diff --git a/source/Network/Xmpp/Concurrent.hs b/source/Network/Xmpp/Concurrent.hs index 6896473..c91c1c1 100644 --- a/source/Network/Xmpp/Concurrent.hs +++ b/source/Network/Xmpp/Concurrent.hs @@ -73,8 +73,24 @@ handleIQ iqHands outC sta = atomically $ do case Map.lookup (iqRequestType iq, iqNS) byNS of Nothing -> writeTChan outC $ serviceUnavailable iq Just ch -> do - sent <- newTVar False - writeTChan ch $ IQRequestTicket sent iq + sentRef <- newTVar False + let answerT answer = do + let IQRequest iqid from _to lang _tp bd = iq + response = case answer of + Left er -> IQErrorS $ IQError iqid Nothing + from lang er + (Just bd) + Right res -> IQResultS $ IQResult iqid Nothing + from lang res + atomically $ do + sent <- readTVar sentRef + case sent of + False -> do + writeTVar sentRef True + writeTChan outC response + return True + True -> return False + writeTChan ch $ IQRequestTicket answerT iq serviceUnavailable (IQRequest iqid from _to lang _tp bd) = IQErrorS $ IQError iqid Nothing from lang err (Just bd) err = StanzaError Cancel ServiceUnavailable Nothing Nothing diff --git a/source/Network/Xmpp/Concurrent/IQ.hs b/source/Network/Xmpp/Concurrent/IQ.hs index a3c1860..4b6c462 100644 --- a/source/Network/Xmpp/Concurrent/IQ.hs +++ b/source/Network/Xmpp/Concurrent/IQ.hs @@ -103,23 +103,7 @@ dropIQChan tp ns session = do writeTVar handlers (byNS', byID) return () -answerIQ :: IQRequestTicket - -> Either StanzaError (Maybe Element) - -> Session - -> IO Bool -answerIQ (IQRequestTicket - sRef - (IQRequest iqid from _to lang _tp bd)) - answer session = 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 - atomically $ do - sent <- readTVar sRef - case sent of - False -> do - writeTVar sRef True - - writeTChan (outCh session) response - return True - True -> return False +-- | Answer an IQ request. Only the first answer ist sent and then True is +-- returned. Subsequent answers are dropped and (False is returned in that case) +answerIQ :: IQRequestTicket -> Either StanzaError (Maybe Element) -> IO Bool +answerIQ ticket = answerTicket ticket diff --git a/source/Network/Xmpp/Concurrent/Types.hs b/source/Network/Xmpp/Concurrent/Types.hs index c98e45c..c2b97b8 100644 --- a/source/Network/Xmpp/Concurrent/Types.hs +++ b/source/Network/Xmpp/Concurrent/Types.hs @@ -10,6 +10,7 @@ import qualified Data.ByteString as BS import qualified Data.Map as Map import Data.Text (Text) import Data.Typeable +import Data.XML.Types (Element) import Network.Xmpp.IM.Roster.Types import Network.Xmpp.Types @@ -56,6 +57,6 @@ type IQHandlers = (Map.Map (IQRequestType, Text) (TChan IQRequestTicket) -- | Contains whether or not a reply has been sent, and the IQ request body to -- reply to. data IQRequestTicket = IQRequestTicket - { sentRef :: (TVar Bool) + { answerTicket :: Either StanzaError (Maybe Element) -> IO Bool , iqRequestBody :: IQRequest }