From bd592f8c2a0c078d91d6fcb1d06c0bee49b242c0 Mon Sep 17 00:00:00 2001 From: Pawel Jakubas Date: Fri, 2 Apr 2021 11:09:25 +0200 Subject: [PATCH 1/4] extend ApiAddress with path derivation remove stack.yaml.lock --- .../Integration/Scenario/API/Byron/Migrations.hs | 2 +- .../Scenario/API/Shelley/Migrations.hs | 2 +- lib/core/src/Cardano/Wallet.hs | 10 +++++----- lib/core/src/Cardano/Wallet/Api/Server.hs | 14 ++++++++------ lib/core/src/Cardano/Wallet/Api/Types.hs | 1 + lib/core/src/Cardano/Wallet/DB/Sqlite.hs | 2 +- .../Cardano/Wallet/Primitive/AddressDiscovery.hs | 2 +- .../Wallet/Primitive/AddressDiscovery/Random.hs | 10 ++++++++-- .../Primitive/AddressDiscovery/Sequential.hs | 16 ++++++++++++---- specifications/api/swagger.yaml | 2 ++ 10 files changed, 40 insertions(+), 21 deletions(-) diff --git a/lib/core-integration/src/Test/Integration/Scenario/API/Byron/Migrations.hs b/lib/core-integration/src/Test/Integration/Scenario/API/Byron/Migrations.hs index 7d1486dd265..bbdc3a3eb8a 100644 --- a/lib/core-integration/src/Test/Integration/Scenario/API/Byron/Migrations.hs +++ b/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: diff --git a/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/Migrations.hs b/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/Migrations.hs index 978c6e0cc8c..e5ffff73a94 100644 --- a/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/Migrations.hs +++ b/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: diff --git a/lib/core/src/Cardano/Wallet.hs b/lib/core/src/Cardano/Wallet.hs index ae9864a371f..2188c8f259d 100644 --- a/lib/core/src/Cardano/Wallet.hs +++ b/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 = diff --git a/lib/core/src/Cardano/Wallet/Api/Server.hs b/lib/core/src/Cardano/Wallet/Api/Server.hs index 7dc13e40e14..c7908dde2da 100644 --- a/lib/core/src/Cardano/Wallet/Api/Server.hs +++ b/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 diff --git a/lib/core/src/Cardano/Wallet/Api/Types.hs b/lib/core/src/Cardano/Wallet/Api/Types.hs index 3c142d0c6c6..524ef5e098e 100644 --- a/lib/core/src/Cardano/Wallet/Api/Types.hs +++ b/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 diff --git a/lib/core/src/Cardano/Wallet/DB/Sqlite.hs b/lib/core/src/Cardano/Wallet/DB/Sqlite.hs index e03e18b21ae..01f3fe6a508 100644 --- a/lib/core/src/Cardano/Wallet/DB/Sqlite.hs +++ b/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) ] diff --git a/lib/core/src/Cardano/Wallet/Primitive/AddressDiscovery.hs b/lib/core/src/Cardano/Wallet/Primitive/AddressDiscovery.hs index 473f79c0ca1..628c37d3679 100644 --- a/lib/core/src/Cardano/Wallet/Primitive/AddressDiscovery.hs +++ b/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 diff --git a/lib/core/src/Cardano/Wallet/Primitive/AddressDiscovery/Random.hs b/lib/core/src/Cardano/Wallet/Primitive/AddressDiscovery/Random.hs index 299685e1502..346af77ed7c 100644 --- a/lib/core/src/Cardano/Wallet/Primitive/AddressDiscovery/Random.hs +++ b/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 [] -------------------------------------------------------------------------------- -- diff --git a/lib/core/src/Cardano/Wallet/Primitive/AddressDiscovery/Sequential.hs b/lib/core/src/Cardano/Wallet/Primitive/AddressDiscovery/Sequential.hs index f1bb281ff2d..57747465446 100644 --- a/lib/core/src/Cardano/Wallet/Primitive/AddressDiscovery/Sequential.hs +++ b/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 diff --git a/specifications/api/swagger.yaml b/specifications/api/swagger.yaml index 686ac8ea6b9..69e99943310 100644 --- a/specifications/api/swagger.yaml +++ b/specifications/api/swagger.yaml @@ -1423,9 +1423,11 @@ components: required: - id - state + - path_derivation properties: id: *addressId state: *addressState + path_derivation: *derivationPath ApiAddressInspect: &ApiAddressInspect type: object From c2c2a833b3789c3f615351eccf5a349c66b5f142 Mon Sep 17 00:00:00 2001 From: Pawel Jakubas Date: Fri, 2 Apr 2021 11:45:39 +0200 Subject: [PATCH 2/4] align core unit tests --- .../test/unit/Cardano/Wallet/Api/TypesSpec.hs | 1 + .../test/unit/Cardano/Wallet/DB/SqliteSpec.hs | 4 ++- .../Primitive/AddressDiscovery/RandomSpec.hs | 8 ++--- .../AddressDiscovery/SequentialSpec.hs | 36 ++++++++++++------- .../Primitive/AddressDiscovery/SharedSpec.hs | 5 ++- .../Wallet/Primitive/AddressDiscoverySpec.hs | 5 +-- 6 files changed, 39 insertions(+), 20 deletions(-) diff --git a/lib/core/test/unit/Cardano/Wallet/Api/TypesSpec.hs b/lib/core/test/unit/Cardano/Wallet/Api/TypesSpec.hs index 576edeea4dd..18013d058a3 100644 --- a/lib/core/test/unit/Cardano/Wallet/Api/TypesSpec.hs +++ b/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 diff --git a/lib/core/test/unit/Cardano/Wallet/DB/SqliteSpec.hs b/lib/core/test/unit/Cardano/Wallet/DB/SqliteSpec.hs index cde2bfc750b..354410887a4 100644 --- a/lib/core/test/unit/Cardano/Wallet/DB/SqliteSpec.hs +++ b/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 diff --git a/lib/core/test/unit/Cardano/Wallet/Primitive/AddressDiscovery/RandomSpec.hs b/lib/core/test/unit/Cardano/Wallet/Primitive/AddressDiscovery/RandomSpec.hs index 01249e662fd..4266502aa5e 100644 --- a/lib/core/test/unit/Cardano/Wallet/Primitive/AddressDiscovery/RandomSpec.hs +++ b/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 diff --git a/lib/core/test/unit/Cardano/Wallet/Primitive/AddressDiscovery/SequentialSpec.hs b/lib/core/test/unit/Cardano/Wallet/Primitive/AddressDiscovery/SequentialSpec.hs index 9c2a3dad81d..e9c95d842dd 100644 --- a/lib/core/test/unit/Cardano/Wallet/Primitive/AddressDiscovery/SequentialSpec.hs +++ b/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 -> [] diff --git a/lib/core/test/unit/Cardano/Wallet/Primitive/AddressDiscovery/SharedSpec.hs b/lib/core/test/unit/Cardano/Wallet/Primitive/AddressDiscovery/SharedSpec.hs index b41a7d4b114..e096ab91f83 100644 --- a/lib/core/test/unit/Cardano/Wallet/Primitive/AddressDiscovery/SharedSpec.hs +++ b/lib/core/test/unit/Cardano/Wallet/Primitive/AddressDiscovery/SharedSpec.hs @@ -139,10 +139,13 @@ prop_addressDiscoveryMakesAddressUsed (CatalystSharedState accXPub' accIx' pTemp addr = constructAddressFromIx @n pTemplate' dTemplate' keyIx sharedState = newSharedState @n accXPub' accIx' g pTemplate' dTemplate' ((Just (ix,_)), sharedState') = isShared @n addr sharedState + pair' (a,s,_) = (a,s) ourAddrs = case dTemplate' of Nothing -> + map pair' $ addresses (liftPaymentAddress @n @ShelleyKey) $ sharedStateAddressPool sharedState' Just dT -> + map pair' $ addresses (liftDelegationAddress @n @ShelleyKey ix dT) $ sharedStateAddressPool sharedState' prop_addressDoubleDiscovery @@ -225,7 +228,7 @@ prop_addressDiscoveryDoesNotChangeGapInvariance (CatalystSharedState accXPub' ac (_, sharedState') = isShared @n addr sharedState mapOfConsecutiveUnused = L.tail $ - L.dropWhile (\(_addr, state) -> state /= Used) $ + L.dropWhile (\(_addr, state,_path) -> state /= Used) $ addresses (liftPaymentAddress @n @ShelleyKey) $ sharedStateAddressPool sharedState' preconditions diff --git a/lib/core/test/unit/Cardano/Wallet/Primitive/AddressDiscoverySpec.hs b/lib/core/test/unit/Cardano/Wallet/Primitive/AddressDiscoverySpec.hs index a6618afaf36..e9e4de59a6b 100644 --- a/lib/core/test/unit/Cardano/Wallet/Primitive/AddressDiscoverySpec.hs +++ b/lib/core/test/unit/Cardano/Wallet/Primitive/AddressDiscoverySpec.hs @@ -85,9 +85,10 @@ prop_derivedKeysAreOurs -> ByronKey 'RootK XPrv -> Property prop_derivedKeysAreOurs seed encPwd accIx addrIx rk' = - isJust resPos .&&. addr `elem` (fst <$> knownAddresses stPos') .&&. - isNothing resNeg .&&. addr `notElem` (fst <$> knownAddresses stNeg') + isJust resPos .&&. addr `elem` (fst' <$> knownAddresses stPos') .&&. + isNothing resNeg .&&. addr `notElem` (fst' <$> knownAddresses stNeg') where + fst' (a,_,_) = a (resPos, stPos') = isOurs addr (mkRndState @n rootXPrv 0) (resNeg, stNeg') = isOurs addr (mkRndState @n rk' 0) key = publicKey $ unsafeGenerateKeyFromSeed (accIx, addrIx) seed encPwd From fe51309816508084209055f2d8f1fd4b4604e4c3 Mon Sep 17 00:00:00 2001 From: Pawel Jakubas Date: Fri, 2 Apr 2021 13:14:12 +0200 Subject: [PATCH 3/4] add derivation path length tests to byron, icarus and shelley --- .../src/Test/Integration/Scenario/API/Byron/Addresses.hs | 9 ++++++--- .../Test/Integration/Scenario/API/Shelley/Addresses.hs | 2 ++ specifications/api/swagger.yaml | 4 ++-- 3 files changed, 10 insertions(+), 5 deletions(-) diff --git a/lib/core-integration/src/Test/Integration/Scenario/API/Byron/Addresses.hs b/lib/core-integration/src/Test/Integration/Scenario/API/Byron/Addresses.hs index cd4540c114a..3d5659af3d5 100644 --- a/lib/core-integration/src/Test/Integration/Scenario/API/Byron/Addresses.hs +++ b/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" diff --git a/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/Addresses.hs b/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/Addresses.hs index 37de077b5d3..01f586689b0 100644 --- a/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/Addresses.hs +++ b/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 diff --git a/specifications/api/swagger.yaml b/specifications/api/swagger.yaml index 69e99943310..20cdfed956e 100644 --- a/specifications/api/swagger.yaml +++ b/specifications/api/swagger.yaml @@ -1423,11 +1423,11 @@ components: required: - id - state - - path_derivation + - derivation_path properties: id: *addressId state: *addressState - path_derivation: *derivationPath + derivation_path: *derivationPath ApiAddressInspect: &ApiAddressInspect type: object From f99c9affe4e927fb8fb974db8c39ce6817f52962 Mon Sep 17 00:00:00 2001 From: Pawel Jakubas Date: Fri, 2 Apr 2021 14:33:31 +0200 Subject: [PATCH 4/4] code improvements --- .../Primitive/AddressDiscovery/Random.hs | 19 +++++++++++++------ .../Primitive/AddressDiscovery/Sequential.hs | 2 +- 2 files changed, 14 insertions(+), 7 deletions(-) diff --git a/lib/core/src/Cardano/Wallet/Primitive/AddressDiscovery/Random.hs b/lib/core/src/Cardano/Wallet/Primitive/AddressDiscovery/Random.hs index 346af77ed7c..ae7f89108f6 100644 --- a/lib/core/src/Cardano/Wallet/Primitive/AddressDiscovery/Random.hs +++ b/lib/core/src/Cardano/Wallet/Primitive/AddressDiscovery/Random.hs @@ -333,16 +333,23 @@ deriveRndStateAddress k passphrase path = instance CompareDiscovery (RndState n) where compareDiscovery _ _ _ = EQ + instance KnownAddresses (RndState n) where knownAddresses s = mconcat - [ retrieveAddrsWithPaPath (discoveredAddresses s) - , retrieveAddrsWithPaPath ((,Unused) <$> pendingAddresses s) + [ toListWithPath (\path (addr, state) -> (addr, state, path)) + (discoveredAddresses s) + , toListWithPath (\path addr -> (addr, Unused, path)) + (pendingAddresses s) ] where - constructAddrWithPath path (addr,state) acc = - (addr, state, toDerivationIndexes path):acc - retrieveAddrsWithPaPath = - Map.foldrWithKey constructAddrWithPath [] + toListWithPath + :: (NonEmpty DerivationIndex -> v -> result) + -> Map DerivationPath v + -> [result] + toListWithPath mk = + Map.foldrWithKey + (\path v result -> mk (toDerivationIndexes path) v : result) + [] -------------------------------------------------------------------------------- -- diff --git a/lib/core/src/Cardano/Wallet/Primitive/AddressDiscovery/Sequential.hs b/lib/core/src/Cardano/Wallet/Primitive/AddressDiscovery/Sequential.hs index 57747465446..aae507607c7 100644 --- a/lib/core/src/Cardano/Wallet/Primitive/AddressDiscovery/Sequential.hs +++ b/lib/core/src/Cardano/Wallet/Primitive/AddressDiscovery/Sequential.hs @@ -391,7 +391,7 @@ addresses mkAddress = toDerivationPath ix = NE.fromList $ map DerivationIndex [ getIndex purposeBIP44 , getIndex purposeCIP1852 - , 0 + , 0 -- corresponds to account number , fromIntegral $ fromEnum $ role @c , getIndex ix ]