From 94bd6f5bfb300722454ffe91034118b90dfe4505 Mon Sep 17 00:00:00 2001
From: joe <joe@jerkface.net>
Date: Tue, 18 Feb 2014 19:25:13 -0500
Subject: wrapStanzaConduit for detection of interrupted stanzas

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

(limited to 'Presence')

diff --git a/Presence/XMPPServer.hs b/Presence/XMPPServer.hs
index f29179e5..6e0f5c5f 100644
--- a/Presence/XMPPServer.hs
+++ b/Presence/XMPPServer.hs
@@ -731,6 +731,13 @@ wrapStanzaList xs = do
     mfrom = m >>= lookupAttrib "from" . tagAttrs
     mid = m >>= lookupAttrib "id" . tagAttrs
 
+wrapStanzaConduit stanza = do
+    mfirst <- await
+    flip (maybe $ return ()) mfirst $ \first -> do
+    yield . Left $ stanza { stanzaChan = first }
+    awaitForever $ yield . Right
+
+
 
 {-
 greet namespace =
@@ -838,9 +845,9 @@ forkConnection sv xmpp k laddr pingflag src snk stanzas = do
                                     PeerKey {}   -> "P"
                         wlog ""
                         stanzaToConduit dup $$ prettyPrint typ
-                    stanzaToConduit stanza
+                    stanzaToConduit stanza =$= wrapStanzaConduit stanza
                         $$ awaitForever
-                            $ liftIO . atomically . Slotted.push slots Nothing . Right
+                            $ liftIO . atomically . Slotted.push slots Nothing
                     loop
                 ,do pingflag >>= check
                     return $ do
-- 
cgit v1.2.3