{-# 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