From 0bb4f4dabb88b4f7b2901aae443386c0e214c78b Mon Sep 17 00:00:00 2001
From: Philipp Balzarek <p.balzarek@googlemail.com>
Date: Tue, 30 Apr 2013 15:29:01 +0200
Subject: [PATCH] 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       | 20 ++++++++++++++++++--
 source/Network/Xmpp/Concurrent/IQ.hs    | 24 ++++--------------------
 source/Network/Xmpp/Concurrent/Types.hs |  3 ++-
 3 files changed, 24 insertions(+), 23 deletions(-)

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
     }