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

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

import Cardano.Ledger.BaseTypes (
  BlocksMade (..),
  Globals (..),
  Network (..),
  Nonce,
  StrictMaybe (..),
  mkCertIxPartial,
  (⭒),
 )
import Cardano.Ledger.Block (Block, bheader)
import Cardano.Ledger.Coin (
  Coin (..),
  CompactForm (CompactCoin),
  DeltaCoin (..),
  addDeltaCoin,
  toDeltaCoin,
 )
import Cardano.Ledger.Compactible
import Cardano.Ledger.Credential (Credential, Ptr (..))
import Cardano.Ledger.Crypto
import qualified Cardano.Ledger.EpochBoundary as EB
import Cardano.Ledger.Keys (KeyRole (..), asWitness, coerceKeyRole)
import Cardano.Ledger.PoolDistr (
  IndividualPoolStake (..),
  PoolDistr (..),
 )
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 (
  NewEpochState (..),
  PulsingRewUpdate (..),
  RewardUpdate (..),
  completeRupd,
  decayFactor,
  emptyRewardUpdate,
  startStep,
 )
import Cardano.Ledger.Shelley.PoolRank (
  Likelihood (..),
  NonMyopic (..),
  applyDecay,
  leaderProbability,
  likelihood,
 )
import Cardano.Ledger.Shelley.Tx (ShelleyTx (..))
import Cardano.Ledger.Shelley.TxBody (
  RewardAccount (..),
  ShelleyTxBody (..),
 )
import Cardano.Ledger.Shelley.TxCert (ShelleyTxCert (..))
import Cardano.Ledger.Shelley.TxOut (ShelleyTxOut (..))
import Cardano.Ledger.Shelley.TxWits (
  addrWits,
 )
import Cardano.Ledger.Slot (
  BlockNo (..),
  EpochNo (..),
  SlotNo (..),
 )
import Cardano.Ledger.TxIn (TxIn (..), mkTxInPartial)
import Cardano.Ledger.UTxO (UTxO (..))
import Cardano.Ledger.Val ((<+>), (<->), (<×>))
import qualified Cardano.Ledger.Val as Val
import Cardano.Protocol.TPraos.BHeader (BHeader, bhHash, hashHeaderToNonce)
import Cardano.Protocol.TPraos.OCert (KESPeriod (..))
import Data.Default (def)
import Data.Group (invert)
import qualified Data.Map.Strict as Map
import Data.Ratio ((%))
import qualified Data.Sequence.Strict as StrictSeq
import qualified Data.Set as Set
import GHC.Exts (fromList)
import GHC.Stack (HasCallStack)
import Test.Cardano.Ledger.Core.KeyPair (mkWitnessesVKey)
import Test.Cardano.Ledger.Shelley.ConcreteCryptoTypes (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 (
  coreNodeIssuerKeys,
  coreNodeKeysBySchedule,
 )
import Test.Cardano.Ledger.Shelley.Examples.Init (
  initSt,
  lastByronHeaderHash,
  nonce0,
  ppEx,
 )
import Test.Cardano.Ledger.Shelley.Generator.Core (
  AllIssuerKeys (..),
  NatNonce (..),
  genesisCoins,
  mkBlockFakeVRF,
  mkOCert,
 )
import Test.Cardano.Ledger.Shelley.Generator.EraGen (genesisId)
import Test.Cardano.Ledger.Shelley.Generator.ShelleyEraGen ()
import Test.Cardano.Ledger.Shelley.Rules.Chain (ChainState (..))
import Test.Cardano.Ledger.Shelley.Utils (
  epochSize,
  getBlockNonce,
  maxLLSupply,
  runShelleyBase,
  testGlobals,
  unsafeBoundRational,
 )
import Test.Tasty (TestTree, testGroup)
import Test.Tasty.HUnit (testCase)

aliceInitCoin :: Coin
aliceInitCoin :: Coin
aliceInitCoin = Integer -> Coin
Coin Integer
10_000_000_000_000_000

bobInitCoin :: Coin
bobInitCoin :: Coin
bobInitCoin = Integer -> Coin
Coin Integer
1_000_000_000_000_000

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

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

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)
    , forall era.
(HasCallStack, Era era, Val (Value era)) =>
Addr (EraCrypto era) -> Value era -> ShelleyTxOut era
ShelleyTxOut forall c. Crypto c => Addr c
Cast.bobAddr (forall t s. Inject t s => t -> s
Val.inject Coin
bobInitCoin)
    ]

initStPoolLifetime :: forall c. Crypto c => ChainState (ShelleyEra c)
initStPoolLifetime :: forall c. Crypto c => ChainState (ShelleyEra c)
initStPoolLifetime = 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
--

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
<-> ((Integer
3 :: Integer) forall t i. (Val t, Integral i) => i -> t -> t
<×> Integer -> Coin
Coin Integer
7)
    forall t. Val t => t -> t -> t
<-> Integer -> Coin
Coin Integer
3

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

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

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

txbodyEx1 :: 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.
ShelleyEraTxCert era =>
StakeCredential (EraCrypto era) -> TxCert era
RegTxCert forall c. Crypto c => Credential 'Staking c
Cast.aliceSHK
          , forall era.
ShelleyEraTxCert era =>
StakeCredential (EraCrypto era) -> TxCert era
RegTxCert forall c. Crypto c => Credential 'Staking c
Cast.bobSHK
          , forall era.
ShelleyEraTxCert era =>
StakeCredential (EraCrypto era) -> TxCert era
RegTxCert forall c. Crypto c => Credential 'Staking c
Cast.carlSHK
          , forall era.
EraTxCert era =>
PoolParams (EraCrypto era) -> TxCert era
RegPoolTxCert forall c. Crypto c => PoolParams c
Cast.alicePoolParams
          ]
            forall a. [a] -> [a] -> [a]
++ [ forall era. MIRCert (EraCrypto era) -> ShelleyTxCert era
ShelleyTxCertMir
                  ( forall c. MIRPot -> MIRTarget c -> MIRCert c
MIRCert
                      MIRPot
ReservesMIR
                      ( forall c. Map (Credential 'Staking c) DeltaCoin -> MIRTarget c
StakeAddressesMIR forall a b. (a -> b) -> a -> b
$
                          forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
                            [ (forall c. Crypto c => Credential 'Staking c
Cast.carlSHK, Coin -> DeltaCoin
toDeltaCoin Coin
carlMIR)
                            , (forall c. Crypto c => Credential 'Staking c
Cast.dariaSHK, Coin -> DeltaCoin
toDeltaCoin Coin
dariaMIR)
                            ]
                      )
                  )
               ]
        )
    )
    (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. ExMock (EraCrypto (ShelleyEra c)) => ShelleyTx (ShelleyEra c)
txEx1 :: forall 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 c. Crypto c => ShelleyTxBody (ShelleyEra c)
txbodyEx1 @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 c. Crypto c => KeyPair 'Payment c
Cast.carlPay])
                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. 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 v (r :: KeyRole). AllIssuerKeys v r -> KeyPair r v
aikCold (forall c. Crypto c => Int -> AllIssuerKeys c 'GenesisDelegate
coreNodeIssuerKeys Int
0)
                          , forall v (r :: KeyRole). AllIssuerKeys v r -> KeyPair r v
aikCold (forall c. Crypto c => Int -> AllIssuerKeys c 'GenesisDelegate
coreNodeIssuerKeys Int
1)
                          , forall v (r :: KeyRole). AllIssuerKeys v r -> KeyPair r v
aikCold (forall c. Crypto c => Int -> AllIssuerKeys c 'GenesisDelegate
coreNodeIssuerKeys Int
2)
                          , forall v (r :: KeyRole). AllIssuerKeys v r -> KeyPair r v
aikCold (forall c. Crypto c => Int -> AllIssuerKeys c 'GenesisDelegate
coreNodeIssuerKeys Int
3)
                          , forall v (r :: KeyRole). AllIssuerKeys v r -> KeyPair r v
