{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ViewPatterns #-}

-- | Currency values
module Cardano.Api.Value
  ( L.Coin (..)

    -- * Multi-asset values
  , Quantity (..)
  , PolicyId (..)
  , scriptPolicyId
  , AssetName (..)
  , AssetId (..)
  , Value
  , selectAsset
  , valueFromList
  , valueToList
  , filterValue
  , negateValue
  , negateLedgerValue
  , calcMinimumDeposit

    -- ** Ada \/ L.Coin specifically
  , Lovelace
  , quantityToLovelace
  , lovelaceToQuantity
  , selectLovelace
  , lovelaceToValue
  , valueToLovelace

    -- ** Alternative nested representation
  , ValueNestedRep (..)
  , ValueNestedBundle (..)
  , valueToNestedRep
  , valueFromNestedRep

    -- ** Rendering
  , renderValue
  , renderValuePretty

    -- * Internal conversion functions
  , toByronLovelace
  , fromByronLovelace
  , fromShelleyDeltaLovelace
  , toMaryValue
  , fromMaryValue
  , fromLedgerValue
  , toLedgerValue

    -- * Data family instances
  , AsType (..)
  )
where

import           Cardano.Api.Eon.MaryEraOnwards
import           Cardano.Api.Eon.ShelleyBasedEra
import           Cardano.Api.Eras.Case
import           Cardano.Api.Error (displayError)
import           Cardano.Api.HasTypeProxy
import qualified Cardano.Api.Ledger.Lens as A
import           Cardano.Api.Script
import           Cardano.Api.SerialiseRaw
import           Cardano.Api.SerialiseUsing
import           Cardano.Api.Utils (failEitherWith)

import qualified Cardano.Chain.Common as Byron
import qualified Cardano.Ledger.Allegra.Core as L
import qualified Cardano.Ledger.Coin as L
import           Cardano.Ledger.Crypto (StandardCrypto)
import           Cardano.Ledger.Mary.TxOut as Mary (scaledMinDeposit)
import           Cardano.Ledger.Mary.Value (MaryValue (..))
import qualified Cardano.Ledger.Mary.Value as Mary

import           Data.Aeson (FromJSON, FromJSONKey, ToJSON, object, parseJSON, toJSON, withObject)
import qualified Data.Aeson as Aeson
import qualified Data.Aeson.Key as Aeson
import           Data.Aeson.Types (Parser, ToJSONKey)
import           Data.ByteString (ByteString)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BSC
import qualified Data.ByteString.Short as Short
import           Data.Data (Data)
import           Data.Function ((&))
import           Data.Group (invert)
import qualified Data.List as List
import qualified Data.Map.Merge.Strict as Map
import           Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import           Data.String (IsString (..))
import           Data.Text (Text)
import qualified Data.Text as Text
import qualified Data.Text.Encoding as Text
import           GHC.Exts (IsList (..))
import           Lens.Micro ((%~))

toByronLovelace :: Lovelace -> Maybe Byron.Lovelace
toByronLovelace :: Lovelace -> Maybe Lovelace
toByronLovelace (L.Coin Integer
x) =
  case Integer -> Either LovelaceError Lovelace
Byron.integerToLovelace Integer
x of
    Left LovelaceError
_ -> Maybe Lovelace
forall a. Maybe a
Nothing
    Right Lovelace
x' -> Lovelace -> Maybe Lovelace
forall a. a -> Maybe a
Just Lovelace
x'

fromByronLovelace :: Byron.Lovelace -> Lovelace
fromByronLovelace :: Lovelace -> Lovelace
fromByronLovelace = Integer -> Lovelace
L.Coin (Integer -> Lovelace)
-> (Lovelace -> Integer) -> Lovelace -> Lovelace
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lovelace -> Integer
Byron.lovelaceToInteger

fromShelleyDeltaLovelace :: L.DeltaCoin -> Lovelace
fromShelleyDeltaLovelace :: DeltaCoin -> Lovelace
fromShelleyDeltaLovelace (L.DeltaCoin Integer
d) = Integer -> Lovelace
L.Coin Integer
d

-- ----------------------------------------------------------------------------
-- Multi asset Value
--

newtype Quantity = Quantity Integer
  deriving stock Typeable Quantity
Typeable Quantity =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Quantity -> c Quantity)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Quantity)
-> (Quantity -> Constr)
-> (Quantity -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Quantity))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Quantity))
-> ((forall b. Data b => b -> b) -> Quantity -> Quantity)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Quantity -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Quantity -> r)
-> (forall u. (forall d. Data d => d -> u) -> Quantity -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Quantity -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Quantity -> m Quantity)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Quantity -> m Quantity)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Quantity -> m Quantity)
-> Data Quantity
Quantity -> Constr
Quantity -> DataType
(forall b. Data b => b -> b) -> Quantity -> Quantity
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Quantity -> u
forall u. (forall d. Data d => d -> u) -> Quantity -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Quantity -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Quantity -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Quantity -> m Quantity
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Quantity -> m Quantity
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Quantity
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Quantity -> c Quantity
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Quantity)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Quantity)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Quantity -> c Quantity
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Quantity -> c Quantity
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Quantity
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Quantity
$ctoConstr :: Quantity -> Constr
toConstr :: Quantity -> Constr
$cdataTypeOf :: Quantity -> DataType
dataTypeOf :: Quantity -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Quantity)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Quantity)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Quantity)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Quantity)
$cgmapT :: (forall b. Data b => b -> b) -> Quantity -> Quantity
gmapT :: (forall b. Data b => b -> b) -> Quantity -> Quantity
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Quantity -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Quantity -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Quantity -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Quantity -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Quantity -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Quantity -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Quantity -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Quantity -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Quantity -> m Quantity
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Quantity -> m Quantity
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Quantity -> m Quantity
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Quantity -> m Quantity
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Quantity -> m Quantity
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Quantity -> m Quantity
Data
  deriving newtype (Quantity -> Quantity -> Bool
(Quantity -> Quantity -> Bool)
-> (Quantity -> Quantity -> Bool) -> Eq Quantity
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Quantity -> Quantity -> Bool
== :: Quantity -> Quantity -> Bool
$c/= :: Quantity -> Quantity -> Bool
/= :: Quantity -> Quantity -> Bool
Eq, Eq Quantity
Eq Quantity =>
(Quantity -> Quantity -> Ordering)
-> (Quantity -> Quantity -> Bool)
-> (Quantity -> Quantity -> Bool)
-> (Quantity -> Quantity -> Bool)
-> (Quantity -> Quantity -> Bool)
-> (Quantity -> Quantity -> Quantity)
-> (Quantity -> Quantity -> Quantity)
-> Ord Quantity
Quantity -> Quantity -> Bool
Quantity -> Quantity -> Ordering
Quantity -> Quantity -> Quantity
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Quantity -> Quantity -> Ordering
compare :: Quantity -> Quantity -> Ordering
$c< :: Quantity -> Quantity -> Bool
< :: Quantity -> Quantity -> Bool
$c<= :: Quantity -> Quantity -> Bool
<= :: Quantity -> Quantity -> Bool
$c> :: Quantity -> Quantity -> Bool
> :: Quantity -> Quantity -> Bool
$c>= :: Quantity -> Quantity -> Bool
>= :: Quantity -> Quantity -> Bool
$cmax :: Quantity -> Quantity -> Quantity
max :: Quantity -> Quantity -> Quantity
$cmin :: Quantity -> Quantity -> Quantity
min :: Quantity -> Quantity -> Quantity
Ord, Integer -> Quantity
Quantity -> Quantity
Quantity -> Quantity -> Quantity
(Quantity -> Quantity -> Quantity)
-> (Quantity -> Quantity -> Quantity)
-> (Quantity -> Quantity -> Quantity)
-> (Quantity -> Quantity)
-> (Quantity -> Quantity)
-> (Quantity -> Quantity)
-> (Integer -> Quantity)
-> Num Quantity
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: Quantity -> Quantity -> Quantity
+ :: Quantity -> Quantity -> Quantity
$c- :: Quantity -> Quantity -> Quantity
- :: Quantity -> Quantity -> Quantity
$c* :: Quantity -> Quantity -> Quantity
* :: Quantity -> Quantity -> Quantity
$cnegate :: Quantity -> Quantity
negate :: Quantity -> Quantity
$cabs :: Quantity -> Quantity
abs :: Quantity -> Quantity
$csignum :: Quantity -> Quantity
signum :: Quantity -> Quantity
$cfromInteger :: Integer -> Quantity
fromInteger :: Integer -> Quantity
Num, Int -> Quantity -> ShowS
[Quantity] -> ShowS
Quantity -> String
(Int -> Quantity -> ShowS)
-> (Quantity -> String) -> ([Quantity] -> ShowS) -> Show Quantity
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Quantity -> ShowS
showsPrec :: Int -> Quantity -> ShowS
$cshow :: Quantity -> String
show :: Quantity -> String
$cshowList :: [Quantity] -> ShowS
showList :: [Quantity] -> ShowS
Show, [Quantity] -> Value
[Quantity] -> Encoding
Quantity -> Bool
Quantity -> Value
Quantity -> Encoding
(Quantity -> Value)
-> (Quantity -> Encoding)
-> ([Quantity] -> Value)
-> ([Quantity] -> Encoding)
-> (Quantity -> Bool)
-> ToJSON Quantity
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: Quantity -> Value
toJSON :: Quantity -> Value
$ctoEncoding :: Quantity -> Encoding
toEncoding :: Quantity -> Encoding
$ctoJSONList :: [Quantity] -> Value
toJSONList :: [Quantity] -> Value
$ctoEncodingList :: [Quantity] -> Encoding
toEncodingList :: [Quantity] -> Encoding
$comitField :: Quantity -> Bool
omitField :: Quantity -> Bool
ToJSON, Maybe Quantity
Value -> Parser [Quantity]
Value -> Parser Quantity
(Value -> Parser Quantity)
-> (Value -> Parser [Quantity])
-> Maybe Quantity
-> FromJSON Quantity
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser Quantity
parseJSON :: Value -> Parser Quantity
$cparseJSONList :: Value -> Parser [Quantity]
parseJSONList :: Value -> Parser [Quantity]
$comittedField :: Maybe Quantity
omittedField :: Maybe Quantity
FromJSON)

