1 {-# LANGUAGE DoAndIfThenElse #-}
3 -- | The 'Domain' data type and its parser. A 'Domain' represents a
4 -- name in the domain name system (DNS) as described by
5 -- RFC1035. In particular, we enforce the restrictions from Section
6 -- 2.3.1 \"Preferred name syntax\". See for example,
8 -- <https://tools.ietf.org/html/rfc1035#section-2.3.1>
10 -- We basically work with strings and characters everywhere, even
11 -- though this isn't really correct. The length specifications in
12 -- the RFCs are all in terms of octets, so really a ByteString.Char8
13 -- would be more appropriate. With strings, for example, we could
14 -- have a unicode mumbo jumbo character that takes up two bytes
17 module Network.DNS.RBL.Domain.Domain (
26 import Text.Parsec.String ( Parser )
28 import Network.DNS.RBL.Domain.Subdomain ( Subdomain, subdomain )
29 import Network.DNS.RBL.Pretty ( Pretty(..) )
30 import Network.DNS.RBL.Reversible ( Reversible(..) )
34 -- | An RFC1035 domain. According to RFC1035 a domain can be either a
35 -- subdomain or \" \", which according to RFC2181
36 -- <https://tools.ietf.org/html/rfc2181#section-11> means the root:
38 -- The zero length full name is defined as representing the root
39 -- of the DNS tree, and is typically written and displayed as
42 -- We let the 'Domain' type remain true to those RFCs, even though
43 -- they don't support an absolute domain name of e.g. a single dot.
50 -- >>> import Text.Parsec ( parse )
51 -- >>> let s = parse subdomain "" "x"
53 -- DomainName (SubdomainSingleLabel (Label (LetDigLetter (Letter 'x')) Nothing))
56 DomainName Subdomain |
61 -- | Pretty-print a 'Domain'.
65 -- >>> pretty_show $ DomainRoot
68 -- >>> import Text.Parsec ( parse )
69 -- >>> let s = parse subdomain "" "x"
70 -- >>> pretty_print $ DomainName s
73 instance Pretty Domain where
74 pretty_show DomainRoot = ""
75 pretty_show (DomainName s) = pretty_show s
78 -- | The maximum number of characters (octets, really) allowed in a
79 -- label. Quoting Section 3.1, \"Name space definitions\", of
82 -- To simplify implementations, the total length of a domain name
83 -- (i.e., label octets and label length octets) is restricted to 255
86 domain_max_length :: Int
87 domain_max_length = 255
90 -- | Parse an RFC1035 \"domain\"
94 -- >>> import Text.Parsec ( parse, parseTest )
96 -- Make sure we can parse a single character:
98 -- >>> pretty_print $ parse domain "" "a"
101 -- And the empty domain:
103 -- >>> parseTest domain ""
106 -- We will in fact parse the \"empty\" domain off the front of
107 -- pretty much anything:
109 -- >>> parseTest domain "!8===D"
112 -- Equality of domains is case-insensitive:
114 -- >>> let (Right r1) = parse domain "" "example.com"
115 -- >>> let (Right r2) = parse domain "" "ExaMPle.coM"
119 -- A single dot IS parsed as the root, but the dot isn't consumed:
121 -- >>> parseTest domain "."
124 -- Anything over domain_max_length characters is an error, so the
125 -- root will be parsed:
127 -- >>> let big_l1 = replicate 63 'x'
128 -- >>> let big_l2 = replicate 63 'y' -- Avoid equal neighboring labels!
129 -- >>> let big_labels = big_l1 ++ "." ++ big_l2 ++ "."
130 -- >>> let big_subdomain = concat $ replicate 3 big_labels
131 -- >>> parseTest domain big_subdomain
134 -- But exactly domain_max_length is allowed:
136 -- >>> import Data.List ( intercalate )
137 -- >>> let l1 = replicate 63 'w'
138 -- >>> let l2 = replicate 63 'x'
139 -- >>> let l3 = replicate 63 'y'
140 -- >>> let l4 = replicate 63 'z'
141 -- >>> let big_subdomain = intercalate "." [l1,l2,l3,l4]
142 -- >>> let (Right r) = parse domain "" big_subdomain
143 -- >>> length (pretty_show r)
146 domain :: Parser Domain
147 domain = try parse_subdomain <|> parse_empty
149 parse_subdomain :: Parser Domain
152 if length (pretty_show s) <= domain_max_length
153 then return $ DomainName s
154 else fail $ "subdomains can be at most " ++
155 (show domain_max_length) ++
158 parse_empty :: Parser Domain
159 parse_empty = string "" >> return DomainRoot
162 instance Reversible Domain where
163 -- | Reverse the labels of a 'Domain'.
165 -- -- ==== _Examples_
167 -- >>> import Text.Parsec ( parse )
169 -- The root reverses to itself:
171 -- >>> let (Right r) = parse domain "" ""
175 -- >>> let (Right r) = parse domain "" "new.www.example.com"
176 -- >>> pretty_print $ backwards r
177 -- com.example.www.new
179 backwards DomainRoot = DomainRoot
180 backwards (DomainName s) = DomainName $ backwards s