src/DNS.hs

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