{-# OPTIONS_HADDOCK hide #-}
module Network.Xmpp.Concurrent.Basic where
import Control.Applicative
import Control.Concurrent.STM
import qualified Control.Exception as Ex
import Control.Monad.State.Strict
import qualified Data.ByteString as BS
import Network.Xmpp.Concurrent.Types
import Network.Xmpp.Marshal
import Network.Xmpp.Stream
import Network.Xmpp.Types
import Network.Xmpp.Utilities
semWrite :: WriteSemaphore -> BS.ByteString -> IO (Either XmppFailure ())
semWrite :: WriteSemaphore -> ByteString -> IO (Either XmppFailure ())
semWrite WriteSemaphore
sem ByteString
bs = forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
Ex.bracket (forall a. STM a -> IO a
atomically forall a b. (a -> b) -> a -> b
$ forall a. TMVar a -> STM a
takeTMVar WriteSemaphore
sem)
(forall a. STM a -> IO a
atomically forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. TMVar a -> a -> STM ()
putTMVar WriteSemaphore
sem)
(forall a b. (a -> b) -> a -> b
$ ByteString
bs)
writeXmppElem :: WriteSemaphore -> XmppElement -> IO (Either XmppFailure ())
writeXmppElem :: WriteSemaphore -> XmppElement -> IO (Either XmppFailure ())
writeXmppElem WriteSemaphore
sem XmppElement
a = do
let el :: Element
el = case XmppElement
a of
XmppStanza Stanza
s -> forall a. PU [Node] a -> a -> Element
pickleElem PU [Node] Stanza
xpStanza Stanza
s
XmppNonza Element
n -> Element
n
outData :: ByteString
outData = Element -> ByteString
renderElement forall a b. (a -> b) -> a -> b
$ Element -> Element
nsHack Element
el
forall (m :: * -> *). MonadIO m => ByteString -> m ()
debugOut ByteString
outData
WriteSemaphore -> ByteString -> IO (Either XmppFailure ())
semWrite WriteSemaphore
sem ByteString
outData
writeStanza :: WriteSemaphore -> Stanza -> IO (Either XmppFailure ())
writeStanza :: WriteSemaphore -> Stanza -> IO (Either XmppFailure ())
writeStanza WriteSemaphore
sem Stanza
a = do
let outData :: ByteString
outData = Element -> ByteString
renderElement forall a b. (a -> b) -> a -> b
$ Element -> Element
nsHack (forall a. PU [Node] a -> a -> Element
pickleElem PU [Node] Stanza
xpStanza Stanza
a)
forall (m :: * -> *). MonadIO m => ByteString -> m ()
debugOut ByteString
outData
WriteSemaphore -> ByteString -> IO (Either XmppFailure ())
semWrite WriteSemaphore
sem ByteString
outData
sendRawStanza :: Stanza -> Session -> IO (Either XmppFailure ())
sendRawStanza :: Stanza -> Session -> IO (Either XmppFailure ())
sendRawStanza Stanza
a Session
session = WriteSemaphore -> Stanza -> IO (Either XmppFailure ())
writeStanza (Session -> WriteSemaphore
writeSemaphore Session
session) Stanza
a
sendStanza :: Stanza -> Session -> IO (Either XmppFailure ())
sendStanza :: Stanza -> Session -> IO (Either XmppFailure ())
sendStanza = forall a b c. (a -> b -> c) -> b -> a -> c
flip Session -> Stanza -> IO (Either XmppFailure ())
sendStanza'
getStanzaChan :: Session -> TChan (Stanza, [Annotation])
getStanzaChan :: Session -> TChan (Stanza, [Annotation])
getStanzaChan Session
session = Session -> TChan (Stanza, [Annotation])
stanzaCh Session
session
getStanza :: Session -> IO (Stanza, [Annotation])
getStanza :: Session -> IO (Stanza, [Annotation])
getStanza Session
session = forall a. STM a -> IO a
atomically forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. TChan a -> STM a
readTChan forall a b. (a -> b) -> a -> b
$ Session -> TChan (Stanza, [Annotation])
stanzaCh Session
session
dupSession :: Session -> IO Session
dupSession :: Session -> IO Session
dupSession Session
session = do
TChan (Stanza, [Annotation])
stanzaCh' <- forall a. STM a -> IO a
atomically forall a b. (a -> b) -> a -> b
$ forall a. TChan a -> STM (TChan a)
cloneTChan (Session -> TChan (Stanza, [Annotation])
stanzaCh Session
session)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Session
session {stanzaCh :: TChan (Stanza, [Annotation])
stanzaCh = TChan (Stanza, [Annotation])
stanzaCh'}
getJid :: Session -> IO (Maybe Jid)
getJid :: Session -> IO (Maybe Jid)
getJid Session{streamRef :: Session -> TMVar Stream
streamRef = TMVar Stream
st} = do
Stream
s <- forall a. STM a -> IO a
atomically forall a b. (a -> b) -> a -> b
$ forall a. TMVar a -> STM a
readTMVar TMVar Stream
st
forall a. StateT StreamState IO a -> Stream -> IO a
withStream' (forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets StreamState -> Maybe Jid
streamJid) Stream
s
getFeatures :: Session -> IO StreamFeatures
getFeatures :: Session -> IO StreamFeatures
getFeatures Session{streamRef :: Session -> TMVar Stream
streamRef = TMVar Stream
st} = do
Stream
s <- forall a. STM a -> IO a
atomically forall a b. (a -> b) -> a -> b
$ forall a. TMVar a -> STM a
readTMVar TMVar Stream
st
forall a. StateT StreamState IO a -> Stream -> IO a
withStream' (forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets StreamState -> StreamFeatures
streamFeatures) Stream
s
waitForStream :: Session -> IO ()
waitForStream :: Session -> IO ()
waitForStream Session{streamRef :: Session -> TMVar Stream
streamRef = TMVar Stream
sr} = forall a. STM a -> IO a
atomically forall a b. (a -> b) -> a -> b
$ do
Stream
s <- forall a. TMVar a -> STM a
readTMVar TMVar Stream
sr
StreamState
ss <- forall a. TMVar a -> STM a
readTMVar forall a b. (a -> b) -> a -> b
$ Stream -> TMVar StreamState
unStream Stream
s
case StreamState -> ConnectionState
streamConnectionState StreamState
ss of
ConnectionState
Plain -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
ConnectionState
Secured -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
ConnectionState
_ -> forall a. STM a
retry
streamState :: Session -> STM ConnectionState
streamState :: Session -> STM ConnectionState
streamState Session{streamRef :: Session -> TMVar Stream
streamRef = TMVar Stream
sr} = do
Stream
s <- forall a. TMVar a -> STM a
readTMVar TMVar Stream
sr
StreamState -> ConnectionState
streamConnectionState forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. TMVar a -> STM a
readTMVar forall a b. (a -> b) -> a -> b
$ Stream -> TMVar StreamState
unStream Stream
s)