{-# 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 = " String -> ShowS
forall a. [a] -> [a] -> [a]
++ f -> String
forall a. Show a => a -> String
show f
x String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"}"
type Annotated a = (a, [Annotation])
getAnnotation :: Typeable b => Annotated a -> Maybe b
getAnnotation :: Annotated a -> Maybe b
getAnnotation = (Annotation -> Maybe b -> Maybe b)
-> Maybe b -> [Annotation] -> Maybe b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\(Annotation f
a) Maybe b
b -> Maybe b -> (b -> Maybe b) -> Maybe b -> Maybe b
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Maybe b
b b -> Maybe b
forall a. a -> Maybe a
Just (Maybe b -> Maybe b) -> Maybe b -> Maybe b
forall a b. (a -> b) -> a -> b
$ f -> Maybe b
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast f
a) Maybe b
forall a. Maybe a
Nothing ([Annotation] -> Maybe b)
-> (Annotated a -> [Annotation]) -> Annotated a -> Maybe b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Annotated a -> [Annotation]
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 :: StreamConfiguration
-> (Session -> XmppFailure -> IO ())
-> IO (IO Text)
-> [Plugin]
-> Bool
-> IO (Maybe Roster)
-> Maybe RosterPushCallback
-> Bool
-> Maybe (Jid -> PeerStatus -> PeerStatus -> IO ())
-> Maybe Int
-> SessionConfiguration
SessionConfiguration { sessionStreamConfiguration :: StreamConfiguration
sessionStreamConfiguration = StreamConfiguration
forall a. Default a => a
def
, onConnectionClosed :: Session -> XmppFailure -> IO ()
onConnectionClosed = \Session
_ XmppFailure
_ -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
, sessionStanzaIDs :: IO (IO Text)
sessionStanzaIDs = do
TVar Integer
idRef <- Integer -> IO (TVar Integer)
forall a. a -> IO (TVar a)
newTVarIO Integer
1
IO Text -> IO (IO Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (IO Text -> IO (IO Text))
-> (STM Text -> IO Text) -> STM Text -> IO (IO Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. STM Text -> IO Text
forall a. STM a -> IO a
atomically (STM Text -> IO (IO Text)) -> STM Text -> IO (IO Text)
forall a b. (a -> b) -> a -> b
$ do
Integer
curId <- TVar Integer -> STM Integer
forall a. TVar a -> STM a
readTVar TVar Integer
idRef
TVar Integer -> Integer -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar Integer
idRef (Integer
curId Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
1 :: Integer)
Text -> STM Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> STM Text) -> (Integer -> Text) -> Integer -> STM Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack (String -> Text) -> (Integer -> String) -> Integer -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> String
forall a. Show a => a -> String
show (Integer -> STM Text) -> Integer -> STM Text
forall a b. (a -> b) -> a -> b
$ Integer
curId
, plugins :: [Plugin]
plugins = []
, enableRoster :: Bool
enableRoster = Bool
True
, initialRoster :: IO (Maybe Roster)
initialRoster = Maybe Roster -> IO (Maybe Roster)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Roster
forall a. Maybe a
Nothing
, onRosterPush :: Maybe RosterPushCallback
onRosterPush = Maybe RosterPushCallback
forall a. Maybe a
Nothing
, enablePresenceTracking :: Bool
enablePresenceTracking = Bool
True
, onPresenceChange :: Maybe (Jid -> PeerStatus -> PeerStatus -> IO ())
onPresenceChange = Maybe (Jid -> PeerStatus -> PeerStatus -> IO ())
forall a. Maybe a
Nothing
, keepAlive :: Maybe Int
keepAlive = Int -> Maybe Int
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
(Int -> IQSendError -> ShowS)
-> (IQSendError -> String)
-> ([IQSendError] -> ShowS)
-> Show IQSendError
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
(IQSendError -> IQSendError -> Bool)
-> (IQSendError -> IQSendError -> Bool) -> Eq IQSendError
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