From fc1da5111eb78a648ac4fb14a9cef742519be205 Mon Sep 17 00:00:00 2001 From: KtorZ Date: Wed, 9 Sep 2020 15:29:07 +0200 Subject: [PATCH 1/3] 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. --- lib/shelley/bench/Restore.hs | 103 ++++++++++++++++++++++++++--------- 1 file changed, 78 insertions(+), 25 deletions(-) diff --git a/lib/shelley/bench/Restore.hs b/lib/shelley/bench/Restore.hs index 83fbc56a4d1..6f65e9ec36f 100644 --- a/lib/shelley/bench/Restore.hs +++ b/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) #-} From a234e492fb99728eed38c72b05d5b0e0a409f347 Mon Sep 17 00:00:00 2001 From: KtorZ Date: Wed, 9 Sep 2020 15:42:26 +0200 Subject: [PATCH 2/3] 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. --- .../src/Cardano/Wallet/Shelley/Transaction.hs | 83 ++++++++----------- 1 file changed, 36 insertions(+), 47 deletions(-) diff --git a/lib/shelley/src/Cardano/Wallet/Shelley/Transaction.hs b/lib/shelley/src/Cardano/Wallet/Shelley/Transaction.hs index a211fb0b66c..3a484725fc7 100644 --- a/lib/shelley/src/Cardano/Wallet/Shelley/Transaction.hs +++ b/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 From fc9d4ff0c636188c6f43ba65f0751a27325f540a Mon Sep 17 00:00:00 2001 From: KtorZ Date: Wed, 9 Sep 2020 16:08:25 +0200 Subject: [PATCH 3/3] 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. --- .../src/Test/Integration/Scenario/API/Byron/Migrations.hs | 7 ++++--- .../Test/Integration/Scenario/API/Shelley/Migrations.hs | 5 +++-- 2 files changed, 7 insertions(+), 5 deletions(-) diff --git a/lib/core-integration/src/Test/Integration/Scenario/API/Byron/Migrations.hs b/lib/core-integration/src/Test/Integration/Scenario/API/Byron/Migrations.hs index fe41852dcd0..f4cd1c355d1 100644 --- a/lib/core-integration/src/Test/Integration/Scenario/API/Byron/Migrations.hs +++ b/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 diff --git a/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/Migrations.hs b/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/Migrations.hs index eb281e5ac45..4104d10d8ca 100644 --- a/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/Migrations.hs +++ b/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