{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}

module Test.Cardano.Ledger.Shelley.BenchmarkFunctions (
  ledgerSpendOneUTxO,
  ledgerSpendOneGivenUTxO,
  initUTxO, -- How to precompute env for the UTxO transactions
  ledgerEnv,
  ledgerRegisterStakeKeys,
  ledgerDeRegisterStakeKeys,
  ledgerRewardWithdrawals,
  ledgerStateWithNregisteredKeys, -- How to precompute env for the StakeKey transactions
  ledgerRegisterStakePools,
  ledgerReRegisterStakePools,
  ledgerRetireStakePools,
  ledgerStateWithNregisteredPools, -- How to precompute env for the Stake Pool transactions
  ledgerDelegateManyKeysOnePool,
  ledgerStateWithNkeysMpools, -- How to precompute env for the Stake Delegation transactions
) where

import Cardano.Ledger.Address (Addr, RewardAccount (..))
import Cardano.Ledger.BaseTypes (
  EpochInterval (..),
  Network (..),
  StrictMaybe (..),
  TxIx,
  inject,
  mkTxIxPartial,
 )
import Cardano.Ledger.Coin (Coin (..))
import Cardano.Ledger.Credential (Credential (..))
import Cardano.Ledger.Keys (asWitness)
import Cardano.Ledger.Shelley (ShelleyEra)
import Cardano.Ledger.Shelley.Core
import Cardano.Ledger.Shelley.LedgerState (
  LedgerState (..),
  UTxOState (..),
 )
import Cardano.Ledger.Shelley.Rules (LedgerEnv (..), ShelleyLEDGER)
import Cardano.Ledger.Shelley.State
import Cardano.Ledger.Shelley.TxBody (TxBody (ShelleyTxBody))
import Cardano.Ledger.Shelley.TxOut (ShelleyTxOut (..))
import Cardano.Ledger.Slot (EpochNo (..), SlotNo (..))
import Cardano.Ledger.TxIn (TxIn (..), mkTxInPartial)
import Cardano.Protocol.Crypto (hashVerKeyVRF)
import Control.State.Transition.Extended (TRC (..), applySTS)
import Data.Default (def)
import qualified Data.Map.Strict as Map
import Data.Sequence.Strict (StrictSeq)
import qualified Data.Sequence.Strict as StrictSeq
import qualified Data.Set as Set
import Data.Word (Word64)
import GHC.Stack
import Lens.Micro ((&), (.~))
import Test.Cardano.Ledger.Core.KeyPair (KeyPair (..), mkAddr, mkWitnessesVKey, vKey)
import Test.Cardano.Ledger.Shelley.ConcreteCryptoTypes (MockCrypto)
import Test.Cardano.Ledger.Shelley.Generator.Core (
  VRFKeyPair (..),
  genesisCoins,
 )
import Test.Cardano.Ledger.Shelley.Generator.EraGen (genesisId)
import Test.Cardano.Ledger.Shelley.Generator.ShelleyEraGen ()
import Test.Cardano.Ledger.Shelley.Utils (
  RawSeed (..),
  mkKeyPair,
  mkKeyPair',
  mkVRFKeyPair,
  runShelleyBase,
  unsafeBoundRational,
 )

-- =========================================================

aliceStake :: KeyPair Staking
aliceStake :: KeyPair Staking
aliceStake = VKey Staking -> SignKeyDSIGN DSIGN -> KeyPair Staking
forall (kd :: KeyRole). VKey kd -> SignKeyDSIGN DSIGN -> KeyPair kd
KeyPair VKey Staking
forall {kd :: KeyRole}. VKey kd
vk SignKeyDSIGN DSIGN
sk
  where
    (SignKeyDSIGN DSIGN
sk, VKey kd
vk) = RawSeed -> (SignKeyDSIGN DSIGN, VKey kd)
forall (kd :: KeyRole). RawSeed -> (SignKeyDSIGN DSIGN, VKey kd)
mkKeyPair (Word64 -> Word64 -> Word64 -> Word64 -> Word64 -> RawSeed
RawSeed Word64
0 Word64
0 Word64
0 Word64
0 Word64
1)

alicePay :: KeyPair Payment
alicePay :: KeyPair Payment
alicePay = VKey Payment -> SignKeyDSIGN DSIGN -> KeyPair Payment
forall (kd :: KeyRole). VKey kd -> SignKeyDSIGN DSIGN -> KeyPair kd
KeyPair VKey Payment
forall {kd :: KeyRole}. VKey kd
vk SignKeyDSIGN DSIGN
sk
  where
    (SignKeyDSIGN DSIGN
sk, VKey kd
vk) = RawSeed -> (SignKeyDSIGN DSIGN, VKey kd)
forall (kd :: KeyRole). RawSeed -> (SignKeyDSIGN DSIGN, VKey kd)
mkKeyPair (Word64 -> Word64 -> Word64 -> Word64 -> Word64 -> RawSeed
RawSeed Word64
0 Word64
0 Word64
0 Word64
0 Word64
0)

aliceAddr :: Addr
aliceAddr :: Addr
aliceAddr = KeyPair Payment -> KeyPair Staking -> Addr
forall p s.
(MakeCredential p Payment, MakeStakeReference s) =>
p -> s -> Addr
mkAddr KeyPair Payment
alicePay KeyPair Staking
aliceStake

-- ==========================================================

injcoins :: Integer -> [ShelleyTxOut ShelleyEra]
injcoins :: Integer -> [ShelleyTxOut ShelleyEra]
injcoins Integer
n = (Integer -> ShelleyTxOut ShelleyEra)
-> [Integer] -> [ShelleyTxOut ShelleyEra]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Integer
_ -> Addr -> Value ShelleyEra -> ShelleyTxOut ShelleyEra
forall era.
(HasCallStack, Era era, Val (Value era)) =>
Addr -> Value era -> ShelleyTxOut era
ShelleyTxOut Addr
aliceAddr (Coin -> Value ShelleyEra
forall t s. Inject t s => t -> s
inject (Coin -> Value ShelleyEra) -> Coin -> Value ShelleyEra
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
100)) [Integer
0 .. Integer
n]

-- Cretae an initial UTxO set with n-many transaction outputs
initUTxO :: Integer -> UTxOState ShelleyEra
initUTxO :: Integer -> UTxOState ShelleyEra
initUTxO Integer
n =
  UTxO ShelleyEra
-> Coin
-> Coin
-> GovState ShelleyEra
-> InstantStake ShelleyEra
-> Coin
-> UTxOState ShelleyEra
forall era.
UTxO era
-> Coin
-> Coin
-> GovState era
-> InstantStake era
-> Coin
-> UTxOState era
UTxOState
    (TxId -> [TxOut ShelleyEra] -> UTxO ShelleyEra
forall era. TxId -> [TxOut era] -> UTxO era
genesisCoins TxId
genesisId (Integer -> [ShelleyTxOut ShelleyEra]
injcoins Integer
n))
    (Integer -> Coin
Coin Integer
0)
    (Integer -> Coin
Coin Integer
0)
    GovState ShelleyEra
ShelleyGovState ShelleyEra
forall a. Default a => a
def
    InstantStake ShelleyEra
ShelleyInstantStake ShelleyEra
forall a. Monoid a => a
mempty
    Coin
forall a. Monoid a => a
mempty

-- Protocal Parameters used for the benchmarknig tests.
-- Note that the fees and deposits are set to zero for
-- ease of creating transactions.
ppsBench :: (EraPParams era, AtMostEra "Mary" era, AtMostEra "Alonzo" era) => PParams era
ppsBench :: forall era.
(EraPParams era, AtMostEra "Mary" era, AtMostEra "Alonzo" era) =>
PParams era
ppsBench =
  PParams era
forall era. EraPParams era => PParams era
emptyPParams
    PParams era -> (PParams era -> PParams era) -> PParams era
forall a b. a -> (a -> b) -> b
& (Word32 -> Identity Word32)
-> PParams era -> Identity (PParams era)
forall era. EraPParams era => Lens' (PParams era) Word32
Lens' (PParams era) Word32
ppMaxBBSizeL ((Word32 -> Identity Word32)
 -> PParams era -> Identity (PParams era))
-> Word32 -> PParams era -> PParams era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Word32
50000
    PParams era -> (PParams era -> PParams era) -> PParams era
forall a b. a -> (a -> b) -> b
& (UnitInterval -> Identity UnitInterval)
-> PParams era -> Identity (PParams era)
forall era.
(EraPParams era, AtMostEra "Alonzo" era) =>
Lens' (PParams era) UnitInterval
Lens' (PParams era) UnitInterval
ppDL ((UnitInterval -> Identity UnitInterval)
 -> PParams era -> Identity (PParams era))
-> UnitInterval -> PParams era -> PParams era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Rational -> UnitInterval
forall r.
(HasCallStack, Typeable r, BoundedRational r) =>
Rational -> r
unsafeBoundRational Rational
0.5
    PParams era -> (PParams era -> PParams era) -> PParams era
forall a b. a -> (a -> b) -> b
& (EpochInterval -> Identity EpochInterval)
-> PParams era -> Identity (PParams era)
forall era. EraPParams era => Lens' (PParams era) EpochInterval
Lens' (PParams era) EpochInterval
ppEMaxL ((EpochInterval -> Identity EpochInterval)
 -> PParams era -> Identity (PParams era))
-> EpochInterval -> PParams era -> PParams era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Word32 -> EpochInterval
EpochInterval Word32
10000
    PParams era -> (PParams era -> PParams era) -> PParams era
forall a b. a -> (a -> b) -> b
& (Coin -> Identity Coin) -> PParams era -> Identity (PParams era)
forall era. EraPParams era => Lens' (PParams era) Coin
Lens' (PParams era) Coin
ppKeyDepositL ((Coin -> Identity Coin) -> PParams era -> Identity (PParams era))
-> Coin -> PParams era -> PParams era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Integer -> Coin
Coin Integer
0
    PParams era -> (PParams era -> PParams era) -> PParams era
