{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}

module Test.Consensus.Shelley.Examples
  ( -- * Setup
    codecConfig
  , Shelley.testShelleyGenesis

    -- * Examples
  , examplesAllegra
  , examplesAlonzo
  , examplesBabbage
  , examplesConway
  , examplesDijkstra
  , examplesMary
  , examplesShelley
  ) where

import qualified Cardano.Crypto.Hash as Hash
import qualified Cardano.Ledger.BaseTypes as SL
import qualified Cardano.Ledger.Block as SL
import qualified Cardano.Ledger.Conway.Governance as CG
import qualified Cardano.Ledger.Conway.State as CG
import Cardano.Ledger.Core
import Cardano.Ledger.Hashes (unsafeMakeSafeHash)
import qualified Cardano.Ledger.Shelley.API as SL
import Cardano.Ledger.State (EraGov, unPoolDistr)
import Cardano.Protocol.Crypto (StandardCrypto)
import qualified Cardano.Protocol.Leios.BlockHeader as Leios
import Cardano.Protocol.Praos.BlockHeader
  ( HeaderBody (HeaderBody)
  )
import qualified Cardano.Protocol.Praos.BlockHeader as Praos
import qualified Cardano.Protocol.TPraos.BlockHeader as SL
import Cardano.Slotting.EpochInfo (fixedEpochInfo)
import Cardano.Slotting.Time (mkSlotLength)
import Data.Coerce (coerce)
import Data.List.NonEmpty (NonEmpty ((:|)))
import qualified Data.Map.Strict as Map
import Data.Set (Set)
import qualified Data.Set as Set
import Ouroboros.Consensus.Block
import Ouroboros.Consensus.HeaderValidation
import Ouroboros.Consensus.Ledger.Extended
import Ouroboros.Consensus.Ledger.Peras (initPerasState)
import Ouroboros.Consensus.Ledger.Query
import Ouroboros.Consensus.Ledger.SupportsMempool
import Ouroboros.Consensus.Ledger.Tables hiding (TxIn)
import Ouroboros.Consensus.Ledger.Tables.Utils
import Ouroboros.Consensus.Protocol.Abstract (TranslateProto, translateChainDepState)
import Ouroboros.Consensus.Protocol.Praos (Praos)
import Ouroboros.Consensus.Protocol.Praos.Common
import Ouroboros.Consensus.Protocol.Praos2 (Praos2)
import Ouroboros.Consensus.Protocol.TPraos
  ( TPraos
  , TPraosState (TPraosState)
  )
import Ouroboros.Consensus.Shelley.Eras (DijkstraEra)
import Ouroboros.Consensus.Shelley.HFEras
import Ouroboros.Consensus.Shelley.Ledger
import Ouroboros.Consensus.Shelley.Protocol.TPraos ()
import Ouroboros.Consensus.Storage.Serialisation
import Ouroboros.Consensus.Util.Time (secondsToNominalDiffTime)
import Ouroboros.Network.Block (mkSerialised)
import Ouroboros.Network.Magic (NetworkMagic (..))
import Ouroboros.Network.PeerSelection.LedgerPeers.Type
import Ouroboros.Network.PeerSelection.RelayAccessPoint
import qualified Test.Cardano.Ledger.Babbage.Examples as Babbage
import qualified Test.Cardano.Ledger.Conway.Examples as Conway
import qualified Test.Cardano.Ledger.Dijkstra.Examples as Dijkstra
import qualified Test.Cardano.Ledger.Shelley.Examples as Shelley
import Test.Cardano.Protocol.TPraos.Examples
  ( ProtocolLedgerExamples (..)
  , ledgerExamplesAllegra
  , ledgerExamplesAlonzo
  , ledgerExamplesMary
  , ledgerExamplesShelley
  , ledgerExamplesTPraos
  )
import Test.Util.Orphans.Arbitrary ()
import Test.Util.Serialisation.Examples
  ( Examples (..)
  , Labelled
  , labelled
  , topLevelQueries
  , unlabelled
  )
import Test.Util.Serialisation.SomeResult (SomeResult (..))

{-------------------------------------------------------------------------------
  Examples
-------------------------------------------------------------------------------}

codecConfig :: CodecConfig StandardShelleyBlock
codecConfig :: CodecConfig StandardShelleyBlock
codecConfig = CodecConfig StandardShelleyBlock
forall proto era. CodecConfig (ShelleyBlock proto era)
ShelleyCodecConfig

{-------------------------------------------------------------------------------
  Queries

  We list every constructor of 'BlockQuery', because the CBOR tag of each one is
  ours and a golden file is the only thing that catches a tag being reordered or
  reassigned. The arguments are mostly empty: the tag and the shape of the
  argument are what we want to pin, and the example ledger state does not give
  us interesting addresses or transaction inputs.
-------------------------------------------------------------------------------}

-- | The queries an era adds to 'eraIndependentQueries'.
--
-- The argument is the pool ids that the example ledger state knows about, for
-- the queries that take one.
type EraQueries proto era =
  [SL.KeyHash SL.StakePool] ->
  Labelled (SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))

-- | For the eras before Conway, which add no queries of their own.
noEraQueries :: EraQueries proto era
noEraQueries :: forall proto era. EraQueries proto era
noEraQueries [KeyHash StakePool]
_ = [(Maybe String,
  SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))]
forall a. Monoid a => a
mempty

-- | The queries that every Shelley-based era supports.
eraIndependentQueries ::
  EraGov era =>
  -- | Credentials to ask the non-myopic member rewards for
  Set (Either SL.Coin (SL.Credential SL.Staking)) ->
  Labelled (SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))
eraIndependentQueries :: forall era proto.
EraGov era =>
Set (Either Coin (Credential Staking))
-> Labelled (SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))
eraIndependentQueries Set (Either Coin (Credential Staking))
rewardsCredentials =
  [(String, SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))]
-> Labelled (SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))
forall a. [(String, a)] -> Labelled a
labelled
    [ (String
"GetLedgerTip", BlockQuery
  (ShelleyBlock proto era)
  'QFNoTables
  (Point (ShelleyBlock proto era))
-> SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
forall (q :: QueryFootprint -> * -> *)
       (footprint :: QueryFootprint) result.
SingI footprint =>
q footprint result -> SomeBlockQuery q
SomeBlockQuery BlockQuery
  (ShelleyBlock proto era)
  'QFNoTables
  (Point (ShelleyBlock proto era))
forall proto era.
BlockQuery
  (ShelleyBlock proto era)
  'QFNoTables
  (Point (ShelleyBlock proto era))
GetLedgerTip)
    , (String
"GetEpochNo", BlockQuery (ShelleyBlock proto era) 'QFNoTables EpochNo
-> SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
forall (q :: QueryFootprint -> * -> *)
       (footprint :: QueryFootprint) result.
SingI footprint =>
q footprint result -> SomeBlockQuery q
SomeBlockQuery BlockQuery (ShelleyBlock proto era) 'QFNoTables EpochNo
forall proto era.
BlockQuery (ShelleyBlock proto era) 'QFNoTables EpochNo
GetEpochNo)
    , (String
"GetNonMyopicMemberRewards", BlockQuery
  (ShelleyBlock proto era)
  'QFNoTables
  QueryResultNonMyopicMemberRewards
-> SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
forall (q :: QueryFootprint -> * -> *)
       (footprint :: QueryFootprint) result.
SingI footprint =>
q footprint result -> SomeBlockQuery q
SomeBlockQuery (BlockQuery
   (ShelleyBlock proto era)
   'QFNoTables
   QueryResultNonMyopicMemberRewards
 -> SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))
-> BlockQuery
     (ShelleyBlock proto era)
     'QFNoTables
     QueryResultNonMyopicMemberRewards
-> SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
forall a b. (a -> b) -> a -> b
$ Set (Either Coin (Credential Staking))
-> BlockQuery
     (ShelleyBlock proto era)
     'QFNoTables
     QueryResultNonMyopicMemberRewards
forall proto era.
Set (Either Coin (Credential Staking))
-> BlockQuery
     (ShelleyBlock proto era)
     'QFNoTables
     QueryResultNonMyopicMemberRewards
GetNonMyopicMemberRewards Set (Either Coin (Credential Staking))
rewardsCredentials)
    , (String
"GetCurrentPParams", BlockQuery (ShelleyBlock proto era) 'QFNoTables (PParams era)
-> SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
forall (q :: QueryFootprint -> * -> *)
       (footprint :: QueryFootprint) result.
SingI footprint =>
q footprint result -> SomeBlockQuery q
SomeBlockQuery BlockQuery (ShelleyBlock proto era) 'QFNoTables (PParams era)
forall proto era.
BlockQuery (ShelleyBlock proto era) 'QFNoTables (PParams era)
GetCurrentPParams)
    , (String
"GetUTxOByAddress", BlockQuery (ShelleyBlock proto era) 'QFTraverseTables (UTxO era)
-> SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
forall (q :: QueryFootprint -> * -> *)
       (footprint :: QueryFootprint) result.
SingI footprint =>
q footprint result -> SomeBlockQuery q
SomeBlockQuery (BlockQuery (ShelleyBlock proto era) 'QFTraverseTables (UTxO era)
 -> SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))
-> BlockQuery (ShelleyBlock proto era) 'QFTraverseTables (UTxO era)
-> SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
forall a b. (a -> b) -> a -> b
$ Set Addr
-> BlockQuery (ShelleyBlock proto era) 'QFTraverseTables (UTxO era)
forall proto era.
Set Addr
-> BlockQuery (ShelleyBlock proto era) 'QFTraverseTables (UTxO era)
GetUTxOByAddress Set Addr
forall a. Set a
Set.empty)
    , (String
"GetUTxOWhole", BlockQuery (ShelleyBlock proto era) 'QFTraverseTables (UTxO era)
-> SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
forall (q :: QueryFootprint -> * -> *)
       (footprint :: QueryFootprint) result.
SingI footprint =>
q footprint result -> SomeBlockQuery q
SomeBlockQuery BlockQuery (ShelleyBlock proto era) 'QFTraverseTables (UTxO era)
forall proto era.
BlockQuery (ShelleyBlock proto era) 'QFTraverseTables (UTxO era)
GetUTxOWhole)
    , (String
"DebugEpochState", BlockQuery (ShelleyBlock proto era) 'QFNoTables (EpochState era)
-> SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
forall (q :: QueryFootprint -> * -> *)
       (footprint :: QueryFootprint) result.
SingI footprint =>
q footprint result -> SomeBlockQuery q
SomeBlockQuery BlockQuery (ShelleyBlock proto era) 'QFNoTables (EpochState era)
forall proto era.
BlockQuery (ShelleyBlock proto era) 'QFNoTables (EpochState era)
DebugEpochState)
    , (String
"GetCBOR", BlockQuery
  (ShelleyBlock proto era)
  'QFNoTables
  (Serialised (Point (ShelleyBlock proto era)))
-> SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
forall (q :: QueryFootprint -> * -> *)
       (footprint :: QueryFootprint) result.
SingI footprint =>
q footprint result -> SomeBlockQuery q
SomeBlockQuery (BlockQuery
  (ShelleyBlock proto era)
  'QFNoTables
  (Point (ShelleyBlock proto era))
-> BlockQuery
     (ShelleyBlock proto era)
     'QFNoTables
     (Serialised (Point (ShelleyBlock proto era)))
forall proto era (fp :: QueryFootprint) result1.
BlockQuery (ShelleyBlock proto era) fp result1
-> BlockQuery (ShelleyBlock proto era) fp (Serialised result1)
GetCBOR BlockQuery
  (ShelleyBlock proto era)
  'QFNoTables
  (Point (ShelleyBlock proto era))
forall proto era.
BlockQuery
  (ShelleyBlock proto era)
  'QFNoTables
  (Point (ShelleyBlock proto era))
GetLedgerTip))
    ,
      ( String
"GetFilteredDelegationsAndRewardAccounts"
      , BlockQuery
  (ShelleyBlock proto era)
  'QFNoTables
  (Map (Credential Staking) (KeyHash StakePool),
   Map (Credential Staking) Coin)
-> SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
forall (q :: QueryFootprint -> * -> *)
       (footprint :: QueryFootprint) result.
SingI footprint =>
q footprint result -> SomeBlockQuery q
SomeBlockQuery (BlockQuery
   (ShelleyBlock proto era)
   'QFNoTables
   (Map (Credential Staking) (KeyHash StakePool),
    Map (Credential Staking) Coin)
 -> SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))
-> BlockQuery
     (ShelleyBlock proto era)
     'QFNoTables
     (Map (Credential Staking) (KeyHash StakePool),
      Map (Credential Staking) Coin)
-> SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
forall a b. (a -> b) -> a -> b
$ Set (Credential Staking)
-> BlockQuery
     (ShelleyBlock proto era)
     'QFNoTables
     (Map (Credential Staking) (KeyHash StakePool),
      Map (Credential Staking) Coin)
forall proto era.
Set (Credential Staking)
-> BlockQuery
     (ShelleyBlock proto era)
     'QFNoTables
     (Map (Credential Staking) (KeyHash StakePool),
      Map (Credential Staking) Coin)
GetFilteredDelegationsAndRewardAccounts Set (Credential Staking)
forall a. Set a
Set.empty
      )
    , (String
"GetGenesisConfig", BlockQuery (ShelleyBlock proto era) 'QFNoTables CompactGenesis
-> SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
forall (q :: QueryFootprint -> * -> *)
       (footprint :: QueryFootprint) result.
SingI footprint =>
q footprint result -> SomeBlockQuery q
SomeBlockQuery BlockQuery (ShelleyBlock proto era) 'QFNoTables CompactGenesis
forall proto era.
BlockQuery (ShelleyBlock proto era) 'QFNoTables CompactGenesis
GetGenesisConfig)
    , (String
"DebugNewEpochState", BlockQuery (ShelleyBlock proto era) 'QFNoTables (NewEpochState era)
-> SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
forall (q :: QueryFootprint -> * -> *)
       (footprint :: QueryFootprint) result.
SingI footprint =>
q footprint result -> SomeBlockQuery q
SomeBlockQuery BlockQuery (ShelleyBlock proto era) 'QFNoTables (NewEpochState era)
forall proto era.
BlockQuery (ShelleyBlock proto era) 'QFNoTables (NewEpochState era)
DebugNewEpochState)
    , (String
"DebugChainDepState", BlockQuery
  (ShelleyBlock proto era) 'QFNoTables (ChainDepState proto)
-> SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
forall (q :: QueryFootprint -> * -> *)
       (footprint :: QueryFootprint) result.
SingI footprint =>
q footprint result -> SomeBlockQuery q
SomeBlockQuery BlockQuery
  (ShelleyBlock proto era) 'QFNoTables (ChainDepState proto)
forall proto era.
BlockQuery
  (ShelleyBlock proto era) 'QFNoTables (ChainDepState proto)
DebugChainDepState)
    , (String
"GetRewardProvenance", BlockQuery (ShelleyBlock proto era) 'QFNoTables RewardProvenance
-> SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
forall (q :: QueryFootprint -> * -> *)
       (footprint :: QueryFootprint) result.
SingI footprint =>
q footprint result -> SomeBlockQuery q
SomeBlockQuery BlockQuery (ShelleyBlock proto era) 'QFNoTables RewardProvenance
forall proto era.
BlockQuery (ShelleyBlock proto era) 'QFNoTables RewardProvenance
GetRewardProvenance)
    , (String
"GetUTxOByTxIn", BlockQuery (ShelleyBlock proto era) 'QFLookupTables (UTxO era)
-> SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
forall (q :: QueryFootprint -> * -> *)
       (footprint :: QueryFootprint) result.
SingI footprint =>
q footprint result -> SomeBlockQuery q
SomeBlockQuery (BlockQuery (ShelleyBlock proto era) 'QFLookupTables (UTxO era)
 -> SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))
