4 import qualified Data.ByteString as BS
5 import qualified Data.ByteString.UTF8 as BSU
6 import Text.Email.Validate (isValid)
7 import Test.HUnit (assertEqual)
8 import Test.Framework (Test, testGroup)
9 import Test.Framework.Providers.HUnit (testCase)
10 import Text.Regex.PCRE.Light (
19 type Address = BSU.ByteString
20 type LocalPart = BSU.ByteString
21 type DomainPart = BSU.ByteString
25 -- | Split an address into local/domain parts.
26 parts :: Address -> (LocalPart, DomainPart)
31 (before, rest) = BSU.break break_func address
38 -- | Check that the lengths of the local/domain parts are within spec.
39 validate_length :: Address -> Bool
40 validate_length address =
41 (BSU.length localpart <= 64) && (BSU.length domain <= 255)
43 (localpart, domain) = parts address
45 -- | Validate an email address against a simple regex. This should
46 -- catch common addresses but disallows a lot of (legal) weird stuff.
47 validate_regex :: Address -> Bool
48 validate_regex address =
53 regex_str = "(\\w+)([\\w\\-\\.]*)@(([a-z0-9\\-]+\\.)+)[a-z]{2,4}$"
54 regex_bs = BSU.fromString regex_str
55 regex = compile regex_bs [anchored, caseless, dollar_endonly, utf8]
56 matches = match regex address []
59 -- | Validate the syntax of an email address by checking its length
60 -- and validating it against either a simple regex or RFC5322,
61 -- depending on the --rfc5322 flag.
62 validate_syntax :: Bool -> Address -> Bool
63 validate_syntax rfc5322 address =
64 (validate_length address) &&
67 else validate_regex address
71 good_addresses :: [Address]
75 "philq23562@hotmail.com",
76 "gsdfg22-2_22@hot-mail.com",
77 "bill.w@sub.domain.com",
78 "paul@sub.domain.co.uk",
79 "someone_45@someplace.info" ]
81 bad_addresses :: [Address]
84 -- Bad, but not caught by email-validate-1.0.0.
85 -- "badunderscore@dom_ain.com",
87 "no spaces@domain.com",
88 ".beginswith@a-dot.com",
93 (replicate 65 'a') ++ "@" ++ "domain.com",
94 "abcdefg@" ++ (replicate 253 'a') ++ ".com",
95 (replicate 100 'a') ++ "@" ++ (replicate 300 'a') ++ ".com" ]
97 unsupported_addresses :: [Address]
98 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 "ok{char@domain.com",
111 "ok|char@domain.com",
112 "ok}char@domain.com",
113 "ok~char@domain.com",
114 "tom.phillips@[127.0.0.1]",
115 "bad%char@domain.com",
116 "bad^char@domain.com" ]
118 test_good_addresses :: Test
119 test_good_addresses =
121 assertEqual desc expected actual
123 desc = "Good addresses are accepted."
125 actual = all (validate_syntax False) good_addresses
127 test_good_addresses_rfc :: Test
128 test_good_addresses_rfc =
130 assertEqual desc expected actual
132 desc = "Good addresses are accepted with --rfc5322."
134 actual = all (validate_syntax True) good_addresses
136 test_bad_addresses :: Test
139 assertEqual desc expected actual
141 desc = "Bad addresses are not accepted."
143 actual = all (not . (validate_syntax False)) bad_addresses
145 test_bad_addresses_rfc :: Test
146 test_bad_addresses_rfc =
148 assertEqual desc expected actual
150 desc = "Bad addresses are not accepted with --rfc5322."
152 actual = all (not . (validate_syntax True)) bad_addresses
154 test_unsupported_addresses :: Test
155 test_unsupported_addresses =
157 assertEqual desc expected actual
159 desc = "Unsupported addresses are not accepted."
161 actual = all (not . (validate_syntax False)) unsupported_addresses
163 test_unsupported_addresses_rfc :: Test
164 test_unsupported_addresses_rfc =
166 assertEqual desc expected actual
168 desc = "Unsupported addresses are accepted with --rfc5322."
170 actual = all (validate_syntax True) unsupported_addresses
172 email_address_tests :: Test
173 email_address_tests =
174 testGroup "EmailAddress Tests" [
176 test_good_addresses_rfc,
178 test_bad_addresses_rfc,
179 test_unsupported_addresses,
180 test_unsupported_addresses_rfc ]