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

-- | Currency values
--
module Cardano.Api.Value
  ( Lovelace(..)

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

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

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

    -- ** Rendering
  , renderValue
  , renderValuePretty

    -- * Internal conversion functions
  , toByronLovelace
  , fromByronLovelace
  , toShelleyLovelace
  , fromShelleyLovelace
  , fromShelleyDeltaLovelace
  , toMaryValue
  , fromMaryValue

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

import           Data.Aeson (FromJSON, FromJSONKey, ToJSON, object, parseJSON, toJSON, withObject)
import qualified Data.Aeson as Aeson
import qualified Data.Aeson.Key as Aeson
import qualified Data.Aeson.KeyMap as KeyMap
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 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 qualified Cardano.Chain.Common as Byron
import qualified Cardano.Ledger.Coin as Shelley
import           Cardano.Ledger.Crypto (StandardCrypto)

import           Cardano.Api.Error (displayError)
import           Cardano.Api.HasTypeProxy
import           Cardano.Api.Script
import           Cardano.Api.SerialiseCBOR
import           Cardano.Api.SerialiseRaw
import           Cardano.Api.SerialiseUsing
import           Cardano.Api.Utils (failEitherWith)
import           Cardano.Ledger.Mary.Value (MaryValue (..))
import qualified Cardano.Ledger.Mary.Value as Mary
import qualified Cardano.Ledger.ShelleyMA.Rules as Shelley

-- ----------------------------------------------------------------------------
-- Lovelace
--

newtype Lovelace = Lovelace Integer
  deriving stock (Lovelace -> Lovelace -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Lovelace -> Lovelace -> Bool
$c/= :: Lovelace -> Lovelace -> Bool
== :: Lovelace -> Lovelace -> Bool
$c== :: Lovelace -> Lovelace -> Bool
Eq, Eq Lovelace
Lovelace -> Lovelace -> Bool
Lovelace -> Lovelace -> Ordering
Lovelace -> Lovelace -> Lovelace
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
min :: Lovelace -> Lovelace -> Lovelace
$cmin :: Lovelace -> Lovelace -> Lovelace
max :: Lovelace -> Lovelace -> Lovelace
$cmax :: Lovelace -> Lovelace -> Lovelace
>= :: Lovelace -> Lovelace -> Bool
$c>= :: Lovelace -> Lovelace -> Bool
> :: Lovelace -> Lovelace -> Bool
$c> :: Lovelace -> Lovelace -> Bool
<= :: Lovelace -> Lovelace -> Bool
$c<= :: Lovelace -> Lovelace -> Bool
< :: Lovelace -> Lovelace -> Bool
$c< :: Lovelace -> Lovelace -> Bool
compare :: Lovelace -> Lovelace -> Ordering
$ccompare :: Lovelace -> Lovelace -> Ordering
Ord, Int -> Lovelace -> ShowS
[Lovelace] -> ShowS
Lovelace -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Lovelace] -> ShowS
$cshowList :: [Lovelace] -> ShowS
show :: Lovelace -> String
$cshow :: Lovelace -> String
showsPrec :: Int -> Lovelace -> ShowS
$cshowsPrec :: Int -> Lovelace -> ShowS
Show)
  deriving newtype (Int -> Lovelace
Lovelace -> Int
Lovelace -> [Lovelace]
Lovelace -> Lovelace
Lovelace -> Lovelace -> [Lovelace]
Lovelace -> Lovelace -> Lovelace -> [Lovelace]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Lovelace -> Lovelace -> Lovelace -> [Lovelace]
$cenumFromThenTo :: Lovelace -> Lovelace -> Lovelace -> [Lovelace]
enumFromTo :: Lovelace -> Lovelace -> [Lovelace]
$cenumFromTo :: Lovelace -> Lovelace -> [Lovelace]
enumFromThen :: Lovelace -> Lovelace -> [Lovelace]
$cenumFromThen :: Lovelace -> Lovelace -> [Lovelace]
enumFrom :: Lovelace -> [Lovelace]
$cenumFrom :: Lovelace -> [Lovelace]
fromEnum :: Lovelace -> Int
$cfromEnum :: Lovelace -> Int
toEnum :: Int -> Lovelace
$ctoEnum :: Int -> Lovelace
pred :: Lovelace -> Lovelace
$cpred :: Lovelace -> Lovelace
succ :: Lovelace -> Lovelace
$csucc :: Lovelace -> Lovelace
Enum, Num Lovelace
Ord Lovelace
Lovelace -> Rational
forall a. Num a -> Ord a -> (a -> Rational) -> Real a
toRational :: Lovelace -> Rational
$ctoRational :: Lovelace -> Rational
Real, Enum Lovelace
Real Lovelace
Lovelace -> Integer
Lovelace -> Lovelace -> (Lovelace, Lovelace)
Lovelace -> Lovelace -> Lovelace
forall a.
Real a
-> Enum a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
toInteger :: Lovelace -> Integer
$ctoInteger :: Lovelace -> Integer
divMod :: Lovelace -> Lovelace -> (Lovelace, Lovelace)
$cdivMod :: Lovelace -> Lovelace -> (Lovelace, Lovelace)
quotRem :: Lovelace -> Lovelace -> (Lovelace, Lovelace)
$cquotRem :: Lovelace -> Lovelace -> (Lovelace, Lovelace)
mod :: Lovelace -> Lovelace -> Lovelace
$cmod :: Lovelace -> Lovelace -> Lovelace
div :: Lovelace -> Lovelace -> Lovelace
$cdiv :: Lovelace -> Lovelace -> Lovelace
rem :: Lovelace -> Lovelace -> Lovelace
$crem :: Lovelace -> Lovelace -> Lovelace
quot :: Lovelace -> Lovelace -> Lovelace
$cquot :: Lovelace -> Lovelace -> Lovelace
Integral, Integer -> Lovelace
Lovelace -> Lovelace
Lovelace -> Lovelace -> Lovelace
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> Lovelace
$cfromInteger :: Integer -> Lovelace
signum :: Lovelace -> Lovelace
$csignum :: Lovelace -> Lovelace
abs :: Lovelace -> Lovelace
$cabs :: Lovelace -> Lovelace
negate :: Lovelace -> Lovelace
$cnegate :: Lovelace -> Lovelace
* :: Lovelace -> Lovelace -> Lovelace
$c* :: Lovelace -> Lovelace -> Lovelace
- :: Lovelace -> Lovelace -> Lovelace
$c- :: Lovelace -> Lovelace -> Lovelace
+ :: Lovelace -> Lovelace -> Lovelace
$c+ :: Lovelace -> Lovelace -> Lovelace
Num, [Lovelace] -> Value
[Lovelace] -> Encoding
Lovelace -> Value
Lovelace -> Encoding
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [Lovelace] -> Encoding
$ctoEncodingList :: [Lovelace] -> Encoding
toJSONList :: [Lovelace] -> Value
$ctoJSONList :: [Lovelace] -> Value
toEncoding :: Lovelace -> Encoding
$ctoEncoding :: Lovelace -> Encoding
toJSON :: Lovelace -> Value
$ctoJSON :: Lovelace -> Value
ToJSON, Value -> Parser [Lovelace]
Value -> Parser Lovelace
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [Lovelace]
$cparseJSONList :: Value -> Parser [Lovelace]
parseJSON :: Value -> Parser Lovelace
$cparseJSON :: Value -> Parser Lovelace
FromJSON, Typeable Lovelace
Lovelace -> Encoding
(forall t. ToCBOR t => Proxy t -> Size) -> Proxy [Lovelace] -> Size
(forall t. ToCBOR t => Proxy t -> Size) -> Proxy Lovelace -> Size
forall a.
Typeable a
-> (a -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size) -> Proxy a -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size) -> Proxy [a] -> Size)
-> ToCBOR a
encodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size) -> Proxy [Lovelace] -> Size
$cencodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size) -> Proxy [Lovelace] -> Size
encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size) -> Proxy Lovelace -> Size
$cencodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size) -> Proxy Lovelace -> Size
toCBOR :: Lovelace -> Encoding
$ctoCBOR :: Lovelace -> Encoding
ToCBOR, Typeable Lovelace
Proxy Lovelace -> Text
forall s. Decoder s Lovelace
forall a.
Typeable a
-> (forall s. Decoder s a) -> (Proxy a -> Text) -> FromCBOR a
label :: Proxy Lovelace -> Text
$clabel :: Proxy Lovelace -> Text
fromCBOR :: forall s. Decoder s Lovelace
$cfromCBOR :: forall s. Decoder s Lovelace
FromCBOR)

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

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


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

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

