From 9cba89aa17a494d0d88408e7bbdfa6d87e429803 Mon Sep 17 00:00:00 2001 From: Alain Brenzikofer Date: Thu, 10 Sep 2026 12:51:09 +0000 Subject: [PATCH] core: create makes the seed, bind claims a path The two were one command: on a device that already had a seed, /_wallet create only bound a profile. Now create makes the seed and refuses when one exists, and binds every profile that exists, as a new seed has no account that already owns a name. /_wallet import binds nothing. Which account a profile had is what an import is recovering, and the seed does not say, so the profile says it with /_wallet bind . /_wallet bind with no account takes the next free one. Co-Authored-By: Claude Opus 5 (1M context) Claude-Session: https://claude.ai/code/session_01Rvc3HbiWBTqbAvRT45G5oX --- src/Simplex/Chat/Controller.hs | 2 +- src/Simplex/Chat/Library/Commands.hs | 18 +++--- src/Simplex/Chat/Store/Wallets.hs | 92 +++++++++++++++------------- tests/WalletTests.hs | 24 ++++++-- 4 files changed, 80 insertions(+), 56 deletions(-) diff --git a/src/Simplex/Chat/Controller.hs b/src/Simplex/Chat/Controller.hs index c2aed4e77c..179d7be93e 100644 --- a/src/Simplex/Chat/Controller.hs +++ b/src/Simplex/Chat/Controller.hs @@ -418,7 +418,7 @@ data ChatCommand | APISendServiceRequest {userId :: UserId, sendTarget :: ConnectTarget 'CMContact, requestTimeout :: Maybe NominalDiffTime, signKey :: Maybe (C.StoredPrivateKey 'C.Ed25519), request :: J.Object} | APISendServiceResponse {userId :: UserId, requestId :: AgentInvId, responseData :: J.Object} | APIWallet - | APIWalletBind {accountIndex :: AccountIndex} + | APIWalletBind {boundAccountIndex :: Maybe AccountIndex} | APIWalletCreate | APIWalletImport {recoveryPhrase :: Text} | APIWalletExportSeedMnemonic diff --git a/src/Simplex/Chat/Library/Commands.hs b/src/Simplex/Chat/Library/Commands.hs index 25e1350892..ac18508ea2 100644 --- a/src/Simplex/Chat/Library/Commands.hs +++ b/src/Simplex/Chat/Library/Commands.hs @@ -58,7 +58,7 @@ import qualified Data.UUID.V4 as V4 import Simplex.Chat.Library.Subscriber import Simplex.Chat.Badges (BadgeCredential (..), LocalBadge (..), badgeServerCredential, maxXFTPFileSize, mkBadgeStatus, verifyCredential) import Simplex.Chat.Names (SimplexDomainProof (..), SimplexDomainClaim (..), claimDomain, mkDomainClaim) -import Simplex.Chat.Store.Wallets (bindAccountIndex, deleteSeed, getAccountIndex, getDeviceSeed, getOrCreateAccountRef, getSeedProfiles, importSeed) +import Simplex.Chat.Store.Wallets (bindAccountIndex, createSeed, deleteSeed, getAccountIndex, getDeviceSeed, getSeedProfiles, importSeed) import Simplex.Chat.Wallet (NameIndex, WalletSeed (..), accountAddress, accountSecret, deriveNameKey, importRecoveryKey, newSeed, recoveryKeyPhrase, renderNameKeyPath) import Simplex.Chat.Call import Simplex.Chat.Controller @@ -1502,19 +1502,20 @@ processChatCommand cxt nm = \case pure (renderNameKeyPath acct k, tshow $ accountAddress acc) profiles <- withFastStore' $ \db -> getSeedProfiles db (wsId seed) user pure $ CRWallet user True paths profiles - APIWalletBind acct -> withUser $ \user -> do + APIWalletBind acct_ -> withUser $ \user -> do seed <- withFastStore' getDeviceSeed >>= maybe (throwCmdError noKeyError) pure - bound <- withFastStore' $ \db -> bindAccountIndex db user (wsId seed) acct + bound <- withFastStore' $ \db -> bindAccountIndex db user (wsId seed) acct_ unless bound $ throwCmdError "another profile uses this account" processChatCommand cxt nm APIWallet - APIWalletCreate -> withUser $ \user -> do + APIWalletCreate -> withUser $ \_ -> do g <- asks random entropy <- atomically $ newSeed MS256 g - withFastStore' $ \db -> getOrCreateAccountRef db user entropy + created <- withFastStore' $ \db -> createSeed db entropy + unless created $ throwCmdError "this device already has a wallet key" processChatCommand cxt nm APIWallet - APIWalletImport phrase -> withUser $ \user -> do + APIWalletImport phrase -> withUser $ \_ -> do entropy <- either (const $ throwCmdError "bad recovery phrase") pure $ importRecoveryKey (encodeUtf8 phrase) - imported <- withFastStore' $ \db -> importSeed db user entropy + imported <- withFastStore' $ \db -> importSeed db entropy unless imported $ throwCmdError "this device already has a wallet key" processChatCommand cxt nm APIWallet APIWalletExportSeedMnemonic -> withUser $ \user -> do @@ -5590,7 +5591,8 @@ chatCommandP = "/_reject " *> (APIRejectContact <$> A.decimal <*> (" notify=" *> onOffP <|> pure False)), "/_service_request " *> (APISendServiceRequest <$> A.decimal <* A.space <*> strP <*> optional (" timeout=" *> (realToFrac <$> A.double)) <*> optional (" sign_key=" *> strP) <* A.space <*> jsonP), "/_service_response " *> (APISendServiceResponse <$> A.decimal <* A.space <*> strP <* A.space <*> jsonP), - "/_wallet bind " *> (APIWalletBind <$> keyIndexP), + "/_wallet bind " *> (APIWalletBind . Just <$> keyIndexP), + "/_wallet bind" $> APIWalletBind Nothing, "/_wallet create" $> APIWalletCreate, "/_wallet import " *> (APIWalletImport <$> textP), "/_wallet export " *> (APIWalletExportDerivedSecret <$> keyIndexP <* A.space <*> keyIndexP), diff --git a/src/Simplex/Chat/Store/Wallets.hs b/src/Simplex/Chat/Store/Wallets.hs index 69e8348f5b..84ab251bba 100644 --- a/src/Simplex/Chat/Store/Wallets.hs +++ b/src/Simplex/Chat/Store/Wallets.hs @@ -8,13 +8,14 @@ module Simplex.Chat.Store.Wallets ( getDeviceSeed, getAccountIndex, getSeedProfiles, - getOrCreateAccountRef, + createSeed, importSeed, bindAccountIndex, deleteSeed, ) where +import Control.Monad (forM_) import Data.ByteString (ByteString) import Data.Int (Int64) import Data.Text (Text) @@ -62,47 +63,53 @@ getSeedProfiles db (SeedId sId) User {userId} = |] (sId, userId) -bindAccount :: DB.Connection -> User -> SeedId -> AccountIndex -> IO () -bindAccount db User {userId} (SeedId sId) acct = +bindUser :: DB.Connection -> Int64 -> SeedId -> Int64 -> IO () +bindUser db uId (SeedId sId) acct = DB.execute db "UPDATE users SET wallet_seed_id = ?, wallet_account_index = ? WHERE user_id = ?" - (sId, fromIntegral acct :: Int64, userId) + (sId, acct, uId) -getOrCreateAccountRef :: DB.Connection -> User -> ByteString -> IO () -getOrCreateAccountRef db user entropy = - getAccountIndex db user >>= \case - Just _ -> pure () - Nothing -> getDeviceSeed db >>= maybe (createWalletSeed db entropy) pure >>= bindNewAccount db user - --- | False if the device already has a key. -importSeed :: DB.Connection -> User -> ByteString -> IO Bool -importSeed db user entropy = +-- | False if the device already has a key. Every profile is bound, as a new +-- seed has no account that already owns a name. +createSeed :: DB.Connection -> ByteString -> IO Bool +createSeed db entropy = getDeviceSeed db >>= \case - Just _ -> pure False - Nothing -> True <$ (createWalletSeed db entropy >>= bindNewAccount db user) - --- | False if another profile holds the account. The counter moves past it, so --- the next profile is not handed the same one. -bindAccountIndex :: DB.Connection -> User -> SeedId -> AccountIndex -> IO Bool -bindAccountIndex db user sId@(SeedId sId') acct = do - taken <- maybeFirstRow fromOnly $ - DB.query - db - "SELECT 1 FROM users WHERE wallet_seed_id = ? AND wallet_account_index = ? AND user_id != ?" - (sId', fromIntegral acct :: Int64, userId user) - case (taken :: Maybe Int64) of Just _ -> pure False Nothing -> do - bindAccount db user sId acct - DB.execute - db - "UPDATE wallet_seeds SET next_account_index = ? WHERE wallet_seed_id = ? AND next_account_index <= ?" - (fromIntegral acct + 1 :: Int64, sId', fromIntegral acct :: Int64) + s <- createWalletSeed db entropy + uIds <- map fromOnly <$> DB.query_ db "SELECT user_id FROM users ORDER BY user_id" + forM_ (zip uIds [0 ..]) $ \(uId, acct) -> bindUser db uId (wsId s) acct + setNextAccountIndex db (wsId s) (fromIntegral $ length uIds) pure True -bindNewAccount :: DB.Connection -> User -> WalletSeed -> IO () -bindNewAccount db user s = takeAccountIndex db (wsId s) >>= bindAccount db user (wsId s) +-- | False if the device already has a key. No profile is bound: which account +-- a profile had is what the import is recovering, and the seed does not say. +importSeed :: DB.Connection -> ByteString -> IO Bool +importSeed db entropy = + getDeviceSeed db >>= \case + Just _ -> pure False + Nothing -> True <$ createWalletSeed db entropy + +-- | Without an account the next free one is taken. False if another profile +-- holds the account asked for. +bindAccountIndex :: DB.Connection -> User -> SeedId -> Maybe AccountIndex -> IO Bool +bindAccountIndex db User {userId} sId@(SeedId sId') = \case + Nothing -> True <$ (takeAccountIndex db sId >>= bindUser db userId sId) + Just acct -> do + taken <- + maybeFirstRow fromOnly $ + DB.query + db + "SELECT 1 FROM users WHERE wallet_seed_id = ? AND wallet_account_index = ? AND user_id != ?" + (sId', fromIntegral acct :: Int64, userId) + case (taken :: Maybe Int64) of + Just _ -> pure False + Nothing -> do + bindUser db userId sId (fromIntegral acct) + -- the counter moves past it, so the next profile is not handed the same one + setNextAccountIndex db sId (fromIntegral acct + 1) + pure True createWalletSeed :: DB.Connection -> ByteString -> IO WalletSeed createWalletSeed db entropy = do @@ -111,18 +118,21 @@ createWalletSeed db entropy = do pure WalletSeed {wsId = SeedId sId, wsEntropy = entropy} -- | Incremented in SQL, so two profiles cannot be handed the same account. -takeAccountIndex :: DB.Connection -> SeedId -> IO AccountIndex -takeAccountIndex db sId@(SeedId sId') = do - DB.execute db "UPDATE wallet_seeds SET next_account_index = next_account_index + 1 WHERE wallet_seed_id = ?" (Only sId') - subtract 1 <$> getNextAccountIndex db sId - -getNextAccountIndex :: DB.Connection -> SeedId -> IO AccountIndex -getNextAccountIndex db (SeedId sId) = - maybe 0 (fromIntegral :: Int64 -> AccountIndex) +takeAccountIndex :: DB.Connection -> SeedId -> IO Int64 +takeAccountIndex db (SeedId sId) = do + DB.execute db "UPDATE wallet_seeds SET next_account_index = next_account_index + 1 WHERE wallet_seed_id = ?" (Only sId) + maybe 0 (subtract 1) <$> ( maybeFirstRow fromOnly $ DB.query db "SELECT next_account_index FROM wallet_seeds WHERE wallet_seed_id = ?" (Only sId) ) +setNextAccountIndex :: DB.Connection -> SeedId -> Int64 -> IO () +setNextAccountIndex db (SeedId sId) acct = + DB.execute + db + "UPDATE wallet_seeds SET next_account_index = ? WHERE wallet_seed_id = ? AND next_account_index < ?" + (acct, sId, acct) + -- | Profiles are unbound first, as the foreign key is ON DELETE RESTRICT. deleteSeed :: DB.Connection -> SeedId -> IO () deleteSeed db (SeedId sId) = do diff --git a/tests/WalletTests.hs b/tests/WalletTests.hs index 14f7a8f12f..a6eabf4b19 100644 --- a/tests/WalletTests.hs +++ b/tests/WalletTests.hs @@ -70,9 +70,13 @@ testWalletCreate ps = withNewTestChat ps "alice" aliceProfile $ \alice -> do alice <## "no wallet key" alice ##> "/_wallet export" alice <## "bad chat command: no wallet key on this device" + alice ##> "/create user alisa" + showActiveUser alice "alisa" + -- a new seed has no account that owns a name, so every profile is bound alice ##> "/_wallet create" rows <- nameRows alice - map fst rows `shouldBe` ["m/44'/60'/0'/0/0", "m/44'/60'/0'/0/1"] + alice <## "also on same seed: alice" + map fst rows `shouldBe` ["m/44'/60'/1'/0/0", "m/44'/60'/1'/0/1"] length (nub $ map snd rows) `shouldBe` 2 testWalletPersists :: HasCallStack => TestParams -> IO () @@ -101,7 +105,10 @@ testWalletSecondProfile ps = withNewTestChat ps "alice" aliceProfile $ \alice -> -- the key belongs to the device, so a profile without an account exports it too alice ##> "/_wallet export" alice <## phrase + -- create is for the seed, and this device has one alice ##> "/_wallet create" + alice <## "bad chat command: this device already has a wallet key" + alice ##> "/_wallet bind" rows' <- nameRows alice alice <## "also on same seed: alice" map fst rows' `shouldBe` ["m/44'/60'/1'/0/0", "m/44'/60'/1'/0/1"] @@ -109,7 +116,10 @@ testWalletSecondProfile ps = withNewTestChat ps "alice" aliceProfile $ \alice -> testWalletImport :: HasCallStack => TestParams -> IO () testWalletImport ps = withNewTestChat ps "alice" aliceProfile $ \alice -> do + -- import binds nothing: which account a profile had is what it is recovering alice ##> ("/_wallet import " <> B.unpack testPhrase) + alice <## "this profile has no wallet key" + alice ##> "/_wallet bind" alice <## "name 0 m/44'/60'/0'/0/0 0x9858EfFD232B4033E47d90003D41EC34EcaEda94" alice <## "name 1 m/44'/60'/0'/0/1 0x6Fac4D18c912343BF86fa7049364Dd4E424Ab9C0" alice ##> "/_wallet export" @@ -122,8 +132,9 @@ testWalletImport ps = withNewTestChat ps "alice" aliceProfile $ \alice -> do testWalletExportDerivedSecret :: HasCallStack => TestParams -> IO () testWalletExportDerivedSecret ps = withNewTestChat ps "alice" aliceProfile $ \alice -> do + -- the secret of a name key needs no profile bound to that account alice ##> ("/_wallet import " <> B.unpack testPhrase) - _ <- nameRows alice + alice <## "this profile has no wallet key" alice ##> "/_wallet export 0 0" alice <## "m/44'/60'/0'/0/0 0x9858EfFD232B4033E47d90003D41EC34EcaEda94 0x1ab42cc412b618bdea3a599e3c9bae199ebf030895b039e9db1e30dafb12b727" -- an index BIP-32 cannot harden is rejected, not wrapped into another account @@ -142,20 +153,21 @@ testWalletExportDerivedSecret ps = withNewTestChat ps "alice" aliceProfile $ \al testWalletDelete :: HasCallStack => TestParams -> IO () testWalletDelete ps = withNewTestChat ps "alice" aliceProfile $ \alice -> do alice ##> ("/_wallet import " <> B.unpack testPhrase) + alice <## "this profile has no wallet key" + alice ##> "/_wallet bind" _ <- nameRows alice alice ##> "/_wallet delete" alice <## "no wallet key" -- deleting unbinds the profile, so a key can be imported again alice ##> ("/_wallet import " <> B.unpack testPhrase) - _ <- nameRows alice - pure () + alice <## "this profile has no wallet key" -- | Restoring a chat database older than the key rebinds profiles in the order -- they ask, so the account a profile had is set by hand. testWalletBind :: HasCallStack => TestParams -> IO () testWalletBind ps = withNewTestChat ps "alice" aliceProfile $ \alice -> do alice ##> ("/_wallet import " <> B.unpack testPhrase) - _ <- nameRows alice + alice <## "this profile has no wallet key" alice ##> "/_wallet bind 3" rows <- nameRows alice map fst rows `shouldBe` ["m/44'/60'/3'/0/0", "m/44'/60'/3'/0/1"] @@ -164,7 +176,7 @@ testWalletBind ps = withNewTestChat ps "alice" aliceProfile $ \alice -> do alice ##> "/_wallet bind 3" alice <## "bad chat command: another profile uses this account" -- the counter moved past the account bound by hand - alice ##> "/_wallet create" + alice ##> "/_wallet bind" rows' <- nameRows alice alice <## "also on same seed: alice" map fst rows' `shouldBe` ["m/44'/60'/4'/0/0", "m/44'/60'/4'/0/1"]