Browse Source

rename CSession to Context

rename forkSessionChan to forkContext
master
Philipp Balzarek 13 years ago
parent
commit
3ff3c71a98
  1. 6
      source/Network/Xmpp.hs
  2. 10
      source/Network/Xmpp/Concurrent/Channels.hs
  3. 8
      source/Network/Xmpp/Concurrent/Channels/Basic.hs
  4. 34
      source/Network/Xmpp/Concurrent/Channels/IQ.hs
  5. 14
      source/Network/Xmpp/Concurrent/Channels/Message.hs
  6. 10
      source/Network/Xmpp/Concurrent/Channels/Presence.hs
  7. 2
      source/Network/Xmpp/Concurrent/Channels/Types.hs
  8. 4
      source/Network/Xmpp/Xep/ServiceDiscovery.hs

6
source/Network/Xmpp.hs

@ -29,8 +29,8 @@ @@ -29,8 +29,8 @@
module Network.Xmpp
( -- * Session management
Session
, newSessionChans
Context
, newContext
, withConnection
, connect
, simpleConnect
@ -141,7 +141,7 @@ module Network.Xmpp @@ -141,7 +141,7 @@ module Network.Xmpp
, iqRequestPayload
, iqResultPayload
-- * Threads
, forkCSession
, forkContext
-- * Miscellaneous
, LangTag(..)
, exampleParams

10
source/Network/Xmpp/Concurrent/Channels.hs

@ -6,7 +6,7 @@ module Network.Xmpp.Concurrent.Channels @@ -6,7 +6,7 @@ module Network.Xmpp.Concurrent.Channels
, module Network.Xmpp.Concurrent.Channels.Presence
, module Network.Xmpp.Concurrent.Channels.IQ
, toChans
, newSessionChans
, newContext
, writeWorker
)
@ -90,9 +90,9 @@ toChans messageC presenceC stanzaC iqHands sta = atomically $ do @@ -90,9 +90,9 @@ toChans messageC presenceC stanzaC iqHands sta = atomically $ do
iqID (Right iq') = iqResultID iq'
-- | Creates and initializes a new concurrent session.
newSessionChans :: IO CSession
newSessionChans = do
-- | Creates and initializes a new concurrent context.
newContext :: IO Context
newContext = do
messageC <- newTChanIO
presenceC <- newTChanIO
outC <- newTChanIO
@ -116,7 +116,7 @@ newSessionChans = do @@ -116,7 +116,7 @@ newSessionChans = do
, eventHandlers = eh
, stopThreads = kill >> killThread writer
}
return $ CSession { session = sess
return $ Context { session = sess
, mShadow = messageC
, pShadow = presenceC
, sShadow = stanzaC

8
source/Network/Xmpp/Concurrent/Channels/Basic.hs

@ -6,16 +6,16 @@ import Network.Xmpp.Concurrent.Channels.Types @@ -6,16 +6,16 @@ import Network.Xmpp.Concurrent.Channels.Types
import Network.Xmpp.Types
-- | Get a duplicate of the stanza channel
getStanzaChan :: CSession -> IO (TChan Stanza)
getStanzaChan :: Context -> IO (TChan Stanza)
getStanzaChan session = atomically $ dupTChan (sShadow session)
-- | Send a stanza to the server.
sendStanza :: Stanza -> CSession -> IO ()
sendStanza :: Stanza -> Context -> IO ()
sendStanza a session = atomically $ writeTChan (outCh session) a
-- | Create a forked session object
forkCSession :: CSession -> IO CSession
forkCSession session = do
forkContext :: Context -> IO Context
forkContext session = do
mCH' <- newIORef Nothing
pCH' <- newIORef Nothing
return $ session {messagesRef = mCH' , presenceRef = pCH'}

34
source/Network/Xmpp/Concurrent/Channels/IQ.hs

@ -23,28 +23,28 @@ sendIQ :: Maybe Int -- ^ Timeout @@ -23,28 +23,28 @@ sendIQ :: Maybe Int -- ^ Timeout
-> Maybe LangTag -- ^ Language tag of the payload (@Nothing@ for
-- default)
-> Element -- ^ The IQ body (there has to be exactly one)
-> CSession
-> Context
-> IO (TMVar IQResponse)
sendIQ timeOut to tp lang body csession = do -- TODO: Add timeout
newId <- idGenerator (session csession)
sendIQ timeOut to tp lang body context = do -- TODO: Add timeout
newId <- idGenerator (session context)
ref <- atomically $ do
resRef <- newEmptyTMVar
(byNS, byId) <- readTVar (iqHandlers csession)
writeTVar (iqHandlers csession) (byNS, Map.insert newId resRef byId)
(byNS, byId) <- readTVar (iqHandlers context)
writeTVar (iqHandlers context) (byNS, Map.insert newId resRef byId)
-- TODO: Check for id collisions (shouldn't happen?)
return resRef
sendStanza (IQRequestS $ IQRequest newId Nothing to lang tp body) csession
sendStanza (IQRequestS $ IQRequest newId Nothing to lang tp body) context
case timeOut of
Nothing -> return ()
Just t -> void . forkIO $ do
threadDelay t
doTimeOut (iqHandlers csession) newId ref
doTimeOut (iqHandlers context) newId ref
return ref
where
doTimeOut handlers iqid var = atomically $ do
p <- tryPutTMVar var IQResponseTimeout
when p $ do
(byNS, byId) <- readTVar (iqHandlers csession)
(byNS, byId) <- readTVar (iqHandlers context)
writeTVar handlers (byNS, Map.delete iqid byId)
return ()
@ -54,10 +54,10 @@ sendIQ' :: Maybe Jid @@ -54,10 +54,10 @@ sendIQ' :: Maybe Jid
-> IQRequestType
-> Maybe LangTag
-> Element
-> CSession
-> Context
-> IO IQResponse
sendIQ' to tp lang body csession = do
ref <- sendIQ (Just 3000000) to tp lang body csession
sendIQ' to tp lang body context = do
ref <- sendIQ (Just 3000000) to tp lang body context
atomically $ takeTMVar ref
@ -68,10 +68,10 @@ sendIQ' to tp lang body csession = do @@ -68,10 +68,10 @@ sendIQ' to tp lang body csession = do
-- to interfere with existing consumers.
listenIQChan :: IQRequestType -- ^ Type of IQs to receive (@Get@ or @Set@)
-> Text -- ^ Namespace of the child element
-> CSession
-> Context
-> IO (Either (TChan IQRequestTicket) (TChan IQRequestTicket))
listenIQChan tp ns csession = do
let handlers = (iqHandlers csession)
listenIQChan tp ns context = do
let handlers = (iqHandlers context)
atomically $ do
(byNS, byID) <- readTVar handlers
iqCh <- newTChan
@ -87,12 +87,12 @@ listenIQChan tp ns csession = do @@ -87,12 +87,12 @@ listenIQChan tp ns csession = do
answerIQ :: IQRequestTicket
-> Either StanzaError (Maybe Element)
-> CSession
-> Context
-> IO Bool
answerIQ (IQRequestTicket
sentRef
(IQRequest iqid from _to lang _tp bd))
answer csession = do
answer context = do
let response = case answer of
Left err -> IQErrorS $ IQError iqid Nothing from lang err (Just bd)
Right res -> IQResultS $ IQResult iqid Nothing from lang res
@ -102,6 +102,6 @@ answerIQ (IQRequestTicket @@ -102,6 +102,6 @@ answerIQ (IQRequestTicket
False -> do
writeTVar sentRef True
writeTChan (outCh csession) response
writeTChan (outCh context) response
return True
True -> return False

14
source/Network/Xmpp/Concurrent/Channels/Message.hs

@ -10,7 +10,7 @@ import Network.Xmpp.Concurrent.Channels.Basic @@ -10,7 +10,7 @@ import Network.Xmpp.Concurrent.Channels.Basic
-- | Get the inbound stanza channel, duplicates from master if necessary. Please
-- note that once duplicated it will keep filling up, call 'dropMessageChan' to
-- allow it to be garbage collected.
getMessageChan :: CSession -> IO (TChan (Either MessageError Message))
getMessageChan :: Context -> IO (TChan (Either MessageError Message))
getMessageChan session = do
mCh <- readIORef . messagesRef $ session
case mCh of
@ -22,19 +22,19 @@ getMessageChan session = do @@ -22,19 +22,19 @@ getMessageChan session = do
-- | Drop the local end of the inbound stanza channel from our context so it can
-- be GC-ed.
dropMessageChan :: CSession -> IO ()
dropMessageChan :: Context -> IO ()
dropMessageChan session = writeIORef (messagesRef session) Nothing
-- | Read an element from the inbound stanza channel, acquiring a copy of the
-- channel as necessary.
pullMessage :: CSession -> IO (Either MessageError Message)
pullMessage :: Context -> IO (Either MessageError Message)
pullMessage session = do
c <- getMessageChan session
atomically $ readTChan c
-- | Pulls a (non-error) message and returns it if the given predicate returns
-- @True@.
waitForMessage :: (Message -> Bool) -> CSession -> IO Message
waitForMessage :: (Message -> Bool) -> Context -> IO Message
waitForMessage f session = do
s <- pullMessage session
case s of
@ -43,7 +43,7 @@ waitForMessage f session = do @@ -43,7 +43,7 @@ waitForMessage f session = do
| otherwise -> waitForMessage f session
-- | Pulls an error message and returns it if the given predicate returns @True@.
waitForMessageError :: (MessageError -> Bool) -> CSession -> IO MessageError
waitForMessageError :: (MessageError -> Bool) -> Context -> IO MessageError
waitForMessageError f session = do
s <- pullMessage session
case s of
@ -55,7 +55,7 @@ waitForMessageError f session = do @@ -55,7 +55,7 @@ waitForMessageError f session = do
-- | Pulls a message and returns it if the given predicate returns @True@.
filterMessages :: (MessageError -> Bool)
-> (Message -> Bool)
-> CSession -> IO (Either MessageError Message)
-> Context -> IO (Either MessageError Message)
filterMessages f g session = do
s <- pullMessage session
case s of
@ -65,5 +65,5 @@ filterMessages f g session = do @@ -65,5 +65,5 @@ filterMessages f g session = do
| otherwise -> filterMessages f g session
-- | Send a message stanza.
sendMessage :: Message -> CSession -> IO ()
sendMessage :: Message -> Context -> IO ()
sendMessage m session = sendStanza (MessageS m) session

10
source/Network/Xmpp/Concurrent/Channels/Presence.hs

@ -8,7 +8,7 @@ import Network.Xmpp.Concurrent.Types @@ -8,7 +8,7 @@ import Network.Xmpp.Concurrent.Types
import Network.Xmpp.Concurrent.Channels.Basic
-- | Analogous to 'getMessageChan'.
getPresenceChan :: CSession -> IO (TChan (Either PresenceError Presence))
getPresenceChan :: Context -> IO (TChan (Either PresenceError Presence))
getPresenceChan session = do
pCh <- readIORef $ (presenceRef session)
case pCh of
@ -20,20 +20,20 @@ getPresenceChan session = do @@ -20,20 +20,20 @@ getPresenceChan session = do
-- | Analogous to 'dropMessageChan'.
dropPresenceChan :: CSession -> IO ()
dropPresenceChan :: Context -> IO ()
dropPresenceChan session = writeIORef (presenceRef session) Nothing
-- | Read an element from the inbound stanza channel, acquiring a copy of the
-- channel as necessary.
pullPresence :: CSession -> IO (Either PresenceError Presence)
pullPresence :: Context -> IO (Either PresenceError Presence)
pullPresence session = do
c <- getPresenceChan session
atomically $ readTChan c
-- | Pulls a (non-error) presence and returns it if the given predicate returns
-- @True@.
waitForPresence :: (Presence -> Bool) -> CSession -> IO Presence
waitForPresence :: (Presence -> Bool) -> Context -> IO Presence
waitForPresence f session = do
s <- pullPresence session
case s of
@ -42,5 +42,5 @@ waitForPresence f session = do @@ -42,5 +42,5 @@ waitForPresence f session = do
| otherwise -> waitForPresence f session
-- | Send a presence stanza.
sendPresence :: Presence -> CSession -> IO ()
sendPresence :: Presence -> Context -> IO ()
sendPresence p session = sendStanza (PresenceS p) session

2
source/Network/Xmpp/Concurrent/Channels/Types.hs

@ -8,7 +8,7 @@ import Network.Xmpp.Concurrent.Types @@ -8,7 +8,7 @@ import Network.Xmpp.Concurrent.Types
import Network.Xmpp.Types
-- | Session with Channels
data CSession = CSession
data Context = Context
{ session :: Session
-- The original master channels that the reader puts stanzas
-- into. These are cloned by @get{STanza,Message,Presence}Chan

4
source/Network/Xmpp/Xep/ServiceDiscovery.hs

@ -86,7 +86,7 @@ xpQueryInfo = xpWrap (\(nd, (feats, ids)) -> QIR nd ids feats) @@ -86,7 +86,7 @@ xpQueryInfo = xpWrap (\(nd, (feats, ids)) -> QIR nd ids feats)
-- | Query an entity for it's identity and features
queryInfo :: Jid -- ^ Entity to query
-> Maybe Text.Text -- ^ Node
-> CSession
-> Context
-> IO (Either DiscoError QueryInfoResult)
queryInfo to node session = do
res <- sendIQ' (Just to) Get Nothing queryBody session
@ -149,7 +149,7 @@ xpQueryItems = xpElem (itemsN "query") @@ -149,7 +149,7 @@ xpQueryItems = xpElem (itemsN "query")
-- | Query an entity for Items of a node
queryItems :: Jid -- ^ Entity to query
-> Maybe Text.Text -- ^ Node
-> CSession
-> Context
-> IO (Either DiscoError (Maybe Text.Text, [Item]))
queryItems to node session = do
res <- sendIQ' (Just to) Get Nothing queryBody session

Loading…
Cancel
Save