Add derivation path to api address

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

@@ -82,6 +82,7 @@ import Web.HttpApiData
     ( ToHttpApiData (..) )
 
 import qualified Cardano.Wallet.Api.Link as Link
+import qualified Data.List.NonEmpty as NE
 import qualified Network.HTTP.Types.Status as HTTP
 
 spec :: forall n.
@@ -93,8 +94,8 @@ spec :: forall n.
     ) => SpecWith Context
 spec = do
     describe "BYRON_ADDRESSES" $ do
-        scenario_ADDRESS_LIST_01 @n emptyRandomWallet
-        scenario_ADDRESS_LIST_01 @n emptyIcarusWallet
+        scenario_ADDRESS_LIST_01 @n emptyRandomWallet 2
+        scenario_ADDRESS_LIST_01 @n emptyIcarusWallet 5
 
         scenario_ADDRESS_LIST_02 @n fixtureRandomWallet
         scenario_ADDRESS_LIST_02 @n fixtureIcarusWallet
@@ -122,14 +123,16 @@ scenario_ADDRESS_LIST_01
         , EncodeAddress n
         )
     => (Context -> ResourceT IO ApiByronWallet)
+    -> Int
     -> SpecWith Context
-scenario_ADDRESS_LIST_01 fixture = it title $ \ctx -> runResourceT $ do
+scenario_ADDRESS_LIST_01 fixture derPathSize = it title $ \ctx -> runResourceT $ do
     w <- fixture ctx
     r <- request @[ApiAddress n] ctx (Link.listAddresses @'Byron w) Default Empty
     verify r [ expectResponseCode HTTP.status200 ]
     let n = length $ getFromResponse id r
     forM_ [0..n-1] $ \addrIx -> do
         expectListField addrIx #state (`shouldBe` ApiT Unused) r
+        expectListField addrIx #derivationPath (\derPath -> NE.length derPath `shouldBe` derPathSize) r
   where
     title = "ADDRESS_LIST_01 - Can list known addresses on a default wallet"
 

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

@@ -544,7 +544,7 @@ spec = describe "BYRON_MIGRATIONS" $ do
             targetWallet <- emptyWallet ctx
             addrs <- listAddresses @n ctx targetWallet
             let addrIds =
-                    map (\(ApiTypes.ApiAddress theid _) -> theid) $
+                    map (\(ApiTypes.ApiAddress theid _ _) -> theid) $
                     take addrNum addrs
 
             -- Calculate the expected migration fee:

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

@@ -83,6 +83,7 @@ import Test.Integration.Framework.TestData
 import qualified Cardano.Wallet.Api.Link as Link
 import qualified Data.Aeson as Aeson
 import qualified Data.Aeson.Lens as Aeson
+import qualified Data.List.NonEmpty as NE
 import qualified Data.Text as T
 import qualified Network.HTTP.Types.Status as HTTP
 import qualified Test.Hspec.Expectations.Lifted as Expectations
@@ -110,6 +111,7 @@ spec = describe "SHELLEY_ADDRESSES" $ do
         expectListSize g r
         forM_ [0..(g-1)] $ \addrNum -> do
             expectListField addrNum (#state . #getApiT) (`shouldBe` Unused) r
+            expectListField addrNum #derivationPath (\derPath -> NE.length derPath `shouldBe` 5) r
 
     it "ADDRESS_LIST_01 - Can list addresses with non-default pool gap" $ \ctx -> runResourceT $ do
         let g = 15

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

@@ -503,7 +503,7 @@ spec = describe "SHELLEY_MIGRATIONS" $ do
             targetWallet <- emptyWallet ctx
             addrs <- listAddresses @n ctx targetWallet
             let addrIds =
-                    map (\(ApiTypes.ApiAddress theid _) -> theid) $
+                    map (\(ApiTypes.ApiAddress theid _ _) -> theid) $
                     take addrNum addrs
 
             -- Calculate the expected migration fee:

lib/core/src/Cardano/Wallet.hs

@@ -1075,7 +1075,7 @@ listAddresses
         -- non-delegation addresses found in the transaction history are
         -- shown with their delegation settings.
         -- Use 'Just' for wallet without delegation settings.
-    -> ExceptT ErrNoSuchWallet IO [(Address, AddressState)]
+    -> ExceptT ErrNoSuchWallet IO [(Address, AddressState, NonEmpty DerivationIndex)]
 listAddresses ctx wid normalize = db & \DBLayer{..} -> do
     cp <- mapExceptT atomically
         $ withNoSuchWallet wid
@@ -1085,8 +1085,8 @@ listAddresses ctx wid normalize = db & \DBLayer{..} -> do
     -- FIXME
     -- Stream this instead of returning it as a single block.
     return
-        $ L.sortBy (\(a,_) (b,_) -> compareDiscovery s a b)
-        $ mapMaybe (\(addr, st) -> (,st) <$> normalize s addr)
+        $ L.sortBy (\(a,_,_) (b,_,_) -> compareDiscovery s a b)
+        $ mapMaybe (\(addr, st,path) -> (,st,path) <$> normalize s addr)
         $ knownAddresses s
   where
     db = ctx ^. dbLayer @s @k
@@ -1121,7 +1121,7 @@ createRandomAddress
     -> WalletId
     -> Passphrase "raw"
     -> Maybe (Index 'Hardened 'AddressK)
-    -> ExceptT ErrCreateRandomAddress IO Address
+    -> ExceptT ErrCreateRandomAddress IO (Address, NonEmpty DerivationIndex)
 createRandomAddress ctx wid pwd mIx = db & \DBLayer{..} ->
     withRootKey @ctx @s @k ctx wid pwd ErrCreateAddrWithRootKey $ \xprv scheme -> do
         mapExceptT atomically $ do
@@ -1144,7 +1144,7 @@ createRandomAddress ctx wid pwd mIx = db & \DBLayer{..} ->
             let cp' = updateState (Rnd.addPendingAddress addr path s') cp
             withExceptT ErrCreateAddrNoSuchWallet $
                 putCheckpoint (PrimaryKey wid) cp'
-            pure addr
+            pure (addr, Rnd.toDerivationIndexes path)
   where
     db = ctx ^. dbLayer @s @k
     isKnownIndex accIx addrIx s =

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

@@ -1405,11 +1405,12 @@ postRandomAddress
 postRandomAddress ctx (ApiT wid) body = do
     let pwd = coerce $ getApiT $ body ^. #passphrase
     let mix = getApiT <$> (body ^. #addressIndex)
-    addr <- withWorkerCtx ctx wid liftE liftE
+    (addr, path) <- withWorkerCtx ctx wid liftE liftE
         $ \wrk -> liftHandler $ W.createRandomAddress @_ @s @k @n wrk wid pwd mix
-    pure $ coerceAddress (addr, Unused)
+    pure $ coerceAddress (addr, Unused, path)
   where
-    coerceAddress (a, s) = ApiAddress (ApiT a, Proxy @n) (ApiT s)
+    coerceAddress (a, s, p) =
+        ApiAddress (ApiT a, Proxy @n) (ApiT s) (NE.map ApiT p)
 
 putRandomAddress
     :: forall ctx s k n.
@@ -1459,11 +1460,12 @@ listAddresses ctx normalize (ApiT wid) stateFilter = do
         W.listAddresses @_ @s @k wrk wid normalize
     return $ coerceAddress <$> filter filterCondition addrs
   where
-    filterCondition :: (Address, AddressState) -> Bool
+    filterCondition :: (Address, AddressState, NonEmpty DerivationIndex) -> Bool
     filterCondition = case stateFilter of
         Nothing -> const True
-        Just (ApiT s) -> (== s) . snd
-    coerceAddress (a, s) = ApiAddress (ApiT a, Proxy @n) (ApiT s)
+        Just (ApiT s) -> \(_,state,_) -> (state == s)
+    coerceAddress (a, s, p) =
+        ApiAddress (ApiT a, Proxy @n) (ApiT s) (NE.map ApiT p)
 
 {-------------------------------------------------------------------------------
                                     Transactions

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

@@ -487,6 +487,7 @@ toApiAssetMetadata W.AssetMetadata{name,description,ticker,url,logo,unit} =
 data ApiAddress (n :: NetworkDiscriminant) = ApiAddress
     { id :: !(ApiT Address, Proxy n)
     , state :: !(ApiT AddressState)
+    , derivationPath :: NonEmpty (ApiT DerivationIndex)
     } deriving (Eq, Generic, Show)
       deriving anyclass NFData
 

lib/core/src/Cardano/Wallet/DB/Sqlite.hs

@@ -2372,7 +2372,7 @@ insertAddressPool
 insertAddressPool wid sl pool =
     void $ dbChunked insertMany_
         [ SeqStateAddress wid sl addr ix (Seq.role @c) state
-        | (ix, (addr, state))
+        | (ix, (addr, state, _))
         <- zip [0..] (Seq.addresses (liftPaymentAddress @n) pool)
         ]
 

lib/core/src/Cardano/Wallet/Primitive/AddressDiscovery.hs

@@ -135,7 +135,7 @@ class CompareDiscovery s where
 class KnownAddresses s where
     knownAddresses
         :: s
-        -> [(Address, AddressState)]
+        -> [(Address, AddressState, NonEmpty DerivationIndex)]
 
 -- | One master node (seed) can be used for unlimited number of independent
 -- cryptocoins such as Bitcoin, Litecoin or Namecoin. However, sharing the

lib/core/src/Cardano/Wallet/Primitive/AddressDiscovery/Random.hs

@@ -27,6 +27,7 @@ module Cardano.Wallet.Primitive.AddressDiscovery.Random
     , RndStateLike
     , mkRndState
     , DerivationPath
+    , toDerivationIndexes
 
     -- ** Low-level API
     , importAddress
@@ -334,9 +335,14 @@ instance CompareDiscovery (RndState n) where
 
 instance KnownAddresses (RndState n) where
     knownAddresses s = mconcat
-        [ Map.elems (discoveredAddresses s)
-        , Map.elems ((,Unused) <$> pendingAddresses s)
+        [ retrieveAddrsWithPaPath (discoveredAddresses s)
+        , retrieveAddrsWithPaPath ((,Unused) <$> pendingAddresses s)
         ]
+      where
+        constructAddrWithPath path (addr,state) acc =
+            (addr, state, toDerivationIndexes path):acc
+        retrieveAddrsWithPaPath =
+            Map.foldrWithKey constructAddrWithPath []
 
 --------------------------------------------------------------------------------
 --

lib/core/src/Cardano/Wallet/Primitive/AddressDiscovery/Sequential.hs

@@ -378,15 +378,23 @@ role = fromMaybe (error $ "role: unmatched type" <> show (typeRep @c))
 --
 -- > mkAddressPool key g cc (addresses pool) == pool
 addresses
-    :: forall c k. ()
+    :: forall c k. Typeable c
     => (KeyFingerprint "payment" k -> Address)
     -> AddressPool c k
-    -> [(Address, AddressState)]
+    -> [(Address, AddressState, NonEmpty DerivationIndex)]
 addresses mkAddress =
-    map (\(k, (_, st)) -> (mkAddress k, st))
+    map (\(k, (ix, st)) -> (mkAddress k, st, toDerivationPath ix))
     . L.sortOn (fst . snd)
     . Map.toList
     . indexedKeys
+  where
+    toDerivationPath ix = NE.fromList $ map DerivationIndex
+        [ getIndex purposeBIP44
+        , getIndex purposeCIP1852
+        , 0
+        , fromIntegral $ fromEnum $ role @c
+        , getIndex ix
+        ]
 
 -- | Create a new Address pool from a list of addresses. Note that, the list is
 -- expected to be ordered in sequence (first indexes, first in the list).
@@ -913,7 +921,7 @@ instance
                 addresses (liftPaymentAddress @n @k) (internalPool s)
 
             usedChangeAddresses =
-                filter ((== Used) . snd) changeAddresses
+                filter (\(_, state, _) -> state == Used) changeAddresses
 
             -- pick as many unused change addresses as there are pending
             -- transactions. Note: the last `internalGap` addresses are all

lib/core/test/unit/Cardano/Wallet/Api/TypesSpec.hs

@@ -1076,6 +1076,7 @@ instance Arbitrary (ApiAddress t) where
     arbitrary = ApiAddress
         <$> fmap (, Proxy @t) arbitrary
         <*> arbitrary
+        <*> arbitrary
 
 instance Arbitrary ApiEpochInfo where
     arbitrary = ApiEpochInfo <$> arbitrary <*> genUniformTime

lib/core/test/unit/Cardano/Wallet/DB/SqliteSpec.hs

@@ -859,7 +859,9 @@ fileModeSpec =  do
                \rollback to the same place" $ \f -> do
               withShelleyDBLayer f $ \db@DBLayer{..} -> do
 
-                let ourAddrs = knownAddresses (getState testCp)
+                let ourAddrs =
+                        map (\(a,s,_) -> (a,s)) $
+                        knownAddresses (getState testCp)
 
                 atomically $ unsafeRunExceptT $ initializeWallet
                     testPk testCp testMetadata mempty gp

lib/core/test/unit/Cardano/Wallet/Primitive/AddressDiscovery/RandomSpec.hs

@@ -319,8 +319,8 @@ prop_forbiddenAddreses rnd@(Rnd st rk pwd) addrIx = conjoin
     , (Set.member addr (forbidden isOursSt))
     , (Set.notMember changeAddr (forbidden isOursSt))
     , (Set.member changeAddr (forbidden changeSt))
-    , (addr `elem` (fst <$> knownAddresses isOursSt))
-    , (changeAddr `elem` (fst <$> knownAddresses changeSt))
+    , (addr `elem` ((\(a,_,_) -> a) <$> knownAddresses isOursSt))
+    , (changeAddr `elem` ((\(a,_,_) -> a) <$> knownAddresses changeSt))
     ]
   where
     (_ours, isOursSt) = isOurs addr st
@@ -334,10 +334,10 @@ prop_oursAreUsed
     -> Index 'WholeDomain 'AddressK
     -> Property
 prop_oursAreUsed rnd@(Rnd st _ _) addrIx = do
-    case find ((== addr) . fst) $ knownAddresses $ snd $ isOurs addr st of
+    case find (\(a,_,_) -> (a == addr)) $ knownAddresses $ snd $ isOurs addr st of
         Nothing ->
             property False & counterexample "address not is known addresses"
-        Just (_, status) ->
+        Just (_, status,_) ->
             status === Used
   where
     addr = mkAddress rnd addrIx

lib/core/test/unit/Cardano/Wallet/Primitive/AddressDiscovery/SequentialSpec.hs

@@ -25,6 +25,7 @@ import Cardano.Address.Derivation
 import Cardano.Wallet.Primitive.AddressDerivation
     ( DelegationAddress (..)
     , Depth (..)
+    , DerivationIndex
     , DerivationType (..)
     , HardDerivation (..)
     , Index
@@ -89,6 +90,8 @@ import Data.Function
     ( (&) )
 import Data.List
     ( elemIndex, (\\) )
+import Data.List.NonEmpty
+    ( NonEmpty )
 import Data.Maybe
     ( isJust, isNothing )
 import Data.Proxy
@@ -318,7 +321,7 @@ prop_roundtripMkAddressPool _proxy pool =
     ( mkAddressPool @'Mainnet
         (context pool)
         (gap pool)
-        (addresses liftAddress pool)
+        (map pair' $ addresses liftAddress pool)
     ) === pool
 
 class GetCtx (chain :: Role) where
@@ -337,6 +340,7 @@ instance GetCtx 'MultisigScript where
 prop_poolAtLeastGapAddresses
     :: forall (chain :: Role) k.
         ( AddressPoolTest k
+        , Typeable chain
         )
     => (Proxy chain, Proxy k)
     -> AddressPool chain k
@@ -468,13 +472,21 @@ prop_compareAntiSymmetric (s, ShowFmt a1, ShowFmt a2) =
                         Properties for KnownAddresses
 -------------------------------------------------------------------------------}
 
+fst' :: (Address, AddressState, NonEmpty DerivationIndex)
+    -> Address
+fst' (a,_,_) = a
+
+pair' :: (Address, AddressState, NonEmpty DerivationIndex)
+    -> (Address, AddressState)
+pair' (a,s,_) = (a,s)
+
 prop_knownAddressesAreOurs
     :: SeqState 'Mainnet ShelleyKey
     -> Property
 prop_knownAddressesAreOurs s =
-    map (\x -> (ShowFmt x, isJust $ fst $ isOurs x s)) (fst <$> knownAddresses s)
+    map (\x -> (ShowFmt x, isJust $ fst $ isOurs x s)) (fst' <$> knownAddresses s)
     ===
-    map (\x -> (ShowFmt x, True)) (fst <$> knownAddresses s)
+    map (\x -> (ShowFmt x, True)) (fst' <$> knownAddresses s)
 
 prop_atLeastKnownAddresses
     :: SeqState 'Mainnet ShelleyKey
@@ -493,9 +505,9 @@ prop_changeIsOnlyKnownAfterGeneration (intPool, extPool) =
     let
         s0 :: SeqState 'Mainnet ShelleyKey
         s0 = SeqState intPool extPool emptyPendingIxs rewardAccount defaultPrefix
-        addrs0 = knownAddresses s0
+        addrs0 = pair' <$> knownAddresses s0
         (change, s1) = genChange (\k _ -> paymentAddress @'Mainnet k) s0
-        addrs1 = fst <$> knownAddresses s1
+        addrs1 = fst' <$> knownAddresses s1
     in conjoin
         [ prop_addrsNotInInternalPool addrs0
         , prop_changeAddressIsKnown change addrs1
@@ -519,9 +531,9 @@ prop_oursAreUsed
     -> Property
 prop_oursAreUsed s =
     let
-        (addr, status) = head $ knownAddresses s
+        (addr, status,_) = head $ knownAddresses s
         (True, s') = first isJust $ isOurs addr s
-        (addr', status') = head $ knownAddresses s'
+        (addr', status',_) = head $ knownAddresses s'
     in
         (status' == Used .&&. addr === addr')
         & label (show status)
@@ -551,8 +563,8 @@ prop_shrinkPreserveKnown _proxy (Positive size) pool =
         $ all (`elem` addrs') cut
   where
     pool'  = shrinkPool @'Mainnet liftAddress cut minBound pool
-    addrs  = fst <$> addresses liftAddress pool
-    addrs' = fst <$> addresses liftAddress pool'
+    addrs  = fst' <$> addresses liftAddress pool
+    addrs' = fst' <$> addresses liftAddress pool'
     cut    = take size addrs
 
 -- There's no address after the address from the cut with the highest index
@@ -572,8 +584,8 @@ prop_shrinkMaxIndex _proxy (Positive size) pool =
     fromIntegral size > getAddressPoolGap minBound ==> last cut === last addrs'
   where
     pool'  = shrinkPool @'Mainnet liftAddress cut minBound pool
-    addrs  = fst <$> addresses liftAddress pool
-    addrs' = fst <$> addresses liftAddress pool'
+    addrs  = fst' <$> addresses liftAddress pool
+    addrs' = fst' <$> addresses liftAddress pool'
     cut    = take size addrs
 
 {-------------------------------------------------------------------------------
@@ -700,7 +712,7 @@ instance
         let
             ctx = context pool
             g = gap pool
-            addrs = addresses liftAddress pool
+            addrs = pair' <$> addresses liftAddress pool
         in case length addrs of
             k | k == fromEnum g && g == minBound ->
                 []