harbl/src/Network/DNS/RBL/Host.hs

   1 module Network.DNS.RBL.Host (
   2   Host(..),
   3   host )
   4 where
   5
   6 import Text.Parsec (
   7   (<|>),
   8   char,
   9   try )
  10 import Text.Parsec.String ( Parser )
  11
  12 import Network.DNS.RBL.Domain (
  13   Domain(..),
  14   domain )
  15 import Network.DNS.RBL.Pretty ( Pretty(..) )
  16 import Network.DNS.RBL.Reversible ( Reversible(..) )
  17
  18
  19 -- | This type helps clarify some murkiness in the DNS \"domain\" name
  20 --   specification. In RFC1034, it is acknowledged that a domain name
  21 --   input with a trailing \".\" will represent an absolute domain
  22 --   name (i.e. with respect to the DNS root). However, the grammar in
  23 --   RFC1035 disallows a trailing dot.
  24 --
  25 --   This makes some sense: within the DNS, everything knows its
  26 --   position in the tree. The relative/absolute distinction only
  27 --   makes sense on the client side, where a user's resolver might
  28 --   decide to append some suffix to a relative
  29 --   request. Unfortunately, that's where we live. So we have to deal
  30 --   with the possibility of having a trailing dot at the end of any
  31 --   domain name.
  32 --
  33 data Host =
  34   HostRelative Domain |
  35   HostAbsolute Domain
  36   deriving (Eq, Show)
  37
  38 instance Pretty Host where
  39   pretty_show (HostRelative d) = pretty_show d
  40   pretty_show (HostAbsolute d) = (pretty_show d) ++ "."
  41
  42
  43 -- | Parse a 'Host'. This is what we'll be using to read user
  44 --   input, since it supports both relative and absolute domain names
  45 --   (unlike the implicitly-absolute 'Domain').
  46 --
  47 --   ==== _Examples_
  48 --
  49 --   >>> import Text.Parsec ( parse, parseTest )
  50 --
  51 --   We can really parse the root now!
  52 --
  53 --   >>> parseTest host "."
  54 --   HostAbsolute DomainRoot
  55 --
  56 --   But multiple dots aren't (only the first):
  57 --
  58 --   >>> pretty_print $ parse host "" ".."
  59 --   .
  60 --
  61 --   We can also optionally have a trailing dot at the end of a
  62 --   non-empty name:
  63 --
  64 --   >>>  pretty_print $ parse host "" "www.example.com"
  65 --   www.example.com
  66 --
  67 --   >>>  pretty_print $ parse host "" "www.example.com."
  68 --   www.example.com.
  69 --
  70 --   A \"relative root\" can also be parsed, letting the user's
  71 --   resolver deal with it:
  72 --
  73 --   >>> parseTest host ""
  74 --   HostRelative DomainRoot
  75 --
  76 host :: Parser Host
  77 host = try absolute <|> relative
  78   where
  79     absolute :: Parser Host
  80     absolute = do
  81       d <- domain
  82       _ <- char '.'
  83       return $ HostAbsolute d
  84
  85     relative :: Parser Host
  86     relative = fmap HostRelative domain
  87
  88
  89 instance Reversible Host where
  90   -- | Reverse the labels of this 'Host' in preparation for making a
  91   --   lookup (using the DNS library). We need to reverse the labels
  92   --   (the stuff between the dots) whether we're looking up a host or a
  93   --   name.
  94   --
  95   --   ==== _Examples_
  96   --
  97   --   >>> import Text.Parsec ( parse )
  98   --
  99   --   >>> let (Right r) = parse host "" "1.2.3.4"
 100   --   >>> pretty_print $ backwards r
 101   --   4.3.2.1
 102   --
 103   --   >>> let (Right r) = parse host "" "new.www.example.com"
 104   --   >>> pretty_print $ backwards r
 105   --   com.example.www.new
 106   --
 107   backwards (HostRelative d) = HostRelative $ backwards d
 108   backwards (HostAbsolute d) = HostAbsolute $ backwards d