diff --git a/Text/ParserCombinators/Parsec/Rfc2234.hs b/Text/ParserCombinators/Parsec/Rfc2234.hs --- a/Text/ParserCombinators/Parsec/Rfc2234.hs +++ b/Text/ParserCombinators/Parsec/Rfc2234.hs @@ -20,6 +20,9 @@ import Data.Char ( toUpper, chr, ord ) import Control.Monad ( liftM2 ) +-- Customize hlint ... +{-# ANN module "HLint: ignore Use camelCase" #-} + ---------------------------------------------------------------------- -- * Parser Combinators ---------------------------------------------------------------------- diff --git a/Text/ParserCombinators/Parsec/Rfc2821.hs b/Text/ParserCombinators/Parsec/Rfc2821.hs --- a/Text/ParserCombinators/Parsec/Rfc2821.hs +++ b/Text/ParserCombinators/Parsec/Rfc2821.hs @@ -21,6 +21,9 @@ import Data.Char ( toLower ) import Text.ParserCombinators.Parsec.Rfc2234 +-- Customize hlint ... +{-# ANN module "HLint: ignore Use camelCase" #-} + ---------------------------------------------------------------------- -- * ESMTP State Machine ---------------------------------------------------------------------- @@ -70,7 +73,7 @@ smtpdFSM :: String -> SmtpdFSM smtpdFSM str = either (\_ -> return (Unrecognized str)) - (handleSmtpCmd) + handleSmtpCmd (parse smtpCmd "" str) -- |For those who want to parse the 'SmtpCmd' themselves. @@ -171,7 +174,7 @@ show (Quit) = "QUIT" show (Turn) = "TURN" show (Help t) - | t == [] = "HELP" + | null t = "HELP" | otherwise = "HELP " ++ t show (WrongArg str _) = "Syntax error in argument of " ++ str ++ "." @@ -192,11 +195,10 @@ instance Show Mailbox where show (Mailbox [] [] []) = "<>" show (Mailbox [] "postmaster" []) = "" - show (Mailbox p u d) = let - route = intercalate "," . map ((:) '@') $ p - mbox = u ++ "@" ++ d - in if null route then "<" ++ mbox ++ ">" - else "<" ++ route ++ ":" ++ mbox ++ ">" + show (Mailbox p u d) = "<" ++ route ++ (if null route then [] else ":") ++ mbox ++ ">" + where + route = intercalate "," . map ((:) '@') $ p + mbox = u ++ "@" ++ d instance Read Mailbox where readsPrec _ = parsec2read (path <|> mailbox) @@ -217,23 +219,20 @@ -- * Data Types for SMTP Replies ---------------------------------------------------------------------- --- |An SMTP reply is a three-digit return code plus some --- waste of bandwidth called \"comments\". This is what the --- list of strings is for; one string per line in the reply. --- 'show' will append an \"@\\r\\n@\" end-of-line marker to --- each entry in that list, so that the resulting string is --- ready to be sent back to the peer. +-- |An SMTP reply is a three-digit return code plus some waste of +-- bandwidth called \"comments\". This is what the list of strings is +-- for; one string per line in the reply. 'show' will append an +-- \"@\\r\\n@\" end-of-line marker to each entry in that list, so that +-- the resulting string is ready to be sent back to the peer. For +-- example: -- --- Here is an example: +-- >>> show $ Reply (Code Success MailSystem 0) ["worked", "like", "a charm" ] +-- "250-worked\r\n250-like\r\n250 a charm\r\n" -- --- > *Rfc2821> print $ Reply (Code Success MailSystem 0) --- > ["worked", "like", "a charm" ] --- > 250-worked --- > 250-like --- > 250 a charm +-- If the message is an empty list @[]@, a default text will be constructed: -- --- If the message is @[]@, you'll get a really helpful --- default text. +-- >>> show $ Reply (Code Success MailSystem 0) [] +-- "250 Success in category MailSystem\r\n" data SmtpReply = Reply SmtpCode [String] @@ -362,7 +361,7 @@ mkCmd1 "HELP" Help (option [] word) noop = try (mkCmd0 "NOOP" Noop) <|> - mkCmd1 "NOOP" (\_ -> Noop) (option [] word) + mkCmd1 "NOOP" (const Noop) (option [] word) ---------------------------------------------------------------------- diff --git a/Text/ParserCombinators/Parsec/Rfc2822.hs b/Text/ParserCombinators/Parsec/Rfc2822.hs --- a/Text/ParserCombinators/Parsec/Rfc2822.hs +++ b/Text/ParserCombinators/Parsec/Rfc2822.hs @@ -82,7 +82,7 @@ -- backslash and the actual content. quoted_pair :: CharParser a String -quoted_pair = do { _ <- char '\\'; r <- text; return ['\\',r] } +quoted_pair = try obs_qp <|> do { _ <- char '\\'; r <- text; return ['\\',r] } "quoted pair" @@ -452,11 +452,8 @@ -- semicolon. The found address(es) are returned - what may be none. -- Here is an example: -- --- > parse group "" "my group: user1@example.org, user2@example.org;" --- --- This input comes out as: --- --- > Right ["user1@example.org","user2@example.org"] +-- >>> parse group "" "my group: user1@example.org, user2@example.org;" +-- Right [NameAddr {nameAddr_name = Nothing, nameAddr_addr = "user1@example.org"},NameAddr {nameAddr_name = Nothing, nameAddr_addr = "user2@example.org"}] group :: CharParser a [NameAddr] group = do _ <- display_name @@ -503,14 +500,14 @@ -- a 'dot_atom' or a 'quoted_string'. local_part :: CharParser a String -local_part = dot_atom <|> quoted_string +local_part = try obs_local_part <|> dot_atom <|> quoted_string "address' local part" -- |Parse and return a \"domain part\" of an 'addr_spec'. That is either -- a 'dot_atom' or a 'domain_literal'. domain :: CharParser a String -domain = dot_atom <|> domain_literal +domain = try obs_domain <|> dot_atom <|> domain_literal "address' domain part" -- |Parse a \"domain literal\". That is a \"@[@\" character, followed by @@ -519,7 +516,7 @@ domain_literal :: CharParser a String domain_literal = unfold (do _ <- char '[' - r <- many $ do { optional fws; dcontent } + r <- many (optional fws >> dcontent) optional fws _ <- char ']' return ("[" ++ concat r ++ "]")) @@ -537,8 +534,8 @@ dtext :: CharParser a Char dtext = no_ws_ctl - <|> satisfy (\c -> ord c `elem` ([33..90] ++ [94,127])) - "character (excluding '[', ']', and '\\')" + <|> satisfy (\c -> ord c `elem` ([33..90] ++ [94..126])) + "any ASCII character (excluding '[', ']', and '\\')" -- * Overall message syntax (section 3.5) @@ -1079,26 +1076,14 @@ -- * Obsolete Addressing (section 4.4) --- |This parser will match the \"obsolete angle address\" syntax. This --- construct used to be known as a \"route address\" in earlier RFCs. --- There are two differences between this construct and the --- 'angle_addr': For one - as usual -, the obsolete form allows for --- more liberal insertion of folding whitespace and comments. --- --- Secondly, and more importantly, angle addresses used to allow the --- (optional) specification of a \"route\". The newer version does not. --- Such a routing address looks like this: --- --- > <@example1.org,@example2.org:simons@example.org> --- --- The parser will return a tuple that - in case of the above address - --- looks like this: --- --- > (["example1.org","example2.org"],"simons@example.org") +-- |This parser matches the \"obsolete angle address\" syntax, a construct that +-- used to be called \"route address\" in earlier RFCs. It differs from a +-- standard 'angle_addr' in two ways: (1) it allows far more +-- liberal insertion of folding whitespace and comments and (2) the address may +-- contain a \"route\" (which this parser ignores): -- --- The first part contains a list of hosts that constitute the route --- part. This list may be empty! The second part of the tuple is the --- actual 'addr_spec' address. +-- >>> parse obs_angle_addr "" "<@example1.org,@example2.org:joe@example.org>" +-- Right "" obs_angle_addr :: CharParser a String obs_angle_addr = unfold (do _ <- char '<' @@ -1161,17 +1146,17 @@ -- commas. But you may have multiple consecutive commas without giving -- a 'mailbox'. You may also have a valid 'obs_mbox_list' that -- contains /no/ 'mailbox' at all. On the other hand, you /must/ have --- at least one comma. --- --- So, this input is perfectly valid: --- --- > "," +-- at least one comma. The following example is valid: -- --- But this one is - contrary to all intuition - not: +-- >>> parse obs_mbox_list "" "," +-- Right [] -- --- > "joe@example.org" +-- But this one is not: -- --- Strange, isn't it? +-- >>> parse obs_mbox_list "" "joe@example.org" +-- Left (line 1, column 16): +-- unexpected end of input +-- expecting obsolete syntax for a list of mailboxes obs_mbox_list :: CharParser a [NameAddr] obs_mbox_list = do r1 <- many1 (try (do r <- maybeOption mailbox diff --git a/doc-test.hs b/doc-test.hs new file mode 100644 --- /dev/null +++ b/doc-test.hs @@ -0,0 +1,22 @@ +{- + Module : Main + Copyright : (c) 2013 Peter Simons + License : BSD3 + + Maintainer : simons@cryp.to + Stability : provisional + Portability : portable + + HsEmail doctest suite. +-} + +module Main ( main ) where + +import Test.DocTest + +main :: IO () +main = doctest + [ "Text/ParserCombinators/Parsec/Rfc2234.hs" + , "Text/ParserCombinators/Parsec/Rfc2821.hs" + , "Text/ParserCombinators/Parsec/Rfc2822.hs" + ] diff --git a/hsemail.cabal b/hsemail.cabal --- a/hsemail.cabal +++ b/hsemail.cabal @@ -1,5 +1,5 @@ Name: hsemail -Version: 1.7.4 +Version: 1.7.5 Copyright: (c) 2013 Peter Simons License: BSD3 License-File: LICENSE @@ -11,7 +11,7 @@ Description: Parsers for the syntax defined in RFC2821 and 2822 Cabal-Version: >= 1.8 Build-Type: Simple -Tested-With: GHC >= 7.0.4 && <= 7.6.1 +Tested-With: GHC >= 7.0.4 && <= 7.6.2 Extra-Source-Files: example/message-test.hs example/message-test.input @@ -33,3 +33,8 @@ type: exitcode-stdio-1.0 main-is: self-test.hs build-depends: base, hspec, parsec, old-time + +Test-Suite doctest-hsemail + type: exitcode-stdio-1.0 + main-is: doc-test.hs + build-depends: base, doctest diff --git a/self-test.hs b/self-test.hs --- a/self-test.hs +++ b/self-test.hs @@ -14,22 +14,29 @@ import Test.Hspec import System.Time ( CalendarTime(..), Month(..), Day(..) ) -import Text.ParserCombinators.Parsec ( parse, CharParser ) +import Text.ParserCombinators.Parsec ( parse, eof, CharParser ) import Text.ParserCombinators.Parsec.Rfc2822 parseTest :: CharParser () a -> String -> IO a -parseTest p input = case parse p "" input of +parseTest p input = case parse (do { r <- p; eof; return r }) (show input) input of Left err -> fail ("parse error at " ++ show err) Right r -> return r +parseIdemTest :: CharParser () String -> String -> Expectation +parseIdemTest p input = parseTest p input `shouldReturn` input + parseFailure :: (Show a) => CharParser () a -> String -> Expectation -parseFailure p input = parse p "" input `shouldSatisfy` failure +parseFailure p input = parse (do { r <- p; eof; return r }) (show input) input `shouldSatisfy` failure where failure (Left _) = True failure _ = False main :: IO () main = hspec $ do + describe "Rfc2822.quoted_pair" $ + it "can quote a nul byte" $ + parseIdemTest quoted_pair "\\\0" + describe "Rfc2822.date_time" $ it "parses hand-picked times correctly" $ parseTest date_time "Fri, 21 Dec 2012 00:07:43 +0300" `shouldReturn` @@ -65,9 +72,203 @@ it "doesn't consume leading whitespace" $ parseTest comments "Comments: foo\r\n" `shouldReturn` " foo" + -- Most of the following test cases have been adapted from + -- . describe "Rfc2822.addr_spec" $ - it "parses hand-picked inputs correctly" $ - parseTest addr_spec "joe@example.de" `shouldReturn` "joe@example.de" + it "parses hand-picked inputs correctly" $ do + parseFailure addr_spec "()[]\\;:,><@example.com" -- Disallowed Characters + parseFailure addr_spec " -- test --@example.com" -- No spaces allowed in local part + parseFailure addr_spec "-@..com" + parseFailure addr_spec "-@a..com" + parseFailure addr_spec ".@" + parseFailure addr_spec ".@example.com" -- Phil Haack says so + parseFailure addr_spec ".dot@example.com" -- Doug Lovell says this should fail + parseFailure addr_spec ".first.last@example.com" -- Local part starts with a dot + parseFailure addr_spec ".test@example.com" + parseFailure addr_spec ".wooly@example.com" -- Phil Haack says so + parseFailure addr_spec "@@bar.com" + parseFailure addr_spec "@NotAnEmail" -- Phil Haack says so + parseFailure addr_spec "@bar.com" + parseFailure addr_spec "@example.com" -- No local part + parseFailure addr_spec "Abc\\@def@example.com" -- Was incorrectly given as a valid address in the original RFC3696 + parseFailure addr_spec "Doug\\ \\\"Ace\\\"\\ L\\.@example.com" -- Doug Lovell says this should fail + parseFailure addr_spec "Doug\\ \\\"Ace\\\"\\ Lovell@example.com" -- Escaping can only happen in a quoted string + parseFailure addr_spec "Fred\\ Bloggs@example.com" -- Was incorrectly given as a valid address in the original RFC3696 + parseFailure addr_spec "Ima Fool@example.com" -- Phil Haack says so + parseFailure addr_spec "Invalid \\\n Folding \\\n Whitespace@example.com" -- This isn't FWS so Dominic Sayers says it's invalid + parseFailure addr_spec "Joe.\\\\Blow@example.com" -- Was incorrectly given as a valid address in the original RFC3696 + parseFailure addr_spec "NotAnEmail" -- Phil Haack says so + parseFailure addr_spec "[test]@example.com" -- Square brackets only allowed within quotes + parseFailure addr_spec "\"Doug \"Ace\" L.\"@example.com" -- Doug Lovell says this should fail + parseIdemTest addr_spec "\"\"@example.com" + parseFailure addr_spec "\"\"\"@example.com" -- Local part contains unescaped excluded characters + parseFailure addr_spec "\"\\\"@example.com" -- Local part cannot end with a backslash + parseFailure addr_spec "\"first\"last\"@example.com" -- Local part contains unescaped excluded characters + parseFailure addr_spec "\"first\\\\\"last\"@example.com" -- Contains an unescaped quote + parseFailure addr_spec "\"foo\"(yay)@(hoopla)[1.2.3.4]" -- Address literal can't be commented (RFC5321) + parseFailure addr_spec "\"null \NUL\"@char.com" -- cannot have unescaped null character + parseFailure addr_spec "\"qu@example.com" -- Doug Lovell says this should fail + parseFailure addr_spec "\"test\"blah\"@example.com" -- Phil Haack says so + parseFailure addr_spec "\"test\"test\"@example.com" -- Quotes cannot be nested + parseFailure addr_spec "\"test\\\r\n blah\"@example.com" -- Folding white space can't appear within a quoted pair + parseFailure addr_spec "\"test\rblah\"@example.com" -- Quoted string specifically excludes carriage returns + parseFailure addr_spec "a(a(b(c)d(e(f))g)(h(i)j)@example.com" -- Braces are not properly matched + parseFailure addr_spec "a@bar.com." + parseFailure addr_spec "aaa.com" + parseFailure addr_spec "aaa@.123" + parseFailure addr_spec "aaa@.com" + parseFailure addr_spec "aaa@[123.123.123.123]a" -- extra data outside ip + parseFailure addr_spec "abc@def@example.com" -- Doug Lovell says this should fail + parseFailure addr_spec "abc\\@def@example.com" -- This example from RFC3696 was corrected in an erratum + parseFailure addr_spec "abc\\@example.com" -- Doug Lovell says this should fail + parseFailure addr_spec "abc\\\\@def@example.com" -- Doug Lovell says this should fail + parseFailure addr_spec "abc\\\\@example.com" -- This example from RFC3696 was corrected in an erratum + parseFailure addr_spec "cal(foo(bar)@iamcal.com" -- Unclosed parenthesis in comment + parseFailure addr_spec "cal(foo)bar)@iamcal.com" -- Too many closing parentheses + parseFailure addr_spec "cal(foo\\)@iamcal.com" -- Backslash at end of comment has nothing to escape + parseFailure addr_spec "dot.@example.com" -- Doug Lovell says this should fail + parseFailure addr_spec "doug@" -- Doug Lovell says this should fail + parseFailure addr_spec "first(12345678901234567890123456789012345678901234567890)last@(1234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890)example.com" -- Too long with comments, not too long without + parseFailure addr_spec "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)" -- Can't have comments or white space except at an element boundary + parseFailure addr_spec "first(middle)last@example.com" -- Can't have a comment or white space except at an element boundary + parseFailure addr_spec "first..last@example.com" -- Local part has consecutive dots + parseFailure addr_spec "first.last" -- No @ + parseFailure addr_spec "first.last.@example.com" -- Local part ends with a dot + parseFailure addr_spec "first.last@" -- No domain + parseFailure addr_spec "first\\@last@example.com" -- Escaping can only happen within a quoted string + parseFailure addr_spec "first\\\\@last@example.com" -- Local part contains unescaped excluded characters + parseFailure addr_spec "first\\last@example.com" -- Unquoted string must be an atom + parseFailure addr_spec "gatsby@f.sc.ot.t.f.i.tzg.era.l.d." -- Doug Lovell says this should fail + parseFailure addr_spec "hello world@example.com" -- Doug Lovell says this should fail + parseFailure addr_spec "ote\"@example.com" -- Doug Lovell says this should fail + parseFailure addr_spec "phil.h\\@\\@ck@haacked.com" -- Escaping can only happen in a quoted string + parseFailure addr_spec "pootietang.@example.com" -- Phil Haack says so + parseFailure addr_spec "test..test@example.com" + parseFailure addr_spec "test.@example.com" + parseFailure addr_spec "test.\r\n\r\n obs@syntax.com" -- obs-fws must have at least one WSP per line + parseFailure addr_spec "test.example.com" + parseFailure addr_spec "test@." -- Dave Child says so + parseFailure addr_spec "test@...........com" -- ...... + parseFailure addr_spec "test@.org" -- Dave Child says so + parseFailure addr_spec "test@123.123.123.123]" -- Dave Child says so + parseFailure addr_spec "test@@example.com" + parseFailure addr_spec "test@[123.123.123.123" -- Dave Child says so + parseFailure addr_spec "test@example." -- Dave Child says so + parseFailure addr_spec "test@test@example.com" + parseFailure addr_spec "two..dot@example.com" -- Doug Lovell says this should fail + parseFailure addr_spec "wo..oly@example.com" -- Phil Haack says so + parseFailure addr_spec "{^c\\@**Dog^}@cartoon.com" -- This is a throwaway example from Doug Lovell's article. Actually it's not a valid address. + parseTest addr_spec " \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" `shouldReturn` "first.last@example.com" + parseIdemTest addr_spec "!def!xyz%abc@example.com" + parseIdemTest addr_spec "$A12345@example.com" + parseTest addr_spec "(foo)cal(bar)@(baz)iamcal.com(quux)" `shouldReturn` "cal@iamcal.com" + parseIdemTest addr_spec "+1~1+@example.com" + parseIdemTest addr_spec "+@b.c" -- TLDs can be any length + parseIdemTest addr_spec "+@b.com" + parseTest addr_spec "1234 @ local(blah) .machine .example" `shouldReturn` "1234@local.machine.example" + parseIdemTest addr_spec "1234567890123456789012345678901234567890123456789012345678901234@example.com" + parseIdemTest addr_spec "123456789012345678901234567890123456789012345678901234567890@12345678901234567890123456789012345678901234567890123456789.12345678901234567890123456789012345678901234567890123456789.123456789012345678901234567890123456789012345678901234567890123.example.com" + parseIdemTest addr_spec "1234567890@example.com" + parseTest addr_spec "HM2Kinsists@(that comments are allowed)this.is.ok" `shouldReturn` "HM2Kinsists@this.is.ok" + parseIdemTest addr_spec "Ima.Fool@example.com" + parseIdemTest addr_spec "TEST@example.com" + parseTest addr_spec "Test.\r\n Folding.\r\n Whitespace@example.com" `shouldReturn` "Test.Folding.Whitespace@example.com" + parseIdemTest addr_spec "\"Abc@def\"@example.com" + parseIdemTest addr_spec "\"Abc\\@def\"@example.com" + parseIdemTest addr_spec "\"Austin@Powers\"@example.com" + parseIdemTest addr_spec "\"Doug \\\"Ace\\\" L.\"@example.com" + parseIdemTest addr_spec "\"Fred Bloggs\"@example.com" + parseIdemTest addr_spec "\"Fred\\ Bloggs\"@example.com" + parseIdemTest addr_spec "\"Ima Fool\"@example.com" + parseIdemTest addr_spec "\"Ima.Fool\"@example.com" + parseIdemTest addr_spec "\"Joe.\\\\Blow\"@example.com" + parseIdemTest addr_spec "\"Joe\\\\Blow\"@example.com" + parseIdemTest addr_spec "\"Test \\\"Fail\\\" Ing\"@example.com" + parseIdemTest addr_spec "\"[[ test ]]\"@example.com" + parseIdemTest addr_spec "\"first last\"@example.com" + parseIdemTest addr_spec "\"first(last)\"@example.com" + parseIdemTest addr_spec "\"first..last\"@example.com" -- obs-local-part form as described in RFC 2822 + parseIdemTest addr_spec "\"first.middle.last\"@example.com" -- obs-local-part form as described in RFC 2822 + parseIdemTest addr_spec "\"first.middle\".\"last\"@example.com" -- obs-local-part form as described in RFC 2822 + parseIdemTest addr_spec "\"first@last\"@example.com" + parseIdemTest addr_spec "\"first\".\"last\"@example.com" + parseIdemTest addr_spec "\"first\".\"middle\".\"last\"@example.com" -- obs-local-part form as described in RFC 2822 + parseIdemTest addr_spec "\"first\".last@example.com" -- obs-local-part form as described in RFC 2822 + parseIdemTest addr_spec "\"first\".middle.\"last\"@example.com" + parseIdemTest addr_spec "\"first\\\"last\"@example.com" + parseIdemTest addr_spec "\"first\\\\\\\"last\"@example.com" + parseIdemTest addr_spec "\"first\\\\last\"@example.com" + parseIdemTest addr_spec "\"first\\last\"@example.com" -- Any character can be escaped in a quoted string + parseIdemTest addr_spec "\"hello my name is\"@stutter.com" + parseIdemTest addr_spec "\"null \\\NUL\"@char.com" -- can have escaped null character + parseIdemTest addr_spec "\"test.test\"@example.com" + parseIdemTest addr_spec "\"test@test\"@example.com" + parseIdemTest addr_spec "\"test\\\"blah\"@example.com" + parseIdemTest addr_spec "\"test\\\\blah\"@example.com" + parseIdemTest addr_spec "\"test\\\rblah\"@example.com" -- Quoted string specifically excludes carriage returns unless escaped + parseIdemTest addr_spec "\"test\\blah\"@example.com" -- Any character can be escaped in a quoted string + parseIdemTest addr_spec "\"test\\test\"@example.com" -- Any character can be escaped in a quoted string + parseIdemTest addr_spec "\"test\r\n blah\"@example.com" -- This is a valid quoted string with folding white space + parseIdemTest addr_spec "_Yosemite.Sam@example.com" + parseIdemTest addr_spec "_somename@example.com" + parseTest addr_spec "a(a(b(c)d(e(f))g)h(i)j)@example.com" `shouldReturn` "a@example.com" + parseIdemTest addr_spec "a-b@bar.com" + parseIdemTest addr_spec "a@b.co-foo.uk" + parseIdemTest addr_spec "a@bar.com" + parseIdemTest addr_spec "aaa@[123.123.123.123]" + parseTest addr_spec "c@(Chris's host.)public.example" `shouldReturn` "c@public.example" + parseTest addr_spec "cal(foo\\)bar)@iamcal.com" `shouldReturn` "cal@iamcal.com" + parseTest addr_spec "cal(foo\\@bar)@iamcal.com" `shouldReturn` "cal@iamcal.com" + parseTest addr_spec "cal(woo(yay)hoopla)@iamcal.com" `shouldReturn` "cal@iamcal.com" + parseTest addr_spec "cal@iamcal(woo).(yay)com" `shouldReturn` "cal@iamcal.com" + parseIdemTest addr_spec "customer/department=shipping@example.com" + parseIdemTest addr_spec "customer/department@example.com" + parseIdemTest addr_spec "dclo@us.ibm.com" + parseTest addr_spec "first().last@example.com" `shouldReturn` "first.last@example.com" + parseTest addr_spec "first(Welcome to\r\n the (\"wonderful\" (!)) world\r\n of email)@example.com" `shouldReturn` "first@example.com" + parseTest addr_spec "first(a\"bc.def).last@example.com" `shouldReturn` "first.last@example.com" + parseTest addr_spec "first(abc.def).last@example.com" `shouldReturn` "first.last@example.com" + parseTest addr_spec "first(abc\\(def)@example.com" `shouldReturn` "first@example.com" + parseTest addr_spec "first.(\")middle.last(\")@example.com" `shouldReturn` "first.middle.last@example.com" + parseTest addr_spec "first.(\r\n middle\r\n )last@example.com" `shouldReturn` "first.last@example.com" + parseIdemTest addr_spec "first.\"last\"@example.com" -- obs-local-part form as described in RFC 2822 + parseIdemTest addr_spec "first.\"mid\\dle\".\"last\"@example.com" -- Backslash can escape anything but must escape something + parseIdemTest addr_spec "first.last@123.example.com" + parseIdemTest addr_spec "first.last@1xample.com" + parseIdemTest addr_spec "first.last@[12.34.56.78]" + parseIdemTest addr_spec "first.last@[IPv6:1111:2222:3333:4444:5555:6666:12.34.56.78]" + parseIdemTest addr_spec "first.last@[IPv6:1111:2222:3333:4444:5555:6666:7777:8888]" + parseIdemTest addr_spec "first.last@[IPv6:1111:2222:3333:4444:5555:6666::]" + parseIdemTest addr_spec "first.last@[IPv6:1111:2222:3333::4444:12.34.56.78]" + parseIdemTest addr_spec "first.last@[IPv6:1111:2222:3333::4444:5555:6666]" + parseIdemTest addr_spec "first.last@[IPv6:::1111:2222:3333:4444:5555:6666]" + parseIdemTest addr_spec "first.last@[IPv6:::12.34.56.78]" + parseIdemTest addr_spec "first.last@example.com" + parseTest addr_spec "first.last@x(1234567890123456789012345678901234567890123456789012345678901234567890).com" `shouldReturn` "first.last@x.com" + parseIdemTest addr_spec "first.last@x23456789012345678901234567890123456789012345678901234567890123.example.com" + parseTest addr_spec "jdoe@machine(comment). example" `shouldReturn` "jdoe@machine.example" + parseIdemTest addr_spec "name.lastname@domain.com" + parseTest addr_spec "pete(his account)@silly.test(his host)" `shouldReturn` "pete@silly.test" + parseIdemTest addr_spec "peter.piper@example.com" + parseIdemTest addr_spec "shaitan@my-domain.thisisminekthx" -- Disagree with Paul Gregg here + parseIdemTest addr_spec "t*est@example.com" + parseIdemTest addr_spec "test+test@example.com" + parseIdemTest addr_spec "test-test@example.com" + parseTest addr_spec "test. \r\n \r\n obs@syntax.com" `shouldReturn` "test.obs@syntax.com" + parseTest addr_spec "test.\"test\"@example.com" `shouldReturn` "test.\"test\"@example.com" + parseTest addr_spec "test.\r\n \r\n obs@syntax.com" `shouldReturn` "test.obs@syntax.com" + parseIdemTest addr_spec "test.test@example.com" + parseIdemTest addr_spec "test@123.123.123.x123" + parseIdemTest addr_spec "test@[123.123.123.123]" + parseIdemTest addr_spec "test@example.com" + parseIdemTest addr_spec "test@example.example.com" + parseIdemTest addr_spec "test@example.example.example.com" + parseIdemTest addr_spec "user%uucp!path@somehost.edu" + parseIdemTest addr_spec "user+mailbox@example.com" + parseIdemTest addr_spec "valid@special.museum" + parseIdemTest addr_spec "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.x234" + parseIdemTest addr_spec "{_test_}@example.com" + parseIdemTest addr_spec "~@example.com" describe "Rfc2822.path" $ do it "parses hand-picked inputs correctly" $ @@ -75,9 +276,29 @@ it "loses the route-part of an obsolete routing address" $ parseTest path "<@example1.org,@example2.org:joe@example.org>" `shouldReturn` "" + describe "Rfc2822.dot_atom" $ do + it "consumes leading and trailing whitespace" $ + parseTest dot_atom " first.last " `shouldReturn` "first.last" + it "does not allow interspersed whitespace" $ do + parseFailure dot_atom "first . last" + parseFailure dot_atom "first .last" + parseFailure dot_atom "first. last" + + describe "Rfc2822.local_part" $ do + it "consumes leading and trailing whitespace" $ + parseTest local_part " first.last " `shouldReturn` "first.last" + it "consumes interspersed whitespace (obsolete syntax)" $ do + parseTest local_part " first . last " `shouldReturn` "first.last" + parseTest local_part " first .last " `shouldReturn` "first.last" + parseTest local_part " first. last " `shouldReturn` "first.last" + describe "Rfc2822.return_path" $ do it "parses hand-picked inputs correctly" $ do parseTest return_path "Return-Path: \r\n" `shouldReturn` "" parseTest return_path "Return-Path: <>\r\n" `shouldReturn` "<>" it "loses the route-part of an obsolete routing address" $ parseTest return_path "Return-Path: <@example1.org,@example2.org:joe@example.org>\r\n" `shouldReturn` "" + + describe "Rfc2822.word" $ + it "parses hand-picked inputs correctly" $ + parseTest word " foobar " `shouldReturn` "foobar"