Merge pull request #6274 from IntersectMBO/coot/default-options

NodeConfiguration: default peer sharing option

Author: coot

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

@@ -227,6 +227,7 @@ data PartialNodeConfiguration
        , pncConfigFile      :: !(Last ConfigYamlFilePath)
        , pncTopologyFile    :: !(Last TopologyFile)
        , pncDatabaseFile    :: !(Last NodeDatabasePaths)
+         -- | pncProtocolFiles can only be supplied with command line arguments.
        , pncProtocolFiles   :: !(Last ProtocolFilepaths)
        , pncValidateDB      :: !(Last Bool)
        , pncShutdownConfig  :: !(Last ShutdownConfig)
@@ -313,6 +314,7 @@ instance Semigroup PartialNodeConfiguration where
 instance FromJSON PartialNodeConfiguration where
   parseJSON =
     withObject "PartialNodeConfiguration" $ \v -> do
+      pncStartAsNonProducingNode <- Last <$> v .:? "StartAsNonProducingNode"
 
       -- Node parameters, not protocol-specific
       pncSocketPath <- Last <$> v .:? "SocketPath"
@@ -433,7 +435,7 @@ instance FromJSON PartialNodeConfiguration where
            , pncProtocolFiles = mempty
            , pncValidateDB = mempty
            , pncShutdownConfig = mempty
-           , pncStartAsNonProducingNode = Last $ Just False
+           , pncStartAsNonProducingNode
            , pncMaybeMempoolCapacityOverride
            , pncLedgerDbConfig
            , pncProtocolIdleTimeout
@@ -651,7 +653,7 @@ defaultPartialNodeConfiguration =
     , pncDiffusionMode = Last $ Just InitiatorAndResponderDiffusionMode
     , pncExperimentalProtocolsEnabled = Last $ Just False
     , pncTopologyFile = Last . Just $ TopologyFile "configuration/cardano/mainnet-topology.json"
-    , pncProtocolFiles = mempty
+    , pncProtocolFiles = Last . Just $ ProtocolFilepaths Nothing Nothing Nothing Nothing Nothing Nothing
     , pncValidateDB = Last $ Just False
     , pncShutdownConfig = Last . Just $ ShutdownConfig Nothing Nothing
     , pncStartAsNonProducingNode = Last $ Just False
@@ -703,8 +705,8 @@ defaultPartialNodeConfiguration =
     , pncConsensusMode = Last (Just Ouroboros.defaultConsensusMode)
       -- https://ouroboros-network.cardano.intersectmbo.org/ouroboros-network/Ouroboros-Network-Diffusion-Configuration.html#v:defaultConsensusMode
     , pncEnableP2P     = Last (Just EnabledP2PMode)
-    , pncPeerSharing   = Last (Just Ouroboros.defaultPeerSharing)
-      -- https://ouroboros-network.cardano.intersectmbo.org/ouroboros-network/Ouroboros-Network-Diffusion-Configuration.html#v:defaultPeerSharing 
+    , pncPeerSharing   = mempty
+      -- the default is defined in `makeNodeConfiguration`
     , pncGenesisConfigFlags = Last (Just defaultGenesisConfigFlags)
       -- https://ouroboros-consensus.cardano.intersectmbo.org/haddocks/ouroboros-consensus-diffusion/Ouroboros-Consensus-Node-Genesis.html#v:defaultGenesisConfigFlags
     , pncResponderCoreAffinityPolicy = Last $ Just NoResponderCoreAffinity
@@ -721,6 +723,7 @@ makeNodeConfiguration pnc = do
   validateDB <- lastToEither "Missing ValidateDB" $ pncValidateDB pnc
   startAsNonProducingNode <- lastToEither "Missing StartAsNonProducingNode" $ pncStartAsNonProducingNode pnc
   protocolConfig <- lastToEither "Missing ProtocolConfig" $ pncProtocolConfig pnc
+  protocolFiles <- lastToEither "Missing ProtocolFiles" $ pncProtocolFiles pnc
   loggingSwitch <- lastToEither "Missing LoggingSwitch" $ pncLoggingSwitch pnc
   logMetrics <- lastToEither "Missing LogMetrics" $ pncLogMetrics pnc
   traceConfig <- first Text.unpack $ partialTraceSelectionToEither $ pncTraceConfig pnc
@@ -800,9 +803,14 @@ makeNodeConfiguration pnc = do
     $ getLast
     $ pncChainSyncIdleTimeout pnc
 
