Bump dns dependency to 1.*, and update DNS module.

[hath.git] / src / DNS.hs

diff --git a/src/DNS.hs b/src/DNS.hs
index e1c4e51e5fa029e1bd367d6fb0e381143333057f..041eeeb52e2404b1d6951f3942cee600b8b28cc4 100644 (file)
--- a/src/DNS.hs
+++ b/src/DNS.hs
@@ -1,10 +1,11 @@
 -- | Helpers to perform DNS queries.
 module DNS (
   Domain,
-  lookup_ptrs
-  )
+  PTRResult,
+  lookup_ptrs )
 where
 
+import Control.Concurrent.ParallelIO.Global ( parallel )
 import qualified  Data.ByteString.Char8 as BS (
   append,
   intercalate,
@@ -12,12 +13,16 @@ import qualified  Data.ByteString.Char8 as BS (
   split )
 import Network.DNS (
   Domain,
+  DNSError,
   ResolvConf(..),
   defaultResolvConf,
   lookupPTR,
   makeResolvSeed,
-  withResolver
-  )
+  withResolver )
+
+
+-- The return type of lookupPTR.
+type PTRResult = Either DNSError [Domain]
 
 
 -- | Convert the given IP address (as a ByteString) to the format
@@ -40,10 +45,13 @@ our_resolv_conf =
 
 -- | Takes a list of IP addresses (as ByteStrings) and performs
 --   reverse (PTR) lookups on each of them.
-lookup_ptrs :: [Domain] -> IO [Maybe [Domain]]
+lookup_ptrs :: [Domain] -> IO [PTRResult]
 lookup_ptrs ips = do
   rs <- makeResolvSeed our_resolv_conf
-  withResolver rs $ \resolver ->
-    mapM (lookupPTR resolver) in_addrs
+  let lookup' addr = withResolver rs $ \resolver ->
+                       lookupPTR resolver addr
+
+  parallel $ map lookup' in_addrs
+
   where
     in_addrs = map ip_to_in_addr_arpa ips