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

data ResponseCode = Unrecognized | InvalidHost | InvalidArguments {argumentError :: ByteString} |
                    InvalidSetOfArguments |
                    InvalidEmail {invalidEmailAddress :: ByteString} | Timeout | NotImplemented |
                    BadSequence | MailboxUnavailable {unavailableMailbox :: ByteString} | TLSNotAvailable |
                    TLSNoSecurity | AuthTypeNotSupported | RequiresTls | BadAuthCredentials |
                    AuthRequired | Congestion | BadConnection | NoConversion | TempUndefined |
                    InvalidCP 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 ", 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."