{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}

-- | Example demonstrating the adoption of of pool parameters
-- when re-registratiing.
module Test.Cardano.Ledger.Shelley.Examples.PoolReReg (
  poolReRegExample,
) where

import Cardano.Ledger.BaseTypes (
  BlocksMade (..),
  Globals (..),
  Nonce,
 )
import Cardano.Ledger.Block (Block (blockHeader))
import Cardano.Ledger.Coin (Coin (..))
import Cardano.Ledger.Keys (asWitness)
import Cardano.Ledger.Shelley (ShelleyEra)
import Cardano.Ledger.Shelley.Core
import Cardano.Ledger.Shelley.LedgerState (PulsingRewUpdate, emptyRewardUpdate)
import Cardano.Ledger.Slot (BlockNo (..), SlotNo (..))
import Cardano.Ledger.State (ActiveStake (..), SnapShot, StakePoolParams (..), UTxO (..))
import Cardano.Ledger.TxIn (TxIn (..))
import Cardano.Ledger.Val ((<+>), (<->))
import qualified Cardano.Ledger.Val as Val
import Cardano.Protocol.TPraos.BHeader (BHeader, bhHash)
import Cardano.Protocol.TPraos.OCert (KESPeriod (..))
import qualified Data.Sequence.Strict as StrictSeq
import qualified Data.Set as Set
import qualified Data.VMap as VMap
import Data.Word (Word64)
import GHC.Stack (HasCallStack)
import Lens.Micro ((&), (.~))
import Test.Cardano.Ledger.Core.Arbitrary (mkSnapShotFromStakePoolParams)
import Test.Cardano.Ledger.Core.KeyPair (mkWitnessesVKey)
import Test.Cardano.Ledger.Shelley.ConcreteCryptoTypes (MockCrypto)
import qualified Test.Cardano.Ledger.Shelley.Examples.Cast as Cast
import Test.Cardano.Ledger.Shelley.Examples.Chain (CHAINExample (..), testCHAINExample)
import qualified Test.Cardano.Ledger.Shelley.Examples.Combinators as C
import Test.Cardano.Ledger.Shelley.Examples.Federation (coreNodeKeysBySchedule)
import Test.Cardano.Ledger.Shelley.Examples.Init (
  initSt,
  lastByronHeaderHash,
  nonce0,
  ppEx,
 )
import Test.Cardano.Ledger.Shelley.Examples.PoolLifetime (makeCompletedPulser)
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 (getBlockNonce, testGlobals)
import Test.Tasty (TestTree, testGroup)
import Test.Tasty.HUnit (testCase)

aliceInitCoin :: Coin
aliceInitCoin :: Coin
aliceInitCoin = Integer -> Coin
Coin (Integer -> Coin) -> Integer -> Coin
forall a b. (a -> b) -> a -> b
$ Integer
10 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

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 -> TxOut ShelleyEra
forall era.
(EraTxOut era, HasCallStack) =>
Addr -> Value era -> TxOut era
mkBasicTxOut Addr
Cast.aliceAddr (Coin -> Coin
forall t s. Inject t s => t -> s
Val.inject Coin
aliceInitCoin)]

initStPoolReReg :: ChainState ShelleyEra
initStPoolReReg :: ChainState ShelleyEra
initStPoolReReg = UTxO ShelleyEra -> ChainState ShelleyEra
forall era.
(EraTxOut era, EraGov era, EraStake era, EraCertState era,
 AtMostEra "Mary" era, AtMostEra "Alonzo" era,
 Default (StashedAVVMAddresses era)) =>
UTxO era -> ChainState era
initSt UTxO ShelleyEra
initUTxO

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

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

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
<-> Coin
feeTx1

txbodyEx1 :: TxBody TopTx ShelleyEra
txbodyEx1 :: TxBody TopTx ShelleyEra
txbodyEx1 =
  TxBody TopTx ShelleyEra
forall era (l :: TxLevel).
(EraTxBody era, Typeable l) =>
TxBody l era
forall (l :: TxLevel). Typeable l => TxBody l ShelleyEra
mkBasicTxBody
    TxBody TopTx ShelleyEra
-> (TxBody TopTx ShelleyEra -> TxBody TopTx ShelleyEra)
-> TxBody TopTx ShelleyEra
forall a b. a -> (a -> b) -> b
& (Set TxIn -> Identity (Set TxIn))
-> TxBody TopTx ShelleyEra -> Identity (TxBody TopTx ShelleyEra)
forall era (l :: TxLevel).
EraTxBody era =>
Lens' (TxBody l era) (Set TxIn)
forall (l :: TxLevel). Lens' (TxBody l ShelleyEra) (Set TxIn)
inputsTxBodyL ((Set TxIn -> Identity (Set TxIn))
 -> TxBody TopTx ShelleyEra -> Identity (TxBody TopTx ShelleyEra))
-> Set TxIn -> TxBody TopTx ShelleyEra -> TxBody TopTx ShelleyEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [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]
    TxBody TopTx ShelleyEra
-> (TxBody TopTx ShelleyEra -> TxBody TopTx ShelleyEra)
-> TxBody TopTx ShelleyEra
forall a b. a -> (a -> b) -> b
& (StrictSeq (TxOut ShelleyEra)
 -> Identity (StrictSeq (TxOut ShelleyEra)))
