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

-- |
-- Module      : Test.Cardano.Ledger.Shelley.Examples.Updates
-- Description : Protocol Parameter Update Example
--
-- Example demonstrating using the protocol parameter update system.
module Test.Cardano.Ledger.Shelley.Examples.Updates (
  updatesExample,
  updates4,
) where

import Cardano.Ledger.BaseTypes (
  BlocksMade (..),
  Nonce,
  StrictMaybe (..),
  mkNonceFromNumber,
  (⭒),
 )
import Cardano.Ledger.Block (Block, bheader)
import Cardano.Ledger.Coin (Coin (..))
import Cardano.Ledger.Keys (asWitness)
import Cardano.Ledger.Shelley (ShelleyEra)
import Cardano.Ledger.Shelley.Core
import Cardano.Ledger.Shelley.LedgerState (PulsingRewUpdate, emptyRewardUpdate)
import Cardano.Ledger.Shelley.PParams (ProposedPPUpdates (..), Update (..))
import Cardano.Ledger.Shelley.Tx (ShelleyTx (..))
import Cardano.Ledger.Shelley.TxBody (TxBody (..))
import Cardano.Ledger.Shelley.TxOut (ShelleyTxOut (..))
import Cardano.Ledger.Shelley.TxWits (addrWits)
import Cardano.Ledger.Slot (
  BlockNo (..),
  EpochNo (..),
  SlotNo (..),
 )
import Cardano.Ledger.State
import Cardano.Ledger.TxIn (TxIn (..))
import Cardano.Ledger.Val ((<+>), (<->))
import qualified Cardano.Ledger.Val as Val
import Cardano.Protocol.TPraos.BHeader (BHeader, bhHash)
import Cardano.Protocol.TPraos.OCert (KESPeriod (..))
import qualified Data.Map.Strict as Map
import qualified Data.Sequence.Strict as StrictSeq
import qualified Data.Set as Set
import Lens.Micro ((&), (.~))
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,
  coreNodeVK,
 )
import Test.Cardano.Ledger.Shelley.Examples.Init (
  initSt,
  lastByronHeaderHash,
  nonce0,
  ppEx,
 )
import Test.Cardano.Ledger.Shelley.Examples.PoolLifetime (makeCompletedPulser)
import Test.Cardano.Ledger.Shelley.Generator.Core (
  AllIssuerKeys (..),
  NatNonce (..),
  genesisCoins,
  mkBlockFakeVRF,
  mkOCert,
 )
import Test.Cardano.Ledger.Shelley.Generator.EraGen (genesisId)
import Test.Cardano.Ledger.Shelley.Generator.ShelleyEraGen ()
import Test.Cardano.Ledger.Shelley.Rules.Chain (ChainState (..))
import Test.Cardano.Ledger.Shelley.Utils (getBlockNonce)
import Test.Tasty (TestTree, testGroup)
import Test.Tasty.HUnit (testCase)

aliceInitCoin :: Coin
aliceInitCoin :: Coin
aliceInitCoin = Integer -> Coin
Coin (Integer -> Coin) -> Integer -> Coin
forall a b. (a -> b) -> a -> b
$ Integer
10 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
1000 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
1000 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
1000 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
1000 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
1000

bobInitCoin :: Coin
bobInitCoin :: Coin
bobInitCoin = Integer -> Coin
Coin (Integer -> Coin) -> Integer -> Coin
forall a b. (a -> b) -> a -> b
$ Integer
1 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
1000 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
1000 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
1000 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
1000 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
1000

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

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

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

ppVoteA :: PParamsUpdate ShelleyEra
ppVoteA :: PParamsUpdate ShelleyEra
ppVoteA =
  PParamsUpdate ShelleyEra
forall era. EraPParams era => PParamsUpdate era
emptyPParamsUpdate
    PParamsUpdate ShelleyEra
-> (PParamsUpdate ShelleyEra -> PParamsUpdate ShelleyEra)
-> PParamsUpdate ShelleyEra
forall a b. a -> (a -> b) -> b
& (StrictMaybe Coin -> Identity (StrictMaybe Coin))
-> PParamsUpdate ShelleyEra -> Identity (PParamsUpdate ShelleyEra)
forall era.
EraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Coin)
Lens' (PParamsUpdate ShelleyEra) (StrictMaybe Coin)
ppuPoolDepositL ((StrictMaybe Coin -> Identity (StrictMaybe Coin))
 -> PParamsUpdate ShelleyEra -> Identity (PParamsUpdate ShelleyEra))
-> StrictMaybe Coin
-> PParamsUpdate ShelleyEra
-> PParamsUpdate ShelleyEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Coin -> StrictMaybe Coin
forall a. a -> StrictMaybe a
SJust (Integer -> Coin
Coin Integer
200)
    PParamsUpdate ShelleyEra
-> (PParamsUpdate ShelleyEra -> PParamsUpdate ShelleyEra)
-> PParamsUpdate ShelleyEra
forall a b. a -> (a -> b) -> b
& (StrictMaybe Nonce -> Identity (StrictMaybe Nonce))
-> PParamsUpdate ShelleyEra -> Identity (PParamsUpdate ShelleyEra)
forall era.
(EraPParams era, ProtVerAtMost era 6) =>
Lens' (PParamsUpdate era) (StrictMaybe Nonce)
Lens' (PParamsUpdate ShelleyEra) (StrictMaybe Nonce)
ppuExtraEntropyL ((StrictMaybe Nonce -> Identity (StrictMaybe Nonce))
 -> PParamsUpdate ShelleyEra -> Identity (PParamsUpdate ShelleyEra))
