{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
module Test.Cardano.Ledger.Generic.AggPropTests where
import Cardano.Ledger.Alonzo.Tx (IsValid (..))
import Cardano.Ledger.Compactible (fromCompact)
import Cardano.Ledger.Core
import Cardano.Ledger.Shelley.LedgerState (
EpochState (..),
LedgerState (..),
NewEpochState (..),
UTxOState (..),
)
import Cardano.Ledger.Shelley.Rules.Reports (synopsisCoinMap)
import Cardano.Ledger.Shelley.State
import Cardano.Ledger.Val ((<+>))
import Control.State.Transition (STS (..))
import Data.Foldable as F (foldl')
import qualified Data.Map.Strict as Map
import qualified Data.Set as Set
import Lens.Micro ((^.))
import qualified Prettyprinter as Pretty
import Test.Cardano.Ledger.Binary.TreeDiff (ansiDocToString)
import Test.Cardano.Ledger.Generic.Functions (
getBody,
getCollateralInputs,
getCollateralOutputs,
isValid',
)
import Test.Cardano.Ledger.Generic.GenState (
EraGenericGen,
GenSize (..),
defaultGenSize,
initStableFields,
)
import Test.Cardano.Ledger.Generic.MockChain (MOCKCHAIN, MockBlock (..), MockChainState (..))
import Test.Cardano.Ledger.Generic.Proof (
AllegraEra,
AlonzoEra,
BabbageEra,
MaryEra,
Proof (..),
ShelleyEra,
)
import Test.Cardano.Ledger.Generic.Trace (Gen1, genTrace, testPropMax)
import Test.Control.State.Transition.Trace (
SourceSignalTarget (..),
Trace (..),
TraceOrder (..),
firstAndLastState,
sourceSignalTargets,
traceSignals,
)
import Test.Control.State.Transition.Trace.Generator.QuickCheck (HasTrace (..))
import Test.QuickCheck
import Test.Tasty
import Test.Tasty.QuickCheck (testProperty)
aggProp ::
agg -> (agg -> Signal sts -> agg) -> (State sts -> State sts -> agg -> prop) -> Trace sts -> prop
aggProp :: forall agg sts prop.
agg
-> (agg -> Signal sts -> agg)
-> (State sts -> State sts -> agg -> prop)
-> Trace sts
-> prop
aggProp agg
agg0 agg -> Signal sts -> agg
aggregate State sts -> State sts -> agg -> prop
test Trace sts
trace = State sts -> State sts -> agg -> prop
test State sts
firstState State sts
lastState ((agg -> Signal sts -> agg) -> agg -> [Signal sts] -> agg
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
F.foldl' agg -> Signal sts -> agg
aggregate agg
agg0 [Signal sts]
sigs)
where
sigs :: [Signal sts]
sigs = TraceOrder -> Trace sts -> [Signal sts]
forall s. TraceOrder -> Trace s -> [Signal s]
traceSignals TraceOrder
OldestFirst Trace sts
trace
(State sts
firstState, State sts
lastState) = Trace sts -> (State sts, State sts)
forall s. Trace s -> (State s, State s)
firstAndLastState Trace sts
trace
consistentUtxoSizeProp :: EraTx era => Proof era -> Trace (MOCKCHAIN era) -> Property
consistentUtxoSizeProp :: forall era.
EraTx era =>
Proof era -> Trace (MOCKCHAIN era) -> Property
consistentUtxoSizeProp Proof era
proof = Int
-> (Int -> Signal (MOCKCHAIN era) -> Int)
-> (State (MOCKCHAIN era)
-> State (MOCKCHAIN era) -> Int -> Property)
-> Trace (MOCKCHAIN era)
-> Property
forall agg sts prop.
agg
-> (agg -> Signal sts -> agg)
-> (State sts -> State sts -> agg -> prop)
-> Trace sts
-> prop
aggProp Int
agg0 Int -> Signal (MOCKCHAIN era) -> Int
Int -> MockBlock era -> Int
aggregate State (MOCKCHAIN era) -> State (MOCKCHAIN era) -> Int -> Property
MockChainState era -> MockChainState era -> Int -> Property
forall {era} {era}.
MockChainState era -> MockChainState era -> Int -> Property
makeprop
where
agg0 :: Int
agg0 = Int
0
aggregate :: Int -> MockBlock era -> Int
aggregate Int
count (MockBlock KeyHash 'StakePool
_ SlotNo
_ StrictSeq (Tx era)
txs) = (Int -> Tx era -> Int) -> Int -> StrictSeq (Tx era) -> Int
forall b a. (b -> a -> b) -> b -> StrictSeq a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
F.foldl' Int -> Tx era -> Int
aggTx Int
count StrictSeq (Tx era)
txs
aggTx :: Int -> Tx era -> Int
aggTx Int
count Tx era
tx =
Int
count
Int -> Int -> Int
forall a. Num a => a -> a -> a
+ ( if Bool
valid
then StrictSeq (TxOut era) -> Int
forall a. StrictSeq a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (TxBody era
body TxBody era
-> Getting
(StrictSeq (TxOut era)) (TxBody era) (StrictSeq (TxOut era))
-> StrictSeq (TxOut era)
forall s a. s -> Getting a s a -> a
^. Getting
(StrictSeq (TxOut era)) (TxBody era) (StrictSeq (TxOut era))
forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxOut era))
Lens' (TxBody era) (StrictSeq (TxOut era))
outputsTxBodyL) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Set TxIn -> Int
forall a. Set a -> Int
Set.size (TxBody era
body TxBody era
-> Getting (Set TxIn) (TxBody era) (Set TxIn) -> Set TxIn
forall s a. s -> Getting a s a -> a
^. Getting (Set TxIn) (TxBody era) (Set TxIn)
forall era. EraTxBody era => Lens' (TxBody era) (Set TxIn)
Lens' (TxBody era) (Set TxIn)
inputsTxBodyL)
else [TxOut era] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Proof era -> TxBody era -> [TxOut era]
forall era. Proof era -> TxBody era -> [TxOut era]
getCollateralOutputs Proof era
proof TxBody era
body) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Set TxIn -> Int
forall a. Set a -> Int
Set.size (Proof era -> TxBody era -> Set TxIn
forall era. Proof era -> TxBody era -> Set TxIn
getCollateralInputs Proof era
proof TxBody era
body)
)
where
body :: TxBody era
body = Proof era -> Tx era -> TxBody era
forall era. EraTx era => Proof era -> Tx era -> TxBody era
getBody Proof era
proof Tx era
tx
IsValid Bool
valid = Proof era -> Tx era -> IsValid
forall era. Proof era -> Tx era -> IsValid
isValid' Proof era
proof Tx era
tx
makeprop :: MockChainState era -> MockChainState era -> Int -> Property
makeprop MockChainState era
firstSt MockChainState era
lastSt Int
n = MockChainState era -> Int
forall era. MockChainState era -> Int
getUtxoSize MockChainState era
firstSt Int -> Int -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== MockChainState era -> Int
forall era. MockChainState era -> Int
getUtxoSize MockChainState era
lastSt Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n
getUtxoSize :: MockChainState era -> Int
getUtxoSize :: forall era. MockChainState era -> Int
getUtxoSize = Map TxIn (TxOut era) -> Int
forall k a. Map k a -> Int
Map.size (Map TxIn (TxOut era) -> Int)
-> (MockChainState era -> Map TxIn (TxOut era))
-> MockChainState era
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTxO era -> Map TxIn (TxOut era)
forall era. UTxO era -> Map TxIn (TxOut era)
unUTxO (UTxO era -> Map TxIn (TxOut era))
-> (MockChainState era -> UTxO era)
-> MockChainState era
-> Map TxIn (TxOut era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTxOState era -> UTxO era
forall era. UTxOState era -> UTxO era
utxosUtxo (UTxOState era -> UTxO era)
-> (MockChainState era -> UTxOState era)
-> MockChainState era
-> UTxO era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LedgerState era -> UTxOState era
forall era. LedgerState era -> UTxOState era
lsUTxOState (LedgerState era -> UTxOState era)
-> (MockChainState era -> LedgerState era)
-> MockChainState era
-> UTxOState era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EpochState era -> LedgerState era
forall era. EpochState era -> LedgerState era
esLState (EpochState era -> LedgerState era)
-> (MockChainState era -> EpochState era)
-> MockChainState era
-> LedgerState era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NewEpochState era -> EpochState era
forall era. NewEpochState era -> EpochState era
nesEs (NewEpochState era -> EpochState era)
-> (MockChainState era -> NewEpochState era)
-> MockChainState era
-> EpochState era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MockChainState era -> NewEpochState era
forall era. MockChainState era -> NewEpochState era
mcsNes
aggUTxO ::
forall era.
( HasTrace (MOCKCHAIN era) (Gen1 era)
, EraGenericGen era
, ShelleyEraAccounts era
) =>
Proof era ->
Gen Property
aggUTxO :: forall era.
(HasTrace (MOCKCHAIN era) (Gen1 era), EraGenericGen era,
ShelleyEraAccounts era) =>
Proof era -> Gen Property
aggUTxO Proof era
proof = do
Trace (MOCKCHAIN era)
trace1 <- Int -> GenSize -> GenRS era () -> Gen (Trace (MOCKCHAIN era))
forall era.
(HasTrace (MOCKCHAIN era) (Gen1 era), EraGenericGen era,
ShelleyEraAccounts era) =>
Int -> GenSize -> GenRS era () -> Gen (Trace (MOCKCHAIN era))
genTrace Int
100 (GenSize
defaultGenSize {blocksizeMax = 4, slotDelta = (6, 12)}) GenRS era ()
forall era. Reflect era => GenRS era ()
initStableFields
Property -> Gen Property
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Property -> Gen Property) -> Property -> Gen Property
forall a b. (a -> b) -> a -> b
$ Proof era -> Trace (MOCKCHAIN era) -> Property
forall era.
EraTx era =>
Proof era -> Trace (MOCKCHAIN era) -> Property
consistentUtxoSizeProp Proof era
proof Trace (MOCKCHAIN era)
trace1
aggTests :: TestTree
aggTests :: TestTree
aggTests =
TestName -> [TestTree] -> TestTree
testGroup
TestName
"tests, aggregating Tx's over a Trace."
[ Int -> TestName -> Gen Property -> TestTree
forall prop. Testable prop => Int -> TestName -> prop -> TestTree
testPropMax Int
30 TestName
"UTxO size in Babbage" (Proof BabbageEra -> Gen Property
forall era.
(HasTrace (MOCKCHAIN era) (Gen1 era), EraGenericGen era,
ShelleyEraAccounts era) =>
Proof era -> Gen Property
aggUTxO Proof BabbageEra
Babbage)
, Int -> TestName -> Gen Property -> TestTree
forall prop. Testable prop => Int -> TestName -> prop -> TestTree
testPropMax Int
30 TestName
"UTxO size in Alonzo" (Proof AlonzoEra -> Gen Property
forall era.
(HasTrace (MOCKCHAIN era) (Gen1 era), EraGenericGen era,
ShelleyEraAccounts era) =>
Proof era -> Gen Property
aggUTxO Proof AlonzoEra
Alonzo)
, Int -> TestName -> Gen Property -> TestTree
forall prop. Testable prop => Int -> TestName -> prop -> TestTree
testPropMax Int
30 TestName
"UTxO size in Mary" (Proof MaryEra -> Gen Property
forall era.
(HasTrace (MOCKCHAIN era) (Gen1 era), EraGenericGen era,
ShelleyEraAccounts era) =>
Proof era -> Gen Property
aggUTxO Proof MaryEra
Mary)
]
forAllChainTrace ::
( Testable prop
, HasTrace (MOCKCHAIN era) (Gen1 era)
, EraGenericGen era
, ShelleyEraAccounts era
) =>
Int -> (Trace (MOCKCHAIN era) -> prop) -> Property
forAllChainTrace :: forall prop era.
(Testable prop, HasTrace (MOCKCHAIN era) (Gen1 era),
EraGenericGen era, ShelleyEraAccounts era) =>
Int -> (Trace (MOCKCHAIN era) -> prop) -> Property
forAllChainTrace Int
n Trace (MOCKCHAIN era) -> prop
propf =
Gen prop -> Property
forall prop. Testable prop => prop -> Property
property (Gen prop -> Property) -> Gen prop -> Property
forall a b. (a -> b) -> a -> b
$
Trace (MOCKCHAIN era) -> prop
propf (Trace (MOCKCHAIN era) -> prop)
-> Gen (Trace (MOCKCHAIN era)) -> Gen prop
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> GenSize -> GenRS era () -> Gen (Trace (MOCKCHAIN era))
forall era.
(HasTrace (MOCKCHAIN era) (Gen1 era), EraGenericGen era,
ShelleyEraAccounts era) =>
Int -> GenSize -> GenRS era () -> Gen (Trace (MOCKCHAIN era))
genTrace Int
n (GenSize
defaultGenSize {blocksizeMax = 4, slotDelta = (6, 12)}) GenRS era ()
forall era. Reflect era => GenRS era ()
initStableFields
depositInvariant ::
EraCertState era =>
SourceSignalTarget (MOCKCHAIN era) ->
Property
depositInvariant :: forall era.
EraCertState era =>
SourceSignalTarget (MOCKCHAIN era) -> Property
depositInvariant SourceSignalTarget {source :: forall a. SourceSignalTarget a -> State a
source = State (MOCKCHAIN era)
mockChainSt} =
let LedgerState {lsUTxOState :: forall era. LedgerState era -> UTxOState era
lsUTxOState = UTxOState era
utxost, lsCertState :: forall era. LedgerState era -> CertState era
lsCertState = CertState era
certState} = (EpochState era -> LedgerState era
forall era. EpochState era -> LedgerState era
esLState (EpochState era -> LedgerState era)
-> (MockChainState era -> EpochState era)
-> MockChainState era
-> LedgerState era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NewEpochState era -> EpochState era
forall era. NewEpochState era -> EpochState era
nesEs (NewEpochState era -> EpochState era)
-> (MockChainState era -> NewEpochState era)
-> MockChainState era
-> EpochState era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MockChainState era -> NewEpochState era
forall era. MockChainState era -> NewEpochState era
mcsNes) State (MOCKCHAIN era)
MockChainState era
mockChainSt
pstate :: PState era
pstate = CertState era
certState CertState era
-> Getting (PState era) (CertState era) (PState era) -> PState era
forall s a. s -> Getting a s a -> a
^. Getting (PState era) (CertState era) (PState era)
forall era. EraCertState era => Lens' (CertState era) (PState era)
Lens' (CertState era) (PState era)
certPStateL
accountsMap :: Map (Credential 'Staking) (AccountState era)
accountsMap = CertState era
certState CertState era
-> Getting
(Map (Credential 'Staking) (AccountState era))
(CertState era)
(Map (Credential 'Staking) (AccountState era))
-> Map (Credential 'Staking) (AccountState era)
forall s a. s -> Getting a s a -> a
^. (DState era
-> Const
(Map (Credential 'Staking) (AccountState era)) (DState era))
-> CertState era
-> Const
(Map (Credential 'Staking) (AccountState era)) (CertState era)
forall era. EraCertState era => Lens' (CertState era) (DState era)
Lens' (CertState era) (DState era)
certDStateL ((DState era
-> Const
(Map (Credential 'Staking) (AccountState era)) (DState era))
-> CertState era
-> Const
(Map (Credential 'Staking) (AccountState era)) (CertState era))
-> ((Map (Credential 'Staking) (AccountState era)
-> Const
(Map (Credential 'Staking) (AccountState era))
(Map (Credential 'Staking) (AccountState era)))
-> DState era
-> Const
(Map (Credential 'Staking) (AccountState era)) (DState era))
-> Getting
(Map (Credential 'Staking) (AccountState era))
(CertState era)
(Map (Credential 'Staking) (AccountState era))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Accounts era
-> Const
(Map (Credential 'Staking) (AccountState era)) (Accounts era))
-> DState era
-> Const
(Map (Credential 'Staking) (AccountState era)) (DState era)
forall era. Lens' (DState era) (Accounts era)
forall (t :: * -> *) era.
CanSetAccounts t =>
Lens' (t era) (Accounts era)
accountsL ((Accounts era
-> Const
(Map (Credential 'Staking) (AccountState era)) (Accounts era))
-> DState era
-> Const
(Map (Credential 'Staking) (AccountState era)) (DState era))
-> ((Map (Credential 'Staking) (AccountState era)
-> Const
(Map (Credential 'Staking) (AccountState era))
(Map (Credential 'Staking) (AccountState era)))
-> Accounts era
-> Const
(Map (Credential 'Staking) (AccountState era)) (Accounts era))
-> (Map (Credential 'Staking) (AccountState era)
-> Const
(Map (Credential 'Staking) (AccountState era))
(Map (Credential 'Staking) (AccountState era)))
-> DState era
-> Const
(Map (Credential 'Staking) (AccountState era)) (DState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map (Credential 'Staking) (AccountState era)
-> Const
(Map (Credential 'Staking) (AccountState era))
(Map (Credential 'Staking) (AccountState era)))
-> Accounts era
-> Const
(Map (Credential 'Staking) (AccountState era)) (Accounts era)
forall era.
EraAccounts era =>
Lens' (Accounts era) (Map (Credential 'Staking) (AccountState era))
Lens' (Accounts era) (Map (Credential 'Staking) (AccountState era))
accountsMapL
allDeposits :: Coin
allDeposits = UTxOState era -> Coin
forall era. UTxOState era -> Coin
utxosDeposited UTxOState era
utxost
keyDeposits :: Coin
keyDeposits = CompactForm Coin -> Coin
forall a. Compactible a => CompactForm a -> a
fromCompact (CompactForm Coin -> Coin) -> CompactForm Coin -> Coin
forall a b. (a -> b) -> a -> b
$ (AccountState era -> CompactForm Coin)
-> Map (Credential 'Staking) (AccountState era) -> CompactForm Coin
forall m a.
Monoid m =>
(a -> m) -> Map (Credential 'Staking) a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (AccountState era
-> Getting (CompactForm Coin) (AccountState era) (CompactForm Coin)
-> CompactForm Coin
forall s a. s -> Getting a s a -> a
^. Getting (CompactForm Coin) (AccountState era) (CompactForm Coin)
forall era.
EraAccounts era =>
Lens' (AccountState era) (CompactForm Coin)
Lens' (AccountState era) (CompactForm Coin)
depositAccountStateL) Map (Credential 'Staking) (AccountState era)
accountsMap
poolDeposits :: Coin
poolDeposits = (CompactForm Coin -> Coin)
-> Map (KeyHash 'StakePool) (CompactForm Coin) -> Coin
forall m a. Monoid m => (a -> m) -> Map (KeyHash 'StakePool) a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap CompactForm Coin -> Coin
forall a. Compactible a => CompactForm a -> a
fromCompact (PState era -> Map (KeyHash 'StakePool) (CompactForm Coin)
forall era.
PState era -> Map (KeyHash 'StakePool) (CompactForm Coin)
psDeposits PState era
pstate)
in TestName -> Property -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample
( Doc AnsiStyle -> TestName
ansiDocToString (Doc AnsiStyle -> TestName)
-> ([Doc AnsiStyle] -> Doc AnsiStyle)
-> [Doc AnsiStyle]
-> TestName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc AnsiStyle] -> Doc AnsiStyle
forall ann. [Doc ann] -> Doc ann
Pretty.vsep ([Doc AnsiStyle] -> TestName) -> [Doc AnsiStyle] -> TestName
forall a b. (a -> b) -> a -> b
$
[ Doc AnsiStyle
"Deposit invariant fails:"
, Int -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Int -> Doc ann -> Doc ann
Pretty.indent Int
2 (Doc AnsiStyle -> Doc AnsiStyle)
-> ([TestName] -> Doc AnsiStyle) -> [TestName] -> Doc AnsiStyle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc AnsiStyle] -> Doc AnsiStyle
forall ann. [Doc ann] -> Doc ann
Pretty.vsep ([Doc AnsiStyle] -> Doc AnsiStyle)
-> ([TestName] -> [Doc AnsiStyle]) -> [TestName] -> Doc AnsiStyle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TestName -> Doc AnsiStyle) -> [TestName] -> [Doc AnsiStyle]
forall a b. (a -> b) -> [a] -> [b]
map TestName -> Doc AnsiStyle
forall ann. TestName -> Doc ann
forall a ann. Pretty a => a -> Doc ann
Pretty.pretty ([TestName] -> Doc AnsiStyle) -> [TestName] -> Doc AnsiStyle
forall a b. (a -> b) -> a -> b
$
[ TestName
"All deposits = " TestName -> TestName -> TestName
forall a. [a] -> [a] -> [a]
++ Coin -> TestName
forall a. Show a => a -> TestName
show Coin
allDeposits
, TestName
"Key deposits = "
TestName -> TestName -> TestName
forall a. [a] -> [a] -> [a]
++ Maybe (Map (Credential 'Staking) Coin) -> TestName
forall k. Maybe (Map k Coin) -> TestName
synopsisCoinMap (Map (Credential 'Staking) Coin
-> Maybe (Map (Credential 'Staking) Coin)
forall a. a -> Maybe a
Just ((AccountState era -> Coin)
-> Map (Credential 'Staking) (AccountState era)
-> Map (Credential 'Staking) Coin
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (CompactForm Coin -> Coin
forall a. Compactible a => CompactForm a -> a
fromCompact (CompactForm Coin -> Coin)
-> (AccountState era -> CompactForm Coin)
-> AccountState era
-> Coin
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AccountState era
-> Getting (CompactForm Coin) (AccountState era) (CompactForm Coin)
-> CompactForm Coin
forall s a. s -> Getting a s a -> a
^. Getting (CompactForm Coin) (AccountState era) (CompactForm Coin)
forall era.
EraAccounts era =>
Lens' (AccountState era) (CompactForm Coin)
Lens' (AccountState era) (CompactForm Coin)
depositAccountStateL)) Map (Credential 'Staking) (AccountState era)
accountsMap))
, TestName
"Pool deposits = " TestName -> TestName -> TestName
forall a. [a] -> [a] -> [a]
++ Maybe (Map (KeyHash 'StakePool) Coin) -> TestName
forall k. Maybe (Map k Coin) -> TestName
synopsisCoinMap (Map (KeyHash 'StakePool) Coin
-> Maybe (Map (KeyHash 'StakePool) Coin)
forall a. a -> Maybe a
Just (CompactForm Coin -> Coin
forall a. Compactible a => CompactForm a -> a
fromCompact (CompactForm Coin -> Coin)
-> Map (KeyHash 'StakePool) (CompactForm Coin)
-> Map (KeyHash 'StakePool) Coin
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PState era -> Map (KeyHash 'StakePool) (CompactForm Coin)
forall era.
PState era -> Map (KeyHash 'StakePool) (CompactForm Coin)
psDeposits PState era
pstate))
]
]
)
(Coin
allDeposits Coin -> Coin -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== Coin
keyDeposits Coin -> Coin -> Coin
forall t. Val t => t -> t -> t
<+> Coin
poolDeposits)
itemPropToTraceProp ::
(SourceSignalTarget (MOCKCHAIN era) -> Property) -> Trace (MOCKCHAIN era) -> Property
itemPropToTraceProp :: forall era.
(SourceSignalTarget (MOCKCHAIN era) -> Property)
-> Trace (MOCKCHAIN era) -> Property
itemPropToTraceProp SourceSignalTarget (MOCKCHAIN era) -> Property
f Trace (MOCKCHAIN era)
trace1 = [Property] -> Property
forall prop. Testable prop => [prop] -> Property
conjoin ((SourceSignalTarget (MOCKCHAIN era) -> Property)
-> [SourceSignalTarget (MOCKCHAIN era)] -> [Property]
forall a b. (a -> b) -> [a] -> [b]
map SourceSignalTarget (MOCKCHAIN era) -> Property
f (Trace (MOCKCHAIN era) -> [SourceSignalTarget (MOCKCHAIN era)]
forall a. Trace a -> [SourceSignalTarget a]
sourceSignalTargets Trace (MOCKCHAIN era)
trace1))
depositEra ::
forall era.
( HasTrace (MOCKCHAIN era) (Gen1 era)
, EraGenericGen era
, ShelleyEraAccounts era
) =>
TestTree
depositEra :: forall era.
(HasTrace (MOCKCHAIN era) (Gen1 era), EraGenericGen era,
ShelleyEraAccounts era) =>
TestTree
depositEra =
TestName -> [TestTree] -> TestTree
testGroup
(forall era. Era era => TestName
eraName @era)
[ TestName -> Property -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty
TestName
"Deposits = KeyDeposits + PoolDeposits"
(Int -> (Trace (MOCKCHAIN era) -> Property) -> Property
forall prop era.
(Testable prop, HasTrace (MOCKCHAIN era) (Gen1 era),
EraGenericGen era, ShelleyEraAccounts era) =>
Int -> (Trace (MOCKCHAIN era) -> prop) -> Property
forAllChainTrace Int
10 ((SourceSignalTarget (MOCKCHAIN era) -> Property)
-> Trace (MOCKCHAIN era) -> Property
forall era.
(SourceSignalTarget (MOCKCHAIN era) -> Property)
-> Trace (MOCKCHAIN era) -> Property
itemPropToTraceProp (forall era.
EraCertState era =>
SourceSignalTarget (MOCKCHAIN era) -> Property
depositInvariant @era)))
]
depositTests :: TestTree
depositTests :: TestTree
depositTests =
TestName -> [TestTree] -> TestTree
testGroup
TestName
"deposit invariants"
[ forall era.
(HasTrace (MOCKCHAIN era) (Gen1 era), EraGenericGen era,
ShelleyEraAccounts era) =>
TestTree
depositEra @ShelleyEra
, forall era.
(HasTrace (MOCKCHAIN era) (Gen1 era), EraGenericGen era,
ShelleyEraAccounts era) =>
TestTree
depositEra @AllegraEra
, forall era.
(HasTrace (MOCKCHAIN era) (Gen1 era), EraGenericGen era,
ShelleyEraAccounts era) =>
TestTree
depositEra @MaryEra
, forall era.
(HasTrace (MOCKCHAIN era) (Gen1 era), EraGenericGen era,
ShelleyEraAccounts era) =>
TestTree
depositEra @AlonzoEra
, forall era.
(HasTrace (MOCKCHAIN era) (Gen1 era), EraGenericGen era,
ShelleyEraAccounts era) =>
TestTree
depositEra @BabbageEra
]