network-protocol-xmpp 0.3 → 0.3.1
raw patch · 2 files changed
+28/−12 lines, 2 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
Network/Protocol/XMPP/Monad.hs view
@@ -35,6 +35,7 @@ , putStanza ) where import qualified Control.Applicative as A+import qualified Control.Concurrent.MVar as M import Control.Monad (ap) import Control.Monad.Fix (MonadFix, mfix) import Control.Monad.Trans (MonadIO, liftIO)@@ -73,7 +74,13 @@ | NoComponentStreamID deriving (Show) -data Session = Session H.Handle Text SAX.Parser+data Session = Session+ { sessionHandle :: H.Handle+ , sessionNamespace :: Text+ , sessionParser :: SAX.Parser+ , sessionReadLock :: M.MVar ()+ , sessionWriteLock :: M.MVar ()+ } newtype XMPP a = XMPP { unXMPP :: ErrorT Error (R.ReaderT Session IO) a } @@ -105,22 +112,31 @@ startXMPP :: H.Handle -> Text -> XMPP a -> IO (Either Error a) startXMPP h ns xmpp = do sax <- SAX.newParser- runXMPP (Session h ns sax) xmpp+ readLock <- M.newMVar ()+ writeLock <- M.newMVar ()+ runXMPP (Session h ns sax readLock writeLock) xmpp restartXMPP :: Maybe H.Handle -> XMPP a -> XMPP a restartXMPP newH xmpp = do- Session oldH ns _ <- getSession+ Session oldH ns _ readLock writeLock <- getSession sax <- liftIO SAX.newParser- let s = Session (maybe oldH id newH) ns sax+ let s = Session (maybe oldH id newH) ns sax readLock writeLock XMPP $ R.local (const s) (unXMPP xmpp) +withLock :: (Session -> M.MVar ()) -> XMPP a -> XMPP a+withLock getLock xmpp = do+ s <- getSession+ let mvar = getLock s+ res <- liftIO $ M.withMVar mvar $ \_ -> runXMPP s xmpp+ case res of+ Left err -> E.throwError err+ Right x -> return x+ getSession :: XMPP Session getSession = XMPP R.ask getHandle :: XMPP H.Handle-getHandle = do- Session h _ _ <- getSession- return h+getHandle = fmap sessionHandle getSession liftTLS :: ErrorT Text IO a -> XMPP a liftTLS io = do@@ -138,12 +154,12 @@ putElement = putBytes . encodeUtf8 . X.serialiseElement putStanza :: S.Stanza a => a -> XMPP ()-putStanza = putElement . S.stanzaToElement+putStanza = withLock sessionWriteLock . putElement . S.stanzaToElement readEvents :: (Integer -> SAX.Event -> Bool) -> XMPP [SAX.Event] readEvents done = xmpp where xmpp = do- Session h _ p <- getSession+ Session h _ p _ _ <- getSession let nextEvents = do -- TODO: read in larger increments bytes <- liftTLS $ H.hGetBytes h 1@@ -170,9 +186,9 @@ endOfTree _ _ = False getStanza :: XMPP S.ReceivedStanza-getStanza = do+getStanza = withLock sessionReadLock $ do elemt <- getElement- Session _ ns _ <- getSession+ Session _ ns _ _ _ <- getSession case S.elementToStanza ns elemt of Just x -> return x Nothing -> E.throwError $ InvalidStanza elemt
network-protocol-xmpp.cabal view
@@ -1,5 +1,5 @@ name: network-protocol-xmpp-version: 0.3+version: 0.3.1 synopsis: Client <-> Server communication over XMPP license: GPL-3 license-file: License.txt