Merge #2128

2128: Address slow fee estimation on Byron wallets r=KtorZ a=KtorZ

# Issue Number

<!-- Put here a reference to the issue this PR relates to and which requirements it tackles -->

#2126 

# Overview

<!-- Detail in a few bullet points the work accomplished in this PR -->

- fc1da51
  📍 **extend post-restoration benchmark wallet overview with number of addresses and transactions**
    We had only the UTxO, which gave little clarity about how many addresses and transactions did that correspond to. In practice, they're of the same order of magnitude, but it's good to have the actual number.

- a234e49
  📍 **do not construct dummy bootstrap witnesses but apply a correction on shelley witnesses afterwards**

  This is slightly simpler, but it also prevent some nasty things happening with the bootstrap witnesses: the 'Ord' instances used to compare and sort bootstrap witnesses require to serialize them fully, which involve two hashes of bytestrings; when done for 50 inputs, and 100 times in a row in multiple selection this little thing start to matter quite a lot.

- fc9d4ff
  📍 **adjust byron migration test assertion due to recent change**
    The fee estimation is now slightly faster, but the approximation is slightly worse, so we end up paying a little more for byron witnesses.

# Comments

<!-- Additional comments or screenshots to attach if any -->

<!-- 
Don't forget to:

 ✓ Self-review your changes to make sure nothing unexpected slipped through
 ✓ Assign yourself to the PR
 ✓ Assign one or several reviewer(s)
 ✓ Once created, link this PR to its corresponding ticket
 ✓ Assign the PR to a corresponding milestone
 ✓ Acknowledge any changes required to the Wiki
-->


Co-authored-by: KtorZ <matthias.benkort@gmail.com>

lib/core-integration/src/Test/Integration/Scenario/API/Byron/Migrations.hs

@@ -89,6 +89,7 @@ import qualified Cardano.Wallet.Api.Link as Link
 import qualified Cardano.Wallet.Api.Types as ApiTypes
 import qualified Data.Map.Strict as Map
 import qualified Network.HTTP.Types.Status as HTTP
+import qualified Test.Hspec as Hspec
 
 
 spec :: forall n t.
@@ -207,7 +208,7 @@ spec = do
  testAddressCycling ctx 3
  testAddressCycling ctx 10
 
- it "BYRON_MIGRATE_01 - \
+ Hspec.it "BYRON_MIGRATE_01 - \
  \ migrate a big wallet requiring more than one tx" $ \ctx -> do
  -- NOTE
  -- Special mnemonic for which 200 legacy funds are attached to in the
@@ -266,7 +267,7 @@ spec = do
  Default
  payloadMigrate >>= flip verify
  [ expectResponseCode @IO HTTP.status202
- , expectField id ((`shouldBe` 17). length)
+ , expectField id ((`shouldBe` 20). length)
  ]
 
  -- Check that funds become available in the target wallet:
@@ -345,7 +346,7 @@ spec = do
  , expectErrorMessage (errMsg403NothingToMigrate srcId)
  ]
 
- it "BYRON_MIGRATE_02 - \
+ Hspec.it "BYRON_MIGRATE_02 - \
  \migrating wallet with dust should fail."
  $ \ctx -> do
  -- NOTE

lib/core-integration/src/Test/Integration/Scenario/API/Shelley/Migrations.hs

@@ -87,6 +87,7 @@ import qualified Cardano.Wallet.Api.Link as Link
 import qualified Cardano.Wallet.Api.Types as ApiTypes
 import qualified Data.Map.Strict as Map
 import qualified Network.HTTP.Types.Status as HTTP
+import qualified Test.Hspec as Hspec
 
 spec :: forall n t.
  ( DecodeAddress n
@@ -167,7 +168,7 @@ spec = do
  testAddressCycling 3
  testAddressCycling 10
 
- it "SHELLEY_MIGRATE_01_big_wallet - \
+ Hspec.it "SHELLEY_MIGRATE_01_big_wallet - \
  \ migrate a big wallet requiring more than one tx" $ \ctx -> do
 
  -- NOTE
@@ -273,7 +274,7 @@ spec = do
  , expectErrorMessage (errMsg403NothingToMigrate srcId)
  ]
 
- it "SHELLEY_MIGRATE_02 - \
+ Hspec.it "SHELLEY_MIGRATE_02 - \
  \migrating wallet with dust should fail."
  $ \ctx -> do
  -- NOTE

lib/shelley/bench/Restore.hs

