Merge #2275

2275: Testing change in coin selection r=piotr-iohk a=piotr-iohk

# Issue Number

#2247

# Overview

- 5508cb3
  Shelley coin selection - case with no change outputs
  
- 5a88cbb
  Byron coin selection - add missing tests


# Comments

<!-- Additional comments or screenshots to attach if any -->

<!-- 
Don't forget to:

 ✓ Self-review your changes to make sure nothing unexpected slipped through
 ✓ Assign yourself to the PR
 ✓ Assign one or several reviewer(s)
 ✓ Once created, link this PR to its corresponding ticket
 ✓ Assign the PR to a corresponding milestone
 ✓ Acknowledge any changes required to the Wiki
-->


Co-authored-by: Piotr Stachyra <piotr.stachyra@iohk.io>

lib/core-integration/src/Test/Integration/Framework/TestData.hs

@@ -40,6 +40,7 @@ module Test.Integration.Framework.TestData
     , errMsg403Fee
     , errMsg403DelegationFee
     , errMsg403NotAByronWallet
+    , errMsg403NotAnIcarusWallet
     , errMsg403NotEnoughMoney
     , errMsg403NotEnoughMoney_
     , errMsg403WrongPass
@@ -272,6 +273,11 @@ errMsg403NotAByronWallet =
     "I cannot derive new address for this wallet type.\
     \ Make sure to use Byron random wallet id."
 
+errMsg403NotAnIcarusWallet :: String
+errMsg403NotAnIcarusWallet =
+    "I cannot derive new address for this wallet type.\
+    \ Make sure to use a sequential wallet style, like Icarus."
+
 errMsg403NotEnoughMoney_ :: String
 errMsg403NotEnoughMoney_ =
     "I can't process this payment because there's not enough UTxO available in \

lib/core-integration/src/Test/Integration/Scenario/API/Byron/Wallets.hs

@@ -16,7 +16,10 @@ module Test.Integration.Scenario.API.Byron.Wallets
 import Prelude
 
 import Cardano.Wallet.Api.Types
-    ( ApiByronWallet
+    ( AddressAmount (..)
+    , ApiByronWallet
+    , ApiCoinSelectionOutput (..)
+    , ApiT (..)
     , ApiUtxoStatistics
     , ApiWalletDiscovery (..)
     , DecodeAddress
@@ -25,15 +28,29 @@ import Cardano.Wallet.Api.Types
     , WalletStyle (..)
     )
 import Cardano.Wallet.Primitive.AddressDerivation
-    ( PassphraseMaxLength (..), PassphraseMinLength (..), PaymentAddress )
+    ( DerivationIndex (..)
+    , DerivationType (..)
+    , Index (..)
+    , PassphraseMaxLength (..)
+    , PassphraseMinLength (..)
+    , PaymentAddress
+    )
 import Cardano.Wallet.Primitive.AddressDerivation.Byron
     ( ByronKey )
+import Cardano.Wallet.Primitive.AddressDerivation.Icarus
+    ( IcarusKey )
+import Cardano.Wallet.Primitive.AddressDiscovery.Sequential
+    ( coinTypeAda, purposeBIP44 )
 import Cardano.Wallet.Primitive.SyncProgress
     ( SyncProgress (..) )
 import Control.Monad
     ( forM_, void )
 import Data.Generics.Internal.VL.Lens
-    ( (^.) )
+    ( view, (^.) )
+import Data.List
+    ( isPrefixOf )
+import Data.List.NonEmpty
+    ( NonEmpty ((:|)) )
 import Data.Maybe
     ( isJust, isNothing )
 import Data.Proxy
@@ -56,26 +73,33 @@ import Test.Integration.Framework.DSL
     , emptyIcarusWallet
     , emptyRandomWallet
     , emptyRandomWalletWithPasswd
+    , emptyWallet
     , eventually
     , expectErrorMessage
     , expectField
     , expectListField
     , expectListSize
     , expectResponseCode
     , expectWalletUTxO
+    , fixtureIcarusWallet
+    , fixtureIcarusWalletWith
     , fixturePassphrase
     , fixturePassphraseEncrypted
     , genMnemonics
     , getFromResponse
     , json
+    , listAddresses
+    , minUTxOValue
     , request
     , rootPrvKeyFromMnemonics
+    , selectCoins
     , verify
     , walletId
     )
 import Test.Integration.Framework.TestData
     ( arabicWalletName
     , errMsg400NumberOfWords
+    , errMsg403NotAnIcarusWallet
     , errMsg403WrongPass
     , errMsg404NoWallet
     , kanjiWalletName
@@ -87,13 +111,16 @@ import Test.Integration.Framework.TestData
     )
 
 import qualified Cardano.Wallet.Api.Link as Link
