4 import qualified Data.ByteString.Char8 as BS (
11 import Text.Email.Validate (isValid)
12 import Test.HUnit (assertEqual)
13 import Test.Framework (Test, testGroup)
14 import Test.Framework.Providers.HUnit (testCase)
15 import Text.Regex.PCRE.Light (
24 type Address = BS.ByteString
25 type LocalPart = BS.ByteString
26 type DomainPart = BS.ByteString
30 -- | Split an address into local/domain parts.
31 parts :: Address -> (LocalPart, DomainPart)
36 (before, rest) = BS.break break_func address
43 -- | Check that the lengths of the local/domain parts are within spec.
44 validate_length :: Address -> Bool
45 validate_length address =
46 (BS.length localpart <= 64) && (BS.length domain <= 255)
48 (localpart, domain) = parts address
50 -- | Validate an email address against a simple regex. This should
51 -- catch common addresses but disallows a lot of (legal) weird stuff.
52 validate_regex :: Address -> Bool
53 validate_regex address =
58 regex_str = "(\\w+)([\\w\\-\\.]*)@(([a-z0-9\\-]+\\.)+)[a-z]{2,4}$"
59 regex_bs = BS.pack regex_str
60 regex = compile regex_bs [anchored, caseless, dollar_endonly, utf8]
61 matches = match regex address []
64 -- | Validate the syntax of an email address by checking its length
65 -- and validating it against either a simple regex or RFC5322,
66 -- depending on the --rfc5322 flag.
67 validate_syntax :: Bool -> Address -> Bool
68 validate_syntax rfc5322 address =
69 (validate_length address) &&
72 else validate_regex address
76 good_addresses :: [Address]
80 "philq23562@hotmail.com",
81 "gsdfg22-2_22@hot-mail.com",
82 "bill.w@sub.domain.com",
83 "paul@sub.domain.co.uk",
84 "someone_45@someplace.info" ]
86 bad_addresses :: [Address]
89 -- Bad, but not caught by email-validate-0.0.1.
90 -- "badunderscore@dom_ain.com",
92 "no spaces@domain.com",
93 ".beginswith@a-dot.com",
98 (replicate 65 'a') ++ "@" ++ "domain.com",
99 "abcdefg@" ++ (replicate 253 'a') ++ ".com",
100 (replicate 100 'a') ++ "@" ++ (replicate 300 'a') ++ ".com" ]
102 unsupported_addresses :: [Address]
103 unsupported_addresses =
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 "ok+char@domain.com",
111 "ok/char@domain.com",
112 "ok=char@domain.com",
113 "ok?char@domain.com",
114 "ok`char@domain.com",
115 "ok{char@domain.com",
116 "ok|char@domain.com",
117 "ok}char@domain.com",
118 "ok~char@domain.com",
119 "tom.phillips@[127.0.0.1]",
120 "bad%char@domain.com",
121 "bad^char@domain.com" ]
123 test_good_addresses :: Test
124 test_good_addresses =
126 assertEqual desc expected actual
128 desc = "Good addresses are accepted."
130 actual = all (validate_syntax False) good_addresses
132 test_good_addresses_rfc :: Test
133 test_good_addresses_rfc =
135 assertEqual desc expected actual
137 desc = "Good addresses are accepted with --rfc5322."
139 actual = all (validate_syntax True) good_addresses
141 test_bad_addresses :: Test
144 assertEqual desc expected actual
146 desc = "Bad addresses are not accepted."
148 actual = all (not . (validate_syntax False)) bad_addresses
150 test_bad_addresses_rfc :: Test
151 test_bad_addresses_rfc =
153 assertEqual desc expected actual
155 desc = "Bad addresses are not accepted with --rfc5322."
157 actual = all (not . (validate_syntax True)) bad_addresses
159 test_unsupported_addresses :: Test
160 test_unsupported_addresses =
162 assertEqual desc expected actual
164 desc = "Unsupported addresses are not accepted."
166 actual = all (not . (validate_syntax False)) unsupported_addresses
168 test_unsupported_addresses_rfc :: Test
169 test_unsupported_addresses_rfc =
171 assertEqual desc expected actual
173 desc = "Unsupported addresses are accepted with --rfc5322."
175 actual = all (validate_syntax True) unsupported_addresses
177 email_address_tests :: Test
178 email_address_tests =
179 testGroup "EmailAddress Tests" [
181 test_good_addresses_rfc,
183 test_bad_addresses_rfc,
184 test_unsupported_addresses,
185 test_unsupported_addresses_rfc ]