{-# 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.Crypto (StandardCrypto)
import qualified Cardano.Ledger.Crypto as CC (Crypto)
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 c ->
  AssetName ->
  Integer ->
  MaryValue c ->
  MaryValue c
insertValue :: forall c.
(Integer -> Integer -> Integer)
-> PolicyID c -> AssetName -> Integer -> MaryValue c -> MaryValue c
insertValue Integer -> Integer -> Integer
combine PolicyID c
pid AssetName
aid Integer
new (MaryValue Coin
c MultiAsset c
m) = forall c. Coin -> MultiAsset c -> MaryValue c
MaryValue Coin
c forall a b. (a -> b) -> a -> b
$ forall c.
(Integer -> Integer -> Integer)
-> PolicyID c
-> AssetName
-> Integer
-> MultiAsset c
-> MultiAsset c
insertMultiAsset Integer -> Integer -> Integer
combine PolicyID c
pid AssetName
aid Integer
new MultiAsset c
m

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

-- | Make a Value with no coin, and just one token.
unit :: PolicyID c -> AssetName -> Integer -> MaryValue c
unit :: forall c. PolicyID c -> AssetName -> Integer -> MaryValue c
unit PolicyID c
pid AssetName
aid Integer
n =
  forall c. Coin -> MultiAsset c -> MaryValue c
MaryValue forall a. Monoid a => a
mempty forall a b. (a -> b) -> a -> b
$
    forall c. Map (PolicyID c) (Map AssetName Integer) -> MultiAsset c
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 c
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 ::
  CC.Crypto c =>
  (Integer -> Integer -> Integer) ->
  PolicyID c ->
  AssetName ->
  Integer ->
  MaryValue c ->
  MaryValue c
insert2 :: forall c.
Crypto c =>
(Integer -> Integer -> Integer)
-> PolicyID c -> AssetName -> Integer -> MaryValue c -> MaryValue c
insert2 Integer -> Integer -> Integer
combine PolicyID c
pid AssetName
aid Integer
new MaryValue c
m1 =
  -- The trick is to correctly not store a zero. Several ways to get a zero
  case (forall c. PolicyID c -> AssetName -> MaryValue c -> Integer
lookupMultiAsset PolicyID c
pid AssetName
aid MaryValue c
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 c
m1
    -- input is not zero, its not in the map, so add it to the map
    (Integer
0, Bool
False) -> MaryValue c
m1 forall t. Val t => t -> t -> t
<+> forall c. PolicyID c -> AssetName -> Integer -> MaryValue c
unit PolicyID c
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 c
m1 forall t. Val t => t -> t -> t
<+> forall c. PolicyID c -> AssetName -> Integer -> MaryValue c
unit PolicyID c
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 StandardCrypto, AssetName, Integer)] -> Integer -> MaryValue StandardCrypto
valueFromList :: [(PolicyID StandardCrypto, AssetName, Integer)]
-> Integer -> MaryValue StandardCrypto
valueFromList [(PolicyID StandardCrypto, AssetName, Integer)]
list Integer
c = forall c. Coin -> MultiAsset c -> MaryValue c
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 forall {c}.
(PolicyID c, AssetName, Integer) -> MultiAsset c -> MultiAsset c
acc forall a. Monoid a => a
mempty [(PolicyID StandardCrypto, AssetName, Integer)]
list
  where
    acc :: (PolicyID c, AssetName, Integer) -> MultiAsset c -> MultiAsset c
acc (PolicyID c
policy, AssetName
asset, Integer
count) MultiAsset c
m = forall c.
(Integer -> Integer -> Integer)
-> PolicyID c
-> AssetName
-> Integer
-> MultiAsset c
-> MultiAsset c
insertMultiAsset forall a. Num a => a -> a -> a
(+) PolicyID c
policy AssetName
asset Integer
count MultiAsset c
m

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

valueFromList2 ::
  [(PolicyID StandardCrypto, AssetName, Integer)] -> Integer -> MaryValue StandardCrypto
