Local State Query protocol uses top level Query type instead of Block…

…Query directly

ouroboros-consensus-cardano/src/Ouroboros/Consensus/Cardano/ByronHFC.hs

@@ -19,7 +19,6 @@ import           Ouroboros.Consensus.HardFork.Combinator.Serialisation.Common
 import           Ouroboros.Consensus.Byron.Ledger
 import           Ouroboros.Consensus.Byron.Node ()
 
-import           Ouroboros.Consensus.Cardano.CanHardFork
 import           Ouroboros.Consensus.Cardano.Node ()
 
 {-------------------------------------------------------------------------------

ouroboros-consensus-test/src/Test/Util/Serialisation/Roundtrip.hs

@@ -50,7 +50,7 @@ import           Ouroboros.Consensus.Block
 import           Ouroboros.Consensus.HeaderValidation (AnnTip)
 import           Ouroboros.Consensus.Ledger.Abstract (LedgerState)
 import           Ouroboros.Consensus.Ledger.Query (BlockQuery, Query (..),
-                     QueryVersion)
+                     QueryVersion, queryDecodeNodeToClient, queryEncodeNodeToClient)
 import qualified Ouroboros.Consensus.Ledger.Query as Query
 import           Ouroboros.Consensus.Ledger.SupportsMempool (ApplyTxErr, GenTx,
                      GenTxId)
@@ -121,8 +121,8 @@ roundtrip_all
      , SerialiseNodeToNodeConstraints   blk
      , SerialiseNodeToClientConstraints blk
 
-     , Show (BlockNodeToNodeVersion   blk)
-     , Show (BlockNodeToClientVersion blk)
+    , Show (BlockNodeToNodeVersion   blk)
+    , Show (BlockNodeToClientVersion blk)
 
      , StandardHash blk
      , GetHeader    blk
@@ -382,6 +382,9 @@ roundtrip_SerialiseNodeToClient ccfg =
                           blockVersion
         )
         "Query"
+    -- , rtWith (Proxy @(SomeSecond Query blk))  "Query"
+    --                                           (queryEncodeNodeToClient ccfg maxBound)
+    --                                           (queryDecodeNodeToClient ccfg maxBound)
       -- See roundtrip_SerialiseNodeToNode for more info
     , testProperty "roundtrip Serialised blk" $
         \(WithVersion version blk) ->
@@ -434,6 +437,20 @@ roundtrip_SerialiseNodeToClient ccfg =
        -> String
        -> TestTree
     rtWith enc' dec' name =
+    -- rt p name = rtWith p name enc dec
+
+    -- rtWith
+    --   :: forall a.
+    --      ( Arbitrary (WithVersion (BlockNodeToClientVersion blk) a)
+    --      , Eq a
+    --      , Show a
+    --      )
+    --    => Proxy a
+    --    -> String
+    --    -> (BlockNodeToClientVersion blk -> a -> Encoding)
+    --    -> (BlockNodeToClientVersion blk -> forall s. Decoder s a)
+    --    -> TestTree
+    -- rtWith _ name enc' dec' =
       testProperty ("roundtrip " <> name) $
         \(WithVersion version a) ->
           roundtrip @a (enc' version) (dec' version) a

ouroboros-consensus/src/Ouroboros/Consensus/HardFork/Combinator/Serialisation/SerialiseNodeToClient.hs

