remove same link, use simplexmq instead

src/Simplex/Chat/Library/Commands.hs

@@ -1503,7 +1503,11 @@ processChatCommand cxt nm = \case
       let SimplexNameInfo {nameDomain = domain} = name
       a <- asks smpAgent
       NameRecord {nrSimplexContact} <- liftIO (runExceptT $ resolveSimplexName a nm (aUserId user) domain) >>= either (throwError . chatErrorAgent) pure
-      unless (any (`linksMatch` ourLink) nrSimplexContact) $ throwCmdError "name is not registered to your address"
+      -- the registry resolves a name to short links; require it to point to our address's short link
+      let resolvesHere resolved = case strDecode (encodeUtf8 resolved) :: Either String AConnectionLink of
+            Right (ACL SCMContact (CLShort sl)) -> maybe False (sameShortLinkContact sl) ourShort_
+            _ -> False
+      unless (any resolvesHere nrSimplexContact) $ throwCmdError "name is not registered to your address"
     -- §4.9 step 3: a name in the profile must carry its address, so write the address short link into contactLink
     -- alongside the name. updateProfile_ then re-publishes the address (signing the proof) and broadcasts to contacts.
     let p' = (fromLocalProfile oldLP :: Profile) {contactDomain = StrJSON <$> name_, contactLink = maybe oldContactLink (const (Just ourLink)) name_}
@@ -3142,7 +3146,10 @@ processChatCommand cxt nm = \case
             let SimplexNameInfo {nameDomain = domain} = name
             a <- asks smpAgent
             NameRecord {nrSimplexChannel} <- liftIO (runExceptT $ resolveSimplexName a nm (aUserId user) domain) >>= either (throwError . chatErrorAgent) pure
-            unless (any (`linksMatch` CLShort groupLink) nrSimplexChannel) $ throwCmdError "name is not registered to this channel"
+            let resolvesHere resolved = case strDecode (encodeUtf8 resolved) :: Either String AConnectionLink of
+                  Right (ACL SCMContact (CLShort sl)) -> sameShortLinkContact sl groupLink
+                  _ -> False
+            unless (any resolvesHere nrSimplexChannel) $ throwCmdError "name is not registered to this channel"
         runUpdateGroupProfile user gInfo p {publicGroup = Just pg {publicGroupAccess = Just (signChannelNameProof gInfo pg access)}}
       Nothing -> throwChatError $ CECommandError "not a public group"
   APICreateGroupLink groupId mRole -> withUser $ \user -> withGroupLock "createGroupLink" groupId $ do
@@ -4845,26 +4852,6 @@ firstNameLink nameType simplexChannel simplexContact ni =
       NTPublicGroup -> simplexChannel
       NTContact -> simplexContact
 
