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

-- |
-- Module      : Test.Cardano.Ledger.Shelley.Examples.GenesisDelegation
-- Description : Genesis Delegation Example
--
-- Example demonstrating Genesis Delegation
module Test.Cardano.Ledger.Shelley.Examples.GenesisDelegation (
  genesisDelegExample,
)
where

import Cardano.Crypto.DSIGN.Class (Signable)
import qualified Cardano.Crypto.Hash as Hash
import Cardano.Ledger.BaseTypes (StrictMaybe (..))
import Cardano.Ledger.Block (Block, bheader)
import Cardano.Ledger.Coin (Coin (..))
import Cardano.Ledger.Crypto
import Cardano.Ledger.Keys (
  GenDelegPair (..),
  Hash,
  KeyRole (..),
  VerKeyVRF,
  asWitness,
  hashKey,
  hashVerKeyVRF,
 )
import Cardano.Ledger.SafeHash (hashAnnotated)
import Cardano.Ledger.Shelley (ShelleyEra)
import Cardano.Ledger.Shelley.Core
import Cardano.Ledger.Shelley.LedgerState
import Cardano.Ledger.Shelley.Tx (ShelleyTx (..))
import Cardano.Ledger.Shelley.TxBody (ShelleyTxBody (..))
import Cardano.Ledger.Shelley.TxOut (ShelleyTxOut (..))
import Cardano.Ledger.Shelley.TxWits (ShelleyTxWits, 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 Data.Default.Class (Default)
import qualified Data.Map.Strict as Map
import qualified Data.Sequence.Strict as StrictSeq
import qualified Data.Set as Set
import Test.Cardano.Ledger.Core.KeyPair (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,
  coreNodeSK,
  coreNodeVK,
 )
import Test.Cardano.Ledger.Shelley.Examples.Init (
  initSt,
  lastByronHeaderHash,
  nonce0,
  ppEx,
 )
import Test.Cardano.Ledger.Shelley.Examples.PoolLifetime (makePulser')
import Test.Cardano.Ledger.Shelley.Generator.Core (
  NatNonce (..),
  VRFKeyPair (..),
  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 (
  RawSeed (..),
  getBlockNonce,
  mkKeyPair,
  mkVRFKeyPair,
 )
import Test.Tasty (TestTree, testGroup)
import Test.Tasty.HUnit (testCase)

initUTxO :: EraTxOut era => UTxO era
initUTxO :: forall era. EraTxOut era => UTxO era
initUTxO =
  forall era. TxId (EraCrypto era) -> [TxOut era] -> UTxO era
genesisCoins
    forall c. HashAlgorithm (HASH c) => TxId c
genesisId
    [ forall era.
(EraTxOut era, HasCallStack) =>
Addr (EraCrypto era) -> Value era -> TxOut era
mkBasicTxOut forall c. Crypto c => Addr c
Cast.aliceAddr Value era
aliceInitCoin
    , forall era.
(EraTxOut era, HasCallStack) =>
Addr (EraCrypto era) -> Value era -> TxOut era
mkBasicTxOut forall c. Crypto c => Addr c
Cast.bobAddr Value era
bobInitCoin
    ]
  where
    aliceInitCoin :: Value era
aliceInitCoin = forall t s. Inject t s => t -> s
Val.inject forall a b. (a -> b) -> a -> b
$ 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
    bobInitCoin :: Value era
bobInitCoin = forall t s. Inject t s => t -> s
Val.inject forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin forall a b. (a -> b) -> a -> b
$ Integer
1 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

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

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

newGenDelegate ::
  Crypto c =>
  KeyPair 'GenesisDelegate c
newGenDelegate :: forall c. Crypto c => KeyPair 'GenesisDelegate c
newGenDelegate = forall (kd :: KeyRole) c.
VKey kd c -> SignKeyDSIGN (DSIGN c) -> KeyPair kd c
KeyPair forall {kd :: KeyRole}. VKey kd c
vkCold SignKeyDSIGN (DSIGN c)
skCold
  where
    (SignKeyDSIGN (DSIGN c)
skCold, VKey kd c
vkCold) = forall c (kd :: KeyRole).
DSIGNAlgorithm (DSIGN c) =>
RawSeed -> (SignKeyDSIGN (DSIGN c), VKey kd c)
mkKeyPair (Word64 -> Word64 -> Word64 -> Word64 -> Word64 -> RawSeed
RawSeed Word64
108 Word64
0 Word64
0 Word64
0 Word64
1)

newGenesisVrfKH :: forall c. Crypto c => Hash c (VerKeyVRF c)
newGenesisVrfKH :: forall c. Crypto c => Hash c (VerKeyVRF c)
newGenesisVrfKH = forall v h.
(VRFAlgorithm v, HashAlgorithm h) =>
VerKeyVRF v -> Hash h (VerKeyVRF v)
hashVerKeyVRF (forall c. VRFKeyPair c -> VerKeyVRF c
vrfVerKey (forall c. Crypto c => RawSeed -> VRFKeyPair c
mkVRFKeyPair @c (Word64 -> Word64 -> Word64 -> Word64 -> Word64 -> RawSeed
RawSeed Word64
9 Word64
8 Word64
7 Word64
6 Word64
5)))

feeTx1 :: Coin
feeTx1 :: Coin
feeTx1 = Integer -> Coin
Coin Integer
1

txbodyEx1 :: forall c. 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.singleton forall a b. (a -> b) -> a -> b
$ forall era.
(HasCallStack, Era era, Val (Value era)) =>
Addr (EraCrypto era) -> Value era -> ShelleyTxOut era
ShelleyTxOut forall c. Crypto c => Addr c
Cast.aliceAddr Coin
aliceCoinEx1)
    ( forall a. [a] -> StrictSeq a
StrictSeq.fromList
        [ forall era.
(ShelleyEraTxCert era, ProtVerAtMost era 8) =>
KeyHash 'Genesis (EraCrypto era)
-> KeyHash 'GenesisDelegate (EraCrypto era)
-> Hash (EraCrypto era) (VerKeyVRF (EraCrypto era))
-> TxCert era
GenesisDelegTxCert
            (forall c (kd :: KeyRole). Crypto c => VKey kd c -> KeyHash kd c
hashKey (forall c. Crypto c => Int -> VKey 'Genesis c
coreNodeVK Int
0))
            (forall c (kd :: KeyRole). Crypto c => VKey kd c -> KeyHash kd c
hashKey (forall (kd :: KeyRole) c. KeyPair kd c -> VKey kd c
vKey forall c. Crypto c => KeyPair 'GenesisDelegate c
newGenDelegate))
            (forall c. Crypto c => Hash c (VerKeyVRF c)
newGenesisVrfKH @c)
        ]
    )
    (forall c. Map (RewardAcnt c) Coin -> Withdrawals c
Withdrawals forall k a. Map k a
Map.empty)
    (Integer -> Coin
Coin Integer
1)
    (Word64 -> SlotNo
SlotNo Word64
10)
    forall a. StrictMaybe a
SNothing
    forall a. StrictMaybe a
SNothing
  where
    aliceCoinEx1 :: Coin
aliceCoinEx1 = Coin
aliceInitCoin forall t. Val t => t -> t -> t
<-> forall t s. Inject t s => t -> s
Val.inject Coin
feeTx1
    aliceInitCoin :: Coin
aliceInitCoin = forall t s. Inject t s => t -> s
Val.inject forall a b. (a -> b) -> a -> b
$ 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

txEx1 ::
  forall c.
  ( Crypto c
  , Signable (DSIGN c) (Hash.Hash (HASH c) EraIndependentTxBody)
  ) =>
  ShelleyTx (ShelleyEra c)
txEx1 :: forall c.
(Crypto c,
 Signable (DSIGN c) (Hash (HASH c) EraIndependentTxBody)) =>
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 ShelleyTxWits (ShelleyEra c)
txwits forall a. StrictMaybe a
SNothing
  where
    txwits :: ShelleyTxWits (ShelleyEra c)
    txwits :: ShelleyTxWits (ShelleyEra c)
txwits =
      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 @c
              (forall x index c.
(HashAnnotated x index c, HashAlgorithm (HASH c)) =>
x -> SafeHash c index
hashAnnotated (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 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 (kd :: KeyRole) c.
VKey kd c -> SignKeyDSIGN (DSIGN c) -> KeyPair kd c
KeyPair @'Genesis @c
                          (forall c. Crypto c => Int -> VKey 'Genesis c
coreNodeVK Int
0)
                          (forall c. Crypto c => Int -> SignKeyDSIGN c
coreNodeSK @c Int
0)
                     ]
              )
        }

blockEx1 ::
  forall c.
  ExMock (EraCrypto (ShelleyEra c)) =>
  Block (BHeader c) (ShelleyEra c)
blockEx1 :: forall c.
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 @(ShelleyEra c)
    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,
 Signable (DSIGN c) (Hash (HASH c) EraIndependentTxBody)) =>