-> TxBody TopTx ShelleyEra -> Identity (TxBody TopTx ShelleyEra)
(StrictSeq (ShelleyTxOut ShelleyEra)
 -> Identity (StrictSeq (ShelleyTxOut ShelleyEra)))
-> TxBody TopTx ShelleyEra -> Identity (TxBody TopTx ShelleyEra)
forall era (l :: TxLevel).
EraTxBody era =>
Lens' (TxBody l era) (StrictSeq (TxOut era))
forall (l :: TxLevel).
Lens' (TxBody l ShelleyEra) (StrictSeq (TxOut ShelleyEra))
outputsTxBodyL ((StrictSeq (ShelleyTxOut ShelleyEra)
  -> Identity (StrictSeq (ShelleyTxOut ShelleyEra)))
 -> TxBody TopTx ShelleyEra -> Identity (TxBody TopTx ShelleyEra))
-> StrictSeq (ShelleyTxOut ShelleyEra)
-> TxBody TopTx ShelleyEra
-> TxBody TopTx ShelleyEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [ShelleyTxOut ShelleyEra] -> StrictSeq (ShelleyTxOut ShelleyEra)
forall a. [a] -> StrictSeq a
StrictSeq.fromList [Addr -> Value ShelleyEra -> TxOut ShelleyEra
forall era.
(EraTxOut era, HasCallStack) =>
Addr -> Value era -> TxOut era
mkBasicTxOut Addr
Cast.aliceAddr (Coin -> Coin
forall t s. Inject t s => t -> s
Val.inject Coin
aliceCoinEx1)]
    TxBody TopTx ShelleyEra
-> (TxBody TopTx ShelleyEra -> TxBody TopTx ShelleyEra)
-> TxBody TopTx ShelleyEra
forall a b. a -> (a -> b) -> b
& (StrictSeq (TxCert ShelleyEra)
 -> Identity (StrictSeq (TxCert ShelleyEra)))
-> TxBody TopTx ShelleyEra -> Identity (TxBody TopTx ShelleyEra)
(StrictSeq (ShelleyTxCert ShelleyEra)
 -> Identity (StrictSeq (ShelleyTxCert ShelleyEra)))
-> TxBody TopTx ShelleyEra -> Identity (TxBody TopTx ShelleyEra)
forall era (l :: TxLevel).
EraTxBody era =>
Lens' (TxBody l era) (StrictSeq (TxCert era))
forall (l :: TxLevel).
Lens' (TxBody l ShelleyEra) (StrictSeq (TxCert ShelleyEra))
certsTxBodyL ((StrictSeq (ShelleyTxCert ShelleyEra)
  -> Identity (StrictSeq (ShelleyTxCert ShelleyEra)))
 -> TxBody TopTx ShelleyEra -> Identity (TxBody TopTx ShelleyEra))
-> StrictSeq (ShelleyTxCert ShelleyEra)
-> TxBody TopTx ShelleyEra
-> TxBody TopTx ShelleyEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [ShelleyTxCert ShelleyEra] -> StrictSeq (ShelleyTxCert ShelleyEra)
forall a. [a] -> StrictSeq a
StrictSeq.fromList [StakePoolParams -> TxCert ShelleyEra
forall era. EraTxCert era => StakePoolParams -> TxCert era
RegPoolTxCert StakePoolParams
Cast.aliceStakePoolParams]
    TxBody TopTx ShelleyEra
-> (TxBody TopTx ShelleyEra -> TxBody TopTx ShelleyEra)
-> TxBody TopTx ShelleyEra
forall a b. a -> (a -> b) -> b
& (Coin -> Identity Coin)
-> TxBody TopTx ShelleyEra -> Identity (TxBody TopTx ShelleyEra)
forall era. EraTxBody era => Lens' (TxBody TopTx era) Coin
Lens' (TxBody TopTx ShelleyEra) Coin
feeTxBodyL ((Coin -> Identity Coin)
 -> TxBody TopTx ShelleyEra -> Identity (TxBody TopTx ShelleyEra))
-> Coin -> TxBody TopTx ShelleyEra -> TxBody TopTx ShelleyEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Coin
feeTx1
    TxBody TopTx ShelleyEra
-> (TxBody TopTx ShelleyEra -> TxBody TopTx ShelleyEra)
-> TxBody TopTx ShelleyEra
forall a b. a -> (a -> b) -> b
& (SlotNo -> Identity SlotNo)
-> TxBody TopTx ShelleyEra -> Identity (TxBody TopTx ShelleyEra)
forall era.
(ShelleyEraTxBody era, ExactEra ShelleyEra era) =>
Lens' (TxBody TopTx era) SlotNo
Lens' (TxBody TopTx ShelleyEra) SlotNo
ttlTxBodyL ((SlotNo -> Identity SlotNo)
 -> TxBody TopTx ShelleyEra -> Identity (TxBody TopTx ShelleyEra))
-> SlotNo -> TxBody TopTx ShelleyEra -> TxBody TopTx ShelleyEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Word64 -> SlotNo
SlotNo Word64
10

