dandri/simplex-chat
1
0
Fork 0
mirror of https://github.com/simplex-chat/simplex-chat.git synced 2026-10-06 01:18:11 +00:00
Code Issues Packages Projects Releases Wiki Activity

core: /_wallet bind, and name the other profiles instead of numbering them

Browse Source 
Restoring a chat database older than the key loses which account each
profile had, and the keys are still there, so /_wallet bind <account> 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) <noreply@anthropic.com>
Claude-Session: https://claude.ai/code/session_01Rvc3HbiWBTqbAvRT45G5oX
This commit is contained in:
Alain Brenzikofer
2026-09-10 12:21:32 +00:00
co-authored by Claude Opus 5
parent ab50d9f4b1
commit de895ff43a
6 changed files with 117 additions and 91 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Simplex/Chat/Controller.hs
+3 -1
View File
@@ -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}
src/Simplex/Chat/Library/Commands.hs
+19 -16
View File
@@ -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),
src/Simplex/Chat/Store/Wallets.hs
+52 -48
View File
@@ -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
src/Simplex/Chat/View.hs
+6 -9
View File
@@ -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