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

-- | Example demonstrating the Move Instantaneous Rewards mechanism
module Test.Cardano.Ledger.Shelley.Examples.Mir (
  mirExample,
) where

import Cardano.Ledger.BaseTypes (Mismatch (..), Nonce, mkCertIxPartial)
import Cardano.Ledger.Block (Block (blockHeader))
import Cardano.Ledger.Coin (Coin (..), toDeltaCoin)
import Cardano.Ledger.Credential (Ptr (..), SlotNo32 (..))
import Cardano.Ledger.Keys (asWitness)
import Cardano.Ledger.Shelley (ShelleyEra)
import Cardano.Ledger.Shelley.Core
import Cardano.Ledger.Shelley.LedgerState (
  EpochState (..),
  NewEpochState (..),
  PulsingRewUpdate,
  emptyRewardUpdate,
 )
import Cardano.Ledger.Shelley.Rules (
  ShelleyDelegPredFailure (..),
  ShelleyUtxowPredFailure (..),
 )
import Cardano.Ledger.Shelley.State
import Cardano.Ledger.Shelley.TxCert (ShelleyTxCert (..))
import Cardano.Ledger.Slot (BlockNo (..), SlotNo (..))
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 (KeyPair (..), mkWitnessesVKey)
import Test.Cardano.Ledger.Shelley.ConcreteCryptoTypes (MockCrypto)
import qualified Test.Cardano.Ledger.Shelley.Examples.Cast as Cast
import Test.Cardano.Ledger.Shelley.Examples.Chain (CHAINExample (..), testCHAINExample)
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.Examples.PoolLifetime (makePulser')
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 (..), TestChainPredicateFailure (..))
import Test.Cardano.Ledger.Shelley.Utils (getBlockNonce)
import Test.Tasty (TestTree, testGroup)
import Test.Tasty.HUnit (testCase)

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 -> TxOut ShelleyEra
forall era.
(EraTxOut era, HasCallStack) =>
Addr -> Value era -> TxOut era
mkBasicTxOut Addr
Cast.aliceAddr Value ShelleyEra
Coin
aliceInitCoin
    , Addr -> Value ShelleyEra -> TxOut ShelleyEra
forall era.
(EraTxOut era, HasCallStack) =>
Addr -> Value era -> TxOut era
mkBasicTxOut Addr
Cast.bobAddr Value ShelleyEra
Coin
bobInitCoin
    ]
  where
    aliceInitCoin :: Coin
aliceInitCoin = Coin -> Coin
forall t s. Inject t s => t -> s
Val.inject (Coin -> Coin) -> Coin -> Coin
forall a b. (a -> b) -> a -> b
$ 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 -> Coin
forall t s. Inject t s => t -> s
Val.inject (Coin -> Coin) -> Coin -> Coin
forall a b. (a -> b) -> a -> b
$ 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

initStMIR :: Coin -> ChainState ShelleyEra
initStMIR :: Coin -> ChainState ShelleyEra
initStMIR Coin
treasury = ChainState ShelleyEra
cs {chainNes = (chainNes cs) {nesEs = es'}}
  where
    cs :: ChainState ShelleyEra
cs = forall era.
(EraTxOut era, EraGov era, EraStake era, EraCertState era,
 AtMostEra "Mary" era, AtMostEra "Alonzo" era,
 Default (StashedAVVMAddresses era)) =>
UTxO era -> ChainState era
initSt @ShelleyEra UTxO ShelleyEra
initUTxO
    chainAccountState :: ChainAccountState
chainAccountState = EpochState ShelleyEra -> ChainAccountState
forall era. EpochState era -> ChainAccountState
esChainAccountState (EpochState ShelleyEra -> ChainAccountState)
-> (NewEpochState ShelleyEra -> EpochState ShelleyEra)
-> NewEpochState ShelleyEra
-> ChainAccountState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NewEpochState ShelleyEra -> EpochState ShelleyEra
forall era. NewEpochState era -> EpochState era
nesEs (NewEpochState ShelleyEra -> ChainAccountState)
-> NewEpochState ShelleyEra -> ChainAccountState
forall a b. (a -> b) -> a -> b
$ ChainState ShelleyEra -> NewEpochState ShelleyEra
forall era. ChainState era -> NewEpochState era
chainNes ChainState ShelleyEra
cs
    chainAccountState' :: ChainAccountState
chainAccountState' =
      ChainAccountState
        { casTreasury :: Coin
casTreasury = ChainAccountState -> Coin
casTreasury ChainAccountState
chainAccountState Coin -> Coin -> Coin
forall t. Val t => t -> t -> t
<+> Coin
treasury
        , casReserves :: Coin
casReserves = ChainAccountState -> Coin
casReserves ChainAccountState
chainAccountState Coin -> Coin -> Coin
forall t. Val t => t -> t -> t
<-> Coin
treasury
        }
    es' :: EpochState ShelleyEra
es' = (NewEpochState ShelleyEra -> EpochState ShelleyEra
forall era. NewEpochState era -> EpochState era
nesEs (NewEpochState ShelleyEra -> EpochState ShelleyEra)
-> NewEpochState ShelleyEra -> EpochState ShelleyEra
forall a b. (a -> b) -> a -> b
$ ChainState ShelleyEra -> NewEpochState ShelleyEra
forall era. ChainState era -> NewEpochState era
chainNes ChainState ShelleyEra
cs) {esChainAccountState = chainAccountState'}

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

aliceMIRCoin :: Coin
aliceMIRCoin :: Coin
aliceMIRCoin = Integer -> Coin
Coin Integer
100

ir :: MIRTarget
ir :: MIRTarget
ir = Map (Credential Staking) DeltaCoin -> MIRTarget
StakeAddressesMIR (Map (Credential Staking) DeltaCoin -> MIRTarget)
-> Map (Credential Staking) DeltaCoin -> MIRTarget
forall a b. (a -> b) -> a -> b
$ [(Credential Staking, DeltaCoin)]
-> Map (Credential Staking) DeltaCoin
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Credential Staking
Cast.aliceSHK, Coin -> DeltaCoin
toDeltaCoin Coin
aliceMIRCoin)]

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

txbodyEx1 :: MIRPot -> TxBody TopTx ShelleyEra
txbodyEx1 :: MIRPot -> TxBody TopTx ShelleyEra
txbodyEx1 MIRPot
pot =
  TxBody TopTx ShelleyEra
