Merge pull request #275 from Concordium/epoch-queries

Support for GetWinningBakersEpoch and GetFirstBlockEpoch.

ChangeLog.md

@@ -5,9 +5,12 @@
 - Add `baker win-time` command for determining the earliest time a specified baker is expected to
   bake.
 - End stream consumption early if an error is returned.
-- Add raw support for `GetBakersRewardPeriod`.
-- Add raw support for `GetBlockCertificates`.
-- Add raw support for `GetBakerEarliestWinTime`.
+- Add support for the following node version 6.1 queries under the `raw` command:
+  - `GetBakersRewardPeriod`
+  - `GetBlockCertificates`
+  - `GetBakerEarliestWinTime`
+  - `GetWinningBakersEpoch`
+  - `GetFirstBlockEpoch`
 - Add support for `CommissionRates` in `CurrentPaydayBakerPoolStatus` (Only available for node versions > 6.0).
 
 ## 6.0.1

src/Concordium/Client/Commands.hs

@@ -28,6 +28,7 @@ module Concordium.Client.Commands (
     ParameterFileInput (..),
     InvokerInput (..),
     ExtraBakerAddData (..),
+    EpochSpecifier (..),
 ) where
 
 import Concordium.Client.LegacyCommands

src/Concordium/Client/GRPC2.hs

@@ -2824,6 +2824,14 @@ instance FromProto Proto.PendingUpdate where
                     PUEFinalizationCommitteeParameters <$> fromProto fcParams
         return PendingUpdate{..}
 
+instance FromProto Proto.WinningBaker where
+    type Output Proto.WinningBaker = WinningBaker
+    fromProto winningBaker = do
+        wbRound <- fromProto (winningBaker ^. ProtoFields.round)
+        wbWinner <- fromProto (winningBaker ^. ProtoFields.winner)
+        let wbPresent = winningBaker ^. ProtoFields.present
+        return WinningBaker{..}
+
 type LoggerMethod = Text -> IO ()
 
 data GrpcConfig = GrpcConfig
@@ -3308,6 +3316,16 @@ getBakerEarliestWinTime bakerId = withUnary (call @"getBakerEarliestWinTime") ms
   where
     msg = toProto bakerId
 
+getWinningBakersEpoch :: (MonadIO m) => EpochRequest -> ClientMonad m (GRPCResult (FromProtoResult (Seq.Seq WinningBaker)))
+getWinningBakersEpoch epochReq = withServerStreamCollect (call @"getWinningBakersEpoch") msg ((fmap . mapM) fromProto)
+  where
+    msg = toProto epochReq
+
+getFirstBlockEpoch :: (MonadIO m) => EpochRequest -> ClientMonad m (GRPCResult (FromProtoResult BlockHash))
+getFirstBlockEpoch epochReq = withUnary (call @"getFirstBlockEpoch") msg (fmap fromProto)
+  where
+    msg = toProto epochReq
+
 -- |Call a unary V2 GRPC API endpoint and return the result.
 withUnary ::
     ( HasMethod CS.Queries m,

src/Concordium/Client/LegacyCommands.hs

@@ -1,4 +1,5 @@
 module Concordium.Client.LegacyCommands (
+    EpochSpecifier (..),
     LegacyCmd (..),
     legacyProgramOptions,
 ) where
@@ -7,6 +8,25 @@ import Concordium.Types
 import Data.Text
 import Options.Applicative
 
+-- |Representation of the arguments to a command that expects an epoch to be specified as input.
+data EpochSpecifier = EpochSpecifier
+    { -- |The genesis index to query. Should be provided with 'esEpoch'.
+      esGenesisIndex :: !(Maybe GenesisIndex),
+      -- |The epoch number to query. Should be provided with 'esGenesisIndex'.
+      esEpoch :: !(Maybe Epoch),
+      -- |The block to use the epoch of. Should not be provided with any other fields.
+      esBlock :: !(Maybe BlockHash)
+    }
+    deriving (Show)
+
+-- |Helper function for parsing an 'EpochSpecifier' as command line options.
+parseEpochSpecifier :: Parser EpochSpecifier
+parseEpochSpecifier =
+    EpochSpecifier
+        <$> optional (option auto (long "genesis-index" <> metavar "GENINDEX" <> help "Genesis index (use with --epoch)"))
+        <*> optional (option auto (long "epoch" <> metavar "EPOCH" <> help "Epoch number (use with --genesis-index)"))
+        <*> optional (option auto (long "block" <> metavar "BLOCKHASH" <> help "Block hash"))
+
 data LegacyCmd
     = -- | Loads a transaction in the context of the local database and sends it to the specified RPC server
       SendTransaction
@@ -147,6 +167,10 @@ data LegacyCmd
     | GetBakerEarliestWinTime
         { legacyBakerId :: !BakerId
         }
+    | GetWinningBakersEpoch
+        {legacyEpoch :: !EpochSpecifier}
+    | GetFirstBlockEpoch
+        {legacyEpoch :: !EpochSpecifier}
     deriving (Show)
 
 legacyProgramOptions :: Parser LegacyCmd
@@ -194,6 +218,8 @@ legacyProgramOptions =
             <> getBakersRewardPeriodCommand
             <> getBlockCertificatesCommand
             <> getBakerEarliestWinTimeCommand
+            <> getWinningBakersEpochCommand
+            <> getFirstBlockEpochCommand
         )
 
 getPeerDataCommand :: Mod CommandFields LegacyCmd