toShelleyLovelace :: Lovelace -> Shelley.Coin
toShelleyLovelace :: Lovelace -> Coin
toShelleyLovelace (Lovelace Integer
l) = Integer -> Coin
Shelley.Coin Integer
l
--TODO: validate bounds

fromShelleyLovelace :: Shelley.Coin -> Lovelace
fromShelleyLovelace :: Coin -> Lovelace
fromShelleyLovelace (Shelley.Coin Integer
l) = Integer -> Lovelace
Lovelace Integer
l

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


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

newtype Quantity = Quantity Integer
  deriving newtype (Quantity -> Quantity -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Quantity -> Quantity -> Bool
$c/= :: Quantity -> Quantity -> Bool
== :: Quantity -> Quantity -> Bool
$c== :: Quantity -> Quantity -> Bool
Eq, Eq 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
min :: Quantity -> Quantity -> Quantity
$cmin :: Quantity -> Quantity -> Quantity
max :: Quantity -> Quantity -> Quantity
$cmax :: Quantity -> Quantity -> Quantity
>= :: Quantity -> Quantity -> Bool
$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
compare :: Quantity -> Quantity -> Ordering
$ccompare :: Quantity -> Quantity -> Ordering
Ord, Integer -> Quantity
Quantity -> Quantity
Quantity -> Quantity -> Quantity
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> Quantity
$cfromInteger :: Integer -> Quantity
signum :: Quantity -> Quantity
$csignum :: Quantity -> Quantity
abs :: Quantity -> Quantity
$cabs :: Quantity -> Quantity
negate :: Quantity -> Quantity
$cnegate :: Quantity -> Quantity
* :: Quantity -> Quantity -> Quantity
$c* :: Quantity -> Quantity -> Quantity
- :: Quantity -> Quantity -> Quantity
$c- :: Quantity -> Quantity -> Quantity
+ :: Quantity -> Quantity -> Quantity
$c+ :: Quantity -> Quantity -> Quantity
Num, Int -> Quantity -> ShowS
[Quantity] -> ShowS
Quantity -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Quantity] -> ShowS
$cshowList :: [Quantity] -> ShowS
show :: Quantity -> String
$cshow :: Quantity -> String
showsPrec :: Int -> Quantity -> ShowS
$cshowsPrec :: Int -> Quantity -> ShowS
Show, [Quantity] -> Value
[Quantity] -> Encoding
Quantity -> Value
Quantity -> Encoding
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [Quantity] -> Encoding
$ctoEncodingList :: [Quantity] -> Encoding
toJSONList :: [Quantity] -> Value
$ctoJSONList :: [Quantity] -> Value
toEncoding :: Quantity -> Encoding
$ctoEncoding :: Quantity -> Encoding
toJSON :: Quantity -> Value
$ctoJSON :: Quantity -> Value
ToJSON, Value -> Parser [Quantity]
Value -> Parser Quantity
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [Quantity]
$cparseJSONList :: Value -> Parser [Quantity]
parseJSON :: Value -> Parser Quantity
$cparseJSON :: Value -> Parser Quantity
FromJSON)

