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

-- |
-- Module      : Test.Cardano.Ledger.Shelley.Examples.PoolReReg
-- Description : Pool Re-Registration
--
-- 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,
  StrictMaybe (..),
 )
import Cardano.Ledger.Block (Block, bheader)
import Cardano.Ledger.Coin (Coin (..))
import Cardano.Ledger.Keys (asWitness)
import Cardano.Ledger.PoolParams (PoolParams (..))
import Cardano.Ledger.Shelley (ShelleyEra, TxBody (..))
import Cardano.Ledger.Shelley.Core
import Cardano.Ledger.Shelley.LedgerState (PulsingRewUpdate, emptyRewardUpdate)
import Cardano.Ledger.Shelley.Tx (ShelleyTx (..))
import Cardano.Ledger.Shelley.TxOut (ShelleyTxOut (..))
import Cardano.Ledger.Shelley.TxWits (addrWits)
import Cardano.Ledger.Slot (BlockNo (..), SlotNo (..))
import Cardano.Ledger.State (SnapShot (ssPoolParams), UTxO (..), emptySnapShot)
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.Map.Strict as Map
import qualified Data.Sequence.Strict as StrictSeq
import qualified Data.Set as Set
import Data.Word (Word64)
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 (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 -> 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)]

initStPoolReReg :: ChainState ShelleyEra
initStPoolReReg :: ChainState ShelleyEra
initStPoolReReg = 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
--

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 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 [PoolParams -> TxCert ShelleyEra
forall era. EraTxCert era => PoolParams -> TxCert era
RegPoolTxCert PoolParams
Cast.alicePoolParams])
    (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]
                <> [asWitness $ Cast.aliceStake]
                <> [asWitness $ aikCold Cast.alicePoolKeys]
            )
      }
    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 [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
. 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
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 :: PoolParams
newPoolParams :: PoolParams
newPoolParams = PoolParams
Cast.alicePoolParams {ppCost = Coin 500}

txbodyEx2 :: TxBody ShelleyEra
txbodyEx2 :: TxBody ShelleyEra
txbodyEx2 =
  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
txbodyEx1) 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
aliceCoinEx2)])
    ( [ShelleyTxCert ShelleyEra] -> StrictSeq (ShelleyTxCert ShelleyEra)
forall a. [a] -> StrictSeq a
StrictSeq.fromList
        ( [ PoolParams -> TxCert ShelleyEra
forall era. EraTxCert era => PoolParams -> TxCert era
RegPoolTxCert PoolParams
newPoolParams
          ]
        )
    )
    (Map RewardAccount Coin -> Withdrawals
Withdrawals Map RewardAccount Coin
forall k a. Map k a
Map.empty)
    Coin
feeTx2
    (Word64 -> SlotNo
SlotNo Word64
100)
    StrictMaybe (Update ShelleyEra)
forall a. StrictMaybe a
SNothing
    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 $ aikCold Cast.alicePoolKeys]
            )
      }
    StrictMaybe (TxAuxData ShelleyEra)
StrictMaybe (ShelleyTxAuxData ShelleyEra)
forall a. StrictMaybe a
SNothing

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 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
slot)
    [Item [ShelleyTx ShelleyEra]
ShelleyTx 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, ProtVerAtMost era 4, ProtVerAtMost era 6) =>
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 =
  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 [] [Item [PoolParams]
PoolParams
newPoolParams] -- The deposit should be ignored because the poolId is already registered
    (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
. PoolParams -> ChainState ShelleyEra -> ChainState ShelleyEra
forall era.
EraCertState era =>
PoolParams -> ChainState era -> ChainState era
C.reregPool PoolParams
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 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
blockEx2B)
    (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
emptySnapShot {ssPoolParams = [(aikColdKeyHash Cast.alicePoolKeys, 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 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
. PoolParams -> ChainState ShelleyEra -> ChainState ShelleyEra
forall era.
EraCertState era =>
PoolParams -> ChainState era -> ChainState era
C.updatePoolParams PoolParams
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 =
  TestName -> [TestTree] -> TestTree
testGroup
    TestName
"pool rereg"
    [ TestName -> Assertion -> TestTree
testCase TestName
"initial pool registration" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ HasCallStack => CHAINExample ShelleyEra -> Assertion
CHAINExample ShelleyEra -> Assertion
testCHAINExample CHAINExample ShelleyEra
poolReReg1
    , TestName -> Assertion -> TestTree
testCase TestName
"early epoch re-registration" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ HasCallStack => CHAINExample ShelleyEra -> Assertion
CHAINExample ShelleyEra -> Assertion
testCHAINExample CHAINExample ShelleyEra
poolReReg2A
    , TestName -> Assertion -> TestTree
testCase TestName
"late epoch re-registration" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ HasCallStack => CHAINExample ShelleyEra -> Assertion
CHAINExample ShelleyEra -> Assertion
testCHAINExample CHAINExample ShelleyEra
poolReReg2B
    , TestName -> Assertion -> TestTree
testCase TestName
"adopt new pool parameters" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ HasCallStack => CHAINExample ShelleyEra -> Assertion
CHAINExample ShelleyEra -> Assertion
testCHAINExample CHAINExample ShelleyEra
poolReReg3
    ]