fb98cd8f5f83f0345eb50ccc64d550e3865be06f
[dead/harbl.git] / harbl / src / Network / DNS / RBL / Domain / Label.hs
1 -- | This module contains the 'Letter' 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"