instance Semigroup Quantity where
  Quantity Integer
a <> :: Quantity -> Quantity -> Quantity
<> Quantity Integer
b = Integer -> Quantity
Quantity (Integer
a 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 (Lovelace Integer
x) = Integer -> Quantity
Quantity Integer
x

quantityToLovelace :: Quantity -> Lovelace
quantityToLovelace :: Quantity -> Lovelace
quantityToLovelace (Quantity Integer
x) = Integer -> Lovelace
Lovelace Integer
x


newtype PolicyId = PolicyId { PolicyId -> ScriptHash
unPolicyId :: ScriptHash }
  deriving stock (PolicyId -> PolicyId -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PolicyId -> PolicyId -> Bool
$c/= :: PolicyId -> PolicyId -> Bool
== :: PolicyId -> PolicyId -> Bool
$c== :: PolicyId -> PolicyId -> Bool
Eq, Eq 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
min :: PolicyId -> PolicyId -> PolicyId
$cmin :: PolicyId -> PolicyId -> PolicyId
max :: PolicyId -> PolicyId -> PolicyId
$cmax :: PolicyId -> PolicyId -> PolicyId
>= :: PolicyId -> PolicyId -> Bool
$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
compare :: PolicyId -> PolicyId -> Ordering
$ccompare :: PolicyId -> PolicyId -> Ordering
Ord)
  deriving (Int -> PolicyId -> ShowS
[PolicyId] -> ShowS
PolicyId -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PolicyId] -> ShowS
$cshowList :: [PolicyId] -> ShowS
show :: PolicyId -> String
$cshow :: PolicyId -> String
showsPrec :: Int -> PolicyId -> ShowS
$cshowsPrec :: Int -> PolicyId -> ShowS
Show, String -> PolicyId
forall a. (String -> a) -> IsString a
fromString :: String -> PolicyId
$cfromString :: String -> PolicyId
IsString, [PolicyId] -> Value
[PolicyId] -> Encoding
PolicyId -> Value
PolicyId -> Encoding
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [PolicyId] -> Encoding
$ctoEncodingList :: [PolicyId] -> Encoding
toJSONList :: [PolicyId] -> Value
$ctoJSONList :: [PolicyId] -> Value
toEncoding :: PolicyId -> Encoding
$ctoEncoding :: PolicyId -> Encoding
toJSON :: PolicyId -> Value
$ctoJSON :: PolicyId -> Value
ToJSON, Value -> Parser [PolicyId]
Value -> Parser PolicyId
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [PolicyId]
$cparseJSONList :: Value -> Parser [PolicyId]
parseJSON :: Value -> Parser PolicyId
$cparseJSON :: Value -> Parser 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) = 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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall lang. Script lang -> ScriptHash
hashScript


