{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# 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.Core as LC
import qualified Cardano.Ledger.Shelley.API as SL
import Cardano.Protocol.Crypto (StandardCrypto)
import qualified Cardano.Protocol.TPraos.BHeader as SL
import Cardano.Slotting.EpochInfo (fixedEpochInfo)
import Cardano.Slotting.Time (mkSlotLength)
import Data.Coerce (coerce)
import Data.Foldable (toList)
import Data.List.NonEmpty (NonEmpty ((:|)))
import qualified Data.Map as Map
import qualified Data.Set as Set
import Lens.Micro
import Ouroboros.Consensus.Block
import Ouroboros.Consensus.HeaderValidation
import Ouroboros.Consensus.Ledger.Extended
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.Praos.Header
  ( HeaderBody (HeaderBody)
  )
import qualified Ouroboros.Consensus.Protocol.Praos.Header as Praos
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

mkLedgerTables ::
  forall proto era.
  ShelleyCompatible proto era =>
  LC.Tx era ->
  LedgerTables (LedgerState (ShelleyBlock proto era)) ValuesMK
mkLedgerTables :: forall proto era.
ShelleyCompatible proto era =>
Tx era
-> LedgerTables (LedgerState (ShelleyBlock proto era)) ValuesMK
mkLedgerTables Tx era
tx =
  ValuesMK
  (TxIn (LedgerState (ShelleyBlock proto era)))
  (TxOut (LedgerState (ShelleyBlock proto era)))
-> LedgerTables (LedgerState (ShelleyBlock proto era)) ValuesMK
forall (l :: LedgerStateKind) (mk :: MapKind).
mk (TxIn l) (TxOut l) -> LedgerTables l mk
LedgerTables (ValuesMK
   (TxIn (LedgerState (ShelleyBlock proto era)))
   (TxOut (LedgerState (ShelleyBlock proto era)))
 -> LedgerTables (LedgerState (ShelleyBlock proto era)) ValuesMK)
-> ValuesMK
     (TxIn (LedgerState (ShelleyBlock proto era)))
     (TxOut (LedgerState (ShelleyBlock proto era)))
-> LedgerTables (LedgerState (ShelleyBlock proto era)) ValuesMK
forall a b. (a -> b) -> a -> b
$
    Map
  (TxIn (LedgerState (ShelleyBlock proto era)))
  (TxOut (LedgerState (ShelleyBlock proto era)))
-> ValuesMK
     (TxIn (LedgerState (ShelleyBlock proto era)))
     (TxOut (LedgerState (ShelleyBlock proto era)))
forall k v. Map k v -> ValuesMK k v
ValuesMK (Map
   (TxIn (LedgerState (ShelleyBlock proto era)))
   (TxOut (LedgerState (ShelleyBlock proto era)))
 -> ValuesMK
      (TxIn (LedgerState (ShelleyBlock proto era)))
      (TxOut (LedgerState (ShelleyBlock proto era))))
-> Map
     (TxIn (LedgerState (ShelleyBlock proto era)))
     (TxOut (LedgerState (ShelleyBlock proto era)))
-> ValuesMK
     (TxIn (LedgerState (ShelleyBlock proto era)))
     (TxOut (LedgerState (ShelleyBlock proto era)))
forall a b. (a -> b) -> a -> b
$
      [(TxIn (LedgerState (ShelleyBlock proto era)),
  TxOut (LedgerState (ShelleyBlock proto era)))]
-> Map
     (TxIn (LedgerState (ShelleyBlock proto era)))
     (TxOut (LedgerState (ShelleyBlock proto era)))
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(TxIn (LedgerState (ShelleyBlock proto era)),
   TxOut (LedgerState (ShelleyBlock proto era)))]
 -> Map
      (TxIn (LedgerState (ShelleyBlock proto era)))
      (TxOut (LedgerState (ShelleyBlock proto era))))
-> [(TxIn (LedgerState (ShelleyBlock proto era)),
     TxOut (LedgerState (ShelleyBlock proto era)))]
-> Map
     (TxIn (LedgerState (ShelleyBlock proto era)))
     (TxOut (LedgerState (ShelleyBlock proto era)))
forall a b. (a -> b) -> a -> b
$
        [TxIn] -> [TxOut era] -> [(TxIn, TxOut era)]
forall a b. [a] -> [b] -> [(a, b)]
zip [TxIn]
exampleTxIns [TxOut era]
exampleTxOuts
 where
  exampleTxIns :: [SL.TxIn]
  exampleTxIns :: [TxIn]
