cut comments

2026-10-01 19:28:49 +00:00 · 2026-09-21 17:39:38 +02:00
parent 1c5ed7275d
commit faa96e3da7
6 changed files with 23 additions and 71 deletions
@@ -1503,8 +1503,7 @@ processChatCommand cxt nm = \case
  APIGetWallet -> withUser $ \user@User {userId} ->
    CRWallet user <$> withFastStore' (\db -> getWalletSeed db $>>= \WalletSeed {wsId} -> Just <$> getUserAccounts db wsId userId)
  APICreateWallet mnemonic_ -> withUser $ \_ -> do
-    -- a generated seed has taken no accounts; an imported one does not say how
-    -- many it has taken, and only a scan of the chain can tell
+    -- a generated seed has taken no accounts, an imported one does not say how many it has taken
    (entropy, nextAccount) <- case mnemonic_ of
      Nothing -> (,Just 0) <$> (asks random >>= atomically . newSeedEntropy)
      Just phrase -> (,Nothing) <$> liftWallet (entropyFromMnemonic $ encodeUtf8 phrase)
@@ -6644,10 +6643,7 @@ chatCommandP =
    quotedP = safeDecodeUtf8 <$> (A.char '"' *> A.takeTill (== '"') <* A.char '"')
    text1P = safeDecodeUtf8 <$> A.takeTill (== ' ')
    char_ = optional . A.char
-    -- The digits are counted before they are read, as reading a very long
-    -- number is not free. Ten of them fit an Int with room to spare, and the
-    -- hardening bound is a typed error when the command runs, so that a caller
-    -- is told which index was refused and why.
+    -- ten digits fit an Int, and the hardening bound is a typed error when the command runs
    accountIndexP = do
      ds <- A.takeWhile1 isDigit
      case if B.length ds <= 10 then B.readInt ds else Nothing of
@@ -552,8 +552,7 @@ liftRC = liftError (ChatErrorRemoteCtrl . RCEProtocolError)

 handleSend :: (ByteString -> Int -> CM' (Either ChatError ChatResponse)) -> Text -> Int -> CM' RemoteResponse
 handleSend execCC command retryNum = do
-  -- only the verb: the rest of the line can carry a mnemonic, and blanking it by
-  -- substring was guesswork
+  -- only the verb: the rest of the line can carry a mnemonic
  logDebug $ "Send: " <> T.takeWhile (/= ' ') command
  -- execCC is execChatCommand CSRemoteCtrl, which checks allowRemoteCommand
  -- convert errors thrown in execCC into error responses to prevent aborting the protocol wrapper
@@ -27,7 +27,4 @@ CREATE UNIQUE INDEX idx_wallet_accounts_wallet_seed_id_account_index ON wallet_a
 CREATE INDEX idx_wallet_accounts_user_id ON wallet_accounts(user_id);
 |]

-- There is no reverse step. Reversing this would drop the only copy of the
-- master entropy, and a downgrade that takes every key on the device with it is
-- worse than one that refuses: without a reverse step the older app reports that
-- the database is newer than it is and changes nothing.
+-- No reverse step: it would drop the only copy of the master entropy.
@@ -40,9 +40,7 @@ import Database.SQLite.Simple.QQ (sql)

 type SeedId = Int64

-- | The device seed, as a row: the id the account rows are counted against, and
-- the entropy every key is derived from. The entropy is 'BA.ScrubbedBytes', so
-- a derived 'Show' does not print it.
+-- | 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
@@ -57,8 +55,7 @@ getWalletSeed db =
  maybeFirstRow toSeed $
    DB.query_ db "SELECT wallet_seed_id, entropy 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, which does not say how many accounts it has been used for.
+-- | 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 =
  getWalletSeed db >>= \case
@@ -78,10 +75,7 @@ deleteWalletSeed db =
    Just WalletSeed {wsId} ->
      True <$ DB.execute db "DELETE FROM wallet_seeds WHERE wallet_seed_id = ?" (Only wsId)

-- | The seed, and the account an argument names or the next free one from the
-- counter when it names none. Refuses an index BIP-32 cannot harden, the
-- counter's included. The seed comes back with it so that a caller derives from
-- the one the index was resolved against.
+-- | 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
@@ -91,15 +85,13 @@ resolveAccount db accountIdx_ = runExceptT $ do
  where
    nextFreeAccount sId = ExceptT $ maybe (Left WECounterUnknown) Right <$> getNextAccountIndex db sId

-- | The index the next account takes. Nothing after an import, where the phrase
-- does not say how many accounts it has been used for.
+-- | 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. A profile holds as many as it
-- owns names.
+-- | The accounts a profile holds, in index order.
 getUserAccounts :: DB.Connection -> SeedId -> UserId -> IO [AccountIndex]
 getUserAccounts db sId userId =
  map (fromIntegral @Int64 . fromOnly)