valueFromList2 :: [(PolicyID StandardCrypto, AssetName, Integer)]
-> Integer -> MaryValue StandardCrypto
valueFromList2 [(PolicyID StandardCrypto, AssetName, Integer)]
list Integer
c = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall {c}.
Crypto c =>
(PolicyID c, AssetName, Integer) -> MaryValue c -> MaryValue c
acc (forall c. Coin -> MultiAsset c -> MaryValue c
MaryValue (Integer -> Coin
Coin Integer
c) forall a. Monoid a => a
mempty) [(PolicyID StandardCrypto, AssetName, Integer)]
list
  where
    acc :: (PolicyID c, AssetName, Integer) -> MaryValue c -> MaryValue c
acc (PolicyID c
policy, AssetName
asset, Integer
count) MaryValue c
m = forall c.
Crypto c =>
(Integer -> Integer -> Integer)
-> PolicyID c -> AssetName -> Integer -> MaryValue c -> MaryValue c
insert2 forall a. Num a => a -> a -> a
(+) PolicyID c
policy AssetName
asset Integer
count MaryValue c
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 StandardCrypto, AssetName, Integer)]
vs Integer
c -> [(PolicyID StandardCrypto, AssetName, Integer)]
-> Integer -> MaryValue StandardCrypto
valueFromList [(PolicyID StandardCrypto, AssetName, Integer)]
vs Integer
c forall a. (Eq a, Show a) => a -> a -> Property
=== [(PolicyID StandardCrypto, AssetName, Integer)]
-> Integer -> MaryValue StandardCrypto
valueFromList2 [(PolicyID StandardCrypto, AssetName, Integer)]
vs Integer
c
    , forall a. Testable a => String -> a -> TestTree
testProperty String
"insert=insert3" forall a b. (a -> b) -> a -> b
$ \[(PolicyID StandardCrypto, AssetName, Integer)]
vs Integer
c -> [(PolicyID StandardCrypto, AssetName, Integer)]
-> Integer -> MaryValue StandardCrypto
valueFromList [(PolicyID StandardCrypto, AssetName, Integer)]
vs Integer
c forall a. (Eq a, Show a) => a -> a -> Property
=== [(PolicyID StandardCrypto, AssetName, Integer)]
-> Integer -> MaryValue StandardCrypto
valueFromList3 [(PolicyID StandardCrypto, AssetName, Integer)]
vs Integer
c
    , forall a. Testable a => String -> a -> TestTree
testProperty String
"insert2=insert3" forall a b. (a -> b) -> a -> b
$ \[(PolicyID StandardCrypto, AssetName, Integer)]
vs Integer
c -> [(PolicyID StandardCrypto, AssetName, Integer)]
-> Integer -> MaryValue StandardCrypto
valueFromList2 [(PolicyID StandardCrypto, AssetName, Integer)]
vs Integer
c forall a. (Eq a, Show a) => a -> a -> Property
=== [(PolicyID StandardCrypto, AssetName, Integer)]
-> Integer -> MaryValue StandardCrypto
valueFromList3 [(PolicyID StandardCrypto, 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 StandardCrypto)
genPolicyID :: Gen (PolicyID StandardCrypto)
genPolicyID = forall c. ScriptHash c -> PolicyID c
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 StandardCrypto -> MaryValue StandardCrypto -> Property
prop, String
name) -> forall a. Testable a => String -> a -> TestTree
testProperty String
name MaryValue StandardCrypto -> MaryValue StandardCrypto -> Property
prop) (forall v. Val v => [(v -> v -> Property, String)]
albelianlist @(MaryValue StandardCrypto))
    ]

-- ===================================================================
-- 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 StandardCrypto)))
  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 StandardCrypto -> PolicyID StandardCrypto -> AssetName -> Bool
    , String
    )
  ]
valuePropList :: [(Integer
  -> Integer
  -> MaryValue StandardCrypto
  -> PolicyID StandardCrypto
  -> AssetName
  -> Bool,
  String)]
