Skip to content

Commit

Permalink
Don't take AnyCardanoEra for tx size estimations
Browse files Browse the repository at this point in the history
No need currently. We know implicitly that the era is a recent era.
  • Loading branch information
Anviking committed May 29, 2023
1 parent f5bbe6c commit 0ebeb88
Show file tree
Hide file tree
Showing 7 changed files with 78 additions and 153 deletions.
33 changes: 15 additions & 18 deletions lib/wallet/api/http/Cardano/Wallet/Api/Http/Shelley/Server.hs
Expand Up @@ -1786,7 +1786,7 @@ selectCoins ctx@ApiLayer {..} argGenChange (ApiT walletId) body = do
body ^. #withdrawal
& maybe (pure NoWithdrawal)
(shelleyOnlyMkWithdrawal @s
netLayer (txWitnessTagFor @k) db era)
netLayer (txWitnessTagFor @k) db)
let genChange = W.defaultChangeAddressGen argGenChange
let paymentOuts = NE.toList $ addressAmountToTxOut <$> body ^. #payments
let txCtx = defaultTransactionCtx
Expand Down Expand Up @@ -1909,7 +1909,7 @@ selectCoinsForQuit ctx@ApiLayer{..} (ApiT walletId) = do
toTimeTranslation (timeInterpreter netLayer)
pp <- NW.currentProtocolParameters netLayer
withdrawal <- W.shelleyOnlyMkSelfWithdrawal @s
netLayer (txWitnessTagFor @k) era db
netLayer (txWitnessTagFor @k) db
action <- WD.quitStakePoolDelegationAction db withdrawal
let changeAddrGen = W.defaultChangeAddressGen (delegationAddressS @n)
let txCtx = defaultTransactionCtx
Expand Down Expand Up @@ -2193,7 +2193,7 @@ postTransactionOld ctx@ApiLayer{..} argGenChange (ApiT wid) body = do
Nothing -> pure NoWithdrawal
Just apiWdrl ->
shelleyOnlyMkWithdrawal @s
netLayer (txWitnessTagFor @k) db era apiWdrl
netLayer (txWitnessTagFor @k) db apiWdrl
let txCtx = defaultTransactionCtx
{ txWithdrawal = wdrl
, txMetadata = md
Expand Down Expand Up @@ -2375,9 +2375,9 @@ postTransactionFeeOld ctx@ApiLayer{..} (ApiT walletId) body = do
Nothing -> pure NoWithdrawal
Just apiWdrl ->
shelleyOnlyMkWithdrawal @s
netLayer (txWitnessTagFor @k) db era apiWdrl
netLayer (txWitnessTagFor @k) db apiWdrl
let outputs = F.toList $ addressAmountToTxOut <$> body ^. #payments
minCoins = W.calcMinimumCoinValues protocolParameters txLayer era
minCoins = W.calcMinimumCoinValues protocolParameters txLayer
<$> outputs
feePercentiles <- liftIO $ W.transactionFee @s
db
Expand Down Expand Up @@ -2473,7 +2473,7 @@ constructTransaction api argGenChange knownPools poolStatus apiWalletId body = d
withdrawal <- case body ^. #withdrawal of
Just SelfWithdraw -> liftIO $
W.shelleyOnlyMkSelfWithdrawal
netLayer (txWitnessTagFor @k) era db
netLayer (txWitnessTagFor @k) db
_ -> pure NoWithdrawal

let transactionCtx0 = defaultTransactionCtx
Expand Down Expand Up @@ -3746,13 +3746,12 @@ createMigrationPlan
createMigrationPlan ctx@ApiLayer{..} withdrawalType (ApiT wid) postData =
withWorkerCtx ctx wid liftE liftE $ \wrk -> do
let db = wrk ^. dbLayer
era <- liftIO $ NW.currentNodeEra netLayer
rewardWithdrawal <- case withdrawalType of
Nothing -> pure NoWithdrawal
Just pd -> shelleyOnlyMkWithdrawal @s
netLayer (txWitnessTagFor @k) db era pd
netLayer (txWitnessTagFor @k) db pd
(wallet, _, _) <- handler $ W.readWallet wrk
plan <- handler $ W.createMigrationPlan @_ wrk era rewardWithdrawal
plan <- handler $ W.createMigrationPlan @_ wrk rewardWithdrawal
liftHandler
$ failWith ErrCreateMigrationPlanEmpty
$ mkApiWalletMigrationPlan
Expand Down Expand Up @@ -3851,8 +3850,8 @@ migrateWallet ctx@ApiLayer{..} withdrawalType (ApiT wid) postData = do
rewardWithdrawal <- case withdrawalType of
Nothing -> pure NoWithdrawal
Just pd -> shelleyOnlyMkWithdrawal @s
netLayer (txWitnessTagFor @k) db era pd
plan <- handler $ W.createMigrationPlan @_ wrk era rewardWithdrawal
netLayer (txWitnessTagFor @k) db pd
plan <- handler $ W.createMigrationPlan @_ wrk rewardWithdrawal
ttl <- liftIO $ W.transactionExpirySlot ti Nothing
pp <- liftIO $ NW.currentProtocolParameters netLayer
selectionWithdrawals <- liftHandler
Expand Down Expand Up @@ -4222,15 +4221,14 @@ mkWithdrawal
. NetworkLayer IO block
-> TxWitnessTag
-> DBLayer IO (SeqState n ShelleyKey)
-> AnyCardanoEra
-> ApiWithdrawalPostData
-> Handler Withdrawal
mkWithdrawal netLayer txWitnessTag db era = \case
mkWithdrawal netLayer txWitnessTag db = \case
SelfWithdrawal ->
liftIO $ W.mkSelfWithdrawal netLayer txWitnessTag era db
liftIO $ W.mkSelfWithdrawal netLayer txWitnessTag db
ExternalWithdrawal (ApiMnemonicT mnemonic) ->
liftHandler . ExceptT
$ W.mkExternalWithdrawal netLayer txWitnessTag era mnemonic
$ W.mkExternalWithdrawal netLayer txWitnessTag mnemonic

-- | Unsafe version of `mkWithdrawal` that throws runtime error
-- when applied to a non-shelley or non-sequential wallet state.
Expand All @@ -4240,13 +4238,12 @@ shelleyOnlyMkWithdrawal
=> NetworkLayer IO block
-> TxWitnessTag
-> DBLayer IO s
-> AnyCardanoEra
-> ApiWithdrawalPostData
-> Handler Withdrawal
shelleyOnlyMkWithdrawal netLayer txWitnessTag db era postData =
shelleyOnlyMkWithdrawal netLayer txWitnessTag db postData =
case walletFlavor @s of
ShelleyWallet ->
mkWithdrawal netLayer txWitnessTag db era postData
mkWithdrawal netLayer txWitnessTag db postData
_ -> notShelleyWallet
where
notShelleyWallet =
Expand Down
6 changes: 2 additions & 4 deletions lib/wallet/bench/api-bench.hs
Expand Up @@ -256,9 +256,8 @@ benchmarksSeq BenchmarkConfig{benchmarkName,ctx} = do
$ W.listTransactions @_ @s ctx
Nothing Nothing Nothing Descending (Just 50)

let era = Cardano.anyCardanoEra Cardano.BabbageEra
(_, createMigrationPlanTime) <- bench "createMigrationPlan"
$ W.createMigrationPlan @_ @s ctx era Tx.NoWithdrawal
$ W.createMigrationPlan @_ @s ctx Tx.NoWithdrawal

(_, delegationFeeTime) <- bench "delegationFee" $ do
timeTranslation <-
Expand Down Expand Up @@ -410,9 +409,8 @@ benchmarksRnd BenchmarkConfig{benchmarkName,ctx} = do
$ W.listTransactions @_ @s ctx
Nothing Nothing Nothing Descending (Just 50)

let era = Cardano.anyCardanoEra Cardano.BabbageEra
(_, createMigrationPlanTime) <- bench "createMigrationPlan"
$ W.createMigrationPlan @_ @s ctx era Tx.NoWithdrawal
$ W.createMigrationPlan @_ @s ctx Tx.NoWithdrawal

pure BenchRndResults
{ benchName = benchmarkName
Expand Down
42 changes: 17 additions & 25 deletions lib/wallet/src/Cardano/Wallet.hs
Expand Up @@ -231,7 +231,7 @@ import Cardano.Address.Derivation
import Cardano.Address.Script
( Cosigner (..), KeyHash )
import Cardano.Api
( AnyCardanoEra, serialiseToCBOR )
( serialiseToCBOR )
import Cardano.Api.Extra
( inAnyCardanoEra )
import Cardano.BM.Data.Severity
Expand Down Expand Up @@ -968,27 +968,25 @@ getWalletUtxoSnapshot
getWalletUtxoSnapshot ctx = do
(wallet, _, pending) <- readWallet @ctx @s ctx
pp <- liftIO $ currentProtocolParameters nl
era <- liftIO $ currentNodeEra nl
let txOuts = availableUTxO @s pending wallet
& unUTxO
& F.toList
pure $ first (view #tokens) . pairTxOutWithMinAdaQuantity era pp <$> txOuts
pure $ first (view #tokens) . pairTxOutWithMinAdaQuantity pp <$> txOuts
where
nl = ctx ^. networkLayer
tl = ctx ^. transactionLayer @(KeyOf s) @(CredFromOf s)

pairTxOutWithMinAdaQuantity
:: Cardano.AnyCardanoEra
-> ProtocolParameters
:: ProtocolParameters
-> TxOut
-> (TxOut, Coin)
pairTxOutWithMinAdaQuantity era pp out =
pairTxOutWithMinAdaQuantity pp out =
(out, computeMinAdaQuantity out)
where
computeMinAdaQuantity :: TxOut -> Coin
computeMinAdaQuantity (TxOut addr bundle) =
view #txOutputMinimumAdaQuantity
(constraints tl era pp)
(constraints tl pp)
(addr)
(view #tokens bundle)

Expand Down Expand Up @@ -1228,29 +1226,27 @@ fetchRewardBalance DBLayer{..} = atomically readDelegationRewardBalance
mkExternalWithdrawal
:: NetworkLayer IO block
-> TxWitnessTag
-> AnyCardanoEra
-> SomeMnemonic
-> IO (Either ErrWithdrawalNotBeneficial Withdrawal)
mkExternalWithdrawal netLayer txWitnessTag era mnemonic = do
mkExternalWithdrawal netLayer txWitnessTag mnemonic = do
let (_, rewardAccount, derivationPath) =
someRewardAccount @ShelleyKey mnemonic
balance <- getCachedRewardAccountBalance netLayer rewardAccount
pp <- currentProtocolParameters netLayer
let (xprv, _acct , _path) = someRewardAccount @ShelleyKey mnemonic
pure $ checkRewardIsWorthTxCost txWitnessTag pp era balance $>
pure $ checkRewardIsWorthTxCost txWitnessTag pp balance $>
WithdrawalExternal rewardAccount derivationPath balance xprv

mkSelfWithdrawal
:: NetworkLayer IO block
-> TxWitnessTag
-> AnyCardanoEra
-> DBLayer IO (SeqState n ShelleyKey)
-> IO Withdrawal
mkSelfWithdrawal netLayer txWitnessTag era db = do
mkSelfWithdrawal netLayer txWitnessTag db = do
(rewardAccount, _, derivationPath) <- readRewardAccount db
balance <- getCachedRewardAccountBalance netLayer rewardAccount
pp <- currentProtocolParameters netLayer
pure $ case checkRewardIsWorthTxCost txWitnessTag pp era balance of
pure $ case checkRewardIsWorthTxCost txWitnessTag pp balance of
Left ErrWithdrawalNotBeneficial -> NoWithdrawal
Right () -> WithdrawalSelf rewardAccount derivationPath balance

Expand All @@ -1261,12 +1257,11 @@ shelleyOnlyMkSelfWithdrawal
. WalletFlavor s
=> NetworkLayer IO block
-> TxWitnessTag
-> AnyCardanoEra
-> DBLayer IO s
-> IO Withdrawal
shelleyOnlyMkSelfWithdrawal netLayer txWitnessTag era db =
shelleyOnlyMkSelfWithdrawal netLayer txWitnessTag db =
case walletFlavor @s of
ShelleyWallet -> mkSelfWithdrawal netLayer txWitnessTag era db
ShelleyWallet -> mkSelfWithdrawal netLayer txWitnessTag db
_ -> notShelleyWallet
where
notShelleyWallet = throwIO
Expand All @@ -1275,14 +1270,13 @@ shelleyOnlyMkSelfWithdrawal netLayer txWitnessTag era db =
checkRewardIsWorthTxCost
:: TxWitnessTag
-> ProtocolParameters
-> AnyCardanoEra
-> Coin
-> Either ErrWithdrawalNotBeneficial ()
checkRewardIsWorthTxCost txWitnessTag pp era balance = do
checkRewardIsWorthTxCost txWitnessTag pp balance = do
when (balance == Coin 0)
$ Left ErrWithdrawalNotBeneficial
let minimumCost txCtx =
calculateMinimumFee era feePerByte txWitnessTag txCtx emptySkeleton
calculateMinimumFee feePerByte txWitnessTag txCtx emptySkeleton
costWith = minimumCost $ mkTxCtx balance
costWithout = minimumCost $ mkTxCtx $ Coin 0
worthOfWithdrawal = Coin.toInteger costWith - Coin.toInteger costWithout
Expand Down Expand Up @@ -1774,11 +1768,10 @@ readWalletUTxO ctx = do
calcMinimumCoinValues
:: ProtocolParameters
-> TransactionLayer k ktype tx
-> Cardano.AnyCardanoEra
-> TxOut
-> Coin
calcMinimumCoinValues pp txLayer era =
uncurry (constraints txLayer era pp ^. #txOutputMinimumAdaQuantity)
calcMinimumCoinValues pp txLayer =
uncurry (constraints txLayer pp ^. #txOutputMinimumAdaQuantity)
. (\o -> (o ^. #address, o ^. #tokens . #tokens))

signTransaction
Expand Down Expand Up @@ -2643,13 +2636,12 @@ createMigrationPlan
, HasTransactionLayer (KeyOf s) 'CredFromKeyK ctx
)
=> ctx
-> Cardano.AnyCardanoEra
-> Withdrawal
-> IO MigrationPlan
createMigrationPlan ctx era rewardWithdrawal = do
createMigrationPlan ctx rewardWithdrawal = do
(wallet, _, pending) <- readWallet @ctx @s ctx
pp <- liftIO $ currentProtocolParameters nl
let txConstraints = constraints tl era pp
let txConstraints = constraints tl pp
let utxo = availableUTxO @s pending wallet
pure
$ Migration.createPlan txConstraints utxo
Expand Down

0 comments on commit 0ebeb88

Please sign in to comment.