purebred-email 0.1.0.1 → 0.2.0.0

raw patch · 9 files changed

+94/−27 lines, 9 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• purebred-email.cabal +2/−2
• src/Data/MIME.hs +5/−3
• src/Data/MIME/Charset.hs +22/−10
• src/Data/MIME/EncodedWord.hs +7/−7
• src/Data/MIME/Parameter.hs +2/−2
• src/Data/RFC5322/Address/Text.hs +14/−0
• src/Data/RFC5322/Internal.hs +6/−1
• tests/Headers.hs +35/−1
• tests/MIME.hs +1/−1

@@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/  name:                purebred-email-version:             0.1.0.1+version:             0.2.0.0 synopsis:            types and parser for email messages (including MIME) description:   The purebred email library.  RFC 5322, MIME, etc.@@ -26,7 +26,7 @@ license-file:        LICENSE author:              Fraser Tweedale maintainer:          frase@frase.id.au-copyright:           Copyright 2017-2018  Fraser Tweedale+copyright:           Copyright 2017-2019  Fraser Tweedale category:            Data, Email build-type:          Simple extra-source-files:

@@ -85,6 +85,8 @@   , createMultipartMixedMessage    -- * Re-exports+  , CharsetLookup+  , defaultCharsets   , module Data.RFC5322   , module Data.MIME.Parameter   , module Data.MIME.Error@@ -380,7 +382,7 @@       else         preview l params <|> Just "us-ascii"   charsetData = body -- XXX: do we need to drop the BOM / encoding decl?-  charsetDecoded = to $ \a -> (\t -> set body t a) <$> view charsetText a+  charsetDecoded m = to $ \a -> (\t -> set body t a) <$> view (charsetText m) a    -- | Encode (@utf-8@) and add/set charset parameter.  If consisting   -- entirely of ASCII characters, the @charset@ parameter gets set to@@ -536,8 +538,8 @@  -- | Traverse the value of the filename parameter (if present). ---filename :: HasParameters a => Traversal' a T.Text-filename = filenameParameter . traversed . charsetPrism . value+filename :: HasParameters a => CharsetLookup -> Traversal' a T.Text+filename m = filenameParameter . traversed . charsetPrism m . value  -- | Access the filename parameter as a @Maybe ('ParameterValue' B.ByteString)@. --

@@ -1,5 +1,6 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-} @@ -24,6 +25,9 @@   , AsCharsetError(..)   , charsetPrism +  , CharsetLookup+  , defaultCharsets+   , decodeLenient   ) where @@ -76,29 +80,34 @@   charsetData :: Getter a B.ByteString    -- | Structure with the encoded data replaced with 'Text'-  charsetDecoded :: AsCharsetError e => Getter a (Either e (Decoded a))+  charsetDecoded :: AsCharsetError e => CharsetLookup -> Getter a (Either e (Decoded a))    -- | Encode the data   charsetEncode :: Decoded a -> a   -- | Decode the object according to the declared charset.-charsetText :: (HasCharset a, AsCharsetError e) => Getter a (Either e T.Text)-charsetText = to $ \a ->+charsetText+  :: (HasCharset a, AsCharsetError e)+  => CharsetLookup -> Getter a (Either e T.Text)+charsetText lookupCharset = to $ \a ->   maybe (Left $ review _CharsetUnspecified ()) Right (view charsetName a)   >>= \k -> maybe (Left $ review _CharsetUnsupported k) Right (lookupCharset k)   >>= \f -> pure (f (view charsetData a))  -- | Monomorphic in error type-charsetText' :: (HasCharset a) => Getter a (Either CharsetError T.Text)+charsetText'+  :: (HasCharset a)+  => CharsetLookup+  -> Getter a (Either CharsetError T.Text) charsetText' = charsetText  -- | Prism for charset decoded/encoded data. -- Information about decoding failures is discarded.-charsetPrism :: forall a. (HasCharset a) => Prism' a (Decoded a)-charsetPrism = prism' charsetEncode (either (const Nothing) Just . view l)+charsetPrism :: forall a. (HasCharset a) => CharsetLookup -> Prism' a (Decoded a)+charsetPrism m = prism' charsetEncode (either (const Nothing) Just . view l)   where-  l = charsetDecoded :: Getter a (Either CharsetError (Decoded a))+  l = charsetDecoded m :: Getter a (Either CharsetError (Decoded a))  charsets :: [(CI.CI B.ByteString, Charset)] charsets =@@ -127,10 +136,13 @@ utf_8 = decodeLenient iso_8859_1 = T.decodeLatin1 --- | Look up a character set.++type CharsetLookup = CI.CI B.ByteString -> Maybe Charset++-- | Supports US-ASCII, UTF-8 and ISO-8859-1. ---lookupCharset :: CI.CI B.ByteString -> Maybe Charset-lookupCharset k = lookup k charsets+defaultCharsets :: CharsetLookup+defaultCharsets k = lookup k charsets  -- | Decode as UTF-8, replacing invalid sequences with placeholders. --

