{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE QuantifiedConstraints #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}

module Ouroboros.Consensus.Ledger.Query (
    BlockQuery
  , BlockSupportsLedgerQuery (..)
  , ConfigSupportsNode (..)
  , Query (..)
  , QueryVersion (..)
  , ShowQuery (..)
  , answerQuery
  , nodeToClientVersionToQueryVersion
  , queryDecodeNodeToClient
  , queryEncodeNodeToClient
  ) where

import           Cardano.Binary (FromCBOR (..), ToCBOR (..))
import           Cardano.Slotting.Block (BlockNo (..))
import           Cardano.Slotting.Slot (WithOrigin (..))
import           Codec.CBOR.Decoding
import           Codec.CBOR.Encoding
import           Codec.Serialise (Serialise)
import           Codec.Serialise.Class (decode, encode)
import           Control.Exception (Exception, throw)
import           Data.Kind (Type)
import           Data.Maybe (isJust)
import           Data.Typeable (Typeable)
import           Ouroboros.Consensus.Block.Abstract (CodecConfig)
import           Ouroboros.Consensus.BlockchainTime (SystemStart)
import           Ouroboros.Consensus.Config
import           Ouroboros.Consensus.Config.SupportsNode
import           Ouroboros.Consensus.HeaderValidation (HasAnnTip (..),
                     headerStateBlockNo, headerStatePoint)
import           Ouroboros.Consensus.Ledger.Extended
import           Ouroboros.Consensus.Ledger.Query.Version
import           Ouroboros.Consensus.Node.NetworkProtocolVersion
                     (BlockNodeToClientVersion)
import           Ouroboros.Consensus.Node.Serialisation
                     (SerialiseNodeToClient (..), SerialiseResult (..))
import           Ouroboros.Consensus.Util (ShowProxy (..), SomeSecond (..))
import           Ouroboros.Consensus.Util.DepPair
import           Ouroboros.Network.Block (HeaderHash, Point (..), StandardHash,
                     decodePoint, encodePoint)
import           Ouroboros.Network.Protocol.LocalStateQuery.Type
                     (ShowQuery (..))

{-------------------------------------------------------------------------------
  Queries
-------------------------------------------------------------------------------}

queryName :: Query blk result -> String
queryName :: forall blk result. Query blk result -> String
queryName Query blk result
query = case Query blk result
query of
  BlockQuery BlockQuery blk result
_    -> String
"BlockQuery"
  Query blk result
GetSystemStart  -> String
"GetSystemStart"
  Query blk result
GetChainBlockNo -> String
"GetChainBlockNo"
  Query blk result
GetChainPoint   -> String
"GetChainPoint"

-- | Different queries supported by the ledger for all block types, indexed
-- by the result type.
--
-- Additions to the set of queries is versioned by 'QueryVersion'
data Query blk result where
  -- | This constructor is supported by all @QueryVersion@s. The @BlockQuery@
  -- argument is versioned by the @BlockNodeToClientVersion blk@.
  BlockQuery :: BlockQuery blk result -> Query blk result

  -- | Get the 'SystemStart' time.
  --
  -- Supported by 'QueryVersion' >= 'QueryVersion1'.
  GetSystemStart :: Query blk SystemStart

  -- | Get the 'GetChainBlockNo' time.
  --
  -- Supported by 'QueryVersion' >= 'QueryVersion2'.
  GetChainBlockNo :: Query blk (WithOrigin BlockNo)

  -- | Get the 'GetChainPoint' time.
  --
  -- Supported by 'QueryVersion' >= 'QueryVersion2'.
  GetChainPoint :: Query blk (Point blk)

instance (ShowProxy (BlockQuery blk)) => ShowProxy (Query blk) where
  showProxy :: Proxy (Query blk) -> String
showProxy (Proxy (Query blk)
Proxy :: Proxy (Query blk)) = String
"Query (" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Proxy (BlockQuery blk) -> String
forall {k} (p :: k). ShowProxy p => Proxy p -> String
showProxy (forall {k} (t :: k). Proxy t
forall (t :: * -> *). Proxy t
Proxy @(BlockQuery blk)) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"

instance (ShowQuery (BlockQuery blk), StandardHash blk) => ShowQuery (Query blk) where
  showResult :: forall result. Query blk result -> result -> String
showResult (BlockQuery BlockQuery blk result
blockQuery) = BlockQuery blk result -> result -> String
forall result. BlockQuery blk result -> result -> String
forall (query :: * -> *) result.
ShowQuery query =>
query result -> result -> String
showResult BlockQuery blk result
blockQuery
  showResult Query blk result
GetSystemStart          = result -> String
forall a. Show a => a -> String
show
  showResult Query blk result
GetChainBlockNo         = result -> String
forall a. Show a => a -> String
show
  showResult Query blk result
GetChainPoint           = result -> String
forall a. Show a => a -> String
show

instance Eq (SomeSecond BlockQuery blk) => Eq (SomeSecond Query blk) where
  SomeSecond (BlockQuery BlockQuery blk b
blockQueryA) == :: SomeSecond Query blk -> SomeSecond Query blk -> Bool
== SomeSecond (BlockQuery BlockQuery blk b
blockQueryB)
    = BlockQuery blk b -> SomeSecond BlockQuery blk
forall {k1} {k2} (f :: k1 -> k2 -> *) (a :: k1) (b :: k2).
f a b -> SomeSecond f a
SomeSecond BlockQuery blk b
blockQueryA SomeSecond BlockQuery blk -> SomeSecond BlockQuery blk -> Bool
forall a. Eq a => a -> a -> Bool
== BlockQuery blk b -> SomeSecond BlockQuery blk
forall {k1} {k2} (f :: k1 -> k2 -> *) (a :: k1) (b :: k2).
f a b -> SomeSecond f a
SomeSecond BlockQuery blk b
blockQueryB
  SomeSecond (BlockQuery BlockQuery blk b
_) == SomeSecond Query blk
_ = Bool
False

  SomeSecond Query blk b
GetSystemStart == SomeSecond Query blk b
GetSystemStart = Bool
True
  SomeSecond Query blk b
GetSystemStart == SomeSecond Query blk
_                         = Bool
False

  SomeSecond Query blk b
GetChainBlockNo == SomeSecond Query blk b
GetChainBlockNo  = Bool
True
  SomeSecond Query blk b
GetChainBlockNo == SomeSecond Query blk
_                           = Bool
False

  SomeSecond Query blk b
GetChainPoint == SomeSecond Query blk b
GetChainPoint  = Bool
True
  SomeSecond Query blk b
GetChainPoint == SomeSecond Query blk
_                         = Bool
False

instance Show (SomeSecond BlockQuery blk) => Show (SomeSecond Query blk) where
  show :: SomeSecond Query blk -> String
show (SomeSecond (BlockQuery BlockQuery blk b
blockQueryA))  = String
"Query " String -> String -> String
forall a. [a] -> [a] -> [a]
++ SomeSecond BlockQuery blk -> String
forall a. Show a => a -> String
show (BlockQuery blk b -> SomeSecond BlockQuery blk
forall {k1} {k2} (f :: k1 -> k2 -> *) (a :: k1) (b :: k2).
f a b -> SomeSecond f a
SomeSecond BlockQuery blk b
blockQueryA)
  show (SomeSecond Query blk b
GetSystemStart)            = String
"Query GetSystemStart"
  show (SomeSecond Query blk b
GetChainBlockNo)           = String
"Query GetChainBlockNo"
  show (SomeSecond Query blk b
GetChainPoint)             = String
"Query GetChainPoint"


-- | Exception thrown in the encoders
data QueryEncoderException blk =
    -- | A query was submitted that is not supported by the given 'QueryVersion'
    QueryEncoderUnsupportedQuery
         (SomeSecond Query blk)
         QueryVersion

deriving instance Show (SomeSecond BlockQuery blk)
    => Show (QueryEncoderException blk)
instance (Typeable blk, Show (SomeSecond BlockQuery blk))
    => Exception (QueryEncoderException blk)

queryEncodeNodeToClient ::
     forall blk.
     Typeable blk
  => Show (SomeSecond BlockQuery blk)
  => SerialiseNodeToClient blk (SomeSecond BlockQuery blk)
  => CodecConfig blk
  -> QueryVersion
  -> BlockNodeToClientVersion blk
  -> SomeSecond Query blk
  -> Encoding
queryEncodeNodeToClient :: forall blk.
(Typeable blk, Show (SomeSecond BlockQuery blk),
 SerialiseNodeToClient blk (SomeSecond BlockQuery blk)) =>
CodecConfig blk
-> QueryVersion
-> BlockNodeToClientVersion blk
-> SomeSecond Query blk
-> Encoding
queryEncodeNodeToClient CodecConfig blk
codecConfig QueryVersion
queryVersion BlockNodeToClientVersion blk
blockVersion (SomeSecond Query blk b
query)
  = case Query blk b
query of
      BlockQuery BlockQuery blk b
blockQuery ->
        QueryVersion -> Encoding -> Encoding
forall a. QueryVersion -> a -> a
requireVersion QueryVersion
QueryVersion1 (Encoding -> Encoding) -> Encoding -> Encoding
forall a b. (a -> b) -> a -> b
$ [Encoding] -> Encoding
forall a. Monoid a => [a] -> a
mconcat
          [ Word -> Encoding
encodeListLen Word
2
          , Word8 -> Encoding
encodeWord8 Word8
0
          , BlockQuery blk b -> Encoding
encodeBlockQuery BlockQuery blk b
blockQuery
          ]

      Query blk b
GetSystemStart ->
        QueryVersion -> Encoding -> Encoding
forall a. QueryVersion -> a -> a
requireVersion QueryVersion
QueryVersion1 (Encoding -> Encoding) -> Encoding -> Encoding
forall a b. (a -> b) -> a -> b
$ [Encoding] -> Encoding
forall a. Monoid a => [a] -> a
mconcat
          [ Word -> Encoding
encodeListLen Word
1
          , Word8 -> Encoding
encodeWord8 Word8
1
          ]

      Query blk b
GetChainBlockNo ->
        QueryVersion -> Encoding -> Encoding
forall a. QueryVersion -> a -> a
requireVersion QueryVersion
QueryVersion2 (Encoding -> Encoding) -> Encoding -> Encoding
forall a b. (a -> b) -> a -> b
$ [Encoding] -> Encoding
forall a. Monoid a => [a] -> a
mconcat
          [ Word -> Encoding
encodeListLen Word
1
          , Word8 -> Encoding
encodeWord8 Word8
2
          ]

      Query blk b
GetChainPoint ->
        QueryVersion -> Encoding -> Encoding
forall a. QueryVersion -> a -> a
requireVersion QueryVersion
QueryVersion2 (Encoding -> Encoding) -> Encoding -> Encoding
forall a b. (a -> b) -> a -> b
$ [Encoding] -> Encoding
forall a. Monoid a => [a] -> a
mconcat
          [ Word -> Encoding
encodeListLen Word
1
          , Word8 -> Encoding
encodeWord8 Word8
3
          ]

  where
    requireVersion :: QueryVersion -> a -> a
    requireVersion :: forall a. QueryVersion -> a -> a
requireVersion QueryVersion
expectedVersion a
a =
      if QueryVersion
queryVersion QueryVersion -> QueryVersion -> Bool
forall a. Ord a => a -> a -> Bool
>= QueryVersion
expectedVersion
        then a
a
        else QueryEncoderException blk -> a
forall a e. Exception e => e -> a
throw (QueryEncoderException blk -> a) -> QueryEncoderException blk -> a
forall a b. (a -> b) -> a -> b
$ SomeSecond Query blk -> QueryVersion -> QueryEncoderException blk
forall blk.
SomeSecond Query blk -> QueryVersion -> QueryEncoderException blk
QueryEncoderUnsupportedQuery (Query blk b -> SomeSecond Query blk
forall {k1} {k2} (f :: k1 -> k2 -> *) (a :: k1) (b :: k2).
f a b -> SomeSecond f a
SomeSecond Query blk b
query) QueryVersion
queryVersion

    encodeBlockQuery :: BlockQuery blk b -> Encoding
encodeBlockQuery BlockQuery blk b
blockQuery =
      forall blk a.
SerialiseNodeToClient blk a =>
CodecConfig blk -> BlockNodeToClientVersion blk -> a -> Encoding
encodeNodeToClient
        @blk
        @(SomeSecond BlockQuery blk)
        CodecConfig blk
codecConfig
        BlockNodeToClientVersion blk
blockVersion
        (BlockQuery blk b -> SomeSecond BlockQuery blk
forall {k1} {k2} (f :: k1 -> k2 -> *) (a :: k1) (b :: k2).
f a b -> SomeSecond f a
SomeSecond BlockQuery blk b
blockQuery)

queryDecodeNodeToClient ::
     forall blk.
     SerialiseNodeToClient blk (SomeSecond BlockQuery blk)
  => CodecConfig blk
  -> QueryVersion
  -> BlockNodeToClientVersion blk
  -> forall s. Decoder s (SomeSecond Query blk)
queryDecodeNodeToClient :: forall blk.
SerialiseNodeToClient blk (SomeSecond BlockQuery blk) =>
CodecConfig blk
-> QueryVersion
-> BlockNodeToClientVersion blk
-> forall s. Decoder s (SomeSecond Query blk)
queryDecodeNodeToClient CodecConfig blk
codecConfig QueryVersion
queryVersion BlockNodeToClientVersion blk
blockVersion
  = case QueryVersion
queryVersion of
      QueryVersion
QueryVersion1 -> Decoder s (SomeSecond Query blk)
forall s. Decoder s (SomeSecond Query blk)
handleTopLevelQuery
      QueryVersion
QueryVersion2 -> Decoder s (SomeSecond Query blk)
forall s. Decoder s (SomeSecond Query blk)
handleTopLevelQuery
  where
    handleTopLevelQuery :: Decoder s (SomeSecond Query blk)
    handleTopLevelQuery :: forall s. Decoder s (SomeSecond Query blk)
handleTopLevelQuery = do
        Int
size <- Decoder s Int
forall s. Decoder s Int
decodeListLen
        Word8
tag  <- Decoder s Word8
forall s. Decoder s Word8
decodeWord8
        case (Int
size, Word8
tag) of
          (Int
2, Word8
0) -> QueryVersion
-> SomeSecond Query blk -> Decoder s (SomeSecond Query blk)
forall s.
QueryVersion
-> SomeSecond Query blk -> Decoder s (SomeSecond Query blk)
requireVersion QueryVersion
QueryVersion1 (SomeSecond Query blk -> Decoder s (SomeSecond Query blk))
-> Decoder s (SomeSecond Query blk)
-> Decoder s (SomeSecond Query blk)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Decoder s (SomeSecond Query blk)
forall s. Decoder s (SomeSecond Query blk)
decodeBlockQuery
          (Int
1, Word8
1) -> QueryVersion
-> SomeSecond Query blk -> Decoder s (SomeSecond Query blk)
forall s.
QueryVersion
-> SomeSecond Query blk -> Decoder s (SomeSecond Query blk)
requireVersion QueryVersion
QueryVersion1 (SomeSecond Query blk -> Decoder s (SomeSecond Query blk))
-> SomeSecond Query blk -> Decoder s (SomeSecond Query blk)
forall a b. (a -> b) -> a -> b
$ Query blk SystemStart -> SomeSecond Query blk
forall {k1} {k2} (f :: k1 -> k2 -> *) (a :: k1) (b :: k2).
f a b -> SomeSecond f a
SomeSecond Query blk SystemStart
forall blk. Query blk SystemStart
GetSystemStart
          (Int
1, Word8
2) -> QueryVersion
-> SomeSecond Query blk -> Decoder s (SomeSecond Query blk)
forall s.
QueryVersion
-> SomeSecond Query blk -> Decoder s (SomeSecond Query blk)
requireVersion QueryVersion
QueryVersion2 (SomeSecond Query blk -> Decoder s (SomeSecond Query blk))
-> SomeSecond Query blk -> Decoder s (SomeSecond Query blk)
forall a b. (a -> b) -> a -> b
$ Query blk (WithOrigin BlockNo) -> SomeSecond Query blk
forall {k1} {k2} (f :: k1 -> k2 -> *) (a :: k1) (b :: k2).
f a b -> SomeSecond f a
SomeSecond Query blk (WithOrigin BlockNo)
forall blk. Query blk (WithOrigin BlockNo)
GetChainBlockNo
          (Int
1, Word8
3) -> QueryVersion
-> SomeSecond Query blk -> Decoder s (SomeSecond Query blk)
forall s.
QueryVersion
-> SomeSecond Query blk -> Decoder s (SomeSecond Query blk)
requireVersion QueryVersion
QueryVersion2 (SomeSecond Query blk -> Decoder s (SomeSecond Query blk))
-> SomeSecond Query blk -> Decoder s (SomeSecond Query blk)
forall a b. (a -> b) -> a -> b
$ Query blk (Point blk) -> SomeSecond Query blk
forall {k1} {k2} (f :: k1 -> k2 -> *) (a :: k1) (b :: k2).
f a b -> SomeSecond f a
SomeSecond Query blk (Point blk)
forall blk. Query blk (Point blk)
GetChainPoint
          (Int, Word8)
_      -> String -> Decoder s (SomeSecond Query blk)
forall a. String -> Decoder s a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Decoder s (SomeSecond Query blk))
-> String -> Decoder s (SomeSecond Query blk)
forall a b. (a -> b) -> a -> b
$ String
"Query: invalid size and tag" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> (Int, Word8) -> String
forall a. Show a => a -> String
show (Int
size, Word8
tag)

    requireVersion ::
         QueryVersion
      -> SomeSecond Query blk
      -> Decoder s (SomeSecond Query blk)
    requireVersion :: forall s.
