agent: split SimplexNameDomain out of SimplexNameInfo (#1788)

* 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

@@ -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
+nameLabelP :: AT.Parser Text
-  strEncode info = "simplex:/name" <> strEncode (nameType info) <> encodeUtf8 (fullDomainName info)
+nameLabelP = T.intercalate "-" <$> AT.takeWhile1 (\c -> isNameLetter c || isDigit c) `AT.sepBy1` AT.char '-'
-  strP = optional "simplex:/name" *> (strP >>= nameP) <|> nameP NTPublicGroup
+  where
-    where
+    isNameLetter c = isAlpha c && not (c >= '\x00c0' && c <= '\x024f')
-      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) []
 
-fullDomainName :: SimplexNameInfo -> Text
+instance StrEncoding SimplexNameInfo where
-fullDomainName SimplexNameInfo {nameTLD, domain, subDomain} = T.intercalate "." (reverse subDomain ++ [domain] ++ tld')
+  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
+  SimplexNameInfo {nameType = NTPublicGroup, nameDomain = SimplexNameDomain {nameTLD = TLDSimplex, domain, subDomain = []}} -> "#" <> domain
-  info -> pfx <> fullDomainName info
+  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)