@@ -101,7 +101,7 @@ -- encoded-words and decodes them. -- -- @--- λ> T.putStrLn $ decodeEncodedWords "hello =?utf-8?B?5LiW55WM?=!"+-- λ> T.putStrLn $ decodeEncodedWords defaultCharsets "hello =?utf-8?B?5LiW55WM?=!" -- hello 世界! -- @ --@@ -109,22 +109,22 @@ -- is left unchanged in the result. -- -- @--- λ> T.putStrLn $ decodeEncodedWords "=?utf-8?B?bogus?="+-- λ> T.putStrLn $ decodeEncodedWords defaultCharsets "=?utf-8?B?bogus?=" -- =?utf-8?B?bogus?= ----- λ> T.putStrLn $ decodeEncodedWords "=?utf-8?X?unrecognised_encoding?="+-- λ> T.putStrLn $ decodeEncodedWords defaultCharsets "=?utf-8?X?unrecognised_encoding?=" -- =?utf-8?X?unrecognised_encoding?= -- @ -- -- Language specification is supported (the datum is discarded). -- -- @--- λ> T.putStrLn $ decodeEncodedWords "=?utf-8*es?Q?hola_mundo!?="+-- λ> T.putStrLn $ decodeEncodedWords defaultCharsets "=?utf-8*es?Q?hola_mundo!?=" -- hola mundo! -- @ ---decodeEncodedWords :: B.ByteString -> T.Text-decodeEncodedWords s =+decodeEncodedWords :: CharsetLookup -> B.ByteString -> T.Text+decodeEncodedWords charsets s =   either (const $ decodeLenient s) merge $ fmap (g . f) <$> parseOnly tokens s   where     -- parse the ByteString into a series of tokens@@ -140,6 +140,6 @@     g (Left t) = Left t     g (Right w) = first       (const $ serialiseEncodedWord $ transferEncodeEncodedWord w :: CharsetError -> B.ByteString)-      (view charsetDecoded w)+      (view (charsetDecoded charsets) w)      merge = foldMap (either decodeLenient id)

@@ -183,7 +183,7 @@ -- constructor directly. -- newParameter :: T.Text -> EncodedParameterValue-newParameter = review charsetPrism . ParameterValue Nothing Nothing+newParameter = charsetEncode . ParameterValue Nothing Nothing   -- | The default charset @us-ascii@ is implied by the abstract of@@ -198,7 +198,7 @@   type Decoded EncodedParameterValue = DecodedParameterValue   charsetName = to $ \(ParameterValue name _ _) -> name <|> Just "us-ascii"   charsetData = value-  charsetDecoded = to $ \a -> (\t -> (set charset Nothing . set value t) a) <$> view charsetText a+  charsetDecoded m = to $ \a -> (\t -> (set charset Nothing . set value t) a) <$> view (charsetText m) a   charsetEncode (ParameterValue _ lang s) =     let       bs = T.encodeUtf8 s

