From: Michael Orlitzky Date: Sun, 22 Jun 2014 23:10:33 +0000 (-0400) Subject: Version bump to v0.4.1. X-Git-Tag: 0.4.2~1 X-Git-Url: http://gitweb.michael.orlitzky.com/?p=haeredes.git;a=commitdiff_plain;h=e862342c38e41176a7ab300b6d7ed03cf0ffd6b2 Version bump to v0.4.1. Remove the tasty test dependencies. Remove the tasty test suite (it only tested the normalization functions). Require dns >= 1.4. Use the normalize* functions moved upstream to Network.DNS.Utils in v1.4.0. --- diff --git a/haeredes.cabal b/haeredes.cabal index 9961eed..c6fce5a 100644 --- a/haeredes.cabal +++ b/haeredes.cabal @@ -1,5 +1,5 @@ name: haeredes -version: 0.4.0 +version: 0.4.1 cabal-version: >= 1.8 author: Michael Orlitzky maintainer: Michael Orlitzky @@ -83,14 +83,10 @@ executable haeredes base == 4.*, bytestring == 0.10.*, cmdargs == 0.10.*, - dns == 1.*, + dns >= 1.4, iproute == 1.2.*, MissingH == 1.2.*, - parallel-io == 0.3.*, - -- Test deps - tasty == 0.8.*, - tasty-hunit == 0.8.*, - tasty-quickcheck == 0.8.* + parallel-io == 0.3.* main-is: Main.hs @@ -120,39 +116,6 @@ executable haeredes -optc-O3 -optc-march=native -test-suite testsuite - type: exitcode-stdio-1.0 - hs-source-dirs: src test - main-is: TestSuite.hs - build-depends: - base == 4.*, - bytestring == 0.10.*, - cmdargs == 0.10.*, - dns == 1.*, - iproute == 1.2.*, - MissingH == 1.2.*, - parallel-io == 0.3.*, - -- Test deps - tasty == 0.8.*, - tasty-hunit == 0.8.*, - tasty-quickcheck == 0.8.* - - -- It's not entirely clear to me why I have to reproduce all of this. - ghc-options: - -Wall - -fwarn-hi-shadowing - -fwarn-missing-signatures - -fwarn-name-shadowing - -fwarn-orphans - -fwarn-type-defaults - -fwarn-tabs - -fwarn-incomplete-record-updates - -fwarn-monomorphism-restriction - -fwarn-unused-do-bind - -rtsopts - -threaded - -optc-O3 - -optc-march=native test-suite doctests type: exitcode-stdio-1.0 diff --git a/src/CommandLine.hs b/src/CommandLine.hs index b94e378..1a1c313 100644 --- a/src/CommandLine.hs +++ b/src/CommandLine.hs @@ -2,8 +2,7 @@ module CommandLine ( Args(..), - get_args - ) + get_args ) where import System.Console.CmdArgs ( diff --git a/src/DNS.hs b/src/DNS.hs index 497bf31..3c89ff4 100644 --- a/src/DNS.hs +++ b/src/DNS.hs @@ -1,22 +1,12 @@ 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 Control.Monad ( liftM ) +import qualified Data.ByteString.Char8 as BS ( pack ) import Data.IP (IPv4) import Network.DNS ( Domain, @@ -29,10 +19,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]) @@ -121,78 +108,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 ] diff --git a/src/Main.hs b/src/Main.hs index 679a1ac..70fa2f5 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -17,6 +17,8 @@ import Network.DNS ( ResolvConf(resolvInfo, resolvTimeout), defaultResolvConf, makeResolvSeed, + normalize, + normalizeCase, withResolver ) import System.Exit (ExitCode(..), exitWith) import System.IO (hPutStrLn, stderr) @@ -27,8 +29,6 @@ import DNS ( LookupResult, lookupMX', lookupNS', - normalize, - normalize_case, resolve_address ) import ExitCodes (exit_bad_server) import Timeout (Timeout(..)) @@ -81,7 +81,7 @@ main = do let normalize_function = if (no_append_root cfg) - then normalize_case + then normalizeCase else normalize -- Normalize the given names and delegates diff --git a/test/TestSuite.hs b/test/TestSuite.hs deleted file mode 100644 index 91e044c..0000000 --- a/test/TestSuite.hs +++ /dev/null @@ -1,12 +0,0 @@ -module Main -where - -import Test.Tasty ( TestTree, defaultMain, testGroup ) - -import DNS ( dns_properties, dns_tests ) - -tests :: TestTree -tests = testGroup "All tests" [ dns_properties, dns_tests ] - -main :: IO () -main = defaultMain tests