Enforce length restrictions properly

Also, add more doctests.

src/Text/Email/Parser.hs

@@ -11,7 +11,7 @@ module Text.Email.Parser
 where
 
 import           Control.Applicative
-import           Control.Monad (guard, void)
+import           Control.Monad (guard, void, when)
 import           Data.Attoparsec.ByteString.Char8
 import           Data.ByteString (ByteString)
 import qualified Data.ByteString.Char8 as BS
@@ -55,7 +55,19 @@ domainPart (EmailAddress _ d) = d
 
 -- | A parser for email addresses.
 addrSpec :: Parser EmailAddress
-addrSpec = unsafeEmailAddress <$> local <* char '@' <*> domain
+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
@@ -65,16 +77,18 @@ domain = domainName <|> domainLiteral
 
 domainName :: Parser ByteString
 domainName = do
-    domain <- BS.intercalate (BS.singleton '.') <$> domainLabel `sepBy1` char '.' <* optional (char '.')
+    parsedDomain <- BS.intercalate (BS.singleton '.') <$>
+        domainLabel `sepBy1` char '.' <* optional (char '.')
 
-    -- domain name must be no greater than 253 chars
-    guard (BS.length domain <= 253)
-    return domain
+    -- 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 /= '-')

src/Text/Email/Validate.hs

@@ -24,12 +24,20 @@ import Text.Email.Parser
     , 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. [email protected]"
+-- Just "[email protected]"
 canonicalizeEmail :: ByteString -> Maybe ByteString
 canonicalizeEmail = fmap toByteString . emailAddress
 
@@ -40,6 +48,12 @@ 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 "[email protected]"
+-- Right "[email protected]"
+-- >>> validate "not.good"
+-- Left "at sign > @: not enough input"
 validate :: ByteString -> Either String EmailAddress
 validate = parseOnly (addrSpec >>= \r -> endOfInput >> return r)