-> BlockQuery (ShelleyBlock proto era) 'QFLookupTables (UTxO era)
-> SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
forall a b. (a -> b) -> a -> b
$ Set TxIn
-> BlockQuery (ShelleyBlock proto era) 'QFLookupTables (UTxO era)
forall proto era.
Set TxIn
-> BlockQuery (ShelleyBlock proto era) 'QFLookupTables (UTxO era)
GetUTxOByTxIn Set TxIn
forall a. Set a
Set.empty)
    , (String
"GetStakePools", BlockQuery
  (ShelleyBlock proto era) 'QFNoTables (Set (KeyHash StakePool))
-> SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
forall (q :: QueryFootprint -> * -> *)
       (footprint :: QueryFootprint) result.
SingI footprint =>
q footprint result -> SomeBlockQuery q
SomeBlockQuery BlockQuery
  (ShelleyBlock proto era) 'QFNoTables (Set (KeyHash StakePool))
forall proto era.
BlockQuery
  (ShelleyBlock proto era) 'QFNoTables (Set (KeyHash StakePool))
GetStakePools)
    , (String
"GetStakePoolParams", BlockQuery
  (ShelleyBlock proto era)
  'QFNoTables
  (Map (KeyHash StakePool) (StakePoolParams era))
-> SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
forall (q :: QueryFootprint -> * -> *)
       (footprint :: QueryFootprint) result.
SingI footprint =>
q footprint result -> SomeBlockQuery q
SomeBlockQuery (BlockQuery
   (ShelleyBlock proto era)
   'QFNoTables
   (Map (KeyHash StakePool) (StakePoolParams era))
 -> SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))
-> BlockQuery
     (ShelleyBlock proto era)
     'QFNoTables
     (Map (KeyHash StakePool) (StakePoolParams era))
-> SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
forall a b. (a -> b) -> a -> b
$ Set (KeyHash StakePool)
-> BlockQuery
     (ShelleyBlock proto era)
     'QFNoTables
     (Map (KeyHash StakePool) (StakePoolParams era))
forall proto era.
Set (KeyHash StakePool)
-> BlockQuery
     (ShelleyBlock proto era)
     'QFNoTables
     (Map (KeyHash StakePool) (StakePoolParams era))
GetStakePoolParams Set (KeyHash StakePool)
forall a. Set a
Set.empty)
    , (String
"GetRewardInfoPools", BlockQuery
  (ShelleyBlock proto era)
  'QFNoTables
  (RewardParams, Map (KeyHash StakePool) RewardInfoPool)
-> SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
forall (q :: QueryFootprint -> * -> *)
       (footprint :: QueryFootprint) result.
SingI footprint =>
q footprint result -> SomeBlockQuery q
SomeBlockQuery BlockQuery
  (ShelleyBlock proto era)
  'QFNoTables
  (RewardParams, Map (KeyHash StakePool) RewardInfoPool)
forall proto era.
BlockQuery
  (ShelleyBlock proto era)
  'QFNoTables
  (RewardParams, Map (KeyHash StakePool) RewardInfoPool)
GetRewardInfoPools)
    , (String
"GetPoolState", BlockQuery
  (ShelleyBlock proto era) 'QFNoTables (QueryPoolStateResult era)
-> SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
forall (q :: QueryFootprint -> * -> *)
       (footprint :: QueryFootprint) result.
SingI footprint =>
q footprint result -> SomeBlockQuery q
SomeBlockQuery (BlockQuery
   (ShelleyBlock proto era) 'QFNoTables (QueryPoolStateResult era)
 -> SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))
-> BlockQuery
     (ShelleyBlock proto era) 'QFNoTables (QueryPoolStateResult era)
-> SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
forall a b. (a -> b) -> a -> b
$ Maybe (Set (KeyHash StakePool))
-> BlockQuery
     (ShelleyBlock proto era) 'QFNoTables (QueryPoolStateResult era)
forall proto era.
Maybe (Set (KeyHash StakePool))
-> BlockQuery
     (ShelleyBlock proto era) 'QFNoTables (QueryPoolStateResult era)
GetPoolState Maybe (Set (KeyHash StakePool))
forall a. Maybe a
Nothing)
    , (String
"GetStakeSnapshots", BlockQuery (ShelleyBlock proto era) 'QFNoTables StakeSnapshots
-> SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
forall (q :: QueryFootprint -> * -> *)
       (footprint :: QueryFootprint) result.
SingI footprint =>
q footprint result -> SomeBlockQuery q
SomeBlockQuery (BlockQuery (ShelleyBlock proto era) 'QFNoTables StakeSnapshots
 -> SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))
-> BlockQuery (ShelleyBlock proto era) 'QFNoTables StakeSnapshots
-> SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
forall a b. (a -> b) -> a -> b
$ Maybe (Set (KeyHash StakePool))
-> BlockQuery (ShelleyBlock proto era) 'QFNoTables StakeSnapshots
forall era proto.
EraGov era =>
Maybe (Set (KeyHash StakePool))
-> BlockQuery (ShelleyBlock proto era) 'QFNoTables StakeSnapshots
GetStakeSnapshots Maybe (Set (KeyHash StakePool))
forall a. Maybe a
Nothing)
    , (String
"GetStakeDelegDeposits", BlockQuery
  (ShelleyBlock proto era)
  'QFNoTables
  (Map (Credential Staking) Coin)
-> SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
forall (q :: QueryFootprint -> * -> *)
       (footprint :: QueryFootprint) result.
SingI footprint =>
q footprint result -> SomeBlockQuery q
SomeBlockQuery (BlockQuery
   (ShelleyBlock proto era)
   'QFNoTables
   (Map (Credential Staking) Coin)
 -> SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))
-> BlockQuery
     (ShelleyBlock proto era)
     'QFNoTables
     (Map (Credential Staking) Coin)
-> SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
forall a b. (a -> b) -> a -> b
$ Set (Credential Staking)
-> BlockQuery
     (ShelleyBlock proto era)
     'QFNoTables
     (Map (Credential Staking) Coin)
forall proto era.
Set (Credential Staking)
-> BlockQuery
     (ShelleyBlock proto era)
     'QFNoTables
     (Map (Credential Staking) Coin)
GetStakeDelegDeposits Set (Credential Staking)
forall a. Set a
Set.empty)
    , (String
"GetGovState", BlockQuery (ShelleyBlock proto era) 'QFNoTables (GovState era)
-> SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
forall (q :: QueryFootprint -> * -> *)
       (footprint :: QueryFootprint) result.
SingI footprint =>
q footprint result -> SomeBlockQuery q
SomeBlockQuery BlockQuery (ShelleyBlock proto era) 'QFNoTables (GovState era)
forall proto era.
BlockQuery (ShelleyBlock proto era) 'QFNoTables (GovState era)
GetGovState)
    , (String
"GetAccountState", BlockQuery (ShelleyBlock proto era) 'QFNoTables ChainAccountState
-> SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
forall (q :: QueryFootprint -> * -> *)
       (footprint :: QueryFootprint) result.
SingI footprint =>
q footprint result -> SomeBlockQuery q
SomeBlockQuery BlockQuery (ShelleyBlock proto era) 'QFNoTables ChainAccountState
forall proto era.
BlockQuery (ShelleyBlock proto era) 'QFNoTables ChainAccountState
GetAccountState)
    , (String
"GetFuturePParams", BlockQuery
  (ShelleyBlock proto era) 'QFNoTables (Maybe (PParams era))
-> SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
forall (q :: QueryFootprint -> * -> *)
       (footprint :: QueryFootprint) result.
SingI footprint =>
q footprint result -> SomeBlockQuery q
SomeBlockQuery BlockQuery
  (ShelleyBlock proto era) 'QFNoTables (Maybe (PParams era))
forall proto era.
BlockQuery
  (ShelleyBlock proto era) 'QFNoTables (Maybe (PParams era))
GetFuturePParams)
    , (String
"GetBigLedgerPeerSnapshot", BlockQuery
  (ShelleyBlock proto era)
  'QFNoTables
  (LedgerPeerSnapshot BigLedgerPeers)
-> SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
forall (q :: QueryFootprint -> * -> *)
       (footprint :: QueryFootprint) result.
SingI footprint =>
q footprint result -> SomeBlockQuery q
SomeBlockQuery (SingLedgerPeersKind BigLedgerPeers
-> BlockQuery
     (ShelleyBlock proto era)
     'QFNoTables
     (LedgerPeerSnapshot BigLedgerPeers)
forall proto era (ledgerPeersKind :: LedgerPeersKind).
SingLedgerPeersKind ledgerPeersKind
-> BlockQuery
     (ShelleyBlock proto era)
     'QFNoTables
     (LedgerPeerSnapshot ledgerPeersKind)
GetLedgerPeerSnapshot SingLedgerPeersKind BigLedgerPeers
SingBigLedgerPeers))
    , (String
"GetAllLedgerPeerSnapshot", BlockQuery
  (ShelleyBlock proto era)
  'QFNoTables
  (LedgerPeerSnapshot AllLedgerPeers)
-> SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
forall (q :: QueryFootprint -> * -> *)
       (footprint :: QueryFootprint) result.
SingI footprint =>
q footprint result -> SomeBlockQuery q
SomeBlockQuery (SingLedgerPeersKind AllLedgerPeers
-> BlockQuery
     (ShelleyBlock proto era)
     'QFNoTables
     (LedgerPeerSnapshot AllLedgerPeers)
forall proto era (ledgerPeersKind :: LedgerPeersKind).
SingLedgerPeersKind ledgerPeersKind
-> BlockQuery
     (ShelleyBlock proto era)
     'QFNoTables
     (LedgerPeerSnapshot ledgerPeersKind)
GetLedgerPeerSnapshot SingLedgerPeersKind AllLedgerPeers
SingAllLedgerPeers))
    , (String
"GetPoolDistr2", BlockQuery
  (ShelleyBlock proto era) 'QFNoTables QueryResultPoolDistr
-> SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
forall (q :: QueryFootprint -> * -> *)
       (footprint :: QueryFootprint) result.
SingI footprint =>
q footprint result -> SomeBlockQuery q
SomeBlockQuery (BlockQuery
   (ShelleyBlock proto era) 'QFNoTables QueryResultPoolDistr
 -> SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))
-> BlockQuery
     (ShelleyBlock proto era) 'QFNoTables QueryResultPoolDistr
-> SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
forall a b. (a -> b) -> a -> b
$ Maybe (Set (KeyHash StakePool))
-> BlockQuery
     (ShelleyBlock proto era) 'QFNoTables QueryResultPoolDistr
forall proto era.
Maybe (Set (KeyHash StakePool))
-> BlockQuery
     (ShelleyBlock proto era) 'QFNoTables QueryResultPoolDistr
GetPoolDistr2 Maybe (Set (KeyHash StakePool))
forall a. Maybe a
Nothing)
    , (String
"GetStakeDistribution2", BlockQuery (ShelleyBlock proto era) 'QFNoTables PoolDistr
-> SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
forall (q :: QueryFootprint -> * -> *)
       (footprint :: QueryFootprint) result.
SingI footprint =>
q footprint result -> SomeBlockQuery q
SomeBlockQuery BlockQuery (ShelleyBlock proto era) 'QFNoTables PoolDistr
forall proto era.
BlockQuery (ShelleyBlock proto era) 'QFNoTables PoolDistr
GetStakeDistribution2)
    , (String
"GetMaxMajorProtocolVersion", BlockQuery (ShelleyBlock proto era) 'QFNoTables MaxMajorProtVer
-> SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
forall (q :: QueryFootprint -> * -> *)
       (footprint :: QueryFootprint) result.
SingI footprint =>
q footprint result -> SomeBlockQuery q
SomeBlockQuery BlockQuery (ShelleyBlock proto era) 'QFNoTables MaxMajorProtVer
forall proto era.
BlockQuery (ShelleyBlock proto era) 'QFNoTables MaxMajorProtVer
GetMaxMajorProtocolVersion)
    ]

-- | The queries that Conway introduced, which the later eras also support.
conwayQueries ::
  (CG.ConwayEraGov era, CG.ConwayEraCertState era) =>
  EraQueries proto era
conwayQueries :: forall era proto.
(ConwayEraGov era, ConwayEraCertState era) =>
EraQueries proto era
conwayQueries [KeyHash StakePool]
poolIds =
  [(String, SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))]
-> Labelled (SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))
forall a. [(String, a)] -> Labelled a
labelled ([(String, SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))]
 -> Labelled (SomeBlockQuery (BlockQuery (ShelleyBlock proto era))))
-> [(String, SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))]
-> Labelled (SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))
forall a b. (a -> b) -> a -> b
$
    [ (String
"GetConstitution", BlockQuery (ShelleyBlock proto era) 'QFNoTables (Constitution era)
-> SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
forall (q :: QueryFootprint -> * -> *)
       (footprint :: QueryFootprint) result.
SingI footprint =>
q footprint result -> SomeBlockQuery q
SomeBlockQuery BlockQuery (ShelleyBlock proto era) 'QFNoTables (Constitution era)
forall era proto.
ConwayEraGov era =>
BlockQuery (ShelleyBlock proto era) 'QFNoTables (Constitution era)
GetConstitution)
    , (String
"GetDRepState", BlockQuery
  (ShelleyBlock proto era)
  'QFNoTables
  (Map (Credential DRepRole) DRepState)
-> SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
forall (q :: QueryFootprint -> * -> *)
       (footprint :: QueryFootprint) result.
SingI footprint =>
q footprint result -> SomeBlockQuery q
SomeBlockQuery (BlockQuery
   (ShelleyBlock proto era)
   'QFNoTables
   (Map (Credential DRepRole) DRepState)
 -> SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))
-> BlockQuery
     (ShelleyBlock proto era)
     'QFNoTables
     (Map (Credential DRepRole) DRepState)
-> SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
forall a b. (a -> b) -> a -> b
$ Set (Credential DRepRole)
-> BlockQuery
     (ShelleyBlock proto era)
     'QFNoTables
     (Map (Credential DRepRole) DRepState)
forall era proto.
(ConwayEraGov era, ConwayEraCertState era) =>
Set (Credential DRepRole)
-> BlockQuery
     (ShelleyBlock proto era)
     'QFNoTables
     (Map (Credential DRepRole) DRepState)
GetDRepState Set (Credential DRepRole)
forall a. Set a
Set.empty)
    , (String
"GetDRepStakeDistr", BlockQuery (ShelleyBlock proto era) 'QFNoTables (Map DRep Coin)
-> SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
forall (q :: QueryFootprint -> * -> *)
       (footprint :: QueryFootprint) result.
SingI footprint =>
q footprint result -> SomeBlockQuery q
SomeBlockQuery (BlockQuery (ShelleyBlock proto era) 'QFNoTables (Map DRep Coin)
 -> SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))
-> BlockQuery (ShelleyBlock proto era) 'QFNoTables (Map DRep Coin)
-> SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
forall a b. (a -> b) -> a -> b
$ Set DRep
-> BlockQuery (ShelleyBlock proto era) 'QFNoTables (Map DRep Coin)
forall era proto.
ConwayEraGov era =>
Set DRep
-> BlockQuery (ShelleyBlock proto era) 'QFNoTables (Map DRep Coin)
GetDRepStakeDistr Set DRep
forall a. Set a
Set.empty)
    ,
      ( String
"GetCommitteeMembersState"
      , BlockQuery
  (ShelleyBlock proto era) 'QFNoTables CommitteeMembersState
-> SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
forall (q :: QueryFootprint -> * -> *)
       (footprint :: QueryFootprint) result.
SingI footprint =>
q footprint result -> SomeBlockQuery q
SomeBlockQuery (BlockQuery
   (ShelleyBlock proto era) 'QFNoTables CommitteeMembersState
 -> SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))
