Support for epoch winning bakers and first block queries.

CHANGELOG.md

@@ -8,6 +8,10 @@
   quorum certificate, timeout certificate and epoch finalization entry contained in the block (where present).
 - Add endpoint `GetBakerEarliestWinTime` to GRPCV2 API. Provided a baker ID, it returns the
   earliest time at which the node projects that the baker could be required to bake a block.
+- Add endpoint `GetFirstBlockEpoch` to GRPCV2 API. It returns the block hash of the first block in
+  a given epoch.
+- Add endpoint `GitWinningBakersEpoch` to GRPCV2 API. It returns a list of the bakers that won
+  rounds in a specified (finalized) epoch. This only supports consensus version 1.
 - Fix a bug in how the last timeout certificate is recovered at start-up.
 
 ## 6.0.4

concordium-consensus/lib.def

@@ -53,6 +53,8 @@ EXPORTS
  getModuleSourceV2
  getInstanceListV2
  getAncestorsV2
+ getFirstBlockEpochV2
+ getWinningBakersEpochV2
  getInstanceInfoV2
  getInstanceStateV2
  getNextAccountSequenceNumberV2

concordium-consensus/src/Concordium/External/GRPC2.hs

@@ -110,6 +110,18 @@ decodeBlockHashInput n dt =
                     Right (rBlockHeight, rGenesisIndex, rRestrict) -> return $ Queries.Relative{..}
             _ -> error "Precondition violation in FFI call: Unknown block hash input type"
 
+-- |Decode an 'Queries.EpochRequest' given the tag byte and data.
+-- The tags supported by 'decodeBlockHashInput' are also supported here (0-4), corresponding to
+-- a 'Queries.EpochOfBlock'. The tag 5 is used for 'Queries.SpecifiedEpoch'.
+decodeEpochRequest :: Word8 -> Ptr Word8 -> IO Queries.EpochRequest
+decodeEpochRequest 5 dt = do
+    -- 8 bytes for epoch, 4 bytes for genesis index
+    inputData <- BS.unsafePackCStringLen (castPtr dt, 12)
+    case S.decode inputData of
+        Left err -> error $ "Precondition violation in FFI call: " ++ err
+        Right (erEpoch, erGenesisIndex) -> return $! Queries.SpecifiedEpoch{..}
+decodeEpochRequest n dt = Queries.EpochOfBlock <$> decodeBlockHashInput n dt
+
 -- | Decode an account address from a foreign ptr. Assumes 32 bytes are available.
 decodeAccountAddress :: Ptr Word8 -> IO AccountAddress
 decodeAccountAddress accPtr = coerce <$> FBS.create @AccountAddressSize (\p -> copyBytes p accPtr 32)
@@ -154,6 +166,8 @@ data QueryResult
       QRNotFound
     | -- | The service is not available at the current protocol version.
       QRUnavailable
+    | -- | The requested data is for a future epoch or genesis index.
+      QRFutureEpoch
 
 -- |Convert a QueryResult to a result code.
 queryResultCode :: QueryResult -> Int64
@@ -162,6 +176,7 @@ queryResultCode QRInternalError = -1
 queryResultCode QRSuccess = 0
 queryResultCode QRNotFound = 1
 queryResultCode QRUnavailable = 2
+queryResultCode QRFutureEpoch = 3
 
 getAccountInfoV2 ::
     StablePtr Ext.ConsensusRunner ->
@@ -415,6 +430,52 @@ getAncestorsV2 cptr channel blockType blockHashPtr depth outHash cbk = do
     response <- runMVR (Q.getAncestors bhi (BlockHeight depth)) mvr
     returnStreamWithBlock (sender channel) outHash response
 
