Browse Source

minor formatting and documentation additions

master
Jon Kristensen 14 years ago
parent
commit
c029d6e1d4
  1. 45
      src/Network/XMPP/Concurrent/IQ.hs

45
src/Network/XMPP/Concurrent/IQ.hs

@ -12,13 +12,14 @@ import Network.XMPP.Concurrent.Monad @@ -12,13 +12,14 @@ import Network.XMPP.Concurrent.Monad
import Network.XMPP.Types
-- | Sends an IQ, returns a 'TMVar' that will be filled with the first inbound
-- IQ with a matching ID that has type @result@ or @error@
-- IQ with a matching ID that has type @result@ or @error@.
sendIQ :: Maybe JID -- ^ Recipient (to)
-> IQRequestType -- ^ IQ type (Get or Set)
-> Maybe LangTag -- ^ Language tag of the payload (Nothing for default)
-> Element -- ^ The iq body (there has to be exactly one)
-> XMPP (TMVar IQResponse)
sendIQ to tp lang body = do -- TODO: add timeout
-> IQRequestType -- ^ IQ type (@Get@ or @Set@)
-> Maybe LangTag -- ^ Language tag of the payload (@Nothing@ for
-- default)
-> Element -- ^ The IQ body (there has to be exactly one)
-> XMPP (TMVar IQResponse)
sendIQ to tp lang body = do -- TODO: Add timeout
newId <- liftIO =<< asks idGenerator
handlers <- asks iqHandlers
ref <- liftIO . atomically $ do
@ -30,30 +31,30 @@ sendIQ to tp lang body = do -- TODO: add timeout @@ -30,30 +31,30 @@ sendIQ to tp lang body = do -- TODO: add timeout
sendStanza . IQRequestS $ IQRequest newId Nothing to lang tp body
return ref
-- | like 'sendIQ', but waits for the answer IQ
-- | Like 'sendIQ', but waits for the answer IQ.
sendIQ' :: Maybe JID
-> IQRequestType
-> Maybe LangTag
-> Element
-> XMPP IQResponse
sendIQ' to tp lang body = do
ref <- sendIQ to tp lang body
liftIO . atomically $ takeTMVar ref
ref <- sendIQ to tp lang body
liftIO . atomically $ takeTMVar ref
-- TODO: What is the TVar Bool? Why are they in a tuple?
answerIQ :: (IQRequest, TVar Bool)
-> Either StanzaError (Maybe Element)
-> XMPP Bool
answerIQ ((IQRequest iqid from _to lang _tp bd), sentRef) answer = do
out <- asks outCh
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
liftIO . atomically $ do
sent <- readTVar sentRef
case sent of
False -> do
writeTVar sentRef True
writeTChan out response
return True
True -> return False
out <- asks outCh
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
liftIO . atomically $ do
sent <- readTVar sentRef
case sent of
False -> do
writeTVar sentRef True
writeTChan out response
return True
True -> return False
Loading…
Cancel
Save