consensus: remove Mempool.getTxSize

The 'LedgerSupportsMempool.txInBlockSize' method suffices, and is already in
scope within the mempool itself.

Adding sizes to the `MempoolSnapshot` interface replaces the other use of
`getTxSize`, in the `NodeKernel`.

Author: nfrisby

ouroboros-consensus-cardano/src/unstable-cardano-tools/Cardano/Tools/DBAnalyser/Analysis.hs

@@ -743,7 +743,6 @@ reproMempoolForge numBlks env = do
       -- one megabyte should generously accomodate two blocks' worth of txs
       (Mempool.MempoolCapacityBytesOverride $ Mempool.MempoolCapacityBytes $ 2^(20 :: Int))
       nullTracer
-      LedgerSupportsMempool.txInBlockSize
 
     void $ processAll db registry GetBlock startFrom limit Nothing (process howManyBlocks ref mempool)
     pure Nothing

ouroboros-consensus-cardano/test/cardano-test/Test/Consensus/Cardano/MiniProtocol/LocalTxSubmission/Server.hs

@@ -85,7 +85,6 @@ tests =
           mempool <- Mocked.openMockedMempool
                       capcityBytesOverride
                       tracer
-                      LedgerSupportsMempool.txInBlockSize
                       mempoolParams
 
           mempool `should_process` [ _137 ]

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

