{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
{-# 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.Coerce (Coercible)
import           Data.SOP.BasicFunctors
import           Data.SOP.Counting (Exactly (..))
import           Data.SOP.Index (Index (..))
import           Data.SOP.Strict
import           Ouroboros.Consensus.Block
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.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 (ExtLedgerState (..))
import           Ouroboros.Consensus.Ledger.SupportsMempool (ApplyTxErr)
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 Crypto))
Shelley.examplesShelley
    Examples (ShelleyBlock (TPraos Crypto) (ShelleyEra Crypto))
-> NP
     Examples
     '[ShelleyBlock (TPraos Crypto) (AllegraEra Crypto),
       ShelleyBlock (TPraos Crypto) (MaryEra Crypto),
       ShelleyBlock (TPraos Crypto) (AlonzoEra Crypto),
       ShelleyBlock (Praos Crypto) (BabbageEra Crypto),
       ShelleyBlock (Praos Crypto) (ConwayEra Crypto)]
-> 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 Crypto))
Shelley.examplesAllegra
    Examples (ShelleyBlock (TPraos Crypto) (AllegraEra Crypto))
-> NP
     Examples
     '[ShelleyBlock (TPraos Crypto) (MaryEra Crypto),
       ShelleyBlock (TPraos Crypto) (AlonzoEra Crypto),
       ShelleyBlock (Praos Crypto) (BabbageEra Crypto),
       ShelleyBlock (Praos Crypto) (ConwayEra Crypto)]
-> NP
     Examples
     '[ShelleyBlock (TPraos Crypto) (AllegraEra Crypto),
       ShelleyBlock (TPraos Crypto) (MaryEra Crypto),
       ShelleyBlock (TPraos Crypto) (AlonzoEra Crypto),
       ShelleyBlock (Praos Crypto) (BabbageEra Crypto),
       ShelleyBlock (Praos Crypto) (ConwayEra Crypto)]
forall {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> NP f xs1 -> NP f (x : xs1)
:* Examples (ShelleyBlock (TPraos Crypto) (MaryEra Crypto))
Shelley.examplesMary
    Examples (ShelleyBlock (TPraos Crypto) (MaryEra Crypto))
-> NP
     Examples
     '[ShelleyBlock (TPraos Crypto) (AlonzoEra Crypto),
       ShelleyBlock (Praos Crypto) (BabbageEra Crypto),
       ShelleyBlock (Praos Crypto) (ConwayEra Crypto)]
-> NP
     Examples
     '[ShelleyBlock (TPraos Crypto) (MaryEra Crypto),
       ShelleyBlock (TPraos Crypto) (AlonzoEra Crypto),
       ShelleyBlock (Praos Crypto) (BabbageEra Crypto),
       ShelleyBlock (Praos Crypto) (ConwayEra Crypto)]
forall {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> NP f xs1 -> NP f (x : xs1)
:* Examples (ShelleyBlock (TPraos Crypto) (AlonzoEra Crypto))
Shelley.examplesAlonzo
    Examples (ShelleyBlock (TPraos Crypto) (AlonzoEra Crypto))
-> NP
     Examples
     '[ShelleyBlock (Praos Crypto) (BabbageEra Crypto),
       ShelleyBlock (Praos Crypto) (ConwayEra Crypto)]
-> NP
     Examples
     '[ShelleyBlock (TPraos Crypto) (AlonzoEra Crypto),
       ShelleyBlock (Praos Crypto) (BabbageEra Crypto),
       ShelleyBlock (Praos Crypto) (ConwayEra Crypto)]
forall {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> NP f xs1 -> NP f (x : xs1)
:* Examples (ShelleyBlock (Praos Crypto) (BabbageEra Crypto))
Shelley.examplesBabbage
    Examples (ShelleyBlock (Praos Crypto) (BabbageEra Crypto))
-> NP Examples '[ShelleyBlock (Praos Crypto) (ConwayEra Crypto)]
-> NP
     Examples
     '[ShelleyBlock (Praos Crypto) (BabbageEra Crypto),
       ShelleyBlock (Praos Crypto) (ConwayEra Crypto)]
