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

cardano-cli/CHANGELOG.md

@@ -62,6 +62,8 @@
 
 - Add `utcTimeToSlotNo` function to support UTC -> slot number conversion ([PR 5130](https://github.com/input-output-hk/cardano-node/pull/5130))
 
+- Add `query slot-number` command line option to support UTC -> slot number conversion ([PR 5149](https://github.com/input-output-hk/cardano-node/pull/5149))
+
 - Remove `--stake-address` option from `stake-address build`
   ([PR 5061](https://github.com/input-output-hk/cardano-node/pull/5061))
 

cardano-cli/src/Cardano/CLI/Shelley/Commands.hs

@@ -49,6 +49,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,
@@ -367,6 +368,7 @@ data QueryCmd =
       (Maybe (File () Out))
   | QueryPoolState' SocketPath AnyConsensusModeParams NetworkId [Hash StakePoolKey]
   | QueryTxMempool SocketPath AnyConsensusModeParams NetworkId TxMempoolQuery (Maybe (File () Out))
+  | QuerySlotNumber SocketPath AnyConsensusModeParams NetworkId UTCTime
   deriving Show
 
 renderQueryCmd :: QueryCmd -> Text
@@ -385,6 +387,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

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 envCli
+        <*> 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 $
@@ -1654,6 +1666,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 <$>

cardano-cli/src/Cardano/CLI/Shelley/Run/Query.hs

@@ -194,6 +194,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
   :: SocketPath
@@ -352,8 +354,6 @@ runQueryTip socketPath (AnyConsensusModeParams cModeParams) network mOutFile = d
 
 -- | Query the UTxO, filtered by a given set of addresses, from a Shelley node
 -- via the local state query protocol.
---
-
 runQueryUTxO
   :: SocketPath
   -> AnyConsensusModeParams
@@ -698,6 +698,15 @@ runQueryTxMempool socketPath (AnyConsensusModeParams cModeParams) network query
     Just (File oFp) -> handleIOExceptT (ShelleyQueryCmdWriteFileError . FileIOError oFp)
         $ LBS.writeFile oFp renderedResult
 
+runQuerySlotNumber
+  :: SocketPath
+  -> AnyConsensusModeParams
+  -> NetworkId
+  -> UTCTime
+  -> ExceptT ShelleyQueryCmdError IO ()
+runQuerySlotNumber sockPath aCmp network utcTime = do
+  SlotNo slotNo <- utcTimeToSlotNo sockPath aCmp network utcTime
+  liftIO . putStr $ show 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.

cardano-cli/test/cardano-cli-golden/files/golden/help.cli

@@ -236,6 +236,7 @@ Usage: cardano-cli query
             | kes-period-info
             | pool-state
             | tx-mempool
+            | slot-number
             )
 
   Node query commands. Will query the local node whose Unix domain socket is
@@ -411,6 +412,16 @@ Usage: cardano-cli query tx-mempool tx-exists TX_ID
 
   Query if a particular transaction exists in the mempool
 
+Usage: cardano-cli query slot-number --socket-path SOCKET_PATH
+            [ --shelley-mode
+            | --byron-mode [--epoch-slots SLOTS]
+            | --cardano-mode [--epoch-slots SLOTS]
+            ]
+            (--mainnet | --testnet-magic NATURAL)
+            TIMESTAMP
+
+  Query slot number for UTC timestamp
+
 Usage: cardano-cli stake-pool 
             ( registration-certificate
             | deregistration-certificate

cardano-cli/test/cardano-cli-golden/files/golden/help/query.cli

@@ -12,6 +12,7 @@ Usage: cardano-cli query
             | kes-period-info
             | pool-state
             | tx-mempool
+            | slot-number
             )
 
   Node query commands. Will query the local node whose Unix domain socket is
@@ -45,3 +46,4 @@ Available commands:
                            node's operational certificate.
   pool-state               Dump the pool state
   tx-mempool               Local Mempool info
+  slot-number              Query slot number for UTC timestamp

cardano-cli/test/cardano-cli-golden/files/golden/help/query_slot-number.cli

@@ -0,0 +1,30 @@
+Usage: cardano-cli query slot-number --socket-path SOCKET_PATH
+            [ --shelley-mode
+            | --byron-mode [--epoch-slots SLOTS]
+            | --cardano-mode [--epoch-slots SLOTS]
+            ]
+            (--mainnet | --testnet-magic NATURAL)
+            TIMESTAMP
+
+  Query slot number for UTC timestamp
+
+Available options:
+  --socket-path SOCKET_PATH
+                           Path to the node socket. This overrides the
+                           CARDANO_NODE_SOCKET_PATH environment variable. The
+                           argument is optional if CARDANO_NODE_SOCKET_PATH is
+                           defined and mandatory otherwise.
+  --shelley-mode           For talking to a node running in Shelley-only mode.
+  --byron-mode             For talking to a node running in Byron-only mode.
+  --epoch-slots SLOTS      The number of slots per epoch for the Byron era.
+                           (default: 21600)
+  --cardano-mode           For talking to a node running in full Cardano mode
+                           (default).
+  --epoch-slots SLOTS      The number of slots per epoch for the Byron era.
+                           (default: 21600)
+  --mainnet                Use the mainnet magic id. This overrides the
+                           CARDANO_NODE_NETWORK_ID environment variable
+  --testnet-magic NATURAL  Specify a testnet magic id. This overrides the
+                           CARDANO_NODE_NETWORK_ID environment variable
+  TIMESTAMP                UTC timestamp in YYYY-MM-DDThh:mm:ssZ format
+  -h,--help                Show this help text

cardano-node/src/Cardano/Node/Configuration/POM.hs

@@ -470,8 +470,8 @@ defaultPartialNodeConfiguration =
     , pncExperimentalProtocolsEnabled = Last $ Just False
     , pncTopologyFile = Last . Just $ TopologyFile "configuration/cardano/mainnet-topology.json"
     , pncProtocolFiles = mempty
-    , pncValidateDB = mempty
-    , pncShutdownConfig = mempty
+    , pncValidateDB = Last $ Just False
+    , pncShutdownConfig = Last . Just $ ShutdownConfig Nothing Nothing
     , pncProtocolConfig = mempty
     , pncMaxConcurrencyBulkSync = mempty
     , pncMaxConcurrencyDeadline = mempty

cardano-testnet/cardano-testnet.cabal

@@ -37,15 +37,19 @@ library
                       , cardano-api ^>= 8.2
                       , cardano-cli
                       , cardano-crypto-class
+                      , cardano-crypto-wrapper
                       , cardano-git-rev
+                      , cardano-ledger-core
                       , cardano-ledger-byron
+                      , cardano-ledger-shelley
                       , cardano-node
                       , containers
                       , directory
                       , exceptions
                       , filepath
                       , hedgehog
                       , hedgehog-extras ^>= 0.4.5.1
+                      , mtl
                       , optparse-applicative-fork
                       , ouroboros-network
                       , ouroboros-network-api
@@ -66,6 +70,7 @@ library
 
   hs-source-dirs:       src
   exposed-modules:      Cardano.Testnet
+                        Testnet.Babbage
                         Testnet.Byron
                         Testnet.Options
                         Testnet.Util.Assert
@@ -82,7 +87,6 @@ library
                         Parsers.Shelley
                         Parsers.Version
                         Testnet
-                        Testnet.Babbage
                         Testnet.Cardano
                         Testnet.Conf
                         Testnet.Commands.Genesis
@@ -149,6 +153,7 @@ test-suite cardano-testnet-test
                         Test.Cli.Babbage.LeadershipSchedule
                         Test.Cli.Babbage.StakeSnapshot
                         Test.Cli.KesPeriodInfo
+                        Test.Cli.QuerySlotNumber
                         Test.FoldBlocks
                         Test.Misc
                         Test.Node.Shutdown

cardano-testnet/src/Testnet/Util/Runtime.hs

@@ -2,6 +2,8 @@
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedStrings #-}
 
 module Testnet.Util.Runtime
   ( LeadershipSlot(..)
@@ -19,29 +21,44 @@ module Testnet.Util.Runtime
   , poolNodeStdout
   , readNodeLoggingFormat
   , startNode
+  , ShelleyGenesis(..)
+  , shelleyGenesis
+  , getStartTime
+  , fromNominalDiffTimeMicro
   ) where
 
 import           Prelude
 
 import           Control.Monad
-import           Data.Aeson (FromJSON)
+import           Control.Monad.Error.Class
+import           Control.Monad.IO.Class
+import           Control.Monad.Trans.Except
+import qualified Data.Aeson as A
 import qualified Data.List as L
-
 import           Data.Text (Text)
+import           Data.Time.Clock (UTCTime)
 import           GHC.Generics (Generic)
+import           GHC.Stack
 import qualified Hedgehog as H
 import           Hedgehog.Extras.Stock.IO.Network.Sprocket (Sprocket (..))
 import qualified Hedgehog.Extras.Stock.IO.Network.Sprocket as IO
 import qualified Hedgehog.Extras.Stock.String as S
 import qualified Hedgehog.Extras.Test.Base as H
 import qualified Hedgehog.Extras.Test.File as H
 import qualified Hedgehog.Extras.Test.Process as H
-
 import           System.FilePath.Posix ((</>))
 import qualified System.Info as OS
 import qualified System.IO as IO
 import qualified System.Process as IO
 
+import           Cardano.Api
+import qualified Cardano.Chain.Genesis as G
+import           Cardano.Crypto.ProtocolMagic (RequiresNetworkMagic (..))
+import           Cardano.Ledger.Crypto (StandardCrypto)
+import           Cardano.Ledger.Shelley.Genesis
+import           Cardano.Node.Configuration.POM
+import qualified Cardano.Node.Protocol.Byron as Byron
+import           Cardano.Node.Types
 import qualified Testnet.Util.Process as H
 
 data NodeLoggingFormat = NodeLoggingFormatAsJson | NodeLoggingFormatAsText deriving (Eq, Show)
@@ -108,6 +125,37 @@ bftSprockets = fmap nodeSprocket . bftNodes
 poolSprockets :: TestnetRuntime -> [Sprocket]
 poolSprockets = fmap (nodeSprocket . poolRuntime) . poolNodes
 
+shelleyGenesis :: (H.MonadTest m, MonadIO m, HasCallStack) => TestnetRuntime -> m (ShelleyGenesis StandardCrypto)
+shelleyGenesis TestnetRuntime{shelleyGenesisFile} = withFrozenCallStack $
+  H.evalEither =<< H.evalIO (A.eitherDecodeFileStrict' shelleyGenesisFile)
+
+getStartTime :: (H.MonadTest m, MonadIO m, HasCallStack) => FilePath -> TestnetRuntime -> m UTCTime
+getStartTime tempRootPath TestnetRuntime{configurationFile} = withFrozenCallStack $ H.evalEither <=< H.evalIO . runExceptT $ do
+  byronGenesisFile <-
+    decodeNodeConfiguration configurationFile >>=
+      \case
+        NodeProtocolConfigurationCardano NodeByronProtocolConfiguration{npcByronGenesisFile} _ _ _ _ ->
+          pure $ unGenesisFile npcByronGenesisFile
+        NodeProtocolConfigurationByron NodeByronProtocolConfiguration{npcByronGenesisFile} ->
+          pure $ unGenesisFile npcByronGenesisFile
+        unsupported ->
+          throwError $ unwords
+            [ "cannot find byron configuration path in"
+            , configurationFile
+            , "- found instead:"
+            , show unsupported
+            ]
+  let byronGenesisFilePath = tempRootPath </> byronGenesisFile
+  G.gdStartTime . G.configGenesisData <$> decodeGenesisFile byronGenesisFilePath
+  where
+    decodeNodeConfiguration :: FilePath -> ExceptT String IO NodeProtocolConfiguration
+    decodeNodeConfiguration file = do
+      partialNodeCfg <- ExceptT $ A.eitherDecodeFileStrict' file
+      fmap ncProtocolConfig . liftEither . makeNodeConfiguration $ defaultPartialNodeConfiguration <> partialNodeCfg
+    decodeGenesisFile :: FilePath -> ExceptT String IO G.Config
+    decodeGenesisFile fp = withExceptT displayError $
+      Byron.readGenesis (GenesisFile fp) Nothing RequiresNoMagic
+
 readNodeLoggingFormat :: String -> Either String NodeLoggingFormat
 readNodeLoggingFormat = \case
   "json" -> Right NodeLoggingFormatAsJson

cardano-testnet/test/cardano-testnet-golden/files/golden/help.cli

@@ -236,6 +236,7 @@ Usage: cardano-cli query
             | kes-period-info
             | pool-state
             | tx-mempool
+            | slot-number
             )
 
   Node query commands. Will query the local node whose Unix domain socket is
@@ -411,6 +412,16 @@ Usage: cardano-cli query tx-mempool tx-exists TX_ID
 
   Query if a particular transaction exists in the mempool
 
+Usage: cardano-cli query slot-number --socket-path SOCKET_PATH
+            [ --shelley-mode
+            | --byron-mode [--epoch-slots SLOTS]
+            | --cardano-mode [--epoch-slots SLOTS]
+            ]
+            (--mainnet | --testnet-magic NATURAL)
+            TIMESTAMP
+
+  Query slot number for UTC timestamp
+
 Usage: cardano-cli stake-pool 
             ( registration-certificate
             | deregistration-certificate

cardano-testnet/test/cardano-testnet-golden/files/golden/help/query.cli

@@ -12,6 +12,7 @@ Usage: cardano-cli query
             | kes-period-info
             | pool-state
             | tx-mempool
+            | slot-number
             )
 
   Node query commands. Will query the local node whose Unix domain socket is
@@ -45,3 +46,4 @@ Available commands:
                            node's operational certificate.
   pool-state               Dump the pool state
   tx-mempool               Local Mempool info
+  slot-number              Query slot number for UTC timestamp