name: haeredes
-version: 0.4.0
+version: 0.4.1
cabal-version: >= 1.8
author: Michael Orlitzky
maintainer: Michael Orlitzky <michael@orlitzky.com>
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
-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
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,
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])
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 ]