-> BlockQuery
     (ShelleyBlock proto era) 'QFNoTables CommitteeMembersState
-> SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
forall a b. (a -> b) -> a -> b
$ Set (Credential ColdCommitteeRole)
-> Set (Credential HotCommitteeRole)
-> Set MemberStatus
-> BlockQuery
     (ShelleyBlock proto era) 'QFNoTables CommitteeMembersState
forall era proto.
(ConwayEraGov era, ConwayEraCertState era) =>
Set (Credential ColdCommitteeRole)
-> Set (Credential HotCommitteeRole)
-> Set MemberStatus
-> BlockQuery
     (ShelleyBlock proto era) 'QFNoTables CommitteeMembersState
GetCommitteeMembersState Set (Credential ColdCommitteeRole)
forall a. Set a
Set.empty Set (Credential HotCommitteeRole)
forall a. Set a
Set.empty Set MemberStatus
forall a. Set a
Set.empty
      )
    , (String
"GetFilteredVoteDelegatees", BlockQuery
  (ShelleyBlock proto era)
  'QFNoTables
  (Map (Credential Staking) DRep)
-> SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
forall (q :: QueryFootprint -> * -> *)
       (footprint :: QueryFootprint) result.
SingI footprint =>
q footprint result -> SomeBlockQuery q
SomeBlockQuery (BlockQuery
   (ShelleyBlock proto era)
   'QFNoTables
   (Map (Credential Staking) DRep)
 -> SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))
-> BlockQuery
     (ShelleyBlock proto era)
     'QFNoTables
     (Map (Credential Staking) DRep)
-> SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
forall a b. (a -> b) -> a -> b
$ Set (Credential Staking)
-> BlockQuery
     (ShelleyBlock proto era)
     'QFNoTables
     (Map (Credential Staking) DRep)
forall era proto.
ConwayEraGov era =>
Set (Credential Staking)
-> BlockQuery
     (ShelleyBlock proto era)
     'QFNoTables
     (Map (Credential Staking) DRep)
GetFilteredVoteDelegatees Set (Credential Staking)
forall a. Set a
Set.empty)
    , (String
"GetSPOStakeDistr", BlockQuery
  (ShelleyBlock proto era) 'QFNoTables (Map (KeyHash StakePool) Coin)
-> SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
forall (q :: QueryFootprint -> * -> *)
       (footprint :: QueryFootprint) result.
SingI footprint =>
q footprint result -> SomeBlockQuery q
SomeBlockQuery (BlockQuery
   (ShelleyBlock proto era) 'QFNoTables (Map (KeyHash StakePool) Coin)
 -> SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))
-> BlockQuery
     (ShelleyBlock proto era) 'QFNoTables (Map (KeyHash StakePool) Coin)
-> SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
forall a b. (a -> b) -> a -> b
$ Set (KeyHash StakePool)
-> BlockQuery
     (ShelleyBlock proto era) 'QFNoTables (Map (KeyHash StakePool) Coin)
forall era proto.
ConwayEraGov era =>
Set (KeyHash StakePool)
-> BlockQuery
     (ShelleyBlock proto era) 'QFNoTables (Map (KeyHash StakePool) Coin)
GetSPOStakeDistr Set (KeyHash StakePool)
forall a. Set a
Set.empty)
    , (String
"GetProposals", BlockQuery
  (ShelleyBlock proto era) 'QFNoTables (Seq (GovActionState era))
-> SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
forall (q :: QueryFootprint -> * -> *)
       (footprint :: QueryFootprint) result.
SingI footprint =>
q footprint result -> SomeBlockQuery q
SomeBlockQuery (BlockQuery
   (ShelleyBlock proto era) 'QFNoTables (Seq (GovActionState era))
 -> SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))
-> BlockQuery
     (ShelleyBlock proto era) 'QFNoTables (Seq (GovActionState era))
-> SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
forall a b. (a -> b) -> a -> b
$ Set GovActionId
-> BlockQuery
     (ShelleyBlock proto era) 'QFNoTables (Seq (GovActionState era))
forall era proto.
ConwayEraGov era =>
Set GovActionId
-> BlockQuery
     (ShelleyBlock proto era) 'QFNoTables (Seq (GovActionState era))
GetProposals Set GovActionId
forall a. Set a
Set.empty)
    , (String
"GetRatifyState", BlockQuery (ShelleyBlock proto era) 'QFNoTables (RatifyState era)
-> SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
forall (q :: QueryFootprint -> * -> *)
       (footprint :: QueryFootprint) result.
SingI footprint =>
q footprint result -> SomeBlockQuery q
SomeBlockQuery BlockQuery (ShelleyBlock proto era) 'QFNoTables (RatifyState era)
forall era proto.
ConwayEraGov era =>
BlockQuery (ShelleyBlock proto era) 'QFNoTables (RatifyState era)
GetRatifyState)
    , (String
"GetDRepDelegations", BlockQuery
  (ShelleyBlock proto era)
  'QFNoTables
  (Map DRep (Set (Credential Staking)))
-> SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
forall (q :: QueryFootprint -> * -> *)
       (footprint :: QueryFootprint) result.
SingI footprint =>
q footprint result -> SomeBlockQuery q
SomeBlockQuery (BlockQuery
   (ShelleyBlock proto era)
   'QFNoTables
   (Map DRep (Set (Credential Staking)))
 -> SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))
-> BlockQuery
     (ShelleyBlock proto era)
     'QFNoTables
     (Map DRep (Set (Credential Staking)))
-> SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
forall a b. (a -> b) -> a -> b
$ Set DRep
-> BlockQuery
     (ShelleyBlock proto era)
     'QFNoTables
     (Map DRep (Set (Credential Staking)))
forall era proto.
(ConwayEraGov era, ConwayEraCertState era) =>
Set DRep
-> BlockQuery
     (ShelleyBlock proto era)
     'QFNoTables
     (Map DRep (Set (Credential Staking)))
GetDRepDelegations Set DRep
forall a. Set a
Set.empty)
    ]
      [(String, SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))]
-> [(String, SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))]
-> [(String, SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))]
forall a. [a] -> [a] -> [a]
++ [ (String
"QueryStakePoolDefaultVote", BlockQuery (ShelleyBlock proto era) 'QFNoTables DefaultVote
-> SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
forall (q :: QueryFootprint -> * -> *)
       (footprint :: QueryFootprint) result.
SingI footprint =>
q footprint result -> SomeBlockQuery q
SomeBlockQuery (BlockQuery (ShelleyBlock proto era) 'QFNoTables DefaultVote
 -> SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))
-> BlockQuery (ShelleyBlock proto era) 'QFNoTables DefaultVote
-> SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
forall a b. (a -> b) -> a -> b
$ KeyHash StakePool
-> BlockQuery (ShelleyBlock proto era) 'QFNoTables DefaultVote
forall era proto.
ConwayEraGov era =>
KeyHash StakePool
-> BlockQuery (ShelleyBlock proto era) 'QFNoTables DefaultVote
QueryStakePoolDefaultVote KeyHash StakePool
poolId)
         | KeyHash StakePool
poolId <- Int -> [KeyHash StakePool] -> [KeyHash StakePool]
forall a. Int -> [a] -> [a]
take Int
1 [KeyHash StakePool]
poolIds
         ]

fromShelleyLedgerExamples ::
  forall era.
  ShelleyCompatible (TPraos StandardCrypto) era =>
  EraQueries (TPraos StandardCrypto) era ->
  ProtocolLedgerExamples (SL.BHeader StandardCrypto) era ->
  Examples (ShelleyBlock (TPraos StandardCrypto) era)
fromShelleyLedgerExamples :: forall era.
ShelleyCompatible (TPraos StandardCrypto) era =>
EraQueries (TPraos StandardCrypto) era
-> ProtocolLedgerExamples (BHeader StandardCrypto) era
-> Examples (ShelleyBlock (TPraos StandardCrypto) era)
fromShelleyLedgerExamples
  EraQueries (TPraos StandardCrypto) era
eraQueries
  ProtocolLedgerExamples
    { pleLedgerExamples :: forall bh era. ProtocolLedgerExamples bh era -> LedgerExamples era
pleLedgerExamples = Shelley.LedgerExamples{Map
  (Either Coin (Credential Staking)) (Map (KeyHash StakePool) Coin)
Set (Either Coin (Credential Staking))
Tx TopTx era
ApplyTxError era
PParams era
TranslationContext era
PoolDistr
ProposedPPUpdates era
ShelleyGenesis
NewEpochState era
leTx :: Tx TopTx era
leApplyTxError :: ApplyTxError era
lePParams :: PParams era
leProposedPPUpdates :: ProposedPPUpdates era
leNewEpochState :: NewEpochState era
lePoolDistr :: PoolDistr
leRewardsCredentials :: Set (Either Coin (Credential Staking))
leNonMyopicRewards :: Map
  (Either Coin (Credential Staking)) (Map (KeyHash StakePool) Coin)
leTranslationContext :: TranslationContext era
leShelleyGenesis :: ShelleyGenesis
leApplyTxError :: forall era. LedgerExamples era -> ApplyTxError era
leNewEpochState :: forall era. LedgerExamples era -> NewEpochState era
leNonMyopicRewards :: forall era.
LedgerExamples era
-> Map
     (Either Coin (Credential Staking)) (Map (KeyHash StakePool) Coin)
lePParams :: forall era. LedgerExamples era -> PParams era
lePoolDistr :: forall era. LedgerExamples era -> PoolDistr
leProposedPPUpdates :: forall era. LedgerExamples era -> ProposedPPUpdates era
leRewardsCredentials :: forall era.
LedgerExamples era -> Set (Either Coin (Credential Staking))
leShelleyGenesis :: forall era. LedgerExamples era -> ShelleyGenesis
leTranslationContext :: forall era. LedgerExamples era -> TranslationContext era
leTx :: forall era. LedgerExamples era -> Tx TopTx era
..}
    , HashHeader
Block (BHeader StandardCrypto) era
BHeader StandardCrypto
ChainDepState
pleHashHeader :: HashHeader
pleBlockHeader :: BHeader StandardCrypto
pleChainDepState :: ChainDepState
pleBlock :: Block (BHeader StandardCrypto) era
pleBlock :: forall bh era. ProtocolLedgerExamples bh era -> Block bh era
pleBlockHeader :: forall bh era. ProtocolLedgerExamples bh era -> bh
pleChainDepState :: forall bh era. ProtocolLedgerExamples bh era -> ChainDepState
pleHashHeader :: forall bh era. ProtocolLedgerExamples bh era -> HashHeader
..
    } =
    Examples
      { exampleBlock :: Labelled (ShelleyBlock (TPraos StandardCrypto) era)
exampleBlock = ShelleyBlock (TPraos StandardCrypto) era
-> Labelled (ShelleyBlock (TPraos StandardCrypto) era)
forall a. a -> Labelled a
unlabelled ShelleyBlock (TPraos StandardCrypto) era
blk
      , exampleSerialisedBlock :: Labelled (Serialised (ShelleyBlock (TPraos StandardCrypto) era))
exampleSerialisedBlock = Serialised (ShelleyBlock (TPraos StandardCrypto) era)
-> Labelled (Serialised (ShelleyBlock (TPraos StandardCrypto) era))
forall a. a -> Labelled a
unlabelled Serialised (ShelleyBlock (TPraos StandardCrypto) era)
serialisedBlock
      , exampleHeader :: Labelled (Header (ShelleyBlock (TPraos StandardCrypto) era))
exampleHeader = Header (ShelleyBlock (TPraos StandardCrypto) era)
-> Labelled (Header (ShelleyBlock (TPraos StandardCrypto) era))
forall a. a -> Labelled a
unlabelled (Header (ShelleyBlock (TPraos StandardCrypto) era)
 -> Labelled (Header (ShelleyBlock (TPraos StandardCrypto) era)))
-> Header (ShelleyBlock (TPraos StandardCrypto) era)
-> Labelled (Header (ShelleyBlock (TPraos StandardCrypto) era))
forall a b. (a -> b) -> a -> b
$ ShelleyBlock (TPraos StandardCrypto) era
-> Header (ShelleyBlock (TPraos StandardCrypto) era)
forall blk. GetHeader blk => blk -> Header blk
getHeader ShelleyBlock (TPraos StandardCrypto) era
blk
      , exampleSerialisedHeader :: Labelled
  (SerialisedHeader (ShelleyBlock (TPraos StandardCrypto) era))
exampleSerialisedHeader = SerialisedHeader (ShelleyBlock (TPraos StandardCrypto) era)
-> Labelled
     (SerialisedHeader (ShelleyBlock (TPraos StandardCrypto) era))
forall a. a -> Labelled a
unlabelled SerialisedHeader (ShelleyBlock (TPraos StandardCrypto) era)
serialisedHeader
      , exampleHeaderHash :: Labelled (HeaderHash (ShelleyBlock (TPraos StandardCrypto) era))
exampleHeaderHash = ShelleyHash -> Labelled ShelleyHash
forall a. a -> Labelled a
unlabelled ShelleyHash
hash
      , exampleGenTx :: Labelled (GenTx (ShelleyBlock (TPraos StandardCrypto) era))
exampleGenTx = GenTx (ShelleyBlock (TPraos StandardCrypto) era)
-> Labelled (GenTx (ShelleyBlock (TPraos StandardCrypto) era))
forall a. a -> Labelled a
unlabelled GenTx (ShelleyBlock (TPraos StandardCrypto) era)
forall {proto}. GenTx (ShelleyBlock proto era)
tx
      , exampleGenTxId :: Labelled (GenTxId (ShelleyBlock (TPraos StandardCrypto) era))
exampleGenTxId = GenTxId (ShelleyBlock (TPraos StandardCrypto) era)
-> Labelled (GenTxId (ShelleyBlock (TPraos StandardCrypto) era))
forall a. a -> Labelled a
unlabelled (GenTxId (ShelleyBlock (TPraos StandardCrypto) era)
 -> Labelled (GenTxId (ShelleyBlock (TPraos StandardCrypto) era)))
-> GenTxId (ShelleyBlock (TPraos StandardCrypto) era)
-> Labelled (GenTxId (ShelleyBlock (TPraos StandardCrypto) era))
forall a b. (a -> b) -> a -> b
$ GenTx (ShelleyBlock (TPraos StandardCrypto) era)
-> GenTxId (ShelleyBlock (TPraos StandardCrypto) era)
forall tx. HasTxId tx => tx -> TxId tx
txId GenTx (ShelleyBlock (TPraos StandardCrypto) era)
forall {proto}. GenTx (ShelleyBlock proto era)
tx
      , exampleApplyTxErr :: Labelled (ApplyTxErr (ShelleyBlock (TPraos StandardCrypto) era))
exampleApplyTxErr = ApplyTxError era -> Labelled (ApplyTxError era)
forall a. a -> Labelled a
unlabelled ApplyTxError era
leApplyTxError
      , exampleQuery :: Labelled
  (SomeBlockQuery
     (BlockQuery (ShelleyBlock (TPraos StandardCrypto) era)))
exampleQuery = Labelled
  (SomeBlockQuery
     (BlockQuery (ShelleyBlock (TPraos StandardCrypto) era)))
queries
      , exampleTopLevelQuery :: Labelled
  (SomeSecond Query (ShelleyBlock (TPraos StandardCrypto) era))
exampleTopLevelQuery = Labelled
  (SomeSecond Query (ShelleyBlock (TPraos StandardCrypto) era))
forall blk. Labelled (SomeSecond Query blk)
topLevelQueries
      , exampleResult :: Labelled (SomeResult (ShelleyBlock (TPraos StandardCrypto) era))
exampleResult = Labelled (SomeResult (ShelleyBlock (TPraos StandardCrypto) era))
results
      , exampleAnnTip :: Labelled (AnnTip (ShelleyBlock (TPraos StandardCrypto) era))
exampleAnnTip = AnnTip (ShelleyBlock (TPraos StandardCrypto) era)
-> Labelled (AnnTip (ShelleyBlock (TPraos StandardCrypto) era))
forall a. a -> Labelled a
unlabelled AnnTip (ShelleyBlock (TPraos StandardCrypto) era)
annTip
      , exampleLedgerState :: Labelled
  (LedgerState (ShelleyBlock (TPraos StandardCrypto) era) EmptyMK)
exampleLedgerState = LedgerState (ShelleyBlock (TPraos StandardCrypto) era) EmptyMK
-> Labelled
     (LedgerState (ShelleyBlock (TPraos StandardCrypto) era) EmptyMK)
forall a. a -> Labelled a
unlabelled LedgerState (ShelleyBlock (TPraos StandardCrypto) era) EmptyMK
forall {proto}. LedgerState (ShelleyBlock proto era) EmptyMK
ledgerState
      , exampleChainDepState :: Labelled
  (ChainDepState
     (BlockProtocol (ShelleyBlock (TPraos StandardCrypto) era)))
exampleChainDepState = TPraosState -> Labelled TPraosState
forall a. a -> Labelled a
unlabelled TPraosState
chainDepState
      , exampleExtLedgerState :: Labelled
  (ExtLedgerState (ShelleyBlock (TPraos StandardCrypto) era) EmptyMK)
exampleExtLedgerState = ExtLedgerState (ShelleyBlock (TPraos StandardCrypto) era) EmptyMK
-> Labelled
     (ExtLedgerState (ShelleyBlock (TPraos StandardCrypto) era) EmptyMK)
forall a. a -> Labelled a
unlabelled ExtLedgerState (ShelleyBlock (TPraos StandardCrypto) era) EmptyMK
extLedgerState
      , exampleSlotNo :: Labelled SlotNo
exampleSlotNo = SlotNo -> Labelled SlotNo
forall a. a -> Labelled a
unlabelled SlotNo
slotNo
      , exampleLedgerConfig :: Labelled (LedgerConfig (ShelleyBlock (TPraos StandardCrypto) era))
exampleLedgerConfig = ShelleyLedgerConfig era -> Labelled (ShelleyLedgerConfig era)
forall a. a -> Labelled a
unlabelled ShelleyLedgerConfig era
ledgerConfig
      }
   where
    ccfg :: CodecConfig (ShelleyBlock (TPraos StandardCrypto) era)
    ccfg :: CodecConfig (ShelleyBlock (TPraos StandardCrypto) era)
