harbl/src/Network/DNS/RBL/Domain/Label.hs

   1 -- | This module contains the 'Label' type and a Parsec parser to
   2 --   parse one. We don't export its constructor because then you could
   3 --   do something dumb like stick a period inside one.
   4 --
   5 --   These are defined in RFC1035, Section 2.3.1, \"Preferred name
   6 --   syntax\" <https://tools.ietf.org/html/rfc1035#section-2.3.1>:
   7 --
   8 --     <label> ::= <letter> [ [ <ldh-str> ] <let-dig> ]
   9 --
  10 --   However, we allow the slightly more general syntax from RFC1123,
  11 --   Section 2.1 <https://tools.ietf.org/html/rfc1123#section-2.1>:
  12 --
  13 --     The syntax of a legal Internet host name was specified in RFC-952
  14 --     [DNS:4].  One aspect of host name syntax is hereby changed: the
  15 --     restriction on the first character is relaxed to allow either a
  16 --     letter or a digit.  Host software MUST support this more liberal
  17 --     syntax.
  18 --
  19 module Network.DNS.RBL.Domain.Label (
  20   Label,
  21   label )
  22 where
  23
  24 import Text.Parsec ( optionMaybe )
  25 import Text.Parsec.String ( Parser )
  26
  27 import Network.DNS.RBL.Domain.LdhStrLetDig (
  28   LdhStrLetDig,
  29   ldh_str_let_dig,
  30   ldh_str_let_dig_length )
  31 import Network.DNS.RBL.Domain.LetDig ( LetDig, let_dig )
  32 import Network.DNS.RBL.Pretty ( Pretty(..) )
  33
  34 -- | The label type from the RFC1035 and RFC1123 grammars.
  35 --
  36 --   ==== _Examples_
  37 --
  38 --   >>> import Text.Parsec ( parse )
  39 --
  40 --   >>> let (Right r)  = parse let_dig "" "x"
  41 --   >>> r
  42 --   LetDigLetter (Letter 'x')
  43 --   >>> Label r Nothing
  44 --   Label (LetDigLetter (Letter 'x')) Nothing
  45 --
  46 data Label = Label LetDig (Maybe LdhStrLetDig)
  47   deriving (Eq, Show)
  48
  49 -- | Pretty-print a 'Label'. Should give you back a string that can be
  50 --   parsed as a 'Label'.
  51 --
  52 --   ==== _Examples_
  53 --
  54 --   >>> import Text.Parsec ( parse )
  55 --
  56 --   >>> let (Right r) = parse label "" "www"
  57 --   >>> pretty_print r
  58 --   www
  59 --
  60 --   >>> let (Right r) = parse label "" "example"
  61 --   >>> pretty_print r
  62 --   example
  63 --
  64 --   >>> let (Right r) = parse label "" "com"
  65 --   >>> pretty_print r
  66 --   com
  67 --
  68 instance Pretty Label where
  69   pretty_show (Label l Nothing) = pretty_show l
  70   pretty_show (Label l (Just s)) = (pretty_show l) ++ (pretty_show s)
  71
  72
  73 -- | The maximum number of characters (octets, really) allowed in a
  74 --   label. Quoting Section 2.3.1, \"Preferred name syntax\", of
  75 --   RFC1035:
  76 --
  77 --     The labels must follow the rules for ARPANET host names.  They
  78 --     must start with a letter, end with a letter or digit, and have
  79 --     as interior characters only letters, digits, and hyphen.  There
  80 --     are also some restrictions on the length.  Labels must be 63
  81 --     characters or less.
  82 --
  83 label_max_length :: Int
  84 label_max_length = 63
  85
  86
  87 -- | Parse a 'Label'.
  88 --
  89 --   In addition to the grammar, there's another restriction on
  90 --   labels: their length must be 'label_max_length' characters or
  91 --   less. We check this only after we have successfully parsed a
  92 --   label.
  93 --
  94 --   ==== _Examples_
  95 --
  96 --   >>> import Text.Parsec ( parse, parseTest )
  97 --
  98 --   Make sure we can parse a single character:
  99 --
 100 --   >>> parseTest label "a"
 101 --   Label (LetDigLetter (Letter 'a')) Nothing
 102 --
 103 --   And longer strings:
 104 --
 105 --   >>> pretty_print $ parse label "" "abc-def"
 106 --   abc-def
 107 --
 108 --   But not anything ending in a hyphen:
 109 --
 110 --   >>> parseTest label "abc-"
 111 --   parse error at (line 1, column 5):
 112 --   label cannot end with a hyphen
 113 --
 114 --   Or anything over 'label_max_length' characters:
 115 --
 116 --   >>> parseTest label (['a'..'z'] ++ ['a'..'z'] ++ ['a'..'z'])
 117 --   parse error at (line 1, column 79):
 118 --   labels must be 63 or fewer characters
 119 --
 120 --   However, /exactly/ 'label_max_length' characters is acceptable:
 121 --
 122 --   >>> pretty_print $ parse label "" (replicate label_max_length 'x')
 123 --   xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
 124 --
 125 --   Ensure that a label can begin with a digit:
 126 --
 127 --   >>> pretty_print $ parse label "" "3com"
 128 --   3com
 129 --
 130 label :: Parser Label
 131 label = do
 132   l <- let_dig -- Guaranteed to be there
 133   maybe_s <- optionMaybe ldh_str_let_dig -- Might not be there
 134   case maybe_s of
 135     -- It can only be one character long, from the letter...
 136     Nothing -> return $ Label l maybe_s
 137
 138     -- The letter gives us one character, so we check that the rest is
 139     -- less than (label_max_length - 1) characters long. But in the
 140     -- error message we need to report label_max_length.
 141     Just s  -> if (ldh_str_let_dig_length s) <= (label_max_length - 1)
 142               then return $ Label l maybe_s
 143               else fail $ "labels must be " ++
 144                           (show label_max_length) ++
 145                           " or fewer characters"