Consolidate TxLimits (#1175)

Closes #1177.

Beyond that Issue, this PR also changes the mempool's definition of
full. The mempool will accepte transactions until the tx chosen to next
enter the mempool would cause any component of the capacity vector (byte
size, exunit steps, exunit mems, ref script byte size) to exceed its
limit. The default capacity is chosen as twice the capacity of a block.
Such a capacity can admit more txs than could fit into two back-to-back
blocks, but no single component (eg ExUnits) of the mempool's contents'
size could exceed what could fit in two blocks.

The mempool capacity has two consequences.

- It implements _latency hiding_: txs can cover the network a little in
advance, so that two blocks on a chain whose slots are very close
together could still both be full (if there are enough submitted txs).
- It bounds the potential burst of CPU load necessary to fill an empty
mempool, which otherwise could be a DoS vector.

Also closes #1168 by superseding the "ad-hoc" mempool reference scripts
capacity limit.

This PR also moves the logic for choosing which prefix of the mempool to
put in the block out of the forging functions and into the NodeKernel
forging thread --- the mempool snapshot is the perfect place to do that,
since tx measurements (each using the correct ledger state) are already
determined.

ouroboros-consensus-cardano/changelog.d/20240711_064942_nick.frisby_consolidate_txlimits.md

@@ -0,0 +1,23 @@
+<!--
+A new scriv changelog fragment.
+
+Uncomment the section that is right (remove the HTML comment wrapper).
+-->
+
+### Patch
+
+- Updates for the `TxLimits` mempool consolidation.
+
+### Non-Breaking
+
+- Do not check transaction sizes in the forging functions; simply include all
+  given transactions.
+
+- Remove the hotfix Babbage mempool checks.
+
+<!--
+### Breaking
+
+- A bullet item for the Breaking category.
+
+-->

ouroboros-consensus-cardano/ouroboros-consensus-cardano.cabal

@@ -167,6 +167,7 @@ library
     strict-sop-core ^>=0.1,
     text,
     these ^>=1.2,
+    validation,
     vector-map,
 
   -- GHC 8.10.7 on aarch64-darwin cannot use text-2

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

@@ -48,7 +48,7 @@ forgeByronBlock ::
   -> BlockNo                          -- ^ Current block number
   -> SlotNo                           -- ^ Current slot number
   -> TickedLedgerState ByronBlock     -- ^ Current ledger
-  -> [Validated (GenTx ByronBlock)]   -- ^ Txs to consider adding in the block
+  -> [Validated (GenTx ByronBlock)]   -- ^ Txs to include
   -> PBftIsLeader PBftByronCrypto     -- ^ Leader proof ('IsLeader')
   -> ByronBlock
 forgeByronBlock cfg = forgeRegularBlock (configBlock cfg)
@@ -123,7 +123,7 @@ forgeRegularBlock ::
   -> BlockNo                           -- ^ Current block number
   -> SlotNo                            -- ^ Current slot number
   -> TickedLedgerState ByronBlock      -- ^ Current ledger
-  -> [Validated (GenTx ByronBlock)]    -- ^ Txs to consider adding in the block
+  -> [Validated (GenTx ByronBlock)]    -- ^ Txs to include
   -> PBftIsLeader PBftByronCrypto      -- ^ Leader proof ('IsLeader')
   -> ByronBlock
 forgeRegularBlock cfg bno sno st txs isLeader =
@@ -141,7 +141,7 @@ forgeRegularBlock cfg bno sno st txs isLeader =
         foldr
           extendBlockPayloads
           initBlockPayloads
-          (takeLargestPrefixThatFits st txs)
+          txs
 
     txPayload :: CC.UTxO.TxPayload
     txPayload = CC.UTxO.mkTxPayload (bpTxs blockPayloads)

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

@@ -48,13 +48,13 @@ import           Cardano.Ledger.Binary (ByteSpan, DecoderError (..),
                      byronProtVer, fromByronCBOR, serialize, slice, toByronCBOR,
                      unsafeDeserialize)
 import           Cardano.Ledger.Binary.Plain (enforceSize)
-import           Cardano.Prelude (cborError)
+import           Cardano.Prelude (Natural, cborError)
 import           Codec.CBOR.Decoding (Decoder)
 import qualified Codec.CBOR.Decoding as CBOR
 import           Codec.CBOR.Encoding (Encoding)
 import qualified Codec.CBOR.Encoding as CBOR
 import           Control.Monad (void)
-import           Control.Monad.Except (Except)
+import           Control.Monad.Except (Except, throwError)
 import           Data.ByteString (ByteString)
 import qualified Data.ByteString as Strict
 import qualified Data.ByteString.Lazy as Lazy
@@ -71,19 +71,9 @@ import           Ouroboros.Consensus.Byron.Ledger.Serialisation
                      (byronBlockEncodingOverhead)
 import           Ouroboros.Consensus.Ledger.Abstract
 import           Ouroboros.Consensus.Ledger.SupportsMempool
-import           Ouroboros.Consensus.Mempool
 import           Ouroboros.Consensus.Util (ShowProxy (..))
 import           Ouroboros.Consensus.Util.Condense
 
-{-------------------------------------------------------------------------------
-  TxLimits
--------------------------------------------------------------------------------}
-
-instance TxLimits ByronBlock where
-  type TxMeasure ByronBlock = ByteSize
-  txMeasure _st    = ByteSize . txInBlockSize . txForgetValidated
-  txsBlockCapacity = ByteSize . txsMaxBytes
-
 {-------------------------------------------------------------------------------
   Transactions
 -------------------------------------------------------------------------------}
@@ -132,18 +122,39 @@ instance LedgerSupportsMempool ByronBlock where
     where
       validationMode = CC.ValidationMode CC.NoBlockValidation Utxo.TxValidationNoCrypto
 
-  txsMaxBytes st =
-    CC.getMaxBlockSize (tickedByronLedgerState st) - byronBlockEncodingOverhead
+  txForgetValidated = forgetValidatedByronTx
 
-  txInBlockSize =
-      fromIntegral
-    . Strict.length
-    . CC.mempoolPayloadRecoverBytes
-    . toMempoolPayload
+instance TxLimits ByronBlock where
+  type TxMeasure ByronBlock = IgnoringOverflow ByteSize32
 
-  txForgetValidated = forgetValidatedByronTx
+  blockCapacityTxMeasure _cfg st =
+      IgnoringOverflow
+    $ ByteSize32
+    $ CC.getMaxBlockSize cvs - byronBlockEncodingOverhead
+    where
+      cvs = tickedByronLedgerState st
 
-  txRefScriptSize _ _ _ = 0
+  txMeasure _cfg st tx =
+      if txszNat > maxTxSize then throwError err else
+      pure $ IgnoringOverflow $ ByteSize32 $ fromIntegral txsz
+    where
+      maxTxSize =
+          Update.ppMaxTxSize
+        $ CC.adoptedProtocolParameters
+        $ CC.cvsUpdateState
+        $ tickedByronLedgerState st
+
+      txszNat = fromIntegral txsz :: Natural
+
+      txsz =
+          Strict.length
+        $ CC.mempoolPayloadRecoverBytes
+        $ toMempoolPayload tx
+
+      err =
+          CC.MempoolTxErr
+        $ Utxo.UTxOValidationTxValidationError
+        $ Utxo.TxValidationTxTooLarge txszNat maxTxSize
 
 data instance TxId (GenTx ByronBlock)
   = ByronTxId             !Utxo.TxId

ouroboros-consensus-cardano/src/ouroboros-consensus-cardano/Ouroboros/Consensus/Cardano/CanHardFork.hs

@@ -2,8 +2,10 @@
 {-# LANGUAGE DataKinds             #-}
 {-# LANGUAGE DeriveAnyClass        #-}
 {-# LANGUAGE DeriveGeneric         #-}
+{-# LANGUAGE EmptyCase             #-}
 {-# LANGUAGE FlexibleContexts      #-}
 {-# LANGUAGE FlexibleInstances     #-}
+{-# LANGUAGE LambdaCase            #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE NamedFieldPuns        #-}
 {-# LANGUAGE OverloadedStrings     #-}
@@ -57,7 +59,7 @@ import           Data.Maybe (listToMaybe, mapMaybe)
 import           Data.Proxy
 import           Data.SOP.BasicFunctors
 import           Data.SOP.InPairs (RequiringBoth (..), ignoringBoth)
-import           Data.SOP.Strict (hpure)
+import qualified Data.SOP.Strict as SOP
 import           Data.SOP.Tails (Tails (..))
 import qualified Data.SOP.Tails as Tails
 import           Data.Void
@@ -78,6 +80,8 @@ import           Ouroboros.Consensus.HardFork.History (Bound (boundSlot),
                      addSlots)
 import           Ouroboros.Consensus.HardFork.Simple
 import           Ouroboros.Consensus.Ledger.Abstract
+import           Ouroboros.Consensus.Ledger.SupportsMempool (ByteSize32,
+                     IgnoringOverflow, TxMeasure)
 import           Ouroboros.Consensus.Ledger.SupportsProtocol
                      (LedgerSupportsProtocol)
 import           Ouroboros.Consensus.Protocol.Abstract
@@ -283,6 +287,8 @@ type CardanoHardForkConstraints c =
   )
 
 instance CardanoHardForkConstraints c => CanHardFork (CardanoEras c) where
+  type HardForkTxMeasure (CardanoEras c) = ConwayMeasure
+
   hardForkEraTranslation = EraTranslation {
       translateLedgerState   =
           PCons translateLedgerStateByronToShelleyWrapper
@@ -311,7 +317,7 @@ instance CardanoHardForkConstraints c => CanHardFork (CardanoEras c) where
     }
   hardForkChainSel =
         -- Byron <-> Shelley, ...
-        TCons (hpure CompareBlockNo)
+        TCons (SOP.hpure CompareBlockNo)
         -- Inter-Shelley-based
       $ Tails.hcpure (Proxy @(HasPraosSelectView c)) CompareSameSelectView
   hardForkInjectTxs =
@@ -349,6 +355,34 @@ instance CardanoHardForkConstraints c => CanHardFork (CardanoEras c) where
               )
       $ PNil
 
+  hardForkInjTxMeasure =
+    fromByteSize `o`
+    fromByteSize `o`
+    fromByteSize `o`
+    fromByteSize `o`
+    fromAlonzo   `o`
+    fromConway   `o`
+    fromConway   `o`
+    nil
+    where
+      nil :: SOP.NS f '[] -> a
+      nil = \case {}
+
+      infixr `o`
+      o ::
+           (TxMeasure x -> a)
+        -> (SOP.NS WrapTxMeasure xs -> a)
+        -> SOP.NS WrapTxMeasure (x : xs)
+        -> a
+      o f g = \case
+        SOP.Z (WrapTxMeasure x) -> f x
+        SOP.S y                 -> g y
+
+      fromByteSize :: IgnoringOverflow ByteSize32 -> ConwayMeasure
+      fromByteSize x = fromAlonzo $ AlonzoMeasure x mempty
+      fromAlonzo   x = fromConway $ ConwayMeasure x mempty
+      fromConway   x = x
+
 class    (SelectView (BlockProtocol blk) ~ PraosChainSelectView c) => HasPraosSelectView c blk
 instance (SelectView (BlockProtocol blk) ~ PraosChainSelectView c) => HasPraosSelectView c blk