Merge pull request #4959 from IntersectMBO/td/improve-sizeTxF

teodanciu · web-flow · commit 655b55265f8c · 2025-04-02T17:19:17.000+01:00
Improve performance of sizeTxF
diff --git a/eras/allegra/impl/src/Cardano/Ledger/Allegra/Rules/Utxo.hs b/eras/allegra/impl/src/Cardano/Ledger/Allegra/Rules/Utxo.hs
@@ -176,6 +176,7 @@ utxoTransition ::
   , InjectRuleFailure "UTXO" AllegraUtxoPredFailure era
   , InjectRuleFailure "UTXO" Shelley.ShelleyUtxoPredFailure era
   , EraRule "UTXO" era ~ AllegraUTXO era
+  , SafeToHash (TxWits era)
   ) =>
   TransitionRule (EraRule "UTXO" era)
 utxoTransition = do
@@ -310,6 +311,7 @@ instance
   , GovState era ~ ShelleyGovState era
   , InjectRuleFailure "UTXO" AllegraUtxoPredFailure era
   , InjectRuleFailure "UTXO" Shelley.ShelleyUtxoPredFailure era
+  , SafeToHash (TxWits era)
   ) =>
   STS (AllegraUTXO era)
   where
@@ -322,6 +324,7 @@ instance
 
   initialRules = []
   transitionRules = [utxoTransition]
+  assertions = [Shelley.validSizeComputationCheck]
 
 instance
   ( Era era
diff --git a/eras/allegra/impl/test/Test/Cardano/Ledger/Allegra/BinarySpec.hs b/eras/allegra/impl/test/Test/Cardano/Ledger/Allegra/BinarySpec.hs
@@ -11,7 +11,7 @@ import Test.Cardano.Ledger.Allegra.Arbitrary ()
 import Test.Cardano.Ledger.Allegra.TreeDiff ()
 import Test.Cardano.Ledger.Common
 import Test.Cardano.Ledger.Core.Binary (specUpgrade)
-import Test.Cardano.Ledger.Core.Binary as Binary (decoderEquivalenceCoreEraTypesSpec)
+import Test.Cardano.Ledger.Core.Binary as Binary (decoderEquivalenceCoreEraTypesSpec, txSizeSpec)
 import Test.Cardano.Ledger.Core.Binary.RoundTrip (RuleListEra (..))
 import Test.Cardano.Ledger.Shelley.Binary.RoundTrip (roundTripShelleyCommonSpec)
 
@@ -22,6 +22,7 @@ spec = do
     roundTripShelleyCommonSpec @AllegraEra
   describe "DecCBOR instances equivalence" $ do
     Binary.decoderEquivalenceCoreEraTypesSpec @AllegraEra
+  Binary.txSizeSpec @AllegraEra
 
 instance RuleListEra AllegraEra where
   type
diff --git a/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Rules/Utxo.hs b/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Rules/Utxo.hs
@@ -492,6 +492,7 @@ utxoTransition ::
   , State (EraRule "UTXOS" era) ~ UTxOState era
   , Signal (EraRule "UTXOS" era) ~ Tx era
   , EraCertState era
+  , SafeToHash (TxWits era)
   ) =>
   TransitionRule (EraRule "UTXO" era)
 utxoTransition = do
@@ -580,6 +581,7 @@ instance
   , InjectRuleFailure "UTXO" AllegraUtxoPredFailure era
   , ProtVerAtMost era 8
   , EraCertState era
+  , SafeToHash (TxWits era)
   ) =>
   STS (AlonzoUTXO era)
   where
@@ -592,6 +594,7 @@ instance
 
   initialRules = []
   transitionRules = [utxoTransition]
+  assertions = [Shelley.validSizeComputationCheck]
 
 instance
   ( Era era
diff --git a/eras/alonzo/impl/test/Test/Cardano/Ledger/Alonzo/BinarySpec.hs b/eras/alonzo/impl/test/Test/Cardano/Ledger/Alonzo/BinarySpec.hs
@@ -13,6 +13,7 @@ import Test.Cardano.Ledger.Core.Binary (BinaryUpgradeOpts (..), specUpgrade)
 import Test.Cardano.Ledger.Core.Binary as Binary (
   decoderEquivalenceCoreEraTypesSpec,
   decoderEquivalenceEraSpec,
+  txSizeSpec,
  )
 import Test.Cardano.Ledger.Core.Binary.RoundTrip (roundTripEraSpec)
 
@@ -31,3 +32,4 @@ spec = do
     Binary.decoderEquivalenceCoreEraTypesSpec @AlonzoEra
     decoderEquivalenceEraSpec @AlonzoEra @(TxDats AlonzoEra)
     decoderEquivalenceEraSpec @AlonzoEra @(Redeemers AlonzoEra)
+  Binary.txSizeSpec @AlonzoEra
diff --git a/eras/babbage/impl/src/Cardano/Ledger/Babbage/Rules/Utxo.hs b/eras/babbage/impl/src/Cardano/Ledger/Babbage/Rules/Utxo.hs
@@ -464,6 +464,7 @@ instance
   , State (EraRule "UTXOS" era) ~ UTxOState era
   , Signal (EraRule "UTXOS" era) ~ Tx era
   , EraCertState era
+  , SafeToHash (TxWits era)
   ) =>
   STS (BabbageUTXO era)
   where
@@ -476,6 +477,7 @@ instance
 
   initialRules = []
   transitionRules = [utxoTransition @era]