+getFirstBlockEpochV2 ::
+    StablePtr Ext.ConsensusRunner ->
+    -- |Query type.
+    Word8 ->
+    -- |Query payload data.
+    Ptr Word8 ->
+    -- |Out pointer for the result block hash.
+    Ptr Word8 ->
+    IO Int64
+getFirstBlockEpochV2 cptr queryType queryDataPtr outHash = do
+    Ext.ConsensusRunner mvr <- deRefStablePtr cptr
+    epochReq <- decodeEpochRequest queryType queryDataPtr
+    response <- runMVR (Q.getFirstBlockEpoch epochReq) mvr
+    case response of
+        Left Q.EQEBlockNotFound -> return $ queryResultCode QRNotFound
+        Left Q.EQEFutureEpoch -> return $ queryResultCode QRFutureEpoch
+        Left Q.EQEInvalidEpoch -> return $ queryResultCode QRInvalidArgument
+        Left Q.EQEInvalidGenesisIndex -> return $ queryResultCode QRInvalidArgument
+        Right res -> do
+            copyHashTo outHash (Q.BQRBlock res ())
+            return $ queryResultCode QRSuccess
+
+getWinningBakersEpochV2 ::
+    StablePtr Ext.ConsensusRunner ->
+    Ptr SenderChannel ->
+    -- |Query type.
+    Word8 ->
+    -- |Query payload data.
+    Ptr Word8 ->
+    -- |Stream callback.
+    FunPtr (Ptr SenderChannel -> Ptr Word8 -> Int64 -> IO Int32) ->
+    IO Int64
+getWinningBakersEpochV2 cptr channel queryType queryDataPtr cbk = do
+    Ext.ConsensusRunner mvr <- deRefStablePtr cptr
+    let sender = callChannelSendCallback cbk channel
+    epochReq <- decodeEpochRequest queryType queryDataPtr
+    response <- runMVR (Q.getWinningBakersEpoch epochReq) mvr
+    case response of
+        Left Q.EQEBlockNotFound -> return $ queryResultCode QRNotFound
+        Left Q.EQEFutureEpoch -> return $ queryResultCode QRFutureEpoch
+        Left Q.EQEInvalidEpoch -> return $ queryResultCode QRInvalidArgument
+        Left Q.EQEInvalidGenesisIndex -> return $ queryResultCode QRInvalidArgument
+        Right res -> do
+            _ <- enqueueMessages sender res
+            return $ queryResultCode QRSuccess
+
 getBlockItemStatusV2 ::
     StablePtr Ext.ConsensusRunner ->
     -- |Transaction hash.
@@ -1246,6 +1307,29 @@ foreign export ccall
         FunPtr (Ptr SenderChannel -> Ptr Word8 -> Int64 -> IO Int32) ->
         IO Int64
 
+foreign export ccall
+    getFirstBlockEpochV2 ::
+        StablePtr Ext.ConsensusRunner ->
+        -- |Query type.
+        Word8 ->
+        -- |Query payload data.
+        Ptr Word8 ->
+        -- |Out pointer for the result block hash.
+        Ptr Word8 ->
+        IO Int64
+
+foreign export ccall
+    getWinningBakersEpochV2 ::
+        StablePtr Ext.ConsensusRunner ->
+        Ptr SenderChannel ->
+        -- |Query type.
+        Word8 ->
+        -- |Query payload data.
+        Ptr Word8 ->
+        -- |Stream callback.
+        FunPtr (Ptr SenderChannel -> Ptr Word8 -> Int64 -> IO Int32) ->
+        IO Int64
+
 foreign export ccall
     getInstanceInfoV2 ::
         StablePtr Ext.ConsensusRunner ->

concordium-consensus/src/Concordium/KonsensusV1/Consensus.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE TypeFamilies #-}
 
@@ -18,6 +19,7 @@ import Concordium.Types
 import qualified Concordium.Types.Accounts as Accounts
 import Concordium.Types.BakerIdentity
 import Concordium.Types.Parameters hiding (getChainParameters)
+import Concordium.Types.Queries
 import Concordium.Utils
 
 import qualified Concordium.Crypto.BlockSignature as Sig
@@ -384,3 +386,63 @@ bakerEarliestWinTimestamp baker sd = do
                                 (blockTimestamp lfBlock)
                                 (fromIntegral (curRound - blockRound lfBlock) * minBlockTime)
                             )
+
+-- |Get the list of rounds that fall within a finalized epoch, together with which baker was
+-- eligible to bake in that round and whether a block in that round was included in the finalized
+-- chain.
+-- This returns 'Nothing' if the epoch is not completely finalized (i.e. there is no finalized
+-- block in a higher round).
+getWinningBakersForEpoch ::
+    forall m.
+    ( GSTypes.BlockState m ~ PBS.HashedPersistentBlockState (MPV m),
+      BS.BlockStateQuery m,
+      LowLevel.MonadTreeStateStore m,
+      MonadIO m
+    ) =>
+    Epoch ->
+    SkovData (MPV m) ->
+    m (Maybe [WinningBaker])
+getWinningBakersForEpoch targetEpoch sd = do
+    -- We start with the first finalized block of the next epoch.
+    -- If there is no such block, then we don't consider the target epoch finalized, so return no
+    -- result.
+    mFirstBlockNextEpoch <- getFirstFinalizedBlockOfEpoch (Left $ targetEpoch + 1) sd
+    forM mFirstBlockNextEpoch $ \startBlock -> do
+        -- The start block will be a finalized block and not the genesis block (its epoch is > 1).
+        -- Its parent will be in the target epoch. (There are no empty epochs.)
+        lastOfEpoch <- parentOfFinalized startBlock
+        bakers <- BS.getCurrentEpochBakers (bpState lastOfEpoch)
+        seedState <- BS.getSeedState (bpState lastOfEpoch)
+        let leNonce = seedState ^. currentLeadershipElectionNonce
+        let roundWinner = getLeaderFullBakers bakers leNonce
+        let roundWB rnd present =
+                WinningBaker
+                    { wbWinner = roundWinner rnd ^. Accounts.bakerIdentity,
+                      wbRound = rnd,
+                      wbPresent = present
+                    }
+        -- We construct the list of rounds starting from the round before @startBlock@ and moving
+        -- backwards to the round after the first ancestor of @startBlock@ that is in an earlier
+        -- epoch than @targetEpoch@.
+        let go ::
+                BlockPointer (MPV m) -> -- Block in at most round @rnd@
+                Round -> -- Next round to include in list
+                [WinningBaker] -> -- Currently accumulated list
+                m [WinningBaker]
+            go prevBaked rnd l
+                | rnd == 0 = do
+                    -- The genesis block (i.e. in round 0) has no baker, so stop.
+                    return l
+                | blockRound prevBaked /= rnd = do
+                    -- prevBaked is the block in the highest round <= rnd, so the round must have
+                    -- timed out.
+                    go prevBaked (rnd - 1) (roundWB rnd False : l)
+                | blockEpoch prevBaked == targetEpoch = do
+                    -- blockRound prevBaked == rnd, so a block in the round is present.
+                    newPrevBaked <- parentOfFinalized prevBaked
+                    go newPrevBaked (rnd - 1) (roundWB rnd True : l)
+                | otherwise = do
+                    -- Here prevBaked must be in a previous epoch, and blockRound prevBaked == rnd,
+                    -- so we stop.
+                    return l
+        go lastOfEpoch (blockRound startBlock - 1) []

