{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE NoMonoLocalBinds #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

module Test.Cardano.Ledger.Mary.Value (valTests) where

import Cardano.Crypto.Hash.Class (castHash, hashFromStringAsHex)
import Cardano.Ledger.Coin (Coin (..))
import Cardano.Ledger.Compactible (fromCompact, toCompact)
import Cardano.Ledger.Hashes (ScriptHash (..))
import Cardano.Ledger.Mary.Value (
  AssetName (..),
  MaryValue (..),
  MultiAsset (..),
  PolicyID (..),
  insertMultiAsset,
  lookupMultiAsset,
 )
import Cardano.Ledger.Val (Val (..), inject, invert)
import Control.DeepSeq (rnf)
import Control.Monad (replicateM)
import Data.ByteString.Short (ShortByteString)
import Data.CanonicalMaps (
  CanonicalZero (..),
  canonicalInsert,
  canonicalMapUnion,
 )
import qualified Data.Group as G
import Data.Map.Strict (empty, singleton)
import qualified Data.Map.Strict as Map
import Data.Maybe (fromMaybe)
import Test.Cardano.Ledger.Mary.Arbitrary ()
import Test.Cardano.Ledger.Shelley.Serialisation.EraIndepGenerators ()
import Test.Cardano.Ledger.Shelley.Serialisation.Generators ()
import qualified Test.QuickCheck as QC
import Test.Tasty
import Test.Tasty.QuickCheck hiding (scale)
import Prelude hiding (lookup)

-- =================================================================================
-- Alternate implementations of insert to be benchmarked.
-- Also used in testing below. to show that the executable spec: insert is correct.
-- We compute Values 3 ways and show all are equivalent.
-- =================================================================================

-- Use canonicalUnion and canonicalInsert

pickNew, pickOld :: a -> a -> a
pickNew :: forall a. a -> a -> a
pickNew a
_o a
n = a
n
pickOld :: forall a. a -> a -> a
pickOld a
o a
_n = a
o

insertValue ::
  (Integer -> Integer -> Integer) ->
  PolicyID ->
  AssetName ->
  Integer ->
  MaryValue ->
  MaryValue
insertValue :: (Integer -> Integer -> Integer)
-> PolicyID -> AssetName -> Integer -> MaryValue -> MaryValue
insertValue Integer -> Integer -> Integer
combine PolicyID
pid AssetName
aid Integer
new (MaryValue Coin
c MultiAsset
m) = Coin -> MultiAsset -> MaryValue
MaryValue Coin
c forall a b. (a -> b) -> a -> b
$ (Integer -> Integer -> Integer)
-> PolicyID -> AssetName -> Integer -> MultiAsset -> MultiAsset
insertMultiAsset Integer -> Integer -> Integer
combine PolicyID
pid AssetName
aid Integer
new MultiAsset
m

insert3 ::
  (Integer -> Integer -> Integer) ->
  PolicyID ->
  AssetName ->
  Integer ->
  MaryValue ->
  MaryValue
insert3 :: (Integer -> Integer -> Integer)
-> PolicyID -> AssetName -> Integer -> MaryValue -> MaryValue
insert3 Integer -> Integer -> Integer
combine PolicyID
pid AssetName
aid Integer
new (MaryValue Coin
c (MultiAsset Map PolicyID (Map AssetName Integer)
m1)) =
  case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup PolicyID
pid Map PolicyID (Map AssetName Integer)
m1 of
    Maybe (Map AssetName Integer)
Nothing ->
      Coin -> MultiAsset -> MaryValue
MaryValue Coin
c forall a b. (a -> b) -> a -> b
$
        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 k a.
(Ord k, CanonicalZero a) =>
(a -> a -> a) -> Map k a -> Map k a -> Map k a
canonicalMapUnion Integer -> Integer -> Integer
combine) PolicyID
pid (forall k a.
(Ord k, CanonicalZero a) =>
(a -> a -> a) -> k -> a -> Map k a -> Map k a
canonicalInsert Integer -> Integer -> Integer
combine AssetName
aid Integer
new forall t. CanonicalZero t => t
zeroC) Map PolicyID (Map AssetName Integer)
m1
    Just Map AssetName Integer
m2 -> case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup AssetName
aid Map AssetName Integer
m2 of
      Maybe Integer
Nothing ->
        Coin -> MultiAsset -> MaryValue
MaryValue Coin
c forall a b. (a -> b) -> a -> b
$
          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 k a.
(Ord k, CanonicalZero a) =>
(a -> a -> a) -> Map k a -> Map k a -> Map k a
canonicalMapUnion Integer -> Integer -> Integer
combine) PolicyID
pid (forall k a. k -> a -> Map k a
singleton AssetName
aid Integer
new) Map PolicyID (Map AssetName Integer)
m1
      Just Integer
old ->
        Coin -> MultiAsset -> MaryValue
MaryValue Coin
c forall a b. (a -> b) -> a -> b
$
          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. a -> a -> a
pickNew PolicyID
pid (forall k a.
(Ord k, CanonicalZero a) =>
(a -> a -> a) -> k -> a -> Map k a -> Map k a
canonicalInsert forall a. a -> a -> a
pickNew AssetName
aid (Integer -> Integer -> Integer
combine Integer
old Integer
new) Map AssetName Integer
m2) Map PolicyID (Map AssetName Integer)
m1

-- | Make a Value with no coin, and just one token.
unit :: PolicyID -> AssetName -> Integer -> MaryValue
unit :: PolicyID -> AssetName -> Integer -> MaryValue
unit PolicyID
pid AssetName
aid Integer
n =
  Coin -> MultiAsset -> MaryValue
MaryValue forall a. Monoid a => a
mempty forall a b. (a -> b) -> a -> b
$
    Map PolicyID (Map AssetName Integer) -> MultiAsset
MultiAsset (forall k a.
(Ord k, CanonicalZero a) =>
(a -> a -> a) -> k -> a -> Map k a -> Map k a
canonicalInsert forall a. a -> a -> a
pickNew PolicyID
pid (forall k a.
(Ord k, CanonicalZero a) =>
(a -> a -> a) -> k -> a -> Map k a -> Map k a
canonicalInsert forall a. a -> a -> a
pickNew AssetName
aid Integer
n forall k a. Map k a
empty) forall k a. Map k a
empty)

-- Use <+> and <->

insert2 ::
  (Integer -> Integer -> Integer) ->
  PolicyID ->
  AssetName ->
  Integer ->
  MaryValue ->
  MaryValue
insert2 :: (Integer -> Integer -> Integer)
-> PolicyID -> AssetName -> Integer -> MaryValue -> MaryValue
insert2 Integer -> Integer -> Integer
combine PolicyID
pid AssetName
aid Integer
new MaryValue
m1 =
  -- The trick is to correctly not store a zero. Several ways to get a zero
  case (PolicyID -> AssetName -> MaryValue -> Integer
lookupMultiAsset PolicyID
pid AssetName
aid MaryValue
m1, Integer
new forall a. Eq a => a -> a -> Bool
== Integer
0) of
    -- input is zero, and its not in the map
    (Integer
0, Bool
True) -> MaryValue
m1
    -- input is not zero, its not in the map, so add it to the map
    (Integer
0, Bool
False) -> MaryValue
m1 forall t. Val t => t -> t -> t
<+> PolicyID -> AssetName -> Integer -> MaryValue
unit PolicyID
pid AssetName
aid Integer
new
    (Integer
old, Bool
_) ->
      let n :: Integer