exampleTxIns = case Set TxIn -> [TxIn]
forall a. Set a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Tx era
tx Tx era -> Getting (Set TxIn) (Tx era) (Set TxIn) -> Set TxIn
forall s a. s -> Getting a s a -> a
^. ((TxBody era -> Const (Set TxIn) (TxBody era))
-> Tx era -> Const (Set TxIn) (Tx era)
forall era. EraTx era => Lens' (Tx era) (TxBody era)
Lens' (Tx era) (TxBody era)
LC.bodyTxL ((TxBody era -> Const (Set TxIn) (TxBody era))
 -> Tx era -> Const (Set TxIn) (Tx era))
-> ((Set TxIn -> Const (Set TxIn) (Set TxIn))
    -> TxBody era -> Const (Set TxIn) (TxBody era))
-> Getting (Set TxIn) (Tx era) (Set TxIn)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Set TxIn -> Const (Set TxIn) (Set TxIn))
-> TxBody era -> Const (Set TxIn) (TxBody era)
forall era. EraTxBody era => SimpleGetter (TxBody era) (Set TxIn)
SimpleGetter (TxBody era) (Set TxIn)
LC.allInputsTxBodyF)) of
    [] -> [Char] -> [TxIn]
forall a. HasCallStack => [Char] -> a
error [Char]
"No transaction inputs were provided to construct the ledger tables"
    -- We require at least one transaction input (and one
    -- transaction output) in the example provided by
    -- cardano-ledger to make sure that we test the serialization
    -- of ledger tables with at least one non-trivial example.
    --
    -- Also all transactions in Cardano have at least one input for
    -- automatic replay protection.
    [TxIn]
xs -> [TxIn]
xs

  exampleTxOuts :: [LC.TxOut era]
  exampleTxOuts :: [TxOut era]
exampleTxOuts = case StrictSeq (TxOut era) -> [TxOut era]
forall a. StrictSeq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Tx era
tx Tx era
-> Getting (StrictSeq (TxOut era)) (Tx era) (StrictSeq (TxOut era))
-> StrictSeq (TxOut era)
forall s a. s -> Getting a s a -> a
^. ((TxBody era -> Const (StrictSeq (TxOut era)) (TxBody era))
-> Tx era -> Const (StrictSeq (TxOut era)) (Tx era)
forall era. EraTx era => Lens' (Tx era) (TxBody era)
Lens' (Tx era) (TxBody era)
LC.bodyTxL ((TxBody era -> Const (StrictSeq (TxOut era)) (TxBody era))
 -> Tx era -> Const (StrictSeq (TxOut era)) (Tx era))
-> ((StrictSeq (TxOut era)
     -> Const (StrictSeq (TxOut era)) (StrictSeq (TxOut era)))
    -> TxBody era -> Const (StrictSeq (TxOut era)) (TxBody era))
-> Getting (StrictSeq (TxOut era)) (Tx era) (StrictSeq (TxOut era))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StrictSeq (TxOut era)
 -> Const (StrictSeq (TxOut era)) (StrictSeq (TxOut era)))
-> TxBody era -> Const (StrictSeq (TxOut era)) (TxBody era)
forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxOut era))
Lens' (TxBody era) (StrictSeq (TxOut era))
LC.outputsTxBodyL)) of
    [] -> [Char] -> [TxOut era]
forall a. HasCallStack => [Char] -> a
error [Char]
"No transaction outputs were provided to construct the ledger tables"
    [TxOut era]
xs -> [TxOut era]
xs

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 era
PParams era
TranslationContext era
PoolDistr
ProposedPPUpdates era
ShelleyGenesis
NewEpochState era
ApplyTxError era
leTx :: Tx 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
leShelleyGenesis :: forall era. LedgerExamples era -> ShelleyGenesis
leTranslationContext :: forall era. LedgerExamples era -> TranslationContext era
leNonMyopicRewards :: forall era.
LedgerExamples era
-> Map
     (Either Coin (Credential 'Staking)) (Map (KeyHash 'StakePool) Coin)
leRewardsCredentials :: forall era.
LedgerExamples era -> Set (Either Coin (Credential 'Staking))
lePoolDistr :: forall era. LedgerExamples era -> PoolDistr
leNewEpochState :: forall era. LedgerExamples era -> NewEpochState era
leProposedPPUpdates :: forall era. LedgerExamples era -> ProposedPPUpdates era
lePParams :: forall era. LedgerExamples era -> PParams era
leApplyTxError :: forall era. LedgerExamples era -> ApplyTxError era
leTx :: forall era. LedgerExamples era -> Tx 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
pleChainDepState :: forall bh era. ProtocolLedgerExamples bh era -> ChainDepState
pleBlockHeader :: forall bh era. ProtocolLedgerExamples bh era -> bh
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)
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)
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
      , 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
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
      , exampleLedgerTables :: Labelled
  (LedgerTables
     (LedgerState (ShelleyBlock (TPraos StandardCrypto) era)) ValuesMK)