valuePropList =
  [ (\Integer
_ Integer
_ MaryValue StandardCrypto
x PolicyID StandardCrypto
_ AssetName
_ -> forall t. Val t => t -> Coin
coin (forall t. Val t => (Coin -> Coin) -> t -> t
modifyCoin Coin -> Coin
f MaryValue StandardCrypto
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 StandardCrypto
x), String
"coinModify")
  , (\Integer
_ Integer
_ MaryValue StandardCrypto
_ PolicyID StandardCrypto
p AssetName
a -> forall c.
(Integer -> Integer -> Integer)
-> PolicyID c -> AssetName -> Integer -> MaryValue c -> MaryValue c
insertValue forall a. a -> a -> a
pickOld PolicyID StandardCrypto
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 StandardCrypto
x PolicyID StandardCrypto
p AssetName
a -> forall c.
(Integer -> Integer -> Integer)
-> PolicyID c -> AssetName -> Integer -> MaryValue c -> MaryValue c
insertValue forall a. a -> a -> a
pickOld PolicyID StandardCrypto
p AssetName
a Integer
0 MaryValue StandardCrypto
x forall a. Eq a => a -> a -> Bool
== forall c.
Crypto c =>
(Integer -> Integer -> Integer)
-> PolicyID c -> AssetName -> Integer -> MaryValue c -> MaryValue c
insert2 forall a. a -> a -> a
pickOld PolicyID StandardCrypto
p AssetName
a Integer
0 MaryValue StandardCrypto
x, String
"insert==insert2A")
  , (\Integer
_ Integer
_ MaryValue StandardCrypto
x PolicyID StandardCrypto
p AssetName
a -> forall c.
(Integer -> Integer -> Integer)
-> PolicyID c -> AssetName -> Integer -> MaryValue c -> MaryValue c
insertValue forall a. a -> a -> a
pickNew PolicyID StandardCrypto
p AssetName
a Integer
0 MaryValue StandardCrypto
x forall a. Eq a => a -> a -> Bool
== forall c.
Crypto c =>
(Integer -> Integer -> Integer)
-> PolicyID c -> AssetName -> Integer -> MaryValue c -> MaryValue c
insert2 forall a. a -> a -> a
pickNew PolicyID StandardCrypto
p AssetName
a Integer
0 MaryValue StandardCrypto
x, String
"insert==insert2B")
  , (\Integer
_ Integer
_ MaryValue StandardCrypto
x PolicyID StandardCrypto
p AssetName
a -> forall c.
(Integer -> Integer -> Integer)
-> PolicyID c -> AssetName -> Integer -> MaryValue c -> MaryValue c
insertValue forall a. a -> a -> a
pickOld PolicyID StandardCrypto
p AssetName
a Integer
0 MaryValue StandardCrypto
x forall a. Eq a => a -> a -> Bool
== forall c.
(Integer -> Integer -> Integer)
-> PolicyID c -> AssetName -> Integer -> MaryValue c -> MaryValue c
insert3 forall a. a -> a -> a
pickOld PolicyID StandardCrypto
p AssetName
a Integer
0 MaryValue StandardCrypto
x, String
"insert==insert3A")
  , (\Integer
_ Integer
_ MaryValue StandardCrypto
x PolicyID StandardCrypto
p AssetName
a -> forall c.
(Integer -> Integer -> Integer)
-> PolicyID c -> AssetName -> Integer -> MaryValue c -> MaryValue c
insertValue forall a. a -> a -> a
pickNew PolicyID StandardCrypto
p AssetName
a Integer
0 MaryValue StandardCrypto
x forall a. Eq a => a -> a -> Bool
== forall c.
(Integer -> Integer -> Integer)
-> PolicyID c -> AssetName -> Integer -> MaryValue c -> MaryValue c
insert3 forall a. a -> a -> a
pickNew PolicyID StandardCrypto
p AssetName
a Integer
0 MaryValue StandardCrypto
x, String
"insert==insert3B")
  ,
    ( \Integer
n Integer
_ MaryValue StandardCrypto
_ PolicyID StandardCrypto
p AssetName
a -> forall c.
(Integer -> Integer -> Integer)
-> PolicyID c -> AssetName -> Integer -> MaryValue c -> MaryValue c
insertValue forall a. a -> a -> a
pickNew PolicyID StandardCrypto
p AssetName
a Integer
n forall t. Val t => t
zero forall a. Eq a => a -> a -> Bool
== forall c.
(Integer -> Integer -> Integer)
-> PolicyID c -> AssetName -> Integer -> MaryValue c -> MaryValue c
insertValue forall a. a -> a -> a
pickOld PolicyID StandardCrypto
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 StandardCrypto
_ PolicyID StandardCrypto
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
|| (forall c.
(Integer -> Integer -> Integer)
-> PolicyID c -> AssetName -> Integer -> MaryValue c -> MaryValue c
insertValue forall a. a -> a -> a
pickOld PolicyID StandardCrypto
p AssetName
a Integer
m (forall c.
(Integer -> Integer -> Integer)
-> PolicyID c -> AssetName -> Integer -> MaryValue c -> MaryValue c
insertValue forall a. a -> a -> a
pickNew PolicyID StandardCrypto
p AssetName
a Integer
n forall t. Val t => t
zero))
            forall a. Eq a => a -> a -> Bool
== (forall c.
(Integer -> Integer -> Integer)
-> PolicyID c -> AssetName -> Integer -> MaryValue c -> MaryValue c
insertValue forall a. a -> a -> a
pickNew PolicyID StandardCrypto
p AssetName
a Integer
n forall t. Val t => t
zero)
    , String
"retains-old"
    )
  ,
    ( \Integer
n Integer
m MaryValue StandardCrypto
_ PolicyID StandardCrypto
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
|| (forall c.
(Integer -> Integer -> Integer)
-> PolicyID c -> AssetName -> Integer -> MaryValue c -> MaryValue c
insertValue forall a. a -> a -> a
pickNew PolicyID StandardCrypto
p AssetName
a Integer
m (forall c.
(Integer -> Integer -> Integer)
-> PolicyID c -> AssetName -> Integer -> MaryValue c -> MaryValue c
insertValue forall a. a -> a -> a
pickNew PolicyID StandardCrypto
p AssetName
a Integer
n forall t. Val t => t
zero))
            forall a. Eq a => a -> a -> Bool
== (forall c.
(Integer -> Integer -> Integer)
-> PolicyID c -> AssetName -> Integer -> MaryValue c -> MaryValue c
insertValue forall a. a -> a -> a
pickNew PolicyID StandardCrypto
p AssetName
a Integer
m forall t. Val t => t
zero)
    , String
"new-overrides"
    )
  ,
    ( \Integer
n Integer
m MaryValue StandardCrypto
_ PolicyID StandardCrypto
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
|| forall c. PolicyID c -> AssetName -> MaryValue c -> Integer
lookupMultiAsset PolicyID StandardCrypto
p AssetName
a (forall c.
(Integer -> Integer -> Integer)
-> PolicyID c -> AssetName -> Integer -> MaryValue c -> MaryValue c
insertValue forall a. a -> a -> a
pickOld PolicyID StandardCrypto
p AssetName
a Integer
m (forall c.
(Integer -> Integer -> Integer)
-> PolicyID c -> AssetName -> Integer -> MaryValue c -> MaryValue c
insertValue forall a. a -> a -> a
pickNew PolicyID StandardCrypto
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 StandardCrypto
_ PolicyID StandardCrypto
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
|| forall c. PolicyID c -> AssetName -> MaryValue c -> Integer
lookupMultiAsset PolicyID StandardCrypto
p AssetName
a (forall c.
(Integer -> Integer -> Integer)
-> PolicyID c -> AssetName -> Integer -> MaryValue c -> MaryValue c
insertValue forall a. a -> a -> a
pickNew PolicyID StandardCrypto
p AssetName
a Integer
m (forall c.
(Integer -> Integer -> Integer)
-> PolicyID c -> AssetName -> Integer -> MaryValue c -> MaryValue c
insertValue forall a. a -> a -> a
pickNew PolicyID StandardCrypto
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 StandardCrypto
x PolicyID StandardCrypto
p AssetName
a -> forall c. PolicyID c -> AssetName -> MaryValue c -> Integer
lookupMultiAsset PolicyID StandardCrypto
p AssetName
a (forall c.
(Integer -> Integer -> Integer)
-> PolicyID c -> AssetName -> Integer -> MaryValue c -> MaryValue c
insertValue forall a. a -> a -> a
pickNew PolicyID StandardCrypto
p AssetName
a Integer
n MaryValue StandardCrypto
x) forall a. Eq a => a -> a -> Bool
== Integer
n, String
"lookup-insert-overwrite")
  ,
    ( \Integer
n Integer
_ MaryValue StandardCrypto
x PolicyID StandardCrypto
p AssetName
a ->
        forall c. PolicyID c -> AssetName -> MaryValue c -> Integer
lookupMultiAsset PolicyID StandardCrypto
p AssetName
a MaryValue StandardCrypto
x forall a. Eq a => a -> a -> Bool
== Integer
0
          Bool -> Bool -> Bool
|| forall c. PolicyID c -> AssetName -> MaryValue c -> Integer
lookupMultiAsset PolicyID StandardCrypto
p AssetName
a (forall c.
(Integer -> Integer -> Integer)
-> PolicyID c -> AssetName -> Integer -> MaryValue c -> MaryValue c
insertValue forall a. a -> a -> a
pickOld PolicyID StandardCrypto
p AssetName
a Integer
n MaryValue StandardCrypto
x) forall a. Eq a => a -> a -> Bool
== forall c. PolicyID c -> AssetName -> MaryValue c -> Integer
lookupMultiAsset PolicyID StandardCrypto
p AssetName
a MaryValue StandardCrypto
x
    , String
"lookup-insert-retain"
    )
  , (\Integer
n Integer
_ MaryValue StandardCrypto
x PolicyID StandardCrypto
p AssetName
a -> forall t. Val t => t -> Coin
coin (forall c.
(Integer -> Integer -> Integer)
-> PolicyID c -> AssetName -> Integer -> MaryValue c -> MaryValue c
insertValue forall a. a -> a -> a
pickOld PolicyID StandardCrypto
p AssetName
a Integer
n MaryValue StandardCrypto
x) forall a. Eq a => a -> a -> Bool
== forall t. Val t => t -> Coin
coin MaryValue StandardCrypto
x, String
"coinIgnores1")
  , (\Integer
n Integer
_ MaryValue StandardCrypto
x PolicyID StandardCrypto
p AssetName
a -> forall t. Val t => t -> Coin
coin (forall c.
(Integer -> Integer -> Integer)
-> PolicyID c -> AssetName -> Integer -> MaryValue c -> MaryValue c
insertValue forall a. a -> a -> a
pickNew PolicyID StandardCrypto
p AssetName
a Integer
n MaryValue StandardCrypto
x) forall a. Eq a => a -> a -> Bool
== forall t. Val t => t -> Coin
coin MaryValue StandardCrypto
x, String
"coinIgnores2")
  , (\Integer
n Integer
_ MaryValue StandardCrypto
x PolicyID StandardCrypto
p AssetName
a -> forall t. Val t => t -> Coin
coin (forall c.
(Integer -> Integer -> Integer)
-> PolicyID c -> AssetName -> Integer -> MaryValue c -> MaryValue c
insertValue (\Integer
o Integer
_n -> Integer
o forall a. Num a => a -> a -> a
+ Integer
n) PolicyID StandardCrypto
p AssetName
a Integer
n MaryValue StandardCrypto
x) forall a. Eq a => a -> a -> Bool
== forall t. Val t => t -> Coin
coin MaryValue StandardCrypto
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 StandardCrypto
-> PolicyID StandardCrypto
-> AssetName
-> Bool
f, String
n) -> forall a. Testable a => String -> a -> TestTree
testProperty String
n Integer
-> Integer
-> MaryValue StandardCrypto
-> PolicyID StandardCrypto
-> AssetName
-> Bool
f) [(Integer
  -> Integer
  -> MaryValue StandardCrypto
  -> PolicyID StandardCrypto
  -> AssetName
  -> Bool,
  String)]
valuePropList)

valueGroup ::
  [ ( Integer ->
      MaryValue StandardCrypto ->
      MaryValue StandardCrypto ->
      PolicyID StandardCrypto ->
      AssetName ->
      Property
    , String
    )
  ]
valueGroup :: [(Integer
  -> MaryValue StandardCrypto
  -> MaryValue StandardCrypto
  -> PolicyID StandardCrypto
  -> AssetName
  -> Property,
  String)]
valueGroup =
  [
    ( \Integer
_ MaryValue StandardCrypto
x MaryValue StandardCrypto
y PolicyID StandardCrypto
p AssetName
a -> forall c. PolicyID c -> AssetName -> MaryValue c -> Integer
lookupMultiAsset PolicyID StandardCrypto
p AssetName
a (MaryValue StandardCrypto
x forall t. Val t => t -> t -> t
<+> MaryValue StandardCrypto
y) forall a. (Eq a, Show a) => a -> a -> Property
=== forall c. PolicyID c -> AssetName -> MaryValue c -> Integer
lookupMultiAsset PolicyID StandardCrypto
p AssetName
a MaryValue StandardCrypto
x forall a. Num a => a -> a -> a
+ forall c. PolicyID c -> AssetName -> MaryValue c -> Integer
lookupMultiAsset PolicyID StandardCrypto
p AssetName
a MaryValue StandardCrypto
y
    , String
"lookup over <+>"
    )
  ,
    ( \Integer
_ MaryValue StandardCrypto
x MaryValue StandardCrypto
y PolicyID StandardCrypto
p AssetName
a -> forall c. PolicyID c -> AssetName -> MaryValue c -> Integer
lookupMultiAsset PolicyID StandardCrypto
p AssetName
a (MaryValue StandardCrypto
x forall t. Val t => t -> t -> t
<-> MaryValue StandardCrypto
y) forall a. (Eq a, Show a) => a -> a -> Property
=== forall c. PolicyID c -> AssetName -> MaryValue c -> Integer
lookupMultiAsset PolicyID StandardCrypto
p AssetName
a MaryValue StandardCrypto
x forall a. Num a => a -> a -> a
- forall c. PolicyID c -> AssetName -> MaryValue c -> Integer
lookupMultiAsset PolicyID StandardCrypto
p AssetName
a MaryValue StandardCrypto
y
    , String
"lookup over <->"
    )
  , (\Integer
n MaryValue StandardCrypto
x MaryValue StandardCrypto
_ PolicyID StandardCrypto
p AssetName
a -> forall c. PolicyID c -> AssetName -> MaryValue c -> Integer
lookupMultiAsset PolicyID StandardCrypto
p AssetName
a (Integer
n forall t i. (Val t, Integral i) => i -> t -> t
<×> MaryValue StandardCrypto
x) forall a. (Eq a, Show a) => a -> a -> Property
=== Integer
n forall a. Num a => a -> a -> a
* forall c. PolicyID c -> AssetName -> MaryValue c -> Integer
lookupMultiAsset PolicyID StandardCrypto
p AssetName
a MaryValue StandardCrypto
x, String
"lookup over <×>")
  , (\Integer
_ MaryValue StandardCrypto
_ MaryValue StandardCrypto
_ PolicyID StandardCrypto
p AssetName
a -> forall c. PolicyID c -> AssetName -> MaryValue c -> Integer
lookupMultiAsset PolicyID StandardCrypto
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 StandardCrypto
x MaryValue StandardCrypto
_ PolicyID StandardCrypto
p AssetName
a -> forall c. PolicyID c -> AssetName -> MaryValue c -> Integer
lookupMultiAsset PolicyID StandardCrypto
p AssetName
a (forall t. Val t => t -> t
invert MaryValue StandardCrypto
x) forall a. (Eq a, Show a) => a -> a -> Property
=== (-Integer
1) forall a. Num a => a -> a -> a
* forall c. PolicyID c -> AssetName -> MaryValue c -> Integer
lookupMultiAsset PolicyID StandardCrypto
p AssetName
a MaryValue StandardCrypto
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 StandardCrypto
-> MaryValue StandardCrypto
-> PolicyID StandardCrypto
-> AssetName
-> Property
f, String
n) -> forall a. Testable a => String -> a -> TestTree
testProperty String
n Integer
-> MaryValue StandardCrypto
-> MaryValue StandardCrypto
-> PolicyID StandardCrypto
-> AssetName
-> Property
f) [(Integer
  -> MaryValue StandardCrypto
  -> MaryValue StandardCrypto
  -> PolicyID StandardCrypto
  -> AssetName
  -> Property,
  String)]
valueGroup)

compactRoundTrip :: Property
compactRoundTrip :: Property
compactRoundTrip = forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
forAll Gen (MaryValue StandardCrypto)
gen forall a b. (a -> b) -> a -> b
$ \MaryValue StandardCrypto
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 StandardCrypto
v)
    (forall a. a -> Maybe a
Just MaryValue StandardCrypto
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 StandardCrypto
v))
  where
    gen :: Gen (MaryValue StandardCrypto)
