Send subscription requests to client for approval, and then

forward the answer to the remote peer.  Todo: related roster update.

1 files changed, 55 insertions, 1 deletions

diff --git a/Presence/main.hs b/Presence/main.hs
index eab02e88..5cccffea 100644
--- a/Presence/main.hs
+++ b/Presence/main.hs
@@ -207,6 +207,23 @@ instance JabberClientSession ClientSession where
             L.putStrLn $ "cached presence: " <++> bshow p
             action p
 
+    sendPending s = do
+        jid <- getJID s 
+        putStrLn $ "sendPending "<++> bshow jid
+        flip (maybe (return ())) (name jid) $ \user -> do
+        pending <- ConfigFiles.getPending user
+        let getRChan = do
+                let rchan = rosterChannel . presence_state $ s
+                isempty <- isEmptyTMVar rchan
+                if (not isempty) 
+                 then do
+                    (_,ch) <- readTMVar rchan
+                    return . Just $ ch
+                 else return Nothing
+        atomically $ do
+            whenJust getRChan $ \rchan -> do
+            forM_ pending (writeTChan rchan . PendingBuddy user)
+
     addSolicited s jid_str jid = do
         me <- getJID s
         withJust (name me) $ \user -> do
@@ -247,6 +264,21 @@ instance JabberClientSession ClientSession where
         msubs <- mapM (cmpJID cjid) subs
         return (Nothing `elem` msubs)
 
+    approveSubscriber s contact = do
+        user <- readIORef (unix_uid s) >>= getJabberUserForId
+        cjid <- parseHostNameJID contact
+        let rmjid modify user buddy = modify user (cmpJID buddy) Nothing
+        addRawJid ConfigFiles.modifySubscribers user contact -- add subscribers
+        rmjid ConfigFiles.modifyPending user cjid
+        rmjid ConfigFiles.modifyOthers  user cjid
+        -- TODO
+        -- roster push (to other clients, or do we include the approver?)
+        sendMessage (outGoingConnections . presence_state $ s) 
+                    (Approval (JID (Just user) LocalHost Nothing) 
+                              cjid)
+                    (peer cjid)
+
+
 tupleToJID (user,tty,pid) = jid user LocalHost tty
 
 data PeerSession = PeerSession {
@@ -330,7 +362,29 @@ instance JabberPeerSession PeerSession where
             (_,ch) <- readTMVar rchan
             writeTChan ch (NewBuddy user buddy)
         return ()
-        
+    processRequest session user buddy = do
+        let addjid modify user buddy = do
+                hbuddy <- asHostNameJID buddy
+                modify user (cmpJID buddy) hbuddy
+        was_pending <- addjid ConfigFiles.modifyPending user buddy
+        putStrLn $ "processRequest was_pending="<++>bshow was_pending
+        --    "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
+        when (not was_pending) $ do
+        let rchan = rosterChannel . peer_global $ session
+        mbuddy <- asHostNameJID buddy
+        withJust mbuddy $ \buddy -> do
+        atomically $ do
+            isempty <- isEmptyTMVar rchan
+            when (not isempty) $ do
+            (_,ch) <- readTMVar rchan
+            writeTChan ch (PendingBuddy user buddy)
 
 
 data RefCountedChan = forall a. RefCountedChan (TMVar (RefCount,TChan a))