X-Git-Url: http://gitweb.michael.orlitzky.com/?a=blobdiff_plain;f=src%2FEmailAddress.hs;fp=src%2FEmailAddress.hs;h=c20aa3069324fc7e0eab6d2857c54729b0c47bec;hb=a5e228280dfbdbd8f2b1f271adb362fee1a43de4;hp=0000000000000000000000000000000000000000;hpb=8096b134a33ace33ea23368353c011e9f68549c7;p=email-validator.git

diff --git a/src/EmailAddress.hs b/src/EmailAddress.hs
new file mode 100644
index 0000000..c20aa30
--- /dev/null
+++ b/src/EmailAddress.hs
@@ -0,0 +1,129 @@
+module EmailAddress
+where
+
+import qualified Data.ByteString as BS
+import qualified Data.ByteString.UTF8 as BSU
+import Test.HUnit (assertEqual)
+import Test.Framework (Test, testGroup)
+import Test.Framework.Providers.HUnit (testCase)
+import Text.Regex.PCRE.Light (
+  anchored,
+  caseless,
+  compile,
+  dollar_endonly,
+  match,
+  utf8
+  )
+
+type Address = BSU.ByteString
+type LocalPart = BSU.ByteString
+type DomainPart = BSU.ByteString
+
+
+
+-- | Split an address into local/domain parts.
+parts :: Address -> (LocalPart, DomainPart)
+parts address =
+  (before, after)
+  where
+    break_func = (== '@')
+    (before, rest) = BSU.break break_func address
+    after = BS.tail rest
+
+
+-- | Check that the lengths of the local/domain parts are within spec.
+validate_length :: Address -> Bool
+validate_length address =
+  (BSU.length localpart <= 64) && (BSU.length domain <= 255)
+  where
+    (localpart, domain) = parts address
+
+-- | Validate an email address against a simple regex. This should
+--   catch common addresses but disallows a lot of (legal) weird stuff.
+validate_regex :: Address -> Bool
+validate_regex address =
+  case matches of
+    Nothing -> False
+    _       -> True
+  where
+    regex_str = "(\\w+)([\\w\\-\\.]*)@(([a-z0-9\\-]+\\.)+)[a-z]{2,4}$"
+    regex_bs  = BSU.fromString regex_str
+    regex = compile regex_bs [anchored, caseless, dollar_endonly, utf8]
+    matches = match regex address []
+
+
+
+-- HUnit tests
+good_addresses :: [Address]
+good_addresses =
+  map BSU.fromString [
+    "phil@hotmail.com",
+    "philq23562@hotmail.com",
+    "gsdfg22-2_22@hot-mail.com",
+    "bill.w@sub.domain.com",
+    "paul@sub.domain.co.uk",
+    "someone_45@someplace.info" ]
+
+bad_addresses :: [Address]
+bad_addresses =
+  map BSU.fromString [
+    "bad%char@domain.com",
+    "bad^char@domain.com",
+    "badunderscore@dom_ain.com",
+    "(fail)@domain.com",
+    "no spaces@domain.com",
+    ".beginswith@a-dot.com"  ]
+
+unsupported_addresses :: [Address]
+unsupported_addresses =
+  map BSU.fromString [
+    "ok!char@domain.com",
+    "ok#char@domain.com",
+    "ok$char@domain.com",
+    "ok'char@domain.com",
+    "ok*char@domain.com",
+    "ok+char@domain.com",
+    "ok/char@domain.com",
+    "ok=char@domain.com",
+    "ok?char@domain.com",
+    "ok`char@domain.com",
+    "ok{char@domain.com",
+    "ok|char@domain.com",
+    "ok}char@domain.com",
+    "ok~char@domain.com",
+    "tom.phillips@[127.0.0.1]" ]
+
+test_good_addresses :: Test
+test_good_addresses =
+  testCase desc $
+    assertEqual desc expected actual
+  where
+    desc = "Good addresses are accepted."
+    expected = True
+    actual = and (map validate_regex good_addresses)
+
+test_bad_addresses :: Test
+test_bad_addresses =
+  testCase desc $
+    assertEqual desc expected actual
+  where
+    desc = "Bad addresses are not accepted."
+    expected = True
+    actual = and (map (not . validate_regex) bad_addresses)
+
+test_unsupported_addresses :: Test
+test_unsupported_addresses =
+  testCase desc $
+    assertEqual desc expected actual
+  where
+    desc = "Unsupported addresses are not accepted."
+    expected = True
+    actual = and (map (not . validate_regex) unsupported_addresses)
+
+
+email_address_tests :: Test
+email_address_tests =
+  testGroup "EmailAddress Tests" [
+    test_good_addresses,
+    test_bad_addresses,
+    test_unsupported_addresses ]