peerSubscriptionRequest todo stub

2 files changed, 29 insertions, 6 deletions

diff --git a/Presence/XMPPServer.hs b/Presence/XMPPServer.hs
index a118ce88..4eb89f7f 100644
--- a/Presence/XMPPServer.hs
+++ b/Presence/XMPPServer.hs
@@ -190,7 +190,8 @@ data XMPPServerParameters =
     , xmppInformClientPresence :: ConnectionKey -> Stanza -> IO ()
     , xmppInformPeerPresence :: ConnectionKey -> Stanza -> IO ()
     , xmppAnswerProbe :: ConnectionKey -> Stanza -> TChan Stanza -> IO ()
-    , xmppClientSubscriptionRequest :: IO () -> ConnectionKey -> Stanza -> IO () 
+    , xmppClientSubscriptionRequest :: IO () -> ConnectionKey -> Stanza -> TChan Stanza -> IO () 
+    , xmppPeerSubscriptionRequest :: IO () -> ConnectionKey -> Stanza -> TChan Stanza -> IO () 
     }
 
 
@@ -1610,7 +1611,7 @@ monitor sv params xmpp = do
                             xmppInformClientPresence xmpp k stanza
                         PresenceRequestSubscription {} -> do
                             let fail = return () -- todo
-                            xmppClientSubscriptionRequest xmpp fail k stanza
+                            xmppClientSubscriptionRequest xmpp fail k stanza replyto
                         NotifyClientVersion name version -> do
                             enableClientHacks name version replyto
                         UnrecognizedQuery query -> do
@@ -1629,6 +1630,9 @@ monitor sv params xmpp = do
                             xmppAnswerProbe xmpp k stanza replyto
                         PresenceStatus {} -> do
                             xmppInformPeerPresence xmpp k stanza
+                        PresenceRequestSubscription {} -> do
+                            let fail = return () -- todo
+                            xmppPeerSubscriptionRequest xmpp fail k stanza replyto
                         _ -> return ()
                 _ -> return ()
             let deliver replyto = do
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