From 58022583c2876fbec603491f52a5f8411825edce Mon Sep 17 00:00:00 2001 From: Johannes Lund Date: Thu, 27 Jun 2024 17:39:04 +0200 Subject: [PATCH] Replace deprecated `evaluateTransactionFee` with `getMinFeeTx` With the 8.11 node the deprecated `evaluateTransactionFee` is removed, and additionally, we will need to adapt to changes to the calculation present in `getMinFeeTxUtxo`. --- .../lib/internal/Internal/Cardano/Write/Tx.hs | 41 ------ .../Internal/Cardano/Write/Tx/Balance.hs | 5 +- .../Internal/Cardano/Write/Tx/Sign.hs | 131 ++++++++++-------- .../Internal/Cardano/Write/Tx/BalanceSpec.hs | 51 ++++--- 4 files changed, 109 insertions(+), 119 deletions(-) diff --git a/lib/balance-tx/lib/internal/Internal/Cardano/Write/Tx.hs b/lib/balance-tx/lib/internal/Internal/Cardano/Write/Tx.hs index ea6f83b968b..f4c45f19423 100644 --- a/lib/balance-tx/lib/internal/Internal/Cardano/Write/Tx.hs +++ b/lib/balance-tx/lib/internal/Internal/Cardano/Write/Tx.hs @@ -4,7 +4,6 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE LambdaCase #-} -{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE RankNTypes #-} @@ -16,10 +15,6 @@ {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE UndecidableSuperClasses #-} -{-# OPTIONS_GHC -Wno-warnings-deprecations #-} --- For 'Shelley.evaluateTransactionFee', see ADP-3334 --- https://cardanofoundation.atlassian.net/browse/ADP-3334 - -- | -- Copyright: © 2022 IOHK -- License: Apache-2.0 @@ -149,7 +144,6 @@ module Internal.Cardano.Write.Tx , AssetName -- * Balancing - , evaluateMinimumFee , evaluateTransactionBalance ) where @@ -294,7 +288,6 @@ import qualified Cardano.Ledger.Credential as Core import qualified Cardano.Ledger.Keys as Ledger import qualified Cardano.Ledger.Mary.Value as Value import qualified Cardano.Ledger.Plutus.Data as Alonzo -import qualified Cardano.Ledger.Shelley.API.Wallet as Shelley import qualified Cardano.Ledger.Shelley.UTxO as Shelley import qualified Cardano.Ledger.TxIn as Ledger import qualified Cardano.Wallet.Primitive.Ledger.Convert as Convert @@ -782,8 +775,6 @@ toCardanoApiUTxO = . Map.mapKeys CardanoApi.fromShelleyTxIn . Map.map (CardanoApi.fromShelleyTxOut (shelleyBasedEra @era)) . unUTxO - where - unUTxO (Shelley.UTxO m) = m fromCardanoApiUTxO :: forall era. IsRecentEra era @@ -868,38 +859,6 @@ stakeKeyDeposit pp = pp ^. Core.ppKeyDepositL -- Balancing -------------------------------------------------------------------------------- --- | Computes the minimal fee amount necessary to pay for a given transaction. --- -evaluateMinimumFee - :: IsRecentEra era - => PParams era - -> Core.Tx era - -> KeyWitnessCounts - -> Coin -evaluateMinimumFee pp tx kwc = - mainFee <> bootWitnessFee - where - KeyWitnessCounts {nKeyWits, nBootstrapWits} = kwc - - mainFee :: Coin - mainFee = Shelley.evaluateTransactionFee pp tx nKeyWits - -- TODO [ADP-3334] Stop using deprecated ledger function - -- https://cardanofoundation.atlassian.net/browse/ADP-3334 - - FeePerByte feePerByte = getFeePerByte pp - - bootWitnessFee :: Coin - bootWitnessFee = Coin $ intCast $ feePerByte * byteCount - where - byteCount :: Natural - byteCount = sizeOf_BootstrapWitnesses $ intCast nBootstrapWits - - -- Matching implementation in "Cardano.Wallet.Shelley.Transaction". - -- Equivalence is tested in property. - sizeOf_BootstrapWitnesses :: Natural -> Natural - sizeOf_BootstrapWitnesses 0 = 0 - sizeOf_BootstrapWitnesses n = 4 + 180 * n - -- | Evaluate the /balance/ of a transaction using the ledger. -- -- The balance is defined as: diff --git a/lib/balance-tx/lib/internal/Internal/Cardano/Write/Tx/Balance.hs b/lib/balance-tx/lib/internal/Internal/Cardano/Write/Tx/Balance.hs index 7105b799402..e8f1abaee8a 100644 --- a/lib/balance-tx/lib/internal/Internal/Cardano/Write/Tx/Balance.hs +++ b/lib/balance-tx/lib/internal/Internal/Cardano/Write/Tx/Balance.hs @@ -198,7 +198,6 @@ import Internal.Cardano.Write.Tx , UTxO (..) , Value , computeMinimumCoinForTxOut - , evaluateMinimumFee , evaluateTransactionBalance , feeOfBytes , getFeePerByte @@ -236,6 +235,7 @@ import Internal.Cardano.Write.Tx.Redeemers import Internal.Cardano.Write.Tx.Sign ( TimelockKeyWitnessCounts (..) , estimateKeyWitnessCounts + , estimateSignedTxMinFee , estimateSignedTxSize ) import Internal.Cardano.Write.Tx.SizeEstimation @@ -866,7 +866,8 @@ balanceTxInner utxoReference tx timelockKeyWitnessCounts - minfee = Convert.toWalletCoin $ evaluateMinimumFee pp tx witCount + minfee = Convert.toWalletCoin + $ estimateSignedTxMinFee pp utxoReference tx witCount update = TxUpdate { extraInputs = mempty , extraCollateral = mempty diff --git a/lib/balance-tx/lib/internal/Internal/Cardano/Write/Tx/Sign.hs b/lib/balance-tx/lib/internal/Internal/Cardano/Write/Tx/Sign.hs index db03eef852b..dcb6bad6090 100644 --- a/lib/balance-tx/lib/internal/Internal/Cardano/Write/Tx/Sign.hs +++ b/lib/balance-tx/lib/internal/Internal/Cardano/Write/Tx/Sign.hs @@ -1,10 +1,12 @@ +{-# LANGUAGE DataKinds #-} {-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TupleSections #-} -{-# LANGUAGE TypeApplications #-} +{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-} +{-# HLINT ignore "Use camelCase" #-} -- | -- Copyright: © 2023 IOHK, 2023 Cardano Foundation @@ -18,6 +20,7 @@ module Internal.Cardano.Write.Tx.Sign -- * Signing-related utilities required for balancing estimateSignedTxSize + , estimateSignedTxMinFee , KeyWitnessCounts (..) , TimelockKeyWitnessCounts (..) @@ -30,6 +33,9 @@ module Internal.Cardano.Write.Tx.Sign import Prelude +import Cardano.Api.Ledger + ( Coin + ) import Cardano.Ledger.Allegra.Scripts ( Timelock ) @@ -41,7 +47,7 @@ import Cardano.Ledger.Api , addrTxWitsL , bodyTxL , bootAddrTxWitsL - , ppMinFeeAL + , getMinFeeTx , scriptTxWitsL , sizeTxF , witsTxL @@ -50,24 +56,32 @@ import Cardano.Ledger.Credential ( Credential (..) , StakeCredential ) +import Cardano.Ledger.Tools + ( addDummyWitsTx + ) import Cardano.Ledger.UTxO ( EraUTxO (getScriptsHashesNeeded, getScriptsNeeded) , txinLookup ) +import Cardano.Wallet.Primitive.Types.Tx.Constraints + ( TxSize (..) + ) import Control.Lens ( view , (&) , (.~) , (^.) ) +import Data.IntCast + ( intCast + , intCastMaybe + ) import Data.Map.Strict ( Map ) import Data.Maybe - ( mapMaybe - ) -import Data.Monoid.Monus - ( Monus ((<\>)) + ( fromMaybe + , mapMaybe ) import Data.Set ( Set @@ -80,6 +94,8 @@ import Internal.Cardano.Write.Tx , Tx , TxIn , UTxO + , feeOfBytes + , getFeePerByte , toCardanoApiTx ) import Numeric.Natural @@ -94,9 +110,6 @@ import qualified Cardano.Ledger.Api as Ledger import qualified Cardano.Ledger.Api.Tx.Cert as Conway import qualified Cardano.Ledger.Shelley.TxCert as Shelley import qualified Cardano.Wallet.Primitive.Ledger.Convert as Convert -import qualified Cardano.Wallet.Primitive.Types.Coin as W - ( Coin (..) - ) import qualified Cardano.Wallet.Primitive.Types.Tx.Constraints as W ( TxSize (..) ) @@ -114,52 +127,15 @@ estimateSignedTxSize -> KeyWitnessCounts -> Tx era -- ^ existing wits in tx are ignored -> W.TxSize -estimateSignedTxSize pparams nWits txWithWits = - let - -- Hack which allows us to rely on the ledger to calculate the size of - -- witnesses: - feeOfWits :: W.Coin - feeOfWits = minfee nWits <\> minfee mempty - - sizeOfWits :: W.TxSize - sizeOfWits = - case feeOfWits `coinQuotRem` feePerByte of - (n, 0) -> W.TxSize n - (_, _) -> error $ unwords - [ "estimateSignedTxSize:" - , "the impossible happened!" - , "Couldn't divide" - , show feeOfWits - , "lovelace (the fee contribution of" - , show nWits - , "witnesses) with" - , show feePerByte - , "lovelace/byte" - ] - - sizeOfTx :: W.TxSize - sizeOfTx = - fromIntegral @Integer @W.TxSize - $ unsignedTx ^. sizeTxF - in - sizeOfTx <> sizeOfWits +estimateSignedTxSize pparams (KeyWitnessCounts nWit nBoot)tx = + TxSize + . (+ sizeOf_BootstrapWitnesses (intCast nBoot)) + . integerToNatural + . view sizeTxF + $ mockWitnesses nWit pparams tx where - unsignedTx :: Tx era - unsignedTx = - txWithWits - & (witsTxL . addrTxWitsL) .~ mempty - & (witsTxL . bootAddrTxWitsL) .~ mempty - - coinQuotRem :: W.Coin -> W.Coin -> (Natural, Natural) - coinQuotRem (W.Coin p) (W.Coin q) = quotRem p q - - minfee :: KeyWitnessCounts -> W.Coin - minfee witCount = Convert.toWalletCoin $ Write.evaluateMinimumFee - pparams unsignedTx witCount - - feePerByte :: W.Coin - feePerByte = Convert.toWalletCoin $ - pparams ^. ppMinFeeAL + integerToNatural = fromMaybe (error "estimateSignedTxSize: negative size") + . intCastMaybe numberOfShelleyWitnesses :: Word -> KeyWitnessCounts numberOfShelleyWitnesses n = KeyWitnessCounts n 0 @@ -418,3 +394,50 @@ estimateMaxWitnessRequiredPerInput = \case -- https://cardanofoundation.atlassian.net/browse/ADP-2676 CA.ActiveFromSlot _ -> 0 CA.ActiveUntilSlot _ -> 0 + +estimateSignedTxMinFee + :: forall era. IsRecentEra era + => PParams era + -> UTxO era + -> Tx era + -> KeyWitnessCounts + -> Coin +estimateSignedTxMinFee pp _utxoNeededSoon tx (KeyWitnessCounts nWit nBoot) = + -- NOTE: We don't use mock bootstrap witnesses, but rely on the same + -- size estimation as coin selection does through 'estimateTxSize' + getMinFeeTx pp (mockWitnesses nWit pp tx) + <> bootWitFee + where + bootWitFee = + feeOfBytes + (getFeePerByte pp) + (sizeOf_BootstrapWitnesses $ intCast nBoot) + +-- Matching the corresponding implementation in "Cardano.Write.Tx.SizeEstimation". +-- Their equivalence is tested in a property test. +sizeOf_BootstrapWitnesses :: Natural -> Natural +sizeOf_BootstrapWitnesses 0 = 0 +sizeOf_BootstrapWitnesses n = 4 + 180 * n + +-- | Adds 'n' number of mock key witnesses to the tx. Any preexisting witnesses +-- will first be removed. +mockWitnesses + :: forall era. IsRecentEra era + => Word -- Key witnesses + -> PParams era + -> Tx era + -> Tx era +mockWitnesses nWits pp tx = + addDummyWitsTx + pp + (dropWits tx) + (wordToInt nWits) + [] -- no byron witnesses + where + wordToInt :: Word -> Int + wordToInt = fromMaybe (error "addDummyKeyWitnesses") . intCastMaybe + + dropWits :: Tx era -> Tx era + dropWits x = x + & (witsTxL . bootAddrTxWitsL) .~ mempty + & (witsTxL . addrTxWitsL) .~ mempty diff --git a/lib/balance-tx/test/spec/Internal/Cardano/Write/Tx/BalanceSpec.hs b/lib/balance-tx/test/spec/Internal/Cardano/Write/Tx/BalanceSpec.hs index 2b986225aae..cefdf7c2edd 100644 --- a/lib/balance-tx/test/spec/Internal/Cardano/Write/Tx/BalanceSpec.hs +++ b/lib/balance-tx/test/spec/Internal/Cardano/Write/Tx/BalanceSpec.hs @@ -298,6 +298,7 @@ import Internal.Cardano.Write.Tx.Balance import Internal.Cardano.Write.Tx.Sign ( KeyWitnessCounts (..) , estimateKeyWitnessCounts + , estimateSignedTxMinFee , estimateSignedTxSize ) import Internal.Cardano.Write.Tx.SizeEstimation @@ -530,8 +531,9 @@ spec_balanceTx = describe "balanceTx" $ do -> Natural evaluateMinimumFeeSize tx = fromIntegral $ Write.unCoin - $ Write.evaluateMinimumFee + $ estimateSignedTxMinFee pp + inputsHaveNoRefScripts (withNoKeyWits tx) (KeyWitnessCounts 0 (fromIntegral $ length wits)) where @@ -541,6 +543,11 @@ spec_balanceTx = describe "balanceTx" $ do -- size-delta. pp = Ledger.emptyPParams & set ppMinFeeAL (Ledger.Coin 1) + -- Dummy UTxO lookup telling the ledger the inputs aren't + -- bringing reference scripts into scope + inputsHaveNoRefScripts = + utxoPromisingInputsHaveAddress dummyAddr tx + let evaluateMinimumFeeDerivedWitSize tx = evaluateMinimumFeeSize tx - evaluateMinimumFeeSize (withNoKeyWits tx) @@ -551,7 +558,7 @@ spec_balanceTx = describe "balanceTx" $ do $ \n tx -> do let balanceSize = evaluateMinimumFeeDerivedWitSize tx let csSize = coinSelectionEstimatedSize $ intCast n - balanceSize === csSize + csSize === balanceSize -- >= would suffice, but we can be stronger it "balanceTx's size estimation >= measured serialized size" @@ -954,7 +961,9 @@ balanceTxGoldenSpec = describe "balance goldens" $ do -> UTxO era -> Coin minFee tx u = - Write.evaluateMinimumFee mockPParamsForBalancing + estimateSignedTxMinFee + mockPParamsForBalancing + u tx (estimateKeyWitnessCounts u tx mempty) @@ -1024,24 +1033,6 @@ spec_estimateSignedTxSize = describe "estimateSignedTxSize" $ do in Hspec.counterexample msg $ f name bs tx - -- estimateSignedTxSize now depends upon being able to resolve inputs. To - -- keep tese tests working, we can create a UTxO with dummy values as long - -- as estimateSignedTxSize can tell that all inputs in the tx correspond to - -- outputs with vk payment credentials. - utxoPromisingInputsHaveAddress - :: forall era. (HasCallStack, IsRecentEra era) - => W.Address - -> Tx era - -> UTxO era - utxoPromisingInputsHaveAddress addr tx = - unsafeUtxoFromTxOutsInRecentEra [(i, txOut) | i <- allInputs tx] - where - allInputs :: Tx era -> [TxIn] - allInputs body = Set.toList $ body ^. (bodyTxL . allInputsTxBodyF) - - txOut :: TxOutInRecentEra - txOut = TxOutInRecentEra (Convert.toLedger addr) mempty NoDatum Nothing - -- An address with a vk payment credential. For the test above, this is the -- only aspect which matters. vkCredAddr = W.Address $ unsafeFromHex @@ -1454,7 +1445,7 @@ prop_balanceTxValid -> UTxO era -> Coin minFee tx utxo = - Write.evaluateMinimumFee protocolParams + estimateSignedTxMinFee protocolParams utxo tx (estimateKeyWitnessCounts utxo tx partialTx.timelockKeyWitnessCounts) @@ -1916,6 +1907,22 @@ cardanoToWalletTxOut = txFee :: IsRecentEra era => Tx era -> Coin txFee tx = tx ^. bodyTxL . feeTxBodyL +-- | Construct a dummy 'UTxO era' where all inputs of the 'Tx era' resolve to +-- outputs with the given 'Address'. +utxoPromisingInputsHaveAddress + :: forall era. (HasCallStack, IsRecentEra era) + => W.Address + -> Tx era + -> UTxO era +utxoPromisingInputsHaveAddress addr tx = + unsafeUtxoFromTxOutsInRecentEra [(i, txOut) | i <- allInputs tx] + where + allInputs :: Tx era -> [TxIn] + allInputs body = Set.toList $ body ^. (bodyTxL . allInputsTxBodyF) + + txOut :: TxOutInRecentEra + txOut = TxOutInRecentEra (Convert.toLedger addr) mempty NoDatum Nothing + -------------------------------------------------------------------------------- -- Test values --------------------------------------------------------------------------------