Merge pull request #4447 from IntersectMBO/amesgen/new-tx-fee-8.9

Backport of size calculation
IntersectMBO · Jun 27, 2024 · 44e9440 · 44e9440
2 parents 6e2d37c + 0e64820
commit 44e9440
Show file tree

Hide file tree

Showing 7 changed files with 64 additions and 8 deletions.
diff --git a/eras/babbage/impl/CHANGELOG.md b/eras/babbage/impl/CHANGELOG.md
@@ -1,5 +1,9 @@
 # Version history for `cardano-ledger-babbage`
 
+## 1.6.1.0
+
+* Add `getReferenceScriptsNonDistinct`
+
 ## 1.6.0.0
 
 * Remove deprecated `getDatumBabbage`, `babbageTxScripts`, `refScripts`

diff --git a/eras/babbage/impl/cardano-ledger-babbage.cabal b/eras/babbage/impl/cardano-ledger-babbage.cabal
@@ -1,6 +1,6 @@
 cabal-version:      3.0
 name:               cardano-ledger-babbage
-version:            1.6.0.0
+version:            1.6.1.0
 license:            Apache-2.0
 maintainer:         [email protected]
 author:             IOHK

diff --git a/eras/babbage/impl/src/Cardano/Ledger/Babbage/UTxO.hs b/eras/babbage/impl/src/Cardano/Ledger/Babbage/UTxO.hs
@@ -8,6 +8,7 @@ module Cardano.Ledger.Babbage.UTxO (
   getBabbageSpendingDatum,
   getBabbageScriptsProvided,
   getReferenceScripts,
+  getReferenceScriptsNonDistinct,
 ) where
 
 import Cardano.Ledger.Alonzo.TxWits (unTxDats)
@@ -137,9 +138,15 @@ getReferenceScripts ::
   UTxO era ->
   Set (TxIn (EraCrypto era)) ->
   Map.Map (ScriptHash (EraCrypto era)) (Script era)
-getReferenceScripts (UTxO mp) inputs = Map.foldl' accum Map.empty (eval (inputs ◁ mp))
-  where
-    accum ans txOut =
-      case txOut ^. referenceScriptTxOutL of
-        SNothing -> ans
-        SJust script -> Map.insert (hashScript script) script ans
+getReferenceScripts utxo ins = Map.fromList (getReferenceScriptsNonDistinct utxo ins)
+
+getReferenceScriptsNonDistinct ::
+  BabbageEraTxOut era =>
+  UTxO era ->
+  Set (TxIn (EraCrypto era)) ->
+  [(ScriptHash (EraCrypto era), Script era)]
+getReferenceScriptsNonDistinct (UTxO mp) inputs =
+  [ (hashScript script, script)
+  | txOut <- Map.elems (eval (inputs ◁ mp))
+  , SJust script <- [txOut ^. referenceScriptTxOutL]
+  ]
diff --git a/eras/conway/impl/CHANGELOG.md b/eras/conway/impl/CHANGELOG.md
@@ -1,5 +1,9 @@
 # Version history for `cardano-ledger-conway`
 
+## 1.12.1.0
+
+* Add `tierRefScriptFee` and `txNonDistinctRefScriptsSize`
+
 ## 1.12.0.0
 
 * Changed the types in `GovernanceActionsDoNotExist`, `DisallowedVoters`

diff --git a/eras/conway/impl/cardano-ledger-conway.cabal b/eras/conway/impl/cardano-ledger-conway.cabal
@@ -1,6 +1,6 @@
 cabal-version:      3.0
 name:               cardano-ledger-conway
-version:            1.12.0.0
+version:            1.12.1.0
 license:            Apache-2.0
 maintainer:         [email protected]
 author:             IOHK
@@ -78,6 +78,7 @@ library
     build-depends:
         base >=4.14 && <5,
         aeson >=2.2,
+        bytestring,
         data-default-class,
         cardano-crypto-class,
         cardano-data >=1.2,

diff --git a/eras/conway/impl/src/Cardano/Ledger/Conway/Tx.hs b/eras/conway/impl/src/Cardano/Ledger/Conway/Tx.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE NumericUnderscores #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeFamilies #-}
@@ -6,6 +8,7 @@
 
 module Cardano.Ledger.Conway.Tx (
   module BabbageTxReExport,
+  tierRefScriptFee,
 )
 where
 
@@ -27,12 +30,14 @@ import Cardano.Ledger.Babbage.Tx as BabbageTxReExport (
   AlonzoEraTx (..),
   AlonzoTx (..),
  )
