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

module Cardano.Ledger.Mary.Value
  ( PolicyID (..),
    AssetName (..),
    Value (..),
    insert,
    lookup,
    policies,
    prune,
    representationSize,
    showValue,
    valueFromList,
    gettriples',
  )
where

import Cardano.Binary
  ( Decoder,
    DecoderError (..),
    Encoding,
    FromCBOR,
    ToCBOR,
    TokenType (..),
    decodeInteger,
    decodeWord64,
    fromCBOR,
    peekTokenType,
    toCBOR,
  )
import qualified Cardano.Crypto.Hash.Class as Hash
import Cardano.Ledger.Coin (Coin (..), CompactForm (..), integerToWord64)
import Cardano.Ledger.Compactible (Compactible (..))
import qualified Cardano.Ledger.Crypto as CC
import Cardano.Ledger.Shelley.Scripts (ScriptHash (..))
import Cardano.Ledger.Val
  ( DecodeMint (..),
    DecodeNonNegative (..),
    EncodeMint (..),
    Val (..),
  )
import Control.DeepSeq (NFData (..), deepseq, rwhnf)
import Control.Monad (forM_)
import Control.Monad.ST (runST)
import qualified Data.ByteString.Base16 as BS16
import qualified Data.ByteString.Char8 as BS8
import qualified Data.ByteString.Short as SBS
import Data.ByteString.Short.Internal (ShortByteString (SBS))
import Data.CanonicalMaps
  ( canonicalMap,
    canonicalMapUnion,
    pointWise,
  )
import Data.Coders
  ( Decode (..),
    Encode (..),
    cborError,
    decode,
    decodeMap,
    encode,
    encodeMap,
    (!>),
    (<!),
  )
import Data.Foldable (foldMap')
import Data.Group (Abelian, Group (..))
import Data.Int (Int64)
import Data.List (sortOn)
import Data.Map.Internal
  ( Map (..),
    link,
    link2,
  )
import Data.Map.Strict (assocs)
import qualified Data.Map.Strict as Map
import Data.Map.Strict.Internal (splitLookup)
import Data.Maybe (fromJust)
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.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
assetName :: 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
/= :: AssetName -> AssetName -> Bool
$c/= :: AssetName -> AssetName -> Bool
== :: AssetName -> AssetName -> Bool
$c== :: AssetName -> AssetName -> Bool
Eq,
      Typeable AssetName
Typeable AssetName
-> (AssetName -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy AssetName -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy [AssetName] -> Size)
-> ToCBOR AssetName
AssetName -> Encoding
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [AssetName] -> Size
(forall t. ToCBOR t => Proxy t -> Size) -> Proxy AssetName -> Size
forall a.
Typeable a
-> (a -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size) -> Proxy a -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size) -> Proxy [a] -> Size)
-> ToCBOR a
encodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [AssetName] -> Size
$cencodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [AssetName] -> Size
encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size) -> Proxy AssetName -> Size
$cencodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size) -> Proxy AssetName -> Size
toCBOR :: AssetName -> Encoding
$ctoCBOR :: AssetName -> Encoding
$cp1ToCBOR :: Typeable AssetName
ToCBOR,
      Eq AssetName
Eq AssetName
-> (AssetName -> AssetName -> Ordering)
-> (AssetName -> AssetName -> Bool)
-> (AssetName -> AssetName -> Bool)
-> (AssetName -> AssetName -> Bool)
-> (AssetName -> AssetName -> Bool)
-> (AssetName -> AssetName -> AssetName)
-> (AssetName -> AssetName -> AssetName)
-> Ord AssetName
AssetName -> AssetName -> Bool
AssetName -> AssetName -> Ordering
AssetName -> AssetName -> AssetName
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: AssetName -> AssetName -> AssetName
$cmin :: AssetName -> AssetName -> AssetName
max :: AssetName -> AssetName -> AssetName
$cmax :: AssetName -> AssetName -> AssetName
>= :: AssetName -> AssetName -> Bool
$c>= :: AssetName -> AssetName -> Bool
> :: AssetName -> AssetName -> Bool
$c> :: AssetName -> AssetName -> Bool
<= :: AssetName -> AssetName -> Bool
$c<= :: AssetName -> AssetName -> Bool
< :: AssetName -> AssetName -> Bool
$c< :: AssetName -> AssetName -> Bool
compare :: AssetName -> AssetName -> Ordering
$ccompare :: AssetName -> AssetName -> Ordering
$cp1Ord :: Eq AssetName
Ord,
      Context -> AssetName -> IO (Maybe ThunkInfo)
Proxy AssetName -> String
(Context -> AssetName -> IO (Maybe ThunkInfo))
-> (Context -> AssetName -> IO (Maybe ThunkInfo))
-> (Proxy AssetName -> String)
-> NoThunks AssetName
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 -> ()
(AssetName -> ()) -> NFData AssetName
forall a. (a -> ()) -> NFData a
rnf :: AssetName -> ()
$crnf :: AssetName -> ()
NFData
    )

instance Show AssetName where
  show :: AssetName -> String
show = ByteString -> String
BS8.unpack (ByteString -> String)
-> (AssetName -> ByteString) -> AssetName -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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
assetName

instance FromCBOR AssetName where
  fromCBOR :: Decoder s AssetName
fromCBOR = do
    ShortByteString
an <- Decoder s ShortByteString
forall a s. FromCBOR a => Decoder s a
fromCBOR
    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 e s a. Buildable e => e -> Decoder s 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
$
            ByteString -> Text
