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 Test.Tasty ( TestTree, testGroup )
+import Test.Tasty.HUnit ( (@?=), testCase )
+import Test.Tasty.QuickCheck ( testProperty )
import Text.Read (readMaybe)
type LookupResult = (Domain, Either DNSError [Domain])
-- | 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 "."
-- | Normalize the given name by lowercasing it.
+--
normalize_case :: Domain -> Domain
normalize_case = BS.map toLower
-test_normalize_case :: Test
+
+-- * Tests
+
+test_normalize_case :: TestTree
test_normalize_case =
- testCase desc $
- assertEqual desc expected actual
+ 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 :: String -> Bool
-prop_normalize_case_idempotent s =
- (normalize_case . normalize_case) bs == normalize_case bs
+prop_normalize_case_idempotent :: TestTree
+prop_normalize_case_idempotent =
+ testProperty desc $ prop
where
- bs = BS.pack s
+ 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 :: Test
+test_normalize_root_adds_dot :: TestTree
test_normalize_root_adds_dot =
- testCase desc $
- assertEqual desc expected actual
+ 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 :: String -> Bool
-prop_normalize_root_idempotent s =
- (normalize_root . normalize_root) bs == normalize_root bs
+prop_normalize_root_idempotent :: TestTree
+prop_normalize_root_idempotent =
+ testProperty desc prop
where
- bs = BS.pack s
+ 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 :: Test
+dns_tests :: TestTree
dns_tests =
testGroup "DNS Tests" [
test_normalize_case,
test_normalize_root_adds_dot ]
-dns_properties :: Test
+dns_properties :: TestTree
dns_properties =
testGroup "DNS Properties" [
- testProperty
- "normalize_case is idempotent"
- prop_normalize_case_idempotent,
- testProperty
- "normalize_root is idempotent"
- prop_normalize_root_idempotent ]
+ prop_normalize_case_idempotent,
+ prop_normalize_root_idempotent ]