Skip to content
Permalink
Browse files

Merge pull request #511 from input-output-hk/piotr/estimate_testing

ValidateSelection extension, errors and new estimate fee endpoint test cases
  • Loading branch information...
KtorZ committed Jul 11, 2019
2 parents f683a6d + e8b058b commit cfff5f7f410f242947c7975c08078f552e9a359f
Showing with 584 additions and 234 deletions.
  1. +38 −32 lib/core/src/Cardano/Wallet.hs
  2. +19 −21 lib/core/src/Cardano/Wallet/Api/Server.hs
  3. +1 −0 lib/core/src/Cardano/Wallet/Api/Types.hs
  4. +31 −24 lib/core/src/Cardano/Wallet/Primitive/CoinSelection.hs
  5. +10 −5 lib/core/src/Cardano/Wallet/Primitive/CoinSelection/LargestFirst.hs
  6. +24 −18 lib/core/src/Cardano/Wallet/Primitive/CoinSelection/Random.hs
  7. +22 −5 lib/core/src/Cardano/Wallet/Transaction.hs
  8. +10 −4 lib/core/test/integration/Test/Integration/Framework/TestData.hs
  9. +51 −37 lib/core/test/integration/Test/Integration/Scenario/API/Transactions.hs
  10. +45 −28 lib/core/test/unit/Cardano/Wallet/Primitive/CoinSelection/LargestFirstSpec.hs
  11. +52 −22 lib/core/test/unit/Cardano/Wallet/Primitive/CoinSelection/RandomSpec.hs
  12. +22 −6 lib/core/test/unit/Cardano/Wallet/Primitive/CoinSelectionSpec.hs
  13. +1 −1 lib/core/test/unit/Cardano/Wallet/Primitive/FeeSpec.hs
  14. +0 −1 lib/core/test/unit/Cardano/Wallet/TransactionSpec.hs
  15. +3 −1 lib/core/test/unit/Cardano/WalletSpec.hs
  16. +20 −3 lib/http-bridge/src/Cardano/Wallet/HttpBridge/Transaction.hs
  17. +38 −14 lib/http-bridge/test/integration/Test/Integration/HttpBridge/Scenario/API/Transactions.hs
  18. +40 −3 lib/http-bridge/test/integration/Test/Integration/HttpBridge/Scenario/CLI/Transactions.hs
  19. +1 −1 lib/http-bridge/test/unit/Cardano/Wallet/HttpBridge/TransactionSpec.hs
  20. +1 −0 lib/jormungandr/cardano-wallet-jormungandr.cabal
  21. +13 −3 lib/jormungandr/src/Cardano/Wallet/Jormungandr/Binary.hs
  22. +35 −3 lib/jormungandr/src/Cardano/Wallet/Jormungandr/Transaction.hs
  23. +3 −0 lib/jormungandr/test/integration/Main.hs
  24. +102 −0 lib/jormungandr/test/integration/Test/Integration/Jormungandr/Scenario/API/Transactions.hs
  25. +2 −2 lib/jormungandr/test/unit/Cardano/Wallet/Jormungandr/TransactionSpec.hs
@@ -7,6 +7,7 @@
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}

-- |
-- Copyright: © 2018-2019 IOHK
@@ -22,20 +23,21 @@ module Cardano.Wallet
WalletLayer (..)

-- * Errors
, ErrAdjustForFee (..)
, ErrCoinSelection (..)
, ErrCreateUnsignedTx (..)
, ErrEstimateTxFee (..)
, ErrMkStdTx (..)
, ErrNetworkUnreachable (..)
, ErrNoSuchWallet (..)
, ErrPostTx (..)
, ErrSignTx (..)
, ErrSubmitTx (..)
, ErrUpdatePassphrase (..)
, ErrValidateSelection
, ErrWalletAlreadyExists (..)
, ErrWithRootKey (..)
, ErrWrongPassphrase (..)
, ErrMkStdTx (..)
, ErrPostTx (..)
, ErrNetworkUnreachable (..)
, ErrCoinSelection (..)
, ErrAdjustForFee (..)

-- * Construction
, newWalletLayer
@@ -73,7 +75,7 @@ import Cardano.Wallet.Primitive.AddressDiscovery
)
import Cardano.Wallet.Primitive.CoinSelection
( CoinSelection (..)
, CoinSelectionOptions
, CoinSelectionOptions (..)
, ErrCoinSelection (..)
, shuffle
)
@@ -119,7 +121,7 @@ import Cardano.Wallet.Primitive.Types
, slotRatio
)
import Cardano.Wallet.Transaction
( ErrMkStdTx (..), TransactionLayer (..) )
( ErrMkStdTx (..), ErrValidateSelection, TransactionLayer (..) )
import Cardano.Wallet.Unsafe
( unsafeRunExceptT )
import Control.Arrow
@@ -235,22 +237,20 @@ data WalletLayer s t = WalletLayer
-- are ordered from the most recently discovered to the oldest known.

