{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}

-- | The example transactions in this module are not valid transactions. We
-- don't care, we are only interested in serialisation, not validation.
module Test.Cardano.Ledger.Shelley.Examples (
  LedgerExamples (..),
  ledgerExamples,
  -- functions used in building examples for other eras
  mkShelleyBasedLedgerExamples,
  exampleShelleyBasedTx,
  addShelleyBasedTopTxExampleFee,
  addShelleyToBabbageExampleProposedPUpdates,
  addShelleyToBabbageTxCerts,
  addShelleyToConwayTxCerts,
  exampleNonMyopicRewards,
  exampleCoin,
  examplePayKey,
  exampleStakeKey,
  exampleNewEpochState,
  examplePoolDistr,
  exampleStakePoolParams,
  exampleTxIns,
  exampleVrfVerKeyHash,
  exampleProposedPPUpdates,
  exampleByronAddress,
  exampleShelleyScript,
  testShelleyGenesis,
  -- utility functions
  mkDSIGNKeyPair,
  mkKeyHash,
  mkScriptHash,
  seedFromByte,
  seedFromWords,
) where

import Cardano.Base.IP (toIPv4, toIPv6)
import qualified Cardano.Chain.Common as Byron
import Cardano.Crypto.DSIGN as DSIGN
import Cardano.Crypto.Hash as Hash
import Cardano.Crypto.Seed as Seed
import qualified Cardano.Crypto.Signing as Byron
import qualified Cardano.Crypto.Wallet as Byron
import Cardano.Ledger.Address (BootstrapAddress (..))
import Cardano.Ledger.BaseTypes
import Cardano.Ledger.Binary (EncCBOR (..), hashWithEncoder)
import Cardano.Ledger.Coin
import Cardano.Ledger.Credential (SlotNo32 (..))
import Cardano.Ledger.Keys
import Cardano.Ledger.Shelley (ShelleyEra)
import Cardano.Ledger.Shelley.API
import Cardano.Ledger.Shelley.Core
import Cardano.Ledger.Shelley.LedgerState
import Cardano.Ledger.Shelley.Rules
import Cardano.Ledger.Shelley.Scripts (
  ShelleyEraScript,
  pattern RequireAllOf,
  pattern RequireAnyOf,
  pattern RequireMOf,
  pattern RequireSignature,
 )
import Cardano.Ledger.Shelley.State
import Cardano.Ledger.Shelley.Translation (emptyFromByronTranslationContext)
import Cardano.Slotting.EpochInfo
import qualified Data.ByteString as Strict
import Data.Coerce (coerce)
import Data.Default
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import qualified Data.MapExtras as Map
import Data.Maybe (fromJust)
import Data.MemPack.Buffer (byteArrayFromShortByteString)
import Data.Proxy (Proxy (Proxy))
import qualified Data.Sequence.Strict as StrictSeq
import Data.Set (Set)
import qualified Data.Set as Set
import Data.Time
import Data.Typeable (Typeable)
import Data.Word (Word64, Word8)
import Lens.Micro ((&), (.~), (<>~))
import Test.Cardano.Ledger.Binary.Random (mkDummyHash)
import Test.Cardano.Ledger.Core.KeyPair (KeyPair (..), mkAddr, mkWitnessesVKey)
import Test.Cardano.Ledger.Core.Utils (mkDummySafeHash, testGlobals, unsafeBoundRational)
import Test.Cardano.Ledger.Shelley.Arbitrary (RawSeed (..))

data LedgerExamples era = LedgerExamples
  { -- tx
    forall era. LedgerExamples era -> Tx TopTx era
leTx :: Tx TopTx era
  , forall era. LedgerExamples era -> ApplyTxError era
leApplyTxError :: ApplyTxError era
  , -- protocol parameters
    forall era. LedgerExamples era -> PParams era
lePParams :: PParams era
  , forall era. LedgerExamples era -> ProposedPPUpdates era
leProposedPPUpdates :: ProposedPPUpdates era
  , -- Ledger state
    forall era. LedgerExamples era -> NewEpochState era
leNewEpochState :: NewEpochState era
  , forall era. LedgerExamples era -> PoolDistr
lePoolDistr :: PoolDistr
  , -- rewards and delegation
    forall era.
LedgerExamples era -> Set (Either Coin (Credential Staking))
leRewardsCredentials :: Set (Either Coin (Credential Staking))
  , forall era.
LedgerExamples era
-> Map
     (Either Coin (Credential Staking)) (Map (KeyHash StakePool) Coin)
leNonMyopicRewards ::
      Map
        (Either Coin (Credential Staking))
        (Map (KeyHash StakePool) Coin)
  , forall era. LedgerExamples era -> TranslationContext era
leTranslationContext :: TranslationContext era
  , forall era. LedgerExamples era -> ShelleyGenesis
leShelleyGenesis :: ShelleyGenesis
  }

deriving instance
  ( EraTx era
  , Eq (PParams era)
  , Eq (PParamsUpdate era)
  , EraGov era
  , Eq (Tx TopTx era)
  , Eq (ApplyTxError era)
  , Eq (StashedAVVMAddresses era)
  , Eq (TranslationContext era)
  , Eq (CertState era)
  , Eq (InstantStake era)
  ) =>
  Eq (LedgerExamples era)

ledgerExamples :: LedgerExamples ShelleyEra
ledgerExamples :: LedgerExamples ShelleyEra
ledgerExamples =
  ApplyTxError ShelleyEra
-> Value ShelleyEra
-> Tx TopTx ShelleyEra
-> TranslationContext ShelleyEra
-> LedgerExamples ShelleyEra
forall era.
(EraTx era, EraGov era, EraStake era, EraCertState era,
 Default (StashedAVVMAddresses era), AtMostEra "Mary" era) =>
ApplyTxError era
-> Value era
-> Tx TopTx era
-> TranslationContext era
-> LedgerExamples era
mkShelleyBasedLedgerExamples
    ( NonEmpty (ShelleyLedgerPredFailure ShelleyEra)
-> ApplyTxError ShelleyEra
ShelleyApplyTxError (NonEmpty (ShelleyLedgerPredFailure ShelleyEra)
 -> ApplyTxError ShelleyEra)
-> (ShelleyDelegPredFailure ShelleyEra
    -> NonEmpty (ShelleyLedgerPredFailure ShelleyEra))
-> ShelleyDelegPredFailure ShelleyEra
-> ApplyTxError ShelleyEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShelleyLedgerPredFailure ShelleyEra
-> NonEmpty (ShelleyLedgerPredFailure ShelleyEra)
forall a. a -> NonEmpty a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ShelleyLedgerPredFailure ShelleyEra
 -> NonEmpty (ShelleyLedgerPredFailure ShelleyEra))
-> (ShelleyDelegPredFailure ShelleyEra
    -> ShelleyLedgerPredFailure ShelleyEra)
-> ShelleyDelegPredFailure ShelleyEra
-> NonEmpty (ShelleyLedgerPredFailure ShelleyEra)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PredicateFailure (EraRule "DELEGS" ShelleyEra)
-> ShelleyLedgerPredFailure ShelleyEra
ShelleyDelegsPredFailure ShelleyEra
-> ShelleyLedgerPredFailure ShelleyEra
forall era.
PredicateFailure (EraRule "DELEGS" era)
-> ShelleyLedgerPredFailure era
DelegsFailure (ShelleyDelegsPredFailure ShelleyEra
 -> ShelleyLedgerPredFailure ShelleyEra)
-> (ShelleyDelegPredFailure ShelleyEra
    -> ShelleyDelegsPredFailure ShelleyEra)
-> ShelleyDelegPredFailure ShelleyEra
-> ShelleyLedgerPredFailure ShelleyEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PredicateFailure (EraRule "DELPL" ShelleyEra)
-> ShelleyDelegsPredFailure ShelleyEra
ShelleyDelplPredFailure ShelleyEra
-> ShelleyDelegsPredFailure ShelleyEra
forall era.
PredicateFailure (EraRule "DELPL" era)
-> ShelleyDelegsPredFailure era
DelplFailure (ShelleyDelplPredFailure ShelleyEra
 -> ShelleyDelegsPredFailure ShelleyEra)
-> (ShelleyDelegPredFailure ShelleyEra
    -> ShelleyDelplPredFailure ShelleyEra)
-> ShelleyDelegPredFailure ShelleyEra
-> ShelleyDelegsPredFailure ShelleyEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PredicateFailure (EraRule "DELEG" ShelleyEra)
-> ShelleyDelplPredFailure ShelleyEra
ShelleyDelegPredFailure ShelleyEra
-> ShelleyDelplPredFailure ShelleyEra
forall era.
PredicateFailure (EraRule "DELEG" era)
-> ShelleyDelplPredFailure era
DelegFailure (ShelleyDelegPredFailure ShelleyEra -> ApplyTxError ShelleyEra)
-> ShelleyDelegPredFailure ShelleyEra -> ApplyTxError ShelleyEra
forall a b. (a -> b) -> a -> b
$
        forall era. KeyHash StakePool -> ShelleyDelegPredFailure era
DelegateeNotRegisteredDELEG @ShelleyEra (Int -> KeyHash StakePool
forall (discriminator :: KeyRole). Int -> KeyHash discriminator
mkKeyHash Int
1)
    )
    Coin
Value ShelleyEra
exampleCoin
    Tx TopTx ShelleyEra
exampleShelleyTx
    TranslationContext ShelleyEra
FromByronTranslationContext
emptyFromByronTranslationContext
  where
    exampleShelleyTx :: Tx TopTx ShelleyEra
    exampleShelleyTx :: Tx TopTx ShelleyEra
exampleShelleyTx =
      Tx TopTx ShelleyEra
forall era (l :: TxLevel).
(EraTx era, ShelleyEraScript era, Typeable l) =>
Tx l era
exampleShelleyBasedTx
        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))
-> ((SlotNo -> Identity SlotNo)
    -> TxBody TopTx ShelleyEra -> Identity (TxBody TopTx ShelleyEra))
