-- |
-- Module:     Network.Smtp.Session
-- Copyright:  (c) 2010 Ertugrul Soeylemez
-- License:    BSD3
-- Maintainer: Ertugrul Soeylemez <es@ertes.de>
-- Stability:  experimental
--
-- SMTP session computations.

{-# LANGUAGE OverloadedStrings, ScopedTypeVariables #-}

module Network.Smtp.Session
    ( -- * Initialization
      hello,
      mailData,
      mailDataStr,
      mailFrom,
      quit,
      rcptTo,
      reset,
      waitForWelcome
    )
    where

import qualified Data.Set as S
import qualified Data.Vector as V
import Control.ContStuff
import Data.ByteString (ByteString)
import Data.Enumerator as E
import Data.List as L
import Data.Maybe
import Network.Smtp.Monad
import Network.Smtp.Tools
import Network.Smtp.Types


-- | Try /EHLO/ with fallback to /HELO/.

hello :: forall m r. MonadIO m => ByteString -> MailT r m ()
hello domain = do
    mailPutLn ["EHLO ", domain]
    SmtpResponse code msgs <- nextResponse
    let exts = S.fromList . catMaybes .
               L.map stringToExtension . V.toList $ msgs

    case code of
      250 -> lift $ modify (\cfg -> cfg { mailExtensions = exts })
      500 -> tryHelo
      502 -> tryHelo
      554 -> tryHelo
      _   -> mailError (SmtpHelloCmd domain) "EHLO rejected" code msgs

    where
    tryHelo :: MailT r m ()
    tryHelo = do
        mailPutLn ["HELO ", domain]
        SmtpResponse code msgs <- nextResponse
        case code of
          250 -> return ()
          _   -> mailError (SmtpHelloCmd domain) "HELO rejected" code msgs


-- | Send the /DATA/ command along with the mail content.  Please note
-- that the last line must be properly terminated by CRLF.

mailData :: MonadIO m => Enumerator ByteString (MailT r m) () -> MailT r m ()
mailData enumMail = do
    mailPutLn ["DATA"]
    SmtpResponse code msgs <- nextResponse
    case code of
      354 -> do
          mailPut (enumMail >==> enumList 1 [".\r\n"])
          SmtpResponse code2 msgs2 <- nextResponse
          case code2 of
            250 -> return ()
            _   -> mailError SmtpDataCmd "Mail data rejected" code2 msgs2
      _ -> mailError SmtpDataCmd "Mail rejected" code msgs


-- | 'ByteString' interface to 'mailData'.

mailDataStr :: MonadIO m => ByteString -> MailT r m ()
mailDataStr = mailData . enumList 1 . (:[])


-- | Send /MAIL FROM/ command.

mailFrom :: MonadIO m => ByteString -> MailT r m ()
mailFrom from = do
    mailPutLn ["MAIL FROM:<", from, ">"]
    SmtpResponse code msgs <- nextResponse
    case code of
      250 -> return ()
      _   -> mailError (SmtpMailFromCmd from) "MAIL FROM rejected" code msgs


-- | Send /QUIT/ command.

quit :: MonadIO m => MailT r m ()
quit = do
    mailPutLn ["QUIT"]
    SmtpResponse code msgs <- nextResponse
    case code of
      221 -> return ()
      _   -> mailError SmtpQuitCmd "Quit rejected" code msgs


-- | Send /RCPT TO/ command.

rcptTo :: MonadIO m => ByteString -> MailT r m ()
rcptTo to = do
    mailPutLn ["RCPT TO:<", to, ">"]
    SmtpResponse code msgs <- nextResponse
    case code of
      250 -> return ()
      _   -> mailError (SmtpRcptToCmd to) "RCPT TO rejected" code msgs


-- | Send /RSET/ command.

reset :: MonadIO m => MailT r m ()
reset = do
    mailPutLn ["RSET"]
    SmtpResponse code msgs <- nextResponse
    case code of
      250 -> return ()
      _   -> mailError SmtpResetCmd "RSET rejected" code msgs


-- | Wait for the welcome greeting from the SMTP server.

waitForWelcome :: Monad m => MailT r m ()
waitForWelcome = do
    SmtpResponse code msgs <- nextResponse
    case code of
      220 -> return ()
      _   -> mailError SmtpWelcomeCmd "We're not welcome" code msgs