decodeLatin1 (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
BS16.encode (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ ShortByteString -> ByteString
SBS.fromShort ShortByteString
an
      else AssetName -> Decoder s AssetName
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 crypto = PolicyID {PolicyID crypto -> ScriptHash crypto
policyID :: ScriptHash crypto}
  deriving (Int -> PolicyID crypto -> ShowS
[PolicyID crypto] -> ShowS
PolicyID crypto -> String
(Int -> PolicyID crypto -> ShowS)
-> (PolicyID crypto -> String)
-> ([PolicyID crypto] -> ShowS)
-> Show (PolicyID crypto)
forall crypto. Int -> PolicyID crypto -> ShowS
forall crypto. [PolicyID crypto] -> ShowS
forall crypto. PolicyID crypto -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PolicyID crypto] -> ShowS
$cshowList :: forall crypto. [PolicyID crypto] -> ShowS
show :: PolicyID crypto -> String
$cshow :: forall crypto. PolicyID crypto -> String
showsPrec :: Int -> PolicyID crypto -> ShowS
$cshowsPrec :: forall crypto. Int -> PolicyID crypto -> ShowS
Show, PolicyID crypto -> PolicyID crypto -> Bool
(PolicyID crypto -> PolicyID crypto -> Bool)
-> (PolicyID crypto -> PolicyID crypto -> Bool)
-> Eq (PolicyID crypto)
forall crypto. PolicyID crypto -> PolicyID crypto -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PolicyID crypto -> PolicyID crypto -> Bool
$c/= :: forall crypto. PolicyID crypto -> PolicyID crypto -> Bool
== :: PolicyID crypto -> PolicyID crypto -> Bool
$c== :: forall crypto. PolicyID crypto -> PolicyID crypto -> Bool
Eq, Typeable (PolicyID crypto)
Typeable (PolicyID crypto)
-> (PolicyID crypto -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy (PolicyID crypto) -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy [PolicyID crypto] -> Size)
-> ToCBOR (PolicyID crypto)
PolicyID crypto -> Encoding
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [PolicyID crypto] -> Size
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (PolicyID crypto) -> Size
forall a.
Typeable a
-> (a -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size) -> Proxy a -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size) -> Proxy [a] -> Size)
-> ToCBOR a
forall crypto. Crypto crypto => Typeable (PolicyID crypto)
forall crypto. Crypto crypto => PolicyID crypto -> Encoding
forall crypto.
Crypto crypto =>
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [PolicyID crypto] -> Size
forall crypto.
Crypto crypto =>
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (PolicyID crypto) -> Size
encodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [PolicyID crypto] -> Size
$cencodedListSizeExpr :: forall crypto.
Crypto crypto =>
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [PolicyID crypto] -> Size
encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (PolicyID crypto) -> Size
$cencodedSizeExpr :: forall crypto.
Crypto crypto =>
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (PolicyID crypto) -> Size
toCBOR :: PolicyID crypto -> Encoding
$ctoCBOR :: forall crypto. Crypto crypto => PolicyID crypto -> Encoding
$cp1ToCBOR :: forall crypto. Crypto crypto => Typeable (PolicyID crypto)
ToCBOR, Typeable (PolicyID crypto)
Decoder s (PolicyID crypto)
Typeable (PolicyID crypto)
-> (forall s. Decoder s (PolicyID crypto))
-> (Proxy (PolicyID crypto) -> Text)
-> FromCBOR (PolicyID crypto)
Proxy (PolicyID crypto) -> Text
forall s. Decoder s (PolicyID crypto)
forall a.
Typeable a
-> (forall s. Decoder s a) -> (Proxy a -> Text) -> FromCBOR a
forall crypto. Crypto crypto => Typeable (PolicyID crypto)
forall crypto. Crypto crypto => Proxy (PolicyID crypto) -> Text
forall crypto s. Crypto crypto => Decoder s (PolicyID crypto)
label :: Proxy (PolicyID crypto) -> Text
$clabel :: forall crypto. Crypto crypto => Proxy (PolicyID crypto) -> Text
fromCBOR :: Decoder s (PolicyID crypto)
$cfromCBOR :: forall crypto s. Crypto crypto => Decoder s (PolicyID crypto)
$cp1FromCBOR :: forall crypto. Crypto crypto => Typeable (PolicyID crypto)
FromCBOR, Eq (PolicyID crypto)
Eq (PolicyID crypto)
-> (PolicyID crypto -> PolicyID crypto -> Ordering)
-> (PolicyID crypto -> PolicyID crypto -> Bool)
-> (PolicyID crypto -> PolicyID crypto -> Bool)
-> (PolicyID crypto -> PolicyID crypto -> Bool)
-> (PolicyID crypto -> PolicyID crypto -> Bool)
-> (PolicyID crypto -> PolicyID crypto -> PolicyID crypto)
-> (PolicyID crypto -> PolicyID crypto -> PolicyID crypto)
-> Ord (PolicyID crypto)
PolicyID crypto -> PolicyID crypto -> Bool
PolicyID crypto -> PolicyID crypto -> Ordering
PolicyID crypto -> PolicyID crypto -> PolicyID crypto
forall crypto. Eq (PolicyID crypto)
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 crypto. PolicyID crypto -> PolicyID crypto -> Bool
forall crypto. PolicyID crypto -> PolicyID crypto -> Ordering
forall crypto.
PolicyID crypto -> PolicyID crypto -> PolicyID crypto
min :: PolicyID crypto -> PolicyID crypto -> PolicyID crypto
$cmin :: forall crypto.
PolicyID crypto -> PolicyID crypto -> PolicyID crypto
max :: PolicyID crypto -> PolicyID crypto -> PolicyID crypto
$cmax :: forall crypto.
PolicyID crypto -> PolicyID crypto -> PolicyID crypto
>= :: PolicyID crypto -> PolicyID crypto -> Bool
$c>= :: forall crypto. PolicyID crypto -> PolicyID crypto -> Bool
> :: PolicyID crypto -> PolicyID crypto -> Bool
$c> :: forall crypto. PolicyID crypto -> PolicyID crypto -> Bool
<= :: PolicyID crypto -> PolicyID crypto -> Bool
$c<= :: forall crypto. PolicyID crypto -> PolicyID crypto -> Bool
< :: PolicyID crypto -> PolicyID crypto -> Bool
$c< :: forall crypto. PolicyID crypto -> PolicyID crypto -> Bool
compare :: PolicyID crypto -> PolicyID crypto -> Ordering
$ccompare :: forall crypto. PolicyID crypto -> PolicyID crypto -> Ordering
$cp1Ord :: forall crypto. Eq (PolicyID crypto)
Ord, Context -> PolicyID crypto -> IO (Maybe ThunkInfo)
Proxy (PolicyID crypto) -> String
(Context -> PolicyID crypto -> IO (Maybe ThunkInfo))
-> (Context -> PolicyID crypto -> IO (Maybe ThunkInfo))
-> (Proxy (PolicyID crypto) -> String)
-> NoThunks (PolicyID crypto)
forall crypto. Context -> PolicyID crypto -> IO (Maybe ThunkInfo)
forall crypto. Proxy (PolicyID crypto) -> String
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
showTypeOf :: Proxy (PolicyID crypto) -> String
$cshowTypeOf :: forall crypto. Proxy (PolicyID crypto) -> String
wNoThunks :: Context -> PolicyID crypto -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall crypto. Context -> PolicyID crypto -> IO (Maybe ThunkInfo)
noThunks :: Context -> PolicyID crypto -> IO (Maybe ThunkInfo)
$cnoThunks :: forall crypto. Context -> PolicyID crypto -> IO (Maybe ThunkInfo)
NoThunks, PolicyID crypto -> ()
(PolicyID crypto -> ()) -> NFData (PolicyID crypto)
forall crypto. PolicyID crypto -> ()
forall a. (a -> ()) -> NFData a
rnf :: PolicyID crypto -> ()
$crnf :: forall crypto. PolicyID crypto -> ()
NFData)

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

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

instance NFData (Value crypto) where
  rnf :: Value crypto -> ()
rnf (Value Integer
c Map (PolicyID crypto) (Map AssetName Integer)
m) = Integer
c Integer -> () -> ()
forall a b. NFData a => a -> b -> b
`deepseq` Map (PolicyID crypto) (Map AssetName Integer) -> ()
forall a. NFData a => a -> ()
rnf Map (PolicyID crypto) (Map AssetName Integer)
m

instance NoThunks (Value crypto)

instance Semigroup (Value crypto) where
  Value Integer
c Map (PolicyID crypto) (Map AssetName Integer)
m <> :: Value crypto -> Value crypto -> Value crypto
<> Value Integer
c1 Map (PolicyID crypto) (Map AssetName Integer)
m1 =
    Integer
-> Map (PolicyID crypto) (Map AssetName Integer) -> Value crypto
forall crypto.
Integer
-> Map (PolicyID crypto) (Map AssetName Integer) -> Value crypto
Value (Integer
c Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
c1) ((Map AssetName Integer
 -> Map AssetName Integer -> Map AssetName Integer)
-> Map (PolicyID crypto) (Map AssetName Integer)
-> Map (PolicyID crypto) (Map AssetName Integer)
-> Map (PolicyID crypto) (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 crypto) (Map AssetName Integer)
m Map (PolicyID crypto) (Map AssetName Integer)
m1)

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

instance Group (Value crypto) where
  invert :: Value crypto -> Value crypto
invert (Value Integer
c Map (PolicyID crypto) (Map AssetName Integer)
m) =
    Integer
