-
Notifications
You must be signed in to change notification settings - Fork 16
Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
Add check-node-configuration command
- Loading branch information
Showing
8 changed files
with
195 additions
and
3 deletions.
There are no files selected for viewing
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
11 changes: 11 additions & 0 deletions
11
cardano-cli/src/Cardano/CLI/Commands/Debug/CheckNodeConfiguration.hs
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -0,0 +1,11 @@ | ||
| {-# LANGUAGE DataKinds #-} | ||
|
|
||
| module Cardano.CLI.Commands.Debug.CheckNodeConfiguration where | ||
|
|
||
| import Cardano.Api | ||
|
|
||
| -- | Argument for the 'debug check-node-configuration' command. | ||
| data CheckNodeConfigCmdArgs = CheckNodeConfigCmdArgs | ||
| { configFileToCheck :: !(NodeConfigFile 'In) | ||
| } | ||
| deriving Show |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
135 changes: 135 additions & 0 deletions
135
cardano-cli/src/Cardano/CLI/Run/Debug/CheckNodeConfiguration.hs
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -0,0 +1,135 @@ | ||
| {-# LANGUAGE DataKinds #-} | ||
| {-# LANGUAGE GADTs #-} | ||
| {-# LANGUAGE NamedFieldPuns #-} | ||
| {-# LANGUAGE ScopedTypeVariables #-} | ||
| {-# LANGUAGE TypeFamilies #-} | ||
|
|
||
| module Cardano.CLI.Run.Debug.CheckNodeConfiguration (eraToStringKey, runCheckNodeConfig) where | ||
|
|
||
| import Cardano.Api | ||
|
|
||
| import Cardano.Chain.Genesis (GenesisHash (..), readGenesisData) | ||
| 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 Data.Maybe (catMaybes) | ||
| 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 | ||
| analyses <- catMaybes <$> mapM (\era -> mkAnalysis era configFile nodeConfig) eras | ||
| mapM_ (runAnalysis configFile) analyses | ||
| liftIO $ putStrLn $ "Successfully checked node configuration file: " <> configFilePath | ||
| where | ||
| configFilePath = unFile configFile | ||
| eras :: [AnyCardanoEra] = [minBound .. maxBound] | ||
|
|
||
| data Analysis = Analysis | ||
| { concernedEra :: AnyCardanoEra | ||
| , genesisFilepath :: FilePath | ||
| -- ^ The path to the genesis file, as found in the node configuration file, if any | ||
| , actualHash :: Text.Text | ||
| -- ^ The actual hash of the genesis file, computed from the file's content | ||
| , expectedHash :: Maybe Text.Text | ||
| -- ^ The hash of the genesis file, as found in the node configuration file, if any. | ||
| } | ||
|
|
||
| runAnalysis | ||
| :: NodeConfigFile 'In | ||
| -- ^ The node configuration file. It's not read by this function, but used for producing error messages. | ||
| -> Analysis | ||
| -> ExceptT DebugCmdError IO () | ||
| -- ^ The fixed node configuration file | ||
| runAnalysis configFile (Analysis{concernedEra, genesisFilepath = _, actualHash, expectedHash}) = do | ||
| case expectedHash of | ||
| Nothing -> | ||
| -- Genesis hash is not declared in the node configuration file: we have nothing to check against | ||
| pure () | ||
| Just expectedHash' | ||
| | expectedHash' == actualHash -> | ||
| -- Genesis hash is correct: no error | ||
| pure () | ||
| Just expectedHash' -> | ||
| -- Genesis hash is incorrect: report an error | ||
| throwError $ | ||
| DebugNodeConfigWrongGenesisHashCmdError (unFile configFile) concernedEra actualHash expectedHash' | ||
|
|
||
| -- | Build an 'Analysis' value from the given node configuration file, for the given era. | ||
| -- Reads the genesis file path and hash from the node configuration file, if they exist. | ||
| mkAnalysis | ||
| :: AnyCardanoEra | ||
| -- ^ The era whose data must be analyzed. This parameter isn't about the eras we support. | ||
| -> 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 (Maybe Analysis) | ||
| mkAnalysis cEra@(AnyCardanoEra era) configFile nodeConfig = do | ||
| case (getGenesisFilePath era nodeConfig, getGenesisHash era nodeConfig) of | ||
| (Nothing, Nothing) -> | ||
| -- Neither the genesis file nor the genesis hash are declared in the node configuration file | ||
| -- Note that this is expected for eras whose hash doesn't appear in the node configuration file, | ||
| -- for example Mary. | ||
| pure Nothing | ||
| (Nothing, Just _) -> do | ||
| -- The path to the genesis file is not given in the node configuration file, | ||
| -- but a genesis hash is provided. Since we can't verify the latter, | ||
| -- we write something to stdout, because this is weird. | ||
| liftIO $ | ||
| putStrLn $ | ||
| "Genesis file for " <> Text.unpack (eraToStringKey era) <> " is not declared in " <> configFilePath | ||
| liftIO $ putStrLn "So the hash's correctness cannot be checked." | ||
| pure Nothing | ||
| (Just filepath, expectedHash) -> do | ||
| -- 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 </>) | ||
| let genesisFilePath = takeDirectory configFilePath </> filepath | ||
| actualHash <- | ||
| case era of | ||
| ByronEra -> do | ||
| (_, GenesisHash byronHash) <- | ||
| firstExceptT (DebugNodeConfigGenesisDataCmdError genesisFilePath) $ readGenesisData genesisFilePath | ||
| return $ Text.pack $ show byronHash | ||
| _ -> Crypto.hashToTextAsHex <$> Read.readShelleyOnwardsGenesisAndHash genesisFilePath | ||
| case expectedHash of | ||
| Nothing -> | ||
| pure $ Just $ Analysis cEra genesisFilePath actualHash Nothing | ||
| Just expectedHash' -> | ||
| pure $ Just $ Analysis cEra genesisFilePath actualHash (Just expectedHash') | ||
| where | ||
| configFilePath = unFile configFile | ||
|
|
||
| -- | Get the hash of the genesis file, of the given era. | ||
| getGenesisHash :: CardanoEra a -> NodeConfig -> Maybe Text.Text | ||
| getGenesisHash era config = | ||
| case era of | ||
| MaryEra -> Nothing | ||
| AllegraEra -> Nothing | ||
| BabbageEra -> Nothing | ||
| ByronEra -> Just $ unGenesisHashByron $ ncByronGenesisHash config | ||
| ShelleyEra -> Just $ Crypto.hashToTextAsHex $ unGenesisHashShelley $ ncShelleyGenesisHash config | ||
| AlonzoEra -> Just $ Crypto.hashToTextAsHex $ unGenesisHashAlonzo $ ncAlonzoGenesisHash config | ||
| ConwayEra -> Crypto.hashToTextAsHex . unGenesisHashConway <$> ncConwayGenesisHash config | ||
|
|
||
| -- | Get the path to the genesis file, of the given era. | ||
| getGenesisFilePath :: CardanoEra a -> NodeConfig -> Maybe FilePath | ||
| getGenesisFilePath era config = | ||
| case era of | ||
| MaryEra -> Nothing | ||
| AllegraEra -> Nothing | ||
| BabbageEra -> Nothing | ||
| ByronEra -> Just $ unFile $ ncByronGenesisFile config | ||
| ShelleyEra -> Just $ unFile $ ncShelleyGenesisFile config | ||
| AlonzoEra -> Just $ unFile $ ncAlonzoGenesisFile config | ||
| ConwayEra -> unFile <$> ncConwayGenesisFile config | ||
|
|
||
| -- | Part of the JSON keys associated with the given era. For example, | ||
| -- @eraToStringKey ByronEra@ returns @"Byron"@. | ||
| eraToStringKey :: CardanoEra a -> Text.Text | ||
| eraToStringKey = docToText . pretty |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters