{-# 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 (..), CompactForm (..), 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 Data.MemPack
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.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
(AssetName -> AssetName -> Bool)
-> (AssetName -> AssetName -> Bool) -> Eq AssetName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AssetName -> AssetName -> Bool
== :: AssetName -> AssetName -> Bool
$c/= :: AssetName -> AssetName -> Bool
/= :: AssetName -> AssetName -> Bool
Eq
    , Typeable AssetName
Typeable AssetName =>
(AssetName -> Encoding)
-> ((forall t. EncCBOR t => Proxy t -> Size)
    -> Proxy AssetName -> Size)
-> ((forall t. EncCBOR t => Proxy t -> Size)
    -> Proxy [AssetName] -> Size)
-> EncCBOR 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
$cencCBOR :: AssetName -> Encoding
encCBOR :: AssetName -> Encoding
$cencodedSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size) -> Proxy AssetName -> Size
encodedSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size) -> Proxy AssetName -> Size
$cencodedListSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size)
-> Proxy [AssetName] -> Size
encodedListSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size)
-> Proxy [AssetName] -> Size
EncCBOR
    , Eq AssetName
Eq AssetName =>
(AssetName -> AssetName -> Ordering)
-> (AssetName -> AssetName -> Bool)
-> (AssetName -> AssetName -> Bool)
-> (AssetName -> AssetName -> Bool)
-> (AssetName -> AssetName -> Bool)
-> (AssetName -> AssetName -> AssetName)
-> (AssetName -> AssetName -> AssetName)
-> Ord AssetName
AssetName -> AssetName -> Bool
AssetName -> AssetName -> Ordering
AssetName -> AssetName -> AssetName
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: AssetName -> AssetName -> Ordering
compare :: AssetName -> AssetName -> Ordering
$c< :: AssetName -> AssetName -> Bool
< :: AssetName -> AssetName -> Bool
$c<= :: AssetName -> AssetName -> Bool
<= :: AssetName -> AssetName -> Bool
$c> :: AssetName -> AssetName -> Bool
> :: AssetName -> AssetName -> Bool
$c>= :: AssetName -> AssetName -> Bool
>= :: AssetName -> AssetName -> Bool
$cmax :: AssetName -> AssetName -> AssetName
max :: AssetName -> AssetName -> AssetName
$cmin :: AssetName -> AssetName -> AssetName
min :: AssetName -> AssetName -> AssetName
Ord
    , Context -> AssetName -> IO (Maybe ThunkInfo)
Proxy AssetName -> [Char]
(Context -> AssetName -> IO (Maybe ThunkInfo))
-> (Context -> AssetName -> IO (Maybe ThunkInfo))
-> (Proxy AssetName -> [Char])
-> NoThunks AssetName
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> [Char])
-> NoThunks a
$cnoThunks :: Context -> AssetName -> IO (Maybe ThunkInfo)
noThunks :: Context -> AssetName -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> AssetName -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> AssetName -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy AssetName -> [Char]
showTypeOf :: Proxy AssetName -> [Char]
NoThunks
    , AssetName -> ()
(AssetName -> ()) -> NFData AssetName
forall a. (a -> ()) -> NFData a
$crnf :: AssetName -> ()
rnf :: AssetName -> ()
NFData
    )

instance Show AssetName where
  show :: AssetName -> [Char]
show = ByteString -> [Char]
forall a. Show a => a -> [Char]
show (ByteString -> [Char])
-> (AssetName -> ByteString) -> AssetName -> [Char]
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 (ByteString -> ByteString)
-> (AssetName -> ByteString) -> AssetName -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortByteString -> ByteString
SBS.fromShort (ShortByteString -> ByteString)
-> (AssetName -> ShortByteString) -> AssetName -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AssetName -> ShortByteString
assetNameBytes

assetNameToTextAsHex :: AssetName -> Text
assetNameToTextAsHex :: AssetName -> Text
assetNameToTextAsHex = ByteString -> Text
decodeLatin1 (ByteString -> Text)
-> (AssetName -> ByteString) -> AssetName -> Text
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 <- Decoder s ShortByteString
forall s. Decoder s ShortByteString
forall a s. DecCBOR a => Decoder s a
decCBOR
    if ShortByteString -> Int
SBS.length ShortByteString
an Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
32
      then
        DecoderError -> Decoder s AssetName
forall (m :: * -> *) e a. (MonadFail m, Buildable e) => e -> m a
cborError (DecoderError -> Decoder s AssetName)
-> DecoderError -> Decoder s AssetName
forall a b. (a -> b) -> a -> b
$
          Text -> Text -> DecoderError
DecoderErrorCustom Text
"asset name exceeds 32 bytes:" (Text -> DecoderError) -> Text -> DecoderError
forall a b. (a -> b) -> a -> b
$
            AssetName -> Text
assetNameToTextAsHex (AssetName -> Text) -> AssetName -> Text
forall a b. (a -> b) -> a -> b
$
              ShortByteString -> AssetName
AssetName ShortByteString
an
      else AssetName -> Decoder s AssetName
forall a. a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AssetName -> Decoder s AssetName)
-> AssetName -> Decoder s AssetName
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]
(Int -> PolicyID -> ShowS)
-> (PolicyID -> [Char]) -> ([PolicyID] -> ShowS) -> Show PolicyID
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PolicyID -> ShowS
showsPrec :: Int -> PolicyID -> ShowS
$cshow :: PolicyID -> [Char]
show :: PolicyID -> [Char]
$cshowList :: [PolicyID] -> ShowS
showList :: [PolicyID] -> ShowS
Show
    , PolicyID -> PolicyID -> Bool
(PolicyID -> PolicyID -> Bool)
-> (PolicyID -> PolicyID -> Bool) -> Eq PolicyID
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PolicyID -> PolicyID -> Bool
== :: PolicyID -> PolicyID -> Bool
$c/= :: PolicyID -> PolicyID -> Bool
/= :: PolicyID -> PolicyID -> Bool
Eq
    , Eq PolicyID
Eq PolicyID =>
(PolicyID -> PolicyID -> Ordering)
-> (PolicyID -> PolicyID -> Bool)
-> (PolicyID -> PolicyID -> Bool)
-> (PolicyID -> PolicyID -> Bool)
-> (PolicyID -> PolicyID -> Bool)
-> (PolicyID -> PolicyID -> PolicyID)
-> (PolicyID -> PolicyID -> PolicyID)
-> Ord PolicyID
PolicyID -> PolicyID -> Bool
PolicyID -> PolicyID -> Ordering
PolicyID -> PolicyID -> PolicyID
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: PolicyID -> PolicyID -> Ordering
compare :: PolicyID -> PolicyID -> Ordering
$c< :: PolicyID -> PolicyID -> Bool
< :: PolicyID -> PolicyID -> Bool
$c<= :: PolicyID -> PolicyID -> Bool
<= :: PolicyID -> PolicyID -> Bool
$c> :: PolicyID -> PolicyID -> Bool
> :: PolicyID -> PolicyID -> Bool
$c>= :: PolicyID -> PolicyID -> Bool
>= :: PolicyID -> PolicyID -> Bool
$cmax :: PolicyID -> PolicyID -> PolicyID
max :: PolicyID -> PolicyID -> PolicyID
$cmin :: PolicyID -> PolicyID -> PolicyID
min :: PolicyID -> PolicyID -> PolicyID
Ord
    , (forall x. PolicyID -> Rep PolicyID x)
-> (forall x. Rep PolicyID x -> PolicyID) -> Generic PolicyID
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
$cfrom :: forall x. PolicyID -> Rep PolicyID x
from :: forall x. PolicyID -> Rep PolicyID x
$cto :: forall x. Rep PolicyID x -> PolicyID
to :: forall x. Rep PolicyID x -> PolicyID
Generic
    , Context -> PolicyID -> IO (Maybe ThunkInfo)
Proxy PolicyID -> [Char]
(Context -> PolicyID -> IO (Maybe ThunkInfo))
-> (Context -> PolicyID -> IO (Maybe ThunkInfo))
-> (Proxy PolicyID -> [Char])
-> NoThunks PolicyID
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> [Char])
-> NoThunks a
$cnoThunks :: Context -> PolicyID -> IO (Maybe ThunkInfo)
noThunks :: Context -> PolicyID -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> PolicyID -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> PolicyID -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy PolicyID -> [Char]
showTypeOf :: Proxy PolicyID -> [Char]
NoThunks
    , PolicyID -> ()
(PolicyID -> ()) -> NFData PolicyID
forall a. (a -> ()) -> NFData a
$crnf :: PolicyID -> ()
rnf :: PolicyID -> ()
NFData
    , Typeable PolicyID