forall a b. a -> (a -> b) -> b
& (Word16 -> Identity Word16)
-> PParams era -> Identity (PParams era)
forall era. EraPParams era => Lens' (PParams era) Word16
Lens' (PParams era) Word16
ppMaxBHSizeL ((Word16 -> Identity Word16)
 -> PParams era -> Identity (PParams era))
-> Word16 -> PParams era -> PParams era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Word16
10000
    PParams era -> (PParams era -> PParams era) -> PParams era
forall a b. a -> (a -> b) -> b
& (Word32 -> Identity Word32)
-> PParams era -> Identity (PParams era)
forall era. EraPParams era => Lens' (PParams era) Word32
Lens' (PParams era) Word32
ppMaxTxSizeL ((Word32 -> Identity Word32)
 -> PParams era -> Identity (PParams era))
-> Word32 -> PParams era -> PParams era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Word32
1000000000
    PParams era -> (PParams era -> PParams era) -> PParams era
forall a b. a -> (a -> b) -> b
& (Coin -> Identity Coin) -> PParams era -> Identity (PParams era)
forall era. EraPParams era => Lens' (PParams era) Coin
Lens' (PParams era) Coin
ppMinFeeAL ((Coin -> Identity Coin) -> PParams era -> Identity (PParams era))
-> Coin -> PParams era -> PParams era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Integer -> Coin
Coin Integer
0
    PParams era -> (PParams era -> PParams era) -> PParams era
forall a b. a -> (a -> b) -> b
& (Coin -> Identity Coin) -> PParams era -> Identity (PParams era)
forall era. EraPParams era => Lens' (PParams era) Coin
Lens' (PParams era) Coin
ppMinFeeBL ((Coin -> Identity Coin) -> PParams era -> Identity (PParams era))
-> Coin -> PParams era -> PParams era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Integer -> Coin
Coin Integer
0
    PParams era -> (PParams era -> PParams era) -> PParams era
forall a b. a -> (a -> b) -> b
& (Coin -> Identity Coin) -> PParams era -> Identity (PParams era)
forall era.
(EraPParams era, AtMostEra "Mary" era) =>
Lens' (PParams era) Coin
Lens' (PParams era) Coin
ppMinUTxOValueL ((Coin -> Identity Coin) -> PParams era -> Identity (PParams era))
-> Coin -> PParams era -> PParams era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Integer -> Coin
Coin Integer
10
    PParams era -> (PParams era -> PParams era) -> PParams era
forall a b. a -> (a -> b) -> b
& (Coin -> Identity Coin) -> PParams era -> Identity (PParams era)
forall era.
(EraPParams era, HasCallStack) =>
Lens' (PParams era) Coin
Lens' (PParams era) Coin
ppPoolDepositL ((Coin -> Identity Coin) -> PParams era -> Identity (PParams era))
-> Coin -> PParams era -> PParams era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Integer -> Coin
Coin Integer
0
    PParams era -> (PParams era -> PParams era) -> PParams era
forall a b. a -> (a -> b) -> b
& (UnitInterval -> Identity UnitInterval)
-> PParams era -> Identity (PParams era)
forall era. EraPParams era => Lens' (PParams era) UnitInterval
Lens' (PParams era) UnitInterval
ppRhoL ((UnitInterval -> Identity UnitInterval)
 -> PParams era -> Identity (PParams era))
-> UnitInterval -> PParams era -> PParams era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Rational -> UnitInterval
forall r.
(HasCallStack, Typeable r, BoundedRational r) =>
Rational -> r
unsafeBoundRational Rational
0.0021
    PParams era -> (PParams era -> PParams era) -> PParams era
forall a b. a -> (a -> b) -> b
& (UnitInterval -> Identity UnitInterval)
-> PParams era -> Identity (PParams era)
forall era. EraPParams era => Lens' (PParams era) UnitInterval
Lens' (PParams era) UnitInterval
ppTauL ((UnitInterval -> Identity UnitInterval)
 -> PParams era -> Identity (PParams era))
-> UnitInterval -> PParams era -> PParams era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Rational -> UnitInterval
forall r.
(HasCallStack, Typeable r, BoundedRational r) =>
Rational -> r
unsafeBoundRational Rational
0.2

ledgerEnv :: (EraPParams era, AtMostEra "Mary" era, AtMostEra "Alonzo" era) => LedgerEnv era
ledgerEnv :: forall era.
(EraPParams era, AtMostEra "Mary" era, AtMostEra "Alonzo" era) =>
LedgerEnv era
ledgerEnv = SlotNo
-> Maybe EpochNo
-> TxIx
-> PParams era
-> ChainAccountState
-> LedgerEnv era
forall era.
SlotNo
-> Maybe EpochNo
-> TxIx
-> PParams era
-> ChainAccountState
-> LedgerEnv era
LedgerEnv (Word64 -> SlotNo
SlotNo Word64
0) Maybe EpochNo
forall a. Maybe a
Nothing TxIx
forall a. Bounded a => a
minBound PParams era
forall era.
(EraPParams era, AtMostEra "Mary" era, AtMostEra "Alonzo" era) =>
PParams era
ppsBench (Coin -> Coin -> ChainAccountState
ChainAccountState (Integer -> Coin
Coin Integer
0) (Integer -> Coin
Coin Integer
0))

testLEDGER ::
  LedgerState ShelleyEra ->
  Tx TopTx ShelleyEra ->
  LedgerEnv ShelleyEra ->
  ()
testLEDGER :: LedgerState ShelleyEra
-> Tx TopTx ShelleyEra -> LedgerEnv ShelleyEra -> ()
testLEDGER LedgerState ShelleyEra
initSt Tx TopTx ShelleyEra
tx LedgerEnv ShelleyEra
env = do
  let st :: Either
  (NonEmpty (ShelleyLedgerPredFailure ShelleyEra))
  (LedgerState ShelleyEra)
st = ShelleyBase
  (Either
     (NonEmpty (ShelleyLedgerPredFailure ShelleyEra))
     (LedgerState ShelleyEra))
-> Either
     (NonEmpty (ShelleyLedgerPredFailure ShelleyEra))
     (LedgerState ShelleyEra)
forall a. ShelleyBase a -> a
runShelleyBase (ShelleyBase
   (Either
      (NonEmpty (ShelleyLedgerPredFailure ShelleyEra))
      (LedgerState ShelleyEra))
 -> Either
      (NonEmpty (ShelleyLedgerPredFailure ShelleyEra))
      (LedgerState ShelleyEra))
-> ShelleyBase
     (Either
        (NonEmpty (ShelleyLedgerPredFailure ShelleyEra))
        (LedgerState ShelleyEra))
-> Either
     (NonEmpty (ShelleyLedgerPredFailure ShelleyEra))
     (LedgerState ShelleyEra)
forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) (rtype :: RuleType).
(STS s, RuleTypeRep rtype, m ~ BaseM s) =>
RuleContext rtype s
-> m (Either (NonEmpty (PredicateFailure s)) (State s))
applySTS @(ShelleyLEDGER ShelleyEra) ((Environment (ShelleyLEDGER ShelleyEra),
 State (ShelleyLEDGER ShelleyEra),
 Signal (ShelleyLEDGER ShelleyEra))
-> TRC (ShelleyLEDGER ShelleyEra)
forall sts. (Environment sts, State sts, Signal sts) -> TRC sts
TRC (LedgerEnv ShelleyEra
Environment (ShelleyLEDGER ShelleyEra)
env, State (ShelleyLEDGER ShelleyEra)
LedgerState ShelleyEra
initSt, Tx TopTx ShelleyEra
Signal (ShelleyLEDGER ShelleyEra)
tx))
  case Either
  (NonEmpty (ShelleyLedgerPredFailure ShelleyEra))
  (LedgerState ShelleyEra)
st of
    Right LedgerState ShelleyEra
_ -> ()
    Left NonEmpty (ShelleyLedgerPredFailure ShelleyEra)
e -> [Char] -> ()
forall a. HasCallStack => [Char] -> a
error ([Char] -> ()) -> [Char] -> ()
forall a b. (a -> b) -> a -> b
$ NonEmpty (ShelleyLedgerPredFailure ShelleyEra) -> [Char]
forall a. Show a => a -> [Char]
show NonEmpty (ShelleyLedgerPredFailure ShelleyEra)
e

txbSpendOneUTxO :: TxBody TopTx ShelleyEra
txbSpendOneUTxO :: TxBody TopTx ShelleyEra
txbSpendOneUTxO =
  Set TxIn
-> StrictSeq (TxOut ShelleyEra)
-> StrictSeq (TxCert ShelleyEra)
-> Withdrawals
-> Coin
-> SlotNo
-> StrictMaybe (Update ShelleyEra)
-> StrictMaybe TxAuxDataHash
-> TxBody TopTx 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])
    ( [ShelleyTxOut ShelleyEra] -> StrictSeq (ShelleyTxOut ShelleyEra)
forall a. [a] -> StrictSeq a
StrictSeq.fromList
        [ Addr -> Value ShelleyEra -> ShelleyTxOut ShelleyEra
forall era.
(HasCallStack, Era era, Val (Value era)) =>
Addr -> Value era -> ShelleyTxOut era
ShelleyTxOut Addr
aliceAddr (Coin -> Value ShelleyEra
forall t s. Inject t s => t -> s
inject (Coin -> Value ShelleyEra) -> Coin -> Value ShelleyEra
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
10)
        , Addr -> Value ShelleyEra -> ShelleyTxOut ShelleyEra
forall era.
(HasCallStack, Era era, Val (Value era)) =>
Addr -> Value era -> ShelleyTxOut era
ShelleyTxOut Addr
aliceAddr (Coin -> Value ShelleyEra
forall t s. Inject t s => t -> s
inject (Coin -> Value ShelleyEra) -> Coin -> Value ShelleyEra
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
89)
        ]
    )
    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
