From ee2ff402fed4d27d31521570c910fe82e0cf116a Mon Sep 17 00:00:00 2001
From: sh <37271604+shumvgolove@users.noreply.github.com>
Date: Fri, 29 May 2026 08:11:08 +0000
Subject: [PATCH] agent: split SimplexNameDomain out of SimplexNameInfo (#1788)
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

* agent: split SimplexNameDomain out of SimplexNameInfo

The type now separates the user-supplied type prefix (#/@) from the
domain itself:

  data SimplexNameInfo = SimplexNameInfo
    { nameType :: SimplexNameType
    , nameDomain :: SimplexNameDomain
    }

  data SimplexNameDomain = SimplexNameDomain
    { nameTLD :: SimplexTLD
    , domain :: Text
    , subDomain :: [Text]
    }

The domain is independent of the contact-vs-public-group distinction —
the same dotted-labels structure applies to both. Future code that
needs to talk about a domain without committing to a name type (e.g.
server-side TLD-based registry lookup) can use SimplexNameDomain
directly.

fullDomainName now operates on SimplexNameDomain rather than the
full info wrapper. Parser, StrEncoding instance, and aeson derivations
updated accordingly. No external callers needed updating.

* agent: split StrEncoding instance for SimplexNameDomain

* agent: flatten TLD case + use unless guard

* agent: address review - strict domain parser, permissive channel
---
 src/Simplex/Messaging/Agent/Protocol.hs | 65 ++++++++++++++++---------
 1 file changed, 41 insertions(+), 24 deletions(-)

diff --git a/src/Simplex/Messaging/Agent/Protocol.hs b/src/Simplex/Messaging/Agent/Protocol.hs
index 58e148f7e..a3f683770 100644
--- a/src/Simplex/Messaging/Agent/Protocol.hs
+++ b/src/Simplex/Messaging/Agent/Protocol.hs
@@ -123,6 +123,7 @@ module Simplex.Messaging.Agent.Protocol
     ConnectionLink (..),
     AConnectionLink (..),
     SimplexNameInfo (..),
+    SimplexNameDomain (..),
     SimplexTLD (..),
     SimplexNameType (..),
     ConnShortLink (..),
@@ -1522,7 +1523,12 @@ data ContactConnType = CCTContact | CCTChannel | CCTGroup | CCTRelay deriving (E
 
 data SimplexNameInfo = SimplexNameInfo
   { nameType :: SimplexNameType,
-    nameTLD :: SimplexTLD,
+    nameDomain :: SimplexNameDomain
+  }
+  deriving (Eq, Show)
+
+data SimplexNameDomain = SimplexNameDomain
+  { nameTLD :: SimplexTLD,
     domain :: Text,
     subDomain :: [Text] -- parent to child: ["b", "a"] for a.b.domain.simplex
   }
@@ -1540,40 +1546,49 @@ instance StrEncoding SimplexNameType where
     NTContact -> "@"
   strP = A.char '#' $> NTPublicGroup <|> A.char '@' $> NTContact
 
-instance StrEncoding SimplexNameInfo where
-  strEncode info = "simplex:/name" <> strEncode (nameType info) <> encodeUtf8 (fullDomainName info)
-  strP = optional "simplex:/name" *> (strP >>= nameP) <|> nameP NTPublicGroup
-    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 = 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]
-          | nt == NTPublicGroup -> Right $ SimplexNameInfo nt TLDSimplex name []
-          | otherwise -> Left "contact name requires 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) []
+nameLabelP :: AT.Parser Text
+nameLabelP = T.intercalate "-" <$> AT.takeWhile1 (\c -> isNameLetter c || isDigit c) `AT.sepBy1` AT.char '-'
+  where
+    isNameLetter c = isAlpha c && not (c >= '\x00c0' && c <= '\x024f')
 
-fullDomainName :: SimplexNameInfo -> Text
-fullDomainName SimplexNameInfo {nameTLD, domain, subDomain} = T.intercalate "." (reverse subDomain ++ [domain] ++ tld')
+instance StrEncoding SimplexNameInfo where
+  strEncode SimplexNameInfo {nameType, nameDomain} =
+    "simplex:/name" <> strEncode nameType <> strEncode nameDomain
+  strP = optional "simplex:/name" *> ((strP >>= infoP) <|> infoP NTPublicGroup)
+    where
+      infoP NTPublicGroup = SimplexNameInfo NTPublicGroup <$> (strP <|> bareName)
+      infoP NTContact = SimplexNameInfo NTContact <$> strP
+      bareName = parseBare . safeDecodeUtf8 <$?> A.takeWhile1 (not . A.isSpace)
+      parseBare s = (\name -> SimplexNameDomain TLDSimplex name []) <$> AT.parseOnly (nameLabelP <* AT.endOfInput) s
+
+instance StrEncoding SimplexNameDomain where
+  strEncode = encodeUtf8 . fullDomainName
+  strP = parseDomain . safeDecodeUtf8 <$?> A.takeWhile1 (not . A.isSpace)
+    where
+      parseDomain s = AT.parseOnly (nameLabelP `AT.sepBy1` AT.char '.' <* AT.endOfInput) s >>= mkDomain
+      mkDomain labels = case reverse labels of
+        [] -> Left "empty name"
+        [_] -> Left "domain requires TLD"
+        "simplex" : name : sub -> Right $ SimplexNameDomain TLDSimplex name sub
+        "testing" : name : sub -> Right $ SimplexNameDomain TLDTesting name sub
+        _ -> Right $ SimplexNameDomain TLDWeb (T.intercalate "." labels) []
+
+fullDomainName :: SimplexNameDomain -> Text
+fullDomainName SimplexNameDomain {nameTLD, domain, subDomain} = T.intercalate "." (reverse subDomain ++ [domain] ++ tld')
   where
     tld' = case nameTLD of
       TLDSimplex -> ["simplex"]
       TLDTesting -> ["testing"]
       TLDWeb -> []
-      
+
 shortNameInfoStr :: SimplexNameInfo -> Text
 shortNameInfoStr = \case
-  SimplexNameInfo {nameType = NTPublicGroup, nameTLD = TLDSimplex, domain, subDomain = []} -> "#" <> domain
-  info -> pfx <> fullDomainName info
+  SimplexNameInfo {nameType = NTPublicGroup, nameDomain = SimplexNameDomain {nameTLD = TLDSimplex, domain, subDomain = []}} -> "#" <> domain
+  info -> pfx <> fullDomainName (nameDomain info)
     where
       pfx = case nameType info of
         NTPublicGroup -> "#"
-        NTContact -> "@"  
+        NTContact -> "@"
 
 data AConnShortLink = forall m. ConnectionModeI m => ACSL (SConnectionMode m) (ConnShortLink m)
 
@@ -2267,4 +2282,6 @@ $(J.deriveJSON (enumJSON $ dropPrefix "TLD") ''SimplexTLD)
 
 $(J.deriveJSON (enumJSON $ dropPrefix "NT") ''SimplexNameType)
 
+$(J.deriveJSON defaultJSON ''SimplexNameDomain)
+
 $(J.deriveJSON defaultJSON ''SimplexNameInfo)