{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# OPTIONS_GHC -Wno-deprecations #-}

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

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

import qualified Cardano.Ledger.BaseTypes as SL
import qualified Cardano.Ledger.Block as SL
import Cardano.Ledger.Core
import qualified Cardano.Ledger.Shelley.API as SL
import Cardano.Protocol.Crypto (StandardCrypto)
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.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 (translateChainDepState)
import Ouroboros.Consensus.Protocol.Praos (Praos)
import Ouroboros.Consensus.Protocol.Praos.Common
import Ouroboros.Consensus.Protocol.TPraos
  ( TPraos
  , TPraosState (TPraosState)
  )
import Ouroboros.Consensus.Shelley.HFEras
import Ouroboros.Consensus.Shelley.Ledger
import Ouroboros.Consensus.Shelley.Ledger.Query.Types
import Ouroboros.Consensus.Shelley.Protocol.TPraos ()
import Ouroboros.Consensus.Storage.Serialisation
import Ouroboros.Consensus.Util.Time (secondsToNominalDiffTime)
import Ouroboros.Network.Block (Serialised (..))
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
  , 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

fromShelleyLedgerExamples ::
  ShelleyCompatible (TPraos StandardCrypto) era =>
  ProtocolLedgerExamples (SL.BHeader StandardCrypto) era ->
  Examples (ShelleyBlock (TPraos StandardCrypto) era)
fromShelleyLedgerExamples :: forall era.
ShelleyCompatible (TPraos StandardCrypto) era =>
ProtocolLedgerExamples (BHeader StandardCrypto) era
-> Examples (ShelleyBlock (TPraos StandardCrypto) era)
fromShelleyLedgerExamples
  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)
forall {a}. Serialised a
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)
forall {proto} {era}. SerialisedHeader (ShelleyBlock proto 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)))
forall {proto} {era}.
Labelled (SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))
queries
      , 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
    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 HASH EraIndependentBlockHeader -> ShelleyHash
ShelleyHash (Hash HASH EraIndependentBlockHeader -> ShelleyHash)
-> Hash HASH EraIndependentBlockHeader -> ShelleyHash
forall a b. (a -> b) -> a -> b
$ HashHeader -> Hash HASH EraIndependentBlockHeader
SL.unHashHeader HashHeader
pleHashHeader
    serialisedBlock :: Serialised a
serialisedBlock = ByteString -> Serialised a
forall {k} (a :: k). ByteString -> Serialised a
Serialised ByteString
"<BLOCK>"
    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
$ NestedCtxt
  Header (ShelleyBlock proto era) (Header (ShelleyBlock proto era))
-> Serialised (Header (ShelleyBlock proto era))
-> GenDepPair
     Serialised (NestedCtxt Header (ShelleyBlock proto era))
forall {k} (f :: k -> *) (a :: k) (g :: k -> *).
f a -> g a -> GenDepPair g f
GenDepPair (NestedCtxt_
  (ShelleyBlock proto era) Header (Header (ShelleyBlock proto era))
-> NestedCtxt
     Header (ShelleyBlock proto era) (Header (ShelleyBlock proto era))
forall (f :: * -> *) blk a.
NestedCtxt_ blk f a -> NestedCtxt f blk a
NestedCtxt NestedCtxt_
  (ShelleyBlock proto era) Header (Header (ShelleyBlock proto era))
forall proto era (f :: * -> *).
NestedCtxt_ (ShelleyBlock proto era) f (f (ShelleyBlock proto era))
CtxtShelley) (ByteString -> Serialised (Header (ShelleyBlock proto era))
forall {k} (a :: k). ByteString -> Serialised a
Serialised ByteString
"<HEADER>")
    queries :: Labelled (SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))
queries =
      [(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
"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
"GetStakeDistribution", BlockQuery
  (ShelleyBlock proto era)
  'QFNoTables
  (PoolDistr (ProtoCrypto 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
  (PoolDistr (ProtoCrypto proto))
forall proto era.
BlockQuery
  (ShelleyBlock proto era)
  'QFNoTables
  (PoolDistr (ProtoCrypto proto))
GetStakeDistribution)
        , (String
"GetNonMyopicMemberRewards", BlockQuery
  (ShelleyBlock proto era) 'QFNoTables NonMyopicMemberRewards
-> SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
forall (q :: QueryFootprint -> * -> *)
       (footprint :: QueryFootprint) result.
SingI footprint =>
q footprint result -> SomeBlockQuery q
SomeBlockQuery (BlockQuery
   (ShelleyBlock proto era) 'QFNoTables NonMyopicMemberRewards
 -> SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))
-> BlockQuery
     (ShelleyBlock proto era) 'QFNoTables NonMyopicMemberRewards
-> SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
forall a b. (a -> b) -> a -> b
$ Set (Either Coin (Credential Staking))
-> BlockQuery
     (ShelleyBlock proto era) 'QFNoTables NonMyopicMemberRewards
forall proto era.
Set (Either Coin (Credential Staking))
-> BlockQuery
     (ShelleyBlock proto era) 'QFNoTables NonMyopicMemberRewards
GetNonMyopicMemberRewards Set (Either Coin (Credential Staking))
leRewardsCredentials)
        , (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
"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 (footprint :: QueryFootprint) result proto era
       (ledgerPeersKind :: LedgerPeersKind).
(footprint ~ 'QFNoTables,
 result ~ LedgerPeerSnapshot ledgerPeersKind) =>
SingLedgerPeersKind ledgerPeersKind
-> BlockQuery (ShelleyBlock proto era) footprint result
GetLedgerPeerSnapshot SingLedgerPeersKind BigLedgerPeers
SingBigLedgerPeers))
        , (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)
        ]
    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
