From 72d93ed7744dc27a96f43605541f440256eb8678 Mon Sep 17 00:00:00 2001
From: Luke Nadur <19835357+intricate@users.noreply.github.com>
Date: Wed, 15 Jan 2020 08:34:35 -0600
Subject: [PATCH] Calculate default mempool capacity as 2x the ledger max block
 size

---
 .../src/Ouroboros/Consensus/Node.hs           |  3 ++-
 .../src/Ouroboros/Consensus/NodeKernel.hs     | 26 ++++++++++++++++---
 .../test-consensus/Test/ThreadNet/Network.hs  |  2 +-
 3 files changed, 26 insertions(+), 5 deletions(-)

diff --git a/ouroboros-consensus/src/Ouroboros/Consensus/Node.hs b/ouroboros-consensus/src/Ouroboros/Consensus/Node.hs
index b6ed44f3ad1..ec3649fe209 100644
--- a/ouroboros-consensus/src/Ouroboros/Consensus/Node.hs
+++ b/ouroboros-consensus/src/Ouroboros/Consensus/Node.hs
@@ -23,6 +23,7 @@ module Ouroboros.Consensus.Node
   , NodeArgs (..)
   , NodeKernel (..)
   , MaxBlockSizeOverride (..)
+  , MempoolCapacityBytesOverride (..)
   , IPSubscriptionTarget (..)
   , DnsSubscriptionTarget (..)
   , ConnectionId (..)
@@ -279,7 +280,7 @@ mkNodeArgs registry cfg initState tracers btime chainDB isProducer = NodeArgs
     , blockMatchesHeader  = nodeBlockMatchesHeader
     , maxUnackTxs         = 100 -- TODO
     , maxBlockSize        = NoOverride
-    , mempoolCap          = MempoolCapacityBytes 128_000 -- TODO
+    , mempoolCap          = NoMempoolCapacityBytesOverride
     , chainSyncPipelining = pipelineDecisionLowHighMark 200 300 -- TODO
     }
   where
diff --git a/ouroboros-consensus/src/Ouroboros/Consensus/NodeKernel.hs b/ouroboros-consensus/src/Ouroboros/Consensus/NodeKernel.hs
index aaf776fa45c..d32dae134a4 100644
--- a/ouroboros-consensus/src/Ouroboros/Consensus/NodeKernel.hs
+++ b/ouroboros-consensus/src/Ouroboros/Consensus/NodeKernel.hs
@@ -16,6 +16,7 @@ module Ouroboros.Consensus.NodeKernel (
     NodeKernel (..)
   , BlockProduction (..)
   , MaxBlockSizeOverride (..)
+  , MempoolCapacityBytesOverride (..)
   , NodeArgs (..)
   , TraceForgeEvent (..)
   , initNodeKernel
@@ -138,6 +139,15 @@ data MaxBlockSizeOverride
   | MaxBlockBodySize !Word32
     -- ^ Use the following maximum size in bytes for the block body.
 
+-- | An override for the default 'MempoolCapacityBytes' which is 2x the
+-- maximum block size from the protocol parameters in the ledger.
+data MempoolCapacityBytesOverride
+  = NoMempoolCapacityBytesOverride
+    -- ^ Use 2x the maximum block size from the protocol parameters in the
+    -- ledger.
+  | MempoolCapacityBytesOverride !MempoolCapacityBytes
+    -- ^ Use the following 'MempoolCapacityBytes'.
+
 -- | Arguments required when initializing a node
 data NodeArgs m peer blk = NodeArgs {
       tracers             :: Tracers m peer blk
@@ -152,7 +162,7 @@ data NodeArgs m peer blk = NodeArgs {
     , blockMatchesHeader  :: Header blk -> blk -> Bool
     , maxUnackTxs         :: Word16
     , maxBlockSize        :: MaxBlockSizeOverride
-    , mempoolCap          :: MempoolCapacityBytes
+    , mempoolCap          :: MempoolCapacityBytesOverride
     , chainSyncPipelining :: MkPipelineDecision
     }
 
@@ -217,7 +227,7 @@ initInternalState
        , ProtocolLedgerView blk
        , Ord peer
        , NoUnexpectedThunks peer
-       , ApplyTx blk
+       , RunNode blk
        )
     => NodeArgs m peer blk
     -> m (InternalState m peer blk)
@@ -226,10 +236,13 @@ initInternalState NodeArgs { tracers, chainDB, registry, cfg,
                              initState, mempoolCap } = do
     varCandidates  <- newTVarM mempty
     varState       <- newTVarM initState
+    mpCap          <- atomically $ do
+      ledger <- ledgerState <$> ChainDB.getCurrentLedger chainDB
+      pure (mempoolCapacity ledger)
     mempool        <- openMempool registry
                                   (chainDBLedgerInterface chainDB)
                                   (ledgerConfigView cfg)
-                                  mempoolCap
+                                  mpCap
                                   (mempoolTracer tracers)
 
     fetchClientRegistry <- newFetchClientRegistry
@@ -242,6 +255,13 @@ initInternalState NodeArgs { tracers, chainDB, registry, cfg,
           cfg chainDB getCandidates blockFetchSize blockMatchesHeader btime
 
     return IS {..}
+  where
+    mempoolCapacity :: LedgerState blk -> MempoolCapacityBytes
+    mempoolCapacity ledger = case mempoolCap of
+        NoMempoolCapacityBytesOverride   -> noOverride
+        MempoolCapacityBytesOverride mcb -> mcb
+      where
+        noOverride = MempoolCapacityBytes (nodeMaxBlockSize ledger * 2)
 
 initBlockFetchConsensusInterface
     :: forall m peer blk. (IOLike m, SupportedBlock blk)
diff --git a/ouroboros-consensus/test-consensus/Test/ThreadNet/Network.hs b/ouroboros-consensus/test-consensus/Test/ThreadNet/Network.hs
index ef90de9e646..526e3639bea 100644
--- a/ouroboros-consensus/test-consensus/Test/ThreadNet/Network.hs
+++ b/ouroboros-consensus/test-consensus/Test/ThreadNet/Network.hs
@@ -443,7 +443,7 @@ runThreadNetwork ThreadNetworkArgs
             , blockMatchesHeader  = nodeBlockMatchesHeader
             , maxUnackTxs         = 1000 -- TODO
             , maxBlockSize        = NoOverride
-            , mempoolCap          = MempoolCapacityBytes 3000 -- TODO
+            , mempoolCap          = NoMempoolCapacityBytesOverride
             , chainSyncPipelining = pipelineDecisionLowHighMark 2 4
             }