summaryrefslogtreecommitdiff
path: root/Presence
diff options
context:
space:
mode:
Diffstat (limited to 'Presence')
-rw-r--r--Presence/XMPPServer.hs4
1 files changed, 4 insertions, 0 deletions
diff --git a/Presence/XMPPServer.hs b/Presence/XMPPServer.hs
index 7fc11124..b9719fa4 100644
--- a/Presence/XMPPServer.hs
+++ b/Presence/XMPPServer.hs
@@ -183,6 +183,7 @@ data XMPPServerParameters =
183 , xmppTellClientNameOfPeer :: ConnectionKey -> IO Text 183 , xmppTellClientNameOfPeer :: ConnectionKey -> IO Text
184 , xmppDeliverMessage :: (IO ()) -> Stanza -> IO () 184 , xmppDeliverMessage :: (IO ()) -> Stanza -> IO ()
185 , xmppInformClientPresence :: ConnectionKey -> Stanza -> IO () 185 , xmppInformClientPresence :: ConnectionKey -> Stanza -> IO ()
186 , xmppInformPeerPresence :: ConnectionKey -> Stanza -> IO ()
186 , xmppAnswerProbe :: ConnectionKey -> Stanza -> TChan Stanza -> IO () 187 , xmppAnswerProbe :: ConnectionKey -> Stanza -> TChan Stanza -> IO ()
187 } 188 }
188 189
@@ -1168,6 +1169,7 @@ forkConnection sv xmpp k laddr pingflag src snk stanzas = do
1168 _ -> return () 1169 _ -> return ()
1169 stanzaToConduit stanza =$= wrapStanzaConduit stanza 1170 stanzaToConduit stanza =$= wrapStanzaConduit stanza
1170 $$ awaitForever 1171 $$ awaitForever
1172 -- TODO: PresenceStatus stanzas should be pushed to appropriate slots
1171 $ liftIO . atomically . Slotted.push slots Nothing 1173 $ liftIO . atomically . Slotted.push slots Nothing
1172 case stanzaType stanza of 1174 case stanzaType stanza of
1173 Error err tag | tagName tag=="{jabber:client}message" -> do 1175 Error err tag | tagName tag=="{jabber:client}message" -> do
@@ -1578,6 +1580,8 @@ monitor sv params xmpp = do
1578 case stanzaType stanza of 1580 case stanzaType stanza of
1579 PresenceRequestStatus {} -> do 1581 PresenceRequestStatus {} -> do
1580 xmppAnswerProbe xmpp k stanza replyto 1582 xmppAnswerProbe xmpp k stanza replyto
1583 PresenceStatus {} -> do
1584 xmppInformPeerPresence xmpp k stanza
1581 _ -> return () 1585 _ -> return ()
1582 _ -> return () 1586 _ -> return ()
1583 let deliver replyto = do 1587 let deliver replyto = do