ccfg = CodecConfig (ShelleyBlock (TPraos StandardCrypto) era)
forall proto era. CodecConfig (ShelleyBlock proto era)
ShelleyCodecConfig
    emptyTx :: Tx TopTx era
emptyTx = TxBody TopTx era -> Tx TopTx era
forall era (l :: TxLevel). EraTx era => TxBody l era -> Tx l era
forall (l :: TxLevel). TxBody l era -> Tx l era
mkBasicTx TxBody TopTx era
forall era (l :: TxLevel).
(EraTxBody era, Typeable l) =>
TxBody l era
forall (l :: TxLevel). Typeable l => TxBody l era
mkBasicTxBody
    blk :: ShelleyBlock (TPraos StandardCrypto) era
blk = Block (ShelleyProtocolHeader (TPraos StandardCrypto)) era
-> ShelleyBlock (TPraos StandardCrypto) era
forall proto era.
ShelleyCompatible proto era =>
Block (ShelleyProtocolHeader proto) era -> ShelleyBlock proto era
mkShelleyBlock Block (BHeader StandardCrypto) era
Block (ShelleyProtocolHeader (TPraos StandardCrypto)) era
pleBlock
    hash :: ShelleyHash
hash = Hash Blake2b_256 EraIndependentBlockHeader -> ShelleyHash
ShelleyHash (Hash Blake2b_256 EraIndependentBlockHeader -> ShelleyHash)
-> Hash Blake2b_256 EraIndependentBlockHeader -> ShelleyHash
forall a b. (a -> b) -> a -> b
$ HashHeader -> Hash Blake2b_256 EraIndependentBlockHeader
SL.unHashHeader HashHeader
pleHashHeader
    serialisedBlock :: Serialised (ShelleyBlock (TPraos StandardCrypto) era)
serialisedBlock = (ShelleyBlock (TPraos StandardCrypto) era -> Encoding)
-> ShelleyBlock (TPraos StandardCrypto) era
-> Serialised (ShelleyBlock (TPraos StandardCrypto) era)
forall a. (a -> Encoding) -> a -> Serialised a
mkSerialised (CodecConfig (ShelleyBlock (TPraos StandardCrypto) era)
-> ShelleyBlock (TPraos StandardCrypto) era -> Encoding
forall blk a. EncodeDisk blk a => CodecConfig blk -> a -> Encoding
encodeDisk CodecConfig (ShelleyBlock (TPraos StandardCrypto) era)
ccfg) ShelleyBlock (TPraos StandardCrypto) era
blk
    tx :: GenTx (ShelleyBlock proto era)
tx = Tx TopTx era -> GenTx (ShelleyBlock proto era)
forall era proto.
ShelleyBasedEra era =>
Tx TopTx era -> GenTx (ShelleyBlock proto era)
mkShelleyTx Tx TopTx era
emptyTx
    slotNo :: SlotNo
slotNo = Word64 -> SlotNo
SlotNo Word64
42
    serialisedHeader :: SerialisedHeader (ShelleyBlock (TPraos StandardCrypto) era)
serialisedHeader =
      GenDepPair
  Serialised
  (NestedCtxt Header (ShelleyBlock (TPraos StandardCrypto) era))
-> SerialisedHeader (ShelleyBlock (TPraos StandardCrypto) era)
forall blk.
GenDepPair Serialised (NestedCtxt Header blk)
-> SerialisedHeader blk
SerialisedHeaderFromDepPair (GenDepPair
   Serialised
   (NestedCtxt Header (ShelleyBlock (TPraos StandardCrypto) era))
 -> SerialisedHeader (ShelleyBlock (TPraos StandardCrypto) era))
-> GenDepPair
     Serialised
     (NestedCtxt Header (ShelleyBlock (TPraos StandardCrypto) era))
-> SerialisedHeader (ShelleyBlock (TPraos StandardCrypto) era)
forall a b. (a -> b) -> a -> b
$ CodecConfig (ShelleyBlock (TPraos StandardCrypto) era)
-> DepPair
     (NestedCtxt Header (ShelleyBlock (TPraos StandardCrypto) era))
-> GenDepPair
     Serialised
     (NestedCtxt Header (ShelleyBlock (TPraos StandardCrypto) era))
forall (f :: MapKind) blk.
EncodeDiskDep f blk =>
CodecConfig blk -> DepPair (f blk) -> GenDepPair Serialised (f blk)
encodeDepPair CodecConfig (ShelleyBlock (TPraos StandardCrypto) era)
ccfg (Header (ShelleyBlock (TPraos StandardCrypto) era)
-> DepPair
     (NestedCtxt Header (ShelleyBlock (TPraos StandardCrypto) era))
forall (f :: * -> *) blk.
HasNestedContent f blk =>
f blk -> DepPair (NestedCtxt f blk)
unnest (ShelleyBlock (TPraos StandardCrypto) era
-> Header (ShelleyBlock (TPraos StandardCrypto) era)
forall blk. GetHeader blk => blk -> Header blk
getHeader ShelleyBlock (TPraos StandardCrypto) era
blk))
    queries :: Labelled
  (SomeBlockQuery
     (BlockQuery (ShelleyBlock (TPraos StandardCrypto) era)))
queries =
      Set (Either Coin (Credential Staking))
-> Labelled
     (SomeBlockQuery
        (BlockQuery (ShelleyBlock (TPraos StandardCrypto) era)))
forall era proto.
EraGov era =>
Set (Either Coin (Credential Staking))
-> Labelled (SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))
eraIndependentQueries Set (Either Coin (Credential Staking))
leRewardsCredentials
        Labelled
  (SomeBlockQuery
     (BlockQuery (ShelleyBlock (TPraos StandardCrypto) era)))
-> Labelled
     (SomeBlockQuery
        (BlockQuery (ShelleyBlock (TPraos StandardCrypto) era)))
-> Labelled
     (SomeBlockQuery
        (BlockQuery (ShelleyBlock (TPraos StandardCrypto) era)))
forall a. Semigroup a => a -> a -> a
<> EraQueries (TPraos StandardCrypto) era
eraQueries (Map (KeyHash StakePool) IndividualPoolStake -> [KeyHash StakePool]
forall k a. Map k a -> [k]
Map.keys (PoolDistr -> Map (KeyHash StakePool) IndividualPoolStake
unPoolDistr PoolDistr
lePoolDistr))
    results :: Labelled (SomeResult (ShelleyBlock (TPraos StandardCrypto) era))
results =
      [(String, SomeResult (ShelleyBlock (TPraos StandardCrypto) era))]
-> Labelled (SomeResult (ShelleyBlock (TPraos StandardCrypto) era))
forall a. [(String, a)] -> Labelled a
labelled
        [ (String
"LedgerTip", BlockQuery
  (ShelleyBlock (TPraos StandardCrypto) era)
  'QFNoTables
  (Point (ShelleyBlock (TPraos StandardCrypto) era))
-> Point (ShelleyBlock (TPraos StandardCrypto) era)
-> SomeResult (ShelleyBlock (TPraos StandardCrypto) era)
forall result blk (fp :: QueryFootprint).
(Eq result, Show result, Typeable result) =>
BlockQuery blk fp result -> result -> SomeResult blk
SomeResult BlockQuery
  (ShelleyBlock (TPraos StandardCrypto) era)
  'QFNoTables
  (Point (ShelleyBlock (TPraos StandardCrypto) era))
forall proto era.
BlockQuery
  (ShelleyBlock proto era)
  'QFNoTables
  (Point (ShelleyBlock proto era))
GetLedgerTip (ShelleyBlock (TPraos StandardCrypto) era
-> Point (ShelleyBlock (TPraos StandardCrypto) era)
forall block. HasHeader block => block -> Point block
blockPoint ShelleyBlock (TPraos StandardCrypto) era
blk))
        , (String
"GenesisConfig", BlockQuery
  (ShelleyBlock (TPraos StandardCrypto) era)
  'QFNoTables
  CompactGenesis
-> CompactGenesis
-> SomeResult (ShelleyBlock (TPraos StandardCrypto) era)
forall result blk (fp :: QueryFootprint).
(Eq result, Show result, Typeable result) =>
BlockQuery blk fp result -> result -> SomeResult blk
SomeResult BlockQuery
  (ShelleyBlock (TPraos StandardCrypto) era)
  'QFNoTables
  CompactGenesis
forall proto era.
BlockQuery (ShelleyBlock proto era) 'QFNoTables CompactGenesis
GetGenesisConfig (ShelleyGenesis -> CompactGenesis
compactGenesis ShelleyGenesis
leShelleyGenesis))
        ,
          ( String
"GetBigLedgerPeerSnapshot"
          , BlockQuery
  (ShelleyBlock (TPraos StandardCrypto) era)
  'QFNoTables
  (LedgerPeerSnapshot BigLedgerPeers)
-> LedgerPeerSnapshot BigLedgerPeers
-> SomeResult (ShelleyBlock (TPraos StandardCrypto) era)
forall result blk (fp :: QueryFootprint).
(Eq result, Show result, Typeable result) =>
BlockQuery blk fp result -> result -> SomeResult blk
SomeResult
              (SingLedgerPeersKind BigLedgerPeers
-> BlockQuery
     (ShelleyBlock (TPraos StandardCrypto) era)
     'QFNoTables
     (LedgerPeerSnapshot BigLedgerPeers)
forall proto era (ledgerPeersKind :: LedgerPeersKind).
SingLedgerPeersKind ledgerPeersKind
-> BlockQuery
     (ShelleyBlock proto era)
     'QFNoTables
     (LedgerPeerSnapshot ledgerPeersKind)
GetLedgerPeerSnapshot SingLedgerPeersKind BigLedgerPeers
SingBigLedgerPeers)
              ( Point RawBlockHash
-> NetworkMagic
-> [(AccPoolStake, (PoolStake, NonEmpty LedgerRelayAccessPoint))]
-> LedgerPeerSnapshot BigLedgerPeers
LedgerBigPeerSnapshotV23
                  (SlotNo -> HeaderHash RawBlockHash -> Point RawBlockHash
forall {k} (block :: k). SlotNo -> HeaderHash block -> Point block
BlockPoint SlotNo
slotNo (ShortByteString -> RawBlockHash
RawBlockHash ShortByteString
"<BLOCK HASH, padded to 32 bytes>"))
                  (Word32 -> NetworkMagic
NetworkMagic Word32
42)
                  [
                    ( Ratio Integer -> AccPoolStake
AccPoolStake Ratio Integer
0.9
                    ,
                      ( Ratio Integer -> PoolStake
PoolStake Ratio Integer
0.9
                      , IP -> PortNumber -> LedgerRelayAccessPoint
LedgerRelayAccessAddress (IPv4 -> IP
IPv4 IPv4
"1.1.1.1") PortNumber
1234 LedgerRelayAccessPoint
-> [LedgerRelayAccessPoint] -> NonEmpty LedgerRelayAccessPoint
forall a. a -> [a] -> NonEmpty a
:| []
                      )
                    )
                  ]
              )
          )
        ,
          ( String
"GetAllLedgerPeerSnapshot"
          , BlockQuery
  (ShelleyBlock (TPraos StandardCrypto) era)
  'QFNoTables
  (LedgerPeerSnapshot AllLedgerPeers)
-> LedgerPeerSnapshot AllLedgerPeers
-> SomeResult (ShelleyBlock (TPraos StandardCrypto) era)
forall result blk (fp :: QueryFootprint).
(Eq result, Show result, Typeable result) =>
BlockQuery blk fp result -> result -> SomeResult blk
SomeResult
              (SingLedgerPeersKind AllLedgerPeers
-> BlockQuery
     (ShelleyBlock (TPraos StandardCrypto) era)
     'QFNoTables
     (LedgerPeerSnapshot AllLedgerPeers)
forall proto era (ledgerPeersKind :: LedgerPeersKind).
SingLedgerPeersKind ledgerPeersKind
-> BlockQuery
     (ShelleyBlock proto era)
     'QFNoTables
     (LedgerPeerSnapshot ledgerPeersKind)
GetLedgerPeerSnapshot SingLedgerPeersKind AllLedgerPeers
SingAllLedgerPeers)
              ( Point RawBlockHash
-> NetworkMagic
-> [(PoolStake, NonEmpty LedgerRelayAccessPoint)]
-> LedgerPeerSnapshot AllLedgerPeers
LedgerAllPeerSnapshotV23
                  (SlotNo -> HeaderHash RawBlockHash -> Point RawBlockHash
forall {k} (block :: k). SlotNo -> HeaderHash block -> Point block
BlockPoint SlotNo
slotNo (ShortByteString -> RawBlockHash
RawBlockHash ShortByteString
"<BLOCK HASH, padded to 32 bytes>"))
                  (Word32 -> NetworkMagic
NetworkMagic Word32
42)
                  [
                    ( Ratio Integer -> PoolStake
PoolStake Ratio Integer
0.9
                    , IP -> PortNumber -> LedgerRelayAccessPoint
LedgerRelayAccessAddress (IPv4 -> IP
IPv4 IPv4
"1.1.1.1") PortNumber
1234 LedgerRelayAccessPoint
-> [LedgerRelayAccessPoint] -> NonEmpty LedgerRelayAccessPoint
forall a. a -> [a] -> NonEmpty a
:| []
                    )
                  ]
              )
          )
        ,
          ( String
"GetBigLedgerPeerSnapshotAtOrigin"
          , BlockQuery
  (ShelleyBlock (TPraos StandardCrypto) era)
  'QFNoTables
  (LedgerPeerSnapshot BigLedgerPeers)
-> LedgerPeerSnapshot BigLedgerPeers
-> SomeResult (ShelleyBlock (TPraos StandardCrypto) era)
forall result blk (fp :: QueryFootprint).
(Eq result, Show result, Typeable result) =>
BlockQuery blk fp result -> result -> SomeResult blk
SomeResult
              (SingLedgerPeersKind BigLedgerPeers
-> BlockQuery
     (ShelleyBlock (TPraos StandardCrypto) era)
     'QFNoTables
     (LedgerPeerSnapshot BigLedgerPeers)
forall proto era (ledgerPeersKind :: LedgerPeersKind).
SingLedgerPeersKind ledgerPeersKind
-> BlockQuery
     (ShelleyBlock proto era)
     'QFNoTables
     (LedgerPeerSnapshot ledgerPeersKind)
GetLedgerPeerSnapshot SingLedgerPeersKind BigLedgerPeers
SingBigLedgerPeers)
              (Point RawBlockHash
-> NetworkMagic
-> [(AccPoolStake, (PoolStake, NonEmpty LedgerRelayAccessPoint))]
-> LedgerPeerSnapshot BigLedgerPeers
LedgerBigPeerSnapshotV23 Point RawBlockHash
forall {k} (block :: k). Point block
GenesisPoint (Word32 -> NetworkMagic
NetworkMagic Word32
42) [])
          )
        ,
          ( String
"MaxMajorProtocolVersion"
          , BlockQuery
  (ShelleyBlock (TPraos StandardCrypto) era)
  'QFNoTables
  MaxMajorProtVer
-> MaxMajorProtVer
-> SomeResult (ShelleyBlock (TPraos StandardCrypto) era)
forall result blk (fp :: QueryFootprint).
(Eq result, Show result, Typeable result) =>
BlockQuery blk fp result -> result -> SomeResult blk
SomeResult BlockQuery
  (ShelleyBlock (TPraos StandardCrypto) era)
  'QFNoTables
  MaxMajorProtVer
forall proto era.
BlockQuery (ShelleyBlock proto era) 'QFNoTables MaxMajorProtVer
GetMaxMajorProtocolVersion (MaxMajorProtVer
 -> SomeResult (ShelleyBlock (TPraos StandardCrypto) era))
-> MaxMajorProtVer
-> SomeResult (ShelleyBlock (TPraos StandardCrypto) era)
forall a b. (a -> b) -> a -> b
$ Version -> MaxMajorProtVer
MaxMajorProtVer (forall a. Bounded a => a
maxBound @SL.Version)
          )
        ]
    annTip :: AnnTip (ShelleyBlock (TPraos StandardCrypto) era)
