From f1fb4a2e5b7a637fc98e617a028b54879dfcab3a Mon Sep 17 00:00:00 2001 From: Johannes Lund Date: Thu, 29 Jun 2023 14:29:58 +0200 Subject: [PATCH 1/2] Move estimateSignedTxSize etc to separate module --- .../Cardano/Wallet/Api/Http/Server/Error.hs | 4 +- lib/wallet/cardano-wallet.cabal | 1 + .../src/Cardano/Wallet/Shelley/Transaction.hs | 214 +-------------- .../src/Cardano/Wallet/Write/Tx/Balance.hs | 4 +- .../src/Cardano/Wallet/Write/Tx/Sign.hs | 259 ++++++++++++++++++ .../Cardano/Wallet/Shelley/TransactionSpec.hs | 5 +- 6 files changed, 270 insertions(+), 217 deletions(-) create mode 100644 lib/wallet/src/Cardano/Wallet/Write/Tx/Sign.hs diff --git a/lib/wallet/api/http/Cardano/Wallet/Api/Http/Server/Error.hs b/lib/wallet/api/http/Cardano/Wallet/Api/Http/Server/Error.hs index 0bccba41720..1a2305d897c 100644 --- a/lib/wallet/api/http/Cardano/Wallet/Api/Http/Server/Error.hs +++ b/lib/wallet/api/http/Cardano/Wallet/Api/Http/Server/Error.hs @@ -112,8 +112,6 @@ import Cardano.Wallet.Primitive.Types.TokenMap ( Flat (..) ) import Cardano.Wallet.Primitive.Types.Tx.SealedTx ( serialisedTx ) -import Cardano.Wallet.Shelley.Transaction - ( KeyWitnessCount (..) ) import Cardano.Wallet.Transaction ( ErrSignTx (..) ) import Cardano.Wallet.Write.Tx.Balance @@ -122,6 +120,8 @@ import Cardano.Wallet.Write.Tx.Balance , ErrBalanceTxInternalError (..) , ErrUpdateSealedTx (..) ) +import Cardano.Wallet.Write.Tx.Sign + ( KeyWitnessCount (..) ) import Control.Monad.Except ( ExceptT, lift, withExceptT ) import Control.Monad.Trans.Except diff --git a/lib/wallet/cardano-wallet.cabal b/lib/wallet/cardano-wallet.cabal index 67882a2def7..12ad8af60a5 100644 --- a/lib/wallet/cardano-wallet.cabal +++ b/lib/wallet/cardano-wallet.cabal @@ -412,6 +412,7 @@ library Cardano.Wallet.Write.Tx.Balance Cardano.Wallet.Write.Tx.Gen Cardano.Wallet.Write.Tx.Redeemers + Cardano.Wallet.Write.Tx.Sign Cardano.Wallet.Write.Tx.SizeEstimation Cardano.Wallet.Write.Tx.TimeTranslation Cardano.Wallet.Write.UTxOAssumptions diff --git a/lib/wallet/src/Cardano/Wallet/Shelley/Transaction.hs b/lib/wallet/src/Cardano/Wallet/Shelley/Transaction.hs index e004573fd56..0335b2c70a3 100644 --- a/lib/wallet/src/Cardano/Wallet/Shelley/Transaction.hs +++ b/lib/wallet/src/Cardano/Wallet/Shelley/Transaction.hs @@ -3,7 +3,6 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE DuplicateRecordFields #-} -{-# LANGUAGE EmptyCase #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE LambdaCase #-} @@ -36,9 +35,6 @@ module Cardano.Wallet.Shelley.Transaction ( newTransactionLayer -- * For balancing (To be moved) - , estimateKeyWitnessCount - , estimateSignedTxSize - , KeyWitnessCount (..) , distributeSurplus , distributeSurplusDelta , sizeOfCoin @@ -85,7 +81,7 @@ import Cardano.Binary import Cardano.Crypto.Wallet ( XPub ) import Cardano.Ledger.Allegra.Core - ( inputsTxBodyL, ppMinFeeAL ) + ( inputsTxBodyL ) import Cardano.Ledger.Crypto ( DSIGN ) import Cardano.Tx.Balance.Internal.CoinSelection @@ -99,8 +95,6 @@ import Cardano.Wallet.Address.Derivation.SharedKey ( replaceCosignersWithVerKeys ) import Cardano.Wallet.Address.Derivation.Shelley ( toRewardAccountRaw ) -import Cardano.Wallet.Address.Discovery.Shared - ( estimateMaxWitnessRequiredPerInput ) import Cardano.Wallet.Address.Keys.WalletKey ( getRawKey ) import Cardano.Wallet.Flavor @@ -124,7 +118,6 @@ import Cardano.Wallet.Primitive.Types.Tx , Tx (..) , cardanoTxIdeallyNoLaterThan , sealedTxFromCardano' - , sealedTxFromCardanoBody ) import Cardano.Wallet.Primitive.Types.Tx.Constraints ( TxSize (..), txOutMaxTokenQuantity ) @@ -151,7 +144,7 @@ import Cardano.Wallet.Shelley.Compatibility , toStakePoolDlgCert ) import Cardano.Wallet.Shelley.Compatibility.Ledger - ( Convert (..), toWalletCoin, toWalletScript ) + ( Convert (toLedger) ) import Cardano.Wallet.Transaction ( AnyExplicitScript (..) , AnyScript (..) @@ -174,7 +167,7 @@ import Cardano.Wallet.TxWitnessTag import Cardano.Wallet.Util ( HasCallStack, internalError ) import Cardano.Wallet.Write.Tx - ( FeePerByte (..), IsRecentEra (..), KeyWitnessCount (..), RecentEra (..) ) + ( FeePerByte (..) ) import Control.Arrow ( left, second ) import Control.Lens @@ -197,8 +190,6 @@ import Data.Maybe ( mapMaybe ) import Data.Type.Equality ( type (==) ) -import Numeric.Natural - ( Natural ) import Ouroboros.Network.Block ( SlotNo ) @@ -211,7 +202,6 @@ import qualified Cardano.Crypto as CC import qualified Cardano.Crypto.DSIGN as DSIGN import qualified Cardano.Crypto.Hash.Class as Crypto import qualified Cardano.Crypto.Wallet as Crypto.HD -import qualified Cardano.Ledger.Alonzo.Scripts as Alonzo import qualified Cardano.Ledger.Api as Ledger import qualified Cardano.Ledger.Keys.Bootstrap as SL import qualified Cardano.Wallet.Primitive.Types.Coin as Coin @@ -650,199 +640,6 @@ mkDelegationCertificates da cred = ] Quit -> [toStakeKeyDeregCert cred] --- | Estimate the size of the transaction (body) when fully signed. -estimateSignedTxSize - :: forall era. Write.IsRecentEra era - => Write.PParams (Write.ShelleyLedgerEra era) - -> KeyWitnessCount - -> Cardano.TxBody era - -> TxSize -estimateSignedTxSize pparams nWits body = - let - -- Hack which allows us to rely on the ledger to calculate the size of - -- witnesses: - feeOfWits :: Coin - feeOfWits = minfee nWits `Coin.difference` minfee mempty - - sizeOfWits :: TxSize - sizeOfWits = - case feeOfWits `coinQuotRem` feePerByte of - (n, 0) -> 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 :: TxSize - sizeOfTx = TxSize - . fromIntegral - . BS.length - . serialisedTx - $ sealedTxFromCardanoBody body - in - sizeOfTx <> sizeOfWits - where - coinQuotRem :: Coin -> Coin -> (Natural, Natural) - coinQuotRem (Coin p) (Coin q) = quotRem p q - - minfee :: KeyWitnessCount -> Coin - minfee witCount = toWalletCoin $ Write.evaluateMinimumFee - (Write.recentEra @era) pparams (toLedgerTx body) witCount - - toLedgerTx :: Cardano.TxBody era -> Write.Tx (Write.ShelleyLedgerEra era) - toLedgerTx b = case Cardano.Tx b [] of - Byron.ByronTx {} -> case Write.recentEra @era of {} - Cardano.ShelleyTx _era ledgerTx -> ledgerTx - - feePerByte :: Coin - feePerByte = toWalletCoin $ - case Write.recentEra @era of - Write.RecentEraBabbage -> pparams ^. ppMinFeeAL - Write.RecentEraConway -> pparams ^. ppMinFeeAL - -numberOfShelleyWitnesses :: Word -> KeyWitnessCount -numberOfShelleyWitnesses n = KeyWitnessCount n 0 - --- | Estimates the required number of Shelley-era witnesses. --- --- Because we don't take into account whether two pieces of tx content will need --- the same key for signing, the result may be an overestimate. --- --- For instance, this may happen if: --- 1. Multiple inputs share the same payment key (like in a single address --- wallet) --- 2. We are updating our delegation and withdrawing rewards at the same time. --- --- FIXME [ADP-1515] Improve estimation --- --- NOTE: Similar to 'estimateTransactionKeyWitnessCount' from cardano-api, which --- we cannot use because it requires a 'TxBodyContent BuildTx era'. -estimateKeyWitnessCount - :: forall era. IsRecentEra era - => Cardano.UTxO era - -- ^ Must contain all inputs from the 'TxBody' or - -- 'estimateKeyWitnessCount will 'error'. - -> Cardano.TxBody era - -> KeyWitnessCount -estimateKeyWitnessCount utxo txbody@(Cardano.TxBody txbodycontent) = - let txIns = map fst $ Cardano.txIns txbodycontent - txInsCollateral = - case Cardano.txInsCollateral txbodycontent of - Cardano.TxInsCollateral _ ins -> ins - Cardano.TxInsCollateralNone -> [] - vkInsUnique = L.nub $ filter (hasVkPaymentCred utxo) $ - txIns ++ txInsCollateral - txExtraKeyWits = Cardano.txExtraKeyWits txbodycontent - txExtraKeyWits' = case txExtraKeyWits of - Cardano.TxExtraKeyWitnesses _ khs -> khs - _ -> [] - txWithdrawals = Cardano.txWithdrawals txbodycontent - txWithdrawals' = case txWithdrawals of - Cardano.TxWithdrawals _ wdls -> - [ () | (_, _, Cardano.ViewTx) <- wdls ] - _ -> [] - txUpdateProposal = Cardano.txUpdateProposal txbodycontent - txUpdateProposal' = case txUpdateProposal of - Cardano.TxUpdateProposal _ - (Cardano.UpdateProposal updatePerGenesisKey _) -> - Map.size updatePerGenesisKey - _ -> 0 - txCerts = case Cardano.txCertificates txbodycontent of - Cardano.TxCertificatesNone -> 0 - Cardano.TxCertificates _ certs _ -> - sumVia estimateDelegSigningKeys certs - scriptVkWitsUpperBound = - fromIntegral - $ sumVia estimateMaxWitnessRequiredPerInput - $ mapMaybe toTimelockScript scripts - nonInputWits = numberOfShelleyWitnesses $ fromIntegral $ - length txExtraKeyWits' + - length txWithdrawals' + - txUpdateProposal' + - fromIntegral txCerts + - scriptVkWitsUpperBound - inputWits = KeyWitnessCount - { nKeyWits = fromIntegral - . length - $ filter (not . hasBootstrapAddr utxo) vkInsUnique - , nBootstrapWits = fromIntegral - . length - $ filter (hasBootstrapAddr utxo) vkInsUnique - } - in - nonInputWits <> inputWits - where - scripts = case txbody of - Cardano.ShelleyTxBody _ _ shelleyBodyScripts _ _ _ -> shelleyBodyScripts - Byron.ByronTxBody {} -> error "estimateKeyWitnessCount: ByronTxBody" - - dummyKeyRole = Payment - - - estimateDelegSigningKeys :: Cardano.Certificate -> Integer - estimateDelegSigningKeys = \case - Cardano.StakeAddressRegistrationCertificate _ -> 0 - Cardano.StakeAddressDeregistrationCertificate cred -> - estimateWitNumForCred cred - Cardano.StakeAddressPoolDelegationCertificate cred _ -> - estimateWitNumForCred cred - _ -> 1 - where - -- Does not include the key witness needed for script credentials. - -- They are accounted for separately in @scriptVkWitsUpperBound@. - estimateWitNumForCred = \case - Cardano.StakeCredentialByKey _ -> 1 - Cardano.StakeCredentialByScript _ -> 0 - - - toTimelockScript - :: Ledger.Script (Cardano.ShelleyLedgerEra era) - -> Maybe (Script KeyHash) - toTimelockScript anyScript = case recentEra @era of - RecentEraConway -> - case anyScript of - Alonzo.TimelockScript timelock -> - Just $ toWalletScript (const dummyKeyRole) timelock - Alonzo.PlutusScript _ _ -> Nothing - RecentEraBabbage -> - case anyScript of - Alonzo.TimelockScript timelock -> - Just $ toWalletScript (const dummyKeyRole) timelock - Alonzo.PlutusScript _ _ -> Nothing - - hasVkPaymentCred - :: Cardano.UTxO era - -> Cardano.TxIn - -> Bool - hasVkPaymentCred (Cardano.UTxO u) inp = case Map.lookup inp u of - Just (Cardano.TxOut addrInEra _ _ _) -> Cardano.isKeyAddress addrInEra - Nothing -> - error $ unwords - [ "estimateMaxWitnessRequiredPerInput: input not in utxo." - , "Caller is expected to ensure this does not happen." - ] - - hasBootstrapAddr - :: Cardano.UTxO era - -> Cardano.TxIn - -> Bool - hasBootstrapAddr (Cardano.UTxO u) inp = case Map.lookup inp u of - Just (Cardano.TxOut addrInEra _ _ _) -> - case addrInEra of - Cardano.AddressInEra Cardano.ByronAddressInAnyEra _ -> True - _ -> False - Nothing -> - error $ unwords - [ "estimateMaxWitnessRequiredPerInput: input not in utxo." - , "Caller is expected to ensure this does not happen." - ] - -- | Calculate the cost of increasing a CBOR-encoded Coin-value by another Coin -- with the lovelace/byte cost given by the 'FeePolicy'. -- @@ -1426,8 +1223,3 @@ explicitFees era = case era of Cardano.TxFeeExplicit Cardano.TxFeesExplicitInBabbageEra ShelleyBasedEraConway -> Cardano.TxFeeExplicit Cardano.TxFeesExplicitInConwayEra - --- Small helper function for summing values. Given a list of values, get the sum --- of the values, after the given function has been applied to each value. -sumVia :: (Foldable t, Num m) => (a -> m) -> t a -> m -sumVia f = F.foldl' (\t -> (t +) . f) 0 diff --git a/lib/wallet/src/Cardano/Wallet/Write/Tx/Balance.hs b/lib/wallet/src/Cardano/Wallet/Write/Tx/Balance.hs index c70ff9a4464..6a75d5f1a61 100644 --- a/lib/wallet/src/Cardano/Wallet/Write/Tx/Balance.hs +++ b/lib/wallet/src/Cardano/Wallet/Write/Tx/Balance.hs @@ -109,7 +109,7 @@ import Cardano.Wallet.Read.Primitive.Tx.Features.Outputs import Cardano.Wallet.Shelley.Compatibility ( fromCardanoTxIn, fromCardanoTxOut, toCardanoSimpleScript, toCardanoUTxO ) import Cardano.Wallet.Shelley.Transaction - ( distributeSurplus, estimateKeyWitnessCount, estimateSignedTxSize ) + ( distributeSurplus ) import Cardano.Wallet.Transaction ( ErrMoreSurplusNeeded (..), TxFeeAndChange (..) ) import Cardano.Wallet.Write.ProtocolParameters @@ -140,6 +140,8 @@ import Cardano.Wallet.Write.Tx ) import Cardano.Wallet.Write.Tx.Redeemers ( ErrAssignRedeemers (..), assignScriptRedeemers ) +import Cardano.Wallet.Write.Tx.Sign + ( estimateKeyWitnessCount, estimateSignedTxSize ) import Cardano.Wallet.Write.Tx.SizeEstimation ( TxSkeleton (..), estimateTxCost ) import Cardano.Wallet.Write.Tx.TimeTranslation diff --git a/lib/wallet/src/Cardano/Wallet/Write/Tx/Sign.hs b/lib/wallet/src/Cardano/Wallet/Write/Tx/Sign.hs new file mode 100644 index 00000000000..3cb48dbd8e3 --- /dev/null +++ b/lib/wallet/src/Cardano/Wallet/Write/Tx/Sign.hs @@ -0,0 +1,259 @@ +{-# LANGUAGE EmptyCase #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} + +-- | +-- Copyright: © 2023 IOHK, 2023 Cardano Foundation +-- License: Apache-2.0 +-- +-- Module for 'signTx' and signing-related utilities for balancing. +module Cardano.Wallet.Write.Tx.Sign + ( + -- * Signing transactions + -- TODO: Move signTx function here + + -- * Signing-related utilities required for balancing + estimateSignedTxSize + + , KeyWitnessCount (..) + , estimateKeyWitnessCount + ) + where + +import Prelude + +import Cardano.Ledger.Api + ( ppMinFeeAL ) +import Cardano.Wallet.Address.Discovery.Shared + ( estimateMaxWitnessRequiredPerInput ) +import qualified Cardano.Wallet.Primitive.Types.Coin as W + ( Coin (..) ) +import Cardano.Wallet.Primitive.Types.Tx + ( sealedTxFromCardanoBody, serialisedTx ) +import Cardano.Wallet.Primitive.Types.Tx.Constraints + ( TxSize (..) ) +import Cardano.Wallet.Shelley.Compatibility.Ledger + ( toWalletCoin, toWalletScript ) +import Cardano.Wallet.Write.Tx + ( IsRecentEra (..), KeyWitnessCount (..), RecentEra (..) ) +import Control.Lens + ( (^.) ) +import Data.Maybe + ( mapMaybe ) +import Numeric.Natural + ( Natural ) + +import qualified Cardano.Address.Script as CA +import qualified Cardano.Api as Cardano +import qualified Cardano.Api.Byron as Byron +import qualified Cardano.Api.Shelley as Cardano +import qualified Cardano.Ledger.Alonzo.Scripts as Alonzo +import qualified Cardano.Ledger.Api as Ledger +import qualified Cardano.Wallet.Primitive.Types.Coin as W.Coin +import qualified Cardano.Wallet.Shelley.Compatibility.Ledger as Ledger +import qualified Cardano.Wallet.Write.Tx as Write +import qualified Data.ByteString as BS +import qualified Data.Foldable as F +import qualified Data.List as L +import qualified Data.Map as Map + +-- | Estimate the size of the transaction (body) when fully signed. +estimateSignedTxSize + :: forall era. Write.IsRecentEra era + => Write.PParams (Write.ShelleyLedgerEra era) + -> KeyWitnessCount + -> Cardano.TxBody era + -> TxSize +estimateSignedTxSize pparams nWits body = + let + -- Hack which allows us to rely on the ledger to calculate the size of + -- witnesses: + feeOfWits :: W.Coin + feeOfWits = minfee nWits `W.Coin.difference` minfee mempty + + sizeOfWits :: TxSize + sizeOfWits = + case feeOfWits `coinQuotRem` feePerByte of + (n, 0) -> 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 :: TxSize + sizeOfTx = TxSize + . fromIntegral + . BS.length + . serialisedTx + $ sealedTxFromCardanoBody body + in + sizeOfTx <> sizeOfWits + where + coinQuotRem :: W.Coin -> W.Coin -> (Natural, Natural) + coinQuotRem (W.Coin p) (W.Coin q) = quotRem p q + + minfee :: KeyWitnessCount -> W.Coin + minfee witCount = toWalletCoin $ Write.evaluateMinimumFee + (recentEra @era) pparams (toLedgerTx body) witCount + + toLedgerTx :: Cardano.TxBody era -> Write.Tx (Write.ShelleyLedgerEra era) + toLedgerTx b = case Cardano.Tx b [] of + Byron.ByronTx {} -> case Write.recentEra @era of {} + Cardano.ShelleyTx _era ledgerTx -> ledgerTx + + feePerByte :: W.Coin + feePerByte = Ledger.toWalletCoin $ + case Write.recentEra @era of + Write.RecentEraBabbage -> pparams ^. ppMinFeeAL + Write.RecentEraConway -> pparams ^. ppMinFeeAL + +numberOfShelleyWitnesses :: Word -> KeyWitnessCount +numberOfShelleyWitnesses n = KeyWitnessCount n 0 + +-- | Estimates the required number of Shelley-era witnesses. +-- +-- Because we don't take into account whether two pieces of tx content will need +-- the same key for signing, the result may be an overestimate. +-- +-- For instance, this may happen if: +-- 1. Multiple inputs share the same payment key (like in a single address +-- wallet) +-- 2. We are updating our delegation and withdrawing rewards at the same time. +-- +-- FIXME [ADP-1515] Improve estimation +-- +-- NOTE: Similar to 'estimateTransactionKeyWitnessCount' from cardano-api, which +-- we cannot use because it requires a 'TxBodyContent BuildTx era'. +estimateKeyWitnessCount + :: forall era. IsRecentEra era + => Cardano.UTxO era + -- ^ Must contain all inputs from the 'TxBody' or + -- 'estimateKeyWitnessCount will 'error'. + -> Cardano.TxBody era + -> KeyWitnessCount +estimateKeyWitnessCount utxo txbody@(Cardano.TxBody txbodycontent) = + let txIns = map fst $ Cardano.txIns txbodycontent + txInsCollateral = + case Cardano.txInsCollateral txbodycontent of + Cardano.TxInsCollateral _ ins -> ins + Cardano.TxInsCollateralNone -> [] + vkInsUnique = L.nub $ filter (hasVkPaymentCred utxo) $ + txIns ++ txInsCollateral + txExtraKeyWits = Cardano.txExtraKeyWits txbodycontent + txExtraKeyWits' = case txExtraKeyWits of + Cardano.TxExtraKeyWitnesses _ khs -> khs + _ -> [] + txWithdrawals = Cardano.txWithdrawals txbodycontent + txWithdrawals' = case txWithdrawals of + Cardano.TxWithdrawals _ wdls -> + [ () | (_, _, Cardano.ViewTx) <- wdls ] + _ -> [] + txUpdateProposal = Cardano.txUpdateProposal txbodycontent + txUpdateProposal' = case txUpdateProposal of + Cardano.TxUpdateProposal _ + (Cardano.UpdateProposal updatePerGenesisKey _) -> + Map.size updatePerGenesisKey + _ -> 0 + txCerts = case Cardano.txCertificates txbodycontent of + Cardano.TxCertificatesNone -> 0 + Cardano.TxCertificates _ certs _ -> + sumVia estimateDelegSigningKeys certs + scriptVkWitsUpperBound = + fromIntegral + $ sumVia estimateMaxWitnessRequiredPerInput + $ mapMaybe toTimelockScript scripts + nonInputWits = numberOfShelleyWitnesses $ fromIntegral $ + length txExtraKeyWits' + + length txWithdrawals' + + txUpdateProposal' + + fromIntegral txCerts + + scriptVkWitsUpperBound + inputWits = KeyWitnessCount + { nKeyWits = fromIntegral + . length + $ filter (not . hasBootstrapAddr utxo) vkInsUnique + , nBootstrapWits = fromIntegral + . length + $ filter (hasBootstrapAddr utxo) vkInsUnique + } + in + nonInputWits <> inputWits + where + scripts = case txbody of + Cardano.ShelleyTxBody _ _ shelleyBodyScripts _ _ _ -> shelleyBodyScripts + Byron.ByronTxBody {} -> error "estimateKeyWitnessCount: ByronTxBody" + + dummyKeyRole = CA.Payment + + estimateDelegSigningKeys :: Cardano.Certificate -> Integer + estimateDelegSigningKeys = \case + Cardano.StakeAddressRegistrationCertificate _ -> 0 + Cardano.StakeAddressDeregistrationCertificate cred -> + estimateWitNumForCred cred + Cardano.StakeAddressPoolDelegationCertificate cred _ -> + estimateWitNumForCred cred + _ -> 1 + where + -- Does not include the key witness needed for script credentials. + -- They are accounted for separately in @scriptVkWitsUpperBound@. + estimateWitNumForCred = \case + Cardano.StakeCredentialByKey _ -> 1 + Cardano.StakeCredentialByScript _ -> 0 + toTimelockScript + :: Ledger.Script (Cardano.ShelleyLedgerEra era) + -> Maybe (CA.Script CA.KeyHash) + toTimelockScript anyScript = case recentEra @era of + RecentEraConway -> + case anyScript of + Alonzo.TimelockScript timelock -> + Just $ toWalletScript (const dummyKeyRole) timelock + Alonzo.PlutusScript _ _ -> Nothing + RecentEraBabbage -> + case anyScript of + Alonzo.TimelockScript timelock -> + Just $ toWalletScript (const dummyKeyRole) timelock + Alonzo.PlutusScript _ _ -> Nothing + + hasVkPaymentCred + :: Cardano.UTxO era + -> Cardano.TxIn + -> Bool + hasVkPaymentCred (Cardano.UTxO u) inp = case Map.lookup inp u of + Just (Cardano.TxOut addrInEra _ _ _) -> Cardano.isKeyAddress addrInEra + Nothing -> + error $ unwords + [ "estimateMaxWitnessRequiredPerInput: input not in utxo." + , "Caller is expected to ensure this does not happen." + ] + + hasBootstrapAddr + :: Cardano.UTxO era + -> Cardano.TxIn + -> Bool + hasBootstrapAddr (Cardano.UTxO u) inp = case Map.lookup inp u of + Just (Cardano.TxOut addrInEra _ _ _) -> + case addrInEra of + Cardano.AddressInEra Cardano.ByronAddressInAnyEra _ -> True + _ -> False + Nothing -> + error $ unwords + [ "estimateMaxWitnessRequiredPerInput: input not in utxo." + , "Caller is expected to ensure this does not happen." + ] + +-------------------------------------------------------------------------------- +-- Helpers +-------------------------------------------------------------------------------- + +-- Small helper function for summing values. Given a list of values, get the sum +-- of the values, after the given function has been applied to each value. +sumVia :: (Foldable t, Num m) => (a -> m) -> t a -> m +sumVia f = F.foldl' (\t -> (t +) . f) 0 diff --git a/lib/wallet/test/unit/Cardano/Wallet/Shelley/TransactionSpec.hs b/lib/wallet/test/unit/Cardano/Wallet/Shelley/TransactionSpec.hs index a608afdce0d..5560a198f4d 100644 --- a/lib/wallet/test/unit/Cardano/Wallet/Shelley/TransactionSpec.hs +++ b/lib/wallet/test/unit/Cardano/Wallet/Shelley/TransactionSpec.hs @@ -236,13 +236,10 @@ import Cardano.Wallet.Shelley.Compatibility.Ledger import Cardano.Wallet.Shelley.Transaction ( EraConstraints - , KeyWitnessCount (..) , TxWitnessTag (..) , costOfIncreasingCoin , distributeSurplus , distributeSurplusDelta - , estimateKeyWitnessCount - , estimateSignedTxSize , maximumCostOfIncreasingCoin , mkByronWitness , mkDelegationCertificates @@ -286,6 +283,8 @@ import Cardano.Wallet.Write.Tx.Balance , posAndNegFromCardanoValue , updateTx ) +import Cardano.Wallet.Write.Tx.Sign + ( KeyWitnessCount (..), estimateKeyWitnessCount, estimateSignedTxSize ) import Cardano.Wallet.Write.Tx.SizeEstimation ( TxSkeleton (..) , estimateTxSize From 46f6c932cb3e79c1dc83c24246b93e2c7c167abc Mon Sep 17 00:00:00 2001 From: Johannes Lund Date: Wed, 12 Jul 2023 13:47:34 +0200 Subject: [PATCH 2/2] Fix documentation --- lib/wallet/src/Cardano/Wallet/Write/Tx/Sign.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/wallet/src/Cardano/Wallet/Write/Tx/Sign.hs b/lib/wallet/src/Cardano/Wallet/Write/Tx/Sign.hs index 3cb48dbd8e3..80a71b5aa76 100644 --- a/lib/wallet/src/Cardano/Wallet/Write/Tx/Sign.hs +++ b/lib/wallet/src/Cardano/Wallet/Write/Tx/Sign.hs @@ -59,7 +59,7 @@ import qualified Data.Foldable as F import qualified Data.List as L import qualified Data.Map as Map --- | Estimate the size of the transaction (body) when fully signed. +-- | Estimate the size of the transaction when fully signed. estimateSignedTxSize :: forall era. Write.IsRecentEra era => Write.PParams (Write.ShelleyLedgerEra era)