{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-}

{-# OPTIONS_GHC -Wno-orphans #-}
#if __GLASGOW_HASKELL__ >= 908
{-# OPTIONS_GHC -Wno-x-partial #-}
#endif

module Test.Consensus.Cardano.Examples (
    -- * Setup
    codecConfig
    -- * Examples
  , exampleApplyTxErrWrongEraByron
  , exampleApplyTxErrWrongEraShelley
  , exampleEraMismatchByron
  , exampleEraMismatchShelley
  , exampleQueryAnytimeShelley
  , exampleQueryEraMismatchByron
  , exampleQueryEraMismatchShelley
  , exampleResultAnytimeShelley
  , exampleResultEraMismatchByron
  , exampleResultEraMismatchShelley
  , examples
  ) where

import           Data.Bifunctor (second)
import           Data.Coerce (Coercible, coerce)
import           Data.SOP.BasicFunctors
import           Data.SOP.Counting (Exactly (..))
import           Data.SOP.Functors (Flip (..))
import           Data.SOP.Index (Index (..), himap)
import           Data.SOP.Strict
import qualified Data.Text as T
import           Ouroboros.Consensus.Block
import           Ouroboros.Consensus.Byron.ByronHFC
import           Ouroboros.Consensus.Byron.Ledger (ByronBlock)
import qualified Ouroboros.Consensus.Byron.Ledger as Byron
import           Ouroboros.Consensus.Cardano.Block
import           Ouroboros.Consensus.Cardano.CanHardFork
import           Ouroboros.Consensus.Cardano.Ledger ()
import           Ouroboros.Consensus.HardFork.Combinator
import           Ouroboros.Consensus.HardFork.Combinator.Embed.Nary
import qualified Ouroboros.Consensus.HardFork.Combinator.State as State
import qualified Ouroboros.Consensus.HardFork.History as History
import           Ouroboros.Consensus.HeaderValidation (AnnTip)
import           Ouroboros.Consensus.Ledger.Extended
import           Ouroboros.Consensus.Ledger.Query
import           Ouroboros.Consensus.Ledger.SupportsMempool (ApplyTxErr)
import           Ouroboros.Consensus.Ledger.Tables (EmptyMK, ValuesMK,
                     castLedgerTables)
import           Ouroboros.Consensus.Protocol.TPraos (TPraos)
import           Ouroboros.Consensus.Shelley.Ledger (ShelleyBlock)
import qualified Ouroboros.Consensus.Shelley.Ledger as Shelley
import           Ouroboros.Consensus.Shelley.Ledger.SupportsProtocol ()
import           Ouroboros.Consensus.Storage.Serialisation
import           Ouroboros.Consensus.TypeFamilyWrappers
import           Ouroboros.Network.Block (Serialised (..))
import qualified Test.Consensus.Byron.Examples as Byron
import qualified Test.Consensus.Shelley.Examples as Shelley
import           Test.Util.Serialisation.Examples (Examples (..), Labelled,
                     labelled, prefixExamples)
import           Test.Util.Serialisation.SomeResult (SomeResult (..))

type Crypto = StandardCrypto

eraExamples :: NP Examples (CardanoEras Crypto)
eraExamples :: NP Examples (ByronBlock : CardanoShelleyEras Crypto)
eraExamples =
       Examples ByronBlock
Byron.examples
    Examples ByronBlock
-> NP Examples (CardanoShelleyEras Crypto)
-> NP Examples (ByronBlock : CardanoShelleyEras Crypto)
forall {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> NP f xs1 -> NP f (x : xs1)
:* Examples (ShelleyBlock (TPraos Crypto) ShelleyEra)
Shelley.examplesShelley
    Examples (ShelleyBlock (TPraos Crypto) ShelleyEra)
-> NP
     Examples
     '[ShelleyBlock (TPraos Crypto) AllegraEra,
       ShelleyBlock (TPraos Crypto) MaryEra,
       ShelleyBlock (TPraos Crypto) AlonzoEra,
       ShelleyBlock (Praos Crypto) BabbageEra,
       ShelleyBlock (Praos Crypto) ConwayEra]
-> NP Examples (CardanoShelleyEras Crypto)
forall {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> NP f xs1 -> NP f (x : xs1)
:* Examples (ShelleyBlock (TPraos Crypto) AllegraEra)
Shelley.examplesAllegra
    Examples (ShelleyBlock (TPraos Crypto) AllegraEra)
-> NP
     Examples
     '[ShelleyBlock (TPraos Crypto) MaryEra,
       ShelleyBlock (TPraos Crypto) AlonzoEra,
       ShelleyBlock (Praos Crypto) BabbageEra,
       ShelleyBlock (Praos Crypto) ConwayEra]
-> NP
     Examples
     '[ShelleyBlock (TPraos Crypto) AllegraEra,
       ShelleyBlock (TPraos Crypto) MaryEra,
       ShelleyBlock (TPraos Crypto) AlonzoEra,
       ShelleyBlock (Praos Crypto) BabbageEra,
       ShelleyBlock (Praos Crypto) ConwayEra]
forall {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> NP f xs1 -> NP f (x : xs1)
:* Examples (ShelleyBlock (TPraos Crypto) MaryEra)
Shelley.examplesMary
    Examples (ShelleyBlock (TPraos Crypto) MaryEra)
-> NP
     Examples
     '[ShelleyBlock (TPraos Crypto) AlonzoEra,
       ShelleyBlock (Praos Crypto) BabbageEra,
       ShelleyBlock (Praos Crypto) ConwayEra]
-> NP
     Examples
     '[ShelleyBlock (TPraos Crypto) MaryEra,
       ShelleyBlock (TPraos Crypto) AlonzoEra,
       ShelleyBlock (Praos Crypto) BabbageEra,
       ShelleyBlock (Praos Crypto) ConwayEra]
forall {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> NP f xs1 -> NP f (x : xs1)
:* Examples (ShelleyBlock (TPraos Crypto) AlonzoEra)
Shelley.examplesAlonzo
    Examples (ShelleyBlock (TPraos Crypto) AlonzoEra)
-> NP
     Examples
     '[ShelleyBlock (Praos Crypto) BabbageEra,
       ShelleyBlock (Praos Crypto) ConwayEra]
-> NP
     Examples
     '[ShelleyBlock (TPraos Crypto) AlonzoEra,
       ShelleyBlock (Praos Crypto) BabbageEra,
       ShelleyBlock (Praos Crypto) ConwayEra]
forall {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> NP f xs1 -> NP f (x : xs1)
:* Examples (ShelleyBlock (Praos Crypto) BabbageEra)
Shelley.examplesBabbage
    Examples (ShelleyBlock (Praos Crypto) BabbageEra)
-> NP Examples '[ShelleyBlock (Praos Crypto) ConwayEra]
-> NP
     Examples
     '[ShelleyBlock (Praos Crypto) BabbageEra,
       ShelleyBlock (Praos Crypto) ConwayEra]
forall {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> NP f xs1 -> NP f (x : xs1)
:* Examples (ShelleyBlock (Praos Crypto) ConwayEra)
Shelley.examplesConway
    Examples (ShelleyBlock (Praos Crypto) ConwayEra)
-> NP Examples '[]
-> NP Examples '[ShelleyBlock (Praos Crypto) ConwayEra]
forall {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> NP f xs1 -> NP f (x : xs1)
:* NP Examples '[]
forall {k} (f :: k -> *). NP f '[]
Nil

-- | By using this function, we can't forget to update this test when adding a
-- new era to 'CardanoEras'.
combineEras ::
     NP Examples (CardanoEras Crypto)
  -> Examples (CardanoBlock Crypto)
combineEras :: NP Examples (ByronBlock : CardanoShelleyEras Crypto)
-> Examples (CardanoBlock Crypto)
combineEras NP Examples (ByronBlock : CardanoShelleyEras Crypto)
perEraExamples = Examples {
        exampleBlock :: Labelled (CardanoBlock Crypto)
exampleBlock            = Labelled (I (CardanoBlock Crypto))
-> Labelled (CardanoBlock Crypto)
forall a b. Coercible a b => a -> b
coerce (Labelled (I (CardanoBlock Crypto))
 -> Labelled (CardanoBlock Crypto))
-> Labelled (I (CardanoBlock Crypto))
-> Labelled (CardanoBlock Crypto)
forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *).
Inject f =>
(forall blk. Examples blk -> Labelled (f blk))
-> Labelled (f (CardanoBlock Crypto))
viaInject @I                 ((Examples blk -> Labelled blk) -> Examples blk -> Labelled (I blk)
forall a b. Coercible a b => a -> b
coerce Examples blk -> Labelled blk
forall blk. Examples blk -> Labelled blk
exampleBlock)
      , exampleSerialisedBlock :: Labelled (Serialised (CardanoBlock Crypto))
exampleSerialisedBlock  =          (forall blk. Examples blk -> Labelled (Serialised blk))
-> Labelled (Serialised (CardanoBlock Crypto))
forall (f :: * -> *).
Inject f =>
(forall blk. Examples blk -> Labelled (f blk))
-> Labelled (f (CardanoBlock Crypto))
viaInject                            Examples blk -> Labelled (Serialised blk)
forall blk. Examples blk -> Labelled (Serialised blk)
exampleSerialisedBlock
      , exampleHeader :: Labelled (Header (CardanoBlock Crypto))
exampleHeader           =          (forall blk. Examples blk -> Labelled (Header blk))
-> Labelled (Header (CardanoBlock Crypto))
forall (f :: * -> *).
Inject f =>
(forall blk. Examples blk -> Labelled (f blk))
-> Labelled (f (CardanoBlock Crypto))
viaInject                            Examples blk -> Labelled (Header blk)
forall blk. Examples blk -> Labelled (Header blk)
exampleHeader
      , exampleSerialisedHeader :: Labelled (SerialisedHeader (CardanoBlock Crypto))
exampleSerialisedHeader =          (forall blk. Examples blk -> Labelled (SerialisedHeader blk))
-> Labelled (SerialisedHeader (CardanoBlock Crypto))
forall (f :: * -> *).
Inject f =>
(forall blk. Examples blk -> Labelled (f blk))
-> Labelled (f (CardanoBlock Crypto))
viaInject                            Examples blk -> Labelled (SerialisedHeader blk)
forall blk. Examples blk -> Labelled (SerialisedHeader blk)
exampleSerialisedHeader
      , exampleHeaderHash :: Labelled (HeaderHash (CardanoBlock Crypto))
exampleHeaderHash       = Labelled (WrapHeaderHash (CardanoBlock Crypto))
-> Labelled (HeaderHash (CardanoBlock Crypto))
forall a b. Coercible a b => a -> b
coerce (Labelled (WrapHeaderHash (CardanoBlock Crypto))
 -> Labelled (HeaderHash (CardanoBlock Crypto)))
-> Labelled (WrapHeaderHash (CardanoBlock Crypto))
-> Labelled (HeaderHash (CardanoBlock Crypto))
forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *).
Inject f =>
(forall blk. Examples blk -> Labelled (f blk))
-> Labelled (f (CardanoBlock Crypto))
viaInject @WrapHeaderHash    ((Examples blk -> Labelled (HeaderHash blk))
-> Examples blk -> Labelled (WrapHeaderHash blk)
forall a b. Coercible a b => a -> b
coerce Examples blk -> Labelled (HeaderHash blk)
forall blk. Examples blk -> Labelled (HeaderHash blk)
exampleHeaderHash)
      , exampleGenTx :: Labelled (GenTx (CardanoBlock Crypto))
exampleGenTx            =          (forall blk. Examples blk -> Labelled (GenTx blk))
-> Labelled (GenTx (CardanoBlock Crypto))
forall (f :: * -> *).
Inject f =>
(forall blk. Examples blk -> Labelled (f blk))
-> Labelled (f (CardanoBlock Crypto))
viaInject                            Examples blk -> Labelled (GenTx blk)
forall blk. Examples blk -> Labelled (GenTx blk)
exampleGenTx
      , exampleGenTxId :: Labelled (GenTxId (CardanoBlock Crypto))
exampleGenTxId          = Labelled (WrapGenTxId (CardanoBlock Crypto))
-> Labelled (GenTxId (CardanoBlock Crypto))
forall a b. Coercible a b => a -> b
coerce (Labelled (WrapGenTxId (CardanoBlock Crypto))
 -> Labelled (GenTxId (CardanoBlock Crypto)))
-> Labelled (WrapGenTxId (CardanoBlock Crypto))
-> Labelled (GenTxId (CardanoBlock Crypto))
forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *).
Inject f =>
(forall blk. Examples blk -> Labelled (f blk))
-> Labelled (f (CardanoBlock Crypto))
viaInject @WrapGenTxId       ((Examples blk -> Labelled (GenTxId blk))
-> Examples blk -> Labelled (WrapGenTxId blk)
forall a b. Coercible a b => a -> b
coerce Examples blk -> Labelled (GenTxId blk)
forall blk. Examples blk -> Labelled (GenTxId blk)
exampleGenTxId)
      , exampleApplyTxErr :: Labelled (ApplyTxErr (CardanoBlock Crypto))
exampleApplyTxErr       = Labelled (WrapApplyTxErr (CardanoBlock Crypto))
-> Labelled (ApplyTxErr (CardanoBlock Crypto))
forall a b. Coercible a b => a -> b
coerce (Labelled (WrapApplyTxErr (CardanoBlock Crypto))
 -> Labelled (ApplyTxErr (CardanoBlock Crypto)))
-> Labelled (WrapApplyTxErr (CardanoBlock Crypto))
-> Labelled (ApplyTxErr (CardanoBlock Crypto))
forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *).
Inject f =>
(forall blk. Examples blk -> Labelled (f blk))
-> Labelled (f (CardanoBlock Crypto))
viaInject @WrapApplyTxErr    ((Examples blk -> Labelled (ApplyTxErr blk))
-> Examples blk -> Labelled (WrapApplyTxErr blk)
forall a b. Coercible a b => a -> b
coerce Examples blk -> Labelled (ApplyTxErr blk)
forall blk. Examples blk -> Labelled (ApplyTxErr blk)
exampleApplyTxErr)
      , exampleQuery :: Labelled (SomeBlockQuery (BlockQuery (CardanoBlock Crypto)))
exampleQuery            = ((Maybe String,
  (:.:) SomeBlockQuery BlockQuery (CardanoBlock Crypto))
 -> (Maybe String,
     SomeBlockQuery (BlockQuery (CardanoBlock Crypto))))
-> [(Maybe String,
     (:.:) SomeBlockQuery BlockQuery (CardanoBlock Crypto))]
-> Labelled (SomeBlockQuery (BlockQuery (CardanoBlock Crypto)))
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((:.:) SomeBlockQuery BlockQuery (CardanoBlock Crypto)
 -> SomeBlockQuery (BlockQuery (CardanoBlock Crypto)))
-> (Maybe String,
    (:.:) SomeBlockQuery BlockQuery (CardanoBlock Crypto))
-> (Maybe String,
    SomeBlockQuery (BlockQuery (CardanoBlock Crypto)))
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (:.:) SomeBlockQuery BlockQuery (CardanoBlock Crypto)
-> SomeBlockQuery (BlockQuery (CardanoBlock Crypto))
forall {l} {k} (f :: l -> *) (g :: k -> l) (p :: k).
(:.:) f g p -> f (g p)
unComp) ([(Maybe String,
   (:.:) SomeBlockQuery BlockQuery (CardanoBlock Crypto))]
 -> Labelled (SomeBlockQuery (BlockQuery (CardanoBlock Crypto))))