-  ncPeerSharing <-
-    lastToEither "Missing PeerSharing"
-    $ pncPeerSharing pnc
+  let ncPeerSharing =
+        case pncPeerSharing pnc of
+          Last Nothing ->
+            if    not startAsNonProducingNode
+               || hasProtocolFile protocolFiles
+            then PeerSharingDisabled
+            else PeerSharingEnabled
+          Last (Just peerSharing) -> peerSharing
 
   mGenesisConfigFlags <- case ncConsensusMode of
     PraosMode -> pure Nothing
@@ -847,13 +855,7 @@ makeNodeConfiguration pnc = do
              { ncConfigFile = configFile
              , ncTopologyFile = topologyFile
              , ncDatabaseFile = databaseFile
-             , ncProtocolFiles =
-                 -- TODO: ncProtocolFiles should be Maybe ProtocolFiles
-                 -- as relay nodes don't need the protocol files because
-                 -- they are not minting blocks.
-                 case getLast $ pncProtocolFiles pnc of
-                   Just pFiles -> pFiles
-                   Nothing -> ProtocolFilepaths Nothing Nothing Nothing Nothing Nothing Nothing
+             , ncProtocolFiles = protocolFiles
              , ncValidateDB = validateDB
              , ncShutdownConfig = shutdownConfig
              , ncStartAsNonProducingNode = startAsNonProducingNode

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

@@ -33,7 +33,9 @@ import           Data.Monoid (Last (..))
 import           Data.Text (Text)
 import qualified Data.Text as Text
 import           Data.Word (Word16, Word32)
-import           Options.Applicative hiding (str)
+import           Options.Applicative hiding (str, switch)
+-- Don't use switch.  It will not allow to set an option in a configuration
+-- file.  See `parseStartAsNonProducingNode` and `parseValidateDB`.
 import qualified Options.Applicative as Opt
 import qualified Options.Applicative.Help as OptI
 import           System.Posix.Types (Fd (..))
@@ -65,7 +67,7 @@ nodeRunParser = do
   shelleyVRFFile  <- optional parseVrfKeyFilePath
   shelleyCertFile <- optional parseOperationalCertFilePath
   shelleyBulkCredsFile <- optional parseBulkCredsFilePath
-  startAsNonProducingNode <- lastOption parseStartAsNonProducingNode
+  startAsNonProducingNode <- Last <$> parseStartAsNonProducingNode
 
   -- Node Address
   nIPv4Address <- lastOption parseHostIPv4Addr
@@ -301,9 +303,13 @@ parseImmutableDbPath = strOption $
     ]
 
 
+-- | 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 =
-    switch (
+    Opt.switch (
          long "validate-db"
       <> help "Validate all on-disk database files"
     )
@@ -388,9 +394,12 @@ parseVrfKeyFilePath =
         <> completer (bashCompleter "file")
     )
 
-parseStartAsNonProducingNode :: Parser Bool
+-- | 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 =
-  switch $ mconcat
+  flag Nothing (Just True) $ mconcat
     [ long "non-producing-node"
     , help $ mconcat
         [ "Start the node as a non block producing node even if "

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

@@ -17,6 +17,7 @@ module Cardano.Node.Types
   , PeerSnapshotFile (..)
   , CheckpointsFile(..)
   , ProtocolFilepaths (..)
+  , hasProtocolFile
   , GenesisHash(..)
   , CheckpointsHash(..)
   , MaxConcurrencyBulkSync(..)
@@ -50,6 +51,7 @@ import           Ouroboros.Network.NodeToNode (DiffusionMode (..))
 import           Control.Exception
 import           Data.Aeson
 import           Data.ByteString (ByteString)
+import           Data.Maybe (isJust)
 import           Data.Monoid (Last (..))
 import           Data.String (IsString)
 import           Data.Text (Text)
@@ -174,6 +176,25 @@ data ProtocolFilepaths =
      , shelleyBulkCredsFile :: !(Maybe FilePath)
      } deriving (Eq, Show)
 
+-- | If any of the 'ProtocolFilepath` is given `PeerSharing` option will be
+-- disabled by default.
+--
+hasProtocolFile :: ProtocolFilepaths -> Bool
+hasProtocolFile ProtocolFilepaths {
+    byronCertFile,
+    byronKeyFile,
+    shelleyKESFile,
+    shelleyVRFFile,
+    shelleyCertFile,
+    shelleyBulkCredsFile
+  }
+  =  isJust byronCertFile
+  || isJust byronKeyFile
+  || isJust shelleyKESFile
+  || isJust shelleyVRFFile
+  || isJust shelleyCertFile
+  || isJust shelleyBulkCredsFile
+
 newtype GenesisHash = GenesisHash (Crypto.Hash Crypto.Blake2b_256 ByteString)
   deriving newtype (Eq, Show, ToJSON, FromJSON)