-> Map (PolicyID crypto) (Map AssetName Integer) -> Value crypto
forall crypto.
Integer
-> Map (PolicyID crypto) (Map AssetName Integer) -> Value crypto
Value
      (-Integer
c)
      ((Map AssetName Integer -> Map AssetName Integer)
-> Map (PolicyID crypto) (Map AssetName Integer)
-> Map (PolicyID crypto) (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 crypto) (Map AssetName Integer)
m)

instance Abelian (Value crypto)

-- ===================================================
-- Make the Val instance of Value

instance CC.Crypto crypto => Val (Value crypto) where
  i
s <×> :: i -> Value crypto -> Value crypto
<×> Value Integer
c Map (PolicyID crypto) (Map AssetName Integer)
v =
    Integer
-> Map (PolicyID crypto) (Map AssetName Integer) -> Value crypto
forall crypto.
Integer
-> Map (PolicyID crypto) (Map AssetName Integer) -> Value crypto
Value
      (i -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral i
s Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
c)
      ((Map AssetName Integer -> Map AssetName Integer)
-> Map (PolicyID crypto) (Map AssetName Integer)
-> Map (PolicyID crypto) (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 crypto) (Map AssetName Integer)
v)
  isZero :: Value crypto -> Bool
isZero (Value Integer
c Map (PolicyID crypto) (Map AssetName Integer)
v) = Integer
c Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0 Bool -> Bool -> Bool
&& Map (PolicyID crypto) (Map AssetName Integer) -> Bool
forall k a. Map k a -> Bool
Map.null Map (PolicyID crypto) (Map AssetName Integer)
v
  coin :: Value crypto -> Coin
coin (Value Integer
c Map (PolicyID crypto) (Map AssetName Integer)
_) = Integer -> Coin
Coin Integer
c
  inject :: Coin -> Value crypto
inject (Coin Integer
c) = Integer
-> Map (PolicyID crypto) (Map AssetName Integer) -> Value crypto
forall crypto.
Integer
-> Map (PolicyID crypto) (Map AssetName Integer) -> Value crypto
Value Integer
c Map (PolicyID crypto) (Map AssetName Integer)
forall a. Monoid a => a
mempty
  modifyCoin :: (Coin -> Coin) -> Value crypto -> Value crypto
modifyCoin Coin -> Coin
f (Value Integer
c Map (PolicyID crypto) (Map AssetName Integer)
m) = Integer
-> Map (PolicyID crypto) (Map AssetName Integer) -> Value crypto
forall crypto.
Integer
-> Map (PolicyID crypto) (Map AssetName Integer) -> Value crypto
Value Integer
n Map (PolicyID crypto) (Map AssetName Integer)
m where (Coin Integer
n) = Coin -> Coin
f (Integer -> Coin
Coin Integer
c)
  pointwise :: (Integer -> Integer -> Bool)
-> Value crypto -> Value crypto -> Bool
pointwise Integer -> Integer -> Bool
p (Value Integer
c Map (PolicyID crypto) (Map AssetName Integer)
x) (Value Integer
d Map (PolicyID crypto) (Map AssetName Integer)
y) = Integer -> Integer -> Bool
p Integer
c Integer
d Bool -> Bool -> Bool
&& (Map AssetName Integer -> Map AssetName Integer -> Bool)
-> Map (PolicyID crypto) (Map AssetName Integer)
-> Map (PolicyID crypto) (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 crypto) (Map AssetName Integer)
x Map (PolicyID crypto) (Map AssetName Integer)
y

  -- returns the size, in Word64's, of the CompactValue representation of Value
  size :: Value crypto -> Integer
size vv :: Value crypto
vv@(Value Integer
_ Map (PolicyID crypto) (Map AssetName Integer)
v)
    -- when Value 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 crypto) (Map AssetName Integer)
v Map (PolicyID crypto) (Map AssetName Integer)
-> Map (PolicyID crypto) (Map AssetName Integer) -> Bool
forall a. Eq a => a -> a -> Bool
== Map (PolicyID crypto) (Map AssetName Integer)
forall a. Monoid a => a
mempty = Integer
2
    -- when Value 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 crypto, AssetName, Integer)] -> Int
forall crypto.
Crypto crypto =>
[(PolicyID crypto, AssetName, Integer)] -> Int
representationSize ((Integer, [(PolicyID crypto, AssetName, Integer)])
-> [(PolicyID crypto, AssetName, Integer)]
forall a b. (a, b) -> b
snd ((Integer, [(PolicyID crypto, AssetName, Integer)])
 -> [(PolicyID crypto, AssetName, Integer)])
-> (Integer, [(PolicyID crypto, AssetName, Integer)])
-> [(PolicyID crypto, AssetName, Integer)]
forall a b. (a -> b) -> a -> b
$ Value crypto -> (Integer, [(PolicyID crypto, AssetName, Integer)])
forall crypto.
Value crypto -> (Integer, [(PolicyID crypto, AssetName, Integer)])
gettriples Value crypto
vv))
              Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
repOverhead
          )

  isAdaOnly :: Value crypto -> Bool
isAdaOnly (Value Integer
_ Map (PolicyID crypto) (Map AssetName Integer)
v) = Map (PolicyID crypto) (Map AssetName Integer) -> Bool
forall k a. Map k a -> Bool
Map.null Map (PolicyID crypto) (Map AssetName Integer)
v

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

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

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

-- TODO filter out 0s at deserialization
-- TODO Probably the actual serialization will be of the formal Coin OR Value type
-- Maybe better to make this distinction in the TxOut de/serialization

decodeValue ::
  CC.Crypto crypto =>
  Decoder s (Value crypto)
decodeValue :: Decoder s (Value crypto)
decodeValue = do
  TokenType
tt <- Decoder s TokenType
forall s. Decoder s TokenType
peekTokenType
  case TokenType
tt of
    TokenType
TypeUInt -> Coin -> Value crypto
forall t. Val t => Coin -> t
inject (Coin -> Value crypto)
-> (Integer -> Coin) -> Integer -> Value crypto
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Coin
Coin (Integer -> Value crypto)
-> Decoder s Integer -> Decoder s (Value crypto)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s Integer
forall s. Decoder s Integer
decodeInteger
    TokenType
TypeUInt64 -> Coin -> Value crypto
forall t. Val t => Coin -> t
inject (Coin -> Value crypto)
-> (Integer -> Coin) -> Integer -> Value crypto
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Coin
Coin (Integer -> Value crypto)
-> Decoder s Integer -> Decoder s (Value crypto)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s Integer
forall s. Decoder s Integer
decodeInteger
    TokenType
TypeNInt -> Coin -> Value crypto
forall t. Val t => Coin -> t
inject (Coin -> Value crypto)
-> (Integer -> Coin) -> Integer -> Value crypto
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Coin
Coin (Integer -> Value crypto)
-> Decoder s Integer -> Decoder s (Value crypto)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s Integer
forall s. Decoder s Integer
decodeInteger
    TokenType
TypeNInt64 -> Coin -> Value crypto
forall t. Val t => Coin -> t
inject (Coin -> Value crypto)
-> (Integer -> Coin) -> Integer -> Value crypto
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Coin
Coin (Integer -> Value crypto)
-> Decoder s Integer -> Decoder s (Value crypto)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s Integer
forall s. Decoder s Integer
decodeInteger
    TokenType
TypeListLen -> (forall s. Decoder s Integer) -> Decoder s (Value crypto)
forall crypto s.
Crypto crypto =>
(forall s. Decoder s Integer) -> Decoder s (Value crypto)
decodeValuePair forall s. Decoder s Integer
decodeInteger
    TokenType