exampleLedgerTables = LedgerTables
  (LedgerState (ShelleyBlock (TPraos StandardCrypto) era)) ValuesMK
-> Labelled
     (LedgerTables
        (LedgerState (ShelleyBlock (TPraos StandardCrypto) era)) ValuesMK)
forall a. a -> Labelled a
unlabelled (LedgerTables
   (LedgerState (ShelleyBlock (TPraos StandardCrypto) era)) ValuesMK
 -> Labelled
      (LedgerTables
         (LedgerState (ShelleyBlock (TPraos StandardCrypto) era)) ValuesMK))
-> LedgerTables
     (LedgerState (ShelleyBlock (TPraos StandardCrypto) era)) ValuesMK
-> Labelled
     (LedgerTables
        (LedgerState (ShelleyBlock (TPraos StandardCrypto) era)) ValuesMK)
forall a b. (a -> b) -> a -> b
$ Tx era
-> LedgerTables
     (LedgerState (ShelleyBlock (TPraos StandardCrypto) era)) ValuesMK
forall proto era.
ShelleyCompatible proto era =>
Tx era
-> LedgerTables (LedgerState (ShelleyBlock proto era)) ValuesMK
mkLedgerTables Tx era
leTx
      }
   where
    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 (TPraos StandardCrypto) era)
tx = Tx era -> GenTx (ShelleyBlock (TPraos StandardCrypto) era)
forall era proto.
ShelleyBasedEra era =>
Tx era -> GenTx (ShelleyBlock proto era)
mkShelleyTx Tx era
leTx
    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 (TPraos StandardCrypto) era)))
queries =
      [([Char],
  SomeBlockQuery
    (BlockQuery (ShelleyBlock (TPraos StandardCrypto) era)))]
-> Labelled
     (SomeBlockQuery
        (BlockQuery (ShelleyBlock (TPraos StandardCrypto) era)))