Typeable PolicyID =>
(PolicyID -> Encoding)
-> ((forall t. EncCBOR t => Proxy t -> Size)
    -> Proxy PolicyID -> Size)
-> ((forall t. EncCBOR t => Proxy t -> Size)
    -> Proxy [PolicyID] -> Size)
-> EncCBOR 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
$cencCBOR :: PolicyID -> Encoding
encCBOR :: PolicyID -> Encoding
$cencodedSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size) -> Proxy PolicyID -> Size
encodedSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size) -> Proxy PolicyID -> Size
$cencodedListSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size)
-> Proxy [PolicyID] -> Size
encodedListSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size)
-> Proxy [PolicyID] -> Size
EncCBOR
    , Typeable PolicyID
Typeable PolicyID =>
(forall s. Decoder s PolicyID)
-> (forall s. Proxy PolicyID -> Decoder s ())
-> (Proxy PolicyID -> Text)
-> DecCBOR 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 ()
$cdecCBOR :: forall s. Decoder s PolicyID
decCBOR :: forall s. Decoder s PolicyID
$cdropCBOR :: forall s. Proxy PolicyID -> Decoder s ()
dropCBOR :: forall s. Proxy PolicyID -> Decoder s ()
$clabel :: Proxy PolicyID -> Text
label :: Proxy PolicyID -> Text
DecCBOR
    , [PolicyID] -> Value
[PolicyID] -> Encoding
PolicyID -> Bool
PolicyID -> Value
PolicyID -> Encoding
(PolicyID -> Value)
-> (PolicyID -> Encoding)
-> ([PolicyID] -> Value)
-> ([PolicyID] -> Encoding)
-> (PolicyID -> Bool)
-> ToJSON PolicyID
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: PolicyID -> Value
toJSON :: PolicyID -> Value
$ctoEncoding :: PolicyID -> Encoding
toEncoding :: PolicyID -> Encoding
$ctoJSONList :: [PolicyID] -> Value
toJSONList :: [PolicyID] -> Value
$ctoEncodingList :: [PolicyID] -> Encoding
toEncodingList :: [PolicyID] -> Encoding
$comitField :: PolicyID -> Bool
omitField :: PolicyID -> Bool
ToJSON
    , Maybe PolicyID
Value -> Parser [PolicyID]
Value -> Parser PolicyID
(Value -> Parser PolicyID)
-> (Value -> Parser [PolicyID])
-> Maybe PolicyID
-> FromJSON PolicyID
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser PolicyID
parseJSON :: Value -> Parser PolicyID
$cparseJSONList :: Value -> Parser [PolicyID]
parseJSONList :: Value -> Parser [PolicyID]
$comittedField :: Maybe PolicyID
omittedField :: Maybe PolicyID
FromJSON
    , ToJSONKeyFunction [PolicyID]
ToJSONKeyFunction PolicyID
ToJSONKeyFunction PolicyID
-> ToJSONKeyFunction [PolicyID] -> ToJSONKey PolicyID
forall a.
ToJSONKeyFunction a -> ToJSONKeyFunction [a] -> ToJSONKey a
$ctoJSONKey :: ToJSONKeyFunction PolicyID
toJSONKey :: ToJSONKeyFunction PolicyID
$ctoJSONKeyList :: ToJSONKeyFunction [PolicyID]
toJSONKeyList :: ToJSONKeyFunction [PolicyID]
ToJSONKey
    , FromJSONKeyFunction [PolicyID]
FromJSONKeyFunction PolicyID
FromJSONKeyFunction PolicyID
-> FromJSONKeyFunction [PolicyID] -> FromJSONKey PolicyID
forall a.
FromJSONKeyFunction a -> FromJSONKeyFunction [a] -> FromJSONKey a
$cfromJSONKey :: FromJSONKeyFunction PolicyID
fromJSONKey :: FromJSONKeyFunction PolicyID
$cfromJSONKeyList :: FromJSONKeyFunction [PolicyID]
fromJSONKeyList :: FromJSONKeyFunction [PolicyID]
FromJSONKey
    )

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

instance Eq MultiAsset where
  MultiAsset Map PolicyID (Map AssetName Integer)
