{-# 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.Crypto
import qualified Cardano.Ledger.EpochBoundary as EB
import Cardano.Ledger.Keys (asWitness, hashKey)
import Cardano.Ledger.SafeHash (hashAnnotated)
import Cardano.Ledger.Shelley (ShelleyEra)
import Cardano.Ledger.Shelley.Core
import Cardano.Ledger.Shelley.LedgerState (PulsingRewUpdate, emptyRewardUpdate)
import Cardano.Ledger.Shelley.PParams (ProposedPPUpdates (..), Update (..))
import Cardano.Ledger.Shelley.Tx (ShelleyTx (..))
import Cardano.Ledger.Shelley.TxBody (ShelleyTxBody (..))
import Cardano.Ledger.Shelley.TxOut (ShelleyTxOut (..))
import Cardano.Ledger.Shelley.TxWits (addrWits)
import Cardano.Ledger.Slot (
  BlockNo (..),
  EpochNo (..),
  SlotNo (..),
 )
import Cardano.Ledger.TxIn (TxIn (..))
import Cardano.Ledger.UTxO (UTxO (..))
import Cardano.Ledger.Val ((<+>), (<->))
import qualified Cardano.Ledger.Val as Val
import Cardano.Protocol.TPraos.BHeader (BHeader, bhHash)
import Cardano.Protocol.TPraos.OCert (KESPeriod (..))
import qualified Data.Map.Strict as Map
import qualified Data.Sequence.Strict as StrictSeq
import qualified Data.Set as Set
import Lens.Micro ((&), (.~))
import Test.Cardano.Ledger.Core.KeyPair (mkWitnessesVKey)
import Test.Cardano.Ledger.Shelley.ConcreteCryptoTypes (ExMock)
import Test.Cardano.Ledger.Shelley.Examples (CHAINExample (..), testCHAINExample)
import qualified Test.Cardano.Ledger.Shelley.Examples.Cast as Cast
import qualified Test.Cardano.Ledger.Shelley.Examples.Combinators as C
import Test.Cardano.Ledger.Shelley.Examples.Federation (
  coreNodeIssuerKeys,
  coreNodeKeysBySchedule,
  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 forall a b. (a -> b) -> a -> b
$ Integer
10 forall a. Num a => a -> a -> a
* Integer
1000 forall a. Num a => a -> a -> a
* Integer
1000 forall a. Num a => a -> a -> a
* Integer
1000 forall a. Num a => a -> a -> a
* Integer
1000 forall a. Num a => a -> a -> a
* Integer
1000

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

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

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

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

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

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

ppVotes1 :: Crypto c => ProposedPPUpdates (ShelleyEra c)
ppVotes1 :: forall c. Crypto c => ProposedPPUpdates (ShelleyEra c)
ppVotes1 = forall c.
Crypto c =>
PParamsUpdate (ShelleyEra c)
-> [Int] -> ProposedPPUpdates (ShelleyEra c)
collectVotes forall c. Crypto c => PParamsUpdate (ShelleyEra c)
ppVoteA [Int
0, Int
3, Int
4]

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

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

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

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

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

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

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

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

ppVotes2 :: Era (ShelleyEra c) => ProposedPPUpdates (ShelleyEra c)
ppVotes2 :: forall c. Era (ShelleyEra c) => ProposedPPUpdates (ShelleyEra c)
ppVotes2 = forall c.
Crypto c =>
PParamsUpdate (ShelleyEra c)
-> [Int] -> ProposedPPUpdates (ShelleyEra c)
collectVotes forall c. Crypto c => PParamsUpdate (ShelleyEra c)
ppVoteA [Int
1, Int
5]

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

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

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

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

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

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

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

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

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

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

ppVotes3 :: Era (ShelleyEra c) => ProposedPPUpdates (ShelleyEra c)
ppVotes3 :: forall c. Era (ShelleyEra c) => ProposedPPUpdates (ShelleyEra c)
ppVotes3 = forall c.
Crypto c =>
PParamsUpdate (ShelleyEra c)
-> [Int] -> ProposedPPUpdates (ShelleyEra c)
collectVotes forall c. Crypto c => PParamsUpdate (ShelleyEra c)
ppVoteB [Int
1]

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

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

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

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

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

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

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

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

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

epoch1Nonce :: forall c. ExMock (EraCrypto (ShelleyEra c)) => Nonce
epoch1Nonce :: forall c. ExMock (EraCrypto (ShelleyEra c)) => Nonce
epoch1Nonce = forall era. ChainState era -> Nonce
chainCandidateNonce (forall c.
ExMock (EraCrypto (ShelleyEra c)) =>
ChainState (ShelleyEra c)
expectedStEx3 @c) Nonce -> Nonce -> Nonce
⭒ Word64 -> Nonce
mkNonceFromNumber Word64
123

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

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

expectedStEx4 :: forall c. ExMock (EraCrypto (ShelleyEra c)) => ChainState (ShelleyEra c)
expectedStEx4 :: forall c.
ExMock (EraCrypto (ShelleyEra c)) =>
ChainState (ShelleyEra c)
expectedStEx4 =
  forall era.
(ProtVerAtMost era 6, EraGov era) =>
Block (BHeader (EraCrypto era)) era
-> ChainState era -> ChainState era
C.newEpoch forall c.
ExMock (EraCrypto (ShelleyEra c)) =>
Block (BHeader c) (ShelleyEra c)
blockEx4
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
SnapShot (EraCrypto era)
-> Coin -> ChainState era -> ChainState era
C.newSnapshot forall c. SnapShot c
EB.emptySnapShot (Coin
feeTx1 forall t. Val t => t -> t -> t
<+> Coin
feeTx2 forall t. Val t => t -> t -> t
<+> Coin
feeTx3)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
EraGov era =>
RewardUpdate (EraCrypto era) -> ChainState era -> ChainState era
C.applyRewardUpdate forall c. RewardUpdate c
emptyRewardUpdate
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
(GovState era ~ ShelleyGovState era, EraPParams era) =>
ProposedPPUpdates era -> ChainState era -> ChainState era
C.setCurrentProposals (forall c.
Crypto c =>
PParamsUpdate (ShelleyEra c)
-> [Int] -> ProposedPPUpdates (ShelleyEra c)
collectVotes forall c. Crypto c => PParamsUpdate (ShelleyEra c)
ppVoteB [Int
1])
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
(GovState era ~ ShelleyGovState era) =>
ProposedPPUpdates era -> ChainState era -> ChainState era
C.setFutureProposals (forall era.
Map (KeyHash 'Genesis (EraCrypto era)) (PParamsUpdate era)
-> ProposedPPUpdates era
ProposedPPUpdates forall k a. Map k a
Map.empty)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
EraGov era =>
PParams era -> ChainState era -> ChainState era
C.setPParams forall c. Crypto c => PParams (ShelleyEra c)
ppExUpdated
    forall a b. (a -> b) -> a -> b
$ forall c.
ExMock (EraCrypto (ShelleyEra c)) =>
ChainState (ShelleyEra c)
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 :: ExMock (EraCrypto (ShelleyEra c)) => CHAINExample (BHeader c) (ShelleyEra c)
updates4 :: forall c.
ExMock (EraCrypto (ShelleyEra c)) =>
CHAINExample (BHeader c) (ShelleyEra c)
updates4 = forall h era.
ChainState era
-> Block h era
-> Either
     (NonEmpty (PredicateFailure (CHAIN era))) (ChainState era)
-> CHAINExample h era
CHAINExample forall c.
ExMock (EraCrypto (ShelleyEra c)) =>
ChainState (ShelleyEra c)
expectedStEx3 forall c.
ExMock (EraCrypto (ShelleyEra c)) =>
Block (BHeader c) (ShelleyEra c)
blockEx4 (forall a b. b -> Either a b
Right forall c.
ExMock (EraCrypto (ShelleyEra c)) =>
ChainState (ShelleyEra c)
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" forall a b. (a -> b) -> a -> b
$ HasCallStack =>
CHAINExample (BHeader C_Crypto) (ShelleyEra C_Crypto) -> Assertion
testCHAINExample forall c.
ExMock (EraCrypto (ShelleyEra c)) =>
CHAINExample (BHeader c) (ShelleyEra c)
updates1
    , TestName -> Assertion -> TestTree
testCase TestName
"get 5/7 votes for a pparam update" forall a b. (a -> b) -> a -> b
$ HasCallStack =>
CHAINExample (BHeader C_Crypto) (ShelleyEra C_Crypto) -> Assertion
testCHAINExample forall c.
ExMock (EraCrypto (ShelleyEra c)) =>
CHAINExample (BHeader c) (ShelleyEra c)
updates2
    , TestName -> Assertion -> TestTree
testCase TestName
"votes for the next epoch" forall a b. (a -> b) -> a -> b
$ HasCallStack =>
CHAINExample (BHeader C_Crypto) (ShelleyEra C_Crypto) -> Assertion
testCHAINExample forall c.
ExMock (EraCrypto (ShelleyEra c)) =>
CHAINExample (BHeader c) (ShelleyEra c)
updates3
    , TestName -> Assertion -> TestTree
testCase TestName
"processes a pparam update" forall a b. (a -> b) -> a -> b
$ HasCallStack =>
CHAINExample (BHeader C_Crypto) (ShelleyEra C_Crypto) -> Assertion
testCHAINExample forall c.
ExMock (EraCrypto (ShelleyEra c)) =>
CHAINExample (BHeader c) (ShelleyEra c)
updates4
    ]