From b867a70b2321065d3d98cb55df96a3083e217018 Mon Sep 17 00:00:00 2001 From: joe Date: Fri, 7 Mar 2014 22:54:03 -0500 Subject: peerSubscriptionRequest todo stub --- xmppServer.hs | 27 +++++++++++++++++++++++---- 1 file changed, 23 insertions(+), 4 deletions(-) (limited to 'xmppServer.hs') diff --git a/xmppServer.hs b/xmppServer.hs index 41f0012e..7f610587 100644 --- a/xmppServer.hs +++ b/xmppServer.hs @@ -613,15 +613,33 @@ sendCachedPresence state k = do -- send local buddies. return () -clientSubscriptionRequest :: PresenceState -> IO () -> ConnectionKey -> Stanza -> IO () -clientSubscriptionRequest state fail k stanza = do +clientSubscriptionRequest :: PresenceState -> IO () -> ConnectionKey -> Stanza -> TChan Stanza -> IO () +clientSubscriptionRequest state fail k stanza chan = do flip (maybe fail) (stanzaTo stanza) $ \to -> do -- TODO: resolve hostname - -- TODO: add to solicitors - -- TODO; if already connected, send solicitation + -- TODO: add to solicited + -- TODO; if already connected, send solicitation -- TODO: addPeer return () +peerSubscriptionRequest :: PresenceState -> IO () -> ConnectionKey -> Stanza -> TChan Stanza -> IO () +peerSubscriptionRequest state fail k stanza chan = do + -- TODO: if already subscribed, reply and quit + + -- TODO: add to pending + + -- TODO: send to clients + -- "all available resources in accordence with section 8" + -- Section 8 says (for presence of type "subscribe", the server MUST + -- adhere to the rules defined under Section 3 and summarized under + -- Appendix A. + -- Appendex A.3.1 says + -- contact ∈ subscribers --> SHOULD NOT, already handled + -- contact ∉ subscribers & contact ∈ pending --> SHOULD NOT + -- contact ∉ subscribers & contact ∉ pending --> MUST + + return () + main = runResourceT $ do state <- liftIO . atomically $ do clients <- newTVar Map.empty @@ -658,6 +676,7 @@ main = runResourceT $ do , xmppInformPeerPresence = informPeerPresence state , xmppAnswerProbe = answerProbe state , xmppClientSubscriptionRequest = clientSubscriptionRequest state + , xmppPeerSubscriptionRequest = peerSubscriptionRequest state } liftIO $ do atomically $ putTMVar (server state) sv -- cgit v1.2.3