-- | Helpers to perform DNS queries.
module DNS (
  Domain,
  PTRResult,
  lookup_ptrs )
where

import Control.Concurrent.ParallelIO.Global ( parallel )
import qualified  Data.ByteString.Char8 as BS (
  append,
  intercalate,
  pack,
  split )
import Network.DNS (
  Domain,
  DNSError,
  ResolvConf(..),
  defaultResolvConf,
  lookupPTR,
  makeResolvSeed,
  withResolver )


-- The return type of lookupPTR.
type PTRResult = Either DNSError [Domain]


-- | Convert the given IP address (as a ByteString) to the format
--   required for a PTR lookup. For example, "192.168.0.0" should be
--   converted to "0.0.168.192.in-addr.arpa".
ip_to_in_addr_arpa :: Domain -> Domain
ip_to_in_addr_arpa ip =
  rev_ip `BS.append` suffix
  where
    dot = BS.pack "."
    suffix = BS.pack ".in-addr.arpa"
    rev_ip = BS.intercalate dot (reverse (BS.split '.' ip))

-- | Take the default ResolvConf and increase the timeout to 15
--   seconds.
our_resolv_conf :: ResolvConf
our_resolv_conf =
  defaultResolvConf { resolvTimeout = 15*1000*1000 } -- 15s


-- | Takes a list of IP addresses (as ByteStrings) and performs
--   reverse (PTR) lookups on each of them.
lookup_ptrs :: [Domain] -> IO [PTRResult]
lookup_ptrs ips = do
  rs <- makeResolvSeed our_resolv_conf
  let lookup' addr = withResolver rs $ \resolver ->
                       lookupPTR resolver addr

  parallel $ map lookup' in_addrs

  where
    in_addrs = map ip_to_in_addr_arpa ips