aikCold (forall c. Crypto c => Int -> AllIssuerKeys c 'GenesisDelegate
coreNodeIssuerKeys Int
4)
                          ]
                   )
            )
      }
    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.
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 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 (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 => Credential 'Staking c
Cast.aliceSHK, forall c. Crypto c => Credential 'Staking c
Cast.bobSHK, forall c. Crypto c => Credential 'Staking c
Cast.carlSHK] [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.
Credential 'Staking (EraCrypto era)
-> Ptr -> ChainState era -> ChainState era
C.newStakeCred forall c. Crypto c => Credential 'Staking c
Cast.aliceSHK (SlotNo -> TxIx -> CertIx -> Ptr
Ptr (Word64 -> SlotNo
SlotNo Word64
10) forall a. Bounded a => a
minBound (HasCallStack => Integer -> CertIx
mkCertIxPartial Integer
0))
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
Credential 'Staking (EraCrypto era)
-> Ptr -> ChainState era -> ChainState era
C.newStakeCred forall c. Crypto c => Credential 'Staking c
Cast.bobSHK (SlotNo -> TxIx -> CertIx -> Ptr
Ptr (Word64 -> SlotNo
SlotNo Word64
10) forall a. Bounded a => a
minBound (HasCallStack => Integer -> CertIx
mkCertIxPartial Integer
1))
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
Credential 'Staking (EraCrypto era)
-> Ptr -> ChainState era -> ChainState era
C.newStakeCred forall c. Crypto c => Credential 'Staking c
Cast.carlSHK (SlotNo -> TxIx -> CertIx -> Ptr
Ptr (Word64 -> SlotNo
SlotNo Word64
10) forall a. Bounded a => a
minBound (HasCallStack => Integer -> CertIx
mkCertIxPartial Integer
2))
    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 b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
Credential 'Staking (EraCrypto era)
-> MIRPot -> Coin -> ChainState era -> ChainState era
C.mir forall c. Crypto c => Credential 'Staking c
Cast.carlSHK MIRPot
ReservesMIR Coin
carlMIR
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
Credential 'Staking (EraCrypto era)
-> MIRPot -> Coin -> ChainState era -> ChainState era
C.mir forall c. Crypto c => Credential 'Staking c
Cast.dariaSHK MIRPot
ReservesMIR Coin
dariaMIR
    forall a b. (a -> b) -> a -> b
$ forall c. Crypto c => ChainState (ShelleyEra c)
initStPoolLifetime

-- === Block 1, Slot 10, Epoch 0
--
-- In the first block of this example, Alice, Bob, and Carl
-- all register stake credentials, and Alice registers a stake pool.
-- Additionally, a MIR certificate is issued to draw from the reserves
-- and give Carl and Daria (who is unregistered) rewards.
poolLifetime1 :: ExMock (EraCrypto (ShelleyEra c)) => CHAINExample (BHeader c) (ShelleyEra c)
poolLifetime1 :: forall c.
ExMock (EraCrypto (ShelleyEra c)) =>
CHAINExample (BHeader c) (ShelleyEra c)
poolLifetime1 = 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)
initStPoolLifetime forall c.
(HasCallStack, 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 90, Epoch 0
--

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

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

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

-- | The transaction delegates Alice's and Bob's stake to Alice's pool.
--   Additionally, we split Alice's ADA between a base address and a pointer address.
txbodyEx2 :: forall c. Crypto c => ShelleyTxBody (ShelleyEra c)
txbodyEx2 :: forall c. Crypto c => ShelleyTxBody (ShelleyEra c)
txbodyEx2 =
  ShelleyTxBody
    { stbInputs :: Set (TxIn (EraCrypto (ShelleyEra c)))
stbInputs = 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 @c)) forall a. Bounded a => a
minBound]
    , stbOutputs :: StrictSeq (TxOut (ShelleyEra c))
stbOutputs =
        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
aliceCoinEx2Base)
          , forall era.
(HasCallStack, Era era, Val (Value era)) =>
Addr (EraCrypto era) -> Value era -> ShelleyTxOut era
ShelleyTxOut forall c. Crypto c => Addr c
Cast.alicePtrAddr (forall t s. Inject t s => t -> s
Val.inject Coin
aliceCoinEx2Ptr)
          ]
    , stbCerts :: StrictSeq (TxCert (ShelleyEra c))
stbCerts =
        forall a. [a] -> StrictSeq a
StrictSeq.fromList
          [ forall era.
ShelleyEraTxCert era =>
StakeCredential (EraCrypto era)
-> KeyHash 'StakePool (EraCrypto era) -> TxCert era
DelegStakeTxCert forall c. Crypto c => Credential 'Staking c
Cast.aliceSHK (forall v (r :: KeyRole). AllIssuerKeys v r -> KeyHash r v
aikColdKeyHash forall c. Crypto c => AllIssuerKeys c 'StakePool
Cast.alicePoolKeys)
          , forall era.
ShelleyEraTxCert era =>
StakeCredential (EraCrypto era)
-> KeyHash 'StakePool (EraCrypto era) -> TxCert era
DelegStakeTxCert forall c. Crypto c => Credential 'Staking c
Cast.bobSHK (forall v (r :: KeyRole). AllIssuerKeys v r -> KeyHash r v
aikColdKeyHash forall c. Crypto c => AllIssuerKeys c 'StakePool
Cast.alicePoolKeys)
          ]
    , stbWithdrawals :: Withdrawals (EraCrypto (ShelleyEra c))
stbWithdrawals = forall c. Map (RewardAccount c) Coin -> Withdrawals c
Withdrawals forall k a. Map k a
Map.empty
    , stbTxFee :: Coin
stbTxFee = Coin
feeTx2
    , stbTTL :: SlotNo
stbTTL = Word64 -> SlotNo
SlotNo Word64
90
    , stbUpdate :: StrictMaybe (Update (ShelleyEra c))
stbUpdate = forall a. StrictMaybe a
SNothing
    , stbMDHash :: StrictMaybe (AuxiliaryDataHash (EraCrypto (ShelleyEra c)))
stbMDHash = forall a. StrictMaybe a
SNothing
    }

txEx2 :: forall c. ExMock (EraCrypto (ShelleyEra c)) => ShelleyTx (ShelleyEra c)
txEx2 :: forall 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 c. Crypto c => ShelleyTxBody (ShelleyEra c)
txbodyEx2 @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 :: KeyRole -> * -> *) (r :: KeyRole) c.
HasKeyRole a =>
a r c -> a 'Witness c
asWitness forall c. Crypto c => KeyPair 'Staking c
Cast.aliceStake
            , forall (a :: KeyRole -> * -> *) (r :: KeyRole) c.
HasKeyRole a =>
a r c -> a 'Witness c
asWitness forall c. Crypto c => KeyPair 'Staking c
Cast.bobStake
            ]
      }
    forall a. StrictMaybe a
SNothing

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
    (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
90)
    [forall c.
ExMock (EraCrypto (ShelleyEra c)) =>
ShelleyTx (ShelleyEra c)
txEx2]
    (Word64 -> SlotNo
SlotNo Word64
90)
    (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
    Word
4
    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
90) Word64
0 (Word -> KESPeriod
KESPeriod Word
0))

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

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

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

pulserEx2 :: forall c. ExMock (EraCrypto (ShelleyEra c)) => PulsingRewUpdate c
pulserEx2 :: forall c. ExMock (EraCrypto (ShelleyEra 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 c => ChainState (ShelleyEra c)
expectedStEx1

expectedStEx2 ::
  forall c.
  ExMock (EraCrypto (ShelleyEra c)) =>
  ChainState (ShelleyEra c)
expectedStEx2 :: forall c.
ExMock (EraCrypto (ShelleyEra c)) =>
ChainState (ShelleyEra c)
expectedStEx2 =
  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)
blockEx2 @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)
blockEx2
    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
feeTx2 [] []
    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.
Credential 'Staking (EraCrypto era)
-> KeyHash 'StakePool (EraCrypto era)
-> ChainState era
-> ChainState era
C.delegation forall c. Crypto c => Credential 'Staking c
Cast.aliceSHK (forall c. PoolParams c -> KeyHash 'StakePool c
ppId forall a b. (a -> b) -> a -> b
$ forall c. Crypto c => PoolParams c
Cast.alicePoolParams @c)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
Credential 'Staking (EraCrypto era)
-> KeyHash 'StakePool (EraCrypto era)
-> ChainState era
-> ChainState era
C.delegation forall c. Crypto c => Credential 'Staking c
Cast.bobSHK (forall c. PoolParams c -> KeyHash 'StakePool c
ppId forall a b. (a -> b) -> a -> b
$ forall c. Crypto c => PoolParams c
Cast.alicePoolParams @c)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
PulsingRewUpdate (EraCrypto era)
-> ChainState era -> ChainState era
C.pulserUpdate forall c. ExMock (EraCrypto (ShelleyEra c)) => PulsingRewUpdate c
pulserEx2
    forall a b. (a -> b) -> a -> b
$ forall c. ExMock c => ChainState (ShelleyEra c)
expectedStEx1

