src/DNS.hs

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