Expose over-the-wire encoded transaction size (#1211)

# Description This change introduces a new method wireSizeTx for the LedgerSupportsMempool class. It provides actual CBOR encoded transaction size as it is when transmitted over the network, which the difffusion layer could exploit. Also note that: - New code should be properly tested (even if it does not add new features). - The fix for a regression should include a test that reproduces said regression. IntersectMBO/cardano-ledger#4521 IntersectMBO/ouroboros-network#4926
IntersectMBO · Sep 24, 2024 · b1088be · b1088be
2 parents 35adef5 + d4b27d8
commit b1088be
Show file tree

Hide file tree

Showing 17 changed files with 118 additions and 8 deletions.
diff --git a/cabal.project b/cabal.project
@@ -59,8 +59,8 @@ if impl(ghc >= 9.10)
 source-repository-package
   type: git
   location: https://github.com/IntersectMBO/ouroboros-network
-  tag: d900a38c55e02f5eed8c8d6d6a4671cd8c5acc6a
-  --sha256: sha256-VVccbWFmd9GlL2N/xNsKtXg2U2asGc4fIX1lLEo+Ar8=
+  tag: 388cc6906b83f41ac2da192b1fd89ab986b4af74
+  --sha256: sha256-LUwryrP5jK+/c4lDitJf/oKg/DqLgbIc68bn83FsHI0=
   subdir:
     cardano-client
     cardano-ping

diff --git a/...-consensus-cardano/changelog.d/20240808_125131_marcin.wojtowicz_tx_wire_size.md b/...-consensus-cardano/changelog.d/20240808_125131_marcin.wojtowicz_tx_wire_size.md
@@ -0,0 +1,21 @@
+<!--
+A new scriv changelog fragment.
+
+Uncomment the section that is right (remove the HTML comment wrapper).
+-->
+
+<!--
+### Patch
+
+- A bullet item for the Patch category.
+
+-->
+<!--
+### Non-Breaking
+
+- A bullet item for the Non-Breaking category.
+
+-->
+### Breaking
+
+- Implement txWireSize of TxLimits instantiations for Byron and Shelley
diff --git a/ouroboros-consensus-cardano/src/byron/Ouroboros/Consensus/Byron/Ledger/Mempool.hs b/ouroboros-consensus-cardano/src/byron/Ouroboros/Consensus/Byron/Ledger/Mempool.hs
@@ -73,6 +73,7 @@ import           Ouroboros.Consensus.Ledger.Abstract
 import           Ouroboros.Consensus.Ledger.SupportsMempool
 import           Ouroboros.Consensus.Util (ShowProxy (..))
 import           Ouroboros.Consensus.Util.Condense
+import           Ouroboros.Network.SizeInBytes as Network
 
 {-------------------------------------------------------------------------------
   Transactions
@@ -127,6 +128,11 @@ instance LedgerSupportsMempool ByronBlock where
 instance TxLimits ByronBlock where
   type TxMeasure ByronBlock = IgnoringOverflow ByteSize32
 
+  txWireSize =   fromIntegral
+               . Strict.length
+               . CC.mempoolPayloadRecoverBytes
+               . toMempoolPayload
+
   blockCapacityTxMeasure _cfg st =
       IgnoringOverflow
     $ ByteSize32

diff --git a/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Ledger/Mempool.hs b/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Ledger/Mempool.hs
@@ -39,7 +39,7 @@ module Ouroboros.Consensus.Shelley.Ledger.Mempool (
 import qualified Cardano.Crypto.Hash as Hash
 import qualified Cardano.Ledger.Allegra.Rules as AllegraEra
 import           Cardano.Ledger.Alonzo.Core (Tx, TxSeq, bodyTxL, eraProtVerLow,
-                     fromTxSeq, ppMaxBBSizeL, ppMaxBlockExUnitsL, sizeTxF)
+                     fromTxSeq, ppMaxBBSizeL, ppMaxBlockExUnitsL, sizeTxF, wireSizeTxF)
 import qualified Cardano.Ledger.Alonzo.Rules as AlonzoEra
 import           Cardano.Ledger.Alonzo.Scripts (ExUnits, ExUnits',
                      pointWiseExUnits, unWrapExUnits)
@@ -146,6 +146,8 @@ instance (ShelleyCompatible proto era, TxLimits (ShelleyBlock proto era))
 
   reapplyTx = reapplyShelleyTx
 
+  wireTxSize (ShelleyTx _ tx) = fromIntegral $ tx ^. wireSizeTxF
+
   txForgetValidated (ShelleyValidatedTx txid vtx) = ShelleyTx txid (SL.extractTx vtx)
 
 mkShelleyTx :: forall era proto. ShelleyBasedEra era => Tx era -> GenTx (ShelleyBlock proto era)
@@ -385,16 +387,19 @@ instance MaxTxSizeUTxO (ConwayEra c) where
 
 instance ShelleyCompatible p (ShelleyEra c) => TxLimits (ShelleyBlock p (ShelleyEra c)) where
   type TxMeasure (ShelleyBlock p (ShelleyEra c)) = IgnoringOverflow ByteSize32
+  txWireSize (ShelleyTx _ tx) = fromIntegral (tx ^. wireSizeTxF)
   txMeasure              _cfg st tx = runValidation $ txInBlockSize st tx
   blockCapacityTxMeasure _cfg       = txsMaxBytes
 
 instance ShelleyCompatible p (AllegraEra c) => TxLimits (ShelleyBlock p (AllegraEra c)) where
   type TxMeasure (ShelleyBlock p (AllegraEra c)) = IgnoringOverflow ByteSize32
+  txWireSize (ShelleyTx _ tx) = fromIntegral (tx ^. wireSizeTxF)
   txMeasure              _cfg st tx = runValidation $ txInBlockSize st tx
   blockCapacityTxMeasure _cfg       = txsMaxBytes
 
 instance ShelleyCompatible p (MaryEra c) => TxLimits (ShelleyBlock p (MaryEra c)) where
   type TxMeasure (ShelleyBlock p (MaryEra c)) = IgnoringOverflow ByteSize32
+  txWireSize (ShelleyTx _ tx) = fromIntegral (tx ^. wireSizeTxF)
   txMeasure              _cfg st tx = runValidation $ txInBlockSize st tx
   blockCapacityTxMeasure _cfg       = txsMaxBytes
 
@@ -485,6 +490,7 @@ instance ( ShelleyCompatible p (AlonzoEra c)
          ) => TxLimits (ShelleyBlock p (AlonzoEra c)) where
 
   type TxMeasure (ShelleyBlock p (AlonzoEra c)) = AlonzoMeasure
+  txWireSize (ShelleyTx _ tx) = fromIntegral (tx ^. wireSizeTxF)
   txMeasure              _cfg st tx = runValidation $ txMeasureAlonzo st tx
   blockCapacityTxMeasure _cfg       = blockCapacityAlonzoMeasure
 
@@ -582,12 +588,14 @@ instance ( ShelleyCompatible p (BabbageEra c)
          ) => TxLimits (ShelleyBlock p (BabbageEra c)) where
 
   type TxMeasure (ShelleyBlock p (BabbageEra c)) = ConwayMeasure
+  txWireSize (ShelleyTx _ tx) = fromIntegral (tx ^. wireSizeTxF)
   txMeasure              _cfg st tx = runValidation $ txMeasureBabbage st tx
   blockCapacityTxMeasure _cfg       = blockCapacityConwayMeasure
 
 instance ( ShelleyCompatible p (ConwayEra c)
          ) => TxLimits (ShelleyBlock p (ConwayEra c)) where
 
   type TxMeasure (ShelleyBlock p (ConwayEra c)) = ConwayMeasure
+  txWireSize (ShelleyTx _ tx) = fromIntegral (tx ^. wireSizeTxF)
   txMeasure              _cfg st tx = runValidation $ txMeasureConway st tx
   blockCapacityTxMeasure _cfg       = blockCapacityConwayMeasure
diff --git a/...-consensus-cardano/src/unstable-byronspec/Ouroboros/Consensus/ByronSpec/Ledger/Mempool.hs b/...-consensus-cardano/src/unstable-byronspec/Ouroboros/Consensus/ByronSpec/Ledger/Mempool.hs
@@ -57,6 +57,7 @@ instance TxLimits ByronSpecBlock where
   type TxMeasure ByronSpecBlock = IgnoringOverflow ByteSize32
 
   -- Dummy values, as these are not used in practice.
+  txWireSize = const . fromIntegral $ (0 :: Int)
   blockCapacityTxMeasure _cfg _st = IgnoringOverflow $ ByteSize32 1
 
   txMeasure _cfg _st _tx = pure $ IgnoringOverflow $ ByteSize32 0
diff --git a/...onsensus-diffusion/changelog.d/20240808_125632_marcin.wojtowicz_tx_wire_size.md b/...onsensus-diffusion/changelog.d/20240808_125632_marcin.wojtowicz_tx_wire_size.md
@@ -0,0 +1,23 @@
+<!--
+A new scriv changelog fragment.
+
+Uncomment the section that is right (remove the HTML comment wrapper).
+-->
+
+<!--
+### Patch
+
+- A bullet item for the Patch category.
+
+-->
+
+### Non-Breaking
+
+- Provide txWireSize to tx-submission protocol
+
+<!--
+### Breaking
+
+- A bullet item for the Breaking category.
+
+-->
diff --git a/...sus-diffusion/src/ouroboros-consensus-diffusion/Ouroboros/Consensus/Network/NodeToNode.hs b/...sus-diffusion/src/ouroboros-consensus-diffusion/Ouroboros/Consensus/Network/NodeToNode.hs
@@ -748,6 +748,7 @@ mkApps kernel Tracers {..} mkCodecs ByteLimits {..} genChainSyncTimeout lopBucke
                    (getSharedTxStateVar kernel)
                    (mapTxSubmissionMempoolReader txForgetValidated
                    $ getMempoolReader (getMempool kernel))
+                   wireTxSize
                    them $ \api ->
                      runServer (newTxSubmissionServer api)
 

diff --git a/...s-consensus-diffusion/src/ouroboros-consensus-diffusion/Ouroboros/Consensus/NodeKernel.hs b/...s-consensus-diffusion/src/ouroboros-consensus-diffusion/Ouroboros/Consensus/NodeKernel.hs
@@ -27,7 +27,6 @@ module Ouroboros.Consensus.NodeKernel (
   ) where
 
 
-import qualified Control.Concurrent.Class.MonadMVar.Strict as StrictSTM
 import qualified Control.Concurrent.Class.MonadSTM as LazySTM
 import qualified Control.Concurrent.Class.MonadSTM.Strict as StrictSTM
 import           Control.DeepSeq (force)
@@ -43,7 +42,6 @@ import           Data.Functor ((<&>))
 import           Data.Hashable (Hashable)
 import           Data.List.NonEmpty (NonEmpty)
 import           Data.Map.Strict (Map)
-import qualified Data.Map.Strict as Map
 import           Data.Maybe (isJust, mapMaybe)
 import           Data.Proxy
 import qualified Data.Text as Text
@@ -114,8 +112,8 @@ import           Ouroboros.Network.TxSubmission.Inbound
                      (TxSubmissionMempoolWriter)
 import qualified Ouroboros.Network.TxSubmission.Inbound as Inbound
 import           Ouroboros.Network.TxSubmission.Inbound.Registry
-                     (SharedTxStateVar, TxChannels (..), TxChannelsVar,
-                     decisionLogicThread, newSharedTxStateVar)
+                     (SharedTxStateVar, TxChannelsVar,
+                     decisionLogicThread, newSharedTxStateVar, newTxChannelsVar)
 import           Ouroboros.Network.TxSubmission.Mempool.Reader
                      (TxSubmissionMempoolReader)
 import qualified Ouroboros.Network.TxSubmission.Mempool.Reader as MempoolReader
@@ -294,7 +292,7 @@ initNodeKernel args@NodeKernelArgs { registry, cfg, tracers
                                         ps_POLICY_PEER_SHARE_STICKY_TIME
                                         ps_POLICY_PEER_SHARE_MAX_PEERS
 
-    txChannelsVar <- StrictSTM.newMVar (TxChannels Map.empty)
+    txChannelsVar <- newTxChannelsVar
     sharedTxStateVar <- newSharedTxStateVar
 
     case gnkaGetLoEFragment genesisArgs of

diff --git a/ouroboros-consensus-diffusion/test/consensus-test/Test/Consensus/HardFork/Combinator/A.hs b/ouroboros-consensus-diffusion/test/consensus-test/Test/Consensus/HardFork/Combinator/A.hs
@@ -330,6 +330,7 @@ instance LedgerSupportsMempool BlockA where
 
 instance TxLimits BlockA where
   type TxMeasure BlockA = IgnoringOverflow ByteSize32
+  txWireSize = const . fromIntegral $ (0 :: Int)
   blockCapacityTxMeasure _cfg _st     = IgnoringOverflow $ ByteSize32 $ 100 * 1024   -- arbitrary
   txMeasure              _cfg _st _tx = pure $ IgnoringOverflow $ ByteSize32 0
 

diff --git a/ouroboros-consensus-diffusion/test/consensus-test/Test/Consensus/HardFork/Combinator/B.hs b/ouroboros-consensus-diffusion/test/consensus-test/Test/Consensus/HardFork/Combinator/B.hs
@@ -266,6 +266,7 @@ instance LedgerSupportsMempool BlockB where
 
 instance TxLimits BlockB where
   type TxMeasure BlockB = IgnoringOverflow ByteSize32
+  txWireSize = const . fromIntegral $ (0 :: Int)
   blockCapacityTxMeasure _cfg _st     = IgnoringOverflow $ ByteSize32 $ 100 * 1024   -- arbitrary
   txMeasure              _cfg _st _tx = pure $ IgnoringOverflow $ ByteSize32 0
 

diff --git a/ouroboros-consensus/bench/mempool-bench/Bench/Consensus/Mempool/TestBlock.hs b/ouroboros-consensus/bench/mempool-bench/Bench/Consensus/Mempool/TestBlock.hs
@@ -151,6 +151,7 @@ instance Ledger.LedgerSupportsMempool TestBlock where
 instance Ledger.TxLimits TestBlock where
   type TxMeasure TestBlock = Ledger.IgnoringOverflow Ledger.ByteSize32
 
+  txWireSize = fromIntegral . Ledger.unByteSize32 . txSize
   -- We tweaked this in such a way that we test the case in which we exceed the
   -- maximum mempool capacity. The value used here depends on 'txInBlockSize'.
   blockCapacityTxMeasure _cfg _st =

diff --git a/ouroboros-consensus/changelog.d/20240808_101916_marcin.wojtowicz_tx_wire_size.md b/ouroboros-consensus/changelog.d/20240808_101916_marcin.wojtowicz_tx_wire_size.md
@@ -0,0 +1,23 @@
+<!--
+A new scriv changelog fragment.
+
+Uncomment the section that is right (remove the HTML comment wrapper).
+-->
+
+<!--
+### Patch
+
+- A bullet item for the Patch category.
+
+-->
+<!--
+### Non-Breaking
+
+- A bullet item for the Non-Breaking category.
+
+-->
+### Breaking
+
+- Added txWireSize method to TxLimits class to provide
+  a CBOR-encoded transaction size as it is when transmitted
+  over the network.
diff --git a/...oros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/HardFork/Combinator/Mempool.hs b/...oros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/HardFork/Combinator/Mempool.hs
@@ -109,6 +109,12 @@ instance CanHardFork xs => LedgerSupportsMempool (HardForkBlock xs) where
           (WrapValidatedGenTx vtx)
           tls
 
+  wireTxSize =
+        hcollapse
+      . hcmap proxySingle (K . wireTxSize)
+      . getOneEraGenTx
+      . getHardForkGenTx
+
   txForgetValidated =
         HardForkGenTx
       . OneEraGenTx
@@ -119,6 +125,12 @@ instance CanHardFork xs => LedgerSupportsMempool (HardForkBlock xs) where
 instance CanHardFork xs => TxLimits (HardForkBlock xs) where
   type TxMeasure (HardForkBlock xs) = HardForkTxMeasure xs
 
+  txWireSize =
+        hcollapse
+      . hcmap proxySingle (K . txWireSize)
+      . getOneEraGenTx
+      . getHardForkGenTx
+
   blockCapacityTxMeasure
     HardForkLedgerConfig{..}
     (TickedHardForkLedgerState transition hardForkState)

diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Ledger/Dual.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Ledger/Dual.hs
@@ -609,6 +609,8 @@ instance Bridge m a => LedgerSupportsMempool (DualBlock m a) where
                                            tickedDualLedgerStateBridge
         }
 
+  wireTxSize    = wireTxSize . dualGenTxMain
+
   txForgetValidated vtx =
       DualGenTx {
           dualGenTxMain   = txForgetValidated vDualGenTxMain
@@ -625,6 +627,7 @@ instance Bridge m a => LedgerSupportsMempool (DualBlock m a) where
 instance Bridge m a => TxLimits (DualBlock m a) where
   type TxMeasure (DualBlock m a) = TxMeasure m
 
+  txWireSize = txWireSize . dualGenTxMain
   txMeasure DualLedgerConfig{..} TickedDualLedgerState{..} DualGenTx{..} = do
       mapExcept (inj +++ id)
     $ txMeasure dualLedgerConfigMain tickedDualLedgerStateMain dualGenTxMain

diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Ledger/SupportsMempool.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Ledger/SupportsMempool.hs
@@ -37,6 +37,7 @@ import           NoThunks.Class
 import           Ouroboros.Consensus.Block.Abstract
 import           Ouroboros.Consensus.Ledger.Abstract
 import           Ouroboros.Consensus.Ticked
+import           Ouroboros.Network.SizeInBytes as Network
 
 -- | Generalized transaction
 --
@@ -111,6 +112,10 @@ class ( UpdateLedger blk
             -> TickedLedgerState blk
             -> Except (ApplyTxErr blk) (TickedLedgerState blk)
 
+  -- | Return the size of a serialised transaction as it is transmitted
+  -- across the network.
+  wireTxSize :: GenTx blk -> Network.SizeInBytes
+
   -- | Discard the evidence that transaction has been previously validated
   txForgetValidated :: Validated (GenTx blk) -> GenTx blk
 
@@ -179,6 +184,10 @@ class ( Measure     (TxMeasure blk)
   -- | The (possibly multi-dimensional) size of a transaction in a block.
   type TxMeasure blk
 
+  -- | The size of the transaction from the perspective of diffusion layer
+  --
+  txWireSize :: GenTx blk -> Network.SizeInBytes
+
   -- | The various sizes (bytes, Plutus script ExUnits, etc) of a tx /when it's
   -- in a block/
   --

diff --git a/ouroboros-consensus/src/unstable-mock-block/Ouroboros/Consensus/Mock/Ledger/Block.hs b/ouroboros-consensus/src/unstable-mock-block/Ouroboros/Consensus/Mock/Ledger/Block.hs
@@ -438,6 +438,7 @@ instance MockProtocolSpecific c ext
 instance TxLimits (SimpleBlock c ext) where
   type TxMeasure (SimpleBlock c ext) = IgnoringOverflow ByteSize32
 
+  txWireSize = fromIntegral . unByteSize32 . txSize
   -- Large value so that the Mempool tests never run out of capacity when they
   -- don't override it.
   --

diff --git a/ouroboros-consensus/test/consensus-test/Test/Consensus/Mempool/Fairness/TestBlock.hs b/ouroboros-consensus/test/consensus-test/Test/Consensus/Mempool/Fairness/TestBlock.hs
@@ -91,6 +91,7 @@ instance Ledger.LedgerSupportsMempool TestBlock where
 instance Ledger.TxLimits TestBlock where
   type TxMeasure TestBlock = Ledger.IgnoringOverflow Ledger.ByteSize32
 
+  txWireSize = fromIntegral . Ledger.unByteSize32 . txSize . unGenTx
   blockCapacityTxMeasure _cfg _st =
     -- The tests will override this value. By using 1, @computeMempoolCapacity@
     -- can be exactly what each test requests.