3 files changed, 10 insertions(+), 6 deletions(-)

M lib/Network/Protocol/XMPP/Client/Authentication.hs
M lib/Network/Protocol/XMPP/Component.hs
M lib/Network/Protocol/XMPP/Monad.hs

@@ 37,7 37,7 @@ import qualified Network.Protocol.XMPP.Monad as M
 import qualified Network.Protocol.XMPP.XML as X
 import           Network.Protocol.XMPP.JID (JID, formatJID, jidResource)
 
-data Result = Success | Failure
+data Result = Success | Failure X.Element
 	deriving (Show, Eq)
 
 data AuthException = XmppError M.Error | SaslError Text


@@ 65,7 65,7 @@ authenticate xmppMechanisms userJID serverJID username password = xmpp where
 				Just mechanism -> authSasl ctx mechanism
 		case res of
 			Right Success -> return ()
-			Right Failure -> E.throwError M.AuthenticationFailure
+			Right (Failure e) -> E.throwError (M.AuthenticationFailure e)
 			Left (XmppError err) -> E.throwError err
 			Left (SaslError err) -> E.throwError (M.AuthenticationError err)
 	


@@ 119,7 119,7 @@ saslLoop ctx = do
 				SASL.NeedsMore -> saslError "Server didn't provide enough SASL data."
 		
 		-- The server has rejected this client's credentials.
-		n | n == "{urn:ietf:params:xml:ns:xmpp-sasl}failure" -> return Failure
+		n | n == "{urn:ietf:params:xml:ns:xmpp-sasl}failure" -> return (Failure e)
 		
 		_ -> saslError ("Server sent unexpected element during authentication.")
 


@@ 128,7 128,7 @@ saslFinish ctx = do
 	elemt <- getElement ctx
 	return $ if X.elementName elemt == "{urn:ietf:params:xml:ns:xmpp-sasl}success"
 		then Success
-		else Failure
+		else Failure elemt
 
 putElement :: M.Session -> X.Element -> SASL.Session ()
 putElement ctx elemt = liftIO $ do

@@ 74,7 74,7 @@ authenticate streamID password = do
 	M.putElement (X.element "handshake" [] [X.NodeContent (X.ContentText digest)])
 	result <- M.getElement
 	let nameHandshake = "{jabber:component:accept}handshake"
-	when (null (X.isNamed nameHandshake result)) (throwError M.AuthenticationFailure)
+	when (null (X.isNamed nameHandshake result)) (throwError (M.AuthenticationFailure result))
 
 buildSecret :: Text -> Text -> ByteString
 buildSecret sid password = encodeUtf8 (X.escape (Data.Text.append sid password))

@@ 57,7 57,11 @@ import qualified Network.Protocol.XMPP.XML as X
 
 data Error
 	-- | The remote host refused the specified authentication credentials.
-	= AuthenticationFailure
+	--
+	-- The included XML element is the error value that the server
+	-- provided. It may contain additional information about why
+	-- authentication failed.
+	= AuthenticationFailure X.Element
 	
 	-- | There was an error while authenticating with the remote host.
 	| AuthenticationError Text