module Network.Mail.Client.Gmail (sendGmail) where
import Control.Monad (foldM_, forM, liftM, void)
import Crypto.Random.AESCtr (makeSystem)
import Data.ByteString.Char8 (lines, unpack)
import Data.ByteString.Base64.Lazy (encode)
import Data.ByteString.Lazy.Char8 (ByteString, readFile)
import Data.ByteString.Lazy.Search (replace)
import Data.Char (isDigit, isSpace)
import Data.Default (def)
import Data.Monoid ((<>))
import Data.Text as Strict (Text, pack)
import Data.Text.Lazy as Lazy (Text, fromChunks)
import Data.Text.Lazy.Encoding (encodeUtf8)
import Network (PortID(PortNumber), connectTo)
import Network.Mail.Mime hiding (renderMail)
import Network.TLS
import Network.TLS.Extra
import Prelude hiding (any, lines, readFile)
import System.FilePath (takeExtension, takeFileName)
import System.IO hiding (readFile)
import System.Timeout (timeout)
sendGmail
:: Lazy.Text
-> Lazy.Text
-> Address
-> [Address]
-> [Address]
-> [Address]
-> Strict.Text
-> Lazy.Text
-> [FilePath]
-> Maybe Int
-> IO ()
sendGmail user pass from to cc bcc subject body attach lim = do
hdl <- connectTo "smtp.gmail.com" $ PortNumber 587
sys <- makeSystem
ctx <- contextNew hdl params sys
_MAIL <- renderMail from to cc bcc subject body attach
hSetBuffering hdl LineBuffering
sendSMTP hdl "EHLO" >> recvSMTP hdl lim "220"
>> recvSMTP hdl lim "250"
sendSMTP hdl "STARTTLS" >> recvSMTP hdl lim "220"
handshake ctx
sendSMTPS ctx "EHLO" >> recvSMTPS ctx lim "250"
sendSMTPS ctx "AUTH LOGIN" >> recvSMTPS ctx lim "334"
sendSMTPS ctx _USERNAME >> recvSMTPS ctx lim "334"
sendSMTPS ctx _PASSWORD >> recvSMTPS ctx lim "235"
sendSMTPS ctx _FROM >> recvSMTPS ctx lim "250"
sendSMTPS ctx _TO >> recvSMTPS ctx lim "250"
sendSMTPS ctx "DATA" >> recvSMTPS ctx lim "354"
sendSMTPS ctx _MAIL >> recvSMTPS ctx lim "250"
sendSMTPS ctx "QUIT" >> recvSMTPS ctx lim "221"
bye ctx
contextClose ctx
hClose hdl
where _USERNAME = encode $ encodeUtf8 user
_PASSWORD = encode $ encodeUtf8 pass
_FROM = "MAIL FROM: " <> angleBracket [from]
_TO = "RCPT TO: " <> angleBracket (to ++ cc ++ bcc)
angleBracket :: [Address] -> ByteString
angleBracket = \ case [] -> ""; (Address _ email:_) -> "<" <> encodeUtf8 (fromChunks [email]) <> ">"
renderMail
:: Address
-> [Address]
-> [Address]
-> [Address]
-> Strict.Text
-> Lazy.Text
-> [FilePath]
-> IO ByteString
renderMail from to cc bcc subject body attach = do
parts <- forM attach $ \ path -> do
content <- readFile path
let mime = getMime $ takeExtension path
file = Just . pack $ takeFileName path
return $! [Part mime Base64 file [] content]
let plain = [Part "text/plain; charset=utf-8" QuotedPrintableText Nothing [] $ encodeUtf8 body]
mail <- renderMail' . Mail from to cc bcc headers $ plain : parts
return $! replace "\n." ("\n.."::ByteString) mail <> "\r\n.\r\n"
where headers = [("Subject",subject)]
sendSMTP
:: Handle
-> String
-> IO ()
sendSMTP = hPutStrLn
recvSMTP
:: Handle
-> Maybe Int
-> String
-> IO ()
recvSMTP hdl lim code = void $
step [] where
step accum = do
mval <- maybe (liftM Just) timeout lim $ hGetLine hdl
case mval of
Nothing -> fail "recvSMTP: connection timeout"
Just reply -> match code reply step accum
sendSMTPS
:: Context
-> ByteString
-> IO ()
sendSMTPS ctx msg = sendData ctx $ msg <> "\r\n"
recvSMTPS
:: Context
-> Maybe Int
-> String
-> IO ()
recvSMTPS ctx lim code = do
mval <- maybe (liftM Just) timeout lim $ recvData ctx
case mval of
Nothing -> fail "recvSMTPS: connection timeout"
Just replies -> foldM_ step [] $ lines replies
where step accum reply = match code (unpack reply) return accum
type Continuation = [String] -> IO [String]
match
:: String
-> String
-> Continuation
-> [String]
-> IO [String]
match code reply continuation accum =
if not (null suffix) && head suffix == '-'
then continuation $ drop 1 suffix:accum
else if prefix == code && "" /= code
then return []
else mismatch code prefix $ suffix:accum
where (prefix, suffix) = break (not . isDigit) reply
mismatch
:: String
-> String
-> [String]
-> IO [String]
mismatch code other replies = fail $
if null code
then "mismatch: missing expected reply code."
else "mismatch: expected reply code " ++ code ++
(if null other
then ", but no reply code was received"
else ", but received reply code " ++ other) ++
case filter (not . null) $ map strip replies of
[] -> "."
(r:rs) -> ": " ++ foldl step (strip r) rs ++ "."
where strip = dropWhile isSpace . filter (/='\r')
step accum = flip (++) $ "; " ++ accum
params :: ClientParams
params = (defaultParamsClient "smtp.gmail.com" "587")
{ clientSupported = def { supportedCiphers = ciphersuite_all }
, clientShared = def { sharedValidationCache = noValidate }
} where noValidate = ValidationCache (\_ _ _ -> return ValidationCachePass)
(\_ _ _ -> return ())
getMime :: String -> Strict.Text
getMime = \ case
".3dm" -> "x-world/x-3dmf"
".3dmf" -> "x-world/x-3dmf"
".a" -> "application/octet-stream"
".aab" -> "application/x-authorware-bin"
".aam" -> "application/x-authorware-map"
".aas" -> "application/x-authorware-seg"
".abc" -> "text/vnd.abc"
".acgi" -> "text/html"
".afl" -> "video/animaflex"
".ai" -> "application/postscript"
".aif" -> "audio/aiff"
".aifc" -> "audio/aiff"
".aiff" -> "audio/aiff"
".aim" -> "application/x-aim"
".aip" -> "text/x-audiosoft-intra"
".ani" -> "application/x-navi-animation"
".aos" -> "application/x-nokia-9000-communicator-add-on-software"
".aps" -> "application/mime"
".arc" -> "application/octet-stream"
".arj" -> "application/arj"
".art" -> "image/x-jg"
".asf" -> "video/x-ms-asf"
".asm" -> "text/x-asm"
".asp" -> "text/asp"
".asx" -> "application/x-mplayer2"
".au" -> "audio/basic"
".avi" -> "application/x-troff-msvideo"
".avs" -> "video/avs-video"
".bcpio" -> "application/x-bcpio"
".bin" -> "application/mac-binary"
".bm" -> "image/bmp"
".bmp" -> "image/bmp"
".boo" -> "application/book"
".book" -> "application/book"
".boz" -> "application/x-bzip2"
".bsh" -> "application/x-bsh"
".bz" -> "application/x-bzip"
".bz2" -> "application/x-bzip2"
".c" -> "text/plain"
".c++" -> "text/plain"
".cat" -> "application/vnd.ms-pki.seccat"
".cc" -> "text/plain"
".ccad" -> "application/clariscad"
".cco" -> "application/x-cocoa"
".cdf" -> "application/cdf"
".cer" -> "application/pkix-cert"
".cha" -> "application/x-chat"
".chat" -> "application/x-chat"
".class" -> "application/java"
".com" -> "application/octet-stream"
".conf" -> "text/plain"
".cpio" -> "application/x-cpio"
".cpp" -> "text/x-c"
".cpt" -> "application/mac-compactpro"
".crl" -> "application/pkcs-crl"
".crt" -> "application/pkix-cert"
".csh" -> "application/x-csh"
".css" -> "application/x-pointplus"
".cxx" -> "text/plain"
".dcr" -> "application/x-director"
".deepv" -> "application/x-deepv"
".def" -> "text/plain"
".der" -> "application/x-x509-ca-cert"
".dif" -> "video/x-dv"
".dir" -> "application/x-director"
".dl" -> "video/dl"
".doc" -> "application/msword"
".dot" -> "application/msword"
".dp" -> "application/commonground"
".drw" -> "application/drafting"
".dump" -> "application/octet-stream"
".dv" -> "video/x-dv"
".dvi" -> "application/x-dvi"
".dwf" -> "drawing/x-dwf (old)"
".dwg" -> "application/acad"
".dxf" -> "application/dxf"
".dxr" -> "application/x-director"
".el" -> "text/x-script.elisp"
".elc" -> "application/x-bytecode.elisp (compiled elisp)"
".env" -> "application/x-envoy"
".eps" -> "application/postscript"
".es" -> "application/x-esrehber"
".etx" -> "text/x-setext"
".evy" -> "application/envoy"
".exe" -> "application/octet-stream"
".f" -> "text/plain"
".f77" -> "text/x-fortran"
".f90" -> "text/plain"
".fdf" -> "application/vnd.fdf"
".fif" -> "application/fractals"
".fli" -> "video/fli"
".flo" -> "image/florian"
".flx" -> "text/vnd.fmi.flexstor"
".fmf" -> "video/x-atomic3d-feature"
".for" -> "text/plain"
".fpx" -> "image/vnd.fpx"
".frl" -> "application/freeloader"
".funk" -> "audio/make"
".g" -> "text/plain"
".g3" -> "image/g3fax"
".gif" -> "image/gif"
".gl" -> "video/gl"
".gsd" -> "audio/x-gsm"
".gsm" -> "audio/x-gsm"
".gsp" -> "application/x-gsp"
".gss" -> "application/x-gss"
".gtar" -> "application/x-gtar"
".gz" -> "application/x-compressed"
".gzip" -> "application/x-gzip"
".h" -> "text/plain"
".hdf" -> "application/x-hdf"
".help" -> "application/x-helpfile"
".hgl" -> "application/vnd.hp-hpgl"
".hh" -> "text/plain"
".hlb" -> "text/x-script"
".hlp" -> "application/hlp"
".hpg" -> "application/vnd.hp-hpgl"
".hpgl" -> "application/vnd.hp-hpgl"
".hqx" -> "application/binhex"
".hs" -> "text/x-haskell"
".hta" -> "application/hta"
".htc" -> "text/x-component"
".htm" -> "text/html"
".html" -> "text/html"
".htmls" -> "text/html"
".htt" -> "text/webviewhtml"
".htx" -> "text/html"
".ice" -> "x-conference/x-cooltalk"
".ico" -> "image/x-icon"
".idc" -> "text/plain"
".ief" -> "image/ief"
".iefs" -> "image/ief"
".iges" -> "application/iges"
".igs" -> "application/iges"
".ima" -> "application/x-ima"
".imap" -> "application/x-httpd-imap"
".inf" -> "application/inf"
".ins" -> "application/x-internett-signup"
".ip" -> "application/x-ip2"
".isu" -> "video/x-isvideo"
".it" -> "audio/it"
".iv" -> "application/x-inventor"
".ivr" -> "i-world/i-vrml"
".ivy" -> "application/x-livescreen"
".jam" -> "audio/x-jam"
".jav" -> "text/plain"
".java" -> "text/plain"
".jcm" -> "application/x-java-commerce"
".jfif" -> "image/jpeg"
".jfif-tbnl" -> "image/jpeg"
".jpe" -> "image/jpeg"
".jpeg" -> "image/jpeg"
".jpg" -> "image/jpeg"
".jps" -> "image/x-jps"
".js" -> "application/x-javascript"
".jut" -> "image/jutvision"
".kar" -> "audio/midi"
".ksh" -> "application/x-ksh"
".la" -> "audio/nspaudio"
".lam" -> "audio/x-liveaudio"
".latex" -> "application/x-latex"
".lha" -> "application/lha"
".lhx" -> "application/octet-stream"
".list" -> "text/plain"
".lma" -> "audio/nspaudio"
".log" -> "text/plain"
".lsp" -> "application/x-lisp"
".lst" -> "text/plain"
".lsx" -> "text/x-la-asf"
".ltx" -> "application/x-latex"
".lzh" -> "application/octet-stream"
".lzx" -> "application/lzx"
".m" -> "text/plain"
".m1v" -> "video/mpeg"
".m2a" -> "audio/mpeg"
".m2v" -> "video/mpeg"
".m3u" -> "audio/x-mpequrl"
".man" -> "application/x-troff-man"
".map" -> "application/x-navimap"
".mar" -> "text/plain"
".mbd" -> "application/mbedlet"
".mc$" -> "application/x-magic-cap-package-1.0"
".mcd" -> "application/mcad"
".mcf" -> "image/vasa"
".mcp" -> "application/netmc"
".me" -> "application/x-troff-me"
".mht" -> "message/rfc822"
".mhtml" -> "message/rfc822"
".mid" -> "application/x-midi"
".midi" -> "application/x-midi"
".mif" -> "application/x-frame"
".mime" -> "message/rfc822"
".mjf" -> "audio/x-vnd.audioexplosion.mjuicemediafile"
".mjpg" -> "video/x-motion-jpeg"
".mm" -> "application/base64"
".mme" -> "application/base64"
".mod" -> "audio/mod"
".moov" -> "video/quicktime"
".mov" -> "video/quicktime"
".movie" -> "video/x-sgi-movie"
".mp2" -> "audio/mpeg"
".mp3" -> "audio/mpeg3"
".mpa" -> "audio/mpeg"
".mpc" -> "application/x-project"
".mpe" -> "video/mpeg"
".mpeg" -> "video/mpeg"
".mpg" -> "audio/mpeg"
".mpga" -> "audio/mpeg"
".mpp" -> "application/vnd.ms-project"
".mpt" -> "application/x-project"
".mpv" -> "application/x-project"
".mpx" -> "application/x-project"
".mrc" -> "application/marc"
".ms" -> "application/x-troff-ms"
".mv" -> "video/x-sgi-movie"
".my" -> "audio/make"
".mzz" -> "application/x-vnd.audioexplosion.mzz"
".nap" -> "image/naplps"
".naplps" -> "image/naplps"
".nc" -> "application/x-netcdf"
".ncm" -> "application/vnd.nokia.configuration-message"
".nif" -> "image/x-niff"
".niff" -> "image/x-niff"
".nix" -> "application/x-mix-transfer"
".nsc" -> "application/x-conference"
".nvd" -> "application/x-navidoc"
".o" -> "application/octet-stream"
".oda" -> "application/oda"
".omc" -> "application/x-omc"
".omcd" -> "application/x-omcdatamaker"
".omcr" -> "application/x-omcregerator"
".p" -> "text/x-pascal"
".p10" -> "application/pkcs10"
".p12" -> "application/pkcs-12"
".p7a" -> "application/x-pkcs7-signature"
".p7c" -> "application/pkcs7-mime"
".p7m" -> "application/pkcs7-mime"
".p7r" -> "application/x-pkcs7-certreqresp"
".p7s" -> "application/pkcs7-signature"
".part" -> "application/pro_eng"
".pas" -> "text/pascal"
".pbm" -> "image/x-portable-bitmap"
".pcl" -> "application/vnd.hp-pcl"
".pct" -> "image/x-pict"
".pcx" -> "image/x-pcx"
".pdb" -> "chemical/x-pdb"
".pdf" -> "application/pdf"
".pfunk" -> "audio/make"
".pgm" -> "image/x-portable-graymap"
".pic" -> "image/pict"
".pict" -> "image/pict"
".pkg" -> "application/x-newton-compatible-pkg"
".pko" -> "application/vnd.ms-pki.pko"
".pl" -> "text/plain"
".plx" -> "application/x-pixclscript"
".pm" -> "image/x-xpixmap"
".pm4" -> "application/x-pagemaker"
".pm5" -> "application/x-pagemaker"
".png" -> "image/png"
".pnm" -> "application/x-portable-anymap"
".pot" -> "application/mspowerpoint"
".pov" -> "model/x-pov"
".ppa" -> "application/vnd.ms-powerpoint"
".ppm" -> "image/x-portable-pixmap"
".pps" -> "application/mspowerpoint"
".ppt" -> "application/mspowerpoint"
".ppz" -> "application/mspowerpoint"
".pre" -> "application/x-freelance"
".prt" -> "application/pro_eng"
".ps" -> "application/postscript"
".psd" -> "application/octet-stream"
".pvu" -> "paleovu/x-pv"
".pwz" -> "application/vnd.ms-powerpoint"
".py" -> "text/x-script.phyton"
".pyc" -> "applicaiton/x-bytecode.python"
".qcp" -> "audio/vnd.qcelp"
".qd3" -> "x-world/x-3dmf"
".qd3d" -> "x-world/x-3dmf"
".qif" -> "image/x-quicktime"
".qt" -> "video/quicktime"
".qtc" -> "video/x-qtc"
".qti" -> "image/x-quicktime"
".qtif" -> "image/x-quicktime"
".ra" -> "audio/x-pn-realaudio"
".ram" -> "audio/x-pn-realaudio"
".ras" -> "application/x-cmu-raster"
".rast" -> "image/cmu-raster"
".rexx" -> "text/x-script.rexx"
".rf" -> "image/vnd.rn-realflash"
".rgb" -> "image/x-rgb"
".rm" -> "application/vnd.rn-realmedia"
".rmi" -> "audio/mid"
".rmm" -> "audio/x-pn-realaudio"
".rmp" -> "audio/x-pn-realaudio"
".rng" -> "application/ringing-tones"
".rnx" -> "application/vnd.rn-realplayer"
".roff" -> "application/x-troff"
".rp" -> "image/vnd.rn-realpix"
".rpm" -> "audio/x-pn-realaudio-plugin"
".rt" -> "text/richtext"
".rtf" -> "application/rtf"
".rtx" -> "application/rtf"
".rv" -> "video/vnd.rn-realvideo"
".s" -> "text/x-asm"
".s3m" -> "audio/s3m"
".saveme" -> "application/octet-stream"
".sbk" -> "application/x-tbook"
".scm" -> "application/x-lotusscreencam"
".sdml" -> "text/plain"
".sdp" -> "application/sdp"
".sdr" -> "application/sounder"
".sea" -> "application/sea"
".set" -> "application/set"
".sgm" -> "text/sgml"
".sgml" -> "text/sgml"
".sh" -> "application/x-bsh"
".shar" -> "application/x-bsh"
".shtml" -> "text/html"
".sid" -> "audio/x-psid"
".sit" -> "application/x-sit"
".skd" -> "application/x-koan"
".skm" -> "application/x-koan"
".skp" -> "application/x-koan"
".skt" -> "application/x-koan"
".sl" -> "application/x-seelogo"
".smi" -> "application/smil"
".smil" -> "application/smil"
".snd" -> "audio/basic"
".sol" -> "application/solids"
".spc" -> "application/x-pkcs7-certificates"
".spl" -> "application/futuresplash"
".spr" -> "application/x-sprite"
".sprite" -> "application/x-sprite"
".src" -> "application/x-wais-source"
".ssi" -> "text/x-server-parsed-html"
".ssm" -> "application/streamingmedia"
".sst" -> "application/vnd.ms-pki.certstore"
".step" -> "application/step"
".stl" -> "application/sla"
".stp" -> "application/step"
".sv4cpio" -> "application/x-sv4cpio"
".sv4crc" -> "application/x-sv4crc"
".svf" -> "image/vnd.dwg"
".svr" -> "application/x-world"
".swf" -> "application/x-shockwave-flash"
".t" -> "application/x-troff"
".talk" -> "text/x-speech"
".tar" -> "application/x-tar"
".tbk" -> "application/toolbook"
".tcl" -> "application/x-tcl"
".tcsh" -> "text/x-script.tcsh"
".tex" -> "application/x-tex"
".texi" -> "application/x-texinfo"
".texinfo" -> "application/x-texinfo"
".text" -> "application/plain"
".tgz" -> "application/gnutar"
".tif" -> "image/tiff"
".tiff" -> "image/tiff"
".tr" -> "application/x-troff"
".tsi" -> "audio/tsp-audio"
".tsp" -> "application/dsptype"
".tsv" -> "text/tab-separated-values"
".turbot" -> "image/florian"
".txt" -> "text/plain"
".uil" -> "text/x-uil"
".uni" -> "text/uri-list"
".unis" -> "text/uri-list"
".unv" -> "application/i-deas"
".uri" -> "text/uri-list"
".uris" -> "text/uri-list"
".ustar" -> "application/x-ustar"
".uu" -> "application/octet-stream"
".uue" -> "text/x-uuencode"
".vcd" -> "application/x-cdlink"
".vcs" -> "text/x-vcalendar"
".vda" -> "application/vda"
".vdo" -> "video/vdo"
".vew" -> "application/groupwise"
".viv" -> "video/vivo"
".vivo" -> "video/vivo"
".vmd" -> "application/vocaltec-media-desc"
".vmf" -> "application/vocaltec-media-file"
".voc" -> "audio/voc"
".vos" -> "video/vosaic"
".vox" -> "audio/voxware"
".vqe" -> "audio/x-twinvq-plugin"
".vqf" -> "audio/x-twinvq"
".vql" -> "audio/x-twinvq-plugin"
".vrml" -> "application/x-vrml"
".vrt" -> "x-world/x-vrt"
".vsd" -> "application/x-visio"
".vst" -> "application/x-visio"
".vsw" -> "application/x-visio"
".w60" -> "application/wordperfect6.0"
".w61" -> "application/wordperfect6.1"
".w6w" -> "application/msword"
".wav" -> "audio/wav"
".wb1" -> "application/x-qpro"
".wbmp" -> "image/vnd.wap.wbmp"
".web" -> "application/vnd.xara"
".wiz" -> "application/msword"
".wk1" -> "application/x-123"
".wmf" -> "windows/metafile"
".wml" -> "text/vnd.wap.wml"
".wmlc" -> "application/vnd.wap.wmlc"
".wmls" -> "text/vnd.wap.wmlscript"
".wmlsc" -> "application/vnd.wap.wmlscriptc"
".word" -> "application/msword"
".wp" -> "application/wordperfect"
".wp5" -> "application/wordperfect"
".wp6" -> "application/wordperfect"
".wpd" -> "application/wordperfect"
".wq1" -> "application/x-lotus"
".wri" -> "application/mswrite"
".wrl" -> "application/x-world"
".wrz" -> "model/vrml"
".wsc" -> "text/scriplet"
".wsrc" -> "application/x-wais-source"
".wtk" -> "application/x-wintalk"
".xbm" -> "image/x-xbitmap"
".xdr" -> "video/x-amt-demorun"
".xgz" -> "xgl/drawing"
".xif" -> "image/vnd.xiff"
".xl" -> "application/excel"
".xla" -> "application/excel"
".xlb" -> "application/excel"
".xlc" -> "application/excel"
".xld" -> "application/excel"
".xlk" -> "application/excel"
".xll" -> "application/excel"
".xlm" -> "application/excel"
".xls" -> "application/excel"
".xlt" -> "application/excel"
".xlv" -> "application/excel"
".xlw" -> "application/excel"
".xm" -> "audio/xm"
".xml" -> "application/xml"
".xmz" -> "xgl/movie"
".xpix" -> "application/x-vnd.ls-xpix"
".xpm" -> "image/x-xpixmap"
".x-png" -> "image/png"
".xsr" -> "video/x-amt-showrun"
".xwd" -> "image/x-xwd"
".xyz" -> "chemical/x-pdb"
".z" -> "application/x-compress"
".zip" -> "application/x-compressed"
".zoo" -> "application/octet-stream"
".zsh" -> "text/x-script.zsh"
_ -> "application/octet-stream"