Merge #3273

3273: Expose ability to configure mempool capacity override r=newhoggy a=newhoggy



Co-authored-by: John Ky <john.ky@iohk.io>

cabal.project

@@ -231,8 +231,8 @@ source-repository-package
 source-repository-package
   type: git
   location: https://github.com/input-output-hk/ouroboros-network
-  tag: c834f359e519a31afc5a285b6aad9fc49355ff19
-  --sha256: 1dimgkjc8d96k5gwp5cml8l79rpydyi7cvk6af94ihhgpshfz428
+  tag: e72d3dc867e946d877f45c22de0b6462723eb589
+  --sha256: 01rpknlp926x7nifr9zhv3nvn6wv0p3i84vibkb1n3g4minlwb25
   subdir:
     io-sim
     io-classes

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

@@ -1,6 +1,7 @@
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 
 {-# OPTIONS_GHC -Wno-noncanonical-monoid-instances #-}
 
@@ -33,10 +34,13 @@ import           Cardano.Crypto (RequiresNetworkMagic (..))
 import           Cardano.Node.Protocol.Types (Protocol (..))
 import           Cardano.Node.Types
 import           Cardano.Tracing.Config
+import           Ouroboros.Consensus.Mempool.API (MempoolCapacityBytesOverride (..), MempoolCapacityBytes (..))
 import           Ouroboros.Consensus.Storage.LedgerDB.DiskPolicy (SnapshotInterval (..))
 import           Ouroboros.Network.Block (MaxSlotNo (..))
 import           Ouroboros.Network.NodeToNode (DiffusionMode (..))
 
+import qualified Data.Aeson.Types as Aeson
+
 data NodeConfiguration
   = NodeConfiguration
       {  ncNodeIPv4Addr    :: !(Maybe NodeHostIPv4Address)
@@ -83,6 +87,8 @@ data NodeConfiguration
        , ncLoggingSwitch  :: !Bool
        , ncLogMetrics     :: !Bool
        , ncTraceConfig    :: !TraceOptions
+
+       , ncMaybeMempoolCapacityOverride :: !(Maybe MempoolCapacityBytesOverride)
        } deriving (Eq, Show)
 
 
@@ -102,7 +108,7 @@ data PartialNodeConfiguration
        , pncShutdownIPC     :: !(Last (Maybe Fd))
        , pncShutdownOnSlotSynced :: !(Last MaxSlotNo)
 
-          -- Protocol-specific parameters:
+         -- Protocol-specific parameters:
        , pncProtocolConfig :: !(Last NodeProtocolConfiguration)
 
          -- Node parameters, not protocol-specific:
@@ -119,6 +125,9 @@ data PartialNodeConfiguration
        , pncLoggingSwitch  :: !(Last Bool)
        , pncLogMetrics     :: !(Last Bool)
        , pncTraceConfig    :: !(Last TraceOptions)
+
+         -- Configuration for testing purposes
+       , pncMaybeMempoolCapacityOverride :: !(Last MempoolCapacityBytesOverride)
        } deriving (Eq, Generic, Show)
 
 instance AdjustFilePaths PartialNodeConfiguration where
@@ -167,6 +176,8 @@ instance FromJSON PartialNodeConfiguration where
                                                                <*> parseShelleyProtocol v
                                                                <*> parseAlonzoProtocol v
                                                                <*> parseHardForkProtocol v)
+      pncMaybeMempoolCapacityOverride <- Last <$> parseMempoolCapacityBytesOverride v
+
       pure PartialNodeConfiguration {
              pncProtocolConfig
            , pncSocketPath
@@ -188,8 +199,21 @@ instance FromJSON PartialNodeConfiguration where
            , pncValidateDB = mempty
            , pncShutdownIPC = mempty
            , pncShutdownOnSlotSynced = mempty
+           , pncMaybeMempoolCapacityOverride
            }
     where
+      parseMempoolCapacityBytesOverride v = parseNoOverride <|> parseOverride
+        where
+          parseNoOverride = fmap (MempoolCapacityBytesOverride . MempoolCapacityBytes) <$> v .:? "MempoolCapacityBytesOverride"
+          parseOverride = do
+            maybeString :: Maybe String <- v .:? "MempoolCapacityBytesOverride"
+            case maybeString of
+              Just "NoOverride" -> return (Just NoMempoolCapacityBytesOverride)
+              Just invalid ->  fmap Just . Aeson.parseFail $
+                    "Invalid value for 'MempoolCapacityBytesOverride'.  \
+                    \Expecting byte count or NoOverride.  Value was: " <> show invalid
+              Nothing -> return Nothing
+
       parseByronProtocol v = do
         primary   <- v .:? "ByronGenesisFile"
         secondary <- v .:? "GenesisFile"
@@ -309,6 +333,7 @@ defaultPartialNodeConfiguration =
     , pncMaxConcurrencyDeadline = mempty
     , pncLogMetrics = mempty
     , pncTraceConfig = mempty
+    , pncMaybeMempoolCapacityOverride = mempty
     }
 
 lastOption :: Parser a -> Parser (Last a)
@@ -358,6 +383,7 @@ makeNodeConfiguration pnc = do
              , ncLogMetrics = logMetrics
              , ncTraceConfig = if loggingSwitch then traceConfig
                                                 else TracingOff
+             , ncMaybeMempoolCapacityOverride = getLast $ pncMaybeMempoolCapacityOverride pnc
              }
 
 ncProtocol :: NodeConfiguration -> Protocol

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

