{-# LANGUAGE ExistentialQuantification #-}
{-# OPTIONS_HADDOCK hide #-}
{-# LANGUAGE DeriveDataTypeable #-}
module Network.Xmpp.Concurrent.Types where
import Control.Concurrent
import Control.Concurrent.STM
import qualified Control.Exception.Lifted as Ex
import Control.Monad.Except
import qualified Data.ByteString as BS
import Data.Default
import qualified Data.Map as Map
import Data.Text (Text)
import qualified Data.Text as Text
import Data.Typeable
import Data.XML.Types (Element)
import Network.Socket
import Network.Xmpp.IM.Roster.Types
import Network.Xmpp.IM.PresenceTracker.Types
import Network.Xmpp.Sasl.Types
import Network.Xmpp.Types
type StanzaHandler = (XmppElement -> IO (Either XmppFailure ()) )
-> XmppElement
-> [Annotation]
-> IO [(XmppElement, [Annotation])]
type Resource = Text
type AuthData = Maybe (ConnectionState -> [SaslHandler] , Maybe Resource)
data Annotation = forall f.(Typeable f, Show f) => Annotation{()
fromAnnotation :: f}
instance Show Annotation where
show :: Annotation -> String
show (Annotation f
x) = String
"Annotation{ fromAnnotation = " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show f
x forall a. [a] -> [a] -> [a]
++ String
"}"
type Annotated a = (a, [Annotation])
getAnnotation :: Typeable b => Annotated a -> Maybe b
getAnnotation :: forall b a. Typeable b => Annotated a -> Maybe b
getAnnotation = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\(Annotation f
a) Maybe b
b -> forall b a. b -> (a -> b) -> Maybe a -> b
maybe Maybe b
b forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast f
a) forall a. Maybe a
Nothing forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd
data Plugin' = Plugin'
{
Plugin'
-> XmppElement -> [Annotation] -> IO [(XmppElement, [Annotation])]
inHandler :: XmppElement
-> [Annotation]
-> IO [(XmppElement, [Annotation])]
, Plugin' -> XmppElement -> IO (Either XmppFailure ())
outHandler :: XmppElement -> IO (Either XmppFailure ())
, Plugin' -> Session -> IO ()
onSessionUp :: Session -> IO ()
}
type Plugin = (XmppElement -> IO (Either XmppFailure ()))
-> ExceptT XmppFailure IO Plugin'
type RosterPushCallback = Roster -> RosterUpdate -> IO ()
data SessionConfiguration = SessionConfiguration
{
SessionConfiguration -> StreamConfiguration
sessionStreamConfiguration :: StreamConfiguration
, SessionConfiguration -> Session -> XmppFailure -> IO ()
onConnectionClosed :: Session -> XmppFailure -> IO ()
, SessionConfiguration -> IO (IO Text)
sessionStanzaIDs :: IO (IO Text)
, SessionConfiguration -> [Plugin]
plugins :: [Plugin]
, SessionConfiguration -> Bool
enableRoster :: Bool
, SessionConfiguration -> IO (Maybe Roster)
initialRoster :: IO (Maybe Roster)
, SessionConfiguration -> Maybe RosterPushCallback
onRosterPush :: Maybe RosterPushCallback
, SessionConfiguration -> Bool
enablePresenceTracking :: Bool
, SessionConfiguration
-> Maybe (Jid -> PeerStatus -> PeerStatus -> IO ())
onPresenceChange :: Maybe ( Jid
-> PeerStatus
-> PeerStatus
-> IO ())
, SessionConfiguration -> Maybe Int
keepAlive :: Maybe Int
}
instance Default SessionConfiguration where
def :: SessionConfiguration
def = SessionConfiguration { sessionStreamConfiguration :: StreamConfiguration
sessionStreamConfiguration = forall a. Default a => a
def
, onConnectionClosed :: Session -> XmppFailure -> IO ()
onConnectionClosed = \Session
_ XmppFailure
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
, sessionStanzaIDs :: IO (IO Text)
sessionStanzaIDs = do
TVar Integer
idRef <- forall a. a -> IO (TVar a)
newTVarIO Integer
1
forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. STM a -> IO a
atomically forall a b. (a -> b) -> a -> b
$ do
Integer
curId <- forall a. TVar a -> STM a
readTVar TVar Integer
idRef
forall a. TVar a -> a -> STM ()
writeTVar TVar Integer
idRef (Integer
curId forall a. Num a => a -> a -> a
+ Integer
1 :: Integer)
forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ Integer
curId
, plugins :: [Plugin]
plugins = []
, enableRoster :: Bool
enableRoster = Bool
True
, initialRoster :: IO (Maybe Roster)
initialRoster = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
, onRosterPush :: Maybe RosterPushCallback
onRosterPush = forall a. Maybe a
Nothing
, enablePresenceTracking :: Bool
enablePresenceTracking = Bool
True
, onPresenceChange :: Maybe (Jid -> PeerStatus -> PeerStatus -> IO ())
onPresenceChange = forall a. Maybe a
Nothing
, keepAlive :: Maybe Int
keepAlive = forall a. a -> Maybe a
Just Int
30
}
data EventHandlers = EventHandlers
{ EventHandlers -> XmppFailure -> IO ()
connectionClosedHandler :: XmppFailure -> IO ()
}
data Interrupt = Interrupt (TMVar ()) deriving Typeable
instance Show Interrupt where show :: Interrupt -> String
show Interrupt
_ = String
"<Interrupt>"
instance Ex.Exception Interrupt
type WriteSemaphore = TMVar (BS.ByteString -> IO (Either XmppFailure ()))
data Session = Session
{ Session -> TChan (Stanza, [Annotation])
stanzaCh :: TChan (Stanza, [Annotation])
, Session -> TVar IQHandlers
iqHandlers :: TVar IQHandlers
, Session -> WriteSemaphore
writeSemaphore :: WriteSemaphore
, Session -> ThreadId
readerThread :: ThreadId
, Session -> IO Text
idGenerator :: IO Text
, Session -> TMVar Stream
streamRef :: TMVar Stream
, Session -> TMVar EventHandlers
eventHandlers :: TMVar EventHandlers
, Session -> IO ()
stopThreads :: IO ()
, Session -> TVar Roster
rosterRef :: TVar Roster
, Session -> TVar Peers
presenceRef :: TVar Peers
, Session -> SessionConfiguration
conf :: SessionConfiguration
, Session -> Stanza -> IO (Either XmppFailure ())
sendStanza' :: Stanza -> IO (Either XmppFailure ())
, Session -> String
sRealm :: HostName
, Session -> Maybe (ConnectionState -> [SaslHandler], Maybe Text)
sSaslCredentials :: Maybe (ConnectionState -> [SaslHandler] , Maybe Text)
, Session -> TVar Int
reconnectWait :: TVar Int
}
type IQHandlers = ( Map.Map (IQRequestType, Text) (TChan IQRequestTicket)
, Map.Map Text (Either (Maybe Jid) Jid,
TMVar (Maybe (Annotated IQResponse)))
)
data IQRequestTicket = IQRequestTicket
{
IQRequestTicket
-> Either StanzaError (Maybe Element)
-> [ExtendedAttribute]
-> IO (Maybe (Either XmppFailure ()))
answerTicket :: Either StanzaError (Maybe Element)
-> [ExtendedAttribute]
-> IO (Maybe (Either XmppFailure ()))
, IQRequestTicket -> IQRequest
iqRequestBody :: IQRequest
, IQRequestTicket -> [Annotation]
iqRequestAnnotations :: [Annotation]
}
data IQSendError = IQSendError XmppFailure
| IQTimeOut
deriving (Int -> IQSendError -> ShowS
[IQSendError] -> ShowS
IQSendError -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IQSendError] -> ShowS
$cshowList :: [IQSendError] -> ShowS
show :: IQSendError -> String
$cshow :: IQSendError -> String
showsPrec :: Int -> IQSendError -> ShowS
$cshowsPrec :: Int -> IQSendError -> ShowS
Show, IQSendError -> IQSendError -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IQSendError -> IQSendError -> Bool
$c/= :: IQSendError -> IQSendError -> Bool
== :: IQSendError -> IQSendError -> Bool
$c== :: IQSendError -> IQSendError -> Bool
Eq, Typeable)
instance Ex.Exception IQSendError