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

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

  -- * Deprecated
  prune,
)
where

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

-- | Asset Name
newtype AssetName = AssetName {AssetName -> ShortByteString
assetNameBytes :: SBS.ShortByteString}
  deriving newtype
    ( AssetName -> AssetName -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AssetName -> AssetName -> Bool
$c/= :: AssetName -> AssetName -> Bool
== :: AssetName -> AssetName -> Bool
$c== :: AssetName -> AssetName -> Bool
Eq
    , Typeable AssetName
AssetName -> Encoding
(forall t. EncCBOR t => Proxy t -> Size)
-> Proxy [AssetName] -> Size
(forall t. EncCBOR t => Proxy t -> Size) -> Proxy AssetName -> Size
forall a.
Typeable a
-> (a -> Encoding)
-> ((forall t. EncCBOR t => Proxy t -> Size) -> Proxy a -> Size)
-> ((forall t. EncCBOR t => Proxy t -> Size) -> Proxy [a] -> Size)
-> EncCBOR a
encodedListSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size)
-> Proxy [AssetName] -> Size
$cencodedListSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size)
-> Proxy [AssetName] -> Size
encodedSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size) -> Proxy AssetName -> Size
$cencodedSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size) -> Proxy AssetName -> Size
encCBOR :: AssetName -> Encoding
$cencCBOR :: AssetName -> Encoding
EncCBOR
    , Eq AssetName
AssetName -> AssetName -> Bool
AssetName -> AssetName -> Ordering
AssetName -> AssetName -> AssetName
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: AssetName -> AssetName -> AssetName
$cmin :: AssetName -> AssetName -> AssetName
max :: AssetName -> AssetName -> AssetName
$cmax :: AssetName -> AssetName -> AssetName
>= :: AssetName -> AssetName -> Bool
$c>= :: AssetName -> AssetName -> Bool
> :: AssetName -> AssetName -> Bool
$c> :: AssetName -> AssetName -> Bool
<= :: AssetName -> AssetName -> Bool
$c<= :: AssetName -> AssetName -> Bool
< :: AssetName -> AssetName -> Bool
$c< :: AssetName -> AssetName -> Bool
compare :: AssetName -> AssetName -> Ordering
$ccompare :: AssetName -> AssetName -> Ordering
Ord
    , Context -> AssetName -> IO (Maybe ThunkInfo)
Proxy AssetName -> String
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
showTypeOf :: Proxy AssetName -> String
$cshowTypeOf :: Proxy AssetName -> String
wNoThunks :: Context -> AssetName -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> AssetName -> IO (Maybe ThunkInfo)
noThunks :: Context -> AssetName -> IO (Maybe ThunkInfo)
$cnoThunks :: Context -> AssetName -> IO (Maybe ThunkInfo)
NoThunks
    , AssetName -> ()
forall a. (a -> ()) -> NFData a
rnf :: AssetName -> ()
$crnf :: AssetName -> ()
NFData
    )

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

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

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

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

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

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

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

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

instance NoThunks (MultiAsset c)

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

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

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

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

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

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

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

instance NoThunks (MaryValue c)

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

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

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

instance Abelian (MaryValue c)

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

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

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

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

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

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

  coinCompact :: CompactForm (MaryValue c) -> 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 c)
injectCompact = forall c. CompactValue c -> CompactForm (MaryValue c)
CompactValue forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. CompactForm Coin -> CompactValue c
CompactValueAdaOnly

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

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

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

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

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

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

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

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

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

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

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

instance Crypto c => DecCBOR (MaryValue c) where
  decCBOR :: forall s. Decoder s (MaryValue c)
decCBOR = forall c s. Crypto c => Decoder s (MaryValue c)
decodeMaryValue

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

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

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

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

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

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

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

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

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

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

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

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

instance Crypto c => Eq (CompactValue c) where
  CompactValue c
a == :: CompactValue c -> CompactValue c -> Bool
== CompactValue c
b = forall c. Crypto c => CompactValue c -> MaryValue c
from CompactValue c
a forall a. Eq a => a -> a -> Bool
== forall c. Crypto c => CompactValue c -> MaryValue c
from CompactValue c
b

deriving via
  OnlyCheckWhnfNamed "CompactValue" (CompactValue c)
  instance
    NoThunks (CompactValue c)

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

    prepare :: (PolicyID c, AssetName, Integer) -> Maybe (Word16, Word16, Word64)
prepare (PolicyID c
pid, AssetName
aname, Integer
q) = do
      Word64
q' <- Integer -> Maybe Word64
integerToWord64 Integer
q
      forall (f :: * -> *) a. Applicative f => a -> f a
pure (PolicyID c -> Word16
pidOffset PolicyID c
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 c -> Bool
isMultiAssetSmallEnough :: forall c. MultiAsset c -> Bool
isMultiAssetSmallEnough (MultiAsset Map (PolicyID c) (Map AssetName Integer)
ma) =
  Int
44 forall a. Num a => a -> a -> a
* forall a. Sum a -> a
M.getSum (forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap' (forall a. a -> Sum a
M.Sum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Int
length) Map (PolicyID c) (Map AssetName Integer)
ma) forall a. Num a => a -> a -> a
+ Int
28 forall a. Num a => a -> a -> a
* forall (t :: * -> *) a. Foldable t => t a -> Int
length Map (PolicyID c) (Map AssetName Integer)
ma forall a. Ord a => a -> a -> Bool
<= Int
65535

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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