10)
    StrictMaybe (Update ShelleyEra)
forall a. StrictMaybe a
SNothing
    StrictMaybe TxAuxDataHash
forall a. StrictMaybe a
SNothing

txSpendOneUTxO :: Tx TopTx ShelleyEra
txSpendOneUTxO :: Tx TopTx ShelleyEra
txSpendOneUTxO =
  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 TxBody TopTx ShelleyEra
txbSpendOneUTxO
    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
txbSpendOneUTxO) [KeyPair Payment -> KeyPair Witness
forall (a :: KeyRole -> *) (r :: KeyRole).
HasKeyRole a =>
a r -> a Witness
asWitness KeyPair Payment
alicePay])
    Tx TopTx ShelleyEra
-> (Tx TopTx ShelleyEra -> Tx TopTx ShelleyEra)
-> Tx TopTx ShelleyEra
forall a b. a -> (a -> b) -> b
& (StrictMaybe (TxAuxData ShelleyEra)
 -> Identity (StrictMaybe (TxAuxData ShelleyEra)))
-> Tx TopTx ShelleyEra -> Identity (Tx TopTx ShelleyEra)
(StrictMaybe (ShelleyTxAuxData ShelleyEra)
 -> Identity (StrictMaybe (ShelleyTxAuxData ShelleyEra)))
-> Tx TopTx ShelleyEra -> Identity (Tx TopTx ShelleyEra)
forall era (l :: TxLevel).
EraTx era =>
Lens' (Tx l era) (StrictMaybe (TxAuxData era))
forall (l :: TxLevel).
Lens' (Tx l ShelleyEra) (StrictMaybe (TxAuxData ShelleyEra))
auxDataTxL ((StrictMaybe (ShelleyTxAuxData ShelleyEra)
  -> Identity (StrictMaybe (ShelleyTxAuxData ShelleyEra)))
 -> Tx TopTx ShelleyEra -> Identity (Tx TopTx ShelleyEra))
-> StrictMaybe (ShelleyTxAuxData ShelleyEra)
-> Tx TopTx ShelleyEra
-> Tx TopTx ShelleyEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ StrictMaybe (ShelleyTxAuxData ShelleyEra)
forall a. StrictMaybe a
SNothing

ledgerSpendOneUTxO :: Integer -> ()
ledgerSpendOneUTxO :: Integer -> ()
ledgerSpendOneUTxO Integer
n = LedgerState ShelleyEra
-> Tx TopTx ShelleyEra -> LedgerEnv ShelleyEra -> ()
testLEDGER (Integer -> LedgerState ShelleyEra
initLedgerState Integer
n) Tx TopTx ShelleyEra
txSpendOneUTxO LedgerEnv ShelleyEra
forall era.
(EraPParams era, AtMostEra "Mary" era, AtMostEra "Alonzo" era) =>
LedgerEnv era
ledgerEnv

ledgerSpendOneGivenUTxO :: UTxOState ShelleyEra -> ()
ledgerSpendOneGivenUTxO :: UTxOState ShelleyEra -> ()
ledgerSpendOneGivenUTxO UTxOState ShelleyEra
state = LedgerState ShelleyEra
-> Tx TopTx ShelleyEra -> LedgerEnv ShelleyEra -> ()
testLEDGER (UTxOState ShelleyEra
-> CertState ShelleyEra -> LedgerState ShelleyEra
forall era. UTxOState era -> CertState era -> LedgerState era
LedgerState UTxOState ShelleyEra
state CertState ShelleyEra
ShelleyCertState ShelleyEra
forall a. Default a => a
def) Tx TopTx ShelleyEra
txSpendOneUTxO LedgerEnv ShelleyEra
forall era.
(EraPParams era, AtMostEra "Mary" era, AtMostEra "Alonzo" era) =>
LedgerEnv era
ledgerEnv

-- ===========================================================================
--
-- Register a stake keys when there are a lot of registered stake keys
--

-- Create stake key pairs, corresponding to seeds
-- (RawSeed start 0 0 0 0) through (RawSeed end 0 0 0 0)
stakeKeys :: Word64 -> Word64 -> [KeyPair Staking]
stakeKeys :: Word64 -> Word64 -> [KeyPair Staking]
stakeKeys Word64
start Word64
end = (Word64 -> KeyPair Staking) -> [Word64] -> [KeyPair Staking]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Word64
w -> RawSeed -> KeyPair Staking
forall (kd :: KeyRole). RawSeed -> KeyPair kd
mkKeyPair' (Word64 -> Word64 -> Word64 -> Word64 -> Word64 -> RawSeed
RawSeed Word64
w Word64
0 Word64
0 Word64
0 Word64
0)) [Word64
start .. Word64
end]

stakeKeyOne :: KeyPair Staking
stakeKeyOne :: KeyPair Staking
stakeKeyOne = RawSeed -> KeyPair Staking
forall (kd :: KeyRole). RawSeed -> KeyPair kd
mkKeyPair' (Word64 -> Word64 -> Word64 -> Word64 -> Word64 -> RawSeed
RawSeed Word64
1 Word64
0 Word64
0 Word64
0 Word64
0)

stakeKeyToCred :: KeyPair Staking -> Credential Staking
stakeKeyToCred :: KeyPair Staking -> Credential Staking
stakeKeyToCred = KeyHash Staking -> Credential Staking
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj (KeyHash Staking -> Credential Staking)
-> (KeyPair Staking -> KeyHash Staking)
-> KeyPair Staking
-> Credential Staking
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VKey Staking -> KeyHash Staking
forall (kd :: KeyRole). VKey kd -> KeyHash kd
hashKey (VKey Staking -> KeyHash Staking)
-> (KeyPair Staking -> VKey Staking)
-> KeyPair Staking
-> KeyHash Staking
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyPair Staking -> VKey Staking
forall (kd :: KeyRole). KeyPair kd -> VKey kd
vKey

firstStakeKeyCred :: Credential Staking
firstStakeKeyCred :: Credential Staking
firstStakeKeyCred = KeyPair Staking -> Credential Staking
stakeKeyToCred KeyPair Staking
stakeKeyOne

-- Create stake key registration certificates
stakeKeyRegistrations :: [KeyPair Staking] -> StrictSeq (TxCert ShelleyEra)
stakeKeyRegistrations :: [KeyPair Staking] -> StrictSeq (TxCert ShelleyEra)
stakeKeyRegistrations [KeyPair Staking]
keys =
  [TxCert ShelleyEra] -> StrictSeq (TxCert ShelleyEra)
forall a. [a] -> StrictSeq a
StrictSeq.fromList ([TxCert ShelleyEra] -> StrictSeq (TxCert ShelleyEra))
-> [TxCert ShelleyEra] -> StrictSeq (TxCert ShelleyEra)
forall a b. (a -> b) -> a -> b
$
    (KeyPair Staking -> ShelleyTxCert ShelleyEra)
-> [KeyPair Staking] -> [ShelleyTxCert ShelleyEra]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Credential Staking -> TxCert ShelleyEra
Credential Staking -> ShelleyTxCert ShelleyEra
forall era.
ShelleyEraTxCert era =>
Credential Staking -> TxCert era
RegTxCert (Credential Staking -> ShelleyTxCert ShelleyEra)
-> (KeyPair Staking -> Credential Staking)
-> KeyPair Staking
-> ShelleyTxCert ShelleyEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyHash Staking -> Credential Staking
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj (KeyHash Staking -> Credential Staking)
-> (KeyPair Staking -> KeyHash Staking)
-> KeyPair Staking
-> Credential Staking
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VKey Staking -> KeyHash Staking
forall (kd :: KeyRole). VKey kd -> KeyHash kd
hashKey (VKey Staking -> KeyHash Staking)
-> (KeyPair Staking -> VKey Staking)
-> KeyPair Staking
-> KeyHash Staking
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyPair Staking -> VKey Staking
forall (kd :: KeyRole). KeyPair kd -> VKey kd
vKey) [KeyPair Staking]
keys

-- Create a transaction body given a sequence of certificates.
-- It spends the genesis coin given by the index ix.
txbFromCerts :: TxIx -> StrictSeq (TxCert ShelleyEra) -> TxBody TopTx ShelleyEra
txbFromCerts :: TxIx -> StrictSeq (TxCert ShelleyEra) -> TxBody TopTx ShelleyEra
txbFromCerts TxIx
ix StrictSeq (TxCert ShelleyEra)
regCerts =
  Set TxIn
-> StrictSeq (TxOut ShelleyEra)
-> StrictSeq (TxCert ShelleyEra)
-> Withdrawals
-> Coin
-> SlotNo
-> StrictMaybe (Update ShelleyEra)
-> StrictMaybe TxAuxDataHash
-> TxBody TopTx ShelleyEra
ShelleyTxBody
    ([TxIn] -> Set TxIn
forall a. Ord a => [a] -> Set a
Set.fromList [TxId -> TxIx -> TxIn
TxIn TxId
genesisId TxIx
ix])
    ([ShelleyTxOut ShelleyEra] -> StrictSeq (ShelleyTxOut ShelleyEra)
forall a. [a] -> StrictSeq a
StrictSeq.fromList [Addr -> Value ShelleyEra -> ShelleyTxOut ShelleyEra
forall era.
(HasCallStack, Era era, Val (Value era)) =>
Addr -> Value era -> ShelleyTxOut era
ShelleyTxOut Addr
aliceAddr (Coin -> Value ShelleyEra
forall t s. Inject t s => t -> s
inject (Coin -> Value ShelleyEra) -> Coin -> Value ShelleyEra
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
100)])
    StrictSeq (TxCert ShelleyEra)
