--- /dev/null
+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 ]