Philipp Balzarek 14 years ago
parent
commit
13c779d3bf
  1. 10
      src/Network/XMPP/Concurrent/Threads.hs
  2. 6
      src/Network/XMPP/SASL.hs

10
src/Network/XMPP/Concurrent/Threads.hs

@ -33,6 +33,8 @@ import Network.XMPP.Concurrent.Types
import Text.XML.Stream.Elements import Text.XML.Stream.Elements
import qualified Text.XML.Stream.Render as XR import qualified Text.XML.Stream.Render as XR
import GHC.IO (unsafeUnmask)
readWorker :: TChan (Either MessageError Message) readWorker :: TChan (Either MessageError Message)
-> TChan (Either PresenceError Presence) -> TChan (Either PresenceError Presence)
-> TVar IQHandlers -> TVar IQHandlers
@ -43,7 +45,7 @@ readWorker messageC presenceC handlers stateRef =
s <- liftIO . atomically $ takeTMVar stateRef s <- liftIO . atomically $ takeTMVar stateRef
(sta', s') <- flip runStateT s $ Ex.catch ( do (sta', s') <- flip runStateT s $ Ex.catch ( do
-- we don't know whether pull will necessarily be interruptible -- we don't know whether pull will necessarily be interruptible
liftIO $ Ex.allowInterrupt liftIO $ allowInterrupt
Just <$> pull Just <$> pull
) )
(\(Interrupt t) -> do (\(Interrupt t) -> do
@ -80,7 +82,11 @@ readWorker messageC presenceC handlers stateRef =
IQRequestS i -> handleIQRequest handlers i IQRequestS i -> handleIQRequest handlers i
IQResultS i -> handleIQResponse handlers (Right i) IQResultS i -> handleIQResponse handlers (Right i)
IQErrorS i -> handleIQResponse handlers (Left i) IQErrorS i -> handleIQResponse handlers (Left i)
where
-- Defining an Control.Exception.allowInterrupt equivalent for
-- GHC 7 compatibility.
allowInterrupt :: IO ()
allowInterrupt = unsafeUnmask $ return ()
handleIQRequest handlers iq = do handleIQRequest handlers iq = do
(byNS, _) <- readTVar handlers (byNS, _) <- readTVar handlers

6
src/Network/XMPP/SASL.hs

@ -92,8 +92,12 @@ createResponse g hostname username passwd' pairs = let
uname = Text.encodeUtf8 username uname = Text.encodeUtf8 username
passwd = Text.encodeUtf8 passwd' passwd = Text.encodeUtf8 passwd'
realm = Text.encodeUtf8 hostname realm = Text.encodeUtf8 hostname
-- Using Char instead of Word8 for random 1.0.0.0 (GHC 7)
-- compatibility.
cnonce = BS.tail . BS.init . cnonce = BS.tail . BS.init .
B64.encode . BS.pack . take 8 $ Random.randoms g B64.encode . BS8.pack . take 8 $ Random.randoms g
nc = "00000001" nc = "00000001"
digestURI = ("xmpp/" `BS.append` realm) digestURI = ("xmpp/" `BS.append` realm)
digest = md5Digest digest = md5Digest

Loading…
Cancel
Save