email-validate 2.3.2.14 → 2.3.2.15
raw patch · 8 files changed
+800/−801 lines, 8 filesdep ~bytestringdep ~doctestsetup-changedPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: bytestring, doctest
API changes (from Hackage documentation)
Files
- LICENSE +30/−30
- Setup.lhs +3/−3
- email-validate.cabal +59/−60
- 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,60 +1,59 @@-name: email-validate -version: 2.3.2.14 -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.14 - -library - build-depends: - base >= 4.4 && < 5, - attoparsec >= 0.10.0 && < 0.15, - bytestring >= 0.9 && < 0.11, - 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.11 - -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.18 - +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
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"+ ]