+import qualified Data.List as L
+import qualified Data.List.NonEmpty as NE
 import qualified Data.Text as T
 import qualified Network.HTTP.Types.Status as HTTP
 
 spec :: forall n t.
     ( DecodeAddress n
     , DecodeStakeAddress n
     , EncodeAddress n
+    , PaymentAddress n IcarusKey
     , PaymentAddress n ByronKey
     ) => SpecWith (Context t)
 spec = describe "BYRON_WALLETS" $ do
@@ -358,6 +385,114 @@ spec = describe "BYRON_WALLETS" $ do
             , expectField (#name . #getApiT . #getWalletName) (`shouldBe` updatedName)
             ]
 
+    it "BYRON_COIN_SELECTION_00 - \
+        \No coin selection on Byron random" $ \ctx -> do
+        rnW <- emptyRandomWallet ctx
+        shW <- emptyWallet ctx
+        (addr:_) <- fmap (view #id) <$> listAddresses @n ctx shW
+        let payments = NE.fromList [ AddressAmount addr (Quantity minUTxOValue) ]
+        selectCoins @_ @'Byron ctx rnW payments >>= flip verify
+            [ expectResponseCode @IO HTTP.status403
+            , expectErrorMessage errMsg403NotAnIcarusWallet
+            ]
+
+    it "BYRON_COIN_SELECTION_01 - \
+        \A singleton payment is included in the coin selection output." $
+        \ctx -> do
+            source <- fixtureIcarusWallet ctx
+            target <- emptyWallet ctx
+            targetAddress : _ <- fmap (view #id) <$> listAddresses @n ctx target
+            let amt = Quantity minUTxOValue
+            let payment = AddressAmount targetAddress amt
+            let output = ApiCoinSelectionOutput targetAddress amt
+            let isValidDerivationPath path =
+                    ( length path == 5 )
+                    &&
+                    ( [ ApiT $ DerivationIndex $ getIndex purposeBIP44
+                      , ApiT $ DerivationIndex $ getIndex coinTypeAda
+                      , ApiT $ DerivationIndex $ getIndex @'Hardened minBound
+                      ] `isPrefixOf` NE.toList path
+                    )
+            selectCoins @_ @'Byron ctx source (payment :| []) >>= flip verify
+                [ expectResponseCode HTTP.status200
+                , expectField #inputs
+                    (`shouldSatisfy` (not . null))
+                , expectField #inputs
+                    (`shouldSatisfy` all
+                        (isValidDerivationPath . view #derivationPath))
+                , expectField #change
+                    (`shouldSatisfy` (not . null))
+                , expectField #change
+                    (`shouldSatisfy` all
+                        (isValidDerivationPath . view #derivationPath))
+                , expectField #outputs
+                    (`shouldBe` [output])
+                ]
+
+    it "BYRON_COIN_SELECTION_02 - \
+        \Multiple payments are all included in the coin selection output." $
+        \ctx -> do
+            let paymentCount = 10
+            source <- fixtureIcarusWallet ctx
+            target <- emptyWallet ctx
+            targetAddresses <- fmap (view #id) <$> listAddresses @n ctx target
+            let amounts = Quantity <$> [minUTxOValue ..]
+            let payments = NE.fromList
+                    $ take paymentCount
+                    $ zipWith AddressAmount targetAddresses amounts
+            let outputs =
+                    take paymentCount
+                    $ zipWith ApiCoinSelectionOutput targetAddresses amounts
+            selectCoins @_ @'Byron ctx source payments >>= flip verify
+                [ expectResponseCode HTTP.status200
+                , expectField #inputs (`shouldSatisfy` (not . null))
+                , expectField #change (`shouldSatisfy` (not . null))
+                , expectField
+                    #outputs (`shouldSatisfy` ((L.sort outputs ==) . L.sort))
+                ]
+
+    it "BYRON_COIN_SELECTION_03 - \
+        \Deleted wallet is not available for selection" $ \ctx -> do
+        icW <- emptyIcarusWallet ctx
+        shW <- emptyWallet ctx
+        (addr:_) <- fmap (view #id) <$> listAddresses @n ctx shW
+        let payments = NE.fromList [ AddressAmount addr (Quantity minUTxOValue) ]
+        _ <- request @ApiByronWallet ctx (Link.deleteWallet @'Byron icW) Default Empty
+        selectCoins @_ @'Byron ctx icW payments >>= flip verify
+            [ expectResponseCode @IO HTTP.status404
+            , expectErrorMessage (errMsg404NoWallet $ icW ^. walletId)
+            ]
+
+    it "BYRON_COIN_SELECTION_05 - \
+        \No change when payment fee eats leftovers due to minUTxOValue" $
+        \ctx -> do
+            source  <- fixtureIcarusWalletWith @n ctx [minUTxOValue, minUTxOValue]
+            target <- emptyWallet ctx
+
+            targetAddress:_ <- fmap (view #id) <$> listAddresses @n ctx target
+            let amt = Quantity minUTxOValue
+            let payment = AddressAmount targetAddress amt
+            let output = ApiCoinSelectionOutput targetAddress amt
+            let isValidDerivationPath path =
+                    ( length path == 5 )
+                    &&
+                    ( [ ApiT $ DerivationIndex $ getIndex purposeBIP44
+                      , ApiT $ DerivationIndex $ getIndex coinTypeAda
+                      , ApiT $ DerivationIndex $ getIndex @'Hardened minBound
+                      ] `isPrefixOf` NE.toList path
+                    )
+            selectCoins @_ @'Byron ctx source (payment :| []) >>= flip verify
+                [ expectResponseCode HTTP.status200
+                , expectField #inputs
+                    (`shouldSatisfy` (not . null))
+                , expectField #inputs
+                    (`shouldSatisfy` all
+                        (isValidDerivationPath . view #derivationPath))
+                , expectField #change
+                    (`shouldSatisfy` null)
+                , expectField #outputs
+                    (`shouldBe` [output])
+                ]
 
     it "BYRON_UTXO_01 - Wallet's inactivity is reflected in utxo" $ \ctx ->
         forM_ [ emptyRandomWallet, emptyIcarusWallet ] $ \emptyByronWallet -> do

lib/core-integration/src/Test/Integration/Scenario/API/Shelley/Wallets.hs

@@ -100,6 +100,7 @@ import Test.Integration.Framework.DSL
     , expectWalletUTxO
     , fixturePassphrase
     , fixtureWallet
+    , fixtureWalletWith
     , genMnemonics
     , getFromResponse
     , json
@@ -950,6 +951,8 @@ spec = describe "SHELLEY_WALLETS" $ do
                 , expectField #inputs
                     (`shouldSatisfy` all
                         (isValidDerivationPath . view #derivationPath))
+                , expectField #change
+                    (`shouldSatisfy` (not . null))
                 , expectField #change
                     (`shouldSatisfy` all
                         (isValidDerivationPath . view #derivationPath))
@@ -972,10 +975,9 @@ spec = describe "SHELLEY_WALLETS" $ do
                     take paymentCount
                     $ zipWith ApiCoinSelectionOutput targetAddresses amounts
             selectCoins @_ @'Shelley ctx source payments >>= flip verify
-                [ expectResponseCode
-                    HTTP.status200
-                , expectField
-                    #inputs (`shouldSatisfy` (not . null))
+                [ expectResponseCode HTTP.status200
+                , expectField #inputs (`shouldSatisfy` (not . null))
+                , expectField #change (`shouldSatisfy` (not . null))
                 , expectField
                     #outputs (`shouldSatisfy` ((L.sort outputs ==) . L.sort))
                 ]
@@ -1049,6 +1051,37 @@ spec = describe "SHELLEY_WALLETS" $ do
                 (Link.selectCoins @'Shelley w) headers payload
             verify r expectations
 
+    it "WALLETS_COIN_SELECTION_05 - \
+        \No change when payment fee eats leftovers due to minUTxOValue" $
+        \ctx -> do
+            source  <- fixtureWalletWith @n ctx [minUTxOValue, minUTxOValue]
+            target <- emptyWallet ctx
+
+            targetAddress:_ <- fmap (view #id) <$> listAddresses @n ctx target
+            let amount = Quantity minUTxOValue
+            let payment = AddressAmount targetAddress amount
+            let output = ApiCoinSelectionOutput targetAddress amount
+            let isValidDerivationPath path =
+                    ( length path == 5 )
+                    &&
+                    ( [ ApiT $ DerivationIndex $ getIndex purposeCIP1852
+                      , ApiT $ DerivationIndex $ getIndex coinTypeAda
+                      , ApiT $ DerivationIndex $ getIndex @'Hardened minBound
+                      ] `isPrefixOf` NE.toList path
+                    )
+            selectCoins @_ @'Shelley ctx source (payment :| []) >>= flip verify
+                [ expectResponseCode HTTP.status200
+                , expectField #inputs
+                    (`shouldSatisfy` (not . null))
+                , expectField #inputs
+                    (`shouldSatisfy` all
+                        (isValidDerivationPath . view #derivationPath))
+                , expectField #change
+                    (`shouldSatisfy` null)
+                , expectField #outputs
+                    (`shouldBe` [output])
+                ]
+
     it "WALLETS_UTXO_01 - Wallet's inactivity is reflected in utxo" $ \ctx -> do
         w <- emptyWallet ctx
         rStat <- request @ApiUtxoStatistics ctx