fcmtp-data/src/Data/SMTP/ResponseCode.hs

{-# LANGUAGE OverloadedStrings #-}

module Data.SMTP.ResponseCode where

import Data.ByteString (ByteString)
import qualified Data.ByteString as BS
import Data.SMTP.Response

import Text.StringConvert

data ResponseCode =
  Unrecognized -- ^ Generic unrecognized command error
  | InvalidHost -- ^ Invalid host at HELO or EHLO argument
  | InvalidArguments ByteString -- ^ Generic invalid argument error
  | InvalidSetOfArguments -- ^ Invalid argument sequence error
  | InvalidEmail ByteString -- ^ @InvalidEmail m@ means @m@ is not in the correct format for an email address
  | Timeout -- ^ Timeout at server or client
  | NotImplemented -- ^ Command not implemented
  | BadSequence -- ^ Bad sequences of commands
  | MailboxUnavailable String -- ^ @MailbxUnavailable m@ means m has the correct format, but does not exist
  | TLSNotAvailable -- ^ Server can not do TLS
  | TLSNoSecurity -- ^ The agreed TLS parameters are not good enough
  | AuthTypeNotSupported -- ^ Server does not support the given authentication method
  | RequiresTls -- ^ This feature is only avilable in TLS connections
  | BadAuthCredentials -- ^ Bad authentication credentials
  | AuthRequired -- ^ This feature is only available for authenticated users
  | Congestion -- ^ Mailsystem congestion error
  | BadConnection -- ^ There were connection problems
  | NoConversion -- ^ This conversion of email encoding is not supported
  | TempUndefined -- ^ Generic undefined temporary error
  | InvalidCP -- ^ Capability has an invalid format
  | BadSeal -- ^ Seal data is invalid
    deriving (Eq, Ord, Read, Show)

errorMessage :: ResponseCode -> ByteString
errorMessage = renderResponse . toResponse

continueOnError :: ResponseCode -> Bool
continueOnError Timeout = False
continueOnError _ = True

toResponse :: ResponseCode -> Response
toResponse Unrecognized = Response PermanentError [] 500 (Just (5, 5, 1)) "Unrecognized command"
toResponse InvalidHost = Response PermanentError [] 501 (Just (5, 5, 2)) "Invalid hostname"
toResponse (InvalidArguments a) = Response PermanentError [] 502 (Just (5, 5, 4)) $ BS.concat ["Invalid argument: ", a, "."]
toResponse InvalidSetOfArguments = Response PermanentError [] 502 (Just (5, 5, 4)) "Invalid argument sequence."
toResponse (InvalidEmail a) = Response PermanentError [] 501 (Just (5, 1, 3)) $ BS.concat ["Invalid email address: ", a, "."]
toResponse Timeout = Response TransientError [] 421 (Just (4, 2, 1)) "Connection timeout, closing transmission channel."
toResponse NotImplemented = Response PermanentError [] 502 (Just (5, 5, 1)) "Command not implemented"
toResponse BadSequence = Response PermanentError [] 503 (Just (5, 5, 1)) "Bad sequence of commands"
toResponse (MailboxUnavailable a) = Response PermanentError [] 551 (Just (5, 5, 1)) $ BS.concat ["Nope, don't know ", s a, "."]
toResponse TLSNotAvailable = Response TransientError [] 454 (Just (4, 7, 0)) "TLS not available due to temporary reason."
toResponse TLSNoSecurity = Response PermanentError [] 554 (Just (5, 7, 0)) "Get a non-broken TLS lib."
toResponse AuthTypeNotSupported = Response PermanentError [] 504 (Just (5, 5, 4)) "Autentication mechanism is not supported."
toResponse RequiresTls = Response PermanentError [] 538 (Just (5, 7, 11)) "StartTLS before this authentication."
toResponse BadAuthCredentials = Response PermanentError [] 535 (Just (5, 7, 8)) "Bad credentials."
toResponse AuthRequired = Response PermanentError [] 530 (Just (5, 7, 0)) "You must be authenticated."
toResponse Congestion = Response TransientError [] 451 (Just (4, 4, 5)) "Mail system congestion."
toResponse BadConnection = Response TransientError [] 421 (Just (4, 4, 2)) "Connection problems."
toResponse NoConversion = Response PermanentError [] 554 (Just (5, 6, 1)) "Conversion is not supported."
toResponse TempUndefined = Response TransientError [] 451 (Just (4, 2, 0)) "Undefined mailsystem error."
toResponse InvalidCP = Response PermanentError [] 500 (Just (5, 7, 7)) "Capability corrupted or invalid."
toResponse BadSeal = Response PermanentError [] 535 (Just (5, 7, 8)) "Seal data is invalid."