Consolidate TxLimits

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