-- === Block 2, Slot 90, Epoch 0
--
-- In the second block Alice and Bob both delegation to Alice's Pool.
poolLifetime2 :: ExMock (EraCrypto (ShelleyEra c)) => CHAINExample (BHeader c) (ShelleyEra c)
poolLifetime2 :: forall c.
ExMock (EraCrypto (ShelleyEra c)) =>
CHAINExample (BHeader c) (ShelleyEra c)
poolLifetime2 = 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 era. EraGov era => ChainState era -> ChainState era
C.solidifyProposals forall c.
ExMock (EraCrypto (ShelleyEra c)) =>
ChainState (ShelleyEra c)
expectedStEx2))

--
-- 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)
expectedStEx2 @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)
blockEx2)
    (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 => EB.SnapShot c
snapEx3 :: forall c. Crypto c => SnapShot c
snapEx3 =
  EB.SnapShot
    { $sel:ssStake:SnapShot :: Stake c
EB.ssStake =
        forall c. [(Credential 'Staking c, Coin)] -> Stake c
mkStake
          [ (forall c. Crypto c => Credential 'Staking c
Cast.aliceSHK, Coin
aliceCoinEx2Base forall a. Semigroup a => a -> a -> a
<> Coin
aliceCoinEx2Ptr)
          , (forall c. Crypto c => Credential 'Staking c
Cast.bobSHK, Coin
bobInitCoin)
          ]
    , $sel:ssDelegations:SnapShot :: VMap VB VB (Credential 'Staking c) (KeyHash 'StakePool c)
EB.ssDelegations =
        [ (forall c. Crypto c => Credential 'Staking c
Cast.aliceSHK, forall v (r :: KeyRole). AllIssuerKeys v r -> KeyHash r v
aikColdKeyHash forall c. Crypto c => AllIssuerKeys c 'StakePool
Cast.alicePoolKeys)
        , (forall c. Crypto c => Credential 'Staking c
Cast.bobSHK, forall v (r :: KeyRole). AllIssuerKeys v r -> KeyHash r v
aikColdKeyHash forall c. Crypto c => AllIssuerKeys c 'StakePool
Cast.alicePoolKeys)
        ]
    , $sel:ssPoolParams:SnapShot :: VMap VB VB (KeyHash 'StakePool c) (PoolParams c)
EB.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 a. Semigroup a => a -> a -> a
<> Coin
feeTx2)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
MIRPot
-> Map (Credential 'Staking (EraCrypto era)) Coin
-> ChainState era
-> ChainState era
C.applyMIR MIRPot
ReservesMIR (forall k a. k -> a -> Map k a
Map.singleton forall c. Crypto c => Credential 'Staking c
Cast.carlSHK Coin
carlMIR)
    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 a b. (a -> b) -> a -> b
$ forall c.
ExMock (EraCrypto (ShelleyEra c)) =>
ChainState (ShelleyEra c)
expectedStEx2

-- === Block 3, Slot 110, Epoch 1
--
-- In the third block, an empty block in a new epoch, the first snapshot is created.
-- The rewards accounts from the MIR certificate in block 1 are now increased.
poolLifetime3 :: ExMock (EraCrypto (ShelleyEra c)) => CHAINExample (BHeader c) (ShelleyEra c)
poolLifetime3 :: forall c.
ExMock (EraCrypto (ShelleyEra c)) =>
CHAINExample (BHeader c) (ShelleyEra c)
poolLifetime3 = 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)
expectedStEx2 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)

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

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

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

txbodyEx4 :: forall c. Crypto c => ShelleyTxBody (ShelleyEra c)
txbodyEx4 :: forall c. Crypto c => ShelleyTxBody (ShelleyEra c)
txbodyEx4 =
  ShelleyTxBody
    { stbInputs :: Set (TxIn (EraCrypto (ShelleyEra c)))
stbInputs = 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)
txbodyEx2) forall a. Bounded a => a
minBound]
    , stbOutputs :: StrictSeq (TxOut (ShelleyEra c))
stbOutputs = 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
aliceCoinEx4Base)]
    , stbCerts :: StrictSeq (TxCert (ShelleyEra c))
stbCerts =
        forall a. [a] -> StrictSeq a
StrictSeq.fromList
          [forall era.
ShelleyEraTxCert era =>
StakeCredential (EraCrypto era)
-> KeyHash 'StakePool (EraCrypto era) -> TxCert era
DelegStakeTxCert forall c. Crypto c => Credential 'Staking c
Cast.carlSHK (forall v (r :: KeyRole). AllIssuerKeys v r -> KeyHash r v
aikColdKeyHash forall c. Crypto c => AllIssuerKeys c 'StakePool
Cast.alicePoolKeys)]
    , stbWithdrawals :: Withdrawals (EraCrypto (ShelleyEra c))
stbWithdrawals = forall c. Map (RewardAccount c) Coin -> Withdrawals c
Withdrawals forall k a. Map k a
Map.empty
    , stbTxFee :: Coin
stbTxFee = Coin
feeTx4
    , stbTTL :: SlotNo
stbTTL = Word64 -> SlotNo
SlotNo Word64
500
    , stbUpdate :: StrictMaybe (Update (ShelleyEra c))
stbUpdate = forall a. StrictMaybe a
SNothing
    , stbMDHash :: StrictMaybe (AuxiliaryDataHash (EraCrypto (ShelleyEra c)))
stbMDHash = forall a. StrictMaybe a
SNothing
    }

txEx4 :: forall c. ExMock (EraCrypto (ShelleyEra c)) => ShelleyTx (ShelleyEra c)
txEx4 :: forall c.
ExMock (EraCrypto (ShelleyEra c)) =>
ShelleyTx (ShelleyEra c)
txEx4 =
  forall era.
EraTx era =>
TxBody era
-> TxWits era -> StrictMaybe (TxAuxData era) -> ShelleyTx era
ShelleyTx
    forall c. Crypto c => ShelleyTxBody (ShelleyEra c)
txbodyEx4
    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 c. Crypto c => ShelleyTxBody (ShelleyEra c)
txbodyEx4 @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 :: KeyRole -> * -> *) (r :: KeyRole) c.
HasKeyRole a =>
a r c -> a 'Witness c
asWitness forall c. Crypto c => KeyPair 'Staking c
Cast.carlStake]
      }
    forall a. StrictMaybe a
SNothing

blockEx4 :: forall c. ExMock (EraCrypto (ShelleyEra c)) => Block (BHeader c) (ShelleyEra c)
blockEx4 :: forall c.
ExMock (EraCrypto (ShelleyEra c)) =>
Block (BHeader c) (ShelleyEra c)
blockEx4 =
  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)
blockEx3)
    (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
190)
    [forall c.
ExMock (EraCrypto (ShelleyEra c)) =>
ShelleyTx (ShelleyEra c)
txEx4]
    (Word64 -> SlotNo
SlotNo Word64
190)
    (Word64 -> BlockNo
BlockNo Word64
4)
    (forall c. ExMock (EraCrypto (ShelleyEra c)) => Nonce
epoch1Nonce @c)
    (Natural -> NatNonce
NatNonce Natural
4)
    forall a. Bounded a => a
minBound
    Word
9
    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
190) Word64
0 (Word -> KESPeriod
KESPeriod Word
0))

pulserEx4 :: forall c. ExMock c => PulsingRewUpdate c
pulserEx4 :: forall c. ExMock c => PulsingRewUpdate c
pulserEx4 = 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)
expectedStEx3

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

expectedStEx4 ::
  forall c.
  ExMock (EraCrypto (ShelleyEra c)) =>
  ChainState (ShelleyEra c)
expectedStEx4 :: forall c.
ExMock (EraCrypto (ShelleyEra c)) =>
ChainState (ShelleyEra c)
expectedStEx4 =
  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)
blockEx4 @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)
blockEx4
    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
feeTx4 [] []
    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)
txbodyEx4
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
Credential 'Staking (EraCrypto era)
-> KeyHash 'StakePool (EraCrypto era)
-> ChainState era
-> ChainState era
C.delegation forall c. Crypto c => Credential 'Staking c
Cast.carlSHK (forall c. PoolParams c -> KeyHash 'StakePool c
ppId forall a b. (a -> b) -> a -> b
$ forall c. Crypto c => PoolParams c
Cast.alicePoolParams @c)
    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
pulserEx4
    forall a b. (a -> b) -> a -> b
$ forall c.
ExMock (EraCrypto (ShelleyEra c)) =>
ChainState (ShelleyEra c)
expectedStEx3

-- === Block 4, Slot 190, Epoch 1
--
-- We process a block late enough in the epoch in order to create a second reward update,
-- preparing the way for the first non-empty pool distribution in this running example.
-- Additionally, in order to have the stake distribution change, Carl delegates his stake.
poolLifetime4 :: ExMock (EraCrypto (ShelleyEra c)) => CHAINExample (BHeader c) (ShelleyEra c)
poolLifetime4 :: forall c.
ExMock (EraCrypto (ShelleyEra c)) =>
CHAINExample (BHeader c) (ShelleyEra c)
poolLifetime4 = 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)
expectedStEx3 forall c.
ExMock (EraCrypto (ShelleyEra c)) =>
Block (BHeader c) (ShelleyEra c)
blockEx4 (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)
expectedStEx4))