n = Integer -> Integer -> Integer
combine Integer
old Integer
new -- it is in the map, use combine to get the correct value
       in MaryValue
m1 forall t. Val t => t -> t -> t
<+> PolicyID -> AssetName -> Integer -> MaryValue
unit PolicyID
pid AssetName
aid (Integer
n forall a. Num a => a -> a -> a
- Integer
old) -- make the correction
      -- equivalent to: (m1 <->  unit pid aid old) <+> unit pid aid n

-- 3 functions that build Values from Policy Asset triples.

valueFromList ::
  [(PolicyID, AssetName, Integer)] -> Integer -> MaryValue
valueFromList :: [(PolicyID, AssetName, Integer)] -> Integer -> MaryValue
valueFromList [(PolicyID, AssetName, Integer)]
list Integer
c = Coin -> MultiAsset -> MaryValue
MaryValue (Integer -> Coin
Coin Integer
c) forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (PolicyID, AssetName, Integer) -> MultiAsset -> MultiAsset
acc forall a. Monoid a => a
mempty [(PolicyID, AssetName, Integer)]
list
  where
    acc :: (PolicyID, AssetName, Integer) -> MultiAsset -> MultiAsset
acc (PolicyID
policy, AssetName
asset, Integer
count) MultiAsset
m = (Integer -> Integer -> Integer)
-> PolicyID -> AssetName -> Integer -> MultiAsset -> MultiAsset
insertMultiAsset forall a. Num a => a -> a -> a
(+) PolicyID
policy AssetName
asset Integer
count MultiAsset
m

valueFromList3 ::
  [(PolicyID, AssetName, Integer)] -> Integer -> MaryValue
valueFromList3 :: [(PolicyID, AssetName, Integer)] -> Integer -> MaryValue
valueFromList3 [(PolicyID, AssetName, Integer)]
list Integer
c = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (PolicyID, AssetName, Integer) -> MaryValue -> MaryValue
acc (Coin -> MultiAsset -> MaryValue
MaryValue (Integer -> Coin
Coin Integer
c) forall a. Monoid a => a
mempty) [(PolicyID, AssetName, Integer)]
list
  where
    acc :: (PolicyID, AssetName, Integer) -> MaryValue -> MaryValue
acc (PolicyID
policy, AssetName
asset, Integer
count) MaryValue
m = (Integer -> Integer -> Integer)
-> PolicyID -> AssetName -> Integer -> MaryValue -> MaryValue
insert3 forall a. Num a => a -> a -> a
(+) PolicyID
policy AssetName
asset Integer
count MaryValue
m

valueFromList2 ::
  [(PolicyID, AssetName, Integer)] -> Integer -> MaryValue
valueFromList2 :: [(PolicyID, AssetName, Integer)] -> Integer -> MaryValue
valueFromList2 [(PolicyID, AssetName, Integer)]
list Integer
c = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (PolicyID, AssetName, Integer) -> MaryValue -> MaryValue
acc (Coin -> MultiAsset -> MaryValue
MaryValue (Integer -> Coin
Coin Integer
c) forall a. Monoid a => a
mempty) [(PolicyID, AssetName, Integer)]
list
  where
    acc :: (PolicyID, AssetName, Integer) -> MaryValue -> MaryValue
acc (PolicyID
policy, AssetName
asset, Integer
count) MaryValue
m = (Integer -> Integer -> Integer)
-> PolicyID -> AssetName -> Integer -> MaryValue -> MaryValue
insert2 forall a. Num a => a -> a -> a
(+) PolicyID
policy AssetName
asset Integer
count MaryValue
m

-- Test that all tree functions build the same values.

insertTests :: TestTree
insertTests :: TestTree
insertTests =
  String -> [TestTree] -> TestTree
testGroup
    String
"insert == insert2 == insert3"
    [ forall a. Testable a => String -> a -> TestTree
testProperty String
"insert=insert2" forall a b. (a -> b) -> a -> b
$ \[(PolicyID, AssetName, Integer)]
vs Integer
c -> [(PolicyID, AssetName, Integer)] -> Integer -> MaryValue
valueFromList [(PolicyID, AssetName, Integer)]
vs Integer
c forall a. (Eq a, Show a) => a -> a -> Property
=== [(PolicyID, AssetName, Integer)] -> Integer -> MaryValue
valueFromList2 [(PolicyID, AssetName, Integer)]
vs Integer
c
    , forall a. Testable a => String -> a -> TestTree
testProperty String
"insert=insert3" forall a b. (a -> b) -> a -> b
$ \[(PolicyID, AssetName, Integer)]
vs Integer
c -> [(PolicyID, AssetName, Integer)] -> Integer -> MaryValue
valueFromList [(PolicyID, AssetName, Integer)]
vs Integer
c forall a. (Eq a, Show a) => a -> a -> Property
=== [(PolicyID, AssetName, Integer)] -> Integer -> MaryValue
valueFromList3 [(PolicyID, AssetName, Integer)]
vs Integer
c
    , forall a. Testable a => String -> a -> TestTree
testProperty String
"insert2=insert3" forall a b. (a -> b) -> a -> b
$ \[(PolicyID, AssetName, Integer)]
vs Integer
c -> [(PolicyID, AssetName, Integer)] -> Integer -> MaryValue
valueFromList2 [(PolicyID, AssetName, Integer)]
vs Integer
c forall a. (Eq a, Show a) => a -> a -> Property
=== [(PolicyID, AssetName, Integer)] -> Integer -> MaryValue
valueFromList3 [(PolicyID, AssetName, Integer)]
vs Integer
c
    ]

-- ============================================================================================
-- Arbitray instances

genB :: Gen ShortByteString
genB :: Gen ShortByteString
genB = forall a. HasCallStack => Int -> Gen a -> Gen a
resize Int
4 forall a. Arbitrary a => Gen a
arbitrary

genAssetName :: Gen AssetName
genAssetName :: Gen AssetName
genAssetName = ShortByteString -> AssetName
AssetName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen ShortByteString
genB

genPolicyID :: Gen PolicyID
genPolicyID :: Gen PolicyID
genPolicyID = ScriptHash -> PolicyID
PolicyID forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary

-- ===========================================================================
-- Tests that Val instances really align with the Albelian Group Supertype

albelianlist :: forall v. Val v => [(v -> v -> Property, String)]
albelianlist :: forall v. Val v => [(v -> v -> Property, String)]
albelianlist =
  [ (\v
x v
y -> v
x forall t. Val t => t -> t -> t
<+> v
y forall a. (Eq a, Show a) => a -> a -> Property
=== v
x forall a. Semigroup a => a -> a -> a
<> v
y, String
"<+> is <>")
  , (\v
_ v
_ -> (forall t. Val t => t
zero @v) forall a. (Eq a, Show a) => a -> a -> Property
=== forall a. Monoid a => a
mempty, String
"zero is mempty")
  , (\v
_ v
_ -> forall t. Val t => t -> Bool
isZero (forall t. Val t => t
zero @v) forall a. (Eq a, Show a) => a -> a -> Property
=== Bool
True, String
"isZero zero")
  , (\v
_ v
_ -> forall t. Val t => t -> Bool
isZero (forall a. Monoid a => a
mempty @v) forall a. (Eq a, Show a) => a -> a -> Property
=== Bool
True, String
"isZero mempty")
  , (\v
x v
_ -> forall t. Val t => t -> Bool
isZero v
x forall a. (Eq a, Show a) => a -> a -> Property
=== (v
x forall a. Eq a => a -> a -> Bool
== forall a. Monoid a => a
mempty), String
"isZero is (== mempty)")
  ]

