diff --git a/lib/balance-tx/lib/Cardano/Write/Tx/SizeEstimation.hs b/lib/balance-tx/lib/Cardano/Write/Tx/SizeEstimation.hs index a2bcf1b9d1f..82002511b4b 100644 --- a/lib/balance-tx/lib/Cardano/Write/Tx/SizeEstimation.hs +++ b/lib/balance-tx/lib/Cardano/Write/Tx/SizeEstimation.hs @@ -9,11 +9,9 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE NamedFieldPuns #-} -{-# LANGUAGE OverloadedLabels #-} {-# LANGUAGE Rank2Types #-} {-# LANGUAGE RoleAnnotations #-} {-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UndecidableInstances #-} {- HLINT ignore "Use <$>" -} @@ -35,14 +33,10 @@ module Cardano.Write.Tx.SizeEstimation , TxWitnessTag (..) , assumedTxWitnessTag - -- * Needed for balance migration - , txConstraints - -- * Needed for estimateSignedTxSize , sizeOf_BootstrapWitnesses - - -- * For the wallet - , _txRewardWithdrawalCost + , sizeOf_VKeyWitnesses + , sizeOf_Withdrawals ) where @@ -51,212 +45,40 @@ import Prelude import Cardano.Address.Script ( Script (..) ) -import Cardano.Ledger.Api - ( ppMaxTxSizeL, ppMaxValSizeL, ppMinFeeBL ) import Cardano.Wallet.Primitive.Types.Address ( Address (..) ) import Cardano.Wallet.Primitive.Types.Coin ( Coin (..) ) -import Cardano.Wallet.Primitive.Types.TokenBundle - ( TokenBundle (..) ) import Cardano.Wallet.Primitive.Types.TokenMap ( AssetId (..) ) import Cardano.Wallet.Primitive.Types.TokenPolicy ( TokenName (..) ) -import Cardano.Wallet.Primitive.Types.TokenQuantity - ( TokenQuantity (..) ) import Cardano.Wallet.Primitive.Types.Tx.Constraints - ( TxConstraints (..), TxSize (..), txOutMaxCoin ) -import Cardano.Write.ProtocolParameters - ( ProtocolParameters (..) ) + ( TxSize (..) ) import Cardano.Write.Tx - ( FeePerByte (..) - , IsRecentEra (recentEra) - , RecentEra (..) - , ShelleyLedgerEra - , TxOut - , computeMinimumCoinForTxOut - , getFeePerByte - , isBelowMinimumCoinForTxOut - , withConstraints - ) + ( FeePerByte (..) ) import Cardano.Write.Tx.Sign ( estimateMaxWitnessRequiredPerInput ) import Cardano.Write.UTxOAssumptions ( UTxOAssumptions (..) ) -import Control.Lens - ( (^.) ) -import Data.Generics.Internal.VL.Lens - ( view ) import Data.Generics.Labels () -import Data.Monoid.Monus - ( Monus ((<\>)) ) import Data.Set ( Set ) -import Data.Word - ( Word64, Word8 ) import GHC.Generics ( Generic ) -import GHC.Stack - ( HasCallStack ) import Numeric.Natural ( Natural ) import qualified Cardano.Address.Script as CA -import qualified Cardano.Wallet.Primitive.Types.Address as W import qualified Cardano.Wallet.Primitive.Types.Coin as Coin import qualified Cardano.Wallet.Primitive.Types.TokenBundle as TokenBundle import qualified Cardano.Wallet.Primitive.Types.Tx.TxOut as W -import qualified Cardano.Wallet.Shelley.Compatibility.Ledger as Convert -import qualified Cardano.Write.Tx as Write import qualified Codec.CBOR.Encoding as CBOR import qualified Codec.CBOR.Write as CBOR import qualified Data.ByteString as BS import qualified Data.Foldable as F --- | Like the 'TxConstraints' field 'txRewardWithdrawalCost', but with added --- support for shared wallets via the 'CA.ScriptTemplate' argument. --- --- We may or may not want to support shared wallets in the full txConstraints. -_txRewardWithdrawalCost - :: Write.FeePerByte - -> Either CA.ScriptTemplate TxWitnessTag - -> Coin - -> Coin -_txRewardWithdrawalCost feePerByte witType = - Convert.toWallet - . Write.feeOfBytes feePerByte - . unTxSize - . _txRewardWithdrawalSize witType - --- | Like the 'TxConstraints' field 'txRewardWithdrawalSize', but with added --- support for shared wallets via the 'CA.ScriptTemplate' argument. --- --- We may or may not want to support shared wallets in the full txConstraints. -_txRewardWithdrawalSize - :: Either CA.ScriptTemplate TxWitnessTag - -> Coin - -> TxSize -_txRewardWithdrawalSize _ (Coin 0) = TxSize 0 -_txRewardWithdrawalSize witType _ = - sizeOf_Withdrawals 1 <> wits - where - wits = case witType of - Right TxWitnessByronUTxO -> - sizeOf_BootstrapWitnesses 1 - sizeOf_BootstrapWitnesses 0 - Right TxWitnessShelleyUTxO -> - sizeOf_VKeyWitnesses 1 - Left scriptTemplate -> - let n = fromIntegral $ estimateMaxWitnessRequiredPerInput - $ view #template scriptTemplate - in sizeOf_VKeyWitnesses n -txConstraints - :: forall era. IsRecentEra era - => ProtocolParameters era - -> TxWitnessTag - -> TxConstraints -txConstraints (ProtocolParameters protocolParams) witnessTag = TxConstraints - { txBaseCost - , txBaseSize - , txInputCost - , txInputSize - , txOutputCost - , txOutputSize - , txOutputMaximumSize - , txOutputMaximumTokenQuantity - , txOutputMinimumAdaQuantity - , txOutputBelowMinimumAdaQuantity - , txRewardWithdrawalCost - , txRewardWithdrawalSize - , txMaximumSize - } - where - era = recentEra @era - - txBaseCost = - constantTxFee <> estimateTxCost feePerByte empty - - constantTxFee = withConstraints era $ - Convert.toWallet $ protocolParams ^. ppMinFeeBL - - feePerByte = getFeePerByte (recentEra @era) protocolParams - - txBaseSize = - estimateTxSize empty - - txInputCost = - marginalCostOf empty {txInputCount = 1} - - txInputSize = - marginalSizeOf empty {txInputCount = 1} - - txOutputCost bundle = - marginalCostOf empty {txOutputs = [mkTxOut bundle]} - - txOutputSize bundle = - marginalSizeOf empty {txOutputs = [mkTxOut bundle]} - - txOutputMaximumSize = withConstraints era $ (<>) - (txOutputSize mempty) - (TxSize (protocolParams ^. ppMaxValSizeL)) - - txOutputMaximumTokenQuantity = - TokenQuantity $ fromIntegral $ maxBound @Word64 - - txOutputMinimumAdaQuantity addr tokens = Convert.toWallet $ - computeMinimumCoinForTxOut - era - protocolParams - (mkLedgerTxOut era addr (TokenBundle txOutMaxCoin tokens)) - - txOutputBelowMinimumAdaQuantity addr bundle = - isBelowMinimumCoinForTxOut - era - protocolParams - (mkLedgerTxOut era addr bundle) - - txRewardWithdrawalCost = - _txRewardWithdrawalCost feePerByte (Right witnessTag) - - txRewardWithdrawalSize = - _txRewardWithdrawalSize (Right witnessTag) - - txMaximumSize = withConstraints era $ - TxSize $ protocolParams ^. ppMaxTxSizeL - - empty :: TxSkeleton - empty = emptyTxSkeleton witnessTag - - -- Computes the size difference between the given skeleton and an empty - -- skeleton. - marginalCostOf :: TxSkeleton -> Coin - marginalCostOf skeleton = - estimateTxCost feePerByte skeleton <\> - estimateTxCost feePerByte empty - - -- Computes the size difference between the given skeleton and an empty - -- skeleton. - marginalSizeOf :: TxSkeleton -> TxSize - marginalSizeOf = - (<\> txBaseSize) . estimateTxSize - - -- Constructs a real transaction output from a token bundle. - mkTxOut :: TokenBundle -> W.TxOut - mkTxOut = W.TxOut dummyAddress - where - dummyAddress :: Address - dummyAddress = Address $ BS.replicate dummyAddressLength nullByte - - dummyAddressLength :: Int - dummyAddressLength = 57 - -- Note: We are at liberty to overestimate the length of an address - -- (which is safe). Therefore, we can choose a length that we know is - -- greater than or equal to all address lengths. - - nullByte :: Word8 - nullByte = 0 - -------------------------------------------------------------------------------- -- Size estimation -------------------------------------------------------------------------------- @@ -279,19 +101,6 @@ data TxSkeleton = TxSkeleton } deriving (Eq, Show, Generic) --- | Constructs an empty transaction skeleton. --- --- This may be used to estimate the size and cost of an empty transaction. --- -emptyTxSkeleton :: TxWitnessTag -> TxSkeleton -emptyTxSkeleton txWitnessTag = TxSkeleton - { txWitnessTag - , txInputCount = 0 - , txOutputs = [] - , txChange = [] - , txPaymentTemplate = Nothing - } - -- | Estimates the final cost of a transaction based on its skeleton. -- -- The constant tx fee is /not/ included in the result of this function. @@ -687,19 +496,6 @@ sizeOf_Array = 3 sumVia :: (Foldable t, Num m) => (a -> m) -> t a -> m sumVia f = F.foldl' (\t -> (t +) . f) 0 -mkLedgerTxOut - :: HasCallStack - => RecentEra era - -> W.Address - -> TokenBundle - -> TxOut (ShelleyLedgerEra era) -mkLedgerTxOut txOutEra address bundle = - case txOutEra of - RecentEraBabbage -> Convert.toBabbageTxOut txOut - RecentEraConway -> Convert.toConwayTxOut txOut - where - txOut = W.TxOut address bundle - data TxWitnessTag = TxWitnessByronUTxO | TxWitnessShelleyUTxO diff --git a/lib/wallet/src/Cardano/Wallet.hs b/lib/wallet/src/Cardano/Wallet.hs index 06a57114682..cc47bcae396 100644 --- a/lib/wallet/src/Cardano/Wallet.hs +++ b/lib/wallet/src/Cardano/Wallet.hs @@ -489,7 +489,7 @@ import Cardano.Wallet.Shelley.Compatibility import Cardano.Wallet.Shelley.Compatibility.Ledger ( toLedgerAddress, toWallet, toWalletCoin ) import Cardano.Wallet.Shelley.Transaction - ( txWitnessTagForKey ) + ( txConstraints, txWitnessTagForKey, _txRewardWithdrawalCost ) import Cardano.Wallet.Transaction ( DelegationAction (..) , ErrCannotJoin (..) @@ -521,7 +521,7 @@ import Cardano.Write.Tx.Balance , constructUTxOIndex ) import Cardano.Write.Tx.SizeEstimation - ( TxWitnessTag (..), _txRewardWithdrawalCost ) + ( TxWitnessTag (..) ) import Cardano.Write.Tx.TimeTranslation ( TimeTranslation ) import Control.Arrow @@ -656,7 +656,6 @@ import qualified Cardano.Wallet.Primitive.Types.UTxOStatistics as UTxOStatistics import qualified Cardano.Wallet.Read as Read import qualified Cardano.Write.ProtocolParameters as Write import qualified Cardano.Write.Tx as Write -import qualified Cardano.Write.Tx.SizeEstimation as Write import qualified Data.ByteArray as BA import qualified Data.Delta.Update as Delta import qualified Data.Foldable as F @@ -1804,7 +1803,7 @@ calcMinimumCoinValues pp txLayer = uncurry (constraints ^. #txOutputMinimumAdaQuantity) . (\o -> (o ^. #address, o ^. #tokens . #tokens)) where - constraints = Write.txConstraints pp $ transactionWitnessTag txLayer + constraints = txConstraints pp $ transactionWitnessTag txLayer signTransaction :: forall k ktype @@ -2649,10 +2648,10 @@ createMigrationPlan createMigrationPlan ctx rewardWithdrawal = do (wallet, _, pending) <- readWallet ctx (Write.InAnyRecentEra _era pp, _) <- readNodeTipStateForTxWrite nl - let txConstraints = Write.txConstraints pp (transactionWitnessTag tl) + let constraints = txConstraints pp (transactionWitnessTag tl) utxo = availableUTxO pending wallet pure - $ Migration.createPlan txConstraints utxo + $ Migration.createPlan constraints utxo $ Migration.RewardWithdrawal $ withdrawalToCoin rewardWithdrawal where diff --git a/lib/wallet/src/Cardano/Wallet/Shelley/Transaction.hs b/lib/wallet/src/Cardano/Wallet/Shelley/Transaction.hs index 8bf99c830e1..f11eee94f23 100644 --- a/lib/wallet/src/Cardano/Wallet/Shelley/Transaction.hs +++ b/lib/wallet/src/Cardano/Wallet/Shelley/Transaction.hs @@ -33,6 +33,7 @@ module Cardano.Wallet.Shelley.Transaction ( newTransactionLayer + , txConstraints -- * Internals , TxPayload (..) @@ -44,6 +45,8 @@ module Cardano.Wallet.Shelley.Transaction , mkShelleyWitness , mkTx , mkUnsignedTx + , _txRewardWithdrawalCost + , _txRewardWithdrawalSize , txWitnessTagForKey ) where @@ -103,6 +106,8 @@ import Cardano.Wallet.Primitive.Types.TokenBundle ( TokenBundle (..) ) import Cardano.Wallet.Primitive.Types.TokenMap ( AssetId (..), TokenMap ) +import Cardano.Wallet.Primitive.Types.TokenQuantity + ( TokenQuantity (TokenQuantity) ) import Cardano.Wallet.Primitive.Types.Tx ( SealedTx (..) , Tx (..) @@ -110,7 +115,7 @@ import Cardano.Wallet.Primitive.Types.Tx , sealedTxFromCardano' ) import Cardano.Wallet.Primitive.Types.Tx.Constraints - ( txOutMaxTokenQuantity ) + ( TxConstraints (..), TxSize (..), txOutMaxCoin, txOutMaxTokenQuantity ) import Cardano.Wallet.Primitive.Types.Tx.TxIn ( TxIn (..) ) import Cardano.Wallet.Primitive.Types.Tx.TxOut @@ -155,8 +160,10 @@ import Cardano.Wallet.Transaction ) import Cardano.Wallet.Util ( HasCallStack, internalError ) +import Cardano.Write.ProtocolParameters + ( ProtocolParameters (..) ) import Cardano.Write.Tx.SizeEstimation - ( TxWitnessTag (..) ) + ( TxSkeleton (..), TxWitnessTag (..), estimateTxCost, estimateTxSize ) import Control.Arrow ( left, second ) import Control.Lens @@ -177,11 +184,16 @@ import Data.Map.Strict ( Map ) import Data.Maybe ( mapMaybe ) +import Data.Monoid.Monus + ( Monus ((<\>)) ) import Data.Type.Equality ( type (==) ) +import Data.Word + ( Word64, Word8 ) import Ouroboros.Network.Block ( SlotNo ) +import qualified Cardano.Address.Script as CA import qualified Cardano.Address.Style.Shelley as CA import qualified Cardano.Api as Cardano import qualified Cardano.Api.Byron as Byron @@ -195,7 +207,10 @@ import qualified Cardano.Ledger.Api as Ledger import qualified Cardano.Ledger.Keys.Bootstrap as SL import qualified Cardano.Wallet.Primitive.Types.TokenMap as TokenMap import qualified Cardano.Wallet.Shelley.Compatibility as Compatibility +import qualified Cardano.Wallet.Shelley.Compatibility.Ledger as Convert import qualified Cardano.Write.Tx as Write +import qualified Cardano.Write.Tx.Sign as Write +import qualified Cardano.Write.Tx.SizeEstimation as Write import qualified Data.ByteString as BS import qualified Data.Foldable as F import qualified Data.List as L @@ -203,7 +218,6 @@ import qualified Data.Map as Map import qualified Data.Set as Set import qualified Data.Text as T - -- | Type encapsulating what we need to know to add things -- payloads, -- certificates -- to a transaction. -- @@ -1086,6 +1100,169 @@ explicitFees era = case era of ShelleyBasedEraConway -> Cardano.TxFeeExplicit Cardano.TxFeesExplicitInConwayEra +txConstraints + :: forall era. Write.IsRecentEra era + => ProtocolParameters era + -> TxWitnessTag + -> TxConstraints +txConstraints (ProtocolParameters protocolParams) witnessTag = TxConstraints + { txBaseCost + , txBaseSize + , txInputCost + , txInputSize + , txOutputCost + , txOutputSize + , txOutputMaximumSize + , txOutputMaximumTokenQuantity + , txOutputMinimumAdaQuantity + , txOutputBelowMinimumAdaQuantity + , txRewardWithdrawalCost + , txRewardWithdrawalSize + , txMaximumSize + } + where + era = Write.recentEra @era + + txBaseCost = + constantTxFee <> estimateTxCost feePerByte empty + + constantTxFee = Write.withConstraints era $ + Convert.toWallet $ protocolParams ^. Ledger.ppMinFeeBL + + feePerByte = Write.getFeePerByte (Write.recentEra @era) protocolParams + + txBaseSize = + estimateTxSize empty + + txInputCost = + marginalCostOf empty {txInputCount = 1} + + txInputSize = + marginalSizeOf empty {txInputCount = 1} + + txOutputCost bundle = + marginalCostOf empty {txOutputs = [mkTxOut bundle]} + + txOutputSize bundle = + marginalSizeOf empty {txOutputs = [mkTxOut bundle]} + + txOutputMaximumSize = Write.withConstraints era $ (<>) + (txOutputSize mempty) + (TxSize (protocolParams ^. Ledger.ppMaxValSizeL)) + + txOutputMaximumTokenQuantity = + TokenQuantity $ fromIntegral $ maxBound @Word64 + + txOutputMinimumAdaQuantity addr tokens = Convert.toWallet $ + Write.computeMinimumCoinForTxOut + era + protocolParams + (mkLedgerTxOut addr (TokenBundle txOutMaxCoin tokens)) + + txOutputBelowMinimumAdaQuantity addr bundle = + Write.isBelowMinimumCoinForTxOut + era + protocolParams + (mkLedgerTxOut addr bundle) + + txRewardWithdrawalCost = + _txRewardWithdrawalCost feePerByte (Right witnessTag) + + txRewardWithdrawalSize = + _txRewardWithdrawalSize (Right witnessTag) + + txMaximumSize = Write.withConstraints era $ + TxSize $ protocolParams ^. Ledger.ppMaxTxSizeL + + empty :: TxSkeleton + empty = TxSkeleton + { txWitnessTag = witnessTag + , txInputCount = 0 + , txOutputs = [] + , txChange = [] + , txPaymentTemplate = Nothing + } + + -- Computes the size difference between the given skeleton and an empty + -- skeleton. + marginalCostOf :: TxSkeleton -> Coin + marginalCostOf skeleton = + estimateTxCost feePerByte skeleton <\> + estimateTxCost feePerByte empty + + -- Computes the size difference between the given skeleton and an empty + -- skeleton. + marginalSizeOf :: TxSkeleton -> TxSize + marginalSizeOf = + (<\> txBaseSize) . estimateTxSize + + -- Constructs a real transaction output from a token bundle. + mkTxOut :: TokenBundle -> TxOut + mkTxOut = TxOut dummyAddress + where + dummyAddress :: Address + dummyAddress = Address $ BS.replicate dummyAddressLength nullByte + + dummyAddressLength :: Int + dummyAddressLength = 57 + -- Note: We are at liberty to overestimate the length of an address + -- (which is safe). Therefore, we can choose a length that we know is + -- greater than or equal to all address lengths. + + nullByte :: Word8 + nullByte = 0 + + mkLedgerTxOut + :: HasCallStack + => Address + -> TokenBundle + -> Write.TxOut (Write.ShelleyLedgerEra era) + mkLedgerTxOut address bundle = + case era of + Write.RecentEraBabbage -> Convert.toBabbageTxOut txOut + Write.RecentEraConway -> Convert.toConwayTxOut txOut + where + txOut = TxOut address bundle + +-- | Like the 'TxConstraints' field 'txRewardWithdrawalCost', but with added +-- support for shared wallets via the 'CA.ScriptTemplate' argument. +-- +-- We may or may not want to support shared wallets in the full txConstraints. +_txRewardWithdrawalCost + :: Write.FeePerByte + -> Either CA.ScriptTemplate TxWitnessTag + -> Coin + -> Coin +_txRewardWithdrawalCost feePerByte witType = + Convert.toWallet + . Write.feeOfBytes feePerByte + . unTxSize + . _txRewardWithdrawalSize witType + +-- | Like the 'TxConstraints' field 'txRewardWithdrawalSize', but with added +-- support for shared wallets via the 'CA.ScriptTemplate' argument. +-- +-- We may or may not want to support shared wallets in the full txConstraints. +_txRewardWithdrawalSize + :: Either CA.ScriptTemplate TxWitnessTag + -> Coin + -> TxSize +_txRewardWithdrawalSize _ (Coin 0) = TxSize 0 +_txRewardWithdrawalSize witType _ = + Write.sizeOf_Withdrawals 1 <> wits + where + wits = case witType of + Right TxWitnessByronUTxO -> + Write.sizeOf_BootstrapWitnesses 1 - + Write.sizeOf_BootstrapWitnesses 0 + Right TxWitnessShelleyUTxO -> + Write.sizeOf_VKeyWitnesses 1 + Left scriptTemplate -> + let n = fromIntegral + $ Write.estimateMaxWitnessRequiredPerInput + $ view #template scriptTemplate + in Write.sizeOf_VKeyWitnesses n + -- NOTE: Should probably not exist. We could consider replacing it with -- `UTxOAssumptions`, which has the benefit of containing the script template we -- often need in the case of shared wallets. `UTxOAssumptions` is difficult to diff --git a/lib/wallet/test/unit/Cardano/Wallet/Shelley/TransactionSpec.hs b/lib/wallet/test/unit/Cardano/Wallet/Shelley/TransactionSpec.hs index edbbfe24dfe..a4b5ac70c4d 100644 --- a/lib/wallet/test/unit/Cardano/Wallet/Shelley/TransactionSpec.hs +++ b/lib/wallet/test/unit/Cardano/Wallet/Shelley/TransactionSpec.hs @@ -120,6 +120,7 @@ import Cardano.Wallet.Shelley.Transaction , mkShelleyWitness , mkUnsignedTx , newTransactionLayer + , txConstraints ) import Cardano.Wallet.Transaction ( SelectionOf (..) @@ -140,7 +141,7 @@ import Cardano.Write.Tx.Balance import Cardano.Write.Tx.BalanceSpec ( mockPParamsForBalancing ) import Cardano.Write.Tx.SizeEstimation - ( TxSkeleton (..), estimateTxSize, txConstraints ) + ( TxSkeleton (..), estimateTxSize ) import Control.Arrow ( first ) import Control.Monad