+import Cardano.Ledger.Coin (Coin (Coin))
 import Cardano.Ledger.Conway.Era (ConwayEra)
 import Cardano.Ledger.Conway.TxAuxData ()
 import Cardano.Ledger.Conway.TxBody ()
 import Cardano.Ledger.Conway.TxWits ()
 import Cardano.Ledger.Core
 import Cardano.Ledger.Crypto
+import Data.Ratio ((%))
 
 instance Crypto c => EraTx (ConwayEra c) where
   {-# SPECIALIZE instance EraTx (ConwayEra StandardCrypto) #-}
@@ -66,6 +71,27 @@ instance Crypto c => EraTx (ConwayEra c) where
       <*> pure valid
       <*> pure (fmap upgradeTxAuxData aux)
 
+-- | Calculate the fee for reference scripts using an expoential growth of the price per
+-- byte with linear increments
+tierRefScriptFee ::
+  -- | Growth factor or step multiplier
+  Rational ->
+  -- | Increment size in which price grows linearly according to the price
+  Int ->
+  -- | Base fee. Currently this is customizable by `ppMinFeeRefScriptCostPerByteL`
+  Rational ->
+  -- | Total RefScript size in bytes
+  Int ->
+  Coin
+tierRefScriptFee multiplier sizeIncrement = go 0
+  where
+    go !acc !curTierPrice !n
+      | n < sizeIncrement =
+          Coin $ floor (acc + (toInteger n % 1) * curTierPrice)
+      | otherwise =
+          go (acc + sizeIncrementRational * curTierPrice) (multiplier * curTierPrice) (n - sizeIncrement)
+    sizeIncrementRational = toInteger sizeIncrement % 1
+
 instance Crypto c => AlonzoEraTx (ConwayEra c) where
   {-# SPECIALIZE instance AlonzoEraTx (ConwayEra StandardCrypto) #-}
 

diff --git a/eras/conway/impl/src/Cardano/Ledger/Conway/UTxO.hs b/eras/conway/impl/src/Cardano/Ledger/Conway/UTxO.hs
@@ -15,6 +15,7 @@
 module Cardano.Ledger.Conway.UTxO (
   conwayProducedValue,
   getConwayWitsVKeyNeeded,
+  txNonDistinctRefScriptsSize,
 ) where
 
 import Cardano.Ledger.Address (RewardAcnt (..))
@@ -27,6 +28,7 @@ import Cardano.Ledger.Babbage.UTxO (
   getBabbageScriptsProvided,
   getBabbageSpendingDatum,
   getBabbageSupplementalDataHashes,
+  getReferenceScriptsNonDistinct,
  )
 import Cardano.Ledger.Conway.Core
 import Cardano.Ledger.Conway.Era (ConwayEra)
@@ -42,13 +44,16 @@ import Cardano.Ledger.Crypto (Crypto)
 import Cardano.Ledger.Keys (KeyHash, KeyRole (..), asWitness)
 import Cardano.Ledger.Mary.UTxO (getConsumedMaryValue)
 import Cardano.Ledger.Mary.Value (PolicyID (..))
+import Cardano.Ledger.SafeHash (SafeToHash (..))
 import Cardano.Ledger.Shelley.UTxO (getShelleyWitsVKeyNeededNoGov, shelleyProducedValue)
 import Cardano.Ledger.UTxO (EraUTxO (..), UTxO (..), getScriptHash)
 import Cardano.Ledger.Val (Val (..), inject)
+import qualified Data.ByteString as BS
 import Data.Foldable (Foldable (..), toList)
 import qualified Data.Map.Strict as Map
 import Data.Maybe (mapMaybe)
 import Data.Maybe.Strict (strictMaybeToMaybe)
+import Data.Monoid (Sum (..))
 import qualified Data.Set as Set
 import Lens.Micro ((^.))
 import Lens.Micro.Extras (view)
@@ -136,6 +141,15 @@ instance Crypto c => AlonzoEraUTxO (ConwayEra c) where
 
   getSpendingDatum = getBabbageSpendingDatum
 
+-- | Calculate the total size of reference scripts used by the transactions. Duplicate
+-- scripts will be counted as many times as they occur, since there is never a reason to
+-- include an input with the same reference script.
+txNonDistinctRefScriptsSize :: (EraTx era, BabbageEraTxBody era) => UTxO era -> Tx era -> Int
+txNonDistinctRefScriptsSize utxo tx = getSum $ foldMap (Sum . BS.length . originalBytes . snd) refScripts
+  where
+    inputs = (tx ^. bodyTxL . referenceInputsTxBodyL) `Set.union` (tx ^. bodyTxL . inputsTxBodyL)
+    refScripts = getReferenceScriptsNonDistinct utxo inputs
+
 getConwayWitsVKeyNeeded ::
   (EraTx era, ConwayEraTxBody era) =>
   UTxO era ->