From 6831ae340ee131b78985f3846cc151d6e2cd87aa Mon Sep 17 00:00:00 2001
From: John Millikin <jmillikin@gmail.com>
Date: Wed, 28 Apr 2010 23:07:20 +0000
Subject: [PATCH] Replace 'hGetChar' with 'hGetBytes'.

---
 Network/Protocol/XMPP/Handle.hs | 26 +++++++++++---------------
 Network/Protocol/XMPP/Monad.hs  | 14 +++++---------
 Network/Protocol/XMPP/XML.hs    |  8 ++++----
 3 files changed, 20 insertions(+), 28 deletions(-)

diff --git a/Network/Protocol/XMPP/Handle.hs b/Network/Protocol/XMPP/Handle.hs
index bf69b94..de28f37 100644
--- a/Network/Protocol/XMPP/Handle.hs
+++ b/Network/Protocol/XMPP/Handle.hs
@@ -18,13 +18,13 @@ module Network.Protocol.XMPP.Handle
 	( Handle (..)
 	, startTLS
 	, hPutBytes
-	, hGetChar
+	, hGetBytes
 	) where
 
 import Control.Monad (when)
 import qualified Control.Monad.Error as E
 import Control.Monad.Trans (liftIO)
-import qualified Data.ByteString.Lazy.Char8 as B
+import qualified Data.ByteString.Lazy as B
 import qualified Data.Text.Lazy as T
 import qualified System.IO as IO
 import qualified Network.Protocol.TLS.GNU as TLS
@@ -56,16 +56,12 @@ hPutBytes :: Handle -> B.ByteString -> ErrorT T.Text IO ()
 hPutBytes (PlainHandle h)  = liftIO . B.hPut h
 hPutBytes (SecureHandle _ s) = liftTLS s . TLS.putBytes
 
-hGetChar :: Handle -> ErrorT T.Text IO Char
-hGetChar (PlainHandle h) = liftIO $ IO.hGetChar h
-hGetChar (SecureHandle h s) = do
-	bytes <- liftTLS s $ do
-		pending <- TLS.checkPending
-		when (pending == 0) $ do
-			liftIO $ IO.hWaitForInput h (- 1)
-			return ()
-		
-		TLS.getBytes 1
-	case B.unpack bytes of
-		(c:_) -> return c
-		_ -> E.throwError "hGetChar: not enough bytes"
+hGetBytes :: Handle -> Integer -> ErrorT T.Text IO B.ByteString
+hGetBytes (PlainHandle h) n = liftIO $  B.hGet h $ fromInteger n
+hGetBytes (SecureHandle h s) n = liftTLS s $ do
+	pending <- TLS.checkPending
+	when (pending == 0) $ do
+		liftIO $ IO.hWaitForInput h (- 1)
+		return ()
+	
+	TLS.getBytes n
diff --git a/Network/Protocol/XMPP/Monad.hs b/Network/Protocol/XMPP/Monad.hs
index 5604a09..556a951 100644
--- a/Network/Protocol/XMPP/Monad.hs
+++ b/Network/Protocol/XMPP/Monad.hs
@@ -26,7 +26,6 @@ module Network.Protocol.XMPP.Monad
 	, getContext
 	
 	, readEvents
-	, getChar
 	, getTree
 	, getStanza
 	
@@ -34,7 +33,6 @@ module Network.Protocol.XMPP.Monad
 	, putTree
 	, putStanza
 	) where
-import Prelude hiding (getChar)
 import Control.Monad.Trans (MonadIO, liftIO)
 import qualified Control.Monad.Error as E
 import qualified Control.Monad.Reader as R
@@ -111,17 +109,11 @@ liftTLS io = do
 		Left err -> E.throwError $ TransportError err
 		Right x -> return x
 
-
 putBytes :: B.ByteString -> XMPP ()
 putBytes bytes = do
 	h <- getHandle
 	liftTLS $ H.hPutBytes h bytes
 
-getChar :: XMPP Char
-getChar = do
-	h <- getHandle
-	liftTLS $ H.hGetChar h
-
 putTree :: DOM.XmlTree -> XMPP ()
 putTree t = do
 	let root = XN.mkRoot [] [t]
@@ -136,7 +128,11 @@ putStanza = putTree . S.stanzaToTree
 readEvents :: (Integer -> SAX.Event -> Bool) -> XMPP [SAX.Event]
 readEvents done = do
 	Context h _ p <- getContext
-	X.readEvents done (liftTLS $ H.hGetChar h) p
+	let nextChar = do
+		-- TODO: read in larger increments
+		bytes <- liftTLS $ H.hGetBytes h 1
+		return $ B.unpack bytes
+	X.readEvents done nextChar p
 
 getTree :: XMPP DOM.XmlTree
 getTree = X.eventsToTree `fmap` readEvents endOfTree where
diff --git a/Network/Protocol/XMPP/XML.hs b/Network/Protocol/XMPP/XML.hs
index 4653706..7fb7388 100644
--- a/Network/Protocol/XMPP/XML.hs
+++ b/Network/Protocol/XMPP/XML.hs
@@ -33,11 +33,11 @@ import qualified Text.XML.HXT.DOM.Interface as DOM
 import qualified Text.XML.HXT.DOM.XmlNode as XN
 import qualified Text.XML.LibXML.SAX as SAX
 
-readEvents :: MonadIO m => (Integer -> SAX.Event -> Bool) -> m Char -> SAX.Parser -> m [SAX.Event]
-readEvents done getChar parser = readEvents' 0 [] where
+readEvents :: MonadIO m => (Integer -> SAX.Event -> Bool) -> m String -> SAX.Parser -> m [SAX.Event]
+readEvents done getChars parser = readEvents' 0 [] where
 	nextEvents = do
-		char <- getChar
-		liftIO $ SAX.parse parser [char] False
+		chars <- getChars
+		liftIO $ SAX.parse parser chars False
 	
 	readEvents' depth acc = do
 		events <- nextEvents
-- 
2.38.5