-> [(Maybe String,
     (:.:) SomeBlockQuery BlockQuery (CardanoBlock Crypto))]
-> Labelled (SomeBlockQuery (BlockQuery (CardanoBlock Crypto)))
forall a b. (a -> b) -> a -> b
$ (forall blk.
 Examples blk -> Labelled ((:.:) SomeBlockQuery BlockQuery blk))
-> [(Maybe String,
     (:.:) SomeBlockQuery BlockQuery (CardanoBlock Crypto))]
forall (f :: * -> *).
Inject f =>
(forall blk. Examples blk -> Labelled (f blk))
-> Labelled (f (CardanoBlock Crypto))
viaInject      (((Maybe String, SomeBlockQuery (BlockQuery blk))
 -> (Maybe String, (:.:) SomeBlockQuery BlockQuery blk))
-> [(Maybe String, SomeBlockQuery (BlockQuery blk))]
-> [(Maybe String, (:.:) SomeBlockQuery BlockQuery blk)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((SomeBlockQuery (BlockQuery blk)
 -> (:.:) SomeBlockQuery BlockQuery blk)
-> (Maybe String, SomeBlockQuery (BlockQuery blk))
-> (Maybe String, (:.:) SomeBlockQuery BlockQuery blk)
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second SomeBlockQuery (BlockQuery blk)
-> (:.:) SomeBlockQuery BlockQuery blk
forall l k (f :: l -> *) (g :: k -> l) (p :: k).
f (g p) -> (:.:) f g p
Comp) ([(Maybe String, SomeBlockQuery (BlockQuery blk))]
 -> [(Maybe String, (:.:) SomeBlockQuery BlockQuery blk)])
-> (Examples blk
    -> [(Maybe String, SomeBlockQuery (BlockQuery blk))])
-> Examples blk
-> [(Maybe String, (:.:) SomeBlockQuery BlockQuery blk)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Examples blk -> [(Maybe String, SomeBlockQuery (BlockQuery blk))]
forall blk.
Examples blk -> Labelled (SomeBlockQuery (BlockQuery blk))
exampleQuery)
      , exampleResult :: Labelled (SomeResult (CardanoBlock Crypto))
exampleResult           =          (forall blk. Examples blk -> Labelled (SomeResult blk))
-> Labelled (SomeResult (CardanoBlock Crypto))
forall (f :: * -> *).
Inject f =>
(forall blk. Examples blk -> Labelled (f blk))
-> Labelled (f (CardanoBlock Crypto))
viaInject                            Examples blk -> Labelled (SomeResult blk)
forall blk. Examples blk -> Labelled (SomeResult blk)
exampleResult
      , exampleAnnTip :: Labelled (AnnTip (CardanoBlock Crypto))
exampleAnnTip           =          (forall blk. Examples blk -> Labelled (AnnTip blk))
-> Labelled (AnnTip (CardanoBlock Crypto))
forall (f :: * -> *).
Inject f =>
(forall blk. Examples blk -> Labelled (f blk))
-> Labelled (f (CardanoBlock Crypto))
viaInject                            Examples blk -> Labelled (AnnTip blk)
forall blk. Examples blk -> Labelled (AnnTip blk)
exampleAnnTip
      , exampleLedgerState :: Labelled (LedgerState (CardanoBlock Crypto) EmptyMK)
exampleLedgerState      = ((Maybe String, Flip LedgerState EmptyMK (CardanoBlock Crypto))
 -> (Maybe String, LedgerState (CardanoBlock Crypto) EmptyMK))
-> [(Maybe String, Flip LedgerState EmptyMK (CardanoBlock Crypto))]
-> Labelled (LedgerState (CardanoBlock Crypto) EmptyMK)
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Flip LedgerState EmptyMK (CardanoBlock Crypto)
 -> LedgerState (CardanoBlock Crypto) EmptyMK)
-> (Maybe String, Flip LedgerState EmptyMK (CardanoBlock Crypto))
-> (Maybe String, LedgerState (CardanoBlock Crypto) EmptyMK)
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second Flip LedgerState EmptyMK (CardanoBlock Crypto)
-> LedgerState (CardanoBlock Crypto) EmptyMK
forall x1 y1 (f :: x1 -> y1 -> *) (x2 :: y1) (y2 :: x1).
Flip f x2 y2 -> f y2 x2
unFlip) ([(Maybe String, Flip LedgerState EmptyMK (CardanoBlock Crypto))]
 -> Labelled (LedgerState (CardanoBlock Crypto) EmptyMK))
-> [(Maybe String, Flip LedgerState EmptyMK (CardanoBlock Crypto))]
-> Labelled (LedgerState (CardanoBlock Crypto) EmptyMK)
forall a b. (a -> b) -> a -> b
$ (forall blk.
 Examples blk -> Labelled (Flip LedgerState EmptyMK blk))
-> [(Maybe String, Flip LedgerState EmptyMK (CardanoBlock Crypto))]
forall (f :: * -> *).
Inject f =>
(forall blk. Examples blk -> Labelled (f blk))
-> Labelled (f (CardanoBlock Crypto))
viaInject      (((Maybe String, LedgerState blk EmptyMK)
 -> (Maybe String, Flip LedgerState EmptyMK blk))
-> [(Maybe String, LedgerState blk EmptyMK)]
-> [(Maybe String, Flip LedgerState EmptyMK blk)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((LedgerState blk EmptyMK -> Flip LedgerState EmptyMK blk)
-> (Maybe String, LedgerState blk EmptyMK)
-> (Maybe String, Flip LedgerState EmptyMK blk)
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second LedgerState blk EmptyMK -> Flip LedgerState EmptyMK blk
forall x y (f :: x -> y -> *) (x1 :: y) (y1 :: x).
f y1 x1 -> Flip f x1 y1
Flip) ([(Maybe String, LedgerState blk EmptyMK)]
 -> [(Maybe String, Flip LedgerState EmptyMK blk)])
-> (Examples blk -> [(Maybe String, LedgerState blk EmptyMK)])
-> Examples blk
-> [(Maybe String, Flip LedgerState EmptyMK blk)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Examples blk -> [(Maybe String, LedgerState blk EmptyMK)]
forall blk. Examples blk -> Labelled (LedgerState blk EmptyMK)
exampleLedgerState)
      , exampleChainDepState :: Labelled (ChainDepState (BlockProtocol (CardanoBlock Crypto)))
exampleChainDepState    = Labelled (WrapChainDepState (CardanoBlock Crypto))
-> Labelled (ChainDepState (BlockProtocol (CardanoBlock Crypto)))
forall a b. Coercible a b => a -> b
coerce (Labelled (WrapChainDepState (CardanoBlock Crypto))
 -> Labelled (ChainDepState (BlockProtocol (CardanoBlock Crypto))))
-> Labelled (WrapChainDepState (CardanoBlock Crypto))
-> Labelled (ChainDepState (BlockProtocol (CardanoBlock Crypto)))
forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *).
Inject f =>
(forall blk. Examples blk -> Labelled (f blk))
-> Labelled (f (CardanoBlock Crypto))
viaInject @WrapChainDepState ((Examples blk -> Labelled (ChainDepState (BlockProtocol blk)))
-> Examples blk -> Labelled (WrapChainDepState blk)
forall a b. Coercible a b => a -> b
coerce Examples blk -> Labelled (ChainDepState (BlockProtocol blk))
forall blk.
Examples blk -> Labelled (ChainDepState (BlockProtocol blk))
exampleChainDepState)
      , exampleExtLedgerState :: Labelled (ExtLedgerState (CardanoBlock Crypto) EmptyMK)
exampleExtLedgerState   = ((Maybe String, Flip ExtLedgerState EmptyMK (CardanoBlock Crypto))
 -> (Maybe String, ExtLedgerState (CardanoBlock Crypto) EmptyMK))
-> [(Maybe String,
     Flip ExtLedgerState EmptyMK (CardanoBlock Crypto))]
-> Labelled (ExtLedgerState (CardanoBlock Crypto) EmptyMK)
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Flip ExtLedgerState EmptyMK (CardanoBlock Crypto)
 -> ExtLedgerState (CardanoBlock Crypto) EmptyMK)
-> (Maybe String,
    Flip ExtLedgerState EmptyMK (CardanoBlock Crypto))
-> (Maybe String, ExtLedgerState (CardanoBlock Crypto) EmptyMK)
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second Flip ExtLedgerState EmptyMK (CardanoBlock Crypto)
-> ExtLedgerState (CardanoBlock Crypto) EmptyMK
forall x1 y1 (f :: x1 -> y1 -> *) (x2 :: y1) (y2 :: x1).
Flip f x2 y2 -> f y2 x2
unFlip) ([(Maybe String,
   Flip ExtLedgerState EmptyMK (CardanoBlock Crypto))]
 -> Labelled (ExtLedgerState (CardanoBlock Crypto) EmptyMK))
-> [(Maybe String,
     Flip ExtLedgerState EmptyMK (CardanoBlock Crypto))]
-> Labelled (ExtLedgerState (CardanoBlock Crypto) EmptyMK)
forall a b. (a -> b) -> a -> b
$ (forall blk.
 Examples blk -> Labelled (Flip ExtLedgerState EmptyMK blk))
-> [(Maybe String,
     Flip ExtLedgerState EmptyMK (CardanoBlock Crypto))]
forall (f :: * -> *).
Inject f =>
(forall blk. Examples blk -> Labelled (f blk))
-> Labelled (f (CardanoBlock Crypto))
viaInject      (((Maybe String, ExtLedgerState blk EmptyMK)
 -> (Maybe String, Flip ExtLedgerState EmptyMK blk))
-> [(Maybe String, ExtLedgerState blk EmptyMK)]
-> [(Maybe String, Flip ExtLedgerState EmptyMK blk)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((ExtLedgerState blk EmptyMK -> Flip ExtLedgerState EmptyMK blk)
-> (Maybe String, ExtLedgerState blk EmptyMK)
-> (Maybe String, Flip ExtLedgerState EmptyMK blk)
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second ExtLedgerState blk EmptyMK -> Flip ExtLedgerState EmptyMK blk
forall x y (f :: x -> y -> *) (x1 :: y) (y1 :: x).
f y1 x1 -> Flip f x1 y1
Flip) ([(Maybe String, ExtLedgerState blk EmptyMK)]
 -> [(Maybe String, Flip ExtLedgerState EmptyMK blk)])
-> (Examples blk -> [(Maybe String, ExtLedgerState blk EmptyMK)])
-> Examples blk
-> [(Maybe String, Flip ExtLedgerState EmptyMK blk)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Examples blk -> [(Maybe String, ExtLedgerState blk EmptyMK)]
forall blk. Examples blk -> Labelled (ExtLedgerState blk EmptyMK)
exampleExtLedgerState)
      , exampleSlotNo :: Labelled SlotNo
exampleSlotNo           = Labelled (K SlotNo (CardanoBlock Crypto)) -> Labelled SlotNo
forall a b. Coercible a b => a -> b
coerce (Labelled (K SlotNo (CardanoBlock Crypto)) -> Labelled SlotNo)
-> Labelled (K SlotNo (CardanoBlock Crypto)) -> Labelled SlotNo
forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *).
Inject f =>
(forall blk. Examples blk -> Labelled (f blk))
-> Labelled (f (CardanoBlock Crypto))
viaInject @(K SlotNo)        ((Examples blk -> Labelled SlotNo)
-> Examples blk -> Labelled (K SlotNo blk)
forall a b. Coercible a b => a -> b
coerce Examples blk -> Labelled SlotNo
forall blk. Examples blk -> Labelled SlotNo
exampleSlotNo)
      , exampleLedgerConfig :: Labelled (LedgerConfig (CardanoBlock Crypto))
exampleLedgerConfig     = Labelled (LedgerConfig (CardanoBlock Crypto))
Labelled
  (HardForkLedgerConfig (ByronBlock : CardanoShelleyEras Crypto))
exampleLedgerConfigCardano
      , exampleLedgerTables :: Labelled
  (LedgerTables (LedgerState (CardanoBlock Crypto)) ValuesMK)
exampleLedgerTables     = Labelled
  (LedgerTables (LedgerState (CardanoBlock Crypto)) ValuesMK)
exampleLedgerTablesCardano
      }
  where
    viaInject ::
         forall f. Inject f
      => (forall blk. Examples blk -> Labelled (f blk))
      -> Labelled (f (CardanoBlock Crypto))
    viaInject :: forall (f :: * -> *).
Inject f =>
(forall blk. Examples blk -> Labelled (f blk))
-> Labelled (f (CardanoBlock Crypto))
viaInject forall blk. Examples blk -> Labelled (f blk)
getExamples =
          [Labelled (f (CardanoBlock Crypto))]
-> Labelled (f (CardanoBlock Crypto))
forall a. Monoid a => [a] -> a
mconcat
        ([Labelled (f (CardanoBlock Crypto))]
 -> Labelled (f (CardanoBlock Crypto)))
-> [Labelled (f (CardanoBlock Crypto))]
-> Labelled (f (CardanoBlock Crypto))
forall a b. (a -> b) -> a -> b
$ NP
  (K (Labelled (f (CardanoBlock Crypto))))
  (ByronBlock : CardanoShelleyEras Crypto)
-> CollapseTo NP (Labelled (f (CardanoBlock Crypto)))
forall (xs :: [*]) a.
SListIN NP xs =>
NP (K a) xs -> CollapseTo NP a
forall k l (h :: (k -> *) -> l -> *) (xs :: l) a.
(HCollapse h, SListIN h xs) =>
h (K a) xs -> CollapseTo h a
hcollapse
        (NP
   (K (Labelled (f (CardanoBlock Crypto))))
   (ByronBlock : CardanoShelleyEras Crypto)
 -> CollapseTo NP (Labelled (f (CardanoBlock Crypto))))
-> NP
     (K (Labelled (f (CardanoBlock Crypto))))
     (ByronBlock : CardanoShelleyEras Crypto)
-> CollapseTo NP (Labelled (f (CardanoBlock Crypto)))
forall a b. (a -> b) -> a -> b
$ (forall a.
 Index (ByronBlock : CardanoShelleyEras Crypto) a
 -> Examples a -> K (Labelled (f (CardanoBlock Crypto))) a)
-> NP Examples (ByronBlock : CardanoShelleyEras Crypto)
-> NP
     (K (Labelled (f (CardanoBlock Crypto))))
     (ByronBlock : CardanoShelleyEras Crypto)
forall {k} (h :: (k -> *) -> [k] -> *) (xs :: [k]) (f1 :: k -> *)
       (f2 :: k -> *).
(HAp h, SListI xs, Prod h ~ NP) =>
(forall (a :: k). Index xs a -> f1 a -> f2 a) -> h f1 xs -> h f2 xs
himap (\Index (ByronBlock : CardanoShelleyEras Crypto) a
ix -> Labelled (f (CardanoBlock Crypto))
-> K (Labelled (f (CardanoBlock Crypto))) a
forall k a (b :: k). a -> K a b
K (Labelled (f (CardanoBlock Crypto))
 -> K (Labelled (f (CardanoBlock Crypto))) a)
-> (Examples a -> Labelled (f (CardanoBlock Crypto)))
-> Examples a
-> K (Labelled (f (CardanoBlock Crypto))) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (ByronBlock : CardanoShelleyEras Crypto) a
-> Labelled (f a) -> Labelled (f (CardanoBlock Crypto))
forall blk.
Index (ByronBlock : CardanoShelleyEras Crypto) blk
-> Labelled (f blk) -> Labelled (f (CardanoBlock Crypto))
inj Index (ByronBlock : CardanoShelleyEras Crypto) a
ix (Labelled (f a) -> Labelled (f (CardanoBlock Crypto)))
-> (Examples a -> Labelled (f a))
-> Examples a
-> Labelled (f (CardanoBlock Crypto))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Examples a -> Labelled (f a)
forall blk. Examples blk -> Labelled (f blk)
getExamples) NP Examples (ByronBlock : CardanoShelleyEras Crypto)
perEraExamplesPrefixed
      where
        inj :: forall blk. Index (CardanoEras Crypto) blk -> Labelled (f blk) -> Labelled (f (CardanoBlock Crypto))
        inj :: forall blk.
