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 <account>. /_wallet bind with no account takes the next
free one.

Co-Authored-By: Claude Opus 5 (1M context) <noreply@anthropic.com>
Claude-Session: https://claude.ai/code/session_01Rvc3HbiWBTqbAvRT45G5oX

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

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),

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

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"]