diff --git a/Yesod/Mail.hs b/Yesod/Mail.hs deleted file mode 100644 index 256b43b5..00000000 --- a/Yesod/Mail.hs +++ /dev/null @@ -1,120 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} -module Yesod.Mail - ( Boundary (..) - , Mail (..) - , Part (..) - , Encoding (..) - , renderMail - , renderMail' - , sendmail - , Disposition (..) - , renderSendMail - , randomString - ) where - -import qualified Data.ByteString.Lazy as L -import Text.Blaze.Builder.Utf8 -import Text.Blaze.Builder.Core -import Data.Monoid -import System.Random -import Control.Arrow -import System.Process -import System.IO -import System.Exit -import Codec.Binary.Base64 (encode) -import Control.Monad ((<=<)) - -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 - -newtype Boundary = Boundary { unBoundary :: String } -instance Random Boundary where - randomR = const random - random = first Boundary . randomString 10 - -data Mail = Mail - { mailHeaders :: [(String, String)] - , mailPlain :: String - , mailParts :: [Part] - } - -data Encoding = None | Base64 - -data Part = Part - { partType :: String -- ^ content type - , partEncoding :: Encoding - , partDisposition :: Disposition - , partContent :: L.ByteString - } - -data Disposition = Inline | Attachment String - -renderMail :: Boundary -> Mail -> L.ByteString -renderMail (Boundary b) (Mail headers plain parts) = toLazyByteString $ mconcat - [ mconcat $ map showHeader headers - , mconcat $ map showHeader - [ ("MIME-Version", "1.0") - , ("Content-Type", "multipart/mixed; boundary=\"" - ++ b ++ "\"") - ] - , fromByteString "\n" - , fromString plain - , mconcat $ map showPart parts - , fromByteString "\n--" - , fromString b - , fromByteString "--" - ] - where - showHeader (k, v) = mconcat - [ fromString k - , fromByteString ": " - , fromString v - , fromByteString "\n" - ] - showPart (Part contentType encoding disposition content) = mconcat - [ fromByteString "\n--" - , fromString b - , fromByteString "\n" - , showHeader ("Content-Type", contentType) - , case encoding of - None -> mempty - Base64 -> showHeader ("Content-Transfer-Encoding", "base64") - , case disposition of - Inline -> mempty - Attachment filename -> - showHeader ("Content-Disposition", "attachment; filename=" ++ filename) - , fromByteString "\n" - , case encoding of - None -> writeList writeByteString $ L.toChunks content - Base64 -> writeList writeByte $ map (toEnum . fromEnum) $ encode $ L.unpack content - ] - -renderMail' :: Mail -> IO L.ByteString -renderMail' m = do - b <- randomIO - return $ renderMail b m - -sendmail :: L.ByteString -> IO () -sendmail lbs = do - (Just hin, _, _, phandle) <- createProcess $ (proc - "/usr/sbin/sendmail" ["-t"]) { std_in = CreatePipe } - L.hPut hin lbs - hClose hin - exitCode <- waitForProcess phandle - case exitCode of - ExitSuccess -> return () - _ -> error $ "sendmail exited with error code " ++ show exitCode - -renderSendMail :: Mail -> IO () -renderSendMail = sendmail <=< renderMail' diff --git a/yesod.cabal b/yesod.cabal index 79c10539..0f6f3228 100644 --- a/yesod.cabal +++ b/yesod.cabal @@ -45,7 +45,6 @@ library , data-object >= 0.3.1 && < 0.4 , network >= 2.2.1.5 && < 2.3 , email-validate >= 0.2.5 && < 0.3 - , process >= 1.0.1 && < 1.1 , web-routes >= 0.23 && < 0.24 , xss-sanitize >= 0.2 && < 0.3 , data-default >= 0.2 && < 0.3 @@ -64,7 +63,6 @@ library Yesod.Handler Yesod.Internal Yesod.Json - Yesod.Mail Yesod.Request Yesod.Widget Yesod.Yesod