epoch2Nonce :: forall c. ExMock (EraCrypto (ShelleyEra c)) => Nonce
epoch2Nonce :: forall c. ExMock (EraCrypto (ShelleyEra c)) => Nonce
epoch2Nonce =
  forall era. ChainState era -> Nonce
chainCandidateNonce (forall c.
ExMock (EraCrypto (ShelleyEra c)) =>
ChainState (ShelleyEra c)
expectedStEx4 @c)
    Nonce -> Nonce -> Nonce
⭒ forall c. HashHeader c -> Nonce
hashHeaderToNonce (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)
blockEx2 @c))

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

blockEx5 :: forall c. ExMock (EraCrypto (ShelleyEra c)) => Block (BHeader c) (ShelleyEra c)
blockEx5 :: forall c.
ExMock (EraCrypto (ShelleyEra c)) =>
Block (BHeader c) (ShelleyEra c)
blockEx5 =
  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)
blockEx4)
    (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
220)
    []
    (Word64 -> SlotNo
SlotNo Word64
220)
    (Word64 -> BlockNo
BlockNo Word64
5)
    (forall c. ExMock (EraCrypto (ShelleyEra c)) => Nonce
epoch2Nonce @c)
    (Natural -> NatNonce
NatNonce Natural
5)
    forall a. Bounded a => a
minBound
    Word
11
    Word
10
    (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
220) Word64
1 (Word -> KESPeriod
KESPeriod Word
10))

snapEx5 :: forall c. Crypto c => EB.SnapShot c
snapEx5 :: forall c. Crypto c => SnapShot c
snapEx5 =
  EB.SnapShot
    { $sel:ssStake:SnapShot :: Stake c
EB.ssStake =
        forall c. [(Credential 'Staking c, Coin)] -> Stake c
mkStake
          [ (forall c. Crypto c => Credential 'Staking c
Cast.aliceSHK, Coin
aliceCoinEx4Base forall a. Semigroup a => a -> a -> a
<> Coin
aliceCoinEx2Ptr)
          , (forall c. Crypto c => Credential 'Staking c
Cast.carlSHK, Coin
carlMIR)
          , (forall c. Crypto c => Credential 'Staking c
Cast.bobSHK, Coin
bobInitCoin)
          ]
    , $sel:ssDelegations:SnapShot :: VMap VB VB (Credential 'Staking c) (KeyHash 'StakePool c)
EB.ssDelegations =
        [ (forall c. Crypto c => Credential 'Staking c
Cast.aliceSHK, forall v (r :: KeyRole). AllIssuerKeys v r -> KeyHash r v
aikColdKeyHash forall c. Crypto c => AllIssuerKeys c 'StakePool
Cast.alicePoolKeys)
        , (forall c. Crypto c => Credential 'Staking c
Cast.carlSHK, forall v (r :: KeyRole). AllIssuerKeys v r -> KeyHash r v
aikColdKeyHash forall c. Crypto c => AllIssuerKeys c 'StakePool
Cast.alicePoolKeys)
        , (forall c. Crypto c => Credential 'Staking c
Cast.bobSHK, forall v (r :: KeyRole). AllIssuerKeys v r -> KeyHash r v
aikColdKeyHash forall c. Crypto c => AllIssuerKeys c 'StakePool
Cast.alicePoolKeys)
        ]
    , $sel:ssPoolParams:SnapShot :: VMap VB VB (KeyHash 'StakePool c) (PoolParams c)
EB.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)]
    }

pdEx5 :: forall c. Crypto c => PoolDistr c
pdEx5 :: forall c. Crypto c => PoolDistr c
pdEx5 =
  forall c.
Map (KeyHash 'StakePool c) (IndividualPoolStake c)
-> CompactForm Coin -> PoolDistr c
PoolDistr
    ( forall k a. k -> a -> Map k a
Map.singleton
        (forall v (r :: KeyRole). AllIssuerKeys v r -> KeyHash r v
aikColdKeyHash forall a b. (a -> b) -> a -> b
$ forall c. Crypto c => AllIssuerKeys c 'StakePool
Cast.alicePoolKeys @c)
        ( forall c.
Rational
-> CompactForm Coin
-> VRFVerKeyHash 'StakePoolVRF c
-> IndividualPoolStake c
IndividualPoolStake
            Rational
1
            (Word64 -> CompactForm Coin
CompactCoin Word64
1)
            (forall c. Crypto c => VRFVerKeyHash 'StakePoolVRF c
Cast.aliceVRFKeyHash @c)
        )
    )
    (Word64 -> CompactForm Coin
CompactCoin Word64
1)

expectedStEx5 ::
  forall c.
  ExMock (EraCrypto (ShelleyEra c)) =>
  ChainState (ShelleyEra c)
expectedStEx5 :: forall c.
ExMock (EraCrypto (ShelleyEra c)) =>
ChainState (ShelleyEra c)
expectedStEx5 =
  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)
blockEx5
    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
snapEx5 Coin
feeTx4
    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
rewardUpdateEx4
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
PoolDistr (EraCrypto era) -> ChainState era -> ChainState era
C.setPoolDistr forall c. Crypto c => PoolDistr c
pdEx5
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
KeyHash 'BlockIssuer (EraCrypto era)
-> Word64 -> ChainState era -> ChainState era
C.setOCertCounter KeyHash 'BlockIssuer c
coreNodeHK Word64
1
    forall a b. (a -> b) -> a -> b
$ forall c.
ExMock (EraCrypto (ShelleyEra c)) =>
ChainState (ShelleyEra c)
expectedStEx4
  where
    coreNodeHK :: KeyHash 'BlockIssuer c
coreNodeHK = forall (a :: KeyRole -> * -> *) (r :: KeyRole) c (r' :: KeyRole).
HasKeyRole a =>
a r c -> a r' c
coerceKeyRole forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall v (r :: KeyRole). AllIssuerKeys v r -> KeyHash r v
aikColdKeyHash forall a b. (a -> b) -> a -> b
$ 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
220

-- === Block 5, Slot 220, Epoch 2
--
-- Create the first non-empty pool distribution
-- by creating a block in the third epoch of this running example.
poolLifetime5 :: ExMock (EraCrypto (ShelleyEra c)) => CHAINExample (BHeader c) (ShelleyEra c)
poolLifetime5 :: forall c.
ExMock (EraCrypto (ShelleyEra c)) =>
CHAINExample (BHeader c) (ShelleyEra c)
poolLifetime5 = 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)
expectedStEx4 forall c.
ExMock (EraCrypto (ShelleyEra c)) =>
Block (BHeader c) (ShelleyEra c)
blockEx5 (forall a b. b -> Either a b
Right forall c.
ExMock (EraCrypto (ShelleyEra c)) =>
ChainState (ShelleyEra c)
expectedStEx5)

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

blockEx6 :: forall c. ExMock (EraCrypto (ShelleyEra c)) => Block (BHeader c) (ShelleyEra c)
blockEx6 :: forall c.
ExMock (EraCrypto (ShelleyEra c)) =>
Block (BHeader c) (ShelleyEra c)
blockEx6 =
  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)
blockEx5)
    forall c. Crypto c => AllIssuerKeys c 'StakePool
Cast.alicePoolKeys
    []
    (Word64 -> SlotNo
SlotNo Word64
295) -- odd slots open for decentralization
    (Word64 -> BlockNo
BlockNo Word64
6)
    (forall c. ExMock (EraCrypto (ShelleyEra c)) => Nonce
epoch2Nonce @c)
    (Natural -> NatNonce
NatNonce Natural
6)
    forall a. Bounded a => a
minBound
    Word
14
    Word
14
    (forall c (r :: KeyRole).
(Crypto c, Signable (DSIGN c) (OCertSignable c)) =>
AllIssuerKeys c r -> Word64 -> KESPeriod -> OCert c
mkOCert forall c. Crypto c => AllIssuerKeys c 'StakePool
Cast.alicePoolKeys Word64
0 (Word -> KESPeriod
KESPeriod Word
14))

