Limit the size of forged blocks

Add a new argument to `NodeArgs`: `maxBlockBodySize :: Word32`. Use `snapshotTxsForSize` to efficiently get transaction from the Mempool (snapshot) until the maximum block size is reached.
IntersectMBO · Dec 13, 2019 · bb37308 · bb37308
1 parent 018a013
commit bb37308
Show file tree

Hide file tree

Showing 3 changed files with 11 additions and 7 deletions.
diff --git a/ouroboros-consensus/src/Ouroboros/Consensus/Node.hs b/ouroboros-consensus/src/Ouroboros/Consensus/Node.hs
@@ -256,6 +256,7 @@ mkNodeArgs registry cfg initState tracers btime chainDB = NodeArgs
     , blockFetchSize      = nodeBlockFetchSize
     , blockMatchesHeader  = nodeBlockMatchesHeader
     , maxUnackTxs         = 100 -- TODO
+    , maxBlockBodySize    = 2000000 -- TODO
     , mempoolCap          = MempoolCapacity 1000
     , chainSyncPipelining = pipelineDecisionLowHighMark 200 300 -- TODO
     }

diff --git a/ouroboros-consensus/src/Ouroboros/Consensus/NodeKernel.hs b/ouroboros-consensus/src/Ouroboros/Consensus/NodeKernel.hs
@@ -27,7 +27,7 @@ import           Control.Monad
 import           Crypto.Random (ChaChaDRG)
 import           Data.Map.Strict (Map)
 import           Data.Maybe (isNothing)
-import           Data.Word (Word16)
+import           Data.Word (Word16, Word32)
 
 import           Cardano.Prelude (UseIsNormalForm (..))
 import           Control.Tracer
@@ -136,6 +136,7 @@ data NodeArgs m peer blk = NodeArgs {
     , blockFetchSize      :: Header blk -> SizeInBytes
     , blockMatchesHeader  :: Header blk -> blk -> Bool
     , maxUnackTxs         :: Word16
+    , maxBlockBodySize    :: Word32
     , mempoolCap          :: MempoolCapacity
     , chainSyncPipelining :: MkPipelineDecision
     }
@@ -150,10 +151,10 @@ initNodeKernel
        )
     => NodeArgs m peer blk
     -> m (NodeKernel m peer blk)
-initNodeKernel args@NodeArgs { registry, cfg, tracers } = do
+initNodeKernel args@NodeArgs { registry, cfg, tracers, maxBlockBodySize } = do
     st <- initInternalState args
 
-    forkBlockProduction st
+    forkBlockProduction maxBlockBodySize st
 
     let IS { blockFetchInterface, fetchClientRegistry, varCandidates,
              chainDB, mempool } = st
@@ -295,9 +296,10 @@ data LeaderResult blk =
 forkBlockProduction
     :: forall m peer blk.
        (IOLike m, ProtocolLedgerView blk, ApplyTx blk)
-    => InternalState m peer blk
+    => Word32  -- ^ Max block size
+    -> InternalState m peer blk
     -> m ()
-forkBlockProduction IS{..} =
+forkBlockProduction maxBlockBodySize IS{..} =
     onSlotChange btime $ \currentSlot -> do
       varDRG <- newTVarM =<< (PRNG <$> produceDRG)
       -- See the docstring of 'withSyncState' for why we're using it instead
@@ -306,9 +308,9 @@ forkBlockProduction IS{..} =
       let withTxs :: (MempoolSnapshot blk TicketNo -> STM m a) -> m a
           withTxs = withSyncState mempool (TxsForBlockInSlot currentSlot)
 
-      leaderResult <- withTxs $ \MempoolSnapshot{snapshotTxs} -> do
+      leaderResult <- withTxs $ \MempoolSnapshot{snapshotTxsForSize} -> do
         l@ExtLedgerState{..} <- ChainDB.getCurrentLedger chainDB
-        let txs = map fst snapshotTxs
+        let txs = map fst (snapshotTxsForSize maxBlockBodySize)
 
         case anachronisticProtocolLedgerView cfg ledgerState (At currentSlot) of
           Right ledgerView -> do

diff --git a/ouroboros-consensus/test-consensus/Test/Dynamic/Network.hs b/ouroboros-consensus/test-consensus/Test/Dynamic/Network.hs
@@ -345,6 +345,7 @@ runNodeNetwork registry testBtime numCoreNodes nodeJoinPlan nodeTopology
             , blockFetchSize      = nodeBlockFetchSize
             , blockMatchesHeader  = nodeBlockMatchesHeader
             , maxUnackTxs         = 1000 -- TODO
+            , maxBlockBodySize    = 20000 -- TODO
             , mempoolCap          = MempoolCapacity 10 -- TODO
             , chainSyncPipelining = pipelineDecisionLowHighMark 2 4
             }