mime-mail 0.4.5.2 → 0.5.2
raw patch · 6 files changed
Files
- ChangeLog.md +59/−0
- LICENSE +17/−27
- Network/Mail/Mime.hs +266/−32
- README.md +6/−0
- mime-mail.cabal +20/−17
- test/Network/Mail/MimeSpec.hs +71/−0
+ ChangeLog.md view
@@ -0,0 +1,59 @@+## 0.5.2++* Add `Eq` instance for `Mail`++## 0.5.1++* Add `Generic` instances for types used in `Mail`++## 0.5++* Add support for inline images and multipart/related+* Add `filePart` and `filePartBS` for attachments+* Change `Part` data type (`Disposition` and `PartContent`)+* Remove `addAttachmentCid` and `addAttachmentBSCid` (replaced by `addImage`)+* Remove `getAttachmentPartBS` and `getAttachmentPart`++## 0.4.14++* Add `IsString` instance for `Address`++## 0.4.13.1++* Fix [#50](https://github.com/snoyberg/mime-mail/issues/50): space between name and address [#51](https://github.com/snoyberg/mime-mail/pull/51)++## 0.4.13++* Sanitize headers to protect against email injection.++## 0.4.12++* Add function to add attachments with content id [#48](https://github.com/snoyberg/mime-mail/pull/48)++## 0.4.11++* Export renderAddress as a utility (e.g. Reply-to) [#44](https://github.com/snoyberg/mime-mail/pull/44)++## 0.4.10++* addParts: append mail parts to a Mail [#43](https://github.com/snoyberg/mime-mail/pull/43)++## 0.4.9++* Add `sendmailCustomCaptureOutput` [#42](https://github.com/snoyberg/mime-mail/pull/42)++## 0.4.8.1++* Bump blaze-builder upper bound [#39](https://github.com/snoyberg/mime-mail/pull/39)++## 0.4.8++* Add some `Eq` instances [#38](https://github.com/snoyberg/mime-mail/pull/38)++## 0.4.7++* `simpleMailInMemory`++## 0.4.6.1++Add a soft line break when hitting a QPEscape at the end of an encoded line. [#34](https://github.com/snoyberg/mime-mail/pull/34)
LICENSE view
@@ -1,30 +1,20 @@-Copyright (c)2010, Michael Snoyman--All rights reserved.--Redistribution and use in source and binary forms, with or without-modification, are permitted provided that the following conditions are met:-- * Redistributions of source code must retain the above copyright- notice, this list of conditions and the following disclaimer.+Copyright (c) 2014 Michael Snoyman, http://www.yesodweb.com/ - * Redistributions in binary form must reproduce the above- copyright notice, this list of conditions and the following- disclaimer in the documentation and/or other materials provided- with the distribution.+Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions: - * Neither the name of Michael Snoyman nor the names of other- contributors may be used to endorse or promote products derived- from this software without specific prior written permission.+The above copyright notice and this permission notice shall be+included in all copies or substantial portions of the Software. -THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS-"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT-LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR-A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT-OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,-SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT-LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,-DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY-THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT-(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE-OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND+NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE+LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION+OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION+WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
Network/Mail/Mime.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE CPP, OverloadedStrings #-}+{-# LANGUAGE CPP, DeriveGeneric, OverloadedStrings, RecordWildCards #-} module Network.Mail.Mime ( -- * Datatypes Boundary (..)@@ -7,7 +7,11 @@ , Address (..) , Alternatives , Part (..)+ , PartContent (..)+ , Disposition (..) , Encoding (..)+ , InlineImage(..)+ , ImageContent(..) , Headers -- * Render a message , renderMail@@ -15,24 +19,36 @@ -- * Sending messages , sendmail , sendmailCustom+ , sendmailCustomCaptureOutput , renderSendMail , renderSendMailCustom -- * High-level 'Mail' creation , simpleMail , simpleMail'+ , simpleMailInMemory+ , simpleMailWithImages -- * Utilities , addPart , addAttachment , addAttachments+ , addAttachmentBS+ , addAttachmentsBS+ , renderAddress , htmlPart , plainPart+ , filePart+ , filePartBS , randomString , quotedPrintable+ , relatedPart+ , addImage+ , mkImageParts ) where import qualified Data.ByteString.Lazy as L import Blaze.ByteString.Builder.Char.Utf8 import Blaze.ByteString.Builder+import Control.Concurrent (forkIO, putMVar, takeMVar, newEmptyMVar) import Data.Monoid import System.Random import Control.Arrow@@ -41,19 +57,21 @@ import System.Exit import System.FilePath (takeFileName) import qualified Data.ByteString.Base64 as Base64-import Control.Monad ((<=<), foldM)+import Control.Monad ((<=<), (>=>), foldM, void) import Control.Exception (throwIO, ErrorCall (ErrorCall)) import Data.List (intersperse) import qualified Data.Text.Lazy as LT import qualified Data.Text.Lazy.Encoding as LT import Data.ByteString.Char8 () import Data.Bits ((.&.), shiftR)-import Data.Char (isAscii)+import Data.Char (isAscii, isControl) import Data.Word (Word8)+import Data.String (IsString(..)) import qualified Data.ByteString as S import Data.Text (Text) import qualified Data.Text as T import qualified Data.Text.Encoding as TE+import GHC.Generics (Generic) -- | Generates a random sequence of alphanumerics of the given length. randomString :: RandomGen d => Int -> d -> (String, d)@@ -72,6 +90,7 @@ -- | MIME boundary between parts of a message. newtype Boundary = Boundary { unBoundary :: Text }+ deriving (Eq, Show) instance Random Boundary where randomR = const random random = first (Boundary . T.pack) . randomString 10@@ -92,6 +111,7 @@ -- version last. , mailParts :: [Alternatives] }+ deriving (Eq, Show, Generic) -- | A mail message with the provided 'from' address and no other -- fields filled in.@@ -109,9 +129,14 @@ { addressName :: Maybe Text , addressEmail :: Text }+ deriving (Eq, Show, Generic) +instance IsString Address where+ fromString = Address Nothing . Data.String.fromString+ -- | How to encode a single part. You should use 'Base64' for binary data. data Encoding = None | Base64 | QuotedPrintableText | QuotedPrintableBinary+ deriving (Eq, Show, Generic) -- | Multiple alternative representations of the same data. For example, you -- could provide a plain-text and HTML version of a message.@@ -121,19 +146,31 @@ data Part = Part { partType :: Text -- ^ content type , partEncoding :: Encoding- -- | The filename for this part, if it is to be sent with an attachemnt+ -- | The filename for this part, if it is to be sent with an attachment -- disposition.- , partFilename :: Maybe Text+ , partDisposition :: Disposition , partHeaders :: Headers- , partContent :: L.ByteString+ , partContent :: PartContent }+ deriving (Eq, Show, Generic) +-- | NestedParts are for multipart-related: One HTML part and some inline images+data PartContent = PartContent L.ByteString | NestedParts [Part]+ deriving (Eq, Show, Generic)++data Disposition = AttachmentDisposition Text+ | InlineDisposition Text+ | DefaultDisposition+ deriving (Show, Eq, Generic)+ type Headers = [(S.ByteString, Text)]-type Pair = (Headers, Builder) +data Pair = Pair (Headers, Builder)+ | CompoundPair (Headers, [Pair])+ partToPair :: Part -> Pair-partToPair (Part contentType encoding disposition headers content) =- (headers', builder)+partToPair (Part contentType encoding disposition headers (PartContent content)) =+ Pair (headers', builder) where headers' = ((:) ("Content-Type", contentType))@@ -145,10 +182,12 @@ QuotedPrintableBinary -> (:) ("Content-Transfer-Encoding", "quoted-printable")) $ (case disposition of- Nothing -> id- Just fn ->- (:) ("Content-Disposition", "attachment; filename="- `T.append` fn))+ AttachmentDisposition fn ->+ (:) ("Content-Disposition", "attachment; filename=" `T.append` fn)+ InlineDisposition cid ->+ (:) ("Content-Disposition", "inline; filename=" `T.append` cid) . (:) ("Content-ID", "<" <> cid <> ">") . (:) ("Content-Location", cid)+ DefaultDisposition -> id+ ) $ headers builder = case encoding of@@ -156,7 +195,14 @@ Base64 -> base64 content QuotedPrintableText -> quotedPrintable True content QuotedPrintableBinary -> quotedPrintable False content+partToPair (Part contentType encoding disposition headers (NestedParts parts)) =+ CompoundPair (headers', pairs)+ where+ headers' = ("Content-Type", contentType):headers+ pairs = map partToPair parts ++-- This function merges sibling pairs into a multipart pair showPairs :: RandomGen g => Text -- ^ multipart type, eg mixed, alternative -> [Pair]@@ -165,7 +211,7 @@ showPairs _ [] _ = error "renderParts called with null parts" showPairs _ [pair] gen = (pair, gen) showPairs mtype parts gen =- ((headers, builder), gen')+ (Pair (headers, builder), gen') where (Boundary b, gen') = random gen headers =@@ -183,21 +229,56 @@ , showBoundEnd $ Boundary b ] +-- This function flattens any compound pairs into a multipart+-- related, but leaves other pairs in tact+-- NOTE that this is not recursive, and assumes only one level of nesting.+flattenCompoundPair :: RandomGen g => Pair -> g -> (Pair, g)+flattenCompoundPair pair@(Pair _) gen = (pair, gen)+flattenCompoundPair (CompoundPair (hs, pairs)) gen =+ (Pair (headers, builder), gen')+ where+ (Boundary b, gen') = random gen+ headers =+ [ ("Content-Type", T.concat+ [ "multipart/related" , "; boundary=\"" , b , "\"" ])+ ]+ builder = mconcat+ [ mconcat $ intersperse (fromByteString "\n")+ $ map (showBoundPart $ Boundary b) pairs+ , showBoundEnd $ Boundary b+ ]++ -- | Render a 'Mail' with a given 'RandomGen' for producing boundaries. renderMail :: RandomGen g => g -> Mail -> (L.ByteString, g) renderMail g0 (Mail from to cc bcc headers parts) = (toLazyByteString builder, g'') where addressHeaders = map showAddressHeader [("From", [from]), ("To", to), ("Cc", cc), ("Bcc", bcc)]- pairs = map (map partToPair) parts- (pairs', g') = helper g0 $ map (showPairs "alternative") pairs+ -- parts is [Alternative], or [[Part]]+ -- reverse parts so attachments come at the end+ pairs :: [[Pair]]+ pairs = map (map partToPair) (reverse parts)++ (pairs1, g1) = helper2 g0 $ map (map flattenCompoundPair) pairs+ (pairs', g') = helper g1 $ map (showPairs "alternative") pairs1+ helper :: g -> [g -> (x, g)] -> ([x], g) helper g [] = ([], g) helper g (x:xs) = let (b, g_) = x g (bs, g__) = helper g_ xs in (b : bs, g__)- ((finalHeaders, finalBuilder), g'') = showPairs "mixed" pairs' g'++ -- new 2nd order helper+ helper2 :: g -> [[g -> (x, g)]] -> ([[x]], g)+ helper2 g [] = ([], g)+ helper2 g (x:xs) =+ let (b, g_) = helper g x -- original helper+ (bs, g__) = helper2 g_ xs+ in (b : bs, g__)++ (Pair (finalHeaders, finalBuilder), g'') = showPairs "mixed" pairs' g' builder = mconcat [ mconcat addressHeaders , mconcat $ map showHeader headers@@ -207,11 +288,24 @@ , finalBuilder ] +-- | Format an E-Mail address according to the name-addr form (see: RFC5322+-- § 3.4 "Address specification", i.e: [display-name] '<'addr-spec'>')+-- This can be handy for adding custom headers that require such format.+--+-- @since 0.4.11+renderAddress :: Address -> Text+renderAddress address =+ TE.decodeUtf8 $ toByteString $ showAddress address++-- Only accept characters between 33 and 126, excluding colons. [RFC2822](https://tools.ietf.org/html/rfc2822#section-2.2)+sanitizeFieldName :: S.ByteString -> S.ByteString+sanitizeFieldName = S.filter (\w -> w >= 33 && w <= 126 && w /= 58)+ showHeader :: (S.ByteString, Text) -> Builder showHeader (k, v) = mconcat- [ fromByteString k+ [ fromByteString (sanitizeFieldName k) , fromByteString ": "- , encodeIfNeeded v+ , encodeIfNeeded (sanitizeHeader v) , fromByteString "\n" ] @@ -231,14 +325,18 @@ -- Since 0.4.3 showAddress :: Address -> Builder showAddress a = mconcat- [ maybe mempty ((`mappend` fromByteString " ") . encodedWord) (addressName a)+ [ maybe mempty ((<> fromByteString " ") . encodedWord) (addressName a) , fromByteString "<"- , fromText (addressEmail a)+ , fromText (sanitizeHeader $ addressEmail a) , fromByteString ">" ] -showBoundPart :: Boundary -> (Headers, Builder) -> Builder-showBoundPart (Boundary b) (headers, content) = mconcat+-- Filter out control characters to prevent CRLF injection.+sanitizeHeader :: Text -> Text+sanitizeHeader = T.filter (not . isControl)++showBoundPart :: Boundary -> Pair -> Builder+showBoundPart (Boundary b) (Pair (headers, content)) = mconcat [ fromByteString "--" , fromText b , fromByteString "\n"@@ -285,14 +383,49 @@ -> [String] -- ^ sendmail command-line options -> L.ByteString -- ^ mail message as lazy bytestring -> IO ()-sendmailCustom sm opts lbs = do- (Just hin, _, _, phandle) <- createProcess $- (proc sm opts) { std_in = CreatePipe }+sendmailCustom sm opts lbs = void $ sendmailCustomAux False sm opts lbs++-- | Like 'sendmailCustom', but also returns sendmail's output to stderr and+-- stdout as strict ByteStrings.+--+-- Since 0.4.9+sendmailCustomCaptureOutput :: FilePath+ -> [String]+ -> L.ByteString+ -> IO (S.ByteString, S.ByteString)+sendmailCustomCaptureOutput sm opts lbs = sendmailCustomAux True sm opts lbs++sendmailCustomAux :: Bool+ -> FilePath+ -> [String]+ -> L.ByteString+ -> IO (S.ByteString, S.ByteString)+sendmailCustomAux captureOut sm opts lbs = do+ let baseOpts = (proc sm opts) { std_in = CreatePipe }+ pOpts = if captureOut+ then baseOpts { std_out = CreatePipe+ , std_err = CreatePipe+ }+ else baseOpts+ (Just hin, mHOut, mHErr, phandle) <- createProcess pOpts L.hPut hin lbs hClose hin+ errMVar <- newEmptyMVar+ outMVar <- newEmptyMVar+ case (mHOut, mHErr) of+ (Nothing, Nothing) -> return ()+ (Just hOut, Just hErr) -> do+ void . forkIO $ S.hGetContents hOut >>= putMVar outMVar+ void . forkIO $ S.hGetContents hErr >>= putMVar errMVar+ _ -> error "error in sendmailCustomAux: missing a handle" exitCode <- waitForProcess phandle case exitCode of- ExitSuccess -> return ()+ ExitSuccess -> if captureOut+ then do+ errOutput <- takeMVar errMVar+ outOutput <- takeMVar outMVar+ return (outOutput, errOutput)+ else return (S.empty, S.empty) _ -> throwIO $ ErrorCall ("sendmail exited with error code " ++ show exitCode) -- | Render an email message and send via the specified sendmail@@ -330,6 +463,55 @@ simpleMail' to from subject body = addPart [plainPart body] $ mailFromToSubject from to subject +-- | A simple interface for generating an email with HTML and plain-text+-- alternatives and some 'ByteString' attachments.+--+-- Since 0.4.7+simpleMailInMemory :: Address -- ^ to+ -> Address -- ^ from+ -> Text -- ^ subject+ -> LT.Text -- ^ plain body+ -> LT.Text -- ^ HTML body+ -> [(Text, Text, L.ByteString)] -- ^ content type, file name and contents of attachments+ -> Mail+simpleMailInMemory to from subject plainBody htmlBody attachments =+ addAttachmentsBS attachments+ . addPart [plainPart plainBody, htmlPart htmlBody]+ $ mailFromToSubject from to subject+++data InlineImage = InlineImage {+ imageContentType :: Text+ , imageContent :: ImageContent+ , imageCID :: Text+ } deriving Show++data ImageContent = ImageFilePath FilePath | ImageByteString L.ByteString+ deriving Show++-- | An interface for generating an email with HTML and plain-text+-- alternatives, some file attachments, and inline images.+-- Note that we use lazy IO for reading in the attachment and inlined images.+-- Inline images can be referred to from the HTML content using+-- the @src="cid:{{CONTENT-ID}}"@ syntax, where CONTENT-ID is+-- the filename of the image.+--+-- Since 0.5.0+simpleMailWithImages :: [Address] -- ^ to (multiple)+ -> Address -- ^ from+ -> Text -- ^ subject+ -> LT.Text -- ^ plain body+ -> LT.Text -- ^ HTML body+ -> [InlineImage]+ -> [(Text, FilePath)] -- ^ content type and path of attachments+ -> IO Mail+simpleMailWithImages to from subject plainBody htmlBody images attachments = do+ inlineImageParts <- mkImageParts images+ addAttachments attachments+ . addPart [ plainPart plainBody+ , relatedPart ((htmlPart htmlBody):inlineImageParts) ]+ $ (emptyMail from) { mailTo = to, mailHeaders = [("Subject", subject)] }+ mailFromToSubject :: Address -- ^ from -> Address -- ^ to -> Text -- ^ subject@@ -346,27 +528,78 @@ addPart :: Alternatives -> Mail -> Mail addPart alt mail = mail { mailParts = alt : mailParts mail } +-- | Add a 'Related' Part+relatedPart :: [Part] -> Part+relatedPart parts =+ Part "multipart/related" None DefaultDisposition [] (NestedParts parts)+ -- | Construct a UTF-8-encoded plain-text 'Part'. plainPart :: LT.Text -> Part-plainPart body = Part cType QuotedPrintableText Nothing [] $ LT.encodeUtf8 body+plainPart body = Part cType QuotedPrintableText DefaultDisposition []+ $ PartContent (LT.encodeUtf8 body) where cType = "text/plain; charset=utf-8" -- | Construct a UTF-8-encoded html 'Part'. htmlPart :: LT.Text -> Part-htmlPart body = Part cType QuotedPrintableText Nothing [] $ LT.encodeUtf8 body+htmlPart body = Part cType QuotedPrintableText DefaultDisposition []+ $ PartContent (LT.encodeUtf8 body) where cType = "text/html; charset=utf-8" +-- | Construct a BASE64-encoded file attachment 'Part'+--+-- Since 0.5.0+filePart :: Text -> FilePath -> IO Part+filePart ct fn = do+ content <- L.readFile fn+ return $ filePartBS ct (T.pack (takeFileName fn)) content++-- | Construct a BASE64-encoded file attachment 'Part'+--+-- Since 0.5.0+filePartBS :: Text -> Text -> L.ByteString -> Part+filePartBS ct filename content = Part ct Base64 (AttachmentDisposition filename) [] (PartContent content)+ -- | Add an attachment from a file and construct a 'Part'. addAttachment :: Text -> FilePath -> Mail -> IO Mail addAttachment ct fn mail = do- content <- L.readFile fn- let part = Part ct Base64 (Just $ T.pack (takeFileName fn)) [] content+ part <- filePart ct fn return $ addPart [part] mail addAttachments :: [(Text, FilePath)] -> Mail -> IO Mail addAttachments xs mail = foldM fun mail xs where fun m (c, f) = addAttachment c f m +-- | Add an inline image from a file and construct a 'Part'.+--+-- Since 0.5.0+addImage :: InlineImage -> IO Part+addImage InlineImage{..} = do+ content <- case imageContent of+ ImageFilePath fn -> L.readFile fn+ ImageByteString bs -> return bs+ return+ $ Part imageContentType Base64 (InlineDisposition imageCID) [] (PartContent content)++mkImageParts :: [InlineImage] -> IO [Part]+mkImageParts xs =+ mapM addImage xs++-- | Add an attachment from a 'ByteString' and construct a 'Part'.+--+-- Since 0.4.7+addAttachmentBS :: Text -- ^ content type+ -> Text -- ^ file name+ -> L.ByteString -- ^ content+ -> Mail -> Mail+addAttachmentBS ct fn content mail = addPart [filePartBS ct fn content] mail++-- |+-- Since 0.4.7+addAttachmentsBS :: [(Text, Text, L.ByteString)] -> Mail -> Mail+addAttachmentsBS xs mail = foldl fun mail xs+ where fun m (ct, fn, content) = addAttachmentBS ct fn content m++ data QP = QPPlain S.ByteString | QPNewline | QPTab@@ -410,6 +643,7 @@ toQPC 10 | isText = QPCLF toQPC 9 = QPCTab toQPC 0x20 = QPCSpace+ toQPC 46 = QPCEscape toQPC 61 = QPCEscape toQPC w | 33 <= w && w <= 126 = QPCPlain@@ -439,7 +673,7 @@ | S.null y = qps | otherwise = QPEscape y : qps in if toTake == 0- then copyByteString "\r\n" `mappend` go 0 (qp:qps)+ then copyByteString "=\r\n" `mappend` go 0 (qp:qps) else helper (S.length x * 3) (escape x) (S.null y) rest where escape =
+ README.md view
@@ -0,0 +1,6 @@+## mime-mail++This package provides some high-level datatypes for declaring MIME email+messages, functions for automatically composing these into bytestrings, and the+ability to send bytestrings via the sendmail executable. You can also use any+other library you wish to send via different methods, eg directly to SMTP.
mime-mail.cabal view
@@ -1,37 +1,40 @@+Cabal-version: 2.0 Name: mime-mail-Version: 0.4.5.2+Version: 0.5.2 Synopsis: Compose MIME email messages.-Description: This package provides some high-level datatypes for declaring MIME email messages, functions for automatically composing these into bytestrings, and the ability to send bytestrings via the sendmail executable. You can also use any other library you wish to send via different methods, eg directly to SMTP.+description: Hackage documentation generation is not reliable. For up to date documentation, please see: <http://www.stackage.org/package/mime-mail>. Homepage: http://github.com/snoyberg/mime-mail-License: BSD3+License: MIT License-file: LICENSE Author: Michael Snoyman <michael@snoyman.com>-Maintainer: Michael Snoyman <michael@snoyman.com>+Maintainer: Michael Snoyman <michael@snoyman.com>, Marek Suchánek <marek.suchanek@fit.cvut.cz> Category: Email Build-type: Simple---- Constraint on the version of Cabal needed to build this package.-Cabal-version: >=1.8+extra-source-files: README.md+extra-doc-files: ChangeLog.md Library+ default-language: Haskell2010 Exposed-modules: Network.Mail.Mime- Build-depends: base >= 4 && < 5- , base64-bytestring >= 0.1- , process >= 1.0- , random >= 1.0- , blaze-builder >= 0.2.1 && < 0.4- , bytestring >= 0.9.1- , text >= 0.7- , filepath >= 1.2+ Build-depends: base >= 4.9 && < 5+ , base64-bytestring ^>= 1.2+ , process ^>= 1.6+ , random ^>= 1.3+ , blaze-builder ^>= 0.4+ , bytestring ^>= 0.12+ , text ^>= 2.1+ , filepath ^>= 1.5 test-suite tests+ default-language: Haskell2010 type: exitcode-stdio-1.0 main-is: Spec.hs+ other-modules: Network.Mail.MimeSpec hs-source-dirs: test build-depends: base- , hspec >= 1.3+ , hspec >= 2.11 , mime-mail , blaze-builder , bytestring@@ -40,4 +43,4 @@ source-repository head type: git- location: git://github.com/snoyberg/mime-mail.git+ location: https://github.com/snoyberg/mime-mail.git
+ test/Network/Mail/MimeSpec.hs view
@@ -0,0 +1,71 @@+{-# LANGUAGE OverloadedStrings #-}+module Network.Mail.MimeSpec where++import Test.Hspec+import Test.Hspec.QuickCheck+import Network.Mail.Mime+import qualified Data.ByteString.Lazy.Char8 as L8+import Blaze.ByteString.Builder (toLazyByteString)+import Control.Monad (forM_)+import Data.Text.Lazy.Encoding (encodeUtf8)++spec :: Spec+spec = describe "Network.Mail.Mime" $ do+ describe "quotedPrintable" $ do+ it "doesn't generate lines longer than 76 characters" $ do+ let lbs = toLazyByteString+ $ quotedPrintable True (L8.replicate 1000 'x')+ forM_ (lines' lbs) $ (\l -> L8.length l `shouldSatisfy` (<= 76))+ it "under 76 in presence of terminating space" $ do+ let lbs = toLazyByteString+ $ quotedPrintable True+ $ L8.pack+ $ foldr+ (\a b -> b ++ replicate 74 'x' ++ [a])+ ""+ [' ']+ forM_ (lines' lbs) $ (\l -> L8.length l `shouldSatisfy` (<= 76))+ prop "always under 76 characters, text" $ \s ->+ let orig = L8.pack s+ gen = toLazyByteString $ quotedPrintable True orig+ in all (\l -> L8.length l <= 76) $ lines' gen+ prop "always under 76 characters, binary" $ \s ->+ let orig = L8.pack s+ gen = toLazyByteString $ quotedPrintable True orig+ in all (\l -> L8.length l <= 76) $ lines' gen++ it "example from Wikipedia" $+ let enc = "If you believe that truth=3Dbeauty, then surely mathematics is the most bea=\r\nutiful branch of philosophy=2E"+ dec = "If you believe that truth=beauty, then surely mathematics is the most beautiful branch of philosophy."+ in toLazyByteString (quotedPrintable True dec) `shouldBe` enc++ it "issue #17- as text" $+ let enc = "</a>=E3=81=AB=E3=81=A4=E3=81=84=E3=81=A6=E3=81=AE=E3=83=86=E3=82=B9=E3=83=\r\n=88"+ dec = encodeUtf8 "</a>についてのテスト"+ in toLazyByteString (quotedPrintable True dec) `shouldBe` enc++ it "issue #17- as binary" $+ let enc = "</a>=E3=81=AB=E3=81=A4=E3=81=84=E3=81=A6=E3=81=AE=E3=83=86=E3=82=B9=E3=83=\r\n=88"+ dec = encodeUtf8 "</a>についてのテスト"+ in toLazyByteString (quotedPrintable False dec) `shouldBe` enc++ it "concrete example: over 76 characters" $+ let orig = "\240\238\191aa\149aa\226a\235\255a=aa\SI\159a\187a\147aa\ACKa\184aaaaaa\191a\237aaaa\EM a"+ gen = toLazyByteString $ quotedPrintable True orig+ in if all (\l -> L8.length l <= 76) $ lines' gen+ then True+ else error $ show $ lines' gen++ it "issue #50" $+ let addr = Address (Just "Name_ (is): @hi?") "user@domain.tld"+ enc = "=?utf-8?Q?Name=5F_=28is=29=3A_=40hi=3F?= <user@domain.tld>"+ in renderAddress addr `shouldBe` enc++lines' :: L8.ByteString -> [L8.ByteString]+lines' =+ map stripCR . L8.lines+ where+ stripCR bs+ | L8.null bs = bs+ | L8.last bs == '\r' = L8.init bs+ | otherwise = bs