{-# 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.Binary (DecoderError, decodeFull, serialize)
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.Lazy as BSL
import qualified Data.ByteString.Short as SBS
import Data.CanonicalMaps (canonicalInsert)
import qualified Data.Map.Strict as Map
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 (
  genMaryValue,
  genMultiAsset,
  genMultiAssetCompletelyEmpty,
  genMultiAssetNestedEmpty,
  genMultiAssetToFail,
  genMultiAssetZero,
  genNegativeInt,
 )

spec :: Spec
spec :: Spec
spec = do
  String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"MultiAsset" (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
    String -> Property -> Spec
forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"Canonical construction agrees" (Property -> Spec) -> Property -> Spec
forall a b. (a -> b) -> a -> b
$
      Int
-> ([(PolicyID, AssetName, Integer)]
    -> [(PolicyID, AssetName, Integer)] -> Property)
-> Property
forall prop. Testable prop => Int -> prop -> Property
withMaxSuccess Int
10000 [(PolicyID, AssetName, Integer)]
-> [(PolicyID, AssetName, Integer)] -> Property
propCanonicalConstructionAgrees
  String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"CBOR roundtrip" (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
    String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"Coin" (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
      String -> (NonNegative Integer -> IO ()) -> Spec
forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"Non-negative Coin succeeds for all eras" ((NonNegative Integer -> IO ()) -> Spec)
-> (NonNegative Integer -> IO ()) -> Spec
forall a b. (a -> b) -> a -> b
$
        \(NonNegative Integer
i) -> Coin -> IO ()
forall t.
(Show t, Eq t, EncCBOR t, DecCBOR t, HasCallStack) =>
t -> IO ()
roundTripCborExpectation (Integer -> Coin
Coin Integer
i)
      String -> (Negative Integer -> IO ()) -> Spec
forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"Negative Coin fails to deserialise for all eras" ((Negative Integer -> IO ()) -> Spec)
-> (Negative Integer -> IO ()) -> Spec
forall a b. (a -> b) -> a -> b
$
        \(Negative Integer
i) -> Version -> Version -> Coin -> IO ()
forall t.
(EncCBOR t, DecCBOR t, Eq t, HasCallStack) =>
Version -> Version -> t -> IO ()
roundTripCborRangeFailureExpectation (forall (v :: Natural).
(KnownNat v, 0 <= v, v <= MaxVersion) =>
Version
natVersion @0) Version
forall a. Bounded a => a
maxBound (Integer -> Coin
Coin Integer
i)
    String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"MultiAsset" (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
      String -> (MultiAsset -> IO ()) -> Spec
forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"Non-zero-valued MultiAsset succeeds for all eras" ((MultiAsset -> IO ()) -> Spec) -> (MultiAsset -> IO ()) -> Spec
forall a b. (a -> b) -> a -> b
$
        forall t.
(Show t, Eq t, EncCBOR t, DecCBOR t, HasCallStack) =>
t -> IO ()
roundTripCborExpectation @MultiAsset
      String -> Property -> Spec
forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"Zero-valued MultiAsset fails for Conway" (Property -> Spec) -> Property -> Spec
forall a b. (a -> b) -> a -> b
$
        Gen MultiAsset -> (MultiAsset -> IO ()) -> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
forAll Gen MultiAsset
genMultiAssetZero ((MultiAsset -> IO ()) -> Property)
-> (MultiAsset -> IO ()) -> Property
forall a b. (a -> b) -> a -> b
$
          Version -> Version -> MultiAsset -> IO ()
forall t.
(EncCBOR t, DecCBOR t, Eq t, HasCallStack) =>
Version -> Version -> t -> IO ()
roundTripCborRangeFailureExpectation (forall (v :: Natural).
(KnownNat v, 0 <= v, v <= MaxVersion) =>
Version
natVersion @9) Version
forall a. Bounded a => a
maxBound
      String -> Property -> Spec
forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"MultiAsset with empty nested asset maps fails for Conway and Dijkstra" (Property -> Spec) -> Property -> Spec
forall a b. (a -> b) -> a -> b
$
        Gen MultiAsset -> (MultiAsset -> IO ()) -> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
forAll Gen MultiAsset
genMultiAssetNestedEmpty ((MultiAsset -> IO ()) -> Property)
-> (MultiAsset -> IO ()) -> Property
forall a b. (a -> b) -> a -> b
$
          Version -> Version -> MultiAsset -> IO ()
forall t.
(EncCBOR t, DecCBOR t, Eq t, HasCallStack) =>
Version -> Version -> t -> IO ()
roundTripCborRangeFailureExpectation (forall (v :: Natural).
(KnownNat v, 0 <= v, v <= MaxVersion) =>
Version
natVersion @9) Version
forall a. Bounded a => a
maxBound
      String -> Property -> Spec
forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"Completely empty MultiAsset succeeds for Conway (but fails for Dijkstra)" (Property -> Spec) -> Property -> Spec
forall a b. (a -> b) -> a -> b
$
        Gen MultiAsset -> (MultiAsset -> IO ()) -> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
forAll Gen MultiAsset
genMultiAssetCompletelyEmpty ((MultiAsset -> IO ()) -> Property)
-> (MultiAsset -> IO ()) -> Property
forall a b. (a -> b) -> a -> b
$
          Version -> Version -> MultiAsset -> IO ()
forall t.
(Show t, Eq t, EncCBOR t, DecCBOR t, HasCallStack) =>
Version -> Version -> t -> IO ()
roundTripCborRangeExpectation (forall (v :: Natural).
(KnownNat v, 0 <= v, v <= MaxVersion) =>
Version
natVersion @4) (forall (v :: Natural).
(KnownNat v, 0 <= v, v <= MaxVersion) =>
Version
natVersion @11)
      String -> Property -> Spec
forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"Completely empty MultiAsset fails for Dijkstra" (Property -> Spec) -> Property -> Spec
forall a b. (a -> b) -> a -> b
$
        Gen MultiAsset -> (MultiAsset -> IO ()) -> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
forAll Gen MultiAsset
genMultiAssetCompletelyEmpty ((MultiAsset -> IO ()) -> Property)
-> (MultiAsset -> IO ()) -> Property
forall a b. (a -> b) -> a -> b
$
          Version -> Version -> MultiAsset -> IO ()
forall t.
(EncCBOR t, DecCBOR t, Eq t, HasCallStack) =>
Version -> Version -> t -> IO ()
roundTripCborRangeFailureExpectation (forall (v :: Natural).
(KnownNat v, 0 <= v, v <= MaxVersion) =>
Version
natVersion @12) Version
forall a. Bounded a => a
maxBound
    String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"MaryValue" (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
      String -> (MaryValue -> IO ()) -> Spec
forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"Positive MaryValue succeeds for all eras" ((MaryValue -> IO ()) -> Spec) -> (MaryValue -> IO ()) -> Spec
forall a b. (a -> b) -> a -> b
$ \(MaryValue
mv :: MaryValue) ->
        MaryValue -> IO ()
forall t.
(Show t, Eq t, EncCBOR t, DecCBOR t, HasCallStack) =>
t -> IO ()
roundTripCborExpectation MaryValue
mv
      String -> Property -> Spec
forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"Negative MaryValue fails for all eras" (Property -> Spec) -> Property -> Spec
forall a b. (a -> b) -> a -> b
$
        Gen MaryValue -> (MaryValue -> IO ()) -> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
forAll
          (Gen MultiAsset -> Gen MaryValue
genMaryValue (Gen Integer -> Gen MultiAsset
genMultiAsset (Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int -> Integer) -> Gen Int -> Gen Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Int
genNegativeInt)))
          MaryValue -> IO ()
forall t. (EncCBOR t, DecCBOR t, Eq t, HasCallStack) => t -> IO ()
roundTripCborFailureExpectation
      String -> Property -> Spec
forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"Zero MaryValue fails Conway onwards" (Property -> Spec) -> Property -> Spec
forall a b. (a -> b) -> a -> b
$
        Gen MaryValue -> (MaryValue -> IO ()) -> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
forAll (Gen MultiAsset -> Gen MaryValue
genMaryValue Gen MultiAsset
genMultiAssetZero) ((MaryValue -> IO ()) -> Property)
-> (MaryValue -> IO ()) -> Property
forall a b. (a -> b) -> a -> b
$
          Version -> Version -> MaryValue -> IO ()
forall t.
(EncCBOR t, DecCBOR t, Eq t, HasCallStack) =>
Version -> Version -> t -> IO ()
roundTripCborRangeFailureExpectation (forall (v :: Natural).
(KnownNat v, 0 <= v, v <= MaxVersion) =>
Version
natVersion @9) Version
forall a. Bounded a => a
maxBound
      String -> Property -> Spec
forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"MaryValue with empty nested asset maps fails Conway onwards" (Property -> Spec) -> Property -> Spec
forall a b. (a -> b) -> a -> b
$
        Gen MaryValue -> (MaryValue -> IO ()) -> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
forAll (Gen MultiAsset -> Gen MaryValue
genMaryValue Gen MultiAsset
genMultiAssetNestedEmpty) ((MaryValue -> IO ()) -> Property)
-> (MaryValue -> IO ()) -> Property
forall a b. (a -> b) -> a -> b
$
          Version -> Version -> MaryValue -> IO ()
forall t.
(EncCBOR t, DecCBOR t, Eq t, HasCallStack) =>
Version -> Version -> t -> IO ()
roundTripCborRangeFailureExpectation (forall (v :: Natural).
(KnownNat v, 0 <= v, v <= MaxVersion) =>
Version
natVersion @9) Version
forall a. Bounded a => a
maxBound
      String -> Property -> Spec
forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"MaryValue with completely empty MultiAsset succeeds for Conway" (Property -> Spec) -> Property -> Spec
forall a b. (a -> b) -> a -> b
$
        Gen MaryValue -> (MaryValue -> IO ()) -> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
forAll (Gen MultiAsset -> Gen MaryValue
genMaryValue Gen MultiAsset
genMultiAssetCompletelyEmpty) ((MaryValue -> IO ()) -> Property)
-> (MaryValue -> IO ()) -> Property
forall a b. (a -> b) -> a -> b
$
          Version -> Version -> MaryValue -> IO ()
forall t.
(Show t, Eq t, EncCBOR t, DecCBOR t, HasCallStack) =>
Version -> Version -> t -> IO ()
roundTripCborRangeExpectation (forall (v :: Natural).
(KnownNat v, 0 <= v, v <= MaxVersion) =>
Version
natVersion @4) (forall (v :: Natural).
(KnownNat v, 0 <= v, v <= MaxVersion) =>
Version
natVersion @11)
      String -> (Positive Int -> IO ()) -> Spec
forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"MaryValue with completely empty MultiAsset fails for Dijkstra" ((Positive Int -> IO ()) -> Spec)
-> (Positive Int -> IO ()) -> Spec
forall a b. (a -> b) -> a -> b
$ \(Positive Int
c) ->
        [Version] -> (Version -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [forall (v :: Natural).
(KnownNat v, 0 <= v, v <= MaxVersion) =>
Version
natVersion @12 .. Version
forall a. Bounded a => a
maxBound] ((Version -> IO ()) -> IO ()) -> (Version -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Version
version -> do
          let serialized :: BSL.ByteString
              serialized :: ByteString
serialized = forall a. EncCBOR a => Version -> a -> ByteString
serialize @(Int, Map.Map () ()) Version
version (Int
c, Map () ()
forall k a. Map k a
Map.empty)
          case Version -> ByteString -> Either DecoderError MaryValue
forall a.
DecCBOR a =>
Version -> ByteString -> Either DecoderError a
decodeFull Version
version ByteString
serialized :: Either DecoderError MaryValue of
            Left DecoderError
_ -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
            Right (MaryValue
m :: MaryValue) ->
              HasCallStack => String -> IO ()
String -> IO ()
expectationFailure (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$
                [String] -> String
forall a. Monoid a => [a] -> a
mconcat
                  [ String
"Should not have deserialized: <version: "
                  , Version -> String
forall a. Show a => a -> String
show Version
version
                  , String
"> "
                  , MaryValue -> String
forall a. Show a => a -> String
show MaryValue
m
                  ]
      -- Test pre-Conway behavior (should allow everything)
      String -> Property -> Spec
forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"All MultiAsset types succeed for pre-Conway eras" (Property -> Spec) -> Property -> Spec
forall a b. (a -> b) -> a -> b
$
        Gen MultiAsset -> (MultiAsset -> IO ()) -> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
forAll ([Gen MultiAsset] -> Gen MultiAsset
forall a. HasCallStack => [Gen a] -> Gen a
oneof [Gen MultiAsset
genMultiAssetCompletelyEmpty, Gen MultiAsset
genMultiAssetZero, Gen MultiAsset
genMultiAssetNestedEmpty]) ((MultiAsset -> IO ()) -> Property)
-> (MultiAsset -> IO ()) -> Property
forall a b. (a -> b) -> a -> b
$ \MultiAsset
ma -> do
          [Version] -> (Version -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [forall (v :: Natural).
(KnownNat v, 0 <= v, v <= MaxVersion) =>
Version
natVersion @4 .. forall (v :: Natural).
(KnownNat v, 0 <= v, v <= MaxVersion) =>
Version
natVersion @8] ((Version -> IO ()) -> IO ()) -> (Version -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Version
version -> do
            let serialized :: BSL.ByteString
                serialized :: ByteString
serialized = forall a. EncCBOR a => Version -> a -> ByteString
serialize @MultiAsset Version
version MultiAsset
ma
            case Version -> ByteString -> Either DecoderError MultiAsset
forall a.
DecCBOR a =>
Version -> ByteString -> Either DecoderError a
decodeFull Version
version ByteString
serialized :: Either DecoderError MultiAsset of
              Right MultiAsset
_ -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
              Left DecoderError
_ ->
                HasCallStack => String -> IO ()
String -> IO ()
expectationFailure (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$
                  [String] -> String
forall a. Monoid a => [a] -> a
mconcat
                    [ String
"Should have deserialized successfully: <version: "
                    , Version -> String
forall a. Show a => a -> String
show Version
version
                    , String
"> "
                    , MultiAsset -> String
forall a. Show a => a -> String
show MultiAsset
ma
                    ]
      String -> Property -> SpecWith (Arg Property)
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Too many assets should fail" (Property -> SpecWith (Arg Property))
-> Property -> SpecWith (Arg Property)
forall a b. (a -> b) -> a -> b
$
        Property -> Property
forall prop. Testable prop => prop -> Property
property (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$
          Gen MaryValue -> (MaryValue -> IO ()) -> Property
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)
                Version
forall a. Bounded a => a
maxBound
            )
  String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"MaryValue compacting" (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
    String -> (MaryValue -> IO ()) -> Spec
forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"Canonical generator" ((MaryValue -> IO ()) -> Spec) -> (MaryValue -> IO ()) -> Spec
forall a b. (a -> b) -> a -> b
$
      \(MaryValue
ma :: MaryValue) ->
        CompactForm MaryValue -> MaryValue
forall a. Compactible a => CompactForm a -> a
fromCompact (Maybe (CompactForm MaryValue) -> CompactForm MaryValue
forall a. HasCallStack => Maybe a -> a
fromJust (MaryValue -> Maybe (CompactForm MaryValue)
forall a. Compactible a => a -> Maybe (CompactForm a)
toCompact MaryValue
ma)) MaryValue -> MaryValue -> IO ()
forall a. (HasCallStack, Show a, Eq a) => a -> a -> IO ()
`shouldBe` MaryValue
ma
    String -> Property -> Spec
forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"Failing generator" (Property -> Spec) -> Property -> Spec
forall a b. (a -> b) -> a -> b
$
      Gen MaryValue -> (MaryValue -> IO ()) -> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
forAll (Gen MultiAsset -> Gen MaryValue
genMaryValue (Bool -> Gen MultiAsset
genMultiAssetToFail Bool
True)) ((MaryValue -> IO ()) -> Property)
-> (MaryValue -> IO ()) -> Property
forall a b. (a -> b) -> a -> b
$
        \MaryValue
ma ->
          MaryValue -> IO MaryValue
forall a. a -> IO a
evaluate (CompactForm MaryValue -> MaryValue
forall a. Compactible a => CompactForm a -> a
fromCompact (Maybe (CompactForm MaryValue) -> CompactForm MaryValue
forall a. HasCallStack => Maybe a -> a
fromJust (MaryValue -> Maybe (CompactForm MaryValue)
forall a. Compactible a => a -> Maybe (CompactForm a)
toCompact MaryValue
ma)))
            IO MaryValue -> Selector AssertionFailed -> IO ()
forall e a.
(HasCallStack, Exception e) =>
IO a -> Selector e -> IO ()
`shouldThrow` (\(AssertionFailed String
errorMsg) -> Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
16 String
errorMsg String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"Assertion failed")

instance IsString AssetName where
  fromString :: String -> AssetName
fromString = ShortByteString -> AssetName
AssetName (ShortByteString -> AssetName)
-> (String -> ShortByteString) -> String -> AssetName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> ShortByteString)
-> (ByteString -> ShortByteString)
-> Either String ByteString
-> ShortByteString
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> ShortByteString
forall a. HasCallStack => String -> a
error ByteString -> ShortByteString
SBS.toShort (Either String ByteString -> ShortByteString)
-> (String -> Either String ByteString)
-> String
-> ShortByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either String ByteString
BS16.decode (ByteString -> Either String ByteString)
-> (String -> ByteString) -> String -> Either String ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> 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 = IO () -> Property
forall prop. Testable prop => prop -> Property
property (IO () -> Property) -> IO () -> 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
  Map PolicyID (Map AssetName Integer) -> IO ()
forall k a.
(HasCallStack, Ord k, Show k, Show a) =>
Map k a -> IO ()
expectValidMap Map PolicyID (Map AssetName Integer)
a1
  Map PolicyID (Map AssetName Integer) -> IO ()
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) =
        [MultiAsset] -> MultiAsset
forall a. Monoid a => [a] -> a
mconcat
          [ Map PolicyID (Map AssetName Integer) -> MultiAsset
MultiAsset (Map PolicyID (Map AssetName Integer) -> MultiAsset)
-> Map PolicyID (Map AssetName Integer) -> MultiAsset
forall a b. (a -> b) -> a -> b
$
              (Map AssetName Integer
 -> Map AssetName Integer -> Map AssetName Integer)
-> PolicyID
-> Map AssetName Integer
-> Map PolicyID (Map AssetName Integer)
-> Map PolicyID (Map AssetName Integer)
forall k a.
(Ord k, CanonicalZero a) =>
(a -> a -> a) -> k -> a -> Map k a -> Map k a
canonicalInsert Map AssetName Integer
-> Map AssetName Integer -> Map AssetName Integer
forall a b. a -> b -> a
const PolicyID
pid ((Integer -> Integer -> Integer)
-> AssetName
-> Integer
-> Map AssetName Integer
-> Map AssetName Integer
forall k a.
(Ord k, CanonicalZero a) =>
(a -> a -> a) -> k -> a -> Map k a -> Map k a
canonicalInsert Integer -> Integer -> Integer
forall a b. a -> b -> a
const AssetName
an Integer
i Map AssetName Integer
forall a. Monoid a => a
mempty) Map PolicyID (Map AssetName Integer)
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) =
        [MultiAsset] -> MultiAsset
forall a. Monoid a => [a] -> a
mconcat
          [ Map PolicyID (Map AssetName Integer) -> MultiAsset
MultiAsset (Map PolicyID (Map AssetName Integer) -> MultiAsset)
-> Map PolicyID (Map AssetName Integer) -> MultiAsset
forall a b. (a -> b) -> a -> b
$
              (Map AssetName Integer
 -> Map AssetName Integer -> Map AssetName Integer)
-> PolicyID
-> Map AssetName Integer
-> Map PolicyID (Map AssetName Integer)
-> Map PolicyID (Map AssetName Integer)
forall k a.
(Ord k, CanonicalZero a) =>
(a -> a -> a) -> k -> a -> Map k a -> Map k a
canonicalInsert Map AssetName Integer
-> Map AssetName Integer -> Map AssetName Integer
forall a b. a -> b -> a
const PolicyID
pid ((Integer -> Integer -> Integer)
-> AssetName
-> Integer
-> Map AssetName Integer
-> Map AssetName Integer
forall k a.
(Ord k, CanonicalZero a) =>
(a -> a -> a) -> k -> a -> Map k a -> Map k a
canonicalInsert Integer -> Integer -> Integer
forall a b. a -> b -> a
const AssetName
an Integer
i Map AssetName Integer
forall a. Monoid a => a
mempty) Map PolicyID (Map AssetName Integer)
forall a. Monoid a => a
mempty
          | (PolicyID
pid, AssetName
an, Integer
i) <- [(PolicyID, AssetName, Integer)]
ys
          ]
  Map PolicyID (Map AssetName Integer) -> IO ()
forall k a.
(HasCallStack, Ord k, Show k, Show a) =>
Map k a -> IO ()
expectValidMap Map PolicyID (Map AssetName Integer)
b1
  Map PolicyID (Map AssetName Integer) -> IO ()
forall k a.
(HasCallStack, Ord k, Show k, Show a) =>
Map k a -> IO ()
expectValidMap Map PolicyID (Map AssetName Integer)
b2
  MultiAsset
ma1 MultiAsset -> MultiAsset -> IO ()
forall a. (HasCallStack, Show a, Eq a) => a -> a -> IO ()
`shouldBe` MultiAsset
mb1
  MultiAsset
ma2 MultiAsset -> MultiAsset -> IO ()
forall a. (HasCallStack, Show a, Eq a) => a -> a -> IO ()
`shouldBe` MultiAsset
mb2
  MultiAsset
ma1 MultiAsset -> MultiAsset -> MultiAsset
forall a. Semigroup a => a -> a -> a
<> MultiAsset
ma2 MultiAsset -> MultiAsset -> IO ()
forall a. (HasCallStack, Show a, Eq a) => a -> a -> IO ()
`shouldBe` MultiAsset
mb1 MultiAsset -> MultiAsset -> MultiAsset
forall a. Semigroup a => a -> a -> a
<> MultiAsset
mb2
  MultiAsset
ma1 MultiAsset -> MultiAsset -> MultiAsset
forall a. Semigroup a => a -> a -> a
<> MultiAsset
mb2 MultiAsset -> MultiAsset -> IO ()
forall a. (HasCallStack, Show a, Eq a) => a -> a -> IO ()
`shouldBe` MultiAsset
mb1 MultiAsset -> MultiAsset -> MultiAsset
forall a. Semigroup a => a -> a -> a
<> MultiAsset
ma2