implement hidden derivation paths

docs/rfcs/2026-09-10-wallet-keys.md

@@ -37,7 +37,7 @@ key. `m/44'/60'/0'/0/0` is left unused so that neither names nor profiles claim
 the point where both dimensions start.
 
 A secret subtree is not in that tree and is not BIP-44. It has a master of its
-own, derived in one step from the seed and a slow hash of the secret (later):
+own, derived in one step from the seed and a slow hash of the secret:
 
 ```
 I              = HMAC-SHA512("simplex wallet subtree", kdf(secret, salt = seed))
@@ -45,10 +45,12 @@ subtree master = private key I[0..31], chain code I[32..63]
 key k          = child k of that master, k >= 1, counted in the subtree
 ```
 
-`kdf` is a deliberately slow hash of the secret, 32 bytes out, so that guessing
-the secret costs something. It is salted with the seed, which needs nothing
-stored and stops one dictionary serving every device, and which is also what
-binds the subtree to this seed rather than to the secret alone. The step is
+`kdf` is Argon2id, 3 passes over 64 MiB with one lane, 32 bytes out, so that
+guessing the secret costs something. Its parameters are pinned rather than taken
+from the library's defaults, which would move every key if they changed. It is
+salted with the seed, which needs nothing stored and stops one dictionary serving
+every device, and which is also what binds the subtree to this seed rather than
+to the secret alone. The step is
 SHA-512 because a master is a key and a chain code, 64 bytes, which is the same
 split BIP-32 makes from `HMAC-SHA512("Bitcoin seed", seed)`. It is a step rather
 than a path level because a level carries 31 bits, which is small enough to
@@ -169,8 +171,7 @@ not more than that. Whoever reads the database sees the binding regardless: the
 name is written into the profile's own row, and the link the name publishes is
 the one the device holds.
 
-Not implemented here. The parameter can be added at any time; the derivation has
-to be settled before the first such key is used.
+The listing side is not implemented, as there is nothing to list yet.
 
 ## Scope
 

src/Simplex/Chat/Controller.hs

@@ -417,10 +417,10 @@ 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}
-  | APIWallet
+  | APIWallet {walletSecret :: Maybe Text}
   | APIWalletCreate {recoveryPhrase :: Maybe Text}
   | APIWalletExportSeedMnemonic
-  | APIWalletExportNameSecret {nameIndex :: NameIndex}
+  | APIWalletExportNameSecret {nameIndex :: NameIndex, walletSecret :: Maybe Text}
   | APIWalletDelete
   | APISendCallInvitation ContactId CallType
   | SendCallInvitation ContactName CallType
@@ -747,7 +747,7 @@ allowRemoteCommand = \case
   DeleteRemoteCtrl _ -> False
   ExecChatStoreSQL _ -> False
   ExecAgentStoreSQL _ -> False
-  APIWallet -> False
+  APIWallet {} -> False
   APIWalletCreate {} -> False
   APIWalletExportSeedMnemonic -> False
   APIWalletExportNameSecret {} -> False

src/Simplex/Chat/Library/Commands.hs

@@ -59,7 +59,7 @@ 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 (createSeed, deleteSeed, getDeviceSeed, getNextNameIndex)
-import Simplex.Chat.Wallet (NameIndex, WalletSeed (..), deriveNameKey, importRecoveryKey, nameKeySecret, newSeed, recoveryKeyPhrase, renderNameKeyPath, seedMaster)
+import Simplex.Chat.Wallet (NameIndex, NameTree, WalletSeed (..), deriveNameKey, importRecoveryKey, nameKeySecret, nameTree, newSeed, recoveryKeyPhrase, renderNameKeyPath)
 import Simplex.Messaging.Eth.Address (addressFromPrivateKey)
 import Simplex.Chat.Call
 import Simplex.Chat.Controller
@@ -1492,27 +1492,31 @@ 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)
-  APIWallet -> withUser $ \user -> do
+  APIWallet secret_ -> withUser $ \user -> do
     withFastStore' getDeviceSeed >>= \case
       Nothing -> pure $ CRWallet user False []
       Just seed -> do
