add IQRequestTicket

src/Network/XMPP.hs

@@ -113,6 +113,8 @@ module Network.XMPP
   --
   -- <http://xmpp.org/rfcs/rfc6120.html#stanzas-semantics-iq>
   , IQRequest(..)
+  , IQRequestTicket
+  , iqRequestBody
   , IQRequestType(..)
   , IQResult(..)
   , IQError(..)
@@ -136,8 +138,7 @@ import Network
 import qualified Network.TLS as TLS
 import Network.XMPP.Bind
 import Network.XMPP.Concurrent
-import Network.XMPP.IM.Presence hiding (presence)
+import Network.XMPP.Concurrent.Types
-import Network.XMPP.IM.Message
 import Network.XMPP.Message
 import Network.XMPP.Monad
 import Network.XMPP.Presence

src/Network/XMPP/Concurrent/IQ.hs

@@ -40,10 +40,13 @@ sendIQ' to tp lang body = do
   ref <- sendIQ to tp lang body
   liftIO . atomically $ takeTMVar ref
 
-answerIQ :: (IQRequest, TVar Bool)
+answerIQ :: IQRequestTicket
          -> Either StanzaError (Maybe Element)
          -> XMPP Bool
-answerIQ ((IQRequest iqid from _to lang _tp bd), sentRef) answer = do
+answerIQ (IQRequestTicket
+              sentRef
+              (IQRequest iqid from _to lang _tp bd))
+           answer = do
   out <- asks outCh
   let response = case answer of
         Left err  -> IQErrorS $ IQError iqid Nothing from lang err (Just bd)

src/Network/XMPP/Concurrent/Monad.hs

@@ -24,7 +24,7 @@ import           Network.XMPP.Monad
 -- combination was alread handled
 listenIQChan :: IQRequestType  -- ^ type of IQs to receive (Get / Set)
                 -> Text -- ^ namespace of the child element
-                -> XMPP (Maybe ( TChan (IQRequest, TVar Bool)))
+                -> XMPP (Maybe ( TChan IQRequestTicket))
 listenIQChan tp ns = do
   handlers <- asks iqHandlers
   liftIO . atomically $ do

src/Network/XMPP/Concurrent/Threads.hs

@@ -107,8 +107,7 @@ handleIQRequest handlers iq = do
       Nothing -> return () -- TODO: send error stanza
       Just ch -> do
         sent <- newTVar False
-        writeTChan ch (iq, sent)
+        writeTChan ch $ IQRequestTicket sent iq
-
 handleIQResponse :: TVar IQHandlers -> Either IQError IQResult -> STM ()
 handleIQResponse handlers iq = do
   (byNS, byID) <- readTVar handlers

src/Network/XMPP/Concurrent/Types.hs

@@ -18,7 +18,7 @@ import           Data.Typeable
 import           Network.XMPP.Types
 
 
-type IQHandlers = (Map.Map (IQRequestType, Text) (TChan (IQRequest, TVar Bool))
+type IQHandlers = (Map.Map (IQRequestType, Text) (TChan IQRequestTicket)
                   , Map.Map StanzaId (TMVar IQResponse)
                   )
 
@@ -60,3 +60,8 @@ type XMPP a = ReaderT Session IO a
 data Interrupt = Interrupt (TMVar ()) deriving Typeable
 instance Show Interrupt where show _ = "<Interrupt>"
 instance Ex.Exception Interrupt
+
+data IQRequestTicket = IQRequestTicket
+                           { sentRef     :: (TVar Bool)
+                           , iqRequestBody :: IQRequest
+                           }

src/Tests.hs

@@ -60,8 +60,9 @@ iqResponder = do
                      >> error "hanging up"
       Just c -> return c
   forever $ do
-    next@(iq,_) <- liftIO . atomically $ readTChan chan
+    next <- liftIO . atomically $ readTChan chan
-    let Right payload = unpickleElem payloadP $ iqRequestPayload iq
+    let Right payload = unpickleElem payloadP . iqRequestPayload $
+                          iqRequestBody next
     let answerPayload = invertPayload payload
     let answerBody = pickleElem payloadP answerPayload
     answerIQ next (Right $ Just answerBody)