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

module Test.Cardano.Ledger.Shelley.Examples (
  LedgerExamples (..),
  ledgerExamples,
  -- functions used in building examples for other eras
  mkLedgerExamples,
  exampleCerts,
  exampleWithdrawals,
  exampleAuxDataMap,
  exampleNonMyopicRewards,
  exampleCoin,
  examplePayKey,
  exampleStakeKey,
  exampleNewEpochState,
  examplePoolDistr,
  examplePoolParams,
  exampleTxIns,
  exampleProposedPPUpdates,
  exampleByronAddress,
  testShelleyGenesis,
  -- utility functions
  keyToCredential,
  mkDSIGNKeyPair,
  mkKeyHash,
  mkScriptHash,
  mkWitnessesPreAlonzo,
  seedFromByte,
  seedFromWords,
) where

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.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.State
import Cardano.Ledger.Shelley.Translation (emptyFromByronTranslationContext)
import Cardano.Ledger.Shelley.TxWits
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 Data.Maybe (fromJust)
import Data.Proxy
import Data.Sequence.Strict (StrictSeq)
import qualified Data.Sequence.Strict as StrictSeq
import Data.Set (Set)
import qualified Data.Set as Set
import Data.Time
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 era
leTx :: Tx 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 era)
  , Eq (PredicateFailure (EraRule "LEDGER" era))
  , Eq (StashedAVVMAddresses era)
  , Eq (TranslationContext era)
  , Eq (CertState era)
  , Eq (InstantStake era)
  ) =>
  Eq (LedgerExamples era)