rewardUpdateEx6 :: forall c. RewardUpdate c
rewardUpdateEx6 :: forall c. RewardUpdate c
rewardUpdateEx6 =
  RewardUpdate
    { deltaT :: DeltaCoin
deltaT = Integer -> DeltaCoin
DeltaCoin Integer
1
    , deltaR :: DeltaCoin
deltaR = Integer -> DeltaCoin
DeltaCoin Integer
4
    , rs :: Map (Credential 'Staking c) (Set (Reward c))
rs = forall k a. Map k a
Map.empty
    , deltaF :: DeltaCoin
deltaF = forall m. Group m => m -> m
invert forall a b. (a -> b) -> a -> b
$ Coin -> DeltaCoin
toDeltaCoin Coin
feeTx4
    , nonMyopic :: NonMyopic c
nonMyopic = forall a. Default a => a
def {rewardPotNM :: Coin
rewardPotNM = Integer -> Coin
Coin Integer
4}
    }

pulserEx6 :: forall c. ExMock c => PulsingRewUpdate c
pulserEx6 :: forall c. ExMock c => PulsingRewUpdate c
pulserEx6 = 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)
expectedStEx5

expectedStEx6 :: forall c. ExMock (EraCrypto (ShelleyEra c)) => ChainState (ShelleyEra c)
expectedStEx6 :: forall c.
ExMock (EraCrypto (ShelleyEra c)) =>
ChainState (ShelleyEra c)
expectedStEx6 =
  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)
blockEx6 @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)
blockEx6
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
KeyHash 'BlockIssuer (EraCrypto era)
-> Word64 -> ChainState era -> ChainState era
C.setOCertCounter (forall (a :: KeyRole -> * -> *) (r :: KeyRole) c (r' :: KeyRole).
HasKeyRole a =>
a r c -> a r' c
coerceKeyRole forall a b. (a -> b) -> a -> b
$ forall v (r :: KeyRole). AllIssuerKeys v r -> KeyHash r v
aikColdKeyHash forall c. Crypto c => AllIssuerKeys c 'StakePool
Cast.alicePoolKeys) Word64
0
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
KeyHash 'StakePool (EraCrypto era)
-> ChainState era -> ChainState era
C.incrBlockCount (forall v (r :: KeyRole). AllIssuerKeys v r -> KeyHash r v
aikColdKeyHash forall c. Crypto c => AllIssuerKeys c 'StakePool
Cast.alicePoolKeys)
    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
pulserEx6
    forall a b. (a -> b) -> a -> b
$ forall c.
ExMock (EraCrypto (ShelleyEra c)) =>
ChainState (ShelleyEra c)
expectedStEx5

-- === Block 6, Slot 295, Epoch 2
--
-- Create a decentralized Praos block (ie one not in the overlay schedule)
poolLifetime6 :: ExMock (EraCrypto (ShelleyEra c)) => CHAINExample (BHeader c) (ShelleyEra c)
poolLifetime6 :: forall c.
ExMock (EraCrypto (ShelleyEra c)) =>
CHAINExample (BHeader c) (ShelleyEra c)
poolLifetime6 = 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)
expectedStEx5 forall c.
ExMock (EraCrypto (ShelleyEra c)) =>
Block (BHeader c) (ShelleyEra c)
blockEx6 (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)
expectedStEx6))

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

epoch3Nonce :: forall c. ExMock (EraCrypto (ShelleyEra c)) => Nonce
epoch3Nonce :: forall c. ExMock (EraCrypto (ShelleyEra c)) => Nonce
epoch3Nonce =
  forall era. ChainState era -> Nonce
chainCandidateNonce (forall c.
ExMock (EraCrypto (ShelleyEra c)) =>
ChainState (ShelleyEra c)
expectedStEx6 @c)
    Nonce -> Nonce -> Nonce
⭒ forall c. HashHeader c -> Nonce
hashHeaderToNonce (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)
blockEx4 @c))

blockEx7 :: forall c. ExMock (EraCrypto (ShelleyEra c)) => Block (BHeader c) (ShelleyEra c)
blockEx7 :: forall c.
ExMock (EraCrypto (ShelleyEra c)) =>
Block (BHeader c) (ShelleyEra c)
blockEx7 =
  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)
blockEx6)
    (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
310)
    []
    (Word64 -> SlotNo
SlotNo Word64
310)
    (Word64 -> BlockNo
BlockNo Word64
7)
    (forall c. ExMock (EraCrypto (ShelleyEra c)) => Nonce
epoch3Nonce @c)
    (Natural -> NatNonce
NatNonce Natural
7)
    forall a. Bounded a => a
minBound
    Word
15
    Word
15
    (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
310) Word64
1 (Word -> KESPeriod
KESPeriod Word
15))

expectedStEx7 :: forall c. ExMock (EraCrypto (ShelleyEra c)) => ChainState (ShelleyEra c)
expectedStEx7 :: forall c.
ExMock (EraCrypto (ShelleyEra c)) =>
ChainState (ShelleyEra c)
expectedStEx7 =
  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)
blockEx7
    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
snapEx5 (Integer -> Coin
Coin Integer
0)
    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
rewardUpdateEx6
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
KeyHash 'BlockIssuer (EraCrypto era)
-> Word64 -> ChainState era -> ChainState era
C.setOCertCounter KeyHash 'BlockIssuer c
coreNodeHK Word64
1
    forall a b. (a -> b) -> a -> b
$ forall c.
ExMock (EraCrypto (ShelleyEra c)) =>
ChainState (ShelleyEra c)
expectedStEx6
  where
    coreNodeHK :: KeyHash 'BlockIssuer c
coreNodeHK = forall (a :: KeyRole -> * -> *) (r :: KeyRole) c (r' :: KeyRole).
HasKeyRole a =>
a r c -> a r' c
coerceKeyRole forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall v (r :: KeyRole). AllIssuerKeys v r -> KeyHash r v
aikColdKeyHash forall a b. (a -> b) -> a -> b
$ 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
310

-- === Block 7, Slot 310, Epoch 3
--
-- Create an empty block in the next epoch
-- to prepare the way for the first non-trivial reward update
poolLifetime7 :: ExMock (EraCrypto (ShelleyEra c)) => CHAINExample (BHeader c) (ShelleyEra c)
poolLifetime7 :: forall c.
ExMock (EraCrypto (ShelleyEra c)) =>
CHAINExample (BHeader c) (ShelleyEra c)
poolLifetime7 = 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)
expectedStEx6 forall c.
ExMock (EraCrypto (ShelleyEra c)) =>
Block (BHeader c) (ShelleyEra c)
blockEx7 (forall a b. b -> Either a b
Right forall c.
ExMock (EraCrypto (ShelleyEra c)) =>
ChainState (ShelleyEra c)
expectedStEx7)

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

blockEx8 :: forall c. ExMock (EraCrypto (ShelleyEra c)) => Block (BHeader c) (ShelleyEra c)
blockEx8 :: forall c.
ExMock (EraCrypto (ShelleyEra c)) =>
Block (BHeader c) (ShelleyEra c)
blockEx8 =
  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)
blockEx7)
    (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
390)
    []
    (Word64 -> SlotNo
SlotNo Word64
390)
    (Word64 -> BlockNo
BlockNo Word64
8)
    (forall c. ExMock (EraCrypto (ShelleyEra c)) => Nonce
epoch3Nonce @c)
    (Natural -> NatNonce
NatNonce Natural
8)
    forall a. Bounded a => a
minBound
    Word
19
    Word
19
    (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
390) Word64
2 (Word -> KESPeriod
KESPeriod Word
19))

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

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

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

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

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

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

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

alicePerfEx8 :: Likelihood
alicePerfEx8 :: Likelihood
alicePerfEx8 = Natural -> Double -> EpochSize -> Likelihood
likelihood Natural
blocks Double
t (EpochNo -> EpochSize
epochSize forall a b. (a -> b) -> a -> b
$ Word64 -> EpochNo
EpochNo Word64
3)
  where
    blocks :: Natural
blocks = Natural
1
    t :: Double
t = ActiveSlotCoeff -> Rational -> UnitInterval -> Double
leaderProbability ActiveSlotCoeff
f Rational
relativeStake (forall r.
(HasCallStack, Typeable r, BoundedRational r) =>
Rational -> r
unsafeBoundRational Rational
0.5)
    (Coin Integer
stake) = Coin
aliceCoinEx2Base forall a. Semigroup a => a -> a -> a
<> Coin
aliceCoinEx2Ptr forall a. Semigroup a => a -> a -> a
<> Coin
bobInitCoin
    (Coin Integer
tot) = Coin
maxLLSupply forall t. Val t => t -> t -> t
<-> Coin
reserves7
    relativeStake :: Rational
relativeStake = forall a. Fractional a => Rational -> a
fromRational (Integer
stake forall a. Integral a => a -> a -> Ratio a
% Integer
tot)
    f :: ActiveSlotCoeff
f = Globals -> ActiveSlotCoeff
activeSlotCoeff Globals
testGlobals

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

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

