Merge #2219

2219: Return derivation path when answering `isOurs` r=KtorZ a=KtorZ

# Issue Number

<!-- Put here a reference to the issue this PR relates to and which requirements it tackles -->

#2176 

# Overview

<!-- Detail in a few bullet points the work accomplished in this PR -->

- 6c3aaea
  📍 **change derivation path JSON serialization to be less verbose**
    And also aligned with other interfaces like cardano-addresses.

- 1bba794
  📍 **change 'isOurs' to return a derivation path instead of a boolean**
    This can then be used to figure out what are the derivation path of
  a bunch of addresses when returning raw coin-selections.
  Note that this commit builds but is so-to-speak unsound. We need to
  find a way to feed the purpose, coin type and account index down to
  the 'isOurs' function. The most logical place to do this is as part of
  the state. We can't use arbitrary constant here because both Icarus
  and Shelley use a SeqState, but have different purpose indexes.

- 4b116de
  📍 **store seq-state derivation prefix in the database.**
    That prefixes tells us which account corresponds to which state and also, which purpose so can distinguish between Icarus and Shelley wallets. This will require a database migration
  which I'll add in a later commit.

- 185d8fb
  📍 **define manual migrations for seq-state with regards to the derivation prefix**
    I've generated databases for Icarus and Shelley wallets from the latest master and, in a test now trying to open these database and observe that a) it is possible, b) there's a log line indicating that a migration has happened, c) the resulting prefix in each database is exactly what we expect it to be.


# 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: KtorZ <matthias.benkort@gmail.com>

.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