diff options
Diffstat (limited to 'Presence')
-rw-r--r-- | Presence/XMPPServer.hs | 11 |
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 | |||
731 | mfrom = m >>= lookupAttrib "from" . tagAttrs | 731 | mfrom = m >>= lookupAttrib "from" . tagAttrs |
732 | mid = m >>= lookupAttrib "id" . tagAttrs | 732 | mid = m >>= lookupAttrib "id" . tagAttrs |
733 | 733 | ||
734 | wrapStanzaConduit stanza = do | ||
735 | mfirst <- await | ||
736 | flip (maybe $ return ()) mfirst $ \first -> do | ||
737 | yield . Left $ stanza { stanzaChan = first } | ||
738 | awaitForever $ yield . Right | ||
739 | |||
740 | |||
734 | 741 | ||
735 | {- | 742 | {- |
736 | greet namespace = | 743 | greet namespace = |
@@ -838,9 +845,9 @@ forkConnection sv xmpp k laddr pingflag src snk stanzas = do | |||
838 | PeerKey {} -> "P" | 845 | PeerKey {} -> "P" |
839 | wlog "" | 846 | wlog "" |
840 | stanzaToConduit dup $$ prettyPrint typ | 847 | stanzaToConduit dup $$ prettyPrint typ |
841 | stanzaToConduit stanza | 848 | stanzaToConduit stanza =$= wrapStanzaConduit stanza |
842 | $$ awaitForever | 849 | $$ awaitForever |
843 | $ liftIO . atomically . Slotted.push slots Nothing . Right | 850 | $ liftIO . atomically . Slotted.push slots Nothing |
844 | loop | 851 | loop |
845 | ,do pingflag >>= check | 852 | ,do pingflag >>= check |
846 | return $ do | 853 | return $ do |