forall {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> NP f xs1 -> NP f (x : xs1)
:* Examples (ShelleyBlock (Praos Crypto) (ConwayEra Crypto))
Shelley.examplesConway
    Examples (ShelleyBlock (Praos Crypto) (ConwayEra Crypto))
-> NP Examples '[]
-> NP Examples '[ShelleyBlock (Praos Crypto) (ConwayEra Crypto)]
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 = [Examples (CardanoBlock Crypto)] -> Examples (CardanoBlock Crypto)
forall a. Monoid a => [a] -> a
mconcat ([Examples (CardanoBlock Crypto)]
 -> Examples (CardanoBlock Crypto))
-> (NP Examples (ByronBlock : CardanoShelleyEras Crypto)
    -> [Examples (CardanoBlock Crypto)])
-> NP Examples (ByronBlock : CardanoShelleyEras Crypto)
-> Examples (CardanoBlock Crypto)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NP
  (K (Examples (CardanoBlock Crypto)))
  (ByronBlock : CardanoShelleyEras Crypto)
-> [Examples (CardanoBlock Crypto)]
NP
  (K (Examples (CardanoBlock Crypto)))
  (ByronBlock : CardanoShelleyEras Crypto)
-> CollapseTo NP (Examples (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 (Examples (CardanoBlock Crypto)))
   (ByronBlock : CardanoShelleyEras Crypto)
 -> [Examples (CardanoBlock Crypto)])
-> (NP Examples (ByronBlock : CardanoShelleyEras Crypto)
    -> NP
         (K (Examples (CardanoBlock Crypto)))
         (ByronBlock : CardanoShelleyEras Crypto))
-> NP Examples (ByronBlock : CardanoShelleyEras Crypto)
-> [Examples (CardanoBlock Crypto)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Prod
  NP
  (Examples -.-> K (Examples (CardanoBlock Crypto)))
  (ByronBlock : CardanoShelleyEras Crypto)
-> NP Examples (ByronBlock : CardanoShelleyEras Crypto)
-> NP
     (K (Examples (CardanoBlock Crypto)))
     (ByronBlock : CardanoShelleyEras Crypto)
forall k l (h :: (k -> *) -> l -> *) (f :: k -> *) (g :: k -> *)
       (xs :: l).
HAp h =>
Prod h (f -.-> g) xs -> h f xs -> h g xs
forall (f :: * -> *) (g :: * -> *) (xs :: [*]).
Prod NP (f -.-> g) xs -> NP f xs -> NP g xs
hap Prod
  NP
  (Examples -.-> K (Examples (CardanoBlock Crypto)))
  (ByronBlock : CardanoShelleyEras Crypto)
NP
  (Examples -.-> K (Examples (CardanoBlock Crypto)))
  (ByronBlock : CardanoShelleyEras Crypto)
eraInjections
  where
    eraInjections :: NP (Examples -.-> K (Examples (CardanoBlock Crypto)))
                        (CardanoEras Crypto)
    eraInjections :: NP
  (Examples -.-> K (Examples (CardanoBlock Crypto)))
  (ByronBlock : CardanoShelleyEras Crypto)
eraInjections =
           (Examples ByronBlock
 -> K (Examples (CardanoBlock Crypto)) ByronBlock)
-> (-.->) Examples (K (Examples (CardanoBlock Crypto))) ByronBlock
forall {k} (f :: k -> *) (a :: k) (f' :: k -> *).
(f a -> f' a) -> (-.->) f f' a
fn (Examples (CardanoBlock Crypto)
-> K (Examples (CardanoBlock Crypto)) ByronBlock
forall k a (b :: k). a -> K a b
K (Examples (CardanoBlock Crypto)
 -> K (Examples (CardanoBlock Crypto)) ByronBlock)
-> (Examples ByronBlock -> Examples (CardanoBlock Crypto))
-> Examples ByronBlock
-> K (Examples (CardanoBlock Crypto)) ByronBlock
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String
-> Index (ByronBlock : CardanoShelleyEras Crypto) ByronBlock
-> Examples ByronBlock
-> Examples (CardanoBlock Crypto)
forall blk.
String
-> Index (ByronBlock : CardanoShelleyEras Crypto) blk
-> Examples blk
-> Examples (CardanoBlock Crypto)
injExamples String
"Byron"   Index (ByronBlock : CardanoShelleyEras Crypto) ByronBlock
forall {k} (x :: k) (xs1 :: [k]). Index (x : xs1) x
IZ)
        (-.->) Examples (K (Examples (CardanoBlock Crypto))) ByronBlock
-> NP
     (Examples -.-> K (Examples (CardanoBlock Crypto)))
     (CardanoShelleyEras Crypto)
-> NP
     (Examples -.-> K (Examples (CardanoBlock Crypto)))
     (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 Crypto))
 -> K (Examples (CardanoBlock Crypto))
      (ShelleyBlock (TPraos Crypto) (ShelleyEra Crypto)))
-> (-.->)
     Examples
     (K (Examples (CardanoBlock Crypto)))
     (ShelleyBlock (TPraos Crypto) (ShelleyEra Crypto))
forall {k} (f :: k -> *) (a :: k) (f' :: k -> *).
(f a -> f' a) -> (-.->) f f' a
fn (Examples (CardanoBlock Crypto)
-> K (Examples (CardanoBlock Crypto))
     (ShelleyBlock (TPraos Crypto) (ShelleyEra Crypto))
forall k a (b :: k). a -> K a b
K (Examples (CardanoBlock Crypto)
 -> K (Examples (CardanoBlock Crypto))
      (ShelleyBlock (TPraos Crypto) (ShelleyEra Crypto)))
-> (Examples (ShelleyBlock (TPraos Crypto) (ShelleyEra Crypto))
    -> Examples (CardanoBlock Crypto))
-> Examples (ShelleyBlock (TPraos Crypto) (ShelleyEra Crypto))
-> K (Examples (CardanoBlock Crypto))
     (ShelleyBlock (TPraos Crypto) (ShelleyEra Crypto))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String
-> Index
     (ByronBlock : CardanoShelleyEras Crypto)
     (ShelleyBlock (TPraos Crypto) (ShelleyEra Crypto))
-> Examples (ShelleyBlock (TPraos Crypto) (ShelleyEra Crypto))
-> Examples (CardanoBlock Crypto)
forall blk.
String
-> Index (ByronBlock : CardanoShelleyEras Crypto) blk
-> Examples blk
-> Examples (CardanoBlock Crypto)
injExamples String
"Shelley" (Index
  (CardanoShelleyEras Crypto)
  (ShelleyBlock (TPraos Crypto) (ShelleyEra Crypto))
-> Index
     (ByronBlock : CardanoShelleyEras Crypto)
     (ShelleyBlock (TPraos Crypto) (ShelleyEra Crypto))
forall {k} (xs1 :: [k]) (x :: k) (y :: k).
Index xs1 x -> Index (y : xs1) x
IS Index
  (CardanoShelleyEras Crypto)
  (ShelleyBlock (TPraos Crypto) (ShelleyEra Crypto))
forall {k} (x :: k) (xs1 :: [k]). Index (x : xs1) x
IZ))
        (-.->)
  Examples
  (K (Examples (CardanoBlock Crypto)))
  (ShelleyBlock (TPraos Crypto) (ShelleyEra Crypto))
-> NP
     (Examples -.-> K (Examples (CardanoBlock Crypto)))
     '[ShelleyBlock (TPraos Crypto) (AllegraEra Crypto),
       ShelleyBlock (TPraos Crypto) (MaryEra Crypto),
       ShelleyBlock (TPraos Crypto) (AlonzoEra Crypto),
       ShelleyBlock (Praos Crypto) (BabbageEra Crypto),
       ShelleyBlock (Praos Crypto) (ConwayEra Crypto)]
-> NP
     (Examples -.-> K (Examples (CardanoBlock Crypto)))
     (CardanoShelleyEras Crypto)
forall {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> NP f xs1 -> NP f (x : xs1)
:* (Examples (ShelleyBlock (TPraos Crypto) (AllegraEra Crypto))
 -> K (Examples (CardanoBlock Crypto))
      (ShelleyBlock (TPraos Crypto) (AllegraEra Crypto)))
-> (-.->)
     Examples
     (K (Examples (CardanoBlock Crypto)))
     (ShelleyBlock (TPraos Crypto) (AllegraEra Crypto))
forall {k} (f :: k -> *) (a :: k) (f' :: k -> *).
(f a -> f' a) -> (-.->) f f' a
fn (Examples (CardanoBlock Crypto)
-> K (Examples (CardanoBlock Crypto))
     (ShelleyBlock (TPraos Crypto) (AllegraEra Crypto))
forall k a (b :: k). a -> K a b
K (Examples (CardanoBlock Crypto)
 -> K (Examples (CardanoBlock Crypto))
      (ShelleyBlock (TPraos Crypto) (AllegraEra Crypto)))
-> (Examples (ShelleyBlock (TPraos Crypto) (AllegraEra Crypto))
    -> Examples (CardanoBlock Crypto))
-> Examples (ShelleyBlock (TPraos Crypto) (AllegraEra Crypto))
-> K (Examples (CardanoBlock Crypto))
     (ShelleyBlock (TPraos Crypto) (AllegraEra Crypto))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String
-> Index
     (ByronBlock : CardanoShelleyEras Crypto)
     (ShelleyBlock (TPraos Crypto) (AllegraEra Crypto))
-> Examples (ShelleyBlock (TPraos Crypto) (AllegraEra Crypto))
-> Examples (CardanoBlock Crypto)
forall blk.
String
-> Index (ByronBlock : CardanoShelleyEras Crypto) blk
-> Examples blk
-> Examples (CardanoBlock Crypto)
injExamples String
"Allegra" (Index
  (CardanoShelleyEras Crypto)
  (ShelleyBlock (TPraos Crypto) (AllegraEra Crypto))
-> Index
     (ByronBlock : CardanoShelleyEras Crypto)
     (ShelleyBlock (TPraos Crypto) (AllegraEra Crypto))
forall {k} (xs1 :: [k]) (x :: k) (y :: k).
Index xs1 x -> Index (y : xs1) x
IS (Index
  '[ShelleyBlock (TPraos Crypto) (AllegraEra Crypto),
    ShelleyBlock (TPraos Crypto) (MaryEra Crypto),
    ShelleyBlock (TPraos Crypto) (AlonzoEra Crypto),
    ShelleyBlock (Praos Crypto) (BabbageEra Crypto),
    ShelleyBlock (Praos Crypto) (ConwayEra Crypto)]
  (ShelleyBlock (TPraos Crypto) (AllegraEra Crypto))
-> Index
     (CardanoShelleyEras Crypto)
     (ShelleyBlock (TPraos Crypto) (AllegraEra Crypto))
forall {k} (xs1 :: [k]) (x :: k) (y :: k).
Index xs1 x -> Index (y : xs1) x
IS Index
  '[ShelleyBlock (TPraos Crypto) (AllegraEra Crypto),
    ShelleyBlock (TPraos Crypto) (MaryEra Crypto),
    ShelleyBlock (TPraos Crypto) (AlonzoEra Crypto),
    ShelleyBlock (Praos Crypto) (BabbageEra Crypto),
    ShelleyBlock (Praos Crypto) (ConwayEra Crypto)]
  (ShelleyBlock (TPraos Crypto) (AllegraEra Crypto))
forall {k} (x :: k) (xs1 :: [k]). Index (x : xs1) x
IZ)))
        (-.->)
  Examples
  (K (Examples (CardanoBlock Crypto)))
  (ShelleyBlock (TPraos Crypto) (AllegraEra Crypto))
-> NP
     (Examples -.-> K (Examples (CardanoBlock Crypto)))
     '[ShelleyBlock (TPraos Crypto) (MaryEra Crypto),
       ShelleyBlock (TPraos Crypto) (AlonzoEra Crypto),
       ShelleyBlock (Praos Crypto) (BabbageEra Crypto),
       ShelleyBlock (Praos Crypto) (ConwayEra Crypto)]
-> NP
     (Examples -.-> K (Examples (CardanoBlock Crypto)))
     '[ShelleyBlock (TPraos Crypto) (AllegraEra Crypto),
       ShelleyBlock (TPraos Crypto) (MaryEra Crypto),
       ShelleyBlock (TPraos Crypto) (AlonzoEra Crypto),
       ShelleyBlock (Praos Crypto) (BabbageEra Crypto),
       ShelleyBlock (Praos Crypto) (ConwayEra Crypto)]
forall {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> NP f xs1 -> NP f (x : xs1)
:* (Examples (ShelleyBlock (TPraos Crypto) (MaryEra Crypto))
 -> K (Examples (CardanoBlock Crypto))
      (ShelleyBlock (TPraos Crypto) (MaryEra Crypto)))
-> (-.->)
     Examples
     (K (Examples (CardanoBlock Crypto)))
     (ShelleyBlock (TPraos Crypto) (MaryEra Crypto))
forall {k} (f :: k -> *) (a :: k) (f' :: k -> *).
(f a -> f' a) -> (-.->) f f' a
fn (Examples (CardanoBlock Crypto)
-> K (Examples (CardanoBlock Crypto))
     (ShelleyBlock (TPraos Crypto) (MaryEra Crypto))
forall k a (b :: k). a -> K a b
K (Examples (CardanoBlock Crypto)
 -> K (Examples (CardanoBlock Crypto))
      (ShelleyBlock (TPraos Crypto) (MaryEra Crypto)))
-> (Examples (ShelleyBlock (TPraos Crypto) (MaryEra Crypto))
    -> Examples (CardanoBlock Crypto))
-> Examples (ShelleyBlock (TPraos Crypto) (MaryEra Crypto))
-> K (Examples (CardanoBlock Crypto))
     (ShelleyBlock (TPraos Crypto) (MaryEra Crypto))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String
-> Index
     (ByronBlock : CardanoShelleyEras Crypto)
     (ShelleyBlock (TPraos Crypto) (MaryEra Crypto))
-> Examples (ShelleyBlock (TPraos Crypto) (MaryEra Crypto))
-> Examples (CardanoBlock Crypto)
forall blk.
String
-> Index (ByronBlock : CardanoShelleyEras Crypto) blk
-> Examples blk
-> Examples (CardanoBlock Crypto)
injExamples String
"Mary"    (Index
  (CardanoShelleyEras Crypto)
  (ShelleyBlock (TPraos Crypto) (MaryEra Crypto))
-> Index
     (ByronBlock : CardanoShelleyEras Crypto)
     (ShelleyBlock (TPraos Crypto) (MaryEra Crypto))
forall {k} (xs1 :: [k]) (x :: k) (y :: k).
Index xs1 x -> Index (y : xs1) x
IS (Index
  '[ShelleyBlock (TPraos Crypto) (AllegraEra Crypto),
    ShelleyBlock (TPraos Crypto) (MaryEra Crypto),
    ShelleyBlock (TPraos Crypto) (AlonzoEra Crypto),
    ShelleyBlock (Praos Crypto) (BabbageEra Crypto),
    ShelleyBlock (Praos Crypto) (ConwayEra Crypto)]
  (ShelleyBlock (TPraos Crypto) (MaryEra Crypto))
-> Index
     (CardanoShelleyEras Crypto)
     (ShelleyBlock (TPraos Crypto) (MaryEra Crypto))
forall {k} (xs1 :: [k]) (x :: k) (y :: k).
Index xs1 x -> Index (y : xs1) x
IS (Index
  '[ShelleyBlock (TPraos Crypto) (MaryEra Crypto),
    ShelleyBlock (TPraos Crypto) (AlonzoEra Crypto),
    ShelleyBlock (Praos Crypto) (BabbageEra Crypto),
    ShelleyBlock (Praos Crypto) (ConwayEra Crypto)]
  (ShelleyBlock (TPraos Crypto) (MaryEra Crypto))
-> Index
     '[ShelleyBlock (TPraos Crypto) (AllegraEra Crypto),
       ShelleyBlock (TPraos Crypto) (MaryEra Crypto),
       ShelleyBlock (TPraos Crypto) (AlonzoEra Crypto),
       ShelleyBlock (Praos Crypto) (BabbageEra Crypto),
       ShelleyBlock (Praos Crypto) (ConwayEra Crypto)]
     (ShelleyBlock (TPraos Crypto) (MaryEra Crypto))
forall {k} (xs1 :: [k]) (x :: k) (y :: k).
Index xs1 x -> Index (y : xs1) x
IS Index
  '[ShelleyBlock (TPraos Crypto) (MaryEra Crypto),
    ShelleyBlock (TPraos Crypto) (AlonzoEra Crypto),
    ShelleyBlock (Praos Crypto) (BabbageEra Crypto),
    ShelleyBlock (Praos Crypto) (ConwayEra Crypto)]
  (ShelleyBlock (TPraos Crypto) (MaryEra Crypto))
forall {k} (x :: k) (xs1 :: [k]). Index (x : xs1) x
IZ))))
        (-.->)
  Examples
  (K (Examples (CardanoBlock Crypto)))
  (ShelleyBlock (TPraos Crypto) (MaryEra Crypto))
-> NP
     (Examples -.-> K (Examples (CardanoBlock Crypto)))
     '[ShelleyBlock (TPraos Crypto) (AlonzoEra Crypto),
       ShelleyBlock (Praos Crypto) (BabbageEra Crypto),
       ShelleyBlock (Praos Crypto) (ConwayEra Crypto)]