ShelleyTx (ShelleyEra c)
txEx1]
    (Word64 -> SlotNo
SlotNo Word64
10)
    (Word64 -> BlockNo
BlockNo Word64
1)
    (forall c. Crypto c => Nonce
nonce0 @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 @c (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))

newGenDeleg ::
  forall c.
  Crypto c =>
  (FutureGenDeleg c, GenDelegPair c)
newGenDeleg :: forall c. Crypto c => (FutureGenDeleg c, GenDelegPair c)
newGenDeleg =
  ( forall c. SlotNo -> KeyHash 'Genesis c -> FutureGenDeleg c
FutureGenDeleg (Word64 -> SlotNo
SlotNo Word64
43) (forall c (kd :: KeyRole). Crypto c => VKey kd c -> KeyHash kd c
hashKey forall a b. (a -> b) -> a -> b
$ forall c. Crypto c => Int -> VKey 'Genesis c
coreNodeVK Int
0)
  , forall c.
KeyHash 'GenesisDelegate c
-> Hash c (VerKeyVRF c) -> GenDelegPair c
GenDelegPair (forall c (kd :: KeyRole). Crypto c => VKey kd c -> KeyHash kd c
hashKey forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (kd :: KeyRole) c. KeyPair kd c -> VKey kd c
vKey forall a b. (a -> b) -> a -> b
$ forall c. Crypto c => KeyPair 'GenesisDelegate c
newGenDelegate) (forall c. Crypto c => Hash c (VerKeyVRF c)
newGenesisVrfKH @c)
  )

