X-Git-Url: http://gitweb.michael.orlitzky.com/?p=haeredes.git;a=blobdiff_plain;f=src%2FDNS.hs;h=b8e9cd0521e6baec631c56da2d4753e531e2ffc1;hp=34a8bd18a6f17a06abc4bcaecf55169b77f38263;hb=c66c2d4fdf14e5b0fa54f39e6061eb4774c7b98a;hpb=689bda2499ec821772b456cb7982527d6740649f diff --git a/src/DNS.hs b/src/DNS.hs index 34a8bd1..b8e9cd0 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,11 +19,7 @@ import Network.DNS ( lookupNSAuth, makeResolvSeed, withResolver ) -import Test.Framework (Test, testGroup) -import Test.Framework.Providers.HUnit (testCase) -import Test.Framework.Providers.QuickCheck2 (testProperty) -import Test.HUnit (assertEqual) -import Text.Read (readMaybe) +import Text.Read ( readMaybe ) type LookupResult = (Domain, Either DNSError [Domain]) @@ -45,9 +31,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 = @@ -122,69 +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 - - -test_normalize_case :: Test -test_normalize_case = - testCase desc $ - assertEqual desc expected actual - where - desc = "normalize_case lowercases DNS names" - expected = BS.pack "example.com" - actual = normalize_case $ BS.pack "ExAmPlE.COM" - -prop_normalize_case_idempotent :: String -> Bool -prop_normalize_case_idempotent s = - (normalize_case . normalize_case) bs == normalize_case bs - where - bs = BS.pack s - -test_normalize_root_adds_dot :: Test -test_normalize_root_adds_dot = - testCase desc $ - assertEqual desc expected actual - where - desc = "normalize_root adds a trailing dot" - expected = BS.pack "example.com." - actual = normalize_root $ BS.pack "example.com" - -prop_normalize_root_idempotent :: String -> Bool -prop_normalize_root_idempotent s = - (normalize_root . normalize_root) bs == normalize_root bs - where - bs = BS.pack s - -dns_tests :: Test -dns_tests = - testGroup "DNS Tests" [ - test_normalize_case, - test_normalize_root_adds_dot ] - -dns_properties :: Test -dns_properties = - testGroup "DNS Properties" [ - testProperty - "normalize_case is idempotent" - prop_normalize_case_idempotent, - testProperty - "normalize_root is idempotent" - prop_normalize_root_idempotent ]