albelianTests :: TestTree
albelianTests :: TestTree
albelianTests =
  String -> [TestTree] -> TestTree
testGroup
    String
"albelian test"
    [ String -> [TestTree] -> TestTree
testGroup String
"albelian Coin" forall a b. (a -> b) -> a -> b
$
        forall a b. (a -> b) -> [a] -> [b]
map (\(Coin -> Coin -> Property
prop, String
name) -> forall a. Testable a => String -> a -> TestTree
testProperty String
name Coin -> Coin -> Property
prop) (forall v. Val v => [(v -> v -> Property, String)]
albelianlist @Coin)
    , String -> [TestTree] -> TestTree
testGroup String
"albelian Value" forall a b. (a -> b) -> a -> b
$
        forall a b. (a -> b) -> [a] -> [b]
map (\(MaryValue -> MaryValue -> Property
prop, String
name) -> forall a. Testable a => String -> a -> TestTree
testProperty String
name MaryValue -> MaryValue -> Property
prop) (forall v. Val v => [(v -> v -> Property, String)]
albelianlist @MaryValue)
    ]

-- ===================================================================
-- Generic tests that should hold for all Val instances.
-- We will instantiate these twice. Once with Coin, once with Value.

proplist :: forall v. Val v => [(Integer -> Integer -> v -> v -> v -> Bool, String)]
proplist :: forall v.
Val v =>
[(Integer -> Integer -> v -> v -> v -> Bool, String)]
proplist =
  -- (\ r s x y z -> prop , name)
  [ (\Integer
_ Integer
_ v
x v
y v
_ -> v
x forall t. Val t => t -> t -> t
<-> v
y forall a. Eq a => a -> a -> Bool
== v
x forall t. Val t => t -> t -> t
<+> forall t. Val t => t -> t
invert v
y, String
"defMinus")
  , (\Integer
_ Integer
_ v
x v
_ v
_ -> forall t. Val t => t -> t
invert v
x forall a. Eq a => a -> a -> Bool
== (-Integer
1 :: Integer) forall t i. (Val t, Integral i) => i -> t -> t
<×> v
x, String
"defInvert")
  , (\Integer
_ Integer
_ v
x v
y v
_ -> v
x forall t. Val t => t -> t -> t
<+> v
y forall a. Eq a => a -> a -> Bool
== v
y forall t. Val t => t -> t -> t
<+> v
x, String
"commute")
  , (\Integer
_ Integer
_ v
x v
y v
z -> v
x forall t. Val t => t -> t -> t
<+> (v
y forall t. Val t => t -> t -> t
<+> v
z) forall a. Eq a => a -> a -> Bool
== (v
y forall t. Val t => t -> t -> t
<+> v
x) forall t. Val t => t -> t -> t
<+> v
z, String
"assoc")
  , (\Integer
_ Integer
_ v
x v
_ v
_ -> (forall t. Val t => t
zero forall t. Val t => t -> t -> t
<+> v
x forall a. Eq a => a -> a -> Bool
== v
x forall t. Val t => t -> t -> t
<+> forall t. Val t => t
zero) Bool -> Bool -> Bool
&& (forall t. Val t => t
zero forall t. Val t => t -> t -> t
<+> v
x forall a. Eq a => a -> a -> Bool
== v
x), String
"addIdent")
  , (\Integer
_ Integer
_ v
_ v
_ v
_ -> (forall t. Val t => t
zero @v forall t. Val t => t -> t -> t
<+> forall t. Val t => t
zero) forall a. Eq a => a -> a -> Bool
== forall t. Val t => t
zero, String
"zero-zero")
  , (\Integer
_ Integer
_ v
x v
_ v
_ -> v
x forall t. Val t => t -> t -> t
<-> v
x forall a. Eq a => a -> a -> Bool
== forall t. Val t => t
zero, String
"cancel")
  , (\Integer
r Integer
_ v
x v
y v
_ -> Integer
r forall t i. (Val t, Integral i) => i -> t -> t
<×> (v
x forall t. Val t => t -> t -> t
<+> v
y) forall a. Eq a => a -> a -> Bool
== (Integer
r forall t i. (Val t, Integral i) => i -> t -> t
<×> v
x) forall t. Val t => t -> t -> t
<+> (Integer
r forall t i. (Val t, Integral i) => i -> t -> t
<×> v
y), String
"distr1")
  , (\Integer
r Integer
s v
x v
_ v
_ -> (Integer
r forall a. Num a => a -> a -> a
+ Integer
s) forall t i. (Val t, Integral i) => i -> t -> t
<×> v
x forall a. Eq a => a -> a -> Bool
== (Integer
r forall t i. (Val t, Integral i) => i -> t -> t
<×> v
x) forall t. Val t => t -> t -> t
<+> (Integer
s forall t i. (Val t, Integral i) => i -> t -> t
<×> v
x), String
"dist2")
  , (\Integer
r Integer
s v
x v
_ v
_ -> (Integer
r forall a. Num a => a -> a -> a
* Integer
s) forall t i. (Val t, Integral i) => i -> t -> t
<×> v
x forall a. Eq a => a -> a -> Bool
== Integer
r forall t i. (Val t, Integral i) => i -> t -> t
<×> (Integer
s forall t i. (Val t, Integral i) => i -> t -> t
<×> v
x), String
"distr3")
  , (\Integer
_ Integer
_ v
x v
_ v
_ -> (Integer
1 :: Integer) forall t i. (Val t, Integral i) => i -> t -> t
<×> v
x forall a. Eq a => a -> a -> Bool
== v
x, String
"scaleIdenity")
  , (\Integer
_ Integer
_ v
x v
_ v
_ -> (v
x forall t. Val t => t -> t -> t
<-> v
x) forall a. Eq a => a -> a -> Bool
== forall t. Val t => t
zero, String
"minusCancel")
  , (\Integer
_ Integer
_ v
x v
y v
_ -> ((v
x forall t. Val t => t -> t -> t
<+> v
y) forall t. Val t => t -> t -> t
<-> v
y forall a. Eq a => a -> a -> Bool
== v
x forall t. Val t => t -> t -> t
<+> (v
y forall t. Val t => t -> t -> t
<-> v
y)) Bool -> Bool -> Bool
&& (v
x forall t. Val t => t -> t -> t
<+> (v
y forall t. Val t => t -> t -> t
<-> v
y) forall a. Eq a => a -> a -> Bool
== v
x), String
"plusMinusAssoc")
  , (\Integer
_ Integer
_ v
x v
_ v
_ -> (v
x forall t. Val t => t -> t -> t
<+> forall t. Val t => t -> t
invert v
x forall a. Eq a => a -> a -> Bool
== (v
x forall t. Val t => t -> t -> t
<-> v
x)) Bool -> Bool -> Bool
&& (v
x forall t. Val t => t -> t -> t
<-> v
x forall a. Eq a => a -> a -> Bool
== forall t. Val t => t
zero), String
"plusInvertCancel")
  , (\Integer
_ Integer
_ v
x v
_ v
_ -> (v
x forall t. Val t => t -> t -> t
<-> forall t. Val t => t
zero) forall a. Eq a => a -> a -> Bool
== v
x, String
"minusZero")
  , (\Integer
_ Integer
_ v
x v
_ v
_ -> (forall t. Val t => t
zero forall t. Val t => t -> t -> t
<-> v
x) forall a. Eq a => a -> a -> Bool
== forall t. Val t => t -> t
invert v
x, String
"zeroMinus")
  , (\Integer
_ Integer
_ v
x v
_ v
_ -> forall t. Val t => t -> t
invert v
x forall a. Eq a => a -> a -> Bool
== (-Integer
1 :: Integer) forall t i. (Val t, Integral i) => i -> t -> t
<×> v
x, String
"invertScale")
  , (\Integer
_ Integer
_ v
x v
_ v
_ -> (Integer
0 :: Integer) forall t i. (Val t, Integral i) => i -> t -> t
<×> v
x forall a. Eq a => a -> a -> Bool
== forall t. Val t => t
zero, String
"scaleZero")
  , (\Integer
r Integer
_ v
_ v
_ v
_ -> Integer
r forall t i. (Val t, Integral i) => i -> t -> t
<×> forall t. Val t => t
zero @v forall a. Eq a => a -> a -> Bool
== forall t. Val t => t
zero @v, String
"zeroScale")
  , (\Integer
r Integer
s v
_ v
_ v
_ -> Integer
r forall t i. (Val t, Integral i) => i -> t -> t
<×> forall t s. Inject t s => t -> s
inject @_ @v (Integer -> Coin
Coin Integer
s) forall a. Eq a => a -> a -> Bool
== forall t s. Inject t s => t -> s
inject (Integer
r forall t i. (Val t, Integral i) => i -> t -> t
<×> Integer -> Coin
Coin Integer
s), String
"scaleInject")
  , (\Integer
_ Integer
_ v
x v
_ v
_ -> (Integer
1 :: Integer) forall t i. (Val t, Integral i) => i -> t -> t
<×> v
x forall a. Eq a => a -> a -> Bool
== v
x, String
"scaleOne")
  , (\Integer
r Integer
_ v
x v
y v
_ -> Integer
r forall t i. (Val t, Integral i) => i -> t -> t
<×> (v
x forall t. Val t => t -> t -> t
<+> v
y) forall a. Eq a => a -> a -> Bool
== (Integer
r forall t i. (Val t, Integral i) => i -> t -> t
<×> v
x) forall t. Val t => t -> t -> t
<+> (Integer
r forall t i. (Val t, Integral i) => i -> t -> t
<×> v
y), String
"scalePlus")
  , (\Integer
r Integer
s v
x v
_ v
_ -> Integer
r forall t i. (Val t, Integral i) => i -> t -> t
<×> (Integer
s forall t i. (Val t, Integral i) => i -> t -> t
<×> v
x) forall a. Eq a => a -> a -> Bool
== (Integer
r forall a. Num a => a -> a -> a
* Integer
s) forall t i. (Val t, Integral i) => i -> t -> t
<×> v
x, String
"scaleScale")
  , (\Integer
r Integer
_ v
x v
_ v
_ -> Integer
r forall t i. (Val t, Integral i) => i -> t -> t
<×> forall t. Val t => t -> Coin
coin v
x forall a. Eq a => a -> a -> Bool
== forall t. Val t => t -> Coin
coin (Integer
r forall t i. (Val t, Integral i) => i -> t -> t
<×> v
x), String
"scaleCoin")
  , (\Integer
_ Integer
_ v
x v
_ v
_ -> (Integer
3 :: Integer) forall t i. (Val t, Integral i) => i -> t -> t
<×> v
x forall a. Eq a => a -> a -> Bool
== v
x forall t. Val t => t -> t -> t
<+> v
x forall t. Val t => t -> t -> t
<+> v
x, String
"unfoldScale")
  , (\Integer
_ Integer
_ v
_ v
_ v
_ -> forall t. Val t => t -> Coin
coin (forall t. Val t => t
zero @v) forall a. Eq a => a -> a -> Bool
== forall t. Val t => t
zero, String
"coinZero")
  , (\Integer
_ Integer
_ v
x v
y v
_ -> forall t. Val t => t -> Coin
coin (v
x forall t. Val t => t -> t -> t
<+> v
y) forall a. Eq a => a -> a -> Bool
== forall t. Val t => t -> Coin
coin v
x forall t. Val t => t -> t -> t
<+> forall t. Val t => t -> Coin
coin v
y, String
"coinPlus")
  , (\Integer
r Integer
_ v
x v
_ v
_ -> forall t. Val t => t -> Coin
coin (Integer
r forall t i. (Val t, Integral i) => i -> t -> t
<×> v
x) forall a. Eq a => a -> a -> Bool
== Integer
r forall t i. (Val t, Integral i) => i -> t -> t
<×> forall t. Val t => t -> Coin
coin v
x, String
"coinScale")
  , (\Integer
r Integer
_ v
_ v
_ v
_ -> forall t. Val t => t -> Coin
coin @v (forall t s. Inject t s => t -> s
inject @_ @v (Integer -> Coin
Coin Integer
r)) forall a. Eq a => a -> a -> Bool
== Integer -> Coin
Coin Integer
r, String
"coinInject")
  , (\Integer
_ Integer
_ v
_ v
_ v
_ -> forall t. Val t => (Integer -> Integer -> Bool) -> t -> t -> Bool
pointwise forall a. Eq a => a -> a -> Bool
(==) (forall t. Val t => t
zero @v) forall t. Val t => t
zero, String
"pointwise zero")
  ]

