From 33fea88dca26e3cc8a000ec1c6e043a9759d252c Mon Sep 17 00:00:00 2001
From: joe <joe@jerkface.net>
Date: Tue, 4 Mar 2014 02:22:30 -0500
Subject: Repaired broken stanzaFromList, probes are sent.

---
 Presence/XMPPServer.hs | 29 ++++++++++++++++++-----------
 1 file changed, 18 insertions(+), 11 deletions(-)

(limited to 'Presence/XMPPServer.hs')

diff --git a/Presence/XMPPServer.hs b/Presence/XMPPServer.hs
index f6df1525..0103ba46 100644
--- a/Presence/XMPPServer.hs
+++ b/Presence/XMPPServer.hs
@@ -456,22 +456,29 @@ stanzaFromList stype reply = do
         mid   = stanzaTag >>= lookupAttrib "id" . tagAttrs
         mfrom = stanzaTag >>= lookupAttrib "from" . tagAttrs
         mto = stanzaTag >>= lookupAttrib "to" . tagAttrs
+        {-
         isInternal (InternalEnableHack {}) = True
         isInternal (InternalCacheId {}) = True
         isInternal _ = False
-    atomically $ do
-        donevar <- newEmptyTMVar
+        -}
+    (donevar,replyChan,replyClsrs) <- atomically $ do
+        donevar <- newEmptyTMVar -- TMVar ()
         replyChan <- newLockedChan
         replyClsrs <- newTVar (Just [])
-        return Stanza { stanzaType = stype
-                      , stanzaId = mid
-                      , stanzaTo = mto      -- as-is from reply list
-                      , stanzaFrom = mfrom  -- as-is from reply list
-                      , stanzaChan = replyChan
-                      , stanzaClosers = replyClsrs
-                      , stanzaInterrupt = donevar
-                      , stanzaOrigin = LocalPeer
-                      }
+        return (donevar,replyChan, replyClsrs)
+    forkIO $ do
+        forM_ reply $ atomically . writeLChan replyChan
+        atomically $ do putTMVar donevar ()
+                        writeTVar replyClsrs Nothing
+    return Stanza { stanzaType = stype
+                  , stanzaId = mid
+                  , stanzaTo = mto      -- as-is from reply list
+                  , stanzaFrom = mfrom  -- as-is from reply list
+                  , stanzaChan = replyChan
+                  , stanzaClosers = replyClsrs
+                  , stanzaInterrupt = donevar
+                  , stanzaOrigin = LocalPeer
+                  }
 
 grokStanzaIQGet :: Monad m => XML.Event -> NestingXML o m (Maybe StanzaType)
 grokStanzaIQGet stanza = do
-- 
cgit v1.2.3