From 14bdc12af7d3b1a6b02ce189139315a282b3f2c4 Mon Sep 17 00:00:00 2001 From: Philipp Balzarek Date: Wed, 13 Mar 2013 20:50:38 +0100 Subject: [PATCH] let session fail on authentication failure --- source/Network/Xmpp/Concurrent.hs | 9 ++++++--- source/Network/Xmpp/Types.hs | 2 ++ 2 files changed, 8 insertions(+), 3 deletions(-) diff --git a/source/Network/Xmpp/Concurrent.hs b/source/Network/Xmpp/Concurrent.hs index b2f32da..4344875 100644 --- a/source/Network/Xmpp/Concurrent.hs +++ b/source/Network/Xmpp/Concurrent.hs @@ -134,12 +134,15 @@ session :: HostName -- ^ The hostname / realm -> Maybe ([SaslHandler], Maybe Text) -- ^ SASL handlers and the desired -- JID resource (or Nothing to let -- the server decide) - -> IO (Either XmppFailure (Session, Maybe AuthFailure)) + -> IO (Either XmppFailure Session) session realm config mbSasl = runErrorT $ do stream <- ErrorT $ openStream realm (sessionStreamConfiguration config) ErrorT $ tls stream - aut <- case mbSasl of + mbAuthError <- case mbSasl of Nothing -> return Nothing Just (handlers, resource) -> ErrorT $ auth handlers resource stream + case mbAuthError of + Nothing -> return () + Just _ -> throwError XmppAuthFailure ses <- ErrorT $ newSession stream config - return (ses, aut) + return ses diff --git a/source/Network/Xmpp/Types.hs b/source/Network/Xmpp/Types.hs index 55f048f..92d9a40 100644 --- a/source/Network/Xmpp/Types.hs +++ b/source/Network/Xmpp/Types.hs @@ -676,6 +676,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 | TlsStreamSecured -- ^ Connection already secured | XmppOtherFailure -- ^ Undefined condition. More -- information should be available in