mime-mail-0.4.11/0000755000000000000000000000000012604155026011633 5ustar0000000000000000mime-mail-0.4.11/ChangeLog.md0000644000000000000000000000125712604155026014011 0ustar0000000000000000## 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) mime-mail-0.4.11/mime-mail.cabal0000644000000000000000000000306212604155026014467 0ustar0000000000000000Name: mime-mail Version: 0.4.11 Synopsis: Compose MIME email messages. description: Hackage documentation generation is not reliable. For up to date documentation, please see: . Homepage: http://github.com/snoyberg/mime-mail License: MIT License-file: LICENSE Author: Michael Snoyman Maintainer: Michael Snoyman Category: Email Build-type: Simple extra-source-files: README.md ChangeLog.md -- Constraint on the version of Cabal needed to build this package. Cabal-version: >=1.8 Library 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.5 , bytestring >= 0.9.1 , text >= 0.7 , filepath >= 1.2 test-suite tests type: exitcode-stdio-1.0 main-is: Spec.hs other-modules: Network.Mail.MimeSpec hs-source-dirs: test build-depends: base , hspec >= 1.3 , mime-mail , blaze-builder , bytestring , text ghc-options: -Wall source-repository head type: git location: git://github.com/snoyberg/mime-mail.git mime-mail-0.4.11/LICENSE0000644000000000000000000000207512604155026012644 0ustar0000000000000000Copyright (c) 2014 Michael Snoyman, http://www.yesodweb.com/ 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: The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. 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. mime-mail-0.4.11/README.md0000644000000000000000000000050012604155026013105 0ustar0000000000000000## 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-0.4.11/Setup.lhs0000644000000000000000000000016212604155026013442 0ustar0000000000000000#!/usr/bin/env runhaskell > module Main where > import Distribution.Simple > main :: IO () > main = defaultMain mime-mail-0.4.11/Network/0000755000000000000000000000000012604155026013264 5ustar0000000000000000mime-mail-0.4.11/Network/Mail/0000755000000000000000000000000012604155026014146 5ustar0000000000000000mime-mail-0.4.11/Network/Mail/Mime.hs0000644000000000000000000004775412604155026015412 0ustar0000000000000000{-# LANGUAGE CPP, OverloadedStrings #-} module Network.Mail.Mime ( -- * Datatypes Boundary (..) , Mail (..) , emptyMail , Address (..) , Alternatives , Part (..) , Encoding (..) , Headers -- * Render a message , renderMail , renderMail' -- * Sending messages , sendmail , sendmailCustom , sendmailCustomCaptureOutput , renderSendMail , renderSendMailCustom -- * High-level 'Mail' creation , simpleMail , simpleMail' , simpleMailInMemory -- * Utilities , addPart , addAttachment , addAttachments , addAttachmentBS , addAttachmentsBS , renderAddress , htmlPart , plainPart , randomString , quotedPrintable ) 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 import System.Process import System.IO import System.Exit import System.FilePath (takeFileName) import qualified Data.ByteString.Base64 as Base64 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.Word (Word8) import qualified Data.ByteString as S import Data.Text (Text) import qualified Data.Text as T import qualified Data.Text.Encoding as TE -- | Generates a random sequence of alphanumerics of the given length. randomString :: RandomGen d => Int -> d -> (String, d) randomString len = first (map toChar) . sequence' (replicate len (randomR (0, 61))) where sequence' [] g = ([], g) sequence' (f:fs) g = let (f', g') = f g (fs', g'') = sequence' fs g' in (f' : fs', g'') toChar i | i < 26 = toEnum $ i + fromEnum 'A' | i < 52 = toEnum $ i + fromEnum 'a' - 26 | otherwise = toEnum $ i + fromEnum '0' - 52 -- | 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 -- | An entire mail message. data Mail = Mail { mailFrom :: Address , mailTo :: [Address] , mailCc :: [Address] , mailBcc :: [Address] -- | Other headers, excluding from, to, cc and bcc. , mailHeaders :: Headers -- | A list of different sets of alternatives. As a concrete example: -- -- > mailParts = [ [textVersion, htmlVersion], [attachment1], [attachment1]] -- -- Make sure when specifying alternatives to place the most preferred -- version last. , mailParts :: [Alternatives] } deriving Show -- | A mail message with the provided 'from' address and no other -- fields filled in. emptyMail :: Address -> Mail emptyMail from = Mail { mailFrom = from , mailTo = [] , mailCc = [] , mailBcc = [] , mailHeaders = [] , mailParts = [] } data Address = Address { addressName :: Maybe Text , addressEmail :: Text } deriving (Eq, Show) -- | How to encode a single part. You should use 'Base64' for binary data. data Encoding = None | Base64 | QuotedPrintableText | QuotedPrintableBinary deriving (Eq, Show) -- | Multiple alternative representations of the same data. For example, you -- could provide a plain-text and HTML version of a message. type Alternatives = [Part] -- | A single part of a multipart message. data Part = Part { partType :: Text -- ^ content type , partEncoding :: Encoding -- | The filename for this part, if it is to be sent with an attachemnt -- disposition. , partFilename :: Maybe Text , partHeaders :: Headers , partContent :: L.ByteString } deriving (Eq, Show) type Headers = [(S.ByteString, Text)] type Pair = (Headers, Builder) partToPair :: Part -> Pair partToPair (Part contentType encoding disposition headers content) = (headers', builder) where headers' = ((:) ("Content-Type", contentType)) $ (case encoding of None -> id Base64 -> (:) ("Content-Transfer-Encoding", "base64") QuotedPrintableText -> (:) ("Content-Transfer-Encoding", "quoted-printable") QuotedPrintableBinary -> (:) ("Content-Transfer-Encoding", "quoted-printable")) $ (case disposition of Nothing -> id Just fn -> (:) ("Content-Disposition", "attachment; filename=" `T.append` fn)) $ headers builder = case encoding of None -> fromWriteList writeByteString $ L.toChunks content Base64 -> base64 content QuotedPrintableText -> quotedPrintable True content QuotedPrintableBinary -> quotedPrintable False content showPairs :: RandomGen g => Text -- ^ multipart type, eg mixed, alternative -> [Pair] -> g -> (Pair, g) showPairs _ [] _ = error "renderParts called with null parts" showPairs _ [pair] gen = (pair, gen) showPairs mtype parts gen = ((headers, builder), gen') where (Boundary b, gen') = random gen headers = [ ("Content-Type", T.concat [ "multipart/" , mtype , "; boundary=\"" , b , "\"" ]) ] builder = mconcat [ mconcat $ intersperse (fromByteString "\n") $ map (showBoundPart $ Boundary b) parts , 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 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' builder = mconcat [ mconcat addressHeaders , mconcat $ map showHeader headers , showHeader ("MIME-Version", "1.0") , mconcat $ map showHeader finalHeaders , fromByteString "\n" , 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 showHeader :: (S.ByteString, Text) -> Builder showHeader (k, v) = mconcat [ fromByteString k , fromByteString ": " , encodeIfNeeded v , fromByteString "\n" ] showAddressHeader :: (S.ByteString, [Address]) -> Builder showAddressHeader (k, as) = if null as then mempty else mconcat [ fromByteString k , fromByteString ": " , mconcat (intersperse (fromByteString ", ") . map showAddress $ as) , fromByteString "\n" ] -- | -- -- Since 0.4.3 showAddress :: Address -> Builder showAddress a = mconcat [ maybe mempty ((`mappend` fromByteString " ") . encodedWord) (addressName a) , fromByteString "<" , fromText (addressEmail a) , fromByteString ">" ] showBoundPart :: Boundary -> (Headers, Builder) -> Builder showBoundPart (Boundary b) (headers, content) = mconcat [ fromByteString "--" , fromText b , fromByteString "\n" , mconcat $ map showHeader headers , fromByteString "\n" , content ] showBoundEnd :: Boundary -> Builder showBoundEnd (Boundary b) = mconcat [ fromByteString "\n--" , fromText b , fromByteString "--" ] -- | Like 'renderMail', but generates a random boundary. renderMail' :: Mail -> IO L.ByteString renderMail' m = do g <- getStdGen let (lbs, g') = renderMail g m setStdGen g' return lbs -- | Send a fully-formed email message via the default sendmail -- executable with default options. sendmail :: L.ByteString -> IO () sendmail = sendmailCustom sendmailPath ["-t"] sendmailPath :: String #ifdef MIME_MAIL_SENDMAIL_PATH sendmailPath = MIME_MAIL_SENDMAIL_PATH #else sendmailPath = "/usr/sbin/sendmail" #endif -- | Render an email message and send via the default sendmail -- executable with default options. renderSendMail :: Mail -> IO () renderSendMail = sendmail <=< renderMail' -- | Send a fully-formed email message via the specified sendmail -- executable with specified options. sendmailCustom :: FilePath -- ^ sendmail executable path -> [String] -- ^ sendmail command-line options -> L.ByteString -- ^ mail message as lazy bytestring -> IO () 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 -> 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 -- executable with specified options. renderSendMailCustom :: FilePath -- ^ sendmail executable path -> [String] -- ^ sendmail command-line options -> Mail -- ^ mail to render and send -> IO () renderSendMailCustom sm opts = sendmailCustom sm opts <=< renderMail' -- FIXME usage of FilePath below can lead to issues with filename encoding -- | A simple interface for generating an email with HTML and plain-text -- alternatives and some file attachments. -- -- Note that we use lazy IO for reading in the attachment contents. simpleMail :: Address -- ^ to -> Address -- ^ from -> Text -- ^ subject -> LT.Text -- ^ plain body -> LT.Text -- ^ HTML body -> [(Text, FilePath)] -- ^ content type and path of attachments -> IO Mail simpleMail to from subject plainBody htmlBody attachments = addAttachments attachments . addPart [plainPart plainBody, htmlPart htmlBody] $ mailFromToSubject from to subject -- | A simple interface for generating an email with only plain-text body. simpleMail' :: Address -- ^ to -> Address -- ^ from -> Text -- ^ subject -> LT.Text -- ^ body -> Mail 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 mailFromToSubject :: Address -- ^ from -> Address -- ^ to -> Text -- ^ subject -> Mail mailFromToSubject from to subject = (emptyMail from) { mailTo = [to] , mailHeaders = [("Subject", subject)] } -- | Add an 'Alternative' to the 'Mail's parts. -- -- To e.g. add a plain text body use -- > addPart [plainPart body] (emptyMail from) addPart :: Alternatives -> Mail -> Mail addPart alt mail = mail { mailParts = mailParts mail ++ [alt] } -- | Construct a UTF-8-encoded plain-text 'Part'. plainPart :: LT.Text -> Part plainPart body = Part cType QuotedPrintableText Nothing [] $ 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 where cType = "text/html; charset=utf-8" -- | 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 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 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 = let part = Part ct Base64 (Just fn) [] content in addPart [part] 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 | QPSpace | QPEscape S.ByteString data QPC = QPCCR | QPCLF | QPCSpace | QPCTab | QPCPlain | QPCEscape deriving Eq toQP :: Bool -- ^ text? -> L.ByteString -> [QP] toQP isText = go where go lbs = case L.uncons lbs of Nothing -> [] Just (c, rest) -> case toQPC c of QPCCR -> go rest QPCLF -> QPNewline : go rest QPCSpace -> QPSpace : go rest QPCTab -> QPTab : go rest QPCPlain -> let (x, y) = L.span ((== QPCPlain) . toQPC) lbs in QPPlain (toStrict x) : go y QPCEscape -> let (x, y) = L.span ((== QPCEscape) . toQPC) lbs in QPEscape (toStrict x) : go y toStrict = S.concat . L.toChunks toQPC :: Word8 -> QPC toQPC 13 | isText = QPCCR toQPC 10 | isText = QPCLF toQPC 9 = QPCTab toQPC 0x20 = QPCSpace toQPC 46 = QPCEscape toQPC 61 = QPCEscape toQPC w | 33 <= w && w <= 126 = QPCPlain | otherwise = QPCEscape buildQPs :: [QP] -> Builder buildQPs = go (0 :: Int) where go _ [] = mempty go currLine (qp:qps) = case qp of QPNewline -> copyByteString "\r\n" `mappend` go 0 qps QPTab -> wsHelper (copyByteString "=09") (fromWord8 9) QPSpace -> wsHelper (copyByteString "=20") (fromWord8 0x20) QPPlain bs -> let toTake = 75 - currLine (x, y) = S.splitAt toTake bs rest | S.null y = qps | otherwise = QPPlain y : qps in helper (S.length x) (copyByteString x) (S.null y) rest QPEscape bs -> let toTake = (75 - currLine) `div` 3 (x, y) = S.splitAt toTake bs rest | S.null y = qps | otherwise = QPEscape y : qps in if toTake == 0 then copyByteString "=\r\n" `mappend` go 0 (qp:qps) else helper (S.length x * 3) (escape x) (S.null y) rest where escape = S.foldl' add mempty where add builder w = builder `mappend` escaped where escaped = fromWord8 61 `mappend` hex (w `shiftR` 4) `mappend` hex (w .&. 15) helper added builder noMore rest = builder' `mappend` go newLine rest where (newLine, builder') | not noMore || (added + currLine) >= 75 = (0, builder `mappend` copyByteString "=\r\n") | otherwise = (added + currLine, builder) wsHelper enc raw | null qps = if currLine <= 73 then enc else copyByteString "\r\n=" `mappend` enc | otherwise = helper 1 raw (currLine < 76) qps -- | The first parameter denotes whether the input should be treated as text. -- If treated as text, then CRs will be stripped and LFs output as CRLFs. If -- binary, then CRs and LFs will be escaped. quotedPrintable :: Bool -> L.ByteString -> Builder quotedPrintable isText = buildQPs . toQP isText hex :: Word8 -> Builder hex x | x < 10 = fromWord8 $ x + 48 | otherwise = fromWord8 $ x + 55 encodeIfNeeded :: Text -> Builder encodeIfNeeded t = if needsEncodedWord t then encodedWord t else fromText t needsEncodedWord :: Text -> Bool needsEncodedWord = not . T.all isAscii encodedWord :: Text -> Builder encodedWord t = mconcat [ fromByteString "=?utf-8?Q?" , S.foldl' go mempty $ TE.encodeUtf8 t , fromByteString "?=" ] where go front w = front `mappend` go' w go' 32 = fromWord8 95 -- space go' 95 = go'' 95 -- _ go' 63 = go'' 63 -- ? go' 61 = go'' 61 -- = -- The special characters from RFC 2822. Not all of these always give -- problems, but at least @[];"<>, gave problems with some mail servers -- when used in the 'name' part of an address. go' 34 = go'' 34 -- " go' 40 = go'' 40 -- ( go' 41 = go'' 41 -- ) go' 44 = go'' 44 -- , go' 46 = go'' 46 -- . go' 58 = go'' 58 -- ; go' 59 = go'' 59 -- ; go' 60 = go'' 60 -- < go' 62 = go'' 62 -- > go' 64 = go'' 64 -- @ go' 91 = go'' 91 -- [ go' 92 = go'' 92 -- \ go' 93 = go'' 93 -- ] go' w | 33 <= w && w <= 126 = fromWord8 w | otherwise = go'' w go'' w = fromWord8 61 `mappend` hex (w `shiftR` 4) `mappend` hex (w .&. 15) -- 57 bytes, when base64-encoded, becomes 76 characters. -- Perform the encoding 57-bytes at a time, and then append a newline. base64 :: L.ByteString -> Builder base64 lbs | L.null lbs = mempty | otherwise = fromByteString x64 `mappend` fromByteString "\r\n" `mappend` base64 y where (x', y) = L.splitAt 57 lbs x = S.concat $ L.toChunks x' x64 = Base64.encode x mime-mail-0.4.11/test/0000755000000000000000000000000012604155026012612 5ustar0000000000000000mime-mail-0.4.11/test/Spec.hs0000644000000000000000000000005412604155026014037 0ustar0000000000000000{-# OPTIONS_GHC -F -pgmF hspec-discover #-} mime-mail-0.4.11/test/Network/0000755000000000000000000000000012604155026014243 5ustar0000000000000000mime-mail-0.4.11/test/Network/Mail/0000755000000000000000000000000012604155026015125 5ustar0000000000000000mime-mail-0.4.11/test/Network/Mail/MimeSpec.hs0000644000000000000000000000566712604155026017201 0ustar0000000000000000{-# 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 = "=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 "についてのテスト" in toLazyByteString (quotedPrintable True dec) `shouldBe` enc it "issue #17- as binary" $ let enc = "=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 "についてのテスト" 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 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