Merge pull request #271 from Concordium/baker-earliest-win-time

Baker earliest win time queries

ChangeLog.md

@@ -2,9 +2,12 @@
 
 ## Unreleased
 
+- 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 `CommissionRates` in `CurrentPaydayBakerPoolStatus` (Only available for node versions > 6.0).
 
 ## 6.0.1

src/Concordium/Client/Commands.hs

@@ -510,6 +510,11 @@ data BakerCmd
         { bodsOpenForDelegation :: !OpenStatus,
           bodsTransactionOpts :: !(TransactionOpts (Maybe Energy))
         }
+    | BakerGetEarliestWinTime
+        { bgewtBakerId :: !BakerId,
+          bgewtShowLocalTime :: !Bool,
+          bgewtPoll :: !Bool
+        }
     deriving (Show)
 
 data DelegatorCmd
@@ -1626,6 +1631,7 @@ bakerCmds =
                         <> bakerUpdateUpdateMetadataURL
                         <> bakerUpdateOpenDelegationStatus
                         <> bakerConfigureCmd
+                        <> bakerGetEarliestWinTime
                     )
             )
             (progDesc "Commands for creating and deploying baker credentials.")
@@ -1767,6 +1773,25 @@ bakerUpdateOpenDelegationStatus =
             (progDesc "Change whether to allow other parties to delegate stake to the baker.")
         )
 
+bakerGetEarliestWinTime :: Mod CommandFields BakerCmd
+bakerGetEarliestWinTime =
+    command
+        "win-time"
+        ( info
+            ( BakerGetEarliestWinTime
+                <$> argument auto (metavar "BAKER-ID" <> help "Baker ID to query.")
+                <*> switch
+                    ( long "local-time"
+                        <> help "Display time in the local time zone (instead of UTC)."
+                    )
+                <*> switch
+                    ( long "poll"
+                        <> help "Repeatedly poll for the latest time."
+                    )
+            )
+            (progDesc "Show the earliest time the baker may be expected to bake a block.")
+        )
+
 bakerSetKeysCmd :: Mod CommandFields BakerCmd
 bakerSetKeysCmd =
     command

src/Concordium/Client/GRPC2.hs

