{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}

module Cardano.Ledger.Mary.Value (
  PolicyID (..),
  AssetName (..),
  MaryValue (..),
  MultiAsset (..),
  insert,
  insertMultiAsset,
  lookup,
  lookupMultiAsset,
  multiAssetFromList,
  policies,
  mapMaybeMultiAsset,
  filterMultiAsset,
  pruneZeroMultiAsset,
  representationSize,
  showValue,
  flattenMultiAsset,
  valueFromList,
  CompactValue (..),
  CompactForm (CompactValue),
  isMultiAssetSmallEnough,
  assetNameToTextAsHex,

  -- * Deprecated
  prune,
)
where

import qualified Cardano.Crypto.Hash.Class as Hash
import Cardano.Ledger.BaseTypes (Inject (..))
import Cardano.Ledger.Binary (
  DecCBOR (..),
  Decoder,
  DecoderError (..),
  EncCBOR (..),
  TokenType (..),
  cborError,
  decodeInteger,
  decodeMap,
  decodeWord64,
  ifDecoderVersionAtLeast,
  peekTokenType,
 )
import Cardano.Ledger.Binary.Coders (
  Decode (..),
  Encode (..),
  decode,
  encode,
  (!>),
  (<!),
 )
import Cardano.Ledger.Binary.Version (natVersion)
import Cardano.Ledger.Coin (Coin (..), integerToWord64)
import Cardano.Ledger.Compactible (Compactible (..))
import Cardano.Ledger.Core
import Cardano.Ledger.Val (Val (..))
import Control.DeepSeq (NFData (..), deepseq, rwhnf)
import Control.Exception (assert)
import Control.Monad (forM_, guard, unless, when)
import Control.Monad.ST (runST)
import Data.Aeson (FromJSON, FromJSONKey, ToJSON (..), object, (.=))
import qualified Data.Aeson as Aeson
import Data.Aeson.Types (ToJSONKey (..), toJSONKeyText)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Base16 as BS16
import qualified Data.ByteString.Short as SBS
import Data.ByteString.Short.Internal (ShortByteString (SBS))
import Data.CanonicalMaps (
  canonicalMap,
  canonicalMapUnion,
  pointWise,
 )
import Data.Foldable (foldMap')
import Data.Group (Abelian, Group (..))
import Data.Int (Int64)
import Data.List (sortOn)
import Data.Map (Map)
import Data.Map.Internal (
  link,
  link2,
 )
import Data.Map.Strict (assocs)
import qualified Data.Map.Strict as Map
import Data.Maybe (fromJust)
import qualified Data.Monoid as M (Sum (Sum, getSum))
import qualified Data.Primitive.ByteArray as BA
import Data.Proxy (Proxy (..))
import qualified Data.Semigroup as Semigroup (Sum (..))
import Data.Set (Set)
import qualified Data.Set as Set
import Data.Text (Text)
import Data.Text.Encoding (decodeLatin1)
import Data.Typeable (Typeable)
import Data.Word (Word16, Word32, Word64)
import GHC.Generics (Generic)
import NoThunks.Class (NoThunks (..), OnlyCheckWhnfNamed (..))
import Prelude hiding (lookup)

-- | Asset Name
newtype AssetName = AssetName {AssetName -> ShortByteString
assetNameBytes :: SBS.ShortByteString}
  deriving newtype
    ( 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
    , Typeable AssetName
AssetName -> Encoding
(forall t. EncCBOR t => Proxy t -> Size)
-> Proxy [AssetName] -> Size
(forall t. EncCBOR t => Proxy t -> Size) -> Proxy AssetName -> Size
forall a.
Typeable a
-> (a -> Encoding)
-> ((forall t. EncCBOR t => Proxy t -> Size) -> Proxy a -> Size)
-> ((forall t. EncCBOR t => Proxy t -> Size) -> Proxy [a] -> Size)
-> EncCBOR a
encodedListSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size)
-> Proxy [AssetName] -> Size
$cencodedListSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size)
-> Proxy [AssetName] -> Size
encodedSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size) -> Proxy AssetName -> Size
$cencodedSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size) -> Proxy AssetName -> Size
encCBOR :: AssetName -> Encoding
$cencCBOR :: AssetName -> Encoding
EncCBOR
    , 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
    , Context -> AssetName -> IO (Maybe ThunkInfo)
Proxy AssetName -> [Char]
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> [Char])
-> NoThunks a
showTypeOf :: Proxy AssetName -> [Char]
$cshowTypeOf :: Proxy AssetName -> [Char]
wNoThunks :: Context -> AssetName -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> AssetName -> IO (Maybe ThunkInfo)
noThunks :: Context -> AssetName -> IO (Maybe ThunkInfo)
$cnoThunks :: Context -> AssetName -> IO (Maybe ThunkInfo)
NoThunks
    , AssetName -> ()
forall a. (a -> ()) -> NFData a
rnf :: AssetName -> ()
$crnf :: AssetName -> ()
NFData
    )

instance Show AssetName where
  show :: AssetName -> [Char]
show = forall a. Show a => a -> [Char]
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. AssetName -> ByteString
assetNameToBytesAsHex

assetNameToBytesAsHex :: AssetName -> BS.ByteString
assetNameToBytesAsHex :: AssetName -> ByteString
assetNameToBytesAsHex = ByteString -> ByteString
BS16.encode forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortByteString -> ByteString
SBS.fromShort forall b c a. (b -> c) -> (a -> b) -> a -> c
. AssetName -> ShortByteString
assetNameBytes

assetNameToTextAsHex :: AssetName -> Text
assetNameToTextAsHex :: AssetName -> Text
assetNameToTextAsHex = ByteString -> Text
decodeLatin1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. AssetName -> ByteString
assetNameToBytesAsHex

instance DecCBOR AssetName where
  decCBOR :: forall s. Decoder s AssetName
decCBOR = do
    ShortByteString
an <- forall a s. DecCBOR a => Decoder s a
decCBOR
    if ShortByteString -> Int
SBS.length ShortByteString
an forall a. Ord a => a -> a -> Bool
> Int
32
      then
        forall (m :: * -> *) e a. (MonadFail m, Buildable e) => e -> m a
cborError forall a b. (a -> b) -> a -> b
$
          Text -> Text -> DecoderError
DecoderErrorCustom Text
"asset name exceeds 32 bytes:" forall a b. (a -> b) -> a -> b
$
            AssetName -> Text
assetNameToTextAsHex forall a b. (a -> b) -> a -> b
$
              ShortByteString -> AssetName
AssetName ShortByteString
an
      else forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ ShortByteString -> AssetName
AssetName ShortByteString
an

-- | Policy ID
newtype PolicyID = PolicyID {PolicyID -> ScriptHash
policyID :: ScriptHash}
  deriving
    ( Int -> PolicyID -> ShowS
[PolicyID] -> ShowS
PolicyID -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [PolicyID] -> ShowS
$cshowList :: [PolicyID] -> ShowS
show :: PolicyID -> [Char]
$cshow :: PolicyID -> [Char]
showsPrec :: Int -> PolicyID -> ShowS
$cshowsPrec :: Int -> PolicyID -> ShowS
Show
    , 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
    , forall x. Rep PolicyID x -> PolicyID
forall x. PolicyID -> Rep PolicyID x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PolicyID x -> PolicyID
$cfrom :: forall x. PolicyID -> Rep PolicyID x
Generic
    , Context -> PolicyID -> IO (Maybe ThunkInfo)
Proxy PolicyID -> [Char]
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> [Char])
-> NoThunks a
showTypeOf :: Proxy PolicyID -> [Char]
$cshowTypeOf :: Proxy PolicyID -> [Char]
wNoThunks :: Context -> PolicyID -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> PolicyID -> IO (Maybe ThunkInfo)
noThunks :: Context -> PolicyID -> IO (Maybe ThunkInfo)
$cnoThunks :: Context -> PolicyID -> IO (Maybe ThunkInfo)
NoThunks
    , PolicyID -> ()
forall a. (a -> ()) -> NFData a
rnf :: PolicyID -> ()
$crnf :: PolicyID -> ()
NFData
    , Typeable PolicyID
PolicyID -> Encoding
(forall t. EncCBOR t => Proxy t -> Size)
-> Proxy [PolicyID] -> Size
(forall t. EncCBOR t => Proxy t -> Size) -> Proxy PolicyID -> Size
forall a.
Typeable a
-> (a -> Encoding)
-> ((forall t. EncCBOR t => Proxy t -> Size) -> Proxy a -> Size)
-> ((forall t. EncCBOR t => Proxy t -> Size) -> Proxy [a] -> Size)
-> EncCBOR a
encodedListSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size)
-> Proxy [PolicyID] -> Size
$cencodedListSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size)
-> Proxy [PolicyID] -> Size
encodedSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size) -> Proxy PolicyID -> Size
$cencodedSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size) -> Proxy PolicyID -> Size
encCBOR :: PolicyID -> Encoding
$cencCBOR :: PolicyID -> Encoding
EncCBOR
    , Typeable PolicyID
Proxy PolicyID -> Text
forall s. Decoder s PolicyID
forall a.
Typeable a
-> (forall s. Decoder s a)
-> (forall s. Proxy a -> Decoder s ())
-> (Proxy a -> Text)
-> DecCBOR a
forall s. Proxy PolicyID -> Decoder s ()
label :: Proxy PolicyID -> Text
$clabel :: Proxy PolicyID -> Text
dropCBOR :: forall s. Proxy PolicyID -> Decoder s ()
$cdropCBOR :: forall s. Proxy PolicyID -> Decoder s ()
decCBOR :: forall s. Decoder s PolicyID
$cdecCBOR :: forall s. Decoder s PolicyID
DecCBOR
    , [PolicyID] -> Encoding
[PolicyID] -> Value
PolicyID -> Bool
PolicyID -> Encoding
PolicyID -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
omitField :: PolicyID -> Bool
$comitField :: PolicyID -> Bool
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
    , Maybe PolicyID
Value -> Parser [PolicyID]
Value -> Parser PolicyID
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
omittedField :: Maybe PolicyID
$comittedField :: Maybe PolicyID
parseJSONList :: Value -> Parser [PolicyID]
$cparseJSONList :: Value -> Parser [PolicyID]
parseJSON :: Value -> Parser PolicyID
$cparseJSON :: Value -> Parser PolicyID
FromJSON
    , ToJSONKeyFunction [PolicyID]
