Merge #2121 #2128

2121: Fix wallet address pool gap limited to Word8 r=KtorZ a=hasufell

Although with Persistent Word32 will change the
underlying type from SqlInt32 to SqlInt64, it
doesn't matter for sqlite, since they all end
up as INTEGER.

https://www.sqlite.org/datatype3.html

Issue #2120 

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: Julian Ospald <julian.ospald@iohk.io>
Co-authored-by: Julian Ospald <hasufell@posteo.de>
Co-authored-by: KtorZ <matthias.benkort@gmail.com>

lib/core-integration/src/Test/Integration/Framework/TestData.hs

@@ -36,6 +36,7 @@ module Test.Integration.Framework.TestData
  , cmdOk
  , versionLine
  , payloadWith
+ , payloadWith'
  , simplePayload
  , updateNamePayload
  , updatePassPayload
@@ -89,6 +90,8 @@ import Cardano.Wallet.Version
  ( gitRevision, showFullVersion, version )
 import Data.Text
  ( Text, pack, unpack )
+import Data.Word
+ ( Word32 )
 import Numeric.Natural
  ( Natural )
 import Test.Integration.Framework.DSL
@@ -225,6 +228,14 @@ payloadWith name mnemonics = Json [json| {
  "passphrase": #{fixturePassphrase}
  } |]
 
+payloadWith' :: Text -> [Text] -> Word32 -> Payload
+payloadWith' name mnemonics gap = Json [json| {
+ "name": #{name},
+ "mnemonic_sentence": #{mnemonics},
+ "passphrase": #{fixturePassphrase},
+ "address_pool_gap": #{gap}
+ } |]
+
 simplePayload :: Payload
 simplePayload = Json [json| {
  "name": "Secure Wallet",

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/core-integration/src/Test/Integration/Scenario/API/Shelley/Wallets.hs

@@ -28,6 +28,7 @@ import Cardano.Mnemonic
  )
 import Cardano.Wallet.Api.Types
  ( AddressAmount (..)
+ , ApiAddress
  , ApiByronWallet
  , ApiCoinSelection
  , ApiNetworkInformation
@@ -116,6 +117,7 @@ import Test.Integration.Framework.TestData
  , mnemonics24
  , mnemonics9
  , payloadWith
+ , payloadWith'
  , polishWalletName
  , russianWalletName
  , simplePayload
@@ -462,18 +464,20 @@ spec = do
  )
  , ( show addrPoolMax
  , addrPoolMax
- , [ expectResponseCode @IO HTTP.status201 ]
+ , [ expectResponseCode @IO HTTP.status201
+ , expectField (#addressPoolGap . #getApiT) (`shouldBe` maxBound)
+ ]
  )
  ]
  forM_ matrix $ \(title, addrPoolGap, expectations) -> it title $ \ctx -> do
- let payload = Json [json| {
-  "name": "Secure Wallet",
-  "mnemonic_sentence": #{mnemonics24},
-  "passphrase": "Secure passphrase",
-  "address_pool_gap": #{addrPoolGap}
-  } |]
- r <- request @ApiWallet ctx (Link.postWallet @'Shelley) Default payload
- verify r expectations
+ let payload = payloadWith' "Secure Wallet" mnemonics24 (fromIntegral addrPoolGap)
+ rW <- request @ApiWallet ctx (Link.postWallet @'Shelley) Default payload
+ verify rW expectations
+ rA <- request @[ApiAddress n] ctx
+ (Link.listAddresses @'Shelley (getFromResponse id rW)) Default Empty
+ verify rA
+  [ expectListSize addrPoolGap
+  ]
 
  it "WALLETS_CREATE_08 - default address_pool_gap" $ \ctx -> do
  let payload = Json [json| {
@@ -525,6 +529,7 @@ spec = do
  r <- request @ApiWallet ctx (Link.postWallet @'Shelley) headers payload
  verify r expectations
 
+
  it "WALLETS_GET_01 - can get wallet details" $ \ctx -> do
  (_, w) <- unsafeRequest @ApiWallet ctx (Link.postWallet @'Shelley) simplePayload
 

lib/core/src/Cardano/Wallet/DB/Sqlite/Types.hs

@@ -80,7 +80,7 @@ import Data.Text.Class
 import Data.Text.Encoding
  ( decodeUtf8, encodeUtf8 )
 import Data.Word
- ( Word32, Word64, Word8 )
+ ( Word32, Word64 )
 import Data.Word.Odd
  ( Word31 )
 import Database.Persist.Sqlite
@@ -393,12 +393,12 @@ instance PersistField AddressPoolGap where
  toPersistValue = toPersistValue . getAddressPoolGap
  fromPersistValue pv = fromPersistValue >=> mkAddressPoolGap' $ pv
  where
- mkAddressPoolGap' :: Word8 -> Either Text AddressPoolGap
+ mkAddressPoolGap' :: Word32 -> Either Text AddressPoolGap
  mkAddressPoolGap' = first msg . mkAddressPoolGap . fromIntegral
  msg e = T.pack $ "not a valid value: " <> show pv <> ": " <> show e
 
 instance PersistFieldSql AddressPoolGap where
- sqlType _ = sqlType (Proxy @Word8)
+ sqlType _ = sqlType (Proxy @Word32)
 
 ----------------------------------------------------------------------------
 -- AccountingStyle

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) #-}