QueryVersion
-> SomeSecond Query blk -> Decoder s (SomeSecond Query blk)
requireVersion QueryVersion
expectedVersion SomeSecond Query blk
someSecondQuery =
      if QueryVersion
queryVersion QueryVersion -> QueryVersion -> Bool
forall a. Ord a => a -> a -> Bool
>= QueryVersion
expectedVersion
        then SomeSecond Query blk -> Decoder s (SomeSecond Query blk)
forall a. a -> Decoder s a
forall (m :: * -> *) a. Monad m => a -> m a
return SomeSecond Query blk
someSecondQuery
        else case SomeSecond Query blk
someSecondQuery of
          SomeSecond Query blk b
query -> String -> Decoder s (SomeSecond Query blk)
forall a. String -> Decoder s a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Decoder s (SomeSecond Query blk))
-> String -> Decoder s (SomeSecond Query blk)
forall a b. (a -> b) -> a -> b
$ String
"Query: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Query blk b -> String
forall blk result. Query blk result -> String
queryName Query blk b
query String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" requires at least " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> QueryVersion -> String
forall a. Show a => a -> String
show QueryVersion
expectedVersion

    decodeBlockQuery :: Decoder s (SomeSecond Query blk)
    decodeBlockQuery :: forall s. Decoder s (SomeSecond Query blk)