Index (ByronBlock : CardanoShelleyEras Crypto) blk
-> Labelled (f blk) -> Labelled (f (CardanoBlock Crypto))
inj Index (ByronBlock : CardanoShelleyEras Crypto) blk
idx = ((Maybe String, f blk) -> (Maybe String, f (CardanoBlock Crypto)))
-> [(Maybe String, f blk)] -> Labelled (f (CardanoBlock Crypto))
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((f blk -> f (CardanoBlock Crypto))
-> (Maybe String, f blk) -> (Maybe String, f (CardanoBlock Crypto))
forall a b. (a -> b) -> (Maybe String, a) -> (Maybe String, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (InjectionIndex (ByronBlock : CardanoShelleyEras Crypto) blk
-> f blk -> f (CardanoBlock Crypto)
forall x (xs :: [*]).
(CanHardFork xs, HasCanonicalTxIn xs, HasHardForkTxOut xs) =>
InjectionIndex xs x -> f x -> f (HardForkBlock xs)
forall (f :: * -> *) x (xs :: [*]).
(Inject f, CanHardFork xs, HasCanonicalTxIn xs,
 HasHardForkTxOut xs) =>
InjectionIndex xs x -> f x -> f (HardForkBlock xs)
inject (InjectionIndex (ByronBlock : CardanoShelleyEras Crypto) blk
 -> f blk -> f (CardanoBlock Crypto))
-> InjectionIndex (ByronBlock : CardanoShelleyEras Crypto) blk
-> f blk
-> f (CardanoBlock Crypto)
forall a b. (a -> b) -> a -> b
$ Exactly (ByronBlock : CardanoShelleyEras Crypto) Bound
-> Index (ByronBlock : CardanoShelleyEras Crypto) blk
-> InjectionIndex (ByronBlock : CardanoShelleyEras Crypto) blk
forall (xs :: [*]) x.
SListI xs =>
Exactly xs Bound -> Index xs x -> InjectionIndex xs x
oracularInjectionIndex Exactly (ByronBlock : CardanoShelleyEras Crypto) Bound
exampleStartBounds Index (ByronBlock : CardanoShelleyEras Crypto) blk
idx))

    perEraExamplesPrefixed :: NP Examples (CardanoEras Crypto)
    perEraExamplesPrefixed :: NP Examples (ByronBlock : CardanoShelleyEras Crypto)
perEraExamplesPrefixed = Proxy SingleEraBlock
-> (forall a. SingleEraBlock a => Examples a -> Examples a)
-> NP Examples (ByronBlock : CardanoShelleyEras Crypto)
-> NP Examples (ByronBlock : CardanoShelleyEras Crypto)
forall {k} {l} (h :: (k -> *) -> l -> *) (c :: k -> Constraint)
       (xs :: l) (proxy :: (k -> Constraint) -> *) (f :: k -> *)
       (f' :: k -> *).
(AllN (Prod h) c xs, HAp h) =>
proxy c
-> (forall (a :: k). c a => f a -> f' a) -> h f xs -> h f' xs
hcmap Proxy SingleEraBlock
proxySingle Examples a -> Examples a
forall {blk}.
(SingleEraBlock blk,
 IndexedMemPack
   (LedgerState blk EmptyMK) (TxOut (LedgerState blk))) =>
Examples blk -> Examples blk
forall a. SingleEraBlock a => Examples a -> Examples a
prefixWithEraName NP Examples (ByronBlock : CardanoShelleyEras Crypto)
perEraExamples
      where
        prefixWithEraName :: Examples blk -> Examples blk
prefixWithEraName Examples blk
es = String -> Examples blk -> Examples blk
forall blk. String -> Examples blk -> Examples blk
prefixExamples (Text -> String
T.unpack Text
eraName) Examples blk
es
          where
            eraName :: Text
eraName = SingleEraInfo blk -> Text
forall blk. SingleEraInfo blk -> Text
singleEraName (SingleEraInfo blk -> Text) -> SingleEraInfo blk -> Text
forall a b. (a -> b) -> a -> b
$ Examples blk -> SingleEraInfo blk
forall blk (proxy :: * -> *).
SingleEraBlock blk =>
proxy blk -> SingleEraInfo blk
forall (proxy :: * -> *). proxy blk -> SingleEraInfo blk
singleEraInfo Examples blk
es

    exampleLedgerTablesCardano ::
         Labelled (LedgerTables (LedgerState (HardForkBlock (CardanoEras Crypto))) ValuesMK)
    exampleLedgerTablesCardano :: Labelled
  (LedgerTables (LedgerState (CardanoBlock Crypto)) ValuesMK)
exampleLedgerTablesCardano =
           [Labelled
   (LedgerTables (LedgerState (CardanoBlock Crypto)) ValuesMK)]
-> Labelled
     (LedgerTables (LedgerState (CardanoBlock Crypto)) ValuesMK)
forall a. Monoid a => [a] -> a
mconcat
         ([Labelled
    (LedgerTables (LedgerState (CardanoBlock Crypto)) ValuesMK)]
 -> Labelled
      (LedgerTables (LedgerState (CardanoBlock Crypto)) ValuesMK))
-> [Labelled
      (LedgerTables (LedgerState (CardanoBlock Crypto)) ValuesMK)]
-> Labelled
     (LedgerTables (LedgerState (CardanoBlock Crypto)) ValuesMK)
forall a b. (a -> b) -> a -> b
$ NP
  (K (Labelled
        (LedgerTables (LedgerState (CardanoBlock Crypto)) ValuesMK)))
  (ByronBlock : CardanoShelleyEras Crypto)
-> CollapseTo
     NP
     (Labelled
        (LedgerTables (LedgerState (CardanoBlock Crypto)) ValuesMK))
forall (xs :: [*]) a.
SListIN NP xs =>
NP (K a) xs -> CollapseTo NP a
forall k l (h :: (k -> *) -> l -> *) (xs :: l) a.
(HCollapse h, SListIN h xs) =>
h (K a) xs -> CollapseTo h a
hcollapse
         (NP
   (K (Labelled
         (LedgerTables (LedgerState (CardanoBlock Crypto)) ValuesMK)))
   (ByronBlock : CardanoShelleyEras Crypto)
 -> CollapseTo
      NP
      (Labelled
         (LedgerTables (LedgerState (CardanoBlock Crypto)) ValuesMK)))
-> NP
     (K (Labelled
           (LedgerTables (LedgerState (CardanoBlock Crypto)) ValuesMK)))
     (ByronBlock : CardanoShelleyEras Crypto)
-> CollapseTo
     NP
     (Labelled
        (LedgerTables (LedgerState (CardanoBlock Crypto)) ValuesMK))
forall a b. (a -> b) -> a -> b
$ (forall a.
 Index (ByronBlock : CardanoShelleyEras Crypto) a
 -> Examples a
 -> K (Labelled
         (LedgerTables (LedgerState (CardanoBlock Crypto)) ValuesMK))
      a)
-> NP Examples (ByronBlock : CardanoShelleyEras Crypto)
-> NP
     (K (Labelled
           (LedgerTables (LedgerState (CardanoBlock Crypto)) ValuesMK)))
     (ByronBlock : CardanoShelleyEras Crypto)
forall {k} (h :: (k -> *) -> [k] -> *) (xs :: [k]) (f1 :: k -> *)
       (f2 :: k -> *).
(HAp h, SListI xs, Prod h ~ NP) =>
(forall (a :: k). Index xs a -> f1 a -> f2 a) -> h f1 xs -> h f2 xs
himap (\Index (ByronBlock : CardanoShelleyEras Crypto) a
ix -> Labelled
  (LedgerTables (LedgerState (CardanoBlock Crypto)) ValuesMK)
-> K (Labelled
        (LedgerTables (LedgerState (CardanoBlock Crypto)) ValuesMK))
     a
forall k a (b :: k). a -> K a b
K (Labelled
   (LedgerTables (LedgerState (CardanoBlock Crypto)) ValuesMK)
 -> K (Labelled
         (LedgerTables (LedgerState (CardanoBlock Crypto)) ValuesMK))
      a)
-> (Examples a
    -> Labelled
         (LedgerTables (LedgerState (CardanoBlock Crypto)) ValuesMK))
-> Examples a
-> K (Labelled
        (LedgerTables (LedgerState (CardanoBlock Crypto)) ValuesMK))
     a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Maybe String, LedgerTables (LedgerState a) ValuesMK)
 -> (Maybe String,
     LedgerTables (LedgerState (CardanoBlock Crypto)) ValuesMK))
-> [(Maybe String, LedgerTables (LedgerState a) ValuesMK)]
-> Labelled
     (LedgerTables (LedgerState (CardanoBlock Crypto)) ValuesMK)
forall a b. (a -> b) -> [a] -> [b]
map ((LedgerTables (LedgerState a) ValuesMK
 -> LedgerTables (LedgerState (CardanoBlock Crypto)) ValuesMK)
-> (Maybe String, LedgerTables (LedgerState a) ValuesMK)
-> (Maybe String,
    LedgerTables (LedgerState (CardanoBlock Crypto)) ValuesMK)
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (Index (ByronBlock : CardanoShelleyEras Crypto) a
-> LedgerTables (LedgerState a) ValuesMK
-> LedgerTables (LedgerState (CardanoBlock Crypto)) ValuesMK
forall (xs :: [*]) x (mk :: * -> * -> *).
(CanMapKeysMK mk, CanMapMK mk, HasCanonicalTxIn xs,
 HasHardForkTxOut xs) =>
Index xs x
-> LedgerTables (LedgerState x) mk
-> LedgerTables (LedgerState (HardForkBlock xs)) mk
injectLedgerTables Index (ByronBlock : CardanoShelleyEras Crypto) a
ix)) ([(Maybe String, LedgerTables (LedgerState a) ValuesMK)]
 -> Labelled
      (LedgerTables (LedgerState (CardanoBlock Crypto)) ValuesMK))
-> (Examples a
    -> [(Maybe String, LedgerTables (LedgerState a) ValuesMK)])
-> Examples a
-> Labelled
     (LedgerTables (LedgerState (CardanoBlock Crypto)) ValuesMK)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Examples a
-> [(Maybe String, LedgerTables (LedgerState a) ValuesMK)]
forall blk.
Examples blk -> Labelled (LedgerTables (LedgerState blk) ValuesMK)
exampleLedgerTables) NP Examples (ByronBlock : CardanoShelleyEras Crypto)
perEraExamplesPrefixed

    exampleLedgerConfigCardano ::
         Labelled (HardForkLedgerConfig (CardanoEras Crypto))
    exampleLedgerConfigCardano :: Labelled
  (HardForkLedgerConfig (ByronBlock : CardanoShelleyEras Crypto))
exampleLedgerConfigCardano = [
        ( Maybe String
forall a. Maybe a
Nothing
        , Shape (ByronBlock : CardanoShelleyEras Crypto)
-> PerEraLedgerConfig (ByronBlock : CardanoShelleyEras Crypto)
-> HardForkLedgerConfig (ByronBlock : CardanoShelleyEras Crypto)
forall (xs :: [*]).
Shape xs -> PerEraLedgerConfig xs -> HardForkLedgerConfig xs
HardForkLedgerConfig
            Shape (ByronBlock : CardanoShelleyEras Crypto)
cardanoShape
            (NP WrapPartialLedgerConfig (ByronBlock : CardanoShelleyEras Crypto)
-> PerEraLedgerConfig (ByronBlock : CardanoShelleyEras Crypto)
forall (xs :: [*]).
NP WrapPartialLedgerConfig xs -> PerEraLedgerConfig xs
PerEraLedgerConfig (
                 PartialLedgerConfig ByronBlock
-> WrapPartialLedgerConfig ByronBlock
forall blk. PartialLedgerConfig blk -> WrapPartialLedgerConfig blk
WrapPartialLedgerConfig (LedgerConfig ByronBlock
-> TriggerHardFork -> ByronPartialLedgerConfig
ByronPartialLedgerConfig   LedgerConfig ByronBlock
lcByron   (EpochNo -> TriggerHardFork
TriggerHardForkAtEpoch EpochNo
shelleyTransitionEpoch))
              WrapPartialLedgerConfig ByronBlock
-> NP WrapPartialLedgerConfig (CardanoShelleyEras Crypto)
-> NP
     WrapPartialLedgerConfig (ByronBlock : CardanoShelleyEras Crypto)
forall {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> NP f xs1 -> NP f (x : xs1)
:* PartialLedgerConfig (ShelleyBlock (TPraos Crypto) ShelleyEra)
-> WrapPartialLedgerConfig
     (ShelleyBlock (TPraos Crypto) ShelleyEra)
forall blk. PartialLedgerConfig blk -> WrapPartialLedgerConfig blk
WrapPartialLedgerConfig (ShelleyLedgerConfig ShelleyEra
-> TriggerHardFork -> ShelleyPartialLedgerConfig ShelleyEra
forall era.
ShelleyLedgerConfig era
-> TriggerHardFork -> ShelleyPartialLedgerConfig era
ShelleyPartialLedgerConfig LedgerConfig (ShelleyBlock (TPraos Crypto) ShelleyEra)
ShelleyLedgerConfig ShelleyEra
lcShelley (EpochNo -> TriggerHardFork
TriggerHardForkAtEpoch (Bound -> EpochNo
History.boundEpoch Bound
allegraStartBound)))
              WrapPartialLedgerConfig (ShelleyBlock (TPraos Crypto) ShelleyEra)
-> NP
     WrapPartialLedgerConfig
     '[ShelleyBlock (TPraos Crypto) AllegraEra,
       ShelleyBlock (TPraos Crypto) MaryEra,
       ShelleyBlock (TPraos Crypto) AlonzoEra,
       ShelleyBlock (Praos Crypto) BabbageEra,
       ShelleyBlock (Praos Crypto) ConwayEra]
-> NP WrapPartialLedgerConfig (CardanoShelleyEras Crypto)
forall {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> NP f xs1 -> NP f (x : xs1)
:* PartialLedgerConfig (ShelleyBlock (TPraos Crypto) AllegraEra)
-> WrapPartialLedgerConfig
     (ShelleyBlock (TPraos Crypto) AllegraEra)
forall blk. PartialLedgerConfig blk -> WrapPartialLedgerConfig blk
WrapPartialLedgerConfig (ShelleyLedgerConfig AllegraEra
-> TriggerHardFork -> ShelleyPartialLedgerConfig AllegraEra
forall era.
ShelleyLedgerConfig era
-> TriggerHardFork -> ShelleyPartialLedgerConfig era
ShelleyPartialLedgerConfig LedgerConfig (ShelleyBlock (TPraos Crypto) AllegraEra)
ShelleyLedgerConfig AllegraEra
lcAllegra (EpochNo -> TriggerHardFork
TriggerHardForkAtEpoch (Bound -> EpochNo
History.boundEpoch Bound
maryStartBound)))
              WrapPartialLedgerConfig (ShelleyBlock (TPraos Crypto) AllegraEra)
-> NP
     WrapPartialLedgerConfig
     '[ShelleyBlock (TPraos Crypto) MaryEra,
       ShelleyBlock (TPraos Crypto) AlonzoEra,
       ShelleyBlock (Praos Crypto) BabbageEra,
       ShelleyBlock (Praos Crypto) ConwayEra]
-> NP
     WrapPartialLedgerConfig
     '[ShelleyBlock (TPraos Crypto) AllegraEra,
       ShelleyBlock (TPraos Crypto) MaryEra,
       ShelleyBlock (TPraos Crypto) AlonzoEra,
       ShelleyBlock (Praos Crypto) BabbageEra,
       ShelleyBlock (Praos Crypto) ConwayEra]
forall {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> NP f xs1 -> NP f (x : xs1)
:* PartialLedgerConfig (ShelleyBlock (TPraos Crypto) MaryEra)
-> WrapPartialLedgerConfig (ShelleyBlock (TPraos Crypto) MaryEra)
forall blk. PartialLedgerConfig blk -> WrapPartialLedgerConfig blk
WrapPartialLedgerConfig (ShelleyLedgerConfig MaryEra
-> TriggerHardFork -> ShelleyPartialLedgerConfig MaryEra
forall era.
ShelleyLedgerConfig era
-> TriggerHardFork -> ShelleyPartialLedgerConfig era
ShelleyPartialLedgerConfig LedgerConfig (ShelleyBlock (TPraos Crypto) MaryEra)
ShelleyLedgerConfig MaryEra
lcMary    (EpochNo -> TriggerHardFork
TriggerHardForkAtEpoch (Bound -> EpochNo
History.boundEpoch Bound
alonzoStartBound)))
              WrapPartialLedgerConfig (ShelleyBlock (TPraos Crypto) MaryEra)
-> NP
     WrapPartialLedgerConfig
     '[ShelleyBlock (TPraos Crypto) AlonzoEra,
       ShelleyBlock (Praos Crypto) BabbageEra,
       ShelleyBlock (Praos Crypto) ConwayEra]
-> NP
     WrapPartialLedgerConfig
     '[ShelleyBlock (TPraos Crypto) MaryEra,
       ShelleyBlock (TPraos Crypto) AlonzoEra,
       ShelleyBlock (Praos Crypto) BabbageEra,
       ShelleyBlock (Praos Crypto) ConwayEra]
forall {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> NP f xs1 -> NP f (x : xs1)
:* PartialLedgerConfig (ShelleyBlock (TPraos Crypto) AlonzoEra)
-> WrapPartialLedgerConfig (ShelleyBlock (TPraos Crypto) AlonzoEra)
forall blk. PartialLedgerConfig blk -> WrapPartialLedgerConfig blk
WrapPartialLedgerConfig (ShelleyLedgerConfig AlonzoEra
-> TriggerHardFork -> ShelleyPartialLedgerConfig AlonzoEra
forall era.
ShelleyLedgerConfig era
-> TriggerHardFork -> ShelleyPartialLedgerConfig era
ShelleyPartialLedgerConfig LedgerConfig (ShelleyBlock (TPraos Crypto) AlonzoEra)
ShelleyLedgerConfig AlonzoEra
lcAlonzo  (EpochNo -> TriggerHardFork
TriggerHardForkAtEpoch (Bound -> EpochNo
History.boundEpoch Bound
babbageStartBound)))
              WrapPartialLedgerConfig (ShelleyBlock (TPraos Crypto) AlonzoEra)
-> NP
     WrapPartialLedgerConfig
     '[ShelleyBlock (Praos Crypto) BabbageEra,
       ShelleyBlock (Praos Crypto) ConwayEra]
-> NP
     WrapPartialLedgerConfig
     '[ShelleyBlock (TPraos Crypto) AlonzoEra,
       ShelleyBlock (Praos Crypto) BabbageEra,
       ShelleyBlock (Praos Crypto) ConwayEra]
forall {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> NP f xs1 -> NP f (x : xs1)
:* PartialLedgerConfig (ShelleyBlock (Praos Crypto) BabbageEra)
-> WrapPartialLedgerConfig (ShelleyBlock (Praos Crypto) BabbageEra)
forall blk. PartialLedgerConfig blk -> WrapPartialLedgerConfig blk
WrapPartialLedgerConfig (ShelleyLedgerConfig BabbageEra
-> TriggerHardFork -> ShelleyPartialLedgerConfig BabbageEra
forall era.
ShelleyLedgerConfig era
-> TriggerHardFork -> ShelleyPartialLedgerConfig era
ShelleyPartialLedgerConfig LedgerConfig (ShelleyBlock (Praos Crypto) BabbageEra)
ShelleyLedgerConfig BabbageEra
lcBabbage (EpochNo -> TriggerHardFork
TriggerHardForkAtEpoch (Bound -> EpochNo
History.boundEpoch Bound
conwayStartBound)))
              WrapPartialLedgerConfig (ShelleyBlock (Praos Crypto) BabbageEra)
-> NP
     WrapPartialLedgerConfig '[ShelleyBlock (Praos Crypto) ConwayEra]
-> NP
     WrapPartialLedgerConfig
     '[ShelleyBlock (Praos Crypto) BabbageEra,
       ShelleyBlock (Praos Crypto) ConwayEra]
forall {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> NP f xs1 -> NP f (x : xs1)
:* PartialLedgerConfig (ShelleyBlock (Praos Crypto) ConwayEra)
-> WrapPartialLedgerConfig (ShelleyBlock (Praos Crypto) ConwayEra)
forall blk. PartialLedgerConfig blk -> WrapPartialLedgerConfig blk
WrapPartialLedgerConfig (ShelleyLedgerConfig ConwayEra
-> TriggerHardFork -> ShelleyPartialLedgerConfig ConwayEra
forall era.
ShelleyLedgerConfig era
-> TriggerHardFork -> ShelleyPartialLedgerConfig era
ShelleyPartialLedgerConfig LedgerConfig (ShelleyBlock (Praos Crypto) ConwayEra)
ShelleyLedgerConfig ConwayEra
lcConway  TriggerHardFork
TriggerHardForkNotDuringThisExecution)
              WrapPartialLedgerConfig (ShelleyBlock (Praos Crypto) ConwayEra)
-> NP WrapPartialLedgerConfig '[]
-> NP
     WrapPartialLedgerConfig '[ShelleyBlock (Praos Crypto) ConwayEra]
forall {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> NP f xs1 -> NP f (x : xs1)
:* NP WrapPartialLedgerConfig '[]
forall {k} (f :: k -> *). NP f '[]
Nil))
        )
      | WrapLedgerConfig LedgerConfig ByronBlock
lcByron   <- [WrapLedgerConfig ByronBlock]
labelledLcByron
      , WrapLedgerConfig LedgerConfig (ShelleyBlock (TPraos Crypto) ShelleyEra)
lcShelley <- [WrapLedgerConfig (ShelleyBlock (TPraos Crypto) ShelleyEra)]
labelledLcShelley
      , WrapLedgerConfig LedgerConfig (ShelleyBlock (TPraos Crypto) AllegraEra)
lcAllegra <- [WrapLedgerConfig (ShelleyBlock (TPraos Crypto) AllegraEra)]
labelledLcAllegra
      , WrapLedgerConfig LedgerConfig (ShelleyBlock (TPraos Crypto) MaryEra)
lcMary    <- [WrapLedgerConfig (ShelleyBlock (TPraos Crypto) MaryEra)]
labelledLcMary
      , WrapLedgerConfig LedgerConfig (ShelleyBlock (TPraos Crypto) AlonzoEra)
lcAlonzo  <- [WrapLedgerConfig (ShelleyBlock (TPraos Crypto) AlonzoEra)]
labelledLcAlonzo
      , WrapLedgerConfig LedgerConfig (ShelleyBlock (Praos Crypto) BabbageEra)
lcBabbage <- [WrapLedgerConfig (ShelleyBlock (Praos Crypto) BabbageEra)]
labelledLcBabbage
      , WrapLedgerConfig LedgerConfig (ShelleyBlock (Praos Crypto) ConwayEra)
lcConway  <- [WrapLedgerConfig (ShelleyBlock (Praos Crypto) ConwayEra)]
labelledLcConway
      ]
      where
        (    Comp [WrapLedgerConfig x]
[WrapLedgerConfig ByronBlock]
labelledLcByron
          :* Comp [WrapLedgerConfig x]
[WrapLedgerConfig (ShelleyBlock (TPraos Crypto) ShelleyEra)]
labelledLcShelley
          :* Comp [WrapLedgerConfig x]
[WrapLedgerConfig (ShelleyBlock (TPraos Crypto) AllegraEra)]
labelledLcAllegra
          :* Comp [WrapLedgerConfig x]
[WrapLedgerConfig (ShelleyBlock (TPraos Crypto) MaryEra)]
labelledLcMary
          :* Comp [WrapLedgerConfig x]
[WrapLedgerConfig (ShelleyBlock (TPraos Crypto) AlonzoEra)]
labelledLcAlonzo
          :* Comp [WrapLedgerConfig x]
[WrapLedgerConfig (ShelleyBlock (Praos Crypto) BabbageEra)]
labelledLcBabbage
          :* Comp [WrapLedgerConfig x]
[WrapLedgerConfig (ShelleyBlock (Praos Crypto) ConwayEra)]
labelledLcConway
          :* NP ([] :.: WrapLedgerConfig) xs1
Nil
          ) = (forall a. Examples a -> (:.:) [] WrapLedgerConfig a)
