Handle rejection case.

1 files changed, 56 insertions, 27 deletions

diff --git a/Presence/main.hs b/Presence/main.hs
index 702b98d5..781b87fa 100644
--- a/Presence/main.hs
+++ b/Presence/main.hs
@@ -87,6 +87,14 @@ data PresenceState = PresenceState
     }
 
 
+rosterPush msg state = do
+        let rchan = rosterChannel state
+        atomically $ do
+            isempty <- isEmptyTMVar rchan
+            when (not isempty) $ do
+            (_,ch) <- readTMVar rchan
+            writeTChan ch msg
+
 getJabberUserForId muid =
              maybe (return "nobody") 
                    (\(uid,_) -> 
@@ -157,7 +165,7 @@ instance JabberClientSession ClientSession where
 
         rsc <- readIORef (unix_resource s)
         -- let jid = user <++> "@" <++> host <++?> "/" <++$> rsc
-        L.putStrLn $ "CLIENT SESSION: jid " <++> L.show (JID (Just user) host rsc)
+        -- L.putStrLn $ "CLIENT SESSION: jid " <++> L.show (JID (Just user) host rsc)
         return (JID (Just user) host rsc)
 
     closeSession session  = do
@@ -228,12 +236,9 @@ instance JabberClientSession ClientSession where
         me <- getJID s
         withJust (name me) $ \user -> do
         addRawJid ConfigFiles.modifySolicited user jid_str
-        let rchan = rosterChannel . presence_state $ s
-        atomically $ do
-            isempty <- isEmptyTMVar rchan
-            when (not isempty) $ do
-            (_,ch) <- readTMVar rchan
-            writeTChan ch (RequestedSubscription user jid_str)
+
+        rosterPush (RequestedSubscription user jid_str) (presence_state s)
+
         sendMessage (outGoingConnections . presence_state $ s) 
                     (Solicitation me jid)
                     (peer jid)
@@ -278,17 +283,14 @@ instance JabberClientSession ClientSession where
         user <- readIORef (unix_uid s) >>= getJabberUserForId
         cjid <- parseHostNameJID contact
         let rmjid modify user buddy = modify user (cmpJID buddy) Nothing
+
+        -- update config files
         addRawJid ConfigFiles.modifySubscribers user contact -- add subscribers
         rmjid ConfigFiles.modifyPending user cjid
         rmjid ConfigFiles.modifyOthers  user cjid
         
         -- roster push
-        let rchan = rosterChannel . presence_state $ s
-        atomically $ do
-            isempty <- isEmptyTMVar rchan
-            when (not isempty) $ do
-            (_,ch) <- readTMVar rchan
-            writeTChan ch (NewSubscriber user contact)
+        rosterPush (NewSubscriber user contact) (presence_state s)
 
         -- notify peer
         sendMessage (outGoingConnections . presence_state $ s) 
@@ -300,6 +302,33 @@ instance JabberClientSession ClientSession where
         forM_ presence $ \p -> sendMessage cons (OutBoundPresence p) (peer cjid)
         return ()
 
+    rejectSubscriber s contact = do
+        user <- readIORef (unix_uid s) >>= getJabberUserForId
+        cjid <- parseHostNameJID contact
+        let rmjid modify user buddy = modify user (cmpJID buddy) Nothing
+        
+        -- update config files
+        was_pending    <- rmjid ConfigFiles.modifyPending user cjid
+        was_subscribed <- rmjid ConfigFiles.modifySubscribers user cjid
+        addRawJid ConfigFiles.modifyOthers user contact
+        
+        -- roster push
+        rosterPush (RejectSubscriber user contact) (presence_state s)
+
+        -- notify peer
+        when (was_pending || was_subscribed) $ do
+        let cons = outGoingConnections . presence_state $ s
+            isonline (Presence _ Offline) = False
+            isonline _                    = True
+        presence <- fmap (filter isonline) $ getUserStatus (presence_state s) user
+        me <- getJID s
+        when (not (null presence)) $
+            sendMessage cons (OutBoundPresence . Presence me $ Offline) (peer cjid)
+        sendMessage (outGoingConnections . presence_state $ s) 
+                    (Rejection (JID (Just user) LocalHost Nothing) 
+                              cjid)
+                    (peer cjid)
+        return ()
 
 tupleToJID (user,tty,pid) = jid user LocalHost tty
 
@@ -375,19 +404,24 @@ instance JabberPeerSession PeerSession where
         solicited <- ConfigFiles.getSolicited user
         let rmjid modify user buddy = modify user (cmpJID buddy) Nothing
         was_sol <- rmjid ConfigFiles.modifySolicited user buddy
-        putStrLn $ "was_sol = "<++>bshow was_sol
         when was_sol $ do -- if buddy ∈ solicited:
         addJid ConfigFiles.modifyBuddies user buddy --   add buddies
         rmjid ConfigFiles.modifyOthers user buddy --   remove others
-        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 (NewBuddy user buddy)
-        return ()
+        rosterPush (NewBuddy user buddy) (peer_global session)
+
+    processRejection session user buddy = do
+        solicited <- ConfigFiles.getSolicited user
+        let rmjid modify user buddy = modify user (cmpJID buddy) Nothing
+        was_sol <- rmjid ConfigFiles.modifySolicited user buddy
+        when was_sol $ do -- if buddy ∈ solicited:
+        rmjid ConfigFiles.modifyBuddies user buddy -- remove buddies
+        addJid ConfigFiles.modifyOthers user buddy -- add others
+        mbuddy <- asHostNameJID buddy
+        withJust mbuddy $ \buddy -> do
+        rosterPush (RemovedBuddy user buddy) (peer_global session)
+
     processRequest session user buddy = do
         let addjid modify user buddy = do
                 hbuddy <- asHostNameJID buddy
@@ -403,14 +437,9 @@ instance JabberPeerSession PeerSession where
         --      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 (PendingSubscriber user buddy)
+        rosterPush (PendingSubscriber user buddy) (peer_global session)
 
 
 data RefCountedChan = forall a. RefCountedChan (TMVar (RefCount,TChan a))