newtype AssetName = AssetName ByteString
  deriving stock (AssetName -> AssetName -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AssetName -> AssetName -> Bool
$c/= :: AssetName -> AssetName -> Bool
== :: AssetName -> AssetName -> Bool
$c== :: AssetName -> AssetName -> Bool
Eq, Eq 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
min :: AssetName -> AssetName -> AssetName
$cmin :: AssetName -> AssetName -> AssetName
max :: AssetName -> AssetName -> AssetName
$cmax :: AssetName -> AssetName -> AssetName
>= :: AssetName -> AssetName -> Bool
$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
compare :: AssetName -> AssetName -> Ordering
$ccompare :: AssetName -> AssetName -> Ordering
Ord)
  deriving newtype (Int -> AssetName -> ShowS
[AssetName] -> ShowS
AssetName -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AssetName] -> ShowS
$cshowList :: [AssetName] -> ShowS
show :: AssetName -> String
$cshow :: AssetName -> String
showsPrec :: Int -> AssetName -> ShowS
$cshowsPrec :: Int -> AssetName -> ShowS
Show)
  deriving ([AssetName] -> Value
[AssetName] -> Encoding
AssetName -> Value
AssetName -> Encoding
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [AssetName] -> Encoding
$ctoEncodingList :: [AssetName] -> Encoding
toJSONList :: [AssetName] -> Value
$ctoJSONList :: [AssetName] -> Value
toEncoding :: AssetName -> Encoding
$ctoEncoding :: AssetName -> Encoding
toJSON :: AssetName -> Value
$ctoJSON :: AssetName -> Value
ToJSON, Value -> Parser [AssetName]
Value -> Parser AssetName
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [AssetName]
$cparseJSONList :: Value -> Parser [AssetName]
parseJSON :: Value -> Parser AssetName
$cparseJSON :: Value -> Parser AssetName
FromJSON, ToJSONKeyFunction [AssetName]
ToJSONKeyFunction AssetName
forall a.
ToJSONKeyFunction a -> ToJSONKeyFunction [a] -> ToJSONKey a
toJSONKeyList :: ToJSONKeyFunction [AssetName]
$ctoJSONKeyList :: ToJSONKeyFunction [AssetName]
toJSONKey :: ToJSONKeyFunction AssetName
$ctoJSONKey :: ToJSONKeyFunction AssetName
ToJSONKey, FromJSONKeyFunction [AssetName]
FromJSONKeyFunction AssetName
forall a.
FromJSONKeyFunction a -> FromJSONKeyFunction [a] -> FromJSONKey a
fromJSONKeyList :: FromJSONKeyFunction [AssetName]
$cfromJSONKeyList :: FromJSONKeyFunction [AssetName]
fromJSONKey :: FromJSONKeyFunction AssetName
$cfromJSONKey :: 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 forall a. Ord a => a -> a -> Bool
<= Int
32 = ByteString -> AssetName
AssetName (String -> ByteString
BSC.pack String
s)
      | Bool
otherwise          = 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 forall a. Ord a => a -> a -> Bool
<= Int
32 = forall a b. b -> Either a b
Right (ByteString -> AssetName
AssetName ByteString
bs)
      | Bool
otherwise          = forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ String -> SerialiseAsRawBytesError
SerialiseAsRawBytesError forall a b. (a -> b) -> a -> b
$
          String
"Unable to deserialise AssetName (the bytestring should be no longer than 32 bytes long " 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
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AssetId -> AssetId -> Bool
$c/= :: AssetId -> AssetId -> Bool
== :: AssetId -> AssetId -> Bool
$c== :: AssetId -> AssetId -> Bool
Eq, Eq 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
min :: AssetId -> AssetId -> AssetId
$cmin :: AssetId -> AssetId -> AssetId
max :: AssetId -> AssetId -> AssetId
$cmax :: AssetId -> AssetId -> AssetId
>= :: AssetId -> AssetId -> Bool
$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
compare :: AssetId -> AssetId -> Ordering
$ccompare :: AssetId -> AssetId -> Ordering
Ord, Int -> AssetId -> ShowS
[AssetId] -> ShowS
AssetId -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AssetId] -> ShowS
$cshowList :: [AssetId] -> ShowS
show :: AssetId -> String
$cshow :: AssetId -> String
showsPrec :: Int -> AssetId -> ShowS
$cshowsPrec :: Int -> AssetId -> ShowS
Show)


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