-> NP
     (Examples -.-> K (Examples (CardanoBlock Crypto)))
     '[ShelleyBlock (TPraos Crypto) (MaryEra Crypto),
       ShelleyBlock (TPraos Crypto) (AlonzoEra Crypto),
       ShelleyBlock (Praos Crypto) (BabbageEra Crypto),
       ShelleyBlock (Praos Crypto) (ConwayEra Crypto)]
forall {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> NP f xs1 -> NP f (x : xs1)
:* (Examples (ShelleyBlock (TPraos Crypto) (AlonzoEra Crypto))
 -> K (Examples (CardanoBlock Crypto))
      (ShelleyBlock (TPraos Crypto) (AlonzoEra Crypto)))
-> (-.->)
     Examples
     (K (Examples (CardanoBlock Crypto)))
     (ShelleyBlock (TPraos Crypto) (AlonzoEra Crypto))
forall {k} (f :: k -> *) (a :: k) (f' :: k -> *).
(f a -> f' a) -> (-.->) f f' a
fn (Examples (CardanoBlock Crypto)
-> K (Examples (CardanoBlock Crypto))
     (ShelleyBlock (TPraos Crypto) (AlonzoEra Crypto))
forall k a (b :: k). a -> K a b
K (Examples (CardanoBlock Crypto)
 -> K (Examples (CardanoBlock Crypto))
      (ShelleyBlock (TPraos Crypto) (AlonzoEra Crypto)))
-> (Examples (ShelleyBlock (TPraos Crypto) (AlonzoEra Crypto))
    -> Examples (CardanoBlock Crypto))
-> Examples (ShelleyBlock (TPraos Crypto) (AlonzoEra Crypto))
-> K (Examples (CardanoBlock Crypto))
     (ShelleyBlock (TPraos Crypto) (AlonzoEra Crypto))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String
-> Index
     (ByronBlock : CardanoShelleyEras Crypto)
     (ShelleyBlock (TPraos Crypto) (AlonzoEra Crypto))
-> Examples (ShelleyBlock (TPraos Crypto) (AlonzoEra Crypto))
-> Examples (CardanoBlock Crypto)
forall blk.
String
-> Index (ByronBlock : CardanoShelleyEras Crypto) blk
-> Examples blk
-> Examples (CardanoBlock Crypto)
injExamples String
"Alonzo"  (Index
  (CardanoShelleyEras Crypto)
  (ShelleyBlock (TPraos Crypto) (AlonzoEra Crypto))
-> Index
     (ByronBlock : CardanoShelleyEras Crypto)
     (ShelleyBlock (TPraos Crypto) (AlonzoEra Crypto))
forall {k} (xs1 :: [k]) (x :: k) (y :: k).
Index xs1 x -> Index (y : xs1) x
IS (Index
  '[ShelleyBlock (TPraos Crypto) (AllegraEra Crypto),
    ShelleyBlock (TPraos Crypto) (MaryEra Crypto),
    ShelleyBlock (TPraos Crypto) (AlonzoEra Crypto),
    ShelleyBlock (Praos Crypto) (BabbageEra Crypto),
    ShelleyBlock (Praos Crypto) (ConwayEra Crypto)]
  (ShelleyBlock (TPraos Crypto) (AlonzoEra Crypto))
-> Index
     (CardanoShelleyEras Crypto)
     (ShelleyBlock (TPraos Crypto) (AlonzoEra Crypto))
forall {k} (xs1 :: [k]) (x :: k) (y :: k).
Index xs1 x -> Index (y : xs1) x
IS (Index
  '[ShelleyBlock (TPraos Crypto) (MaryEra Crypto),
    ShelleyBlock (TPraos Crypto) (AlonzoEra Crypto),
    ShelleyBlock (Praos Crypto) (BabbageEra Crypto),
    ShelleyBlock (Praos Crypto) (ConwayEra Crypto)]
  (ShelleyBlock (TPraos Crypto) (AlonzoEra Crypto))
-> Index
     '[ShelleyBlock (TPraos Crypto) (AllegraEra Crypto),
       ShelleyBlock (TPraos Crypto) (MaryEra Crypto),
       ShelleyBlock (TPraos Crypto) (AlonzoEra Crypto),
       ShelleyBlock (Praos Crypto) (BabbageEra Crypto),
       ShelleyBlock (Praos Crypto) (ConwayEra Crypto)]
     (ShelleyBlock (TPraos Crypto) (AlonzoEra Crypto))
forall {k} (xs1 :: [k]) (x :: k) (y :: k).
Index xs1 x -> Index (y : xs1) x
IS (Index
  '[ShelleyBlock (TPraos Crypto) (AlonzoEra Crypto),
    ShelleyBlock (Praos Crypto) (BabbageEra Crypto),
    ShelleyBlock (Praos Crypto) (ConwayEra Crypto)]
  (ShelleyBlock (TPraos Crypto) (AlonzoEra Crypto))
-> Index
     '[ShelleyBlock (TPraos Crypto) (MaryEra Crypto),
       ShelleyBlock (TPraos Crypto) (AlonzoEra Crypto),
       ShelleyBlock (Praos Crypto) (BabbageEra Crypto),
       ShelleyBlock (Praos Crypto) (ConwayEra Crypto)]
     (ShelleyBlock (TPraos Crypto) (AlonzoEra Crypto))
forall {k} (xs1 :: [k]) (x :: k) (y :: k).
Index xs1 x -> Index (y : xs1) x
IS Index
  '[ShelleyBlock (TPraos Crypto) (AlonzoEra Crypto),
    ShelleyBlock (Praos Crypto) (BabbageEra Crypto),
    ShelleyBlock (Praos Crypto) (ConwayEra Crypto)]
  (ShelleyBlock (TPraos Crypto) (AlonzoEra Crypto))
forall {k} (x :: k) (xs1 :: [k]). Index (x : xs1) x
IZ)))))
        (-.->)
  Examples
  (K (Examples (CardanoBlock Crypto)))
  (ShelleyBlock (TPraos Crypto) (AlonzoEra Crypto))
-> NP
     (Examples -.-> K (Examples (CardanoBlock Crypto)))
     '[ShelleyBlock (Praos Crypto) (BabbageEra Crypto),
       ShelleyBlock (Praos Crypto) (ConwayEra Crypto)]
-> NP
     (Examples -.-> K (Examples (CardanoBlock Crypto)))
     '[ShelleyBlock (TPraos Crypto) (AlonzoEra Crypto),
       ShelleyBlock (Praos Crypto) (BabbageEra Crypto),
       ShelleyBlock (Praos Crypto) (ConwayEra Crypto)]
forall {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> NP f xs1 -> NP f (x : xs1)
:* (Examples (ShelleyBlock (Praos Crypto) (BabbageEra Crypto))
 -> K (Examples (CardanoBlock Crypto))
      (ShelleyBlock (Praos Crypto) (BabbageEra Crypto)))
-> (-.->)
     Examples
     (K (Examples (CardanoBlock Crypto)))
     (ShelleyBlock (Praos Crypto) (BabbageEra Crypto))
forall {k} (f :: k -> *) (a :: k) (f' :: k -> *).
(f a -> f' a) -> (-.->) f f' a
fn (Examples (CardanoBlock Crypto)
-> K (Examples (CardanoBlock Crypto))
     (ShelleyBlock (Praos Crypto) (BabbageEra Crypto))
forall k a (b :: k). a -> K a b
K (Examples (CardanoBlock Crypto)
 -> K (Examples (CardanoBlock Crypto))
      (ShelleyBlock (Praos Crypto) (BabbageEra Crypto)))
-> (Examples (ShelleyBlock (Praos Crypto) (BabbageEra Crypto))
    -> Examples (CardanoBlock Crypto))
-> Examples (ShelleyBlock (Praos Crypto) (BabbageEra Crypto))
-> K (Examples (CardanoBlock Crypto))
     (ShelleyBlock (Praos Crypto) (BabbageEra Crypto))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String
-> Index
     (ByronBlock : CardanoShelleyEras Crypto)
     (ShelleyBlock (Praos Crypto) (BabbageEra Crypto))
-> Examples (ShelleyBlock (Praos Crypto) (BabbageEra Crypto))
-> Examples (CardanoBlock Crypto)
forall blk.
String
-> Index (ByronBlock : CardanoShelleyEras Crypto) blk
-> Examples blk
-> Examples (CardanoBlock Crypto)
injExamples String
"Babbage" (Index
  (CardanoShelleyEras Crypto)
  (ShelleyBlock (Praos Crypto) (BabbageEra Crypto))
-> Index
     (ByronBlock : CardanoShelleyEras Crypto)
     (ShelleyBlock (Praos Crypto) (BabbageEra Crypto))
forall {k} (xs1 :: [k]) (x :: k) (y :: k).
Index xs1 x -> Index (y : xs1) x
IS (Index
  '[ShelleyBlock (TPraos Crypto) (AllegraEra Crypto),
    ShelleyBlock (TPraos Crypto) (MaryEra Crypto),
    ShelleyBlock (TPraos Crypto) (AlonzoEra Crypto),
    ShelleyBlock (Praos Crypto) (BabbageEra Crypto),
    ShelleyBlock (Praos Crypto) (ConwayEra Crypto)]
  (ShelleyBlock (Praos Crypto) (BabbageEra Crypto))
-> Index
     (CardanoShelleyEras Crypto)
     (ShelleyBlock (Praos Crypto) (BabbageEra Crypto))
forall {k} (xs1 :: [k]) (x :: k) (y :: k).
Index xs1 x -> Index (y : xs1) x
IS (Index
  '[ShelleyBlock (TPraos Crypto) (MaryEra Crypto),
    ShelleyBlock (TPraos Crypto) (AlonzoEra Crypto),
    ShelleyBlock (Praos Crypto) (BabbageEra Crypto),
    ShelleyBlock (Praos Crypto) (ConwayEra Crypto)]
  (ShelleyBlock (Praos Crypto) (BabbageEra Crypto))
-> Index
     '[ShelleyBlock (TPraos Crypto) (AllegraEra Crypto),
       ShelleyBlock (TPraos Crypto) (MaryEra Crypto),
       ShelleyBlock (TPraos Crypto) (AlonzoEra Crypto),
       ShelleyBlock (Praos Crypto) (BabbageEra Crypto),
       ShelleyBlock (Praos Crypto) (ConwayEra Crypto)]
     (ShelleyBlock (Praos Crypto) (BabbageEra Crypto))
forall {k} (xs1 :: [k]) (x :: k) (y :: k).
Index xs1 x -> Index (y : xs1) x
IS (Index
  '[ShelleyBlock (TPraos Crypto) (AlonzoEra Crypto),
    ShelleyBlock (Praos Crypto) (BabbageEra Crypto),
    ShelleyBlock (Praos Crypto) (ConwayEra Crypto)]
  (ShelleyBlock (Praos Crypto) (BabbageEra Crypto))
-> Index
     '[ShelleyBlock (TPraos Crypto) (MaryEra Crypto),
       ShelleyBlock (TPraos Crypto) (AlonzoEra Crypto),
       ShelleyBlock (Praos Crypto) (BabbageEra Crypto),
       ShelleyBlock (Praos Crypto) (ConwayEra Crypto)]
     (ShelleyBlock (Praos Crypto) (BabbageEra Crypto))
forall {k} (xs1 :: [k]) (x :: k) (y :: k).
Index xs1 x -> Index (y : xs1) x
IS (Index
  '[ShelleyBlock (Praos Crypto) (BabbageEra Crypto),
    ShelleyBlock (Praos Crypto) (ConwayEra Crypto)]
  (ShelleyBlock (Praos Crypto) (BabbageEra Crypto))
-> Index
     '[ShelleyBlock (TPraos Crypto) (AlonzoEra Crypto),
       ShelleyBlock (Praos Crypto) (BabbageEra Crypto),
       ShelleyBlock (Praos Crypto) (ConwayEra Crypto)]
     (ShelleyBlock (Praos Crypto) (BabbageEra Crypto))
forall {k} (xs1 :: [k]) (x :: k) (y :: k).
Index xs1 x -> Index (y : xs1) x
IS Index
  '[ShelleyBlock (Praos Crypto) (BabbageEra Crypto),
    ShelleyBlock (Praos Crypto) (ConwayEra Crypto)]
  (ShelleyBlock (Praos Crypto) (BabbageEra Crypto))
forall {k} (x :: k) (xs1 :: [k]). Index (x : xs1) x
IZ))))))
        (-.->)
  Examples
  (K (Examples (CardanoBlock Crypto)))
  (ShelleyBlock (Praos Crypto) (BabbageEra Crypto))
-> NP
     (Examples -.-> K (Examples (CardanoBlock Crypto)))
     '[ShelleyBlock (Praos Crypto) (ConwayEra Crypto)]
-> NP
     (Examples -.-> K (Examples (CardanoBlock Crypto)))
     '[ShelleyBlock (Praos Crypto) (BabbageEra Crypto),
       ShelleyBlock (Praos Crypto) (ConwayEra Crypto)]
