src/DNS.hs

   1 -- | Helpers to perform DNS queries.
   2 module DNS (
   3   Domain,
   4   PTRResult,
   5   lookup_ptrs )
   6 where
   7
   8 import Control.Concurrent.ParallelIO.Global ( parallel )
   9 import Network.DNS (
  10   Domain,
  11   DNSError,
  12   ResolvConf(..),
  13   defaultResolvConf,
  14   lookupRDNS,
  15   makeResolvSeed,
  16   withResolver )
  17
  18
  19 -- The return type of lookupRDNS.
  20 type PTRResult = Either DNSError [Domain]
  21
  22
  23 -- | Take the default ResolvConf and increase the timeout to 15
  24 --   seconds.
  25 our_resolv_conf :: ResolvConf
  26 our_resolv_conf =
  27   defaultResolvConf { resolvTimeout = 15*1000*1000 } -- 15s
  28
  29
  30 -- | Takes a list of IP addresses (as ByteStrings) and performs
  31 --   reverse (PTR) lookups on each of them.
  32 lookup_ptrs :: [Domain] -> IO [PTRResult]
  33 lookup_ptrs ips = do
  34   rs <- makeResolvSeed our_resolv_conf
  35   let lookup' addr = withResolver rs $ \resolver ->
  36                        lookupRDNS resolver addr
  37
  38   parallel $ map lookup' ips