-- (octets).
--
module Network.DNS.RBL.Domain (
- Domain,
+ Domain(..),
domain )
where
import Text.Parsec.String ( Parser )
import Network.DNS.RBL.Pretty ( Pretty(..) )
+import Network.DNS.RBL.Reversible ( Reversible(..) )
-- * Digits
pretty_show (SubdomainMultipleLabel l s) =
(pretty_show l) ++ "." ++ (pretty_show s)
+
+instance Reversible Subdomain where
+ -- | Reverse the labels of the given subdomain.
+ --
+ -- ==== _Examples_
+ --
+ -- >>> import Text.Parsec ( parse )
+ --
+ -- Standard usage:
+ --
+ -- >>> let (Right r) = parse subdomain "" "com"
+ -- >>> pretty_print $ backwards r
+ -- com
+ --
+ -- >>> let (Right r) = parse subdomain "" "example.com"
+ -- >>> pretty_print $ backwards r
+ -- com.example
+ --
+ -- >>> let (Right r) = parse subdomain "" "www.example.com"
+ -- >>> pretty_print $ backwards r
+ -- com.example.www
+ --
+ -- >>> let (Right r) = parse subdomain "" "new.www.example.com"
+ -- >>> pretty_print $ backwards r
+ -- com.example.www.new
+ --
+
+ -- It's easy to reverse a single label...
+ backwards s@(SubdomainSingleLabel _) = s
+
+ -- For multiple labels we have two cases. The first is where we have
+ -- exactly two labels, and we just need to swap them.
+ backwards (SubdomainMultipleLabel l (SubdomainSingleLabel m)) =
+ SubdomainMultipleLabel m (SubdomainSingleLabel l)
+
+ -- And now the hard case. If we reversed @s@, then the "head" of
+ -- the result (@last_s@) should be the last label in the entire
+ -- subdomain. Stick @last_s@ on the front of the result. That makes
+ -- enough sense.
+ --
+ -- But what to do about the rest? We need to get \"init s\"
+ -- somehow. Well, we have the reverse of it... why not waste a bunch
+ -- of time and reverse that, too? With @init s@ in hand, we can
+ -- prepend @l@ to that, and THEN reverse the entire thing. What we'll
+ -- wind up with looks like @[last_s, init_s_rev, l]@ which you can
+ -- pretend you recognize as the subdomain in reverse.
+ --
+ backwards (SubdomainMultipleLabel l s) =
+ case (backwards s) of
+ SubdomainMultipleLabel last_s init_s_rev ->
+ let init_s = backwards init_s_rev
+ in
+ SubdomainMultipleLabel
+ last_s
+ (backwards (SubdomainMultipleLabel l init_s))
+
+ -- Reversing a multiple label thing gives you back a multiple
+ -- label thing but there's no way to promise that.
+ impossible -> impossible
+
+
+
-- | Parse an RFC1035 \"subdomain\". The given grammar is,
--
-- <subdomain> ::= <label> | <subdomain> "." <label>
+
-- * Domains
-- | An RFC1035 domain. According to RFC1035 a domain can be either a
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