From b9ace6751eae78d7dd1326f9d9185052d28ef4f9 Mon Sep 17 00:00:00 2001 From: teodanciu Date: Wed, 27 Jul 2022 13:00:48 +0100 Subject: [PATCH] Define `MultiAsset` type wrapping multiasset map and use it in `Value` --- .../impl/src/Cardano/Ledger/Alonzo/Tx.hs | 4 +- .../impl/src/Cardano/Ledger/Alonzo/TxInfo.hs | 4 +- .../test/Test/Cardano/Ledger/Alonzo/Golden.hs | 4 +- .../Ledger/Babbage/Examples/Consensus.hs | 4 +- .../impl/src/Cardano/Ledger/Mary/Value.hs | 97 ++++++++------- .../Cardano/Ledger/Mary/Examples/Consensus.hs | 2 +- .../src/Test/Cardano/Ledger/Mary/Golden.hs | 117 ++++++++++-------- .../src/Test/Cardano/Ledger/MaryEraGen.hs | 3 +- .../ShelleyMA/Serialisation/Generators.hs | 7 +- .../Test/Cardano/Ledger/ShelleyMA/TxBody.hs | 4 +- .../Ledger/Mary/Examples/MultiAssets.hs | 41 +++--- .../test/Test/Cardano/Ledger/Mary/Value.hs | 20 +-- .../Serialisation/Golden/Encoding.hs | 29 ++--- .../bench/Bench/Cardano/Ledger/TxOut.hs | 2 +- .../src/Test/Cardano/Ledger/Generic/Fields.hs | 4 +- .../Test/Cardano/Ledger/Generic/Indexed.hs | 11 +- .../Test/Cardano/Ledger/Generic/PrettyCore.hs | 6 +- .../Test/Cardano/Ledger/Generic/Scriptic.hs | 8 +- .../src/Test/Cardano/Ledger/ValueFromList.hs | 3 +- .../src/Cardano/Ledger/State/UTxO.hs | 6 +- 20 files changed, 211 insertions(+), 165 deletions(-) diff --git a/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Tx.hs b/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Tx.hs index 61469d5aeb0..83f1b953e52 100644 --- a/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Tx.hs +++ b/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Tx.hs @@ -123,7 +123,7 @@ import Cardano.Ledger.Coin (Coin (..)) import Cardano.Ledger.Core hiding (TxBody) import qualified Cardano.Ledger.Core as Core import qualified Cardano.Ledger.Crypto as CC -import Cardano.Ledger.Mary.Value (AssetName, MaryValue (..), PolicyID (..)) +import Cardano.Ledger.Mary.Value (AssetName, MaryValue (..), MultiAsset (..), PolicyID (..)) import Cardano.Ledger.SafeHash ( HashAnnotated, SafeToHash (..), @@ -429,7 +429,7 @@ rdptrInv txBody (RdmrPtr Cert idx) = Certifying <$> fromIndex idx (txBody ^. certsTxBodyL) getMapFromValue :: MaryValue crypto -> Map.Map (PolicyID crypto) (Map.Map AssetName Integer) -getMapFromValue (MaryValue _ m) = m +getMapFromValue (MaryValue _ (MultiAsset m)) = m -- | Find the Data and ExUnits assigned to a script. indexedRdmrs :: diff --git a/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/TxInfo.hs b/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/TxInfo.hs index 34d7a3d7aa8..581ae51d0d5 100644 --- a/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/TxInfo.hs +++ b/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/TxInfo.hs @@ -100,7 +100,7 @@ import Cardano.Ledger.Credential ) import qualified Cardano.Ledger.Crypto as CC (Crypto) import Cardano.Ledger.Keys (KeyHash (..), hashKey) -import Cardano.Ledger.Mary.Value (AssetName (..), MaryValue (..), PolicyID (..)) +import Cardano.Ledger.Mary.Value (AssetName (..), MaryValue (..), MultiAsset (..), PolicyID (..)) import Cardano.Ledger.SafeHash (SafeHash, extractHash, hashAnnotated) import Cardano.Ledger.Serialization (Sized (sizedValue)) import qualified Cardano.Ledger.Shelley.HardForks as HardForks @@ -360,7 +360,7 @@ transAssetName :: AssetName -> PV1.TokenName transAssetName (AssetName bs) = PV1.TokenName (PV1.toBuiltin (SBS.fromShort bs)) transValue :: MaryValue c -> PV1.Value -transValue (MaryValue n mp) = Map.foldlWithKey' accum1 justada mp +transValue (MaryValue n (MultiAsset mp)) = Map.foldlWithKey' accum1 justada mp where accum1 ans sym mp2 = Map.foldlWithKey' accum2 ans mp2 where diff --git a/eras/alonzo/test-suite/test/Test/Cardano/Ledger/Alonzo/Golden.hs b/eras/alonzo/test-suite/test/Test/Cardano/Ledger/Alonzo/Golden.hs index 88b42454b8c..644815cccd8 100644 --- a/eras/alonzo/test-suite/test/Test/Cardano/Ledger/Alonzo/Golden.hs +++ b/eras/alonzo/test-suite/test/Test/Cardano/Ledger/Alonzo/Golden.hs @@ -31,7 +31,7 @@ import Cardano.Ledger.BaseTypes (StrictMaybe (..), boundRational) import Cardano.Ledger.Block (Block (..)) import Cardano.Ledger.Coin (Coin (..)) import Cardano.Ledger.Era (EraSegWits (..)) -import Cardano.Ledger.Mary.Value (MaryValue (..), valueFromList) +import Cardano.Ledger.Mary.Value (MaryValue (..), MultiAsset (..), valueFromList) import Cardano.Protocol.TPraos.BHeader (BHeader) import Codec.CBOR.Read (deserialiseFromBytes) import qualified Data.ByteString.Base16 as B16 @@ -175,7 +175,7 @@ goldenUTxOEntryMinAda = -- with the old parameter minUTxOValue. -- If we wish to keep the ada-only, no datum hash, minimum value nearly the same, -- we can divide minUTxOValue by 29 and round. - utxoEntrySize @(AlonzoEra StandardCrypto) (AlonzoTxOut aliceAddr (MaryValue 0 mempty) SNothing) @?= 29 + utxoEntrySize @(AlonzoEra StandardCrypto) (AlonzoTxOut aliceAddr (MaryValue 0 (MultiAsset mempty)) SNothing) @?= 29 ] goldenSerialization :: TestTree diff --git a/eras/babbage/test-suite/src/Test/Cardano/Ledger/Babbage/Examples/Consensus.hs b/eras/babbage/test-suite/src/Test/Cardano/Ledger/Babbage/Examples/Consensus.hs index 8c13da45131..2fc3c9c667b 100644 --- a/eras/babbage/test-suite/src/Test/Cardano/Ledger/Babbage/Examples/Consensus.hs +++ b/eras/babbage/test-suite/src/Test/Cardano/Ledger/Babbage/Examples/Consensus.hs @@ -26,7 +26,7 @@ import Cardano.Ledger.Coin (Coin (..)) import Cardano.Ledger.Core (EraScript (hashScript), TxBody) import Cardano.Ledger.Crypto (StandardCrypto) import Cardano.Ledger.Keys (asWitness) -import Cardano.Ledger.Mary.Value (MaryValue (..)) +import Cardano.Ledger.Mary.Value (MaryValue (..), MultiAsset (..)) import Cardano.Ledger.SafeHash (hashAnnotated) import Cardano.Ledger.Serialization (mkSized) import Cardano.Ledger.Shelley.API @@ -104,7 +104,7 @@ collateralOutput :: BabbageTxOut StandardBabbage collateralOutput = BabbageTxOut (mkAddr (SLE.examplePayKey, SLE.exampleStakeKey)) - (MaryValue 8675309 mempty) + (MaryValue 8675309 (MultiAsset mempty)) NoDatum SNothing diff --git a/eras/shelley-ma/impl/src/Cardano/Ledger/Mary/Value.hs b/eras/shelley-ma/impl/src/Cardano/Ledger/Mary/Value.hs index 9c9a2f1ddd2..4c2f2b0c7de 100644 --- a/eras/shelley-ma/impl/src/Cardano/Ledger/Mary/Value.hs +++ b/eras/shelley-ma/impl/src/Cardano/Ledger/Mary/Value.hs @@ -15,6 +15,7 @@ module Cardano.Ledger.Mary.Value ( PolicyID (..), AssetName (..), MaryValue (..), + MultiAsset (..), Value, insert, lookup, @@ -126,8 +127,14 @@ instance FromCBOR AssetName where newtype PolicyID crypto = PolicyID {policyID :: ScriptHash crypto} deriving (Show, Eq, ToCBOR, FromCBOR, Ord, NoThunks, NFData) +-- | The MultiAssets map +newtype MultiAsset crypto = MultiAsset (Map (PolicyID crypto) (Map AssetName Integer)) + deriving (Show, Generic) + +instance NoThunks (MultiAsset crypto) + -- | The Value representing MultiAssets -data MaryValue crypto = MaryValue !Integer !(Map (PolicyID crypto) (Map AssetName Integer)) +data MaryValue crypto = MaryValue !Integer !(MultiAsset crypto) deriving (Show, Generic) type Value = MaryValue @@ -138,22 +145,22 @@ instance CC.Crypto crypto => Eq (MaryValue crypto) where x == y = pointwise (==) x y instance NFData (MaryValue crypto) where - rnf (MaryValue c m) = c `deepseq` rnf m + rnf (MaryValue c (MultiAsset m)) = c `deepseq` rnf m instance NoThunks (MaryValue crypto) instance Semigroup (MaryValue crypto) where - MaryValue c m <> MaryValue c1 m1 = - MaryValue (c + c1) (canonicalMapUnion (canonicalMapUnion (+)) m m1) + MaryValue c (MultiAsset m) <> MaryValue c1 (MultiAsset m1) = + MaryValue (c + c1) (MultiAsset (canonicalMapUnion (canonicalMapUnion (+)) m m1)) instance Monoid (MaryValue crypto) where - mempty = MaryValue 0 mempty + mempty = MaryValue 0 (MultiAsset mempty) instance Group (MaryValue crypto) where - invert (MaryValue c m) = + invert (MaryValue c (MultiAsset m)) = MaryValue (-c) - (canonicalMap (canonicalMap ((-1 :: Integer) *)) m) + (MultiAsset (canonicalMap (canonicalMap ((-1 :: Integer) *)) m)) instance Abelian (MaryValue crypto) @@ -161,24 +168,24 @@ instance Abelian (MaryValue crypto) -- Make the Val instance of MaryValue instance CC.Crypto crypto => Val (MaryValue crypto) where - s <×> MaryValue c v = + s <×> MaryValue c (MultiAsset m) = MaryValue (fromIntegral s * c) - (canonicalMap (canonicalMap (fromIntegral s *)) v) - isZero (MaryValue c v) = c == 0 && Map.null v + (MultiAsset (canonicalMap (canonicalMap (fromIntegral s *)) m)) + isZero (MaryValue c (MultiAsset m)) = c == 0 && Map.null m coin (MaryValue c _) = Coin c - inject (Coin c) = MaryValue c mempty + inject (Coin c) = MaryValue c (MultiAsset mempty) modifyCoin f (MaryValue c m) = MaryValue n m where (Coin n) = f (Coin c) - pointwise p (MaryValue c x) (MaryValue d y) = p c d && pointWise (pointWise p) x y + pointwise p (MaryValue c (MultiAsset x)) (MaryValue d (MultiAsset y)) = p c d && pointWise (pointWise p) x y -- returns the size, in Word64's, of the CompactValue representation of MaryValue - size vv@(MaryValue _ v) + size vv@(MaryValue _ (MultiAsset m)) -- when MaryValue contains only ada -- !WARNING! This branch is INCORRECT in the Mary era and should ONLY be -- used in the Alonzo ERA. -- TODO - find a better way to reconcile the mistakes in Mary with what needs -- to be the case in Alonzo. - | v == mempty = 2 + | m == mempty = 2 -- when MaryValue contains ada as well as other tokens -- sums up : -- i) adaWords : the space taken up by the ada amount @@ -192,7 +199,7 @@ instance CC.Crypto crypto => Val (MaryValue crypto) where + repOverhead ) - isAdaOnly (MaryValue _ v) = Map.null v + isAdaOnly (MaryValue _ (MultiAsset m)) = Map.null m isAdaOnlyCompact = \case CompactValue (CompactValueAdaOnly _) -> True @@ -264,16 +271,16 @@ decodeValuePair decodeAmount = encodeMultiAssetMaps :: CC.Crypto crypto => - Map (PolicyID crypto) (Map AssetName Integer) -> + MultiAsset crypto -> Encoding -encodeMultiAssetMaps = encodeMap toCBOR (encodeMap toCBOR toCBOR) +encodeMultiAssetMaps (MultiAsset m) = encodeMap toCBOR (encodeMap toCBOR toCBOR) m decodeMultiAssetMaps :: CC.Crypto crypto => Decoder s Integer -> - Decoder s (Map (PolicyID crypto) (Map AssetName Integer)) + Decoder s (MultiAsset crypto) decodeMultiAssetMaps decodeAmount = - prune <$> decodeMap fromCBOR (decodeMap fromCBOR decodeAmount) + MultiAsset . prune <$> decodeMap fromCBOR (decodeMap fromCBOR decodeAmount) decodeNonNegativeInteger :: Decoder s Integer decodeNonNegativeInteger = fromIntegral <$> decodeWord64 @@ -295,14 +302,14 @@ instance CC.Crypto crypto => ToCBOR (MaryValue crypto) where - toCBOR (MaryValue c v) = - if Map.null v + toCBOR (MaryValue c (MultiAsset m)) = + if Map.null m then toCBOR c else encode $ Rec MaryValue !> To c - !> E encodeMultiAssetMaps v + !> E encodeMultiAssetMaps (MultiAsset m) instance CC.Crypto crypto => @@ -509,8 +516,8 @@ to :: -- 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 (MaryValue ada ma) - | Map.null ma = +to (MaryValue ada (MultiAsset m)) + | Map.null m = CompactValueAdaOnly . CompactCoin <$> integerToWord64 ada to v = do c <- integerToWord64 ada @@ -646,7 +653,7 @@ representationSize xs = abcRegionSize + pidBlockSize + anameBlockSize Semigroup.getSum $ foldMap' (Semigroup.Sum . SBS.length . assetName) assetNames from :: forall crypto. (CC.Crypto crypto) => CompactValue crypto -> MaryValue crypto -from (CompactValueAdaOnly (CompactCoin c)) = MaryValue (fromIntegral c) mempty +from (CompactValueAdaOnly (CompactCoin c)) = MaryValue (fromIntegral c) (MultiAsset mempty) from (CompactValueMultiAsset (CompactCoin c) numAssets rep) = valueFromList (fromIntegral c) triples where @@ -730,10 +737,10 @@ readShortByteString sbs start len = -- This function is equivalent to computing the support of the value in the -- spec. policies :: MaryValue crypto -> Set (PolicyID crypto) -policies (MaryValue _ m) = Map.keysSet m +policies (MaryValue _ (MultiAsset m)) = Map.keysSet m lookup :: PolicyID crypto -> AssetName -> MaryValue crypto -> Integer -lookup pid aid (MaryValue _ m) = +lookup pid aid (MaryValue _ (MultiAsset m)) = case Map.lookup pid m of Nothing -> 0 Just m2 -> Map.findWithDefault 0 aid m2 @@ -749,7 +756,7 @@ insert :: Integer -> MaryValue crypto -> MaryValue crypto -insert combine pid aid new (MaryValue cn m1) = +insert combine pid aid new (MaryValue cn (MultiAsset m1)) = case splitLookup pid m1 of (l1, Just m2, l2) -> case splitLookup aid m2 of @@ -758,29 +765,33 @@ insert combine pid aid new (MaryValue cn m1) = then let m3 = link2 v1 v2 in if Map.null m3 - then MaryValue cn (link2 l1 l2) - else MaryValue cn (link pid m3 l1 l2) - else MaryValue cn (link pid (link aid n v1 v2) l1 l2) + then MaryValue cn (MultiAsset (link2 l1 l2)) + else MaryValue cn (MultiAsset (link pid m3 l1 l2)) + else MaryValue cn (MultiAsset (link pid (link aid n v1 v2) l1 l2)) where n = combine old new (_, Nothing, _) -> MaryValue cn - ( link - pid - ( if new == 0 - then m2 - else Map.insert aid new m2 + ( MultiAsset + ( link + pid + ( if new == 0 + then m2 + else Map.insert aid new m2 + ) + l1 + l2 ) - l1 - l2 ) (l1, Nothing, l2) -> MaryValue cn - ( if new == 0 - then link2 l1 l2 - else link pid (Map.singleton aid new) l1 l2 + ( MultiAsset + ( if new == 0 + then link2 l1 l2 + else link pid (Map.singleton aid new) l1 l2 + ) ) -- ======================================================== @@ -798,7 +809,7 @@ valueFromList :: Integer -> [(PolicyID era, AssetName, Integer)] -> MaryValue er valueFromList ada = foldr (\(p, n, i) ans -> insert (+) p n i ans) - (MaryValue ada Map.empty) + (MaryValue ada (MultiAsset Map.empty)) -- | Display a MaryValue as a String, one token per line showValue :: MaryValue crypto -> String @@ -815,7 +826,7 @@ showValue v = show c ++ "\n" ++ unlines (map trans ts) -- | Turn the nested 'MaryValue' map-of-maps representation into a flat sequence -- of policyID, asset name and quantity, plus separately the ada quantity. gettriples' :: MaryValue crypto -> (Integer, [(PolicyID crypto, AssetName, Integer)], [PolicyID crypto]) -gettriples' (MaryValue c m1) = (c, triples, bad) +gettriples' (MaryValue c (MultiAsset m1)) = (c, triples, bad) where triples = [ (policyId, aname, amount) diff --git a/eras/shelley-ma/test-suite/src/Test/Cardano/Ledger/Mary/Examples/Consensus.hs b/eras/shelley-ma/test-suite/src/Test/Cardano/Ledger/Mary/Examples/Consensus.hs index c54df20a682..b9f5f494d47 100644 --- a/eras/shelley-ma/test-suite/src/Test/Cardano/Ledger/Mary/Examples/Consensus.hs +++ b/eras/shelley-ma/test-suite/src/Test/Cardano/Ledger/Mary/Examples/Consensus.hs @@ -36,7 +36,7 @@ exampleMultiAssetValue :: Int -> MaryValue c exampleMultiAssetValue x = - MaryValue 100 $ Map.singleton policyId $ Map.singleton couttsCoin 1000 + MaryValue 100 $ (MultiAsset (Map.singleton policyId $ Map.singleton couttsCoin 1000)) where policyId :: PolicyID c policyId = PolicyID $ mkScriptHash x diff --git a/eras/shelley-ma/test-suite/src/Test/Cardano/Ledger/Mary/Golden.hs b/eras/shelley-ma/test-suite/src/Test/Cardano/Ledger/Mary/Golden.hs index 8313a4ee262..87be2e8d4c2 100644 --- a/eras/shelley-ma/test-suite/src/Test/Cardano/Ledger/Mary/Golden.hs +++ b/eras/shelley-ma/test-suite/src/Test/Cardano/Ledger/Mary/Golden.hs @@ -20,7 +20,7 @@ where import Cardano.Ledger.Coin (Coin (..)) import Cardano.Ledger.Core (hashScript) import Cardano.Ledger.Mary (MaryEra) -import Cardano.Ledger.Mary.Value (AssetName (..), MaryValue (..), PolicyID (..)) +import Cardano.Ledger.Mary.Value (AssetName (..), MaryValue (..), MultiAsset (..), PolicyID (..)) import Cardano.Ledger.ShelleyMA.Rules (scaledMinDeposit) import Cardano.Ledger.ShelleyMA.Timelocks (Timelock (..)) import Cardano.Ledger.Slot (SlotNo (..)) @@ -84,107 +84,116 @@ goldenScaledMinDeposit = [ testCase "one policy, one (smallest) name" $ scaledMinDeposit ( MaryValue 1407406 $ - Map.singleton pid1 (Map.fromList [(smallestName, 1)]) + MultiAsset $ + Map.singleton pid1 (Map.fromList [(smallestName, 1)]) ) minUTxO @?= Coin 1407406, testCase "one policy, one (small) name" $ scaledMinDeposit ( MaryValue 1444443 $ - Map.singleton - pid1 - (Map.fromList [(smallName 1, 1)]) + MultiAsset $ + Map.singleton + pid1 + (Map.fromList [(smallName 1, 1)]) ) minUTxO @?= Coin 1444443, testCase "one policy, one (real) name" $ scaledMinDeposit ( MaryValue 1444443 $ - Map.singleton - pid1 - (Map.fromList [(realName, 1)]) + MultiAsset $ + Map.singleton + pid1 + (Map.fromList [(realName, 1)]) ) minUTxO @?= Coin 1481480, testCase "one policy, three (small) name" $ scaledMinDeposit ( MaryValue 1555554 $ - Map.singleton - pid1 - ( Map.fromList - [ (smallName 1, 1), - (smallName 2, 1), - (smallName 3, 1) - ] - ) + MultiAsset $ + Map.singleton + pid1 + ( Map.fromList + [ (smallName 1, 1), + (smallName 2, 1), + (smallName 3, 1) + ] + ) ) minUTxO @?= Coin 1555554, testCase "one policy, one (largest) name" $ scaledMinDeposit ( MaryValue 1555554 $ - Map.singleton - pid1 - (Map.fromList [(largestName 65, 1)]) + MultiAsset $ + Map.singleton + pid1 + (Map.fromList [(largestName 65, 1)]) ) minUTxO @?= Coin 1555554, testCase "one policy, three (largest) name" $ scaledMinDeposit ( MaryValue 1962961 $ - Map.singleton - pid1 - ( Map.fromList - [ (largestName 65, 1), - (largestName 66, 1), - (largestName 67, 1) - ] - ) + MultiAsset $ + Map.singleton + pid1 + ( Map.fromList + [ (largestName 65, 1), + (largestName 66, 1), + (largestName 67, 1) + ] + ) ) minUTxO @?= Coin 1962961, testCase "two policies, one (smallest) name" $ scaledMinDeposit ( MaryValue 1592591 $ - Map.fromList - [ ( pid1, - Map.fromList [(smallestName, 1)] - ), - ( pid2, - Map.fromList [(smallestName, 1)] - ) - ] + MultiAsset $ + Map.fromList + [ ( pid1, + Map.fromList [(smallestName, 1)] + ), + ( pid2, + Map.fromList [(smallestName, 1)] + ) + ] ) minUTxO @?= Coin 1592591, testCase "two policies, two (small) names" $ scaledMinDeposit ( MaryValue 1629628 $ - Map.fromList - [ ( pid1, - Map.fromList [(smallName 1, 1)] - ), - ( pid2, - Map.fromList [(smallName 2, 1)] - ) - ] + MultiAsset $ + Map.fromList + [ ( pid1, + Map.fromList [(smallName 1, 1)] + ), + ( pid2, + Map.fromList [(smallName 2, 1)] + ) + ] ) minUTxO @?= Coin 1629628, testCase "three policies, ninety-six (small) names" $ scaledMinDeposit ( MaryValue 7407400 $ - Map.fromList - [ ( pid1, - Map.fromList $ map ((,1) . smallName) [32 .. 63] - ), - ( pid2, - Map.fromList $ map ((,1) . smallName) [64 .. 95] - ), - ( pid3, - Map.fromList $ map ((,1) . smallName) [96 .. 127] - ) - ] + MultiAsset $ + Map.fromList + [ ( pid1, + Map.fromList $ map ((,1) . smallName) [32 .. 63] + ), + ( pid2, + Map.fromList $ map ((,1) . smallName) [64 .. 95] + ), + ( pid3, + Map.fromList $ map ((,1) . smallName) [96 .. 127] + ) + ] ) minUTxO @?= Coin 7407400 diff --git a/eras/shelley-ma/test-suite/src/Test/Cardano/Ledger/MaryEraGen.hs b/eras/shelley-ma/test-suite/src/Test/Cardano/Ledger/MaryEraGen.hs index 995350ac38d..504dd8bae23 100644 --- a/eras/shelley-ma/test-suite/src/Test/Cardano/Ledger/MaryEraGen.hs +++ b/eras/shelley-ma/test-suite/src/Test/Cardano/Ledger/MaryEraGen.hs @@ -20,6 +20,7 @@ import qualified Cardano.Ledger.Crypto as CC import Cardano.Ledger.Mary.Value ( AssetName (..), MaryValue (..), + MultiAsset (..), PolicyID (..), policies, valueFromList, @@ -323,7 +324,7 @@ instance Split (MaryValue era) where vsplit (MaryValue n mp) m | m <= 0 = error "must split coins into positive parts" | otherwise = - ( take (fromIntegral m) (MaryValue (n `div` m) mp : repeat (MaryValue (n `div` m) Map.empty)), + ( take (fromIntegral m) (MaryValue (n `div` m) mp : repeat (MaryValue (n `div` m) (MultiAsset Map.empty))), Coin (n `rem` m) ) diff --git a/eras/shelley-ma/test-suite/src/Test/Cardano/Ledger/ShelleyMA/Serialisation/Generators.hs b/eras/shelley-ma/test-suite/src/Test/Cardano/Ledger/ShelleyMA/Serialisation/Generators.hs index cd3fb94fcb9..01b8795ec8c 100644 --- a/eras/shelley-ma/test-suite/src/Test/Cardano/Ledger/ShelleyMA/Serialisation/Generators.hs +++ b/eras/shelley-ma/test-suite/src/Test/Cardano/Ledger/ShelleyMA/Serialisation/Generators.hs @@ -29,7 +29,7 @@ import qualified Cardano.Ledger.Core as Core import qualified Cardano.Ledger.Crypto as CC (Crypto) import Cardano.Ledger.Era (Crypto, Era) import Cardano.Ledger.Mary (MaryEra) -import Cardano.Ledger.Mary.Value (AssetName (..), MaryValue (..), PolicyID (..)) +import Cardano.Ledger.Mary.Value (AssetName (..), MaryValue (..), MultiAsset (..), PolicyID (..)) import qualified Cardano.Ledger.Mary.Value as ConcreteValue import Cardano.Ledger.Shelley.API import Cardano.Ledger.ShelleyMA.AuxiliaryData (MAAuxiliaryData (..)) @@ -158,6 +158,9 @@ instance Mock c => Arbitrary (MATxBody (MaryEra c)) where instance Mock c => Arbitrary (PolicyID c) where arbitrary = PolicyID <$> arbitrary +instance Mock c => Arbitrary (MultiAsset c) where + arbitrary = MultiAsset <$> arbitrary + instance Mock c => Arbitrary (MaryValue c) where arbitrary = valueFromListBounded @Word64 <$> arbitrary <*> arbitrary @@ -189,7 +192,7 @@ valueFromListBounded :: valueFromListBounded (fromIntegral -> ada) = foldr (\(p, n, fromIntegral -> i) ans -> ConcreteValue.insert comb p n i ans) - (MaryValue ada Map.empty) + (MaryValue ada (MultiAsset Map.empty)) where comb :: Integer -> Integer -> Integer comb a b = diff --git a/eras/shelley-ma/test-suite/src/Test/Cardano/Ledger/ShelleyMA/TxBody.hs b/eras/shelley-ma/test-suite/src/Test/Cardano/Ledger/ShelleyMA/TxBody.hs index e04e285585a..60c1579d7db 100644 --- a/eras/shelley-ma/test-suite/src/Test/Cardano/Ledger/ShelleyMA/TxBody.hs +++ b/eras/shelley-ma/test-suite/src/Test/Cardano/Ledger/ShelleyMA/TxBody.hs @@ -20,7 +20,7 @@ import Cardano.Ledger.BaseTypes (StrictMaybe (SJust, SNothing)) import Cardano.Ledger.Coin (Coin (..)) import Cardano.Ledger.Core import Cardano.Ledger.Mary (MaryEra) -import Cardano.Ledger.Mary.Value (AssetName (..), MaryValue (..), PolicyID (..)) +import Cardano.Ledger.Mary.Value (AssetName (..), MaryValue (..), MultiAsset (..), PolicyID (..)) import Cardano.Ledger.Shelley.TxBody (ShelleyEraTxBody (..), Wdrl (..)) import Cardano.Ledger.ShelleyMA.Timelocks (Timelock (..), ValidityInterval (..)) import Cardano.Ledger.ShelleyMA.TxBody (MATxBody (..), ShelleyMAEraTxBody (..)) @@ -66,7 +66,7 @@ txM = testmint testmint :: MaryValue TestCrypto -testmint = MaryValue 0 (Map.singleton policyId (Map.singleton aname 2)) +testmint = MaryValue 0 $ MultiAsset $ Map.singleton policyId (Map.singleton aname 2) where policyId = PolicyID . hashScript @TestEra . RequireAnyOf $ fromList [] aname = AssetName $ fromString "asset name" diff --git a/eras/shelley-ma/test-suite/test/Test/Cardano/Ledger/Mary/Examples/MultiAssets.hs b/eras/shelley-ma/test-suite/test/Test/Cardano/Ledger/Mary/Examples/MultiAssets.hs index 684d54d6f6f..62dbf14f565 100644 --- a/eras/shelley-ma/test-suite/test/Test/Cardano/Ledger/Mary/Examples/MultiAssets.hs +++ b/eras/shelley-ma/test-suite/test/Test/Cardano/Ledger/Mary/Examples/MultiAssets.hs @@ -20,6 +20,7 @@ import Cardano.Ledger.Mary (MaryEra) import Cardano.Ledger.Mary.Value ( AssetName (..), MaryValue (..), + MultiAsset (..), PolicyID (..), ) import Cardano.Ledger.SafeHash (hashAnnotated) @@ -161,7 +162,8 @@ amethyst = AssetName "amethyst" mintSimpleEx1 :: MaryValue TestCrypto mintSimpleEx1 = MaryValue 0 $ - Map.singleton purplePolicyId (Map.fromList [(plum, 13), (amethyst, 2)]) + MultiAsset $ + Map.singleton purplePolicyId (Map.fromList [(plum, 13), (amethyst, 2)]) aliceCoinSimpleEx1 :: Coin aliceCoinSimpleEx1 = aliceInitCoin <-> feeEx @@ -210,12 +212,14 @@ aliceCoinsSimpleEx2 = aliceCoinSimpleEx1 <-> (feeEx <+> minUtxoSimpleEx2) aliceTokensSimpleEx2 :: MaryValue TestCrypto aliceTokensSimpleEx2 = MaryValue (unCoin aliceCoinsSimpleEx2) $ - Map.singleton purplePolicyId (Map.fromList [(plum, 8), (amethyst, 2)]) + MultiAsset $ + Map.singleton purplePolicyId (Map.fromList [(plum, 8), (amethyst, 2)]) bobTokensSimpleEx2 :: MaryValue TestCrypto bobTokensSimpleEx2 = MaryValue (unCoin minUtxoSimpleEx2) $ - Map.singleton purplePolicyId (Map.singleton plum 5) + MultiAsset $ + Map.singleton purplePolicyId (Map.singleton plum 5) -- Alice gives five plums to Bob. txbodySimpleEx2 :: MATxBody MaryTest @@ -285,7 +289,8 @@ tokenTimeEx = AssetName "tokenTimeEx" mintTimeEx1 :: MaryValue TestCrypto mintTimeEx1 = MaryValue 0 $ - Map.singleton boundedTimePolicyId (Map.singleton tokenTimeEx 1) + MultiAsset $ + Map.singleton boundedTimePolicyId (Map.singleton tokenTimeEx 1) aliceCoinsTimeEx1 :: Coin aliceCoinsTimeEx1 = aliceInitCoin <-> feeEx @@ -348,7 +353,8 @@ mintTimeEx2 = Coin 120 bobTokensTimeEx2 :: MaryValue TestCrypto bobTokensTimeEx2 = MaryValue (unCoin mintTimeEx2) $ - Map.singleton boundedTimePolicyId (Map.singleton tokenTimeEx 1) + MultiAsset $ + Map.singleton boundedTimePolicyId (Map.singleton tokenTimeEx 1) aliceCoinsTimeEx2 :: Coin aliceCoinsTimeEx2 = aliceCoinSimpleEx1 <-> (feeEx <+> mintTimeEx2) @@ -406,7 +412,8 @@ tokenSingWitEx1 = AssetName "tokenSingWitEx1" mintSingWitEx1 :: MaryValue TestCrypto mintSingWitEx1 = MaryValue 0 $ - Map.singleton alicePolicyId (Map.singleton tokenSingWitEx1 17) + MultiAsset $ + Map.singleton alicePolicyId (Map.singleton tokenSingWitEx1 17) bobCoinsSingWitEx1 :: Coin bobCoinsSingWitEx1 = bobInitCoin <-> feeEx @@ -466,12 +473,14 @@ txSingWitEx1Invalid = mintNegEx1 :: MaryValue TestCrypto mintNegEx1 = MaryValue 0 $ - Map.singleton purplePolicyId (Map.singleton plum (-8)) + MultiAsset $ + Map.singleton purplePolicyId (Map.singleton plum (-8)) aliceTokensNegEx1 :: MaryValue TestCrypto aliceTokensNegEx1 = MaryValue (unCoin $ aliceCoinsSimpleEx2 <-> feeEx) $ - Map.singleton purplePolicyId (Map.singleton amethyst 2) + MultiAsset $ + Map.singleton purplePolicyId (Map.singleton amethyst 2) txbodyNegEx1 :: MATxBody MaryTest txbodyNegEx1 = @@ -510,12 +519,14 @@ expectedUTxONegEx1 = mintNegEx2 :: MaryValue TestCrypto mintNegEx2 = MaryValue 0 $ - Map.singleton purplePolicyId (Map.singleton plum (-9)) + MultiAsset $ + Map.singleton purplePolicyId (Map.singleton plum (-9)) aliceTokensNegEx2 :: MaryValue TestCrypto aliceTokensNegEx2 = MaryValue (unCoin $ aliceCoinsSimpleEx2 <-> feeEx) $ - Map.singleton purplePolicyId (Map.fromList [(plum, -1), (amethyst, 2)]) + MultiAsset $ + Map.singleton purplePolicyId (Map.fromList [(plum, -1), (amethyst, 2)]) -- Mint negative valued tokens txbodyNegEx2 :: MATxBody MaryTest @@ -543,7 +554,8 @@ minUtxoBigEx = Coin 50000 smallValue :: MaryValue TestCrypto smallValue = MaryValue 0 $ - Map.singleton purplePolicyId (Map.fromList [(plum, 13), (amethyst, 2)]) + MultiAsset $ + Map.singleton purplePolicyId (Map.fromList [(plum, 13), (amethyst, 2)]) smallOut :: ShelleyTxOut MaryTest smallOut = @@ -555,9 +567,10 @@ numAssets = 1000 bigValue :: MaryValue TestCrypto bigValue = MaryValue 0 $ - Map.singleton - purplePolicyId - (Map.fromList $ map (\x -> (AssetName . fromString $ show x, 1)) [1 .. numAssets]) + MultiAsset $ + Map.singleton + purplePolicyId + (Map.fromList $ map (\x -> (AssetName . fromString $ show x, 1)) [1 .. numAssets]) bigOut :: ShelleyTxOut MaryTest bigOut = ShelleyTxOut Cast.aliceAddr $ bigValue <+> Val.inject minUtxoBigEx diff --git a/eras/shelley-ma/test-suite/test/Test/Cardano/Ledger/Mary/Value.hs b/eras/shelley-ma/test-suite/test/Test/Cardano/Ledger/Mary/Value.hs index a4884c265a9..a8ab715a8a9 100644 --- a/eras/shelley-ma/test-suite/test/Test/Cardano/Ledger/Mary/Value.hs +++ b/eras/shelley-ma/test-suite/test/Test/Cardano/Ledger/Mary/Value.hs @@ -15,6 +15,7 @@ import qualified Cardano.Ledger.Crypto as CC (Crypto) import Cardano.Ledger.Mary.Value ( AssetName (..), MaryValue (..), + MultiAsset (..), PolicyID (..), insert, lookup, @@ -56,22 +57,25 @@ insert3 :: Integer -> MaryValue crypto -> MaryValue crypto -insert3 combine pid aid new (MaryValue c m1) = +insert3 combine pid aid new (MaryValue c (MultiAsset m1)) = case Map.lookup pid m1 of Nothing -> MaryValue c $ - canonicalInsert (canonicalMapUnion combine) pid (canonicalInsert combine aid new zeroC) m1 + MultiAsset $ + canonicalInsert (canonicalMapUnion combine) pid (canonicalInsert combine aid new zeroC) m1 Just m2 -> case Map.lookup aid m2 of Nothing -> MaryValue c $ - canonicalInsert (canonicalMapUnion combine) pid (singleton aid new) m1 + MultiAsset $ + canonicalInsert (canonicalMapUnion combine) pid (singleton aid new) m1 Just old -> MaryValue c $ - canonicalInsert pickNew pid (canonicalInsert pickNew aid (combine old new) m2) m1 + MultiAsset $ + canonicalInsert pickNew pid (canonicalInsert pickNew aid (combine old new) m2) m1 -- | Make a Value with no coin, and just one token. unit :: PolicyID crypto -> AssetName -> Integer -> MaryValue crypto -unit pid aid n = MaryValue 0 (canonicalInsert pickNew pid (canonicalInsert pickNew aid n empty) empty) +unit pid aid n = MaryValue 0 $ MultiAsset (canonicalInsert pickNew pid (canonicalInsert pickNew aid n empty) empty) -- Use <+> and <-> @@ -98,17 +102,17 @@ insert2 combine pid aid new m1 = -- 3 functions that build Values from Policy Asset triples. valueFromList :: [(PolicyID C_Crypto, AssetName, Integer)] -> Integer -> MaryValue C_Crypto -valueFromList list c = foldr acc (MaryValue c empty) list +valueFromList list c = foldr acc (MaryValue c (MultiAsset empty)) list where acc (policy, asset, count) m = insert (+) policy asset count m valueFromList3 :: [(PolicyID C_Crypto, AssetName, Integer)] -> Integer -> MaryValue C_Crypto -valueFromList3 list c = foldr acc (MaryValue c empty) list +valueFromList3 list c = foldr acc (MaryValue c (MultiAsset empty)) list where acc (policy, asset, count) m = insert3 (+) policy asset count m valueFromList2 :: [(PolicyID C_Crypto, AssetName, Integer)] -> Integer -> MaryValue C_Crypto -valueFromList2 list c = foldr acc (MaryValue c empty) list +valueFromList2 list c = foldr acc (MaryValue c (MultiAsset empty)) list where acc (policy, asset, count) m = insert2 (+) policy asset count m diff --git a/eras/shelley-ma/test-suite/test/Test/Cardano/Ledger/ShelleyMA/Serialisation/Golden/Encoding.hs b/eras/shelley-ma/test-suite/test/Test/Cardano/Ledger/ShelleyMA/Serialisation/Golden/Encoding.hs index b343e92edfc..5dd7cede40e 100644 --- a/eras/shelley-ma/test-suite/test/Test/Cardano/Ledger/ShelleyMA/Serialisation/Golden/Encoding.hs +++ b/eras/shelley-ma/test-suite/test/Test/Cardano/Ledger/ShelleyMA/Serialisation/Golden/Encoding.hs @@ -18,7 +18,7 @@ import qualified Cardano.Ledger.Core as Core import Cardano.Ledger.Credential (Credential (..), StakeReference (..)) import qualified Cardano.Ledger.Crypto as CC (Crypto) import Cardano.Ledger.Keys (KeyHash (..), KeyRole (..), hashKey) -import Cardano.Ledger.Mary.Value (AssetName (..), MaryValue (..), PolicyID (..)) +import Cardano.Ledger.Mary.Value (AssetName (..), MaryValue (..), MultiAsset (..), PolicyID (..)) import qualified Cardano.Ledger.Shelley.Metadata as SMD import Cardano.Ledger.Shelley.PParams ( ShelleyPParamsHKD (..), @@ -314,17 +314,18 @@ goldenEncodingTestsMary = checkEncodingCBOR "not_just_ada_value" ( MaryValue @TestCrypto 2 $ - Map.fromList - [ ( policyID1, - Map.fromList - [ (AssetName assetName1, 13), - (AssetName assetName2, 17) - ] - ), - ( policyID2, - Map.singleton (AssetName assetName3) 19 - ) - ] + MultiAsset $ + Map.fromList + [ ( policyID1, + Map.fromList + [ (AssetName assetName1, 13), + (AssetName assetName2, 17) + ] + ), + ( policyID2, + Map.singleton (AssetName assetName3) 19 + ) + ] ) ( T ( TkListLen 2 @@ -348,7 +349,7 @@ goldenEncodingTestsMary = ), checkEncodingCBOR "value_with_negative" - (MaryValue 0 $ Map.singleton policyID1 (Map.singleton (AssetName assetName1) (-19))) + (MaryValue 0 $ MultiAsset $ Map.singleton policyID1 (Map.singleton (AssetName assetName1) (-19))) ( T ( TkListLen 2 . TkInteger 0 @@ -409,7 +410,7 @@ goldenEncodingTestsMary = (ValidityInterval (SJust $ SlotNo 500) (SJust $ SlotNo 600)) (SJust up) (SJust mdh) - (MaryValue 0 mint) + (MaryValue 0 (MultiAsset mint)) ) ( T (TkMapLen 10) <> T (TkWord 0) -- Tx Ins diff --git a/libs/cardano-ledger-test/bench/Bench/Cardano/Ledger/TxOut.hs b/libs/cardano-ledger-test/bench/Bench/Cardano/Ledger/TxOut.hs index 66c87b91a3d..cc0f4f0bb78 100644 --- a/libs/cardano-ledger-test/bench/Bench/Cardano/Ledger/TxOut.hs +++ b/libs/cardano-ledger-test/bench/Bench/Cardano/Ledger/TxOut.hs @@ -43,7 +43,7 @@ benchTxOut = addr :: Int -> Addr StandardCrypto addr n = Addr Mainnet (key n) stake value :: MaryValue StandardCrypto - value = MaryValue 200 (singleton (PolicyID policyId28) (singleton assName 217)) + value = MaryValue 200 $ MultiAsset (singleton (PolicyID policyId28) (singleton assName 217)) txOutAddr :: Int -> TxOut A txOutAddr n = mkBasicTxOut (addr n) value & dataHashTxOutL .~ SJust dataHash32 diff --git a/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Generic/Fields.hs b/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Generic/Fields.hs index 475dbb8cd9a..02bbedb5936 100644 --- a/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Generic/Fields.hs +++ b/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Generic/Fields.hs @@ -61,7 +61,7 @@ import Cardano.Ledger.Core import Cardano.Ledger.Credential (Credential (..), StakeReference (..)) import Cardano.Ledger.Keys (KeyHash, KeyPair (..), KeyRole (..), hashKey) import Cardano.Ledger.Keys.Bootstrap (BootstrapWitness (..)) -import Cardano.Ledger.Mary.Value (MaryValue (..)) +import Cardano.Ledger.Mary.Value (MaryValue (..), MultiAsset (..)) import Cardano.Ledger.Serialization (sizedValue) import qualified Cardano.Ledger.Shelley.PParams as PP (Update) import Cardano.Ledger.Shelley.Tx (ShelleyTx (..), ShelleyTxOut (..), pattern WitnessSet) @@ -237,7 +237,7 @@ initWdrl :: Wdrl crypto initWdrl = Wdrl Map.empty initValue :: MaryValue crypto -initValue = MaryValue 0 Map.empty +initValue = MaryValue 0 (MultiAsset Map.empty) initialTxBody :: Era era => Proof era -> TxBody era initialTxBody (Shelley _) = ShelleyTxBody Set.empty Seq.empty Seq.empty initWdrl (Coin 0) (SlotNo 0) SNothing SNothing diff --git a/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Generic/Indexed.hs b/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Generic/Indexed.hs index 58e53b69414..b913800fe61 100644 --- a/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Generic/Indexed.hs +++ b/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Generic/Indexed.hs @@ -30,6 +30,7 @@ import Cardano.Ledger.Keys hashKey, ) import Cardano.Ledger.Mary.Value (AssetName (..), MaryValue (..), PolicyID (..)) +import qualified Cardano.Ledger.Mary.Value as Mary (MultiAsset (..)) import Cardano.Ledger.Pretty (PrettyA (..), ppPair, ppString) import Cardano.Ledger.Pretty.Alonzo () import Cardano.Ledger.Pretty.Mary () @@ -108,9 +109,11 @@ instance (Reflect era, EraScript era, Fixed (Script era)) => Fixed (MultiAsset e MultiAsset ( MaryValue (fromIntegral n) - ( Map.singleton - (lift (pickPolicyID @era n)) - (Map.singleton (unique @AssetName n) (fromIntegral n)) + ( Mary.MultiAsset + ( Map.singleton + (lift (pickPolicyID @era n)) + (Map.singleton (unique @AssetName n) (fromIntegral n)) + ) ) ) size _ = lift (scriptsize @era) @@ -120,7 +123,7 @@ scriptsize _ = size (Proxy @(Script era)) instance CC.Crypto c => Fixed (MaryValue c) where size _ = Nothing - unique n = MaryValue (fromIntegral n) Map.empty + unique n = MaryValue (fromIntegral n) (Mary.MultiAsset Map.empty) -- ======================================================= -- Keys and KeyHashes diff --git a/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Generic/PrettyCore.hs b/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Generic/PrettyCore.hs index f208f760ea0..4ecc922f1a2 100644 --- a/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Generic/PrettyCore.hs +++ b/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Generic/PrettyCore.hs @@ -43,7 +43,7 @@ import Cardano.Ledger.Keys VKey (..), hashKey, ) -import Cardano.Ledger.Mary.Value (MaryValue (..)) +import Cardano.Ledger.Mary.Value (MaryValue (..), MultiAsset (..)) import Cardano.Ledger.PoolDistr (IndividualPoolStake (..), PoolDistr (..)) import Cardano.Ledger.Pretty import Cardano.Ledger.Pretty.Alonzo @@ -892,7 +892,7 @@ plutusDataSummary (Plutus.I n) = ppInteger n plutusDataSummary (Plutus.B bs) = trim (ppLong bs) vSummary :: MaryValue c -> PDoc -vSummary (MaryValue n m) = +vSummary (MaryValue n (MultiAsset m)) = ppSexp "Value" [ppInteger n, ppString ("num tokens = " ++ show (Map.size m))] scriptSummary :: forall era. Proof era -> Script era -> PDoc @@ -1077,7 +1077,7 @@ pcCoin (Coin n) = hsep [ppString "₳", ppInteger n] instance PrettyC Coin era where prettyC _ = pcCoin pcValue :: MaryValue c -> PDoc -pcValue (MaryValue n m) = ppSexp "Value" [ppInteger n, ppString ("num tokens = " ++ show (Map.size m))] +pcValue (MaryValue n (MultiAsset m)) = ppSexp "Value" [ppInteger n, ppString ("num tokens = " ++ show (Map.size m))] instance c ~ Crypto era => PrettyC (MaryValue c) era where prettyC _ = pcValue diff --git a/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Generic/Scriptic.hs b/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Generic/Scriptic.hs index a4cf4327d11..d4192a157d0 100644 --- a/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Generic/Scriptic.hs +++ b/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Generic/Scriptic.hs @@ -14,7 +14,7 @@ import Cardano.Ledger.Alonzo.Scripts (AlonzoScript (..)) import Cardano.Ledger.Core import qualified Cardano.Ledger.Crypto as CC (Crypto) import Cardano.Ledger.Keys (KeyHash, KeyRole (..)) -import Cardano.Ledger.Mary.Value (AssetName (..), MaryValue (..), PolicyID (..)) +import Cardano.Ledger.Mary.Value (AssetName (..), MaryValue (..), MultiAsset (..), PolicyID (..)) import qualified Cardano.Ledger.Shelley.Scripts as Multi import Cardano.Ledger.ShelleyMA.Timelocks (Timelock (..)) import Cardano.Slotting.Slot (SlotNo (..)) @@ -87,19 +87,19 @@ instance CC.Crypto c => PostShelley (MaryEra c) where after n (Mary _) = RequireTimeExpire (theSlot n) instance forall c. CC.Crypto c => HasTokens (MaryEra c) where - forge n s = MaryValue 0 $ Map.singleton pid (Map.singleton an n) + forge n s = MaryValue 0 $ MultiAsset $ Map.singleton pid (Map.singleton an n) where pid = PolicyID (hashScript @(MaryEra c) s) an = AssetName "an" instance forall c. CC.Crypto c => HasTokens (AlonzoEra c) where - forge n s = MaryValue 0 $ Map.singleton pid (Map.singleton an n) + forge n s = MaryValue 0 $ MultiAsset $ Map.singleton pid (Map.singleton an n) where pid = PolicyID (hashScript @(AlonzoEra c) s) an = AssetName "an" instance forall c. CC.Crypto c => HasTokens (BabbageEra c) where - forge n s = MaryValue 0 $ Map.singleton pid (Map.singleton an n) + forge n s = MaryValue 0 $ MultiAsset $ Map.singleton pid (Map.singleton an n) where pid = PolicyID (hashScript @(BabbageEra c) s) an = AssetName "an" diff --git a/libs/cardano-ledger-test/src/Test/Cardano/Ledger/ValueFromList.hs b/libs/cardano-ledger-test/src/Test/Cardano/Ledger/ValueFromList.hs index 3b7f5e27458..678b0785906 100644 --- a/libs/cardano-ledger-test/src/Test/Cardano/Ledger/ValueFromList.hs +++ b/libs/cardano-ledger-test/src/Test/Cardano/Ledger/ValueFromList.hs @@ -9,6 +9,7 @@ import qualified Cardano.Ledger.Crypto as C import Cardano.Ledger.Mary.Value as Mary ( AssetName, MaryValue (..), + MultiAsset (..), PolicyID (..), insert, valueFromList, @@ -28,7 +29,7 @@ instance C.Crypto crypto => ValueFromList (MaryValue crypto) crypto where insert = Mary.insert - gettriples (MaryValue c m1) = (c, triples) + gettriples (MaryValue c (MultiAsset m1)) = (c, triples) where triples = [ (policyId, aname, amount) diff --git a/libs/ledger-state/src/Cardano/Ledger/State/UTxO.hs b/libs/ledger-state/src/Cardano/Ledger/State/UTxO.hs index 5a59365f433..4f0d251fd29 100644 --- a/libs/ledger-state/src/Cardano/Ledger/State/UTxO.hs +++ b/libs/ledger-state/src/Cardano/Ledger/State/UTxO.hs @@ -574,17 +574,17 @@ countTxOutStats :: [TxOut CurrentEra] -> TxOutStats countTxOutStats = foldMap countTxOutStat where countTxOutStat :: TxOut CurrentEra -> TxOutStats - countTxOutStat (AlonzoTxOut addr (MaryValue v vm) mData) = + countTxOutStat (AlonzoTxOut addr (MaryValue v (MultiAsset m)) mData) = let !dataStat = strictMaybe mempty (\d -> mempty {tosDataHash = statSingleton d}) mData - !vmElems = Map.elems vm + !vmElems = Map.elems m !valueStat = dataStat { tosValue = statSingleton v, - tosPolicyId = statMapKeys vm, + tosPolicyId = statMapKeys m, tosAssetName = foldMap statMapKeys vmElems, tosAssetValue = foldMap statFoldable vmElems }