txEx1 :: Tx TopTx ShelleyEra
txEx1 :: Tx TopTx ShelleyEra
txEx1 =
  TxBody TopTx ShelleyEra -> Tx TopTx ShelleyEra
forall era (l :: TxLevel). EraTx era => TxBody l era -> Tx l era
forall (l :: TxLevel). TxBody l ShelleyEra -> Tx l ShelleyEra
mkBasicTx TxBody TopTx ShelleyEra
txbodyEx1
    Tx TopTx ShelleyEra
-> (Tx TopTx ShelleyEra -> Tx TopTx ShelleyEra)
-> Tx TopTx ShelleyEra
forall a b. a -> (a -> b) -> b
& (TxWits ShelleyEra -> Identity (TxWits ShelleyEra))
-> Tx TopTx ShelleyEra -> Identity (Tx TopTx ShelleyEra)
(ShelleyTxWits ShelleyEra -> Identity (ShelleyTxWits ShelleyEra))
-> Tx TopTx ShelleyEra -> Identity (Tx TopTx ShelleyEra)
forall era (l :: TxLevel).
EraTx era =>
Lens' (Tx l era) (TxWits era)
forall (l :: TxLevel). Lens' (Tx l ShelleyEra) (TxWits ShelleyEra)
witsTxL
      ((ShelleyTxWits ShelleyEra -> Identity (ShelleyTxWits ShelleyEra))
 -> Tx TopTx ShelleyEra -> Identity (Tx TopTx ShelleyEra))
-> ShelleyTxWits ShelleyEra
-> Tx TopTx ShelleyEra
-> Tx TopTx ShelleyEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ( TxWits ShelleyEra
forall era. EraTxWits era => TxWits era
mkBasicTxWits
             TxWits ShelleyEra
-> (TxWits ShelleyEra -> ShelleyTxWits ShelleyEra)
-> ShelleyTxWits ShelleyEra
forall a b. a -> (a -> b) -> b
& (Set (WitVKey Witness) -> Identity (Set (WitVKey Witness)))
-> TxWits ShelleyEra -> Identity (TxWits ShelleyEra)
(Set (WitVKey Witness) -> Identity (Set (WitVKey Witness)))
-> TxWits ShelleyEra -> Identity (ShelleyTxWits ShelleyEra)
forall era.
EraTxWits era =>
Lens' (TxWits era) (Set (WitVKey Witness))
Lens' (TxWits ShelleyEra) (Set (WitVKey Witness))
addrTxWitsL
               ((Set (WitVKey Witness) -> Identity (Set (WitVKey Witness)))
 -> TxWits ShelleyEra -> Identity (ShelleyTxWits ShelleyEra))
-> Set (WitVKey Witness)
-> TxWits ShelleyEra
-> ShelleyTxWits ShelleyEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ SafeHash EraIndependentTxBody
-> [KeyPair Witness] -> Set (WitVKey Witness)
forall (kr :: KeyRole).
SafeHash EraIndependentTxBody
-> [KeyPair kr] -> Set (WitVKey Witness)
mkWitnessesVKey
                 (TxBody TopTx ShelleyEra -> SafeHash EraIndependentTxBody
forall x i. HashAnnotated x i => x -> SafeHash i
hashAnnotated TxBody TopTx ShelleyEra
txbodyEx1)
                 ( [KeyPair Payment -> KeyPair Witness
forall (a :: KeyRole -> *) (r :: KeyRole).
HasKeyRole a =>
a r -> a Witness
asWitness KeyPair Payment
Cast.alicePay]
                     [KeyPair Witness] -> [KeyPair Witness] -> [KeyPair Witness]
forall a. Semigroup a => a -> a -> a
<> [KeyPair Staking -> KeyPair Witness
forall (a :: KeyRole -> *) (r :: KeyRole).
HasKeyRole a =>
a r -> a Witness
asWitness KeyPair Staking
Cast.aliceStake]
                     [KeyPair Witness] -> [KeyPair Witness] -> [KeyPair Witness]
forall a. Semigroup a => a -> a -> a
<> [KeyPair StakePool -> KeyPair Witness
forall (a :: KeyRole -> *) (r :: KeyRole).
HasKeyRole a =>
a r -> a Witness
asWitness (KeyPair StakePool -> KeyPair Witness)
-> KeyPair StakePool -> KeyPair Witness
forall a b. (a -> b) -> a -> b
$ AllIssuerKeys MockCrypto StakePool -> KeyPair StakePool
forall c (r :: KeyRole). AllIssuerKeys c r -> KeyPair r
aikCold AllIssuerKeys MockCrypto StakePool
Cast.alicePoolKeys]
                 )
         )

blockEx1 :: HasCallStack => Block (BHeader MockCrypto) ShelleyEra
blockEx1 :: HasCallStack => Block (BHeader MockCrypto) ShelleyEra
blockEx1 =
  HashHeader
-> AllIssuerKeys MockCrypto GenesisDelegate
-> [Tx TopTx ShelleyEra]
-> SlotNo
-> BlockNo
-> Nonce
-> NatNonce
-> UnitInterval
-> Word
-> Word
-> OCert MockCrypto
-> Block (BHeader MockCrypto) ShelleyEra
forall era (r :: KeyRole) c.
(Crypto c, EraBlockBody era, Signable (VRF c) (WithResult Seed),
 Signable (KES c) (BHBody c)) =>