@@ -1,5 +1,6 @@
 {-# LANGUAGE ApplicativeDo #-}
 {-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE TypeApplications #-}
 
 module Cardano.Node.Parsers
   ( nodeCLIParser
@@ -19,6 +20,7 @@ import           System.Posix.Types (Fd (..))
 
 import           Ouroboros.Network.Block (MaxSlotNo (..), SlotNo (..))
 
+import           Ouroboros.Consensus.Mempool.API (MempoolCapacityBytesOverride (..), MempoolCapacityBytes (..))
 import           Ouroboros.Consensus.Storage.LedgerDB.DiskPolicy (SnapshotInterval (..))
 
 import           Cardano.Node.Configuration.POM (PartialNodeConfiguration (..), lastOption)
@@ -62,6 +64,8 @@ nodeRunParser = do
 
   shutdownOnSlotSynced <- lastOption parseShutdownOnSlotSynced
 
+  maybeMempoolCapacityOverride <- lastOption parseMempoolCapacityOverride
+
   pure $ PartialNodeConfiguration
            { pncNodeIPv4Addr = nIPv4Address
            , pncNodeIPv6Addr = nIPv6Address
@@ -90,6 +94,7 @@ nodeRunParser = do
            , pncLoggingSwitch = mempty
            , pncLogMetrics = mempty
            , pncTraceConfig = mempty
+           , pncMaybeMempoolCapacityOverride = maybeMempoolCapacityOverride
            }
 
 parseSocketPath :: Text -> Parser SocketPath
@@ -153,6 +158,24 @@ parseConfigFile =
     <> completer (bashCompleter "file")
     )
 
+parseMempoolCapacityOverride :: Parser MempoolCapacityBytesOverride
+parseMempoolCapacityOverride = parseOverride <|> parseNoOverride
+  where
+    parseOverride :: Parser MempoolCapacityBytesOverride
+    parseOverride =
+      MempoolCapacityBytesOverride . MempoolCapacityBytes <$>
+      option (auto @Word32)
+        (  long "mempool-capacity-override"
+        <> metavar "BYTES"
+        <> help "The number of bytes"
+        )
+    parseNoOverride :: Parser MempoolCapacityBytesOverride
+    parseNoOverride =
+      flag' NoMempoolCapacityBytesOverride
+        (  long "no-mempool-capacity-override"
+        <> help "The port number"
+        )
+
 parseDbPath :: Parser FilePath
 parseDbPath =
   strOption

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

@@ -5,6 +5,7 @@
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
 
 #if !defined(mingw32_HOST_OS)
 #define UNIX
@@ -94,6 +95,8 @@ runNode cmdPc = do
             Left err -> panic $ "Error in creating the NodeConfiguration: " <> Text.pack err
             Right nc' -> return nc'
 
+    putStrLn $ "Node configuration: " <> show @_ @Text nc
+
     case shelleyVRFFile $ ncProtocolFiles nc of
       Just vrfFp -> do vrf <- runExceptT $ checkVRFFilePermissions vrfFp
                        case vrf of
@@ -283,15 +286,16 @@ handleSimpleNode scp runP trace nodeTracers nc onKernel = do
            onKernel nodeKernel
        }
      StdRunNodeArgs
-       { srnBfcMaxConcurrencyBulkSync   = unMaxConcurrencyBulkSync <$> ncMaxConcurrencyBulkSync nc
-       , srnBfcMaxConcurrencyDeadline   = unMaxConcurrencyDeadline <$> ncMaxConcurrencyDeadline nc
-       , srnChainDbValidateOverride     = ncValidateDB nc
-       , srnSnapshotInterval            = ncSnapshotInterval nc
-       , srnDatabasePath                = dbPath
-       , srnDiffusionArguments          = diffusionArguments
-       , srnDiffusionTracers            = diffusionTracers
-       , srnEnableInDevelopmentVersions = ncTestEnableDevelopmentNetworkProtocols nc
-       , srnTraceChainDB                = chainDBTracer nodeTracers
+       { srnBfcMaxConcurrencyBulkSync    = unMaxConcurrencyBulkSync <$> ncMaxConcurrencyBulkSync nc
+       , srnBfcMaxConcurrencyDeadline    = unMaxConcurrencyDeadline <$> ncMaxConcurrencyDeadline nc
+       , srnChainDbValidateOverride      = ncValidateDB nc
+       , srnSnapshotInterval             = ncSnapshotInterval nc
+       , srnDatabasePath                 = dbPath
+       , srnDiffusionArguments           = diffusionArguments
+       , srnDiffusionTracers             = diffusionTracers
+       , srnEnableInDevelopmentVersions  = ncTestEnableDevelopmentNetworkProtocols nc
+       , srnTraceChainDB                 = chainDBTracer nodeTracers
+       , srnMaybeMempoolCapacityOverride = ncMaybeMempoolCapacityOverride nc
        }
  where
   createDiffusionTracers :: Tracers RemoteConnectionId LocalConnectionId blk

cardano-node/test/Test/Cardano/Node/POM.hs

@@ -65,6 +65,7 @@ testPartialYamlConfig =
     , pncValidateDB = mempty
     , pncShutdownIPC = mempty
     , pncShutdownOnSlotSynced = mempty
+    , pncMaybeMempoolCapacityOverride = mempty
     }
 
 -- | Example partial configuration theoretically created
@@ -92,6 +93,7 @@ testPartialCliConfig =
     , pncLoggingSwitch = mempty
     , pncLogMetrics = mempty
     , pncTraceConfig = mempty
+    , pncMaybeMempoolCapacityOverride = mempty
     }
 
 -- | Expected final NodeConfiguration
@@ -120,6 +122,7 @@ expectedConfig =
     , ncLoggingSwitch = True
     , ncLogMetrics = True
     , ncTraceConfig = TracingOff
+    , ncMaybeMempoolCapacityOverride = Nothing
     }
 
 -- -----------------------------------------------------------------------------