{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE NumericUnderscores #-}
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}

-- |
-- Module      : Test.Cardano.Ledger.Shelley.Examples.TwoPools
-- Description : Two Pools Example
--
-- Example demonstrating a particular delegation scenario involving
-- two pools. Both pools select a reward account which is *not*
-- a pool owner, and which delegates to one of the pools.
module Test.Cardano.Ledger.Shelley.Examples.TwoPools (
  twoPoolsExample,
  twoPoolsExampleExtended,
) where

import Cardano.Ledger.BaseTypes (
  BlocksMade (..),
  BoundedRational (..),
  Globals (..),
  Network (..),
  Nonce,
  ProtVer (..),
  StrictMaybe (..),
  activeSlotVal,
  mkCertIxPartial,
  natVersion,
  (⭒),
 )
import Cardano.Ledger.Block (Block, bheader)
import Cardano.Ledger.Coin (
  Coin (..),
  CompactForm (CompactCoin),
  DeltaCoin (..),
  compactCoinOrError,
  rationalToCoinViaFloor,
  toDeltaCoin,
 )
import Cardano.Ledger.Credential (Credential, Ptr (..), SlotNo32 (..))
import Cardano.Ledger.Keys (asWitness, coerceKeyRole)
import Cardano.Ledger.PoolParams (PoolParams (..))
import Cardano.Ledger.Shelley
import Cardano.Ledger.Shelley.Core
import Cardano.Ledger.Shelley.LedgerState (
  PulsingRewUpdate (..),
  RewardUpdate (..),
  completeStep,
  emptyRewardUpdate,
 )
import Cardano.Ledger.Shelley.PoolRank (
  Likelihood (..),
  NonMyopic (..),
  leaderProbability,
  likelihood,
 )
import Cardano.Ledger.Shelley.Rewards (
  StakeShare (..),
  aggregateRewards,
  leaderRew,
  memberRew,
  mkApparentPerformance,
  sumRewards,
 )
import Cardano.Ledger.Shelley.Tx (
  ShelleyTx (..),
 )
import Cardano.Ledger.Shelley.TxBody (RewardAccount (..))
import Cardano.Ledger.Shelley.TxOut (ShelleyTxOut (..))
import Cardano.Ledger.Shelley.TxWits (
  addrWits,
 )
import Cardano.Ledger.Slot (
  BlockNo (..),
  EpochNo (..),
  SlotNo (..),
 )
import Cardano.Ledger.State (IndividualPoolStake (..), PoolDistr (..), SnapShot (..), UTxO, maxPool)
import Cardano.Ledger.TxIn (TxIn (..))
import Cardano.Ledger.Val ((<+>), (<->), (<×>))
import qualified Cardano.Ledger.Val as Val
import Cardano.Protocol.TPraos.BHeader (BHeader, bhHash, hashHeaderToNonce)
import Cardano.Protocol.TPraos.OCert (KESPeriod (..))
import Data.Default (def)
import Data.Group (invert)
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.Ratio ((%))
import qualified Data.Sequence.Strict as StrictSeq
import Data.Set (Set)
import qualified Data.Set as Set
import GHC.Stack (HasCallStack)
import Lens.Micro ((&), (.~), (^.))
import Test.Cardano.Ledger.Core.KeyPair (mkWitnessesVKey)
import Test.Cardano.Ledger.Shelley.ConcreteCryptoTypes (C, MockCrypto)
import Test.Cardano.Ledger.Shelley.Examples (CHAINExample (..), testCHAINExample)
import qualified Test.Cardano.Ledger.Shelley.Examples.Cast as Cast
import qualified Test.Cardano.Ledger.Shelley.Examples.Combinators as C
import Test.Cardano.Ledger.Shelley.Examples.Federation (
  coreNodeKeysBySchedule,
 )
import Test.Cardano.Ledger.Shelley.Examples.Init (
  initSt,
  lastByronHeaderHash,
  nonce0,
  ppEx,
 )
import Test.Cardano.Ledger.Shelley.Examples.PoolLifetime (makeCompletedPulser, mkStake)
import Test.Cardano.Ledger.Shelley.Generator.Core (
  AllIssuerKeys (..),
  NatNonce (..),
  genesisCoins,
  mkBlockFakeVRF,
  mkOCert,
 )
import Test.Cardano.Ledger.Shelley.Generator.EraGen (genesisId)
import Test.Cardano.Ledger.Shelley.Generator.ShelleyEraGen ()
import Test.Cardano.Ledger.Shelley.Rules.Chain (ChainState (..))
import Test.Cardano.Ledger.Shelley.Utils (
  epochSize,
  getBlockNonce,
  maxLLSupply,
  runShelleyBase,
  testGlobals,
  unsafeBoundRational,
 )
import Test.Tasty (TestTree, testGroup)
import Test.Tasty.HUnit (Assertion, testCase, (@?=))

aliceInitCoin :: Coin
aliceInitCoin :: Coin
aliceInitCoin = Integer -> Coin
Coin Integer
10_000_000_000_000_000

bobInitCoin :: Coin
bobInitCoin :: Coin
bobInitCoin = Integer -> Coin
Coin Integer
1_000_000_000_000_000

carlInitCoin :: Coin
carlInitCoin :: Coin
carlInitCoin = Integer -> Coin
Coin Integer
5_000_000_000_000_000

initUTxO :: UTxO C
initUTxO :: UTxO C
initUTxO =
  TxId -> [TxOut C] -> UTxO C
forall era. TxId -> [TxOut era] -> UTxO era
genesisCoins
    TxId
genesisId
    [ Addr -> Value C -> ShelleyTxOut C
forall era.
(HasCallStack, Era era, Val (Value era)) =>
Addr -> Value era -> ShelleyTxOut era
ShelleyTxOut Addr
Cast.aliceAddr (Coin -> Coin
forall t s. Inject t s => t -> s
Val.inject Coin
aliceInitCoin)
    , Addr -> Value C -> ShelleyTxOut C
forall era.
(HasCallStack, Era era, Val (Value era)) =>
Addr -> Value era -> ShelleyTxOut era
ShelleyTxOut Addr
Cast.bobAddr (Coin -> Coin
forall t s. Inject t s => t -> s
Val.inject Coin
bobInitCoin)
    , Addr -> Value C -> ShelleyTxOut C
forall era.
(HasCallStack, Era era, Val (Value era)) =>
Addr -> Value era -> ShelleyTxOut era
ShelleyTxOut Addr
Cast.carlAddr (Coin -> Coin
forall t s. Inject t s => t -> s
Val.inject Coin
carlInitCoin)
    ]

initStTwoPools :: ChainState C
initStTwoPools :: ChainState C
initStTwoPools = UTxO C -> ChainState C
forall era.
(EraTxOut era, EraGov era, EraStake era, EraCertState era,
 ProtVerAtMost era 4, ProtVerAtMost era 6,
 Default (StashedAVVMAddresses era)) =>
UTxO era -> ChainState era
initSt UTxO C
initUTxO

--
-- Block 1, Slot 10, Epoch 0
--

aliceCoinEx1 :: Coin
aliceCoinEx1 :: Coin
aliceCoinEx1 =
  Coin
aliceInitCoin
    Coin -> Coin -> Coin
forall t. Val t => t -> t -> t
<-> ((Integer
2 :: Integer) Integer -> Coin -> Coin
forall i. Integral i => i -> Coin -> Coin
forall t i. (Val t, Integral i) => i -> t -> t
<×> Integer -> Coin
Coin Integer
250)
    Coin -> Coin -> Coin
forall t. Val t => t -> t -> t
<-> ((Integer
3 :: Integer) Integer -> Coin -> Coin
forall i. Integral i => i -> Coin -> Coin
forall t i. (Val t, Integral i) => i -> t -> t
<×> Integer -> Coin
Coin Integer
7)
    Coin -> Coin -> Coin
forall t. Val t => t -> t -> t
<-> Coin
feeTx1

feeTx1 :: Coin
feeTx1 :: Coin
feeTx1 = Integer -> Coin
Coin Integer
3

alicePoolParams' :: PoolParams
alicePoolParams' :: PoolParams
alicePoolParams' = PoolParams
Cast.alicePoolParams {ppRewardAccount = RewardAccount Testnet Cast.carlSHK}

bobPoolParams' :: PoolParams
bobPoolParams' :: PoolParams
bobPoolParams' = PoolParams
Cast.bobPoolParams {ppRewardAccount = RewardAccount Testnet Cast.carlSHK}

txbodyEx1 :: TxBody C
txbodyEx1 :: TxBody C
txbodyEx1 =
  Set TxIn
-> StrictSeq (TxOut C)
-> StrictSeq (TxCert C)
-> Withdrawals
-> Coin
-> SlotNo
-> StrictMaybe (Update C)
-> StrictMaybe TxAuxDataHash
-> TxBody C
ShelleyTxBody
    ([TxIn] -> Set TxIn
forall a. Ord a => [a] -> Set a
Set.fromList [TxId -> TxIx -> TxIn
TxIn TxId
genesisId TxIx
forall a. Bounded a => a
minBound])
    ([ShelleyTxOut C] -> StrictSeq (ShelleyTxOut C)
forall a. [a] -> StrictSeq a
StrictSeq.fromList [Addr -> Value C -> ShelleyTxOut C
forall era.
(HasCallStack, Era era, Val (Value era)) =>
Addr -> Value era -> ShelleyTxOut era
ShelleyTxOut Addr
Cast.aliceAddr (Coin -> Coin
forall t s. Inject t s => t -> s
Val.inject Coin
aliceCoinEx1)])
    ( [ShelleyTxCert C] -> StrictSeq (ShelleyTxCert C)
forall a. [a] -> StrictSeq a
StrictSeq.fromList
        [ Credential 'Staking -> TxCert C
forall era.
ShelleyEraTxCert era =>
Credential 'Staking -> TxCert era
RegTxCert Credential 'Staking
Cast.aliceSHK
        , Credential 'Staking -> TxCert C
forall era.
ShelleyEraTxCert era =>
Credential 'Staking -> TxCert era
RegTxCert Credential 'Staking
Cast.bobSHK
        , Credential 'Staking -> TxCert C
forall era.
ShelleyEraTxCert era =>
Credential 'Staking -> TxCert era
RegTxCert Credential 'Staking
Cast.carlSHK
        , PoolParams -> TxCert C
forall era. EraTxCert era => PoolParams -> TxCert era
RegPoolTxCert PoolParams
alicePoolParams'
        , PoolParams -> TxCert C
forall era. EraTxCert era => PoolParams -> TxCert era
RegPoolTxCert PoolParams
bobPoolParams'
        , Credential 'Staking -> KeyHash 'StakePool -> TxCert C
forall era.
ShelleyEraTxCert era =>
Credential 'Staking -> KeyHash 'StakePool -> TxCert era
DelegStakeTxCert Credential 'Staking
Cast.aliceSHK (AllIssuerKeys MockCrypto 'StakePool -> KeyHash 'StakePool
forall c (r :: KeyRole). AllIssuerKeys c r -> KeyHash r
aikColdKeyHash AllIssuerKeys MockCrypto 'StakePool
Cast.alicePoolKeys)
        , Credential 'Staking -> KeyHash 'StakePool -> TxCert C
forall era.
ShelleyEraTxCert era =>
Credential 'Staking -> KeyHash 'StakePool -> TxCert era
DelegStakeTxCert Credential 'Staking
Cast.bobSHK (AllIssuerKeys MockCrypto 'StakePool -> KeyHash 'StakePool
forall c (r :: KeyRole). AllIssuerKeys c r -> KeyHash r
aikColdKeyHash AllIssuerKeys MockCrypto 'StakePool
Cast.bobPoolKeys)
        , Credential 'Staking -> KeyHash 'StakePool -> TxCert C
forall era.
ShelleyEraTxCert era =>
Credential 'Staking -> KeyHash 'StakePool -> TxCert era
DelegStakeTxCert Credential 'Staking
Cast.carlSHK (AllIssuerKeys MockCrypto 'StakePool -> KeyHash 'StakePool
forall c (r :: KeyRole). AllIssuerKeys c r -> KeyHash r
aikColdKeyHash AllIssuerKeys MockCrypto 'StakePool
Cast.alicePoolKeys)
        ]
    )
    (Map RewardAccount Coin -> Withdrawals
Withdrawals Map RewardAccount Coin
forall k a. Map k a
Map.empty)
    Coin
feeTx1
    (Word64 -> SlotNo
SlotNo Word64
10)
    StrictMaybe (Update C)
forall a. StrictMaybe a
SNothing
    StrictMaybe TxAuxDataHash
forall a. StrictMaybe a
SNothing

txEx1 :: ShelleyTx C
txEx1 :: ShelleyTx C
txEx1 =
  TxBody C -> TxWits C -> StrictMaybe (TxAuxData C) -> ShelleyTx C
forall era.
EraTx era =>
TxBody era
-> TxWits era -> StrictMaybe (TxAuxData era) -> ShelleyTx era
ShelleyTx
    TxBody C
txbodyEx1
    ShelleyTxWits C
forall a. Monoid a => a
mempty
      { addrWits =
          mkWitnessesVKey
            (hashAnnotated txbodyEx1)
            ( (asWitness <$> [Cast.alicePay])
                <> (asWitness <$> [Cast.aliceStake, Cast.bobStake, Cast.carlStake])
                <> (asWitness <$> [aikCold Cast.alicePoolKeys, aikCold Cast.bobPoolKeys])
            )
      }
    StrictMaybe (TxAuxData C)
StrictMaybe (ShelleyTxAuxData C)
forall a. StrictMaybe a
SNothing

blockEx1 :: HasCallStack => Block (BHeader MockCrypto) C
blockEx1 :: HasCallStack => Block (BHeader MockCrypto) C
blockEx1 =
  HashHeader