@@ -112,17 +104,13 @@ getUserAccounts db sId userId =
      |]
      (sId, userId)

-- | Which profile holds an account: 'Nothing' when the device does not know the
-- account at all, @Just Nothing@ when it knows it and no profile holds it.
+-- | 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 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)

-- | True when a profile other than this one holds the account, which keeps one
-- profile from handing out another's account key. It is a guard, not a
-- boundary: @export master@ reaches every account from any profile. An account
-- no profile holds is not another profile's.
+-- | 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
@@ -131,10 +119,7 @@ heldByOther userId = \case
 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: one the device already knows about, one a
-- scan found, or the next free one when no index is given. The whole command is
-- one transaction, so nothing between reading the counter and taking the
-- account can hand the same one out twice.
+-- | Bind an account to a profile, the next free one when no index is given. One transaction, so none is taken twice.
 bindAccount :: DB.Connection -> UserId -> Maybe AccountIndex -> IO (Either WalletError ())
 bindAccount db userId accountIdx_ = runExceptT $ do
  (WalletSeed {wsId = sId}, n) <- ExceptT $ resolveAccount db accountIdx_
@@ -142,9 +127,7 @@ bindAccount db userId accountIdx_ = runExceptT $ do
  when (heldByOther userId held) $ throwError WEAccountBound
  taken <- liftIO $ case held of
    Just (Just _) -> pure True -- already this profile's
-    -- the update takes the account only while no profile holds it, and the read
-    -- after it says whether this one got it: where transactions are not
-    -- serialised, two of them can both read the account as free
+    -- 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
  unless taken $ throwError WEAccountBound
@@ -163,9 +146,7 @@ setAccountUser db sId userId 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, so an account taken by index is not
-- handed out again as the next free one. Never lowers it, and never gives a
-- value to the imported phrase that has none.
+-- | 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
@@ -180,6 +161,5 @@ 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)

-- | How an account index is stored: the column is a signed integer.
 accountIndexCol :: AccountIndex -> Int64
 accountIndexCol = fromIntegral
@@ -1,14 +1,7 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE TemplateHaskell #-}

-- | The device wallet: one BIP-39 seed, and the accounts derived from it.
--
-- An account is a hardened BIP-44 account, @m\/44'\/60'\/n'\/0\/0@, which is how
-- Ledger Live lays out an Ethereum wallet. The account level is hardened, so an
-- exported account key hands over that account and reaches no other.
--
-- Nothing here knows about chat profiles. Which profile an account belongs to is
-- a mapping in "Simplex.Chat.Store.Wallets".
+-- | 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,
@@ -40,15 +33,12 @@ import qualified Simplex.Messaging.Crypto.Secp256k1 as S
 import Simplex.Messaging.Eth.Address (ethereumPath)
 import Simplex.Messaging.Parsers (defaultJSON, dropPrefix, sumTypeJSON)

-- | BIP-44 account index. One account owns one thing on chain, one name to
-- begin with.
+-- | BIP-44 account index, one per thing the device owns on chain.
 type AccountIndex = Word32

-- | The key at an account index. It owns whatever that account owns.
 type AccountKey = S.Secp256k1PrivateKey

-- | One derived address, with the index it came from, so a caller that left the
-- index out knows what it got.
+-- | One derived address, with the index it came from.
 data WalletAddress = WalletAddress
  { accountIndex :: AccountIndex,
    keyPath :: Text,
@@ -67,14 +57,11 @@ data WalletError
  | WEDerivation {derivationError :: String} -- BIP-32 or BIP-39 said no
  deriving (Eq, Show)

-- | BIP-32 hardens an index by adding 2^31, so an index at or above it is
-- already a hardened component and derives the same key as the index it wraps
-- onto. Refusing it is what keeps one account index to one key.
+-- | 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 ()

-- | 24 words. No 25th-word passphrase: it would be a second secret to back up,
-- and losing it would look exactly like losing the phrase.
+-- | 24 words. No 25th-word passphrase, which would be a second secret to back up.
 masterStrength :: B39.MnemonicStrength
 masterStrength = B39.MS256

@@ -114,10 +101,7 @@ accountSecret k = "0x" <> decodeLatin1 (BAE.convertToBase BAE.Base16 $ S.unPriva
 entropyBytes :: BA.ScrubbedBytes -> ByteString
 entropyBytes = BA.convert

-- | The BIP-32 and BIP-39 functions report failure as a string. For entropy
-- this module produced only 'B32.masterKey' and 'B32.derivePath' can fail at
-- all, with a negligible probability, and nothing here retries, so the whole
-- family shares one constructor.
+-- | 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