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

[ADP-3344] Implement createPayment using balanceTx #4814

Merged
merged 7 commits into from
Nov 4, 2024
Merged

[ADP-3344] Implement createPayment using balanceTx #4814

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
7 commits
Select commit Hold shift + click to select a range
6b13278
Adapt to latest `cardano-wallet-agda`
HeinrichApfelmus Oct 29, 2024
303c4a9
Change argument of `signTx` from `Write.TxBody` to `Write.Tx`
HeinrichApfelmus Oct 28, 2024
905e18e
Implement `createPayment`, pure
HeinrichApfelmus Oct 21, 2024
4710c06
Add `currentPParams` to `NetworkEnv`
HeinrichApfelmus Oct 28, 2024
eb891da
Add `toTimeTranslationPure`
HeinrichApfelmus Oct 28, 2024
80aeecd
Implement `createPayment`, IO
HeinrichApfelmus Oct 28, 2024
842e571
Make `createPayment` scenario executable
HeinrichApfelmus Oct 29, 2024
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
4 changes: 2 additions & 2 deletions cabal.project
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -157,8 +157,8 @@ source-repository-package
source-repository-package
type: git
location: https://github.com/cardano-foundation/cardano-wallet-agda
tag: 20b263d494ee91d2f353e2645c045f728d7eb076
--sha256: 1j8mph2frsxqwq5ajsfhg0ixwxrs73dls34kbf0s0gh0y1gchvkb
tag: 04fb3e743ab874811d6c6850a218eee8bf110866
--sha256: 1m1kxinqir9a5i261ph7lah5wpy9qic9yqk47x54q65zws8r4ply
subdir:
lib/customer-deposit-wallet-pure
lib/cardano-wallet-read
Expand Down
4 changes: 4 additions & 0 deletions lib/customer-deposit-wallet/customer-deposit-wallet.cabal
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -57,6 +57,7 @@ library
, cardano-balance-tx
, cardano-crypto
, cardano-ledger-api
, cardano-ledger-core
, cardano-strict-containers
, cardano-wallet
, cardano-wallet-network-layer
Expand All @@ -67,16 +68,19 @@ library
, customer-deposit-wallet-pure
, delta-store
, delta-types
, digest
, fingertree
, io-classes
, microlens
, monoidal-containers
, mtl
, MonadRandom
, mwc-random
, OddWord
, random
, text
, time
, transformers

exposed-modules:
Cardano.Wallet.Deposit.IO
Expand Down
13 changes: 7 additions & 6 deletions lib/customer-deposit-wallet/rest/Cardano/Wallet/Deposit/REST.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -44,7 +44,7 @@ module Cardano.Wallet.Deposit.REST
-- ** Writing to the blockchain
, createPayment
, getBIP32PathsForOwnedInputs
, signTxBody
, signTx
, walletExists
, walletPublicIdentity
, deleteWallet
Expand Down Expand Up @@ -72,6 +72,7 @@ import Cardano.Wallet.Deposit.IO.Resource
)
import Cardano.Wallet.Deposit.Pure
( Customer
, ErrCreatePayment
, Word31
, fromXPubAndGenesis
)
Expand Down Expand Up @@ -405,16 +406,16 @@ getTxHistoryByTime = onWalletInstance WalletIO.getTxHistoryByTime

createPayment
:: [(Address, Read.Value)]
-> WalletResourceM (Maybe Write.TxBody)
-> WalletResourceM (Either ErrCreatePayment Write.Tx)
createPayment = onWalletInstance . WalletIO.createPayment

getBIP32PathsForOwnedInputs
:: Write.TxBody
:: Write.Tx
-> WalletResourceM [BIP32Path]
getBIP32PathsForOwnedInputs =
onWalletInstance . WalletIO.getBIP32PathsForOwnedInputs