forall era (l :: TxLevel).
(EraTxBody era, Typeable l) =>
TxBody l era
forall (l :: TxLevel). Typeable l => TxBody l ShelleyEra
mkBasicTxBody
    TxBody TopTx ShelleyEra
-> (TxBody TopTx ShelleyEra -> TxBody TopTx ShelleyEra)
-> TxBody TopTx ShelleyEra
forall a b. a -> (a -> b) -> b
& (Set TxIn -> Identity (Set TxIn))
-> TxBody TopTx ShelleyEra -> Identity (TxBody TopTx ShelleyEra)
forall era (l :: TxLevel).
EraTxBody era =>
Lens' (TxBody l era) (Set TxIn)
forall (l :: TxLevel). Lens' (TxBody l ShelleyEra) (Set TxIn)
inputsTxBodyL ((Set TxIn -> Identity (Set TxIn))
 -> TxBody TopTx ShelleyEra -> Identity (TxBody TopTx ShelleyEra))
-> Set TxIn -> TxBody TopTx ShelleyEra -> TxBody TopTx ShelleyEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [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]
    TxBody TopTx ShelleyEra
-> (TxBody TopTx ShelleyEra -> TxBody TopTx ShelleyEra)
-> TxBody TopTx ShelleyEra
forall a b. a -> (a -> b) -> b
& (StrictSeq (TxOut ShelleyEra)
 -> Identity (StrictSeq (TxOut ShelleyEra)))
-> TxBody TopTx ShelleyEra -> Identity (TxBody TopTx ShelleyEra)
(StrictSeq (ShelleyTxOut ShelleyEra)
 -> Identity (StrictSeq (ShelleyTxOut ShelleyEra)))
-> TxBody TopTx ShelleyEra -> Identity (TxBody TopTx ShelleyEra)
forall era (l :: TxLevel).
EraTxBody era =>
Lens' (TxBody l era) (StrictSeq (TxOut era))
forall (l :: TxLevel).
Lens' (TxBody l ShelleyEra) (StrictSeq (TxOut ShelleyEra))
outputsTxBodyL ((StrictSeq (ShelleyTxOut ShelleyEra)
  -> Identity (StrictSeq (ShelleyTxOut ShelleyEra)))
 -> TxBody TopTx ShelleyEra -> Identity (TxBody TopTx ShelleyEra))
-> StrictSeq (ShelleyTxOut ShelleyEra)
-> TxBody TopTx ShelleyEra
-> TxBody TopTx ShelleyEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ShelleyTxOut ShelleyEra -> StrictSeq (ShelleyTxOut ShelleyEra)
forall a. a -> StrictSeq a
StrictSeq.singleton (Addr -> Value ShelleyEra -> TxOut ShelleyEra
forall era.
(EraTxOut era, HasCallStack) =>
Addr -> Value era -> TxOut era
mkBasicTxOut Addr
Cast.aliceAddr Value ShelleyEra
Coin
aliceCoinEx1)
    TxBody TopTx ShelleyEra
-> (TxBody TopTx ShelleyEra -> TxBody TopTx ShelleyEra)
-> TxBody TopTx ShelleyEra
forall a b. a -> (a -> b) -> b
& (StrictSeq (TxCert ShelleyEra)
 -> Identity (StrictSeq (TxCert ShelleyEra)))
-> TxBody TopTx ShelleyEra -> Identity (TxBody TopTx ShelleyEra)
(StrictSeq (ShelleyTxCert ShelleyEra)
 -> Identity (StrictSeq (ShelleyTxCert ShelleyEra)))
-> TxBody TopTx ShelleyEra -> Identity (TxBody TopTx ShelleyEra)
forall era (l :: TxLevel).
EraTxBody era =>
Lens' (TxBody l era) (StrictSeq (TxCert era))
forall (l :: TxLevel).
Lens' (TxBody l ShelleyEra) (StrictSeq (TxCert ShelleyEra))
certsTxBodyL
      ((StrictSeq (ShelleyTxCert ShelleyEra)
  -> Identity (StrictSeq (ShelleyTxCert ShelleyEra)))
 -> TxBody TopTx ShelleyEra -> Identity (TxBody TopTx ShelleyEra))
-> StrictSeq (ShelleyTxCert ShelleyEra)
-> TxBody TopTx ShelleyEra
-> TxBody TopTx ShelleyEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [ShelleyTxCert ShelleyEra] -> StrictSeq (ShelleyTxCert ShelleyEra)
forall a. [a] -> StrictSeq a
StrictSeq.fromList
        [ MIRCert -> ShelleyTxCert ShelleyEra
forall era. MIRCert -> ShelleyTxCert era
ShelleyTxCertMir (MIRPot -> MIRTarget -> MIRCert
MIRCert MIRPot
pot MIRTarget
ir)
        , Credential Staking -> TxCert ShelleyEra
forall era.
ShelleyEraTxCert era =>
Credential Staking -> TxCert era
RegTxCert Credential Staking
Cast.aliceSHK
        ]
    TxBody TopTx ShelleyEra
-> (TxBody TopTx ShelleyEra -> TxBody TopTx ShelleyEra)
-> TxBody TopTx ShelleyEra
forall a b. a -> (a -> b) -> b
& (Coin -> Identity Coin)
-> TxBody TopTx ShelleyEra -> Identity (TxBody TopTx ShelleyEra)
forall era. EraTxBody era => Lens' (TxBody TopTx era) Coin
Lens' (TxBody TopTx ShelleyEra) Coin
feeTxBodyL ((Coin -> Identity Coin)
 -> TxBody TopTx ShelleyEra -> Identity (TxBody TopTx ShelleyEra))
-> Coin -> TxBody TopTx ShelleyEra -> TxBody TopTx ShelleyEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Integer -> Coin
Coin Integer
1
    TxBody TopTx ShelleyEra
-> (TxBody TopTx ShelleyEra -> TxBody TopTx ShelleyEra)
-> TxBody TopTx ShelleyEra
forall a b. a -> (a -> b) -> b
& (SlotNo -> Identity SlotNo)
-> TxBody TopTx ShelleyEra -> Identity (TxBody TopTx ShelleyEra)
forall era.
(ShelleyEraTxBody era, ExactEra ShelleyEra era) =>
Lens' (TxBody TopTx era) SlotNo
Lens' (TxBody TopTx ShelleyEra) SlotNo
ttlTxBodyL ((SlotNo -> Identity SlotNo)
 -> TxBody TopTx ShelleyEra -> Identity (TxBody TopTx ShelleyEra))