ToJSONKeyFunction PolicyID
forall a.
ToJSONKeyFunction a -> ToJSONKeyFunction [a] -> ToJSONKey a
toJSONKeyList :: ToJSONKeyFunction [PolicyID]
$ctoJSONKeyList :: ToJSONKeyFunction [PolicyID]
toJSONKey :: ToJSONKeyFunction PolicyID
$ctoJSONKey :: ToJSONKeyFunction PolicyID
ToJSONKey
    , FromJSONKeyFunction [PolicyID]
FromJSONKeyFunction PolicyID
forall a.
FromJSONKeyFunction a -> FromJSONKeyFunction [a] -> FromJSONKey a
fromJSONKeyList :: FromJSONKeyFunction [PolicyID]
$cfromJSONKeyList :: FromJSONKeyFunction [PolicyID]
fromJSONKey :: FromJSONKeyFunction PolicyID
$cfromJSONKey :: FromJSONKeyFunction PolicyID
FromJSONKey
    )

-- | The MultiAssets map
newtype MultiAsset = MultiAsset (Map PolicyID (Map AssetName Integer))
  deriving (Int -> MultiAsset -> ShowS
[MultiAsset] -> ShowS
MultiAsset -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [MultiAsset] -> ShowS
$cshowList :: [MultiAsset] -> ShowS
show :: MultiAsset -> [Char]
$cshow :: MultiAsset -> [Char]
showsPrec :: Int -> MultiAsset -> ShowS
$cshowsPrec :: Int -> MultiAsset -> ShowS
Show, forall x. Rep MultiAsset x -> MultiAsset
forall x. MultiAsset -> Rep MultiAsset x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep MultiAsset x -> MultiAsset
$cfrom :: forall x. MultiAsset -> Rep MultiAsset x
Generic, [MultiAsset] -> Encoding
[MultiAsset] -> Value
MultiAsset -> Bool
MultiAsset -> Encoding
MultiAsset -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
omitField :: MultiAsset -> Bool
$comitField :: MultiAsset -> Bool
toEncodingList :: [MultiAsset] -> Encoding
$ctoEncodingList :: [MultiAsset] -> Encoding
toJSONList :: [MultiAsset] -> Value
$ctoJSONList :: [MultiAsset] -> Value
toEncoding :: MultiAsset -> Encoding
$ctoEncoding :: MultiAsset -> Encoding
toJSON :: MultiAsset -> Value
$ctoJSON :: MultiAsset -> Value
ToJSON, Typeable MultiAsset
MultiAsset -> Encoding
(forall t. EncCBOR t => Proxy t -> Size)
-> Proxy [MultiAsset] -> Size
(forall t. EncCBOR t => Proxy t -> Size)
-> Proxy MultiAsset -> Size
forall a.
Typeable a
-> (a -> Encoding)
-> ((forall t. EncCBOR t => Proxy t -> Size) -> Proxy a -> Size)
-> ((forall t. EncCBOR t => Proxy t -> Size) -> Proxy [a] -> Size)
-> EncCBOR a
encodedListSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size)
-> Proxy [MultiAsset] -> Size
$cencodedListSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size)
-> Proxy [MultiAsset] -> Size
encodedSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size)
-> Proxy MultiAsset -> Size
$cencodedSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size)
-> Proxy MultiAsset -> Size
encCBOR :: MultiAsset -> Encoding
$cencCBOR :: MultiAsset -> Encoding
EncCBOR)

instance Eq MultiAsset where
  MultiAsset Map PolicyID (Map AssetName Integer)
x == :: MultiAsset -> MultiAsset -> Bool
== MultiAsset Map PolicyID (Map AssetName Integer)
y = forall k v.
(Ord k, CanonicalZero v) =>
(v -> v -> Bool) -> Map k v -> Map k v -> Bool
pointWise (forall k v.
(Ord k, CanonicalZero v) =>
(v -> v -> Bool) -> Map k v -> Map k v -> Bool
pointWise forall a. Eq a => a -> a -> Bool
(==)) Map PolicyID (Map AssetName Integer)
x Map PolicyID (Map AssetName Integer)
y

instance NFData MultiAsset where
  rnf :: MultiAsset -> ()
rnf (MultiAsset Map PolicyID (Map AssetName Integer)
m) = forall a. NFData a => a -> ()
rnf Map PolicyID (Map AssetName Integer)
m

instance NoThunks MultiAsset

instance Semigroup MultiAsset where
  MultiAsset Map PolicyID (Map AssetName Integer)
m1 <> :: MultiAsset -> MultiAsset -> MultiAsset
<> MultiAsset Map PolicyID (Map AssetName Integer)
m2 =
    Map PolicyID (Map AssetName Integer) -> MultiAsset
MultiAsset (forall k a.
(Ord k, CanonicalZero a) =>
(a -> a -> a) -> Map k a -> Map k a -> Map k a
canonicalMapUnion (forall k a.
(Ord k, CanonicalZero a) =>
(a -> a -> a) -> Map k a -> Map k a -> Map k a
canonicalMapUnion forall a. Num a => a -> a -> a
(+)) Map PolicyID (Map AssetName Integer)
m1 Map PolicyID (Map AssetName Integer)
m2)

instance Monoid MultiAsset where
  mempty :: MultiAsset
mempty = Map PolicyID (Map AssetName Integer) -> MultiAsset
MultiAsset forall a. Monoid a => a
mempty

instance Group MultiAsset where
  invert :: MultiAsset -> MultiAsset
invert (MultiAsset Map PolicyID (Map AssetName Integer)
m) =
    Map PolicyID (Map AssetName Integer) -> MultiAsset
MultiAsset (forall k a.
(Ord k, CanonicalZero a) =>
(a -> a) -> Map k a -> Map k a
canonicalMap (forall k a.
(Ord k, CanonicalZero a) =>
(a -> a) -> Map k a -> Map k a
canonicalMap ((-Integer
1 :: Integer) forall a. Num a => a -> a -> a
*)) Map PolicyID (Map AssetName Integer)
m)

instance DecCBOR MultiAsset where
  decCBOR :: forall s. Decoder s MultiAsset
decCBOR = forall s. (forall t. Decoder t Integer) -> Decoder s MultiAsset
decodeMultiAsset forall t. Decoder t Integer
decodeIntegerBounded64

-- | The Value representing MultiAssets
data MaryValue = MaryValue !Coin !MultiAsset
  deriving (Int -> MaryValue -> ShowS
[MaryValue] -> ShowS
MaryValue -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [MaryValue] -> ShowS
$cshowList :: [MaryValue] -> ShowS
show :: MaryValue -> [Char]
$cshow :: MaryValue -> [Char]
showsPrec :: Int -> MaryValue -> ShowS
$cshowsPrec :: Int -> MaryValue -> ShowS
Show, forall x. Rep MaryValue x -> MaryValue
forall x. MaryValue -> Rep MaryValue x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep MaryValue x -> MaryValue
$cfrom :: forall x. MaryValue -> Rep MaryValue x
Generic)

instance Eq MaryValue where
  MaryValue
x == :: MaryValue -> MaryValue -> Bool
== MaryValue
y = forall t. Val t => (Integer -> Integer -> Bool) -> t -> t -> Bool
pointwise forall a. Eq a => a -> a -> Bool
(==) MaryValue
x MaryValue
y

instance NFData MaryValue where
  rnf :: MaryValue -> ()
rnf (MaryValue Coin
c MultiAsset
m) = Coin
c forall a b. NFData a => a -> b -> b
`deepseq` forall a. NFData a => a -> ()
rnf MultiAsset
m

instance NoThunks MaryValue

instance Semigroup MaryValue where
  MaryValue Coin
c1 MultiAsset
m1 <> :: MaryValue -> MaryValue -> MaryValue
<> MaryValue Coin
c2 MultiAsset
m2 =
    Coin -> MultiAsset -> MaryValue
MaryValue (Coin
c1 forall a. Semigroup a => a -> a -> a
<> Coin
c2) (MultiAsset
m1 forall a. Semigroup a => a -> a -> a
<> MultiAsset
m2)

instance Monoid MaryValue where
  mempty :: MaryValue
mempty = Coin -> MultiAsset -> MaryValue
MaryValue forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty

instance Group MaryValue where
  invert :: MaryValue -> MaryValue
invert (MaryValue Coin
c MultiAsset
m) =
    Coin -> MultiAsset -> MaryValue
MaryValue
      (forall m. Group m => m -> m
invert Coin
c)
      (forall m. Group m => m -> m
invert MultiAsset
m)

instance Abelian MaryValue

instance Inject Coin MaryValue where
  inject :: Coin -> MaryValue
inject Coin
c = Coin -> MultiAsset -> MaryValue
MaryValue Coin
c (Map PolicyID (Map AssetName Integer) -> MultiAsset
MultiAsset forall k a. Map k a
Map.empty)

-- ===================================================
-- Make the Val instance of MaryValue

instance Val MaryValue where
  i
s <×> :: forall b. Integral b => b -> MaryValue -> MaryValue
<×> MaryValue Coin
c (MultiAsset Map PolicyID (Map AssetName Integer)
m) =
    Coin -> MultiAsset -> MaryValue
MaryValue
      (i
s forall t i. (Val t, Integral i) => i -> t -> t
<×> Coin
c)
      (Map PolicyID (Map AssetName Integer) -> MultiAsset
MultiAsset (forall k a.
(Ord k, CanonicalZero a) =>
(a -> a) -> Map k a -> Map k a
canonicalMap (forall k a.
(Ord k, CanonicalZero a) =>
(a -> a) -> Map k a -> Map k a
canonicalMap (forall a b. (Integral a, Num b) => a -> b
fromIntegral i
s forall a. Num a => a -> a -> a
*)) Map PolicyID (Map AssetName Integer)
m))
  isZero :: MaryValue -> Bool
isZero (MaryValue Coin
c (MultiAsset Map PolicyID (Map AssetName Integer)
m)) = Coin
c forall a. Eq a => a -> a -> Bool
== forall t. Val t => t
zero Bool -> Bool -> Bool
&& forall k a. Map k a -> Bool
Map.null Map PolicyID (Map AssetName Integer)
m
  coin :: MaryValue -> Coin
coin (MaryValue Coin
c MultiAsset
_) = Coin
c
  modifyCoin :: (Coin -> Coin) -> MaryValue -> MaryValue
