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