src/DNS.hs

   1 module DNS (
   2   LookupResult,
   3   lookupMX',
   4   lookupNS',
   5   resolve_address )
   6 where
   7
   8 import Control.Monad ( liftM )
   9 import qualified Data.ByteString.Char8 as BS ( pack )
  10 import Data.IP (IPv4)
  11 import Network.DNS (
  12   Domain,
  13   DNSError,
  14   Resolver,
  15   defaultResolvConf,
  16   lookupA,
  17   lookupMX,
  18   lookupNS,
  19   lookupNSAuth,
  20   makeResolvSeed,
  21   withResolver )
  22 import Text.Read ( readMaybe )
  23
  24 type LookupResult = (Domain, Either DNSError [Domain])
  25
  26 -- | Takes a String representing either a hostname or an IP
  27 --   address. If a hostname was supplied, it is resolved to either an
  28 --   [IPv4] or an error. If an IP address is supplied, it is returned
  29 --   as a singleton [IPv4].
  30 --
  31 --   Examples:
  32 --
  33 --   >>> resolve_address "example.com"
  34 --   Right [93.184.216.34]
  35 --   >>> resolve_address "93.184.216.34"
  36 --   Right [93.184.216.34]
  37 --
  38 resolve_address :: String -> IO (Either DNSError [IPv4])
  39 resolve_address s =
  40   case read_result of
  41     Just addr  -> return $ Right [addr]
  42     Nothing -> do
  43       default_rs <- makeResolvSeed defaultResolvConf
  44       withResolver default_rs $ \resolver ->
  45         lookupA resolver (BS.pack s)
  46   where
  47     read_result :: Maybe IPv4
  48     read_result = readMaybe s
  49
  50
  51 -- | This calls lookupMX, and returns the result as the second
  52 --   component of a tuple whose first component is the domain name
  53 --   itself.
  54 --
  55 --   Examples:
  56 --
  57 --   The example domain, example.com, has no MX record.
  58 --
  59 --   >>> rs <- makeResolvSeed defaultResolvConf
  60 --   >>> let domain = BS.pack "example.com."
  61 --   >>> withResolver rs $ \resolver -> lookupMX' resolver domain
  62 --   ("example.com.",Right [])
  63 --
  64 lookupMX' :: Resolver -> Domain -> IO LookupResult
  65 lookupMX' resolver domain =
  66   liftM (pair_em . drop_priority) $ lookupMX resolver domain
  67   where
  68     drop_priority :: Either DNSError [(Domain, Int)]
  69                   -> Either DNSError [Domain]
  70     drop_priority = fmap (map fst)
  71
  72     pair_em :: a -> (Domain, a)
  73     pair_em = (,) domain
  74
  75
  76 -- | This calls lookupNS, and returns the result as the second
  77 --   component of a tuple whose first component is the domain name
  78 --   itself.
  79 --
  80 --   Examples:
  81 --
  82 --   The example domain, example.com, does have NS records, but the
  83 --   order in which they are returned is variable, so we have to sort
  84 --   them to get a reliable result.
  85 --
  86 --   >>> import Data.List (sort)
  87 --   >>> import Control.Applicative ((<$>))
  88 --   >>>
  89 --   >>> let sort_snd (x,y) = (x, sort <$> y)
  90 --   >>> rs <- makeResolvSeed defaultResolvConf
  91 --   >>> let domain = BS.pack "example.com."
  92 --   >>> withResolver rs $ \resolver -> sort_snd <$> lookupNS' resolver domain
  93 --   ("example.com.",Right ["a.iana-servers.net.","b.iana-servers.net."])
  94 --
  95 lookupNS' :: Resolver -> Domain -> IO LookupResult
  96 lookupNS' resolver domain = do
  97   answer_result <- lookupNS resolver domain
  98   auth_result <- lookupNSAuth resolver domain
  99   liftM pair_em $ return $ combine answer_result auth_result
 100   where
 101     pair_em :: a -> (Domain, a)
 102     pair_em = (,) domain
 103
 104     combine :: (Either DNSError [Domain])
 105             -> (Either DNSError [Domain])
 106             -> (Either DNSError [Domain])
 107     combine e1 e2 = do
 108       l1 <- e1
 109       l2 <- e2
 110       return (l1 ++ l2)