-> AllIssuerKeys MockCrypto 'GenesisDelegate
-> [Tx C]
-> SlotNo
-> BlockNo
-> Nonce
-> NatNonce
-> UnitInterval
-> Word
-> Word
-> OCert MockCrypto
-> Block (BHeader MockCrypto) C
forall era (r :: KeyRole) c.
(Crypto c, EraSegWits era, Signable (VRF c) (WithResult Seed),
 Signable (KES c) (BHBody c)) =>
HashHeader
-> AllIssuerKeys c r
-> [Tx era]
-> SlotNo
-> BlockNo
-> Nonce
-> NatNonce
-> UnitInterval
-> Word
-> Word
-> OCert c
-> Block (BHeader c) era
mkBlockFakeVRF
    HashHeader
lastByronHeaderHash
    (forall era.
(HasCallStack, EraPParams era) =>
PParams era -> Word64 -> AllIssuerKeys MockCrypto 'GenesisDelegate
coreNodeKeysBySchedule @C PParams C
forall era.
(EraPParams era, ProtVerAtMost era 4, ProtVerAtMost era 6) =>
PParams era
ppEx Word64
10)
    [Item [ShelleyTx C]
ShelleyTx C
txEx1]
    (Word64 -> SlotNo
SlotNo Word64
10)
    (Word64 -> BlockNo
BlockNo Word64
1)
    Nonce
nonce0
    (Natural -> NatNonce
NatNonce Natural
1)
    UnitInterval
forall a. Bounded a => a
minBound
    Word
0
    Word
0
    (AllIssuerKeys MockCrypto 'GenesisDelegate
-> Word64 -> KESPeriod -> OCert MockCrypto
forall c (r :: KeyRole).
Crypto c =>
AllIssuerKeys c r -> Word64 -> KESPeriod -> OCert c
mkOCert (forall era.
(HasCallStack, EraPParams era) =>
PParams era -> Word64 -> AllIssuerKeys MockCrypto 'GenesisDelegate
coreNodeKeysBySchedule @C PParams C
forall era.
(EraPParams era, ProtVerAtMost era 4, ProtVerAtMost era 6) =>
PParams era
ppEx Word64
10) Word64
0 (Word -> KESPeriod
KESPeriod Word
0))

expectedStEx1 :: ChainState C
expectedStEx1 :: ChainState C
expectedStEx1 =
  Nonce -> ChainState C -> ChainState C
forall era. Nonce -> ChainState era -> ChainState era
C.evolveNonceUnfrozen (Block (BHeader MockCrypto) C -> Nonce
forall era. Block (BHeader MockCrypto) era -> Nonce
getBlockNonce Block (BHeader MockCrypto) C
HasCallStack => Block (BHeader MockCrypto) C
blockEx1)
    (ChainState C -> ChainState C)
-> (ChainState C -> ChainState C) -> ChainState C -> ChainState C
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Block (BHeader MockCrypto) C -> ChainState C -> ChainState C
forall era.
Block (BHeader MockCrypto) era -> ChainState era -> ChainState era
C.newLab Block (BHeader MockCrypto) C
HasCallStack => Block (BHeader MockCrypto) C
blockEx1
    (ChainState C -> ChainState C)