forall a. [([Char], a)] -> Labelled a
labelled
        [ ([Char]
"GetLedgerTip", BlockQuery
  (ShelleyBlock (TPraos StandardCrypto) era)
  'QFNoTables
  (Point (ShelleyBlock (TPraos StandardCrypto) era))
-> SomeBlockQuery
     (BlockQuery (ShelleyBlock (TPraos StandardCrypto) era))
forall (q :: QueryFootprint -> * -> *)
       (footprint :: QueryFootprint) result.
SingI footprint =>
q footprint result -> SomeBlockQuery q
SomeBlockQuery BlockQuery
  (ShelleyBlock (TPraos StandardCrypto) era)
  'QFNoTables
  (Point (ShelleyBlock (TPraos StandardCrypto) era))
forall proto era.
BlockQuery
  (ShelleyBlock proto era)
  'QFNoTables
  (Point (ShelleyBlock proto era))
GetLedgerTip)
        , ([Char]
"GetEpochNo", BlockQuery
  (ShelleyBlock (TPraos StandardCrypto) era) 'QFNoTables EpochNo
-> SomeBlockQuery
     (BlockQuery (ShelleyBlock (TPraos StandardCrypto) era))
forall (q :: QueryFootprint -> * -> *)
       (footprint :: QueryFootprint) result.
SingI footprint =>
q footprint result -> SomeBlockQuery q
SomeBlockQuery BlockQuery
  (ShelleyBlock (TPraos StandardCrypto) era) 'QFNoTables EpochNo
forall proto era.
BlockQuery (ShelleyBlock proto era) 'QFNoTables EpochNo
GetEpochNo)
        , ([Char]
"GetCurrentPParams", BlockQuery
  (ShelleyBlock (TPraos StandardCrypto) era)
  'QFNoTables
  (PParams era)
-> SomeBlockQuery
     (BlockQuery (ShelleyBlock (TPraos StandardCrypto) era))
forall (q :: QueryFootprint -> * -> *)
       (footprint :: QueryFootprint) result.
SingI footprint =>
q footprint result -> SomeBlockQuery q
SomeBlockQuery BlockQuery
  (ShelleyBlock (TPraos StandardCrypto) era)
  'QFNoTables
  (PParams era)
forall proto era.
BlockQuery (ShelleyBlock proto era) 'QFNoTables (PParams era)
GetCurrentPParams)
        , ([Char]
"GetStakeDistribution", BlockQuery
  (ShelleyBlock (TPraos StandardCrypto) era)
  'QFNoTables
  (PoolDistr StandardCrypto)
-> SomeBlockQuery
     (BlockQuery (ShelleyBlock (TPraos StandardCrypto) era))
forall (q :: QueryFootprint -> * -> *)
       (footprint :: QueryFootprint) result.
SingI footprint =>
q footprint result -> SomeBlockQuery q
SomeBlockQuery 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)
        , ([Char]
"GetNonMyopicMemberRewards", BlockQuery
  (ShelleyBlock (TPraos StandardCrypto) era)
  'QFNoTables
  NonMyopicMemberRewards
-> SomeBlockQuery
     (BlockQuery (ShelleyBlock (TPraos StandardCrypto) era))
forall (q :: QueryFootprint -> * -> *)
       (footprint :: QueryFootprint) result.
SingI footprint =>
q footprint result -> SomeBlockQuery q
SomeBlockQuery (BlockQuery
   (ShelleyBlock (TPraos StandardCrypto) era)
   'QFNoTables
   NonMyopicMemberRewards
 -> SomeBlockQuery
      (BlockQuery (ShelleyBlock (TPraos StandardCrypto) era)))
-> BlockQuery
     (ShelleyBlock (TPraos StandardCrypto) era)
     'QFNoTables
     NonMyopicMemberRewards
-> SomeBlockQuery
     (BlockQuery (ShelleyBlock (TPraos StandardCrypto) era))
forall a b. (a -> b) -> a -> b
$ 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))
leRewardsCredentials)
        , ([Char]
"GetGenesisConfig", BlockQuery
  (ShelleyBlock (TPraos StandardCrypto) era)
  'QFNoTables
  CompactGenesis
-> SomeBlockQuery
     (BlockQuery (ShelleyBlock (TPraos StandardCrypto) era))
forall (q :: QueryFootprint -> * -> *)
       (footprint :: QueryFootprint) result.
SingI footprint =>
q footprint result -> SomeBlockQuery q
SomeBlockQuery BlockQuery
  (ShelleyBlock (TPraos StandardCrypto) era)
  'QFNoTables
  CompactGenesis
forall proto era.
BlockQuery (ShelleyBlock proto era) 'QFNoTables CompactGenesis
GetGenesisConfig)
        , ([Char]
"GetBigLedgerPeerSnapshot", BlockQuery
  (ShelleyBlock (TPraos StandardCrypto) era)
  'QFNoTables
  LedgerPeerSnapshot
-> SomeBlockQuery
     (BlockQuery (ShelleyBlock (TPraos StandardCrypto) era))
forall (q :: QueryFootprint -> * -> *)
       (footprint :: QueryFootprint) result.
SingI footprint =>
q footprint result -> SomeBlockQuery q
SomeBlockQuery BlockQuery
  (ShelleyBlock (TPraos StandardCrypto) era)
  'QFNoTables
  LedgerPeerSnapshot
forall proto era.
BlockQuery (ShelleyBlock proto era) 'QFNoTables LedgerPeerSnapshot
GetBigLedgerPeerSnapshot)
        , ([Char]
"GetStakeDistribution2", BlockQuery
  (ShelleyBlock (TPraos StandardCrypto) era) 'QFNoTables PoolDistr
-> SomeBlockQuery
     (BlockQuery (ShelleyBlock (TPraos StandardCrypto) era))
forall (q :: QueryFootprint -> * -> *)
       (footprint :: QueryFootprint) result.
SingI footprint =>
q footprint result -> SomeBlockQuery q
SomeBlockQuery BlockQuery
  (ShelleyBlock (TPraos StandardCrypto) era) 'QFNoTables PoolDistr
forall proto era.
BlockQuery (ShelleyBlock proto era) 'QFNoTables PoolDistr
GetStakeDistribution2)
        , ([Char]
"GetMaxMajorProtocolVersion", BlockQuery
  (ShelleyBlock (TPraos StandardCrypto) era)
  'QFNoTables
  MaxMajorProtVer
-> SomeBlockQuery
     (BlockQuery (ShelleyBlock (TPraos StandardCrypto) era))
forall (q :: QueryFootprint -> * -> *)
       (footprint :: QueryFootprint) result.
SingI footprint =>
q footprint result -> SomeBlockQuery q
SomeBlockQuery BlockQuery
  (ShelleyBlock (TPraos StandardCrypto) era)
  'QFNoTables
  MaxMajorProtVer
forall proto era.
BlockQuery (ShelleyBlock proto era) 'QFNoTables MaxMajorProtVer
GetMaxMajorProtocolVersion)
        ]
    results :: Labelled (SomeResult (ShelleyBlock (TPraos StandardCrypto) era))
