{-# 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.PoolParams (
  PoolParams (..),
  ppCost,
  ppId,
  ppMargin,
  ppMetadata,
  ppOwners,
  ppPledge,
  ppRelays,
  ppRewardAccount,
  ppVrf,
 )
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.Tx (ShelleyTx (..))
import Cardano.Ledger.Shelley.TxBody (TxBody (ShelleyTxBody))
import Cardano.Ledger.Shelley.TxOut (ShelleyTxOut (..))
import Cardano.Ledger.Shelley.TxWits (addrWits)
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, ProtVerAtMost era 4, ProtVerAtMost era 6) => PParams era
ppsBench :: forall era.
(EraPParams era, ProtVerAtMost era 4, ProtVerAtMost era 6) =>
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, ProtVerAtMost era 6) =>
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, ProtVerAtMost era 4) =>
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 => 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, ProtVerAtMost era 4, ProtVerAtMost era 6) => LedgerEnv era
ledgerEnv :: forall era.
(EraPParams era, ProtVerAtMost era 4, ProtVerAtMost era 6) =>
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, ProtVerAtMost era 4, ProtVerAtMost era 6) =>
PParams era
ppsBench (Coin -> Coin -> ChainAccountState
ChainAccountState (Integer -> Coin
Coin Integer
0) (Integer -> Coin
Coin Integer
0))

testLEDGER ::
  LedgerState ShelleyEra ->
  ShelleyTx ShelleyEra ->
  LedgerEnv ShelleyEra ->
  ()
testLEDGER :: LedgerState ShelleyEra
-> ShelleyTx ShelleyEra -> LedgerEnv ShelleyEra -> ()
testLEDGER LedgerState ShelleyEra
initSt ShelleyTx 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, ShelleyTx 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 ShelleyEra
txbSpendOneUTxO :: TxBody ShelleyEra
txbSpendOneUTxO =
  Set TxIn
