xmppSubscribeToRoster

1 files changed, 8 insertions, 1 deletions

diff --git a/Presence/XMPPServer.hs b/Presence/XMPPServer.hs
index 4c87ba65..83a9fb39 100644
--- a/Presence/XMPPServer.hs
+++ b/Presence/XMPPServer.hs
@@ -128,9 +128,11 @@ data XMPPServerParameters =
     , xmppRosterSubscribers  :: ConnectionKey -> IO [Text]
     , xmppRosterSolicited    :: ConnectionKey -> IO [Text]
     , xmppRosterOthers       :: ConnectionKey -> IO [Text]
+    , xmppSubscribeToRoster :: ConnectionKey -> IO ()
     , xmppLookupClientJID :: ConnectionKey -> IO Text
     , xmppLookupPeerName  :: ConnectionKey -> IO Text
     , xmppDeliverMessage :: (IO ()) -> Stanza -> IO ()
+    , xmppInformClientPresence :: ConnectionKey -> Stanza -> IO ()
     }
 
 -- TODO: http://xmpp.org/rfcs/rfc6120.html#rules-remote-error
@@ -797,6 +799,8 @@ sendRoster query xmpp replyto = do
 
 socketFromKey :: Server k -> k -> IO Socket
 socketFromKey sv k = do
+    let v = Map.lookup k $ conmap sv
+    flip (maybe $ todo) v $ \_ ->do
     return todo
 
 monitor sv params xmpp = do
@@ -835,11 +839,14 @@ monitor sv params xmpp = do
                         SessionRequest -> do
                             let reply = iq_session_reply (stanzaId stanza) "localhost"
                             sendReply quitVar Pong reply replyto
-                        RequestRoster ->
+                        RequestRoster -> do
                             sendRoster stanza xmpp replyto
+                            xmppSubscribeToRoster xmpp k
                         Message {} -> do
                             let fail = return () -- todo
                             xmppDeliverMessage xmpp fail stanza
+                        PresenceStatus {} -> do
+                            xmppInformClientPresence xmpp k stanza
                         UnrecognizedQuery query -> do
                             let reply = iq_service_unavailable (stanzaId stanza) "localhost" query
                             sendReply quitVar Error reply replyto