summaryrefslogtreecommitdiff
path: root/Presence/XMPPServer.hs
diff options
context:
space:
mode:
authorjoe <joe@jerkface.net>2014-03-04 02:22:30 -0500
committerjoe <joe@jerkface.net>2014-03-04 02:22:30 -0500
commit33fea88dca26e3cc8a000ec1c6e043a9759d252c (patch)
treec22ea7bd569410747485ac08528c19076be05007 /Presence/XMPPServer.hs
parentcefae0f42db7cae156dfd0c42c9bea3eb534b21c (diff)
Repaired broken stanzaFromList, probes are sent.
Diffstat (limited to 'Presence/XMPPServer.hs')
-rw-r--r--Presence/XMPPServer.hs29
1 files changed, 18 insertions, 11 deletions
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
456 mid = stanzaTag >>= lookupAttrib "id" . tagAttrs 456 mid = stanzaTag >>= lookupAttrib "id" . tagAttrs
457 mfrom = stanzaTag >>= lookupAttrib "from" . tagAttrs 457 mfrom = stanzaTag >>= lookupAttrib "from" . tagAttrs
458 mto = stanzaTag >>= lookupAttrib "to" . tagAttrs 458 mto = stanzaTag >>= lookupAttrib "to" . tagAttrs
459 {-
459 isInternal (InternalEnableHack {}) = True 460 isInternal (InternalEnableHack {}) = True
460 isInternal (InternalCacheId {}) = True 461 isInternal (InternalCacheId {}) = True
461 isInternal _ = False 462 isInternal _ = False
462 atomically $ do 463 -}
463 donevar <- newEmptyTMVar 464 (donevar,replyChan,replyClsrs) <- atomically $ do
465 donevar <- newEmptyTMVar -- TMVar ()
464 replyChan <- newLockedChan 466 replyChan <- newLockedChan
465 replyClsrs <- newTVar (Just []) 467 replyClsrs <- newTVar (Just [])
466 return Stanza { stanzaType = stype 468 return (donevar,replyChan, replyClsrs)
467 , stanzaId = mid 469 forkIO $ do
468 , stanzaTo = mto -- as-is from reply list 470 forM_ reply $ atomically . writeLChan replyChan
469 , stanzaFrom = mfrom -- as-is from reply list 471 atomically $ do putTMVar donevar ()
470 , stanzaChan = replyChan 472 writeTVar replyClsrs Nothing
471 , stanzaClosers = replyClsrs 473 return Stanza { stanzaType = stype
472 , stanzaInterrupt = donevar 474 , stanzaId = mid
473 , stanzaOrigin = LocalPeer 475 , stanzaTo = mto -- as-is from reply list
474 } 476 , stanzaFrom = mfrom -- as-is from reply list
477 , stanzaChan = replyChan
478 , stanzaClosers = replyClsrs
479 , stanzaInterrupt = donevar
480 , stanzaOrigin = LocalPeer
481 }
475 482
476grokStanzaIQGet :: Monad m => XML.Event -> NestingXML o m (Maybe StanzaType) 483grokStanzaIQGet :: Monad m => XML.Event -> NestingXML o m (Maybe StanzaType)
477grokStanzaIQGet stanza = do 484grokStanzaIQGet stanza = do