{-# LANGUAGE OverloadedStrings #-}
module Main where
import Test.Hspec
import Test.Hspec.QuickCheck
import Text.Regex.PCRE
import Control.Monad
import Data.Text (Text, unpack, pack)
import qualified Data.Text as T
import Test.QuickCheck
import Data.Monoid
import Text.Html.Email.Validate
main :: IO ()
main = hspec $ do
describe "Checking the correctness of parsing" $ do
forM_ validEmails $ \(raw,parsed) -> do
it (unpack raw) $ do
parseEmail raw `shouldBe` Right parsed
describe "Checking against the regex" $ do
describe "Emails from wikipedia:" $ do
forM_ (map unpack emails) $ \email -> do
it email $ do
testEmail email
describe "QuickCheck property:" $ do
modifyMaxSuccess (const 100000) $ prop "random@random:" $
\local domain -> testEmail $ local ++ "@" ++ domain
{-describe "Very long label:" $ do-}
{-it "really long" $ isValidEmail ("j@aa" <> T.replicate 10000000 "-a") `shouldBe` False-}
testEmail email = (isValidEmail $ pack email) `shouldBe` validateEmailRegex email
validateEmailRegex email
| any (== '\n') email = False -- For some reason when using Text.Regex.PCRE
-- the javascript regex matches '\n' even
-- though when the same regex is used in
-- javascript it doesn't
| otherwise = email =~ emailRegex
emailRegex = "^[a-zA-Z0-9.!#$%&'*+\\/=?^_`{|}~-]+@[a-zA-Z0-9](?:[a-zA-Z0-9-]{0,61}[a-zA-Z0-9])?(?:\\.[a-zA-Z0-9](?:[a-zA-Z0-9-]{0,61}[a-zA-Z0-9])?)*$" :: String
emails :: [Text]
emails = map fst validEmails ++ invalidEmails
validEmails :: [(Text, EmailAddress)]
validEmails = [ ("niceandsimple@example.com", EmailAddress "niceandsimple" "example.com")
, ("very.common@example.com", EmailAddress "very.common" "example.com")
, ("a.little.lengthy.but.fine@dept.example.com", EmailAddress "a.little.lengthy.but.fine" "dept.example.com")
, ("disposable.style.email.with+symbol@example.com", EmailAddress "disposable.style.email.with+symbol" "example.com")
, ("other.email-with-dash@example.com", EmailAddress "other.email-with-dash" "example.com")
, ("admin@mailserver1", EmailAddress "admin" "mailserver1")
, ("!#$%&'*+-/=?^_`{}|~@example.org", EmailAddress "!#$%&'*+-/=?^_`{}|~" "example.org")
, ("john..doe@example.com", EmailAddress "john..doe" "example.com")
, let domain = "a" <> T.replicate 31 "-a"
in ("j@" <> domain, EmailAddress "j" domain) -- 63 characters in one label (maximum)
]
invalidEmails :: [Text]
invalidEmails = [ "\"much.more unusual\"@example.com"
, "\"very.unusual.@.unusual.com\"@example.com"
, "\"very.(),:;<>[]\\\".VERY.\\\"very@\\\\ \\\"very\\\".unusual\"@strange.example.com"
, "\"()<>[]:,;@\\\"!#$%&'*+-/=?^_`{}| ~.a\"@example.org","\" \"@example.org"
, "\252\241\238\231\248\240\233@example.com"
, "\252\241\238\231\248\240\233@\252\241\238\231\248\240\233.com"
, "Abc.example.com"
, "A@b@c@example.com","a\"b(c)d,e:f;g<h>i[j\\k]l@example.com"
, "just\"not\"right@example.com"
, "this is\"not\allowed@example.com"
, "this\\ still\\\"not\\\\allowed@example.com"
, "john.doe@example..com"
, "j@aa" <> T.replicate 31 "-a" -- 64 characters in one label (just out of limit)
]