forall {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> NP f xs1 -> NP f (x : xs1)
:* (Examples (ShelleyBlock (Praos Crypto) (ConwayEra Crypto))
 -> K (Examples (CardanoBlock Crypto))
      (ShelleyBlock (Praos Crypto) (ConwayEra Crypto)))
-> (-.->)
     Examples
     (K (Examples (CardanoBlock Crypto)))
     (ShelleyBlock (Praos Crypto) (ConwayEra Crypto))
forall {k} (f :: k -> *) (a :: k) (f' :: k -> *).
(f a -> f' a) -> (-.->) f f' a
fn (Examples (CardanoBlock Crypto)
-> K (Examples (CardanoBlock Crypto))
     (ShelleyBlock (Praos Crypto) (ConwayEra Crypto))
forall k a (b :: k). a -> K a b
K (Examples (CardanoBlock Crypto)
 -> K (Examples (CardanoBlock Crypto))
      (ShelleyBlock (Praos Crypto) (ConwayEra Crypto)))
-> (Examples (ShelleyBlock (Praos Crypto) (ConwayEra Crypto))
    -> Examples (CardanoBlock Crypto))
-> Examples (ShelleyBlock (Praos Crypto) (ConwayEra Crypto))
-> K (Examples (CardanoBlock Crypto))
     (ShelleyBlock (Praos Crypto) (ConwayEra Crypto))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String
-> Index
     (ByronBlock : CardanoShelleyEras Crypto)
     (ShelleyBlock (Praos Crypto) (ConwayEra Crypto))
-> Examples (ShelleyBlock (Praos Crypto) (ConwayEra Crypto))
-> Examples (CardanoBlock Crypto)
forall blk.
String
-> Index (ByronBlock : CardanoShelleyEras Crypto) blk
-> Examples blk
-> Examples (CardanoBlock Crypto)
injExamples String
"Conway"  (Index
  (CardanoShelleyEras Crypto)
  (ShelleyBlock (Praos Crypto) (ConwayEra Crypto))
-> Index
     (ByronBlock : CardanoShelleyEras Crypto)
     (ShelleyBlock (Praos Crypto) (ConwayEra Crypto))
forall {k} (xs1 :: [k]) (x :: k) (y :: k).
Index xs1 x -> Index (y : xs1) x
IS (Index
  '[ShelleyBlock (TPraos Crypto) (AllegraEra Crypto),
    ShelleyBlock (TPraos Crypto) (MaryEra Crypto),
    ShelleyBlock (TPraos Crypto) (AlonzoEra Crypto),
    ShelleyBlock (Praos Crypto) (BabbageEra Crypto),
    ShelleyBlock (Praos Crypto) (ConwayEra Crypto)]
  (ShelleyBlock (Praos Crypto) (ConwayEra Crypto))
-> Index
     (CardanoShelleyEras Crypto)
     (ShelleyBlock (Praos Crypto) (ConwayEra Crypto))
forall {k} (xs1 :: [k]) (x :: k) (y :: k).
Index xs1 x -> Index (y : xs1) x
IS (Index
  '[ShelleyBlock (TPraos Crypto) (MaryEra Crypto),
    ShelleyBlock (TPraos Crypto) (AlonzoEra Crypto),
    ShelleyBlock (Praos Crypto) (BabbageEra Crypto),
    ShelleyBlock (Praos Crypto) (ConwayEra Crypto)]
  (ShelleyBlock (Praos Crypto) (ConwayEra Crypto))
-> Index
     '[ShelleyBlock (TPraos Crypto) (AllegraEra Crypto),
       ShelleyBlock (TPraos Crypto) (MaryEra Crypto),
       ShelleyBlock (TPraos Crypto) (AlonzoEra Crypto),
       ShelleyBlock (Praos Crypto) (BabbageEra Crypto),
       ShelleyBlock (Praos Crypto) (ConwayEra Crypto)]
     (ShelleyBlock (Praos Crypto) (ConwayEra Crypto))
forall {k} (xs1 :: [k]) (x :: k) (y :: k).
Index xs1 x -> Index (y : xs1) x
IS (Index
  '[ShelleyBlock (TPraos Crypto) (AlonzoEra Crypto),
    ShelleyBlock (Praos Crypto) (BabbageEra Crypto),
    ShelleyBlock (Praos Crypto) (ConwayEra Crypto)]
  (ShelleyBlock (Praos Crypto) (ConwayEra Crypto))
-> Index
     '[ShelleyBlock (TPraos Crypto) (MaryEra Crypto),
       ShelleyBlock (TPraos Crypto) (AlonzoEra Crypto),
       ShelleyBlock (Praos Crypto) (BabbageEra Crypto),
       ShelleyBlock (Praos Crypto) (ConwayEra Crypto)]
     (ShelleyBlock (Praos Crypto) (ConwayEra Crypto))
forall {k} (xs1 :: [k]) (x :: k) (y :: k).
Index xs1 x -> Index (y : xs1) x
IS (Index
  '[ShelleyBlock (Praos Crypto) (BabbageEra Crypto),
    ShelleyBlock (Praos Crypto) (ConwayEra Crypto)]
  (ShelleyBlock (Praos Crypto) (ConwayEra Crypto))
-> Index
     '[ShelleyBlock (TPraos Crypto) (AlonzoEra Crypto),
       ShelleyBlock (Praos Crypto) (BabbageEra Crypto),
       ShelleyBlock (Praos Crypto) (ConwayEra Crypto)]
     (ShelleyBlock (Praos Crypto) (ConwayEra Crypto))
forall {k} (xs1 :: [k]) (x :: k) (y :: k).
Index xs1 x -> Index (y : xs1) x
IS (Index
  '[ShelleyBlock (Praos Crypto) (ConwayEra Crypto)]
  (ShelleyBlock (Praos Crypto) (ConwayEra Crypto))
-> Index
     '[ShelleyBlock (Praos Crypto) (BabbageEra Crypto),
       ShelleyBlock (Praos Crypto) (ConwayEra Crypto)]
     (ShelleyBlock (Praos Crypto) (ConwayEra Crypto))
forall {k} (xs1 :: [k]) (x :: k) (y :: k).
Index xs1 x -> Index (y : xs1) x
IS Index
  '[ShelleyBlock (Praos Crypto) (ConwayEra Crypto)]
  (ShelleyBlock (Praos Crypto) (ConwayEra Crypto))
forall {k} (x :: k) (xs1 :: [k]). Index (x : xs1) x
IZ)))))))
        (-.->)
  Examples
  (K (Examples (CardanoBlock Crypto)))
  (ShelleyBlock (Praos Crypto) (ConwayEra Crypto))
-> NP (Examples -.-> K (Examples (CardanoBlock Crypto))) '[]
-> NP
     (Examples -.-> K (Examples (CardanoBlock Crypto)))
     '[ShelleyBlock (Praos Crypto) (ConwayEra Crypto)]