x == :: MultiAsset -> MultiAsset -> Bool
== MultiAsset Map PolicyID (Map AssetName Integer)
y = (Map AssetName Integer -> Map AssetName Integer -> Bool)
-> Map PolicyID (Map AssetName Integer)
-> Map PolicyID (Map AssetName Integer)
-> Bool
forall k v.
(Ord k, CanonicalZero v) =>
(v -> v -> Bool) -> Map k v -> Map k v -> Bool
pointWise ((Integer -> Integer -> Bool)
-> Map AssetName Integer -> Map AssetName Integer -> Bool
forall k v.
(Ord k, CanonicalZero v) =>
(v -> v -> Bool) -> Map k v -> Map k v -> Bool
pointWise Integer -> Integer -> Bool
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) = Map PolicyID (Map AssetName Integer) -> ()
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 ((Map AssetName Integer
 -> Map AssetName Integer -> Map AssetName Integer)
-> Map PolicyID (Map AssetName Integer)
-> Map PolicyID (Map AssetName Integer)
-> Map PolicyID (Map AssetName Integer)
forall k a.
(Ord k, CanonicalZero a) =>
(a -> a -> a) -> Map k a -> Map k a -> Map k a
canonicalMapUnion ((Integer -> Integer -> Integer)
-> Map AssetName Integer
-> Map AssetName Integer
-> Map AssetName Integer
forall k a.
(Ord k, CanonicalZero a) =>
(a -> a -> a) -> Map k a -> Map k a -> Map k a
canonicalMapUnion Integer -> Integer -> Integer
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 Map PolicyID (Map AssetName Integer)
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 ((Map AssetName Integer -> Map AssetName Integer)
-> Map PolicyID (Map AssetName Integer)
-> Map PolicyID (Map AssetName Integer)
forall k a.
(Ord k, CanonicalZero a) =>
(a -> a) -> Map k a -> Map k a
canonicalMap ((Integer -> Integer)
-> Map AssetName Integer -> Map AssetName Integer
forall k a.
(Ord k, CanonicalZero a) =>
(a -> a) -> Map k a -> Map k a
canonicalMap ((-Integer
1 :: Integer) Integer -> Integer -> 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 t. Decoder t Integer) -> Decoder s MultiAsset
forall s. (forall t. Decoder t Integer) -> Decoder s MultiAsset
decodeMultiAsset Decoder t Integer
forall t. Decoder t Integer
decodeIntegerBounded64

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

instance Eq MaryValue where
  MaryValue
x == :: MaryValue -> MaryValue -> Bool
== MaryValue
y = (Integer -> Integer -> Bool) -> MaryValue -> MaryValue -> Bool
forall t. Val t => (Integer -> Integer -> Bool) -> t -> t -> Bool
pointwise Integer -> Integer -> Bool
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 Coin -> () -> ()
forall a b. NFData a => a -> b -> b
`deepseq` MultiAsset -> ()
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 Coin -> Coin -> Coin
forall a. Semigroup a => a -> a -> a
<> Coin
c2) (MultiAsset
m1 MultiAsset -> MultiAsset -> MultiAsset
forall a. Semigroup a => a -> a -> a
<> MultiAsset
m2)

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

instance Group MaryValue where
  invert :: MaryValue -> MaryValue
invert (MaryValue Coin
c MultiAsset
m) =
    Coin -> MultiAsset -> MaryValue
MaryValue
      (Coin -> Coin
forall m. Group m => m -> m
invert Coin
c)
      (MultiAsset -> MultiAsset
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 Map PolicyID (Map AssetName Integer)
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 i -> Coin -> Coin
forall i. Integral i => i -> Coin -> Coin
forall t i. (Val t, Integral i) => i -> t -> t
<×> Coin
c)
      (Map PolicyID (Map AssetName Integer) -> MultiAsset
MultiAsset ((Map AssetName Integer -> Map AssetName Integer)
-> Map PolicyID (Map AssetName Integer)
-> Map PolicyID (Map AssetName Integer)
forall k a.
(Ord k, CanonicalZero a) =>
(a -> a) -> Map k a -> Map k a
canonicalMap ((Integer -> Integer)
-> Map AssetName Integer -> Map AssetName Integer
forall k a.
(Ord k, CanonicalZero a) =>
(a -> a) -> Map k a -> Map k a
canonicalMap (i -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral i
s Integer -> Integer -> Integer
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 Coin -> Coin -> Bool
forall a. Eq a => a -> a -> Bool
== Coin
forall t. Val t => t
zero Bool -> Bool -> Bool
&& Map PolicyID (Map AssetName Integer) -> 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
&& (Map AssetName Integer -> Map AssetName Integer -> Bool)
-> Map PolicyID (Map AssetName Integer)
-> Map PolicyID (Map AssetName Integer)
-> Bool
forall k v.
(Ord k, CanonicalZero v) =>
(v -> v -> Bool) -> Map k v -> Map k v -> Bool
pointWise ((Integer -> Integer -> Bool)
-> Map AssetName Integer -> Map AssetName Integer -> Bool
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.
    | Map PolicyID (Map AssetName Integer) -> Bool
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 =
        Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral
          ( Int -> Int
roundupBytesToWords ([(PolicyID, AssetName, Integer)] -> Int
representationSize ((Coin, [(PolicyID, AssetName, Integer)])
-> [(PolicyID, AssetName, Integer)]
forall a b. (a, b) -> b
snd ((Coin, [(PolicyID, AssetName, Integer)])
 -> [(PolicyID, AssetName, Integer)])
-> (Coin, [(PolicyID, AssetName, Integer)])
-> [(PolicyID, AssetName, Integer)]
forall a b. (a -> b) -> a -> b
$ MaryValue -> (Coin, [(PolicyID, AssetName, Integer)])
gettriples MaryValue
vv))
              Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
repOverhead
          )

  isAdaOnly :: MaryValue -> Bool
isAdaOnly (MaryValue Coin
_ (MultiAsset Map PolicyID (Map AssetName Integer)
m)) = Map PolicyID (Map AssetName Integer) -> Bool
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 (CompactValue -> CompactForm MaryValue)
-> (CompactForm Coin -> CompactValue)
-> CompactForm Coin
-> CompactForm MaryValue
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 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
adaWords Int -> Int -> Int
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 = Int -> Int -> Int
forall a. Integral a => a -> a -> a
quot (Int
b Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
wordLength Int -> Int -> Int
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 <- Decoder s TokenType
forall s. Decoder s TokenType
peekTokenType
  case TokenType
tt of
    TokenType
TypeUInt -> Coin -> MaryValue
forall t s. Inject t s => t -> s
inject (Coin -> MaryValue) -> (Word64 -> Coin) -> Word64 -> MaryValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Coin
Coin (Integer -> Coin) -> (Word64 -> Integer) -> Word64 -> Coin
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Integer
forall a. Integral a => a -> Integer
toInteger (Word64 -> MaryValue) -> Decoder s Word64 -> Decoder s MaryValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s Word64
forall s. Decoder s Word64
decodeWord64
    TokenType
TypeUInt64 -> Coin -> MaryValue
forall t s. Inject t s => t -> s
inject (Coin -> MaryValue) -> (Word64 -> Coin) -> Word64 -> MaryValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Coin
Coin (Integer -> Coin) -> (Word64 -> Integer) -> Word64 -> Coin
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Integer
forall a. Integral a => a -> Integer
toInteger (Word64 -> MaryValue) -> Decoder s Word64 -> Decoder s MaryValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s Word64
forall s. Decoder s Word64
decodeWord64
    TokenType
TypeListLen -> (forall t. Decoder t Integer) -> Decoder s MaryValue
forall s. (forall t. Decoder t Integer) -> Decoder s MaryValue
decodeValuePair (Word64 -> Integer
forall a. Integral a => a -> Integer
toInteger (Word64 -> Integer) -> Decoder t Word64 -> Decoder t Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder t Word64
forall s. Decoder s Word64
decodeWord64)
    TokenType
TypeListLen64 -> (forall t. Decoder t Integer) -> Decoder s MaryValue
forall s. (forall t. Decoder t Integer) -> Decoder s MaryValue
decodeValuePair (Word64 -> Integer
forall a. Integral a => a -> Integer
toInteger (Word64 -> Integer) -> Decoder t Word64 -> Decoder t Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder t Word64
forall s. Decoder s Word64
decodeWord64)
    TokenType
TypeListLenIndef -> (forall t. Decoder t Integer) -> Decoder s MaryValue
forall s. (forall t. Decoder t Integer) -> Decoder s MaryValue
decodeValuePair (Word64 -> Integer
forall a. Integral a => a -> Integer
toInteger (Word64 -> Integer) -> Decoder t Word64 -> Decoder t Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder t Word64
forall s. Decoder s Word64
decodeWord64)
    TokenType
_ -> [Char] -> Decoder s MaryValue
forall a. [Char] -> Decoder s a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char] -> Decoder s MaryValue) -> [Char] -> Decoder s MaryValue
forall a b. (a -> b) -> a -> b
$ [Char]
"MaryValue: expected array or int, got " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ TokenType -> [Char]
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 =
  Decode ('Closed 'Dense) MaryValue -> Decoder s MaryValue
forall t (w :: Wrapped) s. Typeable t => Decode w t -> Decoder s t
decode (Decode ('Closed 'Dense) MaryValue -> Decoder s MaryValue)
-> Decode ('Closed 'Dense) MaryValue -> Decoder s MaryValue
forall a b. (a -> b) -> a -> b
$
    (Coin -> MultiAsset -> MaryValue)
-> Decode ('Closed 'Dense) (Coin -> MultiAsset -> MaryValue)
forall t. t -> Decode ('Closed 'Dense) t
RecD Coin -> MultiAsset -> MaryValue
MaryValue
      Decode ('Closed 'Dense) (Coin -> MultiAsset -> MaryValue)
-> Decode ('Closed 'Dense) Coin
-> Decode ('Closed 'Dense) (MultiAsset -> MaryValue)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! (forall s. Decoder s Coin) -> Decode ('Closed 'Dense) Coin
forall t. (forall s. Decoder s t) -> Decode ('Closed 'Dense) t
D (Integer -> Coin
Coin (Integer -> Coin) -> (Word64 -> Integer) -> Word64 -> Coin
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Integer
forall a. Integral a => a -> Integer
toInteger (Word64 -> Coin) -> Decoder s Word64 -> Decoder s Coin
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s Word64
forall s. Decoder s Word64
decodeWord64)
      Decode ('Closed 'Dense) (MultiAsset -> MaryValue)
-> Decode ('Closed 'Dense) MultiAsset
-> Decode ('Closed 'Dense) MaryValue
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! (forall s. Decoder s MultiAsset)
-> Decode ('Closed 'Dense) MultiAsset
forall t. (forall s. Decoder s t) -> Decode ('Closed 'Dense) t
D ((forall t. Decoder t Integer) -> Decoder s MultiAsset
forall s. (forall t. Decoder t Integer) -> Decoder s MultiAsset
decodeMultiAsset Decoder t Integer
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 <-
    Version
-> Decoder s MultiAsset
-> Decoder s MultiAsset
-> Decoder s MultiAsset
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 MultiAsset -> Decoder s () -> Decoder s MultiAsset
forall a b. a -> Decoder s b -> Decoder s a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Bool -> Decoder s () -> Decoder s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (MultiAsset -> Bool
isMultiAssetSmallEnough MultiAsset
ma) ([Char] -> Decoder s ()
forall a. [Char] -> Decoder s a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"MultiAsset is too big to compact")
  where
    decodeWithEnforcing :: Decoder s MultiAsset
decodeWithEnforcing =
      (Map PolicyID (Map AssetName Integer) -> MultiAsset)
-> Decoder s (Map PolicyID (Map AssetName Integer))
-> Decoder s MultiAsset
forall a b. (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Map PolicyID (Map AssetName Integer) -> MultiAsset
MultiAsset (Decoder s (Map PolicyID (Map AssetName Integer))
 -> Decoder s MultiAsset)
-> Decoder s (Map PolicyID (Map AssetName Integer))
-> Decoder s MultiAsset
forall a b. (a -> b) -> a -> b
$ Decoder s PolicyID
-> Decoder s (Map AssetName Integer)
-> Decoder s (Map PolicyID (Map AssetName Integer))
forall k s v.
Ord k =>
Decoder s k -> Decoder s v -> Decoder s (Map k v)
decodeMap Decoder s PolicyID
forall s. Decoder s PolicyID
forall a s. DecCBOR a => Decoder s a
decCBOR (Decoder s (Map AssetName Integer)
 -> Decoder s (Map PolicyID (Map AssetName Integer)))
-> Decoder s (Map AssetName Integer)
-> Decoder s (Map PolicyID (Map AssetName Integer))
forall a b. (a -> b) -> a -> b
$ do
        Map AssetName Integer
m <- Decoder s AssetName
-> Decoder s Integer -> Decoder s (Map AssetName Integer)
forall k s v.
Ord k =>
Decoder s k -> Decoder s v -> Decoder s (Map k v)
decodeMap Decoder s AssetName
forall s. Decoder s AssetName
forall a s. DecCBOR a => Decoder s a
decCBOR (Decoder s Integer -> Decoder s (Map AssetName Integer))
-> Decoder s Integer -> Decoder s (Map AssetName Integer)
forall a b. (a -> b) -> a -> b
$ do
          Integer
amount <- Decoder s Integer
forall t. Decoder t Integer
decodeAmount
          Integer
amount Integer -> Decoder s () -> Decoder s Integer
forall a b. a -> Decoder s b -> Decoder s a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Bool -> Decoder s () -> Decoder s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Integer
amount Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0) ([Char] -> Decoder s ()
forall a. [Char] -> Decoder s a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"MultiAsset cannot contain zeros")
        Map AssetName Integer
m Map AssetName Integer
-> Decoder s () -> Decoder s (Map AssetName Integer)
forall a b. a -> Decoder s b -> Decoder s a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Bool -> Decoder s () -> Decoder s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Map AssetName Integer -> Bool
forall k a. Map k a -> Bool
Map.null Map AssetName Integer
m) ([Char] -> Decoder s ()
forall a. [Char] -> Decoder s a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"Empty Assets are not allowed")
    decodeWithPrunning :: Decoder s MultiAsset
decodeWithPrunning =
      MultiAsset -> MultiAsset
pruneZeroMultiAsset (MultiAsset -> MultiAsset)
-> (Map PolicyID (Map AssetName Integer) -> MultiAsset)
-> Map PolicyID (Map AssetName Integer)
-> MultiAsset
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map PolicyID (Map AssetName Integer) -> MultiAsset
MultiAsset (Map PolicyID (Map AssetName Integer) -> MultiAsset)
-> Decoder s (Map PolicyID (Map AssetName Integer))
-> Decoder s MultiAsset
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s PolicyID
-> Decoder s (Map AssetName Integer)
-> Decoder s (Map PolicyID (Map AssetName Integer))
forall k s v.
Ord k =>
Decoder s k -> Decoder s v -> Decoder s (Map k v)
decodeMap Decoder s PolicyID
forall s. Decoder s PolicyID
forall a s. DecCBOR a => Decoder s a
decCBOR (Decoder s AssetName
-> Decoder s Integer -> Decoder s (Map AssetName Integer)
forall k s v.
Ord k =>
Decoder s k -> Decoder s v -> Decoder s (Map k v)
decodeMap Decoder s AssetName
forall s. Decoder s AssetName
forall a s. DecCBOR a => Decoder s a
decCBOR Decoder s Integer
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 Map PolicyID (Map AssetName Integer) -> Bool
forall k a. Map k a -> Bool
Map.null Map PolicyID (Map AssetName Integer)
m
      then Coin -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR Coin
c
      else
        Encode ('Closed 'Dense) MaryValue -> Encoding
forall (w :: Wrapped) t. Encode w t -> Encoding
encode (Encode ('Closed 'Dense) MaryValue -> Encoding)
-> Encode ('Closed 'Dense) MaryValue -> Encoding
forall a b. (a -> b) -> a -> b
$
          (Coin -> MultiAsset -> MaryValue)
-> Encode ('Closed 'Dense) (Coin -> MultiAsset -> MaryValue)
forall t. t -> Encode ('Closed 'Dense) t
Rec Coin -> MultiAsset -> MaryValue
MaryValue
            Encode ('Closed 'Dense) (Coin -> MultiAsset -> MaryValue)
-> Encode ('Closed 'Dense) Coin
-> Encode ('Closed 'Dense) (MultiAsset -> MaryValue)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Coin -> Encode ('Closed 'Dense) Coin
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Coin
c
            Encode ('Closed 'Dense) (MultiAsset -> MaryValue)
-> Encode ('Closed 'Dense) MultiAsset
-> Encode ('Closed 'Dense) MaryValue
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> MultiAsset -> Encode ('Closed 'Dense) MultiAsset
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To MultiAsset
ma

instance DecCBOR MaryValue where
  decCBOR :: forall s. Decoder s MaryValue
decCBOR = Decoder s MaryValue
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 <- Decoder s TokenType
forall s. Decoder s TokenType
peekTokenType
  case TokenType
tt of
    TokenType
TypeUInt -> () -> Decoder s ()
forall a. a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    TokenType
TypeUInt64 -> () -> Decoder s ()
forall a. a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    TokenType
TypeNInt -> () -> Decoder s ()
forall a. a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    TokenType
TypeNInt64 -> () -> Decoder s ()
forall a. a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    TokenType
_ -> [Char] -> Decoder s ()
forall a. [Char] -> Decoder s a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"expected major type 0 or 1 when decoding mint field"
  Integer
x <- Decoder s Integer
forall t. Decoder t Integer
decodeInteger
  if Integer
minval Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
x Bool -> Bool -> Bool
&& Integer
x Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
maxval
    then Integer -> Decoder s Integer
forall a. a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Integer
x
    else
      [Char] -> Decoder s Integer
forall a. [Char] -> Decoder s a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char] -> Decoder s Integer) -> [Char] -> Decoder s Integer
forall a b. (a -> b) -> a -> b
$
        Context -> [Char]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
          [ [Char]
"overflow when decoding mint field. min value: "
          , Integer -> [Char]
forall a. Show a => a -> [Char]
show Integer
minval
          , [Char]
" max value: "
          , Integer -> [Char]
forall a. Show a => a -> [Char]
show Integer
maxval
          , [Char]
" got: "
          , Integer -> [Char]
forall a. Show a => a -> [Char]
show Integer
x
          ]
  where
    maxval :: Integer
maxval = Int64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64
forall a. Bounded a => a
maxBound :: Int64)
    minval :: Integer
minval = Int64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64
forall a. Bounded a => a
minBound :: Int64)

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

instance ToJSON MaryValue where
  toJSON :: MaryValue -> Value
toJSON = [Pair] -> Value
object ([Pair] -> Value) -> (MaryValue -> [Pair]) -> MaryValue -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MaryValue -> [Pair]
forall e a. KeyValue e a => MaryValue -> [a]
toMaryValuePairs
  toEncoding :: MaryValue -> Encoding
toEncoding = Series -> Encoding
Aeson.pairs (Series -> Encoding)
-> (MaryValue -> Series) -> MaryValue -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Series] -> Series
forall a. Monoid a => [a] -> a
mconcat ([Series] -> Series)
-> (MaryValue -> [Series]) -> MaryValue -> Series
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MaryValue -> [Series]
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" Key -> Coin -> a
forall v. ToJSON v => Key -> v -> a
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Coin
l
  , Key
"policies" Key -> MultiAsset -> a
forall v. ToJSON v => Key -> v -> a
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 (Text -> Value) -> (AssetName -> Text) -> AssetName -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AssetName -> Text
assetNameToTextAsHex

instance ToJSONKey AssetName where
  toJSONKey :: ToJSONKeyFunction AssetName
toJSONKey = (AssetName -> Text) -> ToJSONKeyFunction AssetName
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
(CompactForm MaryValue -> CompactForm MaryValue -> Bool)
-> (CompactForm MaryValue -> CompactForm MaryValue -> Bool)
-> Eq (CompactForm MaryValue)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CompactForm MaryValue -> CompactForm MaryValue -> Bool
== :: CompactForm MaryValue -> CompactForm MaryValue -> Bool
$c/= :: CompactForm MaryValue -> CompactForm MaryValue -> Bool
/= :: CompactForm MaryValue -> CompactForm MaryValue -> Bool
Eq, Int -> CompactForm MaryValue -> ShowS
[CompactForm MaryValue] -> ShowS
CompactForm MaryValue -> [Char]
(Int -> CompactForm MaryValue -> ShowS)
-> (CompactForm MaryValue -> [Char])
-> ([CompactForm MaryValue] -> ShowS)
-> Show (CompactForm MaryValue)
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CompactForm MaryValue -> ShowS
showsPrec :: Int -> CompactForm MaryValue -> ShowS
$cshow :: CompactForm MaryValue -> [Char]
show :: CompactForm MaryValue -> [Char]
$cshowList :: [CompactForm MaryValue] -> ShowS
showList :: [CompactForm MaryValue] -> ShowS
Show, Context -> CompactForm MaryValue -> IO (Maybe ThunkInfo)
Proxy (CompactForm MaryValue) -> [Char]
(Context -> CompactForm MaryValue -> IO (Maybe ThunkInfo))
-> (Context -> CompactForm MaryValue -> IO (Maybe ThunkInfo))
-> (Proxy (CompactForm MaryValue) -> [Char])
-> NoThunks (CompactForm MaryValue)
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> [Char])
-> NoThunks a
$cnoThunks :: Context -> CompactForm MaryValue -> IO (Maybe ThunkInfo)
noThunks :: Context -> CompactForm MaryValue -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> CompactForm MaryValue -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> CompactForm MaryValue -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy (CompactForm MaryValue) -> [Char]
showTypeOf :: Proxy (CompactForm MaryValue) -> [Char]
NoThunks, Typeable (CompactForm MaryValue)
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)
-> EncCBOR (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
$cencCBOR :: CompactForm MaryValue -> Encoding
encCBOR :: CompactForm MaryValue -> Encoding
$cencodedSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size)
-> Proxy (CompactForm MaryValue) -> Size
encodedSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size)
-> Proxy (CompactForm MaryValue) -> Size
$cencodedListSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size)
-> Proxy [CompactForm MaryValue] -> Size
encodedListSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size)
-> Proxy [CompactForm MaryValue] -> Size
EncCBOR, Typeable (CompactForm MaryValue)
Typeable (CompactForm MaryValue) =>
(forall s. Decoder s (CompactForm MaryValue))
-> (forall s. Proxy (CompactForm MaryValue) -> Decoder s ())
-> (Proxy (CompactForm MaryValue) -> Text)
-> DecCBOR (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 ()
$cdecCBOR :: forall s. Decoder s (CompactForm MaryValue)
decCBOR :: forall s. Decoder s (CompactForm MaryValue)
$cdropCBOR :: forall s. Proxy (CompactForm MaryValue) -> Decoder s ()
dropCBOR :: forall s. Proxy (CompactForm MaryValue) -> Decoder s ()
$clabel :: Proxy (CompactForm MaryValue) -> Text
label :: Proxy (CompactForm MaryValue) -> Text
DecCBOR, CompactForm MaryValue -> ()
(CompactForm MaryValue -> ()) -> NFData (CompactForm MaryValue)
forall a. (a -> ()) -> NFData a
$crnf :: CompactForm MaryValue -> ()
rnf :: CompactForm MaryValue -> ()
NFData, [Char]
[Char]
-> (CompactForm MaryValue -> Int)
-> (forall s. CompactForm MaryValue -> Pack s ())
-> (forall b. Buffer b => Unpack b (CompactForm MaryValue))
-> MemPack (CompactForm MaryValue)
CompactForm MaryValue -> Int
forall a.
[Char]
-> (a -> Int)
-> (forall s. a -> Pack s ())
-> (forall b. Buffer b => Unpack b a)
-> MemPack a
forall s. CompactForm MaryValue -> Pack s ()
forall b. Buffer b => Unpack b (CompactForm MaryValue)
$ctypeName :: [Char]
typeName :: [Char]
$cpackedByteCount :: CompactForm MaryValue -> Int
packedByteCount :: CompactForm MaryValue -> Int
$cpackM :: forall s. CompactForm MaryValue -> Pack s ()
packM :: forall s. CompactForm MaryValue -> Pack s ()
$cunpackM :: forall b. Buffer b => Unpack b (CompactForm MaryValue)
unpackM :: forall b. Buffer b => Unpack b (CompactForm MaryValue)
MemPack)
  toCompact :: MaryValue -> Maybe (CompactForm MaryValue)
