self-review iteration 2

src/Simplex/Chat/Controller.hs

@@ -68,8 +68,8 @@ import Simplex.Chat.Types
 import Simplex.Chat.Types.Preferences
 import Simplex.Chat.Types.Shared
 import Simplex.Chat.Types.UITheme
-import Simplex.Chat.Wallet (AccountIndex, WalletAddress, WalletError)
 import Simplex.Chat.Util (liftIOEither)
+import Simplex.Chat.Wallet (AccountIndex, WalletAddress, WalletError)
 import Simplex.FileTransfer.Description (FileDescriptionURI)
 import Simplex.Messaging.Server.Information (ServerPublicInfo)
 import Simplex.Messaging.Agent (AgentClient, DatabaseDiff, SubscriptionsInfo)
@@ -437,12 +437,12 @@ data ChatCommand
   | APIRejectContact {contactReqId :: Int64, notify :: Bool}
   | 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}
-  | APIGetWallet
+  | APIGetWallet {userId :: UserId}
   | APICreateWallet {mnemonic :: Maybe Text}
-  | APIBindWalletAccount {accountIndex_ :: Maybe AccountIndex}
+  | APIBindWalletAccount {userId :: UserId, accountIndex_ :: Maybe AccountIndex}
   | APIGetWalletAddress {accountIndex_ :: Maybe AccountIndex}
   | APIExportWalletMnemonic
-  | APIExportWalletAccount {accountIndex :: AccountIndex}
+  | APIExportWalletAccount {userId :: UserId, accountIndex :: AccountIndex}
   | APIDeleteWallet
   | APISendCallInvitation ContactId CallType
   | SendCallInvitation ContactName CallType

src/Simplex/Chat/Library/Commands.hs

