X-Git-Url: http://gitweb.michael.orlitzky.com/?p=dead%2Fharbl.git;a=blobdiff_plain;f=src%2FNetwork%2FDNS%2FRBL%2FHost.hs;fp=src%2FNetwork%2FDNS%2FRBL%2FHost.hs;h=ea7d4c8353e6bdc6c18778ac3ff472fe06f867da;hp=0000000000000000000000000000000000000000;hb=c4d41b93ec02ff4dc762163441ebefb0324e6f07;hpb=ecd15b8e60f56ea8e4ceb464c0a5e677e5d17376

diff --git a/src/Network/DNS/RBL/Host.hs b/src/Network/DNS/RBL/Host.hs
new file mode 100644
index 0000000..ea7d4c8
--- /dev/null
+++ b/src/Network/DNS/RBL/Host.hs
@@ -0,0 +1,73 @@
+module Network.DNS.RBL.Host
+where
+
+import Data.ByteString.Char8 (
+  ByteString,
+  intercalate,
+  pack,
+  split )
+import qualified Network.DNS as DNS ( Domain )
+
+import Network.DNS.RBL.Domain ( UserDomain(..) )
+import Network.DNS.RBL.Pretty ( Pretty(..) )
+
+
+-- | A data type representing a host that we would like to look up on
+--   a blacklist. This can be either an IP address (for normal
+--   blacklists) or a domain name (for name-based blacklists).
+--
+--   Rather than make a distinction, we rely on the fact that we can
+--   parse all-digit \"domain names\". That is, we'll happily accept
+--   e.g. \"127.0.0.1\" as a name, and anything that isn't a valid IP
+--   address will implicitly be treated as a name and not an address.
+--
+newtype Host = Host UserDomain
+
+instance Pretty Host where pretty_show (Host d) = pretty_show d
+
+
+-- | Reverse the labels of this host in preparation for making a
+--   lookup (using the DNS library). We need to reverse the labels
+--   (the stuff between the dots) whether we're looking up a host or a
+--   name. The only tricky part here is that we need to turn an
+--   absolute 'UserDomain' into a relative one.
+--
+--   ==== _Examples_
+--
+--   >>> import Text.Parsec ( parse )
+--   >>> import Network.DNS.RBL.Domain ( user_domain )
+--
+--   >>> let (Right r) = parse user_domain "" "1.2.3.4"
+--   >>> let h = Host r
+--   >>> reverse_labels h
+--   "4.3.2.1"
+--
+--   >>> let (Right r) = parse user_domain "" "www.example.com"
+--   >>> let h = Host r
+--   >>> reverse_labels h
+--   "com.example.www"
+--
+--   Make sure absolute names are made relative:
+--
+--   >>> let (Right r) = parse user_domain "" "www.example.com."
+--   >>> let h = Host r
+--   >>> reverse_labels h
+--   "com.example.www"
+--
+reverse_labels :: Host -> DNS.Domain
+reverse_labels (Host h) = reversed
+  where
+    -- | It's possible that we are given an absolute domain name to
+    --   look up. This is legit; say I want to look up
+    --   \"www.example.com.\" That's fine, but before we make the
+    --   actual query we'll need to make it relative and then append
+    --   the DNSBL's suffix to it.
+    relative_host_string :: String
+    relative_host_string =
+      case h of
+        (UserDomainRelative _) -> pretty_show h
+        (UserDomainAbsolute d) -> pretty_show d
+
+    dot = pack "."
+    labels = split '.' (pack relative_host_string)
+    reversed = intercalate dot (reverse labels)