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