toCompact MaryValue
x = CompactValue -> CompactForm MaryValue
CompactValue (CompactValue -> CompactForm MaryValue)
-> Maybe CompactValue -> Maybe (CompactForm MaryValue)
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 = MaryValue -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR (MaryValue -> Encoding)
-> (CompactValue -> MaryValue) -> CompactValue -> Encoding
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 <- Decoder s MaryValue
forall s. Decoder s MaryValue
decodeMaryValue
    case MaryValue -> Maybe CompactValue
to MaryValue
v of
      Maybe CompactValue
Nothing ->
        [Char] -> Decoder s CompactValue
forall a. [Char] -> Decoder s a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail
          [Char]
"impossible failure: decoded nonnegative value that cannot be compacted"
      Just CompactValue
x -> CompactValue -> Decoder s CompactValue
forall a. a -> Decoder s a
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. CompactValue -> Rep CompactValue x)
-> (forall x. Rep CompactValue x -> CompactValue)
-> Generic CompactValue
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
$cfrom :: forall x. CompactValue -> Rep CompactValue x
from :: forall x. CompactValue -> Rep CompactValue x
$cto :: forall x. Rep CompactValue x -> CompactValue
to :: forall x. Rep CompactValue x -> CompactValue
Generic, Int -> CompactValue -> ShowS
[CompactValue] -> ShowS
CompactValue -> [Char]
(Int -> CompactValue -> ShowS)
-> (CompactValue -> [Char])
-> ([CompactValue] -> ShowS)
-> Show CompactValue
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CompactValue -> ShowS
showsPrec :: Int -> CompactValue -> ShowS
$cshow :: CompactValue -> [Char]
show :: CompactValue -> [Char]
$cshowList :: [CompactValue] -> ShowS
showList :: [CompactValue] -> ShowS
Show)

