~singpolyma/network-protocol-xmpp

5055a1d4d2f42c2fc3021dd136ef92fde56c5ada — John Millikin 13 years ago 0095311
In ``clientBind``, parse and return the JID returned from the server.
1 files changed, 25 insertions(+), 13 deletions(-)

M Network/Protocol/XMPP/Client.hs
M Network/Protocol/XMPP/Client.hs => Network/Protocol/XMPP/Client.hs +25 -13
@@ 16,7 16,7 @@

module Network.Protocol.XMPP.Client (
	 ConnectedClient
	,AuthenticatedClient
	,Client
	,clientConnect
	,clientAuthenticate
	,clientBind


@@ 33,15 33,20 @@ import Text.XML.HXT.DOM.TypeDefs (XmlTree)
import qualified Text.XML.HXT.DOM.XmlNode as XN
import qualified Text.XML.HXT.DOM.QualifiedName as QN

import Network.Protocol.XMPP.JID (JID)
import Network.Protocol.XMPP.JID (JID, jidParse)
import Network.Protocol.XMPP.SASL (Mechanism, bestMechanism)
import qualified Network.Protocol.XMPP.Stream as S
import Network.Protocol.XMPP.Stanzas (Stanza)
import Network.Protocol.XMPP.Util (mkElement)
import Network.Protocol.XMPP.Util (mkElement, mkQName)

data ConnectedClient = ConnectedClient JID S.Stream Handle

data AuthenticatedClient = AuthenticatedClient JID JID S.Stream Handle
data Client = Client {
	 clientJID       :: JID
	,clientServerJID :: JID
	,clientStream    :: S.Stream
	,clientHandle    :: Handle
	}

type Username = String
type Password = String


@@ 57,7 62,7 @@ clientConnect jid host port = do
	
	return $ ConnectedClient jid stream handle

clientAuthenticate :: ConnectedClient -> JID -> Username -> Password -> IO AuthenticatedClient
clientAuthenticate :: ConnectedClient -> JID -> Username -> Password -> IO Client
clientAuthenticate (ConnectedClient serverJID stream h) jid username password = let
	mechanisms = (advertisedMechanisms . S.streamFeatures) stream
	saslMechanism = case bestMechanism mechanisms of


@@ 79,10 84,10 @@ clientAuthenticate (ConnectedClient serverJID stream h) jid username password = 
		-- TODO: check if response is success or failure
		
		newStream <- S.beginStream serverJID h
		return $ AuthenticatedClient serverJID jid newStream h
		return $ Client serverJID jid newStream h

clientBind :: AuthenticatedClient -> IO ()
clientBind c@(AuthenticatedClient _ _ stream h) = do
clientBind :: Client -> IO JID
clientBind c = do
	-- Bind
	-- TODO: request specific resource
	-- TODO: set ID to random value, and check bind result for JID


@@ 94,6 99,13 @@ clientBind c@(AuthenticatedClient _ _ stream h) = do
		  	[]]
	
	bindResult <- getTree c
	let [rawJID] = A.runLA (
		A.deep (A.hasQName (mkQName "urn:ietf:params:xml:ns:xmpp-bind" "jid"))
		>>> A.getChildren
		>>> A.getText) bindResult
	let jid = case jidParse rawJID of
		Just x -> x
		otherwise -> error "Couldn't parse server's returned JID"
	
	-- Session
	putTree c $ mkElement ("", "iq")


@@ 106,7 118,7 @@ clientBind c@(AuthenticatedClient _ _ stream h) = do
	
	putTree c $ mkElement ("", "presence") [] []
	getTree c
	return ()
	return jid

advertisedMechanisms :: [S.StreamFeature] -> [Mechanism]
advertisedMechanisms [] = []


@@ 116,9 128,9 @@ advertisedMechanisms (f:fs) = case f of

-------------------------------------------------------------------------------

putTree :: AuthenticatedClient -> XmlTree -> IO ()
putTree (AuthenticatedClient _ _ s _) = S.putTree s
putTree :: Client -> XmlTree -> IO ()
putTree = S.putTree . clientStream

getTree :: AuthenticatedClient -> IO XmlTree
getTree (AuthenticatedClient _ _ s _) = S.getTree s
getTree :: Client -> IO XmlTree
getTree = S.getTree . clientStream