Conway: add ref scripts size to TxMeasure (#1172)

Making sure that we never forge blocks that violate the new max ref
scripts size limit per block that is enforced at the ledger level
starting in Conway:
IntersectMBO/cardano-ledger#4450

Also see #1168 for restoring a similar limit for the size of the total
mempool in Conway.

Author: amesgen

ouroboros-consensus-cardano/changelog.d/20240701_131358_alexander.esgen_conway_txmeasure.md

@@ -0,0 +1,3 @@
+### Breaking
+
+- Added `TickedLedgerState` argument to `txMeasure`.

ouroboros-consensus-cardano/changelog.d/20240701_132131_alexander.esgen_conway_txmeasure.md

@@ -0,0 +1,4 @@
+### Breaking
+
+- Introduced `ConwayMeasure`, a Conway-specific `TxMeasure` adding the total
+  reference scripts size as a new dimension on top of `AlonzoMeasure`.

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

@@ -81,7 +81,7 @@ import           Ouroboros.Consensus.Util.Condense
 
 instance TxLimits ByronBlock where
   type TxMeasure ByronBlock = ByteSize
-  txMeasure        = ByteSize . txInBlockSize . txForgetValidated
+  txMeasure _st    = ByteSize . txInBlockSize . txForgetValidated
   txsBlockCapacity = ByteSize . txsMaxBytes
 
 {-------------------------------------------------------------------------------

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

@@ -30,6 +30,7 @@ module Ouroboros.Consensus.Shelley.Ledger.Mempool (
   , perTxOverhead
     -- * Exported for tests
   , AlonzoMeasure (..)
+  , ConwayMeasure (..)
   , fromExUnits
   ) where
 
@@ -39,6 +40,7 @@ import           Cardano.Ledger.Alonzo.Core (Tx, TxSeq, bodyTxL, eraProtVerLow,
 import           Cardano.Ledger.Alonzo.Scripts (ExUnits, ExUnits',
                      unWrapExUnits)
 import           Cardano.Ledger.Alonzo.Tx (totExUnits)
+import qualified Cardano.Ledger.Api as L
 import           Cardano.Ledger.Binary (Annotator (..), DecCBOR (..),
                      EncCBOR (..), FromCBOR (..), FullByteString (..),
                      ToCBOR (..), toPlainDecoder)
@@ -295,37 +297,27 @@ theLedgerLens f x =
 
 instance ShelleyCompatible p (ShelleyEra c) => Mempool.TxLimits (ShelleyBlock p (ShelleyEra c)) where
   type TxMeasure (ShelleyBlock p (ShelleyEra c)) = Mempool.ByteSize
-  txMeasure        = Mempool.ByteSize . txInBlockSize . txForgetValidated
+  txMeasure _st    = Mempool.ByteSize . txInBlockSize . txForgetValidated
   txsBlockCapacity = Mempool.ByteSize . txsMaxBytes
 
 instance ShelleyCompatible p (AllegraEra c) => Mempool.TxLimits (ShelleyBlock p (AllegraEra c)) where
   type TxMeasure (ShelleyBlock p (AllegraEra c)) = Mempool.ByteSize
-  txMeasure        = Mempool.ByteSize . txInBlockSize . txForgetValidated
+  txMeasure _st    = Mempool.ByteSize . txInBlockSize . txForgetValidated
   txsBlockCapacity = Mempool.ByteSize . txsMaxBytes
 
 instance ShelleyCompatible p (MaryEra c) => Mempool.TxLimits (ShelleyBlock p (MaryEra c)) where
   type TxMeasure (ShelleyBlock p (MaryEra c)) = Mempool.ByteSize
-  txMeasure        = Mempool.ByteSize . txInBlockSize . txForgetValidated
+  txMeasure _st    = Mempool.ByteSize . txInBlockSize . txForgetValidated
   txsBlockCapacity = Mempool.ByteSize . txsMaxBytes
 
 instance ( ShelleyCompatible p (AlonzoEra c)
          ) => Mempool.TxLimits (ShelleyBlock p (AlonzoEra c)) where
 
   type TxMeasure (ShelleyBlock p (AlonzoEra c)) = AlonzoMeasure
 
-  txMeasure (ShelleyValidatedTx _txid vtx) =
-    AlonzoMeasure {
-        byteSize = Mempool.ByteSize $ txInBlockSize (mkShelleyTx @(AlonzoEra c) @p (SL.extractTx vtx))
-      , exUnits  = fromExUnits $ totExUnits (SL.extractTx vtx)
-      }
+  txMeasure _st = txMeasureAlonzo
 
-  txsBlockCapacity ledgerState =
-      AlonzoMeasure {
-          byteSize = Mempool.ByteSize $ txsMaxBytes ledgerState
-        , exUnits  = fromExUnits $ pparams ^. ppMaxBlockExUnitsL
-        }
-    where
-      pparams = getPParams $ tickedShelleyLedgerState ledgerState
+  txsBlockCapacity = txsBlockCapacityAlonzo
 
 data AlonzoMeasure = AlonzoMeasure {
     byteSize :: !Mempool.ByteSize
@@ -337,43 +329,69 @@ data AlonzoMeasure = AlonzoMeasure {
 fromExUnits :: ExUnits -> ExUnits' (WithTop Natural)
 fromExUnits = fmap NotTop . unWrapExUnits
 
+txMeasureAlonzo ::
+     forall proto era.
+     (ShelleyCompatible proto era, L.AlonzoEraTxWits era)
+  => Validated (GenTx (ShelleyBlock proto era)) -> AlonzoMeasure
+txMeasureAlonzo (ShelleyValidatedTx _txid vtx) =
+    AlonzoMeasure {
+        byteSize = Mempool.ByteSize $ txInBlockSize (mkShelleyTx @era @proto tx)
+      , exUnits  = fromExUnits $ totExUnits tx
+      }
+  where
+    tx = SL.extractTx vtx
+
+txsBlockCapacityAlonzo ::
+     forall proto era.
+     (ShelleyCompatible proto era, L.AlonzoEraPParams era)
+  => TickedLedgerState (ShelleyBlock proto era) -> AlonzoMeasure
+txsBlockCapacityAlonzo ledgerState =
+    AlonzoMeasure {
+        byteSize = Mempool.ByteSize $ txsMaxBytes ledgerState
+      , exUnits  = fromExUnits $ pparams ^. ppMaxBlockExUnitsL
+      }
+  where
+    pparams = getPParams $ tickedShelleyLedgerState ledgerState
+
 instance ( ShelleyCompatible p (BabbageEra c)
          ) => Mempool.TxLimits (ShelleyBlock p (BabbageEra c)) where
 
   type TxMeasure (ShelleyBlock p (BabbageEra c)) = AlonzoMeasure
 
-  txMeasure (ShelleyValidatedTx _txid vtx) =
-    AlonzoMeasure {
-        byteSize = Mempool.ByteSize $ txInBlockSize (mkShelleyTx @(BabbageEra c) @p (SL.extractTx vtx))
-      , exUnits  = fromExUnits $ totExUnits (SL.extractTx vtx)
-      }
+  txMeasure _st = txMeasureAlonzo
 
-  txsBlockCapacity ledgerState =
-      AlonzoMeasure {
-          byteSize = Mempool.ByteSize $ txsMaxBytes ledgerState
-        , exUnits  = fromExUnits $ pparams ^. ppMaxBlockExUnitsL
-        }
-    where
-      pparams = getPParams $ tickedShelleyLedgerState ledgerState
+  txsBlockCapacity = txsBlockCapacityAlonzo
+
+data ConwayMeasure = ConwayMeasure {
+    alonzoMeasure  :: !AlonzoMeasure
+  , refScriptsSize :: !Mempool.ByteSize
+  } deriving stock (Eq, Generic, Show)
+    deriving (BoundedMeasure, Measure)
+         via (InstantiatedAt Generic ConwayMeasure)
 
 instance ( ShelleyCompatible p (ConwayEra c)
          ) => Mempool.TxLimits (ShelleyBlock p (ConwayEra c)) where
 
-  type TxMeasure (ShelleyBlock p (ConwayEra c)) = AlonzoMeasure
+  type TxMeasure (ShelleyBlock p (ConwayEra c)) = ConwayMeasure
 
-  txMeasure (ShelleyValidatedTx _txid vtx) =
-    AlonzoMeasure {
-        byteSize = Mempool.ByteSize $ txInBlockSize (mkShelleyTx @(ConwayEra c) @p (SL.extractTx vtx))
-      , exUnits  = fromExUnits $ totExUnits (SL.extractTx vtx)
-      }
-
-  txsBlockCapacity ledgerState =
-      AlonzoMeasure {
-          byteSize = Mempool.ByteSize $ txsMaxBytes ledgerState
-        , exUnits  = fromExUnits $ pparams ^. ppMaxBlockExUnitsL
+  txMeasure st genTx@(ShelleyValidatedTx _txid vtx) =
+      ConwayMeasure {
+          alonzoMeasure  = txMeasureAlonzo genTx
+        , refScriptsSize = Mempool.ByteSize $ fromIntegral $
+            SL.txNonDistinctRefScriptsSize utxo (SL.extractTx vtx)
         }
     where
-      pparams = getPParams $ tickedShelleyLedgerState ledgerState
+      utxo = SL.getUTxO . tickedShelleyLedgerState $ st
+
+
+  txsBlockCapacity st =
+      ConwayMeasure {
+          alonzoMeasure  = txsBlockCapacityAlonzo st
+        , refScriptsSize =
+            -- TODO use maxRefScriptSizePerBlock from
+            -- https://github.com/IntersectMBO/cardano-ledger/pull/4450
+            Mempool.ByteSize $ 2560 * 1024 -- 2.5 MB
+        }
 
 {-------------------------------------------------------------------------------
   WithTop

ouroboros-consensus/changelog.d/20240701_133021_alexander.esgen_conway_txmeasure.md

@@ -0,0 +1,3 @@
+### Breaking
+
+- Added `TickedLedgerState` argument to `txMeasure`.

ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Block/Forging.hs

@@ -165,7 +165,7 @@ takeLargestPrefixThatFits ::
   -> [Validated (GenTx blk)]
   -> [Validated (GenTx blk)]
 takeLargestPrefixThatFits overrides ledger txs =
-    Measure.take MempoolCapacity.txMeasure capacity txs
+    Measure.take (MempoolCapacity.txMeasure ledger) capacity txs
   where
     capacity =
       MempoolCapacity.applyOverrides

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

@@ -120,7 +120,10 @@ class BoundedMeasure (TxMeasure blk) => TxLimits blk where
   type TxMeasure blk
 
   -- | What is the measure an individual tx?
-  txMeasure        :: Validated (GenTx blk)    -> TxMeasure blk
+  txMeasure ::
+       TickedLedgerState blk
+    -> Validated (GenTx blk)
+    -> TxMeasure blk
 
   -- | What is the allowed capacity for txs in an individual block?
   txsBlockCapacity :: Ticked (LedgerState blk) -> TxMeasure blk