-- | We need to manually pack/unpack `CompactForm Coin` here because its MemPack instance can't be
-- used due to the requirement of it being compatible with the first case of
-- `CompactValueAdaOnly`. In other words `MemPack` instance for `CompactForm Coin` also prefixes a
-- zero Tag for binary compatibility with `CompactValueAdaOnly` case.
instance MemPack CompactValue where
  packedByteCount :: CompactValue -> Int
packedByteCount = \case
    CompactValueAdaOnly CompactForm Coin
c ->
      Int
packedTagByteCount Int -> Int -> Int
forall a. Num a => a -> a -> a
+ CompactForm Coin -> Int
compactCoinByteCount CompactForm Coin
c
    CompactValueMultiAsset CompactForm Coin
c Word32
numMA ShortByteString
rep -> do
      Int
packedTagByteCount
        Int -> Int -> Int
forall a. Num a => a -> a -> a
+ CompactForm Coin -> Int
compactCoinByteCount CompactForm Coin
c
        Int -> Int -> Int
forall a. Num a => a -> a -> a
+ VarLen Word32 -> Int
forall a. MemPack a => a -> Int
packedByteCount (Word32 -> VarLen Word32
forall a. a -> VarLen a
VarLen Word32
numMA)
        Int -> Int -> Int
forall a. Num a => a -> a -> a
+ ShortByteString -> Int
forall a. MemPack a => a -> Int
packedByteCount ShortByteString
rep
    where
      compactCoinByteCount :: CompactForm Coin -> Int