rewardUpdateEx8 :: forall c. Crypto c => RewardUpdate c
rewardUpdateEx8 :: forall c. Crypto c => RewardUpdate c
rewardUpdateEx8 =
  RewardUpdate
    { deltaT :: DeltaCoin
deltaT = DeltaCoin
deltaT8
    , deltaR :: DeltaCoin
deltaR = DeltaCoin
deltaR8
    , rs :: Map (Credential 'Staking c) (Set (Reward c))
rs =
        forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
          [
            ( forall c. Crypto c => Credential 'Staking c
Cast.aliceSHK
            , forall a. a -> Set a
Set.singleton forall a b. (a -> b) -> a -> b
$ forall c. RewardType -> KeyHash 'StakePool c -> Coin -> Reward c
Reward RewardType
LeaderReward (forall v (r :: KeyRole). AllIssuerKeys v r -> KeyHash r v
aikColdKeyHash forall c. Crypto c => AllIssuerKeys c 'StakePool
Cast.alicePoolKeys) Coin
aliceRAcnt8
            )
          ,
            ( forall c. Crypto c => Credential 'Staking c
Cast.bobSHK
            , forall a. a -> Set a
Set.singleton forall a b. (a -> b) -> a -> b
$ forall c. RewardType -> KeyHash 'StakePool c -> Coin -> Reward c
Reward RewardType
MemberReward (forall v (r :: KeyRole). AllIssuerKeys v r -> KeyHash r v
aikColdKeyHash forall c. Crypto c => AllIssuerKeys c 'StakePool
Cast.alicePoolKeys) Coin
bobRAcnt8
            )
          ]
    , deltaF :: DeltaCoin
deltaF = Integer -> DeltaCoin
DeltaCoin Integer
0
    , nonMyopic :: NonMyopic c
nonMyopic = forall c. Crypto c => NonMyopic c
nonMyopicEx8
    }

expectedStEx8 :: forall c. ExMock (EraCrypto (ShelleyEra c)) => ChainState (ShelleyEra c)
expectedStEx8 :: forall c.
ExMock (EraCrypto (ShelleyEra c)) =>
ChainState (ShelleyEra c)
expectedStEx8 =
  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)
blockEx8 @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)
blockEx8
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
KeyHash 'BlockIssuer (EraCrypto era)
-> Word64 -> ChainState era -> ChainState era
C.setOCertCounter KeyHash 'BlockIssuer c
coreNodeHK Word64
2
    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
pulserEx8
    forall a b. (a -> b) -> a -> b
$ forall c.
ExMock (EraCrypto (ShelleyEra c)) =>
ChainState (ShelleyEra c)
expectedStEx7
  where
    coreNodeHK :: KeyHash 'BlockIssuer c
coreNodeHK = forall (a :: KeyRole -> * -> *) (r :: KeyRole) c (r' :: KeyRole).
HasKeyRole a =>
a r c -> a r' c
coerceKeyRole forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall v (r :: KeyRole). AllIssuerKeys v r -> KeyHash r v
aikColdKeyHash forall a b. (a -> b) -> a -> b
$ 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
390

-- === Block 8, Slot 390, Epoch 3
--
-- Create the first non-trivial reward update.
poolLifetime8 :: ExMock (EraCrypto (ShelleyEra c)) => CHAINExample (BHeader c) (ShelleyEra c)
poolLifetime8 :: forall c.
ExMock (EraCrypto (ShelleyEra c)) =>
CHAINExample (BHeader c) (ShelleyEra c)
poolLifetime8 = 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)
expectedStEx7 forall c.
ExMock (EraCrypto (ShelleyEra c)) =>
Block (BHeader c) (ShelleyEra c)
blockEx8 (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)
expectedStEx8))

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

epoch4Nonce :: forall c. ExMock (EraCrypto (ShelleyEra c)) => Nonce
epoch4Nonce :: forall c. ExMock (EraCrypto (ShelleyEra c)) => Nonce
epoch4Nonce =
  forall era. ChainState era -> Nonce
chainCandidateNonce (forall c.
ExMock (EraCrypto (ShelleyEra c)) =>
ChainState (ShelleyEra c)
expectedStEx8 @c)
    Nonce -> Nonce -> Nonce
⭒ forall c. HashHeader c -> Nonce
hashHeaderToNonce (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)
blockEx6 @c))

blockEx9 :: forall c. ExMock (EraCrypto (ShelleyEra c)) => Block (BHeader c) (ShelleyEra c)
blockEx9 :: forall c.
ExMock (EraCrypto (ShelleyEra c)) =>
Block (BHeader c) (ShelleyEra c)
blockEx9 =
  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)
blockEx8)
    (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
410)
    []
    (Word64 -> SlotNo
SlotNo Word64
410)
    (Word64 -> BlockNo
BlockNo Word64
9)
    (forall c. ExMock (EraCrypto (ShelleyEra c)) => Nonce
epoch4Nonce @c)
    (Natural -> NatNonce
NatNonce Natural
9)
    forall a. Bounded a => a
minBound
    Word
20
    Word
20
    (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
410) Word64
2 (Word -> KESPeriod
KESPeriod Word
20))

snapEx9 :: forall c. Crypto c => EB.SnapShot c
snapEx9 :: forall c. Crypto c => SnapShot c
snapEx9 =
  forall c. Crypto c => SnapShot c
snapEx5
    { $sel:ssStake:SnapShot :: Stake c
EB.ssStake =
        forall c. [(Credential 'Staking c, Coin)] -> Stake c
mkStake
          [ (forall c. Crypto c => Credential 'Staking c
Cast.bobSHK, Coin
bobInitCoin forall a. Semigroup a => a -> a -> a
<> Coin
bobRAcnt8)
          , (forall c. Crypto c => Credential 'Staking c
Cast.aliceSHK, Coin
aliceCoinEx4Base forall a. Semigroup a => a -> a -> a
<> Coin
aliceCoinEx2Ptr forall a. Semigroup a => a -> a -> a
<> Coin
aliceRAcnt8)
          , (forall c. Crypto c => Credential 'Staking c
Cast.carlSHK, Coin
carlMIR)
          ]
    }

expectedStEx9 :: forall c. ExMock (EraCrypto (ShelleyEra c)) => ChainState (ShelleyEra c)
expectedStEx9 :: forall c.
ExMock (EraCrypto (ShelleyEra c)) =>
ChainState (ShelleyEra c)
expectedStEx9 =
  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)
blockEx9
    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
snapEx9 (Integer -> Coin
Coin Integer
0)
    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. Crypto c => RewardUpdate c
rewardUpdateEx8
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
KeyHash 'BlockIssuer (EraCrypto era)
-> Word64 -> ChainState era -> ChainState era
C.setOCertCounter KeyHash 'BlockIssuer c
coreNodeHK Word64
2
    forall a b. (a -> b) -> a -> b
$ forall c.
ExMock (EraCrypto (ShelleyEra c)) =>
ChainState (ShelleyEra c)
expectedStEx8
  where
    coreNodeHK :: KeyHash 'BlockIssuer c
coreNodeHK = forall (a :: KeyRole -> * -> *) (r :: KeyRole) c (r' :: KeyRole).
HasKeyRole a =>
a r c -> a r' c
coerceKeyRole forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall v (r :: KeyRole). AllIssuerKeys v r -> KeyHash r v
aikColdKeyHash forall a b. (a -> b) -> a -> b
$ 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
410

-- === Block 9, Slot 410, Epoch 4
--
-- Apply the first non-trivial reward update.
poolLifetime9 :: ExMock (EraCrypto (ShelleyEra c)) => CHAINExample (BHeader c) (ShelleyEra c)
poolLifetime9 :: forall c.
ExMock (EraCrypto (ShelleyEra c)) =>
CHAINExample (BHeader c) (ShelleyEra c)
poolLifetime9 = 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)
expectedStEx8 forall c.
ExMock (EraCrypto (ShelleyEra c)) =>
Block (BHeader c) (ShelleyEra c)
blockEx9 (forall a b. b -> Either a b
Right forall c.
ExMock (EraCrypto (ShelleyEra c)) =>
ChainState (ShelleyEra c)
expectedStEx9)

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

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

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

txbodyEx10 :: Crypto c => ShelleyTxBody (ShelleyEra c)
txbodyEx10 :: forall c. Crypto c => ShelleyTxBody (ShelleyEra c)
txbodyEx10 =
  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. HasCallStack => TxId c -> Integer -> TxIn c
mkTxInPartial forall c. HashAlgorithm (HASH c) => TxId c
genesisId Integer
1])
    (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.bobAddr (forall t s. Inject t s => t -> s
Val.inject Coin
bobAda10))
    (forall a. [a] -> StrictSeq a
StrictSeq.fromList [forall era.
ShelleyEraTxCert era =>
StakeCredential (EraCrypto era) -> TxCert era
UnRegTxCert forall c. Crypto c => Credential 'Staking c
Cast.bobSHK])
    (forall c. Map (RewardAccount c) Coin -> Withdrawals c
Withdrawals forall a b. (a -> b) -> a -> b
$ forall k a. k -> a -> Map k a
Map.singleton (forall c. Network -> Credential 'Staking c -> RewardAccount c
RewardAccount Network
Testnet forall c. Crypto c => Credential 'Staking c
Cast.bobSHK) Coin
bobRAcnt8)
    Coin
