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

-- |
-- Module      : Test.Cardano.Ledger.Shelley.Examples.PoolLifetime
-- Description : Pool Lifetime Example
--
-- Example demonstrating the creation of a new stake pool,
-- block production under Praos, rewards, and pool retirement.
module Test.Cardano.Ledger.Shelley.Examples.PoolLifetime (
  makePulser,
  makePulser',
  makeCompletedPulser,
  poolLifetimeExample,
  mkStake,
) where

import Cardano.Ledger.BaseTypes (
  BlocksMade (..),
  Globals (..),
  Network (..),
  Nonce,
  StrictMaybe (..),
  mkCertIxPartial,
  (⭒),
 )
import Cardano.Ledger.Block (Block, bheader)
import Cardano.Ledger.Coin (
  Coin (..),
  CompactForm (CompactCoin),
  DeltaCoin (..),
  addDeltaCoin,
  toDeltaCoin,
 )
import Cardano.Ledger.Compactible
import Cardano.Ledger.Credential (Credential, Ptr (..), SlotNo32 (..))
import Cardano.Ledger.Keys (asWitness, coerceKeyRole)
import Cardano.Ledger.PoolParams (PoolParams (..))
import Cardano.Ledger.Shelley (ShelleyEra)
import Cardano.Ledger.Shelley.Core
import Cardano.Ledger.Shelley.LedgerState (
  NewEpochState (..),
  PulsingRewUpdate (..),
  RewardUpdate (..),
  completeRupd,
  decayFactor,
  emptyRewardUpdate,
  startStep,
 )
import Cardano.Ledger.Shelley.PoolRank (
  Likelihood (..),
  NonMyopic (..),
  applyDecay,
  leaderProbability,
  likelihood,
 )
import Cardano.Ledger.Shelley.Tx (ShelleyTx (..))
import Cardano.Ledger.Shelley.TxBody (
  RewardAccount (..),
  TxBody (..),
 )
import Cardano.Ledger.Shelley.TxCert (ShelleyTxCert (..))
import Cardano.Ledger.Shelley.TxOut (ShelleyTxOut (..))
import Cardano.Ledger.Shelley.TxWits (
  addrWits,
 )
import Cardano.Ledger.Slot (
  BlockNo (..),
  EpochNo (..),
  SlotNo (..),
 )