regCerts
    (Map RewardAccount Coin -> Withdrawals
Withdrawals Map RewardAccount Coin
forall k a. Map k a
Map.empty)
    (Integer -> Coin
Coin Integer
0)
    (Word64 -> SlotNo
SlotNo Word64
10)
    StrictMaybe (Update ShelleyEra)
forall a. StrictMaybe a
SNothing
    StrictMaybe TxAuxDataHash
forall a. StrictMaybe a
SNothing

makeSimpleTx ::
  TxBody TopTx ShelleyEra ->
  [KeyPair Witness] ->
  Tx TopTx ShelleyEra
makeSimpleTx :: TxBody TopTx ShelleyEra -> [KeyPair Witness] -> Tx TopTx ShelleyEra
makeSimpleTx TxBody TopTx ShelleyEra
txbody [KeyPair Witness]
keysAddr =
  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 TxBody TopTx ShelleyEra
forall era (l :: TxLevel).
(EraTxBody era, Typeable l) =>
TxBody l era
forall (l :: TxLevel). Typeable l => TxBody l ShelleyEra
mkBasicTxBody
    Tx TopTx ShelleyEra
-> (Tx TopTx ShelleyEra -> Tx TopTx ShelleyEra)
-> Tx TopTx ShelleyEra
forall a b. a -> (a -> b) -> b
& (TxBody TopTx ShelleyEra -> Identity (TxBody TopTx ShelleyEra))
-> Tx TopTx ShelleyEra -> Identity (Tx TopTx ShelleyEra)
forall era (l :: TxLevel).
EraTx era =>
Lens' (Tx l era) (TxBody l era)
forall (l :: TxLevel).
Lens' (Tx l ShelleyEra) (TxBody l ShelleyEra)
bodyTxL ((TxBody TopTx ShelleyEra -> Identity (TxBody TopTx ShelleyEra))
 -> Tx TopTx ShelleyEra -> Identity (Tx TopTx ShelleyEra))
-> TxBody TopTx ShelleyEra
-> Tx TopTx ShelleyEra
-> Tx TopTx ShelleyEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ TxBody TopTx ShelleyEra
txbody
    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
txbody) [KeyPair Witness]
keysAddr)
    Tx TopTx ShelleyEra
-> (Tx TopTx ShelleyEra -> Tx TopTx ShelleyEra)
-> Tx TopTx ShelleyEra
forall a b. a -> (a -> b) -> b
& (StrictMaybe (TxAuxData ShelleyEra)
 -> Identity (StrictMaybe (TxAuxData ShelleyEra)))
-> Tx TopTx ShelleyEra -> Identity (Tx TopTx ShelleyEra)
(StrictMaybe (ShelleyTxAuxData ShelleyEra)
 -> Identity (StrictMaybe (ShelleyTxAuxData ShelleyEra)))
-> Tx TopTx ShelleyEra -> Identity (Tx TopTx ShelleyEra)
forall era (l :: TxLevel).
EraTx era =>
Lens' (Tx l era) (StrictMaybe (TxAuxData era))
forall (l :: TxLevel).
Lens' (Tx l ShelleyEra) (StrictMaybe (TxAuxData ShelleyEra))
auxDataTxL ((StrictMaybe (ShelleyTxAuxData ShelleyEra)
  -> Identity (StrictMaybe (ShelleyTxAuxData ShelleyEra)))
 -> Tx TopTx ShelleyEra -> Identity (Tx TopTx ShelleyEra))
-> StrictMaybe (ShelleyTxAuxData ShelleyEra)
-> Tx TopTx ShelleyEra
-> Tx TopTx ShelleyEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ StrictMaybe (ShelleyTxAuxData ShelleyEra)
forall a. StrictMaybe a
SNothing

-- Create a transaction that registers stake credentials.
txRegStakeKeys :: TxIx -> [KeyPair Staking] -> Tx TopTx ShelleyEra
txRegStakeKeys :: TxIx -> [KeyPair Staking] -> Tx TopTx ShelleyEra
txRegStakeKeys TxIx
ix [KeyPair Staking]
keys =
  TxBody TopTx ShelleyEra -> [KeyPair Witness] -> Tx TopTx ShelleyEra
makeSimpleTx
    (TxIx -> StrictSeq (TxCert ShelleyEra) -> TxBody TopTx ShelleyEra
txbFromCerts TxIx
ix (StrictSeq (TxCert ShelleyEra) -> TxBody TopTx ShelleyEra)
-> StrictSeq (TxCert ShelleyEra) -> TxBody TopTx ShelleyEra
forall a b. (a -> b) -> a -> b
$ [KeyPair Staking] -> StrictSeq (TxCert ShelleyEra)
stakeKeyRegistrations [KeyPair Staking]
keys)
    [KeyPair Payment -> KeyPair Witness
forall (a :: KeyRole -> *) (r :: KeyRole).
HasKeyRole a =>
a r -> a Witness
asWitness KeyPair Payment
alicePay]

initLedgerState :: Integer -> LedgerState ShelleyEra
initLedgerState :: Integer -> LedgerState ShelleyEra
initLedgerState Integer
n = UTxOState ShelleyEra
-> CertState ShelleyEra -> LedgerState ShelleyEra
forall era. UTxOState era -> CertState era -> LedgerState era
LedgerState (Integer -> UTxOState ShelleyEra
initUTxO Integer
n) CertState ShelleyEra
ShelleyCertState ShelleyEra
forall a. Default a => a
def

makeLEDGERState ::
  HasCallStack => LedgerState ShelleyEra -> Tx TopTx ShelleyEra -> LedgerState ShelleyEra
makeLEDGERState :: HasCallStack =>
LedgerState ShelleyEra
-> Tx TopTx ShelleyEra -> LedgerState ShelleyEra
makeLEDGERState LedgerState ShelleyEra
start Tx TopTx ShelleyEra
tx =
  let st :: ReaderT
  Globals
  Identity
  (Either
     (NonEmpty (PredicateFailure (ShelleyLEDGER ShelleyEra)))
     (State (ShelleyLEDGER ShelleyEra)))
st = forall s (m :: * -> *) (rtype :: RuleType).
(STS s, RuleTypeRep rtype, m ~ BaseM s) =>
RuleContext rtype s
-> m (Either (NonEmpty (PredicateFailure s)) (State s))
applySTS @(ShelleyLEDGER ShelleyEra) ((Environment (ShelleyLEDGER ShelleyEra),
 State (ShelleyLEDGER ShelleyEra),
 Signal (ShelleyLEDGER ShelleyEra))
-> TRC (ShelleyLEDGER ShelleyEra)
forall sts. (Environment sts, State sts, Signal sts) -> TRC sts
TRC (LedgerEnv ShelleyEra
Environment (ShelleyLEDGER ShelleyEra)
forall era.
(EraPParams era, AtMostEra "Mary" era, AtMostEra "Alonzo" era) =>
LedgerEnv era
ledgerEnv, State (ShelleyLEDGER ShelleyEra)
LedgerState ShelleyEra
start, Tx TopTx ShelleyEra
Signal (ShelleyLEDGER ShelleyEra)
tx))
   in case ShelleyBase
  (Either
     (NonEmpty (ShelleyLedgerPredFailure ShelleyEra))
     (LedgerState ShelleyEra))
-> Either
     (NonEmpty (ShelleyLedgerPredFailure ShelleyEra))
     (LedgerState ShelleyEra)
forall a. ShelleyBase a -> a
runShelleyBase ReaderT
  Globals
  Identity
  (Either
     (NonEmpty (PredicateFailure (ShelleyLEDGER ShelleyEra)))
     (State (ShelleyLEDGER ShelleyEra)))
ShelleyBase
  (Either
     (NonEmpty (ShelleyLedgerPredFailure ShelleyEra))
     (LedgerState ShelleyEra))
st of
        Right LedgerState ShelleyEra
st' -> LedgerState ShelleyEra
st'
        Left NonEmpty (ShelleyLedgerPredFailure ShelleyEra)
e -> [Char] -> LedgerState ShelleyEra
forall a. HasCallStack => [Char] -> a
error ([Char] -> LedgerState ShelleyEra)
-> [Char] -> LedgerState ShelleyEra
forall a b. (a -> b) -> a -> b
$ NonEmpty (ShelleyLedgerPredFailure ShelleyEra) -> [Char]
forall a. Show a => a -> [Char]
show NonEmpty (ShelleyLedgerPredFailure ShelleyEra)
e

-- Create a ledger state that has registered stake credentials that
-- are seeded with (RawSeed n 0 0 0 0) to (RawSeed m 0 0 0 0).
-- It is pre-populated with 2 genesis injcoins.
ledgerStateWithNregisteredKeys :: Word64 -> Word64 -> LedgerState ShelleyEra
ledgerStateWithNregisteredKeys :: Word64 -> Word64 -> LedgerState ShelleyEra
ledgerStateWithNregisteredKeys Word64
n Word64
m =
  HasCallStack =>
LedgerState ShelleyEra
-> Tx TopTx ShelleyEra -> LedgerState ShelleyEra
LedgerState ShelleyEra
-> Tx TopTx ShelleyEra -> LedgerState ShelleyEra
makeLEDGERState (Integer -> LedgerState ShelleyEra
initLedgerState Integer
1) (Tx TopTx ShelleyEra -> LedgerState ShelleyEra)
-> Tx TopTx ShelleyEra -> LedgerState ShelleyEra
forall a b. (a -> b) -> a -> b
$ TxIx -> [KeyPair Staking] -> Tx TopTx ShelleyEra
txRegStakeKeys TxIx
forall a. Bounded a => a
minBound (Word64 -> Word64 -> [KeyPair Staking]
stakeKeys Word64
n Word64
m)

-- ===========================================================
-- Stake Key Registration example

