+{-# LANGUAGE DoAndIfThenElse #-}
+
+-- | The 'Domain' data type and its parser. A 'Domain' represents a
+-- name in the domain name system (DNS) as described by
+-- RFC1035. In particular, we enforce the restrictions from Section
+-- 2.3.1 \"Preferred name syntax\". See for example,
+--
+-- <https://tools.ietf.org/html/rfc1035#section-2.3.1>
+--
+-- We basically work with strings and characters everywhere, even
+-- though this isn't really correct. The length specifications in
+-- the RFCs are all in terms of octets, so really a ByteString.Char8
+-- would be more appropriate. With strings, for example, we could
+-- have a unicode mumbo jumbo character that takes up two bytes
+-- (octets).
+--
+module Network.DNS.RBL.Domain.Domain (
+ Domain(..),
+ domain )
+where
+
+import Text.Parsec (
+ (<|>),
+ string,
+ try )
+import Text.Parsec.String ( Parser )
+
+import Network.DNS.RBL.Domain.Subdomain ( Subdomain, subdomain )
+import Network.DNS.RBL.Pretty ( Pretty(..) )
+import Network.DNS.RBL.Reversible ( Reversible(..) )
+
+
+
+-- | An RFC1035 domain. According to RFC1035 a domain can be either a
+-- subdomain or \" \", which according to RFC2181
+-- <https://tools.ietf.org/html/rfc2181#section-11> means the root:
+--
+-- The zero length full name is defined as representing the root
+-- of the DNS tree, and is typically written and displayed as
+-- \".\".
+--
+-- We let the 'Domain' type remain true to those RFCs, even though
+-- they don't support an absolute domain name of e.g. a single dot.
+--
+-- ==== _Examples_
+--
+-- >>> DomainRoot
+-- DomainRoot
+--
+-- >>> import Text.Parsec ( parse )
+-- >>> let s = parse subdomain "" "x"
+-- >>> DomainName s
+-- DomainName (SubdomainSingleLabel (Label (LetDigLetter (Letter 'x')) Nothing))
+--
+data Domain =
+ DomainName Subdomain |
+ DomainRoot
+ deriving (Eq, Show)
+
+
+-- | Pretty-print a 'Domain'.
+--
+-- ==== _Examples_
+--
+-- >>> pretty_show $ DomainRoot
+-- ""
+--
+-- >>> import Text.Parsec ( parse )
+-- >>> let s = parse subdomain "" "x"
+-- >>> pretty_print $ DomainName s
+-- x
+--
+instance Pretty Domain where
+ pretty_show DomainRoot = ""
+ pretty_show (DomainName s) = pretty_show s
+
+
+-- | The maximum number of characters (octets, really) allowed in a
+-- label. Quoting Section 3.1, \"Name space definitions\", of
+-- RFC1035:
+--
+-- To simplify implementations, the total length of a domain name
+-- (i.e., label octets and label length octets) is restricted to 255
+-- octets or less.
+--
+domain_max_length :: Int
+domain_max_length = 255
+
+
+-- | Parse an RFC1035 \"domain\"
+--
+-- ==== _Examples_
+--
+-- >>> import Text.Parsec ( parse, parseTest )
+--
+-- Make sure we can parse a single character:
+--
+-- >>> pretty_print $ parse domain "" "a"
+-- a
+--
+-- And the empty domain:
+--
+-- >>> parseTest domain ""
+-- DomainRoot
+--
+-- We will in fact parse the \"empty\" domain off the front of
+-- pretty much anything:
+--
+-- >>> parseTest domain "!8===D"
+-- DomainRoot
+--
+-- Equality of domains is case-insensitive:
+--
+-- >>> let (Right r1) = parse domain "" "example.com"
+-- >>> let (Right r2) = parse domain "" "ExaMPle.coM"
+-- >>> r1 == r2
+-- True
+--
+-- A single dot IS parsed as the root, but the dot isn't consumed:
+--
+-- >>> parseTest domain "."
+-- DomainRoot
+--
+-- Anything over domain_max_length characters is an error, so the
+-- root will be parsed:
+--
+-- >>> let big_l1 = replicate 63 'x'
+-- >>> let big_l2 = replicate 63 'y' -- Avoid equal neighboring labels!
+-- >>> let big_labels = big_l1 ++ "." ++ big_l2 ++ "."
+-- >>> let big_subdomain = concat $ replicate 3 big_labels
+-- >>> parseTest domain big_subdomain
+-- DomainRoot
+--
+-- But exactly domain_max_length is allowed:
+--
+-- >>> import Data.List ( intercalate )
+-- >>> let l1 = replicate 63 'w'
+-- >>> let l2 = replicate 63 'x'
+-- >>> let l3 = replicate 63 'y'
+-- >>> let l4 = replicate 63 'z'
+-- >>> let big_subdomain = intercalate "." [l1,l2,l3,l4]
+-- >>> let (Right r) = parse domain "" big_subdomain
+-- >>> length (pretty_show r)
+-- 255
+--
+domain :: Parser Domain
+domain = try parse_subdomain <|> parse_empty
+ where
+ parse_subdomain :: Parser Domain
+ parse_subdomain = do
+ s <- subdomain
+ if length (pretty_show s) <= domain_max_length
+ then return $ DomainName s
+ else fail $ "subdomains can be at most " ++
+ (show domain_max_length) ++
+ " characters"
+
+ parse_empty :: Parser Domain
+ parse_empty = string "" >> return DomainRoot
+
+
+instance Reversible Domain where
+ -- | Reverse the labels of a 'Domain'.
+ --
+ -- -- ==== _Examples_
+ --
+ -- >>> import Text.Parsec ( parse )
+ --
+ -- The root reverses to itself:
+ --
+ -- >>> let (Right r) = parse domain "" ""
+ -- >>> backwards r
+ -- DomainRoot
+ --
+ -- >>> let (Right r) = parse domain "" "new.www.example.com"
+ -- >>> pretty_print $ backwards r
+ -- com.example.www.new
+ --
+ backwards DomainRoot = DomainRoot
+ backwards (DomainName s) = DomainName $ backwards s