@@ -689,3 +715,21 @@ getCryptographicParametersCommand =
             )
             (progDesc "Query the gRPC server for the cryptographic parameters in a specific block.")
         )
+
+getWinningBakersEpochCommand :: Mod CommandFields LegacyCmd
+getWinningBakersEpochCommand =
+    command
+        "GetWinningBakersEpoch"
+        ( info
+            (GetWinningBakersEpoch <$> parseEpochSpecifier)
+            (progDesc "Query the winning bakers for an epoch.")
+        )
+
+getFirstBlockEpochCommand :: Mod CommandFields LegacyCmd
+getFirstBlockEpochCommand =
+    command
+        "GetFirstBlockEpoch"
+        ( info
+            (GetFirstBlockEpoch <$> parseEpochSpecifier)
+            (progDesc "Query the first finalized block of an epoch. (Default: the epoch of the last finalized block.)")
+        )

src/Concordium/Client/Runner.hs

@@ -1632,6 +1632,33 @@ readBlockHashOrDefault :: (MonadIO m) => BlockHashInput -> Maybe Text -> m Block
 readBlockHashOrDefault d Nothing = return d
 readBlockHashOrDefault _ (Just s) = readOrFail s >>= return . Given
 
+-- |Parse an 'Queries.EpochRequest' from an 'EpochSpecifier'.
+parseEpochRequest ::
+    (MonadIO m) =>
+    -- |Optional value to use if no arguments are specified.
+    Maybe Queries.EpochRequest ->
+    -- |Input specifying the epoch
+    EpochSpecifier ->
+    m Queries.EpochRequest
+parseEpochRequest
+    _
+    EpochSpecifier
+        { esGenesisIndex = Just genIndex,
+          esEpoch = Just epoch,
+          esBlock = Nothing
+        } =
+        return Queries.SpecifiedEpoch{erGenesisIndex = genIndex, erEpoch = epoch}
+parseEpochRequest
+    _
+    EpochSpecifier{esGenesisIndex = Nothing, esEpoch = Nothing, esBlock = Just blk} =
+        return $! Queries.EpochOfBlock (Queries.Given blk)
+parseEpochRequest
+    (Just emptyCase)
+    (EpochSpecifier Nothing Nothing Nothing) =
+        return emptyCase
+parseEpochRequest _ _ =
+    logFatal [[i|Invalid arguments: either a genesis index and an epoch number should be supplied, or a block hash.|]]
+
 -- |Process an 'account ...' command.
 processAccountCmd :: AccountCmd -> Maybe FilePath -> Verbose -> Backend -> IO ()
 processAccountCmd action baseCfgDir verbose backend =
@@ -4132,6 +4159,16 @@ processLegacyCmd action backend =
                     >>= printResponseValueAsJSON
         GetBakerEarliestWinTime bakerId ->
             withClient backend $ getBakerEarliestWinTime bakerId >>= printResponseValueAsJSON
+        GetWinningBakersEpoch epochSpec ->
+            withClient backend $
+                parseEpochRequest Nothing epochSpec
+                    >>= getWinningBakersEpoch
+                    >>= printResponseValueAsJSON
+        GetFirstBlockEpoch epochSpec ->
+            withClient backend $
+                parseEpochRequest (Just (Queries.EpochOfBlock Queries.LastFinal)) epochSpec
+                    >>= getFirstBlockEpoch
+                    >>= printResponseValueAsJSON
   where
     -- \|Print the response value under the provided mapping,
     -- or fail with an error message if the response contained

src/Concordium/Client/Runner/Helper.hs

@@ -30,7 +30,7 @@ import qualified Data.Text as Text
 import Data.Text.Encoding (decodeUtf8')
 import Network.GRPC.Client hiding (Invalid)
 import Network.GRPC.HTTP2.Types
-import qualified Network.URI.Encode (decode)
+import qualified Network.URI.Encode (decode, decodeBSToText)
 import Text.Read (readEither)
 import Prelude
 
@@ -75,7 +75,7 @@ toGRPCResult' =
         -- @RawUnaryOutput@ models the result of invoking a non-streaming GRPC call.
         -- It wraps a @RawReply@ which either indicates if a problem occurred at the
         -- application layer, whose nature is then available in an @ErrorCode@, or if the
-        -- request was successful the result is available in a triple comprimising HTTP/2
+        -- request was successful the result is available in a triple comprising HTTP/2
         -- response headers, trailers and a GRPC response. The response in turn either
         -- indicates if a non-'OK' status code was returned or if an 'OK' status code was
         -- returned. In the former case, a server response message is available, and in the
@@ -107,7 +107,12 @@ toGRPCResult' =
                 Left _ -> StatusInvalid
                 Right (GRPCStatus code message) ->
                     if code /= OK
-                        then StatusNotOk (code, "GRPC error: " <> show message)
+                        then
+                            StatusNotOk
+                                ( code,
+                                  "GRPC error: "
+                                    <> Text.unpack (Network.URI.Encode.decodeBSToText message)
+                                )
                         else
                             let hs = map (\(hn, hv) -> (CI.mk hn, hv)) hds
                             in  StatusOk (GRPCResponse hs t)