-- Given a ledger state, presumably created by ledgerStateWithNregisteredKeys n m,
-- so that keys (RawSeed n 0 0 0 0) through (RawSeed m 0 0 0 0) are already registered,
-- register new keys (RawSeed x 0 0 0 0) through (RawSeed y 0 0 0 0).
-- Note that [n, m] must be disjoint from [x, y].
ledgerRegisterStakeKeys :: Word64 -> Word64 -> LedgerState ShelleyEra -> ()
ledgerRegisterStakeKeys :: Word64 -> Word64 -> LedgerState ShelleyEra -> ()
ledgerRegisterStakeKeys Word64
x Word64
y LedgerState ShelleyEra
state =
  LedgerState ShelleyEra
-> Tx TopTx ShelleyEra -> LedgerEnv ShelleyEra -> ()
testLEDGER
    LedgerState ShelleyEra
state
    (TxIx -> [KeyPair Staking] -> Tx TopTx ShelleyEra
txRegStakeKeys (HasCallStack => Integer -> TxIx
Integer -> TxIx
mkTxIxPartial Integer
1) (Word64 -> Word64 -> [KeyPair Staking]
stakeKeys Word64
x Word64
y))
    LedgerEnv ShelleyEra
forall era.
(EraPParams era, AtMostEra "Mary" era, AtMostEra "Alonzo" era) =>
LedgerEnv era
ledgerEnv

-- ===========================================================
-- Deregistration example

-- Create a transaction body that de-registers stake credentials,
-- corresponding to the keys seeded with (RawSeed x 0 0 0 0) to (RawSeed y 0 0 0 0)
txbDeRegStakeKey :: Word64 -> Word64 -> TxBody TopTx ShelleyEra
txbDeRegStakeKey :: Word64 -> Word64 -> TxBody TopTx ShelleyEra
txbDeRegStakeKey Word64
x Word64
y =
  Set TxIn
-> StrictSeq (TxOut ShelleyEra)
-> StrictSeq (TxCert ShelleyEra)
-> Withdrawals
-> Coin
-> SlotNo
-> StrictMaybe (Update ShelleyEra)
-> StrictMaybe TxAuxDataHash
-> TxBody TopTx ShelleyEra
ShelleyTxBody
    ([TxIn] -> Set TxIn
forall a. Ord a => [a] -> Set a
Set.fromList [HasCallStack => TxId -> Integer -> TxIn
TxId -> Integer -> TxIn
mkTxInPartial TxId
genesisId Integer
1])
    ([ShelleyTxOut ShelleyEra] -> StrictSeq (ShelleyTxOut ShelleyEra)
forall a. [a] -> StrictSeq a
StrictSeq.fromList [Addr -> Value ShelleyEra -> ShelleyTxOut ShelleyEra
forall era.
(HasCallStack, Era era, Val (Value era)) =>
Addr -> Value era -> ShelleyTxOut era
ShelleyTxOut Addr
aliceAddr (Coin -> Value ShelleyEra
forall t s. Inject t s => t -> s
inject (Coin -> Value ShelleyEra) -> Coin -> Value ShelleyEra
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
100)])
    ( [TxCert ShelleyEra] -> StrictSeq (TxCert ShelleyEra)
forall a. [a] -> StrictSeq a
StrictSeq.fromList ([TxCert ShelleyEra] -> StrictSeq (TxCert ShelleyEra))
-> [TxCert ShelleyEra] -> StrictSeq (TxCert ShelleyEra)
forall a b. (a -> b) -> a -> b
$
        (KeyPair Staking -> ShelleyTxCert ShelleyEra)
-> [KeyPair Staking] -> [ShelleyTxCert ShelleyEra]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Credential Staking -> TxCert ShelleyEra
Credential Staking -> ShelleyTxCert ShelleyEra
forall era.
ShelleyEraTxCert era =>
Credential Staking -> TxCert era
UnRegTxCert (Credential Staking -> ShelleyTxCert ShelleyEra)
-> (KeyPair Staking -> Credential Staking)
-> KeyPair Staking
-> ShelleyTxCert ShelleyEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyPair Staking -> Credential Staking
stakeKeyToCred) (Word64 -> Word64 -> [KeyPair Staking]
stakeKeys Word64
x Word64
y)
    )
    (Map RewardAccount Coin -> Withdrawals
Withdrawals Map RewardAccount Coin
forall k a. Map k a
Map.empty)
    (Integer -> Coin
Coin Integer
0)
    (Word64 -> SlotNo
SlotNo Word64
10)
    StrictMaybe (Update ShelleyEra)
forall a. StrictMaybe a
SNothing
    StrictMaybe TxAuxDataHash
forall a. StrictMaybe a
SNothing

-- Create a transaction that deregisters stake credentials numbered x through y.
-- It spends the genesis coin indexed by 1.
txDeRegStakeKeys :: Word64 -> Word64 -> Tx TopTx ShelleyEra
txDeRegStakeKeys :: Word64 -> Word64 -> Tx TopTx ShelleyEra
txDeRegStakeKeys Word64
x Word64
y =
  TxBody TopTx ShelleyEra -> [KeyPair Witness] -> Tx TopTx ShelleyEra
makeSimpleTx
    (Word64 -> Word64 -> TxBody TopTx ShelleyEra
txbDeRegStakeKey Word64
x Word64
y)
    (KeyPair Payment -> KeyPair Witness
forall (a :: KeyRole -> *) (r :: KeyRole).
HasKeyRole a =>
a r -> a Witness
asWitness KeyPair Payment
alicePay KeyPair Witness -> [KeyPair Witness] -> [KeyPair Witness]
forall a. a -> [a] -> [a]
: (KeyPair Staking -> KeyPair Witness)
-> [KeyPair Staking] -> [KeyPair Witness]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap KeyPair Staking -> KeyPair Witness
forall (a :: KeyRole -> *) (r :: KeyRole).
HasKeyRole a =>
a r -> a Witness
asWitness (Word64 -> Word64 -> [KeyPair Staking]
stakeKeys Word64
x Word64
y))

-- Given a ledger state, presumably created by ledgerStateWithNregisteredKeys n m,
-- so that keys (RawSeed n 0 0 0 0) through (RawSeed m 0 0 0 0) are already registered,
-- deregister keys (RawSeed x 0 0 0 0) through (RawSeed y 0 0 0 0).
-- Note that [x, y] must be contained in [n, m].
ledgerDeRegisterStakeKeys :: Word64 -> Word64 -> LedgerState ShelleyEra -> ()
ledgerDeRegisterStakeKeys :: Word64 -> Word64 -> LedgerState ShelleyEra -> ()
ledgerDeRegisterStakeKeys Word64
x Word64
y LedgerState ShelleyEra
state =
  LedgerState ShelleyEra
-> Tx TopTx ShelleyEra -> LedgerEnv ShelleyEra -> ()
testLEDGER
    LedgerState ShelleyEra
state
    (Word64 -> Word64 -> Tx TopTx ShelleyEra
txDeRegStakeKeys Word64
x Word64
y)
    LedgerEnv ShelleyEra
forall era.
(EraPParams era, AtMostEra "Mary" era, AtMostEra "Alonzo" era) =>
LedgerEnv era
ledgerEnv

-- ===========================================================
-- Reward Withdrawal example

-- Create a transaction body that withdrawals from reward accounts,
-- corresponding to the keys seeded with (RawSeed x 0 0 0 0) to (RawSeed y 0 0 0 0).
txbWithdrawals :: Word64 -> Word64 -> TxBody TopTx ShelleyEra
txbWithdrawals :: Word64 -> Word64 -> TxBody TopTx ShelleyEra
txbWithdrawals Word64
x Word64
y =
  Set TxIn
-> StrictSeq (TxOut ShelleyEra)
-> StrictSeq (TxCert ShelleyEra)
-> Withdrawals
-> Coin
-> SlotNo
-> StrictMaybe (Update ShelleyEra)
-> StrictMaybe TxAuxDataHash
-> TxBody TopTx ShelleyEra
ShelleyTxBody
    ([TxIn] -> Set TxIn
forall a. Ord a => [a] -> Set a
Set.fromList [HasCallStack => TxId -> Integer -> TxIn
TxId -> Integer -> TxIn
mkTxInPartial TxId
genesisId Integer
1])
    ([ShelleyTxOut ShelleyEra] -> StrictSeq (ShelleyTxOut ShelleyEra)
forall a. [a] -> StrictSeq a
StrictSeq.fromList [Addr -> Value ShelleyEra -> ShelleyTxOut ShelleyEra
forall era.
(HasCallStack, Era era, Val (Value era)) =>
Addr -> Value era -> ShelleyTxOut era
ShelleyTxOut Addr
aliceAddr (Coin -> Value ShelleyEra
forall t s. Inject t s => t -> s
inject (Coin -> Value ShelleyEra) -> Coin -> Value ShelleyEra
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
100)])
    StrictSeq (TxCert ShelleyEra)
StrictSeq (ShelleyTxCert ShelleyEra)
forall a. StrictSeq a
StrictSeq.empty
    ( Map RewardAccount Coin -> Withdrawals
Withdrawals (Map RewardAccount Coin -> Withdrawals)
-> Map RewardAccount Coin -> Withdrawals
forall a b. (a -> b) -> a -> b
$
        [(RewardAccount, Coin)] -> Map RewardAccount Coin
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(RewardAccount, Coin)] -> Map RewardAccount Coin)
-> [(RewardAccount, Coin)] -> Map RewardAccount Coin
forall a b. (a -> b) -> a -> b
$
          (KeyPair Staking -> (RewardAccount, Coin))
-> [KeyPair Staking] -> [(RewardAccount, Coin)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\KeyPair Staking
ks -> (Network -> Credential Staking -> RewardAccount
RewardAccount Network
Testnet (KeyPair Staking -> Credential Staking
stakeKeyToCred KeyPair Staking
ks), Integer -> Coin
Coin Integer
0)) (Word64 -> Word64 -> [KeyPair Staking]
stakeKeys Word64
x Word64
y)
    )
    (Integer -> Coin
Coin Integer
0)
    (Word64 -> SlotNo
SlotNo Word64
10)
    StrictMaybe (Update ShelleyEra)