@@ -11,6 +11,7 @@
 {-# LANGUAGE ScopedTypeVariables   #-}
 {-# LANGUAGE TypeApplications      #-}
 {-# LANGUAGE TypeOperators         #-}
+{-# LANGUAGE UndecidableInstances  #-}
 
 {-# OPTIONS_GHC -Wno-orphans #-}
 

ouroboros-consensus/src/Ouroboros/Consensus/Ledger/Query.hs

@@ -19,6 +19,8 @@ module Ouroboros.Consensus.Ledger.Query (
   , nodeToClientVersionToQueryVersion
   , queryDecodeNodeToClient
   , queryEncodeNodeToClient
+  , queryEncodeResult
+  , queryDecodeResult
   ) where
 
 import           Codec.CBOR.Decoding
@@ -35,7 +37,7 @@ import           Ouroboros.Consensus.HardFork.Combinator.PartialConfig
 import           Ouroboros.Consensus.Ledger.Extended
 import           Ouroboros.Consensus.Ledger.Query.Version
 import           Ouroboros.Consensus.Node.NetworkProtocolVersion
-                     (BlockNodeToClientVersion)
+                     (BlockNodeToClientVersion, NodeToClientVersion(..), HasNetworkProtocolVersion (..))
 import           Ouroboros.Consensus.Node.Serialisation
                      (SerialiseNodeToClient (..), SerialiseResult (..))
 import           Ouroboros.Consensus.Util (ShowProxy (..), SomeSecond (..))
@@ -113,17 +115,6 @@ queryDecodeNodeToClient codecConfig queryVersion blockVersion
         blockVersion
       return (SomeSecond (BlockQuery blockQuery))
 
-instance ( SerialiseResult blk (BlockQuery blk)
-         , SerialiseNodeToClient blk (PartialLedgerConfig blk)
-         ) => SerialiseResult blk (Query blk) where
-  encodeResult codecConfig blockVersion query result = case query of
-    BlockQuery blockQuery -> encodeResult codecConfig blockVersion blockQuery result
-    GetPartialLedgerConfig -> encodeNodeToClient codecConfig blockVersion result
-
-  decodeResult codecConfig blockVersion query = case query of
-    BlockQuery blockQuery -> decodeResult codecConfig blockVersion blockQuery
-    GetPartialLedgerConfig -> decodeNodeToClient codecConfig blockVersion
-
 instance SerialiseNodeToClient blk (SomeSecond BlockQuery blk) => SerialiseNodeToClient blk (SomeSecond Query blk) where
   encodeNodeToClient codecConfig blockVersion (SomeSecond query)
     = case query of
@@ -150,6 +141,53 @@ instance SerialiseNodeToClient blk (SomeSecond BlockQuery blk) => SerialiseNodeT
       1 -> return (SomeSecond GetPartialLedgerConfig)
       _ -> fail $ "SomeSecond Query blk: unknown tag " ++ show tag
 
+instance ( SerialiseResult blk (BlockQuery blk)
+         , SerialiseNodeToClient blk (PartialLedgerConfig blk)
+         ) => SerialiseResult blk (Query blk) where
+  encodeResult codecConfig blockVersion query result = case query of
+    BlockQuery blockQuery -> encodeResult codecConfig blockVersion blockQuery result
+    GetPartialLedgerConfig -> encodeNodeToClient codecConfig blockVersion result
+
+  decodeResult codecConfig blockVersion query = case query of
+    BlockQuery blockQuery -> decodeResult codecConfig blockVersion blockQuery
+    GetPartialLedgerConfig -> decodeNodeToClient codecConfig blockVersion
+
+queryEncodeResult ::
+     forall blk result. SerialiseResult blk (BlockQuery blk)
+  => CodecConfig blk
+  -> NodeToClientVersion
+  -> BlockNodeToClientVersion blk
+  -> Query blk result
+  -> result
+  -> Encoding
+queryEncodeResult codecConfig version blockNodeToClientVersion query result
+  | not (version >= NodeToClientV_9)
+  = error $ "encode failure: Serializing Query result is not supported (on node to client version: " ++ show version ++ ")"
+  | otherwise
+  = case query of
+      BlockQuery blockQuery ->
+        encodeTag 0
+        <> encodeResult codecConfig blockNodeToClientVersion blockQuery result
+      GetPartialLedgerConfig ->
+        encodeTag 1
+
+queryDecodeResult ::
+     forall blk result. SerialiseResult blk (BlockQuery blk)
+  => CodecConfig blk
+  -> NodeToClientVersion
+  -> BlockNodeToClientVersion blk
+  -> Query blk result
+  -> forall s. Decoder s result
+queryDecodeResult codecConfig version blockNodeToClientVersion query
+  | not (version >= NodeToClientV_9)
+  = error $ "encode failure: Deserializing Query result is not supported (on node to client version: " ++ show version ++ ")"
+  | otherwise
+  = do
+    tag <- decodeTag
+    case (tag, query) of
+      (0, BlockQuery blockQuery) -> decodeResult codecConfig blockNodeToClientVersion blockQuery
+      _ -> fail $ "Query blk: " ++ show tag ++ " but does not match query"
+
 instance SameDepIndex (BlockQuery blk) => SameDepIndex (Query blk) where
   sameDepIndex (BlockQuery blockQueryA) (BlockQuery blockQueryB)
     = sameDepIndex blockQueryA blockQueryB

ouroboros-consensus/src/Ouroboros/Consensus/Network/NodeToClient.hs

@@ -196,6 +196,10 @@ defaultCodecs ccfg version networkVersion = Codecs {
           ((\(SomeSecond qry) -> Some qry) <$> queryDecodeNodeToClient ccfg queryVersion version)
           (encodeResult ccfg version)
           (decodeResult ccfg version)
+          -- (queryEncodeNodeToClient ccfg networkVersion version . SomeSecond)
+          -- ((\(SomeSecond qry) -> Some qry) <$> queryDecodeNodeToClient ccfg networkVersion version)
+          -- (queryEncodeResult ccfg networkVersion version)
+          -- (queryDecodeResult ccfg networkVersion version)
     }
   where
     queryVersion :: QueryVersion
@@ -248,6 +252,10 @@ clientCodecs ccfg version networkVersion = Codecs {
           ((\(SomeSecond qry) -> Some qry) <$> queryDecodeNodeToClient ccfg queryVersion version)
           (encodeResult ccfg version)
           (decodeResult ccfg version)
+          -- (queryEncodeNodeToClient ccfg networkVersion version . SomeSecond)
+          -- ((\(SomeSecond qry) -> Some qry) <$> queryDecodeNodeToClient ccfg networkVersion version)
+          -- (queryEncodeResult ccfg networkVersion version)
+          -- (queryDecodeResult ccfg networkVersion version)
     }
   where
     queryVersion :: QueryVersion

ouroboros-network/src/Ouroboros/Network/NodeToClient/Version.hs

@@ -4,8 +4,8 @@
 module Ouroboros.Network.NodeToClient.Version
   ( NodeToClientVersion (..)
   , NodeToClientVersionData (..)
-  , nodeToClientVersionCodec
   , nodeToClientCodecCBORTerm
+  , nodeToClientVersionCodec
   ) where
 
 import           Data.Bits (clearBit, setBit, testBit)
@@ -41,6 +41,8 @@ data NodeToClientVersion
     -- ^ 'LocalStateQuery' protocol codec change, allows to acquire tip point.
     | NodeToClientV_9
     -- ^ enabled @CardanoNodeToClientVersion7@, i.e., Alonzo
+    -- 'LocalStateQuery' protocol codec change, queries are now
+    -- wrapped in a top level 'Query blk' Type.
   deriving (Eq, Ord, Enum, Bounded, Show, Typeable)
 
 -- | We set 16ths bit to distinguish `NodeToNodeVersion` and