Add check-node-configuration command

IntersectMBO · Oct 29, 2024 · cb352f9 · cb352f9
1 parent b047ed7
commit cb352f9
Show file tree

Hide file tree

Showing 7 changed files with 170 additions and 1 deletion.
diff --git a/cardano-cli/cardano-cli.cabal b/cardano-cli/cardano-cli.cabal
@@ -60,6 +60,7 @@ library
     Cardano.CLI.Commands
     Cardano.CLI.Commands.Address
     Cardano.CLI.Commands.Debug
+    Cardano.CLI.Commands.Debug.CheckNodeConfiguration
     Cardano.CLI.Commands.Debug.LogEpochState
     Cardano.CLI.Commands.Debug.TransactionView
     Cardano.CLI.Commands.Hash
@@ -141,6 +142,7 @@ library
     Cardano.CLI.Run.Address
     Cardano.CLI.Run.Address.Info
     Cardano.CLI.Run.Debug
+    Cardano.CLI.Run.Debug.CheckNodeConfiguration
     Cardano.CLI.Run.Debug.LogEpochState
     Cardano.CLI.Run.Debug.TransactionView
     Cardano.CLI.Run.Hash
@@ -207,6 +209,7 @@ library
     cardano-crypto-wrapper ^>=1.5.1,
     cardano-data >=1.1,
     cardano-git-rev ^>=0.2.2,
+    cardano-ledger-byron,
     cardano-ping ^>=0.5,
     cardano-prelude,
     cardano-slotting ^>=0.2.0.0,

diff --git a/cardano-cli/src/Cardano/CLI/Commands/Debug.hs b/cardano-cli/src/Cardano/CLI/Commands/Debug.hs
@@ -3,9 +3,11 @@ module Cardano.CLI.Commands.Debug
   )
 where
 
+import           Cardano.CLI.Commands.Debug.CheckNodeConfiguration
 import           Cardano.CLI.Commands.Debug.LogEpochState
 import           Cardano.CLI.Commands.Debug.TransactionView
 
 data DebugCmds
-  = DebugLogEpochStateCmd LogEpochStateCmdArgs
+  = DebugCheckNodeConfigurationCmd CheckNodeConfigCmdArgs
+  | DebugLogEpochStateCmd LogEpochStateCmdArgs
   | DebugTransactionViewCmd TransactionViewCmdArgs
