From 0a8756458c4a368b3a581b701b2856eaf25cfa4b Mon Sep 17 00:00:00 2001
From: "Evgeny @ SimpleX Chat"
 <259188159+evgeny-simplex@users.noreply.github.com>
Date: Mon, 25 May 2026 16:20:58 +0000
Subject: [PATCH 01/13] agent: types for namespace support

---
 src/Simplex/Messaging/Agent.hs          |   2 +
 src/Simplex/Messaging/Agent/Protocol.hs | 109 ++++++++++++++++++++----
 2 files changed, 94 insertions(+), 17 deletions(-)

diff --git a/src/Simplex/Messaging/Agent.hs b/src/Simplex/Messaging/Agent.hs
index c466795bf..b868ca63b 100644
--- a/src/Simplex/Messaging/Agent.hs
+++ b/src/Simplex/Messaging/Agent.hs
@@ -1007,6 +1007,7 @@ setConnShortLinkAsync' c corrId connId userLinkData clientData =
     enqueueCommand c corrId connId (Just srv) $ AClientCommand $ LSET userLinkData clientData
 
 getConnShortLinkAsync' :: AgentClient -> UserId -> ACorrId -> Maybe ConnId -> ConnShortLink 'CMContact -> AM ConnId
+getConnShortLinkAsync' c _userId _corrId _connId_ (CSLName _) = throwE $ AGENT $ A_LINK "name resolution not supported"
 getConnShortLinkAsync' c userId corrId connId_ shortLink@(CSLContact _ _ srv _) = do
   connId <- case connId_ of
     Just existingConnId -> do
@@ -1121,6 +1122,7 @@ getConnShortLink' c nm userId = \case
     let (linkId, k) = SL.contactShortLinkKdf linkKey
     ld <- getQueueLink c nm userId srv linkId
     decryptData srv linkKey k ld
+  CSLName _ -> throwE $ AGENT $ A_LINK "name resolution not supported"
   where
     decryptData :: ConnectionModeI c => SMPServer -> LinkKey -> C.SbKey -> (SMP.SenderId, QueueLinkData) -> AM (FixedLinkData c, ConnLinkData c)
     decryptData srv linkKey k (sndId, d) = do
diff --git a/src/Simplex/Messaging/Agent/Protocol.hs b/src/Simplex/Messaging/Agent/Protocol.hs
index 30a2e53d9..e5fc4b14c 100644
--- a/src/Simplex/Messaging/Agent/Protocol.hs
+++ b/src/Simplex/Messaging/Agent/Protocol.hs
@@ -123,6 +123,11 @@ module Simplex.Messaging.Agent.Protocol
     ConnectionLink (..),
     AConnectionLink (..),
     ConnShortLink (..),
+    SimplexNameInfo (..),
+    SimplexNamespace (..),
+    SimplexNameType (..),
+    parseNameFragment,
+    encodeNameFragment,
     AConnShortLink (..),
     CreatedConnLink (..),
     ACreatedConnLink (..),
@@ -195,7 +200,7 @@ import qualified Data.Attoparsec.ByteString.Char8 as A
 import qualified Data.ByteString.Base64.URL as B64
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
-import Data.Char (toLower, toUpper)
+import Data.Char (isSpace, toLower, toUpper)
 import Data.Foldable (find)
 import Data.Functor (($>))
 import Data.Int (Int64)
@@ -1471,6 +1476,21 @@ data ShortLinkScheme = SLSSimplex | SLSServer deriving (Eq, Show)
 data ConnShortLink (m :: ConnectionMode) where
   CSLInvitation :: ShortLinkScheme -> SMPServer -> SMP.LinkId -> LinkKey -> ConnShortLink 'CMInvitation
   CSLContact :: ShortLinkScheme -> ContactConnType -> SMPServer -> LinkKey -> ConnShortLink 'CMContact
+  CSLName :: SimplexNameInfo -> ConnShortLink 'CMContact
+
+data SimplexNameInfo = SimplexNameInfo
+  { nameType :: SimplexNameType,
+    namespace :: SimplexNamespace,
+    domain :: Text,
+    subDomain :: [Text]
+  }
+  deriving (Eq, Show)
+
+data SimplexNamespace = NSSimplex | NSTesting | NSWeb
+  deriving (Eq, Show)
+
+data SimplexNameType = NTPublicGroup | NTContact
+  deriving (Eq, Show)
 
 deriving instance Eq (ConnShortLink m)
 
@@ -1480,6 +1500,7 @@ simplexShortLink :: ConnShortLink m -> ConnShortLink m
 simplexShortLink = \case
   CSLInvitation _ srv lnkId k -> CSLInvitation SLSSimplex srv lnkId k
   CSLContact _ ct srv k -> CSLContact SLSSimplex ct srv k
+  l@(CSLName _) -> l
 
 newtype LinkKey = LinkKey ByteString -- sha3-256(fixed_data)
   deriving (Eq, Show)
@@ -1583,6 +1604,7 @@ instance ConnectionModeI m => StrEncoding (ConnShortLink m) where
   strEncode = \case
     CSLInvitation sch srv (SMP.EntityId lnkId) (LinkKey k) -> slEncode sch srv 'i' lnkId k
     CSLContact sch ct srv (LinkKey k) -> slEncode sch srv (toLower $ ctTypeChar ct) "" k
+    CSLName nameInfo -> "simplex:/name#" <> encodeUtf8 (encodeNameFragment nameInfo)
     where
       slEncode sch (SMPServer (h :| hs) port (C.KeyHash kh)) linkType lnkId k =
         B.concat [authority, "/", B.singleton linkType, "#", lnkIdStr, B64.encodeUnpadded k, queryStr]
