Types.hs

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

{-# LANGUAGE DeriveDataTypeable #-}

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

      -- * SMTP service extensions
      Extension(..),
      AuthMethod(..),

      -- * Other types
      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


-- | Authentication methods for the SMTP authentication extension.

data AuthMethod
    = AuthMethod  -- ^ We don't know any authentication methods yet.
    deriving (Eq, Ord, Read, Show)


-- | SMTP service extension.

data Extension
    = AuthExt (Set AuthMethod)  -- ^ Authentication extension.
    deriving (Eq, Ord, Read, Show)


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

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


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

type Mail r = MailT r IO


-- | Mail session configuration.

data MailConfig =
    MailConfig {
      mailExtensions   :: Set Extension,  -- ^ Supported extensions.
      mailHandle       :: Handle,         -- ^ Connection handle.
      mailWriteTimeout :: Int             -- ^ Write timeout in milliseconds.
    }


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

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


-- | 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)