ledgerExamples :: LedgerExamples ShelleyEra
ledgerExamples :: LedgerExamples ShelleyEra
ledgerExamples =
  (TxBody ShelleyEra -> [KeyPair 'Witness] -> TxWits ShelleyEra)
-> Value ShelleyEra
-> TxBody ShelleyEra
-> TxAuxData ShelleyEra
-> TranslationContext ShelleyEra
-> LedgerExamples ShelleyEra
forall era.
(EraTx era, EraGov era, EraStake era, EraCertState era,
 PredicateFailure (EraRule "DELEGS" era)
 ~ ShelleyDelegsPredFailure era,
 PredicateFailure (EraRule "LEDGER" era)
 ~ ShelleyLedgerPredFailure era,
 Default (StashedAVVMAddresses era), ProtVerAtMost era 4) =>
(TxBody era -> [KeyPair 'Witness] -> TxWits era)
-> Value era
-> TxBody era
-> TxAuxData era
-> TranslationContext era
-> LedgerExamples era
mkLedgerExamples
    (Proxy ShelleyEra
-> TxBody ShelleyEra
-> [KeyPair 'Witness]
-> ShelleyTxWits ShelleyEra
forall era.
EraTx era =>
Proxy era -> TxBody era -> [KeyPair 'Witness] -> ShelleyTxWits era
mkWitnessesPreAlonzo (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @ShelleyEra))
    Coin
Value ShelleyEra
exampleCoin
    TxBody ShelleyEra
exampleTxBodyShelley
    TxAuxData ShelleyEra
exampleAuxiliaryDataShelley
    TranslationContext ShelleyEra
FromByronTranslationContext
emptyFromByronTranslationContext

mkLedgerExamples ::
  forall era.
  ( EraTx era
  , EraGov era
  , EraStake era
  , EraCertState era
  , PredicateFailure (EraRule "DELEGS" era) ~ ShelleyDelegsPredFailure era
  , PredicateFailure (EraRule "LEDGER" era) ~ ShelleyLedgerPredFailure era
  , Default (StashedAVVMAddresses era)
  , ProtVerAtMost era 4
  ) =>
  (TxBody era -> [KeyPair 'Witness] -> TxWits era) ->
  Value era ->
  TxBody era ->
  TxAuxData era ->
  TranslationContext era ->
  LedgerExamples era
mkLedgerExamples :: forall era.
(EraTx era, EraGov era, EraStake era, EraCertState era,
 PredicateFailure (EraRule "DELEGS" era)
 ~ ShelleyDelegsPredFailure era,
 PredicateFailure (EraRule "LEDGER" era)
 ~ ShelleyLedgerPredFailure era,
 Default (StashedAVVMAddresses era), ProtVerAtMost era 4) =>
(TxBody era -> [KeyPair 'Witness] -> TxWits era)
-> Value era
-> TxBody era
-> TxAuxData era
-> TranslationContext era
-> LedgerExamples era
mkLedgerExamples
  TxBody era -> [KeyPair 'Witness] -> TxWits era
mkWitnesses
  Value era
value
  TxBody era
txBody
  TxAuxData era
auxData
  TranslationContext era
translationContext =
    LedgerExamples
      { leTx :: Tx era
leTx = Tx era
tx
      , leApplyTxError :: ApplyTxError era
leApplyTxError =
          NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> ApplyTxError era
NonEmpty (ShelleyLedgerPredFailure era) -> ApplyTxError era
forall era.
NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> ApplyTxError era
ApplyTxError (NonEmpty (ShelleyLedgerPredFailure era) -> ApplyTxError era)
-> (ShelleyDelegsPredFailure era
    -> NonEmpty (ShelleyLedgerPredFailure era))
-> ShelleyDelegsPredFailure era
-> ApplyTxError era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShelleyLedgerPredFailure era
-> NonEmpty (ShelleyLedgerPredFailure era)
forall a. a -> NonEmpty a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ShelleyLedgerPredFailure era
 -> NonEmpty (ShelleyLedgerPredFailure era))
-> (ShelleyDelegsPredFailure era -> ShelleyLedgerPredFailure era)
-> ShelleyDelegsPredFailure era
-> NonEmpty (ShelleyLedgerPredFailure era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PredicateFailure (EraRule "DELEGS" era)
-> ShelleyLedgerPredFailure era
ShelleyDelegsPredFailure era -> ShelleyLedgerPredFailure era
forall era.
PredicateFailure (EraRule "DELEGS" era)
-> ShelleyLedgerPredFailure era
DelegsFailure (ShelleyDelegsPredFailure era -> ApplyTxError era)
-> ShelleyDelegsPredFailure era -> ApplyTxError era
forall a b. (a -> b) -> a -> b
$
            forall era. KeyHash 'StakePool -> ShelleyDelegsPredFailure era
DelegateeNotRegisteredDELEG @era (Int -> KeyHash 'StakePool
forall (discriminator :: KeyRole). Int -> KeyHash discriminator
mkKeyHash Int
1)
      , lePParams :: PParams era
lePParams = PParams era
forall a. Default a => a
def
      , leProposedPPUpdates :: ProposedPPUpdates era
leProposedPPUpdates =
          Map (KeyHash 'Genesis) (PParamsUpdate era) -> ProposedPPUpdates era
forall era.
Map (KeyHash 'Genesis) (PParamsUpdate era) -> ProposedPPUpdates era
ProposedPPUpdates (Map (KeyHash 'Genesis) (PParamsUpdate era)
 -> ProposedPPUpdates era)
-> Map (KeyHash 'Genesis) (PParamsUpdate era)
-> ProposedPPUpdates era
forall a b. (a -> b) -> a -> b
$
            KeyHash 'Genesis
-> PParamsUpdate era -> Map (KeyHash 'Genesis) (PParamsUpdate era)
forall k a. k -> a -> Map k a
Map.singleton
              (Int -> KeyHash 'Genesis
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 =>
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, 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
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
      }
    where
      tx :: Tx era
tx = (TxBody era -> [KeyPair 'Witness] -> TxWits era)
-> TxBody era -> TxAuxData era -> Tx era
forall era.
EraTx era =>
(TxBody era -> [KeyPair 'Witness] -> TxWits era)
-> TxBody era -> TxAuxData era -> Tx era
exampleTx TxBody era -> [KeyPair 'Witness] -> TxWits era
mkWitnesses TxBody era
txBody TxAuxData era
auxData

-- | This is not a valid transaction. We don't care, we are only interested in
-- serialisation, not validation.
exampleTx ::
  forall era.
  EraTx era =>
  (TxBody era -> [KeyPair 'Witness] -> TxWits era) ->
  TxBody era ->
  TxAuxData era ->
  Tx era
exampleTx :: forall era.
EraTx era =>
(TxBody era -> [KeyPair 'Witness] -> TxWits era)
-> TxBody era -> TxAuxData era -> Tx era
exampleTx TxBody era -> [KeyPair 'Witness] -> TxWits era
mkWitnesses TxBody era
txBody TxAuxData era
auxData =
  forall era. EraTx era => TxBody era -> Tx era
mkBasicTx @era TxBody era
txBody
    Tx era -> (Tx era -> Tx era) -> Tx era
forall a b. a -> (a -> b) -> b
& (TxWits era -> Identity (TxWits era))
-> Tx era -> Identity (Tx era)
forall era. EraTx era => Lens' (Tx era) (TxWits era)
Lens' (Tx era) (TxWits era)
witsTxL
      ((TxWits era -> Identity (TxWits era))
 -> Tx era -> Identity (Tx era))
-> TxWits era -> Tx era -> Tx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ TxBody era -> [KeyPair 'Witness] -> TxWits era
mkWitnesses TxBody era
txBody [KeyPair 'Witness]
keyPairWits
    Tx era -> (Tx era -> Tx era) -> Tx era
forall a b. a -> (a -> b) -> b
& (StrictMaybe (TxAuxData era)
 -> Identity (StrictMaybe (TxAuxData era)))
-> Tx era -> Identity (Tx era)
forall era.
EraTx era =>
Lens' (Tx era) (StrictMaybe (TxAuxData era))
Lens' (Tx era) (StrictMaybe (TxAuxData era))
auxDataTxL
      ((StrictMaybe (TxAuxData era)
  -> Identity (StrictMaybe (TxAuxData era)))
 -> Tx era -> Identity (Tx era))
-> StrictMaybe (TxAuxData era) -> Tx era -> Tx 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
auxData
  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 Any -> KeyPair 'Witness
forall (a :: KeyRole -> *) (r :: KeyRole).
HasKeyRole a =>
a r -> a 'Witness
asWitness (KeyPair Any -> KeyPair 'Witness)
-> KeyPair Any -> KeyPair 'Witness
forall a b. (a -> b) -> a -> b
$ Word8 -> KeyPair Any
forall (kd :: KeyRole). Word8 -> KeyPair kd
mkDSIGNKeyPair Word8
1
      ]

-- | 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 -> PaymentCredential -> StakeReference -> Addr
Addr
            Network
Testnet
            (KeyPair 'Payment -> PaymentCredential
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
-> CompactForm 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
          )
        ]
    )
    (Word64 -> CompactForm Coin
CompactCoin Word64
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 'Genesis) GenDelegPair
sgGenDelegs = Map (KeyHash 'Genesis) 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
    }

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

exampleTxBodyShelley :: TxBody ShelleyEra
exampleTxBodyShelley :: TxBody ShelleyEra
exampleTxBodyShelley =
  Set TxIn
-> StrictSeq (TxOut ShelleyEra)
-> StrictSeq (TxCert ShelleyEra)
-> Withdrawals
-> Coin
-> SlotNo
-> StrictMaybe (Update ShelleyEra)
-> StrictMaybe TxAuxDataHash
-> TxBody ShelleyEra
ShelleyTxBody
    Set TxIn
exampleTxIns
    ( [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 (KeyPair 'Payment -> KeyPair 'Staking -> Addr
forall p s.
(MakeCredential p 'Payment, MakeStakeReference s) =>
p -> s -> Addr
mkAddr KeyPair 'Payment
examplePayKey KeyPair 'Staking
exampleStakeKey) (Integer -> Coin
Coin Integer
100000)
        ]
    )
    StrictSeq (TxCert ShelleyEra)
forall era.
(ShelleyEraTxCert era, ProtVerAtMost era 8) =>
StrictSeq (TxCert era)
exampleCerts
    Withdrawals
exampleWithdrawals
    (Integer -> Coin
Coin Integer
3)
    (Word64 -> SlotNo
SlotNo Word64
10)
    (Update ShelleyEra -> StrictMaybe (Update ShelleyEra)
forall a. a -> StrictMaybe a
SJust (ProposedPPUpdates ShelleyEra -> EpochNo -> Update ShelleyEra
forall era. ProposedPPUpdates era -> EpochNo -> Update era
Update ProposedPPUpdates ShelleyEra
forall era. EraPParams era => ProposedPPUpdates era
exampleProposedPPUpdates (Word64 -> EpochNo
EpochNo Word64
0)))
    (TxAuxDataHash -> StrictMaybe TxAuxDataHash
forall a. a -> StrictMaybe a
SJust TxAuxDataHash
auxiliaryDataHash)
  where
    -- Dummy hash to decouple from the auxiliaryData in 'exampleTx'.
    auxiliaryDataHash :: TxAuxDataHash
    auxiliaryDataHash :: TxAuxDataHash
auxiliaryDataHash =
      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

exampleAuxiliaryDataShelley :: TxAuxData ShelleyEra
exampleAuxiliaryDataShelley :: TxAuxData ShelleyEra
exampleAuxiliaryDataShelley = Map Word64 Metadatum -> ShelleyTxAuxData ShelleyEra
forall era. Era era => Map Word64 Metadatum -> ShelleyTxAuxData era
ShelleyTxAuxData 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, ByteString -> Metadatum
B ByteString
"bytes")
    , (Word64
3, [Metadatum] -> Metadatum
List [Integer -> Metadatum
I Integer
1, Integer -> Metadatum
I Integer
2])
    , (Word64
4, [(Metadatum, Metadatum)] -> Metadatum
Map [(Integer -> Metadatum
I Integer
3, ByteString -> Metadatum
B ByteString
"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
    ]

exampleCerts ::
  (ShelleyEraTxCert era, ProtVerAtMost era 8) =>
  StrictSeq (TxCert era)
exampleCerts :: forall era.
(ShelleyEraTxCert era, ProtVerAtMost era 8) =>
StrictSeq (TxCert era)
exampleCerts =
  [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)
    , PoolParams -> TxCert era
forall era. EraTxCert era => PoolParams -> TxCert era
RegPoolTxCert PoolParams
examplePoolParams
    , MIRCert -> TxCert era
forall era.
(ShelleyEraTxCert era, ProtVerAtMost era 8) =>
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
110)
              ]
    ]

exampleWithdrawals :: Withdrawals
exampleWithdrawals :: Withdrawals
exampleWithdrawals =
  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
exampleRewardAccount, Integer -> Coin
Coin Integer
100)
      ]

exampleProposedPPUpdates ::
  EraPParams era =>
  ProposedPPUpdates era
exampleProposedPPUpdates :: forall era. EraPParams era => ProposedPPUpdates era
exampleProposedPPUpdates =
  Map (KeyHash 'Genesis) (PParamsUpdate era) -> ProposedPPUpdates era
forall era.
Map (KeyHash 'Genesis) (PParamsUpdate era) -> ProposedPPUpdates era
ProposedPPUpdates (Map (KeyHash 'Genesis) (PParamsUpdate era)
 -> ProposedPPUpdates era)
-> Map (KeyHash 'Genesis) (PParamsUpdate era)
-> ProposedPPUpdates era
forall a b. (a -> b) -> a -> b
$
    KeyHash 'Genesis
-> PParamsUpdate era -> Map (KeyHash 'Genesis) (PParamsUpdate era)
forall k a. k -> a -> Map k a
Map.singleton
      (Int -> KeyHash 'Genesis
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)

examplePoolParams :: PoolParams
examplePoolParams :: PoolParams
examplePoolParams =
  PoolParams
    { ppId :: KeyHash 'StakePool
ppId = 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
    , ppVrf :: VRFVerKeyHash 'StakePoolVRF
ppVrf = VRFVerKeyHash 'StakePoolVRF
exampleVrfVerKeyHash
    , ppPledge :: Coin
ppPledge = Integer -> Coin
Coin Integer
1
    , ppCost :: Coin
ppCost = Integer -> Coin
Coin Integer
5
    , ppMargin :: UnitInterval
ppMargin = Rational -> UnitInterval
forall r.
(HasCallStack, Typeable r, BoundedRational r) =>
Rational -> r
unsafeBoundRational Rational
0.1
    , ppRewardAccount :: RewardAccount
ppRewardAccount = RewardAccount
exampleRewardAccount
    , 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 (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
    , ppRelays :: StrictSeq StakePoolRelay
ppRelays = StrictSeq StakePoolRelay
forall a. StrictSeq a
StrictSeq.empty
    , ppMetadata :: StrictMaybe PoolMetadata
ppMetadata =
        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 :: ByteString
pmHash = ByteString
"{}"
            }
    }

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"

exampleRewardAccount :: RewardAccount
exampleRewardAccount :: RewardAccount
exampleRewardAccount = Network -> Credential 'Staking -> RewardAccount
RewardAccount Network
Testnet (KeyPair 'Staking -> Credential 'Staking
forall (r :: KeyRole). KeyPair r -> Credential r
keyToCredential KeyPair 'Staking
exampleStakeKey)

exampleByronAddress :: Addr
exampleByronAddress :: Addr
exampleByronAddress = BootstrapAddress -> Addr
AddrBootstrap (Address -> BootstrapAddress
BootstrapAddress Address
byronAddr)
  where
    byronAddr :: Address
byronAddr = AddrSpendingData -> AddrAttributes -> Address
Byron.makeAddress AddrSpendingData
asd AddrAttributes
attrs
    asd :: AddrSpendingData
asd = VerificationKey -> AddrSpendingData
Byron.VerKeyASD VerificationKey
byronVerificationKey
    attrs :: AddrAttributes
attrs =
      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)
    byronVerificationKey :: VerificationKey
byronVerificationKey = SigningKey -> VerificationKey
Byron.toVerification SigningKey
signingKey
    signingKey :: SigningKey
signingKey = 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)
    seed :: ByteString
seed = ByteString
"12345678901234567890123456789012" :: ByteString

mkWitnessesPreAlonzo ::
  EraTx era =>
  Proxy era ->
  TxBody era ->
  [KeyPair 'Witness] ->
  ShelleyTxWits era
mkWitnessesPreAlonzo :: forall era.
EraTx era =>
Proxy era -> TxBody era -> [KeyPair 'Witness] -> ShelleyTxWits era
mkWitnessesPreAlonzo Proxy era
_ TxBody era
txBody [KeyPair 'Witness]
keyPairWits =
  ShelleyTxWits era
forall a. Monoid a => a
mempty
    { addrWits =
        mkWitnessesVKey (coerce (hashAnnotated txBody)) keyPairWits
    }

-- | @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