polyCoinTests :: TestTree
polyCoinTests :: TestTree
polyCoinTests = String -> [TestTree] -> TestTree
testGroup String
"polyCoinTests" (forall a b. (a -> b) -> [a] -> [b]
map forall {a}. Testable a => (a, String) -> TestTree
f (forall v.
Val v =>
[(Integer -> Integer -> v -> v -> v -> Bool, String)]
proplist @Coin))
  where
    f :: (a, String) -> TestTree
f (a
fun, String
name) = forall a. Testable a => String -> a -> TestTree
testProperty String
name a
fun

polyValueTests :: TestTree
polyValueTests :: TestTree
polyValueTests = String -> [TestTree] -> TestTree
testGroup String
"polyValueTests" (forall a b. (a -> b) -> [a] -> [b]
map forall {a}. Testable a => (a, String) -> TestTree
f (forall v.
Val v =>
[(Integer -> Integer -> v -> v -> v -> Bool, String)]
proplist @MaryValue))
  where
    f :: (a, String) -> TestTree
f (a
fun, String
name) = forall a. Testable a => String -> a -> TestTree
testProperty String
name a
fun

-- ============================================================================
-- Tests that hold only in the Value class.
-- Testing that insert, lookup, and coin interact properly

valuePropList ::
  [ ( Integer -> Integer -> MaryValue -> PolicyID -> AssetName -> Bool
    , String
    )
  ]