modifyCoin Coin -> Coin
f (MaryValue Coin
c MultiAsset
m) = Coin -> MultiAsset -> MaryValue
MaryValue (Coin -> Coin
f Coin
c) MultiAsset
m
  pointwise :: (Integer -> Integer -> Bool) -> MaryValue -> MaryValue -> Bool
pointwise Integer -> Integer -> Bool
p (MaryValue (Coin Integer
c) (MultiAsset Map PolicyID (Map AssetName Integer)
x)) (MaryValue (Coin Integer
d) (MultiAsset Map PolicyID (Map AssetName Integer)
y)) =
    Integer -> Integer -> Bool
p Integer
c Integer
d Bool -> Bool -> Bool
&& forall k v.
(Ord k, CanonicalZero v) =>
(v -> v -> Bool) -> Map k v -> Map k v -> Bool
pointWise (forall k v.
(Ord k, CanonicalZero v) =>
(v -> v -> Bool) -> Map k v -> Map k v -> Bool
pointWise Integer -> Integer -> Bool
p) Map PolicyID (Map AssetName Integer)
x Map PolicyID (Map AssetName Integer)
y

  -- returns the size, in Word64's, of the CompactValue representation of MaryValue
  size :: MaryValue -> Integer
size vv :: MaryValue
vv@(MaryValue Coin
_ (MultiAsset Map PolicyID (Map AssetName Integer)
m))
    -- when MaryValue contains only ada
    -- !WARNING! This branch is INCORRECT in the Mary era and should ONLY be
    -- used in the Alonzo ERA.
    -- TODO - find a better way to reconcile the mistakes in Mary with what needs
    -- to be the case in Alonzo.
    | forall k a. Map k a -> Bool
Map.null Map PolicyID (Map AssetName Integer)
m = Integer
2
    -- when MaryValue contains ada as well as other tokens
    -- sums up :
    -- i) adaWords : the space taken up by the ada amount
    -- ii) numberMulAssets : the space taken by number of words used to store
    --    number of non-ada assets in a value
    -- iii) the space taken up by the rest of the representation (quantities,
    --    PIDs, AssetNames, indeces)
    | Bool
otherwise =
        forall a b. (Integral a, Num b) => a -> b
fromIntegral
          ( Int -> Int
roundupBytesToWords ([(PolicyID, AssetName, Integer)] -> Int
representationSize (forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ MaryValue -> (Coin, [(PolicyID, AssetName, Integer)])
gettriples MaryValue
vv))
              forall a. Num a => a -> a -> a
+ Int
repOverhead
          )

  isAdaOnly :: MaryValue -> Bool
isAdaOnly (MaryValue Coin
_ (MultiAsset Map PolicyID (Map AssetName Integer)
m)) = forall k a. Map k a -> Bool
Map.null Map PolicyID (Map AssetName Integer)
m

  isAdaOnlyCompact :: CompactForm MaryValue -> Bool
isAdaOnlyCompact = \case
    CompactValue (CompactValueAdaOnly CompactForm Coin
_) -> Bool
True
    CompactValue CompactValueMultiAsset {} -> Bool
False

  coinCompact :: CompactForm MaryValue -> CompactForm Coin
coinCompact = \case
    CompactValue (CompactValueAdaOnly CompactForm Coin
cc) -> CompactForm Coin
cc
    CompactValue (CompactValueMultiAsset CompactForm Coin
cc Word32
_ ShortByteString
_) -> CompactForm Coin
cc

  injectCompact :: CompactForm Coin -> CompactForm MaryValue
injectCompact = CompactValue -> CompactForm MaryValue
CompactValue forall b c a. (b -> c) -> (a -> b) -> a -> c
. CompactForm Coin -> CompactValue
CompactValueAdaOnly

  modifyCompactCoin :: (CompactForm Coin -> CompactForm Coin)
-> CompactForm MaryValue -> CompactForm MaryValue
modifyCompactCoin CompactForm Coin -> CompactForm Coin
f = \case
    CompactValue (CompactValueAdaOnly CompactForm Coin
cc) ->
      CompactValue -> CompactForm MaryValue
CompactValue (CompactForm Coin -> CompactValue
CompactValueAdaOnly (CompactForm Coin -> CompactForm Coin
f CompactForm Coin
cc))
    CompactValue (CompactValueMultiAsset CompactForm Coin
cc Word32
n ShortByteString
sbs) ->
      CompactValue -> CompactForm MaryValue
CompactValue (CompactForm Coin -> Word32 -> ShortByteString -> CompactValue
CompactValueMultiAsset (CompactForm Coin -> CompactForm Coin
f CompactForm Coin
cc) Word32
n ShortByteString
sbs)

-- space (in Word64s) taken up by the ada amount
adaWords :: Int
adaWords :: Int
adaWords = Int
1

-- 64 bit machine Word64 length
wordLength :: Int
wordLength :: Int
wordLength = Int
8

-- overhead in MA compact rep
repOverhead :: Int
repOverhead :: Int
repOverhead = Int
4 forall a. Num a => a -> a -> a
+ Int
adaWords forall a. Num a => a -> a -> a
+ Int
numberMulAssets

-- number of words used to store number of MAs in a value
numberMulAssets :: Int
numberMulAssets :: Int
numberMulAssets = Int
1

-- converts bytes to words (rounding up)
roundupBytesToWords :: Int -> Int
roundupBytesToWords :: Int -> Int
roundupBytesToWords Int
b = forall a. Integral a => a -> a -> a
quot (Int
b forall a. Num a => a -> a -> a
+ Int
wordLength forall a. Num a => a -> a -> a
- Int
1) Int
wordLength

-- ==============================================================
-- CBOR

decodeMaryValue :: Decoder s MaryValue
decodeMaryValue :: forall s. Decoder s MaryValue
decodeMaryValue = do
  TokenType
tt <- forall s. Decoder s TokenType
peekTokenType
  case TokenType
tt of
    TokenType
TypeUInt -> forall t s. Inject t s => t -> s
inject forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Coin
Coin forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Integral a => a -> Integer
toInteger forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s. Decoder s Word64
decodeWord64
    TokenType
TypeUInt64 -> forall t s. Inject t s => t -> s
inject forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Coin
Coin forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Integral a => a -> Integer
toInteger forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s. Decoder s Word64
decodeWord64
    TokenType
TypeListLen -> forall s. (forall t. Decoder t Integer) -> Decoder s MaryValue
decodeValuePair (forall a. Integral a => a -> Integer
toInteger forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s. Decoder s Word64
decodeWord64)
    TokenType
TypeListLen64 -> forall s. (forall t. Decoder t Integer) -> Decoder s MaryValue
decodeValuePair (forall a. Integral a => a -> Integer
toInteger forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s. Decoder s Word64
decodeWord64)
    TokenType
TypeListLenIndef -> forall s. (forall t. Decoder t Integer) -> Decoder s MaryValue
decodeValuePair (forall a. Integral a => a -> Integer
toInteger forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s. Decoder s Word64
decodeWord64)
    TokenType
_ -> forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail forall a b. (a -> b) -> a -> b
$ [Char]
"MaryValue: expected array or int, got " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show TokenType
tt

decodeValuePair :: (forall t. Decoder t Integer) -> Decoder s MaryValue
decodeValuePair :: forall s. (forall t. Decoder t Integer) -> Decoder s MaryValue
decodeValuePair forall t. Decoder t Integer
decodeMultiAssetAmount =
  forall (w :: Wrapped) t s. Decode w t -> Decoder s t
decode forall a b. (a -> b) -> a -> b
$
    forall t. t -> Decode ('Closed 'Dense) t
RecD Coin -> MultiAsset -> MaryValue
MaryValue
      forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! forall t. (forall s. Decoder s t) -> Decode ('Closed 'Dense) t
D (Integer -> Coin
Coin forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Integral a => a -> Integer
toInteger forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s. Decoder s Word64
decodeWord64)
      forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! forall t. (forall s. Decoder s t) -> Decode ('Closed 'Dense) t
D (forall s. (forall t. Decoder t Integer) -> Decoder s MultiAsset
decodeMultiAsset forall t. Decoder t Integer
decodeMultiAssetAmount)

-- | `MultiAsset` can be used in two different circumstances:
--
-- 1. In `MaryValue` while sending, where amounts must be positive.
-- 2. During minting, both negative and positive are allowed, but not zero.
--
-- In both cases MultiAsset cannot be too big for compact representation and it must not
-- contain empty Maps.
decodeMultiAsset :: (forall t. Decoder t Integer) -> Decoder s MultiAsset
decodeMultiAsset :: forall s. (forall t. Decoder t Integer) -> Decoder s MultiAsset
decodeMultiAsset forall t. Decoder t Integer
decodeAmount = do
  MultiAsset
ma <-
    forall s a. Version -> Decoder s a -> Decoder s a -> Decoder s a
ifDecoderVersionAtLeast
      (forall (v :: Natural).
(KnownNat v, MinVersion <= v, v <= MaxVersion) =>
Version
natVersion @9)
      Decoder s MultiAsset
decodeWithEnforcing
      Decoder s MultiAsset
decodeWithPrunning
  MultiAsset
ma forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (MultiAsset -> Bool
isMultiAssetSmallEnough MultiAsset
ma) (forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"MultiAsset is too big to compact")
  where
    decodeWithEnforcing :: Decoder s MultiAsset
decodeWithEnforcing =
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Map PolicyID (Map AssetName Integer) -> MultiAsset
MultiAsset forall a b. (a -> b) -> a -> b
$ forall k s v.
Ord k =>
Decoder s k -> Decoder s v -> Decoder s (Map k v)
decodeMap forall a s. DecCBOR a => Decoder s a
decCBOR forall a b. (a -> b) -> a -> b
$ do
        Map AssetName Integer
m <- forall k s v.
Ord k =>
Decoder s k -> Decoder s v -> Decoder s (Map k v)
decodeMap forall a s. DecCBOR a => Decoder s a
decCBOR forall a b. (a -> b) -> a -> b
$ do
          Integer
amount <- forall t. Decoder t Integer
decodeAmount
          Integer
amount forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Integer
amount forall a. Eq a => a -> a -> Bool
== Integer
0) (forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"MultiAsset cannot contain zeros")
        Map AssetName Integer
m forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall k a. Map k a -> Bool
Map.null Map AssetName Integer
m) (forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"Empty Assets are not allowed")
    decodeWithPrunning :: Decoder s MultiAsset
decodeWithPrunning =
      MultiAsset -> MultiAsset
