{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}

module Test.Consensus.Shelley.Examples (
    -- * Setup
    codecConfig
  , testShelleyGenesis
    -- * Examples
  , examplesAllegra
  , examplesAlonzo
  , examplesBabbage
  , examplesConway
  , examplesMary
  , examplesShelley
  ) where


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.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           Test.Cardano.Ledger.Allegra.Examples.Consensus
                     (ledgerExamplesAllegra)
import           Test.Cardano.Ledger.Alonzo.Examples.Consensus
                     (ledgerExamplesAlonzo)
import           Test.Cardano.Ledger.Babbage.Examples.Consensus
                     (ledgerExamplesBabbage)
import           Test.Cardano.Ledger.Conway.Examples.Consensus
                     (ledgerExamplesConway)
import           Test.Cardano.Ledger.Mary.Examples.Consensus
                     (ledgerExamplesMary)
import           Test.Cardano.Ledger.Shelley.Examples.Consensus
                     (ShelleyLedgerExamples (..), ShelleyResultExamples (..),
                     ledgerExamplesShelley, testShelleyGenesis)
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
  => ShelleyLedgerExamples era
  -> Examples (ShelleyBlock (TPraos StandardCrypto) era)
fromShelleyLedgerExamples :: forall era.
ShelleyCompatible (TPraos StandardCrypto) era =>
ShelleyLedgerExamples era
-> Examples (ShelleyBlock (TPraos StandardCrypto) era)
fromShelleyLedgerExamples
  ShelleyLedgerExamples
    { sleResultExamples :: forall era. ShelleyLedgerExamples era -> ShelleyResultExamples era
sleResultExamples = ShelleyResultExamples{Map
  (Either Coin (Credential 'Staking)) (Map (KeyHash 'StakePool) Coin)
PParams era
PoolDistr
ProposedPPUpdates era
ShelleyGenesis
srePParams :: PParams era
sreProposedPPUpdates :: ProposedPPUpdates era
srePoolDistr :: PoolDistr
sreNonMyopicRewards :: Map
  (Either Coin (Credential 'Staking)) (Map (KeyHash 'StakePool) Coin)
sreShelleyGenesis :: ShelleyGenesis
sreShelleyGenesis :: forall era. ShelleyResultExamples era -> ShelleyGenesis
sreNonMyopicRewards :: forall era.
ShelleyResultExamples era
-> Map
     (Either Coin (Credential 'Staking)) (Map (KeyHash 'StakePool) Coin)
srePoolDistr :: forall era. ShelleyResultExamples era -> PoolDistr
sreProposedPPUpdates :: forall era. ShelleyResultExamples era -> ProposedPPUpdates era
srePParams :: forall era. ShelleyResultExamples era -> PParams era
..}
    , Set (Either Coin (Credential 'Staking))
Tx era
TranslationContext era
NewEpochState era
Block (BHeader StandardCrypto) era
ApplyTxError era
HashHeader
ChainDepState
sleBlock :: Block (BHeader StandardCrypto) era
sleHashHeader :: HashHeader
sleTx :: Tx era
sleApplyTxError :: ApplyTxError era
sleRewardsCredentials :: Set (Either Coin (Credential 'Staking))
sleNewEpochState :: NewEpochState era
sleChainDepState :: ChainDepState
sleTranslationContext :: TranslationContext era
sleTranslationContext :: forall era. ShelleyLedgerExamples era -> TranslationContext era
sleChainDepState :: forall era. ShelleyLedgerExamples era -> ChainDepState
sleNewEpochState :: forall era. ShelleyLedgerExamples era -> NewEpochState era
sleRewardsCredentials :: forall era.
ShelleyLedgerExamples era
-> Set (Either Coin (Credential 'Staking))
sleApplyTxError :: forall era. ShelleyLedgerExamples era -> ApplyTxError era
sleTx :: forall era. ShelleyLedgerExamples era -> Tx era
sleHashHeader :: forall era. ShelleyLedgerExamples era -> HashHeader
sleBlock :: forall era.
ShelleyLedgerExamples era -> Block (BHeader StandardCrypto) era
..} =
  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
sleApplyTxError
    , 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
sleTx
    }
  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
sleBlock
    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
sleHashHeader
    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
sleTx
    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))
sleRewardsCredentials)
        , ([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)
      ]
    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 EpochNo
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
srePParams)
        , ([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
srePoolDistr)
        , ([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)
sreNonMyopicRewards))
        , ([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
sreShelleyGenesis))
        , ([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 RelayAccessPoint))])
-> 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 -> RelayAccessPoint
RelayAccessAddress (IPv4 -> IP
IPv4 IPv4
"1.1.1.1") PortNumber
1234 RelayAccessPoint -> [RelayAccessPoint] -> NonEmpty RelayAccessPoint
forall a. a -> [a] -> NonEmpty a
:| []))])))
        ]
    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
sleNewEpochState
    , 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
sleChainDepState
    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
sleTranslationContext

-- | TODO Factor this out into something nicer.
fromShelleyLedgerExamplesPraos ::
  forall era.
  ShelleyCompatible (Praos StandardCrypto) era
  => ShelleyLedgerExamples era
  -> Examples (ShelleyBlock (Praos StandardCrypto) era)
