{-# 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."