-        next <- withFastStore' $ \db -> getNextNameIndex db (wsId seed)
-        CRWallet user True <$> nameKeyRows seed next
+        -- a subtree keeps no counter, as keeping one would show that it is in use
+        next <- maybe (withFastStore' $ \db -> getNextNameIndex db (wsId seed)) (const $ pure 1) secret_
+        tree <- either throwCmdError pure $ nameTree seed secret_
+        CRWallet user True <$> nameKeyRows tree next
   APIWalletCreate phrase_ -> withUser $ \_ -> do
     entropy <- case phrase_ of
       Nothing -> asks random >>= atomically . newSeed MS256
       Just phrase -> either (const $ throwCmdError "bad recovery phrase") pure $ importRecoveryKey (encodeUtf8 phrase)
     created <- withFastStore' $ \db -> createSeed db entropy
     unless created $ throwCmdError "this device already has a wallet key"
-    processChatCommand cxt nm APIWallet
+    processChatCommand cxt nm $ APIWallet Nothing
   APIWalletExportSeedMnemonic -> withUser $ \user -> do
     seed <- deviceSeed
     phrase <- either throwCmdError pure $ recoveryKeyPhrase seed
     pure $ CRWalletSeedMnemonic user (safeDecodeUtf8 phrase)
-  APIWalletExportNameSecret nameIdx -> withUser $ \user -> do
+  APIWalletExportNameSecret nameIdx secret_ -> withUser $ \user -> do
     seed <- deviceSeed
-    k <- either throwCmdError pure $ seedMaster seed >>= \m -> deriveNameKey m nameIdx
-    pure $ CRWalletDerivedSecret user (renderNameKeyPath nameIdx) (decodeLatin1 . strEncode $ addressFromPrivateKey k) (safeDecodeUtf8 $ nameKeySecret k)
+    (tree, k) <- either throwCmdError pure $ do
+      tree <- nameTree seed secret_
+      (tree,) <$> deriveNameKey tree nameIdx
+    pure $ CRWalletDerivedSecret user (renderNameKeyPath tree nameIdx) (decodeLatin1 . strEncode $ addressFromPrivateKey k) (safeDecodeUtf8 $ nameKeySecret k)
   APIWalletDelete -> withUser $ \_ -> do
     seed <- deviceSeed
     withFastStore' $ \db -> deleteSeed db (wsId seed)
@@ -5459,11 +5463,10 @@ walletNamesShown = 2
 deviceSeed :: CM WalletSeed
 deviceSeed = withFastStore' getDeviceSeed >>= maybe (throwCmdError "no wallet key on this device") pure
 
-nameKeyRows :: WalletSeed -> NameIndex -> CM [(Text, Text)]
-nameKeyRows seed next = either throwCmdError pure $ do
-  master <- seedMaster seed
+nameKeyRows :: NameTree -> NameIndex -> CM [(Text, Text)]
+nameKeyRows tree next = either throwCmdError pure $
   forM (take walletNamesShown [next ..]) $ \nm ->
-    (renderNameKeyPath nm,) . decodeLatin1 . strEncode . addressFromPrivateKey <$> deriveNameKey master nm
+    (renderNameKeyPath tree nm,) . decodeLatin1 . strEncode . addressFromPrivateKey <$> deriveNameKey tree nm
 
 chatCommandP :: Parser ChatCommand
 chatCommandP =
@@ -5585,10 +5588,10 @@ chatCommandP =
       "/_service_response " *> (APISendServiceResponse <$> A.decimal <* A.space <*> strP <* A.space <*> jsonP),
       "/_wallet create new" $> APIWalletCreate Nothing,
       "/_wallet create mnemonic=" *> (APIWalletCreate . Just <$> textP),
-      "/_wallet export name " *> (APIWalletExportNameSecret <$> keyIndexP),
+      "/_wallet export name " *> (APIWalletExportNameSecret <$> keyIndexP <*> optional (" secret=" *> secretP)),
       "/_wallet export" $> APIWalletExportSeedMnemonic,
       "/_wallet delete" $> APIWalletDelete,
-      "/_wallet" $> APIWallet,
+      "/_wallet" *> (APIWallet <$> optional (" secret=" *> secretP)),
       "/_call invite @" *> (APISendCallInvitation <$> A.decimal <* A.space <*> jsonP),
       "/call " *> char_ '@' *> (SendCallInvitation <$> displayNameP <*> pure defaultCallType),
       "/_call reject @" *> (APIRejectCall <$> A.decimal),
@@ -6129,6 +6132,7 @@ chatCommandP =
     quotedP = safeDecodeUtf8 <$> (A.char '"' *> A.takeTill (== '"') <* A.char '"')
     text1P = safeDecodeUtf8 <$> A.takeTill (== ' ')
     char_ = optional . A.char
+    secretP = quotedP <|> safeDecodeUtf8 <$> A.takeByteString
     -- BIP-32 hardens at 2^31, and Word32 would wrap. Digits are counted before
     -- they are read, as reading a very long number is not free.
     keyIndexP = do

src/Simplex/Chat/Wallet.hs

@@ -1,4 +1,6 @@
+{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 
 -- | BIP-39 seeds and the keys derived from them.
 --
@@ -11,7 +13,8 @@ module Simplex.Chat.Wallet
     newSeed,
     importRecoveryKey,
     recoveryKeyPhrase,
-    seedMaster,
+    NameTree,
+    nameTree,
     deriveNameKey,
     renderNameKeyPath,
     nameKeySecret,
@@ -19,12 +22,19 @@ module Simplex.Chat.Wallet
 where
 
 import Control.Concurrent.STM
+import Crypto.Error (CryptoFailable (..))
+import qualified Crypto.Hash as H
+import qualified Crypto.KDF.Argon2 as Argon2
+import qualified Crypto.MAC.HMAC as HMAC
 import Crypto.Random (ChaChaDRG)
+import qualified Data.ByteArray as BA
 import qualified Data.ByteArray.Encoding as BAE
 import Data.ByteString (ByteString)
+import qualified Data.ByteString as B
 import Data.Int (Int64)
 import Data.Text (Text)
-import Data.Text.Encoding (decodeLatin1)
+import qualified Data.Text as T
+import Data.Text.Encoding (decodeLatin1, encodeUtf8)
 import Data.Word (Word32)
 import qualified Simplex.Messaging.Crypto.BIP32 as B32
 import qualified Simplex.Messaging.Crypto.BIP39 as B39
@@ -56,17 +66,47 @@ importRecoveryKey phrase = B39.mnemonicToEntropy <$> B39.parseMnemonic phrase
 recoveryKeyPhrase :: WalletSeed -> Either String ByteString
 recoveryKeyPhrase s = B39.mnemonicPhrase <$> B39.entropyToMnemonic (wsEntropy s)
 
--- | Deriving this runs PBKDF2, so it is done once per command.
-seedMaster :: WalletSeed -> Either String B32.ExtendedKey
-seedMaster s = do
-  m <- B39.entropyToMnemonic (wsEntropy s)
-  B32.masterKey (B39.mnemonicToSeed m "")
+-- | Where name keys hang. Deriving one runs a slow hash, so it is done once per
+-- command rather than once per key.
+data NameTree = NameTree {ntMaster :: B32.ExtendedKey, ntSecret :: Bool}
 
-renderNameKeyPath :: NameIndex -> Text
-renderNameKeyPath nm = decodeLatin1 . B32.renderPath $ ethereumPath 0 nm
+bip39Seed :: WalletSeed -> Either String ByteString
+bip39Seed s = (`B39.mnemonicToSeed` "") <$> B39.entropyToMnemonic (wsEntropy s)
 
-deriveNameKey :: B32.ExtendedKey -> NameIndex -> Either String S.PrivateKey
-deriveNameKey master nm = B32.xkKey <$> B32.derivePath master (ethereumPath 0 nm)
+-- | Without a secret, the seed's own tree. With one, a subtree that a scan of
+-- the seed does not reach, as its master comes from the secret.
+nameTree :: WalletSeed -> Maybe Text -> Either String NameTree
+nameTree s = \case
+  Nothing -> (\m -> NameTree m False) <$> (B32.masterKey =<< bip39Seed s)
+  Just secret -> do
+    seed <- bip39Seed s
+    kdf <- case Argon2.hash argonOptions (encodeUtf8 secret) seed 32 of
+      CryptoPassed (k :: ByteString) -> Right k
+      CryptoFailed e -> Left $ "wallet secret: " <> show e
+    let i = BA.convert (HMAC.hmac subtreeLabel kdf :: HMAC.HMAC H.SHA512) :: ByteString
+    key <- S.mkPrivateKey (B.take 32 i)
+    pure NameTree {ntMaster = B32.ExtendedKey {B32.xkKey = key, B32.xkChainCode = B.drop 32 i}, ntSecret = True}
+  where
+    subtreeLabel = "simplex wallet subtree" :: ByteString
+    -- pinned, not defaultOptions: a library default moving would move every key
+    argonOptions =
+      Argon2.Options
+        { Argon2.iterations = 3,
+          Argon2.memory = 65536,
+          Argon2.parallelism = 1,
+          Argon2.variant = Argon2.Argon2id,
+          Argon2.version = Argon2.Version13
+        }
+
+renderNameKeyPath :: NameTree -> NameIndex -> Text
+renderNameKeyPath t nm
+  | ntSecret t = "secret/" <> T.pack (show nm)
+  | otherwise = decodeLatin1 . B32.renderPath $ ethereumPath 0 nm
+
+deriveNameKey :: NameTree -> NameIndex -> Either String S.PrivateKey
+deriveNameKey t nm
+  | ntSecret t = B32.xkKey <$> B32.deriveChild (ntMaster t) nm
+  | otherwise = B32.xkKey <$> B32.derivePath (ntMaster t) (ethereumPath 0 nm)
 
 -- | As wallets take it when a key is imported on its own.
 nameKeySecret :: S.PrivateKey -> ByteString

tests/WalletTests.hs

@@ -9,9 +9,9 @@ import ChatTests.Utils
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
 import Data.Either (isLeft)
-import Data.List (nub)
+import Data.List (intersect, nub)
 import qualified Simplex.Messaging.Crypto.Secp256k1 as S
-import Simplex.Chat.Wallet (NameIndex, WalletSeed (..), deriveNameKey, importRecoveryKey, nameKeySecret, recoveryKeyPhrase, renderNameKeyPath, seedMaster)
+import Simplex.Chat.Wallet (NameIndex, WalletSeed (..), deriveNameKey, importRecoveryKey, nameKeySecret, nameTree, recoveryKeyPhrase, renderNameKeyPath)
 import Simplex.Messaging.Eth.Address (addressFromPrivateKey)
 import Test.Hspec hiding (it)
 import qualified Test.Hspec as Hspec
@@ -24,7 +24,7 @@ testSeed :: WalletSeed
 testSeed = WalletSeed {wsId = 1, wsEntropy = either error id $ importRecoveryKey testPhrase}
 
 nameKey :: NameIndex -> Either String S.PrivateKey
-nameKey nm = seedMaster testSeed >>= \m -> deriveNameKey m nm
+nameKey nm = nameTree testSeed Nothing >>= \t -> deriveNameKey t nm
 
 walletDerivationTests :: Spec
 walletDerivationTests = do
@@ -38,8 +38,9 @@ walletDerivationTests = do
     either error nameKeySecret (nameKey 1)
       `shouldBe` "0x9a983cb3d832fbde5ab49d692b7a8bf5b5d232479c99333d0fc8e1d21f1b55b6"
   Hspec.it "renders the path a name key sits at" $ do
-    renderNameKeyPath 1 `shouldBe` "m/44'/60'/0'/0/1"
-    renderNameKeyPath 7 `shouldBe` "m/44'/60'/0'/0/7"
+    let t = either error id $ nameTree testSeed Nothing
+    renderNameKeyPath t 1 `shouldBe` "m/44'/60'/0'/0/1"
+    renderNameKeyPath t 7 `shouldBe` "m/44'/60'/0'/0/7"
   Hspec.it "round-trips the phrase it was imported from" $
     recoveryKeyPhrase testSeed `shouldBe` Right testPhrase
   Hspec.it "refuses a phrase with a bad checksum" $
@@ -54,6 +55,7 @@ walletTests = do
   it "exports the secret of any name key" testWalletExportDerivedSecret
   it "deletes the seed, and a seed can be imported again" testWalletDelete
   it "discards a seed imported before the database is restored" testWalletImportThenRestore
+  it "reaches a secret subtree, which a scan of the seed does not" testWalletSecretSubtree
 
 -- | The state a chat database backed up before the seed restores to.
 forgetSeed :: HasCallStack => TestCC -> IO ()
@@ -154,3 +156,19 @@ testWalletImportThenRestore ps = withNewTestChat ps "alice" aliceProfile $ \alic
   alice ##> ("/_wallet create mnemonic=" <> B.unpack testPhrase)
   rows <- nameRows alice
   map fst rows `shouldBe` ["m/44'/60'/0'/0/1", "m/44'/60'/0'/0/2"]
+
+testWalletSecretSubtree :: HasCallStack => TestParams -> IO ()
+testWalletSecretSubtree ps = withNewTestChat ps "alice" aliceProfile $ \alice -> do
+  alice ##> ("/_wallet create mnemonic=" <> B.unpack testPhrase)
+  rows <- nameRows alice
+  alice ##> "/_wallet secret=\"blablablablabla\""
+  rows' <- nameRows alice
+  map fst rows' `shouldBe` ["secret/1", "secret/2"]
+  -- the subtree is somewhere the enumerable paths do not reach
+  null (map snd rows `intersect` map snd rows') `shouldBe` True
+  alice ##> "/_wallet export name 1 secret=\"blablablablabla\""
+  alice <## "secret/1  0x29F36E18fa94E016657a476C718d271EC5B95619  0xd16df2c2657eb95bba47cefc2425ed27713a86faa79eb85d3f1ae5758c588bd6"
+  -- a different secret is a different subtree
+  alice ##> "/_wallet export name 1 secret=other words here"
+  l <- getTermLine alice
+  (words l !! 1) `shouldNotBe` "0x29F36E18fa94E016657a476C718d271EC5B95619"