Browse Source

Clean up and additionally document AuthFailure (and XmppFailure) types

As mentioned in a previous patch, the `AuthFailure' type signals a
(non-fatal) SASL error condition. This is now reflected in the
documentation.

I went through the different constructors for the type, looking at how
they were produced (thrown) and whether or not that information were
useful for the application using Pontarius XMPP.

To begin, I conclude that `AuthStreamFailure' is only used internally.
It will probably be removed when the internal type signatures of the
Sasl package are changed to conform with the rest of the `Error'
computations of Pontarius XMPP.

`AuthFailure' is not thrown as far as I can see, but is only used for
the Error instance.

`AuthNoAcceptableMechanism' is thrown by `xmppSasl' when none of the
mechanisms offered by the server is specified as acceptable by the
client. It wraps the mechanisms offered. I consider this information
useful for client developers, and will therefor keep this constructor.

`AuthSaslFailure' wraps a `SaslFailure' (from Types.hs) and is only
thrown when `pullSaslElement' unpickles a SASL failure. This, together
with `AuthNoAcceptableMechanism' above, could be considered the
`normal' ways of which SASL might be failing.

`AuthStringPrepFailure' is thrown if `prepCredentials' fails to
stringprep-verify the credentials. This might be interesting for the
client developer. As I think that `AuthIllegalCredentials' is more
understandable, I have changed the name to that.

`AuthNoStream' is thrown by `xmppSasl' when the stream state is
`Closed'. This is the result of a client program error/bug. This patch
removes this constructor and modifies the behaviour of xmppSasl to
throw an `XmppFailure' instead.

`AuthChallengeFailure' is thrown if `fromPairs' fails (in Scram.hs),
if a challenge element could not be pulled (in Common.hs), by
`saslFromJust' if a `Nothing' value is encountered (in Common.hs), in
`pullFinalMessage' (`decode') if the success payload could not be
decoded (in Common.hs), or if `toPairs' (in Common.hs) can not extract
the pairs. Furthermore, `AuthServerAuthFailure' is thrown if there is
no `v' value in the final message of the SCRAM handler. Finally,
`AuthXmlFailure' is thrown when `pullSuccess' find something other
than a success element (and, I'm guessing, a `SaslFailure' element).
This can only happen if there is a bug in Pontarius XMPP or the
server. The way I see it, all these failures are abnormal and are of
no interest from the client application itself. I suggest that these
events are logged instead, and that we signal any of these conditions
with a new `AuthOtherFailure' constructor.

I suggest that we remove the `AuthFailure' constructor, and use the
`AuthOtherFailure' for the `Error' instance.

The `AuthFailure' type and all its constructors are now documented.

I also made some minor documentation enhancements to the `XmppFailure'
type.
master
Jon Kristensen 13 years ago
parent
commit
655aeb5b6b
  1. 9
      source/Network/Xmpp.hs
  2. 2
      source/Network/Xmpp/Sasl.hs
  3. 14
      source/Network/Xmpp/Sasl/Common.hs
  4. 4
      source/Network/Xmpp/Sasl/Mechanisms/Scram.hs
  5. 28
      source/Network/Xmpp/Sasl/Types.hs
  6. 15
      source/Network/Xmpp/Types.hs

9
source/Network/Xmpp.hs

@ -142,13 +142,10 @@ module Network.Xmpp @@ -142,13 +142,10 @@ module Network.Xmpp
, XmppFailure(..)
, StreamErrorInfo(..)
, StreamErrorCondition(..)
, AuthFailure( AuthXmlFailure -- Does not export AuthStreamFailure
, AuthNoAcceptableMechanism
, AuthChallengeFailure
, AuthNoStream
, AuthFailure
, AuthFailure( AuthNoAcceptableMechanism
, AuthSaslFailure
, AuthStringPrepFailure )
, AuthIllegalCredentials
, AuthOtherFailure )
) where

2
source/Network/Xmpp/Sasl.hs

@ -76,7 +76,7 @@ xmppSasl handlers stream = (flip withStream stream) $ do @@ -76,7 +76,7 @@ xmppSasl handlers stream = (flip withStream stream) $ do
(_name, handler):_ -> do
cs <- gets streamState
case cs of
Closed -> return . Right $ Just AuthNoStream
Closed -> return . Left $ XmppNoStream
_ -> lift $ handler stream
-- | Authenticate to the server using the first matching method and bind a

14
source/Network/Xmpp/Sasl/Common.hs