valuePropList :: [(Integer -> Integer -> MaryValue -> PolicyID -> AssetName -> Bool,
  String)]
valuePropList =
  [ (\Integer
_ Integer
_ MaryValue
x PolicyID
_ AssetName
_ -> forall t. Val t => t -> Coin
coin (forall t. Val t => (Coin -> Coin) -> t -> t
modifyCoin Coin -> Coin
f MaryValue
x) forall a. Eq a => a -> a -> Bool
== forall t. Val t => (Coin -> Coin) -> t -> t
modifyCoin Coin -> Coin
f (forall t. Val t => t -> Coin
coin MaryValue
x), String
"coinModify")
  , (\Integer
_ Integer
_ MaryValue
_ PolicyID
p AssetName
a -> (Integer -> Integer -> Integer)
-> PolicyID -> AssetName -> Integer -> MaryValue -> MaryValue
insertValue forall a. a -> a -> a
pickOld PolicyID
p AssetName
a Integer
0 forall t. Val t => t
zero forall a. Eq a => a -> a -> Bool
== forall t. Val t => t
zero, String
"Nozeros")
  , (\Integer
_ Integer
_ MaryValue
x PolicyID
p AssetName
a -> (Integer -> Integer -> Integer)
-> PolicyID -> AssetName -> Integer -> MaryValue -> MaryValue
insertValue forall a. a -> a -> a
pickOld PolicyID
p AssetName
a Integer
0 MaryValue
x forall a. Eq a => a -> a -> Bool
== (Integer -> Integer -> Integer)
-> PolicyID -> AssetName -> Integer -> MaryValue -> MaryValue
insert2 forall a. a -> a -> a
pickOld PolicyID
p AssetName
a Integer
0 MaryValue
x, String
"insert==insert2A")
  , (\Integer
_ Integer
_ MaryValue
x PolicyID
p AssetName
a -> (Integer -> Integer -> Integer)
-> PolicyID -> AssetName -> Integer -> MaryValue -> MaryValue
insertValue forall a. a -> a -> a
pickNew PolicyID
p AssetName
a Integer
0 MaryValue
x forall a. Eq a => a -> a -> Bool
== (Integer -> Integer -> Integer)
-> PolicyID -> AssetName -> Integer -> MaryValue -> MaryValue
insert2 forall a. a -> a -> a
pickNew PolicyID
p AssetName
a Integer
0 MaryValue
x, String
"insert==insert2B")
  , (\Integer
_ Integer
_ MaryValue
x PolicyID
p AssetName
a -> (Integer -> Integer -> Integer)
-> PolicyID -> AssetName -> Integer -> MaryValue -> MaryValue
insertValue forall a. a -> a -> a
pickOld PolicyID
p AssetName
a Integer
0 MaryValue
x forall a. Eq a => a -> a -> Bool
== (Integer -> Integer -> Integer)
-> PolicyID -> AssetName -> Integer -> MaryValue -> MaryValue
insert3 forall a. a -> a -> a
pickOld PolicyID
p AssetName
a Integer
0 MaryValue
x, String
"insert==insert3A")
  , (\Integer
_ Integer
_ MaryValue
x PolicyID
p AssetName
a -> (Integer -> Integer -> Integer)
-> PolicyID -> AssetName -> Integer -> MaryValue -> MaryValue
insertValue forall a. a -> a -> a
pickNew PolicyID
p AssetName
a Integer
0 MaryValue
x forall a. Eq a => a -> a -> Bool
== (Integer -> Integer -> Integer)
-> PolicyID -> AssetName -> Integer -> MaryValue -> MaryValue
insert3 forall a. a -> a -> a
pickNew PolicyID
p AssetName
a Integer
0 MaryValue
x, String
"insert==insert3B")
  ,
    ( \Integer
n Integer
_ MaryValue
_ PolicyID
p AssetName
a -> (Integer -> Integer -> Integer)
-> PolicyID -> AssetName -> Integer -> MaryValue -> MaryValue
insertValue forall a. a -> a -> a
pickNew PolicyID
p AssetName
a Integer
n forall t. Val t => t
zero forall a. Eq a => a -> a -> Bool
== (Integer -> Integer -> Integer)
-> PolicyID -> AssetName -> Integer -> MaryValue -> MaryValue
insertValue forall a. a -> a -> a
pickOld PolicyID
p AssetName
a Integer
n forall t. Val t => t
zero
    , String
"comb doesn't matter on zero"
    )
  , -- the following 4 laws only holds for non zero n and m, and when not(n==m).
    -- Zeros cause the inserts to be no-ops in that case.

    ( \Integer
n Integer
m MaryValue
_ PolicyID
p AssetName
a ->
        Integer
n forall a. Eq a => a -> a -> Bool
== Integer
0
          Bool -> Bool -> Bool
|| Integer
m forall a. Eq a => a -> a -> Bool
== Integer
0
          Bool -> Bool -> Bool
|| Integer
n forall a. Eq a => a -> a -> Bool
== Integer
m
          Bool -> Bool -> Bool
|| ((Integer -> Integer -> Integer)
-> PolicyID -> AssetName -> Integer -> MaryValue -> MaryValue
insertValue forall a. a -> a -> a
pickOld PolicyID
p AssetName
a Integer
m ((Integer -> Integer -> Integer)
-> PolicyID -> AssetName -> Integer -> MaryValue -> MaryValue
insertValue forall a. a -> a -> a
pickNew PolicyID
p AssetName
a Integer
n forall t. Val t => t
zero))
            forall a. Eq a => a -> a -> Bool
== ((Integer -> Integer -> Integer)
-> PolicyID -> AssetName -> Integer -> MaryValue -> MaryValue
insertValue forall a. a -> a -> a
pickNew PolicyID
p AssetName
a Integer
n forall t. Val t => t
zero)
    , String
"retains-old"
    )
  ,
    ( \Integer
n Integer
m MaryValue
_ PolicyID
p AssetName
a ->
        Integer
n forall a. Eq a => a -> a -> Bool
== Integer
0
          Bool -> Bool -> Bool
|| Integer
m forall a. Eq a => a -> a -> Bool
== Integer
0
          Bool -> Bool -> Bool
|| Integer
n forall a. Eq a => a -> a -> Bool
== Integer
m
          Bool -> Bool -> Bool
|| ((Integer -> Integer -> Integer)
-> PolicyID -> AssetName -> Integer -> MaryValue -> MaryValue
insertValue forall a. a -> a -> a
pickNew PolicyID
p AssetName
a Integer
m ((Integer -> Integer -> Integer)
-> PolicyID -> AssetName -> Integer -> MaryValue -> MaryValue
insertValue forall a. a -> a -> a
pickNew PolicyID
p AssetName
a Integer
n forall t. Val t => t
zero))
            forall a. Eq a => a -> a -> Bool
== ((Integer -> Integer -> Integer)
-> PolicyID -> AssetName -> Integer -> MaryValue -> MaryValue
insertValue forall a. a -> a -> a
pickNew PolicyID
p AssetName
a Integer
m forall t. Val t => t
zero)
    , String
"new-overrides"
    )
  ,
    ( \Integer
n Integer
m MaryValue
_ PolicyID
p AssetName
a ->
        Integer
n forall a. Eq a => a -> a -> Bool
== Integer
0
          Bool -> Bool -> Bool
|| Integer
m forall a. Eq a => a -> a -> Bool
== Integer
0
          Bool -> Bool -> Bool
|| Integer
n forall a. Eq a => a -> a -> Bool
== Integer
m
          Bool -> Bool -> Bool
|| PolicyID -> AssetName -> MaryValue -> Integer
lookupMultiAsset PolicyID
p AssetName
a ((Integer -> Integer -> Integer)
-> PolicyID -> AssetName -> Integer -> MaryValue -> MaryValue
insertValue forall a. a -> a -> a
pickOld PolicyID
p AssetName
a Integer
m ((Integer -> Integer -> Integer)
-> PolicyID -> AssetName -> Integer -> MaryValue -> MaryValue
insertValue forall a. a -> a -> a
pickNew PolicyID
p AssetName
a Integer
n forall t. Val t => t
zero)) forall a. Eq a => a -> a -> Bool
== Integer
n
    , String
"oldVsNew"
    )
  ,
    ( \Integer
n Integer
m MaryValue
_ PolicyID
p AssetName
a ->
        Integer
n forall a. Eq a => a -> a -> Bool
== Integer
0
          Bool -> Bool -> Bool
|| Integer
m forall a. Eq a => a -> a -> Bool
== Integer
0
          Bool -> Bool -> Bool
|| Integer
n forall a. Eq a => a -> a -> Bool
== Integer
m
          Bool -> Bool -> Bool
|| PolicyID -> AssetName -> MaryValue -> Integer
lookupMultiAsset PolicyID
p AssetName
a ((Integer -> Integer -> Integer)
-> PolicyID -> AssetName -> Integer -> MaryValue -> MaryValue
insertValue forall a. a -> a -> a
pickNew PolicyID
p AssetName
a Integer
m ((Integer -> Integer -> Integer)
-> PolicyID -> AssetName -> Integer -> MaryValue -> MaryValue
insertValue forall a. a -> a -> a
pickNew PolicyID
p AssetName
a Integer
n forall t. Val t => t
zero)) forall a. Eq a => a -> a -> Bool
== Integer
m
    , String
"newVsOld"
    )
  , (\Integer
n Integer
_ MaryValue
x PolicyID
p AssetName
a -> PolicyID -> AssetName -> MaryValue -> Integer
lookupMultiAsset PolicyID
p AssetName
a ((Integer -> Integer -> Integer)
-> PolicyID -> AssetName -> Integer -> MaryValue -> MaryValue
insertValue forall a. a -> a -> a
pickNew PolicyID
p AssetName
a Integer
n MaryValue
x) forall a. Eq a => a -> a -> Bool
== Integer
n, String
"lookup-insert-overwrite")
  ,
    ( \Integer
n Integer
_ MaryValue
x PolicyID
p AssetName
a ->
        PolicyID -> AssetName -> MaryValue -> Integer
lookupMultiAsset PolicyID
p AssetName
a MaryValue
x forall a. Eq a => a -> a -> Bool
== Integer
0
          Bool -> Bool -> Bool
|| PolicyID -> AssetName -> MaryValue -> Integer
lookupMultiAsset PolicyID
p AssetName
a ((Integer -> Integer -> Integer)
-> PolicyID -> AssetName -> Integer -> MaryValue -> MaryValue
insertValue forall a. a -> a -> a
pickOld PolicyID
p AssetName
a Integer
n MaryValue
x) forall a. Eq a => a -> a -> Bool
== PolicyID -> AssetName -> MaryValue -> Integer
lookupMultiAsset PolicyID
p AssetName
a MaryValue
x
    , String
"lookup-insert-retain"
    )
  , (\Integer
n Integer
_ MaryValue
x PolicyID
p AssetName
a -> forall t. Val t => t -> Coin
coin ((Integer -> Integer -> Integer)
-> PolicyID -> AssetName -> Integer -> MaryValue -> MaryValue
insertValue forall a. a -> a -> a
pickOld PolicyID
p AssetName
a Integer
n MaryValue
x) forall a. Eq a => a -> a -> Bool
== forall t. Val t => t -> Coin
coin MaryValue
x, String
"coinIgnores1")
  , (\Integer
n Integer
_ MaryValue
x PolicyID
p AssetName
a -> forall t. Val t => t -> Coin
coin ((Integer -> Integer -> Integer)
-> PolicyID -> AssetName -> Integer -> MaryValue -> MaryValue
insertValue forall a. a -> a -> a
pickNew PolicyID
p AssetName
a Integer
n MaryValue
x) forall a. Eq a => a -> a -> Bool
== forall t. Val t => t -> Coin
coin MaryValue
x, String
"coinIgnores2")
  , (\Integer
n Integer
_ MaryValue
x PolicyID
p AssetName
a -> forall t. Val t => t -> Coin
coin ((Integer -> Integer -> Integer)
-> PolicyID -> AssetName -> Integer -> MaryValue -> MaryValue
insertValue (\Integer
o Integer
_n -> Integer
o forall a. Num a => a -> a -> a
+ Integer
n) PolicyID
p AssetName
a Integer
n MaryValue
x) forall a. Eq a => a -> a -> Bool
== forall t. Val t => t -> Coin
coin MaryValue
x, String
"coinIgnores3")
  ]
  where
    f :: Coin -> Coin
