3 files changed, 20 insertions(+), 28 deletions(-)

M Network/Protocol/XMPP/Handle.hs
M Network/Protocol/XMPP/Monad.hs
M Network/Protocol/XMPP/XML.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

@@ 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

@@ 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