diff --git a/cardano-node/cardano-node.cabal b/cardano-node/cardano-node.cabal index dc2ec35072b..e9bc0194345 100644 --- a/cardano-node/cardano-node.cabal +++ b/cardano-node/cardano-node.cabal @@ -32,8 +32,9 @@ library hs-source-dirs: src - exposed-modules: Cardano.Node.Configuration.Topology - Cardano.Node.Configuration.Logging + exposed-modules: Cardano.Node.Configuration.Logging + Cardano.Node.Configuration.POM + Cardano.Node.Configuration.Topology Cardano.Node.Handlers.Shutdown Cardano.Node.Handlers.TopLevel Cardano.Node.Orphans @@ -86,6 +87,7 @@ library , containers , directory , filepath + , generic-data , hostname , iproute , io-sim-classes diff --git a/cardano-node/src/Cardano/Node/Configuration/POM.hs b/cardano-node/src/Cardano/Node/Configuration/POM.hs new file mode 100644 index 00000000000..a95bee315ce --- /dev/null +++ b/cardano-node/src/Cardano/Node/Configuration/POM.hs @@ -0,0 +1,285 @@ + +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE NamedFieldPuns #-} + +{-# OPTIONS_GHC -Wno-noncanonical-monoid-instances #-} + +module Cardano.Node.Configuration.POM + ( defaultPartialNodeConfiguration + , makeNodeConfiguration + ) +where + +import Cardano.Prelude +import Prelude (String) + +import Control.Monad (fail) +import Data.Aeson +import Data.Semigroup (Semigroup (..)) +import Generic.Data (gmappend) +import Generic.Data.Orphans () +import System.Posix.Types (Fd (..)) + +import qualified Cardano.Chain.Update as Byron +import Cardano.Crypto (RequiresNetworkMagic (..)) +import Cardano.Node.Protocol.Types (Protocol (..)) +import Cardano.Node.Types hiding (NodeConfiguration (..)) +import Cardano.Tracing.Config +import Ouroboros.Network.Block (MaxSlotNo (..)) + +data NodeConfigurationF + = NodeConfigurationF + { ncNodeAddr :: !(Maybe NodeAddress) + -- | Filepath of the configuration yaml file. This file determines + -- all the configuration settings required for the cardano node + -- (logging, tracing, protocol, slot length etc) + , ncConfigFile :: !ConfigYamlFilePath + , ncTopologyFile :: !TopologyFile + , ncDatabaseFile :: !DbFile + , ncProtocolFiles :: !ProtocolFilepaths + , ncValidateDB :: !Bool + , ncShutdownIPC :: !(Maybe Fd) + , ncShutdownOnSlotSynced :: !MaxSlotNo + + -- What used to be the NodeConfiguration + -- Protocol-specific parameters: + , ncProtocolConfig :: NodeProtocolConfiguration + + -- Node parameters, not protocol-specific: + , ncSocketPath :: Maybe SocketPath + + -- BlockFetch configuration + , ncMaxConcurrencyBulkSync :: Maybe MaxConcurrencyBulkSync + , ncMaxConcurrencyDeadline :: Maybe MaxConcurrencyDeadline + + -- Logging parameters: + , ncViewMode :: ViewMode + , ncLoggingSwitch :: Bool + , ncLogMetrics :: Bool + , ncTraceConfig :: TraceOptions + } deriving Show + + +data PartialNodeConfiguration + = PartialNodeConfiguration + { -- Previously NodeCLI + pncnodeAddr :: !(Last (Maybe NodeAddress)) + -- | Filepath of the configuration yaml file. This file determines + -- all the configuration settings required for the cardano node + -- (logging, tracing, protocol, slot length etc) + , pncconfigFile :: !(Last ConfigYamlFilePath) + , pnctopologyFile :: !(Last TopologyFile) + , pncdatabaseFile :: !(Last DbFile) +-- , pncsocketFile :: !(Last (Maybe SocketPath)) + , pncprotocolFiles :: !(Last ProtocolFilepaths) + , pncvalidateDB :: !(Last Bool) + , pncshutdownIPC :: !(Last (Maybe Fd)) + , pncshutdownOnSlotSynced :: !(Last MaxSlotNo) + + -- From here onward was the original NodeConfiguration + -- Protocol-specific parameters: + , pncProtocolConfig :: !(Last NodeProtocolConfiguration) + + -- Node parameters, not protocol-specific: + , pncSocketPath :: !(Last (Maybe SocketPath)) + + -- BlockFetch configuration + , pncMaxConcurrencyBulkSync :: !(Last (Maybe MaxConcurrencyBulkSync)) + , pncMaxConcurrencyDeadline :: !(Last (Maybe MaxConcurrencyDeadline)) + + -- Logging parameters: + , pncViewMode :: !(Last ViewMode) + , pncLoggingSwitch :: !(Last Bool) + , pncLogMetrics :: !(Last Bool) + , pncTraceConfig :: !(Last TraceOptions) + } deriving (Eq, Generic, Show) + +instance Semigroup PartialNodeConfiguration where + (<>) = gmappend + +instance Monoid PartialNodeConfiguration where + mempty = PartialNodeConfiguration mempty mempty mempty mempty mempty mempty mempty mempty mempty mempty mempty mempty mempty mempty mempty mempty + mappend x y = PartialNodeConfiguration + { pncnodeAddr = pncnodeAddr x <> pncnodeAddr y + , pncconfigFile = pncconfigFile x <> pncconfigFile y + , pnctopologyFile = pnctopologyFile x <> pnctopologyFile y + , pncdatabaseFile = pncdatabaseFile x <> pncdatabaseFile y + -- , pncsocketFile = pncsocketFile x <> pncsocketFile y + , pncprotocolFiles = pncprotocolFiles x <> pncprotocolFiles y + , pncvalidateDB = pncvalidateDB x <> pncvalidateDB y + , pncshutdownIPC = pncshutdownIPC x <> pncshutdownIPC y + , pncshutdownOnSlotSynced = pncshutdownOnSlotSynced x <> pncshutdownOnSlotSynced y + , pncProtocolConfig = pncProtocolConfig x <> pncProtocolConfig y + , pncSocketPath = pncSocketPath x <> pncSocketPath y + , pncMaxConcurrencyBulkSync = pncMaxConcurrencyBulkSync x <> pncMaxConcurrencyBulkSync y + , pncMaxConcurrencyDeadline = pncMaxConcurrencyDeadline x <> pncMaxConcurrencyDeadline y + , pncViewMode = pncViewMode x <> pncViewMode y + , pncLoggingSwitch = pncLoggingSwitch x <> pncLoggingSwitch y + , pncLogMetrics = pncLogMetrics x <> pncLogMetrics y + , pncTraceConfig = pncTraceConfig x <> pncTraceConfig y + } + + +instance FromJSON PartialNodeConfiguration where + parseJSON = + withObject "PartialNodeConfiguration" $ \v -> do + + -- Node parameters, not protocol-specific + pncSocketPath' <- Last <$> v .:? "SocketPath" + + -- Blockfetch parameters + pncMaxConcurrencyBulkSync' <- Last <$> v .:? "MaxConcurrencyBulkSync" + pncMaxConcurrencyDeadline' <- Last <$> v .:? "MaxConcurrencyDeadline" + + -- Logging parameters + pncViewMode' <- Last <$> v .:? "ViewMode" -- This needs to be in the default config .!= SimpleView + pncLoggingSwitch' <- v .:? "TurnOnLogging" .!= True -- This needs to be in the default config .!= True + pncLogMetrics' <- Last <$> v .:? "TurnOnLogMetrics" -- This needs to be in the default config .!= True + pncTraceConfig' <- if pncLoggingSwitch' -- TODO: Need to unpackage last and check the bool + then Last . Just <$> traceConfigParser v + else return . Last $ Just TracingOff + + -- Protocol parameters + protocol <- v .:? "Protocol" .!= ByronProtocol -- Should be in the default config + pncProtocolConfig' <- + case protocol of + ByronProtocol -> + Last . Just . NodeProtocolConfigurationByron <$> parseByronProtocol v + + ShelleyProtocol -> + Last . Just . NodeProtocolConfigurationShelley <$> parseShelleyProtocol v + + CardanoProtocol -> + Last . Just <$> (NodeProtocolConfigurationCardano <$> parseByronProtocol v + <*> parseShelleyProtocol v + <*> parseHardForkProtocol v) + pure mempty { + pncProtocolConfig = pncProtocolConfig' + , pncSocketPath = pncSocketPath' + , pncMaxConcurrencyBulkSync = pncMaxConcurrencyBulkSync' + , pncMaxConcurrencyDeadline = pncMaxConcurrencyDeadline' + , pncViewMode = pncViewMode' + , pncLoggingSwitch = Last $ Just pncLoggingSwitch' + , pncLogMetrics = pncLogMetrics' + , pncTraceConfig = pncTraceConfig' + } + where + parseByronProtocol v = do + primary <- v .:? "ByronGenesisFile" + secondary <- v .:? "GenesisFile" + npcByronGenesisFile <- + case (primary, secondary) of + (Just g, Nothing) -> return g + (Nothing, Just g) -> return g + (Nothing, Nothing) -> fail $ "Missing required field, either " + ++ "ByronGenesisFile or GenesisFile" + (Just _, Just _) -> fail $ "Specify either ByronGenesisFile" + ++ "or GenesisFile, but not both" + npcByronGenesisFileHash <- v .:? "ByronGenesisHash" + + npcByronReqNetworkMagic <- v .:? "RequiresNetworkMagic" + .!= RequiresNoMagic + npcByronPbftSignatureThresh <- v .:? "PBftSignatureThreshold" + npcByronApplicationName <- v .:? "ApplicationName" + .!= Byron.ApplicationName "cardano-sl" + npcByronApplicationVersion <- v .:? "ApplicationVersion" .!= 1 + protVerMajor <- v .: "LastKnownBlockVersion-Major" + protVerMinor <- v .: "LastKnownBlockVersion-Minor" + protVerAlt <- v .: "LastKnownBlockVersion-Alt" .!= 0 + + pure NodeByronProtocolConfiguration { + npcByronGenesisFile + , npcByronGenesisFileHash + , npcByronReqNetworkMagic + , npcByronPbftSignatureThresh + , npcByronApplicationName + , npcByronApplicationVersion + , npcByronSupportedProtocolVersionMajor = protVerMajor + , npcByronSupportedProtocolVersionMinor = protVerMinor + , npcByronSupportedProtocolVersionAlt = protVerAlt + } + + parseShelleyProtocol v = do + primary <- v .:? "ShelleyGenesisFile" + secondary <- v .:? "GenesisFile" + npcShelleyGenesisFile <- + case (primary, secondary) of + (Just g, Nothing) -> return g + (Nothing, Just g) -> return g + (Nothing, Nothing) -> fail $ "Missing required field, either " + ++ "ShelleyGenesisFile or GenesisFile" + (Just _, Just _) -> fail $ "Specify either ShelleyGenesisFile" + ++ "or GenesisFile, but not both" + npcShelleyGenesisFileHash <- v .:? "ShelleyGenesisHash" + + --TODO: these are silly names, allow better aliases: + protVerMajor <- v .: "LastKnownBlockVersion-Major" + protVerMinor <- v .: "LastKnownBlockVersion-Minor" + protVerMajroMax <- v .:? "MaxKnownMajorProtocolVersion" .!= 1 + + pure NodeShelleyProtocolConfiguration { + npcShelleyGenesisFile + , npcShelleyGenesisFileHash + , npcShelleySupportedProtocolVersionMajor = protVerMajor + , npcShelleySupportedProtocolVersionMinor = protVerMinor + , npcShelleyMaxSupportedProtocolVersion = protVerMajroMax + } + + parseHardForkProtocol v = do + npcTestShelleyHardForkAtEpoch <- v .:? "TestShelleyHardForkAtEpoch" + npcTestShelleyHardForkAtVersion <- v .:? "TestShelleyHardForkAtVersion" + npcShelleyHardForkNotBeforeEpoch <- v .:? "ShelleyHardForkNotBeforeEpoch" + pure NodeHardForkProtocolConfiguration { + npcTestShelleyHardForkAtEpoch, + npcTestShelleyHardForkAtVersion, + npcShelleyHardForkNotBeforeEpoch + } +defaultPartialNodeConfiguration :: PartialNodeConfiguration +defaultPartialNodeConfiguration = mempty + { pncViewMode = Last $ Just SimpleView + , pncLoggingSwitch = Last $ Just True + } + +lastToEither :: String -> Last a -> Either String a +lastToEither errMsg (Last x) = maybe (Left errMsg) Right x + +makeNodeConfiguration :: PartialNodeConfiguration -> Either String NodeConfigurationF +makeNodeConfiguration pnc = do + nodeAddr <- lastToEither "Missing Node Address" $ pncnodeAddr pnc + configFile <- lastToEither "Missing ConfigFile" $ pncconfigFile pnc + topologyFile <- lastToEither "Missing TopologyFile" $ pnctopologyFile pnc + databaseFile <- lastToEither "Missing DatabaseFile" $ pncdatabaseFile pnc +-- socketFile <- lastToEither "Missing SocketFile" $ pncsocketFile pnc + protocolFiles <- lastToEither "Missing ProtocolFiles" $ pncprotocolFiles pnc + validateDB <- lastToEither "Missing ValidateDB" $ pncvalidateDB pnc + shutdownIPC <- lastToEither "Missing ShutdownIPC" $ pncshutdownIPC pnc + shutdownOnSlotSynced <- lastToEither "Missing ShutdownOnSlotSynced" $ pncshutdownOnSlotSynced pnc + + + + protocolConfig <- lastToEither "Missing ProtocolConfig" $ pncProtocolConfig pnc + socketPath <- lastToEither "Missing SocketPath" $ pncSocketPath pnc + maxConcurrencyBulkSync <- lastToEither "Missing MaxConcurrencyBulkSync" $ pncMaxConcurrencyBulkSync pnc + maxConcurrencyDeadline <- lastToEither "Missing MaxConcurrencyDeadline" $ pncMaxConcurrencyDeadline pnc + viewMode <- lastToEither "Missing ViewMode" $ pncViewMode pnc + loggingSwitch <- lastToEither "Missing LoggingSwitch" $ pncLoggingSwitch pnc + logMetrics <- lastToEither "Missing LogMetrics" $ pncLogMetrics pnc + traceConfig <- lastToEither "Missing TraceConfig" $ pncTraceConfig pnc + return $ NodeConfigurationF + { ncNodeAddr = nodeAddr + , ncConfigFile = configFile + , ncTopologyFile = topologyFile + , ncDatabaseFile = databaseFile + , ncProtocolFiles = protocolFiles + , ncValidateDB = validateDB + , ncShutdownIPC = shutdownIPC + , ncShutdownOnSlotSynced = shutdownOnSlotSynced + , ncProtocolConfig = protocolConfig + , ncSocketPath = socketPath + , ncMaxConcurrencyBulkSync = maxConcurrencyBulkSync + , ncMaxConcurrencyDeadline = maxConcurrencyDeadline + , ncViewMode = viewMode + , ncLoggingSwitch = loggingSwitch + , ncLogMetrics = logMetrics + , ncTraceConfig = traceConfig + } diff --git a/cardano-node/src/Cardano/Node/Types.hs b/cardano-node/src/Cardano/Node/Types.hs index ab98545f286..2408cf1d3d3 100644 --- a/cardano-node/src/Cardano/Node/Types.hs +++ b/cardano-node/src/Cardano/Node/Types.hs @@ -64,7 +64,7 @@ newtype ConfigYamlFilePath = ConfigYamlFilePath newtype DbFile = DbFile { unDB :: FilePath } - deriving newtype Show + deriving newtype (Eq, Show) newtype GenesisFile = GenesisFile { unGenesisFile :: FilePath } @@ -178,6 +178,45 @@ data NodeConfiguration , ncTraceConfig :: TraceOptions } deriving Show + +{- +data NodeCLI = NodeCLI + { + } + +data NodeConfiguration + = NodeConfiguration + { ncNodeAddr :: !(Maybe NodeAddress) + -- | Filepath of the configuration yaml file. This file determines + -- all the configuration settings required for the cardano node + -- (logging, tracing, protocol, slot length etc) + , ncConfigFile :: !ConfigYamlFilePath + , ncTopologyFile :: !TopologyFile + , ncDatabaseFile :: !DbFile + , ncProtocolFiles :: !ProtocolFilepaths + , ncValidateDB :: !Bool + , ncShutdownIPC :: !(Maybe Fd) + , ncShutdownOnSlotSynced :: !MaxSlotNo + + -- What used to be the NodeConfiguration + -- Protocol-specific parameters: + , ncProtocolConfig :: NodeProtocolConfiguration + + -- Node parameters, not protocol-specific: + , ncSocketPath :: Maybe SocketPath + + -- BlockFetch configuration + , ncMaxConcurrencyBulkSync :: Maybe MaxConcurrencyBulkSync + , ncMaxConcurrencyDeadline :: Maybe MaxConcurrencyDeadline + + -- Logging parameters: + , ncViewMode :: ViewMode + , ncLoggingSwitch :: Bool + , ncLogMetrics :: Bool + , ncTraceConfig :: TraceOptions + } deriving Show +-} + class AdjustFilePaths a where adjustFilePaths :: (FilePath -> FilePath) -> a -> a @@ -313,7 +352,7 @@ data ProtocolFilepaths = , shelleyKESFile :: !(Maybe FilePath) , shelleyVRFFile :: !(Maybe FilePath) , shelleyCertFile :: !(Maybe FilePath) - } + } deriving (Eq, Show) newtype GenesisHash = GenesisHash (Crypto.Hash Crypto.Blake2b_256 ByteString) deriving newtype (Eq, Show, ToJSON, FromJSON) @@ -324,7 +363,7 @@ data NodeProtocolConfiguration = | NodeProtocolConfigurationCardano NodeByronProtocolConfiguration NodeShelleyProtocolConfiguration NodeHardForkProtocolConfiguration - deriving Show + deriving (Eq, Show) data NodeShelleyProtocolConfiguration = NodeShelleyProtocolConfiguration { @@ -346,7 +385,7 @@ data NodeShelleyProtocolConfiguration = -- will stop with an appropriate error message. , npcShelleyMaxSupportedProtocolVersion :: !Natural } - deriving Show + deriving (Eq, Show) data NodeByronProtocolConfiguration = NodeByronProtocolConfiguration { @@ -372,7 +411,7 @@ data NodeByronProtocolConfiguration = , npcByronSupportedProtocolVersionMinor :: !Word16 , npcByronSupportedProtocolVersionAlt :: !Word8 } - deriving Show + deriving (Eq, Show) -- | Configuration relating to a hard forks themselves, not the specific eras. -- @@ -403,7 +442,7 @@ data NodeHardForkProtocolConfiguration = -- , npcTestShelleyHardForkAtVersion :: Maybe Word } - deriving Show + deriving (Eq, Show) newtype SocketPath = SocketPath { unSocketPath :: FilePath } @@ -412,7 +451,7 @@ newtype SocketPath = SocketPath newtype TopologyFile = TopologyFile { unTopology :: FilePath } - deriving newtype Show + deriving newtype (Show, Eq) instance AdjustFilePaths NodeProtocolConfiguration where diff --git a/cardano-node/src/Cardano/Tracing/Config.hs b/cardano-node/src/Cardano/Tracing/Config.hs index dfc8bbbd2b2..dcd510744ef 100644 --- a/cardano-node/src/Cardano/Tracing/Config.hs +++ b/cardano-node/src/Cardano/Tracing/Config.hs @@ -20,7 +20,7 @@ import Cardano.Node.Orphans () data TraceOptions = TracingOff | TracingOn TraceSelection - deriving Show + deriving (Eq, Show) data TraceSelection = TraceSelection