From: Michael Orlitzky <michael@orlitzky.com>
Date: Thu, 9 Jul 2015 19:00:15 +0000 (-0400)
Subject: Fix parsing of labels beginning with digits.
X-Git-Url: https://gitweb.michael.orlitzky.com/?a=commitdiff_plain;h=ecd15b8e60f56ea8e4ceb464c0a5e677e5d17376;p=dead%2Fharbl.git

Fix parsing of labels beginning with digits.
---

diff --git a/src/Network/DNS/RBL/Domain.hs b/src/Network/DNS/RBL/Domain.hs
index a405ff1..73a6988 100644
--- a/src/Network/DNS/RBL/Domain.hs
+++ b/src/Network/DNS/RBL/Domain.hs
@@ -15,7 +15,7 @@
 --   (octets).
 --
 module Network.DNS.RBL.Domain (
-  UserDomain,
+  UserDomain(..),
   user_domain )
 where
 
@@ -400,7 +400,7 @@ length_ldh_str_let_dig (LdhStrLetDig (Just ldhstring) _) =
 --     letter or a digit.  Host software MUST support this more liberal
 --     syntax.
 --
-data Label = Label Letter (Maybe LdhStrLetDig)
+data Label = Label LetDig (Maybe LdhStrLetDig)
   deriving (Eq, Show)
 
 instance Pretty Label where
@@ -428,7 +428,7 @@ instance Pretty Label where
 --   Make sure we can parse a single character:
 --
 --   >>> parseTest label "a"
---   Label (Letter 'a') Nothing
+--   Label (LetDigLetter (Letter 'a')) Nothing
 --
 --   And longer strings:
 --
@@ -452,9 +452,14 @@ instance Pretty Label where
 --   >>> pretty_print $ parse label "" (replicate 63 'x')
 --   xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
 --
+--   Ensure that a label can begin with a digit:
+--
+--   >>> pretty_print $ parse label "" "3com"
+--   3com
+--
 label :: Parser Label
 label = do
-  l <- letter -- Guaranteed to be there
+  l <- let_dig -- Guaranteed to be there
   maybe_s <- optionMaybe ldh_str_let_dig -- Might not be there
   case maybe_s of
     -- It can only be one character long, from the letter...
@@ -523,7 +528,7 @@ instance Pretty Subdomain where
 --   Make sure we can parse a single character:
 --
 --   >>> parseTest subdomain "a"
---   SubdomainSingleLabel (Label (Letter 'a') Nothing)
+--   SubdomainSingleLabel (Label (LetDigLetter (Letter 'a')) Nothing)
 --
 --   >>> pretty_print $ parse subdomain "" "example.com"
 --   example.com
@@ -654,8 +659,8 @@ instance Pretty Domain where
 --
 --   Make sure we can parse a single character:
 --
---   >>> parseTest domain "a"
---   DomainName (SubdomainSingleLabel (Label (Letter 'a') Nothing))
+--   >>> pretty_print $ parse domain "" "a"
+--   a
 --
 --   And the empty domain:
 --
@@ -665,7 +670,7 @@ instance Pretty Domain where
 --   We will in fact parse the \"empty\" domain off the front of
 --   pretty much anything:
 --
---   >>> parseTest domain "8===D"
+--   >>> parseTest domain "!8===D"
 --   DomainRoot
 --
 --   Equality of domains is case-insensitive: