Require dns >= 1.4 and use its 'normalize' function.

diff --git a/list-remote-forwards.cabal b/list-remote-forwards.cabal
index cff0d70ebc62b7137242724e495fb10854201fd8..e6b4ece839e7deafcbfdc758f6ced147491a42ad 100644 (file)
--- a/list-remote-forwards.cabal
+++ b/list-remote-forwards.cabal
@@ -132,7 +132,7 @@ executable list-remote-forwards
     cmdargs                     >= 0.10,
     configurator                >= 0.2,
     containers                  >= 0.5,
     cmdargs                     >= 0.10,
     configurator                >= 0.2,
     containers                  >= 0.5,

-    dns                         >= 1.2,
+    dns                         >= 1.4,

     directory                   >= 1.2,
     filepath                    >= 1.3,
     HDBC                        >= 2.4,
     directory                   >= 1.2,
     filepath                    >= 1.3,
     HDBC                        >= 2.4,


@@ -183,7 +183,7 @@ test-suite testsuite
     cmdargs                     >= 0.10,
     configurator                >= 0.2,
     containers                  >= 0.5,
     cmdargs                     >= 0.10,
     configurator                >= 0.2,
     containers                  >= 0.5,

-    dns                         >= 1.2,
+    dns                         >= 1.4,

     directory                   >= 1.2,
     filepath                    >= 1.3,
     HDBC                        >= 2.4,
     directory                   >= 1.2,
     filepath                    >= 1.3,
     HDBC                        >= 2.4,

diff --git a/src/DNS.hs b/src/DNS.hs
index 00db178331f00a6ab29d5c332dcf60d00e8a32db..c319a9fbb387f66ae7a047dee33d119c6cbc5428 100644 (file)
--- a/src/DNS.hs
+++ b/src/DNS.hs
@@ -1,26 +1,12 @@
-module DNS (
-  dns_properties,
-  dns_tests,
-  lookup_mxs,
-  normalize )
+module DNS ( lookup_mxs )

 where
 
 where
 

-import qualified Data.ByteString.Char8 as BS (
-  append,
-  last,
-  map,
-  null,
-  pack )
-import Data.Char ( toLower )

 import Network.DNS (
   Domain,
   defaultResolvConf,
   lookupMX,
   makeResolvSeed,
   withResolver )
 import Network.DNS (
   Domain,
   defaultResolvConf,
   lookupMX,
   makeResolvSeed,
   withResolver )

-import Test.Tasty ( TestTree, testGroup )
-import Test.Tasty.HUnit ( (@?=), testCase )
-import Test.Tasty.QuickCheck ( testProperty )

 
 -- Slow since we create the resolver every time.
 lookup_mxs :: Domain -> IO [Domain]
 
 -- Slow since we create the resolver every time.
 lookup_mxs :: Domain -> IO [Domain]


@@ -31,77 +17,3 @@ lookup_mxs domain = do
     return $ case mxs of
                Left  _     -> []
                Right pairs -> map fst pairs
     return $ case mxs of
                Left  _     -> []
                Right pairs -> map fst pairs

-
-
--- | 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 ]

diff --git a/src/Report.hs b/src/Report.hs
index b15da98b251b67d822e1ae655fcd9ca27563066b..82409c42ef95a71b7fd346520cc3c85e40805d2b 100644 (file)
--- a/src/Report.hs
+++ b/src/Report.hs
@@ -16,12 +16,13 @@ import Database.HDBC (
   sFetchAllRows')
 import Database.HDBC.Sqlite3 ( connectSqlite3 )
 import Data.List ( (\\) )
   sFetchAllRows')
 import Database.HDBC.Sqlite3 ( connectSqlite3 )
 import Data.List ( (\\) )

+import Network.DNS.Utils ( normalize )

 import System.Console.CmdArgs.Default ( Default(..) )
 import Test.Tasty ( TestTree, testGroup )
 import Test.Tasty.HUnit ( (@?=), testCase )
 
 import Configuration ( Configuration(..) )
 import System.Console.CmdArgs.Default ( Default(..) )
 import Test.Tasty ( TestTree, testGroup )
 import Test.Tasty.HUnit ( (@?=), testCase )
 
 import Configuration ( Configuration(..) )

-import DNS ( lookup_mxs, normalize )
+import DNS ( lookup_mxs )

 import MxList ( MxList(..) )
 
 -- Type synonyms to make the signatures below a little more clear.
 import MxList ( MxList(..) )
 
 -- Type synonyms to make the signatures below a little more clear.

diff --git a/test/TestSuite.hs b/test/TestSuite.hs
index fc58bd855ca5dc2c1bd91a41b085283a399c53e2..50d56b48c356359ba6b2965b8cfc7847170e0233 100644 (file)
--- a/test/TestSuite.hs
+++ b/test/TestSuite.hs
@@ -1,12 +1,9 @@
 import Test.Tasty ( TestTree, defaultMain, testGroup )
 
 import Test.Tasty ( TestTree, defaultMain, testGroup )
 

-import DNS ( dns_properties, dns_tests )

 import Report ( report_tests )
 
 tests :: TestTree
 import Report ( report_tests )
 
 tests :: TestTree

-tests = testGroup "All tests" [ dns_properties,
-                                dns_tests,
-                                report_tests ]
+tests = testGroup "All tests" [ report_tests ]

 
 main :: IO ()
 main = defaultMain tests
 
 main :: IO ()
 main = defaultMain tests