@@ -1,6 +1,5 @@
 {-# LANGUAGE AllowAmbiguousTypes #-}
 {-# LANGUAGE DataKinds #-}
-{-# LANGUAGE DeriveFunctor #-}
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE FlexibleContexts #-}
@@ -103,6 +102,7 @@ import Cardano.Wallet.Primitive.Types
  , GenesisParameters (..)
  , NetworkParameters (..)
  , SlotNo (..)
+ , SortOrder (..)
  , TxOut (..)
  , UTxOStatistics (..)
  , WalletId (..)
@@ -139,7 +139,7 @@ import Control.Monad.Trans.Except
 import Control.Tracer
  ( Tracer (..), traceWith )
 import Data.Aeson
- ( ToJSON (..), genericToJSON )
+ ( ToJSON (..), genericToJSON, (.=) )
 import Data.Coerce
  ( coerce )
 import Data.Functor
@@ -159,7 +159,17 @@ import Data.Text.Class
 import Data.Time.Clock.POSIX
  ( getCurrentTime, utcTimeToPOSIXSeconds )
 import Fmt
- ( Buildable, build, genericF, pretty, (+|), (+||), (|+), (||+) )
+ ( Buildable
+ , blockListF'
+ , build
+ , genericF
+ , nameF
+ , pretty
+ , (+|)
+ , (+||)
+ , (|+)
+ , (||+)
+ )
 import GHC.Generics
  ( Generic )
 import GHC.TypeLits
@@ -338,22 +348,44 @@ data SomeBenchmarkResults where
 instance Buildable SomeBenchmarkResults where
  build (SomeBenchmarkResults results) = build results
 
-data BenchRndResults s = BenchRndResults
+data WalletOverview = WalletOverview
+ { utxo :: UTxOStatistics
+ , addresses :: Word
+ , transactions :: Word
+ } deriving (Show, Generic)
+
+instance Buildable WalletOverview where
+ build WalletOverview{utxo,addresses,transactions} =
+ blockListF' "" id
+ [ nameF "number of addresses" (build addresses)
+ , nameF "number of transactions" (build transactions)
+ , build utxo
+ ]
+
+instance ToJSON WalletOverview where
+ toJSON WalletOverview{utxo,addresses,transactions} = Aeson.object
+ [ "utxo" .= toApiUtxoStatistics utxo
+ , "addresses" .= addresses
+ , "transactions" .= transactions
+ ]
+
+data BenchRndResults = BenchRndResults
  { benchName :: Text
  , restoreTime :: Time
  , readWalletTime :: Time
  , listAddressesTime :: Time
+ , listTransactionsTime :: Time
  , importOneAddressTime :: Time
  , importManyAddressesTime :: Time
  , estimateFeesTime :: Time
- , utxoStatistics :: s
- } deriving (Show, Generic, Functor)
+ , walletOverview :: WalletOverview
+ } deriving (Show, Generic)
 
-instance Buildable s => Buildable (BenchRndResults s) where
+instance Buildable BenchRndResults where
  build = genericF
 
-instance ToJSON (BenchRndResults UTxOStatistics) where
- toJSON = genericToJSON Aeson.defaultOptions . fmap toApiUtxoStatistics
+instance ToJSON BenchRndResults where
+ toJSON = genericToJSON Aeson.defaultOptions
 
 benchmarksRnd
  :: forall (n :: NetworkDiscriminant) s t k p.
@@ -369,17 +401,24 @@ benchmarksRnd
  -> WalletId
  -> WalletName
  -> Time
- -> IO (BenchRndResults UTxOStatistics)
+ -> IO BenchRndResults
 benchmarksRnd _ w wid wname restoreTime = do
  ((cp, pending), readWalletTime) <- bench "read wallet" $ do
  (cp, _, pending) <- unsafeRunExceptT $ W.readWallet w wid
  pure (cp, pending)
 
- (utxoStatistics, _) <- bench "utxo statistics" $ do
+ (utxo, _) <- bench "utxo statistics" $ do
  pure $ computeUtxoStatistics log10 (totalUTxO pending cp)
 
- (_, listAddressesTime) <- bench "list addresses" $ do
- unsafeRunExceptT $ W.listAddresses w wid (const pure)
+ (addresses, listAddressesTime) <- bench "list addresses"
+ $ fmap (fromIntegral . length)
+ $ unsafeRunExceptT
+ $ W.listAddresses w wid (const pure)
+
+ (transactions, listTransactionsTime) <- bench "list transactions"
+ $ fmap (fromIntegral . length)
+ $ unsafeRunExceptT
+ $ W.listTransactions @_ @s @k @t w wid Nothing Nothing Nothing Descending
 
  (_, estimateFeesTime) <- bench "estimate tx fee" $ do
  let out = TxOut (dummyAddress @n) (Coin 1)
@@ -396,15 +435,18 @@ benchmarksRnd _ w wid wname restoreTime = do
  runExceptT $ withExceptT show $
  W.importRandomAddresses @_ @s @k w wid manyAddresses
 
+ let walletOverview = WalletOverview{utxo,addresses,transactions}
+
  pure BenchRndResults
  { benchName = getWalletName wname
  , restoreTime
  , readWalletTime
  , listAddressesTime
+ , listTransactionsTime
  , estimateFeesTime
  , importOneAddressTime
  , importManyAddressesTime
- , utxoStatistics
+ , walletOverview
  }
  where
  genAddresses :: Int -> Wallet s -> IO [Address]
@@ -415,20 +457,21 @@ benchmarksRnd _ w wid wname restoreTime = do
  where
  xprv = Byron.generateKeyFromSeed seed mempty
 
-data BenchSeqResults s = BenchSeqResults
+data BenchSeqResults = BenchSeqResults
  { benchName :: Text
  , restoreTime :: Time
  , readWalletTime :: Time
  , listAddressesTime :: Time
+ , listTransactionsTime :: Time
  , estimateFeesTime :: Time
- , utxoStatistics :: s
- } deriving (Show, Generic, Functor)
+ , walletOverview :: WalletOverview
+ } deriving (Show, Generic)
 
-instance Buildable s => Buildable (BenchSeqResults s) where
+instance Buildable BenchSeqResults where
  build = genericF
 
-instance ToJSON (BenchSeqResults UTxOStatistics) where
- toJSON = genericToJSON Aeson.defaultOptions . fmap toApiUtxoStatistics
+instance ToJSON BenchSeqResults where
+ toJSON = genericToJSON Aeson.defaultOptions
 
 benchmarksSeq
  :: forall (n :: NetworkDiscriminant) s t k p.
@@ -444,30 +487,40 @@ benchmarksSeq
  -> WalletId
  -> WalletName
  -> Time
- -> IO (BenchSeqResults UTxOStatistics)
+ -> IO BenchSeqResults
 benchmarksSeq _ w wid wname restoreTime = do
  ((cp, pending), readWalletTime) <- bench "read wallet" $ do
  (cp, _, pending) <- unsafeRunExceptT $ W.readWallet w wid
  pure (cp, pending)
 
- (utxoStatistics, _) <- bench "utxo statistics" $ do
+ (utxo, _) <- bench "utxo statistics" $ do
  pure $ computeUtxoStatistics log10 (totalUTxO pending cp)
 
- (_, listAddressesTime) <- bench "list addresses" $ do
- unsafeRunExceptT $ W.listAddresses w wid (const pure)
+ (addresses, listAddressesTime) <- bench "list addresses"
+ $ fmap (fromIntegral . length)
+ $ unsafeRunExceptT
+ $ W.listAddresses w wid (const pure)
+
+ (transactions, listTransactionsTime) <- bench "list transactions"
+ $ fmap (fromIntegral . length)
+ $ unsafeRunExceptT
+ $ W.listTransactions @_ @s @k @t w wid Nothing Nothing Nothing Descending
 
  (_, estimateFeesTime) <- bench "estimate tx fee" $ do
  let out = TxOut (dummyAddress @n) (Coin 1)
  runExceptT $ withExceptT show $ W.estimateFeeForPayment @_ @s @t @k
  w wid (out :| []) (Quantity 0) Nothing
 
+ let walletOverview = WalletOverview{utxo,addresses,transactions}
+
  pure BenchSeqResults
  { benchName = getWalletName wname
  , restoreTime
  , readWalletTime
  , listAddressesTime
+ , listTransactionsTime
  , estimateFeesTime
- , utxoStatistics
+ , walletOverview
  }
 
 {-# ANN bench_restoration ("HLint: ignore Use camelCase" :: String) #-}

lib/shelley/src/Cardano/Wallet/Shelley/Transaction.hs

@@ -387,17 +387,19 @@ computeTxSize networkId witTag md action cs =
 
  signed = Cardano.makeSignedTransaction wits unsigned
 
- -- NOTE
- -- When we generate dummy output, we generate them as new Shelley addresses
- -- because their format is much easier to generate (can be a sequence of
- -- bytes, and a straightforward header). Generating dummy Byron or Icarus
- -- addresses would be nuts. So instead, we apply a small correction for each
- -- output which can either slightly increase or decrease the overall size.
- --
- -- When change are Shelley addresses, the correction is null.
- outputCorrection =
- toInteger (length $ change cs) * perChangeCorrection
+ outputCorrection = sum
+ [ toInteger (length $ change cs) * perChangeCorrection
+ , toInteger (length $ inputs cs) * perInputCorrection
+ ]
  where
+ -- NOTE
+ -- When we generate dummy output, we generate them as new Shelley addresses
+ -- because their format is much easier to generate (can be a sequence of
+ -- bytes, and a straightforward header). Generating dummy Byron or Icarus
+ -- addresses would be nuts. So instead, we apply a small correction for each
+ -- output which can either slightly increase or decrease the overall size.
+ --
+ -- When change are Shelley addresses, the correction is null.
  perChangeCorrection = case witTag of
  TxWitnessShelleyUTxO ->
  0
@@ -416,6 +418,29 @@ computeTxSize networkId witTag md action cs =
  maxSizeOfIcarusMainAddr = 43
  maxSizeOfIcarusTestAddr = 50
 
+ -- NOTE
+ -- We generate dummy witnesses that are exclusively in Shelley format.
+ -- In Byron (or so-called bootstrap witnesses), we need to account for
+ -- some extra bytes due to the inclusion of:
+ --
+ -- - The chain code
+ -- - Serialized address attributes (path and protocol magic)
+ perInputCorrection = case witTag of
+ TxWitnessShelleyUTxO ->
+ 0
+ TxWitnessByronUTxO Byron | networkId == Cardano.Mainnet ->
+ ccLen + addrPathAttrLen
+ TxWitnessByronUTxO Byron ->
+ ccLen + addrPathAttrLen + networkMagicLen
+ TxWitnessByronUTxO Icarus | networkId == Cardano.Mainnet ->
+ ccLen
+ TxWitnessByronUTxO Icarus ->
+ ccLen + networkMagicLen
+ where
+ ccLen = 34
+ addrPathAttrLen = 40
+ networkMagicLen = 7
+
  unsigned = mkUnsignedTx maxBound cs' md wdrls certs
  where
  cs' :: CoinSelection
@@ -466,7 +491,7 @@ computeTxSize networkId witTag md action cs =
  TxWitnessShelleyUTxO ->
  addrWits <> certWits
  TxWitnessByronUTxO{} ->
- byronWits
+ addrWits
 
  (addrWits, certWits) =
  ( mconcat
@@ -497,46 +522,10 @@ computeTxSize networkId witTag md action cs =
  where
  chaff = L8.pack (show ix) <> BL.fromStrict txid
 
- -- Note that the "byron"/bootstrap witnesses are still shelley era
- -- witnesses.
- byronWits = map dummyWitnessUniq $ CS.inputs cs
- where
- dummyWitness :: BL.ByteString -> Address -> Cardano.Witness Cardano.Shelley
- dummyWitness chaff addr =
- Cardano.ShelleyBootstrapWitness $ SL.BootstrapWitness key sig cc padding
- where
- key = SL.VKey
- $ fromMaybe (error "error creating dummy witness ver key")
- $ rawDeserialiseVerKeyDSIGN
- $ bloatChaff keyLen chaff
-
- sig = SignedDSIGN
- $ fromMaybe (error "error creating dummy witness sig")
- $ rawDeserialiseSigDSIGN
- $ bloatChaff sigLen chaff
-
- cc = SL.ChainCode
- $ bloatChaff ccLen "0"
-
- padding = serialize'
- $ Byron.mkAttributes
- $ Byron.AddrAttributes
- { Byron.aaVKDerivationPath = toHDPayloadAddress addr
- , Byron.aaNetworkMagic = Cardano.toByronNetworkMagic networkId
- }
-
- dummyWitnessUniq :: (TxIn, TxOut) -> Cardano.Witness Cardano.Shelley
- dummyWitnessUniq (TxIn (Hash txid) ix, TxOut addr _) =
- dummyWitness chaff addr
- where
- chaff = L8.pack (show ix) <> BL.fromStrict txid
-
  sigLen = sizeSigDSIGN $ Proxy @(DSIGN TPraosStandardCrypto)
 
  keyLen = sizeVerKeyDSIGN $ Proxy @(DSIGN TPraosStandardCrypto)
 
- ccLen = 32
-
  bloatChaff :: Word -> BL.ByteString -> ByteString
  bloatChaff n = BL.toStrict . BL.take (fromIntegral n) . BL.cycle