add /name address getter and more tests

bots/src/API/Docs/Commands.hs

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

bots/src/API/Docs/Responses.hs

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

src/Simplex/Chat/Controller.hs

@@ -415,6 +415,7 @@ data ChatCommand
   | APISendServiceRequest {userId :: UserId, sendTarget :: ConnectTarget 'CMContact, requestTimeout :: Maybe NominalDiffTime, signKey :: Maybe (C.StoredPrivateKey 'C.Ed25519), request :: J.Object}
   | APISendServiceResponse {userId :: UserId, requestId :: AgentInvId, responseData :: J.Object}
   | APINameRegister {sendTarget :: ConnectTarget 'CMContact, regName :: Text, registerLink :: Text}
+  | APINameAddress
   | APISendCallInvitation ContactId CallType
   | SendCallInvitation ContactName CallType
   | APIRejectCall ContactId
@@ -842,6 +843,7 @@ data ChatResponse
   | CRServiceResponse {user :: User, responseData :: J.Object}
   | CRServiceReplyAccepted {user :: User, connectionId :: AgentConnId}
   | CRNameRegistered {user :: User, regName :: Text, regOwner :: Text, regExpiry :: UTCTime, regTxHash :: TxHash}
+  | CRNameAddress {user :: User, nameAddress :: Maybe Text}
   | CRUserAcceptedGroupSent {user :: User, groupInfo :: GroupInfo, hostContact :: Maybe Contact}
   | CRUserDeletedMembers {user :: User, groupInfo :: GroupInfo, members :: [GroupMember], withMessages :: Bool, msgSigned :: Bool}
   | CRGroupsList {user :: User, groups :: [GroupInfo]}

src/Simplex/Chat/Help.hs

@@ -226,6 +226,7 @@ namesHelpInfo =
     [ green "SimpleX name commands:",
       indent <> highlight "/name register <service> <name> <simplex_link>",
       indent <> indent <> " - register a name for your address or channel",
+      indent <> highlight "/name address" <> " - show the address that owns the names you register",
       "",
       green "Arguments:",
       indent <> highlight "<service>     " <> " - address of the names service to register with",

src/Simplex/Chat/Library/Commands.hs

@@ -60,7 +60,7 @@ 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.Store.Wallets (boundAccount, getOrCreateAccountRef)
 import Simplex.Chat.Wallet (AccountRef (..), accountAddress, deriveAccount, newSeed)
 import Simplex.Chat.Call
 import Simplex.Chat.Controller
@@ -1499,6 +1499,13 @@ processChatCommand cxt nm = \case
         (seed, AccountRef {arIndex}) <-
           withFastStore' $ \db -> getOrCreateAccountRef db user (atomically $ newSeed MS256 g)
         either (throwCmdError . ("wallet: " <>)) (pure . accountAddress) $ deriveAccount seed arIndex
+  APINameAddress -> withUser $ \user -> do
+    -- Read-only: never creates a seed. A key appears when you register a name,
+    -- not when you ask which address you have.
+    acc_ <- withFastStore' $ \db -> boundAccount db user
+    addr <- forM acc_ $ \(seed, AccountRef {arIndex}) ->
+      either (throwCmdError . ("wallet: " <>)) (pure . tshow . accountAddress) $ deriveAccount seed arIndex
+    pure $ CRNameAddress user addr
   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)
@@ -5579,6 +5586,7 @@ chatCommandP =
       "/_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),
+      "/name address" $> APINameAddress,
       "/_call invite @" *> (APISendCallInvitation <$> A.decimal <* A.space <*> jsonP),
       "/call " *> char_ '@' *> (SendCallInvitation <$> displayNameP <*> pure defaultCallType),
       "/_call reject @" *> (APIRejectCall <$> A.decimal),

src/Simplex/Chat/Store/Wallets.hs

@@ -8,10 +8,11 @@
 -- 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. It is the only export, because it is all that name
--- registration needs; the helpers below stay internal until they have a caller.
+-- next free account index, while 'boundAccount' only reads. Those two are the
+-- exports; the helpers below stay internal until they have a caller.
 module Simplex.Chat.Store.Wallets
   ( getOrCreateAccountRef,
+    boundAccount,
   )
 where
 
@@ -67,6 +68,15 @@ bindAccount db User {userId} AccountRef {arSeedId = SeedId sId, arIndex} =
     "UPDATE users SET wallet_seed_id = ?, wallet_account_index = ? WHERE user_id = ?"
     (sId, fromIntegral arIndex :: Int64, userId)
 
+-- | The seed and account this profile is bound to, or Nothing if it has never
+-- used the wallet. Creates nothing: callers that need a wallet ask the user
+-- first, so a profile is never given keys as a side effect of reading.
+boundAccount :: DB.Connection -> User -> IO (Maybe (WalletSeed, AccountRef))
+boundAccount db user =
+  getAccountRef db user >>= \case
+    Nothing -> pure Nothing
+    Just r -> fmap (\s -> (s, r)) <$> getWalletSeed db (arSeedId r)
+
 -- | Bind this profile to a seed, creating one from @mkSeed@ if the database has
 -- none yet, and allocating the next free account index.
 --

src/Simplex/Chat/View.hs

@@ -190,6 +190,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)]
+  CRNameAddress u addr_ ->
+    ttyUser u [maybe "no name address yet - it is created when you register a name" (plain . ("name address: " <>)) addr_]
   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