forall {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> NP f xs1 -> NP f (x : xs1)
:* NP (Examples -.-> K (Examples (CardanoBlock Crypto))) '[]
forall {k} (f :: k -> *). NP f '[]
Nil

    injExamples ::
         String
      -> Index (CardanoEras Crypto) blk
      -> Examples blk
      -> Examples (CardanoBlock Crypto)
    injExamples :: forall blk.
String
-> Index (ByronBlock : CardanoShelleyEras Crypto) blk
-> Examples blk
-> Examples (CardanoBlock Crypto)
injExamples String
eraName Index (ByronBlock : CardanoShelleyEras Crypto) blk
idx =
          String
-> Examples (CardanoBlock Crypto) -> Examples (CardanoBlock Crypto)
forall blk. String -> Examples blk -> Examples blk
prefixExamples String
eraName
        (Examples (CardanoBlock Crypto) -> Examples (CardanoBlock Crypto))
-> (Examples blk -> Examples (CardanoBlock Crypto))
-> Examples blk
-> Examples (CardanoBlock Crypto)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Exactly (ByronBlock : CardanoShelleyEras Crypto) Bound
-> Index (ByronBlock : CardanoShelleyEras Crypto) blk
-> Examples blk
-> Examples (CardanoBlock Crypto)
forall x (xs :: [*]).
CanHardFork xs =>
Exactly xs Bound
-> Index xs x -> Examples x -> Examples (HardForkBlock xs)
forall (f :: * -> *) x (xs :: [*]).
(Inject f, CanHardFork xs) =>
Exactly xs Bound -> Index xs x -> f x -> f (HardForkBlock xs)
inject Exactly (ByronBlock : CardanoShelleyEras Crypto) Bound
exampleStartBounds Index (ByronBlock : CardanoShelleyEras Crypto) blk
idx

{-------------------------------------------------------------------------------
  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 =>
Exactly xs Bound
-> Index xs x -> Serialised x -> Serialised (HardForkBlock xs)
inject Exactly xs Bound
_ Index 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 =>
Exactly xs Bound
-> Index xs x -> SomeResult x -> SomeResult (HardForkBlock xs)
inject Exactly xs Bound
_ Index xs x
idx (SomeResult BlockQuery x result
q result
r) =
      BlockQuery (HardForkBlock xs) (Either (MismatchEraInfo xs) result)
-> Either (MismatchEraInfo xs) result
-> SomeResult (HardForkBlock xs)
forall result blk.
(Eq result, Show result, Typeable result) =>
BlockQuery blk result -> result -> SomeResult blk
SomeResult (QueryIfCurrent xs result
-> BlockQuery
     (HardForkBlock xs) (Either (MismatchEraInfo xs) result)
forall (xs :: [*]) result.
QueryIfCurrent xs result
-> BlockQuery
     (HardForkBlock xs) (Either (MismatchEraInfo xs) result)
QueryIfCurrent (Index xs x -> BlockQuery x result -> QueryIfCurrent xs result
forall x (xs :: [*]) result.
Index xs x -> BlockQuery x result -> QueryIfCurrent xs result
injectQuery Index xs x
idx BlockQuery x 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 =>
Exactly xs Bound
-> Index xs x -> Examples x -> Examples (HardForkBlock xs)
inject Exactly xs Bound
startBounds (Index xs x
idx :: Index xs x) Examples {Labelled x
Labelled SlotNo
Labelled (HeaderHash x)
Labelled (Header x)
Labelled (ChainDepState (BlockProtocol x))
Labelled (SomeSecond BlockQuery x)
Labelled (LedgerState x)
Labelled (GenTxId x)
Labelled (ApplyTxErr x)
Labelled (GenTx x)
Labelled (AnnTip x)
Labelled (SerialisedHeader x)
Labelled (ExtLedgerState x)
Labelled (Serialised x)
Labelled (SomeResult x)
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 (SomeSecond BlockQuery x)
exampleResult :: Labelled (SomeResult x)
exampleAnnTip :: Labelled (AnnTip x)
exampleLedgerState :: Labelled (LedgerState x)
exampleChainDepState :: Labelled (ChainDepState (BlockProtocol x))
exampleExtLedgerState :: Labelled (ExtLedgerState x)
exampleSlotNo :: Labelled SlotNo
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 (SomeSecond 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)
exampleChainDepState :: forall blk.
Examples blk -> Labelled (ChainDepState (BlockProtocol blk))
exampleExtLedgerState :: forall blk. Examples blk -> Labelled (ExtLedgerState blk)
exampleSlotNo :: forall blk. Examples blk -> Labelled SlotNo
..} = 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 (SomeSecond BlockQuery (HardForkBlock xs))
exampleQuery            = Proxy (SomeSecond BlockQuery)
-> Labelled (SomeSecond BlockQuery x)
-> Labelled (SomeSecond 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 @(SomeSecond BlockQuery)) Labelled (SomeSecond 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))
exampleLedgerState      = Proxy LedgerState
-> Labelled (LedgerState x)
-> Labelled (LedgerState (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 @LedgerState)             Labelled (LedgerState x)
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))
exampleExtLedgerState   = Proxy ExtLedgerState
-> Labelled (ExtLedgerState x)
-> Labelled (ExtLedgerState (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 @ExtLedgerState)          Labelled (ExtLedgerState x)
exampleExtLedgerState
      , exampleSlotNo :: Labelled SlotNo
exampleSlotNo           =                                      Labelled SlotNo
exampleSlotNo
      }
    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]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((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 -> Exactly xs Bound -> Index xs x -> a -> b
forall (f :: * -> *) a b x (xs :: [*]).
(Inject f, CanHardFork xs, Coercible a (f x),
 Coercible b (f (HardForkBlock xs))) =>
Proxy f -> Exactly xs Bound -> Index xs x -> a -> b
inject' Proxy f
p Exactly xs Bound
startBounds Index xs x
idx))

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

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

shelleyEraParams :: History.EraParams
shelleyEraParams :: EraParams
shelleyEraParams = forall c. ShelleyGenesis c -> EraParams
Shelley.shelleyEraParams @StandardCrypto ShelleyGenesis Crypto
forall c. Crypto c => ShelleyGenesis c
Shelley.testShelleyGenesis

allegraEraParams :: History.EraParams
allegraEraParams :: EraParams
allegraEraParams = forall c. ShelleyGenesis c -> EraParams
Shelley.shelleyEraParams @StandardCrypto ShelleyGenesis Crypto
forall c. Crypto c => ShelleyGenesis c
Shelley.testShelleyGenesis

maryEraParams :: History.EraParams
maryEraParams :: EraParams
maryEraParams = forall c. ShelleyGenesis c -> EraParams
Shelley.shelleyEraParams @StandardCrypto ShelleyGenesis Crypto
forall c. Crypto c => ShelleyGenesis c
Shelley.testShelleyGenesis

alonzoEraParams :: History.EraParams
alonzoEraParams :: EraParams
alonzoEraParams = forall c. ShelleyGenesis c -> EraParams
Shelley.shelleyEraParams @StandardCrypto ShelleyGenesis Crypto
forall c. Crypto c => ShelleyGenesis c
Shelley.testShelleyGenesis

babbageEraParams :: History.EraParams
babbageEraParams :: EraParams
babbageEraParams = forall c. ShelleyGenesis c -> EraParams
Shelley.shelleyEraParams @StandardCrypto ShelleyGenesis Crypto
forall c. Crypto c => ShelleyGenesis c
Shelley.testShelleyGenesis

conwayEraParams :: History.EraParams
conwayEraParams :: EraParams
conwayEraParams = forall c. ShelleyGenesis c -> EraParams
Shelley.shelleyEraParams @StandardCrypto ShelleyGenesis Crypto
forall c. Crypto c => ShelleyGenesis c
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 Crypto))
forall k a (b :: k). a -> K a b
K Bound
shelleyStartBound
    K Bound (ShelleyBlock (TPraos Crypto) (ShelleyEra Crypto))
-> NP
     (K Bound)
     '[ShelleyBlock (TPraos Crypto) (AllegraEra Crypto),
       ShelleyBlock (TPraos Crypto) (MaryEra Crypto),
       ShelleyBlock (TPraos Crypto) (AlonzoEra Crypto),
       ShelleyBlock (Praos Crypto) (BabbageEra Crypto),
       ShelleyBlock (Praos Crypto) (ConwayEra Crypto)]
-> 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 Crypto))
forall k a (b :: k). a -> K a b
K Bound
allegraStartBound
    K Bound (ShelleyBlock (TPraos Crypto) (AllegraEra Crypto))
-> NP
     (K Bound)
     '[ShelleyBlock (TPraos Crypto) (MaryEra Crypto),
       ShelleyBlock (TPraos Crypto) (AlonzoEra Crypto),
       ShelleyBlock (Praos Crypto) (BabbageEra Crypto),
       ShelleyBlock (Praos Crypto) (ConwayEra Crypto)]
-> NP
     (K Bound)
     '[ShelleyBlock (TPraos Crypto) (AllegraEra Crypto),
       ShelleyBlock (TPraos Crypto) (MaryEra Crypto),
       ShelleyBlock (TPraos Crypto) (AlonzoEra Crypto),
       ShelleyBlock (Praos Crypto) (BabbageEra Crypto),
       ShelleyBlock (Praos Crypto) (ConwayEra Crypto)]
forall {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> NP f xs1 -> NP f (x : xs1)
:* Bound -> K Bound (ShelleyBlock (TPraos Crypto) (MaryEra Crypto))
forall k a (b :: k). a -> K a b
K Bound
maryStartBound
    K Bound (ShelleyBlock (TPraos Crypto) (MaryEra Crypto))
-> NP
     (K Bound)
     '[ShelleyBlock (TPraos Crypto) (AlonzoEra Crypto),
       ShelleyBlock (Praos Crypto) (BabbageEra Crypto),
       ShelleyBlock (Praos Crypto) (ConwayEra Crypto)]
-> NP
     (K Bound)
     '[ShelleyBlock (TPraos Crypto) (MaryEra Crypto),
       ShelleyBlock (TPraos Crypto) (AlonzoEra Crypto),
       ShelleyBlock (Praos Crypto) (BabbageEra Crypto),
       ShelleyBlock (Praos Crypto) (ConwayEra Crypto)]
forall {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> NP f xs1 -> NP f (x : xs1)
:* Bound -> K Bound (ShelleyBlock (TPraos Crypto) (AlonzoEra Crypto))
forall k a (b :: k). a -> K a b
K Bound
alonzoStartBound
    K Bound (ShelleyBlock (TPraos Crypto) (AlonzoEra Crypto))
-> NP
     (K Bound)
     '[ShelleyBlock (Praos Crypto) (BabbageEra Crypto),
       ShelleyBlock (Praos Crypto) (ConwayEra Crypto)]
-> NP
     (K Bound)
     '[ShelleyBlock (TPraos Crypto) (AlonzoEra Crypto),
       ShelleyBlock (Praos Crypto) (BabbageEra Crypto),
       ShelleyBlock (Praos Crypto) (ConwayEra Crypto)]
forall {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> NP f xs1 -> NP f (x : xs1)
:* Bound -> K Bound (ShelleyBlock (Praos Crypto) (BabbageEra Crypto))
forall k a (b :: k). a -> K a b
K Bound
babbageStartBound
    K Bound (ShelleyBlock (Praos Crypto) (BabbageEra Crypto))
-> NP (K Bound) '[ShelleyBlock (Praos Crypto) (ConwayEra Crypto)]
-> NP
     (K Bound)
     '[ShelleyBlock (Praos Crypto) (BabbageEra Crypto),
       ShelleyBlock (Praos Crypto) (ConwayEra Crypto)]
forall {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> NP f xs1 -> NP f (x : xs1)
:* Bound -> K Bound (ShelleyBlock (Praos Crypto) (ConwayEra Crypto))
forall k a (b :: k). a -> K a b
K Bound
conwayStartBound
    K Bound (ShelleyBlock (Praos Crypto) (ConwayEra Crypto))
-> NP (K Bound) '[]
-> NP (K Bound) '[ShelleyBlock (Praos Crypto) (ConwayEra Crypto)]
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 Crypto))
forall k a (b :: k). a -> K a b
K EraParams
shelleyEraParams
    K EraParams (ShelleyBlock (TPraos Crypto) (ShelleyEra Crypto))
-> NP
     (K EraParams)
     '[ShelleyBlock (TPraos Crypto) (AllegraEra Crypto),
       ShelleyBlock (TPraos Crypto) (MaryEra Crypto),
       ShelleyBlock (TPraos Crypto) (AlonzoEra Crypto),
       ShelleyBlock (Praos Crypto) (BabbageEra Crypto),
       ShelleyBlock (Praos Crypto) (ConwayEra Crypto)]