pruneZeroMultiAsset forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map PolicyID (Map AssetName Integer) -> MultiAsset
MultiAsset forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall k s v.
Ord k =>
Decoder s k -> Decoder s v -> Decoder s (Map k v)
decodeMap forall a s. DecCBOR a => Decoder s a
decCBOR (forall k s v.
Ord k =>
Decoder s k -> Decoder s v -> Decoder s (Map k v)
decodeMap forall a s. DecCBOR a => Decoder s a
decCBOR forall t. Decoder t Integer
decodeAmount)

instance EncCBOR MaryValue where
  encCBOR :: MaryValue -> Encoding
encCBOR (MaryValue Coin
c ma :: MultiAsset
ma@(MultiAsset Map PolicyID (Map AssetName Integer)
m)) =
    if forall k a. Map k a -> Bool
Map.null Map PolicyID (Map AssetName Integer)
m
      then forall a. EncCBOR a => a -> Encoding
encCBOR Coin
c
      else
        forall (w :: Wrapped) t. Encode w t -> Encoding
encode forall a b. (a -> b) -> a -> b
$
          forall t. t -> Encode ('Closed 'Dense) t
Rec Coin -> MultiAsset -> MaryValue
MaryValue
            forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Coin
c
            forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To MultiAsset
ma

instance DecCBOR MaryValue where
  decCBOR :: forall s. Decoder s MaryValue
decCBOR = forall s. Decoder s MaryValue
decodeMaryValue

-- Note: we do not use `decodeInt64` from the cborg library here because the
-- implementation contains "-- TODO FIXME: overflow"
decodeIntegerBounded64 :: Decoder s Integer
decodeIntegerBounded64 :: forall t. Decoder t Integer
decodeIntegerBounded64 = do
  TokenType
tt <- forall s. Decoder s TokenType
peekTokenType
  case TokenType
tt of
    TokenType
TypeUInt -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    TokenType
TypeUInt64 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    TokenType
TypeNInt -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    TokenType
TypeNInt64 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    TokenType
_ -> forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"expected major type 0 or 1 when decoding mint field"
  Integer
x <- forall t. Decoder t Integer
decodeInteger
  if Integer
minval forall a. Ord a => a -> a -> Bool
<= Integer
x Bool -> Bool -> Bool
&& Integer
x forall a. Ord a => a -> a -> Bool
<= Integer
maxval
    then forall (f :: * -> *) a. Applicative f => a -> f a
pure Integer
x
    else
      forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail forall a b. (a -> b) -> a -> b
$
        forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
          [ [Char]
"overflow when decoding mint field. min value: "
          , forall a. Show a => a -> [Char]
show Integer
minval
          , [Char]
" max value: "
          , forall a. Show a => a -> [Char]
show Integer
maxval
          , [Char]
" got: "
          , forall a. Show a => a -> [Char]
show Integer
x
          ]
  where
    maxval :: Integer
maxval = forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bounded a => a
maxBound :: Int64)
    minval :: Integer
minval = forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bounded a => a
minBound :: Int64)

-- ========================================================================
-- JSON

instance ToJSON MaryValue where
  toJSON :: MaryValue -> Value
toJSON = [Pair] -> Value
object forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e a. KeyValue e a => MaryValue -> [a]
toMaryValuePairs
  toEncoding :: MaryValue -> Encoding
toEncoding = Series -> Encoding
Aeson.pairs forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e a. KeyValue e a => MaryValue -> [a]
toMaryValuePairs

toMaryValuePairs :: Aeson.KeyValue e a => MaryValue -> [a]
toMaryValuePairs :: forall e a. KeyValue e a => MaryValue -> [a]
toMaryValuePairs (MaryValue Coin
l MultiAsset
ps) =
  [ Key
"lovelace" forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Coin
l
  , Key
"policies" forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= MultiAsset
ps
  ]

instance ToJSON AssetName where
  toJSON :: AssetName -> Value
toJSON = Text -> Value
Aeson.String forall b c a. (b -> c) -> (a -> b) -> a -> c
. AssetName -> Text
assetNameToTextAsHex

instance ToJSONKey AssetName where
  toJSONKey :: ToJSONKeyFunction AssetName
toJSONKey = forall a. (a -> Text) -> ToJSONKeyFunction a
toJSONKeyText AssetName -> Text
assetNameToTextAsHex

-- ========================================================================
-- Compactible
-- This is used in the TxOut which stores the (CompactForm MaryValue).

instance Compactible MaryValue where
  newtype CompactForm MaryValue = CompactValue CompactValue
    deriving (CompactForm MaryValue -> CompactForm MaryValue -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CompactForm MaryValue -> CompactForm MaryValue -> Bool
$c/= :: CompactForm MaryValue -> CompactForm MaryValue -> Bool
== :: CompactForm MaryValue -> CompactForm MaryValue -> Bool
$c== :: CompactForm MaryValue -> CompactForm MaryValue -> Bool
Eq, Typeable, Int -> CompactForm MaryValue -> ShowS
[CompactForm MaryValue] -> ShowS
CompactForm MaryValue -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [CompactForm MaryValue] -> ShowS
$cshowList :: [CompactForm MaryValue] -> ShowS
show :: CompactForm MaryValue -> [Char]
$cshow :: CompactForm MaryValue -> [Char]
showsPrec :: Int -> CompactForm MaryValue -> ShowS
$cshowsPrec :: Int -> CompactForm MaryValue -> ShowS
Show, Context -> CompactForm MaryValue -> IO (Maybe ThunkInfo)
Proxy (CompactForm MaryValue) -> [Char]
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> [Char])
-> NoThunks a
showTypeOf :: Proxy (CompactForm MaryValue) -> [Char]
$cshowTypeOf :: Proxy (CompactForm MaryValue) -> [Char]
wNoThunks :: Context -> CompactForm MaryValue -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> CompactForm MaryValue -> IO (Maybe ThunkInfo)
noThunks :: Context -> CompactForm MaryValue -> IO (Maybe ThunkInfo)
$cnoThunks :: Context -> CompactForm MaryValue -> IO (Maybe ThunkInfo)
NoThunks, Typeable (CompactForm MaryValue)
CompactForm MaryValue -> Encoding
(forall t. EncCBOR t => Proxy t -> Size)
-> Proxy [CompactForm MaryValue] -> Size
(forall t. EncCBOR t => Proxy t -> Size)
-> Proxy (CompactForm MaryValue) -> Size
forall a.
Typeable a
-> (a -> Encoding)
-> ((forall t. EncCBOR t => Proxy t -> Size) -> Proxy a -> Size)
-> ((forall t. EncCBOR t => Proxy t -> Size) -> Proxy [a] -> Size)
-> EncCBOR a
encodedListSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size)
-> Proxy [CompactForm MaryValue] -> Size
$cencodedListSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size)
-> Proxy [CompactForm MaryValue] -> Size
encodedSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size)
-> Proxy (CompactForm MaryValue) -> Size
$cencodedSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size)
-> Proxy (CompactForm MaryValue) -> Size
encCBOR :: CompactForm MaryValue -> Encoding
$cencCBOR :: CompactForm MaryValue -> Encoding
EncCBOR, Typeable (CompactForm MaryValue)
Proxy (CompactForm MaryValue) -> Text
forall s. Decoder s (CompactForm MaryValue)
forall a.
Typeable a
-> (forall s. Decoder s a)
-> (forall s. Proxy a -> Decoder s ())
-> (Proxy a -> Text)
-> DecCBOR a
forall s. Proxy (CompactForm MaryValue) -> Decoder s ()
label :: Proxy (CompactForm MaryValue) -> Text
$clabel :: Proxy (CompactForm MaryValue) -> Text
dropCBOR :: forall s. Proxy (CompactForm MaryValue) -> Decoder s ()
$cdropCBOR :: forall s. Proxy (CompactForm MaryValue) -> Decoder s ()
decCBOR :: forall s. Decoder s (CompactForm MaryValue)
$cdecCBOR :: forall s. Decoder s (CompactForm MaryValue)
DecCBOR, CompactForm MaryValue -> ()
forall a. (a -> ()) -> NFData a
rnf :: CompactForm MaryValue -> ()
$crnf :: CompactForm MaryValue -> ()
NFData)
  toCompact :: MaryValue -> Maybe (CompactForm MaryValue)
toCompact MaryValue
x = CompactValue -> CompactForm MaryValue
CompactValue forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MaryValue -> Maybe CompactValue
to MaryValue
x
  fromCompact :: CompactForm MaryValue -> MaryValue
fromCompact (CompactValue CompactValue
x) = CompactValue -> MaryValue
from CompactValue
x

instance EncCBOR CompactValue where
  encCBOR :: CompactValue -> Encoding
encCBOR = forall a. EncCBOR a => a -> Encoding
encCBOR forall b c a. (b -> c) -> (a -> b) -> a -> c
. CompactValue -> MaryValue
from

instance DecCBOR CompactValue where
  decCBOR :: forall s. Decoder s CompactValue
decCBOR = do
    MaryValue
v <- forall s. Decoder s MaryValue
decodeMaryValue
    case MaryValue -> Maybe CompactValue
to MaryValue
v of
      Maybe CompactValue
Nothing ->
        forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail
          [Char]
"impossible failure: decoded nonnegative value that cannot be compacted"
      Just CompactValue
x -> forall (f :: * -> *) a. Applicative f => a -> f a
pure CompactValue
x