-> StrictMaybe Nonce
-> PParamsUpdate ShelleyEra
-> PParamsUpdate ShelleyEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Nonce -> StrictMaybe Nonce
forall a. a -> StrictMaybe a
SJust (Word64 -> Nonce
mkNonceFromNumber Word64
123)

collectVotes ::
  PParamsUpdate ShelleyEra ->
  [Int] ->
  ProposedPPUpdates ShelleyEra
collectVotes :: PParamsUpdate ShelleyEra -> [Int] -> ProposedPPUpdates ShelleyEra
collectVotes PParamsUpdate ShelleyEra
vote =
  Map (KeyHash 'Genesis) (PParamsUpdate ShelleyEra)
-> ProposedPPUpdates ShelleyEra
forall era.
Map (KeyHash 'Genesis) (PParamsUpdate era) -> ProposedPPUpdates era
ProposedPPUpdates (Map (KeyHash 'Genesis) (PParamsUpdate ShelleyEra)
 -> ProposedPPUpdates ShelleyEra)
-> ([Int] -> Map (KeyHash 'Genesis) (PParamsUpdate ShelleyEra))
-> [Int]
-> ProposedPPUpdates ShelleyEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(KeyHash 'Genesis, PParamsUpdate ShelleyEra)]
-> Map (KeyHash 'Genesis) (PParamsUpdate ShelleyEra)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(KeyHash 'Genesis, PParamsUpdate ShelleyEra)]
 -> Map (KeyHash 'Genesis) (PParamsUpdate ShelleyEra))
-> ([Int] -> [(KeyHash 'Genesis, PParamsUpdate ShelleyEra)])
-> [Int]
-> Map (KeyHash 'Genesis) (PParamsUpdate ShelleyEra)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int -> (KeyHash 'Genesis, PParamsUpdate ShelleyEra))
-> [Int] -> [(KeyHash 'Genesis, PParamsUpdate ShelleyEra)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Int
n -> (VKey 'Genesis -> KeyHash 'Genesis
forall (kd :: KeyRole). VKey kd -> KeyHash kd
hashKey (VKey 'Genesis -> KeyHash 'Genesis)
-> VKey 'Genesis -> KeyHash 'Genesis
forall a b. (a -> b) -> a -> b
$ Int -> VKey 'Genesis
coreNodeVK Int
n, PParamsUpdate ShelleyEra
vote)))

ppVotes1 :: ProposedPPUpdates ShelleyEra
ppVotes1 :: ProposedPPUpdates ShelleyEra
ppVotes1 = PParamsUpdate ShelleyEra -> [Int] -> ProposedPPUpdates ShelleyEra
collectVotes PParamsUpdate ShelleyEra
ppVoteA [Int
0, Int
3, Int
4]

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

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

txbodyEx1 :: TxBody ShelleyEra
txbodyEx1 :: TxBody ShelleyEra
txbodyEx1 =
  Set TxIn
-> StrictSeq (TxOut ShelleyEra)
-> StrictSeq (TxCert ShelleyEra)
-> Withdrawals
-> Coin
-> SlotNo
-> StrictMaybe (Update ShelleyEra)
-> StrictMaybe TxAuxDataHash
-> TxBody ShelleyEra
ShelleyTxBody
    ([TxIn] -> Set TxIn
forall a. Ord a => [a] -> Set a
Set.fromList [TxId -> TxIx -> TxIn
TxIn TxId
genesisId TxIx
forall a. Bounded a => a
minBound])
    (TxOut ShelleyEra -> StrictSeq (TxOut ShelleyEra)
forall a. a -> StrictSeq a
StrictSeq.singleton (TxOut ShelleyEra -> StrictSeq (TxOut ShelleyEra))
-> TxOut ShelleyEra -> StrictSeq (TxOut ShelleyEra)
forall a b. (a -> b) -> a -> b
$ Addr -> Value ShelleyEra -> ShelleyTxOut ShelleyEra
forall era.
(HasCallStack, Era era, Val (Value era)) =>
Addr -> Value era -> ShelleyTxOut era
ShelleyTxOut Addr
Cast.aliceAddr (Coin -> Coin
forall t s. Inject t s => t -> s
Val.inject Coin
aliceCoinEx1))
    StrictSeq (TxCert ShelleyEra)
StrictSeq (ShelleyTxCert ShelleyEra)
forall a. StrictSeq a
StrictSeq.empty
    (Map RewardAccount Coin -> Withdrawals
Withdrawals Map RewardAccount Coin
forall k a. Map k a
Map.empty)
    Coin
feeTx1
    (Word64 -> SlotNo
SlotNo Word64
10)
    (Update ShelleyEra -> StrictMaybe (Update ShelleyEra)
forall a. a -> StrictMaybe a
SJust (ProposedPPUpdates ShelleyEra -> EpochNo -> Update ShelleyEra
forall era. ProposedPPUpdates era -> EpochNo -> Update era
Update ProposedPPUpdates ShelleyEra
ppVotes1 (Word64 -> EpochNo
EpochNo Word64
0)))
    StrictMaybe TxAuxDataHash
forall a. StrictMaybe a
SNothing

txEx1 :: ShelleyTx ShelleyEra
txEx1 :: ShelleyTx ShelleyEra
txEx1 =
  TxBody ShelleyEra
-> TxWits ShelleyEra
-> StrictMaybe (TxAuxData ShelleyEra)
-> ShelleyTx ShelleyEra
forall era.
EraTx era =>
TxBody era
-> TxWits era -> StrictMaybe (TxAuxData era) -> ShelleyTx era
ShelleyTx
    TxBody ShelleyEra
txbodyEx1
    ShelleyTxWits ShelleyEra
forall a. Monoid a => a
mempty
      { addrWits =
          mkWitnessesVKey
            (hashAnnotated txbodyEx1)
            ( [asWitness Cast.alicePay]
                <> [ asWitness . aikCold $ coreNodeIssuerKeys 0
                   , asWitness . aikCold $ coreNodeIssuerKeys 3
                   , asWitness . aikCold $ coreNodeIssuerKeys 4
                   ]
            )
      }
    StrictMaybe (TxAuxData ShelleyEra)
StrictMaybe (ShelleyTxAuxData ShelleyEra)
forall a. StrictMaybe a
SNothing

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

expectedStEx1 :: ChainState ShelleyEra
expectedStEx1 :: ChainState ShelleyEra
expectedStEx1 =
  Nonce -> ChainState ShelleyEra -> ChainState ShelleyEra
forall era. Nonce -> ChainState era -> ChainState era
C.evolveNonceUnfrozen (Block (BHeader MockCrypto) ShelleyEra -> Nonce
forall era. Block (BHeader MockCrypto) era -> Nonce
getBlockNonce Block (BHeader MockCrypto) ShelleyEra
blockEx1)
    (ChainState ShelleyEra -> ChainState ShelleyEra)
-> (ChainState ShelleyEra -> ChainState ShelleyEra)
-> ChainState ShelleyEra
-> ChainState ShelleyEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Block (BHeader MockCrypto) ShelleyEra
-> ChainState ShelleyEra -> ChainState ShelleyEra
forall era.
Block (BHeader MockCrypto) era -> ChainState era -> ChainState era
C.newLab Block (BHeader MockCrypto) ShelleyEra
blockEx1
    (ChainState ShelleyEra -> ChainState ShelleyEra)
-> (ChainState ShelleyEra -> ChainState ShelleyEra)
-> ChainState ShelleyEra
-> ChainState ShelleyEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PParams ShelleyEra
-> Coin
-> [Credential 'Staking]
-> [PoolParams]
-> ChainState ShelleyEra
-> ChainState ShelleyEra
forall era.
(EraPParams era, EraCertState era) =>
PParams era
-> Coin
-> [Credential 'Staking]
-> [PoolParams]
-> ChainState era
-> ChainState era
C.feesAndDeposits PParams ShelleyEra
forall era.
(EraPParams era, ProtVerAtMost era 4, ProtVerAtMost era 6) =>
PParams era
ppEx Coin
feeTx1 [] []
    (ChainState ShelleyEra -> ChainState ShelleyEra)
-> (ChainState ShelleyEra -> ChainState ShelleyEra)
-> ChainState ShelleyEra
-> ChainState ShelleyEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxBody ShelleyEra -> ChainState ShelleyEra -> ChainState ShelleyEra
forall era.
(EraTx era, EraStake era) =>
TxBody era -> ChainState era -> ChainState era
C.newUTxO TxBody ShelleyEra
txbodyEx1
    (ChainState ShelleyEra -> ChainState ShelleyEra)
-> (ChainState ShelleyEra -> ChainState ShelleyEra)
-> ChainState ShelleyEra
-> ChainState ShelleyEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProposedPPUpdates ShelleyEra
-> ChainState ShelleyEra -> ChainState ShelleyEra
forall era.
(GovState era ~ ShelleyGovState era, EraPParams era) =>
ProposedPPUpdates era -> ChainState era -> ChainState era
C.setCurrentProposals ProposedPPUpdates ShelleyEra
ppVotes1
    (ChainState ShelleyEra -> ChainState ShelleyEra)
-> ChainState ShelleyEra -> ChainState ShelleyEra
forall a b. (a -> b) -> a -> b
$ ChainState ShelleyEra
initStUpdates

-- === Block 1, Slot 10, Epoch 0
--
-- In the first block, three genesis keys vote on the same new parameters.
updates1 :: CHAINExample ShelleyEra
updates1 :: CHAINExample ShelleyEra
updates1 = ChainState ShelleyEra
-> Block (BHeader MockCrypto) ShelleyEra
-> Either
     (NonEmpty (PredicateFailure (CHAIN ShelleyEra)))
     (ChainState ShelleyEra)
-> CHAINExample ShelleyEra
forall era.
ChainState era
-> Block (BHeader MockCrypto) era
-> Either
     (NonEmpty (PredicateFailure (CHAIN era))) (ChainState era)
-> CHAINExample era
CHAINExample ChainState ShelleyEra
initStUpdates Block (BHeader MockCrypto) ShelleyEra
blockEx1 (ChainState ShelleyEra
-> Either
     (NonEmpty (TestChainPredicateFailure ShelleyEra))
     (ChainState ShelleyEra)
forall a b. b -> Either a b
Right ChainState ShelleyEra
expectedStEx1)

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

ppVotes2 :: ProposedPPUpdates ShelleyEra
ppVotes2 :: ProposedPPUpdates ShelleyEra
ppVotes2 = PParamsUpdate ShelleyEra -> [Int] -> ProposedPPUpdates ShelleyEra
collectVotes PParamsUpdate ShelleyEra
ppVoteA [Int
1, Int
5]

updateEx3B :: Update ShelleyEra
updateEx3B :: Update ShelleyEra
updateEx3B = ProposedPPUpdates ShelleyEra -> EpochNo -> Update ShelleyEra
forall era. ProposedPPUpdates era -> EpochNo -> Update era
Update ProposedPPUpdates ShelleyEra
ppVotes2 (Word64 -> EpochNo
EpochNo Word64
0)

feeTx2 :: Coin
feeTx2 :: Coin
feeTx2 = Integer -> Coin
Coin Integer
1

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

txbodyEx2 :: TxBody ShelleyEra
txbodyEx2 :: TxBody ShelleyEra
txbodyEx2 =
  Set TxIn
-> StrictSeq (TxOut ShelleyEra)
-> StrictSeq (TxCert ShelleyEra)
-> Withdrawals
-> Coin
-> SlotNo
-> StrictMaybe (Update ShelleyEra)
-> StrictMaybe TxAuxDataHash
-> TxBody ShelleyEra
ShelleyTxBody
    ([TxIn] -> Set TxIn
forall a. Ord a => [a] -> Set a
Set.fromList [TxId -> TxIx -> TxIn
TxIn (TxBody ShelleyEra -> TxId
forall era. EraTxBody era => TxBody era -> TxId
txIdTxBody TxBody ShelleyEra
txbodyEx1) TxIx
forall a. Bounded a => a
minBound])
    (TxOut ShelleyEra -> StrictSeq (TxOut ShelleyEra)
forall a. a -> StrictSeq a
StrictSeq.singleton (TxOut ShelleyEra -> StrictSeq (TxOut ShelleyEra))
-> TxOut ShelleyEra -> StrictSeq (TxOut ShelleyEra)
forall a b. (a -> b) -> a -> b
$ Addr -> Value ShelleyEra -> ShelleyTxOut ShelleyEra
forall era.
(HasCallStack, Era era, Val (Value era)) =>
Addr -> Value era -> ShelleyTxOut era
ShelleyTxOut Addr
Cast.aliceAddr (Coin -> Coin
forall t s. Inject t s => t -> s
Val.inject Coin
aliceCoinEx2))
    StrictSeq (TxCert ShelleyEra)
StrictSeq (ShelleyTxCert ShelleyEra)
forall a. StrictSeq a
StrictSeq.empty
    (Map RewardAccount Coin -> Withdrawals
Withdrawals Map RewardAccount Coin
forall k a. Map k a
Map.empty)
    (Integer -> Coin
Coin Integer
1)
    (Word64 -> SlotNo
SlotNo Word64
31)
    (Update ShelleyEra -> StrictMaybe (Update ShelleyEra)
forall a. a -> StrictMaybe a
SJust Update ShelleyEra
updateEx3B)
    StrictMaybe TxAuxDataHash
forall a. StrictMaybe a
SNothing

txEx2 :: ShelleyTx ShelleyEra
txEx2 :: ShelleyTx ShelleyEra
txEx2 =
  TxBody ShelleyEra
-> TxWits ShelleyEra
-> StrictMaybe (TxAuxData ShelleyEra)
-> ShelleyTx ShelleyEra
forall era.
EraTx era =>
TxBody era
-> TxWits era -> StrictMaybe (TxAuxData era) -> ShelleyTx era
ShelleyTx
    TxBody ShelleyEra
txbodyEx2
    ShelleyTxWits ShelleyEra
forall a. Monoid a => a
mempty
      { addrWits =
          mkWitnessesVKey
            (hashAnnotated txbodyEx2)
            ( [asWitness Cast.alicePay]
                <> [ asWitness . aikCold $ coreNodeIssuerKeys 1
                   , asWitness . aikCold $ coreNodeIssuerKeys 5
                   ]
            )
      }
    StrictMaybe (TxAuxData ShelleyEra)
StrictMaybe (ShelleyTxAuxData ShelleyEra)
forall a. StrictMaybe a
SNothing

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

expectedStEx2 :: ChainState ShelleyEra
expectedStEx2 :: ChainState ShelleyEra
expectedStEx2 =
  Nonce -> ChainState ShelleyEra -> ChainState ShelleyEra
forall era. Nonce -> ChainState era -> ChainState era
C.evolveNonceUnfrozen (Block (BHeader MockCrypto) ShelleyEra -> Nonce
forall era. Block (BHeader MockCrypto) era -> Nonce
getBlockNonce Block (BHeader MockCrypto) ShelleyEra
blockEx2)
    (ChainState ShelleyEra -> ChainState ShelleyEra)
-> (ChainState ShelleyEra -> ChainState ShelleyEra)
-> ChainState ShelleyEra
-> ChainState ShelleyEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Block (BHeader MockCrypto) ShelleyEra
-> ChainState ShelleyEra -> ChainState ShelleyEra
forall era.
Block (BHeader MockCrypto) era -> ChainState era -> ChainState era
C.newLab Block (BHeader MockCrypto) ShelleyEra
blockEx2
    (ChainState ShelleyEra -> ChainState ShelleyEra)
-> (ChainState ShelleyEra -> ChainState ShelleyEra)
-> ChainState ShelleyEra
-> ChainState ShelleyEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PParams ShelleyEra
-> Coin
-> [Credential 'Staking]
-> [PoolParams]
-> ChainState ShelleyEra
-> ChainState ShelleyEra
forall era.
(EraPParams era, EraCertState era) =>
PParams era
-> Coin
-> [Credential 'Staking]
-> [PoolParams]
-> ChainState era
-> ChainState era
C.feesAndDeposits PParams ShelleyEra
forall era.
(EraPParams era, ProtVerAtMost era 4, ProtVerAtMost era 6) =>
PParams era
ppEx Coin
feeTx2 [] []
    (ChainState ShelleyEra -> ChainState ShelleyEra)
-> (ChainState ShelleyEra -> ChainState ShelleyEra)
-> ChainState ShelleyEra
-> ChainState ShelleyEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxBody ShelleyEra -> ChainState ShelleyEra -> ChainState ShelleyEra
forall era.
(EraTx era, EraStake era) =>
TxBody era -> ChainState era -> ChainState era
C.newUTxO TxBody ShelleyEra
txbodyEx2
    (ChainState ShelleyEra -> ChainState ShelleyEra)
-> (ChainState ShelleyEra -> ChainState ShelleyEra)
-> ChainState ShelleyEra
-> ChainState ShelleyEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProposedPPUpdates ShelleyEra
-> ChainState ShelleyEra -> ChainState ShelleyEra
forall era.
(GovState era ~ ShelleyGovState era, EraPParams era) =>
ProposedPPUpdates era -> ChainState era -> ChainState era
C.setCurrentProposals (PParamsUpdate ShelleyEra -> [Int] -> ProposedPPUpdates ShelleyEra
collectVotes PParamsUpdate ShelleyEra
ppVoteA [Int
0, Int
1, Int
3, Int
4, Int
5])
    (ChainState ShelleyEra -> ChainState ShelleyEra)
-> ChainState ShelleyEra -> ChainState ShelleyEra
forall a b. (a -> b) -> a -> b
$ ChainState ShelleyEra
expectedStEx1

-- === Block 2, Slot 20, Epoch 0
--
-- In the second block, two more genesis keys vote for the same new parameters.
updates2 :: CHAINExample ShelleyEra
updates2 :: CHAINExample ShelleyEra
updates2 = ChainState ShelleyEra
-> Block (BHeader MockCrypto) ShelleyEra
-> Either
     (NonEmpty (PredicateFailure (CHAIN ShelleyEra)))
     (ChainState ShelleyEra)
-> CHAINExample ShelleyEra
forall era.
ChainState era
-> Block (BHeader MockCrypto) era
-> Either
     (NonEmpty (PredicateFailure (CHAIN era))) (ChainState era)
-> CHAINExample era
CHAINExample ChainState ShelleyEra
expectedStEx1 Block (BHeader MockCrypto) ShelleyEra
blockEx2 (ChainState ShelleyEra
-> Either
     (NonEmpty (TestChainPredicateFailure ShelleyEra))
     (ChainState ShelleyEra)
forall a b. b -> Either a b
Right ChainState ShelleyEra
expectedStEx2)

--
-- Block 3, Slot 80, Epoch 0
--

ppVoteB :: PParamsUpdate ShelleyEra
ppVoteB :: PParamsUpdate ShelleyEra
ppVoteB =
  PParamsUpdate ShelleyEra
forall era. EraPParams era => PParamsUpdate era
emptyPParamsUpdate
    PParamsUpdate ShelleyEra
-> (PParamsUpdate ShelleyEra -> PParamsUpdate ShelleyEra)
-> PParamsUpdate ShelleyEra
forall a b. a -> (a -> b) -> b
& (StrictMaybe Coin -> Identity (StrictMaybe Coin))
-> PParamsUpdate ShelleyEra -> Identity (PParamsUpdate ShelleyEra)
forall era.
(EraPParams era, ProtVerAtMost era 4) =>
Lens' (PParamsUpdate era) (StrictMaybe Coin)
Lens' (PParamsUpdate ShelleyEra) (StrictMaybe Coin)
ppuMinUTxOValueL ((StrictMaybe Coin -> Identity (StrictMaybe Coin))
 -> PParamsUpdate ShelleyEra -> Identity (PParamsUpdate ShelleyEra))
-> StrictMaybe Coin
-> PParamsUpdate ShelleyEra
-> PParamsUpdate ShelleyEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Coin -> StrictMaybe Coin
forall a. a -> StrictMaybe a
SJust (Integer -> Coin
Coin Integer
99)

ppVotes3 :: ProposedPPUpdates ShelleyEra
ppVotes3 :: ProposedPPUpdates ShelleyEra
ppVotes3 = PParamsUpdate ShelleyEra -> [Int] -> ProposedPPUpdates ShelleyEra
collectVotes PParamsUpdate ShelleyEra
ppVoteB [Int
1]

feeTx3 :: Coin
feeTx3 :: Coin
feeTx3 = Integer -> Coin
Coin Integer
1

aliceCoinEx3 :: Coin
aliceCoinEx3 :: Coin
aliceCoinEx3 = Coin
aliceCoinEx2 Coin -> Coin -> Coin
forall t. Val t => t -> t -> t
<-> Coin
feeTx3

txbodyEx3 :: TxBody ShelleyEra
txbodyEx3 :: TxBody ShelleyEra
txbodyEx3 =
  Set TxIn
-> StrictSeq (TxOut ShelleyEra)
-> StrictSeq (TxCert ShelleyEra)
-> Withdrawals
-> Coin
-> SlotNo
-> StrictMaybe (Update ShelleyEra)
-> StrictMaybe TxAuxDataHash
-> TxBody ShelleyEra
ShelleyTxBody
    ([TxIn] -> Set TxIn
forall a. Ord a => [a] -> Set a
Set.fromList [TxId -> TxIx -> TxIn
TxIn (TxBody ShelleyEra -> TxId
forall era. EraTxBody era => TxBody era -> TxId
txIdTxBody TxBody ShelleyEra
txbodyEx2) TxIx
forall a. Bounded a => a
minBound])
    (TxOut ShelleyEra -> StrictSeq (TxOut ShelleyEra)
forall a. a -> StrictSeq a
StrictSeq.singleton (TxOut ShelleyEra -> StrictSeq (TxOut ShelleyEra))
-> TxOut ShelleyEra -> StrictSeq (TxOut ShelleyEra)
forall a b. (a -> b) -> a -> b
$ Addr -> Value ShelleyEra -> ShelleyTxOut ShelleyEra
forall era.
(HasCallStack, Era era, Val (Value era)) =>
Addr -> Value era -> ShelleyTxOut era
ShelleyTxOut Addr
Cast.aliceAddr (Coin -> Coin
forall t s. Inject t s => t -> s
Val.inject Coin
aliceCoinEx3))
    StrictSeq (TxCert ShelleyEra)
StrictSeq (ShelleyTxCert ShelleyEra)
forall a. StrictSeq a
StrictSeq.empty
    (Map RewardAccount Coin -> Withdrawals
Withdrawals Map RewardAccount Coin
forall k a. Map k a
Map.empty)
    Coin
feeTx3
    (Word64 -> SlotNo
SlotNo Word64
81)
    (Update ShelleyEra -> StrictMaybe (Update ShelleyEra)
forall a. a -> StrictMaybe a
SJust (ProposedPPUpdates ShelleyEra -> EpochNo -> Update ShelleyEra
forall era. ProposedPPUpdates era -> EpochNo -> Update era
Update ProposedPPUpdates ShelleyEra
ppVotes3 (Word64 -> EpochNo
EpochNo Word64
1)))
    StrictMaybe TxAuxDataHash
forall a. StrictMaybe a
SNothing

txEx3 :: ShelleyTx ShelleyEra
txEx3 :: ShelleyTx ShelleyEra
txEx3 =
  TxBody ShelleyEra
-> TxWits ShelleyEra
-> StrictMaybe (TxAuxData ShelleyEra)
-> ShelleyTx ShelleyEra
forall era.
EraTx era =>
TxBody era
-> TxWits era -> StrictMaybe (TxAuxData era) -> ShelleyTx era
ShelleyTx
    TxBody ShelleyEra
txbodyEx3
    ShelleyTxWits ShelleyEra
forall a. Monoid a => a
mempty
      { addrWits =
          mkWitnessesVKey
            (hashAnnotated txbodyEx3)
            [asWitness Cast.alicePay, asWitness . aikCold $ coreNodeIssuerKeys 1]
      }
    StrictMaybe (TxAuxData ShelleyEra)
StrictMaybe (ShelleyTxAuxData ShelleyEra)
forall a. StrictMaybe a
SNothing

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

pulserEx3 :: PulsingRewUpdate
pulserEx3 :: PulsingRewUpdate
pulserEx3 = BlocksMade -> ChainState ShelleyEra -> PulsingRewUpdate
forall era.
(EraGov era, EraCertState era) =>
BlocksMade -> ChainState era -> PulsingRewUpdate
makeCompletedPulser (Map (KeyHash 'StakePool) Natural -> BlocksMade
BlocksMade Map (KeyHash 'StakePool) Natural
forall a. Monoid a => a
mempty) ChainState ShelleyEra
expectedStEx2

expectedStEx3 :: ChainState ShelleyEra
expectedStEx3 :: ChainState ShelleyEra
expectedStEx3 =
  Nonce -> ChainState ShelleyEra -> ChainState ShelleyEra
forall era. Nonce -> ChainState era -> ChainState era
C.evolveNonceFrozen (Block (BHeader MockCrypto) ShelleyEra -> Nonce
forall era. Block (BHeader MockCrypto) era -> Nonce
getBlockNonce Block (BHeader MockCrypto) ShelleyEra
blockEx3)
    (ChainState ShelleyEra -> ChainState ShelleyEra)
-> (ChainState ShelleyEra -> ChainState ShelleyEra)
-> ChainState ShelleyEra
-> ChainState ShelleyEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Block (BHeader MockCrypto) ShelleyEra
-> ChainState ShelleyEra -> ChainState ShelleyEra
forall era.
Block (BHeader MockCrypto) era -> ChainState era -> ChainState era
C.newLab Block (BHeader MockCrypto) ShelleyEra
blockEx3
    (ChainState ShelleyEra -> ChainState ShelleyEra)
-> (ChainState ShelleyEra -> ChainState ShelleyEra)
-> ChainState ShelleyEra
-> ChainState ShelleyEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PParams ShelleyEra
-> Coin
-> [Credential 'Staking]
-> [PoolParams]
-> ChainState ShelleyEra
-> ChainState ShelleyEra
forall era.
(EraPParams era, EraCertState era) =>
PParams era
-> Coin
-> [Credential 'Staking]
-> [PoolParams]
-> ChainState era
-> ChainState era
C.feesAndDeposits PParams ShelleyEra
forall era.
(EraPParams era, ProtVerAtMost era 4, ProtVerAtMost era 6) =>
PParams era
ppEx Coin
feeTx3 [] []
    (ChainState ShelleyEra -> ChainState ShelleyEra)
-> (ChainState ShelleyEra -> ChainState ShelleyEra)
-> ChainState ShelleyEra
-> ChainState ShelleyEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxBody ShelleyEra -> ChainState ShelleyEra -> ChainState ShelleyEra
forall era.
(EraTx era, EraStake era) =>
TxBody era -> ChainState era -> ChainState era
C.newUTxO TxBody ShelleyEra
txbodyEx3
    (ChainState ShelleyEra -> ChainState ShelleyEra)
-> (ChainState ShelleyEra -> ChainState ShelleyEra)
-> ChainState ShelleyEra
-> ChainState ShelleyEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PulsingRewUpdate -> ChainState ShelleyEra -> ChainState ShelleyEra
forall era. PulsingRewUpdate -> ChainState era -> ChainState era
C.pulserUpdate PulsingRewUpdate
pulserEx3
    (ChainState ShelleyEra -> ChainState ShelleyEra)
-> (ChainState ShelleyEra -> ChainState ShelleyEra)
-> ChainState ShelleyEra
-> ChainState ShelleyEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProposedPPUpdates ShelleyEra
-> ChainState ShelleyEra -> ChainState ShelleyEra
forall era.
(GovState era ~ ShelleyGovState era) =>
ProposedPPUpdates era -> ChainState era -> ChainState era
C.setFutureProposals (PParamsUpdate ShelleyEra -> [Int] -> ProposedPPUpdates ShelleyEra
collectVotes PParamsUpdate ShelleyEra
ppVoteB [Int
1])
    (ChainState ShelleyEra -> ChainState ShelleyEra)
-> (ChainState ShelleyEra -> ChainState ShelleyEra)
-> ChainState ShelleyEra
-> ChainState ShelleyEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChainState ShelleyEra -> ChainState ShelleyEra
forall era. EraGov era => ChainState era -> ChainState era
C.solidifyProposals
    (ChainState ShelleyEra -> ChainState ShelleyEra)
-> ChainState ShelleyEra -> ChainState ShelleyEra
forall a b. (a -> b) -> a -> b
$ ChainState ShelleyEra
expectedStEx2

-- === Block 3, Slot 80, Epoch 0
--
-- In the third block, one genesis keys votes for the next epoch
updates3 :: CHAINExample ShelleyEra
updates3 :: CHAINExample ShelleyEra
updates3 = ChainState ShelleyEra
-> Block (BHeader MockCrypto) ShelleyEra
-> Either
     (NonEmpty (PredicateFailure (CHAIN ShelleyEra)))
     (ChainState ShelleyEra)
-> CHAINExample ShelleyEra
forall era.
ChainState era
-> Block (BHeader MockCrypto) era
-> Either
     (NonEmpty (PredicateFailure (CHAIN era))) (ChainState era)
-> CHAINExample era
CHAINExample ChainState ShelleyEra
expectedStEx2 Block (BHeader MockCrypto) ShelleyEra
blockEx3 (ChainState ShelleyEra
-> Either
     (NonEmpty (TestChainPredicateFailure ShelleyEra))
     (ChainState ShelleyEra)
forall a b. b -> Either a b
Right ChainState ShelleyEra
expectedStEx3)

--
-- Block 4, Slot 110, Epoch 1
--

epoch1Nonce :: Nonce
epoch1Nonce :: Nonce
epoch1Nonce = ChainState ShelleyEra -> Nonce
forall era. ChainState era -> Nonce
chainCandidateNonce ChainState ShelleyEra
expectedStEx3 Nonce -> Nonce -> Nonce
⭒ Word64 -> Nonce
mkNonceFromNumber Word64
123

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

ppExUpdated :: PParams ShelleyEra
ppExUpdated :: PParams ShelleyEra
ppExUpdated =
  PParams ShelleyEra
forall era.
(EraPParams era, ProtVerAtMost era 4, ProtVerAtMost era 6) =>
PParams era
ppEx
    PParams ShelleyEra
-> (PParams ShelleyEra -> PParams ShelleyEra) -> PParams ShelleyEra
forall a b. a -> (a -> b) -> b
& (Coin -> Identity Coin)
-> PParams ShelleyEra -> Identity (PParams ShelleyEra)
forall era. EraPParams era => Lens' (PParams era) Coin
Lens' (PParams ShelleyEra) Coin
ppPoolDepositL ((Coin -> Identity Coin)
 -> PParams ShelleyEra -> Identity (PParams ShelleyEra))
-> Coin -> PParams ShelleyEra -> PParams ShelleyEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Integer -> Coin
Coin Integer
200
    PParams ShelleyEra
-> (PParams ShelleyEra -> PParams ShelleyEra) -> PParams ShelleyEra
forall a b. a -> (a -> b) -> b
& (Nonce -> Identity Nonce)
-> PParams ShelleyEra -> Identity (PParams ShelleyEra)
forall era.
(EraPParams era, ProtVerAtMost era 6) =>
Lens' (PParams era) Nonce
Lens' (PParams ShelleyEra) Nonce
ppExtraEntropyL ((Nonce -> Identity Nonce)
 -> PParams ShelleyEra -> Identity (PParams ShelleyEra))
-> Nonce -> PParams ShelleyEra -> PParams ShelleyEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Word64 -> Nonce
mkNonceFromNumber Word64
123

expectedStEx4 :: ChainState ShelleyEra
expectedStEx4 :: ChainState ShelleyEra
expectedStEx4 =
  Block (BHeader MockCrypto) ShelleyEra
-> ChainState ShelleyEra -> ChainState ShelleyEra
forall era.
(ProtVerAtMost era 6, EraGov era) =>
Block (BHeader MockCrypto) era -> ChainState era -> ChainState era
C.newEpoch Block (BHeader MockCrypto) ShelleyEra
blockEx4
    (ChainState ShelleyEra -> ChainState ShelleyEra)
-> (ChainState ShelleyEra -> ChainState ShelleyEra)
-> ChainState ShelleyEra
-> ChainState ShelleyEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SnapShot -> Coin -> ChainState ShelleyEra -> ChainState ShelleyEra
forall era. SnapShot -> Coin -> ChainState era -> ChainState era
C.newSnapshot SnapShot
emptySnapShot (Coin
feeTx1 Coin -> Coin -> Coin
forall t. Val t => t -> t -> t
<+> Coin
feeTx2 Coin -> Coin -> Coin
forall t. Val t => t -> t -> t
<+> Coin
feeTx3)
    (ChainState ShelleyEra -> ChainState ShelleyEra)
-> (ChainState ShelleyEra -> ChainState ShelleyEra)
-> ChainState ShelleyEra
-> ChainState ShelleyEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RewardUpdate -> ChainState ShelleyEra -> ChainState ShelleyEra
forall era.
(EraGov era, EraCertState era) =>
RewardUpdate -> ChainState era -> ChainState era
C.applyRewardUpdate RewardUpdate
emptyRewardUpdate
    (ChainState ShelleyEra -> ChainState ShelleyEra)
-> (ChainState ShelleyEra -> ChainState ShelleyEra)
-> ChainState ShelleyEra
-> ChainState ShelleyEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProposedPPUpdates ShelleyEra
-> ChainState ShelleyEra -> ChainState ShelleyEra
forall era.
(GovState era ~ ShelleyGovState era, EraPParams era) =>
ProposedPPUpdates era -> ChainState era -> ChainState era
C.setCurrentProposals (PParamsUpdate ShelleyEra -> [Int] -> ProposedPPUpdates ShelleyEra
collectVotes PParamsUpdate ShelleyEra
ppVoteB [Int
1])
    (ChainState ShelleyEra -> ChainState ShelleyEra)
-> (ChainState ShelleyEra -> ChainState ShelleyEra)
-> ChainState ShelleyEra
-> ChainState ShelleyEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProposedPPUpdates ShelleyEra
-> ChainState ShelleyEra -> ChainState ShelleyEra
forall era.
(GovState era ~ ShelleyGovState era) =>
ProposedPPUpdates era -> ChainState era -> ChainState era
C.setFutureProposals (Map (KeyHash 'Genesis) (PParamsUpdate ShelleyEra)
-> ProposedPPUpdates ShelleyEra
forall era.
Map (KeyHash 'Genesis) (PParamsUpdate era) -> ProposedPPUpdates era
ProposedPPUpdates Map (KeyHash 'Genesis) (PParamsUpdate ShelleyEra)
forall k a. Map k a
Map.empty)
    (ChainState ShelleyEra -> ChainState ShelleyEra)
-> (ChainState ShelleyEra -> ChainState ShelleyEra)
-> ChainState ShelleyEra
-> ChainState ShelleyEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PParams ShelleyEra
-> ChainState ShelleyEra -> ChainState ShelleyEra
forall era.
EraGov era =>
PParams era -> ChainState era -> ChainState era
C.setPParams PParams ShelleyEra
ppExUpdated
    (ChainState ShelleyEra -> ChainState ShelleyEra)
-> ChainState ShelleyEra -> ChainState ShelleyEra
forall a b. (a -> b) -> a -> b
$ ChainState ShelleyEra
expectedStEx3

-- === Block 4, Slot 110, Epoch 1
--
-- In the fourth block, the new protocol parameters are adopted,
-- and the future vote becomes a current vote.
-- Since the extra entropy was voted on, notice that it is a part
-- of the new epoch nonce.
updates4 :: CHAINExample ShelleyEra
updates4 :: CHAINExample ShelleyEra
updates4 = ChainState ShelleyEra
-> Block (BHeader MockCrypto) ShelleyEra
-> Either
     (NonEmpty (PredicateFailure (CHAIN ShelleyEra)))
     (ChainState ShelleyEra)
-> CHAINExample ShelleyEra
forall era.
ChainState era
-> Block (BHeader MockCrypto) era
-> Either
     (NonEmpty (PredicateFailure (CHAIN era))) (ChainState era)
-> CHAINExample era
CHAINExample ChainState ShelleyEra
expectedStEx3 Block (BHeader MockCrypto) ShelleyEra
blockEx4 (ChainState ShelleyEra
-> Either
     (NonEmpty (TestChainPredicateFailure ShelleyEra))
     (ChainState ShelleyEra)
forall a b. b -> Either a b
Right ChainState ShelleyEra
expectedStEx4)

--
-- Updates Test Group
--

updatesExample :: TestTree
updatesExample :: TestTree
updatesExample =
  TestName -> [TestTree] -> TestTree
testGroup
    TestName
"protocol parameter updates"
    [ TestName -> Assertion -> TestTree
testCase TestName
"get 3/7 votes for a pparam update" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ HasCallStack => CHAINExample ShelleyEra -> Assertion
CHAINExample ShelleyEra -> Assertion
testCHAINExample CHAINExample ShelleyEra
updates1
    , TestName -> Assertion -> TestTree
testCase TestName
"get 5/7 votes for a pparam update" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ HasCallStack => CHAINExample ShelleyEra -> Assertion
CHAINExample ShelleyEra -> Assertion
testCHAINExample CHAINExample ShelleyEra
updates2
    , TestName -> Assertion -> TestTree
testCase TestName
"votes for the next epoch" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ HasCallStack => CHAINExample ShelleyEra -> Assertion
CHAINExample ShelleyEra -> Assertion
testCHAINExample CHAINExample ShelleyEra
updates3
    , TestName -> Assertion -> TestTree
testCase TestName
"processes a pparam update" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ HasCallStack => CHAINExample ShelleyEra -> Assertion
CHAINExample ShelleyEra -> Assertion
testCHAINExample CHAINExample ShelleyEra
updates4
    ]