Propagate POM types through cardano-node

cardano-node/app/cardano-node.hs

@@ -16,12 +16,11 @@ import           Data.Version (showVersion)
 import           Paths_cardano_node (version)
 import           System.Info (arch, compilerName, compilerVersion, os)
 
-import           Cardano.Node.Configuration.Logging (createLoggingLayer)
+import           Cardano.Node.Configuration.POM (PartialNodeConfiguration)
 import           Cardano.Node.Handlers.TopLevel
 import           Cardano.Node.Parsers (nodeCLIParser, parserHelpHeader, parserHelpOptions,
                      renderHelpDoc)
 import           Cardano.Node.Run (runNode)
-import           Cardano.Node.Types (NodeCLI (..))
 
 main :: IO ()
 main = toplevelExceptionHandler $ do
@@ -56,7 +55,7 @@ main = toplevelExceptionHandler $ do
         <$$> parserHelpOptions nodeCLIParser
 
 
-data Command = RunCmd NodeCLI
+data Command = RunCmd PartialNodeConfiguration
              | VersionCmd
 
 -- Yes! A --version flag or version command. Either guess is right!
@@ -91,18 +90,8 @@ runVersionCommand =
     renderVersion = Text.pack . showVersion
 
 
-runRunCommand :: NodeCLI -> IO ()
-runRunCommand npm = do
-
-  eLoggingLayer <- runExceptT $ createLoggingLayer
-                     (Text.pack (showVersion version))
-                     npm
-
-  loggingLayer <- case eLoggingLayer of
-                    Left err -> putTextLn (show err) >> exitFailure
-                    Right res -> return res
-
-  liftIO $ runNode loggingLayer npm
+runRunCommand :: PartialNodeConfiguration -> IO ()
+runRunCommand pnc = liftIO $ runNode pnc
 
 command' :: String -> String -> Parser a -> Mod CommandFields a
 command' c descr p =

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
                      , hedgehog-extras
                      , hostname
                      , iproute
@@ -145,7 +147,8 @@ library cardano-node-config
 
   hs-source-dirs:      src
 
-  exposed-modules:     Cardano.Node.Orphans
+  exposed-modules:     Cardano.Node.Configuration.POM
+                       Cardano.Node.Orphans
                        Cardano.Node.Protocol.Types
                        Cardano.Node.Types
                        Cardano.Tracing.Config
@@ -168,9 +171,11 @@ library cardano-node-config
                      , cardano-slotting
                      , containers
                      , filepath
+                     , generic-data
                      , iohk-monitoring
                      , iproute
                      , network
+                     , optparse-applicative
                      , ouroboros-consensus
                      , ouroboros-consensus-cardano
                      , ouroboros-consensus-byron

cardano-node/src/Cardano/Node/Configuration/Logging.hs

@@ -64,6 +64,7 @@ import           Cardano.BM.Trace (Trace, appendName, traceNamedObject)
 import qualified Cardano.BM.Trace as Trace
 
 import           Cardano.Config.Git.Rev (gitRev)
+import           Cardano.Node.Configuration.POM (NodeConfiguration (..))
 import           Cardano.Node.Types
 
 --------------------------------
@@ -124,21 +125,18 @@ loggingCLIConfiguration = maybe emptyConfig readConfig
 -- | Create logging feature for `cardano-node`
 createLoggingLayer
   :: Text
-  -> NodeCLI
+  -> NodeConfiguration
   -> ExceptT ConfigError IO LoggingLayer
-createLoggingLayer ver nodecli@NodeCLI{configFile} = do
-
-  -- TODO:  we shouldn't be parsing configuration multiple times!
-  nodeConfig <- liftIO $ parseNodeConfiguration nodecli
+createLoggingLayer ver nodeConfig' = do
 
   logConfig <- loggingCLIConfiguration $
-    if ncLoggingSwitch nodeConfig
+    if ncLoggingSwitch nodeConfig'
     -- Re-interpret node config again, as logging 'Configuration':
-    then Just $ unConfigPath configFile
+    then Just . unConfigPath $ ncConfigFile nodeConfig'
     else Nothing
 
   -- adapt logging configuration before setup
-  liftIO $ adaptLogConfig nodeConfig logConfig
+  liftIO $ adaptLogConfig nodeConfig' logConfig
 
   -- These have to be set before the switchboard is set up.
   liftIO $ do
