Introduce a NormalDomain newtype to ensure comparisons are made safely.

[list-remote-forwards.git] / src / DNS.hs

diff --git a/src/DNS.hs b/src/DNS.hs
index 8d94de51e9c7772d33adcb6cf5ec3e40c9479105..556c68675eecb4e4a6293117143e5358255f28bc 100644 (file)
--- a/src/DNS.hs
+++ b/src/DNS.hs
@@ -1,7 +1,8 @@
 module DNS (
   MxSetMap,
+  NormalDomain,
   mx_set_map,
-  normalize_string_domain )
+  normalize_string )
 where
 
 import qualified Data.ByteString.Char8 as BS ( pack, unpack )
@@ -18,13 +19,31 @@ import Network.DNS (
   normalize,
   withResolver )
 
--- | A map from domain names (represented as 'String's) to sets of
---   mail exchanger names (also represented as 'String's).
+-- | A type-safe wrapper around a domain name (represented as a
+--   string) that ensures we've created it by calling
+--   'normalize_string'. This prevents us from making
+--   comparisons on un-normalized 'Domain's or 'String's.
+--
+newtype NormalDomain =
+  NormalDomain String
+  deriving ( Eq, Ord, Show )
+
+
+-- | A set of mail exchanger names, represented as 'String's. The use
+--   of 'NormalDomain' prevents us from constructing a set of names
+--   that aren't normalized first.
 --
-type MxSetMap = Map String MxSet
+type MxSet = Set NormalDomain
 
--- | A set of mail exchanger names, represented as 'String's.
-type MxSet = Set String
+
+-- | A map from domain names (represented as 'String's) to sets of
+--   mail exchanger names (also represented as 'String's). The use of
+--   'NormalDomain' in the key prevents us from using keys that aren't
+--   normalized; this is important because we'll be using them for
+--   lookups and want e.g. \"foo.com\" and \"FOO.com\" to look up the
+--   same MX records.
+--
+type MxSetMap = Map NormalDomain MxSet
 
 
 -- | Normalize a domain name string by converting to a 'Domain',
@@ -32,11 +51,11 @@ type MxSet = Set String
 --
 --   ==== __Examples__
 --
---   >>> normalize_string_domain "ExAMplE.com"
---   "example.com."
+--   >>> normalize_string "ExAMplE.com"
+--   NormalDomain "example.com."
 --
-normalize_string_domain :: String -> String
-normalize_string_domain = BS.unpack . normalize . BS.pack
+normalize_string :: String -> NormalDomain
+normalize_string = NormalDomain . BS.unpack . normalize . BS.pack
 
 
 -- | Retrieve all MX records for the given domain. This is somewhat
@@ -81,16 +100,20 @@ mx_set_map domains = do
     --   domain name in the first component and a set of its mail
     --   exchangers (as strings) in the second component.
     --
-    make_pair :: Domain -> IO (String, Set String)
+    make_pair :: Domain -> IO (NormalDomain, Set NormalDomain)
     make_pair domain = do
       -- Lookup the @domain@'s MX records.
       mx_list <- lookup_mxs domain
 
-      -- Now convert the MX records *back* to strings.
-      let string_mx_list = map BS.unpack mx_list
+      -- Now convert the MX records *back* to strings, and then to
+      -- NormalDomains
+      let normal_mx_list = map (normalize_string . BS.unpack) mx_list
+
+      -- Convert the list into a set...
+      let normal_mx_set = Set.fromList normal_mx_list
 
-      -- Convert the list into a set
-      let string_mx_set = Set.fromList string_mx_list
+      -- The lookup key.
+      let normal_domain = normalize_string $ BS.unpack domain
 
       -- Finally, construct the pair and return it.
-      return (BS.unpack domain, string_mx_set)
+      return (normal_domain, normal_mx_set)