From de895ff43a6ed39a61a89803da5300bc9eb437f5 Mon Sep 17 00:00:00 2001 From: Alain Brenzikofer Date: Thu, 10 Sep 2026 12:21:32 +0000 Subject: [PATCH] core: /_wallet bind, and name the other profiles instead of numbering them Restoring a chat database older than the key loses which account each profile had, and the keys are still there, so /_wallet bind sets it by hand. The counter moves past an account bound this way, and an account another profile holds is refused. /_wallet now shows the paths of the active profile only, and names the other profiles on the key. Their account indexes were the gap that showed a hidden profile exists. Co-Authored-By: Claude Opus 5 (1M context) Claude-Session: https://claude.ai/code/session_01Rvc3HbiWBTqbAvRT45G5oX --- bots/src/API/Docs/Commands.hs | 1 + src/Simplex/Chat/Controller.hs | 4 +- src/Simplex/Chat/Library/Commands.hs | 35 +++++----- src/Simplex/Chat/Store/Wallets.hs | 100 ++++++++++++++------------- src/Simplex/Chat/View.hs | 15 ++-- tests/WalletTests.hs | 53 +++++++++----- 6 files changed, 117 insertions(+), 91 deletions(-) diff --git a/bots/src/API/Docs/Commands.hs b/bots/src/API/Docs/Commands.hs index 0be6b110a7..3673ca7c86 100644 --- a/bots/src/API/Docs/Commands.hs +++ b/bots/src/API/Docs/Commands.hs @@ -451,6 +451,7 @@ undocumentedCommands = "APIVerifyGroupMember", "APIVerifyToken", "APIWallet", + "APIWalletBind", "APIWalletCreate", "APIWalletDelete", "APIWalletExportDerivedSecret", diff --git a/src/Simplex/Chat/Controller.hs b/src/Simplex/Chat/Controller.hs index d9b71084da..c2aed4e77c 100644 --- a/src/Simplex/Chat/Controller.hs +++ b/src/Simplex/Chat/Controller.hs @@ -418,6 +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} | APIWalletCreate | APIWalletImport {recoveryPhrase :: Text} | APIWalletExportSeedMnemonic @@ -749,6 +750,7 @@ allowRemoteCommand = \case ExecChatStoreSQL _ -> False ExecAgentStoreSQL _ -> False APIWallet -> False + APIWalletBind {} -> False APIWalletCreate -> False APIWalletImport _ -> False APIWalletExportSeedMnemonic -> False @@ -855,7 +857,7 @@ data ChatResponse | CRContactRequestRejected {user :: User, contactRequest :: UserContactRequest, contact_ :: Maybe Contact} | CRServiceResponse {user :: User, responseData :: J.Object} | CRServiceReplyAccepted {user :: User, connectionId :: AgentConnId} - | CRWallet {user :: User, walletKeyExists :: Bool, walletAccounts :: [(Text, AccountIndex, Bool, [(Text, Text)])]} + | CRWallet {user :: User, walletKeyExists :: Bool, walletKeyPaths :: [(Text, Text)], walletProfiles :: [Text]} | CRWalletSeedMnemonic {user :: User, recoveryPhrase :: Text} | CRWalletDerivedSecret {user :: User, keyPath :: Text, address :: Text, derivedSecret :: Text} | CRUserAcceptedGroupSent {user :: User, groupInfo :: GroupInfo, hostContact :: Maybe Contact} diff --git a/src/Simplex/Chat/Library/Commands.hs b/src/Simplex/Chat/Library/Commands.hs index ad21a337e0..25e1350892 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 (deleteSeed, getDeviceSeed, getOrCreateAccountRef, getSeedAccounts, importSeed) +import Simplex.Chat.Store.Wallets (bindAccountIndex, deleteSeed, getAccountIndex, getDeviceSeed, getOrCreateAccountRef, getSeedProfiles, importSeed) import Simplex.Chat.Wallet (NameIndex, WalletSeed (..), accountAddress, accountSecret, deriveNameKey, importRecoveryKey, newSeed, recoveryKeyPhrase, renderNameKeyPath) import Simplex.Chat.Call import Simplex.Chat.Controller @@ -1492,28 +1492,30 @@ processChatCommand cxt nm = \case connId <- withAgent $ \a -> sendServiceReplyAsync a "" (aUserId user) invId (LB.toStrict $ J.encode responseData) pure $ CRServiceReplyAccepted user (AgentConnId connId) APIWallet -> withUser $ \user -> do - seed_ <- withFastStore' getDeviceSeed - accs <- case seed_ of - Nothing -> pure [] + withFastStore' getDeviceSeed >>= \case + Nothing -> pure $ CRWallet user False [] [] Just seed -> do - -- hidden profiles are left out, as they are by /users, but the gap in - -- account indexes still shows that one exists - as <- filter (\(_, _, active, hidden) -> active || not hidden) <$> withFastStore' (\db -> getSeedAccounts db (wsId seed)) - forM as $ \(n, acct, active, _) -> do - keys <- forM [0 .. walletNamesShown - 1] $ \k -> do - acc <- either (throwCmdError . ("wallet: " <>)) pure $ deriveNameKey seed acct k - pure (renderNameKeyPath acct k, tshow (accountAddress acc)) - pure (n, acct, active, keys) - pure $ CRWallet user (isJust seed_) accs + -- other profiles are named but not numbered, so a hidden one leaves no gap + acct_ <- withFastStore' (`getAccountIndex` user) + paths <- forM (maybe [] (\acct -> map ((,) acct) [0 .. walletNamesShown - 1]) acct_) $ \(acct, k) -> do + acc <- either (throwCmdError . ("wallet: " <>)) pure $ deriveNameKey seed acct k + 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 + seed <- withFastStore' getDeviceSeed >>= maybe (throwCmdError noKeyError) pure + 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 g <- asks random entropy <- atomically $ newSeed MS256 g - void $ withFastStore' $ \db -> getOrCreateAccountRef db user entropy + withFastStore' $ \db -> getOrCreateAccountRef db user entropy processChatCommand cxt nm APIWallet APIWalletImport phrase -> withUser $ \user -> do entropy <- either (const $ throwCmdError "bad recovery phrase") pure $ importRecoveryKey (encodeUtf8 phrase) - r <- withFastStore' $ \db -> importSeed db user entropy - when (isNothing r) $ throwCmdError "this device already has a wallet key" + imported <- withFastStore' $ \db -> importSeed db user entropy + unless imported $ throwCmdError "this device already has a wallet key" processChatCommand cxt nm APIWallet APIWalletExportSeedMnemonic -> withUser $ \user -> do seed <- withFastStore' getDeviceSeed >>= maybe (throwCmdError noKeyError) pure @@ -5588,6 +5590,7 @@ 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 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 b7a41a1e79..69e8348f5b 100644 --- a/src/Simplex/Chat/Store/Wallets.hs +++ b/src/Simplex/Chat/Store/Wallets.hs @@ -6,22 +6,22 @@ module Simplex.Chat.Store.Wallets ( getDeviceSeed, - getSeedAccounts, + getAccountIndex, + getSeedProfiles, getOrCreateAccountRef, importSeed, + bindAccountIndex, deleteSeed, ) where import Data.ByteString (ByteString) import Data.Int (Int64) -import Data.Maybe (isJust) import Data.Text (Text) import Simplex.Chat.Store.Shared (insertedRowId) import Simplex.Chat.Types (User (..)) -import Simplex.Chat.Wallet (AccountIndex, AccountRef (..), SeedId (..), WalletSeed (..)) +import Simplex.Chat.Wallet (AccountIndex, SeedId (..), WalletSeed (..)) import Simplex.Messaging.Agent.Store.AgentStore (maybeFirstRow) -import Simplex.Messaging.Agent.Store.DB (BoolInt (..)) import qualified Simplex.Messaging.Agent.Store.DB as DB #if defined(dbPostgres) @@ -40,65 +40,69 @@ getDeviceSeed db = maybeFirstRow toSeed $ DB.query_ db "SELECT wallet_seed_id, seed FROM wallet_seeds ORDER BY wallet_seed_id LIMIT 1" -getWalletSeed :: DB.Connection -> SeedId -> IO (Maybe WalletSeed) -getWalletSeed db (SeedId sId) = - maybeFirstRow toSeed $ - DB.query db "SELECT wallet_seed_id, seed FROM wallet_seeds WHERE wallet_seed_id = ?" (Only sId) - -getAccountRef :: DB.Connection -> User -> IO (Maybe AccountRef) -getAccountRef db User {userId} = do +getAccountIndex :: DB.Connection -> User -> IO (Maybe AccountIndex) +getAccountIndex db User {userId} = do r <- - maybeFirstRow id $ - DB.query db "SELECT wallet_seed_id, wallet_account_index FROM users WHERE user_id = ?" (Only userId) + maybeFirstRow fromOnly $ + DB.query db "SELECT wallet_account_index FROM users WHERE user_id = ?" (Only userId) pure $ case r of - Just (Just sId, Just ix) -> Just AccountRef {arSeedId = SeedId sId, arIndex = fromIntegral (ix :: Int64)} + Just (Just ix) -> Just $ fromIntegral (ix :: Int64) _ -> Nothing -bindAccount :: DB.Connection -> User -> AccountRef -> IO () -bindAccount db User {userId} AccountRef {arSeedId = SeedId sId, arIndex} = - DB.execute - db - "UPDATE users SET wallet_seed_id = ?, wallet_account_index = ? WHERE user_id = ?" - (sId, fromIntegral arIndex :: Int64, userId) - -getBoundAccount :: DB.Connection -> User -> IO (Maybe (WalletSeed, AccountRef)) -getBoundAccount db user = - getAccountRef db user >>= \case - Nothing -> pure Nothing - Just r -> fmap (\s -> (s, r)) <$> getWalletSeed db (arSeedId r) - -getSeedAccounts :: DB.Connection -> SeedId -> IO [(Text, AccountIndex, Bool, Bool)] -getSeedAccounts db (SeedId sId) = - map toRow +-- | Hidden profiles are left out, as they are by /users. +getSeedProfiles :: DB.Connection -> SeedId -> User -> IO [Text] +getSeedProfiles db (SeedId sId) User {userId} = + map fromOnly <$> DB.query db [sql| - SELECT local_display_name, wallet_account_index, active_user, view_pwd_hash - FROM users WHERE wallet_seed_id = ? ORDER BY wallet_account_index + SELECT local_display_name FROM users + WHERE wallet_seed_id = ? AND user_id != ? AND view_pwd_hash IS NULL + ORDER BY local_display_name |] - (Only sId) - where - toRow (n, ix, BI active, pwdHash) = (n, fromIntegral (ix :: Int64), active, isJust (pwdHash :: Maybe ByteString)) + (sId, userId) -getOrCreateAccountRef :: DB.Connection -> User -> ByteString -> IO (WalletSeed, AccountRef) +bindAccount :: DB.Connection -> User -> SeedId -> AccountIndex -> IO () +bindAccount db User {userId} (SeedId sId) acct = + DB.execute + db + "UPDATE users SET wallet_seed_id = ?, wallet_account_index = ? WHERE user_id = ?" + (sId, fromIntegral acct :: Int64, userId) + +getOrCreateAccountRef :: DB.Connection -> User -> ByteString -> IO () getOrCreateAccountRef db user entropy = - getBoundAccount db user >>= \case - Just bound -> pure bound + getAccountIndex db user >>= \case + Just _ -> pure () Nothing -> getDeviceSeed db >>= maybe (createWalletSeed db entropy) pure >>= bindNewAccount db user --- | Nothing if the device already has a key. -importSeed :: DB.Connection -> User -> ByteString -> IO (Maybe (WalletSeed, AccountRef)) +-- | False if the device already has a key. +importSeed :: DB.Connection -> User -> ByteString -> IO Bool importSeed db user entropy = getDeviceSeed db >>= \case - Just _ -> pure Nothing - Nothing -> Just <$> (createWalletSeed db entropy >>= bindNewAccount db user) + Just _ -> pure False + Nothing -> True <$ (createWalletSeed db entropy >>= bindNewAccount db user) -bindNewAccount :: DB.Connection -> User -> WalletSeed -> IO (WalletSeed, AccountRef) -bindNewAccount db user s = do - ix <- takeAccountIndex db (wsId s) - let r = AccountRef {arSeedId = wsId s, arIndex = ix} - bindAccount db user r - pure (s, r) +-- | 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) + pure True + +bindNewAccount :: DB.Connection -> User -> WalletSeed -> IO () +bindNewAccount db user s = takeAccountIndex db (wsId s) >>= bindAccount db user (wsId s) createWalletSeed :: DB.Connection -> ByteString -> IO WalletSeed createWalletSeed db entropy = do diff --git a/src/Simplex/Chat/View.hs b/src/Simplex/Chat/View.hs index 8f598340f1..b6e2b58eb8 100644 --- a/src/Simplex/Chat/View.hs +++ b/src/Simplex/Chat/View.hs @@ -188,17 +188,14 @@ chatResponseToView hu cfg@ChatConfig {logLevel, showReactions, showFullLinks, te CRContactRequestRejected u UserContactRequest {localDisplayName = c} _ct_ -> ttyUser u [ttyContact c <> ": contact request rejected"] CRServiceResponse u resp -> ttyUser u ["service response: " <> viewJSON resp] CRServiceReplyAccepted u (AgentConnId cId) -> ttyUser u [plain $ "service reply accepted, connection id: " <> safeDecodeUtf8 (strEncode cId)] - CRWallet u exists accs + CRWallet u exists paths profiles | not exists -> ttyUser u ["no wallet key"] - | otherwise -> - ttyUser u $ - concatMap accountRows accs - <> ["this profile has no wallet key" | not (any (\(_, _, active, _) -> active) accs)] + | otherwise -> ttyUser u $ keyRows <> [plain $ "also on this key: " <> T.intercalate ", " profiles | not (null profiles)] where - accountRows (n, acct, active, keys) = - plain ("account " <> tshow acct <> " (" <> n <> (if active then ", active" else "") <> ")") - : zipWith nameRow [0 :: Int ..] keys - nameRow k (path, addr) = plain $ " name " <> tshow k <> " " <> path <> " " <> addr + keyRows + | null paths = ["this profile has no wallet key"] + | otherwise = zipWith nameRow [0 :: Int ..] paths + nameRow k (path, addr) = plain $ "name " <> tshow k <> " " <> path <> " " <> addr CRWalletSeedMnemonic u phrase -> ttyUser u [plain phrase] CRWalletDerivedSecret u path addr secret -> ttyUser u [plain $ path <> " " <> addr <> " " <> secret] CRGroupCreated u g -> ttyUser u $ viewGroupCreated g testView diff --git a/tests/WalletTests.hs b/tests/WalletTests.hs index 4039364726..aaef7c82d6 100644 --- a/tests/WalletTests.hs +++ b/tests/WalletTests.hs @@ -52,11 +52,10 @@ walletTests = do it "imports a phrase, exports it, and refuses a second import" testWalletImport it "exports the secret of any name key" testWalletExportDerivedSecret it "deletes the key, and a key can be imported again" testWalletDelete + it "binds a profile to the account it had" testWalletBind -accountRows :: HasCallStack => TestCC -> String -> Int -> IO [(String, String)] -accountRows cc profile acct = do - cc <## ("account " <> show acct <> " (" <> profile <> ")") - mapM (\_ -> nameRow <$> getTermLine cc) [0 .. 1 :: Int] +nameRows :: HasCallStack => TestCC -> IO [(String, String)] +nameRows cc = mapM (\_ -> nameRow <$> getTermLine cc) [0 .. 1 :: Int] where nameRow l = case words l of ["name", _, path, addr] -> (path, addr) @@ -72,7 +71,7 @@ testWalletCreate ps = withNewTestChat ps "alice" aliceProfile $ \alice -> do alice ##> "/_wallet export" alice <## "bad chat command: no wallet key on this device" alice ##> "/_wallet create" - rows <- accountRows alice "alice, active" 0 + rows <- nameRows alice map fst rows `shouldBe` ["m/44'/60'/0'/0/0", "m/44'/60'/0'/0/1"] length (nub $ map snd rows) `shouldBe` 2 @@ -80,38 +79,39 @@ testWalletPersists :: HasCallStack => TestParams -> IO () testWalletPersists ps = do rows <- withNewTestChat ps "alice" aliceProfile $ \alice -> do alice ##> "/_wallet create" - accountRows alice "alice, active" 0 + nameRows alice -- same database, new session: a name bought at that address must stay reachable withTestChat ps "alice" $ \alice -> do alice ##> "/_wallet" - rows' <- accountRows alice "alice, active" 0 + rows' <- nameRows alice rows' `shouldBe` rows testWalletSecondProfile :: HasCallStack => TestParams -> IO () testWalletSecondProfile ps = withNewTestChat ps "alice" aliceProfile $ \alice -> do alice ##> "/_wallet create" - rows <- accountRows alice "alice, active" 0 + rows <- nameRows alice alice ##> "/_wallet export" phrase <- getTermLine alice alice ##> "/create user alisa" showActiveUser alice "alisa" + -- other profiles are named, never numbered alice ##> "/_wallet" - _ <- accountRows alice "alice" 0 alice <## "this profile has no wallet key" + alice <## "also on this key: alice" -- the key belongs to the device, so a profile without an account exports it too alice ##> "/_wallet export" alice <## phrase alice ##> "/_wallet create" - _ <- accountRows alice "alice" 0 - rows' <- accountRows alice "alisa, active" 1 + rows' <- nameRows alice + alice <## "also on this key: alice" + map fst rows' `shouldBe` ["m/44'/60'/1'/0/0", "m/44'/60'/1'/0/1"] null (map snd rows `intersect` map snd rows') `shouldBe` True testWalletImport :: HasCallStack => TestParams -> IO () testWalletImport ps = withNewTestChat ps "alice" aliceProfile $ \alice -> do alice ##> ("/_wallet import " <> B.unpack testPhrase) - alice <## "account 0 (alice, active)" - alice <## " name 0 m/44'/60'/0'/0/0 0x9858EfFD232B4033E47d90003D41EC34EcaEda94" - alice <## " name 1 m/44'/60'/0'/0/1 0x6Fac4D18c912343BF86fa7049364Dd4E424Ab9C0" + alice <## "name 0 m/44'/60'/0'/0/0 0x9858EfFD232B4033E47d90003D41EC34EcaEda94" + alice <## "name 1 m/44'/60'/0'/0/1 0x6Fac4D18c912343BF86fa7049364Dd4E424Ab9C0" alice ##> "/_wallet export" alice <## B.unpack testPhrase alice ##> ("/_wallet import " <> B.unpack testPhrase) @@ -123,7 +123,7 @@ testWalletImport ps = withNewTestChat ps "alice" aliceProfile $ \alice -> do testWalletExportDerivedSecret :: HasCallStack => TestParams -> IO () testWalletExportDerivedSecret ps = withNewTestChat ps "alice" aliceProfile $ \alice -> do alice ##> ("/_wallet import " <> B.unpack testPhrase) - _ <- accountRows alice "alice, active" 0 + _ <- nameRows alice 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,10 +142,29 @@ 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) - _ <- accountRows alice "alice, active" 0 + _ <- 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) - _ <- accountRows alice "alice, active" 0 + _ <- nameRows alice pure () + +-- | 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 ##> "/_wallet bind 3" + rows <- nameRows alice + map fst rows `shouldBe` ["m/44'/60'/3'/0/0", "m/44'/60'/3'/0/1"] + alice ##> "/create user alisa" + showActiveUser alice "alisa" + 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" + rows' <- nameRows alice + alice <## "also on this key: alice" + map fst rows' `shouldBe` ["m/44'/60'/4'/0/0", "m/44'/60'/4'/0/1"]