TypeListLen64 -> (forall s. Decoder s Integer) -> Decoder s (Value crypto)
forall crypto s.
Crypto crypto =>
(forall s. Decoder s Integer) -> Decoder s (Value crypto)
decodeValuePair forall s. Decoder s Integer
decodeInteger
    TokenType
TypeListLenIndef -> (forall s. Decoder s Integer) -> Decoder s (Value crypto)
forall crypto s.
Crypto crypto =>
(forall s. Decoder s Integer) -> Decoder s (Value crypto)
decodeValuePair forall s. Decoder s Integer
decodeInteger
    TokenType
_ -> String -> Decoder s (Value crypto)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Decoder s (Value crypto))
-> String -> Decoder s (Value crypto)
forall a b. (a -> b) -> a -> b
$ String
"Value: expected array or int, got " String -> ShowS
forall a. [a] -> [a] -> [a]
++ TokenType -> String
forall a. Show a => a -> String
show TokenType
tt

decodeValuePair ::
  CC.Crypto crypto =>
  (forall t. Decoder t Integer) ->
  Decoder s (Value crypto)
decodeValuePair :: (forall s. Decoder s Integer) -> Decoder s (Value crypto)
decodeValuePair forall s. Decoder s Integer
decodeAmount =
  Decode ('Closed 'Dense) (Value crypto) -> Decoder s (Value crypto)
forall (w :: Wrapped) t s. Decode w t -> Decoder s t
decode (Decode ('Closed 'Dense) (Value crypto)
 -> Decoder s (Value crypto))
-> Decode ('Closed 'Dense) (Value crypto)
-> Decoder s (Value crypto)
forall a b. (a -> b) -> a -> b
$
    (Integer
 -> Map (PolicyID crypto) (Map AssetName Integer) -> Value crypto)
-> Decode
     ('Closed 'Dense)
     (Integer
      -> Map (PolicyID crypto) (Map AssetName Integer) -> Value crypto)
forall t. t -> Decode ('Closed 'Dense) t
RecD Integer
-> Map (PolicyID crypto) (Map AssetName Integer) -> Value crypto
forall crypto.
Integer
-> Map (PolicyID crypto) (Map AssetName Integer) -> Value crypto
Value
      Decode
  ('Closed 'Dense)
  (Integer
   -> Map (PolicyID crypto) (Map AssetName Integer) -> Value crypto)
-> Decode ('Closed 'Dense) Integer
-> Decode
     ('Closed 'Dense)
     (Map (PolicyID crypto) (Map AssetName Integer) -> Value crypto)
forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! (forall s. Decoder s Integer) -> Decode ('Closed 'Dense) Integer
forall t. (forall s. Decoder s t) -> Decode ('Closed 'Dense) t
D forall s. Decoder s Integer
decodeAmount
      Decode
  ('Closed 'Dense)
  (Map (PolicyID crypto) (Map AssetName Integer) -> Value crypto)
-> Decode
     ('Closed 'Dense) (Map (PolicyID crypto) (Map AssetName Integer))
-> Decode ('Closed 'Dense) (Value crypto)
forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! (forall s.
 Decoder s (Map (PolicyID crypto) (Map AssetName Integer)))
-> Decode
     ('Closed 'Dense) (Map (PolicyID crypto) (Map AssetName Integer))
forall t. (forall s. Decoder s t) -> Decode ('Closed 'Dense) t
D (Decoder s Integer
-> Decoder s (Map (PolicyID crypto) (Map AssetName Integer))
forall crypto s.
Crypto crypto =>
Decoder s Integer
-> Decoder s (Map (PolicyID crypto) (Map AssetName Integer))
decodeMultiAssetMaps Decoder s Integer
forall s. Decoder s Integer
decodeAmount)

encodeMultiAssetMaps ::
  CC.Crypto crypto =>
  Map (PolicyID crypto) (Map AssetName Integer) ->
  Encoding
encodeMultiAssetMaps :: Map (PolicyID crypto) (Map AssetName Integer) -> Encoding
encodeMultiAssetMaps = (PolicyID crypto -> Encoding)
-> (Map AssetName Integer -> Encoding)
-> Map (PolicyID crypto) (Map AssetName Integer)
-> Encoding
forall a b.
(a -> Encoding) -> (b -> Encoding) -> Map a b -> Encoding
encodeMap PolicyID crypto -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR ((AssetName -> Encoding)
-> (Integer -> Encoding) -> Map AssetName Integer -> Encoding
forall a b.
(a -> Encoding) -> (b -> Encoding) -> Map a b -> Encoding
encodeMap AssetName -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR Integer -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR)

decodeMultiAssetMaps ::
  CC.Crypto crypto =>
  Decoder s Integer ->
  Decoder s (Map (PolicyID crypto) (Map AssetName Integer))
decodeMultiAssetMaps :: Decoder s Integer
-> Decoder s (Map (PolicyID crypto) (Map AssetName Integer))
decodeMultiAssetMaps Decoder s Integer
decodeAmount =
  Map (PolicyID crypto) (Map AssetName Integer)
-> Map (PolicyID crypto) (Map AssetName Integer)
forall crypto.
Map (PolicyID crypto) (Map AssetName Integer)
-> Map (PolicyID crypto) (Map AssetName Integer)
prune (Map (PolicyID crypto) (Map AssetName Integer)
 -> Map (PolicyID crypto) (Map AssetName Integer))
-> Decoder s (Map (PolicyID crypto) (Map AssetName Integer))
-> Decoder s (Map (PolicyID crypto) (Map AssetName Integer))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (PolicyID crypto)
-> Decoder s (Map AssetName Integer)
-> Decoder s (Map (PolicyID crypto) (Map AssetName Integer))
forall a s b.
Ord a =>
Decoder s a -> Decoder s b -> Decoder s (Map a b)
decodeMap Decoder s (PolicyID crypto)
forall a s. FromCBOR a => Decoder s a
fromCBOR (Decoder s AssetName
-> Decoder s Integer -> Decoder s (Map AssetName Integer)
forall a s b.
Ord a =>
Decoder s a -> Decoder s b -> Decoder s (Map a b)
decodeMap Decoder s AssetName
forall a s. FromCBOR a => Decoder s a
fromCBOR Decoder s Integer
decodeAmount)

decodeNonNegativeInteger :: Decoder s Integer
decodeNonNegativeInteger :: Decoder s Integer
decodeNonNegativeInteger = Word64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Integer) -> Decoder s Word64 -> Decoder s Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s Word64
forall s. Decoder s Word64
decodeWord64

decodeNonNegativeValue ::
  CC.Crypto crypto =>
  Decoder s (Value crypto)
decodeNonNegativeValue :: Decoder s (Value crypto)
decodeNonNegativeValue = do
  TokenType
tt <- Decoder s TokenType
forall s. Decoder s TokenType
peekTokenType
  case TokenType
tt of
    TokenType
TypeUInt -> Coin -> Value crypto
forall t. Val t => Coin -> t
inject (Coin -> Value crypto)
-> (Integer -> Coin) -> Integer -> Value crypto
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Coin
Coin (Integer -> Value crypto)
-> Decoder s Integer -> Decoder s (Value crypto)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s Integer
forall s. Decoder s Integer
decodeNonNegativeInteger
    TokenType
TypeUInt64 -> Coin -> Value crypto
forall t. Val t => Coin -> t
inject (Coin -> Value crypto)
-> (Integer -> Coin) -> Integer -> Value crypto
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Coin
Coin (Integer -> Value crypto)
-> Decoder s Integer -> Decoder s (Value crypto)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s Integer
forall s. Decoder s Integer
decodeNonNegativeInteger
    TokenType
