{-# 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
  , queryIsSupportedOnNodeToClientVersion
  , querySupportedVersions
  ) 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 qualified Data.Map.Strict as Map
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.Abstract
import           Ouroboros.Consensus.Ledger.Extended
import           Ouroboros.Consensus.Ledger.Query.Version
import           Ouroboros.Consensus.Node.NetworkProtocolVersion
                     (BlockNodeToClientVersion, NodeToClientVersion,
                     SupportedNetworkProtocolVersion (supportedNodeToClientVersions))
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"
  Query blk result
GetLedgerConfig -> String
"GetLedgerConfig"

-- | 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)

  -- | Get the ledger config.
  --
  -- This constructor is supported by 'QueryVersion' >= 'QueryVersion3'.
  -- Serialisation of the @LedgerConfig blk@ result is versioned by the
  -- @BlockNodeToClientVersion blk@.
  GetLedgerConfig :: Query blk (LedgerConfig 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
  showResult Query blk result
GetLedgerConfig         = String -> result -> String
forall a b. a -> b -> a
const String
"LedgerConfig{..}"

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

  SomeSecond Query blk b
GetLedgerConfig == SomeSecond Query blk b
GetLedgerConfig = Bool
True
  SomeSecond Query blk b
GetLedgerConfig == 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"
  show (SomeSecond Query blk b
GetLedgerConfig)           = String
"Query GetLedgerConfig"

queryIsSupportedOnNodeToClientVersion ::
     forall blk result.
     (SupportedNetworkProtocolVersion blk, BlockSupportsLedgerQuery blk)
  => Query blk result
  -> NodeToClientVersion
  -> Bool
queryIsSupportedOnNodeToClientVersion :: forall blk result.
(SupportedNetworkProtocolVersion blk,
 BlockSupportsLedgerQuery blk) =>
Query blk result -> NodeToClientVersion -> Bool
queryIsSupportedOnNodeToClientVersion Query blk result
q NodeToClientVersion
ntc =
  case Proxy blk -> Map NodeToClientVersion (BlockNodeToClientVersion blk)
forall blk.
SupportedNetworkProtocolVersion blk =>
Proxy blk -> Map NodeToClientVersion (BlockNodeToClientVersion blk)
supportedNodeToClientVersions (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @blk) Map NodeToClientVersion (BlockNodeToClientVersion blk)
-> NodeToClientVersion -> Maybe (BlockNodeToClientVersion blk)
forall k a. Ord k => Map k a -> k -> Maybe a
Map.!? NodeToClientVersion
ntc of
    Maybe (BlockNodeToClientVersion blk)
Nothing -> Bool
False
    Just BlockNodeToClientVersion blk
bv -> Query blk result
-> QueryVersion -> BlockNodeToClientVersion blk -> Bool
forall blk result.
BlockSupportsLedgerQuery blk =>
Query blk result
-> QueryVersion -> BlockNodeToClientVersion blk -> Bool
queryIsSupportedOnVersion Query blk result
q QueryVersion
qv BlockNodeToClientVersion blk
bv
  where
    qv :: QueryVersion
qv = NodeToClientVersion -> QueryVersion
nodeToClientVersionToQueryVersion NodeToClientVersion
ntc

queryIsSupportedOnVersion ::
     BlockSupportsLedgerQuery blk
  => Query blk result
  -> QueryVersion
  -> BlockNodeToClientVersion blk
  -> Bool
queryIsSupportedOnVersion :: forall blk result.
BlockSupportsLedgerQuery blk =>
Query blk result
-> QueryVersion -> BlockNodeToClientVersion blk -> Bool
queryIsSupportedOnVersion Query blk result
q QueryVersion
qv BlockNodeToClientVersion blk
bv = case Query blk result
q of
      BlockQuery BlockQuery blk result
q'     -> QueryVersion
qv QueryVersion -> QueryVersion -> Bool
forall a. Ord a => a -> a -> Bool
>= QueryVersion
QueryVersion1 Bool -> Bool -> Bool
&& BlockQuery blk result -> BlockNodeToClientVersion blk -> Bool
forall blk result.
BlockSupportsLedgerQuery blk =>
BlockQuery blk result -> BlockNodeToClientVersion blk -> Bool
forall result.
BlockQuery blk result -> BlockNodeToClientVersion blk -> Bool
blockQueryIsSupportedOnVersion BlockQuery blk result
q' BlockNodeToClientVersion blk
bv
      GetSystemStart{}  -> QueryVersion
qv QueryVersion -> QueryVersion -> Bool
forall a. Ord a => a -> a -> Bool
>= QueryVersion
QueryVersion1
      GetChainBlockNo{} -> QueryVersion
qv QueryVersion -> QueryVersion -> Bool
forall a. Ord a => a -> a -> Bool
>= QueryVersion
QueryVersion2
      GetChainPoint{}   -> QueryVersion
qv QueryVersion -> QueryVersion -> Bool
forall a. Ord a => a -> a -> Bool
>= QueryVersion
QueryVersion2
      GetLedgerConfig{} -> QueryVersion
qv QueryVersion -> QueryVersion -> Bool
forall a. Ord a => a -> a -> Bool
>= QueryVersion
QueryVersion3

querySupportedVersions ::
     forall blk result.
     (SupportedNetworkProtocolVersion blk, BlockSupportsLedgerQuery blk)
  => Query blk result
  -> [NodeToClientVersion]
querySupportedVersions :: forall blk result.
(SupportedNetworkProtocolVersion blk,
 BlockSupportsLedgerQuery blk) =>
Query blk result -> [NodeToClientVersion]
querySupportedVersions Query blk result
q =
  [ NodeToClientVersion
v | NodeToClientVersion
v <- [NodeToClientVersion
forall a. Bounded a => a
minBound..NodeToClientVersion
forall a. Bounded a => a
maxBound]
      , Query blk result -> NodeToClientVersion -> Bool
forall blk result.
(SupportedNetworkProtocolVersion blk,
 BlockSupportsLedgerQuery blk) =>
Query blk result -> NodeToClientVersion -> Bool
queryIsSupportedOnNodeToClientVersion Query blk result
q NodeToClientVersion
v
  ]

-- | 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
         (BlockNodeToClientVersion blk)

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

queryEncodeNodeToClient ::
     forall blk.
     (Typeable blk, BlockSupportsLedgerQuery blk, Show (BlockNodeToClientVersion blk))
  => Show (SomeSecond BlockQuery blk)
  => SerialiseNodeToClient blk (SomeSecond BlockQuery blk)
  => CodecConfig blk
  -> QueryVersion
  -> BlockNodeToClientVersion blk
  -> SomeSecond Query blk
  -> Encoding
queryEncodeNodeToClient :: forall blk.
(Typeable blk, BlockSupportsLedgerQuery blk,
 Show (BlockNodeToClientVersion 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)
  = Query blk b -> Encoding -> Encoding
forall result a. Query blk result -> a -> a
requireVersion Query blk b
query (Encoding -> Encoding) -> Encoding -> Encoding
forall a b. (a -> b) -> a -> b
$ case Query blk b
query of
      BlockQuery BlockQuery blk b
blockQuery ->
        [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 ->
        [Encoding] -> Encoding
forall a. Monoid a => [a] -> a
mconcat
          [ Word -> Encoding
encodeListLen Word
1
          , Word8 -> Encoding
encodeWord8 Word8
1
          ]

      Query blk b
GetChainBlockNo ->
        [Encoding] -> Encoding
forall a. Monoid a => [a] -> a
mconcat
          [ Word -> Encoding
encodeListLen Word
1
          , Word8 -> Encoding
encodeWord8 Word8
2
          ]

      Query blk b
GetChainPoint ->
        [Encoding] -> Encoding
forall a. Monoid a => [a] -> a
mconcat
          [ Word -> Encoding
encodeListLen Word
1
          , Word8 -> Encoding
encodeWord8 Word8
3
          ]

      Query blk b
GetLedgerConfig ->
        [Encoding] -> Encoding
forall a. Monoid a => [a] -> a
mconcat
          [ Word -> Encoding
encodeListLen Word
1
          , Word8 -> Encoding
encodeWord8 Word8
4
          ]
  where
    requireVersion :: Query blk result -> a -> a
    requireVersion :: forall result a. Query blk result -> a -> a
requireVersion Query blk result
q a
a =
      if Query blk result
-> QueryVersion -> BlockNodeToClientVersion blk -> Bool
forall blk result.
BlockSupportsLedgerQuery blk =>
Query blk result
-> QueryVersion -> BlockNodeToClientVersion blk -> Bool
queryIsSupportedOnVersion Query blk result
q QueryVersion
queryVersion BlockNodeToClientVersion blk
blockVersion
        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
-> BlockNodeToClientVersion blk
-> QueryEncoderException blk
forall blk.
SomeSecond Query blk
-> QueryVersion
-> BlockNodeToClientVersion blk
-> 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 BlockNodeToClientVersion blk
blockVersion

    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
      QueryVersion
QueryVersion3 -> 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
1, Word8
4) -> QueryVersion
-> SomeSecond Query blk -> Decoder s (SomeSecond Query blk)
forall s.
QueryVersion
-> SomeSecond Query blk -> Decoder s (SomeSecond Query blk)
requireVersion QueryVersion
QueryVersion3 (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 (LedgerCfg (LedgerState blk)) -> SomeSecond Query blk
forall {k1} {k2} (f :: k1 -> k2 -> *) (a :: k1) (b :: k2).
f a b -> SomeSecond f a
SomeSecond Query blk (LedgerCfg (LedgerState blk))
forall blk. Query blk (LedgerConfig blk)
GetLedgerConfig
          (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)
         , SerialiseNodeToClient blk (LedgerConfig 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
  encodeResult CodecConfig blk
codecConfig BlockNodeToClientVersion blk
blockVersion Query blk result
GetLedgerConfig result
result
    = CodecConfig blk
-> BlockNodeToClientVersion blk -> result -> Encoding
forall blk a.
SerialiseNodeToClient blk a =>
CodecConfig blk -> BlockNodeToClientVersion blk -> a -> Encoding
encodeNodeToClient CodecConfig blk
codecConfig BlockNodeToClientVersion blk
blockVersion result
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
  decodeResult CodecConfig blk
codecConfig BlockNodeToClientVersion blk
blockVersion Query blk result
GetLedgerConfig
    = forall blk a.
SerialiseNodeToClient blk a =>
CodecConfig blk
-> BlockNodeToClientVersion blk -> forall s. Decoder s a
decodeNodeToClient @blk @(LedgerConfig blk) CodecConfig blk
codecConfig BlockNodeToClientVersion blk
blockVersion

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
  sameDepIndex Query blk a
GetLedgerConfig Query blk b
GetLedgerConfig
    = (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
GetLedgerConfig 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)
  Query blk result
GetLedgerConfig -> TopLevelConfig blk -> LedgerCfg (LedgerState blk)
forall blk. TopLevelConfig blk -> LedgerConfig blk
topLevelConfigLedger (ExtLedgerCfg blk -> TopLevelConfig blk
forall blk. ExtLedgerCfg blk -> TopLevelConfig blk
getExtLedgerCfg ExtLedgerCfg blk
cfg)

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

  -- | Is the given query supported in this NTC version?
  --
  -- Encoders for queries should call this function before attempting to send a
  -- query. The node will still try to answer block queries it knows about even
  -- if they are not guaranteed to be supported on the negotiated version, but
  -- clients can benefit of knowing beforehand whether the query is expected to
  -- not work, even if it decides to send it anyways.
  --
  -- More reasoning on how queries are versioned in Consensus can be seen in
  -- https://ouroboros-consensus.cardano.intersectmbo.org/docs/for-developers/QueryVersioning/. In
  -- particular this function implements the check described in
  -- https://ouroboros-consensus.cardano.intersectmbo.org/docs/for-developers/QueryVersioning/#checks.
  blockQueryIsSupportedOnVersion :: BlockQuery blk result -> BlockNodeToClientVersion blk -> Bool

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)