{-# LANGUAGE DataKinds #-} {-# LANGUAGE EmptyCase #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE KindSignatures #-} {-# 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 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.Strict import Data.Type.Equality import Data.Typeable (Typeable) import Cardano.Binary (enforceSize) import Ouroboros.Consensus.Block import Ouroboros.Consensus.Config import Ouroboros.Consensus.HardFork.Abstract (hardForkSummary) 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.TypeFamilyWrappers (WrapChainDepState (..)) import Ouroboros.Consensus.Util (ShowProxy) import Ouroboros.Consensus.Util.Counting (getExactly) 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.Combinator.Util.Match (Mismatch (..), mustMatchNS) instance Typeable xs => ShowProxy (BlockQuery (HardForkBlock xs)) where instance All SingleEraBlock xs => ShowQuery (BlockQuery (HardForkBlock xs)) where showResult :: BlockQuery (HardForkBlock xs) result -> result -> String showResult (QueryAnytime qry _) result result = QueryAnytime result -> result -> String forall (query :: * -> *) result. ShowQuery query => query result -> result -> String showResult QueryAnytime result qry result result showResult (QueryHardFork qry) result 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 qry) result mResult = case result mResult of Left err -> MismatchEraInfo xs -> String forall a. Show a => a -> String show MismatchEraInfo xs err Right 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 => QueryLedger (HardForkBlock xs) where answerBlockQuery :: 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) HeaderState (HardForkBlock xs) _) = case BlockQuery (HardForkBlock xs) result query of QueryIfCurrent queryIfCurrent -> NP ExtLedgerCfg xs -> QueryIfCurrent xs result -> NS ExtLedgerState xs -> HardForkQueryResult 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 (EraIndex 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 -> 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 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 :: 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 hst 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 :: 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 t 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 :: BlockQuery (HardForkBlock xs) a -> BlockQuery (HardForkBlock xs) b -> Maybe (a :~: b) sameDepIndex (QueryIfCurrent qry) (QueryIfCurrent 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) -> Either (MismatchEraInfo xs) result :~: Either (MismatchEraInfo xs) result) -> Maybe (result :~: result) -> Maybe (Either (MismatchEraInfo xs) result :~: Either (MismatchEraInfo xs) result) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> QueryIfCurrent xs result -> QueryIfCurrent xs result -> Maybe (result :~: result) 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 qry era) (QueryAnytime qry' 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 (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 qry) (QueryHardFork qry') = 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 :: 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 qry -> (result :~: HardForkQueryResult xs result) -> QueryIfCurrent xs result -> r forall result'. (result :~: HardForkQueryResult xs result') -> QueryIfCurrent xs result' -> r k1 result :~: HardForkQueryResult xs result forall k (a :: k). a :~: a Refl QueryIfCurrent xs result qry QueryAnytime qry 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 :~: (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 isNonEmpty Proxy xs forall k (t :: k). Proxy t Proxy) QueryAnytime result qry EraIndex xs EraIndex (x : xs) era QueryHardFork qry -> (xs :~: (x : xs)) -> ProofNonEmpty xs -> QueryHardFork xs result -> r forall x' (xs' :: [*]). (xs :~: (x' : xs')) -> ProofNonEmpty xs' -> QueryHardFork xs result -> r k3 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 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 :: QueryIfCurrent xs result -> result -> String showResult (QZ BlockQuery x result qry) = 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 (query :: * -> *) result. ShowQuery query => query result -> result -> String showResult QueryIfCurrent xs result qry instance All SingleEraBlock xs => SameDepIndex (QueryIfCurrent xs) where sameDepIndex :: 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 (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 (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 :: 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 :: NP ExtLedgerCfg xs' -> QueryIfCurrent xs' result -> NS ExtLedgerState xs' -> HardForkQueryResult xs' result go (ExtLedgerCfg x c :* NP ExtLedgerCfg xs _) (QZ BlockQuery x result qry) (Z ExtLedgerState x st) = result -> HardForkQueryResult xs' result forall a b. b -> Either a b Right (result -> HardForkQueryResult xs' result) -> result -> HardForkQueryResult xs' result forall a b. (a -> b) -> a -> b $ ExtLedgerCfg x -> BlockQuery x result -> ExtLedgerState x -> result forall blk result. QueryLedger 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 xs cs) (QS QueryIfCurrent xs result qry) (S NS ExtLedgerState xs st) = (MismatchEraInfo xs -> MismatchEraInfo (x : xs)) -> Either (MismatchEraInfo xs) result -> Either (MismatchEraInfo (x : xs)) result forall (p :: * -> * -> *) a b c. Bifunctor p => (a -> b) -> p a c -> p b c first MismatchEraInfo xs -> MismatchEraInfo (x : xs) forall (xs :: [*]) x. MismatchEraInfo xs -> MismatchEraInfo (x : xs) shiftMismatch (Either (MismatchEraInfo xs) result -> Either (MismatchEraInfo (x : xs)) result) -> Either (MismatchEraInfo xs) result -> Either (MismatchEraInfo (x : xs)) result forall a b. (a -> b) -> a -> b $ NP ExtLedgerCfg xs -> QueryIfCurrent xs result -> NS ExtLedgerState xs -> Either (MismatchEraInfo xs) result forall (xs' :: [*]). All SingleEraBlock xs' => NP ExtLedgerCfg xs' -> QueryIfCurrent xs' result -> NS ExtLedgerState xs' -> HardForkQueryResult xs' result go NP ExtLedgerCfg xs cs QueryIfCurrent xs result QueryIfCurrent xs result qry NS ExtLedgerState xs NS ExtLedgerState xs st go NP ExtLedgerCfg xs' _ (QZ BlockQuery x result qry) (S NS ExtLedgerState xs st) = MismatchEraInfo (x : xs) -> Either (MismatchEraInfo (x : xs)) result forall a b. a -> Either a b Left (MismatchEraInfo (x : xs) -> Either (MismatchEraInfo (x : xs)) result) -> MismatchEraInfo (x : xs) -> Either (MismatchEraInfo (x : xs)) result forall a b. (a -> b) -> a -> b $ 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)) -> Mismatch SingleEraInfo LedgerEraInfo (x : xs) -> MismatchEraInfo (x : xs) forall a b. (a -> b) -> a -> b $ SingleEraInfo x -> NS LedgerEraInfo xs -> Mismatch SingleEraInfo LedgerEraInfo (x : xs) forall a (f :: a -> *) (x :: a) (g :: a -> *) (xs :: [a]). f x -> NS g xs -> Mismatch f g (x : xs) 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 xs -> NS LedgerEraInfo xs 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 forall a. SingleEraBlock a => ExtLedgerState a -> LedgerEraInfo a ledgerInfo NS ExtLedgerState xs st) go NP ExtLedgerCfg xs' _ (QS QueryIfCurrent xs result qry) (Z ExtLedgerState x st) = MismatchEraInfo (x : xs) -> Either (MismatchEraInfo (x : xs)) result forall a b. a -> Either a b Left (MismatchEraInfo (x : xs) -> Either (MismatchEraInfo (x : xs)) result) -> MismatchEraInfo (x : xs) -> Either (MismatchEraInfo (x : xs)) result forall a b. (a -> b) -> a -> b $ 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)) -> Mismatch SingleEraInfo LedgerEraInfo (x : xs) -> MismatchEraInfo (x : xs) forall a b. (a -> b) -> a -> b $ NS SingleEraInfo xs -> LedgerEraInfo x -> Mismatch SingleEraInfo LedgerEraInfo (x : xs) forall a (f :: a -> *) (xs :: [a]) (g :: a -> *) (x :: a). NS f xs -> g x -> Mismatch f g (x : xs) 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 :: QueryAnytime result -> result -> String showResult QueryAnytime result GetEraStart = result -> String forall a. Show a => a -> String show instance SameDepIndex QueryAnytime where sameDepIndex :: QueryAnytime a -> QueryAnytime b -> Maybe (a :~: b) sameDepIndex QueryAnytime a GetEraStart QueryAnytime b GetEraStart = (a :~: a) -> Maybe (a :~: a) forall a. a -> Maybe a Just a :~: a 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 :: 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 :: HardForkLedgerConfig xs -> QueryAnytime result -> Situated h LedgerState xs -> result answerQueryAnytime HardForkLedgerConfig{Shape xs PerEraLedgerConfig xs hardForkLedgerConfigPerEra :: forall (xs :: [*]). HardForkLedgerConfig xs -> PerEraLedgerConfig xs hardForkLedgerConfigShape :: forall (xs :: [*]). HardForkLedgerConfig xs -> Shape xs hardForkLedgerConfigPerEra :: PerEraLedgerConfig xs hardForkLedgerConfigShape :: Shape 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 :: 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 xs cs) (K EraParams ps :* NP (K EraParams) xs pss) QueryAnytime result GetEraStart Situated h LedgerState xs' ctxt = case Situated h LedgerState xs' ctxt of SituatedShift Situated h LedgerState xs ctxt' -> NP WrapPartialLedgerConfig xs -> NP (K EraParams) xs -> QueryAnytime (Maybe Bound) -> Situated h LedgerState xs -> Maybe Bound 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 cs NP (K EraParams) xs NP (K EraParams) xs pss QueryAnytime (Maybe Bound) GetEraStart Situated h LedgerState xs Situated h LedgerState xs ctxt' SituatedFuture Current LedgerState x _ NS h xs _ -> result 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 :: 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 :: QueryHardFork xs a -> QueryHardFork xs b -> Maybe (a :~: b) sameDepIndex QueryHardFork xs a GetInterpreter QueryHardFork xs b GetInterpreter = (a :~: a) -> Maybe (a :~: a) forall a. a -> Maybe a Just a :~: a 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 :~: a) -> Maybe (a :~: a) forall a. a -> Maybe a Just a :~: a 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 :: 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 :: 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 (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 (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 :: 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 :: QueryAnytime result -> forall s. Decoder s result decodeQueryAnytimeResult QueryAnytime result GetEraStart = Decoder s result forall a s. Serialise a => Decoder s a decode encodeQueryHardForkResult :: SListI xs => QueryHardFork xs result -> result -> Encoding encodeQueryHardForkResult :: 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 :: QueryHardFork xs result -> forall s. Decoder s result decodeQueryHardForkResult = \case QueryHardFork xs result GetInterpreter -> Decoder s result forall a s. Serialise a => Decoder s a decode QueryHardFork xs result GetCurrentEra -> Decoder s result forall a s. Serialise a => Decoder s a decode {------------------------------------------------------------------------------- Auxiliary -------------------------------------------------------------------------------} ledgerInfo :: forall blk. SingleEraBlock blk => ExtLedgerState blk -> LedgerEraInfo blk ledgerInfo :: ExtLedgerState blk -> LedgerEraInfo blk 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 singleEraInfo (Proxy blk forall k (t :: k). Proxy t Proxy @blk) queryInfo :: forall blk query result. SingleEraBlock blk => query blk result -> SingleEraInfo blk queryInfo :: query blk result -> SingleEraInfo blk queryInfo query blk result _ = Proxy blk -> SingleEraInfo blk forall blk (proxy :: * -> *). SingleEraBlock blk => proxy blk -> SingleEraInfo blk singleEraInfo (Proxy blk forall k (t :: k). Proxy t Proxy @blk) hardForkQueryInfo :: All SingleEraBlock xs => QueryIfCurrent xs result -> NS SingleEraInfo xs hardForkQueryInfo :: 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 :: QueryIfCurrent xs' result -> NS SingleEraInfo xs' go (QZ BlockQuery x result qry) = SingleEraInfo x -> NS SingleEraInfo (x : xs) forall a (f :: a -> *) (x :: a) (xs :: [a]). f x -> NS f (x : xs) 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 a (f :: a -> *) (xs :: [a]) (x :: a). NS f xs -> NS f (x : xs) 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 :: 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 a (f :: a -> *) (g :: a -> *) (xs :: [a]) (x :: a). Mismatch f g xs -> Mismatch f g (x : xs) 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