{-# 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.Consensus where

import Cardano.Crypto.DSIGN as DSIGN
import Cardano.Crypto.Hash as Hash
import Cardano.Crypto.KES as KES
import Cardano.Crypto.Seed as Seed
import qualified Cardano.Crypto.VRF as VRF
import Cardano.Ledger.BaseTypes
import Cardano.Ledger.Coin
import Cardano.Ledger.EpochBoundary
import Cardano.Ledger.Keys hiding (hashVerKeyVRF)
import Cardano.Ledger.PoolDistr
import Cardano.Ledger.Shelley (ShelleyEra)
import Cardano.Ledger.Shelley.API hiding (hashVerKeyVRF)
import Cardano.Ledger.Shelley.Core
import Cardano.Ledger.Shelley.LedgerState
import Cardano.Ledger.Shelley.Rules
import Cardano.Ledger.Shelley.Translation (emptyFromByronTranslationContext)
import Cardano.Ledger.Shelley.TxWits
import Cardano.Protocol.Crypto
import Cardano.Protocol.TPraos.API
import Cardano.Protocol.TPraos.BHeader
import Cardano.Protocol.TPraos.OCert
import Cardano.Protocol.TPraos.Rules.Prtcl
import Cardano.Protocol.TPraos.Rules.Tickn
import Cardano.Slotting.EpochInfo
import qualified Data.ByteString as Strict
import Data.Coerce (coerce)
import Data.Default
import qualified Data.List.NonEmpty as NE
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.Text (pack)
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 (..), mkWitnessesVKey)
import Test.Cardano.Ledger.Shelley.Generator.Core
import Test.Cardano.Ledger.Shelley.Utils hiding (mkVRFKeyPair)

{-------------------------------------------------------------------------------
  ShelleyLedgerExamples
-------------------------------------------------------------------------------}