-> NP Examples (ByronBlock : CardanoShelleyEras Crypto)
-> NP
     ([] :.: WrapLedgerConfig) (ByronBlock : CardanoShelleyEras Crypto)
forall {k} {l} (h :: (k -> *) -> l -> *) (xs :: l) (f :: k -> *)
       (f' :: k -> *).
(SListIN (Prod h) xs, HAp h) =>
(forall (a :: k). f a -> f' a) -> h f xs -> h f' xs
hmap ([WrapLedgerConfig a] -> (:.:) [] WrapLedgerConfig a
forall l k (f :: l -> *) (g :: k -> l) (p :: k).
f (g p) -> (:.:) f g p
Comp ([WrapLedgerConfig a] -> (:.:) [] WrapLedgerConfig a)
-> (Examples a -> [WrapLedgerConfig a])
-> Examples a
-> (:.:) [] WrapLedgerConfig a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Maybe String, LedgerCfg (LedgerState a)) -> WrapLedgerConfig a)
-> [(Maybe String, LedgerCfg (LedgerState a))]
-> [WrapLedgerConfig a]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (LedgerCfg (LedgerState a) -> WrapLedgerConfig a
forall blk. LedgerConfig blk -> WrapLedgerConfig blk
WrapLedgerConfig (LedgerCfg (LedgerState a) -> WrapLedgerConfig a)
-> ((Maybe String, LedgerCfg (LedgerState a))
    -> LedgerCfg (LedgerState a))
-> (Maybe String, LedgerCfg (LedgerState a))
-> WrapLedgerConfig a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe String, LedgerCfg (LedgerState a))
-> LedgerCfg (LedgerState a)
forall a b. (a, b) -> b
snd) ([(Maybe String, LedgerCfg (LedgerState a))]
 -> [WrapLedgerConfig a])
-> (Examples a -> [(Maybe String, LedgerCfg (LedgerState a))])
-> Examples a
-> [WrapLedgerConfig a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Examples a -> [(Maybe String, LedgerCfg (LedgerState a))]
forall blk. Examples blk -> Labelled (LedgerConfig blk)
exampleLedgerConfig) NP Examples (ByronBlock : CardanoShelleyEras Crypto)
perEraExamples

{-------------------------------------------------------------------------------
  Inject instances
-------------------------------------------------------------------------------}

-- | In reality, an era tag would be prepended, but we're testing that the
-- encoder doesn't care what the bytes are.
instance Inject Serialised where
  inject :: forall x (xs :: [*]).
(CanHardFork xs, HasCanonicalTxIn xs, HasHardForkTxOut xs) =>
InjectionIndex xs x
-> Serialised x -> Serialised (HardForkBlock xs)
inject InjectionIndex xs x
_ (Serialised ByteString
_) = ByteString -> Serialised (HardForkBlock xs)
forall {k} (a :: k). ByteString -> Serialised a
Serialised ByteString
"<CARDANO_BLOCK>"

instance Inject SomeResult where
  inject :: forall x (xs :: [*]).
(CanHardFork xs, HasCanonicalTxIn xs, HasHardForkTxOut xs) =>
InjectionIndex xs x
-> SomeResult x -> SomeResult (HardForkBlock xs)
inject InjectionIndex xs x
iidx (SomeResult BlockQuery x fp result
q result
r) =
      BlockQuery
  (HardForkBlock xs) fp (Either (MismatchEraInfo xs) result)
-> Either (MismatchEraInfo xs) result
-> SomeResult (HardForkBlock xs)
forall result blk (fp :: QueryFootprint).
(Eq result, Show result, Typeable result) =>
BlockQuery blk fp result -> result -> SomeResult blk
SomeResult
        (QueryIfCurrent xs fp result
-> BlockQuery
     (HardForkBlock xs) fp (Either (MismatchEraInfo xs) result)
forall (xs :: [*]) (footprint :: QueryFootprint) result1.
QueryIfCurrent xs footprint result1
-> BlockQuery
     (HardForkBlock xs) footprint (Either (MismatchEraInfo xs) result1)
QueryIfCurrent (Index xs x -> BlockQuery x fp result -> QueryIfCurrent xs fp result
forall x (xs :: [*]) result (fp :: QueryFootprint).
Index xs x -> BlockQuery x fp result -> QueryIfCurrent xs fp result
injectQuery (InjectionIndex xs x -> Index xs x
forall (xs :: [*]) x.
SListI xs =>
InjectionIndex xs x -> Index xs x
forgetInjectionIndex InjectionIndex xs x
iidx) BlockQuery x fp result
q))
        (result -> Either (MismatchEraInfo xs) result
forall a b. b -> Either a b
Right result
r)

instance Inject Examples where
  inject :: forall x (xs :: [*]).
