consensus: use Natural for ByteSize

At the cost of a single pointer indirection --- which we expect to be dwarfed
by crypto checks etc --- the Mempool is trivially innoculated against
overflows.

The worst-case is actually at most two pointers, and that can only happen when
a Word64 actually would have overflowed. This should never happen in practice
due to the Diffusion Layer's finitely-bounded message buffers (for the
TxSubmission mini protocol, in particular) (perhaps unless the node is severely
configured). But a minor performance hit seems a preferable worst-case compared
to crashes/confused conditionals/etc.

Author: nfrisby

ouroboros-consensus-cardano/src/byron/Ouroboros/Consensus/Byron/Ledger/Mempool.hs

@@ -129,6 +129,7 @@ instance TxLimits ByronBlock where
 
   blockCapacityTxMeasure _cfg st =
       ByteSize
+    $ fromIntegral
     $ CC.getMaxBlockSize cvs - byronBlockEncodingOverhead
     where
       cvs = tickedByronLedgerState st

ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Ledger/Mempool.hs

@@ -282,7 +282,7 @@ txsMaxBytes ::
   -> ByteSize
 txsMaxBytes TickedShelleyLedgerState { tickedShelleyLedgerState } =
     -- `maxBlockBodySize` is expected to be bigger than `fixedBlockBodyOverhead`
-    ByteSize $ maxBlockBodySize - fixedBlockBodyOverhead
+    ByteSize $ fromIntegral $ maxBlockBodySize - fixedBlockBodyOverhead
   where
     maxBlockBodySize = getPParams tickedShelleyLedgerState ^. ppMaxBBSizeL
 

ouroboros-consensus-cardano/test/shelley-test/Test/Consensus/Shelley/Coherence.hs

@@ -5,7 +5,7 @@ import qualified Data.Measure as Measure
 import           Data.Word (Word32)
 import           Ouroboros.Consensus.Ledger.SupportsMempool (ByteSize (..))
 import           Ouroboros.Consensus.Shelley.Ledger.Mempool (AlonzoMeasure (..),
-                     fromExUnits)
+                     ConwayMeasure (..), fromExUnits)
 import           Test.Cardano.Ledger.Alonzo.Serialisation.Generators ()
 import           Test.Tasty
 import           Test.Tasty.QuickCheck
@@ -16,11 +16,18 @@ tests = testGroup "Shelley coherences" [
     ]
 
 -- | 'Measure.<=' and @'pointWiseExUnits' (<=)@ must agree
-leqCoherence :: Word32 -> ExUnits -> ExUnits -> Property
-leqCoherence w eu1 eu2 =
+leqCoherence :: Word32 -> Word32 -> ExUnits -> ExUnits -> Property
+leqCoherence w1 w2 eu1 eu2 =
     actual === expected
   where
-    inj eu = AlonzoMeasure (ByteSize w) (fromExUnits eu)
+    -- ConwayMeasure is the fullest TxMeasure and mainnet's
+    inj eu =
+        ConwayMeasure
+          (AlonzoMeasure
+             (ByteSize (fromIntegral w1))
+             (fromExUnits eu)
+          )
+          (ByteSize (fromIntegral w2))
 
     actual   = inj eu1 Measure.<= inj eu2
     expected = pointWiseExUnits (<=) eu1 eu2

ouroboros-consensus-diffusion/src/ouroboros-consensus-diffusion/Ouroboros/Consensus/NodeKernel.hs