expectedStEx1 ::
  forall c.
  ExMock c =>
  ChainState (ShelleyEra c)
expectedStEx1 :: forall c. ExMock 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 @(ShelleyEra c) forall c.
ExMock (EraCrypto (ShelleyEra c)) =>
Block (BHeader c) (ShelleyEra c)
blockEx1)
    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)
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 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.
(FutureGenDeleg (EraCrypto era), GenDelegPair (EraCrypto era))
-> ChainState era -> ChainState era
C.setFutureGenDeleg forall c. Crypto c => (FutureGenDeleg c, GenDelegPair c)
newGenDeleg
    forall a b. (a -> b) -> a -> b
$ forall era.
(EraTxOut era, ProtVerAtMost era 4, ProtVerAtMost era 6,
 EraGov era, Default (StashedAVVMAddresses era)) =>
ChainState era
initStGenesisDeleg

-- === Block 1, Slot 10, Epoch 0
--
-- In the first block, stage a new future genesis delegate
genesisDelegation1 ::
  ExMock c =>
  CHAINExample (BHeader c) (ShelleyEra c)
genesisDelegation1 :: forall c. ExMock c => CHAINExample (BHeader c) (ShelleyEra c)
genesisDelegation1 = forall h era.
ChainState era
-> Block h era
-> Either
     (NonEmpty (PredicateFailure (CHAIN era))) (ChainState era)
-> CHAINExample h era
CHAINExample forall era.
(EraTxOut era, ProtVerAtMost era 4, ProtVerAtMost era 6,
 EraGov era, Default (StashedAVVMAddresses era)) =>
ChainState era
initStGenesisDeleg forall c.
ExMock (EraCrypto (ShelleyEra c)) =>
Block (BHeader c) (ShelleyEra c)
blockEx1 (forall a b. b -> Either a b
Right forall c. ExMock c => ChainState (ShelleyEra c)
expectedStEx1)

--
-- Block 2, Slot 50, Epoch 0
--

blockEx2 ::
  forall c.
  ExMock (EraCrypto (ShelleyEra c)) =>
  Block (BHeader c) (ShelleyEra c)