"EpochNo", BlockQuery
  (ShelleyBlock (TPraos StandardCrypto) era) 'QFNoTables EpochNo
-> EpochNo -> 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 EpochNo
forall proto era.
BlockQuery (ShelleyBlock proto era) 'QFNoTables EpochNo
GetEpochNo (Word64 -> EpochNo
EpochNo Word64
10))
        , (String
"EmptyPParams", BlockQuery
  (ShelleyBlock (TPraos StandardCrypto) era)
  'QFNoTables
  (PParams era)
-> PParams 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
  (PParams era)
forall proto era.
BlockQuery (ShelleyBlock proto era) 'QFNoTables (PParams era)
GetCurrentPParams PParams era
lePParams)
        , (String
"StakeDistribution", BlockQuery
  (ShelleyBlock (TPraos StandardCrypto) era)
  'QFNoTables
  (PoolDistr StandardCrypto)
-> PoolDistr StandardCrypto
-> 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
  (PoolDistr StandardCrypto)
BlockQuery
  (ShelleyBlock (TPraos StandardCrypto) era)
  'QFNoTables
  (PoolDistr (ProtoCrypto (TPraos StandardCrypto)))
forall proto era.
BlockQuery
  (ShelleyBlock proto era)
  'QFNoTables
  (PoolDistr (ProtoCrypto proto))
GetStakeDistribution (PoolDistr StandardCrypto
 -> SomeResult (ShelleyBlock (TPraos StandardCrypto) era))
-> PoolDistr StandardCrypto
-> SomeResult (ShelleyBlock (TPraos StandardCrypto) era)
forall a b. (a -> b) -> a -> b
$ PoolDistr -> PoolDistr StandardCrypto
forall c. PoolDistr -> PoolDistr c
fromLedgerPoolDistr PoolDistr
lePoolDistr)
        ,
          ( String
"NonMyopicMemberRewards"
          , BlockQuery
  (ShelleyBlock (TPraos StandardCrypto) era)
  'QFNoTables
  NonMyopicMemberRewards
-> NonMyopicMemberRewards
-> SomeResult (ShelleyBlock (TPraos StandardCrypto) era)
forall result blk (fp :: QueryFootprint).
(Eq result, Show result, Typeable result) =>
BlockQuery blk fp result -> result -> SomeResult blk
SomeResult
              (Set (Either Coin (Credential Staking))
-> BlockQuery
     (ShelleyBlock (TPraos StandardCrypto) era)
     'QFNoTables
     NonMyopicMemberRewards
forall proto era.
Set (Either Coin (Credential Staking))
-> BlockQuery
     (ShelleyBlock proto era) 'QFNoTables NonMyopicMemberRewards
GetNonMyopicMemberRewards Set (Either Coin (Credential Staking))
forall a. Set a
Set.empty)
              (Map
  (Either Coin (Credential Staking)) (Map (KeyHash StakePool) Coin)
-> NonMyopicMemberRewards
NonMyopicMemberRewards (Map
   (Either Coin (Credential Staking)) (Map (KeyHash StakePool) Coin)
 -> NonMyopicMemberRewards)
-> Map
     (Either Coin (Credential Staking)) (Map (KeyHash StakePool) Coin)
-> NonMyopicMemberRewards
forall a b. (a -> b) -> a -> b
$ Map
  (Either Coin (Credential Staking)) (Map (KeyHash StakePool) Coin)
leNonMyopicRewards)
          )
        , (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 (footprint :: QueryFootprint) result proto era
       (ledgerPeersKind :: LedgerPeersKind).
(footprint ~ 'QFNoTables,
 result ~ LedgerPeerSnapshot ledgerPeersKind) =>
SingLedgerPeersKind ledgerPeersKind
-> BlockQuery (ShelleyBlock proto era) footprint result
GetLedgerPeerSnapshot SingLedgerPeersKind BigLedgerPeers
SingBigLedgerPeers)
              ( (WithOrigin SlotNo,
 [(AccPoolStake, (PoolStake, NonEmpty LedgerRelayAccessPoint))])
-> LedgerPeerSnapshot BigLedgerPeers
LedgerPeerSnapshotV2
                  ( SlotNo -> WithOrigin SlotNo
forall t. t -> WithOrigin t
NotOrigin SlotNo
slotNo
                  ,
                    [
                      ( 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
"StakeDistribution2", BlockQuery
  (ShelleyBlock (TPraos StandardCrypto) era) 'QFNoTables PoolDistr
-> PoolDistr
-> 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 PoolDistr
forall proto era.
BlockQuery (ShelleyBlock proto era) 'QFNoTables PoolDistr
GetStakeDistribution2 PoolDistr
lePoolDistr)
        ,
          ( 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

-- | TODO Factor this out into something nicer.
fromShelleyLedgerExamplesPraos ::
  forall era.
  ShelleyCompatible (Praos StandardCrypto) era =>
  ProtocolLedgerExamples (SL.BHeader StandardCrypto) era ->
  Examples (ShelleyBlock (Praos StandardCrypto) era)
fromShelleyLedgerExamplesPraos :: forall era.
ShelleyCompatible (Praos StandardCrypto) era =>
ProtocolLedgerExamples (BHeader StandardCrypto) era
-> Examples (ShelleyBlock (Praos StandardCrypto) era)
fromShelleyLedgerExamplesPraos
  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 (Praos StandardCrypto) era)
exampleBlock = ShelleyBlock (Praos StandardCrypto) era
-> Labelled (ShelleyBlock (Praos StandardCrypto) era)
forall a. a -> Labelled a
unlabelled ShelleyBlock (Praos StandardCrypto) era
blk
      , exampleSerialisedBlock :: Labelled (Serialised (ShelleyBlock (Praos StandardCrypto) era))
exampleSerialisedBlock = Serialised (ShelleyBlock (Praos StandardCrypto) era)
-> Labelled (Serialised (ShelleyBlock (Praos StandardCrypto) era))
forall a. a -> Labelled a
unlabelled Serialised (ShelleyBlock (Praos StandardCrypto) era)
forall {a}. Serialised a
serialisedBlock
      , exampleHeader :: Labelled (Header (ShelleyBlock (Praos StandardCrypto) era))
exampleHeader = Header (ShelleyBlock (Praos StandardCrypto) era)
-> Labelled (Header (ShelleyBlock (Praos StandardCrypto) era))
forall a. a -> Labelled a
unlabelled (Header (ShelleyBlock (Praos StandardCrypto) era)
 -> Labelled (Header (ShelleyBlock (Praos StandardCrypto) era)))
-> Header (ShelleyBlock (Praos StandardCrypto) era)
-> Labelled (Header (ShelleyBlock (Praos StandardCrypto) era))
forall a b. (a -> b) -> a -> b
$ ShelleyBlock (Praos StandardCrypto) era
-> Header (ShelleyBlock (Praos StandardCrypto) era)
forall blk. GetHeader blk => blk -> Header blk
getHeader ShelleyBlock (Praos StandardCrypto) era
blk
      , exampleSerialisedHeader :: Labelled
  (SerialisedHeader (ShelleyBlock (Praos StandardCrypto) era))
exampleSerialisedHeader = SerialisedHeader (ShelleyBlock (Praos StandardCrypto) era)
-> Labelled
     (SerialisedHeader (ShelleyBlock (Praos StandardCrypto) era))
forall a. a -> Labelled a
unlabelled SerialisedHeader (ShelleyBlock (Praos StandardCrypto) era)
forall {proto} {era}. SerialisedHeader (ShelleyBlock proto era)
serialisedHeader
      , exampleHeaderHash :: Labelled (HeaderHash (ShelleyBlock (Praos StandardCrypto) era))
exampleHeaderHash = ShelleyHash -> Labelled ShelleyHash
forall a. a -> Labelled a
unlabelled ShelleyHash
hash
      , exampleGenTx :: Labelled (GenTx (ShelleyBlock (Praos StandardCrypto) era))
exampleGenTx = GenTx (ShelleyBlock (Praos StandardCrypto) era)
-> Labelled (GenTx (ShelleyBlock (Praos StandardCrypto) era))
forall a. a -> Labelled a
unlabelled GenTx (ShelleyBlock (Praos StandardCrypto) era)
forall {proto}. GenTx (ShelleyBlock proto era)
tx
      , exampleGenTxId :: Labelled (GenTxId (ShelleyBlock (Praos StandardCrypto) era))
exampleGenTxId = GenTxId (ShelleyBlock (Praos StandardCrypto) era)
-> Labelled (GenTxId (ShelleyBlock (Praos StandardCrypto) era))
forall a. a -> Labelled a
unlabelled (GenTxId (ShelleyBlock (Praos StandardCrypto) era)
 -> Labelled (GenTxId (ShelleyBlock (Praos StandardCrypto) era)))
-> GenTxId (ShelleyBlock (Praos StandardCrypto) era)
-> Labelled (GenTxId (ShelleyBlock (Praos StandardCrypto) era))
forall a b. (a -> b) -> a -> b
$ GenTx (ShelleyBlock (Praos StandardCrypto) era)
-> GenTxId (ShelleyBlock (Praos StandardCrypto) era)
forall tx. HasTxId tx => tx -> TxId tx
txId GenTx (ShelleyBlock (Praos StandardCrypto) era)
forall {proto}. GenTx (ShelleyBlock proto era)
tx
      , exampleApplyTxErr :: Labelled (ApplyTxErr (ShelleyBlock (Praos StandardCrypto) era))
exampleApplyTxErr = ApplyTxError era -> Labelled (ApplyTxError era)
forall a. a -> Labelled a
unlabelled ApplyTxError era
leApplyTxError
      , exampleQuery :: Labelled
  (SomeBlockQuery
     (BlockQuery (ShelleyBlock (Praos StandardCrypto) era)))
exampleQuery = Labelled
  (SomeBlockQuery
     (BlockQuery (ShelleyBlock (Praos StandardCrypto) era)))
forall {proto} {era}.
Labelled (SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))
queries
      , exampleResult :: Labelled (SomeResult (ShelleyBlock (Praos StandardCrypto) era))
exampleResult = Labelled (SomeResult (ShelleyBlock (Praos StandardCrypto) era))
results
      , exampleAnnTip :: Labelled (AnnTip (ShelleyBlock (Praos StandardCrypto) era))
exampleAnnTip = AnnTip (ShelleyBlock (Praos StandardCrypto) era)
-> Labelled (AnnTip (ShelleyBlock (Praos StandardCrypto) era))
forall a. a -> Labelled a
unlabelled AnnTip (ShelleyBlock (Praos StandardCrypto) era)
annTip
      , exampleLedgerState :: Labelled
  (LedgerState (ShelleyBlock (Praos StandardCrypto) era) EmptyMK)
exampleLedgerState = LedgerState (ShelleyBlock (Praos StandardCrypto) era) EmptyMK
-> Labelled
     (LedgerState (ShelleyBlock (Praos StandardCrypto) era) EmptyMK)
forall a. a -> Labelled a
unlabelled LedgerState (ShelleyBlock (Praos StandardCrypto) era) EmptyMK
forall {proto}. LedgerState (ShelleyBlock proto era) EmptyMK
ledgerState
      , exampleChainDepState :: Labelled
  (ChainDepState
     (BlockProtocol (ShelleyBlock (Praos StandardCrypto) era)))
exampleChainDepState = PraosState -> Labelled PraosState
forall a. a -> Labelled a
unlabelled PraosState
chainDepState
      , exampleExtLedgerState :: Labelled
  (ExtLedgerState (ShelleyBlock (Praos StandardCrypto) era) EmptyMK)
exampleExtLedgerState = ExtLedgerState (ShelleyBlock (Praos StandardCrypto) era) EmptyMK
-> Labelled
     (ExtLedgerState (ShelleyBlock (Praos StandardCrypto) era) EmptyMK)
forall a. a -> Labelled a
unlabelled ExtLedgerState (ShelleyBlock (Praos StandardCrypto) era) EmptyMK
extLedgerState
      , exampleSlotNo :: Labelled SlotNo
exampleSlotNo = SlotNo -> Labelled SlotNo
forall a. a -> Labelled a
unlabelled SlotNo
slotNo
      , exampleLedgerConfig :: Labelled (LedgerConfig (ShelleyBlock (Praos StandardCrypto) era))
exampleLedgerConfig = ShelleyLedgerConfig era -> Labelled (ShelleyLedgerConfig era)
forall a. a -> Labelled a
unlabelled ShelleyLedgerConfig era
ledgerConfig
      }
   where
    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 (Praos StandardCrypto) era
blk =
      Block (ShelleyProtocolHeader (Praos StandardCrypto)) era
-> ShelleyBlock (Praos StandardCrypto) era
forall proto era.
ShelleyCompatible proto era =>
Block (ShelleyProtocolHeader proto) era -> ShelleyBlock proto era
mkShelleyBlock (Block (ShelleyProtocolHeader (Praos StandardCrypto)) era
 -> ShelleyBlock (Praos StandardCrypto) era)
-> Block (ShelleyProtocolHeader (Praos StandardCrypto)) era
-> ShelleyBlock (Praos StandardCrypto) era
forall a b. (a -> b) -> a -> b
$
        let SL.Block BHeader StandardCrypto
hdr1 BlockBody era
bdy = Block (BHeader StandardCrypto) era
pleBlock
         in Header StandardCrypto
-> BlockBody era -> Block (Header StandardCrypto) era
forall h era. h -> BlockBody era -> Block h era
SL.Block (BHeader StandardCrypto -> Header StandardCrypto
translateHeader BHeader StandardCrypto
hdr1) BlockBody era
bdy

    translateHeader :: SL.BHeader StandardCrypto -> Praos.Header StandardCrypto
    translateHeader :: BHeader StandardCrypto -> Header StandardCrypto
translateHeader (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 HeaderBody StandardCrypto
hBody SignedKES (Sum6KES Ed25519DSIGN HASH) (HeaderBody StandardCrypto)
SignedKES (KES StandardCrypto) (HeaderBody StandardCrypto)
hSig
     where
      hBody :: HeaderBody StandardCrypto
hBody =
        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 HASH EraIndependentBlockBody
hbBodyHash = BHBody StandardCrypto -> Hash HASH EraIndependentBlockBody
forall c. BHBody c -> Hash HASH 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
          }
      hSig :: SignedKES (Sum6KES Ed25519DSIGN HASH) (HeaderBody StandardCrypto)
hSig = SignedKES (Sum6KES Ed25519DSIGN HASH) (BHBody StandardCrypto)
-> SignedKES
     (Sum6KES Ed25519DSIGN HASH) (HeaderBody StandardCrypto)
forall a b. Coercible a b => a -> b
coerce SignedKES (Sum6KES Ed25519DSIGN HASH) (BHBody StandardCrypto)
SignedKES (KES StandardCrypto) (BHBody StandardCrypto)
bhSig
    hash :: ShelleyHash
hash = Hash HASH EraIndependentBlockHeader -> ShelleyHash
ShelleyHash (Hash HASH EraIndependentBlockHeader -> ShelleyHash)
-> Hash HASH EraIndependentBlockHeader -> ShelleyHash
forall a b. (a -> b) -> a -> b
$ HashHeader -> Hash HASH EraIndependentBlockHeader
SL.unHashHeader HashHeader
pleHashHeader
    serialisedBlock :: Serialised a
serialisedBlock = ByteString -> Serialised a
forall {k} (a :: k). ByteString -> Serialised a
Serialised ByteString
"<BLOCK>"
    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
$ NestedCtxt
  Header (ShelleyBlock proto era) (Header (ShelleyBlock proto era))
-> Serialised (Header (ShelleyBlock proto era))
-> GenDepPair
     Serialised (NestedCtxt Header (ShelleyBlock proto era))
forall {k} (f :: k -> *) (a :: k) (g :: k -> *).
f a -> g a -> GenDepPair g f
GenDepPair (NestedCtxt_
  (ShelleyBlock proto era) Header (Header (ShelleyBlock proto era))
-> NestedCtxt
     Header (ShelleyBlock proto era) (Header (ShelleyBlock proto era))
forall (f :: * -> *) blk a.
NestedCtxt_ blk f a -> NestedCtxt f blk a
NestedCtxt NestedCtxt_
  (ShelleyBlock proto era) Header (Header (ShelleyBlock proto era))
forall proto era (f :: * -> *).
NestedCtxt_ (ShelleyBlock proto era) f (f (ShelleyBlock proto era))
CtxtShelley) (ByteString -> Serialised (Header (ShelleyBlock proto era))
forall {k} (a :: k). ByteString -> Serialised a
Serialised ByteString
"<HEADER>")
    queries :: Labelled (SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))
