src/DNS.hs: update a test, example.com now has a NULLMX record.

[haeredes.git] / src / DNS.hs

diff --git a/src/DNS.hs b/src/DNS.hs
index 497bf31894fa09fc00848f6c5dfa81db7b9622a4..aa46f4be8191798f7194495e761d92ee5120ce70 100644 (file)
--- a/src/DNS.hs
+++ b/src/DNS.hs
@@ -1,22 +1,11 @@
 module DNS (
   LookupResult,
-  dns_properties,
-  dns_tests,
   lookupMX',
   lookupNS',
-  normalize,
-  normalize_case,
   resolve_address )
 where
 
-import Control.Monad (liftM)
-import qualified Data.ByteString.Char8 as BS (
-  append,
-  last,
-  map,
-  null,
-  pack )
-import Data.Char (toLower)
+import qualified Data.ByteString.Char8 as BS ( pack )
 import Data.IP (IPv4)
 import Network.DNS (
   Domain,
@@ -29,10 +18,7 @@ import Network.DNS (
   lookupNSAuth,
   makeResolvSeed,
   withResolver )
-import Test.Tasty ( TestTree, testGroup )
-import Test.Tasty.HUnit ( (@?=), testCase )
-import Test.Tasty.QuickCheck ( testProperty )
-import Text.Read (readMaybe)
+import Text.Read ( readMaybe )
 
 type LookupResult = (Domain, Either DNSError [Domain])
 
@@ -44,9 +30,9 @@ type LookupResult = (Domain, Either DNSError [Domain])
 --   Examples:
 --
 --   >>> resolve_address "example.com"
---   Right [93.184.216.119]
---   >>> resolve_address "93.184.216.119"
---   Right [93.184.216.119]
+--   Right [93.184.216.34]
+--   >>> resolve_address "93.184.216.34"
+--   Right [93.184.216.34]
 --
 resolve_address :: String -> IO (Either DNSError [IPv4])
 resolve_address s =
@@ -67,16 +53,16 @@ resolve_address s =
 --
 --   Examples:
 --
---   The example domain, example.com, has no MX record.
+--   The example domain, example.com, has a NULLMX record.
 --
 --   >>> rs <- makeResolvSeed defaultResolvConf
 --   >>> let domain = BS.pack "example.com."
 --   >>> withResolver rs $ \resolver -> lookupMX' resolver domain
---   ("example.com.",Right [])
+--   ("example.com.",Right ["."])
 --
 lookupMX' :: Resolver -> Domain -> IO LookupResult
 lookupMX' resolver domain =
-  liftM (pair_em . drop_priority) $ lookupMX resolver domain
+  fmap (pair_em . drop_priority) $ lookupMX resolver domain
   where
     drop_priority :: Either DNSError [(Domain, Int)]
                   -> Either DNSError [Domain]
@@ -109,7 +95,7 @@ lookupNS' :: Resolver -> Domain -> IO LookupResult
 lookupNS' resolver domain = do
   answer_result <- lookupNS resolver domain
   auth_result <- lookupNSAuth resolver domain
-  liftM pair_em $ return $ combine answer_result auth_result
+  fmap pair_em $ return $ combine answer_result auth_result
   where
     pair_em :: a -> (Domain, a)
     pair_em = (,) domain
@@ -121,78 +107,3 @@ lookupNS' resolver domain = do
       l1 <- e1
       l2 <- e2
       return (l1 ++ l2)
-
--- | Perform both normalize_case and normalize_root.
-normalize :: Domain -> Domain
-normalize = normalize_case . normalize_root
-
--- | Normalize the given name by appending a trailing dot (the DNS
---   root) if necessary.
---
-normalize_root :: Domain -> Domain
-normalize_root d
-  | BS.null d = BS.pack "."
-  | BS.last d == '.' = d
-  | otherwise = d `BS.append` trailing_dot
-    where
-      trailing_dot = BS.pack "."
-
-
--- | Normalize the given name by lowercasing it.
---
-normalize_case :: Domain -> Domain
-normalize_case = BS.map toLower
-
-
-
--- * Tests
-
-test_normalize_case :: TestTree
-test_normalize_case =
-  testCase desc $ actual @?= expected
-  where
-    desc = "normalize_case lowercases DNS names"
-    expected = BS.pack "example.com"
-    actual = normalize_case $ BS.pack "ExAmPlE.COM"
-
-prop_normalize_case_idempotent :: TestTree
-prop_normalize_case_idempotent =
-  testProperty desc $ prop
-  where
-    desc = "normalize_case is idempotent"
-
-    prop :: String -> Bool
-    prop s = (normalize_case . normalize_case) bs  == normalize_case bs
-      where
-        bs = BS.pack s
-
-test_normalize_root_adds_dot :: TestTree
-test_normalize_root_adds_dot =
-  testCase desc $ actual @?= expected
-  where
-    desc = "normalize_root adds a trailing dot"
-    expected = BS.pack "example.com."
-    actual = normalize_root $ BS.pack "example.com"
-
-prop_normalize_root_idempotent :: TestTree
-prop_normalize_root_idempotent =
-  testProperty desc prop
-  where
-    desc = "normalize_root is idempotent"
-
-    prop :: String -> Bool
-    prop s = (normalize_root . normalize_root) bs  == normalize_root bs
-      where
-        bs = BS.pack s
-
-dns_tests :: TestTree
-dns_tests =
-  testGroup "DNS Tests" [
-    test_normalize_case,
-    test_normalize_root_adds_dot ]
-
-dns_properties :: TestTree
-dns_properties =
-  testGroup "DNS Properties" [
-    prop_normalize_case_idempotent,
-    prop_normalize_root_idempotent ]