-> (SlotNo -> Identity SlotNo)
-> Tx TopTx ShelleyEra
-> Identity (Tx TopTx ShelleyEra)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SlotNo -> Identity SlotNo)
-> TxBody TopTx ShelleyEra -> Identity (TxBody TopTx ShelleyEra)
forall era.
(ShelleyEraTxBody era, ExactEra ShelleyEra era) =>
Lens' (TxBody TopTx era) SlotNo
Lens' (TxBody TopTx ShelleyEra) SlotNo
ttlTxBodyL ((SlotNo -> Identity SlotNo)
 -> Tx TopTx ShelleyEra -> Identity (Tx TopTx ShelleyEra))
-> SlotNo -> Tx TopTx ShelleyEra -> Tx TopTx ShelleyEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Word64 -> SlotNo
SlotNo Word64
10
        Tx TopTx ShelleyEra
-> (Tx TopTx ShelleyEra -> Tx TopTx ShelleyEra)
-> Tx TopTx ShelleyEra
forall a b. a -> (a -> b) -> b
& Tx TopTx ShelleyEra -> Tx TopTx ShelleyEra
forall era. EraTx era => Tx TopTx era -> Tx TopTx era
addShelleyBasedTopTxExampleFee
        Tx TopTx ShelleyEra
-> (Tx TopTx ShelleyEra -> Tx TopTx ShelleyEra)
-> Tx TopTx ShelleyEra
forall a b. a -> (a -> b) -> b
& Tx TopTx ShelleyEra -> Tx TopTx ShelleyEra
forall era.
(EraTx era, ShelleyEraTxBody era) =>
Tx TopTx era -> Tx TopTx era
addShelleyToBabbageExampleProposedPUpdates
        Tx TopTx ShelleyEra
-> (Tx TopTx ShelleyEra -> Tx TopTx ShelleyEra)
-> Tx TopTx ShelleyEra
forall a b. a -> (a -> b) -> b
& Tx TopTx ShelleyEra -> Tx TopTx ShelleyEra
forall era (l :: TxLevel).
(EraTx era, ShelleyEraTxCert era, AtMostEra "Babbage" era) =>
Tx l era -> Tx l era
addShelleyToBabbageTxCerts
        Tx TopTx ShelleyEra
-> (Tx TopTx ShelleyEra -> Tx TopTx ShelleyEra)
-> Tx TopTx ShelleyEra
forall a b. a -> (a -> b) -> b
& Tx TopTx ShelleyEra -> Tx TopTx ShelleyEra
forall era (l :: TxLevel).
(EraTx era, ShelleyEraTxCert era) =>
Tx l era -> Tx l era
addShelleyToConwayTxCerts

mkShelleyBasedLedgerExamples ::
  forall era.
  ( EraTx era
  , EraGov era
  , EraStake era
  , EraCertState era
  , Default (StashedAVVMAddresses era)
  , AtMostEra "Mary" era
  ) =>
  ApplyTxError era ->
  Value era ->
  Tx TopTx era ->
  TranslationContext era ->
  LedgerExamples era
mkShelleyBasedLedgerExamples :: forall era.
(EraTx era, EraGov era, EraStake era, EraCertState era,
 Default (StashedAVVMAddresses era), AtMostEra "Mary" era) =>
ApplyTxError era
-> Value era
-> Tx TopTx era
-> TranslationContext era
-> LedgerExamples era
mkShelleyBasedLedgerExamples
  ApplyTxError era
applyTxError
  Value era
value
  Tx TopTx era
tx
  TranslationContext era
translationContext =
    LedgerExamples
      { leTx :: Tx TopTx era
leTx = Tx TopTx era
tx
      , leApplyTxError :: ApplyTxError era
leApplyTxError = ApplyTxError era
applyTxError
      , lePParams :: PParams era
lePParams = PParams era
forall a. Default a => a
def
      , leProposedPPUpdates :: ProposedPPUpdates era
leProposedPPUpdates =
          Map (KeyHash GenesisRole) (PParamsUpdate era)
-> ProposedPPUpdates era
forall era.
Map (KeyHash GenesisRole) (PParamsUpdate era)
-> ProposedPPUpdates era
ProposedPPUpdates (Map (KeyHash GenesisRole) (PParamsUpdate era)
 -> ProposedPPUpdates era)
-> Map (KeyHash GenesisRole) (PParamsUpdate era)
-> ProposedPPUpdates era
forall a b. (a -> b) -> a -> b
$
            KeyHash GenesisRole
-> PParamsUpdate era
-> Map (KeyHash GenesisRole) (PParamsUpdate era)
forall k a. k -> a -> Map k a
Map.singleton
              (Int -> KeyHash GenesisRole
forall (discriminator :: KeyRole). Int -> KeyHash discriminator
mkKeyHash Int
0)
              (PParamsUpdate era
forall era. EraPParams era => PParamsUpdate era
emptyPParamsUpdate PParamsUpdate era
-> (PParamsUpdate era -> PParamsUpdate era) -> PParamsUpdate era
forall a b. a -> (a -> b) -> b
& (StrictMaybe Coin -> Identity (StrictMaybe Coin))
-> PParamsUpdate era -> Identity (PParamsUpdate era)
forall era.
(EraPParams era, HasCallStack) =>
Lens' (PParamsUpdate era) (StrictMaybe Coin)
Lens' (PParamsUpdate era) (StrictMaybe Coin)
ppuKeyDepositL ((StrictMaybe Coin -> Identity (StrictMaybe Coin))
 -> PParamsUpdate era -> Identity (PParamsUpdate era))
-> StrictMaybe Coin -> PParamsUpdate era -> PParamsUpdate era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Coin -> StrictMaybe Coin
forall a. a -> StrictMaybe a
SJust (Integer -> Coin
Coin Integer
100))
      , leNewEpochState :: NewEpochState era
leNewEpochState =
          Value era -> PParams era -> PParams era -> NewEpochState era
forall era.
(EraTxOut era, EraGov era, EraStake era, EraCertState era,
 Default (StashedAVVMAddresses era)) =>
Value era -> PParams era -> PParams era -> NewEpochState era
exampleNewEpochState
            Value era
value
            PParams era
forall era. EraPParams era => PParams era
emptyPParams
            (PParams era
forall era. EraPParams era => PParams era
emptyPParams 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, HasCallStack) =>
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
1)
      , lePoolDistr :: PoolDistr
lePoolDistr = PoolDistr
examplePoolDistr
      , leRewardsCredentials :: Set (Either Coin (Credential Staking))
leRewardsCredentials =
          [Either Coin (Credential Staking)]
-> Set (Either Coin (Credential Staking))
forall a. Ord a => [a] -> Set a
Set.fromList
            [ Coin -> Either Coin (Credential Staking)
forall a b. a -> Either a b
Left (Integer -> Coin
Coin Integer
100)
            , Credential Staking -> Either Coin (Credential Staking)
forall a b. b -> Either a b
Right (ScriptHash -> Credential Staking
forall (kr :: KeyRole). ScriptHash -> Credential kr
ScriptHashObj (Int -> ScriptHash
mkScriptHash Int
1))
            , Credential Staking -> Either Coin (Credential Staking)
forall a b. b -> Either a b
Right (KeyHash Staking -> Credential Staking
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj (Int -> KeyHash Staking
forall (discriminator :: KeyRole). Int -> KeyHash discriminator
mkKeyHash Int
2))
            ]
      , leNonMyopicRewards :: Map
  (Either Coin (Credential Staking)) (Map (KeyHash StakePool) Coin)
leNonMyopicRewards = Map
  (Either Coin (Credential Staking)) (Map (KeyHash StakePool) Coin)
exampleNonMyopicRewards
      , leTranslationContext :: TranslationContext era
leTranslationContext = TranslationContext era
translationContext
      , leShelleyGenesis :: ShelleyGenesis
leShelleyGenesis = ShelleyGenesis
testShelleyGenesis
      }

-- | This is probably not a valid ledger. We don't care, we are only
-- interested in serialisation, not validation.
exampleNewEpochState ::
  forall era.
  ( EraTxOut era
  , EraGov era
  , EraStake era
  , EraCertState era
  , Default (StashedAVVMAddresses era)
  ) =>
  Value era ->
  PParams era ->
  PParams era ->
  NewEpochState era
exampleNewEpochState :: forall era.
(EraTxOut era, EraGov era, EraStake era, EraCertState era,
 Default (StashedAVVMAddresses era)) =>
Value era -> PParams era -> PParams era -> NewEpochState era
exampleNewEpochState Value era
value PParams era
ppp PParams era
pp =
  NewEpochState
    { nesEL :: EpochNo
nesEL = Word64 -> EpochNo
EpochNo Word64
0
    , nesBprev :: BlocksMade
nesBprev = Map (KeyHash StakePool) Natural -> BlocksMade
BlocksMade (KeyHash StakePool -> Natural -> Map (KeyHash StakePool) Natural
forall k a. k -> a -> Map k a
Map.singleton (Int -> KeyHash StakePool
forall (discriminator :: KeyRole). Int -> KeyHash discriminator
mkKeyHash Int
1) Natural
10)
    , nesBcur :: BlocksMade
nesBcur = Map (KeyHash StakePool) Natural -> BlocksMade
BlocksMade (KeyHash StakePool -> Natural -> Map (KeyHash StakePool) Natural
forall k a. k -> a -> Map k a
Map.singleton (Int -> KeyHash StakePool
forall (discriminator :: KeyRole). Int -> KeyHash discriminator
mkKeyHash Int
2) Natural
3)
    , nesEs :: EpochState era
nesEs = EpochState era
epochState
    , nesRu :: StrictMaybe PulsingRewUpdate
nesRu = PulsingRewUpdate -> StrictMaybe PulsingRewUpdate
forall a. a -> StrictMaybe a
SJust PulsingRewUpdate
rewardUpdate
    , nesPd :: PoolDistr
nesPd = PoolDistr
examplePoolDistr
    , stashedAVVMAddresses :: StashedAVVMAddresses era
stashedAVVMAddresses = StashedAVVMAddresses era
forall a. Default a => a
def
    }
  where
    epochState :: EpochState era
    epochState :: EpochState era