instance Show Value where
  showsPrec :: Int -> Value -> ShowS
showsPrec Int
d Value
v = Bool -> ShowS -> ShowS
showParen (Int
d forall a. Ord a => a -> a -> Bool
> Int
10) forall a b. (a -> b) -> a -> b
$
    String -> ShowS
showString String
"valueFromList " forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> ShowS
shows (Value -> [(AssetId, Quantity)]
valueToList 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 forall k a. Map k a
Map.empty


{-# 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 =
    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
      forall (f :: * -> *) k x. Applicative f => WhenMissing f k x x
Map.preserveMissing
      forall (f :: * -> *) k x. Applicative f => WhenMissing f k x x
Map.preserveMissing
      (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 forall a. Semigroup a => a -> a -> a
<> Quantity
b of
        Quantity Integer
0 -> forall a. Maybe a
Nothing
        Quantity
c          -> forall a. a -> Maybe a
Just Quantity
c

instance ToJSON Value where
  toJSON :: Value -> Value
toJSON = forall a. ToJSON a => a -> Value
toJSON 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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 = forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault forall a. Monoid a => a
mempty AssetId
a Map AssetId Quantity
m

valueFromList :: [(AssetId, Quantity)] -> Value
valueFromList :: [(AssetId, Quantity)] -> Value
valueFromList = Map AssetId Quantity -> Value
Value
              forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter (forall a. Eq a => a -> a -> Bool
/= Quantity
0)
              forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith forall a. Semigroup a => a -> a -> a
(<>)

valueToList :: Value -> [(AssetId, Quantity)]
valueToList :: Value -> [(AssetId, Quantity)]
valueToList (Value Map AssetId Quantity
m) = forall k a. Map k a -> [(k, a)]
Map.toList Map AssetId Quantity
m

-- | 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 (forall a b k. (a -> b) -> Map k a -> Map k b
Map.map forall a. Num a => a -> a
negate Map AssetId Quantity
m)

filterValue :: (AssetId -> Bool) -> Value -> Value
filterValue :: (AssetId -> Bool) -> Value -> Value
filterValue AssetId -> Bool
p (Value Map AssetId Quantity
m) = Map AssetId Quantity -> Value
Value (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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. k -> a -> Map k a
Map.singleton AssetId
AdaAssetId 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
      []                -> forall a. a -> Maybe a
Just (Integer -> Lovelace
Lovelace Integer
0)
      [(AssetId
AdaAssetId, Quantity
q)] -> forall a. a -> Maybe a
Just (Quantity -> Lovelace
quantityToLovelace Quantity
q)
      [(AssetId, Quantity)]
_                 -> forall a. Maybe a
Nothing

toMaryValue :: Value -> MaryValue StandardCrypto
toMaryValue :: Value -> MaryValue StandardCrypto
toMaryValue Value
v =
    forall crypto.
Integer
-> Map (PolicyID crypto) (Map AssetName Integer)
-> MaryValue crypto
MaryValue Integer
lovelace Map (PolicyID StandardCrypto) (Map AssetName Integer)
other
  where
    Quantity Integer
lovelace = Value -> AssetId -> Quantity
selectAsset Value
v AssetId
AdaAssetId
      --TODO: write QC tests to show it's ok to use Map.fromAscListWith here
    other :: Map (PolicyID StandardCrypto) (Map AssetName Integer)
other = forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union
              [ (PolicyId -> PolicyID StandardCrypto
toMaryPolicyID PolicyId
pid, forall k a. k -> a -> Map k a
Map.singleton (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) = forall crypto. ScriptHash crypto -> PolicyID crypto
Mary.PolicyID (ScriptHash -> ScriptHash StandardCrypto
toShelleyScriptHash ScriptHash
sh)

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


fromMaryValue :: MaryValue StandardCrypto -> Value
fromMaryValue :: MaryValue StandardCrypto -> Value
fromMaryValue (MaryValue Integer
lovelace Map (PolicyID StandardCrypto) (Map AssetName Integer)
other) =
    Map AssetId Quantity -> Value
Value forall a b. (a -> b) -> a -> b
$
      --TODO: write QC tests to show it's ok to use Map.fromAscList here
      forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall a b. (a -> b) -> a -> b
$
        [ (AssetId
AdaAssetId, Integer -> Quantity
Quantity Integer
lovelace) | Integer
lovelace forall a. Eq a => a -> a -> Bool
/= Integer
0 ]
     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, Map AssetName Integer
as) <- forall k a. Map k a -> [(k, a)]
Map.toList Map (PolicyID StandardCrypto) (Map AssetName Integer)
other
        , (AssetName
name, Integer
q) <- forall k a. Map k a -> [(k, a)]
Map.toList Map AssetName Integer
as ]
  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 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 Lovelace
minUTxo =
  Coin -> Lovelace
fromShelleyLovelace forall a b. (a -> b) -> a -> b
$ forall v. Val v => v -> Coin -> Coin
Shelley.scaledMinDeposit (Value -> MaryValue StandardCrypto
toMaryValue Value
v) (Lovelace -> Coin
toShelleyLovelace Lovelace
minUTxo)

-- ----------------------------------------------------------------------------
-- 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
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ValueNestedRep -> ValueNestedRep -> Bool
$c/= :: ValueNestedRep -> ValueNestedRep -> Bool
== :: ValueNestedRep -> ValueNestedRep -> Bool
$c== :: ValueNestedRep -> ValueNestedRep -> Bool
Eq, Eq 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
min :: ValueNestedRep -> ValueNestedRep -> ValueNestedRep
$cmin :: ValueNestedRep -> ValueNestedRep -> ValueNestedRep
max :: ValueNestedRep -> ValueNestedRep -> ValueNestedRep
$cmax :: ValueNestedRep -> ValueNestedRep -> ValueNestedRep
>= :: ValueNestedRep -> ValueNestedRep -> Bool
$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
compare :: ValueNestedRep -> ValueNestedRep -> Ordering
$ccompare :: ValueNestedRep -> ValueNestedRep -> Ordering
Ord, Int -> ValueNestedRep -> ShowS
[ValueNestedRep] -> ShowS
ValueNestedRep -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ValueNestedRep] -> ShowS
$cshowList :: [ValueNestedRep] -> ShowS
show :: ValueNestedRep -> String
$cshow :: ValueNestedRep -> String
showsPrec :: Int -> ValueNestedRep -> ShowS
$cshowsPrec :: Int -> 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
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ValueNestedBundle -> ValueNestedBundle -> Bool
$c/= :: ValueNestedBundle -> ValueNestedBundle -> Bool
== :: ValueNestedBundle -> ValueNestedBundle -> Bool
$c== :: ValueNestedBundle -> ValueNestedBundle -> Bool
Eq, Eq 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
min :: ValueNestedBundle -> ValueNestedBundle -> ValueNestedBundle
$cmin :: ValueNestedBundle -> ValueNestedBundle -> ValueNestedBundle
max :: ValueNestedBundle -> ValueNestedBundle -> ValueNestedBundle
$cmax :: ValueNestedBundle -> ValueNestedBundle -> ValueNestedBundle
>= :: ValueNestedBundle -> ValueNestedBundle -> Bool
$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
compare :: ValueNestedBundle -> ValueNestedBundle -> Ordering
$ccompare :: ValueNestedBundle -> ValueNestedBundle -> Ordering
Ord, Int -> ValueNestedBundle -> ShowS
[ValueNestedBundle] -> ShowS
ValueNestedBundle -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ValueNestedBundle] -> ShowS
$cshowList :: [ValueNestedBundle] -> ShowS
show :: ValueNestedBundle -> String
$cshow :: ValueNestedBundle -> String
showsPrec :: Int -> ValueNestedBundle -> ShowS
$cshowsPrec :: Int -> 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 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 forall a. Eq a => a -> a -> Bool
/= Quantity
0 ]
     forall a. [a] -> [a] -> [a]
++ [ PolicyId -> Map AssetName Quantity -> ValueNestedBundle
ValueNestedBundle PolicyId
pId Map AssetName Quantity
qs | (PolicyId
pId, Map AssetName Quantity
qs) <- forall k a. Map k a -> [(k, a)]
Map.toList Map PolicyId (Map AssetName Quantity)
nonAdaAssets ]
  where
    nonAdaAssets :: Map PolicyId (Map AssetName Quantity)
    nonAdaAssets :: Map PolicyId (Map AssetName Quantity)
nonAdaAssets =
      forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith (forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith forall a. Semigroup a => a -> a -> a
(<>))
        [ (PolicyId
pId, 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) <- forall k a. Map k a -> [(k, a)]
Map.toList Map AssetName Quantity
qs ]
      ]

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

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

-- | Render a \"prettified\" textual representation of a 'Value'.
renderValuePretty :: Value -> Text
renderValuePretty :: Value -> Text
renderValuePretty Value
v =
    Text -> [Text] -> Text
Text.intercalate
      (Text
"\n" forall a. Semigroup a => a -> a -> a
<> Int -> Text -> Text
Text.replicate Int
4 Text
" " forall a. Semigroup a => a -> a -> a
<> Text
"+ ")
      (forall a b. (a -> b) -> [a] -> [b]
map (AssetId, Quantity) -> Text
renderAssetIdQuantityPair [(AssetId, Quantity)]
vals)
  where
    vals :: [(AssetId, Quantity)]
    vals :: [(AssetId, Quantity)]
vals = Value -> [(AssetId, Quantity)]
valueToList Value
v

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

renderPolicyId :: PolicyId -> Text
renderPolicyId :: PolicyId -> Text
renderPolicyId (PolicyId ScriptHash
scriptHash) = 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 forall a. Semigroup a => a -> a -> a
<> Text
"." forall a. Semigroup a => a -> a -> a
<> forall a. SerialiseAsRawBytes a => a -> Text
serialiseToRawBytesHexText AssetName
assetName