purebred-email 0.3.0.0 → 0.3.1

raw patch · 6 files changed

+81/−46 lines, 6 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• purebred-email.cabal +2/−2
• src/Data/MIME.hs +42/−18
• src/Data/RFC5322.hs +2/−2
• src/Data/RFC5322/Address/Text.hs +2/−2
• src/Data/RFC5322/Internal.hs +7/−11
• tests/Headers.hs +26/−11

@@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/  name:                purebred-email-version:             0.3.0.0+version:             0.3.1 synopsis:            types and parser for email messages (including MIME) description:   The purebred email library.  RFC 5322, MIME, etc.@@ -34,7 +34,7 @@   tests/golden/*.golden cabal-version:       >=1.10 tested-with:-  GHC==8.4.4, GHC==8.6.5, GHC==8.8.1+  GHC==8.4.4, GHC==8.6.5, GHC==8.8.3, GHC==8.10.1  homepage:            https://github.com/purebred-mua/purebred-email bug-reports:         https://github.com/purebred-mua/purebred-email/issues

@@ -147,13 +147,34 @@ λ> B.putStrLn s MIME-Version: 1.0 Content-Transfer-Encoding: 7bit+Content-Disposition: inline Content-Type: text/plain; charset=us-ascii++Hello, world!+@++Set the @From@ and @To@ headers:++@+λ> alice = Mailbox Nothing (AddrSpec "alice" (DomainDotAtom ("example" :| ["com"])))+λ> bob = Mailbox Nothing (AddrSpec "bob" (DomainDotAtom ("example" :| ["net"])))+λ> msgFromAliceToBob = set 'headerFrom' [alice] . set 'headerTo' [Single bob] $ msg+λ> B.putStrLn (renderMessage msgFromAliceToBob)+MIME-Version: 1.0+From: alice@example.com+To: bob@example.net+Content-Transfer-Encoding: 7bit Content-Disposition: inline+Content-Type: text/plain; charset=us-ascii  Hello, world! @ -__TODO__ show how to set From,To,Cc,etc.+The 'headerFrom', 'headerTo', 'headerCC' and 'headerBCC' lenses are the most+convenient interface for reading and setting the sender and recipient+addresses.  Note that you would usually not manually construct email addresses+manually as was done above.  Instead you would usually read it from another+email or configuration, or parse addresses from user input.  Create a multipart message with attachment: @@ -783,27 +804,30 @@       in ents <> boundary <> "--\r\n"     FailedParse _ bs -> "\r\n" <> Builder.byteString bs -headerFrom :: HasHeaders a => Lens' a [Mailbox]-headerFrom = headers . lens getter setter-  where-    getter = either (pure []) id . parseOnly mailboxList . view (header "from")-    setter = flip $ set (header "from") . renderMailboxes -headerTo :: HasHeaders a => Lens' a [Address]-headerTo = headers . lens (headerGetter "to") (headerSetter "to")--headerCC :: HasHeaders a => Lens' a [Address]-headerCC = headers . lens (headerGetter "cc") (headerSetter "cc")+-- | Map a single-occurrence header to a list value.+-- On read, absent header is mapped to empty list.+-- On write, empty list results in absent header.+--+headerSingleToList+  :: (HasHeaders s)+  => (B.ByteString -> [a])+  -> ([a] -> B.ByteString)+  -> CI B.ByteString+  -> Lens' s [a]+headerSingleToList f g k =+  headers . at k . iso (maybe [] f) (\l -> if null l then Nothing else Just (g l)) -headerBCC :: HasHeaders a => Lens' a [Address]-headerBCC = headers . lens (headerGetter "bcc") (headerSetter "bcc")+headerFrom :: HasHeaders a => Lens' a [Mailbox]+headerFrom = headerSingleToList (either (const []) id . parseOnly mailboxList) renderMailboxes "From" -headerSetter :: CI B.ByteString -> Headers -> [Address] -> Headers-headerSetter fieldname = flip $ set (header fieldname) . renderAddresses+headerAddressList :: (HasHeaders a) => CI B.ByteString -> Lens' a [Address]+headerAddressList = headerSingleToList (either (const []) id . parseOnly addressList) renderAddresses -headerGetter :: CI C8.ByteString -> Headers -> [Address]-headerGetter fieldname =-    either (pure []) id . parseOnly addressList . view (header fieldname)+headerTo, headerCC, headerBCC :: (HasHeaders a) => Lens' a [Address]+headerTo = headerAddressList "To"+headerCC = headerAddressList "Cc"+headerBCC = headerAddressList "Bcc"  headerDate :: HasHeaders a => Lens' a UTCTime headerDate = headers . lens getter setter

@@ -275,7 +275,7 @@ isDtext c = (c >= 33 && c <= 90) || (c >= 94 && c <= 126)  domain :: Parser Domain-domain = (DomainDotAtom <$> (pure <$> dotAtom))+domain = (DomainDotAtom <$> dotAtom)          <|> (DomainLiteral <$> domainLiteral)  mailboxList :: Parser [Mailbox]@@ -308,7 +308,7 @@ message :: (Headers -> Parser a) -> Parser (Message (MessageContext a) a) message f = fields >>= \hdrs -> Message hdrs <$> (crlf *> f hdrs) -type family MessageContext a = s+type family MessageContext a   fields :: Parser Headers

@@ -97,5 +97,5 @@ addressSpec = AddrSpec <$> (T.encodeUtf8 <$> localPart) <*> (char '@' *> domain)  domain :: Parser Domain-domain = (DomainDotAtom <$> (pure . T.encodeUtf8 <$> dotAtom))-         <|> (DomainLiteral <$> (T.encodeUtf8 <$> domainLiteral))+domain = (DomainDotAtom . fmap T.encodeUtf8 <$> dotAtom)+         <|> (DomainLiteral . T.encodeUtf8 <$> domainLiteral)

@@ -49,7 +49,6 @@ import Prelude hiding (takeWhile) import Control.Applicative ((<|>), Alternative, liftA2, many, optional) import Control.Monad (void)-import Control.Lens.Cons (Cons, cons) import qualified Data.Attoparsec.ByteString as A import qualified Data.Attoparsec.Internal as A import qualified Data.Attoparsec.Internal.Types as AT@@ -61,8 +60,7 @@ import Data.Char (chr) import Data.Foldable (fold) import Data.Functor (($>))-import Data.List (intersperse)-import Data.List.NonEmpty (fromList)+import Data.List.NonEmpty (NonEmpty, fromList, intersperse) import Data.Semigroup (Semigroup((<>))) import Data.Semigroup.Foldable (fold1) import qualified Data.Text as T@@ -208,16 +206,14 @@ phrase :: (Alternative (f s), CharParsing f s a, SM s) => (f s) s phrase = foldMany1Sep (singleton ' ') word -dotAtomText :: (Alternative (f s), CharParsing f s a, SM s, Cons s s a a) => (f s) s-dotAtomText =-  takeWhile1 isAtext-  <<>> foldMany (char '.' *> (cons (fromChar '.') <$> takeWhile1 isAtext))+dotAtomText :: (Alternative (f s), CharParsing f s a) => (f s) (NonEmpty s)+dotAtomText = fromList <$> (takeWhile1 isAtext `A.sepBy1` char '.') -dotAtom :: (Alternative (f s), CharParsing f s a, SM s, Cons s s a a) => (f s) s+dotAtom :: (Alternative (f s), CharParsing f s a, SM s) => (f s) (NonEmpty s) dotAtom = optionalCFWS *> dotAtomText <* optionalCFWS -localPart :: (Alternative (f s), CharParsing f s a, SM s, Cons s s a a) => (f s) s-localPart = dotAtom <|> quotedString+localPart :: (Alternative (f s), CharParsing f s a, SM s) => (f s) s+localPart = (fold . intersperse (singleton '.') <$> dotAtom) <|> quotedString  -- | Printable US-ASCII excl "[", "]", or "\" isDtext :: Char -> Bool@@ -253,7 +249,7 @@  -- | Parse one or more values and fold them with a separating element foldMany1Sep :: (Semigroup m, Alternative f) => m -> f m -> f m-foldMany1Sep sep = fmap (fold1 . fromList . intersperse sep) . A.many1+foldMany1Sep sep = fmap (fold1 . intersperse sep . fromList) . A.many1  -- | Skip until the given parser succeeds --

@@ -42,10 +42,30 @@   , contentTypeTests   , parameterTests   , testReferencesField+  , testFromToCcBccOptics   , testProperty "field rendering round-trip" prop_renderHeadersRoundtrip   , testProperty "folded fields no longer than 78 chars" prop_foldedUnstructuredLimited   ] +testFromToCcBccOptics :: TestTree+testFromToCcBccOptics = testGroup "headerFrom/To/Cc/Bcc tests" $+  let+    alice = Mailbox Nothing (AddrSpec "alice" (DomainDotAtom ("example" :| ["com"])))+    bob = Mailbox Nothing (AddrSpec "bob" (DomainDotAtom ("example" :| ["com"])))+    carol = Mailbox Nothing (AddrSpec "carol" (DomainDotAtom ("example" :| ["com"])))+    msg = createTextPlainMessage "hi"+    fromAlice = set headerFrom [alice] msg+    fromAliceToBob = set headerTo [Single bob] fromAlice+    fromAliceToCarolAndBob = over headerTo (Single carol :) fromAliceToBob+  in+    [ testCase "From empty" $ view headerFrom msg @?= []+    , testCase "To empty" $ view headerTo msg @?= []+    , testCase "set From alice" $ view headerFrom fromAlice @?= [alice]+    , testCase "set To bob" $ view headerTo fromAliceToBob @?= [Single bob]+    , testCase "add To carol" $ view headerTo fromAliceToCarolAndBob @?= [Single carol, Single bob]+    , testCase "removing header" $ has (header "From") (set headerFrom [] fromAlice) @?= False+    ]+ rendersFieldsSuccessfully :: TestTree rendersFieldsSuccessfully =     testGroup "correct folding for unstructured" $@@ -108,7 +128,7 @@ mailboxFixtures :: IsString s => [(String, Either String Mailbox -> Assertion, s)] mailboxFixtures =     [ ( "address with FQDN"-      , (Right (Mailbox Nothing (AddrSpec "foo" (DomainDotAtom $ pure "bar.com"))) @=?)+      , (Right (Mailbox Nothing (AddrSpec "foo" (DomainDotAtom $ "bar" :| ["com"]))) @=?)       , "foo@bar.com")     , ( "just with a host name"       , (Right (Mailbox Nothing (AddrSpec "foo" (DomainDotAtom $ pure "bar"))) @=?)@@ -144,7 +164,7 @@       , assertBool "Parse error expected" . isLeft       , "foo@,bar,com")     , ( "displayName without quotes but with spaces"-      , (Right (Mailbox (Just "John Doe") (AddrSpec "jdoe" (DomainDotAtom $ pure "machine.example"))) @=?)+      , (Right (Mailbox (Just "John Doe") (AddrSpec "jdoe" (DomainDotAtom $ "machine" :| ["example"]))) @=?)       , "John Doe <jdoe@machine.example>"       )     ]@@ -166,14 +186,14 @@ addresses :: IsString s => [(String, Either String Address -> Assertion, s)] addresses =     [ ( "single address"-      , (Right (Single (Mailbox Nothing (AddrSpec "foo" (DomainDotAtom $ pure "bar.com")))) @=?)+      , (Right (Single (Mailbox Nothing (AddrSpec "foo" (DomainDotAtom $ "bar" :| ["com"])))) @=?)       , "<foo@bar.com>")     , ( "group of addresses"       , (Right              (Group                   "Group"-                  [ Mailbox (Just "Mr Foo") (AddrSpec "foo" (DomainDotAtom $ pure "bar.com"))-                  , Mailbox (Just "Mr Bar") (AddrSpec "bar" (DomainDotAtom $ pure "bar.com"))]) @=?)+                  [ Mailbox (Just "Mr Foo") (AddrSpec "foo" (DomainDotAtom $ "bar" :| ["com"]))+                  , Mailbox (Just "Mr Bar") (AddrSpec "bar" (DomainDotAtom $ "bar" :| ["com"]))]) @=?)       , "Group: \"Mr Foo\" <foo@bar.com>, \"Mr Bar\" <bar@bar.com>;")     , ( "group of undisclosed recipients"       , (Right (Group "undisclosed-recipients" []) @=?)@@ -303,14 +323,9 @@         , Just "references messageid")       ] -multipleMailboxes :: [Mailbox]-multipleMailboxes =-    [ Mailbox (Just "Mr Bar") (AddrSpec "bar" (DomainDotAtom $ pure "bar.com"))-    , Mailbox Nothing (AddrSpec "roman" (DomainDotAtom $ pure "mail.test"))]- -- | Generate headers genFieldItem :: Gen B.ByteString-genFieldItem = resize 55 . B.pack <$> listOf1 (suchThat arbitrary isFtext)+genFieldItem = resize 55 (B.pack <$> listOf1 (suchThat arbitrary isFtext))  isFtext :: Word8 -> Bool isFtext c = (c >= 33 && c <= 57) || (c >= 59 && c <= 126)