, createUnsignedTx
:: (DefineTx t)
:: forall e. (DefineTx t, e ~ ErrValidateSelection t)
=> WalletId
-> CoinSelectionOptions
-> NonEmpty TxOut
-> ExceptT ErrCreateUnsignedTx IO CoinSelection
-> ExceptT (ErrCreateUnsignedTx e) IO CoinSelection
-- ^ Prepare a transaction and automatically select inputs from the
-- wallet to cover the requested outputs. Note that this only run the
-- coin selection for the given outputs. In order to construct (and
-- sign) an actual transaction, have a look at 'signTx'.

, estimateTxFee
:: (DefineTx t)
:: forall e. (DefineTx t, e ~ ErrValidateSelection t)
=> WalletId
-> CoinSelectionOptions
-> NonEmpty TxOut
-> ExceptT ErrEstimateTxFee IO Fee
-> ExceptT (ErrEstimateTxFee e) IO Fee
-- ^ Estimate a transaction fee by automatically selecting inputs from the
-- wallet to cover the requested outputs.

@@ -292,16 +292,16 @@ data WalletLayer s t = WalletLayer
}

-- | Errors occuring when creating an unsigned transaction
data ErrCreateUnsignedTx
data ErrCreateUnsignedTx e
= ErrCreateUnsignedTxNoSuchWallet ErrNoSuchWallet
| ErrCreateUnsignedTxCoinSelection ErrCoinSelection
| ErrCreateUnsignedTxCoinSelection (ErrCoinSelection e)
| ErrCreateUnsignedTxFee ErrAdjustForFee
deriving (Show, Eq)

-- | Errors occuring when estimating transaction fee
data ErrEstimateTxFee
data ErrEstimateTxFee e
= ErrEstimateTxFeeNoSuchWallet ErrNoSuchWallet
| ErrEstimateTxFeeCoinSelection ErrCoinSelection
| ErrEstimateTxFeeCoinSelection (ErrCoinSelection e)
deriving (Show, Eq)

-- | Errors occuring when signing a transaction
@@ -621,37 +621,43 @@ newWalletLayer tracer block0 feePolicy db nw tl = do
Transactions
---------------------------------------------------------------------------}

-- FIXME Compute the options based on the transaction's size / inputs
coinSelOpts :: CoinSelectionOptions (ErrValidateSelection t)
coinSelOpts = CoinSelectionOptions
{ maximumNumberOfInputs = 10
, validate = validateSelection tl
}

feeOpts :: FeeOptions
feeOpts = FeeOptions
{ estimate = computeFee feePolicy . estimateSize tl
, dustThreshold = minBound
}