data CompactValue
  = CompactValueAdaOnly {-# UNPACK #-} !(CompactForm Coin)
  | CompactValueMultiAsset
      {-# UNPACK #-} !(CompactForm Coin) -- ada
      {-# UNPACK #-} !Word32 -- number of ma's
      {-# UNPACK #-} !ShortByteString -- rep
  deriving (forall x. Rep CompactValue x -> CompactValue
forall x. CompactValue -> Rep CompactValue x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CompactValue x -> CompactValue
$cfrom :: forall x. CompactValue -> Rep CompactValue x
Generic, Int -> CompactValue -> ShowS
[CompactValue] -> ShowS
CompactValue -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [CompactValue] -> ShowS
$cshowList :: [CompactValue] -> ShowS
show :: CompactValue -> [Char]
$cshow :: CompactValue -> [Char]
showsPrec :: Int -> CompactValue -> ShowS
$cshowsPrec :: Int -> CompactValue -> ShowS
Show, Typeable)

instance NFData CompactValue where
  rnf :: CompactValue -> ()
rnf = forall a. a -> ()
rwhnf

instance Eq CompactValue where
  CompactValue
a == :: CompactValue -> CompactValue -> Bool
== CompactValue
b = CompactValue -> MaryValue
from CompactValue
a forall a. Eq a => a -> a -> Bool
== CompactValue -> MaryValue
from CompactValue
b

deriving via
  OnlyCheckWhnfNamed "CompactValue" CompactValue
  instance
    NoThunks CompactValue

{-
The MaryValue surface type uses a nested map. For the compact version we use a
flattened representation, equivalent to a list of triples:
  [(PolicyID, AssetName, Quantity)]

Example:
  [ ("0xa519f84e...", "",       42)  -- empty asset name
  , ("0xf820a82c...", "Snark",  1)
  , ("0xf820a82c...", "Boojum", 1)   -- shared policy id, different name
  ]

We start by sorting in /descending/ order by asset name. Note that descending
order puts empty strings last:
  [ ("0xf820a82c...", "Snark",  1)
  , ("0xf820a82c...", "Boojum", 1)
  , ("0xa519f84e...", "",      42)
  ]

This example will be serialised as:
  ┏━━━━━━━━━━━━━━━┳━━━━━━━━━━━━━━━┳━━━━━━━━━━━━━━━┓
A)┃             1 ┃             1 ┃            42 ┃ Word64 quantities
  ┣━━━┳━━━┳━━━┳━━━┻━━━━━━━━━━━━━━━┻━━━━━━━━━━━━━━━┛
B)┃ 36┃ 36┃ 64┃                                     Word16 policyId offsets
  ┣━━━╋━━━╋━━━┫
C)┃ 92┃ 98┃103┃                                     Word16 asset name offsets
  ┣━┯━╇━┯━╇━┯━╇━┯━┯━┯━┯━┯━┯━┯━┯━┯━┯━┯━┯━┯━┯━┯━┯━┯━┯━┯━┯━┯━┓
D)┃f820a82c.. ┊ ┊ ┊ ┊ ┊ ┊ ┊ ┊ ┊ ┊ ┊ ┊ ┊ ┊ ┊ ┊ ┊ ┊ ┊ ┊ ┊ ┊ ┃ 28 byte policyId #1
  ┣━┿━┿━┿━┿━┿━┿━┿━┿━┿━┿━┿━┿━┿━┿━┿━┿━┿━┿━┿━┿━┿━┿━┿━┿━┿━┿━┿━┫
  ┃a519f84e.. ┊ ┊ ┊ ┊ ┊ ┊ ┊ ┊ ┊ ┊ ┊ ┊ ┊ ┊ ┊ ┊ ┊ ┊ ┊ ┊ ┊ ┊ ┃ 28 byte policyId #2
  ┣━┿━┿━┿━┿━┿━┿━┿━┿━┿━┿━╈━╈━┷━┷━┷━┷━┷━┷━┷━┷━┷━┷━┷━┷━┷━┷━┷━┛
E)┃S┊n┊a┊r┊k┊B┊o┊o┊j┊u┊m┃◀╂─padding to word size    Asset names, plus padding
  ┗━┷━┷━┷━┷━┷━┷━┷━┷━┷━┷━┻━┛
   ▲         ▲           ▲
   92-offset 97-offset   103-offset, end of string

Note that the asset name offsets end up sorted in ascending order, with empty
asset names pointing to the offset past the end of the concatenated names.

The serialised representation consists of five parts, concatenated together:
  A) A sequence of Word64s representing asset quantities.

  B) A sequence of Word16s representing policyId string offsets within D.
     We do not need to store a length because policyIds are fixed size.

  C) A sequence of Word16s representing asset name string offsets within E.
     We store only the starting offset and not a end offset or length. We can
     do this because we keep the assets in A,B,C sorted by the asset name, so
     the offsets in C are sorted. This means the next distinct entry gives the
     (exclusive) end offset of the asset name string. As a special case for
     empty asset names, the index points to the end of the string E.

     Note: If there are duplicate asset names, this can yield a sequence of
     multiple of the same offset. For example, if the assets are named
     "Snark","Snark","Boojum", region E would contain "SnarkBoojum",
     and region C would contain 92, 92, 97. For the decoder to determine the
     length of the first asset, it would subtract 92 from 97 (and not from the
     duplicate 92).

  D) a blob of policyIDs, without duplicates, concatenated.

  E) a blob of asset names, sorted, without duplicates, concatenated.

The size of the regions A,B,C are known based on the number of values. The
string offsets in B and C are relative to the whole of the representation, not
relative to the start of D & E (since D is variable size depending on whether
there were duplicate policyIDs)

The encoding strategy is
 - Collect all (unique) policy Ids.
 - Collect all (unique) asset names.
 - Determine the sizes of the regions and allocate them.
   - size A = 8 * numassets
   - size B = 2 * numassets
   - size C = 2 * numassets
   - size D = length (concat policyIds)
   - size E = length (concat assetNames)
   - sum = 12*numassets
         + length (concat policyIds)
         + length (concat assetNames)
 - Write the policyIds to region D
 - Write the asset names to region E
 - For each asset entry
   - Locate the corresponding asset name and policyId
   - Write quantity, policyId location, and asset name location to corresponding
     regions
   - For the special case of 0 length asset names, the location is the end of
     region E

The decoding strategy is
 - Use length information to determine the beginnings of regions A,B,C
   (We do not need to do this for regions D and E because the policyId
   and asset name locations are relative to the beginning of entire rep.)
 - For each integer in 0..(numassets -1)
   - Read corresponding quantity, pid offset, and asset name offset from regions
     A, B, and C, respectively.
   - Read (pid length) bytes from pid offset. assume it points into region D
   - Determine asset name lengths using the difference between the offset and
     the next greater offset (if it exists). If there is no next greater offset,
     use the difference from the end of the rep. (Note: for the special case of
     0 length asset names, this calculation results in 0 because we are
     subtracting the end of the rep from itself.)
   - Read (asset name length) bytes from asset name offset. assume it points
     into region E.
 -}

to ::
  MaryValue ->
  -- The Nothing case of the return value corresponds to a quantity that is outside
  -- the bounds of a Word64. x < 0 or x > (2^64 - 1)
  Maybe CompactValue
to :: MaryValue -> Maybe CompactValue
to (MaryValue Coin
ada (MultiAsset Map PolicyID (Map AssetName Integer)
m))
  | forall k a. Map k a -> Bool
Map.null Map PolicyID (Map AssetName Integer)
m = CompactForm Coin -> CompactValue
CompactValueAdaOnly forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Compactible a => a -> Maybe (CompactForm a)
toCompact Coin
ada
to v :: MaryValue
v@(MaryValue Coin
_ MultiAsset
ma) = do
  CompactForm Coin
c <- forall a. HasCallStack => Bool -> a -> a
assert (MultiAsset -> Bool
isMultiAssetSmallEnough MultiAsset
ma) (forall a. Compactible a => a -> Maybe (CompactForm a)
toCompact Coin
ada)
  -- Here we convert the (pid, assetName, quantity) triples into
  -- (Int, (Word16,Word16,Word64))
  -- These represent the index, pid offset, asset name offset, and quantity.
  -- If any of the quantities out of bounds, this will produce Nothing.
  -- The triples are ordered by asset name in descending order.
  [(Int, (Word16, Word16, Word64))]
preparedTriples <-
    forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0 ..] forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (\(Word16
_, Word16
x, Word64
_) -> Word16
x) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (PolicyID, AssetName, Integer) -> Maybe (Word16, Word16, Word64)
prepare [(PolicyID, AssetName, Integer)]
triples
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
    CompactForm Coin -> Word32 -> ShortByteString -> CompactValue
CompactValueMultiAsset CompactForm Coin
c (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
numTriples) forall a b. (a -> b) -> a -> b
$
      forall a. (forall s. ST s a) -> a
runST forall a b. (a -> b) -> a -> b
$ do
        MutableByteArray s
byteArray <- forall (m :: * -> *).
PrimMonad m =>
Int -> m (MutableByteArray (PrimState m))
BA.newByteArray Int
repSize
        forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(Int, (Word16, Word16, Word64))]
preparedTriples forall a b. (a -> b) -> a -> b
$ \(Int
i, (Word16
pidoff, Word16
anoff, Word64
q)) ->
          do
            -- For each triple, we write the quantity to region A,
            -- the pid offset to region B, and the asset name offset to region C.
            -- We can calculate the sizes (and therefore the starts) of each region
            -- using the number of triples.
            -- A:
            --   size: (#triples * 8) bytes
            --   start: offset 0
            -- B:
            --   size: (#triples * 2) bytes
            --   start: size(A) = #triples * 8
            -- C:
            --   size: (#triples * 2) bytes
            --   start: size(A) + size(B) = #triples * 10
            --
            -- The position argument to writeByteArray is an index in terms of the
            -- size of the value being written. So writeByteArray of a Word64 at
            -- position 1 writes at offset 8.
            --
            -- For the following, the byte offsets calculated above are converted to
            -- ByteArray positions by division.
            --
            -- The byte offset of the ith...
            --   quantity: 8i
            --   pid offset: 8n + 2i
            --   asset name offset: 8n + 2n + 2i
            -- Dividing by the respective sizes (8,2,2) yields the indices below.
            forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
BA.writeByteArray MutableByteArray s
byteArray Int
i Word64
q
            forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
BA.writeByteArray MutableByteArray s
byteArray (Int
4 forall a. Num a => a -> a -> a
* Int
numTriples forall a. Num a => a -> a -> a
+ Int
i) Word16
pidoff
            forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
BA.writeByteArray MutableByteArray s
byteArray (Int
5 forall a. Num a => a -> a -> a
* Int
numTriples forall a. Num a => a -> a -> a
+ Int
i) Word16
anoff

        forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (forall k a. Map k a -> [(k, a)]
Map.toList Map PolicyID Word16
pidOffsetMap) forall a b. (a -> b) -> a -> b
$
          \(PolicyID (ScriptHash Hash ADDRHASH EraIndependentScript
sh), Word16
offset) ->
            let pidBytes :: ShortByteString
pidBytes = forall h a. Hash h a -> ShortByteString
Hash.hashToBytesShort Hash ADDRHASH EraIndependentScript
sh
             in forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m)
-> Int -> ByteArray -> Int -> Int -> m ()
BA.copyByteArray
                  MutableByteArray s
byteArray
                  (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
offset)
                  (ShortByteString -> ByteArray
sbsToByteArray ShortByteString
pidBytes)
                  Int
0
                  Int
pidSize

        forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (forall k a. Map k a -> [(k, a)]
Map.toList Map AssetName Word16
assetNameOffsetMap) forall a b. (a -> b) -> a -> b
$
          \(AssetName ShortByteString
anameBS, Word16
offset) ->
            let anameBytes :: ShortByteString
anameBytes = ShortByteString
anameBS
                anameLen :: Int
anameLen = ShortByteString -> Int
SBS.length ShortByteString
anameBS
             in forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m)
-> Int -> ByteArray -> Int -> Int -> m ()
BA.copyByteArray
                  MutableByteArray s
byteArray
                  (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
offset)
                  (ShortByteString -> ByteArray
sbsToByteArray ShortByteString
anameBytes)
                  Int
0
                  Int
anameLen
        ByteArray -> ShortByteString
byteArrayToSbs forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m) -> m ByteArray
BA.unsafeFreezeByteArray MutableByteArray s
byteArray
  where
    (Coin
ada, [(PolicyID, AssetName, Integer)]
triples) = MaryValue -> (Coin, [(PolicyID, AssetName, Integer)])
gettriples MaryValue
v
    numTriples :: Int
