From faa96e3da74c5368190b7d33f043e93ae066ad64 Mon Sep 17 00:00:00 2001 From: Alain Brenzikofer Date: Mon, 21 Sep 2026 17:39:38 +0200 Subject: [PATCH] cut comments --- src/Simplex/Chat/Library/Commands.hs | 8 +--- src/Simplex/Chat/Remote.hs | 3 +- .../Migrations/M20260921_wallet_seeds.hs | 5 +-- src/Simplex/Chat/Store/Wallets.hs | 40 +++++-------------- src/Simplex/Chat/Wallet.hs | 28 +++---------- tests/WalletTests.hs | 10 ++--- 6 files changed, 23 insertions(+), 71 deletions(-) diff --git a/src/Simplex/Chat/Library/Commands.hs b/src/Simplex/Chat/Library/Commands.hs index 11d03a5ff9..3deb592a8e 100644 --- a/src/Simplex/Chat/Library/Commands.hs +++ b/src/Simplex/Chat/Library/Commands.hs @@ -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 diff --git a/src/Simplex/Chat/Remote.hs b/src/Simplex/Chat/Remote.hs index de1b812b87..7be5cd1707 100644 --- a/src/Simplex/Chat/Remote.hs +++ b/src/Simplex/Chat/Remote.hs @@ -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 diff --git a/src/Simplex/Chat/Store/SQLite/Migrations/M20260921_wallet_seeds.hs b/src/Simplex/Chat/Store/SQLite/Migrations/M20260921_wallet_seeds.hs index 0f0054f334..014c01894b 100644 --- a/src/Simplex/Chat/Store/SQLite/Migrations/M20260921_wallet_seeds.hs +++ b/src/Simplex/Chat/Store/SQLite/Migrations/M20260921_wallet_seeds.hs @@ -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. diff --git a/src/Simplex/Chat/Store/Wallets.hs b/src/Simplex/Chat/Store/Wallets.hs index ef39533c26..b804cf9f5c 100644 --- a/src/Simplex/Chat/Store/Wallets.hs +++ b/src/Simplex/Chat/Store/Wallets.hs @@ -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 diff --git a/src/Simplex/Chat/Wallet.hs b/src/Simplex/Chat/Wallet.hs index f0e84884a3..2e7fef8a33 100644 --- a/src/Simplex/Chat/Wallet.hs +++ b/src/Simplex/Chat/Wallet.hs @@ -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 diff --git a/tests/WalletTests.hs b/tests/WalletTests.hs index 1e8426024a..4f609591af 100644 --- a/tests/WalletTests.hs +++ b/tests/WalletTests.hs @@ -22,14 +22,11 @@ import Simplex.Messaging.Util (safeDecodeUtf8) import Test.Hspec hiding (it) import qualified Test.Hspec as Hspec --- | The standard BIP-39 test vector, 12 words, so the addresses below can be --- checked against any other wallet. Importing takes 24 words, so this phrase is --- only used for derivation, never through a command. +-- | The standard BIP-39 test vector, 12 words, to check the addresses against another wallet. testPhrase12 :: ByteString testPhrase12 = B.unwords $ replicate 11 "abandon" <> ["about"] --- | The 24 word all-zero-entropy vector, the length the commands take. It is a --- different seed from the 12 word one, so it reaches different addresses. +-- | The 24 word all-zero-entropy vector, the length the commands take. testPhrase24 :: ByteString testPhrase24 = B.unwords $ replicate 23 "abandon" <> ["art"] @@ -217,8 +214,7 @@ testWalletExport ps = withNewTestChat ps "alice" aliceProfile $ \alice -> do (idx, path, address, secret) <- exportRow <$> getTermLine alice idx `shouldBe` "0" path `shouldBe` "m/44'/60'/0'/0/0" - -- m/44'/60'/0'/0/0 of the 24 word vector, pinned outside this implementation, - -- so a change of path fails here rather than shipping + -- m/44'/60'/0'/0/0 of the 24 word vector, pinned so a change of path fails here address `shouldBe` "0xF278cF59F82eDcf871d630F28EcC8056f25C1cdb" addressFromSecret secret `shouldBe` address -- the index reaches the key, not only the path printed beside it