@@ -3302,6 +3302,12 @@ getBlockCertificates bhInput = withUnary (call @"getBlockCertificates") msg (fma
   where
     msg = toProto bhInput
 
+-- |Get the earliest time at which a baker may be expected to bake a block.
+getBakerEarliestWinTime :: (MonadIO m) => BakerId -> ClientMonad m (GRPCResult (FromProtoResult Timestamp))
+getBakerEarliestWinTime bakerId = withUnary (call @"getBakerEarliestWinTime") msg (fmap fromProto)
+  where
+    msg = toProto bakerId
+
 -- |Call a unary V2 GRPC API endpoint and return the result.
 withUnary ::
     ( HasMethod CS.Queries m,

src/Concordium/Client/LegacyCommands.hs

@@ -16,11 +16,11 @@ data LegacyCmd
       GetTransactionStatus
         { legacyTransactionHash :: !Text
         }
-    | -- |Get non finalized transactions for a given account.
+    | -- | Get non finalized transactions for a given account.
       GetAccountNonFinalized
         { legacyAddress :: !Text
         }
-    | -- |Get non finalized transactions for a given account.
+    | -- | Get non finalized transactions for a given account.
       GetNextAccountNonce
         { legacyAddress :: !Text
         }
@@ -96,7 +96,7 @@ data LegacyCmd
       GetModuleList
         { legacyBlockHash :: !(Maybe Text)
         }
-    | -- |Queries the gRPC server for the node information.
+    | -- | Queries the gRPC server for the node information.
       GetNodeInfo
     | GetPeerData
         { -- | Whether to include bootstrapper node in the stats or not.
@@ -144,6 +144,9 @@ data LegacyCmd
         {legacyBlockHash :: !(Maybe Text)}
     | GetBlockCertificates
         {legacyBlockHash :: !(Maybe Text)}
+    | GetBakerEarliestWinTime
+        { legacyBakerId :: !BakerId
+        }
     deriving (Show)
 
 legacyProgramOptions :: Parser LegacyCmd
@@ -190,6 +193,7 @@ legacyProgramOptions =
             <> getNextUpdateSequenceNumbersCommand
             <> getBakersRewardPeriodCommand
             <> getBlockCertificatesCommand
+            <> getBakerEarliestWinTimeCommand
         )
 
 getPeerDataCommand :: Mod CommandFields LegacyCmd
@@ -416,6 +420,20 @@ getBlockCertificatesCommand =
             (progDesc "Query the gRPC server for the certificates of a block.")
         )
 
+getBakerEarliestWinTimeCommand :: Mod CommandFields LegacyCmd
+getBakerEarliestWinTimeCommand =
+    command
+        "GetBakerEarliestWinTime"
+        ( info
+            ( GetBakerEarliestWinTime
+                <$> argument auto (metavar "BAKER-ID" <> help "Baker ID of the baker.")
+            )
+            ( progDesc
+                "Query the gRPC server for the earliest time that a given baker is expected \
+                \to bake."
+            )
+        )
+
 getInstanceInfoCommand :: Mod CommandFields LegacyCmd
 getInstanceInfoCommand =
     command

src/Concordium/Client/Runner.hs

@@ -80,6 +80,7 @@ import Codec.CBOR.Encoding
 import Codec.CBOR.JSON
 import Codec.CBOR.Write
 import Control.Arrow (Arrow (second))
+import Control.Concurrent (threadDelay)
 import Control.Exception
 import Control.Monad.Except
 import Control.Monad.Reader hiding (fail)
@@ -104,7 +105,7 @@ import Data.String.Interpolate (i, iii)
 import Data.Text (Text)
 import qualified Data.Text as Text
 import qualified Data.Text.Encoding as Text
-import Data.Time.Clock (UTCTime, addUTCTime, getCurrentTime)
+import Data.Time
 import qualified Data.Tuple as Tuple
 import qualified Data.Vector as Vec
 import Data.Word
@@ -3670,6 +3671,44 @@ processBakerCmd action baseCfgDir verbose backend =
             processBakerConfigureCmd baseCfgDir verbose backend txOpts False Nothing Nothing Nothing (Just url) Nothing Nothing Nothing Nothing Nothing
         BakerUpdateOpenDelegationStatus status txOpts ->
             processBakerConfigureCmd baseCfgDir verbose backend txOpts False Nothing Nothing (Just status) Nothing Nothing Nothing Nothing Nothing Nothing
+        BakerGetEarliestWinTime bakerId useLocalTime doPoll -> do
+            winTimestamp <- getWinTimestamp
+            putStrLn [i|Baker #{bakerId} is expected to bake no sooner than:|]
+            if doPoll then polling 0 (0 :: Int) winTimestamp else void $ displayTime 0 winTimestamp
+            putStrLn ""
+          where
+            getWinTimestamp = do
+                result <- withClient backend $ getBakerEarliestWinTime bakerId
+                getResponseValueOrDie result
+            -- Display the timestamp and how far away it is from the current time.
+            -- This takes the length of the old output and returns the length of the new output
+            -- so that each call can cleanly overwrite the previous output.
+            displayTime :: Int -> Types.Timestamp -> IO Int
+            displayTime oldLen winTimestamp = do
+                let winUTC = Time.timestampToUTCTime winTimestamp
+                tz <- if useLocalTime then getTimeZone winUTC else return utc
+                let winLocalised = utcToZonedTime tz winUTC
+                now <- Time.utcTimeToTimestamp <$> getCurrentTime
+                let duration
+                        | winTimestamp > now = durationToText . fromIntegral $ winTimestamp - now
+                        | otherwise = "the past"
+                let txt = [i|#{formatTime defaultTimeLocale rfc822DateFormat winLocalised}  (in #{duration})|]
+                let newLen = length txt
+                -- Pad the text with spaces to erase the previous output, and end with
+                -- carriage return so that the next output will overwrite it.
+                putStr $ txt ++ replicate (oldLen - newLen) ' ' ++ "\r"
+                return newLen
+            polling :: Int -> Int -> Types.Timestamp -> IO ()
+            polling oldLen lastPoll winTimestamp = do
+                newLen <- displayTime oldLen winTimestamp
+                -- Delay for 1 second
+                threadDelay 1_000_000
+                now <- Time.utcTimeToTimestamp <$> getCurrentTime
+                -- We repeat the query every 10th iteration, or every iteration if the timestamp
+                -- is less than 10 seconds in the future.
+                if lastPoll >= 10 || winTimestamp < now + 10_000
+                    then polling newLen 0 =<< getWinTimestamp
+                    else polling newLen (lastPoll + 1) winTimestamp
 
 -- |Process a 'delegator configure ...' command.
 processDelegatorConfigureCmd ::
@@ -4091,6 +4130,8 @@ processLegacyCmd action backend =
                 readBlockHashOrDefault Best block
                     >>= getBlockCertificates
                     >>= printResponseValueAsJSON
+        GetBakerEarliestWinTime bakerId ->
+            withClient backend $ getBakerEarliestWinTime bakerId >>= printResponseValueAsJSON
   where
     -- \|Print the response value under the provided mapping,
     -- or fail with an error message if the response contained