numTriples = forall (t :: * -> *) a. Foldable t => t a -> Int
length [(PolicyID, AssetName, Integer)]
triples

    -- abcRegionSize is the combined size of regions A, B, and C
    abcRegionSize :: Int
abcRegionSize = Int
numTriples forall a. Num a => a -> a -> a
* Int
12

    pidSize :: Int
pidSize = forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall h (proxy :: * -> *). HashAlgorithm h => proxy h -> Word
Hash.sizeHash (forall {k} (t :: k). Proxy t
Proxy :: Proxy ADDRHASH))

    -- pids is the collection of all distinct pids
    pids :: Set PolicyID
pids = forall a. Ord a => [a] -> Set a
Set.fromList forall a b. (a -> b) -> a -> b
$ (\(PolicyID
pid, AssetName
_, Integer
_) -> PolicyID
pid) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(PolicyID, AssetName, Integer)]
triples

    pidOffsetMap :: Map PolicyID Word16
    pidOffsetMap :: Map PolicyID Word16
pidOffsetMap =
      -- the pid offsets are:
      --   X, X + s, X + 2s, X + 3s, ...
      -- where X is the start of block D and s is the size of a pid
      let offsets :: [Word16]
offsets =
            forall a. Enum a => a -> a -> [a]
enumFromThen (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
abcRegionSize) (forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
abcRegionSize forall a. Num a => a -> a -> a
+ Int
pidSize))
       in forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList (forall a b. [a] -> [b] -> [(a, b)]
zip (forall a. Set a -> [a]
Set.toList Set PolicyID
pids) [Word16]
offsets)

    pidOffset :: PolicyID -> Word16
pidOffset PolicyID
pid = forall a. HasCallStack => Maybe a -> a
fromJust (forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup PolicyID
pid Map PolicyID Word16
pidOffsetMap)

    pidBlockSize :: Int
pidBlockSize = forall a. Set a -> Int
Set.size Set PolicyID
pids forall a. Num a => a -> a -> a
* Int
pidSize

    -- Putting asset names in descending order ensures that the empty string
    -- is last, so the associated offset is pointing to the end of the array
    assetNames :: [AssetName]
assetNames = forall a. Set a -> [a]
Set.toDescList forall a b. (a -> b) -> a -> b
$ forall a. Ord a => [a] -> Set a
Set.fromList forall a b. (a -> b) -> a -> b
$ (\(PolicyID
_, AssetName
an, Integer
_) -> AssetName
an) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(PolicyID, AssetName, Integer)]
triples

    assetNameLengths :: [Int]
assetNameLengths = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortByteString -> Int
SBS.length forall b c a. (b -> c) -> (a -> b) -> a -> c
. AssetName -> ShortByteString
assetNameBytes forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [AssetName]
assetNames

    assetNameOffsetMap :: Map AssetName Word16
    assetNameOffsetMap :: Map AssetName Word16
assetNameOffsetMap =
      -- The asset name offsets are the running sum of the asset lengths,
      -- but starting with the offset of the start of block E.
      let offsets :: [Int]
offsets = forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl forall a. Num a => a -> a -> a
(+) (Int
abcRegionSize forall a. Num a => a -> a -> a
+ Int
pidBlockSize) [Int]
assetNameLengths
       in forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList (forall a b. [a] -> [b] -> [(a, b)]
zip [AssetName]
assetNames [Int]
offsets)

    assetNameOffset :: AssetName -> Word16
assetNameOffset AssetName
aname = forall a. HasCallStack => Maybe a -> a
fromJust (forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup AssetName
aname Map AssetName Word16
assetNameOffsetMap)

    anameBlockSize :: Int
anameBlockSize = forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Int]
assetNameLengths

    -- size = size(A+B+C)      + size(D)      + size(E)
    repSize :: Int
repSize = Int
abcRegionSize forall a. Num a => a -> a -> a
+ Int
pidBlockSize forall a. Num a => a -> a -> a
+ Int
anameBlockSize

    prepare :: (PolicyID, AssetName, Integer) -> Maybe (Word16, Word16, Word64)
prepare (PolicyID
pid, AssetName
aname, Integer
q) = do
      Word64
q' <- Integer -> Maybe Word64
integerToWord64 Integer
q
      forall (f :: * -> *) a. Applicative f => a -> f a
pure (PolicyID -> Word16
pidOffset PolicyID
pid, AssetName -> Word16
assetNameOffset AssetName
aname, Word64
q')

-- | Unlike `representationSize`, this function cheaply checks whether
-- any offset within a MultiAsset compact representation is likely to overflow Word16.
--
-- compact form inequality:
--   8n (Word64) + 2n (Word16) + 2n (Word16) + 28p (policy ids) + sum of lengths of unique asset names <= 65535
-- maximum size for the asset name is 32 bytes, so:
-- 8n + 2n + 2n + 28p + 32n <= 65535
-- where: n = total number of assets, p = number of unique policy ids
isMultiAssetSmallEnough :: MultiAsset -> Bool
isMultiAssetSmallEnough :: MultiAsset -> Bool
isMultiAssetSmallEnough (MultiAsset Map PolicyID (Map AssetName Integer)
ma) =
  Int
44 forall a. Num a => a -> a -> a
* forall a. Sum a -> a
M.getSum (forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap' (forall a. a -> Sum a
M.Sum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Int
length) Map PolicyID (Map AssetName Integer)
ma) forall a. Num a => a -> a -> a
+ Int
28 forall a. Num a => a -> a -> a
* forall (t :: * -> *) a. Foldable t => t a -> Int
length Map PolicyID (Map AssetName Integer)
ma forall a. Ord a => a -> a -> Bool
<= Int
65535

representationSize ::
  [(PolicyID, AssetName, Integer)] ->
  Int
representationSize :: [(PolicyID, AssetName, Integer)] -> Int
representationSize [(PolicyID, AssetName, Integer)]
xs = Int
abcRegionSize forall a. Num a => a -> a -> a
+ Int
pidBlockSize forall a. Num a => a -> a -> a
+ Int
anameBlockSize
  where
    len :: Int
len = forall (t :: * -> *) a. Foldable t => t a -> Int
length [(PolicyID, AssetName, Integer)]
xs
    abcRegionSize :: Int
abcRegionSize = Int
len forall a. Num a => a -> a -> a
* Int
12

    numPids :: Int
numPids = forall a. Set a -> Int
Set.size forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Ord a => [a] -> Set a
Set.fromList forall a b. (a -> b) -> a -> b
$ (\(PolicyID
pid, AssetName
_, Integer
_) -> PolicyID
pid) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(PolicyID, AssetName, Integer)]
xs
    pidSize :: Int
pidSize = forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall h (proxy :: * -> *). HashAlgorithm h => proxy h -> Word
Hash.sizeHash (forall {k} (t :: k). Proxy t
Proxy :: Proxy ADDRHASH))
    pidBlockSize :: Int
pidBlockSize = Int
numPids forall a. Num a => a -> a -> a
* Int
pidSize

    assetNames :: Set AssetName
assetNames = forall a. Ord a => [a] -> Set a
Set.fromList forall a b. (a -> b) -> a -> b
$ (\(PolicyID
_, AssetName
an, Integer
_) -> AssetName
an) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(PolicyID, AssetName, Integer)]
xs
    anameBlockSize :: Int
anameBlockSize =
      forall a. Sum a -> a
Semigroup.getSum forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap' (forall a. a -> Sum a
Semigroup.Sum forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortByteString -> Int
SBS.length forall b c a. (b -> c) -> (a -> b) -> a -> c
. AssetName -> ShortByteString
assetNameBytes) Set AssetName
assetNames

from :: CompactValue -> MaryValue
from :: CompactValue -> MaryValue
from (CompactValueAdaOnly CompactForm Coin
c) = Coin -> MultiAsset -> MaryValue
MaryValue (forall a. Compactible a => CompactForm a -> a
fromCompact CompactForm Coin
c) (Map PolicyID (Map AssetName Integer) -> MultiAsset
MultiAsset forall k a. Map k a
Map.empty)
from (CompactValueMultiAsset CompactForm Coin
c Word32
numAssets ShortByteString
rep) =
  let mv :: MaryValue
mv@(MaryValue Coin
_ MultiAsset
ma) = Coin -> [(PolicyID, AssetName, Integer)] -> MaryValue
valueFromList (forall a. Compactible a => CompactForm a -> a
fromCompact CompactForm Coin
c) [(PolicyID, AssetName, Integer)]
triples
   in forall a. HasCallStack => Bool -> a -> a
assert (MultiAsset -> Bool
isMultiAssetSmallEnough MultiAsset
ma) MaryValue
mv
  where
    n :: Int
n = forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
numAssets

    ba :: ByteArray
ba = ShortByteString -> ByteArray
sbsToByteArray ShortByteString
rep

    getTripleForIndex :: Int -> (Word16, Word16, Word64)
    getTripleForIndex :: Int -> (Word16, Word16, Word64)
getTripleForIndex Int
i =
      -- indexByteArray indices are in terms of the size of the value being indexed
      -- rather than byte offsets.
      -- The corresponding byte offsets are:
      -- q: 0 + 8i
      -- pidix: 8n + 2i
      -- anameix: 8n + 2n + 2i
      -- Dividing by the sized (resp 8,2,2) yields the indices below
      let q :: Word64
