module Network.HaskellNet.SMTP.SSL
( connectSMTPSSL
, connectSMTPSSLPort
, connectSMTPSTARTTLS
, connectSMTPSTARTTLSPort
, doSMTPSSL
, doSMTPSSLPort
, doSMTPSTARTTLS
, doSMTPSTARTTLSPort
) where
import Network.Socket.Internal (PortNumber)
import Network.HaskellNet.SMTP
import Network.HaskellNet.SSL
import Network.HaskellNet.BSStream
import Network.BSD (getHostName)
import qualified Data.ByteString.Char8 as B
import Control.Exception
import Control.Monad
import Data.IORef
connectSMTPSSL :: String -> IO SMTPConnection
connectSMTPSSL hostname = connectSMTPSSLPort hostname 465
connectSMTPSSLPort :: String -> PortNumber -> IO SMTPConnection
connectSMTPSSLPort hostname port = connectSSL hostname port >>= connectStream
connectSMTPSTARTTLS :: String -> IO SMTPConnection
connectSMTPSTARTTLS hostname = connectSMTPSTARTTLSPort hostname 587
connectSMTPSTARTTLSPort :: String -> PortNumber -> IO SMTPConnection
connectSMTPSTARTTLSPort hostname port = connectSTARTTLS hostname port >>= connectStream
connectSTARTTLS :: String -> PortNumber -> IO BSStream
connectSTARTTLS hostname port = do
(bs, startTLS) <- connectPlain hostname port
greeting <- bsGetLine bs
failIfNot bs 220 $ parseResponse greeting
hn <- getHostName
bsPut bs $ B.pack ("HELO " ++ hn ++ "\r\n")
getResponse bs >>= failIfNot bs 250
bsPut bs $ B.pack "STARTTLS\r\n"
getResponse bs >>= failIfNot bs 220
startTLS
prefixRef <- newIORef [greeting]
return $ bs {bsGetLine = prefixedGetLine prefixRef (bsGetLine bs)}
where parseResponse = parse . B.unpack
parse s = (getCode s, s)
getCode = read . head . words
getResponse bs = liftM parseResponse $ bsGetLine bs
failIfNot :: BSStream -> Integer -> (Integer, String) -> IO ()
failIfNot bs code (rc, rs) = when (code /= rc) closeAndFail
where closeAndFail = bsClose bs >> fail ("cannot connect to server: " ++ rs)
prefixedGetLine :: IORef [B.ByteString] -> IO B.ByteString -> IO B.ByteString
prefixedGetLine prefix rawGetLine = readIORef prefix >>= deliverLine
where deliverLine [] = rawGetLine
deliverLine (l:ls) = writeIORef prefix ls >> return l
bracketSMTP :: IO SMTPConnection -> (SMTPConnection -> IO a) -> IO a
bracketSMTP = flip bracket closeSMTP
doSMTPSSL :: String -> (SMTPConnection -> IO a) -> IO a
doSMTPSSL host = bracketSMTP $ connectSMTPSSL host
doSMTPSSLPort :: String -> PortNumber -> (SMTPConnection -> IO a) -> IO a
doSMTPSSLPort host port = bracketSMTP $ connectSMTPSSLPort host port
doSMTPSTARTTLS :: String -> (SMTPConnection -> IO a) -> IO a
doSMTPSTARTTLS host = bracketSMTP $ connectSMTPSTARTTLS host
doSMTPSTARTTLSPort :: String -> PortNumber -> (SMTPConnection -> IO a) -> IO a
doSMTPSTARTTLSPort host port = bracketSMTP $ connectSMTPSTARTTLSPort host port