-- | A 'Coin' is a Lovelace.
type Lovelace = L.Coin

instance Semigroup Quantity where
  Quantity Integer
a <> :: Quantity -> Quantity -> Quantity
<> Quantity Integer
b = Integer -> Quantity
Quantity (Integer
a Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
b)

instance Monoid Quantity where
  mempty :: Quantity
mempty = Integer -> Quantity
Quantity Integer
0

lovelaceToQuantity :: Lovelace -> Quantity
lovelaceToQuantity :: Lovelace -> Quantity
lovelaceToQuantity (L.Coin Integer
x) = Integer -> Quantity
Quantity Integer
x

quantityToLovelace :: Quantity -> Lovelace
quantityToLovelace :: Quantity -> Lovelace
quantityToLovelace (Quantity Integer
x) = Integer -> Lovelace
L.Coin Integer
x

newtype PolicyId = PolicyId {PolicyId -> ScriptHash
unPolicyId :: ScriptHash}
  deriving stock (PolicyId -> PolicyId -> Bool
(PolicyId -> PolicyId -> Bool)
-> (PolicyId -> PolicyId -> Bool) -> Eq PolicyId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PolicyId -> PolicyId -> Bool
== :: PolicyId -> PolicyId -> Bool
$c/= :: PolicyId -> PolicyId -> Bool
/= :: PolicyId -> PolicyId -> Bool
Eq, Eq PolicyId
Eq PolicyId =>
(PolicyId -> PolicyId -> Ordering)
-> (PolicyId -> PolicyId -> Bool)
-> (PolicyId -> PolicyId -> Bool)
-> (PolicyId -> PolicyId -> Bool)
-> (PolicyId -> PolicyId -> Bool)
-> (PolicyId -> PolicyId -> PolicyId)
-> (PolicyId -> PolicyId -> PolicyId)
-> Ord PolicyId
PolicyId -> PolicyId -> Bool
PolicyId -> PolicyId -> Ordering
PolicyId -> PolicyId -> PolicyId
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: PolicyId -> PolicyId -> Ordering
compare :: PolicyId -> PolicyId -> Ordering
$c< :: PolicyId -> PolicyId -> Bool
< :: PolicyId -> PolicyId -> Bool
$c<= :: PolicyId -> PolicyId -> Bool
<= :: PolicyId -> PolicyId -> Bool
$c> :: PolicyId -> PolicyId -> Bool
> :: PolicyId -> PolicyId -> Bool
$c>= :: PolicyId -> PolicyId -> Bool
>= :: PolicyId -> PolicyId -> Bool
$cmax :: PolicyId -> PolicyId -> PolicyId
max :: PolicyId -> PolicyId -> PolicyId
$cmin :: PolicyId -> PolicyId -> PolicyId
min :: PolicyId -> PolicyId -> PolicyId
Ord)
  deriving (Int -> PolicyId -> ShowS
[PolicyId] -> ShowS
PolicyId -> String
(Int -> PolicyId -> ShowS)
-> (PolicyId -> String) -> ([PolicyId] -> ShowS) -> Show PolicyId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PolicyId -> ShowS
showsPrec :: Int -> PolicyId -> ShowS
$cshow :: PolicyId -> String
show :: PolicyId -> String
$cshowList :: [PolicyId] -> ShowS
showList :: [PolicyId] -> ShowS
Show, String -> PolicyId
(String -> PolicyId) -> IsString PolicyId
forall a. (String -> a) -> IsString a
$cfromString :: String -> PolicyId
fromString :: String -> PolicyId
IsString, [PolicyId] -> Value
[PolicyId] -> Encoding
PolicyId -> Bool
PolicyId -> Value
PolicyId -> Encoding
(PolicyId -> Value)
-> (PolicyId -> Encoding)
-> ([PolicyId] -> Value)
-> ([PolicyId] -> Encoding)
-> (PolicyId -> Bool)
-> ToJSON PolicyId
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: PolicyId -> Value
toJSON :: PolicyId -> Value
$ctoEncoding :: PolicyId -> Encoding
toEncoding :: PolicyId -> Encoding
$ctoJSONList :: [PolicyId] -> Value
toJSONList :: [PolicyId] -> Value
$ctoEncodingList :: [PolicyId] -> Encoding
toEncodingList :: [PolicyId] -> Encoding
$comitField :: PolicyId -> Bool
omitField :: PolicyId -> Bool
ToJSON, Maybe PolicyId
Value -> Parser [PolicyId]
Value -> Parser PolicyId
(Value -> Parser PolicyId)
-> (Value -> Parser [PolicyId])
-> Maybe PolicyId
-> FromJSON PolicyId
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser PolicyId
parseJSON :: Value -> Parser PolicyId
$cparseJSONList :: Value -> Parser [PolicyId]
parseJSONList :: Value -> Parser [PolicyId]
$comittedField :: Maybe PolicyId
omittedField :: Maybe PolicyId
FromJSON) via UsingRawBytesHex PolicyId

instance HasTypeProxy PolicyId where
  data AsType PolicyId = AsPolicyId
  proxyToAsType :: Proxy PolicyId -> AsType PolicyId
proxyToAsType Proxy PolicyId
_ = AsType PolicyId
AsPolicyId

instance SerialiseAsRawBytes PolicyId where
  serialiseToRawBytes :: PolicyId -> ByteString
serialiseToRawBytes (PolicyId ScriptHash
sh) = ScriptHash -> ByteString
forall a. SerialiseAsRawBytes a => a -> ByteString
serialiseToRawBytes ScriptHash
sh
  deserialiseFromRawBytes :: AsType PolicyId
-> ByteString -> Either SerialiseAsRawBytesError PolicyId
deserialiseFromRawBytes AsType PolicyId
R:AsTypePolicyId
AsPolicyId ByteString
bs =
    ScriptHash -> PolicyId
PolicyId (ScriptHash -> PolicyId)
-> Either SerialiseAsRawBytesError ScriptHash
-> Either SerialiseAsRawBytesError PolicyId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AsType ScriptHash
-> ByteString -> Either SerialiseAsRawBytesError ScriptHash
forall a.
SerialiseAsRawBytes a =>
AsType a -> ByteString -> Either SerialiseAsRawBytesError a
deserialiseFromRawBytes AsType ScriptHash
AsScriptHash ByteString
bs

scriptPolicyId :: Script lang -> PolicyId
scriptPolicyId :: forall lang. Script lang -> PolicyId
scriptPolicyId = ScriptHash -> PolicyId
PolicyId (ScriptHash -> PolicyId)
-> (Script lang -> ScriptHash) -> Script lang -> PolicyId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Script lang -> ScriptHash
forall lang. Script lang -> ScriptHash
hashScript

newtype AssetName = AssetName ByteString
  deriving stock (AssetName -> AssetName -> Bool
(AssetName -> AssetName -> Bool)
-> (AssetName -> AssetName -> Bool) -> Eq AssetName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AssetName -> AssetName -> Bool
== :: AssetName -> AssetName -> Bool
$c/= :: AssetName -> AssetName -> Bool
/= :: AssetName -> AssetName -> Bool
Eq, Eq AssetName
Eq AssetName =>
(AssetName -> AssetName -> Ordering)
-> (AssetName -> AssetName -> Bool)
-> (AssetName -> AssetName -> Bool)
-> (AssetName -> AssetName -> Bool)
-> (AssetName -> AssetName -> Bool)
-> (AssetName -> AssetName -> AssetName)
-> (AssetName -> AssetName -> AssetName)
-> Ord AssetName
AssetName -> AssetName -> Bool
AssetName -> AssetName -> Ordering
AssetName -> AssetName -> AssetName
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: AssetName -> AssetName -> Ordering
compare :: AssetName -> AssetName -> Ordering
$c< :: AssetName -> AssetName -> Bool
< :: AssetName -> AssetName -> Bool
$c<= :: AssetName -> AssetName -> Bool
<= :: AssetName -> AssetName -> Bool
$c> :: AssetName -> AssetName -> Bool
> :: AssetName -> AssetName -> Bool
$c>= :: AssetName -> AssetName -> Bool
>= :: AssetName -> AssetName -> Bool
$cmax :: AssetName -> AssetName -> AssetName
max :: AssetName -> AssetName -> AssetName
$cmin :: AssetName -> AssetName -> AssetName
min :: AssetName -> AssetName -> AssetName
Ord)
  deriving newtype Int -> AssetName -> ShowS
[AssetName] -> ShowS
AssetName -> String
(Int -> AssetName -> ShowS)
-> (AssetName -> String)
-> ([AssetName] -> ShowS)
-> Show AssetName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AssetName -> ShowS
showsPrec :: Int -> AssetName -> ShowS
$cshow :: AssetName -> String
show :: AssetName -> String
$cshowList :: [AssetName] -> ShowS
showList :: [AssetName] -> ShowS
Show
  deriving
    ([AssetName] -> Value
[AssetName] -> Encoding
AssetName -> Bool
AssetName -> Value
AssetName -> Encoding
(AssetName -> Value)
-> (AssetName -> Encoding)
-> ([AssetName] -> Value)
-> ([AssetName] -> Encoding)
-> (AssetName -> Bool)
-> ToJSON AssetName
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: AssetName -> Value
toJSON :: AssetName -> Value
$ctoEncoding :: AssetName -> Encoding
toEncoding :: AssetName -> Encoding
$ctoJSONList :: [AssetName] -> Value
toJSONList :: [AssetName] -> Value
$ctoEncodingList :: [AssetName] -> Encoding
toEncodingList :: [AssetName] -> Encoding
$comitField :: AssetName -> Bool
omitField :: AssetName -> Bool
ToJSON, Maybe AssetName
Value -> Parser [AssetName]
Value -> Parser AssetName
(Value -> Parser AssetName)
-> (Value -> Parser [AssetName])
-> Maybe AssetName
-> FromJSON AssetName
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser AssetName
parseJSON :: Value -> Parser AssetName
$cparseJSONList :: Value -> Parser [AssetName]
parseJSONList :: Value -> Parser [AssetName]
$comittedField :: Maybe AssetName
omittedField :: Maybe AssetName
FromJSON, ToJSONKeyFunction [AssetName]
ToJSONKeyFunction AssetName
ToJSONKeyFunction AssetName
-> ToJSONKeyFunction [AssetName] -> ToJSONKey AssetName
forall a.
ToJSONKeyFunction a -> ToJSONKeyFunction [a] -> ToJSONKey a
$ctoJSONKey :: ToJSONKeyFunction AssetName
toJSONKey :: ToJSONKeyFunction AssetName
$ctoJSONKeyList :: ToJSONKeyFunction [AssetName]
toJSONKeyList :: ToJSONKeyFunction [AssetName]
ToJSONKey, FromJSONKeyFunction [AssetName]
FromJSONKeyFunction AssetName
FromJSONKeyFunction AssetName
-> FromJSONKeyFunction [AssetName] -> FromJSONKey AssetName
forall a.
FromJSONKeyFunction a -> FromJSONKeyFunction [a] -> FromJSONKey a
$cfromJSONKey :: FromJSONKeyFunction AssetName
fromJSONKey :: FromJSONKeyFunction AssetName
$cfromJSONKeyList :: FromJSONKeyFunction [AssetName]
fromJSONKeyList :: FromJSONKeyFunction [AssetName]
FromJSONKey)
    via UsingRawBytesHex AssetName

instance IsString AssetName where
  fromString :: String -> AssetName
fromString String
s
    | let bs :: ByteString
bs = Text -> ByteString
Text.encodeUtf8 (String -> Text
Text.pack String
s)
    , ByteString -> Int
BS.length ByteString
bs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
32 =
        ByteString -> AssetName
AssetName (String -> ByteString
BSC.pack String
s)
    | Bool
otherwise = String -> AssetName
forall a. HasCallStack => String -> a
error String
"fromString: AssetName over 32 bytes"

instance HasTypeProxy AssetName where
  data AsType AssetName = AsAssetName
  proxyToAsType :: Proxy AssetName -> AsType AssetName
proxyToAsType Proxy AssetName
_ = AsType AssetName
AsAssetName

instance SerialiseAsRawBytes AssetName where
  serialiseToRawBytes :: AssetName -> ByteString
serialiseToRawBytes (AssetName ByteString
bs) = ByteString
bs
  deserialiseFromRawBytes :: AsType AssetName
-> ByteString -> Either SerialiseAsRawBytesError AssetName
deserialiseFromRawBytes AsType AssetName
R:AsTypeAssetName
AsAssetName ByteString
bs
    | ByteString -> Int
BS.length ByteString
bs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
32 = AssetName -> Either SerialiseAsRawBytesError AssetName
forall a b. b -> Either a b
Right (ByteString -> AssetName
AssetName ByteString
bs)
    | Bool
otherwise =
        SerialiseAsRawBytesError
-> Either SerialiseAsRawBytesError AssetName
forall a b. a -> Either a b
Left (SerialiseAsRawBytesError
 -> Either SerialiseAsRawBytesError AssetName)
-> SerialiseAsRawBytesError
-> Either SerialiseAsRawBytesError AssetName
forall a b. (a -> b) -> a -> b
$
          String -> SerialiseAsRawBytesError
SerialiseAsRawBytesError (String -> SerialiseAsRawBytesError)
-> String -> SerialiseAsRawBytesError
forall a b. (a -> b) -> a -> b
$
            String
"Unable to deserialise AssetName (the bytestring should be no longer than 32 bytes long "
              String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"which corresponds to a hex representation of 64 characters)"

data AssetId
  = AdaAssetId
  | AssetId !PolicyId !AssetName
  deriving (AssetId -> AssetId -> Bool
(AssetId -> AssetId -> Bool)
-> (AssetId -> AssetId -> Bool) -> Eq AssetId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AssetId -> AssetId -> Bool
== :: AssetId -> AssetId -> Bool
$c/= :: AssetId -> AssetId -> Bool
/= :: AssetId -> AssetId -> Bool
Eq, Eq AssetId
Eq AssetId =>
(AssetId -> AssetId -> Ordering)
-> (AssetId -> AssetId -> Bool)
-> (AssetId -> AssetId -> Bool)
-> (AssetId -> AssetId -> Bool)
-> (AssetId -> AssetId -> Bool)
-> (AssetId -> AssetId -> AssetId)
-> (AssetId -> AssetId -> AssetId)
-> Ord AssetId
AssetId -> AssetId -> Bool
AssetId -> AssetId -> Ordering
AssetId -> AssetId -> AssetId
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: AssetId -> AssetId -> Ordering
compare :: AssetId -> AssetId -> Ordering
$c< :: AssetId -> AssetId -> Bool
< :: AssetId -> AssetId -> Bool
$c<= :: AssetId -> AssetId -> Bool
<= :: AssetId -> AssetId -> Bool
$c> :: AssetId -> AssetId -> Bool
> :: AssetId -> AssetId -> Bool
$c>= :: AssetId -> AssetId -> Bool
>= :: AssetId -> AssetId -> Bool
$cmax :: AssetId -> AssetId -> AssetId
max :: AssetId -> AssetId -> AssetId
$cmin :: AssetId -> AssetId -> AssetId
min :: AssetId -> AssetId -> AssetId
Ord, Int -> AssetId -> ShowS
[AssetId] -> ShowS
AssetId -> String
(Int -> AssetId -> ShowS)
-> (AssetId -> String) -> ([AssetId] -> ShowS) -> Show AssetId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AssetId -> ShowS
showsPrec :: Int -> AssetId -> ShowS
$cshow :: AssetId -> String
show :: AssetId -> String
$cshowList :: [AssetId] -> ShowS
showList :: [AssetId] -> ShowS
Show)

newtype Value = Value (Map AssetId Quantity)
  deriving Value -> Value -> Bool
(Value -> Value -> Bool) -> (Value -> Value -> Bool) -> Eq Value
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Value -> Value -> Bool
== :: Value -> Value -> Bool
$c/= :: Value -> Value -> Bool
/= :: Value -> Value -> Bool
Eq

instance Show Value where
  showsPrec :: Int -> Value -> ShowS
showsPrec Int
d Value
v =
    Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
      String -> ShowS
showString String
"valueFromList " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(AssetId, Quantity)] -> ShowS
forall a. Show a => a -> ShowS
shows (Value -> [Item Value]
forall l. IsList l => l -> [Item l]
toList Value
v)

instance Semigroup Value where
  Value Map AssetId Quantity
a <> :: Value -> Value -> Value
<> Value Map AssetId Quantity
b = Map AssetId Quantity -> Value
Value (Map AssetId Quantity
-> Map AssetId Quantity -> Map AssetId Quantity
mergeAssetMaps Map AssetId Quantity
a Map AssetId Quantity
b)

instance Monoid Value where
  mempty :: Value
mempty = Map AssetId Quantity -> Value
Value Map AssetId Quantity
forall k a. Map k a
Map.empty

instance IsList Value where
  type Item Value = (AssetId, Quantity)
  fromList :: [Item Value] -> Value
fromList =
    Map AssetId Quantity -> Value
Value
      (Map AssetId Quantity -> Value)
-> ([(AssetId, Quantity)] -> Map AssetId Quantity)
-> [(AssetId, Quantity)]
-> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Quantity -> Bool) -> Map AssetId Quantity -> Map AssetId Quantity
forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter (Quantity -> Quantity -> Bool
forall a. Eq a => a -> a -> Bool
/= Quantity
0)
      (Map AssetId Quantity -> Map AssetId Quantity)
-> ([(AssetId, Quantity)] -> Map AssetId Quantity)
-> [(AssetId, Quantity)]
-> Map AssetId Quantity
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Quantity -> Quantity -> Quantity)
-> [(AssetId, Quantity)] -> Map AssetId Quantity
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith Quantity -> Quantity -> Quantity
forall a. Semigroup a => a -> a -> a
(<>)
  toList :: Value -> [Item Value]
toList (Value Map AssetId Quantity
m) = Map AssetId Quantity -> [Item (Map AssetId Quantity)]
forall l. IsList l => l -> [Item l]
toList Map AssetId Quantity
m

{-# NOINLINE mergeAssetMaps #-} -- as per advice in Data.Map.Merge docs
mergeAssetMaps
  :: Map AssetId Quantity
  -> Map AssetId Quantity
  -> Map AssetId Quantity
mergeAssetMaps :: Map AssetId Quantity
-> Map AssetId Quantity -> Map AssetId Quantity
mergeAssetMaps =
  SimpleWhenMissing AssetId Quantity Quantity
-> SimpleWhenMissing AssetId Quantity Quantity
-> SimpleWhenMatched AssetId Quantity Quantity Quantity
-> Map AssetId Quantity
-> Map AssetId Quantity
-> Map AssetId Quantity
forall k a c b.
Ord k =>
SimpleWhenMissing k a c
-> SimpleWhenMissing k b c
-> SimpleWhenMatched k a b c
-> Map k a
-> Map k b
-> Map k c
Map.merge
    SimpleWhenMissing AssetId Quantity Quantity
forall (f :: * -> *) k x. Applicative f => WhenMissing f k x x
Map.preserveMissing
    SimpleWhenMissing AssetId Quantity Quantity
forall (f :: * -> *) k x. Applicative f => WhenMissing f k x x
Map.preserveMissing
    ((AssetId -> Quantity -> Quantity -> Maybe Quantity)
-> SimpleWhenMatched AssetId Quantity Quantity Quantity
forall (f :: * -> *) k x y z.
Applicative f =>
(k -> x -> y -> Maybe z) -> WhenMatched f k x y z
Map.zipWithMaybeMatched AssetId -> Quantity -> Quantity -> Maybe Quantity
mergeQuantity)
 where
  mergeQuantity :: AssetId -> Quantity -> Quantity -> Maybe Quantity
  mergeQuantity :: AssetId -> Quantity -> Quantity -> Maybe Quantity
mergeQuantity AssetId
_k Quantity
a Quantity
b =
    case Quantity
a Quantity -> Quantity -> Quantity
forall a. Semigroup a => a -> a -> a
<> Quantity
b of
      Quantity Integer
0 -> Maybe Quantity
forall a. Maybe a
Nothing
      Quantity
c -> Quantity -> Maybe Quantity
forall a. a -> Maybe a
Just Quantity
c

instance ToJSON Value where
  toJSON :: Value -> Value
toJSON = ValueNestedRep -> Value
forall a. ToJSON a => a -> Value
toJSON (ValueNestedRep -> Value)
-> (Value -> ValueNestedRep) -> Value -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> ValueNestedRep
valueToNestedRep

instance FromJSON Value where
  parseJSON :: Value -> Parser Value
parseJSON Value
v = ValueNestedRep -> Value
valueFromNestedRep (ValueNestedRep -> Value) -> Parser ValueNestedRep -> Parser Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser ValueNestedRep
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v

selectAsset :: Value -> (AssetId -> Quantity)
selectAsset :: Value -> AssetId -> Quantity
selectAsset (Value Map AssetId Quantity
m) AssetId
a = Quantity -> AssetId -> Map AssetId Quantity -> Quantity
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault Quantity
forall a. Monoid a => a
mempty AssetId
a Map AssetId Quantity
m

{-# DEPRECATED valueFromList "Use 'fromList' instead." #-}
valueFromList :: [(AssetId, Quantity)] -> Value
valueFromList :: [(AssetId, Quantity)] -> Value
valueFromList = [(AssetId, Quantity)] -> Value
[Item Value] -> Value
forall l. IsList l => [Item l] -> l
fromList

{-# DEPRECATED valueToList "Use 'toList' instead." #-}
valueToList :: Value -> [(AssetId, Quantity)]
valueToList :: Value -> [(AssetId, Quantity)]
valueToList = Value -> [(AssetId, Quantity)]
Value -> [Item Value]
forall l. IsList l => l -> [Item l]
toList

-- | This lets you write @a - b@ as @a <> negateValue b@.
negateValue :: Value -> Value
negateValue :: Value -> Value
negateValue (Value Map AssetId Quantity
m) = Map AssetId Quantity -> Value
Value ((Quantity -> Quantity)
-> Map AssetId Quantity -> Map AssetId Quantity
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map Quantity -> Quantity
forall a. Num a => a -> a
negate Map AssetId Quantity
m)

negateLedgerValue
  :: ShelleyBasedEra era -> L.Value (ShelleyLedgerEra era) -> L.Value (ShelleyLedgerEra era)
negateLedgerValue :: forall era.
ShelleyBasedEra era
-> Value (ShelleyLedgerEra era) -> Value (ShelleyLedgerEra era)
negateLedgerValue ShelleyBasedEra era
sbe Value (ShelleyLedgerEra era)
v =
  (ShelleyToAllegraEraConstraints era =>
 ShelleyToAllegraEra era -> Value (ShelleyLedgerEra era))
-> (MaryEraOnwardsConstraints era =>
    MaryEraOnwards era -> Value (ShelleyLedgerEra era))
-> ShelleyBasedEra era
-> Value (ShelleyLedgerEra era)
forall era a.
(ShelleyToAllegraEraConstraints era =>
 ShelleyToAllegraEra era -> a)
-> (MaryEraOnwardsConstraints era => MaryEraOnwards era -> a)
-> ShelleyBasedEra era
-> a
caseShelleyToAllegraOrMaryEraOnwards
    (\ShelleyToAllegraEra era
_ -> Value (ShelleyLedgerEra era)
Lovelace
v Lovelace
-> (Lovelace -> Value (ShelleyLedgerEra era))
-> Value (ShelleyLedgerEra era)
forall a b. a -> (a -> b) -> b
& ShelleyBasedEra era
-> Lens' (Value (ShelleyLedgerEra era)) Lovelace
forall era.
ShelleyBasedEra era
-> Lens' (Value (ShelleyLedgerEra era)) Lovelace
A.adaAssetL ShelleyBasedEra era
sbe ((Lovelace -> Identity Lovelace)
 -> Lovelace -> Identity (Value (ShelleyLedgerEra era)))
-> (Lovelace -> Lovelace)
-> Lovelace
-> Value (ShelleyLedgerEra era)
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Integer -> Lovelace
L.Coin (Integer -> Lovelace)
-> (Lovelace -> Integer) -> Lovelace -> Lovelace
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Integer
forall a. Num a => a -> a
negate (Integer -> Integer)
-> (Lovelace -> Integer) -> Lovelace -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lovelace -> Integer
L.unCoin)
    (\MaryEraOnwards era
w -> Value (ShelleyLedgerEra era)
MaryValue StandardCrypto
v MaryValue StandardCrypto
-> (MaryValue StandardCrypto -> Value (ShelleyLedgerEra era))
-> Value (ShelleyLedgerEra era)
forall a b. a -> (a -> b) -> b
& MaryEraOnwards era
-> Lens' (MaryValue StandardCrypto) (MultiAsset StandardCrypto)
forall era.
MaryEraOnwards era
-> Lens' (MaryValue StandardCrypto) (MultiAsset StandardCrypto)
A.multiAssetL MaryEraOnwards era
w ((MultiAsset StandardCrypto
  -> Identity (MultiAsset StandardCrypto))
 -> MaryValue StandardCrypto
 -> Identity (Value (ShelleyLedgerEra era)))
-> (MultiAsset StandardCrypto -> MultiAsset StandardCrypto)
-> MaryValue StandardCrypto
-> Value (ShelleyLedgerEra era)
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ MultiAsset StandardCrypto -> MultiAsset StandardCrypto
forall m. Group m => m -> m
invert)
    ShelleyBasedEra era
sbe

filterValue :: (AssetId -> Bool) -> Value -> Value
filterValue :: (AssetId -> Bool) -> Value -> Value
filterValue AssetId -> Bool
p (Value Map AssetId Quantity
m) = Map AssetId Quantity -> Value
Value ((AssetId -> Quantity -> Bool)
-> Map AssetId Quantity -> Map AssetId Quantity
forall k a. (k -> a -> Bool) -> Map k a -> Map k a
Map.filterWithKey (\AssetId
k Quantity
_v -> AssetId -> Bool
p AssetId
k) Map AssetId Quantity
m)

selectLovelace :: Value -> Lovelace
selectLovelace :: Value -> Lovelace
selectLovelace = Quantity -> Lovelace
quantityToLovelace (Quantity -> Lovelace) -> (Value -> Quantity) -> Value -> Lovelace
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Value -> AssetId -> Quantity) -> AssetId -> Value -> Quantity
forall a b c. (a -> b -> c) -> b -> a -> c
flip Value -> AssetId -> Quantity
selectAsset AssetId
AdaAssetId

lovelaceToValue :: Lovelace -> Value
lovelaceToValue :: Lovelace -> Value
lovelaceToValue = Map AssetId Quantity -> Value
Value (Map AssetId Quantity -> Value)
-> (Lovelace -> Map AssetId Quantity) -> Lovelace -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AssetId -> Quantity -> Map AssetId Quantity
forall k a. k -> a -> Map k a
Map.singleton AssetId
AdaAssetId (Quantity -> Map AssetId Quantity)
-> (Lovelace -> Quantity) -> Lovelace -> Map AssetId Quantity
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lovelace -> Quantity
lovelaceToQuantity

-- | Check if the 'Value' consists of /only/ 'Lovelace' and no other assets,
-- and if so then return the Lovelace
--
-- See also 'selectLovelace' to select the Lovelace quantity from the Value,
-- ignoring other assets.
valueToLovelace :: Value -> Maybe Lovelace
valueToLovelace :: Value -> Maybe Lovelace
valueToLovelace Value
v =
  case Value -> [(AssetId, Quantity)]
valueToList Value
v of
    [] -> Lovelace -> Maybe Lovelace
forall a. a -> Maybe a
Just (Integer -> Lovelace
L.Coin Integer
0)
    [(AssetId
AdaAssetId, Quantity
q)] -> Lovelace -> Maybe Lovelace
forall a. a -> Maybe a
Just (Quantity -> Lovelace
quantityToLovelace Quantity
q)
    [(AssetId, Quantity)]
_ -> Maybe Lovelace
forall a. Maybe a
Nothing

toMaryValue :: Value -> MaryValue StandardCrypto
toMaryValue :: Value -> MaryValue StandardCrypto
toMaryValue Value
v =
  Lovelace
-> [(PolicyID StandardCrypto, AssetName, Integer)]
-> MaryValue StandardCrypto
forall era.
Lovelace -> [(PolicyID era, AssetName, Integer)] -> MaryValue era
Mary.valueFromList (Integer -> Lovelace
L.Coin Integer
lovelace) [(PolicyID StandardCrypto, AssetName, Integer)]
other
 where
  Quantity Integer
lovelace = Value -> AssetId -> Quantity
selectAsset Value
v AssetId
AdaAssetId
  other :: [(PolicyID StandardCrypto, AssetName, Integer)]
other =
    [ (PolicyId -> PolicyID StandardCrypto
toMaryPolicyID PolicyId
pid, AssetName -> AssetName
toMaryAssetName AssetName
name, Integer
q)
    | (AssetId PolicyId
pid AssetName
name, Quantity Integer
q) <- Value -> [(AssetId, Quantity)]
valueToList Value
v
    ]

  toMaryPolicyID :: PolicyId -> Mary.PolicyID StandardCrypto
  toMaryPolicyID :: PolicyId -> PolicyID StandardCrypto
toMaryPolicyID (PolicyId ScriptHash
sh) = ScriptHash StandardCrypto -> PolicyID StandardCrypto
forall c. ScriptHash c -> PolicyID c
Mary.PolicyID (ScriptHash -> ScriptHash StandardCrypto
toShelleyScriptHash ScriptHash
sh)

  toMaryAssetName :: AssetName -> Mary.AssetName
  toMaryAssetName :: AssetName -> AssetName
toMaryAssetName (AssetName ByteString
n) = ShortByteString -> AssetName
Mary.AssetName (ShortByteString -> AssetName) -> ShortByteString -> AssetName
forall a b. (a -> b) -> a -> b
$ ByteString -> ShortByteString
Short.toShort ByteString
n

toLedgerValue :: MaryEraOnwards era -> Value -> L.Value (ShelleyLedgerEra era)
toLedgerValue :: forall era.
MaryEraOnwards era -> Value -> Value (ShelleyLedgerEra era)
toLedgerValue MaryEraOnwards era
w = MaryEraOnwards era
-> (MaryEraOnwardsConstraints era =>
    Value -> Value (ShelleyLedgerEra era))
-> Value
-> Value (ShelleyLedgerEra era)
forall era a.
MaryEraOnwards era -> (MaryEraOnwardsConstraints era => a) -> a
maryEraOnwardsConstraints MaryEraOnwards era
w MaryEraOnwardsConstraints era =>
Value -> Value (ShelleyLedgerEra era)
Value -> Value (ShelleyLedgerEra era)
Value -> MaryValue StandardCrypto
toMaryValue

fromLedgerValue :: ShelleyBasedEra era -> L.Value (ShelleyLedgerEra era) -> Value
fromLedgerValue :: forall era.
ShelleyBasedEra era -> Value (ShelleyLedgerEra era) -> Value
fromLedgerValue ShelleyBasedEra era
sbe Value (ShelleyLedgerEra era)
v =
  (ShelleyToAllegraEraConstraints era =>
 ShelleyToAllegraEra era -> Value)
-> (MaryEraOnwardsConstraints era => MaryEraOnwards era -> Value)
-> ShelleyBasedEra era
-> Value
forall era a.
(ShelleyToAllegraEraConstraints era =>
 ShelleyToAllegraEra era -> a)
-> (MaryEraOnwardsConstraints era => MaryEraOnwards era -> a)
-> ShelleyBasedEra era
-> a
caseShelleyToAllegraOrMaryEraOnwards
    (Value -> ShelleyToAllegraEra era -> Value
forall a b. a -> b -> a
const (Lovelace -> Value
lovelaceToValue Value (ShelleyLedgerEra era)
Lovelace
v))
    (Value -> MaryEraOnwards era -> Value
forall a b. a -> b -> a
const (MaryValue StandardCrypto -> Value
fromMaryValue Value (ShelleyLedgerEra era)
MaryValue StandardCrypto
v))
    ShelleyBasedEra era
sbe

fromMaryValue :: MaryValue StandardCrypto -> Value
fromMaryValue :: MaryValue StandardCrypto -> Value
fromMaryValue (MaryValue (L.Coin Integer
lovelace) MultiAsset StandardCrypto
other) =
  Map AssetId Quantity -> Value
Value (Map AssetId Quantity -> Value) -> Map AssetId Quantity -> Value
forall a b. (a -> b) -> a -> b
$
    -- TODO: write QC tests to show it's ok to use Map.fromAscList here
    [Item (Map AssetId Quantity)] -> Map AssetId Quantity
forall l. IsList l => [Item l] -> l
fromList ([Item (Map AssetId Quantity)] -> Map AssetId Quantity)
-> [Item (Map AssetId Quantity)] -> Map AssetId Quantity
forall a b. (a -> b) -> a -> b
$
      [(AssetId
AdaAssetId, Integer -> Quantity
Quantity Integer
lovelace) | Integer
lovelace Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
/= Integer
0]
        [(AssetId, Quantity)]
-> [(AssetId, Quantity)] -> [(AssetId, Quantity)]
forall a. [a] -> [a] -> [a]
++ [ (PolicyId -> AssetName -> AssetId
AssetId (PolicyID StandardCrypto -> PolicyId
fromMaryPolicyID PolicyID StandardCrypto
pid) (AssetName -> AssetName
fromMaryAssetName AssetName
name), Integer -> Quantity
Quantity Integer
q)
           | (PolicyID StandardCrypto
pid, AssetName
name, Integer
q) <- MultiAsset StandardCrypto
-> [(PolicyID StandardCrypto, AssetName, Integer)]
forall c. MultiAsset c -> [(PolicyID c, AssetName, Integer)]
Mary.flattenMultiAsset MultiAsset StandardCrypto
other
           ]
 where
  fromMaryPolicyID :: Mary.PolicyID StandardCrypto -> PolicyId
  fromMaryPolicyID :: PolicyID StandardCrypto -> PolicyId
fromMaryPolicyID (Mary.PolicyID ScriptHash StandardCrypto
sh) = ScriptHash -> PolicyId
PolicyId (ScriptHash StandardCrypto -> ScriptHash
fromShelleyScriptHash ScriptHash StandardCrypto
sh)

  fromMaryAssetName :: Mary.AssetName -> AssetName
  fromMaryAssetName :: AssetName -> AssetName
fromMaryAssetName (Mary.AssetName ShortByteString
n) = ByteString -> AssetName
AssetName (ByteString -> AssetName) -> ByteString -> AssetName
forall a b. (a -> b) -> a -> b
$ ShortByteString -> ByteString
Short.fromShort ShortByteString
n

-- | Calculate cost of making a UTxO entry for a given 'Value' and
-- mininimum UTxO value derived from the 'ProtocolParameters'
calcMinimumDeposit :: Value -> Lovelace -> Lovelace
calcMinimumDeposit :: Value -> Lovelace -> Lovelace
calcMinimumDeposit Value
v =
  MaryValue StandardCrypto -> Lovelace -> Lovelace
forall v. Val v => v -> Lovelace -> Lovelace
Mary.scaledMinDeposit (Value -> MaryValue StandardCrypto
toMaryValue Value
v)

-- ----------------------------------------------------------------------------
-- An alternative nested representation
--

-- | An alternative nested representation for 'Value' that groups assets that
-- share a 'PolicyId'.
newtype ValueNestedRep = ValueNestedRep [ValueNestedBundle]
  deriving (ValueNestedRep -> ValueNestedRep -> Bool
(ValueNestedRep -> ValueNestedRep -> Bool)
-> (ValueNestedRep -> ValueNestedRep -> Bool) -> Eq ValueNestedRep
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ValueNestedRep -> ValueNestedRep -> Bool
== :: ValueNestedRep -> ValueNestedRep -> Bool
$c/= :: ValueNestedRep -> ValueNestedRep -> Bool
/= :: ValueNestedRep -> ValueNestedRep -> Bool
Eq, Eq ValueNestedRep
Eq ValueNestedRep =>
(ValueNestedRep -> ValueNestedRep -> Ordering)
-> (ValueNestedRep -> ValueNestedRep -> Bool)
-> (ValueNestedRep -> ValueNestedRep -> Bool)
-> (ValueNestedRep -> ValueNestedRep -> Bool)
-> (ValueNestedRep -> ValueNestedRep -> Bool)
-> (ValueNestedRep -> ValueNestedRep -> ValueNestedRep)
-> (ValueNestedRep -> ValueNestedRep -> ValueNestedRep)
-> Ord ValueNestedRep
ValueNestedRep -> ValueNestedRep -> Bool
ValueNestedRep -> ValueNestedRep -> Ordering
ValueNestedRep -> ValueNestedRep -> ValueNestedRep
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ValueNestedRep -> ValueNestedRep -> Ordering
compare :: ValueNestedRep -> ValueNestedRep -> Ordering
$c< :: ValueNestedRep -> ValueNestedRep -> Bool
< :: ValueNestedRep -> ValueNestedRep -> Bool
$c<= :: ValueNestedRep -> ValueNestedRep -> Bool
<= :: ValueNestedRep -> ValueNestedRep -> Bool
$c> :: ValueNestedRep -> ValueNestedRep -> Bool
> :: ValueNestedRep -> ValueNestedRep -> Bool
$c>= :: ValueNestedRep -> ValueNestedRep -> Bool
>= :: ValueNestedRep -> ValueNestedRep -> Bool
$cmax :: ValueNestedRep -> ValueNestedRep -> ValueNestedRep
max :: ValueNestedRep -> ValueNestedRep -> ValueNestedRep
$cmin :: ValueNestedRep -> ValueNestedRep -> ValueNestedRep
min :: ValueNestedRep -> ValueNestedRep -> ValueNestedRep
Ord, Int -> ValueNestedRep -> ShowS
[ValueNestedRep] -> ShowS
ValueNestedRep -> String
(Int -> ValueNestedRep -> ShowS)
-> (ValueNestedRep -> String)
-> ([ValueNestedRep] -> ShowS)
-> Show ValueNestedRep
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ValueNestedRep -> ShowS
showsPrec :: Int -> ValueNestedRep -> ShowS
$cshow :: ValueNestedRep -> String
show :: ValueNestedRep -> String
$cshowList :: [ValueNestedRep] -> ShowS
showList :: [ValueNestedRep] -> ShowS
Show)

-- | A bundle within a 'ValueNestedRep' for a single 'PolicyId', or for the
-- special case of ada.
data ValueNestedBundle
  = ValueNestedBundleAda Quantity
  | ValueNestedBundle PolicyId (Map AssetName Quantity)
  deriving (ValueNestedBundle -> ValueNestedBundle -> Bool
(ValueNestedBundle -> ValueNestedBundle -> Bool)
-> (ValueNestedBundle -> ValueNestedBundle -> Bool)
-> Eq ValueNestedBundle
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ValueNestedBundle -> ValueNestedBundle -> Bool
== :: ValueNestedBundle -> ValueNestedBundle -> Bool
$c/= :: ValueNestedBundle -> ValueNestedBundle -> Bool
/= :: ValueNestedBundle -> ValueNestedBundle -> Bool
Eq, Eq ValueNestedBundle
Eq ValueNestedBundle =>
(ValueNestedBundle -> ValueNestedBundle -> Ordering)
-> (ValueNestedBundle -> ValueNestedBundle -> Bool)
-> (ValueNestedBundle -> ValueNestedBundle -> Bool)
-> (ValueNestedBundle -> ValueNestedBundle -> Bool)
-> (ValueNestedBundle -> ValueNestedBundle -> Bool)
-> (ValueNestedBundle -> ValueNestedBundle -> ValueNestedBundle)
-> (ValueNestedBundle -> ValueNestedBundle -> ValueNestedBundle)
-> Ord ValueNestedBundle
ValueNestedBundle -> ValueNestedBundle -> Bool
ValueNestedBundle -> ValueNestedBundle -> Ordering
ValueNestedBundle -> ValueNestedBundle -> ValueNestedBundle
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ValueNestedBundle -> ValueNestedBundle -> Ordering
compare :: ValueNestedBundle -> ValueNestedBundle -> Ordering
$c< :: ValueNestedBundle -> ValueNestedBundle -> Bool
< :: ValueNestedBundle -> ValueNestedBundle -> Bool
$c<= :: ValueNestedBundle -> ValueNestedBundle -> Bool
<= :: ValueNestedBundle -> ValueNestedBundle -> Bool
$c> :: ValueNestedBundle -> ValueNestedBundle -> Bool
> :: ValueNestedBundle -> ValueNestedBundle -> Bool
$c>= :: ValueNestedBundle -> ValueNestedBundle -> Bool
>= :: ValueNestedBundle -> ValueNestedBundle -> Bool
$cmax :: ValueNestedBundle -> ValueNestedBundle -> ValueNestedBundle
max :: ValueNestedBundle -> ValueNestedBundle -> ValueNestedBundle
$cmin :: ValueNestedBundle -> ValueNestedBundle -> ValueNestedBundle
min :: ValueNestedBundle -> ValueNestedBundle -> ValueNestedBundle
Ord, Int -> ValueNestedBundle -> ShowS
[ValueNestedBundle] -> ShowS
ValueNestedBundle -> String
(Int -> ValueNestedBundle -> ShowS)
-> (ValueNestedBundle -> String)
-> ([ValueNestedBundle] -> ShowS)
-> Show ValueNestedBundle
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ValueNestedBundle -> ShowS
showsPrec :: Int -> ValueNestedBundle -> ShowS
$cshow :: ValueNestedBundle -> String
show :: ValueNestedBundle -> String
$cshowList :: [ValueNestedBundle] -> ShowS
showList :: [ValueNestedBundle] -> ShowS
Show)

valueToNestedRep :: Value -> ValueNestedRep
valueToNestedRep :: Value -> ValueNestedRep
valueToNestedRep Value
v =
  -- unflatten all the non-ada assets, and add ada separately
  [ValueNestedBundle] -> ValueNestedRep
ValueNestedRep ([ValueNestedBundle] -> ValueNestedRep)
-> [ValueNestedBundle] -> ValueNestedRep
forall a b. (a -> b) -> a -> b
$
    [Quantity -> ValueNestedBundle
ValueNestedBundleAda Quantity
q | let q :: Quantity
q = Value -> AssetId -> Quantity
selectAsset Value
v AssetId
AdaAssetId, Quantity
q Quantity -> Quantity -> Bool
forall a. Eq a => a -> a -> Bool
/= Quantity
0]
      [ValueNestedBundle] -> [ValueNestedBundle] -> [ValueNestedBundle]
forall a. [a] -> [a] -> [a]
++ [PolicyId -> Map AssetName Quantity -> ValueNestedBundle
ValueNestedBundle PolicyId
pId Map AssetName Quantity
qs | (PolicyId
pId, Map AssetName Quantity
qs) <- Map PolicyId (Map AssetName Quantity)
-> [Item (Map PolicyId (Map AssetName Quantity))]
forall l. IsList l => l -> [Item l]
toList Map PolicyId (Map AssetName Quantity)
nonAdaAssets]
 where
  nonAdaAssets :: Map PolicyId (Map AssetName Quantity)
  nonAdaAssets :: Map PolicyId (Map AssetName Quantity)
nonAdaAssets =
    (Map AssetName Quantity
 -> Map AssetName Quantity -> Map AssetName Quantity)
-> [(PolicyId, Map AssetName Quantity)]
-> Map PolicyId (Map AssetName Quantity)
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith
      ((Quantity -> Quantity -> Quantity)
-> Map AssetName Quantity
-> Map AssetName Quantity
-> Map AssetName Quantity
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith Quantity -> Quantity -> Quantity
forall a. Semigroup a => a -> a -> a
(<>))
      [ (PolicyId
pId, AssetName -> Quantity -> Map AssetName Quantity
forall k a. k -> a -> Map k a
Map.singleton AssetName
aName Quantity
q)
      | (AssetId PolicyId
pId AssetName
aName, Quantity
q) <- Value -> [(AssetId, Quantity)]
valueToList Value
v
      ]

valueFromNestedRep :: ValueNestedRep -> Value
valueFromNestedRep :: ValueNestedRep -> Value
valueFromNestedRep (ValueNestedRep [ValueNestedBundle]
bundles) =
  [(AssetId, Quantity)] -> Value
valueFromList
    [ (AssetId
aId, Quantity
q)
    | ValueNestedBundle
bundle <- [ValueNestedBundle]
bundles
    , (AssetId
aId, Quantity
q) <- case ValueNestedBundle
bundle of
        ValueNestedBundleAda Quantity
q -> [(AssetId
AdaAssetId, Quantity
q)]
        ValueNestedBundle PolicyId
pId Map AssetName Quantity
qs ->
          [ (PolicyId -> AssetName -> AssetId
AssetId PolicyId
pId AssetName
aName, Quantity
q)
          | (AssetName
aName, Quantity
q) <- Map AssetName Quantity -> [Item (Map AssetName Quantity)]
forall l. IsList l => l -> [Item l]
toList Map AssetName Quantity
qs
          ]
    ]

instance ToJSON ValueNestedRep where
  toJSON :: ValueNestedRep -> Value
toJSON (ValueNestedRep [ValueNestedBundle]
bundles) = [Pair] -> Value
object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ (ValueNestedBundle -> Pair) -> [ValueNestedBundle] -> [Pair]
forall a b. (a -> b) -> [a] -> [b]
map ValueNestedBundle -> Pair
toPair [ValueNestedBundle]
bundles
   where
    toPair :: ValueNestedBundle -> (Aeson.Key, Aeson.Value)
    toPair :: ValueNestedBundle -> Pair
toPair (ValueNestedBundleAda Quantity
q) = (Key
"lovelace", Quantity -> Value
forall a. ToJSON a => a -> Value
toJSON Quantity
q)
    toPair (ValueNestedBundle PolicyId
pid Map AssetName Quantity
assets) = (Text -> Key
Aeson.fromText (Text -> Key) -> Text -> Key
forall a b. (a -> b) -> a -> b
$ PolicyId -> Text
renderPolicyId PolicyId
pid, Map AssetName Quantity -> Value
forall a. ToJSON a => a -> Value
toJSON Map AssetName Quantity
assets)

instance FromJSON ValueNestedRep where
  parseJSON :: Value -> Parser ValueNestedRep
parseJSON =
    String
-> (Object -> Parser ValueNestedRep)
-> Value
-> Parser ValueNestedRep
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"ValueNestedRep" ((Object -> Parser ValueNestedRep)
 -> Value -> Parser ValueNestedRep)
-> (Object -> Parser ValueNestedRep)
-> Value
-> Parser ValueNestedRep
forall a b. (a -> b) -> a -> b
$ \Object
obj ->
      [ValueNestedBundle] -> ValueNestedRep
ValueNestedRep
        ([ValueNestedBundle] -> ValueNestedRep)
-> Parser [ValueNestedBundle] -> Parser ValueNestedRep
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Parser ValueNestedBundle] -> Parser [ValueNestedBundle]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
forall (f :: * -> *) a. Applicative f => [f a] -> f [a]
sequenceA
          [ Pair -> Parser ValueNestedBundle
parsePid Pair
keyValTuple
          | Pair
keyValTuple <- Object -> [Item Object]
forall l. IsList l => l -> [Item l]
toList Object
obj
          ]
   where
    parsePid :: (Aeson.Key, Aeson.Value) -> Parser ValueNestedBundle
    parsePid :: Pair -> Parser ValueNestedBundle
parsePid (Key
"lovelace", Value
q) = Quantity -> ValueNestedBundle
ValueNestedBundleAda (Quantity -> ValueNestedBundle)
-> Parser Quantity -> Parser ValueNestedBundle
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser Quantity
forall a. FromJSON a => Value -> Parser a
parseJSON Value
q
    parsePid (Key -> Text
Aeson.toText -> Text
pid, Value
quantityBundleJson) = do
      ScriptHash
sHash <-
        (RawBytesHexError -> String)
-> Either RawBytesHexError ScriptHash -> Parser ScriptHash
forall (m :: * -> *) e a.
MonadFail m =>
(e -> String) -> Either e a -> m a
failEitherWith
          (\RawBytesHexError
e -> String
"Failure when deserialising PolicyId: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ RawBytesHexError -> String
forall a. Error a => a -> String
displayError RawBytesHexError
e)
          (Either RawBytesHexError ScriptHash -> Parser ScriptHash)
-> Either RawBytesHexError ScriptHash -> Parser ScriptHash
forall a b. (a -> b) -> a -> b
$ AsType ScriptHash
-> ByteString -> Either RawBytesHexError ScriptHash
forall a.
SerialiseAsRawBytes a =>
AsType a -> ByteString -> Either RawBytesHexError a
deserialiseFromRawBytesHex AsType ScriptHash
AsScriptHash
          (ByteString -> Either RawBytesHexError ScriptHash)
-> ByteString -> Either RawBytesHexError ScriptHash
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
Text.encodeUtf8 Text
pid
      PolicyId -> Map AssetName Quantity -> ValueNestedBundle
ValueNestedBundle (ScriptHash -> PolicyId
PolicyId ScriptHash
sHash) (Map AssetName Quantity -> ValueNestedBundle)
-> Parser (Map AssetName Quantity) -> Parser ValueNestedBundle
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser (Map AssetName Quantity)
forall a. FromJSON a => Value -> Parser a
parseJSON Value
quantityBundleJson

-- ----------------------------------------------------------------------------
-- Printing and pretty-printing
--

-- | Render a textual representation of a 'Value'.
renderValue :: Value -> Text
renderValue :: Value -> Text
renderValue = Text -> Value -> Text
renderValueSep Text
" + "

-- | Render a \"prettified\" textual representation of a 'Value'.
renderValuePretty :: Value -> Text
renderValuePretty :: Value -> Text
renderValuePretty = Text -> Value -> Text
renderValueSep (Text -> Value -> Text) -> Text -> Value -> Text
forall a b. (a -> b) -> a -> b
$ Text
"\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text -> Text
Text.replicate Int
4 Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"+ "

renderValueSep :: Text -> Value -> Text
renderValueSep :: Text -> Value -> Text
renderValueSep Text
sep Value
v =
  if [(AssetId, Quantity)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
List.null [(AssetId, Quantity)]
valueList
    then Text
"0 lovelace"
    else Text -> [Text] -> Text
Text.intercalate Text
sep (((AssetId, Quantity) -> Text) -> [(AssetId, Quantity)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (AssetId, Quantity) -> Text
renderAssetIdQuantityPair [(AssetId, Quantity)]
valueList)
 where
  valueList :: [(AssetId, Quantity)]
  valueList :: [(AssetId, Quantity)]
valueList = Value -> [(AssetId, Quantity)]
valueToList Value
v

renderAssetIdQuantityPair :: (AssetId, Quantity) -> Text
renderAssetIdQuantityPair :: (AssetId, Quantity) -> Text
renderAssetIdQuantityPair (AssetId
aId, Quantity
quant) =
  String -> Text
Text.pack (Quantity -> String
forall a. Show a => a -> String
show Quantity
quant) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> AssetId -> Text
renderAssetId AssetId
aId

renderPolicyId :: PolicyId -> Text
renderPolicyId :: PolicyId -> Text
renderPolicyId (PolicyId ScriptHash
scriptHash) = ScriptHash -> Text
forall a. SerialiseAsRawBytes a => a -> Text
serialiseToRawBytesHexText ScriptHash
scriptHash

renderAssetId :: AssetId -> Text
renderAssetId :: AssetId -> Text
renderAssetId AssetId
AdaAssetId = Text
"lovelace"
renderAssetId (AssetId PolicyId
polId (AssetName ByteString
"")) = PolicyId -> Text
renderPolicyId PolicyId
polId
renderAssetId (AssetId PolicyId
polId AssetName
assetName) =
  PolicyId -> Text
renderPolicyId PolicyId
polId Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> AssetName -> Text
forall a. SerialiseAsRawBytes a => a -> Text
serialiseToRawBytesHexText AssetName
assetName