data ShelleyResultExamples era = ShelleyResultExamples
  { forall era. ShelleyResultExamples era -> PParams era
srePParams :: PParams era
  , forall era. ShelleyResultExamples era -> ProposedPPUpdates era
sreProposedPPUpdates :: ProposedPPUpdates era
  , forall era. ShelleyResultExamples era -> PoolDistr
srePoolDistr :: PoolDistr
  , forall era.
ShelleyResultExamples era
-> Map
     (Either Coin (Credential 'Staking)) (Map (KeyHash 'StakePool) Coin)
sreNonMyopicRewards ::
      Map
        (Either Coin (Credential 'Staking))
        (Map (KeyHash 'StakePool) Coin)
  , forall era. ShelleyResultExamples era -> ShelleyGenesis
sreShelleyGenesis :: ShelleyGenesis
  }

deriving instance
  ( Eq (PParams era)
  , Eq (PParamsUpdate era)
  , Era era
  ) =>
  Eq (ShelleyResultExamples era)

data ShelleyLedgerExamples era = ShelleyLedgerExamples
  { forall era.
ShelleyLedgerExamples era -> Block (BHeader StandardCrypto) era
sleBlock :: Block (BHeader StandardCrypto) era
  , forall era. ShelleyLedgerExamples era -> HashHeader
sleHashHeader :: HashHeader
  , forall era. ShelleyLedgerExamples era -> Tx era
sleTx :: Tx era
  , forall era. ShelleyLedgerExamples era -> ApplyTxError era
sleApplyTxError :: ApplyTxError era
  , forall era.
ShelleyLedgerExamples era
-> Set (Either Coin (Credential 'Staking))
sleRewardsCredentials :: Set (Either Coin (Credential 'Staking))
  , forall era. ShelleyLedgerExamples era -> ShelleyResultExamples era
sleResultExamples :: ShelleyResultExamples era
  , forall era. ShelleyLedgerExamples era -> NewEpochState era
sleNewEpochState :: NewEpochState era
  , forall era. ShelleyLedgerExamples era -> ChainDepState
sleChainDepState :: ChainDepState
  , forall era. ShelleyLedgerExamples era -> TranslationContext era
sleTranslationContext :: TranslationContext era
  }

deriving instance
  ( EraTx era
  , EraGov era
  , Eq (TxSeq era)
  , Eq (PredicateFailure (EraRule "LEDGER" era))
  , Eq (StashedAVVMAddresses era)
  , Eq (TranslationContext era)
  ) =>
  Eq (ShelleyLedgerExamples era)

{-------------------------------------------------------------------------------
  Default constructor
-------------------------------------------------------------------------------}

defaultShelleyLedgerExamples ::
  forall era.
  ( EraSegWits era
  , EraGov 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) ->
  (ShelleyTx era -> Tx era) ->
  Value era ->
  TxBody era ->
  TxAuxData era ->
  TranslationContext era ->
  ShelleyLedgerExamples era
defaultShelleyLedgerExamples :: forall era.
(EraSegWits era, EraGov 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)
-> (ShelleyTx era -> Tx era)
-> Value era
-> TxBody era
-> TxAuxData era
-> TranslationContext era
-> ShelleyLedgerExamples era
defaultShelleyLedgerExamples TxBody era -> [KeyPair 'Witness] -> TxWits era
mkWitnesses ShelleyTx era -> Tx era
mkAlonzoTx Value era
value TxBody era
txBody TxAuxData era
auxData TranslationContext era
translationContext =
  ShelleyLedgerExamples
    { sleBlock :: Block (BHeader StandardCrypto) era
sleBlock = forall era.
EraSegWits era =>
Tx era -> Block (BHeader StandardCrypto) era
exampleShelleyLedgerBlock (ShelleyTx era -> Tx era
mkAlonzoTx ShelleyTx era
tx)
    , sleHashHeader :: HashHeader
sleHashHeader = HashHeader
exampleHashHeader
    , sleTx :: Tx era
sleTx = ShelleyTx era -> Tx era
mkAlonzoTx ShelleyTx era
tx
    , sleApplyTxError :: ApplyTxError era
sleApplyTxError =
        forall era.
NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> ApplyTxError era
ApplyTxError forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
PredicateFailure (EraRule "DELEGS" era)
-> ShelleyLedgerPredFailure era
DelegsFailure forall a b. (a -> b) -> a -> b
$
          forall era. KeyHash 'StakePool -> ShelleyDelegsPredFailure era
DelegateeNotRegisteredDELEG @era (forall (discriminator :: KeyRole). Int -> KeyHash discriminator
mkKeyHash Int
1)
    , sleRewardsCredentials :: Set (Either Coin (Credential 'Staking))
sleRewardsCredentials =
        forall a. Ord a => [a] -> Set a
Set.fromList
          [ forall a b. a -> Either a b
Left (Integer -> Coin
Coin Integer
100)
          , forall a b. b -> Either a b
Right (forall (kr :: KeyRole). ScriptHash -> Credential kr
ScriptHashObj (Int -> ScriptHash
mkScriptHash Int
1))
          , forall a b. b -> Either a b
Right (forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj (forall (discriminator :: KeyRole). Int -> KeyHash discriminator
mkKeyHash Int
2))
          ]
    , sleResultExamples :: ShelleyResultExamples era
sleResultExamples = ShelleyResultExamples era
resultExamples
    , sleNewEpochState :: NewEpochState era
sleNewEpochState =
        forall era.
(EraTxOut era, EraGov era, Default (StashedAVVMAddresses era)) =>
Value era -> PParams era -> PParams era -> NewEpochState era
exampleNewEpochState
          Value era
value
          forall era. EraPParams era => PParams era
emptyPParams
          (forall era. EraPParams era => PParams era
emptyPParams forall a b. a -> (a -> b) -> b
& forall era.
(EraPParams era, ProtVerAtMost era 4) =>
Lens' (PParams era) Coin
ppMinUTxOValueL forall s t a b. ASetter s t a b -> b -> s -> t
.~ Integer -> Coin
Coin Integer
1)
    , sleChainDepState :: ChainDepState
sleChainDepState = Word64 -> ChainDepState
exampleLedgerChainDepState Word64
1
    , sleTranslationContext :: TranslationContext era
sleTranslationContext = TranslationContext era
translationContext
    }
  where
    tx :: ShelleyTx era
tx = forall era.
EraTx era =>
(TxBody era -> [KeyPair 'Witness] -> TxWits era)
-> TxBody era -> TxAuxData era -> ShelleyTx era
exampleTx TxBody era -> [KeyPair 'Witness] -> TxWits era
mkWitnesses TxBody era
txBody TxAuxData era
auxData

    resultExamples :: ShelleyResultExamples era
resultExamples =
      ShelleyResultExamples
        { srePParams :: PParams era
srePParams = forall a. Default a => a
def
        , sreProposedPPUpdates :: ProposedPPUpdates era
sreProposedPPUpdates = forall era. EraPParams era => ProposedPPUpdates era
exampleProposedPParamsUpdates
        , srePoolDistr :: PoolDistr
srePoolDistr = PoolDistr
examplePoolDistr
        , sreNonMyopicRewards :: Map
  (Either Coin (Credential 'Staking)) (Map (KeyHash 'StakePool) Coin)
sreNonMyopicRewards = Map
  (Either Coin (Credential 'Staking)) (Map (KeyHash 'StakePool) Coin)
exampleNonMyopicRewards
        , sreShelleyGenesis :: ShelleyGenesis
sreShelleyGenesis = ShelleyGenesis
testShelleyGenesis
        }

{-------------------------------------------------------------------------------
  Helper constructors
-------------------------------------------------------------------------------}

exampleShelleyLedgerBlock ::
  forall era.
  EraSegWits era =>
  Tx era ->
  Block (BHeader StandardCrypto) era
exampleShelleyLedgerBlock :: forall era.
EraSegWits era =>
Tx era -> Block (BHeader StandardCrypto) era
exampleShelleyLedgerBlock Tx era
tx = forall era h.
(Era era, EncCBORGroup (TxSeq era), EncCBOR h) =>
h -> TxSeq era -> Block h era
Block BHeader StandardCrypto
blockHeader TxSeq era
blockBody
  where
    keys :: AllIssuerKeys StandardCrypto 'StakePool
    keys :: AllIssuerKeys StandardCrypto 'StakePool
keys = forall (r :: KeyRole). AllIssuerKeys StandardCrypto r
exampleKeys

    hotKey :: UnsoundPureSignKeyKES (KES StandardCrypto)
hotKey = forall c. KESKeyPair c -> UnsoundPureSignKeyKES (KES c)
kesSignKey forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ forall a. NonEmpty a -> a
NE.head forall a b. (a -> b) -> a -> b
$ forall c (r :: KeyRole).
AllIssuerKeys c r -> NonEmpty (KESPeriod, KESKeyPair c)
aikHot AllIssuerKeys StandardCrypto 'StakePool
keys
    KeyPair VKey 'StakePool
vKeyCold SignKeyDSIGN Ed25519DSIGN
_ = forall c (r :: KeyRole). AllIssuerKeys c r -> KeyPair r
aikCold AllIssuerKeys StandardCrypto 'StakePool
keys

    blockHeader :: BHeader StandardCrypto
    blockHeader :: BHeader StandardCrypto
blockHeader = forall c.
Crypto c =>
BHBody c -> SignedKES (KES c) (BHBody c) -> BHeader c
BHeader BHBody StandardCrypto
blockHeaderBody (forall v a.
(UnsoundPureKESAlgorithm v, Signable v a) =>
ContextKES v
-> Period -> a -> UnsoundPureSignKeyKES v -> SignedKES v a
unsoundPureSignedKES () Period
0 BHBody StandardCrypto
blockHeaderBody UnsoundPureSignKeyKES (Sum6KES Ed25519DSIGN HASH)
hotKey)

    blockHeaderBody :: BHBody StandardCrypto
    blockHeaderBody :: BHBody StandardCrypto
blockHeaderBody =
      BHBody
        { bheaderBlockNo :: BlockNo
bheaderBlockNo = Word64 -> BlockNo
BlockNo Word64
3
        , bheaderSlotNo :: SlotNo
bheaderSlotNo = Word64 -> SlotNo
SlotNo Word64
9
        , bheaderPrev :: PrevHash
bheaderPrev = HashHeader -> PrevHash
BlockHash (Hash HASH EraIndependentBlockHeader -> HashHeader
HashHeader (forall h a b. (HashAlgorithm h, EncCBOR a) => a -> Hash h b
mkDummyHash (Int
2 :: Int)))
        , bheaderVk :: VKey 'BlockIssuer
bheaderVk = forall (a :: KeyRole -> *) (r :: KeyRole) (r' :: KeyRole).
HasKeyRole a =>
a r -> a r'
coerceKeyRole VKey 'StakePool
vKeyCold
        , bheaderVrfVk :: VerKeyVRF (VRF StandardCrypto)
bheaderVrfVk = forall c. VRFKeyPair c -> VerKeyVRF (VRF c)
vrfVerKey forall a b. (a -> b) -> a -> b
$ forall c (r :: KeyRole). AllIssuerKeys c r -> VRFKeyPair c
aikVrf AllIssuerKeys StandardCrypto 'StakePool
keys
        , bheaderEta :: CertifiedVRF (VRF StandardCrypto) Nonce
bheaderEta = forall v a b.
(Signable v a, VRFAlgorithm v, ContextVRF v ~ (),
 Coercible b (CertifiedVRF v a)) =>
a -> SignKeyVRF v -> b
mkCertifiedVRF (Int -> Seed
mkBytes Int
0) (forall c. VRFKeyPair c -> SignKeyVRF (VRF c)
vrfSignKey forall a b. (a -> b) -> a -> b
$ forall c (r :: KeyRole). AllIssuerKeys c r -> VRFKeyPair c
aikVrf AllIssuerKeys StandardCrypto 'StakePool
keys)
        , bheaderL :: CertifiedVRF (VRF StandardCrypto) Natural
bheaderL = forall v a b.
(Signable v a, VRFAlgorithm v, ContextVRF v ~ (),
 Coercible b (CertifiedVRF v a)) =>
a -> SignKeyVRF v -> b
mkCertifiedVRF (Int -> Seed
mkBytes Int
1) (forall c. VRFKeyPair c -> SignKeyVRF (VRF c)
vrfSignKey forall a b. (a -> b) -> a -> b
$ forall c (r :: KeyRole). AllIssuerKeys c r -> VRFKeyPair c
aikVrf AllIssuerKeys StandardCrypto 'StakePool
keys)
        , bsize :: Word32
bsize = Word32
2345
        , bhash :: Hash HASH EraIndependentBlockBody
bhash = forall era.
EraSegWits era =>
TxSeq era -> Hash HASH EraIndependentBlockBody
hashTxSeq @era TxSeq era
blockBody
        , bheaderOCert :: OCert StandardCrypto
bheaderOCert = forall c (r :: KeyRole).
Crypto c =>
AllIssuerKeys c r -> Word64 -> KESPeriod -> OCert c
mkOCert AllIssuerKeys StandardCrypto 'StakePool
keys Word64
0 (Period -> KESPeriod
KESPeriod Period
0)
        , bprotver :: ProtVer
bprotver = Version -> Natural -> ProtVer
ProtVer (forall (v :: Natural).
(KnownNat v, MinVersion <= v, v <= MaxVersion) =>
Version
natVersion @2) Natural
0
        }

    blockBody :: TxSeq era
blockBody = forall era. EraSegWits era => StrictSeq (Tx era) -> TxSeq era
toTxSeq @era (forall a. [a] -> StrictSeq a
StrictSeq.fromList [Tx era
tx])

    mkBytes :: Int -> Cardano.Ledger.BaseTypes.Seed
    mkBytes :: Int -> Seed
mkBytes = Hash HASH Seed -> Seed
Seed forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall h a b. (HashAlgorithm h, EncCBOR a) => a -> Hash h b
mkDummyHash @Blake2b_256

exampleHashHeader :: HashHeader
exampleHashHeader :: HashHeader
exampleHashHeader = coerce :: forall a b. Coercible a b => a -> b
coerce forall a b. (a -> b) -> a -> b
$ forall h a b. (HashAlgorithm h, EncCBOR a) => a -> Hash h b
mkDummyHash @HASH (Int
0 :: Int)

mkKeyHash :: forall discriminator. Int -> KeyHash discriminator
mkKeyHash :: forall (discriminator :: KeyRole). Int -> KeyHash discriminator
mkKeyHash = forall (r :: KeyRole).
Hash ADDRHASH (VerKeyDSIGN Ed25519DSIGN) -> KeyHash r
KeyHash 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall h a b. (HashAlgorithm h, EncCBOR a) => a -> Hash h b
mkDummyHash @ADDRHASH

-- | 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 ->
  ShelleyTx era
exampleTx :: forall era.
EraTx era =>
(TxBody era -> [KeyPair 'Witness] -> TxWits era)
-> TxBody era -> TxAuxData era -> ShelleyTx era
exampleTx TxBody era -> [KeyPair 'Witness] -> TxWits era
mkWitnesses TxBody era
txBody TxAuxData era
auxData =
  forall era.
EraTx era =>
TxBody era
-> TxWits era -> StrictMaybe (TxAuxData era) -> ShelleyTx era
ShelleyTx TxBody era
txBody (TxBody era -> [KeyPair 'Witness] -> TxWits era
mkWitnesses TxBody era
txBody [KeyPair 'Witness]
keyPairWits) (forall a. a -> StrictMaybe a
SJust TxAuxData era
auxData)
  where
    keyPairWits :: [KeyPair 'Witness]
keyPairWits =
      [ forall (a :: KeyRole -> *) (r :: KeyRole).
HasKeyRole a =>
a r -> a 'Witness
asWitness KeyPair 'Payment
examplePayKey
      , forall (a :: KeyRole -> *) (r :: KeyRole).
HasKeyRole a =>
a r -> a 'Witness
asWitness KeyPair 'Staking
exampleStakeKey
      , forall (a :: KeyRole -> *) (r :: KeyRole).
HasKeyRole a =>
a r -> a 'Witness
asWitness forall a b. (a -> b) -> a -> b
$ forall c (r :: KeyRole). AllIssuerKeys c r -> KeyPair r
aikCold forall (r :: KeyRole). AllIssuerKeys StandardCrypto r
exampleKeys
      ]

exampleProposedPParamsUpdates ::
  EraPParams era =>
  ProposedPPUpdates era
exampleProposedPParamsUpdates :: forall era. EraPParams era => ProposedPPUpdates era
exampleProposedPParamsUpdates =
  forall era.
Map (KeyHash 'Genesis) (PParamsUpdate era) -> ProposedPPUpdates era
ProposedPPUpdates forall a b. (a -> b) -> a -> b
$
    forall k a. k -> a -> Map k a
Map.singleton
      (forall (discriminator :: KeyRole). Int -> KeyHash discriminator
mkKeyHash Int
0)
      (forall era. EraPParams era => PParamsUpdate era
emptyPParamsUpdate forall a b. a -> (a -> b) -> b
& forall era.
EraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Coin)
ppuKeyDepositL forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall a. a -> StrictMaybe a
SJust (Integer -> Coin
Coin Integer
100))

examplePoolDistr :: PoolDistr
examplePoolDistr :: PoolDistr
examplePoolDistr =
  Map (KeyHash 'StakePool) IndividualPoolStake
-> CompactForm Coin -> PoolDistr
PoolDistr
    ( forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
        [
          ( forall (discriminator :: KeyRole). Int -> KeyHash discriminator
mkKeyHash Int
1
          , Rational
-> CompactForm Coin
-> VRFVerKeyHash 'StakePoolVRF
-> IndividualPoolStake
IndividualPoolStake
              Rational
1
              (Word64 -> CompactForm Coin
CompactCoin Word64
1)
              (forall c (r :: KeyRoleVRF).
Crypto c =>
VerKeyVRF (VRF c) -> VRFVerKeyHash r
hashVerKeyVRF @StandardCrypto (forall c. VRFKeyPair c -> VerKeyVRF (VRF c)
vrfVerKey (forall c (r :: KeyRole). AllIssuerKeys c r -> VRFKeyPair c
aikVrf forall (r :: KeyRole). AllIssuerKeys StandardCrypto r
exampleKeys)))
          )
        ]
    )
    (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 =
  forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
    [ (forall a b. a -> Either a b
Left (Integer -> Coin
Coin Integer
100), forall k a. k -> a -> Map k a
Map.singleton (forall (discriminator :: KeyRole). Int -> KeyHash discriminator
mkKeyHash Int
2) (Integer -> Coin
Coin Integer
3))
    , (forall a b. b -> Either a b
Right (forall (kr :: KeyRole). ScriptHash -> Credential kr
ScriptHashObj (Int -> ScriptHash
mkScriptHash Int
1)), forall k a. Map k a
Map.empty)
    , (forall a b. b -> Either a b
Right (forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj (forall (discriminator :: KeyRole). Int -> KeyHash discriminator
mkKeyHash Int
2)), forall k a. k -> a -> Map k a
Map.singleton (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 = forall r.
(HasCallStack, Typeable r, BoundedRational r) =>
Rational -> r
unsafeBoundRational Rational
0.9
    , sgSecurityParam :: Word64
sgSecurityParam = Globals -> Word64
securityParameter Globals
testGlobals
    , sgEpochLength :: EpochSize
sgEpochLength = forall a. Identity a -> a
runIdentity forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
HasCallStack =>
EpochInfo m -> EpochNo -> m EpochSize
epochInfoSize EpochInfo Identity
testEpochInfo EpochNo
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 = forall era. EraPParams era => PParams era
emptyPParams
    , sgGenDelegs :: Map (KeyHash 'Genesis) GenDelegPair
sgGenDelegs = forall k a. Map k a
Map.empty
    , sgInitialFunds :: ListMap Addr Coin
sgInitialFunds = forall a. Monoid a => a
mempty
    , sgStaking :: ShelleyGenesisStaking
sgStaking = ShelleyGenesisStaking
emptyGenesisStaking
    }

-- | 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
  , Default (StashedAVVMAddresses era)
  ) =>
  Value era ->
  PParams era ->
  PParams era ->
  NewEpochState era
exampleNewEpochState :: forall era.
(EraTxOut era, EraGov 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 (forall k a. k -> a -> Map k a
Map.singleton (forall (discriminator :: KeyRole). Int -> KeyHash discriminator
mkKeyHash Int
1) Natural
10)
    , nesBcur :: BlocksMade
nesBcur = Map (KeyHash 'StakePool) Natural -> BlocksMade
BlocksMade (forall k a. k -> a -> Map k a
Map.singleton (forall (discriminator :: KeyRole). Int -> KeyHash discriminator
mkKeyHash Int
2) Natural
3)
    , nesEs :: EpochState era
nesEs = EpochState era
epochState
    , nesRu :: StrictMaybe PulsingRewUpdate
nesRu = forall a. a -> StrictMaybe a
SJust PulsingRewUpdate
rewardUpdate
    , nesPd :: PoolDistr
nesPd = PoolDistr
examplePoolDistr
    , stashedAVVMAddresses :: StashedAVVMAddresses era
stashedAVVMAddresses = forall a. Default a => a
def
    }
  where
    epochState :: EpochState era
    epochState :: EpochState era
epochState =
      EpochState
        { esAccountState :: AccountState
esAccountState =
            AccountState
              { asTreasury :: Coin
asTreasury = Integer -> Coin
Coin Integer
10000
              , asReserves :: Coin
asReserves = Integer -> Coin
Coin Integer
1000
              }
        , esSnapshots :: SnapShots
esSnapshots = SnapShots
emptySnapShots
        , esLState :: LedgerState era
esLState =
            LedgerState
              { lsUTxOState :: UTxOState era
lsUTxOState =
                  UTxOState
                    { utxosUtxo :: UTxO era
utxosUtxo =
                        forall era. Map TxIn (TxOut era) -> UTxO era
UTxO forall a b. (a -> b) -> a -> b
$
                          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)) forall a. Bounded a => a
minBound
                              , 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 = forall era. EraGov era => GovState era
emptyGovState
                    , utxosStakeDistr :: IncrementalStake
utxosStakeDistr = forall a. Monoid a => a
mempty
                    , utxosDonation :: Coin
utxosDonation = forall a. Monoid a => a
mempty
                    }
              , lsCertState :: CertState era
lsCertState = forall a. Default a => a
def
              }
        , esNonMyopic :: NonMyopic
esNonMyopic = forall a. Default a => a
def
        }
        forall a b. a -> (a -> b) -> b
& forall era. EraGov era => Lens' (EpochState era) (PParams era)
prevPParamsEpochStateL forall s t a b. ASetter s t a b -> b -> s -> t
.~ PParams era
ppp
        forall a b. a -> (a -> b) -> b
& forall era. EraGov era => Lens' (EpochState era) (PParams era)
curPParamsEpochStateL 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
            (forall (r :: KeyRole). KeyPair r -> Credential r
keyToCredential KeyPair 'Payment
examplePayKey)
            (Credential 'Staking -> StakeReference
StakeRefBase (forall (r :: KeyRole). KeyPair r -> Credential r
keyToCredential KeyPair 'Staking
exampleStakeKey))

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

exampleLedgerChainDepState :: Word64 -> ChainDepState
exampleLedgerChainDepState :: Word64 -> ChainDepState
exampleLedgerChainDepState Word64
seed =
  ChainDepState
    { csProtocol :: PrtclState
csProtocol =
        Map (KeyHash 'BlockIssuer) Word64 -> Nonce -> Nonce -> PrtclState
PrtclState
          ( forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
              [ (forall (discriminator :: KeyRole). Int -> KeyHash discriminator
mkKeyHash Int
1, Word64
1)
              , (forall (discriminator :: KeyRole). Int -> KeyHash discriminator
mkKeyHash Int
2, Word64
2)
              ]
          )
          (Word64 -> Nonce
mkNonceFromNumber Word64
seed)
          (Word64 -> Nonce
mkNonceFromNumber Word64
seed)
    , csTickn :: TicknState
csTickn =
        Nonce -> Nonce -> TicknState
TicknState
          Nonce
NeutralNonce
          (Word64 -> Nonce
mkNonceFromNumber Word64
seed)
    , csLabNonce :: Nonce
csLabNonce =
        Word64 -> Nonce
mkNonceFromNumber Word64
seed
    }

testEpochInfo :: EpochInfo Identity
testEpochInfo :: EpochInfo Identity
testEpochInfo = Globals -> EpochInfo Identity
epochInfoPure Globals
testGlobals

mkDummyAnchor :: Int -> Anchor
mkDummyAnchor :: Int -> Anchor
mkDummyAnchor Int
n =
  Anchor
    { anchorUrl :: Url
anchorUrl = forall a. HasCallStack => Maybe a -> a
fromJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). MonadFail m => Int -> Text -> m Url
textToUrl Int
64 forall a b. (a -> b) -> a -> b
$ Text
"dummy@" forall a. Semigroup a => a -> a -> a
<> String -> Text
pack (forall a. Show a => a -> String
show Int
n)
    , anchorDataHash :: SafeHash AnchorData
anchorDataHash = forall a. Int -> SafeHash a
mkDummySafeHash @AnchorData Int
n
    }

{-------------------------------------------------------------------------------
  Shelley era specific functions
-------------------------------------------------------------------------------}

-- | ShelleyLedgerExamples for Shelley era
ledgerExamplesShelley :: ShelleyLedgerExamples ShelleyEra
ledgerExamplesShelley :: ShelleyLedgerExamples ShelleyEra
ledgerExamplesShelley =
  forall era.
(EraSegWits era, EraGov 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)
-> (ShelleyTx era -> Tx era)
-> Value era
-> TxBody era
-> TxAuxData era
-> TranslationContext era
-> ShelleyLedgerExamples era
defaultShelleyLedgerExamples
    (forall era.
EraTx era =>
Proxy era -> TxBody era -> [KeyPair 'Witness] -> ShelleyTxWits era
mkWitnessesPreAlonzo (forall {k} (t :: k). Proxy t
Proxy @ShelleyEra))
    forall a. a -> a
id
    Coin
exampleCoin
    ShelleyTxBody ShelleyEra
exampleTxBodyShelley
    TxAuxData ShelleyEra
exampleAuxiliaryDataShelley
    FromByronTranslationContext
emptyFromByronTranslationContext

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 =
  forall a. Monoid a => a
mempty
    { addrWits :: Set (WitVKey 'Witness)
addrWits =
        forall (kr :: KeyRole).
SafeHash EraIndependentTxBody
-> [KeyPair kr] -> Set (WitVKey 'Witness)
mkWitnessesVKey (coerce :: forall a b. Coercible a b => a -> b
coerce (forall x i. HashAnnotated x i => x -> SafeHash i
hashAnnotated TxBody era
txBody)) [KeyPair 'Witness]
keyPairWits
    }

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

exampleTxBodyShelley :: ShelleyTxBody ShelleyEra
exampleTxBodyShelley :: ShelleyTxBody ShelleyEra
exampleTxBodyShelley =
  forall era.
(EraTxOut era, EncCBOR (TxCert era)) =>
Set TxIn
-> StrictSeq (TxOut era)
-> StrictSeq (TxCert era)
-> Withdrawals
-> Coin
-> SlotNo
-> StrictMaybe (Update era)
-> StrictMaybe TxAuxDataHash
-> ShelleyTxBody era
ShelleyTxBody
    Set TxIn
exampleTxIns
    ( forall a. [a] -> StrictSeq a
StrictSeq.fromList
        [ forall era.
(HasCallStack, Era era, Val (Value era)) =>
Addr -> Value era -> ShelleyTxOut era
ShelleyTxOut ((KeyPair 'Payment, KeyPair 'Staking) -> Addr
mkAddr (KeyPair 'Payment
examplePayKey, KeyPair 'Staking
exampleStakeKey)) (Integer -> Coin
Coin Integer
100000)
        ]
    )
    forall era.
(ShelleyEraTxCert era, ProtVerAtMost era 8) =>
StrictSeq (TxCert era)
exampleCerts
    Withdrawals
exampleWithdrawals
    (Integer -> Coin
Coin Integer
3)
    (Word64 -> SlotNo
SlotNo Word64
10)
    (forall a. a -> StrictMaybe a
SJust (forall era. ProposedPPUpdates era -> EpochNo -> Update era
Update forall era. EraPParams era => ProposedPPUpdates era
exampleProposedPPUpdates (Word64 -> EpochNo
EpochNo Word64
0)))
    (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 forall a b. (a -> b) -> a -> b
$ forall a. Int -> SafeHash a
mkDummySafeHash @EraIndependentTxAuxData Int
30

exampleAuxDataMap :: Map Word64 Metadatum
exampleAuxDataMap :: Map Word64 Metadatum
exampleAuxDataMap =
  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")])
    ]

exampleAuxiliaryDataShelley :: TxAuxData ShelleyEra
exampleAuxiliaryDataShelley :: TxAuxData ShelleyEra
exampleAuxiliaryDataShelley = forall era. Era era => Map Word64 Metadatum -> ShelleyTxAuxData era
ShelleyTxAuxData Map Word64 Metadatum
exampleAuxDataMap

exampleTxIns :: Set TxIn
exampleTxIns :: Set TxIn
exampleTxIns =
  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)) 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 =
  forall a. [a] -> StrictSeq a
StrictSeq.fromList
    [ forall era.
ShelleyEraTxCert era =>
Credential 'Staking -> TxCert era
RegTxCert (forall (r :: KeyRole). KeyPair r -> Credential r
keyToCredential KeyPair 'Staking
exampleStakeKey)
    , forall era. EraTxCert era => PoolParams -> TxCert era
RegPoolTxCert PoolParams
examplePoolParams
    , forall era.
(ShelleyEraTxCert era, ProtVerAtMost era 8) =>
MIRCert -> TxCert era
MirTxCert forall a b. (a -> b) -> a -> b
$
        MIRPot -> MIRTarget -> MIRCert
MIRCert MIRPot
ReservesMIR forall a b. (a -> b) -> a -> b
$
          Map (Credential 'Staking) DeltaCoin -> MIRTarget
StakeAddressesMIR forall a b. (a -> b) -> a -> b
$
            forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
              [ (forall (r :: KeyRole). KeyPair r -> Credential r
keyToCredential (forall (kd :: KeyRole). Word8 -> KeyPair kd
mkDSIGNKeyPair Word8
2), Integer -> DeltaCoin
DeltaCoin Integer
110)
              ]
    ]

exampleWithdrawals :: Withdrawals
exampleWithdrawals :: Withdrawals
exampleWithdrawals =
  Map RewardAccount Coin -> Withdrawals
Withdrawals forall a b. (a -> b) -> a -> b
$
    forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
      [ (PoolParams -> RewardAccount
ppRewardAccount PoolParams
examplePoolParams, Integer -> Coin
Coin Integer
100)
      ]

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

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

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

exampleKeys :: AllIssuerKeys StandardCrypto r
exampleKeys :: forall (r :: KeyRole). AllIssuerKeys StandardCrypto r
exampleKeys =
  forall c (r :: KeyRole).
KeyPair r
-> VRFKeyPair c
-> NonEmpty (KESPeriod, KESKeyPair c)
-> KeyHash r
-> AllIssuerKeys c r
AllIssuerKeys
    forall {kd :: KeyRole}. KeyPair kd
coldKey
    (forall c. Crypto c => Proxy c -> Word8 -> VRFKeyPair c
mkVRFKeyPair (forall {k} (t :: k). Proxy t
Proxy @StandardCrypto) Word8
1)
    ((Period -> KESPeriod
KESPeriod Period
0, forall c. Crypto c => RawSeed -> KESKeyPair c
mkKESKeyPair (Word64 -> Word64 -> Word64 -> Word64 -> Word64 -> RawSeed
RawSeed Word64
1 Word64
0 Word64
0 Word64
0 Word64
3)) forall a. a -> [a] -> NonEmpty a
NE.:| [])
    (forall (kd :: KeyRole). VKey kd -> KeyHash kd
hashKey (forall (kd :: KeyRole). KeyPair kd -> VKey kd
vKey forall {kd :: KeyRole}. KeyPair kd
coldKey))
  where
    coldKey :: KeyPair kd
coldKey = forall (kd :: KeyRole). Word8 -> KeyPair kd
mkDSIGNKeyPair Word8
1

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

-- | @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 = forall (kd :: KeyRole).
VKey kd -> SignKeyDSIGN Ed25519DSIGN -> KeyPair kd
KeyPair (forall (kd :: KeyRole). VerKeyDSIGN Ed25519DSIGN -> VKey kd
VKey forall a b. (a -> b) -> a -> b
$ forall v. DSIGNAlgorithm v => SignKeyDSIGN v -> VerKeyDSIGN v
DSIGN.deriveVerKeyDSIGN SignKeyDSIGN Ed25519DSIGN
sk) SignKeyDSIGN Ed25519DSIGN
sk
  where
    seed :: Seed
seed =
      ByteString -> Seed
Seed.mkSeedFromBytes forall a b. (a -> b) -> a -> b
$
        Int -> Word8 -> ByteString
Strict.replicate
          (forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall v (proxy :: * -> *). DSIGNAlgorithm v => proxy v -> Period
DSIGN.seedSizeDSIGN (forall {k} (t :: k). Proxy t
Proxy @DSIGN)))
          Word8
byte

    sk :: SignKeyDSIGN Ed25519DSIGN
sk = forall v. DSIGNAlgorithm v => Seed -> SignKeyDSIGN v
DSIGN.genKeyDSIGN Seed
seed

mkVRFKeyPair ::
  forall c.
  Crypto c =>
  Proxy c ->
  Word8 ->
  VRFKeyPair c
mkVRFKeyPair :: forall c. Crypto c => Proxy c -> Word8 -> VRFKeyPair c
mkVRFKeyPair Proxy c
_ Word8
byte = forall c. SignKeyVRF (VRF c) -> VerKeyVRF (VRF c) -> VRFKeyPair c
VRFKeyPair SignKeyVRF (VRF c)
sk (forall v. VRFAlgorithm v => SignKeyVRF v -> VerKeyVRF v
VRF.deriveVerKeyVRF SignKeyVRF (VRF c)
sk)
  where
    seed :: Seed
seed =
      ByteString -> Seed
Seed.mkSeedFromBytes forall a b. (a -> b) -> a -> b
$
        Int -> Word8 -> ByteString
Strict.replicate
          (forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall v (proxy :: * -> *). VRFAlgorithm v => proxy v -> Period
VRF.seedSizeVRF (forall {k} (t :: k). Proxy t
Proxy @(VRF c))))
          Word8
byte

    sk :: SignKeyVRF (VRF c)
sk = forall v. VRFAlgorithm v => Seed -> SignKeyVRF v
VRF.genKeyVRF Seed
seed

examplePoolParams :: PoolParams
examplePoolParams :: PoolParams
examplePoolParams =
  PoolParams
    { ppId :: KeyHash 'StakePool
ppId = forall (kd :: KeyRole). VKey kd -> KeyHash kd
hashKey forall a b. (a -> b) -> a -> b
$ forall (kd :: KeyRole). KeyPair kd -> VKey kd
vKey forall a b. (a -> b) -> a -> b
$ forall c (r :: KeyRole). AllIssuerKeys c r -> KeyPair r
aikCold forall (r :: KeyRole). AllIssuerKeys StandardCrypto r
exampleKeys
    , ppVrf :: VRFVerKeyHash 'StakePoolVRF
ppVrf = forall c (r :: KeyRoleVRF).
Crypto c =>
VerKeyVRF (VRF c) -> VRFVerKeyHash r
hashVerKeyVRF @StandardCrypto forall a b. (a -> b) -> a -> b
$ forall c. VRFKeyPair c -> VerKeyVRF (VRF c)
vrfVerKey forall a b. (a -> b) -> a -> b
$ forall c (r :: KeyRole). AllIssuerKeys c r -> VRFKeyPair c
aikVrf forall (r :: KeyRole). AllIssuerKeys StandardCrypto r
exampleKeys
    , ppPledge :: Coin
ppPledge = Integer -> Coin
Coin Integer
1
    , ppCost :: Coin
ppCost = Integer -> Coin
Coin Integer
5
    , ppMargin :: UnitInterval
ppMargin = forall r.
(HasCallStack, Typeable r, BoundedRational r) =>
Rational -> r
unsafeBoundRational Rational
0.1
    , ppRewardAccount :: RewardAccount
ppRewardAccount = Network -> Credential 'Staking -> RewardAccount
RewardAccount Network
Testnet (forall (r :: KeyRole). KeyPair r -> Credential r
keyToCredential KeyPair 'Staking
exampleStakeKey)
    , ppOwners :: Set (KeyHash 'Staking)
ppOwners = forall a. a -> Set a
Set.singleton forall a b. (a -> b) -> a -> b
$ forall (kd :: KeyRole). VKey kd -> KeyHash kd
hashKey forall a b. (a -> b) -> a -> b
$ forall (kd :: KeyRole). KeyPair kd -> VKey kd
vKey KeyPair 'Staking
exampleStakeKey
    , ppRelays :: StrictSeq StakePoolRelay
ppRelays = forall a. StrictSeq a
StrictSeq.empty
    , ppMetadata :: StrictMaybe PoolMetadata
ppMetadata =
        forall a. a -> StrictMaybe a
SJust forall a b. (a -> b) -> a -> b
$
          PoolMetadata
            { pmUrl :: Url
pmUrl = forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). MonadFail m => Int -> Text -> m Url
textToUrl Int
64 Text
"consensus.pool"
            , pmHash :: ByteString
pmHash = ByteString
"{}"
            }
    }