queries =
      [(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
"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
"GetStakeDistribution", BlockQuery
  (ShelleyBlock proto era)
  'QFNoTables
  (PoolDistr (ProtoCrypto 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
  (PoolDistr (ProtoCrypto proto))
forall proto era.
BlockQuery
  (ShelleyBlock proto era)
  'QFNoTables
  (PoolDistr (ProtoCrypto proto))
GetStakeDistribution)
        , (String
"GetNonMyopicMemberRewards", BlockQuery
  (ShelleyBlock proto era) 'QFNoTables NonMyopicMemberRewards
-> SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
forall (q :: QueryFootprint -> * -> *)
       (footprint :: QueryFootprint) result.
SingI footprint =>
q footprint result -> SomeBlockQuery q
SomeBlockQuery (BlockQuery
   (ShelleyBlock proto era) 'QFNoTables NonMyopicMemberRewards
 -> SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))
-> BlockQuery
     (ShelleyBlock proto era) 'QFNoTables NonMyopicMemberRewards
-> SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
forall a b. (a -> b) -> a -> b
$ Set (Either Coin (Credential Staking))
-> BlockQuery
     (ShelleyBlock proto era) 'QFNoTables NonMyopicMemberRewards
forall proto era.
Set (Either Coin (Credential Staking))
-> BlockQuery
     (ShelleyBlock proto era) 'QFNoTables NonMyopicMemberRewards
GetNonMyopicMemberRewards Set (Either Coin (Credential Staking))
leRewardsCredentials)
        , (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
"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 (footprint :: QueryFootprint) result proto era
       (ledgerPeersKind :: LedgerPeersKind).
(footprint ~ 'QFNoTables,
 result ~ LedgerPeerSnapshot ledgerPeersKind) =>
SingLedgerPeersKind ledgerPeersKind
-> BlockQuery (ShelleyBlock proto era) footprint result
GetLedgerPeerSnapshot SingLedgerPeersKind BigLedgerPeers
SingBigLedgerPeers))
        , (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)
        ]
    results :: Labelled (SomeResult (ShelleyBlock (Praos StandardCrypto) era))
