M Network/Protocol/XMPP/Handle.hs => Network/Protocol/XMPP/Handle.hs +11 -15
@@ 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
M Network/Protocol/XMPP/Monad.hs => Network/Protocol/XMPP/Monad.hs +5 -9
@@ 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
M Network/Protocol/XMPP/XML.hs => Network/Protocol/XMPP/XML.hs +4 -4
@@ 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