src/DNS.hs

   1 module DNS (
   2   LookupResult,
   3   lookupMX',
   4   lookupNS',
   5   normalize
   6   )
   7 where
   8
   9 import Control.Monad (liftM)
  10 import qualified Data.ByteString.Char8 as BS (
  11   append,
  12   last,
  13   map,
  14   pack )
  15 import Data.Char (toLower)
  16 import Network.DNS (
  17   Domain,
  18   Resolver,
  19   lookupMX,
  20   lookupNS )
  21
  22 type LookupResult = (Domain, Maybe [Domain])
  23
  24 lookupMX' :: Resolver -> Domain -> IO LookupResult
  25 lookupMX' resolver domain =
  26   liftM (pair_em . drop_priority) $ lookupMX resolver domain
  27   where
  28     drop_priority :: Maybe [(Domain, Int)] -> Maybe [Domain]
  29     drop_priority = fmap (map fst)
  30
  31     pair_em :: a -> (Domain, a)
  32     pair_em = (,) domain
  33
  34 -- This function keeps the domain matches with its NS records.
  35 lookupNS' :: Resolver -> Domain -> IO LookupResult
  36 lookupNS' resolver domain =
  37   liftM pair_em $ lookupNS resolver domain
  38   where
  39     pair_em :: a -> (Domain, a)
  40     pair_em = (,) domain
  41
  42 -- | Normalize the given name by lowercasing and appending a trailing
  43 --   dot (the root) if necessary.
  44 normalize :: Domain -> Domain
  45 normalize = normalize_case . normalize_root
  46
  47
  48 normalize_root :: Domain -> Domain
  49 normalize_root d
  50   | BS.last d == '.' = d
  51   | otherwise = d `BS.append` trailing_dot
  52     where
  53       trailing_dot = BS.pack "."
  54
  55
  56 normalize_case :: Domain -> Domain
  57 normalize_case = BS.map toLower