compactCoinByteCount (CompactCoin Word64
c) = VarLen Word64 -> Int
forall a. MemPack a => a -> Int
packedByteCount (Word64 -> VarLen Word64
forall a. a -> VarLen a
VarLen Word64
c)
  {-# INLINE packedByteCount #-}
  packM :: forall s. CompactValue -> Pack s ()
packM = \case
    CompactValueAdaOnly CompactForm Coin
c ->
      Tag -> Pack s ()
forall s. Tag -> Pack s ()
packTagM Tag
0 Pack s () -> Pack s () -> Pack s ()
forall a b. Pack s a -> Pack s b -> Pack s b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> CompactForm Coin -> Pack s ()
forall {s}. CompactForm Coin -> Pack s ()
packCompactCoinM CompactForm Coin
c
    CompactValueMultiAsset CompactForm Coin
c Word32
numMA ShortByteString
rep -> do
      Tag -> Pack s ()
forall s. Tag -> Pack s ()
packTagM Tag
1 Pack s () -> Pack s () -> Pack s ()
forall a b. Pack s a -> Pack s b -> Pack s b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> CompactForm Coin -> Pack s ()
forall {s}. CompactForm Coin -> Pack s ()
packCompactCoinM CompactForm Coin
c Pack s () -> Pack s () -> Pack s ()
forall a b. Pack s a -> Pack s b -> Pack s b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> VarLen Word32 -> Pack s ()
forall a s. MemPack a => a -> Pack s ()
forall s. VarLen Word32 -> Pack s ()
packM (Word32 -> VarLen Word32
forall a. a -> VarLen a
VarLen Word32
numMA) Pack s () -> Pack s () -> Pack s ()
forall a b. Pack s a -> Pack s b -> Pack s b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ShortByteString -> Pack s ()
forall s. ShortByteString -> Pack s ()
forall a s. MemPack a => a -> Pack s ()
packM ShortByteString
rep
    where
      -- See note on the instance for why `MemPack` instance for `CompactForm Coin` can't be used.
      packCompactCoinM :: CompactForm Coin -> Pack s ()
packCompactCoinM (CompactCoin Word64
c) = VarLen Word64 -> Pack s ()
forall a s. MemPack a => a -> Pack s ()
forall s. VarLen Word64 -> Pack s ()
packM (Word64 -> VarLen Word64
forall a. a -> VarLen a
VarLen Word64
c)
      {-# INLINE packCompactCoinM #-}
  {-# INLINE packM #-}
  unpackM :: forall b. Buffer b => Unpack b CompactValue
unpackM = do
    Unpack b Tag
forall b. Buffer b => Unpack b Tag
unpackTagM Unpack b Tag
-> (Tag -> Unpack b CompactValue) -> Unpack b CompactValue
forall a b. Unpack b a -> (a -> Unpack b b) -> Unpack b b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Tag
0 -> CompactForm Coin -> CompactValue
CompactValueAdaOnly (CompactForm Coin -> CompactValue)
-> Unpack b (CompactForm Coin) -> Unpack b CompactValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Unpack b (CompactForm Coin)
unpackCompactCoinM
      Tag
1 -> CompactForm Coin -> Word32 -> ShortByteString -> CompactValue
CompactValueMultiAsset (CompactForm Coin -> Word32 -> ShortByteString -> CompactValue)
-> Unpack b (CompactForm Coin)
-> Unpack b (Word32 -> ShortByteString -> CompactValue)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Unpack b (CompactForm Coin)
unpackCompactCoinM Unpack b (Word32 -> ShortByteString -> CompactValue)
-> Unpack b Word32 -> Unpack b (ShortByteString -> CompactValue)
forall a b. Unpack b (a -> b) -> Unpack b a -> Unpack b b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (VarLen Word32 -> Word32
forall a. VarLen a -> a
unVarLen (VarLen Word32 -> Word32)
-> Unpack b (VarLen Word32) -> Unpack b Word32
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Unpack b (VarLen Word32)
forall a b. (MemPack a, Buffer b) => Unpack b a
forall b. Buffer b => Unpack b (VarLen Word32)
unpackM) Unpack b (ShortByteString -> CompactValue)
-> Unpack b ShortByteString -> Unpack b CompactValue
forall a b. Unpack b (a -> b) -> Unpack b a -> Unpack b b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Unpack b ShortByteString
forall a b. (MemPack a, Buffer b) => Unpack b a
forall b. Buffer b => Unpack b ShortByteString
unpackM
      Tag
n -> forall a (m :: * -> *) b. (MemPack a, MonadFail m) => Tag -> m b
unknownTagM @CompactValue Tag
n
    where
      unpackCompactCoinM :: Unpack b (CompactForm Coin)
unpackCompactCoinM = Word64 -> CompactForm Coin
CompactCoin (Word64 -> CompactForm Coin)
-> (VarLen Word64 -> Word64) -> VarLen Word64 -> CompactForm Coin
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VarLen Word64 -> Word64
forall a. VarLen a -> a
unVarLen (VarLen Word64 -> CompactForm Coin)
-> Unpack b (VarLen Word64) -> Unpack b (CompactForm Coin)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Unpack b (VarLen Word64)
forall a b. (MemPack a, Buffer b) => Unpack b a
forall b. Buffer b => Unpack b (VarLen Word64)
unpackM
      {-# INLINE unpackCompactCoinM #-}
  {-# INLINE unpackM #-}

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

instance Eq CompactValue where
  CompactValue
a == :: CompactValue -> CompactValue -> Bool
== CompactValue
b = CompactValue -> MaryValue
from CompactValue
a MaryValue -> MaryValue -> Bool
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))
  | Map PolicyID (Map AssetName Integer) -> Bool
forall k a. Map k a -> Bool
Map.null Map PolicyID (Map AssetName Integer)
m = CompactForm Coin -> CompactValue
CompactValueAdaOnly (CompactForm Coin -> CompactValue)
-> Maybe (CompactForm Coin) -> Maybe CompactValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Coin -> Maybe (CompactForm Coin)
forall a. Compactible a => a -> Maybe (CompactForm a)
toCompact Coin
ada
to v :: MaryValue
v@(MaryValue Coin
_ MultiAsset
ma) = do
  CompactForm Coin
c <- Bool -> Maybe (CompactForm Coin) -> Maybe (CompactForm Coin)
forall a. HasCallStack => Bool -> a -> a
assert (MultiAsset -> Bool
isMultiAssetSmallEnough MultiAsset
ma) (Coin -> Maybe (CompactForm Coin)
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 <-
    [Int]
-> [(Word16, Word16, Word64)] -> [(Int, (Word16, Word16, Word64))]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0 ..] ([(Word16, Word16, Word64)] -> [(Int, (Word16, Word16, Word64))])
-> ([(Word16, Word16, Word64)] -> [(Word16, Word16, Word64)])
-> [(Word16, Word16, Word64)]
-> [(Int, (Word16, Word16, Word64))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Word16, Word16, Word64) -> Word16)
-> [(Word16, Word16, Word64)] -> [(Word16, Word16, Word64)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (\(Word16
_, Word16
x, Word64
_) -> Word16
x) ([(Word16, Word16, Word64)] -> [(Int, (Word16, Word16, Word64))])
-> Maybe [(Word16, Word16, Word64)]
-> Maybe [(Int, (Word16, Word16, Word64))]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((PolicyID, AssetName, Integer) -> Maybe (Word16, Word16, Word64))
-> [(PolicyID, AssetName, Integer)]
-> Maybe [(Word16, Word16, Word64)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (PolicyID, AssetName, Integer) -> Maybe (Word16, Word16, Word64)
prepare [(PolicyID, AssetName, Integer)]
triples
  CompactValue -> Maybe CompactValue
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CompactValue -> Maybe CompactValue)
-> CompactValue -> Maybe CompactValue
forall a b. (a -> b) -> a -> b
$
    CompactForm Coin -> Word32 -> ShortByteString -> CompactValue
CompactValueMultiAsset CompactForm Coin
c (Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
numTriples) (ShortByteString -> CompactValue)
-> ShortByteString -> CompactValue
forall a b. (a -> b) -> a -> b
$
      (forall s. ST s ShortByteString) -> ShortByteString
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s ShortByteString) -> ShortByteString)
-> (forall s. ST s ShortByteString) -> ShortByteString
forall a b. (a -> b) -> a -> b
$ do
        MutableByteArray s
byteArray <- Int -> ST s (MutableByteArray (PrimState (ST s)))
forall (m :: * -> *).
PrimMonad m =>
Int -> m (MutableByteArray (PrimState m))
BA.newByteArray Int
repSize
        [(Int, (Word16, Word16, Word64))]
-> ((Int, (Word16, Word16, Word64)) -> ST s ()) -> ST s ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(Int, (Word16, Word16, Word64))]
preparedTriples (((Int, (Word16, Word16, Word64)) -> ST s ()) -> ST s ())
-> ((Int, (Word16, Word16, Word64)) -> ST s ()) -> ST s ()
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.
            MutableByteArray (PrimState (ST s)) -> Int -> Word64 -> ST s ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
BA.writeByteArray MutableByteArray s
MutableByteArray (PrimState (ST s))
byteArray Int
i Word64
q
            MutableByteArray (PrimState (ST s)) -> Int -> Word16 -> ST s ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
BA.writeByteArray MutableByteArray s
MutableByteArray (PrimState (ST s))
byteArray (Int
4 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
numTriples Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
i) Word16
pidoff
            MutableByteArray (PrimState (ST s)) -> Int -> Word16 -> ST s ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
BA.writeByteArray MutableByteArray s
MutableByteArray (PrimState (ST s))
byteArray (Int
5 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
numTriples Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
i) Word16
anoff

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

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

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

    -- pids is the collection of all distinct pids
    pids :: Set PolicyID
pids = [PolicyID] -> Set PolicyID
forall a. Ord a => [a] -> Set a
Set.fromList ([PolicyID] -> Set PolicyID) -> [PolicyID] -> Set PolicyID
forall a b. (a -> b) -> a -> b
$ (\(PolicyID
pid, AssetName
_, Integer
_) -> PolicyID
pid) ((PolicyID, AssetName, Integer) -> PolicyID)
-> [(PolicyID, AssetName, Integer)] -> [PolicyID]
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 =
            Word16 -> Word16 -> [Word16]
