email-validate 2.3.2.15 → 2.3.2.16
raw patch · 8 files changed
+800/−800 lines, 8 filesdep ~doctestdep ~hspecdep ~template-haskellsetup-changedPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: doctest, hspec, template-haskell
API changes (from Hackage documentation)
Files
- LICENSE +30/−30
- Setup.lhs +3/−3
- email-validate.cabal +59/−59
- src/Text/Email/Parser.hs +196/−196
- src/Text/Email/QuasiQuotation.hs +42/−42
- src/Text/Email/Validate.hs +63/−63
- tests/Main.hs +400/−400
- tests/doctests.hs +7/−7
LICENSE view
@@ -1,30 +1,30 @@-Copyright (c) 2009 George Pollard--All rights reserved.--Redistribution and use in source and binary forms, with or without-modification, are permitted provided that the following conditions-are met:--1. Redistributions of source code must retain the above copyright- notice, this list of conditions and the following disclaimer.--2. Redistributions in binary form must reproduce the above copyright- notice, this list of conditions and the following disclaimer in the- documentation and/or other materials provided with the distribution.--3. Neither the name of the author nor the names of his contributors- may be used to endorse or promote products derived from this software- without specific prior written permission.--THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND ANY EXPRESS OR-IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED-WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE-DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR-ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL-DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS-OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)-HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,-STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN-ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE-POSSIBILITY OF SUCH DAMAGE.+Copyright (c) 2009 George Pollard + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions +are met: + +1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + +2. Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + +3. Neither the name of the author nor the names of his contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND ANY EXPRESS OR +IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED +WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE +DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR +ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS +OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) +HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, +STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN +ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +POSSIBILITY OF SUCH DAMAGE.
Setup.lhs view
@@ -1,3 +1,3 @@-#!/usr/bin/env runhaskell-> import Distribution.Simple-> main = defaultMain+#!/usr/bin/env runhaskell +> import Distribution.Simple +> main = defaultMain
email-validate.cabal view
@@ -1,59 +1,59 @@-name: email-validate-version: 2.3.2.15-license: BSD3-license-file: LICENSE-author: George Pollard <porges@porg.es>-maintainer: George Pollard <porges@porg.es>-homepage: https://github.com/Porges/email-validate-hs-category: Text-synopsis: Email address validation-description: Validating an email address string against RFC 5322-build-type: Simple-stability: experimental-cabal-version: >= 1.10--source-repository head- type: git- location: git://github.com/Porges/email-validate-hs.git--source-repository this- type: git- location: git://github.com/Porges/email-validate-hs.git- tag: v2.3.2.15--library- build-depends:- base >= 4.4 && < 5,- attoparsec >= 0.10.0 && < 0.15,- bytestring >= 0.9 && < 0.12,- template-haskell >= 2.10.0.0 && < 2.18- default-language: Haskell2010- hs-source-dirs: src- ghc-options: -Wall- exposed-modules:- Text.Email.QuasiQuotation,- Text.Email.Validate,- Text.Email.Parser--test-suite Main- type: exitcode-stdio-1.0- main-is: Main.hs- ghc-options: -threaded- hs-source-dirs: tests- default-language: Haskell2010- build-depends:- email-validate,- base >= 4 && < 5,- hspec >= 2.2.3 && < 2.9,- QuickCheck >= 2.4 && < 2.15,- bytestring >= 0.9 && < 0.12--test-suite doctests- type: exitcode-stdio-1.0- ghc-options: -threaded- default-language: Haskell2010- hs-source-dirs: tests- main-is: doctests.hs- build-depends:- base >= 4 && < 5,- doctest >= 0.8 && < 0.19+name: email-validate +version: 2.3.2.16 +license: BSD3 +license-file: LICENSE +author: George Pollard <porges@porg.es> +maintainer: George Pollard <porges@porg.es> +homepage: https://github.com/Porges/email-validate-hs +category: Text +synopsis: Email address validation +description: Validating an email address string against RFC 5322 +build-type: Simple +stability: experimental +cabal-version: >= 1.10 + +source-repository head + type: git + location: git://github.com/Porges/email-validate-hs.git + +source-repository this + type: git + location: git://github.com/Porges/email-validate-hs.git + tag: v2.3.2.16 + +library + build-depends: + base >= 4.4 && < 5, + attoparsec >= 0.10.0 && < 0.15, + bytestring >= 0.9 && < 0.12, + template-haskell >= 2.10.0.0 && < 2.19 + default-language: Haskell2010 + hs-source-dirs: src + ghc-options: -Wall + exposed-modules: + Text.Email.QuasiQuotation, + Text.Email.Validate, + Text.Email.Parser + +test-suite Main + type: exitcode-stdio-1.0 + main-is: Main.hs + ghc-options: -threaded + hs-source-dirs: tests + default-language: Haskell2010 + build-depends: + email-validate, + base >= 4 && < 5, + hspec >= 2.2.3 && < 2.10, + QuickCheck >= 2.4 && < 2.15, + bytestring >= 0.9 && < 0.12 + +test-suite doctests + type: exitcode-stdio-1.0 + ghc-options: -threaded + default-language: Haskell2010 + hs-source-dirs: tests + main-is: doctests.hs + build-depends: + base >= 4 && < 5, + doctest >= 0.8 && < 0.20
src/Text/Email/Parser.hs view
@@ -1,196 +1,196 @@-{-# LANGUAGE DeriveDataTypeable, DeriveGeneric #-}--module Text.Email.Parser- ( addrSpec- , localPart- , domainPart- , EmailAddress- , unsafeEmailAddress- , toByteString- )-where--import Control.Applicative-import Control.Monad (guard, void, when)-import Data.Attoparsec.ByteString.Char8-import Data.ByteString (ByteString)-import qualified Data.ByteString.Char8 as BS-import Data.Data (Data, Typeable)-import GHC.Generics (Generic)-import qualified Text.Read as Read---- | Represents an email address.-data EmailAddress = EmailAddress ByteString ByteString- deriving (Eq, Ord, Data, Typeable, Generic)---- | Creates an email address without validating it.--- You should only use this when reading data from--- somewhere it has already been validated (e.g. a--- database).-unsafeEmailAddress :: ByteString -> ByteString -> EmailAddress-unsafeEmailAddress = EmailAddress--instance Show EmailAddress where- show = show . toByteString--instance Read EmailAddress where- readListPrec = Read.readListPrecDefault- readPrec = Read.parens (do- bs <- Read.readPrec- case parseOnly (addrSpec <* endOfInput) bs of- Left _ -> Read.pfail- Right a -> return a)---- | Converts an email address back to a ByteString-toByteString :: EmailAddress -> ByteString-toByteString (EmailAddress l d) = BS.concat [l, BS.singleton '@', d]---- | Extracts the local part of an email address.-localPart :: EmailAddress -> ByteString-localPart (EmailAddress l _) = l---- | Extracts the domain part of an email address.-domainPart :: EmailAddress -> ByteString-domainPart (EmailAddress _ d) = d---- | A parser for email addresses.-addrSpec :: Parser EmailAddress-addrSpec = do- l <- local-- -- Maximum length of local-part is 64, per RFC3696- when (BS.length l > 64) (fail "local-part of email is too long (more than 64 octets)")-- _ <- char '@' <?> "at sign"- d <- domain-- -- Maximum length is 254, per Erratum 1690 on RFC3696- when (BS.length l + BS.length d + 1 > 254) (fail "email address is too long (more than 254 octets)")-- return (unsafeEmailAddress l d)--local :: Parser ByteString-local = dottedAtoms--domain :: Parser ByteString-domain = domainName <|> domainLiteral--domainName :: Parser ByteString-domainName = do- parsedDomain <- BS.intercalate (BS.singleton '.') <$>- domainLabel `sepBy1` char '.' <* optional (char '.')-- -- Domain name must be no greater than 253 chars, per RFC1035- guard (BS.length parsedDomain <= 253)- return parsedDomain--domainLabel :: Parser ByteString-domainLabel = do- content <- between1 (optional cfws) (fst <$> match (alphaNum >> skipWhile isAlphaNumHyphen))-- -- Per RFC1035:- -- label must be no greater than 63 chars and cannot end with '-'- -- (we already enforced that it does not start with '-')- guard (BS.length content <= 63 && BS.last content /= '-')- return content--alphaNum :: Parser Char-alphaNum = satisfy isAlphaNum--isAlphaNumHyphen :: Char -> Bool-isAlphaNumHyphen x = isDigit x || isAlpha_ascii x || x == '-'--dottedAtoms :: Parser ByteString-dottedAtoms = BS.intercalate (BS.singleton '.') <$>- between1 (optional cfws)- (atom <|> quotedString) `sepBy1` char '.'--atom :: Parser ByteString-atom = takeWhile1 isAtomText--isAtomText :: Char -> Bool-isAtomText x = isAlphaNum x || inClass "!#$%&'*+/=?^_`{|}~-" x--domainLiteral :: Parser ByteString-domainLiteral =- (BS.cons '[' . flip BS.snoc ']' . BS.concat) <$>- between (optional cfws *> char '[') (char ']' <* optional cfws)- (many (optional fws >> takeWhile1 isDomainText) <* optional fws)--isDomainText :: Char -> Bool-isDomainText x = inClass "\33-\90\94-\126" x || isObsNoWsCtl x--quotedString :: Parser ByteString-quotedString =- (BS.cons '"' . flip BS.snoc '"' . BS.concat) <$>- between1 (char '"')- (many (optional fws >> quotedContent) <* optional fws)--quotedContent :: Parser ByteString-quotedContent = takeWhile1 isQuotedText <|> quotedPair--isQuotedText :: Char -> Bool-isQuotedText x = inClass "\33\35-\91\93-\126" x || isObsNoWsCtl x--quotedPair :: Parser ByteString-quotedPair = (BS.cons '\\' . BS.singleton) <$> (char '\\' *> (vchar <|> wsp <|> lf <|> cr <|> obsNoWsCtl <|> nullChar))--cfws :: Parser ()-cfws = skipMany (comment <|> fws)--fws :: Parser ()-fws = void (wsp1 >> optional (crlf >> wsp1)) <|> (skipMany1 (crlf >> wsp1))--between :: Applicative f => f l -> f r -> f a -> f a-between l r x = l *> x <* r--between1 :: Applicative f => f lr -> f a -> f a-between1 lr x = lr *> x <* lr--comment :: Parser ()-comment = between (char '(') (char ')') $ skipMany (void commentContent <|> fws)--commentContent :: Parser ()-commentContent = skipWhile1 isCommentText <|> void quotedPair <|> comment--isCommentText :: Char -> Bool-isCommentText x = inClass "\33-\39\42-\91\93-\126" x || isObsNoWsCtl x--nullChar :: Parser Char-nullChar = char '\0'--skipWhile1 :: (Char -> Bool) -> Parser()-skipWhile1 x = satisfy x >> skipWhile x--wsp1 :: Parser ()-wsp1 = skipWhile1 isWsp--wsp :: Parser Char-wsp = satisfy isWsp--isWsp :: Char -> Bool-isWsp x = x == ' ' || x == '\t'--isAlphaNum :: Char -> Bool-isAlphaNum x = isDigit x || isAlpha_ascii x--cr :: Parser Char-cr = char '\r'--lf :: Parser Char-lf = char '\n'--crlf :: Parser ()-crlf = void $ cr >> lf--isVchar :: Char -> Bool-isVchar = inClass "\x21-\x7e"--vchar :: Parser Char-vchar = satisfy isVchar--isObsNoWsCtl :: Char -> Bool-isObsNoWsCtl = inClass "\1-\8\11-\12\14-\31\127"--obsNoWsCtl :: Parser Char-obsNoWsCtl = satisfy isObsNoWsCtl+{-# LANGUAGE DeriveDataTypeable, DeriveGeneric #-} + +module Text.Email.Parser + ( addrSpec + , localPart + , domainPart + , EmailAddress + , unsafeEmailAddress + , toByteString + ) +where + +import Control.Applicative +import Control.Monad (guard, void, when) +import Data.Attoparsec.ByteString.Char8 +import Data.ByteString (ByteString) +import qualified Data.ByteString.Char8 as BS +import Data.Data (Data, Typeable) +import GHC.Generics (Generic) +import qualified Text.Read as Read + +-- | Represents an email address. +data EmailAddress = EmailAddress ByteString ByteString + deriving (Eq, Ord, Data, Typeable, Generic) + +-- | Creates an email address without validating it. +-- You should only use this when reading data from +-- somewhere it has already been validated (e.g. a +-- database). +unsafeEmailAddress :: ByteString -> ByteString -> EmailAddress +unsafeEmailAddress = EmailAddress + +instance Show EmailAddress where + show = show . toByteString + +instance Read EmailAddress where + readListPrec = Read.readListPrecDefault + readPrec = Read.parens (do + bs <- Read.readPrec + case parseOnly (addrSpec <* endOfInput) bs of + Left _ -> Read.pfail + Right a -> return a) + +-- | Converts an email address back to a ByteString +toByteString :: EmailAddress -> ByteString +toByteString (EmailAddress l d) = BS.concat [l, BS.singleton '@', d] + +-- | Extracts the local part of an email address. +localPart :: EmailAddress -> ByteString +localPart (EmailAddress l _) = l + +-- | Extracts the domain part of an email address. +domainPart :: EmailAddress -> ByteString +domainPart (EmailAddress _ d) = d + +-- | A parser for email addresses. +addrSpec :: Parser EmailAddress +addrSpec = do + l <- local + + -- Maximum length of local-part is 64, per RFC3696 + when (BS.length l > 64) (fail "local-part of email is too long (more than 64 octets)") + + _ <- char '@' <?> "at sign" + d <- domain + + -- Maximum length is 254, per Erratum 1690 on RFC3696 + when (BS.length l + BS.length d + 1 > 254) (fail "email address is too long (more than 254 octets)") + + return (unsafeEmailAddress l d) + +local :: Parser ByteString +local = dottedAtoms + +domain :: Parser ByteString +domain = domainName <|> domainLiteral + +domainName :: Parser ByteString +domainName = do + parsedDomain <- BS.intercalate (BS.singleton '.') <$> + domainLabel `sepBy1` char '.' <* optional (char '.') + + -- Domain name must be no greater than 253 chars, per RFC1035 + guard (BS.length parsedDomain <= 253) + return parsedDomain + +domainLabel :: Parser ByteString +domainLabel = do + content <- between1 (optional cfws) (fst <$> match (alphaNum >> skipWhile isAlphaNumHyphen)) + + -- Per RFC1035: + -- label must be no greater than 63 chars and cannot end with '-' + -- (we already enforced that it does not start with '-') + guard (BS.length content <= 63 && BS.last content /= '-') + return content + +alphaNum :: Parser Char +alphaNum = satisfy isAlphaNum + +isAlphaNumHyphen :: Char -> Bool +isAlphaNumHyphen x = isDigit x || isAlpha_ascii x || x == '-' + +dottedAtoms :: Parser ByteString +dottedAtoms = BS.intercalate (BS.singleton '.') <$> + between1 (optional cfws) + (atom <|> quotedString) `sepBy1` char '.' + +atom :: Parser ByteString +atom = takeWhile1 isAtomText + +isAtomText :: Char -> Bool +isAtomText x = isAlphaNum x || inClass "!#$%&'*+/=?^_`{|}~-" x + +domainLiteral :: Parser ByteString +domainLiteral = + (BS.cons '[' . flip BS.snoc ']' . BS.concat) <$> + between (optional cfws *> char '[') (char ']' <* optional cfws) + (many (optional fws >> takeWhile1 isDomainText) <* optional fws) + +isDomainText :: Char -> Bool +isDomainText x = inClass "\33-\90\94-\126" x || isObsNoWsCtl x + +quotedString :: Parser ByteString +quotedString = + (BS.cons '"' . flip BS.snoc '"' . BS.concat) <$> + between1 (char '"') + (many (optional fws >> quotedContent) <* optional fws) + +quotedContent :: Parser ByteString +quotedContent = takeWhile1 isQuotedText <|> quotedPair + +isQuotedText :: Char -> Bool +isQuotedText x = inClass "\33\35-\91\93-\126" x || isObsNoWsCtl x + +quotedPair :: Parser ByteString +quotedPair = (BS.cons '\\' . BS.singleton) <$> (char '\\' *> (vchar <|> wsp <|> lf <|> cr <|> obsNoWsCtl <|> nullChar)) + +cfws :: Parser () +cfws = skipMany (comment <|> fws) + +fws :: Parser () +fws = void (wsp1 >> optional (crlf >> wsp1)) <|> (skipMany1 (crlf >> wsp1)) + +between :: Applicative f => f l -> f r -> f a -> f a +between l r x = l *> x <* r + +between1 :: Applicative f => f lr -> f a -> f a +between1 lr x = lr *> x <* lr + +comment :: Parser () +comment = between (char '(') (char ')') $ skipMany (void commentContent <|> fws) + +commentContent :: Parser () +commentContent = skipWhile1 isCommentText <|> void quotedPair <|> comment + +isCommentText :: Char -> Bool +isCommentText x = inClass "\33-\39\42-\91\93-\126" x || isObsNoWsCtl x + +nullChar :: Parser Char +nullChar = char '\0' + +skipWhile1 :: (Char -> Bool) -> Parser() +skipWhile1 x = satisfy x >> skipWhile x + +wsp1 :: Parser () +wsp1 = skipWhile1 isWsp + +wsp :: Parser Char +wsp = satisfy isWsp + +isWsp :: Char -> Bool +isWsp x = x == ' ' || x == '\t' + +isAlphaNum :: Char -> Bool +isAlphaNum x = isDigit x || isAlpha_ascii x + +cr :: Parser Char +cr = char '\r' + +lf :: Parser Char +lf = char '\n' + +crlf :: Parser () +crlf = void $ cr >> lf + +isVchar :: Char -> Bool +isVchar = inClass "\x21-\x7e" + +vchar :: Parser Char +vchar = satisfy isVchar + +isObsNoWsCtl :: Char -> Bool +isObsNoWsCtl = inClass "\1-\8\11-\12\14-\31\127" + +obsNoWsCtl :: Parser Char +obsNoWsCtl = satisfy isObsNoWsCtl
src/Text/Email/QuasiQuotation.hs view
@@ -1,42 +1,42 @@-{-# LANGUAGE CPP #-}-#if __GLASGOW_HASKELL__ >= 800-{-# LANGUAGE TemplateHaskellQuotes #-}-#else-{-# LANGUAGE TemplateHaskell #-}-#endif--module Text.Email.QuasiQuotation- ( email- ) where--import qualified Data.ByteString.Char8 as BS8--import Language.Haskell.TH.Quote (QuasiQuoter(..))--import Text.Email.Validate (validate, localPart, domainPart, unsafeEmailAddress)---- | A QuasiQuoter for email addresses. ------ Use it like this:--- --- >>> :set -XQuasiQuotes--- >>> [email|someone@example.com|]--- "someone@example.com"-email :: QuasiQuoter-email = QuasiQuoter- { quoteExp = quoteEmail emailToExp- , quotePat = error "email is not supported as a pattern"- , quoteDec = error "email is not supported at top-level"- , quoteType = error "email is not supported as a type"- }- where-- quoteEmail p s = - case validate (BS8.pack s) of - Left err -> error ("Invalid quasi-quoted email address: " ++ err) - Right e -> p e-- emailToExp e = - let lp = BS8.unpack (localPart e) in- let dp = BS8.unpack (domainPart e) in- [| unsafeEmailAddress (BS8.pack lp) (BS8.pack dp) |]+{-# LANGUAGE CPP #-} +#if __GLASGOW_HASKELL__ >= 800 +{-# LANGUAGE TemplateHaskellQuotes #-} +#else +{-# LANGUAGE TemplateHaskell #-} +#endif + +module Text.Email.QuasiQuotation + ( email + ) where + +import qualified Data.ByteString.Char8 as BS8 + +import Language.Haskell.TH.Quote (QuasiQuoter(..)) + +import Text.Email.Validate (validate, localPart, domainPart, unsafeEmailAddress) + +-- | A QuasiQuoter for email addresses. +-- +-- Use it like this: +-- +-- >>> :set -XQuasiQuotes +-- >>> [email|someone@example.com|] +-- "someone@example.com" +email :: QuasiQuoter +email = QuasiQuoter + { quoteExp = quoteEmail emailToExp + , quotePat = error "email is not supported as a pattern" + , quoteDec = error "email is not supported at top-level" + , quoteType = error "email is not supported as a type" + } + where + + quoteEmail p s = + case validate (BS8.pack s) of + Left err -> error ("Invalid quasi-quoted email address: " ++ err) + Right e -> p e + + emailToExp e = + let lp = BS8.unpack (localPart e) in + let dp = BS8.unpack (domainPart e) in + [| unsafeEmailAddress (BS8.pack lp) (BS8.pack dp) |]
src/Text/Email/Validate.hs view
@@ -1,63 +1,63 @@-module Text.Email.Validate- ( isValid- , validate- , emailAddress- , canonicalizeEmail-- -- Re-exports:- , EmailAddress- , domainPart- , localPart- , toByteString- , unsafeEmailAddress- )-where--import Data.Attoparsec.ByteString (endOfInput, parseOnly)-import Data.ByteString (ByteString)--import Text.Email.Parser- ( EmailAddress- , addrSpec- , domainPart- , localPart- , toByteString- , unsafeEmailAddress)---- $setup--- This is required for all examples:------ >>> :set -XOverloadedStrings---- | Smart constructor for an email address-emailAddress :: ByteString -> Maybe EmailAddress-emailAddress = either (const Nothing) Just . validate---- | Checks that an email is valid and returns a version of it--- where comments and whitespace have been removed.------ Example:------ >>> canonicalizeEmail "spaces. are. allowed@example.com"--- Just "spaces.are.allowed@example.com"-canonicalizeEmail :: ByteString -> Maybe ByteString-canonicalizeEmail = fmap toByteString . emailAddress---- | Validates whether a particular string is an email address--- according to RFC5322.-isValid :: ByteString -> Bool-isValid = either (const False) (const True) . validate---- | If you want to find out *why* a particular string is not--- an email address, use this.------ Examples:------ >>> validate "example@example.com"--- Right "example@example.com"------ >>> validate "not.good"--- Left "at sign > @: not enough input"-validate :: ByteString -> Either String EmailAddress-validate = parseOnly (addrSpec >>= \r -> endOfInput >> return r)-+module Text.Email.Validate + ( isValid + , validate + , emailAddress + , canonicalizeEmail + + -- Re-exports: + , EmailAddress + , domainPart + , localPart + , toByteString + , unsafeEmailAddress + ) +where + +import Data.Attoparsec.ByteString (endOfInput, parseOnly) +import Data.ByteString (ByteString) + +import Text.Email.Parser + ( EmailAddress + , addrSpec + , domainPart + , localPart + , toByteString + , unsafeEmailAddress) + +-- $setup +-- This is required for all examples: +-- +-- >>> :set -XOverloadedStrings + +-- | Smart constructor for an email address +emailAddress :: ByteString -> Maybe EmailAddress +emailAddress = either (const Nothing) Just . validate + +-- | Checks that an email is valid and returns a version of it +-- where comments and whitespace have been removed. +-- +-- Example: +-- +-- >>> canonicalizeEmail "spaces. are. allowed@example.com" +-- Just "spaces.are.allowed@example.com" +canonicalizeEmail :: ByteString -> Maybe ByteString +canonicalizeEmail = fmap toByteString . emailAddress + +-- | Validates whether a particular string is an email address +-- according to RFC5322. +isValid :: ByteString -> Bool +isValid = either (const False) (const True) . validate + +-- | If you want to find out *why* a particular string is not +-- an email address, use this. +-- +-- Examples: +-- +-- >>> validate "example@example.com" +-- Right "example@example.com" +-- +-- >>> validate "not.good" +-- Left "at sign > @: not enough input" +validate :: ByteString -> Either String EmailAddress +validate = parseOnly (addrSpec >>= \r -> endOfInput >> return r) +
tests/Main.hs view
@@ -1,400 +1,400 @@-{-# LANGUAGE NamedFieldPuns #-}-{-# LANGUAGE QuasiQuotes #-}-{-# LANGUAGE OverloadedStrings #-}--module Main where--import Control.Exception (evaluate)-import Control.Monad (forM_)-import Data.ByteString (ByteString)-import qualified Data.ByteString.Char8 as BS-import Data.List (isInfixOf)-import Data.Maybe (Maybe(..), isNothing, fromJust)-import Data.Monoid ((<>))--import Test.Hspec (hspec, context, describe, errorCall, it, parallel, shouldBe, shouldSatisfy)-import Test.QuickCheck (Arbitrary(..), suchThat, property)--import Text.Email.QuasiQuotation (email)-import Text.Email.Validate- ( EmailAddress- , canonicalizeEmail- , domainPart- , emailAddress- , localPart- , isValid- , toByteString- , validate- , unsafeEmailAddress- )--main :: IO ()-main = hspec $ parallel $ do-- showAndRead- canonicalization- exampleTests- specificFailures- simpleAccessors- quasiQuotationTests--canonicalization =- describe "emailAddress" $ do- it "is idempotent" $- property prop_doubleCanonicalize--exampleTests =- describe "Examples" $ do- forM_ examples $ \Example{example, exampleValid, exampleWhy, errorContains} -> do- context (show example ++ (if null exampleWhy then "" else " (" ++ exampleWhy ++ ")")) $ do- if exampleValid- then do- it "should be valid" $ - isValid example `shouldBe` True-- it "passes double-canonicalization test" $- prop_doubleCanonicalize (fromJust (emailAddress example))-- else do- it "should be invalid" $- isValid example `shouldBe` False-- case (errorContains, validate example) of- (Just err, Left errMessage) ->- it "should have correct error message" $- errMessage `shouldSatisfy` (err `isInfixOf`)- (_, _) -> return ()--showAndRead =- describe "show/read instances" $ do-- it "can roundtrip" $- property prop_showAndReadBack-- it "shows in the same way as ByteString" $- property prop_showLikeByteString-- it "should fail if read back without a quote" $- property prop_showAndReadBackWithoutQuoteFails--specificFailures = do- describe "GitHub issue #12" $ do- it "is fixed" $- let (Right em) = validate (BS.pack "\"\"@1") in- em `shouldBe` read (show em)-- describe "Trailing dot" $ do- it "is canonicalized" $ - canonicalizeEmail "foo@bar.com." `shouldBe` Just "foo@bar.com"--simpleAccessors = do- describe "localPart" $- it "extracts local part" $- localPart (unsafeEmailAddress "local" undefined) `shouldBe` "local"--- describe "domainPart" $- it "extracts domain part" $- domainPart (unsafeEmailAddress undefined "domain") `shouldBe` "domain"--quasiQuotationTests =- describe "QuasiQuoter" $ do- it "works as expected" $- [email|local@domain.com|] `shouldBe` unsafeEmailAddress "local" "domain.com"--instance Arbitrary ByteString where- arbitrary = fmap BS.pack arbitrary--instance Arbitrary EmailAddress where- arbitrary = do- local <- suchThat arbitrary (\l -> isEmail l (BS.pack "example.com"))- domain <- suchThat arbitrary (\d -> isEmail (BS.pack "example") d)- let (Just result) = emailAddress (makeEmailLike local domain)- pure result-- where- isEmail l d = isValid (makeEmailLike l d)- makeEmailLike l d = BS.concat [l, BS.singleton '@', d]--{- Properties -}--prop_doubleCanonicalize :: EmailAddress -> Bool-prop_doubleCanonicalize email = Just email == emailAddress (toByteString email)--prop_showLikeByteString :: EmailAddress -> Bool-prop_showLikeByteString email = show (toByteString email) == show email--prop_showAndReadBack :: EmailAddress -> Bool-prop_showAndReadBack email = read (show email) == email--prop_showAndReadBackWithoutQuoteFails :: EmailAddress -> Bool-prop_showAndReadBackWithoutQuoteFails email =- isNothing (readMaybe (init s)) && isNothing (readMaybe (tail s))- where- s = show email- readMaybe :: String -> Maybe EmailAddress- readMaybe s = case reads s of- [(x, "")] -> Just x- _ -> Nothing--{- Examples -}--data Example = Example- { example :: ByteString- , exampleValid :: Bool- , exampleWhy :: String- , errorContains :: Maybe String }--valid, invalid :: ByteString -> Example-valid e = Example e True "" Nothing-invalid e = Example e False "" Nothing--why :: Example -> String -> Example-why ex str = ex { exampleWhy = str }--errorShouldContain :: Example -> String -> Example-errorShouldContain ex str = ex { errorContains = Just str }---examples :: [Example]-examples =- let domain249 = BS.intercalate "." (take 25 (repeat (BS.replicate 9 'x'))) in- [ valid "first.last@example.com"- , valid "first.last@example.com." `why` "Dot allowed on end of domain"- , invalid "local@exam_ple.com" `why` "Underscore not permitted in domain"- , valid "1234567890123456789012345678901234567890123456789012345678901234@example.com"- , valid "\"first last\"@example.com" `why` "Contains quoted spaces"- , valid "\"first\\\"last\"@example.com" `why` "Contains quoted escaped quote"- , invalid "first\\@last@example.com" `why` "Escaping can only happen within a quoted string"- , valid "\"first@last\"@example.com" `why` "Contains quoted at-sign"- , valid "\"first\\\\last\"@example.com" `why` "Contains quoted escaped backslash"- , valid ("1234@" <> domain249)- `why` "Maximum length is 254, this is 254 exactly"- , valid ("1234@" <> domain249 <> ".")- `why` "Trailing dot doesn't increase length"- , invalid ("12345@" <> domain249)- `why` "Maximum length is 254, this is 255"- `errorShouldContain` "too long"- , valid "first.last@[12.34.56.78]" `why` "IP address"- , valid "first.last@[IPv6:::12.34.56.78]" `why` "IPv6 address"- , valid "first.last@[IPv6:1111:2222:3333::4444:12.34.56.78]"- , valid "first.last@[IPv6:1111:2222:3333:4444:5555:6666:12.34.56.78]"- , valid "first.last@[IPv6:::1111:2222:3333:4444:5555:6666]"- , valid "first.last@[IPv6:1111:2222:3333::4444:5555:6666]"- , valid "first.last@[IPv6:1111:2222:3333:4444:5555:6666::]"- , valid "first.last@[IPv6:1111:2222:3333:4444:5555:6666:7777:8888]"- , valid "first.last@x23456789012345678901234567890123456789012345678901234567890123.example.com"- , valid "first.last@1xample.com"- , valid "first.last@123.example.com"- , invalid "first.last" `why` "no at sign" `errorShouldContain` "at sign"- , invalid ".first.last@example.com" `why` "Local part starts with a dot"- , invalid "first.last.@example.com" `why` "Local part ends with a dot"- , invalid "first..last@example.com" `why` "Local part has consecutive dots"- , invalid "\"first\"last\"@example.com" `why` "Local part contains unescaped excluded characters"- , valid "\"first\\last\"@example.com" `why` "Any character can be escaped in a quoted string"- , invalid "\"\"\"@example.com" `why` "Local part contains unescaped excluded characters"- , invalid "\"\\\"@example.com" `why` "Local part cannot end with a backslash"- , invalid "first\\\\@last@example.com" `why` "Local part contains unescaped excluded characters"- , invalid "first.last@" `why` "No domain"- , valid "\"Abc\\@def\"@example.com"- , valid "\"Fred\\ Bloggs\"@example.com"- , valid "\"Joe.\\\\Blow\"@example.com"- , valid "\"Abc@def\"@example.com"- , valid "\"Fred Bloggs\"@example.com"- , valid "user+mailbox@example.com"- , valid "customer/department=shipping@example.com"- , valid "$A12345@example.com"- , valid "!def!xyz%abc@example.com"- , valid "_somename@example.com"- , valid "dclo@us.ibm.com"- , invalid "abc\\@def@example.com" `why` "This example from RFC3696 was corrected in an erratum"- , invalid "abc\\\\@example.com" `why` "This example from RFC3696 was corrected in an erratum"- , valid "peter.piper@example.com"- , invalid "Doug\\ \\\"Ace\\\"\\ Lovell@example.com" `why` "Escaping can only happen in a quoted string"- , valid "\"Doug \\\"Ace\\\" L.\"@example.com"- , invalid "abc@def@example.com" `why` "Doug Lovell says this should fail"- , invalid "abc\\\\@def@example.com" `why` "Doug Lovell says this should fail"- , invalid "abc\\@example.com" `why` "Doug Lovell says this should fail"- , invalid "@example.com" `why` "no local part"- , invalid "doug@" `why` "no domain part"- , invalid "\"qu@example.com" `why` "Doug Lovell says this should fail"- , invalid "ote\"@example.com" `why` "Doug Lovell says this should fail"- , invalid ".dot@example.com" `why` "Doug Lovell says this should fail"- , invalid "dot.@example.com" `why` "Doug Lovell says this should fail"- , invalid "two..dot@example.com" `why` "Doug Lovell says this should fail"- , invalid "\"Doug \"Ace\" L.\"@example.com" `why` "Doug Lovell says this should fail"- , invalid "Doug\\ \\\"Ace\\\"\\ L\\.@example.com" `why` "Doug Lovell says this should fail"- , invalid "hello world@example.com" `why` "Doug Lovell says this should fail"- , valid "gatsby@f.sc.ot.t.f.i.tzg.era.l.d."- , valid "test@example.com"- , valid "TEST@example.com"- , valid "1234567890@example.com"- , valid "test+test@example.com"- , valid "test-test@example.com"- , valid "t*est@example.com"- , valid "+1~1+@example.com"- , valid "{_test_}@example.com"- , valid "\"[[ test ]]\"@example.com"- , valid "test.test@example.com"- , valid "\"test.test\"@example.com"- , valid "test.\"test\"@example.com" `why` "Obsolete form, but documented in RFC2822"- , valid "\"test@test\"@example.com"- , valid "test@123.123.123.x123"- , valid "test@[123.123.123.123]"- , valid "test@example.example.com"- , valid "test@example.example.example.com"- , invalid "test.example.com"- , invalid "test.@example.com"- , invalid "test..test@example.com"- , invalid ".test@example.com"- , invalid "test@test@example.com"- , invalid "test@@example.com"- , invalid "-- test --@example.com" `why` "No spaces allowed in local part"- , invalid "[test]@example.com" `why` "Square brackets only allowed within quotes"- , valid "\"test\\test\"@example.com" `why` "Any character can be escaped in a quoted string"- , invalid "\"test\"test\"@example.com" `why` "Quotes cannot be nested"- , invalid "()[]\\;:,><@example.com" `why` "Disallowed Characters"- , invalid "test@." `why` "Dave Child says so"- , valid "test@example."- , invalid "test@.org" `why` "Dave Child says so"- , invalid "test@[123.123.123.123" `why` "Dave Child says so"- , invalid "test@123.123.123.123]" `why` "Dave Child says so"- , invalid "NotAnEmail" `why` "Phil Haack says so"- , invalid "@NotAnEmail" `why` "Phil Haack says so"- , valid "\"test\\\\blah\"@example.com"- , valid "\"test\\blah\"@example.com" `why` "Any character can be escaped in a quoted string"- , valid "\"test\\\rblah\"@example.com" `why` "Quoted string specifically excludes carriage returns unless escaped"- , invalid "\"test\rblah\"@example.com" `why` "Quoted string specifically excludes carriage returns"- , valid "\"test\\\"blah\"@example.com"- , invalid "\"test\"blah\"@example.com" `why` "Phil Haack says so"- , valid "customer/department@example.com"- , valid "_Yosemite.Sam@example.com"- , valid "~@example.com"- , invalid ".wooly@example.com" `why` "Phil Haack says so"- , invalid "wo..oly@example.com" `why` "Phil Haack says so"- , invalid "pootietang.@example.com" `why` "Phil Haack says so"- , invalid ".@example.com" `why` "Phil Haack says so"- , valid "\"Austin@Powers\"@example.com"- , valid "Ima.Fool@example.com"- , valid "\"Ima.Fool\"@example.com"- , valid "\"Ima Fool\"@example.com"- , invalid "Ima Fool@example.com" `why` "Phil Haack says so"- , invalid "phil.h\\@\\@ck@haacked.com" `why` "Escaping can only happen in a quoted string"- , valid "\"first\".\"last\"@example.com"- , valid "\"first\".middle.\"last\"@example.com"- , invalid "\"first\\\\\"last\"@example.com" `why` "Contains an unescaped quote"- , valid "\"first\".last@example.com" `why` "obs-local-part form as described in RFC 2822"- , valid "first.\"last\"@example.com" `why` "obs-local-part form as described in RFC 2822"- , valid "\"first\".\"middle\".\"last\"@example.com" `why` "obs-local-part form as described in RFC 2822"- , valid "\"first.middle\".\"last\"@example.com" `why` "obs-local-part form as described in RFC 2822"- , valid "\"first.middle.last\"@example.com" `why` "obs-local-part form as described in RFC 2822"- , valid "\"first..last\"@example.com" `why` "obs-local-part form as described in RFC 2822"- , invalid "foo@[\\1.2.3.4]" `why` "RFC 5321 specifies the syntax for address-literal and does not allow escaping"- , valid "\"first\\\\\\\"last\"@example.com"- , valid "first.\"mid\\dle\".\"last\"@example.com" `why` "Backslash can escape anything but must escape something"- , valid "Test.\r\n Folding.\r\n Whitespace@example.com"- , invalid "first\\last@example.com" `why` "Unquoted string must be an atom"- , invalid "Abc\\@def@example.com" `why` "Was incorrectly given as a valid address in the original RFC3696"- , invalid "Fred\\ Bloggs@example.com" `why` "Was incorrectly given as a valid address in the original RFC3696"- , invalid "Joe.\\\\Blow@example.com" `why` "Was incorrectly given as a valid address in the original RFC3696"- , invalid "\"test\\\r\n blah\"@example.com" `why` "Folding white space can\'t appear within a quoted pair"- , valid "\"test\r\n blah\"@example.com" `why` "This is a valid quoted string with folding white space"- , invalid "{^c\\@**Dog^}@cartoon.com" `why` "This is a throwaway example from Doug Lovell\'s article. Actually it\'s not a valid address."- , valid "(foo)cal(bar)@(baz)iamcal.com(quux)" `why` "A valid address containing comments"- , valid "cal@iamcal(woo).(yay)com" `why` "A valid address containing comments"- , valid "cal(woo(yay)hoopla)@iamcal.com" `why` "A valid address containing comments"- , valid "cal(foo\\@bar)@iamcal.com" `why` "A valid address containing comments"- , valid "cal(foo\\)bar)@iamcal.com" `why` "A valid address containing comments and an escaped parenthesis"- , invalid "cal(foo(bar)@iamcal.com" `why` "Unclosed parenthesis in comment"- , invalid "cal(foo)bar)@iamcal.com" `why` "Too many closing parentheses"- , invalid "cal(foo\\)@iamcal.com" `why` "Backslash at end of comment has nothing to escape"- , valid "first().last@example.com" `why` "A valid address containing an empty comment"- , valid "first.(\r\n middle\r\n )last@example.com" `why` "Comment with folding white space"- , invalid "first(12345678901234567890123456789012345678901234567890)last@(1234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890)example.com" `why` "Too long with comments, not too long without"- , valid "first(Welcome to\r\n the (\"wonderful\" (!)) world\r\n of email)@example.com" `why` "Silly example from my blog post"- , valid "pete(his account)@silly.test(his host)" `why` "Canonical example from RFC5322"- , valid "c@(Chris\'s host.)public.example" `why` "Canonical example from RFC5322"- , valid "jdoe@machine(comment). example" `why` "Canonical example from RFC5322"- , valid "1234 @ local(blah) .machine .example" `why` "Canonical example from RFC5322"- , invalid "first(middle)last@example.com" `why` "Can\'t have a comment or white space except at an element boundary"- , valid "first(abc.def).last@example.com" `why` "Comment can contain a dot"- , valid "first(a\"bc.def).last@example.com" `why` "Comment can contain double quote"- , valid "first.(\")middle.last(\")@example.com" `why` "Comment can contain a quote"- , invalid "first(abc(\"def\".ghi).mno)middle(abc(\"def\".ghi).mno).last@(abc(\"def\".ghi).mno)example(abc(\"def\".ghi).mno).(abc(\"def\".ghi).mno)com(abc(\"def\".ghi).mno)" `why` "Can\'t have comments or white space except at an element boundary"- , valid "first(abc\\(def)@example.com" `why` "Comment can contain quoted-pair"- , valid "first.last@x(1234567890123456789012345678901234567890123456789012345678901234567890).com" `why` "Label is longer than 63 octets, but not with comment removed"- , valid "a(a(b(c)d(e(f))g)h(i)j)@example.com"- , invalid "a(a(b(c)d(e(f))g)(h(i)j)@example.com" `why` "Braces are not properly matched"- , valid "name.lastname@domain.com"- , invalid ".@"- , invalid "@bar.com"- , invalid "@@bar.com"- , valid "a@bar.com"- , invalid "aaa.com"- , invalid "aaa@.com"- , invalid "aaa@.123"- , valid "aaa@[123.123.123.123]"- , invalid "aaa@[123.123.123.123]a" `why` "extra data outside ip"- , valid "a@bar.com."- , valid "a-b@bar.com"- , valid "+@b.c" `why` "TLDs can be any length"- , valid "+@b.com"- , invalid "-@..com"- , invalid "-@a..com"- , valid "a@b.co-foo.uk"- , valid "\"hello my name is\"@stutter.com"- , valid "\"Test \\\"Fail\\\" Ing\"@example.com"- , valid "valid@special.museum"- , valid "shaitan@my-domain.thisisminekthx" `why` "Disagree with Paul Gregg here"- , invalid "test@...........com" `why` "......"- , valid "\"Joe\\\\Blow\"@example.com"- , invalid "Invalid \\\n Folding \\\n Whitespace@example.com" `why` "This isn\'t FWS so Dominic Sayers says it\'s invalid"- , valid "HM2Kinsists@(that comments are allowed)this.is.ok"- , valid "user%uucp!path@somehost.edu"- , valid "\"first(last)\"@example.com"- , valid " \r\n (\r\n x \r\n ) \r\n first\r\n ( \r\n x\r\n ) \r\n .\r\n ( \r\n x) \r\n last \r\n ( x \r\n ) \r\n @example.com"- , valid "test.\r\n \r\n obs@syntax.com" `why` "obs-fws allows multiple lines"- , valid "test. \r\n \r\n obs@syntax.com" `why` "obs-fws allows multiple lines (test 2: space before break)"- , invalid "test.\r\n\r\n obs@syntax.com" `why` "obs-fws must have at least one WSP per line"- , valid "\"null \\\0\"@char.com" `why` "can have escaped null character"- , invalid "\"null \0\"@char.com" `why` "cannot have unescaped null character"- -- items below here are invalid according to other RFCs (or opinions)- --, invalid "\"\"@example.com" `why` "Local part is effectively empty"- --, invalid "foobar@192.168.0.1" `why` "ip need to be []"- --, invalid "first.last@[.12.34.56.78]" `why` "Only char that can precede IPv4 address is \':\'"- --, invalid "first.last@[12.34.56.789]" `why` "Can\'t be interpreted as IPv4 so IPv6 tag is missing"- --, invalid "first.last@[::12.34.56.78]" `why` "IPv6 tag is missing"- --, invalid "first.last@[IPv5:::12.34.56.78]" `why` "IPv6 tag is wrong"- --, invalid "first.last@[IPv6:1111:2222:3333::4444:5555:12.34.56.78]" `why` "Too many IPv6 groups (4 max)"- --, invalid "first.last@[IPv6:1111:2222:3333:4444:5555:12.34.56.78]" `why` "Not enough IPv6 groups"- --, invalid "first.last@[IPv6:1111:2222:3333:4444:5555:6666:7777:12.34.56.78]" `why` "Too many IPv6 groups (6 max)"- --, invalid "first.last@[IPv6:1111:2222:3333:4444:5555:6666:7777]" `why` "Not enough IPv6 groups"- --, invalid "first.last@[IPv6:1111:2222:3333:4444:5555:6666:7777:8888:9999]" `why` "Too many IPv6 groups (8 max)"- --, invalid "first.last@[IPv6:1111:2222::3333::4444:5555:6666]" `why` "Too many \'::\' (can be none or one)"- --, invalid "first.last@[IPv6:1111:2222:3333::4444:5555:6666:7777]" `why` "Too many IPv6 groups (6 max)"- --, invalid "first.last@[IPv6:1111:2222:333x::4444:5555]" `why` "x is not valid in an IPv6 address"- --, invalid "first.last@[IPv6:1111:2222:33333::4444:5555]" `why` "33333 is not a valid group in an IPv6 address"- --, invalid "first.last@example.123" `why` "TLD can\'t be all digits"- --, invalid "aaa@[123.123.123.333]" `why` "not a valid IP"- --, invalid "first.last@[IPv6:1111:2222:3333:4444:5555:6666:12.34.567.89]" `why` "IPv4 part contains an invalid octet"- , valid "a@b"- , valid "a@bar"- , invalid "invalid@special.museum-" `why` "domain can't end with hyphen"- , invalid "a@-b.com" `why` "domain can't start with hyphen"- , invalid "a@b-.com" `why` "domain label can't end with hyphen"- --, invalid "\"foo\"(yay)@(hoopla)[1.2.3.4]" `why` "Address literal can\'t be commented (RFC5321)"- --, invalid "first.\"\".last@example.com" `why` "Contains a zero-length element"- --, invalid "test@example" `why` "Dave Child says so"- , invalid (BS.replicate 65 'x' <> "@x") `why` "local-part longer than 64 octets" `errorShouldContain` "too long"- , invalid "x@x23456789.x23456789.x23456789.x23456789.x23456789.x23456789.x23456789.x23456789.x23456789.x23456789.x23456789.x23456789.x23456789.x23456789.x23456789.x23456789.x23456789.x23456789.x23456789.x23456789.x23456789.x23456789.x23456789.x23456789.x23456789.x23456" `why` "Domain exceeds 255 chars"- , invalid "test@123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012.com" `why` "255 characters is maximum length for domain. This is 256."- , invalid "123456789012345678901234567890123456789012345678901234567890@12345678901234567890123456789012345678901234567890123456789.12345678901234567890123456789012345678901234567890123456789.12345678901234567890123456789012345678901234567890123456789.1234.example.com" `why` "Entire address is longer than 254 characters (this is 257)"- , invalid "123456789012345678901234567890123456789012345678901234567890@12345678901234567890123456789012345678901234567890123456789.12345678901234567890123456789012345678901234567890123456789.12345678901234567890123456789012345678901234567890123456789.123.example.com" `why` "Entire address is longer than 254 characters (this is 256)"- , invalid "123456789012345678901234567890123456789012345678901234567890@12345678901234567890123456789012345678901234567890123456789.12345678901234567890123456789012345678901234567890123456789.12345678901234567890123456789012345678901234567890123456789.12.example.com" `why` "Entire address is longer than 254 characters (this is 255)"- , valid "123456789012345678901234567890123456789012345678901234567890@12345678901234567890123456789012345678901234567890123456789.12345678901234567890123456789012345678901234567890123456789.12345678901234567890123456789012345678901234567890123456789.1.example.com" `why` "Entire address is 254 characters"- --, invalid "test@123.123.123.123" `why` "Top Level Domain won\'t be all-numeric (see RFC3696 Section 2). I disagree with Dave Child on this one."- , invalid "first.last@x234567890123456789012345678901234567890123456789012345678901234.example.com" `why` "Label can\'t be longer than 63 octets"- --, invalid "first.last@com" `why` "Mail host must be second- or lower level"- , invalid "first.last@e.-xample.com" `why` "Label can\'t begin with a hyphen"- , invalid "first.last@exampl-.e.com" `why` "Label can\'t end with a hyphen"- ]+{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE OverloadedStrings #-} + +module Main where + +import Control.Exception (evaluate) +import Control.Monad (forM_) +import Data.ByteString (ByteString) +import qualified Data.ByteString.Char8 as BS +import Data.List (isInfixOf) +import Data.Maybe (Maybe(..), isNothing, fromJust) +import Data.Monoid ((<>)) + +import Test.Hspec (hspec, context, describe, errorCall, it, parallel, shouldBe, shouldSatisfy) +import Test.QuickCheck (Arbitrary(..), suchThat, property) + +import Text.Email.QuasiQuotation (email) +import Text.Email.Validate + ( EmailAddress + , canonicalizeEmail + , domainPart + , emailAddress + , localPart + , isValid + , toByteString + , validate + , unsafeEmailAddress + ) + +main :: IO () +main = hspec $ parallel $ do + + showAndRead + canonicalization + exampleTests + specificFailures + simpleAccessors + quasiQuotationTests + +canonicalization = + describe "emailAddress" $ do + it "is idempotent" $ + property prop_doubleCanonicalize + +exampleTests = + describe "Examples" $ do + forM_ examples $ \Example{example, exampleValid, exampleWhy, errorContains} -> do + context (show example ++ (if null exampleWhy then "" else " (" ++ exampleWhy ++ ")")) $ do + if exampleValid + then do + it "should be valid" $ + isValid example `shouldBe` True + + it "passes double-canonicalization test" $ + prop_doubleCanonicalize (fromJust (emailAddress example)) + + else do + it "should be invalid" $ + isValid example `shouldBe` False + + case (errorContains, validate example) of + (Just err, Left errMessage) -> + it "should have correct error message" $ + errMessage `shouldSatisfy` (err `isInfixOf`) + (_, _) -> return () + +showAndRead = + describe "show/read instances" $ do + + it "can roundtrip" $ + property prop_showAndReadBack + + it "shows in the same way as ByteString" $ + property prop_showLikeByteString + + it "should fail if read back without a quote" $ + property prop_showAndReadBackWithoutQuoteFails + +specificFailures = do + describe "GitHub issue #12" $ do + it "is fixed" $ + let (Right em) = validate (BS.pack "\"\"@1") in + em `shouldBe` read (show em) + + describe "Trailing dot" $ do + it "is canonicalized" $ + canonicalizeEmail "foo@bar.com." `shouldBe` Just "foo@bar.com" + +simpleAccessors = do + describe "localPart" $ + it "extracts local part" $ + localPart (unsafeEmailAddress "local" undefined) `shouldBe` "local" + + + describe "domainPart" $ + it "extracts domain part" $ + domainPart (unsafeEmailAddress undefined "domain") `shouldBe` "domain" + +quasiQuotationTests = + describe "QuasiQuoter" $ do + it "works as expected" $ + [email|local@domain.com|] `shouldBe` unsafeEmailAddress "local" "domain.com" + +instance Arbitrary ByteString where + arbitrary = fmap BS.pack arbitrary + +instance Arbitrary EmailAddress where + arbitrary = do + local <- suchThat arbitrary (\l -> isEmail l (BS.pack "example.com")) + domain <- suchThat arbitrary (\d -> isEmail (BS.pack "example") d) + let (Just result) = emailAddress (makeEmailLike local domain) + pure result + + where + isEmail l d = isValid (makeEmailLike l d) + makeEmailLike l d = BS.concat [l, BS.singleton '@', d] + +{- Properties -} + +prop_doubleCanonicalize :: EmailAddress -> Bool +prop_doubleCanonicalize email = Just email == emailAddress (toByteString email) + +prop_showLikeByteString :: EmailAddress -> Bool +prop_showLikeByteString email = show (toByteString email) == show email + +prop_showAndReadBack :: EmailAddress -> Bool +prop_showAndReadBack email = read (show email) == email + +prop_showAndReadBackWithoutQuoteFails :: EmailAddress -> Bool +prop_showAndReadBackWithoutQuoteFails email = + isNothing (readMaybe (init s)) && isNothing (readMaybe (tail s)) + where + s = show email + readMaybe :: String -> Maybe EmailAddress + readMaybe s = case reads s of + [(x, "")] -> Just x + _ -> Nothing + +{- Examples -} + +data Example = Example + { example :: ByteString + , exampleValid :: Bool + , exampleWhy :: String + , errorContains :: Maybe String } + +valid, invalid :: ByteString -> Example +valid e = Example e True "" Nothing +invalid e = Example e False "" Nothing + +why :: Example -> String -> Example +why ex str = ex { exampleWhy = str } + +errorShouldContain :: Example -> String -> Example +errorShouldContain ex str = ex { errorContains = Just str } + + +examples :: [Example] +examples = + let domain249 = BS.intercalate "." (take 25 (repeat (BS.replicate 9 'x'))) in + [ valid "first.last@example.com" + , valid "first.last@example.com." `why` "Dot allowed on end of domain" + , invalid "local@exam_ple.com" `why` "Underscore not permitted in domain" + , valid "1234567890123456789012345678901234567890123456789012345678901234@example.com" + , valid "\"first last\"@example.com" `why` "Contains quoted spaces" + , valid "\"first\\\"last\"@example.com" `why` "Contains quoted escaped quote" + , invalid "first\\@last@example.com" `why` "Escaping can only happen within a quoted string" + , valid "\"first@last\"@example.com" `why` "Contains quoted at-sign" + , valid "\"first\\\\last\"@example.com" `why` "Contains quoted escaped backslash" + , valid ("1234@" <> domain249) + `why` "Maximum length is 254, this is 254 exactly" + , valid ("1234@" <> domain249 <> ".") + `why` "Trailing dot doesn't increase length" + , invalid ("12345@" <> domain249) + `why` "Maximum length is 254, this is 255" + `errorShouldContain` "too long" + , valid "first.last@[12.34.56.78]" `why` "IP address" + , valid "first.last@[IPv6:::12.34.56.78]" `why` "IPv6 address" + , valid "first.last@[IPv6:1111:2222:3333::4444:12.34.56.78]" + , valid "first.last@[IPv6:1111:2222:3333:4444:5555:6666:12.34.56.78]" + , valid "first.last@[IPv6:::1111:2222:3333:4444:5555:6666]" + , valid "first.last@[IPv6:1111:2222:3333::4444:5555:6666]" + , valid "first.last@[IPv6:1111:2222:3333:4444:5555:6666::]" + , valid "first.last@[IPv6:1111:2222:3333:4444:5555:6666:7777:8888]" + , valid "first.last@x23456789012345678901234567890123456789012345678901234567890123.example.com" + , valid "first.last@1xample.com" + , valid "first.last@123.example.com" + , invalid "first.last" `why` "no at sign" `errorShouldContain` "at sign" + , invalid ".first.last@example.com" `why` "Local part starts with a dot" + , invalid "first.last.@example.com" `why` "Local part ends with a dot" + , invalid "first..last@example.com" `why` "Local part has consecutive dots" + , invalid "\"first\"last\"@example.com" `why` "Local part contains unescaped excluded characters" + , valid "\"first\\last\"@example.com" `why` "Any character can be escaped in a quoted string" + , invalid "\"\"\"@example.com" `why` "Local part contains unescaped excluded characters" + , invalid "\"\\\"@example.com" `why` "Local part cannot end with a backslash" + , invalid "first\\\\@last@example.com" `why` "Local part contains unescaped excluded characters" + , invalid "first.last@" `why` "No domain" + , valid "\"Abc\\@def\"@example.com" + , valid "\"Fred\\ Bloggs\"@example.com" + , valid "\"Joe.\\\\Blow\"@example.com" + , valid "\"Abc@def\"@example.com" + , valid "\"Fred Bloggs\"@example.com" + , valid "user+mailbox@example.com" + , valid "customer/department=shipping@example.com" + , valid "$A12345@example.com" + , valid "!def!xyz%abc@example.com" + , valid "_somename@example.com" + , valid "dclo@us.ibm.com" + , invalid "abc\\@def@example.com" `why` "This example from RFC3696 was corrected in an erratum" + , invalid "abc\\\\@example.com" `why` "This example from RFC3696 was corrected in an erratum" + , valid "peter.piper@example.com" + , invalid "Doug\\ \\\"Ace\\\"\\ Lovell@example.com" `why` "Escaping can only happen in a quoted string" + , valid "\"Doug \\\"Ace\\\" L.\"@example.com" + , invalid "abc@def@example.com" `why` "Doug Lovell says this should fail" + , invalid "abc\\\\@def@example.com" `why` "Doug Lovell says this should fail" + , invalid "abc\\@example.com" `why` "Doug Lovell says this should fail" + , invalid "@example.com" `why` "no local part" + , invalid "doug@" `why` "no domain part" + , invalid "\"qu@example.com" `why` "Doug Lovell says this should fail" + , invalid "ote\"@example.com" `why` "Doug Lovell says this should fail" + , invalid ".dot@example.com" `why` "Doug Lovell says this should fail" + , invalid "dot.@example.com" `why` "Doug Lovell says this should fail" + , invalid "two..dot@example.com" `why` "Doug Lovell says this should fail" + , invalid "\"Doug \"Ace\" L.\"@example.com" `why` "Doug Lovell says this should fail" + , invalid "Doug\\ \\\"Ace\\\"\\ L\\.@example.com" `why` "Doug Lovell says this should fail" + , invalid "hello world@example.com" `why` "Doug Lovell says this should fail" + , valid "gatsby@f.sc.ot.t.f.i.tzg.era.l.d." + , valid "test@example.com" + , valid "TEST@example.com" + , valid "1234567890@example.com" + , valid "test+test@example.com" + , valid "test-test@example.com" + , valid "t*est@example.com" + , valid "+1~1+@example.com" + , valid "{_test_}@example.com" + , valid "\"[[ test ]]\"@example.com" + , valid "test.test@example.com" + , valid "\"test.test\"@example.com" + , valid "test.\"test\"@example.com" `why` "Obsolete form, but documented in RFC2822" + , valid "\"test@test\"@example.com" + , valid "test@123.123.123.x123" + , valid "test@[123.123.123.123]" + , valid "test@example.example.com" + , valid "test@example.example.example.com" + , invalid "test.example.com" + , invalid "test.@example.com" + , invalid "test..test@example.com" + , invalid ".test@example.com" + , invalid "test@test@example.com" + , invalid "test@@example.com" + , invalid "-- test --@example.com" `why` "No spaces allowed in local part" + , invalid "[test]@example.com" `why` "Square brackets only allowed within quotes" + , valid "\"test\\test\"@example.com" `why` "Any character can be escaped in a quoted string" + , invalid "\"test\"test\"@example.com" `why` "Quotes cannot be nested" + , invalid "()[]\\;:,><@example.com" `why` "Disallowed Characters" + , invalid "test@." `why` "Dave Child says so" + , valid "test@example." + , invalid "test@.org" `why` "Dave Child says so" + , invalid "test@[123.123.123.123" `why` "Dave Child says so" + , invalid "test@123.123.123.123]" `why` "Dave Child says so" + , invalid "NotAnEmail" `why` "Phil Haack says so" + , invalid "@NotAnEmail" `why` "Phil Haack says so" + , valid "\"test\\\\blah\"@example.com" + , valid "\"test\\blah\"@example.com" `why` "Any character can be escaped in a quoted string" + , valid "\"test\\\rblah\"@example.com" `why` "Quoted string specifically excludes carriage returns unless escaped" + , invalid "\"test\rblah\"@example.com" `why` "Quoted string specifically excludes carriage returns" + , valid "\"test\\\"blah\"@example.com" + , invalid "\"test\"blah\"@example.com" `why` "Phil Haack says so" + , valid "customer/department@example.com" + , valid "_Yosemite.Sam@example.com" + , valid "~@example.com" + , invalid ".wooly@example.com" `why` "Phil Haack says so" + , invalid "wo..oly@example.com" `why` "Phil Haack says so" + , invalid "pootietang.@example.com" `why` "Phil Haack says so" + , invalid ".@example.com" `why` "Phil Haack says so" + , valid "\"Austin@Powers\"@example.com" + , valid "Ima.Fool@example.com" + , valid "\"Ima.Fool\"@example.com" + , valid "\"Ima Fool\"@example.com" + , invalid "Ima Fool@example.com" `why` "Phil Haack says so" + , invalid "phil.h\\@\\@ck@haacked.com" `why` "Escaping can only happen in a quoted string" + , valid "\"first\".\"last\"@example.com" + , valid "\"first\".middle.\"last\"@example.com" + , invalid "\"first\\\\\"last\"@example.com" `why` "Contains an unescaped quote" + , valid "\"first\".last@example.com" `why` "obs-local-part form as described in RFC 2822" + , valid "first.\"last\"@example.com" `why` "obs-local-part form as described in RFC 2822" + , valid "\"first\".\"middle\".\"last\"@example.com" `why` "obs-local-part form as described in RFC 2822" + , valid "\"first.middle\".\"last\"@example.com" `why` "obs-local-part form as described in RFC 2822" + , valid "\"first.middle.last\"@example.com" `why` "obs-local-part form as described in RFC 2822" + , valid "\"first..last\"@example.com" `why` "obs-local-part form as described in RFC 2822" + , invalid "foo@[\\1.2.3.4]" `why` "RFC 5321 specifies the syntax for address-literal and does not allow escaping" + , valid "\"first\\\\\\\"last\"@example.com" + , valid "first.\"mid\\dle\".\"last\"@example.com" `why` "Backslash can escape anything but must escape something" + , valid "Test.\r\n Folding.\r\n Whitespace@example.com" + , invalid "first\\last@example.com" `why` "Unquoted string must be an atom" + , invalid "Abc\\@def@example.com" `why` "Was incorrectly given as a valid address in the original RFC3696" + , invalid "Fred\\ Bloggs@example.com" `why` "Was incorrectly given as a valid address in the original RFC3696" + , invalid "Joe.\\\\Blow@example.com" `why` "Was incorrectly given as a valid address in the original RFC3696" + , invalid "\"test\\\r\n blah\"@example.com" `why` "Folding white space can\'t appear within a quoted pair" + , valid "\"test\r\n blah\"@example.com" `why` "This is a valid quoted string with folding white space" + , invalid "{^c\\@**Dog^}@cartoon.com" `why` "This is a throwaway example from Doug Lovell\'s article. Actually it\'s not a valid address." + , valid "(foo)cal(bar)@(baz)iamcal.com(quux)" `why` "A valid address containing comments" + , valid "cal@iamcal(woo).(yay)com" `why` "A valid address containing comments" + , valid "cal(woo(yay)hoopla)@iamcal.com" `why` "A valid address containing comments" + , valid "cal(foo\\@bar)@iamcal.com" `why` "A valid address containing comments" + , valid "cal(foo\\)bar)@iamcal.com" `why` "A valid address containing comments and an escaped parenthesis" + , invalid "cal(foo(bar)@iamcal.com" `why` "Unclosed parenthesis in comment" + , invalid "cal(foo)bar)@iamcal.com" `why` "Too many closing parentheses" + , invalid "cal(foo\\)@iamcal.com" `why` "Backslash at end of comment has nothing to escape" + , valid "first().last@example.com" `why` "A valid address containing an empty comment" + , valid "first.(\r\n middle\r\n )last@example.com" `why` "Comment with folding white space" + , invalid "first(12345678901234567890123456789012345678901234567890)last@(1234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890)example.com" `why` "Too long with comments, not too long without" + , valid "first(Welcome to\r\n the (\"wonderful\" (!)) world\r\n of email)@example.com" `why` "Silly example from my blog post" + , valid "pete(his account)@silly.test(his host)" `why` "Canonical example from RFC5322" + , valid "c@(Chris\'s host.)public.example" `why` "Canonical example from RFC5322" + , valid "jdoe@machine(comment). example" `why` "Canonical example from RFC5322" + , valid "1234 @ local(blah) .machine .example" `why` "Canonical example from RFC5322" + , invalid "first(middle)last@example.com" `why` "Can\'t have a comment or white space except at an element boundary" + , valid "first(abc.def).last@example.com" `why` "Comment can contain a dot" + , valid "first(a\"bc.def).last@example.com" `why` "Comment can contain double quote" + , valid "first.(\")middle.last(\")@example.com" `why` "Comment can contain a quote" + , invalid "first(abc(\"def\".ghi).mno)middle(abc(\"def\".ghi).mno).last@(abc(\"def\".ghi).mno)example(abc(\"def\".ghi).mno).(abc(\"def\".ghi).mno)com(abc(\"def\".ghi).mno)" `why` "Can\'t have comments or white space except at an element boundary" + , valid "first(abc\\(def)@example.com" `why` "Comment can contain quoted-pair" + , valid "first.last@x(1234567890123456789012345678901234567890123456789012345678901234567890).com" `why` "Label is longer than 63 octets, but not with comment removed" + , valid "a(a(b(c)d(e(f))g)h(i)j)@example.com" + , invalid "a(a(b(c)d(e(f))g)(h(i)j)@example.com" `why` "Braces are not properly matched" + , valid "name.lastname@domain.com" + , invalid ".@" + , invalid "@bar.com" + , invalid "@@bar.com" + , valid "a@bar.com" + , invalid "aaa.com" + , invalid "aaa@.com" + , invalid "aaa@.123" + , valid "aaa@[123.123.123.123]" + , invalid "aaa@[123.123.123.123]a" `why` "extra data outside ip" + , valid "a@bar.com." + , valid "a-b@bar.com" + , valid "+@b.c" `why` "TLDs can be any length" + , valid "+@b.com" + , invalid "-@..com" + , invalid "-@a..com" + , valid "a@b.co-foo.uk" + , valid "\"hello my name is\"@stutter.com" + , valid "\"Test \\\"Fail\\\" Ing\"@example.com" + , valid "valid@special.museum" + , valid "shaitan@my-domain.thisisminekthx" `why` "Disagree with Paul Gregg here" + , invalid "test@...........com" `why` "......" + , valid "\"Joe\\\\Blow\"@example.com" + , invalid "Invalid \\\n Folding \\\n Whitespace@example.com" `why` "This isn\'t FWS so Dominic Sayers says it\'s invalid" + , valid "HM2Kinsists@(that comments are allowed)this.is.ok" + , valid "user%uucp!path@somehost.edu" + , valid "\"first(last)\"@example.com" + , valid " \r\n (\r\n x \r\n ) \r\n first\r\n ( \r\n x\r\n ) \r\n .\r\n ( \r\n x) \r\n last \r\n ( x \r\n ) \r\n @example.com" + , valid "test.\r\n \r\n obs@syntax.com" `why` "obs-fws allows multiple lines" + , valid "test. \r\n \r\n obs@syntax.com" `why` "obs-fws allows multiple lines (test 2: space before break)" + , invalid "test.\r\n\r\n obs@syntax.com" `why` "obs-fws must have at least one WSP per line" + , valid "\"null \\\0\"@char.com" `why` "can have escaped null character" + , invalid "\"null \0\"@char.com" `why` "cannot have unescaped null character" + -- items below here are invalid according to other RFCs (or opinions) + --, invalid "\"\"@example.com" `why` "Local part is effectively empty" + --, invalid "foobar@192.168.0.1" `why` "ip need to be []" + --, invalid "first.last@[.12.34.56.78]" `why` "Only char that can precede IPv4 address is \':\'" + --, invalid "first.last@[12.34.56.789]" `why` "Can\'t be interpreted as IPv4 so IPv6 tag is missing" + --, invalid "first.last@[::12.34.56.78]" `why` "IPv6 tag is missing" + --, invalid "first.last@[IPv5:::12.34.56.78]" `why` "IPv6 tag is wrong" + --, invalid "first.last@[IPv6:1111:2222:3333::4444:5555:12.34.56.78]" `why` "Too many IPv6 groups (4 max)" + --, invalid "first.last@[IPv6:1111:2222:3333:4444:5555:12.34.56.78]" `why` "Not enough IPv6 groups" + --, invalid "first.last@[IPv6:1111:2222:3333:4444:5555:6666:7777:12.34.56.78]" `why` "Too many IPv6 groups (6 max)" + --, invalid "first.last@[IPv6:1111:2222:3333:4444:5555:6666:7777]" `why` "Not enough IPv6 groups" + --, invalid "first.last@[IPv6:1111:2222:3333:4444:5555:6666:7777:8888:9999]" `why` "Too many IPv6 groups (8 max)" + --, invalid "first.last@[IPv6:1111:2222::3333::4444:5555:6666]" `why` "Too many \'::\' (can be none or one)" + --, invalid "first.last@[IPv6:1111:2222:3333::4444:5555:6666:7777]" `why` "Too many IPv6 groups (6 max)" + --, invalid "first.last@[IPv6:1111:2222:333x::4444:5555]" `why` "x is not valid in an IPv6 address" + --, invalid "first.last@[IPv6:1111:2222:33333::4444:5555]" `why` "33333 is not a valid group in an IPv6 address" + --, invalid "first.last@example.123" `why` "TLD can\'t be all digits" + --, invalid "aaa@[123.123.123.333]" `why` "not a valid IP" + --, invalid "first.last@[IPv6:1111:2222:3333:4444:5555:6666:12.34.567.89]" `why` "IPv4 part contains an invalid octet" + , valid "a@b" + , valid "a@bar" + , invalid "invalid@special.museum-" `why` "domain can't end with hyphen" + , invalid "a@-b.com" `why` "domain can't start with hyphen" + , invalid "a@b-.com" `why` "domain label can't end with hyphen" + --, invalid "\"foo\"(yay)@(hoopla)[1.2.3.4]" `why` "Address literal can\'t be commented (RFC5321)" + --, invalid "first.\"\".last@example.com" `why` "Contains a zero-length element" + --, invalid "test@example" `why` "Dave Child says so" + , invalid (BS.replicate 65 'x' <> "@x") `why` "local-part longer than 64 octets" `errorShouldContain` "too long" + , invalid "x@x23456789.x23456789.x23456789.x23456789.x23456789.x23456789.x23456789.x23456789.x23456789.x23456789.x23456789.x23456789.x23456789.x23456789.x23456789.x23456789.x23456789.x23456789.x23456789.x23456789.x23456789.x23456789.x23456789.x23456789.x23456789.x23456" `why` "Domain exceeds 255 chars" + , invalid "test@123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012.com" `why` "255 characters is maximum length for domain. This is 256." + , invalid "123456789012345678901234567890123456789012345678901234567890@12345678901234567890123456789012345678901234567890123456789.12345678901234567890123456789012345678901234567890123456789.12345678901234567890123456789012345678901234567890123456789.1234.example.com" `why` "Entire address is longer than 254 characters (this is 257)" + , invalid "123456789012345678901234567890123456789012345678901234567890@12345678901234567890123456789012345678901234567890123456789.12345678901234567890123456789012345678901234567890123456789.12345678901234567890123456789012345678901234567890123456789.123.example.com" `why` "Entire address is longer than 254 characters (this is 256)" + , invalid "123456789012345678901234567890123456789012345678901234567890@12345678901234567890123456789012345678901234567890123456789.12345678901234567890123456789012345678901234567890123456789.12345678901234567890123456789012345678901234567890123456789.12.example.com" `why` "Entire address is longer than 254 characters (this is 255)" + , valid "123456789012345678901234567890123456789012345678901234567890@12345678901234567890123456789012345678901234567890123456789.12345678901234567890123456789012345678901234567890123456789.12345678901234567890123456789012345678901234567890123456789.1.example.com" `why` "Entire address is 254 characters" + --, invalid "test@123.123.123.123" `why` "Top Level Domain won\'t be all-numeric (see RFC3696 Section 2). I disagree with Dave Child on this one." + , invalid "first.last@x234567890123456789012345678901234567890123456789012345678901234.example.com" `why` "Label can\'t be longer than 63 octets" + --, invalid "first.last@com" `why` "Mail host must be second- or lower level" + , invalid "first.last@e.-xample.com" `why` "Label can\'t begin with a hyphen" + , invalid "first.last@exampl-.e.com" `why` "Label can\'t end with a hyphen" + ]
tests/doctests.hs view
@@ -1,7 +1,7 @@-import Test.DocTest--main = doctest- [ "-isrc"- , "src/Text/Email/QuasiQuotation.hs"- , "src/Text/Email/Validate.hs"- ]+import Test.DocTest + +main = doctest + [ "-isrc" + , "src/Text/Email/QuasiQuotation.hs" + , "src/Text/Email/Validate.hs" + ]