From fed9e141735b74540fd380b051671ac1c451a178 Mon Sep 17 00:00:00 2001 From: Michael Orlitzky Date: Mon, 23 Jun 2014 09:13:47 -0400 Subject: [PATCH] Require dns >= 1.4 and use its 'normalize' function. --- list-remote-forwards.cabal | 4 +- src/DNS.hs | 90 +------------------------------------- src/Report.hs | 3 +- test/TestSuite.hs | 5 +-- 4 files changed, 6 insertions(+), 96 deletions(-) diff --git a/list-remote-forwards.cabal b/list-remote-forwards.cabal index cff0d70..e6b4ece 100644 --- 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, - dns >= 1.2, + dns >= 1.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, - dns >= 1.2, + dns >= 1.4, directory >= 1.2, filepath >= 1.3, HDBC >= 2.4, diff --git a/src/DNS.hs b/src/DNS.hs index 00db178..c319a9f 100644 --- 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 -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 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] @@ -31,77 +17,3 @@ lookup_mxs domain = do 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 b15da98..82409c4 100644 --- a/src/Report.hs +++ b/src/Report.hs @@ -16,12 +16,13 @@ import Database.HDBC ( 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 DNS ( lookup_mxs, normalize ) +import DNS ( lookup_mxs ) 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 fc58bd8..50d56b4 100644 --- a/test/TestSuite.hs +++ b/test/TestSuite.hs @@ -1,12 +1,9 @@ import Test.Tasty ( TestTree, defaultMain, testGroup ) -import DNS ( dns_properties, dns_tests ) 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 -- 2.43.2