f (Coin Integer
n) = Integer -> Coin
Coin (Integer
n forall a. Num a => a -> a -> a
+ Integer
3)

monoValueTests :: TestTree
monoValueTests :: TestTree
monoValueTests = String -> [TestTree] -> TestTree
testGroup String
"Value specific tests" (forall a b. (a -> b) -> [a] -> [b]
map (\(Integer -> Integer -> MaryValue -> PolicyID -> AssetName -> Bool
f, String
n) -> forall a. Testable a => String -> a -> TestTree
testProperty String
n Integer -> Integer -> MaryValue -> PolicyID -> AssetName -> Bool
f) [(Integer -> Integer -> MaryValue -> PolicyID -> AssetName -> Bool,
  String)]
valuePropList)

valueGroup ::
  [ ( Integer ->
      MaryValue ->
      MaryValue ->
      PolicyID ->
      AssetName ->
      Property
    , String
    )
  ]
valueGroup :: [(Integer
  -> MaryValue -> MaryValue -> PolicyID -> AssetName -> Property,
  String)]
valueGroup =
  [
    ( \Integer
_ MaryValue
x MaryValue
y PolicyID
p AssetName
a -> PolicyID -> AssetName -> MaryValue -> Integer
lookupMultiAsset PolicyID
p AssetName
a (MaryValue
x forall t. Val t => t -> t -> t
<+> MaryValue
y) forall a. (Eq a, Show a) => a -> a -> Property
=== PolicyID -> AssetName -> MaryValue -> Integer
lookupMultiAsset PolicyID
p AssetName
a MaryValue
x forall a. Num a => a -> a -> a
+ PolicyID -> AssetName -> MaryValue -> Integer
lookupMultiAsset PolicyID
p AssetName
a MaryValue
y
    , String
"lookup over <+>"
    )
  ,
    ( \Integer
_ MaryValue
x MaryValue
y PolicyID
p AssetName
a -> PolicyID -> AssetName -> MaryValue -> Integer
lookupMultiAsset PolicyID
p AssetName
a (MaryValue
x forall t. Val t => t -> t -> t
<-> MaryValue
y) forall a. (Eq a, Show a) => a -> a -> Property
=== PolicyID -> AssetName -> MaryValue -> Integer
lookupMultiAsset PolicyID
p AssetName
a MaryValue
x forall a. Num a => a -> a -> a
- PolicyID -> AssetName -> MaryValue -> Integer
lookupMultiAsset PolicyID
p AssetName
a MaryValue
y
    , String
"lookup over <->"
    )
  , (\Integer
n MaryValue
x MaryValue
_ PolicyID
p AssetName
a -> PolicyID -> AssetName -> MaryValue -> Integer
lookupMultiAsset PolicyID
p AssetName
a (Integer
n forall t i. (Val t, Integral i) => i -> t -> t
<×> MaryValue
x) forall a. (Eq a, Show a) => a -> a -> Property
=== Integer
n forall a. Num a => a -> a -> a
* PolicyID -> AssetName -> MaryValue -> Integer
lookupMultiAsset PolicyID
p AssetName
a MaryValue
x, String
"lookup over <×>")
  , (\Integer
_ MaryValue
_ MaryValue
_ PolicyID
p AssetName
a -> PolicyID -> AssetName -> MaryValue -> Integer
lookupMultiAsset PolicyID
p AssetName
a forall t. Val t => t
zero forall a. (Eq a, Show a) => a -> a -> Property
=== Integer
0, String
"lookup over zero")
  ,
    ( \Integer
_ MaryValue
x MaryValue
_ PolicyID
p AssetName
a -> PolicyID -> AssetName -> MaryValue -> Integer
lookupMultiAsset PolicyID
p AssetName
a (forall t. Val t => t -> t
invert MaryValue
x) forall a. (Eq a, Show a) => a -> a -> Property
=== (-Integer
1) forall a. Num a => a -> a -> a
* PolicyID -> AssetName -> MaryValue -> Integer
lookupMultiAsset PolicyID
p AssetName
a MaryValue
x
    , String
"lookup over invert"
    )
  ]