(CanHardFork xs, HasCanonicalTxIn xs, HasHardForkTxOut xs) =>
InjectionIndex xs x -> Examples x -> Examples (HardForkBlock xs)
inject (InjectionIndex xs x
iidx :: InjectionIndex xs x) Examples {Labelled x
Labelled SlotNo
Labelled (HeaderHash x)
Labelled (Header x)
Labelled (LedgerTables (LedgerState x) ValuesMK)
Labelled (ChainDepState (BlockProtocol x))
Labelled (LedgerState x EmptyMK)
Labelled (LedgerConfig x)
Labelled (GenTxId x)
Labelled (ApplyTxErr x)
Labelled (GenTx x)
Labelled (AnnTip x)
Labelled (SerialisedHeader x)
Labelled (ExtLedgerState x EmptyMK)
Labelled (SomeBlockQuery (BlockQuery x))
Labelled (Serialised x)
Labelled (SomeResult x)
exampleBlock :: forall blk. Examples blk -> Labelled blk
exampleSerialisedBlock :: forall blk. Examples blk -> Labelled (Serialised blk)
exampleHeader :: forall blk. Examples blk -> Labelled (Header blk)
exampleSerialisedHeader :: forall blk. Examples blk -> Labelled (SerialisedHeader blk)
exampleHeaderHash :: forall blk. Examples blk -> Labelled (HeaderHash blk)
exampleGenTx :: forall blk. Examples blk -> Labelled (GenTx blk)
exampleGenTxId :: forall blk. Examples blk -> Labelled (GenTxId blk)
exampleApplyTxErr :: forall blk. Examples blk -> Labelled (ApplyTxErr blk)
exampleQuery :: forall blk.
Examples blk -> Labelled (SomeBlockQuery (BlockQuery blk))
exampleResult :: forall blk. Examples blk -> Labelled (SomeResult blk)
exampleAnnTip :: forall blk. Examples blk -> Labelled (AnnTip blk)
exampleLedgerState :: forall blk. Examples blk -> Labelled (LedgerState blk EmptyMK)
exampleChainDepState :: forall blk.
Examples blk -> Labelled (ChainDepState (BlockProtocol blk))
exampleExtLedgerState :: forall blk. Examples blk -> Labelled (ExtLedgerState blk EmptyMK)
exampleSlotNo :: forall blk. Examples blk -> Labelled SlotNo
exampleLedgerConfig :: forall blk. Examples blk -> Labelled (LedgerConfig blk)
exampleLedgerTables :: forall blk.
Examples blk -> Labelled (LedgerTables (LedgerState blk) ValuesMK)
exampleBlock :: Labelled x
exampleSerialisedBlock :: Labelled (Serialised x)
exampleHeader :: Labelled (Header x)
exampleSerialisedHeader :: Labelled (SerialisedHeader x)
exampleHeaderHash :: Labelled (HeaderHash x)
exampleGenTx :: Labelled (GenTx x)
exampleGenTxId :: Labelled (GenTxId x)
exampleApplyTxErr :: Labelled (ApplyTxErr x)
exampleQuery :: Labelled (SomeBlockQuery (BlockQuery x))
exampleResult :: Labelled (SomeResult x)
exampleAnnTip :: Labelled (AnnTip x)
exampleLedgerState :: Labelled (LedgerState x EmptyMK)
exampleChainDepState :: Labelled (ChainDepState (BlockProtocol x))
exampleExtLedgerState :: Labelled (ExtLedgerState x EmptyMK)
exampleSlotNo :: Labelled SlotNo
exampleLedgerConfig :: Labelled (LedgerConfig x)
exampleLedgerTables :: Labelled (LedgerTables (LedgerState x) ValuesMK)
..} = Examples {
        exampleBlock :: Labelled (HardForkBlock xs)
exampleBlock            = Proxy I -> Labelled x -> Labelled (HardForkBlock xs)
forall (f :: * -> *) a b.
(Inject f, Coercible a (f x),
 Coercible b (f (HardForkBlock xs))) =>
Proxy f -> Labelled a -> Labelled b
inj (forall {k} (t :: k). Proxy t
forall (t :: * -> *). Proxy t
Proxy @I)                               Labelled x
exampleBlock
      , exampleSerialisedBlock :: Labelled (Serialised (HardForkBlock xs))
exampleSerialisedBlock  = Proxy Serialised
-> Labelled (Serialised x)
-> Labelled (Serialised (HardForkBlock xs))
forall (f :: * -> *) a b.
(Inject f, Coercible a (f x),
 Coercible b (f (HardForkBlock xs))) =>
Proxy f -> Labelled a -> Labelled b
inj (forall {k} (t :: k). Proxy t
forall (t :: * -> *). Proxy t
Proxy @Serialised)                      Labelled (Serialised x)
exampleSerialisedBlock
      , exampleHeader :: Labelled (Header (HardForkBlock xs))
exampleHeader           = Proxy Header
-> Labelled (Header x) -> Labelled (Header (HardForkBlock xs))
forall (f :: * -> *) a b.
(Inject f, Coercible a (f x),
 Coercible b (f (HardForkBlock xs))) =>
Proxy f -> Labelled a -> Labelled b
inj (forall {k} (t :: k). Proxy t
forall (t :: * -> *). Proxy t
Proxy @Header)                          Labelled (Header x)
exampleHeader
      , exampleSerialisedHeader :: Labelled (SerialisedHeader (HardForkBlock xs))
exampleSerialisedHeader = Proxy SerialisedHeader
-> Labelled (SerialisedHeader x)
-> Labelled (SerialisedHeader (HardForkBlock xs))
forall (f :: * -> *) a b.
(Inject f, Coercible a (f x),
 Coercible b (f (HardForkBlock xs))) =>
Proxy f -> Labelled a -> Labelled b
inj (forall {k} (t :: k). Proxy t
forall (t :: * -> *). Proxy t
Proxy @SerialisedHeader)                Labelled (SerialisedHeader x)
exampleSerialisedHeader
      , exampleHeaderHash :: Labelled (HeaderHash (HardForkBlock xs))
exampleHeaderHash       = Proxy WrapHeaderHash
-> Labelled (HeaderHash x) -> Labelled (OneEraHash xs)
forall (f :: * -> *) a b.
(Inject f, Coercible a (f x),
 Coercible b (f (HardForkBlock xs))) =>
Proxy f -> Labelled a -> Labelled b
inj (forall {k} (t :: k). Proxy t
forall (t :: * -> *). Proxy t
Proxy @WrapHeaderHash)                  Labelled (HeaderHash x)
exampleHeaderHash
      , exampleGenTx :: Labelled (GenTx (HardForkBlock xs))
exampleGenTx            = Proxy GenTx
-> Labelled (GenTx x) -> Labelled (GenTx (HardForkBlock xs))
forall (f :: * -> *) a b.
(Inject f, Coercible a (f x),
 Coercible b (f (HardForkBlock xs))) =>
Proxy f -> Labelled a -> Labelled b
inj (forall {k} (t :: k). Proxy t
forall (t :: * -> *). Proxy t
Proxy @GenTx)                           Labelled (GenTx x)
exampleGenTx
      , exampleGenTxId :: Labelled (GenTxId (HardForkBlock xs))
exampleGenTxId          = Proxy WrapGenTxId
-> Labelled (GenTxId x) -> Labelled (GenTxId (HardForkBlock xs))
forall (f :: * -> *) a b.
(Inject f, Coercible a (f x),
 Coercible b (f (HardForkBlock xs))) =>
Proxy f -> Labelled a -> Labelled b
inj (forall {k} (t :: k). Proxy t
forall (t :: * -> *). Proxy t
Proxy @WrapGenTxId)                     Labelled (GenTxId x)
exampleGenTxId
      , exampleApplyTxErr :: Labelled (ApplyTxErr (HardForkBlock xs))
exampleApplyTxErr       = Proxy WrapApplyTxErr
-> Labelled (ApplyTxErr x) -> Labelled (HardForkApplyTxErr xs)
forall (f :: * -> *) a b.
(Inject f, Coercible a (f x),
 Coercible b (f (HardForkBlock xs))) =>
Proxy f -> Labelled a -> Labelled b
inj (forall {k} (t :: k). Proxy t
forall (t :: * -> *). Proxy t
Proxy @WrapApplyTxErr)                  Labelled (ApplyTxErr x)
exampleApplyTxErr
      , exampleQuery :: Labelled (SomeBlockQuery (BlockQuery (HardForkBlock xs)))
exampleQuery            = Proxy (SomeBlockQuery :.: BlockQuery)
-> Labelled (SomeBlockQuery (BlockQuery x))
-> Labelled (SomeBlockQuery (BlockQuery (HardForkBlock xs)))
forall (f :: * -> *) a b.
(Inject f, Coercible a (f x),
 Coercible b (f (HardForkBlock xs))) =>
Proxy f -> Labelled a -> Labelled b
inj (forall {k} (t :: k). Proxy t
forall (t :: * -> *). Proxy t
Proxy @(SomeBlockQuery :.: BlockQuery)) Labelled (SomeBlockQuery (BlockQuery x))
exampleQuery
      , exampleResult :: Labelled (SomeResult (HardForkBlock xs))
exampleResult           = Proxy SomeResult
-> Labelled (SomeResult x)
-> Labelled (SomeResult (HardForkBlock xs))
forall (f :: * -> *) a b.
(Inject f, Coercible a (f x),
 Coercible b (f (HardForkBlock xs))) =>
Proxy f -> Labelled a -> Labelled b
inj (forall {k} (t :: k). Proxy t
forall (t :: * -> *). Proxy t
Proxy @SomeResult)                      Labelled (SomeResult x)
exampleResult
      , exampleAnnTip :: Labelled (AnnTip (HardForkBlock xs))
exampleAnnTip           = Proxy AnnTip
-> Labelled (AnnTip x) -> Labelled (AnnTip (HardForkBlock xs))
forall (f :: * -> *) a b.
(Inject f, Coercible a (f x),
 Coercible b (f (HardForkBlock xs))) =>
Proxy f -> Labelled a -> Labelled b
inj (forall {k} (t :: k). Proxy t
forall (t :: * -> *). Proxy t
Proxy @AnnTip)                          Labelled (AnnTip x)
exampleAnnTip
      , exampleLedgerState :: Labelled (LedgerState (HardForkBlock xs) EmptyMK)
exampleLedgerState      = Proxy (Flip LedgerState EmptyMK)
-> Labelled (LedgerState x EmptyMK)
-> Labelled (LedgerState (HardForkBlock xs) EmptyMK)
forall (f :: * -> *) a b.
(Inject f, Coercible a (f x),
 Coercible b (f (HardForkBlock xs))) =>
Proxy f -> Labelled a -> Labelled b
inj (forall {k} (t :: k). Proxy t
forall (t :: * -> *). Proxy t
Proxy @(Flip LedgerState EmptyMK))      Labelled (LedgerState x EmptyMK)
exampleLedgerState
      , exampleChainDepState :: Labelled (ChainDepState (BlockProtocol (HardForkBlock xs)))
exampleChainDepState    = Proxy WrapChainDepState
-> Labelled (ChainDepState (BlockProtocol x))
-> Labelled (HardForkChainDepState xs)
forall (f :: * -> *) a b.
(Inject f, Coercible a (f x),
 Coercible b (f (HardForkBlock xs))) =>
Proxy f -> Labelled a -> Labelled b
inj (forall {k} (t :: k). Proxy t
forall (t :: * -> *). Proxy t
Proxy @WrapChainDepState)               Labelled (ChainDepState (BlockProtocol x))
exampleChainDepState
      , exampleExtLedgerState :: Labelled (ExtLedgerState (HardForkBlock xs) EmptyMK)
exampleExtLedgerState   = Proxy (Flip ExtLedgerState EmptyMK)
-> Labelled (ExtLedgerState x EmptyMK)
-> Labelled (ExtLedgerState (HardForkBlock xs) EmptyMK)
forall (f :: * -> *) a b.
(Inject f, Coercible a (f x),
 Coercible b (f (HardForkBlock xs))) =>
Proxy f -> Labelled a -> Labelled b
inj (forall {k} (t :: k). Proxy t
forall (t :: * -> *). Proxy t
Proxy @(Flip ExtLedgerState EmptyMK))   Labelled (ExtLedgerState x EmptyMK)
exampleExtLedgerState
      , exampleSlotNo :: Labelled SlotNo
exampleSlotNo           =                                              Labelled SlotNo
exampleSlotNo
      , exampleLedgerTables :: Labelled (LedgerTables (LedgerState (HardForkBlock xs)) ValuesMK)
exampleLedgerTables     = Proxy WrapLedgerTables
-> Labelled (LedgerTables (LedgerState x) ValuesMK)
-> Labelled
     (LedgerTables (LedgerState (HardForkBlock xs)) ValuesMK)
forall (f :: * -> *) a b.
(Inject f, Coercible a (f x),
 Coercible b (f (HardForkBlock xs))) =>
Proxy f -> Labelled a -> Labelled b
inj (forall {k} (t :: k). Proxy t
forall (t :: * -> *). Proxy t
Proxy @WrapLedgerTables)                Labelled (LedgerTables (LedgerState x) ValuesMK)
exampleLedgerTables
        -- We cannot create a HF Ledger Config out of just one of the eras
      , exampleLedgerConfig :: Labelled (LedgerConfig (HardForkBlock xs))
exampleLedgerConfig     = Labelled (LedgerConfig (HardForkBlock xs))
Labelled (HardForkLedgerConfig xs)
forall a. Monoid a => a
mempty
      }
    where
      inj ::
           forall f a b.
           ( Inject f
           , Coercible a (f x)
           , Coercible b (f (HardForkBlock xs))
           )
        => Proxy f -> Labelled a -> Labelled b
      inj :: forall (f :: * -> *) a b.
(Inject f, Coercible a (f x),
 Coercible b (f (HardForkBlock xs))) =>
Proxy f -> Labelled a -> Labelled b
inj Proxy f
p = ((Maybe String, a) -> (Maybe String, b))
-> [(Maybe String, a)] -> [(Maybe String, b)]
forall a b. (a -> b) -> [a] -> [b]
map ((a -> b) -> (Maybe String, a) -> (Maybe String, b)
forall a b. (a -> b) -> (Maybe String, a) -> (Maybe String, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Proxy f -> InjectionIndex xs x -> a -> b
forall (f :: * -> *) a b x (xs :: [*]).
(Inject f, CanHardFork xs, HasCanonicalTxIn xs,
 HasHardForkTxOut xs, Coercible a (f x),
 Coercible b (f (HardForkBlock xs))) =>
Proxy f -> InjectionIndex xs x -> a -> b
inject' Proxy f
p InjectionIndex xs x
iidx))

-- | This wrapper is used only in the 'Example' instance of 'Inject' so that we
-- can use a type that matches the kind expected by 'inj'.
newtype WrapLedgerTables blk = WrapLedgerTables ( LedgerTables (ExtLedgerState blk) ValuesMK )

instance Inject WrapLedgerTables where
  inject :: forall x (xs :: [*]).
(CanHardFork xs, HasCanonicalTxIn xs, HasHardForkTxOut xs) =>
InjectionIndex xs x
-> WrapLedgerTables x -> WrapLedgerTables (HardForkBlock xs)
inject InjectionIndex xs x
idx (WrapLedgerTables LedgerTables (ExtLedgerState x) ValuesMK
lt) =
    LedgerTables (ExtLedgerState (HardForkBlock xs)) ValuesMK
-> WrapLedgerTables (HardForkBlock xs)
forall blk.
LedgerTables (ExtLedgerState blk) ValuesMK -> WrapLedgerTables blk
WrapLedgerTables (LedgerTables (ExtLedgerState (HardForkBlock xs)) ValuesMK
 -> WrapLedgerTables (HardForkBlock xs))