tests/Bots/NamesServiceTests.hs

@@ -22,6 +22,8 @@ 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 "rejects a reveal with no matching commitment" testRevealWithoutCommit
+  it "shows the owner address without creating one" testNameAddress
   it "derives the same owner address after restart" testSeedPersists
 
 -- | Pins the wire format. The end-to-end test cannot catch a key renamed on
@@ -91,6 +93,35 @@ testNamesRegister ps =
       client <## "name alice.simplex: committed. waiting 1s before revealing"
       client <## "name alice.simplex: revealing"
 
+-- | @\/name address@ reports the owner address but never creates a seed: asking
+-- which address you have must not be what gives you one. Only registering does.
+testNameAddress :: HasCallStack => TestParams -> IO ()
+testNameAddress ps =
+  withBadgeService ps $ \client bsLink -> do
+    -- asked repeatedly before any registration: still no address, none created
+    client ##> "/name address"
+    client <## "no name address yet - it is created when you register a name"
+    client ##> "/name address"
+    client <## "no name address yet - it is created when you register a name"
+    client ##> ("/name register " <> bsLink <> " carol.simplex simplex:/contact#/x")
+    owner <- ownerOf client "carol.simplex"
+    -- now it exists, and reports the address the name was registered to
+    client ##> "/name address"
+    client <## ("name address: " <> owner)
+
+-- | The front-running defence: a reveal only registers a name if that exact
+-- commitment was published first. Sent as a raw service request, because the
+-- core always commits before revealing and so cannot produce this on its own.
+testRevealWithoutCommit :: HasCallStack => TestParams -> IO ()
+testRevealWithoutCommit ps =
+  withBadgeService ps $ \client bsLink -> do
+    let reveal =
+          "{\"version\":1,\"request\":{\"type\":\"reveal\",\"name\":\"eve.simplex\""
+            <> ",\"owner\":\"0x520110c7b1ce17f8c0a2778b41ab2f23d10b70b0\",\"secret\":\"0x73\""
+            <> ",\"ttl\":3600,\"simplex_link\":\"simplex:/contact#/x\"}}"
+    client ##> ("/_service_request 1 " <> bsLink <> " " <> reveal)
+    client <## "service response: {\"code\":\"bad_request\",\"message\":\"no matching commitment\",\"type\":\"error\"}"
+
 -- | 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.
@@ -114,18 +145,19 @@ testSeedPersists ps = 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)
 
+-- | Reads past startup and progress lines to the registration result, returning
+-- the owner address. Keeps reading until the final progress event has arrived
+-- too — it races with the command response and would otherwise be left
+-- unconsumed, failing the next assertion or the session close.
+ownerOf :: HasCallStack => TestCC -> String -> IO String
+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)