-> SlotNo -> TxBody TopTx ShelleyEra -> TxBody TopTx ShelleyEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Word64 -> SlotNo
SlotNo Word64
10
  where
    aliceInitCoin :: Coin
aliceInitCoin = Coin -> Coin
forall t s. Inject t s => t -> s
Val.inject (Coin -> Coin) -> Coin -> Coin
forall a b. (a -> b) -> a -> b
$ 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
    aliceCoinEx1 :: Coin
aliceCoinEx1 = Coin
aliceInitCoin Coin -> Coin -> Coin
forall t. Val t => t -> t -> t
<-> Coin -> Coin
forall t s. Inject t s => t -> s
Val.inject (Coin
feeTx1 Coin -> Coin -> Coin
forall t. Val t => t -> t -> t
<+> Integer -> Coin
Coin Integer
7)

mirWits :: [Int] -> [KeyPair Witness]
mirWits :: [Int] -> [KeyPair Witness]
mirWits = (Int -> KeyPair Witness) -> [Int] -> [KeyPair Witness]
forall a b. (a -> b) -> [a] -> [b]
map (KeyPair GenesisDelegate -> KeyPair Witness
forall (a :: KeyRole -> *) (r :: KeyRole).
HasKeyRole a =>
a r -> a Witness
asWitness (KeyPair GenesisDelegate -> KeyPair Witness)
-> (Int -> KeyPair GenesisDelegate) -> Int -> KeyPair Witness
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AllIssuerKeys MockCrypto GenesisDelegate -> KeyPair GenesisDelegate
forall c (r :: KeyRole). AllIssuerKeys c r -> KeyPair r
aikCold (AllIssuerKeys MockCrypto GenesisDelegate
 -> KeyPair GenesisDelegate)
-> (Int -> AllIssuerKeys MockCrypto GenesisDelegate)
-> Int
-> KeyPair GenesisDelegate
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> AllIssuerKeys MockCrypto GenesisDelegate
coreNodeIssuerKeys)

sufficientMIRWits :: [KeyPair Witness]
sufficientMIRWits :: [KeyPair Witness]
sufficientMIRWits = [Int] -> [KeyPair Witness]
mirWits [Int
0 .. Int
4]

insufficientMIRWits :: [KeyPair Witness]
insufficientMIRWits :: [KeyPair Witness]
insufficientMIRWits = [Int] -> [KeyPair Witness]
mirWits [Int
0 .. Int
3]

txEx1 :: [KeyPair Witness] -> MIRPot -> Tx TopTx ShelleyEra
txEx1 :: [KeyPair Witness] -> MIRPot -> Tx TopTx ShelleyEra
txEx1 [KeyPair Witness]
txwits MIRPot
pot =
  TxBody TopTx ShelleyEra -> Tx TopTx ShelleyEra
forall era (l :: TxLevel). EraTx era => TxBody l era -> Tx l era
forall (l :: TxLevel). TxBody l ShelleyEra -> Tx l ShelleyEra
mkBasicTx (MIRPot -> TxBody TopTx ShelleyEra
txbodyEx1 MIRPot
pot)
    Tx TopTx ShelleyEra
-> (Tx TopTx ShelleyEra -> Tx TopTx ShelleyEra)
-> Tx TopTx ShelleyEra
forall a b. a -> (a -> b) -> b
& (TxWits ShelleyEra -> Identity (TxWits ShelleyEra))
-> Tx TopTx ShelleyEra -> Identity (Tx TopTx ShelleyEra)
(ShelleyTxWits ShelleyEra -> Identity (ShelleyTxWits ShelleyEra))
-> Tx TopTx ShelleyEra -> Identity (Tx TopTx ShelleyEra)
forall era (l :: TxLevel).
EraTx era =>
Lens' (Tx l era) (TxWits era)
forall (l :: TxLevel). Lens' (Tx l ShelleyEra) (TxWits ShelleyEra)
witsTxL
      ((ShelleyTxWits ShelleyEra -> Identity (ShelleyTxWits ShelleyEra))
 -> Tx TopTx ShelleyEra -> Identity (Tx TopTx ShelleyEra))
-> ShelleyTxWits ShelleyEra
-> Tx TopTx ShelleyEra
-> Tx TopTx ShelleyEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ( TxWits ShelleyEra
forall era. EraTxWits era => TxWits era
mkBasicTxWits
             TxWits ShelleyEra
-> (TxWits ShelleyEra -> ShelleyTxWits ShelleyEra)
-> ShelleyTxWits ShelleyEra
forall a b. a -> (a -> b) -> b
& (Set (WitVKey Witness) -> Identity (Set (WitVKey Witness)))
-> TxWits ShelleyEra -> Identity (TxWits ShelleyEra)
(Set (WitVKey Witness) -> Identity (Set (WitVKey Witness)))
-> TxWits ShelleyEra -> Identity (ShelleyTxWits ShelleyEra)
forall era.
EraTxWits era =>
Lens' (TxWits era) (Set (WitVKey Witness))
Lens' (TxWits ShelleyEra) (Set (WitVKey Witness))
addrTxWitsL
               ((Set (WitVKey Witness) -> Identity (Set (WitVKey Witness)))
 -> TxWits ShelleyEra -> Identity (ShelleyTxWits ShelleyEra))
-> Set (WitVKey Witness)
-> TxWits ShelleyEra
-> ShelleyTxWits ShelleyEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ SafeHash EraIndependentTxBody
-> [KeyPair Witness] -> Set (WitVKey Witness)
forall (kr :: KeyRole).
SafeHash EraIndependentTxBody
-> [KeyPair kr] -> Set (WitVKey Witness)
mkWitnessesVKey
                 (TxBody TopTx ShelleyEra -> SafeHash EraIndependentTxBody
forall x i. HashAnnotated x i => x -> SafeHash i
hashAnnotated (TxBody TopTx ShelleyEra -> SafeHash EraIndependentTxBody)
-> TxBody TopTx ShelleyEra -> SafeHash EraIndependentTxBody
forall a b. (a -> b) -> a -> b
$ MIRPot -> TxBody TopTx ShelleyEra
txbodyEx1 MIRPot
pot)
                 ([KeyPair Payment -> KeyPair Witness
forall (a :: KeyRole -> *) (r :: KeyRole).
HasKeyRole a =>
a r -> a Witness
asWitness KeyPair Payment
Cast.alicePay] [KeyPair Witness] -> [KeyPair Witness] -> [KeyPair Witness]
forall a. Semigroup a => a -> a -> a
<> [KeyPair Witness]
txwits)
         )