feeTx10
    (Word64 -> SlotNo
SlotNo Word64
500)
    forall a. StrictMaybe a
SNothing
    forall a. StrictMaybe a
SNothing

txEx10 :: forall c. ExMock (EraCrypto (ShelleyEra c)) => ShelleyTx (ShelleyEra c)
txEx10 :: forall c.
ExMock (EraCrypto (ShelleyEra c)) =>
ShelleyTx (ShelleyEra c)
txEx10 =
  forall era.
EraTx era =>
TxBody era
-> TxWits era -> StrictMaybe (TxAuxData era) -> ShelleyTx era
ShelleyTx
    forall c. Crypto c => ShelleyTxBody (ShelleyEra c)
txbodyEx10
    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 c. Crypto c => ShelleyTxBody (ShelleyEra c)
txbodyEx10 @c)) [forall (a :: KeyRole -> * -> *) (r :: KeyRole) c.
HasKeyRole a =>
a r c -> a 'Witness c
asWitness forall c. Crypto c => KeyPair 'Payment c
Cast.bobPay, forall (a :: KeyRole -> * -> *) (r :: KeyRole) c.
HasKeyRole a =>
a r c -> a 'Witness c
asWitness forall c. Crypto c => KeyPair 'Staking c
Cast.bobStake]
      }
    forall a. StrictMaybe a
SNothing

blockEx10 :: forall c. ExMock (EraCrypto (ShelleyEra c)) => Block (BHeader c) (ShelleyEra c)
blockEx10 :: forall c.
ExMock (EraCrypto (ShelleyEra c)) =>
Block (BHeader c) (ShelleyEra c)
blockEx10 =
  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)
blockEx9)
    (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
420)
    [forall c.
ExMock (EraCrypto (ShelleyEra c)) =>
ShelleyTx (ShelleyEra c)
txEx10]
    (Word64 -> SlotNo
SlotNo Word64
420)
    (Word64 -> BlockNo
BlockNo Word64
10)
    (forall c. ExMock (EraCrypto (ShelleyEra c)) => Nonce
epoch4Nonce @c)
    (Natural -> NatNonce
NatNonce Natural
10)
    forall a. Bounded a => a
minBound
    Word
21
    Word
19
    (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
420) Word64
2 (Word -> KESPeriod
KESPeriod Word
19))

expectedStEx10 :: forall c. ExMock (EraCrypto (ShelleyEra c)) => ChainState (ShelleyEra c)
expectedStEx10 :: forall c.
ExMock (EraCrypto (ShelleyEra c)) =>
ChainState (ShelleyEra c)
expectedStEx10 =
  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)
blockEx10 @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)
blockEx10
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
Credential 'Staking (EraCrypto era)
-> ChainState era -> ChainState era
C.deregStakeCred forall c. Crypto c => Credential 'Staking c
Cast.bobSHK
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
Coin
-> Credential 'Staking (EraCrypto era)
-> ChainState era
-> ChainState era
C.feesAndKeyRefund Coin
feeTx10 forall c. Crypto c => Credential 'Staking c
Cast.bobSHK -- We must zero out the refund, before we deregister
    -- because we loose the refund amount otherwise
    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)
txbodyEx10
    forall a b. (a -> b) -> a -> b
$ forall c.
ExMock (EraCrypto (ShelleyEra c)) =>
ChainState (ShelleyEra c)
expectedStEx9

-- === Block 10, Slot 420, Epoch 4
--
-- Drain Bob's reward account and de-register Bob's stake key.
poolLifetime10 :: ExMock (EraCrypto (ShelleyEra c)) => CHAINExample (BHeader c) (ShelleyEra c)
poolLifetime10 :: forall c.
ExMock (EraCrypto (ShelleyEra c)) =>
CHAINExample (BHeader c) (ShelleyEra c)
poolLifetime10 = 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)
expectedStEx9 forall c.
ExMock (EraCrypto (ShelleyEra c)) =>
Block (BHeader c) (ShelleyEra c)
blockEx10 (forall a b. b -> Either a b
Right forall c.
ExMock (EraCrypto (ShelleyEra c)) =>
ChainState (ShelleyEra c)
expectedStEx10)

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

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

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

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

txbodyEx11 :: forall c. Crypto c => ShelleyTxBody (ShelleyEra c)
txbodyEx11 :: forall c. Crypto c => ShelleyTxBody (ShelleyEra c)
txbodyEx11 =
  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)
txbodyEx4) 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.alicePtrAddr (forall t s. Inject t s => t -> s
Val.inject Coin
aliceCoinEx11Ptr))
    (forall a. [a] -> StrictSeq a
StrictSeq.fromList [forall era.
EraTxCert era =>
KeyHash 'StakePool (EraCrypto era) -> EpochNo -> TxCert era
RetirePoolTxCert (forall v (r :: KeyRole). AllIssuerKeys v r -> KeyHash r v
aikColdKeyHash forall c. Crypto c => AllIssuerKeys c 'StakePool
Cast.alicePoolKeys) EpochNo
aliceRetireEpoch])
    (forall c. Map (RewardAccount c) Coin -> Withdrawals c
Withdrawals forall k a. Map k a
Map.empty)
    Coin
feeTx11
    (Word64 -> SlotNo
SlotNo Word64
500)
    forall a. StrictMaybe a
SNothing
    forall a. StrictMaybe a
SNothing

txEx11 :: forall c. ExMock (EraCrypto (ShelleyEra c)) => ShelleyTx (ShelleyEra c)
txEx11 :: forall c.
ExMock (EraCrypto (ShelleyEra c)) =>
ShelleyTx (ShelleyEra c)
txEx11 =
  forall era.
EraTx era =>
TxBody era
-> TxWits era -> StrictMaybe (TxAuxData era) -> ShelleyTx era
ShelleyTx
    forall c. Crypto c => ShelleyTxBody (ShelleyEra c)
txbodyEx11
    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 c. Crypto c => ShelleyTxBody (ShelleyEra c)
txbodyEx11 @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 v (r :: KeyRole). AllIssuerKeys v r -> KeyPair r v
aikCold forall c. Crypto c => AllIssuerKeys c 'StakePool
Cast.alicePoolKeys]
            )
      }
    forall a. StrictMaybe a
SNothing

blockEx11 :: forall c. ExMock (EraCrypto (ShelleyEra c)) => Block (BHeader c) (ShelleyEra c)
blockEx11 :: forall c.
ExMock (EraCrypto (ShelleyEra c)) =>
Block (BHeader c) (ShelleyEra c)
blockEx11 =
  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)
blockEx10)
    (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
490)
    [forall c.
ExMock (EraCrypto (ShelleyEra c)) =>
ShelleyTx (ShelleyEra c)
txEx11]
    (Word64 -> SlotNo
SlotNo Word64
490)
    (Word64 -> BlockNo
BlockNo Word64
11)
    (forall c. ExMock (EraCrypto (ShelleyEra c)) => Nonce
epoch4Nonce @c)
    (Natural -> NatNonce
NatNonce Natural
11)
    forall a. Bounded a => a
minBound
    Word
24
    Word
19
    (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
490) Word64
2 (Word -> KESPeriod
KESPeriod Word
19))

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

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

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

pulserEx11 :: forall c. ExMock c => PulsingRewUpdate c
pulserEx11 :: forall c. ExMock c => PulsingRewUpdate c
pulserEx11 = 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)
expectedStEx10

rewardUpdateEx11 :: forall c. Crypto c => RewardUpdate c
rewardUpdateEx11 :: forall c. Crypto c => RewardUpdate c
rewardUpdateEx11 =
  RewardUpdate
    { deltaT :: DeltaCoin
deltaT = Integer -> DeltaCoin
DeltaCoin Integer
0
    , deltaR :: DeltaCoin
deltaR = Integer -> DeltaCoin
DeltaCoin Integer
0
    , rs :: Map (Credential 'Staking c) (Set (Reward c))
rs = forall k a. Map k a
Map.empty
    , deltaF :: DeltaCoin
deltaF = Integer -> DeltaCoin
DeltaCoin Integer
0
    , nonMyopic :: NonMyopic c
nonMyopic = forall c. Crypto c => NonMyopic c
nonMyopicEx11
    }

expectedStEx11 :: forall c. ExMock (EraCrypto (ShelleyEra c)) => ChainState (ShelleyEra c)
expectedStEx11 :: forall c.
ExMock (EraCrypto (ShelleyEra c)) =>
ChainState (ShelleyEra c)
expectedStEx11 =
  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)
