Fix wildcard parsing.

src/GenericParser.purs

@@ -7,7 +7,8 @@ module GenericParser
   ) where
 
 import GenericParser.DomainParser.Common (DomainError(..), ldh_str, let_dig, let_dig_hyp, max_domain_length, max_label_length, Size)
-import GenericParser.DomainParser (domain, label, subdomain, sub_eof)
+import GenericParser.DomainParser (domain, domain', label, name, subdomain, sub_eof, wildcard, wildcard_eof)
+-- import GenericParser.DomainParserRFC1035 (domain, domain', label, name, subdomain, sub_eof, wildcard, wildcard_eof)
 import GenericParser.Parser (char, current_input, current_position, Error, errorParser, error_functor, failure, failureError, Input, item, lookahead, many1, parse, parse_last_char, Parser(..), Position, PositionString, Result, rollback, sat, string, success, try, tryMaybe, until, Value)
 import GenericParser.RFC5322 (obs_fws, fws, ctext, quoted_pair, ccontent, comment, cfws, address, mailbox, name_addr, angle_addr, group, display_name, mailbox_list, address_list, group_list, atext, atom, dot_atom_text, dot_atom, specials, addr_spec, local_part, {- domain ,-} domain_literal, dtext, obs_angle_addr, obs_route, obs_domain_list, obs_mbox_list, obs_addr_list, obs_group_list, obs_local_part, obs_domain, obs_dtext, obs_no_ws_ctl, obs_ctext, obs_qtext, obs_utext, obs_qp, obs_body, obs_unstruct, obs_phrase, word, phrase, unstructured, obs_phrase_list, qtext, qcontent, quoted_string)
 -- import GenericParser.RFC5234

src/GenericParser/DomainParser.purs

@@ -71,6 +71,24 @@ sub_eof = do
     did_we_parse_the_final_point Nothing sub = sub
     did_we_parse_the_final_point _       sub = sub <> "."
 
+-- | Wildcard ("*") parser: <wildcard> ::= "*." subdomain
+wildcard :: Parser DomainError String
+wildcard = do
+  _ <- string "*."
+  rest <- sub_eof
+  pure $ "*." <> rest
+
+-- | Wildcard only ("*") parser: <wildcard_eof> ::= "*" (nothing should follow)
+wildcard_eof :: Parser DomainError String
+wildcard_eof = do
+  _ <- string "*"
+  _ <- eof -- In case there is still some input, it fails.
+  pure "*"
+
+-- | `name` provides an easy-to-use validation for the "name" attribute of resource records.
+name :: Parser DomainError String
+name = wildcard <|> wildcard_eof <|> sub_eof
+
 -- | From RFC 1035: <domain> ::= <subdomain> | " "
 -- |
 -- | Since RFC 1034 requires to accept '*' as leftmost domain label, the rule should be:
@@ -85,9 +103,9 @@ sub_eof = do
 -- | For documentation about wildcards, see RFC 4592.
 domain :: Parser DomainError String
 domain = (string " " *> eof) <|> wildcard <|> sub_eof
-  where
-    wildcard :: Parser DomainError String
-    wildcard = do
-      _ <- string "*."
-      rest <- sub_eof
-      pure $ "*." <> rest
+
+-- | `domain'` is as `domain` but doesn't accept empty domains (" ").
+-- |
+-- | <domain> ::= <subdomain> | "*." <subdomain>
+domain' :: Parser DomainError String
+domain' = wildcard <|> sub_eof

src/GenericParser/DomainParserRFC1035.purs

@@ -77,6 +77,24 @@ sub_eof = do
   then Parser \_ -> failureError pos (Just <<< DomainTooLarge $ S.length sub)
   else pure sub
 
+-- | Wildcard ("*") parser: <wildcard> ::= "*." subdomain
+wildcard :: Parser DomainError String
+wildcard = do
+  _ <- string "*."
+  rest <- sub_eof
+  pure $ "*." <> rest
+
+-- | Wildcard only ("*") parser: <wildcard_eof> ::= "*" (nothing should follow)
+wildcard_eof :: Parser DomainError String
+wildcard_eof = do
+  _ <- string "*"
+  _ <- eof -- In case there is still some input, it fails.
+  pure "*"
+
+-- | `name` provides an easy-to-use validation for the "name" attribute of resource records.
+name :: Parser DomainError String
+name = wildcard <|> wildcard_eof <|> sub_eof
+
 -- | From RFC 1035: <domain> ::= <subdomain> | " "
 -- |
 -- | Since RFC 1034 requires to accept '*' as leftmost domain label, the rule should be:
@@ -91,9 +109,9 @@ sub_eof = do
 -- | For documentation about wildcards, see RFC 4592.
 domain :: Parser DomainError String
 domain = (string " " *> eof) <|> wildcard <|> sub_eof
-  where
-    wildcard :: Parser DomainError String
-    wildcard = do
-      _ <- string "*."
-      rest <- sub_eof
-      pure $ "*." <> rest
+
+-- | `domain'` is as `domain` but doesn't accept empty domains (" ").
+-- |
+-- | <domain> ::= <subdomain> | "*." <subdomain>
+domain' :: Parser DomainError String
+domain' = wildcard <|> sub_eof

test/Main.purs

@@ -94,8 +94,12 @@ main = do
   log ""
   test_series "RFC1035.sub_eof" RFC1035.sub_eof id showerror T.domains
   log ""
+  test_series "RFC1035.name" RFC1035.name id showerror T.domains
+  log ""
   test_series "RFC1035.domain" RFC1035.domain id showerror T.domains
   log ""
+  test_series "ModernDomains.name" ModernDomains.name id showerror T.domains
+  log ""
   test_series "ModernDomains.domain" ModernDomains.domain id showerror T.domains
 
   log ""

test/TestValues.purs

@@ -16,6 +16,8 @@ domains
     , "xblah.a33.org"
     , "_dmarc.example.com"
     , "*.example.com"
+    , "*."
+    , "*"
     ]
 
 ipv4_addresses :: Array String