Add new GetChainBlockNo and GetChainPoint queries

This patch adds a supported node to client version `NodeToClientV_10` with new
queries:

- `GetChainBlockNo`: Get the chain block number
- `GetChainPoint`: Get the chain point, which includes the slot number and

ouroboros-consensus-cardano-test/test/golden/QueryVersion2/CardanoNodeToClientVersion7/Result_Allegra_EpochNo

@@ -0,0 +1 @@
+�

ouroboros-consensus-cardano-test/test/golden/QueryVersion2/CardanoNodeToClientVersion7/Result_Allegra_LedgerTip

@@ -0,0 +1 @@
+��	X �TF����b�Nެ�K��wy�=�Th�|Y

ouroboros-consensus-cardano-test/test/golden/QueryVersion2/CardanoNodeToClientVersion7/Result_Allegra_ProposedPParamsUpdates

@@ -0,0 +1 @@
+��X��ts.���?9Z�E����P#��2�d

ouroboros-consensus-cardano-test/test/golden/QueryVersion2/CardanoNodeToClientVersion7/Result_Allegra_StakeDistribution

@@ -0,0 +1 @@
+��X�1���s��]k?�ժ�P�[{%A��

X �����-�ò^46���R�>Žb�{L

ouroboros-consensus-cardano-test/test/golden/QueryVersion2/CardanoNodeToClientVersion7/Result_Alonzo_EpochNo

@@ -0,0 +1 @@
+�

ouroboros-consensus-cardano-test/test/golden/QueryVersion2/CardanoNodeToClientVersion7/Result_Alonzo_LedgerTip

@@ -0,0 +1 @@
+��	X ����8����o�fo&&���&n�s�s$&�

ouroboros-consensus-cardano-test/test/golden/QueryVersion2/CardanoNodeToClientVersion7/Result_Alonzo_ProposedPParamsUpdates

@@ -0,0 +1 @@
+��X��ts.���?9Z�E����P#��2��

ouroboros-consensus-cardano-test/test/golden/QueryVersion2/CardanoNodeToClientVersion7/Result_Alonzo_StakeDistribution

@@ -0,0 +1 @@
+��X�1���s��]k?�ժ�P�[{%A��

X �����-�ò^46���R�>Žb�{L

ouroboros-consensus-cardano-test/test/golden/QueryVersion2/CardanoNodeToClientVersion7/Result_Mary_EpochNo

@@ -0,0 +1 @@
+�

ouroboros-consensus-cardano-test/test/golden/QueryVersion2/CardanoNodeToClientVersion7/Result_Mary_LedgerTip

@@ -0,0 +1 @@
+��	X ��E<���p���2W@Y��rJt=&��v��j

ouroboros-consensus-cardano-test/test/golden/QueryVersion2/CardanoNodeToClientVersion7/Result_Mary_ProposedPParamsUpdates

@@ -0,0 +1 @@
+��X��ts.���?9Z�E����P#��2�d

ouroboros-consensus-cardano-test/test/golden/QueryVersion2/CardanoNodeToClientVersion7/Result_Mary_StakeDistribution

@@ -0,0 +1 @@
+��X�1���s��]k?�ժ�P�[{%A��

X �����-�ò^46���R�>Žb�{L

ouroboros-consensus-cardano-test/test/golden/QueryVersion2/CardanoNodeToClientVersion7/Result_Shelley_EpochNo

@@ -0,0 +1 @@
+�

ouroboros-consensus-cardano-test/test/golden/QueryVersion2/CardanoNodeToClientVersion7/Result_Shelley_LedgerTip

@@ -0,0 +1 @@
+��	X ��� u��'9Ki�(�׺y���C����)�l

ouroboros-consensus-cardano-test/test/golden/QueryVersion2/CardanoNodeToClientVersion7/Result_Shelley_ProposedPParamsUpdates

@@ -0,0 +1 @@
+��X��ts.���?9Z�E����P#��2�d

ouroboros-consensus-cardano-test/test/golden/QueryVersion2/CardanoNodeToClientVersion7/Result_Shelley_StakeDistribution

@@ -0,0 +1 @@
+��X�1���s��]k?�ժ�P�[{%A��

X �����-�ò^46���R�>Žb�{L

ouroboros-consensus-cardano-test/test/golden/QueryVersion2/CardanoNodeToClientVersion7/SerialisedBlock_Allegra

@@ -0,0 +1 @@
+�O<CARDANO_BLOCK>

ouroboros-consensus-cardano-test/test/golden/QueryVersion2/CardanoNodeToClientVersion7/SerialisedBlock_Alonzo

@@ -0,0 +1 @@
+�O<CARDANO_BLOCK>

ouroboros-consensus-cardano-test/test/golden/QueryVersion2/CardanoNodeToClientVersion7/SerialisedBlock_Byron_EBB

@@ -0,0 +1 @@
+�O<CARDANO_BLOCK>

ouroboros-consensus-cardano-test/test/golden/QueryVersion2/CardanoNodeToClientVersion7/SerialisedBlock_Byron_regular

@@ -0,0 +1 @@
+�O<CARDANO_BLOCK>

ouroboros-consensus-cardano-test/test/golden/QueryVersion2/CardanoNodeToClientVersion7/SerialisedBlock_Mary

@@ -0,0 +1 @@
+�O<CARDANO_BLOCK>

ouroboros-consensus-cardano-test/test/golden/QueryVersion2/CardanoNodeToClientVersion7/SerialisedBlock_Shelley

@@ -0,0 +1 @@
+�O<CARDANO_BLOCK>

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

@@ -374,18 +374,19 @@ instance CardanoHardForkConstraints c
       ]
 
   supportedNodeToClientVersions _ = Map.fromList $
-      [ (NodeToClientV_1, CardanoNodeToClientVersion1)
-      , (NodeToClientV_2, CardanoNodeToClientVersion1)
-      , (NodeToClientV_3, CardanoNodeToClientVersion2)
-      , (NodeToClientV_4, CardanoNodeToClientVersion3)
-      , (NodeToClientV_5, CardanoNodeToClientVersion4)
-      , (NodeToClientV_6, CardanoNodeToClientVersion5)
-      , (NodeToClientV_7, CardanoNodeToClientVersion6)
-      , (NodeToClientV_8, CardanoNodeToClientVersion6)
-      , (NodeToClientV_9, CardanoNodeToClientVersion7)
+      [ (NodeToClientV_1 , CardanoNodeToClientVersion1)
+      , (NodeToClientV_2 , CardanoNodeToClientVersion1)
+      , (NodeToClientV_3 , CardanoNodeToClientVersion2)
+      , (NodeToClientV_4 , CardanoNodeToClientVersion3)
+      , (NodeToClientV_5 , CardanoNodeToClientVersion4)
+      , (NodeToClientV_6 , CardanoNodeToClientVersion5)
+      , (NodeToClientV_7 , CardanoNodeToClientVersion6)
+      , (NodeToClientV_8 , CardanoNodeToClientVersion6)
+      , (NodeToClientV_9 , CardanoNodeToClientVersion7)
+      , (NodeToClientV_10, CardanoNodeToClientVersion7)
       ]
 
-  latestReleasedNodeVersion _prx = (Just NodeToNodeV_7, Just NodeToClientV_9)
+  latestReleasedNodeVersion _prx = (Just NodeToNodeV_7, Just NodeToClientV_10)
 
 {-------------------------------------------------------------------------------
   ProtocolInfo

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

@@ -228,17 +228,34 @@ instance ( blockVersion ~ BlockNodeToClientVersion blk
       -- This case statement will cause a warning when we add a new top
       -- level query and hence a new QueryVersion. In that case we should
       -- support such top level `Query` constructors in this Arbitrary instance.
-      Query.TopLevelQueryDisabled ->
-        arbitraryBlockQuery queryVersion
-
-      Query.QueryVersion1 ->
-        frequency
-          [ (15, arbitraryBlockQuery queryVersion)
-          , (1,  do blockV <- arbitrary
-                    return (WithVersion (queryVersion, blockV)
-                                        (SomeSecond GetSystemStart)))
-          ]
+      Query.TopLevelQueryDisabled -> arbitraryBlockQuery queryVersion
+      Query.QueryVersion1         -> genTopLevelQuery1
+      Query.QueryVersion2         -> genTopLevelQuery2
     where
+      mkEntry :: QueryVersion
+        -> Query blk query
+        -> Gen
+            (WithVersion (QueryVersion, blockVersion) (SomeSecond Query blk))
+      mkEntry qv q = do
+        blockV <- arbitrary
+        return (WithVersion (qv, blockV) (SomeSecond q))
+
+      genTopLevelQuery1 =
+        let version = Query.QueryVersion1
+        in  frequency
+              [ (15, arbitraryBlockQuery version    )
+              , (1 , mkEntry version GetSystemStart )
+              ]
+
+      genTopLevelQuery2 =
+        let version = Query.QueryVersion2
+        in  frequency
+              [ (15, arbitraryBlockQuery version    )
+              , (1 , mkEntry version GetSystemStart )
+              , (1 , mkEntry version GetChainBlockNo)
+              , (1 , mkEntry version GetChainPoint  )
+              ]
+
       arbitraryBlockQuery :: QueryVersion
                           -> Gen (WithVersion (QueryVersion, blockVersion)
                                               (SomeSecond Query blk))

ouroboros-consensus/docs/interface-CHANGELOG.md

@@ -56,6 +56,15 @@ may appear out of chronological order.
 The internals of each entry are organized similar to
 https://keepachangelog.com/en/1.1.0/, adapted to our plan explained above.
 
+## Circa 2021-09-22
+
+### Added
+
+- New supported node to client version `NodeToClientV_10` with new queries:
+  - `GetChainBlockNo`: Get the chain block number
+  - `GetChainPoint`: Get the chain point, which includes the slot number and
+    header hash.
+
 ## Circa 2021-08-31
 
 ### Added

ouroboros-consensus/src/Ouroboros/Consensus/HeaderValidation.hs

@@ -31,6 +31,7 @@ module Ouroboros.Consensus.HeaderValidation (
   , HeaderState (..)
   , castHeaderState
   , genesisHeaderState
+  , headerStateBlockNo
   , headerStatePoint
   , tickHeaderState
     -- * Validate header envelope
@@ -200,6 +201,9 @@ tickHeaderState cfg ledgerView slot HeaderState {..} = TickedHeaderState {
 genesisHeaderState :: ChainDepState (BlockProtocol blk) -> HeaderState blk
 genesisHeaderState = HeaderState Origin
 
+headerStateBlockNo :: HeaderState blk -> WithOrigin BlockNo
+headerStateBlockNo = fmap annTipBlockNo . headerStateTip
+
 headerStatePoint :: HasAnnTip blk => HeaderState blk -> Point blk
 headerStatePoint =
       withOriginRealPointToPoint

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

@@ -28,16 +28,25 @@ import           Data.Maybe (isJust)
 import           Data.Typeable (Typeable)
 
 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           Ouroboros.Network.Block (HeaderHash, Point (..), StandardHash,
+                     decodePoint, encodePoint)
 import           Ouroboros.Network.Protocol.LocalStateQuery.Type
                      (ShowQuery (..))
 
 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
@@ -51,6 +60,13 @@ import           Ouroboros.Consensus.Util.DepPair
   Queries
 -------------------------------------------------------------------------------}
 
+queryName :: Query blk result -> String
+queryName query = case query of
+  BlockQuery _    -> "BlockQuery"
+  GetSystemStart  -> "GetSystemStart"
+  GetChainBlockNo -> "GetChainBlockNo"
+  GetChainPoint   -> "GetChainPoint"
+
 -- | Different queries supported by the ledger for all block types, indexed
 -- by the result type.
 --
@@ -65,12 +81,24 @@ data Query blk result where
   -- 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 :: Proxy (Query blk)) = "Query (" ++ showProxy (Proxy @(BlockQuery blk)) ++ ")"
 
-instance (ShowQuery (BlockQuery blk)) => ShowQuery (Query blk) where
+instance (ShowQuery (BlockQuery blk), StandardHash blk) => ShowQuery (Query blk) where
   showResult (BlockQuery blockQuery) = showResult blockQuery
   showResult GetSystemStart          = show
+  showResult GetChainBlockNo         = show
+  showResult GetChainPoint           = show
 
 instance Eq (SomeSecond BlockQuery blk) => Eq (SomeSecond Query blk) where
   SomeSecond (BlockQuery blockQueryA) == SomeSecond (BlockQuery blockQueryB)
@@ -80,9 +108,17 @@ instance Eq (SomeSecond BlockQuery blk) => Eq (SomeSecond Query blk) where
   SomeSecond GetSystemStart == SomeSecond GetSystemStart = True
   SomeSecond GetSystemStart == _                         = False
 
+  SomeSecond GetChainBlockNo == SomeSecond GetChainBlockNo  = True
+  SomeSecond GetChainBlockNo == _                           = False
+
+  SomeSecond GetChainPoint == SomeSecond GetChainPoint  = True
+  SomeSecond GetChainPoint == _                         = False
+
 instance Show (SomeSecond BlockQuery blk) => Show (SomeSecond Query blk) where
-  show (SomeSecond (BlockQuery blockQueryA)) = "Query " ++ show (SomeSecond blockQueryA)
-  show (SomeSecond GetSystemStart) = "Query GetSystemStart"
+  show (SomeSecond (BlockQuery blockQueryA))  = "Query " ++ show (SomeSecond blockQueryA)
+  show (SomeSecond GetSystemStart)            = "Query GetSystemStart"
+  show (SomeSecond GetChainBlockNo)           = "Query GetChainBlockNo"
+  show (SomeSecond GetChainPoint)             = "Query GetChainPoint"
 
 
 -- | Exception thrown in the encoders
@@ -118,16 +154,40 @@ queryEncodeNodeToClient codecConfig queryVersion blockVersion (SomeSecond query)
           throw $ QueryEncoderUnsupportedQuery (SomeSecond query) queryVersion
 
     -- From version 1 onwards, we use normal constructor tags
-    QueryVersion1 ->
+    _ ->
       case query of
         BlockQuery blockQuery ->
-            encodeListLen 2
-         <> encodeWord8 0
-         <> encodeBlockQuery blockQuery
+          requireVersion QueryVersion1 $ mconcat
+            [ encodeListLen 2
+            , encodeWord8 0
+            , encodeBlockQuery blockQuery
+            ]
+
         GetSystemStart ->
-            encodeListLen 1
-         <> encodeWord8 1
+          requireVersion QueryVersion1 $ mconcat
+            [ encodeListLen 1
+            , encodeWord8 1
+            ]
+
+        GetChainBlockNo ->
+          requireVersion QueryVersion2 $ mconcat
+            [ encodeListLen 1
+            , encodeWord8 2
+            ]
+
+        GetChainPoint ->
+          requireVersion QueryVersion2 $ mconcat
+            [ encodeListLen 1
+            , encodeWord8 3
+            ]
+
   where
+    requireVersion :: QueryVersion -> a -> a
+    requireVersion expectedVersion a =
+      if queryVersion >= expectedVersion
+        then a
+        else throw $ QueryEncoderUnsupportedQuery (SomeSecond query) queryVersion
+
     encodeBlockQuery blockQuery =
       encodeNodeToClient
         @blk
@@ -146,14 +206,28 @@ queryDecodeNodeToClient ::
 queryDecodeNodeToClient codecConfig queryVersion blockVersion
   = case queryVersion of
       TopLevelQueryDisabled -> decodeBlockQuery
-      QueryVersion1 -> do
+      QueryVersion1         -> handleTopLevelQuery
+      QueryVersion2         -> handleTopLevelQuery
+  where
+    handleTopLevelQuery :: Decoder s (SomeSecond Query blk)
+    handleTopLevelQuery = do
         size <- decodeListLen
         tag  <- decodeWord8
         case (size, tag) of
-          (2, 0) -> decodeBlockQuery
-          (1, 1) -> return (SomeSecond GetSystemStart)
+          (2, 0) -> requireVersion QueryVersion1 =<< decodeBlockQuery
+          (1, 1) -> requireVersion QueryVersion1 $ SomeSecond GetSystemStart
+          (1, 2) -> requireVersion QueryVersion2 $ SomeSecond GetChainBlockNo
+          (1, 3) -> requireVersion QueryVersion2 $ SomeSecond GetChainPoint
           _      -> fail $ "Query: invalid size and tag" <> show (size, tag)
-  where
+
+    requireVersion :: QueryVersion -> SomeSecond Query blk -> Decoder s (SomeSecond Query blk)
+    requireVersion expectedVersion someSecondQuery =
+      if queryVersion >= expectedVersion
+        then return someSecondQuery
+        else case someSecondQuery of
+          SomeSecond query -> fail $ "Query: " <> queryName query <> " requires at least " <> show expectedVersion
+
+    decodeBlockQuery :: Decoder s (SomeSecond Query blk)
     decodeBlockQuery = do
       SomeSecond blockQuery <- decodeNodeToClient
         @blk
@@ -162,16 +236,26 @@ queryDecodeNodeToClient codecConfig queryVersion blockVersion
         blockVersion
       return (SomeSecond (BlockQuery blockQuery))
 
-instance SerialiseResult blk (BlockQuery blk) => SerialiseResult blk (Query blk) where
+instance ( SerialiseResult blk (BlockQuery blk)
+         , Serialise (HeaderHash blk)
+         ) => SerialiseResult blk (Query blk) where
   encodeResult codecConfig blockVersion (BlockQuery blockQuery) result
     = encodeResult codecConfig blockVersion blockQuery result
   encodeResult _ _ GetSystemStart result
     = toCBOR result
+  encodeResult _ _ GetChainBlockNo result
+    = toCBOR result
+  encodeResult _ _ GetChainPoint result
+    = encodePoint encode result
 
   decodeResult codecConfig blockVersion (BlockQuery query)
     = decodeResult codecConfig blockVersion query
   decodeResult _ _ GetSystemStart
     = fromCBOR
+  decodeResult _ _ GetChainBlockNo
+    = fromCBOR
+  decodeResult _ _ GetChainPoint
+    = decodePoint decode
 
 instance SameDepIndex (BlockQuery blk) => SameDepIndex (Query blk) where
   sameDepIndex (BlockQuery blockQueryA) (BlockQuery blockQueryB)
@@ -182,19 +266,29 @@ instance SameDepIndex (BlockQuery blk) => SameDepIndex (Query blk) where
     = Just Refl
   sameDepIndex GetSystemStart _
     = Nothing
+  sameDepIndex GetChainBlockNo GetChainBlockNo
+    = Just Refl
+  sameDepIndex GetChainBlockNo _
+    = Nothing
+  sameDepIndex GetChainPoint GetChainPoint
+    = Just Refl
+  sameDepIndex GetChainPoint _
+    = Nothing
 
 deriving instance Show (BlockQuery blk result) => Show (Query blk result)
 
 -- | Answer the given query about the extended ledger state.
 answerQuery ::
-     (QueryLedger blk, ConfigSupportsNode blk)
+     (QueryLedger blk, ConfigSupportsNode blk, HasAnnTip blk)
   => ExtLedgerCfg blk
   -> Query blk result
   -> ExtLedgerState blk
   -> result
 answerQuery cfg query st = case query of
   BlockQuery blockQuery -> answerBlockQuery cfg blockQuery st
   GetSystemStart -> getSystemStart (topLevelConfigBlock (getExtLedgerCfg cfg))
+  GetChainBlockNo -> headerStateBlockNo (headerState st)
+  GetChainPoint -> headerStatePoint (headerState st)
 
 -- | Different queries supported by the ledger, indexed by the result type.
 data family BlockQuery blk :: Type -> Type