Return derivation path when answering isOurs

.gitignore

@@ -28,3 +28,6 @@ cabal.sandbox.config
 ### Nix ###
 result*
 .stack-to-nix.cache
+
+### auto-generated faulty JSON golden tests ###
+*.faulty.json

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

@@ -23,6 +23,7 @@ import Cardano.Wallet.Api.Types
     , ApiAddress
     , ApiByronWallet
     , ApiCoinSelection
+    , ApiCoinSelectionInput (derivationPath)
     , ApiNetworkInformation
     , ApiT (..)
     , ApiTransaction
@@ -34,23 +35,30 @@ import Cardano.Wallet.Api.Types
     , WalletStyle (..)
     )
 import Cardano.Wallet.Primitive.AddressDerivation
-    ( PassphraseMaxLength (..), PassphraseMinLength (..), PaymentAddress )
+    ( DerivationType (..)
+    , Index (..)
+    , PassphraseMaxLength (..)
+    , PassphraseMinLength (..)
+    , PaymentAddress
+    )
 import Cardano.Wallet.Primitive.AddressDerivation.Byron
     ( ByronKey )
 import Cardano.Wallet.Primitive.AddressDerivation.Icarus
     ( IcarusKey )
 import Cardano.Wallet.Primitive.AddressDerivation.Shelley
     ( ShelleyKey )
 import Cardano.Wallet.Primitive.AddressDiscovery.Sequential
-    ( AddressPoolGap (..) )
+    ( AddressPoolGap (..), coinTypeAda, purposeCIP1852 )
 import Cardano.Wallet.Primitive.SyncProgress
     ( SyncProgress (..) )
 import Cardano.Wallet.Primitive.Types
-    ( walletNameMaxLength, walletNameMinLength )
+    ( DerivationIndex (..), walletNameMaxLength, walletNameMinLength )
 import Control.Monad
     ( forM_ )
 import Data.Generics.Internal.VL.Lens
     ( view, (^.) )
+import Data.List
+    ( isPrefixOf )
 import Data.List.NonEmpty
     ( NonEmpty ((:|)) )
 import Data.Proxy
@@ -915,9 +923,18 @@ spec = describe "SHELLEY_WALLETS" $ do
             targetAddress : _ <- fmap (view #id) <$> listAddresses @n ctx target
             let amount = Quantity minUTxOValue
             let payment = AddressAmount targetAddress amount
+            let hasValidDerivationPath input =
+                    ( length (derivationPath input) == 5 )
+                    &&
+                    ( [ ApiT $ DerivationIndex $ getIndex purposeCIP1852
+                      , ApiT $ DerivationIndex $ getIndex coinTypeAda
+                      , ApiT $ DerivationIndex $ getIndex @'Hardened minBound
+                      ] `isPrefixOf` NE.toList (derivationPath input)
+                    )
             selectCoins @_ @'Shelley ctx source (payment :| []) >>= flip verify
                 [ expectResponseCode HTTP.status200
                 , expectField #inputs (`shouldSatisfy` (not . null))
+                , expectField #inputs (`shouldSatisfy` all hasValidDerivationPath)
                 , expectField #outputs (`shouldSatisfy` ((> 1) . length))
                 , expectField #outputs (`shouldSatisfy` (payment `elem`))
                 ]

lib/core/src/Cardano/Wallet.hs

@@ -248,6 +248,7 @@ import Cardano.Wallet.Primitive.AddressDiscovery.Sequential
     , defaultAddressPoolGap
     , mkSeqStateFromRootXPrv
     , mkUnboundedAddressPoolGap
+    , purposeBIP44
     , shrinkPool
     )
 import Cardano.Wallet.Primitive.CoinSelection
@@ -291,6 +292,7 @@ import Cardano.Wallet.Primitive.Types
     , ChimericAccount (..)
     , Coin (..)
     , DelegationCertificate (..)
+    , DerivationIndex
     , Direction (..)
     , FeePolicy (LinearFee)
     , GenesisParameters (..)
@@ -306,9 +308,11 @@ import Cardano.Wallet.Primitive.Types
     , SortOrder (..)
     , TransactionInfo (..)
     , Tx
+    , TxIn
     , TxMeta (..)
     , TxMetadata
     , TxOut (..)
+    , TxOut (..)
     , TxStatus (..)
     , UTxO (..)
     , UTxOStatistics