blockEx1' :: [KeyPair Witness] -> MIRPot -> Block (BHeader MockCrypto) ShelleyEra
blockEx1' :: [KeyPair Witness]
-> MIRPot -> Block (BHeader MockCrypto) ShelleyEra
blockEx1' [KeyPair Witness]
txwits MIRPot
pot =
  HashHeader
-> AllIssuerKeys MockCrypto GenesisDelegate
-> [Tx TopTx ShelleyEra]
-> SlotNo
-> BlockNo
-> Nonce
-> NatNonce
-> UnitInterval
-> Word
-> Word
-> OCert MockCrypto
-> Block (BHeader MockCrypto) ShelleyEra
forall era (r :: KeyRole) c.
(Crypto c, EraBlockBody era, Signable (VRF c) (WithResult Seed),
 Signable (KES c) (BHBody c)) =>
HashHeader
-> AllIssuerKeys c r
-> [Tx TopTx 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, AtMostEra "Mary" era, AtMostEra "Alonzo" era) =>
PParams era
ppEx Word64
10)
    [[KeyPair Witness] -> MIRPot -> Tx TopTx ShelleyEra
txEx1 [KeyPair Witness]
txwits MIRPot
pot]
    (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, AtMostEra "Mary" era, AtMostEra "Alonzo" era) =>
PParams era
ppEx Word64
10) Word64
0 (Word -> KESPeriod
KESPeriod Word
0))

blockEx1 :: MIRPot -> Block (BHeader MockCrypto) ShelleyEra
blockEx1 :: MIRPot -> Block (BHeader MockCrypto) ShelleyEra
blockEx1 = [KeyPair Witness]
-> MIRPot -> Block (BHeader MockCrypto) ShelleyEra
blockEx1' [KeyPair Witness]
sufficientMIRWits

