diff --git a/src/Network/XMPP/Concurrent/Threads.hs b/src/Network/XMPP/Concurrent/Threads.hs index b40024b..04ab8d6 100644 --- a/src/Network/XMPP/Concurrent/Threads.hs +++ b/src/Network/XMPP/Concurrent/Threads.hs @@ -33,6 +33,8 @@ import Network.XMPP.Concurrent.Types import Text.XML.Stream.Elements import qualified Text.XML.Stream.Render as XR +import GHC.IO (unsafeUnmask) + readWorker :: TChan (Either MessageError Message) -> TChan (Either PresenceError Presence) -> TVar IQHandlers @@ -43,7 +45,7 @@ readWorker messageC presenceC handlers stateRef = s <- liftIO . atomically $ takeTMVar stateRef (sta', s') <- flip runStateT s $ Ex.catch ( do -- we don't know whether pull will necessarily be interruptible - liftIO $ Ex.allowInterrupt + liftIO $ allowInterrupt Just <$> pull ) (\(Interrupt t) -> do @@ -80,7 +82,11 @@ readWorker messageC presenceC handlers stateRef = IQRequestS i -> handleIQRequest handlers i IQResultS i -> handleIQResponse handlers (Right 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 (byNS, _) <- readTVar handlers diff --git a/src/Network/XMPP/SASL.hs b/src/Network/XMPP/SASL.hs index c325d89..f7e28c3 100644 --- a/src/Network/XMPP/SASL.hs +++ b/src/Network/XMPP/SASL.hs @@ -92,8 +92,12 @@ createResponse g hostname username passwd' pairs = let uname = Text.encodeUtf8 username passwd = Text.encodeUtf8 passwd' realm = Text.encodeUtf8 hostname + + -- Using Char instead of Word8 for random 1.0.0.0 (GHC 7) + -- compatibility. 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" digestURI = ("xmpp/" `BS.append` realm) digest = md5Digest