8 import qualified Data.ByteString.Char8 as BS (
14 import Data.Char ( toLower )
21 import Test.Tasty ( TestTree, testGroup )
22 import Test.Tasty.HUnit ( (@?=), testCase )
23 import Test.Tasty.QuickCheck ( testProperty )
25 -- Slow since we create the resolver every time.
26 lookup_mxs :: Domain -> IO [Domain]
27 lookup_mxs domain = do
28 default_rs <- makeResolvSeed defaultResolvConf
29 withResolver default_rs $ \resolver -> do
30 mxs <- lookupMX resolver domain
33 Right pairs -> map fst pairs
36 -- | Perform both normalize_case and normalize_root.
37 normalize :: Domain -> Domain
38 normalize = normalize_case . normalize_root
40 -- | Normalize the given name by appending a trailing dot (the DNS
41 -- root) if necessary.
43 normalize_root :: Domain -> Domain
45 | BS.null d = BS.pack "."
46 | BS.last d == '.' = d
47 | otherwise = d `BS.append` trailing_dot
49 trailing_dot = BS.pack "."
52 -- | Normalize the given name by lowercasing it.
54 normalize_case :: Domain -> Domain
55 normalize_case = BS.map toLower
59 test_normalize_case :: TestTree
61 testCase desc $ actual @?= expected
63 desc = "normalize_case lowercases DNS names"
64 expected = BS.pack "example.com"
65 actual = normalize_case $ BS.pack "ExAmPlE.COM"
67 prop_normalize_case_idempotent :: TestTree
68 prop_normalize_case_idempotent =
69 testProperty desc $ prop
71 desc = "normalize_case is idempotent"
73 prop :: String -> Bool
74 prop s = (normalize_case . normalize_case) bs == normalize_case bs
78 test_normalize_root_adds_dot :: TestTree
79 test_normalize_root_adds_dot =
80 testCase desc $ actual @?= expected
82 desc = "normalize_root adds a trailing dot"
83 expected = BS.pack "example.com."
84 actual = normalize_root $ BS.pack "example.com"
86 prop_normalize_root_idempotent :: TestTree
87 prop_normalize_root_idempotent =
88 testProperty desc prop
90 desc = "normalize_root is idempotent"
92 prop :: String -> Bool
93 prop s = (normalize_root . normalize_root) bs == normalize_root bs
99 testGroup "DNS Tests" [
101 test_normalize_root_adds_dot ]
103 dns_properties :: TestTree
105 testGroup "DNS Properties" [
106 prop_normalize_case_idempotent,
107 prop_normalize_root_idempotent ]