decodeBlockQuery = do
      SomeSecond BlockQuery blk b
blockQuery <- forall blk a.
SerialiseNodeToClient blk a =>
CodecConfig blk
-> BlockNodeToClientVersion blk -> forall s. Decoder s a
decodeNodeToClient
        @blk
        @(SomeSecond BlockQuery blk)
        CodecConfig blk
codecConfig
        BlockNodeToClientVersion blk
blockVersion
      SomeSecond Query blk -> Decoder s (SomeSecond Query blk)
forall a. a -> Decoder s a
forall (m :: * -> *) a. Monad m => a -> m a
return (Query blk b -> SomeSecond Query blk
forall {k1} {k2} (f :: k1 -> k2 -> *) (a :: k1) (b :: k2).
f a b -> SomeSecond f a
SomeSecond (BlockQuery blk b -> Query blk b
forall blk result. BlockQuery blk result -> Query blk result
BlockQuery BlockQuery blk b
blockQuery))

instance ( SerialiseResult blk (BlockQuery blk)
         , Serialise (HeaderHash blk)
         ) => SerialiseResult blk (Query blk) where
  encodeResult :: forall result.
CodecConfig blk
-> BlockNodeToClientVersion blk
-> Query blk result
-> result
-> Encoding
encodeResult CodecConfig blk
codecConfig BlockNodeToClientVersion blk
blockVersion (BlockQuery BlockQuery blk result
blockQuery) result
result
    = CodecConfig blk
