--- /dev/null
+-- | This module contains the 'Letter' type and a Parsec parser to
+-- parse one. We don't export its constructor because then you could
+-- do something dumb like stick a period inside one.
+--
+-- These are defined in RFC1035, Section 2.3.1, \"Preferred name
+-- syntax\" <https://tools.ietf.org/html/rfc1035#section-2.3.1>:
+--
+-- <label> ::= <letter> [ [ <ldh-str> ] <let-dig> ]
+--
+-- However, we allow the slightly more general syntax from RFC1123,
+-- Section 2.1 <https://tools.ietf.org/html/rfc1123#section-2.1>:
+--
+-- The syntax of a legal Internet host name was specified in RFC-952
+-- [DNS:4]. One aspect of host name syntax is hereby changed: the
+-- restriction on the first character is relaxed to allow either a
+-- letter or a digit. Host software MUST support this more liberal
+-- syntax.
+--
+module Network.DNS.RBL.Domain.Label (
+ Label,
+ label )
+where
+
+import Text.Parsec ( optionMaybe )
+import Text.Parsec.String ( Parser )
+
+import Network.DNS.RBL.Domain.LdhStrLetDig (
+ LdhStrLetDig,
+ ldh_str_let_dig,
+ ldh_str_let_dig_length )
+import Network.DNS.RBL.Domain.LetDig ( LetDig, let_dig )
+import Network.DNS.RBL.Pretty ( Pretty(..) )
+
+-- | The label type from the RFC1035 and RFC1123 grammars.
+--
+-- ==== _Examples_
+--
+-- >>> import Text.Parsec ( parse )
+--
+-- >>> let (Right r) = parse let_dig "" "x"
+-- >>> r
+-- LetDigLetter (Letter 'x')
+-- >>> Label r Nothing
+-- Label (LetDigLetter (Letter 'x')) Nothing
+--
+data Label = Label LetDig (Maybe LdhStrLetDig)
+ deriving (Eq, Show)
+
+-- | Pretty-print a 'Label'. Should give you back a string that can be
+-- parsed as a 'Label'.
+--
+-- ==== _Examples_
+--
+-- >>> import Text.Parsec ( parse )
+--
+-- >>> let (Right r) = parse label "" "www"
+-- >>> pretty_print r
+-- www
+--
+-- >>> let (Right r) = parse label "" "example"
+-- >>> pretty_print r
+-- example
+--
+-- >>> let (Right r) = parse label "" "com"
+-- >>> pretty_print r
+-- com
+--
+instance Pretty Label where
+ pretty_show (Label l Nothing) = pretty_show l
+ pretty_show (Label l (Just s)) = (pretty_show l) ++ (pretty_show s)
+
+
+-- | The maximum number of characters (octets, really) allowed in a
+-- label. Quoting Section 2.3.1, \"Preferred name syntax\", of
+-- RFC1035:
+--
+-- The labels must follow the rules for ARPANET host names. They
+-- must start with a letter, end with a letter or digit, and have
+-- as interior characters only letters, digits, and hyphen. There
+-- are also some restrictions on the length. Labels must be 63
+-- characters or less.
+--
+label_max_length :: Int
+label_max_length = 63
+
+
+-- | Parse a 'Label'.
+--
+-- In addition to the grammar, there's another restriction on
+-- labels: their length must be 'label_max_length' characters or
+-- less. We check this only after we have successfully parsed a
+-- label.
+--
+-- ==== _Examples_
+--
+-- >>> import Text.Parsec ( parse, parseTest )
+--
+-- Make sure we can parse a single character:
+--
+-- >>> parseTest label "a"
+-- Label (LetDigLetter (Letter 'a')) Nothing
+--
+-- And longer strings:
+--
+-- >>> pretty_print $ parse label "" "abc-def"
+-- abc-def
+--
+-- But not anything ending in a hyphen:
+--
+-- >>> parseTest label "abc-"
+-- parse error at (line 1, column 5):
+-- label cannot end with a hyphen
+--
+-- Or anything over 'label_max_length' characters:
+--
+-- >>> parseTest label (['a'..'z'] ++ ['a'..'z'] ++ ['a'..'z'])
+-- parse error at (line 1, column 79):
+-- labels must be 63 or fewer characters
+--
+-- However, /exactly/ 'label_max_length' characters is acceptable:
+--
+-- >>> pretty_print $ parse label "" (replicate label_max_length 'x')
+-- xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
+--
+-- Ensure that a label can begin with a digit:
+--
+-- >>> pretty_print $ parse label "" "3com"
+-- 3com
+--
+label :: Parser Label
+label = do
+ 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...
+ Nothing -> return $ Label l maybe_s
+
+ -- The letter gives us one character, so we check that the rest is
+ -- less than (label_max_length - 1) characters long. But in the
+ -- error message we need to report label_max_length.
+ Just s -> if (ldh_str_let_dig_length s) <= (label_max_length - 1)
+ then return $ Label l maybe_s
+ else fail $ "labels must be " ++
+ (show label_max_length) ++
+ " or fewer characters"