123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263 |
- {-# LANGUAGE OverloadedStrings #-}
- module Data.SMTP.EncodedBody where
- import Data.ByteString.Lazy (ByteString)
- import qualified Data.ByteString.Lazy as BS
- import qualified Data.ByteString.Base64.Lazy as B64
- import qualified Data.ByteString.Lazy.Search as Search
- import GHC.Word (Word8)
- import Data.Default.Class
- import Data.Maybe (fromMaybe)
- import Data.SMTP.Email (EmailData)
- import Data.SMTP.Mime
- reencodeBody :: BodyEncoding -> EmailData -> EmailData
- reencodeBody toEncoding = id
- b7bitMessage :: EmailData -> EmailData
- b7bitMessage = B64.encode
- qpDecode :: EmailData -> EmailData
- qpDecode dt = unextend $ Search.replace "=\r\n" BS.empty dt
- where
- unextend d
- | BS.null d = d
- | BS.head d == 61 = let
- (a, rem') = BS.splitAt 2 d
- in BS.cons (unascii . reverse . BS.unpack $ a) (unextend rem')
- | otherwise = d
- unascii :: [Word8] -> Word8
- unascii [] = 0
- unascii (a:aa) = fromIntegral loc + 16 * unascii aa -- the list is reversed
- where
- loc = fromMaybe (
- fromMaybe (
- fromMaybe 0 $ BS.elemIndex a "abcdef" + 10
- ) BS.elemIndex a "ABCDEF" + 10
- ) BS.elemIndex a "0123456789"
- qpEncode :: EmailData -> EmailData
- qpEncode = quoteP
- where
- quoteP :: ByteString -> ByteString
- quoteP d = BS.intercalate "=\r\n" lineCount
- where
- lineCount = splitN 70 cat
- cat = BS.concatMap extendCharP d
- extendCharP :: Word8 -> ByteString
- extendCharP w
- | w > 32 && w < 127 && w /= 61= BS.singleton w
- | otherwise = BS.cons 61 $ asciicode w
- asciicode :: Word8 -> ByteString
- asciicode 0 = ""
- asciicode w = BS.cons h t
- where
- m = mod w 16
- h = if m < 10 then 48 + m else 65 + m
- t = asciicode $ div w 16
- splitN _ d | BS.null d = []
- splitN n d = h : splitN n t
- where
- (h, t) = BS.splitAt n d
|