_createUnsignedTx
:: DefineTx t
:: forall e. (DefineTx t, e ~ ErrValidateSelection t)
=> WalletId
-> CoinSelectionOptions
-> NonEmpty TxOut
-> ExceptT ErrCreateUnsignedTx IO CoinSelection
_createUnsignedTx wid opts recipients = do
-> ExceptT (ErrCreateUnsignedTx e) IO CoinSelection
_createUnsignedTx wid recipients = do
(w, _) <- withExceptT ErrCreateUnsignedTxNoSuchWallet (_readWallet wid)
let utxo = availableUTxO @s @t w
(sel, utxo') <- withExceptT ErrCreateUnsignedTxCoinSelection $
CoinSelection.random opts recipients utxo
CoinSelection.random coinSelOpts recipients utxo
logInfoT $ "Coins selected for transaction: \n"+| sel |+""
withExceptT ErrCreateUnsignedTxFee $ do
let feeOpts = FeeOptions
{ estimate = computeFee feePolicy . estimateSize tl
, dustThreshold = minBound
}
debug "Coins after fee adjustment" =<< adjustForFee feeOpts utxo' sel


_estimateTxFee
:: DefineTx t
:: forall e. (DefineTx t, e ~ ErrValidateSelection t)
=> WalletId
-> CoinSelectionOptions
-> NonEmpty TxOut
-> ExceptT ErrEstimateTxFee IO Fee
_estimateTxFee wid opts recipients = do
-> ExceptT (ErrEstimateTxFee e) IO Fee
_estimateTxFee wid recipients = do
(w, _) <- withExceptT ErrEstimateTxFeeNoSuchWallet (_readWallet wid)
let utxo = availableUTxO @s @t w
(sel, _utxo') <- withExceptT ErrEstimateTxFeeCoinSelection $
CoinSelection.random opts recipients utxo
CoinSelection.random coinSelOpts recipients utxo
let estimateFee = computeFee feePolicy . estimateSize tl
pure $ estimateFee sel

@@ -37,6 +37,7 @@ import Cardano.Wallet
, ErrSignTx (..)
, ErrSubmitTx (..)
, ErrUpdatePassphrase (..)
, ErrValidateSelection
, ErrWalletAlreadyExists (..)
, ErrWithRootKey (..)
, ErrWrongPassphrase (..)
@@ -64,8 +65,6 @@ import Cardano.Wallet.Primitive.AddressDerivation
( KeyToAddress, digest, generateKeyFromSeed, publicKey )
import Cardano.Wallet.Primitive.AddressDiscovery
( SeqState (..), defaultAddressPoolGap, mkSeqState )
import Cardano.Wallet.Primitive.CoinSelection
( CoinSelectionOptions (..) )
import Cardano.Wallet.Primitive.Fee
( Fee (..) )
import Cardano.Wallet.Primitive.Model
@@ -112,7 +111,7 @@ import Data.Text.Class
import Data.Time
( UTCTime )
import Fmt
( pretty, (+|), (+||), (|+), (||+) )
( Buildable, pretty, (+|), (+||), (|+), (||+) )
import Network.HTTP.Media.RenderHeader
( renderHeader )
import Network.HTTP.Types.Header
@@ -163,7 +162,13 @@ data Listen

-- | Start the application server, using the given settings and a bound socket.
start
:: forall t. (DefineTx t, KeyToAddress t, EncodeAddress t, DecodeAddress t)
:: forall t.
( DefineTx t
, KeyToAddress t
, EncodeAddress t
, DecodeAddress t
, Buildable (ErrValidateSelection t)
)
=> Warp.Settings
-> Trace IO Text
-> Socket
@@ -369,7 +374,7 @@ listAddresses w (ApiT wid) stateFilter = do
-------------------------------------------------------------------------------}

transactions
:: (DefineTx t, KeyToAddress t)
:: (DefineTx t, KeyToAddress t, Buildable (ErrValidateSelection t))
=> WalletLayer (SeqState t) t
-> Server (Transactions t)
transactions w =
@@ -378,17 +383,15 @@ transactions w =
:<|> postTransactionFee w

createTransaction
:: forall t. (DefineTx t, KeyToAddress t)
:: forall t. (DefineTx t, KeyToAddress t, Buildable (ErrValidateSelection t))
=> WalletLayer (SeqState t) t
-> ApiT WalletId
-> PostTransactionData t
-> Handler (ApiTransaction t)
createTransaction w (ApiT wid) body = do
-- FIXME Compute the options based on the transaction's size / inputs
let opts = CoinSelectionOptions { maximumNumberOfInputs = 10 }
let outs = coerceCoin <$> (body ^. #payments)
let pwd = getApiT $ body ^. #passphrase
selection <- liftHandler $ W.createUnsignedTx w wid opts outs
selection <- liftHandler $ W.createUnsignedTx w wid outs
(tx, meta, wit) <- liftHandler $ W.signTx w wid pwd selection
liftHandler $ W.submitTx w wid (tx, meta, wit)
return ApiTransaction
@@ -419,16 +422,14 @@ coerceCoin (AddressAmount (ApiT addr, _) (Quantity c)) =
TxOut addr (Coin $ fromIntegral c)

postTransactionFee
:: forall t. (DefineTx t)
:: forall t. (DefineTx t, Buildable (ErrValidateSelection t))
=> WalletLayer (SeqState t) t
-> ApiT WalletId
-> PostTransactionFeeData t
-> Handler ApiFee
postTransactionFee w (ApiT wid) body = do
-- FIXME Compute the options based on the transaction's size / inputs
let opts = CoinSelectionOptions { maximumNumberOfInputs = 10 }
let outs = coerceCoin <$> (body ^. #payments)
(Fee fee) <- liftHandler $ W.estimateTxFee w wid opts outs
(Fee fee) <- liftHandler $ W.estimateTxFee w wid outs
return ApiFee
{ amount = Quantity (fromIntegral fee)
}
@@ -489,7 +490,7 @@ instance LiftHandler ErrWithRootKey where
, toText wid
]

instance LiftHandler ErrCoinSelection where
instance Buildable e => LiftHandler (ErrCoinSelection e) where
handler = \case
ErrNotEnoughMoney utxo payment ->
apiError err403 NotEnoughMoney $ mconcat
@@ -520,6 +521,8 @@ instance LiftHandler ErrCoinSelection where
, "transaction depleted all available inputs. "
, "Try sending a smaller amount."
]
ErrInvalidSelection e ->
apiError err403 InvalidCoinSelection $ pretty e

instance LiftHandler ErrAdjustForFee where
handler = \case
@@ -533,13 +536,13 @@ instance LiftHandler ErrAdjustForFee where
, showT missing, " Lovelace."
]