valueGroupTests :: TestTree
valueGroupTests :: TestTree
valueGroupTests = String -> [TestTree] -> TestTree
testGroup String
"value is a group" (forall a b. (a -> b) -> [a] -> [b]
map (\(Integer
-> MaryValue -> MaryValue -> PolicyID -> AssetName -> Property
f, String
n) -> forall a. Testable a => String -> a -> TestTree
testProperty String
n Integer
-> MaryValue -> MaryValue -> PolicyID -> AssetName -> Property
f) [(Integer
  -> MaryValue -> MaryValue -> PolicyID -> AssetName -> Property,
  String)]
valueGroup)

compactRoundTrip :: Property
compactRoundTrip :: Property
compactRoundTrip = forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
forAll Gen MaryValue
gen forall a b. (a -> b) -> a -> b
$ \MaryValue
v ->
  forall prop. Testable prop => String -> prop -> Property
counterexample
    (forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ forall a. Compactible a => a -> Maybe (CompactForm a)
toCompact MaryValue
v)
    (forall a. a -> Maybe a
Just MaryValue
v forall a. (Eq a, Show a) => a -> a -> Property
=== forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Compactible a => CompactForm a -> a
fromCompact (forall a. Compactible a => a -> Maybe (CompactForm a)
toCompact MaryValue
v))
  where
    gen :: Gen MaryValue
gen = do
      [Gen PolicyID]
pids <- forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
3 (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen PolicyID
genPolicyID)
      [Gen AssetName]
ans <- forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
3 (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen AssetName
genAssetName)
      -- this ensures we get some collisions among asset names and among pids
      Int
numTriples <- forall a. Random a => (a, a) -> Gen a
QC.choose (Int
3, Int
30)
      [(PolicyID, AssetName, Integer)]
triples <- forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
numTriples forall a b. (a -> b) -> a -> b
$ do
        PolicyID
pid <- forall a. HasCallStack => [Gen a] -> Gen a
QC.oneof [Gen PolicyID]
pids
        AssetName
an <- forall a. HasCallStack => [Gen a] -> Gen a
QC.oneof [Gen AssetName]
ans
        Integer
q <- forall a. Random a => (a, a) -> Gen a
QC.choose (Integer
0, Integer
100)
        forall (f :: * -> *) a. Applicative f => a -> f a
pure (PolicyID
pid, AssetName
an, Integer
q)
      Integer
q <- forall a. Random a => (a, a) -> Gen a
QC.choose (Integer
0, Integer
100)
      forall (f :: * -> *) a. Applicative f => a -> f a
pure ([(PolicyID, AssetName, Integer)] -> Integer -> MaryValue
valueFromList [(PolicyID, AssetName, Integer)]
triples Integer
q)

compactTest :: TestTree
compactTest :: TestTree
compactTest = forall a. Testable a => String -> a -> TestTree
testProperty String
"fromCompact . toCompact == id" Property
compactRoundTrip

-- | Create a script hash of length 28 with 27 leading zeros followed by one hex-encoded byte
-- supplied by the caller.
makeScriptHash :: String -> ScriptHash
makeScriptHash :: String -> ScriptHash
makeScriptHash String
str =
  Hash ADDRHASH EraIndependentScript -> ScriptHash
ScriptHash forall a b. (a -> b) -> a -> b
$ forall h a b. Hash h a -> Hash h b
castHash (forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => String -> a
error String
"Impossible") forall a b. (a -> b) -> a -> b
$ forall h a. HashAlgorithm h => String -> Maybe (Hash h a)
hashFromStringAsHex (String
pad forall a. Semigroup a => a -> a -> a
<> String
str))
  where
    pad :: String
pad = forall a. Int -> a -> [a]
replicate Int
54 Char
'0'

oneNonameAsset :: Map.Map AssetName Integer
oneNonameAsset :: Map AssetName Integer
oneNonameAsset = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(ShortByteString -> AssetName
AssetName ShortByteString
"", Integer
1)]

makeMultiAsset :: ScriptHash -> MultiAsset
makeMultiAsset :: ScriptHash -> MultiAsset
makeMultiAsset ScriptHash
sh = Map PolicyID (Map AssetName Integer) -> MultiAsset
MultiAsset (forall k a. k -> a -> Map k a
Map.singleton (ScriptHash -> PolicyID
PolicyID ScriptHash
sh) Map AssetName Integer
oneNonameAsset)

