From 400c78ab723552f7eef134481413b841f4a221c5 Mon Sep 17 00:00:00 2001
From: John Millikin <jmillikin@gmail.com>
Date: Tue, 16 Jun 2009 21:34:38 +0000
Subject: [PATCH] Re-open the stream after authentication.

---
 Network/Protocol/XMPP/Client.hs | 18 +++++++++++-------
 Network/Protocol/XMPP/Stream.hs | 15 ++++-----------
 2 files changed, 15 insertions(+), 18 deletions(-)

diff --git a/Network/Protocol/XMPP/Client.hs b/Network/Protocol/XMPP/Client.hs
index 9425b0b..518a859 100644
--- a/Network/Protocol/XMPP/Client.hs
+++ b/Network/Protocol/XMPP/Client.hs
@@ -22,7 +22,7 @@ module Network.Protocol.XMPP.Client (
 	,clientSend
 	) where
 
-import System.IO (Handle)
+import System.IO (hSetBuffering, BufferMode(NoBuffering), Handle)
 import Codec.Binary.Base64.String (encode)
 import Network (HostName, PortID, connectTo)
 import Text.XML.HXT.Arrow ((>>>))
@@ -35,9 +35,9 @@ import Network.Protocol.XMPP.SASL (Mechanism, bestMechanism)
 import qualified Network.Protocol.XMPP.Stream as S
 import Network.Protocol.XMPP.Stanzas (Stanza)
 
-data ConnectedClient = ConnectedClient JID S.Stream
+data ConnectedClient = ConnectedClient JID S.Stream Handle
 
-data AuthenticatedClient = AuthenticatedClient JID S.Stream
+data AuthenticatedClient = AuthenticatedClient JID JID S.Stream Handle
 
 type Username = String
 type Password = String
@@ -45,14 +45,16 @@ type Password = String
 clientConnect :: JID -> HostName -> PortID -> IO ConnectedClient
 clientConnect jid host port = do
 	handle <- connectTo host port
-	stream <- S.beginStream jid host handle
+	hSetBuffering handle NoBuffering
+	
+	stream <- S.beginStream jid handle
 	
 	-- TODO: TLS support
 	
-	return $ ConnectedClient jid stream
+	return $ ConnectedClient jid stream handle
 
 clientAuthenticate :: ConnectedClient -> JID -> Username -> Password -> IO AuthenticatedClient
-clientAuthenticate (ConnectedClient _ stream) jid username password = let
+clientAuthenticate (ConnectedClient serverJID stream h) jid username password = let
 	mechanisms = (advertisedMechanisms . S.streamFeatures) stream
 	saslMechanism = case bestMechanism mechanisms of
 		Nothing -> error "No supported SASL mechanism"
@@ -79,7 +81,9 @@ clientAuthenticate (ConnectedClient _ stream) jid username password = let
 		
 		-- TODO: check if response is success or failure
 		
-		return $ AuthenticatedClient jid stream
+		newStream <- S.beginStream serverJID h
+		putStrLn $ "features = " ++ (show . S.streamFeatures) newStream
+		return $ AuthenticatedClient serverJID jid newStream h
 
 clientSend :: (Stanza s) => AuthenticatedClient -> s -> IO ()
 clientSend = undefined
diff --git a/Network/Protocol/XMPP/Stream.hs b/Network/Protocol/XMPP/Stream.hs
index 3a3d9ef..e1a837d 100644
--- a/Network/Protocol/XMPP/Stream.hs
+++ b/Network/Protocol/XMPP/Stream.hs
@@ -16,8 +16,7 @@
 
 module Network.Protocol.XMPP.Stream (
 	 Stream (
-	 	 streamHostName
-	 	,streamLanguage
+	 	 streamLanguage
 	 	,streamVersion
 	 	,streamFeatures
 	 	)
@@ -32,7 +31,6 @@ module Network.Protocol.XMPP.Stream (
 	) where
 
 import qualified System.IO as IO
-import Network (HostName, PortID, connectTo)
 import qualified Network.Protocol.XMPP.IncrementalXML as XML
 import Data.AssocList (lookupDef)
 import qualified Text.XML.HXT.DOM.QualifiedName as QN
@@ -46,7 +44,6 @@ import qualified Text.XML.HXT.Arrow as A
 
 import Network.Protocol.XMPP.JID (JID)
 import Network.Protocol.XMPP.SASL (Mechanism, findMechanism)
-import Network.Protocol.XMPP.Stanzas (Stanza)
 import Network.Protocol.XMPP.XMLBuilder (eventsToTree)
 
 maxXMPPVersion = XMPPVersion 1 0
@@ -55,7 +52,6 @@ data Stream = Stream
 	{
 		 streamHandle :: IO.Handle
 		,streamParser :: XML.Parser
-		,streamHostName :: HostName
 		,streamLanguage :: XMLLanguage
 		,streamVersion :: XMPPVersion
 		,streamFeatures :: [StreamFeature]
@@ -77,12 +73,10 @@ data XMPPVersion = XMPPVersion Int Int
 
 -------------------------------------------------------------------------------
 
-beginStream :: JID -> HostName -> IO.Handle -> IO Stream
-beginStream jid host handle = do
+beginStream :: JID -> IO.Handle -> IO Stream
+beginStream jid handle = do
 	parser <- XML.newParser
 	
-	IO.hSetBuffering handle IO.NoBuffering
-	
 	-- Since only the opening tag should be written, normal XML
 	-- serialization cannot be used. Be careful to escape any embedded
 	-- attributes.
@@ -105,7 +99,6 @@ beginStream jid host handle = do
 
 beginStream' handle parser streamStart featureTree = let
 	-- TODO: parse from streamStart
-	host = "localhost"
 	language = XMLLanguage "en"
 	version = XMPPVersion 1 0
 	
@@ -118,7 +111,7 @@ beginStream' handle parser streamStart featureTree = let
 		[] -> []
 		(t:_) -> map parseFeature (A.runLA A.getChildren t)
 	
-	in Stream handle parser host language version features
+	in Stream handle parser language version features
 
 parseFeature :: XmlTree -> StreamFeature
 parseFeature t = lookupDef FeatureUnknown qname [
-- 
2.38.4