forall a. StrictMaybe a
SNothing
    StrictMaybe TxAuxDataHash
forall a. StrictMaybe a
SNothing

-- Create a transaction that withdrawals from a reward accounts.
-- It spends the genesis coin indexed by 1.
txWithdrawals :: Word64 -> Word64 -> Tx TopTx ShelleyEra
txWithdrawals :: Word64 -> Word64 -> Tx TopTx ShelleyEra
txWithdrawals Word64
x Word64
y =
  TxBody TopTx ShelleyEra -> [KeyPair Witness] -> Tx TopTx ShelleyEra
makeSimpleTx
    (Word64 -> Word64 -> TxBody TopTx ShelleyEra
txbWithdrawals Word64
x Word64
y)
    (KeyPair Payment -> KeyPair Witness
forall (a :: KeyRole -> *) (r :: KeyRole).
HasKeyRole a =>
a r -> a Witness
asWitness KeyPair Payment
alicePay KeyPair Witness -> [KeyPair Witness] -> [KeyPair Witness]
forall a. a -> [a] -> [a]
: (KeyPair Staking -> KeyPair Witness)
-> [KeyPair Staking] -> [KeyPair Witness]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap KeyPair Staking -> KeyPair Witness
forall (a :: KeyRole -> *) (r :: KeyRole).
HasKeyRole a =>
a r -> a Witness
asWitness (Word64 -> Word64 -> [KeyPair Staking]
stakeKeys Word64
x Word64
y))

-- Given a ledger state, presumably created by ledgerStateWithNregisteredKeys n m,
-- so that keys (RawSeed n 0 0 0 0) through (RawSeed m 0 0 0 0) are already registered,
-- make reward withdrawals for keys (RawSeed x 0 0 0 0) through (RawSeed y 0 0 0 0).
-- Note that [x, y] must be contained in [n, m].
ledgerRewardWithdrawals :: Word64 -> Word64 -> LedgerState ShelleyEra -> ()
ledgerRewardWithdrawals :: Word64 -> Word64 -> LedgerState ShelleyEra -> ()
ledgerRewardWithdrawals Word64
x Word64
y LedgerState ShelleyEra
state = LedgerState ShelleyEra
-> Tx TopTx ShelleyEra -> LedgerEnv ShelleyEra -> ()
testLEDGER LedgerState ShelleyEra
state (Word64 -> Word64 -> Tx TopTx ShelleyEra
txWithdrawals Word64
x Word64
y) LedgerEnv ShelleyEra
forall era.
(EraPParams era, AtMostEra "Mary" era, AtMostEra "Alonzo" era) =>
LedgerEnv era
ledgerEnv

-- ===========================================================================
--
-- Register a stake pool when there are a lot of registered stake pool
--

-- Create stake pool key pairs, corresponding to seeds
-- (RawSeed start 0 0 0 0) through (RawSeed end 0 0 0 0)
poolColdKeys :: Word64 -> Word64 -> [KeyPair StakePool]
poolColdKeys :: Word64 -> Word64 -> [KeyPair StakePool]
poolColdKeys Word64
start Word64
end = (Word64 -> KeyPair StakePool) -> [Word64] -> [KeyPair StakePool]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Word64
w -> RawSeed -> KeyPair StakePool
forall (kd :: KeyRole). RawSeed -> KeyPair kd
mkKeyPair' (Word64 -> Word64 -> Word64 -> Word64 -> Word64 -> RawSeed
RawSeed Word64
w Word64
1 Word64
0 Word64
0 Word64
0)) [Word64
start .. Word64
end]

firstStakePool :: KeyPair StakePool
firstStakePool :: KeyPair StakePool
firstStakePool = RawSeed -> KeyPair StakePool
forall (kd :: KeyRole). RawSeed -> KeyPair kd
mkKeyPair' (Word64 -> Word64 -> Word64 -> Word64 -> Word64 -> RawSeed
RawSeed Word64
1 Word64
1 Word64
0 Word64
0 Word64
0)

mkPoolKeyHash :: KeyPair StakePool -> KeyHash StakePool
mkPoolKeyHash :: KeyPair StakePool -> KeyHash StakePool
mkPoolKeyHash = VKey StakePool -> KeyHash StakePool
forall (kd :: KeyRole). VKey kd -> KeyHash kd
hashKey (VKey StakePool -> KeyHash StakePool)
-> (KeyPair StakePool -> VKey StakePool)
-> KeyPair StakePool
-> KeyHash StakePool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyPair StakePool -> VKey StakePool
forall (kd :: KeyRole). KeyPair kd -> VKey kd
vKey

firstStakePoolKeyHash :: KeyHash StakePool
firstStakePoolKeyHash :: KeyHash StakePool
firstStakePoolKeyHash = KeyPair StakePool -> KeyHash StakePool
mkPoolKeyHash KeyPair StakePool
firstStakePool

vrfKeyHash :: VRFVerKeyHash StakePoolVRF
vrfKeyHash :: VRFVerKeyHash StakePoolVRF
vrfKeyHash = forall c (r :: KeyRoleVRF).
Crypto c =>
VerKeyVRF (VRF c) -> VRFVerKeyHash r
hashVerKeyVRF @MockCrypto (VerKeyVRF FakeVRF -> VRFVerKeyHash StakePoolVRF)
-> (RawSeed -> VerKeyVRF FakeVRF)
-> RawSeed
-> VRFVerKeyHash StakePoolVRF
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VRFKeyPair MockCrypto -> VerKeyVRF (VRF MockCrypto)
VRFKeyPair MockCrypto -> VerKeyVRF FakeVRF
forall c. VRFKeyPair c -> VerKeyVRF (VRF c)
vrfVerKey (VRFKeyPair MockCrypto -> VerKeyVRF FakeVRF)
-> (RawSeed -> VRFKeyPair MockCrypto)
-> RawSeed
-> VerKeyVRF FakeVRF
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. Crypto c => RawSeed -> VRFKeyPair c
mkVRFKeyPair @MockCrypto (RawSeed -> VRFVerKeyHash StakePoolVRF)
-> RawSeed -> VRFVerKeyHash StakePoolVRF
forall a b. (a -> b) -> a -> b
$ Word64 -> Word64 -> Word64 -> Word64 -> Word64 -> RawSeed
RawSeed Word64
0 Word64
0 Word64
0 Word64
0 Word64
0

mkStakePoolParams :: KeyPair StakePool -> StakePoolParams
mkStakePoolParams :: KeyPair StakePool -> StakePoolParams
mkStakePoolParams KeyPair StakePool
keys =
  StakePoolParams
    { sppId :: KeyHash StakePool
sppId = VKey StakePool -> KeyHash StakePool
forall (kd :: KeyRole). VKey kd -> KeyHash kd
hashKey (KeyPair StakePool -> VKey StakePool
forall (kd :: KeyRole). KeyPair kd -> VKey kd
vKey KeyPair StakePool
keys)
    , sppVrf :: VRFVerKeyHash StakePoolVRF
sppVrf = VRFVerKeyHash StakePoolVRF
vrfKeyHash
    , sppPledge :: Coin
sppPledge = Integer -> Coin
Coin Integer
0
    , sppCost :: Coin
sppCost = Integer -> Coin
Coin Integer
0
    , sppMargin :: UnitInterval
sppMargin = Rational -> UnitInterval
forall r.
(HasCallStack, Typeable r, BoundedRational r) =>
Rational -> r
unsafeBoundRational Rational
0
    , sppRewardAccount :: RewardAccount
sppRewardAccount = Network -> Credential Staking -> RewardAccount
RewardAccount Network
Testnet Credential Staking
firstStakeKeyCred
    , sppOwners :: Set (KeyHash Staking)
sppOwners = KeyHash Staking -> Set (KeyHash Staking)
forall a. a -> Set a
Set.singleton (KeyHash Staking -> Set (KeyHash Staking))
-> KeyHash Staking -> Set (KeyHash Staking)
forall a b. (a -> b) -> a -> b
$ VKey Staking -> KeyHash Staking
forall (kd :: KeyRole). VKey kd -> KeyHash kd
hashKey (KeyPair Staking -> VKey Staking
forall (kd :: KeyRole). KeyPair kd -> VKey kd
vKey KeyPair Staking
stakeKeyOne)
    , sppRelays :: StrictSeq StakePoolRelay
sppRelays = StrictSeq StakePoolRelay
forall a. StrictSeq a
StrictSeq.empty
    , sppMetadata :: StrictMaybe PoolMetadata
sppMetadata = StrictMaybe PoolMetadata
forall a. StrictMaybe a
SNothing
    }

-- Create stake pool registration certs
poolRegCerts :: [KeyPair StakePool] -> StrictSeq (TxCert ShelleyEra)
poolRegCerts :: [KeyPair StakePool] -> StrictSeq (TxCert ShelleyEra)
poolRegCerts = [ShelleyTxCert ShelleyEra] -> StrictSeq (ShelleyTxCert ShelleyEra)
forall a. [a] -> StrictSeq a
StrictSeq.fromList ([ShelleyTxCert ShelleyEra]
 -> StrictSeq (ShelleyTxCert ShelleyEra))
-> ([KeyPair StakePool] -> [ShelleyTxCert ShelleyEra])
-> [KeyPair StakePool]
-> StrictSeq (ShelleyTxCert ShelleyEra)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (KeyPair StakePool -> ShelleyTxCert ShelleyEra)
-> [KeyPair StakePool] -> [ShelleyTxCert ShelleyEra]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (StakePoolParams -> TxCert ShelleyEra
StakePoolParams -> ShelleyTxCert ShelleyEra
forall era. EraTxCert era => StakePoolParams -> TxCert era
RegPoolTxCert (StakePoolParams -> ShelleyTxCert ShelleyEra)
-> (KeyPair StakePool -> StakePoolParams)
-> KeyPair StakePool
-> ShelleyTxCert ShelleyEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyPair StakePool -> StakePoolParams
mkStakePoolParams)

