X-Git-Url: http://gitweb.michael.orlitzky.com/?p=email-validator.git;a=blobdiff_plain;f=src%2FEmailAddress.hs;h=615d43cf5ae02358de0ff5b47c9ab2b4e705e33f;hp=c20aa3069324fc7e0eab6d2857c54729b0c47bec;hb=80e83309f0de0b4b89002564c94d9d988924bf9e;hpb=2a7f245979ec1dc33657cba9ee14144a77e45e25 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