-> LedgerTables (ExtLedgerState (HardForkBlock xs)) ValuesMK
-> WrapLedgerTables (HardForkBlock xs)
forall a b. (a -> b) -> a -> b
$ LedgerTables (LedgerState (HardForkBlock xs)) ValuesMK
-> LedgerTables (ExtLedgerState (HardForkBlock xs)) ValuesMK
forall (l :: LedgerStateKind) (l' :: LedgerStateKind)
       (mk :: * -> * -> *).
SameUtxoTypes l l' =>
LedgerTables l mk -> LedgerTables l' mk
castLedgerTables (LedgerTables (LedgerState (HardForkBlock xs)) ValuesMK
 -> LedgerTables (ExtLedgerState (HardForkBlock xs)) ValuesMK)
-> LedgerTables (LedgerState (HardForkBlock xs)) ValuesMK
-> LedgerTables (ExtLedgerState (HardForkBlock xs)) ValuesMK
forall a b. (a -> b) -> a -> b
$ Index xs x
-> LedgerTables (LedgerState x) ValuesMK
-> LedgerTables (LedgerState (HardForkBlock xs)) ValuesMK
forall (xs :: [*]) x (mk :: * -> * -> *).
(CanMapKeysMK mk, CanMapMK mk, HasCanonicalTxIn xs,
 HasHardForkTxOut xs) =>
Index xs x
-> LedgerTables (LedgerState x) mk
-> LedgerTables (LedgerState (HardForkBlock xs)) mk
injectLedgerTables (InjectionIndex xs x -> Index xs x
forall (xs :: [*]) x.
SListI xs =>
InjectionIndex xs x -> Index xs x
forgetInjectionIndex InjectionIndex xs x
idx) (LedgerTables (ExtLedgerState x) ValuesMK
-> LedgerTables (LedgerState x) ValuesMK
forall (l :: LedgerStateKind) (l' :: LedgerStateKind)
       (mk :: * -> * -> *).
SameUtxoTypes l l' =>
LedgerTables l mk -> LedgerTables l' mk
castLedgerTables LedgerTables (ExtLedgerState x) ValuesMK
lt)

{-------------------------------------------------------------------------------
  Setup
-------------------------------------------------------------------------------}

byronEraParams :: History.EraParams
byronEraParams :: EraParams
byronEraParams = Config -> EraParams
Byron.byronEraParams Config
LedgerConfig ByronBlock
Byron.ledgerConfig

shelleyEraParams :: History.EraParams
shelleyEraParams :: EraParams
shelleyEraParams = ShelleyGenesis -> EraParams
Shelley.shelleyEraParams ShelleyGenesis
Shelley.testShelleyGenesis

allegraEraParams :: History.EraParams
allegraEraParams :: EraParams
allegraEraParams = ShelleyGenesis -> EraParams
Shelley.shelleyEraParams ShelleyGenesis
Shelley.testShelleyGenesis

maryEraParams :: History.EraParams
maryEraParams :: EraParams
maryEraParams = ShelleyGenesis -> EraParams
Shelley.shelleyEraParams ShelleyGenesis
Shelley.testShelleyGenesis

alonzoEraParams :: History.EraParams
alonzoEraParams :: EraParams
alonzoEraParams = ShelleyGenesis -> EraParams
Shelley.shelleyEraParams ShelleyGenesis
Shelley.testShelleyGenesis

babbageEraParams :: History.EraParams
babbageEraParams :: EraParams
babbageEraParams = ShelleyGenesis -> EraParams
Shelley.shelleyEraParams ShelleyGenesis
Shelley.testShelleyGenesis

conwayEraParams :: History.EraParams
conwayEraParams :: EraParams
conwayEraParams = ShelleyGenesis -> EraParams
Shelley.shelleyEraParams ShelleyGenesis
Shelley.testShelleyGenesis

-- | We use 10, 20, 30, 40, ... as the transition epochs
shelleyTransitionEpoch :: EpochNo
shelleyTransitionEpoch :: EpochNo
shelleyTransitionEpoch = EpochNo
10

byronStartBound :: History.Bound
byronStartBound :: Bound
byronStartBound = Bound
History.initBound

shelleyStartBound :: History.Bound
shelleyStartBound :: Bound
shelleyStartBound =
    HasCallStack => EraParams -> Bound -> EpochNo -> Bound
EraParams -> Bound -> EpochNo -> Bound
History.mkUpperBound
      EraParams
byronEraParams
      Bound
byronStartBound
      EpochNo
shelleyTransitionEpoch

allegraStartBound :: History.Bound
allegraStartBound :: Bound
allegraStartBound =
    HasCallStack => EraParams -> Bound -> EpochNo -> Bound
EraParams -> Bound -> EpochNo -> Bound
History.mkUpperBound
      EraParams
shelleyEraParams
      Bound
shelleyStartBound
      EpochNo
20

maryStartBound :: History.Bound
maryStartBound :: Bound
maryStartBound =
    HasCallStack => EraParams -> Bound -> EpochNo -> Bound
EraParams -> Bound -> EpochNo -> Bound
History.mkUpperBound
      EraParams
allegraEraParams
      Bound
allegraStartBound
      EpochNo
30

alonzoStartBound :: History.Bound
alonzoStartBound :: Bound
alonzoStartBound =
    HasCallStack => EraParams -> Bound -> EpochNo -> Bound
EraParams -> Bound -> EpochNo -> Bound
History.mkUpperBound
      EraParams
maryEraParams
      Bound
maryStartBound
      EpochNo
40

babbageStartBound :: History.Bound
babbageStartBound :: Bound
babbageStartBound =
    HasCallStack => EraParams -> Bound -> EpochNo -> Bound
EraParams -> Bound -> EpochNo -> Bound
History.mkUpperBound
      EraParams
alonzoEraParams
      Bound
alonzoStartBound
      EpochNo
50

conwayStartBound :: History.Bound
conwayStartBound :: Bound
conwayStartBound =
    HasCallStack => EraParams -> Bound -> EpochNo -> Bound
EraParams -> Bound -> EpochNo -> Bound
History.mkUpperBound
      EraParams
alonzoEraParams
      Bound
alonzoStartBound
      EpochNo
60

exampleStartBounds :: Exactly (CardanoEras Crypto) History.Bound
exampleStartBounds :: Exactly (ByronBlock : CardanoShelleyEras Crypto) Bound
exampleStartBounds = NP (K Bound) (ByronBlock : CardanoShelleyEras Crypto)
-> Exactly (ByronBlock : CardanoShelleyEras Crypto) Bound
forall (xs :: [*]) a. NP (K a) xs -> Exactly xs a
Exactly (NP (K Bound) (ByronBlock : CardanoShelleyEras Crypto)
 -> Exactly (ByronBlock : CardanoShelleyEras Crypto) Bound)
-> NP (K Bound) (ByronBlock : CardanoShelleyEras Crypto)
-> Exactly (ByronBlock : CardanoShelleyEras Crypto) Bound
forall a b. (a -> b) -> a -> b
$
    (  Bound -> K Bound ByronBlock
forall k a (b :: k). a -> K a b
K Bound
byronStartBound
    K Bound ByronBlock
-> NP (K Bound) (CardanoShelleyEras Crypto)
-> NP (K Bound) (ByronBlock : CardanoShelleyEras Crypto)
forall {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> NP f xs1 -> NP f (x : xs1)
:* Bound -> K Bound (ShelleyBlock (TPraos Crypto) ShelleyEra)
forall k a (b :: k). a -> K a b
K Bound
shelleyStartBound
    K Bound (ShelleyBlock (TPraos Crypto) ShelleyEra)
-> NP
     (K Bound)
     '[ShelleyBlock (TPraos Crypto) AllegraEra,
       ShelleyBlock (TPraos Crypto) MaryEra,
       ShelleyBlock (TPraos Crypto) AlonzoEra,
       ShelleyBlock (Praos Crypto) BabbageEra,
       ShelleyBlock (Praos Crypto) ConwayEra]
-> NP (K Bound) (CardanoShelleyEras Crypto)
forall {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> NP f xs1 -> NP f (x : xs1)
:* Bound -> K Bound (ShelleyBlock (TPraos Crypto) AllegraEra)
forall k a (b :: k). a -> K a b
K Bound
allegraStartBound
    K Bound (ShelleyBlock (TPraos Crypto) AllegraEra)
-> NP
     (K Bound)
     '[ShelleyBlock (TPraos Crypto) MaryEra,
       ShelleyBlock (TPraos Crypto) AlonzoEra,
       ShelleyBlock (Praos Crypto) BabbageEra,
       ShelleyBlock (Praos Crypto) ConwayEra]
-> NP
     (K Bound)
     '[ShelleyBlock (TPraos Crypto) AllegraEra,
       ShelleyBlock (TPraos Crypto) MaryEra,
       ShelleyBlock (TPraos Crypto) AlonzoEra,
       ShelleyBlock (Praos Crypto) BabbageEra,
       ShelleyBlock (Praos Crypto) ConwayEra]
forall {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> NP f xs1 -> NP f (x : xs1)
:* Bound -> K Bound (ShelleyBlock (TPraos Crypto) MaryEra)
forall k a (b :: k). a -> K a b
K Bound
maryStartBound
    K Bound (ShelleyBlock (TPraos Crypto) MaryEra)
-> NP
     (K Bound)
     '[ShelleyBlock (TPraos Crypto) AlonzoEra,
       ShelleyBlock (Praos Crypto) BabbageEra,
       ShelleyBlock (Praos Crypto) ConwayEra]
-> NP
     (K Bound)
     '[ShelleyBlock (TPraos Crypto) MaryEra,
       ShelleyBlock (TPraos Crypto) AlonzoEra,
       ShelleyBlock (Praos Crypto) BabbageEra,
       ShelleyBlock (Praos Crypto) ConwayEra]
forall {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> NP f xs1 -> NP f (x : xs1)
:* Bound -> K Bound (ShelleyBlock (TPraos Crypto) AlonzoEra)
forall k a (b :: k). a -> K a b
K Bound
alonzoStartBound
    K Bound (ShelleyBlock (TPraos Crypto) AlonzoEra)
-> NP
     (K Bound)
     '[ShelleyBlock (Praos Crypto) BabbageEra,
       ShelleyBlock (Praos Crypto) ConwayEra]
-> NP
     (K Bound)
     '[ShelleyBlock (TPraos Crypto) AlonzoEra,
       ShelleyBlock (Praos Crypto) BabbageEra,
       ShelleyBlock (Praos Crypto) ConwayEra]
forall {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> NP f xs1 -> NP f (x : xs1)
:* Bound -> K Bound (ShelleyBlock (Praos Crypto) BabbageEra)
forall k a (b :: k). a -> K a b
K Bound
babbageStartBound
    K Bound (ShelleyBlock (Praos Crypto) BabbageEra)
-> NP (K Bound) '[ShelleyBlock (Praos Crypto) ConwayEra]
-> NP
     (K Bound)
     '[ShelleyBlock (Praos Crypto) BabbageEra,
       ShelleyBlock (Praos Crypto) ConwayEra]
forall {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> NP f xs1 -> NP f (x : xs1)
:* Bound -> K Bound (ShelleyBlock (Praos Crypto) ConwayEra)
forall k a (b :: k). a -> K a b
K Bound
conwayStartBound
    K Bound (ShelleyBlock (Praos Crypto) ConwayEra)
-> NP (K Bound) '[]
-> NP (K Bound) '[ShelleyBlock (Praos Crypto) ConwayEra]
forall {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> NP f xs1 -> NP f (x : xs1)
:* NP (K Bound) '[]
forall {k} (f :: k -> *). NP f '[]
Nil
    )

cardanoShape :: History.Shape (CardanoEras Crypto)
cardanoShape :: Shape (ByronBlock : CardanoShelleyEras Crypto)
cardanoShape = Exactly (ByronBlock : CardanoShelleyEras Crypto) EraParams
-> Shape (ByronBlock : CardanoShelleyEras Crypto)
forall (xs :: [*]). Exactly xs EraParams -> Shape xs
History.Shape (Exactly (ByronBlock : CardanoShelleyEras Crypto) EraParams
 -> Shape (ByronBlock : CardanoShelleyEras Crypto))
-> Exactly (ByronBlock : CardanoShelleyEras Crypto) EraParams
-> Shape (ByronBlock : CardanoShelleyEras Crypto)
forall a b. (a -> b) -> a -> b
$ NP (K EraParams) (ByronBlock : CardanoShelleyEras Crypto)
-> Exactly (ByronBlock : CardanoShelleyEras Crypto) EraParams
forall (xs :: [*]) a. NP (K a) xs -> Exactly xs a
Exactly (NP (K EraParams) (ByronBlock : CardanoShelleyEras Crypto)
 -> Exactly (ByronBlock : CardanoShelleyEras Crypto) EraParams)
-> NP (K EraParams) (ByronBlock : CardanoShelleyEras Crypto)
-> Exactly (ByronBlock : CardanoShelleyEras Crypto) EraParams
forall a b. (a -> b) -> a -> b
$
    (  EraParams -> K EraParams ByronBlock
forall k a (b :: k). a -> K a b
K EraParams
byronEraParams
    K EraParams ByronBlock
-> NP (K EraParams) (CardanoShelleyEras Crypto)
-> NP (K EraParams) (ByronBlock : CardanoShelleyEras Crypto)
forall {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> NP f xs1 -> NP f (x : xs1)
:* EraParams -> K EraParams (ShelleyBlock (TPraos Crypto) ShelleyEra)
forall k a (b :: k). a -> K a b
K EraParams
shelleyEraParams
    K EraParams (ShelleyBlock (TPraos Crypto) ShelleyEra)
-> NP
     (K EraParams)
     '[ShelleyBlock (TPraos Crypto) AllegraEra,
       ShelleyBlock (TPraos Crypto) MaryEra,
       ShelleyBlock (TPraos Crypto) AlonzoEra,
       ShelleyBlock (Praos Crypto) BabbageEra,
       ShelleyBlock (Praos Crypto) ConwayEra]
-> NP (K EraParams) (CardanoShelleyEras Crypto)
forall {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> NP f xs1 -> NP f (x : xs1)
:* EraParams -> K EraParams (ShelleyBlock (TPraos Crypto) AllegraEra)
forall k a (b :: k). a -> K a b
K EraParams
allegraEraParams
    K EraParams (ShelleyBlock (TPraos Crypto) AllegraEra)
-> NP
     (K EraParams)
     '[ShelleyBlock (TPraos Crypto) MaryEra,
       ShelleyBlock (TPraos Crypto) AlonzoEra,
       ShelleyBlock (Praos Crypto) BabbageEra,
       ShelleyBlock (Praos Crypto) ConwayEra]
-> NP
     (K EraParams)
     '[ShelleyBlock (TPraos Crypto) AllegraEra,
       ShelleyBlock (TPraos Crypto) MaryEra,
       ShelleyBlock (TPraos Crypto) AlonzoEra,
       ShelleyBlock (Praos Crypto) BabbageEra,
       ShelleyBlock (Praos Crypto) ConwayEra]
forall {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> NP f xs1 -> NP f (x : xs1)
:* EraParams -> K EraParams (ShelleyBlock (TPraos Crypto) MaryEra)
forall k a (b :: k). a -> K a b
K EraParams
maryEraParams
    K EraParams (ShelleyBlock (TPraos Crypto) MaryEra)
-> NP
     (K EraParams)
     '[ShelleyBlock (TPraos Crypto) AlonzoEra,
       ShelleyBlock (Praos Crypto) BabbageEra,
       ShelleyBlock (Praos Crypto) ConwayEra]
-> NP
     (K EraParams)
     '[ShelleyBlock (TPraos Crypto) MaryEra,
       ShelleyBlock (TPraos Crypto) AlonzoEra,
       ShelleyBlock (Praos Crypto) BabbageEra,
       ShelleyBlock (Praos Crypto) ConwayEra]
forall {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> NP f xs1 -> NP f (x : xs1)
:* EraParams -> K EraParams (ShelleyBlock (TPraos Crypto) AlonzoEra)
forall k a (b :: k). a -> K a b
K EraParams
alonzoEraParams
    K EraParams (ShelleyBlock (TPraos Crypto) AlonzoEra)
-> NP
     (K EraParams)
     '[ShelleyBlock (Praos Crypto) BabbageEra,
       ShelleyBlock (Praos Crypto) ConwayEra]