signTxBody
:: Write.TxBody
signTx
:: Write.Tx
-> WalletResourceM (Maybe Write.Tx)
signTxBody = onWalletInstance . WalletIO.signTxBody
signTx = onWalletInstance . WalletIO.signTx
23 changes: 16 additions & 7 deletions lib/customer-deposit-wallet/src/Cardano/Wallet/Deposit/IO.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -33,7 +33,7 @@ module Cardano.Wallet.Deposit.IO
-- ** Writing to the blockchain
, createPayment
, getBIP32PathsForOwnedInputs
, signTxBody
, signTx
, WalletStore
, walletPublicIdentity
) where
Expand Down Expand Up @@ -85,6 +85,7 @@ import Data.Time
import qualified Cardano.Wallet.Deposit.IO.Network.Type as Network
import qualified Cardano.Wallet.Deposit.Pure as Wallet
import qualified Cardano.Wallet.Deposit.Read as Read
import qualified Cardano.Wallet.Deposit.Time as Time
import qualified Cardano.Wallet.Deposit.Write as Write
import qualified Control.Concurrent.Async as Async
import qualified Data.DBVar as DBVar
Expand Down Expand Up @@ -288,17 +289,25 @@ rollBackward w point =
------------------------------------------------------------------------------}

createPayment
:: [(Address, Read.Value)] -> WalletInstance -> IO (Maybe Write.TxBody)
createPayment a w =
Wallet.createPayment a <$> readWalletState w
:: [(Address, Read.Value)]
-> WalletInstance
-> IO (Either Wallet.ErrCreatePayment Write.Tx)
createPayment a w = do
timeTranslation <-
Time.toTimeTranslation <$> Network.getTimeInterpreter network
pparams <-
Network.currentPParams network
Wallet.createPayment pparams timeTranslation a <$> readWalletState w
where
network = networkEnv $ bootEnv $ env w

getBIP32PathsForOwnedInputs
:: Write.TxBody -> WalletInstance -> IO [BIP32Path]
:: Write.Tx -> WalletInstance -> IO [BIP32Path]
getBIP32PathsForOwnedInputs a w =
Wallet.getBIP32PathsForOwnedInputs a <$> readWalletState w

signTxBody :: Write.TxBody -> WalletInstance -> IO (Maybe Write.Tx)
signTxBody txbody w = Wallet.signTxBody txbody <$> readWalletState w
signTx :: Write.Tx -> WalletInstance -> IO (Maybe Write.Tx)
signTx a w = Wallet.signTx a <$> readWalletState w

