{-# 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.Crypto
import Cardano.Ledger.EpochBoundary (SnapShot (ssPoolParams), emptySnapShot)
import Cardano.Ledger.Keys (asWitness)
import Cardano.Ledger.PoolParams (PoolParams (..))
import Cardano.Ledger.SafeHash (hashAnnotated)
import Cardano.Ledger.Shelley (ShelleyEra)
import Cardano.Ledger.Shelley.Core
import Cardano.Ledger.Shelley.LedgerState (PulsingRewUpdate, emptyRewardUpdate)
import Cardano.Ledger.Shelley.Tx (ShelleyTx (..))
import Cardano.Ledger.Shelley.TxBody (ShelleyTxBody (..))
import Cardano.Ledger.Shelley.TxOut (ShelleyTxOut (..))
import Cardano.Ledger.Shelley.TxWits (addrWits)
import Cardano.Ledger.Slot (BlockNo (..), SlotNo (..))
import Cardano.Ledger.TxIn (TxIn (..))
import Cardano.Ledger.UTxO (UTxO (..))
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 (ExMock)
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 forall a b. (a -> b) -> a -> b
$ Integer
10 forall a. Num a => a -> a -> a
* Integer
1000 forall a. Num a => a -> a -> a
* Integer
1000 forall a. Num a => a -> a -> a
* Integer
1000 forall a. Num a => a -> a -> a
* Integer
1000 forall a. Num a => a -> a -> a
* Integer
1000

initUTxO :: Crypto c => UTxO (ShelleyEra c)
initUTxO :: forall c. Crypto c => UTxO (ShelleyEra c)
initUTxO = forall era. TxId (EraCrypto era) -> [TxOut era] -> UTxO era
genesisCoins forall c. HashAlgorithm (HASH c) => TxId c
genesisId [forall era.
(HasCallStack, Era era, Val (Value era)) =>
Addr (EraCrypto era) -> Value era -> ShelleyTxOut era
ShelleyTxOut forall c. Crypto c => Addr c
Cast.aliceAddr (forall t s. Inject t s => t -> s
Val.inject Coin
aliceInitCoin)]

initStPoolReReg :: Crypto c => ChainState (ShelleyEra c)
initStPoolReReg :: forall c. Crypto c => ChainState (ShelleyEra c)
initStPoolReReg = forall era.
(EraTxOut era, ProtVerAtMost era 4, ProtVerAtMost era 6,
 Default (StashedAVVMAddresses era), EraGov era) =>
UTxO era -> ChainState era
initSt forall c. Crypto c => UTxO (ShelleyEra c)
initUTxO

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

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

aliceCoinEx1 :: Coin
aliceCoinEx1 :: Coin
aliceCoinEx1 = Coin
aliceInitCoin forall t. Val t => t -> t -> t
<-> Integer -> Coin
Coin Integer
250 forall t. Val t => t -> t -> t
<-> Coin
feeTx1

txbodyEx1 :: Crypto c => ShelleyTxBody (ShelleyEra c)
txbodyEx1 :: forall c. Crypto c => ShelleyTxBody (ShelleyEra c)
txbodyEx1 =
  forall era.
(EraTxOut era, EncCBOR (TxCert era)) =>
Set (TxIn (EraCrypto era))
-> StrictSeq (TxOut era)
-> StrictSeq (TxCert era)
-> Withdrawals (EraCrypto era)
-> Coin
-> SlotNo
-> StrictMaybe (Update era)
-> StrictMaybe (AuxiliaryDataHash (EraCrypto era))
-> ShelleyTxBody era
ShelleyTxBody
    (forall a. Ord a => [a] -> Set a
Set.fromList [forall c. TxId c -> TxIx -> TxIn c
TxIn forall c. HashAlgorithm (HASH c) => TxId c
genesisId forall a. Bounded a => a
minBound])
    (forall a. [a] -> StrictSeq a
StrictSeq.fromList [forall era.
(HasCallStack, Era era, Val (Value era)) =>
Addr (EraCrypto era) -> Value era -> ShelleyTxOut era
ShelleyTxOut forall c. Crypto c => Addr c
Cast.aliceAddr (forall t s. Inject t s => t -> s
Val.inject Coin
aliceCoinEx1)])
    (forall a. [a] -> StrictSeq a
StrictSeq.fromList [forall era.
EraTxCert era =>
PoolParams (EraCrypto era) -> TxCert era
RegPoolTxCert forall c. Crypto c => PoolParams c
Cast.alicePoolParams])
    (forall c. Map (RewardAccount c) Coin -> Withdrawals c
Withdrawals forall k a. Map k a
Map.empty)
    Coin
feeTx1
    (Word64 -> SlotNo
SlotNo Word64
10)
    forall a. StrictMaybe a
SNothing
    forall a. StrictMaybe a
SNothing

txEx1 :: forall c. (Crypto c, ExMock (EraCrypto (ShelleyEra c))) => ShelleyTx (ShelleyEra c)
txEx1 :: forall c.
(Crypto c, ExMock (EraCrypto (ShelleyEra c))) =>
ShelleyTx (ShelleyEra c)
txEx1 =
  forall era.
EraTx era =>
TxBody era
-> TxWits era -> StrictMaybe (TxAuxData era) -> ShelleyTx era
ShelleyTx
    forall c. Crypto c => ShelleyTxBody (ShelleyEra c)
txbodyEx1
    forall a. Monoid a => a
mempty
      { addrWits :: Set (WitVKey 'Witness (EraCrypto (ShelleyEra c)))
addrWits =
          forall c (kr :: KeyRole).
(Crypto c, DSignable c (Hash (HASH c) EraIndependentTxBody)) =>
SafeHash c EraIndependentTxBody
-> [KeyPair kr c] -> Set (WitVKey 'Witness c)
mkWitnessesVKey
            (forall x index c.
(HashAnnotated x index c, HashAlgorithm (HASH c)) =>
x -> SafeHash c index
hashAnnotated forall a b. (a -> b) -> a -> b
$ forall c. Crypto c => ShelleyTxBody (ShelleyEra c)
txbodyEx1 @c)
            ( [forall (a :: KeyRole -> * -> *) (r :: KeyRole) c.
HasKeyRole a =>
a r c -> a 'Witness c
asWitness forall a b. (a -> b) -> a -> b
$ forall c. Crypto c => KeyPair 'Payment c
Cast.alicePay]
                forall a. Semigroup a => a -> a -> a
<> [forall (a :: KeyRole -> * -> *) (r :: KeyRole) c.
HasKeyRole a =>
a r c -> a 'Witness c
asWitness forall a b. (a -> b) -> a -> b
$ forall c. Crypto c => KeyPair 'Staking c
Cast.aliceStake]
                forall a. Semigroup a => a -> a -> a
<> [forall (a :: KeyRole -> * -> *) (r :: KeyRole) c.
HasKeyRole a =>
a r c -> a 'Witness c
asWitness forall a b. (a -> b) -> a -> b
$ forall v (r :: KeyRole). AllIssuerKeys v r -> KeyPair r v
aikCold forall c. Crypto c => AllIssuerKeys c 'StakePool
Cast.alicePoolKeys]
            )
      }
    forall a. StrictMaybe a
SNothing

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

expectedStEx1 ::
  forall c.
  ExMock (EraCrypto (ShelleyEra c)) =>
  ChainState (ShelleyEra c)
expectedStEx1 :: forall c.
ExMock (EraCrypto (ShelleyEra c)) =>
ChainState (ShelleyEra c)
expectedStEx1 =
  forall era. Nonce -> ChainState era -> ChainState era
C.evolveNonceUnfrozen (forall era. Era era => Block (BHeader (EraCrypto era)) era -> Nonce
getBlockNonce (forall c.
(HasCallStack, ExMock (EraCrypto (ShelleyEra c))) =>
Block (BHeader c) (ShelleyEra c)
blockEx1 @c))
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
Era era =>
Block (BHeader (EraCrypto era)) era
-> ChainState era -> ChainState era
C.newLab forall c.
(HasCallStack, ExMock (EraCrypto (ShelleyEra c))) =>
Block (BHeader c) (ShelleyEra c)
blockEx1
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
EraPParams era =>
PParams era
-> Coin
-> [Credential 'Staking (EraCrypto era)]
-> [PoolParams (EraCrypto era)]
-> ChainState era
-> ChainState era
C.feesAndDeposits forall era.
(EraPParams era, ProtVerAtMost era 4, ProtVerAtMost era 6) =>
PParams era
ppEx Coin
feeTx1 [] [forall c. Crypto c => PoolParams c
Cast.alicePoolParams]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
(EraTx era, EraGov era) =>
TxBody era -> ChainState era -> ChainState era
C.newUTxO forall c. Crypto c => ShelleyTxBody (ShelleyEra c)
txbodyEx1
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
PoolParams (EraCrypto era) -> ChainState era -> ChainState era
C.newPool forall c. Crypto c => PoolParams c
Cast.alicePoolParams
    forall a b. (a -> b) -> a -> b
$ forall c. Crypto c => ChainState (ShelleyEra c)
initStPoolReReg

-- === Block 1, Slot 10, Epoch 0
--
-- In the first block Alice registers a stake pool.
poolReReg1 :: ExMock (EraCrypto (ShelleyEra c)) => CHAINExample (BHeader c) (ShelleyEra c)
poolReReg1 :: forall c.
ExMock (EraCrypto (ShelleyEra c)) =>
CHAINExample (BHeader c) (ShelleyEra c)
poolReReg1 = forall h era.
ChainState era
-> Block h era
-> Either
     (NonEmpty (PredicateFailure (CHAIN era))) (ChainState era)
-> CHAINExample h era
CHAINExample forall c. Crypto c => ChainState (ShelleyEra c)
initStPoolReReg forall c.
(HasCallStack, ExMock (EraCrypto (ShelleyEra c))) =>
Block (BHeader c) (ShelleyEra c)
blockEx1 (forall a b. b -> Either a b
Right forall c.
ExMock (EraCrypto (ShelleyEra c)) =>
ChainState (ShelleyEra c)
expectedStEx1)

--
-- Block 2, Slot 20, Epoch 0
--

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

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

newPoolParams :: Crypto c => PoolParams c
newPoolParams :: forall c. Crypto c => PoolParams c
newPoolParams = forall c. Crypto c => PoolParams c
Cast.alicePoolParams {ppCost :: Coin
ppCost = Integer -> Coin
Coin Integer
500}

txbodyEx2 :: forall c. Crypto c => ShelleyTxBody (ShelleyEra c)
txbodyEx2 :: forall c. Crypto c => ShelleyTxBody (ShelleyEra c)
txbodyEx2 =
  forall era.
(EraTxOut era, EncCBOR (TxCert era)) =>
Set (TxIn (EraCrypto era))
-> StrictSeq (TxOut era)
-> StrictSeq (TxCert era)
-> Withdrawals (EraCrypto era)
-> Coin
-> SlotNo
-> StrictMaybe (Update era)
-> StrictMaybe (AuxiliaryDataHash (EraCrypto era))
-> ShelleyTxBody era
ShelleyTxBody
    (forall a. Ord a => [a] -> Set a
Set.fromList [forall c. TxId c -> TxIx -> TxIn c
TxIn (forall era. EraTxBody era => TxBody era -> TxId (EraCrypto era)
txIdTxBody forall c. Crypto c => ShelleyTxBody (ShelleyEra c)
txbodyEx1) forall a. Bounded a => a
minBound])
    (forall a. [a] -> StrictSeq a
StrictSeq.fromList [forall era.
(HasCallStack, Era era, Val (Value era)) =>
Addr (EraCrypto era) -> Value era -> ShelleyTxOut era
ShelleyTxOut forall c. Crypto c => Addr c
Cast.aliceAddr (forall t s. Inject t s => t -> s
Val.inject Coin
aliceCoinEx2)])
    ( forall a. [a] -> StrictSeq a
StrictSeq.fromList
        ( [ forall era.
EraTxCert era =>
PoolParams (EraCrypto era) -> TxCert era
RegPoolTxCert forall c. Crypto c => PoolParams c
newPoolParams
          ]
        )
    )
    (forall c. Map (RewardAccount c) Coin -> Withdrawals c
Withdrawals forall k a. Map k a
Map.empty)
    Coin
feeTx2
    (Word64 -> SlotNo
SlotNo Word64
100)
    forall a. StrictMaybe a
SNothing
    forall a. StrictMaybe a
SNothing

txEx2 :: forall c. (Crypto c, ExMock (EraCrypto (ShelleyEra c))) => ShelleyTx (ShelleyEra c)
txEx2 :: forall c.
(Crypto c, ExMock (EraCrypto (ShelleyEra c))) =>
ShelleyTx (ShelleyEra c)
txEx2 =
  forall era.
EraTx era =>
TxBody era
-> TxWits era -> StrictMaybe (TxAuxData era) -> ShelleyTx era
ShelleyTx
    forall c. Crypto c => ShelleyTxBody (ShelleyEra c)
txbodyEx2
    forall a. Monoid a => a
mempty
      { addrWits :: Set (WitVKey 'Witness (EraCrypto (ShelleyEra c)))
addrWits =
          forall c (kr :: KeyRole).
(Crypto c, DSignable c (Hash (HASH c) EraIndependentTxBody)) =>
SafeHash c EraIndependentTxBody
-> [KeyPair kr c] -> Set (WitVKey 'Witness c)
mkWitnessesVKey
            (forall x index c.
(HashAnnotated x index c, HashAlgorithm (HASH c)) =>
x -> SafeHash c index
hashAnnotated forall a b. (a -> b) -> a -> b
$ forall c. Crypto c => ShelleyTxBody (ShelleyEra c)
txbodyEx2 @c)
            ( (forall (a :: KeyRole -> * -> *) (r :: KeyRole) c.
HasKeyRole a =>
a r c -> a 'Witness c
asWitness forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [forall c. Crypto c => KeyPair 'Payment c
Cast.alicePay])
                forall a. Semigroup a => a -> a -> a
<> (forall (a :: KeyRole -> * -> *) (r :: KeyRole) c.
HasKeyRole a =>
a r c -> a 'Witness c
asWitness forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [forall c. Crypto c => KeyPair 'Staking c
Cast.aliceStake])
                forall a. Semigroup a => a -> a -> a
<> [forall (a :: KeyRole -> * -> *) (r :: KeyRole) c.
HasKeyRole a =>
a r c -> a 'Witness c
asWitness forall a b. (a -> b) -> a -> b
$ forall v (r :: KeyRole). AllIssuerKeys v r -> KeyPair r v
aikCold forall c. Crypto c => AllIssuerKeys c 'StakePool
Cast.alicePoolKeys]
            )
      }
    forall a. StrictMaybe a
SNothing

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

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

blockEx2A :: forall c. ExMock (EraCrypto (ShelleyEra c)) => Block (BHeader c) (ShelleyEra c)
blockEx2A :: forall c.
ExMock (EraCrypto (ShelleyEra c)) =>
Block (BHeader c) (ShelleyEra c)
blockEx2A = forall c.
ExMock (EraCrypto (ShelleyEra c)) =>
Word64 -> Block (BHeader c) (ShelleyEra c)
blockEx2 Word64
20

expectedStEx2 :: forall c. ExMock (EraCrypto (ShelleyEra c)) => ChainState (ShelleyEra c)
expectedStEx2 :: forall c.
ExMock (EraCrypto (ShelleyEra c)) =>
ChainState (ShelleyEra c)
expectedStEx2 =
  forall era.
EraPParams era =>
PParams era
-> Coin
-> [Credential 'Staking (EraCrypto era)]
-> [PoolParams (EraCrypto era)]
-> ChainState era
-> ChainState era
C.feesAndDeposits forall era.
(EraPParams era, ProtVerAtMost era 4, ProtVerAtMost era 6) =>
PParams era
ppEx Coin
feeTx2 [] [forall c. Crypto c => PoolParams c
newPoolParams] -- The deposit should be ignored because the poolId is already registered
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
(EraTx era, EraGov era) =>
TxBody era -> ChainState era -> ChainState era
C.newUTxO forall c. Crypto c => ShelleyTxBody (ShelleyEra c)
txbodyEx2
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
PoolParams (EraCrypto era) -> ChainState era -> ChainState era
C.reregPool forall c. Crypto c => PoolParams c
newPoolParams
    forall a b. (a -> b) -> a -> b
$ forall c.
ExMock (EraCrypto (ShelleyEra c)) =>
ChainState (ShelleyEra c)
expectedStEx1

expectedStEx2A :: forall c. ExMock (EraCrypto (ShelleyEra c)) => ChainState (ShelleyEra c)
expectedStEx2A :: forall c.
ExMock (EraCrypto (ShelleyEra c)) =>
ChainState (ShelleyEra c)
expectedStEx2A =
  forall era. Nonce -> ChainState era -> ChainState era
C.evolveNonceUnfrozen (forall era. Era era => Block (BHeader (EraCrypto era)) era -> Nonce
getBlockNonce (forall c.
ExMock (EraCrypto (ShelleyEra c)) =>
Block (BHeader c) (ShelleyEra c)
blockEx2A @c))
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
Era era =>
Block (BHeader (EraCrypto era)) era
-> ChainState era -> ChainState era
C.newLab forall c.
ExMock (EraCrypto (ShelleyEra c)) =>
Block (BHeader c) (ShelleyEra c)
blockEx2A
    forall a b. (a -> b) -> a -> b
$ forall c.
ExMock (EraCrypto (ShelleyEra c)) =>
ChainState (ShelleyEra c)
expectedStEx2

-- === Block 2, Slot 20, Epoch 0
--
-- In the second block Alice re-registers with new pool parameters
-- early in the epoch.
poolReReg2A :: ExMock (EraCrypto (ShelleyEra c)) => CHAINExample (BHeader c) (ShelleyEra c)
poolReReg2A :: forall c.
ExMock (EraCrypto (ShelleyEra c)) =>
CHAINExample (BHeader c) (ShelleyEra c)
poolReReg2A = forall h era.
ChainState era
-> Block h era
-> Either
     (NonEmpty (PredicateFailure (CHAIN era))) (ChainState era)
-> CHAINExample h era
CHAINExample forall c.
ExMock (EraCrypto (ShelleyEra c)) =>
ChainState (ShelleyEra c)
expectedStEx1 forall c.
ExMock (EraCrypto (ShelleyEra c)) =>
Block (BHeader c) (ShelleyEra c)
blockEx2A (forall a b. b -> Either a b
Right forall c.
ExMock (EraCrypto (ShelleyEra c)) =>
ChainState (ShelleyEra c)
expectedStEx2A)

pulserEx2 :: forall c. ExMock c => PulsingRewUpdate c
pulserEx2 :: forall c. ExMock c => PulsingRewUpdate c
pulserEx2 = forall era.
EraGov era =>
BlocksMade (EraCrypto era)
-> ChainState era -> PulsingRewUpdate (EraCrypto era)
makeCompletedPulser (forall c. Map (KeyHash 'StakePool c) Natural -> BlocksMade c
BlocksMade forall a. Monoid a => a
mempty) forall c.
ExMock (EraCrypto (ShelleyEra c)) =>
ChainState (ShelleyEra c)
expectedStEx2

expectedStEx2B :: forall c. ExMock (EraCrypto (ShelleyEra c)) => ChainState (ShelleyEra c)
expectedStEx2B :: forall c.
ExMock (EraCrypto (ShelleyEra c)) =>
ChainState (ShelleyEra c)
expectedStEx2B =
  forall era. Nonce -> ChainState era -> ChainState era
C.evolveNonceFrozen (forall era. Era era => Block (BHeader (EraCrypto era)) era -> Nonce
getBlockNonce (forall c.
ExMock (EraCrypto (ShelleyEra c)) =>
Block (BHeader c) (ShelleyEra c)
blockEx2B @c))
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
Era era =>
Block (BHeader (EraCrypto era)) era
-> ChainState era -> ChainState era
C.newLab forall c.
ExMock (EraCrypto (ShelleyEra c)) =>
Block (BHeader c) (ShelleyEra c)
blockEx2B
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
PulsingRewUpdate (EraCrypto era)
-> ChainState era -> ChainState era
C.pulserUpdate forall c. ExMock c => PulsingRewUpdate c
pulserEx2
    forall a b. (a -> b) -> a -> b
$ forall c.
ExMock (EraCrypto (ShelleyEra c)) =>
ChainState (ShelleyEra c)
expectedStEx2

blockEx2B :: forall c. ExMock (EraCrypto (ShelleyEra c)) => Block (BHeader c) (ShelleyEra c)
blockEx2B :: forall c.
ExMock (EraCrypto (ShelleyEra c)) =>
Block (BHeader c) (ShelleyEra c)
blockEx2B = forall c.
ExMock (EraCrypto (ShelleyEra c)) =>
Word64 -> Block (BHeader c) (ShelleyEra c)
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 :: ExMock (EraCrypto (ShelleyEra c)) => CHAINExample (BHeader c) (ShelleyEra c)
poolReReg2B :: forall c.
ExMock (EraCrypto (ShelleyEra c)) =>
CHAINExample (BHeader c) (ShelleyEra c)
poolReReg2B = forall h era.
ChainState era
-> Block h era
-> Either
     (NonEmpty (PredicateFailure (CHAIN era))) (ChainState era)
-> CHAINExample h era
CHAINExample forall c.
ExMock (EraCrypto (ShelleyEra c)) =>
ChainState (ShelleyEra c)
expectedStEx1 forall c.
ExMock (EraCrypto (ShelleyEra c)) =>
Block (BHeader c) (ShelleyEra c)
blockEx2B (forall a b. b -> Either a b
Right (forall era. EraGov era => ChainState era -> ChainState era
C.solidifyProposals forall c.
ExMock (EraCrypto (ShelleyEra c)) =>
ChainState (ShelleyEra c)
expectedStEx2B))

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

epoch1Nonce :: forall c. ExMock (EraCrypto (ShelleyEra c)) => Nonce
epoch1Nonce :: forall c. ExMock (EraCrypto (ShelleyEra c)) => Nonce
epoch1Nonce = forall era. ChainState era -> Nonce
chainCandidateNonce (forall c.
ExMock (EraCrypto (ShelleyEra c)) =>
ChainState (ShelleyEra c)
expectedStEx2B @c)

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

snapEx3 :: Crypto c => SnapShot c
snapEx3 :: forall c. Crypto c => SnapShot c
snapEx3 =
  forall c. SnapShot c
emptySnapShot {$sel:ssPoolParams:SnapShot :: VMap VB VB (KeyHash 'StakePool c) (PoolParams c)
ssPoolParams = [(forall v (r :: KeyRole). AllIssuerKeys v r -> KeyHash r v
aikColdKeyHash forall c. Crypto c => AllIssuerKeys c 'StakePool
Cast.alicePoolKeys, forall c. Crypto c => PoolParams c
Cast.alicePoolParams)]}

expectedStEx3 :: forall c. ExMock (EraCrypto (ShelleyEra c)) => ChainState (ShelleyEra c)
expectedStEx3 :: forall c.
ExMock (EraCrypto (ShelleyEra c)) =>
ChainState (ShelleyEra c)
expectedStEx3 =
  forall era.
(ProtVerAtMost era 6, EraGov era) =>
Block (BHeader (EraCrypto era)) era
-> ChainState era -> ChainState era
C.newEpoch forall c.
ExMock (EraCrypto (ShelleyEra c)) =>
Block (BHeader c) (ShelleyEra c)
blockEx3
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
SnapShot (EraCrypto era)
-> Coin -> ChainState era -> ChainState era
C.newSnapshot forall c. Crypto c => SnapShot c
snapEx3 (Coin
feeTx1 forall t. Val t => t -> t -> t
<+> Coin
feeTx2)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
EraGov era =>
RewardUpdate (EraCrypto era) -> ChainState era -> ChainState era
C.applyRewardUpdate forall c. RewardUpdate c
emptyRewardUpdate
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
PoolParams (EraCrypto era) -> ChainState era -> ChainState era
C.updatePoolParams forall c. Crypto c => PoolParams c
newPoolParams
    forall a b. (a -> b) -> a -> b
$ forall c.
ExMock (EraCrypto (ShelleyEra c)) =>
ChainState (ShelleyEra c)
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 :: ExMock (EraCrypto (ShelleyEra c)) => CHAINExample (BHeader c) (ShelleyEra c)
poolReReg3 :: forall c.
ExMock (EraCrypto (ShelleyEra c)) =>
CHAINExample (BHeader c) (ShelleyEra c)
poolReReg3 = forall h era.
ChainState era
-> Block h era
-> Either
     (NonEmpty (PredicateFailure (CHAIN era))) (ChainState era)
-> CHAINExample h era
CHAINExample forall c.
ExMock (EraCrypto (ShelleyEra c)) =>
ChainState (ShelleyEra c)
expectedStEx2B forall c.
ExMock (EraCrypto (ShelleyEra c)) =>
Block (BHeader c) (ShelleyEra c)
blockEx3 (forall a b. b -> Either a b
Right forall c.
ExMock (EraCrypto (ShelleyEra c)) =>
ChainState (ShelleyEra c)
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" forall a b. (a -> b) -> a -> b
$ HasCallStack =>
CHAINExample (BHeader C_Crypto) (ShelleyEra C_Crypto) -> Assertion
testCHAINExample forall c.
ExMock (EraCrypto (ShelleyEra c)) =>
CHAINExample (BHeader c) (ShelleyEra c)
poolReReg1
    , TestName -> Assertion -> TestTree
testCase TestName
"early epoch re-registration" forall a b. (a -> b) -> a -> b
$ HasCallStack =>
CHAINExample (BHeader C_Crypto) (ShelleyEra C_Crypto) -> Assertion
testCHAINExample forall c.
ExMock (EraCrypto (ShelleyEra c)) =>
CHAINExample (BHeader c) (ShelleyEra c)
poolReReg2A
    , TestName -> Assertion -> TestTree
testCase TestName
"late epoch re-registration" forall a b. (a -> b) -> a -> b
$ HasCallStack =>
CHAINExample (BHeader C_Crypto) (ShelleyEra C_Crypto) -> Assertion
testCHAINExample forall c.
ExMock (EraCrypto (ShelleyEra c)) =>
CHAINExample (BHeader c) (ShelleyEra c)
poolReReg2B
    , TestName -> Assertion -> TestTree
testCase TestName
"adopt new pool parameters" forall a b. (a -> b) -> a -> b
$ HasCallStack =>
CHAINExample (BHeader C_Crypto) (ShelleyEra C_Crypto) -> Assertion
testCHAINExample forall c.
ExMock (EraCrypto (ShelleyEra c)) =>
CHAINExample (BHeader c) (ShelleyEra c)
poolReReg3
    ]