forall a. Enum a => a -> a -> [a]
enumFromThen (Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
abcRegionSize) (Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
abcRegionSize Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
pidSize))
       in [(PolicyID, Word16)] -> Map PolicyID Word16
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([PolicyID] -> [Word16] -> [(PolicyID, Word16)]
forall a b. [a] -> [b] -> [(a, b)]
zip (Set PolicyID -> [PolicyID]
forall a. Set a -> [a]
Set.toList Set PolicyID
pids) [Word16]
offsets)

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

    pidBlockSize :: Int
pidBlockSize = Set PolicyID -> Int
forall a. Set a -> Int
Set.size Set PolicyID
pids Int -> Int -> Int
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 = Set AssetName -> [AssetName]
forall a. Set a -> [a]
Set.toDescList (Set AssetName -> [AssetName]) -> Set AssetName -> [AssetName]
forall a b. (a -> b) -> a -> b
$ [AssetName] -> Set AssetName
forall a. Ord a => [a] -> Set a
Set.fromList ([AssetName] -> Set AssetName) -> [AssetName] -> Set AssetName
forall a b. (a -> b) -> a -> b
$ (\(PolicyID
_, AssetName
an, Integer
_) -> AssetName
an) ((PolicyID, AssetName, Integer) -> AssetName)
-> [(PolicyID, AssetName, Integer)] -> [AssetName]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(PolicyID, AssetName, Integer)]
triples

    assetNameLengths :: [Int]
assetNameLengths = Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int) -> (AssetName -> Int) -> AssetName -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortByteString -> Int
SBS.length (ShortByteString -> Int)
-> (AssetName -> ShortByteString) -> AssetName -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AssetName -> ShortByteString
assetNameBytes (AssetName -> Int) -> [AssetName] -> [Int]
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 = (Int -> Int -> Int) -> Int -> [Int] -> [Int]
forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl Int -> Int -> Int
forall a. Num a => a -> a -> a
(+) (Int
abcRegionSize Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
pidBlockSize) [Int]
assetNameLengths
       in Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word16) -> Map AssetName Int -> Map AssetName Word16
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(AssetName, Int)] -> Map AssetName Int
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([AssetName] -> [Int] -> [(AssetName, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip [AssetName]
assetNames [Int]
offsets)

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

    anameBlockSize :: Int
anameBlockSize = [Int] -> Int
forall a. Num a => [a] -> a
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 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
pidBlockSize Int -> Int -> Int
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
      (Word16, Word16, Word64) -> Maybe (Word16, Word16, Word64)
forall a. a -> Maybe a
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 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Sum Int -> Int
forall a. Sum a -> a
M.getSum ((Map AssetName Integer -> Sum Int)
-> Map PolicyID (Map AssetName Integer) -> Sum Int
forall m a. Monoid m => (a -> m) -> Map PolicyID a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap' (Int -> Sum Int
forall a. a -> Sum a
M.Sum (Int -> Sum Int)
-> (Map AssetName Integer -> Int)
-> Map AssetName Integer
-> Sum Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map AssetName Integer -> Int
forall a. Map AssetName a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length) Map PolicyID (Map AssetName Integer)
ma) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
28 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Map PolicyID (Map AssetName Integer) -> Int
forall a. Map PolicyID a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Map PolicyID (Map AssetName Integer)
ma Int -> Int -> Bool
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 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
pidBlockSize Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
anameBlockSize
  where
    len :: Int
len = [(PolicyID, AssetName, Integer)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(PolicyID, AssetName, Integer)]
xs
    abcRegionSize :: Int
abcRegionSize = Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
12

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

    assetNames :: Set AssetName
assetNames = [AssetName] -> Set AssetName
forall a. Ord a => [a] -> Set a
Set.fromList ([AssetName] -> Set AssetName) -> [AssetName] -> Set AssetName
forall a b. (a -> b) -> a -> b
$ (\(PolicyID
_, AssetName
an, Integer
_) -> AssetName
an) ((PolicyID, AssetName, Integer) -> AssetName)
-> [(PolicyID, AssetName, Integer)] -> [AssetName]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(PolicyID, AssetName, Integer)]
xs
    anameBlockSize :: Int
anameBlockSize =
      Sum Int -> Int
forall a. Sum a -> a
Semigroup.getSum (Sum Int -> Int) -> Sum Int -> Int
forall a b. (a -> b) -> a -> b
$ (AssetName -> Sum Int) -> Set AssetName -> Sum Int
forall m a. Monoid m => (a -> m) -> Set a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap' (Int -> Sum Int
forall a. a -> Sum a
Semigroup.Sum (Int -> Sum Int) -> (AssetName -> Int) -> AssetName -> Sum Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortByteString -> Int
SBS.length (ShortByteString -> Int)
-> (AssetName -> ShortByteString) -> AssetName -> Int
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 (CompactForm Coin -> Coin
forall a. Compactible a => CompactForm a -> a
fromCompact CompactForm Coin
c) (Map PolicyID (Map AssetName Integer) -> MultiAsset
MultiAsset Map PolicyID (Map AssetName Integer)
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 (CompactForm Coin -> Coin
forall a. Compactible a => CompactForm a -> a
fromCompact CompactForm Coin
c) [(PolicyID, AssetName, Integer)]
triples
   in Bool -> MaryValue -> MaryValue
forall a. HasCallStack => Bool -> a -> a
assert (MultiAsset -> Bool
isMultiAssetSmallEnough MultiAsset
ma) MaryValue
mv
  where
    n :: Int
n = Word32 -> Int
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 = ByteArray -> Int -> Word64
forall a. Prim a => ByteArray -> Int -> a
BA.indexByteArray ByteArray
ba Int
i
          pidix :: Word16
pidix = ByteArray -> Int -> Word16
forall a. Prim a => ByteArray -> Int -> a
BA.indexByteArray ByteArray
ba (Int
4 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
i)
          anameix :: Word16
anameix = ByteArray -> Int -> Word16
forall a. Prim a => ByteArray -> Int -> a
BA.indexByteArray ByteArray
ba (Int
5 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
n Int -> Int -> Int
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 = (Int -> (Word16, Word16, Word64))
-> [Int] -> [(Word16, Word16, Word64)]
forall a b. (a -> b) -> [a] -> [b]
map Int -> (Word16, Word16, Word64)
getTripleForIndex [Int
0 .. (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int) -> Word32 -> Int
forall a b. (a -> b) -> a -> b
$ Word32
numAssets Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
- Word32
1)]

    triples :: [(PolicyID, AssetName, Integer)]
    triples :: [(PolicyID, AssetName, Integer)]
triples = ((Word16, Word16, Word64) -> (PolicyID, AssetName, Integer))
-> [(Word16, Word16, Word64)] -> [(PolicyID, AssetName, Integer)]
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 = [Word16] -> [Word16]
forall a. Ord a => [a] -> [a]
nubOrd ([Word16] -> [Word16]) -> [Word16] -> [Word16]
forall a b. (a -> b) -> a -> b
$ ((Word16, Word16, Word64) -> Word16)
-> [(Word16, Word16, Word64)] -> [Word16]
forall a b. (a -> b) -> [a] -> [b]
map (\(Word16
_, Word16
x, Word64
_) -> Word16
x) [(Word16, Word16, Word64)]
rawTriples
          ixPairs :: [(Word16, Word16)]
ixPairs = [Word16] -> [Word16] -> [(Word16, Word16)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Word16]
ixs (Int -> [Word16] -> [Word16]
forall a. Int -> [a] -> [a]
drop Int
1 [Word16]
ixs [Word16] -> [Word16] -> [Word16]
forall a. [a] -> [a] -> [a]
++ [Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word16) -> Int -> Word16
forall a b. (a -> b) -> a -> b
$ ShortByteString -> Int
SBS.length ShortByteString
rep])
       in [(Word16, Int)] -> Map Word16 Int
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Word16, Int)] -> Map Word16 Int)
-> [(Word16, Int)] -> Map Word16 Int
forall a b. (a -> b) -> a -> b
$ (\(Word16
a, Word16
b) -> (Word16
a, Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16 -> Int) -> Word16 -> Int
forall a b. (a -> b) -> a -> b
$ Word16
b Word16 -> Word16 -> Word16
forall a. Num a => a -> a -> a
- Word16
a)) ((Word16, Word16) -> (Word16, Int))
-> [(Word16, Word16)] -> [(Word16, Int)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Word16, Word16)]
ixPairs
    assetLen :: Word16 -> Int
    assetLen :: Word16 -> Int