blockEx2 :: forall c.
ExMock (EraCrypto (ShelleyEra c)) =>
Block (BHeader c) (ShelleyEra c)
blockEx2 =
  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 @(ShelleyEra c)
    (forall c. Crypto c => BHeader c -> HashHeader c
bhHash forall a b. (a -> b) -> a -> b
$ forall h era. Block h era -> h
bheader forall c.
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
50)
    []
    (Word64 -> SlotNo
SlotNo Word64
50)
    (Word64 -> BlockNo
BlockNo Word64
2)
    (forall c. Crypto c => Nonce
nonce0 @c)
    (Natural -> NatNonce
NatNonce Natural
2)
    forall a. Bounded a => a
minBound
    Word
2
    Word
0
    (forall c (r :: KeyRole).
(Crypto c, Signable (DSIGN c) (OCertSignable c)) =>
AllIssuerKeys c r -> Word64 -> KESPeriod -> OCert c
mkOCert @c (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
50) Word64
0 (Word -> KESPeriod
KESPeriod Word
0))

pulserEx2 :: ExMock c => PulsingRewUpdate c
pulserEx2 :: forall c. ExMock c => PulsingRewUpdate c
pulserEx2 = forall era.
EraGov era =>
ChainState era -> PulsingRewUpdate (EraCrypto era)
makePulser' forall c. ExMock c => ChainState (ShelleyEra c)
expectedStEx1

expectedStEx2 ::
  forall c.
  ExMock c =>
  ChainState (ShelleyEra c)
expectedStEx2 :: forall c. ExMock c => ChainState (ShelleyEra c)
expectedStEx2 =
  forall era. Nonce -> ChainState era -> ChainState era
C.evolveNonceUnfrozen (forall era. Era era => Block (BHeader (EraCrypto era)) era -> Nonce
getBlockNonce @(ShelleyEra c) forall c.
ExMock (EraCrypto (ShelleyEra c)) =>
Block (BHeader c) (ShelleyEra c)
blockEx2)
    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)
blockEx2
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
(FutureGenDeleg (EraCrypto era), GenDelegPair (EraCrypto era))
-> ChainState era -> ChainState era
C.adoptFutureGenDeleg forall c. Crypto c => (FutureGenDeleg c, GenDelegPair c)
newGenDeleg
    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 b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. EraGov era => ChainState era -> ChainState era
C.solidifyProposals
    forall a b. (a -> b) -> a -> b
$ forall c. ExMock c => ChainState (ShelleyEra c)
expectedStEx1

-- === Block 2, Slot 50, Epoch 0
--
-- Submit an empty block to trigger adopting the genesis delegation.
genesisDelegation2 :: ExMock c => CHAINExample (BHeader c) (ShelleyEra c)
genesisDelegation2 :: forall c. ExMock c => CHAINExample (BHeader c) (ShelleyEra c)
genesisDelegation2 = forall h era.
ChainState era
-> Block h era
-> Either
     (NonEmpty (PredicateFailure (CHAIN era))) (ChainState era)
-> CHAINExample h era
CHAINExample forall c. ExMock c => ChainState (ShelleyEra c)
expectedStEx1 forall c.
ExMock (EraCrypto (ShelleyEra c)) =>
Block (BHeader c) (ShelleyEra c)
blockEx2 (forall a b. b -> Either a b
Right forall c. ExMock c => ChainState (ShelleyEra c)
expectedStEx2)

--
-- Genesis Delegation Test Group
--

genesisDelegExample :: TestTree
genesisDelegExample :: TestTree
genesisDelegExample =
  TestName -> [TestTree] -> TestTree
testGroup
    TestName
"genesis delegation"
    [ TestName -> Assertion -> TestTree
testCase TestName
"stage genesis key delegation" forall a b. (a -> b) -> a -> b
$ HasCallStack => CHAINExample (BHeader C_Crypto) C -> Assertion
testCHAINExample forall c. ExMock c => CHAINExample (BHeader c) (ShelleyEra c)
genesisDelegation1
    , TestName -> Assertion -> TestTree
testCase TestName
"adopt genesis key delegation" forall a b. (a -> b) -> a -> b
$ HasCallStack => CHAINExample (BHeader C_Crypto) C -> Assertion
testCHAINExample forall c. ExMock c => CHAINExample (BHeader c) (ShelleyEra c)
genesisDelegation2
    ]