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

-- | 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           Prelude

import           Data.Aeson (FromJSON, FromJSONKey, ToJSON, object, parseJSON, toJSON, withObject)
import qualified Data.Aeson 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.HashMap.Strict as HashMap
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 qualified Cardano.Ledger.Mary.Value as Mary
import qualified Cardano.Ledger.ShelleyMA.Rules.Utxo as Shelley

import           Cardano.Api.HasTypeProxy
import           Cardano.Api.Script
import           Cardano.Api.SerialiseCBOR
import           Cardano.Api.SerialiseRaw
import           Cardano.Api.SerialiseUsing
import           Cardano.Api.Utils (note)


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

newtype Lovelace = Lovelace Integer
  deriving stock (Lovelace -> Lovelace -> Bool
(Lovelace -> Lovelace -> Bool)
-> (Lovelace -> Lovelace -> Bool) -> Eq Lovelace
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
Eq Lovelace
-> (Lovelace -> Lovelace -> Ordering)
-> (Lovelace -> Lovelace -> Bool)
-> (Lovelace -> Lovelace -> Bool)
-> (Lovelace -> Lovelace -> Bool)
-> (Lovelace -> Lovelace -> Bool)
-> (Lovelace -> Lovelace -> Lovelace)
-> (Lovelace -> Lovelace -> Lovelace)
-> Ord 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
$cp1Ord :: Eq Lovelace
Ord, Int -> Lovelace -> ShowS
[Lovelace] -> ShowS
Lovelace -> String
(Int -> Lovelace -> ShowS)
-> (Lovelace -> String) -> ([Lovelace] -> ShowS) -> Show Lovelace
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]
(Lovelace -> Lovelace)
-> (Lovelace -> Lovelace)
-> (Int -> Lovelace)
-> (Lovelace -> Int)
-> (Lovelace -> [Lovelace])
-> (Lovelace -> Lovelace -> [Lovelace])
-> (Lovelace -> Lovelace -> [Lovelace])
-> (Lovelace -> Lovelace -> Lovelace -> [Lovelace])
-> Enum 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, Integer -> Lovelace
Lovelace -> Lovelace
Lovelace -> Lovelace -> Lovelace
(Lovelace -> Lovelace -> Lovelace)
-> (Lovelace -> Lovelace -> Lovelace)
-> (Lovelace -> Lovelace -> Lovelace)
-> (Lovelace -> Lovelace)
-> (Lovelace -> Lovelace)
-> (Lovelace -> Lovelace)
-> (Integer -> Lovelace)
-> Num 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
(Lovelace -> Value)
-> (Lovelace -> Encoding)
-> ([Lovelace] -> Value)
-> ([Lovelace] -> Encoding)
-> ToJSON Lovelace
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
(Value -> Parser Lovelace)
-> (Value -> Parser [Lovelace]) -> FromJSON 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
Typeable Lovelace
-> (Lovelace -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy Lovelace -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy [Lovelace] -> Size)
-> ToCBOR 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
$cp1ToCBOR :: Typeable Lovelace
ToCBOR, Typeable Lovelace
Decoder s Lovelace
Typeable Lovelace
-> (forall s. Decoder s Lovelace)
-> (Proxy Lovelace -> Text)
-> FromCBOR 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 :: Decoder s Lovelace
$cfromCBOR :: forall s. Decoder s Lovelace
$cp1FromCBOR :: Typeable Lovelace
FromCBOR)

instance Semigroup Lovelace where
  Lovelace Integer
a <> :: Lovelace -> Lovelace -> Lovelace
<> Lovelace Integer
b = Integer -> Lovelace
Lovelace (Integer
a Integer -> Integer -> Integer
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
_  -> 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
Lovelace (Integer -> Lovelace)
-> (Lovelace -> 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
(Quantity -> Quantity -> Bool)
-> (Quantity -> Quantity -> Bool) -> Eq Quantity
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
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
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
$cp1Ord :: Eq 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
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
(Int -> Quantity -> ShowS)
-> (Quantity -> String) -> ([Quantity] -> ShowS) -> Show Quantity
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
(Quantity -> Value)
-> (Quantity -> Encoding)
-> ([Quantity] -> Value)
-> ([Quantity] -> Encoding)
-> ToJSON Quantity
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
(Value -> Parser Quantity)
-> (Value -> Parser [Quantity]) -> FromJSON 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 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 (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 ScriptHash
  deriving stock (PolicyId -> PolicyId -> Bool
(PolicyId -> PolicyId -> Bool)
-> (PolicyId -> PolicyId -> Bool) -> Eq PolicyId
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
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
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
$cp1Ord :: Eq 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
showList :: [PolicyId] -> ShowS
$cshowList :: [PolicyId] -> ShowS
show :: PolicyId -> String
$cshow :: PolicyId -> String
showsPrec :: Int -> PolicyId -> ShowS
$cshowsPrec :: Int -> PolicyId -> ShowS
Show, String -> PolicyId
(String -> PolicyId) -> IsString PolicyId
forall a. (String -> a) -> IsString a
fromString :: String -> PolicyId
$cfromString :: String -> PolicyId
IsString, [PolicyId] -> Value
[PolicyId] -> Encoding
PolicyId -> Value
PolicyId -> Encoding
(PolicyId -> Value)
-> (PolicyId -> Encoding)
-> ([PolicyId] -> Value)
-> ([PolicyId] -> Encoding)
-> ToJSON PolicyId
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
(Value -> Parser PolicyId)
-> (Value -> Parser [PolicyId]) -> FromJSON 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) = ScriptHash -> ByteString
forall a. SerialiseAsRawBytes a => a -> ByteString
serialiseToRawBytes ScriptHash
sh
    deserialiseFromRawBytes :: AsType PolicyId -> ByteString -> Maybe PolicyId
deserialiseFromRawBytes AsType PolicyId
AsPolicyId ByteString
bs =
      ScriptHash -> PolicyId
PolicyId (ScriptHash -> PolicyId) -> Maybe ScriptHash -> Maybe PolicyId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AsType ScriptHash -> ByteString -> Maybe ScriptHash
forall a.
SerialiseAsRawBytes a =>
AsType a -> ByteString -> Maybe a
deserialiseFromRawBytes AsType ScriptHash
AsScriptHash ByteString
bs

scriptPolicyId :: Script lang -> PolicyId
scriptPolicyId :: 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
/= :: AssetName -> AssetName -> Bool
$c/= :: AssetName -> AssetName -> Bool
== :: AssetName -> AssetName -> Bool
$c== :: 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
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
$cp1Ord :: Eq 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
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
(AssetName -> Value)
-> (AssetName -> Encoding)
-> ([AssetName] -> Value)
-> ([AssetName] -> Encoding)
-> ToJSON AssetName
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
(Value -> Parser AssetName)
-> (Value -> Parser [AssetName]) -> FromJSON 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
ToJSONKeyFunction AssetName
-> ToJSONKeyFunction [AssetName] -> ToJSONKey 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
FromJSONKeyFunction AssetName
-> FromJSONKeyFunction [AssetName] -> FromJSONKey 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 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 -> Maybe AssetName
deserialiseFromRawBytes AsType AssetName
AsAssetName ByteString
bs
      | ByteString -> Int
BS.length ByteString
bs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
32 = AssetName -> Maybe AssetName
forall a. a -> Maybe a
Just (ByteString -> AssetName
AssetName ByteString
bs)
      | Bool
otherwise          = Maybe AssetName
forall a. Maybe a
Nothing


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
/= :: AssetId -> AssetId -> Bool
$c/= :: AssetId -> AssetId -> Bool
== :: AssetId -> AssetId -> Bool
$c== :: 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
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
$cp1Ord :: Eq 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
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
(Value -> Value -> Bool) -> (Value -> Value -> Bool) -> Eq Value
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 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 -> [(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 Map AssetId Quantity
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 =
    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

valueFromList :: [(AssetId, Quantity)] -> Value
valueFromList :: [(AssetId, Quantity)] -> Value
valueFromList = 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
(<>)

valueToList :: Value -> [(AssetId, Quantity)]
valueToList :: Value -> [(AssetId, Quantity)]
valueToList (Value Map AssetId Quantity
m) = Map AssetId Quantity -> [(AssetId, Quantity)]
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 ((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)

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
Lovelace 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 -> Mary.Value StandardCrypto
toMaryValue :: Value -> Value StandardCrypto
toMaryValue Value
v =
    Integer
-> Map (PolicyID StandardCrypto) (Map AssetName Integer)
-> Value StandardCrypto
forall crypto.
Integer
-> Map (PolicyID crypto) (Map AssetName Integer) -> Value crypto
Mary.Value 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 = (Map AssetName Integer
 -> Map AssetName Integer -> Map AssetName Integer)
-> [(PolicyID StandardCrypto, Map AssetName Integer)]
-> Map (PolicyID StandardCrypto) (Map AssetName Integer)
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith Map AssetName Integer
-> Map AssetName Integer -> Map AssetName Integer
forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union
              [ (PolicyId -> PolicyID StandardCrypto
toMaryPolicyID PolicyId
pid, AssetName -> Integer -> Map AssetName Integer
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) = ScriptHash StandardCrypto -> PolicyID StandardCrypto
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) = ByteString -> AssetName
Mary.AssetName ByteString
n


fromMaryValue :: Mary.Value StandardCrypto -> Value
fromMaryValue :: Value StandardCrypto -> Value
fromMaryValue (Mary.Value Integer
lovelace Map (PolicyID StandardCrypto) (Map AssetName Integer)
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
      [(AssetId, Quantity)] -> Map AssetId Quantity
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(AssetId, Quantity)] -> Map AssetId Quantity)
-> [(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, Map AssetName Integer
as) <- Map (PolicyID StandardCrypto) (Map AssetName Integer)
-> [(PolicyID StandardCrypto, Map AssetName Integer)]
forall k a. Map k a -> [(k, a)]
Map.toList Map (PolicyID StandardCrypto) (Map AssetName Integer)
other
        , (AssetName
name, Integer
q) <- Map AssetName Integer -> [(AssetName, Integer)]
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 ByteString
n) = ByteString -> AssetName
AssetName ByteString
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 (Coin -> Lovelace) -> Coin -> Lovelace
forall a b. (a -> b) -> a -> b
$ Value StandardCrypto -> Coin -> Coin
forall v. Val v => v -> Coin -> Coin
Shelley.scaledMinDeposit (Value -> Value 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
(ValueNestedRep -> ValueNestedRep -> Bool)
-> (ValueNestedRep -> ValueNestedRep -> Bool) -> Eq ValueNestedRep
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
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
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
$cp1Ord :: Eq 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
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
(ValueNestedBundle -> ValueNestedBundle -> Bool)
-> (ValueNestedBundle -> ValueNestedBundle -> Bool)
-> Eq ValueNestedBundle
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
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
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
$cp1Ord :: Eq 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
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 ([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)
-> [(PolicyId, Map AssetName Quantity)]
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 =
      (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 -> [(AssetName, Quantity)]
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 ([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 -> (Text, Aeson.Value)
     toPair :: ValueNestedBundle -> Pair
toPair (ValueNestedBundleAda Quantity
q) = (Text
"lovelace", Quantity -> Value
forall a. ToJSON a => a -> Value
toJSON Quantity
q)
     toPair (ValueNestedBundle PolicyId
pid Map AssetName Quantity
assets) = (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)
sequenceA [ Pair -> Parser ValueNestedBundle
parsePid Pair
keyValTuple
                                   | Pair
keyValTuple <- Object -> [Pair]
forall k v. HashMap k v -> [(k, v)]
HashMap.toList Object
obj ]
    where
      parsePid :: (Text, Aeson.Value) -> Parser ValueNestedBundle
      parsePid :: Pair -> Parser ValueNestedBundle
parsePid (Text
"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 (Text
pid, Value
quantityBundleJson) = do
        ScriptHash
sHash <-
          String -> Maybe ScriptHash -> Parser ScriptHash
forall (m :: * -> *) a. MonadFail m => String -> Maybe a -> m a
note (String
"Expected hex encoded PolicyId but got: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
Text.unpack Text
pid) (Maybe ScriptHash -> Parser ScriptHash)
-> Maybe ScriptHash -> Parser ScriptHash
forall a b. (a -> b) -> a -> b
$
          AsType ScriptHash -> ByteString -> Maybe ScriptHash
forall a.
SerialiseAsRawBytes a =>
AsType a -> ByteString -> Maybe a
deserialiseFromRawBytesHex AsType ScriptHash
AsScriptHash (ByteString -> Maybe ScriptHash) -> ByteString -> Maybe ScriptHash
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
Text.encodeUtf8 Text
pid
        Map AssetName Quantity
quantityBundle <- Value -> Parser (Map AssetName Quantity)
forall a. FromJSON a => Value -> Parser a
parseJSON Value
quantityBundleJson
        ValueNestedBundle -> Parser ValueNestedBundle
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ValueNestedBundle -> Parser ValueNestedBundle)
-> ValueNestedBundle -> Parser ValueNestedBundle
forall a b. (a -> b) -> a -> b
$ PolicyId -> Map AssetName Quantity -> ValueNestedBundle
ValueNestedBundle (ScriptHash -> PolicyId
PolicyId ScriptHash
sHash) Map AssetName Quantity
quantityBundle


-- ----------------------------------------------------------------------------
-- 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
" + "
      (((AssetId, Quantity) -> Text) -> [(AssetId, Quantity)] -> [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" 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
"+ ")
      (((AssetId, Quantity) -> Text) -> [(AssetId, Quantity)] -> [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 (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