{-----------------------------------------------------------------------------
Logging
Expand Down
2 changes: 2 additions & 0 deletions lib/customer-deposit-wallet/src/Cardano/Wallet/Deposit/IO/Network/Mock.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -89,6 +89,8 @@ newNetworkEnvMock = do
-- brief delay to account for asynchronous chain followers
threadDelay 100
pure $ Right ()
, currentPParams =
pure $ Read.EraValue Read.mockPParamsConway
, getTimeInterpreter =
pure Time.mockTimeInterpreter
, slotsToUTCTimes = pure . Time.unsafeSlotsToUTCTimes
Expand Down
3 changes: 3 additions & 0 deletions lib/customer-deposit-wallet/src/Cardano/Wallet/Deposit/IO/Network/Type.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -60,6 +60,9 @@ data NetworkEnv m block = NetworkEnv
:: Write.Tx
-> m (Either ErrPostTx ())
-- ^ Post a transaction to the Cardano network.
, currentPParams
:: m (Read.EraValue Read.PParams)
-- ^ Current protocol paramters.
, getTimeInterpreter
:: m Time.TimeInterpreter
-- ^ Get the current 'TimeInterpreter' from the Cardano node.
Expand Down
138 changes: 125 additions & 13 deletions lib/customer-deposit-wallet/src/Cardano/Wallet/Deposit/Pure.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -2,6 +2,7 @@
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeOperators #-}

module Cardano.Wallet.Deposit.Pure
Expand Down Expand Up @@ -38,11 +39,13 @@ module Cardano.Wallet.Deposit.Pure
, getTxHistoryByTime

-- ** Writing to the blockchain
, ErrCreatePayment (..)
, createPayment

, BIP32Path (..)
, DerivationType (..)
, getBIP32PathsForOwnedInputs
, signTxBody
, signTx
, addTxSubmission
, listTxsInSubmission

Expand Down Expand Up @@ -93,6 +96,15 @@ import Cardano.Wallet.Deposit.Read
, TxId
, WithOrigin
)
import Control.Monad.Trans.Except
( runExceptT
)
import Data.Bifunctor
( first
)
import Data.Digest.CRC32
( crc32
)
import Data.Foldable
( fold
, foldl'
Expand Down Expand Up @@ -127,6 +139,8 @@ import qualified Cardano.Wallet.Deposit.Pure.UTxO as UTxO
import qualified Cardano.Wallet.Deposit.Pure.UTxO.UTxOHistory as UTxOHistory
import qualified Cardano.Wallet.Deposit.Read as Read
import qualified Cardano.Wallet.Deposit.Write as Write
import qualified Cardano.Wallet.Read.Hash as Hash
import qualified Control.Monad.Random.Strict as Random
import qualified Data.Delta as Delta
import qualified Data.List as L
import qualified Data.Map.Strict as Map
Expand All @@ -139,11 +153,18 @@ type Customer = Address.Customer

data WalletState = WalletState
{ walletTip :: Read.ChainPoint
-- ^ The wallet includes information from all blocks until
-- and including this one.
, addresses :: !Address.AddressState
-- ^ Addresses and public keys known to this wallet.
, utxoHistory :: !UTxOHistory.UTxOHistory
-- ^ UTxO of this wallet, with support for rollbacks.
, txHistory :: !TxHistory
-- ^ (Summarized) transaction history of this wallet.
, submissions :: Sbm.TxSubmissions
-- ^ Queue of pending transactions.
, rootXSignKey :: Maybe XPrv
-- ^ Maybe a private key for signing transactions.
-- , info :: !WalletInfo
}

Expand Down Expand Up @@ -217,7 +238,7 @@ fromXPubAndGenesis xpub knownCustomerCount genesisData =
{ walletTip = Read.GenesisPoint
, addresses =
Address.fromXPubAndCount network xpub knownCustomerCount
, utxoHistory = UTxOHistory.empty initialUTxO
, utxoHistory = UTxOHistory.fromOrigin initialUTxO
, txHistory = mempty
, submissions = Sbm.empty
, rootXSignKey = Nothing
Expand Down Expand Up @@ -342,23 +363,109 @@ wonders interval =

{-----------------------------------------------------------------------------
Operations
Writing to blockchain
Constructing transactions
------------------------------------------------------------------------------}
data ErrCreatePayment
= ErrCreatePaymentNotRecentEra (Read.EraValue Read.Era)
| ErrCreatePaymentBalanceTx (Write.ErrBalanceTx Write.Conway)
deriving (Eq, Show)

-- | Create a payment to a list of destinations.
createPayment
:: [(Address, Write.Value)] -> WalletState -> Maybe Write.TxBody
createPayment = undefined
:: Read.EraValue Read.PParams
-> Write.TimeTranslation
-> [(Address, Write.Value)]
-> WalletState
-> Either ErrCreatePayment Write.Tx
createPayment (Read.EraValue (Read.PParams pparams :: Read.PParams era)) a b w =
case Read.theEra :: Read.Era era of
Read.Conway ->
first ErrCreatePaymentBalanceTx
$ createPaymentConway pparams a b w
era' -> Left $ ErrCreatePaymentNotRecentEra (Read.EraValue era')

-- | In the Conway era: Create a payment to a list of destinations.
createPaymentConway
:: Write.PParams Write.Conway
-> Write.TimeTranslation
-> [(Address, Write.Value)]
-> WalletState
-> Either (Write.ErrBalanceTx Write.Conway) Write.Tx
createPaymentConway pparams timeTranslation destinations w =
Copy link
Member

Choose a reason for hiding this comment

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

Frankly — I don't think eventually duplicating createPaymentConway and createPaymentNextEra seem that appealing. Why not have the implementation for any IsRecentEra era?

Copy link
Member

Choose a reason for hiding this comment

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

IsRecentEra era

On this note, I actually still suspect it would be better to consistently keep two eras as "recent" so that we don't forget details which matter only when supporting an era which isn't the latest one, for when we have to before the HF. For instance, that the utxo in theory could be newer than the era where toConwayUTxO might fail (although in practice, this might require both switching nodes and a race condition... 🤔)

Copy link
Contributor Author

@HeinrichApfelmus HeinrichApfelmus Oct 30, 2024 •
edited
Loading

Choose a reason for hiding this comment

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

I generally agree on the IsRecentEra era polymorphism.

However, for the Deposit Wallet MVP, I figured that I would limit the scope to Conway — that's why Cardano.Wallet.Deposit.Write.Tx is pinned to a single era for now.

As for the actual implementation of era-polymorphic functions: It's a matter of code reuse — the function createPaymentConway can be reused in an era-polymorphic implementation, or it can be cheaper to write createPaymentPolymorphic directly.

Compare

fooPolymorphic :: IsRecentEra era => Thing era
fooPolymorphic = … barConway … barDonway …

barConway :: Otherthing Conway
barDonway :: Otherthing Donway

vs

fooPolymorphic :: IsRecentEra era => Thing era
fooPolymorphic = … barPolymorphic …

barPolymorphic :: IsRecentEra era => Otherthing Conway era

The second style tends to use lines of code more efficiently, but not always due to case distinctions and type inference. The first style can always be wrapped into the second style by adding code rather than changing it.

fmap (Read.Tx . fst)
. flip Random.evalRand (pilferRandomGen w)
. runExceptT
. balance
(availableUTxO w)
(addresses w)
. mkPartialTx
$ paymentTxBody
where
paymentTxBody :: Write.TxBody
paymentTxBody = Write.TxBody
{ spendInputs = mempty
, collInputs = mempty
, txouts =
Map.fromList $ zip [(toEnum 0)..] $ map (uncurry Write.mkTxOut) destinations
, collRet = Nothing
}

mkPartialTx :: Write.TxBody -> Write.PartialTx Write.Conway
mkPartialTx txbody = Write.PartialTx
{ tx = Read.unTx $ Write.mkTx txbody
, extraUTxO = mempty :: Write.UTxO Write.Conway
, redeemers = mempty
, stakeKeyDeposits = Write.StakeKeyDepositMap mempty
, timelockKeyWitnessCounts = Write.TimelockKeyWitnessCounts mempty
}

balance utxo addressState =
Write.balanceTx
pparams
timeTranslation
Write.AllKeyPaymentCredentials
(Write.constructUTxOIndex $ Write.toConwayUTxO utxo)
(changeAddressGen addressState)
()

changeAddressGen s = Write.ChangeAddressGen
{ Write.genChangeAddress =
first Read.decompactAddr . Address.newChangeAddress s
, Write.maxLengthChangeAddress =
Read.decompactAddr $ Address.mockMaxLengthChangeAddress s
}

-- | Use entropy contained in the current 'WalletState'
-- to construct a pseudorandom seed.
-- (NOT a viable source of cryptographic randomness.)
--
-- Possible downsides of this approach:
--
-- 1. security/privacy
-- 2. concurrency
-- 3. retries for different coin selections
pilferRandomGen :: WalletState -> Random.StdGen
Copy link
Member

Choose a reason for hiding this comment

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

It not being IO is neat! But I wonder if there are any downsides with either getting it from WalletState in general or from walletTip specifically 🤔

E.g. possibly re 1) security/privacy or 2) concurrency or 3) retries for different selections