@@ -148,14 +146,14 @@ createLoggingLayer ver nodecli@NodeCLI{configFile} = do
   (baseTrace, switchBoard) <- liftIO $ setupTrace_ logConfig "cardano"
 
   let loggingEnabled :: Bool
-      loggingEnabled = ncLoggingSwitch nodeConfig
+      loggingEnabled = ncLoggingSwitch nodeConfig'
       trace :: Trace IO Text
       trace = if loggingEnabled
               then baseTrace
               else Trace.nullTracer
 
   when loggingEnabled $ liftIO $
-    loggingPreInit nodeConfig logConfig switchBoard trace
+    loggingPreInit nodeConfig' logConfig switchBoard trace
 
   pure $ mkLogLayer logConfig switchBoard trace
  where

cardano-node/src/Cardano/Node/Configuration/Socket.hs

@@ -17,6 +17,7 @@ import           Control.Monad.Trans.Except.Extra (handleIOExceptT)
 import           Network.Socket (AddrInfo (..), AddrInfoFlag (..), Socket, SocketType (..),
                      defaultHints, getAddrInfo)
 
+import           Cardano.Node.Configuration.POM (NodeConfiguration (..))
 import           Cardano.Node.Types
 
 #if defined(mingw32_HOST_OS)
@@ -91,18 +92,17 @@ renderSocketConfigError (GetAddrInfoError addr ex) =
 -- * systemd socket activation
 --
 gatherConfiguredSockets :: NodeConfiguration
-                        -> NodeCLI
                         -> ExceptT SocketConfigError IO
                                    (SocketOrSocketInfo [Socket] [AddrInfo],
                                     SocketOrSocketInfo Socket SocketPath)
-gatherConfiguredSockets config cli = do
+gatherConfiguredSockets config = do
 
     mbAllSocketsFromSystemD          <- liftIO getSystemdSockets
 
     -- Select the sockets or address for public node-to-node comms
     --
     let mbPublicSocketsAddrFromConfigOrCLI :: Maybe NodeAddress
-        mbPublicSocketsAddrFromConfigOrCLI = nodeAddr cli
+        mbPublicSocketsAddrFromConfigOrCLI = ncNodeAddr config
                                              --TODO: add config file support
         mbPublicSocketsFromSystemD         = snd <$> mbAllSocketsFromSystemD
 
@@ -117,11 +117,10 @@ gatherConfiguredSockets config cli = do
 
     -- Select the socket or path for local node-to-client comms
     --
-    let mbLocalSocketFileConfigOrCLI  = socketFile cli `mplus`
-                                        ncSocketPath config
+    let mbLocalSocketFileConfig       = ncSocketPath config
         mbLocalSocketFromSystemD      = fst <$> mbAllSocketsFromSystemD
 
