From 4efb81758cc5b839720e71ae0a42cdcb63b98d26 Mon Sep 17 00:00:00 2001
From: Philipp Balzarek <p.balzarek@googlemail.com>
Date: Wed, 29 Jan 2014 11:28:05 +0100
Subject: [PATCH] Check IQ response from addresses

---
 source/Network/Xmpp/Concurrent.hs       | 5 ++++-
 source/Network/Xmpp/Concurrent/IQ.hs    | 5 +++--
 source/Network/Xmpp/Concurrent/Types.hs | 2 +-
 3 files changed, 8 insertions(+), 4 deletions(-)

diff --git a/source/Network/Xmpp/Concurrent.hs b/source/Network/Xmpp/Concurrent.hs
index 0753c93..dd7137f 100644
--- a/source/Network/Xmpp/Concurrent.hs
+++ b/source/Network/Xmpp/Concurrent.hs
@@ -121,7 +121,8 @@ handleIQ iqHands out sta as = do
     handleIQResponse :: TVar IQHandlers -> Either IQError IQResult -> IO ()
     handleIQResponse handlers iq = atomically $ do
         (byNS, byID) <- readTVar handlers
-        case Map.updateLookupWithKey (\_ _ -> Nothing) (iqID iq) byID of
+        case Map.updateLookupWithKey (\_ _ -> Nothing) (iqID iq, iqFrom iq)
+                                     byID of
             (Nothing, _) -> return () -- We are not supposed to send an error.
             (Just tmvar, byID') -> do
                 let answer = Just (either IQResponseError IQResponseResult iq, as)
@@ -130,6 +131,8 @@ handleIQ iqHands out sta as = do
       where
         iqID (Left err') = iqErrorID err'
         iqID (Right iq') = iqResultID iq'
+        iqFrom (Left err') = iqErrorFrom err'
+        iqFrom (Right iq') = iqResultFrom iq'
 
 -- | Creates and initializes a new Xmpp context.
 newSession :: Stream
diff --git a/source/Network/Xmpp/Concurrent/IQ.hs b/source/Network/Xmpp/Concurrent/IQ.hs
index 9030abf..4234ff6 100644
--- a/source/Network/Xmpp/Concurrent/IQ.hs
+++ b/source/Network/Xmpp/Concurrent/IQ.hs
@@ -33,10 +33,11 @@ sendIQ :: Maybe Integer -- ^ Timeout . When the timeout is reached the response
        -> IO (Either XmppFailure (TMVar (Maybe (Annotated IQResponse))))
 sendIQ timeOut to tp lang body session = do -- TODO: Add timeout
     newId <- idGenerator session
+    let key = (newId, to)
     ref <- atomically $ do
         resRef <- newEmptyTMVar
         (byNS, byId) <- readTVar (iqHandlers session)
-        writeTVar (iqHandlers session) (byNS, Map.insert newId resRef byId)
+        writeTVar (iqHandlers session) (byNS, Map.insert key resRef byId)
           -- TODO: Check for id collisions (shouldn't happen?)
         return resRef
     res <- sendStanza (IQRequestS $ IQRequest newId Nothing to lang tp body) session
@@ -46,7 +47,7 @@ sendIQ timeOut to tp lang body session = do -- TODO: Add timeout
                 Nothing -> return ()
                 Just t -> void . forkIO $ do
                           delay t
-                          doTimeOut (iqHandlers session) newId ref
+                          doTimeOut (iqHandlers session) key ref
             return $ Right ref
         Left e -> return $ Left e
   where
diff --git a/source/Network/Xmpp/Concurrent/Types.hs b/source/Network/Xmpp/Concurrent/Types.hs
index 796e7fb..4f2b605 100644
--- a/source/Network/Xmpp/Concurrent/Types.hs
+++ b/source/Network/Xmpp/Concurrent/Types.hs
@@ -135,7 +135,7 @@ data Session = Session
 -- TMVars of and TMVars for expected IQ responses (the second Text represent a
 -- stanza identifier.
 type IQHandlers = ( Map.Map (IQRequestType, Text) (TChan IQRequestTicket)
-                  , Map.Map Text (TMVar (Maybe (Annotated IQResponse)))
+                  , Map.Map (Text, Maybe Jid) (TMVar (Maybe (Annotated IQResponse)))
                   )
 
 -- | Contains whether or not a reply has been sent, and the IQ request body to