TypeListLen -> (forall s. Decoder s Integer) -> Decoder s (Value crypto)
forall crypto s.
Crypto crypto =>
(forall s. Decoder s Integer) -> Decoder s (Value crypto)
decodeValuePair forall s. Decoder s Integer
decodeNonNegativeInteger
    TokenType
TypeListLen64 -> (forall s. Decoder s Integer) -> Decoder s (Value crypto)
forall crypto s.
Crypto crypto =>
(forall s. Decoder s Integer) -> Decoder s (Value crypto)
decodeValuePair forall s. Decoder s Integer
decodeNonNegativeInteger
    TokenType
TypeListLenIndef -> (forall s. Decoder s Integer) -> Decoder s (Value crypto)
forall crypto s.
Crypto crypto =>
(forall s. Decoder s Integer) -> Decoder s (Value crypto)
decodeValuePair forall s. Decoder s Integer
decodeNonNegativeInteger
    TokenType
_ -> String -> Decoder s (Value crypto)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Decoder s (Value crypto))
-> String -> Decoder s (Value crypto)
forall a b. (a -> b) -> a -> b
$ String
"Value: expected array or int, got " String -> ShowS
forall a. [a] -> [a] -> [a]
++ TokenType -> String
forall a. Show a => a -> String
show TokenType
tt

instance
  CC.Crypto crypto =>
  ToCBOR (Value crypto)
  where
  toCBOR :: Value crypto -> Encoding
toCBOR (Value Integer
c Map (PolicyID crypto) (Map AssetName Integer)
v) =
    if Map (PolicyID crypto) (Map AssetName Integer) -> Bool
forall k a. Map k a -> Bool
Map.null Map (PolicyID crypto) (Map AssetName Integer)
v
      then Integer -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR Integer
c
      else
        Encode ('Closed 'Dense) (Value crypto) -> Encoding
forall (w :: Wrapped) t. Encode w t -> Encoding
encode (Encode ('Closed 'Dense) (Value crypto) -> Encoding)
-> Encode ('Closed 'Dense) (Value crypto) -> Encoding
forall a b. (a -> b) -> a -> b
$
          (Integer
 -> Map (PolicyID crypto) (Map AssetName Integer) -> Value crypto)
-> Encode
     ('Closed 'Dense)
     (Integer
      -> Map (PolicyID crypto) (Map AssetName Integer) -> Value crypto)
forall t. t -> Encode ('Closed 'Dense) t
Rec Integer
-> Map (PolicyID crypto) (Map AssetName Integer) -> Value crypto
forall crypto.
Integer
-> Map (PolicyID crypto) (Map AssetName Integer) -> Value crypto
Value
            Encode
  ('Closed 'Dense)
  (Integer
   -> Map (PolicyID crypto) (Map AssetName Integer) -> Value crypto)
-> Encode ('Closed 'Dense) Integer
-> Encode
     ('Closed 'Dense)
     (Map (PolicyID crypto) (Map AssetName Integer) -> Value crypto)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Integer -> Encode ('Closed 'Dense) Integer
forall t. ToCBOR t => t -> Encode ('Closed 'Dense) t
To Integer
c
            Encode
  ('Closed 'Dense)
  (Map (PolicyID crypto) (Map AssetName Integer) -> Value crypto)
-> Encode
     ('Closed 'Dense) (Map (PolicyID crypto) (Map AssetName Integer))
-> Encode ('Closed 'Dense) (Value crypto)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> (Map (PolicyID crypto) (Map AssetName Integer) -> Encoding)
-> Map (PolicyID crypto) (Map AssetName Integer)
-> Encode
     ('Closed 'Dense) (Map (PolicyID crypto) (Map AssetName Integer))
forall t. (t -> Encoding) -> t -> Encode ('Closed 'Dense) t
E Map (PolicyID crypto) (Map AssetName Integer) -> Encoding
forall crypto.
Crypto crypto =>
Map (PolicyID crypto) (Map AssetName Integer) -> Encoding
encodeMultiAssetMaps Map (PolicyID crypto) (Map AssetName Integer)
v

instance
  CC.Crypto crypto =>
  FromCBOR (Value crypto)
  where
  fromCBOR :: Decoder s (Value crypto)
fromCBOR = Decoder s (Value crypto)
forall crypto s. Crypto crypto => Decoder s (Value crypto)
decodeValue

instance
  CC.Crypto crypto =>
  DecodeNonNegative (Value crypto)
  where
  decodeNonNegative :: Decoder s (Value crypto)
decodeNonNegative = Decoder s (Value crypto)
forall crypto s. Crypto crypto => Decoder s (Value crypto)
decodeNonNegativeValue

instance
  CC.Crypto crypto =>
  DecodeMint (Value crypto)
  where
  decodeMint :: Decoder s (Value crypto)
decodeMint = Integer
-> Map (PolicyID crypto) (Map AssetName Integer) -> Value crypto
forall crypto.
Integer
-> Map (PolicyID crypto) (Map AssetName Integer) -> Value crypto
Value Integer
0 (Map (PolicyID crypto) (Map AssetName Integer) -> Value crypto)
-> Decoder s (Map (PolicyID crypto) (Map AssetName Integer))
-> Decoder s (Value crypto)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s Integer
-> Decoder s (Map (PolicyID crypto) (Map AssetName Integer))
forall crypto s.
Crypto crypto =>
Decoder s Integer
-> Decoder s (Map (PolicyID crypto) (Map AssetName Integer))
decodeMultiAssetMaps Decoder s Integer
forall s. Decoder s Integer
decodeIntegerBounded64

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

instance
  CC.Crypto crypto =>
  EncodeMint (Value crypto)
  where
  encodeMint :: Value crypto -> Encoding
encodeMint (Value Integer
_ Map (PolicyID crypto) (Map AssetName Integer)
multiasset) = Map (PolicyID crypto) (Map AssetName Integer) -> Encoding
forall crypto.
Crypto crypto =>
Map (PolicyID crypto) (Map AssetName Integer) -> Encoding
encodeMultiAssetMaps Map (PolicyID crypto) (Map AssetName Integer)
multiasset

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