@@ -7,10 +7,14 @@ module Data.RFC5322.Address.Text   (     mailbox+  , mailboxList   , address+  , addressList   -- * Pretty printing   , renderMailbox   , renderMailboxes+  , renderAddress+  , renderAddresses   ) where  import Control.Applicative ((<|>), optional)@@ -46,6 +50,13 @@   where     a' = renderAddressSpec a +renderAddresses :: [Address] -> T.Text+renderAddresses xs = T.intercalate ", " $ renderAddress <$> xs++renderAddress :: Address -> T.Text+renderAddress (Single m) = renderMailbox m+renderAddress (Group name xs) = name <> ":" <> renderMailboxes xs <> ";"+ renderAddressSpec :: AddrSpec -> Builder.Builder renderAddressSpec (AddrSpec lp (DomainDotAtom b))   | " " `B.isInfixOf` lp = "\"" <> buildLP <> "\"" <> rest@@ -67,6 +78,9 @@  mailboxList :: Parser [Mailbox] mailboxList = mailbox `sepBy` char ','++addressList :: Parser [Address]+addressList = address `sepBy` char ','  group :: Parser Address group = Group <$> displayName <* char ':' <*> mailboxList <* char ';' <* optionalCFWS

@@ -61,6 +61,7 @@ import Data.Char (chr) import Data.Foldable (fold) import Data.Functor (($>))+import Data.List (intersperse) import Data.List.NonEmpty (fromList) import Data.Semigroup (Semigroup((<>))) import Data.Semigroup.Foldable (fold1)@@ -206,7 +207,7 @@ word = atom <|> quotedString  phrase :: (Alternative (f s), CharParsing f s a, SM s) => (f s) s-phrase = foldMany1 word+phrase = foldMany1Sep (singleton ' ') word  dotAtomText :: (Alternative (f s), CharParsing f s a, SM s, Cons s s a a) => (f s) s dotAtomText =@@ -250,6 +251,10 @@ -- | Parse one or more values and fold them foldMany1 :: (Semigroup m, Alternative f) => f m -> f m foldMany1 = fmap (fold1 . fromList) . A.many1++-- | 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  -- | Skip until the given parser succeeds --

@@ -23,7 +23,8 @@ import Test.QuickCheck.Instances ()  import Data.MIME-import qualified Data.RFC5322.Address.Text as AddressText (mailbox, address)+import qualified Data.RFC5322.Address.Text as AddressText+  (mailbox, address, renderAddress)  renderField :: (CI.CI B.ByteString, B.ByteString) -> B.ByteString renderField = toStrict . Builder.toLazyByteString . buildField@@ -34,6 +35,7 @@   , parsesTextMailboxesSuccessfully   , parsesAddressesSuccessfully   , parsesTextAddressesSuccessfully+  , rendersAddressesToTextSuccessfully   , testRenderMailboxes   , rendersFieldsSuccessfully   , ixAndAt@@ -75,6 +77,34 @@          , Mailbox Nothing (AddrSpec "bar" (DomainDotAtom ("bar" :| ["com"])))          ] +rendersAddressesToTextSuccessfully :: TestTree+rendersAddressesToTextSuccessfully =+  testGroup "renders addresses to text" $+  (\(desc, address, expected) ->+     testCase desc $ expected @=? (AddressText.renderAddress address)) <$>+  xs+  where+    xs =+      [ ( "single address"+        , (Single+             (Mailbox Nothing (AddrSpec "foo" (DomainDotAtom $ pure "bar.com"))))+        , "foo@bar.com")+      , ( "group of addresses"+        , (Group+             "Group"+             [ Mailbox+                 (Just "Mr Foo")+                 (AddrSpec "foo" (DomainDotAtom $ pure "bar.com"))+             , Mailbox+                 (Just "Mr Bar")+                 (AddrSpec "bar" (DomainDotAtom $ pure "bar.com"))+             ])+        , "Group:\"Mr Foo\" <foo@bar.com>, \"Mr Bar\" <bar@bar.com>;")+      , ( "group of undisclosed recipients"+        , (Group "undisclosed-recipients" [])+        , "undisclosed-recipients:;")+      ]+ -- | Note some examples are taken from https://tools.ietf.org/html/rfc3696#section-3 mailboxFixtures :: IsString s => [(String, Either String Mailbox -> Assertion, s)] mailboxFixtures =@@ -114,6 +144,10 @@     , ( "wrong: comma in front of domain"       , 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"))) @=?)+      , "John Doe <jdoe@machine.example>"+      )     ]  parsesMailboxesSuccessfully :: TestTree

@@ -139,7 +139,7 @@         )     ]   where-    lFilename = headers . contentDisposition . filename+    lFilename = headers . contentDisposition . filename defaultCharsets     stripPath = snd . T.breakOnEnd "/"  testParse :: TestTree