assetLen Word16
ix = Maybe Int -> Int
forall a. HasCallStack => Maybe a -> a
fromJust (Word16 -> Map Word16 Int -> Maybe Int
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 (ScriptHash -> PolicyID) -> ScriptHash -> PolicyID
forall a b. (a -> b) -> a -> b
$
          Hash ADDRHASH EraIndependentScript -> ScriptHash
ScriptHash (Hash ADDRHASH EraIndependentScript -> ScriptHash)
-> Hash ADDRHASH EraIndependentScript -> ScriptHash
forall a b. (a -> b) -> a -> b
$
            ShortByteString -> Hash ADDRHASH EraIndependentScript
forall h a. HashAlgorithm h => ShortByteString -> Hash h a
Hash.UnsafeHash (ShortByteString -> Hash ADDRHASH EraIndependentScript)
-> ShortByteString -> Hash ADDRHASH EraIndependentScript
forall a b. (a -> b) -> a -> b
$
              ShortByteString -> Int -> Int -> ShortByteString
readShortByteString
                ShortByteString
rep
                (Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
p)
                (Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word -> Int) -> Word -> Int
forall a b. (a -> b) -> a -> b
$ [ADDRHASH] -> Word
forall h (proxy :: * -> *). HashAlgorithm h => proxy h -> Word
Hash.sizeHash ([] :: [ADDRHASH]))
      , ShortByteString -> AssetName
AssetName (ShortByteString -> AssetName) -> ShortByteString -> AssetName
forall a b. (a -> b) -> a -> b
$ ShortByteString -> Int -> Int -> ShortByteString
readShortByteString ShortByteString
rep (Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
a) (Word16 -> Int
assetLen Word16
a)
      , Word64 -> Integer
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 =
  Set a -> [a] -> [a]
forall {a}. Ord a => Set a -> [a] -> [a]
loop Set a
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 a -> Set a -> Bool
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' = a -> Set a -> Set a
forall a. Ord a => a -> Set a -> Set a
Set.insert a
a Set a
s in Set a
s' Set a -> [a] -> [a]
forall a b. a -> b -> b
`seq` a
a a -> [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 (ByteArray -> ShortByteString) -> ByteArray -> ShortByteString
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) = Map PolicyID (Map AssetName Integer) -> Set PolicyID
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 PolicyID
-> Map PolicyID (Map AssetName Integer)
-> Maybe (Map AssetName Integer)
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 -> Integer -> AssetName -> Map AssetName Integer -> Integer
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 PolicyID
-> Map PolicyID (Map AssetName Integer)
-> (Map PolicyID (Map AssetName Integer),
    Maybe (Map AssetName Integer),
    Map PolicyID (Map AssetName Integer))
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 AssetName
-> Map AssetName Integer
-> (Map AssetName Integer, Maybe Integer, Map AssetName Integer)
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 Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0
            then
              let m3 :: Map AssetName Integer
m3 = Map AssetName Integer
-> Map AssetName Integer -> Map AssetName Integer
forall k a. Map k a -> Map k a -> Map k a
link2 Map AssetName Integer
v1 Map AssetName Integer
v2
               in if Map AssetName Integer -> Bool
forall k a. Map k a -> Bool
Map.null Map AssetName Integer
m3
                    then Map PolicyID (Map AssetName Integer) -> MultiAsset
MultiAsset (Map PolicyID (Map AssetName Integer)
-> Map PolicyID (Map AssetName Integer)
-> Map PolicyID (Map AssetName Integer)
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 (PolicyID
-> Map AssetName Integer
-> Map PolicyID (Map AssetName Integer)
-> Map PolicyID (Map AssetName Integer)
-> Map PolicyID (Map AssetName Integer)
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 (PolicyID
-> Map AssetName Integer
-> Map PolicyID (Map AssetName Integer)
-> Map PolicyID (Map AssetName Integer)
-> Map PolicyID (Map AssetName Integer)
forall k a. k -> a -> Map k a -> Map k a -> Map k a
link PolicyID
pid (AssetName
-> Integer
-> Map AssetName Integer
-> Map AssetName Integer
-> Map AssetName Integer
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
            ( PolicyID
-> Map AssetName Integer
-> Map PolicyID (Map AssetName Integer)
-> Map PolicyID (Map AssetName Integer)
-> Map PolicyID (Map AssetName Integer)
forall k a. k -> a -> Map k a -> Map k a -> Map k a
link
                PolicyID
pid
                ( if Integer
new Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0
                    then Map AssetName Integer
m2
                    else AssetName
-> Integer -> Map AssetName Integer -> Map AssetName Integer
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 Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0
            then Map PolicyID (Map AssetName Integer)
-> Map PolicyID (Map AssetName Integer)
-> Map PolicyID (Map AssetName Integer)
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 PolicyID
-> Map AssetName Integer
-> Map PolicyID (Map AssetName Integer)
-> Map PolicyID (Map AssetName Integer)
-> Map PolicyID (Map AssetName Integer)
forall k a. k -> a -> Map k a -> Map k a -> Map k a
link PolicyID
pid (AssetName -> Integer -> Map AssetName Integer
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 =
  (Map AssetName Integer -> Bool)
-> Map PolicyID (Map AssetName Integer)
-> Map PolicyID (Map AssetName Integer)
forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter (Bool -> Bool
not (Bool -> Bool)
-> (Map AssetName Integer -> Bool) -> Map AssetName Integer -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map AssetName Integer -> Bool
forall a. Map AssetName a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) (Map PolicyID (Map AssetName Integer)
 -> Map PolicyID (Map AssetName Integer))
-> Map PolicyID (Map AssetName Integer)
-> Map PolicyID (Map AssetName Integer)
forall a b. (a -> b) -> a -> b
$ (Integer -> Bool) -> Map AssetName Integer -> Map AssetName Integer
forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter (Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
/= Integer
0) (Map AssetName Integer -> Map AssetName Integer)
-> Map PolicyID (Map AssetName Integer)
-> Map PolicyID (Map AssetName Integer)
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
_ -> (Integer -> Integer -> Bool
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 (Map PolicyID (Map AssetName Integer) -> MultiAsset)
-> Map PolicyID (Map AssetName Integer) -> MultiAsset
forall a b. (a -> b) -> a -> b
$ (PolicyID
 -> Map AssetName Integer -> Maybe (Map AssetName Integer))
-> Map PolicyID (Map AssetName Integer)
-> Map PolicyID (Map AssetName Integer)
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 = (AssetName -> Integer -> Bool)
-> Map AssetName Integer -> Map AssetName Integer
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
      Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Bool
not (Map AssetName Integer -> Bool
forall a. Map AssetName a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Map AssetName Integer
newAssetMap))
      Map AssetName Integer -> Maybe (Map AssetName Integer)
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 (Map PolicyID (Map AssetName Integer) -> MultiAsset)
-> Map PolicyID (Map AssetName Integer) -> MultiAsset
forall a b. (a -> b) -> a -> b
$ (PolicyID
 -> Map AssetName Integer -> Maybe (Map AssetName Integer))
-> Map PolicyID (Map AssetName Integer)
-> Map PolicyID (Map AssetName Integer)
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 = (AssetName -> Integer -> Maybe Integer)
-> Map AssetName Integer -> Map AssetName Integer
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
      Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Bool
not (Map AssetName Integer -> Bool
forall a. Map AssetName a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Map AssetName Integer
newAssetMap))
      Map AssetName Integer -> Maybe (Map AssetName Integer)
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
      Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Integer
newAssetValue Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
/= Integer
0)
      Integer -> Maybe Integer
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 = ((PolicyID, AssetName, Integer) -> MultiAsset -> MultiAsset)
-> MultiAsset -> [(PolicyID, AssetName, Integer)] -> MultiAsset
forall a b. (a -> b -> b) -> b -> [a] -> b
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 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
(+) PolicyID
p AssetName
n Integer
i MultiAsset
ans) MultiAsset
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 = Coin -> [Char]
forall a. Show a => a -> [Char]
show Coin
c [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"\n" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Context -> [Char]
unlines (((PolicyID, AssetName, Integer) -> [Char])
-> [(PolicyID, AssetName, Integer)] -> Context
forall a b. (a -> b) -> [a] -> [b]
map (PolicyID, AssetName, Integer) -> [Char]
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) =
      ScriptHash -> [Char]
forall a. Show a => a -> [Char]
show ScriptHash
x
        [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
",  "
        [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> [Char]
forall a. Show a => a -> [Char]
show a
hash
        [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
",  "
        [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> [Char]
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) <- Map PolicyID (Map AssetName Integer)
-> [(PolicyID, Map AssetName Integer)]
forall k a. Map k a -> [(k, a)]
assocs Map PolicyID (Map AssetName Integer)
m
  , (AssetName
aname, Integer
amount) <- Map AssetName Integer -> [(AssetName, Integer)]
forall k a. Map k a -> [(k, a)]
assocs Map AssetName Integer
m2
  ]