-- | This module contains the 'Label' 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"