Copy link
Contributor Author

@HeinrichApfelmus HeinrichApfelmus Oct 30, 2024 •
edited
Loading

Choose a reason for hiding this comment

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

🤔 My thinking was that balanceTx uses a randomized algorithm to improve the result, but the presence or absence of a result should not materially depend on randomization.

  1. Hm. In principle, it could be possible to reverse-engineer information about the StdGen and therefore information about the ChainPoint from the observed selection of coins.
  2. You're probably referring to the fact that concurrent calls to balanceTx with the same UTxO may have a higher likelihood of selecting different inputs.
  3. Similar to 2). The necessity to retry would indicate a material defect in the balanceTx, though. ("Sometimes it gives a result, sometimes it doesn't".)

Alternative designs:

  • Keep track of a StdGen in WalletState. Avoids 1 by revealing only uninteresting information.
  • Use a cryptographic hash of the transaction as source of randomness. Avoids 1 and 2.

The point 3 cannot be changed in a stateless manner — you'd need to know about previous attempts at calling balanceTx. A fast-evolving source of randomness can mitigate this, but I think that it's better to have balanceTx not fail randomly.

Copy link
Member

@Anviking Anviking Nov 1, 2024 •
edited
Loading

Choose a reason for hiding this comment

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

  1. Hm. In principle, it could be possible to reverse-engineer information about the StdGen and therefore information about the ChainPoint from the observed selection of coins.

