From 22f7aadd20b5a44608fff93634ebba88c0df878d Mon Sep 17 00:00:00 2001 From: Javier Sagredo Date: Fri, 19 Jun 2026 18:17:55 +0200 Subject: [PATCH] Switch to cardano-config --- cabal.project | 8 + cardano-node-capi/cardano-node-capi.cabal | 3 +- cardano-node-capi/src/Node.hs | 12 +- cardano-node/app/cardano-node.hs | 26 +- cardano-node/cardano-node.cabal | 6 +- .../src/Cardano/Node/Configuration/Adapter.hs | 396 +++++++++++++++ cardano-node/src/Cardano/Node/Parsers.hs | 469 ------------------ cardano-node/src/Cardano/Node/Run.hs | 79 +-- 8 files changed, 468 insertions(+), 531 deletions(-) create mode 100644 cardano-node/src/Cardano/Node/Configuration/Adapter.hs delete mode 100644 cardano-node/src/Cardano/Node/Parsers.hs diff --git a/cabal.project b/cabal.project index 03ebe5305a2..2671a879bde 100644 --- a/cabal.project +++ b/cabal.project @@ -186,3 +186,11 @@ source-repository-package location: https://github.com/f-f/ekg-forward tag: b24b3aba2806ce223c62f8ce3e267ec92dcc52e2 --sha256: sha256-s5Hxxm04HmFVmdBjAnFEsJEhTqr5Z/uiB4K1s2VaVwE= + +source-repository-package + type: git + location: https://github.com/IntersectMBO/cardano-base + tag: 0cb3b722c9af9e9afbee25d4fa66b5cab917d781 + --sha256: sha256-QtJ9Q56fPQm6S1AYMcKbj9WAbtAyxZxb8x0NSQNbKMs= + subdir: + cardano-config diff --git a/cardano-node-capi/cardano-node-capi.cabal b/cardano-node-capi/cardano-node-capi.cabal index d50d59e6e1e..2be5a5f3c38 100644 --- a/cardano-node-capi/cardano-node-capi.cabal +++ b/cardano-node-capi/cardano-node-capi.cabal @@ -21,8 +21,7 @@ library import: project-config exposed-modules: Node build-depends: base >= 4.14 && < 5 - , aeson - , bytestring + , cardano-config , cardano-node , optparse-applicative hs-source-dirs: src diff --git a/cardano-node-capi/src/Node.hs b/cardano-node-capi/src/Node.hs index 2db6b7730b7..d9277084c57 100644 --- a/cardano-node-capi/src/Node.hs +++ b/cardano-node-capi/src/Node.hs @@ -1,11 +1,8 @@ module Node where -import Cardano.Node.Parsers (nodeCLIParser, parserHelpHeader, parserHelpOptions, - renderHelpDoc) +import qualified Cardano.Configuration as CC import Cardano.Node.Run (runNode) -import Data.Aeson (eitherDecodeStrict) -import Data.ByteString.Char8 (pack) import Options.Applicative import Foreign.C (CString, peekCString) @@ -19,10 +16,13 @@ foreign export ccall "runNode" crunNode :: Int -> Ptr CString -> IO () crunNode :: Int -> Ptr CString -> IO () crunNode argc argv = peekArray argc argv >>= mapM peekCString >>= \args -> case execParserPure pref opts args of - Success pnc -> runNode pnc + Success cli -> runNode cli Failure f -> print f CompletionInvoked _ -> putStrLn "Completion Invoked?" where pref = prefs showHelpOnEmpty - opts = info nodeCLIParser + opts = info (nodeRunParser <**> helper) ( fullDesc <> progDesc "Start node of the Cardano blockchain." ) + nodeRunParser = + subparser $ + command "run" (info (CC.parseCliArgs <**> helper) (progDesc "Run the node.")) diff --git a/cardano-node/app/cardano-node.hs b/cardano-node/app/cardano-node.hs index 563193bd652..12779ace684 100644 --- a/cardano-node/app/cardano-node.hs +++ b/cardano-node/app/cardano-node.hs @@ -4,23 +4,20 @@ {-# LANGUAGE RankNTypes #-} {-# LANGUAGE TemplateHaskell #-} +import qualified Cardano.Configuration as CC import qualified Cardano.Crypto.Init as Crypto import Cardano.Git.Rev (gitRev) -import Cardano.Node.Configuration.POM (PartialNodeConfiguration (..)) import Cardano.Node.Handlers.TopLevel -import Cardano.Node.Parsers (nodeCLIParser) import Cardano.Node.Run (runNode) import Cardano.Node.Tracing.Documentation (TraceDocumentationCmd (..), parseTraceDocumentationCmd, runTraceDocumentationCmd) -import Data.Monoid (Last (getLast)) import qualified Data.Text as Text import qualified Data.Text.IO as Text import Data.Version (showVersion) import Options.Applicative import qualified Options.Applicative as Opt import System.Info (arch, compilerName, compilerVersion, os) -import System.IO (hPutStrLn, stderr) import Paths_cardano_node (version) @@ -32,28 +29,16 @@ main = do cmd <- Opt.customExecParser p opts case cmd of - RunCmd args -> do - warnIfSet args pncMaybeMempoolCapacityOverride "mempool-capacity-override" "MempoolCapacityBytesOverride" - runNode args + RunCmd args -> runNode args TraceDocumentation tdc -> runTraceDocumentationCmd tdc VersionCmd -> runVersionCommand where p = Opt.prefs Opt.showHelpOnEmpty - warnIfSet :: PartialNodeConfiguration -> (PartialNodeConfiguration -> Last a) -> String -> String -> IO () - warnIfSet args f name key = - maybe - (pure ()) - (\_ -> hPutStrLn stderr $ "WARNING: Option --" ++ name ++ " was set via CLI flags.\ - \ This CLI flag will be removed in upcoming node releases.\ - \ Please, set this configuration option in the configuration file instead with key " ++ key ++ ".") - $ getLast - $ f args - opts :: Opt.ParserInfo Command opts = - Opt.info (fmap RunCmd nodeCLIParser + Opt.info (fmap RunCmd nodeRunParser <|> fmap TraceDocumentation parseTraceDocumentationCmd <|> parseVersionCmd <**> helper) @@ -62,8 +47,11 @@ main = do Opt.progDesc "Start node of the Cardano blockchain." ) +-- | The node's CLI, parsed by @cardano-config@, under the @run@ subcommand. +nodeRunParser :: Parser CC.CliArgs +nodeRunParser = Opt.subparser $ command' "run" "Run the node." CC.parseCliArgs -data Command = RunCmd PartialNodeConfiguration +data Command = RunCmd CC.CliArgs | TraceDocumentation TraceDocumentationCmd | VersionCmd diff --git a/cardano-node/cardano-node.cabal b/cardano-node/cardano-node.cabal index a4c2c092439..5246a57df10 100644 --- a/cardano-node/cardano-node.cabal +++ b/cardano-node/cardano-node.cabal @@ -59,7 +59,8 @@ library hs-source-dirs: src - exposed-modules: Cardano.Node.Configuration.NodeAddress + exposed-modules: Cardano.Node.Configuration.Adapter + Cardano.Node.Configuration.NodeAddress Cardano.Node.Configuration.POM Cardano.Node.Configuration.LedgerDB Cardano.Node.Configuration.Socket @@ -67,7 +68,6 @@ library Cardano.Node.Handlers.Shutdown Cardano.Node.Handlers.TopLevel Cardano.Node.Orphans - Cardano.Node.Parsers Cardano.Node.Pretty Cardano.Node.Protocol Cardano.Node.Protocol.Alonzo @@ -124,6 +124,7 @@ library , base16-bytestring , bytestring , cardano-api ^>= 11.3 + , cardano-config , cardano-data , cardano-crypto-class ^>=2.5 , cardano-crypto-wrapper @@ -206,6 +207,7 @@ executable cardano-node autogen-modules: Paths_cardano_node build-depends: base + , cardano-config , cardano-crypto-class , cardano-git-rev , cardano-node diff --git a/cardano-node/src/Cardano/Node/Configuration/Adapter.hs b/cardano-node/src/Cardano/Node/Configuration/Adapter.hs new file mode 100644 index 00000000000..b4584b06d37 --- /dev/null +++ b/cardano-node/src/Cardano/Node/Configuration/Adapter.hs @@ -0,0 +1,396 @@ +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE ScopedTypeVariables #-} + +-- | Adapter from the @cardano-config@ package's resolved configuration +-- ('CC.NodeConfiguration') to the node's existing 'PartialNodeConfiguration'. +-- +-- The intent is that the node's entrypoint becomes: +-- +-- @ +-- file <- CC.parseConfigurationFiles (CC.configFilePath cli) +-- let ccnc = CC.resolveConfiguration cli file +-- cfgDir = takeDirectory (CC.configFilePath cli) +-- makeNodeConfiguration (defaultPartialNodeConfiguration <> fromCardanoConfig cfgDir ccnc) +-- @ +-- +-- We deliberately target 'PartialNodeConfiguration' (not the fully-resolved +-- 'NodeConfiguration') so that all of the node's defaulting and validation +-- logic in 'makeNodeConfiguration' is reused verbatim. Whenever +-- @cardano-config@ has no value for a field we leave it as 'mempty' / @Last +-- Nothing@ so the node default applies. +-- +-- NOTE on file paths: genesis and checkpoint files are always sourced from the +-- configuration file and, as in the legacy parser, are resolved relative to the +-- configuration file's directory (the @configDir@ argument). Credential, +-- database and socket paths come (mostly) from the CLI and are left as given, +-- i.e. relative to the current working directory — again matching the legacy +-- 'parseNodeConfigurationFP' / 'AdjustFilePaths' behaviour. +module Cardano.Node.Configuration.Adapter + ( fromCardanoConfig + ) where + +import qualified Cardano.Configuration as CC +import qualified Cardano.Configuration.CliArgs as CCCli +import qualified Cardano.Configuration.File.Consensus as CCCon +import qualified Cardano.Configuration.File.Network as CCNet +import qualified Cardano.Configuration.File.Storage as CCSto + +import Cardano.Api (File (..)) + +import Cardano.Crypto (RequiresNetworkMagic (..)) +import Cardano.Network.ConsensusMode (ConsensusMode (..)) +import Cardano.Network.PeerSelection (NumberOfBigLedgerPeers (..)) +import Cardano.Node.Configuration.LedgerDB (LedgerDbConfiguration (..), + LedgerDbSelectorFlag (..), noDeprecatedOptions) +import Cardano.Node.Configuration.NodeAddress (NodeHostIPv4Address (..), + NodeHostIPv6Address (..)) +import Cardano.Node.Configuration.POM (PartialNodeConfiguration (..), + ResponderCoreAffinityPolicy (..)) +import Cardano.Node.Configuration.Socket (SocketConfig (..)) +import Cardano.Node.Handlers.Shutdown (ShutdownConfig (..), ShutdownOn (..)) +import Cardano.Node.Types +import Cardano.Rpc.Server.Config (RpcConfigF (..)) + +import Cardano.Slotting.Block (BlockNo (..)) +import Cardano.Slotting.Slot (EpochNo (..), SlotNo (..)) + +import qualified Cardano.Logging.Types as Net + +import Ouroboros.Consensus.Ledger.SupportsMempool (ByteSize32 (..)) +import Ouroboros.Consensus.Mempool (MempoolCapacityBytesOverride (..)) +import Ouroboros.Consensus.Node (NodeDatabasePaths (..)) +import qualified Ouroboros.Consensus.Node.Genesis as Genesis +import Ouroboros.Consensus.Storage.LedgerDB.Args (QueryBatchSize (..)) +import Ouroboros.Consensus.Storage.LedgerDB.Snapshots (NumOfDiskSnapshots (..), + SnapshotFrequency (..), SnapshotFrequencyArgs (..), + SnapshotPolicyArgs (..), defaultSnapshotPolicyArgs) +import Ouroboros.Consensus.Util.Args (OverrideOrDefault (..)) +-- These three are re-exported (unqualified) from +-- @Ouroboros.Network.Diffusion.Configuration@, exactly as +-- 'Cardano.Node.Configuration.POM' imports them. +import Ouroboros.Network.Diffusion.Configuration (AcceptedConnectionsLimit (..), + DiffusionMode (..), PeerSharing (..)) +import Ouroboros.Network.TxSubmission.Inbound.V2.Types (TxSubmissionInitDelay (..), + TxSubmissionLogicVersion (..)) + +import Cardano.Ledger.BaseTypes.NonZero (nonZero) + +import Data.Functor.Identity (runIdentity) +import Data.Monoid (Last (..)) +import Data.Time.Clock (secondsToDiffTime) +import System.FilePath (()) + +-- | Map a resolved @cardano-config@ configuration onto a +-- 'PartialNodeConfiguration'. Combine with +-- @defaultPartialNodeConfiguration <> _@ and feed to @makeNodeConfiguration@. +fromCardanoConfig :: FilePath -> CC.NodeConfiguration -> PartialNodeConfiguration +fromCardanoConfig configDir ccnc = + PartialNodeConfiguration + { pncConfigFile = Last . Just . ConfigYamlFilePath $ CC.configFilePath ccnc + , pncTopologyFile = Last . Just . TopologyFile $ CC.topologyFile ccnc + , pncDatabaseFile = Last . Just . fromDbPaths . runIdentity $ CC.databasePath storage + , pncValidateDB = Last . Just $ CC.validateDatabase ccnc + , pncProtocolFiles = Last . Just $ fromCredentials (CC.credentials ccnc) + , pncShutdownConfig = Last . Just $ ShutdownConfig (CC.shutdownIPC ccnc) (fromShutdownOn <$> CC.shutdownOnTarget ccnc) + , pncSocketConfig = Last . Just $ socketConfig + , pncStartAsNonProducingNode = Last . Just . runIdentity $ CC.startAsNonProducingNode protocol + + -- Protocol-specific parameters + , pncProtocolConfig = Last . Just $ protocolConfig + + -- Modes + , pncDiffusionMode = Last $ fromDiffusionMode (CC.pncDiffusionMode net) + , pncExperimentalProtocolsEnabled = Last $ CC.pncExperimentalProtocolsEnabled net + + -- BlockFetch + , pncMaxConcurrencyBulkSync = Last $ MaxConcurrencyBulkSync <$> CC.pncMaxConcurrencyBulkSync net + , pncMaxConcurrencyDeadline = Last $ MaxConcurrencyDeadline <$> CC.pncMaxConcurrencyDeadline net + + -- Tracing forwarder socket (CLI only) + , pncTraceForwardSocket = Last $ fromTracerConnection <$> CC.tracerSocket ccnc + + -- Mempool + , pncMaybeMempoolCapacityOverride = + Last $ (MempoolCapacityBytesOverride . ByteSize32 . fromIntegral) + <$> CC.mempoolCapacityOverride mempool + , pncMempoolTimeoutSoft = Last $ CC.mempoolTimeoutSoft mempool + , pncMempoolTimeoutHard = Last $ CC.mempoolTimeoutHard mempool + , pncMempoolTimeoutCapacity = Last $ CC.mempoolTimeoutCapacity mempool + + -- LedgerDB + , pncLedgerDbConfig = Last . Just . fromLedgerDb . runIdentity $ CC.ledgerDbConfiguration storage + + -- Network timeouts + , pncProtocolIdleTimeout = Last $ CC.pncProtocolIdleTimeout net + , pncTimeWaitTimeout = Last $ CC.pncTimeWaitTimeout net + , pncEgressPollInterval = Last $ CC.pncEgressPollInterval net + , pncChainSyncIdleTimeout = Last $ CC.pncChainSyncIdleTimeout net + + -- AcceptedConnectionsLimit + , pncAcceptedConnectionsLimit = Last $ fromAcceptedConnectionsLimit <$> CC.pncAcceptedConnectionsLimit net + + -- P2P governor targets (deadline) + , pncDeadlineTargetOfRootPeers = Last $ CC.pncDeadlineTargetOfRootPeers net + , pncDeadlineTargetOfKnownPeers = Last $ CC.pncDeadlineTargetOfKnownPeers net + , pncDeadlineTargetOfEstablishedPeers = Last $ CC.pncDeadlineTargetOfEstablishedPeers net + , pncDeadlineTargetOfActivePeers = Last $ CC.pncDeadlineTargetOfActivePeers net + , pncDeadlineTargetOfKnownBigLedgerPeers = Last $ CC.pncDeadlineTargetOfKnownBigLedgerPeers net + , pncDeadlineTargetOfEstablishedBigLedgerPeers = Last $ CC.pncDeadlineTargetOfEstablishedBigLedgerPeers net + , pncDeadlineTargetOfActiveBigLedgerPeers = Last $ CC.pncDeadlineTargetOfActiveBigLedgerPeers net + + -- P2P governor targets (sync) + , pncSyncTargetOfRootPeers = Last $ CC.pncSyncTargetOfRootPeers net + , pncSyncTargetOfKnownPeers = Last $ CC.pncSyncTargetOfKnownPeers net + , pncSyncTargetOfEstablishedPeers = Last $ CC.pncSyncTargetOfEstablishedPeers net + , pncSyncTargetOfActivePeers = Last $ CC.pncSyncTargetOfActivePeers net + , pncSyncTargetOfKnownBigLedgerPeers = Last $ CC.pncSyncTargetOfKnownBigLedgerPeers net + , pncSyncTargetOfEstablishedBigLedgerPeers = Last $ CC.pncSyncTargetOfEstablishedBigLedgerPeers net + , pncSyncTargetOfActiveBigLedgerPeers = Last $ CC.pncSyncTargetOfActiveBigLedgerPeers net + + , pncMinBigLedgerPeersForTrustedState = + Last $ NumberOfBigLedgerPeers <$> CC.pncMinBigLedgerPeersForTrustedState net + + -- Consensus mode / Genesis + , pncConsensusMode = Last . Just $ consensusMode + , pncGenesisConfigFlags = Last genesisConfigFlags + + -- Peer sharing + , pncPeerSharing = Last $ fromPeerSharing <$> CC.pncPeerSharing net + + , pncResponderCoreAffinityPolicy = + Last $ fromResponderCoreAffinity <$> CC.pncResponderCoreAffinityPolicy net + + , pncTxSubmissionLogicVersion = Last $ CC.pncTxSubmissionLogicVersion net >>= fromTxSubmissionLogicVersion + , pncTxSubmissionInitDelay = Last $ TxSubmissionInitDelay <$> CC.pncTxSubmissionInitDelay net + + -- gRPC + , pncRpcConfig = rpcConfig + } + where + storage = CC.storageConfiguration ccnc + consensus = CC.consensusConfiguration ccnc + protocol = CC.protocolConfiguration ccnc + net = CC.networkConfiguration ccnc + testing = CC.testingConfiguration ccnc + mempool = CC.mempoolConfiguration ccnc + lcc = CC.localConnectionsConfig ccnc + + socketConfig = + SocketConfig + (Last $ NodeHostIPv4Address <$> CC.hostAddr ccnc) + (Last $ NodeHostIPv6Address <$> CC.hostIPv6Addr ccnc) + (Last $ CC.port ccnc) + (Last $ File <$> CC.pncSocketPath lcc) + + rpcConfig = + RpcConfig + (Last $ CC.pncEnableRpc lcc) + (Last $ File <$> CC.pncRpcSocketPath lcc) + mempty + + -- The resolved consensus mode also drives whether the (separate) genesis + -- config flags field is populated. Mirrors the node's split: ConsensusMode + -- (Praos|Genesis) lives in one field, the low-level flags in another. + (consensusMode, genesisConfigFlags) = + case runIdentity (CC.getConsensusConfiguration consensus) of + CCCon.PraosMode -> (PraosMode, Nothing) + CCCon.GenesisMode flags -> (GenesisMode, Just (fromGenesisConfigFlags flags)) + + -- Genesis files always come from the configuration file and are resolved + -- relative to its directory (matching the legacy parser). + genesisFile = toGenesisFile configDir + + protocolConfig = + NodeProtocolConfigurationCardano + (fromByron configDir (CC.byronGenesis protocol)) + (NodeShelleyProtocolConfiguration (genesisFile (CC.shelleyGenesis protocol)) (toGenesisHash (CC.shelleyGenesis protocol))) + (NodeAlonzoProtocolConfiguration (genesisFile (CC.alonzoGenesis protocol)) (toGenesisHash (CC.alonzoGenesis protocol))) + (NodeConwayProtocolConfiguration (genesisFile (CC.conwayGenesis protocol)) (toGenesisHash (CC.conwayGenesis protocol))) + dijkstra + hardFork + checkpoints + + -- Dijkstra is only wired in when the experimental eras are enabled, and its + -- genesis file lives under the Testing component in cardano-config. + dijkstra + | CC.experimentalHardForksEnabled testing + , Just h <- CC.experimentalGenesis testing + = Just $ NodeDijkstraProtocolConfiguration (genesisFile h) (toGenesisHash h) + | otherwise = Nothing + + hardFork = + NodeHardForkProtocolConfiguration + { npcExperimentalHardForksEnabled = CC.experimentalHardForksEnabled testing + , npcTestShelleyHardForkAtEpoch = EpochNo <$> CC.testShelleyHardForkAtEpoch testing + , npcTestShelleyHardForkAtVersion = CC.testShelleyHardForkAtVersion testing + , npcTestAllegraHardForkAtEpoch = EpochNo <$> CC.testAllegraHardForkAtEpoch testing + , npcTestAllegraHardForkAtVersion = CC.testAllegraHardForkAtVersion testing + , npcTestMaryHardForkAtEpoch = EpochNo <$> CC.testMaryHardForkAtEpoch testing + , npcTestMaryHardForkAtVersion = CC.testMaryHardForkAtVersion testing + , npcTestAlonzoHardForkAtEpoch = EpochNo <$> CC.testAlonzoHardForkAtEpoch testing + , npcTestAlonzoHardForkAtVersion = CC.testAlonzoHardForkAtVersion testing + , npcTestBabbageHardForkAtEpoch = EpochNo <$> CC.testBabbageHardForkAtEpoch testing + , npcTestBabbageHardForkAtVersion = CC.testBabbageHardForkAtVersion testing + , npcTestConwayHardForkAtEpoch = EpochNo <$> CC.testConwayHardForkAtEpoch testing + , npcTestConwayHardForkAtVersion = CC.testConwayHardForkAtVersion testing + , npcTestDijkstraHardForkAtEpoch = EpochNo <$> CC.testDijkstraHardForkAtEpoch testing + , npcTestDijkstraHardForkAtVersion = CC.testDijkstraHardForkAtVersion testing + } + + checkpoints = + NodeCheckpointsConfiguration + (CheckpointsFile . (configDir ) . CC.hashed <$> CC.checkpointsFile protocol) + (toHash =<< CC.checkpointsFile protocol) + where + toHash h = CheckpointsHash <$> CC.hash h + +-------------------------------------------------------------------------------- +-- Component conversions +-------------------------------------------------------------------------------- + +-- Field order is (immutable, volatile) for both: cardano-config's +-- @SplitDB ImmutablePath VolatilePath@ and the node's +-- @MultipleDbPaths immutable volatile@ (see Cardano.Node.Run). +fromDbPaths :: CC.NodeDatabasePaths -> NodeDatabasePaths +fromDbPaths = \case + CC.SingleDB fp -> OnePathForAllDbs fp + CC.SplitDB im vol -> MultipleDbPaths im vol + +fromCredentials :: CC.Credentials -> ProtocolFilepaths +fromCredentials creds = + ProtocolFilepaths + { byronCertFile = CCCli.byronDelegationCertificate creds + , byronKeyFile = CCCli.byronSigningKey creds + , shelleyKESSource = fromKESSource <$> CCCli.shelleyKES creds + , shelleyVRFFile = CCCli.shelleyVRFKey creds + , shelleyCertFile = CCCli.shelleyOperationalCertificate creds + , shelleyBulkCredsFile = CCCli.bulkCredentialsFile creds + } + +fromKESSource :: CCCli.KESSource -> KESSource +fromKESSource = \case + CCCli.KESKeyFilePath fp -> KESKeyFilePath fp + CCCli.KESAgentSocketPath s -> KESAgentSocketPath s + +fromShutdownOn :: CCCli.ShutdownOn -> ShutdownOn +fromShutdownOn = \case + CCCli.ShutdownAtSlot w -> ASlot (SlotNo w) + CCCli.ShutdownAtBlock w -> ABlock (BlockNo w) + +fromDiffusionMode :: String -> Maybe DiffusionMode +fromDiffusionMode = \case + "InitiatorOnly" -> Just InitiatorOnlyDiffusionMode + "InitiatorAndResponder" -> Just InitiatorAndResponderDiffusionMode + _ -> Nothing + +fromPeerSharing :: Bool -> PeerSharing +fromPeerSharing True = PeerSharingEnabled +fromPeerSharing False = PeerSharingDisabled + +fromResponderCoreAffinity :: String -> ResponderCoreAffinityPolicy +fromResponderCoreAffinity = \case + "ResponderCoreAffinity" -> ResponderCoreAffinity + _ -> NoResponderCoreAffinity + +-- Spellings match the node's orphan @FromJSON TxSubmissionLogicVersion@ +-- (Ouroboros.Network.OrphanInstances). Falls back to the node default +-- (Last Nothing) on an unrecognised value. +fromTxSubmissionLogicVersion :: String -> Maybe TxSubmissionLogicVersion +fromTxSubmissionLogicVersion = \case + "TxSubmissionLogicV1" -> Just TxSubmissionLogicV1 + "TxSubmissionLogicV2" -> Just TxSubmissionLogicV2 + _ -> Nothing + +-- cardano-config: AcceptedConnectionsLimit . +-- ouroboros: AcceptedConnectionsLimit { hard, soft, delay }. +fromAcceptedConnectionsLimit :: CCNet.AcceptedConnectionsLimit -> AcceptedConnectionsLimit +fromAcceptedConnectionsLimit (CCNet.AcceptedConnectionsLimit hard soft delay) = + AcceptedConnectionsLimit hard soft delay + +fromTracerConnection :: CCCli.TracerConnection -> (Net.HowToConnect, Net.ForwarderMode) +fromTracerConnection (CCCli.TracerConnection tag method) = + (howToConnect, forwarderMode tag) + where + howToConnect = case method of + CCCli.TracerConnectViaPipe fp -> Net.LocalPipe fp + CCCli.TracerConnectViaRemote host pn -> Net.RemoteSocket host (fromIntegral pn) + -- "Accept" => we accept an incoming connection (Responder); + -- "Connect" => we connect out (Initiator). The tag comes from + -- cardano-config's TracerConnection (Cardano.Configuration.CliArgs). + forwarderMode "Connect" = Net.Initiator + forwarderMode _ = Net.Responder + +fromGenesisConfigFlags :: CCCon.GenesisConfigFlags -> Genesis.GenesisConfigFlags +fromGenesisConfigFlags f = + Genesis.GenesisConfigFlags + { Genesis.gcfEnableCSJ = CCCon.gcfEnableCSJ f + , Genesis.gcfEnableLoEAndGDD = CCCon.gcfEnableLoEAndGDD f + , Genesis.gcfEnableLoP = CCCon.gcfEnableLoP f + , Genesis.gcfBlockFetchGracePeriod = CCCon.gcfBlockFetchGracePeriod f + , Genesis.gcfBucketCapacity = CCCon.gcfBucketCapacity f + , Genesis.gcfBucketRate = CCCon.gcfBucketRate f + , Genesis.gcfCSJJumpSize = SlotNo <$> CCCon.gcfCSJJumpSize f + , Genesis.gcfGDDRateLimit = CCCon.gcfGDDRateLimit f + } + +fromByron :: FilePath -> CC.ByronGenesisConfiguration -> NodeByronProtocolConfiguration +fromByron configDir b = + NodeByronProtocolConfiguration + { npcByronGenesisFile = toGenesisFile configDir (CC.byronGenesisFile b) + , npcByronGenesisFileHash = toGenesisHash (CC.byronGenesisFile b) + , npcByronReqNetworkMagic = fromReqNetworkMagic (CC.byronReqNetworkMagic b) + , npcByronPbftSignatureThresh = CC.byronPbftSignatureThresh b + , npcByronSupportedProtocolVersionMajor = CC.byronSupportedProtocolVersionMajor b + , npcByronSupportedProtocolVersionMinor = CC.byronSupportedProtocolVersionMinor b + , npcByronSupportedProtocolVersionAlt = CC.byronSupportedProtocolVersionAlt b + } + +-- cardano-config keeps RequiresNetworkMagic as a raw string (default +-- "RequiresNoMagic"); the node uses the cardano-crypto enum. +fromReqNetworkMagic :: String -> RequiresNetworkMagic +fromReqNetworkMagic = \case + "RequiresMagic" -> RequiresMagic + "RequiresNoMagic" -> RequiresNoMagic + _ -> RequiresNoMagic + +-- | Resolve a genesis file path relative to the configuration file's directory. +-- @System.FilePath.()@ leaves absolute paths untouched. +toGenesisFile :: FilePath -> CC.Hashed FilePath -> GenesisFile +toGenesisFile configDir = GenesisFile . (configDir ) . CC.hashed + +toGenesisHash :: CC.Hashed FilePath -> Maybe GenesisHash +toGenesisHash = fmap GenesisHash . CC.hash + +-- TODO(adapter): cardano-config's named snapshot policy ("Mithril") and the +-- LSM export path have no representation in the node's LedgerDbConfiguration; +-- the named policy falls back to the default and the export path is dropped. +-- The node also does not consume MinDelay/MaxDelay (sfaDelaySnapshotRange is +-- always UseDefault here, mirroring the legacy parser). +fromLedgerDb :: CC.LedgerDbConfiguration -> LedgerDbConfiguration +fromLedgerDb ldb = + LedgerDbConfiguration + snapshotPolicyArgs + queryBatchSize + selector + noDeprecatedOptions + where + snapshotPolicyArgs = + case CC.snapshots ldb of + Nothing -> defaultSnapshotPolicyArgs + Just (CCSto.NamedSnapshotPolicy _name) -> defaultSnapshotPolicyArgs -- TODO(adapter) + Just (CCSto.CustomSnapshotPolicy opts) -> + SnapshotPolicyArgs + (SnapshotFrequency SnapshotFrequencyArgs + { sfaInterval = maybe UseDefault Override (CCSto.snapshotInterval opts >>= nonZero) + , sfaOffset = maybe UseDefault (Override . SlotNo) (CCSto.slotOffset opts) + , sfaRateLimit = maybe UseDefault (Override . secondsToDiffTime . fromIntegral) (CCSto.snapshotRateLimit opts) + , sfaDelaySnapshotRange = UseDefault + }) + (maybe UseDefault (Override . NumOfDiskSnapshots . fromIntegral) (CCSto.numOfDiskSnapshots opts)) + + queryBatchSize = maybe DefaultQueryBatchSize RequestedQueryBatchSize (CC.queryBatchSize ldb) + + selector = case CC.backendSelector ldb of + CCSto.V2InMemory -> V2InMemory + CCSto.V2LSM dbPath _export -> V2LSM dbPath diff --git a/cardano-node/src/Cardano/Node/Parsers.hs b/cardano-node/src/Cardano/Node/Parsers.hs deleted file mode 100644 index 0b42c77dc62..00000000000 --- a/cardano-node/src/Cardano/Node/Parsers.hs +++ /dev/null @@ -1,469 +0,0 @@ -{-# LANGUAGE ApplicativeDo #-} -{-# LANGUAGE MultiWayIf #-} -{-# LANGUAGE NamedFieldPuns #-} -{-# LANGUAGE TupleSections #-} -{-# LANGUAGE TypeApplications #-} - -module Cardano.Node.Parsers - ( nodeCLIParser - , parseConfigFile - , parserHelpHeader - , parserHelpOptions - , renderHelpDoc - , parseHostPort - ) where - -import Cardano.Logging.Types -import qualified Cardano.Logging.Types as Net -import Cardano.Node.Configuration.NodeAddress (File (..), - NodeHostIPv4Address (NodeHostIPv4Address), - NodeHostIPv6Address (NodeHostIPv6Address), PortNumber, SocketPath) -import Cardano.Node.Configuration.POM (PartialNodeConfiguration (..), lastOption) -import Cardano.Node.Configuration.Socket -import Cardano.Node.Handlers.Shutdown -import Cardano.Node.Types -import Cardano.Prelude (ConvertText (..)) -import Cardano.Rpc.Server.Config (PartialRpcConfig, RpcConfigF (..)) -import Ouroboros.Consensus.Ledger.SupportsMempool -import Ouroboros.Consensus.Node - -import Data.Char (isDigit) -import Data.Foldable -import Data.Maybe (fromMaybe) -import Data.Monoid (Last (..)) -import Data.Text (Text) -import qualified Data.Text as Text -import Data.Word (Word16, Word32) -import Options.Applicative hiding (str, switch) -import qualified Options.Applicative as Opt -import qualified Options.Applicative.Help as OptI -import qualified Prettyprinter.Internal as PP -import System.Posix.Types (Fd (..)) -import Text.Read (readMaybe) - -nodeCLIParser :: Parser PartialNodeConfiguration -nodeCLIParser = subparser - ( commandGroup "Run the node" - <> metavar "run" - <> command "run" - (info (nodeRunParser <**> helper) - (progDesc "Run the node." )) - ) - -nodeRunParser :: Parser PartialNodeConfiguration -nodeRunParser = do - -- Filepaths - topFp <- lastOption parseTopologyFile - dbFp <- lastOption parseNodeDatabasePaths - validate <- lastOption parseValidateDB - socketFp <- lastOption $ parseSocketPath "socket-path" "Path to a cardano-node socket" - traceForwardSocket <- lastOption parseTracerSocketMode - nodeConfigFp <- lastOption parseConfigFile - - -- Protocol files - byronCertFile <- optional parseByronDelegationCert - byronKeyFile <- optional parseByronSigningKey - shelleyKESSource <- optional parseKesSourceFilePath - shelleyVRFFile <- optional parseVrfKeyFilePath - shelleyCertFile <- optional parseOperationalCertFilePath - shelleyBulkCredsFile <- optional parseBulkCredsFilePath - startAsNonProducingNode <- (\depr new -> Last depr <> Last new) - <$> parseStartAsNonProducingNodeDeprecated - <*> parseStartAsNonProducingNode - - -- Node Address - nIPv4Address <- lastOption parseHostIPv4Addr - nIPv6Address <- lastOption parseHostIPv6Addr - nPortNumber <- lastOption parsePort - - -- Shutdown - shutdownIPC <- lastOption parseShutdownIPC - shutdownOnLimit <- lastOption parseShutdownOn - - -- Hidden options (to be removed eventually) - maybeMempoolCapacityOverride <- lastOption parseMempoolCapacityOverride - - -- gRPC - pncRpcConfig <- parseRpcConfig - - pure $ PartialNodeConfiguration - { pncSocketConfig = - Last . Just $ SocketConfig - nIPv4Address - nIPv6Address - nPortNumber - socketFp - , pncConfigFile = ConfigYamlFilePath <$> nodeConfigFp - , pncTopologyFile = TopologyFile <$> topFp - , pncDatabaseFile = dbFp - , pncDiffusionMode = mempty - , pncExperimentalProtocolsEnabled = mempty - , pncProtocolFiles = Last $ Just ProtocolFilepaths - { byronCertFile - , byronKeyFile - , shelleyKESSource - , shelleyVRFFile - , shelleyCertFile - , shelleyBulkCredsFile - } - , pncValidateDB = validate - , pncShutdownConfig = - Last . Just $ ShutdownConfig (getLast shutdownIPC) (getLast shutdownOnLimit) - , pncStartAsNonProducingNode = startAsNonProducingNode - , pncProtocolConfig = mempty - , pncMaxConcurrencyBulkSync = mempty - , pncMaxConcurrencyDeadline = mempty - , pncTraceForwardSocket = traceForwardSocket - , pncMaybeMempoolCapacityOverride = maybeMempoolCapacityOverride - , pncLedgerDbConfig = mempty - , pncProtocolIdleTimeout = mempty - , pncTimeWaitTimeout = mempty - , pncEgressPollInterval = mempty - , pncChainSyncIdleTimeout = mempty - , pncMempoolTimeoutSoft = mempty - , pncMempoolTimeoutHard = mempty - , pncMempoolTimeoutCapacity = mempty - , pncAcceptedConnectionsLimit = mempty - , pncDeadlineTargetOfRootPeers = mempty - , pncDeadlineTargetOfKnownPeers = mempty - , pncDeadlineTargetOfEstablishedPeers = mempty - , pncDeadlineTargetOfActivePeers = mempty - , pncDeadlineTargetOfKnownBigLedgerPeers = mempty - , pncDeadlineTargetOfEstablishedBigLedgerPeers = mempty - , pncDeadlineTargetOfActiveBigLedgerPeers = mempty - , pncSyncTargetOfRootPeers = mempty - , pncSyncTargetOfKnownPeers = mempty - , pncSyncTargetOfEstablishedPeers = mempty - , pncSyncTargetOfActivePeers = mempty - , pncSyncTargetOfKnownBigLedgerPeers = mempty - , pncSyncTargetOfEstablishedBigLedgerPeers = mempty - , pncSyncTargetOfActiveBigLedgerPeers = mempty - , pncMinBigLedgerPeersForTrustedState = mempty - , pncConsensusMode = mempty - , pncPeerSharing = mempty - , pncGenesisConfigFlags = mempty - , pncResponderCoreAffinityPolicy = mempty - , pncRpcConfig - , pncTxSubmissionLogicVersion = mempty - , pncTxSubmissionInitDelay = mempty - } - -parseSocketPath :: Text -- ^ option name - -> Text -- ^ help text - -> Parser SocketPath -parseSocketPath optionName helpMessage = - fmap File $ strOption $ mconcat - [ long (toS optionName) - , help (toS helpMessage) - , completer (bashCompleter "file") - , metavar "FILEPATH" - ] - - --- leave hostname untouched, non-empty --- 0 <= port <= 65535 -parseNodeAddress :: Opt.ReadM Net.HowToConnect -parseNodeAddress = Opt.eitherReader parseHostPort - -parseHostPort :: String -> Either String Net.HowToConnect -parseHostPort str - | (portRev, ':' : hostRev) <- break (== ':') (reverse str) - = if - | null hostRev -> Left "parseHostPort: Empty host." - | null portRev -> Left "parseHostPort: Empty port." - | all isDigit portRev - , Just port <- readMaybe @Word16 (reverse portRev) -> if - | 0 <= port, port <= 65535 -> Right (Net.RemoteSocket (Text.pack (reverse hostRev)) port) - | otherwise -> Left ("parseHostPort: Numeric port '" ++ show port ++ "' out of range: 0 - 65535)") - | otherwise -> Left "parseHostPort: Non-numeric port." - | otherwise - = Left "parseHostPort: No colon found." - -parseTracerSocketMode :: Parser (Net.HowToConnect, ForwarderMode) -parseTracerSocketMode = - asum - [ fmap (, Responder) $ option parseNodeAddress $ mconcat - [ long "tracer-socket-network-accept" - , help "Accept incoming cardano-tracer connection on HOST:PORT" - , metavar "HOST:PORT" - ] - , fmap (, Initiator) $ option parseNodeAddress $ mconcat - [ long "tracer-socket-network-connect" - , help "Connect to cardano-tracer listening on HOST:PORT" - , metavar "HOST:PORT" - ] - , fmap (\host -> (Net.LocalPipe host, Responder)) $ strOption $ mconcat - [ long "tracer-socket-path-accept" - , help "Accept incoming cardano-tracer connection at local socket" - , completer (bashCompleter "file") - , metavar "FILEPATH" - ] - , fmap (\host -> (Net.LocalPipe host, Initiator)) $ strOption $ mconcat - [ long "tracer-socket-path-connect" - , help "Connect to cardano-tracer listening on a local socket" - , completer (bashCompleter "file") - , metavar "FILEPATH" - ] - ] - -parseHostIPv4Addr :: Parser NodeHostIPv4Address -parseHostIPv4Addr = - Opt.option (eitherReader parseNodeHostIPv4Address) ( - long "host-addr" - <> metavar "IPV4" - <> help "An optional IPv4 address" - ) - -parseHostIPv6Addr :: Parser NodeHostIPv6Address -parseHostIPv6Addr = - Opt.option (eitherReader parseNodeHostIPv6Address) ( - long "host-ipv6-addr" - <> metavar "IPV6" - <> help "An optional IPv6 address" - ) - -parseNodeHostIPv4Address :: String -> Either String NodeHostIPv4Address -parseNodeHostIPv4Address str = - maybe - (Left $ - "Failed to parse IPv4 address: " ++ str ++ - ". If you want to specify an IPv6 address, use --host-ipv6-addr option.") - (Right . NodeHostIPv4Address) - (readMaybe str) - -parseNodeHostIPv6Address :: String -> Either String NodeHostIPv6Address -parseNodeHostIPv6Address str = - maybe - (Left $ - "Failed to parse IPv6 address: " ++ str ++ - ". If you want to specify an IPv4 address, use --host-addr option.") - (Right . NodeHostIPv6Address) - (readMaybe str) - -parsePort :: Parser PortNumber -parsePort = - Opt.option ((fromIntegral :: Int -> PortNumber) <$> auto) ( - long "port" - <> metavar "PORT" - <> help "The port number" - <> value 0 -- Use an ephemeral port - ) - -parseConfigFile :: Parser FilePath -parseConfigFile = - strOption - ( long "config" - <> metavar "NODE-CONFIGURATION" - <> help "Configuration file for the cardano-node" - <> completer (bashCompleter "file") - ) - -parseMempoolCapacityOverride :: Parser MempoolCapacityBytesOverride -parseMempoolCapacityOverride = parseOverride <|> parseNoOverride - where - parseOverride :: Parser MempoolCapacityBytesOverride - parseOverride = - MempoolCapacityBytesOverride . ByteSize32 <$> - Opt.option (auto @Word32) - ( long "mempool-capacity-override" - <> metavar "BYTES" - <> help "[DEPRECATED: Set it in config file with key MempoolCapacityBytesOverride] The number of bytes" - ) - parseNoOverride :: Parser MempoolCapacityBytesOverride - parseNoOverride = - flag' NoMempoolCapacityBytesOverride - ( long "no-mempool-capacity-override" - <> help "[DEPRECATED: Set it in config file] Don't override mempool capacity" - ) - -parseNodeDatabasePaths :: Parser NodeDatabasePaths -parseNodeDatabasePaths = parseDbPath <|> parseMultipleDbPaths - -parseDbPath :: Parser NodeDatabasePaths -parseDbPath = - fmap OnePathForAllDbs $ - strOption $ - mconcat - [ long "database-path" - , metavar "FILEPATH" - , help "Directory where the state is stored." - , completer (bashCompleter "file") - ] - -parseMultipleDbPaths :: Parser NodeDatabasePaths -parseMultipleDbPaths = MultipleDbPaths <$> parseImmutableDbPath <*> parseVolatileDbPath - -parseVolatileDbPath :: Parser FilePath -parseVolatileDbPath = strOption $ - mconcat - [ long "volatile-database-path" - , metavar "FILEPATH" - , help "Directory where the state is stored." - , completer (bashCompleter "file") - ] - -parseImmutableDbPath :: Parser FilePath -parseImmutableDbPath = strOption $ - mconcat - [ long "immutable-database-path" - , metavar "FILEPATH" - , help "Directory where the state is stored." - , completer (bashCompleter "file") - ] - - --- | This parser will always override configuration option, even if the --- `--validate-db` is not present. This is fine for `--validate-db` switch, --- but might not be for something else. See `parseStartAsNonProducingNode` for --- an alternative solution. -parseValidateDB :: Parser Bool -parseValidateDB = - Opt.switch ( - long "validate-db" - <> help "Validate all on-disk database files" - ) - -parseShutdownIPC :: Parser Fd -parseShutdownIPC = - Opt.option (Fd <$> auto) ( - long "shutdown-ipc" - <> metavar "FD" - <> help "Shut down the process when this inherited FD reaches EOF" - <> hidden - ) - -parseTopologyFile :: Parser FilePath -parseTopologyFile = - strOption ( - long "topology" - <> metavar "FILEPATH" - <> help "The path to a file describing the topology." - <> completer (bashCompleter "file") - ) - -parseByronDelegationCert :: Parser FilePath -parseByronDelegationCert = - strOption ( long "byron-delegation-certificate" - <> metavar "FILEPATH" - <> help "Path to the delegation certificate." - <> completer (bashCompleter "file") - ) - <|> - strOption - ( long "delegation-certificate" - <> Opt.internal - ) - -parseByronSigningKey :: Parser FilePath -parseByronSigningKey = - strOption ( long "byron-signing-key" - <> metavar "FILEPATH" - <> help "Path to the Byron signing key." - <> completer (bashCompleter "file") - ) - <|> - strOption ( long "signing-key" - <> Opt.internal - ) - -parseOperationalCertFilePath :: Parser FilePath -parseOperationalCertFilePath = - strOption - ( long "shelley-operational-certificate" - <> metavar "FILEPATH" - <> help "Path to the delegation certificate." - <> completer (bashCompleter "file") - ) - -parseBulkCredsFilePath :: Parser FilePath -parseBulkCredsFilePath = - strOption - ( long "bulk-credentials-file" - <> metavar "FILEPATH" - <> help "Path to the bulk pool credentials file." - <> completer (bashCompleter "file") - ) - -parseKesSourceFilePath :: Parser KESSource -parseKesSourceFilePath = asum - [ KESKeyFilePath <$> - strOption - ( long "shelley-kes-key" - <> metavar "FILEPATH" - <> help "Path to the KES signing key." - <> completer (bashCompleter "file") - ) - , KESAgentSocketPath <$> - strOption - ( long "shelley-kes-agent-socket" - <> metavar "SOCKET_FILEPATH" - <> help "Path to the KES Agent socket" - <> completer (bashCompleter "file") - ) - ] - -parseVrfKeyFilePath :: Parser FilePath -parseVrfKeyFilePath = - strOption - ( long "shelley-vrf-key" - <> metavar "FILEPATH" - <> help "Path to the VRF signing key." - <> completer (bashCompleter "file") - ) - -parseStartAsNonProducingNodeDeprecated :: Parser (Maybe Bool) -parseStartAsNonProducingNodeDeprecated = - flag Nothing (Just True) $ mconcat - [ long "non-producing-node" - , help $ mconcat - [ "DEPRECATED, use --start-as-non-producing-node instead. " - , "This option will be removed in one of the future versions of cardano-node." - ] - , hidden - ] - --- | A parser which returns `Nothing` or `Just True`; the default value is set --- in `defaultPartialNodeConfiguration`. This allows to set this option either --- in the configuration file or as command line flag. -parseStartAsNonProducingNode :: Parser (Maybe Bool) -parseStartAsNonProducingNode = - flag Nothing (Just True) $ mconcat - [ long "start-as-non-producing-node" - , help $ mconcat - [ "Start the node as a non block producing node even if " - , "credentials are specified." - ] - ] - -parseRpcConfig :: Parser PartialRpcConfig -parseRpcConfig = do - isEnabled <- lastOption parseRpcToggle - socketPath <- lastOption parseRpcSocketPath - pure $ RpcConfig isEnabled socketPath mempty - where - parseRpcToggle :: Parser Bool - parseRpcToggle = - Opt.flag' True $ mconcat - [ long "grpc-enable" - , help "[EXPERIMENTAL] Enable node gRPC endpoint." - ] - parseRpcSocketPath :: Parser SocketPath - parseRpcSocketPath = - parseSocketPath - "grpc-socket-path" - "[EXPERIMENTAL] gRPC socket path. Defaults to rpc.sock in the same directory as node socket." - --- | Produce just the brief help header for a given CLI option parser, --- without the options. -parserHelpHeader :: String -> Opt.Parser a -> OptI.Doc -parserHelpHeader = flip (OptI.parserUsage (Opt.prefs mempty)) - --- | Produce just the options help for a given CLI option parser, --- without the header. -parserHelpOptions :: Opt.Parser a -> OptI.Doc -parserHelpOptions = fromMaybe mempty . OptI.unChunk . OptI.fullDesc (Opt.prefs mempty) - --- | Render the help pretty document. -renderHelpDoc :: Int -> OptI.Doc -> String -renderHelpDoc cols = - (`PP.renderShowS` "") . OptI.layoutPretty (OptI.LayoutOptions (OptI.AvailablePerLine cols 1.0)) diff --git a/cardano-node/src/Cardano/Node/Run.hs b/cardano-node/src/Cardano/Node/Run.hs index 479a177b734..e41f550a1bf 100644 --- a/cardano-node/src/Cardano/Node/Run.hs +++ b/cardano-node/src/Cardano/Node/Run.hs @@ -28,13 +28,16 @@ import Cardano.Api.Error (displayError) import qualified Cardano.Api as Api import System.Random (randomIO) +import qualified Cardano.Configuration as CC +import qualified Cardano.Configuration.CliArgs as CCCli import qualified Cardano.Crypto.Init as Crypto +import Cardano.Node.Configuration.Adapter (fromCardanoConfig) import Cardano.Node.Configuration.LedgerDB import Cardano.Node.Configuration.NodeAddress import Cardano.Node.Configuration.POM (NodeConfiguration (..), - PartialNodeConfiguration (..), TimeoutOverride (..), + TimeoutOverride (..), defaultPartialNodeConfiguration, makeNodeConfiguration, - parseNodeConfigurationFP, getForkPolicy) + getForkPolicy) import Cardano.Node.Configuration.Socket (LocalSocketOrSocketInfo, SocketOrSocketInfo, SocketOrSocketInfo' (..), gatherConfiguredSockets, getSocketOrSocketInfoAddr) @@ -142,7 +145,6 @@ import Data.IP (toSockAddr) import Data.Map.Strict (Map) import qualified Data.Map.Strict as Map import Data.Maybe (catMaybes, fromMaybe, mapMaybe) -import Data.Monoid (Last (..)) import Data.Proxy (Proxy (..)) import qualified Data.Set as Set import Data.SOP.Dict @@ -172,9 +174,9 @@ import GHC.Stack {- HLINT ignore "Use fewer imports" -} runNode - :: PartialNodeConfiguration + :: CC.CliArgs -> IO () -runNode cmdPc = do +runNode cli = do installSigTermHandler Crypto.cryptoInit @@ -182,7 +184,7 @@ runNode cmdPc = do nc@NodeConfiguration { ncProtocolConfig , ncProtocolFiles=ncProtocolFiles@ProtocolFilepaths{shelleyVRFFile=mShelleyVrfFile} - } <- buildNodeConfiguration cmdPc + } <- buildNodeConfiguration cli let earlyTracer = stdoutTracer traceWith earlyTracer $ "Node configuration: " <> show nc @@ -198,21 +200,26 @@ runNode cmdPc = do -- don't need these. (Just ncProtocolFiles) - handleNodeWithTracers cmdPc nc consensusProtocol + handleNodeWithTracers cli nc consensusProtocol runThrowExceptT :: Exception e => ExceptT e IO a -> IO a runThrowExceptT act = runExceptT act >>= either Exception.throwIO pure --- | Read node configuration from a file specified in 'PartialNodeConfiguration' +-- | Build the resolved 'NodeConfiguration' from the CLI arguments, using the +-- @cardano-config@ package to parse the configuration file(s) and combine them +-- with the CLI, then the node's own 'makeNodeConfiguration' to apply defaults +-- and validation. See 'Cardano.Node.Configuration.Adapter'. buildNodeConfiguration :: HasCallStack - => PartialNodeConfiguration -- ^ defaults + => CC.CliArgs -> IO NodeConfiguration -buildNodeConfiguration partialConf = do - configYamlPc <- parseNodeConfigurationFP . getLast $ pncConfigFile partialConf +buildNodeConfiguration cli = do + file <- CC.parseConfigurationFiles (CCCli.configFilePath cli) + let ccnc = CC.resolveConfiguration cli file + cfgDir = takeDirectory (CCCli.configFilePath cli) either (\err -> error $ "Error in creating the NodeConfiguration: " <> err) pure - $ makeNodeConfiguration (defaultPartialNodeConfiguration <> configYamlPc <> partialConf) + $ makeNodeConfiguration (defaultPartialNodeConfiguration <> fromCardanoConfig cfgDir ccnc) -- | Workaround to ensure that the main thread throws an async exception on -- receiving a SIGTERM signal. @@ -233,19 +240,17 @@ installSigTermHandler = do return () handleNodeWithTracers - :: PartialNodeConfiguration + :: CC.CliArgs -> NodeConfiguration -> SomeConsensusProtocol -> IO () -handleNodeWithTracers cmdPc nc p@(SomeConsensusProtocol blockType runP) = do +handleNodeWithTracers cli nc p@(SomeConsensusProtocol blockType runP) = do (ProtocolInfo{pInfoConfig}, mkBlockForging) <- Api.protocolInfo @IO runP let networkMagic :: Api.NetworkMagic = getNetworkMagic $ Consensus.configBlock pInfoConfig -- This IORef contains node kernel structure which holds node kernel. -- Used for ledger queries and peer connection status. nodeKernelData <- mkNodeKernelData - let fp = maybe "No file path found!" - unConfigPath - (getLast (pncConfigFile cmdPc)) + let fp = CCCli.configFilePath cli blockForging <- mkBlockForging nullTracer tracers <- initTraceDispatcher @@ -265,7 +270,7 @@ handleNodeWithTracers cmdPc nc p@(SomeConsensusProtocol blockType runP) = do then DisabledBlockForging else EnabledBlockForging)) - handleSimpleNode blockType runP tracers nc networkMagic + handleSimpleNode blockType runP tracers nc cli networkMagic (\nk -> do setNodeKernel nodeKernelData nk traceWith (nodeStateTracer tracers) NodeKernelOnline) @@ -305,13 +310,16 @@ handleSimpleNode -> Api.ProtocolInfoArgs IO blk -> Tracers RemoteAddress LocalAddress blk IO -> NodeConfiguration + -> CC.CliArgs + -- ^ The original CLI arguments, retained so the SIGHUP handler can re-read and + -- re-resolve the configuration (e.g. to reload the RPC configuration). -> NetworkMagic -> (NodeKernel IO RemoteAddress LocalConnectionId blk -> IO ()) -- ^ Called on the 'NodeKernel' after creating it, but before the network -- layer is initialised. This implies this function must not block, -- otherwise the node won't actually start. -> IO () -handleSimpleNode blockType runP tracers nc networkMagic onKernel = do +handleSimpleNode blockType runP tracers nc cli networkMagic onKernel = do logStartupWarnings logDeprecatedLedgerDBOptions @@ -440,7 +448,7 @@ handleSimpleNode blockType runP tracers nc networkMagic onKernel = do (readTVar ledgerPeerSnapshotPathVar) (readTVar useLedgerVar) (writeTVar ledgerPeerSnapshotVar) - updateRpcConfiguration (startupTracer tracers) (ncConfigFile nc) rpcConfigVar + updateRpcConfiguration (startupTracer tracers) cli rpcConfigVar traceWith (startupTracer tracers) (BlockForgingUpdate NotEffective) ) Nothing @@ -485,7 +493,7 @@ handleSimpleNode blockType runP tracers nc networkMagic onKernel = do rnNodeKernelHook = \registry nodeKernel -> do -- reinstall `SIGHUP` handler installSigHUPHandler (startupTracer tracers) (Consensus.kesAgentTracer $ consensusTracers tracers) - blockType nc networkMagic nodeKernel localRootsVar publicRootsVar useLedgerVar + blockType nc cli networkMagic nodeKernel localRootsVar publicRootsVar useLedgerVar useBootstrapVar ledgerPeerSnapshotPathVar ledgerPeerSnapshotVar rpcConfigVar rnNodeKernelHook nodeArgs registry nodeKernel @@ -576,6 +584,7 @@ installSigHUPHandler :: Tracer IO (StartupTrace blk) -> Tracer IO KESAgentClientTrace -> Api.BlockType blk -> NodeConfiguration + -> CC.CliArgs -> NetworkMagic -> NodeKernel IO RemoteAddress (ConnectionId LocalAddress) blk -> StrictTVar IO [(HotValency, WarmValency, Map RelayAccessPoint (LocalRootConfig PeerTrustable))] @@ -587,9 +596,9 @@ installSigHUPHandler :: Tracer IO (StartupTrace blk) -> StrictTVar IO RpcConfig -> IO () #ifndef UNIX -installSigHUPHandler _ _ _ _ _ _ _ _ _ _ _ _ _ = return () +installSigHUPHandler _ _ _ _ _ _ _ _ _ _ _ _ _ _ = return () #else -installSigHUPHandler startupTracer kesAgentTracer blockType nc networkMagic nodeKernel localRootsVar +installSigHUPHandler startupTracer kesAgentTracer blockType nc cli networkMagic nodeKernel localRootsVar publicRootsVar useLedgerVar useBootstrapPeersVar ledgerPeerSnapshotPathVar ledgerPeerSnapshotVar rpcConfigVar = void $ Signals.installHandler @@ -606,7 +615,7 @@ installSigHUPHandler startupTracer kesAgentTracer blockType nc networkMagic node (readTVar ledgerPeerSnapshotPathVar) (readTVar useLedgerVar) (writeTVar ledgerPeerSnapshotVar) - updateRpcConfiguration startupTracer (ncConfigFile nc) rpcConfigVar + updateRpcConfiguration startupTracer cli rpcConfigVar ) Nothing #endif @@ -784,22 +793,26 @@ rpcServerLoop startupTracer rpcTracer rpcConfigVar networkMagic = go atomically . modifyTVar rpcConfigVar $ \config -> config{isEnabled = Identity False} #ifdef UNIX --- | Reload RPC configuration from the configuration file -updateRpcConfiguration :: Tracer IO (StartupTrace blk) -- ^ tracer tracing the configuration reload - -> ConfigYamlFilePath -- ^ node configuration file, to reload configuration from +-- | Reload RPC configuration from the configuration file. +-- +-- We re-read and re-resolve the whole configuration through @cardano-config@ +-- (reusing 'buildNodeConfiguration'), then keep only the resulting RPC +-- configuration. The CLI arguments are re-applied, so a @--grpc-*@ flag given at +-- startup keeps taking precedence over the configuration file on reload. +updateRpcConfiguration :: HasCallStack + => Tracer IO (StartupTrace blk) -- ^ tracer tracing the configuration reload + -> CC.CliArgs -- ^ CLI arguments, to re-read and re-resolve the configuration -> StrictTVar IO RpcConfig -- ^ TVar storing RPC configuration -> IO () -updateRpcConfiguration tracer configFilePath rpcConfigVar = do - result <- fmap (join . first Exception.displayException) +updateRpcConfiguration tracer cli rpcConfigVar = do + result <- fmap (first Exception.displayException) . try @Exception.SomeException - . fmap makeNodeConfiguration - . parseNodeConfigurationFP - $ Just configFilePath + $ ncRpcConfig <$> buildNodeConfiguration cli case result of Left err -> -- reload failure, we don't do anything this time traceWith tracer (RpcConfigUpdateError $ pack err) - Right NodeConfiguration{ncRpcConfig=newConfig} -> + Right newConfig -> join . atomically $ do oldConfig <- readTVar rpcConfigVar if oldConfig /= newConfig