-    local  <- case (mbLocalSocketFileConfigOrCLI,
+    local  <- case (mbLocalSocketFileConfig,
                     mbLocalSocketFromSystemD) of
                 (Nothing, Just sock) -> return (ActualSocket sock)
                 (Just path, Nothing) -> do removeStaleLocalSocket path

cardano-node/src/Cardano/Node/Configuration/Topology.hs

@@ -25,6 +25,7 @@ import qualified Data.Text as Text
 import           Network.Socket (PortNumber, SockAddr (..))
 import           Text.Read (readMaybe)
 
+import           Cardano.Node.Configuration.POM (NodeConfiguration (..))
 import           Cardano.Node.Types
 
 import           Ouroboros.Consensus.Util.Condense (Condense (..))
@@ -128,9 +129,9 @@ instance ToJSON NetworkTopology where
 -- | Read the `NetworkTopology` configuration from the specified file.
 -- While running a real protocol, this gives your node its own address and
 -- other remote peers it will attempt to connect to.
-readTopologyFile :: NodeCLI -> IO (Either Text NetworkTopology)
-readTopologyFile ncli = do
-  eBs <- Exception.try $ BS.readFile (unTopology $ topologyFile ncli)
+readTopologyFile :: NodeConfiguration -> IO (Either Text NetworkTopology)
+readTopologyFile nc = do
+  eBs <- Exception.try $ BS.readFile (unTopology $ ncTopologyFile nc)
 
   case eBs of
     Left e -> return . Left $ handler e

cardano-node/src/Cardano/Node/Handlers/Shutdown.hs

@@ -39,7 +39,7 @@ import           Ouroboros.Consensus.Util.ResourceRegistry (ResourceRegistry)
 import           Ouroboros.Consensus.Util.STM (onEachChange)
 import           Ouroboros.Network.Block (MaxSlotNo (..), SlotNo, pointSlot)
 
-import           Cardano.Node.Types
+import           Cardano.Node.Configuration.POM (NodeConfiguration (..))
 
 -- | 'ShutdownFDs' mediate the graceful shutdown requests,
 -- either external or internal to the process.
@@ -131,18 +131,18 @@ triggerShutdown (ShutdownDoorbell (Fd shutFd)) trace reason = do
 -- external or internal, as requested by configuration in 'NodeCLI',
 -- while allocating corresponding 'ShutdownFDs', and providing them to the 'action'.
 withShutdownHandling
-  :: NodeCLI
+  :: NodeConfiguration
   -> Trace IO Text
   -> (ShutdownFDs -> IO ())
   -> IO ()
-withShutdownHandling cli trace action = do
-  sfds <- decideShutdownFds cli
+withShutdownHandling nc trace action = do
+  sfds <- decideShutdownFds nc
   withShutdownHandler (sfdsListener sfds) trace (action sfds)
  where
-   decideShutdownFds :: NodeCLI -> IO ShutdownFDs
-   decideShutdownFds NodeCLI{shutdownIPC = Just fd} =
+   decideShutdownFds :: NodeConfiguration -> IO ShutdownFDs
+   decideShutdownFds NodeConfiguration{ncShutdownIPC = Just fd} =
      pure $ ExternalShutdown (ShutdownListener fd)
-   decideShutdownFds NodeCLI{shutdownOnSlotSynced = MaxSlotNo{}} =
+   decideShutdownFds NodeConfiguration{ncShutdownOnSlotSynced = MaxSlotNo{}} =
      mkInternalShutdown
    decideShutdownFds _ = pure NoShutdownFDs
 
@@ -155,14 +155,14 @@ withShutdownHandling cli trace action = do
 -- spawn a thread that would cause node to shutdown upon ChainDB reaching the
 -- configuration-defined slot.
 maybeSpawnOnSlotSyncedShutdownHandler
-  :: NodeCLI
+  :: NodeConfiguration
   -> ShutdownFDs
   -> Trace IO Text
   -> ResourceRegistry IO
   -> ChainDB.ChainDB IO blk
   -> IO ()
-maybeSpawnOnSlotSyncedShutdownHandler cli sfds trace registry chaindb =
-  case (shutdownOnSlotSynced cli, sfds) of
+maybeSpawnOnSlotSyncedShutdownHandler nc sfds trace registry chaindb =
+  case (ncShutdownOnSlotSynced nc, sfds) of
     (MaxSlotNo maxSlot, InternalShutdown _sl sd) -> do
       traceWith (trTransformer MaximalVerbosity $ severityNotice trace)
         ("will terminate upon reaching " <> pack (show maxSlot))

cardano-node/src/Cardano/Node/Parsers.hs

@@ -20,9 +20,10 @@ import           System.Posix.Types (Fd (..))
 
 import           Ouroboros.Network.Block (MaxSlotNo (..), SlotNo (..))
 
+import           Cardano.Node.Configuration.POM (PartialNodeConfiguration (..), lastOption)
 import           Cardano.Node.Types
 
-nodeCLIParser  :: Parser NodeCLI
+nodeCLIParser  :: Parser PartialNodeConfiguration
 nodeCLIParser = subparser
                 (  commandGroup "Run the node"
                 <> metavar "run"
@@ -31,12 +32,12 @@ nodeCLIParser = subparser
                            (progDesc "Run the node." ))
                 )
 
-nodeRunParser :: Parser NodeCLI
+nodeRunParser :: Parser PartialNodeConfiguration
 nodeRunParser = do
   -- Filepaths
-  topFp <- parseTopologyFile
-  dbFp <- parseDbPath
-  socketFp <-   optional $ parseSocketPath "Path to a cardano-node socket"
+  topFp <- lastOption parseTopologyFile
+  dbFp <- lastOption parseDbPath
+  socketFp <-   lastOption $ parseSocketPath "Path to a cardano-node socket"
 
   -- Protocol files
   byronCertFile   <- optional parseDelegationCert
@@ -46,33 +47,33 @@ nodeRunParser = do
   shelleyCertFile <- optional parseOperationalCertFilePath
 
   -- Node Address
-  nAddress <- optional parseNodeAddress
+  nAddress <- lastOption parseNodeAddress
 
   -- NodeConfiguration filepath
-  nodeConfigFp <- parseConfigFile
-
-  validate <- parseValidateDB
-  shutdownIPC <- parseShutdownIPC
-
-  shutdownOnSlotSynced <- parseShutdownOnSlotSynced
-
-  pure NodeCLI
-    { nodeAddr = nAddress
-    , configFile   = ConfigYamlFilePath nodeConfigFp
-    , topologyFile = TopologyFile topFp
-    , databaseFile = DbFile dbFp
-    , socketFile   = socketFp
-    , protocolFiles = ProtocolFilepaths
-      { byronCertFile
-      , byronKeyFile
-      , shelleyKESFile
-      , shelleyVRFFile
-      , shelleyCertFile
-      }
-    , validateDB = validate
-    , shutdownIPC
-    , shutdownOnSlotSynced
-    }
+  nodeConfigFp <- lastOption parseConfigFile
+
+  validate <- lastOption parseValidateDB
+  shutdownIPC <- lastOption parseShutdownIPC
+
+  shutdownOnSlotSynced <- lastOption parseShutdownOnSlotSynced
+
+  pure $ mempty
+           { pncNodeAddr = nAddress
+           , pncConfigFile   = ConfigYamlFilePath <$> nodeConfigFp
+           , pncTopologyFile = TopologyFile <$> topFp
+           , pncDatabaseFile = DbFile <$> dbFp
+           , pncSocketPath   = socketFp
+           , pncProtocolFiles = Last $ Just ProtocolFilepaths
+             { byronCertFile
+             , byronKeyFile
+             , shelleyKESFile
+             , shelleyVRFFile
+             , shelleyCertFile
+             }
+           , pncValidateDB = validate
+           , pncShutdownIPC = shutdownIPC
+           , pncShutdownOnSlotSynced = shutdownOnSlotSynced
+           }
 
 parseSocketPath :: Text -> Parser SocketPath
 parseSocketPath helpMessage =

cardano-node/src/Cardano/Node/Protocol.hs

@@ -12,6 +12,7 @@ import           Cardano.Prelude
 import           Control.Monad.Trans.Except (ExceptT)
 import           Control.Monad.Trans.Except.Extra (firstExceptT)
 
+import           Cardano.Node.Configuration.POM (NodeConfiguration (..))
 import           Cardano.Node.Types
 
 import           Cardano.Node.Protocol.Byron
@@ -25,18 +26,17 @@ import           Cardano.Node.Protocol.Types (SomeConsensusProtocol (..))
 
 mkConsensusProtocol
   :: NodeConfiguration
-  -> Maybe ProtocolFilepaths
   -> ExceptT ProtocolInstantiationError IO SomeConsensusProtocol
-mkConsensusProtocol NodeConfiguration{ncProtocolConfig} files =
+mkConsensusProtocol NodeConfiguration{ncProtocolConfig, ncProtocolFiles} =
     case ncProtocolConfig of
 
       NodeProtocolConfigurationByron config ->
         firstExceptT ByronProtocolInstantiationError $
-          mkSomeConsensusProtocolByron config files
+          mkSomeConsensusProtocolByron config (Just ncProtocolFiles)
 
       NodeProtocolConfigurationShelley config ->
         firstExceptT ShelleyProtocolInstantiationError $
-          mkSomeConsensusProtocolShelley config files
+          mkSomeConsensusProtocolShelley config (Just ncProtocolFiles)
 
       NodeProtocolConfigurationCardano byronConfig
                                        shelleyConfig
@@ -46,7 +46,7 @@ mkConsensusProtocol NodeConfiguration{ncProtocolConfig} files =
             byronConfig
             shelleyConfig
             hardForkConfig
-            files
+            (Just ncProtocolFiles)
 
 ------------------------------------------------------------------------------
 -- Errors