{-# LANGUAGE DataKinds #-}
{-# LANGUAGE EmptyCase #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE StandaloneKindSignatures #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE UndecidableSuperClasses #-}

{-# OPTIONS_GHC -Wno-orphans #-}

module Ouroboros.Consensus.HardFork.Combinator.Ledger.Query (
    BlockQuery (..)
  , BlockSupportsHFLedgerQuery (..)
  , HardForkNodeToClientVersion (..)
  , HardForkQueryResult
  , QueryAnytime (..)
  , QueryHardFork (..)
  , QueryIfCurrent (..)
  , decodeQueryAnytimeResult
  , decodeQueryHardForkResult
  , encodeQueryAnytimeResult
  , encodeQueryHardForkResult
  , getHardForkQuery
  , hardForkQueryInfo
  ) where

import           Cardano.Binary (enforceSize)
import           Codec.CBOR.Decoding (Decoder)
import qualified Codec.CBOR.Decoding as Dec
import           Codec.CBOR.Encoding (Encoding)
import qualified Codec.CBOR.Encoding as Enc
import           Codec.Serialise (Serialise (..))
import           Data.Bifunctor
import           Data.Functor.Product
import           Data.Kind (Type)
import           Data.Proxy
import           Data.SOP.BasicFunctors
import           Data.SOP.Constraint
import           Data.SOP.Counting (getExactly)
import           Data.SOP.Functors (Flip (..))
import           Data.SOP.Index
import           Data.SOP.Match (Mismatch (..), mustMatchNS)
import           Data.SOP.Strict
import           Data.Type.Equality
import           Data.Typeable (Typeable)
import           NoThunks.Class
import           Ouroboros.Consensus.Block
import           Ouroboros.Consensus.Config
import           Ouroboros.Consensus.HardFork.Abstract (hardForkSummary)
import           Ouroboros.Consensus.HardFork.Combinator.Abstract
import           Ouroboros.Consensus.HardFork.Combinator.AcrossEras
import           Ouroboros.Consensus.HardFork.Combinator.Basics
import           Ouroboros.Consensus.HardFork.Combinator.Block
import           Ouroboros.Consensus.HardFork.Combinator.Info
import           Ouroboros.Consensus.HardFork.Combinator.Ledger ()
import           Ouroboros.Consensus.HardFork.Combinator.NetworkVersion
import           Ouroboros.Consensus.HardFork.Combinator.PartialConfig
import           Ouroboros.Consensus.HardFork.Combinator.State (Current (..),
                     Past (..), Situated (..))
import qualified Ouroboros.Consensus.HardFork.Combinator.State as State
import           Ouroboros.Consensus.HardFork.History (Bound (..), EraParams,
                     Shape (..))
import qualified Ouroboros.Consensus.HardFork.History as History
import           Ouroboros.Consensus.HeaderValidation
import           Ouroboros.Consensus.Ledger.Abstract
import           Ouroboros.Consensus.Ledger.Extended
import           Ouroboros.Consensus.Ledger.Query
import           Ouroboros.Consensus.Node.Serialisation (Some (..))
import           Ouroboros.Consensus.Storage.LedgerDB
import           Ouroboros.Consensus.TypeFamilyWrappers (WrapChainDepState (..),
                     WrapTxOut)
import           Ouroboros.Consensus.Util (ShowProxy)
import           Ouroboros.Consensus.Util.IOLike (MonadSTM (atomically))

type HardForkQueryResult xs = Either (MismatchEraInfo xs)

data instance BlockQuery (HardForkBlock xs) footprint result where
  -- | Answer a query about an era if it is the current one.
  QueryIfCurrent ::
       QueryIfCurrent xs footprint result
    -> BlockQuery (HardForkBlock xs) footprint (HardForkQueryResult xs result)

  -- | Answer a query about an era from /any/ era.
  --
  -- NOTE: we don't allow this when there is only a single era, so that the
  -- HFC applied to a single era is still isomorphic to the single era.
  QueryAnytime ::
       IsNonEmpty xs
    => QueryAnytime result
    -> EraIndex (x ': xs)
    -> BlockQuery (HardForkBlock (x ': xs)) QFNoTables result

  -- | Answer a query about the hard fork combinator
  --
  -- NOTE: we don't allow this when there is only a single era, so that the
  -- HFC applied to a single era is still isomorphic to the single era.
  QueryHardFork ::
       IsNonEmpty xs
    => QueryHardFork (x ': xs) result
    -> BlockQuery (HardForkBlock (x ': xs)) QFNoTables result

-- | Queries that use ledger tables usually can be implemented faster if we work
-- with the hard fork tables rather than projecting everything to the
-- appropriate era before we process the query. This class should be used to
-- implement how these queries that have a footprint which is not @QFNoTables@
-- are answered.
class ( All (Compose NoThunks WrapTxOut) xs
      , All (Compose Show WrapTxOut) xs
      , All (Compose Eq WrapTxOut) xs
      , All (Compose HasTickedLedgerTables LedgerState) xs
      , All (Compose HasLedgerTables LedgerState) xs
      ) => BlockSupportsHFLedgerQuery xs where
  answerBlockQueryHFLookup ::
       All SingleEraBlock xs
    => Monad m
    => Index xs x
    -> ExtLedgerCfg x
    -> BlockQuery x QFLookupTables result
    -> ReadOnlyForker' m (HardForkBlock xs)
    -> m result

  answerBlockQueryHFTraverse ::
       All SingleEraBlock xs
    => Monad m
    => Index xs x
    -> ExtLedgerCfg x
    -> BlockQuery x QFTraverseTables result
    -> ReadOnlyForker' m (HardForkBlock xs)
    -> m result

  -- | The @QFTraverseTables@ queries consist of some filter on the @TxOut@. This class
  -- provides that filter so that @answerBlockQueryHFAll@ can be implemented
  -- in an abstract manner depending on this function.
  queryLedgerGetTraversingFilter ::
       Index xs x
    -> BlockQuery x QFTraverseTables result
    -> TxOut (LedgerState (HardForkBlock xs))
    -> Bool

{-------------------------------------------------------------------------------
  Instances
-------------------------------------------------------------------------------}

------
-- Show
------

instance Typeable xs => ShowProxy (BlockQuery (HardForkBlock xs)) where
-- Use default implementation

deriving instance All SingleEraBlock xs => Show (BlockQuery (HardForkBlock xs) footprint result)

instance All SingleEraBlock xs
      => ShowQuery (BlockQuery (HardForkBlock xs) footprint) where
  showResult :: forall result.
BlockQuery (HardForkBlock xs) footprint result -> result -> String
showResult (QueryAnytime   QueryAnytime result
qry EraIndex (x : xs)
_) result
result = QueryAnytime result -> result -> String
forall result. QueryAnytime result -> result -> String
forall (query :: * -> *) result.
ShowQuery query =>
query result -> result -> String
showResult QueryAnytime result
qry result
result
  showResult (QueryHardFork  QueryHardFork (x : xs) result
qry)   result
result = QueryHardFork (x : xs) result -> result -> String
forall result. QueryHardFork (x : xs) result -> result -> String
forall (query :: * -> *) result.
ShowQuery query =>
query result -> result -> String
showResult QueryHardFork (x : xs) result
qry result
result
  showResult (QueryIfCurrent QueryIfCurrent xs footprint result
qry)  result
mResult =
      case result
mResult of
        Left  MismatchEraInfo xs
err    -> MismatchEraInfo xs -> String
forall a. Show a => a -> String
show MismatchEraInfo xs
err
        Right result
result -> QueryIfCurrent xs footprint result -> result -> String
forall result.
QueryIfCurrent xs footprint result -> result -> String
forall (query :: * -> *) result.
ShowQuery query =>
query result -> result -> String
showResult QueryIfCurrent xs footprint result
qry result
result

------
-- Eq
------

instance All SingleEraBlock xs => SameDepIndex2 (BlockQuery (HardForkBlock xs)) where
  sameDepIndex2 :: forall (x :: QueryFootprint) a (y :: QueryFootprint) b.
BlockQuery (HardForkBlock xs) x a
-> BlockQuery (HardForkBlock xs) y b -> Maybe ('(x, a) :~: '(y, b))
sameDepIndex2 (QueryIfCurrent QueryIfCurrent xs x result
qry) (QueryIfCurrent QueryIfCurrent xs y result
qry') =
      (\'(x, result) :~: '(y, result)
Refl -> '(x, a) :~: '(x, a)
'(x, a) :~: '(y, b)
forall {k} (a :: k). a :~: a
Refl) (('(x, result) :~: '(y, result)) -> '(x, a) :~: '(y, b))
-> Maybe ('(x, result) :~: '(y, result))
-> Maybe ('(x, a) :~: '(y, b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> QueryIfCurrent xs x result
-> QueryIfCurrent xs y result
-> Maybe ('(x, result) :~: '(y, result))
forall k1 k2 (f :: k1 -> k2 -> *) (x :: k1) (a :: k2) (y :: k1)
       (b :: k2).
SameDepIndex2 f =>
f x a -> f y b -> Maybe ('(x, a) :~: '(y, b))
forall (x :: QueryFootprint) a (y :: QueryFootprint) b.
QueryIfCurrent xs x a
-> QueryIfCurrent xs y b -> Maybe ('(x, a) :~: '(y, b))
sameDepIndex2 QueryIfCurrent xs x result
qry QueryIfCurrent xs y result
qry'
  sameDepIndex2 (QueryIfCurrent {}) BlockQuery (HardForkBlock xs) y b
_ =
      Maybe ('(x, a) :~: '(y, b))
forall a. Maybe a
Nothing
  sameDepIndex2 (QueryAnytime QueryAnytime a
qry EraIndex (x : xs)
era) (QueryAnytime QueryAnytime b
qry' EraIndex (x : xs)
era')
    | EraIndex (x : xs)
era EraIndex (x : xs) -> EraIndex (x : xs) -> Bool
forall a. Eq a => a -> a -> Bool
== EraIndex (x : xs)
EraIndex (x : xs)
era'
    = (\a :~: b
Refl -> '(x, a) :~: '(x, a)
'(x, a) :~: '(y, b)
forall {k} (a :: k). a :~: a
Refl) ((a :~: b) -> '(x, a) :~: '(y, b))
-> Maybe (a :~: b) -> Maybe ('(x, a) :~: '(y, b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> QueryAnytime a -> QueryAnytime b -> Maybe (a :~: b)
forall a b. QueryAnytime a -> QueryAnytime b -> Maybe (a :~: b)
forall k (f :: k -> *) (a :: k) (b :: k).
SameDepIndex f =>
f a -> f b -> Maybe (a :~: b)
sameDepIndex QueryAnytime a
qry QueryAnytime b
qry'
    | Bool
otherwise
    = Maybe ('(x, a) :~: '(y, b))
forall a. Maybe a
Nothing
  sameDepIndex2(QueryAnytime {}) BlockQuery (HardForkBlock xs) y b
_ =
      Maybe ('(x, a) :~: '(y, b))
forall a. Maybe a
Nothing
  sameDepIndex2 (QueryHardFork QueryHardFork (x : xs) a
qry) (QueryHardFork QueryHardFork (x : xs) b
qry') =
      (\a :~: b
Refl -> '(x, a) :~: '(x, a)
'(x, a) :~: '(y, b)
forall {k} (a :: k). a :~: a
Refl) ((a :~: b) -> '(x, a) :~: '(y, b))
-> Maybe (a :~: b) -> Maybe ('(x, a) :~: '(y, b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> QueryHardFork (x : xs) a
-> QueryHardFork (x : xs) b -> Maybe (a :~: b)
forall a b.
QueryHardFork (x : xs) a
-> QueryHardFork (x : xs) b -> Maybe (a :~: b)
forall k (f :: k -> *) (a :: k) (b :: k).
SameDepIndex f =>
f a -> f b -> Maybe (a :~: b)
sameDepIndex QueryHardFork (x : xs) a
qry QueryHardFork (x : xs) b
QueryHardFork (x : xs) b
qry'
  sameDepIndex2 (QueryHardFork {}) BlockQuery (HardForkBlock xs) y b
_ =
      Maybe ('(x, a) :~: '(y, b))
forall a. Maybe a
Nothing

{-------------------------------------------------------------------------------
  Query Ledger
-------------------------------------------------------------------------------}

instance ( All SingleEraBlock xs
         , BlockSupportsHFLedgerQuery xs
         , All BlockSupportsLedgerQuery xs
         , CanHardFork xs
         )
      => BlockSupportsLedgerQuery (HardForkBlock xs) where
  answerPureBlockQuery :: forall result.
ExtLedgerCfg (HardForkBlock xs)
-> BlockQuery (HardForkBlock xs) 'QFNoTables result
-> ExtLedgerState (HardForkBlock xs) EmptyMK
-> result
answerPureBlockQuery
    (ExtLedgerCfg TopLevelConfig (HardForkBlock xs)
cfg)
    BlockQuery (HardForkBlock xs) 'QFNoTables result
query
    ext :: ExtLedgerState (HardForkBlock xs) EmptyMK
ext@(ExtLedgerState st :: LedgerState (HardForkBlock xs) EmptyMK
st@(HardForkLedgerState HardForkState (Flip LedgerState EmptyMK) xs
hardForkState) HeaderState (HardForkBlock xs)
_) =
      case BlockQuery (HardForkBlock xs) 'QFNoTables result
query of
        QueryIfCurrent QueryIfCurrent xs 'QFNoTables result
queryIfCurrent ->
          NP ExtLedgerCfg xs
-> QueryIfCurrent xs 'QFNoTables result
-> NS (Flip ExtLedgerState EmptyMK) xs
-> Either (MismatchEraInfo xs) result
forall result (xs :: [*]).
All SingleEraBlock xs =>
NP ExtLedgerCfg xs
-> QueryIfCurrent xs 'QFNoTables result
-> NS (Flip ExtLedgerState EmptyMK) xs
-> HardForkQueryResult xs result
interpretQueryIfCurrent
            NP ExtLedgerCfg xs
cfgs
            QueryIfCurrent xs 'QFNoTables result
queryIfCurrent
            (ExtLedgerState (HardForkBlock xs) EmptyMK
-> NS (Flip ExtLedgerState EmptyMK) xs
forall (xs :: [*]) (mk :: MapKind).
All SingleEraBlock xs =>
ExtLedgerState (HardForkBlock xs) mk
-> NS (Flip ExtLedgerState mk) xs
distribExtLedgerState ExtLedgerState (HardForkBlock xs) EmptyMK
ext)
        QueryAnytime QueryAnytime result
queryAnytime (EraIndex NS (K ()) (x : xs)
era) ->
          HardForkLedgerConfig (x : xs)
-> QueryAnytime result
-> EraIndex (x : xs)
-> HardForkState (Flip LedgerState EmptyMK) (x : xs)
-> result
forall result (xs :: [*]) (mk :: MapKind).
All SingleEraBlock xs =>
HardForkLedgerConfig xs
-> QueryAnytime result
-> EraIndex xs
-> HardForkState (Flip LedgerState mk) xs
-> result
interpretQueryAnytime
            LedgerConfig (HardForkBlock xs)
HardForkLedgerConfig (x : xs)
lcfg
            QueryAnytime result
queryAnytime
            (NS (K ()) (x : xs) -> EraIndex (x : xs)
forall (xs :: [*]). NS (K ()) xs -> EraIndex xs
EraIndex NS (K ()) (x : xs)
era)
            HardForkState (Flip LedgerState EmptyMK) xs
HardForkState (Flip LedgerState EmptyMK) (x : xs)
hardForkState
        QueryHardFork QueryHardFork (x : xs) result
queryHardFork ->
          HardForkLedgerConfig (x : xs)
-> QueryHardFork (x : xs) result
-> LedgerState (HardForkBlock (x : xs)) EmptyMK
-> result
forall (xs :: [*]) result (mk :: MapKind).
All SingleEraBlock xs =>
HardForkLedgerConfig xs
-> QueryHardFork xs result
-> LedgerState (HardForkBlock xs) mk
-> result
interpretQueryHardFork
            LedgerConfig (HardForkBlock xs)
HardForkLedgerConfig (x : xs)
lcfg
            QueryHardFork (x : xs) result
queryHardFork
            LedgerState (HardForkBlock xs) EmptyMK
LedgerState (HardForkBlock (x : xs)) EmptyMK
st
    where
      cfgs :: NP ExtLedgerCfg xs
cfgs = (forall a. TopLevelConfig a -> ExtLedgerCfg a)
-> NP TopLevelConfig xs -> NP ExtLedgerCfg xs
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 TopLevelConfig a -> ExtLedgerCfg a
forall a. TopLevelConfig a -> ExtLedgerCfg a
ExtLedgerCfg (NP TopLevelConfig xs -> NP ExtLedgerCfg xs)
-> NP TopLevelConfig xs -> NP ExtLedgerCfg xs
forall a b. (a -> b) -> a -> b
$ EpochInfo (Except PastHorizonException)
-> TopLevelConfig (HardForkBlock xs) -> NP TopLevelConfig xs
forall (xs :: [*]).
All SingleEraBlock xs =>
EpochInfo (Except PastHorizonException)
-> TopLevelConfig (HardForkBlock xs) -> NP TopLevelConfig xs
distribTopLevelConfig EpochInfo (Except PastHorizonException)
ei TopLevelConfig (HardForkBlock xs)
cfg
      lcfg :: LedgerConfig (HardForkBlock xs)
lcfg = TopLevelConfig (HardForkBlock xs)
-> LedgerConfig (HardForkBlock xs)
forall blk. TopLevelConfig blk -> LedgerConfig blk
configLedger TopLevelConfig (HardForkBlock xs)
cfg
      ei :: EpochInfo (Except PastHorizonException)
ei   = HardForkLedgerConfig xs
-> HardForkState (Flip LedgerState EmptyMK) xs
-> EpochInfo (Except PastHorizonException)
forall (xs :: [*]) (mk :: MapKind).
All SingleEraBlock xs =>
HardForkLedgerConfig xs
-> HardForkState (Flip LedgerState mk) xs
-> EpochInfo (Except PastHorizonException)
State.epochInfoLedger LedgerConfig (HardForkBlock xs)
HardForkLedgerConfig xs
lcfg HardForkState (Flip LedgerState EmptyMK) xs
hardForkState

  answerBlockQueryLookup :: forall (m :: * -> *) result.
MonadSTM m =>
ExtLedgerCfg (HardForkBlock xs)
-> BlockQuery (HardForkBlock xs) 'QFLookupTables result
-> ReadOnlyForker' m (HardForkBlock xs)
-> m result
answerBlockQueryLookup   ExtLedgerCfg (HardForkBlock xs)
cfg (QueryIfCurrent QueryIfCurrent xs 'QFLookupTables result
q) =
      (NP ExtLedgerCfg xs
 -> QueryIfCurrent xs 'QFLookupTables result
 -> ReadOnlyForker
      m (ExtLedgerState (HardForkBlock xs)) (HardForkBlock xs)
 -> m (Either (MismatchEraInfo xs) result))
-> ExtLedgerCfg (HardForkBlock xs)
-> QueryIfCurrent xs 'QFLookupTables result
-> ReadOnlyForker
     m (ExtLedgerState (HardForkBlock xs)) (HardForkBlock xs)
-> m (Either (MismatchEraInfo xs) result)
forall (m :: * -> *) (xs :: [*]) (footprint :: QueryFootprint)
       result.
(MonadSTM m, BlockSupportsHFLedgerQuery xs, CanHardFork xs) =>
(NP ExtLedgerCfg xs
 -> QueryIfCurrent xs footprint result
 -> ReadOnlyForker' m (HardForkBlock xs)
 -> m (HardForkQueryResult xs result))
-> ExtLedgerCfg (HardForkBlock xs)
-> QueryIfCurrent xs footprint result
-> ReadOnlyForker' m (HardForkBlock xs)
-> m (HardForkQueryResult xs result)
answerBlockQueryHelper NP ExtLedgerCfg xs
-> QueryIfCurrent xs 'QFLookupTables result
-> ReadOnlyForker
     m (ExtLedgerState (HardForkBlock xs)) (HardForkBlock xs)
-> m (Either (MismatchEraInfo xs) result)
forall result (xs :: [*]) (m :: * -> *).
(MonadSTM m, BlockSupportsHFLedgerQuery xs, CanHardFork xs) =>
NP ExtLedgerCfg xs
-> QueryIfCurrent xs 'QFLookupTables result
-> ReadOnlyForker' m (HardForkBlock xs)
-> m (HardForkQueryResult xs result)
interpretQueryIfCurrentLookup   ExtLedgerCfg (HardForkBlock xs)
cfg QueryIfCurrent xs 'QFLookupTables result
q
  answerBlockQueryTraverse :: forall (m :: * -> *) result.
MonadSTM m =>
ExtLedgerCfg (HardForkBlock xs)
-> BlockQuery (HardForkBlock xs) 'QFTraverseTables result
-> ReadOnlyForker' m (HardForkBlock xs)
-> m result
answerBlockQueryTraverse ExtLedgerCfg (HardForkBlock xs)
cfg (QueryIfCurrent QueryIfCurrent xs 'QFTraverseTables result
q) =
      (NP ExtLedgerCfg xs
 -> QueryIfCurrent xs 'QFTraverseTables result
 -> ReadOnlyForker
      m (ExtLedgerState (HardForkBlock xs)) (HardForkBlock xs)
 -> m (Either (MismatchEraInfo xs) result))
-> ExtLedgerCfg (HardForkBlock xs)
-> QueryIfCurrent xs 'QFTraverseTables result
-> ReadOnlyForker
     m (ExtLedgerState (HardForkBlock xs)) (HardForkBlock xs)
-> m (Either (MismatchEraInfo xs) result)
forall (m :: * -> *) (xs :: [*]) (footprint :: QueryFootprint)
       result.
(MonadSTM m, BlockSupportsHFLedgerQuery xs, CanHardFork xs) =>
(NP ExtLedgerCfg xs
 -> QueryIfCurrent xs footprint result
 -> ReadOnlyForker' m (HardForkBlock xs)
 -> m (HardForkQueryResult xs result))
-> ExtLedgerCfg (HardForkBlock xs)
-> QueryIfCurrent xs footprint result
-> ReadOnlyForker' m (HardForkBlock xs)
-> m (HardForkQueryResult xs result)
answerBlockQueryHelper NP ExtLedgerCfg xs
-> QueryIfCurrent xs 'QFTraverseTables result
-> ReadOnlyForker
     m (ExtLedgerState (HardForkBlock xs)) (HardForkBlock xs)
-> m (Either (MismatchEraInfo xs) result)
forall result (xs :: [*]) (m :: * -> *).
(MonadSTM m, BlockSupportsHFLedgerQuery xs, CanHardFork xs) =>
NP ExtLedgerCfg xs
-> QueryIfCurrent xs 'QFTraverseTables result
-> ReadOnlyForker' m (HardForkBlock xs)
-> m (HardForkQueryResult xs result)
interpretQueryIfCurrentTraverse ExtLedgerCfg (HardForkBlock xs)
cfg QueryIfCurrent xs 'QFTraverseTables result
q

  blockQueryIsSupportedOnVersion :: forall (fp :: QueryFootprint) result.
BlockQuery (HardForkBlock xs) fp result
-> BlockNodeToClientVersion (HardForkBlock xs) -> Bool
blockQueryIsSupportedOnVersion BlockQuery (HardForkBlock xs) fp result
q (HardForkNodeToClientDisabled BlockNodeToClientVersion x
x) = case BlockQuery (HardForkBlock xs) fp result
q of
    QueryIfCurrent (QZ BlockQuery x fp result
q') -> BlockQuery x fp result -> BlockNodeToClientVersion x -> Bool
forall blk (fp :: QueryFootprint) result.
BlockSupportsLedgerQuery blk =>
BlockQuery blk fp result -> BlockNodeToClientVersion blk -> Bool
forall (fp :: QueryFootprint) result.
BlockQuery x fp result -> BlockNodeToClientVersion x -> Bool
blockQueryIsSupportedOnVersion BlockQuery x fp result
q' BlockNodeToClientVersion x
BlockNodeToClientVersion x
x
    QueryIfCurrent{}       -> Bool
False
    QueryAnytime{}         -> Bool
False
    QueryHardFork {}       -> Bool
False
  blockQueryIsSupportedOnVersion BlockQuery (HardForkBlock xs) fp result
q (HardForkNodeToClientEnabled HardForkSpecificNodeToClientVersion
_hfv NP EraNodeToClientVersion xs
npversions) = case BlockQuery (HardForkBlock xs) fp result
q of
    QueryIfCurrent QueryIfCurrent xs fp result
qc -> QueryIfCurrent xs fp result -> NP EraNodeToClientVersion xs -> Bool
forall (ys :: [*]) (fp :: QueryFootprint) result.
All BlockSupportsLedgerQuery ys =>
QueryIfCurrent ys fp result -> NP EraNodeToClientVersion ys -> Bool
go QueryIfCurrent xs fp result
qc NP EraNodeToClientVersion xs
npversions
    QueryAnytime{}    -> Bool
True
    QueryHardFork{}   -> Bool
True
   where
     go :: forall ys fp result. All BlockSupportsLedgerQuery ys => QueryIfCurrent ys fp result -> NP EraNodeToClientVersion ys -> Bool
     go :: forall (ys :: [*]) (fp :: QueryFootprint) result.
All BlockSupportsLedgerQuery ys =>
QueryIfCurrent ys fp result -> NP EraNodeToClientVersion ys -> Bool
go (QZ BlockQuery x fp result
_) (EraNodeToClientVersion x
EraNodeToClientDisabled :* NP EraNodeToClientVersion xs1
_) = Bool
False
     go (QZ BlockQuery x fp result
x) (EraNodeToClientEnabled BlockNodeToClientVersion x
v :* NP EraNodeToClientVersion xs1
_) = BlockQuery x fp result -> BlockNodeToClientVersion x -> Bool
forall blk (fp :: QueryFootprint) result.
BlockSupportsLedgerQuery blk =>
BlockQuery blk fp result -> BlockNodeToClientVersion blk -> Bool
forall (fp :: QueryFootprint) result.
BlockQuery x fp result -> BlockNodeToClientVersion x -> Bool
blockQueryIsSupportedOnVersion BlockQuery x fp result
x BlockNodeToClientVersion x
BlockNodeToClientVersion x
v
     go (QS QueryIfCurrent xs fp result
x) (EraNodeToClientVersion x
_ :* NP EraNodeToClientVersion xs1
n) = QueryIfCurrent xs fp result -> NP EraNodeToClientVersion xs -> Bool
forall (ys :: [*]) (fp :: QueryFootprint) result.
All BlockSupportsLedgerQuery ys =>
QueryIfCurrent ys fp result -> NP EraNodeToClientVersion ys -> Bool
go QueryIfCurrent xs fp result
x NP EraNodeToClientVersion xs
NP EraNodeToClientVersion xs1
n

-- | NOT EXPORTED, for footprints other than 'QFNoTables'
answerBlockQueryHelper ::
       (MonadSTM m, BlockSupportsHFLedgerQuery xs, CanHardFork xs)
    => (   NP ExtLedgerCfg xs
        -> QueryIfCurrent xs footprint result
        -> ReadOnlyForker' m (HardForkBlock xs)
        -> m (HardForkQueryResult xs result)
       )
    -> ExtLedgerCfg (HardForkBlock xs)
    -> QueryIfCurrent xs footprint result
    -> ReadOnlyForker' m (HardForkBlock xs)
    -> m (HardForkQueryResult xs result)
answerBlockQueryHelper :: forall (m :: * -> *) (xs :: [*]) (footprint :: QueryFootprint)
       result.
(MonadSTM m, BlockSupportsHFLedgerQuery xs, CanHardFork xs) =>
(NP ExtLedgerCfg xs
 -> QueryIfCurrent xs footprint result
 -> ReadOnlyForker' m (HardForkBlock xs)
 -> m (HardForkQueryResult xs result))
-> ExtLedgerCfg (HardForkBlock xs)
-> QueryIfCurrent xs footprint result
-> ReadOnlyForker' m (HardForkBlock xs)
-> m (HardForkQueryResult xs result)
answerBlockQueryHelper
  NP ExtLedgerCfg xs
-> QueryIfCurrent xs footprint result
-> ReadOnlyForker' m (HardForkBlock xs)
-> m (HardForkQueryResult xs result)
f
  (ExtLedgerCfg TopLevelConfig (HardForkBlock xs)
cfg)
  QueryIfCurrent xs footprint result
qry
  ReadOnlyForker' m (HardForkBlock xs)
forker = do
    hardForkState <- LedgerState (HardForkBlock xs) EmptyMK
-> HardForkState (Flip LedgerState EmptyMK) xs
forall (xs :: [*]) (mk :: MapKind).
LedgerState (HardForkBlock xs) mk
-> HardForkState (Flip LedgerState mk) xs
hardForkLedgerStatePerEra (LedgerState (HardForkBlock xs) EmptyMK
 -> HardForkState (Flip LedgerState EmptyMK) xs)
-> (ExtLedgerState (HardForkBlock xs) EmptyMK
    -> LedgerState (HardForkBlock xs) EmptyMK)
-> ExtLedgerState (HardForkBlock xs) EmptyMK
-> HardForkState (Flip LedgerState EmptyMK) xs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExtLedgerState (HardForkBlock xs) EmptyMK
-> LedgerState (HardForkBlock xs) EmptyMK
forall blk (mk :: MapKind).
ExtLedgerState blk mk -> LedgerState blk mk
ledgerState (ExtLedgerState (HardForkBlock xs) EmptyMK
 -> HardForkState (Flip LedgerState EmptyMK) xs)
-> m (ExtLedgerState (HardForkBlock xs) EmptyMK)
-> m (HardForkState (Flip LedgerState EmptyMK) xs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> STM m (ExtLedgerState (HardForkBlock xs) EmptyMK)
-> m (ExtLedgerState (HardForkBlock xs) EmptyMK)
forall a. HasCallStack => STM m a -> m a
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (ReadOnlyForker' m (HardForkBlock xs)
-> STM m (ExtLedgerState (HardForkBlock xs) EmptyMK)
forall (m :: * -> *) (l :: LedgerStateKind) blk.
ReadOnlyForker m l blk -> STM m (l EmptyMK)
roforkerGetLedgerState ReadOnlyForker' m (HardForkBlock xs)
forker)
    let ei   = HardForkLedgerConfig xs
-> HardForkState (Flip LedgerState EmptyMK) xs
-> EpochInfo (Except PastHorizonException)
forall (xs :: [*]) (mk :: MapKind).
All SingleEraBlock xs =>
HardForkLedgerConfig xs
-> HardForkState (Flip LedgerState mk) xs
-> EpochInfo (Except PastHorizonException)
State.epochInfoLedger LedgerConfig (HardForkBlock xs)
HardForkLedgerConfig xs
lcfg HardForkState (Flip LedgerState EmptyMK) xs
hardForkState
        cfgs = (forall a. TopLevelConfig a -> ExtLedgerCfg a)
-> NP TopLevelConfig xs -> NP ExtLedgerCfg xs
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 TopLevelConfig a -> ExtLedgerCfg a
forall a. TopLevelConfig a -> ExtLedgerCfg a
ExtLedgerCfg (NP TopLevelConfig xs -> NP ExtLedgerCfg xs)
-> NP TopLevelConfig xs -> NP ExtLedgerCfg xs
forall a b. (a -> b) -> a -> b
$ EpochInfo (Except PastHorizonException)
-> TopLevelConfig (HardForkBlock xs) -> NP TopLevelConfig xs
forall (xs :: [*]).
All SingleEraBlock xs =>
EpochInfo (Except PastHorizonException)
-> TopLevelConfig (HardForkBlock xs) -> NP TopLevelConfig xs
distribTopLevelConfig EpochInfo (Except PastHorizonException)
ei TopLevelConfig (HardForkBlock xs)
cfg
    f cfgs qry forker
  where
    lcfg :: LedgerConfig (HardForkBlock xs)
lcfg = TopLevelConfig (HardForkBlock xs)
-> LedgerConfig (HardForkBlock xs)
forall blk. TopLevelConfig blk -> LedgerConfig blk
configLedger TopLevelConfig (HardForkBlock xs)
cfg

-- | Precondition: the 'ledgerState' and 'headerState' should be from the same
-- era. In practice, this is _always_ the case, unless the 'ExtLedgerState' was
-- manually crafted.
distribExtLedgerState ::
     All SingleEraBlock xs
  => ExtLedgerState (HardForkBlock xs) mk -> NS (Flip ExtLedgerState mk) xs
distribExtLedgerState :: forall (xs :: [*]) (mk :: MapKind).
All SingleEraBlock xs =>
ExtLedgerState (HardForkBlock xs) mk
-> NS (Flip ExtLedgerState mk) xs
distribExtLedgerState (ExtLedgerState LedgerState (HardForkBlock xs) mk
ledgerState HeaderState (HardForkBlock xs)
headerState) =
    (forall a.
 Product HeaderState (Flip LedgerState mk) a
 -> Flip ExtLedgerState mk a)
-> NS (Product HeaderState (Flip LedgerState mk)) xs
-> NS (Flip ExtLedgerState mk) xs
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 (\(Pair HeaderState a
hst Flip LedgerState mk a
lst) -> ExtLedgerState a mk -> Flip ExtLedgerState mk a
forall x y (f :: x -> y -> *) (x1 :: y) (y1 :: x).
f y1 x1 -> Flip f x1 y1
Flip (ExtLedgerState a mk -> Flip ExtLedgerState mk a)
-> ExtLedgerState a mk -> Flip ExtLedgerState mk a
forall a b. (a -> b) -> a -> b
$ LedgerState a mk -> HeaderState a -> ExtLedgerState a mk
forall blk (mk :: MapKind).
LedgerState blk mk -> HeaderState blk -> ExtLedgerState blk mk
ExtLedgerState (Flip LedgerState mk a -> LedgerState a mk
forall x1 y1 (f :: x1 -> y1 -> *) (x2 :: y1) (y2 :: x1).
Flip f x2 y2 -> f y2 x2
unFlip Flip LedgerState mk a
lst) HeaderState a
hst) (NS (Product HeaderState (Flip LedgerState mk)) xs
 -> NS (Flip ExtLedgerState mk) xs)
-> NS (Product HeaderState (Flip LedgerState mk)) xs
-> NS (Flip ExtLedgerState mk) xs
forall a b. (a -> b) -> a -> b
$
      String
-> NS HeaderState xs
-> NS (Flip LedgerState mk) xs
-> NS (Product HeaderState (Flip LedgerState mk)) xs
forall {k} (f :: k -> *) (g :: k -> *) (xs :: [k]).
HasCallStack =>
String -> NS f xs -> NS g xs -> NS (Product f g) xs
mustMatchNS
        String
"HeaderState"
        (HeaderState (HardForkBlock xs) -> NS HeaderState xs
forall (xs :: [*]).
All SingleEraBlock xs =>
HeaderState (HardForkBlock xs) -> NS HeaderState xs
distribHeaderState HeaderState (HardForkBlock xs)
headerState)
        (HardForkState (Flip LedgerState mk) xs
-> NS (Flip LedgerState mk) xs
forall (xs :: [*]) (f :: * -> *).
SListI xs =>
HardForkState f xs -> NS f xs
State.tip (LedgerState (HardForkBlock xs) mk
-> HardForkState (Flip LedgerState mk) xs
forall (xs :: [*]) (mk :: MapKind).
LedgerState (HardForkBlock xs) mk
-> HardForkState (Flip LedgerState mk) xs
hardForkLedgerStatePerEra LedgerState (HardForkBlock xs) mk
ledgerState))

-- | Precondition: the 'headerStateTip' and 'headerStateChainDep' should be from
-- the same era. In practice, this is _always_ the case, unless the
-- 'HeaderState' was manually crafted.
distribHeaderState ::
     All SingleEraBlock xs
  => HeaderState (HardForkBlock xs) -> NS HeaderState xs
distribHeaderState :: forall (xs :: [*]).
All SingleEraBlock xs =>
HeaderState (HardForkBlock xs) -> NS HeaderState xs
distribHeaderState (HeaderState WithOrigin (AnnTip (HardForkBlock xs))
tip ChainDepState (BlockProtocol (HardForkBlock xs))
chainDepState) =
    case WithOrigin (AnnTip (HardForkBlock xs))
tip of
      WithOrigin (AnnTip (HardForkBlock xs))
Origin ->
        (forall a. WrapChainDepState a -> HeaderState a)
-> NS WrapChainDepState xs -> NS HeaderState xs
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 (WithOrigin (AnnTip a)
-> ChainDepState (BlockProtocol a) -> HeaderState a
forall blk.
WithOrigin (AnnTip blk)
-> ChainDepState (BlockProtocol blk) -> HeaderState blk
HeaderState WithOrigin (AnnTip a)
forall t. WithOrigin t
Origin (ChainDepState (BlockProtocol a) -> HeaderState a)
-> (WrapChainDepState a -> ChainDepState (BlockProtocol a))
-> WrapChainDepState a
-> HeaderState a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WrapChainDepState a -> ChainDepState (BlockProtocol a)
forall blk.
WrapChainDepState blk -> ChainDepState (BlockProtocol blk)
unwrapChainDepState) (HardForkState WrapChainDepState xs -> NS WrapChainDepState xs
forall (xs :: [*]) (f :: * -> *).
SListI xs =>
HardForkState f xs -> NS f xs
State.tip ChainDepState (BlockProtocol (HardForkBlock xs))
HardForkState WrapChainDepState xs
chainDepState)
      NotOrigin AnnTip (HardForkBlock xs)
annTip ->
        (forall a. Product AnnTip WrapChainDepState a -> HeaderState a)
-> NS (Product AnnTip WrapChainDepState) xs -> NS HeaderState xs
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
          (\(Pair AnnTip a
t WrapChainDepState a
cds) -> WithOrigin (AnnTip a)
-> ChainDepState (BlockProtocol a) -> HeaderState a
forall blk.
WithOrigin (AnnTip blk)
-> ChainDepState (BlockProtocol blk) -> HeaderState blk
HeaderState (AnnTip a -> WithOrigin (AnnTip a)
forall t. t -> WithOrigin t
NotOrigin AnnTip a
t) (WrapChainDepState a -> ChainDepState (BlockProtocol a)
forall blk.
WrapChainDepState blk -> ChainDepState (BlockProtocol blk)
unwrapChainDepState WrapChainDepState a
cds))
          (String
-> NS AnnTip xs
-> NS WrapChainDepState xs
-> NS (Product AnnTip WrapChainDepState) xs
forall {k} (f :: k -> *) (g :: k -> *) (xs :: [k]).
HasCallStack =>
String -> NS f xs -> NS g xs -> NS (Product f g) xs
mustMatchNS String
"AnnTip" (AnnTip (HardForkBlock xs) -> NS AnnTip xs
forall (xs :: [*]).
SListI xs =>
AnnTip (HardForkBlock xs) -> NS AnnTip xs
distribAnnTip AnnTip (HardForkBlock xs)
annTip) (HardForkState WrapChainDepState xs -> NS WrapChainDepState xs
forall (xs :: [*]) (f :: * -> *).
SListI xs =>
HardForkState f xs -> NS f xs
State.tip ChainDepState (BlockProtocol (HardForkBlock xs))
HardForkState WrapChainDepState xs
chainDepState))

getHardForkQuery :: BlockQuery (HardForkBlock xs) footprint result
                 -> (forall result'.
                          result :~: HardForkQueryResult xs result'
                       -> QueryIfCurrent xs footprint result'
                       -> r)
                 -> (forall x' xs'.
                          xs :~: x' ': xs'
                       -> ProofNonEmpty xs'
                       -> QueryAnytime result
                       -> EraIndex xs
                       -> r)
                 -> (forall x' xs'.
                          xs :~: x' ': xs'
                       -> ProofNonEmpty xs'
                       -> QueryHardFork xs result
                       -> r)
                 -> r
getHardForkQuery :: forall (xs :: [*]) (footprint :: QueryFootprint) result r.
BlockQuery (HardForkBlock xs) footprint result
-> (forall result'.
    (result :~: HardForkQueryResult xs result')
    -> QueryIfCurrent xs footprint result' -> r)
-> (forall x' (xs' :: [*]).
    (xs :~: (x' : xs'))
    -> ProofNonEmpty xs' -> QueryAnytime result -> EraIndex xs -> r)
-> (forall x' (xs' :: [*]).
    (xs :~: (x' : xs'))
    -> ProofNonEmpty xs' -> QueryHardFork xs result -> r)
-> r
getHardForkQuery BlockQuery (HardForkBlock xs) footprint result
q forall result'.
(result :~: HardForkQueryResult xs result')
-> QueryIfCurrent xs footprint result' -> r
k1 forall x' (xs' :: [*]).
(xs :~: (x' : xs'))
-> ProofNonEmpty xs' -> QueryAnytime result -> EraIndex xs -> r
k2 forall x' (xs' :: [*]).
(xs :~: (x' : xs'))
-> ProofNonEmpty xs' -> QueryHardFork xs result -> r
k3 = case BlockQuery (HardForkBlock xs) footprint result
q of
    QueryIfCurrent QueryIfCurrent xs footprint result
qry   -> (result :~: Either (MismatchEraInfo xs) result)
-> QueryIfCurrent xs footprint result -> r
forall result'.
(result :~: HardForkQueryResult xs result')
-> QueryIfCurrent xs footprint result' -> r
k1 result :~: result
result :~: Either (MismatchEraInfo xs) result
forall {k} (a :: k). a :~: a
Refl QueryIfCurrent xs footprint result
qry
    QueryAnytime QueryAnytime result
qry EraIndex (x : xs)
era -> (xs :~: (x : xs))
-> ProofNonEmpty xs -> QueryAnytime result -> EraIndex xs -> r
forall x' (xs' :: [*]).
(xs :~: (x' : xs'))
-> ProofNonEmpty xs' -> QueryAnytime result -> EraIndex xs -> r
k2 xs :~: xs
xs :~: (x : xs)
forall {k} (a :: k). a :~: a
Refl (Proxy xs -> ProofNonEmpty xs
forall {a} (xs :: [a]) (proxy :: [a] -> *).
IsNonEmpty xs =>
proxy xs -> ProofNonEmpty xs
forall (proxy :: [*] -> *). proxy xs -> ProofNonEmpty xs
isNonEmpty Proxy xs
forall {k} (t :: k). Proxy t
Proxy) QueryAnytime result
qry EraIndex xs
EraIndex (x : xs)
era
    QueryHardFork QueryHardFork (x : xs) result
qry    -> (xs :~: (x : xs))
-> ProofNonEmpty xs -> QueryHardFork xs result -> r
forall x' (xs' :: [*]).
(xs :~: (x' : xs'))
-> ProofNonEmpty xs' -> QueryHardFork xs result -> r
k3 xs :~: xs
xs :~: (x : xs)
forall {k} (a :: k). a :~: a
Refl (Proxy xs -> ProofNonEmpty xs
forall {a} (xs :: [a]) (proxy :: [a] -> *).
IsNonEmpty xs =>
proxy xs -> ProofNonEmpty xs
forall (proxy :: [*] -> *). proxy xs -> ProofNonEmpty xs
isNonEmpty Proxy xs
forall {k} (t :: k). Proxy t
Proxy) QueryHardFork xs result
QueryHardFork (x : xs) result
qry

{-------------------------------------------------------------------------------
  Current era queries
-------------------------------------------------------------------------------}

type QueryIfCurrent :: [Type] -> QueryFootprint -> Type -> Type
data QueryIfCurrent xs footprint result where
  QZ :: BlockQuery     x  footprint result -> QueryIfCurrent (x ': xs) footprint result
  QS :: QueryIfCurrent xs footprint result -> QueryIfCurrent (x ': xs) footprint result

deriving instance All SingleEraBlock xs => Show (QueryIfCurrent xs footprint result)

instance All SingleEraBlock xs => ShowQuery (QueryIfCurrent xs footprint) where
  showResult :: forall result.
QueryIfCurrent xs footprint result -> result -> String
showResult (QZ BlockQuery x footprint result
qry) = BlockQuery x footprint result -> result -> String
forall result. BlockQuery x footprint result -> result -> String
forall (query :: * -> *) result.
ShowQuery query =>
query result -> result -> String
showResult BlockQuery x footprint result
qry
  showResult (QS QueryIfCurrent xs footprint result
qry) = QueryIfCurrent xs footprint result -> result -> String
forall result.
QueryIfCurrent xs footprint result -> result -> String
forall (query :: * -> *) result.
ShowQuery query =>
query result -> result -> String
showResult QueryIfCurrent xs footprint result
qry

instance All SingleEraBlock xs => SameDepIndex2 (QueryIfCurrent xs) where
  sameDepIndex2 :: forall (x :: QueryFootprint) a (y :: QueryFootprint) b.
QueryIfCurrent xs x a
-> QueryIfCurrent xs y b -> Maybe ('(x, a) :~: '(y, b))
sameDepIndex2 (QZ BlockQuery x x a
qry) (QZ BlockQuery x y b
qry') = BlockQuery x x a -> BlockQuery x y b -> Maybe ('(x, a) :~: '(y, b))
forall k1 k2 (f :: k1 -> k2 -> *) (x :: k1) (a :: k2) (y :: k1)
       (b :: k2).
SameDepIndex2 f =>
f x a -> f y b -> Maybe ('(x, a) :~: '(y, b))
forall (x :: QueryFootprint) a (y :: QueryFootprint) b.
BlockQuery x x a -> BlockQuery x y b -> Maybe ('(x, a) :~: '(y, b))
sameDepIndex2 BlockQuery x x a
qry BlockQuery x y b
BlockQuery x y b
qry'
  sameDepIndex2 (QS QueryIfCurrent xs x a
qry) (QS QueryIfCurrent xs y b
qry') = QueryIfCurrent xs x a
-> QueryIfCurrent xs y b -> Maybe ('(x, a) :~: '(y, b))
forall k1 k2 (f :: k1 -> k2 -> *) (x :: k1) (a :: k2) (y :: k1)
       (b :: k2).
SameDepIndex2 f =>
f x a -> f y b -> Maybe ('(x, a) :~: '(y, b))
forall (x :: QueryFootprint) a (y :: QueryFootprint) b.
QueryIfCurrent xs x a
-> QueryIfCurrent xs y b -> Maybe ('(x, a) :~: '(y, b))
sameDepIndex2 QueryIfCurrent xs x a
qry QueryIfCurrent xs y b
QueryIfCurrent xs y b
qry'
  sameDepIndex2 QueryIfCurrent xs x a
_        QueryIfCurrent xs y b
_         = Maybe ('(x, a) :~: '(y, b))
forall a. Maybe a
Nothing

interpretQueryIfCurrent ::
     forall result xs. All SingleEraBlock xs
  => NP ExtLedgerCfg xs
  -> QueryIfCurrent xs QFNoTables result
  -> NS (Flip ExtLedgerState EmptyMK) xs
  -> HardForkQueryResult xs result
interpretQueryIfCurrent :: forall result (xs :: [*]).
All SingleEraBlock xs =>
NP ExtLedgerCfg xs
-> QueryIfCurrent xs 'QFNoTables result
-> NS (Flip ExtLedgerState EmptyMK) xs
-> HardForkQueryResult xs result
interpretQueryIfCurrent = NP ExtLedgerCfg xs
-> QueryIfCurrent xs 'QFNoTables result
-> NS (Flip ExtLedgerState EmptyMK) xs
-> HardForkQueryResult xs result
forall (xs' :: [*]).
All SingleEraBlock xs' =>
NP ExtLedgerCfg xs'
-> QueryIfCurrent xs' 'QFNoTables result
-> NS (Flip ExtLedgerState EmptyMK) xs'
-> HardForkQueryResult xs' result
go
  where
    go :: All SingleEraBlock xs'
       => NP ExtLedgerCfg xs'
       -> QueryIfCurrent xs' QFNoTables result
       -> NS (Flip ExtLedgerState EmptyMK) xs'
       -> HardForkQueryResult xs' result
    go :: forall (xs' :: [*]).
All SingleEraBlock xs' =>
NP ExtLedgerCfg xs'
-> QueryIfCurrent xs' 'QFNoTables result
-> NS (Flip ExtLedgerState EmptyMK) xs'
-> HardForkQueryResult xs' result
go (ExtLedgerCfg x
c :* NP ExtLedgerCfg xs1
_)  (QZ BlockQuery x 'QFNoTables result
qry) (Z (Flip ExtLedgerState x EmptyMK
st)) =
        result -> Either (MismatchEraInfo xs') result
forall a b. b -> Either a b
Right (result -> Either (MismatchEraInfo xs') result)
-> result -> Either (MismatchEraInfo xs') result
forall a b. (a -> b) -> a -> b
$ ExtLedgerCfg x
-> BlockQuery x 'QFNoTables result
-> ExtLedgerState x EmptyMK
-> result
forall result.
ExtLedgerCfg x
-> BlockQuery x 'QFNoTables result
-> ExtLedgerState x EmptyMK
-> result
forall blk result.
BlockSupportsLedgerQuery blk =>
ExtLedgerCfg blk
-> BlockQuery blk 'QFNoTables result
-> ExtLedgerState blk EmptyMK
-> result
answerPureBlockQuery ExtLedgerCfg x
c BlockQuery x 'QFNoTables result
BlockQuery x 'QFNoTables result
qry ExtLedgerState x EmptyMK
ExtLedgerState x EmptyMK
st
    go (ExtLedgerCfg x
_ :* NP ExtLedgerCfg xs1
cs) (QS QueryIfCurrent xs 'QFNoTables result
qry) (S NS (Flip ExtLedgerState EmptyMK) xs1
st) =
        (MismatchEraInfo xs1 -> MismatchEraInfo xs')
-> Either (MismatchEraInfo xs1) result
-> Either (MismatchEraInfo xs') result
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: MapKind) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first MismatchEraInfo xs1 -> MismatchEraInfo xs'
MismatchEraInfo xs1 -> MismatchEraInfo (x : xs1)
forall (xs :: [*]) x.
MismatchEraInfo xs -> MismatchEraInfo (x : xs)
shiftMismatch (Either (MismatchEraInfo xs1) result
 -> Either (MismatchEraInfo xs') result)
-> Either (MismatchEraInfo xs1) result
-> Either (MismatchEraInfo xs') result
forall a b. (a -> b) -> a -> b
$ NP ExtLedgerCfg xs1
-> QueryIfCurrent xs1 'QFNoTables result
-> NS (Flip ExtLedgerState EmptyMK) xs1
-> Either (MismatchEraInfo xs1) result
forall (xs' :: [*]).
All SingleEraBlock xs' =>
NP ExtLedgerCfg xs'
-> QueryIfCurrent xs' 'QFNoTables result
-> NS (Flip ExtLedgerState EmptyMK) xs'
-> HardForkQueryResult xs' result
go NP ExtLedgerCfg xs1
cs QueryIfCurrent xs1 'QFNoTables result
QueryIfCurrent xs 'QFNoTables result
qry NS (Flip ExtLedgerState EmptyMK) xs1
NS (Flip ExtLedgerState EmptyMK) xs1
st
    go NP ExtLedgerCfg xs'
_         (QZ BlockQuery x 'QFNoTables result
qry) (S NS (Flip ExtLedgerState EmptyMK) xs1
st) =
        MismatchEraInfo xs' -> Either (MismatchEraInfo xs') result
forall a b. a -> Either a b
Left (MismatchEraInfo xs' -> Either (MismatchEraInfo xs') result)
-> MismatchEraInfo xs' -> Either (MismatchEraInfo xs') result
forall a b. (a -> b) -> a -> b
$ Mismatch SingleEraInfo LedgerEraInfo xs' -> MismatchEraInfo xs'
forall (xs :: [*]).
Mismatch SingleEraInfo LedgerEraInfo xs -> MismatchEraInfo xs
MismatchEraInfo (Mismatch SingleEraInfo LedgerEraInfo xs' -> MismatchEraInfo xs')
-> Mismatch SingleEraInfo LedgerEraInfo xs' -> MismatchEraInfo xs'
forall a b. (a -> b) -> a -> b
$ SingleEraInfo x
-> NS LedgerEraInfo xs1
-> Mismatch SingleEraInfo LedgerEraInfo (x : xs1)
forall {k} (f :: k -> *) (x :: k) (g :: k -> *) (xs1 :: [k]).
f x -> NS g xs1 -> Mismatch f g (x : xs1)
ML (BlockQuery x 'QFNoTables result -> SingleEraInfo x
forall blk (query :: * -> QueryFootprint -> * -> *)
       (footprint :: QueryFootprint) result.
SingleEraBlock blk =>
query blk footprint result -> SingleEraInfo blk
queryInfo BlockQuery x 'QFNoTables result
qry) (Proxy SingleEraBlock
-> (forall a.
    SingleEraBlock a =>
    Flip ExtLedgerState EmptyMK a -> LedgerEraInfo a)
-> NS (Flip ExtLedgerState EmptyMK) xs1
-> NS LedgerEraInfo xs1
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 (ExtLedgerState a EmptyMK -> LedgerEraInfo a
forall blk (mk :: MapKind).
SingleEraBlock blk =>
ExtLedgerState blk mk -> LedgerEraInfo blk
ledgerInfo (ExtLedgerState a EmptyMK -> LedgerEraInfo a)
-> (Flip ExtLedgerState EmptyMK a -> ExtLedgerState a EmptyMK)
-> Flip ExtLedgerState EmptyMK a
-> LedgerEraInfo a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Flip ExtLedgerState EmptyMK a -> ExtLedgerState a EmptyMK
forall x1 y1 (f :: x1 -> y1 -> *) (x2 :: y1) (y2 :: x1).
Flip f x2 y2 -> f y2 x2
unFlip) NS (Flip ExtLedgerState EmptyMK) xs1
st)
    go NP ExtLedgerCfg xs'
_         (QS QueryIfCurrent xs 'QFNoTables result
qry) (Z (Flip ExtLedgerState x EmptyMK
st)) =
        MismatchEraInfo xs' -> Either (MismatchEraInfo xs') result
forall a b. a -> Either a b
Left (MismatchEraInfo xs' -> Either (MismatchEraInfo xs') result)
-> MismatchEraInfo xs' -> Either (MismatchEraInfo xs') result
forall a b. (a -> b) -> a -> b
$ Mismatch SingleEraInfo LedgerEraInfo xs' -> MismatchEraInfo xs'
forall (xs :: [*]).
Mismatch SingleEraInfo LedgerEraInfo xs -> MismatchEraInfo xs
MismatchEraInfo (Mismatch SingleEraInfo LedgerEraInfo xs' -> MismatchEraInfo xs')
-> Mismatch SingleEraInfo LedgerEraInfo xs' -> MismatchEraInfo xs'
forall a b. (a -> b) -> a -> b
$ NS SingleEraInfo xs
-> LedgerEraInfo x -> Mismatch SingleEraInfo LedgerEraInfo (x : xs)
forall {k} (f :: k -> *) (xs1 :: [k]) (g :: k -> *) (x :: k).
NS f xs1 -> g x -> Mismatch f g (x : xs1)
MR (QueryIfCurrent xs 'QFNoTables result -> NS SingleEraInfo xs
forall (xs :: [*]) (footprint :: QueryFootprint) result.
All SingleEraBlock xs =>
QueryIfCurrent xs footprint result -> NS SingleEraInfo xs
hardForkQueryInfo QueryIfCurrent xs 'QFNoTables result
qry) (ExtLedgerState x EmptyMK -> LedgerEraInfo x
forall blk (mk :: MapKind).
SingleEraBlock blk =>
ExtLedgerState blk mk -> LedgerEraInfo blk
ledgerInfo ExtLedgerState x EmptyMK
st)

interpretQueryIfCurrentLookup ::
     forall result xs m. (MonadSTM m, BlockSupportsHFLedgerQuery xs, CanHardFork xs)
  => NP ExtLedgerCfg xs
  -> QueryIfCurrent xs QFLookupTables result
  -> ReadOnlyForker' m (HardForkBlock xs)
  -> m (HardForkQueryResult xs result)
interpretQueryIfCurrentLookup :: forall result (xs :: [*]) (m :: * -> *).
(MonadSTM m, BlockSupportsHFLedgerQuery xs, CanHardFork xs) =>
NP ExtLedgerCfg xs
-> QueryIfCurrent xs 'QFLookupTables result
-> ReadOnlyForker' m (HardForkBlock xs)
-> m (HardForkQueryResult xs result)
interpretQueryIfCurrentLookup NP ExtLedgerCfg xs
cfg QueryIfCurrent xs 'QFLookupTables result
q ReadOnlyForker' m (HardForkBlock xs)
forker = do
    st <- ExtLedgerState (HardForkBlock xs) EmptyMK
-> NS (Flip ExtLedgerState EmptyMK) xs
forall (xs :: [*]) (mk :: MapKind).
All SingleEraBlock xs =>
ExtLedgerState (HardForkBlock xs) mk
-> NS (Flip ExtLedgerState mk) xs
distribExtLedgerState (ExtLedgerState (HardForkBlock xs) EmptyMK
 -> NS (Flip ExtLedgerState EmptyMK) xs)
-> m (ExtLedgerState (HardForkBlock xs) EmptyMK)
-> m (NS (Flip ExtLedgerState EmptyMK) xs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> STM m (ExtLedgerState (HardForkBlock xs) EmptyMK)
-> m (ExtLedgerState (HardForkBlock xs) EmptyMK)
forall a. HasCallStack => STM m a -> m a
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (ReadOnlyForker' m (HardForkBlock xs)
-> STM m (ExtLedgerState (HardForkBlock xs) EmptyMK)
forall (m :: * -> *) (l :: LedgerStateKind) blk.
ReadOnlyForker m l blk -> STM m (l EmptyMK)
roforkerGetLedgerState ReadOnlyForker' m (HardForkBlock xs)
forker)
    go indices cfg q st
  where
    go :: All SingleEraBlock xs'
       => NP (Index xs) xs'
       -> NP ExtLedgerCfg xs'
       -> QueryIfCurrent xs' QFLookupTables result
       -> NS (Flip ExtLedgerState EmptyMK) xs'
       -> m (HardForkQueryResult xs' result)
    go :: forall (xs' :: [*]).
All SingleEraBlock xs' =>
NP (Index xs) xs'
-> NP ExtLedgerCfg xs'
-> QueryIfCurrent xs' 'QFLookupTables result
-> NS (Flip ExtLedgerState EmptyMK) xs'
-> m (HardForkQueryResult xs' result)
go (Index xs x
idx :* NP (Index xs) xs1
_) (ExtLedgerCfg x
c :* NP ExtLedgerCfg xs1
_)  (QZ BlockQuery x 'QFLookupTables result
qry) NS (Flip ExtLedgerState EmptyMK) xs'
_ =
        result -> Either (MismatchEraInfo xs') result
forall a b. b -> Either a b
Right (result -> Either (MismatchEraInfo xs') result)
-> m result -> m (Either (MismatchEraInfo xs') result)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Index xs x
-> ExtLedgerCfg x
-> BlockQuery x 'QFLookupTables result
-> ReadOnlyForker' m (HardForkBlock xs)
-> m result
forall (xs :: [*]) (m :: * -> *) x result.
(BlockSupportsHFLedgerQuery xs, All SingleEraBlock xs, Monad m) =>
Index xs x
-> ExtLedgerCfg x
-> BlockQuery x 'QFLookupTables result
-> ReadOnlyForker' m (HardForkBlock xs)
-> m result
forall (m :: * -> *) x result.
(All SingleEraBlock xs, Monad m) =>
Index xs x
-> ExtLedgerCfg x
-> BlockQuery x 'QFLookupTables result
-> ReadOnlyForker' m (HardForkBlock xs)
-> m result
answerBlockQueryHFLookup Index xs x
idx ExtLedgerCfg x
ExtLedgerCfg x
c BlockQuery x 'QFLookupTables result
BlockQuery x 'QFLookupTables result
qry ReadOnlyForker' m (HardForkBlock xs)
forker
    go (Index xs x
_ :* NP (Index xs) xs1
idx) (ExtLedgerCfg x
_ :* NP ExtLedgerCfg xs1
cs) (QS QueryIfCurrent xs 'QFLookupTables result
qry) (S NS (Flip ExtLedgerState EmptyMK) xs1
st) =
        (MismatchEraInfo xs1 -> MismatchEraInfo xs')
-> Either (MismatchEraInfo xs1) result
-> Either (MismatchEraInfo xs') result
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: MapKind) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first MismatchEraInfo xs1 -> MismatchEraInfo xs'
MismatchEraInfo xs1 -> MismatchEraInfo (x : xs1)
forall (xs :: [*]) x.
MismatchEraInfo xs -> MismatchEraInfo (x : xs)
shiftMismatch (Either (MismatchEraInfo xs1) result
 -> Either (MismatchEraInfo xs') result)
-> m (Either (MismatchEraInfo xs1) result)
-> m (Either (MismatchEraInfo xs') result)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NP (Index xs) xs1
-> NP ExtLedgerCfg xs1
-> QueryIfCurrent xs1 'QFLookupTables result
-> NS (Flip ExtLedgerState EmptyMK) xs1
-> m (Either (MismatchEraInfo xs1) result)
forall (xs' :: [*]).
All SingleEraBlock xs' =>
NP (Index xs) xs'
-> NP ExtLedgerCfg xs'
-> QueryIfCurrent xs' 'QFLookupTables result
-> NS (Flip ExtLedgerState EmptyMK) xs'
-> m (HardForkQueryResult xs' result)
go NP (Index xs) xs1
idx NP ExtLedgerCfg xs1
NP ExtLedgerCfg xs1
cs QueryIfCurrent xs1 'QFLookupTables result
QueryIfCurrent xs 'QFLookupTables result
qry NS (Flip ExtLedgerState EmptyMK) xs1
NS (Flip ExtLedgerState EmptyMK) xs1
st
    go NP (Index xs) xs'
_          NP ExtLedgerCfg xs'
_         (QS QueryIfCurrent xs 'QFLookupTables result
qry) (Z (Flip ExtLedgerState x EmptyMK
st)) =
        Either (MismatchEraInfo xs') result
-> m (Either (MismatchEraInfo xs') result)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either (MismatchEraInfo xs') result
 -> m (Either (MismatchEraInfo xs') result))
-> Either (MismatchEraInfo xs') result
-> m (Either (MismatchEraInfo xs') result)
forall a b. (a -> b) -> a -> b
$ MismatchEraInfo xs' -> Either (MismatchEraInfo xs') result
forall a b. a -> Either a b
Left (MismatchEraInfo xs' -> Either (MismatchEraInfo xs') result)
-> MismatchEraInfo xs' -> Either (MismatchEraInfo xs') result
forall a b. (a -> b) -> a -> b
$ Mismatch SingleEraInfo LedgerEraInfo xs' -> MismatchEraInfo xs'
forall (xs :: [*]).
Mismatch SingleEraInfo LedgerEraInfo xs -> MismatchEraInfo xs
MismatchEraInfo (Mismatch SingleEraInfo LedgerEraInfo xs' -> MismatchEraInfo xs')
-> Mismatch SingleEraInfo LedgerEraInfo xs' -> MismatchEraInfo xs'
forall a b. (a -> b) -> a -> b
$ NS SingleEraInfo xs
-> LedgerEraInfo x -> Mismatch SingleEraInfo LedgerEraInfo (x : xs)
forall {k} (f :: k -> *) (xs1 :: [k]) (g :: k -> *) (x :: k).
NS f xs1 -> g x -> Mismatch f g (x : xs1)
MR (QueryIfCurrent xs 'QFLookupTables result -> NS SingleEraInfo xs
forall (xs :: [*]) (footprint :: QueryFootprint) result.
All SingleEraBlock xs =>
QueryIfCurrent xs footprint result -> NS SingleEraInfo xs
hardForkQueryInfo QueryIfCurrent xs 'QFLookupTables result
qry) (ExtLedgerState x EmptyMK -> LedgerEraInfo x
forall blk (mk :: MapKind).
SingleEraBlock blk =>
ExtLedgerState blk mk -> LedgerEraInfo blk
ledgerInfo ExtLedgerState x EmptyMK
st)

interpretQueryIfCurrentTraverse ::
     forall result xs m. (MonadSTM m, BlockSupportsHFLedgerQuery xs, CanHardFork xs)
  => NP ExtLedgerCfg xs
  -> QueryIfCurrent xs QFTraverseTables result
  -> ReadOnlyForker' m (HardForkBlock xs)
  -> m (HardForkQueryResult xs result)
interpretQueryIfCurrentTraverse :: forall result (xs :: [*]) (m :: * -> *).
(MonadSTM m, BlockSupportsHFLedgerQuery xs, CanHardFork xs) =>
NP ExtLedgerCfg xs
-> QueryIfCurrent xs 'QFTraverseTables result
-> ReadOnlyForker' m (HardForkBlock xs)
-> m (HardForkQueryResult xs result)
interpretQueryIfCurrentTraverse NP ExtLedgerCfg xs
cfg QueryIfCurrent xs 'QFTraverseTables result
q ReadOnlyForker' m (HardForkBlock xs)
forker = do
    st <- ExtLedgerState (HardForkBlock xs) EmptyMK
-> NS (Flip ExtLedgerState EmptyMK) xs
forall (xs :: [*]) (mk :: MapKind).
All SingleEraBlock xs =>
ExtLedgerState (HardForkBlock xs) mk
-> NS (Flip ExtLedgerState mk) xs
distribExtLedgerState (ExtLedgerState (HardForkBlock xs) EmptyMK
 -> NS (Flip ExtLedgerState EmptyMK) xs)
-> m (ExtLedgerState (HardForkBlock xs) EmptyMK)
-> m (NS (Flip ExtLedgerState EmptyMK) xs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> STM m (ExtLedgerState (HardForkBlock xs) EmptyMK)
-> m (ExtLedgerState (HardForkBlock xs) EmptyMK)
forall a. HasCallStack => STM m a -> m a
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (ReadOnlyForker' m (HardForkBlock xs)
-> STM m (ExtLedgerState (HardForkBlock xs) EmptyMK)
forall (m :: * -> *) (l :: LedgerStateKind) blk.
ReadOnlyForker m l blk -> STM m (l EmptyMK)
roforkerGetLedgerState ReadOnlyForker' m (HardForkBlock xs)
forker)
    go indices cfg q st
  where
    go :: All SingleEraBlock xs'
       => NP (Index xs) xs'
       -> NP ExtLedgerCfg xs'
       -> QueryIfCurrent xs' QFTraverseTables result
       -> NS (Flip ExtLedgerState EmptyMK) xs'
       -> m (HardForkQueryResult xs' result)
    go :: forall (xs' :: [*]).
All SingleEraBlock xs' =>
NP (Index xs) xs'
-> NP ExtLedgerCfg xs'
-> QueryIfCurrent xs' 'QFTraverseTables result
-> NS (Flip ExtLedgerState EmptyMK) xs'
-> m (HardForkQueryResult xs' result)
go (Index xs x
idx :* NP (Index xs) xs1
_) (ExtLedgerCfg x
c :* NP ExtLedgerCfg xs1
_)  (QZ BlockQuery x 'QFTraverseTables result
qry) NS (Flip ExtLedgerState EmptyMK) xs'
_ =
        result -> Either (MismatchEraInfo xs') result
forall a b. b -> Either a b
Right (result -> Either (MismatchEraInfo xs') result)
-> m result -> m (Either (MismatchEraInfo xs') result)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Index xs x
-> ExtLedgerCfg x
-> BlockQuery x 'QFTraverseTables result
-> ReadOnlyForker' m (HardForkBlock xs)
-> m result
forall (xs :: [*]) (m :: * -> *) x result.
(BlockSupportsHFLedgerQuery xs, All SingleEraBlock xs, Monad m) =>
Index xs x
-> ExtLedgerCfg x
-> BlockQuery x 'QFTraverseTables result
-> ReadOnlyForker' m (HardForkBlock xs)
-> m result
forall (m :: * -> *) x result.
(All SingleEraBlock xs, Monad m) =>
Index xs x
-> ExtLedgerCfg x
-> BlockQuery x 'QFTraverseTables result
-> ReadOnlyForker' m (HardForkBlock xs)
-> m result
answerBlockQueryHFTraverse Index xs x
idx ExtLedgerCfg x
ExtLedgerCfg x
c BlockQuery x 'QFTraverseTables result
BlockQuery x 'QFTraverseTables result
qry ReadOnlyForker' m (HardForkBlock xs)
forker
    go (Index xs x
_ :* NP (Index xs) xs1
idx) (ExtLedgerCfg x
_ :* NP ExtLedgerCfg xs1
cs) (QS QueryIfCurrent xs 'QFTraverseTables result
qry) (S NS (Flip ExtLedgerState EmptyMK) xs1
st) =
        (MismatchEraInfo xs1 -> MismatchEraInfo xs')
-> Either (MismatchEraInfo xs1) result
-> Either (MismatchEraInfo xs') result
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: MapKind) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first MismatchEraInfo xs1 -> MismatchEraInfo xs'
MismatchEraInfo xs1 -> MismatchEraInfo (x : xs1)
forall (xs :: [*]) x.
MismatchEraInfo xs -> MismatchEraInfo (x : xs)
shiftMismatch (Either (MismatchEraInfo xs1) result
 -> Either (MismatchEraInfo xs') result)
-> m (Either (MismatchEraInfo xs1) result)
-> m (Either (MismatchEraInfo xs') result)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NP (Index xs) xs1
-> NP ExtLedgerCfg xs1
-> QueryIfCurrent xs1 'QFTraverseTables result
-> NS (Flip ExtLedgerState EmptyMK) xs1
-> m (Either (MismatchEraInfo xs1) result)
forall (xs' :: [*]).
All SingleEraBlock xs' =>
NP (Index xs) xs'
-> NP ExtLedgerCfg xs'
-> QueryIfCurrent xs' 'QFTraverseTables result
-> NS (Flip ExtLedgerState EmptyMK) xs'
-> m (HardForkQueryResult xs' result)
go NP (Index xs) xs1
idx NP ExtLedgerCfg xs1
NP ExtLedgerCfg xs1
cs QueryIfCurrent xs1 'QFTraverseTables result
QueryIfCurrent xs 'QFTraverseTables result
qry NS (Flip ExtLedgerState EmptyMK) xs1
NS (Flip ExtLedgerState EmptyMK) xs1
st
    go NP (Index xs) xs'
_          NP ExtLedgerCfg xs'
_         (QS QueryIfCurrent xs 'QFTraverseTables result
qry) (Z (Flip ExtLedgerState x EmptyMK
st)) =
        Either (MismatchEraInfo xs') result
-> m (Either (MismatchEraInfo xs') result)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either (MismatchEraInfo xs') result
 -> m (Either (MismatchEraInfo xs') result))
-> Either (MismatchEraInfo xs') result
-> m (Either (MismatchEraInfo xs') result)
forall a b. (a -> b) -> a -> b
$ MismatchEraInfo xs' -> Either (MismatchEraInfo xs') result
forall a b. a -> Either a b
Left (MismatchEraInfo xs' -> Either (MismatchEraInfo xs') result)
-> MismatchEraInfo xs' -> Either (MismatchEraInfo xs') result
forall a b. (a -> b) -> a -> b
$ Mismatch SingleEraInfo LedgerEraInfo xs' -> MismatchEraInfo xs'
forall (xs :: [*]).
Mismatch SingleEraInfo LedgerEraInfo xs -> MismatchEraInfo xs
MismatchEraInfo (Mismatch SingleEraInfo LedgerEraInfo xs' -> MismatchEraInfo xs')
-> Mismatch SingleEraInfo LedgerEraInfo xs' -> MismatchEraInfo xs'
forall a b. (a -> b) -> a -> b
$ NS SingleEraInfo xs
-> LedgerEraInfo x -> Mismatch SingleEraInfo LedgerEraInfo (x : xs)
forall {k} (f :: k -> *) (xs1 :: [k]) (g :: k -> *) (x :: k).
NS f xs1 -> g x -> Mismatch f g (x : xs1)
MR (QueryIfCurrent xs 'QFTraverseTables result -> NS SingleEraInfo xs
forall (xs :: [*]) (footprint :: QueryFootprint) result.
All SingleEraBlock xs =>
QueryIfCurrent xs footprint result -> NS SingleEraInfo xs
hardForkQueryInfo QueryIfCurrent xs 'QFTraverseTables result
qry) (ExtLedgerState x EmptyMK -> LedgerEraInfo x
forall blk (mk :: MapKind).
SingleEraBlock blk =>
ExtLedgerState blk mk -> LedgerEraInfo blk
ledgerInfo ExtLedgerState x EmptyMK
st)

{-------------------------------------------------------------------------------
  Any era queries
-------------------------------------------------------------------------------}

data QueryAnytime result where
  GetEraStart :: QueryAnytime (Maybe Bound)

deriving instance Show (QueryAnytime result)

instance ShowQuery QueryAnytime where
  showResult :: forall result. QueryAnytime result -> result -> String
showResult QueryAnytime result
GetEraStart = result -> String
forall a. Show a => a -> String
show

instance SameDepIndex QueryAnytime where
   sameDepIndex :: forall a b. QueryAnytime a -> QueryAnytime b -> Maybe (a :~: b)
sameDepIndex QueryAnytime a
GetEraStart QueryAnytime b
GetEraStart = (a :~: b) -> Maybe (a :~: b)
forall a. a -> Maybe a
Just a :~: a
a :~: b
forall {k} (a :: k). a :~: a
Refl

interpretQueryAnytime ::
     forall result xs mk. All SingleEraBlock xs
  => HardForkLedgerConfig xs
  -> QueryAnytime result
  -> EraIndex xs
  -> State.HardForkState (Flip LedgerState mk) xs
  -> result
interpretQueryAnytime :: forall result (xs :: [*]) (mk :: MapKind).
All SingleEraBlock xs =>
HardForkLedgerConfig xs
-> QueryAnytime result
-> EraIndex xs
-> HardForkState (Flip LedgerState mk) xs
-> result
interpretQueryAnytime HardForkLedgerConfig xs
cfg QueryAnytime result
query (EraIndex NS (K ()) xs
era) HardForkState (Flip LedgerState mk) xs
st =
    HardForkLedgerConfig xs
-> QueryAnytime result
-> Situated (K ()) (Flip LedgerState mk) xs
-> result
forall (xs :: [*]) result (h :: * -> *) (mk :: MapKind).
All SingleEraBlock xs =>
HardForkLedgerConfig xs
-> QueryAnytime result
-> Situated h (Flip LedgerState mk) xs
-> result
answerQueryAnytime HardForkLedgerConfig xs
cfg QueryAnytime result
query (NS (K ()) xs
-> HardForkState (Flip LedgerState mk) xs
-> Situated (K ()) (Flip LedgerState mk) xs
forall (h :: * -> *) (xs :: [*]) (f :: * -> *).
NS h xs -> HardForkState f xs -> Situated h f xs
State.situate NS (K ()) xs
era HardForkState (Flip LedgerState mk) xs
st)

answerQueryAnytime ::
     All SingleEraBlock xs
  => HardForkLedgerConfig xs
  -> QueryAnytime result
  -> Situated h (Flip LedgerState mk) xs
  -> result
answerQueryAnytime :: forall (xs :: [*]) result (h :: * -> *) (mk :: MapKind).
All SingleEraBlock xs =>
HardForkLedgerConfig xs
-> QueryAnytime result
-> Situated h (Flip LedgerState mk) xs
-> result
answerQueryAnytime HardForkLedgerConfig{Shape xs
PerEraLedgerConfig xs
hardForkLedgerConfigShape :: Shape xs
hardForkLedgerConfigPerEra :: PerEraLedgerConfig xs
hardForkLedgerConfigPerEra :: forall (xs :: [*]).
HardForkLedgerConfig xs -> PerEraLedgerConfig xs
hardForkLedgerConfigShape :: forall (xs :: [*]). HardForkLedgerConfig xs -> Shape xs
..} =
    NP WrapPartialLedgerConfig xs
-> NP (K EraParams) xs
-> QueryAnytime result
-> Situated h (Flip LedgerState mk) xs
-> result
forall (xs' :: [*]) result (h :: * -> *) (mk :: MapKind).
All SingleEraBlock xs' =>
NP WrapPartialLedgerConfig xs'
-> NP (K EraParams) xs'
-> QueryAnytime result
-> Situated h (Flip LedgerState mk) xs'
-> result
go NP WrapPartialLedgerConfig xs
cfgs (Exactly xs EraParams -> NP (K EraParams) xs
forall (xs :: [*]) a. Exactly xs a -> NP (K a) xs
getExactly (Shape xs -> Exactly xs EraParams
forall (xs :: [*]). Shape xs -> Exactly xs EraParams
getShape Shape xs
hardForkLedgerConfigShape))
  where
    cfgs :: NP WrapPartialLedgerConfig xs
cfgs = PerEraLedgerConfig xs -> NP WrapPartialLedgerConfig xs
forall (xs :: [*]).
PerEraLedgerConfig xs -> NP WrapPartialLedgerConfig xs
getPerEraLedgerConfig PerEraLedgerConfig xs
hardForkLedgerConfigPerEra

    go :: All SingleEraBlock xs'
       => NP WrapPartialLedgerConfig xs'
       -> NP (K EraParams) xs'
       -> QueryAnytime result
       -> Situated h (Flip LedgerState mk) xs'
       -> result
    go :: forall (xs' :: [*]) result (h :: * -> *) (mk :: MapKind).
All SingleEraBlock xs' =>
NP WrapPartialLedgerConfig xs'
-> NP (K EraParams) xs'
-> QueryAnytime result
-> Situated h (Flip LedgerState mk) xs'
-> result
go NP WrapPartialLedgerConfig xs'
Nil       NP (K EraParams) xs'
_             QueryAnytime result
_           Situated h (Flip LedgerState mk) xs'
ctxt = case Situated h (Flip LedgerState mk) xs'
ctxt of {}
    go (WrapPartialLedgerConfig x
c :* NP WrapPartialLedgerConfig xs1
cs) (K EraParams
ps :* NP (K EraParams) xs1
pss) QueryAnytime result
GetEraStart Situated h (Flip LedgerState mk) xs'
ctxt = case Situated h (Flip LedgerState mk) xs'
ctxt of
      SituatedShift Situated h (Flip LedgerState mk) xs1
ctxt'   -> NP WrapPartialLedgerConfig xs1
-> NP (K EraParams) xs1
-> QueryAnytime result
-> Situated h (Flip LedgerState mk) xs1
-> result
forall (xs' :: [*]) result (h :: * -> *) (mk :: MapKind).
All SingleEraBlock xs' =>
NP WrapPartialLedgerConfig xs'
-> NP (K EraParams) xs'
-> QueryAnytime result
-> Situated h (Flip LedgerState mk) xs'
-> result
go NP WrapPartialLedgerConfig xs1
cs NP (K EraParams) xs1
NP (K EraParams) xs1
pss QueryAnytime result
QueryAnytime (Maybe Bound)
GetEraStart Situated h (Flip LedgerState mk) xs1
Situated h (Flip LedgerState mk) xs1
ctxt'
      SituatedFuture Current (Flip LedgerState mk) x
_ NS h xs1
_    -> result
Maybe Bound
forall a. Maybe a
Nothing
      SituatedPast K Past x
past h x
_   -> Bound -> Maybe Bound
forall a. a -> Maybe a
Just (Bound -> Maybe Bound) -> Bound -> Maybe Bound
forall a b. (a -> b) -> a -> b
$ Past -> Bound
pastStart (Past -> Bound) -> Past -> Bound
forall a b. (a -> b) -> a -> b
$ K Past x -> Past
forall {k} a (b :: k). K a b -> a
unK K Past x
past
      SituatedCurrent Current (Flip LedgerState mk) x
cur h x
_ -> Bound -> Maybe Bound
forall a. a -> Maybe a
Just (Bound -> Maybe Bound) -> Bound -> Maybe Bound
forall a b. (a -> b) -> a -> b
$ Current (Flip LedgerState mk) x -> Bound
forall (f :: * -> *) blk. Current f blk -> Bound
currentStart Current (Flip LedgerState mk) x
cur
      SituatedNext Current (Flip LedgerState mk) x
cur h y
_    ->
        HasCallStack => EraParams -> Bound -> EpochNo -> Bound
EraParams -> Bound -> EpochNo -> Bound
History.mkUpperBound EraParams
ps (Current (Flip LedgerState mk) x -> Bound
forall (f :: * -> *) blk. Current f blk -> Bound
currentStart Current (Flip LedgerState mk) x
cur) (EpochNo -> Bound) -> Maybe EpochNo -> Maybe Bound
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
          PartialLedgerConfig x
-> EraParams -> Bound -> LedgerState x mk -> Maybe EpochNo
forall blk (mk :: MapKind).
SingleEraBlock blk =>
PartialLedgerConfig blk
-> EraParams -> Bound -> LedgerState blk mk -> Maybe EpochNo
forall (mk :: MapKind).
PartialLedgerConfig x
-> EraParams -> Bound -> LedgerState x mk -> Maybe EpochNo
singleEraTransition
          (WrapPartialLedgerConfig x -> PartialLedgerConfig x
forall blk. WrapPartialLedgerConfig blk -> PartialLedgerConfig blk
unwrapPartialLedgerConfig WrapPartialLedgerConfig x
c)
          EraParams
ps
          (Current (Flip LedgerState mk) x -> Bound
forall (f :: * -> *) blk. Current f blk -> Bound
currentStart Current (Flip LedgerState mk) x
cur)
          (Flip LedgerState mk x -> LedgerState x mk
forall x1 y1 (f :: x1 -> y1 -> *) (x2 :: y1) (y2 :: x1).
Flip f x2 y2 -> f y2 x2
unFlip (Flip LedgerState mk x -> LedgerState x mk)
-> Flip LedgerState mk x -> LedgerState x mk
forall a b. (a -> b) -> a -> b
$ Current (Flip LedgerState mk) x -> Flip LedgerState mk x
forall (f :: * -> *) blk. Current f blk -> f blk
currentState Current (Flip LedgerState mk) x
cur)

{-------------------------------------------------------------------------------
  Hard fork queries
-------------------------------------------------------------------------------}

data QueryHardFork xs result where
  GetInterpreter :: QueryHardFork xs (History.Interpreter xs)
  GetCurrentEra  :: QueryHardFork xs (EraIndex xs)

deriving instance Show (QueryHardFork xs result)

instance All SingleEraBlock xs => ShowQuery (QueryHardFork xs) where
  showResult :: forall result. QueryHardFork xs result -> result -> String
showResult QueryHardFork xs result
GetInterpreter = result -> String
forall a. Show a => a -> String
show
  showResult QueryHardFork xs result
GetCurrentEra  = result -> String
forall a. Show a => a -> String
show

instance SameDepIndex (QueryHardFork xs) where
  sameDepIndex :: forall a b.
QueryHardFork xs a -> QueryHardFork xs b -> Maybe (a :~: b)
sameDepIndex QueryHardFork xs a
GetInterpreter QueryHardFork xs b
GetInterpreter =
      (a :~: b) -> Maybe (a :~: b)
forall a. a -> Maybe a
Just a :~: a
a :~: b
forall {k} (a :: k). a :~: a
Refl
  sameDepIndex QueryHardFork xs a
GetInterpreter QueryHardFork xs b
_ =
      Maybe (a :~: b)
forall a. Maybe a
Nothing
  sameDepIndex QueryHardFork xs a
GetCurrentEra QueryHardFork xs b
GetCurrentEra =
      (a :~: b) -> Maybe (a :~: b)
forall a. a -> Maybe a
Just a :~: a
a :~: b
forall {k} (a :: k). a :~: a
Refl
  sameDepIndex QueryHardFork xs a
GetCurrentEra QueryHardFork xs b
_ =
      Maybe (a :~: b)
forall a. Maybe a
Nothing

interpretQueryHardFork ::
     All SingleEraBlock xs
  => HardForkLedgerConfig xs
  -> QueryHardFork xs result
  -> LedgerState (HardForkBlock xs) mk
  -> result
interpretQueryHardFork :: forall (xs :: [*]) result (mk :: MapKind).
All SingleEraBlock xs =>
HardForkLedgerConfig xs
-> QueryHardFork xs result
-> LedgerState (HardForkBlock xs) mk
-> result
interpretQueryHardFork HardForkLedgerConfig xs
cfg QueryHardFork xs result
query LedgerState (HardForkBlock xs) mk
st =
    case QueryHardFork xs result
query of
      QueryHardFork xs result
GetInterpreter ->
        Summary xs -> Interpreter xs
forall (xs :: [*]). Summary xs -> Interpreter xs
History.mkInterpreter (Summary xs -> Interpreter xs) -> Summary xs -> Interpreter xs
forall a b. (a -> b) -> a -> b
$ LedgerConfig (HardForkBlock xs)
-> LedgerState (HardForkBlock xs) mk
-> Summary (HardForkIndices (HardForkBlock xs))
forall blk (mk :: MapKind).
HasHardForkHistory blk =>
LedgerConfig blk
-> LedgerState blk mk -> Summary (HardForkIndices blk)
forall (mk :: MapKind).
LedgerConfig (HardForkBlock xs)
-> LedgerState (HardForkBlock xs) mk
-> Summary (HardForkIndices (HardForkBlock xs))
hardForkSummary LedgerConfig (HardForkBlock xs)
HardForkLedgerConfig xs
cfg LedgerState (HardForkBlock xs) mk
st
      QueryHardFork xs result
GetCurrentEra  ->
        NS (Flip LedgerState mk) xs -> EraIndex xs
forall (xs :: [*]) (f :: * -> *).
SListI xs =>
NS f xs -> EraIndex xs
eraIndexFromNS (NS (Flip LedgerState mk) xs -> EraIndex xs)
-> NS (Flip LedgerState mk) xs -> EraIndex xs
forall a b. (a -> b) -> a -> b
$ HardForkState (Flip LedgerState mk) xs
-> NS (Flip LedgerState mk) xs
forall (xs :: [*]) (f :: * -> *).
SListI xs =>
HardForkState f xs -> NS f xs
State.tip (HardForkState (Flip LedgerState mk) xs
 -> NS (Flip LedgerState mk) xs)
-> HardForkState (Flip LedgerState mk) xs
-> NS (Flip LedgerState mk) xs
forall a b. (a -> b) -> a -> b
$ LedgerState (HardForkBlock xs) mk
-> HardForkState (Flip LedgerState mk) xs
forall (xs :: [*]) (mk :: MapKind).
LedgerState (HardForkBlock xs) mk
-> HardForkState (Flip LedgerState mk) xs
hardForkLedgerStatePerEra LedgerState (HardForkBlock xs) mk
st

{-------------------------------------------------------------------------------
  Serialisation
-------------------------------------------------------------------------------}

instance Serialise (Some QueryAnytime) where
  encode :: Some QueryAnytime -> Encoding
encode (Some QueryAnytime a
GetEraStart) = [Encoding] -> Encoding
forall a. Monoid a => [a] -> a
mconcat [
        Word -> Encoding
Enc.encodeListLen Word
1
      , Word8 -> Encoding
Enc.encodeWord8 Word8
0
      ]

  decode :: forall s. Decoder s (Some QueryAnytime)
decode = do
    Text -> Int -> Decoder s ()
forall s. Text -> Int -> Decoder s ()
enforceSize Text
"QueryAnytime" Int
1
    tag <- Decoder s Word8
forall s. Decoder s Word8
Dec.decodeWord8
    case tag of
      Word8
0 -> Some QueryAnytime -> Decoder s (Some QueryAnytime)
forall a. a -> Decoder s a
forall (m :: * -> *) a. Monad m => a -> m a
return (Some QueryAnytime -> Decoder s (Some QueryAnytime))
-> Some QueryAnytime -> Decoder s (Some QueryAnytime)
forall a b. (a -> b) -> a -> b
$ QueryAnytime (Maybe Bound) -> Some QueryAnytime
forall {k} (f :: k -> *) (a :: k). f a -> Some f
Some QueryAnytime (Maybe Bound)
GetEraStart
      Word8
_ -> String -> Decoder s (Some QueryAnytime)
forall a. String -> Decoder s a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Decoder s (Some QueryAnytime))
-> String -> Decoder s (Some QueryAnytime)
forall a b. (a -> b) -> a -> b
$ String
"QueryAnytime: invalid tag " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word8 -> String
forall a. Show a => a -> String
show Word8
tag

encodeQueryAnytimeResult :: QueryAnytime result -> result -> Encoding
encodeQueryAnytimeResult :: forall result. QueryAnytime result -> result -> Encoding
encodeQueryAnytimeResult QueryAnytime result
GetEraStart = result -> Encoding
forall a. Serialise a => a -> Encoding
encode

decodeQueryAnytimeResult :: QueryAnytime result -> forall s. Decoder s result
decodeQueryAnytimeResult :: forall result. QueryAnytime result -> forall s. Decoder s result
decodeQueryAnytimeResult QueryAnytime result
GetEraStart = Decoder s result
forall s. Decoder s result
forall a s. Serialise a => Decoder s a
decode

encodeQueryHardForkResult ::
     SListI xs
  => QueryHardFork xs result -> result -> Encoding
encodeQueryHardForkResult :: forall (xs :: [*]) result.
SListI xs =>
QueryHardFork xs result -> result -> Encoding
encodeQueryHardForkResult = \case
    QueryHardFork xs result
GetInterpreter -> result -> Encoding
forall a. Serialise a => a -> Encoding
encode
    QueryHardFork xs result
GetCurrentEra  -> result -> Encoding
forall a. Serialise a => a -> Encoding
encode

decodeQueryHardForkResult ::
     SListI xs
  => QueryHardFork xs result -> forall s. Decoder s result
decodeQueryHardForkResult :: forall (xs :: [*]) result.
SListI xs =>
QueryHardFork xs result -> forall s. Decoder s result
decodeQueryHardForkResult = \case
    QueryHardFork xs result
GetInterpreter -> Decoder s result
forall s. Decoder s result
forall a s. Serialise a => Decoder s a
decode
    QueryHardFork xs result
GetCurrentEra  -> Decoder s result
forall s. Decoder s result
forall a s. Serialise a => Decoder s a
decode

{-------------------------------------------------------------------------------
  Auxiliary
-------------------------------------------------------------------------------}

ledgerInfo :: forall blk mk. SingleEraBlock blk
           => ExtLedgerState blk mk
           -> LedgerEraInfo blk
ledgerInfo :: forall blk (mk :: MapKind).
SingleEraBlock blk =>
ExtLedgerState blk mk -> LedgerEraInfo blk
ledgerInfo ExtLedgerState blk mk
_ = SingleEraInfo blk -> LedgerEraInfo blk
forall blk. SingleEraInfo blk -> LedgerEraInfo blk
LedgerEraInfo (SingleEraInfo blk -> LedgerEraInfo blk)
-> SingleEraInfo blk -> LedgerEraInfo blk
forall a b. (a -> b) -> a -> b
$ Proxy blk -> SingleEraInfo blk
forall blk (proxy :: * -> *).
SingleEraBlock blk =>
proxy blk -> SingleEraInfo blk
forall (proxy :: * -> *). proxy blk -> SingleEraInfo blk
singleEraInfo (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @blk)

queryInfo :: forall blk query (footprint :: QueryFootprint) result. SingleEraBlock blk
          => query blk footprint result -> SingleEraInfo blk
queryInfo :: forall blk (query :: * -> QueryFootprint -> * -> *)
       (footprint :: QueryFootprint) result.
SingleEraBlock blk =>
query blk footprint result -> SingleEraInfo blk
queryInfo query blk footprint result
_ = Proxy blk -> SingleEraInfo blk
forall blk (proxy :: * -> *).
SingleEraBlock blk =>
proxy blk -> SingleEraInfo blk
forall (proxy :: * -> *). proxy blk -> SingleEraInfo blk
singleEraInfo (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @blk)

hardForkQueryInfo :: All SingleEraBlock xs
                  => QueryIfCurrent xs footprint result -> NS SingleEraInfo xs
hardForkQueryInfo :: forall (xs :: [*]) (footprint :: QueryFootprint) result.
All SingleEraBlock xs =>
QueryIfCurrent xs footprint result -> NS SingleEraInfo xs
hardForkQueryInfo = QueryIfCurrent xs footprint result -> NS SingleEraInfo xs
forall (xs :: [*]) (footprint :: QueryFootprint) result.
All SingleEraBlock xs =>
QueryIfCurrent xs footprint result -> NS SingleEraInfo xs
go
  where
    go :: All SingleEraBlock xs'
       => QueryIfCurrent xs' footprint result -> NS SingleEraInfo xs'
    go :: forall (xs :: [*]) (footprint :: QueryFootprint) result.
All SingleEraBlock xs =>
QueryIfCurrent xs footprint result -> NS SingleEraInfo xs
go (QZ BlockQuery x footprint result
qry) = SingleEraInfo x -> NS SingleEraInfo (x : xs)
forall {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> NS f (x : xs1)
Z (BlockQuery x footprint result -> SingleEraInfo x
forall blk (query :: * -> QueryFootprint -> * -> *)
       (footprint :: QueryFootprint) result.
SingleEraBlock blk =>
query blk footprint result -> SingleEraInfo blk
queryInfo BlockQuery x footprint result
qry)
    go (QS QueryIfCurrent xs footprint result
qry) = NS SingleEraInfo xs -> NS SingleEraInfo (x : xs)
forall {k} (f :: k -> *) (xs1 :: [k]) (x :: k).
NS f xs1 -> NS f (x : xs1)
S (QueryIfCurrent xs footprint result -> NS SingleEraInfo xs
forall (xs :: [*]) (footprint :: QueryFootprint) result.
All SingleEraBlock xs =>
QueryIfCurrent xs footprint result -> NS SingleEraInfo xs
go QueryIfCurrent xs footprint result
qry)

shiftMismatch :: MismatchEraInfo xs -> MismatchEraInfo (x ': xs)
shiftMismatch :: forall (xs :: [*]) x.
MismatchEraInfo xs -> MismatchEraInfo (x : xs)
shiftMismatch = Mismatch SingleEraInfo LedgerEraInfo (x : xs)
-> MismatchEraInfo (x : xs)
forall (xs :: [*]).
Mismatch SingleEraInfo LedgerEraInfo xs -> MismatchEraInfo xs
MismatchEraInfo (Mismatch SingleEraInfo LedgerEraInfo (x : xs)
 -> MismatchEraInfo (x : xs))
-> (MismatchEraInfo xs
    -> Mismatch SingleEraInfo LedgerEraInfo (x : xs))
-> MismatchEraInfo xs
-> MismatchEraInfo (x : xs)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mismatch SingleEraInfo LedgerEraInfo xs
-> Mismatch SingleEraInfo LedgerEraInfo (x : xs)
forall {k} (f :: k -> *) (g :: k -> *) (xs1 :: [k]) (x :: k).
Mismatch f g xs1 -> Mismatch f g (x : xs1)
MS (Mismatch SingleEraInfo LedgerEraInfo xs
 -> Mismatch SingleEraInfo LedgerEraInfo (x : xs))
-> (MismatchEraInfo xs -> Mismatch SingleEraInfo LedgerEraInfo xs)
-> MismatchEraInfo xs
-> Mismatch SingleEraInfo LedgerEraInfo (x : xs)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MismatchEraInfo xs -> Mismatch SingleEraInfo LedgerEraInfo xs
forall (xs :: [*]).
MismatchEraInfo xs -> Mismatch SingleEraInfo LedgerEraInfo xs
getMismatchEraInfo