[Haskell-cafe] Sending email

Daniel P. Wright dani at dpwright.com
Tue Apr 19 05:59:28 UTC 2016


Not to throw another spanner in the works with Yet Another Package to try,
but another option is HaskellNet[1] with HaskellNet-SSL[2] for your TLS
connection.  I originally wrote the HaskellNet-SSL wrapper but it's
currently being maintained by Leza Morais Lutonda.  It works with gmail.  I
haven't tried any of the other SMTP options and I mostly used it for IMAP,
not SMTP, so I can't compare them directly or recommend one over the other
-- just throwing it out there as another option!

[1]: http://hackage.haskell.org/package/HaskellNet
[2]: http://hackage.haskell.org/package/HaskellNet-SSL

2016-04-19 6:42 GMT+09:00 David Escobar <davidescobar1976 at gmail.com>:

> Hi everyone,
> I'm trying to use the *Network.Mail.SMTP* library to send email:
>
> *{-# LANGUAGE OverloadedStrings #-}*
>
> *module Main where*
>
> *import Control.Exception*
>
> *import qualified Data.Text as T*
> *import qualified Data.Text.Lazy as LT*
> *import Network.Mail.SMTP*
>
> *main :: IO ()*
> *main = do*
> *  sendEmail (“Person sender”, “sender at somewhere.com
> <sender at somewhere.com>”)*
> *            [(“Person recipient“, “recipient at somewhere.com
> <recipient at somewhere.com>”)]*
> *            "Test email"*
> *            "Some message goes here."*
>
>
> *sendEmail :: (T.Text, T.Text) -> [(T.Text, T.Text)] -> T.Text -> T.Text
> -> IO ()*
> *sendEmail (fromName, fromEmail) toAddresses subject' body' = do*
> *  let toNameAddrs = map (\(toName, toEmail) -> Address (Just toName)
> toEmail) toAddresses*
> *      msg = simpleMail (Address (Just fromName) fromEmail)*
> *                       toNameAddrs*
> *                       []*
> *                       []*
> *                       subject'*
> *                       [ plainTextPart $ LT.fromStrict body' ]*
> *  result <- try $ sendMailWithLogin' "smtp.gmail.com
> <http://smtp.gmail.com>"*
> *                                     465 -- SSL port*
> *                                     “sender_login”*
> *                                     “sender_password”*
> *                                     msg :: IO (Either SomeException ())*
> *  case result of*
> *    Left e -> putStrLn $ "Exception caught: " ++ (displayException e)*
> *    Right _ -> putStrLn "Sent email successfully."*
>
>
> The program compiles, but when I run it, I get:
>
> *Exception caught: <socket: 49>: Data.ByteString.hGetLine: end of file*
>
> I tried using the TLS port of 587, but then I just get an authentication
> failure. Am I using the wrong library or is it just the wrong
> configuration. Thanks.
>
> _______________________________________________
> Haskell-Cafe mailing list
> Haskell-Cafe at haskell.org
> http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe
>
>
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/haskell-cafe/attachments/20160419/d2a7b740/attachment.html>


More information about the Haskell-Cafe mailing list