fcmtp-data/src/Data/SMTP/EncodedBody.hs

{-# 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