wrapStanzaConduit for detection of interrupted stanzas

1 files changed, 9 insertions, 2 deletions

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