-> NP
     (K EraParams)
     '[ShelleyBlock (TPraos Crypto) AlonzoEra,
       ShelleyBlock (Praos Crypto) BabbageEra,
       ShelleyBlock (Praos Crypto) ConwayEra]
forall {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> NP f xs1 -> NP f (x : xs1)
:* EraParams -> K EraParams (ShelleyBlock (Praos Crypto) BabbageEra)
forall k a (b :: k). a -> K a b
K EraParams
babbageEraParams
    K EraParams (ShelleyBlock (Praos Crypto) BabbageEra)
-> NP (K EraParams) '[ShelleyBlock (Praos Crypto) ConwayEra]
-> NP
     (K EraParams)
     '[ShelleyBlock (Praos Crypto) BabbageEra,
       ShelleyBlock (Praos Crypto) ConwayEra]
forall {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> NP f xs1 -> NP f (x : xs1)
:* EraParams -> K EraParams (ShelleyBlock (Praos Crypto) ConwayEra)
forall k a (b :: k). a -> K a b
K EraParams
conwayEraParams
    K EraParams (ShelleyBlock (Praos Crypto) ConwayEra)
-> NP (K EraParams) '[]
-> NP (K EraParams) '[ShelleyBlock (Praos Crypto) ConwayEra]
forall {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> NP f xs1 -> NP f (x : xs1)
:* NP (K EraParams) '[]
forall {k} (f :: k -> *). NP f '[]
Nil
    )

summary :: History.Summary (CardanoEras Crypto)
summary :: Summary (ByronBlock : CardanoShelleyEras Crypto)
summary =
    Shape (ByronBlock : CardanoShelleyEras Crypto)
-> TransitionInfo
-> HardForkState
     (Flip LedgerState EmptyMK) (ByronBlock : CardanoShelleyEras Crypto)
-> Summary (ByronBlock : CardanoShelleyEras Crypto)
forall (xs :: [*]) (f :: * -> *).
Shape xs -> TransitionInfo -> HardForkState f xs -> Summary xs
State.reconstructSummary
      Shape (ByronBlock : CardanoShelleyEras Crypto)
cardanoShape
      (EpochNo -> TransitionInfo
State.TransitionKnown EpochNo
shelleyTransitionEpoch)
      (LedgerState (CardanoBlock Crypto) EmptyMK
-> HardForkState
     (Flip LedgerState EmptyMK) (ByronBlock : CardanoShelleyEras Crypto)
forall (xs :: [*]) (mk :: * -> * -> *).
LedgerState (HardForkBlock xs) mk
-> HardForkState (Flip LedgerState mk) xs
hardForkLedgerStatePerEra (LedgerState ByronBlock EmptyMK
-> LedgerState (CardanoBlock Crypto) EmptyMK
forall (mk :: * -> * -> *).
LedgerState ByronBlock mk -> LedgerState (CardanoBlock Crypto) mk
ledgerStateByron LedgerState ByronBlock EmptyMK
byronLedger))
  where
    (Maybe String
_, LedgerState ByronBlock EmptyMK
byronLedger) = [(Maybe String, LedgerState ByronBlock EmptyMK)]
-> (Maybe String, LedgerState ByronBlock EmptyMK)
forall a. HasCallStack => [a] -> a
head ([(Maybe String, LedgerState ByronBlock EmptyMK)]
 -> (Maybe String, LedgerState ByronBlock EmptyMK))
-> [(Maybe String, LedgerState ByronBlock EmptyMK)]
-> (Maybe String, LedgerState ByronBlock EmptyMK)
forall a b. (a -> b) -> a -> b
$ Examples ByronBlock
-> [(Maybe String, LedgerState ByronBlock EmptyMK)]
forall blk. Examples blk -> Labelled (LedgerState blk EmptyMK)
exampleLedgerState Examples ByronBlock
Byron.examples

eraInfoByron :: SingleEraInfo ByronBlock
eraInfoByron :: SingleEraInfo ByronBlock
eraInfoByron = Proxy ByronBlock -> SingleEraInfo ByronBlock
forall blk (proxy :: * -> *).
SingleEraBlock blk =>
proxy blk -> SingleEraInfo blk
forall (proxy :: * -> *).
proxy ByronBlock -> SingleEraInfo ByronBlock
singleEraInfo (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @ByronBlock)

eraInfoShelley :: SingleEraInfo (ShelleyBlock (TPraos StandardCrypto) ShelleyEra)
eraInfoShelley :: SingleEraInfo (ShelleyBlock (TPraos Crypto) ShelleyEra)
eraInfoShelley = Proxy (ShelleyBlock (TPraos Crypto) ShelleyEra)
-> SingleEraInfo (ShelleyBlock (TPraos Crypto) ShelleyEra)
forall blk (proxy :: * -> *).
SingleEraBlock blk =>
proxy blk -> SingleEraInfo blk
forall (proxy :: * -> *).
proxy (ShelleyBlock (TPraos Crypto) ShelleyEra)
-> SingleEraInfo (ShelleyBlock (TPraos Crypto) ShelleyEra)
singleEraInfo (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(ShelleyBlock (TPraos StandardCrypto) ShelleyEra))

codecConfig :: CardanoCodecConfig Crypto
codecConfig :: CardanoCodecConfig Crypto
codecConfig =
    CodecConfig ByronBlock
-> CodecConfig (ShelleyBlock (TPraos Crypto) ShelleyEra)
-> CodecConfig (ShelleyBlock (TPraos Crypto) AllegraEra)
-> CodecConfig (ShelleyBlock (TPraos Crypto) MaryEra)
-> CodecConfig (ShelleyBlock (TPraos Crypto) AlonzoEra)
-> CodecConfig (ShelleyBlock (Praos Crypto) BabbageEra)
-> CodecConfig (ShelleyBlock (Praos Crypto) ConwayEra)
-> CardanoCodecConfig Crypto
forall c.
CodecConfig ByronBlock
-> CodecConfig (ShelleyBlock (TPraos c) ShelleyEra)
-> CodecConfig (ShelleyBlock (TPraos c) AllegraEra)
-> CodecConfig (ShelleyBlock (TPraos c) MaryEra)
-> CodecConfig (ShelleyBlock (TPraos c) AlonzoEra)
-> CodecConfig (ShelleyBlock (Praos c) BabbageEra)
-> CodecConfig (ShelleyBlock (Praos c) ConwayEra)
-> CardanoCodecConfig c
CardanoCodecConfig
      CodecConfig ByronBlock
Byron.codecConfig
      CodecConfig (ShelleyBlock (TPraos Crypto) ShelleyEra)
forall proto era. CodecConfig (ShelleyBlock proto era)
Shelley.ShelleyCodecConfig
      CodecConfig (ShelleyBlock (TPraos Crypto) AllegraEra)
forall proto era. CodecConfig (ShelleyBlock proto era)
Shelley.ShelleyCodecConfig
      CodecConfig (ShelleyBlock (TPraos Crypto) MaryEra)
forall proto era. CodecConfig (ShelleyBlock proto era)
Shelley.ShelleyCodecConfig
      CodecConfig (ShelleyBlock (TPraos Crypto) AlonzoEra)
forall proto era. CodecConfig (ShelleyBlock proto era)
Shelley.ShelleyCodecConfig
      CodecConfig (ShelleyBlock (Praos Crypto) BabbageEra)
forall proto era. CodecConfig (ShelleyBlock proto era)
Shelley.ShelleyCodecConfig
      CodecConfig (ShelleyBlock (Praos Crypto) ConwayEra)
forall proto era. CodecConfig (ShelleyBlock proto era)
Shelley.ShelleyCodecConfig

ledgerStateByron ::
     LedgerState ByronBlock mk
  -> LedgerState (CardanoBlock Crypto) mk
ledgerStateByron :: forall (mk :: * -> * -> *).
LedgerState ByronBlock mk -> LedgerState (CardanoBlock Crypto) mk
ledgerStateByron LedgerState ByronBlock mk
stByron =
    HardForkState
  (Flip LedgerState mk) (ByronBlock : CardanoShelleyEras Crypto)
-> LedgerState (CardanoBlock Crypto) mk
forall (xs :: [*]) (mk :: * -> * -> *).
HardForkState (Flip LedgerState mk) xs
-> LedgerState (HardForkBlock xs) mk
HardForkLedgerState (HardForkState
   (Flip LedgerState mk) (ByronBlock : CardanoShelleyEras Crypto)
 -> LedgerState (CardanoBlock Crypto) mk)
-> HardForkState
     (Flip LedgerState mk) (ByronBlock : CardanoShelleyEras Crypto)
-> LedgerState (CardanoBlock Crypto) mk
forall a b. (a -> b) -> a -> b
$ Telescope
  (K Past)
  (Current (Flip LedgerState mk))
  (ByronBlock : CardanoShelleyEras Crypto)
-> HardForkState
     (Flip LedgerState mk) (ByronBlock : CardanoShelleyEras Crypto)
forall (f :: * -> *) (xs :: [*]).
Telescope (K Past) (Current f) xs -> HardForkState f xs
HardForkState (Telescope
   (K Past)
   (Current (Flip LedgerState mk))
   (ByronBlock : CardanoShelleyEras Crypto)
 -> HardForkState
      (Flip LedgerState mk) (ByronBlock : CardanoShelleyEras Crypto))
-> Telescope
     (K Past)
     (Current (Flip LedgerState mk))
     (ByronBlock : CardanoShelleyEras Crypto)
-> HardForkState
     (Flip LedgerState mk) (ByronBlock : CardanoShelleyEras Crypto)
forall a b. (a -> b) -> a -> b
$ Current (Flip LedgerState mk) ByronBlock
-> Telescope
     (K Past)
     (Current (Flip LedgerState mk))
     (ByronBlock : CardanoShelleyEras Crypto)
forall {k} (f :: k -> *) (x :: k) (g :: k -> *) (xs1 :: [k]).
f x -> Telescope g f (x : xs1)
TZ Current (Flip LedgerState mk) ByronBlock
cur
  where
    cur :: Current (Flip LedgerState mk) ByronBlock
cur = State.Current {
          currentStart :: Bound
currentStart = Bound
History.initBound
        , currentState :: Flip LedgerState mk ByronBlock
currentState = LedgerState ByronBlock mk -> Flip LedgerState mk ByronBlock
forall x y (f :: x -> y -> *) (x1 :: y) (y1 :: x).
f y1 x1 -> Flip f x1 y1
Flip LedgerState ByronBlock mk
stByron
        }

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

-- | Multi-era examples, e.g., applying a transaction to the wrong era.
multiEraExamples :: Examples (CardanoBlock Crypto)
multiEraExamples :: Examples (CardanoBlock Crypto)
multiEraExamples = Examples (CardanoBlock Crypto)
forall a. Monoid a => a
mempty {
      exampleApplyTxErr = labelled [
          ("WrongEraByron",   exampleApplyTxErrWrongEraByron)
        , ("WrongEraShelley", exampleApplyTxErrWrongEraShelley)
        ]
    , exampleQuery = labelled [
          ("AnytimeByron",   exampleQueryAnytimeByron)
        , ("AnytimeShelley", exampleQueryAnytimeShelley)
        , ("HardFork",       exampleQueryHardFork)
        ]
    , exampleResult = labelled [
          ("EraMismatchByron",   exampleResultEraMismatchByron)
        , ("EraMismatchShelley", exampleResultEraMismatchShelley)
        , ("AnytimeByron",       exampleResultAnytimeByron)
        , ("AnytimeShelley",     exampleResultAnytimeShelley)
        , ("HardFork",           exampleResultHardFork)
        ]
    }

-- | The examples: the examples from each individual era lifted in to
-- 'CardanoBlock' /and/ the multi-era examples.
examples :: Examples (CardanoBlock Crypto)
examples :: Examples (CardanoBlock Crypto)
examples = NP Examples (ByronBlock : CardanoShelleyEras Crypto)
-> Examples (CardanoBlock Crypto)
combineEras NP Examples (ByronBlock : CardanoShelleyEras Crypto)
eraExamples Examples (CardanoBlock Crypto)
-> Examples (CardanoBlock Crypto) -> Examples (CardanoBlock Crypto)
forall a. Semigroup a => a -> a -> a
<> Examples (CardanoBlock Crypto)
multiEraExamples

-- | Applying a Shelley thing to a Byron ledger
exampleEraMismatchByron :: MismatchEraInfo (CardanoEras Crypto)
exampleEraMismatchByron :: MismatchEraInfo (ByronBlock : CardanoShelleyEras Crypto)
exampleEraMismatchByron =
    Mismatch
  SingleEraInfo
  LedgerEraInfo
  (ByronBlock : CardanoShelleyEras Crypto)
-> MismatchEraInfo (ByronBlock : CardanoShelleyEras Crypto)
forall (xs :: [*]).
Mismatch SingleEraInfo LedgerEraInfo xs -> MismatchEraInfo xs
MismatchEraInfo (Mismatch
   SingleEraInfo
   LedgerEraInfo
   (ByronBlock : CardanoShelleyEras Crypto)
 -> MismatchEraInfo (ByronBlock : CardanoShelleyEras Crypto))
-> Mismatch
     SingleEraInfo
     LedgerEraInfo
     (ByronBlock : CardanoShelleyEras Crypto)
-> MismatchEraInfo (ByronBlock : CardanoShelleyEras Crypto)
forall a b. (a -> b) -> a -> b
$ NS SingleEraInfo (CardanoShelleyEras Crypto)
-> LedgerEraInfo ByronBlock
-> Mismatch
     SingleEraInfo
     LedgerEraInfo
     (ByronBlock : CardanoShelleyEras Crypto)
forall {k} (f :: k -> *) (xs1 :: [k]) (g :: k -> *) (x :: k).
NS f xs1 -> g x -> Mismatch f g (x : xs1)
MR (SingleEraInfo (ShelleyBlock (TPraos Crypto) ShelleyEra)
-> NS SingleEraInfo (CardanoShelleyEras Crypto)
forall {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> NS f (x : xs1)
Z SingleEraInfo (ShelleyBlock (TPraos Crypto) ShelleyEra)
eraInfoShelley) (SingleEraInfo ByronBlock -> LedgerEraInfo ByronBlock
forall blk. SingleEraInfo blk -> LedgerEraInfo blk
LedgerEraInfo SingleEraInfo ByronBlock
eraInfoByron)

-- | Applying a Byron thing to a Shelley ledger
exampleEraMismatchShelley :: MismatchEraInfo (CardanoEras Crypto)
exampleEraMismatchShelley :: MismatchEraInfo (ByronBlock : CardanoShelleyEras Crypto)
exampleEraMismatchShelley =
    Mismatch
  SingleEraInfo
  LedgerEraInfo
  (ByronBlock : CardanoShelleyEras Crypto)
-> MismatchEraInfo (ByronBlock : CardanoShelleyEras Crypto)
forall (xs :: [*]).
Mismatch SingleEraInfo LedgerEraInfo xs -> MismatchEraInfo xs
MismatchEraInfo (Mismatch
   SingleEraInfo
   LedgerEraInfo
   (ByronBlock : CardanoShelleyEras Crypto)
 -> MismatchEraInfo (ByronBlock : CardanoShelleyEras Crypto))
-> Mismatch
     SingleEraInfo
     LedgerEraInfo
     (ByronBlock : CardanoShelleyEras Crypto)
-> MismatchEraInfo (ByronBlock : CardanoShelleyEras Crypto)
forall a b. (a -> b) -> a -> b
$ SingleEraInfo ByronBlock
-> NS LedgerEraInfo (CardanoShelleyEras Crypto)
-> Mismatch
     SingleEraInfo
     LedgerEraInfo
     (ByronBlock : CardanoShelleyEras Crypto)
forall {k} (f :: k -> *) (x :: k) (g :: k -> *) (xs1 :: [k]).
f x -> NS g xs1 -> Mismatch f g (x : xs1)
ML SingleEraInfo ByronBlock
eraInfoByron (LedgerEraInfo (ShelleyBlock (TPraos Crypto) ShelleyEra)
-> NS LedgerEraInfo (CardanoShelleyEras Crypto)
forall {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> NS f (x : xs1)
Z (SingleEraInfo (ShelleyBlock (TPraos Crypto) ShelleyEra)
-> LedgerEraInfo (ShelleyBlock (TPraos Crypto) ShelleyEra)
forall blk. SingleEraInfo blk -> LedgerEraInfo blk
LedgerEraInfo SingleEraInfo (ShelleyBlock (TPraos Crypto) ShelleyEra)
eraInfoShelley))

exampleApplyTxErrWrongEraByron :: ApplyTxErr (CardanoBlock Crypto)
exampleApplyTxErrWrongEraByron :: ApplyTxErr (CardanoBlock Crypto)
exampleApplyTxErrWrongEraByron =
      MismatchEraInfo (ByronBlock : CardanoShelleyEras Crypto)
-> HardForkApplyTxErr (ByronBlock : CardanoShelleyEras Crypto)
forall (xs :: [*]). MismatchEraInfo xs -> HardForkApplyTxErr xs
HardForkApplyTxErrWrongEra MismatchEraInfo (ByronBlock : CardanoShelleyEras Crypto)
exampleEraMismatchByron

exampleApplyTxErrWrongEraShelley :: ApplyTxErr (CardanoBlock Crypto)
exampleApplyTxErrWrongEraShelley :: ApplyTxErr (CardanoBlock Crypto)
exampleApplyTxErrWrongEraShelley =
      MismatchEraInfo (ByronBlock : CardanoShelleyEras Crypto)
-> HardForkApplyTxErr (ByronBlock : CardanoShelleyEras Crypto)
forall (xs :: [*]). MismatchEraInfo xs -> HardForkApplyTxErr xs
HardForkApplyTxErrWrongEra MismatchEraInfo (ByronBlock : CardanoShelleyEras Crypto)
exampleEraMismatchShelley

exampleQueryEraMismatchByron :: SomeBlockQuery (BlockQuery (CardanoBlock Crypto))
exampleQueryEraMismatchByron :: SomeBlockQuery (BlockQuery (CardanoBlock Crypto))
exampleQueryEraMismatchByron =
    BlockQuery
  (CardanoBlock Crypto)
  'QFNoTables
  (CardanoQueryResult
     Crypto (Point (ShelleyBlock (TPraos Crypto) ShelleyEra)))
-> SomeBlockQuery (BlockQuery (CardanoBlock Crypto))
forall (q :: QueryFootprint -> * -> *)
       (footprint :: QueryFootprint) result.
SingI footprint =>
q footprint result -> SomeBlockQuery q
SomeBlockQuery (BlockQuery
  (ShelleyBlock (TPraos Crypto) ShelleyEra)
  'QFNoTables
  (Point (ShelleyBlock (TPraos Crypto) ShelleyEra))
-> BlockQuery
     (CardanoBlock Crypto)
     'QFNoTables
     (CardanoQueryResult
        Crypto (Point (ShelleyBlock (TPraos Crypto) ShelleyEra)))
forall c a (fp :: QueryFootprint) result.
(CardanoQueryResult c result ~ a) =>
BlockQuery (ShelleyBlock (TPraos c) ShelleyEra) fp result
-> CardanoQuery c fp a
QueryIfCurrentShelley BlockQuery
  (ShelleyBlock (TPraos Crypto) ShelleyEra)
  'QFNoTables
  (Point (ShelleyBlock (TPraos Crypto) ShelleyEra))
forall proto era.
BlockQuery
  (ShelleyBlock proto era)
  'QFNoTables
  (Point (ShelleyBlock proto era))
Shelley.GetLedgerTip)

exampleQueryEraMismatchShelley :: SomeBlockQuery (BlockQuery (CardanoBlock Crypto))
exampleQueryEraMismatchShelley :: SomeBlockQuery (BlockQuery (CardanoBlock Crypto))
exampleQueryEraMismatchShelley =
    BlockQuery
  (CardanoBlock Crypto) 'QFNoTables (CardanoQueryResult Crypto State)
-> SomeBlockQuery (BlockQuery (CardanoBlock Crypto))
forall (q :: QueryFootprint -> * -> *)
       (footprint :: QueryFootprint) result.
SingI footprint =>
q footprint result -> SomeBlockQuery q
SomeBlockQuery (BlockQuery ByronBlock 'QFNoTables State
-> BlockQuery
     (CardanoBlock Crypto) 'QFNoTables (CardanoQueryResult Crypto State)
forall c a (fp :: QueryFootprint) result.
(CardanoQueryResult c result ~ a) =>
BlockQuery ByronBlock fp result -> CardanoQuery c fp a
QueryIfCurrentByron BlockQuery ByronBlock 'QFNoTables State
Byron.GetUpdateInterfaceState)

exampleQueryAnytimeByron :: SomeBlockQuery (BlockQuery (CardanoBlock Crypto))
exampleQueryAnytimeByron :: SomeBlockQuery (BlockQuery (CardanoBlock Crypto))
exampleQueryAnytimeByron =
    BlockQuery (CardanoBlock Crypto) 'QFNoTables (Maybe Bound)
-> SomeBlockQuery (BlockQuery (CardanoBlock Crypto))
forall (q :: QueryFootprint -> * -> *)
       (footprint :: QueryFootprint) result.
SingI footprint =>
q footprint result -> SomeBlockQuery q
SomeBlockQuery (QueryAnytime (Maybe Bound)
-> BlockQuery (CardanoBlock Crypto) 'QFNoTables (Maybe Bound)
forall result c.
QueryAnytime result -> CardanoQuery c 'QFNoTables result
QueryAnytimeByron QueryAnytime (Maybe Bound)
GetEraStart)

exampleQueryAnytimeShelley :: SomeBlockQuery (BlockQuery (CardanoBlock Crypto))
exampleQueryAnytimeShelley :: SomeBlockQuery (BlockQuery (CardanoBlock Crypto))
exampleQueryAnytimeShelley =
    BlockQuery (CardanoBlock Crypto) 'QFNoTables (Maybe Bound)
-> SomeBlockQuery (BlockQuery (CardanoBlock Crypto))
forall (q :: QueryFootprint -> * -> *)
       (footprint :: QueryFootprint) result.
SingI footprint =>
q footprint result -> SomeBlockQuery q
SomeBlockQuery (QueryAnytime (Maybe Bound)
-> BlockQuery (CardanoBlock Crypto) 'QFNoTables (Maybe Bound)
forall result c.
QueryAnytime result -> CardanoQuery c 'QFNoTables result
QueryAnytimeShelley QueryAnytime (Maybe Bound)
GetEraStart)

exampleQueryHardFork :: SomeBlockQuery (BlockQuery (CardanoBlock Crypto))
exampleQueryHardFork :: SomeBlockQuery (BlockQuery (CardanoBlock Crypto))
exampleQueryHardFork =
    BlockQuery
  (CardanoBlock Crypto)
  'QFNoTables
  (Interpreter (ByronBlock : CardanoShelleyEras Crypto))
-> SomeBlockQuery (BlockQuery (CardanoBlock Crypto))
forall (q :: QueryFootprint -> * -> *)
       (footprint :: QueryFootprint) result.
SingI footprint =>
q footprint result -> SomeBlockQuery q
SomeBlockQuery (QueryHardFork
  (ByronBlock : CardanoShelleyEras Crypto)
  (Interpreter (ByronBlock : CardanoShelleyEras Crypto))
-> BlockQuery
     (CardanoBlock Crypto)
     'QFNoTables
     (Interpreter (ByronBlock : CardanoShelleyEras Crypto))
forall (xs1 :: [*]) x result.
IsNonEmpty xs1 =>
QueryHardFork (x : xs1) result
-> BlockQuery (HardForkBlock (x : xs1)) 'QFNoTables result
QueryHardFork QueryHardFork
  (ByronBlock : CardanoShelleyEras Crypto)
  (Interpreter (ByronBlock : CardanoShelleyEras Crypto))
forall (xs :: [*]). QueryHardFork xs (Interpreter xs)
GetInterpreter)

exampleResultEraMismatchByron :: SomeResult (CardanoBlock Crypto)
exampleResultEraMismatchByron :: SomeResult (CardanoBlock Crypto)
exampleResultEraMismatchByron =
    BlockQuery
  (CardanoBlock Crypto)
  'QFNoTables
  (CardanoQueryResult
     Crypto (Point (ShelleyBlock (TPraos Crypto) ShelleyEra)))
-> CardanoQueryResult
     Crypto (Point (ShelleyBlock (TPraos Crypto) ShelleyEra))
-> SomeResult (CardanoBlock Crypto)
forall result blk (fp :: QueryFootprint).
(Eq result, Show result, Typeable result) =>
BlockQuery blk fp result -> result -> SomeResult blk
SomeResult
      (BlockQuery
  (ShelleyBlock (TPraos Crypto) ShelleyEra)
  'QFNoTables
  (Point (ShelleyBlock (TPraos Crypto) ShelleyEra))
-> BlockQuery
     (CardanoBlock Crypto)
     'QFNoTables
     (CardanoQueryResult
        Crypto (Point (ShelleyBlock (TPraos Crypto) ShelleyEra)))
forall c a (fp :: QueryFootprint) result.
(CardanoQueryResult c result ~ a) =>
BlockQuery (ShelleyBlock (TPraos c) ShelleyEra) fp result
-> CardanoQuery c fp a
QueryIfCurrentShelley BlockQuery
  (ShelleyBlock (TPraos Crypto) ShelleyEra)
  'QFNoTables
  (Point (ShelleyBlock (TPraos Crypto) ShelleyEra))
forall proto era.
BlockQuery
  (ShelleyBlock proto era)
  'QFNoTables
  (Point (ShelleyBlock proto era))
Shelley.GetLedgerTip)
      (MismatchEraInfo (ByronBlock : CardanoShelleyEras Crypto)
-> CardanoQueryResult
     Crypto (Point (ShelleyBlock (TPraos Crypto) ShelleyEra))
forall a b. a -> Either a b
Left MismatchEraInfo (ByronBlock : CardanoShelleyEras Crypto)
exampleEraMismatchByron)

exampleResultEraMismatchShelley :: SomeResult (CardanoBlock Crypto)
exampleResultEraMismatchShelley :: SomeResult (CardanoBlock Crypto)
exampleResultEraMismatchShelley =
    BlockQuery
  (CardanoBlock Crypto) 'QFNoTables (CardanoQueryResult Crypto State)
-> CardanoQueryResult Crypto State
-> SomeResult (CardanoBlock Crypto)
forall result blk (fp :: QueryFootprint).
(Eq result, Show result, Typeable result) =>
BlockQuery blk fp result -> result -> SomeResult blk
SomeResult
      (BlockQuery ByronBlock 'QFNoTables State
-> BlockQuery
     (CardanoBlock Crypto) 'QFNoTables (CardanoQueryResult Crypto State)
forall c a (fp :: QueryFootprint) result.
(CardanoQueryResult c result ~ a) =>
BlockQuery ByronBlock fp result -> CardanoQuery c fp a
QueryIfCurrentByron BlockQuery ByronBlock 'QFNoTables State
Byron.GetUpdateInterfaceState)
      (MismatchEraInfo (ByronBlock : CardanoShelleyEras Crypto)
-> CardanoQueryResult Crypto State
forall a b. a -> Either a b
Left MismatchEraInfo (ByronBlock : CardanoShelleyEras Crypto)
exampleEraMismatchShelley)

exampleResultAnytimeByron :: SomeResult (CardanoBlock Crypto)
exampleResultAnytimeByron :: SomeResult (CardanoBlock Crypto)
exampleResultAnytimeByron =
    BlockQuery (CardanoBlock Crypto) 'QFNoTables (Maybe Bound)
-> Maybe Bound -> SomeResult (CardanoBlock Crypto)
forall result blk (fp :: QueryFootprint).
(Eq result, Show result, Typeable result) =>
BlockQuery blk fp result -> result -> SomeResult blk
SomeResult (QueryAnytime (Maybe Bound)
-> BlockQuery (CardanoBlock Crypto) 'QFNoTables (Maybe Bound)
forall result c.
QueryAnytime result -> CardanoQuery c 'QFNoTables result
QueryAnytimeByron QueryAnytime (Maybe Bound)
GetEraStart) (Bound -> Maybe Bound
forall a. a -> Maybe a
Just Bound
byronStartBound)

exampleResultAnytimeShelley :: SomeResult (CardanoBlock Crypto)
exampleResultAnytimeShelley :: SomeResult (CardanoBlock Crypto)
exampleResultAnytimeShelley =
    BlockQuery (CardanoBlock Crypto) 'QFNoTables (Maybe Bound)
-> Maybe Bound -> SomeResult (CardanoBlock Crypto)
forall result blk (fp :: QueryFootprint).
(Eq result, Show result, Typeable result) =>
BlockQuery blk fp result -> result -> SomeResult blk
SomeResult (QueryAnytime (Maybe Bound)
-> BlockQuery (CardanoBlock Crypto) 'QFNoTables (Maybe Bound)
forall result c.
QueryAnytime result -> CardanoQuery c 'QFNoTables result
QueryAnytimeShelley QueryAnytime (Maybe Bound)
GetEraStart) (Bound -> Maybe Bound
forall a. a -> Maybe a
Just Bound
shelleyStartBound)

exampleResultHardFork :: SomeResult (CardanoBlock Crypto)
exampleResultHardFork :: SomeResult (CardanoBlock Crypto)
exampleResultHardFork =
    BlockQuery
  (CardanoBlock Crypto)
  'QFNoTables
  (Interpreter (ByronBlock : CardanoShelleyEras Crypto))
-> Interpreter (ByronBlock : CardanoShelleyEras Crypto)
-> SomeResult (CardanoBlock Crypto)
forall result blk (fp :: QueryFootprint).
(Eq result, Show result, Typeable result) =>
BlockQuery blk fp result -> result -> SomeResult blk
SomeResult (QueryHardFork
  (ByronBlock : CardanoShelleyEras Crypto)
  (Interpreter (ByronBlock : CardanoShelleyEras Crypto))
-> BlockQuery
     (CardanoBlock Crypto)
     'QFNoTables
     (Interpreter (ByronBlock : CardanoShelleyEras Crypto))
forall (xs1 :: [*]) x result.
IsNonEmpty xs1 =>
QueryHardFork (x : xs1) result
-> BlockQuery (HardForkBlock (x : xs1)) 'QFNoTables result
QueryHardFork QueryHardFork
  (ByronBlock : CardanoShelleyEras Crypto)
  (Interpreter (ByronBlock : CardanoShelleyEras Crypto))
forall (xs :: [*]). QueryHardFork xs (Interpreter xs)
GetInterpreter) (Summary (ByronBlock : CardanoShelleyEras Crypto)
-> Interpreter (ByronBlock : CardanoShelleyEras Crypto)
forall (xs :: [*]). Summary xs -> Interpreter xs
History.mkInterpreter Summary (ByronBlock : CardanoShelleyEras Crypto)
summary)