-- Create a transaction that registers stake pools.
txRegStakePools :: TxIx -> [KeyPair StakePool] -> Tx TopTx ShelleyEra
txRegStakePools :: TxIx -> [KeyPair StakePool] -> Tx TopTx ShelleyEra
txRegStakePools TxIx
ix [KeyPair StakePool]
keys =
  TxBody TopTx ShelleyEra -> [KeyPair Witness] -> Tx TopTx ShelleyEra
makeSimpleTx
    (TxIx -> StrictSeq (TxCert ShelleyEra) -> TxBody TopTx ShelleyEra
txbFromCerts TxIx
ix (StrictSeq (TxCert ShelleyEra) -> TxBody TopTx ShelleyEra)
-> StrictSeq (TxCert ShelleyEra) -> TxBody TopTx ShelleyEra
forall a b. (a -> b) -> a -> b
$ [KeyPair StakePool] -> StrictSeq (TxCert ShelleyEra)
poolRegCerts [KeyPair StakePool]
keys)
    ([KeyPair Payment -> KeyPair Witness
forall (a :: KeyRole -> *) (r :: KeyRole).
HasKeyRole a =>
a r -> a Witness
asWitness KeyPair Payment
alicePay, KeyPair Staking -> KeyPair Witness
forall (a :: KeyRole -> *) (r :: KeyRole).
HasKeyRole a =>
a r -> a Witness
asWitness KeyPair Staking
stakeKeyOne] [KeyPair Witness] -> [KeyPair Witness] -> [KeyPair Witness]
forall a. [a] -> [a] -> [a]
++ (KeyPair StakePool -> KeyPair Witness)
-> [KeyPair StakePool] -> [KeyPair Witness]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap KeyPair StakePool -> KeyPair Witness
forall (a :: KeyRole -> *) (r :: KeyRole).
HasKeyRole a =>
a r -> a Witness
asWitness [KeyPair StakePool]
keys)

-- Create a ledger state that has n registered stake pools.
-- The keys are seeded with (RawSeed n 1 0 0 0) to (RawSeed m 1 0 0 0)
-- It is pre-populated with 2 genesis injcoins.
ledgerStateWithNregisteredPools :: Word64 -> Word64 -> LedgerState ShelleyEra
ledgerStateWithNregisteredPools :: Word64 -> Word64 -> LedgerState ShelleyEra
ledgerStateWithNregisteredPools Word64
n Word64
m =
  HasCallStack =>
LedgerState ShelleyEra
-> Tx TopTx ShelleyEra -> LedgerState ShelleyEra
LedgerState ShelleyEra
-> Tx TopTx ShelleyEra -> LedgerState ShelleyEra
makeLEDGERState (Integer -> LedgerState ShelleyEra
initLedgerState Integer
1) (Tx TopTx ShelleyEra -> LedgerState ShelleyEra)
-> Tx TopTx ShelleyEra -> LedgerState ShelleyEra
forall a b. (a -> b) -> a -> b
$ TxIx -> [KeyPair StakePool] -> Tx TopTx ShelleyEra
txRegStakePools TxIx
forall a. Bounded a => a
minBound (Word64 -> Word64 -> [KeyPair StakePool]
poolColdKeys Word64
n Word64
m)

-- ===========================================================
-- Stake Pool Registration example

-- Given a ledger state, presumably created by ledgerStateWithNregisteredPools n m,
-- so that pool keys (RawSeed n 1 0 0 0) through (RawSeed m 1 0 0 0) are already registered,
-- register new pools (RawSeed x 0 0 0 0) through (RawSeed y 0 0 0 0).
-- Note that [n, m] must be disjoint from [x, y].
ledgerRegisterStakePools :: Word64 -> Word64 -> LedgerState ShelleyEra -> ()
ledgerRegisterStakePools :: Word64 -> Word64 -> LedgerState ShelleyEra -> ()
ledgerRegisterStakePools Word64
x Word64
y LedgerState ShelleyEra
state =
  LedgerState ShelleyEra
-> Tx TopTx ShelleyEra -> LedgerEnv ShelleyEra -> ()
testLEDGER
    LedgerState ShelleyEra
state
    (TxIx -> [KeyPair StakePool] -> Tx TopTx ShelleyEra
txRegStakePools (HasCallStack => Integer -> TxIx
Integer -> TxIx
mkTxIxPartial Integer
1) (Word64 -> Word64 -> [KeyPair StakePool]
poolColdKeys Word64
x Word64
y))
    LedgerEnv ShelleyEra
forall era.
(EraPParams era, AtMostEra "Mary" era, AtMostEra "Alonzo" era) =>
LedgerEnv era
ledgerEnv

-- ===========================================================
-- Stake Pool Re-Registration/Update example

-- Given a ledger state, presumably created by ledgerStateWithNregisteredPools n m,
-- so that pool keys (RawSeed n 1 0 0 0) through (RawSeed m 1 0 0 0) are already registered,
-- re-register pools (RawSeed x 0 0 0 0) through (RawSeed y 0 0 0 0).
-- Note that [n, m] must be contained in [x, y].
ledgerReRegisterStakePools :: Word64 -> Word64 -> LedgerState ShelleyEra -> ()
ledgerReRegisterStakePools :: Word64 -> Word64 -> LedgerState ShelleyEra -> ()
ledgerReRegisterStakePools Word64
x Word64
y LedgerState ShelleyEra
state =
  LedgerState ShelleyEra
-> Tx TopTx ShelleyEra -> LedgerEnv ShelleyEra -> ()
testLEDGER
    LedgerState ShelleyEra
state
    (TxIx -> [KeyPair StakePool] -> Tx TopTx ShelleyEra
txRegStakePools (HasCallStack => Integer -> TxIx
Integer -> TxIx
mkTxIxPartial Integer
1) (Word64 -> Word64 -> [KeyPair StakePool]
poolColdKeys Word64
x Word64
y))
    LedgerEnv ShelleyEra
forall era.
(EraPParams era, AtMostEra "Mary" era, AtMostEra "Alonzo" era) =>
LedgerEnv era
ledgerEnv

-- ===========================================================
-- Stake Pool Retirement example

-- Create a transaction body that retires stake pools,
-- corresponding to the keys seeded with (RawSeed x 1 0 0 0) to (RawSeed y 1 0 0 0)
txbRetireStakePool :: Word64 -> Word64 -> TxBody TopTx ShelleyEra
txbRetireStakePool :: Word64 -> Word64 -> TxBody TopTx ShelleyEra
txbRetireStakePool Word64
x Word64
y =
  Set TxIn
-> StrictSeq (TxOut ShelleyEra)
-> StrictSeq (TxCert ShelleyEra)
-> Withdrawals
-> Coin
-> SlotNo
-> StrictMaybe (Update ShelleyEra)
-> StrictMaybe TxAuxDataHash
-> TxBody TopTx ShelleyEra
ShelleyTxBody
    ([TxIn] -> Set TxIn
forall a. Ord a => [a] -> Set a
Set.fromList [HasCallStack => TxId -> Integer -> TxIn
TxId -> Integer -> TxIn
mkTxInPartial TxId
genesisId Integer
1])
    ([ShelleyTxOut ShelleyEra] -> StrictSeq (ShelleyTxOut ShelleyEra)
forall a. [a] -> StrictSeq a
StrictSeq.fromList [Addr -> Value ShelleyEra -> ShelleyTxOut ShelleyEra
forall era.
(HasCallStack, Era era, Val (Value era)) =>
Addr -> Value era -> ShelleyTxOut era
ShelleyTxOut Addr
aliceAddr (Coin -> Value ShelleyEra
forall t s. Inject t s => t -> s
inject (Coin -> Value ShelleyEra) -> Coin -> Value ShelleyEra
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
100)])
    ( [TxCert ShelleyEra] -> StrictSeq (TxCert ShelleyEra)
forall a. [a] -> StrictSeq a
StrictSeq.fromList ([TxCert ShelleyEra] -> StrictSeq (TxCert ShelleyEra))
-> [TxCert ShelleyEra] -> StrictSeq (TxCert ShelleyEra)
forall a b. (a -> b) -> a -> b
$
        (KeyPair StakePool -> ShelleyTxCert ShelleyEra)
-> [KeyPair StakePool] -> [ShelleyTxCert ShelleyEra]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
          (\KeyPair StakePool
ks -> KeyHash StakePool -> EpochNo -> TxCert ShelleyEra
forall era.
EraTxCert era =>
KeyHash StakePool -> EpochNo -> TxCert era
RetirePoolTxCert (KeyPair StakePool -> KeyHash StakePool
mkPoolKeyHash KeyPair StakePool
ks) (Word64 -> EpochNo
EpochNo Word64
1))
          (Word64 -> Word64 -> [KeyPair StakePool]
poolColdKeys Word64
x Word64
y)
    )
    (Map RewardAccount Coin -> Withdrawals
Withdrawals Map RewardAccount Coin
forall k a. Map k a
Map.empty)
    (Integer -> Coin
Coin Integer
0)
    (Word64 -> SlotNo
SlotNo Word64
10)
    StrictMaybe (Update ShelleyEra)
forall a. StrictMaybe a
SNothing
    StrictMaybe TxAuxDataHash
forall a. StrictMaybe a
SNothing

-- Create a transaction that retires stake pools x through y.
-- It spends the genesis coin indexed by 1.
txRetireStakePool :: Word64 -> Word64 -> Tx TopTx ShelleyEra
txRetireStakePool :: Word64 -> Word64 -> Tx TopTx ShelleyEra
txRetireStakePool Word64
x Word64
y =
  TxBody TopTx ShelleyEra -> [KeyPair Witness] -> Tx TopTx ShelleyEra