-> 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 Crypto))
forall k a (b :: k). a -> K a b
K EraParams
allegraEraParams
    K EraParams (ShelleyBlock (TPraos Crypto) (AllegraEra Crypto))
-> NP
     (K EraParams)
     '[ShelleyBlock (TPraos Crypto) (MaryEra Crypto),
       ShelleyBlock (TPraos Crypto) (AlonzoEra Crypto),
       ShelleyBlock (Praos Crypto) (BabbageEra Crypto),
       ShelleyBlock (Praos Crypto) (ConwayEra Crypto)]
-> NP
     (K EraParams)
     '[ShelleyBlock (TPraos Crypto) (AllegraEra Crypto),
       ShelleyBlock (TPraos Crypto) (MaryEra Crypto),
       ShelleyBlock (TPraos Crypto) (AlonzoEra Crypto),
       ShelleyBlock (Praos Crypto) (BabbageEra Crypto),
       ShelleyBlock (Praos Crypto) (ConwayEra Crypto)]
forall {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> NP f xs1 -> NP f (x : xs1)
:* EraParams
-> K EraParams (ShelleyBlock (TPraos Crypto) (MaryEra Crypto))
forall k a (b :: k). a -> K a b
K EraParams
maryEraParams
    K EraParams (ShelleyBlock (TPraos Crypto) (MaryEra Crypto))
-> NP
     (K EraParams)
     '[ShelleyBlock (TPraos Crypto) (AlonzoEra Crypto),
       ShelleyBlock (Praos Crypto) (BabbageEra Crypto),
       ShelleyBlock (Praos Crypto) (ConwayEra Crypto)]
-> NP
     (K EraParams)
     '[ShelleyBlock (TPraos Crypto) (MaryEra Crypto),
       ShelleyBlock (TPraos Crypto) (AlonzoEra Crypto),
       ShelleyBlock (Praos Crypto) (BabbageEra Crypto),
       ShelleyBlock (Praos Crypto) (ConwayEra Crypto)]
forall {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> NP f xs1 -> NP f (x : xs1)
:* EraParams
-> K EraParams (ShelleyBlock (TPraos Crypto) (AlonzoEra Crypto))
forall k a (b :: k). a -> K a b
K EraParams
alonzoEraParams
    K EraParams (ShelleyBlock (TPraos Crypto) (AlonzoEra Crypto))
-> NP
     (K EraParams)
     '[ShelleyBlock (Praos Crypto) (BabbageEra Crypto),
       ShelleyBlock (Praos Crypto) (ConwayEra Crypto)]
-> NP
     (K EraParams)
     '[ShelleyBlock (TPraos Crypto) (AlonzoEra Crypto),
       ShelleyBlock (Praos Crypto) (BabbageEra Crypto),
       ShelleyBlock (Praos Crypto) (ConwayEra Crypto)]
forall {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> NP f xs1 -> NP f (x : xs1)
:* EraParams
-> K EraParams (ShelleyBlock (Praos Crypto) (BabbageEra Crypto))
forall k a (b :: k). a -> K a b
K EraParams
babbageEraParams
    K EraParams (ShelleyBlock (Praos Crypto) (BabbageEra Crypto))
-> NP
     (K EraParams) '[ShelleyBlock (Praos Crypto) (ConwayEra Crypto)]
-> NP
     (K EraParams)
     '[ShelleyBlock (Praos Crypto) (BabbageEra Crypto),
       ShelleyBlock (Praos Crypto) (ConwayEra Crypto)]
forall {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> NP f xs1 -> NP f (x : xs1)
:* EraParams
-> K EraParams (ShelleyBlock (Praos Crypto) (ConwayEra Crypto))
forall k a (b :: k). a -> K a b
K EraParams
conwayEraParams
    K EraParams (ShelleyBlock (Praos Crypto) (ConwayEra Crypto))
-> NP (K EraParams) '[]
-> NP
     (K EraParams) '[ShelleyBlock (Praos Crypto) (ConwayEra Crypto)]
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
     LedgerState (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)
-> HardForkState
     LedgerState (ByronBlock : CardanoShelleyEras Crypto)
forall (xs :: [*]).
LedgerState (HardForkBlock xs) -> HardForkState LedgerState xs
hardForkLedgerStatePerEra (LedgerState ByronBlock -> LedgerState (CardanoBlock Crypto)
ledgerStateByron LedgerState ByronBlock
byronLedger))
  where
    (Maybe String
_, LedgerState ByronBlock
byronLedger) = [(Maybe String, LedgerState ByronBlock)]
-> (Maybe String, LedgerState ByronBlock)
forall a. HasCallStack => [a] -> a
head ([(Maybe String, LedgerState ByronBlock)]
 -> (Maybe String, LedgerState ByronBlock))
-> [(Maybe String, LedgerState ByronBlock)]
-> (Maybe String, LedgerState ByronBlock)
forall a b. (a -> b) -> a -> b
$ Examples ByronBlock -> [(Maybe String, LedgerState ByronBlock)]
forall blk. Examples blk -> Labelled (LedgerState blk)
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) StandardShelley)
eraInfoShelley :: SingleEraInfo (ShelleyBlock (TPraos Crypto) (ShelleyEra Crypto))
eraInfoShelley = Proxy (ShelleyBlock (TPraos Crypto) (ShelleyEra Crypto))
-> SingleEraInfo (ShelleyBlock (TPraos Crypto) (ShelleyEra Crypto))
forall blk (proxy :: * -> *).
SingleEraBlock blk =>
proxy blk -> SingleEraInfo blk
forall (proxy :: * -> *).
proxy (ShelleyBlock (TPraos Crypto) (ShelleyEra Crypto))
-> SingleEraInfo (ShelleyBlock (TPraos Crypto) (ShelleyEra Crypto))
singleEraInfo (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(ShelleyBlock (TPraos StandardCrypto) StandardShelley))

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

ledgerStateByron ::
     LedgerState ByronBlock
  -> LedgerState (CardanoBlock Crypto)
ledgerStateByron :: LedgerState ByronBlock -> LedgerState (CardanoBlock Crypto)
ledgerStateByron LedgerState ByronBlock
stByron =
    HardForkState LedgerState (ByronBlock : CardanoShelleyEras Crypto)
-> LedgerState (CardanoBlock Crypto)
forall (xs :: [*]).
HardForkState LedgerState xs -> LedgerState (HardForkBlock xs)
HardForkLedgerState (HardForkState LedgerState (ByronBlock : CardanoShelleyEras Crypto)
 -> LedgerState (CardanoBlock Crypto))
-> HardForkState
     LedgerState (ByronBlock : CardanoShelleyEras Crypto)
-> LedgerState (CardanoBlock Crypto)
forall a b. (a -> b) -> a -> b
$ Telescope
  (K Past)
  (Current LedgerState)
  (ByronBlock : CardanoShelleyEras Crypto)
-> HardForkState
     LedgerState (ByronBlock : CardanoShelleyEras Crypto)
forall (f :: * -> *) (xs :: [*]).
Telescope (K Past) (Current f) xs -> HardForkState f xs
HardForkState (Telescope
   (K Past)
   (Current LedgerState)
   (ByronBlock : CardanoShelleyEras Crypto)
 -> HardForkState
      LedgerState (ByronBlock : CardanoShelleyEras Crypto))
-> Telescope
     (K Past)
     (Current LedgerState)
     (ByronBlock : CardanoShelleyEras Crypto)
-> HardForkState
     LedgerState (ByronBlock : CardanoShelleyEras Crypto)
forall a b. (a -> b) -> a -> b
$ Current LedgerState ByronBlock
-> Telescope
     (K Past)
     (Current LedgerState)
     (ByronBlock : CardanoShelleyEras Crypto)
forall {k} (f :: k -> *) (x :: k) (g :: k -> *) (xs1 :: [k]).
f x -> Telescope g f (x : xs1)
TZ Current LedgerState ByronBlock
cur
  where
    cur :: Current LedgerState ByronBlock
