~singpolyma/network-protocol-xmpp

905f1032527759b10409471df7b6218a4c385d54 — John Millikin 7 years ago 23ef847 network-protocol-xmpp_0.4.5
If auth fails, include the error element in AuthenticationFailure.
M lib/Network/Protocol/XMPP/Client/Authentication.hs => lib/Network/Protocol/XMPP/Client/Authentication.hs +4 -4
@@ 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

M lib/Network/Protocol/XMPP/Component.hs => lib/Network/Protocol/XMPP/Component.hs +1 -1
@@ 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))

M lib/Network/Protocol/XMPP/Monad.hs => lib/Network/Protocol/XMPP/Monad.hs +5 -1
@@ 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