@@ -604,7 +608,7 @@ createIcarusWallet
     -> (k 'RootK XPrv, Passphrase "encryption")
     -> ExceptT ErrWalletAlreadyExists IO WalletId
 createIcarusWallet ctx wid wname credentials = db & \DBLayer{..} -> do
-    let s = mkSeqStateFromRootXPrv @n credentials $
+    let s = mkSeqStateFromRootXPrv @n credentials purposeBIP44 $
             mkUnboundedAddressPoolGap 10000
     let (hist, cp) = initWallet block0 gp s
     let addrs = map address . concatMap (view #outputs . fst) $ hist
@@ -614,6 +618,7 @@ createIcarusWallet ctx wid wname credentials = db & \DBLayer{..} -> do
             (shrinkPool @n (liftPaymentAddress @n) addrs g (Seq.externalPool s))
             (Seq.pendingChangeIxs s)
             (Seq.rewardAccountKey s)
+            (Seq.derivationPrefix s)
     now <- lift getCurrentTime
     let meta = WalletMetadata
             { name = wname
@@ -1624,7 +1629,7 @@ signTx
     -> WalletId
     -> Passphrase "raw"
     -> Maybe TxMetadata
-    -> UnsignedTx
+    -> UnsignedTx (TxIn, TxOut)
     -> ExceptT ErrSignPayment IO (Tx, TxMeta, UTCTime, SealedTx)
 signTx ctx wid pwd md (UnsignedTx inpsNE outsNE) = db & \DBLayer{..} -> do
     withRootKey @_ @s ctx wid pwd ErrSignPaymentWithRootKey $ \xprv scheme -> do
@@ -1660,29 +1665,57 @@ selectCoinsExternal
         , HasLogger WalletLog ctx
         , HasTransactionLayer t k ctx
         , e ~ ErrValidateSelection t
+        , IsOurs s Address
         )
     => ctx
     -> WalletId
     -> ArgGenChange s
     -> NonEmpty TxOut
     -> Quantity "lovelace" Word64
     -> Maybe TxMetadata
-    -> ExceptT (ErrSelectCoinsExternal e) IO UnsignedTx
+    -> ExceptT
+        (ErrSelectCoinsExternal e)
+        IO
+        (UnsignedTx (TxIn, TxOut, NonEmpty DerivationIndex))
 selectCoinsExternal ctx wid argGenChange payments withdrawal md = do
     cs <- withExceptT ErrSelectCoinsExternalUnableToMakeSelection $
         selectCoinsForPayment @ctx @s @t @k @e ctx wid payments withdrawal md
-    cs' <- db & \DBLayer{..} ->
+    (cs', s') <- db & \DBLayer{..} ->
         withExceptT ErrSelectCoinsExternalNoSuchWallet $
             mapExceptT atomically $ do
                 cp <- withNoSuchWallet wid $ readCheckpoint $ PrimaryKey wid
                 (cs', s') <- assignChangeAddresses argGenChange cs (getState cp)
                 putCheckpoint (PrimaryKey wid) (updateState s' cp)
-                pure cs'
+                pure (cs', s')
     UnsignedTx
-        <$> ensureNonEmpty (inputs cs') ErrSelectCoinsExternalUnableToAssignInputs
-        <*> ensureNonEmpty (outputs cs') ErrSelectCoinsExternalUnableToAssignOutputs
+        <$> (fullyQualifiedInputs s' cs' >>= flip ensureNonEmpty
+                ErrSelectCoinsExternalUnableToAssignInputs)
+        <*> ensureNonEmpty (outputs cs')
+                ErrSelectCoinsExternalUnableToAssignOutputs
   where
     db = ctx ^. dbLayer @s @k
+
+    fullyQualifiedInputs
+        :: s
+        -> CoinSelection
+        -> ExceptT
+            (ErrSelectCoinsExternal e)
+            IO
+            [(TxIn, TxOut, NonEmpty DerivationIndex)]
+    fullyQualifiedInputs s cs =
+        traverse withDerivationPath (inputs cs)
+      where
+        withDerivationPath
+            :: (TxIn, TxOut)
+            -> ExceptT
+                (ErrSelectCoinsExternal e)
+                IO
+                (TxIn, TxOut, NonEmpty DerivationIndex)
+        withDerivationPath (txin, txout) = do
+            case fst $ isOurs (address txout) s of
+                Nothing -> throwE $ ErrSelectCoinsExternalUnableToAssignInputs wid
+                Just path -> pure (txin, txout, path)
+
     ensureNonEmpty
         :: forall a. [a]
         -> (WalletId -> ErrSelectCoinsExternal e)
@@ -1805,15 +1838,15 @@ mkTxMeta interpretTime blockHeader wState tx cs expiry =
 
     ourCoins :: TxOut -> Maybe Natural
     ourCoins (TxOut addr (Coin val)) =
-        if fst (isOurs addr wState)
-        then Just (fromIntegral val)
-        else Nothing
+        case fst (isOurs addr wState) of
+            Just{}  -> Just (fromIntegral val)
+            Nothing -> Nothing
 
     ourWithdrawal :: (ChimericAccount, Coin) -> Maybe Natural
     ourWithdrawal (acct, (Coin val)) =
-        if fst (isOurs acct wState)
-        then Just (fromIntegral val)
-        else Nothing
+        case fst (isOurs acct wState) of
+            Just{}  -> Just (fromIntegral val)
+            Nothing -> Nothing
 
 -- | Broadcast a (signed) transaction to the network.
 submitTx

lib/core/src/Cardano/Wallet/Api/Server.hs

@@ -259,6 +259,7 @@ import Cardano.Wallet.Primitive.AddressDiscovery.Sequential
     , defaultAddressPoolGap
     , mkSeqStateFromAccountXPub
     , mkSeqStateFromRootXPrv
+    , purposeCIP1852
     )
 import Cardano.Wallet.Primitive.CoinSelection
     ( CoinSelection (..), changeBalance, inputBalance )
@@ -283,6 +284,7 @@ import Cardano.Wallet.Primitive.Types
     , Block
     , BlockHeader (..)
     , Coin (..)
+    , DerivationIndex (..)
     , Hash (..)
     , NetworkParameters (..)
     , PassphraseScheme (..)
@@ -349,6 +351,8 @@ import Data.Generics.Labels
     ()
 import Data.List
     ( isInfixOf, isSubsequenceOf, sortOn )
+import Data.List.NonEmpty
+    ( NonEmpty )
 import Data.Map.Strict
     ( Map )
 import Data.Maybe
@@ -602,7 +606,7 @@ postShelleyWallet
     -> WalletPostData
     -> Handler ApiWallet
 postShelleyWallet ctx generateKey body = do
-    let state = mkSeqStateFromRootXPrv (rootXPrv, pwd) g
+    let state = mkSeqStateFromRootXPrv (rootXPrv, pwd) purposeCIP1852 g
     void $ liftHandler $ initWorker @_ @s @k ctx wid
         (\wrk -> W.createWallet  @(WorkerCtx ctx) @s @k wrk wid wName state)
         (\wrk -> W.restoreWallet @(WorkerCtx ctx) @s @t @k wrk wid)
@@ -638,7 +642,7 @@ postAccountWallet
     -> AccountPostData
     -> Handler w
 postAccountWallet ctx mkWallet liftKey coworker body = do
-    let state = mkSeqStateFromAccountXPub (liftKey accXPub) g
+    let state = mkSeqStateFromAccountXPub (liftKey accXPub) purposeCIP1852 g
     void $ liftHandler $ initWorker @_ @s @k ctx wid
         (\wrk -> W.createWallet  @(WorkerCtx ctx) @s @k wrk wid wName state)
         (\wrk -> W.restoreWallet @(WorkerCtx ctx) @s @t @k wrk wid)
@@ -1107,6 +1111,7 @@ selectCoins
         , s ~ SeqState n k
         , SoftDerivation k
         , ctx ~ ApiLayer s t k
+        , IsOurs s Address
         )
     => ctx
     -> ArgGenChange s
@@ -1574,15 +1579,15 @@ assignMigrationAddresses
     -- ^ Target addresses
     -> [CoinSelection]
     -- ^ Migration data for the source wallet.
-    -> [UnsignedTx]
+    -> [UnsignedTx (TxIn, TxOut)]
 assignMigrationAddresses addrs selections =
     fst $ foldr accumulate ([], cycle addrs) selections
   where
     accumulate sel (txs, addrsAvailable) = first
         (\addrsSelected -> makeTx sel addrsSelected : txs)
         (splitAt (length $ change sel) addrsAvailable)
 
-    makeTx :: CoinSelection -> [Address] -> UnsignedTx
+    makeTx :: CoinSelection -> [Address] -> UnsignedTx (TxIn, TxOut)
     makeTx sel addrsSelected = UnsignedTx
         (NE.fromList (sel ^. #inputs))
         (NE.fromList (zipWith TxOut addrsSelected (sel ^. #change)))
@@ -1771,7 +1776,10 @@ rndStateChange ctx (ApiT wid) pwd =
             pure (xprv, preparePassphrase scheme pwd)
 
 -- | Makes an 'ApiCoinSelection' from the given 'UnsignedTx'.
-mkApiCoinSelection :: forall n. UnsignedTx -> ApiCoinSelection n
+mkApiCoinSelection
+    :: forall n. ()
+    => UnsignedTx (TxIn, TxOut, NonEmpty DerivationIndex)
+    -> ApiCoinSelection n
 mkApiCoinSelection (UnsignedTx inputs outputs) =
     ApiCoinSelection
         (mkApiCoinSelectionInput <$> inputs)
@@ -1781,13 +1789,16 @@ mkApiCoinSelection (UnsignedTx inputs outputs) =
     mkAddressAmount (TxOut addr (Coin c)) =
         AddressAmount (ApiT addr, Proxy @n) (Quantity $ fromIntegral c)
 
-    mkApiCoinSelectionInput :: (TxIn, TxOut) -> ApiCoinSelectionInput n
-    mkApiCoinSelectionInput (TxIn txid index, TxOut addr (Coin c)) =
+    mkApiCoinSelectionInput
+        :: (TxIn, TxOut, NonEmpty DerivationIndex)
+        -> ApiCoinSelectionInput n
+    mkApiCoinSelectionInput (TxIn txid index, TxOut addr (Coin c), path) =
         ApiCoinSelectionInput
             { id = ApiT txid
             , index = index
             , address = (ApiT addr, Proxy @n)
             , amount = Quantity $ fromIntegral c
+            , derivationPath = ApiT <$> path
             }
 
 mkApiTransaction