instance CC.Crypto crypto => Compactible (Value crypto) where
  newtype CompactForm (Value crypto) = CompactValue (CompactValue crypto)
    deriving (CompactForm (Value crypto) -> CompactForm (Value crypto) -> Bool
(CompactForm (Value crypto) -> CompactForm (Value crypto) -> Bool)
-> (CompactForm (Value crypto)
    -> CompactForm (Value crypto) -> Bool)
-> Eq (CompactForm (Value crypto))
forall crypto.
Crypto crypto =>
CompactForm (Value crypto) -> CompactForm (Value crypto) -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CompactForm (Value crypto) -> CompactForm (Value crypto) -> Bool
$c/= :: forall crypto.
Crypto crypto =>
CompactForm (Value crypto) -> CompactForm (Value crypto) -> Bool
== :: CompactForm (Value crypto) -> CompactForm (Value crypto) -> Bool
$c== :: forall crypto.
Crypto crypto =>
CompactForm (Value crypto) -> CompactForm (Value crypto) -> Bool
Eq, Typeable, Int -> CompactForm (Value crypto) -> ShowS
[CompactForm (Value crypto)] -> ShowS
CompactForm (Value crypto) -> String
(Int -> CompactForm (Value crypto) -> ShowS)
-> (CompactForm (Value crypto) -> String)
-> ([CompactForm (Value crypto)] -> ShowS)
-> Show (CompactForm (Value crypto))
forall crypto. Int -> CompactForm (Value crypto) -> ShowS
forall crypto. [CompactForm (Value crypto)] -> ShowS
forall crypto. CompactForm (Value crypto) -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CompactForm (Value crypto)] -> ShowS
$cshowList :: forall crypto. [CompactForm (Value crypto)] -> ShowS
show :: CompactForm (Value crypto) -> String
$cshow :: forall crypto. CompactForm (Value crypto) -> String
showsPrec :: Int -> CompactForm (Value crypto) -> ShowS
$cshowsPrec :: forall crypto. Int -> CompactForm (Value crypto) -> ShowS
Show, Context -> CompactForm (Value crypto) -> IO (Maybe ThunkInfo)
Proxy (CompactForm (Value crypto)) -> String
(Context -> CompactForm (Value crypto) -> IO (Maybe ThunkInfo))
-> (Context -> CompactForm (Value crypto) -> IO (Maybe ThunkInfo))
-> (Proxy (CompactForm (Value crypto)) -> String)
-> NoThunks (CompactForm (Value crypto))
forall crypto.
Context -> CompactForm (Value crypto) -> IO (Maybe ThunkInfo)
forall crypto. Proxy (CompactForm (Value crypto)) -> String
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
showTypeOf :: Proxy (CompactForm (Value crypto)) -> String
$cshowTypeOf :: forall crypto. Proxy (CompactForm (Value crypto)) -> String
wNoThunks :: Context -> CompactForm (Value crypto) -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall crypto.
Context -> CompactForm (Value crypto) -> IO (Maybe ThunkInfo)
noThunks :: Context -> CompactForm (Value crypto) -> IO (Maybe ThunkInfo)
$cnoThunks :: forall crypto.
Context -> CompactForm (Value crypto) -> IO (Maybe ThunkInfo)
NoThunks, Typeable (CompactForm (Value crypto))
Typeable (CompactForm (Value crypto))
-> (CompactForm (Value crypto) -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy (CompactForm (Value crypto)) -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy [CompactForm (Value crypto)] -> Size)
-> ToCBOR (CompactForm (Value crypto))
CompactForm (Value crypto) -> Encoding
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [CompactForm (Value crypto)] -> Size
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (CompactForm (Value crypto)) -> Size
forall a.
Typeable a
-> (a -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size) -> Proxy a -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size) -> Proxy [a] -> Size)
-> ToCBOR a
forall crypto.
Crypto crypto =>
Typeable (CompactForm (Value crypto))
forall crypto.
Crypto crypto =>
CompactForm (Value crypto) -> Encoding
forall crypto.
Crypto crypto =>
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [CompactForm (Value crypto)] -> Size
forall crypto.
Crypto crypto =>
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (CompactForm (Value crypto)) -> Size
encodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [CompactForm (Value crypto)] -> Size
$cencodedListSizeExpr :: forall crypto.
Crypto crypto =>
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [CompactForm (Value crypto)] -> Size
encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (CompactForm (Value crypto)) -> Size
$cencodedSizeExpr :: forall crypto.
Crypto crypto =>
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (CompactForm (Value crypto)) -> Size
toCBOR :: CompactForm (Value crypto) -> Encoding
$ctoCBOR :: forall crypto.
Crypto crypto =>
CompactForm (Value crypto) -> Encoding
$cp1ToCBOR :: forall crypto.
Crypto crypto =>
Typeable (CompactForm (Value crypto))
ToCBOR, Typeable (CompactForm (Value crypto))
Decoder s (CompactForm (Value crypto))
Typeable (CompactForm (Value crypto))
-> (forall s. Decoder s (CompactForm (Value crypto)))
-> (Proxy (CompactForm (Value crypto)) -> Text)
-> FromCBOR (CompactForm (Value crypto))
Proxy (CompactForm (Value crypto)) -> Text
forall s. Decoder s (CompactForm (Value crypto))
forall a.
Typeable a
-> (forall s. Decoder s a) -> (Proxy a -> Text) -> FromCBOR a
forall crypto.
Crypto crypto =>
Typeable (CompactForm (Value crypto))
forall crypto.
Crypto crypto =>
Proxy (CompactForm (Value crypto)) -> Text
forall crypto s.
Crypto crypto =>
Decoder s (CompactForm (Value crypto))
label :: Proxy (CompactForm (Value crypto)) -> Text
$clabel :: forall crypto.
Crypto crypto =>
Proxy (CompactForm (Value crypto)) -> Text
fromCBOR :: Decoder s (CompactForm (Value crypto))
$cfromCBOR :: forall crypto s.
Crypto crypto =>
Decoder s (CompactForm (Value crypto))
$cp1FromCBOR :: forall crypto.
Crypto crypto =>
Typeable (CompactForm (Value crypto))
FromCBOR, CompactForm (Value crypto) -> ()
(CompactForm (Value crypto) -> ())
-> NFData (CompactForm (Value crypto))
forall crypto. CompactForm (Value crypto) -> ()
forall a. (a -> ()) -> NFData a
rnf :: CompactForm (Value crypto) -> ()
$crnf :: forall crypto. CompactForm (Value crypto) -> ()
NFData)
  toCompact :: Value crypto -> Maybe (CompactForm (Value crypto))
toCompact Value crypto
x = CompactValue crypto -> CompactForm (Value crypto)
forall crypto. CompactValue crypto -> CompactForm (Value crypto)
CompactValue (CompactValue crypto -> CompactForm (Value crypto))
-> Maybe (CompactValue crypto)
-> Maybe (CompactForm (Value crypto))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value crypto -> Maybe (CompactValue crypto)
forall crypto.
Crypto crypto =>
Value crypto -> Maybe (CompactValue crypto)
to Value crypto
x
  fromCompact :: CompactForm (Value crypto) -> Value crypto
fromCompact (CompactValue x) = CompactValue crypto -> Value crypto
forall crypto. Crypto crypto => CompactValue crypto -> Value crypto
from CompactValue crypto
x

instance CC.Crypto crypto => ToCBOR (CompactValue crypto) where
  toCBOR :: CompactValue crypto -> Encoding
toCBOR = Value crypto -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (Value crypto -> Encoding)
-> (CompactValue crypto -> Value crypto)
-> CompactValue crypto
-> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CompactValue crypto -> Value crypto
forall crypto. Crypto crypto => CompactValue crypto -> Value crypto
from

instance CC.Crypto crypto => FromCBOR (CompactValue crypto) where
  fromCBOR :: Decoder s (CompactValue crypto)
fromCBOR = do
    Value crypto
v <- Decoder s (Value crypto)
forall crypto s. Crypto crypto => Decoder s (Value crypto)
decodeNonNegativeValue
    case Value crypto -> Maybe (CompactValue crypto)
forall crypto.
Crypto crypto =>
Value crypto -> Maybe (CompactValue crypto)
to Value crypto
v of
      Maybe (CompactValue crypto)
Nothing ->
        String -> Decoder s (CompactValue crypto)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail
          String
"impossible failure: decoded nonnegative value that cannot be compacted"
      Just CompactValue crypto
x -> CompactValue crypto -> Decoder s (CompactValue crypto)
forall (f :: * -> *) a. Applicative f => a -> f a
pure CompactValue crypto
x

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

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

instance CC.Crypto crypto => Eq (CompactValue crypto) where
  CompactValue crypto
a == :: CompactValue crypto -> CompactValue crypto -> Bool
== CompactValue crypto
b = CompactValue crypto -> Value crypto
forall crypto. Crypto crypto => CompactValue crypto -> Value crypto
from CompactValue crypto
a Value crypto -> Value crypto -> Bool
forall a. Eq a => a -> a -> Bool
== CompactValue crypto -> Value crypto
forall crypto. Crypto crypto => CompactValue crypto -> Value crypto
from CompactValue crypto
b

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