expectedStEx1' :: [KeyPair Witness] -> MIRPot -> ChainState ShelleyEra
expectedStEx1' :: [KeyPair Witness] -> MIRPot -> ChainState ShelleyEra
expectedStEx1' [KeyPair Witness]
txwits MIRPot
pot =
  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 ([KeyPair Witness]
-> MIRPot -> Block (BHeader MockCrypto) ShelleyEra
blockEx1' [KeyPair Witness]
txwits MIRPot
pot))
    (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 ([KeyPair Witness]
-> MIRPot -> Block (BHeader MockCrypto) ShelleyEra
blockEx1' [KeyPair Witness]
txwits MIRPot
pot)
    (ChainState ShelleyEra -> ChainState ShelleyEra)
-> (ChainState ShelleyEra -> ChainState ShelleyEra)
-> ChainState ShelleyEra
-> ChainState ShelleyEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Coin -> ChainState ShelleyEra -> ChainState ShelleyEra
forall era. Coin -> ChainState era -> ChainState era
C.addFees 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 TopTx ShelleyEra
-> ChainState ShelleyEra -> ChainState ShelleyEra
forall era.
(EraTx era, EraStake era) =>
TxBody TopTx era -> ChainState era -> ChainState era
C.newUTxO (MIRPot -> TxBody TopTx ShelleyEra
txbodyEx1 MIRPot
pot)
    (ChainState ShelleyEra -> ChainState ShelleyEra)
-> (ChainState ShelleyEra -> ChainState ShelleyEra)
-> ChainState ShelleyEra
-> ChainState ShelleyEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Credential Staking
-> Ptr -> ChainState ShelleyEra -> ChainState ShelleyEra
forall era.
(EraCertState era, EraGov era, ShelleyEraAccounts era) =>
Credential Staking -> Ptr -> ChainState era -> ChainState era
C.newStakeCred Credential Staking
Cast.aliceSHK (SlotNo32 -> TxIx -> CertIx -> Ptr
Ptr (Word32 -> SlotNo32
SlotNo32 Word32
10) TxIx
forall a. Bounded a => a
minBound (HasCallStack => Integer -> CertIx
Integer -> CertIx
mkCertIxPartial Integer
1))
    (ChainState ShelleyEra -> ChainState ShelleyEra)
-> (ChainState ShelleyEra -> ChainState ShelleyEra)
-> ChainState ShelleyEra
-> ChainState ShelleyEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Credential Staking
-> MIRPot -> Coin -> ChainState ShelleyEra -> ChainState ShelleyEra
forall era.
EraCertState era =>
Credential Staking
-> MIRPot -> Coin -> ChainState era -> ChainState era
C.mir Credential Staking
Cast.aliceSHK MIRPot
pot Coin
aliceMIRCoin
    (ChainState ShelleyEra -> ChainState ShelleyEra)
-> ChainState ShelleyEra -> ChainState ShelleyEra
forall a b. (a -> b) -> a -> b
$ Coin -> ChainState ShelleyEra
initStMIR (Integer -> Coin
Coin Integer
1000)

expectedStEx1 :: MIRPot -> ChainState ShelleyEra
expectedStEx1 :: MIRPot -> ChainState ShelleyEra
expectedStEx1 = [KeyPair Witness] -> MIRPot -> ChainState ShelleyEra
expectedStEx1' [KeyPair Witness]
sufficientMIRWits

-- === Block 1, Slot 10, Epoch 0, Successful MIR Reserves Example
--
-- In the first block, submit a MIR cert drawing from the reserves.
mir1 :: MIRPot -> CHAINExample ShelleyEra
mir1 :: MIRPot -> CHAINExample ShelleyEra
mir1 MIRPot
pot =
  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
    (Coin -> ChainState ShelleyEra
initStMIR (Integer -> Coin
Coin Integer
1000))
    (MIRPot -> Block (BHeader MockCrypto) ShelleyEra
blockEx1 MIRPot
pot)
    (ChainState ShelleyEra
-> Either
     (NonEmpty (PredicateFailure (CHAIN ShelleyEra)))
     (ChainState ShelleyEra)
forall a b. b -> Either a b
Right (ChainState ShelleyEra
 -> Either
      (NonEmpty (PredicateFailure (CHAIN ShelleyEra)))
      (ChainState ShelleyEra))
-> ChainState ShelleyEra
-> Either
     (NonEmpty (PredicateFailure (CHAIN ShelleyEra)))
     (ChainState ShelleyEra)
forall a b. (a -> b) -> a -> b
$ MIRPot -> ChainState ShelleyEra
expectedStEx1 MIRPot
pot)

-- === Block 1, Slot 10, Epoch 0, Insufficient MIR Wits, Reserves Example
--
-- In the first block, submit a MIR cert drawing from the reserves.
mirFailWits :: MIRPot -> CHAINExample ShelleyEra
mirFailWits :: MIRPot -> CHAINExample ShelleyEra
mirFailWits MIRPot
pot =
  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
    (Coin -> ChainState ShelleyEra
initStMIR (Integer -> Coin
Coin Integer
1000))
    ([KeyPair Witness]
-> MIRPot -> Block (BHeader MockCrypto) ShelleyEra
blockEx1' [KeyPair Witness]
insufficientMIRWits MIRPot
pot)
    ( NonEmpty (TestChainPredicateFailure ShelleyEra)
-> Either
     (NonEmpty (PredicateFailure (CHAIN ShelleyEra)))
     (ChainState ShelleyEra)
NonEmpty (TestChainPredicateFailure ShelleyEra)
-> Either
     (NonEmpty (TestChainPredicateFailure ShelleyEra))
     (ChainState ShelleyEra)
forall a b. a -> Either a b
Left
        (NonEmpty (TestChainPredicateFailure ShelleyEra)
 -> Either
      (NonEmpty (PredicateFailure (CHAIN ShelleyEra)))
      (ChainState ShelleyEra))
-> (ShelleyUtxowPredFailure ShelleyEra
    -> NonEmpty (TestChainPredicateFailure ShelleyEra))
-> ShelleyUtxowPredFailure ShelleyEra
-> Either
     (NonEmpty (PredicateFailure (CHAIN ShelleyEra)))
     (ChainState ShelleyEra)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TestChainPredicateFailure ShelleyEra
-> NonEmpty (TestChainPredicateFailure ShelleyEra)
forall a. a -> NonEmpty a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
        (TestChainPredicateFailure ShelleyEra
 -> NonEmpty (TestChainPredicateFailure ShelleyEra))
-> (ShelleyUtxowPredFailure ShelleyEra
    -> TestChainPredicateFailure ShelleyEra)
-> ShelleyUtxowPredFailure ShelleyEra
-> NonEmpty (TestChainPredicateFailure ShelleyEra)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PredicateFailure (EraRule "BBODY" ShelleyEra)
-> TestChainPredicateFailure ShelleyEra
ShelleyBbodyPredFailure ShelleyEra
-> TestChainPredicateFailure ShelleyEra
forall era.
PredicateFailure (EraRule "BBODY" era)
-> TestChainPredicateFailure era
BbodyFailure
        (ShelleyBbodyPredFailure ShelleyEra
 -> TestChainPredicateFailure ShelleyEra)
-> (ShelleyUtxowPredFailure ShelleyEra
    -> ShelleyBbodyPredFailure ShelleyEra)
-> ShelleyUtxowPredFailure ShelleyEra
-> TestChainPredicateFailure ShelleyEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShelleyUtxowPredFailure ShelleyEra
-> EraRuleFailure "BBODY" ShelleyEra
ShelleyUtxowPredFailure ShelleyEra
-> ShelleyBbodyPredFailure ShelleyEra
forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure
        (ShelleyUtxowPredFailure ShelleyEra
 -> Either
      (NonEmpty (PredicateFailure (CHAIN ShelleyEra)))
      (ChainState ShelleyEra))
-> ShelleyUtxowPredFailure ShelleyEra
-> Either
     (NonEmpty (PredicateFailure (CHAIN ShelleyEra)))
     (ChainState ShelleyEra)
forall a b. (a -> b) -> a -> b
$ Set (KeyHash Witness) -> ShelleyUtxowPredFailure ShelleyEra
forall era. Set (KeyHash Witness) -> ShelleyUtxowPredFailure era
MIRInsufficientGenesisSigsUTXOW Set (KeyHash Witness)
ws
    )
  where
    ws :: Set (KeyHash Witness)
ws = [KeyHash Witness] -> Set (KeyHash Witness)
forall a. Ord a => [a] -> Set a
Set.fromList ([KeyHash Witness] -> Set (KeyHash Witness))
-> [KeyHash Witness] -> Set (KeyHash Witness)
forall a b. (a -> b) -> a -> b
$ (Int -> KeyHash Witness) -> [Int] -> [KeyHash Witness]
forall a b. (a -> b) -> [a] -> [b]
map (KeyHash GenesisDelegate -> KeyHash Witness
forall (a :: KeyRole -> *) (r :: KeyRole).
HasKeyRole a =>
a r -> a Witness
asWitness (KeyHash GenesisDelegate -> KeyHash Witness)
-> (Int -> KeyHash GenesisDelegate) -> Int -> KeyHash Witness
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AllIssuerKeys MockCrypto GenesisDelegate -> KeyHash GenesisDelegate
forall c (r :: KeyRole). AllIssuerKeys c r -> KeyHash r
aikColdKeyHash (AllIssuerKeys MockCrypto GenesisDelegate
 -> KeyHash GenesisDelegate)
-> (Int -> AllIssuerKeys MockCrypto GenesisDelegate)
-> Int
-> KeyHash GenesisDelegate
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> AllIssuerKeys MockCrypto GenesisDelegate
coreNodeIssuerKeys) [Int
0 .. Int
3]

-- === Block 1, Slot 10, Epoch 0, Insufficient MIR funds, Reserves Example
--
-- In the first block, submit a MIR cert drawing from the reserves.
mirFailFunds ::
  MIRPot ->
  Coin ->
  Coin ->
  Coin ->
  CHAINExample ShelleyEra
mirFailFunds :: MIRPot -> Coin -> Coin -> Coin -> CHAINExample ShelleyEra
mirFailFunds MIRPot
pot Coin
treasury Coin
llNeeded Coin
llReceived =
  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
    (Coin -> ChainState ShelleyEra
initStMIR Coin
treasury)
    ([KeyPair Witness]
-> MIRPot -> Block (BHeader MockCrypto) ShelleyEra
blockEx1' [KeyPair Witness]
sufficientMIRWits MIRPot
pot)
    ( NonEmpty (TestChainPredicateFailure ShelleyEra)
-> Either
     (NonEmpty (PredicateFailure (CHAIN ShelleyEra)))
     (ChainState ShelleyEra)
NonEmpty (TestChainPredicateFailure ShelleyEra)
-> Either
     (NonEmpty (TestChainPredicateFailure ShelleyEra))
     (ChainState ShelleyEra)
forall a b. a -> Either a b
Left
        (NonEmpty (TestChainPredicateFailure ShelleyEra)
 -> Either
      (NonEmpty (PredicateFailure (CHAIN ShelleyEra)))
      (ChainState ShelleyEra))
-> (ShelleyDelegPredFailure ShelleyEra
    -> NonEmpty (TestChainPredicateFailure ShelleyEra))
-> ShelleyDelegPredFailure ShelleyEra
-> Either
     (NonEmpty (PredicateFailure (CHAIN ShelleyEra)))
     (ChainState ShelleyEra)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TestChainPredicateFailure ShelleyEra
-> NonEmpty (TestChainPredicateFailure ShelleyEra)
forall a. a -> NonEmpty a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
        (TestChainPredicateFailure ShelleyEra
 -> NonEmpty (TestChainPredicateFailure ShelleyEra))
-> (ShelleyDelegPredFailure ShelleyEra
    -> TestChainPredicateFailure ShelleyEra)
-> ShelleyDelegPredFailure ShelleyEra
-> NonEmpty (TestChainPredicateFailure ShelleyEra)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PredicateFailure (EraRule "BBODY" ShelleyEra)
-> TestChainPredicateFailure ShelleyEra
ShelleyBbodyPredFailure ShelleyEra
-> TestChainPredicateFailure ShelleyEra
forall era.
PredicateFailure (EraRule "BBODY" era)
-> TestChainPredicateFailure era
BbodyFailure
        (ShelleyBbodyPredFailure ShelleyEra
 -> TestChainPredicateFailure ShelleyEra)
-> (ShelleyDelegPredFailure ShelleyEra
    -> ShelleyBbodyPredFailure ShelleyEra)
-> ShelleyDelegPredFailure ShelleyEra
-> TestChainPredicateFailure ShelleyEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShelleyDelegPredFailure ShelleyEra
-> EraRuleFailure "BBODY" ShelleyEra
ShelleyDelegPredFailure ShelleyEra
-> ShelleyBbodyPredFailure ShelleyEra
forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure
        (ShelleyDelegPredFailure ShelleyEra
 -> Either
      (NonEmpty (PredicateFailure (CHAIN ShelleyEra)))
      (ChainState ShelleyEra))
-> ShelleyDelegPredFailure ShelleyEra
-> Either
     (NonEmpty (PredicateFailure (CHAIN ShelleyEra)))
     (ChainState ShelleyEra)
forall a b. (a -> b) -> a -> b
$ MIRPot
-> Mismatch RelLTEQ Coin -> ShelleyDelegPredFailure ShelleyEra
forall era.
MIRPot -> Mismatch RelLTEQ Coin -> ShelleyDelegPredFailure era
InsufficientForInstantaneousRewardsDELEG MIRPot
pot
        (Mismatch RelLTEQ Coin -> ShelleyDelegPredFailure ShelleyEra)
-> Mismatch RelLTEQ Coin -> ShelleyDelegPredFailure ShelleyEra
forall a b. (a -> b) -> a -> b
$ Coin -> Coin -> Mismatch RelLTEQ Coin
forall (r :: Relation) a. a -> a -> Mismatch r a
Mismatch Coin
llNeeded Coin
llReceived
    )

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

blockEx2 :: MIRPot -> Block (BHeader MockCrypto) ShelleyEra
blockEx2 :: MIRPot -> Block (BHeader MockCrypto) ShelleyEra
blockEx2 MIRPot
pot =
  HashHeader
-> AllIssuerKeys MockCrypto GenesisDelegate
-> [Tx TopTx ShelleyEra]
-> SlotNo
-> BlockNo
-> Nonce
-> NatNonce
-> UnitInterval
-> Word
-> Word
-> OCert MockCrypto
-> Block (BHeader MockCrypto) ShelleyEra
forall era (r :: KeyRole) c.
(Crypto c, EraBlockBody era, Signable (VRF c) (WithResult Seed),
 Signable (KES c) (BHBody c)) =>
HashHeader
-> AllIssuerKeys c r
-> [Tx TopTx 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
blockHeader (MIRPot -> Block (BHeader MockCrypto) ShelleyEra
blockEx1 MIRPot
pot))
    (forall era.
(HasCallStack, EraPParams era) =>
PParams era -> Word64 -> AllIssuerKeys MockCrypto GenesisDelegate
coreNodeKeysBySchedule @ShelleyEra PParams ShelleyEra
forall era.
(EraPParams era, AtMostEra "Mary" era, AtMostEra "Alonzo" era) =>
PParams era
ppEx Word64
50)
    []
    (Word64 -> SlotNo
SlotNo Word64
50)
    (Word64 -> BlockNo
BlockNo Word64
2)
    Nonce
nonce0
    (Natural -> NatNonce
NatNonce Natural
2)
    UnitInterval
forall a. Bounded a => a
minBound
    Word
2
    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, AtMostEra "Mary" era, AtMostEra "Alonzo" era) =>