epochState =
      EpochState
        { esChainAccountState :: ChainAccountState
esChainAccountState =
            ChainAccountState
              { casTreasury :: Coin
casTreasury = Integer -> Coin
Coin Integer
10000
              , casReserves :: Coin
casReserves = Integer -> Coin
Coin Integer
1000
              }
        , esSnapshots :: SnapShots
esSnapshots = SnapShots
emptySnapShots
        , esLState :: LedgerState era
esLState =
            LedgerState
              { lsUTxOState :: UTxOState era
lsUTxOState =
                  UTxOState
                    { utxosUtxo :: UTxO era
utxosUtxo =
                        Map TxIn (TxOut era) -> UTxO era
forall era. Map TxIn (TxOut era) -> UTxO era
UTxO (Map TxIn (TxOut era) -> UTxO era)
-> Map TxIn (TxOut era) -> UTxO era
forall a b. (a -> b) -> a -> b
$
                          [(TxIn, TxOut era)] -> Map TxIn (TxOut era)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
                            [
                              ( TxId -> TxIx -> TxIn
TxIn (SafeHash EraIndependentTxBody -> TxId
TxId (forall a. Int -> SafeHash a
mkDummySafeHash @EraIndependentTxBody Int
1)) TxIx
forall a. Bounded a => a
minBound
                              , Addr -> Value era -> TxOut era
forall era.
(EraTxOut era, HasCallStack) =>
Addr -> Value era -> TxOut era
mkBasicTxOut Addr
addr Value era
value
                              )
                            ]
                    , utxosDeposited :: Coin
utxosDeposited = Integer -> Coin
Coin Integer
1000
                    , utxosFees :: Coin
utxosFees = Integer -> Coin
Coin Integer
1
                    , utxosGovState :: GovState era
utxosGovState = GovState era
forall era. EraGov era => GovState era
emptyGovState
                    , utxosInstantStake :: InstantStake era
utxosInstantStake = InstantStake era
forall a. Monoid a => a
mempty
                    , utxosDonation :: Coin
utxosDonation = Coin
forall a. Monoid a => a
mempty
                    }
              , lsCertState :: CertState era
lsCertState = CertState era
forall a. Default a => a
def
              }
        , esNonMyopic :: NonMyopic
esNonMyopic = NonMyopic
forall a. Default a => a
def
        }
        EpochState era
-> (EpochState era -> EpochState era) -> EpochState era
forall a b. a -> (a -> b) -> b
& (PParams era -> Identity (PParams era))
-> EpochState era -> Identity (EpochState era)
forall era. EraGov era => Lens' (EpochState era) (PParams era)
Lens' (EpochState era) (PParams era)
prevPParamsEpochStateL ((PParams era -> Identity (PParams era))
 -> EpochState era -> Identity (EpochState era))
-> PParams era -> EpochState era -> EpochState era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ PParams era
ppp
        EpochState era
-> (EpochState era -> EpochState era) -> EpochState era
forall a b. a -> (a -> b) -> b
& (PParams era -> Identity (PParams era))
-> EpochState era -> Identity (EpochState era)
forall era. EraGov era => Lens' (EpochState era) (PParams era)
Lens' (EpochState era) (PParams era)
curPParamsEpochStateL ((PParams era -> Identity (PParams era))
 -> EpochState era -> Identity (EpochState era))
-> PParams era -> EpochState era -> EpochState era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ PParams era
pp
      where
        addr :: Addr
        addr :: Addr
addr =
          Network -> Credential Payment -> StakeReference -> Addr
Addr
            Network
Testnet
            (KeyPair Payment -> Credential Payment
forall (r :: KeyRole). KeyPair r -> Credential r
keyToCredential KeyPair Payment
examplePayKey)
            (Credential Staking -> StakeReference
StakeRefBase (KeyPair Staking -> Credential Staking
forall (r :: KeyRole). KeyPair r -> Credential r
keyToCredential KeyPair Staking
exampleStakeKey))

    rewardUpdate :: PulsingRewUpdate
    rewardUpdate :: PulsingRewUpdate
rewardUpdate =
      forall era.
(EraGov era, EraCertState era) =>
EpochSize
-> BlocksMade
-> EpochState era
-> Coin
-> ActiveSlotCoeff
-> NonZero Word64
-> PulsingRewUpdate
startStep @era
        (Word64 -> EpochSize
EpochSize Word64
432000)
        (Map (KeyHash StakePool) Natural -> BlocksMade
BlocksMade (KeyHash StakePool -> Natural -> Map (KeyHash StakePool) Natural
forall k a. k -> a -> Map k a
Map.singleton (Int -> KeyHash StakePool
forall (discriminator :: KeyRole). Int -> KeyHash discriminator
mkKeyHash Int
1) Natural
10))
        EpochState era
epochState
        (Integer -> Coin
Coin Integer
1000)
        (Globals -> ActiveSlotCoeff
activeSlotCoeff Globals
testGlobals)
        (forall (n :: Natural) a.
(KnownNat n, 1 <= n, WithinBounds n a, Num a) =>
NonZero a
knownNonZeroBounded @10)

examplePoolDistr :: PoolDistr
examplePoolDistr :: PoolDistr
examplePoolDistr =
  Map (KeyHash StakePool) IndividualPoolStake
-> NonZero Coin -> PoolDistr
PoolDistr
    ( [(KeyHash StakePool, IndividualPoolStake)]
-> Map (KeyHash StakePool) IndividualPoolStake
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
        [
          ( Int -> KeyHash StakePool
forall (discriminator :: KeyRole). Int -> KeyHash discriminator
mkKeyHash Int
1
          , Rational
-> CompactForm Coin
-> VRFVerKeyHash StakePoolVRF
-> IndividualPoolStake
IndividualPoolStake
              Rational
1
              (Word64 -> CompactForm Coin
CompactCoin Word64
1)
              VRFVerKeyHash StakePoolVRF
exampleVrfVerKeyHash
          )
        ]
    )
    (forall (n :: Natural). (KnownNat n, 1 <= n) => NonZero Coin
knownNonZeroCoin @1)

exampleNonMyopicRewards :: Map (Either Coin (Credential Staking)) (Map (KeyHash StakePool) Coin)
exampleNonMyopicRewards :: Map
  (Either Coin (Credential Staking)) (Map (KeyHash StakePool) Coin)
exampleNonMyopicRewards =
  [(Either Coin (Credential Staking), Map (KeyHash StakePool) Coin)]
-> Map
     (Either Coin (Credential Staking)) (Map (KeyHash StakePool) Coin)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
    [ (Coin -> Either Coin (Credential Staking)
forall a b. a -> Either a b
Left (Integer -> Coin
Coin Integer
100), KeyHash StakePool -> Coin -> Map (KeyHash StakePool) Coin
forall k a. k -> a -> Map k a
Map.singleton (Int -> KeyHash StakePool
forall (discriminator :: KeyRole). Int -> KeyHash discriminator
mkKeyHash Int
2) (Integer -> Coin
Coin Integer
3))
    , (Credential Staking -> Either Coin (Credential Staking)
forall a b. b -> Either a b
Right (ScriptHash -> Credential Staking
forall (kr :: KeyRole). ScriptHash -> Credential kr
ScriptHashObj (Int -> ScriptHash
mkScriptHash Int
1)), Map (KeyHash StakePool) Coin
forall k a. Map k a
Map.empty)
    , (Credential Staking -> Either Coin (Credential Staking)
forall a b. b -> Either a b
Right (KeyHash Staking -> Credential Staking
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj (Int -> KeyHash Staking
forall (discriminator :: KeyRole). Int -> KeyHash discriminator
mkKeyHash Int
2)), KeyHash StakePool -> Coin -> Map (KeyHash StakePool) Coin
forall k a. k -> a -> Map k a
Map.singleton (Int -> KeyHash StakePool
forall (discriminator :: KeyRole). Int -> KeyHash discriminator
mkKeyHash Int
3) (Integer -> Coin
Coin Integer
9))
    ]

-- | These are dummy values.
testShelleyGenesis :: ShelleyGenesis
testShelleyGenesis :: ShelleyGenesis
testShelleyGenesis =
  ShelleyGenesis
    { sgSystemStart :: UTCTime
sgSystemStart = Day -> DiffTime -> UTCTime
UTCTime (Integer -> Int -> Int -> Day
fromGregorian Integer
2020 Int
5 Int
14) DiffTime
0
    , sgNetworkMagic :: Word32
sgNetworkMagic = Word32
0
    , sgNetworkId :: Network
sgNetworkId = Network
Testnet
    , -- Chosen to match activeSlotCoeff
      sgActiveSlotsCoeff :: PositiveUnitInterval
sgActiveSlotsCoeff = Rational -> PositiveUnitInterval
forall r.
(HasCallStack, Typeable r, BoundedRational r) =>
Rational -> r
unsafeBoundRational Rational
0.9
    , sgSecurityParam :: NonZero Word64
sgSecurityParam = Globals -> NonZero Word64
securityParameter Globals
testGlobals
    , sgEpochLength :: EpochSize
sgEpochLength = Identity EpochSize -> EpochSize
forall a. Identity a -> a
runIdentity (Identity EpochSize -> EpochSize)
-> Identity EpochSize -> EpochSize
forall a b. (a -> b) -> a -> b
$ EpochInfo Identity -> EpochNo -> Identity EpochSize
forall (m :: * -> *).
HasCallStack =>
EpochInfo m -> EpochNo -> m EpochSize
epochInfoSize (Globals -> EpochInfo Identity
epochInfoPure Globals
testGlobals) (Word64 -> EpochNo
EpochNo Word64
0)
    , sgSlotsPerKESPeriod :: Word64
sgSlotsPerKESPeriod = Globals -> Word64
slotsPerKESPeriod Globals
testGlobals
    , sgMaxKESEvolutions :: Word64
sgMaxKESEvolutions = Globals -> Word64
maxKESEvo Globals
testGlobals
    , -- Not important
      sgSlotLength :: NominalDiffTimeMicro
sgSlotLength = Micro -> NominalDiffTimeMicro
secondsToNominalDiffTimeMicro Micro
2
    , sgUpdateQuorum :: Word64
sgUpdateQuorum = Globals -> Word64
quorum Globals
testGlobals
    , sgMaxLovelaceSupply :: Word64
sgMaxLovelaceSupply = Globals -> Word64
maxLovelaceSupply Globals
testGlobals
    , sgProtocolParams :: PParams ShelleyEra
sgProtocolParams = PParams ShelleyEra
forall era. EraPParams era => PParams era
emptyPParams
    , sgGenDelegs :: Map (KeyHash GenesisRole) GenDelegPair
sgGenDelegs = Map (KeyHash GenesisRole) GenDelegPair
forall k a. Map k a
Map.empty
    , sgInitialFunds :: ListMap Addr Coin
sgInitialFunds = ListMap Addr Coin
forall a. Monoid a => a
mempty
    , sgStaking :: ShelleyGenesisStaking
sgStaking = ShelleyGenesisStaking
emptyGenesisStaking
    , sgExtraConfig :: StrictMaybe ShelleyExtraConfig
sgExtraConfig = StrictMaybe ShelleyExtraConfig
forall a. StrictMaybe a
SNothing
    }