{-
The Value 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 crypto.
  (CC.Crypto crypto) =>
  Value crypto ->
  -- 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 crypto)
to :: Value crypto -> Maybe (CompactValue crypto)
to (Value Integer
ada Map (PolicyID crypto) (Map AssetName Integer)
ma)
  | Map (PolicyID crypto) (Map AssetName Integer) -> Bool
forall k a. Map k a -> Bool
Map.null Map (PolicyID crypto) (Map AssetName Integer)
ma =
      CompactForm Coin -> CompactValue crypto
forall crypto. CompactForm Coin -> CompactValue crypto
CompactValueAdaOnly (CompactForm Coin -> CompactValue crypto)
-> (Word64 -> CompactForm Coin) -> Word64 -> CompactValue crypto
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> CompactForm Coin
CompactCoin (Word64 -> CompactValue crypto)
-> Maybe Word64 -> Maybe (CompactValue crypto)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Integer -> Maybe Word64
integerToWord64 Integer
ada
to Value crypto
v = do
  Word64
c <- Integer -> Maybe Word64
integerToWord64 Integer
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 crypto, AssetName, Integer)
 -> Maybe (Word16, Word16, Word64))
-> [(PolicyID crypto, AssetName, Integer)]
-> Maybe [(Word16, Word16, Word64)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (PolicyID crypto, AssetName, Integer)
-> Maybe (Word16, Word16, Word64)
prepare [(PolicyID crypto, AssetName, Integer)]
triples
  CompactValue crypto -> Maybe (CompactValue crypto)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CompactValue crypto -> Maybe (CompactValue crypto))
-> CompactValue crypto -> Maybe (CompactValue crypto)
forall a b. (a -> b) -> a -> b
$
    CompactForm Coin
-> Word32 -> ShortByteString -> CompactValue crypto
forall crypto.
CompactForm Coin
-> Word32 -> ShortByteString -> CompactValue crypto
CompactValueMultiAsset (Word64 -> CompactForm Coin
CompactCoin Word64
c) (Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
numTriples) (ShortByteString -> CompactValue crypto)
-> ShortByteString -> CompactValue crypto
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 crypto, Word16)]
-> ((PolicyID crypto, Word16) -> ST s ()) -> ST s ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Map (PolicyID crypto) Word16 -> [(PolicyID crypto, Word16)]
forall k a. Map k a -> [(k, a)]
Map.toList Map (PolicyID crypto) Word16
pidOffsetMap) (((PolicyID crypto, Word16) -> ST s ()) -> ST s ())
-> ((PolicyID crypto, Word16) -> ST s ()) -> ST s ()
forall a b. (a -> b) -> a -> b
$
          \(PolicyID (ScriptHash Hash (ADDRHASH crypto) EraIndependentScript
sh), Word16
offset) ->
            let pidBytes :: ShortByteString
pidBytes = Hash (ADDRHASH crypto) EraIndependentScript -> ShortByteString
forall h a. Hash h a -> ShortByteString
Hash.hashToBytesShort Hash (ADDRHASH crypto) 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
    (Integer
ada, [(PolicyID crypto, AssetName, Integer)]
triples) = Value crypto -> (Integer, [(PolicyID crypto, AssetName, Integer)])
forall crypto.
Value crypto -> (Integer, [(PolicyID crypto, AssetName, Integer)])
gettriples Value crypto
v
    numTriples :: Int
numTriples = [(PolicyID crypto, AssetName, Integer)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(PolicyID crypto, 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 crypto) -> Word
forall h (proxy :: * -> *). HashAlgorithm h => proxy h -> Word
Hash.sizeHash (Proxy (ADDRHASH crypto)
forall k (t :: k). Proxy t
Proxy :: Proxy (CC.ADDRHASH crypto)))

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

    pidOffsetMap :: Map (PolicyID crypto) Word16
    pidOffsetMap :: Map (PolicyID crypto) 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 crypto, Word16)] -> Map (PolicyID crypto) Word16
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([PolicyID crypto] -> [Word16] -> [(PolicyID crypto, Word16)]
forall a b. [a] -> [b] -> [(a, b)]
zip (Set (PolicyID crypto) -> [PolicyID crypto]
forall a. Set a -> [a]
Set.toList Set (PolicyID crypto)
pids) [Word16]
offsets)

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

    pidBlockSize :: Int
pidBlockSize = Set (PolicyID crypto) -> Int
forall a. Set a -> Int
Set.size Set (PolicyID crypto)
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 crypto
_, AssetName
an, Integer
_) -> AssetName
an) ((PolicyID crypto, AssetName, Integer) -> AssetName)
-> [(PolicyID crypto, AssetName, Integer)] -> [AssetName]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(PolicyID crypto, 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
assetName (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 (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 crypto, AssetName, Integer)
-> Maybe (Word16, Word16, Word64)
prepare (PolicyID crypto
pid, AssetName
aname, Integer
q) = do
      Word64
q' <- Integer -> Maybe Word64
integerToWord64 Integer
q
      (Word16, Word16, Word64) -> Maybe (Word16, Word16, Word64)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PolicyID crypto -> Word16
pidOffset PolicyID crypto
pid, AssetName -> Word16
assetNameOffset AssetName
aname, Word64
q')

representationSize ::
  forall crypto.
  CC.Crypto crypto =>
  [(PolicyID crypto, AssetName, Integer)] ->
  Int
representationSize :: [(PolicyID crypto, AssetName, Integer)] -> Int
representationSize [(PolicyID crypto, 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 crypto, AssetName, Integer)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(PolicyID crypto, 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 crypto) -> Int
forall a. Set a -> Int
Set.size (Set (PolicyID crypto) -> Int)
-> ([PolicyID crypto] -> Set (PolicyID crypto))
-> [PolicyID crypto]
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [PolicyID crypto] -> Set (PolicyID crypto)
forall a. Ord a => [a] -> Set a
Set.fromList ([PolicyID crypto] -> Int) -> [PolicyID crypto] -> Int
forall a b. (a -> b) -> a -> b
$ (\(PolicyID crypto
pid, AssetName
_, Integer
_) -> PolicyID crypto
pid) ((PolicyID crypto, AssetName, Integer) -> PolicyID crypto)
-> [(PolicyID crypto, AssetName, Integer)] -> [PolicyID crypto]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(PolicyID crypto, AssetName, Integer)]
xs
    pidSize :: Int
pidSize = Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Proxy (ADDRHASH crypto) -> Word
forall h (proxy :: * -> *). HashAlgorithm h => proxy h -> Word
Hash.sizeHash (Proxy (ADDRHASH crypto)
forall k (t :: k). Proxy t
Proxy :: Proxy (CC.ADDRHASH crypto)))
    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 crypto
_, AssetName
an, Integer
_) -> AssetName
an) ((PolicyID crypto, AssetName, Integer) -> AssetName)
-> [(PolicyID crypto, AssetName, Integer)] -> [AssetName]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(PolicyID crypto, 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 (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
assetName) Set AssetName
assetNames

from :: forall crypto. (CC.Crypto crypto) => CompactValue crypto -> Value crypto
from :: CompactValue crypto -> Value crypto
from (CompactValueAdaOnly (CompactCoin c)) = Integer
-> Map (PolicyID crypto) (Map AssetName Integer) -> Value crypto
forall crypto.
Integer
-> Map (PolicyID crypto) (Map AssetName Integer) -> Value crypto
Value (Word64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
c) Map (PolicyID crypto) (Map AssetName Integer)
forall a. Monoid a => a
mempty
from (CompactValueMultiAsset (CompactCoin c) Word32
numAssets ShortByteString
rep) =
  Integer -> [(PolicyID crypto, AssetName, Integer)] -> Value crypto
forall era.
Integer -> [(PolicyID era, AssetName, Integer)] -> Value era
valueFromList (Word64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
c) [(PolicyID crypto, AssetName, Integer)]
triples
  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 crypto, AssetName, Integer)]
    triples :: [(PolicyID crypto, AssetName, Integer)]