-> BlockNodeToClientVersion blk
-> BlockQuery blk result
-> result
-> Encoding
forall result.
CodecConfig blk
-> BlockNodeToClientVersion blk
-> BlockQuery blk result
-> result
-> Encoding
forall blk (query :: * -> *) result.
SerialiseResult blk query =>
CodecConfig blk
-> BlockNodeToClientVersion blk
-> query result
-> result
-> Encoding
encodeResult CodecConfig blk
codecConfig BlockNodeToClientVersion blk
blockVersion BlockQuery blk result
blockQuery result
result
  encodeResult CodecConfig blk
_ BlockNodeToClientVersion blk
_ Query blk result
GetSystemStart result
result
    = result -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR result
result
  encodeResult CodecConfig blk
_ BlockNodeToClientVersion blk
_ Query blk result
GetChainBlockNo result
result
    = result -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR result
result
  encodeResult CodecConfig blk
_ BlockNodeToClientVersion blk
_ Query blk result
GetChainPoint result
result
    = (HeaderHash blk -> Encoding) -> Point blk -> Encoding
forall {k} (block :: k).
(HeaderHash block -> Encoding) -> Point block -> Encoding
encodePoint HeaderHash blk -> Encoding
forall a. Serialise a => a -> Encoding
encode result
Point blk
result

  decodeResult :: forall result.
