{-# 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 TypeApplications #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -Wno-orphans #-} module Ouroboros.Consensus.HardFork.Combinator.Ledger.Query ( BlockQuery (..) , 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.Reflection (give) import Data.SOP.BasicFunctors import Data.SOP.Constraint import Data.SOP.Counting (getExactly) import Data.SOP.Match (Mismatch (..), mustMatchNS) import Data.SOP.Strict import Data.Type.Equality import Data.Typeable (Typeable) 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.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.HardFork.History.EraParams (EraParamsFormat (..)) import Ouroboros.Consensus.HeaderValidation import Ouroboros.Consensus.Ledger.Extended import Ouroboros.Consensus.Ledger.Query import Ouroboros.Consensus.Node.Serialisation (Some (..)) import Ouroboros.Consensus.TypeFamilyWrappers (WrapChainDepState (..)) import Ouroboros.Consensus.Util (ShowProxy) instance Typeable xs => ShowProxy (BlockQuery (HardForkBlock xs)) where instance All SingleEraBlock xs => ShowQuery (BlockQuery (HardForkBlock xs)) where showResult :: forall result. BlockQuery (HardForkBlock xs) 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 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 result -> result -> String forall result. QueryIfCurrent xs result -> result -> String forall (query :: * -> *) result. ShowQuery query => query result -> result -> String showResult QueryIfCurrent xs result qry result result type HardForkQueryResult xs = Either (MismatchEraInfo xs) data instance BlockQuery (HardForkBlock xs) :: Type -> Type where -- | Answer a query about an era if it is the current one. QueryIfCurrent :: QueryIfCurrent xs result -> BlockQuery (HardForkBlock xs) (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)) 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)) result instance All SingleEraBlock xs => BlockSupportsLedgerQuery (HardForkBlock xs) where answerBlockQuery :: forall result. ExtLedgerCfg (HardForkBlock xs) -> BlockQuery (HardForkBlock xs) result -> ExtLedgerState (HardForkBlock xs) -> result answerBlockQuery (ExtLedgerCfg TopLevelConfig (HardForkBlock xs) cfg) BlockQuery (HardForkBlock xs) result query ext :: ExtLedgerState (HardForkBlock xs) ext@(ExtLedgerState st :: LedgerState (HardForkBlock xs) st@(HardForkLedgerState HardForkState LedgerState xs hardForkState) HeaderState (HardForkBlock xs) _) = case BlockQuery (HardForkBlock xs) result query of QueryIfCurrent QueryIfCurrent xs result queryIfCurrent -> NP ExtLedgerCfg xs -> QueryIfCurrent xs result -> NS ExtLedgerState xs -> Either (MismatchEraInfo xs) result forall result (xs :: [*]). All SingleEraBlock xs => NP ExtLedgerCfg xs -> QueryIfCurrent xs result -> NS ExtLedgerState xs -> HardForkQueryResult xs result interpretQueryIfCurrent NP ExtLedgerCfg xs cfgs QueryIfCurrent xs result queryIfCurrent (ExtLedgerState (HardForkBlock xs) -> NS ExtLedgerState xs forall (xs :: [*]). All SingleEraBlock xs => ExtLedgerState (HardForkBlock xs) -> NS ExtLedgerState xs distribExtLedgerState ExtLedgerState (HardForkBlock xs) ext) QueryAnytime QueryAnytime result queryAnytime (EraIndex NS (K ()) (x : xs) era) -> HardForkLedgerConfig (x : xs) -> QueryAnytime result -> EraIndex (x : xs) -> HardForkState LedgerState (x : xs) -> result forall result (xs :: [*]). All SingleEraBlock xs => HardForkLedgerConfig xs -> QueryAnytime result -> EraIndex xs -> HardForkState LedgerState 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 LedgerState xs HardForkState LedgerState (x : xs) hardForkState QueryHardFork QueryHardFork (x : xs) result queryHardFork -> HardForkLedgerConfig (x : xs) -> QueryHardFork (x : xs) result -> LedgerState (HardForkBlock (x : xs)) -> result forall (xs :: [*]) result. All SingleEraBlock xs => HardForkLedgerConfig xs -> QueryHardFork xs result -> LedgerState (HardForkBlock xs) -> result interpretQueryHardFork LedgerConfig (HardForkBlock xs) HardForkLedgerConfig (x : xs) lcfg QueryHardFork (x : xs) result queryHardFork LedgerState (HardForkBlock xs) LedgerState (HardForkBlock (x : xs)) 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 LedgerState xs -> EpochInfo (Except PastHorizonException) forall (xs :: [*]). All SingleEraBlock xs => HardForkLedgerConfig xs -> HardForkState LedgerState xs -> EpochInfo (Except PastHorizonException) State.epochInfoLedger LedgerConfig (HardForkBlock xs) HardForkLedgerConfig xs lcfg HardForkState LedgerState xs hardForkState -- | 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) -> NS ExtLedgerState xs distribExtLedgerState :: forall (xs :: [*]). All SingleEraBlock xs => ExtLedgerState (HardForkBlock xs) -> NS ExtLedgerState xs distribExtLedgerState (ExtLedgerState LedgerState (HardForkBlock xs) ledgerState HeaderState (HardForkBlock xs) headerState) = (forall a. Product HeaderState LedgerState a -> ExtLedgerState a) -> NS (Product HeaderState LedgerState) xs -> NS ExtLedgerState 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 LedgerState a lst) -> LedgerState a -> HeaderState a -> ExtLedgerState a forall blk. LedgerState blk -> HeaderState blk -> ExtLedgerState blk ExtLedgerState LedgerState a lst HeaderState a hst) (NS (Product HeaderState LedgerState) xs -> NS ExtLedgerState xs) -> NS (Product HeaderState LedgerState) xs -> NS ExtLedgerState xs forall a b. (a -> b) -> a -> b $ String -> NS HeaderState xs -> NS LedgerState xs -> NS (Product HeaderState LedgerState) 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 LedgerState xs -> NS LedgerState xs forall (xs :: [*]) (f :: * -> *). SListI xs => HardForkState f xs -> NS f xs State.tip (LedgerState (HardForkBlock xs) -> HardForkState LedgerState xs forall (xs :: [*]). LedgerState (HardForkBlock xs) -> HardForkState LedgerState xs hardForkLedgerStatePerEra LedgerState (HardForkBlock xs) 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)) instance All SingleEraBlock xs => SameDepIndex (BlockQuery (HardForkBlock xs)) where sameDepIndex :: forall a b. BlockQuery (HardForkBlock xs) a -> BlockQuery (HardForkBlock xs) b -> Maybe (a :~: b) sameDepIndex (QueryIfCurrent QueryIfCurrent xs result qry) (QueryIfCurrent QueryIfCurrent xs result qry') = (Either (MismatchEraInfo xs) :~: Either (MismatchEraInfo xs)) -> (result :~: result) -> Either (MismatchEraInfo xs) result :~: Either (MismatchEraInfo xs) result forall {k1} {k2} (f :: k1 -> k2) (g :: k1 -> k2) (a :: k1) (b :: k1). (f :~: g) -> (a :~: b) -> f a :~: g b apply Either (MismatchEraInfo xs) :~: Either (MismatchEraInfo xs) forall {k} (a :: k). a :~: a Refl ((result :~: result) -> a :~: b) -> Maybe (result :~: result) -> Maybe (a :~: b) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> QueryIfCurrent xs result -> QueryIfCurrent xs result -> Maybe (result :~: result) forall a b. QueryIfCurrent xs a -> QueryIfCurrent xs b -> Maybe (a :~: b) forall (f :: * -> *) a b. SameDepIndex f => f a -> f b -> Maybe (a :~: b) sameDepIndex QueryIfCurrent xs result qry QueryIfCurrent xs result qry' sameDepIndex (QueryIfCurrent {}) BlockQuery (HardForkBlock xs) b _ = Maybe (a :~: b) forall a. Maybe a Nothing sameDepIndex (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' = QueryAnytime a -> QueryAnytime b -> Maybe (a :~: b) forall a b. QueryAnytime a -> QueryAnytime b -> Maybe (a :~: b) forall (f :: * -> *) a b. SameDepIndex f => f a -> f b -> Maybe (a :~: b) sameDepIndex QueryAnytime a qry QueryAnytime b qry' | Bool otherwise = Maybe (a :~: b) forall a. Maybe a Nothing sameDepIndex (QueryAnytime {}) BlockQuery (HardForkBlock xs) b _ = Maybe (a :~: b) forall a. Maybe a Nothing sameDepIndex (QueryHardFork QueryHardFork (x : xs) a qry) (QueryHardFork QueryHardFork (x : xs) b qry') = 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 (f :: * -> *) a b. SameDepIndex f => f a -> f b -> Maybe (a :~: b) sameDepIndex QueryHardFork (x : xs) a qry QueryHardFork (x : xs) b QueryHardFork (x : xs) b qry' sameDepIndex (QueryHardFork {}) BlockQuery (HardForkBlock xs) b _ = Maybe (a :~: b) forall a. Maybe a Nothing deriving instance All SingleEraBlock xs => Show (BlockQuery (HardForkBlock xs) result) getHardForkQuery :: BlockQuery (HardForkBlock xs) result -> (forall result'. result :~: HardForkQueryResult xs result' -> QueryIfCurrent xs 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 :: [*]) result r. BlockQuery (HardForkBlock xs) result -> (forall result'. (result :~: HardForkQueryResult xs result') -> QueryIfCurrent xs 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) result q forall result'. (result :~: HardForkQueryResult xs result') -> QueryIfCurrent xs 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) result q of QueryIfCurrent QueryIfCurrent xs result qry -> (result :~: Either (MismatchEraInfo xs) result) -> QueryIfCurrent xs result -> r forall result'. (result :~: HardForkQueryResult xs result') -> QueryIfCurrent xs result' -> r k1 result :~: result result :~: Either (MismatchEraInfo xs) result forall {k} (a :: k). a :~: a Refl QueryIfCurrent xs 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 -------------------------------------------------------------------------------} data QueryIfCurrent :: [Type] -> Type -> Type where QZ :: BlockQuery x result -> QueryIfCurrent (x ': xs) result QS :: QueryIfCurrent xs result -> QueryIfCurrent (x ': xs) result deriving instance All SingleEraBlock xs => Show (QueryIfCurrent xs result) instance All SingleEraBlock xs => ShowQuery (QueryIfCurrent xs) where showResult :: forall result. QueryIfCurrent xs result -> result -> String showResult (QZ BlockQuery x result qry) = BlockQuery x result -> result -> String forall result. BlockQuery x result -> result -> String forall (query :: * -> *) result. ShowQuery query => query result -> result -> String showResult BlockQuery x result qry showResult (QS QueryIfCurrent xs result qry) = QueryIfCurrent xs result -> result -> String forall result. QueryIfCurrent xs result -> result -> String forall (query :: * -> *) result. ShowQuery query => query result -> result -> String showResult QueryIfCurrent xs result qry instance All SingleEraBlock xs => SameDepIndex (QueryIfCurrent xs) where sameDepIndex :: forall a b. QueryIfCurrent xs a -> QueryIfCurrent xs b -> Maybe (a :~: b) sameDepIndex (QZ BlockQuery x a qry) (QZ BlockQuery x b qry') = BlockQuery x a -> BlockQuery x b -> Maybe (a :~: b) forall a b. BlockQuery x a -> BlockQuery x b -> Maybe (a :~: b) forall (f :: * -> *) a b. SameDepIndex f => f a -> f b -> Maybe (a :~: b) sameDepIndex BlockQuery x a qry BlockQuery x b BlockQuery x b qry' sameDepIndex (QS QueryIfCurrent xs a qry) (QS QueryIfCurrent xs b qry') = QueryIfCurrent xs a -> QueryIfCurrent xs b -> Maybe (a :~: b) forall a b. QueryIfCurrent xs a -> QueryIfCurrent xs b -> Maybe (a :~: b) forall (f :: * -> *) a b. SameDepIndex f => f a -> f b -> Maybe (a :~: b) sameDepIndex QueryIfCurrent xs a qry QueryIfCurrent xs b QueryIfCurrent xs b qry' sameDepIndex QueryIfCurrent xs a _ QueryIfCurrent xs b _ = Maybe (a :~: b) forall a. Maybe a Nothing interpretQueryIfCurrent :: forall result xs. All SingleEraBlock xs => NP ExtLedgerCfg xs -> QueryIfCurrent xs result -> NS ExtLedgerState xs -> HardForkQueryResult xs result interpretQueryIfCurrent :: forall result (xs :: [*]). All SingleEraBlock xs => NP ExtLedgerCfg xs -> QueryIfCurrent xs result -> NS ExtLedgerState xs -> HardForkQueryResult xs result interpretQueryIfCurrent = NP ExtLedgerCfg xs -> QueryIfCurrent xs result -> NS ExtLedgerState xs -> HardForkQueryResult xs result forall (xs' :: [*]). All SingleEraBlock xs' => NP ExtLedgerCfg xs' -> QueryIfCurrent xs' result -> NS ExtLedgerState xs' -> HardForkQueryResult xs' result go where go :: All SingleEraBlock xs' => NP ExtLedgerCfg xs' -> QueryIfCurrent xs' result -> NS ExtLedgerState xs' -> HardForkQueryResult xs' result go :: forall (xs' :: [*]). All SingleEraBlock xs' => NP ExtLedgerCfg xs' -> QueryIfCurrent xs' result -> NS ExtLedgerState xs' -> HardForkQueryResult xs' result go (ExtLedgerCfg x c :* NP ExtLedgerCfg xs1 _) (QZ BlockQuery x result qry) (Z ExtLedgerState x 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 result -> ExtLedgerState x -> result forall result. ExtLedgerCfg x -> BlockQuery x result -> ExtLedgerState x -> result forall blk result. BlockSupportsLedgerQuery blk => ExtLedgerCfg blk -> BlockQuery blk result -> ExtLedgerState blk -> result answerBlockQuery ExtLedgerCfg x c BlockQuery x result BlockQuery x result qry ExtLedgerState x ExtLedgerState x st go (ExtLedgerCfg x _ :* NP ExtLedgerCfg xs1 cs) (QS QueryIfCurrent xs result qry) (S NS ExtLedgerState 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 :: * -> * -> *) 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 result -> NS ExtLedgerState xs1 -> Either (MismatchEraInfo xs1) result forall (xs' :: [*]). All SingleEraBlock xs' => NP ExtLedgerCfg xs' -> QueryIfCurrent xs' result -> NS ExtLedgerState xs' -> HardForkQueryResult xs' result go NP ExtLedgerCfg xs1 cs QueryIfCurrent xs1 result QueryIfCurrent xs result qry NS ExtLedgerState xs1 NS ExtLedgerState xs1 st go NP ExtLedgerCfg xs' _ (QZ BlockQuery x result qry) (S NS ExtLedgerState 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 result -> SingleEraInfo x forall blk (query :: * -> * -> *) result. SingleEraBlock blk => query blk result -> SingleEraInfo blk queryInfo BlockQuery x result qry) (Proxy SingleEraBlock -> (forall a. SingleEraBlock a => ExtLedgerState a -> LedgerEraInfo a) -> NS ExtLedgerState 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 -> LedgerEraInfo a forall a. SingleEraBlock a => ExtLedgerState a -> LedgerEraInfo a ledgerInfo NS ExtLedgerState xs1 st) go NP ExtLedgerCfg xs' _ (QS QueryIfCurrent xs result qry) (Z ExtLedgerState x 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 result -> NS SingleEraInfo xs forall (xs :: [*]) result. All SingleEraBlock xs => QueryIfCurrent xs result -> NS SingleEraInfo xs hardForkQueryInfo QueryIfCurrent xs result qry) (ExtLedgerState x -> LedgerEraInfo x forall a. SingleEraBlock a => ExtLedgerState a -> LedgerEraInfo a ledgerInfo ExtLedgerState x 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. All SingleEraBlock xs => HardForkLedgerConfig xs -> QueryAnytime result -> EraIndex xs -> State.HardForkState LedgerState xs -> result interpretQueryAnytime :: forall result (xs :: [*]). All SingleEraBlock xs => HardForkLedgerConfig xs -> QueryAnytime result -> EraIndex xs -> HardForkState LedgerState xs -> result interpretQueryAnytime HardForkLedgerConfig xs cfg QueryAnytime result query (EraIndex NS (K ()) xs era) HardForkState LedgerState xs st = HardForkLedgerConfig xs -> QueryAnytime result -> Situated (K ()) LedgerState xs -> result forall (xs :: [*]) result (h :: * -> *). All SingleEraBlock xs => HardForkLedgerConfig xs -> QueryAnytime result -> Situated h LedgerState xs -> result answerQueryAnytime HardForkLedgerConfig xs cfg QueryAnytime result query (NS (K ()) xs -> HardForkState LedgerState xs -> Situated (K ()) LedgerState xs forall (h :: * -> *) (xs :: [*]) (f :: * -> *). NS h xs -> HardForkState f xs -> Situated h f xs State.situate NS (K ()) xs era HardForkState LedgerState xs st) answerQueryAnytime :: All SingleEraBlock xs => HardForkLedgerConfig xs -> QueryAnytime result -> Situated h LedgerState xs -> result answerQueryAnytime :: forall (xs :: [*]) result (h :: * -> *). All SingleEraBlock xs => HardForkLedgerConfig xs -> QueryAnytime result -> Situated h LedgerState xs -> result answerQueryAnytime HardForkLedgerConfig{Shape xs PerEraLedgerConfig xs hardForkLedgerConfigShape :: Shape xs hardForkLedgerConfigPerEra :: PerEraLedgerConfig xs hardForkLedgerConfigShape :: forall (xs :: [*]). HardForkLedgerConfig xs -> Shape xs hardForkLedgerConfigPerEra :: forall (xs :: [*]). HardForkLedgerConfig xs -> PerEraLedgerConfig xs ..} = NP WrapPartialLedgerConfig xs -> NP (K EraParams) xs -> QueryAnytime result -> Situated h LedgerState xs -> result forall (xs' :: [*]) result (h :: * -> *). All SingleEraBlock xs' => NP WrapPartialLedgerConfig xs' -> NP (K EraParams) xs' -> QueryAnytime result -> Situated h LedgerState 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 LedgerState xs' -> result go :: forall (xs' :: [*]) result (h :: * -> *). All SingleEraBlock xs' => NP WrapPartialLedgerConfig xs' -> NP (K EraParams) xs' -> QueryAnytime result -> Situated h LedgerState xs' -> result go NP WrapPartialLedgerConfig xs' Nil NP (K EraParams) xs' _ QueryAnytime result _ Situated h LedgerState xs' ctxt = case Situated h LedgerState xs' ctxt of {} go (WrapPartialLedgerConfig x c :* NP WrapPartialLedgerConfig xs1 cs) (K EraParams ps :* NP (K EraParams) xs1 pss) QueryAnytime result GetEraStart Situated h LedgerState xs' ctxt = case Situated h LedgerState xs' ctxt of SituatedShift Situated h LedgerState xs1 ctxt' -> NP WrapPartialLedgerConfig xs1 -> NP (K EraParams) xs1 -> QueryAnytime result -> Situated h LedgerState xs1 -> result forall (xs' :: [*]) result (h :: * -> *). All SingleEraBlock xs' => NP WrapPartialLedgerConfig xs' -> NP (K EraParams) xs' -> QueryAnytime result -> Situated h LedgerState xs' -> result go NP WrapPartialLedgerConfig xs1 cs NP (K EraParams) xs1 NP (K EraParams) xs1 pss QueryAnytime result QueryAnytime (Maybe Bound) GetEraStart Situated h LedgerState xs1 Situated h LedgerState xs1 ctxt' SituatedFuture Current LedgerState 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 LedgerState 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 LedgerState x -> Bound forall (f :: * -> *) blk. Current f blk -> Bound currentStart Current LedgerState x cur SituatedNext Current LedgerState x cur h y _ -> HasCallStack => EraParams -> Bound -> EpochNo -> Bound EraParams -> Bound -> EpochNo -> Bound History.mkUpperBound EraParams ps (Current LedgerState x -> Bound forall (f :: * -> *) blk. Current f blk -> Bound currentStart Current LedgerState 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 -> Maybe EpochNo forall blk. SingleEraBlock blk => PartialLedgerConfig blk -> EraParams -> Bound -> LedgerState blk -> Maybe EpochNo singleEraTransition (WrapPartialLedgerConfig x -> PartialLedgerConfig x forall blk. WrapPartialLedgerConfig blk -> PartialLedgerConfig blk unwrapPartialLedgerConfig WrapPartialLedgerConfig x c) EraParams ps (Current LedgerState x -> Bound forall (f :: * -> *) blk. Current f blk -> Bound currentStart Current LedgerState x cur) (Current LedgerState x -> LedgerState x forall (f :: * -> *) blk. Current f blk -> f blk currentState Current LedgerState 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) -> result interpretQueryHardFork :: forall (xs :: [*]) result. All SingleEraBlock xs => HardForkLedgerConfig xs -> QueryHardFork xs result -> LedgerState (HardForkBlock xs) -> result interpretQueryHardFork HardForkLedgerConfig xs cfg QueryHardFork xs result query LedgerState (HardForkBlock xs) 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) -> Summary (HardForkIndices (HardForkBlock xs)) forall blk. HasHardForkHistory blk => LedgerConfig blk -> LedgerState blk -> Summary (HardForkIndices blk) hardForkSummary LedgerConfig (HardForkBlock xs) HardForkLedgerConfig xs cfg LedgerState (HardForkBlock xs) st QueryHardFork xs result GetCurrentEra -> NS LedgerState xs -> EraIndex xs forall (xs :: [*]) (f :: * -> *). SListI xs => NS f xs -> EraIndex xs eraIndexFromNS (NS LedgerState xs -> EraIndex xs) -> NS LedgerState xs -> EraIndex xs forall a b. (a -> b) -> a -> b $ HardForkState LedgerState xs -> NS LedgerState xs forall (xs :: [*]) (f :: * -> *). SListI xs => HardForkState f xs -> NS f xs State.tip (HardForkState LedgerState xs -> NS LedgerState xs) -> HardForkState LedgerState xs -> NS LedgerState xs forall a b. (a -> b) -> a -> b $ LedgerState (HardForkBlock xs) -> HardForkState LedgerState xs forall (xs :: [*]). LedgerState (HardForkBlock xs) -> HardForkState LedgerState xs hardForkLedgerStatePerEra LedgerState (HardForkBlock xs) 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 Word8 tag <- Decoder s Word8 forall s. Decoder s Word8 Dec.decodeWord8 case Word8 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 => EraParamsFormat -> QueryHardFork xs result -> result -> Encoding encodeQueryHardForkResult :: forall (xs :: [*]) result. SListI xs => EraParamsFormat -> QueryHardFork xs result -> result -> Encoding encodeQueryHardForkResult EraParamsFormat epf = \case QueryHardFork xs result GetInterpreter -> EraParamsFormat -> (Given EraParamsFormat => result -> Encoding) -> result -> Encoding forall a r. a -> (Given a => r) -> r give EraParamsFormat epf result -> Encoding Given EraParamsFormat => 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 => EraParamsFormat -> QueryHardFork xs result -> forall s. Decoder s result decodeQueryHardForkResult :: forall (xs :: [*]) result. SListI xs => EraParamsFormat -> QueryHardFork xs result -> forall s. Decoder s result decodeQueryHardForkResult EraParamsFormat epf = \case QueryHardFork xs result GetInterpreter -> EraParamsFormat -> (Given EraParamsFormat => Decoder s result) -> Decoder s result forall a r. a -> (Given a => r) -> r give EraParamsFormat epf Decoder s result Given EraParamsFormat => 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. SingleEraBlock blk => ExtLedgerState blk -> LedgerEraInfo blk ledgerInfo :: forall a. SingleEraBlock a => ExtLedgerState a -> LedgerEraInfo a ledgerInfo ExtLedgerState blk _ = 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 result. SingleEraBlock blk => query blk result -> SingleEraInfo blk queryInfo :: forall blk (query :: * -> * -> *) result. SingleEraBlock blk => query blk result -> SingleEraInfo blk queryInfo query blk 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 result -> NS SingleEraInfo xs hardForkQueryInfo :: forall (xs :: [*]) result. All SingleEraBlock xs => QueryIfCurrent xs result -> NS SingleEraInfo xs hardForkQueryInfo = QueryIfCurrent xs result -> NS SingleEraInfo xs forall (xs :: [*]) result. All SingleEraBlock xs => QueryIfCurrent xs result -> NS SingleEraInfo xs go where go :: All SingleEraBlock xs' => QueryIfCurrent xs' result -> NS SingleEraInfo xs' go :: forall (xs :: [*]) result. All SingleEraBlock xs => QueryIfCurrent xs result -> NS SingleEraInfo xs go (QZ BlockQuery x 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 result -> SingleEraInfo x forall blk (query :: * -> * -> *) result. SingleEraBlock blk => query blk result -> SingleEraInfo blk queryInfo BlockQuery x result qry) go (QS QueryIfCurrent xs 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 result -> NS SingleEraInfo xs forall (xs :: [*]) result. All SingleEraBlock xs => QueryIfCurrent xs result -> NS SingleEraInfo xs go QueryIfCurrent xs 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