annTip =
      AnnTip
        { annTipSlotNo :: SlotNo
annTipSlotNo = Word64 -> SlotNo
SlotNo Word64
14
        , annTipBlockNo :: BlockNo
annTipBlockNo = Word64 -> BlockNo
BlockNo Word64
6
        , annTipInfo :: TipInfo (ShelleyBlock (TPraos StandardCrypto) era)
annTipInfo = TipInfo (ShelleyBlock (TPraos StandardCrypto) era)
ShelleyHash
hash
        }
    ledgerState :: LedgerState (ShelleyBlock proto era) EmptyMK
ledgerState =
      ShelleyLedgerState
        { shelleyLedgerTip :: WithOrigin (ShelleyTip proto era)
shelleyLedgerTip =
            ShelleyTip proto era -> WithOrigin (ShelleyTip proto era)
forall t. t -> WithOrigin t
NotOrigin
              ShelleyTip
                { shelleyTipSlotNo :: SlotNo
shelleyTipSlotNo = Word64 -> SlotNo
SlotNo Word64
9
                , shelleyTipBlockNo :: BlockNo
shelleyTipBlockNo = Word64 -> BlockNo
BlockNo Word64
3
                , shelleyTipHash :: HeaderHash (ShelleyBlock proto era)
shelleyTipHash = HeaderHash (ShelleyBlock proto era)
ShelleyHash
hash
                }
        , shelleyLedgerState :: NewEpochState era
shelleyLedgerState = NewEpochState era
leNewEpochState
        , shelleyLedgerTransition :: ShelleyTransition
shelleyLedgerTransition = ShelleyTransitionInfo{shelleyAfterVoting :: Word32
shelleyAfterVoting = Word32
0}
        , shelleyLedgerTables :: LedgerTables (ShelleyBlock proto era) EmptyMK
shelleyLedgerTables = EmptyMK
  (TxIn (ShelleyBlock proto era)) (TxOut (ShelleyBlock proto era))
-> LedgerTables (ShelleyBlock proto era) EmptyMK
forall blk (mk :: MapKind).
mk (TxIn blk) (TxOut blk) -> LedgerTables blk mk
LedgerTables EmptyMK
  (TxIn (ShelleyBlock proto era)) (TxOut (ShelleyBlock proto era))
EmptyMK BigEndianTxIn (TxOut era)
forall k v. EmptyMK k v
EmptyMK
        }
    chainDepState :: TPraosState
chainDepState = WithOrigin SlotNo -> ChainDepState -> TPraosState
TPraosState (SlotNo -> WithOrigin SlotNo
forall t. t -> WithOrigin t
NotOrigin SlotNo
1) ChainDepState
pleChainDepState
    extLedgerState :: ExtLedgerState (ShelleyBlock (TPraos StandardCrypto) era) EmptyMK
extLedgerState =
      let headerState :: HeaderState (ShelleyBlock (TPraos StandardCrypto) era)
headerState = ChainDepState
  (BlockProtocol (ShelleyBlock (TPraos StandardCrypto) era))
-> HeaderState (ShelleyBlock (TPraos StandardCrypto) era)
forall blk. ChainDepState (BlockProtocol blk) -> HeaderState blk
genesisHeaderState ChainDepState
  (BlockProtocol (ShelleyBlock (TPraos StandardCrypto) era))
TPraosState
chainDepState
          perasState :: PerasState (ShelleyBlock (TPraos StandardCrypto) era)
perasState = LedgerConfig (ShelleyBlock (TPraos StandardCrypto) era)
-> LedgerState (ShelleyBlock (TPraos StandardCrypto) era) EmptyMK
-> HeaderState (ShelleyBlock (TPraos StandardCrypto) era)
-> PerasState (ShelleyBlock (TPraos StandardCrypto) era)
forall blk (mk :: MapKind).
(All Top (HardForkIndices blk), StateSupportsPerasEpochContext blk,
 HasLedgerTables LedgerState blk) =>
LedgerCfg LedgerState blk
-> LedgerState blk mk -> HeaderState blk -> PerasState blk
initPerasState LedgerConfig (ShelleyBlock (TPraos StandardCrypto) era)
ShelleyLedgerConfig era
ledgerConfig LedgerState (ShelleyBlock (TPraos StandardCrypto) era) EmptyMK
forall {proto}. LedgerState (ShelleyBlock proto era) EmptyMK
ledgerState HeaderState (ShelleyBlock (TPraos StandardCrypto) era)
headerState
       in ExtLedgerState
            { LedgerState (ShelleyBlock (TPraos StandardCrypto) era) EmptyMK
forall {proto}. LedgerState (ShelleyBlock proto era) EmptyMK
ledgerState :: forall {proto}. LedgerState (ShelleyBlock proto era) EmptyMK
ledgerState :: LedgerState (ShelleyBlock (TPraos StandardCrypto) era) EmptyMK
ledgerState
            , HeaderState (ShelleyBlock (TPraos StandardCrypto) era)
headerState :: HeaderState (ShelleyBlock (TPraos StandardCrypto) era)
headerState :: HeaderState (ShelleyBlock (TPraos StandardCrypto) era)
headerState
            , PerasState (ShelleyBlock (TPraos StandardCrypto) era)
perasState :: PerasState (ShelleyBlock (TPraos StandardCrypto) era)
perasState :: PerasState (ShelleyBlock (TPraos StandardCrypto) era)
perasState
            }

    ledgerConfig :: ShelleyLedgerConfig era
ledgerConfig = TranslationContext era -> ShelleyLedgerConfig era
forall era. TranslationContext era -> ShelleyLedgerConfig era
exampleShelleyLedgerConfig TranslationContext era
leTranslationContext

fromShelleyLedgerExamplesPraos ::
  ShelleyCompatible (Praos StandardCrypto) era =>
  EraQueries (Praos StandardCrypto) era ->
  ProtocolLedgerExamples (SL.BHeader StandardCrypto) era ->
  Examples (ShelleyBlock (Praos StandardCrypto) era)
fromShelleyLedgerExamplesPraos :: forall era.
ShelleyCompatible (Praos StandardCrypto) era =>
EraQueries (Praos StandardCrypto) era
-> ProtocolLedgerExamples (BHeader StandardCrypto) era
-> Examples (ShelleyBlock (Praos StandardCrypto) era)
fromShelleyLedgerExamplesPraos = (BHeader StandardCrypto
 -> ShelleyProtocolHeader (Praos StandardCrypto))
-> EraQueries (Praos StandardCrypto) era
-> ProtocolLedgerExamples (BHeader StandardCrypto) era
-> Examples (ShelleyBlock (Praos StandardCrypto) era)
forall proto era.
(ShelleyCompatible proto era,
 TranslateProto (TPraos StandardCrypto) proto era) =>
(BHeader StandardCrypto -> ShelleyProtocolHeader proto)
-> EraQueries proto era
-> ProtocolLedgerExamples (BHeader StandardCrypto) era
-> Examples (ShelleyBlock proto era)
fromShelleyLedgerExamplesPolyPraos BHeader StandardCrypto -> Header StandardCrypto
BHeader StandardCrypto
-> ShelleyProtocolHeader (Praos StandardCrypto)
translatePraosHeader

-- | TODO Factor this out into something nicer.
fromShelleyLedgerExamplesPolyPraos ::
  forall proto era.
  ( ShelleyCompatible proto era
  , TranslateProto (TPraos StandardCrypto) proto era
  ) =>
  -- | Rebuild the example's TPraos header as this protocol's header
  (SL.BHeader StandardCrypto -> ShelleyProtocolHeader proto) ->
  EraQueries proto era ->
  ProtocolLedgerExamples (SL.BHeader StandardCrypto) era ->
  Examples (ShelleyBlock proto era)
fromShelleyLedgerExamplesPolyPraos :: forall proto era.
(ShelleyCompatible proto era,
 TranslateProto (TPraos StandardCrypto) proto era) =>
(BHeader StandardCrypto -> ShelleyProtocolHeader proto)
-> EraQueries proto era
-> ProtocolLedgerExamples (BHeader StandardCrypto) era
-> Examples (ShelleyBlock proto era)
fromShelleyLedgerExamplesPolyPraos
  BHeader StandardCrypto -> ShelleyProtocolHeader proto
translateHeader
  EraQueries proto era
eraQueries
  ProtocolLedgerExamples
    { pleLedgerExamples :: forall bh era. ProtocolLedgerExamples bh era -> LedgerExamples era
pleLedgerExamples = Shelley.LedgerExamples{Map
  (Either Coin (Credential Staking)) (Map (KeyHash StakePool) Coin)
Set (Either Coin (Credential Staking))
Tx TopTx era
ApplyTxError era
PParams era
TranslationContext era
PoolDistr
ProposedPPUpdates era
ShelleyGenesis
NewEpochState era
leApplyTxError :: forall era. LedgerExamples era -> ApplyTxError era
leNewEpochState :: forall era. LedgerExamples era -> NewEpochState era
leNonMyopicRewards :: forall era.
LedgerExamples era
-> Map
     (Either Coin (Credential Staking)) (Map (KeyHash StakePool) Coin)
lePParams :: forall era. LedgerExamples era -> PParams era
lePoolDistr :: forall era. LedgerExamples era -> PoolDistr
leProposedPPUpdates :: forall era. LedgerExamples era -> ProposedPPUpdates era
leRewardsCredentials :: forall era.
LedgerExamples era -> Set (Either Coin (Credential Staking))
leShelleyGenesis :: forall era. LedgerExamples era -> ShelleyGenesis
leTranslationContext :: forall era. LedgerExamples era -> TranslationContext era
leTx :: forall era. LedgerExamples era -> Tx TopTx era
leTx :: Tx TopTx era
leApplyTxError :: ApplyTxError era
lePParams :: PParams era
leProposedPPUpdates :: ProposedPPUpdates era
leNewEpochState :: NewEpochState era
lePoolDistr :: PoolDistr
leRewardsCredentials :: Set (Either Coin (Credential Staking))
leNonMyopicRewards :: Map
  (Either Coin (Credential Staking)) (Map (KeyHash StakePool) Coin)
leTranslationContext :: TranslationContext era
leShelleyGenesis :: ShelleyGenesis
..}
    , HashHeader
Block (BHeader StandardCrypto) era
BHeader StandardCrypto
ChainDepState
pleBlock :: forall bh era. ProtocolLedgerExamples bh era -> Block bh era
pleBlockHeader :: forall bh era. ProtocolLedgerExamples bh era -> bh
pleChainDepState :: forall bh era. ProtocolLedgerExamples bh era -> ChainDepState
pleHashHeader :: forall bh era. ProtocolLedgerExamples bh era -> HashHeader
pleHashHeader :: HashHeader
pleBlockHeader :: BHeader StandardCrypto
pleChainDepState :: ChainDepState
pleBlock :: Block (BHeader StandardCrypto) era
..
    } =
    Examples
      { exampleBlock :: Labelled (ShelleyBlock proto era)
exampleBlock = ShelleyBlock proto era -> Labelled (ShelleyBlock proto era)
forall a. a -> Labelled a
unlabelled ShelleyBlock proto era
blk
      , exampleSerialisedBlock :: Labelled (Serialised (ShelleyBlock proto era))
exampleSerialisedBlock = Serialised (ShelleyBlock proto era)
-> Labelled (Serialised (ShelleyBlock proto era))
forall a. a -> Labelled a
unlabelled Serialised (ShelleyBlock proto era)
serialisedBlock
      , exampleHeader :: Labelled (Header (ShelleyBlock proto era))
exampleHeader = Header (ShelleyBlock proto era)
-> Labelled (Header (ShelleyBlock proto era))
forall a. a -> Labelled a
unlabelled (Header (ShelleyBlock proto era)
 -> Labelled (Header (ShelleyBlock proto era)))
-> Header (ShelleyBlock proto era)
-> Labelled (Header (ShelleyBlock proto era))
forall a b. (a -> b) -> a -> b
$ ShelleyBlock proto era -> Header (ShelleyBlock proto era)
forall blk. GetHeader blk => blk -> Header blk
getHeader ShelleyBlock proto era
blk
      , exampleSerialisedHeader :: Labelled (SerialisedHeader (ShelleyBlock proto era))
exampleSerialisedHeader = SerialisedHeader (ShelleyBlock proto era)
-> Labelled (SerialisedHeader (ShelleyBlock proto era))
forall a. a -> Labelled a
unlabelled SerialisedHeader (ShelleyBlock proto era)
serialisedHeader
      , exampleHeaderHash :: Labelled (HeaderHash (ShelleyBlock proto era))
exampleHeaderHash = ShelleyHash -> Labelled ShelleyHash
forall a. a -> Labelled a
unlabelled ShelleyHash
hash
      , exampleGenTx :: Labelled (GenTx (ShelleyBlock proto era))
exampleGenTx = GenTx (ShelleyBlock proto era)
-> Labelled (GenTx (ShelleyBlock proto era))
forall a. a -> Labelled a
unlabelled GenTx (ShelleyBlock proto era)
forall {proto}. GenTx (ShelleyBlock proto era)
tx
      , exampleGenTxId :: Labelled (GenTxId (ShelleyBlock proto era))
exampleGenTxId = GenTxId (ShelleyBlock proto era)
-> Labelled (GenTxId (ShelleyBlock proto era))
forall a. a -> Labelled a
unlabelled (GenTxId (ShelleyBlock proto era)
 -> Labelled (GenTxId (ShelleyBlock proto era)))
-> GenTxId (ShelleyBlock proto era)
-> Labelled (GenTxId (ShelleyBlock proto era))
forall a b. (a -> b) -> a -> b
$ GenTx (ShelleyBlock proto era) -> GenTxId (ShelleyBlock proto era)
forall tx. HasTxId tx => tx -> TxId tx
txId GenTx (ShelleyBlock proto era)
forall {proto}. GenTx (ShelleyBlock proto era)
tx
      , exampleApplyTxErr :: Labelled (ApplyTxErr (ShelleyBlock proto era))
exampleApplyTxErr = ApplyTxError era -> Labelled (ApplyTxError era)
forall a. a -> Labelled a
unlabelled ApplyTxError era
leApplyTxError
      , exampleQuery :: Labelled (SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))