diff --git a/cardano-cli/src/Cardano/CLI/Commands/Debug/CheckNodeConfiguration.hs b/cardano-cli/src/Cardano/CLI/Commands/Debug/CheckNodeConfiguration.hs
@@ -0,0 +1,9 @@
+{-# LANGUAGE DataKinds #-}
+
+module Cardano.CLI.Commands.Debug.CheckNodeConfiguration where
+
+import           Cardano.Api
+
+-- | Argument for the 'debug check-node-configuration' command.
+newtype CheckNodeConfigCmdArgs = CheckNodeConfigCmdArgs (NodeConfigFile 'In)
+  deriving Show
diff --git a/cardano-cli/src/Cardano/CLI/Options/Debug.hs b/cardano-cli/src/Cardano/CLI/Options/Debug.hs
@@ -14,6 +14,7 @@ where
 import           Cardano.Api.Shelley hiding (QueryInShelleyBasedEra (..))
 
 import           Cardano.CLI.Commands.Debug
+import           Cardano.CLI.Commands.Debug.CheckNodeConfiguration
 import           Cardano.CLI.Commands.Debug.LogEpochState
 import           Cardano.CLI.Commands.Debug.TransactionView
 import           Cardano.CLI.Environment
@@ -47,6 +48,10 @@ pDebugCmds envCli =
               , " The log file format is line delimited JSON."
               , " The command will not terminate."
               ]
+    , subParser "check-node-configuration" $
+        Opt.info pCheckNodeConfigurationCmdArgs $
+          Opt.progDesc
+            "Check hashes and paths of genesis files in the given node configuration file."
     , subParser "transaction" $
         Opt.info
           ( asum
@@ -65,6 +70,11 @@ pDebugCmds envCli =
         <*> pFileOutDirection
           "out-file"
           "Output filepath of the log file.  The log file format is line delimited JSON."
+  pCheckNodeConfigurationCmdArgs :: Parser DebugCmds
+  pCheckNodeConfigurationCmdArgs =
+    fmap DebugCheckNodeConfigurationCmd $
+      CheckNodeConfigCmdArgs
+        <$> pNodeConfigurationFileIn
   pTransactionView :: Parser DebugCmds
   pTransactionView =
     fmap DebugTransactionViewCmd $

diff --git a/cardano-cli/src/Cardano/CLI/Run/Debug.hs b/cardano-cli/src/Cardano/CLI/Run/Debug.hs
@@ -10,11 +10,13 @@ where
 import           Cardano.Api
 
 import           Cardano.CLI.Commands.Debug
+import           Cardano.CLI.Run.Debug.CheckNodeConfiguration (runCheckNodeConfig)
 import           Cardano.CLI.Run.Debug.LogEpochState
 import           Cardano.CLI.Run.Debug.TransactionView (runTransactionViewCmd)
 import           Cardano.CLI.Types.Errors.DebugCmdError
 
 runDebugCmds :: DebugCmds -> ExceptT DebugCmdError IO ()
 runDebugCmds = \case
+  DebugCheckNodeConfigurationCmd cmd -> runCheckNodeConfig cmd
   DebugLogEpochStateCmd cmd -> liftIO $ runLogEpochStateCmd cmd
   DebugTransactionViewCmd cmd -> firstExceptT DebugTxCmdError $ runTransactionViewCmd cmd
diff --git a/cardano-cli/src/Cardano/CLI/Run/Debug/CheckNodeConfiguration.hs b/cardano-cli/src/Cardano/CLI/Run/Debug/CheckNodeConfiguration.hs
@@ -0,0 +1,91 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
+module Cardano.CLI.Run.Debug.CheckNodeConfiguration (runCheckNodeConfig) where
+
+import           Cardano.Api
+
+import qualified Cardano.Chain.Genesis as Byron
+import           Cardano.CLI.Commands.Debug.CheckNodeConfiguration
+import qualified Cardano.CLI.Read as Read
+import           Cardano.CLI.Types.Errors.DebugCmdError
+import qualified Cardano.Crypto.Hash as Crypto
+
+import           Control.Monad
+import qualified Data.Text as Text
+import qualified Data.Yaml as Yaml
+import           System.FilePath (takeDirectory, (</>))
+
+runCheckNodeConfig :: CheckNodeConfigCmdArgs -> ExceptT DebugCmdError IO ()
+runCheckNodeConfig (CheckNodeConfigCmdArgs configFile) = do
+  nodeConfig :: NodeConfig <- liftIO $ Yaml.decodeFileThrow configFilePath
+  checkNodeGenesisConfiguration configFile nodeConfig
+  liftIO $ putStrLn $ "Successfully checked node configuration file: " <> configFilePath
+ where
+  configFilePath = unFile configFile
+
+checkNodeGenesisConfiguration
+  :: NodeConfigFile 'In
+  -- ^ The node configuration file path. It's not read by this function, but used for producing error messages.
+  -> NodeConfig
+  -- ^ The parsed node configuration file
+  -> ExceptT DebugCmdError IO ()
+checkNodeGenesisConfiguration configFile nodeConfig = do
+  let byronGenFile = adjustFilepath $ unFile $ ncByronGenesisFile nodeConfig
+      alonzoGenFile = adjustFilepath $ unFile $ ncAlonzoGenesisFile nodeConfig
+      shelleyGenFile = adjustFilepath $ unFile $ ncShelleyGenesisFile nodeConfig
+  conwayGenFile <- case ncConwayGenesisFile nodeConfig of
+    Nothing -> throwError $ DebugNodeConfigNoConwayFileCmdError configFilePath
+    Just conwayGenesisFile -> pure $ adjustFilepath $ unFile conwayGenesisFile
+
+  liftIO $ putStrLn $ "Checking byron genesis file: " <> byronGenFile
+
+  let expectedByronHash = unGenesisHashByron $ ncByronGenesisHash nodeConfig
+      expectedAlonzoHash = Crypto.hashToTextAsHex $ unGenesisHashAlonzo $ ncAlonzoGenesisHash nodeConfig
+      expectedShelleyHash = Crypto.hashToTextAsHex $ unGenesisHashShelley $ ncShelleyGenesisHash nodeConfig
+  expectedConwayHash <- case ncConwayGenesisHash nodeConfig of
+    Nothing -> throwError $ DebugNodeConfigNoConwayHashCmdError configFilePath
+    Just conwayGenesisHash -> pure $ Crypto.hashToTextAsHex $ unGenesisHashConway conwayGenesisHash
+
+  (_, Byron.GenesisHash byronHash) <-
+    firstExceptT (DebugNodeConfigGenesisDataCmdError byronGenFile) $
+      Byron.readGenesisData byronGenFile
+  let actualByronHash = Text.pack $ show byronHash
+  actualAlonzoHash <- Crypto.hashToTextAsHex <$> Read.readShelleyOnwardsGenesisAndHash alonzoGenFile
+  actualShelleyHash <- Crypto.hashToTextAsHex <$> Read.readShelleyOnwardsGenesisAndHash shelleyGenFile
+  actualConwayHash <- Crypto.hashToTextAsHex <$> Read.readShelleyOnwardsGenesisAndHash conwayGenFile
+
+  when (actualByronHash /= expectedByronHash) $
+    throwError $
+      DebugNodeConfigWrongGenesisHashCmdError
+        configFilePath
+        byronGenFile
+        actualByronHash
+        expectedByronHash
+  when (actualAlonzoHash /= expectedAlonzoHash) $
+    throwError $
+      DebugNodeConfigWrongGenesisHashCmdError
+        configFilePath
+        alonzoGenFile
+        actualAlonzoHash
+        expectedAlonzoHash
+  when (actualShelleyHash /= expectedShelleyHash) $
+    throwError $
+      DebugNodeConfigWrongGenesisHashCmdError
+        configFilePath
+        shelleyGenFile
+        actualShelleyHash
+        expectedShelleyHash
+  when (actualConwayHash /= expectedConwayHash) $
+    throwError $
+      DebugNodeConfigWrongGenesisHashCmdError
+        configFilePath
+        conwayGenFile
+        actualConwayHash
+        expectedConwayHash
+ where
+  configFilePath = unFile configFile
+  -- We make the genesis filepath relative to the node configuration file, like the node does:
+  -- https://github.com/IntersectMBO/cardano-node/blob/9671e7b6a1b91f5a530722937949b86deafaad43/cardano-node/src/Cardano/Node/Configuration/POM.hs#L668
+  -- Note that, if the genesis filepath is absolute, the node configuration file's directory is ignored (by property of </>)
+  adjustFilepath f = takeDirectory configFilePath </> f
diff --git a/cardano-cli/src/Cardano/CLI/Types/Errors/DebugCmdError.hs b/cardano-cli/src/Cardano/CLI/Types/Errors/DebugCmdError.hs
@@ -7,13 +7,65 @@ where
 
 import           Cardano.Api
 
+import           Cardano.Chain.Genesis
 import           Cardano.CLI.Types.Errors.TxCmdError
 
+import           Data.Text (Text)
+import qualified Data.Text.Lazy.Builder as Text
+import           Formatting.Buildable (build)
+
 data DebugCmdError
   = DebugCmdFailed
+  | -- | @DebugNodeConfigGenesisDataCmdError filepath error@ represents an error when
+    -- reading the node configuration at @filepath@
+    DebugNodeConfigGenesisDataCmdError !FilePath !GenesisDataError
+  | -- | @DebugNodeConfigWrongGenesisHashCmdError filepath eraGenesisPath actualHash expectedHash@ represents a user error
+    -- that the hash of @eraGenesisPath@ in @filepath@ is @actualHash@, whereas it should be @expectedHash@
+    DebugNodeConfigWrongGenesisHashCmdError
+      !FilePath
+      -- ^ The file path of the node configuration file
+      !FilePath
+      -- ^ The file path of the era configuration file whose hash is wrong
+      !Text
+      -- ^ The actual hash (the hash found by hashing the genesis file)
+      !Text
+      -- ^ The expected hash (the hash mentioned in the configuration file)
+  | -- | @DebugNodeConfigNoConwayFileCmdError filepath@ represents a user error
+    -- that the genesis file for Conway in @filepath@ is not specified
+    DebugNodeConfigNoConwayFileCmdError
+      !FilePath
+  | -- | @DebugNodeConfigNoConwayHashCmdError filepath@ represents a user error
+    -- that the hash for the Conway genesis file in @filepath@ is not specified
+    DebugNodeConfigNoConwayHashCmdError
+      !FilePath
+      -- ^ The file path of the node configuration file
   | DebugTxCmdError !TxCmdError
 
 instance Error DebugCmdError where
   prettyError = \case
     DebugCmdFailed -> "Debug command failed"
+    DebugNodeConfigGenesisDataCmdError fp err ->
+      "Error reading node configuration at: "
+        <> pretty fp
+        <> ": "
+        <> pretty (Text.toLazyText $ build err)
+    DebugNodeConfigNoConwayFileCmdError fp ->
+      "Conway genesis file not specified in "
+        <> pretty fp
+        <> ". Please add a \"ConwayGenesisFile\" key to the file at "
+        <> pretty fp
+    DebugNodeConfigNoConwayHashCmdError fp ->
+      "Conway genesis hash not specified in "
+        <> pretty fp
+        <> ". Please add a \"ConwayGenesisHash\" key to the file at "
+        <> pretty fp
+    DebugNodeConfigWrongGenesisHashCmdError nodeFp genesisFp actualHash expectedHash ->
+      "Wrong genesis hash for "
+        <> pretty genesisFp
+        <> " in "
+        <> pretty nodeFp
+        <> ": when computing the hash, got: "
+        <> pretty actualHash
+        <> ", but the node configuration files states that this hash is expected: "
+        <> pretty expectedHash
     DebugTxCmdError err -> renderTxCmdError err