cur = State.Current {
          currentStart :: Bound
currentStart = Bound
History.initBound
        , currentState :: LedgerState ByronBlock
currentState = LedgerState ByronBlock
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 Crypto))
-> NS SingleEraInfo (CardanoShelleyEras Crypto)
forall {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> NS f (x : xs1)
Z SingleEraInfo (ShelleyBlock (TPraos Crypto) (ShelleyEra Crypto))
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 Crypto))
-> NS LedgerEraInfo (CardanoShelleyEras Crypto)
forall {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> NS f (x : xs1)
Z (SingleEraInfo (ShelleyBlock (TPraos Crypto) (ShelleyEra Crypto))
-> LedgerEraInfo (ShelleyBlock (TPraos Crypto) (ShelleyEra Crypto))
forall blk. SingleEraInfo blk -> LedgerEraInfo blk
LedgerEraInfo SingleEraInfo (ShelleyBlock (TPraos Crypto) (ShelleyEra Crypto))
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 :: SomeSecond BlockQuery (CardanoBlock Crypto)
exampleQueryEraMismatchByron :: SomeSecond BlockQuery (CardanoBlock Crypto)
exampleQueryEraMismatchByron =
    BlockQuery
  (CardanoBlock Crypto)
  (CardanoQueryResult
     Crypto (Point (ShelleyBlock (TPraos Crypto) (ShelleyEra Crypto))))
-> SomeSecond BlockQuery (CardanoBlock Crypto)
forall {k1} {k2} (f :: k1 -> k2 -> *) (a :: k1) (b :: k2).
f a b -> SomeSecond f a
SomeSecond (BlockQuery
  (ShelleyBlock (TPraos Crypto) (ShelleyEra Crypto))
  (Point (ShelleyBlock (TPraos Crypto) (ShelleyEra Crypto)))
-> BlockQuery
     (CardanoBlock Crypto)
     (CardanoQueryResult
        Crypto (Point (ShelleyBlock (TPraos Crypto) (ShelleyEra Crypto))))
forall c a result.
(CardanoQueryResult c result ~ a) =>
BlockQuery (ShelleyBlock (TPraos c) (ShelleyEra c)) result
-> CardanoQuery c a
QueryIfCurrentShelley BlockQuery
  (ShelleyBlock (TPraos Crypto) (ShelleyEra Crypto))
  (Point (ShelleyBlock (TPraos Crypto) (ShelleyEra Crypto)))
forall proto era.
BlockQuery
  (ShelleyBlock proto era) (Point (ShelleyBlock proto era))
Shelley.GetLedgerTip)

exampleQueryEraMismatchShelley :: SomeSecond BlockQuery (CardanoBlock Crypto)
exampleQueryEraMismatchShelley :: SomeSecond BlockQuery (CardanoBlock Crypto)
exampleQueryEraMismatchShelley =
    BlockQuery (CardanoBlock Crypto) (CardanoQueryResult Crypto State)
-> SomeSecond BlockQuery (CardanoBlock Crypto)
forall {k1} {k2} (f :: k1 -> k2 -> *) (a :: k1) (b :: k2).
f a b -> SomeSecond f a
SomeSecond (BlockQuery ByronBlock State
-> BlockQuery
     (CardanoBlock Crypto) (CardanoQueryResult Crypto State)
forall c a result.
(CardanoQueryResult c result ~ a) =>
BlockQuery ByronBlock result -> CardanoQuery c a
QueryIfCurrentByron BlockQuery ByronBlock State
Byron.GetUpdateInterfaceState)

exampleQueryAnytimeByron :: SomeSecond BlockQuery (CardanoBlock Crypto)
exampleQueryAnytimeByron :: SomeSecond BlockQuery (CardanoBlock Crypto)
exampleQueryAnytimeByron =
    BlockQuery (CardanoBlock Crypto) (Maybe Bound)
-> SomeSecond BlockQuery (CardanoBlock Crypto)
forall {k1} {k2} (f :: k1 -> k2 -> *) (a :: k1) (b :: k2).
f a b -> SomeSecond f a
SomeSecond (QueryAnytime (Maybe Bound)
-> BlockQuery (CardanoBlock Crypto) (Maybe Bound)
forall result c. QueryAnytime result -> CardanoQuery c result
QueryAnytimeByron QueryAnytime (Maybe Bound)
GetEraStart)

exampleQueryAnytimeShelley :: SomeSecond BlockQuery (CardanoBlock Crypto)
exampleQueryAnytimeShelley :: SomeSecond BlockQuery (CardanoBlock Crypto)
exampleQueryAnytimeShelley =
    BlockQuery (CardanoBlock Crypto) (Maybe Bound)
-> SomeSecond BlockQuery (CardanoBlock Crypto)
forall {k1} {k2} (f :: k1 -> k2 -> *) (a :: k1) (b :: k2).
f a b -> SomeSecond f a
SomeSecond (QueryAnytime (Maybe Bound)
-> BlockQuery (CardanoBlock Crypto) (Maybe Bound)
forall result c. QueryAnytime result -> CardanoQuery c result
QueryAnytimeShelley QueryAnytime (Maybe Bound)
GetEraStart)

exampleQueryHardFork :: SomeSecond BlockQuery (CardanoBlock Crypto)
exampleQueryHardFork :: SomeSecond BlockQuery (CardanoBlock Crypto)
exampleQueryHardFork =
    BlockQuery
  (CardanoBlock Crypto)
  (Interpreter (ByronBlock : CardanoShelleyEras Crypto))
-> SomeSecond BlockQuery (CardanoBlock Crypto)
forall {k1} {k2} (f :: k1 -> k2 -> *) (a :: k1) (b :: k2).
f a b -> SomeSecond f a
SomeSecond (QueryHardFork
  (ByronBlock : CardanoShelleyEras Crypto)
  (Interpreter (ByronBlock : CardanoShelleyEras Crypto))
-> BlockQuery
     (CardanoBlock Crypto)
     (Interpreter (ByronBlock : CardanoShelleyEras Crypto))
forall (xs1 :: [*]) x a.
IsNonEmpty xs1 =>
QueryHardFork (x : xs1) a -> BlockQuery (HardForkBlock (x : xs1)) a
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)
  (CardanoQueryResult
     Crypto (Point (ShelleyBlock (TPraos Crypto) (ShelleyEra Crypto))))
-> CardanoQueryResult
     Crypto (Point (ShelleyBlock (TPraos Crypto) (ShelleyEra Crypto)))
-> SomeResult (CardanoBlock Crypto)
forall result blk.
(Eq result, Show result, Typeable result) =>
BlockQuery blk result -> result -> SomeResult blk
SomeResult
      (BlockQuery
  (ShelleyBlock (TPraos Crypto) (ShelleyEra Crypto))
  (Point (ShelleyBlock (TPraos Crypto) (ShelleyEra Crypto)))
-> BlockQuery
     (CardanoBlock Crypto)
     (CardanoQueryResult
        Crypto (Point (ShelleyBlock (TPraos Crypto) (ShelleyEra Crypto))))
forall c a result.
(CardanoQueryResult c result ~ a) =>
BlockQuery (ShelleyBlock (TPraos c) (ShelleyEra c)) result
-> CardanoQuery c a
QueryIfCurrentShelley BlockQuery
  (ShelleyBlock (TPraos Crypto) (ShelleyEra Crypto))
  (Point (ShelleyBlock (TPraos Crypto) (ShelleyEra Crypto)))
forall proto era.
BlockQuery
  (ShelleyBlock proto era) (Point (ShelleyBlock proto era))
Shelley.GetLedgerTip)
      (MismatchEraInfo (ByronBlock : CardanoShelleyEras Crypto)
-> CardanoQueryResult
     Crypto (Point (ShelleyBlock (TPraos Crypto) (ShelleyEra Crypto)))
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) (CardanoQueryResult Crypto State)
-> CardanoQueryResult Crypto State
-> SomeResult (CardanoBlock Crypto)
forall result blk.
(Eq result, Show result, Typeable result) =>
BlockQuery blk result -> result -> SomeResult blk
SomeResult
      (BlockQuery ByronBlock State
-> BlockQuery
     (CardanoBlock Crypto) (CardanoQueryResult Crypto State)
forall c a result.
(CardanoQueryResult c result ~ a) =>
BlockQuery ByronBlock result -> CardanoQuery c a
QueryIfCurrentByron BlockQuery ByronBlock 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) (Maybe Bound)
-> Maybe Bound -> SomeResult (CardanoBlock Crypto)
forall result blk.
(Eq result, Show result, Typeable result) =>
BlockQuery blk result -> result -> SomeResult blk
SomeResult (QueryAnytime (Maybe Bound)
-> BlockQuery (CardanoBlock Crypto) (Maybe Bound)
forall result c. QueryAnytime result -> CardanoQuery c 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) (Maybe Bound)
-> Maybe Bound -> SomeResult (CardanoBlock Crypto)
forall result blk.
(Eq result, Show result, Typeable result) =>
BlockQuery blk result -> result -> SomeResult blk
SomeResult (QueryAnytime (Maybe Bound)
-> BlockQuery (CardanoBlock Crypto) (Maybe Bound)
forall result c. QueryAnytime result -> CardanoQuery c 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)
  (Interpreter (ByronBlock : CardanoShelleyEras Crypto))
-> Interpreter (ByronBlock : CardanoShelleyEras Crypto)
-> SomeResult (CardanoBlock Crypto)
forall result blk.
(Eq result, Show result, Typeable result) =>
BlockQuery blk result -> result -> SomeResult blk
SomeResult (QueryHardFork
  (ByronBlock : CardanoShelleyEras Crypto)
  (Interpreter (ByronBlock : CardanoShelleyEras Crypto))
-> BlockQuery
     (CardanoBlock Crypto)
     (Interpreter (ByronBlock : CardanoShelleyEras Crypto))
forall (xs1 :: [*]) x a.
IsNonEmpty xs1 =>
QueryHardFork (x : xs1) a -> BlockQuery (HardForkBlock (x : xs1)) a
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)