HashHeader
-> AllIssuerKeys c r
-> [Tx TopTx 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, AtMostEra "Mary" era, AtMostEra "Alonzo" era) =>
PParams era
ppEx Word64
10)
    [Tx TopTx 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, AtMostEra "Mary" era, AtMostEra "Alonzo" era) =>
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
. Coin -> ChainState ShelleyEra -> ChainState ShelleyEra
forall era. Coin -> ChainState era -> ChainState era
C.addFees Coin
feeTx1
    (ChainState ShelleyEra -> ChainState ShelleyEra)
-> (ChainState ShelleyEra -> ChainState ShelleyEra)
-> ChainState ShelleyEra
-> ChainState ShelleyEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxBody TopTx ShelleyEra
-> ChainState ShelleyEra -> ChainState ShelleyEra
forall era.
(EraTx era, EraStake era) =>
TxBody TopTx era -> ChainState era -> ChainState era
C.newUTxO TxBody TopTx ShelleyEra
txbodyEx1
    (ChainState ShelleyEra -> ChainState ShelleyEra)
-> (ChainState ShelleyEra -> ChainState ShelleyEra)
-> ChainState ShelleyEra
-> ChainState ShelleyEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StakePoolParams -> ChainState ShelleyEra -> ChainState ShelleyEra
forall era.
(EraCertState era, EraGov era) =>
StakePoolParams -> ChainState era -> ChainState era
C.regPool StakePoolParams
Cast.aliceStakePoolParams
    (ChainState ShelleyEra -> ChainState ShelleyEra)
-> ChainState ShelleyEra -> ChainState ShelleyEra
forall a b. (a -> b) -> a -> b
$ ChainState ShelleyEra
initStPoolReReg

-- === Block 1, Slot 10, Epoch 0
--
-- In the first block Alice registers a stake pool.
poolReReg1 :: CHAINExample ShelleyEra
poolReReg1 :: CHAINExample ShelleyEra
poolReReg1 = 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
initStPoolReReg 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 20, Epoch 0
--

feeTx2 :: Coin
feeTx2 :: Coin
feeTx2 = Integer -> Coin
Coin Integer
3

aliceCoinEx2 :: Coin
aliceCoinEx2 :: Coin
aliceCoinEx2 = Coin
aliceCoinEx1 Coin -> Coin -> Coin
forall t. Val t => t -> t -> t
<-> Coin
feeTx2

newPoolParams :: StakePoolParams
newPoolParams :: StakePoolParams
newPoolParams = StakePoolParams
Cast.aliceStakePoolParams {sppCost = Coin 500}

txbodyEx2 :: TxBody TopTx ShelleyEra
txbodyEx2 :: TxBody TopTx ShelleyEra
txbodyEx2 =
  TxBody TopTx ShelleyEra
forall era (l :: TxLevel).
(EraTxBody era, Typeable l) =>
TxBody l era
forall (l :: TxLevel). Typeable l => TxBody l ShelleyEra
mkBasicTxBody
    TxBody TopTx ShelleyEra
-> (TxBody TopTx ShelleyEra -> TxBody TopTx ShelleyEra)
-> TxBody TopTx ShelleyEra
forall a b. a -> (a -> b) -> b
& (Set TxIn -> Identity (Set TxIn))
-> TxBody TopTx ShelleyEra -> Identity (TxBody TopTx ShelleyEra)
forall era (l :: TxLevel).
EraTxBody era =>
Lens' (TxBody l era) (Set TxIn)
forall (l :: TxLevel). Lens' (TxBody l ShelleyEra) (Set TxIn)
inputsTxBodyL ((Set TxIn -> Identity (Set TxIn))
 -> TxBody TopTx ShelleyEra -> Identity (TxBody TopTx ShelleyEra))
-> Set TxIn -> TxBody TopTx ShelleyEra -> TxBody TopTx ShelleyEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [TxIn] -> Set TxIn
forall a. Ord a => [a] -> Set a
Set.fromList [TxId -> TxIx -> TxIn
TxIn (TxBody TopTx ShelleyEra -> TxId
forall era (l :: TxLevel). EraTxBody era => TxBody l era -> TxId
txIdTxBody TxBody TopTx ShelleyEra
txbodyEx1) TxIx
forall a. Bounded a => a
minBound]
    TxBody TopTx ShelleyEra
-> (TxBody TopTx ShelleyEra -> TxBody TopTx ShelleyEra)
-> TxBody TopTx ShelleyEra
forall a b. a -> (a -> b) -> b
& (StrictSeq (TxOut ShelleyEra)
 -> Identity (StrictSeq (TxOut ShelleyEra)))
-> TxBody TopTx ShelleyEra -> Identity (TxBody TopTx ShelleyEra)
(StrictSeq (ShelleyTxOut ShelleyEra)
 -> Identity (StrictSeq (ShelleyTxOut ShelleyEra)))