s0, s1, s2, s3, s4, s5, s6, s7, s8, s9, s10, s11, s12 :: MultiAsset
s0 :: MultiAsset
s0 = ScriptHash -> MultiAsset
makeMultiAsset forall a b. (a -> b) -> a -> b
$ String -> ScriptHash
makeScriptHash String
"00"
s1 :: MultiAsset
s1 = ScriptHash -> MultiAsset
makeMultiAsset forall a b. (a -> b) -> a -> b
$ String -> ScriptHash
makeScriptHash String
"01"
s2 :: MultiAsset
s2 = ScriptHash -> MultiAsset
makeMultiAsset forall a b. (a -> b) -> a -> b
$ String -> ScriptHash
makeScriptHash String
"02"
s3 :: MultiAsset
s3 = ScriptHash -> MultiAsset
makeMultiAsset forall a b. (a -> b) -> a -> b
$ String -> ScriptHash
makeScriptHash String
"03"
s4 :: MultiAsset
s4 = ScriptHash -> MultiAsset
makeMultiAsset forall a b. (a -> b) -> a -> b
$ String -> ScriptHash
makeScriptHash String
"04"
s5 :: MultiAsset
s5 = ScriptHash -> MultiAsset
makeMultiAsset forall a b. (a -> b) -> a -> b
$ String -> ScriptHash
makeScriptHash String
"05"
s6 :: MultiAsset
s6 = ScriptHash -> MultiAsset
makeMultiAsset forall a b. (a -> b) -> a -> b
$ String -> ScriptHash
makeScriptHash String
"06"
s7 :: MultiAsset
s7 = ScriptHash -> MultiAsset
makeMultiAsset forall a b. (a -> b) -> a -> b
$ String -> ScriptHash
makeScriptHash String
"07"
s8 :: MultiAsset
s8 = ScriptHash -> MultiAsset
makeMultiAsset forall a b. (a -> b) -> a -> b
$ String -> ScriptHash
makeScriptHash String
"08"
s9 :: MultiAsset
s9 = ScriptHash -> MultiAsset
makeMultiAsset forall a b. (a -> b) -> a -> b
$ String -> ScriptHash
makeScriptHash String
"09"
s10 :: MultiAsset
s10 = ScriptHash -> MultiAsset
makeMultiAsset forall a b. (a -> b) -> a -> b
$ String -> ScriptHash
makeScriptHash String
"10"
s11 :: MultiAsset
s11 = ScriptHash -> MultiAsset
makeMultiAsset forall a b. (a -> b) -> a -> b
$ String -> ScriptHash
makeScriptHash String
"11"
s12 :: MultiAsset
s12 = ScriptHash -> MultiAsset
makeMultiAsset forall a b. (a -> b) -> a -> b
$ String -> ScriptHash
makeScriptHash String
"12"

exampleMultiAssets :: [MultiAsset]
exampleMultiAssets :: [MultiAsset]
exampleMultiAssets = [MultiAsset
s0, MultiAsset
s1, MultiAsset
s2, MultiAsset
s3, MultiAsset
s4, MultiAsset
s5, MultiAsset
s6, MultiAsset
s7, MultiAsset
s8, MultiAsset
s9, MultiAsset
s10, MultiAsset
s11, MultiAsset
s12]

-- | Test that the subtraction of Multi-assets (and the underlying 'CanonicalMaps')
-- is a total function.
-- This was used to diagnose https://github.com/input-output-hk/cardano-node/issues/4826
subtractionIsTotal :: TestTree
subtractionIsTotal :: TestTree
subtractionIsTotal = forall a. Testable a => String -> a -> TestTree
testProperty String
"multi-asset subtraction is total" forall a b. (a -> b) -> a -> b
$
  forall prop. Testable prop => Int -> prop -> Property
QC.withMaxSuccess Int
100000 forall a b. (a -> b) -> a -> b
$
    do
      [MultiAsset]
shuffle1 <- forall a. Int -> [a] -> [a]
take Int
12 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. [a] -> Gen [a]
QC.shuffle [MultiAsset]
exampleMultiAssets
      [MultiAsset]
shuffle2 <- forall a. Int -> [a] -> [a]
take Int
2 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. [a] -> Gen [a]
QC.shuffle [MultiAsset]
exampleMultiAssets
      let a :: Map PolicyID (Map AssetName Integer)
a = forall a. Monoid a => [a] -> a
mconcat [Map PolicyID (Map AssetName Integer)
m | MultiAsset Map PolicyID (Map AssetName Integer)
m <- [MultiAsset]
shuffle1]
          -- \^ here we chose to perform addition on the CanonicalMaps, as this is what
          -- happens during deserialization, giving us insight into how node-4826 could
          -- have occurred on mainnet (since we care about how the addition is associated).
          -- Note that the ledger does not manipulate instances of
          -- 'Value' and then store them in memory, since outputs are created by the user
          -- and only deserialized. In other words, it is only in the ledger rules themselves
          -- that we manipulate 'Value'.
          b :: MultiAsset
b = forall a. Monoid a => [a] -> a
mconcat [MultiAsset]
shuffle2
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$! forall a. NFData a => a -> ()
rnf (Map PolicyID (Map AssetName Integer) -> MultiAsset
MultiAsset Map PolicyID (Map AssetName Integer)
a forall a. Semigroup a => a -> a -> a
<> forall m. Group m => m -> m
G.invert MultiAsset
b)

-- | The test below was discovered by a failure of 'subtractionIsTotal'
-- using git sha bd359d3f745ca72242b2cd1208780c2787992b5f and --quickcheck-replay=649941
node4826Reproducible :: TestTree
node4826Reproducible :: TestTree
node4826Reproducible =
  forall a. Testable a => String -> a -> TestTree
testProperty String
"node4826Reproducible" forall a b. (a -> b) -> a -> b
$
    let shuffle1 :: [MultiAsset]
shuffle1 =
          [ ScriptHash -> MultiAsset
makeMultiAsset forall a b. (a -> b) -> a -> b
$ String -> ScriptHash
makeScriptHash String
suffix
          | String
suffix <- [String
"10", String
"09", String
"11", String
"08", String
"01", String
"06", String
"03", String
"05", String
"04", String
"07", String
"02", String
"00"]
          ]
        shuffle2 :: [MultiAsset]
shuffle2 =
          [ ScriptHash -> MultiAsset
makeMultiAsset forall a b. (a -> b) -> a -> b
$ String -> ScriptHash
makeScriptHash String
suffix
          | String
suffix <- [String
"04", String
"08"]
          ]
        multiAssetMap :: Map PolicyID (Map AssetName Integer)
multiAssetMap = forall a. Monoid a => [a] -> a
mconcat [Map PolicyID (Map AssetName Integer)
m | MultiAsset Map PolicyID (Map AssetName Integer)
m <- [MultiAsset]
shuffle1]
        reproducible :: MultiAsset
reproducible = Map PolicyID (Map AssetName Integer) -> MultiAsset
MultiAsset Map PolicyID (Map AssetName Integer)
multiAssetMap forall a. Semigroup a => a -> a -> a
<> forall m. Group m => m -> m
G.invert (forall a. Monoid a => [a] -> a
mconcat [MultiAsset]
shuffle2)
     in forall a. NFData a => a -> ()
rnf MultiAsset
reproducible

-- ===========================================
-- All the value tests

valTests :: TestTree
valTests :: TestTree
valTests =
  String -> [TestTree] -> TestTree
testGroup
    String
"allValTests"
    [ TestTree
insertTests
    , TestTree
albelianTests
    , TestTree
polyCoinTests
    , TestTree
polyValueTests
    , TestTree
monoValueTests
    , TestTree
valueGroupTests
    , TestTree
compactTest
    , TestTree
subtractionIsTotal
    , TestTree
node4826Reproducible
    ]