Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Jump to bottom

Address slow fee estimation on Byron wallets #2128

Merged
merged 3 commits into from
Sep 9, 2020
Merged

Address slow fee estimation on Byron wallets #2128

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
3 commits
Select commit Hold shift + click to select a range
5f274e6
extend post-restoration benchmark wallet overview with number of addr…
KtorZ Sep 9, 2020
6c4b1c8
do not construct dummy bootstrap witnesses but apply a correction on …
KtorZ Sep 9, 2020
3e628f0
adjust byron migration test assertion due to recent change
KtorZ Sep 9, 2020
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
7 changes: 4 additions & 3 deletions lib/core-integration/src/Test/Integration/Scenario/API/Byron/Migrations.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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.
Expand Down Expand Up @@ -207,7 +208,7 @@ spec = do
testAddressCycling ctx 3
testAddressCycling ctx 10

it "BYRON_MIGRATE_01 - \
Hspec.it "BYRON_MIGRATE_01 - \
Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

we want to revert this to our it, right?

Copy link
Contributor

@piotr-iohk piotr-iohk Sep 9, 2020 •
edited
Loading

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Using regular Hspec.it makes sense here I think, because those tests use specific mnemonic wallets, so in case when those tests fail the subsequent run will result in 409 - wallet already exists anyway...

Copy link
Member Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Using regular Hspec.it makes sense here I think, because those tests use specific mnemonic wallets

Indeed. We don't want to retry these tests because they use a hard-coded mnemonic. So I changed it back to the standard hspec "it" to make debugging easier.

Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

What about prefixing the retrying version it with sh to clarify its function? (sorry, couldn't resist 😁)

\ migrate a big wallet requiring more than one tx" $ \ctx -> do
-- NOTE
-- Special mnemonic for which 200 legacy funds are attached to in the
Expand Down Expand Up @@ -266,7 +267,7 @@ spec = do
Default
payloadMigrate >>= flip verify
[ expectResponseCode @IO HTTP.status202
, expectField id ((`shouldBe` 17). length)
, expectField id ((`shouldBe` 20). length)
Copy link
Member Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

The fee estimation for Byron witnesses is slightly less accurate than before with this change, so fees are evaluated slightly in excess. We could spend more time tweaking numbers but I think it's good enough already even though it means that transactions costs a little bit more.

]

-- Check that funds become available in the target wallet:
Expand Down Expand Up @@ -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
Expand Down
5 changes: 3 additions & 2 deletions lib/core-integration/src/Test/Integration/Scenario/API/Shelley/Migrations.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -167,7 +168,7 @@ spec = do
testAddressCycling 3
testAddressCycling 10

it "SHELLEY_MIGRATE_01_big_wallet - \
Hspec.it "SHELLEY_MIGRATE_01_big_wallet - \
Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

the same here

\ migrate a big wallet requiring more than one tx" $ \ctx -> do

-- NOTE
Expand Down Expand Up @@ -273,7 +274,7 @@ spec = do
, expectErrorMessage (errMsg403NothingToMigrate srcId)
]

it "SHELLEY_MIGRATE_02 - \
Hspec.it "SHELLEY_MIGRATE_02 - \
Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

the same here

\migrating wallet with dust should fail."
$ \ctx -> do
-- NOTE
Expand Down
103 changes: 78 additions & 25 deletions lib/shelley/bench/Restore.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,6 +1,5 @@
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleContexts #-}
Expand Down Expand Up @@ -103,6 +102,7 @@ import Cardano.Wallet.Primitive.Types
, GenesisParameters (..)
, NetworkParameters (..)
, SlotNo (..)
, SortOrder (..)
, TxOut (..)
, UTxOStatistics (..)
, WalletId (..)
Expand Down Expand Up @@ -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
Expand All @@ -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
Expand Down Expand Up @@ -338,22 +348,44 @@ data SomeBenchmarkResults where
instance Buildable SomeBenchmarkResults where
build (SomeBenchmarkResults results) = build results

data BenchRndResults s = BenchRndResults
data WalletOverview = WalletOverview
Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

👍

{ 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.
Expand All @@ -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)
Expand All @@ -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]
Expand All @@ -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.
Expand All @@ -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) #-}
Expand Down
83 changes: 36 additions & 47 deletions lib/shelley/src/Cardano/Wallet/Shelley/Transaction.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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
Expand Down Expand Up @@ -466,7 +491,7 @@ computeTxSize networkId witTag md action cs =
TxWitnessShelleyUTxO ->
addrWits <> certWits
TxWitnessByronUTxO{} ->
byronWits
addrWits

(addrWits, certWits) =
( mconcat
Expand Down Expand Up @@ -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

Expand Down
Loading