PParams era
ppEx Word64
50) Word64
0 (Word -> KESPeriod
KESPeriod Word
0))

pulserEx2 :: MIRPot -> PulsingRewUpdate
pulserEx2 :: MIRPot -> PulsingRewUpdate
pulserEx2 MIRPot
pot = ChainState ShelleyEra -> PulsingRewUpdate
forall era.
(EraGov era, EraCertState era) =>
ChainState era -> PulsingRewUpdate
makePulser' (MIRPot -> ChainState ShelleyEra
expectedStEx1 MIRPot
pot)

expectedStEx2 :: MIRPot -> ChainState ShelleyEra
expectedStEx2 :: MIRPot -> ChainState ShelleyEra
expectedStEx2 MIRPot
pot =
  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 (MIRPot -> Block (BHeader MockCrypto) ShelleyEra
blockEx2 MIRPot
pot))
    (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 (MIRPot -> Block (BHeader MockCrypto) ShelleyEra
blockEx2 MIRPot
pot)
    (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 (MIRPot -> PulsingRewUpdate
pulserEx2 MIRPot
pot)
    (ChainState ShelleyEra -> ChainState ShelleyEra)
-> ChainState ShelleyEra -> ChainState ShelleyEra
forall a b. (a -> b) -> a -> b
$ MIRPot -> ChainState ShelleyEra
expectedStEx1 MIRPot
pot

-- === Block 2, Slot 50, Epoch 0
--
-- Submit an empty block to create an empty reward update.
mir2 :: MIRPot -> CHAINExample ShelleyEra
mir2 :: MIRPot -> CHAINExample ShelleyEra
mir2 MIRPot
pot =
  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
    (MIRPot -> ChainState ShelleyEra
expectedStEx1 MIRPot
pot)
    (MIRPot -> Block (BHeader MockCrypto) ShelleyEra
blockEx2 MIRPot
pot)
    (ChainState ShelleyEra
-> Either
     (NonEmpty (PredicateFailure (CHAIN ShelleyEra)))
     (ChainState ShelleyEra)
forall a b. b -> Either a b
Right (ChainState ShelleyEra
 -> Either
      (NonEmpty (PredicateFailure (CHAIN ShelleyEra)))
      (ChainState ShelleyEra))
-> ChainState ShelleyEra
-> Either
     (NonEmpty (PredicateFailure (CHAIN ShelleyEra)))
     (ChainState ShelleyEra)
forall a b. (a -> b) -> a -> b
$ ChainState ShelleyEra -> ChainState ShelleyEra
forall era. EraGov era => ChainState era -> ChainState era
C.solidifyProposals (MIRPot -> ChainState ShelleyEra
expectedStEx2 MIRPot
pot))

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

epoch1Nonce :: MIRPot -> Nonce
epoch1Nonce :: MIRPot -> Nonce
epoch1Nonce MIRPot
pot = ChainState ShelleyEra -> Nonce
forall era. ChainState era -> Nonce
chainCandidateNonce (MIRPot -> ChainState ShelleyEra
expectedStEx2 MIRPot
pot)

blockEx3 :: MIRPot -> Block (BHeader MockCrypto) ShelleyEra
blockEx3 :: MIRPot -> Block (BHeader MockCrypto) ShelleyEra
blockEx3 MIRPot
pot =
  HashHeader
-> AllIssuerKeys MockCrypto GenesisDelegate
-> [Tx TopTx ShelleyEra]
-> SlotNo
-> BlockNo
-> Nonce
-> NatNonce
-> UnitInterval
-> Word
-> Word
-> OCert MockCrypto
-> Block (BHeader MockCrypto) ShelleyEra
forall era (r :: KeyRole) c.
(Crypto c, EraBlockBody era, Signable (VRF c) (WithResult Seed),
 Signable (KES c) (BHBody c)) =>
HashHeader
-> AllIssuerKeys c r
-> [Tx TopTx 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
blockHeader (MIRPot -> Block (BHeader MockCrypto) ShelleyEra
blockEx2 MIRPot
pot))
    (forall era.
(HasCallStack, EraPParams era) =>
PParams era -> Word64 -> AllIssuerKeys MockCrypto GenesisDelegate
coreNodeKeysBySchedule @ShelleyEra PParams ShelleyEra
forall era.
(EraPParams era, AtMostEra "Mary" era, AtMostEra "Alonzo" era) =>
PParams era
ppEx Word64
110)
    []
    (Word64 -> SlotNo
SlotNo Word64
110)
    (Word64 -> BlockNo
BlockNo Word64
3)
    (MIRPot -> Nonce
epoch1Nonce MIRPot
pot)
    (Natural -> NatNonce
NatNonce Natural
3)
    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, AtMostEra "Mary" era, AtMostEra "Alonzo" era) =>
PParams era
ppEx Word64
110) Word64
0 (Word -> KESPeriod
KESPeriod Word
0))