I was more thinking that: if utxo, walletTip, guessPartialTx onchainTx can determinsitically produce the resulting onchainTx, it could make correlating enterprise addresses from the same wallet easer, and possibly in some new sense leak information about the utxo set as a whole. However... one would have to guess the walletTip at the time of tx construction, which might make the approach worthless even with just a few likely tips.

You're probably referring to the fact that concurrent calls to balanceTx with the same UTxO may have a higher likelihood of selecting different inputs.

*the same inputs, yes. And I think there's a decent chance it's guaranteed. But... this may possibly not be terrible as you shouldn't rely on randomness to prevent selecting the same inputs anyway 🤷‍♂️

Similar to 2). The necessity to retry would indicate a material defect in the balanceTx, though. ("Sometimes it gives a result, sometimes it doesn't".)

Not necessarily. There could be cases where the user as strong opinions on the selection and would like to discard it to try again.

As for retries not being an intended solution for failing balanceTx results, I do agree. (Whether balanceTx should be guaranteed to find the only succeeding selection in tricky situations if such exists is another question though. I suspect we only need/want some balance >= paymentAmt + delta => can make payment property to hold, and are ok with the result sometimes succeeding and sometimes failing when paymentAmt <= balance <= paymentAmt + delta)

Keep track of a StdGen in WalletState. Avoids 1 by revealing only uninteresting information.

If you provide a non-public initial seed, probably 🤔

Use a cryptographic hash of the transaction as source of randomness. Avoids 1 and 2.

What tx? The one that isn't constructed yet? Identical partial txs may be balanced and submitted repeatedly. We could use all arguments to balanceTx as source of randomness though (in particular the utxo set). This wouldn't avoid 1 though (or it might depend on how far-fetched or realistic 1 is).

Copy link
Member

Choose a reason for hiding this comment

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

Anyway, happy to go with the approach you have, as it's interesting and I see no clear problem with it, but I did want to raise the points.

pilferRandomGen =
Random.mkStdGen . fromEnum . fromChainPoint . walletTip
where
fromChainPoint (Read.GenesisPoint) = 0
fromChainPoint (Read.BlockPoint _ headerHash) =
crc32 $ Hash.hashToBytes headerHash

-- needs balanceTx
-- needs to sign the transaction
{-----------------------------------------------------------------------------
Operations
Signing transactions
------------------------------------------------------------------------------}

getBIP32PathsForOwnedInputs
:: Write.TxBody -> WalletState -> [BIP32Path]
getBIP32PathsForOwnedInputs txbody w =
getBIP32PathsForOwnedInputs :: Write.Tx -> WalletState -> [BIP32Path]
getBIP32PathsForOwnedInputs tx w =
getBIP32Paths w
. resolveInputAddresses
$ Write.spendInputs txbody <> Write.collInputs txbody
$ Write.spendInputs txBody <> Write.collInputs txBody
where
txBody :: Write.TxBody
txBody = undefined tx

resolveInputAddresses :: Set Read.TxIn -> [Read.Address]
resolveInputAddresses ins =
map (Read.address . snd)
Expand All @@ -369,8 +476,13 @@ getBIP32Paths :: WalletState -> [Read.Address] -> [BIP32Path]
getBIP32Paths w =
mapMaybe $ Address.getBIP32Path (addresses w)

signTxBody :: Write.TxBody -> WalletState -> Maybe Write.Tx
signTxBody _txbody _w = undefined
signTx :: Write.Tx -> WalletState -> Maybe Write.Tx
signTx _tx _w = undefined

{-----------------------------------------------------------------------------
Operations
Pending transactions
------------------------------------------------------------------------------}

addTxSubmission :: Write.Tx -> WalletState -> WalletState
addTxSubmission _tx _w = undefined
Expand Down
Loading
Loading