-> TxBody TopTx ShelleyEra -> Identity (TxBody TopTx ShelleyEra)
forall era (l :: TxLevel).
EraTxBody era =>
Lens' (TxBody l era) (StrictSeq (TxOut era))
forall (l :: TxLevel).
Lens' (TxBody l ShelleyEra) (StrictSeq (TxOut ShelleyEra))
outputsTxBodyL ((StrictSeq (ShelleyTxOut ShelleyEra)
  -> Identity (StrictSeq (ShelleyTxOut ShelleyEra)))
 -> TxBody TopTx ShelleyEra -> Identity (TxBody TopTx ShelleyEra))
-> StrictSeq (ShelleyTxOut ShelleyEra)
-> TxBody TopTx ShelleyEra
-> TxBody TopTx ShelleyEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [ShelleyTxOut ShelleyEra] -> StrictSeq (ShelleyTxOut ShelleyEra)
forall a. [a] -> StrictSeq a
StrictSeq.fromList [Addr -> Value ShelleyEra -> TxOut ShelleyEra
forall era.
(EraTxOut era, HasCallStack) =>
Addr -> Value era -> TxOut era
mkBasicTxOut Addr
Cast.aliceAddr (Coin -> Coin
forall t s. Inject t s => t -> s
Val.inject Coin
aliceCoinEx2)]
    TxBody TopTx ShelleyEra
-> (TxBody TopTx ShelleyEra -> TxBody TopTx ShelleyEra)
-> TxBody TopTx ShelleyEra
forall a b. a -> (a -> b) -> b
& (StrictSeq (TxCert ShelleyEra)
 -> Identity (StrictSeq (TxCert ShelleyEra)))
-> TxBody TopTx ShelleyEra -> Identity (TxBody TopTx ShelleyEra)
(StrictSeq (ShelleyTxCert ShelleyEra)
 -> Identity (StrictSeq (ShelleyTxCert ShelleyEra)))
-> TxBody TopTx ShelleyEra -> Identity (TxBody TopTx ShelleyEra)
forall era (l :: TxLevel).
EraTxBody era =>
Lens' (TxBody l era) (StrictSeq (TxCert era))
forall (l :: TxLevel).
Lens' (TxBody l ShelleyEra) (StrictSeq (TxCert ShelleyEra))
certsTxBodyL ((StrictSeq (ShelleyTxCert ShelleyEra)
  -> Identity (StrictSeq (ShelleyTxCert ShelleyEra)))
 -> TxBody TopTx ShelleyEra -> Identity (TxBody TopTx ShelleyEra))
-> StrictSeq (ShelleyTxCert ShelleyEra)
-> TxBody TopTx ShelleyEra
-> TxBody TopTx ShelleyEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [ShelleyTxCert ShelleyEra] -> StrictSeq (ShelleyTxCert ShelleyEra)
forall a. [a] -> StrictSeq a
StrictSeq.fromList [StakePoolParams -> TxCert ShelleyEra
forall era. EraTxCert era => StakePoolParams -> TxCert era
RegPoolTxCert StakePoolParams
newPoolParams]
    TxBody TopTx ShelleyEra
-> (TxBody TopTx ShelleyEra -> TxBody TopTx ShelleyEra)
-> TxBody TopTx ShelleyEra
forall a b. a -> (a -> b) -> b
& (Coin -> Identity Coin)
-> TxBody TopTx ShelleyEra -> Identity (TxBody TopTx ShelleyEra)
forall era. EraTxBody era => Lens' (TxBody TopTx era) Coin
Lens' (TxBody TopTx ShelleyEra) Coin
feeTxBodyL ((Coin -> Identity Coin)
 -> TxBody TopTx ShelleyEra -> Identity (TxBody TopTx ShelleyEra))
-> Coin -> TxBody TopTx ShelleyEra -> TxBody TopTx ShelleyEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Coin
feeTx2
    TxBody TopTx ShelleyEra
-> (TxBody TopTx ShelleyEra -> TxBody TopTx ShelleyEra)
-> TxBody TopTx ShelleyEra
forall a b. a -> (a -> b) -> b
& (SlotNo -> Identity SlotNo)
-> TxBody TopTx ShelleyEra -> Identity (TxBody TopTx ShelleyEra)
forall era.
(ShelleyEraTxBody era, ExactEra ShelleyEra era) =>
Lens' (TxBody TopTx era) SlotNo
Lens' (TxBody TopTx ShelleyEra) SlotNo
ttlTxBodyL ((SlotNo -> Identity SlotNo)
 -> TxBody TopTx ShelleyEra -> Identity (TxBody TopTx ShelleyEra))
-> SlotNo -> TxBody TopTx ShelleyEra -> TxBody TopTx ShelleyEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Word64 -> SlotNo
SlotNo Word64
100

txEx2 :: Tx TopTx ShelleyEra
txEx2 :: Tx TopTx ShelleyEra
txEx2 =
  TxBody TopTx ShelleyEra -> Tx TopTx ShelleyEra
forall era (l :: TxLevel). EraTx era => TxBody l era -> Tx l era
forall (l :: TxLevel). TxBody l ShelleyEra -> Tx l ShelleyEra
mkBasicTx TxBody TopTx ShelleyEra
txbodyEx2
    Tx TopTx ShelleyEra
