#4928 Add CLI command for printing slot number for UTC Time

adf
IntersectMBO · Apr 26, 2023 · 39dc687 · 39dc687
1 parent 4a455c0
commit 39dc687
Show file tree

Hide file tree

Showing 3 changed files with 36 additions and 4 deletions.
diff --git a/cardano-cli/src/Cardano/CLI/Shelley/Commands.hs b/cardano-cli/src/Cardano/CLI/Shelley/Commands.hs
@@ -50,6 +50,7 @@ import           Prelude
 import           Cardano.Api.Shelley
 
 import           Data.Text (Text)
+import           Data.Time.Clock
 
 import           Cardano.CLI.Shelley.Key (DelegationTarget, PaymentVerifier, StakeIdentifier,
                    StakeVerifier, VerificationKeyOrFile, VerificationKeyOrHashOrFile,
@@ -368,6 +369,7 @@ data QueryCmd =
       (Maybe (File () Out))
   | QueryPoolState' (Maybe SocketPath) AnyConsensusModeParams NetworkId [Hash StakePoolKey]
   | QueryTxMempool (Maybe SocketPath) AnyConsensusModeParams NetworkId TxMempoolQuery (Maybe (File () Out))
+  | QuerySlotNumber (Maybe SocketPath) AnyConsensusModeParams NetworkId UTCTime
   deriving Show
 
 renderQueryCmd :: QueryCmd -> Text
@@ -386,6 +388,7 @@ renderQueryCmd cmd =
     QueryKesPeriodInfo {} -> "query kes-period-info"
     QueryPoolState' {} -> "query pool-state"
     QueryTxMempool _ _ _ query _ -> "query tx-mempool" <> renderTxMempoolQuery query
+    QuerySlotNumber {} -> "query slot-number"
   where
     renderTxMempoolQuery query =
       case query of

diff --git a/cardano-cli/src/Cardano/CLI/Shelley/Parsers.hs b/cardano-cli/src/Cardano/CLI/Shelley/Parsers.hs
@@ -955,6 +955,8 @@ pQueryCmd envCli =
         (Opt.info pQueryPoolState $ Opt.progDesc "Dump the pool state")
     , subParser "tx-mempool"
         (Opt.info pQueryTxMempool $ Opt.progDesc "Local Mempool info")
+    , subParser "slot-number"
+        (Opt.info pQuerySlotNumber $ Opt.progDesc "Query slot number for UTC timestamp")
     ]
   where
     pQueryProtocolParameters :: Parser QueryCmd
@@ -1092,6 +1094,20 @@ pQueryCmd envCli =
         <*> pOperationalCertificateFile
         <*> pMaybeOutputFile
 
+    pQuerySlotNumber :: Parser QueryCmd
+    pQuerySlotNumber =
+      QuerySlotNumber
+        <$> pSocketPath
+        <*> pConsensusModeParams
+        <*> pNetworkId envCli
+        <*> pUtcTimestamp
+          where
+            pUtcTimestamp =
+              convertTime <$> (Opt.strArgument . mconcat)
+                [ Opt.metavar "TIMESTAMP"
+                , Opt.help "UTC timestamp in YYYY-MM-DDThh:mm:ssZ format"
+                ]
+
 pGovernanceCmd :: Parser GovernanceCmd
 pGovernanceCmd =
   asum
@@ -1475,10 +1491,6 @@ pGenesisCmd envCli =
         <> Opt.completer (Opt.bashCompleter "file")
         )
 
-    convertTime :: String -> UTCTime
-    convertTime =
-      parseTimeOrError False defaultTimeLocale "%Y-%m-%dT%H:%M:%SZ"
-
     pInitialSupplyNonDelegated :: Parser (Maybe Lovelace)
     pInitialSupplyNonDelegated =
       Opt.optional $
@@ -1655,6 +1667,10 @@ pTxMetadataJsonSchema =
     -- Default to the no-schema conversion.
     pure TxMetadataJsonNoSchema
 
+convertTime :: String -> UTCTime
+convertTime =
+  parseTimeOrError False defaultTimeLocale "%Y-%m-%dT%H:%M:%SZ"
+
 pMetadataFile :: Parser MetadataFile
 pMetadataFile =
       MetadataFileJSON <$>

diff --git a/cardano-cli/src/Cardano/CLI/Shelley/Run/Query.hs b/cardano-cli/src/Cardano/CLI/Shelley/Run/Query.hs
@@ -196,6 +196,8 @@ runQueryCmd cmd =
       runQueryPoolState mNodeSocketPath consensusModeParams network poolid
     QueryTxMempool mNodeSocketPath consensusModeParams network op mOutFile ->
       runQueryTxMempool mNodeSocketPath consensusModeParams network op mOutFile
+    QuerySlotNumber mNodeSocketPath consensusModeParams network utcTime ->
+      runQuerySlotNumber mNodeSocketPath consensusModeParams network utcTime
 
 runQueryProtocolParameters
   :: Maybe SocketPath
@@ -718,6 +720,17 @@ runQueryTxMempool mNodeSocketPath (AnyConsensusModeParams cModeParams) network q
     Just (File oFp) -> handleIOExceptT (ShelleyQueryCmdWriteFileError . FileIOError oFp)
         $ LBS.writeFile oFp renderedResult
 
+runQuerySlotNumber
+  :: Maybe SocketPath
+  -> AnyConsensusModeParams
+  -> NetworkId
+  -> UTCTime
+  -> ExceptT ShelleyQueryCmdError IO ()
+runQuerySlotNumber mNodeSocketPath aCmp network utcTime = do
+  sockPath <- maybe (lift readEnvSocketPath) (pure . Right) mNodeSocketPath
+    & onLeft (left . ShelleyQueryCmdEnvVarSocketErr)
+  SlotNo slotNo <- utcTimeToSlotNo sockPath aCmp network utcTime
+  liftIO $ print slotNo
 
 -- | Obtain stake snapshot information for a pool, plus information about the total active stake.
 -- This information can be used for leader slot calculation, for example, and has been requested by SPOs.