@@ -65,9 +65,8 @@ import Simplex.Chat.Badges.Types (BadgeAlert (..), BadgeAlertKind (..), BadgeIss
 import Simplex.Chat.Badges.Code (badgeCodeText, parseBadgeCode)
 import Simplex.Chat.Badges.Service (BadgeBalance (..), BadgeServiceCommand (..), BadgeServiceErrorCode (..), BadgeServiceRequest (..), BadgeServiceResponse (..), BadgeStatement (..), StatementDebitType (..), StatementEntry (..), StatementEntryType (..), currentBadgeServiceVersion)
 import Simplex.Chat.Names (SimplexDomainProof (..), SimplexDomainClaim (..), claimDomain, mkDomainClaim)
-import Simplex.Chat.Store.Wallets (WalletSeed (..), accountHeldByOther, bindAccount, createWalletSeed, deleteWalletSeed, getUserAccounts, getWalletSeed, resolveAccount)
-import Simplex.Chat.Wallet (AccountIndex, AccountKey, WalletAddress (..), WalletError (..), accountSecret, deriveAccountKey, entropyFromMnemonic, newSeedEntropy, renderAccountPath, seedMaster, seedMnemonic)
-import Simplex.Messaging.Eth.Address (addressFromPrivateKey)
+import Simplex.Chat.Store.Wallets (WalletSeed (..), accountHeldBy, bindAccount, createWalletSeed, deleteWalletSeed, getUserAccounts, getWalletSeed, resolveAccount)
+import Simplex.Chat.Wallet (AccountIndex, AccountKey, WalletAddress, WalletError (..), accountSecret, deriveAccount, entropyFromMnemonic, newSeedEntropy, seedMnemonic)
 import Simplex.Chat.Call
 import Simplex.Chat.Controller
 import Simplex.Chat.Delivery (DeliveryJobScope (..), DeliveryJobSpec (..), DeliveryWorkerScope (..))
@@ -1500,33 +1499,33 @@ processChatCommand cxt nm = \case
     let AgentInvId invId = requestId
     connId <- withAgent $ \a -> sendServiceReplyAsync a "" (aUserId user) invId (LB.toStrict $ J.encode responseData)
     pure $ CRServiceReplyAccepted user (AgentConnId connId)
-  APIGetWallet -> withUser $ \user@User {userId} ->
-    CRWallet user <$> withFastStore' (\db -> getWalletSeed db $>>= \WalletSeed {wsId} -> Just <$> getUserAccounts db wsId userId)
+  APIGetWallet userId -> withUserId userId $ \user ->
+    CRWallet user <$> withFastStore' (\db -> getWalletSeed db >>= mapM (\WalletSeed {wsId} -> getUserAccounts db wsId userId))
   APICreateWallet mnemonic_ -> withUser $ \user -> do
     seed_ <- withFastStore' getWalletSeed
     when (isJust seed_) $ throwWalletError WEMasterExists
-    -- a generated seed has taken no accounts, an imported one does not say how many it has taken
+    -- the counter starts at 0 for a generated seed and is unknown for an imported one
     (entropy, nextAccount) <- case mnemonic_ of
       Nothing -> (,Just 0) <$> (asks random >>= atomically . newSeedEntropy)
       Just phrase -> (,Nothing) <$> liftWallet (entropyFromMnemonic $ encodeUtf8 phrase)
     created <- withFastStore' $ \db -> createWalletSeed db entropy nextAccount
     unless created $ throwWalletError WEMasterExists
     pure $ CRWallet user (Just [])
-  APIBindWalletAccount accountIdx_ -> withUser $ \user@User {userId, viewPwdHash} -> do
+  APIBindWalletAccount userId accountIdx_ -> withUserId userId $ \user@User {viewPwdHash} -> do
     when (isJust viewPwdHash) $ throwWalletError WEHiddenProfile
-    CRWallet user . Just <$> (liftWallet =<< withFastStore' (\db -> bindAccount db userId accountIdx_))
+    (seed, n) <- withWalletStore $ \db -> bindAccount db userId accountIdx_
+    CRWalletAddress user . snd <$> seedAccount seed n
   APIGetWalletAddress accountIdx_ -> withUser $ \user -> do
-    (seed, n) <- liftWallet =<< withFastStore' (`resolveAccount` accountIdx_)
-    CRWalletAddress user <$> (accountAddress n =<< accountKey seed n)
-  APIExportWalletMnemonic -> withUser $ \user ->
-    CRWalletMnemonic user <$> (liftWallet . seedMnemonic . wsEntropy =<< walletSeed)
-  APIExportWalletAccount n -> withUser $ \user@User {userId} -> do
-    (seed, _) <- liftWallet =<< withFastStore' (`resolveAccount` Just n)
-    -- a key another profile holds is not this profile's to hand out
-    heldByOther <- withFastStore' $ \db -> accountHeldByOther db (wsId seed) userId n
-    when heldByOther $ throwWalletError WEAccountBound
-    k <- accountKey seed n
-    a <- accountAddress n k
+    (seed, n) <- withWalletStore (`resolveAccount` accountIdx_)
+    CRWalletAddress user . snd <$> seedAccount seed n
+  APIExportWalletMnemonic -> withUser $ \user -> do
+    WalletSeed {wsEntropy} <- withFastStore' getWalletSeed >>= maybe (throwWalletError WENoMaster) pure
+    CRWalletMnemonic user <$> liftWallet (seedMnemonic wsEntropy)
+  APIExportWalletAccount userId n -> withUserId userId $ \user -> do
+    (seed@WalletSeed {wsId}, _) <- withWalletStore (`resolveAccount` Just n)
+    held <- withFastStore' $ \db -> accountHeldBy db wsId userId n
+    unless held $ throwWalletError WEAccountNotHeld
+    (k, a) <- seedAccount seed n
     pure $ CRWalletAccountSecret user a (accountSecret k)
   APIDeleteWallet -> withUser $ \_ -> do
     deleted <- withFastStore' deleteWalletSeed
@@ -6026,24 +6025,17 @@ withExpirationDate globalTTL chatItemTTL action = do
   let ttl = fromMaybe globalTTL chatItemTTL
   when (ttl > 0) $ action $ addUTCTime (-1 * fromIntegral ttl) currentTs
 
-walletSeed :: CM WalletSeed
-walletSeed = withFastStore' getWalletSeed >>= maybe (throwWalletError WENoMaster) pure
-
 throwWalletError :: WalletError -> CM a
 throwWalletError = throwChatError . CEWallet
 
 liftWallet :: Either WalletError a -> CM a
 liftWallet = either throwWalletError pure
 
-accountKey :: WalletSeed -> AccountIndex -> CM AccountKey
-accountKey seed n = do
-  master <- liftWallet =<< liftIO (seedMaster $ wsEntropy seed)
-  liftWallet =<< liftIO (deriveAccountKey master n)
+withWalletStore :: (DB.Connection -> IO (Either WalletError a)) -> CM a
+withWalletStore action = liftWallet =<< withFastStore' action
 
-accountAddress :: AccountIndex -> AccountKey -> CM WalletAddress
-accountAddress n k = do
-  a <- liftIO $ addressFromPrivateKey k
-  pure WalletAddress {accountIndex = n, keyPath = renderAccountPath n, address = decodeLatin1 $ strEncode a}
+seedAccount :: WalletSeed -> AccountIndex -> CM (AccountKey, WalletAddress)
+seedAccount WalletSeed {wsEntropy} n = liftWallet =<< liftIO (deriveAccount wsEntropy n)
 
 chatCommandP :: Parser ChatCommand
 chatCommandP =
@@ -6169,14 +6161,12 @@ chatCommandP =
       "/_service_response " *> (APISendServiceResponse <$> A.decimal <* A.space <*> strP <* A.space <*> jsonP),
       "/_wallet create new" $> APICreateWallet Nothing,
       "/_wallet create mnemonic=" *> (APICreateWallet . Just <$> textP),
-      "/_wallet bind account=" *> (APIBindWalletAccount . Just <$> accountIndexP),
-      "/_wallet bind" $> APIBindWalletAccount Nothing,
-      "/_wallet address account=" *> (APIGetWalletAddress . Just <$> accountIndexP),
-      "/_wallet address" $> APIGetWalletAddress Nothing,
+      "/_wallet bind " *> (APIBindWalletAccount <$> A.decimal <*> optional (" account=" *> accountIndexP)),
+      "/_wallet address" *> (APIGetWalletAddress <$> optional (" account=" *> accountIndexP)),
       "/_wallet export master" $> APIExportWalletMnemonic,
-      "/_wallet export account " *> (APIExportWalletAccount <$> accountIndexP),
+      "/_wallet export account " *> (APIExportWalletAccount <$> A.decimal <* A.space <*> accountIndexP),
       "/_wallet delete" $> APIDeleteWallet,
-      "/_wallet" $> APIGetWallet,
+      "/_wallet " *> (APIGetWallet <$> A.decimal),
       "/_call invite @" *> (APISendCallInvitation <$> A.decimal <* A.space <*> jsonP),
       "/call " *> char_ '@' *> (SendCallInvitation <$> displayNameP <*> pure defaultCallType),
       "/_call reject @" *> (APIRejectCall <$> A.decimal),
@@ -6720,12 +6710,9 @@ chatCommandP =
     quotedP = safeDecodeUtf8 <$> (A.char '"' *> A.takeTill (== '"') <* A.char '"')
     text1P = safeDecodeUtf8 <$> A.takeTill (== ' ')
     char_ = optional . A.char
-    -- a long digit run is not free to convert; the hardening bound is checked when the command runs
     accountIndexP = do
-      ds <- A.takeWhile1 isDigit
-      case if B.length ds <= 10 then B.readInteger ds else Nothing of
-        Just (i, _) | i <= toInteger (maxBound :: AccountIndex) -> pure (fromInteger i)
-        _ -> fail "account index too large"
+      i <- A.decimal
+      if i <= toInteger (maxBound :: AccountIndex) then pure (fromInteger i) else fail "account index too large"
 
 displayNameP :: Parser Text
 displayNameP = safeDecodeUtf8 <$> displayNameP_

src/Simplex/Chat/Store/Postgres/Migrations/M20260924_wallet_seeds.hs

@@ -9,7 +9,6 @@ import Text.RawString.QQ (r)
 m20260924_wallet_seeds :: Text
 m20260924_wallet_seeds =
   [r|
--- the columns are commented in the SQLite migration
 CREATE TABLE wallet_seeds (
   wallet_seed_id BIGINT GENERATED ALWAYS AS IDENTITY PRIMARY KEY,
   entropy BYTEA NOT NULL CHECK (length(entropy) = 32),

src/Simplex/Chat/Store/SQLite/Migrations/M20260924_wallet_seeds.hs

@@ -10,7 +10,7 @@ m20260924_wallet_seeds =
   [sql|
 CREATE TABLE wallet_seeds (
   wallet_seed_id INTEGER PRIMARY KEY AUTOINCREMENT,
-  entropy BLOB NOT NULL CHECK (length(entropy) = 32), -- BIP-39 entropy, 24 words
+  entropy BLOB NOT NULL CHECK (length(entropy) = 32),
   next_account_index INTEGER CHECK (next_account_index BETWEEN 0 AND 2147483648),
   single_seed INTEGER NOT NULL DEFAULT 1
 ) STRICT;

src/Simplex/Chat/Store/SQLite/Migrations/chat_query_plans.txt

@@ -2048,6 +2048,14 @@ Query:
       
 Plan:
 
+Query: 
+        INSERT INTO wallet_seeds (entropy, next_account_index) VALUES (?, ?)
+        ON CONFLICT (single_seed) DO NOTHING
+        RETURNING wallet_seed_id
+      
+Plan:
+SEARCH wallet_accounts USING COVERING INDEX idx_wallet_accounts_wallet_seed_id_account_index (wallet_seed_id=?)
+
 Query: 
         SELECT
           (SELECT prev.balance_start_ts FROM badge_ledger prev
@@ -3502,6 +3510,14 @@ SCAN CONSTANT ROW
 SCALAR SUBQUERY 1
 SEARCH groups USING INDEX idx_groups_relay_request_group_link (user_id=? AND relay_request_group_link=?)
 
+Query: 
+        SELECT account_index FROM wallet_accounts
+        WHERE wallet_seed_id = ? AND user_id = ? AND account_index IS NOT NULL
+        ORDER BY account_index
+      
+Plan:
+SEARCH wallet_accounts USING INDEX idx_wallet_accounts_wallet_seed_id_account_index (wallet_seed_id=? AND account_index>?)
+
 Query: 
         SELECT agent_conn_id
         FROM connections
@@ -5707,6 +5723,20 @@ Query:
 Plan:
 SEARCH users USING INTEGER PRIMARY KEY (rowid=?)
 
+Query: 
+      UPDATE wallet_accounts SET user_id = ?
+      WHERE wallet_seed_id = ? AND account_index = ? AND user_id IS NULL
+    
+Plan:
+SEARCH wallet_accounts USING INDEX idx_wallet_accounts_wallet_seed_id_account_index (wallet_seed_id=? AND account_index=?)
+
+Query: 
+      UPDATE wallet_seeds SET next_account_index = ?
+      WHERE wallet_seed_id = ? AND next_account_index IS NOT NULL AND next_account_index <= ?
+    
+Plan:
+SEARCH wallet_seeds USING INTEGER PRIMARY KEY (rowid=?)
+
 Query: 
       UPDATE xftp_file_descriptions
       SET file_descr_text = ?, file_descr_part_no = ?, file_descr_complete = ?, updated_at = ?
@@ -7109,6 +7139,7 @@ SEARCH connections USING COVERING INDEX idx_connections_user_contact_link_id (us
 Query: DELETE FROM users WHERE user_id = ?
 Plan:
 SEARCH users USING INTEGER PRIMARY KEY (rowid=?)
+SEARCH wallet_accounts USING COVERING INDEX idx_wallet_accounts_user_id (user_id=?)
 SEARCH badge_code_redemptions USING COVERING INDEX idx_badge_code_redemptions_user (user_id=?)
 SEARCH badge_purchases USING COVERING INDEX idx_badge_purchases_user (user_id=?)
 SEARCH chat_relays USING COVERING INDEX idx_chat_relays_user_id (user_id=?)
@@ -7136,6 +7167,11 @@ SEARCH contacts USING COVERING INDEX sqlite_autoindex_contacts_2 (user_id=?)
 SEARCH display_names USING COVERING INDEX sqlite_autoindex_display_names_2 (user_id=?)
 SEARCH contact_profiles USING COVERING INDEX idx_contact_profiles_user_id (user_id=?)
 
+Query: DELETE FROM wallet_seeds RETURNING wallet_seed_id
+Plan:
+SCAN wallet_seeds
+SEARCH wallet_accounts USING COVERING INDEX idx_wallet_accounts_wallet_seed_id_account_index (wallet_seed_id=?)
+
 Query: DROP TABLE IF EXISTS temp_delete_members
 Plan:
 
@@ -7259,6 +7295,9 @@ Plan:
 Query: INSERT INTO users (agent_user_id, local_display_name, active_user, is_user_chat_relay, active_order, contact_id, show_ntfs, send_rcpts_contacts, send_rcpts_small_groups, auto_accept_member_contacts, auto_accept_group_invitations, client_service, created_at, updated_at) VALUES (?,?,?,?,?,0,?,?,?,?,?,?,?,?)
 Plan:
 
+Query: INSERT INTO wallet_accounts (wallet_seed_id, account_index, user_id) VALUES (?, ?, ?)
+Plan:
+
 Query: INSERT INTO xftp_file_descriptions (user_id, file_descr_text, file_descr_part_no, file_descr_complete, created_at, updated_at) VALUES (?,?,?,?,?,?)
 Plan:
 
@@ -7768,6 +7807,10 @@ Query: SELECT user_id FROM users WHERE local_display_name = ?
 Plan:
 SEARCH users USING COVERING INDEX sqlite_autoindex_users_2 (local_display_name=?)
 
+Query: SELECT user_id FROM wallet_accounts WHERE wallet_seed_id = ? AND account_index = ?
+Plan:
+SEARCH wallet_accounts USING INDEX idx_wallet_accounts_wallet_seed_id_account_index (wallet_seed_id=? AND account_index=?)
+
 Query: SELECT via_contact_uri FROM connections WHERE connection_id = ?
 Plan:
 SEARCH connections USING INTEGER PRIMARY KEY (rowid=?)
@@ -7776,6 +7819,10 @@ Query: SELECT via_contact_uri, via_contact_uri_hash FROM connections WHERE conne
 Plan:
 SEARCH connections USING INTEGER PRIMARY KEY (rowid=?)
 
+Query: SELECT wallet_seed_id, entropy, next_account_index FROM wallet_seeds ORDER BY wallet_seed_id LIMIT 1
+Plan:
+SCAN wallet_seeds
+
 Query: SELECT xgrplinkmem_received FROM group_members WHERE group_member_id = ?
 Plan:
 SEARCH group_members USING INTEGER PRIMARY KEY (rowid=?)

src/Simplex/Chat/Store/SQLite/Migrations/chat_schema.sql

@@ -983,7 +983,7 @@ CREATE TABLE badge_code_redemptions(
 ) STRICT;
 CREATE TABLE wallet_seeds(
   wallet_seed_id INTEGER PRIMARY KEY AUTOINCREMENT,
-  entropy BLOB NOT NULL CHECK(length(entropy) = 32), -- BIP-39 entropy, 24 words
+  entropy BLOB NOT NULL CHECK(length(entropy) = 32),
   next_account_index INTEGER CHECK(next_account_index BETWEEN 0 AND 2147483648),
   single_seed INTEGER NOT NULL DEFAULT 1
 ) STRICT;

src/Simplex/Chat/Store/Wallets.hs

@@ -5,7 +5,6 @@
 {-# LANGUAGE QuasiQuotes #-}
 {-# LANGUAGE TypeApplications #-}
 
--- | The device seed, and which chat profile each account belongs to.
 module Simplex.Chat.Store.Wallets
   ( SeedId,
     WalletSeed (..),
@@ -14,12 +13,13 @@ module Simplex.Chat.Store.Wallets
     deleteWalletSeed,
     resolveAccount,
     getUserAccounts,
-    accountHeldByOther,
+    accountHeldBy,
     bindAccount,
   )
 where
 
-import Control.Monad (join, unless)
+import Control.Applicative ((<|>))
+import Control.Monad (unless)
 import Control.Monad.Except
 import Control.Monad.IO.Class (liftIO)
 import qualified Data.ByteArray as BA
@@ -41,25 +41,23 @@ import Database.SQLite.Simple.QQ (sql)
 
 type SeedId = Int64
 
--- | The device seed row. The entropy is 'BA.ScrubbedBytes', so a derived 'Show' does not print it.
 data WalletSeed = WalletSeed
   { wsId :: SeedId,
-    wsEntropy :: BA.ScrubbedBytes
+    wsEntropy :: BA.ScrubbedBytes,
+    wsNextAccount :: Maybe AccountIndex
   }
-  deriving (Show)
 
-toSeed :: (Int64, ByteString) -> WalletSeed
-toSeed (sId, entropy) = WalletSeed {wsId = sId, wsEntropy = BA.convert entropy}
+toSeed :: (SeedId, ByteString, Maybe AccountIndex) -> WalletSeed
+toSeed (wsId, entropy, wsNextAccount) = WalletSeed {wsId, wsEntropy = BA.convert entropy, wsNextAccount}
 
 getWalletSeed :: DB.Connection -> IO (Maybe WalletSeed)
 getWalletSeed db =
   maybeFirstRow toSeed $
-    DB.query_ db "SELECT wallet_seed_id, entropy FROM wallet_seeds ORDER BY wallet_seed_id LIMIT 1"
+    DB.query_ db "SELECT wallet_seed_id, entropy, next_account_index FROM wallet_seeds ORDER BY wallet_seed_id LIMIT 1"
 
--- | False if the device already has a seed. The counter is 'Nothing' for an imported phrase.
 createWalletSeed :: DB.Connection -> BA.ScrubbedBytes -> Maybe AccountIndex -> IO Bool
 createWalletSeed db entropy nextAccount =
-  fmap isJust . maybeFirstRow (fromOnly @Int64) $
+  fmap isJust . maybeFirstRow (fromOnly @SeedId) $
     DB.query
       db
       [sql|
@@ -67,36 +65,23 @@ createWalletSeed db entropy nextAccount =
         ON CONFLICT (single_seed) DO NOTHING
         RETURNING wallet_seed_id
       |]
-      (DB.Binary (BA.convert entropy :: ByteString), accountIndexCol <$> nextAccount)
+      (DB.Binary (BA.convert entropy :: ByteString), nextAccount)
 
--- | False if the device had no seed to delete. The account rows go with it.
 deleteWalletSeed :: DB.Connection -> IO Bool
 deleteWalletSeed db =
-  getWalletSeed db >>= \case
-    Nothing -> pure False
-    Just WalletSeed {wsId} ->
-      True <$ DB.execute db "DELETE FROM wallet_seeds WHERE wallet_seed_id = ?" (Only wsId)
+  fmap isJust . maybeFirstRow (fromOnly @SeedId) $
+    DB.query_ db "DELETE FROM wallet_seeds RETURNING wallet_seed_id"
 
--- | The seed, and the account named or the next free one from the counter. Refuses an index BIP-32 cannot harden.
 resolveAccount :: DB.Connection -> Maybe AccountIndex -> IO (Either WalletError (WalletSeed, AccountIndex))
 resolveAccount db accountIdx_ = runExceptT $ do
-  seed <- ExceptT $ maybe (Left WENoMaster) Right <$> getWalletSeed db
-  n <- maybe (nextFreeAccount $ wsId seed) pure accountIdx_
+  seed@WalletSeed {wsNextAccount} <- ExceptT $ maybe (Left WENoMaster) Right <$> getWalletSeed db
+  n <- liftEither $ maybe (Left WECounterUnknown) Right (accountIdx_ <|> wsNextAccount)
   liftEither $ checkAccountIndex n
   pure (seed, n)
-  where
-    nextFreeAccount sId = ExceptT $ maybe (Left WECounterUnknown) Right <$> getNextAccountIndex db sId
 
--- | The index the next account takes. Nothing after an import.
-getNextAccountIndex :: DB.Connection -> SeedId -> IO (Maybe AccountIndex)
-getNextAccountIndex db sId =
-  fmap (fromIntegral @Int64) . join
-    <$> maybeFirstRow fromOnly (DB.query db "SELECT next_account_index FROM wallet_seeds WHERE wallet_seed_id = ?" (Only sId))
-
--- | The accounts a profile holds, in index order.
 getUserAccounts :: DB.Connection -> SeedId -> UserId -> IO [AccountIndex]
 getUserAccounts db sId userId =
-  map (fromIntegral @Int64 . fromOnly)
+  map fromOnly
     <$> DB.query
       db
       [sql|
@@ -107,31 +92,22 @@ getUserAccounts db sId userId =
       (sId, userId)
 
 -- | Which profile holds an account: 'Nothing' when it is unknown, @Just Nothing@ when no profile holds it.
-accountUser :: DB.Connection -> SeedId -> AccountIndex -> IO (Maybe (Maybe Int64))
+accountUser :: DB.Connection -> SeedId -> AccountIndex -> IO (Maybe (Maybe UserId))
 accountUser db sId n =
-  maybeFirstRow (fromOnly @(Maybe Int64)) $
-    DB.query db "SELECT user_id FROM wallet_accounts WHERE wallet_seed_id = ? AND account_index = ?" (sId, accountIndexCol n)
+  maybeFirstRow fromOnly $
+    DB.query db "SELECT user_id FROM wallet_accounts WHERE wallet_seed_id = ? AND account_index = ?" (sId, n)
 
--- | True when another profile holds the account. A guard, not a boundary: @export master@ reaches every account.
-heldByOther :: UserId -> Maybe (Maybe Int64) -> Bool
-heldByOther userId = \case
-  Just (Just heldBy) -> heldBy /= userId
-  _ -> False
-
-accountHeldByOther :: DB.Connection -> SeedId -> UserId -> AccountIndex -> IO Bool
-accountHeldByOther db sId userId n = heldByOther userId <$> accountUser db sId n
-
--- | Bind an account to a profile, the next free one when no index is given, and return the profile's accounts. One transaction, so none is taken twice.
-bindAccount :: DB.Connection -> UserId -> Maybe AccountIndex -> IO (Either WalletError [AccountIndex])
+bindAccount :: DB.Connection -> UserId -> Maybe AccountIndex -> IO (Either WalletError (WalletSeed, AccountIndex))
 bindAccount db userId accountIdx_ = runExceptT $ do
-  (WalletSeed {wsId = sId}, n) <- ExceptT $ resolveAccount db accountIdx_
-  taken <- liftIO $ accountUser db sId n >>= \case
+  r@(WalletSeed {wsId}, n) <- ExceptT $ resolveAccount db accountIdx_
+  taken <- liftIO $ accountUser db wsId n >>= \case
     Just (Just heldBy) -> pure $ heldBy == userId
-    -- the update takes the account only while no profile holds it, the read after says whether this one got it
-    Just Nothing -> setAccountUser db sId userId n >> accountHeldBy db sId userId n
-    Nothing -> True <$ insertAccount db sId userId n
+    -- the update sets user_id only while it is NULL, so the read after it shows which profile holds the account
+    Just Nothing -> setAccountUser db wsId userId n >> accountHeldBy db wsId userId n
+    Nothing -> True <$ insertAccount db wsId userId n
   unless taken $ throwError WEAccountBound
-  liftIO $ raiseNextAccount db sId n >> getUserAccounts db sId userId
+  liftIO $ raiseNextAccount db wsId n
+  pure r
 
 setAccountUser :: DB.Connection -> SeedId -> UserId -> AccountIndex -> IO ()
 setAccountUser db sId userId n =
@@ -141,12 +117,11 @@ setAccountUser db sId userId n =
       UPDATE wallet_accounts SET user_id = ?
       WHERE wallet_seed_id = ? AND account_index = ? AND user_id IS NULL
     |]
-    (userId, sId, accountIndexCol n)
+    (userId, sId, n)
 
 accountHeldBy :: DB.Connection -> SeedId -> UserId -> AccountIndex -> IO Bool
 accountHeldBy db sId userId n = (== Just (Just userId)) <$> accountUser db sId n
 
--- | Keep the counter a high-water mark. Never lowers it, never gives one to an imported phrase that has none.
 raiseNextAccount :: DB.Connection -> SeedId -> AccountIndex -> IO ()
 raiseNextAccount db sId n =
   DB.execute
@@ -155,11 +130,8 @@ raiseNextAccount db sId n =
       UPDATE wallet_seeds SET next_account_index = ?
       WHERE wallet_seed_id = ? AND next_account_index IS NOT NULL AND next_account_index <= ?
     |]
-    (accountIndexCol n + 1, sId, accountIndexCol n)
+    (n + 1, sId, n)
 
 insertAccount :: DB.Connection -> SeedId -> UserId -> AccountIndex -> IO ()
 insertAccount db sId userId n =
-  DB.execute db "INSERT INTO wallet_accounts (wallet_seed_id, account_index, user_id) VALUES (?, ?, ?)" (sId, accountIndexCol n, userId)
-
-accountIndexCol :: AccountIndex -> Int64
-accountIndexCol = fromIntegral
+  DB.execute db "INSERT INTO wallet_accounts (wallet_seed_id, account_index, user_id) VALUES (?, ?, ?)" (sId, n, userId)

src/Simplex/Chat/View.hs

@@ -1121,7 +1121,8 @@ walletErrorText = \case
   WEBadMnemonic -> "not a valid 24 word recovery phrase"
   WEHiddenProfile -> "a hidden profile cannot own an account"
   WEAccountBound -> "another profile holds this account"
-  WECounterUnknown -> "unknown how many accounts this phrase has used, a scan of the chain has to run first"
+  WEAccountNotHeld -> "this profile does not hold this account"
+  WECounterUnknown -> "the next account is unknown after an import, scan the chain first"
   WEIndexTooLarge -> "account index is too large to harden"
   WEDerivation e -> "derivation failed: " <> T.pack e
 

src/Simplex/Chat/Wallet.hs

@@ -1,7 +1,6 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE TemplateHaskell #-}
 
--- | The device wallet: one BIP-39 seed, and the hardened BIP-44 accounts @m\/44'\/60'\/n'\/0\/0@ under it.
 module Simplex.Chat.Wallet
   ( AccountIndex,
     AccountKey,
@@ -10,9 +9,7 @@ module Simplex.Chat.Wallet
     newSeedEntropy,
     entropyFromMnemonic,
     seedMnemonic,
-    seedMaster,
-    renderAccountPath,
-    deriveAccountKey,
+    deriveAccount,
     accountSecret,
     checkAccountIndex,
   )
@@ -20,8 +17,10 @@ where
 
 import Control.Concurrent.STM
 import Control.Monad.Except
+import Control.Monad.IO.Class (liftIO)
 import Crypto.Random (ChaChaDRG)
 import qualified Data.Aeson.TH as JQ
+import Data.Bifunctor (bimap, first)
 import qualified Data.ByteArray as BA
 import qualified Data.ByteArray.Encoding as BAE
 import Data.ByteString (ByteString)
@@ -31,15 +30,14 @@ import Data.Word (Word32)
 import qualified Simplex.Messaging.Crypto.BIP32 as B32
 import qualified Simplex.Messaging.Crypto.BIP39 as B39
 import qualified Simplex.Messaging.Crypto.Secp256k1 as S
-import Simplex.Messaging.Eth.Address (ethereumPath)
+import Simplex.Messaging.Encoding.String (strEncode)
+import Simplex.Messaging.Eth.Address (addressFromPrivateKey, ethereumPath)
 import Simplex.Messaging.Parsers (defaultJSON, dropPrefix, sumTypeJSON)
 
--- | BIP-44 account index, one per thing the device owns on chain.
 type AccountIndex = Word32
 
 type AccountKey = S.Secp256k1PrivateKey
 
--- | One derived address, with the index it came from.
 data WalletAddress = WalletAddress
   { accountIndex :: AccountIndex,
     keyPath :: Text,
@@ -48,64 +46,50 @@ data WalletAddress = WalletAddress
   deriving (Show)
 
 data WalletError
-  = WENoMaster -- the device has no master entropy
-  | WEMasterExists -- create, when it already has one
-  | WEBadMnemonic -- wrong word count, wrong word, or bad checksum
-  | WEHiddenProfile -- bind, on a profile the app hides
-  | WEAccountBound -- bind or export account, on an account another profile holds
-  | WECounterUnknown -- no counter to read yet, after an import
-  | WEIndexTooLarge -- at or above 2^31
-  | WEDerivation {derivationError :: String} -- BIP-32 or BIP-39 said no
+  = WENoMaster
+  | WEMasterExists
+  | WEBadMnemonic
+  | WEHiddenProfile
+  | WEAccountBound
+  | WEAccountNotHeld
+  | WECounterUnknown
+  | WEIndexTooLarge
+  | WEDerivation {derivationError :: String}
   deriving (Eq, Show)
 
--- | Refuse an index at or above 2^31: BIP-32 would harden it onto another index's key.
 checkAccountIndex :: AccountIndex -> Either WalletError ()
-checkAccountIndex n = if n >= B32.hardenedOffset then Left WEIndexTooLarge else Right ()
+checkAccountIndex n = () <$ accountPath n
+
+accountPath :: AccountIndex -> Either WalletError [Word32]
+accountPath n = maybe (Left WEIndexTooLarge) Right $ ethereumPath n 0
 
--- | 24 words. No 25th-word passphrase, which would be a second secret to back up.
 masterStrength :: B39.MnemonicStrength
 masterStrength = B39.MS256
 
 newSeedEntropy :: TVar ChaChaDRG -> STM BA.ScrubbedBytes
-newSeedEntropy g = BA.convert . B39.mnemonicToEntropy <$> B39.randomMnemonic masterStrength g
+newSeedEntropy g = B39.mnemonicToEntropy <$> B39.randomMnemonic masterStrength g
 
 entropyFromMnemonic :: ByteString -> Either WalletError BA.ScrubbedBytes
 entropyFromMnemonic phrase = case B39.parseMnemonic phrase of
   Right m | length (B39.mnemonicWords m) == B39.strengthWordCount masterStrength ->
-    Right . BA.convert $ B39.mnemonicToEntropy m
+    Right $ B39.mnemonicToEntropy m
   _ -> Left WEBadMnemonic
 
 seedMnemonic :: BA.ScrubbedBytes -> Either WalletError Text
-seedMnemonic entropy =
-  bipError . fmap (decodeLatin1 . B39.mnemonicPhrase) . B39.entropyToMnemonic $ entropyBytes entropy
+seedMnemonic = bimap WEDerivation (decodeLatin1 . B39.mnemonicPhrase) . B39.entropyToMnemonic
 
--- | Deriving this runs PBKDF2, so it is done once per command.
-seedMaster :: BA.ScrubbedBytes -> IO (Either WalletError B32.ExtendedKey)
-seedMaster entropy = runExceptT $ do
-  m <- liftEither . bipError . B39.entropyToMnemonic $ entropyBytes entropy
-  ExceptT $ bipError <$> B32.masterKey (B39.mnemonicToSeed m "")
+deriveAccount :: BA.ScrubbedBytes -> AccountIndex -> IO (Either WalletError (AccountKey, WalletAddress))
+deriveAccount entropy n = runExceptT $ do
+  path <- liftEither $ accountPath n
+  m <- liftEither . first WEDerivation $ B39.entropyToMnemonic entropy
+  master <- ExceptT $ first WEDerivation <$> B32.masterKey (B39.mnemonicToSeed m "")
+  k <- ExceptT $ fmap B32.xkKey . first WEDerivation <$> B32.derivePath master path
+  a <- liftIO $ addressFromPrivateKey k
+  pure (k, WalletAddress {accountIndex = n, keyPath = decodeLatin1 $ B32.renderPath path, address = decodeLatin1 $ strEncode a})
 
-accountPath :: AccountIndex -> [Word32]
-accountPath n = ethereumPath n 0
-
-renderAccountPath :: AccountIndex -> Text
-renderAccountPath = decodeLatin1 . B32.renderPath . accountPath
-
-deriveAccountKey :: B32.ExtendedKey -> AccountIndex -> IO (Either WalletError AccountKey)
-deriveAccountKey master n = fmap B32.xkKey . bipError <$> B32.derivePath master (accountPath n)
-
--- | As wallets take it when a key is imported on its own.
 accountSecret :: AccountKey -> Text
 accountSecret k = "0x" <> decodeLatin1 (BAE.convertToBase BAE.Base16 $ S.unPrivateKey k)
 
--- | The copy BIP-39 takes is a plain 'ByteString' and is not wiped.
-entropyBytes :: BA.ScrubbedBytes -> ByteString
-entropyBytes = BA.convert
-
--- | BIP-32 and BIP-39 report failure as a string, and nothing here retries, so one constructor covers them.
-bipError :: Either String a -> Either WalletError a
-bipError = either (Left . WEDerivation) Right
-
 $(JQ.deriveJSON defaultJSON ''WalletAddress)
 
 $(JQ.deriveJSON (sumTypeJSON $ dropPrefix "WE") ''WalletError)