gen = do
      [Gen (PolicyID StandardCrypto)]
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 StandardCrypto)
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 StandardCrypto, 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 StandardCrypto
pid <- forall a. HasCallStack => [Gen a] -> Gen a
QC.oneof [Gen (PolicyID StandardCrypto)]
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 StandardCrypto
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 StandardCrypto, AssetName, Integer)]
-> Integer -> MaryValue StandardCrypto
valueFromList [(PolicyID StandardCrypto, 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 StandardCrypto
makeScriptHash :: String -> ScriptHash StandardCrypto
makeScriptHash String
str =
  forall c. Hash (ADDRHASH c) EraIndependentScript -> ScriptHash c
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 StandardCrypto -> MultiAsset StandardCrypto
makeMultiAsset :: ScriptHash StandardCrypto -> MultiAsset StandardCrypto
makeMultiAsset ScriptHash StandardCrypto
sh = forall c. Map (PolicyID c) (Map AssetName Integer) -> MultiAsset c
MultiAsset (forall k a. k -> a -> Map k a
Map.singleton (forall c. ScriptHash c -> PolicyID c
PolicyID ScriptHash StandardCrypto
sh) Map AssetName Integer
oneNonameAsset)

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

exampleMultiAssets :: [MultiAsset StandardCrypto]
exampleMultiAssets :: [MultiAsset StandardCrypto]
exampleMultiAssets = [MultiAsset StandardCrypto
s0, MultiAsset StandardCrypto
s1, MultiAsset StandardCrypto
s2, MultiAsset StandardCrypto
s3, MultiAsset StandardCrypto
s4, MultiAsset StandardCrypto
s5, MultiAsset StandardCrypto
s6, MultiAsset StandardCrypto
s7, MultiAsset StandardCrypto
s8, MultiAsset StandardCrypto
s9, MultiAsset StandardCrypto
s10, MultiAsset StandardCrypto
s11, MultiAsset StandardCrypto
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 StandardCrypto]
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 StandardCrypto]
exampleMultiAssets
      [MultiAsset StandardCrypto]
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 StandardCrypto]
exampleMultiAssets
      let a :: Map (PolicyID StandardCrypto) (Map AssetName Integer)