--- | Best-effort comparison between an RSLV-resolved link (a 'Text' from the
--- name record) and the peer's stored connection link. Both are normalized via
--- 'strDecode' + 'strEncode' so scheme drift (simplex:/ vs https://simplex.chat)
--- doesn't cause a false negative. If the RSLV text fails to parse as a contact
--- link, we treat it as a mismatch — the resolver returned something we don't
--- understand, which is not a valid verification.
-linksMatch :: Text -> ConnLinkContact -> Bool
-linksMatch resolved stored = case strDecode (encodeUtf8 resolved) :: Either String AConnectionLink of
-  Right (ACL SCMContact resolvedLink) -> normalize resolvedLink == normalize stored
-  _ -> False
-  where
-    -- Mirror the inline 'serverShortLink' helper used elsewhere in this module:
-    -- the agent's simplex:/ scheme and the server-hostname scheme encode the
-    -- same link; verification must be scheme-insensitive.
-    normalize :: ConnLinkContact -> ByteString
-    normalize = \case
-      CLFull cReq -> strEncode cReq
-      CLShort (CSLContact _ ct srv linkKey) ->
-        strEncode (CSLContact SLSServer ct srv linkKey :: ConnShortLink 'CMContact)
-
 -- | Resolves the chat row's name claim via RSLV (the agent picks a names
 -- server) and compares the resolved per-type link to the peer's stored
 -- connection link. Persists the 3-state verification result. Returns
@@ -4928,14 +4915,7 @@ apiVerifySimplexName user nm chatRef = do
     -- the proof must be bound (anti-replay) to the link the peer was connected through
     proofBoundTo :: NameClaimProof -> AConnShortLink -> Bool
     proofBoundTo NameClaimProof {presHeader} connLink =
-      (normASL <$> proofPresHeaderLink presHeader) == Just (normASL connLink)
-      where
-        -- compare scheme-insensitively (simplex:/ vs server-hostname), as linksMatch does, so a proof
-        -- minted in one scheme still matches the stored link in the other
-        normASL :: AConnShortLink -> ByteString
-        normASL (ACSL m sl) = strEncode $ ACSL m $ case sl of
-          CSLInvitation _ srv lnkId linkKey -> CSLInvitation SLSServer srv lnkId linkKey
-          CSLContact _ ct srv linkKey -> CSLContact SLSServer ct srv linkKey
+      maybe False (`sameConnShortLink` connLink) (proofPresHeaderLink presHeader)
     -- verify the proof signature against the resolved name's owner key
     -- Maybe Bool: Just = a determined result for this resolved link; Nothing = couldn't fetch it
     -- (network/agent error) so the result is undetermined — never recorded as a failed verification.

tests/ResolveNameTests.hs

@@ -1,25 +1,18 @@
-{-# LANGUAGE DataKinds #-}
-{-# LANGUAGE GADTs #-}
 {-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE PatternSynonyms #-}
 
 module ResolveNameTests (resolveNameTests) where
 
 import Data.Text (Text)
-import qualified Data.Text.Encoding as T
 import Simplex.Chat.Controller (ChatError (..), ChatErrorType (..))
-import Simplex.Chat.Library.Commands (firstNameLink, linksMatch)
-import Simplex.Messaging.Agent.Protocol (AConnectionLink (..), ConnShortLink, ConnectionLink (..), ConnectionMode (..), SConnectionMode (..), SimplexNameDomain (..), SimplexNameInfo (..), SimplexNameType (..), SimplexTLD (..))
-import Simplex.Messaging.Encoding.String (strDecode)
+import Simplex.Chat.Library.Commands (firstNameLink)
+import Simplex.Messaging.Agent.Protocol (SimplexNameDomain (..), SimplexNameInfo (..), SimplexNameType (..), SimplexTLD (..))
 import Test.Hspec
 
--- Name resolution and verification are owned by the agent (resolveSimplexName),
--- and failures flow through ChatErrorAgent — there is no chat-side iteration or
--- error-translation layer to test. These specs cover the two pure helpers that
--- remain in the chat layer: firstNameLink (link selection) and linksMatch
--- (verification comparison).
+-- Name resolution/verification is owned by the agent (resolveSimplexName), and link comparison
+-- uses the agent's sameConnShortLink / sameShortLinkContact. The only pure helper remaining in the
+-- chat layer to cover here is firstNameLink (per-type link selection).
 resolveNameTests :: Spec
-resolveNameTests = do
+resolveNameTests =
   -- firstNameLink is the pure link-picker used by dispatchResolvedRecord:
   -- it selects nrSimplexContact for NTContact, nrSimplexChannel for NTPublicGroup.
   -- An empty link for the queried type collapses to CESimplexNameNotFound so the
@@ -55,52 +48,6 @@ resolveNameTests = do
       case firstNameLink NTContact [channelLink] [] aliceNi of
         Left (ChatError (CESimplexNameNotFound ni)) -> ni `shouldBe` aliceNi
         other -> expectationFailure $ "expected CESimplexNameNotFound, got " <> show other
-  -- linksMatch is the byte-equal-after-normalize comparator that gates
-  -- APIVerifySimplexName. The agent's simplex:/ scheme and the server-hostname
-  -- scheme encode the same link, so a successful verification must accept
-  -- either side using either scheme. A malformed RSLV link (anything that
-  -- doesn't parse as a contact link) is rejected.
-  describe "linksMatch" $ do
-    let storedShort = CLShort sampleShortLinkServer
-    it "matches an RSLV link in server scheme against a stored short-link" $
-      linksMatch sampleShortLinkServerText storedShort `shouldBe` True
-    it "matches across scheme normalization (simplex:/ vs https://)" $
-      linksMatch sampleShortLinkSimplexText storedShort `shouldBe` True
-    it "rejects a non-contact-link RSLV payload" $
-      linksMatch "not-a-link" storedShort `shouldBe` False
-    it "rejects a structurally different short-link" $
-      linksMatch differentShortLinkText storedShort `shouldBe` False
-    it "matches an invitation-shaped link only if both sides parse as contact" $
-      -- invitation-typed RSLV link is not CMContact and must be rejected even
-      -- if the bytes look superficially similar.
-      linksMatch invitationLikeText storedShort `shouldBe` False
-
--- | Known-good short contact link in server-hostname scheme. Mirrors the
--- canonical encoding from simplexmq's ConnectionRequestTests.hs:
--- @CSLContact SLSServer CCTContact srv (LinkKey ...)@.
-sampleShortLinkServerText :: Text
-sampleShortLinkServerText = "https://smp.simplex.im/a#MDEyMzQ1Njc4OWFiY2RlZjAxMjM0NTY3ODlhYmNkZWY?h=jjbyvoemxysm7qxap7m5d5m35jzv5qq6gnlv7s4rsn7tdwwmuqciwpid.onion&p=5223&c=1234-w"
-
--- | The same link as 'sampleShortLinkServerText' but in the agent's
--- simplex:/ scheme. normalize must collapse these to byte-equal forms.
-sampleShortLinkSimplexText :: Text
-sampleShortLinkSimplexText = "simplex:/a#MDEyMzQ1Njc4OWFiY2RlZjAxMjM0NTY3ODlhYmNkZWY?h=smp.simplex.im%2Cjjbyvoemxysm7qxap7m5d5m35jzv5qq6gnlv7s4rsn7tdwwmuqciwpid.onion&p=5223&c=1234-w"
-
--- | Structurally different short link (different LinkKey). Must NOT match.
-differentShortLinkText :: Text
-differentShortLinkText = "https://smp.simplex.im/a#YWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWE?h=jjbyvoemxysm7qxap7m5d5m35jzv5qq6gnlv7s4rsn7tdwwmuqciwpid.onion&p=5223&c=1234-w"
-
--- | An invitation-shaped link (path /i not /a). Even if the bytes happen to
--- parse as some AConnectionLink, the SCMContact projection must fail.
-invitationLikeText :: Text
-invitationLikeText = "https://smp.simplex.im/i#MDEyMzQ1Njc4OWFiY2RlZjAxMjM0NTY3ODlhYmNkZWY?h=jjbyvoemxysm7qxap7m5d5m35jzv5qq6gnlv7s4rsn7tdwwmuqciwpid.onion&p=5223&c=1234-w"
-
--- | Parsed form of 'sampleShortLinkServerText' for use as the stored side
--- of the linksMatch comparison.
-sampleShortLinkServer :: ConnShortLink 'CMContact
-sampleShortLinkServer = case strDecode (T.encodeUtf8 sampleShortLinkServerText) of
-  Right (ACL SCMContact (CLShort l)) -> l
-  other -> error $ "ResolveNameTests fixture failed to parse: " <> show other
 
 aliceNi :: SimplexNameInfo
 aliceNi = SimplexNameInfo NTContact (SimplexNameDomain TLDSimplex "alice" [])