results =
      [(String, SomeResult (ShelleyBlock (Praos StandardCrypto) era))]
-> Labelled (SomeResult (ShelleyBlock (Praos StandardCrypto) era))
forall a. [(String, a)] -> Labelled a
labelled
        [ (String
"LedgerTip", BlockQuery
  (ShelleyBlock (Praos StandardCrypto) era)
  'QFNoTables
  (Point (ShelleyBlock (Praos StandardCrypto) era))
-> Point (ShelleyBlock (Praos StandardCrypto) era)
-> SomeResult (ShelleyBlock (Praos StandardCrypto) era)
forall result blk (fp :: QueryFootprint).
(Eq result, Show result, Typeable result) =>
BlockQuery blk fp result -> result -> SomeResult blk
SomeResult BlockQuery
  (ShelleyBlock (Praos StandardCrypto) era)
  'QFNoTables
  (Point (ShelleyBlock (Praos StandardCrypto) era))
forall proto era.
BlockQuery
  (ShelleyBlock proto era)
  'QFNoTables
  (Point (ShelleyBlock proto era))
GetLedgerTip (ShelleyBlock (Praos StandardCrypto) era
-> Point (ShelleyBlock (Praos StandardCrypto) era)
forall block. HasHeader block => block -> Point block
blockPoint ShelleyBlock (Praos StandardCrypto) era
blk))
        , (String
"EpochNo", BlockQuery
  (ShelleyBlock (Praos StandardCrypto) era) 'QFNoTables EpochNo
-> EpochNo -> SomeResult (ShelleyBlock (Praos StandardCrypto) era)
forall result blk (fp :: QueryFootprint).
(Eq result, Show result, Typeable result) =>
BlockQuery blk fp result -> result -> SomeResult blk
SomeResult BlockQuery
  (ShelleyBlock (Praos StandardCrypto) era) 'QFNoTables EpochNo
forall proto era.
BlockQuery (ShelleyBlock proto era) 'QFNoTables EpochNo
GetEpochNo (Word64 -> EpochNo
EpochNo Word64
10))
        , (String
"EmptyPParams", BlockQuery
  (ShelleyBlock (Praos StandardCrypto) era) 'QFNoTables (PParams era)
-> PParams era
-> SomeResult (ShelleyBlock (Praos StandardCrypto) era)
forall result blk (fp :: QueryFootprint).
(Eq result, Show result, Typeable result) =>
BlockQuery blk fp result -> result -> SomeResult blk
SomeResult BlockQuery
  (ShelleyBlock (Praos StandardCrypto) era) 'QFNoTables (PParams era)
forall proto era.
BlockQuery (ShelleyBlock proto era) 'QFNoTables (PParams era)
GetCurrentPParams PParams era
lePParams)
        , (String
"StakeDistribution", BlockQuery
  (ShelleyBlock (Praos StandardCrypto) era)
  'QFNoTables
  (PoolDistr StandardCrypto)
-> PoolDistr StandardCrypto
-> SomeResult (ShelleyBlock (Praos StandardCrypto) era)
forall result blk (fp :: QueryFootprint).
(Eq result, Show result, Typeable result) =>
BlockQuery blk fp result -> result -> SomeResult blk
SomeResult BlockQuery
  (ShelleyBlock (Praos StandardCrypto) era)
  'QFNoTables
  (PoolDistr StandardCrypto)
BlockQuery
  (ShelleyBlock (Praos StandardCrypto) era)
  'QFNoTables
  (PoolDistr (ProtoCrypto (Praos StandardCrypto)))
forall proto era.
BlockQuery
  (ShelleyBlock proto era)
  'QFNoTables
  (PoolDistr (ProtoCrypto proto))
GetStakeDistribution (PoolDistr StandardCrypto
 -> SomeResult (ShelleyBlock (Praos StandardCrypto) era))
-> PoolDistr StandardCrypto
-> SomeResult (ShelleyBlock (Praos StandardCrypto) era)
forall a b. (a -> b) -> a -> b
$ PoolDistr -> PoolDistr StandardCrypto
forall c. PoolDistr -> PoolDistr c
fromLedgerPoolDistr PoolDistr
lePoolDistr)
        ,
          ( String
"NonMyopicMemberRewards"
          , BlockQuery
  (ShelleyBlock (Praos StandardCrypto) era)
  'QFNoTables
  NonMyopicMemberRewards
-> NonMyopicMemberRewards
-> SomeResult (ShelleyBlock (Praos StandardCrypto) era)
forall result blk (fp :: QueryFootprint).
(Eq result, Show result, Typeable result) =>
BlockQuery blk fp result -> result -> SomeResult blk
SomeResult
              (Set (Either Coin (Credential Staking))
-> BlockQuery
     (ShelleyBlock (Praos StandardCrypto) era)
     'QFNoTables
     NonMyopicMemberRewards
forall proto era.
Set (Either Coin (Credential Staking))
-> BlockQuery
     (ShelleyBlock proto era) 'QFNoTables NonMyopicMemberRewards
GetNonMyopicMemberRewards Set (Either Coin (Credential Staking))
forall a. Set a
Set.empty)
              (Map
  (Either Coin (Credential Staking)) (Map (KeyHash StakePool) Coin)
-> NonMyopicMemberRewards
NonMyopicMemberRewards (Map
   (Either Coin (Credential Staking)) (Map (KeyHash StakePool) Coin)
 -> NonMyopicMemberRewards)
-> Map
     (Either Coin (Credential Staking)) (Map (KeyHash StakePool) Coin)
-> NonMyopicMemberRewards
forall a b. (a -> b) -> a -> b
$ Map
  (Either Coin (Credential Staking)) (Map (KeyHash StakePool) Coin)
leNonMyopicRewards)
          )
        , (String
"GenesisConfig", BlockQuery
  (ShelleyBlock (Praos StandardCrypto) era)
  'QFNoTables
  CompactGenesis
-> CompactGenesis
-> SomeResult (ShelleyBlock (Praos StandardCrypto) era)
forall result blk (fp :: QueryFootprint).
(Eq result, Show result, Typeable result) =>
BlockQuery blk fp result -> result -> SomeResult blk
SomeResult BlockQuery
  (ShelleyBlock (Praos StandardCrypto) era)
  'QFNoTables
  CompactGenesis
forall proto era.
BlockQuery (ShelleyBlock proto era) 'QFNoTables CompactGenesis
GetGenesisConfig (ShelleyGenesis -> CompactGenesis
compactGenesis ShelleyGenesis
leShelleyGenesis))
        ,
          ( String
"GetBigLedgerPeerSnapshot"
          , BlockQuery
  (ShelleyBlock (Praos StandardCrypto) era)
  'QFNoTables
  (LedgerPeerSnapshot BigLedgerPeers)
-> LedgerPeerSnapshot BigLedgerPeers
-> SomeResult (ShelleyBlock (Praos 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 (Praos StandardCrypto) era)
     'QFNoTables
     (LedgerPeerSnapshot BigLedgerPeers)
forall (footprint :: QueryFootprint) result proto era
       (ledgerPeersKind :: LedgerPeersKind).
(footprint ~ 'QFNoTables,
 result ~ LedgerPeerSnapshot ledgerPeersKind) =>
SingLedgerPeersKind ledgerPeersKind
-> BlockQuery (ShelleyBlock proto era) footprint result
GetLedgerPeerSnapshot SingLedgerPeersKind BigLedgerPeers
SingBigLedgerPeers)
              ( (WithOrigin SlotNo,
 [(AccPoolStake, (PoolStake, NonEmpty LedgerRelayAccessPoint))])
-> LedgerPeerSnapshot BigLedgerPeers
LedgerPeerSnapshotV2
                  ( SlotNo -> WithOrigin SlotNo
forall t. t -> WithOrigin t
NotOrigin SlotNo
slotNo
                  ,
                    [
                      ( 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
"StakeDistribution2", BlockQuery
  (ShelleyBlock (Praos StandardCrypto) era) 'QFNoTables PoolDistr
-> PoolDistr
-> SomeResult (ShelleyBlock (Praos StandardCrypto) era)
forall result blk (fp :: QueryFootprint).
(Eq result, Show result, Typeable result) =>
BlockQuery blk fp result -> result -> SomeResult blk
SomeResult BlockQuery
  (ShelleyBlock (Praos StandardCrypto) era) 'QFNoTables PoolDistr
forall proto era.
BlockQuery (ShelleyBlock proto era) 'QFNoTables PoolDistr
GetStakeDistribution2 PoolDistr
lePoolDistr)
        ,
          ( String
"MaxMajorProtocolVersion"
          , BlockQuery
  (ShelleyBlock (Praos StandardCrypto) era)
  'QFNoTables
  MaxMajorProtVer
-> MaxMajorProtVer
-> SomeResult (ShelleyBlock (Praos StandardCrypto) era)
forall result blk (fp :: QueryFootprint).
(Eq result, Show result, Typeable result) =>
BlockQuery blk fp result -> result -> SomeResult blk
SomeResult BlockQuery
  (ShelleyBlock (Praos StandardCrypto) era)
  'QFNoTables
  MaxMajorProtVer
forall proto era.
BlockQuery (ShelleyBlock proto era) 'QFNoTables MaxMajorProtVer
GetMaxMajorProtocolVersion (MaxMajorProtVer
 -> SomeResult (ShelleyBlock (Praos StandardCrypto) era))
-> MaxMajorProtVer
-> SomeResult (ShelleyBlock (Praos StandardCrypto) era)
forall a b. (a -> b) -> a -> b
$ Version -> MaxMajorProtVer
MaxMajorProtVer (forall a. Bounded a => a
maxBound @SL.Version)
          )
        ]
    annTip :: AnnTip (ShelleyBlock (Praos StandardCrypto) era)
annTip =
      AnnTip
        { annTipSlotNo :: SlotNo
annTipSlotNo = Word64 -> SlotNo
SlotNo Word64
14
        , annTipBlockNo :: BlockNo
annTipBlockNo = Word64 -> BlockNo
BlockNo Word64
6
        , annTipInfo :: TipInfo (ShelleyBlock (Praos StandardCrypto) era)
annTipInfo = TipInfo (ShelleyBlock (Praos 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 = LedgerTables (ShelleyBlock proto era) EmptyMK
forall (mk :: MapKind) blk.
(ZeroableMK mk, LedgerTableConstraints blk) =>
LedgerTables blk mk
emptyLedgerTables
        }
    chainDepState :: ChainDepState (Praos StandardCrypto)
chainDepState =
      Proxy (TPraos StandardCrypto, Praos StandardCrypto)
-> ChainDepState (TPraos StandardCrypto)
-> ChainDepState (Praos StandardCrypto)
forall protoFrom protoTo.
TranslateProto protoFrom protoTo =>
Proxy (protoFrom, protoTo)
-> ChainDepState protoFrom -> ChainDepState protoTo
translateChainDepState (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(TPraos StandardCrypto, Praos StandardCrypto)) (ChainDepState (TPraos StandardCrypto)
 -> ChainDepState (Praos StandardCrypto))
-> ChainDepState (TPraos StandardCrypto)
-> ChainDepState (Praos StandardCrypto)
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 (Praos StandardCrypto) era) EmptyMK
extLedgerState =
      let headerState :: HeaderState (ShelleyBlock (Praos StandardCrypto) era)
headerState = ChainDepState
  (BlockProtocol (ShelleyBlock (Praos StandardCrypto) era))
-> HeaderState (ShelleyBlock (Praos StandardCrypto) era)
forall blk. ChainDepState (BlockProtocol blk) -> HeaderState blk
genesisHeaderState ChainDepState
  (BlockProtocol (ShelleyBlock (Praos StandardCrypto) era))
PraosState
chainDepState
          perasState :: PerasState (ShelleyBlock (Praos StandardCrypto) era)
perasState = LedgerConfig (ShelleyBlock (Praos StandardCrypto) era)
-> LedgerState (ShelleyBlock (Praos StandardCrypto) era) EmptyMK
-> HeaderState (ShelleyBlock (Praos StandardCrypto) era)
-> PerasState (ShelleyBlock (Praos 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 (Praos StandardCrypto) era)
ShelleyLedgerConfig era
ledgerConfig LedgerState (ShelleyBlock (Praos StandardCrypto) era) EmptyMK
forall {proto}. LedgerState (ShelleyBlock proto era) EmptyMK
ledgerState HeaderState (ShelleyBlock (Praos StandardCrypto) era)
headerState
       in ExtLedgerState
            { LedgerState (ShelleyBlock (Praos StandardCrypto) era) EmptyMK
forall {proto}. LedgerState (ShelleyBlock proto era) EmptyMK
ledgerState :: LedgerState (ShelleyBlock (Praos StandardCrypto) era) EmptyMK
ledgerState :: forall {proto}. LedgerState (ShelleyBlock proto era) EmptyMK
ledgerState
            , HeaderState (ShelleyBlock (Praos StandardCrypto) era)
headerState :: HeaderState (ShelleyBlock (Praos StandardCrypto) era)
headerState :: HeaderState (ShelleyBlock (Praos StandardCrypto) era)
headerState
            , PerasState (ShelleyBlock (Praos StandardCrypto) era)
perasState :: PerasState (ShelleyBlock (Praos StandardCrypto) era)
perasState :: PerasState (ShelleyBlock (Praos StandardCrypto) era)
perasState
            }

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

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

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

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

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

examplesBabbage :: Examples StandardBabbageBlock
examplesBabbage :: Examples StandardBabbageBlock
examplesBabbage = ProtocolLedgerExamples (BHeader StandardCrypto) BabbageEra
-> Examples StandardBabbageBlock
forall era.
ShelleyCompatible (Praos StandardCrypto) era =>
ProtocolLedgerExamples (BHeader StandardCrypto) era
-> Examples (ShelleyBlock (Praos StandardCrypto) era)
fromShelleyLedgerExamplesPraos (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 = ProtocolLedgerExamples (BHeader StandardCrypto) ConwayEra
-> Examples StandardConwayBlock
forall era.
ShelleyCompatible (Praos StandardCrypto) era =>
ProtocolLedgerExamples (BHeader StandardCrypto) era
-> Examples (ShelleyBlock (Praos StandardCrypto) era)
fromShelleyLedgerExamplesPraos (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 StandardDijkstraBlock
examplesDijkstra = ProtocolLedgerExamples (BHeader StandardCrypto) DijkstraEra
-> Examples StandardDijkstraBlock
forall era.
ShelleyCompatible (Praos StandardCrypto) era =>
ProtocolLedgerExamples (BHeader StandardCrypto) era
-> Examples (ShelleyBlock (Praos StandardCrypto) era)
fromShelleyLedgerExamplesPraos (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)