q = forall a. Prim a => ByteArray -> Int -> a
BA.indexByteArray ByteArray
ba Int
i
          pidix :: Word16
pidix = forall a. Prim a => ByteArray -> Int -> a
BA.indexByteArray ByteArray
ba (Int
4 forall a. Num a => a -> a -> a
* Int
n forall a. Num a => a -> a -> a
+ Int
i)
          anameix :: Word16
anameix = forall a. Prim a => ByteArray -> Int -> a
BA.indexByteArray ByteArray
ba (Int
5 forall a. Num a => a -> a -> a
* Int
n forall a. Num a => a -> a -> a
+ Int
i)
       in (Word16
pidix, Word16
anameix, Word64
q)

    -- raw triples :: [(pid offset, asset name offset, quantity)]
    rawTriples :: [(Word16, Word16, Word64)]
    rawTriples :: [(Word16, Word16, Word64)]
rawTriples = forall a b. (a -> b) -> [a] -> [b]
map Int -> (Word16, Word16, Word64)
getTripleForIndex [Int
0 .. (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Word32
numAssets forall a. Num a => a -> a -> a
- Word32
1)]

    triples :: [(PolicyID, AssetName, Integer)]
    triples :: [(PolicyID, AssetName, Integer)]
triples = forall a b. (a -> b) -> [a] -> [b]
map (Word16, Word16, Word64) -> (PolicyID, AssetName, Integer)
convertTriple [(Word16, Word16, Word64)]
rawTriples

    -- Asset name length are calculated by subtracting the offset from the
    -- next greater offset (or from the end of the rep, if there is none.)
    -- For an index pointing to the end of the array, the associated
    -- length will be: offset - length(rep) = 0
    assetLens :: Map Word16 Int
assetLens =
      -- This assumes that the triples are ordered by nondecreasing asset name offset
      let ixs :: [Word16]
ixs = forall a. Ord a => [a] -> [a]
nubOrd forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (\(Word16
_, Word16
x, Word64
_) -> Word16
x) [(Word16, Word16, Word64)]
rawTriples
          ixPairs :: [(Word16, Word16)]
ixPairs = forall a b. [a] -> [b] -> [(a, b)]
zip [Word16]
ixs (forall a. Int -> [a] -> [a]
drop Int
1 [Word16]
ixs forall a. [a] -> [a] -> [a]
++ [forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ ShortByteString -> Int
SBS.length ShortByteString
rep])
       in forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall a b. (a -> b) -> a -> b
$ (\(Word16
a, Word16
b) -> (Word16
a, forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Word16
b forall a. Num a => a -> a -> a
- Word16
a)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Word16, Word16)]
ixPairs
    assetLen :: Word16 -> Int
    assetLen :: Word16 -> Int
assetLen Word16
ix = forall a. HasCallStack => Maybe a -> a
fromJust (forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Word16
ix Map Word16 Int
assetLens)

    convertTriple ::
      (Word16, Word16, Word64) -> (PolicyID, AssetName, Integer)
    convertTriple :: (Word16, Word16, Word64) -> (PolicyID, AssetName, Integer)
convertTriple (Word16
p, Word16
a, Word64
i) =
      ( ScriptHash -> PolicyID
PolicyID forall a b. (a -> b) -> a -> b
$
          Hash ADDRHASH EraIndependentScript -> ScriptHash
ScriptHash forall a b. (a -> b) -> a -> b
$
            forall h a. HashAlgorithm h => ShortByteString -> Hash h a
Hash.UnsafeHash forall a b. (a -> b) -> a -> b
$
              ShortByteString -> Int -> Int -> ShortByteString
readShortByteString
                ShortByteString
rep
                (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
p)
                (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall h (proxy :: * -> *). HashAlgorithm h => proxy h -> Word
Hash.sizeHash ([] :: [ADDRHASH]))
      , ShortByteString -> AssetName
AssetName forall a b. (a -> b) -> a -> b
$ ShortByteString -> Int -> Int -> ShortByteString
readShortByteString ShortByteString
rep (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
a) (Word16 -> Int
assetLen Word16
a)
      , forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
i
      )

-- | Strip out duplicates
nubOrd :: Ord a => [a] -> [a]
nubOrd :: forall a. Ord a => [a] -> [a]
nubOrd =
  forall {a}. Ord a => Set a -> [a] -> [a]
loop forall a. Monoid a => a
mempty
  where
    loop :: Set a -> [a] -> [a]
loop Set a
_ [] = []
    loop Set a
s (a
a : [a]
as)
      | a
a forall a. Ord a => a -> Set a -> Bool
`Set.member` Set a
s = Set a -> [a] -> [a]
loop Set a
s [a]
as
      | Bool
otherwise =
          let s' :: Set a
s' = forall a. Ord a => a -> Set a -> Set a
Set.insert a
a Set a
s in Set a
s' seq :: forall a b. a -> b -> b
`seq` a
a forall a. a -> [a] -> [a]
: Set a -> [a] -> [a]
loop Set a
s' [a]
as

sbsToByteArray :: ShortByteString -> BA.ByteArray
sbsToByteArray :: ShortByteString -> ByteArray
sbsToByteArray (SBS ByteArray#
bah) = ByteArray# -> ByteArray
BA.ByteArray ByteArray#
bah

byteArrayToSbs :: BA.ByteArray -> ShortByteString
byteArrayToSbs :: ByteArray -> ShortByteString
byteArrayToSbs (BA.ByteArray ByteArray#
bah) = ByteArray# -> ShortByteString
SBS ByteArray#
bah

readShortByteString :: ShortByteString -> Int -> Int -> ShortByteString
readShortByteString :: ShortByteString -> Int -> Int -> ShortByteString
readShortByteString ShortByteString
sbs Int
start Int
len =
  ByteArray -> ShortByteString
byteArrayToSbs forall a b. (a -> b) -> a -> b
$ ByteArray -> Int -> Int -> ByteArray
BA.cloneByteArray (ShortByteString -> ByteArray
sbsToByteArray ShortByteString
sbs) Int
start Int
len

-- ========================================================================
-- Operations on Values

-- | Extract the set of policies in the Value.
--
--   This function is equivalent to computing the support of the value in the
--   spec.
policies :: MultiAsset -> Set PolicyID
policies :: MultiAsset -> Set PolicyID
policies (MultiAsset Map PolicyID (Map AssetName Integer)
m) = forall k a. Map k a -> Set k
Map.keysSet Map PolicyID (Map AssetName Integer)
m

