From 1ca1927a27ab4200c9a71f2e6ab4fd6be860e92f Mon Sep 17 00:00:00 2001 From: joe Date: Sun, 16 Feb 2014 22:31:49 -0500 Subject: xmppSubscribeToRoster --- Presence/XMPPServer.hs | 9 ++++++++- 1 file changed, 8 insertions(+), 1 deletion(-) (limited to 'Presence/XMPPServer.hs') 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 -- cgit v1.2.3