From 80e83309f0de0b4b89002564c94d9d988924bf9e Mon Sep 17 00:00:00 2001
From: Michael Orlitzky <michael@orlitzky.com>
Date: Sun, 9 Jun 2013 14:01:46 -0400
Subject: [PATCH] Add length tests and fix zero-length domain bug.

---
 src/EmailAddress.hs | 26 +++++++++++++++++++++-----
 src/Main.hs         |  6 ------
 2 files changed, 21 insertions(+), 11 deletions(-)

diff --git a/src/EmailAddress.hs b/src/EmailAddress.hs
index c20aa30..615d43c 100644
--- a/src/EmailAddress.hs
+++ b/src/EmailAddress.hs
@@ -28,7 +28,10 @@ parts address =
   where
     break_func = (== '@')
     (before, rest) = BSU.break break_func address
-    after = BS.tail rest
+    after =
+      if rest == BS.empty
+      then BS.empty
+      else BS.tail rest
 
 
 -- | Check that the lengths of the local/domain parts are within spec.
@@ -52,6 +55,12 @@ validate_regex address =
     matches = match 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)
+
 
 -- HUnit tests
 good_addresses :: [Address]
@@ -72,7 +81,14 @@ bad_addresses =
     "badunderscore@dom_ain.com",
     "(fail)@domain.com",
     "no spaces@domain.com",
-    ".beginswith@a-dot.com"  ]
+    ".beginswith@a-dot.com",
+    "a",
+    "a.com",
+    "@b.com",
+    "b@",
+    (replicate 65 'a') ++ "@" ++ "domain.com",
+    "abcdefg@" ++ (replicate 253 'a') ++ ".com",
+    (replicate 100 'a') ++ "@" ++ (replicate 300 'a') ++ ".com" ]
 
 unsupported_addresses :: [Address]
 unsupported_addresses =
@@ -100,7 +116,7 @@ test_good_addresses =
   where
     desc = "Good addresses are accepted."
     expected = True
-    actual = and (map validate_regex good_addresses)
+    actual = and (map validate_syntax good_addresses)
 
 test_bad_addresses :: Test
 test_bad_addresses =
@@ -109,7 +125,7 @@ test_bad_addresses =
   where
     desc = "Bad addresses are not accepted."
     expected = True
-    actual = and (map (not . validate_regex) bad_addresses)
+    actual = and (map (not . validate_syntax) bad_addresses)
 
 test_unsupported_addresses :: Test
 test_unsupported_addresses =
@@ -118,7 +134,7 @@ test_unsupported_addresses =
   where
     desc = "Unsupported addresses are not accepted."
     expected = True
-    actual = and (map (not . validate_regex) unsupported_addresses)
+    actual = and (map (not . validate_syntax) unsupported_addresses)
 
 
 email_address_tests :: Test
diff --git a/src/Main.hs b/src/Main.hs
index d2346c4..9b22f5c 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -60,12 +60,6 @@ validate_mx resolver domain
         _       -> return True
 
 
--- | 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)
-
 
 -- | Validate an email address by doing some simple syntax checks and
 --   (if those fail) an MX lookup. We don't count an A record as a mail
-- 
2.43.2