instance LiftHandler ErrCreateUnsignedTx where
instance Buildable e => LiftHandler (ErrCreateUnsignedTx e) where
handler = \case
ErrCreateUnsignedTxNoSuchWallet e -> handler e
ErrCreateUnsignedTxCoinSelection e -> handler e
ErrCreateUnsignedTxFee e -> handler e

instance LiftHandler ErrEstimateTxFee where
instance Buildable e => LiftHandler (ErrEstimateTxFee e) where
handler = \case
ErrEstimateTxFeeNoSuchWallet e -> handler e
ErrEstimateTxFeeCoinSelection e -> handler e
@@ -553,11 +556,6 @@ instance LiftHandler ErrSignTx where
, pretty addr, ". Are you sure this address belongs to a known "
, "wallet?"
]
ErrSignTx ErrInvalidTx ->
apiError err403 CreatedInvalidTransaction $ mconcat
[ "I can't process this payment because it contains at least"
, " one payment output of value 0. This isn't supported by the current core nodes."
]
ErrSignTxNoSuchWallet e -> (handler e)
{ errHTTPCode = 410
, errReasonPhrase = errReasonPhrase err410
@@ -206,6 +206,7 @@ data ApiErrorCode
| TransactionIsTooBig
| InputsDepleted
| CannotCoverFee
| InvalidCoinSelection
| NetworkUnreachable
| CreatedInvalidTransaction
| RejectedByCoreNode
@@ -15,9 +15,9 @@
module Cardano.Wallet.Primitive.CoinSelection
(
-- * Coin Selection
CoinSelectionOptions (..)
CoinSelection(..)
, ErrCoinSelection (..)
, CoinSelection(..)
, CoinSelectionOptions (..)

-- * Helpers
, shuffle
@@ -47,28 +47,6 @@ import qualified Data.Vector.Mutable as MV
Coin Selection
-------------------------------------------------------------------------------}

newtype CoinSelectionOptions = CoinSelectionOptions
{ maximumNumberOfInputs
:: Word64
} deriving (Generic)

data ErrCoinSelection
= ErrNotEnoughMoney Word64 Word64
-- ^ UTxO exhausted during input selection
-- We record the balance of the UTxO as well as the size of the payment
-- we tried to make.
| ErrUtxoNotEnoughFragmented Word64 Word64
-- ^ UTxO is not enough fragmented for the number of transaction outputs
-- We record the number of UTxO entries as well as the number of the
-- outputs of the transaction.
| ErrMaximumInputsReached Word64
-- ^ When trying to construct a transaction, the max number of allowed
-- inputs was reached.
| ErrInputsDepleted
-- ^ When trying to construct a transaction, the available inputs are depleted
-- even when UTxO is properly fragmented and with enough funds to cover payment
deriving (Show, Eq)

data CoinSelection = CoinSelection
{ inputs :: [(TxIn, TxOut)]
-- ^ Picked inputs
@@ -100,6 +78,35 @@ instance Buildable CoinSelection where
where
inpsF (txin, txout) = build txin <> " (~ " <> build txout <> ")"

data CoinSelectionOptions e = CoinSelectionOptions
{ maximumNumberOfInputs
:: Word64
, validate
:: CoinSelection -> Either e ()
} deriving (Generic)

data ErrCoinSelection e
= ErrNotEnoughMoney Word64 Word64
-- ^ UTxO exhausted during input selection
-- We record the balance of the UTxO as well as the size of the payment
-- we tried to make.
| ErrUtxoNotEnoughFragmented Word64 Word64
-- ^ UTxO is not enough fragmented for the number of transaction outputs
-- We record the number of UTxO entries as well as the number of the
-- outputs of the transaction.
| ErrMaximumInputsReached Word64
-- ^ When trying to construct a transaction, the max number of allowed
-- inputs was reached.
| ErrInputsDepleted
-- ^ When trying to construct a transaction, the available inputs are depleted
-- even when UTxO is properly fragmented and with enough funds to cover payment
| ErrInvalidSelection e
-- ^ Somewhat, we ended up generating an invalid coin selection because of
-- inputs passed down to the coin selection function, or because a target
-- backend has extra-limitations not covered by our coin selection
-- algorithm.
deriving (Show, Eq)

{-------------------------------------------------------------------------------
Helpers
-------------------------------------------------------------------------------}

0 comments on commit cfff5f7

Please sign in to comment.
You can’t perform that action at this time.