a = forall a. Monoid a => [a] -> a
mconcat [Map (PolicyID StandardCrypto) (Map AssetName Integer)
m | MultiAsset Map (PolicyID StandardCrypto) (Map AssetName Integer)
m <- [MultiAsset StandardCrypto]
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 StandardCrypto
b = forall a. Monoid a => [a] -> a
mconcat [MultiAsset StandardCrypto]
shuffle2
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$! forall a. NFData a => a -> ()
rnf (forall c. Map (PolicyID c) (Map AssetName Integer) -> MultiAsset c
MultiAsset Map (PolicyID StandardCrypto) (Map AssetName Integer)
a forall a. Semigroup a => a -> a -> a
<> forall m. Group m => m -> m
G.invert MultiAsset StandardCrypto
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 StandardCrypto]
shuffle1 =
          [ ScriptHash StandardCrypto -> MultiAsset StandardCrypto
makeMultiAsset forall a b. (a -> b) -> a -> b
$ String -> ScriptHash StandardCrypto
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 StandardCrypto]
shuffle2 =
          [ ScriptHash StandardCrypto -> MultiAsset StandardCrypto
makeMultiAsset forall a b. (a -> b) -> a -> b
$ String -> ScriptHash StandardCrypto
makeScriptHash String
suffix
          | String
suffix <- [String
"04", String
"08"]
          ]
        multiAssetMap :: Map (PolicyID StandardCrypto) (Map AssetName Integer)
multiAssetMap = forall a. Monoid a => [a] -> a
mconcat [Map (PolicyID StandardCrypto) (Map AssetName Integer)
m | MultiAsset Map (PolicyID StandardCrypto) (Map AssetName Integer)
m <- [MultiAsset StandardCrypto]
shuffle1]
        reproducible :: MultiAsset StandardCrypto
reproducible = forall c. Map (PolicyID c) (Map AssetName Integer) -> MultiAsset c
MultiAsset Map (PolicyID StandardCrypto) (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 StandardCrypto]
shuffle2)
     in forall a. NFData a => a -> ()
rnf MultiAsset StandardCrypto
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
    ]