-> (Tx TopTx ShelleyEra -> Tx TopTx ShelleyEra)
-> Tx TopTx ShelleyEra
forall a b. a -> (a -> b) -> b
& (TxWits ShelleyEra -> Identity (TxWits ShelleyEra))
-> Tx TopTx ShelleyEra -> Identity (Tx TopTx ShelleyEra)
(ShelleyTxWits ShelleyEra -> Identity (ShelleyTxWits ShelleyEra))
-> Tx TopTx ShelleyEra -> Identity (Tx TopTx ShelleyEra)
forall era (l :: TxLevel).
EraTx era =>
Lens' (Tx l era) (TxWits era)
forall (l :: TxLevel). Lens' (Tx l ShelleyEra) (TxWits ShelleyEra)
witsTxL
      ((ShelleyTxWits ShelleyEra -> Identity (ShelleyTxWits ShelleyEra))
 -> Tx TopTx ShelleyEra -> Identity (Tx TopTx ShelleyEra))
-> ShelleyTxWits ShelleyEra
-> Tx TopTx ShelleyEra
-> Tx TopTx ShelleyEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ( TxWits ShelleyEra
forall era. EraTxWits era => TxWits era
mkBasicTxWits
             TxWits ShelleyEra
-> (TxWits ShelleyEra -> ShelleyTxWits ShelleyEra)
-> ShelleyTxWits ShelleyEra
forall a b. a -> (a -> b) -> b
& (Set (WitVKey Witness) -> Identity (Set (WitVKey Witness)))
-> TxWits ShelleyEra -> Identity (TxWits ShelleyEra)
(Set (WitVKey Witness) -> Identity (Set (WitVKey Witness)))
-> TxWits ShelleyEra -> Identity (ShelleyTxWits ShelleyEra)
forall era.
EraTxWits era =>
Lens' (TxWits era) (Set (WitVKey Witness))
Lens' (TxWits ShelleyEra) (Set (WitVKey Witness))
addrTxWitsL
               ((Set (WitVKey Witness) -> Identity (Set (WitVKey Witness)))
 -> TxWits ShelleyEra -> Identity (ShelleyTxWits ShelleyEra))
-> Set (WitVKey Witness)
-> TxWits ShelleyEra
-> ShelleyTxWits ShelleyEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ SafeHash EraIndependentTxBody
-> [KeyPair Witness] -> Set (WitVKey Witness)
forall (kr :: KeyRole).
SafeHash EraIndependentTxBody
-> [KeyPair kr] -> Set (WitVKey Witness)
mkWitnessesVKey
                 (TxBody TopTx ShelleyEra -> SafeHash EraIndependentTxBody
forall x i. HashAnnotated x i => x -> SafeHash i
hashAnnotated TxBody TopTx ShelleyEra
txbodyEx2)
                 ( (KeyPair Payment -> KeyPair Witness
forall (a :: KeyRole -> *) (r :: KeyRole).
HasKeyRole a =>
a r -> a Witness
asWitness (KeyPair Payment -> KeyPair Witness)
-> [KeyPair Payment] -> [KeyPair Witness]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [KeyPair Payment
Cast.alicePay])
                     [KeyPair Witness] -> [KeyPair Witness] -> [KeyPair Witness]
forall a. Semigroup a => a -> a -> a
<> (KeyPair Staking -> KeyPair Witness
forall (a :: KeyRole -> *) (r :: KeyRole).
HasKeyRole a =>
a r -> a Witness
asWitness (KeyPair Staking -> KeyPair Witness)
-> [KeyPair Staking] -> [KeyPair Witness]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [KeyPair Staking
Cast.aliceStake])
                     [KeyPair Witness] -> [KeyPair Witness] -> [KeyPair Witness]
forall a. Semigroup a => a -> a -> a
<> [KeyPair StakePool -> KeyPair Witness
forall (a :: KeyRole -> *) (r :: KeyRole).
HasKeyRole a =>
a r -> a Witness
asWitness (KeyPair StakePool -> KeyPair Witness)
-> KeyPair StakePool -> KeyPair Witness
forall a b. (a -> b) -> a -> b
$ AllIssuerKeys MockCrypto StakePool -> KeyPair StakePool
forall c (r :: KeyRole). AllIssuerKeys c r -> KeyPair r
aikCold AllIssuerKeys MockCrypto StakePool
Cast.alicePoolKeys]
                 )
         )

word64SlotToKesPeriodWord :: Word64 -> Word
word64SlotToKesPeriodWord :: Word64 -> Word
word64SlotToKesPeriodWord Word64
slot =
  Integer -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Integer
forall a. Integral a => a -> Integer
toInteger Word64
slot) Word -> Word -> Word
forall a. Integral a => a -> a -> a
`div` Integer -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Integer
forall a. Integral a => a -> Integer
toInteger (Word64 -> Integer) -> Word64 -> Integer
forall a b. (a -> b) -> a -> b
$ Globals -> Word64
slotsPerKESPeriod Globals
testGlobals)

blockEx2 :: Word64 -> Block (BHeader MockCrypto) ShelleyEra
blockEx2 :: Word64 -> Block (BHeader MockCrypto) ShelleyEra
blockEx2 Word64
slot =
  HashHeader
