diff --git a/source/Network/Xmpp/Concurrent.hs b/source/Network/Xmpp/Concurrent.hs index c30c3b4..b883fef 100644 --- a/source/Network/Xmpp/Concurrent.hs +++ b/source/Network/Xmpp/Concurrent.hs @@ -178,7 +178,7 @@ session realm mbSasl config = runErrorT $ do Just (handlers, resource) -> ErrorT $ auth (handlers cs) resource stream case mbAuthError of Nothing -> return () - Just _ -> throwError XmppAuthFailure + Just e -> throwError $ XmppAuthFailure e ses <- ErrorT $ newSession stream config liftIO $ when (enableRoster config) $ initRoster ses return ses diff --git a/source/Network/Xmpp/Sasl/Types.hs b/source/Network/Xmpp/Sasl/Types.hs index 1e53c34..aaa2324 100644 --- a/source/Network/Xmpp/Sasl/Types.hs +++ b/source/Network/Xmpp/Sasl/Types.hs @@ -7,25 +7,6 @@ import Data.ByteString(ByteString) import qualified Data.Text as Text import Network.Xmpp.Types --- | Signals a (non-fatal) SASL authentication error condition. -data AuthFailure = -- | No mechanism offered by the server was matched - -- by the provided acceptable mechanisms; wraps the - -- mechanisms offered by the server - AuthNoAcceptableMechanism [Text.Text] - | AuthStreamFailure XmppFailure -- TODO: Remove - -- | A SASL failure element was encountered - | AuthSaslFailure SaslFailure - -- | The credentials provided did not conform to - -- the SASLprep Stringprep profile - | AuthIllegalCredentials - -- | Other failure; more information is available - -- in the log - | AuthOtherFailure - deriving Show - -instance Error AuthFailure where - noMsg = AuthOtherFailure - data SaslElement = SaslSuccess (Maybe Text.Text) | SaslChallenge (Maybe Text.Text) diff --git a/source/Network/Xmpp/Types.hs b/source/Network/Xmpp/Types.hs index 45999cd..efcd603 100644 --- a/source/Network/Xmpp/Types.hs +++ b/source/Network/Xmpp/Types.hs @@ -54,6 +54,7 @@ module Network.Xmpp.Types , InvalidXmppXml(..) , SessionConfiguration(..) , TlsBehaviour(..) + , AuthFailure(..) ) where @@ -427,7 +428,7 @@ data SaslFailure = SaslFailure { saslFailureCondition :: SaslError , saslFailureText :: Maybe ( Maybe LangTag , Text ) - } deriving Show + } deriving (Eq, Show) data SaslError = SaslAborted -- ^ Client aborted. | SaslAccountDisabled -- ^ The account has been temporarily @@ -456,6 +457,7 @@ data SaslError = SaslAborted -- ^ Client aborted. -- temporary error condition; the -- initiating entity is recommended -- to try again later. + deriving Eq instance Show SaslError where show SaslAborted = "aborted" @@ -692,8 +694,8 @@ data XmppFailure = StreamErrorFailure StreamErrorInfo -- ^ An error XML stream | XmppNoStream -- ^ An action that required an active -- stream were performed when the -- 'StreamState' was 'Closed' - | XmppAuthFailure -- ^ Authentication with the server failed - -- unrecoverably + | XmppAuthFailure AuthFailure -- ^ Authentication with the + -- server failed (unrecoverably) | TlsStreamSecured -- ^ Connection already secured | XmppOtherFailure -- ^ Undefined condition. More -- information should be available in @@ -705,6 +707,25 @@ data XmppFailure = StreamErrorFailure StreamErrorInfo -- ^ An error XML stream instance Exception XmppFailure instance Error XmppFailure where noMsg = XmppOtherFailure +-- | Signals a SASL authentication error condition. +data AuthFailure = -- | No mechanism offered by the server was matched + -- by the provided acceptable mechanisms; wraps the + -- mechanisms offered by the server + AuthNoAcceptableMechanism [Text.Text] + | AuthStreamFailure XmppFailure -- TODO: Remove + -- | A SASL failure element was encountered + | AuthSaslFailure SaslFailure + -- | The credentials provided did not conform to + -- the SASLprep Stringprep profile + | AuthIllegalCredentials + -- | Other failure; more information is available + -- in the log + | AuthOtherFailure + deriving (Eq, Show) + +instance Error AuthFailure where + noMsg = AuthOtherFailure + -- ============================================================================= -- XML TYPES -- =============================================================================