{-# 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 (..), SlotNo32 (..))
import qualified Cardano.Ledger.EpochBoundary as EB
import Cardano.Ledger.Keys (asWitness, coerceKeyRole)
import Cardano.Ledger.PoolDistr (
  IndividualPoolStake (..),
  PoolDistr (..),
 )
import Cardano.Ledger.PoolParams (PoolParams (..))
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 (MockCrypto)
import Test.Cardano.Ledger.Shelley.Examples (CHAINExample (..), testCHAINExample)
import qualified Test.Cardano.Ledger.Shelley.Examples.Cast as Cast
import qualified Test.Cardano.Ledger.Shelley.Examples.Combinators as C
import Test.Cardano.Ledger.Shelley.Examples.Federation (
  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, Coin)] -> EB.Stake
mkStake :: [(Credential 'Staking, Coin)] -> Stake
mkStake = VMap VB VP (Credential 'Staking) (CompactForm Coin) -> Stake
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 :: UTxO ShelleyEra
initUTxO :: UTxO ShelleyEra
initUTxO =
  forall era. TxId -> [TxOut era] -> UTxO era
genesisCoins
    TxId
genesisId
    [ forall era.
(HasCallStack, Era era, Val (Value era)) =>
Addr -> Value era -> ShelleyTxOut era
ShelleyTxOut Addr
Cast.aliceAddr (forall t s. Inject t s => t -> s
Val.inject Coin
aliceInitCoin)
    , forall era.
(HasCallStack, Era era, Val (Value era)) =>
Addr -> Value era -> ShelleyTxOut era
ShelleyTxOut Addr
Cast.bobAddr (forall t s. Inject t s => t -> s
Val.inject Coin
bobInitCoin)
    ]

initStPoolLifetime :: ChainState ShelleyEra
initStPoolLifetime :: ChainState ShelleyEra
initStPoolLifetime = forall era.
(EraTxOut era, ProtVerAtMost era 4, ProtVerAtMost era 6,
 Default (StashedAVVMAddresses era), EraGov era) =>
UTxO era -> ChainState era
initSt UTxO ShelleyEra
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 :: ShelleyTxBody ShelleyEra
txbodyEx1 :: ShelleyTxBody ShelleyEra
txbodyEx1 =
  forall era.
(EraTxOut era, EncCBOR (TxCert era)) =>
Set TxIn
-> StrictSeq (TxOut era)
-> StrictSeq (TxCert era)
-> Withdrawals
-> Coin
-> SlotNo
-> StrictMaybe (Update era)
-> StrictMaybe TxAuxDataHash
-> ShelleyTxBody era
ShelleyTxBody
    (forall a. Ord a => [a] -> Set a
Set.fromList [TxId -> TxIx -> TxIn
TxIn TxId
genesisId forall a. Bounded a => a
minBound])
    (forall a. [a] -> StrictSeq a
StrictSeq.fromList [forall era.
(HasCallStack, Era era, Val (Value era)) =>
Addr -> Value era -> ShelleyTxOut era
ShelleyTxOut Addr
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 =>
Credential 'Staking -> TxCert era
RegTxCert Credential 'Staking
Cast.aliceSHK
          , forall era.
ShelleyEraTxCert era =>
Credential 'Staking -> TxCert era
RegTxCert Credential 'Staking
Cast.bobSHK
          , forall era.
ShelleyEraTxCert era =>
Credential 'Staking -> TxCert era
RegTxCert Credential 'Staking
Cast.carlSHK
          , forall era. EraTxCert era => PoolParams -> TxCert era
RegPoolTxCert PoolParams
Cast.alicePoolParams
          ]
            forall a. [a] -> [a] -> [a]
++ [ forall era. MIRCert -> ShelleyTxCert era
ShelleyTxCertMir
                  ( MIRPot -> MIRTarget -> MIRCert
MIRCert
                      MIRPot
ReservesMIR
                      ( Map (Credential 'Staking) DeltaCoin -> MIRTarget
StakeAddressesMIR forall a b. (a -> b) -> a -> b
$
                          forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
                            [ (Credential 'Staking
Cast.carlSHK, Coin -> DeltaCoin
toDeltaCoin Coin
carlMIR)
                            , (Credential 'Staking
Cast.dariaSHK, Coin -> DeltaCoin
toDeltaCoin Coin
dariaMIR)
                            ]
                      )
                  )
               ]
        )
    )
    (Map RewardAccount Coin -> Withdrawals
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 :: ShelleyTx ShelleyEra
txEx1 :: ShelleyTx ShelleyEra
txEx1 =
  forall era.
EraTx era =>
TxBody era
-> TxWits era -> StrictMaybe (TxAuxData era) -> ShelleyTx era
ShelleyTx
    ShelleyTxBody ShelleyEra
txbodyEx1
    forall a. Monoid a => a
mempty
      { addrWits :: Set (WitVKey 'Witness)
addrWits =
          forall (kr :: KeyRole).
SafeHash EraIndependentTxBody
-> [KeyPair kr] -> Set (WitVKey 'Witness)
mkWitnessesVKey
            (forall x i. HashAnnotated x i => x -> SafeHash i
hashAnnotated ShelleyTxBody ShelleyEra
txbodyEx1)
            ( (forall (a :: KeyRole -> *) (r :: KeyRole).
HasKeyRole a =>
a r -> a 'Witness
asWitness forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [KeyPair 'Payment
Cast.alicePay, KeyPair 'Payment
Cast.carlPay])
                forall a. Semigroup a => a -> a -> a
<> (forall (a :: KeyRole -> *) (r :: KeyRole).
HasKeyRole a =>
a r -> a 'Witness
asWitness forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [KeyPair 'Staking
Cast.aliceStake])
                forall a. Semigroup a => a -> a -> a
<> [forall (a :: KeyRole -> *) (r :: KeyRole).
HasKeyRole a =>
a r -> a 'Witness
asWitness forall a b. (a -> b) -> a -> b
$ forall c (r :: KeyRole). AllIssuerKeys c r -> KeyPair r
aikCold AllIssuerKeys MockCrypto 'StakePool
Cast.alicePoolKeys]
                forall a. Semigroup a => a -> a -> a
<> ( forall (a :: KeyRole -> *) (r :: KeyRole).
HasKeyRole a =>
a r -> a 'Witness
asWitness
                      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ forall c (r :: KeyRole). AllIssuerKeys c r -> KeyPair r
aikCold (Int -> AllIssuerKeys MockCrypto 'GenesisDelegate
coreNodeIssuerKeys Int
0)
                          , forall c (r :: KeyRole). AllIssuerKeys c r -> KeyPair r
aikCold (Int -> AllIssuerKeys MockCrypto 'GenesisDelegate
coreNodeIssuerKeys Int
1)
                          , forall c (r :: KeyRole). AllIssuerKeys c r -> KeyPair r
aikCold (Int -> AllIssuerKeys MockCrypto 'GenesisDelegate
coreNodeIssuerKeys Int
2)
                          , forall c (r :: KeyRole). AllIssuerKeys c r -> KeyPair r
aikCold (Int -> AllIssuerKeys MockCrypto 'GenesisDelegate
coreNodeIssuerKeys Int
3)
                          , forall c (r :: KeyRole). AllIssuerKeys c r -> KeyPair r
aikCold (Int -> AllIssuerKeys MockCrypto 'GenesisDelegate
coreNodeIssuerKeys Int
4)
                          ]
                   )
            )
      }
    forall a. StrictMaybe a
SNothing

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

expectedStEx1 :: ChainState ShelleyEra
expectedStEx1 :: ChainState ShelleyEra
expectedStEx1 =
  forall era. Nonce -> ChainState era -> ChainState era
C.evolveNonceUnfrozen (forall era. Block (BHeader MockCrypto) era -> Nonce
getBlockNonce HasCallStack => Block (BHeader MockCrypto) ShelleyEra
blockEx1)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
Block (BHeader MockCrypto) era -> ChainState era -> ChainState era
C.newLab HasCallStack => Block (BHeader MockCrypto) ShelleyEra
blockEx1
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
EraPParams era =>
PParams era
-> Coin
-> [Credential 'Staking]
-> [PoolParams]
-> ChainState era
-> ChainState era
C.feesAndDeposits forall era.
(EraPParams era, ProtVerAtMost era 4, ProtVerAtMost era 6) =>
PParams era
ppEx Coin
feeTx1 [Credential 'Staking
Cast.aliceSHK, Credential 'Staking
Cast.bobSHK, Credential 'Staking
Cast.carlSHK] [PoolParams
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 ShelleyTxBody ShelleyEra
txbodyEx1
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
Credential 'Staking -> Ptr -> ChainState era -> ChainState era
C.newStakeCred Credential 'Staking
Cast.aliceSHK (SlotNo32 -> TxIx -> CertIx -> Ptr
Ptr (Word32 -> SlotNo32
SlotNo32 Word32
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 -> Ptr -> ChainState era -> ChainState era
C.newStakeCred Credential 'Staking
Cast.bobSHK (SlotNo32 -> TxIx -> CertIx -> Ptr
Ptr (Word32 -> SlotNo32
SlotNo32 Word32
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 -> Ptr -> ChainState era -> ChainState era
C.newStakeCred Credential 'Staking
Cast.carlSHK (SlotNo32 -> TxIx -> CertIx -> Ptr
Ptr (Word32 -> SlotNo32
SlotNo32 Word32
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 -> ChainState era -> ChainState era
C.newPool PoolParams
Cast.alicePoolParams
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
Credential 'Staking
-> MIRPot -> Coin -> ChainState era -> ChainState era
C.mir Credential 'Staking
Cast.carlSHK MIRPot
ReservesMIR Coin
carlMIR
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
Credential 'Staking
-> MIRPot -> Coin -> ChainState era -> ChainState era
C.mir Credential 'Staking
Cast.dariaSHK MIRPot
ReservesMIR Coin
dariaMIR
    forall a b. (a -> b) -> a -> b
$ ChainState ShelleyEra
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 :: CHAINExample ShelleyEra
poolLifetime1 :: CHAINExample ShelleyEra
poolLifetime1 = forall era.
ChainState era
-> Block (BHeader MockCrypto) era
-> Either
     (NonEmpty (PredicateFailure (CHAIN era))) (ChainState era)
-> CHAINExample era
CHAINExample ChainState ShelleyEra
initStPoolLifetime HasCallStack => Block (BHeader MockCrypto) ShelleyEra
blockEx1 (forall a b. b -> Either a b
Right ChainState ShelleyEra
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 :: ShelleyTxBody ShelleyEra
txbodyEx2 :: ShelleyTxBody ShelleyEra
txbodyEx2 =
  ShelleyTxBody
    { stbInputs :: Set TxIn
stbInputs = forall a. Ord a => [a] -> Set a
Set.fromList [TxId -> TxIx -> TxIn
TxIn (forall era. EraTxBody era => TxBody era -> TxId
txIdTxBody ShelleyTxBody ShelleyEra
txbodyEx1) forall a. Bounded a => a
minBound]
    , stbOutputs :: StrictSeq (TxOut ShelleyEra)
stbOutputs =
        forall a. [a] -> StrictSeq a
StrictSeq.fromList
          [ forall era.
(HasCallStack, Era era, Val (Value era)) =>
Addr -> Value era -> ShelleyTxOut era
ShelleyTxOut Addr
Cast.aliceAddr (forall t s. Inject t s => t -> s
Val.inject Coin
aliceCoinEx2Base)
          , forall era.
(HasCallStack, Era era, Val (Value era)) =>
Addr -> Value era -> ShelleyTxOut era
ShelleyTxOut Addr
Cast.alicePtrAddr (forall t s. Inject t s => t -> s
Val.inject Coin
aliceCoinEx2Ptr)
          ]
    , stbCerts :: StrictSeq (TxCert ShelleyEra)
stbCerts =
        forall a. [a] -> StrictSeq a
StrictSeq.fromList
          [ forall era.
ShelleyEraTxCert era =>
Credential 'Staking -> KeyHash 'StakePool -> TxCert era
DelegStakeTxCert Credential 'Staking
Cast.aliceSHK (forall c (r :: KeyRole). AllIssuerKeys c r -> KeyHash r
aikColdKeyHash AllIssuerKeys MockCrypto 'StakePool
Cast.alicePoolKeys)
          , forall era.
ShelleyEraTxCert era =>
Credential 'Staking -> KeyHash 'StakePool -> TxCert era
DelegStakeTxCert Credential 'Staking
Cast.bobSHK (forall c (r :: KeyRole). AllIssuerKeys c r -> KeyHash r
aikColdKeyHash AllIssuerKeys MockCrypto 'StakePool
Cast.alicePoolKeys)
          ]
    , stbWithdrawals :: Withdrawals
stbWithdrawals = Map RewardAccount Coin -> Withdrawals
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)
stbUpdate = forall a. StrictMaybe a
SNothing
    , stbMDHash :: StrictMaybe TxAuxDataHash
stbMDHash = forall a. StrictMaybe a
SNothing
    }

txEx2 :: ShelleyTx ShelleyEra
txEx2 :: ShelleyTx ShelleyEra
txEx2 =
  forall era.
EraTx era =>
TxBody era
-> TxWits era -> StrictMaybe (TxAuxData era) -> ShelleyTx era
ShelleyTx
    ShelleyTxBody ShelleyEra
txbodyEx2
    forall a. Monoid a => a
mempty
      { addrWits :: Set (WitVKey 'Witness)
addrWits =
          forall (kr :: KeyRole).
SafeHash EraIndependentTxBody
-> [KeyPair kr] -> Set (WitVKey 'Witness)
mkWitnessesVKey
            (forall x i. HashAnnotated x i => x -> SafeHash i
hashAnnotated ShelleyTxBody ShelleyEra
txbodyEx2)
            [ forall (a :: KeyRole -> *) (r :: KeyRole).
HasKeyRole a =>
a r -> a 'Witness
asWitness KeyPair 'Payment
Cast.alicePay
            , forall (a :: KeyRole -> *) (r :: KeyRole).
HasKeyRole a =>
a r -> a 'Witness
asWitness KeyPair 'Staking
Cast.aliceStake
            , forall (a :: KeyRole -> *) (r :: KeyRole).
HasKeyRole a =>
a r -> a 'Witness
asWitness KeyPair 'Staking
Cast.bobStake
            ]
      }
    forall a. StrictMaybe a
SNothing

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

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

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

makeCompletedPulser :: EraGov era => BlocksMade -> ChainState era -> PulsingRewUpdate
makeCompletedPulser :: forall era.
EraGov era =>
BlocksMade -> ChainState era -> PulsingRewUpdate
makeCompletedPulser BlocksMade
bs ChainState era
cs = RewardUpdate -> PulsingRewUpdate
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
. PulsingRewUpdate -> ShelleyBase (RewardUpdate, RewardEvent)
completeRupd forall a b. (a -> b) -> a -> b
$ forall era.
EraGov era =>
BlocksMade -> ChainState era -> PulsingRewUpdate
makePulser BlocksMade
bs ChainState era
cs

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

expectedStEx2 :: ChainState ShelleyEra
expectedStEx2 :: ChainState ShelleyEra
expectedStEx2 =
  forall era. Nonce -> ChainState era -> ChainState era
C.evolveNonceFrozen (forall era. Block (BHeader MockCrypto) era -> Nonce
getBlockNonce Block (BHeader MockCrypto) ShelleyEra
blockEx2)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
Block (BHeader MockCrypto) era -> ChainState era -> ChainState era
C.newLab Block (BHeader MockCrypto) ShelleyEra
blockEx2
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
EraPParams era =>
PParams era
-> Coin
-> [Credential 'Staking]
-> [PoolParams]
-> 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 ShelleyTxBody ShelleyEra
txbodyEx2
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
Credential 'Staking
-> KeyHash 'StakePool -> ChainState era -> ChainState era
C.delegation Credential 'Staking
Cast.aliceSHK (PoolParams -> KeyHash 'StakePool
ppId PoolParams
Cast.alicePoolParams)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
Credential 'Staking
-> KeyHash 'StakePool -> ChainState era -> ChainState era
C.delegation Credential 'Staking
Cast.bobSHK (PoolParams -> KeyHash 'StakePool
ppId PoolParams
Cast.alicePoolParams)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. PulsingRewUpdate -> ChainState era -> ChainState era
C.pulserUpdate PulsingRewUpdate
pulserEx2
    forall a b. (a -> b) -> a -> b
$ ChainState ShelleyEra
expectedStEx1

-- === Block 2, Slot 90, Epoch 0
--
-- In the second block Alice and Bob both delegation to Alice's Pool.
poolLifetime2 :: CHAINExample ShelleyEra
poolLifetime2 :: CHAINExample ShelleyEra
poolLifetime2 = forall era.
ChainState era
-> Block (BHeader MockCrypto) era
-> Either
     (NonEmpty (PredicateFailure (CHAIN era))) (ChainState era)
-> CHAINExample era
CHAINExample ChainState ShelleyEra
expectedStEx1 Block (BHeader MockCrypto) ShelleyEra
blockEx2 (forall a b. b -> Either a b
Right (forall era. EraGov era => ChainState era -> ChainState era
C.solidifyProposals ChainState ShelleyEra
expectedStEx2))

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

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

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

snapEx3 :: EB.SnapShot
snapEx3 :: SnapShot
snapEx3 =
  EB.SnapShot
    { $sel:ssStake:SnapShot :: Stake
EB.ssStake =
        [(Credential 'Staking, Coin)] -> Stake
mkStake
          [ (Credential 'Staking
Cast.aliceSHK, Coin
aliceCoinEx2Base forall a. Semigroup a => a -> a -> a
<> Coin
aliceCoinEx2Ptr)
          , (Credential 'Staking
Cast.bobSHK, Coin
bobInitCoin)
          ]
    , $sel:ssDelegations:SnapShot :: VMap VB VB (Credential 'Staking) (KeyHash 'StakePool)
EB.ssDelegations =
        [ (Credential 'Staking
Cast.aliceSHK, forall c (r :: KeyRole). AllIssuerKeys c r -> KeyHash r
aikColdKeyHash AllIssuerKeys MockCrypto 'StakePool
Cast.alicePoolKeys)
        , (Credential 'Staking
Cast.bobSHK, forall c (r :: KeyRole). AllIssuerKeys c r -> KeyHash r
aikColdKeyHash AllIssuerKeys MockCrypto 'StakePool
Cast.alicePoolKeys)
        ]
    , $sel:ssPoolParams:SnapShot :: VMap VB VB (KeyHash 'StakePool) PoolParams
EB.ssPoolParams = [(forall c (r :: KeyRole). AllIssuerKeys c r -> KeyHash r
aikColdKeyHash AllIssuerKeys MockCrypto 'StakePool
Cast.alicePoolKeys, PoolParams
Cast.alicePoolParams)]
    }

expectedStEx3 :: ChainState ShelleyEra
expectedStEx3 :: ChainState ShelleyEra
expectedStEx3 =
  forall era.
(ProtVerAtMost era 6, EraGov era) =>
Block (BHeader MockCrypto) era -> ChainState era -> ChainState era
C.newEpoch Block (BHeader MockCrypto) ShelleyEra
blockEx3
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. SnapShot -> Coin -> ChainState era -> ChainState era
C.newSnapshot SnapShot
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) Coin
-> ChainState era
-> ChainState era
C.applyMIR MIRPot
ReservesMIR (forall k a. k -> a -> Map k a
Map.singleton Credential 'Staking
Cast.carlSHK Coin
carlMIR)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
EraGov era =>
RewardUpdate -> ChainState era -> ChainState era
C.applyRewardUpdate RewardUpdate
emptyRewardUpdate
    forall a b. (a -> b) -> a -> b
$ ChainState ShelleyEra
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 :: CHAINExample ShelleyEra
poolLifetime3 :: CHAINExample ShelleyEra
poolLifetime3 = forall era.
ChainState era
-> Block (BHeader MockCrypto) era
-> Either
     (NonEmpty (PredicateFailure (CHAIN era))) (ChainState era)
-> CHAINExample era
CHAINExample ChainState ShelleyEra
expectedStEx2 Block (BHeader MockCrypto) ShelleyEra
blockEx3 (forall a b. b -> Either a b
Right ChainState ShelleyEra
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 :: ShelleyTxBody ShelleyEra
txbodyEx4 :: ShelleyTxBody ShelleyEra
txbodyEx4 =
  ShelleyTxBody
    { stbInputs :: Set TxIn
stbInputs = forall a. Ord a => [a] -> Set a
Set.fromList [TxId -> TxIx -> TxIn
TxIn (forall era. EraTxBody era => TxBody era -> TxId
txIdTxBody ShelleyTxBody ShelleyEra
txbodyEx2) forall a. Bounded a => a
minBound]
    , stbOutputs :: StrictSeq (TxOut ShelleyEra)
stbOutputs = forall a. [a] -> StrictSeq a
StrictSeq.fromList [forall era.
(HasCallStack, Era era, Val (Value era)) =>
Addr -> Value era -> ShelleyTxOut era
ShelleyTxOut Addr
Cast.aliceAddr (forall t s. Inject t s => t -> s
Val.inject Coin
aliceCoinEx4Base)]
    , stbCerts :: StrictSeq (TxCert ShelleyEra)
stbCerts =
        forall a. [a] -> StrictSeq a
StrictSeq.fromList
          [forall era.
ShelleyEraTxCert era =>
Credential 'Staking -> KeyHash 'StakePool -> TxCert era
DelegStakeTxCert Credential 'Staking
Cast.carlSHK (forall c (r :: KeyRole). AllIssuerKeys c r -> KeyHash r
aikColdKeyHash AllIssuerKeys MockCrypto 'StakePool
Cast.alicePoolKeys)]
    , stbWithdrawals :: Withdrawals
stbWithdrawals = Map RewardAccount Coin -> Withdrawals
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)
stbUpdate = forall a. StrictMaybe a
SNothing
    , stbMDHash :: StrictMaybe TxAuxDataHash
stbMDHash = forall a. StrictMaybe a
SNothing
    }

txEx4 :: ShelleyTx ShelleyEra
txEx4 :: ShelleyTx ShelleyEra
txEx4 =
  forall era.
EraTx era =>
TxBody era
-> TxWits era -> StrictMaybe (TxAuxData era) -> ShelleyTx era
ShelleyTx
    ShelleyTxBody ShelleyEra
txbodyEx4
    forall a. Monoid a => a
mempty
      { addrWits :: Set (WitVKey 'Witness)
addrWits =
          forall (kr :: KeyRole).
SafeHash EraIndependentTxBody
-> [KeyPair kr] -> Set (WitVKey 'Witness)
mkWitnessesVKey
            (forall x i. HashAnnotated x i => x -> SafeHash i
hashAnnotated ShelleyTxBody ShelleyEra
txbodyEx4)
            [forall (a :: KeyRole -> *) (r :: KeyRole).
HasKeyRole a =>
a r -> a 'Witness
asWitness KeyPair 'Payment
Cast.alicePay, forall (a :: KeyRole -> *) (r :: KeyRole).
HasKeyRole a =>
a r -> a 'Witness
asWitness KeyPair 'Staking
Cast.carlStake]
      }
    forall a. StrictMaybe a
SNothing

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

pulserEx4 :: PulsingRewUpdate
pulserEx4 :: PulsingRewUpdate
pulserEx4 = forall era.
EraGov era =>
BlocksMade -> ChainState era -> PulsingRewUpdate
makeCompletedPulser (Map (KeyHash 'StakePool) Natural -> BlocksMade
BlocksMade forall a. Monoid a => a
mempty) ChainState ShelleyEra
expectedStEx3

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

expectedStEx4 :: ChainState ShelleyEra
expectedStEx4 :: ChainState ShelleyEra
expectedStEx4 =
  forall era. Nonce -> ChainState era -> ChainState era
C.evolveNonceFrozen (forall era. Block (BHeader MockCrypto) era -> Nonce
getBlockNonce Block (BHeader MockCrypto) ShelleyEra
blockEx4)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
Block (BHeader MockCrypto) era -> ChainState era -> ChainState era
C.newLab Block (BHeader MockCrypto) ShelleyEra
blockEx4
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
EraPParams era =>
PParams era
-> Coin
-> [Credential 'Staking]
-> [PoolParams]
-> 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 ShelleyTxBody ShelleyEra
txbodyEx4
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
Credential 'Staking
-> KeyHash 'StakePool -> ChainState era -> ChainState era
C.delegation Credential 'Staking
Cast.carlSHK (PoolParams -> KeyHash 'StakePool
ppId PoolParams
Cast.alicePoolParams)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. PulsingRewUpdate -> ChainState era -> ChainState era
C.pulserUpdate PulsingRewUpdate
pulserEx4
    forall a b. (a -> b) -> a -> b
$ ChainState ShelleyEra
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 :: CHAINExample ShelleyEra
poolLifetime4 :: CHAINExample ShelleyEra
poolLifetime4 = forall era.
ChainState era
-> Block (BHeader MockCrypto) era
-> Either
     (NonEmpty (PredicateFailure (CHAIN era))) (ChainState era)
-> CHAINExample era
CHAINExample ChainState ShelleyEra
expectedStEx3 Block (BHeader MockCrypto) ShelleyEra
blockEx4 (forall a b. b -> Either a b
Right (forall era. EraGov era => ChainState era -> ChainState era
C.solidifyProposals ChainState ShelleyEra
expectedStEx4))

epoch2Nonce :: Nonce
epoch2Nonce :: Nonce
epoch2Nonce =
  forall era. ChainState era -> Nonce
chainCandidateNonce ChainState ShelleyEra
expectedStEx4
    Nonce -> Nonce -> Nonce
⭒ HashHeader -> Nonce
hashHeaderToNonce (forall c. Crypto c => BHeader c -> HashHeader
bhHash forall a b. (a -> b) -> a -> b
$ forall h era. Block h era -> h
bheader Block (BHeader MockCrypto) ShelleyEra
blockEx2)

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

blockEx5 :: Block (BHeader MockCrypto) ShelleyEra
blockEx5 :: Block (BHeader MockCrypto) ShelleyEra
blockEx5 =
  forall era (r :: KeyRole) c.
(Crypto c, EraSegWits era, Signable (VRF c) (WithResult Seed),
 Signable (KES c) (BHBody c)) =>
HashHeader
-> AllIssuerKeys c r
-> [Tx era]
-> SlotNo
-> BlockNo
-> Nonce
-> NatNonce
-> UnitInterval
-> Word
-> Word
-> OCert c
-> Block (BHeader c) era
mkBlockFakeVRF
    (forall c. Crypto c => BHeader c -> HashHeader
bhHash forall a b. (a -> b) -> a -> b
$ forall h era. Block h era -> h
bheader Block (BHeader MockCrypto) ShelleyEra
blockEx4)
    (forall era.
(HasCallStack, EraPParams era) =>
PParams era -> Word64 -> AllIssuerKeys MockCrypto 'GenesisDelegate
coreNodeKeysBySchedule @ShelleyEra 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)
    Nonce
epoch2Nonce
    (Natural -> NatNonce
NatNonce Natural
5)
    forall a. Bounded a => a
minBound
    Word
11
    Word
10
    (forall c (r :: KeyRole).
Crypto c =>
AllIssuerKeys c r -> Word64 -> KESPeriod -> OCert c
mkOCert (forall era.
(HasCallStack, EraPParams era) =>
PParams era -> Word64 -> AllIssuerKeys MockCrypto 'GenesisDelegate
coreNodeKeysBySchedule @ShelleyEra forall era.
(EraPParams era, ProtVerAtMost era 4, ProtVerAtMost era 6) =>
PParams era
ppEx Word64
220) Word64
1 (Word -> KESPeriod
KESPeriod Word
10))

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

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

expectedStEx5 :: ChainState ShelleyEra
expectedStEx5 :: ChainState ShelleyEra
expectedStEx5 =
  forall era.
(ProtVerAtMost era 6, EraGov era) =>
Block (BHeader MockCrypto) era -> ChainState era -> ChainState era
C.newEpoch Block (BHeader MockCrypto) ShelleyEra
blockEx5
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. SnapShot -> Coin -> ChainState era -> ChainState era
C.newSnapshot SnapShot
snapEx5 Coin
feeTx4
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
EraGov era =>
RewardUpdate -> ChainState era -> ChainState era
C.applyRewardUpdate RewardUpdate
rewardUpdateEx4
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. PoolDistr -> ChainState era -> ChainState era
C.setPoolDistr PoolDistr
pdEx5
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
KeyHash 'BlockIssuer -> Word64 -> ChainState era -> ChainState era
C.setOCertCounter forall {r' :: KeyRole}. KeyHash r'
coreNodeHK Word64
1
    forall a b. (a -> b) -> a -> b
$ ChainState ShelleyEra
expectedStEx4
  where
    coreNodeHK :: KeyHash r'
coreNodeHK = forall (a :: KeyRole -> *) (r :: KeyRole) (r' :: KeyRole).
HasKeyRole a =>
a r -> a r'
coerceKeyRole forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c (r :: KeyRole). AllIssuerKeys c r -> KeyHash r
aikColdKeyHash forall a b. (a -> b) -> a -> b
$ forall era.
(HasCallStack, EraPParams era) =>
PParams era -> Word64 -> AllIssuerKeys MockCrypto 'GenesisDelegate
coreNodeKeysBySchedule @ShelleyEra 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 :: CHAINExample ShelleyEra
poolLifetime5 :: CHAINExample ShelleyEra
poolLifetime5 = forall era.
ChainState era
-> Block (BHeader MockCrypto) era
-> Either
     (NonEmpty (PredicateFailure (CHAIN era))) (ChainState era)
-> CHAINExample era
CHAINExample ChainState ShelleyEra
expectedStEx4 Block (BHeader MockCrypto) ShelleyEra
blockEx5 (forall a b. b -> Either a b
Right ChainState ShelleyEra
expectedStEx5)

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

blockEx6 :: Block (BHeader MockCrypto) ShelleyEra
blockEx6 :: Block (BHeader MockCrypto) ShelleyEra
blockEx6 =
  forall era (r :: KeyRole) c.
(Crypto c, EraSegWits era, Signable (VRF c) (WithResult Seed),
 Signable (KES c) (BHBody c)) =>
HashHeader
-> AllIssuerKeys c r
-> [Tx era]
-> SlotNo
-> BlockNo
-> Nonce
-> NatNonce
-> UnitInterval
-> Word
-> Word
-> OCert c
-> Block (BHeader c) era
mkBlockFakeVRF
    (forall c. Crypto c => BHeader c -> HashHeader
bhHash forall a b. (a -> b) -> a -> b
$ forall h era. Block h era -> h
bheader Block (BHeader MockCrypto) ShelleyEra
blockEx5)
    AllIssuerKeys MockCrypto 'StakePool
Cast.alicePoolKeys
    []
    (Word64 -> SlotNo
SlotNo Word64
295) -- odd slots open for decentralization
    (Word64 -> BlockNo
BlockNo Word64
6)
    Nonce
epoch2Nonce
    (Natural -> NatNonce
NatNonce Natural
6)
    forall a. Bounded a => a
minBound
    Word
14
    Word
14
    (forall c (r :: KeyRole).
Crypto c =>
AllIssuerKeys c r -> Word64 -> KESPeriod -> OCert c
mkOCert AllIssuerKeys MockCrypto 'StakePool
Cast.alicePoolKeys Word64
0 (Word -> KESPeriod
KESPeriod Word
14))

rewardUpdateEx6 :: RewardUpdate
rewardUpdateEx6 :: RewardUpdate
rewardUpdateEx6 =
  RewardUpdate
    { deltaT :: DeltaCoin
deltaT = Integer -> DeltaCoin
DeltaCoin Integer
1
    , deltaR :: DeltaCoin
deltaR = Integer -> DeltaCoin
DeltaCoin Integer
4
    , rs :: RewardEvent
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
nonMyopic = forall a. Default a => a
def {rewardPotNM :: Coin
rewardPotNM = Integer -> Coin
Coin Integer
4}
    }

pulserEx6 :: PulsingRewUpdate
pulserEx6 :: PulsingRewUpdate
pulserEx6 = forall era.
EraGov era =>
BlocksMade -> ChainState era -> PulsingRewUpdate
makeCompletedPulser (Map (KeyHash 'StakePool) Natural -> BlocksMade
BlocksMade forall a. Monoid a => a
mempty) ChainState ShelleyEra
expectedStEx5

expectedStEx6 :: ChainState ShelleyEra
expectedStEx6 :: ChainState ShelleyEra
expectedStEx6 =
  forall era. Nonce -> ChainState era -> ChainState era
C.evolveNonceFrozen (forall era. Block (BHeader MockCrypto) era -> Nonce
getBlockNonce Block (BHeader MockCrypto) ShelleyEra
blockEx6)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
Block (BHeader MockCrypto) era -> ChainState era -> ChainState era
C.newLab Block (BHeader MockCrypto) ShelleyEra
blockEx6
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
KeyHash 'BlockIssuer -> Word64 -> ChainState era -> ChainState era
C.setOCertCounter (forall (a :: KeyRole -> *) (r :: KeyRole) (r' :: KeyRole).
HasKeyRole a =>
a r -> a r'
coerceKeyRole forall a b. (a -> b) -> a -> b
$ forall c (r :: KeyRole). AllIssuerKeys c r -> KeyHash r
aikColdKeyHash AllIssuerKeys MockCrypto 'StakePool
Cast.alicePoolKeys) Word64
0
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. KeyHash 'StakePool -> ChainState era -> ChainState era
C.incrBlockCount (forall c (r :: KeyRole). AllIssuerKeys c r -> KeyHash r
aikColdKeyHash AllIssuerKeys MockCrypto 'StakePool
Cast.alicePoolKeys)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. PulsingRewUpdate -> ChainState era -> ChainState era
C.pulserUpdate PulsingRewUpdate
pulserEx6
    forall a b. (a -> b) -> a -> b
$ ChainState ShelleyEra
expectedStEx5

-- === Block 6, Slot 295, Epoch 2
--
-- Create a decentralized Praos block (ie one not in the overlay schedule)
poolLifetime6 :: CHAINExample ShelleyEra
poolLifetime6 :: CHAINExample ShelleyEra
poolLifetime6 = forall era.
ChainState era
-> Block (BHeader MockCrypto) era
-> Either
     (NonEmpty (PredicateFailure (CHAIN era))) (ChainState era)
-> CHAINExample era
CHAINExample ChainState ShelleyEra
expectedStEx5 Block (BHeader MockCrypto) ShelleyEra
blockEx6 (forall a b. b -> Either a b
Right (forall era. EraGov era => ChainState era -> ChainState era
C.solidifyProposals ChainState ShelleyEra
expectedStEx6))

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

epoch3Nonce :: Nonce
epoch3Nonce :: Nonce
epoch3Nonce =
  forall era. ChainState era -> Nonce
chainCandidateNonce ChainState ShelleyEra
expectedStEx6
    Nonce -> Nonce -> Nonce
⭒ HashHeader -> Nonce
hashHeaderToNonce (forall c. Crypto c => BHeader c -> HashHeader
bhHash forall a b. (a -> b) -> a -> b
$ forall h era. Block h era -> h
bheader Block (BHeader MockCrypto) ShelleyEra
blockEx4)

blockEx7 :: Block (BHeader MockCrypto) ShelleyEra
blockEx7 :: Block (BHeader MockCrypto) ShelleyEra
blockEx7 =
  forall era (r :: KeyRole) c.
(Crypto c, EraSegWits era, Signable (VRF c) (WithResult Seed),
 Signable (KES c) (BHBody c)) =>
HashHeader
-> AllIssuerKeys c r
-> [Tx era]
-> SlotNo
-> BlockNo
-> Nonce
-> NatNonce
-> UnitInterval
-> Word
-> Word
-> OCert c
-> Block (BHeader c) era
mkBlockFakeVRF
    (forall c. Crypto c => BHeader c -> HashHeader
bhHash forall a b. (a -> b) -> a -> b
$ forall h era. Block h era -> h
bheader Block (BHeader MockCrypto) ShelleyEra
blockEx6)
    (forall era.
(HasCallStack, EraPParams era) =>
PParams era -> Word64 -> AllIssuerKeys MockCrypto 'GenesisDelegate
coreNodeKeysBySchedule @ShelleyEra 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)
    Nonce
epoch3Nonce
    (Natural -> NatNonce
NatNonce Natural
7)
    forall a. Bounded a => a
minBound
    Word
15
    Word
15
    (forall c (r :: KeyRole).
Crypto c =>
AllIssuerKeys c r -> Word64 -> KESPeriod -> OCert c
mkOCert (forall era.
(HasCallStack, EraPParams era) =>
PParams era -> Word64 -> AllIssuerKeys MockCrypto 'GenesisDelegate
coreNodeKeysBySchedule @ShelleyEra forall era.
(EraPParams era, ProtVerAtMost era 4, ProtVerAtMost era 6) =>
PParams era
ppEx Word64
310) Word64
1 (Word -> KESPeriod
KESPeriod Word
15))

expectedStEx7 :: ChainState ShelleyEra
expectedStEx7 :: ChainState ShelleyEra
expectedStEx7 =
  forall era.
(ProtVerAtMost era 6, EraGov era) =>
Block (BHeader MockCrypto) era -> ChainState era -> ChainState era
C.newEpoch Block (BHeader MockCrypto) ShelleyEra
blockEx7
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. SnapShot -> Coin -> ChainState era -> ChainState era
C.newSnapshot SnapShot
snapEx5 (Integer -> Coin
Coin Integer
0)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
EraGov era =>
RewardUpdate -> ChainState era -> ChainState era
C.applyRewardUpdate RewardUpdate
rewardUpdateEx6
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
KeyHash 'BlockIssuer -> Word64 -> ChainState era -> ChainState era
C.setOCertCounter forall {r' :: KeyRole}. KeyHash r'
coreNodeHK Word64
1
    forall a b. (a -> b) -> a -> b
$ ChainState ShelleyEra
expectedStEx6
  where
    coreNodeHK :: KeyHash r'
coreNodeHK = forall (a :: KeyRole -> *) (r :: KeyRole) (r' :: KeyRole).
HasKeyRole a =>
a r -> a r'
coerceKeyRole forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c (r :: KeyRole). AllIssuerKeys c r -> KeyHash r
aikColdKeyHash forall a b. (a -> b) -> a -> b
$ forall era.
(HasCallStack, EraPParams era) =>
PParams era -> Word64 -> AllIssuerKeys MockCrypto 'GenesisDelegate
coreNodeKeysBySchedule @ShelleyEra 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 :: CHAINExample ShelleyEra
poolLifetime7 :: CHAINExample ShelleyEra
poolLifetime7 = forall era.
ChainState era
-> Block (BHeader MockCrypto) era
-> Either
     (NonEmpty (PredicateFailure (CHAIN era))) (ChainState era)
-> CHAINExample era
CHAINExample ChainState ShelleyEra
expectedStEx6 Block (BHeader MockCrypto) ShelleyEra
blockEx7 (forall a b. b -> Either a b
Right ChainState ShelleyEra
expectedStEx7)

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

blockEx8 :: Block (BHeader MockCrypto) ShelleyEra
blockEx8 :: Block (BHeader MockCrypto) ShelleyEra
blockEx8 =
  forall era (r :: KeyRole) c.
(Crypto c, EraSegWits era, Signable (VRF c) (WithResult Seed),
 Signable (KES c) (BHBody c)) =>
HashHeader
-> AllIssuerKeys c r
-> [Tx era]
-> SlotNo
-> BlockNo
-> Nonce
-> NatNonce
-> UnitInterval
-> Word
-> Word
-> OCert c
-> Block (BHeader c) era
mkBlockFakeVRF
    (forall c. Crypto c => BHeader c -> HashHeader
bhHash forall a b. (a -> b) -> a -> b
$ forall h era. Block h era -> h
bheader Block (BHeader MockCrypto) ShelleyEra
blockEx7)
    (forall era.
(HasCallStack, EraPParams era) =>
PParams era -> Word64 -> AllIssuerKeys MockCrypto 'GenesisDelegate
coreNodeKeysBySchedule @ShelleyEra 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)
    Nonce
epoch3Nonce
    (Natural -> NatNonce
NatNonce Natural
8)
    forall a. Bounded a => a
minBound
    Word
19
    Word
19
    (forall c (r :: KeyRole).
Crypto c =>
AllIssuerKeys c r -> Word64 -> KESPeriod -> OCert c
mkOCert (forall era.
(HasCallStack, EraPParams era) =>
PParams era -> Word64 -> AllIssuerKeys MockCrypto 'GenesisDelegate
coreNodeKeysBySchedule @ShelleyEra 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 :: NonMyopic
nonMyopicEx8 :: NonMyopic
nonMyopicEx8 =
  Map (KeyHash 'StakePool) Likelihood -> Coin -> NonMyopic
NonMyopic
    (forall k a. k -> a -> Map k a
Map.singleton (forall c (r :: KeyRole). AllIssuerKeys c r -> KeyHash r
aikColdKeyHash AllIssuerKeys MockCrypto 'StakePool
Cast.alicePoolKeys) Likelihood
alicePerfEx8)
    Coin
rewardPot8

pulserEx8 :: PulsingRewUpdate
pulserEx8 :: PulsingRewUpdate
pulserEx8 =
  forall era.
EraGov era =>
BlocksMade -> ChainState era -> PulsingRewUpdate
makeCompletedPulser (Map (KeyHash 'StakePool) Natural -> BlocksMade
BlocksMade forall a b. (a -> b) -> a -> b
$ forall k a. k -> a -> Map k a
Map.singleton (forall c (r :: KeyRole). AllIssuerKeys c r -> KeyHash r
aikColdKeyHash AllIssuerKeys MockCrypto 'StakePool
Cast.alicePoolKeys) Natural
1) ChainState ShelleyEra
expectedStEx7

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

expectedStEx8 :: ChainState ShelleyEra
expectedStEx8 :: ChainState ShelleyEra
expectedStEx8 =
  forall era. Nonce -> ChainState era -> ChainState era
C.evolveNonceFrozen (forall era. Block (BHeader MockCrypto) era -> Nonce
getBlockNonce Block (BHeader MockCrypto) ShelleyEra
blockEx8)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
Block (BHeader MockCrypto) era -> ChainState era -> ChainState era
C.newLab Block (BHeader MockCrypto) ShelleyEra
blockEx8
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
KeyHash 'BlockIssuer -> Word64 -> ChainState era -> ChainState era
C.setOCertCounter forall {r' :: KeyRole}. KeyHash r'
coreNodeHK Word64
2
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. PulsingRewUpdate -> ChainState era -> ChainState era
C.pulserUpdate PulsingRewUpdate
pulserEx8
    forall a b. (a -> b) -> a -> b
$ ChainState ShelleyEra
expectedStEx7
  where
    coreNodeHK :: KeyHash r'
coreNodeHK = forall (a :: KeyRole -> *) (r :: KeyRole) (r' :: KeyRole).
HasKeyRole a =>
a r -> a r'
coerceKeyRole forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c (r :: KeyRole). AllIssuerKeys c r -> KeyHash r
aikColdKeyHash forall a b. (a -> b) -> a -> b
$ forall era.
(HasCallStack, EraPParams era) =>
PParams era -> Word64 -> AllIssuerKeys MockCrypto 'GenesisDelegate
coreNodeKeysBySchedule @ShelleyEra 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 :: CHAINExample ShelleyEra
poolLifetime8 :: CHAINExample ShelleyEra
poolLifetime8 = forall era.
ChainState era
-> Block (BHeader MockCrypto) era
-> Either
     (NonEmpty (PredicateFailure (CHAIN era))) (ChainState era)
-> CHAINExample era
CHAINExample ChainState ShelleyEra
expectedStEx7 Block (BHeader MockCrypto) ShelleyEra
blockEx8 (forall a b. b -> Either a b
Right (forall era. EraGov era => ChainState era -> ChainState era
C.solidifyProposals ChainState ShelleyEra
expectedStEx8))

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

epoch4Nonce :: Nonce
epoch4Nonce :: Nonce
epoch4Nonce =
  forall era. ChainState era -> Nonce
chainCandidateNonce ChainState ShelleyEra
expectedStEx8
    Nonce -> Nonce -> Nonce
⭒ HashHeader -> Nonce
hashHeaderToNonce (forall c. Crypto c => BHeader c -> HashHeader
bhHash forall a b. (a -> b) -> a -> b
$ forall h era. Block h era -> h
bheader Block (BHeader MockCrypto) ShelleyEra
blockEx6)

blockEx9 :: Block (BHeader MockCrypto) ShelleyEra
blockEx9 :: Block (BHeader MockCrypto) ShelleyEra
blockEx9 =
  forall era (r :: KeyRole) c.
(Crypto c, EraSegWits era, Signable (VRF c) (WithResult Seed),
 Signable (KES c) (BHBody c)) =>
HashHeader
-> AllIssuerKeys c r
-> [Tx era]
-> SlotNo
-> BlockNo
-> Nonce
-> NatNonce
-> UnitInterval
-> Word
-> Word
-> OCert c
-> Block (BHeader c) era
mkBlockFakeVRF
    (forall c. Crypto c => BHeader c -> HashHeader
bhHash forall a b. (a -> b) -> a -> b
$ forall h era. Block h era -> h
bheader Block (BHeader MockCrypto) ShelleyEra
blockEx8)
    (forall era.
(HasCallStack, EraPParams era) =>
PParams era -> Word64 -> AllIssuerKeys MockCrypto 'GenesisDelegate
coreNodeKeysBySchedule @ShelleyEra 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)
    Nonce
epoch4Nonce
    (Natural -> NatNonce
NatNonce Natural
9)
    forall a. Bounded a => a
minBound
    Word
20
    Word
20
    (forall c (r :: KeyRole).
Crypto c =>
AllIssuerKeys c r -> Word64 -> KESPeriod -> OCert c
mkOCert (forall era.
(HasCallStack, EraPParams era) =>
PParams era -> Word64 -> AllIssuerKeys MockCrypto 'GenesisDelegate
coreNodeKeysBySchedule @ShelleyEra forall era.
(EraPParams era, ProtVerAtMost era 4, ProtVerAtMost era 6) =>
PParams era
ppEx Word64
410) Word64
2 (Word -> KESPeriod
KESPeriod Word
20))

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

expectedStEx9 :: ChainState ShelleyEra
expectedStEx9 :: ChainState ShelleyEra
expectedStEx9 =
  forall era.
(ProtVerAtMost era 6, EraGov era) =>
Block (BHeader MockCrypto) era -> ChainState era -> ChainState era
C.newEpoch Block (BHeader MockCrypto) ShelleyEra
blockEx9
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. SnapShot -> Coin -> ChainState era -> ChainState era
C.newSnapshot SnapShot
snapEx9 (Integer -> Coin
Coin Integer
0)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
EraGov era =>
RewardUpdate -> ChainState era -> ChainState era
C.applyRewardUpdate RewardUpdate
rewardUpdateEx8
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
KeyHash 'BlockIssuer -> Word64 -> ChainState era -> ChainState era
C.setOCertCounter forall {r' :: KeyRole}. KeyHash r'
coreNodeHK Word64
2
    forall a b. (a -> b) -> a -> b
$ ChainState ShelleyEra
expectedStEx8
  where
    coreNodeHK :: KeyHash r'
coreNodeHK = forall (a :: KeyRole -> *) (r :: KeyRole) (r' :: KeyRole).
HasKeyRole a =>
a r -> a r'
coerceKeyRole forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c (r :: KeyRole). AllIssuerKeys c r -> KeyHash r
aikColdKeyHash forall a b. (a -> b) -> a -> b
$ forall era.
(HasCallStack, EraPParams era) =>
PParams era -> Word64 -> AllIssuerKeys MockCrypto 'GenesisDelegate
coreNodeKeysBySchedule @ShelleyEra 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 :: CHAINExample ShelleyEra
poolLifetime9 :: CHAINExample ShelleyEra
poolLifetime9 = forall era.
ChainState era
-> Block (BHeader MockCrypto) era
-> Either
     (NonEmpty (PredicateFailure (CHAIN era))) (ChainState era)
-> CHAINExample era
CHAINExample ChainState ShelleyEra
expectedStEx8 Block (BHeader MockCrypto) ShelleyEra
blockEx9 (forall a b. b -> Either a b
Right ChainState ShelleyEra
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 :: ShelleyTxBody ShelleyEra
txbodyEx10 :: ShelleyTxBody ShelleyEra
txbodyEx10 =
  forall era.
(EraTxOut era, EncCBOR (TxCert era)) =>
Set TxIn
-> StrictSeq (TxOut era)
-> StrictSeq (TxCert era)
-> Withdrawals
-> Coin
-> SlotNo
-> StrictMaybe (Update era)
-> StrictMaybe TxAuxDataHash
-> ShelleyTxBody era
ShelleyTxBody
    (forall a. Ord a => [a] -> Set a
Set.fromList [HasCallStack => TxId -> Integer -> TxIn
mkTxInPartial TxId
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 -> Value era -> ShelleyTxOut era
ShelleyTxOut Addr
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 =>
Credential 'Staking -> TxCert era
UnRegTxCert Credential 'Staking
Cast.bobSHK])
    (Map RewardAccount Coin -> Withdrawals
Withdrawals forall a b. (a -> b) -> a -> b
$ forall k a. k -> a -> Map k a
Map.singleton (Network -> Credential 'Staking -> RewardAccount
RewardAccount Network
Testnet Credential 'Staking
Cast.bobSHK) Coin
bobRAcnt8)
    Coin
feeTx10
    (Word64 -> SlotNo
SlotNo Word64
500)
    forall a. StrictMaybe a
SNothing
    forall a. StrictMaybe a
SNothing

txEx10 :: ShelleyTx ShelleyEra
txEx10 :: ShelleyTx ShelleyEra
txEx10 =
  forall era.
EraTx era =>
TxBody era
-> TxWits era -> StrictMaybe (TxAuxData era) -> ShelleyTx era
ShelleyTx
    ShelleyTxBody ShelleyEra
txbodyEx10
    forall a. Monoid a => a
mempty
      { addrWits :: Set (WitVKey 'Witness)
addrWits =
          forall (kr :: KeyRole).
SafeHash EraIndependentTxBody
-> [KeyPair kr] -> Set (WitVKey 'Witness)
mkWitnessesVKey (forall x i. HashAnnotated x i => x -> SafeHash i
hashAnnotated ShelleyTxBody ShelleyEra
txbodyEx10) [forall (a :: KeyRole -> *) (r :: KeyRole).
HasKeyRole a =>
a r -> a 'Witness
asWitness KeyPair 'Payment
Cast.bobPay, forall (a :: KeyRole -> *) (r :: KeyRole).
HasKeyRole a =>
a r -> a 'Witness
asWitness KeyPair 'Staking
Cast.bobStake]
      }
    forall a. StrictMaybe a
SNothing

blockEx10 :: Block (BHeader MockCrypto) ShelleyEra
blockEx10 :: Block (BHeader MockCrypto) ShelleyEra
blockEx10 =
  forall era (r :: KeyRole) c.
(Crypto c, EraSegWits era, Signable (VRF c) (WithResult Seed),
 Signable (KES c) (BHBody c)) =>
HashHeader
-> AllIssuerKeys c r
-> [Tx era]
-> SlotNo
-> BlockNo
-> Nonce
-> NatNonce
-> UnitInterval
-> Word
-> Word
-> OCert c
-> Block (BHeader c) era
mkBlockFakeVRF
    (forall c. Crypto c => BHeader c -> HashHeader
bhHash forall a b. (a -> b) -> a -> b
$ forall h era. Block h era -> h
bheader Block (BHeader MockCrypto) ShelleyEra
blockEx9)
    (forall era.
(HasCallStack, EraPParams era) =>
PParams era -> Word64 -> AllIssuerKeys MockCrypto 'GenesisDelegate
coreNodeKeysBySchedule @ShelleyEra forall era.
(EraPParams era, ProtVerAtMost era 4, ProtVerAtMost era 6) =>
PParams era
ppEx Word64
420)
    [ShelleyTx ShelleyEra
txEx10]
    (Word64 -> SlotNo
SlotNo Word64
420)
    (Word64 -> BlockNo
BlockNo Word64
10)
    Nonce
epoch4Nonce
    (Natural -> NatNonce
NatNonce Natural
10)
    forall a. Bounded a => a
minBound
    Word
21
    Word
19
    (forall c (r :: KeyRole).
Crypto c =>
AllIssuerKeys c r -> Word64 -> KESPeriod -> OCert c
mkOCert (forall era.
(HasCallStack, EraPParams era) =>
PParams era -> Word64 -> AllIssuerKeys MockCrypto 'GenesisDelegate
coreNodeKeysBySchedule @ShelleyEra forall era.
(EraPParams era, ProtVerAtMost era 4, ProtVerAtMost era 6) =>
PParams era
ppEx Word64
420) Word64
2 (Word -> KESPeriod
KESPeriod Word
19))

expectedStEx10 :: ChainState ShelleyEra
expectedStEx10 :: ChainState ShelleyEra
expectedStEx10 =
  forall era. Nonce -> ChainState era -> ChainState era
C.evolveNonceUnfrozen (forall era. Block (BHeader MockCrypto) era -> Nonce
getBlockNonce Block (BHeader MockCrypto) ShelleyEra
blockEx10)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
Block (BHeader MockCrypto) era -> ChainState era -> ChainState era
C.newLab Block (BHeader MockCrypto) ShelleyEra
blockEx10
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Credential 'Staking -> ChainState era -> ChainState era
C.deregStakeCred Credential 'Staking
Cast.bobSHK
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
Coin -> Credential 'Staking -> ChainState era -> ChainState era
C.feesAndKeyRefund Coin
feeTx10 Credential 'Staking
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 ShelleyTxBody ShelleyEra
txbodyEx10
    forall a b. (a -> b) -> a -> b
$ ChainState ShelleyEra
expectedStEx9

-- === Block 10, Slot 420, Epoch 4
--
-- Drain Bob's reward account and de-register Bob's stake key.
poolLifetime10 :: CHAINExample ShelleyEra
poolLifetime10 :: CHAINExample ShelleyEra
poolLifetime10 = forall era.
ChainState era
-> Block (BHeader MockCrypto) era
-> Either
     (NonEmpty (PredicateFailure (CHAIN era))) (ChainState era)
-> CHAINExample era
CHAINExample ChainState ShelleyEra
expectedStEx9 Block (BHeader MockCrypto) ShelleyEra
blockEx10 (forall a b. b -> Either a b
Right ChainState ShelleyEra
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 :: ShelleyTxBody ShelleyEra
txbodyEx11 :: ShelleyTxBody ShelleyEra
txbodyEx11 =
  forall era.
(EraTxOut era, EncCBOR (TxCert era)) =>
Set TxIn
-> StrictSeq (TxOut era)
-> StrictSeq (TxCert era)
-> Withdrawals
-> Coin
-> SlotNo
-> StrictMaybe (Update era)
-> StrictMaybe TxAuxDataHash
-> ShelleyTxBody era
ShelleyTxBody
    (forall a. Ord a => [a] -> Set a
Set.fromList [TxId -> TxIx -> TxIn
TxIn (forall era. EraTxBody era => TxBody era -> TxId
txIdTxBody ShelleyTxBody ShelleyEra
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 -> Value era -> ShelleyTxOut era
ShelleyTxOut Addr
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 -> EpochNo -> TxCert era
RetirePoolTxCert (forall c (r :: KeyRole). AllIssuerKeys c r -> KeyHash r
aikColdKeyHash AllIssuerKeys MockCrypto 'StakePool
Cast.alicePoolKeys) EpochNo
aliceRetireEpoch])
    (Map RewardAccount Coin -> Withdrawals
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 :: ShelleyTx ShelleyEra
txEx11 :: ShelleyTx ShelleyEra
txEx11 =
  forall era.
EraTx era =>
TxBody era
-> TxWits era -> StrictMaybe (TxAuxData era) -> ShelleyTx era
ShelleyTx
    ShelleyTxBody ShelleyEra
txbodyEx11
    forall a. Monoid a => a
mempty
      { addrWits :: Set (WitVKey 'Witness)
addrWits =
          forall (kr :: KeyRole).
SafeHash EraIndependentTxBody
-> [KeyPair kr] -> Set (WitVKey 'Witness)
mkWitnessesVKey
            (forall x i. HashAnnotated x i => x -> SafeHash i
hashAnnotated ShelleyTxBody ShelleyEra
txbodyEx11)
            ( [forall (a :: KeyRole -> *) (r :: KeyRole).
HasKeyRole a =>
a r -> a 'Witness
asWitness KeyPair 'Payment
Cast.alicePay]
                forall a. Semigroup a => a -> a -> a
<> [forall (a :: KeyRole -> *) (r :: KeyRole).
HasKeyRole a =>
a r -> a 'Witness
asWitness forall a b. (a -> b) -> a -> b
$ forall c (r :: KeyRole). AllIssuerKeys c r -> KeyPair r
aikCold AllIssuerKeys MockCrypto 'StakePool
Cast.alicePoolKeys]
            )
      }
    forall a. StrictMaybe a
SNothing

blockEx11 :: Block (BHeader MockCrypto) ShelleyEra
blockEx11 :: Block (BHeader MockCrypto) ShelleyEra
blockEx11 =
  forall era (r :: KeyRole) c.
(Crypto c, EraSegWits era, Signable (VRF c) (WithResult Seed),
 Signable (KES c) (BHBody c)) =>
HashHeader
-> AllIssuerKeys c r
-> [Tx era]
-> SlotNo
-> BlockNo
-> Nonce
-> NatNonce
-> UnitInterval
-> Word
-> Word
-> OCert c
-> Block (BHeader c) era
mkBlockFakeVRF
    (forall c. Crypto c => BHeader c -> HashHeader
bhHash forall a b. (a -> b) -> a -> b
$ forall h era. Block h era -> h
bheader Block (BHeader MockCrypto) ShelleyEra
blockEx10)
    (forall era.
(HasCallStack, EraPParams era) =>
PParams era -> Word64 -> AllIssuerKeys MockCrypto 'GenesisDelegate
coreNodeKeysBySchedule @ShelleyEra forall era.
(EraPParams era, ProtVerAtMost era 4, ProtVerAtMost era 6) =>
PParams era
ppEx Word64
490)
    [ShelleyTx ShelleyEra
txEx11]
    (Word64 -> SlotNo
SlotNo Word64
490)
    (Word64 -> BlockNo
BlockNo Word64
11)
    Nonce
epoch4Nonce
    (Natural -> NatNonce
NatNonce Natural
11)
    forall a. Bounded a => a
minBound
    Word
24
    Word
19
    (forall c (r :: KeyRole).
Crypto c =>
AllIssuerKeys c r -> Word64 -> KESPeriod -> OCert c
mkOCert (forall era.
(HasCallStack, EraPParams era) =>
PParams era -> Word64 -> AllIssuerKeys MockCrypto 'GenesisDelegate
coreNodeKeysBySchedule @ShelleyEra 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 :: Likelihood
alicePerfEx11 :: 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 = Stake -> Coin
EB.sumAllStake (SnapShot -> Stake
EB.ssStake SnapShot
snapEx5)
    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 :: NonMyopic
nonMyopicEx11 :: NonMyopic
nonMyopicEx11 =
  Map (KeyHash 'StakePool) Likelihood -> Coin -> NonMyopic
NonMyopic
    (forall k a. k -> a -> Map k a
Map.singleton (forall c (r :: KeyRole). AllIssuerKeys c r -> KeyHash r
aikColdKeyHash AllIssuerKeys MockCrypto 'StakePool
Cast.alicePoolKeys) Likelihood
alicePerfEx11)
    (Integer -> Coin
Coin Integer
0)

pulserEx11 :: PulsingRewUpdate
pulserEx11 :: PulsingRewUpdate
pulserEx11 = forall era.
EraGov era =>
BlocksMade -> ChainState era -> PulsingRewUpdate
makeCompletedPulser (Map (KeyHash 'StakePool) Natural -> BlocksMade
BlocksMade forall a. Monoid a => a
mempty) ChainState ShelleyEra
expectedStEx10

rewardUpdateEx11 :: RewardUpdate
rewardUpdateEx11 :: RewardUpdate
rewardUpdateEx11 =
  RewardUpdate
    { deltaT :: DeltaCoin
deltaT = Integer -> DeltaCoin
DeltaCoin Integer
0
    , deltaR :: DeltaCoin
deltaR = Integer -> DeltaCoin
DeltaCoin Integer
0
    , rs :: RewardEvent
rs = forall k a. Map k a
Map.empty
    , deltaF :: DeltaCoin
deltaF = Integer -> DeltaCoin
DeltaCoin Integer
0
    , nonMyopic :: NonMyopic
nonMyopic = NonMyopic
nonMyopicEx11
    }

expectedStEx11 :: ChainState ShelleyEra
expectedStEx11 :: ChainState ShelleyEra
expectedStEx11 =
  forall era. Nonce -> ChainState era -> ChainState era
C.evolveNonceFrozen (forall era. Block (BHeader MockCrypto) era -> Nonce
getBlockNonce Block (BHeader MockCrypto) ShelleyEra
blockEx11)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
Block (BHeader MockCrypto) era -> ChainState era -> ChainState era
C.newLab Block (BHeader MockCrypto) ShelleyEra
blockEx11
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
EraPParams era =>
PParams era
-> Coin
-> [Credential 'Staking]
-> [PoolParams]
-> 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 ShelleyTxBody ShelleyEra
txbodyEx11
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. PulsingRewUpdate -> ChainState era -> ChainState era
C.pulserUpdate PulsingRewUpdate
pulserEx11
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
KeyHash 'StakePool -> EpochNo -> ChainState era -> ChainState era
C.stageRetirement (forall c (r :: KeyRole). AllIssuerKeys c r -> KeyHash r
aikColdKeyHash AllIssuerKeys MockCrypto 'StakePool
Cast.alicePoolKeys) EpochNo
aliceRetireEpoch
    forall a b. (a -> b) -> a -> b
$ ChainState ShelleyEra
expectedStEx10

-- === Block 11, Slot 490, Epoch 4
--
-- Stage the retirement of Alice's stake pool.
poolLifetime11 :: CHAINExample ShelleyEra
poolLifetime11 :: CHAINExample ShelleyEra
poolLifetime11 = forall era.
ChainState era
-> Block (BHeader MockCrypto) era
-> Either
     (NonEmpty (PredicateFailure (CHAIN era))) (ChainState era)
-> CHAINExample era
CHAINExample ChainState ShelleyEra
expectedStEx10 Block (BHeader MockCrypto) ShelleyEra
blockEx11 (forall a b. b -> Either a b
Right (forall era. EraGov era => ChainState era -> ChainState era
C.solidifyProposals ChainState ShelleyEra
expectedStEx11))

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

epoch5Nonce :: Nonce
epoch5Nonce :: Nonce
epoch5Nonce =
  forall era. ChainState era -> Nonce
chainCandidateNonce ChainState ShelleyEra
expectedStEx11
    Nonce -> Nonce -> Nonce
⭒ HashHeader -> Nonce
hashHeaderToNonce (forall c. Crypto c => BHeader c -> HashHeader
bhHash forall a b. (a -> b) -> a -> b
$ forall h era. Block h era -> h
bheader Block (BHeader MockCrypto) ShelleyEra
blockEx8)

blockEx12 :: Block (BHeader MockCrypto) ShelleyEra
blockEx12 :: Block (BHeader MockCrypto) ShelleyEra
blockEx12 =
  forall era (r :: KeyRole) c.
(Crypto c, EraSegWits era, Signable (VRF c) (WithResult Seed),
 Signable (KES c) (BHBody c)) =>
HashHeader
-> AllIssuerKeys c r
-> [Tx era]
-> SlotNo
-> BlockNo
-> Nonce
-> NatNonce
-> UnitInterval
-> Word
-> Word
-> OCert c
-> Block (BHeader c) era
mkBlockFakeVRF
    (forall c. Crypto c => BHeader c -> HashHeader
bhHash forall a b. (a -> b) -> a -> b
$ forall h era. Block h era -> h
bheader Block (BHeader MockCrypto) ShelleyEra
blockEx11)
    (forall era.
(HasCallStack, EraPParams era) =>
PParams era -> Word64 -> AllIssuerKeys MockCrypto 'GenesisDelegate
coreNodeKeysBySchedule @ShelleyEra 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)
    Nonce
epoch5Nonce
    (Natural -> NatNonce
NatNonce Natural
12)
    forall a. Bounded a => a
minBound
    Word
25
    Word
25
    (forall c (r :: KeyRole).
Crypto c =>
AllIssuerKeys c r -> Word64 -> KESPeriod -> OCert c
mkOCert (forall era.
(HasCallStack, EraPParams era) =>
PParams era -> Word64 -> AllIssuerKeys MockCrypto 'GenesisDelegate
coreNodeKeysBySchedule @ShelleyEra forall era.
(EraPParams era, ProtVerAtMost era 4, ProtVerAtMost era 6) =>
PParams era
ppEx Word64
510) Word64
3 (Word -> KESPeriod
KESPeriod Word
25))

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

expectedStEx12 :: ChainState ShelleyEra
expectedStEx12 :: ChainState ShelleyEra
expectedStEx12 =
  forall era.
(ProtVerAtMost era 6, EraGov era) =>
Block (BHeader MockCrypto) era -> ChainState era -> ChainState era
C.newEpoch Block (BHeader MockCrypto) ShelleyEra
blockEx12
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. SnapShot -> Coin -> ChainState era -> ChainState era
C.newSnapshot SnapShot
snapEx12 (Integer -> Coin
Coin Integer
11)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
EraGov era =>
RewardUpdate -> ChainState era -> ChainState era
C.applyRewardUpdate RewardUpdate
rewardUpdateEx11
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
KeyHash 'BlockIssuer -> Word64 -> ChainState era -> ChainState era
C.setOCertCounter forall {r' :: KeyRole}. KeyHash r'
coreNodeHK Word64
3
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
EraGov era =>
PoolParams -> ChainState era -> ChainState era
C.reapPool PoolParams
Cast.alicePoolParams
    forall a b. (a -> b) -> a -> b
$ ChainState ShelleyEra
expectedStEx11
  where
    coreNodeHK :: KeyHash r'
coreNodeHK = forall (a :: KeyRole -> *) (r :: KeyRole) (r' :: KeyRole).
HasKeyRole a =>
a r -> a r'
coerceKeyRole forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c (r :: KeyRole). AllIssuerKeys c r -> KeyHash r
aikColdKeyHash forall a b. (a -> b) -> a -> b
$ forall era.
(HasCallStack, EraPParams era) =>
PParams era -> Word64 -> AllIssuerKeys MockCrypto 'GenesisDelegate
coreNodeKeysBySchedule @ShelleyEra 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 :: CHAINExample ShelleyEra
poolLifetime12 :: CHAINExample ShelleyEra
poolLifetime12 = forall era.
ChainState era
-> Block (BHeader MockCrypto) era
-> Either
     (NonEmpty (PredicateFailure (CHAIN era))) (ChainState era)
-> CHAINExample era
CHAINExample ChainState ShelleyEra
expectedStEx11 Block (BHeader MockCrypto) ShelleyEra
blockEx12 (forall a b. b -> Either a b
Right ChainState ShelleyEra
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 ShelleyEra -> Assertion
testCHAINExample CHAINExample ShelleyEra
poolLifetime1
    , [Char] -> Assertion -> TestTree
testCase [Char]
"delegate stake and create reward update" forall a b. (a -> b) -> a -> b
$ HasCallStack => CHAINExample ShelleyEra -> Assertion
testCHAINExample CHAINExample ShelleyEra
poolLifetime2
    , [Char] -> Assertion -> TestTree
testCase [Char]
"new epoch changes" forall a b. (a -> b) -> a -> b
$ HasCallStack => CHAINExample ShelleyEra -> Assertion
testCHAINExample CHAINExample ShelleyEra
poolLifetime3
    , [Char] -> Assertion -> TestTree
testCase [Char]
"second reward update" forall a b. (a -> b) -> a -> b
$ HasCallStack => CHAINExample ShelleyEra -> Assertion
testCHAINExample CHAINExample ShelleyEra
poolLifetime4
    , [Char] -> Assertion -> TestTree
testCase [Char]
"nonempty pool distr" forall a b. (a -> b) -> a -> b
$ HasCallStack => CHAINExample ShelleyEra -> Assertion
testCHAINExample CHAINExample ShelleyEra
poolLifetime5
    , [Char] -> Assertion -> TestTree
testCase [Char]
"decentralized block" forall a b. (a -> b) -> a -> b
$ HasCallStack => CHAINExample ShelleyEra -> Assertion
testCHAINExample CHAINExample ShelleyEra
poolLifetime6
    , [Char] -> Assertion -> TestTree
testCase [Char]
"prelude to the first nontrivial rewards" forall a b. (a -> b) -> a -> b
$ HasCallStack => CHAINExample ShelleyEra -> Assertion
testCHAINExample CHAINExample ShelleyEra
poolLifetime7
    , [Char] -> Assertion -> TestTree
testCase [Char]
"create a nontrivial rewards" forall a b. (a -> b) -> a -> b
$ HasCallStack => CHAINExample ShelleyEra -> Assertion
testCHAINExample CHAINExample ShelleyEra
poolLifetime8
    , [Char] -> Assertion -> TestTree
testCase [Char]
"apply a nontrivial rewards" forall a b. (a -> b) -> a -> b
$ HasCallStack => CHAINExample ShelleyEra -> Assertion
testCHAINExample CHAINExample ShelleyEra
poolLifetime9
    , [Char] -> Assertion -> TestTree
testCase [Char]
"drain reward account and deregister" forall a b. (a -> b) -> a -> b
$ HasCallStack => CHAINExample ShelleyEra -> Assertion
testCHAINExample CHAINExample ShelleyEra
poolLifetime10
    , [Char] -> Assertion -> TestTree
testCase [Char]
"stage stake pool retirement" forall a b. (a -> b) -> a -> b
$ HasCallStack => CHAINExample ShelleyEra -> Assertion
testCHAINExample CHAINExample ShelleyEra
poolLifetime11
    , [Char] -> Assertion -> TestTree
testCase [Char]
"reap stake pool" forall a b. (a -> b) -> a -> b
$ HasCallStack => CHAINExample ShelleyEra -> Assertion
testCHAINExample CHAINExample ShelleyEra
poolLifetime12
    ]