exampleCoin :: Coin
exampleCoin :: Coin
exampleCoin = Integer -> Coin
Coin Integer
10

-- Complete transaction which is compatible with any era starting with Shelley.
-- This transaction forms the basis on which future era transactions will be
-- at the very least based on.
exampleShelleyBasedTx ::
  forall era l.
  ( EraTx era
  , ShelleyEraScript era
  , Typeable l
  ) =>
  Tx l era
exampleShelleyBasedTx :: forall era (l :: TxLevel).
(EraTx era, ShelleyEraScript era, Typeable l) =>
Tx l era
exampleShelleyBasedTx =
  TxBody l era -> Tx l era
forall era (l :: TxLevel). EraTx era => TxBody l era -> Tx l era
forall (l :: TxLevel). TxBody l era -> Tx l era
mkBasicTx TxBody l era
txBody
    Tx l era -> (Tx l era -> Tx l era) -> Tx l era
forall a b. a -> (a -> b) -> b
& (TxWits era -> Identity (TxWits era))
-> Tx l era -> Identity (Tx l era)
forall era (l :: TxLevel).
EraTx era =>
Lens' (Tx l era) (TxWits era)
forall (l :: TxLevel). Lens' (Tx l era) (TxWits era)
witsTxL ((TxWits era -> Identity (TxWits era))
 -> Tx l era -> Identity (Tx l era))
-> TxWits era -> Tx l era -> Tx l era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ TxWits era
shelleyBasedWitnesses
    Tx l era -> (Tx l era -> Tx l era) -> Tx l era
forall a b. a -> (a -> b) -> b
& (StrictMaybe (TxAuxData era)
 -> Identity (StrictMaybe (TxAuxData era)))
-> Tx l era -> Identity (Tx l era)
forall era (l :: TxLevel).
EraTx era =>
Lens' (Tx l era) (StrictMaybe (TxAuxData era))
forall (l :: TxLevel).
Lens' (Tx l era) (StrictMaybe (TxAuxData era))
auxDataTxL ((StrictMaybe (TxAuxData era)
  -> Identity (StrictMaybe (TxAuxData era)))
 -> Tx l era -> Identity (Tx l era))
-> StrictMaybe (TxAuxData era) -> Tx l era -> Tx l era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ TxAuxData era -> StrictMaybe (TxAuxData era)
forall a. a -> StrictMaybe a
SJust TxAuxData era
forall era. EraTxAuxData era => TxAuxData era
exampleAuxiliaryDataShelley
  where
    keyPairWits :: [KeyPair Witness]
keyPairWits =
      [ KeyPair Payment -> KeyPair Witness
forall (a :: KeyRole -> *) (r :: KeyRole).
HasKeyRole a =>
a r -> a Witness
asWitness KeyPair Payment
examplePayKey
      , KeyPair Staking -> KeyPair Witness
forall (a :: KeyRole -> *) (r :: KeyRole).
HasKeyRole a =>
a r -> a Witness
asWitness KeyPair Staking
exampleStakeKey
      , KeyPair (ZonkAny MinVersion) -> KeyPair Witness
forall (a :: KeyRole -> *) (r :: KeyRole).
HasKeyRole a =>
a r -> a Witness
asWitness (KeyPair (ZonkAny MinVersion) -> KeyPair Witness)
-> KeyPair (ZonkAny MinVersion) -> KeyPair Witness
forall a b. (a -> b) -> a -> b
$ Word8 -> KeyPair (ZonkAny MinVersion)
forall (kd :: KeyRole). Word8 -> KeyPair kd
mkDSIGNKeyPair Word8
1
      ]

    txBody :: TxBody l era
    txBody :: TxBody l era
txBody =
      TxBody l era
forall era (l :: TxLevel).
(EraTxBody era, Typeable l) =>
TxBody l era
forall (l :: TxLevel). Typeable l => TxBody l era
mkBasicTxBody
        TxBody l era -> (TxBody l era -> TxBody l era) -> TxBody l era
forall a b. a -> (a -> b) -> b
& (Set TxIn -> Identity (Set TxIn))
-> TxBody l era -> Identity (TxBody l era)
forall era (l :: TxLevel).
EraTxBody era =>
Lens' (TxBody l era) (Set TxIn)
forall (l :: TxLevel). Lens' (TxBody l era) (Set TxIn)
inputsTxBodyL ((Set TxIn -> Identity (Set TxIn))
 -> TxBody l era -> Identity (TxBody l era))
-> Set TxIn -> TxBody l era -> TxBody l era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Set TxIn
exampleTxIns
        TxBody l era -> (TxBody l era -> TxBody l era) -> TxBody l era
forall a b. a -> (a -> b) -> b
& (StrictSeq (TxOut era) -> Identity (StrictSeq (TxOut era)))
-> TxBody l era -> Identity (TxBody l era)
forall era (l :: TxLevel).
EraTxBody era =>
Lens' (TxBody l era) (StrictSeq (TxOut era))
forall (l :: TxLevel). Lens' (TxBody l era) (StrictSeq (TxOut era))
outputsTxBodyL
          ((StrictSeq (TxOut era) -> Identity (StrictSeq (TxOut era)))
 -> TxBody l era -> Identity (TxBody l era))
-> StrictSeq (TxOut era) -> TxBody l era -> TxBody l era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [TxOut era] -> StrictSeq (TxOut era)
forall a. [a] -> StrictSeq a
StrictSeq.fromList
            [ Addr -> Value era -> TxOut era
forall era.
(EraTxOut era, HasCallStack) =>
Addr -> Value era -> TxOut era
mkBasicTxOut (KeyPair Payment -> KeyPair Staking -> Addr
forall p s.
(MakeCredential p Payment, MakeStakeReference s) =>
p -> s -> Addr
mkAddr KeyPair Payment
examplePayKey KeyPair Staking
exampleStakeKey) (Value era -> TxOut era) -> Value era -> TxOut era
forall a b. (a -> b) -> a -> b
$ Coin -> Value era
forall t s. Inject t s => t -> s
inject (Coin -> Value era) -> Coin -> Value era
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
100000
            , Addr -> Value era -> TxOut era
forall era.
(EraTxOut era, HasCallStack) =>
Addr -> Value era -> TxOut era
mkBasicTxOut
                ( Network -> Credential Payment -> StakeReference -> Addr
Addr
                    Network
Testnet
                    (KeyPair Payment -> Credential Payment
forall (r :: KeyRole). KeyPair r -> Credential r
keyToCredential KeyPair Payment
examplePayKey)
                    (Ptr -> StakeReference
StakeRefPtr (SlotNo32 -> TxIx -> CertIx -> Ptr
Ptr (Word32 -> SlotNo32
SlotNo32 Word32
10) (HasCallStack => Integer -> TxIx
Integer -> TxIx
mkTxIxPartial Integer
0) (HasCallStack => Integer -> CertIx
Integer -> CertIx
mkCertIxPartial Integer
0)))
                )
                (Value era -> TxOut era) -> Value era -> TxOut era
forall a b. (a -> b) -> a -> b
$ Coin -> Value era
forall t s. Inject t s => t -> s
inject
                (Coin -> Value era) -> Coin -> Value era
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
100000
            , Addr -> Value era -> TxOut era
forall era.
(EraTxOut era, HasCallStack) =>
Addr -> Value era -> TxOut era
mkBasicTxOut (Network -> Credential Payment -> StakeReference -> Addr
Addr Network
Testnet (KeyPair Payment -> Credential Payment
forall (r :: KeyRole). KeyPair r -> Credential r
keyToCredential KeyPair Payment
examplePayKey) StakeReference
StakeRefNull) (Value era -> TxOut era) -> Value era -> TxOut era
forall a b. (a -> b) -> a -> b
$ Coin -> Value era
forall t s. Inject t s => t -> s
inject (Coin -> Value era) -> Coin -> Value era
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
100000
            , Addr -> Value era -> TxOut era
forall era.
(EraTxOut era, HasCallStack) =>
Addr -> Value era -> TxOut era
mkBasicTxOut Addr
exampleByronAddress (Value era -> TxOut era) -> Value era -> TxOut era
forall a b. (a -> b) -> a -> b
$ Coin -> Value era
forall t s. Inject t s => t -> s
inject (Coin -> Value era) -> Coin -> Value era
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
100000
            ]
        TxBody l era -> (TxBody l era -> TxBody l era) -> TxBody l era
forall a b. a -> (a -> b) -> b
& (Withdrawals -> Identity Withdrawals)
-> TxBody l era -> Identity (TxBody l era)
forall era (l :: TxLevel).
EraTxBody era =>
Lens' (TxBody l era) Withdrawals
forall (l :: TxLevel). Lens' (TxBody l era) Withdrawals
withdrawalsTxBodyL ((Withdrawals -> Identity Withdrawals)
 -> TxBody l era -> Identity (TxBody l era))
-> Withdrawals -> TxBody l era -> TxBody l era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Withdrawals
exampleWithdrawals
        TxBody l era -> (TxBody l era -> TxBody l era) -> TxBody l era
forall a b. a -> (a -> b) -> b
& (StrictMaybe TxAuxDataHash -> Identity (StrictMaybe TxAuxDataHash))
-> TxBody l era -> Identity (TxBody l era)
forall era (l :: TxLevel).
EraTxBody era =>
Lens' (TxBody l era) (StrictMaybe TxAuxDataHash)
forall (l :: TxLevel).
Lens' (TxBody l era) (StrictMaybe TxAuxDataHash)
auxDataHashTxBodyL ((StrictMaybe TxAuxDataHash
  -> Identity (StrictMaybe TxAuxDataHash))
 -> TxBody l era -> Identity (TxBody l era))