CodecConfig blk
-> BlockNodeToClientVersion blk
-> Query blk result
-> forall s. Decoder s result
decodeResult CodecConfig blk
codecConfig BlockNodeToClientVersion blk
blockVersion (BlockQuery BlockQuery blk result
query)
    = CodecConfig blk
-> BlockNodeToClientVersion blk
-> BlockQuery blk result
-> forall s. Decoder s result
forall result.
CodecConfig blk
-> BlockNodeToClientVersion blk
-> BlockQuery blk result
-> forall s. Decoder s result
forall blk (query :: * -> *) result.
SerialiseResult blk query =>
CodecConfig blk
-> BlockNodeToClientVersion blk
-> query result
-> forall s. Decoder s result
decodeResult CodecConfig blk
codecConfig BlockNodeToClientVersion blk
blockVersion BlockQuery blk result
query
  decodeResult CodecConfig blk
_ BlockNodeToClientVersion blk
_ Query blk result
GetSystemStart
    = Decoder s result
forall s. Decoder s result
forall a s. FromCBOR a => Decoder s a
fromCBOR
  decodeResult CodecConfig blk
_ BlockNodeToClientVersion blk
_ Query blk result
GetChainBlockNo
    = Decoder s result
forall s. Decoder s result
forall a s. FromCBOR a => Decoder s a
fromCBOR
  decodeResult CodecConfig blk
