module Network.Xmpp.Concurrent.Types where
import Control.Concurrent
import Control.Concurrent.STM
import qualified Control.Exception.Lifted as Ex
import Control.Monad.Error
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
import Network.Xmpp.IM.Roster.Types
import Network.Xmpp.Sasl.Types
import Network.Xmpp.Types
type StanzaHandler = (Stanza -> IO (Either XmppFailure ()) )
-> Stanza
-> [Annotation]
-> IO [(Stanza, [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 x) = "Annotation{ fromAnnotation = " ++ show x ++ "}"
type Annotated a = (a, [Annotation])
getAnnotation :: Typeable b => Annotated a -> Maybe b
getAnnotation = foldr (\(Annotation a) b -> maybe b Just $ cast a) Nothing . snd
data Plugin' = Plugin'
{
inHandler :: Stanza
-> [Annotation]
-> IO [(Stanza, [Annotation])]
, outHandler :: Stanza -> IO (Either XmppFailure ())
, onSessionUp :: Session -> IO ()
}
type Plugin = (Stanza -> IO (Either XmppFailure ()))
-> ErrorT XmppFailure IO Plugin'
data SessionConfiguration = SessionConfiguration
{
sessionStreamConfiguration :: StreamConfiguration
, onConnectionClosed :: Session -> XmppFailure -> IO ()
, sessionStanzaIDs :: IO (IO Text)
, plugins :: [Plugin]
, enableRoster :: Bool
}
instance Default SessionConfiguration where
def = SessionConfiguration { sessionStreamConfiguration = def
, onConnectionClosed = \_ _ -> return ()
, sessionStanzaIDs = do
idRef <- newTVarIO 1
return . atomically $ do
curId <- readTVar idRef
writeTVar idRef (curId + 1 :: Integer)
return . Text.pack . show $ curId
, plugins = []
, enableRoster = True
}
data EventHandlers = EventHandlers
{ connectionClosedHandler :: XmppFailure -> IO ()
}
data Interrupt = Interrupt (TMVar ()) deriving Typeable
instance Show Interrupt where show _ = "<Interrupt>"
instance Ex.Exception Interrupt
type WriteSemaphore = TMVar (BS.ByteString -> IO (Either XmppFailure ()))
data Session = Session
{ stanzaCh :: TChan (Stanza, [Annotation])
, iqHandlers :: TVar IQHandlers
, writeSemaphore :: WriteSemaphore
, readerThread :: ThreadId
, idGenerator :: IO Text
, streamRef :: TMVar Stream
, eventHandlers :: TMVar EventHandlers
, stopThreads :: IO ()
, rosterRef :: TVar Roster
, conf :: SessionConfiguration
, sendStanza' :: Stanza -> IO (Either XmppFailure ())
, sRealm :: HostName
, sSaslCredentials :: Maybe (ConnectionState -> [SaslHandler] , Maybe Text)
, 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
{
answerTicket :: Either StanzaError (Maybe Element)
-> IO (Maybe (Either XmppFailure ()))
, iqRequestBody :: IQRequest
, iqRequestAnnotations :: [Annotation]
}
data IQSendError = IQSendError XmppFailure
| IQTimeOut
deriving (Show, Eq)