import Cardano.Ledger.State
import Cardano.Ledger.TxIn (TxIn (..), mkTxInPartial)
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 qualified Data.Map.Strict as Map
import Data.Ratio ((%))
import qualified Data.Sequence.Strict as StrictSeq
import qualified Data.Set as Set
import GHC.Exts (fromList)
import GHC.Stack (HasCallStack)
import Test.Cardano.Ledger.Core.KeyPair (mkWitnessesVKey)
import Test.Cardano.Ledger.Shelley.ConcreteCryptoTypes (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 (
  coreNodeIssuerKeys,
  coreNodeKeysBySchedule,
 )
import Test.Cardano.Ledger.Shelley.Examples.Init (
  initSt,
  lastByronHeaderHash,
  nonce0,
  ppEx,
 )
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 (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

toCompactCoinError :: Coin -> CompactForm Coin
toCompactCoinError :: Coin -> CompactForm Coin
toCompactCoinError Coin
c =
  case Coin -> Maybe (CompactForm Coin)
forall a. Compactible a => a -> Maybe (CompactForm a)
toCompact Coin
c of
    Maybe (CompactForm Coin)
Nothing -> [Char] -> CompactForm Coin
forall a. HasCallStack => [Char] -> a
error ([Char] -> CompactForm Coin) -> [Char] -> CompactForm Coin
forall a b. (a -> b) -> a -> b
$ [Char]
"Invalid coin: " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Coin -> [Char]
forall a. Show a => a -> [Char]
show Coin
c
    Just CompactForm Coin
compactCoin -> CompactForm Coin
compactCoin

mkStake :: [(Credential 'Staking, Coin)] -> Stake
mkStake :: [(Credential 'Staking, Coin)] -> Stake
mkStake = VMap VB VP (Credential 'Staking) (CompactForm Coin) -> Stake
Stake (VMap VB VP (Credential 'Staking) (CompactForm Coin) -> Stake)
-> ([(Credential 'Staking, Coin)]
    -> VMap VB VP (Credential 'Staking) (CompactForm Coin))
-> [(Credential 'Staking, Coin)]
-> Stake
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Credential 'Staking, CompactForm Coin)]
-> VMap VB VP (Credential 'Staking) (CompactForm Coin)
[Item (VMap VB VP (Credential 'Staking) (CompactForm Coin))]
-> VMap VB VP (Credential 'Staking) (CompactForm Coin)
forall l. IsList l => [Item l] -> l
GHC.Exts.fromList ([(Credential 'Staking, CompactForm Coin)]
 -> VMap VB VP (Credential 'Staking) (CompactForm Coin))
-> ([(Credential 'Staking, Coin)]
    -> [(Credential 'Staking, CompactForm Coin)])
-> [(Credential 'Staking, Coin)]
-> VMap VB VP (Credential 'Staking) (CompactForm Coin)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Credential 'Staking, Coin)
 -> (Credential 'Staking, CompactForm Coin))
-> [(Credential 'Staking, Coin)]
-> [(Credential 'Staking, CompactForm Coin)]
forall a b. (a -> b) -> [a] -> [b]
map ((Coin -> CompactForm Coin)
-> (Credential 'Staking, Coin)
-> (Credential 'Staking, CompactForm Coin)
forall a b.
(a -> b) -> (Credential 'Staking, a) -> (Credential 'Staking, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Coin -> CompactForm Coin
toCompactCoinError)

initUTxO :: UTxO ShelleyEra
initUTxO :: UTxO ShelleyEra
initUTxO =
  TxId -> [TxOut ShelleyEra] -> UTxO ShelleyEra
forall era. TxId -> [TxOut era] -> UTxO era
genesisCoins
    TxId
genesisId
    [ Addr -> Value ShelleyEra -> ShelleyTxOut ShelleyEra
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 ShelleyEra -> ShelleyTxOut ShelleyEra
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)
    ]

initStPoolLifetime :: ChainState ShelleyEra
initStPoolLifetime :: ChainState ShelleyEra
initStPoolLifetime = UTxO ShelleyEra -> ChainState ShelleyEra
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 ShelleyEra
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 -> 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
<-> Integer -> Coin
Coin Integer
3

carlMIR :: Coin
carlMIR :: Coin
carlMIR = Integer -> Coin
Coin Integer
110

dariaMIR :: Coin
dariaMIR :: Coin
dariaMIR = Integer -> Coin
Coin Integer
99

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

txbodyEx1 :: TxBody ShelleyEra
txbodyEx1 :: TxBody ShelleyEra
txbodyEx1 =
  Set TxIn
-> StrictSeq (TxOut ShelleyEra)
-> StrictSeq (TxCert ShelleyEra)
-> Withdrawals
-> Coin
-> SlotNo
-> StrictMaybe (Update ShelleyEra)
-> StrictMaybe TxAuxDataHash
-> TxBody ShelleyEra
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 ShelleyEra] -> StrictSeq (ShelleyTxOut ShelleyEra)
forall a. [a] -> StrictSeq a
StrictSeq.fromList [Addr -> Value ShelleyEra -> ShelleyTxOut ShelleyEra
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 ShelleyEra] -> StrictSeq (ShelleyTxCert ShelleyEra)
forall a. [a] -> StrictSeq a
StrictSeq.fromList
        ( [ Credential 'Staking -> TxCert ShelleyEra
forall era.
ShelleyEraTxCert era =>
Credential 'Staking -> TxCert era
RegTxCert Credential 'Staking
Cast.aliceSHK
          , Credential 'Staking -> TxCert ShelleyEra
forall era.
ShelleyEraTxCert era =>
Credential 'Staking -> TxCert era
RegTxCert Credential 'Staking
Cast.bobSHK
          , Credential 'Staking -> TxCert ShelleyEra
forall era.
ShelleyEraTxCert era =>
Credential 'Staking -> TxCert era
RegTxCert Credential 'Staking
Cast.carlSHK
          , PoolParams -> TxCert ShelleyEra
forall era. EraTxCert era => PoolParams -> TxCert era
RegPoolTxCert PoolParams
Cast.alicePoolParams
          ]
            [ShelleyTxCert ShelleyEra]
-> [ShelleyTxCert ShelleyEra] -> [ShelleyTxCert ShelleyEra]
forall a. [a] -> [a] -> [a]
++ [ MIRCert -> ShelleyTxCert ShelleyEra
forall era. MIRCert -> ShelleyTxCert era
ShelleyTxCertMir
                   ( MIRPot -> MIRTarget -> MIRCert
MIRCert
                       MIRPot
ReservesMIR
                       ( Map (Credential 'Staking) DeltaCoin -> MIRTarget
StakeAddressesMIR (Map (Credential 'Staking) DeltaCoin -> MIRTarget)
-> Map (Credential 'Staking) DeltaCoin -> MIRTarget
forall a b. (a -> b) -> a -> b
$
                           [(Credential 'Staking, DeltaCoin)]
-> Map (Credential 'Staking) DeltaCoin
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
                             [ (Credential 'Staking
Cast.carlSHK, Coin -> DeltaCoin
toDeltaCoin Coin
carlMIR)
                             , (Credential 'Staking
Cast.dariaSHK, Coin -> DeltaCoin
toDeltaCoin Coin
dariaMIR)
                             ]
                       )
                   )
               ]
        )
    )
    (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 ShelleyEra)
forall a. StrictMaybe a
SNothing
    StrictMaybe TxAuxDataHash
forall a. StrictMaybe a
SNothing

txEx1 :: ShelleyTx ShelleyEra
txEx1 :: ShelleyTx ShelleyEra
txEx1 =
  TxBody ShelleyEra
-> TxWits ShelleyEra
-> StrictMaybe (TxAuxData ShelleyEra)
-> ShelleyTx ShelleyEra
forall era.
TxBody era
-> TxWits era -> StrictMaybe (TxAuxData era) -> ShelleyTx era
ShelleyTx
    TxBody ShelleyEra
txbodyEx1
    ShelleyTxWits ShelleyEra
forall a. Monoid a => a
mempty
      { addrWits =
          mkWitnessesVKey
            (hashAnnotated txbodyEx1)
            ( (asWitness <$> [Cast.alicePay, Cast.carlPay])
                <> (asWitness <$> [Cast.aliceStake])
                <> [asWitness $ aikCold Cast.alicePoolKeys]
                <> ( asWitness
                       <$> [ aikCold (coreNodeIssuerKeys 0)
                           , aikCold (coreNodeIssuerKeys 1)
                           , aikCold (coreNodeIssuerKeys 2)
                           , aikCold (coreNodeIssuerKeys 3)
                           , aikCold (coreNodeIssuerKeys 4)
                           ]
                   )
            )
      }
    StrictMaybe (TxAuxData ShelleyEra)
StrictMaybe (ShelleyTxAuxData ShelleyEra)
forall a. StrictMaybe a
SNothing

blockEx1 :: HasCallStack => Block (BHeader MockCrypto) ShelleyEra
blockEx1 :: HasCallStack => Block (BHeader MockCrypto) ShelleyEra
blockEx1 =
  HashHeader
-> AllIssuerKeys MockCrypto 'GenesisDelegate
-> [Tx ShelleyEra]
-> SlotNo
-> BlockNo
-> Nonce
-> NatNonce
-> UnitInterval
-> Word
-> Word
-> OCert MockCrypto
-> Block (BHeader MockCrypto) ShelleyEra
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 @ShelleyEra PParams ShelleyEra
forall era.
(EraPParams era, ProtVerAtMost era 4, ProtVerAtMost era 6) =>
PParams era
ppEx Word64
10)
    [Item [ShelleyTx ShelleyEra]
ShelleyTx ShelleyEra
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 @ShelleyEra PParams ShelleyEra
forall era.
(EraPParams era, ProtVerAtMost era 4, ProtVerAtMost era 6) =>
PParams era
ppEx Word64
10) Word64
0 (Word -> KESPeriod
KESPeriod Word
0))

expectedStEx1 :: ChainState ShelleyEra
expectedStEx1 :: ChainState ShelleyEra
expectedStEx1 =
  Nonce -> ChainState ShelleyEra -> ChainState ShelleyEra
forall era. Nonce -> ChainState era -> ChainState era
C.evolveNonceUnfrozen (Block (BHeader MockCrypto) ShelleyEra -> Nonce
forall era. Block (BHeader MockCrypto) era -> Nonce
getBlockNonce Block (BHeader MockCrypto) ShelleyEra
HasCallStack => Block (BHeader MockCrypto) ShelleyEra
blockEx1)
    (ChainState ShelleyEra -> ChainState ShelleyEra)
-> (ChainState ShelleyEra -> ChainState ShelleyEra)
-> ChainState ShelleyEra
-> ChainState ShelleyEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Block (BHeader MockCrypto) ShelleyEra
-> ChainState ShelleyEra -> ChainState ShelleyEra
forall era.
Block (BHeader MockCrypto) era -> ChainState era -> ChainState era
C.newLab Block (BHeader MockCrypto) ShelleyEra
HasCallStack => Block (BHeader MockCrypto) ShelleyEra
blockEx1
    (ChainState ShelleyEra -> ChainState ShelleyEra)
-> (ChainState ShelleyEra -> ChainState ShelleyEra)
-> ChainState ShelleyEra
-> ChainState ShelleyEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PParams ShelleyEra
-> Coin
-> [Credential 'Staking]
-> [PoolParams]
-> ChainState ShelleyEra
-> ChainState ShelleyEra
forall era.
(EraPParams era, EraCertState era) =>
PParams era
-> Coin
-> [Credential 'Staking]
-> [PoolParams]
-> ChainState era
-> ChainState era
C.feesAndDeposits PParams ShelleyEra
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
Cast.alicePoolParams]
    (ChainState ShelleyEra -> ChainState ShelleyEra)
-> (ChainState ShelleyEra -> ChainState ShelleyEra)
-> ChainState ShelleyEra
-> ChainState ShelleyEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxBody ShelleyEra -> ChainState ShelleyEra -> ChainState ShelleyEra
forall era.
(EraTx era, EraStake era) =>
TxBody era -> ChainState era -> ChainState era
C.newUTxO TxBody ShelleyEra
txbodyEx1
    (ChainState ShelleyEra -> ChainState ShelleyEra)
-> (ChainState ShelleyEra -> ChainState ShelleyEra)
-> ChainState ShelleyEra
-> ChainState ShelleyEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Credential 'Staking
-> Ptr -> ChainState ShelleyEra -> ChainState ShelleyEra
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 ShelleyEra -> ChainState ShelleyEra)
-> (ChainState ShelleyEra -> ChainState ShelleyEra)
-> ChainState ShelleyEra
-> ChainState ShelleyEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Credential 'Staking
-> Ptr -> ChainState ShelleyEra -> ChainState ShelleyEra
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 ShelleyEra -> ChainState ShelleyEra)
-> (ChainState ShelleyEra -> ChainState ShelleyEra)
-> ChainState ShelleyEra
-> ChainState ShelleyEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Credential 'Staking
-> Ptr -> ChainState ShelleyEra -> ChainState ShelleyEra
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 ShelleyEra -> ChainState ShelleyEra)
-> (ChainState ShelleyEra -> ChainState ShelleyEra)
-> ChainState ShelleyEra
-> ChainState ShelleyEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PoolParams -> ChainState ShelleyEra -> ChainState ShelleyEra
forall era.
EraCertState era =>
PoolParams -> ChainState era -> ChainState era
C.newPool PoolParams
Cast.alicePoolParams
    (ChainState ShelleyEra -> ChainState ShelleyEra)
-> (ChainState ShelleyEra -> ChainState ShelleyEra)
-> ChainState ShelleyEra
-> ChainState ShelleyEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Credential 'Staking
-> MIRPot -> Coin -> ChainState ShelleyEra -> ChainState ShelleyEra
forall era.
EraCertState era =>
Credential 'Staking
-> MIRPot -> Coin -> ChainState era -> ChainState era
C.mir Credential 'Staking
Cast.carlSHK MIRPot
ReservesMIR Coin
carlMIR
    (ChainState ShelleyEra -> ChainState ShelleyEra)
-> (ChainState ShelleyEra -> ChainState ShelleyEra)
-> ChainState ShelleyEra
-> ChainState ShelleyEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Credential 'Staking
-> MIRPot -> Coin -> ChainState ShelleyEra -> ChainState ShelleyEra
forall era.
EraCertState era =>
Credential 'Staking
-> MIRPot -> Coin -> ChainState era -> ChainState era
C.mir Credential 'Staking
Cast.dariaSHK MIRPot
ReservesMIR Coin
dariaMIR
    (ChainState ShelleyEra -> ChainState ShelleyEra)
-> ChainState ShelleyEra -> ChainState ShelleyEra
forall a b. (a -> b) -> a -> b
$ ChainState ShelleyEra
initStPoolLifetime

-- === Block 1, Slot 10, Epoch 0
--
-- In the first block of this example, Alice, Bob, and Carl
-- all register stake credentials, and Alice registers a stake pool.
-- Additionally, a MIR certificate is issued to draw from the reserves
-- and give Carl and Daria (who is unregistered) rewards.
poolLifetime1 :: CHAINExample ShelleyEra
poolLifetime1 :: CHAINExample ShelleyEra
poolLifetime1 = ChainState ShelleyEra
-> Block (BHeader MockCrypto) ShelleyEra
-> Either
     (NonEmpty (PredicateFailure (CHAIN ShelleyEra)))
     (ChainState ShelleyEra)
-> CHAINExample ShelleyEra
forall era.
ChainState era
-> Block (BHeader MockCrypto) era
-> Either
     (NonEmpty (PredicateFailure (CHAIN era))) (ChainState era)
-> CHAINExample era
CHAINExample ChainState ShelleyEra
initStPoolLifetime Block (BHeader MockCrypto) ShelleyEra
HasCallStack => Block (BHeader MockCrypto) ShelleyEra
blockEx1 (ChainState ShelleyEra
-> Either
     (NonEmpty (TestChainPredicateFailure ShelleyEra))
     (ChainState ShelleyEra)
forall a b. b -> Either a b
Right ChainState ShelleyEra
expectedStEx1)

--
-- Block 2, Slot 90, Epoch 0
--

feeTx2 :: Coin
feeTx2 :: Coin
feeTx2 = Integer -> Coin
Coin Integer
4

aliceCoinEx2Base :: Coin
aliceCoinEx2Base :: Coin
aliceCoinEx2Base = Integer -> Coin
Coin (Integer -> Coin) -> Integer -> Coin
forall a b. (a -> b) -> a -> b
$ Integer
5 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
1000 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
1000 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
1000 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
1000 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
1000

aliceCoinEx2Ptr :: Coin
aliceCoinEx2Ptr :: Coin
aliceCoinEx2Ptr = Coin
aliceCoinEx1 Coin -> Coin -> Coin
forall t. Val t => t -> t -> t
<-> (Coin
aliceCoinEx2Base Coin -> Coin -> Coin
forall t. Val t => t -> t -> t
<+> Coin
feeTx2)

-- | The transaction delegates Alice's and Bob's stake to Alice's pool.
--   Additionally, we split Alice's ADA between a base address and a pointer address.
txbodyEx2 :: TxBody ShelleyEra
txbodyEx2 :: TxBody ShelleyEra
txbodyEx2 =
  ShelleyTxBody
    { stbInputs :: Set TxIn
stbInputs = [TxIn] -> Set TxIn
forall a. Ord a => [a] -> Set a
Set.fromList [TxId -> TxIx -> TxIn
TxIn (TxBody ShelleyEra -> TxId
forall era. EraTxBody era => TxBody era -> TxId
txIdTxBody TxBody ShelleyEra
txbodyEx1) TxIx
forall a. Bounded a => a
minBound]
    , stbOutputs :: StrictSeq (TxOut ShelleyEra)
stbOutputs =
        [ShelleyTxOut ShelleyEra] -> StrictSeq (ShelleyTxOut ShelleyEra)
forall a. [a] -> StrictSeq a
StrictSeq.fromList
          [ Addr -> Value ShelleyEra -> ShelleyTxOut ShelleyEra
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
aliceCoinEx2Base)
          , Addr -> Value ShelleyEra -> ShelleyTxOut ShelleyEra
forall era.
(HasCallStack, Era era, Val (Value era)) =>
Addr -> Value era -> ShelleyTxOut era
ShelleyTxOut Addr
Cast.alicePtrAddr (Coin -> Coin
forall t s. Inject t s => t -> s
Val.inject Coin
aliceCoinEx2Ptr)
          ]
    , stbCerts :: StrictSeq (TxCert ShelleyEra)
stbCerts =
        [ShelleyTxCert ShelleyEra] -> StrictSeq (ShelleyTxCert ShelleyEra)
forall a. [a] -> StrictSeq a
StrictSeq.fromList
          [ Credential 'Staking -> KeyHash 'StakePool -> TxCert ShelleyEra
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 ShelleyEra
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.alicePoolKeys)
          ]
    , stbWithdrawals :: Withdrawals
stbWithdrawals = Map RewardAccount Coin -> Withdrawals
Withdrawals Map RewardAccount Coin
forall k a. Map k a
Map.empty
    , stbTxFee :: Coin
stbTxFee = Coin
feeTx2
    , stbTTL :: SlotNo
stbTTL = Word64 -> SlotNo
SlotNo Word64
90
    , stbUpdate :: StrictMaybe (Update ShelleyEra)
stbUpdate = StrictMaybe (Update ShelleyEra)
forall a. StrictMaybe a
SNothing
    , stbMDHash :: StrictMaybe TxAuxDataHash
stbMDHash = StrictMaybe TxAuxDataHash
forall a. StrictMaybe a
SNothing
    }

txEx2 :: ShelleyTx ShelleyEra
txEx2 :: ShelleyTx ShelleyEra
txEx2 =
  TxBody ShelleyEra
-> TxWits ShelleyEra
-> StrictMaybe (TxAuxData ShelleyEra)
-> ShelleyTx ShelleyEra
forall era.
TxBody era
-> TxWits era -> StrictMaybe (TxAuxData era) -> ShelleyTx era
ShelleyTx
    TxBody ShelleyEra
txbodyEx2
    ShelleyTxWits ShelleyEra
forall a. Monoid a => a
mempty
      { addrWits =
          mkWitnessesVKey
            (hashAnnotated txbodyEx2)
            [ asWitness Cast.alicePay
            , asWitness Cast.aliceStake
            , asWitness Cast.bobStake
            ]
      }
    StrictMaybe (TxAuxData ShelleyEra)
StrictMaybe (ShelleyTxAuxData ShelleyEra)
forall a. StrictMaybe a
SNothing

blockEx2 :: Block (BHeader MockCrypto) ShelleyEra
blockEx2 :: Block (BHeader MockCrypto) ShelleyEra
blockEx2 =
  HashHeader
-> AllIssuerKeys MockCrypto 'GenesisDelegate
-> [Tx ShelleyEra]
-> SlotNo
-> BlockNo
-> Nonce
-> NatNonce
-> UnitInterval
-> Word
-> Word
-> OCert MockCrypto
-> Block (BHeader MockCrypto) ShelleyEra
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) ShelleyEra -> BHeader MockCrypto
forall h era. Block h era -> h
bheader Block (BHeader MockCrypto) ShelleyEra
HasCallStack => Block (BHeader MockCrypto) ShelleyEra
blockEx1)
    (forall era.
(HasCallStack, EraPParams era) =>
PParams era -> Word64 -> AllIssuerKeys MockCrypto 'GenesisDelegate
coreNodeKeysBySchedule @ShelleyEra PParams ShelleyEra
forall era.
(EraPParams era, ProtVerAtMost era 4, ProtVerAtMost era 6) =>
PParams era
ppEx Word64
90)
    [Item [ShelleyTx ShelleyEra]
ShelleyTx ShelleyEra
txEx2]
    (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 @ShelleyEra PParams ShelleyEra
forall era.
(EraPParams era, ProtVerAtMost era 4, ProtVerAtMost era 6) =>
PParams era
ppEx Word64
90) Word64
0 (Word -> KESPeriod
KESPeriod Word
0))

makePulser :: (EraGov era, EraCertState era) => BlocksMade -> ChainState era -> PulsingRewUpdate
makePulser :: forall era.
(EraGov era, EraCertState era) =>
BlocksMade -> ChainState era -> PulsingRewUpdate
makePulser BlocksMade
bs ChainState era
cs =
  EpochSize
-> BlocksMade
-> EpochState era
-> Coin
-> ActiveSlotCoeff
-> NonZero Word64
-> PulsingRewUpdate
forall era.
(EraGov era, EraCertState era) =>
EpochSize
-> BlocksMade
-> EpochState era
-> Coin
-> ActiveSlotCoeff
-> NonZero Word64
-> PulsingRewUpdate
startStep
    (EpochNo -> EpochSize
epochSize (EpochNo -> EpochSize) -> EpochNo -> EpochSize
forall a b. (a -> b) -> a -> b
$ Word64 -> EpochNo
EpochNo Word64
0)
    BlocksMade
bs
    (NewEpochState era -> EpochState era
forall era. NewEpochState era -> EpochState era
nesEs (NewEpochState era -> EpochState era)
-> NewEpochState era -> EpochState era
forall a b. (a -> b) -> a -> b
$ ChainState era -> NewEpochState era
forall era. ChainState era -> NewEpochState era
chainNes ChainState era
cs)
    Coin
maxLLSupply
    (Globals -> ActiveSlotCoeff
activeSlotCoeff Globals
testGlobals)
    (Globals -> NonZero Word64
securityParameter Globals
testGlobals)

makePulser' :: (EraGov era, EraCertState era) => ChainState era -> PulsingRewUpdate
makePulser' :: forall era.
(EraGov era, EraCertState era) =>
ChainState era -> PulsingRewUpdate
makePulser' = BlocksMade -> ChainState era -> PulsingRewUpdate
forall era.
(EraGov era, EraCertState era) =>
BlocksMade -> ChainState era -> PulsingRewUpdate
makePulser (Map (KeyHash 'StakePool) Natural -> BlocksMade
BlocksMade Map (KeyHash 'StakePool) Natural
forall a. Monoid a => a
mempty)

makeCompletedPulser ::
  (EraGov era, EraCertState era) => BlocksMade -> ChainState era -> PulsingRewUpdate
makeCompletedPulser :: forall era.
(EraGov era, EraCertState era) =>
BlocksMade -> ChainState era -> PulsingRewUpdate
makeCompletedPulser BlocksMade
bs ChainState era
cs = RewardUpdate -> PulsingRewUpdate
Complete (RewardUpdate -> PulsingRewUpdate)
-> (PulsingRewUpdate -> RewardUpdate)
-> PulsingRewUpdate
-> PulsingRewUpdate
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RewardUpdate, RewardEvent) -> RewardUpdate
forall a b. (a, b) -> a
fst ((RewardUpdate, RewardEvent) -> RewardUpdate)
-> (PulsingRewUpdate -> (RewardUpdate, RewardEvent))
-> PulsingRewUpdate
-> RewardUpdate
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShelleyBase (RewardUpdate, RewardEvent)
-> (RewardUpdate, RewardEvent)
forall a. ShelleyBase a -> a
runShelleyBase (ShelleyBase (RewardUpdate, RewardEvent)
 -> (RewardUpdate, RewardEvent))
-> (PulsingRewUpdate -> ShelleyBase (RewardUpdate, RewardEvent))
-> PulsingRewUpdate
-> (RewardUpdate, RewardEvent)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PulsingRewUpdate -> ShelleyBase (RewardUpdate, RewardEvent)
completeRupd (PulsingRewUpdate -> PulsingRewUpdate)
-> PulsingRewUpdate -> PulsingRewUpdate
forall a b. (a -> b) -> a -> b
$ BlocksMade -> ChainState era -> PulsingRewUpdate
forall era.
(EraGov era, EraCertState era) =>
BlocksMade -> ChainState era -> PulsingRewUpdate
makePulser BlocksMade
bs ChainState era
cs

pulserEx2 :: PulsingRewUpdate
pulserEx2 :: PulsingRewUpdate
pulserEx2 = BlocksMade -> ChainState ShelleyEra -> PulsingRewUpdate
forall era.
(EraGov era, EraCertState era) =>
BlocksMade -> ChainState era -> PulsingRewUpdate
makeCompletedPulser (Map (KeyHash 'StakePool) Natural -> BlocksMade
BlocksMade Map (KeyHash 'StakePool) Natural
forall a. Monoid a => a
mempty) ChainState ShelleyEra
expectedStEx1

expectedStEx2 :: ChainState ShelleyEra
expectedStEx2 :: ChainState ShelleyEra
expectedStEx2 =
  Nonce -> ChainState ShelleyEra -> ChainState ShelleyEra
forall era. Nonce -> ChainState era -> ChainState era
C.evolveNonceFrozen (Block (BHeader MockCrypto) ShelleyEra -> Nonce
forall era. Block (BHeader MockCrypto) era -> Nonce
getBlockNonce Block (BHeader MockCrypto) ShelleyEra
blockEx2)
    (ChainState ShelleyEra -> ChainState ShelleyEra)
-> (ChainState ShelleyEra -> ChainState ShelleyEra)
-> ChainState ShelleyEra
-> ChainState ShelleyEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Block (BHeader MockCrypto) ShelleyEra
-> ChainState ShelleyEra -> ChainState ShelleyEra
forall era.
Block (BHeader MockCrypto) era -> ChainState era -> ChainState era
C.newLab Block (BHeader MockCrypto) ShelleyEra
blockEx2
    (ChainState ShelleyEra -> ChainState ShelleyEra)
-> (ChainState ShelleyEra -> ChainState ShelleyEra)
-> ChainState ShelleyEra
-> ChainState ShelleyEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PParams ShelleyEra
-> Coin
-> [Credential 'Staking]
-> [PoolParams]
-> ChainState ShelleyEra
-> ChainState ShelleyEra
forall era.
(EraPParams era, EraCertState era) =>
PParams era
-> Coin
-> [Credential 'Staking]
-> [PoolParams]
-> ChainState era
-> ChainState era
C.feesAndDeposits PParams ShelleyEra
forall era.
(EraPParams era, ProtVerAtMost era 4, ProtVerAtMost era 6) =>
PParams era
ppEx Coin
feeTx2 [] []
    (ChainState ShelleyEra -> ChainState ShelleyEra)
-> (ChainState ShelleyEra -> ChainState ShelleyEra)
-> ChainState ShelleyEra
-> ChainState ShelleyEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxBody ShelleyEra -> ChainState ShelleyEra -> ChainState ShelleyEra
forall era.
(EraTx era, EraStake era) =>
TxBody era -> ChainState era -> ChainState era
C.newUTxO TxBody ShelleyEra
txbodyEx2
    (ChainState ShelleyEra -> ChainState ShelleyEra)
-> (ChainState ShelleyEra -> ChainState ShelleyEra)
-> ChainState ShelleyEra
-> ChainState ShelleyEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Credential 'Staking
-> KeyHash 'StakePool
-> ChainState ShelleyEra
-> ChainState ShelleyEra
forall era.
EraCertState era =>
Credential 'Staking
-> KeyHash 'StakePool -> ChainState era -> ChainState era
C.delegation Credential 'Staking
Cast.aliceSHK (PoolParams -> KeyHash 'StakePool
ppId PoolParams
Cast.alicePoolParams)
    (ChainState ShelleyEra -> ChainState ShelleyEra)
-> (ChainState ShelleyEra -> ChainState ShelleyEra)
-> ChainState ShelleyEra
-> ChainState ShelleyEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Credential 'Staking
-> KeyHash 'StakePool
-> ChainState ShelleyEra
-> ChainState ShelleyEra
forall era.
EraCertState era =>
Credential 'Staking
-> KeyHash 'StakePool -> ChainState era -> ChainState era
C.delegation Credential 'Staking
Cast.bobSHK (PoolParams -> KeyHash 'StakePool
ppId PoolParams
Cast.alicePoolParams)
    (ChainState ShelleyEra -> ChainState ShelleyEra)
-> (ChainState ShelleyEra -> ChainState ShelleyEra)
-> ChainState ShelleyEra
-> ChainState ShelleyEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PulsingRewUpdate -> ChainState ShelleyEra -> ChainState ShelleyEra
forall era. PulsingRewUpdate -> ChainState era -> ChainState era
C.pulserUpdate PulsingRewUpdate
pulserEx2
    (ChainState ShelleyEra -> ChainState ShelleyEra)
-> ChainState ShelleyEra -> ChainState ShelleyEra
forall a b. (a -> b) -> a -> b
$ ChainState ShelleyEra
expectedStEx1

-- === Block 2, Slot 90, Epoch 0
--
-- In the second block Alice and Bob both delegation to Alice's Pool.
poolLifetime2 :: CHAINExample ShelleyEra
poolLifetime2 :: CHAINExample ShelleyEra
poolLifetime2 = ChainState ShelleyEra
-> Block (BHeader MockCrypto) ShelleyEra
-> Either
     (NonEmpty (PredicateFailure (CHAIN ShelleyEra)))
     (ChainState ShelleyEra)
-> CHAINExample ShelleyEra
forall era.
ChainState era
-> Block (BHeader MockCrypto) era
-> Either
     (NonEmpty (PredicateFailure (CHAIN era))) (ChainState era)
-> CHAINExample era
CHAINExample ChainState ShelleyEra
expectedStEx1 Block (BHeader MockCrypto) ShelleyEra
blockEx2 (ChainState ShelleyEra
-> Either
     (NonEmpty (TestChainPredicateFailure ShelleyEra))
     (ChainState ShelleyEra)
forall a b. b -> Either a b
Right (ChainState ShelleyEra -> ChainState ShelleyEra
forall era. EraGov era => ChainState era -> ChainState era
C.solidifyProposals ChainState ShelleyEra
expectedStEx2))

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

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

blockEx3 :: Block (BHeader MockCrypto) ShelleyEra
blockEx3 :: Block (BHeader MockCrypto) ShelleyEra
blockEx3 =
  HashHeader
-> AllIssuerKeys MockCrypto 'GenesisDelegate
-> [Tx ShelleyEra]
-> SlotNo
-> BlockNo
-> Nonce
-> NatNonce
-> UnitInterval
-> Word
-> Word
-> OCert MockCrypto
-> Block (BHeader MockCrypto) ShelleyEra
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) ShelleyEra -> BHeader MockCrypto
forall h era. Block h era -> h
bheader Block (BHeader MockCrypto) ShelleyEra
blockEx2)
    (forall era.
(HasCallStack, EraPParams era) =>
PParams era -> Word64 -> AllIssuerKeys MockCrypto 'GenesisDelegate
coreNodeKeysBySchedule @ShelleyEra PParams ShelleyEra
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 @ShelleyEra PParams ShelleyEra
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
aliceCoinEx2Base Coin -> Coin -> Coin
forall a. Semigroup a => a -> a -> a
<> Coin
aliceCoinEx2Ptr)
          , (Credential 'Staking
Cast.bobSHK, Coin
bobInitCoin)
          ]
    , $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.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
Cast.alicePoolParams)]
    }

expectedStEx3 :: ChainState ShelleyEra
expectedStEx3 :: ChainState ShelleyEra
expectedStEx3 =
  Block (BHeader MockCrypto) ShelleyEra
-> ChainState ShelleyEra -> ChainState ShelleyEra
forall era.
(ProtVerAtMost era 6, EraGov era) =>
Block (BHeader MockCrypto) era -> ChainState era -> ChainState era
C.newEpoch Block (BHeader MockCrypto) ShelleyEra
blockEx3
    (ChainState ShelleyEra -> ChainState ShelleyEra)
-> (ChainState ShelleyEra -> ChainState ShelleyEra)
-> ChainState ShelleyEra
-> ChainState ShelleyEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SnapShot -> Coin -> ChainState ShelleyEra -> ChainState ShelleyEra
forall era. SnapShot -> Coin -> ChainState era -> ChainState era
C.newSnapshot SnapShot
snapEx3 (Coin
feeTx1 Coin -> Coin -> Coin
forall a. Semigroup a => a -> a -> a
<> Coin
feeTx2)
    (ChainState ShelleyEra -> ChainState ShelleyEra)
-> (ChainState ShelleyEra -> ChainState ShelleyEra)
-> ChainState ShelleyEra
-> ChainState ShelleyEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MIRPot
-> Map (Credential 'Staking) Coin
-> ChainState ShelleyEra
-> ChainState ShelleyEra
forall era.
EraCertState era =>
MIRPot
-> Map (Credential 'Staking) Coin
-> ChainState era
-> ChainState era
C.applyMIR MIRPot
ReservesMIR (Credential 'Staking -> Coin -> Map (Credential 'Staking) Coin
forall k a. k -> a -> Map k a
Map.singleton Credential 'Staking
Cast.carlSHK Coin
carlMIR)
    (ChainState ShelleyEra -> ChainState ShelleyEra)
-> (ChainState ShelleyEra -> ChainState ShelleyEra)
-> ChainState ShelleyEra
-> ChainState ShelleyEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RewardUpdate -> ChainState ShelleyEra -> ChainState ShelleyEra
forall era.
(EraGov era, EraCertState era) =>
RewardUpdate -> ChainState era -> ChainState era
C.applyRewardUpdate RewardUpdate
emptyRewardUpdate
    (ChainState ShelleyEra -> ChainState ShelleyEra)
-> ChainState ShelleyEra -> ChainState ShelleyEra
forall a b. (a -> b) -> a -> b
$ ChainState ShelleyEra
expectedStEx2

-- === Block 3, Slot 110, Epoch 1
--
-- In the third block, an empty block in a new epoch, the first snapshot is created.
-- The rewards accounts from the MIR certificate in block 1 are now increased.
poolLifetime3 :: CHAINExample ShelleyEra
poolLifetime3 :: CHAINExample ShelleyEra
poolLifetime3 = ChainState ShelleyEra
-> Block (BHeader MockCrypto) ShelleyEra
-> Either
     (NonEmpty (PredicateFailure (CHAIN ShelleyEra)))
     (ChainState ShelleyEra)
-> CHAINExample ShelleyEra
forall era.
ChainState era
-> Block (BHeader MockCrypto) era
-> Either
     (NonEmpty (PredicateFailure (CHAIN era))) (ChainState era)
-> CHAINExample era
CHAINExample ChainState ShelleyEra
expectedStEx2 Block (BHeader MockCrypto) ShelleyEra
blockEx3 (ChainState ShelleyEra
-> Either
     (NonEmpty (TestChainPredicateFailure ShelleyEra))
     (ChainState ShelleyEra)
forall a b. b -> Either a b
Right ChainState ShelleyEra
expectedStEx3)

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

feeTx4 :: Coin
feeTx4 :: Coin
feeTx4 = Integer -> Coin
Coin Integer
5

aliceCoinEx4Base :: Coin
aliceCoinEx4Base :: Coin
aliceCoinEx4Base = Coin
aliceCoinEx2Base Coin -> Coin -> Coin
forall t. Val t => t -> t -> t
<-> Coin
feeTx4

txbodyEx4 :: TxBody ShelleyEra
txbodyEx4 :: TxBody ShelleyEra
txbodyEx4 =
  ShelleyTxBody
    { stbInputs :: Set TxIn
stbInputs = [TxIn] -> Set TxIn
forall a. Ord a => [a] -> Set a
Set.fromList [TxId -> TxIx -> TxIn
TxIn (TxBody ShelleyEra -> TxId
forall era. EraTxBody era => TxBody era -> TxId
txIdTxBody TxBody ShelleyEra
txbodyEx2) TxIx
forall a. Bounded a => a
minBound]
    , stbOutputs :: StrictSeq (TxOut ShelleyEra)
stbOutputs = [ShelleyTxOut ShelleyEra] -> StrictSeq (ShelleyTxOut ShelleyEra)
forall a. [a] -> StrictSeq a
StrictSeq.fromList [Addr -> Value ShelleyEra -> ShelleyTxOut ShelleyEra
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
aliceCoinEx4Base)]
    , stbCerts :: StrictSeq (TxCert ShelleyEra)
stbCerts =
        [ShelleyTxCert ShelleyEra] -> StrictSeq (ShelleyTxCert ShelleyEra)
forall a. [a] -> StrictSeq a
StrictSeq.fromList
          [Credential 'Staking -> KeyHash 'StakePool -> TxCert ShelleyEra
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)]
    , stbWithdrawals :: Withdrawals
stbWithdrawals = Map RewardAccount Coin -> Withdrawals
Withdrawals Map RewardAccount Coin
forall k a. Map k a
Map.empty
    , stbTxFee :: Coin
stbTxFee = Coin
feeTx4
    , stbTTL :: SlotNo
stbTTL = Word64 -> SlotNo
SlotNo Word64
500
    , stbUpdate :: StrictMaybe (Update ShelleyEra)
stbUpdate = StrictMaybe (Update ShelleyEra)
forall a. StrictMaybe a
SNothing
    , stbMDHash :: StrictMaybe TxAuxDataHash
stbMDHash = StrictMaybe TxAuxDataHash
forall a. StrictMaybe a
SNothing
    }

txEx4 :: ShelleyTx ShelleyEra
txEx4 :: ShelleyTx ShelleyEra
txEx4 =
  TxBody ShelleyEra
-> TxWits ShelleyEra
-> StrictMaybe (TxAuxData ShelleyEra)
-> ShelleyTx ShelleyEra
forall era.
TxBody era
-> TxWits era -> StrictMaybe (TxAuxData era) -> ShelleyTx era
ShelleyTx
    TxBody ShelleyEra
txbodyEx4
    ShelleyTxWits ShelleyEra
forall a. Monoid a => a
mempty
      { addrWits =
          mkWitnessesVKey
            (hashAnnotated txbodyEx4)
            [asWitness Cast.alicePay, asWitness Cast.carlStake]
      }
    StrictMaybe (TxAuxData ShelleyEra)
StrictMaybe (ShelleyTxAuxData ShelleyEra)
forall a. StrictMaybe a
SNothing

blockEx4 :: Block (BHeader MockCrypto) ShelleyEra
blockEx4 :: Block (BHeader MockCrypto) ShelleyEra
blockEx4 =
  HashHeader
-> AllIssuerKeys MockCrypto 'GenesisDelegate
-> [Tx ShelleyEra]
-> SlotNo
-> BlockNo
-> Nonce
-> NatNonce
-> UnitInterval
-> Word
-> Word
-> OCert MockCrypto
-> Block (BHeader MockCrypto) ShelleyEra
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) ShelleyEra -> BHeader MockCrypto
forall h era. Block h era -> h
bheader Block (BHeader MockCrypto) ShelleyEra
blockEx3)
    (forall era.
(HasCallStack, EraPParams era) =>
PParams era -> Word64 -> AllIssuerKeys MockCrypto 'GenesisDelegate
coreNodeKeysBySchedule @ShelleyEra PParams ShelleyEra
forall era.
(EraPParams era, ProtVerAtMost era 4, ProtVerAtMost era 6) =>
PParams era
ppEx Word64
190)
    [Item [ShelleyTx ShelleyEra]
ShelleyTx ShelleyEra
txEx4]
    (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 @ShelleyEra PParams ShelleyEra
forall era.
(EraPParams era, ProtVerAtMost era 4, ProtVerAtMost era 6) =>
PParams era
ppEx Word64
190) Word64
0 (Word -> KESPeriod
KESPeriod Word
0))

pulserEx4 :: PulsingRewUpdate
pulserEx4 :: PulsingRewUpdate
pulserEx4 = BlocksMade -> ChainState ShelleyEra -> PulsingRewUpdate
forall era.
(EraGov era, EraCertState era) =>
BlocksMade -> ChainState era -> PulsingRewUpdate
makeCompletedPulser (Map (KeyHash 'StakePool) Natural -> BlocksMade
BlocksMade Map (KeyHash 'StakePool) Natural
forall a. Monoid a => a
mempty) ChainState ShelleyEra
expectedStEx3

rewardUpdateEx4 :: RewardUpdate
rewardUpdateEx4 :: RewardUpdate
rewardUpdateEx4 =
  RewardUpdate
    { deltaT :: DeltaCoin
deltaT = Integer -> DeltaCoin
DeltaCoin Integer
1
    , deltaR :: DeltaCoin
deltaR = Integer -> DeltaCoin
DeltaCoin Integer
6
    , rs :: RewardEvent
rs = RewardEvent
forall k a. Map k a
Map.empty
    , deltaF :: DeltaCoin
deltaF = Integer -> DeltaCoin
DeltaCoin (-Integer
7)
    , nonMyopic :: NonMyopic
nonMyopic = NonMyopic
forall a. Default a => a
def {rewardPotNM = Coin 6}
    }

expectedStEx4 :: ChainState ShelleyEra
expectedStEx4 :: ChainState ShelleyEra
expectedStEx4 =
  Nonce -> ChainState ShelleyEra -> ChainState ShelleyEra
forall era. Nonce -> ChainState era -> ChainState era
C.evolveNonceFrozen (Block (BHeader MockCrypto) ShelleyEra -> Nonce
forall era. Block (BHeader MockCrypto) era -> Nonce
getBlockNonce Block (BHeader MockCrypto) ShelleyEra
blockEx4)
    (ChainState ShelleyEra -> ChainState ShelleyEra)
-> (ChainState ShelleyEra -> ChainState ShelleyEra)
-> ChainState ShelleyEra
-> ChainState ShelleyEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Block (BHeader MockCrypto) ShelleyEra
-> ChainState ShelleyEra -> ChainState ShelleyEra
forall era.
Block (BHeader MockCrypto) era -> ChainState era -> ChainState era
C.newLab Block (BHeader MockCrypto) ShelleyEra
blockEx4
    (ChainState ShelleyEra -> ChainState ShelleyEra)
-> (ChainState ShelleyEra -> ChainState ShelleyEra)
-> ChainState ShelleyEra
-> ChainState ShelleyEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PParams ShelleyEra
-> Coin
-> [Credential 'Staking]
-> [PoolParams]
-> ChainState ShelleyEra
-> ChainState ShelleyEra
forall era.
(EraPParams era, EraCertState era) =>
PParams era
-> Coin
-> [Credential 'Staking]
-> [PoolParams]
-> ChainState era
-> ChainState era
C.feesAndDeposits PParams ShelleyEra
forall era.
(EraPParams era, ProtVerAtMost era 4, ProtVerAtMost era 6) =>
PParams era
ppEx Coin
feeTx4 [] []
    (ChainState ShelleyEra -> ChainState ShelleyEra)
-> (ChainState ShelleyEra -> ChainState ShelleyEra)
-> ChainState ShelleyEra
-> ChainState ShelleyEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxBody ShelleyEra -> ChainState ShelleyEra -> ChainState ShelleyEra
forall era.
(EraTx era, EraStake era) =>
TxBody era -> ChainState era -> ChainState era
C.newUTxO TxBody ShelleyEra
txbodyEx4
    (ChainState ShelleyEra -> ChainState ShelleyEra)
-> (ChainState ShelleyEra -> ChainState ShelleyEra)
-> ChainState ShelleyEra
-> ChainState ShelleyEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Credential 'Staking
-> KeyHash 'StakePool
-> ChainState ShelleyEra
-> ChainState ShelleyEra
forall era.
EraCertState era =>
Credential 'Staking
-> KeyHash 'StakePool -> ChainState era -> ChainState era
C.delegation Credential 'Staking
Cast.carlSHK (PoolParams -> KeyHash 'StakePool
ppId PoolParams
Cast.alicePoolParams)
    (ChainState ShelleyEra -> ChainState ShelleyEra)
-> (ChainState ShelleyEra -> ChainState ShelleyEra)
-> ChainState ShelleyEra
-> ChainState ShelleyEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PulsingRewUpdate -> ChainState ShelleyEra -> ChainState ShelleyEra
forall era. PulsingRewUpdate -> ChainState era -> ChainState era
C.pulserUpdate PulsingRewUpdate
pulserEx4
    (ChainState ShelleyEra -> ChainState ShelleyEra)
-> ChainState ShelleyEra -> ChainState ShelleyEra
forall a b. (a -> b) -> a -> b
$ ChainState ShelleyEra
expectedStEx3

-- === Block 4, Slot 190, Epoch 1
--
-- We process a block late enough in the epoch in order to create a second reward update,
-- preparing the way for the first non-empty pool distribution in this running example.
-- Additionally, in order to have the stake distribution change, Carl delegates his stake.
poolLifetime4 :: CHAINExample ShelleyEra
poolLifetime4 :: CHAINExample ShelleyEra
poolLifetime4 = ChainState ShelleyEra
-> Block (BHeader MockCrypto) ShelleyEra
-> Either
     (NonEmpty (PredicateFailure (CHAIN ShelleyEra)))
     (ChainState ShelleyEra)
-> CHAINExample ShelleyEra
forall era.
ChainState era
-> Block (BHeader MockCrypto) era
-> Either
     (NonEmpty (PredicateFailure (CHAIN era))) (ChainState era)
-> CHAINExample era
CHAINExample ChainState ShelleyEra
expectedStEx3 Block (BHeader MockCrypto) ShelleyEra
blockEx4 (ChainState ShelleyEra
-> Either
     (NonEmpty (TestChainPredicateFailure ShelleyEra))
     (ChainState ShelleyEra)
forall a b. b -> Either a b
Right (ChainState ShelleyEra -> ChainState ShelleyEra
forall era. EraGov era => ChainState era -> ChainState era
C.solidifyProposals ChainState ShelleyEra
expectedStEx4))

epoch2Nonce :: Nonce
epoch2Nonce :: Nonce
epoch2Nonce =
  ChainState ShelleyEra -> Nonce
forall era. ChainState era -> Nonce
chainCandidateNonce ChainState ShelleyEra
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) ShelleyEra -> BHeader MockCrypto
forall h era. Block h era -> h
bheader Block (BHeader MockCrypto) ShelleyEra
blockEx2)

--
-- Block 5, Slot 220, Epoch 2
--

blockEx5 :: Block (BHeader MockCrypto) ShelleyEra
blockEx5 :: Block (BHeader MockCrypto) ShelleyEra
blockEx5 =
  HashHeader
-> AllIssuerKeys MockCrypto 'GenesisDelegate
-> [Tx ShelleyEra]
-> SlotNo
-> BlockNo
-> Nonce
-> NatNonce
-> UnitInterval
-> Word
-> Word
-> OCert MockCrypto
-> Block (BHeader MockCrypto) ShelleyEra
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) ShelleyEra -> BHeader MockCrypto
forall h era. Block h era -> h
bheader Block (BHeader MockCrypto) ShelleyEra
blockEx4)
    (forall era.
(HasCallStack, EraPParams era) =>
PParams era -> Word64 -> AllIssuerKeys MockCrypto 'GenesisDelegate
coreNodeKeysBySchedule @ShelleyEra PParams ShelleyEra
forall era.
(EraPParams era, ProtVerAtMost era 4, ProtVerAtMost era 6) =>
PParams era
ppEx Word64
220)
    []
    (Word64 -> SlotNo
SlotNo Word64
220)
    (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 '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 @ShelleyEra PParams ShelleyEra
forall era.
(EraPParams era, ProtVerAtMost era 4, ProtVerAtMost era 6) =>
PParams era
ppEx Word64
220) Word64
1 (Word -> KESPeriod
KESPeriod Word
10))

snapEx5 :: SnapShot
snapEx5 :: SnapShot
snapEx5 =
  SnapShot
    { $sel:ssStake:SnapShot :: Stake
ssStake =
        [(Credential 'Staking, Coin)] -> Stake
mkStake
          [ (Credential 'Staking
Cast.aliceSHK, Coin
aliceCoinEx4Base Coin -> Coin -> Coin
forall a. Semigroup a => a -> a -> a
<> Coin
aliceCoinEx2Ptr)
          , (Credential 'Staking
Cast.carlSHK, Coin
carlMIR)
          , (Credential 'Staking
Cast.bobSHK, Coin
bobInitCoin)
          ]
    , $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.carlSHK, 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.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
Cast.alicePoolParams)]
    }

pdEx5 :: PoolDistr
pdEx5 :: PoolDistr
pdEx5 =
  Map (KeyHash 'StakePool) IndividualPoolStake
-> CompactForm Coin -> PoolDistr
PoolDistr
    ( KeyHash 'StakePool
-> IndividualPoolStake
-> Map (KeyHash 'StakePool) IndividualPoolStake
forall k a. k -> a -> Map k a
Map.singleton
        (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
1
            (Word64 -> CompactForm Coin
CompactCoin Word64
1)
            VRFVerKeyHash 'StakePoolVRF
Cast.aliceVRFKeyHash
        )
    )
    (Word64 -> CompactForm Coin
CompactCoin Word64
1)

expectedStEx5 :: ChainState ShelleyEra
expectedStEx5 :: ChainState ShelleyEra
expectedStEx5 =
  Block (BHeader MockCrypto) ShelleyEra
-> ChainState ShelleyEra -> ChainState ShelleyEra
forall era.
(ProtVerAtMost era 6, EraGov era) =>
Block (BHeader MockCrypto) era -> ChainState era -> ChainState era
C.newEpoch Block (BHeader MockCrypto) ShelleyEra
blockEx5
    (ChainState ShelleyEra -> ChainState ShelleyEra)
-> (ChainState ShelleyEra -> ChainState ShelleyEra)
-> ChainState ShelleyEra
-> ChainState ShelleyEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SnapShot -> Coin -> ChainState ShelleyEra -> ChainState ShelleyEra
forall era. SnapShot -> Coin -> ChainState era -> ChainState era
C.newSnapshot SnapShot
snapEx5 Coin
feeTx4
    (ChainState ShelleyEra -> ChainState ShelleyEra)
-> (ChainState ShelleyEra -> ChainState ShelleyEra)
-> ChainState ShelleyEra
-> ChainState ShelleyEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RewardUpdate -> ChainState ShelleyEra -> ChainState ShelleyEra
forall era.
(EraGov era, EraCertState era) =>
RewardUpdate -> ChainState era -> ChainState era
C.applyRewardUpdate RewardUpdate
rewardUpdateEx4
    (ChainState ShelleyEra -> ChainState ShelleyEra)
-> (ChainState ShelleyEra -> ChainState ShelleyEra)
-> ChainState ShelleyEra
-> ChainState ShelleyEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PoolDistr -> ChainState ShelleyEra -> ChainState ShelleyEra
forall era. PoolDistr -> ChainState era -> ChainState era
C.setPoolDistr PoolDistr
pdEx5
    (ChainState ShelleyEra -> ChainState ShelleyEra)
-> (ChainState ShelleyEra -> ChainState ShelleyEra)
-> ChainState ShelleyEra
-> ChainState ShelleyEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyHash 'BlockIssuer
-> Word64 -> ChainState ShelleyEra -> ChainState ShelleyEra
forall era.
KeyHash 'BlockIssuer -> Word64 -> ChainState era -> ChainState era
C.setOCertCounter KeyHash 'BlockIssuer
forall {r' :: KeyRole}. KeyHash r'
coreNodeHK Word64
1
    (ChainState ShelleyEra -> ChainState ShelleyEra)
-> ChainState ShelleyEra -> ChainState ShelleyEra
forall a b. (a -> b) -> a -> b
$ ChainState ShelleyEra
expectedStEx4
  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 @ShelleyEra PParams ShelleyEra
forall era.
(EraPParams era, ProtVerAtMost era 4, ProtVerAtMost era 6) =>
PParams era
ppEx Word64
220

-- === Block 5, Slot 220, Epoch 2
--
-- Create the first non-empty pool distribution
-- by creating a block in the third epoch of this running example.
poolLifetime5 :: CHAINExample ShelleyEra
poolLifetime5 :: CHAINExample ShelleyEra
poolLifetime5 = ChainState ShelleyEra
-> Block (BHeader MockCrypto) ShelleyEra
-> Either
     (NonEmpty (PredicateFailure (CHAIN ShelleyEra)))
     (ChainState ShelleyEra)
-> CHAINExample ShelleyEra
forall era.
ChainState era
-> Block (BHeader MockCrypto) era
-> Either
     (NonEmpty (PredicateFailure (CHAIN era))) (ChainState era)
-> CHAINExample era
CHAINExample ChainState ShelleyEra
expectedStEx4 Block (BHeader MockCrypto) ShelleyEra
blockEx5 (ChainState ShelleyEra
-> Either
     (NonEmpty (TestChainPredicateFailure ShelleyEra))
     (ChainState ShelleyEra)
forall a b. b -> Either a b
Right ChainState ShelleyEra
expectedStEx5)

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

blockEx6 :: Block (BHeader MockCrypto) ShelleyEra
blockEx6 :: Block (BHeader MockCrypto) ShelleyEra
blockEx6 =
  HashHeader
-> AllIssuerKeys MockCrypto 'StakePool
-> [Tx ShelleyEra]
-> SlotNo
-> BlockNo
-> Nonce
-> NatNonce
-> UnitInterval
-> Word
-> Word
-> OCert MockCrypto
-> Block (BHeader MockCrypto) ShelleyEra
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) ShelleyEra -> BHeader MockCrypto
forall h era. Block h era -> h
bheader Block (BHeader MockCrypto) ShelleyEra
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))

rewardUpdateEx6 :: RewardUpdate
rewardUpdateEx6 :: RewardUpdate
rewardUpdateEx6 =
  RewardUpdate
    { deltaT :: DeltaCoin
deltaT = Integer -> DeltaCoin
DeltaCoin Integer
1
    , deltaR :: DeltaCoin
deltaR = Integer -> DeltaCoin
DeltaCoin Integer
4
    , rs :: RewardEvent
rs = RewardEvent
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
feeTx4
    , nonMyopic :: NonMyopic
nonMyopic = NonMyopic
forall a. Default a => a
def {rewardPotNM = Coin 4}
    }

pulserEx6 :: PulsingRewUpdate
pulserEx6 :: PulsingRewUpdate
pulserEx6 = BlocksMade -> ChainState ShelleyEra -> PulsingRewUpdate
forall era.
(EraGov era, EraCertState era) =>
BlocksMade -> ChainState era -> PulsingRewUpdate
makeCompletedPulser (Map (KeyHash 'StakePool) Natural -> BlocksMade
BlocksMade Map (KeyHash 'StakePool) Natural
forall a. Monoid a => a
mempty) ChainState ShelleyEra
expectedStEx5

expectedStEx6 :: ChainState ShelleyEra
expectedStEx6 :: ChainState ShelleyEra
expectedStEx6 =
  Nonce -> ChainState ShelleyEra -> ChainState ShelleyEra
forall era. Nonce -> ChainState era -> ChainState era
C.evolveNonceFrozen (Block (BHeader MockCrypto) ShelleyEra -> Nonce
forall era. Block (BHeader MockCrypto) era -> Nonce
getBlockNonce Block (BHeader MockCrypto) ShelleyEra
blockEx6)
    (ChainState ShelleyEra -> ChainState ShelleyEra)
-> (ChainState ShelleyEra -> ChainState ShelleyEra)
-> ChainState ShelleyEra
-> ChainState ShelleyEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Block (BHeader MockCrypto) ShelleyEra
-> ChainState ShelleyEra -> ChainState ShelleyEra
forall era.
Block (BHeader MockCrypto) era -> ChainState era -> ChainState era
C.newLab Block (BHeader MockCrypto) ShelleyEra
blockEx6
    (ChainState ShelleyEra -> ChainState ShelleyEra)
-> (ChainState ShelleyEra -> ChainState ShelleyEra)
-> ChainState ShelleyEra
-> ChainState ShelleyEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyHash 'BlockIssuer
-> Word64 -> ChainState ShelleyEra -> ChainState ShelleyEra
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 ShelleyEra -> ChainState ShelleyEra)
-> (ChainState ShelleyEra -> ChainState ShelleyEra)
-> ChainState ShelleyEra
-> ChainState ShelleyEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyHash 'StakePool
-> ChainState ShelleyEra -> ChainState ShelleyEra
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 ShelleyEra -> ChainState ShelleyEra)
-> (ChainState ShelleyEra -> ChainState ShelleyEra)
-> ChainState ShelleyEra
-> ChainState ShelleyEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PulsingRewUpdate -> ChainState ShelleyEra -> ChainState ShelleyEra
forall era. PulsingRewUpdate -> ChainState era -> ChainState era
C.pulserUpdate PulsingRewUpdate
pulserEx6
    (ChainState ShelleyEra -> ChainState ShelleyEra)
-> ChainState ShelleyEra -> ChainState ShelleyEra
forall a b. (a -> b) -> a -> b
$ ChainState ShelleyEra
expectedStEx5

-- === Block 6, Slot 295, Epoch 2
--
-- Create a decentralized Praos block (ie one not in the overlay schedule)
poolLifetime6 :: CHAINExample ShelleyEra
poolLifetime6 :: CHAINExample ShelleyEra
poolLifetime6 = ChainState ShelleyEra
-> Block (BHeader MockCrypto) ShelleyEra
-> Either
     (NonEmpty (PredicateFailure (CHAIN ShelleyEra)))
     (ChainState ShelleyEra)
-> CHAINExample ShelleyEra
forall era.
ChainState era
-> Block (BHeader MockCrypto) era
-> Either
     (NonEmpty (PredicateFailure (CHAIN era))) (ChainState era)
-> CHAINExample era
CHAINExample ChainState ShelleyEra
expectedStEx5 Block (BHeader MockCrypto) ShelleyEra
blockEx6 (ChainState ShelleyEra
-> Either
     (NonEmpty (TestChainPredicateFailure ShelleyEra))
     (ChainState ShelleyEra)
forall a b. b -> Either a b
Right (ChainState ShelleyEra -> ChainState ShelleyEra
forall era. EraGov era => ChainState era -> ChainState era
C.solidifyProposals ChainState ShelleyEra
expectedStEx6))

--
-- Block 7, Slot 310, Epoch 3
--

epoch3Nonce :: Nonce
epoch3Nonce :: Nonce
epoch3Nonce =
  ChainState ShelleyEra -> Nonce
forall era. ChainState era -> Nonce
chainCandidateNonce ChainState ShelleyEra
expectedStEx6
    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) ShelleyEra -> BHeader MockCrypto
forall h era. Block h era -> h
bheader Block (BHeader MockCrypto) ShelleyEra
blockEx4)

blockEx7 :: Block (BHeader MockCrypto) ShelleyEra
blockEx7 :: Block (BHeader MockCrypto) ShelleyEra
blockEx7 =
  HashHeader
-> AllIssuerKeys MockCrypto 'GenesisDelegate
-> [Tx ShelleyEra]
-> SlotNo
-> BlockNo
-> Nonce
-> NatNonce
-> UnitInterval
-> Word
-> Word
-> OCert MockCrypto
-> Block (BHeader MockCrypto) ShelleyEra
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) ShelleyEra -> BHeader MockCrypto
forall h era. Block h era -> h
bheader Block (BHeader MockCrypto) ShelleyEra
blockEx6)
    (forall era.
(HasCallStack, EraPParams era) =>
PParams era -> Word64 -> AllIssuerKeys MockCrypto 'GenesisDelegate
coreNodeKeysBySchedule @ShelleyEra PParams ShelleyEra
forall era.
(EraPParams era, ProtVerAtMost era 4, ProtVerAtMost era 6) =>
PParams era
ppEx Word64
310)
    []
    (Word64 -> SlotNo
SlotNo Word64
310)
    (Word64 -> BlockNo
BlockNo Word64
7)
    Nonce
epoch3Nonce
    (Natural -> NatNonce
NatNonce Natural
7)
    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 @ShelleyEra PParams ShelleyEra
forall era.
(EraPParams era, ProtVerAtMost era 4, ProtVerAtMost era 6) =>
PParams era
ppEx Word64
310) Word64
1 (Word -> KESPeriod
KESPeriod Word
15))

expectedStEx7 :: ChainState ShelleyEra
expectedStEx7 :: ChainState ShelleyEra
expectedStEx7 =
  Block (BHeader MockCrypto) ShelleyEra
-> ChainState ShelleyEra -> ChainState ShelleyEra
forall era.
(ProtVerAtMost era 6, EraGov era) =>
Block (BHeader MockCrypto) era -> ChainState era -> ChainState era
C.newEpoch Block (BHeader MockCrypto) ShelleyEra
blockEx7
    (ChainState ShelleyEra -> ChainState ShelleyEra)
-> (ChainState ShelleyEra -> ChainState ShelleyEra)
-> ChainState ShelleyEra
-> ChainState ShelleyEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SnapShot -> Coin -> ChainState ShelleyEra -> ChainState ShelleyEra
forall era. SnapShot -> Coin -> ChainState era -> ChainState era
C.newSnapshot SnapShot
snapEx5 (Integer -> Coin
Coin Integer
0)
    (ChainState ShelleyEra -> ChainState ShelleyEra)
-> (ChainState ShelleyEra -> ChainState ShelleyEra)
-> ChainState ShelleyEra
-> ChainState ShelleyEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RewardUpdate -> ChainState ShelleyEra -> ChainState ShelleyEra
forall era.
(EraGov era, EraCertState era) =>
RewardUpdate -> ChainState era -> ChainState era
C.applyRewardUpdate RewardUpdate
rewardUpdateEx6
    (ChainState ShelleyEra -> ChainState ShelleyEra)
-> (ChainState ShelleyEra -> ChainState ShelleyEra)
-> ChainState ShelleyEra
-> ChainState ShelleyEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyHash 'BlockIssuer
-> Word64 -> ChainState ShelleyEra -> ChainState ShelleyEra
forall era.
KeyHash 'BlockIssuer -> Word64 -> ChainState era -> ChainState era
C.setOCertCounter KeyHash 'BlockIssuer
forall {r' :: KeyRole}. KeyHash r'
coreNodeHK Word64
1
    (ChainState ShelleyEra -> ChainState ShelleyEra)
-> ChainState ShelleyEra -> ChainState ShelleyEra
forall a b. (a -> b) -> a -> b
$ ChainState ShelleyEra
expectedStEx6
  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 @ShelleyEra PParams ShelleyEra
forall era.
(EraPParams era, ProtVerAtMost era 4, ProtVerAtMost era 6) =>
PParams era
ppEx Word64
310

-- === Block 7, Slot 310, Epoch 3
--
-- Create an empty block in the next epoch
-- to prepare the way for the first non-trivial reward update
poolLifetime7 :: CHAINExample ShelleyEra
poolLifetime7 :: CHAINExample ShelleyEra
poolLifetime7 = ChainState ShelleyEra
-> Block (BHeader MockCrypto) ShelleyEra
-> Either
     (NonEmpty (PredicateFailure (CHAIN ShelleyEra)))
     (ChainState ShelleyEra)
-> CHAINExample ShelleyEra
forall era.
ChainState era
-> Block (BHeader MockCrypto) era
-> Either
     (NonEmpty (PredicateFailure (CHAIN era))) (ChainState era)
-> CHAINExample era
CHAINExample ChainState ShelleyEra
expectedStEx6 Block (BHeader MockCrypto) ShelleyEra
blockEx7 (ChainState ShelleyEra
-> Either
     (NonEmpty (TestChainPredicateFailure ShelleyEra))
     (ChainState ShelleyEra)
forall a b. b -> Either a b
Right ChainState ShelleyEra
expectedStEx7)

--
-- Block 8, Slot 390, Epoch 3
--

blockEx8 :: Block (BHeader MockCrypto) ShelleyEra
blockEx8 :: Block (BHeader MockCrypto) ShelleyEra
blockEx8 =
  HashHeader
-> AllIssuerKeys MockCrypto 'GenesisDelegate
-> [Tx ShelleyEra]
-> SlotNo
-> BlockNo
-> Nonce
-> NatNonce
-> UnitInterval
-> Word
-> Word
-> OCert MockCrypto
-> Block (BHeader MockCrypto) ShelleyEra
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) ShelleyEra -> BHeader MockCrypto
forall h era. Block h era -> h
bheader Block (BHeader MockCrypto) ShelleyEra
blockEx7)
    (forall era.
(HasCallStack, EraPParams era) =>
PParams era -> Word64 -> AllIssuerKeys MockCrypto 'GenesisDelegate
coreNodeKeysBySchedule @ShelleyEra PParams ShelleyEra
forall era.
(EraPParams era, ProtVerAtMost era 4, ProtVerAtMost era 6) =>
PParams era
ppEx Word64
390)
    []
    (Word64 -> SlotNo
SlotNo Word64
390)
    (Word64 -> BlockNo
BlockNo Word64
8)
    Nonce
epoch3Nonce
    (Natural -> NatNonce
NatNonce Natural
8)
    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 @ShelleyEra PParams ShelleyEra
forall era.
(EraPParams era, ProtVerAtMost era 4, ProtVerAtMost era 6) =>
PParams era
ppEx Word64
390) Word64
2 (Word -> KESPeriod
KESPeriod Word
19))

aliceRAcnt8 :: Coin
aliceRAcnt8 :: Coin
aliceRAcnt8 = Integer -> Coin
Coin Integer
11654787878

bobRAcnt8 :: Coin
bobRAcnt8 :: Coin
bobRAcnt8 = Integer -> Coin
Coin Integer
1038545454

deltaT8' :: Coin
deltaT8' :: Coin
deltaT8' = Integer -> Coin
Coin Integer
317333333333

deltaT8 :: DeltaCoin
deltaT8 :: DeltaCoin
deltaT8 = Coin -> DeltaCoin
toDeltaCoin Coin
deltaT8'

deltaR8 :: DeltaCoin
deltaR8 :: DeltaCoin
deltaR8 = Integer -> DeltaCoin
DeltaCoin (-Integer
330026666665)

reserves7 :: Coin
reserves7 :: Coin
reserves7 = Integer -> Coin
Coin Integer
33999999999999900

rewardPot8 :: Coin
rewardPot8 :: Coin
rewardPot8 = Integer -> Coin
Coin Integer
1269333333333

alicePerfEx8 :: Likelihood
alicePerfEx8 :: Likelihood
alicePerfEx8 = 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
relativeStake (Rational -> UnitInterval
forall r.
(HasCallStack, Typeable r, BoundedRational r) =>
Rational -> r
unsafeBoundRational Rational
0.5)
    (Coin Integer
stake) = Coin
aliceCoinEx2Base Coin -> Coin -> Coin
forall a. Semigroup a => a -> a -> a
<> Coin
aliceCoinEx2Ptr Coin -> Coin -> Coin
forall a. Semigroup a => a -> a -> a
<> Coin
bobInitCoin
    (Coin Integer
tot) = Coin
maxLLSupply Coin -> Coin -> Coin
forall t. Val t => t -> t -> t
<-> Coin
reserves7
    relativeStake :: Rational
relativeStake = Rational -> Rational
forall a. Fractional a => Rational -> a
fromRational (Integer
stake Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
tot)
    f :: ActiveSlotCoeff
f = Globals -> ActiveSlotCoeff
activeSlotCoeff Globals
testGlobals

nonMyopicEx8 :: NonMyopic
nonMyopicEx8 :: NonMyopic
nonMyopicEx8 =
  Map (KeyHash 'StakePool) Likelihood -> Coin -> NonMyopic
NonMyopic
    (KeyHash 'StakePool
-> Likelihood -> Map (KeyHash 'StakePool) Likelihood
forall k a. k -> a -> Map k a
Map.singleton (AllIssuerKeys MockCrypto 'StakePool -> KeyHash 'StakePool
forall c (r :: KeyRole). AllIssuerKeys c r -> KeyHash r
aikColdKeyHash AllIssuerKeys MockCrypto 'StakePool
Cast.alicePoolKeys) Likelihood
alicePerfEx8)
    Coin
rewardPot8

pulserEx8 :: PulsingRewUpdate
pulserEx8 :: PulsingRewUpdate
pulserEx8 =
  BlocksMade -> ChainState ShelleyEra -> 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. k -> a -> Map k a
Map.singleton (AllIssuerKeys MockCrypto 'StakePool -> KeyHash 'StakePool
forall c (r :: KeyRole). AllIssuerKeys c r -> KeyHash r
aikColdKeyHash AllIssuerKeys MockCrypto 'StakePool
Cast.alicePoolKeys) Natural
1) ChainState ShelleyEra
expectedStEx7

rewardUpdateEx8 :: RewardUpdate
rewardUpdateEx8 :: RewardUpdate
rewardUpdateEx8 =
  RewardUpdate
    { deltaT :: DeltaCoin
deltaT = DeltaCoin
deltaT8
    , deltaR :: DeltaCoin
deltaR = DeltaCoin
deltaR8
    , rs :: RewardEvent
rs =
        [(Credential 'Staking, Set Reward)] -> RewardEvent
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
          [
            ( Credential 'Staking
Cast.aliceSHK
            , Reward -> Set Reward
forall a. a -> Set a
Set.singleton (Reward -> Set Reward) -> Reward -> Set Reward
forall a b. (a -> b) -> a -> b
$ 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
aliceRAcnt8
            )
          ,
            ( Credential 'Staking
Cast.bobSHK
            , Reward -> Set Reward
forall a. a -> Set a
Set.singleton (Reward -> Set Reward) -> Reward -> Set Reward
forall a b. (a -> b) -> a -> b
$ 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
bobRAcnt8
            )
          ]
    , deltaF :: DeltaCoin
deltaF = Integer -> DeltaCoin
DeltaCoin Integer
0
    , nonMyopic :: NonMyopic
nonMyopic = NonMyopic
nonMyopicEx8
    }

expectedStEx8 :: ChainState ShelleyEra
expectedStEx8 :: ChainState ShelleyEra
expectedStEx8 =
  Nonce -> ChainState ShelleyEra -> ChainState ShelleyEra
forall era. Nonce -> ChainState era -> ChainState era
C.evolveNonceFrozen (Block (BHeader MockCrypto) ShelleyEra -> Nonce
forall era. Block (BHeader MockCrypto) era -> Nonce
getBlockNonce Block (BHeader MockCrypto) ShelleyEra
blockEx8)
    (ChainState ShelleyEra -> ChainState ShelleyEra)
-> (ChainState ShelleyEra -> ChainState ShelleyEra)
-> ChainState ShelleyEra
-> ChainState ShelleyEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Block (BHeader MockCrypto) ShelleyEra
-> ChainState ShelleyEra -> ChainState ShelleyEra
forall era.
Block (BHeader MockCrypto) era -> ChainState era -> ChainState era
C.newLab Block (BHeader MockCrypto) ShelleyEra
blockEx8
    (ChainState ShelleyEra -> ChainState ShelleyEra)
-> (ChainState ShelleyEra -> ChainState ShelleyEra)
-> ChainState ShelleyEra
-> ChainState ShelleyEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyHash 'BlockIssuer
-> Word64 -> ChainState ShelleyEra -> ChainState ShelleyEra
forall era.
KeyHash 'BlockIssuer -> Word64 -> ChainState era -> ChainState era
C.setOCertCounter KeyHash 'BlockIssuer
forall {r' :: KeyRole}. KeyHash r'
coreNodeHK Word64
2
    (ChainState ShelleyEra -> ChainState ShelleyEra)
-> (ChainState ShelleyEra -> ChainState ShelleyEra)
-> ChainState ShelleyEra
-> ChainState ShelleyEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PulsingRewUpdate -> ChainState ShelleyEra -> ChainState ShelleyEra
forall era. PulsingRewUpdate -> ChainState era -> ChainState era
C.pulserUpdate PulsingRewUpdate
pulserEx8
    (ChainState ShelleyEra -> ChainState ShelleyEra)
-> ChainState ShelleyEra -> ChainState ShelleyEra
forall a b. (a -> b) -> a -> b
$ ChainState ShelleyEra
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 @ShelleyEra PParams ShelleyEra
forall era.
(EraPParams era, ProtVerAtMost era 4, ProtVerAtMost era 6) =>
PParams era
ppEx Word64
390

-- === Block 8, Slot 390, Epoch 3
--
-- Create the first non-trivial reward update.
poolLifetime8 :: CHAINExample ShelleyEra
poolLifetime8 :: CHAINExample ShelleyEra
poolLifetime8 = ChainState ShelleyEra
-> Block (BHeader MockCrypto) ShelleyEra
-> Either
     (NonEmpty (PredicateFailure (CHAIN ShelleyEra)))
     (ChainState ShelleyEra)
-> CHAINExample ShelleyEra
forall era.
ChainState era
-> Block (BHeader MockCrypto) era
-> Either
     (NonEmpty (PredicateFailure (CHAIN era))) (ChainState era)
-> CHAINExample era
CHAINExample ChainState ShelleyEra
expectedStEx7 Block (BHeader MockCrypto) ShelleyEra
blockEx8 (ChainState ShelleyEra
-> Either
     (NonEmpty (TestChainPredicateFailure ShelleyEra))
     (ChainState ShelleyEra)
forall a b. b -> Either a b
Right (ChainState ShelleyEra -> ChainState ShelleyEra
forall era. EraGov era => ChainState era -> ChainState era
C.solidifyProposals ChainState ShelleyEra
expectedStEx8))

--
-- Block 9, Slot 410, Epoch 4
--

epoch4Nonce :: Nonce
epoch4Nonce :: Nonce
epoch4Nonce =
  ChainState ShelleyEra -> Nonce
forall era. ChainState era -> Nonce
chainCandidateNonce ChainState ShelleyEra
expectedStEx8
    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) ShelleyEra -> BHeader MockCrypto
forall h era. Block h era -> h
bheader Block (BHeader MockCrypto) ShelleyEra
blockEx6)

blockEx9 :: Block (BHeader MockCrypto) ShelleyEra
blockEx9 :: Block (BHeader MockCrypto) ShelleyEra
blockEx9 =
  HashHeader
-> AllIssuerKeys MockCrypto 'GenesisDelegate
-> [Tx ShelleyEra]
-> SlotNo
-> BlockNo
-> Nonce
-> NatNonce
-> UnitInterval
-> Word
-> Word
-> OCert MockCrypto
-> Block (BHeader MockCrypto) ShelleyEra
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) ShelleyEra -> BHeader MockCrypto
forall h era. Block h era -> h
bheader Block (BHeader MockCrypto) ShelleyEra
blockEx8)
    (forall era.
(HasCallStack, EraPParams era) =>
PParams era -> Word64 -> AllIssuerKeys MockCrypto 'GenesisDelegate
coreNodeKeysBySchedule @ShelleyEra PParams ShelleyEra
forall era.
(EraPParams era, ProtVerAtMost era 4, ProtVerAtMost era 6) =>
PParams era
ppEx Word64
410)
    []
    (Word64 -> SlotNo
SlotNo Word64
410)
    (Word64 -> BlockNo
BlockNo Word64
9)
    Nonce
epoch4Nonce
    (Natural -> NatNonce
NatNonce Natural
9)
    UnitInterval
forall a. Bounded a => a
minBound
    Word
20
    Word
20
    (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 @ShelleyEra PParams ShelleyEra
forall era.
(EraPParams era, ProtVerAtMost era 4, ProtVerAtMost era 6) =>
PParams era
ppEx Word64
410) Word64
2 (Word -> KESPeriod
KESPeriod Word
20))

snapEx9 :: SnapShot
snapEx9 :: SnapShot
snapEx9 =
  SnapShot
snapEx5
    { ssStake =
        mkStake
          [ (Cast.bobSHK, bobInitCoin <> bobRAcnt8)
          , (Cast.aliceSHK, aliceCoinEx4Base <> aliceCoinEx2Ptr <> aliceRAcnt8)
          , (Cast.carlSHK, carlMIR)
          ]
    }

expectedStEx9 :: ChainState ShelleyEra
expectedStEx9 :: ChainState ShelleyEra
expectedStEx9 =
  Block (BHeader MockCrypto) ShelleyEra
-> ChainState ShelleyEra -> ChainState ShelleyEra
forall era.
(ProtVerAtMost era 6, EraGov era) =>
Block (BHeader MockCrypto) era -> ChainState era -> ChainState era
C.newEpoch Block (BHeader MockCrypto) ShelleyEra
blockEx9
    (ChainState ShelleyEra -> ChainState ShelleyEra)
-> (ChainState ShelleyEra -> ChainState ShelleyEra)
-> ChainState ShelleyEra
-> ChainState ShelleyEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SnapShot -> Coin -> ChainState ShelleyEra -> ChainState ShelleyEra
forall era. SnapShot -> Coin -> ChainState era -> ChainState era
C.newSnapshot SnapShot
snapEx9 (Integer -> Coin
Coin Integer
0)
    (ChainState ShelleyEra -> ChainState ShelleyEra)
-> (ChainState ShelleyEra -> ChainState ShelleyEra)
-> ChainState ShelleyEra
-> ChainState ShelleyEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RewardUpdate -> ChainState ShelleyEra -> ChainState ShelleyEra
forall era.
(EraGov era, EraCertState era) =>
RewardUpdate -> ChainState era -> ChainState era
C.applyRewardUpdate RewardUpdate
rewardUpdateEx8
    (ChainState ShelleyEra -> ChainState ShelleyEra)
-> (ChainState ShelleyEra -> ChainState ShelleyEra)
-> ChainState ShelleyEra
-> ChainState ShelleyEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyHash 'BlockIssuer
-> Word64 -> ChainState ShelleyEra -> ChainState ShelleyEra
forall era.
KeyHash 'BlockIssuer -> Word64 -> ChainState era -> ChainState era
C.setOCertCounter KeyHash 'BlockIssuer
forall {r' :: KeyRole}. KeyHash r'
coreNodeHK Word64
2
    (ChainState ShelleyEra -> ChainState ShelleyEra)
-> ChainState ShelleyEra -> ChainState ShelleyEra
forall a b. (a -> b) -> a -> b
$ ChainState ShelleyEra
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 @ShelleyEra PParams ShelleyEra
forall era.
(EraPParams era, ProtVerAtMost era 4, ProtVerAtMost era 6) =>
PParams era
ppEx Word64
410

-- === Block 9, Slot 410, Epoch 4
--
-- Apply the first non-trivial reward update.
poolLifetime9 :: CHAINExample ShelleyEra
poolLifetime9 :: CHAINExample ShelleyEra
poolLifetime9 = ChainState ShelleyEra
-> Block (BHeader MockCrypto) ShelleyEra
-> Either
     (NonEmpty (PredicateFailure (CHAIN ShelleyEra)))
     (ChainState ShelleyEra)
-> CHAINExample ShelleyEra
forall era.
ChainState era
-> Block (BHeader MockCrypto) era
-> Either
     (NonEmpty (PredicateFailure (CHAIN era))) (ChainState era)
-> CHAINExample era
CHAINExample ChainState ShelleyEra
expectedStEx8 Block (BHeader MockCrypto) ShelleyEra
blockEx9 (ChainState ShelleyEra
-> Either
     (NonEmpty (TestChainPredicateFailure ShelleyEra))
     (ChainState ShelleyEra)
forall a b. b -> Either a b
Right ChainState ShelleyEra
expectedStEx9)

--
-- Block 10, Slot 420, Epoch 4
--

feeTx10 :: Coin
feeTx10 :: Coin
feeTx10 = Integer -> Coin
Coin Integer
9

bobAda10 :: Coin
bobAda10 :: Coin
bobAda10 =
  Coin
bobRAcnt8
    Coin -> Coin -> Coin
forall t. Val t => t -> t -> t
<+> Coin
bobInitCoin
    Coin -> Coin -> Coin
forall t. Val t => t -> t -> t
<+> Integer -> Coin
Coin Integer
7
    Coin -> Coin -> Coin
forall t. Val t => t -> t -> t
<-> Coin
feeTx10

txbodyEx10 :: TxBody ShelleyEra
txbodyEx10 :: TxBody ShelleyEra
txbodyEx10 =
  Set TxIn
-> StrictSeq (TxOut ShelleyEra)
-> StrictSeq (TxCert ShelleyEra)
-> Withdrawals
-> Coin
-> SlotNo
-> StrictMaybe (Update ShelleyEra)
-> StrictMaybe TxAuxDataHash
-> TxBody ShelleyEra
ShelleyTxBody
    ([TxIn] -> Set TxIn
forall a. Ord a => [a] -> Set a
Set.fromList [HasCallStack => TxId -> Integer -> TxIn
TxId -> Integer -> TxIn
mkTxInPartial TxId
genesisId Integer
1])
    (TxOut ShelleyEra -> StrictSeq (TxOut ShelleyEra)
forall a. a -> StrictSeq a
StrictSeq.singleton (TxOut ShelleyEra -> StrictSeq (TxOut ShelleyEra))
-> TxOut ShelleyEra -> StrictSeq (TxOut ShelleyEra)
forall a b. (a -> b) -> a -> b
$ Addr -> Value ShelleyEra -> ShelleyTxOut ShelleyEra
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
bobAda10))
    ([ShelleyTxCert ShelleyEra] -> StrictSeq (ShelleyTxCert ShelleyEra)
forall a. [a] -> StrictSeq a
StrictSeq.fromList [Credential 'Staking -> TxCert ShelleyEra
forall era.
ShelleyEraTxCert era =>
Credential 'Staking -> TxCert era
UnRegTxCert Credential 'Staking
Cast.bobSHK])
    (Map RewardAccount Coin -> Withdrawals
Withdrawals (Map RewardAccount Coin -> Withdrawals)
-> Map RewardAccount Coin -> Withdrawals
forall a b. (a -> b) -> a -> b
$ RewardAccount -> Coin -> Map RewardAccount Coin
forall k a. k -> a -> Map k a
Map.singleton (Network -> Credential 'Staking -> RewardAccount
RewardAccount Network
Testnet Credential 'Staking
Cast.bobSHK) Coin
bobRAcnt8)
    Coin
feeTx10
    (Word64 -> SlotNo
SlotNo Word64
500)
    StrictMaybe (Update ShelleyEra)
forall a. StrictMaybe a
SNothing
    StrictMaybe TxAuxDataHash
forall a. StrictMaybe a
SNothing

txEx10 :: ShelleyTx ShelleyEra
txEx10 :: ShelleyTx ShelleyEra
txEx10 =
  TxBody ShelleyEra
-> TxWits ShelleyEra
-> StrictMaybe (TxAuxData ShelleyEra)
-> ShelleyTx ShelleyEra
forall era.
TxBody era
-> TxWits era -> StrictMaybe (TxAuxData era) -> ShelleyTx era
ShelleyTx
    TxBody ShelleyEra
txbodyEx10
    ShelleyTxWits ShelleyEra
forall a. Monoid a => a
mempty
      { addrWits =
          mkWitnessesVKey (hashAnnotated txbodyEx10) [asWitness Cast.bobPay, asWitness Cast.bobStake]
      }
    StrictMaybe (TxAuxData ShelleyEra)
StrictMaybe (ShelleyTxAuxData ShelleyEra)
forall a. StrictMaybe a
SNothing

blockEx10 :: Block (BHeader MockCrypto) ShelleyEra
blockEx10 :: Block (BHeader MockCrypto) ShelleyEra
blockEx10 =
  HashHeader
-> AllIssuerKeys MockCrypto 'GenesisDelegate
-> [Tx ShelleyEra]
-> SlotNo
-> BlockNo
-> Nonce
-> NatNonce
-> UnitInterval
-> Word
-> Word
-> OCert MockCrypto
-> Block (BHeader MockCrypto) ShelleyEra
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) ShelleyEra -> BHeader MockCrypto
forall h era. Block h era -> h
bheader Block (BHeader MockCrypto) ShelleyEra
blockEx9)
    (forall era.
(HasCallStack, EraPParams era) =>
PParams era -> Word64 -> AllIssuerKeys MockCrypto 'GenesisDelegate
coreNodeKeysBySchedule @ShelleyEra PParams ShelleyEra
forall era.
(EraPParams era, ProtVerAtMost era 4, ProtVerAtMost era 6) =>
PParams era
ppEx Word64
420)
    [Item [ShelleyTx ShelleyEra]
ShelleyTx ShelleyEra
txEx10]
    (Word64 -> SlotNo
SlotNo Word64
420)
    (Word64 -> BlockNo
BlockNo Word64
10)
    Nonce
epoch4Nonce
    (Natural -> NatNonce
NatNonce Natural
10)
    UnitInterval
forall a. Bounded a => a
minBound
    Word
21
    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 @ShelleyEra PParams ShelleyEra
forall era.
(EraPParams era, ProtVerAtMost era 4, ProtVerAtMost era 6) =>
PParams era
ppEx Word64
420) Word64
2 (Word -> KESPeriod
KESPeriod Word
19))

expectedStEx10 :: ChainState ShelleyEra
expectedStEx10 :: ChainState ShelleyEra
expectedStEx10 =
  Nonce -> ChainState ShelleyEra -> ChainState ShelleyEra
forall era. Nonce -> ChainState era -> ChainState era
C.evolveNonceUnfrozen (Block (BHeader MockCrypto) ShelleyEra -> Nonce
forall era. Block (BHeader MockCrypto) era -> Nonce
getBlockNonce Block (BHeader MockCrypto) ShelleyEra
blockEx10)
    (ChainState ShelleyEra -> ChainState ShelleyEra)
-> (ChainState ShelleyEra -> ChainState ShelleyEra)
-> ChainState ShelleyEra
-> ChainState ShelleyEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Block (BHeader MockCrypto) ShelleyEra
-> ChainState ShelleyEra -> ChainState ShelleyEra
forall era.
Block (BHeader MockCrypto) era -> ChainState era -> ChainState era
C.newLab Block (BHeader MockCrypto) ShelleyEra
blockEx10
    (ChainState ShelleyEra -> ChainState ShelleyEra)
-> (ChainState ShelleyEra -> ChainState ShelleyEra)
-> ChainState ShelleyEra
-> ChainState ShelleyEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Credential 'Staking
-> ChainState ShelleyEra -> ChainState ShelleyEra
forall era.
EraCertState era =>
Credential 'Staking -> ChainState era -> ChainState era
C.deregStakeCred Credential 'Staking
Cast.bobSHK
    (ChainState ShelleyEra -> ChainState ShelleyEra)
-> (ChainState ShelleyEra -> ChainState ShelleyEra)
-> ChainState ShelleyEra
-> ChainState ShelleyEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Coin
-> Credential 'Staking
-> ChainState ShelleyEra
-> ChainState ShelleyEra
forall era.
EraCertState era =>
Coin -> Credential 'Staking -> ChainState era -> ChainState era
C.feesAndKeyRefund Coin
feeTx10 Credential 'Staking
Cast.bobSHK -- We must zero out the refund, before we deregister
    -- because we loose the refund amount otherwise
    (ChainState ShelleyEra -> ChainState ShelleyEra)
-> (ChainState ShelleyEra -> ChainState ShelleyEra)
-> ChainState ShelleyEra
-> ChainState ShelleyEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxBody ShelleyEra -> ChainState ShelleyEra -> ChainState ShelleyEra
forall era.
(EraTx era, EraStake era) =>
TxBody era -> ChainState era -> ChainState era
C.newUTxO TxBody ShelleyEra
txbodyEx10
    (ChainState ShelleyEra -> ChainState ShelleyEra)
-> ChainState ShelleyEra -> ChainState ShelleyEra
forall a b. (a -> b) -> a -> b
$ ChainState ShelleyEra
expectedStEx9

-- === Block 10, Slot 420, Epoch 4
--
-- Drain Bob's reward account and de-register Bob's stake key.
poolLifetime10 :: CHAINExample ShelleyEra
poolLifetime10 :: CHAINExample ShelleyEra
poolLifetime10 = ChainState ShelleyEra
-> Block (BHeader MockCrypto) ShelleyEra
-> Either
     (NonEmpty (PredicateFailure (CHAIN ShelleyEra)))
     (ChainState ShelleyEra)
-> CHAINExample ShelleyEra
forall era.
ChainState era
-> Block (BHeader MockCrypto) era
-> Either
     (NonEmpty (PredicateFailure (CHAIN era))) (ChainState era)
-> CHAINExample era
CHAINExample ChainState ShelleyEra
expectedStEx9 Block (BHeader MockCrypto) ShelleyEra
blockEx10 (ChainState ShelleyEra
-> Either
     (NonEmpty (TestChainPredicateFailure ShelleyEra))
     (ChainState ShelleyEra)
forall a b. b -> Either a b
Right ChainState ShelleyEra
expectedStEx10)

--
-- Block 11, Slot 490, Epoch 4
--

feeTx11 :: Coin
feeTx11 :: Coin
feeTx11 = Integer -> Coin
Coin Integer
2

aliceCoinEx11Ptr :: Coin
aliceCoinEx11Ptr :: Coin
aliceCoinEx11Ptr = Coin
aliceCoinEx4Base Coin -> Coin -> Coin
forall t. Val t => t -> t -> t
<-> Coin
feeTx11

aliceRetireEpoch :: EpochNo
aliceRetireEpoch :: EpochNo
aliceRetireEpoch = Word64 -> EpochNo
EpochNo Word64
5

txbodyEx11 :: TxBody ShelleyEra
txbodyEx11 :: TxBody ShelleyEra
txbodyEx11 =
  Set TxIn
-> StrictSeq (TxOut ShelleyEra)
-> StrictSeq (TxCert ShelleyEra)
-> Withdrawals
-> Coin
-> SlotNo
-> StrictMaybe (Update ShelleyEra)
-> StrictMaybe TxAuxDataHash
-> TxBody ShelleyEra
ShelleyTxBody
    ([TxIn] -> Set TxIn
forall a. Ord a => [a] -> Set a
Set.fromList [TxId -> TxIx -> TxIn
TxIn (TxBody ShelleyEra -> TxId
forall era. EraTxBody era => TxBody era -> TxId
txIdTxBody TxBody ShelleyEra
txbodyEx4) TxIx
forall a. Bounded a => a
minBound])
    (TxOut ShelleyEra -> StrictSeq (TxOut ShelleyEra)
forall a. a -> StrictSeq a
StrictSeq.singleton (TxOut ShelleyEra -> StrictSeq (TxOut ShelleyEra))
-> TxOut ShelleyEra -> StrictSeq (TxOut ShelleyEra)
forall a b. (a -> b) -> a -> b
$ Addr -> Value ShelleyEra -> ShelleyTxOut ShelleyEra
forall era.
(HasCallStack, Era era, Val (Value era)) =>
Addr -> Value era -> ShelleyTxOut era
ShelleyTxOut Addr
Cast.alicePtrAddr (Coin -> Coin
forall t s. Inject t s => t -> s
Val.inject Coin
aliceCoinEx11Ptr))
    ([ShelleyTxCert ShelleyEra] -> StrictSeq (ShelleyTxCert ShelleyEra)
forall a. [a] -> StrictSeq a
StrictSeq.fromList [KeyHash 'StakePool -> EpochNo -> TxCert ShelleyEra
forall era.
EraTxCert era =>
KeyHash 'StakePool -> EpochNo -> TxCert era
RetirePoolTxCert (AllIssuerKeys MockCrypto 'StakePool -> KeyHash 'StakePool
forall c (r :: KeyRole). AllIssuerKeys c r -> KeyHash r
aikColdKeyHash AllIssuerKeys MockCrypto 'StakePool
Cast.alicePoolKeys) EpochNo
aliceRetireEpoch])
    (Map RewardAccount Coin -> Withdrawals
Withdrawals Map RewardAccount Coin
forall k a. Map k a
Map.empty)
    Coin
feeTx11
    (Word64 -> SlotNo
SlotNo Word64
500)
    StrictMaybe (Update ShelleyEra)
forall a. StrictMaybe a
SNothing
    StrictMaybe TxAuxDataHash
forall a. StrictMaybe a
SNothing

txEx11 :: ShelleyTx ShelleyEra
txEx11 :: ShelleyTx ShelleyEra
txEx11 =
  TxBody ShelleyEra
-> TxWits ShelleyEra
-> StrictMaybe (TxAuxData ShelleyEra)
-> ShelleyTx ShelleyEra
forall era.
TxBody era
-> TxWits era -> StrictMaybe (TxAuxData era) -> ShelleyTx era
ShelleyTx
    TxBody ShelleyEra
txbodyEx11
    ShelleyTxWits ShelleyEra
forall a. Monoid a => a
mempty
      { addrWits =
          mkWitnessesVKey
            (hashAnnotated txbodyEx11)
            ( [asWitness Cast.alicePay]
                <> [asWitness $ aikCold Cast.alicePoolKeys]
            )
      }
    StrictMaybe (TxAuxData ShelleyEra)
StrictMaybe (ShelleyTxAuxData ShelleyEra)
forall a. StrictMaybe a
SNothing

blockEx11 :: Block (BHeader MockCrypto) ShelleyEra
blockEx11 :: Block (BHeader MockCrypto) ShelleyEra
blockEx11 =
  HashHeader
-> AllIssuerKeys MockCrypto 'GenesisDelegate
-> [Tx ShelleyEra]
-> SlotNo
-> BlockNo
-> Nonce
-> NatNonce
-> UnitInterval
-> Word
-> Word
-> OCert MockCrypto
-> Block (BHeader MockCrypto) ShelleyEra
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) ShelleyEra -> BHeader MockCrypto
forall h era. Block h era -> h
bheader Block (BHeader MockCrypto) ShelleyEra
blockEx10)
    (forall era.
(HasCallStack, EraPParams era) =>
PParams era -> Word64 -> AllIssuerKeys MockCrypto 'GenesisDelegate
coreNodeKeysBySchedule @ShelleyEra PParams ShelleyEra
forall era.
(EraPParams era, ProtVerAtMost era 4, ProtVerAtMost era 6) =>
PParams era
ppEx Word64
490)
    [Item [ShelleyTx ShelleyEra]
ShelleyTx ShelleyEra
txEx11]
    (Word64 -> SlotNo
SlotNo Word64
490)
    (Word64 -> BlockNo
BlockNo Word64
11)
    Nonce
epoch4Nonce
    (Natural -> NatNonce
NatNonce Natural
11)
    UnitInterval
forall a. Bounded a => a
minBound
    Word
24
    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 @ShelleyEra PParams ShelleyEra
forall era.
(EraPParams era, ProtVerAtMost era 4, ProtVerAtMost era 6) =>
PParams era
ppEx Word64
490) Word64
2 (Word -> KESPeriod
KESPeriod Word
19))

reserves12 :: Coin
reserves12 :: Coin
reserves12 = Coin -> DeltaCoin -> Coin
addDeltaCoin Coin
reserves7 DeltaCoin
deltaR8

alicePerfEx11 :: Likelihood
alicePerfEx11 :: Likelihood
alicePerfEx11 = Float -> Likelihood -> Likelihood
applyDecay Float
decayFactor Likelihood
alicePerfEx8 Likelihood -> Likelihood -> Likelihood
forall a. Semigroup a => a -> a -> a
<> Likelihood
epoch4Likelihood
  where
    epoch4Likelihood :: Likelihood
epoch4Likelihood = 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
4)
    blocks :: Natural
blocks = Natural
0
    t :: Double
t = ActiveSlotCoeff -> Rational -> UnitInterval -> Double
leaderProbability ActiveSlotCoeff
f Rational
relativeStake (Rational -> UnitInterval
forall r.
(HasCallStack, Typeable r, BoundedRational r) =>
Rational -> r
unsafeBoundRational Rational
0.5)
    -- everyone has delegated to Alice's Pool
    Coin Integer
stake = Stake -> Coin
sumAllStake (SnapShot -> Stake
ssStake SnapShot
snapEx5)
    relativeStake :: Rational
relativeStake = Rational -> Rational
forall a. Fractional a => Rational -> a
fromRational (Integer
stake Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
supply)
    Coin Integer
supply = Coin
maxLLSupply Coin -> Coin -> Coin
forall t. Val t => t -> t -> t
<-> Coin
reserves12
    f :: ActiveSlotCoeff
f = Globals -> ActiveSlotCoeff
activeSlotCoeff Globals
testGlobals

nonMyopicEx11 :: NonMyopic
nonMyopicEx11 :: NonMyopic
nonMyopicEx11 =
  Map (KeyHash 'StakePool) Likelihood -> Coin -> NonMyopic
NonMyopic
    (KeyHash 'StakePool
-> Likelihood -> Map (KeyHash 'StakePool) Likelihood
forall k a. k -> a -> Map k a
Map.singleton (AllIssuerKeys MockCrypto 'StakePool -> KeyHash 'StakePool
forall c (r :: KeyRole). AllIssuerKeys c r -> KeyHash r
aikColdKeyHash AllIssuerKeys MockCrypto 'StakePool
Cast.alicePoolKeys) Likelihood
alicePerfEx11)
    (Integer -> Coin
Coin Integer
0)

pulserEx11 :: PulsingRewUpdate
pulserEx11 :: PulsingRewUpdate
pulserEx11 = BlocksMade -> ChainState ShelleyEra -> PulsingRewUpdate
forall era.
(EraGov era, EraCertState era) =>
BlocksMade -> ChainState era -> PulsingRewUpdate
makeCompletedPulser (Map (KeyHash 'StakePool) Natural -> BlocksMade
BlocksMade Map (KeyHash 'StakePool) Natural
forall a. Monoid a => a
mempty) ChainState ShelleyEra
expectedStEx10

rewardUpdateEx11 :: RewardUpdate
rewardUpdateEx11 :: RewardUpdate
rewardUpdateEx11 =
  RewardUpdate
    { deltaT :: DeltaCoin
deltaT = Integer -> DeltaCoin
DeltaCoin Integer
0
    , deltaR :: DeltaCoin
deltaR = Integer -> DeltaCoin
DeltaCoin Integer
0
    , rs :: RewardEvent
rs = RewardEvent
forall k a. Map k a
Map.empty
    , deltaF :: DeltaCoin
deltaF = Integer -> DeltaCoin
DeltaCoin Integer
0
    , nonMyopic :: NonMyopic
nonMyopic = NonMyopic
nonMyopicEx11
    }

expectedStEx11 :: ChainState ShelleyEra
expectedStEx11 :: ChainState ShelleyEra
expectedStEx11 =
  Nonce -> ChainState ShelleyEra -> ChainState ShelleyEra
forall era. Nonce -> ChainState era -> ChainState era
C.evolveNonceFrozen (Block (BHeader MockCrypto) ShelleyEra -> Nonce
forall era. Block (BHeader MockCrypto) era -> Nonce
getBlockNonce Block (BHeader MockCrypto) ShelleyEra
blockEx11)
    (ChainState ShelleyEra -> ChainState ShelleyEra)
-> (ChainState ShelleyEra -> ChainState ShelleyEra)
-> ChainState ShelleyEra
-> ChainState ShelleyEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Block (BHeader MockCrypto) ShelleyEra
-> ChainState ShelleyEra -> ChainState ShelleyEra
forall era.
Block (BHeader MockCrypto) era -> ChainState era -> ChainState era
C.newLab Block (BHeader MockCrypto) ShelleyEra
blockEx11
    (ChainState ShelleyEra -> ChainState ShelleyEra)
-> (ChainState ShelleyEra -> ChainState ShelleyEra)
-> ChainState ShelleyEra
-> ChainState ShelleyEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PParams ShelleyEra
-> Coin
-> [Credential 'Staking]
-> [PoolParams]
-> ChainState ShelleyEra
-> ChainState ShelleyEra
forall era.
(EraPParams era, EraCertState era) =>
PParams era
-> Coin
-> [Credential 'Staking]
-> [PoolParams]
-> ChainState era
-> ChainState era
C.feesAndDeposits PParams ShelleyEra
forall era.
(EraPParams era, ProtVerAtMost era 4, ProtVerAtMost era 6) =>
PParams era
ppEx Coin
feeTx11 [] []
    (ChainState ShelleyEra -> ChainState ShelleyEra)
-> (ChainState ShelleyEra -> ChainState ShelleyEra)
-> ChainState ShelleyEra
-> ChainState ShelleyEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxBody ShelleyEra -> ChainState ShelleyEra -> ChainState ShelleyEra
forall era.
(EraTx era, EraStake era) =>
TxBody era -> ChainState era -> ChainState era
C.newUTxO TxBody ShelleyEra
txbodyEx11
    (ChainState ShelleyEra -> ChainState ShelleyEra)
-> (ChainState ShelleyEra -> ChainState ShelleyEra)
-> ChainState ShelleyEra
-> ChainState ShelleyEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PulsingRewUpdate -> ChainState ShelleyEra -> ChainState ShelleyEra
forall era. PulsingRewUpdate -> ChainState era -> ChainState era
C.pulserUpdate PulsingRewUpdate
pulserEx11
    (ChainState ShelleyEra -> ChainState ShelleyEra)
-> (ChainState ShelleyEra -> ChainState ShelleyEra)
-> ChainState ShelleyEra
-> ChainState ShelleyEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyHash 'StakePool
-> EpochNo -> ChainState ShelleyEra -> ChainState ShelleyEra
forall era.
EraCertState era =>
KeyHash 'StakePool -> EpochNo -> ChainState era -> ChainState era
C.stageRetirement (AllIssuerKeys MockCrypto 'StakePool -> KeyHash 'StakePool
forall c (r :: KeyRole). AllIssuerKeys c r -> KeyHash r
aikColdKeyHash AllIssuerKeys MockCrypto 'StakePool
Cast.alicePoolKeys) EpochNo
aliceRetireEpoch
    (ChainState ShelleyEra -> ChainState ShelleyEra)
-> ChainState ShelleyEra -> ChainState ShelleyEra
forall a b. (a -> b) -> a -> b
$ ChainState ShelleyEra
expectedStEx10

-- === Block 11, Slot 490, Epoch 4
--
-- Stage the retirement of Alice's stake pool.
poolLifetime11 :: CHAINExample ShelleyEra
poolLifetime11 :: CHAINExample ShelleyEra
poolLifetime11 = ChainState ShelleyEra
-> Block (BHeader MockCrypto) ShelleyEra
-> Either
     (NonEmpty (PredicateFailure (CHAIN ShelleyEra)))
     (ChainState ShelleyEra)
-> CHAINExample ShelleyEra
forall era.
ChainState era
-> Block (BHeader MockCrypto) era
-> Either
     (NonEmpty (PredicateFailure (CHAIN era))) (ChainState era)
-> CHAINExample era
CHAINExample ChainState ShelleyEra
expectedStEx10 Block (BHeader MockCrypto) ShelleyEra
blockEx11 (ChainState ShelleyEra
-> Either
     (NonEmpty (TestChainPredicateFailure ShelleyEra))
     (ChainState ShelleyEra)
forall a b. b -> Either a b
Right (ChainState ShelleyEra -> ChainState ShelleyEra
forall era. EraGov era => ChainState era -> ChainState era
C.solidifyProposals ChainState ShelleyEra
expectedStEx11))

--
-- Block 12, Slot 510, Epoch 5
--

epoch5Nonce :: Nonce
epoch5Nonce :: Nonce
epoch5Nonce =
  ChainState ShelleyEra -> Nonce
forall era. ChainState era -> Nonce
chainCandidateNonce ChainState ShelleyEra
expectedStEx11
    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) ShelleyEra -> BHeader MockCrypto
forall h era. Block h era -> h
bheader Block (BHeader MockCrypto) ShelleyEra
blockEx8)

blockEx12 :: Block (BHeader MockCrypto) ShelleyEra
blockEx12 :: Block (BHeader MockCrypto) ShelleyEra
blockEx12 =
  HashHeader
-> AllIssuerKeys MockCrypto 'GenesisDelegate
-> [Tx ShelleyEra]
-> SlotNo
-> BlockNo
-> Nonce
-> NatNonce
-> UnitInterval
-> Word
-> Word
-> OCert MockCrypto
-> Block (BHeader MockCrypto) ShelleyEra
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) ShelleyEra -> BHeader MockCrypto
forall h era. Block h era -> h
bheader Block (BHeader MockCrypto) ShelleyEra
blockEx11)
    (forall era.
(HasCallStack, EraPParams era) =>
PParams era -> Word64 -> AllIssuerKeys MockCrypto 'GenesisDelegate
coreNodeKeysBySchedule @ShelleyEra PParams ShelleyEra
forall era.
(EraPParams era, ProtVerAtMost era 4, ProtVerAtMost era 6) =>
PParams era
ppEx Word64
510)
    []
    (Word64 -> SlotNo
SlotNo Word64
510)
    (Word64 -> BlockNo
BlockNo Word64
12)
    Nonce
epoch5Nonce
    (Natural -> NatNonce
NatNonce Natural
12)
    UnitInterval
forall a. Bounded a => a
minBound
    Word
25
    Word
25
    (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 @ShelleyEra PParams ShelleyEra
forall era.
(EraPParams era, ProtVerAtMost era 4, ProtVerAtMost era 6) =>
PParams era
ppEx Word64
510) Word64
3 (Word -> KESPeriod
KESPeriod Word
25))

snapEx12 :: SnapShot
snapEx12 :: SnapShot
snapEx12 =
  SnapShot
snapEx9
    { ssStake =
        mkStake
          [ (Cast.aliceSHK, aliceRAcnt8 <> aliceCoinEx2Ptr <> aliceCoinEx11Ptr)
          , (Cast.carlSHK, carlMIR)
          ]
    , ssDelegations =
        [ (Cast.aliceSHK, aikColdKeyHash Cast.alicePoolKeys)
        , (Cast.carlSHK, aikColdKeyHash Cast.alicePoolKeys)
        ]
    }

expectedStEx12 :: ChainState ShelleyEra
expectedStEx12 :: ChainState ShelleyEra
expectedStEx12 =
  Block (BHeader MockCrypto) ShelleyEra
-> ChainState ShelleyEra -> ChainState ShelleyEra
forall era.
(ProtVerAtMost era 6, EraGov era) =>
Block (BHeader MockCrypto) era -> ChainState era -> ChainState era
C.newEpoch Block (BHeader MockCrypto) ShelleyEra
blockEx12
    (ChainState ShelleyEra -> ChainState ShelleyEra)
-> (ChainState ShelleyEra -> ChainState ShelleyEra)
-> ChainState ShelleyEra
-> ChainState ShelleyEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SnapShot -> Coin -> ChainState ShelleyEra -> ChainState ShelleyEra
forall era. SnapShot -> Coin -> ChainState era -> ChainState era
C.newSnapshot SnapShot
snapEx12 (Integer -> Coin
Coin Integer
11)
    (ChainState ShelleyEra -> ChainState ShelleyEra)
-> (ChainState ShelleyEra -> ChainState ShelleyEra)
-> ChainState ShelleyEra
-> ChainState ShelleyEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RewardUpdate -> ChainState ShelleyEra -> ChainState ShelleyEra
forall era.
(EraGov era, EraCertState era) =>
RewardUpdate -> ChainState era -> ChainState era
C.applyRewardUpdate RewardUpdate
rewardUpdateEx11
    (ChainState ShelleyEra -> ChainState ShelleyEra)
-> (ChainState ShelleyEra -> ChainState ShelleyEra)
-> ChainState ShelleyEra
-> ChainState ShelleyEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyHash 'BlockIssuer
-> Word64 -> ChainState ShelleyEra -> ChainState ShelleyEra
forall era.
KeyHash 'BlockIssuer -> Word64 -> ChainState era -> ChainState era
C.setOCertCounter KeyHash 'BlockIssuer
forall {r' :: KeyRole}. KeyHash r'
coreNodeHK Word64
3
    (ChainState ShelleyEra -> ChainState ShelleyEra)
-> (ChainState ShelleyEra -> ChainState ShelleyEra)
-> ChainState ShelleyEra
-> ChainState ShelleyEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PoolParams -> ChainState ShelleyEra -> ChainState ShelleyEra
forall era.
(EraGov era, EraCertState era) =>
PoolParams -> ChainState era -> ChainState era
C.reapPool PoolParams
Cast.alicePoolParams
    (ChainState ShelleyEra -> ChainState ShelleyEra)
-> ChainState ShelleyEra -> ChainState ShelleyEra
forall a b. (a -> b) -> a -> b
$ ChainState ShelleyEra
expectedStEx11
  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 @ShelleyEra PParams ShelleyEra
forall era.
(EraPParams era, ProtVerAtMost era 4, ProtVerAtMost era 6) =>
PParams era
ppEx Word64
510

-- === Block 12, Slot 510, Epoch 5
--
-- Reap Alice's stake pool.
poolLifetime12 :: CHAINExample ShelleyEra
poolLifetime12 :: CHAINExample ShelleyEra
poolLifetime12 = ChainState ShelleyEra
-> Block (BHeader MockCrypto) ShelleyEra
-> Either
     (NonEmpty (PredicateFailure (CHAIN ShelleyEra)))
     (ChainState ShelleyEra)
-> CHAINExample ShelleyEra
forall era.
ChainState era
-> Block (BHeader MockCrypto) era
-> Either
     (NonEmpty (PredicateFailure (CHAIN era))) (ChainState era)
-> CHAINExample era
CHAINExample ChainState ShelleyEra
expectedStEx11 Block (BHeader MockCrypto) ShelleyEra
blockEx12 (ChainState ShelleyEra
-> Either
     (NonEmpty (TestChainPredicateFailure ShelleyEra))
     (ChainState ShelleyEra)
forall a b. b -> Either a b
Right ChainState ShelleyEra
expectedStEx12)

--
-- Pool Lifetime Test Group
--

poolLifetimeExample :: TestTree
poolLifetimeExample :: TestTree
poolLifetimeExample =
  [Char] -> [TestTree] -> TestTree
testGroup
    [Char]
"pool lifetime"
    [ [Char] -> Assertion -> TestTree
testCase [Char]
"initial registrations" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ HasCallStack => CHAINExample ShelleyEra -> Assertion
CHAINExample ShelleyEra -> Assertion
testCHAINExample CHAINExample ShelleyEra
poolLifetime1
    , [Char] -> Assertion -> TestTree
testCase [Char]
"delegate stake and create reward update" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ HasCallStack => CHAINExample ShelleyEra -> Assertion
CHAINExample ShelleyEra -> Assertion
testCHAINExample CHAINExample ShelleyEra
poolLifetime2
    , [Char] -> Assertion -> TestTree
testCase [Char]
"new epoch changes" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ HasCallStack => CHAINExample ShelleyEra -> Assertion
CHAINExample ShelleyEra -> Assertion
testCHAINExample CHAINExample ShelleyEra
poolLifetime3
    , [Char] -> Assertion -> TestTree
testCase [Char]
"second reward update" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ HasCallStack => CHAINExample ShelleyEra -> Assertion
CHAINExample ShelleyEra -> Assertion
testCHAINExample CHAINExample ShelleyEra
poolLifetime4
    , [Char] -> Assertion -> TestTree
testCase [Char]
"nonempty pool distr" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ HasCallStack => CHAINExample ShelleyEra -> Assertion
CHAINExample ShelleyEra -> Assertion
testCHAINExample CHAINExample ShelleyEra
poolLifetime5
    , [Char] -> Assertion -> TestTree
testCase [Char]
"decentralized block" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ HasCallStack => CHAINExample ShelleyEra -> Assertion
CHAINExample ShelleyEra -> Assertion
testCHAINExample CHAINExample ShelleyEra
poolLifetime6
    , [Char] -> Assertion -> TestTree
testCase [Char]
"prelude to the first nontrivial rewards" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ HasCallStack => CHAINExample ShelleyEra -> Assertion
CHAINExample ShelleyEra -> Assertion
testCHAINExample CHAINExample ShelleyEra
poolLifetime7
    , [Char] -> Assertion -> TestTree
testCase [Char]
"create a nontrivial rewards" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ HasCallStack => CHAINExample ShelleyEra -> Assertion
CHAINExample ShelleyEra -> Assertion
testCHAINExample CHAINExample ShelleyEra
poolLifetime8
    , [Char] -> Assertion -> TestTree
testCase [Char]
"apply a nontrivial rewards" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ HasCallStack => CHAINExample ShelleyEra -> Assertion
CHAINExample ShelleyEra -> Assertion
testCHAINExample CHAINExample ShelleyEra
poolLifetime9
    , [Char] -> Assertion -> TestTree
testCase [Char]
"drain reward account and deregister" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ HasCallStack => CHAINExample ShelleyEra -> Assertion
CHAINExample ShelleyEra -> Assertion
testCHAINExample CHAINExample ShelleyEra
poolLifetime10
    , [Char] -> Assertion -> TestTree
testCase [Char]
"stage stake pool retirement" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ HasCallStack => CHAINExample ShelleyEra -> Assertion
CHAINExample ShelleyEra -> Assertion
testCHAINExample CHAINExample ShelleyEra
poolLifetime11
    , [Char] -> Assertion -> TestTree
testCase [Char]
"reap stake pool" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ HasCallStack => CHAINExample ShelleyEra -> Assertion
CHAINExample ShelleyEra -> Assertion
testCHAINExample CHAINExample ShelleyEra
poolLifetime12
    ]