implement names purchase MVP integrating with the badges service

apps/simplex-badge-service/src/BadgeService/Service.hs

@@ -17,30 +17,54 @@ import Control.Logger.Simple
 import Control.Monad
 import qualified Data.Aeson as J
 import qualified Data.Aeson.KeyMap as KM
+import Data.ByteString (ByteString)
+import Data.Map.Strict (Map)
+import qualified Data.Map.Strict as M
+import Data.Set (Set)
+import qualified Data.Set as S
+import Data.Text (Text)
 import qualified Data.Text as T
+import Data.Time.Clock (UTCTime, addUTCTime, getCurrentTime)
 import Simplex.Chat.Badges.Service (BadgeServiceErrorCode (..))
 import Simplex.Chat.Bot (initializeBotAddress')
 import Simplex.Chat.Controller
 import Simplex.Chat.Core (sendChatCmd, simplexChatCore)
+import Simplex.Chat.Names.Protocol
 import Simplex.Chat.Options (printDbOpts)
 import Simplex.Chat.Terminal (terminalChatConfig)
 import Simplex.Chat.Terminal.Main (simplexChatCLI')
 import Simplex.Chat.Types (AgentInvId (..), User (..))
 import Simplex.Messaging.Encoding.String (strEncode)
+import Simplex.Messaging.Eth.Address (Address)
+import Simplex.Messaging.Eth.Keccak (keccak256)
 import Simplex.Messaging.Util (raceAny_, safeDecodeUtf8, tshow)
 import System.Directory (getAppUserDataDirectory)
 import System.Exit (exitFailure)
 
 data ServiceState = ServiceState
   { serviceCC :: TMVar ChatController,
-    serviceRequestQ :: TQueue (User, AgentInvId, J.Object)
+    serviceRequestQ :: TQueue (User, AgentInvId, J.Object),
+    serviceNamesChain :: TVar NamesChain
   }
 
 newServiceState :: IO ServiceState
 newServiceState = do
   serviceCC <- newEmptyTMVarIO
   serviceRequestQ <- newTQueueIO
-  pure ServiceState {serviceCC, serviceRequestQ}
+  serviceNamesChain <- newTVarIO emptyNamesChain
+  pure ServiceState {serviceCC, serviceRequestQ, serviceNamesChain}
+
+-- | In-memory mock of the name registry chain: committed hashes and registered
+-- names. Stands in for a deployed SNRC; swap for a relayer to make it real.
+data NamesChain = NamesChain
+  { chainCommitments :: Set ByteString,
+    chainNames :: Map Text NameEntry
+  }
+
+data NameEntry = NameEntry {neOwner :: Address, neSimplexLink :: Text, neExpiry :: UTCTime}
+
+emptyNamesChain :: NamesChain
+emptyNamesChain = NamesChain S.empty M.empty
 
 welcomeGetOpts :: IO BadgeServiceOpts
 welcomeGetOpts = do
@@ -65,7 +89,7 @@ badgeService opts cfg = do
       (_, event) <- atomically . readTBQueue $ outputQ cc
       case event of
         -- TODO enforce _sigKey == BadgeServiceRequest.purchaseKey (docs/protocol/badges-rpc.md).
-        Right (CEvtServiceRequest u reqId _sigKey reqData) -> handleServiceRequest cc u reqId reqData
+        Right (CEvtServiceRequest u reqId _sigKey reqData) -> handleServiceRequest cc (serviceNamesChain env) u reqId reqData
         _ -> pure ()
 
 badgeServiceCLI :: BadgeServiceOpts -> IO ()
@@ -93,7 +117,7 @@ processQueuedRequests env = do
   cc <- atomically $ readTMVar $ serviceCC env
   forever $ do
     (u, reqId, reqData) <- atomically $ readTQueue $ serviceRequestQ env
-    handleServiceRequest cc u reqId reqData
+    handleServiceRequest cc (serviceNamesChain env) u reqId reqData
 
 badgePreStartHook :: BadgeServiceOpts -> ChatController -> IO ()
 badgePreStartHook opts ChatController {config, chatStore} =
@@ -110,11 +134,48 @@ badgePostStartHook BadgeServiceOpts {noAddress, testing} env cc = do
       unless noAddress $ initializeBotAddress' (not testing) (Just True) False cc
       void $ atomically $ tryPutTMVar (serviceCC env) cc
 
-handleServiceRequest :: ChatController -> User -> AgentInvId -> J.Object -> IO ()
-handleServiceRequest cc User {userId} reqId _reqData = do
+handleServiceRequest :: ChatController -> TVar NamesChain -> User -> AgentInvId -> J.Object -> IO ()
+handleServiceRequest cc chain User {userId} reqId reqData = do
   let reqIdT = safeDecodeUtf8 (strEncode reqId)
-      respObj = KM.fromList [("type", J.String "error"), ("code", J.toJSON BSEUnsupportedVersion)]
-  logInfo $ "badge service request " <> reqIdT
+  logInfo $ "service request " <> reqIdT
+  respObj <- case J.fromJSON (J.Object reqData) of
+    J.Success req -> handleNamesRequest chain req
+    -- Non-names request: badge dispatch is still a stub.
+    J.Error _ -> pure $ KM.fromList [("type", J.String "error"), ("code", J.toJSON BSEUnsupportedVersion)]
   sendChatCmd cc (APISendServiceResponse userId reqId respObj) >>= \case
     Right _ -> pure ()
-    Left e -> logError $ "badge service response failed for " <> reqIdT <> ": " <> tshow e
+    Left e -> logError $ "service response failed for " <> reqIdT <> ": " <> tshow e
+
+-- | Commit\/reveal against the chain mock. Commit stores the commitment and is
+-- idempotent; reveal registers the name only if it was committed and is not
+-- already registered — a second reveal of a live name fails with @name_taken@.
+handleNamesRequest :: TVar NamesChain -> NamesRequest -> IO J.Object
+handleNamesRequest chain NamesRequest {nrVersion, nrRequest}
+  | nrVersion /= currentNamesVersion = pure $ respObj $ NRPError NECUnsupportedVersion Nothing Nothing
+  | otherwise = case nrRequest of
+      NRCommit {nrCommitment} -> do
+        atomically $ modifyTVar' chain $ \c ->
+          c {chainCommitments = S.insert (unCommitment nrCommitment) (chainCommitments c)}
+        pure $ respObj $ NRPCommitted (mockTxHash "commit" $ unCommitment nrCommitment)
+      NRReveal {nrName, nrOwner, nrSecret, nrTtl, nrLink} -> do
+        now <- getCurrentTime
+        let commitment = unCommitment (mkCommitment nrName nrOwner nrSecret nrTtl)
+            expiry = addUTCTime (fromIntegral nrTtl) now
+        atomically $ do
+          c <- readTVar chain
+          if not (S.member commitment (chainCommitments c))
+            then pure $ respObj $ NRPError NECBadRequest (Just "no matching commitment") Nothing
+            else case M.lookup nrName (chainNames c) of
+              -- A registered name is taken, including by you: re-registering is not
+              -- an update, and edits need signing (out of scope). Retry-idempotency
+              -- cannot be inferred from matching fields — it needs a request key,
+              -- which arrives with retries themselves.
+              Just _ -> pure $ respObj $ NRPError NECNameTaken Nothing Nothing
+              Nothing -> do
+                writeTVar chain c {chainNames = M.insert nrName (NameEntry nrOwner nrLink expiry) (chainNames c)}
+                pure $ respObj $ NRPRegistered nrName expiry (mockTxHash "reveal" commitment)
+  where
+    -- A NamesResponse always encodes to a JSON object.
+    respObj r = case J.toJSON r of J.Object o -> o; _ -> KM.empty
+    -- commit and reveal are distinct chain writes, so their hashes differ
+    mockTxHash tag = TxHash . keccak256 . (tag <>)

bots/src/API/Docs/Commands.hs

@@ -393,6 +393,7 @@ undocumentedCommands =
     "APIHideUser",
     "APIImportArchive",
     "APIMuteUser",
+    "APINameRegister",
     "APIPlanForwardChatItems",
     "APIPrepareContact",
     "APIPrepareGroup",

bots/src/API/Docs/Events.hs

@@ -196,6 +196,7 @@ undocumentedEvents =
     "CEvtGroupMemberRatchetSync",
     "CEvtGroupMemberSwitch",
     "CEvtServiceSubStatus",
+    "CEvtNameRegistrationProgress",
     "CEvtNewRemoteHost",
     "CEvtNoMemberContactCreating",
     "CEvtNtfMessage",

bots/src/API/Docs/Responses.hs

@@ -177,6 +177,7 @@ undocumentedResponses =
     "CRMemberSupportChatRead",
     "CRMemberSupportChatDeleted",
     "CRMemberSupportChats",
+    "CRNameRegistered",
     "CRNetworkConfig",
     "CRNewMemberContact",
     "CRNewMemberContactSentInv",

simplex-chat.cabal

@@ -43,6 +43,9 @@ library
       Simplex.Chat.Badges.Service
       Simplex.Chat.Badges.Types
       Simplex.Chat.Names
+      Simplex.Chat.Names.Protocol
+      Simplex.Chat.Store.Wallets
+      Simplex.Chat.Wallet
       Simplex.Chat.Call
       Simplex.Chat.Controller
       Simplex.Chat.Delivery
@@ -158,6 +161,7 @@ library
           Simplex.Chat.Store.Postgres.Migrations.M20260720_server_roles
           Simplex.Chat.Store.Postgres.Migrations.M20260723_contact_request_rejection
           Simplex.Chat.Store.Postgres.Migrations.M20260731_user_badges
+          Simplex.Chat.Store.Postgres.Migrations.M20260806_wallet_seeds
   else
       exposed-modules:
           Simplex.Chat.Archive
@@ -329,6 +333,7 @@ library
           Simplex.Chat.Store.SQLite.Migrations.M20260720_server_roles
           Simplex.Chat.Store.SQLite.Migrations.M20260723_contact_request_rejection
           Simplex.Chat.Store.SQLite.Migrations.M20260731_user_badges
+          Simplex.Chat.Store.SQLite.Migrations.M20260806_wallet_seeds
   other-modules:
       Paths_simplex_chat
   hs-source-dirs:
@@ -420,12 +425,14 @@ executable simplex-badge-service
   build-depends:
       aeson ==2.2.*
     , base >=4.7 && <5
+    , containers ==0.6.*
     , directory ==1.3.*
     , optparse-applicative >=0.15 && <0.17
     , simple-logger ==0.1.*
     , simplex-chat
     , simplexmq >=6.3
     , stm ==2.5.*
+    , time ==1.12.*
   default-language: Haskell2010
   if flag(client_postgres)
     other-modules:
@@ -677,6 +684,7 @@ test-suite simplex-chat-test
       BadgeService.Service
       BadgeService.Store.Migrate
       Bots.BadgeServiceTests
+      Bots.NamesServiceTests
       Broadcast.Bot
       Broadcast.Options
       Directory.BlockedWords

src/Simplex/Chat/Controller.hs

@@ -48,7 +48,7 @@ import Data.Text.Encoding (decodeLatin1)
 import Data.Time (NominalDiffTime, UTCTime)
 import Data.Time.Clock.System (SystemTime (..), systemToUTCTime)
 import Data.Version (showVersion)
-import Data.Word (Word16)
+import Data.Word (Word16, Word32)
 import Language.Haskell.TH (Exp, Q, runIO)
 import Network.Socket (HostName)
 import Numeric.Natural
@@ -64,6 +64,7 @@ import Simplex.Chat.Remote.AppVersion
 import Simplex.Chat.Remote.Types
 import Simplex.Chat.Stats (PresentedServersSummary)
 import Simplex.Chat.Store (AddressSettings, ChatLockEntity, GroupLinkInfo, StoreError (..), UserContactLink, UserMsgReceiptSettings)
+import Simplex.Chat.Names.Protocol (NameRegPhase, TxHash)
 import Simplex.Chat.Types
 import Simplex.Chat.Types.Preferences
 import Simplex.Chat.Types.Shared
@@ -413,6 +414,7 @@ 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}
+  | APINameRegister {sendTarget :: ConnectTarget 'CMContact, regName :: Text, registerLink :: Text}
   | APISendCallInvitation ContactId CallType
   | SendCallInvitation ContactName CallType
   | APIRejectCall ContactId
@@ -839,6 +841,7 @@ data ChatResponse
   | CRContactRequestRejected {user :: User, contactRequest :: UserContactRequest, contact_ :: Maybe Contact}
   | CRServiceResponse {user :: User, responseData :: J.Object}
   | CRServiceReplyAccepted {user :: User, connectionId :: AgentConnId}
+  | CRNameRegistered {user :: User, regName :: Text, regOwner :: Text, regExpiry :: UTCTime, regTxHash :: TxHash}
   | CRUserAcceptedGroupSent {user :: User, groupInfo :: GroupInfo, hostContact :: Maybe Contact}
   | CRUserDeletedMembers {user :: User, groupInfo :: GroupInfo, members :: [GroupMember], withMessages :: Bool, msgSigned :: Bool}
   | CRGroupsList {user :: User, groups :: [GroupInfo]}
@@ -956,6 +959,7 @@ data ChatEvent
   | CEvtReceivedContactRequest {user :: User, contactRequest :: UserContactRequest, chat_ :: Maybe AChat}
   | CEvtServiceRequest {user :: User, requestId :: AgentInvId, signerKey :: Maybe C.PublicKeyEd25519, requestData :: J.Object}
   | CEvtServiceReplySent {connectionId :: AgentConnId}
+  | CEvtNameRegistrationProgress {user :: User, regName :: Text, regPhase :: NameRegPhase, waitMs :: Maybe Word32}
   | CEvtContactRequestRejected {user :: User, contact :: Contact, rejectionReason :: Maybe ContactRejectionReason}
   | CEvtAcceptingContactRequest {user :: User, contact :: Contact} -- there is the same command response
   | CEvtAcceptingBusinessRequest {user :: User, groupInfo :: GroupInfo}

src/Simplex/Chat/Library/Commands.hs

@@ -33,6 +33,7 @@ import qualified Data.ByteString.Base64 as B64
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
 import qualified Data.ByteString.Lazy.Char8 as LB
+import Data.Word (Word32)
 import Data.Char
 import Data.Constraint (Dict (..))
 import Data.Either (fromRight, partitionEithers, rights)
@@ -58,6 +59,9 @@ import qualified Data.UUID.V4 as V4
 import Simplex.Chat.Library.Subscriber
 import Simplex.Chat.Badges (BadgeCredential (..), LocalBadge (..), maxXFTPFileSize, mkBadgeStatus, verifyCredential)
 import Simplex.Chat.Names (SimplexDomainProof (..), SimplexDomainClaim (..), claimDomain, mkDomainClaim)
+import Simplex.Chat.Names.Protocol
+import Simplex.Chat.Store.Wallets (getOrCreateAccountRef)
+import Simplex.Chat.Wallet (AccountRef (..), accountAddress, deriveAccount, newSeed)
 import Simplex.Chat.Call
 import Simplex.Chat.Controller
 import Simplex.Chat.Delivery (DeliveryJobScope (..), DeliveryJobSpec (..), DeliveryWorkerScope (..))
@@ -104,6 +108,7 @@ import qualified Simplex.Messaging.Agent.Store.DB as DB
 import Simplex.Messaging.Agent.Store.Interface (getCurrentMigrations)
 import Simplex.Messaging.Client (NetworkConfig (..), NetworkRequestMode (..), NetworkTimeout (..), SMPWebPortServers (..), SocksMode (SMAlways), pattern NRMInteractive, textToHostMode)
 import qualified Simplex.Messaging.Crypto as C
+import Simplex.Messaging.Crypto.BIP39 (MnemonicStrength (..))
 import qualified Simplex.Messaging.Crypto.ShortLink as SL
 import Simplex.Messaging.Crypto.File (CryptoFile (..), CryptoFileArgs (..))
 import qualified Simplex.Messaging.Crypto.File as CF
@@ -1455,25 +1460,47 @@ processChatCommand cxt nm = \case
             pure ct_
         pure $ CRContactRequestRejected user cReq ct_
   APISendServiceRequest userId sendTarget requestTimeout signKey request -> withUserId userId $ \user -> do
-    cReq <- resolveServiceTarget user sendTarget
+    cReq <- resolveServiceTarget nm user sendTarget
     respData <- withAgent $ \a -> sendServiceRequestAsync a (aUserId user) cReq requestTimeout (C.unStored <$> signKey) (LB.toStrict $ J.encode request)
     resp <- either (const $ throwCmdError "invalid service response") pure $ J.eitherDecodeStrict' respData
     pure $ CRServiceResponse user resp
+  APINameRegister sendTarget nm' sLink -> withUser $ \user -> do
+    owner <- deriveNameOwner user
+    cReq <- resolveServiceTarget nm user sendTarget
+    g <- asks random
+    secret <- NameSecret <$> atomically (C.randomBytes 32 g)
+    let ttl = defaultNameTtl
+        commitment = mkCommitment nm' owner secret ttl
+        sendNames c = do
+          let req = NamesRequest currentNamesVersion c
+          respData <- withAgent $ \a -> sendServiceRequestAsync a (aUserId user) cReq Nothing Nothing (LB.toStrict $ J.encode req)
+          either (const $ throwCmdError "invalid names response") pure $ J.eitherDecodeStrict' respData
+        progress phase waitMs = toView $ CEvtNameRegistrationProgress user nm' phase waitMs
+    progress NRPhaseCommitting Nothing
+    sendNames (NRCommit commitment) >>= \case
+      NRPCommitted {} -> pure ()
+      NRPError {nrCode, nrMessage} -> throwCmdError $ nameRegError nrCode nrMessage
+      _ -> throwCmdError "unexpected commit response"
+    progress NRPhaseCommitted (Just commitWaitMs)
+    liftIO $ threadDelay $ fromIntegral commitWaitMs * 1000
+    progress NRPhaseRevealing Nothing
+    (expiry', txHash') <-
+      sendNames (NRReveal nm' owner secret ttl sLink) >>= \case
+        NRPRegistered {nrExpiry, nrTxHash} -> pure (nrExpiry, nrTxHash)
+        NRPError {nrCode, nrMessage} -> throwCmdError $ nameRegError nrCode nrMessage
+        _ -> throwCmdError "unexpected reveal response"
+    progress NRPhaseRegistered Nothing
+    pure $ CRNameRegistered user nm' (tshow owner) expiry' txHash'
     where
-      resolveServiceTarget user = \case
-        CTFullContact cReq -> pure cReq
-        CTShortContact (CTLink sLnk) -> resolveShortLink sLnk
-        CTShortContact (CTName SimplexNameInfo {nameType, nameDomain}) -> case nameType of
-          NTContact -> resolveDomain nameDomain
-          _ -> throwCmdError "service request target must be a contact"
-        CTDomain d -> resolveDomain d
-        where
-          resolveDomain d = do
-            nr <- withAgent $ \a -> resolveSimplexName a nm (aUserId user) d
-            case firstNameLink CCTContact (nrSimplexContact nr) of
-              Just sLnk -> resolveShortLink sLnk
-              Nothing -> throwChatError $ CESimplexDomainNotReady d SDENoValidLink
-          resolveShortLink sLnk = (\(_, _, cReq) -> cReq) <$> getShortLinkConnReq nm user sLnk
+      -- The seed is created on first registration and persisted, so the owner
+      -- address survives restart — a name whose key we cannot re-derive is lost.
+      deriveNameOwner user = do
+        g <- asks random
+        (seed, AccountRef {arIndex}) <-
+          withFastStore' $ \db -> getOrCreateAccountRef db user (atomically $ newSeed MS256 g)
+        either (throwCmdError . ("wallet: " <>)) (pure . accountAddress) $ deriveAccount seed arIndex
+      nameRegError code message =
+        "name registration failed: " <> T.unpack (textEncode code) <> maybe "" ((": " <>) . T.unpack) message
   APISendServiceResponse userId requestId responseData -> withUserId userId $ \user -> do
     let AgentInvId invId = requestId
     connId <- withAgent $ \a -> sendServiceReplyAsync a "" (aUserId user) invId (LB.toStrict $ J.encode responseData)
@@ -5021,6 +5048,32 @@ processChatCommand cxt nm = \case
       gVar <- asks random
       liftIO $ SharedMsgId <$> encodedRandomBytes gVar 12
 
+-- | Resolve a service connect target to a contact connection request, shared by
+-- the service-request and name-registration commands.
+resolveServiceTarget :: NetworkRequestMode -> User -> ConnectTarget 'CMContact -> CM ConnReqContact
+resolveServiceTarget nm user = \case
+  CTFullContact cReq -> pure cReq
+  CTShortContact (CTLink sLnk) -> resolveShortLink sLnk
+  CTShortContact (CTName SimplexNameInfo {nameType, nameDomain}) -> case nameType of
+    NTContact -> resolveDomain nameDomain
+    _ -> throwCmdError "service request target must be a contact"
+  CTDomain d -> resolveDomain d
+  where
+    resolveDomain d = do
+      nr <- withAgent $ \a -> resolveSimplexName a nm (aUserId user) d
+      case firstNameLink CCTContact (nrSimplexContact nr) of
+        Just sLnk -> resolveShortLink sLnk
+        Nothing -> throwChatError $ CESimplexDomainNotReady d SDENoValidLink
+    resolveShortLink sLnk = (\(_, _, cReq) -> cReq) <$> getShortLinkConnReq nm user sLnk
+
+-- | Default name lifetime (365 days). Real min-commitment-age enforcement deferred.
+defaultNameTtl :: NameTtl
+defaultNameTtl = 31536000
+
+-- | Hardcoded commit→reveal wait in ms, standing in for the on-chain minimum commitment age.
+commitWaitMs :: Word32
+commitWaitMs = 1000
+
 firstNameLink :: ContactConnType -> [Text] -> Maybe (ConnShortLink 'CMContact)
 firstNameLink ctType = foldr (\t r -> nameLink t <|> r) Nothing
   where
@@ -5527,6 +5580,7 @@ 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),
+      "/name register " *> (APINameRegister <$> strP <* A.space <*> displayNameP <* A.space <*> textP),
       "/_call invite @" *> (APISendCallInvitation <$> A.decimal <* A.space <*> jsonP),
       "/call " *> char_ '@' *> (SendCallInvitation <$> displayNameP <*> pure defaultCallType),
       "/_call reject @" *> (APIRejectCall <$> A.decimal),

src/Simplex/Chat/Names/Protocol.hs

@@ -0,0 +1,246 @@
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TemplateHaskell #-}
+
+-- | Wire protocol for name registration over the badge service-RPC transport.
+--
+-- A 'NamesRequest' travels in @APISendServiceRequest.request@ and a
+-- 'NamesResponse' comes back in @CRServiceResponse.responseData@ — one response
+-- per request. The envelope and both command\/response sums are @type@-tagged
+-- JSON objects, the same shape the badge service decodes.
+--
+-- Registration is commit-then-reveal (see the MVP plan): 'NRCommit' publishes
+-- only @H(name, owner, secret, ttl)@ so the service cannot tell which name it
+-- is; 'NRReveal' submits the plaintext once the aged commitment already binds
+-- the name to /this/ owner address, so the service cannot front-run it.
+module Simplex.Chat.Names.Protocol
+  ( NamesVersion,
+    currentNamesVersion,
+    NameTtl,
+    NamesRequest (..),
+    NamesCommand (..),
+    NamesResponse (..),
+    NamesErrorCode (..),
+    Commitment (..),
+    NameSecret (..),
+    TxHash (..),
+    NameRegPhase (..),
+    mkCommitment,
+  )
+where
+
+import Data.Aeson (FromJSON (..), ToJSON (..), (.:), (.:?), (.=))
+import qualified Data.Aeson as J
+import qualified Data.Aeson.Types as JT
+import Control.Applicative (optional)
+import Data.Attoparsec.ByteString.Char8 (Parser)
+import qualified Data.Attoparsec.ByteString.Char8 as A
+import qualified Data.ByteArray.Encoding as BAE
+import Data.ByteString (ByteString)
+import qualified Data.ByteString as B
+import Data.Char (isHexDigit)
+import Data.Text (Text)
+import qualified Data.Text as T
+import Data.Text.Encoding (encodeUtf8)
+import Data.Time.Clock (UTCTime)
+import Data.Word (Word16, Word32)
+import qualified Data.Aeson.TH as JQ
+import Simplex.Messaging.Encoding (smpEncode)
+import Simplex.Messaging.Encoding.String
+import Simplex.Messaging.Parsers (enumJSON)
+import Simplex.Messaging.Eth.Address (Address, checksumAddress, parseAddress, unAddress)
+import Simplex.Messaging.Eth.Keccak (keccak256)
+import Simplex.Messaging.Util (safeDecodeUtf8)
+
+-- | Protocol version, negotiated the way the badge service version is.
+type NamesVersion = Word16
+
+currentNamesVersion :: NamesVersion
+currentNamesVersion = 1
+
+-- | Name lifetime in seconds. Real min-commitment-age enforcement is deferred.
+type NameTtl = Word32
+
+-- | @H(name, owner, secret, ttl)@ — the only thing a commit reveals.
+newtype Commitment = Commitment {unCommitment :: ByteString}
+  deriving (Eq, Show)
+
+-- | Per-registration nonce, kept secret until reveal so the commitment is opaque.
+newtype NameSecret = NameSecret {unSecret :: ByteString}
+  deriving (Eq, Show)
+
+-- | A mock transaction hash. Returned now so block-inclusion checks (out of
+-- scope) need no protocol change later.
+newtype TxHash = TxHash {unTxHash :: ByteString}
+  deriving (Eq, Show)
+
+-- | All three are on-chain byte values, so they are encoded the way Ethereum
+-- writes them — @0x@-prefixed hex — not base64.
+hexEncode :: ByteString -> ByteString
+hexEncode = ("0x" <>) . BAE.convertToBase BAE.Base16
+
+hexP :: Parser ByteString
+hexP = do
+  _ <- optional (A.string "0x")
+  s <- A.takeWhile1 isHexDigit
+  either fail pure $ BAE.convertFromBase BAE.Base16 s
+
+instance StrEncoding Commitment where
+  strEncode = hexEncode . unCommitment
+  strP = Commitment <$> hexP
+
+instance StrEncoding NameSecret where
+  strEncode = hexEncode . unSecret
+  strP = NameSecret <$> hexP
+
+instance StrEncoding TxHash where
+  strEncode = hexEncode . unTxHash
+  strP = TxHash <$> hexP
+
+instance ToJSON Commitment where toJSON = strToJSON; toEncoding = strToJEncoding
+
+instance FromJSON Commitment where parseJSON = strParseJSON "Commitment"
+
+instance ToJSON NameSecret where toJSON = strToJSON; toEncoding = strToJEncoding
+
+instance FromJSON NameSecret where parseJSON = strParseJSON "NameSecret"
+
+instance ToJSON TxHash where toJSON = strToJSON; toEncoding = strToJEncoding
+
+instance FromJSON TxHash where parseJSON = strParseJSON "TxHash"
+
+-- | Bind a name to an owner address with a secret and a TTL. Uses keccak256, so
+-- the commitment matches what an Ethereum registrar would hash.
+mkCommitment :: Text -> Address -> NameSecret -> NameTtl -> Commitment
+mkCommitment name owner (NameSecret secret) ttl =
+  Commitment . keccak256 $ B.concat [encodeUtf8 name, unAddress owner, secret, smpEncode ttl]
+
+-- | @{ version, request }@ — the outer envelope. Fields are @nr@-prefixed so
+-- they do not shadow local bindings where this module is imported unqualified.
+data NamesRequest = NamesRequest
+  { nrVersion :: NamesVersion,
+    nrRequest :: NamesCommand
+  }
+  deriving (Eq, Show)
+
+data NamesCommand
+  = NRCommit {nrCommitment :: Commitment}
+  | NRReveal
+      { nrName :: Text,
+        nrOwner :: Address,
+        nrSecret :: NameSecret,
+        nrTtl :: NameTtl,
+        nrLink :: Text
+      }
+  deriving (Eq, Show)
+
+data NamesResponse
+  = NRPCommitted {nrTxHash :: TxHash}
+  | NRPRegistered {nrName :: Text, nrExpiry :: UTCTime, nrTxHash :: TxHash}
+  | NRPError {nrCode :: NamesErrorCode, nrMessage :: Maybe Text, nrRetryAfter :: Maybe Word32}
+  deriving (Eq, Show)
+
+data NamesErrorCode
+  = NECNameTaken
+  | NECBadRequest
+  | NECUnsupportedVersion
+  | NECInternal
+  | NECUnknown Text -- forwards-compatible: service may be ahead of clients
+  deriving (Eq, Show)
+
+instance TextEncoding NamesErrorCode where
+  textEncode = \case
+    NECNameTaken -> "name_taken"
+    NECBadRequest -> "bad_request"
+    NECUnsupportedVersion -> "unsupported_version"
+    NECInternal -> "internal"
+    NECUnknown t -> t
+  textDecode = Just . \case
+    "name_taken" -> NECNameTaken
+    "bad_request" -> NECBadRequest
+    "unsupported_version" -> NECUnsupportedVersion
+    "internal" -> NECInternal
+    t -> NECUnknown t
+
+instance ToJSON NamesErrorCode where
+  toJSON = textToJSON
+  toEncoding = textToEncoding
+
+instance FromJSON NamesErrorCode where
+  parseJSON = textParseJSON "NamesErrorCode"
+
+instance ToJSON NamesRequest where
+  toJSON NamesRequest {nrVersion, nrRequest} = J.object ["version" .= nrVersion, "request" .= nrRequest]
+
+instance FromJSON NamesRequest where
+  parseJSON = J.withObject "NamesRequest" $ \o ->
+    NamesRequest <$> o .: "version" <*> o .: "request"
+
+instance ToJSON NamesCommand where
+  toJSON = \case
+    NRCommit {nrCommitment} ->
+      J.object ["type" .= ("commit" :: Text), "commitment" .= nrCommitment]
+    NRReveal {nrName, nrOwner, nrSecret, nrTtl, nrLink} ->
+      J.object
+        [ "type" .= ("reveal" :: Text),
+          "name" .= nrName,
+          "owner" .= addressJSON nrOwner,
+          "secret" .= nrSecret,
+          "ttl" .= nrTtl,
+          "simplex_link" .= nrLink
+        ]
+
+instance FromJSON NamesCommand where
+  parseJSON = J.withObject "NamesCommand" $ \o ->
+    (o .: "type") >>= \case
+      "commit" -> NRCommit <$> o .: "commitment"
+      "reveal" ->
+        NRReveal
+          <$> o .: "name"
+          <*> (o .: "owner" >>= parseAddressJSON)
+          <*> o .: "secret"
+          <*> o .: "ttl"
+          <*> o .: "simplex_link"
+      t -> fail $ "unknown names command: " <> T.unpack (t :: Text)
+
+instance ToJSON NamesResponse where
+  toJSON = \case
+    NRPCommitted {nrTxHash} ->
+      J.object ["type" .= ("committed" :: Text), "txHash" .= nrTxHash]
+    NRPRegistered {nrName, nrExpiry, nrTxHash} ->
+      J.object ["type" .= ("registered" :: Text), "name" .= nrName, "expiry" .= nrExpiry, "txHash" .= nrTxHash]
+    NRPError {nrCode, nrMessage, nrRetryAfter} ->
+      J.object $
+        ["type" .= ("error" :: Text), "code" .= nrCode]
+          <> ["message" .= m | Just m <- [nrMessage]]
+          <> ["retryAfter" .= r | Just r <- [nrRetryAfter]]
+
+instance FromJSON NamesResponse where
+  parseJSON = J.withObject "NamesResponse" $ \o ->
+    (o .: "type") >>= \case
+      "committed" -> NRPCommitted <$> o .: "txHash"
+      "registered" -> NRPRegistered <$> o .: "name" <*> o .: "expiry" <*> o .: "txHash"
+      "error" -> NRPError <$> o .: "code" <*> o .:? "message" <*> o .:? "retryAfter"
+      t -> fail $ "unknown names response: " <> T.unpack (t :: Text)
+
+-- | EIP-55 checksummed hex, the form a user pastes into a block explorer.
+addressJSON :: Address -> J.Value
+addressJSON = J.String . safeDecodeUtf8 . checksumAddress
+
+parseAddressJSON :: J.Value -> JT.Parser Address
+parseAddressJSON = J.withText "Address" $ either fail pure . parseAddress . encodeUtf8
+
+-- | Progress phases streamed from core to the UI as registration advances.
+-- Not part of the wire protocol — carried in @CEvtNameRegistrationProgress@.
+-- | 'NRPhaseCommitted' carries @waitMs@: the commit→reveal wait starts as soon
+-- as it is emitted, so it needs no phase of its own.
+data NameRegPhase
+  = NRPhaseCommitting
+  | NRPhaseCommitted
+  | NRPhaseRevealing
+  | NRPhaseRegistered
+  deriving (Eq, Show)
+
+$(JQ.deriveJSON (enumJSON $ \case "NRPhaseCommitting" -> "committing"; "NRPhaseCommitted" -> "committed"; "NRPhaseRevealing" -> "revealing"; "NRPhaseRegistered" -> "registered"; s -> s) ''NameRegPhase)

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

@@ -46,6 +46,7 @@ import Simplex.Chat.Store.Postgres.Migrations.M20260715_profile_description
 import Simplex.Chat.Store.Postgres.Migrations.M20260716_signed_history
 import Simplex.Chat.Store.Postgres.Migrations.M20260720_server_roles
 import Simplex.Chat.Store.Postgres.Migrations.M20260723_contact_request_rejection
+import Simplex.Chat.Store.Postgres.Migrations.M20260806_wallet_seeds
 import Simplex.Messaging.Agent.Store.Shared (Migration (..))
 
 schemaMigrations :: [(String, Text, Maybe Text)]
@@ -91,7 +92,8 @@ schemaMigrations =
     ("20260715_profile_description", m20260715_profile_description, Just down_m20260715_profile_description),
     ("20260716_signed_history", m20260716_signed_history, Just down_m20260716_signed_history),
     ("20260720_server_roles", m20260720_server_roles, Just down_m20260720_server_roles),
-    ("20260723_contact_request_rejection", m20260723_contact_request_rejection, Just down_m20260723_contact_request_rejection)
+    ("20260723_contact_request_rejection", m20260723_contact_request_rejection, Just down_m20260723_contact_request_rejection),
+    ("20260806_wallet_seeds", m20260806_wallet_seeds, Just down_m20260806_wallet_seeds)
   ]
 
 -- | The list of migrations in ascending order by date

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

@@ -0,0 +1,56 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE QuasiQuotes #-}
+
+module Simplex.Chat.Store.Postgres.Migrations.M20260806_wallet_seeds where
+
+import Data.Text (Text)
+import Text.RawString.QQ (r)
+
+m20260806_wallet_seeds :: Text
+m20260806_wallet_seeds =
+  [r|
+CREATE TABLE wallet_seeds (
+  wallet_seed_id BIGINT GENERATED ALWAYS AS IDENTITY PRIMARY KEY,
+  seed BYTEA NOT NULL,
+  created_at TIMESTAMPTZ NOT NULL DEFAULT now(),
+  backed_up SMALLINT NOT NULL DEFAULT 0,
+  -- High-water mark for account allocation; see the SQLite migration for why
+  -- this cannot be derived from MAX(users.wallet_account_index).
+  next_account_index BIGINT NOT NULL DEFAULT 0
+);
+
+ALTER TABLE users ADD COLUMN wallet_seed_id BIGINT REFERENCES wallet_seeds ON DELETE RESTRICT;
+ALTER TABLE users ADD COLUMN wallet_account_index BIGINT;
+ALTER TABLE users ADD COLUMN wallet_scanned_to TEXT;
+
+CREATE INDEX idx_users_wallet_seed_id ON users(wallet_seed_id);
+
+CREATE TABLE wallet_one_time_addresses (
+  wallet_one_time_address_id BIGINT GENERATED ALWAYS AS IDENTITY PRIMARY KEY,
+  user_id BIGINT NOT NULL REFERENCES users ON DELETE CASCADE,
+  chain TEXT NOT NULL,
+  address BYTEA NOT NULL,
+  ephemeral_pub_key BYTEA NOT NULL,
+  discovered_at TIMESTAMPTZ NOT NULL DEFAULT now(),
+  accepted_at TIMESTAMPTZ,
+  UNIQUE (user_id, chain, address)
+);
+
+CREATE INDEX idx_wallet_one_time_addresses_user ON wallet_one_time_addresses(user_id, chain);
+|]
+
+down_m20260806_wallet_seeds :: Text
+down_m20260806_wallet_seeds =
+  [r|
+DROP INDEX idx_wallet_one_time_addresses_user;
+
+DROP TABLE wallet_one_time_addresses;
+
+DROP INDEX idx_users_wallet_seed_id;
+
+ALTER TABLE users DROP COLUMN wallet_scanned_to;
+ALTER TABLE users DROP COLUMN wallet_account_index;
+ALTER TABLE users DROP COLUMN wallet_seed_id;
+
+DROP TABLE wallet_seeds;
+|]

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

@@ -169,6 +169,7 @@ import Simplex.Chat.Store.SQLite.Migrations.M20260715_profile_description
 import Simplex.Chat.Store.SQLite.Migrations.M20260716_signed_history
 import Simplex.Chat.Store.SQLite.Migrations.M20260720_server_roles
 import Simplex.Chat.Store.SQLite.Migrations.M20260723_contact_request_rejection
+import Simplex.Chat.Store.SQLite.Migrations.M20260806_wallet_seeds
 import Simplex.Messaging.Agent.Store.Shared (Migration (..))
 
 schemaMigrations :: [(String, Query, Maybe Query)]
@@ -325,6 +326,7 @@ schemaMigrations =
     ("20260514_relay_request_group_link_index", m20260514_relay_request_group_link_index, Just down_m20260514_relay_request_group_link_index),
     ("20260515_public_group_access", m20260515_public_group_access, Just down_m20260515_public_group_access),
     ("20260516_supporter_badges", m20260516_supporter_badges, Just down_m20260516_supporter_badges),
+    ("20260806_wallet_seeds", m20260806_wallet_seeds, Just down_m20260806_wallet_seeds),
     ("20260529_delivery_job_senders", m20260529_delivery_job_senders, Just down_m20260529_delivery_job_senders),
     ("20260530_client_services", m20260530_client_services, Just down_m20260530_client_services),
     ("20260531_member_removed_at", m20260531_member_removed_at, Just down_m20260531_member_removed_at),

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

@@ -0,0 +1,74 @@
+{-# LANGUAGE QuasiQuotes #-}
+
+module Simplex.Chat.Store.SQLite.Migrations.M20260806_wallet_seeds where
+
+import Database.SQLite.Simple (Query)
+import Database.SQLite.Simple.QQ (sql)
+
+-- | Wallet seeds: BIP-39 entropy, one or more per database.
+--
+-- The schema allows several seeds per database, with each chat profile bound to
+-- exactly one of them plus its own BIP-44 account index. Only the single-seed
+-- case is reachable from the UI today — profiles all share one seed and differ
+-- by account index — but modelling it this way now means importing a second
+-- recovery key later is a UI change, not a migration of live key material.
+m20260806_wallet_seeds :: Query
+m20260806_wallet_seeds =
+  [sql|
+CREATE TABLE wallet_seeds (
+  wallet_seed_id INTEGER PRIMARY KEY AUTOINCREMENT,
+  seed BLOB NOT NULL,                       -- BIP-39 entropy, 16-32 bytes
+  created_at TEXT NOT NULL DEFAULT (datetime('now')),
+  backed_up INTEGER NOT NULL DEFAULT 0,     -- user acknowledged saving the recovery key
+  -- High-water mark for account allocation. Deliberately not derived from
+  -- MAX(users.wallet_account_index): after recovery from the phrase alone that
+  -- table is empty while accounts 0..N already hold names on chain, so a new
+  -- profile would silently reuse a recovered account's keys and meta-address.
+  -- The recovery probe raises this before any profile is created.
+  next_account_index INTEGER NOT NULL DEFAULT 0
+) STRICT;
+
+ALTER TABLE users ADD COLUMN wallet_seed_id INTEGER REFERENCES wallet_seeds ON DELETE RESTRICT;
+ALTER TABLE users ADD COLUMN wallet_account_index INTEGER;
+-- Position of the last recovery scan, so a repeat scan resumes. Not a live
+-- watermark: incoming names are learned from a chat message, not by scanning.
+ALTER TABLE users ADD COLUMN wallet_scanned_to TEXT;
+
+CREATE INDEX idx_users_wallet_seed_id ON users(wallet_seed_id);
+
+-- Destinations learned from a sender's message, or rediscovered by a recovery
+-- scan. Holds no private key: the key is re-derived from the seed and the
+-- ephemeral public key on demand, so this table is a cache and losing it costs
+-- a rescan rather than an asset.
+--
+-- 'chain' is carried from the first migration so that adding Bitcoin or Monero
+-- later is new rows, not a schema change.
+CREATE TABLE wallet_one_time_addresses (
+  wallet_one_time_address_id INTEGER PRIMARY KEY AUTOINCREMENT,
+  user_id INTEGER NOT NULL REFERENCES users ON DELETE CASCADE,
+  chain TEXT NOT NULL,                      -- 'eth' today; 'btc', 'xmr' later
+  address BLOB NOT NULL,
+  ephemeral_pub_key BLOB NOT NULL,          -- compressed secp256k1 point, 33 bytes
+  discovered_at TEXT NOT NULL DEFAULT (datetime('now')),
+  accepted_at TEXT,                         -- NULL = received but not accepted
+  UNIQUE (user_id, chain, address)
+) STRICT;
+
+CREATE INDEX idx_wallet_one_time_addresses_user ON wallet_one_time_addresses(user_id, chain);
+|]
+
+down_m20260806_wallet_seeds :: Query
+down_m20260806_wallet_seeds =
+  [sql|
+DROP INDEX idx_wallet_one_time_addresses_user;
+
+DROP TABLE wallet_one_time_addresses;
+
+DROP INDEX idx_users_wallet_seed_id;
+
+ALTER TABLE users DROP COLUMN wallet_scanned_to;
+ALTER TABLE users DROP COLUMN wallet_account_index;
+ALTER TABLE users DROP COLUMN wallet_seed_id;
+
+DROP TABLE wallet_seeds;
+|]

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

@@ -53,7 +53,10 @@ CREATE TABLE users(
   active_order INTEGER NOT NULL DEFAULT 0,
   auto_accept_member_contacts INTEGER NOT NULL DEFAULT 0,
   is_user_chat_relay INTEGER NOT NULL DEFAULT 0,
-  client_service INTEGER NOT NULL DEFAULT 0, -- 1 for active user
+  client_service INTEGER NOT NULL DEFAULT 0,
+  wallet_seed_id INTEGER REFERENCES wallet_seeds ON DELETE RESTRICT,
+  wallet_account_index INTEGER,
+  wallet_scanned_to TEXT, -- 1 for active user
   FOREIGN KEY(user_id, local_display_name)
   REFERENCES display_names(user_id, local_display_name)
   ON DELETE RESTRICT
@@ -845,6 +848,29 @@ CREATE TABLE rcv_roster_transfers(
   created_at TEXT NOT NULL DEFAULT(datetime('now')),
   updated_at TEXT NOT NULL DEFAULT(datetime('now'))
 ) STRICT;
+CREATE TABLE wallet_seeds(
+  wallet_seed_id INTEGER PRIMARY KEY AUTOINCREMENT,
+  seed BLOB NOT NULL, -- BIP-39 entropy, 16-32 bytes
+  created_at TEXT NOT NULL DEFAULT(datetime('now')),
+  backed_up INTEGER NOT NULL DEFAULT 0, -- user acknowledged saving the recovery key
+  -- High-water mark for account allocation. Deliberately not derived from
+  -- MAX(users.wallet_account_index): after recovery from the phrase alone that
+  -- table is empty while accounts 0..N already hold names on chain, so a new
+  -- profile would silently reuse a recovered account's keys and meta-address.
+-- The recovery probe raises this before any profile is created.
+  next_account_index INTEGER NOT NULL DEFAULT 0
+) STRICT;
+CREATE TABLE wallet_one_time_addresses(
+  wallet_one_time_address_id INTEGER PRIMARY KEY AUTOINCREMENT,
+  user_id INTEGER NOT NULL REFERENCES users ON DELETE CASCADE,
+  chain TEXT NOT NULL, -- 'eth' today; 'btc',
+  'xmr' later
+  address BLOB NOT NULL,
+  ephemeral_pub_key BLOB NOT NULL, -- compressed secp256k1 point, 33 bytes
+  discovered_at TEXT NOT NULL DEFAULT(datetime('now')),
+  accepted_at TEXT, -- NULL = received but not accepted
+  UNIQUE(user_id, chain, address)
+) STRICT;
 CREATE INDEX contact_profiles_index ON contact_profiles(
   display_name,
   full_name
@@ -1379,6 +1405,11 @@ CREATE INDEX idx_files_roster_transfer_id ON files(roster_transfer_id);
 CREATE INDEX idx_chat_items_item_signed_by_group_member_id ON chat_items(
   item_signed_by_group_member_id
 );
+CREATE INDEX idx_users_wallet_seed_id ON users(wallet_seed_id);
+CREATE INDEX idx_wallet_one_time_addresses_user ON wallet_one_time_addresses(
+  user_id,
+  chain
+);
 CREATE TRIGGER on_group_members_insert_update_summary
 AFTER INSERT ON group_members
 FOR EACH ROW

src/Simplex/Chat/Store/Wallets.hs

@@ -0,0 +1,120 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+-- | Persistence for wallet seeds and per-profile accounts.
+--
+-- The schema holds several seeds and binds each chat profile to one of them
+-- plus its own account index. Only the single-seed case is reachable from the
+-- UI: 'getOrCreateAccountRef' reuses the database's first seed and allocates the
+-- next free account index.
+module Simplex.Chat.Store.Wallets
+  ( getWalletSeeds,
+    getWalletSeed,
+    createWalletSeed,
+    getAccountRef,
+    bindAccount,
+    getOrCreateAccountRef,
+    getNextAccountIndex,
+  )
+where
+
+import Data.ByteString (ByteString)
+import Data.Int (Int64)
+import Data.Maybe (listToMaybe)
+import Simplex.Chat.Store.Shared (insertedRowId)
+import Simplex.Chat.Types (User (..))
+import Simplex.Chat.Wallet (AccountIndex, AccountRef (..), SeedId (..), WalletSeed (..))
+import Simplex.Messaging.Agent.Store.AgentStore (maybeFirstRow)
+import qualified Simplex.Messaging.Agent.Store.DB as DB
+
+#if defined(dbPostgres)
+import Database.PostgreSQL.Simple (Only (..))
+#else
+import Database.SQLite.Simple (Only (..))
+#endif
+
+toSeed :: (Int64, ByteString, Bool) -> WalletSeed
+toSeed (sId, seed, backedUp) = WalletSeed {wsId = SeedId sId, wsEntropy = seed, wsBackedUp = backedUp}
+
+getWalletSeeds :: DB.Connection -> IO [WalletSeed]
+getWalletSeeds db =
+  map toSeed
+    <$> DB.query_ db "SELECT wallet_seed_id, seed, backed_up FROM wallet_seeds ORDER BY wallet_seed_id"
+
+getWalletSeed :: DB.Connection -> SeedId -> IO (Maybe WalletSeed)
+getWalletSeed db (SeedId sId) =
+  maybeFirstRow toSeed $
+    DB.query db "SELECT wallet_seed_id, seed, backed_up FROM wallet_seeds WHERE wallet_seed_id = ?" (Only sId)
+
+-- | Insert a seed. Callers generate the entropy; this module never does, so the
+-- DRG stays with the agent.
+createWalletSeed :: DB.Connection -> ByteString -> IO WalletSeed
+createWalletSeed db seed = do
+  DB.execute db "INSERT INTO wallet_seeds (seed) VALUES (?)" (Only seed)
+  sId <- insertedRowId db
+  pure WalletSeed {wsId = SeedId sId, wsEntropy = seed, wsBackedUp = False}
+
+getAccountRef :: DB.Connection -> User -> IO (Maybe AccountRef)
+getAccountRef db User {userId} = do
+  r <-
+    maybeFirstRow id $
+      DB.query db "SELECT wallet_seed_id, wallet_account_index FROM users WHERE user_id = ?" (Only userId)
+  pure $ case r of
+    Just (Just sId, Just ix) -> Just AccountRef {arSeedId = SeedId sId, arIndex = fromIntegral (ix :: Int64)}
+    _ -> Nothing
+
+bindAccount :: DB.Connection -> User -> AccountRef -> IO ()
+bindAccount db User {userId} AccountRef {arSeedId = SeedId sId, arIndex} =
+  DB.execute
+    db
+    "UPDATE users SET wallet_seed_id = ?, wallet_account_index = ? WHERE user_id = ?"
+    (sId, fromIntegral arIndex :: Int64, userId)
+
+-- | Bind this profile to a seed, creating one from @mkSeed@ if the database has
+-- none yet, and allocating the next free account index.
+--
+-- Single-seed by construction: it always picks the first existing seed. When
+-- multiple seeds become selectable this is the one function that changes.
+getOrCreateAccountRef :: DB.Connection -> User -> IO ByteString -> IO (WalletSeed, AccountRef)
+getOrCreateAccountRef db user mkSeed = do
+  existing <- getAccountRef db user
+  -- Load the seed this profile is actually bound to. Picking the first row in
+  -- the table instead would silently re-bind a profile whenever a second seed
+  -- exists - which is exactly what importing a recovery key creates - throwing
+  -- away the imported key and moving the profile to a new account index, so
+  -- the names it already owned stop being derivable too.
+  bound <- case existing of
+    Just r -> fmap (\s -> (r, s)) <$> getWalletSeed db (arSeedId r)
+    Nothing -> pure Nothing
+  case bound of
+    Just (r, s) -> pure (s, r)
+    Nothing -> do
+      seeds <- getWalletSeeds db
+      s <- case listToMaybe seeds of
+        Just s -> pure s
+        Nothing -> mkSeed >>= createWalletSeed db
+      ix <- takeAccountIndex db (wsId s)
+      let r = AccountRef {arSeedId = wsId s, arIndex = ix}
+      bindAccount db user r
+      pure (s, r)
+
+-- | Take the next account index and advance the seed's high-water mark.
+--
+-- The mark is stored rather than computed as @MAX(users.wallet_account_index)@,
+-- because after recovery from the phrase alone the @users@ table is empty while
+-- accounts @0..N@ already hold names on chain. Computing it would hand the first
+-- newly created profile index 0 and, with it, a recovered account's keys.
+takeAccountIndex :: DB.Connection -> SeedId -> IO AccountIndex
+takeAccountIndex db sId@(SeedId sId') = do
+  ix <- getNextAccountIndex db sId
+  DB.execute db "UPDATE wallet_seeds SET next_account_index = ? WHERE wallet_seed_id = ?" (fromIntegral ix + 1 :: Int64, sId')
+  pure ix
+
+getNextAccountIndex :: DB.Connection -> SeedId -> IO AccountIndex
+getNextAccountIndex db (SeedId sId) =
+  maybe 0 (fromIntegral :: Int64 -> AccountIndex)
+    <$> ( maybeFirstRow fromOnly $
+            DB.query db "SELECT next_account_index FROM wallet_seeds WHERE wallet_seed_id = ?" (Only sId)
+        )

src/Simplex/Chat/View.hs

@@ -53,6 +53,7 @@ import Simplex.Chat.Remote.Types
 import Simplex.Chat.Store (AddressSettings (..), AutoAccept (..), StoreError (..), UserContactLink (..))
 import Simplex.Chat.Styled
 import Simplex.Chat.Names (SimplexDomainClaim (..), claimDomain)
+import Simplex.Chat.Names.Protocol (NameRegPhase (..))
 import Simplex.Chat.Types
 import Simplex.Chat.Types.Preferences
 import Simplex.Chat.Types.Shared
@@ -188,6 +189,8 @@ chatResponseToView hu cfg@ChatConfig {logLevel, showReactions, showFullLinks, te
   CRContactRequestRejected u UserContactRequest {localDisplayName = c} _ct_ -> ttyUser u [ttyContact c <> ": contact request rejected"]
   CRServiceResponse u resp -> ttyUser u ["service response: " <> viewJSON resp]
   CRServiceReplyAccepted u (AgentConnId cId) -> ttyUser u [plain $ "service reply accepted, connection id: " <> safeDecodeUtf8 (strEncode cId)]
+  CRNameRegistered u nm owner expiry txHash ->
+    ttyUser u [plain $ "name registered: " <> nm <> " -> " <> owner <> " (expires " <> tshow expiry <> ", tx " <> safeDecodeUtf8 (strEncode txHash) <> ")"]
   CRGroupCreated u g -> ttyUser u $ viewGroupCreated g testView
   CRPublicGroupCreated u g _groupLink _relays -> ttyUser u $ viewGroupCreated g testView
   CRPublicGroupCreationFailed u results -> ttyUser u $ viewPublicGroupCreationFailed results
@@ -474,6 +477,14 @@ chatEventToView hu ChatConfig {logLevel, showReactions, showReceipts, testView}
         <> maybe [] (\k -> [plain $ "signed by " <> safeDecodeUtf8 (strEncode k)]) sigKey_
         <> ["request: " <> viewJSON req]
   CEvtServiceReplySent (AgentConnId cId) -> [plain $ "service reply sent, connection id: " <> safeDecodeUtf8 (strEncode cId)]
+  CEvtNameRegistrationProgress u nm regPhase waitMs ->
+    ttyUser u [plain $ "name " <> nm <> ": " <> phaseText]
+    where
+      phaseText = case regPhase of
+        NRPhaseCommitting -> "committing"
+        NRPhaseCommitted -> "committed" <> maybe "" (\ms -> ". waiting " <> tshow (ms `div` 1000) <> "s before revealing") waitMs
+        NRPhaseRevealing -> "revealing"
+        NRPhaseRegistered -> "registered"
   CEvtContactRequestRejected u Contact {localDisplayName = c} _reason -> ttyUser u [ttyContact c <> ": contact request rejected"]
   CEvtRcvFileStart u ci -> ttyUser u $ receivingFile_' hu testView "started" ci
   CEvtRcvFileComplete u ci -> ttyUser u $ receivingFile_' hu testView "completed" ci

src/Simplex/Chat/Wallet.hs

@@ -0,0 +1,97 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+-- | The wallet: BIP-39 seeds, and the per-chat-profile accounts derived from
+-- them.
+--
+--   * __seed__ — BIP-39 entropy. Generic and profile-scoped, /not/ name-specific.
+--   * __account__ — a profile's slot in a seed, index @i@, holding the main
+--     address that owns the names the profile registers.
+--   * __wallet__ — this module: creation and derivation.
+--
+-- Names are a /consumer/ of the wallet, which is why this sits here rather than
+-- under "Simplex.Chat.Names".
+--
+-- The schema allows several seeds; a profile binds to exactly one plus its own
+-- account index. Only the single-seed case is reachable today.
+--
+-- This module is pure. Persistence lives in "Simplex.Chat.Store.Wallets".
+--
+-- This is the read-only subset needed to register a name: no signing, no
+-- stealth keys, no recovery-phrase import or export. Those are additive —
+-- the types here match the full wallet, so adding them changes no signature.
+module Simplex.Chat.Wallet
+  ( SeedId (..),
+    WalletSeed (..),
+    AccountIndex,
+    AccountRef (..),
+    WalletAccount (..),
+    newSeed,
+    deriveAccount,
+    accountAddress,
+  )
+where
+
+import Control.Concurrent.STM
+import Crypto.Random (ChaChaDRG)
+import Data.ByteString (ByteString)
+import Data.Int (Int64)
+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 (Address, addressFromPrivateKey, ethereumPath)
+
+newtype SeedId = SeedId Int64
+  deriving (Eq, Ord, Show)
+
+-- | BIP-44 account index within a seed. One per chat profile.
+type AccountIndex = Word32
+
+-- | A seed, held as BIP-39 entropy. Stored in the chat database so it rides the
+-- existing archive export and Migrate-to-another-device flows.
+--
+-- 'Show' is redacting: this is the root secret behind every name it owns.
+data WalletSeed = WalletSeed
+  { wsId :: SeedId,
+    wsEntropy :: ByteString,
+    wsBackedUp :: Bool
+  }
+  deriving (Eq)
+
+instance Show WalletSeed where
+  show s = "WalletSeed " <> show (wsId s) <> " <redacted, backedUp=" <> show (wsBackedUp s) <> ">"
+
+-- | What a chat profile stores: which seed, and which account index within it.
+data AccountRef = AccountRef
+  { arSeedId :: SeedId,
+    arIndex :: AccountIndex
+  }
+  deriving (Eq, Show)
+
+-- | A derived account: the reference plus the key it resolves to.
+data WalletAccount = WalletAccount
+  { waRef :: AccountRef,
+    waKey :: S.PrivateKey
+  }
+  deriving (Eq)
+
+instance Show WalletAccount where
+  show a = "WalletAccount " <> show (waRef a) <> " <redacted>"
+
+-- | Fresh seed entropy. The caller stores it; this module never persists.
+-- A 25th-word passphrase is deliberately not used — it would be a second secret
+-- to back up.
+newSeed :: B39.MnemonicStrength -> TVar ChaChaDRG -> STM ByteString
+newSeed strength g = B39.mnemonicToEntropy <$> B39.randomMnemonic strength g
+
+-- | Derive the account at @m\/44'\/60'\/i'\/0\/0@.
+deriveAccount :: WalletSeed -> AccountIndex -> Either String WalletAccount
+deriveAccount s ix = do
+  m <- B39.entropyToMnemonic (wsEntropy s)
+  master <- B32.masterKey (B39.mnemonicToSeed m "")
+  xk <- B32.derivePath master (ethereumPath ix)
+  pure WalletAccount {waRef = AccountRef {arSeedId = wsId s, arIndex = ix}, waKey = B32.xkKey xk}
+
+-- | The Ethereum address that owns names registered by this account.
+accountAddress :: WalletAccount -> Address
+accountAddress = addressFromPrivateKey . waKey

tests/Bots/NamesServiceTests.hs

@@ -0,0 +1,131 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE PostfixOperators #-}
+
+module Bots.NamesServiceTests where
+
+import Bots.BadgeServiceTests (badgeProfile, mkBadgeServiceOpts, runBadgeService, serviceDbPrefix, withBadgeService)
+import ChatClient
+import ChatTests.DBUtils
+import ChatTests.Utils
+import Data.List (isPrefixOf)
+import qualified Data.Aeson as J
+import qualified Data.ByteString as B
+import qualified Data.ByteString.Lazy.Char8 as LB
+import Data.Char (isHexDigit)
+import Simplex.Chat.Names.Protocol
+import Simplex.Messaging.Encoding.String (strEncode)
+import Simplex.Messaging.Eth.Address (parseAddress)
+import Simplex.Messaging.Eth.Keccak (keccak256)
+import Test.Hspec hiding (it)
+import qualified Test.Hspec as Hspec
+
+namesServiceTests :: SpecWith TestParams
+namesServiceTests = do
+  it "registers a name via commit/reveal and rejects a taken name" testNamesRegister
+  it "derives the same owner address after restart" testSeedPersists
+
+-- | Pins the wire format. The end-to-end test cannot catch a key renamed on
+-- both sides at once, so the encodings are asserted literally here.
+namesProtocolTests :: Spec
+namesProtocolTests = do
+  Hspec.it "encodes commit and reveal requests" $ do
+    -- on-chain byte values are 0x-prefixed hex, as Ethereum writes them
+    encodes (NamesRequest 1 (NRCommit $ Commitment "0123456789abcdef")) $
+      "{\"version\":1,\"request\":{\"type\":\"commit\",\"commitment\":\"0x30313233343536373839616263646566\"}}"
+    encodes (NamesRequest 1 (NRReveal "alice.simplex" testOwner (NameSecret "s") 3600 "simplex:/contact#/x")) $
+      "{\"version\":1,\"request\":{\"type\":\"reveal\",\"name\":\"alice.simplex\""
+        <> ",\"owner\":\"0x520110C7b1CE17f8C0a2778B41AB2F23D10B70B0\",\"secret\":\"0x73\""
+        <> ",\"ttl\":3600,\"simplex_link\":\"simplex:/contact#/x\"}}"
+    encodes (NRPError NECNameTaken Nothing Nothing) "{\"type\":\"error\",\"code\":\"name_taken\"}"
+  Hspec.it "roundtrips requests and responses" $ do
+    roundtrips $ NamesRequest 1 (NRCommit $ Commitment "0123456789abcdef")
+    roundtrips $ NamesRequest 1 (NRReveal "alice.simplex" testOwner (NameSecret "s") 3600 "simplex:/contact#/x")
+    roundtrips $ NRPCommitted (TxHash "tx")
+    roundtrips $ NRPError NECNameTaken Nothing Nothing
+    roundtrips $ NRPError (NECUnknown "future_code") (Just "why") (Just 30)
+  Hspec.it "renders a 32-byte hash as 0x + 64 hex digits" $ do
+    let h = strEncode $ TxHash (keccak256 "reveal")
+    B.length h `shouldBe` 66
+    B.take 2 h `shouldBe` "0x"
+    B.all (\c -> isHexDigit (toEnum $ fromIntegral c)) (B.drop 2 h) `shouldBe` True
+  Hspec.it "binds the commitment to every field" $ do
+    let c = mkCommitment "alice.simplex" testOwner (NameSecret "s") 3600
+    -- the service recomputes it at reveal, so it must be deterministic
+    c `shouldBe` mkCommitment "alice.simplex" testOwner (NameSecret "s") 3600
+    c `shouldNotBe` mkCommitment "bob.simplex" testOwner (NameSecret "s") 3600
+    c `shouldNotBe` mkCommitment "alice.simplex" testOwner (NameSecret "s2") 3600
+    c `shouldNotBe` mkCommitment "alice.simplex" testOwner (NameSecret "s") 7200
+  where
+    testOwner = either error id $ parseAddress "0x520110C7b1CE17f8C0a2778B41AB2F23D10B70B0"
+    -- compares parsed values, so the assertion does not depend on key order
+    encodes :: J.ToJSON a => a -> LB.ByteString -> Expectation
+    encodes x s = Just (J.toJSON x) `shouldBe` J.decode s
+    roundtrips :: (Eq a, Show a, J.ToJSON a, J.FromJSON a) => a -> Expectation
+    roundtrips x = J.eitherDecode' (J.encode x) `shouldBe` Right x
+
+-- | End-to-end: @/name register@ streams the commit → wait → reveal phases and
+-- resolves to the owner address derived from the wallet seed; a second
+-- registration of the same name fails with name_taken.
+testNamesRegister :: HasCallStack => TestParams -> IO ()
+testNamesRegister ps =
+  withBadgeService ps $ \client bsLink -> do
+    client ##> ("/name register " <> bsLink <> " alice.simplex simplex:/contact#/first")
+    commitPhases client
+    -- the final progress event and the command response arrive on separate channels
+    client
+      <### [ ConsoleString "name alice.simplex: registered",
+             StartsWith "name registered: alice.simplex -> 0x"
+           ]
+    -- re-running the identical command is rejected too, not silently accepted:
+    -- the owner is the same within a session, so this is the duplicate a user hits.
+    client ##> ("/name register " <> bsLink <> " alice.simplex simplex:/contact#/first")
+    commitPhases client
+    client <## "bad chat command: name registration failed: name_taken"
+    -- and the same name pointed at a different link is equally rejected
+    client ##> ("/name register " <> bsLink <> " alice.simplex simplex:/contact#/second")
+    commitPhases client
+    client <## "bad chat command: name registration failed: name_taken"
+  where
+    commitPhases client = do
+      client <## "name alice.simplex: committing"
+      client <## "name alice.simplex: committed. waiting 1s before revealing"
+      client <## "name alice.simplex: revealing"
+
+-- | The seed is persisted, so a name registered in one session is still owned by
+-- an address the next session can derive. Without this the key is unrecoverable
+-- after restart and the name is orphaned.
+testSeedPersists :: HasCallStack => TestParams -> IO ()
+testSeedPersists ps = do
+  let opts = mkBadgeServiceOpts ps
+  withNewTestChatCfg ps testCfg serviceDbPrefix badgeProfile $ \_ -> pure ()
+  runBadgeService testCfg opts (pure ())
+  bsLink <- withTestChat ps serviceDbPrefix $ \bs -> do
+    bs <## "subscribed 1 connections on server localhost"
+    bs ##> "/sa"
+    (sLink, _) <- getContactLinks bs False
+    bs <## "auto_accept off"
+    pure sLink
+  runBadgeService testCfg opts $ do
+    owner1 <- withNewTestChatCfg ps testCfg "client" bobProfile $ \client -> do
+      client ##> ("/name register " <> bsLink <> " first.simplex simplex:/contact#/x")
+      ownerOf client "first.simplex"
+    -- same database, new session: the seed has to come back from the DB
+    owner2 <- withTestChat ps "client" $ \client -> do
+      client ##> ("/name register " <> bsLink <> " second.simplex simplex:/contact#/y")
+      ownerOf client "second.simplex"
+    owner2 `shouldBe` owner1
+  where
+    -- Reads past startup and progress lines to the registration result, and
+    -- keeps reading until the final progress event has arrived too — it races
+    -- with the command response and would otherwise be left unconsumed.
+    ownerOf client nm = go (40 :: Int) Nothing False
+      where
+        pfx = "name registered: " <> nm <> " -> "
+        lastEvt = "name " <> nm <> ": registered"
+        go _ (Just a) True = pure a
+        go 0 _ _ = error $ "no registration line for " <> nm
+        go n addr seen = do
+          l <- getTermLine client
+          let addr' = if pfx `isPrefixOf` l then Just (takeWhile (/= ' ') $ drop (length pfx) l) else addr
+          go (n - 1) addr' (seen || l == lastEvt)
+

tests/Test.hs

@@ -5,6 +5,7 @@
 
 import Bots.BadgeServiceTests
 import Bots.BroadcastTests
+import Bots.NamesServiceTests (namesProtocolTests, namesServiceTests)
 import Bots.DirectoryTests
 import ChatClient
 import ChatTests
@@ -66,6 +67,7 @@ main = do
       describe "Supporter badges" badgeTests
       describe "SimpleX chat markdown" markdownTests
       describe "JSON Tests" jsonTests
+      describe "SimpleX names protocol" namesProtocolTests
       describe "Member relations" memberRelationsTests
       describe "SimpleX chat view" viewTests
       describe "SimpleX chat protocol" protocolTests
@@ -90,6 +92,7 @@ main = do
           xdescribe'' "SimpleX Broadcast bot" broadcastBotTests
           xdescribe'' "SimpleX Directory service bot" directoryServiceTests
           xdescribe'' "SimpleX Badge service bot" badgeServiceTests
+          xdescribe'' "SimpleX Names service" namesServiceTests
           describe "Remote session" remoteTests
 #if !defined(dbPostgres)
           xdescribe'' "Save query plans" saveQueryPlans