{-# 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


-- | Send a stanza to the server without running plugins. (The stanza is sent as
-- is)
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

-- | Send a stanza to the server, managed by plugins
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'

-- | Get the channel of incoming stanzas.
getStanzaChan :: Session -> TChan (Stanza, [Annotation])
getStanzaChan :: Session -> TChan (Stanza, [Annotation])
getStanzaChan Session
session = Session -> TChan (Stanza, [Annotation])
stanzaCh Session
session

-- | Get the next incoming stanza
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

-- | Duplicate the inbound channel of the session object. Most receiving
-- functions discard stanzas they are not interested in from the inbound
-- channel. Duplicating the channel ensures that those stanzas can aren't lost
-- and can still be handled somewhere else.
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'}

-- | Return the JID assigned to us by the server
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

-- | Return the stream features the server announced
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

-- | Wait until the connection of the stream is re-established
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)