@ -134,11 +134,11 @@ pullChallenge = do @@ -134,11 +134,11 @@ pullChallenge = do
SaslChallenge (Just scb64)
| Right sc <- B64.decode . Text.encodeUtf8 $ scb64
-> return $ Just sc
_ -> throwError AuthChallengeFailure
_ -> throwError AuthOtherFailure -- TODO: Log
-- | Extract value from Just, failing with AuthChallengeFailure on Nothing.
-- | Extract value from Just, failing with AuthOtherFailure on Nothing.
saslFromJust :: Maybe a -> ErrorT AuthFailure (StateT Stream IO) a
saslFromJust Nothing = throwError $ AuthChallengeFailure
saslFromJust Nothing = throwError $ AuthOtherFailure -- TODO: Log
saslFromJust (Just d) = return d
-- | Pull the next element and check that it is success.
@ -147,7 +147,7 @@ pullSuccess = do @@ -147,7 +147,7 @@ pullSuccess = do
e <- pullSaslElement
case e of
SaslSuccess x -> return x
_ -> throwError $ AuthXmlFailure
_ -> throwError $ AuthOtherFailure -- TODO: Log
-- | Pull the next element. When it's success, return it's payload.
-- If it's a challenge, send an empty response and pull success.
@ -163,13 +163,13 @@ pullFinalMessage = do @@ -163,13 +163,13 @@ pullFinalMessage = do
where
decode Nothing = return Nothing
decode (Just d) = case B64.decode $ Text.encodeUtf8 d of
Left _e -> throwError $ AuthChallengeFailure
Left _e -> throwError $ AuthOtherFailure -- TODO: Log
Right x -> return $ Just x
-- | Extract p=q pairs from a challenge.
toPairs :: BS.ByteString -> ErrorT AuthFailure (StateT Stream IO) Pairs
toPairs ctext = case pairs ctext of
Left _e -> throwError AuthChallengeFailure
Left _e -> throwError AuthOtherFailure -- TODO: Log
Right r -> return r
-- | Send a SASL response element. The content will be base64-encoded.
@ -186,7 +186,7 @@ respond m = do @@ -186,7 +186,7 @@ respond m = do
prepCredentials :: Text.Text -> Maybe Text.Text -> Text.Text
-> ErrorT AuthFailure (StateT Stream IO) (Text.Text, Maybe Text.Text, Text.Text)
prepCredentials authcid authzid password = case credentials of
Nothing -> throwError $ AuthStringPrepFailure
Nothing -> throwError $ AuthIllegalCredentials
Just creds -> return creds
where
credentials = do

4
source/Network/Xmpp/Sasl/Mechanisms/Scram.hs

@ -63,7 +63,7 @@ scram hashToken authcid authzid password = do @@ -63,7 +63,7 @@ scram hashToken authcid authzid password = do
let (cfm, v) = cFinalMessageAndVerifier nonce salt ic sFirstMessage cnonce
respond $ Just cfm
finalPairs <- toPairs =<< saslFromJust =<< pullFinalMessage
unless (lookup "v" finalPairs == Just v) $ throwError AuthServerAuthFailure
unless (lookup "v" finalPairs == Just v) $ throwError AuthOtherFailure -- TODO: Log
return ()
where
-- We need to jump through some hoops to get a polymorphic solution
@ -106,7 +106,7 @@ scram hashToken authcid authzid password = do @@ -106,7 +106,7 @@ scram hashToken authcid authzid password = do
, Just ic <- lookup "i" pairs
, [(i,"")] <- reads $ BS8.unpack ic
= return (nonce, salt, i)
fromPairs _ _ = throwError $ AuthChallengeFailure
fromPairs _ _ = throwError $ AuthOtherFailure -- TODO: Log
cFinalMessageAndVerifier :: BS.ByteString
-> BS.ByteString

28
source/Network/Xmpp/Sasl/Types.hs

@ -8,22 +8,24 @@ import qualified Data.Text as Text @@ -8,22 +8,24 @@ import qualified Data.Text as Text
import Network.Xmpp.Types
import Control.Concurrent.STM
data AuthFailure = AuthXmlFailure
| AuthNoAcceptableMechanism [Text.Text] -- ^ Wraps mechanisms
-- offered
| AuthChallengeFailure
| AuthServerAuthFailure -- ^ The server failed to authenticate
-- itself
| AuthStreamFailure XmppFailure -- ^ Stream error on stream restart
-- TODO: Rename AuthConnectionFailure?
| AuthNoStream
| AuthFailure -- General instance used for the Error instance
| AuthSaslFailure SaslFailure -- ^ Defined SASL error condition
| AuthStringPrepFailure -- ^ StringPrep failed
-- | 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 = AuthFailure
noMsg = AuthOtherFailure
data SaslElement = SaslSuccess (Maybe Text.Text)
| SaslChallenge (Maybe Text.Text)

15
source/Network/Xmpp/Types.hs

@ -634,7 +634,7 @@ data StreamErrorInfo = StreamErrorInfo @@ -634,7 +634,7 @@ data StreamErrorInfo = StreamErrorInfo
} deriving (Show, Eq)
-- | Signals an XMPP stream error or another unpredicted stream-related
-- situation.
-- situation. This error is fatal, and closes the XMPP stream.
data XmppFailure = StreamErrorFailure StreamErrorInfo -- ^ An error XML stream
-- element has been
-- encountered.
@ -649,14 +649,19 @@ data XmppFailure = StreamErrorFailure StreamErrorInfo -- ^ An error XML stream @@ -649,14 +649,19 @@ data XmppFailure = StreamErrorFailure StreamErrorInfo -- ^ An error XML stream
-- constructor wraps the
-- elements collected so
-- far.
| TlsError TLS.TLSError
| TlsNoServerSupport
| XmppNoStream
| TlsError TLS.TLSError -- ^ An error occurred in the
-- TLS layer
| TlsNoServerSupport -- ^ The server does not support
-- the use of TLS
| XmppNoStream -- ^ An action that required an active
-- stream were performed when the
-- 'StreamState' was 'Closed'
| TlsStreamSecured -- ^ Connection already secured
| XmppOtherFailure -- ^ Undefined condition. More
-- information should be available
-- in the log.
| XmppIOException IOException
| XmppIOException IOException -- ^ An 'IOException'
-- occurred
deriving (Show, Eq, Typeable)
instance Exception XmppFailure

Loading…
Cancel
Save