@@ -1603,20 +1625,27 @@ instance ConnectionModeI m => StrEncoding (ConnShortLink m) where
 instance StrEncoding AConnShortLink where
   strEncode (ACSL _ l) = strEncode l
   {-# INLINE strEncode #-}
-  strP = do
-    (sch, h_) <- authorityP <* A.char '/'
-    ct_ <- contactTypeP <* optional (A.char '/') <* A.char '#'
-    case ct_ of
-      Nothing -> do
-        lnkId <- strP <* A.char '/'
-        k <- strP
-        srv <- serverQueryP h_
-        pure $ ACSL SCMInvitation $ CSLInvitation sch srv (SMP.EntityId lnkId) (LinkKey k)
-      Just ct -> do
-        k <- strP
-        srv <- serverQueryP h_
-        pure $ ACSL SCMContact $ CSLContact sch ct srv (LinkKey k)
+  strP = nameP <|> serverLinkP
     where
+      nameP = do
+        _ <- "simplex:/name#"
+        frag <- A.takeWhile1 (not . A.isSpace)
+        case parseNameFragment (safeDecodeUtf8 frag) of
+          Just ni -> pure $ ACSL SCMContact $ CSLName ni
+          Nothing -> fail "invalid name"
+      serverLinkP = do
+        (sch, h_) <- authorityP <* A.char '/'
+        ct_ <- contactTypeP <* optional (A.char '/') <* A.char '#'
+        case ct_ of
+          Nothing -> do
+            lnkId <- strP <* A.char '/'
+            k <- strP
+            srv <- serverQueryP h_
+            pure $ ACSL SCMInvitation $ CSLInvitation sch srv (SMP.EntityId lnkId) (LinkKey k)
+          Just ct -> do
+            k <- strP
+            srv <- serverQueryP h_
+            pure $ ACSL SCMContact $ CSLContact sch ct srv (LinkKey k)
       authorityP =
         "simplex:" $> (SLSSimplex, Nothing)
           <|> "https://" *> ((SLSServer,) . Just <$> strP)
@@ -1639,6 +1668,7 @@ instance ConnectionModeI m => Encoding (ConnShortLink m) where
   smpEncode = \case
     CSLInvitation _ srv lnkId (LinkKey k) -> smpEncode (CMInvitation, srv, lnkId, k)
     CSLContact _ ct srv (LinkKey k) -> smpEncode (CMContact, ctTypeChar ct, srv, k)
+    CSLName ni -> smpEncode (CMContact, 'N', encodeUtf8 $ encodeNameFragment ni)
   smpP = (\(ACSL _ l) -> checkConnMode l) <$?> smpP
   {-# INLINE smpP #-}
 
@@ -1651,9 +1681,17 @@ instance Encoding AConnShortLink where
         (srv, lnkId, k) <- smpP
         pure $ ACSL SCMInvitation $ CSLInvitation SLSServer srv lnkId (LinkKey k)
       CMContact -> do
-        ct <- ctTypeP =<< A.anyChar
-        (srv, k) <- smpP
-        pure $ ACSL SCMContact $ CSLContact SLSServer ct srv (LinkKey k)
+        c <- A.anyChar
+        if c == 'N'
+          then do
+            frag <- smpP @ByteString
+            case parseNameFragment (safeDecodeUtf8 frag) of
+              Just ni -> pure $ ACSL SCMContact $ CSLName ni
+              Nothing -> fail "invalid name in binary encoding"
+          else do
+            ct <- ctTypeP c
+            (srv, k) <- smpP
+            pure $ ACSL SCMContact $ CSLContact SLSServer ct srv (LinkKey k)
 
 ctTypeP :: Char -> Parser ContactConnType
 ctTypeP = \case
@@ -1677,6 +1715,7 @@ shortenShortLink :: NonEmpty SMPServer -> ConnShortLink m -> ConnShortLink m
 shortenShortLink presetSrvs = \case
   CSLInvitation sch srv lnkId linkKey -> CSLInvitation sch (shortServer srv) lnkId linkKey
   CSLContact sch ct srv linkKey -> CSLContact sch ct (shortServer srv) linkKey
+  l@(CSLName _) -> l
   where
     shortServer srv@(SMPServer (h :| _) _ _) =
       if isPresetServer srv presetSrvs then SMPServerOnlyHost h else srv
@@ -1700,6 +1739,7 @@ restoreShortLink :: NonEmpty SMPServer -> ConnShortLink m -> ConnShortLink m
 restoreShortLink presetSrvs = \case
   CSLInvitation sch srv lnkId linkKey -> CSLInvitation sch (fullServer srv) lnkId linkKey
   CSLContact sch ct srv linkKey -> CSLContact sch ct (fullServer srv) linkKey
+  l@(CSLName _) -> l
   where
     fullServer = \case
       s@(SMPServerOnlyHost _) -> fromMaybe s $ findPresetServer s presetSrvs
@@ -1718,6 +1758,41 @@ sameConnReqContact (CRContactUri ConnReqUriData {crSmpQueues = qs}) (CRContactUr
 sameShortLinkContact :: ConnShortLink 'CMContact -> ConnShortLink 'CMContact -> Bool
 sameShortLinkContact (CSLContact _ ct srv k) (CSLContact _ ct' srv' k') =
   ct == ct' && sameSrvAddr srv srv' && k == k'
+sameShortLinkContact (CSLName ni) (CSLName ni') = ni == ni'
+sameShortLinkContact _ _ = False
+
+encodeNameFragment :: SimplexNameInfo -> Text
+encodeNameFragment SimplexNameInfo {nameType, namespace, domain, subDomain} =
+  prefix <> T.intercalate "." (subDomain <> [domain] <> [nsTLD namespace])
+  where
+    prefix = case nameType of
+      NTPublicGroup -> ""
+      NTContact -> ":"
+    nsTLD = \case
+      NSSimplex -> "simplex"
+      NSTesting -> "testnet"
+      NSWeb -> ""
+
+parseNameFragment :: Text -> Maybe SimplexNameInfo
+parseNameFragment t = case T.uncons t of
+  Nothing -> Nothing
+  Just (':', rest) -> parseName NTContact rest
+  Just _ -> parseName NTPublicGroup t
+  where
+    parseName nt s = case reverse $ T.splitOn "." s of
+      [] -> Nothing
+      ["simplex"] -> Nothing
+      [name] -> Just $ SimplexNameInfo nt NSSimplex name []
+      (tld : labels) -> case tld of
+        "simplex" -> case labels of
+          [name] -> Just $ SimplexNameInfo nt NSSimplex name []
+          (name : sub) -> Just $ SimplexNameInfo nt NSSimplex name (reverse sub)
+          [] -> Nothing
+        "testnet" -> case labels of
+          [name] -> Just $ SimplexNameInfo nt NSTesting name []
+          (name : sub) -> Just $ SimplexNameInfo nt NSTesting name (reverse sub)
+          [] -> Nothing
+        _ -> Just $ SimplexNameInfo nt NSWeb s []
 
 checkConnMode :: forall t m m'. (ConnectionModeI m, ConnectionModeI m') => t m' -> Either String (t m)
 checkConnMode c = case testEquality (sConnectionMode @m) (sConnectionMode @m') of

From c8e5246b48e5b695a76f2e3c233908f93840e52e Mon Sep 17 00:00:00 2001
From: "Evgeny @ SimpleX Chat"
 <259188159+evgeny-simplex@users.noreply.github.com>
Date: Mon, 25 May 2026 17:03:14 +0000
Subject: [PATCH 02/13] parser

---
 src/Simplex/Messaging/Agent/Protocol.hs | 42 +++++++++++++++----------
 1 file changed, 26 insertions(+), 16 deletions(-)

diff --git a/src/Simplex/Messaging/Agent/Protocol.hs b/src/Simplex/Messaging/Agent/Protocol.hs
index e5fc4b14c..b52f06f1d 100644
--- a/src/Simplex/Messaging/Agent/Protocol.hs
+++ b/src/Simplex/Messaging/Agent/Protocol.hs
@@ -127,6 +127,7 @@ module Simplex.Messaging.Agent.Protocol
     SimplexNamespace (..),
     SimplexNameType (..),
     parseNameFragment,
+    parseName,
     encodeNameFragment,
     AConnShortLink (..),
     CreatedConnLink (..),
@@ -1625,12 +1626,20 @@ instance ConnectionModeI m => StrEncoding (ConnShortLink m) where
 instance StrEncoding AConnShortLink where
   strEncode (ACSL _ l) = strEncode l
   {-# INLINE strEncode #-}
-  strP = nameP <|> serverLinkP
+  strP = nameUriP <|> namePrefixP <|> serverLinkP
     where
-      nameP = do
+      nameUriP = do
         _ <- "simplex:/name#"
         frag <- A.takeWhile1 (not . A.isSpace)
         case parseNameFragment (safeDecodeUtf8 frag) of
+          Just ni -> pure $ ACSL SCMContact $ CSLName ni
+          Nothing -> fail "invalid name uri"
+      namePrefixP = do
+        pfx <- A.char '#' <|> A.char ':'
+        name <- A.takeWhile1 (\c -> not (A.isSpace c) && c /= '#')
+        let nt = if pfx == ':' then NTContact else NTPublicGroup
+            frag = safeDecodeUtf8 name
+        case parseName nt frag of
           Just ni -> pure $ ACSL SCMContact $ CSLName ni
           Nothing -> fail "invalid name"
       serverLinkP = do
@@ -1778,21 +1787,22 @@ parseNameFragment t = case T.uncons t of
   Nothing -> Nothing
   Just (':', rest) -> parseName NTContact rest
   Just _ -> parseName NTPublicGroup t
-  where
-    parseName nt s = case reverse $ T.splitOn "." s of
-      [] -> Nothing
-      ["simplex"] -> Nothing
+
+parseName :: SimplexNameType -> Text -> Maybe SimplexNameInfo
+parseName nt s = case reverse $ T.splitOn "." s of
+  [] -> Nothing
+  ["simplex"] -> Nothing
+  [name] -> Just $ SimplexNameInfo nt NSSimplex name []
+  (tld : labels) -> case tld of
+    "simplex" -> case labels of
       [name] -> Just $ SimplexNameInfo nt NSSimplex name []
-      (tld : labels) -> case tld of
-        "simplex" -> case labels of
-          [name] -> Just $ SimplexNameInfo nt NSSimplex name []
-          (name : sub) -> Just $ SimplexNameInfo nt NSSimplex name (reverse sub)
-          [] -> Nothing
-        "testnet" -> case labels of
-          [name] -> Just $ SimplexNameInfo nt NSTesting name []
-          (name : sub) -> Just $ SimplexNameInfo nt NSTesting name (reverse sub)
-          [] -> Nothing
-        _ -> Just $ SimplexNameInfo nt NSWeb s []
+      (name : sub) -> Just $ SimplexNameInfo nt NSSimplex name (reverse sub)
+      [] -> Nothing
+    "testnet" -> case labels of
+      [name] -> Just $ SimplexNameInfo nt NSTesting name []
+      (name : sub) -> Just $ SimplexNameInfo nt NSTesting name (reverse sub)
+      [] -> Nothing
+    _ -> Just $ SimplexNameInfo nt NSWeb s []
 
 checkConnMode :: forall t m m'. (ConnectionModeI m, ConnectionModeI m') => t m' -> Either String (t m)
 checkConnMode c = case testEquality (sConnectionMode @m) (sConnectionMode @m') of

From bc25e8e979dd5698212a6aff7317c266cf651cdb Mon Sep 17 00:00:00 2001
From: "Evgeny @ SimpleX Chat"
 <259188159+evgeny-simplex@users.noreply.github.com>
Date: Mon, 25 May 2026 17:56:12 +0000
Subject: [PATCH 03/13] refactor

---
 src/Simplex/Messaging/Agent/Protocol.hs | 90 +++++++++++++++----------
 1 file changed, 54 insertions(+), 36 deletions(-)

diff --git a/src/Simplex/Messaging/Agent/Protocol.hs b/src/Simplex/Messaging/Agent/Protocol.hs
index b52f06f1d..2604c7a22 100644
--- a/src/Simplex/Messaging/Agent/Protocol.hs
+++ b/src/Simplex/Messaging/Agent/Protocol.hs
@@ -201,7 +201,7 @@ import qualified Data.Attoparsec.ByteString.Char8 as A
 import qualified Data.ByteString.Base64.URL as B64
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
-import Data.Char (isSpace, toLower, toUpper)
+import Data.Char (isAlpha, isAscii, isDigit, isSpace, toLower, toUpper)
 import Data.Foldable (find)
 import Data.Functor (($>))
 import Data.Int (Int64)
@@ -1630,18 +1630,21 @@ instance StrEncoding AConnShortLink where
     where
       nameUriP = do
         _ <- "simplex:/name#"
-        frag <- A.takeWhile1 (not . A.isSpace)
-        case parseNameFragment (safeDecodeUtf8 frag) of
-          Just ni -> pure $ ACSL SCMContact $ CSLName ni
-          Nothing -> fail "invalid name uri"
+        nt <- A.char ':' $> NTContact <|> pure NTPublicGroup
+        ACSL SCMContact . CSLName <$> (classifyLabels nt <$?> nameLabelP `A.sepBy1` A.char '.')
       namePrefixP = do
-        pfx <- A.char '#' <|> A.char ':'
-        name <- A.takeWhile1 (\c -> not (A.isSpace c) && c /= '#')
-        let nt = if pfx == ':' then NTContact else NTPublicGroup
-            frag = safeDecodeUtf8 name
-        case parseName nt frag of
-          Just ni -> pure $ ACSL SCMContact $ CSLName ni
-          Nothing -> fail "invalid name"
+        nt <- A.char '#' $> NTPublicGroup <|> A.char ':' $> NTContact
+        ACSL SCMContact . CSLName <$> (classifyLabels nt <$?> nameLabelP `A.sepBy1` A.char '.')
+      nameLabelP = do
+        c <- A.peekChar'
+        unless (isNameLetter c) $ fail "expected letter"
+        lbl <- A.takeWhile1 $ \ch -> isNameLetter ch || isDigit ch || ch == '-'
+        let lbl' = safeDecodeUtf8 lbl
+        when (T.last lbl' == '-') $ fail "trailing hyphen"
+        when (T.isInfixOf "--" lbl') $ fail "consecutive hyphens"
+        pure lbl'
+      isNameLetter c = (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z') || (not (isAscii c) && isAlpha c && not (isLatinExtended c))
+      isLatinExtended c = c >= '\x00c0' && c <= '\x024f'
       serverLinkP = do
         (sch, h_) <- authorityP <* A.char '/'
         ct_ <- contactTypeP <* optional (A.char '/') <* A.char '#'
@@ -1693,10 +1696,8 @@ instance Encoding AConnShortLink where
         c <- A.anyChar
         if c == 'N'
           then do
-            frag <- smpP @ByteString
-            case parseNameFragment (safeDecodeUtf8 frag) of
-              Just ni -> pure $ ACSL SCMContact $ CSLName ni
-              Nothing -> fail "invalid name in binary encoding"
+            ni <- parseNameFragment . safeDecodeUtf8 <$?> smpP @ByteString
+            pure $ ACSL SCMContact $ CSLName ni
           else do
             ct <- ctTypeP c
             (srv, k) <- smpP
@@ -1782,27 +1783,44 @@ encodeNameFragment SimplexNameInfo {nameType, namespace, domain, subDomain} =
       NSTesting -> "testnet"
       NSWeb -> ""
 
-parseNameFragment :: Text -> Maybe SimplexNameInfo
+classifyLabels :: SimplexNameType -> [Text] -> Either String SimplexNameInfo
+classifyLabels _ [] = Left "empty name"
+classifyLabels nt labels = case reverse labels of
+  ["simplex"] -> Left "missing name before TLD"
+  [name] -> Right $ SimplexNameInfo nt NSSimplex name []
+  (tld : rest) -> case tld of
+    "simplex" -> case rest of
+      [name] -> Right $ SimplexNameInfo nt NSSimplex name []
+      (name : sub) -> Right $ SimplexNameInfo nt NSSimplex name (reverse sub)
+      [] -> Left "missing name before TLD"
+    "testnet" -> case rest of
+      [name] -> Right $ SimplexNameInfo nt NSTesting name []
+      (name : sub) -> Right $ SimplexNameInfo nt NSTesting name (reverse sub)
+      [] -> Left "missing name before TLD"
+    _ -> Right $ SimplexNameInfo nt NSWeb (T.intercalate "." labels) []
+
+parseNameFragment :: Text -> Either String SimplexNameInfo
 parseNameFragment t = case T.uncons t of
-  Nothing -> Nothing
-  Just (':', rest) -> parseName NTContact rest
-  Just _ -> parseName NTPublicGroup t
-
-parseName :: SimplexNameType -> Text -> Maybe SimplexNameInfo
-parseName nt s = case reverse $ T.splitOn "." s of
-  [] -> Nothing
-  ["simplex"] -> Nothing
-  [name] -> Just $ SimplexNameInfo nt NSSimplex name []
-  (tld : labels) -> case tld of
-    "simplex" -> case labels of
-      [name] -> Just $ SimplexNameInfo nt NSSimplex name []
-      (name : sub) -> Just $ SimplexNameInfo nt NSSimplex name (reverse sub)
-      [] -> Nothing
-    "testnet" -> case labels of
-      [name] -> Just $ SimplexNameInfo nt NSTesting name []
-      (name : sub) -> Just $ SimplexNameInfo nt NSTesting name (reverse sub)
-      [] -> Nothing
-    _ -> Just $ SimplexNameInfo nt NSWeb s []
+  Nothing -> Left "empty name"
+  Just (':', rest) -> parseNameText NTContact rest
+  Just _ -> parseNameText NTPublicGroup t
+
+parseNameText :: SimplexNameType -> Text -> Either String SimplexNameInfo
+parseNameText nt s = do
+  let labels = T.splitOn "." s
+  mapM_ parseLabel labels
+  classifyLabels nt labels
+  where
+    parseLabel lbl
+      | T.null lbl = Left "empty label"
+      | not (isNameLetter $ T.head lbl) = Left "expected letter"
+      | T.last lbl == '-' = Left "trailing hyphen"
+      | T.isInfixOf "--" lbl = Left "consecutive hyphens"
+      | not (T.all (\c -> isNameLetter c || isDigit c || c == '-') lbl) = Left "invalid character"
+      | otherwise = Right ()
+    isNameLetter c = (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z') || isNonLatinLetter c
+    isNonLatinLetter c = not (isAscii c) && isAlpha c && not (isLatinExtended c)
+    isLatinExtended c = c >= '\x00c0' && c <= '\x024f'
 
 checkConnMode :: forall t m m'. (ConnectionModeI m, ConnectionModeI m') => t m' -> Either String (t m)
 checkConnMode c = case testEquality (sConnectionMode @m) (sConnectionMode @m') of

From 78fdd8c7cb9e90e436435bf334a49689d9742180 Mon Sep 17 00:00:00 2001
From: "Evgeny @ SimpleX Chat"
 <259188159+evgeny-simplex@users.noreply.github.com>
Date: Mon, 25 May 2026 18:40:34 +0000
Subject: [PATCH 04/13] more refactor

---
 src/Simplex/Messaging/Agent/Protocol.hs | 23 ++++++++++++++---------
 1 file changed, 14 insertions(+), 9 deletions(-)

diff --git a/src/Simplex/Messaging/Agent/Protocol.hs b/src/Simplex/Messaging/Agent/Protocol.hs
index 2604c7a22..31535a88d 100644
--- a/src/Simplex/Messaging/Agent/Protocol.hs
+++ b/src/Simplex/Messaging/Agent/Protocol.hs
@@ -127,7 +127,8 @@ module Simplex.Messaging.Agent.Protocol
     SimplexNamespace (..),
     SimplexNameType (..),
     parseNameFragment,
-    parseName,
+    parseNameText,
+    classifyLabels,
     encodeNameFragment,
     AConnShortLink (..),
     CreatedConnLink (..),
@@ -201,6 +202,7 @@ import qualified Data.Attoparsec.ByteString.Char8 as A
 import qualified Data.ByteString.Base64.URL as B64
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
+import Control.Monad (unless, when)
 import Data.Char (isAlpha, isAscii, isDigit, isSpace, toLower, toUpper)
 import Data.Foldable (find)
 import Data.Functor (($>))
@@ -1605,7 +1607,11 @@ instance ConnectionModeI m => StrEncoding (ConnShortLink m) where
   strEncode = \case
     CSLInvitation sch srv (SMP.EntityId lnkId) (LinkKey k) -> slEncode sch srv 'i' lnkId k
     CSLContact sch ct srv (LinkKey k) -> slEncode sch srv (toLower $ ctTypeChar ct) "" k
-    CSLName nameInfo -> "simplex:/name#" <> encodeUtf8 (encodeNameFragment nameInfo)
+    CSLName SimplexNameInfo {nameType, namespace, domain, subDomain} ->
+      "simplex:/name" <> encodeUtf8 (pfx <> T.intercalate "." (subDomain <> [domain] <> tld))
+      where
+        pfx = case nameType of NTPublicGroup -> "#"; NTContact -> ":"
+        tld = case namespace of NSSimplex -> ["simplex"]; NSTesting -> ["testing"]; NSWeb -> []
     where
       slEncode sch (SMPServer (h :| hs) port (C.KeyHash kh)) linkType lnkId k =
         B.concat [authority, "/", B.singleton linkType, "#", lnkIdStr, B64.encodeUnpadded k, queryStr]
@@ -1628,11 +1634,9 @@ instance StrEncoding AConnShortLink where
   {-# INLINE strEncode #-}
   strP = nameUriP <|> namePrefixP <|> serverLinkP
     where
-      nameUriP = do
-        _ <- "simplex:/name#"
-        nt <- A.char ':' $> NTContact <|> pure NTPublicGroup
-        ACSL SCMContact . CSLName <$> (classifyLabels nt <$?> nameLabelP `A.sepBy1` A.char '.')
-      namePrefixP = do
+      nameUriP = "simplex:/name" *> nameBodyP
+      namePrefixP = nameBodyP
+      nameBodyP = do
         nt <- A.char '#' $> NTPublicGroup <|> A.char ':' $> NTContact
         ACSL SCMContact . CSLName <$> (classifyLabels nt <$?> nameLabelP `A.sepBy1` A.char '.')
       nameLabelP = do
@@ -1780,12 +1784,13 @@ encodeNameFragment SimplexNameInfo {nameType, namespace, domain, subDomain} =
       NTContact -> ":"
     nsTLD = \case
       NSSimplex -> "simplex"
-      NSTesting -> "testnet"
+      NSTesting -> "testing"
       NSWeb -> ""
 
 classifyLabels :: SimplexNameType -> [Text] -> Either String SimplexNameInfo
 classifyLabels _ [] = Left "empty name"
 classifyLabels nt labels = case reverse labels of
+  [] -> Left "empty name"
   ["simplex"] -> Left "missing name before TLD"
   [name] -> Right $ SimplexNameInfo nt NSSimplex name []
   (tld : rest) -> case tld of
@@ -1793,7 +1798,7 @@ classifyLabels nt labels = case reverse labels of
       [name] -> Right $ SimplexNameInfo nt NSSimplex name []
       (name : sub) -> Right $ SimplexNameInfo nt NSSimplex name (reverse sub)
       [] -> Left "missing name before TLD"
-    "testnet" -> case rest of
+    "testing" -> case rest of
       [name] -> Right $ SimplexNameInfo nt NSTesting name []
       (name : sub) -> Right $ SimplexNameInfo nt NSTesting name (reverse sub)
       [] -> Left "missing name before TLD"

From 9a55554efedbe6b5c451efa7117df7f887f0b9db Mon Sep 17 00:00:00 2001
From: "Evgeny @ SimpleX Chat"
 <259188159+evgeny-simplex@users.noreply.github.com>
Date: Mon, 25 May 2026 18:45:37 +0000
Subject: [PATCH 05/13] simplify

---
 src/Simplex/Messaging/Agent/Protocol.hs | 5 ++---
 1 file changed, 2 insertions(+), 3 deletions(-)

diff --git a/src/Simplex/Messaging/Agent/Protocol.hs b/src/Simplex/Messaging/Agent/Protocol.hs
index 31535a88d..15e415d75 100644
--- a/src/Simplex/Messaging/Agent/Protocol.hs
+++ b/src/Simplex/Messaging/Agent/Protocol.hs
@@ -1647,7 +1647,7 @@ instance StrEncoding AConnShortLink where
         when (T.last lbl' == '-') $ fail "trailing hyphen"
         when (T.isInfixOf "--" lbl') $ fail "consecutive hyphens"
         pure lbl'
-      isNameLetter c = (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z') || (not (isAscii c) && isAlpha c && not (isLatinExtended c))
+      isNameLetter c = isAlpha c && not (isLatinExtended c)
       isLatinExtended c = c >= '\x00c0' && c <= '\x024f'
       serverLinkP = do
         (sch, h_) <- authorityP <* A.char '/'
@@ -1823,8 +1823,7 @@ parseNameText nt s = do
       | T.isInfixOf "--" lbl = Left "consecutive hyphens"
       | not (T.all (\c -> isNameLetter c || isDigit c || c == '-') lbl) = Left "invalid character"
       | otherwise = Right ()
-    isNameLetter c = (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z') || isNonLatinLetter c
-    isNonLatinLetter c = not (isAscii c) && isAlpha c && not (isLatinExtended c)
+    isNameLetter c = isAlpha c && not (isLatinExtended c)
     isLatinExtended c = c >= '\x00c0' && c <= '\x024f'
 
 checkConnMode :: forall t m m'. (ConnectionModeI m, ConnectionModeI m') => t m' -> Either String (t m)

From 9f0c0457b5aa386d9442812f77a6d91ba971c35f Mon Sep 17 00:00:00 2001
From: "Evgeny @ SimpleX Chat"
 <259188159+evgeny-simplex@users.noreply.github.com>
Date: Mon, 25 May 2026 19:38:32 +0000
Subject: [PATCH 06/13] refactor again

---
 src/Simplex/Messaging/Agent.hs          |   2 -
 src/Simplex/Messaging/Agent/Protocol.hs | 207 ++++++++++--------------
 2 files changed, 86 insertions(+), 123 deletions(-)

diff --git a/src/Simplex/Messaging/Agent.hs b/src/Simplex/Messaging/Agent.hs
index b868ca63b..c466795bf 100644
--- a/src/Simplex/Messaging/Agent.hs
+++ b/src/Simplex/Messaging/Agent.hs
@@ -1007,7 +1007,6 @@ setConnShortLinkAsync' c corrId connId userLinkData clientData =
     enqueueCommand c corrId connId (Just srv) $ AClientCommand $ LSET userLinkData clientData
 
 getConnShortLinkAsync' :: AgentClient -> UserId -> ACorrId -> Maybe ConnId -> ConnShortLink 'CMContact -> AM ConnId
-getConnShortLinkAsync' c _userId _corrId _connId_ (CSLName _) = throwE $ AGENT $ A_LINK "name resolution not supported"
 getConnShortLinkAsync' c userId corrId connId_ shortLink@(CSLContact _ _ srv _) = do
   connId <- case connId_ of
     Just existingConnId -> do
@@ -1122,7 +1121,6 @@ getConnShortLink' c nm userId = \case
     let (linkId, k) = SL.contactShortLinkKdf linkKey
     ld <- getQueueLink c nm userId srv linkId
     decryptData srv linkKey k ld
-  CSLName _ -> throwE $ AGENT $ A_LINK "name resolution not supported"
   where
     decryptData :: ConnectionModeI c => SMPServer -> LinkKey -> C.SbKey -> (SMP.SenderId, QueueLinkData) -> AM (FixedLinkData c, ConnLinkData c)
     decryptData srv linkKey k (sndId, d) = do
diff --git a/src/Simplex/Messaging/Agent/Protocol.hs b/src/Simplex/Messaging/Agent/Protocol.hs
index 15e415d75..52c45aa6a 100644
--- a/src/Simplex/Messaging/Agent/Protocol.hs
+++ b/src/Simplex/Messaging/Agent/Protocol.hs
@@ -122,14 +122,12 @@ module Simplex.Messaging.Agent.Protocol
     OwnerId,
     ConnectionLink (..),
     AConnectionLink (..),
-    ConnShortLink (..),
+    AConnectTarget (..),
     SimplexNameInfo (..),
     SimplexNamespace (..),
     SimplexNameType (..),
-    parseNameFragment,
-    parseNameText,
-    classifyLabels,
-    encodeNameFragment,
+    isNameLetter,
+    ConnShortLink (..),
     AConnShortLink (..),
     CreatedConnLink (..),
     ACreatedConnLink (..),
@@ -203,7 +201,7 @@ import qualified Data.ByteString.Base64.URL as B64
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
 import Control.Monad (unless, when)
-import Data.Char (isAlpha, isAscii, isDigit, isSpace, toLower, toUpper)
+import Data.Char (isAlpha, isDigit, toLower, toUpper)
 import Data.Foldable (find)
 import Data.Functor (($>))
 import Data.Int (Int64)
@@ -1479,21 +1477,6 @@ data ShortLinkScheme = SLSSimplex | SLSServer deriving (Eq, Show)
 data ConnShortLink (m :: ConnectionMode) where
   CSLInvitation :: ShortLinkScheme -> SMPServer -> SMP.LinkId -> LinkKey -> ConnShortLink 'CMInvitation
   CSLContact :: ShortLinkScheme -> ContactConnType -> SMPServer -> LinkKey -> ConnShortLink 'CMContact
-  CSLName :: SimplexNameInfo -> ConnShortLink 'CMContact
-
-data SimplexNameInfo = SimplexNameInfo
-  { nameType :: SimplexNameType,
-    namespace :: SimplexNamespace,
-    domain :: Text,
-    subDomain :: [Text]
-  }
-  deriving (Eq, Show)
-
-data SimplexNamespace = NSSimplex | NSTesting | NSWeb
-  deriving (Eq, Show)
-
-data SimplexNameType = NTPublicGroup | NTContact
-  deriving (Eq, Show)
 
 deriving instance Eq (ConnShortLink m)
 
@@ -1503,7 +1486,6 @@ simplexShortLink :: ConnShortLink m -> ConnShortLink m
 simplexShortLink = \case
   CSLInvitation _ srv lnkId k -> CSLInvitation SLSSimplex srv lnkId k
   CSLContact _ ct srv k -> CSLContact SLSSimplex ct srv k
-  l@(CSLName _) -> l
 
 newtype LinkKey = LinkKey ByteString -- sha3-256(fixed_data)
   deriving (Eq, Show)
@@ -1538,6 +1520,72 @@ instance (Typeable c, ConnectionModeI c) => FromField (ConnShortLink c) where fr
 
 data ContactConnType = CCTContact | CCTChannel | CCTGroup | CCTRelay deriving (Eq, Show)
 
+-- | A connection target: either a resolved link or an unresolved name.
+-- Contexts that support name resolution accept AConnectTarget.
+-- Contexts that only handle resolved links use AConnectionLink directly.
+data AConnectTarget = ACTLink AConnectionLink | ACTName SimplexNameInfo
+  deriving (Eq, Show)
+
+data SimplexNameInfo = SimplexNameInfo
+  { nameType :: SimplexNameType,
+    namespace :: SimplexNamespace,
+    domain :: Text,
+    subDomain :: [Text]
+  }
+  deriving (Eq, Show)
+
+data SimplexNamespace = NSSimplex | NSTesting | NSWeb
+  deriving (Eq, Show)
+
+data SimplexNameType = NTPublicGroup | NTContact
+  deriving (Eq, Show)
+
+isNameLetter :: Char -> Bool
+isNameLetter c = isAlpha c && not (c >= '\x00c0' && c <= '\x024f')
+
+instance StrEncoding AConnectTarget where
+  strEncode = \case
+    ACTLink lnk -> strEncode lnk
+    ACTName ni -> "simplex:/name" <> encodeUtf8 (encodeNameFragment ni)
+  strP = ACTName <$> nameP <|> ACTLink <$> strP
+    where
+      nameP = nameUriP <|> namePrefixP
+      nameUriP = "simplex:/name" *> nameBodyP
+      namePrefixP = nameBodyP
+      nameBodyP = do
+        nt <- A.char '#' $> NTPublicGroup <|> A.char ':' $> NTContact
+        classifyLabels nt <$?> nameLabelP `A.sepBy1` A.char '.'
+      nameLabelP = do
+        c <- A.peekChar'
+        unless (isNameLetter c) $ fail "expected letter"
+        lbl <- A.takeWhile1 $ \ch -> isNameLetter ch || isDigit ch || ch == '-'
+        let lbl' = safeDecodeUtf8 lbl
+        when (T.last lbl' == '-') $ fail "trailing hyphen"
+        when (T.isInfixOf "--" lbl') $ fail "consecutive hyphens"
+        pure lbl'
+
+encodeNameFragment :: SimplexNameInfo -> Text
+encodeNameFragment SimplexNameInfo {nameType, namespace, domain, subDomain} =
+  prefix <> T.intercalate "." (subDomain <> [domain] <> tld)
+  where
+    prefix = case nameType of NTPublicGroup -> "#"; NTContact -> ":"
+    tld = case namespace of NSSimplex -> ["simplex"]; NSTesting -> ["testing"]; NSWeb -> []
+
+classifyLabels :: SimplexNameType -> [Text] -> Either String SimplexNameInfo
+classifyLabels nt labels = case reverse labels of
+  [] -> Left "empty name"
+  [name] -> Right $ SimplexNameInfo nt NSSimplex name []
+  (tld : rest) -> case tld of
+    "simplex" -> case rest of
+      [name] -> Right $ SimplexNameInfo nt NSSimplex name []
+      (name : sub) -> Right $ SimplexNameInfo nt NSSimplex name (reverse sub)
+      [] -> Left "missing name before TLD"
+    "testing" -> case rest of
+      [name] -> Right $ SimplexNameInfo nt NSTesting name []
+      (name : sub) -> Right $ SimplexNameInfo nt NSTesting name (reverse sub)
+      [] -> Left "missing name before TLD"
+    _ -> Right $ SimplexNameInfo nt NSWeb (T.intercalate "." labels) []
+
 data AConnShortLink = forall m. ConnectionModeI m => ACSL (SConnectionMode m) (ConnShortLink m)
 
 instance Eq AConnShortLink where
@@ -1607,11 +1655,6 @@ instance ConnectionModeI m => StrEncoding (ConnShortLink m) where
   strEncode = \case
     CSLInvitation sch srv (SMP.EntityId lnkId) (LinkKey k) -> slEncode sch srv 'i' lnkId k
     CSLContact sch ct srv (LinkKey k) -> slEncode sch srv (toLower $ ctTypeChar ct) "" k
-    CSLName SimplexNameInfo {nameType, namespace, domain, subDomain} ->
-      "simplex:/name" <> encodeUtf8 (pfx <> T.intercalate "." (subDomain <> [domain] <> tld))
-      where
-        pfx = case nameType of NTPublicGroup -> "#"; NTContact -> ":"
-        tld = case namespace of NSSimplex -> ["simplex"]; NSTesting -> ["testing"]; NSWeb -> []
     where
       slEncode sch (SMPServer (h :| hs) port (C.KeyHash kh)) linkType lnkId k =
         B.concat [authority, "/", B.singleton linkType, "#", lnkIdStr, B64.encodeUnpadded k, queryStr]
@@ -1632,36 +1675,20 @@ instance ConnectionModeI m => StrEncoding (ConnShortLink m) where
 instance StrEncoding AConnShortLink where
   strEncode (ACSL _ l) = strEncode l
   {-# INLINE strEncode #-}
-  strP = nameUriP <|> namePrefixP <|> serverLinkP
+  strP = do
+    (sch, h_) <- authorityP <* A.char '/'
+    ct_ <- contactTypeP <* optional (A.char '/') <* A.char '#'
+    case ct_ of
+      Nothing -> do
+        lnkId <- strP <* A.char '/'
+        k <- strP
+        srv <- serverQueryP h_
+        pure $ ACSL SCMInvitation $ CSLInvitation sch srv (SMP.EntityId lnkId) (LinkKey k)
+      Just ct -> do
+        k <- strP
+        srv <- serverQueryP h_
+        pure $ ACSL SCMContact $ CSLContact sch ct srv (LinkKey k)
     where
-      nameUriP = "simplex:/name" *> nameBodyP
-      namePrefixP = nameBodyP
-      nameBodyP = do
-        nt <- A.char '#' $> NTPublicGroup <|> A.char ':' $> NTContact
-        ACSL SCMContact . CSLName <$> (classifyLabels nt <$?> nameLabelP `A.sepBy1` A.char '.')
-      nameLabelP = do
-        c <- A.peekChar'
-        unless (isNameLetter c) $ fail "expected letter"
-        lbl <- A.takeWhile1 $ \ch -> isNameLetter ch || isDigit ch || ch == '-'
-        let lbl' = safeDecodeUtf8 lbl
-        when (T.last lbl' == '-') $ fail "trailing hyphen"
-        when (T.isInfixOf "--" lbl') $ fail "consecutive hyphens"
-        pure lbl'
-      isNameLetter c = isAlpha c && not (isLatinExtended c)
-      isLatinExtended c = c >= '\x00c0' && c <= '\x024f'
-      serverLinkP = do
-        (sch, h_) <- authorityP <* A.char '/'
-        ct_ <- contactTypeP <* optional (A.char '/') <* A.char '#'
-        case ct_ of
-          Nothing -> do
-            lnkId <- strP <* A.char '/'
-            k <- strP
-            srv <- serverQueryP h_
-            pure $ ACSL SCMInvitation $ CSLInvitation sch srv (SMP.EntityId lnkId) (LinkKey k)
-          Just ct -> do
-            k <- strP
-            srv <- serverQueryP h_
-            pure $ ACSL SCMContact $ CSLContact sch ct srv (LinkKey k)
       authorityP =
         "simplex:" $> (SLSSimplex, Nothing)
           <|> "https://" *> ((SLSServer,) . Just <$> strP)
@@ -1684,7 +1711,6 @@ instance ConnectionModeI m => Encoding (ConnShortLink m) where
   smpEncode = \case
     CSLInvitation _ srv lnkId (LinkKey k) -> smpEncode (CMInvitation, srv, lnkId, k)
     CSLContact _ ct srv (LinkKey k) -> smpEncode (CMContact, ctTypeChar ct, srv, k)
-    CSLName ni -> smpEncode (CMContact, 'N', encodeUtf8 $ encodeNameFragment ni)
   smpP = (\(ACSL _ l) -> checkConnMode l) <$?> smpP
   {-# INLINE smpP #-}
 
@@ -1697,15 +1723,9 @@ instance Encoding AConnShortLink where
         (srv, lnkId, k) <- smpP
         pure $ ACSL SCMInvitation $ CSLInvitation SLSServer srv lnkId (LinkKey k)
       CMContact -> do
-        c <- A.anyChar
-        if c == 'N'
-          then do
-            ni <- parseNameFragment . safeDecodeUtf8 <$?> smpP @ByteString
-            pure $ ACSL SCMContact $ CSLName ni
-          else do
-            ct <- ctTypeP c
-            (srv, k) <- smpP
-            pure $ ACSL SCMContact $ CSLContact SLSServer ct srv (LinkKey k)
+        ct <- ctTypeP =<< A.anyChar
+        (srv, k) <- smpP
+        pure $ ACSL SCMContact $ CSLContact SLSServer ct srv (LinkKey k)
 
 ctTypeP :: Char -> Parser ContactConnType
 ctTypeP = \case
@@ -1729,7 +1749,6 @@ shortenShortLink :: NonEmpty SMPServer -> ConnShortLink m -> ConnShortLink m
 shortenShortLink presetSrvs = \case
   CSLInvitation sch srv lnkId linkKey -> CSLInvitation sch (shortServer srv) lnkId linkKey
   CSLContact sch ct srv linkKey -> CSLContact sch ct (shortServer srv) linkKey
-  l@(CSLName _) -> l
   where
     shortServer srv@(SMPServer (h :| _) _ _) =
       if isPresetServer srv presetSrvs then SMPServerOnlyHost h else srv
@@ -1753,7 +1772,6 @@ restoreShortLink :: NonEmpty SMPServer -> ConnShortLink m -> ConnShortLink m
 restoreShortLink presetSrvs = \case
   CSLInvitation sch srv lnkId linkKey -> CSLInvitation sch (fullServer srv) lnkId linkKey
   CSLContact sch ct srv linkKey -> CSLContact sch ct (fullServer srv) linkKey
-  l@(CSLName _) -> l
   where
     fullServer = \case
       s@(SMPServerOnlyHost _) -> fromMaybe s $ findPresetServer s presetSrvs
@@ -1772,59 +1790,6 @@ sameConnReqContact (CRContactUri ConnReqUriData {crSmpQueues = qs}) (CRContactUr
 sameShortLinkContact :: ConnShortLink 'CMContact -> ConnShortLink 'CMContact -> Bool
 sameShortLinkContact (CSLContact _ ct srv k) (CSLContact _ ct' srv' k') =
   ct == ct' && sameSrvAddr srv srv' && k == k'
-sameShortLinkContact (CSLName ni) (CSLName ni') = ni == ni'
-sameShortLinkContact _ _ = False
-
-encodeNameFragment :: SimplexNameInfo -> Text
-encodeNameFragment SimplexNameInfo {nameType, namespace, domain, subDomain} =
-  prefix <> T.intercalate "." (subDomain <> [domain] <> [nsTLD namespace])
-  where
-    prefix = case nameType of
-      NTPublicGroup -> ""
-      NTContact -> ":"
-    nsTLD = \case
-      NSSimplex -> "simplex"
-      NSTesting -> "testing"
-      NSWeb -> ""
-
-classifyLabels :: SimplexNameType -> [Text] -> Either String SimplexNameInfo
-classifyLabels _ [] = Left "empty name"
-classifyLabels nt labels = case reverse labels of
-  [] -> Left "empty name"
-  ["simplex"] -> Left "missing name before TLD"
-  [name] -> Right $ SimplexNameInfo nt NSSimplex name []
-  (tld : rest) -> case tld of
-    "simplex" -> case rest of
-      [name] -> Right $ SimplexNameInfo nt NSSimplex name []
-      (name : sub) -> Right $ SimplexNameInfo nt NSSimplex name (reverse sub)
-      [] -> Left "missing name before TLD"
-    "testing" -> case rest of
-      [name] -> Right $ SimplexNameInfo nt NSTesting name []
-      (name : sub) -> Right $ SimplexNameInfo nt NSTesting name (reverse sub)
-      [] -> Left "missing name before TLD"
-    _ -> Right $ SimplexNameInfo nt NSWeb (T.intercalate "." labels) []
-
-parseNameFragment :: Text -> Either String SimplexNameInfo
-parseNameFragment t = case T.uncons t of
-  Nothing -> Left "empty name"
-  Just (':', rest) -> parseNameText NTContact rest
-  Just _ -> parseNameText NTPublicGroup t
-
-parseNameText :: SimplexNameType -> Text -> Either String SimplexNameInfo
-parseNameText nt s = do
-  let labels = T.splitOn "." s
-  mapM_ parseLabel labels
-  classifyLabels nt labels
-  where
-    parseLabel lbl
-      | T.null lbl = Left "empty label"
-      | not (isNameLetter $ T.head lbl) = Left "expected letter"
-      | T.last lbl == '-' = Left "trailing hyphen"
-      | T.isInfixOf "--" lbl = Left "consecutive hyphens"
-      | not (T.all (\c -> isNameLetter c || isDigit c || c == '-') lbl) = Left "invalid character"
-      | otherwise = Right ()
-    isNameLetter c = isAlpha c && not (isLatinExtended c)
-    isLatinExtended c = c >= '\x00c0' && c <= '\x024f'
 
 checkConnMode :: forall t m m'. (ConnectionModeI m, ConnectionModeI m') => t m' -> Either String (t m)
 checkConnMode c = case testEquality (sConnectionMode @m) (sConnectionMode @m') of

From 7c6ac42adcc437d70344c1e3e4e2d082d3fe81dc Mon Sep 17 00:00:00 2001
From: "Evgeny @ SimpleX Chat"
 <259188159+evgeny-simplex@users.noreply.github.com>
Date: Mon, 25 May 2026 20:07:12 +0000
Subject: [PATCH 07/13] refactor

---
 src/Simplex/Messaging/Agent/Protocol.hs | 23 ++++++++---------------
 1 file changed, 8 insertions(+), 15 deletions(-)

diff --git a/src/Simplex/Messaging/Agent/Protocol.hs b/src/Simplex/Messaging/Agent/Protocol.hs
index 52c45aa6a..a4607ad60 100644
--- a/src/Simplex/Messaging/Agent/Protocol.hs
+++ b/src/Simplex/Messaging/Agent/Protocol.hs
@@ -1530,7 +1530,7 @@ data SimplexNameInfo = SimplexNameInfo
   { nameType :: SimplexNameType,
     namespace :: SimplexNamespace,
     domain :: Text,
-    subDomain :: [Text]
+    subDomain :: [Text] -- parent to child: ["b", "a"] for a.b.domain.simplex
   }
   deriving (Eq, Show)
 
@@ -1554,7 +1554,7 @@ instance StrEncoding AConnectTarget where
       namePrefixP = nameBodyP
       nameBodyP = do
         nt <- A.char '#' $> NTPublicGroup <|> A.char ':' $> NTContact
-        classifyLabels nt <$?> nameLabelP `A.sepBy1` A.char '.'
+        mkNameInfo nt <$?> nameLabelP `A.sepBy1` A.char '.'
       nameLabelP = do
         c <- A.peekChar'
         unless (isNameLetter c) $ fail "expected letter"
@@ -1566,25 +1566,18 @@ instance StrEncoding AConnectTarget where
 
 encodeNameFragment :: SimplexNameInfo -> Text
 encodeNameFragment SimplexNameInfo {nameType, namespace, domain, subDomain} =
-  prefix <> T.intercalate "." (subDomain <> [domain] <> tld)
+  prefix <> T.intercalate "." (reverse subDomain <> [domain] <> tld)
   where
     prefix = case nameType of NTPublicGroup -> "#"; NTContact -> ":"
     tld = case namespace of NSSimplex -> ["simplex"]; NSTesting -> ["testing"]; NSWeb -> []
 
-classifyLabels :: SimplexNameType -> [Text] -> Either String SimplexNameInfo
-classifyLabels nt labels = case reverse labels of
+mkNameInfo :: SimplexNameType -> [Text] -> Either String SimplexNameInfo
+mkNameInfo nt labels = case reverse labels of
   [] -> Left "empty name"
   [name] -> Right $ SimplexNameInfo nt NSSimplex name []
-  (tld : rest) -> case tld of
-    "simplex" -> case rest of
-      [name] -> Right $ SimplexNameInfo nt NSSimplex name []
-      (name : sub) -> Right $ SimplexNameInfo nt NSSimplex name (reverse sub)
-      [] -> Left "missing name before TLD"
-    "testing" -> case rest of
-      [name] -> Right $ SimplexNameInfo nt NSTesting name []
-      (name : sub) -> Right $ SimplexNameInfo nt NSTesting name (reverse sub)
-      [] -> Left "missing name before TLD"
-    _ -> Right $ SimplexNameInfo nt NSWeb (T.intercalate "." labels) []
+  "simplex" : name : sub -> Right $ SimplexNameInfo nt NSSimplex name sub
+  "testing" : name : sub -> Right $ SimplexNameInfo nt NSTesting name sub
+  _ -> Right $ SimplexNameInfo nt NSWeb (T.intercalate "." labels) []
 
 data AConnShortLink = forall m. ConnectionModeI m => ACSL (SConnectionMode m) (ConnShortLink m)
 

From e751b27a0e10082e8262e57e6dfb878120ec753e Mon Sep 17 00:00:00 2001
From: "Evgeny @ SimpleX Chat"
 <259188159+evgeny-simplex@users.noreply.github.com>
Date: Mon, 25 May 2026 20:25:06 +0000
Subject: [PATCH 08/13] refactor

---
 src/Simplex/Messaging/Agent/Protocol.hs | 53 ++++++++++---------------
 1 file changed, 20 insertions(+), 33 deletions(-)

diff --git a/src/Simplex/Messaging/Agent/Protocol.hs b/src/Simplex/Messaging/Agent/Protocol.hs
index a4607ad60..d26ee4e2f 100644
--- a/src/Simplex/Messaging/Agent/Protocol.hs
+++ b/src/Simplex/Messaging/Agent/Protocol.hs
@@ -126,7 +126,6 @@ module Simplex.Messaging.Agent.Protocol
     SimplexNameInfo (..),
     SimplexNamespace (..),
     SimplexNameType (..),
-    isNameLetter,
     ConnShortLink (..),
     AConnShortLink (..),
     CreatedConnLink (..),
@@ -188,7 +187,8 @@ module Simplex.Messaging.Agent.Protocol
   )
 where
 
-import Control.Applicative (optional, (<|>))
+import Control.Applicative (many, optional, (<|>))
+import Control.Monad (guard)
 import Control.Exception (BlockedIndefinitelyOnMVar (..), BlockedIndefinitelyOnSTM (..), fromException)
 import Data.Aeson (FromJSON (..), ToJSON (..), Value (..), (.:), (.:?))
 import qualified Data.Aeson as J'
@@ -197,10 +197,10 @@ import qualified Data.Aeson.TH as J
 import qualified Data.Aeson.Types as JT
 import Data.Attoparsec.ByteString.Char8 (Parser)
 import qualified Data.Attoparsec.ByteString.Char8 as A
+import qualified Data.Attoparsec.Text as AT
 import qualified Data.ByteString.Base64.URL as B64
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
-import Control.Monad (unless, when)
 import Data.Char (isAlpha, isDigit, toLower, toUpper)
 import Data.Foldable (find)
 import Data.Functor (($>))
@@ -1540,44 +1540,31 @@ data SimplexNamespace = NSSimplex | NSTesting | NSWeb
 data SimplexNameType = NTPublicGroup | NTContact
   deriving (Eq, Show)
 
-isNameLetter :: Char -> Bool
-isNameLetter c = isAlpha c && not (c >= '\x00c0' && c <= '\x024f')
-
 instance StrEncoding AConnectTarget where
   strEncode = \case
     ACTLink lnk -> strEncode lnk
-    ACTName ni -> "simplex:/name" <> encodeUtf8 (encodeNameFragment ni)
+    ACTName SimplexNameInfo {nameType, namespace, domain, subDomain} ->
+      "simplex:/name" <> encodeUtf8 (pfx <> T.intercalate "." (reverse subDomain <> [domain] <> tld))
+      where
+        pfx = case nameType of NTPublicGroup -> "#"; NTContact -> ":"
+        tld = case namespace of NSSimplex -> ["simplex"]; NSTesting -> ["testing"]; NSWeb -> []
   strP = ACTName <$> nameP <|> ACTLink <$> strP
     where
-      nameP = nameUriP <|> namePrefixP
-      nameUriP = "simplex:/name" *> nameBodyP
-      namePrefixP = nameBodyP
+      nameP = "simplex:/name" *> nameBodyP <|> nameBodyP
       nameBodyP = do
         nt <- A.char '#' $> NTPublicGroup <|> A.char ':' $> NTContact
-        mkNameInfo nt <$?> nameLabelP `A.sepBy1` A.char '.'
+        parseName nt . safeDecodeUtf8 <$?> A.takeWhile1 (not . A.isSpace)
+      parseName nt s = AT.parseOnly (nameLabelP `AT.sepBy1` AT.char '.' <* AT.endOfInput) s >>= mkNameInfo nt
       nameLabelP = do
-        c <- A.peekChar'
-        unless (isNameLetter c) $ fail "expected letter"
-        lbl <- A.takeWhile1 $ \ch -> isNameLetter ch || isDigit ch || ch == '-'
-        let lbl' = safeDecodeUtf8 lbl
-        when (T.last lbl' == '-') $ fail "trailing hyphen"
-        when (T.isInfixOf "--" lbl') $ fail "consecutive hyphens"
-        pure lbl'
-
-encodeNameFragment :: SimplexNameInfo -> Text
-encodeNameFragment SimplexNameInfo {nameType, namespace, domain, subDomain} =
-  prefix <> T.intercalate "." (reverse subDomain <> [domain] <> tld)
-  where
-    prefix = case nameType of NTPublicGroup -> "#"; NTContact -> ":"
-    tld = case namespace of NSSimplex -> ["simplex"]; NSTesting -> ["testing"]; NSWeb -> []
-
-mkNameInfo :: SimplexNameType -> [Text] -> Either String SimplexNameInfo
-mkNameInfo nt labels = case reverse labels of
-  [] -> Left "empty name"
-  [name] -> Right $ SimplexNameInfo nt NSSimplex name []
-  "simplex" : name : sub -> Right $ SimplexNameInfo nt NSSimplex name sub
-  "testing" : name : sub -> Right $ SimplexNameInfo nt NSTesting name sub
-  _ -> Right $ SimplexNameInfo nt NSWeb (T.intercalate "." labels) []
+        guard . isNameLetter =<< AT.peekChar'
+        T.intercalate "-" <$> AT.takeWhile1 (\c -> isNameLetter c || isDigit c) `AT.sepBy1` AT.char '-'
+      isNameLetter c = isAlpha c && not (c >= '\x00c0' && c <= '\x024f')
+      mkNameInfo nt labels = case reverse labels of
+        [] -> Left "empty name"
+        [name] -> Right $ SimplexNameInfo nt NSSimplex name []
+        "simplex" : name : sub -> Right $ SimplexNameInfo nt NSSimplex name sub
+        "testing" : name : sub -> Right $ SimplexNameInfo nt NSTesting name sub
+        _ -> Right $ SimplexNameInfo nt NSWeb (T.intercalate "." labels) []
 
 data AConnShortLink = forall m. ConnectionModeI m => ACSL (SConnectionMode m) (ConnShortLink m)
 

From 1113779c3af833bcc5d1dd80da2a2392ca457018 Mon Sep 17 00:00:00 2001
From: "Evgeny @ SimpleX Chat"
 <259188159+evgeny-simplex@users.noreply.github.com>
Date: Tue, 26 May 2026 16:49:39 +0000
Subject: [PATCH 09/13] import

---
 src/Simplex/Messaging/Agent/Protocol.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/Simplex/Messaging/Agent/Protocol.hs b/src/Simplex/Messaging/Agent/Protocol.hs
index d26ee4e2f..dae053cf2 100644
--- a/src/Simplex/Messaging/Agent/Protocol.hs
+++ b/src/Simplex/Messaging/Agent/Protocol.hs
@@ -187,7 +187,7 @@ module Simplex.Messaging.Agent.Protocol
   )
 where
 
-import Control.Applicative (many, optional, (<|>))
+import Control.Applicative (optional, (<|>))
 import Control.Monad (guard)
 import Control.Exception (BlockedIndefinitelyOnMVar (..), BlockedIndefinitelyOnSTM (..), fromException)
 import Data.Aeson (FromJSON (..), ToJSON (..), Value (..), (.:), (.:?))

From 3e39044c4d8eaa4b1e5aeb705f187165055c5b17 Mon Sep 17 00:00:00 2001
From: "Evgeny @ SimpleX Chat"
 <259188159+evgeny-simplex@users.noreply.github.com>
Date: Tue, 26 May 2026 21:46:33 +0000
Subject: [PATCH 10/13] use @ for contact addresses

---
 src/Simplex/Messaging/Agent/Protocol.hs | 8 +++++---
 1 file changed, 5 insertions(+), 3 deletions(-)

diff --git a/src/Simplex/Messaging/Agent/Protocol.hs b/src/Simplex/Messaging/Agent/Protocol.hs
index dae053cf2..058f9e3f0 100644
--- a/src/Simplex/Messaging/Agent/Protocol.hs
+++ b/src/Simplex/Messaging/Agent/Protocol.hs
@@ -1546,13 +1546,13 @@ instance StrEncoding AConnectTarget where
     ACTName SimplexNameInfo {nameType, namespace, domain, subDomain} ->
       "simplex:/name" <> encodeUtf8 (pfx <> T.intercalate "." (reverse subDomain <> [domain] <> tld))
       where
-        pfx = case nameType of NTPublicGroup -> "#"; NTContact -> ":"
+        pfx = case nameType of NTPublicGroup -> "#"; NTContact -> "@"
         tld = case namespace of NSSimplex -> ["simplex"]; NSTesting -> ["testing"]; NSWeb -> []
   strP = ACTName <$> nameP <|> ACTLink <$> strP
     where
       nameP = "simplex:/name" *> nameBodyP <|> nameBodyP
       nameBodyP = do
-        nt <- A.char '#' $> NTPublicGroup <|> A.char ':' $> NTContact
+        nt <- A.char '#' $> NTPublicGroup <|> A.char '@' $> NTContact
         parseName nt . safeDecodeUtf8 <$?> A.takeWhile1 (not . A.isSpace)
       parseName nt s = AT.parseOnly (nameLabelP `AT.sepBy1` AT.char '.' <* AT.endOfInput) s >>= mkNameInfo nt
       nameLabelP = do
@@ -1561,7 +1561,9 @@ instance StrEncoding AConnectTarget where
       isNameLetter c = isAlpha c && not (c >= '\x00c0' && c <= '\x024f')
       mkNameInfo nt labels = case reverse labels of
         [] -> Left "empty name"
-        [name] -> Right $ SimplexNameInfo nt NSSimplex name []
+        [name]
+          | nt == NTPublicGroup -> Right $ SimplexNameInfo nt NSSimplex name []
+          | otherwise -> Left "contact name requires TLD"
         "simplex" : name : sub -> Right $ SimplexNameInfo nt NSSimplex name sub
         "testing" : name : sub -> Right $ SimplexNameInfo nt NSTesting name sub
         _ -> Right $ SimplexNameInfo nt NSWeb (T.intercalate "." labels) []

From 6bad02130b41614d6474c2f47d2394cc1a17fe71 Mon Sep 17 00:00:00 2001
From: Evgeny Poberezkin <evgeny@poberezkin.com>
Date: Wed, 27 May 2026 09:06:58 +0100
Subject: [PATCH 11/13] remove AConnectTarget

---
 src/Simplex/Messaging/Agent/Protocol.hs | 30 +++++++++++--------------
 1 file changed, 13 insertions(+), 17 deletions(-)

diff --git a/src/Simplex/Messaging/Agent/Protocol.hs b/src/Simplex/Messaging/Agent/Protocol.hs
index 058f9e3f0..31dc48e3e 100644
--- a/src/Simplex/Messaging/Agent/Protocol.hs
+++ b/src/Simplex/Messaging/Agent/Protocol.hs
@@ -122,7 +122,6 @@ module Simplex.Messaging.Agent.Protocol
     OwnerId,
     ConnectionLink (..),
     AConnectionLink (..),
-    AConnectTarget (..),
     SimplexNameInfo (..),
     SimplexNamespace (..),
     SimplexNameType (..),
@@ -1520,12 +1519,6 @@ instance (Typeable c, ConnectionModeI c) => FromField (ConnShortLink c) where fr
 
 data ContactConnType = CCTContact | CCTChannel | CCTGroup | CCTRelay deriving (Eq, Show)
 
--- | A connection target: either a resolved link or an unresolved name.
--- Contexts that support name resolution accept AConnectTarget.
--- Contexts that only handle resolved links use AConnectionLink directly.
-data AConnectTarget = ACTLink AConnectionLink | ACTName SimplexNameInfo
-  deriving (Eq, Show)
-
 data SimplexNameInfo = SimplexNameInfo
   { nameType :: SimplexNameType,
     namespace :: SimplexNamespace,
@@ -1540,17 +1533,14 @@ data SimplexNamespace = NSSimplex | NSTesting | NSWeb
 data SimplexNameType = NTPublicGroup | NTContact
   deriving (Eq, Show)
 
-instance StrEncoding AConnectTarget where
-  strEncode = \case
-    ACTLink lnk -> strEncode lnk
-    ACTName SimplexNameInfo {nameType, namespace, domain, subDomain} ->
-      "simplex:/name" <> encodeUtf8 (pfx <> T.intercalate "." (reverse subDomain <> [domain] <> tld))
-      where
-        pfx = case nameType of NTPublicGroup -> "#"; NTContact -> "@"
-        tld = case namespace of NSSimplex -> ["simplex"]; NSTesting -> ["testing"]; NSWeb -> []
-  strP = ACTName <$> nameP <|> ACTLink <$> strP
+instance StrEncoding SimplexNameInfo where
+  strEncode SimplexNameInfo {nameType, namespace, domain, subDomain} =
+    "simplex:/name" <> encodeUtf8 (pfx <> T.intercalate "." (reverse subDomain <> [domain] <> tld))
+    where
+      pfx = case nameType of NTPublicGroup -> "#"; NTContact -> "@"
+      tld = case namespace of NSSimplex -> ["simplex"]; NSTesting -> ["testing"]; NSWeb -> []
+  strP = optional "simplex:/name" *> nameBodyP
     where
-      nameP = "simplex:/name" *> nameBodyP <|> nameBodyP
       nameBodyP = do
         nt <- A.char '#' $> NTPublicGroup <|> A.char '@' $> NTContact
         parseName nt . safeDecodeUtf8 <$?> A.takeWhile1 (not . A.isSpace)
@@ -2255,3 +2245,9 @@ instance FromJSON ACreatedConnLink where
 instance ToJSON ACreatedConnLink where
   toEncoding (ACCL _ ccLink) = toEncoding ccLink
   toJSON (ACCL _ ccLink) = toJSON ccLink
+
+$(J.deriveJSON (enumJSON $ dropPrefix "NS") ''SimplexNamespace)
+
+$(J.deriveJSON (enumJSON $ dropPrefix "NT") ''SimplexNameType)
+
+$(J.deriveJSON defaultJSON ''SimplexNameInfo)

From 86767e9ac31d7471663eda1016429afe99f4d224 Mon Sep 17 00:00:00 2001
From: Evgeny Poberezkin <evgeny@poberezkin.com>
Date: Wed, 27 May 2026 11:28:21 +0100
Subject: [PATCH 12/13] update parser and types

---
 src/Simplex/Messaging/Agent/Protocol.hs | 56 +++++++++++++++++--------
 1 file changed, 39 insertions(+), 17 deletions(-)

diff --git a/src/Simplex/Messaging/Agent/Protocol.hs b/src/Simplex/Messaging/Agent/Protocol.hs
index 31dc48e3e..a1c780615 100644
--- a/src/Simplex/Messaging/Agent/Protocol.hs
+++ b/src/Simplex/Messaging/Agent/Protocol.hs
@@ -123,7 +123,7 @@ module Simplex.Messaging.Agent.Protocol
     ConnectionLink (..),
     AConnectionLink (..),
     SimplexNameInfo (..),
-    SimplexNamespace (..),
+    SimplexTLD (..),
     SimplexNameType (..),
     ConnShortLink (..),
     AConnShortLink (..),
@@ -144,6 +144,8 @@ module Simplex.Messaging.Agent.Protocol
     connReqUriP',
     simplexConnReqUri,
     simplexShortLink,
+    fullDomainName,
+    shortNameInfoStr,
     AgentErrorType (..),
     CommandErrorType (..),
     ConnectionErrorType (..),
@@ -1521,29 +1523,29 @@ data ContactConnType = CCTContact | CCTChannel | CCTGroup | CCTRelay deriving (E
 
 data SimplexNameInfo = SimplexNameInfo
   { nameType :: SimplexNameType,
-    namespace :: SimplexNamespace,
+    nameTLD :: SimplexTLD,
     domain :: Text,
     subDomain :: [Text] -- parent to child: ["b", "a"] for a.b.domain.simplex
   }
   deriving (Eq, Show)
 
-data SimplexNamespace = NSSimplex | NSTesting | NSWeb
+data SimplexTLD = TLDSimplex | TLDTesting | TLDWeb {tld :: Text}
   deriving (Eq, Show)
 
 data SimplexNameType = NTPublicGroup | NTContact
   deriving (Eq, Show)
 
+instance StrEncoding SimplexNameType where
+  strEncode = \case
+    NTPublicGroup -> "#"
+    NTContact -> "@"
+  strP = A.char '#' $> NTPublicGroup <|> A.char '@' $> NTContact
+
 instance StrEncoding SimplexNameInfo where
-  strEncode SimplexNameInfo {nameType, namespace, domain, subDomain} =
-    "simplex:/name" <> encodeUtf8 (pfx <> T.intercalate "." (reverse subDomain <> [domain] <> tld))
+  strEncode info = "simplex:/name" <> strEncode (nameType info) <> encodeUtf8 (fullDomainName info)
+  strP = optional "simplex:/name" *> (strP >>= nameP) <|> nameP NTPublicGroup
     where
-      pfx = case nameType of NTPublicGroup -> "#"; NTContact -> "@"
-      tld = case namespace of NSSimplex -> ["simplex"]; NSTesting -> ["testing"]; NSWeb -> []
-  strP = optional "simplex:/name" *> nameBodyP
-    where
-      nameBodyP = do
-        nt <- A.char '#' $> NTPublicGroup <|> A.char '@' $> NTContact
-        parseName nt . safeDecodeUtf8 <$?> A.takeWhile1 (not . A.isSpace)
+      nameP nt = parseName nt . safeDecodeUtf8 <$?> A.takeWhile1 (not . A.isSpace)
       parseName nt s = AT.parseOnly (nameLabelP `AT.sepBy1` AT.char '.' <* AT.endOfInput) s >>= mkNameInfo nt
       nameLabelP = do
         guard . isNameLetter =<< AT.peekChar'
@@ -1552,11 +1554,31 @@ instance StrEncoding SimplexNameInfo where
       mkNameInfo nt labels = case reverse labels of
         [] -> Left "empty name"
         [name]
-          | nt == NTPublicGroup -> Right $ SimplexNameInfo nt NSSimplex name []
+          | nt == NTPublicGroup -> Right $ SimplexNameInfo nt TLDSimplex name []
           | otherwise -> Left "contact name requires TLD"
-        "simplex" : name : sub -> Right $ SimplexNameInfo nt NSSimplex name sub
-        "testing" : name : sub -> Right $ SimplexNameInfo nt NSTesting name sub
-        _ -> Right $ SimplexNameInfo nt NSWeb (T.intercalate "." labels) []
+        tld : name : sub -> Right $ SimplexNameInfo nt ns name sub
+          where
+            ns = case tld of
+              "simplex" -> TLDSimplex
+              "testing" -> TLDTesting
+              _ -> TLDWeb tld
+
+fullDomainName :: SimplexNameInfo -> Text
+fullDomainName SimplexNameInfo {nameTLD, domain, subDomain} = T.intercalate "." (reverse subDomain <> [domain, tld'])
+  where
+    tld' = case nameTLD of
+      TLDSimplex -> "simplex"
+      TLDTesting -> "testing"
+      TLDWeb tld -> tld
+      
+shortNameInfoStr :: SimplexNameInfo -> Text
+shortNameInfoStr = \case
+  SimplexNameInfo {nameType = NTPublicGroup, nameTLD = TLDSimplex, domain, subDomain = []} -> "#" <> domain
+  info -> pfx <> fullDomainName info
+    where
+      pfx = case nameType info of
+        NTPublicGroup -> "#"
+        NTContact -> "@"  
 
 data AConnShortLink = forall m. ConnectionModeI m => ACSL (SConnectionMode m) (ConnShortLink m)
 
@@ -2246,7 +2268,7 @@ instance ToJSON ACreatedConnLink where
   toEncoding (ACCL _ ccLink) = toEncoding ccLink
   toJSON (ACCL _ ccLink) = toJSON ccLink
 
-$(J.deriveJSON (enumJSON $ dropPrefix "NS") ''SimplexNamespace)
+$(J.deriveJSON (enumJSON $ dropPrefix "TLD") ''SimplexTLD)
 
 $(J.deriveJSON (enumJSON $ dropPrefix "NT") ''SimplexNameType)
 

From 9ad6d9dc248b6fa3b3d429252e14a39e1045704c Mon Sep 17 00:00:00 2001
From: Evgeny Poberezkin <evgeny@poberezkin.com>
Date: Wed, 27 May 2026 12:52:07 +0100
Subject: [PATCH 13/13] revert TLDWeb

---
 src/Simplex/Messaging/Agent/Protocol.hs | 27 ++++++++++++-------------
 1 file changed, 13 insertions(+), 14 deletions(-)

diff --git a/src/Simplex/Messaging/Agent/Protocol.hs b/src/Simplex/Messaging/Agent/Protocol.hs
index a1c780615..841cc0088 100644
--- a/src/Simplex/Messaging/Agent/Protocol.hs
+++ b/src/Simplex/Messaging/Agent/Protocol.hs
@@ -189,7 +189,7 @@ module Simplex.Messaging.Agent.Protocol
 where
 
 import Control.Applicative (optional, (<|>))
-import Control.Monad (guard)
+import Control.Monad
 import Control.Exception (BlockedIndefinitelyOnMVar (..), BlockedIndefinitelyOnSTM (..), fromException)
 import Data.Aeson (FromJSON (..), ToJSON (..), Value (..), (.:), (.:?))
 import qualified Data.Aeson as J'
@@ -1529,7 +1529,7 @@ data SimplexNameInfo = SimplexNameInfo
   }
   deriving (Eq, Show)
 
-data SimplexTLD = TLDSimplex | TLDTesting | TLDWeb {tld :: Text}
+data SimplexTLD = TLDSimplex | TLDTesting | TLDWeb
   deriving (Eq, Show)
 
 data SimplexNameType = NTPublicGroup | NTContact
@@ -1548,28 +1548,27 @@ instance StrEncoding SimplexNameInfo where
       nameP nt = parseName nt . safeDecodeUtf8 <$?> A.takeWhile1 (not . A.isSpace)
       parseName nt s = AT.parseOnly (nameLabelP `AT.sepBy1` AT.char '.' <* AT.endOfInput) s >>= mkNameInfo nt
       nameLabelP = do
-        guard . isNameLetter =<< AT.peekChar'
-        T.intercalate "-" <$> AT.takeWhile1 (\c -> isNameLetter c || isDigit c) `AT.sepBy1` AT.char '-'
+        ws <- AT.takeWhile1 (\c -> isNameLetter c || isDigit c) `AT.sepBy1` AT.char '-'
+        when (all (T.all isDigit) ws) $ fail "name must contain letters"
+        pure $ T.intercalate "-" ws
       isNameLetter c = isAlpha c && not (c >= '\x00c0' && c <= '\x024f')
       mkNameInfo nt labels = case reverse labels of
         [] -> Left "empty name"
         [name]
           | nt == NTPublicGroup -> Right $ SimplexNameInfo nt TLDSimplex name []
           | otherwise -> Left "contact name requires TLD"
-        tld : name : sub -> Right $ SimplexNameInfo nt ns name sub
-          where
-            ns = case tld of
-              "simplex" -> TLDSimplex
-              "testing" -> TLDTesting
-              _ -> TLDWeb tld
+        tld : name : sub -> Right $ case tld of
+          "simplex" -> SimplexNameInfo nt TLDSimplex name sub
+          "testing" -> SimplexNameInfo nt TLDTesting name sub
+          _ -> SimplexNameInfo nt TLDWeb (T.intercalate "." labels) []
 
 fullDomainName :: SimplexNameInfo -> Text
-fullDomainName SimplexNameInfo {nameTLD, domain, subDomain} = T.intercalate "." (reverse subDomain <> [domain, tld'])
+fullDomainName SimplexNameInfo {nameTLD, domain, subDomain} = T.intercalate "." (reverse subDomain ++ [domain] ++ tld')
   where
     tld' = case nameTLD of
-      TLDSimplex -> "simplex"
-      TLDTesting -> "testing"
-      TLDWeb tld -> tld
+      TLDSimplex -> ["simplex"]
+      TLDTesting -> ["testing"]
+      TLDWeb -> []
       
 shortNameInfoStr :: SimplexNameInfo -> Text
 shortNameInfoStr = \case