From 15f4983fe24bfe6a4bb57ea203cda4783ae190d6 Mon Sep 17 00:00:00 2001
From: Philippe Pittoli <karchnu@karchnu.fr>
Date: Sat, 13 Jan 2024 01:39:16 +0100
Subject: [PATCH] sub_eof

---
 src/DomainParser.purs | 66 ++++++++++++++++++++-----------------------
 src/Main.purs         | 23 +++++++++++++++
 2 files changed, 54 insertions(+), 35 deletions(-)

diff --git a/src/DomainParser.purs b/src/DomainParser.purs
index bb996e6..3bcc59b 100644
--- a/src/DomainParser.purs
+++ b/src/DomainParser.purs
@@ -16,16 +16,16 @@ import Control.Plus (empty)
 
 import Parser
 
--- From RFC 1035: <let-dig> ::= <letter> | <digit>
+-- | From RFC 1035: <let-dig> ::= <letter> | <digit>
 let_dig :: Parser Char
 let_dig = alphanum
 
--- From RFC 1035: <let-dig-hyp> ::= <let-dig> | "-"
--- Either a Letter, Digital or an Hyphenation character.
+-- | From RFC 1035: <let-dig-hyp> ::= <let-dig> | "-"
+-- | Either a Letter, Digital or an Hyphenation character.
 let_dig_hyp :: Parser Char
 let_dig_hyp = let_dig <|> char '-'
 
--- From RFC 1035: <ldh-str> ::= <let-dig-hyp> | <let-dig-hyp> <ldh-str>
+-- | From RFC 1035: <ldh-str> ::= <let-dig-hyp> | <let-dig-hyp> <ldh-str>
 ldh_str :: Parser (Array Char)
 ldh_str = many1 let_dig_hyp
 
@@ -33,6 +33,10 @@ ldh_str = many1 let_dig_hyp
 label_maxsize :: Int
 label_maxsize = 7
 
+-- TODO: 255?
+max_domain_length :: Int
+max_domain_length = 15
+
 last_char :: String -> Maybe Char
 last_char = A.last <<< CU.toCharArray
 
@@ -54,7 +58,7 @@ try p = Parser p'
                    Nothing -> Just (Tuple mempty str) -- FIXME! Need a better base structure.
                    Just x -> pure x
 
--- From RFC 1035: <label> ::= <letter> [ [ <ldh-str> ] <let-dig> ]
+-- | From RFC 1035: <label> ::= <letter> [ [ <ldh-str> ] <let-dig> ]
 label :: Parser String
 label = do
   l <- letter
@@ -66,7 +70,7 @@ label = do
        then empty
        else pure labelstr
 
--- From RFC 1035: <subdomain> ::= <label> | <subdomain> "." <label>
+-- | From RFC 1035: <subdomain> ::= <label> | <subdomain> "." <label>
 subdomain :: Parser String
 subdomain = do
   -- First: read a label. This is bare minimum for a subdomain.
@@ -79,26 +83,30 @@ subdomain = do
   then pure lab
   else pure $ lab <> "." <> upperlabels
 
-----  -- Second: the rest is optional.
-----  r <- PC.optionMaybe (PC.try point_sub)
-----  case r of
-----    Nothing  -> pure lab
-----    Just sub -> pure $ lab <> sub
-----
-----  where
-----    point_sub :: Parser String
-----    point_sub = do
-----      point <- char '.'
-----      sub <- defer \_ -> subdomain
-----      pure $ CU.singleton point <> sub
+-- | Test for the end-of-file (no more input).
+-- | If not EOF the parser fails (Nothing), otherwise it provides an empty string.
+eof :: Parser String
+eof = Parser \str -> case S.length str of
+  0 -> Just (Tuple "" str)
+  _ -> Nothing -- this means an error
+
+-- | 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 String
+sub_eof = do
+  sub <- subdomain
+  maybe_final_point <- char '.' <|> pure ' '
+  _ <- eof -- In case there is still some input, it fails.
+  let parsed_domain = did_we_parsed_the_final_point maybe_final_point sub
+  if S.length parsed_domain > max_domain_length
+  then empty -- TODO: error management
+  else pure parsed_domain
+  where
+    did_we_parsed_the_final_point '.' sub = sub <> "."
+    did_we_parsed_the_final_point _   sub = sub
 
 {-
-import Control.Lazy (defer)
-import Data.Array.NonEmpty as NonEmpty
 import Data.Either (Either(..))
-import Data.Maybe (Maybe(..))
-import Data.String as S -- length
-import Data.String.CodeUnits as CU
 -- import Data.String.Regex as R
 -- import Data.String.Regex.Flags as RF
 import Data.Tuple (Tuple(..))
@@ -118,18 +126,6 @@ import Parsing.String (char, string, eof)
 domain :: Parser String String
 domain = PC.try (string " ") <|> sub_eof
 
-sub_eof :: Parser String String
-sub_eof = do
-  sub <- subdomain
-  maybe_final_point <- PC.optionMaybe (char '.')
-  eof
-  let parsed_domain = did_we_parsed_the_final_point maybe_final_point sub
-  if S.length parsed_domain > 255
-  then fail $ "domain length is > 255 bytes (" <> show (S.length parsed_domain) <> ")"
-  else pure parsed_domain
-  where
-    did_we_parsed_the_final_point Nothing  sub = sub
-    did_we_parsed_the_final_point (Just _) sub = sub <> "."
 
 -- | Converting a single letter parser to a String parser.
 char_to_string :: Parser String Char -> Parser String String
diff --git a/src/Main.purs b/src/Main.purs
index cdc73aa..676364f 100644
--- a/src/Main.purs
+++ b/src/Main.purs
@@ -95,6 +95,29 @@ main = do
   logtest "subdomain" subdomain "-" id
   logtest "subdomain" subdomain "a-" id
 
+  log ""
+
+  logtest "sub_eof" sub_eof "example.org" id
+  logtest "sub_eof" sub_eof "" id
+  logtest "sub_eof" sub_eof "a.x" id
+  logtest "sub_eof" sub_eof "a2.org" id
+  logtest "sub_eof" sub_eof "a33.org" id
+  logtest "sub_eof" sub_eof "a444.org" id
+  logtest "sub_eof" sub_eof "a5555.org" id
+  logtest "sub_eof" sub_eof "a66666.org" id
+  logtest "sub_eof" sub_eof "a777777.org" id
+  logtest "sub_eof" sub_eof "a8888888.org" id
+  logtest "sub_eof" sub_eof "xblah.a.x" id
+  logtest "sub_eof" sub_eof "xblah.a2.org" id
+  logtest "sub_eof" sub_eof "xblah.a33.org" id
+  logtest "sub_eof" sub_eof "xblah.a444.org" id
+  logtest "sub_eof" sub_eof "xblah.a5555.org" id
+  logtest "sub_eof" sub_eof "xblah.a66666.org" id
+  logtest "sub_eof" sub_eof "xblah.a777777.org" id
+  logtest "sub_eof" sub_eof "xblah.a8888888.org" id
+  logtest "sub_eof" sub_eof "-" id
+  logtest "sub_eof" sub_eof "a-" id
+
 --  log $ "parsing the first 'f' in 'fiction' (sat): " <> case parse (sat (\x -> x == 'f')) "fiction" of
 --    Just (Tuple x y) -> show x <> " " <> show y
 --    Nothing -> "failed"