results =
      [([Char], SomeResult (ShelleyBlock (TPraos StandardCrypto) era))]
-> Labelled (SomeResult (ShelleyBlock (TPraos StandardCrypto) era))
forall a. [([Char], a)] -> Labelled a
labelled
        [ ([Char]
"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))
        , ([Char]
"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))
        , ([Char]
"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)
        , ([Char]
"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)
        ,
          ( [Char]
"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)
          )
        , ([Char]
"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))
        ,
          ( [Char]
"GetBigLedgerPeerSnapshot"
          , BlockQuery
  (ShelleyBlock (TPraos StandardCrypto) era)
  'QFNoTables
  LedgerPeerSnapshot
-> LedgerPeerSnapshot
-> 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
  LedgerPeerSnapshot
forall proto era.
BlockQuery (ShelleyBlock proto era) 'QFNoTables LedgerPeerSnapshot
GetBigLedgerPeerSnapshot
              ( (WithOrigin SlotNo,
 [(AccPoolStake, (PoolStake, NonEmpty LedgerRelayAccessPoint))])
-> LedgerPeerSnapshot
LedgerPeerSnapshot
                  ( SlotNo -> WithOrigin SlotNo
forall t. t -> WithOrigin t
NotOrigin SlotNo
slotNo
                  ,
                    [
                      ( Rational -> AccPoolStake
AccPoolStake Rational
0.9
                      ,
                        ( Rational -> PoolStake
PoolStake Rational
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
:| []
                        )
                      )
                    ]
                  )
              )
          )
        , ([Char]
"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)
        ,
          ( [Char]
"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 (TPraos StandardCrypto) era) EmptyMK
ledgerState =
      ShelleyLedgerState
        { shelleyLedgerTip :: WithOrigin (ShelleyTip (TPraos StandardCrypto) era)
shelleyLedgerTip =
            ShelleyTip (TPraos StandardCrypto) era
-> WithOrigin (ShelleyTip (TPraos StandardCrypto) 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 (TPraos StandardCrypto) era)
shelleyTipHash = HeaderHash (ShelleyBlock (TPraos StandardCrypto) era)
ShelleyHash
hash
                }
        , shelleyLedgerState :: NewEpochState era
shelleyLedgerState = NewEpochState era
leNewEpochState
        , shelleyLedgerTransition :: ShelleyTransition
shelleyLedgerTransition = ShelleyTransitionInfo{shelleyAfterVoting :: Word32
shelleyAfterVoting = Word32
0}
        , shelleyLedgerTables :: LedgerTables
  (LedgerState (ShelleyBlock (TPraos StandardCrypto) era)) EmptyMK
shelleyLedgerTables = EmptyMK
  (TxIn (LedgerState (ShelleyBlock (TPraos StandardCrypto) era)))
  (TxOut (LedgerState (ShelleyBlock (TPraos StandardCrypto) era)))
-> LedgerTables
     (LedgerState (ShelleyBlock (TPraos StandardCrypto) era)) EmptyMK
forall (l :: LedgerStateKind) (mk :: MapKind).
mk (TxIn l) (TxOut l) -> LedgerTables l mk
LedgerTables EmptyMK TxIn (TxOut era)
EmptyMK
  (TxIn (LedgerState (ShelleyBlock (TPraos StandardCrypto) era)))
  (TxOut (LedgerState (ShelleyBlock (TPraos StandardCrypto) 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 =
      LedgerState (ShelleyBlock (TPraos StandardCrypto) era) EmptyMK
-> HeaderState (ShelleyBlock (TPraos StandardCrypto) era)
-> ExtLedgerState
     (ShelleyBlock (TPraos StandardCrypto) era) EmptyMK
forall blk (mk :: MapKind).
LedgerState blk mk -> HeaderState blk -> ExtLedgerState blk mk
ExtLedgerState
        LedgerState (ShelleyBlock (TPraos StandardCrypto) era) EmptyMK
ledgerState
        (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)

    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 era
PParams era
TranslationContext era
PoolDistr
ProposedPPUpdates era
ShelleyGenesis
NewEpochState era
ApplyTxError era
leShelleyGenesis :: forall era. LedgerExamples era -> ShelleyGenesis
leTranslationContext :: forall era. LedgerExamples era -> TranslationContext era
leNonMyopicRewards :: forall era.
LedgerExamples era
-> Map
     (Either Coin (Credential 'Staking)) (Map (KeyHash 'StakePool) Coin)
leRewardsCredentials :: forall era.
LedgerExamples era -> Set (Either Coin (Credential 'Staking))
lePoolDistr :: forall era. LedgerExamples era -> PoolDistr
leNewEpochState :: forall era. LedgerExamples era -> NewEpochState era
leProposedPPUpdates :: forall era. LedgerExamples era -> ProposedPPUpdates era
lePParams :: forall era. LedgerExamples era -> PParams era
leApplyTxError :: forall era. LedgerExamples era -> ApplyTxError era
leTx :: forall era. LedgerExamples era -> Tx era
leTx :: Tx 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
pleChainDepState :: forall bh era. ProtocolLedgerExamples bh era -> ChainDepState
pleBlockHeader :: forall bh era. ProtocolLedgerExamples bh era -> bh
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)
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)
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)))
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
ledgerState
      , exampleLedgerTables :: Labelled
  (LedgerTables
     (LedgerState (ShelleyBlock (Praos StandardCrypto) era)) ValuesMK)
exampleLedgerTables = LedgerTables
  (LedgerState (ShelleyBlock (Praos StandardCrypto) era)) ValuesMK
-> Labelled
     (LedgerTables
        (LedgerState (ShelleyBlock (Praos StandardCrypto) era)) ValuesMK)
forall a. a -> Labelled a
unlabelled (LedgerTables
   (LedgerState (ShelleyBlock (Praos StandardCrypto) era)) ValuesMK
 -> Labelled
      (LedgerTables
         (LedgerState (ShelleyBlock (Praos StandardCrypto) era)) ValuesMK))
-> LedgerTables
     (LedgerState (ShelleyBlock (Praos StandardCrypto) era)) ValuesMK
-> Labelled
     (LedgerTables
        (LedgerState (ShelleyBlock (Praos StandardCrypto) era)) ValuesMK)
forall a b. (a -> b) -> a -> b
$ Tx era
-> LedgerTables
     (LedgerState (ShelleyBlock (Praos StandardCrypto) era)) ValuesMK
forall proto era.
ShelleyCompatible proto era =>
Tx era
-> LedgerTables (LedgerState (ShelleyBlock proto era)) ValuesMK
mkLedgerTables Tx era
leTx
      , exampleChainDepState :: Labelled
  (ChainDepState
     (BlockProtocol (ShelleyBlock (Praos StandardCrypto) era)))
exampleChainDepState = PraosState -> Labelled PraosState
forall a. a -> Labelled a
unlabelled ChainDepState (Praos StandardCrypto)
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
    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 (Praos StandardCrypto) era)
tx = Tx era -> GenTx (ShelleyBlock (Praos StandardCrypto) era)
forall era proto.
ShelleyBasedEra era =>
Tx era -> GenTx (ShelleyBlock proto era)
mkShelleyTx Tx era
leTx
    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 (Praos StandardCrypto) era)))
queries =
      [([Char],
  SomeBlockQuery
    (BlockQuery (ShelleyBlock (Praos StandardCrypto) era)))]
-> Labelled
     (SomeBlockQuery
        (BlockQuery (ShelleyBlock (Praos StandardCrypto) era)))
forall a. [([Char], a)] -> Labelled a
labelled
        [ ([Char]
"GetLedgerTip", BlockQuery
  (ShelleyBlock (Praos StandardCrypto) era)
  'QFNoTables
  (Point (ShelleyBlock (Praos StandardCrypto) era))
-> SomeBlockQuery
     (BlockQuery (ShelleyBlock (Praos StandardCrypto) era))
forall (q :: QueryFootprint -> * -> *)
       (footprint :: QueryFootprint) result.
SingI footprint =>
q footprint result -> SomeBlockQuery q
SomeBlockQuery BlockQuery
  (ShelleyBlock (Praos StandardCrypto) era)
  'QFNoTables
  (Point (ShelleyBlock (Praos StandardCrypto) era))
forall proto era.
BlockQuery
  (ShelleyBlock proto era)
  'QFNoTables
  (Point (ShelleyBlock proto era))
GetLedgerTip)
        , ([Char]
"GetEpochNo", BlockQuery
  (ShelleyBlock (Praos StandardCrypto) era) 'QFNoTables EpochNo
-> SomeBlockQuery
     (BlockQuery (ShelleyBlock (Praos StandardCrypto) era))
forall (q :: QueryFootprint -> * -> *)
       (footprint :: QueryFootprint) result.
SingI footprint =>
q footprint result -> SomeBlockQuery q
SomeBlockQuery BlockQuery
  (ShelleyBlock (Praos StandardCrypto) era) 'QFNoTables EpochNo
forall proto era.
BlockQuery (ShelleyBlock proto era) 'QFNoTables EpochNo
GetEpochNo)
        , ([Char]
"GetCurrentPParams", BlockQuery
  (ShelleyBlock (Praos StandardCrypto) era) 'QFNoTables (PParams era)
-> SomeBlockQuery
     (BlockQuery (ShelleyBlock (Praos StandardCrypto) era))
forall (q :: QueryFootprint -> * -> *)
       (footprint :: QueryFootprint) result.
SingI footprint =>
q footprint result -> SomeBlockQuery q
SomeBlockQuery BlockQuery
  (ShelleyBlock (Praos StandardCrypto) era) 'QFNoTables (PParams era)
forall proto era.
BlockQuery (ShelleyBlock proto era) 'QFNoTables (PParams era)
GetCurrentPParams)
        , ([Char]
"GetStakeDistribution", BlockQuery
  (ShelleyBlock (Praos StandardCrypto) era)
  'QFNoTables
  (PoolDistr StandardCrypto)
-> SomeBlockQuery
     (BlockQuery (ShelleyBlock (Praos StandardCrypto) era))
forall (q :: QueryFootprint -> * -> *)
       (footprint :: QueryFootprint) result.
SingI footprint =>
q footprint result -> SomeBlockQuery q
SomeBlockQuery 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)
        , ([Char]
"GetNonMyopicMemberRewards", BlockQuery
  (ShelleyBlock (Praos StandardCrypto) era)
  'QFNoTables
  NonMyopicMemberRewards
-> SomeBlockQuery
     (BlockQuery (ShelleyBlock (Praos StandardCrypto) era))
forall (q :: QueryFootprint -> * -> *)
       (footprint :: QueryFootprint) result.
SingI footprint =>
q footprint result -> SomeBlockQuery q
SomeBlockQuery (BlockQuery
   (ShelleyBlock (Praos StandardCrypto) era)
   'QFNoTables
   NonMyopicMemberRewards
 -> SomeBlockQuery
      (BlockQuery (ShelleyBlock (Praos StandardCrypto) era)))
-> BlockQuery
     (ShelleyBlock (Praos StandardCrypto) era)
     'QFNoTables
     NonMyopicMemberRewards
-> SomeBlockQuery
     (BlockQuery (ShelleyBlock (Praos StandardCrypto) era))
forall a b. (a -> b) -> a -> b
$ 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))
leRewardsCredentials)
        , ([Char]
"GetGenesisConfig", BlockQuery
  (ShelleyBlock (Praos StandardCrypto) era)
  'QFNoTables
  CompactGenesis
-> SomeBlockQuery
     (BlockQuery (ShelleyBlock (Praos StandardCrypto) era))
forall (q :: QueryFootprint -> * -> *)
       (footprint :: QueryFootprint) result.
SingI footprint =>
q footprint result -> SomeBlockQuery q
SomeBlockQuery BlockQuery
  (ShelleyBlock (Praos StandardCrypto) era)
  'QFNoTables
  CompactGenesis
forall proto era.
BlockQuery (ShelleyBlock proto era) 'QFNoTables CompactGenesis
GetGenesisConfig)
        , ([Char]
"GetBigLedgerPeerSnapshot", BlockQuery
  (ShelleyBlock (Praos StandardCrypto) era)
  'QFNoTables
  LedgerPeerSnapshot
-> SomeBlockQuery
     (BlockQuery (ShelleyBlock (Praos StandardCrypto) era))
forall (q :: QueryFootprint -> * -> *)
       (footprint :: QueryFootprint) result.
SingI footprint =>
q footprint result -> SomeBlockQuery q
SomeBlockQuery BlockQuery
  (ShelleyBlock (Praos StandardCrypto) era)
  'QFNoTables
  LedgerPeerSnapshot
forall proto era.
BlockQuery (ShelleyBlock proto era) 'QFNoTables LedgerPeerSnapshot
GetBigLedgerPeerSnapshot)
        , ([Char]
"GetStakeDistribution2", BlockQuery
  (ShelleyBlock (Praos StandardCrypto) era) 'QFNoTables PoolDistr
-> SomeBlockQuery
     (BlockQuery (ShelleyBlock (Praos StandardCrypto) era))
forall (q :: QueryFootprint -> * -> *)
       (footprint :: QueryFootprint) result.
SingI footprint =>
q footprint result -> SomeBlockQuery q
SomeBlockQuery BlockQuery
  (ShelleyBlock (Praos StandardCrypto) era) 'QFNoTables PoolDistr
forall proto era.
BlockQuery (ShelleyBlock proto era) 'QFNoTables PoolDistr
GetStakeDistribution2)
        , ([Char]
"GetMaxMajorProtocolVersion", BlockQuery
  (ShelleyBlock (Praos StandardCrypto) era)
  'QFNoTables
  MaxMajorProtVer
-> SomeBlockQuery
     (BlockQuery (ShelleyBlock (Praos StandardCrypto) era))
forall (q :: QueryFootprint -> * -> *)
       (footprint :: QueryFootprint) result.
SingI footprint =>
q footprint result -> SomeBlockQuery q
SomeBlockQuery BlockQuery
  (ShelleyBlock (Praos StandardCrypto) era)
  'QFNoTables
  MaxMajorProtVer
forall proto era.
BlockQuery (ShelleyBlock proto era) 'QFNoTables MaxMajorProtVer
GetMaxMajorProtocolVersion)
        ]
    results :: Labelled (SomeResult (ShelleyBlock (Praos StandardCrypto) era))
results =
      [([Char], SomeResult (ShelleyBlock (Praos StandardCrypto) era))]
-> Labelled (SomeResult (ShelleyBlock (Praos StandardCrypto) era))
forall a. [([Char], a)] -> Labelled a
labelled
        [ ([Char]
"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))
        , ([Char]
"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))
        , ([Char]
"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)
        , ([Char]
"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)
        ,
          ( [Char]
"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)
          )
        , ([Char]
"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))
        ,
          ( [Char]
"GetBigLedgerPeerSnapshot"
          , BlockQuery
  (ShelleyBlock (Praos StandardCrypto) era)
  'QFNoTables
  LedgerPeerSnapshot
-> LedgerPeerSnapshot
-> 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
  LedgerPeerSnapshot
forall proto era.
BlockQuery (ShelleyBlock proto era) 'QFNoTables LedgerPeerSnapshot
GetBigLedgerPeerSnapshot
              ( (WithOrigin SlotNo,
 [(AccPoolStake, (PoolStake, NonEmpty LedgerRelayAccessPoint))])
-> LedgerPeerSnapshot
LedgerPeerSnapshot
                  ( SlotNo -> WithOrigin SlotNo
forall t. t -> WithOrigin t
NotOrigin SlotNo
slotNo
                  ,
                    [
                      ( Rational -> AccPoolStake
AccPoolStake Rational
0.9
                      ,
                        ( Rational -> PoolStake
PoolStake Rational
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
:| []
                        )
                      )
                    ]
                  )
              )
          )
        , ([Char]
"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)
        ,
          ( [Char]
"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 (Praos StandardCrypto) era) EmptyMK
ledgerState =
      ShelleyLedgerState
        { shelleyLedgerTip :: WithOrigin (ShelleyTip (Praos StandardCrypto) era)
shelleyLedgerTip =
            ShelleyTip (Praos StandardCrypto) era
-> WithOrigin (ShelleyTip (Praos StandardCrypto) 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 (Praos StandardCrypto) era)
shelleyTipHash = HeaderHash (ShelleyBlock (Praos StandardCrypto) era)
ShelleyHash
hash
                }
        , shelleyLedgerState :: NewEpochState era
shelleyLedgerState = NewEpochState era
leNewEpochState
        , shelleyLedgerTransition :: ShelleyTransition
shelleyLedgerTransition = ShelleyTransitionInfo{shelleyAfterVoting :: Word32
shelleyAfterVoting = Word32
0}
        , shelleyLedgerTables :: LedgerTables
  (LedgerState (ShelleyBlock (Praos StandardCrypto) era)) EmptyMK
shelleyLedgerTables = LedgerTables
  (LedgerState (ShelleyBlock (Praos StandardCrypto) era)) EmptyMK
forall (mk :: MapKind) (l :: LedgerStateKind).
(ZeroableMK mk, LedgerTableConstraints l) =>
LedgerTables l 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 =
      LedgerState (ShelleyBlock (Praos StandardCrypto) era) EmptyMK
-> HeaderState (ShelleyBlock (Praos StandardCrypto) era)
-> ExtLedgerState (ShelleyBlock (Praos StandardCrypto) era) EmptyMK
forall blk (mk :: MapKind).
LedgerState blk mk -> HeaderState blk -> ExtLedgerState blk mk
ExtLedgerState
        LedgerState (ShelleyBlock (Praos StandardCrypto) era) EmptyMK
ledgerState
        (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))
ChainDepState (Praos StandardCrypto)
chainDepState)

    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)