Add the Network.DNS.RBL.Host module.

[dead/harbl.git] / src / Network / DNS / RBL.hs

diff --git a/src/Network/DNS/RBL.hs b/src/Network/DNS/RBL.hs
index d9c232e996373942349645ff12d4ce28937a2c7a..3c32e5d97b990d654b92bf1e5ad40279b529c65e 100644 (file)
--- a/src/Network/DNS/RBL.hs
+++ b/src/Network/DNS/RBL.hs
@@ -1,11 +1,7 @@
 module Network.DNS.RBL ( lookup_single )
 where
 
-import qualified Data.ByteString.Char8 as BS (
-  append,
-  intercalate,
-  pack,
-  split )
+import Data.ByteString.Char8 ( append, pack )
 import Data.IP ( IPv4 )
 import Data.List ( intercalate )
 import Data.Maybe ( catMaybes )
@@ -18,14 +14,11 @@ import Network.DNS (
   withResolver )
 
 import Network.DNS.RBL.Domain ( UserDomain )
+import Network.DNS.RBL.Host ( Host, reverse_labels )
 import Network.DNS.RBL.IPv4Pattern ( addresses )
 import Network.DNS.RBL.Pretty ( Pretty(..) )
 import Network.DNS.RBL.Site ( Site(..), Weight(..) )
 
--- | A dumb wrapper around an IP address input as a 'String'.
---
-newtype Host = Host String
-instance Pretty Host where pretty_show (Host h) = h
 
 
 -- | In most applications, you will want to know /why/ a host is
@@ -53,84 +46,20 @@ listing_message host (ListingDetails (Site d _ w) codes) =
 --   pretty sure I wrote anyway.
 --
 dnslookup :: Resolver -> UserDomain -> Host -> IO (Either DNSError [IPv4])
-dnslookup rlv rbl (Host ip) = lookupA rlv dom
+dnslookup rlv rbl host = lookupA rlv dom
   where
-    -- ByteString constants.
-    dot = BS.pack "."
-    suffix = BS.pack $ "." ++ (pretty_show rbl)
-
-    octets = BS.split '.' (BS.pack ip)
-    reverse_ip = BS.intercalate dot (reverse octets)
-    dom = reverse_ip `BS.append` suffix
-
-
-
--- | Look up the given @host@ on a single RBL, and return the number
---   of \"points\" it scores. If the host is listed, it should score the
---   weight of the given blacklist. Otherwise, it scores zero.
---
-lookup_single :: Host -> Site -> IO Int
-lookup_single host site = do
-  rs <- makeResolvSeed defaultResolvConf
-  withResolver rs $ \resolver -> lookup_single' resolver host site
-
-
--- | See 'lookup_single'.
---
---   The \"prime\" version of this function takes a pre-existing
---   resolver as an argument for performance reasons.
---
-lookup_single' :: Resolver -> Host -> Site -> IO Int
-lookup_single' resolver host (Site d p (Weight w)) = do
-  response <- dnslookup resolver d host
-  case response of
-    Left _ -> return 0 -- Not listed
-    Right ipv4s ->
-      case p of
-        -- No pattern given, but we got a hit.
-        Nothing -> return w
-        Just pat -> do
-          let ipv4_strings = map show ipv4s
-          let codes = addresses pat
-          let hits = map (`elem` codes) ipv4_strings
-          if or hits -- if any of the returned addresses match the pattern
-          then return w
-          else return 0
-
-
--- | Look up the given @host@ on all of the white/blacklists contained
---   in @sites@. Return the total \"score\" for the @host@; that is,
---   the sum of the weights for each site whose pattern the host
---   matches.
---
-lookup_simple :: Host -> [Site] -> IO Int
-lookup_simple host sites = do
-  rs <- makeResolvSeed defaultResolvConf
-  withResolver rs $ \resolver -> do
-    results <- mapM (lookup_single' resolver host) sites
-    return $ sum results
+    suffix = pack $ "." ++ (pretty_show rbl)
+    dom = (reverse_labels host) `append` suffix
 
--- | Look up the given @host@ on all of the white/blacklists contained
---   in @sites@. If the results, multiplied by their weights, add up to
---   (at least) @threshold@, then @True@ is returned; that is, the
---   @host@ is \"listed\". Otherwise, @False@ is returned.
---
-lookup_threshold :: Host -> [Site] -> Int -> IO Bool
-lookup_threshold host sites threshold = do
-  score <- lookup_simple host sites
-  if score >= threshold
-  then return True
-  else return False
 
-
--- | See 'lookup_single_details'. The \"prime\" version here takes an
+-- | See 'lookup_single'. The \"prime\" version here takes an
 --   additional @resolver@ argument for performance reasons.
 --
-lookup_single_details' :: Resolver
-                       -> Host
-                       -> Site
-                       -> IO (Maybe ListingDetails)
-lookup_single_details' resolver host site@(Site d p (Weight w)) = do
+lookup_single' :: Resolver
+               -> Host
+               -> Site
+               -> IO (Maybe ListingDetails)
+lookup_single' resolver host site@(Site d p (Weight w)) = do
   response <- dnslookup resolver d host
   case response of
     Left _ -> return Nothing -- Not listed, no error to report
@@ -148,17 +77,19 @@ lookup_single_details' resolver host site@(Site d p (Weight w)) = do
 
 
 -- | Look up a single...
-lookup_single_details :: Host
-                      -> Site
-                      -> IO (Maybe ListingDetails)
-lookup_single_details host site = do
+lookup_single :: Host
+              -> Site
+              -> IO (Maybe ListingDetails)
+lookup_single host site = do
   rs <- makeResolvSeed defaultResolvConf
-  withResolver rs $ \resolver -> lookup_single_details' resolver host site
+  withResolver rs $ \resolver -> lookup_single' resolver host site
 
 
-lookup_details :: Host -> [Site] -> IO [ListingDetails]
-lookup_details host sites = do
+lookup :: Host -> [Site] -> IO [ListingDetails]
+lookup host sites = do
   rs <- makeResolvSeed defaultResolvConf
   withResolver rs $ \resolver -> do
-    results <- mapM (lookup_single_details' resolver host) sites
+    results <- mapM (lookup_single' resolver host) sites
     return $ catMaybes results
+
+