_ BlockNodeToClientVersion blk
_ Query blk result
GetChainPoint
    = (forall s. Decoder s (HeaderHash blk))
-> forall s. Decoder s (Point blk)
forall {k} (block :: k).
(forall s. Decoder s (HeaderHash block))
-> forall s. Decoder s (Point block)
decodePoint Decoder s (HeaderHash blk)
forall s. Decoder s (HeaderHash blk)
forall a s. Serialise a => Decoder s a
decode

instance SameDepIndex (BlockQuery blk) => SameDepIndex (Query blk) where
  sameDepIndex :: forall a b. Query blk a -> Query blk b -> Maybe (a :~: b)
sameDepIndex (BlockQuery BlockQuery blk a
blockQueryA) (BlockQuery BlockQuery blk b
blockQueryB)
    = BlockQuery blk a -> BlockQuery blk b -> Maybe (a :~: b)
forall a b. BlockQuery blk a -> BlockQuery blk b -> Maybe (a :~: b)
forall (f :: * -> *) a b.
SameDepIndex f =>
f a -> f b -> Maybe (a :~: b)
sameDepIndex BlockQuery blk a
blockQueryA BlockQuery blk b
blockQueryB
  sameDepIndex (BlockQuery BlockQuery blk a
_) Query blk b
_
    = Maybe (a :~: b)
forall a. Maybe a
Nothing
  sameDepIndex Query blk a
GetSystemStart Query blk b
GetSystemStart
    = (a :~: b) -> Maybe (a :~: b)
forall a. a -> Maybe a
Just a :~: a
a :~: b
forall {k} (a :: k). a :~: a
Refl
  sameDepIndex Query blk a
GetSystemStart Query blk b
_
    = Maybe (a :~: b)
forall a. Maybe a
Nothing
  sameDepIndex Query blk a
GetChainBlockNo Query blk b
GetChainBlockNo
    = (a :~: b) -> Maybe (a :~: b)
forall a. a -> Maybe a
Just a :~: a
a :~: b
forall {k} (a :: k). a :~: a
Refl
  sameDepIndex Query blk a
GetChainBlockNo Query blk b
_
    = Maybe (a :~: b)
forall a. Maybe a
Nothing
  sameDepIndex Query blk a