-> AllIssuerKeys MockCrypto GenesisDelegate
-> [Tx TopTx ShelleyEra]
-> SlotNo
-> BlockNo
-> Nonce
-> NatNonce
-> UnitInterval
-> Word
-> Word
-> OCert MockCrypto
-> Block (BHeader MockCrypto) ShelleyEra
forall era (r :: KeyRole) c.
(Crypto c, EraBlockBody era, Signable (VRF c) (WithResult Seed),
 Signable (KES c) (BHBody c)) =>
HashHeader
-> AllIssuerKeys c r
-> [Tx TopTx 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
blockHeader 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, AtMostEra "Mary" era, AtMostEra "Alonzo" era) =>
PParams era
ppEx Word64
slot)
    [Tx TopTx ShelleyEra
txEx2]
    (Word64 -> SlotNo
SlotNo Word64
slot)
    (Word64 -> BlockNo
BlockNo Word64
2)
    Nonce
nonce0
    (Natural -> NatNonce
NatNonce Natural
2)
    UnitInterval
forall a. Bounded a => a
minBound
    (Word64 -> Word
word64SlotToKesPeriodWord Word64
slot)
    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, AtMostEra "Mary" era, AtMostEra "Alonzo" era) =>
PParams era
ppEx Word64
20) Word64
0 (Word -> KESPeriod
KESPeriod Word
0))

blockEx2A :: Block (BHeader MockCrypto) ShelleyEra
blockEx2A :: Block (BHeader MockCrypto) ShelleyEra
blockEx2A = Word64 -> Block (BHeader MockCrypto) ShelleyEra
blockEx2 Word64
20

expectedStEx2 :: ChainState ShelleyEra
expectedStEx2 :: ChainState ShelleyEra
expectedStEx2 =
  Coin -> ChainState ShelleyEra -> ChainState ShelleyEra
forall era. Coin -> ChainState era -> ChainState era
C.addFees 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 TopTx ShelleyEra
-> ChainState ShelleyEra -> ChainState ShelleyEra
forall era.
(EraTx era, EraStake era) =>
TxBody TopTx era -> ChainState era -> ChainState era
C.newUTxO TxBody TopTx ShelleyEra
txbodyEx2
    (ChainState ShelleyEra -> ChainState ShelleyEra)
-> (ChainState ShelleyEra -> ChainState ShelleyEra)
-> ChainState ShelleyEra
-> ChainState ShelleyEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StakePoolParams -> ChainState ShelleyEra -> ChainState ShelleyEra
forall era.
(EraCertState era, EraGov era) =>
StakePoolParams -> ChainState era -> ChainState era
C.regPool StakePoolParams
newPoolParams
    (ChainState ShelleyEra -> ChainState ShelleyEra)
-> ChainState ShelleyEra -> ChainState ShelleyEra
forall a b. (a -> b) -> a -> b
$ ChainState ShelleyEra
expectedStEx1

expectedStEx2A :: ChainState ShelleyEra
expectedStEx2A :: ChainState ShelleyEra
expectedStEx2A =
  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
blockEx2A)
    (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
blockEx2A
    (ChainState ShelleyEra -> ChainState ShelleyEra)
-> ChainState ShelleyEra -> ChainState ShelleyEra
forall a b. (a -> b) -> a -> b
$ ChainState ShelleyEra
expectedStEx2

-- === Block 2, Slot 20, Epoch 0
--
-- In the second block Alice re-registers with new pool parameters
-- early in the epoch.
poolReReg2A :: CHAINExample ShelleyEra
poolReReg2A :: CHAINExample ShelleyEra
poolReReg2A = 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
blockEx2A (ChainState ShelleyEra
-> Either
     (NonEmpty (TestChainPredicateFailure ShelleyEra))
     (ChainState ShelleyEra)
forall a b. b -> Either a b
Right ChainState ShelleyEra
expectedStEx2A)

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
expectedStEx2

expectedStEx2B :: ChainState ShelleyEra
expectedStEx2B :: ChainState ShelleyEra
expectedStEx2B =
  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
blockEx2B)
    (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
blockEx2B
    (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
expectedStEx2

blockEx2B :: Block (BHeader MockCrypto) ShelleyEra
blockEx2B :: Block (BHeader MockCrypto) ShelleyEra
blockEx2B = Word64 -> Block (BHeader MockCrypto) ShelleyEra
blockEx2 Word64
90

-- === Block 2, Slot 90, Epoch 0
--
-- In the second block Alice re-registers with new pool parameters
-- late in the epoch.
poolReReg2B :: CHAINExample ShelleyEra
poolReReg2B :: CHAINExample ShelleyEra
poolReReg2B = 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
blockEx2B (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
expectedStEx2B))

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

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

blockEx3 :: Block (BHeader MockCrypto) ShelleyEra
blockEx3 :: Block (BHeader MockCrypto) ShelleyEra
blockEx3 =
  HashHeader
-> AllIssuerKeys MockCrypto GenesisDelegate
-> [Tx TopTx ShelleyEra]
-> SlotNo
-> BlockNo
-> Nonce
-> NatNonce
-> UnitInterval
-> Word
-> Word
-> OCert MockCrypto
-> Block (BHeader MockCrypto) ShelleyEra
forall era (r :: KeyRole) c.
(Crypto c, EraBlockBody era, Signable (VRF c) (WithResult Seed),
 Signable (KES c) (BHBody c)) =>
HashHeader
-> AllIssuerKeys c r
-> [Tx TopTx 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
blockHeader Block (BHeader MockCrypto) ShelleyEra
blockEx2B)
    (forall era.
(HasCallStack, EraPParams era) =>
PParams era -> Word64 -> AllIssuerKeys MockCrypto GenesisDelegate
coreNodeKeysBySchedule @ShelleyEra PParams ShelleyEra
forall era.
(EraPParams era, AtMostEra "Mary" era, AtMostEra "Alonzo" era) =>
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, AtMostEra "Mary" era, AtMostEra "Alonzo" era) =>
PParams era
ppEx Word64
110) Word64
0 (Word -> KESPeriod
KESPeriod Word
0))

