4 import qualified Data.ByteString as BS
5 import qualified Data.ByteString.UTF8 as BSU
6 import Test.HUnit (assertEqual)
7 import Test.Framework (Test, testGroup)
8 import Test.Framework.Providers.HUnit (testCase)
9 import Text.Regex.PCRE.Light (
18 type Address = BSU.ByteString
19 type LocalPart = BSU.ByteString
20 type DomainPart = BSU.ByteString
24 -- | Split an address into local/domain parts.
25 parts :: Address -> (LocalPart, DomainPart)
30 (before, rest) = BSU.break break_func address
37 -- | Check that the lengths of the local/domain parts are within spec.
38 validate_length :: Address -> Bool
39 validate_length address =
40 (BSU.length localpart <= 64) && (BSU.length domain <= 255)
42 (localpart, domain) = parts address
44 -- | Validate an email address against a simple regex. This should
45 -- catch common addresses but disallows a lot of (legal) weird stuff.
46 validate_regex :: Address -> Bool
47 validate_regex address =
52 regex_str = "(\\w+)([\\w\\-\\.]*)@(([a-z0-9\\-]+\\.)+)[a-z]{2,4}$"
53 regex_bs = BSU.fromString regex_str
54 regex = compile regex_bs [anchored, caseless, dollar_endonly, utf8]
55 matches = match regex address []
58 -- | Validate the syntax of an email address by checking its length
59 -- and validating it against a simple regex.
60 validate_syntax :: Address -> Bool
61 validate_syntax address =
62 (validate_length address) && (validate_regex address)
66 good_addresses :: [Address]
70 "philq23562@hotmail.com",
71 "gsdfg22-2_22@hot-mail.com",
72 "bill.w@sub.domain.com",
73 "paul@sub.domain.co.uk",
74 "someone_45@someplace.info" ]
76 bad_addresses :: [Address]
79 "bad%char@domain.com",
80 "bad^char@domain.com",
81 "badunderscore@dom_ain.com",
83 "no spaces@domain.com",
84 ".beginswith@a-dot.com",
89 (replicate 65 'a') ++ "@" ++ "domain.com",
90 "abcdefg@" ++ (replicate 253 'a') ++ ".com",
91 (replicate 100 'a') ++ "@" ++ (replicate 300 'a') ++ ".com" ]
93 unsupported_addresses :: [Address]
94 unsupported_addresses =
100 "ok*char@domain.com",
101 "ok+char@domain.com",
102 "ok/char@domain.com",
103 "ok=char@domain.com",
104 "ok?char@domain.com",
105 "ok`char@domain.com",
106 "ok{char@domain.com",
107 "ok|char@domain.com",
108 "ok}char@domain.com",
109 "ok~char@domain.com",
110 "tom.phillips@[127.0.0.1]" ]
112 test_good_addresses :: Test
113 test_good_addresses =
115 assertEqual desc expected actual
117 desc = "Good addresses are accepted."
119 actual = all validate_syntax good_addresses
121 test_bad_addresses :: Test
124 assertEqual desc expected actual
126 desc = "Bad addresses are not accepted."
128 actual = all (not . validate_syntax) bad_addresses
130 test_unsupported_addresses :: Test
131 test_unsupported_addresses =
133 assertEqual desc expected actual
135 desc = "Unsupported addresses are not accepted."
137 actual = all (not . validate_syntax) unsupported_addresses
140 email_address_tests :: Test
141 email_address_tests =
142 testGroup "EmailAddress Tests" [
145 test_unsupported_addresses ]