-- |
-- Module:     Network.Smtp.Types
-- Copyright:  (c) 2010 Ertugrul Soeylemez
-- License:    BSD3
-- Maintainer: Ertugrul Soeylemez <es@ertes.de>
-- Stability:  experimental
--
-- Types used by ismtp.

{-# LANGUAGE DeriveDataTypeable #-}

module Network.Smtp.Types
    ( -- * Mail monad
      Mail,
      MailT,
      StringMailT,

      -- * Other types
      Extension(..),
      MailConfig(..),
      SmtpCommand(..),
      SmtpException(..),
      SmtpResponse(..)
    )
    where

import Control.ContStuff
import Control.Exception as Ex
import Data.ByteString (ByteString)
import Data.Enumerator
import Data.Set (Set)
import Data.Typeable
import Data.Vector (Vector)
import System.IO
import Text.Printf


-- | SMTP service extension.

data Extension
    = Extension  -- ^ We don't support any extensions yet.
    deriving (Eq, Ord)


-- | The 'MailT' monad transformer encapsulates an SMTP session.

type MailT r m = Iteratee SmtpResponse (StateT r MailConfig m)


-- | Convenient type alias for raw streams.  Needed by
-- 'Network.Smtp.Monad.runMailT'.

type StringMailT r m = Iteratee ByteString (StateT r MailConfig m)


-- | The 'Mail' monad is 'MailT' over 'IO'.

type Mail r a = MailT r IO a


-- | Mail session configuration.

data MailConfig =
    MailConfig {
      mailExtensions :: Set Extension,  -- ^ Supported extensions.
      mailHandle     :: Handle          -- ^ Connection handle.
    }


-- | Failed SMTP command (used by 'SmtpException').

data SmtpCommand
    = SmtpWelcomeCmd              -- ^ Waiting for welcome message.
    | SmtpHelloCmd ByteString     -- ^ EHLO or HELO with domain.
    | SmtpMailFromCmd ByteString  -- ^ MAIL FROM with address.
    | SmtpRcptToCmd ByteString    -- ^ RCPT TO with address.
    | SmtpDataCmd                 -- ^ DATA.
    | SmtpResetCmd                -- ^ RSET.
    | SmtpQuitCmd                 -- ^ QUIT.


-- | SMTP exception.

data SmtpException =
    SmtpException {
      smtpErrorMessage       :: String,
      smtpErrorCommand       :: SmtpCommand,
      smtpErrorCode          :: Integer,
      smtpErrorServerMessage :: String
    }
    deriving Typeable

instance Ex.Exception SmtpException

instance Show SmtpException where
    show (SmtpException msg _ code srvMsg) =
        printf "%s (%i): \"%s\"" msg code srvMsg


-- | SMTP response.

data SmtpResponse =
    SmtpResponse {
      smtpCode     :: Integer,           -- ^ Three digit response code.
      smtpMessages :: Vector ByteString  -- ^ Messages sent with the code.
    }
    deriving (Eq, Show)