lookup :: PolicyID -> AssetName -> MaryValue -> Integer
lookup :: PolicyID -> AssetName -> MaryValue -> Integer
lookup = PolicyID -> AssetName -> MaryValue -> Integer
lookupMultiAsset
{-# DEPRECATED lookup "In favor of `lookupMultiAsset`" #-}

lookupMultiAsset :: PolicyID -> AssetName -> MaryValue -> Integer
lookupMultiAsset :: PolicyID -> AssetName -> MaryValue -> Integer
lookupMultiAsset PolicyID
pid AssetName
aid (MaryValue Coin
_ (MultiAsset Map PolicyID (Map AssetName Integer)
m)) =
  case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup PolicyID
pid Map PolicyID (Map AssetName Integer)
m of
    Maybe (Map AssetName Integer)
Nothing -> Integer
0
    Just Map AssetName Integer
m2 -> forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault Integer
0 AssetName
aid Map AssetName Integer
m2

-- | insert comb policy asset n v,
--   if comb = \ old new -> old, the integer in the MultiAsset is prefered over n
--   if comb = \ old new -> new, then n is prefered over the integer in the MultiAsset
--   if (comb old new) == 0, then that value should not be stored in the MultiAsset
insert ::
  (Integer -> Integer -> Integer) ->
  PolicyID ->
  AssetName ->
  Integer ->
  MultiAsset ->
  MultiAsset
insert :: (Integer -> Integer -> Integer)
-> PolicyID -> AssetName -> Integer -> MultiAsset -> MultiAsset
insert = (Integer -> Integer -> Integer)
-> PolicyID -> AssetName -> Integer -> MultiAsset -> MultiAsset
insertMultiAsset
{-# DEPRECATED insert "In favor of `insertMultiAsset`" #-}

-- | insertMultiAsset comb policy asset n v,
--   if comb = \ old new -> old, the integer in the MultiAsset is prefered over n
--   if comb = \ old new -> new, then n is prefered over the integer in the MultiAsset
--   if (comb old new) == 0, then that value should not be stored in the MultiAsset
insertMultiAsset ::
  (Integer -> Integer -> Integer) ->
  PolicyID ->
  AssetName ->
  Integer ->
  MultiAsset ->
  MultiAsset
insertMultiAsset :: (Integer -> Integer -> Integer)
-> PolicyID -> AssetName -> Integer -> MultiAsset -> MultiAsset
insertMultiAsset Integer -> Integer -> Integer
combine PolicyID
pid AssetName
aid Integer
new (MultiAsset Map PolicyID (Map AssetName Integer)
m1) =
  case forall k a. Ord k => k -> Map k a -> (Map k a, Maybe a, Map k a)
Map.splitLookup PolicyID
pid Map PolicyID (Map AssetName Integer)
m1 of
    (Map PolicyID (Map AssetName Integer)
l1, Just Map AssetName Integer
m2, Map PolicyID (Map AssetName Integer)
l2) ->
      case forall k a. Ord k => k -> Map k a -> (Map k a, Maybe a, Map k a)
Map.splitLookup AssetName
aid Map AssetName Integer
m2 of
        (Map AssetName Integer
v1, Just Integer
old, Map AssetName Integer
v2) ->
          if Integer
n forall a. Eq a => a -> a -> Bool
== Integer
0
            then
              let m3 :: Map AssetName Integer
m3 = forall k a. Map k a -> Map k a -> Map k a
link2 Map AssetName Integer
v1 Map AssetName Integer
v2
               in if forall k a. Map k a -> Bool
Map.null Map AssetName Integer
m3
                    then Map PolicyID (Map AssetName Integer) -> MultiAsset
MultiAsset (forall k a. Map k a -> Map k a -> Map k a
link2 Map PolicyID (Map AssetName Integer)
l1 Map PolicyID (Map AssetName Integer)
l2)
                    else Map PolicyID (Map AssetName Integer) -> MultiAsset
MultiAsset (forall k a. k -> a -> Map k a -> Map k a -> Map k a
link PolicyID
pid Map AssetName Integer
m3 Map PolicyID (Map AssetName Integer)
l1 Map PolicyID (Map AssetName Integer)
l2)
            else Map PolicyID (Map AssetName Integer) -> MultiAsset
MultiAsset (forall k a. k -> a -> Map k a -> Map k a -> Map k a
link PolicyID
pid (forall k a. k -> a -> Map k a -> Map k a -> Map k a
link AssetName
aid Integer
n Map AssetName Integer
v1 Map AssetName Integer
v2) Map PolicyID (Map AssetName Integer)
l1 Map PolicyID (Map AssetName Integer)
l2)
          where
            n :: Integer
n = Integer -> Integer -> Integer
combine Integer
old Integer
new
        (Map AssetName Integer
_, Maybe Integer
Nothing, Map AssetName Integer
_) ->
          Map PolicyID (Map AssetName Integer) -> MultiAsset
MultiAsset
            ( forall k a. k -> a -> Map k a -> Map k a -> Map k a
link
                PolicyID
pid
                ( if Integer
new forall a. Eq a => a -> a -> Bool
== Integer
0
                    then Map AssetName Integer
m2
                    else forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert AssetName
aid Integer
new Map AssetName Integer
m2
                )
                Map PolicyID (Map AssetName Integer)
l1
                Map PolicyID (Map AssetName Integer)
l2
            )
    (Map PolicyID (Map AssetName Integer)
l1, Maybe (Map AssetName Integer)
Nothing, Map PolicyID (Map AssetName Integer)
l2) ->
      Map PolicyID (Map AssetName Integer) -> MultiAsset
MultiAsset
        ( if Integer
new forall a. Eq a => a -> a -> Bool
== Integer
0
            then forall k a. Map k a -> Map k a -> Map k a
link2 Map PolicyID (Map AssetName Integer)
l1 Map PolicyID (Map AssetName Integer)
l2
            else forall k a. k -> a -> Map k a -> Map k a -> Map k a
link PolicyID
pid (forall k a. k -> a -> Map k a
Map.singleton AssetName
aid Integer
new) Map PolicyID (Map AssetName Integer)
l1 Map PolicyID (Map AssetName Integer)
l2
        )

-- ========================================================

-- | Remove 0 assets from a `MultiAsset`
prune ::
  Map PolicyID (Map AssetName Integer) ->
  Map PolicyID (Map AssetName Integer)
prune :: Map PolicyID (Map AssetName Integer)
-> Map PolicyID (Map AssetName Integer)
prune Map PolicyID (Map AssetName Integer)
assets =
  forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Bool
null) forall a b. (a -> b) -> a -> b
$ forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter (forall a. Eq a => a -> a -> Bool
/= Integer
0) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map PolicyID (Map AssetName Integer)
assets
{-# DEPRECATED prune "In favor of `pruneZeroMultiAsset`" #-}

-- | Remove all assets with that have zero amount specified
pruneZeroMultiAsset :: MultiAsset -> MultiAsset
pruneZeroMultiAsset :: MultiAsset -> MultiAsset
pruneZeroMultiAsset = (PolicyID -> AssetName -> Integer -> Bool)
-> MultiAsset -> MultiAsset
filterMultiAsset (\PolicyID
_ AssetName
_ -> (forall a. Eq a => a -> a -> Bool
/= Integer
0))

-- | Filter multi assets. Canonical form is preserved.
filterMultiAsset ::
  -- | Predicate that needs to return `True` whenever an asset should be retained.
  (PolicyID -> AssetName -> Integer -> Bool) ->
  MultiAsset ->
  MultiAsset
filterMultiAsset :: (PolicyID -> AssetName -> Integer -> Bool)
-> MultiAsset -> MultiAsset
filterMultiAsset PolicyID -> AssetName -> Integer -> Bool
f (MultiAsset Map PolicyID (Map AssetName Integer)
ma) =
  Map PolicyID (Map AssetName Integer) -> MultiAsset
MultiAsset forall a b. (a -> b) -> a -> b
$ forall k a b. (k -> a -> Maybe b) -> Map k a -> Map k b
Map.mapMaybeWithKey PolicyID -> Map AssetName Integer -> Maybe (Map AssetName Integer)
modifyAsset Map PolicyID (Map AssetName Integer)
ma
  where
    modifyAsset :: PolicyID -> Map AssetName Integer -> Maybe (Map AssetName Integer)
modifyAsset PolicyID
policyId Map AssetName Integer
assetMap = do
      let newAssetMap :: Map AssetName Integer
newAssetMap = forall k a. (k -> a -> Bool) -> Map k a -> Map k a
Map.filterWithKey (PolicyID -> AssetName -> Integer -> Bool
f PolicyID
policyId) Map AssetName Integer
assetMap
      forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null Map AssetName Integer
newAssetMap))
      forall a. a -> Maybe a
Just Map AssetName Integer
newAssetMap

-- | Map a function over each multi asset value while optionally filtering values
-- out. Canonical form is preserved.
mapMaybeMultiAsset ::
  (PolicyID -> AssetName -> Integer -> Maybe Integer) ->
  MultiAsset ->
  MultiAsset
mapMaybeMultiAsset :: (PolicyID -> AssetName -> Integer -> Maybe Integer)
-> MultiAsset -> MultiAsset
mapMaybeMultiAsset PolicyID -> AssetName -> Integer -> Maybe Integer
f (MultiAsset Map PolicyID (Map AssetName Integer)
ma) =
  Map PolicyID (Map AssetName Integer) -> MultiAsset
MultiAsset forall a b. (a -> b) -> a -> b
$ forall k a b. (k -> a -> Maybe b) -> Map k a -> Map k b
Map.mapMaybeWithKey PolicyID -> Map AssetName Integer -> Maybe (Map AssetName Integer)
modifyAsset Map PolicyID (Map AssetName Integer)
ma
  where
    modifyAsset :: PolicyID -> Map AssetName Integer -> Maybe (Map AssetName Integer)
modifyAsset PolicyID
policyId Map AssetName Integer
assetMap = do
      let newAssetMap :: Map AssetName Integer
newAssetMap = forall k a b. (k -> a -> Maybe b) -> Map k a -> Map k b
Map.mapMaybeWithKey (PolicyID -> AssetName -> Integer -> Maybe Integer
modifyValue PolicyID
policyId) Map AssetName Integer
assetMap
      forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null Map AssetName Integer
newAssetMap))
      forall a. a -> Maybe a
Just Map AssetName Integer
newAssetMap
    modifyValue :: PolicyID -> AssetName -> Integer -> Maybe Integer
modifyValue PolicyID
policyId AssetName
assetName Integer
assetValue = do
      Integer
newAssetValue <- PolicyID -> AssetName -> Integer -> Maybe Integer
f PolicyID
policyId AssetName
assetName Integer
assetValue
      forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Integer
newAssetValue forall a. Eq a => a -> a -> Bool
/= Integer
0)
      forall a. a -> Maybe a
Just Integer
newAssetValue

-- | Rather than using prune to remove 0 assets, when can avoid adding them in the
--   first place by using valueFromList to construct a MultiAsset
multiAssetFromList :: [(PolicyID, AssetName, Integer)] -> MultiAsset
multiAssetFromList :: [(PolicyID, AssetName, Integer)] -> MultiAsset
multiAssetFromList = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\(PolicyID
p, AssetName
n, Integer
i) MultiAsset
ans -> (Integer -> Integer -> Integer)
-> PolicyID -> AssetName -> Integer -> MultiAsset -> MultiAsset
insertMultiAsset forall a. Num a => a -> a -> a
(+) PolicyID
p AssetName
n Integer
i MultiAsset
ans) forall a. Monoid a => a
mempty

valueFromList :: Coin -> [(PolicyID, AssetName, Integer)] -> MaryValue
valueFromList :: Coin -> [(PolicyID, AssetName, Integer)] -> MaryValue
valueFromList Coin
ada [(PolicyID, AssetName, Integer)]
triples = Coin -> MultiAsset -> MaryValue
MaryValue Coin
ada ([(PolicyID, AssetName, Integer)] -> MultiAsset
multiAssetFromList [(PolicyID, AssetName, Integer)]
triples)

-- | Display a MaryValue as a String, one token per line
showValue :: MaryValue -> String
showValue :: MaryValue -> [Char]
showValue MaryValue
v = forall a. Show a => a -> [Char]
show Coin
c forall a. [a] -> [a] -> [a]
++ [Char]
"\n" forall a. [a] -> [a] -> [a]
++ Context -> [Char]
unlines (forall a b. (a -> b) -> [a] -> [b]
map forall {a} {a}. (Show a, Show a) => (PolicyID, a, a) -> [Char]
trans [(PolicyID, AssetName, Integer)]
ts)
  where
    (Coin
c, [(PolicyID, AssetName, Integer)]
ts) = MaryValue -> (Coin, [(PolicyID, AssetName, Integer)])
gettriples MaryValue
v
    trans :: (PolicyID, a, a) -> [Char]
trans (PolicyID ScriptHash
x, a
hash, a
cnt) =
      forall a. Show a => a -> [Char]
show ScriptHash
x
        forall a. [a] -> [a] -> [a]
++ [Char]
",  "
        forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show a
hash
        forall a. [a] -> [a] -> [a]
++ [Char]
",  "
        forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show a
cnt

-- | Turn the nested 'MaryValue' map-of-maps representation into a flat sequence
-- of policyID, asset name and quantity, plus separately the ada quantity.
gettriples :: MaryValue -> (Coin, [(PolicyID, AssetName, Integer)])
gettriples :: MaryValue -> (Coin, [(PolicyID, AssetName, Integer)])
gettriples (MaryValue Coin
c MultiAsset
ma) = (Coin
c, MultiAsset -> [(PolicyID, AssetName, Integer)]
flattenMultiAsset MultiAsset
ma)

flattenMultiAsset :: MultiAsset -> [(PolicyID, AssetName, Integer)]
flattenMultiAsset :: MultiAsset -> [(PolicyID, AssetName, Integer)]
flattenMultiAsset (MultiAsset Map PolicyID (Map AssetName Integer)
m) =
  [ (PolicyID
policyId, AssetName
aname, Integer
amount)
  | (PolicyID
policyId, Map AssetName Integer
m2) <- forall k a. Map k a -> [(k, a)]
assocs Map PolicyID (Map AssetName Integer)
m
  , (AssetName
aname, Integer
amount) <- forall k a. Map k a -> [(k, a)]
assocs Map AssetName Integer
m2
  ]