exampleQuery = Labelled (SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))
queries
      , exampleTopLevelQuery :: Labelled (SomeSecond Query (ShelleyBlock proto era))
exampleTopLevelQuery = Labelled (SomeSecond Query (ShelleyBlock proto era))
forall blk. Labelled (SomeSecond Query blk)
topLevelQueries
      , exampleResult :: Labelled (SomeResult (ShelleyBlock proto era))
exampleResult = Labelled (SomeResult (ShelleyBlock proto era))
results
      , exampleAnnTip :: Labelled (AnnTip (ShelleyBlock proto era))
exampleAnnTip = AnnTip (ShelleyBlock proto era)
-> Labelled (AnnTip (ShelleyBlock proto era))
forall a. a -> Labelled a
unlabelled AnnTip (ShelleyBlock proto era)
annTip
      , exampleLedgerState :: Labelled (LedgerState (ShelleyBlock proto era) EmptyMK)
exampleLedgerState = LedgerState (ShelleyBlock proto era) EmptyMK
-> Labelled (LedgerState (ShelleyBlock proto era) EmptyMK)
forall a. a -> Labelled a
unlabelled LedgerState (ShelleyBlock proto era) EmptyMK
forall {proto}. LedgerState (ShelleyBlock proto era) EmptyMK
ledgerState
      , exampleChainDepState :: Labelled (ChainDepState (BlockProtocol (ShelleyBlock proto era)))
exampleChainDepState = ChainDepState proto -> Labelled (ChainDepState proto)
forall a. a -> Labelled a
unlabelled ChainDepState proto
chainDepState
      , exampleExtLedgerState :: Labelled (ExtLedgerState (ShelleyBlock proto era) EmptyMK)
exampleExtLedgerState = ExtLedgerState (ShelleyBlock proto era) EmptyMK
-> Labelled (ExtLedgerState (ShelleyBlock proto era) EmptyMK)
forall a. a -> Labelled a
unlabelled ExtLedgerState (ShelleyBlock proto era) EmptyMK
extLedgerState
      , exampleSlotNo :: Labelled SlotNo
exampleSlotNo = SlotNo -> Labelled SlotNo
forall a. a -> Labelled a
unlabelled SlotNo
slotNo
      , exampleLedgerConfig :: Labelled (LedgerConfig (ShelleyBlock proto era))
exampleLedgerConfig = ShelleyLedgerConfig era -> Labelled (ShelleyLedgerConfig era)
forall a. a -> Labelled a
unlabelled ShelleyLedgerConfig era
ledgerConfig
      }
   where
    ccfg :: CodecConfig (ShelleyBlock proto era)
    ccfg :: CodecConfig (ShelleyBlock proto era)
ccfg = CodecConfig (ShelleyBlock proto era)
forall proto era. CodecConfig (ShelleyBlock proto era)
ShelleyCodecConfig
    emptyTx :: Tx TopTx era
emptyTx = TxBody TopTx era -> Tx TopTx era
forall era (l :: TxLevel). EraTx era => TxBody l era -> Tx l era
forall (l :: TxLevel). TxBody l era -> Tx l era
mkBasicTx TxBody TopTx era
forall era (l :: TxLevel).
(EraTxBody era, Typeable l) =>
TxBody l era
forall (l :: TxLevel). Typeable l => TxBody l era
mkBasicTxBody
    blk :: ShelleyBlock proto era
blk =
      Block (ShelleyProtocolHeader proto) era -> ShelleyBlock proto era
forall proto era.
ShelleyCompatible proto era =>
Block (ShelleyProtocolHeader proto) era -> ShelleyBlock proto era
mkShelleyBlock (Block (ShelleyProtocolHeader proto) era -> ShelleyBlock proto era)
-> Block (ShelleyProtocolHeader proto) era
-> ShelleyBlock proto era
forall a b. (a -> b) -> a -> b
$
        let SL.Block BHeader StandardCrypto
hdr1 BlockBody era
bdy = Block (BHeader StandardCrypto) era
pleBlock
         in ShelleyProtocolHeader proto
-> BlockBody era -> Block (ShelleyProtocolHeader proto) era
forall h era. h -> BlockBody era -> Block h era
SL.Block (BHeader StandardCrypto -> ShelleyProtocolHeader proto
translateHeader BHeader StandardCrypto
hdr1) BlockBody era
bdy

    hash :: ShelleyHash
hash = Hash Blake2b_256 EraIndependentBlockHeader -> ShelleyHash
ShelleyHash (Hash Blake2b_256 EraIndependentBlockHeader -> ShelleyHash)
-> Hash Blake2b_256 EraIndependentBlockHeader -> ShelleyHash
forall a b. (a -> b) -> a -> b
$ HashHeader -> Hash Blake2b_256 EraIndependentBlockHeader
SL.unHashHeader HashHeader
pleHashHeader
    serialisedBlock :: Serialised (ShelleyBlock proto era)
serialisedBlock = (ShelleyBlock proto era -> Encoding)
-> ShelleyBlock proto era -> Serialised (ShelleyBlock proto era)
forall a. (a -> Encoding) -> a -> Serialised a
mkSerialised (CodecConfig (ShelleyBlock proto era)
-> ShelleyBlock proto era -> Encoding
forall blk a. EncodeDisk blk a => CodecConfig blk -> a -> Encoding
encodeDisk CodecConfig (ShelleyBlock proto era)
ccfg) ShelleyBlock proto era
blk
    tx :: GenTx (ShelleyBlock proto era)
tx = Tx TopTx era -> GenTx (ShelleyBlock proto era)
forall era proto.
ShelleyBasedEra era =>
Tx TopTx era -> GenTx (ShelleyBlock proto era)
mkShelleyTx Tx TopTx era
emptyTx
    slotNo :: SlotNo
slotNo = Word64 -> SlotNo
SlotNo Word64
42
    serialisedHeader :: SerialisedHeader (ShelleyBlock proto era)
serialisedHeader =
      GenDepPair Serialised (NestedCtxt Header (ShelleyBlock proto era))
-> SerialisedHeader (ShelleyBlock proto era)
forall blk.
GenDepPair Serialised (NestedCtxt Header blk)
-> SerialisedHeader blk
SerialisedHeaderFromDepPair (GenDepPair Serialised (NestedCtxt Header (ShelleyBlock proto era))
 -> SerialisedHeader (ShelleyBlock proto era))
-> GenDepPair
     Serialised (NestedCtxt Header (ShelleyBlock proto era))
-> SerialisedHeader (ShelleyBlock proto era)
forall a b. (a -> b) -> a -> b
$ CodecConfig (ShelleyBlock proto era)
-> DepPair (NestedCtxt Header (ShelleyBlock proto era))
-> GenDepPair
     Serialised (NestedCtxt Header (ShelleyBlock proto era))
forall (f :: MapKind) blk.
EncodeDiskDep f blk =>
CodecConfig blk -> DepPair (f blk) -> GenDepPair Serialised (f blk)
encodeDepPair CodecConfig (ShelleyBlock proto era)
ccfg (Header (ShelleyBlock proto era)
-> DepPair (NestedCtxt Header (ShelleyBlock proto era))
forall (f :: * -> *) blk.
HasNestedContent f blk =>
f blk -> DepPair (NestedCtxt f blk)
unnest (ShelleyBlock proto era -> Header (ShelleyBlock proto era)
forall blk. GetHeader blk => blk -> Header blk
getHeader ShelleyBlock proto era
blk))
    queries :: Labelled (SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))
queries =
      Set (Either Coin (Credential Staking))
-> Labelled (SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))
forall era proto.
EraGov era =>
Set (Either Coin (Credential Staking))
-> Labelled (SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))
eraIndependentQueries Set (Either Coin (Credential Staking))
leRewardsCredentials
        Labelled (SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))
-> Labelled (SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))
-> Labelled (SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))
forall a. Semigroup a => a -> a -> a
<> EraQueries proto era
eraQueries (Map (KeyHash StakePool) IndividualPoolStake -> [KeyHash StakePool]
forall k a. Map k a -> [k]
Map.keys (PoolDistr -> Map (KeyHash StakePool) IndividualPoolStake
unPoolDistr PoolDistr
lePoolDistr))
    results :: Labelled (SomeResult (ShelleyBlock proto era))
results =
      [(String, SomeResult (ShelleyBlock proto era))]
-> Labelled (SomeResult (ShelleyBlock proto era))
forall a. [(String, a)] -> Labelled a
labelled
        [ (String
"LedgerTip", BlockQuery
  (ShelleyBlock proto era)
  'QFNoTables
  (Point (ShelleyBlock proto era))
-> Point (ShelleyBlock proto era)
-> SomeResult (ShelleyBlock proto era)
forall result blk (fp :: QueryFootprint).
(Eq result, Show result, Typeable result) =>
BlockQuery blk fp result -> result -> SomeResult blk
SomeResult BlockQuery
  (ShelleyBlock proto era)
  'QFNoTables
  (Point (ShelleyBlock proto era))
forall proto era.
BlockQuery
  (ShelleyBlock proto era)
  'QFNoTables
  (Point (ShelleyBlock proto era))
GetLedgerTip (ShelleyBlock proto era -> Point (ShelleyBlock proto era)
forall block. HasHeader block => block -> Point block
blockPoint ShelleyBlock proto era
blk))
        , (String
"GenesisConfig", BlockQuery (ShelleyBlock proto era) 'QFNoTables CompactGenesis
-> CompactGenesis -> SomeResult (ShelleyBlock proto era)
forall result blk (fp :: QueryFootprint).
(Eq result, Show result, Typeable result) =>
BlockQuery blk fp result -> result -> SomeResult blk
SomeResult BlockQuery (ShelleyBlock proto era) 'QFNoTables CompactGenesis
forall proto era.
BlockQuery (ShelleyBlock proto era) 'QFNoTables CompactGenesis
GetGenesisConfig (ShelleyGenesis -> CompactGenesis
compactGenesis ShelleyGenesis
leShelleyGenesis))
        ,
          ( String
"GetBigLedgerPeerSnapshot"
          , BlockQuery
  (ShelleyBlock proto era)
  'QFNoTables
  (LedgerPeerSnapshot BigLedgerPeers)
-> LedgerPeerSnapshot BigLedgerPeers
-> SomeResult (ShelleyBlock proto era)
forall result blk (fp :: QueryFootprint).
(Eq result, Show result, Typeable result) =>
BlockQuery blk fp result -> result -> SomeResult blk
SomeResult
              (SingLedgerPeersKind BigLedgerPeers
-> BlockQuery
     (ShelleyBlock proto era)
     'QFNoTables
     (LedgerPeerSnapshot BigLedgerPeers)
forall proto era (ledgerPeersKind :: LedgerPeersKind).
SingLedgerPeersKind ledgerPeersKind
-> BlockQuery
     (ShelleyBlock proto era)
     'QFNoTables
     (LedgerPeerSnapshot ledgerPeersKind)
GetLedgerPeerSnapshot SingLedgerPeersKind BigLedgerPeers
SingBigLedgerPeers)
              ( Point RawBlockHash
-> NetworkMagic
-> [(AccPoolStake, (PoolStake, NonEmpty LedgerRelayAccessPoint))]
-> LedgerPeerSnapshot BigLedgerPeers
LedgerBigPeerSnapshotV23
                  (SlotNo -> HeaderHash RawBlockHash -> Point RawBlockHash
forall {k} (block :: k). SlotNo -> HeaderHash block -> Point block
BlockPoint SlotNo
slotNo (ShortByteString -> RawBlockHash
RawBlockHash ShortByteString
"<BLOCK HASH, padded to 32 bytes>"))
                  (Word32 -> NetworkMagic
NetworkMagic Word32
42)
                  [
                    ( Ratio Integer -> AccPoolStake
AccPoolStake Ratio Integer
0.9
                    ,
                      ( Ratio Integer -> PoolStake
PoolStake Ratio Integer
0.9
                      , IP -> PortNumber -> LedgerRelayAccessPoint
LedgerRelayAccessAddress (IPv4 -> IP
IPv4 IPv4
"1.1.1.1") PortNumber
1234 LedgerRelayAccessPoint
-> [LedgerRelayAccessPoint] -> NonEmpty LedgerRelayAccessPoint
forall a. a -> [a] -> NonEmpty a
:| []
                      )
                    )
                  ]
              )
          )
        ,
          ( String
"GetAllLedgerPeerSnapshot"
          , BlockQuery
  (ShelleyBlock proto era)
  'QFNoTables
  (LedgerPeerSnapshot AllLedgerPeers)
-> LedgerPeerSnapshot AllLedgerPeers
-> SomeResult (ShelleyBlock proto era)
forall result blk (fp :: QueryFootprint).
(Eq result, Show result, Typeable result) =>
BlockQuery blk fp result -> result -> SomeResult blk
SomeResult
              (SingLedgerPeersKind AllLedgerPeers
-> BlockQuery
     (ShelleyBlock proto era)
     'QFNoTables
     (LedgerPeerSnapshot AllLedgerPeers)
forall proto era (ledgerPeersKind :: LedgerPeersKind).
SingLedgerPeersKind ledgerPeersKind
-> BlockQuery
     (ShelleyBlock proto era)
     'QFNoTables
     (LedgerPeerSnapshot ledgerPeersKind)
GetLedgerPeerSnapshot SingLedgerPeersKind AllLedgerPeers
SingAllLedgerPeers)
              ( Point RawBlockHash
-> NetworkMagic
-> [(PoolStake, NonEmpty LedgerRelayAccessPoint)]
-> LedgerPeerSnapshot AllLedgerPeers
LedgerAllPeerSnapshotV23
                  (SlotNo -> HeaderHash RawBlockHash -> Point RawBlockHash
forall {k} (block :: k). SlotNo -> HeaderHash block -> Point block
BlockPoint SlotNo
slotNo (ShortByteString -> RawBlockHash
RawBlockHash ShortByteString
"<BLOCK HASH, padded to 32 bytes>"))
                  (Word32 -> NetworkMagic
NetworkMagic Word32
42)
                  [
                    ( Ratio Integer -> PoolStake
PoolStake Ratio Integer
0.9
                    , IP -> PortNumber -> LedgerRelayAccessPoint
LedgerRelayAccessAddress (IPv4 -> IP
IPv4 IPv4
"1.1.1.1") PortNumber
1234 LedgerRelayAccessPoint
-> [LedgerRelayAccessPoint] -> NonEmpty LedgerRelayAccessPoint
forall a. a -> [a] -> NonEmpty a
:| []
                    )
                  ]
              )
          )
        ,
          ( String
"GetBigLedgerPeerSnapshotAtOrigin"
          , BlockQuery
  (ShelleyBlock proto era)
  'QFNoTables
  (LedgerPeerSnapshot BigLedgerPeers)
-> LedgerPeerSnapshot BigLedgerPeers
-> SomeResult (ShelleyBlock proto era)
forall result blk (fp :: QueryFootprint).
(Eq result, Show result, Typeable result) =>
BlockQuery blk fp result -> result -> SomeResult blk
SomeResult
              (SingLedgerPeersKind BigLedgerPeers
-> BlockQuery
     (ShelleyBlock proto era)
     'QFNoTables
     (LedgerPeerSnapshot BigLedgerPeers)
forall proto era (ledgerPeersKind :: LedgerPeersKind).
SingLedgerPeersKind ledgerPeersKind
-> BlockQuery
     (ShelleyBlock proto era)
     'QFNoTables
     (LedgerPeerSnapshot ledgerPeersKind)
GetLedgerPeerSnapshot SingLedgerPeersKind BigLedgerPeers
SingBigLedgerPeers)
              (Point RawBlockHash
-> NetworkMagic
-> [(AccPoolStake, (PoolStake, NonEmpty LedgerRelayAccessPoint))]
-> LedgerPeerSnapshot BigLedgerPeers
LedgerBigPeerSnapshotV23 Point RawBlockHash
forall {k} (block :: k). Point block
GenesisPoint (Word32 -> NetworkMagic
NetworkMagic Word32
42) [])
          )
        ,
          ( String
"MaxMajorProtocolVersion"
          , BlockQuery (ShelleyBlock proto era) 'QFNoTables MaxMajorProtVer
-> MaxMajorProtVer -> SomeResult (ShelleyBlock proto era)
forall result blk (fp :: QueryFootprint).
(Eq result, Show result, Typeable result) =>
BlockQuery blk fp result -> result -> SomeResult blk
SomeResult BlockQuery (ShelleyBlock proto era) 'QFNoTables MaxMajorProtVer
forall proto era.
BlockQuery (ShelleyBlock proto era) 'QFNoTables MaxMajorProtVer
GetMaxMajorProtocolVersion (MaxMajorProtVer -> SomeResult (ShelleyBlock proto era))
-> MaxMajorProtVer -> SomeResult (ShelleyBlock proto era)
forall a b. (a -> b) -> a -> b
$ Version -> MaxMajorProtVer
MaxMajorProtVer (forall a. Bounded a => a
maxBound @SL.Version)
          )
        ]
    annTip :: AnnTip (ShelleyBlock proto era)