-> (ChainState C -> ChainState C) -> ChainState C -> ChainState C
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PParams C
-> Coin
-> [Credential 'Staking]
-> [PoolParams]
-> ChainState C
-> ChainState C
forall era.
(EraPParams era, EraCertState era) =>
PParams era
-> Coin
-> [Credential 'Staking]
-> [PoolParams]
-> ChainState era
-> ChainState era
C.feesAndDeposits
      PParams C
forall era.
(EraPParams era, ProtVerAtMost era 4, ProtVerAtMost era 6) =>
PParams era
ppEx
      Coin
feeTx1
      [Item [Credential 'Staking]
Credential 'Staking
Cast.aliceSHK, Item [Credential 'Staking]
Credential 'Staking
Cast.bobSHK, Item [Credential 'Staking]
Credential 'Staking
Cast.carlSHK]
      [Item [PoolParams]
PoolParams
alicePoolParams', Item [PoolParams]
PoolParams
bobPoolParams']
    (ChainState C -> ChainState C)
-> (ChainState C -> ChainState C) -> ChainState C -> ChainState C
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxBody C -> ChainState C -> ChainState C
forall era.
(EraTx era, EraStake era) =>
TxBody era -> ChainState era -> ChainState era
C.newUTxO TxBody C
txbodyEx1
    (ChainState C -> ChainState C)
-> (ChainState C -> ChainState C) -> ChainState C -> ChainState C
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Credential 'Staking -> Ptr -> ChainState C -> ChainState C
forall era.
EraCertState era =>
Credential 'Staking -> Ptr -> ChainState era -> ChainState era
C.newStakeCred Credential 'Staking
Cast.aliceSHK (SlotNo32 -> TxIx -> CertIx -> Ptr
Ptr (Word32 -> SlotNo32
SlotNo32 Word32
10) TxIx
forall a. Bounded a => a
minBound (HasCallStack => Integer -> CertIx
Integer -> CertIx
mkCertIxPartial Integer
0))
    (ChainState C -> ChainState C)
-> (ChainState C -> ChainState C) -> ChainState C -> ChainState C
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Credential 'Staking -> Ptr -> ChainState C -> ChainState C
forall era.
EraCertState era =>
Credential 'Staking -> Ptr -> ChainState era -> ChainState era
C.newStakeCred Credential 'Staking
Cast.bobSHK (SlotNo32 -> TxIx -> CertIx -> Ptr
Ptr (Word32 -> SlotNo32
SlotNo32 Word32
10) TxIx
forall a. Bounded a => a
minBound (HasCallStack => Integer -> CertIx
Integer -> CertIx
mkCertIxPartial Integer
1))
    (ChainState C -> ChainState C)
-> (ChainState C -> ChainState C) -> ChainState C -> ChainState C
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Credential 'Staking -> Ptr -> ChainState C -> ChainState C
forall era.
EraCertState era =>
Credential 'Staking -> Ptr -> ChainState era -> ChainState era
C.newStakeCred Credential 'Staking
Cast.carlSHK (SlotNo32 -> TxIx -> CertIx -> Ptr
Ptr (Word32 -> SlotNo32
SlotNo32 Word32
10) TxIx
forall a. Bounded a => a
minBound (HasCallStack => Integer -> CertIx
Integer -> CertIx
mkCertIxPartial Integer
2))
    (ChainState C -> ChainState C)
-> (ChainState C -> ChainState C) -> ChainState C -> ChainState C
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PoolParams -> ChainState C -> ChainState C
forall era.
EraCertState era =>
PoolParams -> ChainState era -> ChainState era
C.newPool PoolParams
alicePoolParams'
    (ChainState C -> ChainState C)
-> (ChainState C -> ChainState C) -> ChainState C -> ChainState C
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PoolParams -> ChainState C -> ChainState C
forall era.
EraCertState era =>
PoolParams -> ChainState era -> ChainState era
C.newPool PoolParams
bobPoolParams'
    (ChainState C -> ChainState C)
-> (ChainState C -> ChainState C) -> ChainState C -> ChainState C
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Credential 'Staking
-> KeyHash 'StakePool -> ChainState C -> ChainState C
forall era.
EraCertState era =>
Credential 'Staking
-> KeyHash 'StakePool -> ChainState era -> ChainState era
C.delegation Credential 'Staking
Cast.aliceSHK (PoolParams -> KeyHash 'StakePool
ppId PoolParams
alicePoolParams')
    (ChainState C -> ChainState C)
-> (ChainState C -> ChainState C) -> ChainState C -> ChainState C
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Credential 'Staking
-> KeyHash 'StakePool -> ChainState C -> ChainState C
forall era.
EraCertState era =>
Credential 'Staking
-> KeyHash 'StakePool -> ChainState era -> ChainState era
C.delegation Credential 'Staking
Cast.bobSHK (PoolParams -> KeyHash 'StakePool
ppId PoolParams
bobPoolParams')
    (ChainState C -> ChainState C)
-> (ChainState C -> ChainState C) -> ChainState C -> ChainState C
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Credential 'Staking
-> KeyHash 'StakePool -> ChainState C -> ChainState C
forall era.
EraCertState era =>
Credential 'Staking
-> KeyHash 'StakePool -> ChainState era -> ChainState era
C.delegation Credential 'Staking
Cast.carlSHK (PoolParams -> KeyHash 'StakePool
ppId PoolParams
alicePoolParams')
    (ChainState C -> ChainState C) -> ChainState C -> ChainState C
forall a b. (a -> b) -> a -> b
$ ChainState C
initStTwoPools

-- === Block 1, Slot 10, Epoch 0
--
-- In the first block of this example, Alice, Bob, and Carl register
-- stake credentials, Alice and Bob register stake pools,
-- Alice and Carl delegate to Alice's pool, and Bob delegates to Bob's pool.
--
-- This is the only block in this example that includes a transaction,
-- and after this block is processed, the UTxO will consist entirely
-- of Alice's new coin aliceCoinEx1, and Bob and Carls initial genesis coins.
twoPools1 :: CHAINExample C
twoPools1 :: CHAINExample C
twoPools1 = ChainState C
-> Block (BHeader MockCrypto) C
-> Either (NonEmpty (PredicateFailure (CHAIN C))) (ChainState C)
-> CHAINExample C
forall era.
ChainState era
-> Block (BHeader MockCrypto) era
-> Either
     (NonEmpty (PredicateFailure (CHAIN era))) (ChainState era)
-> CHAINExample era
CHAINExample ChainState C
initStTwoPools Block (BHeader MockCrypto) C
HasCallStack => Block (BHeader MockCrypto) C
blockEx1 (ChainState C
-> Either (NonEmpty (TestChainPredicateFailure C)) (ChainState C)
forall a b. b -> Either a b
Right ChainState C
expectedStEx1)

--
-- Block 2, Slot 90, Epoch 0
--
blockEx2 :: Block (BHeader MockCrypto) C
blockEx2 :: Block (BHeader MockCrypto) C
blockEx2 =
  HashHeader
-> AllIssuerKeys MockCrypto 'GenesisDelegate
-> [Tx C]
-> SlotNo
-> BlockNo
-> Nonce
-> NatNonce
-> UnitInterval
-> Word
-> Word
-> OCert MockCrypto
-> Block (BHeader MockCrypto) C
forall era (r :: KeyRole) c.
(Crypto c, EraSegWits era, Signable (VRF c) (WithResult Seed),
 Signable (KES c) (BHBody c)) =>
HashHeader
-> AllIssuerKeys c r
-> [Tx era]
-> SlotNo
-> BlockNo
-> Nonce
-> NatNonce
-> UnitInterval
-> Word
-> Word
-> OCert c
-> Block (BHeader c) era
mkBlockFakeVRF
    (BHeader MockCrypto -> HashHeader
forall c. BHeader c -> HashHeader
bhHash (BHeader MockCrypto -> HashHeader)
-> BHeader MockCrypto -> HashHeader
forall a b. (a -> b) -> a -> b
$ Block (BHeader MockCrypto) C -> BHeader MockCrypto
forall h era. Block h era -> h
bheader Block (BHeader MockCrypto) C
HasCallStack => Block (BHeader MockCrypto) C
blockEx1)
    (forall era.
(HasCallStack, EraPParams era) =>
PParams era -> Word64 -> AllIssuerKeys MockCrypto 'GenesisDelegate
coreNodeKeysBySchedule @C PParams C
forall era.
(EraPParams era, ProtVerAtMost era 4, ProtVerAtMost era 6) =>
PParams era
ppEx Word64
90)
    []
    (Word64 -> SlotNo
SlotNo Word64
90)
    (Word64 -> BlockNo
BlockNo Word64
2)
    Nonce
nonce0
    (Natural -> NatNonce
NatNonce Natural
2)
    UnitInterval
forall a. Bounded a => a
minBound
    Word
4
    Word
0
    (AllIssuerKeys MockCrypto 'GenesisDelegate
-> Word64 -> KESPeriod -> OCert MockCrypto
forall c (r :: KeyRole).
Crypto c =>
AllIssuerKeys c r -> Word64 -> KESPeriod -> OCert c
mkOCert (forall era.
(HasCallStack, EraPParams era) =>
PParams era -> Word64 -> AllIssuerKeys MockCrypto 'GenesisDelegate
coreNodeKeysBySchedule @C PParams C
forall era.
(EraPParams era, ProtVerAtMost era 4, ProtVerAtMost era 6) =>
PParams era
ppEx Word64
90) Word64
0 (Word -> KESPeriod
KESPeriod Word
0))

expectedStEx2 :: ChainState C
expectedStEx2 :: ChainState C
expectedStEx2 =
  Nonce -> ChainState C -> ChainState C
forall era. Nonce -> ChainState era -> ChainState era
C.evolveNonceFrozen (Block (BHeader MockCrypto) C -> Nonce
forall era. Block (BHeader MockCrypto) era -> Nonce
getBlockNonce Block (BHeader MockCrypto) C
blockEx2)
    (ChainState C -> ChainState C)
-> (ChainState C -> ChainState C) -> ChainState C -> ChainState C
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Block (BHeader MockCrypto) C -> ChainState C -> ChainState C
forall era.
Block (BHeader MockCrypto) era -> ChainState era -> ChainState era
C.newLab Block (BHeader MockCrypto) C
blockEx2
    (ChainState C -> ChainState C)
-> (ChainState C -> ChainState C) -> ChainState C -> ChainState C
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RewardUpdate -> ChainState C -> ChainState C
forall era. RewardUpdate -> ChainState era -> ChainState era
C.rewardUpdate RewardUpdate
emptyRewardUpdate
    (ChainState C -> ChainState C) -> ChainState C -> ChainState C
forall a b. (a -> b) -> a -> b
$ ChainState C
expectedStEx1

-- === Block 2, Slot 90, Epoch 0
--
-- Create an empty block near the end of epoch 0 to close out the epoch.
twoPools2 :: CHAINExample C
twoPools2 :: CHAINExample C
twoPools2 = ChainState C
-> Block (BHeader MockCrypto) C
-> Either (NonEmpty (PredicateFailure (CHAIN C))) (ChainState C)
-> CHAINExample C
forall era.
ChainState era
-> Block (BHeader MockCrypto) era
-> Either
     (NonEmpty (PredicateFailure (CHAIN era))) (ChainState era)
-> CHAINExample era
CHAINExample ChainState C
expectedStEx1 Block (BHeader MockCrypto) C
blockEx2 (ChainState C
-> Either (NonEmpty (TestChainPredicateFailure C)) (ChainState C)
forall a b. b -> Either a b
Right ChainState C
expectedStEx2)

--
-- Block 3, Slot 110, Epoch 1
--

epoch1Nonce :: Nonce
epoch1Nonce :: Nonce
epoch1Nonce = ChainState C -> Nonce
forall era. ChainState era -> Nonce
chainCandidateNonce ChainState C
expectedStEx2

blockEx3 :: Block (BHeader MockCrypto) C
blockEx3 :: Block (BHeader MockCrypto) C
blockEx3 =
  HashHeader
-> AllIssuerKeys MockCrypto 'GenesisDelegate
-> [Tx C]
-> SlotNo
-> BlockNo
-> Nonce
-> NatNonce
-> UnitInterval
-> Word
-> Word
-> OCert MockCrypto
-> Block (BHeader MockCrypto) C
forall era (r :: KeyRole) c.
(Crypto c, EraSegWits era, Signable (VRF c) (WithResult Seed),
 Signable (KES c) (BHBody c)) =>
HashHeader
-> AllIssuerKeys c r
-> [Tx era]
-> SlotNo
-> BlockNo
-> Nonce
-> NatNonce
-> UnitInterval
-> Word
-> Word
-> OCert c
-> Block (BHeader c) era
mkBlockFakeVRF
    (BHeader MockCrypto -> HashHeader
forall c. BHeader c -> HashHeader
bhHash (BHeader MockCrypto -> HashHeader)
-> BHeader MockCrypto -> HashHeader
forall a b. (a -> b) -> a -> b
$ Block (BHeader MockCrypto) C -> BHeader MockCrypto
forall h era. Block h era -> h
bheader Block (BHeader MockCrypto) C
blockEx2)
    (forall era.
(HasCallStack, EraPParams era) =>
PParams era -> Word64 -> AllIssuerKeys MockCrypto 'GenesisDelegate
coreNodeKeysBySchedule @C PParams C
forall era.
(EraPParams era, ProtVerAtMost era 4, ProtVerAtMost era 6) =>
PParams era
ppEx Word64
110)
    []
    (Word64 -> SlotNo
SlotNo Word64
110)
    (Word64 -> BlockNo
BlockNo Word64
3)
    Nonce
epoch1Nonce
    (Natural -> NatNonce
NatNonce Natural
3)
    UnitInterval
forall a. Bounded a => a
minBound
    Word
5
    Word
0
    (AllIssuerKeys MockCrypto 'GenesisDelegate
-> Word64 -> KESPeriod -> OCert MockCrypto
forall c (r :: KeyRole).
Crypto c =>
AllIssuerKeys c r -> Word64 -> KESPeriod -> OCert c
mkOCert (forall era.
(HasCallStack, EraPParams era) =>
PParams era -> Word64 -> AllIssuerKeys MockCrypto 'GenesisDelegate
coreNodeKeysBySchedule @C PParams C
forall era.
(EraPParams era, ProtVerAtMost era 4, ProtVerAtMost era 6) =>
PParams era
ppEx Word64
110) Word64
0 (Word -> KESPeriod
KESPeriod Word
0))

snapEx3 :: SnapShot
snapEx3 :: SnapShot
snapEx3 =
  SnapShot
    { $sel:ssStake:SnapShot :: Stake
ssStake =
        [(Credential 'Staking, Coin)] -> Stake
mkStake
          [ (Credential 'Staking
Cast.aliceSHK, Coin
aliceCoinEx1)
          , (Credential 'Staking
Cast.bobSHK, Coin
bobInitCoin)
          , (Credential 'Staking
Cast.carlSHK, Coin
carlInitCoin)
          ]
    , $sel:ssDelegations:SnapShot :: VMap VB VB (Credential 'Staking) (KeyHash 'StakePool)
ssDelegations =
        [ (Credential 'Staking
Cast.aliceSHK, AllIssuerKeys MockCrypto 'StakePool -> KeyHash 'StakePool
forall c (r :: KeyRole). AllIssuerKeys c r -> KeyHash r
aikColdKeyHash AllIssuerKeys MockCrypto 'StakePool
Cast.alicePoolKeys)
        , (Credential 'Staking
Cast.bobSHK, AllIssuerKeys MockCrypto 'StakePool -> KeyHash 'StakePool
forall c (r :: KeyRole). AllIssuerKeys c r -> KeyHash r
aikColdKeyHash AllIssuerKeys MockCrypto 'StakePool
Cast.bobPoolKeys)
        , (Credential 'Staking
Cast.carlSHK, AllIssuerKeys MockCrypto 'StakePool -> KeyHash 'StakePool
forall c (r :: KeyRole). AllIssuerKeys c r -> KeyHash r
aikColdKeyHash AllIssuerKeys MockCrypto 'StakePool
Cast.alicePoolKeys)
        ]
    , $sel:ssPoolParams:SnapShot :: VMap VB VB (KeyHash 'StakePool) PoolParams
ssPoolParams =
        [ (AllIssuerKeys MockCrypto 'StakePool -> KeyHash 'StakePool
forall c (r :: KeyRole). AllIssuerKeys c r -> KeyHash r
aikColdKeyHash AllIssuerKeys MockCrypto 'StakePool
Cast.alicePoolKeys, PoolParams
alicePoolParams')
        , (AllIssuerKeys MockCrypto 'StakePool -> KeyHash 'StakePool
forall c (r :: KeyRole). AllIssuerKeys c r -> KeyHash r
aikColdKeyHash AllIssuerKeys MockCrypto 'StakePool
Cast.bobPoolKeys, PoolParams
bobPoolParams')
        ]
    }

expectedStEx3 :: ChainState C
expectedStEx3 :: ChainState C
expectedStEx3 =
  Block (BHeader MockCrypto) C -> ChainState C -> ChainState C
forall era.
(ProtVerAtMost era 6, EraGov era) =>
Block (BHeader MockCrypto) era -> ChainState era -> ChainState era
C.newEpoch Block (BHeader MockCrypto) C
blockEx3
    (ChainState C -> ChainState C)
-> (ChainState C -> ChainState C) -> ChainState C -> ChainState C
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SnapShot -> Coin -> ChainState C -> ChainState C
forall era. SnapShot -> Coin -> ChainState era -> ChainState era
C.newSnapshot SnapShot
snapEx3 Coin
feeTx1
    (ChainState C -> ChainState C)
-> (ChainState C -> ChainState C) -> ChainState C -> ChainState C
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RewardUpdate -> ChainState C -> ChainState C
forall era.
(EraGov era, EraCertState era) =>
RewardUpdate -> ChainState era -> ChainState era
C.applyRewardUpdate RewardUpdate
emptyRewardUpdate
    (ChainState C -> ChainState C) -> ChainState C -> ChainState C
forall a b. (a -> b) -> a -> b
$ ChainState C
expectedStEx2

-- === Block 3, Slot 110, Epoch 1
--
-- Create an empty block at the begining of epoch 1 to trigger the epoch change.
twoPools3 :: CHAINExample C
twoPools3 :: CHAINExample C
twoPools3 = ChainState C
-> Block (BHeader MockCrypto) C
-> Either (NonEmpty (PredicateFailure (CHAIN C))) (ChainState C)
-> CHAINExample C
forall era.
ChainState era
-> Block (BHeader MockCrypto) era
-> Either
     (NonEmpty (PredicateFailure (CHAIN era))) (ChainState era)
-> CHAINExample era
CHAINExample ChainState C
expectedStEx2 Block (BHeader MockCrypto) C
blockEx3 (ChainState C
-> Either (NonEmpty (TestChainPredicateFailure C)) (ChainState C)
forall a b. b -> Either a b
Right ChainState C
expectedStEx3)

--
-- Block 4, Slot 190, Epoch 1
--

blockEx4 :: Block (BHeader MockCrypto) C
blockEx4 :: Block (BHeader MockCrypto) C
blockEx4 =
  HashHeader
-> AllIssuerKeys MockCrypto 'GenesisDelegate
-> [Tx C]
-> SlotNo
-> BlockNo
-> Nonce
-> NatNonce
-> UnitInterval
-> Word
-> Word
-> OCert MockCrypto
-> Block (BHeader MockCrypto) C
forall era (r :: KeyRole) c.
(Crypto c, EraSegWits era, Signable (VRF c) (WithResult Seed),
 Signable (KES c) (BHBody c)) =>
HashHeader
-> AllIssuerKeys c r
-> [Tx era]
-> SlotNo
-> BlockNo
-> Nonce
-> NatNonce
-> UnitInterval
-> Word
-> Word
-> OCert c
-> Block (BHeader c) era
mkBlockFakeVRF
    (BHeader MockCrypto -> HashHeader
forall c. BHeader c -> HashHeader
bhHash (BHeader MockCrypto -> HashHeader)
-> BHeader MockCrypto -> HashHeader
forall a b. (a -> b) -> a -> b
$ Block (BHeader MockCrypto) C -> BHeader MockCrypto
forall h era. Block h era -> h
bheader Block (BHeader MockCrypto) C
blockEx3)
    (forall era.
(HasCallStack, EraPParams era) =>
PParams era -> Word64 -> AllIssuerKeys MockCrypto 'GenesisDelegate
coreNodeKeysBySchedule @C PParams C
forall era.
(EraPParams era, ProtVerAtMost era 4, ProtVerAtMost era 6) =>
PParams era
ppEx Word64
190)
    []
    (Word64 -> SlotNo
SlotNo Word64
190)
    (Word64 -> BlockNo
BlockNo Word64
4)
    Nonce
epoch1Nonce
    (Natural -> NatNonce
NatNonce Natural
4)
    UnitInterval
forall a. Bounded a => a
minBound
    Word
9
    Word
0
    (AllIssuerKeys MockCrypto 'GenesisDelegate
-> Word64 -> KESPeriod -> OCert MockCrypto
forall c (r :: KeyRole).
Crypto c =>
AllIssuerKeys c r -> Word64 -> KESPeriod -> OCert c
mkOCert (forall era.
(HasCallStack, EraPParams era) =>
PParams era -> Word64 -> AllIssuerKeys MockCrypto 'GenesisDelegate
coreNodeKeysBySchedule @C PParams C
forall era.
(EraPParams era, ProtVerAtMost era 4, ProtVerAtMost era 6) =>
PParams era
ppEx Word64
190) Word64
0 (Word -> KESPeriod
KESPeriod Word
0))

deltaREx4 :: Coin
deltaREx4 :: Coin
deltaREx4 = Integer -> Coin
Coin Integer
3

rewardUpdateEx4 :: RewardUpdate
rewardUpdateEx4 :: RewardUpdate
rewardUpdateEx4 =
  RewardUpdate
    { deltaT :: DeltaCoin
deltaT = Integer -> DeltaCoin
DeltaCoin Integer
0
    , deltaR :: DeltaCoin
deltaR = Coin -> DeltaCoin
toDeltaCoin Coin
deltaREx4 -- No rewards paid out, fees go to reserves
    , rs :: Map (Credential 'Staking) (Set Reward)
rs = Map (Credential 'Staking) (Set Reward)
forall k a. Map k a
Map.empty
    , deltaF :: DeltaCoin
deltaF = DeltaCoin -> DeltaCoin
forall m. Group m => m -> m
invert (DeltaCoin -> DeltaCoin) -> DeltaCoin -> DeltaCoin
forall a b. (a -> b) -> a -> b
$ Coin -> DeltaCoin
toDeltaCoin Coin
feeTx1
    , nonMyopic :: NonMyopic
nonMyopic = NonMyopic
forall a. Default a => a
def {rewardPotNM = feeTx1}
    }

expectedStEx4 :: ChainState C
expectedStEx4 :: ChainState C
expectedStEx4 =
  Nonce -> ChainState C -> ChainState C
forall era. Nonce -> ChainState era -> ChainState era
C.evolveNonceFrozen (Block (BHeader MockCrypto) C -> Nonce
forall era. Block (BHeader MockCrypto) era -> Nonce
getBlockNonce Block (BHeader MockCrypto) C
blockEx4)
    (ChainState C -> ChainState C)
-> (ChainState C -> ChainState C) -> ChainState C -> ChainState C
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Block (BHeader MockCrypto) C -> ChainState C -> ChainState C
forall era.
Block (BHeader MockCrypto) era -> ChainState era -> ChainState era
C.newLab Block (BHeader MockCrypto) C
blockEx4
    (ChainState C -> ChainState C)
-> (ChainState C -> ChainState C) -> ChainState C -> ChainState C
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RewardUpdate -> ChainState C -> ChainState C
forall era. RewardUpdate -> ChainState era -> ChainState era
C.rewardUpdate RewardUpdate
rewardUpdateEx4
    (ChainState C -> ChainState C) -> ChainState C -> ChainState C
forall a b. (a -> b) -> a -> b
$ ChainState C
expectedStEx3

-- === Block 4, Slot 190, Epoch 1
--
-- Create an empty block near the end of epoch 0 to close out the epoch,
-- preparing the way for the first non-empty pool distribution.
twoPools4 :: CHAINExample C
twoPools4 :: CHAINExample C
twoPools4 = ChainState C
-> Block (BHeader MockCrypto) C
-> Either (NonEmpty (PredicateFailure (CHAIN C))) (ChainState C)
-> CHAINExample C
forall era.
ChainState era
-> Block (BHeader MockCrypto) era
-> Either
     (NonEmpty (PredicateFailure (CHAIN era))) (ChainState era)
-> CHAINExample era
CHAINExample ChainState C
expectedStEx3 Block (BHeader MockCrypto) C
blockEx4 (ChainState C
-> Either (NonEmpty (TestChainPredicateFailure C)) (ChainState C)
forall a b. b -> Either a b
Right ChainState C
expectedStEx4)

epoch2Nonce :: Nonce
epoch2Nonce :: Nonce
epoch2Nonce =
  ChainState C -> Nonce
forall era. ChainState era -> Nonce
chainCandidateNonce ChainState C
expectedStEx4
    Nonce -> Nonce -> Nonce
⭒ HashHeader -> Nonce
hashHeaderToNonce (BHeader MockCrypto -> HashHeader
forall c. BHeader c -> HashHeader
bhHash (BHeader MockCrypto -> HashHeader)
-> BHeader MockCrypto -> HashHeader
forall a b. (a -> b) -> a -> b
$ Block (BHeader MockCrypto) C -> BHeader MockCrypto
forall h era. Block h era -> h
bheader Block (BHeader MockCrypto) C
blockEx2)

--
-- Block 5, Slot 221, Epoch 2
--

blockEx5 :: Block (BHeader MockCrypto) C
blockEx5 :: Block (BHeader MockCrypto) C
blockEx5 =
  HashHeader
-> AllIssuerKeys MockCrypto 'StakePool
-> [Tx C]
-> SlotNo
-> BlockNo
-> Nonce
-> NatNonce
-> UnitInterval
-> Word
-> Word
-> OCert MockCrypto
-> Block (BHeader MockCrypto) C
forall era (r :: KeyRole) c.
(Crypto c, EraSegWits era, Signable (VRF c) (WithResult Seed),
 Signable (KES c) (BHBody c)) =>
HashHeader
-> AllIssuerKeys c r
-> [Tx era]
-> SlotNo
-> BlockNo
-> Nonce
-> NatNonce
-> UnitInterval
-> Word
-> Word
-> OCert c
-> Block (BHeader c) era
mkBlockFakeVRF
    (BHeader MockCrypto -> HashHeader
forall c. BHeader c -> HashHeader
bhHash (BHeader MockCrypto -> HashHeader)
-> BHeader MockCrypto -> HashHeader
forall a b. (a -> b) -> a -> b
$ Block (BHeader MockCrypto) C -> BHeader MockCrypto
forall h era. Block h era -> h
bheader Block (BHeader MockCrypto) C
blockEx4)
    AllIssuerKeys MockCrypto 'StakePool
Cast.alicePoolKeys
    []
    (Word64 -> SlotNo
SlotNo Word64
221) -- odd slots open for decentralization
    (Word64 -> BlockNo
BlockNo Word64
5)
    Nonce
epoch2Nonce
    (Natural -> NatNonce
NatNonce Natural
5)
    UnitInterval
forall a. Bounded a => a
minBound
    Word
11
    Word
10
    (AllIssuerKeys MockCrypto 'StakePool
-> Word64 -> KESPeriod -> OCert MockCrypto
forall c (r :: KeyRole).
Crypto c =>
AllIssuerKeys c r -> Word64 -> KESPeriod -> OCert c
mkOCert AllIssuerKeys MockCrypto 'StakePool
Cast.alicePoolKeys Word64
0 (Word -> KESPeriod
KESPeriod Word
10))

activeStakeEx5 :: Integer
activeStakeEx5 :: Integer
activeStakeEx5 = [Integer] -> Integer
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Integer] -> Integer) -> [Integer] -> Integer
forall a b. (a -> b) -> a -> b
$ (Coin -> Integer) -> [Coin] -> [Integer]
forall a b. (a -> b) -> [a] -> [b]
map Coin -> Integer
unCoin [Item [Coin]
Coin
aliceCoinEx1, Item [Coin]
Coin
bobInitCoin, Item [Coin]
Coin
carlInitCoin]

alicePoolStake :: Rational
alicePoolStake :: Rational
alicePoolStake = (Coin -> Integer
unCoin Coin
aliceCoinEx1 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Coin -> Integer
unCoin Coin
carlInitCoin) Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
activeStakeEx5

bobPoolStake :: Rational
bobPoolStake :: Rational
bobPoolStake = Coin -> Integer
unCoin Coin
bobInitCoin Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
activeStakeEx5

pdEx5 :: PoolDistr
pdEx5 :: PoolDistr
pdEx5 =
  Map (KeyHash 'StakePool) IndividualPoolStake
-> CompactForm Coin -> PoolDistr
PoolDistr
    ( [(KeyHash 'StakePool, IndividualPoolStake)]
-> Map (KeyHash 'StakePool) IndividualPoolStake
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
        [
          ( AllIssuerKeys MockCrypto 'StakePool -> KeyHash 'StakePool
forall c (r :: KeyRole). AllIssuerKeys c r -> KeyHash r
aikColdKeyHash AllIssuerKeys MockCrypto 'StakePool
Cast.alicePoolKeys
          , Rational
-> CompactForm Coin
-> VRFVerKeyHash 'StakePoolVRF
-> IndividualPoolStake
IndividualPoolStake
              Rational
alicePoolStake
              (HasCallStack => Coin -> CompactForm Coin
Coin -> CompactForm Coin
compactCoinOrError (Coin -> CompactForm Coin) -> Coin -> CompactForm Coin
forall a b. (a -> b) -> a -> b
$ Coin
aliceCoinEx1 Coin -> Coin -> Coin
forall a. Semigroup a => a -> a -> a
<> Coin
carlInitCoin)
              VRFVerKeyHash 'StakePoolVRF
Cast.aliceVRFKeyHash
          )
        ,
          ( AllIssuerKeys MockCrypto 'StakePool -> KeyHash 'StakePool
forall c (r :: KeyRole). AllIssuerKeys c r -> KeyHash r
aikColdKeyHash AllIssuerKeys MockCrypto 'StakePool
Cast.bobPoolKeys
          , Rational
-> CompactForm Coin
-> VRFVerKeyHash 'StakePoolVRF
-> IndividualPoolStake
IndividualPoolStake
              Rational
bobPoolStake
              (HasCallStack => Coin -> CompactForm Coin
Coin -> CompactForm Coin
compactCoinOrError Coin
bobInitCoin)
              VRFVerKeyHash 'StakePoolVRF
Cast.bobVRFKeyHash
          )
        ]
    )
    (Word64 -> CompactForm Coin
CompactCoin (Word64 -> CompactForm Coin) -> Word64 -> CompactForm Coin
forall a b. (a -> b) -> a -> b
$ Integer -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
activeStakeEx5)

expectedStEx5 :: ChainState C
expectedStEx5 :: ChainState C
expectedStEx5 =
  KeyHash 'StakePool -> ChainState C -> ChainState C
forall era. KeyHash 'StakePool -> ChainState era -> ChainState era
C.incrBlockCount (AllIssuerKeys MockCrypto 'StakePool -> KeyHash 'StakePool
forall c (r :: KeyRole). AllIssuerKeys c r -> KeyHash r
aikColdKeyHash AllIssuerKeys MockCrypto 'StakePool
Cast.alicePoolKeys)
    (ChainState C -> ChainState C)
-> (ChainState C -> ChainState C) -> ChainState C -> ChainState C
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SnapShot -> Coin -> ChainState C -> ChainState C
forall era. SnapShot -> Coin -> ChainState era -> ChainState era
C.newSnapshot SnapShot
snapEx3 (Integer -> Coin
Coin Integer
0)
    (ChainState C -> ChainState C)
-> (ChainState C -> ChainState C) -> ChainState C -> ChainState C
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RewardUpdate -> ChainState C -> ChainState C
forall era.
(EraGov era, EraCertState era) =>
RewardUpdate -> ChainState era -> ChainState era
C.applyRewardUpdate RewardUpdate
rewardUpdateEx4
    (ChainState C -> ChainState C)
-> (ChainState C -> ChainState C) -> ChainState C -> ChainState C
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PoolDistr -> ChainState C -> ChainState C
forall era. PoolDistr -> ChainState era -> ChainState era
C.setPoolDistr PoolDistr
pdEx5
    (ChainState C -> ChainState C)
-> (ChainState C -> ChainState C) -> ChainState C -> ChainState C
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyHash 'BlockIssuer -> Word64 -> ChainState C -> ChainState C
forall era.
KeyHash 'BlockIssuer -> Word64 -> ChainState era -> ChainState era
C.setOCertCounter (KeyHash 'StakePool -> KeyHash 'BlockIssuer
forall (r :: KeyRole) (r' :: KeyRole). KeyHash r -> KeyHash r'
forall (a :: KeyRole -> *) (r :: KeyRole) (r' :: KeyRole).
HasKeyRole a =>
a r -> a r'
coerceKeyRole (KeyHash 'StakePool -> KeyHash 'BlockIssuer)
-> KeyHash 'StakePool -> KeyHash 'BlockIssuer
forall a b. (a -> b) -> a -> b
$ AllIssuerKeys MockCrypto 'StakePool -> KeyHash 'StakePool
forall c (r :: KeyRole). AllIssuerKeys c r -> KeyHash r
aikColdKeyHash AllIssuerKeys MockCrypto 'StakePool
Cast.alicePoolKeys) Word64
0
    (ChainState C -> ChainState C)
-> (ChainState C -> ChainState C) -> ChainState C -> ChainState C
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Block (BHeader MockCrypto) C -> ChainState C -> ChainState C
forall era.
(ProtVerAtMost era 6, EraGov era) =>
Block (BHeader MockCrypto) era -> ChainState era -> ChainState era
C.newEpoch Block (BHeader MockCrypto) C
blockEx5 -- This must be processed before the incrBlockCount
    (ChainState C -> ChainState C) -> ChainState C -> ChainState C
forall a b. (a -> b) -> a -> b
$ ChainState C
expectedStEx4

-- === Block 5, Slot 220, Epoch 2
--
-- Create the first non-empty pool distribution by starting the epoch 2.
-- Moreover, Alice's pool produces the block.
twoPools5 :: CHAINExample C
twoPools5 :: CHAINExample C
twoPools5 = ChainState C
-> Block (BHeader MockCrypto) C
-> Either (NonEmpty (PredicateFailure (CHAIN C))) (ChainState C)
-> CHAINExample C
forall era.
ChainState era
-> Block (BHeader MockCrypto) era
-> Either
     (NonEmpty (PredicateFailure (CHAIN era))) (ChainState era)
-> CHAINExample era
CHAINExample ChainState C
expectedStEx4 Block (BHeader MockCrypto) C
blockEx5 (ChainState C
-> Either (NonEmpty (TestChainPredicateFailure C)) (ChainState C)
forall a b. b -> Either a b
Right ChainState C
expectedStEx5)

--
-- Block 6, Slot 295, Epoch 2
--

blockEx6 :: Block (BHeader MockCrypto) C
blockEx6 :: Block (BHeader MockCrypto) C
blockEx6 =
  HashHeader
-> AllIssuerKeys MockCrypto 'StakePool
-> [Tx C]
-> SlotNo
-> BlockNo
-> Nonce
-> NatNonce
-> UnitInterval
-> Word
-> Word
-> OCert MockCrypto
-> Block (BHeader MockCrypto) C
forall era (r :: KeyRole) c.
(Crypto c, EraSegWits era, Signable (VRF c) (WithResult Seed),
 Signable (KES c) (BHBody c)) =>
HashHeader
-> AllIssuerKeys c r
-> [Tx era]
-> SlotNo
-> BlockNo
-> Nonce
-> NatNonce
-> UnitInterval
-> Word
-> Word
-> OCert c
-> Block (BHeader c) era
mkBlockFakeVRF
    (BHeader MockCrypto -> HashHeader
forall c. BHeader c -> HashHeader
bhHash (BHeader MockCrypto -> HashHeader)
-> BHeader MockCrypto -> HashHeader
forall a b. (a -> b) -> a -> b
$ Block (BHeader MockCrypto) C -> BHeader MockCrypto
forall h era. Block h era -> h
bheader Block (BHeader MockCrypto) C
blockEx5)
    AllIssuerKeys MockCrypto 'StakePool
Cast.alicePoolKeys
    []
    (Word64 -> SlotNo
SlotNo Word64
295) -- odd slots open for decentralization
    (Word64 -> BlockNo
BlockNo Word64
6)
    Nonce
epoch2Nonce
    (Natural -> NatNonce
NatNonce Natural
6)
    UnitInterval
forall a. Bounded a => a
minBound
    Word
14
    Word
14
    (AllIssuerKeys MockCrypto 'StakePool
-> Word64 -> KESPeriod -> OCert MockCrypto
forall c (r :: KeyRole).
Crypto c =>
AllIssuerKeys c r -> Word64 -> KESPeriod -> OCert c
mkOCert AllIssuerKeys MockCrypto 'StakePool
Cast.alicePoolKeys Word64
0 (Word -> KESPeriod
KESPeriod Word
14))

expectedStEx6 :: ChainState C
expectedStEx6 :: ChainState C
expectedStEx6 =
  Nonce -> ChainState C -> ChainState C
forall era. Nonce -> ChainState era -> ChainState era
C.evolveNonceFrozen (Block (BHeader MockCrypto) C -> Nonce
forall era. Block (BHeader MockCrypto) era -> Nonce
getBlockNonce Block (BHeader MockCrypto) C
blockEx6)
    (ChainState C -> ChainState C)
-> (ChainState C -> ChainState C) -> ChainState C -> ChainState C
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Block (BHeader MockCrypto) C -> ChainState C -> ChainState C
forall era.
Block (BHeader MockCrypto) era -> ChainState era -> ChainState era
C.newLab Block (BHeader MockCrypto) C
blockEx6
    (ChainState C -> ChainState C)
-> (ChainState C -> ChainState C) -> ChainState C -> ChainState C
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyHash 'BlockIssuer -> Word64 -> ChainState C -> ChainState C
forall era.
KeyHash 'BlockIssuer -> Word64 -> ChainState era -> ChainState era
C.setOCertCounter (KeyHash 'StakePool -> KeyHash 'BlockIssuer
forall (r :: KeyRole) (r' :: KeyRole). KeyHash r -> KeyHash r'
forall (a :: KeyRole -> *) (r :: KeyRole) (r' :: KeyRole).
HasKeyRole a =>
a r -> a r'
coerceKeyRole (KeyHash 'StakePool -> KeyHash 'BlockIssuer)
-> KeyHash 'StakePool -> KeyHash 'BlockIssuer
forall a b. (a -> b) -> a -> b
$ AllIssuerKeys MockCrypto 'StakePool -> KeyHash 'StakePool
forall c (r :: KeyRole). AllIssuerKeys c r -> KeyHash r
aikColdKeyHash AllIssuerKeys MockCrypto 'StakePool
Cast.alicePoolKeys) Word64
0
    (ChainState C -> ChainState C)
-> (ChainState C -> ChainState C) -> ChainState C -> ChainState C
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyHash 'StakePool -> ChainState C -> ChainState C
forall era. KeyHash 'StakePool -> ChainState era -> ChainState era
C.incrBlockCount (AllIssuerKeys MockCrypto 'StakePool -> KeyHash 'StakePool
forall c (r :: KeyRole). AllIssuerKeys c r -> KeyHash r
aikColdKeyHash AllIssuerKeys MockCrypto 'StakePool
Cast.alicePoolKeys)
    (ChainState C -> ChainState C)
-> (ChainState C -> ChainState C) -> ChainState C -> ChainState C
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RewardUpdate -> ChainState C -> ChainState C
forall era. RewardUpdate -> ChainState era -> ChainState era
C.rewardUpdate RewardUpdate
emptyRewardUpdate
    (ChainState C -> ChainState C) -> ChainState C -> ChainState C
forall a b. (a -> b) -> a -> b
$ ChainState C
expectedStEx5

-- === Block 6, Slot 295, Epoch 2
--
-- Alice's pool produces a second block.
twoPools6 :: CHAINExample C
twoPools6 :: CHAINExample C
twoPools6 = ChainState C
-> Block (BHeader MockCrypto) C
-> Either (NonEmpty (PredicateFailure (CHAIN C))) (ChainState C)
-> CHAINExample C
forall era.
ChainState era
-> Block (BHeader MockCrypto) era
-> Either
     (NonEmpty (PredicateFailure (CHAIN era))) (ChainState era)
-> CHAINExample era
CHAINExample ChainState C
expectedStEx5 Block (BHeader MockCrypto) C
blockEx6 (ChainState C
-> Either (NonEmpty (TestChainPredicateFailure C)) (ChainState C)
forall a b. b -> Either a b
Right ChainState C
expectedStEx6)

--
-- Block 7, Slot 297, Epoch 2
--

blockEx7 :: Block (BHeader MockCrypto) C
blockEx7 :: Block (BHeader MockCrypto) C
blockEx7 =
  HashHeader
-> AllIssuerKeys MockCrypto 'StakePool
-> [Tx C]
-> SlotNo
-> BlockNo
-> Nonce
-> NatNonce
-> UnitInterval
-> Word
-> Word
-> OCert MockCrypto
-> Block (BHeader MockCrypto) C
forall era (r :: KeyRole) c.
(Crypto c, EraSegWits era, Signable (VRF c) (WithResult Seed),
 Signable (KES c) (BHBody c)) =>
HashHeader
-> AllIssuerKeys c r
-> [Tx era]
-> SlotNo
-> BlockNo
-> Nonce
-> NatNonce
-> UnitInterval
-> Word
-> Word
-> OCert c
-> Block (BHeader c) era
mkBlockFakeVRF
    (BHeader MockCrypto -> HashHeader
forall c. BHeader c -> HashHeader
bhHash (BHeader MockCrypto -> HashHeader)
-> BHeader MockCrypto -> HashHeader
forall a b. (a -> b) -> a -> b
$ forall h era. Block h era -> h
bheader @(BHeader MockCrypto) Block (BHeader MockCrypto) C
blockEx6)
    AllIssuerKeys MockCrypto 'StakePool
Cast.bobPoolKeys
    []
    (Word64 -> SlotNo
SlotNo Word64
297) -- odd slots open for decentralization
    (Word64 -> BlockNo
BlockNo Word64
7)
    Nonce
epoch2Nonce
    (Natural -> NatNonce
NatNonce Natural
7)
    UnitInterval
forall a. Bounded a => a
minBound
    Word
14
    Word
14
    (AllIssuerKeys MockCrypto 'StakePool
-> Word64 -> KESPeriod -> OCert MockCrypto
forall c (r :: KeyRole).
Crypto c =>
AllIssuerKeys c r -> Word64 -> KESPeriod -> OCert c
mkOCert AllIssuerKeys MockCrypto 'StakePool
Cast.bobPoolKeys Word64
0 (Word -> KESPeriod
KESPeriod Word
14))

expectedStEx7 :: ChainState C
expectedStEx7 :: ChainState C
expectedStEx7 =
  Nonce -> ChainState C -> ChainState C
forall era. Nonce -> ChainState era -> ChainState era
C.evolveNonceFrozen (Block (BHeader MockCrypto) C -> Nonce
forall era. Block (BHeader MockCrypto) era -> Nonce
getBlockNonce Block (BHeader MockCrypto) C
blockEx7)
    (ChainState C -> ChainState C)
-> (ChainState C -> ChainState C) -> ChainState C -> ChainState C
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Block (BHeader MockCrypto) C -> ChainState C -> ChainState C
forall era.
Block (BHeader MockCrypto) era -> ChainState era -> ChainState era
C.newLab Block (BHeader MockCrypto) C
blockEx7
    (ChainState C -> ChainState C)
-> (ChainState C -> ChainState C) -> ChainState C -> ChainState C
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyHash 'BlockIssuer -> Word64 -> ChainState C -> ChainState C
forall era.
KeyHash 'BlockIssuer -> Word64 -> ChainState era -> ChainState era
C.setOCertCounter (KeyHash 'StakePool -> KeyHash 'BlockIssuer
forall (r :: KeyRole) (r' :: KeyRole). KeyHash r -> KeyHash r'
forall (a :: KeyRole -> *) (r :: KeyRole) (r' :: KeyRole).
HasKeyRole a =>
a r -> a r'
coerceKeyRole (KeyHash 'StakePool -> KeyHash 'BlockIssuer)
-> KeyHash 'StakePool -> KeyHash 'BlockIssuer
forall a b. (a -> b) -> a -> b
$ AllIssuerKeys MockCrypto 'StakePool -> KeyHash 'StakePool
forall c (r :: KeyRole). AllIssuerKeys c r -> KeyHash r
aikColdKeyHash AllIssuerKeys MockCrypto 'StakePool
Cast.bobPoolKeys) Word64
0
    (ChainState C -> ChainState C)
-> (ChainState C -> ChainState C) -> ChainState C -> ChainState C
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyHash 'StakePool -> ChainState C -> ChainState C
forall era. KeyHash 'StakePool -> ChainState era -> ChainState era
C.incrBlockCount (AllIssuerKeys MockCrypto 'StakePool -> KeyHash 'StakePool
forall c (r :: KeyRole). AllIssuerKeys c r -> KeyHash r
aikColdKeyHash AllIssuerKeys MockCrypto 'StakePool
Cast.bobPoolKeys)
    (ChainState C -> ChainState C) -> ChainState C -> ChainState C
forall a b. (a -> b) -> a -> b
$ ChainState C
expectedStEx6

-- === Block 7, Slot 295, Epoch 2
--
-- Bob's pool produces a block.
twoPools7 :: CHAINExample C
twoPools7 :: CHAINExample C
twoPools7 = ChainState C
-> Block (BHeader MockCrypto) C
-> Either (NonEmpty (PredicateFailure (CHAIN C))) (ChainState C)
-> CHAINExample C
forall era.
ChainState era
-> Block (BHeader MockCrypto) era
-> Either
     (NonEmpty (PredicateFailure (CHAIN era))) (ChainState era)
-> CHAINExample era
CHAINExample ChainState C
expectedStEx6 Block (BHeader MockCrypto) C
blockEx7 (ChainState C
-> Either (NonEmpty (TestChainPredicateFailure C)) (ChainState C)
forall a b. b -> Either a b
Right ChainState C
expectedStEx7)

--
-- Block 8, Slot 310, Epoch 3
--

epoch3Nonce :: Nonce
epoch3Nonce :: Nonce
epoch3Nonce =
  ChainState C -> Nonce
forall era. ChainState era -> Nonce
chainCandidateNonce ChainState C
expectedStEx7
    Nonce -> Nonce -> Nonce
⭒ HashHeader -> Nonce
hashHeaderToNonce (BHeader MockCrypto -> HashHeader
forall c. BHeader c -> HashHeader
bhHash (BHeader MockCrypto -> HashHeader)
-> BHeader MockCrypto -> HashHeader
forall a b. (a -> b) -> a -> b
$ Block (BHeader MockCrypto) C -> BHeader MockCrypto
forall h era. Block h era -> h
bheader Block (BHeader MockCrypto) C
blockEx4)

blockEx8 :: Block (BHeader MockCrypto) C
blockEx8 :: Block (BHeader MockCrypto) C
blockEx8 =
  HashHeader
-> AllIssuerKeys MockCrypto 'GenesisDelegate
-> [Tx C]
-> SlotNo
-> BlockNo
-> Nonce
-> NatNonce
-> UnitInterval
-> Word
-> Word
-> OCert MockCrypto
-> Block (BHeader MockCrypto) C
forall era (r :: KeyRole) c.
(Crypto c, EraSegWits era, Signable (VRF c) (WithResult Seed),
 Signable (KES c) (BHBody c)) =>
HashHeader
-> AllIssuerKeys c r
-> [Tx era]
-> SlotNo
-> BlockNo
-> Nonce
-> NatNonce
-> UnitInterval
-> Word
-> Word
-> OCert c
-> Block (BHeader c) era
mkBlockFakeVRF
    (BHeader MockCrypto -> HashHeader
forall c. BHeader c -> HashHeader
bhHash (BHeader MockCrypto -> HashHeader)
-> BHeader MockCrypto -> HashHeader
forall a b. (a -> b) -> a -> b
$ Block (BHeader MockCrypto) C -> BHeader MockCrypto
forall h era. Block h era -> h
bheader Block (BHeader MockCrypto) C
blockEx7)
    (forall era.
(HasCallStack, EraPParams era) =>
PParams era -> Word64 -> AllIssuerKeys MockCrypto 'GenesisDelegate
coreNodeKeysBySchedule @C PParams C
forall era.
(EraPParams era, ProtVerAtMost era 4, ProtVerAtMost era 6) =>
PParams era
ppEx Word64
310)
    []
    (Word64 -> SlotNo
SlotNo Word64
310)
    (Word64 -> BlockNo
BlockNo Word64
8)
    Nonce
epoch3Nonce
    (Natural -> NatNonce
NatNonce Natural
8)
    UnitInterval
forall a. Bounded a => a
minBound
    Word
15
    Word
15
    (AllIssuerKeys MockCrypto 'GenesisDelegate
-> Word64 -> KESPeriod -> OCert MockCrypto
forall c (r :: KeyRole).
Crypto c =>
AllIssuerKeys c r -> Word64 -> KESPeriod -> OCert c
mkOCert (forall era.
(HasCallStack, EraPParams era) =>
PParams era -> Word64 -> AllIssuerKeys MockCrypto 'GenesisDelegate
coreNodeKeysBySchedule @C PParams C
forall era.
(EraPParams era, ProtVerAtMost era 4, ProtVerAtMost era 6) =>
PParams era
ppEx Word64
310) Word64
1 (Word -> KESPeriod
KESPeriod Word
15))

expectedStEx8 :: ChainState C
expectedStEx8 :: ChainState C
expectedStEx8 =
  Block (BHeader MockCrypto) C -> ChainState C -> ChainState C
forall era.
(ProtVerAtMost era 6, EraGov era) =>
Block (BHeader MockCrypto) era -> ChainState era -> ChainState era
C.newEpoch Block (BHeader MockCrypto) C
blockEx8
    (ChainState C -> ChainState C)
-> (ChainState C -> ChainState C) -> ChainState C -> ChainState C
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SnapShot -> Coin -> ChainState C -> ChainState C
forall era. SnapShot -> Coin -> ChainState era -> ChainState era
C.newSnapshot SnapShot
snapEx3 (Integer -> Coin
Coin Integer
0)
    (ChainState C -> ChainState C)
-> (ChainState C -> ChainState C) -> ChainState C -> ChainState C
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyHash 'BlockIssuer -> Word64 -> ChainState C -> ChainState C
forall era.
KeyHash 'BlockIssuer -> Word64 -> ChainState era -> ChainState era
C.setOCertCounter KeyHash 'BlockIssuer
forall {r' :: KeyRole}. KeyHash r'
coreNodeHK Word64
1
    (ChainState C -> ChainState C)
-> (ChainState C -> ChainState C) -> ChainState C -> ChainState C
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RewardUpdate -> ChainState C -> ChainState C
forall era.
(EraGov era, EraCertState era) =>
RewardUpdate -> ChainState era -> ChainState era
C.applyRewardUpdate RewardUpdate
emptyRewardUpdate
    (ChainState C -> ChainState C) -> ChainState C -> ChainState C
forall a b. (a -> b) -> a -> b
$ ChainState C
expectedStEx7
  where
    coreNodeHK :: KeyHash r'
coreNodeHK = KeyHash 'GenesisDelegate -> KeyHash r'
forall (r :: KeyRole) (r' :: KeyRole). KeyHash r -> KeyHash r'
forall (a :: KeyRole -> *) (r :: KeyRole) (r' :: KeyRole).
HasKeyRole a =>
a r -> a r'
coerceKeyRole (KeyHash 'GenesisDelegate -> KeyHash r')
-> (AllIssuerKeys MockCrypto 'GenesisDelegate
    -> KeyHash 'GenesisDelegate)
-> AllIssuerKeys MockCrypto 'GenesisDelegate
-> KeyHash r'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AllIssuerKeys MockCrypto 'GenesisDelegate
-> KeyHash 'GenesisDelegate
forall c (r :: KeyRole). AllIssuerKeys c r -> KeyHash r
aikColdKeyHash (AllIssuerKeys MockCrypto 'GenesisDelegate -> KeyHash r')
-> AllIssuerKeys MockCrypto 'GenesisDelegate -> KeyHash r'
forall a b. (a -> b) -> a -> b
$ forall era.
(HasCallStack, EraPParams era) =>
PParams era -> Word64 -> AllIssuerKeys MockCrypto 'GenesisDelegate
coreNodeKeysBySchedule @C PParams C
forall era.
(EraPParams era, ProtVerAtMost era 4, ProtVerAtMost era 6) =>
PParams era
ppEx Word64
310

-- === Block 8, Slot 310, Epoch 3
--
-- Create an empty block to start epoch 3.
twoPools8 :: CHAINExample C
twoPools8 :: CHAINExample C
twoPools8 = ChainState C
-> Block (BHeader MockCrypto) C
-> Either (NonEmpty (PredicateFailure (CHAIN C))) (ChainState C)
-> CHAINExample C
forall era.
ChainState era
-> Block (BHeader MockCrypto) era
-> Either
     (NonEmpty (PredicateFailure (CHAIN era))) (ChainState era)
-> CHAINExample era
CHAINExample ChainState C
expectedStEx7 Block (BHeader MockCrypto) C
blockEx8 (ChainState C
-> Either (NonEmpty (TestChainPredicateFailure C)) (ChainState C)
forall a b. b -> Either a b
Right ChainState C
expectedStEx8)

--
-- Block 9, Slot 390, Epoch 3
--

blockEx9 :: Block (BHeader MockCrypto) C
blockEx9 :: Block (BHeader MockCrypto) C
blockEx9 =
  HashHeader
-> AllIssuerKeys MockCrypto 'GenesisDelegate
-> [Tx C]
-> SlotNo
-> BlockNo
-> Nonce
-> NatNonce
-> UnitInterval
-> Word
-> Word
-> OCert MockCrypto
-> Block (BHeader MockCrypto) C
forall era (r :: KeyRole) c.
(Crypto c, EraSegWits era, Signable (VRF c) (WithResult Seed),
 Signable (KES c) (BHBody c)) =>
HashHeader
-> AllIssuerKeys c r
-> [Tx era]
-> SlotNo
-> BlockNo
-> Nonce
-> NatNonce
-> UnitInterval
-> Word
-> Word
-> OCert c
-> Block (BHeader c) era
mkBlockFakeVRF
    (BHeader MockCrypto -> HashHeader
forall c. BHeader c -> HashHeader
bhHash (BHeader MockCrypto -> HashHeader)
-> BHeader MockCrypto -> HashHeader
forall a b. (a -> b) -> a -> b
$ Block (BHeader MockCrypto) C -> BHeader MockCrypto
forall h era. Block h era -> h
bheader Block (BHeader MockCrypto) C
blockEx8)
    (forall era.
(HasCallStack, EraPParams era) =>
PParams era -> Word64 -> AllIssuerKeys MockCrypto 'GenesisDelegate
coreNodeKeysBySchedule @C PParams C
forall era.
(EraPParams era, ProtVerAtMost era 4, ProtVerAtMost era 6) =>
PParams era
ppEx Word64
390)
    []
    (Word64 -> SlotNo
SlotNo Word64
390)
    (Word64 -> BlockNo
BlockNo Word64
9)
    Nonce
epoch3Nonce
    (Natural -> NatNonce
NatNonce Natural
9)
    UnitInterval
forall a. Bounded a => a
minBound
    Word
19
    Word
19
    (AllIssuerKeys MockCrypto 'GenesisDelegate
-> Word64 -> KESPeriod -> OCert MockCrypto
forall c (r :: KeyRole).
Crypto c =>
AllIssuerKeys c r -> Word64 -> KESPeriod -> OCert c
mkOCert (forall era.
(HasCallStack, EraPParams era) =>
PParams era -> Word64 -> AllIssuerKeys MockCrypto 'GenesisDelegate
coreNodeKeysBySchedule @C PParams C
forall era.
(EraPParams era, ProtVerAtMost era 4, ProtVerAtMost era 6) =>
PParams era
ppEx Word64
390) Word64
2 (Word -> KESPeriod
KESPeriod Word
19))

blocksMadeEpoch3 :: Integer
blocksMadeEpoch3 :: Integer
blocksMadeEpoch3 = Integer
3

expectedBlocks :: Integer
expectedBlocks :: Integer
expectedBlocks =
  Rational -> Integer
forall b. Integral b => Rational -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor (Rational -> Integer) -> Rational -> Integer
forall a b. (a -> b) -> a -> b
$
    Rational
0.5
      Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* PositiveUnitInterval -> Rational
forall r. BoundedRational r => r -> Rational
unboundRational (ActiveSlotCoeff -> PositiveUnitInterval
activeSlotVal (ActiveSlotCoeff -> PositiveUnitInterval)
-> ActiveSlotCoeff -> PositiveUnitInterval
forall a b. (a -> b) -> a -> b
$ Globals -> ActiveSlotCoeff
activeSlotCoeff Globals
testGlobals)
      Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* EpochSize -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral (EpochNo -> EpochSize
epochSize (EpochNo -> EpochSize) -> EpochNo -> EpochSize
forall a b. (a -> b) -> a -> b
$ Word64 -> EpochNo
EpochNo Word64
3)

reserves9 :: Coin
reserves9 :: Coin
reserves9 = Coin
maxLLSupply Coin -> Coin -> Coin
forall t. Val t => t -> t -> t
<+> Coin
deltaREx4 Coin -> Coin -> Coin
forall t. Val t => t -> t -> t
<-> (Coin
aliceInitCoin Coin -> Coin -> Coin
forall t. Val t => t -> t -> t
<+> Coin
bobInitCoin Coin -> Coin -> Coin
forall t. Val t => t -> t -> t
<+> Coin
carlInitCoin)

deltaR1Ex9 :: Coin
deltaR1Ex9 :: Coin
deltaR1Ex9 =
  Rational -> Coin
rationalToCoinViaFloor (Rational -> Coin) -> Rational -> Coin
forall a b. (a -> b) -> a -> b
$
    (Integer
blocksMadeEpoch3 Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
expectedBlocks)
      Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* Rational
0.0021
      Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* (Integer -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Rational) -> (Coin -> Integer) -> Coin -> Rational
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Coin -> Integer
unCoin (Coin -> Rational) -> Coin -> Rational
forall a b. (a -> b) -> a -> b
$ Coin
reserves9)

rPot :: Integer
rPot :: Integer
rPot = Coin -> Integer
unCoin Coin
deltaR1Ex9 -- There were no fees

deltaTEx9 :: Integer
deltaTEx9 :: Integer
deltaTEx9 = Double -> Integer
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor (Double -> Integer) -> Double -> Integer
forall a b. (a -> b) -> a -> b
$ (Double
0.2 :: Double) Double -> Double -> Double
forall a. Num a => a -> a -> a
* Integer -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
rPot

bigR :: Coin
bigR :: Coin
bigR = Integer -> Coin
Coin (Integer -> Coin) -> Integer -> Coin
forall a b. (a -> b) -> a -> b
$ Integer
rPot Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
deltaTEx9

circulation :: Integer
circulation :: Integer
circulation = Coin -> Integer
unCoin (Coin -> Integer) -> Coin -> Integer
forall a b. (a -> b) -> a -> b
$ Coin
maxLLSupply Coin -> Coin -> Coin
forall t. Val t => t -> t -> t
<-> Coin
reserves9

aliceStakeShareTot :: Rational
aliceStakeShareTot :: Rational
aliceStakeShareTot = (Coin -> Integer
unCoin Coin
aliceCoinEx1 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Coin -> Integer
unCoin Coin
carlInitCoin) Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
circulation

bobStakeShareTot :: Rational
bobStakeShareTot :: Rational
bobStakeShareTot = Coin -> Integer
unCoin Coin
bobInitCoin Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
circulation

alicePoolRewards :: Coin
alicePoolRewards :: Coin
alicePoolRewards = Rational -> Coin
rationalToCoinViaFloor (Rational
appPerf Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* (Integer -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Rational) -> (Coin -> Integer) -> Coin -> Rational
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Coin -> Integer
unCoin (Coin -> Rational) -> Coin -> Rational
forall a b. (a -> b) -> a -> b
$ Coin
maxP))
  where
    appPerf :: Rational
appPerf = UnitInterval -> Rational -> Natural -> Natural -> Rational
mkApparentPerformance (forall era.
(EraPParams era, ProtVerAtMost era 4, ProtVerAtMost era 6) =>
PParams era
ppEx @ShelleyEra PParams C
-> Getting UnitInterval (PParams C) UnitInterval -> UnitInterval
forall s a. s -> Getting a s a -> a
^. Getting UnitInterval (PParams C) UnitInterval
forall era.
(EraPParams era, ProtVerAtMost era 6) =>
Lens' (PParams era) UnitInterval
Lens' (PParams C) UnitInterval
ppDL) Rational
alicePoolStake Natural
2 Natural
3
    pledge :: Integer
pledge = Coin -> Integer
unCoin (Coin -> Integer) -> Coin -> Integer
forall a b. (a -> b) -> a -> b
$ PoolParams -> Coin
ppPledge PoolParams
alicePoolParams'
    pr :: Rational
pr = Integer
pledge Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
circulation
    maxP :: Coin
maxP = forall era.
EraPParams era =>
PParams era -> Coin -> Rational -> Rational -> Coin
maxPool @ShelleyEra PParams C
forall era.
(EraPParams era, ProtVerAtMost era 4, ProtVerAtMost era 6) =>
PParams era
ppEx Coin
bigR Rational
aliceStakeShareTot Rational
pr

carlMemberRewardsFromAlice :: Coin
carlMemberRewardsFromAlice :: Coin
carlMemberRewardsFromAlice =
  Coin -> PoolParams -> StakeShare -> StakeShare -> Coin
memberRew
    Coin
alicePoolRewards
    PoolParams
alicePoolParams'
    (Rational -> StakeShare
StakeShare (Rational -> StakeShare) -> Rational -> StakeShare
forall a b. (a -> b) -> a -> b
$ Coin -> Integer
unCoin Coin
carlInitCoin Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
circulation)
    (Rational -> StakeShare
StakeShare Rational
aliceStakeShareTot)

carlLeaderRewardsFromAlice :: Coin
carlLeaderRewardsFromAlice :: Coin
carlLeaderRewardsFromAlice =
  Coin -> PoolParams -> StakeShare -> StakeShare -> Coin
leaderRew
    Coin
alicePoolRewards
    PoolParams
alicePoolParams'
    (Rational -> StakeShare
StakeShare (Rational -> StakeShare) -> Rational -> StakeShare
forall a b. (a -> b) -> a -> b
$ Coin -> Integer
unCoin Coin
aliceCoinEx1 Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
circulation)
    (Rational -> StakeShare
StakeShare Rational
aliceStakeShareTot)

bobPoolRewards :: Coin
bobPoolRewards :: Coin
bobPoolRewards = Rational -> Coin
rationalToCoinViaFloor (Rational
appPerf Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* (Integer -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Rational) -> (Coin -> Integer) -> Coin -> Rational
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Coin -> Integer
unCoin (Coin -> Rational) -> Coin -> Rational
forall a b. (a -> b) -> a -> b
$ Coin
maxP))
  where
    appPerf :: Rational
appPerf = UnitInterval -> Rational -> Natural -> Natural -> Rational
mkApparentPerformance (forall era.
(EraPParams era, ProtVerAtMost era 4, ProtVerAtMost era 6) =>
PParams era
ppEx @ShelleyEra PParams C
-> Getting UnitInterval (PParams C) UnitInterval -> UnitInterval
forall s a. s -> Getting a s a -> a
^. Getting UnitInterval (PParams C) UnitInterval
forall era.
(EraPParams era, ProtVerAtMost era 6) =>
Lens' (PParams era) UnitInterval
Lens' (PParams C) UnitInterval
ppDL) Rational
bobPoolStake Natural
1 Natural
3
    pledge :: Integer
pledge = Coin -> Integer
unCoin (Coin -> Integer) -> Coin -> Integer
forall a b. (a -> b) -> a -> b
$ PoolParams -> Coin
ppPledge PoolParams
bobPoolParams'
    pr :: Rational
pr = Integer
pledge Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
circulation
    maxP :: Coin
maxP = forall era.
EraPParams era =>
PParams era -> Coin -> Rational -> Rational -> Coin
maxPool @ShelleyEra PParams C
forall era.
(EraPParams era, ProtVerAtMost era 4, ProtVerAtMost era 6) =>
PParams era
ppEx Coin
bigR Rational
bobStakeShareTot Rational
pr

carlLeaderRewardsFromBob :: Coin
carlLeaderRewardsFromBob :: Coin
carlLeaderRewardsFromBob =
  Coin -> PoolParams -> StakeShare -> StakeShare -> Coin
leaderRew
    Coin
bobPoolRewards
    PoolParams
bobPoolParams'
    (Rational -> StakeShare
StakeShare (Rational -> StakeShare) -> Rational -> StakeShare
forall a b. (a -> b) -> a -> b
$ Coin -> Integer
unCoin Coin
bobInitCoin Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
circulation)
    (Rational -> StakeShare
StakeShare Rational
bobStakeShareTot)

alicePerfEx9 :: Likelihood
alicePerfEx9 :: Likelihood
alicePerfEx9 = Natural -> Double -> EpochSize -> Likelihood
likelihood Natural
blocks Double
t (EpochNo -> EpochSize
epochSize (EpochNo -> EpochSize) -> EpochNo -> EpochSize
forall a b. (a -> b) -> a -> b
$ Word64 -> EpochNo
EpochNo Word64
3)
  where
    blocks :: Natural
blocks = Natural
2
    t :: Double
t = ActiveSlotCoeff -> Rational -> UnitInterval -> Double
leaderProbability ActiveSlotCoeff
f Rational
alicePoolStake (Rational -> UnitInterval
forall r.
(HasCallStack, Typeable r, BoundedRational r) =>
Rational -> r
unsafeBoundRational Rational
0.5)
    f :: ActiveSlotCoeff
f = Globals -> ActiveSlotCoeff
activeSlotCoeff Globals
testGlobals

bobPerfEx9 :: Likelihood
bobPerfEx9 :: Likelihood
bobPerfEx9 = Natural -> Double -> EpochSize -> Likelihood
likelihood Natural
blocks Double
t (EpochNo -> EpochSize
epochSize (EpochNo -> EpochSize) -> EpochNo -> EpochSize
forall a b. (a -> b) -> a -> b
$ Word64 -> EpochNo
EpochNo Word64
3)
  where
    blocks :: Natural
blocks = Natural
1
    t :: Double
t = ActiveSlotCoeff -> Rational -> UnitInterval -> Double
leaderProbability ActiveSlotCoeff
f Rational
bobPoolStake (Rational -> UnitInterval
forall r.
(HasCallStack, Typeable r, BoundedRational r) =>
Rational -> r
unsafeBoundRational Rational
0.5)
    f :: ActiveSlotCoeff
f = Globals -> ActiveSlotCoeff
activeSlotCoeff Globals
testGlobals

nonMyopicEx9 :: NonMyopic
nonMyopicEx9 :: NonMyopic
nonMyopicEx9 =
  Map (KeyHash 'StakePool) Likelihood -> Coin -> NonMyopic
NonMyopic
    ( [(KeyHash 'StakePool, Likelihood)]
-> Map (KeyHash 'StakePool) Likelihood
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
        [ (AllIssuerKeys MockCrypto 'StakePool -> KeyHash 'StakePool
forall c (r :: KeyRole). AllIssuerKeys c r -> KeyHash r
aikColdKeyHash AllIssuerKeys MockCrypto 'StakePool
Cast.alicePoolKeys, Likelihood
alicePerfEx9)
        , (AllIssuerKeys MockCrypto 'StakePool -> KeyHash 'StakePool
forall c (r :: KeyRole). AllIssuerKeys c r -> KeyHash r
aikColdKeyHash AllIssuerKeys MockCrypto 'StakePool
Cast.bobPoolKeys, Likelihood
bobPerfEx9)
        ]
    )
    Coin
bigR

rewardUpdateEx9 ::
  PParams C ->
  Map (Credential 'Staking) (Set Reward) ->
  RewardUpdate
rewardUpdateEx9 :: PParams C -> Map (Credential 'Staking) (Set Reward) -> RewardUpdate
rewardUpdateEx9 PParams C
pp Map (Credential 'Staking) (Set Reward)
rewards =
  RewardUpdate
    { deltaT :: DeltaCoin
deltaT = Integer -> DeltaCoin
DeltaCoin Integer
deltaTEx9
    , deltaR :: DeltaCoin
deltaR = DeltaCoin -> DeltaCoin
forall m. Group m => m -> m
invert (Coin -> DeltaCoin
toDeltaCoin Coin
deltaR1Ex9) DeltaCoin -> DeltaCoin -> DeltaCoin
forall a. Semigroup a => a -> a -> a
<> Coin -> DeltaCoin
toDeltaCoin Coin
deltaR2Ex9
    , rs :: Map (Credential 'Staking) (Set Reward)
rs = Map (Credential 'Staking) (Set Reward)
rewards
    , deltaF :: DeltaCoin
deltaF = Integer -> DeltaCoin
DeltaCoin Integer
0
    , nonMyopic :: NonMyopic
nonMyopic = NonMyopic
nonMyopicEx9
    }
  where
    pv :: ProtVer
pv = PParams C
pp PParams C -> Getting ProtVer (PParams C) ProtVer -> ProtVer
forall s a. s -> Getting a s a -> a
^. Getting ProtVer (PParams C) ProtVer
forall era. EraPParams era => Lens' (PParams era) ProtVer
Lens' (PParams C) ProtVer
ppProtocolVersionL
    deltaR2Ex9 :: Coin
deltaR2Ex9 = Coin
bigR Coin -> Coin -> Coin
forall t. Val t => t -> t -> t
<-> ProtVer -> Map (Credential 'Staking) (Set Reward) -> Coin
sumRewards ProtVer
pv Map (Credential 'Staking) (Set Reward)
rewards

pulserEx9 :: PParams C -> PulsingRewUpdate
pulserEx9 :: PParams C -> PulsingRewUpdate
pulserEx9 PParams C
pp =
  BlocksMade -> ChainState C -> PulsingRewUpdate
forall era.
(EraGov era, EraCertState era) =>
BlocksMade -> ChainState era -> PulsingRewUpdate
makeCompletedPulser
    ( Map (KeyHash 'StakePool) Natural -> BlocksMade
BlocksMade (Map (KeyHash 'StakePool) Natural -> BlocksMade)
-> Map (KeyHash 'StakePool) Natural -> BlocksMade
forall a b. (a -> b) -> a -> b
$
        [(KeyHash 'StakePool, Natural)] -> Map (KeyHash 'StakePool) Natural
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
          [(AllIssuerKeys MockCrypto 'StakePool -> KeyHash 'StakePool
forall c (r :: KeyRole). AllIssuerKeys c r -> KeyHash r
aikColdKeyHash AllIssuerKeys MockCrypto 'StakePool
Cast.alicePoolKeys, Natural
2), (AllIssuerKeys MockCrypto 'StakePool -> KeyHash 'StakePool
forall c (r :: KeyRole). AllIssuerKeys c r -> KeyHash r
aikColdKeyHash AllIssuerKeys MockCrypto 'StakePool
Cast.bobPoolKeys, Natural
1)]
    )
    ChainState C
expectedStEx8'
  where
    expectedStEx8' :: ChainState C
expectedStEx8' = PParams C -> ChainState C -> ChainState C
forall era.
EraGov era =>
PParams era -> ChainState era -> ChainState era
C.setPrevPParams PParams C
pp ChainState C
expectedStEx8

expectedStEx9 :: PParams C -> ChainState C
expectedStEx9 :: PParams C -> ChainState C
expectedStEx9 PParams C
pp =
  Nonce -> ChainState C -> ChainState C
forall era. Nonce -> ChainState era -> ChainState era
C.evolveNonceFrozen (Block (BHeader MockCrypto) C -> Nonce
forall era. Block (BHeader MockCrypto) era -> Nonce
getBlockNonce Block (BHeader MockCrypto) C
blockEx9)
    (ChainState C -> ChainState C)
-> (ChainState C -> ChainState C) -> ChainState C -> ChainState C
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Block (BHeader MockCrypto) C -> ChainState C -> ChainState C
forall era.
Block (BHeader MockCrypto) era -> ChainState era -> ChainState era
C.newLab Block (BHeader MockCrypto) C
blockEx9
    (ChainState C -> ChainState C)
-> (ChainState C -> ChainState C) -> ChainState C -> ChainState C
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyHash 'BlockIssuer -> Word64 -> ChainState C -> ChainState C
forall era.
KeyHash 'BlockIssuer -> Word64 -> ChainState era -> ChainState era
C.setOCertCounter KeyHash 'BlockIssuer
forall {r' :: KeyRole}. KeyHash r'
coreNodeHK Word64
2
    (ChainState C -> ChainState C)
-> (ChainState C -> ChainState C) -> ChainState C -> ChainState C
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PulsingRewUpdate -> ChainState C -> ChainState C
forall era. PulsingRewUpdate -> ChainState era -> ChainState era
C.pulserUpdate (PParams C -> PulsingRewUpdate
pulserEx9 PParams C
pp)
    (ChainState C -> ChainState C)
-> (ChainState C -> ChainState C) -> ChainState C -> ChainState C
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChainState C -> ChainState C
forall era. EraGov era => ChainState era -> ChainState era
C.solidifyProposals
    (ChainState C -> ChainState C) -> ChainState C -> ChainState C
forall a b. (a -> b) -> a -> b
$ ChainState C
expectedStEx8
  where
    coreNodeHK :: KeyHash r'
coreNodeHK = KeyHash 'GenesisDelegate -> KeyHash r'
forall (r :: KeyRole) (r' :: KeyRole). KeyHash r -> KeyHash r'
forall (a :: KeyRole -> *) (r :: KeyRole) (r' :: KeyRole).
HasKeyRole a =>
a r -> a r'
coerceKeyRole (KeyHash 'GenesisDelegate -> KeyHash r')
-> (AllIssuerKeys MockCrypto 'GenesisDelegate
    -> KeyHash 'GenesisDelegate)
-> AllIssuerKeys MockCrypto 'GenesisDelegate
-> KeyHash r'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AllIssuerKeys MockCrypto 'GenesisDelegate
-> KeyHash 'GenesisDelegate
forall c (r :: KeyRole). AllIssuerKeys c r -> KeyHash r
aikColdKeyHash (AllIssuerKeys MockCrypto 'GenesisDelegate -> KeyHash r')
-> AllIssuerKeys MockCrypto 'GenesisDelegate -> KeyHash r'
forall a b. (a -> b) -> a -> b
$ forall era.
(HasCallStack, EraPParams era) =>
PParams era -> Word64 -> AllIssuerKeys MockCrypto 'GenesisDelegate
coreNodeKeysBySchedule @C PParams C
forall era.
(EraPParams era, ProtVerAtMost era 4, ProtVerAtMost era 6) =>
PParams era
ppEx Word64
390

-- === Block 9, Slot 390, Epoch 3
--
-- Create the first non-trivial reward update. The rewards demonstrate the
-- results of the delegation scenario that was constructed in the first and only transaction.
twoPools9 :: CHAINExample C
twoPools9 :: CHAINExample C
twoPools9 = ChainState C
-> Block (BHeader MockCrypto) C
-> Either (NonEmpty (PredicateFailure (CHAIN C))) (ChainState C)
-> CHAINExample C
forall era.
ChainState era
-> Block (BHeader MockCrypto) era
-> Either
     (NonEmpty (PredicateFailure (CHAIN era))) (ChainState era)
-> CHAINExample era
CHAINExample ChainState C
expectedStEx8 Block (BHeader MockCrypto) C
blockEx9 (ChainState C
-> Either (NonEmpty (PredicateFailure (CHAIN C))) (ChainState C)
forall a b. b -> Either a b
Right (ChainState C
 -> Either (NonEmpty (PredicateFailure (CHAIN C))) (ChainState C))
-> ChainState C
-> Either (NonEmpty (PredicateFailure (CHAIN C))) (ChainState C)
forall a b. (a -> b) -> a -> b
$ PParams C -> ChainState C
expectedStEx9 PParams C
forall era.
(EraPParams era, ProtVerAtMost era 4, ProtVerAtMost era 6) =>
PParams era
ppEx)

--
-- Now test with Aggregation
--
carlsRewards :: Set Reward
carlsRewards :: Set Reward
carlsRewards =
  [Reward] -> Set Reward
forall a. Ord a => [a] -> Set a
Set.fromList
    [ RewardType -> KeyHash 'StakePool -> Coin -> Reward
Reward RewardType
MemberReward (AllIssuerKeys MockCrypto 'StakePool -> KeyHash 'StakePool
forall c (r :: KeyRole). AllIssuerKeys c r -> KeyHash r
aikColdKeyHash AllIssuerKeys MockCrypto 'StakePool
Cast.alicePoolKeys) Coin
carlMemberRewardsFromAlice
    , RewardType -> KeyHash 'StakePool -> Coin -> Reward
Reward RewardType
LeaderReward (AllIssuerKeys MockCrypto 'StakePool -> KeyHash 'StakePool
forall c (r :: KeyRole). AllIssuerKeys c r -> KeyHash r
aikColdKeyHash AllIssuerKeys MockCrypto 'StakePool
Cast.alicePoolKeys) Coin
carlLeaderRewardsFromAlice
    , RewardType -> KeyHash 'StakePool -> Coin -> Reward
Reward RewardType
LeaderReward (AllIssuerKeys MockCrypto 'StakePool -> KeyHash 'StakePool
forall c (r :: KeyRole). AllIssuerKeys c r -> KeyHash r
aikColdKeyHash AllIssuerKeys MockCrypto 'StakePool
Cast.bobPoolKeys) Coin
carlLeaderRewardsFromBob
    ]

rsEx9Agg :: Map (Credential 'Staking) (Set Reward)
rsEx9Agg :: Map (Credential 'Staking) (Set Reward)
rsEx9Agg = Credential 'Staking
-> Set Reward -> Map (Credential 'Staking) (Set Reward)
forall k a. k -> a -> Map k a
Map.singleton Credential 'Staking
Cast.carlSHK Set Reward
carlsRewards

ppProtVer3 :: PParams C
ppProtVer3 :: PParams C
ppProtVer3 = PParams C
forall era.
(EraPParams era, ProtVerAtMost era 4, ProtVerAtMost era 6) =>
PParams era
ppEx PParams C -> (PParams C -> PParams C) -> PParams C
forall a b. a -> (a -> b) -> b
& (ProtVer -> Identity ProtVer) -> PParams C -> Identity (PParams C)
forall era. EraPParams era => Lens' (PParams era) ProtVer
Lens' (PParams C) ProtVer
ppProtocolVersionL ((ProtVer -> Identity ProtVer)
 -> PParams C -> Identity (PParams C))
-> ProtVer -> PParams C -> PParams C
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Version -> Natural -> ProtVer
ProtVer (forall (v :: Natural).
(KnownNat v, MinVersion <= v, v <= MaxVersion) =>
Version
natVersion @3) Natural
0

expectedStEx8Agg :: ChainState C
expectedStEx8Agg :: ChainState C
expectedStEx8Agg = PParams C -> ChainState C -> ChainState C
forall era.
EraGov era =>
PParams era -> ChainState era -> ChainState era
C.setPrevPParams PParams C
ppProtVer3 ChainState C
expectedStEx8

expectedStEx9Agg :: ChainState C
expectedStEx9Agg :: ChainState C
expectedStEx9Agg = ChainState C -> ChainState C
forall era. EraGov era => ChainState era -> ChainState era
C.solidifyProposals (ChainState C -> ChainState C) -> ChainState C -> ChainState C
forall a b. (a -> b) -> a -> b
$ PParams C -> ChainState C -> ChainState C
forall era.
EraGov era =>
PParams era -> ChainState era -> ChainState era
C.setPrevPParams PParams C
ppProtVer3 (PParams C -> ChainState C
expectedStEx9 PParams C
ppProtVer3)

-- Create the first non-trivial reward update. The rewards demonstrate the
-- results of the delegation scenario that was constructed in the first and only transaction.
twoPools9Agg :: CHAINExample C
twoPools9Agg :: CHAINExample C
twoPools9Agg = ChainState C
-> Block (BHeader MockCrypto) C
-> Either (NonEmpty (PredicateFailure (CHAIN C))) (ChainState C)
-> CHAINExample C
forall era.
ChainState era
-> Block (BHeader MockCrypto) era
-> Either
     (NonEmpty (PredicateFailure (CHAIN era))) (ChainState era)
-> CHAINExample era
CHAINExample ChainState C
expectedStEx8Agg Block (BHeader MockCrypto) C
blockEx9 (ChainState C
-> Either (NonEmpty (TestChainPredicateFailure C)) (ChainState C)
forall a b. b -> Either a b
Right ChainState C
expectedStEx9Agg)

testAggregateRewardsLegacy :: HasCallStack => Assertion
testAggregateRewardsLegacy :: HasCallStack => Assertion
testAggregateRewardsLegacy = do
  let expectedReward :: Coin
expectedReward = Coin
carlLeaderRewardsFromBob
  Coin
expectedReward Coin -> Coin -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= Reward -> Coin
rewardAmount (Set Reward -> Reward
forall a. Ord a => Set a -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum Set Reward
carlsRewards)
  ProtVer
-> Map (Credential 'Staking) (Set Reward)
-> Map (Credential 'Staking) Coin
aggregateRewards (PParams C
forall era.
(EraPParams era, ProtVerAtMost era 4, ProtVerAtMost era 6) =>
PParams era
ppEx PParams C -> Getting ProtVer (PParams C) ProtVer -> ProtVer
forall s a. s -> Getting a s a -> a
^. forall era. EraPParams era => Lens' (PParams era) ProtVer
ppProtocolVersionL @C) Map (Credential 'Staking) (Set Reward)
rsEx9Agg
    Map (Credential 'Staking) Coin
-> Map (Credential 'Staking) Coin -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= Credential 'Staking -> Coin -> Map (Credential 'Staking) Coin
forall k a. k -> a -> Map k a
Map.singleton Credential 'Staking
Cast.carlSHK Coin
expectedReward

testAggregateRewardsNew :: Assertion
testAggregateRewardsNew :: Assertion
testAggregateRewardsNew =
  ProtVer
-> Map (Credential 'Staking) (Set Reward)
-> Map (Credential 'Staking) Coin
aggregateRewards (PParams C
ppProtVer3 PParams C -> Getting ProtVer (PParams C) ProtVer -> ProtVer
forall s a. s -> Getting a s a -> a
^. forall era. EraPParams era => Lens' (PParams era) ProtVer
ppProtocolVersionL @C) Map (Credential 'Staking) (Set Reward)
rsEx9Agg
    Map (Credential 'Staking) Coin
-> Map (Credential 'Staking) Coin -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= Credential 'Staking -> Coin -> Map (Credential 'Staking) Coin
forall k a. k -> a -> Map k a
Map.singleton Credential 'Staking
Cast.carlSHK ((Reward -> Coin) -> Set Reward -> Coin
forall m a. Monoid m => (a -> m) -> Set a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Reward -> Coin
rewardAmount Set Reward
carlsRewards)

--
-- Two Pools Test Group
--

twoPoolsExample :: TestTree
twoPoolsExample :: TestTree
twoPoolsExample =
  TestName -> [TestTree] -> TestTree
testGroup
    TestName
"two pools"
    [ TestName -> Assertion -> TestTree
testCase TestName
"create non-aggregated pulser" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ HasCallStack => CHAINExample C -> Assertion
CHAINExample C -> Assertion
testCHAINExample CHAINExample C
twoPools9
    , TestName -> Assertion -> TestTree
testCase TestName
"non-aggregated pulser is correct" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
        RewardUpdate -> PulsingRewUpdate
Complete (PParams C -> Map (Credential 'Staking) (Set Reward) -> RewardUpdate
rewardUpdateEx9 PParams C
forall era.
(EraPParams era, ProtVerAtMost era 4, ProtVerAtMost era 6) =>
PParams era
ppEx Map (Credential 'Staking) (Set Reward)
rsEx9Agg)
          PulsingRewUpdate -> PulsingRewUpdate -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= ((PulsingRewUpdate, Map (Credential 'Staking) (Set Reward))
-> PulsingRewUpdate
forall a b. (a, b) -> a
fst ((PulsingRewUpdate, Map (Credential 'Staking) (Set Reward))
 -> PulsingRewUpdate)
-> (PulsingRewUpdate
    -> (PulsingRewUpdate, Map (Credential 'Staking) (Set Reward)))
-> PulsingRewUpdate
-> PulsingRewUpdate
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShelleyBase
  (PulsingRewUpdate, Map (Credential 'Staking) (Set Reward))
-> (PulsingRewUpdate, Map (Credential 'Staking) (Set Reward))
forall a. ShelleyBase a -> a
runShelleyBase (ShelleyBase
   (PulsingRewUpdate, Map (Credential 'Staking) (Set Reward))
 -> (PulsingRewUpdate, Map (Credential 'Staking) (Set Reward)))
-> (PulsingRewUpdate
    -> ShelleyBase
         (PulsingRewUpdate, Map (Credential 'Staking) (Set Reward)))
-> PulsingRewUpdate
-> (PulsingRewUpdate, Map (Credential 'Staking) (Set Reward))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PulsingRewUpdate
-> ShelleyBase
     (PulsingRewUpdate, Map (Credential 'Staking) (Set Reward))
completeStep (PulsingRewUpdate -> PulsingRewUpdate)
-> PulsingRewUpdate -> PulsingRewUpdate
forall a b. (a -> b) -> a -> b
$ PParams C -> PulsingRewUpdate
pulserEx9 PParams C
forall era.
(EraPParams era, ProtVerAtMost era 4, ProtVerAtMost era 6) =>
PParams era
ppEx)
    , TestName -> Assertion -> TestTree
testCase TestName
"aggregated pulser is correct" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
        RewardUpdate -> PulsingRewUpdate
Complete (PParams C -> Map (Credential 'Staking) (Set Reward) -> RewardUpdate
rewardUpdateEx9 PParams C
ppProtVer3 Map (Credential 'Staking) (Set Reward)
rsEx9Agg)
          PulsingRewUpdate -> PulsingRewUpdate -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= ((PulsingRewUpdate, Map (Credential 'Staking) (Set Reward))
-> PulsingRewUpdate
forall a b. (a, b) -> a
fst ((PulsingRewUpdate, Map (Credential 'Staking) (Set Reward))
 -> PulsingRewUpdate)
-> (PulsingRewUpdate
    -> (PulsingRewUpdate, Map (Credential 'Staking) (Set Reward)))
-> PulsingRewUpdate
-> PulsingRewUpdate
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShelleyBase
  (PulsingRewUpdate, Map (Credential 'Staking) (Set Reward))
-> (PulsingRewUpdate, Map (Credential 'Staking) (Set Reward))
forall a. ShelleyBase a -> a
runShelleyBase (ShelleyBase
   (PulsingRewUpdate, Map (Credential 'Staking) (Set Reward))
 -> (PulsingRewUpdate, Map (Credential 'Staking) (Set Reward)))
-> (PulsingRewUpdate
    -> ShelleyBase
         (PulsingRewUpdate, Map (Credential 'Staking) (Set Reward)))
-> PulsingRewUpdate
-> (PulsingRewUpdate, Map (Credential 'Staking) (Set Reward))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PulsingRewUpdate
-> ShelleyBase
     (PulsingRewUpdate, Map (Credential 'Staking) (Set Reward))
completeStep (PulsingRewUpdate -> PulsingRewUpdate)
-> PulsingRewUpdate -> PulsingRewUpdate
forall a b. (a -> b) -> a -> b
$ PParams C -> PulsingRewUpdate
pulserEx9 PParams C
ppProtVer3)
    , TestName -> Assertion -> TestTree
testCase TestName
"create aggregated pulser" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ HasCallStack => CHAINExample C -> Assertion
CHAINExample C -> Assertion
testCHAINExample CHAINExample C
twoPools9Agg
    , TestName -> Assertion -> TestTree
testCase TestName
"create legacy aggregatedRewards" Assertion
HasCallStack => Assertion
testAggregateRewardsLegacy
    , TestName -> Assertion -> TestTree
testCase TestName
"create new aggregatedRewards" Assertion
testAggregateRewardsNew
    ]

-- This test group tests each block individually, which is really only
-- helpful for debugging purposes.
twoPoolsExampleExtended :: TestTree
twoPoolsExampleExtended :: TestTree
twoPoolsExampleExtended =
  TestName -> [TestTree] -> TestTree
testGroup
    TestName
"two pools extended"
    [ TestName -> Assertion -> TestTree
testCase TestName
"initial registrations" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ HasCallStack => CHAINExample C -> Assertion
CHAINExample C -> Assertion
testCHAINExample CHAINExample C
twoPools1
    , TestName -> Assertion -> TestTree
testCase TestName
"delegate stake and create reward update" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ HasCallStack => CHAINExample C -> Assertion
CHAINExample C -> Assertion
testCHAINExample CHAINExample C
twoPools2
    , TestName -> Assertion -> TestTree
testCase TestName
"new epoch changes" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ HasCallStack => CHAINExample C -> Assertion
CHAINExample C -> Assertion
testCHAINExample CHAINExample C
twoPools3
    , TestName -> Assertion -> TestTree
testCase TestName
"second reward update" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ HasCallStack => CHAINExample C -> Assertion
CHAINExample C -> Assertion
testCHAINExample CHAINExample C
twoPools4
    , TestName -> Assertion -> TestTree
testCase TestName
"nonempty pool distr" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ HasCallStack => CHAINExample C -> Assertion
CHAINExample C -> Assertion
testCHAINExample CHAINExample C
twoPools5
    , TestName -> Assertion -> TestTree
testCase TestName
"alice produces a block" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ HasCallStack => CHAINExample C -> Assertion
CHAINExample C -> Assertion
testCHAINExample CHAINExample C
twoPools6
    , TestName -> Assertion -> TestTree
testCase TestName
"bob produces a block" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ HasCallStack => CHAINExample C -> Assertion
CHAINExample C -> Assertion
testCHAINExample CHAINExample C
twoPools7
    , TestName -> Assertion -> TestTree
testCase TestName
"prelude to the first nontrivial rewards" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ HasCallStack => CHAINExample C -> Assertion
CHAINExample C -> Assertion
testCHAINExample CHAINExample C
twoPools8
    , TestName -> Assertion -> TestTree
testCase TestName
"create non-aggregated rewards" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ HasCallStack => CHAINExample C -> Assertion
CHAINExample C -> Assertion
testCHAINExample CHAINExample C
twoPools9
    , TestName -> Assertion -> TestTree
testCase TestName
"create aggregated rewards" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ HasCallStack => CHAINExample C -> Assertion
CHAINExample C -> Assertion
testCHAINExample CHAINExample C
twoPools9Agg
    ]