+
+
+
+-- * 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 ]