-> StrictMaybe TxAuxDataHash -> TxBody l era -> TxBody l era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ TxAuxDataHash -> StrictMaybe TxAuxDataHash
forall a. a -> StrictMaybe a
SJust TxAuxDataHash
exampleAuxDataHash
        TxBody l era -> (TxBody l era -> TxBody l era) -> TxBody l era
forall a b. a -> (a -> b) -> b
& (StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> TxBody l era -> Identity (TxBody l era)
forall era (l :: TxLevel).
EraTxBody era =>
Lens' (TxBody l era) (StrictSeq (TxCert era))
forall (l :: TxLevel).
Lens' (TxBody l era) (StrictSeq (TxCert era))
certsTxBodyL ((StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
 -> TxBody l era -> Identity (TxBody l era))
-> StrictSeq (TxCert era) -> TxBody l era -> TxBody l era
forall a s t. Monoid a => ASetter s t a a -> a -> s -> t
<>~ StrictSeq (TxCert era)
txCerts

    exampleAuxDataHash :: TxAuxDataHash
exampleAuxDataHash = SafeHash EraIndependentTxAuxData -> TxAuxDataHash
TxAuxDataHash (SafeHash EraIndependentTxAuxData -> TxAuxDataHash)
-> SafeHash EraIndependentTxAuxData -> TxAuxDataHash
forall a b. (a -> b) -> a -> b
$ forall a. Int -> SafeHash a
mkDummySafeHash @EraIndependentTxAuxData Int
30

    shelleyBasedWitnesses :: TxWits era
shelleyBasedWitnesses =
      TxWits era
forall era. EraTxWits era => TxWits era
mkBasicTxWits
        TxWits era -> (TxWits era -> TxWits era) -> TxWits era
forall a b. a -> (a -> b) -> b
& (Set (WitVKey Witness) -> Identity (Set (WitVKey Witness)))
-> TxWits era -> Identity (TxWits era)
forall era.
EraTxWits era =>
Lens' (TxWits era) (Set (WitVKey Witness))
Lens' (TxWits era) (Set (WitVKey Witness))
addrTxWitsL ((Set (WitVKey Witness) -> Identity (Set (WitVKey Witness)))
 -> TxWits era -> Identity (TxWits era))
-> Set (WitVKey Witness) -> TxWits era -> TxWits era
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 (TxId -> SafeHash EraIndependentTxBody
forall a b. Coercible a b => a -> b
coerce (TxBody l era -> TxId
forall era (l :: TxLevel). EraTxBody era => TxBody l era -> TxId
txIdTxBody TxBody l era
txBody)) [KeyPair Witness]
keyPairWits
        TxWits era -> (TxWits era -> TxWits era) -> TxWits era
forall a b. a -> (a -> b) -> b
& (Set BootstrapWitness -> Identity (Set BootstrapWitness))
-> TxWits era -> Identity (TxWits era)
forall era.
EraTxWits era =>
Lens' (TxWits era) (Set BootstrapWitness)
Lens' (TxWits era) (Set BootstrapWitness)
bootAddrTxWitsL ((Set BootstrapWitness -> Identity (Set BootstrapWitness))
 -> TxWits era -> Identity (TxWits era))
-> Set BootstrapWitness -> TxWits era -> TxWits era
forall a s t. Monoid a => ASetter s t a a -> a -> s -> t
<>~ BootstrapWitness -> Set BootstrapWitness
forall a. a -> Set a
Set.singleton (Hash HASH EraIndependentTxBody -> BootstrapWitness
exampleBootstrapWitness Hash HASH EraIndependentTxBody
txBodyHash)
        TxWits era -> (TxWits era -> TxWits era) -> TxWits era
forall a b. a -> (a -> b) -> b
& (Map ScriptHash (Script era)
 -> Identity (Map ScriptHash (Script era)))
-> TxWits era -> Identity (TxWits era)
forall era.
EraTxWits era =>
Lens' (TxWits era) (Map ScriptHash (Script era))
Lens' (TxWits era) (Map ScriptHash (Script era))
scriptTxWitsL ((Map ScriptHash (Script era)
  -> Identity (Map ScriptHash (Script era)))
 -> TxWits era -> Identity (TxWits era))
-> Map ScriptHash (Script era) -> TxWits era -> TxWits era
forall a s t. Monoid a => ASetter s t a a -> a -> s -> t
<>~ (Script era -> ScriptHash)
-> [Script era] -> Map ScriptHash (Script era)
forall (f :: * -> *) k v.
(Foldable f, Ord k) =>
(v -> k) -> f v -> Map k v
Map.fromElems Script era -> ScriptHash
forall era. EraScript era => Script era -> ScriptHash
hashScript [NativeScript era -> Script era
forall era. EraScript era => NativeScript era -> Script era
fromNativeScript NativeScript era
forall era. ShelleyEraScript era => NativeScript era
exampleShelleyScript]
    txBodyHash :: Hash HASH EraIndependentTxBody
txBodyHash = SafeHash EraIndependentTxBody -> Hash HASH EraIndependentTxBody
forall i. SafeHash i -> Hash HASH i
extractHash (TxId -> SafeHash EraIndependentTxBody
unTxId (TxBody l era -> TxId
forall era (l :: TxLevel). EraTxBody era => TxBody l era -> TxId
txIdTxBody TxBody l era
txBody))

    txCerts :: StrictSeq (TxCert era)
txCerts =
      [TxCert era] -> StrictSeq (TxCert era)
forall a. [a] -> StrictSeq a
StrictSeq.fromList
        [ StakePoolParams -> TxCert era
forall era. EraTxCert era => StakePoolParams -> TxCert era
RegPoolTxCert StakePoolParams
exampleStakePoolParams
        , KeyHash StakePool -> EpochNo -> TxCert era
forall era.
EraTxCert era =>
KeyHash StakePool -> EpochNo -> TxCert era
RetirePoolTxCert (StakePoolParams -> KeyHash StakePool
sppId StakePoolParams
exampleStakePoolParams) (Word64 -> EpochNo
EpochNo Word64
2)
        ]

addShelleyBasedTopTxExampleFee ::
  forall era.
  EraTx era =>
  Tx TopTx era ->
  Tx TopTx era
addShelleyBasedTopTxExampleFee :: forall era. EraTx era => Tx TopTx era -> Tx TopTx era
addShelleyBasedTopTxExampleFee Tx TopTx era
tx =
  Tx TopTx era
tx Tx TopTx era -> (Tx TopTx era -> Tx TopTx era) -> Tx TopTx era
forall a b. a -> (a -> b) -> b
& (TxBody TopTx era -> Identity (TxBody TopTx era))
-> Tx TopTx era -> Identity (Tx TopTx era)
forall era (l :: TxLevel).
EraTx era =>
Lens' (Tx l era) (TxBody l era)
forall (l :: TxLevel). Lens' (Tx l era) (TxBody l era)
bodyTxL ((TxBody TopTx era -> Identity (TxBody TopTx era))
 -> Tx TopTx era -> Identity (Tx TopTx era))
-> ((Coin -> Identity Coin)
    -> TxBody TopTx era -> Identity (TxBody TopTx era))
-> (Coin -> Identity Coin)
-> Tx TopTx era
-> Identity (Tx TopTx era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Coin -> Identity Coin)
-> TxBody TopTx era -> Identity (TxBody TopTx era)
forall era. EraTxBody era => Lens' (TxBody TopTx era) Coin
Lens' (TxBody TopTx era) Coin
feeTxBodyL ((Coin -> Identity Coin)
 -> Tx TopTx era -> Identity (Tx TopTx era))
-> Coin -> Tx TopTx era -> Tx TopTx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Integer -> Coin
Coin Integer
3

addShelleyToBabbageExampleProposedPUpdates ::
  forall era.
  (EraTx era, ShelleyEraTxBody era) =>
  Tx TopTx era ->
  Tx TopTx era
addShelleyToBabbageExampleProposedPUpdates :: forall era.
(EraTx era, ShelleyEraTxBody era) =>
Tx TopTx era -> Tx TopTx era
addShelleyToBabbageExampleProposedPUpdates Tx TopTx era
tx =
  Tx TopTx era
tx Tx TopTx era -> (Tx TopTx era -> Tx TopTx era) -> Tx TopTx era
forall a b. a -> (a -> b) -> b
& (TxBody TopTx era -> Identity (TxBody TopTx era))
-> Tx TopTx era -> Identity (Tx TopTx era)
forall era (l :: TxLevel).
EraTx era =>
Lens' (Tx l era) (TxBody l era)
forall (l :: TxLevel). Lens' (Tx l era) (TxBody l era)
bodyTxL ((TxBody TopTx era -> Identity (TxBody TopTx era))
 -> Tx TopTx era -> Identity (Tx TopTx era))
-> ((StrictMaybe (Update era)
     -> Identity (StrictMaybe (Update era)))
    -> TxBody TopTx era -> Identity (TxBody TopTx era))
-> (StrictMaybe (Update era)
    -> Identity (StrictMaybe (Update era)))
-> Tx TopTx era
-> Identity (Tx TopTx era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StrictMaybe (Update era) -> Identity (StrictMaybe (Update era)))
-> TxBody TopTx era -> Identity (TxBody TopTx era)
forall era.
ShelleyEraTxBody era =>
Lens' (TxBody TopTx era) (StrictMaybe (Update era))
Lens' (TxBody TopTx era) (StrictMaybe (Update era))
updateTxBodyL ((StrictMaybe (Update era) -> Identity (StrictMaybe (Update era)))
 -> Tx TopTx era -> Identity (Tx TopTx era))
-> StrictMaybe (Update era) -> Tx TopTx era -> Tx TopTx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Update era -> StrictMaybe (Update era)
forall a. a -> StrictMaybe a
SJust (ProposedPPUpdates era -> EpochNo -> Update era
forall era. ProposedPPUpdates era -> EpochNo -> Update era
Update ProposedPPUpdates era
forall era. EraPParams era => ProposedPPUpdates era
exampleProposedPPUpdates (Word64 -> EpochNo
EpochNo Word64
10))

-- Add certificates to a given transaction that are compatible until Babbage
-- era.
addShelleyToBabbageTxCerts ::
  (EraTx era, ShelleyEraTxCert era, AtMostEra "Babbage" era) =>
  Tx l era ->
  Tx l era
addShelleyToBabbageTxCerts :: forall era (l :: TxLevel).
(EraTx era, ShelleyEraTxCert era, AtMostEra "Babbage" era) =>
Tx l era -> Tx l era
addShelleyToBabbageTxCerts Tx l era
tx =
  Tx l era
tx Tx l era -> (Tx l era -> Tx l era) -> Tx l era
forall a b. a -> (a -> b) -> b
& (TxBody l era -> Identity (TxBody l era))
-> Tx l era -> Identity (Tx l era)
forall era (l :: TxLevel).
EraTx era =>
Lens' (Tx l era) (TxBody l era)
forall (l :: TxLevel). Lens' (Tx l era) (TxBody l era)
bodyTxL ((TxBody l era -> Identity (TxBody l era))
 -> Tx l era -> Identity (Tx l era))
-> ((StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
    -> TxBody l era -> Identity (TxBody l era))
-> (StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> Tx l era
-> Identity (Tx l era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> TxBody l era -> Identity (TxBody l era)
forall era (l :: TxLevel).
EraTxBody era =>
Lens' (TxBody l era) (StrictSeq (TxCert era))
forall (l :: TxLevel).
Lens' (TxBody l era) (StrictSeq (TxCert era))
certsTxBodyL ((StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
 -> Tx l era -> Identity (Tx l era))
-> StrictSeq (TxCert era) -> Tx l era -> Tx l era
forall a s t. Monoid a => ASetter s t a a -> a -> s -> t
<>~ StrictSeq (TxCert era)
txCerts
  where
    txCerts :: StrictSeq (TxCert era)
txCerts =
      [TxCert era] -> StrictSeq (TxCert era)
forall a. [a] -> StrictSeq a
StrictSeq.fromList
        [ KeyHash GenesisRole
-> KeyHash GenesisDelegate
-> VRFVerKeyHash GenDelegVRF
-> TxCert era
forall era.
(ShelleyEraTxCert era, AtMostEra "Babbage" era) =>
KeyHash GenesisRole
-> KeyHash GenesisDelegate
-> VRFVerKeyHash GenDelegVRF
-> TxCert era
GenesisDelegTxCert
            (Int -> KeyHash GenesisRole
forall (discriminator :: KeyRole). Int -> KeyHash discriminator
mkKeyHash Int
3)
            (Int -> KeyHash GenesisDelegate
forall (discriminator :: KeyRole). Int -> KeyHash discriminator
mkKeyHash Int
4)
            (VRFVerKeyHash StakePoolVRF -> VRFVerKeyHash GenDelegVRF
forall a b. Coercible a b => a -> b
coerce VRFVerKeyHash StakePoolVRF
exampleVrfVerKeyHash :: VRFVerKeyHash GenDelegVRF)
        , MIRCert -> TxCert era
forall era.
(ShelleyEraTxCert era, AtMostEra "Babbage" era) =>
MIRCert -> TxCert era
MirTxCert (MIRCert -> TxCert era) -> MIRCert -> TxCert era
forall a b. (a -> b) -> a -> b
$
            MIRPot -> MIRTarget -> MIRCert
MIRCert MIRPot
ReservesMIR (MIRTarget -> MIRCert) -> MIRTarget -> MIRCert
forall a b. (a -> b) -> a -> b
$
              Map (Credential Staking) DeltaCoin -> MIRTarget
StakeAddressesMIR (Map (Credential Staking) DeltaCoin -> MIRTarget)
-> Map (Credential Staking) DeltaCoin -> MIRTarget
forall a b. (a -> b) -> a -> b
$
                [(Credential Staking, DeltaCoin)]
-> Map (Credential Staking) DeltaCoin
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
                  [ (KeyPair Staking -> Credential Staking
forall (r :: KeyRole). KeyPair r -> Credential r
keyToCredential (Word8 -> KeyPair Staking
forall (kd :: KeyRole). Word8 -> KeyPair kd
mkDSIGNKeyPair Word8
2), Integer -> DeltaCoin
DeltaCoin Integer
1)
                  ]
        , MIRCert -> TxCert era
forall era.
(ShelleyEraTxCert era, AtMostEra "Babbage" era) =>
MIRCert -> TxCert era
MirTxCert (MIRCert -> TxCert era) -> MIRCert -> TxCert era
forall a b. (a -> b) -> a -> b
$
            MIRPot -> MIRTarget -> MIRCert
MIRCert MIRPot
TreasuryMIR (MIRTarget -> MIRCert) -> MIRTarget -> MIRCert
forall a b. (a -> b) -> a -> b
$
              Map (Credential Staking) DeltaCoin -> MIRTarget
StakeAddressesMIR (Map (Credential Staking) DeltaCoin -> MIRTarget)
-> Map (Credential Staking) DeltaCoin -> MIRTarget
forall a b. (a -> b) -> a -> b
$
                [(Credential Staking, DeltaCoin)]
-> Map (Credential Staking) DeltaCoin
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
                  [ (KeyPair Staking -> Credential Staking
forall (r :: KeyRole). KeyPair r -> Credential r
keyToCredential (Word8 -> KeyPair Staking
forall (kd :: KeyRole). Word8 -> KeyPair kd
mkDSIGNKeyPair Word8
3), Integer -> DeltaCoin
DeltaCoin Integer
1)
                  ]
        , MIRCert -> TxCert era
forall era.
(ShelleyEraTxCert era, AtMostEra "Babbage" era) =>
MIRCert -> TxCert era
MirTxCert (MIRCert -> TxCert era) -> MIRCert -> TxCert era
forall a b. (a -> b) -> a -> b
$ MIRPot -> MIRTarget -> MIRCert
MIRCert MIRPot
ReservesMIR (MIRTarget -> MIRCert) -> MIRTarget -> MIRCert
forall a b. (a -> b) -> a -> b
$ Coin -> MIRTarget
SendToOppositePotMIR (Integer -> Coin
Coin Integer
1)
        ]

-- Add certificates to a given transaction that are compatible until Conway
-- era (DijkstraEra is not an instance of ShelleyEraTxCert).
addShelleyToConwayTxCerts ::
  (EraTx era, ShelleyEraTxCert era) =>
  Tx l era ->
  Tx l era
addShelleyToConwayTxCerts :: forall era (l :: TxLevel).
(EraTx era, ShelleyEraTxCert era) =>
Tx l era -> Tx l era
addShelleyToConwayTxCerts Tx l era
tx =
  Tx l era
tx Tx l era -> (Tx l era -> Tx l era) -> Tx l era
forall a b. a -> (a -> b) -> b
& (TxBody l era -> Identity (TxBody l era))
-> Tx l era -> Identity (Tx l era)
forall era (l :: TxLevel).
EraTx era =>
Lens' (Tx l era) (TxBody l era)
forall (l :: TxLevel). Lens' (Tx l era) (TxBody l era)
bodyTxL ((TxBody l era -> Identity (TxBody l era))
 -> Tx l era -> Identity (Tx l era))
-> ((StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
    -> TxBody l era -> Identity (TxBody l era))
-> (StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> Tx l era
-> Identity (Tx l era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> TxBody l era -> Identity (TxBody l era)
forall era (l :: TxLevel).
EraTxBody era =>
Lens' (TxBody l era) (StrictSeq (TxCert era))
forall (l :: TxLevel).
Lens' (TxBody l era) (StrictSeq (TxCert era))
certsTxBodyL ((StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
 -> Tx l era -> Identity (Tx l era))
-> StrictSeq (TxCert era) -> Tx l era -> Tx l era
forall a s t. Monoid a => ASetter s t a a -> a -> s -> t
<>~ StrictSeq (TxCert era)
txCerts
  where
    txCerts :: StrictSeq (TxCert era)
txCerts =
      [TxCert era] -> StrictSeq (TxCert era)
forall a. [a] -> StrictSeq a
StrictSeq.fromList
        [ Credential Staking -> TxCert era
forall era.
ShelleyEraTxCert era =>
Credential Staking -> TxCert era
RegTxCert (KeyPair Staking -> Credential Staking
forall (r :: KeyRole). KeyPair r -> Credential r
keyToCredential KeyPair Staking
exampleStakeKey)
        , Credential Staking -> TxCert era
forall era.
ShelleyEraTxCert era =>
Credential Staking -> TxCert era
UnRegTxCert (ScriptHash -> Credential Staking
forall (kr :: KeyRole). ScriptHash -> Credential kr
ScriptHashObj (Int -> ScriptHash
mkScriptHash Int
1))
        , Credential Staking -> KeyHash StakePool -> TxCert era
forall era.
ShelleyEraTxCert era =>
Credential Staking -> KeyHash StakePool -> TxCert era
DelegStakeTxCert (KeyPair Staking -> Credential Staking
forall (r :: KeyRole). KeyPair r -> Credential r
keyToCredential KeyPair Staking
exampleStakeKey) (StakePoolParams -> KeyHash StakePool
sppId StakePoolParams
exampleStakePoolParams)
        ]

exampleAuxiliaryDataShelley :: EraTxAuxData era => TxAuxData era
exampleAuxiliaryDataShelley :: forall era. EraTxAuxData era => TxAuxData era
exampleAuxiliaryDataShelley =
  TxAuxData era
forall era. EraTxAuxData era => TxAuxData era
mkBasicTxAuxData TxAuxData era -> (TxAuxData era -> TxAuxData era) -> TxAuxData era
forall a b. a -> (a -> b) -> b
& (Map Word64 Metadatum -> Identity (Map Word64 Metadatum))
-> TxAuxData era -> Identity (TxAuxData era)
forall era.
EraTxAuxData era =>
Lens' (TxAuxData era) (Map Word64 Metadatum)
Lens' (TxAuxData era) (Map Word64 Metadatum)
metadataTxAuxDataL ((Map Word64 Metadatum -> Identity (Map Word64 Metadatum))
 -> TxAuxData era -> Identity (TxAuxData era))
-> Map Word64 Metadatum -> TxAuxData era -> TxAuxData era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Map Word64 Metadatum
exampleAuxDataMap

exampleAuxDataMap :: Map Word64 Metadatum
exampleAuxDataMap :: Map Word64 Metadatum
exampleAuxDataMap =
  [(Word64, Metadatum)] -> Map Word64 Metadatum
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
    [ (Word64
1, Text -> Metadatum
S Text
"string")
    , (Word64
2, ByteArray -> Metadatum
B (ByteArray -> Metadatum) -> ByteArray -> Metadatum
forall a b. (a -> b) -> a -> b
$ ShortByteString -> ByteArray
byteArrayFromShortByteString ShortByteString
"bytes")
    , (Word64
3, Integer -> Metadatum
I Integer
1)
    , (Word64
4, [Metadatum] -> Metadatum
List [Integer -> Metadatum
I Integer
1, Integer -> Metadatum
I Integer
2])
    , (Word64
5, [(Metadatum, Metadatum)] -> Metadatum
Map [(Integer -> Metadatum
I Integer
3, ByteArray -> Metadatum
B (ByteArray -> Metadatum) -> ByteArray -> Metadatum
forall a b. (a -> b) -> a -> b
$ ShortByteString -> ByteArray
byteArrayFromShortByteString ShortByteString
"b")])
    ]

exampleTxIns :: Set TxIn
exampleTxIns :: Set TxIn
exampleTxIns =
  [TxIn] -> Set TxIn
forall a. Ord a => [a] -> Set a
Set.fromList
    [ TxId -> TxIx -> TxIn
TxIn (SafeHash EraIndependentTxBody -> TxId
TxId (forall a. Int -> SafeHash a
mkDummySafeHash @EraIndependentTxBody Int
1)) TxIx
forall a. Bounded a => a
minBound
    ]

exampleWithdrawals :: Withdrawals
exampleWithdrawals :: Withdrawals
exampleWithdrawals =
  Map AccountAddress Coin -> Withdrawals
Withdrawals (Map AccountAddress Coin -> Withdrawals)
-> Map AccountAddress Coin -> Withdrawals
forall a b. (a -> b) -> a -> b
$
    [(AccountAddress, Coin)] -> Map AccountAddress Coin
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
      [ (AccountAddress
exampleAccountAddress, Integer -> Coin
Coin Integer
100)
      ]

exampleProposedPPUpdates ::
  EraPParams era =>
  ProposedPPUpdates era
exampleProposedPPUpdates :: forall era. EraPParams era => ProposedPPUpdates era
exampleProposedPPUpdates =
  Map (KeyHash GenesisRole) (PParamsUpdate era)
-> ProposedPPUpdates era
forall era.
Map (KeyHash GenesisRole) (PParamsUpdate era)
-> ProposedPPUpdates era
ProposedPPUpdates (Map (KeyHash GenesisRole) (PParamsUpdate era)
 -> ProposedPPUpdates era)
-> Map (KeyHash GenesisRole) (PParamsUpdate era)
-> ProposedPPUpdates era
forall a b. (a -> b) -> a -> b
$
    KeyHash GenesisRole
-> PParamsUpdate era
-> Map (KeyHash GenesisRole) (PParamsUpdate era)
forall k a. k -> a -> Map k a
Map.singleton
      (Int -> KeyHash GenesisRole
forall (discriminator :: KeyRole). Int -> KeyHash discriminator
mkKeyHash Int
1)
      (PParamsUpdate era
forall era. EraPParams era => PParamsUpdate era
emptyPParamsUpdate PParamsUpdate era
-> (PParamsUpdate era -> PParamsUpdate era) -> PParamsUpdate era
forall a b. a -> (a -> b) -> b
& (StrictMaybe Word16 -> Identity (StrictMaybe Word16))
-> PParamsUpdate era -> Identity (PParamsUpdate era)
forall era.
EraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Word16)
Lens' (PParamsUpdate era) (StrictMaybe Word16)
ppuMaxBHSizeL ((StrictMaybe Word16 -> Identity (StrictMaybe Word16))
 -> PParamsUpdate era -> Identity (PParamsUpdate era))
-> StrictMaybe Word16 -> PParamsUpdate era -> PParamsUpdate era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Word16 -> StrictMaybe Word16
forall a. a -> StrictMaybe a
SJust Word16
4000)

exampleStakePoolParams :: StakePoolParams
exampleStakePoolParams :: StakePoolParams
exampleStakePoolParams =
  StakePoolParams
    { sppId :: KeyHash StakePool
sppId = VKey StakePool -> KeyHash StakePool
forall (kd :: KeyRole). VKey kd -> KeyHash kd
hashKey (VKey StakePool -> KeyHash StakePool)
-> VKey StakePool -> KeyHash StakePool
forall a b. (a -> b) -> a -> b
$ KeyPair StakePool -> VKey StakePool
forall (kd :: KeyRole). KeyPair kd -> VKey kd
vKey (KeyPair StakePool -> VKey StakePool)
-> KeyPair StakePool -> VKey StakePool
forall a b. (a -> b) -> a -> b
$ Word8 -> KeyPair StakePool
forall (kd :: KeyRole). Word8 -> KeyPair kd
mkDSIGNKeyPair Word8
1
    , sppVrf :: VRFVerKeyHash StakePoolVRF
sppVrf = VRFVerKeyHash StakePoolVRF
exampleVrfVerKeyHash
    , sppPledge :: Coin
sppPledge = Integer -> Coin
Coin Integer
1
    , sppCost :: Coin
sppCost = Integer -> Coin
Coin Integer
5
    , sppMargin :: UnitInterval
sppMargin = Rational -> UnitInterval
forall r.
(HasCallStack, Typeable r, BoundedRational r) =>
Rational -> r
unsafeBoundRational Rational
0.1
    , sppAccountAddress :: AccountAddress
sppAccountAddress = AccountAddress
exampleAccountAddress
    , 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 (VKey Staking -> KeyHash Staking)
-> VKey Staking -> KeyHash Staking
forall a b. (a -> b) -> a -> b
$ KeyPair Staking -> VKey Staking
forall (kd :: KeyRole). KeyPair kd -> VKey kd
vKey KeyPair Staking
exampleStakeKey
    , sppRelays :: StrictSeq StakePoolRelay
sppRelays =
        [StakePoolRelay] -> StrictSeq StakePoolRelay
forall a. [a] -> StrictSeq a
StrictSeq.fromList
          [ StrictMaybe Port
-> StrictMaybe IPv4 -> StrictMaybe IPv6 -> StakePoolRelay
SingleHostAddr
              (Port -> StrictMaybe Port
forall a. a -> StrictMaybe a
SJust (Word16 -> Port
Port Word16
3000))
              (IPv4 -> StrictMaybe IPv4
forall a. a -> StrictMaybe a
SJust ([Int] -> IPv4
toIPv4 [Int
127, Int
0, Int
0, Int
1]))
              (IPv6 -> StrictMaybe IPv6
forall a. a -> StrictMaybe a
SJust ([Int] -> IPv6
toIPv6 [Int
0x2001, Int
0xdb8, Int
0, Int
0, Int
0, Int
0, Int
0, Int
1]))
          , StrictMaybe Port -> DnsName -> StakePoolRelay
SingleHostName (Port -> StrictMaybe Port
forall a. a -> StrictMaybe a
SJust (Word16 -> Port
Port Word16
3001)) (Maybe DnsName -> DnsName
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe DnsName -> DnsName) -> Maybe DnsName -> DnsName
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Maybe DnsName
forall (m :: * -> *). MonadFail m => Int -> Text -> m DnsName
textToDns Int
64 Text
"relay.example.com")
          , DnsName -> StakePoolRelay
MultiHostName (Maybe DnsName -> DnsName
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe DnsName -> DnsName) -> Maybe DnsName -> DnsName
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Maybe DnsName
forall (m :: * -> *). MonadFail m => Int -> Text -> m DnsName
textToDns Int
64 Text
"relay.example.com")
          ]
    , sppMetadata :: StrictMaybe PoolMetadata
sppMetadata =
        PoolMetadata -> StrictMaybe PoolMetadata
forall a. a -> StrictMaybe a
SJust (PoolMetadata -> StrictMaybe PoolMetadata)
-> PoolMetadata -> StrictMaybe PoolMetadata
forall a b. (a -> b) -> a -> b
$
          PoolMetadata
            { pmUrl :: Url
pmUrl = Maybe Url -> Url
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe Url -> Url) -> Maybe Url -> Url
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Maybe Url
forall (m :: * -> *). MonadFail m => Int -> Text -> m Url
textToUrl Int
64 Text
"consensus.pool"
            , pmHash :: ByteArray
pmHash = ShortByteString -> ByteArray
byteArrayFromShortByteString ShortByteString
"{}"
            }
    }

examplePayKey :: KeyPair Payment
examplePayKey :: KeyPair Payment
examplePayKey = Word8 -> KeyPair Payment
forall (kd :: KeyRole). Word8 -> KeyPair kd
mkDSIGNKeyPair Word8
0

exampleStakeKey :: KeyPair Staking
exampleStakeKey :: KeyPair Staking
exampleStakeKey = Word8 -> KeyPair Staking
forall (kd :: KeyRole). Word8 -> KeyPair kd
mkDSIGNKeyPair Word8
1

exampleVrfVerKeyHash :: VRFVerKeyHash StakePoolVRF
exampleVrfVerKeyHash :: VRFVerKeyHash StakePoolVRF
exampleVrfVerKeyHash = Hash HASH KeyRoleVRF -> VRFVerKeyHash StakePoolVRF
forall (r :: KeyRoleVRF). Hash HASH KeyRoleVRF -> VRFVerKeyHash r
VRFVerKeyHash Hash HASH KeyRoleVRF
"c5e21ab1c9f6022d81c3b25e3436cb7f1df77f9652ae3e1310c28e621dd87b4c"

exampleAccountAddress :: AccountAddress
exampleAccountAddress :: AccountAddress
exampleAccountAddress = Network -> AccountId -> AccountAddress
AccountAddress Network
Testnet (Credential Staking -> AccountId
AccountId (KeyPair Staking -> Credential Staking
forall (r :: KeyRole). KeyPair r -> Credential r
keyToCredential KeyPair Staking
exampleStakeKey))

exampleByronSigningKey :: Byron.SigningKey
exampleByronSigningKey :: SigningKey
exampleByronSigningKey = XPrv -> SigningKey
Byron.SigningKey (XPrv -> SigningKey) -> XPrv -> SigningKey
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString -> XPrv
forall passPhrase seed.
(ByteArrayAccess passPhrase, ByteArrayAccess seed) =>
seed -> passPhrase -> XPrv
Byron.generate ByteString
seed (ByteString
forall a. Monoid a => a
mempty :: ByteString)
  where
    seed :: ByteString
seed = ByteString
"12345678901234567890123456789012" :: ByteString

exampleByronAddr :: Byron.Address
exampleByronAddr :: Address
exampleByronAddr =
  AddrSpendingData -> AddrAttributes -> Address
Byron.makeAddress
    (VerificationKey -> AddrSpendingData
Byron.VerKeyASD (SigningKey -> VerificationKey
Byron.toVerification SigningKey
exampleByronSigningKey))
    ( Maybe HDAddressPayload -> NetworkMagic -> AddrAttributes
Byron.AddrAttributes
        (HDAddressPayload -> Maybe HDAddressPayload
forall a. a -> Maybe a
Just (ByteString -> HDAddressPayload
Byron.HDAddressPayload ByteString
"a compressed lenna.png"))
        (Word32 -> NetworkMagic
Byron.NetworkTestnet Word32
0)
    )

exampleByronAddress :: Addr
exampleByronAddress :: Addr
exampleByronAddress = BootstrapAddress -> Addr
AddrBootstrap (Address -> BootstrapAddress
BootstrapAddress Address
exampleByronAddr)

exampleBootstrapWitness :: Hash HASH EraIndependentTxBody -> BootstrapWitness
exampleBootstrapWitness :: Hash HASH EraIndependentTxBody -> BootstrapWitness
exampleBootstrapWitness Hash HASH EraIndependentTxBody
txBodyHash =
  Hash HASH EraIndependentTxBody
-> SigningKey -> Attributes AddrAttributes -> BootstrapWitness
makeBootstrapWitness Hash HASH EraIndependentTxBody
txBodyHash SigningKey
exampleByronSigningKey (Address -> Attributes AddrAttributes
Byron.addrAttributes Address
exampleByronAddr)

exampleShelleyScript :: ShelleyEraScript era => NativeScript era
exampleShelleyScript :: forall era. ShelleyEraScript era => NativeScript era
exampleShelleyScript =
  Int -> StrictSeq (NativeScript era) -> NativeScript era
forall era.
ShelleyEraScript era =>
Int -> StrictSeq (NativeScript era) -> NativeScript era
RequireMOf Int
2 (StrictSeq (NativeScript era) -> NativeScript era)
-> StrictSeq (NativeScript era) -> NativeScript era
forall a b. (a -> b) -> a -> b
$
    [NativeScript era] -> StrictSeq (NativeScript era)
forall a. [a] -> StrictSeq a
StrictSeq.fromList
      [ KeyHash Witness -> NativeScript era
forall era.
ShelleyEraScript era =>
KeyHash Witness -> NativeScript era
RequireSignature (Int -> KeyHash Witness
forall (discriminator :: KeyRole). Int -> KeyHash discriminator
mkKeyHash Int
0)
      , StrictSeq (NativeScript era) -> NativeScript era
forall era.
ShelleyEraScript era =>
StrictSeq (NativeScript era) -> NativeScript era
RequireAllOf (StrictSeq (NativeScript era) -> NativeScript era)
-> StrictSeq (NativeScript era) -> NativeScript era
forall a b. (a -> b) -> a -> b
$
          [NativeScript era] -> StrictSeq (NativeScript era)
forall a. [a] -> StrictSeq a
StrictSeq.fromList
            [ KeyHash Witness -> NativeScript era
forall era.
ShelleyEraScript era =>
KeyHash Witness -> NativeScript era
RequireSignature (Int -> KeyHash Witness
forall (discriminator :: KeyRole). Int -> KeyHash discriminator
mkKeyHash Int
1)
            , KeyHash Witness -> NativeScript era
forall era.
ShelleyEraScript era =>
KeyHash Witness -> NativeScript era
RequireSignature (Int -> KeyHash Witness
forall (discriminator :: KeyRole). Int -> KeyHash discriminator
mkKeyHash Int
2)
            ]
      , StrictSeq (NativeScript era) -> NativeScript era
forall era.
ShelleyEraScript era =>
StrictSeq (NativeScript era) -> NativeScript era
RequireAnyOf (StrictSeq (NativeScript era) -> NativeScript era)
-> StrictSeq (NativeScript era) -> NativeScript era
forall a b. (a -> b) -> a -> b
$
          [NativeScript era] -> StrictSeq (NativeScript era)
forall a. [a] -> StrictSeq a
StrictSeq.fromList
            [ KeyHash Witness -> NativeScript era
forall era.
ShelleyEraScript era =>
KeyHash Witness -> NativeScript era
RequireSignature (Int -> KeyHash Witness
forall (discriminator :: KeyRole). Int -> KeyHash discriminator
mkKeyHash Int
3)
            , KeyHash Witness -> NativeScript era
forall era.
ShelleyEraScript era =>
KeyHash Witness -> NativeScript era
RequireSignature (Int -> KeyHash Witness
forall (discriminator :: KeyRole). Int -> KeyHash discriminator
mkKeyHash Int
4)
            ]
      ]

-- | @mkKeyPair'@ from @Test.Cardano.Ledger.Shelley.Utils@ doesn't work for real
-- crypto:
-- <https://github.com/intersectmbo/cardano-ledger/issues/1770>
mkDSIGNKeyPair :: forall kd. Word8 -> KeyPair kd
mkDSIGNKeyPair :: forall (kd :: KeyRole). Word8 -> KeyPair kd
mkDSIGNKeyPair Word8
byte = VKey kd -> SignKeyDSIGN DSIGN -> KeyPair kd
forall (kd :: KeyRole). VKey kd -> SignKeyDSIGN DSIGN -> KeyPair kd
KeyPair (VerKeyDSIGN DSIGN -> VKey kd
forall (kd :: KeyRole). VerKeyDSIGN DSIGN -> VKey kd
VKey (VerKeyDSIGN DSIGN -> VKey kd) -> VerKeyDSIGN DSIGN -> VKey kd
forall a b. (a -> b) -> a -> b
$ SignKeyDSIGN DSIGN -> VerKeyDSIGN DSIGN
forall v. DSIGNAlgorithm v => SignKeyDSIGN v -> VerKeyDSIGN v
DSIGN.deriveVerKeyDSIGN SignKeyDSIGN DSIGN
sk) SignKeyDSIGN DSIGN
sk
  where
    sk :: SignKeyDSIGN DSIGN
sk = Seed -> SignKeyDSIGN DSIGN
forall v. DSIGNAlgorithm v => Seed -> SignKeyDSIGN v
DSIGN.genKeyDSIGN (Seed -> SignKeyDSIGN DSIGN) -> Seed -> SignKeyDSIGN DSIGN
forall a b. (a -> b) -> a -> b
$ Word8 -> Int -> Seed
seedFromByte Word8
byte Int
size
    size :: Int
size = Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word -> Int) -> Word -> Int
forall a b. (a -> b) -> a -> b
$ Proxy DSIGN -> Word
forall v (proxy :: * -> *). DSIGNAlgorithm v => proxy v -> Word
DSIGN.seedSizeDSIGN (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @DSIGN)

mkKeyHash :: forall discriminator. Int -> KeyHash discriminator
mkKeyHash :: forall (discriminator :: KeyRole). Int -> KeyHash discriminator
mkKeyHash = Hash ADDRHASH (VerKeyDSIGN DSIGN) -> KeyHash discriminator
forall (r :: KeyRole).
Hash ADDRHASH (VerKeyDSIGN DSIGN) -> KeyHash r
KeyHash (Hash ADDRHASH (VerKeyDSIGN DSIGN) -> KeyHash discriminator)
-> (Int -> Hash ADDRHASH (VerKeyDSIGN DSIGN))
-> Int
-> KeyHash discriminator
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall h a b. (HashAlgorithm h, EncCBOR a) => a -> Hash h b
mkDummyHash @ADDRHASH

mkScriptHash :: Int -> ScriptHash
mkScriptHash :: Int -> ScriptHash
mkScriptHash = Hash ADDRHASH EraIndependentScript -> ScriptHash
ScriptHash (Hash ADDRHASH EraIndependentScript -> ScriptHash)
-> (Int -> Hash ADDRHASH EraIndependentScript) -> Int -> ScriptHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall h a b. (HashAlgorithm h, EncCBOR a) => a -> Hash h b
mkDummyHash @ADDRHASH

seedFromByte :: Word8 -> Int -> Seed.Seed
seedFromByte :: Word8 -> Int -> Seed
seedFromByte Word8
byte Int
size =
  ByteString -> Seed
Seed.mkSeedFromBytes (ByteString -> Seed) -> ByteString -> Seed
forall a b. (a -> b) -> a -> b
$
    Int -> Word8 -> ByteString
Strict.replicate
      Int
size
      Word8
byte

seedFromWords :: RawSeed -> Seed.Seed
seedFromWords :: RawSeed -> Seed
seedFromWords RawSeed
ws =
  ByteString -> Seed
Seed.mkSeedFromBytes (ByteString -> Seed)
-> (Hash HASH RawSeed -> ByteString) -> Hash HASH RawSeed -> Seed
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash HASH RawSeed -> ByteString
forall h a. Hash h a -> ByteString
hashToBytes (Hash HASH RawSeed -> Seed) -> Hash HASH RawSeed -> Seed
forall a b. (a -> b) -> a -> b
$ forall h a.
HashAlgorithm h =>
Version -> (a -> Encoding) -> a -> Hash h a
hashWithEncoder @HASH Version
shelleyProtVer RawSeed -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR RawSeed
ws

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