blockEx11 @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)
blockEx11
    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
feeTx11 [] []
    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)
txbodyEx11
    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
pulserEx11
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
KeyHash 'StakePool (EraCrypto era)
-> EpochNo -> ChainState era -> ChainState era
C.stageRetirement (forall v (r :: KeyRole). AllIssuerKeys v r -> KeyHash r v
aikColdKeyHash forall c. Crypto c => AllIssuerKeys c 'StakePool
Cast.alicePoolKeys) EpochNo
aliceRetireEpoch
    forall a b. (a -> b) -> a -> b
$ forall c.
ExMock (EraCrypto (ShelleyEra c)) =>
ChainState (ShelleyEra c)
expectedStEx10

-- === Block 11, Slot 490, Epoch 4
--
-- Stage the retirement of Alice's stake pool.
poolLifetime11 :: ExMock (EraCrypto (ShelleyEra c)) => CHAINExample (BHeader c) (ShelleyEra c)
poolLifetime11 :: forall c.
ExMock (EraCrypto (ShelleyEra c)) =>
CHAINExample (BHeader c) (ShelleyEra c)
poolLifetime11 = 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)
expectedStEx10 forall c.
ExMock (EraCrypto (ShelleyEra c)) =>
Block (BHeader c) (ShelleyEra c)
blockEx11 (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)
expectedStEx11))

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

epoch5Nonce :: forall c. ExMock (EraCrypto (ShelleyEra c)) => Nonce
epoch5Nonce :: forall c. ExMock (EraCrypto (ShelleyEra c)) => Nonce
epoch5Nonce =
  forall era. ChainState era -> Nonce
chainCandidateNonce (forall c.
ExMock (EraCrypto (ShelleyEra c)) =>
ChainState (ShelleyEra c)
expectedStEx11 @c)
    Nonce -> Nonce -> Nonce
⭒ forall c. HashHeader c -> Nonce
hashHeaderToNonce (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)
blockEx8 @c))

blockEx12 :: forall c. ExMock (EraCrypto (ShelleyEra c)) => Block (BHeader c) (ShelleyEra c)
blockEx12 :: forall c.
ExMock (EraCrypto (ShelleyEra c)) =>
Block (BHeader c) (ShelleyEra c)
blockEx12 =
  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)
blockEx11)
    (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
510)
    []
    (Word64 -> SlotNo
SlotNo Word64
510)
    (Word64 -> BlockNo
BlockNo Word64
12)
    (forall c. ExMock (EraCrypto (ShelleyEra c)) => Nonce
epoch5Nonce @c)
    (Natural -> NatNonce
NatNonce Natural
12)
    forall a. Bounded a => a
minBound
    Word
25
    Word
25
    (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
510) Word64
3 (Word -> KESPeriod
KESPeriod Word
25))

snapEx12 :: forall c. Crypto c => EB.SnapShot c
snapEx12 :: forall c. Crypto c => SnapShot c
snapEx12 =
  forall c. Crypto c => SnapShot c
snapEx9
    { $sel:ssStake:SnapShot :: Stake c
EB.ssStake =
        forall c. [(Credential 'Staking c, Coin)] -> Stake c
mkStake
          [ (forall c. Crypto c => Credential 'Staking c
Cast.aliceSHK, Coin
aliceRAcnt8 forall a. Semigroup a => a -> a -> a
<> Coin
aliceCoinEx2Ptr forall a. Semigroup a => a -> a -> a
<> Coin
aliceCoinEx11Ptr)
          , (forall c. Crypto c => Credential 'Staking c
Cast.carlSHK, Coin
carlMIR)
          ]
    , $sel:ssDelegations:SnapShot :: VMap VB VB (Credential 'Staking c) (KeyHash 'StakePool c)
EB.ssDelegations =
        [ (forall c. Crypto c => Credential 'Staking c
Cast.aliceSHK, forall v (r :: KeyRole). AllIssuerKeys v r -> KeyHash r v
aikColdKeyHash forall c. Crypto c => AllIssuerKeys c 'StakePool
Cast.alicePoolKeys)
        , (forall c. Crypto c => Credential 'Staking c
Cast.carlSHK, forall v (r :: KeyRole). AllIssuerKeys v r -> KeyHash r v
aikColdKeyHash forall c. Crypto c => AllIssuerKeys c 'StakePool
Cast.alicePoolKeys)
        ]
    }

expectedStEx12 :: forall c. ExMock (EraCrypto (ShelleyEra c)) => ChainState (ShelleyEra c)
expectedStEx12 :: forall c.
ExMock (EraCrypto (ShelleyEra c)) =>
ChainState (ShelleyEra c)
expectedStEx12 =
  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)
blockEx12
    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
snapEx12 (Integer -> Coin
Coin Integer
11)
    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. Crypto c => RewardUpdate c
rewardUpdateEx11
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
KeyHash 'BlockIssuer (EraCrypto era)
-> Word64 -> ChainState era -> ChainState era
C.setOCertCounter KeyHash 'BlockIssuer c
coreNodeHK Word64
3
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
EraGov era =>
PoolParams (EraCrypto era) -> ChainState era -> ChainState era
C.reapPool forall c. Crypto c => PoolParams c
Cast.alicePoolParams
    forall a b. (a -> b) -> a -> b
$ forall c.
ExMock (EraCrypto (ShelleyEra c)) =>
ChainState (ShelleyEra c)
expectedStEx11
  where
    coreNodeHK :: KeyHash 'BlockIssuer c
coreNodeHK = forall (a :: KeyRole -> * -> *) (r :: KeyRole) c (r' :: KeyRole).
HasKeyRole a =>
a r c -> a r' c
coerceKeyRole forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall v (r :: KeyRole). AllIssuerKeys v r -> KeyHash r v
aikColdKeyHash forall a b. (a -> b) -> a -> b
$ 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
510

-- === Block 12, Slot 510, Epoch 5
--
-- Reap Alice's stake pool.
poolLifetime12 :: ExMock (EraCrypto (ShelleyEra c)) => CHAINExample (BHeader c) (ShelleyEra c)
poolLifetime12 :: forall c.
ExMock (EraCrypto (ShelleyEra c)) =>
CHAINExample (BHeader c) (ShelleyEra c)
poolLifetime12 = 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)
expectedStEx11 forall c.
ExMock (EraCrypto (ShelleyEra c)) =>
Block (BHeader c) (ShelleyEra c)
blockEx12 (forall a b. b -> Either a b
Right forall c.
ExMock (EraCrypto (ShelleyEra c)) =>
ChainState (ShelleyEra c)
expectedStEx12)

--
-- Pool Lifetime Test Group
--

poolLifetimeExample :: TestTree
poolLifetimeExample :: TestTree
poolLifetimeExample =
  [Char] -> [TestTree] -> TestTree
testGroup
    [Char]
"pool lifetime"
    [ [Char] -> Assertion -> TestTree
testCase [Char]
"initial registrations" 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)
poolLifetime1
    , [Char] -> Assertion -> TestTree
testCase [Char]
"delegate stake and create reward update" 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)
poolLifetime2
    , [Char] -> Assertion -> TestTree
testCase [Char]
"new epoch changes" 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)
poolLifetime3
    , [Char] -> Assertion -> TestTree
testCase [Char]
"second reward update" 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)
poolLifetime4
    , [Char] -> Assertion -> TestTree
testCase [Char]
"nonempty pool distr" 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)
poolLifetime5
    , [Char] -> Assertion -> TestTree
testCase [Char]
"decentralized block" 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)
poolLifetime6
    , [Char] -> Assertion -> TestTree
testCase [Char]
"prelude to the first nontrivial rewards" 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)
poolLifetime7
    , [Char] -> Assertion -> TestTree
testCase [Char]
"create a nontrivial rewards" 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)
poolLifetime8
    , [Char] -> Assertion -> TestTree
testCase [Char]
"apply a nontrivial rewards" 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)
poolLifetime9
    , [Char] -> Assertion -> TestTree
testCase [Char]
"drain reward account and deregister" 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)
poolLifetime10
    , [Char] -> Assertion -> TestTree
testCase [Char]
"stage stake pool retirement" 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)
poolLifetime11
    , [Char] -> Assertion -> TestTree
testCase [Char]
"reap stake pool" 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)
poolLifetime12
    ]