From 83bb8a777c4a0eb22e655ad4433f5104895dd6b5 Mon Sep 17 00:00:00 2001 From: Johannes Lund Date: Tue, 8 Aug 2023 14:14:26 +0200 Subject: [PATCH 01/16] Use `sizeAlonzoTxF` instead of `length $ serializedTx` --- .../src/Cardano/Wallet/Write/Tx/Balance.hs | 23 ++++++------ .../src/Cardano/Wallet/Write/Tx/Sign.hs | 36 +++++++++---------- .../Cardano/Wallet/Shelley/TransactionSpec.hs | 10 +++--- 3 files changed, 34 insertions(+), 35 deletions(-) diff --git a/lib/wallet/src/Cardano/Wallet/Write/Tx/Balance.hs b/lib/wallet/src/Cardano/Wallet/Write/Tx/Balance.hs index bb95e0c7e56..24bcaa3bc9b 100644 --- a/lib/wallet/src/Cardano/Wallet/Write/Tx/Balance.hs +++ b/lib/wallet/src/Cardano/Wallet/Write/Tx/Balance.hs @@ -680,12 +680,13 @@ balanceTransactionWithSelectionStrategyAndNoZeroAdaAdjustment :: KeyWitnessCount -> Cardano.Tx era -> ExceptT ErrBalanceTx m (Cardano.Tx era) - guardTxSize witCount tx@(Cardano.Tx body _noKeyWits) = - withConstraints (recentEra @era) $ do + guardTxSize witCount cardanoTx = + withConstraints era $ do + let tx = fromCardanoTx cardanoTx let maxSize = TxSize (pp ^. ppMaxTxSizeL) - when (estimateSignedTxSize pp witCount body > maxSize) $ + when (estimateSignedTxSize era pp witCount tx > maxSize) $ throwE ErrBalanceTxMaxSizeLimitExceeded - pure tx + pure cardanoTx guardTxBalanced :: Cardano.Tx era -> ExceptT ErrBalanceTx m (Cardano.Tx era) guardTxBalanced tx = do @@ -697,8 +698,8 @@ balanceTransactionWithSelectionStrategyAndNoZeroAdaAdjustment txBalance :: Cardano.Tx era -> Cardano.Value txBalance = toCardanoValue @era - . evaluateTransactionBalance (recentEra @era) pp combinedUTxO - . txBody (recentEra @era) + . evaluateTransactionBalance era pp combinedUTxO + . txBody era . fromCardanoTx balanceAfterSettingMinFee @@ -708,7 +709,7 @@ balanceTransactionWithSelectionStrategyAndNoZeroAdaAdjustment balanceAfterSettingMinFee tx = ExceptT . pure $ do let witCount = estimateKeyWitnessCount combinedUTxO (getBody tx) minfee = W.toWalletCoin $ evaluateMinimumFee - (recentEra @era) pp (fromCardanoTx tx) witCount + era pp (fromCardanoTx tx) witCount update = TxUpdate [] [] [] [] (UseNewTxFee minfee) tx' <- left ErrBalanceTxUpdateError $ updateTx tx update let balance = txBalance tx' @@ -754,14 +755,14 @@ balanceTransactionWithSelectionStrategyAndNoZeroAdaAdjustment ] extractOutputsFromTx :: Cardano.Tx era -> [W.TxOut] - extractOutputsFromTx (Cardano.ByronTx _) = case recentEra @era of {} + extractOutputsFromTx (Cardano.ByronTx _) = case era of {} extractOutputsFromTx (Cardano.ShelleyTx _ tx) = map fromLedgerTxOut - $ outputs (recentEra @era) - $ txBody (recentEra @era) tx + $ outputs era + $ txBody era tx where fromLedgerTxOut :: TxOut (ShelleyLedgerEra era) -> W.TxOut - fromLedgerTxOut o = case recentEra @era of + fromLedgerTxOut o = case era of RecentEraBabbage -> W.fromBabbageTxOut o RecentEraConway -> W.fromConwayTxOut o diff --git a/lib/wallet/src/Cardano/Wallet/Write/Tx/Sign.hs b/lib/wallet/src/Cardano/Wallet/Write/Tx/Sign.hs index 99342244522..fd17ce4c61f 100644 --- a/lib/wallet/src/Cardano/Wallet/Write/Tx/Sign.hs +++ b/lib/wallet/src/Cardano/Wallet/Write/Tx/Sign.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE EmptyCase #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE ScopedTypeVariables #-} @@ -27,6 +26,8 @@ module Cardano.Wallet.Write.Tx.Sign import Prelude +import Cardano.Ledger.Alonzo.Tx + ( sizeAlonzoTxF ) import Cardano.Ledger.Api ( Addr (..), addrTxOutL, ppMinFeeAL ) import Cardano.Ledger.Credential @@ -35,8 +36,6 @@ import Cardano.Ledger.UTxO ( txinLookup ) 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 @@ -44,8 +43,10 @@ import Cardano.Wallet.Shelley.Compatibility.Ledger import Cardano.Wallet.Write.Tx ( IsRecentEra (..) , KeyWitnessCount (..) + , PParams , RecentEra (..) , ShelleyLedgerEra + , Tx , TxIn , UTxO , withConstraints @@ -66,19 +67,18 @@ 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 when fully signed. estimateSignedTxSize - :: forall era. Write.IsRecentEra era - => Write.PParams (Write.ShelleyLedgerEra era) + :: forall era. RecentEra era + -> PParams (ShelleyLedgerEra era) -> KeyWitnessCount - -> Cardano.TxBody era + -> Tx (ShelleyLedgerEra era) -> TxSize -estimateSignedTxSize pparams nWits body = +estimateSignedTxSize era pparams nWits tx = withConstraints era $ let -- Hack which allows us to rely on the ledger to calculate the size of -- witnesses: @@ -100,12 +100,13 @@ estimateSignedTxSize pparams nWits body = , show feePerByte , "lovelace/byte" ] + -- When updating to a new era, check that the choice of encoding still + -- seems right w.r.t the ledger. Types will /probably/ but not + -- /necessarily/ protect against calling the wrong function. sizeOfTx :: TxSize - sizeOfTx = TxSize - . fromIntegral - . BS.length - . serialisedTx - $ sealedTxFromCardanoBody body + sizeOfTx = fromIntegral @Integer @TxSize $ case era of + RecentEraBabbage -> tx ^. sizeAlonzoTxF + RecentEraConway -> tx ^. sizeAlonzoTxF in sizeOfTx <> sizeOfWits where @@ -114,16 +115,11 @@ estimateSignedTxSize pparams nWits body = 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 + era pparams tx witCount feePerByte :: W.Coin feePerByte = Ledger.toWalletCoin $ - case Write.recentEra @era of + case era of Write.RecentEraBabbage -> pparams ^. ppMinFeeAL Write.RecentEraConway -> pparams ^. ppMinFeeAL diff --git a/lib/wallet/test/unit/Cardano/Wallet/Shelley/TransactionSpec.hs b/lib/wallet/test/unit/Cardano/Wallet/Shelley/TransactionSpec.hs index 64c612d047e..10fc9f52d16 100644 --- a/lib/wallet/test/unit/Cardano/Wallet/Shelley/TransactionSpec.hs +++ b/lib/wallet/test/unit/Cardano/Wallet/Shelley/TransactionSpec.hs @@ -3343,10 +3343,11 @@ prop_balanceTransactionValid -> Write.UTxO (Write.ShelleyLedgerEra era) -> Property prop_validSize tx@(Cardano.Tx body _) utxo = do + let era = recentEra @era let (TxSize size) = - estimateSignedTxSize ledgerPParams + estimateSignedTxSize era ledgerPParams (estimateKeyWitnessCount utxo body) - body + (Write.fromCardanoTx tx) let limit = ledgerPParams ^. ppMaxTxSizeL let msg = unwords [ "The tx size " @@ -3736,10 +3737,11 @@ estimateSignedTxSizeSpec = describe "estimateSignedTxSize" $ do -> ByteString -> Cardano.Tx era -> IO () - test _name bs tx@(Cardano.Tx (body :: Cardano.TxBody era) _) = do + test _name bs tx@(Cardano.Tx body _) = do let pparams = Write.pparamsLedger $ mockPParamsForBalancing @era utxo = utxoPromisingInputsHaveVkPaymentCreds body witCount = estimateKeyWitnessCount (Write.fromCardanoUTxO utxo) body + era = recentEra @era ledgerTx :: Write.Tx (Write.ShelleyLedgerEra era) ledgerTx = Write.fromCardanoTx @era tx @@ -3753,7 +3755,7 @@ estimateSignedTxSizeSpec = describe "estimateSignedTxSize" $ do case (noScripts, noBootWits) of (True, True) -> do - estimateSignedTxSize pparams witCount body + estimateSignedTxSize era pparams witCount ledgerTx `shouldBe` TxSize (fromIntegral (BS.length bs)) (False, False) -> testDoesNotYetSupport "bootstrap wits + scripts" From c2e62aa17fb2b3b53627743265d0dff83058af3c Mon Sep 17 00:00:00 2001 From: Johannes Lund Date: Mon, 14 Aug 2023 20:52:18 +0200 Subject: [PATCH 02/16] fix: ignore existing key wits in estimateSignedTxSize --- lib/wallet/src/Cardano/Wallet/Write/Tx/Sign.hs | 15 ++++++++++----- 1 file changed, 10 insertions(+), 5 deletions(-) diff --git a/lib/wallet/src/Cardano/Wallet/Write/Tx/Sign.hs b/lib/wallet/src/Cardano/Wallet/Write/Tx/Sign.hs index fd17ce4c61f..7912d5d2445 100644 --- a/lib/wallet/src/Cardano/Wallet/Write/Tx/Sign.hs +++ b/lib/wallet/src/Cardano/Wallet/Write/Tx/Sign.hs @@ -29,7 +29,7 @@ import Prelude import Cardano.Ledger.Alonzo.Tx ( sizeAlonzoTxF ) import Cardano.Ledger.Api - ( Addr (..), addrTxOutL, ppMinFeeAL ) + ( Addr (..), addrTxOutL, ppMinFeeAL, witsTxL ) import Cardano.Ledger.Credential ( Credential (..) ) import Cardano.Ledger.UTxO @@ -52,7 +52,7 @@ import Cardano.Wallet.Write.Tx , withConstraints ) import Control.Lens - ( view, (^.) ) + ( view, (&), (.~), (^.) ) import Data.Maybe ( mapMaybe ) import Numeric.Natural @@ -72,11 +72,13 @@ import qualified Data.List as L import qualified Data.Map as Map -- | Estimate the size of the transaction when fully signed. +-- +-- NOTE: Existing key witnesses in the tx are ignored. estimateSignedTxSize :: forall era. RecentEra era -> PParams (ShelleyLedgerEra era) -> KeyWitnessCount - -> Tx (ShelleyLedgerEra era) + -> Tx (ShelleyLedgerEra era) -- ^ existing wits in tx are ignored -> TxSize estimateSignedTxSize era pparams nWits tx = withConstraints era $ let @@ -100,13 +102,16 @@ estimateSignedTxSize era pparams nWits tx = withConstraints era $ , show feePerByte , "lovelace/byte" ] + + unsignedTx = tx & witsTxL .~ mempty + -- When updating to a new era, check that the choice of encoding still -- seems right w.r.t the ledger. Types will /probably/ but not -- /necessarily/ protect against calling the wrong function. sizeOfTx :: TxSize sizeOfTx = fromIntegral @Integer @TxSize $ case era of - RecentEraBabbage -> tx ^. sizeAlonzoTxF - RecentEraConway -> tx ^. sizeAlonzoTxF + RecentEraBabbage -> unsignedTx ^. sizeAlonzoTxF + RecentEraConway -> unsignedTx ^. sizeAlonzoTxF in sizeOfTx <> sizeOfWits where From 4959e8a192724ab7600016d48f35f655e5cf47d6 Mon Sep 17 00:00:00 2001 From: Johannes Lund Date: Mon, 14 Aug 2023 21:00:36 +0200 Subject: [PATCH 03/16] Allow some size difference in goldens --- .../test/unit/Cardano/Wallet/Shelley/TransactionSpec.hs | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/lib/wallet/test/unit/Cardano/Wallet/Shelley/TransactionSpec.hs b/lib/wallet/test/unit/Cardano/Wallet/Shelley/TransactionSpec.hs index 10fc9f52d16..98ddf514e8a 100644 --- a/lib/wallet/test/unit/Cardano/Wallet/Shelley/TransactionSpec.hs +++ b/lib/wallet/test/unit/Cardano/Wallet/Shelley/TransactionSpec.hs @@ -3757,10 +3757,15 @@ estimateSignedTxSizeSpec = describe "estimateSignedTxSize" $ do (True, True) -> do estimateSignedTxSize era pparams witCount ledgerTx `shouldBe` - TxSize (fromIntegral (BS.length bs)) + TxSize (fromIntegral (BS.length bs) - correction) (False, False) -> testDoesNotYetSupport "bootstrap wits + scripts" (True, False) -> testDoesNotYetSupport "bootstrap wits" (False, True) -> testDoesNotYetSupport "scripts" + where + -- Apparently the cbor encoding used by the ledger for size-checks + -- (`toCBORForSizeComputation`) is a few bytes smaller than the actual + -- serialized size for these goldens. + correction = 3 forAllGoldens :: [(String, ByteString)] From 65f86a4f740da52155496fc7a07851b45f84b0d0 Mon Sep 17 00:00:00 2001 From: Johannes Lund Date: Tue, 15 Aug 2023 18:21:53 +0200 Subject: [PATCH 04/16] fixup --- .../src/Cardano/Wallet/Write/Tx/Sign.hs | 11 +++++++---- .../Cardano/Wallet/Shelley/TransactionSpec.hs | 19 ++++++++++++++++--- 2 files changed, 23 insertions(+), 7 deletions(-) diff --git a/lib/wallet/src/Cardano/Wallet/Write/Tx/Sign.hs b/lib/wallet/src/Cardano/Wallet/Write/Tx/Sign.hs index 7912d5d2445..c7ca7fb9d1a 100644 --- a/lib/wallet/src/Cardano/Wallet/Write/Tx/Sign.hs +++ b/lib/wallet/src/Cardano/Wallet/Write/Tx/Sign.hs @@ -29,7 +29,7 @@ import Prelude import Cardano.Ledger.Alonzo.Tx ( sizeAlonzoTxF ) import Cardano.Ledger.Api - ( Addr (..), addrTxOutL, ppMinFeeAL, witsTxL ) + ( Addr (..), addrTxOutL, addrTxWitsL, ppMinFeeAL, witsTxL ) import Cardano.Ledger.Credential ( Credential (..) ) import Cardano.Ledger.UTxO @@ -80,7 +80,7 @@ estimateSignedTxSize -> KeyWitnessCount -> Tx (ShelleyLedgerEra era) -- ^ existing wits in tx are ignored -> TxSize -estimateSignedTxSize era pparams nWits tx = withConstraints era $ +estimateSignedTxSize era pparams nWits txWithWits = withConstraints era $ let -- Hack which allows us to rely on the ledger to calculate the size of -- witnesses: @@ -103,7 +103,6 @@ estimateSignedTxSize era pparams nWits tx = withConstraints era $ , "lovelace/byte" ] - unsignedTx = tx & witsTxL .~ mempty -- When updating to a new era, check that the choice of encoding still -- seems right w.r.t the ledger. Types will /probably/ but not @@ -115,12 +114,16 @@ estimateSignedTxSize era pparams nWits tx = withConstraints era $ in sizeOfTx <> sizeOfWits where + unsignedTx :: Tx (ShelleyLedgerEra era) + unsignedTx = withConstraints era $ + txWithWits & (witsTxL . addrTxWitsL) .~ mempty + 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 - era pparams tx witCount + era pparams unsignedTx witCount feePerByte :: W.Coin feePerByte = Ledger.toWalletCoin $ diff --git a/lib/wallet/test/unit/Cardano/Wallet/Shelley/TransactionSpec.hs b/lib/wallet/test/unit/Cardano/Wallet/Shelley/TransactionSpec.hs index 98ddf514e8a..5977d9db4ee 100644 --- a/lib/wallet/test/unit/Cardano/Wallet/Shelley/TransactionSpec.hs +++ b/lib/wallet/test/unit/Cardano/Wallet/Shelley/TransactionSpec.hs @@ -3753,11 +3753,14 @@ estimateSignedTxSizeSpec = describe "estimateSignedTxSize" $ do testDoesNotYetSupport x = pendingWith $ "Test setup does not work for txs with " <> x + + signedBinarySize = TxSize $ fromIntegral $ BS.length bs + case (noScripts, noBootWits) of (True, True) -> do estimateSignedTxSize era pparams witCount ledgerTx - `shouldBe` - TxSize (fromIntegral (BS.length bs) - correction) + `shouldBeWithin` + (signedBinarySize - correction, signedBinarySize) (False, False) -> testDoesNotYetSupport "bootstrap wits + scripts" (True, False) -> testDoesNotYetSupport "bootstrap wits" (False, True) -> testDoesNotYetSupport "scripts" @@ -3765,7 +3768,17 @@ estimateSignedTxSizeSpec = describe "estimateSignedTxSize" $ do -- Apparently the cbor encoding used by the ledger for size-checks -- (`toCBORForSizeComputation`) is a few bytes smaller than the actual -- serialized size for these goldens. - correction = 3 + correction = TxSize 6 + + -- | Checks for membership in the given closed interval [a, b] + x `shouldBeWithin` (a, b) = + if a <= x && x <= b + then pure () + else expectationFailure $ unwords + [ show x + , "not in the expected interval" + , "[" <> show a <> ", " <> show b <> "]" + ] forAllGoldens :: [(String, ByteString)] From e1e38394c53e4f374992f6cee041f17f98fcd30b Mon Sep 17 00:00:00 2001 From: Johannes Lund Date: Wed, 16 Aug 2023 12:02:22 +0200 Subject: [PATCH 05/16] fixup --- lib/wallet/src/Cardano/Wallet/Write/Tx/Sign.hs | 12 ++++++++++-- 1 file changed, 10 insertions(+), 2 deletions(-) diff --git a/lib/wallet/src/Cardano/Wallet/Write/Tx/Sign.hs b/lib/wallet/src/Cardano/Wallet/Write/Tx/Sign.hs index c7ca7fb9d1a..ae94b862ec4 100644 --- a/lib/wallet/src/Cardano/Wallet/Write/Tx/Sign.hs +++ b/lib/wallet/src/Cardano/Wallet/Write/Tx/Sign.hs @@ -29,7 +29,13 @@ import Prelude import Cardano.Ledger.Alonzo.Tx ( sizeAlonzoTxF ) import Cardano.Ledger.Api - ( Addr (..), addrTxOutL, addrTxWitsL, ppMinFeeAL, witsTxL ) + ( Addr (..) + , addrTxOutL + , addrTxWitsL + , bootAddrTxWitsL + , ppMinFeeAL + , witsTxL + ) import Cardano.Ledger.Credential ( Credential (..) ) import Cardano.Ledger.UTxO @@ -116,7 +122,9 @@ estimateSignedTxSize era pparams nWits txWithWits = withConstraints era $ where unsignedTx :: Tx (ShelleyLedgerEra era) unsignedTx = withConstraints era $ - txWithWits & (witsTxL . addrTxWitsL) .~ mempty + txWithWits + & (witsTxL . addrTxWitsL) .~ mempty + & (witsTxL . bootAddrTxWitsL) .~ mempty coinQuotRem :: W.Coin -> W.Coin -> (Natural, Natural) coinQuotRem (W.Coin p) (W.Coin q) = quotRem p q From 39188be0e3c732167f700ace254b6a426afcfa55 Mon Sep 17 00:00:00 2001 From: Johannes Lund Date: Wed, 16 Aug 2023 18:42:49 +0200 Subject: [PATCH 06/16] Extend `estimateSignedTxSize` test coverage for bootstrap wits --- .../Cardano/Wallet/Shelley/TransactionSpec.hs | 36 +++++++++++++------ 1 file changed, 26 insertions(+), 10 deletions(-) diff --git a/lib/wallet/test/unit/Cardano/Wallet/Shelley/TransactionSpec.hs b/lib/wallet/test/unit/Cardano/Wallet/Shelley/TransactionSpec.hs index 5977d9db4ee..c09144eb32c 100644 --- a/lib/wallet/test/unit/Cardano/Wallet/Shelley/TransactionSpec.hs +++ b/lib/wallet/test/unit/Cardano/Wallet/Shelley/TransactionSpec.hs @@ -3739,8 +3739,9 @@ estimateSignedTxSizeSpec = describe "estimateSignedTxSize" $ do -> IO () test _name bs tx@(Cardano.Tx body _) = do let pparams = Write.pparamsLedger $ mockPParamsForBalancing @era - utxo = utxoPromisingInputsHaveVkPaymentCreds body + utxo = utxoPromisingInputsHaveAddress vkCredAddr body witCount = estimateKeyWitnessCount (Write.fromCardanoUTxO utxo) body + witCountBoot = estimateKeyWitnessCount (Write.fromCardanoUTxO $ utxoPromisingInputsHaveAddress bootAddr body) body era = recentEra @era ledgerTx :: Write.Tx (Write.ShelleyLedgerEra era) @@ -3762,7 +3763,16 @@ estimateSignedTxSizeSpec = describe "estimateSignedTxSize" $ do `shouldBeWithin` (signedBinarySize - correction, signedBinarySize) (False, False) -> testDoesNotYetSupport "bootstrap wits + scripts" - (True, False) -> testDoesNotYetSupport "bootstrap wits" + (True, False) -> + estimateSignedTxSize era pparams witCountBoot ledgerTx + `shouldBeWithin` + ( signedBinarySize - correction + , signedBinarySize + TxSize 45 + -- For txs with bootstrap witnesses we accept that the + -- initial estimation might be much higher than the + -- eventual signed tx. The bootstrap witnesses can vary + -- in size. + ) (False, True) -> testDoesNotYetSupport "scripts" where -- Apparently the cbor encoding used by the ledger for size-checks @@ -3798,21 +3808,22 @@ estimateSignedTxSizeSpec = 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. - utxoPromisingInputsHaveVkPaymentCreds - :: forall era. HasCallStack - => Cardano.IsShelleyBasedEra era - => Cardano.TxBody era + utxoPromisingInputsHaveAddress + :: forall era. (HasCallStack, Cardano.IsShelleyBasedEra era) + => Address + -> Cardano.TxBody era -> Cardano.UTxO era - utxoPromisingInputsHaveVkPaymentCreds (Cardano.TxBody body) = + utxoPromisingInputsHaveAddress addr (Cardano.TxBody body) = Cardano.UTxO $ Map.fromList $ [ (i , Compatibility.toCardanoTxOut (shelleyBasedEra @era) - (TxOut paymentAddr mempty) + (TxOut addr mempty) ) | i <- allTxIns body ] @@ -3825,8 +3836,13 @@ estimateSignedTxSizeSpec = describe "estimateSignedTxSize" $ do Cardano.TxInsCollateralNone -> [] ins = Cardano.txIns body - paymentAddr = Address $ unsafeFromHex - "6079467c69a9ac66280174d09d62575ba955748b21dec3b483a9469a65" + + + bootAddr = Address $ unsafeFromHex + "82d818582183581cba970ad36654d8dd8f74274b733452ddeab9a62a397746be3c42ccdda0001a9026da5b" + + vkCredAddr = Address $ unsafeFromHex + "6079467c69a9ac66280174d09d62575ba955748b21dec3b483a9469a65" fst6 :: (a, b, c, d, e, f) -> a fst6 (a,_,_,_,_,_) = a From 6e335621d695e913203866f8870f33527270ab9e Mon Sep 17 00:00:00 2001 From: Johannes Lund Date: Wed, 23 Aug 2023 20:47:28 +0200 Subject: [PATCH 07/16] Apply suggestions from code review Co-authored-by: Jonathan Knowles --- lib/wallet/src/Cardano/Wallet/Write/Tx/Sign.hs | 2 -- .../unit/Cardano/Wallet/Shelley/TransactionSpec.hs | 11 +++++------ 2 files changed, 5 insertions(+), 8 deletions(-) diff --git a/lib/wallet/src/Cardano/Wallet/Write/Tx/Sign.hs b/lib/wallet/src/Cardano/Wallet/Write/Tx/Sign.hs index ae94b862ec4..12e81c2d36c 100644 --- a/lib/wallet/src/Cardano/Wallet/Write/Tx/Sign.hs +++ b/lib/wallet/src/Cardano/Wallet/Write/Tx/Sign.hs @@ -108,8 +108,6 @@ estimateSignedTxSize era pparams nWits txWithWits = withConstraints era $ , show feePerByte , "lovelace/byte" ] - - -- When updating to a new era, check that the choice of encoding still -- seems right w.r.t the ledger. Types will /probably/ but not -- /necessarily/ protect against calling the wrong function. diff --git a/lib/wallet/test/unit/Cardano/Wallet/Shelley/TransactionSpec.hs b/lib/wallet/test/unit/Cardano/Wallet/Shelley/TransactionSpec.hs index c09144eb32c..97a49ca7b59 100644 --- a/lib/wallet/test/unit/Cardano/Wallet/Shelley/TransactionSpec.hs +++ b/lib/wallet/test/unit/Cardano/Wallet/Shelley/TransactionSpec.hs @@ -3754,18 +3754,17 @@ estimateSignedTxSizeSpec = describe "estimateSignedTxSize" $ do testDoesNotYetSupport x = pendingWith $ "Test setup does not work for txs with " <> x - signedBinarySize = TxSize $ fromIntegral $ BS.length bs case (noScripts, noBootWits) of (True, True) -> do - estimateSignedTxSize era pparams witCount ledgerTx - `shouldBeWithin` + estimateSignedTxSize era pparams (witCount vkCredAddr) tx + `shouldBeInclusivelyWithin` (signedBinarySize - correction, signedBinarySize) (False, False) -> testDoesNotYetSupport "bootstrap wits + scripts" (True, False) -> - estimateSignedTxSize era pparams witCountBoot ledgerTx - `shouldBeWithin` + estimateSignedTxSize era pparams (witCount bootAddr) tx + `shouldBeInclusivelyWithin` ( signedBinarySize - correction , signedBinarySize + TxSize 45 -- For txs with bootstrap witnesses we accept that the @@ -3781,7 +3780,7 @@ estimateSignedTxSizeSpec = describe "estimateSignedTxSize" $ do correction = TxSize 6 -- | Checks for membership in the given closed interval [a, b] - x `shouldBeWithin` (a, b) = + x `shouldBeInclusivelyWithin` (a, b) = if a <= x && x <= b then pure () else expectationFailure $ unwords From 5f54e3db153ed8edd96fd357db6fc71354e45f06 Mon Sep 17 00:00:00 2001 From: Johannes Lund Date: Wed, 23 Aug 2023 21:40:22 +0200 Subject: [PATCH 08/16] Avoid exceeding 80-char line length --- .../Cardano/Wallet/Shelley/TransactionSpec.hs | 17 +++++++++-------- 1 file changed, 9 insertions(+), 8 deletions(-) diff --git a/lib/wallet/test/unit/Cardano/Wallet/Shelley/TransactionSpec.hs b/lib/wallet/test/unit/Cardano/Wallet/Shelley/TransactionSpec.hs index 97a49ca7b59..29969f4f4ff 100644 --- a/lib/wallet/test/unit/Cardano/Wallet/Shelley/TransactionSpec.hs +++ b/lib/wallet/test/unit/Cardano/Wallet/Shelley/TransactionSpec.hs @@ -3737,20 +3737,21 @@ estimateSignedTxSizeSpec = describe "estimateSignedTxSize" $ do -> ByteString -> Cardano.Tx era -> IO () - test _name bs tx@(Cardano.Tx body _) = do + test _name bs cardanoTx@(Cardano.Tx body _) = do let pparams = Write.pparamsLedger $ mockPParamsForBalancing @era - utxo = utxoPromisingInputsHaveAddress vkCredAddr body - witCount = estimateKeyWitnessCount (Write.fromCardanoUTxO utxo) body - witCountBoot = estimateKeyWitnessCount (Write.fromCardanoUTxO $ utxoPromisingInputsHaveAddress bootAddr body) body + witCount dummyAddr = estimateKeyWitnessCount + (Write.fromCardanoUTxO + $ utxoPromisingInputsHaveAddress dummyAddr body) + body era = recentEra @era - ledgerTx :: Write.Tx (Write.ShelleyLedgerEra era) - ledgerTx = Write.fromCardanoTx @era tx + tx :: Write.Tx (Write.ShelleyLedgerEra era) + tx = Write.fromCardanoTx @era cardanoTx noScripts = Write.withConstraints (recentEra @era) $ - Map.null $ ledgerTx ^. witsTxL . scriptTxWitsL + Map.null $ tx ^. witsTxL . scriptTxWitsL noBootWits = Write.withConstraints (recentEra @era) $ - Set.null $ ledgerTx ^. witsTxL . bootAddrTxWitsL + Set.null $ tx ^. witsTxL . bootAddrTxWitsL testDoesNotYetSupport x = pendingWith $ "Test setup does not work for txs with " <> x From 7230444789cd3c37cb3a9691c7d046bf9e4f5459 Mon Sep 17 00:00:00 2001 From: Johannes Lund Date: Wed, 23 Aug 2023 21:44:24 +0200 Subject: [PATCH 09/16] Use `sizeTxF` instead of `sizeAlonzoTxF` --- lib/wallet/src/Cardano/Wallet/Write/Tx/Sign.hs | 7 +++---- 1 file changed, 3 insertions(+), 4 deletions(-) diff --git a/lib/wallet/src/Cardano/Wallet/Write/Tx/Sign.hs b/lib/wallet/src/Cardano/Wallet/Write/Tx/Sign.hs index 12e81c2d36c..fae3effdda3 100644 --- a/lib/wallet/src/Cardano/Wallet/Write/Tx/Sign.hs +++ b/lib/wallet/src/Cardano/Wallet/Write/Tx/Sign.hs @@ -26,14 +26,13 @@ module Cardano.Wallet.Write.Tx.Sign import Prelude -import Cardano.Ledger.Alonzo.Tx - ( sizeAlonzoTxF ) import Cardano.Ledger.Api ( Addr (..) , addrTxOutL , addrTxWitsL , bootAddrTxWitsL , ppMinFeeAL + , sizeTxF , witsTxL ) import Cardano.Ledger.Credential @@ -113,8 +112,8 @@ estimateSignedTxSize era pparams nWits txWithWits = withConstraints era $ -- /necessarily/ protect against calling the wrong function. sizeOfTx :: TxSize sizeOfTx = fromIntegral @Integer @TxSize $ case era of - RecentEraBabbage -> unsignedTx ^. sizeAlonzoTxF - RecentEraConway -> unsignedTx ^. sizeAlonzoTxF + RecentEraBabbage -> unsignedTx ^. sizeTxF + RecentEraConway -> unsignedTx ^. sizeTxF in sizeOfTx <> sizeOfWits where From 222ff6de1b9492e0aad870e7c122efda51453fc6 Mon Sep 17 00:00:00 2001 From: Johannes Lund Date: Thu, 24 Aug 2023 12:16:58 +0200 Subject: [PATCH 10/16] fixup: delete extra line --- lib/wallet/test/unit/Cardano/Wallet/Shelley/TransactionSpec.hs | 1 - 1 file changed, 1 deletion(-) diff --git a/lib/wallet/test/unit/Cardano/Wallet/Shelley/TransactionSpec.hs b/lib/wallet/test/unit/Cardano/Wallet/Shelley/TransactionSpec.hs index 29969f4f4ff..ab45bb4d73d 100644 --- a/lib/wallet/test/unit/Cardano/Wallet/Shelley/TransactionSpec.hs +++ b/lib/wallet/test/unit/Cardano/Wallet/Shelley/TransactionSpec.hs @@ -3808,7 +3808,6 @@ estimateSignedTxSizeSpec = 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 From a07f4b866f4da2132f54710443fc81f5dba56bf9 Mon Sep 17 00:00:00 2001 From: Johannes Lund Date: Thu, 24 Aug 2023 13:25:13 +0200 Subject: [PATCH 11/16] Avoid case statement --- lib/wallet/src/Cardano/Wallet/Write/Tx/Sign.hs | 10 ++++------ 1 file changed, 4 insertions(+), 6 deletions(-) diff --git a/lib/wallet/src/Cardano/Wallet/Write/Tx/Sign.hs b/lib/wallet/src/Cardano/Wallet/Write/Tx/Sign.hs index fae3effdda3..8b66e031cf5 100644 --- a/lib/wallet/src/Cardano/Wallet/Write/Tx/Sign.hs +++ b/lib/wallet/src/Cardano/Wallet/Write/Tx/Sign.hs @@ -107,13 +107,11 @@ estimateSignedTxSize era pparams nWits txWithWits = withConstraints era $ , show feePerByte , "lovelace/byte" ] - -- When updating to a new era, check that the choice of encoding still - -- seems right w.r.t the ledger. Types will /probably/ but not - -- /necessarily/ protect against calling the wrong function. + sizeOfTx :: TxSize - sizeOfTx = fromIntegral @Integer @TxSize $ case era of - RecentEraBabbage -> unsignedTx ^. sizeTxF - RecentEraConway -> unsignedTx ^. sizeTxF + sizeOfTx = withConstraints era + $ fromIntegral @Integer @TxSize + $ unsignedTx ^. sizeTxF in sizeOfTx <> sizeOfWits where From c3feaa43d7a18e234f021cc5ccd6a59405774e79 Mon Sep 17 00:00:00 2001 From: Johannes Lund Date: Thu, 24 Aug 2023 13:28:51 +0200 Subject: [PATCH 12/16] Also avoid case statement for `ppMinFeeAL` --- lib/wallet/src/Cardano/Wallet/Write/Tx/Sign.hs | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/lib/wallet/src/Cardano/Wallet/Write/Tx/Sign.hs b/lib/wallet/src/Cardano/Wallet/Write/Tx/Sign.hs index 8b66e031cf5..fd26dfa58cb 100644 --- a/lib/wallet/src/Cardano/Wallet/Write/Tx/Sign.hs +++ b/lib/wallet/src/Cardano/Wallet/Write/Tx/Sign.hs @@ -129,10 +129,8 @@ estimateSignedTxSize era pparams nWits txWithWits = withConstraints era $ era pparams unsignedTx witCount feePerByte :: W.Coin - feePerByte = Ledger.toWalletCoin $ - case era of - Write.RecentEraBabbage -> pparams ^. ppMinFeeAL - Write.RecentEraConway -> pparams ^. ppMinFeeAL + feePerByte = withConstraints era $ Ledger.toWalletCoin $ + pparams ^. ppMinFeeAL numberOfShelleyWitnesses :: Word -> KeyWitnessCount numberOfShelleyWitnesses n = KeyWitnessCount n 0 From 707f8fc6a498313f7ba6679e7d998761f777d103 Mon Sep 17 00:00:00 2001 From: Johannes Lund Date: Mon, 28 Aug 2023 14:29:18 +0200 Subject: [PATCH 13/16] s/size-checks/size checks/ Co-authored-by: Jonathan Knowles --- lib/wallet/test/unit/Cardano/Wallet/Shelley/TransactionSpec.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/wallet/test/unit/Cardano/Wallet/Shelley/TransactionSpec.hs b/lib/wallet/test/unit/Cardano/Wallet/Shelley/TransactionSpec.hs index ab45bb4d73d..e146bfa06a0 100644 --- a/lib/wallet/test/unit/Cardano/Wallet/Shelley/TransactionSpec.hs +++ b/lib/wallet/test/unit/Cardano/Wallet/Shelley/TransactionSpec.hs @@ -3775,7 +3775,7 @@ estimateSignedTxSizeSpec = describe "estimateSignedTxSize" $ do ) (False, True) -> testDoesNotYetSupport "scripts" where - -- Apparently the cbor encoding used by the ledger for size-checks + -- Apparently the cbor encoding used by the ledger for size checks -- (`toCBORForSizeComputation`) is a few bytes smaller than the actual -- serialized size for these goldens. correction = TxSize 6 From 6000e90fc8aa10d288652acd23c43a4b2c9e2f7f Mon Sep 17 00:00:00 2001 From: Johannes Lund Date: Mon, 28 Aug 2023 14:22:39 +0200 Subject: [PATCH 14/16] Explain constants in estimateSignedTxSize test better --- .../Cardano/Wallet/Shelley/TransactionSpec.hs | 28 +++++++++++++------ 1 file changed, 19 insertions(+), 9 deletions(-) diff --git a/lib/wallet/test/unit/Cardano/Wallet/Shelley/TransactionSpec.hs b/lib/wallet/test/unit/Cardano/Wallet/Shelley/TransactionSpec.hs index e146bfa06a0..4c2771d4ed0 100644 --- a/lib/wallet/test/unit/Cardano/Wallet/Shelley/TransactionSpec.hs +++ b/lib/wallet/test/unit/Cardano/Wallet/Shelley/TransactionSpec.hs @@ -3761,17 +3761,15 @@ estimateSignedTxSizeSpec = describe "estimateSignedTxSize" $ do (True, True) -> do estimateSignedTxSize era pparams (witCount vkCredAddr) tx `shouldBeInclusivelyWithin` - (signedBinarySize - correction, signedBinarySize) + ( signedBinarySize - correction + , signedBinarySize + ) (False, False) -> testDoesNotYetSupport "bootstrap wits + scripts" (True, False) -> estimateSignedTxSize era pparams (witCount bootAddr) tx `shouldBeInclusivelyWithin` ( signedBinarySize - correction - , signedBinarySize + TxSize 45 - -- For txs with bootstrap witnesses we accept that the - -- initial estimation might be much higher than the - -- eventual signed tx. The bootstrap witnesses can vary - -- in size. + , signedBinarySize + bootWitsCanBeLongerBy ) (False, True) -> testDoesNotYetSupport "scripts" where @@ -3835,13 +3833,25 @@ estimateSignedTxSizeSpec = describe "estimateSignedTxSize" $ do Cardano.TxInsCollateralNone -> [] ins = Cardano.txIns body + -- An address with a vk payment credential. For the test above, this is the + -- only aspect which matters. + vkCredAddr = Address $ unsafeFromHex + "6000000000000000000000000000000000000000000000000000000000" - + -- This is a short bootstrap address retrieved from + -- "byron-address-format.md". bootAddr = Address $ unsafeFromHex "82d818582183581cba970ad36654d8dd8f74274b733452ddeab9a62a397746be3c42ccdda0001a9026da5b" - vkCredAddr = Address $ unsafeFromHex - "6079467c69a9ac66280174d09d62575ba955748b21dec3b483a9469a65" + -- With more attributes, the address can be longer. This value was chosen + -- /experimentally/ to make the tests pass. The ledger has been validating + -- new outputs with bootstrap addresses have attributes not larger than 64 + -- bytes. The ledger has done so since the middle of the Byron era. + -- Address attributes are included in the bootstrap witnesses. + -- + -- NOTE: If we had access to the real UTxO set for the inputs of the test + -- txs, we wouldn't need this fuzziness. Related: ADP-2987. + bootWitsCanBeLongerBy = 45 fst6 :: (a, b, c, d, e, f) -> a fst6 (a,_,_,_,_,_) = a From 673fbdc1763056bc3f5f3f8eddf43f2b1dfb53ed Mon Sep 17 00:00:00 2001 From: Johannes Lund Date: Mon, 28 Aug 2023 14:28:17 +0200 Subject: [PATCH 15/16] fixup name shadowing warning --- .../test/unit/Cardano/Wallet/Shelley/TransactionSpec.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lib/wallet/test/unit/Cardano/Wallet/Shelley/TransactionSpec.hs b/lib/wallet/test/unit/Cardano/Wallet/Shelley/TransactionSpec.hs index 4c2771d4ed0..777032948c6 100644 --- a/lib/wallet/test/unit/Cardano/Wallet/Shelley/TransactionSpec.hs +++ b/lib/wallet/test/unit/Cardano/Wallet/Shelley/TransactionSpec.hs @@ -3737,7 +3737,7 @@ estimateSignedTxSizeSpec = describe "estimateSignedTxSize" $ do -> ByteString -> Cardano.Tx era -> IO () - test _name bs cardanoTx@(Cardano.Tx body _) = do + test _name bs cTx@(Cardano.Tx body _) = do let pparams = Write.pparamsLedger $ mockPParamsForBalancing @era witCount dummyAddr = estimateKeyWitnessCount (Write.fromCardanoUTxO @@ -3746,7 +3746,7 @@ estimateSignedTxSizeSpec = describe "estimateSignedTxSize" $ do era = recentEra @era tx :: Write.Tx (Write.ShelleyLedgerEra era) - tx = Write.fromCardanoTx @era cardanoTx + tx = Write.fromCardanoTx @era cTx noScripts = Write.withConstraints (recentEra @era) $ Map.null $ tx ^. witsTxL . scriptTxWitsL From 52487205de7382fd5a91d3f59e07e3122988a19e Mon Sep 17 00:00:00 2001 From: Johannes Lund Date: Tue, 29 Aug 2023 13:24:37 +0200 Subject: [PATCH 16/16] Address review comments --- .../unit/Cardano/Wallet/Shelley/TransactionSpec.hs | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) diff --git a/lib/wallet/test/unit/Cardano/Wallet/Shelley/TransactionSpec.hs b/lib/wallet/test/unit/Cardano/Wallet/Shelley/TransactionSpec.hs index 777032948c6..67c9925fdad 100644 --- a/lib/wallet/test/unit/Cardano/Wallet/Shelley/TransactionSpec.hs +++ b/lib/wallet/test/unit/Cardano/Wallet/Shelley/TransactionSpec.hs @@ -3740,9 +3740,9 @@ estimateSignedTxSizeSpec = describe "estimateSignedTxSize" $ do test _name bs cTx@(Cardano.Tx body _) = do let pparams = Write.pparamsLedger $ mockPParamsForBalancing @era witCount dummyAddr = estimateKeyWitnessCount - (Write.fromCardanoUTxO - $ utxoPromisingInputsHaveAddress dummyAddr body) - body + (Write.fromCardanoUTxO + $ utxoPromisingInputsHaveAddress dummyAddr body) + body era = recentEra @era tx :: Write.Tx (Write.ShelleyLedgerEra era) @@ -3764,7 +3764,8 @@ estimateSignedTxSizeSpec = describe "estimateSignedTxSize" $ do ( signedBinarySize - correction , signedBinarySize ) - (False, False) -> testDoesNotYetSupport "bootstrap wits + scripts" + (False, False) -> + testDoesNotYetSupport "bootstrap wits + scripts" (True, False) -> estimateSignedTxSize era pparams (witCount bootAddr) tx `shouldBeInclusivelyWithin` @@ -3851,7 +3852,7 @@ estimateSignedTxSizeSpec = describe "estimateSignedTxSize" $ do -- -- NOTE: If we had access to the real UTxO set for the inputs of the test -- txs, we wouldn't need this fuzziness. Related: ADP-2987. - bootWitsCanBeLongerBy = 45 + bootWitsCanBeLongerBy = TxSize 45 fst6 :: (a, b, c, d, e, f) -> a fst6 (a,_,_,_,_,_) = a