@@ -706,7 +706,10 @@ getMempoolReader mempool = MempoolReader.TxSubmissionMempoolReader
                                       snapshotHasTx } =
       MempoolReader.MempoolSnapshot
         { mempoolTxIdsAfter = \idx ->
-            [ (txId (txForgetValidated tx), idx', unByteSize byteSize)
+            [ ( txId (txForgetValidated tx)
+              , idx'
+              , fromIntegral $ unByteSize byteSize   -- TODO overflow?
+              )
             | (tx, idx', byteSize) <- snapshotTxsAfter idx
             ]
         , mempoolLookupTx   = snapshotLookupTx

ouroboros-consensus-diffusion/test/consensus-test/Test/Consensus/HardFork/Combinator/A.hs

@@ -330,8 +330,7 @@ instance LedgerSupportsMempool BlockA where
 
 instance TxLimits BlockA where
   type TxMeasure BlockA = ByteSize
-  -- default mempool capacity is two blocks, so maxBound/2 avoids overflow
-  blockCapacityTxMeasure _cfg _st     = ByteSize $ maxBound `div` 2
+  blockCapacityTxMeasure _cfg _st     = ByteSize $ 100 * 1024   -- arbitrary
   txMeasure              _cfg _st _tx = ByteSize 0
 
 newtype instance TxId (GenTx BlockA) = TxIdA Int

ouroboros-consensus-diffusion/test/consensus-test/Test/Consensus/HardFork/Combinator/B.hs

@@ -266,8 +266,7 @@ instance LedgerSupportsMempool BlockB where
 
 instance TxLimits BlockB where
   type TxMeasure BlockB = ByteSize
-  -- default mempool capacity is two blocks, so maxBound/2 avoids overflow
-  blockCapacityTxMeasure _cfg _st     = ByteSize $ maxBound `div` 2
+  blockCapacityTxMeasure _cfg _st     = ByteSize $ 100 * 1024   -- arbitrary
   txMeasure              _cfg _st _tx = ByteSize 0
 
 data instance TxId (GenTx BlockB)

ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Ledger/SupportsMempool.hs

@@ -26,9 +26,9 @@ import           Data.ByteString.Short (ShortByteString)
 import           Data.DerivingVia (InstantiatedAt (..))
 import           Data.Kind (Type)
 import           Data.Measure (Measure)
-import           Data.Word (Word32)
 import           GHC.Stack (HasCallStack)
 import           NoThunks.Class
+import           Numeric.Natural (Natural)
 import           Ouroboros.Consensus.Block.Abstract
 import           Ouroboros.Consensus.Ledger.Abstract
 import           Ouroboros.Consensus.Ticked
@@ -204,7 +204,10 @@ class ( Measure     (TxMeasure blk)
     -> TickedLedgerState blk
     -> TxMeasure blk
 
-newtype ByteSize = ByteSize { unByteSize :: Word32 }
+-- | We intentionally do not declare a 'Num' instance! We prefer @ByteSize@ to
+-- occur explicitly in the code where possible, for legibility/perspciousness.
+-- We also do not need nor want subtraction.
+newtype ByteSize = ByteSize { unByteSize :: Natural }
   deriving stock (Show)
   deriving newtype (Eq, Ord)
   deriving newtype (Measure)

ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/MiniProtocol/LocalTxMonitor/Server.hs

@@ -61,10 +61,10 @@ localTxMonitorServer mempool =
       , recvMsgGetSizes = do
           let MempoolSize{msNumTxs,msNumBytes} = snapshotMempoolSize snapshot
           let sizes = MempoolSizeAndCapacity
-                { capacityInBytes = unByteSize capacity
-                , sizeInBytes     = unByteSize msNumBytes
+                { capacityInBytes = fromIntegral $ unByteSize capacity
+                , sizeInBytes     = fromIntegral $ unByteSize msNumBytes
                 , numberOfTxs     = msNumTxs
-                }
+                }   -- TODO what to do about overflow?
           pure $ SendMsgReplyGetSizes sizes (serverStAcquired s txs)
       , recvMsgAwaitAcquire = do
           s' <- atomically $ do

ouroboros-consensus/test/consensus-test/Test/Consensus/Mempool.hs

@@ -35,7 +35,7 @@ module Test.Consensus.Mempool (tests) where
 import           Cardano.Binary (Encoding, toCBOR)
 import           Cardano.Crypto.Hash
 import           Control.Exception (assert)
-import           Control.Monad (foldM, forM, forM_, void)
+import           Control.Monad (foldM, forM, forM_, void, when)
 import           Control.Monad.Except (Except, runExcept)
 import           Control.Monad.IOSim (runSimOrThrow)
 import           Control.Monad.State (State, evalState, get, modify)
@@ -48,8 +48,9 @@ import qualified Data.Map.Strict as Map
 import           Data.Maybe (mapMaybe)
 import           Data.Semigroup (stimes)
 import qualified Data.Set as Set
-import           Data.Word
+import           Data.Word (Word32)
 import           GHC.Stack (HasCallStack)
+import           Numeric.Natural (Natural)
 import           Ouroboros.Consensus.Block
 import           Ouroboros.Consensus.BlockchainTime
 import           Ouroboros.Consensus.Config.SecurityParam
@@ -355,7 +356,7 @@ ppTestTxWithHash x = condense
 --
 -- The generated 'testMempoolCap' will be:
 -- > foldMap 'txSize' 'testInitialTxs' + extraCapacity
-genTestSetupWithExtraCapacity :: Int -> Word32 -> Gen (TestSetup, LedgerState TestBlock)
+genTestSetupWithExtraCapacity :: Int -> Natural -> Gen (TestSetup, LedgerState TestBlock)
 genTestSetupWithExtraCapacity maxInitialTxs extraCapacity = do
     ledgerSize   <- choose (0, maxInitialTxs)
     nbInitialTxs <- choose (0, maxInitialTxs)
@@ -831,20 +832,26 @@ instance Arbitrary MempoolCapTestSetup where
     -- The Mempool should at least be capable of containing the transactions
     -- it already contains.
     let currentSize               = foldMap txSize (testInitialTxs testSetup)
-        ByteSize capacityMinBound = currentSize
+        capacityMinBound = currentSize
         validTxsToAdd             = [tx | (tx, True) <- txs]
         -- Use the current size + the sum of all the valid transactions to add
         -- as the upper bound.
-        ByteSize capacityMaxBound = currentSize <> foldMap txSize validTxsToAdd
+        capacityMaxBound = currentSize <> foldMap txSize validTxsToAdd
     -- Note that we could pick @currentSize@, meaning that we can't add any
     -- more transactions to the Mempool
+
+    when (unByteSize capacityMaxBound >= 2^(32 :: Int)) $ do
+      error "impossible!"   -- could 'QC.discard' if this is actually feasible
+
     capacity <- choose
-      ( capacityMinBound
-      , capacityMaxBound
+      ( fromIntegral (unByteSize capacityMinBound) :: Word32
+      , fromIntegral (unByteSize capacityMaxBound) :: Word32
       )
     let testSetup' = testSetup {
             testMempoolCapOverride =
-              MempoolCapacityBytesOverride (ByteSize capacity)
+                MempoolCapacityBytesOverride
+              $ ByteSize
+              $ fromIntegral (capacity :: Word32)
           }
     return $ MempoolCapTestSetup testSetupWithTxs { testSetup = testSetup' }
 
@@ -942,8 +949,8 @@ data TxSizeSplitTestSetup = TxSizeSplitTestSetup
 
 instance Arbitrary TxSizeSplitTestSetup where
   arbitrary = do
-    let txSizeMaxBound = 10 * 1024 * 1024 -- 10MB transaction max bound
-    txSizes <- listOf $ choose (1, txSizeMaxBound)
+    let txSizeMaxBound = 10 * 1024 * 1024 -- 10 mebibyte transaction max bound
+    txSizes <- listOf $ choose (1, txSizeMaxBound :: Word32)
     let totalTxsSize = sum txSizes
     txSizeToSplitOn <- frequency
       [ (1, pure 0)
@@ -952,8 +959,8 @@ instance Arbitrary TxSizeSplitTestSetup where
       , (1, choose (totalTxsSize + 1, totalTxsSize + 1000))
       ]
     pure TxSizeSplitTestSetup
-      { tssTxSizes = map ByteSize txSizes
-      , tssTxSizeToSplitOn = ByteSize txSizeToSplitOn
+      { tssTxSizes = map (ByteSize . fromIntegral) txSizes
+      , tssTxSizeToSplitOn = ByteSize $ fromIntegral txSizeToSplitOn
       }
 
   shrink TxSizeSplitTestSetup { tssTxSizes, tssTxSizeToSplitOn = ByteSize x } =
@@ -1031,9 +1038,8 @@ prop_Mempool_idx_consistency (Actions actions) =
       , testMempoolCapOverride =
             MempoolCapacityBytesOverride
           $ ByteSize
-          $ maxBound - unByteSize simpleBlockCapacity
-          --- can't use maxBound, because then 'computeMempoolCapacity'
-          --- calculation overflows, resulting in a capacity of just one block
+          $ 1024*1024*1024
+            -- There's no way this test will need more than a gibibyte.
       }
 
     lastOfMempoolRemoved txsInMempool = \case