snapEx3 :: SnapShot
snapEx3 :: SnapShot
snapEx3 =
  ActiveStake -> [StakePoolParams] -> SnapShot
forall (f :: * -> *).
Foldable f =>
ActiveStake -> f StakePoolParams -> SnapShot
mkSnapShotFromStakePoolParams (VMap VB VS (Credential Staking) StakeWithDelegation -> ActiveStake
ActiveStake VMap VB VS (Credential Staking) StakeWithDelegation
forall (kv :: * -> *) k (vv :: * -> *) v.
(Vector kv k, Vector vv v) =>
VMap kv vv k v
VMap.empty) [StakePoolParams
Cast.aliceStakePoolParams]

expectedStEx3 :: ChainState ShelleyEra
expectedStEx3 :: ChainState ShelleyEra
expectedStEx3 =
  Block (BHeader MockCrypto) ShelleyEra
-> ChainState ShelleyEra -> ChainState ShelleyEra
forall era.
(AtMostEra "Alonzo" era, 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 t. Val t => t -> t -> t
<+> Coin
feeTx2)
    (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)
-> ChainState ShelleyEra
-> ChainState ShelleyEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Network
-> StakePoolParams
-> ChainState ShelleyEra
-> ChainState ShelleyEra
forall era.
(EraCertState era, EraGov era) =>
Network -> StakePoolParams -> ChainState era -> ChainState era
C.updatePoolParams (Globals -> Network
networkId Globals
testGlobals) StakePoolParams
newPoolParams
    (ChainState ShelleyEra -> ChainState ShelleyEra)
-> ChainState ShelleyEra -> ChainState ShelleyEra
forall a b. (a -> b) -> a -> b
$ ChainState ShelleyEra
expectedStEx2B

-- === Block 3, Slot 110, Epoch 1
--
-- The third block is empty and trigger the epoch change,
-- and Alice's new pool parameters are adopted.
poolReReg3 :: CHAINExample ShelleyEra
poolReReg3 :: CHAINExample ShelleyEra
poolReReg3 = 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
expectedStEx2B Block (BHeader MockCrypto) ShelleyEra
blockEx3 (ChainState ShelleyEra
-> Either
     (NonEmpty (TestChainPredicateFailure ShelleyEra))
     (ChainState ShelleyEra)
forall a b. b -> Either a b
Right ChainState ShelleyEra
expectedStEx3)

--
-- Pool Lifetime Test Group
--

poolReRegExample :: TestTree
poolReRegExample :: TestTree
poolReRegExample =
  String -> [TestTree] -> TestTree
forall a. HasCallStack => String -> [SpecWith a] -> SpecWith a
testGroup
    String
"pool rereg"
    [ HasCallStack => String -> Expectation -> TestTree
String -> Expectation -> TestTree
testCase String
"initial pool registration" (Expectation -> TestTree) -> Expectation -> TestTree
forall a b. (a -> b) -> a -> b
$ HasCallStack => CHAINExample ShelleyEra -> Expectation
CHAINExample ShelleyEra -> Expectation
testCHAINExample CHAINExample ShelleyEra
poolReReg1
    , HasCallStack => String -> Expectation -> TestTree
String -> Expectation -> TestTree
testCase String
"early epoch re-registration" (Expectation -> TestTree) -> Expectation -> TestTree
forall a b. (a -> b) -> a -> b
$ HasCallStack => CHAINExample ShelleyEra -> Expectation
CHAINExample ShelleyEra -> Expectation
testCHAINExample CHAINExample ShelleyEra
poolReReg2A
    , HasCallStack => String -> Expectation -> TestTree
String -> Expectation -> TestTree
testCase String
"late epoch re-registration" (Expectation -> TestTree) -> Expectation -> TestTree
forall a b. (a -> b) -> a -> b
$ HasCallStack => CHAINExample ShelleyEra -> Expectation
CHAINExample ShelleyEra -> Expectation
testCHAINExample CHAINExample ShelleyEra
poolReReg2B
    , HasCallStack => String -> Expectation -> TestTree
String -> Expectation -> TestTree
testCase String
"adopt new pool parameters" (Expectation -> TestTree) -> Expectation -> TestTree
forall a b. (a -> b) -> a -> b
$ HasCallStack => CHAINExample ShelleyEra -> Expectation
CHAINExample ShelleyEra -> Expectation
testCHAINExample CHAINExample ShelleyEra
poolReReg3
    ]