import qualified Data.ByteString as BS
import qualified Data.ByteString.UTF8 as BSU
+import Text.Email.Validate (isValid)
import Test.HUnit (assertEqual)
import Test.Framework (Test, testGroup)
import Test.Framework.Providers.HUnit (testCase)
-- | Validate the syntax of an email address by checking its length
--- and validating it against a simple regex.
-validate_syntax :: Address -> Bool
-validate_syntax address =
- (validate_length address) && (validate_regex address)
+-- and validating it against either a simple regex or RFC5322,
+-- depending on the --rfc5322 flag.
+validate_syntax :: Bool -> Address -> Bool
+validate_syntax rfc5322 address =
+ (validate_length address) &&
+ if rfc5322
+ then isValid address
+ else validate_regex address
-- HUnit tests
bad_addresses :: [Address]
bad_addresses =
map BSU.fromString [
- "bad%char@domain.com",
- "bad^char@domain.com",
- "badunderscore@dom_ain.com",
+-- Bad, but not caught by email-validate-1.0.0.
+-- "badunderscore@dom_ain.com",
"(fail)@domain.com",
"no spaces@domain.com",
".beginswith@a-dot.com",
"ok|char@domain.com",
"ok}char@domain.com",
"ok~char@domain.com",
- "tom.phillips@[127.0.0.1]" ]
+ "tom.phillips@[127.0.0.1]",
+ "bad%char@domain.com",
+ "bad^char@domain.com" ]
test_good_addresses :: Test
test_good_addresses =
where
desc = "Good addresses are accepted."
expected = True
- actual = all validate_syntax good_addresses
+ actual = all (validate_syntax False) good_addresses
+
+test_good_addresses_rfc :: Test
+test_good_addresses_rfc =
+ testCase desc $
+ assertEqual desc expected actual
+ where
+ desc = "Good addresses are accepted with --rfc5322."
+ expected = True
+ actual = all (validate_syntax True) good_addresses
test_bad_addresses :: Test
test_bad_addresses =
where
desc = "Bad addresses are not accepted."
expected = True
- actual = all (not . validate_syntax) bad_addresses
+ actual = all (not . (validate_syntax False)) bad_addresses
+
+test_bad_addresses_rfc :: Test
+test_bad_addresses_rfc =
+ testCase desc $
+ assertEqual desc expected actual
+ where
+ desc = "Bad addresses are not accepted with --rfc5322."
+ expected = True
+ actual = all (not . (validate_syntax True)) bad_addresses
test_unsupported_addresses :: Test
test_unsupported_addresses =
where
desc = "Unsupported addresses are not accepted."
expected = True
- actual = all (not . validate_syntax) unsupported_addresses
+ actual = all (not . (validate_syntax False)) unsupported_addresses
+test_unsupported_addresses_rfc :: Test
+test_unsupported_addresses_rfc =
+ testCase desc $
+ assertEqual desc expected actual
+ where
+ desc = "Unsupported addresses are accepted with --rfc5322."
+ expected = True
+ actual = all (validate_syntax True) unsupported_addresses
email_address_tests :: Test
email_address_tests =
testGroup "EmailAddress Tests" [
test_good_addresses,
+ test_good_addresses_rfc,
test_bad_addresses,
- test_unsupported_addresses ]
+ test_bad_addresses_rfc,
+ test_unsupported_addresses,
+ test_unsupported_addresses_rfc ]