{-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} {-# OPTIONS_GHC -Wno-orphans #-} module Test.Cardano.Ledger.Mary.ValueSpec (spec) where import Cardano.Ledger.BaseTypes (natVersion) import Cardano.Ledger.Coin (Coin (Coin)) import Cardano.Ledger.Compactible (fromCompact, toCompact) import Cardano.Ledger.Core (eraProtVerLow) import Cardano.Ledger.Mary (MaryEra) import Cardano.Ledger.Mary.Value import Control.Exception (AssertionFailed (AssertionFailed), evaluate) import qualified Data.ByteString.Base16 as BS16 import qualified Data.ByteString.Char8 as BS8 import qualified Data.ByteString.Short as SBS import Data.CanonicalMaps (canonicalInsert) import Data.Maybe (fromJust) import GHC.Exts import Test.Cardano.Data import Test.Cardano.Ledger.Binary.RoundTrip ( roundTripCborExpectation, roundTripCborFailureExpectation, roundTripCborRangeExpectation, roundTripCborRangeFailureExpectation, ) import Test.Cardano.Ledger.Common import Test.Cardano.Ledger.Mary.Arbitrary ( genEmptyMultiAsset, genMaryValue, genMultiAsset, genMultiAssetToFail, genMultiAssetZero, genNegativeInt, ) spec :: Spec spec :: Spec spec = do forall a. HasCallStack => [Char] -> SpecWith a -> SpecWith a describe [Char] "MultiAsset" forall a b. (a -> b) -> a -> b $ do forall prop. (HasCallStack, Testable prop) => [Char] -> prop -> Spec prop [Char] "Canonical construction agrees" forall a b. (a -> b) -> a -> b $ forall prop. Testable prop => Int -> prop -> Property withMaxSuccess Int 10000 forall a b. (a -> b) -> a -> b $ [(PolicyID, AssetName, Integer)] -> [(PolicyID, AssetName, Integer)] -> Property propCanonicalConstructionAgrees forall a. HasCallStack => [Char] -> SpecWith a -> SpecWith a describe [Char] "CBOR roundtrip" forall a b. (a -> b) -> a -> b $ do forall a. HasCallStack => [Char] -> SpecWith a -> SpecWith a context [Char] "Coin" forall a b. (a -> b) -> a -> b $ do forall prop. (HasCallStack, Testable prop) => [Char] -> prop -> Spec prop [Char] "Non-negative Coin succeeds for all eras" forall a b. (a -> b) -> a -> b $ \(NonNegative Integer i) -> forall t. (Show t, Eq t, EncCBOR t, DecCBOR t, HasCallStack) => t -> IO () roundTripCborExpectation (Integer -> Coin Coin Integer i) forall prop. (HasCallStack, Testable prop) => [Char] -> prop -> Spec prop [Char] "Negative Coin succeeds for pre-Conway" forall a b. (a -> b) -> a -> b $ \(Negative Integer i) -> forall t. (Show t, Eq t, EncCBOR t, DecCBOR t, HasCallStack) => Version -> Version -> t -> IO () roundTripCborRangeExpectation forall a. Bounded a => a minBound (forall (v :: Natural). (KnownNat v, MinVersion <= v, v <= MaxVersion) => Version natVersion @8) (Integer -> Coin Coin Integer i) forall prop. (HasCallStack, Testable prop) => [Char] -> prop -> Spec prop [Char] "Negative Coin fails to deserialise for Conway" forall a b. (a -> b) -> a -> b $ \(Negative Integer i) -> forall t. (EncCBOR t, DecCBOR t, Eq t, HasCallStack) => Version -> Version -> t -> IO () roundTripCborRangeFailureExpectation (forall (v :: Natural). (KnownNat v, MinVersion <= v, v <= MaxVersion) => Version natVersion @9) (forall (v :: Natural). (KnownNat v, MinVersion <= v, v <= MaxVersion) => Version natVersion @9) (Integer -> Coin Coin Integer i) forall a. HasCallStack => [Char] -> SpecWith a -> SpecWith a context [Char] "MultiAsset" forall a b. (a -> b) -> a -> b $ do forall prop. (HasCallStack, Testable prop) => [Char] -> prop -> Spec prop [Char] "Non-zero-valued MultiAsset succeeds for all eras" forall a b. (a -> b) -> a -> b $ forall t. (Show t, Eq t, EncCBOR t, DecCBOR t, HasCallStack) => t -> IO () roundTripCborExpectation @MultiAsset forall prop. (HasCallStack, Testable prop) => [Char] -> prop -> Spec prop [Char] "Zero-valued MultiAsset fails for Conway" forall a b. (a -> b) -> a -> b $ forall a prop. (Show a, Testable prop) => Gen a -> (a -> prop) -> Property forAll Gen MultiAsset genMultiAssetZero forall a b. (a -> b) -> a -> b $ forall t. (EncCBOR t, DecCBOR t, Eq t, HasCallStack) => Version -> Version -> t -> IO () roundTripCborRangeFailureExpectation (forall (v :: Natural). (KnownNat v, MinVersion <= v, v <= MaxVersion) => Version natVersion @9) forall a. Bounded a => a maxBound forall prop. (HasCallStack, Testable prop) => [Char] -> prop -> Spec prop [Char] "Empty MultiAsset fails for Conway" forall a b. (a -> b) -> a -> b $ forall a prop. (Show a, Testable prop) => Gen a -> (a -> prop) -> Property forAll Gen MultiAsset genEmptyMultiAsset forall a b. (a -> b) -> a -> b $ forall t. (EncCBOR t, DecCBOR t, Eq t, HasCallStack) => Version -> Version -> t -> IO () roundTripCborRangeFailureExpectation (forall (v :: Natural). (KnownNat v, MinVersion <= v, v <= MaxVersion) => Version natVersion @9) forall a. Bounded a => a maxBound forall a. HasCallStack => [Char] -> SpecWith a -> SpecWith a context [Char] "MaryValue" forall a b. (a -> b) -> a -> b $ do forall prop. (HasCallStack, Testable prop) => [Char] -> prop -> Spec prop [Char] "Positive MaryValue succeeds for all eras" forall a b. (a -> b) -> a -> b $ \(MaryValue mv :: MaryValue) -> forall t. (Show t, Eq t, EncCBOR t, DecCBOR t, HasCallStack) => t -> IO () roundTripCborExpectation MaryValue mv forall prop. (HasCallStack, Testable prop) => [Char] -> prop -> Spec prop [Char] "Negative MaryValue fails for all eras" forall a b. (a -> b) -> a -> b $ forall a prop. (Show a, Testable prop) => Gen a -> (a -> prop) -> Property forAll (Gen MultiAsset -> Gen MaryValue genMaryValue (Gen Integer -> Gen MultiAsset genMultiAsset (forall a. Integral a => a -> Integer toInteger forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Gen Int genNegativeInt))) forall t. (EncCBOR t, DecCBOR t, Eq t, HasCallStack) => t -> IO () roundTripCborFailureExpectation forall prop. (HasCallStack, Testable prop) => [Char] -> prop -> Spec prop [Char] "Zero MaryValue fails for Conway" forall a b. (a -> b) -> a -> b $ forall a prop. (Show a, Testable prop) => Gen a -> (a -> prop) -> Property forAll (Gen MultiAsset -> Gen MaryValue genMaryValue Gen MultiAsset genMultiAssetZero) forall a b. (a -> b) -> a -> b $ forall t. (EncCBOR t, DecCBOR t, Eq t, HasCallStack) => Version -> Version -> t -> IO () roundTripCborRangeFailureExpectation (forall (v :: Natural). (KnownNat v, MinVersion <= v, v <= MaxVersion) => Version natVersion @9) forall a. Bounded a => a maxBound forall prop. (HasCallStack, Testable prop) => [Char] -> prop -> Spec prop [Char] "Empty MaryValue fails for Conway" forall a b. (a -> b) -> a -> b $ forall a prop. (Show a, Testable prop) => Gen a -> (a -> prop) -> Property forAll (Gen MultiAsset -> Gen MaryValue genMaryValue Gen MultiAsset genEmptyMultiAsset) forall a b. (a -> b) -> a -> b $ forall t. (EncCBOR t, DecCBOR t, Eq t, HasCallStack) => Version -> Version -> t -> IO () roundTripCborRangeFailureExpectation (forall (v :: Natural). (KnownNat v, MinVersion <= v, v <= MaxVersion) => Version natVersion @9) forall a. Bounded a => a maxBound forall a. (HasCallStack, Example a) => [Char] -> a -> SpecWith (Arg a) it [Char] "Too many assets should fail" forall a b. (a -> b) -> a -> b $ forall prop. Testable prop => prop -> Property property forall a b. (a -> b) -> a -> b $ forall a prop. (Show a, Testable prop) => Gen a -> (a -> prop) -> Property forAll (Gen MultiAsset -> Gen MaryValue genMaryValue (Bool -> Gen MultiAsset genMultiAssetToFail Bool True)) ( forall t. (EncCBOR t, DecCBOR t, Eq t, HasCallStack) => Version -> Version -> t -> IO () roundTripCborRangeFailureExpectation @MaryValue (forall era. Era era => Version eraProtVerLow @MaryEra) forall a. Bounded a => a maxBound ) forall a. HasCallStack => [Char] -> SpecWith a -> SpecWith a describe [Char] "MaryValue compacting" forall a b. (a -> b) -> a -> b $ do forall prop. (HasCallStack, Testable prop) => [Char] -> prop -> Spec prop [Char] "Canonical generator" forall a b. (a -> b) -> a -> b $ \(MaryValue ma :: MaryValue) -> forall a. Compactible a => CompactForm a -> a fromCompact (forall a. HasCallStack => Maybe a -> a fromJust (forall a. Compactible a => a -> Maybe (CompactForm a) toCompact MaryValue ma)) forall a. (HasCallStack, Show a, Eq a) => a -> a -> IO () `shouldBe` MaryValue ma forall prop. (HasCallStack, Testable prop) => [Char] -> prop -> Spec prop [Char] "Failing generator" forall a b. (a -> b) -> a -> b $ forall a prop. (Show a, Testable prop) => Gen a -> (a -> prop) -> Property forAll (Gen MultiAsset -> Gen MaryValue genMaryValue (Bool -> Gen MultiAsset genMultiAssetToFail Bool True)) forall a b. (a -> b) -> a -> b $ \MaryValue ma -> forall a. a -> IO a evaluate (forall a. Compactible a => CompactForm a -> a fromCompact (forall a. HasCallStack => Maybe a -> a fromJust (forall a. Compactible a => a -> Maybe (CompactForm a) toCompact MaryValue ma))) forall e a. (HasCallStack, Exception e) => IO a -> Selector e -> IO () `shouldThrow` (\(AssertionFailed [Char] errorMsg) -> forall a. Int -> [a] -> [a] take Int 16 [Char] errorMsg forall a. Eq a => a -> a -> Bool == [Char] "Assertion failed") instance IsString AssetName where fromString :: [Char] -> AssetName fromString = ShortByteString -> AssetName AssetName forall b c a. (b -> c) -> (a -> b) -> a -> c . forall a c b. (a -> c) -> (b -> c) -> Either a b -> c either forall a. HasCallStack => [Char] -> a error ByteString -> ShortByteString SBS.toShort forall b c a. (b -> c) -> (a -> b) -> a -> c . ByteString -> Either [Char] ByteString BS16.decode forall b c a. (b -> c) -> (a -> b) -> a -> c . [Char] -> ByteString BS8.pack propCanonicalConstructionAgrees :: [(PolicyID, AssetName, Integer)] -> [(PolicyID, AssetName, Integer)] -> Property propCanonicalConstructionAgrees :: [(PolicyID, AssetName, Integer)] -> [(PolicyID, AssetName, Integer)] -> Property propCanonicalConstructionAgrees [(PolicyID, AssetName, Integer)] xs [(PolicyID, AssetName, Integer)] ys = forall prop. Testable prop => prop -> Property property forall a b. (a -> b) -> a -> b $ do let ma1 :: MultiAsset ma1@(MultiAsset Map PolicyID (Map AssetName Integer) a1) = [(PolicyID, AssetName, Integer)] -> MultiAsset multiAssetFromList [(PolicyID, AssetName, Integer)] xs ma2 :: MultiAsset ma2@(MultiAsset Map PolicyID (Map AssetName Integer) a2) = [(PolicyID, AssetName, Integer)] -> MultiAsset multiAssetFromList [(PolicyID, AssetName, Integer)] ys forall k a. (HasCallStack, Ord k, Show k, Show a) => Map k a -> IO () expectValidMap Map PolicyID (Map AssetName Integer) a1 forall k a. (HasCallStack, Ord k, Show k, Show a) => Map k a -> IO () expectValidMap Map PolicyID (Map AssetName Integer) a2 let mb1 :: MultiAsset mb1@(MultiAsset Map PolicyID (Map AssetName Integer) b1) = forall a. Monoid a => [a] -> a mconcat [ Map PolicyID (Map AssetName Integer) -> MultiAsset MultiAsset forall a b. (a -> b) -> a -> b $ forall k a. (Ord k, CanonicalZero a) => (a -> a -> a) -> k -> a -> Map k a -> Map k a canonicalInsert forall a b. a -> b -> a const PolicyID pid (forall k a. (Ord k, CanonicalZero a) => (a -> a -> a) -> k -> a -> Map k a -> Map k a canonicalInsert forall a b. a -> b -> a const AssetName an Integer i forall a. Monoid a => a mempty) forall a. Monoid a => a mempty | (PolicyID pid, AssetName an, Integer i) <- [(PolicyID, AssetName, Integer)] xs ] mb2 :: MultiAsset mb2@(MultiAsset Map PolicyID (Map AssetName Integer) b2) = forall a. Monoid a => [a] -> a mconcat [ Map PolicyID (Map AssetName Integer) -> MultiAsset MultiAsset forall a b. (a -> b) -> a -> b $ forall k a. (Ord k, CanonicalZero a) => (a -> a -> a) -> k -> a -> Map k a -> Map k a canonicalInsert forall a b. a -> b -> a const PolicyID pid (forall k a. (Ord k, CanonicalZero a) => (a -> a -> a) -> k -> a -> Map k a -> Map k a canonicalInsert forall a b. a -> b -> a const AssetName an Integer i forall a. Monoid a => a mempty) forall a. Monoid a => a mempty | (PolicyID pid, AssetName an, Integer i) <- [(PolicyID, AssetName, Integer)] ys ] forall k a. (HasCallStack, Ord k, Show k, Show a) => Map k a -> IO () expectValidMap Map PolicyID (Map AssetName Integer) b1 forall k a. (HasCallStack, Ord k, Show k, Show a) => Map k a -> IO () expectValidMap Map PolicyID (Map AssetName Integer) b2 MultiAsset ma1 forall a. (HasCallStack, Show a, Eq a) => a -> a -> IO () `shouldBe` MultiAsset mb1 MultiAsset ma2 forall a. (HasCallStack, Show a, Eq a) => a -> a -> IO () `shouldBe` MultiAsset mb2 MultiAsset ma1 forall a. Semigroup a => a -> a -> a <> MultiAsset ma2 forall a. (HasCallStack, Show a, Eq a) => a -> a -> IO () `shouldBe` MultiAsset mb1 forall a. Semigroup a => a -> a -> a <> MultiAsset mb2 MultiAsset ma1 forall a. Semigroup a => a -> a -> a <> MultiAsset mb2 forall a. (HasCallStack, Show a, Eq a) => a -> a -> IO () `shouldBe` MultiAsset mb1 forall a. Semigroup a => a -> a -> a <> MultiAsset ma2