#4928 Testing conversion function

IntersectMBO · Apr 21, 2023 · 9cb709d · 9cb709d
1 parent 5a7f583
commit 9cb709d
Show file tree

Hide file tree

Showing 3 changed files with 45 additions and 2 deletions.
diff --git a/cardano-cli/src/Cardano/CLI/Shelley/Commands.hs b/cardano-cli/src/Cardano/CLI/Shelley/Commands.hs
@@ -16,6 +16,7 @@ module Cardano.CLI.Shelley.Commands
   , GovernanceCmd (..)
   , GenesisCmd (..)
   , TextViewCmd (..)
+  , CalculateSlotTimeCmd (..)
   , renderShelleyCommand
 
     -- * CLI flag types
@@ -50,6 +51,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,
@@ -75,6 +77,7 @@ data ShelleyCommand
   | GovernanceCmd   GovernanceCmd
   | GenesisCmd      GenesisCmd
   | TextViewCmd     TextViewCmd
+  | CalculateSlotTimeCmd CalculateSlotTimeCmd
 
 renderShelleyCommand :: ShelleyCommand -> Text
 renderShelleyCommand sc =
@@ -89,6 +92,7 @@ renderShelleyCommand sc =
     GovernanceCmd cmd -> renderGovernanceCmd cmd
     GenesisCmd cmd -> renderGenesisCmd cmd
     TextViewCmd cmd -> renderTextViewCmd cmd
+    CalculateSlotTimeCmd cmd -> renderCalculateSlotTimeCmd cmd
 
 data AddressCmd
   = AddressKeyGen AddressKeyType (VerificationKeyFile Out) (SigningKeyFile Out)
@@ -444,6 +448,14 @@ data TextViewCmd
 renderTextViewCmd :: TextViewCmd -> Text
 renderTextViewCmd (TextViewInfo _ _) = "text-view decode-cbor"
 
+data CalculateSlotTimeCmd =
+  CalculateSlotTimeCmd' (Maybe SocketPath) AnyConsensusModeParams NetworkId UTCTime
+  deriving Show
+
+renderCalculateSlotTimeCmd :: CalculateSlotTimeCmd -> Text
+renderCalculateSlotTimeCmd _ = "calculateslottime"
+
+
 data GenesisCmd
   = GenesisCreate GenesisDir Word Word (Maybe SystemStart) (Maybe Lovelace) NetworkId
   | GenesisCreateCardano GenesisDir Word Word (Maybe SystemStart) (Maybe Lovelace) BlockCount Word Rational NetworkId FilePath FilePath FilePath FilePath (Maybe FilePath)

diff --git a/cardano-cli/src/Cardano/CLI/Shelley/Parsers.hs b/cardano-cli/src/Cardano/CLI/Shelley/Parsers.hs
@@ -109,9 +109,27 @@ parseShelleyCommands =
                , "Transactions, addresses etc are stored on disk as TextView files."
                ]
             )
-
+      , Opt.command "calculateslottime"
+          (Opt.info (CalculateSlotTimeCmd <$> pCalculateSlotTimeCmd) $ Opt.progDesc  "calculateslottime")
       ]
 
+pCalculateSlotTimeCmd :: Parser CalculateSlotTimeCmd
+pCalculateSlotTimeCmd =
+  CalculateSlotTimeCmd'
+    <$> pSocketPath
+    <*> pConsensusModeParams
+    <*> pNetworkId
+    <*> pUTCTime
+      where
+        pUTCTime :: Parser UTCTime
+        pUTCTime = do
+          convertTime <$> Opt.strOption (Opt.long "utc-time")
+
+        convertTime :: String -> UTCTime
+        convertTime =
+          parseTimeOrError False defaultTimeLocale "%Y-%m-%dT%H:%M:%SZ"
+
+
 pTextViewCmd :: Parser TextViewCmd
 pTextViewCmd =
   asum

diff --git a/cardano-cli/src/Cardano/CLI/Shelley/Run.hs b/cardano-cli/src/Cardano/CLI/Shelley/Run.hs
@@ -10,9 +10,10 @@ import           Data.Text (Text)
 import           Cardano.Api
 
 import           Control.Monad.Trans.Except.Extra (firstExceptT)
+import Control.Monad.IO.Class
 import qualified Data.Text as Text
 
-import           Cardano.CLI.Shelley.Parsers
+import           Cardano.CLI.Shelley.Commands
 
 import           Cardano.CLI.Shelley.Run.Address
 import           Cardano.CLI.Shelley.Run.Governance
@@ -37,6 +38,7 @@ data ShelleyClientCmdError
   | ShelleyCmdTransactionError !ShelleyTxCmdError
   | ShelleyCmdQueryError !ShelleyQueryCmdError
   | ShelleyCmdKeyError !ShelleyKeyCmdError
+  | ShelleyCmdCalculateSlotTimeError !Text
 
 renderShelleyClientCmdError :: ShelleyCommand -> ShelleyClientCmdError -> Text
 renderShelleyClientCmdError cmd err =
@@ -61,6 +63,8 @@ renderShelleyClientCmdError cmd err =
        renderError cmd renderShelleyQueryCmdError queryErr
     ShelleyCmdKeyError keyErr ->
        renderError cmd renderShelleyKeyCmdError keyErr
+    ShelleyCmdCalculateSlotTimeError txt ->
+       renderError cmd id txt
  where
    renderError :: ShelleyCommand -> (a -> Text) -> a -> Text
    renderError shelleyCmd renderer shelCliCmdErr =
@@ -86,3 +90,12 @@ runShelleyClientCommand (QueryCmd        cmd) = firstExceptT ShelleyCmdQueryErro
 runShelleyClientCommand (GovernanceCmd   cmd) = firstExceptT ShelleyCmdGovernanceError $ runGovernanceCmd cmd
 runShelleyClientCommand (GenesisCmd      cmd) = firstExceptT ShelleyCmdGenesisError $ runGenesisCmd cmd
 runShelleyClientCommand (TextViewCmd     cmd) = firstExceptT ShelleyCmdTextViewError $ runTextViewCmd cmd
+runShelleyClientCommand (CalculateSlotTimeCmd cmd) = firstExceptT ShelleyCmdCalculateSlotTimeError $ runCalculateSlotTime cmd
+
+
+runCalculateSlotTime :: CalculateSlotTimeCmd -> ExceptT Text IO ()
+runCalculateSlotTime cstc@(CalculateSlotTimeCmd' mSocketPath acm nid utcTime) = firstExceptT (Text.pack . show) $ do
+  liftIO $ print cstc
+  slot <- utcTimeToSlotNo mSocketPath acm nid utcTime
+  liftIO $ putStrLn "SLOTNO"
+  liftIO $ print slot