annTip =
      AnnTip
        { annTipSlotNo :: SlotNo
annTipSlotNo = Word64 -> SlotNo
SlotNo Word64
14
        , annTipBlockNo :: BlockNo
annTipBlockNo = Word64 -> BlockNo
BlockNo Word64
6
        , annTipInfo :: TipInfo (ShelleyBlock proto era)
annTipInfo = TipInfo (ShelleyBlock proto era)
ShelleyHash
hash
        }
    ledgerState :: LedgerState (ShelleyBlock proto era) EmptyMK
ledgerState =
      ShelleyLedgerState
        { shelleyLedgerTip :: WithOrigin (ShelleyTip proto era)
shelleyLedgerTip =
            ShelleyTip proto era -> WithOrigin (ShelleyTip proto era)
forall t. t -> WithOrigin t
NotOrigin
              ShelleyTip
                { shelleyTipSlotNo :: SlotNo
shelleyTipSlotNo = Word64 -> SlotNo
SlotNo Word64
9
                , shelleyTipBlockNo :: BlockNo
shelleyTipBlockNo = Word64 -> BlockNo
BlockNo Word64
3
                , shelleyTipHash :: HeaderHash (ShelleyBlock proto era)
shelleyTipHash = HeaderHash (ShelleyBlock proto era)
ShelleyHash
hash
                }
        , shelleyLedgerState :: NewEpochState era
shelleyLedgerState = NewEpochState era
leNewEpochState
        , shelleyLedgerTransition :: ShelleyTransition
shelleyLedgerTransition = ShelleyTransitionInfo{shelleyAfterVoting :: Word32
shelleyAfterVoting = Word32
0}
        , shelleyLedgerTables :: LedgerTables (ShelleyBlock proto era) EmptyMK
shelleyLedgerTables = LedgerTables (ShelleyBlock proto era) EmptyMK
forall (mk :: MapKind) blk.
(ZeroableMK mk, LedgerTableConstraints blk) =>
LedgerTables blk mk
emptyLedgerTables
        }
    chainDepState :: ChainDepState proto
chainDepState =
      Proxy (TPraos StandardCrypto, proto, era)
-> ChainDepState (TPraos StandardCrypto) -> ChainDepState proto
forall protoFrom protoTo eraTo.
TranslateProto protoFrom protoTo eraTo =>
Proxy (protoFrom, protoTo, eraTo)
-> ChainDepState protoFrom -> ChainDepState protoTo
translateChainDepState (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(TPraos StandardCrypto, proto, era)) (ChainDepState (TPraos StandardCrypto) -> ChainDepState proto)
-> ChainDepState (TPraos StandardCrypto) -> ChainDepState proto
forall a b. (a -> b) -> a -> b
$
        WithOrigin SlotNo -> ChainDepState -> TPraosState
TPraosState (SlotNo -> WithOrigin SlotNo
forall t. t -> WithOrigin t
NotOrigin SlotNo
1) ChainDepState
pleChainDepState
    extLedgerState :: ExtLedgerState (ShelleyBlock proto era) EmptyMK
extLedgerState =
      let headerState :: HeaderState (ShelleyBlock proto era)
headerState = ChainDepState (BlockProtocol (ShelleyBlock proto era))
-> HeaderState (ShelleyBlock proto era)
forall blk. ChainDepState (BlockProtocol blk) -> HeaderState blk
genesisHeaderState ChainDepState proto
ChainDepState (BlockProtocol (ShelleyBlock proto era))
chainDepState
          perasState :: PerasState (ShelleyBlock proto era)
perasState = LedgerConfig (ShelleyBlock proto era)
-> LedgerState (ShelleyBlock proto era) EmptyMK
-> HeaderState (ShelleyBlock proto era)
-> PerasState (ShelleyBlock proto era)
forall blk (mk :: MapKind).
(All Top (HardForkIndices blk), StateSupportsPerasEpochContext blk,
 HasLedgerTables LedgerState blk) =>
LedgerCfg LedgerState blk
-> LedgerState blk mk -> HeaderState blk -> PerasState blk
initPerasState LedgerConfig (ShelleyBlock proto era)
ShelleyLedgerConfig era
ledgerConfig LedgerState (ShelleyBlock proto era) EmptyMK
forall {proto}. LedgerState (ShelleyBlock proto era) EmptyMK
ledgerState HeaderState (ShelleyBlock proto era)
headerState
       in ExtLedgerState
            { LedgerState (ShelleyBlock proto era) EmptyMK
forall {proto}. LedgerState (ShelleyBlock proto era) EmptyMK
ledgerState :: LedgerState (ShelleyBlock proto era) EmptyMK
ledgerState :: forall {proto}. LedgerState (ShelleyBlock proto era) EmptyMK
ledgerState
            , HeaderState (ShelleyBlock proto era)
headerState :: HeaderState (ShelleyBlock proto era)
headerState :: HeaderState (ShelleyBlock proto era)
headerState
            , PerasState (ShelleyBlock proto era)
perasState :: PerasState (ShelleyBlock proto era)
perasState :: PerasState (ShelleyBlock proto era)
perasState
            }

    ledgerConfig :: ShelleyLedgerConfig era
ledgerConfig = TranslationContext era -> ShelleyLedgerConfig era
forall era. TranslationContext era -> ShelleyLedgerConfig era
exampleShelleyLedgerConfig TranslationContext era
leTranslationContext

-- | Rebuild a TPraos example header as a Praos one.
translatePraosHeader :: SL.BHeader StandardCrypto -> Praos.Header StandardCrypto
translatePraosHeader :: BHeader StandardCrypto -> Header StandardCrypto
translatePraosHeader (SL.BHeader BHBody StandardCrypto
bhBody SignedKES (KES StandardCrypto) (BHBody StandardCrypto)
bhSig) =
  HeaderBody StandardCrypto
-> SignedKES (KES StandardCrypto) (HeaderBody StandardCrypto)
-> Header StandardCrypto
forall crypto.
Crypto crypto =>
HeaderBody crypto
-> SignedKES (KES crypto) (HeaderBody crypto) -> Header crypto
Praos.Header (BHBody StandardCrypto -> HeaderBody StandardCrypto
praosHeaderBodyFromTPraos BHBody StandardCrypto
bhBody) (SignedKES
  (Sum6KES Ed25519DSIGN Blake2b_256) (BHBody StandardCrypto)
-> SignedKES
     (Sum6KES Ed25519DSIGN Blake2b_256) (HeaderBody StandardCrypto)
forall a b. Coercible a b => a -> b
coerce SignedKES
  (Sum6KES Ed25519DSIGN Blake2b_256) (BHBody StandardCrypto)
SignedKES (KES StandardCrypto) (BHBody StandardCrypto)
bhSig)

praosHeaderBodyFromTPraos :: SL.BHBody StandardCrypto -> HeaderBody StandardCrypto
praosHeaderBodyFromTPraos :: BHBody StandardCrypto -> HeaderBody StandardCrypto
praosHeaderBodyFromTPraos BHBody StandardCrypto
bhBody =
  HeaderBody
    { hbBlockNo :: BlockNo
hbBlockNo = BHBody StandardCrypto -> BlockNo
forall c. BHBody c -> BlockNo
SL.bheaderBlockNo BHBody StandardCrypto
bhBody
    , hbSlotNo :: SlotNo
hbSlotNo = BHBody StandardCrypto -> SlotNo
forall c. BHBody c -> SlotNo
SL.bheaderSlotNo BHBody StandardCrypto
bhBody
    , hbPrev :: PrevHash
hbPrev = BHBody StandardCrypto -> PrevHash
forall c. BHBody c -> PrevHash
SL.bheaderPrev BHBody StandardCrypto
bhBody
    , hbVk :: VKey BlockIssuer
hbVk = BHBody StandardCrypto -> VKey BlockIssuer
forall c. BHBody c -> VKey BlockIssuer
SL.bheaderVk BHBody StandardCrypto
bhBody
    , hbVrfVk :: VerKeyVRF (VRF StandardCrypto)
hbVrfVk = BHBody StandardCrypto -> VerKeyVRF (VRF StandardCrypto)
forall c. BHBody c -> VerKeyVRF (VRF c)
SL.bheaderVrfVk BHBody StandardCrypto
bhBody
    , hbVrfRes :: CertifiedVRF (VRF StandardCrypto) InputVRF
hbVrfRes = CertifiedVRF PraosVRF Nonce
-> CertifiedVRF (VRF StandardCrypto) InputVRF
forall a b. Coercible a b => a -> b
coerce (CertifiedVRF PraosVRF Nonce
 -> CertifiedVRF (VRF StandardCrypto) InputVRF)
-> CertifiedVRF PraosVRF Nonce
-> CertifiedVRF (VRF StandardCrypto) InputVRF
forall a b. (a -> b) -> a -> b
$ BHBody StandardCrypto -> CertifiedVRF (VRF StandardCrypto) Nonce
forall c. BHBody c -> CertifiedVRF (VRF c) Nonce
SL.bheaderEta BHBody StandardCrypto
bhBody
    , hbBodySize :: Word32
hbBodySize = BHBody StandardCrypto -> Word32
forall c. BHBody c -> Word32
SL.bsize BHBody StandardCrypto
bhBody
    , hbBodyHash :: Hash Blake2b_256 EraIndependentBlockBody
hbBodyHash = BHBody StandardCrypto -> Hash Blake2b_256 EraIndependentBlockBody
forall c. BHBody c -> Hash Blake2b_256 EraIndependentBlockBody
SL.bhash BHBody StandardCrypto
bhBody
    , hbOCert :: OCert StandardCrypto
hbOCert = BHBody StandardCrypto -> OCert StandardCrypto
forall c. BHBody c -> OCert c
SL.bheaderOCert BHBody StandardCrypto
bhBody
    , hbProtVer :: ProtVer
hbProtVer = BHBody StandardCrypto -> ProtVer
forall c. BHBody c -> ProtVer
SL.bprotver BHBody StandardCrypto
bhBody
    }

fromShelleyLedgerExamplesPraos2 ::
  EraQueries (Praos2 StandardCrypto) DijkstraEra ->
  ProtocolLedgerExamples (SL.BHeader StandardCrypto) DijkstraEra ->
  Examples (ShelleyBlock (Praos2 StandardCrypto) DijkstraEra)
fromShelleyLedgerExamplesPraos2 :: EraQueries (Praos2 StandardCrypto) DijkstraEra
-> ProtocolLedgerExamples (BHeader StandardCrypto) DijkstraEra
-> Examples (ShelleyBlock (Praos2 StandardCrypto) DijkstraEra)
fromShelleyLedgerExamplesPraos2 =
  (BHeader StandardCrypto
 -> ShelleyProtocolHeader (Praos2 StandardCrypto))
-> EraQueries (Praos2 StandardCrypto) DijkstraEra
-> ProtocolLedgerExamples (BHeader StandardCrypto) DijkstraEra
-> Examples (ShelleyBlock (Praos2 StandardCrypto) DijkstraEra)
forall proto era.
(ShelleyCompatible proto era,
 TranslateProto (TPraos StandardCrypto) proto era) =>
(BHeader StandardCrypto -> ShelleyProtocolHeader proto)
-> EraQueries proto era
-> ProtocolLedgerExamples (BHeader StandardCrypto) era
-> Examples (ShelleyBlock proto era)
fromShelleyLedgerExamplesPolyPraos BHeader StandardCrypto -> Header StandardCrypto
BHeader StandardCrypto
-> ShelleyProtocolHeader (Praos2 StandardCrypto)
translateLeiosHeader