makeSimpleTx
    (Word64 -> Word64 -> TxBody TopTx ShelleyEra
txbRetireStakePool Word64
x Word64
y)
    (KeyPair Payment -> KeyPair Witness
forall (a :: KeyRole -> *) (r :: KeyRole).
HasKeyRole a =>
a r -> a Witness
asWitness KeyPair Payment
alicePay KeyPair Witness -> [KeyPair Witness] -> [KeyPair Witness]
forall a. a -> [a] -> [a]
: (KeyPair StakePool -> KeyPair Witness)
-> [KeyPair StakePool] -> [KeyPair Witness]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap KeyPair StakePool -> KeyPair Witness
forall (a :: KeyRole -> *) (r :: KeyRole).
HasKeyRole a =>
a r -> a Witness
asWitness (Word64 -> Word64 -> [KeyPair StakePool]
poolColdKeys Word64
x Word64
y))

-- Given a ledger state, presumably created by ledgerStateWithNregisteredPools n m,
-- so that pool keys (RawSeed n 1 0 0 0) through (RawSeed m 1 0 0 0) are already registered,
-- retire pools (RawSeed x 0 0 0 0) through (RawSeed y 0 0 0 0).
-- Note that [n, m] must be contained in [x, y].
ledgerRetireStakePools :: Word64 -> Word64 -> LedgerState ShelleyEra -> ()
ledgerRetireStakePools :: Word64 -> Word64 -> LedgerState ShelleyEra -> ()
ledgerRetireStakePools Word64
x Word64
y LedgerState ShelleyEra
state = LedgerState ShelleyEra
-> Tx TopTx ShelleyEra -> LedgerEnv ShelleyEra -> ()
testLEDGER LedgerState ShelleyEra
state (Word64 -> Word64 -> Tx TopTx ShelleyEra
txRetireStakePool Word64
x Word64
y) LedgerEnv ShelleyEra
forall era.
(EraPParams era, AtMostEra "Mary" era, AtMostEra "Alonzo" era) =>
LedgerEnv era
ledgerEnv

-- ===========================================================================
--
-- Delegate Stake Credentials when many stake keys and stake pools are registered.
--

-- Create a ledger state that has n registered stake keys and m stake pools.
-- The stake keys are seeded with (RawSeed 1 0 0 0 0) to (RawSeed n 0 0 0 0)
-- The stake pools are seeded with (RawSeed 1 1 0 0 0) to (RawSeed m 1 0 0 0)
-- It is pre-populated with 3 genesis injcoins.
ledgerStateWithNkeysMpools :: Word64 -> Word64 -> LedgerState ShelleyEra
ledgerStateWithNkeysMpools :: Word64 -> Word64 -> LedgerState ShelleyEra
ledgerStateWithNkeysMpools Word64
n Word64
m =
  HasCallStack =>
LedgerState ShelleyEra
-> Tx TopTx ShelleyEra -> LedgerState ShelleyEra
LedgerState ShelleyEra
-> Tx TopTx ShelleyEra -> LedgerState ShelleyEra
makeLEDGERState
    (HasCallStack =>
LedgerState ShelleyEra
-> Tx TopTx ShelleyEra -> LedgerState ShelleyEra
LedgerState ShelleyEra
-> Tx TopTx ShelleyEra -> LedgerState ShelleyEra
makeLEDGERState (Integer -> LedgerState ShelleyEra
initLedgerState Integer
2) (Tx TopTx ShelleyEra -> LedgerState ShelleyEra)
-> Tx TopTx ShelleyEra -> LedgerState ShelleyEra
forall a b. (a -> b) -> a -> b
$ TxIx -> [KeyPair Staking] -> Tx TopTx ShelleyEra
txRegStakeKeys TxIx
forall a. Bounded a => a
minBound (Word64 -> Word64 -> [KeyPair Staking]
stakeKeys Word64
1 Word64
n))
    (TxIx -> [KeyPair StakePool] -> Tx TopTx ShelleyEra
txRegStakePools (HasCallStack => Integer -> TxIx
Integer -> TxIx
mkTxIxPartial Integer
1) (Word64 -> Word64 -> [KeyPair StakePool]
poolColdKeys Word64
1 Word64
m))

-- Create a transaction body that delegates several keys to ONE stake pool,
-- corresponding to the keys seeded with (RawSeed n 0 0 0 0) to (RawSeed m 0 0 0 0)
txbDelegate :: Word64 -> Word64 -> TxBody TopTx ShelleyEra
txbDelegate :: Word64 -> Word64 -> TxBody TopTx ShelleyEra
txbDelegate Word64
n Word64
m =
  Set TxIn
-> StrictSeq (TxOut ShelleyEra)
-> StrictSeq (TxCert ShelleyEra)
-> Withdrawals
-> Coin
-> SlotNo
-> StrictMaybe (Update ShelleyEra)
-> StrictMaybe TxAuxDataHash
-> TxBody TopTx ShelleyEra
ShelleyTxBody
    ([TxIn] -> Set TxIn
forall a. Ord a => [a] -> Set a
Set.fromList [HasCallStack => TxId -> Integer -> TxIn
TxId -> Integer -> TxIn
mkTxInPartial TxId
genesisId Integer
2])
    ([ShelleyTxOut ShelleyEra] -> StrictSeq (ShelleyTxOut ShelleyEra)
forall a. [a] -> StrictSeq a
StrictSeq.fromList [Addr -> Value ShelleyEra -> ShelleyTxOut ShelleyEra
forall era.
(HasCallStack, Era era, Val (Value era)) =>
Addr -> Value era -> ShelleyTxOut era
ShelleyTxOut Addr
aliceAddr (Coin -> Value ShelleyEra
forall t s. Inject t s => t -> s
inject (Coin -> Value ShelleyEra) -> Coin -> Value ShelleyEra
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
100)])
    ( [TxCert ShelleyEra] -> StrictSeq (TxCert ShelleyEra)
forall a. [a] -> StrictSeq a
StrictSeq.fromList ([TxCert ShelleyEra] -> StrictSeq (TxCert ShelleyEra))
-> [TxCert ShelleyEra] -> StrictSeq (TxCert ShelleyEra)
forall a b. (a -> b) -> a -> b
$
        (KeyPair Staking -> ShelleyTxCert ShelleyEra)
-> [KeyPair Staking] -> [ShelleyTxCert ShelleyEra]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
          (\KeyPair Staking
ks -> Credential Staking -> KeyHash StakePool -> TxCert ShelleyEra
forall era.
ShelleyEraTxCert era =>
Credential Staking -> KeyHash StakePool -> TxCert era
DelegStakeTxCert (KeyPair Staking -> Credential Staking
stakeKeyToCred KeyPair Staking
ks) KeyHash StakePool
firstStakePoolKeyHash)
          (Word64 -> Word64 -> [KeyPair Staking]
stakeKeys Word64
n Word64
m)
    )
    (Map RewardAccount Coin -> Withdrawals
Withdrawals Map RewardAccount Coin
forall k a. Map k a
Map.empty)
    (Integer -> Coin
Coin Integer
0)
    (Word64 -> SlotNo
SlotNo Word64
10)
    StrictMaybe (Update ShelleyEra)
forall a. StrictMaybe a
SNothing
    StrictMaybe TxAuxDataHash
forall a. StrictMaybe a
SNothing

-- Create a transaction that delegates stake.
txDelegate :: Word64 -> Word64 -> Tx TopTx ShelleyEra
txDelegate :: Word64 -> Word64 -> Tx TopTx ShelleyEra
txDelegate Word64
n Word64
m =
  TxBody TopTx ShelleyEra -> [KeyPair Witness] -> Tx TopTx ShelleyEra
makeSimpleTx
    (Word64 -> Word64 -> TxBody TopTx ShelleyEra
txbDelegate Word64
n Word64
m)
    (KeyPair Payment -> KeyPair Witness
forall (a :: KeyRole -> *) (r :: KeyRole).
HasKeyRole a =>
a r -> a Witness
asWitness KeyPair Payment
alicePay KeyPair Witness -> [KeyPair Witness] -> [KeyPair Witness]
forall a. a -> [a] -> [a]
: (KeyPair Staking -> KeyPair Witness)
-> [KeyPair Staking] -> [KeyPair Witness]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap KeyPair Staking -> KeyPair Witness
forall (a :: KeyRole -> *) (r :: KeyRole).
HasKeyRole a =>
a r -> a Witness
asWitness (Word64 -> Word64 -> [KeyPair Staking]
stakeKeys Word64
n Word64
m))

-- Given a ledger state, presumably created by ledgerStateWithNkeysMpools n m,
-- so that stake keys (RawSeed 1 0 0 0 0) through (RawSeed n 0 0 0 0) are already registered
-- and pool keys (RawSeed 1 1 0 0 0) through (RawSeed m 1 0 0 0) are already registered,
-- delegate stake keys (RawSeed x 0 0 0 0) through (RawSeed y 0 0 0 0) to ONE pool.
-- Note that [x, y] must be contained in [1, n].
ledgerDelegateManyKeysOnePool :: Word64 -> Word64 -> LedgerState ShelleyEra -> ()
ledgerDelegateManyKeysOnePool :: Word64 -> Word64 -> LedgerState ShelleyEra -> ()
ledgerDelegateManyKeysOnePool Word64
x Word64
y LedgerState ShelleyEra
state = LedgerState ShelleyEra
-> Tx TopTx ShelleyEra -> LedgerEnv ShelleyEra -> ()
testLEDGER LedgerState ShelleyEra
state (Word64 -> Word64 -> Tx TopTx ShelleyEra
txDelegate Word64
x Word64
y) LedgerEnv ShelleyEra
forall era.
(EraPParams era, AtMostEra "Mary" era, AtMostEra "Alonzo" era) =>
LedgerEnv era
ledgerEnv