+  assertions = [Shelley.validSizeComputationCheck]
 
 instance
   ( Era era
diff --git a/eras/babbage/impl/test/Test/Cardano/Ledger/Babbage/BinarySpec.hs b/eras/babbage/impl/test/Test/Cardano/Ledger/Babbage/BinarySpec.hs
@@ -16,6 +16,7 @@ import Test.Cardano.Ledger.Core.Binary (specUpgrade)
 import Test.Cardano.Ledger.Core.Binary as Binary (
   decoderEquivalenceCoreEraTypesSpec,
   decoderEquivalenceEraSpec,
+  txSizeSpec,
  )
 import Test.Cardano.Ledger.Core.Binary.RoundTrip (RuleListEra (..))
 
@@ -28,6 +29,7 @@ spec = do
     Binary.decoderEquivalenceCoreEraTypesSpec @BabbageEra
     decoderEquivalenceEraSpec @BabbageEra @(TxDats BabbageEra)
     decoderEquivalenceEraSpec @BabbageEra @(Redeemers BabbageEra)
+  Binary.txSizeSpec @BabbageEra
 
 instance RuleListEra BabbageEra where
   type
diff --git a/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Utxo.hs b/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Utxo.hs
@@ -67,7 +67,7 @@ import Cardano.Ledger.Conway.Rules.Utxos (
 import Cardano.Ledger.Plutus (ExUnits)
 import qualified Cardano.Ledger.Shelley.LedgerState as Shelley (UTxOState)
 import Cardano.Ledger.Shelley.Rules (ShelleyUtxoPredFailure)
-import qualified Cardano.Ledger.Shelley.Rules as Shelley (UtxoEnv)
+import qualified Cardano.Ledger.Shelley.Rules as Shelley (UtxoEnv, validSizeComputationCheck)
 import Cardano.Ledger.State (EraCertState (..), EraUTxO, UTxO (..))
 import Cardano.Ledger.TxIn (TxIn)
 import Control.DeepSeq (NFData)
@@ -241,6 +241,7 @@ instance
   , Signal (EraRule "UTXOS" era) ~ Tx era
   , PredicateFailure (EraRule "UTXO" era) ~ ConwayUtxoPredFailure era
   , EraCertState era
+  , SafeToHash (TxWits era)
   ) =>
   STS (ConwayUTXO era)
   where
@@ -255,6 +256,8 @@ instance
 
   transitionRules = [Babbage.utxoTransition @era]
 
+  assertions = [Shelley.validSizeComputationCheck]
+
 instance
   ( Era era
   , STS (ConwayUTXOS era)
diff --git a/eras/conway/impl/test/Test/Cardano/Ledger/Conway/BinarySpec.hs b/eras/conway/impl/test/Test/Cardano/Ledger/Conway/BinarySpec.hs
@@ -22,7 +22,7 @@ import Test.Cardano.Ledger.Conway.Arbitrary ()
 import Test.Cardano.Ledger.Conway.Binary.RoundTrip (roundTripConwayCommonSpec)
 import Test.Cardano.Ledger.Conway.TreeDiff ()
 import Test.Cardano.Ledger.Core.Binary (specUpgrade)
-import Test.Cardano.Ledger.Core.Binary as Binary (decoderEquivalenceCoreEraTypesSpec)
+import Test.Cardano.Ledger.Core.Binary as Binary (decoderEquivalenceCoreEraTypesSpec, txSizeSpec)
 import Test.Cardano.Ledger.Core.Binary.RoundTrip (roundTripEraSpec)
 
 spec :: Spec
@@ -43,6 +43,7 @@ spec = do
     Binary.decoderEquivalenceCoreEraTypesSpec @ConwayEra
     decoderEquivalenceLenientSpec @(TxDats ConwayEra)
     decoderEquivalenceLenientSpec @(Redeemers ConwayEra)
+  Binary.txSizeSpec @ConwayEra
   where
     -- The expectation used in this spec allows for the deserialization to fail, in which case
     -- it only checks that it fails for both decoders.
diff --git a/eras/mary/impl/test/Test/Cardano/Ledger/Mary/BinarySpec.hs b/eras/mary/impl/test/Test/Cardano/Ledger/Mary/BinarySpec.hs
@@ -9,7 +9,7 @@ import Cardano.Ledger.Mary
 import Data.Default (def)
 import Test.Cardano.Ledger.Common
 import Test.Cardano.Ledger.Core.Binary (specUpgrade)
-import Test.Cardano.Ledger.Core.Binary as Binary (decoderEquivalenceCoreEraTypesSpec)
+import Test.Cardano.Ledger.Core.Binary as Binary (decoderEquivalenceCoreEraTypesSpec, txSizeSpec)
 import Test.Cardano.Ledger.Core.Binary.RoundTrip (RuleListEra (..))
 import Test.Cardano.Ledger.Mary.Arbitrary ()
 import Test.Cardano.Ledger.Mary.TreeDiff ()
@@ -22,6 +22,7 @@ spec = do
     roundTripShelleyCommonSpec @MaryEra
   describe "DecCBOR instances equivalence" $ do
     Binary.decoderEquivalenceCoreEraTypesSpec @MaryEra
+  Binary.txSizeSpec @MaryEra
 
 instance RuleListEra MaryEra where
   type
diff --git a/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Utxo.hs b/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Utxo.hs
@@ -23,6 +23,7 @@ module Cardano.Ledger.Shelley.Rules.Utxo (
   ShelleyUtxoPredFailure (..),
   UtxoEvent (..),
   PredicateFailure,
+  validSizeComputationCheck,
   updateUTxOState,
 
   -- * Validations
@@ -282,6 +283,7 @@ instance
   , EraRule "UTXO" era ~ ShelleyUTXO era
   , InjectRuleFailure "UTXO" ShelleyUtxoPredFailure era
   , EraCertState era
+  , SafeToHash (TxWits era)
   ) =>
   STS (ShelleyUTXO era)
   where
@@ -333,6 +335,7 @@ instance
             ( \(TRC (_, us, tx)) us' ->
                 utxoBalance us <> withdrawals (tx ^. bodyTxL) == utxoBalance us'
             )
+    , validSizeComputationCheck @era
     ]
 
 utxoInductive ::
@@ -628,3 +631,16 @@ instance
   where
   wrapFailed = UpdateFailure
   wrapEvent = UpdateEvent
+
+validSizeComputationCheck ::
+  ( EraTx era
+  , SafeToHash (TxWits era)
+  , Signal (rule era) ~ Tx era
+  ) =>
+  Assertion (rule era)
+validSizeComputationCheck =
+  PreCondition
+    "Tx size should be the length of the serialization bytestring"
+    ( \(TRC (_, _, tx)) ->
+        tx ^. sizeTxF == sizeTxForFeeCalculation tx
+    )
diff --git a/eras/shelley/impl/test/Test/Cardano/Ledger/Shelley/BinarySpec.hs b/eras/shelley/impl/test/Test/Cardano/Ledger/Shelley/BinarySpec.hs
@@ -1,10 +1,11 @@
+{-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeApplications #-}
 
 module Test.Cardano.Ledger.Shelley.BinarySpec (spec) where
 
 import Cardano.Ledger.Shelley (ShelleyEra)
 import Test.Cardano.Ledger.Common
-import Test.Cardano.Ledger.Core.Binary as Binary (decoderEquivalenceCoreEraTypesSpec)
+import Test.Cardano.Ledger.Core.Binary as Binary (decoderEquivalenceCoreEraTypesSpec, txSizeSpec)
 import qualified Test.Cardano.Ledger.Shelley.Binary.GoldenSpec as Golden
 import qualified Test.Cardano.Ledger.Shelley.Binary.RoundTripSpec as RoundTrip
 
@@ -13,3 +14,4 @@ spec = do
   Golden.spec
   RoundTrip.spec
   Binary.decoderEquivalenceCoreEraTypesSpec @ShelleyEra
+  Binary.txSizeSpec @ShelleyEra
diff --git a/libs/cardano-ledger-core/CHANGELOG.md b/libs/cardano-ledger-core/CHANGELOG.md
@@ -2,6 +2,7 @@
 
 ## 1.18.0.0
 
+* Added `sizeTxForFeeCalculation` to `EraTx` with a default implementation
 * Added `consumed` to `EraUTxO`
 * Removed `upgradeCertState`
 * Removed `VState` (moved to `cardano-ledger-conway`) and related functions
diff --git a/libs/cardano-ledger-core/cardano-ledger-core.cabal b/libs/cardano-ledger-core/cardano-ledger-core.cabal
@@ -206,6 +206,7 @@ library testlib
     hedgehog-quickcheck,
     heredoc,
     hspec,
+    microlens,
     mtl,
     nothunks,
     plutus-ledger-api:{plutus-ledger-api, plutus-ledger-api-testlib},
diff --git a/libs/cardano-ledger-core/src/Cardano/Ledger/Core.hs b/libs/cardano-ledger-core/src/Cardano/Ledger/Core.hs
@@ -106,7 +106,7 @@ import Data.Kind (Type)
 import Data.Map (Map)
 import qualified Data.Map.Strict as Map
 import Data.Maybe (fromMaybe, isJust)
-import Data.Maybe.Strict (StrictMaybe)
+import Data.Maybe.Strict (StrictMaybe, strictMaybe)
 import Data.MemPack
 import Data.Sequence.Strict (StrictSeq)
 import Data.Set (Set)
@@ -152,6 +152,16 @@ class
   -- | For end use by eg. diffusion layer in transaction submission protocol
   wireSizeTxF :: SimpleGetter (Tx era) Word32
 
+  -- | For fee calculation and estimations of impact on block space
+  -- To replace `sizeTxF` after it has been proved equivalent to it .
+  sizeTxForFeeCalculation :: SafeToHash (TxWits era) => Tx era -> Integer
+  sizeTxForFeeCalculation tx =
+    fromIntegral $
+      originalBytesSize (tx ^. bodyTxL)
+        + originalBytesSize (tx ^. witsTxL)
+        + strictMaybe 1 originalBytesSize (tx ^. auxDataTxL)
+        + 1 -- account for the top-level CBOR encoding tag
+
   -- | Using information from the transaction validate the supplied native script.
   validateNativeScript :: Tx era -> NativeScript era -> Bool
 
diff --git a/libs/cardano-ledger-core/testlib/Test/Cardano/Ledger/Core/Binary.hs b/libs/cardano-ledger-core/testlib/Test/Cardano/Ledger/Core/Binary.hs
@@ -11,13 +11,15 @@ module Test.Cardano.Ledger.Core.Binary (
   decoderEquivalenceCoreEraTypesSpec,
   specUpgrade,
   decoderEquivalenceEraSpec,
+  txSizeSpec,
 ) where
 
 import Cardano.Ledger.Binary (Annotator, DecCBOR, ToCBOR, decNoShareCBOR, encodeMemPack)
 import Cardano.Ledger.Core
 import Cardano.Ledger.MemoBytes (EqRaw (eqRaw))
 import Cardano.Ledger.Plutus (Data)
 import Data.Default (Default (def))
+import Lens.Micro
 import qualified Prettyprinter as Pretty
 import Test.Cardano.Ledger.Binary (decoderEquivalenceSpec)
 import Test.Cardano.Ledger.Binary.RoundTrip
@@ -325,3 +327,16 @@ decoderEquivalenceCoreEraTypesSpec =
     decoderEquivalenceEraSpec @era @(TxWits era)
     decoderEquivalenceEraSpec @era @(TxBody era)
     decoderEquivalenceEraSpec @era @(Tx era)
+
+txSizeSpec ::
+  forall era.
+  ( EraTx era
+  , Arbitrary (Tx era)
+  , SafeToHash (TxWits era)
+  ) =>
+  Spec
+txSizeSpec =
+  describe "Transaction size" $ do
+    prop "should match the size of the cbor encoding" $ \(tx :: Tx era) -> do
+      let txSize = sizeTxForFeeCalculation tx
+      txSize `shouldBe` tx ^. sizeTxF
