Added method to compute over-the-wire CBOR encoded transaction size

IntersectMBO · Aug 1, 2024 · 5268608 · 5268608
1 parent 48c5fd3
commit 5268608
Show file tree

Hide file tree

Showing 9 changed files with 41 additions and 9 deletions.
diff --git a/eras/allegra/impl/src/Cardano/Ledger/Allegra/Tx.hs b/eras/allegra/impl/src/Cardano/Ledger/Allegra/Tx.hs
@@ -59,6 +59,9 @@ instance Crypto c => EraTx (AllegraEra c) where
   sizeTxF = sizeShelleyTxF
   {-# INLINE sizeTxF #-}
 
+  wireSizeTxF = sizeShelleyTxF
+  {-# INLINE wireSizeTxF #-}
+
   validateNativeScript = validateTimelock
   {-# INLINE validateNativeScript #-}
 

diff --git a/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Tx.hs b/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Tx.hs
@@ -11,6 +11,7 @@
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE TypeApplications #-}
@@ -186,9 +187,12 @@ instance Crypto c => EraTx (AlonzoEra c) where
   auxDataTxL = auxDataAlonzoTxL
   {-# INLINE auxDataTxL #-}
 
-  sizeTxF = sizeAlonzoTxF
+  sizeTxF = sizeAlonzoTxF toCBORForSizeComputation
   {-# INLINE sizeTxF #-}
 
+  wireSizeTxF = sizeAlonzoTxf toCBOR
+  {-# INLINE wireSizeTxF #-}
+
   validateNativeScript = validateTimelock
   {-# INLINE validateNativeScript #-}
 
@@ -236,13 +240,18 @@ auxDataAlonzoTxL = lens auxiliaryData (\tx txTxAuxData -> tx {auxiliaryData = tx
 {-# INLINEABLE auxDataAlonzoTxL #-}
 
 -- | txsize computes the length of the serialised bytes
-sizeAlonzoTxF :: forall era. EraTx era => SimpleGetter (AlonzoTx era) Integer
-sizeAlonzoTxF =
+sizeAlonzoTxF ::
+  forall era.
+  EraTx era =>
+  -- | encoding for CBOR size or mempool submission
+  (AlonzoTx era -> Encoding) ->
+  SimpleGetter (AlonzoTx era) Integer
+sizeAlonzoTxF enc =
   to $
     fromIntegral
       . LBS.length
       . serialize (eraProtVerLow @era)
-      . toCBORForSizeComputation
+      . enc
 {-# INLINEABLE sizeAlonzoTxF #-}
 
 isValidAlonzoTxL :: Lens' (AlonzoTx era) IsValid

diff --git a/eras/babbage/impl/src/Cardano/Ledger/Babbage/Tx.hs b/eras/babbage/impl/src/Cardano/Ledger/Babbage/Tx.hs
@@ -47,9 +47,12 @@ instance Crypto c => EraTx (BabbageEra c) where
   auxDataTxL = auxDataAlonzoTxL
   {-# INLINE auxDataTxL #-}
 
-  sizeTxF = sizeAlonzoTxF
+  sizeTxF = sizeAlonzoTxF X.toCBORForSizeComputation
   {-# INLINE sizeTxF #-}
 
+  wireSizeTxF = sizeAlonzoTxf toCBOR
+  {-# INLINE wireSizeTxF #-}
+
   validateNativeScript = validateTimelock
   {-# INLINE validateNativeScript #-}
 

diff --git a/eras/conway/impl/src/Cardano/Ledger/Conway/Tx.hs b/eras/conway/impl/src/Cardano/Ledger/Conway/Tx.hs
@@ -62,9 +62,12 @@ instance Crypto c => EraTx (ConwayEra c) where
   auxDataTxL = auxDataAlonzoTxL
   {-# INLINE auxDataTxL #-}
 
-  sizeTxF = sizeAlonzoTxF
+  sizeTxF = sizeAlonzoTxF toCBORForSizeComputation
   {-# INLINE sizeTxF #-}
 
+  wireSizeTxF = sizeAlonzoTxf toCBOR
+  {-# INLINE wireSizeTxF #-}
+
   validateNativeScript = validateTimelock
   {-# INLINE validateNativeScript #-}
 

diff --git a/eras/mary/impl/src/Cardano/Ledger/Mary/Tx.hs b/eras/mary/impl/src/Cardano/Ledger/Mary/Tx.hs
@@ -47,6 +47,9 @@ instance Crypto c => EraTx (MaryEra c) where
   sizeTxF = sizeShelleyTxF
   {-# INLINE sizeTxF #-}
 
+  wireSizeTxF = sizeShelleyTxF
+  {-# INLINE wireSizeTxF #-}
+
   validateNativeScript = validateTimelock
   {-# INLINE validateNativeScript #-}
 

diff --git a/eras/shelley/impl/src/Cardano/Ledger/Shelley/Tx.hs b/eras/shelley/impl/src/Cardano/Ledger/Shelley/Tx.hs
@@ -164,7 +164,7 @@ auxDataShelleyTxL =
 {-# INLINEABLE auxDataShelleyTxL #-}
 
 -- | Size getter for `ShelleyTx`.
-sizeShelleyTxF :: Era era => SimpleGetter (ShelleyTx era) Integer
+sizeShelleyTxF :: (Era era, Num b) => SimpleGetter (ShelleyTx era) b
 sizeShelleyTxF = to (\(TxConstr (Memo _ bytes)) -> fromIntegral $ SBS.length bytes)
 {-# INLINEABLE sizeShelleyTxF #-}
 
@@ -200,6 +200,9 @@ instance Crypto c => EraTx (ShelleyEra c) where
   sizeTxF = sizeShelleyTxF
   {-# INLINE sizeTxF #-}
 
+  wireSizeTxF = sizeShelleyTxF
+  {-# INLINE wireSizeTxF #-}
+
   validateNativeScript = validateMultiSig
   {-# INLINE validateNativeScript #-}
 

diff --git a/libs/cardano-ledger-core/CHANGELOG.md b/libs/cardano-ledger-core/CHANGELOG.md
@@ -1,5 +1,9 @@
 # Version history for `cardano-ledger-core`
 
+## 1.14.2.0
+
+* Add `wireSizeTxF` to `EraTx` class
+
 ## 1.14.1.0
 
 ### `testlib`

diff --git a/libs/cardano-ledger-core/cardano-ledger-core.cabal b/libs/cardano-ledger-core/cardano-ledger-core.cabal
@@ -1,6 +1,6 @@
 cabal-version:      3.0
 name:               cardano-ledger-core
-version:            1.14.1.0
+version:            1.14.2.0
 license:            Apache-2.0
 maintainer:         operations@iohk.io
 author:             IOHK

diff --git a/libs/cardano-ledger-core/src/Cardano/Ledger/Core.hs b/libs/cardano-ledger-core/src/Cardano/Ledger/Core.hs
@@ -118,7 +118,7 @@ import Data.Maybe.Strict (StrictMaybe)
 import Data.Sequence.Strict (StrictSeq)
 import Data.Set (Set)
 import Data.Void (Void)
-import Data.Word (Word64)
+import Data.Word (Word32, Word64)
 import GHC.Stack (HasCallStack)
 import Lens.Micro
 import NoThunks.Class (NoThunks)
@@ -153,8 +153,12 @@ class
 
   auxDataTxL :: Lens' (Tx era) (StrictMaybe (AuxiliaryData era))
 
+  -- | For estimations of impact on block space
   sizeTxF :: SimpleGetter (Tx era) Integer
 
+  -- | For end use by eg. diffusion layer in transaction submission protocol
+  wireSizeTxF :: SimpleGetter (Tx era) Word32
+
   -- | Using information from the transaction validate the supplied native script.
   validateNativeScript :: Tx era -> NativeScript era -> Bool