refactor answerIQ. The ticket now contains the method to answer itself, so tickets can now be answered without needing access to the unerlying session.

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

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

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
     }