fromShelleyLedgerExamplesPraos :: forall era.
ShelleyCompatible (Praos StandardCrypto) era =>
ShelleyLedgerExamples era
-> Examples (ShelleyBlock (Praos StandardCrypto) era)
fromShelleyLedgerExamplesPraos ShelleyLedgerExamples {
                            sleResultExamples :: forall era. ShelleyLedgerExamples era -> ShelleyResultExamples era
sleResultExamples = ShelleyResultExamples{Map
  (Either Coin (Credential 'Staking)) (Map (KeyHash 'StakePool) Coin)
PParams era
PoolDistr
ProposedPPUpdates era
ShelleyGenesis
sreShelleyGenesis :: forall era. ShelleyResultExamples era -> ShelleyGenesis
sreNonMyopicRewards :: forall era.
ShelleyResultExamples era
-> Map
     (Either Coin (Credential 'Staking)) (Map (KeyHash 'StakePool) Coin)
srePoolDistr :: forall era. ShelleyResultExamples era -> PoolDistr
sreProposedPPUpdates :: forall era. ShelleyResultExamples era -> ProposedPPUpdates era
srePParams :: forall era. ShelleyResultExamples era -> PParams era
srePParams :: PParams era
sreProposedPPUpdates :: ProposedPPUpdates era
srePoolDistr :: PoolDistr
sreNonMyopicRewards :: Map
  (Either Coin (Credential 'Staking)) (Map (KeyHash 'StakePool) Coin)
sreShelleyGenesis :: ShelleyGenesis
..}
                            , Set (Either Coin (Credential 'Staking))
Tx era
TranslationContext era
NewEpochState era
Block (BHeader StandardCrypto) era
ApplyTxError era
HashHeader
ChainDepState
sleTranslationContext :: forall era. ShelleyLedgerExamples era -> TranslationContext era
sleChainDepState :: forall era. ShelleyLedgerExamples era -> ChainDepState
sleNewEpochState :: forall era. ShelleyLedgerExamples era -> NewEpochState era
sleRewardsCredentials :: forall era.
ShelleyLedgerExamples era
-> Set (Either Coin (Credential 'Staking))
sleApplyTxError :: forall era. ShelleyLedgerExamples era -> ApplyTxError era
sleTx :: forall era. ShelleyLedgerExamples era -> Tx era
sleHashHeader :: forall era. ShelleyLedgerExamples era -> HashHeader
sleBlock :: forall era.
ShelleyLedgerExamples era -> Block (BHeader StandardCrypto) era
sleBlock :: Block (BHeader StandardCrypto) era
sleHashHeader :: HashHeader
sleTx :: Tx era
sleApplyTxError :: ApplyTxError era
sleRewardsCredentials :: Set (Either Coin (Credential 'Staking))
sleNewEpochState :: NewEpochState era
sleChainDepState :: ChainDepState
sleTranslationContext :: TranslationContext 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
sleApplyTxError
    , 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
sleTx
    , 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 TxSeq era
bdy = Block (BHeader StandardCrypto) era
sleBlock
       in Header StandardCrypto
-> TxSeq era -> Block (Header StandardCrypto) era
forall era h.
(Era era, EncCBORGroup (TxSeq era), EncCBOR h) =>
h -> TxSeq era -> Block h era
SL.Block (BHeader StandardCrypto -> Header StandardCrypto
translateHeader BHeader StandardCrypto
hdr1) TxSeq 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
sleHashHeader
    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
sleTx
    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))
sleRewardsCredentials)
        , ([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)
      ]
    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 EpochNo
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
srePParams)
        , ([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
srePoolDistr)
        , ([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)
sreNonMyopicRewards))
        , ([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
sreShelleyGenesis))
        ]
    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
sleNewEpochState
    , 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
sleChainDepState
    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
sleTranslationContext

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

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

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

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

examplesBabbage :: Examples StandardBabbageBlock
examplesBabbage :: Examples StandardBabbageBlock
examplesBabbage = ShelleyLedgerExamples BabbageEra -> Examples StandardBabbageBlock
forall era.
ShelleyCompatible (Praos StandardCrypto) era =>
ShelleyLedgerExamples era
-> Examples (ShelleyBlock (Praos StandardCrypto) era)
fromShelleyLedgerExamplesPraos ShelleyLedgerExamples BabbageEra
ledgerExamplesBabbage

examplesConway :: Examples StandardConwayBlock
examplesConway :: Examples StandardConwayBlock
examplesConway = ShelleyLedgerExamples ConwayEra -> Examples StandardConwayBlock
forall era.
ShelleyCompatible (Praos StandardCrypto) era =>
ShelleyLedgerExamples era
-> Examples (ShelleyBlock (Praos StandardCrypto) era)
fromShelleyLedgerExamplesPraos ShelleyLedgerExamples ConwayEra
ledgerExamplesConway

exampleShelleyLedgerConfig :: TranslationContext era -> ShelleyLedgerConfig era
exampleShelleyLedgerConfig :: forall era. TranslationContext era -> ShelleyLedgerConfig era
exampleShelleyLedgerConfig TranslationContext era
translationContext = ShelleyLedgerConfig {
      shelleyLedgerCompactGenesis :: CompactGenesis
shelleyLedgerCompactGenesis = ShelleyGenesis -> CompactGenesis
compactGenesis ShelleyGenesis
testShelleyGenesis
    , shelleyLedgerGlobals :: Globals
shelleyLedgerGlobals = ShelleyGenesis -> EpochInfo (Either Text) -> Globals
SL.mkShelleyGlobals
        ShelleyGenesis
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)