GetChainPoint Query blk b
GetChainPoint
    = (a :~: b) -> Maybe (a :~: b)
forall a. a -> Maybe a
Just a :~: a
a :~: b
forall {k} (a :: k). a :~: a
Refl
  sameDepIndex Query blk a
GetChainPoint Query blk b
_
    = Maybe (a :~: b)
forall a. Maybe a
Nothing

deriving instance Show (BlockQuery blk result) => Show (Query blk result)

-- | Answer the given query about the extended ledger state.
answerQuery ::
     (BlockSupportsLedgerQuery blk, ConfigSupportsNode blk, HasAnnTip blk)
  => ExtLedgerCfg blk
  -> Query blk result
  -> ExtLedgerState blk
  -> result
answerQuery :: forall blk result.
(BlockSupportsLedgerQuery blk, ConfigSupportsNode blk,
 HasAnnTip blk) =>
ExtLedgerCfg blk
-> Query blk result -> ExtLedgerState blk -> result
answerQuery ExtLedgerCfg blk
cfg Query blk result
query ExtLedgerState blk
st = case Query blk result
query of
  BlockQuery BlockQuery blk result
blockQuery -> ExtLedgerCfg blk
-> BlockQuery blk result -> ExtLedgerState blk -> result
forall result.
ExtLedgerCfg blk
-> BlockQuery blk result -> ExtLedgerState blk -> result
forall blk result.
BlockSupportsLedgerQuery blk =>
ExtLedgerCfg blk
-> BlockQuery blk result -> ExtLedgerState blk -> result
answerBlockQuery ExtLedgerCfg blk
cfg BlockQuery blk result
blockQuery ExtLedgerState blk
st
  Query blk result
GetSystemStart -> BlockConfig blk -> SystemStart
forall blk.
ConfigSupportsNode blk =>
BlockConfig blk -> SystemStart
getSystemStart (TopLevelConfig blk -> BlockConfig blk
forall blk. TopLevelConfig blk -> BlockConfig blk
topLevelConfigBlock (ExtLedgerCfg blk -> TopLevelConfig blk
forall blk. ExtLedgerCfg blk -> TopLevelConfig blk
getExtLedgerCfg ExtLedgerCfg blk
cfg))
  Query blk result
GetChainBlockNo -> HeaderState blk -> WithOrigin BlockNo
forall blk. HeaderState blk -> WithOrigin BlockNo
headerStateBlockNo (ExtLedgerState blk -> HeaderState blk
forall blk. ExtLedgerState blk -> HeaderState blk
headerState ExtLedgerState blk
st)
  Query blk result
GetChainPoint -> HeaderState blk -> Point blk
forall blk. HasAnnTip blk => HeaderState blk -> Point blk
headerStatePoint (ExtLedgerState blk -> HeaderState blk
forall blk. ExtLedgerState blk -> HeaderState blk
headerState ExtLedgerState blk
st)

-- | Different queries supported by the ledger, indexed by the result type.
data family BlockQuery blk :: Type -> Type

-- | Query the ledger extended state.
--
-- Used by the LocalStateQuery protocol to allow clients to query the extended
-- ledger state.
class (ShowQuery (BlockQuery blk), SameDepIndex (BlockQuery blk))
   => BlockSupportsLedgerQuery blk where

  -- | Answer the given query about the extended ledger state.
  answerBlockQuery ::
      ExtLedgerCfg blk
   -> BlockQuery blk result
   -> ExtLedgerState blk
   -> result

instance SameDepIndex (BlockQuery blk) => Eq (SomeSecond BlockQuery blk) where
  SomeSecond BlockQuery blk b
qry == :: SomeSecond BlockQuery blk -> SomeSecond BlockQuery blk -> Bool
== SomeSecond BlockQuery blk b
qry' = Maybe (b :~: b) -> Bool
forall a. Maybe a -> Bool
isJust (BlockQuery blk b -> BlockQuery blk b -> Maybe (b :~: b)
forall a b. BlockQuery blk a -> BlockQuery blk b -> Maybe (a :~: b)
forall (f :: * -> *) a b.
SameDepIndex f =>
f a -> f b -> Maybe (a :~: b)
sameDepIndex BlockQuery blk b
qry BlockQuery blk b
qry')

deriving instance (forall result. Show (BlockQuery blk result))
   => Show (SomeSecond BlockQuery blk)