@@ -379,7 +379,6 @@ initInternalState NodeKernelArgs { tracers, chainDB, registry, cfg
                                  (configLedger cfg)
                                  mempoolCapacityOverride
                                  (mempoolTracer tracers)
-                                 txInBlockSize
 
     fetchClientRegistry <- newFetchClientRegistry
 
@@ -732,8 +731,8 @@ getMempoolReader mempool = MempoolReader.TxSubmissionMempoolReader
                                       snapshotHasTx } =
       MempoolReader.MempoolSnapshot
         { mempoolTxIdsAfter = \idx ->
-            [ (txId (txForgetValidated tx), idx', getTxSize mempool (txForgetValidated tx))
-            | (tx, idx') <- snapshotTxsAfter idx
+            [ (txId (txForgetValidated tx), idx', sz)
+            | (tx, idx', sz) <- snapshotTxsAfter idx
             ]
         , mempoolLookupTx   = snapshotLookupTx
         , mempoolHasTx      = snapshotHasTx

ouroboros-consensus/bench/mempool-bench/Main.hs

@@ -139,7 +139,6 @@ openMempoolWithCapacity capacity =
                                (Mempool.unByteSize capacity)
                              )
                              Tracer.nullTracer
-                             TestBlock.txSize
                              Mocked.MempoolAndModelParams {
                                  Mocked.immpInitialState = TestBlock.initialLedgerState
                                , Mocked.immpLedgerConfig = TestBlock.sampleLedgerConfig

ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Mempool/API.hs

@@ -207,9 +207,6 @@ data Mempool m blk = Mempool {
       -- capacity, i.e., we won't admit new transactions until some have been
       -- removed because they have become invalid.
     , getCapacity    :: STM m Cap.MempoolCapacityBytes
-
-      -- | Return the post-serialisation size in bytes of a 'GenTx'.
-    , getTxSize      :: GenTx blk -> TxSizeInBytes
     }
 
 {-------------------------------------------------------------------------------
@@ -335,7 +332,8 @@ data MempoolSnapshot blk = MempoolSnapshot {
     -- | Get all transactions (oldest to newest) in the mempool snapshot,
     -- along with their ticket number, which are associated with a ticket
     -- number greater than the one provided.
-  , snapshotTxsAfter    :: TicketNo -> [(Validated (GenTx blk), TicketNo)]
+  , snapshotTxsAfter    ::
+      TicketNo -> [(Validated (GenTx blk), TicketNo, TxSizeInBytes)]
 
     -- | Get a specific transaction from the mempool snapshot by its ticket
     -- number, if it exists.

ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Mempool/Impl/Common.hs

@@ -187,7 +187,6 @@ data MempoolEnv m blk = MempoolEnv {
     , mpEnvAddTxsRemoteFifo :: MVar m ()
     , mpEnvAddTxsAllFifo    :: MVar m ()
     , mpEnvTracer           :: Tracer m (TraceEventMempool blk)
-    , mpEnvTxSize           :: GenTx blk -> TxSizeInBytes
     , mpEnvCapacityOverride :: MempoolCapacityBytesOverride
     }
 
@@ -200,9 +199,8 @@ initMempoolEnv :: ( IOLike m
                -> LedgerConfig blk
                -> MempoolCapacityBytesOverride
                -> Tracer m (TraceEventMempool blk)
-               -> (GenTx blk -> TxSizeInBytes)
                -> m (MempoolEnv m blk)
-initMempoolEnv ledgerInterface cfg capacityOverride tracer txSize = do
+initMempoolEnv ledgerInterface cfg capacityOverride tracer = do
     st <- atomically $ getCurrentLedgerState ledgerInterface
     let (slot, st') = tickLedgerState cfg (ForgeInUnknownSlot st)
     isVar <- newTVarIO $ initInternalState capacityOverride TxSeq.zeroTicketNo slot st'
@@ -215,7 +213,6 @@ initMempoolEnv ledgerInterface cfg capacityOverride tracer txSize = do
       , mpEnvAddTxsRemoteFifo = addTxRemoteFifo
       , mpEnvAddTxsAllFifo    = addTxAllFifo
       , mpEnvTracer           = tracer
-      , mpEnvTxSize           = txSize
       , mpEnvCapacityOverride = capacityOverride
       }
 
@@ -323,14 +320,13 @@ extendVRPrevApplied cfg txTicket vr =
 -- again.
 extendVRNew :: (LedgerSupportsMempool blk, HasTxId (GenTx blk))
             => LedgerConfig blk
-            -> (GenTx blk -> TxSizeInBytes)
             -> WhetherToIntervene
             -> GenTx blk
             -> ValidationResult (GenTx blk) blk
             -> ( Either (ApplyTxErr blk) (Validated (GenTx blk))
                , ValidationResult (GenTx blk) blk
                )
-extendVRNew cfg txSize wti tx vr = assert (isNothing vrNewValid) $
+extendVRNew cfg wti tx vr = assert (isNothing vrNewValid) $
     case runExcept (applyTx cfg wti vrSlotNo tx vrAfter) of
       Left err         ->
         ( Left err
@@ -339,7 +335,7 @@ extendVRNew cfg txSize wti tx vr = assert (isNothing vrNewValid) $
         )
       Right (st', vtx) ->
         ( Right vtx
-        , vr { vrValid        = vrValid :> TxTicket vtx nextTicketNo (txSize tx)
+        , vr { vrValid        = vrValid :> TxTicket vtx nextTicketNo sz
              , vrValidTxIds   = Set.insert (txId tx) vrValidTxIds
              , vrNewValid     = Just vtx
              , vrAfter        = st'
@@ -359,6 +355,8 @@ extendVRNew cfg txSize wti tx vr = assert (isNothing vrNewValid) $
 
     nextTicketNo = succ vrLastTicketNo
 
+    sz = txInBlockSize tx
+
 {-------------------------------------------------------------------------------
   Conversions
 -------------------------------------------------------------------------------}
@@ -428,11 +426,13 @@ snapshotFromIS is = MempoolSnapshot {
  where
   implSnapshotGetTxs :: InternalState blk
                      -> [(Validated (GenTx blk), TicketNo)]
-  implSnapshotGetTxs = flip implSnapshotGetTxsAfter TxSeq.zeroTicketNo
+  implSnapshotGetTxs is' =
+      map (\(a, b, _c) -> (a, b))
+    $ implSnapshotGetTxsAfter is' TxSeq.zeroTicketNo
 
   implSnapshotGetTxsAfter :: InternalState blk
                           -> TicketNo
-                          -> [(Validated (GenTx blk), TicketNo)]
+                          -> [(Validated (GenTx blk), TicketNo, TxSizeInBytes)]
   implSnapshotGetTxsAfter IS{isTxs} =
     TxSeq.toTuples . snd . TxSeq.splitAfterTicketNo isTxs
 

ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Mempool/Init.hs

@@ -39,10 +39,9 @@ openMempool ::
   -> LedgerConfig blk
   -> MempoolCapacityBytesOverride
   -> Tracer m (TraceEventMempool blk)
-  -> (GenTx blk -> TxSizeInBytes)
   -> m (Mempool m blk)
-openMempool registry ledger cfg capacityOverride tracer txSize = do
-    env <- initMempoolEnv ledger cfg capacityOverride tracer txSize
+openMempool registry ledger cfg capacityOverride tracer = do
+    env <- initMempoolEnv ledger cfg capacityOverride tracer
     forkSyncStateOnTipPointChange registry env
     return $ mkMempool env
 
@@ -91,10 +90,9 @@ openMempoolWithoutSyncThread ::
   -> LedgerConfig blk
   -> MempoolCapacityBytesOverride
   -> Tracer m (TraceEventMempool blk)
-  -> (GenTx blk -> TxSizeInBytes)
   -> m (Mempool m blk)
-openMempoolWithoutSyncThread ledger cfg capacityOverride tracer txSize =
-    mkMempool <$> initMempoolEnv ledger cfg capacityOverride tracer txSize
+openMempoolWithoutSyncThread ledger cfg capacityOverride tracer =
+    mkMempool <$> initMempoolEnv ledger cfg capacityOverride tracer
 
 mkMempool ::
      ( IOLike m
@@ -104,19 +102,17 @@ mkMempool ::
      )
   => MempoolEnv m blk -> Mempool m blk
 mkMempool mpEnv = Mempool
-    { addTx          = implAddTx istate remoteFifo allFifo cfg txSize trcr
+    { addTx          = implAddTx istate remoteFifo allFifo cfg trcr
     , removeTxs      = implRemoveTxs mpEnv
     , syncWithLedger = implSyncWithLedger mpEnv
     , getSnapshot    = snapshotFromIS <$> readTVar istate
     , getSnapshotFor = \fls -> pureGetSnapshotFor cfg fls co <$> readTVar istate
     , getCapacity    = isCapacity <$> readTVar istate
-    , getTxSize      = txSize
     }
    where MempoolEnv { mpEnvStateVar = istate
                     , mpEnvAddTxsRemoteFifo = remoteFifo
                     , mpEnvAddTxsAllFifo = allFifo
                     , mpEnvLedgerCfg = cfg
-                    , mpEnvTxSize = txSize
                     , mpEnvTracer = trcr
                     , mpEnvCapacityOverride = co
                     } = mpEnv

ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Mempool/TxSeq.hs

@@ -231,9 +231,13 @@ toList (TxSeq ftree) = Foldable.toList ftree
 
 -- | Convert a 'TxSeq' to a list of pairs of transactions and their
 -- associated 'TicketNo's.
-toTuples :: TxSeq tx -> [(tx, TicketNo)]
+toTuples :: TxSeq tx -> [(tx, TicketNo, TxSizeInBytes)]
 toTuples (TxSeq ftree) = fmap
-    (\ticket -> (txTicketTx ticket, txTicketNo ticket))
+    (\ticket ->
+       ( txTicketTx ticket
+       , txTicketNo ticket
+       , txTicketTxSizeInBytes ticket)
+    )
     (Foldable.toList ftree)
 
 -- | \( O(1) \). Return the 'MempoolSize' of the given 'TxSeq'.

ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Mempool/Update.hs

@@ -44,16 +44,13 @@ implAddTx ::
       -- ^ The FIFO for all remote peers and local clients
   -> LedgerConfig blk
      -- ^ The configuration of the ledger.
-  -> (GenTx blk -> TxSizeInBytes)
-     -- ^ The function to calculate the size of a
-     -- transaction.
   -> Tracer m (TraceEventMempool blk)
   -> AddTxOnBehalfOf
      -- ^ Whether we're acting on behalf of a remote peer or a local client.
   -> GenTx blk
      -- ^ The transaction to add to the mempool.
   -> m (MempoolAddTxResult blk)
-implAddTx istate remoteFifo allFifo cfg txSize trcr onbehalf tx =
+implAddTx istate remoteFifo allFifo cfg trcr onbehalf tx =
     -- To ensure fair behaviour between threads that are trying to add
     -- transactions, we make them all queue in a fifo. Only the one at the head
     -- of the queue gets to actually wait for space to get freed up in the
@@ -87,7 +84,7 @@ implAddTx istate remoteFifo allFifo cfg txSize trcr onbehalf tx =
   where
     implAddTx' = do
       (result, ev) <- atomically $ do
-        outcome <- implTryAddTx istate cfg txSize
+        outcome <- implTryAddTx istate cfg
                                 (whetherToIntervene onbehalf)
                                 tx
         case outcome of
@@ -144,16 +141,13 @@ implTryAddTx ::
      -- ^ The InternalState TVar.
   -> LedgerConfig blk
      -- ^ The configuration of the ledger.
-  -> (GenTx blk -> TxSizeInBytes)
-     -- ^ The function to calculate the size of a
-     -- transaction.
   -> WhetherToIntervene
   -> GenTx blk
      -- ^ The transaction to add to the mempool.
   -> STM m (TryAddTx blk)
-implTryAddTx istate cfg txSize wti tx = do
+implTryAddTx istate cfg wti tx = do
         is <- readTVar istate
-        let outcome = pureTryAddTx cfg txSize wti tx is
+        let outcome = pureTryAddTx cfg wti tx is
         case outcome of
           TryAddTx (Just is') _ _ -> writeTVar istate is'
           _                       -> return ()
@@ -172,15 +166,13 @@ pureTryAddTx ::
      )
   => LedgerCfg (LedgerState blk)
      -- ^ The ledger configuration.
-  -> (GenTx blk -> TxSizeInBytes)
-     -- ^ The function to claculate the size of a transaction.
   -> WhetherToIntervene
   -> GenTx blk
      -- ^ The transaction to add to the mempool.
   -> InternalState blk
      -- ^ The current internal state of the mempool.
   -> TryAddTx blk
-pureTryAddTx cfg txSize wti tx is
+pureTryAddTx cfg wti tx is
     -- We add the transaction if there is at least one byte free left in the
     -- mempool.
   | let curSize = msNumBytes $ isMempoolSize is
@@ -213,7 +205,7 @@ pureTryAddTx cfg txSize wti tx is
   | otherwise
   = NoSpaceLeft
     where
-      (eVtx, vr) = extendVRNew cfg txSize wti tx $ validationResultFromIS is
+      (eVtx, vr) = extendVRNew cfg wti tx $ validationResultFromIS is
       is'        = internalStateFromVR vr
 
 {-------------------------------------------------------------------------------

ouroboros-consensus/src/unstable-mempool-test-utils/Test/Consensus/Mempool/Mocked.hs

@@ -58,10 +58,9 @@ openMockedMempool ::
      )
   => Mempool.MempoolCapacityBytesOverride
   -> Tracer IO (Mempool.TraceEventMempool blk)
-  -> (Ledger.GenTx blk -> Mempool.TxSizeInBytes)
   -> InitialMempoolAndModelParams blk
   -> IO (MockedMempool IO blk)
-openMockedMempool capacityOverride tracer txSizeImpl initialParams = do
+openMockedMempool capacityOverride tracer initialParams = do
     currentLedgerStateTVar <- newTVarIO (immpInitialState initialParams)
     let ledgerItf = Mempool.LedgerInterface {
             Mempool.getCurrentLedgerState = readTVar currentLedgerStateTVar
@@ -71,7 +70,6 @@ openMockedMempool capacityOverride tracer txSizeImpl initialParams = do
                    (immpLedgerConfig initialParams)
                    capacityOverride
                    tracer
-                   txSizeImpl
     pure MockedMempool {
         getLedgerInterface = ledgerItf
       , getLedgerStateTVar = currentLedgerStateTVar