concordium-consensus/src/Concordium/KonsensusV1/TreeState/Implementation.hs

@@ -48,6 +48,7 @@ import Concordium.Types.HashableTo
 import Concordium.Types.Transactions
 import Concordium.Types.Updates
 import Concordium.Utils
+import Concordium.Utils.InterpolationSearch
 
 import Concordium.GlobalState.BlockState
 import Concordium.GlobalState.Parameters (RuntimeParameters (..))
@@ -485,6 +486,35 @@ getBlocksAtHeight height sd = case compare height lastFinHeight of
     lastFin = sd ^. lastFinalized
     lastFinHeight = bmHeight (blockMetadata lastFin)
 
+-- |Get the first finalized block in a given epoch. The epoch can be specified either directly or
+-- by a block belong to the epoch.
+getFirstFinalizedBlockOfEpoch ::
+    (LowLevel.MonadTreeStateStore m, MonadIO m) =>
+    -- |Target epoch or a block in the target epoch.
+    Either Epoch (BlockPointer (MPV m)) ->
+    SkovData (MPV m) ->
+    m (Maybe (BlockPointer (MPV m)))
+getFirstFinalizedBlockOfEpoch epochOrBlock sd
+    | targetEpoch > blockEpoch lastFin = return Nothing
+    | otherwise = do
+        gen <- unsafeFinalizedAtHeight 0
+        let low = (0, gen)
+        let high = case epochOrBlock of
+                Right guess
+                    | blockHeight guess <= blockHeight lastFin ->
+                        (blockHeight guess, (blockEpoch guess, guess))
+                _ -> (blockHeight lastFin, (blockEpoch lastFin, lastFin))
+        fmap snd <$> interpolationSearchFirstM unsafeFinalizedAtHeight targetEpoch low high
+  where
+    targetEpoch = case epochOrBlock of
+        Left epoch -> epoch
+        Right block -> blockEpoch block
+    unsafeFinalizedAtHeight h =
+        getFinalizedBlockAtHeight h <&> \case
+            Nothing -> error $ "Missing finalized block at height " ++ show h
+            Just b -> (blockEpoch b, b)
+    lastFin = sd ^. lastFinalized
+
 -- |Turn a 'PendingBlock' into a live block.
 -- This marks the block as 'MemBlockAlive' in the block table, records the arrive time of the block,
 -- and returns the resulting 'BlockPointer'.
@@ -605,6 +635,24 @@ parentOfLive sd block
         | Present blockData <- blockBakedData block = blockParent blockData
         | otherwise = error "parentOfLive: unexpected genesis block"
 
+-- |Get the parent of a block where the parent is a finalized block.
+-- This will produce an error if the supplied block is the genesis block, or the parent block is
+-- not finalized.
+parentOfFinalized :: (LowLevel.MonadTreeStateStore m, MonadIO m) => BlockPointer (MPV m) -> m (BlockPointer (MPV m))
+parentOfFinalized block = do
+    let parentHash
+            | Present blockData <- blockBakedData block = blockParent blockData
+            | otherwise = error "parentOfFinalized: unexpected genesis block"
+    LowLevel.lookupBlock parentHash >>= \case
+        Nothing ->
+            error $
+                "parentOfFinalized: parent block ("
+                    ++ show parentHash
+                    ++ ") of "
+                    ++ show (getHash @BlockHash block)
+                    ++ " is not finalized"
+        Just storedBlock -> mkBlockPointer storedBlock
+
 -- |Get the last finalized block from the perspective of a block. That is, follow the QC chain
 -- back until we reach two blocks in consecutive rounds.
 lastFinalizedOf ::