-> StrictSeq (TxOut ShelleyEra)
-> StrictSeq (TxCert ShelleyEra)
-> Withdrawals
-> Coin
-> SlotNo
-> StrictMaybe (Update ShelleyEra)
-> StrictMaybe TxAuxDataHash
-> TxBody ShelleyEra
ShelleyTxBody
    ([TxIn] -> Set TxIn
forall a. Ord a => [a] -> Set a
Set.fromList [TxId -> TxIx -> TxIn
TxIn TxId
genesisId TxIx
forall a. Bounded a => a
minBound])
    ( [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 :: ShelleyTx ShelleyEra
txSpendOneUTxO :: ShelleyTx ShelleyEra
txSpendOneUTxO =
  TxBody ShelleyEra
-> TxWits ShelleyEra
-> StrictMaybe (TxAuxData ShelleyEra)
-> ShelleyTx ShelleyEra
forall era.
EraTx era =>
TxBody era
-> TxWits era -> StrictMaybe (TxAuxData era) -> ShelleyTx era
ShelleyTx
    TxBody ShelleyEra
txbSpendOneUTxO
    ShelleyTxWits ShelleyEra
forall a. Monoid a => a
mempty
      { addrWits = mkWitnessesVKey (hashAnnotated txbSpendOneUTxO) [asWitness alicePay]
      }
    StrictMaybe (TxAuxData ShelleyEra)
StrictMaybe (ShelleyTxAuxData ShelleyEra)
forall a. StrictMaybe a
SNothing

ledgerSpendOneUTxO :: Integer -> ()
ledgerSpendOneUTxO :: Integer -> ()
ledgerSpendOneUTxO Integer
n = LedgerState ShelleyEra
-> ShelleyTx ShelleyEra -> LedgerEnv ShelleyEra -> ()
testLEDGER (Integer -> LedgerState ShelleyEra
initLedgerState Integer
n) ShelleyTx ShelleyEra
txSpendOneUTxO LedgerEnv ShelleyEra
forall era.
(EraPParams era, ProtVerAtMost era 4, ProtVerAtMost era 6) =>
LedgerEnv era
ledgerEnv

ledgerSpendOneGivenUTxO :: UTxOState ShelleyEra -> ()
ledgerSpendOneGivenUTxO :: UTxOState ShelleyEra -> ()
ledgerSpendOneGivenUTxO UTxOState ShelleyEra
state = LedgerState ShelleyEra
-> ShelleyTx 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) ShelleyTx ShelleyEra
txSpendOneUTxO LedgerEnv ShelleyEra
forall era.
(EraPParams era, ProtVerAtMost era 4, ProtVerAtMost era 6) =>
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 ShelleyEra
txbFromCerts :: TxIx -> StrictSeq (TxCert ShelleyEra) -> TxBody 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 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 ShelleyEra ->
  [KeyPair 'Witness] ->
  ShelleyTx ShelleyEra
makeSimpleTx :: TxBody ShelleyEra -> [KeyPair 'Witness] -> ShelleyTx ShelleyEra
makeSimpleTx TxBody ShelleyEra
txbody [KeyPair 'Witness]
keysAddr =
  TxBody ShelleyEra
-> TxWits ShelleyEra
-> StrictMaybe (TxAuxData ShelleyEra)
-> ShelleyTx ShelleyEra
forall era.
EraTx era =>
TxBody era
-> TxWits era -> StrictMaybe (TxAuxData era) -> ShelleyTx era
ShelleyTx
    TxBody ShelleyEra
txbody
    ShelleyTxWits ShelleyEra
forall a. Monoid a => a
mempty
      { addrWits = mkWitnessesVKey (hashAnnotated txbody) keysAddr
      }
    StrictMaybe (TxAuxData ShelleyEra)
StrictMaybe (ShelleyTxAuxData ShelleyEra)
forall a. StrictMaybe a
SNothing

-- Create a transaction that registers stake credentials.
txRegStakeKeys :: TxIx -> [KeyPair 'Staking] -> ShelleyTx ShelleyEra
txRegStakeKeys :: TxIx -> [KeyPair 'Staking] -> ShelleyTx ShelleyEra
txRegStakeKeys TxIx
ix [KeyPair 'Staking]
keys =
  TxBody ShelleyEra -> [KeyPair 'Witness] -> ShelleyTx ShelleyEra
makeSimpleTx
    (TxIx -> StrictSeq (TxCert ShelleyEra) -> TxBody ShelleyEra
txbFromCerts TxIx
ix (StrictSeq (TxCert ShelleyEra) -> TxBody ShelleyEra)
-> StrictSeq (TxCert ShelleyEra) -> TxBody 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 -> ShelleyTx ShelleyEra -> LedgerState ShelleyEra
makeLEDGERState :: HasCallStack =>
LedgerState ShelleyEra
-> ShelleyTx ShelleyEra -> LedgerState ShelleyEra
makeLEDGERState LedgerState ShelleyEra
start ShelleyTx 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, ProtVerAtMost era 4, ProtVerAtMost era 6) =>
LedgerEnv era
ledgerEnv, State (ShelleyLEDGER ShelleyEra)
LedgerState ShelleyEra
start, ShelleyTx 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
-> ShelleyTx ShelleyEra -> LedgerState ShelleyEra
LedgerState ShelleyEra
-> ShelleyTx ShelleyEra -> LedgerState ShelleyEra
makeLEDGERState (Integer -> LedgerState ShelleyEra
initLedgerState Integer
1) (ShelleyTx ShelleyEra -> LedgerState ShelleyEra)
-> ShelleyTx ShelleyEra -> LedgerState ShelleyEra
forall a b. (a -> b) -> a -> b
$ TxIx -> [KeyPair 'Staking] -> ShelleyTx 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
-> ShelleyTx ShelleyEra -> LedgerEnv ShelleyEra -> ()
testLEDGER
    LedgerState ShelleyEra
state
    (TxIx -> [KeyPair 'Staking] -> ShelleyTx 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, ProtVerAtMost era 4, ProtVerAtMost era 6) =>
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 ShelleyEra
txbDeRegStakeKey :: Word64 -> Word64 -> TxBody ShelleyEra
txbDeRegStakeKey Word64
x Word64
y =
  Set TxIn
-> StrictSeq (TxOut ShelleyEra)
-> StrictSeq (TxCert ShelleyEra)
-> Withdrawals
-> Coin
-> SlotNo
-> StrictMaybe (Update ShelleyEra)
-> StrictMaybe TxAuxDataHash
-> TxBody ShelleyEra
ShelleyTxBody
    ([TxIn] -> Set TxIn
forall a. Ord a => [a] -> Set a
Set.fromList [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 -> ShelleyTx ShelleyEra
txDeRegStakeKeys :: Word64 -> Word64 -> ShelleyTx ShelleyEra
txDeRegStakeKeys Word64
x Word64
y =
  TxBody ShelleyEra -> [KeyPair 'Witness] -> ShelleyTx ShelleyEra
makeSimpleTx
    (Word64 -> Word64 -> TxBody 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
-> ShelleyTx ShelleyEra -> LedgerEnv ShelleyEra -> ()
testLEDGER
    LedgerState ShelleyEra
state
    (Word64 -> Word64 -> ShelleyTx ShelleyEra
txDeRegStakeKeys Word64
x Word64
y)
    LedgerEnv ShelleyEra
forall era.
(EraPParams era, ProtVerAtMost era 4, ProtVerAtMost era 6) =>
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 ShelleyEra
txbWithdrawals :: Word64 -> Word64 -> TxBody ShelleyEra
txbWithdrawals Word64
x Word64
y =
  Set TxIn
-> StrictSeq (TxOut ShelleyEra)
-> StrictSeq (TxCert ShelleyEra)
-> Withdrawals
-> Coin
-> SlotNo
-> StrictMaybe (Update ShelleyEra)
-> StrictMaybe TxAuxDataHash
-> TxBody ShelleyEra
ShelleyTxBody
    ([TxIn] -> Set TxIn
forall a. Ord a => [a] -> Set a
Set.fromList [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 -> ShelleyTx ShelleyEra
txWithdrawals :: Word64 -> Word64 -> ShelleyTx ShelleyEra
txWithdrawals Word64
x Word64
y =
  TxBody ShelleyEra -> [KeyPair 'Witness] -> ShelleyTx ShelleyEra
makeSimpleTx
    (Word64 -> Word64 -> TxBody 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
-> ShelleyTx ShelleyEra -> LedgerEnv ShelleyEra -> ()
testLEDGER LedgerState ShelleyEra
state (Word64 -> Word64 -> ShelleyTx ShelleyEra
txWithdrawals Word64
x Word64
y) LedgerEnv ShelleyEra
forall era.
(EraPParams era, ProtVerAtMost era 4, ProtVerAtMost era 6) =>
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

mkPoolParameters :: KeyPair 'StakePool -> PoolParams
mkPoolParameters :: KeyPair 'StakePool -> PoolParams
mkPoolParameters KeyPair 'StakePool
keys =
  PoolParams
    { ppId :: KeyHash 'StakePool
ppId = 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)
    , ppVrf :: VRFVerKeyHash 'StakePoolVRF
ppVrf = VRFVerKeyHash 'StakePoolVRF
vrfKeyHash
    , ppPledge :: Coin
ppPledge = Integer -> Coin
Coin Integer
0
    , ppCost :: Coin
ppCost = Integer -> Coin
Coin Integer
0
    , ppMargin :: UnitInterval
ppMargin = Rational -> UnitInterval
forall r.
(HasCallStack, Typeable r, BoundedRational r) =>
Rational -> r
unsafeBoundRational Rational
0
    , ppRewardAccount :: RewardAccount
ppRewardAccount = Network -> Credential 'Staking -> RewardAccount
RewardAccount Network
Testnet Credential 'Staking
firstStakeKeyCred
    , ppOwners :: Set (KeyHash 'Staking)
ppOwners = 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)
    , ppRelays :: StrictSeq StakePoolRelay
ppRelays = StrictSeq StakePoolRelay
forall a. StrictSeq a
StrictSeq.empty
    , ppMetadata :: StrictMaybe PoolMetadata
ppMetadata = 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 (PoolParams -> TxCert ShelleyEra
PoolParams -> ShelleyTxCert ShelleyEra
forall era. EraTxCert era => PoolParams -> TxCert era
RegPoolTxCert (PoolParams -> ShelleyTxCert ShelleyEra)
-> (KeyPair 'StakePool -> PoolParams)
-> KeyPair 'StakePool
-> ShelleyTxCert ShelleyEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyPair 'StakePool -> PoolParams
mkPoolParameters)

-- Create a transaction that registers stake pools.
txRegStakePools :: TxIx -> [KeyPair 'StakePool] -> ShelleyTx ShelleyEra
txRegStakePools :: TxIx -> [KeyPair 'StakePool] -> ShelleyTx ShelleyEra
txRegStakePools TxIx
ix [KeyPair 'StakePool]
keys =
  TxBody ShelleyEra -> [KeyPair 'Witness] -> ShelleyTx ShelleyEra
makeSimpleTx
    (TxIx -> StrictSeq (TxCert ShelleyEra) -> TxBody ShelleyEra
txbFromCerts TxIx
ix (StrictSeq (TxCert ShelleyEra) -> TxBody ShelleyEra)
-> StrictSeq (TxCert ShelleyEra) -> TxBody 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
-> ShelleyTx ShelleyEra -> LedgerState ShelleyEra
LedgerState ShelleyEra
-> ShelleyTx ShelleyEra -> LedgerState ShelleyEra
makeLEDGERState (Integer -> LedgerState ShelleyEra
initLedgerState Integer
1) (ShelleyTx ShelleyEra -> LedgerState ShelleyEra)
-> ShelleyTx ShelleyEra -> LedgerState ShelleyEra
forall a b. (a -> b) -> a -> b
$ TxIx -> [KeyPair 'StakePool] -> ShelleyTx 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
-> ShelleyTx ShelleyEra -> LedgerEnv ShelleyEra -> ()
testLEDGER
    LedgerState ShelleyEra
state
    (TxIx -> [KeyPair 'StakePool] -> ShelleyTx 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, ProtVerAtMost era 4, ProtVerAtMost era 6) =>
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
-> ShelleyTx ShelleyEra -> LedgerEnv ShelleyEra -> ()
testLEDGER
    LedgerState ShelleyEra
state
    (TxIx -> [KeyPair 'StakePool] -> ShelleyTx 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, ProtVerAtMost era 4, ProtVerAtMost era 6) =>
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 ShelleyEra
txbRetireStakePool :: Word64 -> Word64 -> TxBody ShelleyEra
txbRetireStakePool Word64
x Word64
y =
  Set TxIn
-> StrictSeq (TxOut ShelleyEra)
-> StrictSeq (TxCert ShelleyEra)
-> Withdrawals
-> Coin
-> SlotNo
-> StrictMaybe (Update ShelleyEra)
-> StrictMaybe TxAuxDataHash
-> TxBody ShelleyEra
ShelleyTxBody
    ([TxIn] -> Set TxIn
forall a. Ord a => [a] -> Set a
Set.fromList [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 -> ShelleyTx ShelleyEra
txRetireStakePool :: Word64 -> Word64 -> ShelleyTx ShelleyEra
txRetireStakePool Word64
x Word64
y =
  TxBody ShelleyEra -> [KeyPair 'Witness] -> ShelleyTx ShelleyEra
makeSimpleTx
    (Word64 -> Word64 -> TxBody 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
-> ShelleyTx ShelleyEra -> LedgerEnv ShelleyEra -> ()
testLEDGER LedgerState ShelleyEra
state (Word64 -> Word64 -> ShelleyTx ShelleyEra
txRetireStakePool Word64
x Word64
y) LedgerEnv ShelleyEra
forall era.
(EraPParams era, ProtVerAtMost era 4, ProtVerAtMost era 6) =>
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
-> ShelleyTx ShelleyEra -> LedgerState ShelleyEra
LedgerState ShelleyEra
-> ShelleyTx ShelleyEra -> LedgerState ShelleyEra
makeLEDGERState
    (HasCallStack =>
LedgerState ShelleyEra
-> ShelleyTx ShelleyEra -> LedgerState ShelleyEra
LedgerState ShelleyEra
-> ShelleyTx ShelleyEra -> LedgerState ShelleyEra
makeLEDGERState (Integer -> LedgerState ShelleyEra
initLedgerState Integer
2) (ShelleyTx ShelleyEra -> LedgerState ShelleyEra)
-> ShelleyTx ShelleyEra -> LedgerState ShelleyEra
forall a b. (a -> b) -> a -> b
$ TxIx -> [KeyPair 'Staking] -> ShelleyTx ShelleyEra
txRegStakeKeys TxIx
forall a. Bounded a => a
minBound (Word64 -> Word64 -> [KeyPair 'Staking]
stakeKeys Word64
1 Word64
n))
    (TxIx -> [KeyPair 'StakePool] -> ShelleyTx 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 ShelleyEra
txbDelegate :: Word64 -> Word64 -> TxBody ShelleyEra
txbDelegate Word64
n Word64
m =
  Set TxIn
-> StrictSeq (TxOut ShelleyEra)
-> StrictSeq (TxCert ShelleyEra)
-> Withdrawals
-> Coin
-> SlotNo
-> StrictMaybe (Update ShelleyEra)
-> StrictMaybe TxAuxDataHash
-> TxBody ShelleyEra
ShelleyTxBody
    ([TxIn] -> Set TxIn
forall a. Ord a => [a] -> Set a
Set.fromList [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 -> ShelleyTx ShelleyEra
txDelegate :: Word64 -> Word64 -> ShelleyTx ShelleyEra
txDelegate Word64
n Word64
m =
  TxBody ShelleyEra -> [KeyPair 'Witness] -> ShelleyTx ShelleyEra
makeSimpleTx
    (Word64 -> Word64 -> TxBody 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
-> ShelleyTx ShelleyEra -> LedgerEnv ShelleyEra -> ()
testLEDGER LedgerState ShelleyEra
state (Word64 -> Word64 -> ShelleyTx ShelleyEra
txDelegate Word64
x Word64
y) LedgerEnv ShelleyEra
forall era.
(EraPParams era, ProtVerAtMost era 4, ProtVerAtMost era 6) =>
LedgerEnv era
ledgerEnv