triples = ((Word16, Word16, Word64) -> (PolicyID crypto, AssetName, Integer))
-> [(Word16, Word16, Word64)]
-> [(PolicyID crypto, AssetName, Integer)]
forall a b. (a -> b) -> [a] -> [b]
map (Word16, Word16, Word64) -> (PolicyID crypto, 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 crypto, AssetName, Integer)
    convertTriple :: (Word16, Word16, Word64) -> (PolicyID crypto, AssetName, Integer)
convertTriple (Word16
p, Word16
a, Word64
i) =
      ( ScriptHash crypto -> PolicyID crypto
forall crypto. ScriptHash crypto -> PolicyID crypto
PolicyID (ScriptHash crypto -> PolicyID crypto)
-> ScriptHash crypto -> PolicyID crypto
forall a b. (a -> b) -> a -> b
$
          Hash (ADDRHASH crypto) EraIndependentScript -> ScriptHash crypto
forall crypto.
Hash (ADDRHASH crypto) EraIndependentScript -> ScriptHash crypto
ScriptHash (Hash (ADDRHASH crypto) EraIndependentScript -> ScriptHash crypto)
-> Hash (ADDRHASH crypto) EraIndependentScript -> ScriptHash crypto
forall a b. (a -> b) -> a -> b
$
            ShortByteString -> Hash (ADDRHASH crypto) EraIndependentScript
forall h a. HashAlgorithm h => ShortByteString -> Hash h a
Hash.UnsafeHash (ShortByteString -> Hash (ADDRHASH crypto) EraIndependentScript)
-> ShortByteString -> Hash (ADDRHASH crypto) 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 crypto] -> Word
forall h (proxy :: * -> *). HashAlgorithm h => proxy h -> Word
Hash.sizeHash ([] :: [CC.ADDRHASH crypto])),
        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 :: [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]
`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 :: Value crypto -> Set (PolicyID crypto)
policies :: Value crypto -> Set (PolicyID crypto)
policies (Value Integer
_ Map (PolicyID crypto) (Map AssetName Integer)
m) = Map (PolicyID crypto) (Map AssetName Integer)
-> Set (PolicyID crypto)
forall k a. Map k a -> Set k
Map.keysSet Map (PolicyID crypto) (Map AssetName Integer)
m

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

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

-- | Remove 0 assets from a map
prune ::
  Map (PolicyID crypto) (Map AssetName Integer) ->
  Map (PolicyID crypto) (Map AssetName Integer)
prune :: Map (PolicyID crypto) (Map AssetName Integer)
-> Map (PolicyID crypto) (Map AssetName Integer)
prune Map (PolicyID crypto) (Map AssetName Integer)
assets =
  (Map AssetName Integer -> Bool)
-> Map (PolicyID crypto) (Map AssetName Integer)
-> Map (PolicyID crypto) (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 (t :: * -> *) a. Foldable t => t a -> Bool
null) (Map (PolicyID crypto) (Map AssetName Integer)
 -> Map (PolicyID crypto) (Map AssetName Integer))
-> Map (PolicyID crypto) (Map AssetName Integer)
-> Map (PolicyID crypto) (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 crypto) (Map AssetName Integer)
-> Map (PolicyID crypto) (Map AssetName Integer)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map (PolicyID crypto) (Map AssetName Integer)
assets

-- | Rather than using prune to remove 0 assets, when can avoid adding them in the
--   first place by using valueFromList to construct a Value.
valueFromList :: Integer -> [(PolicyID era, AssetName, Integer)] -> Value era
valueFromList :: Integer -> [(PolicyID era, AssetName, Integer)] -> Value era
valueFromList Integer
ada =
  ((PolicyID era, AssetName, Integer) -> Value era -> Value era)
-> Value era -> [(PolicyID era, AssetName, Integer)] -> Value era
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr
    (\(PolicyID era
p, AssetName
n, Integer
i) Value era
ans -> (Integer -> Integer -> Integer)
-> PolicyID era -> AssetName -> Integer -> Value era -> Value era
forall crypto.
(Integer -> Integer -> Integer)
-> PolicyID crypto
-> AssetName
-> Integer
-> Value crypto
-> Value crypto
insert Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
(+) PolicyID era
p AssetName
n Integer
i Value era
ans)
    (Integer -> Map (PolicyID era) (Map AssetName Integer) -> Value era
forall crypto.
Integer
-> Map (PolicyID crypto) (Map AssetName Integer) -> Value crypto
Value Integer
ada Map (PolicyID era) (Map AssetName Integer)
forall k a. Map k a
Map.empty)

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

-- | Turn the nested 'Value' map-of-maps representation into a flat sequence
-- of policyID, asset name and quantity, plus separately the ada quantity.
gettriples' :: Value crypto -> (Integer, [(PolicyID crypto, AssetName, Integer)], [PolicyID crypto])
gettriples' :: Value crypto
-> (Integer, [(PolicyID crypto, AssetName, Integer)],
    [PolicyID crypto])
gettriples' (Value Integer
c Map (PolicyID crypto) (Map AssetName Integer)
m1) = (Integer
c, [(PolicyID crypto, AssetName, Integer)]
triples, [PolicyID crypto]
bad)
  where
    triples :: [(PolicyID crypto, AssetName, Integer)]
triples =
      [ (PolicyID crypto
policyId, AssetName
aname, Integer
amount)
        | (PolicyID crypto
policyId, Map AssetName Integer
m2) <- Map (PolicyID crypto) (Map AssetName Integer)
-> [(PolicyID crypto, Map AssetName Integer)]
forall k a. Map k a -> [(k, a)]
assocs Map (PolicyID crypto) (Map AssetName Integer)
m1,
          (AssetName
aname, Integer
amount) <- Map AssetName Integer -> [(AssetName, Integer)]
forall k a. Map k a -> [(k, a)]
assocs Map AssetName Integer
m2
      ]
    bad :: [PolicyID crypto]
bad = Map (PolicyID crypto) (Map AssetName Integer) -> [PolicyID crypto]
forall k a. Map k a -> [k]
Map.keys ((Map AssetName Integer -> Bool)
-> Map (PolicyID crypto) (Map AssetName Integer)
-> Map (PolicyID crypto) (Map AssetName Integer)
forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter Map AssetName Integer -> Bool
forall k a. Map k a -> Bool
Map.null Map (PolicyID crypto) (Map AssetName Integer)
m1) -- This is a malformed value, not in cannonical form.

gettriples :: Value crypto -> (Integer, [(PolicyID crypto, AssetName, Integer)])
gettriples :: Value crypto -> (Integer, [(PolicyID crypto, AssetName, Integer)])
gettriples Value crypto
v = case Value crypto
-> (Integer, [(PolicyID crypto, AssetName, Integer)],
    [PolicyID crypto])
forall crypto.
Value crypto
-> (Integer, [(PolicyID crypto, AssetName, Integer)],
    [PolicyID crypto])
gettriples' Value crypto
v of
  (Integer
a, [(PolicyID crypto, AssetName, Integer)]
b, [PolicyID crypto]
_) -> (Integer
a, [(PolicyID crypto, AssetName, Integer)]
b)