hsemail 1.7.4 → 1.7.5
raw patch · 6 files changed
+302/−67 lines, 6 filesdep +doctestdep ~basePVP ok
version bump matches the API change (PVP)
Dependencies added: doctest
Dependency ranges changed: base
API changes (from Hackage documentation)
Files
- Text/ParserCombinators/Parsec/Rfc2234.hs +3/−0
- Text/ParserCombinators/Parsec/Rfc2821.hs +21/−22
- Text/ParserCombinators/Parsec/Rfc2822.hs +23/−38
- doc-test.hs +22/−0
- hsemail.cabal +7/−2
- self-test.hs +226/−5
Text/ParserCombinators/Parsec/Rfc2234.hs view
@@ -20,6 +20,9 @@ import Data.Char ( toUpper, chr, ord ) import Control.Monad ( liftM2 ) +-- Customize hlint ...+{-# ANN module "HLint: ignore Use camelCase" #-}+ ---------------------------------------------------------------------- -- * Parser Combinators ----------------------------------------------------------------------
Text/ParserCombinators/Parsec/Rfc2821.hs view
@@ -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" []) = "<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) ----------------------------------------------------------------------
Text/ParserCombinators/Parsec/Rfc2822.hs view
@@ -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 "<joe@example.org>" 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
+ doc-test.hs view
@@ -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"+ ]
hsemail.cabal view
@@ -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
self-test.hs view
@@ -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 "<buffer>" 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 "<buffer>" 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+ -- <http://hackage.haskell.org/package/email-validate>. 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` "<joe@example.org>" + 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: <joe@example.de>\r\n" `shouldReturn` "<joe@example.de>" 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` "<joe@example.org>"++ describe "Rfc2822.word" $+ it "parses hand-picked inputs correctly" $+ parseTest word " foobar " `shouldReturn` "foobar"