Add an --rfc5322 option which validates against the real RFC syntax.

[email-validator.git] / src / EmailAddress.hs

diff --git a/src/EmailAddress.hs b/src/EmailAddress.hs
index 0c1080613bb69d1db5b02a9c874d6fab6f4baf46..88feafd59fb10f115578858e6a70f2fc9411d77b 100644 (file)
--- a/src/EmailAddress.hs
+++ b/src/EmailAddress.hs
@@ -3,6 +3,7 @@ where
 
 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)
@@ -56,10 +57,14 @@ validate_regex address =
 
 
 -- | 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
@@ -76,9 +81,8 @@ good_addresses =
 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",
@@ -107,7 +111,9 @@ unsupported_addresses =
     "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 =
@@ -116,7 +122,16 @@ 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 =
@@ -125,7 +140,16 @@ 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 =
@@ -134,12 +158,23 @@ 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 ]