From 6a78e863c1900ab0d304d062a62e2442014dafde Mon Sep 17 00:00:00 2001
From: Philippe Pittoli <karchnu@karchnu.fr>
Date: Sat, 20 Jan 2024 01:33:42 +0100
Subject: [PATCH] Accepting a final "." at the end of a subdomain (both RFC1035
 and Modern Parser).

---
 src/GenericParser/DomainParser.purs        | 16 ++++++-----
 src/GenericParser/DomainParserRFC1035.purs | 33 ++++++++++------------
 test/Main.purs                             | 10 -------
 3 files changed, 24 insertions(+), 35 deletions(-)

diff --git a/src/GenericParser/DomainParser.purs b/src/GenericParser/DomainParser.purs
index 58f23f2..b72d08e 100644
--- a/src/GenericParser/DomainParser.purs
+++ b/src/GenericParser/DomainParser.purs
@@ -19,7 +19,7 @@ import GenericParser.Parser (Parser(..)
                             , failureError
                             , current_position
                             , char, letter, parse, string
-                            , try, tryMaybe)
+                            , tryMaybe)
 
 -- | From RFC 1035: <label> ::= <letter> [ [ <ldh-str> ] <let-dig> ]
 -- | In practice, the first character can be an underscore (for example, see `_dmarc.example.com`).
@@ -53,17 +53,19 @@ label = do
          _       -> true
 
 -- | From RFC 1035: <subdomain> ::= <label> | <subdomain> "." <label>
+-- | For implementation details, this accepts a final dot "." as a suffix.
 subdomain :: Parser DomainError String
 subdomain = do
   -- First: read a label. This is bare minimum for a subdomain.
   lab <- label
-  upperlabels <- try do
-    _ <- char '.'
-    sub <- defer \_ -> subdomain
-    pure sub
-  case upperlabels of
+  point <- tryMaybe $ char '.'
+  case point of
     Nothing -> pure lab
-    Just l  -> pure $ lab <> "." <> l
+    Just _  -> do
+      upperlabels <- tryMaybe $ defer \_ -> subdomain
+      case upperlabels of
+        Nothing -> pure $ lab <> "."
+        Just l  -> pure $ lab <> "." <> l
 
 -- | Test for the domain to be a list of subdomains then an end-of-file.
 -- | Said otherwise, the input must only contain a domain (with or without a final dot '.').
diff --git a/src/GenericParser/DomainParserRFC1035.purs b/src/GenericParser/DomainParserRFC1035.purs
index a55beed..f9339f4 100644
--- a/src/GenericParser/DomainParserRFC1035.purs
+++ b/src/GenericParser/DomainParserRFC1035.purs
@@ -13,13 +13,13 @@ import Data.String as S
 import Data.String.CodeUnits as CU
 
 -- Import all common functions between RFC1035 and modern domain parsing.
-import GenericParser.DomainParser.Common (DomainError(..), eof, ldh_str, let_dig, let_dig_hyp, max_domain_length, max_label_length, Size)
+import GenericParser.DomainParser.Common (DomainError(..), eof, ldh_str, let_dig, max_domain_length, max_label_length)
 
 import GenericParser.Parser (Parser(..)
-                            , success, failureError
+                            , failureError
                             , current_position
-                            , alphanum, char, letter, many1, parse, string
-                            , try, tryMaybe)
+                            , char, letter, parse, string
+                            , tryMaybe)
 
 -- | From RFC 1035: <label> ::= <letter> [ [ <ldh-str> ] <let-dig> ]
 label :: Parser DomainError String
@@ -51,33 +51,30 @@ label = do
          _       -> true
 
 -- | From RFC 1035: <subdomain> ::= <label> | <subdomain> "." <label>
+-- | For implementation details, this accepts a final dot "." as a suffix.
 subdomain :: Parser DomainError String
 subdomain = do
   -- First: read a label. This is bare minimum for a subdomain.
   lab <- label
-  upperlabels <- try do
-    _ <- char '.'
-    sub <- defer \_ -> subdomain
-    pure sub
-  case upperlabels of
+  point <- tryMaybe $ char '.'
+  case point of
     Nothing -> pure lab
-    Just l  -> pure $ lab <> "." <> l
+    Just _  -> do
+      upperlabels <- tryMaybe $ defer \_ -> subdomain
+      case upperlabels of
+        Nothing -> pure $ lab <> "."
+        Just l  -> pure $ lab <> "." <> l
 
 -- | Test for the domain to be a list of subdomains then an end-of-file.
 -- | Said otherwise, the input must only contain a domain (with or without a final dot '.').
 sub_eof :: Parser DomainError String
 sub_eof = do
   sub <- subdomain
-  maybe_final_point <- tryMaybe $ char '.'
   _ <- eof -- In case there is still some input, it fails.
   pos <- current_position
-  let parsed_domain = did_we_parse_the_final_point maybe_final_point sub
-  if S.length parsed_domain > max_domain_length
-  then Parser \_ -> failureError pos (Just <<< DomainTooLarge $ S.length parsed_domain)
-  else pure parsed_domain
-  where
-    did_we_parse_the_final_point Nothing sub = sub
-    did_we_parse_the_final_point _       sub = sub <> "."
+  if S.length sub > max_domain_length
+  then Parser \_ -> failureError pos (Just <<< DomainTooLarge $ S.length sub)
+  else pure sub
 
 -- | From RFC 1035: <domain> ::= <subdomain> | " "
 -- |
diff --git a/test/Main.purs b/test/Main.purs
index 81ba626..98b3a3b 100644
--- a/test/Main.purs
+++ b/test/Main.purs
@@ -45,19 +45,9 @@ main = do
       "a.x",
       "a2.org",
       "a33.org",
-      "a444.org",
-      "a5555.org",
-      "a66666.org",
-      "a777777.org",
-      "a8888888.org",
       "xblah.a.x",
       "xblah.a2.org",
       "xblah.a33.org",
-      "xblah.a444.org",
-      "xblah.a5555.org",
-      "xblah.a66666.org",
-      "xblah.a777777.org",
-      "xblah.a8888888.org",
       "_dmarc.example.com"
     ]
   test_series "ldh_str" ldh_str fromCharArray showerror domains