{-# 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 = IO (ByteString -> IO (Either XmppFailure ()))
-> ((ByteString -> IO (Either XmppFailure ())) -> IO ())
-> ((ByteString -> IO (Either XmppFailure ()))
-> IO (Either XmppFailure ()))
-> IO (Either XmppFailure ())
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
Ex.bracket (STM (ByteString -> IO (Either XmppFailure ()))
-> IO (ByteString -> IO (Either XmppFailure ()))
forall a. STM a -> IO a
atomically (STM (ByteString -> IO (Either XmppFailure ()))
-> IO (ByteString -> IO (Either XmppFailure ())))
-> STM (ByteString -> IO (Either XmppFailure ()))
-> IO (ByteString -> IO (Either XmppFailure ()))
forall a b. (a -> b) -> a -> b
$ WriteSemaphore -> STM (ByteString -> IO (Either XmppFailure ()))
forall a. TMVar a -> STM a
takeTMVar WriteSemaphore
sem)
(STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ())
-> ((ByteString -> IO (Either XmppFailure ())) -> STM ())
-> (ByteString -> IO (Either XmppFailure ()))
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WriteSemaphore
-> (ByteString -> IO (Either XmppFailure ())) -> STM ()
forall a. TMVar a -> a -> STM ()
putTMVar WriteSemaphore
sem)
((ByteString -> IO (Either XmppFailure ()))
-> ByteString -> IO (Either XmppFailure ())
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 -> PU [Node] Stanza -> Stanza -> Element
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 (Element -> ByteString) -> Element -> ByteString
forall a b. (a -> b) -> a -> b
$ Element -> Element
nsHack Element
el
ByteString -> IO ()
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 (Element -> ByteString) -> Element -> ByteString
forall a b. (a -> b) -> a -> b
$ Element -> Element
nsHack (PU [Node] Stanza -> Stanza -> Element
forall a. PU [Node] a -> a -> Element
pickleElem PU [Node] Stanza
xpStanza Stanza
a)
ByteString -> IO ()
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 = (Session -> Stanza -> IO (Either XmppFailure ()))
-> Stanza -> Session -> IO (Either XmppFailure ())
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 = STM (Stanza, [Annotation]) -> IO (Stanza, [Annotation])
forall a. STM a -> IO a
atomically (STM (Stanza, [Annotation]) -> IO (Stanza, [Annotation]))
-> (TChan (Stanza, [Annotation]) -> STM (Stanza, [Annotation]))
-> TChan (Stanza, [Annotation])
-> IO (Stanza, [Annotation])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TChan (Stanza, [Annotation]) -> STM (Stanza, [Annotation])
forall a. TChan a -> STM a
readTChan (TChan (Stanza, [Annotation]) -> IO (Stanza, [Annotation]))
-> TChan (Stanza, [Annotation]) -> IO (Stanza, [Annotation])
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' <- STM (TChan (Stanza, [Annotation]))
-> IO (TChan (Stanza, [Annotation]))
forall a. STM a -> IO a
atomically (STM (TChan (Stanza, [Annotation]))
-> IO (TChan (Stanza, [Annotation])))
-> STM (TChan (Stanza, [Annotation]))
-> IO (TChan (Stanza, [Annotation]))
forall a b. (a -> b) -> a -> b
$ TChan (Stanza, [Annotation]) -> STM (TChan (Stanza, [Annotation]))
forall a. TChan a -> STM (TChan a)
cloneTChan (Session -> TChan (Stanza, [Annotation])
stanzaCh Session
session)
Session -> IO Session
forall (m :: * -> *) a. Monad m => a -> m a
return (Session -> IO Session) -> Session -> IO Session
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 <- STM Stream -> IO Stream
forall a. STM a -> IO a
atomically (STM Stream -> IO Stream) -> STM Stream -> IO Stream
forall a b. (a -> b) -> a -> b
$ TMVar Stream -> STM Stream
forall a. TMVar a -> STM a
readTMVar TMVar Stream
st
StateT StreamState IO (Maybe Jid) -> Stream -> IO (Maybe Jid)
forall a. StateT StreamState IO a -> Stream -> IO a
withStream' ((StreamState -> Maybe Jid) -> StateT StreamState IO (Maybe Jid)
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 <- STM Stream -> IO Stream
forall a. STM a -> IO a
atomically (STM Stream -> IO Stream) -> STM Stream -> IO Stream
forall a b. (a -> b) -> a -> b
$ TMVar Stream -> STM Stream
forall a. TMVar a -> STM a
readTMVar TMVar Stream
st
StateT StreamState IO StreamFeatures -> Stream -> IO StreamFeatures
forall a. StateT StreamState IO a -> Stream -> IO a
withStream' ((StreamState -> StreamFeatures)
-> StateT StreamState IO StreamFeatures
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} = STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
Stream
s <- TMVar Stream -> STM Stream
forall a. TMVar a -> STM a
readTMVar TMVar Stream
sr
StreamState
ss <- TMVar StreamState -> STM StreamState
forall a. TMVar a -> STM a
readTMVar (TMVar StreamState -> STM StreamState)
-> TMVar StreamState -> STM StreamState
forall a b. (a -> b) -> a -> b
$ Stream -> TMVar StreamState
unStream Stream
s
case StreamState -> ConnectionState
streamConnectionState StreamState
ss of
ConnectionState
Plain -> () -> STM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
ConnectionState
Secured -> () -> STM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
ConnectionState
_ -> STM ()
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 <- TMVar Stream -> STM Stream
forall a. TMVar a -> STM a
readTMVar TMVar Stream
sr
StreamState -> ConnectionState
streamConnectionState (StreamState -> ConnectionState)
-> STM StreamState -> STM ConnectionState
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (TMVar StreamState -> STM StreamState
forall a. TMVar a -> STM a
readTMVar (TMVar StreamState -> STM StreamState)
-> TMVar StreamState -> STM StreamState
forall a b. (a -> b) -> a -> b
$ Stream -> TMVar StreamState
unStream Stream
s)