-- | As 'translatePraosHeader', with the Leios fields of an example block that
-- announces an endorser block. It carries no certificate, since the example
-- body has none and 'blockMatchesHeader' requires the two to agree.
translateLeiosHeader :: SL.BHeader StandardCrypto -> Leios.Header StandardCrypto
translateLeiosHeader :: BHeader StandardCrypto -> Header StandardCrypto
translateLeiosHeader (SL.BHeader BHBody StandardCrypto
bhBody SignedKES (KES StandardCrypto) (BHBody StandardCrypto)
bhSig) =
  Proxy DijkstraEra
-> HeaderBody StandardCrypto
-> SignedKES (KES StandardCrypto) (HeaderBody StandardCrypto)
-> Header StandardCrypto
forall era crypto (proxy :: * -> *).
(Era era, Crypto crypto) =>
proxy era
-> HeaderBody crypto
-> SignedKES (KES crypto) (HeaderBody crypto)
-> Header crypto
Leios.mkHeader (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @DijkstraEra) HeaderBody StandardCrypto
hBody (SignedKES
  (Sum6KES Ed25519DSIGN Blake2b_256) (BHBody StandardCrypto)
-> SignedKES
     (Sum6KES Ed25519DSIGN Blake2b_256) (HeaderBody StandardCrypto)
forall a b. Coercible a b => a -> b
coerce SignedKES
  (Sum6KES Ed25519DSIGN Blake2b_256) (BHBody StandardCrypto)
SignedKES (KES StandardCrypto) (BHBody StandardCrypto)
bhSig)
 where
  pb :: HeaderBody StandardCrypto
pb = BHBody StandardCrypto -> HeaderBody StandardCrypto
praosHeaderBodyFromTPraos BHBody StandardCrypto
bhBody
  SL.ProtVer Version
major Word32
minor = HeaderBody StandardCrypto -> ProtVer
forall crypto. HeaderBody crypto -> ProtVer
Praos.hbProtVer HeaderBody StandardCrypto
pb
  hBody :: HeaderBody StandardCrypto
hBody =
    Proxy DijkstraEra
-> HeaderBodyRaw StandardCrypto -> HeaderBody StandardCrypto
forall era crypto (proxy :: * -> *).
(Era era, Crypto crypto) =>
proxy era -> HeaderBodyRaw crypto -> HeaderBody crypto
Leios.mkHeaderBody (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @DijkstraEra) (HeaderBodyRaw StandardCrypto -> HeaderBody StandardCrypto)
-> HeaderBodyRaw StandardCrypto -> HeaderBody StandardCrypto
forall a b. (a -> b) -> a -> b
$
      Leios.HeaderBodyRaw
        { hbrBlockNo :: BlockNo
Leios.hbrBlockNo = HeaderBody StandardCrypto -> BlockNo
forall crypto. HeaderBody crypto -> BlockNo
Praos.hbBlockNo HeaderBody StandardCrypto
pb
        , hbrSlotNo :: SlotNo
Leios.hbrSlotNo = HeaderBody StandardCrypto -> SlotNo
forall crypto. HeaderBody crypto -> SlotNo
Praos.hbSlotNo HeaderBody StandardCrypto
pb
        , hbrPrev :: PrevHash
Leios.hbrPrev = HeaderBody StandardCrypto -> PrevHash
forall crypto. HeaderBody crypto -> PrevHash
Praos.hbPrev HeaderBody StandardCrypto
pb
        , hbrVk :: VKey BlockIssuer
Leios.hbrVk = HeaderBody StandardCrypto -> VKey BlockIssuer
forall crypto. HeaderBody crypto -> VKey BlockIssuer
Praos.hbVk HeaderBody StandardCrypto
pb
        , hbrVrfVk :: VerKeyVRF (VRF StandardCrypto)
Leios.hbrVrfVk = HeaderBody StandardCrypto -> VerKeyVRF (VRF StandardCrypto)
forall crypto. HeaderBody crypto -> VerKeyVRF (VRF crypto)
Praos.hbVrfVk HeaderBody StandardCrypto
pb
        , hbrVrfRes :: CertifiedVRF (VRF StandardCrypto) InputVRF
Leios.hbrVrfRes = HeaderBody StandardCrypto
-> CertifiedVRF (VRF StandardCrypto) InputVRF
forall crypto.
HeaderBody crypto -> CertifiedVRF (VRF crypto) InputVRF
Praos.hbVrfRes HeaderBody StandardCrypto
pb
        , hbrBodySize :: Word32
Leios.hbrBodySize = HeaderBody StandardCrypto -> Word32
forall crypto. HeaderBody crypto -> Word32
Praos.hbBodySize HeaderBody StandardCrypto
pb
        , hbrBodyHash :: Hash Blake2b_256 EraIndependentBlockBody
Leios.hbrBodyHash = HeaderBody StandardCrypto
-> Hash Blake2b_256 EraIndependentBlockBody
forall crypto.
HeaderBody crypto -> Hash Blake2b_256 EraIndependentBlockBody
Praos.hbBodyHash HeaderBody StandardCrypto
pb
        , hbrOCert :: OCert StandardCrypto
Leios.hbrOCert = HeaderBody StandardCrypto -> OCert StandardCrypto
forall crypto. HeaderBody crypto -> OCert crypto
Praos.hbOCert HeaderBody StandardCrypto
pb
        , hbrVersionInfo :: BlockHeaderVersionInfo
Leios.hbrVersionInfo = Word32 -> Word32 -> BlockHeaderVersionInfo
SL.BlockHeaderVersionInfo (Version -> Word32
SL.getVersion32 Version
major) Word32
minor
        , hbrBlockBodyContainsLeiosCert :: Bool
Leios.hbrBlockBodyContainsLeiosCert = Bool
False
        , hbrEbReferencesAnnouncement :: StrictMaybe EbReferencesAnnouncement
Leios.hbrEbReferencesAnnouncement =
            EbReferencesAnnouncement -> StrictMaybe EbReferencesAnnouncement
forall a. a -> StrictMaybe a
SL.SJust (EbReferencesAnnouncement -> StrictMaybe EbReferencesAnnouncement)
-> EbReferencesAnnouncement -> StrictMaybe EbReferencesAnnouncement
forall a b. (a -> b) -> a -> b
$
              SL.EbReferencesAnnouncement
                { ebReferencesAnnouncementHash :: SafeHash EraIndependentEbReferences
SL.ebReferencesAnnouncementHash =
                    Hash Blake2b_256 EraIndependentEbReferences
-> SafeHash EraIndependentEbReferences
forall i. Hash Blake2b_256 i -> SafeHash i
unsafeMakeSafeHash (Hash Blake2b_256 EraIndependentEbReferences
 -> SafeHash EraIndependentEbReferences)
-> Hash Blake2b_256 EraIndependentEbReferences
-> SafeHash EraIndependentEbReferences
forall a b. (a -> b) -> a -> b
$ Hash Blake2b_256 EraIndependentBlockBody
-> Hash Blake2b_256 EraIndependentEbReferences
forall h a b. Hash h a -> Hash h b
Hash.castHash (Hash Blake2b_256 EraIndependentBlockBody
 -> Hash Blake2b_256 EraIndependentEbReferences)
-> Hash Blake2b_256 EraIndependentBlockBody
-> Hash Blake2b_256 EraIndependentEbReferences
forall a b. (a -> b) -> a -> b
$ HeaderBody StandardCrypto
-> Hash Blake2b_256 EraIndependentBlockBody
forall crypto.
HeaderBody crypto -> Hash Blake2b_256 EraIndependentBlockBody
Praos.hbBodyHash HeaderBody StandardCrypto
pb
                , ebReferencesAnnouncementSize :: Word32
SL.ebReferencesAnnouncementSize = Word32
123
                }
        }

examplesShelley :: Examples StandardShelleyBlock
examplesShelley :: Examples StandardShelleyBlock
examplesShelley = EraQueries (TPraos StandardCrypto) ShelleyEra
-> ProtocolLedgerExamples (BHeader StandardCrypto) ShelleyEra
-> Examples StandardShelleyBlock
forall era.
ShelleyCompatible (TPraos StandardCrypto) era =>
EraQueries (TPraos StandardCrypto) era
-> ProtocolLedgerExamples (BHeader StandardCrypto) era
-> Examples (ShelleyBlock (TPraos StandardCrypto) era)
fromShelleyLedgerExamples EraQueries (TPraos StandardCrypto) ShelleyEra
forall proto era. EraQueries proto era
noEraQueries ProtocolLedgerExamples (BHeader StandardCrypto) ShelleyEra
ledgerExamplesShelley

examplesAllegra :: Examples StandardAllegraBlock
examplesAllegra :: Examples StandardAllegraBlock
examplesAllegra = EraQueries (TPraos StandardCrypto) AllegraEra
-> ProtocolLedgerExamples (BHeader StandardCrypto) AllegraEra
-> Examples StandardAllegraBlock
forall era.
ShelleyCompatible (TPraos StandardCrypto) era =>
EraQueries (TPraos StandardCrypto) era
-> ProtocolLedgerExamples (BHeader StandardCrypto) era
-> Examples (ShelleyBlock (TPraos StandardCrypto) era)
fromShelleyLedgerExamples EraQueries (TPraos StandardCrypto) AllegraEra
forall proto era. EraQueries proto era
noEraQueries ProtocolLedgerExamples (BHeader StandardCrypto) AllegraEra
ledgerExamplesAllegra

examplesMary :: Examples StandardMaryBlock
examplesMary :: Examples StandardMaryBlock
examplesMary = EraQueries (TPraos StandardCrypto) MaryEra
-> ProtocolLedgerExamples (BHeader StandardCrypto) MaryEra
-> Examples StandardMaryBlock
forall era.
ShelleyCompatible (TPraos StandardCrypto) era =>
EraQueries (TPraos StandardCrypto) era
-> ProtocolLedgerExamples (BHeader StandardCrypto) era
-> Examples (ShelleyBlock (TPraos StandardCrypto) era)
fromShelleyLedgerExamples EraQueries (TPraos StandardCrypto) MaryEra
forall proto era. EraQueries proto era
noEraQueries ProtocolLedgerExamples (BHeader StandardCrypto) MaryEra
ledgerExamplesMary

examplesAlonzo :: Examples StandardAlonzoBlock
examplesAlonzo :: Examples StandardAlonzoBlock
examplesAlonzo = EraQueries (TPraos StandardCrypto) AlonzoEra
-> ProtocolLedgerExamples (BHeader StandardCrypto) AlonzoEra
-> Examples StandardAlonzoBlock
forall era.
ShelleyCompatible (TPraos StandardCrypto) era =>
EraQueries (TPraos StandardCrypto) era
-> ProtocolLedgerExamples (BHeader StandardCrypto) era
-> Examples (ShelleyBlock (TPraos StandardCrypto) era)
fromShelleyLedgerExamples EraQueries (TPraos StandardCrypto) AlonzoEra
forall proto era. EraQueries proto era
noEraQueries ProtocolLedgerExamples (BHeader StandardCrypto) AlonzoEra
ledgerExamplesAlonzo

examplesBabbage :: Examples StandardBabbageBlock
examplesBabbage :: Examples StandardBabbageBlock
examplesBabbage = EraQueries (Praos StandardCrypto) BabbageEra
-> ProtocolLedgerExamples (BHeader StandardCrypto) BabbageEra
-> Examples StandardBabbageBlock
forall era.
ShelleyCompatible (Praos StandardCrypto) era =>
EraQueries (Praos StandardCrypto) era
-> ProtocolLedgerExamples (BHeader StandardCrypto) era
-> Examples (ShelleyBlock (Praos StandardCrypto) era)
fromShelleyLedgerExamplesPraos EraQueries (Praos StandardCrypto) BabbageEra
forall proto era. EraQueries proto era
noEraQueries (LedgerExamples BabbageEra
-> ProtocolLedgerExamples (BHeader StandardCrypto) BabbageEra
forall era.
EraBlockBody era =>
LedgerExamples era
-> ProtocolLedgerExamples (BHeader StandardCrypto) era
ledgerExamplesTPraos LedgerExamples BabbageEra
Babbage.ledgerExamples)

examplesConway :: Examples StandardConwayBlock
examplesConway :: Examples StandardConwayBlock
examplesConway = EraQueries (Praos StandardCrypto) ConwayEra
-> ProtocolLedgerExamples (BHeader StandardCrypto) ConwayEra
-> Examples StandardConwayBlock
forall era.
ShelleyCompatible (Praos StandardCrypto) era =>
EraQueries (Praos StandardCrypto) era
-> ProtocolLedgerExamples (BHeader StandardCrypto) era
-> Examples (ShelleyBlock (Praos StandardCrypto) era)
fromShelleyLedgerExamplesPraos EraQueries (Praos StandardCrypto) ConwayEra
forall era proto.
(ConwayEraGov era, ConwayEraCertState era) =>
EraQueries proto era
conwayQueries (LedgerExamples ConwayEra
-> ProtocolLedgerExamples (BHeader StandardCrypto) ConwayEra
forall era.
EraBlockBody era =>
LedgerExamples era
-> ProtocolLedgerExamples (BHeader StandardCrypto) era
ledgerExamplesTPraos LedgerExamples ConwayEra
Conway.ledgerExamples)

examplesDijkstra :: Examples StandardDijkstraBlock
examplesDijkstra :: Examples (ShelleyBlock (Praos2 StandardCrypto) DijkstraEra)
examplesDijkstra =
  EraQueries (Praos2 StandardCrypto) DijkstraEra
-> ProtocolLedgerExamples (BHeader StandardCrypto) DijkstraEra
-> Examples (ShelleyBlock (Praos2 StandardCrypto) DijkstraEra)
fromShelleyLedgerExamplesPraos2 EraQueries (Praos2 StandardCrypto) DijkstraEra
forall era proto.
(ConwayEraGov era, ConwayEraCertState era) =>
EraQueries proto era
conwayQueries (LedgerExamples DijkstraEra
-> ProtocolLedgerExamples (BHeader StandardCrypto) DijkstraEra
forall era.
EraBlockBody era =>
LedgerExamples era
-> ProtocolLedgerExamples (BHeader StandardCrypto) era
ledgerExamplesTPraos LedgerExamples DijkstraEra
Dijkstra.ledgerExamples)

exampleShelleyLedgerConfig :: TranslationContext era -> ShelleyLedgerConfig era
exampleShelleyLedgerConfig :: forall era. TranslationContext era -> ShelleyLedgerConfig era
exampleShelleyLedgerConfig TranslationContext era
translationContext =
  ShelleyLedgerConfig
    { shelleyLedgerCompactGenesis :: CompactGenesis
shelleyLedgerCompactGenesis = ShelleyGenesis -> CompactGenesis
compactGenesis ShelleyGenesis
Shelley.testShelleyGenesis
    , shelleyLedgerGlobals :: Globals
shelleyLedgerGlobals =
        ShelleyGenesis -> EpochInfo (Either Text) -> Globals
SL.mkShelleyGlobals
          ShelleyGenesis
Shelley.testShelleyGenesis
          EpochInfo (Either Text)
epochInfo
    , shelleyLedgerTranslationContext :: TranslationContext era
shelleyLedgerTranslationContext = TranslationContext era
translationContext
    }
 where
  epochInfo :: EpochInfo (Either Text)
epochInfo = EpochSize -> SlotLength -> EpochInfo (Either Text)
forall (m :: * -> *).
Monad m =>
EpochSize -> SlotLength -> EpochInfo m
fixedEpochInfo (Word64 -> EpochSize
EpochSize Word64
4) SlotLength
slotLength
  slotLength :: SlotLength
slotLength = NominalDiffTime -> SlotLength
mkSlotLength (Double -> NominalDiffTime
secondsToNominalDiffTime Double
7)