Right, you need to STARTTLS and upgrade to a secure connection before trying to authenticate, but smtp-mail will not take care of this for you. You could do it manually, using the tls package, or you could try smtp-mail-ng[1][2].

Alex

[1] https://github.com/avieth/smtp-mail-ng
[2] https://hackage.haskell.org/package/smtp-mail-ng-0.1.0.1

On Mon, Apr 18, 2016 at 6:36 PM, David Escobar <davidescobar1976@gmail.com> wrote:
No explicit mention is made anywhere in the documentation about TLS or even SSL, so perhaps not? Some libraries I've come across specifically mention that they don't support TLS or SSL. Being relatively new to this part of Haskell, what is the most standard library the community uses for email that supports modern protocols such as those used by GMail? Thanks.

On Mon, Apr 18, 2016 at 2:49 PM, Alex Feldman-Crough <alex@fldcr.com> wrote:
Does the library support TLS? Does it have to be configured differently? It sounds like a negotiation error to me.
On Mon, Apr 18, 2016 at 2:43 PM David Escobar <davidescobar1976@gmail.com> wrote:
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@somewhere.com”)
            [(“Person recipient“, “recipient@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"
                                     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@haskell.org
http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe
--
Alex Feldman Crough
602 573-9588


_______________________________________________
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe