Merge pull request #30 from jonkri/master

Wrap `AuthFailure' in `XmppAuthFailure'

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

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)
 

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
 -- =============================================================================