expectedStEx3 :: MIRPot -> ChainState ShelleyEra
expectedStEx3 :: MIRPot -> ChainState ShelleyEra
expectedStEx3 MIRPot
pot =
  Block (BHeader MockCrypto) ShelleyEra
-> ChainState ShelleyEra -> ChainState ShelleyEra
forall era.
(AtMostEra "Alonzo" era, EraGov era) =>
Block (BHeader MockCrypto) era -> ChainState era -> ChainState era
C.newEpoch (MIRPot -> Block (BHeader MockCrypto) ShelleyEra
blockEx3 MIRPot
pot)
    (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
    (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
. MIRPot
-> Map (Credential Staking) Coin
-> ChainState ShelleyEra
-> ChainState ShelleyEra
forall era.
EraCertState era =>
MIRPot
-> Map (Credential Staking) Coin
-> ChainState era
-> ChainState era
C.applyMIR MIRPot
pot (Credential Staking -> Coin -> Map (Credential Staking) Coin
forall k a. k -> a -> Map k a
Map.singleton Credential Staking
Cast.aliceSHK Coin
aliceMIRCoin)
    (ChainState ShelleyEra -> ChainState ShelleyEra)
-> ChainState ShelleyEra -> ChainState ShelleyEra
forall a b. (a -> b) -> a -> b
$ MIRPot -> ChainState ShelleyEra
expectedStEx2 MIRPot
pot

-- === Block 3, Slot 110, Epoch 1
--
-- Submit an empty block in the next epoch to apply the MIR rewards.
mir3 :: MIRPot -> CHAINExample ShelleyEra
mir3 :: MIRPot -> CHAINExample ShelleyEra
mir3 MIRPot
pot = 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 (MIRPot -> ChainState ShelleyEra
expectedStEx2 MIRPot
pot) (MIRPot -> Block (BHeader MockCrypto) ShelleyEra
blockEx3 MIRPot
pot) (ChainState ShelleyEra
-> Either
     (NonEmpty (PredicateFailure (CHAIN ShelleyEra)))
     (ChainState ShelleyEra)
forall a b. b -> Either a b
Right (ChainState ShelleyEra
 -> Either
      (NonEmpty (PredicateFailure (CHAIN ShelleyEra)))
      (ChainState ShelleyEra))
-> ChainState ShelleyEra
-> Either
     (NonEmpty (PredicateFailure (CHAIN ShelleyEra)))
     (ChainState ShelleyEra)
forall a b. (a -> b) -> a -> b
$ MIRPot -> ChainState ShelleyEra
expectedStEx3 MIRPot
pot)

--
-- MIR Test Group
--

mirExample :: TestTree
mirExample :: TestTree
mirExample =
  String -> [TestTree] -> TestTree
forall a. HasCallStack => String -> [SpecWith a] -> SpecWith a
testGroup
    String
"move inst rewards"
    [ HasCallStack => String -> Expectation -> TestTree
String -> Expectation -> TestTree
testCase String
"create MIR cert - reserves" (Expectation -> TestTree) -> Expectation -> TestTree
forall a b. (a -> b) -> a -> b
$ HasCallStack => CHAINExample ShelleyEra -> Expectation
CHAINExample ShelleyEra -> Expectation
testCHAINExample (MIRPot -> CHAINExample ShelleyEra
mir1 MIRPot
ReservesMIR)
    , HasCallStack => String -> Expectation -> TestTree
String -> Expectation -> TestTree
testCase String
"create MIR cert - treasury" (Expectation -> TestTree) -> Expectation -> TestTree
forall a b. (a -> b) -> a -> b
$ HasCallStack => CHAINExample ShelleyEra -> Expectation
CHAINExample ShelleyEra -> Expectation
testCHAINExample (MIRPot -> CHAINExample ShelleyEra
mir1 MIRPot
TreasuryMIR)
    , HasCallStack => String -> Expectation -> TestTree
String -> Expectation -> TestTree
testCase String
"insufficient MIR witnesses, reserves" (Expectation -> TestTree) -> Expectation -> TestTree
forall a b. (a -> b) -> a -> b
$
        HasCallStack => CHAINExample ShelleyEra -> Expectation
CHAINExample ShelleyEra -> Expectation
testCHAINExample (MIRPot -> CHAINExample ShelleyEra
mirFailWits MIRPot
ReservesMIR)
    , HasCallStack => String -> Expectation -> TestTree
String -> Expectation -> TestTree
testCase String
"insufficient MIR witnesses, treasury" (Expectation -> TestTree) -> Expectation -> TestTree
forall a b. (a -> b) -> a -> b
$
        HasCallStack => CHAINExample ShelleyEra -> Expectation
CHAINExample ShelleyEra -> Expectation
testCHAINExample (MIRPot -> CHAINExample ShelleyEra
mirFailWits MIRPot
TreasuryMIR)
    , HasCallStack => String -> Expectation -> TestTree
String -> Expectation -> TestTree
testCase String
"insufficient MIR funds, reserves" (Expectation -> TestTree) -> Expectation -> TestTree
forall a b. (a -> b) -> a -> b
$
        HasCallStack => CHAINExample ShelleyEra -> Expectation
CHAINExample ShelleyEra -> Expectation
testCHAINExample (MIRPot -> Coin -> Coin -> Coin -> CHAINExample ShelleyEra
mirFailFunds MIRPot
ReservesMIR (Integer -> Coin
Coin Integer
34000000000000000) (Integer -> Coin
Coin Integer
100) (Integer -> Coin
Coin Integer
0))
    , HasCallStack => String -> Expectation -> TestTree
String -> Expectation -> TestTree
testCase String
"insufficient MIR funds, treasury" (Expectation -> TestTree) -> Expectation -> TestTree
forall a b. (a -> b) -> a -> b
$
        HasCallStack => CHAINExample ShelleyEra -> Expectation
CHAINExample ShelleyEra -> Expectation
testCHAINExample (MIRPot -> Coin -> Coin -> Coin -> CHAINExample ShelleyEra
mirFailFunds MIRPot
TreasuryMIR (Integer -> Coin
Coin Integer
99) (Integer -> Coin
Coin Integer
100) (Integer -> Coin
Coin Integer
99))
    , HasCallStack => String -> Expectation -> TestTree
String -> Expectation -> TestTree
testCase String
"end of epoch after MIR - reserves" (Expectation -> TestTree) -> Expectation -> TestTree
forall a b. (a -> b) -> a -> b
$
        HasCallStack => CHAINExample ShelleyEra -> Expectation
CHAINExample ShelleyEra -> Expectation
testCHAINExample (MIRPot -> CHAINExample ShelleyEra
mir2 MIRPot
ReservesMIR)
    , HasCallStack => String -> Expectation -> TestTree
String -> Expectation -> TestTree
testCase String
"end of epoch after MIR - treasury" (Expectation -> TestTree) -> Expectation -> TestTree
forall a b. (a -> b) -> a -> b
$
        HasCallStack => CHAINExample ShelleyEra -> Expectation
CHAINExample ShelleyEra -> Expectation
testCHAINExample (MIRPot -> CHAINExample ShelleyEra
mir2 MIRPot
TreasuryMIR)
    , HasCallStack => String -> Expectation -> TestTree
String -> Expectation -> TestTree
testCase String
"apply MIR - reserves" (Expectation -> TestTree) -> Expectation -> TestTree
forall a b. (a -> b) -> a -> b
$ HasCallStack => CHAINExample ShelleyEra -> Expectation
CHAINExample ShelleyEra -> Expectation
testCHAINExample (MIRPot -> CHAINExample ShelleyEra
mir3 MIRPot
ReservesMIR)
    , HasCallStack => String -> Expectation -> TestTree
String -> Expectation -> TestTree
testCase String
"apply MIR - treasury" (Expectation -> TestTree) -> Expectation -> TestTree
forall a b. (a -> b) -> a -> b
$ HasCallStack => CHAINExample ShelleyEra -> Expectation
CHAINExample ShelleyEra -> Expectation
testCHAINExample (MIRPot -> CHAINExample ShelleyEra
mir3 MIRPot
TreasuryMIR)
    ]