roster updates and presence notification in case of a new subscription.

1 files changed, 41 insertions, 15 deletions

diff --git a/Presence/main.hs b/Presence/main.hs
index 5cccffea..702b98d5 100644
--- a/Presence/main.hs
+++ b/Presence/main.hs
@@ -222,7 +222,7 @@ instance JabberClientSession ClientSession where
                  else return Nothing
         atomically $ do
             whenJust getRChan $ \rchan -> do
-            forM_ pending (writeTChan rchan . PendingBuddy user)
+            forM_ pending (writeTChan rchan . PendingSubscriber user)
 
     addSolicited s jid_str jid = do
         me <- getJID s
@@ -264,6 +264,16 @@ instance JabberClientSession ClientSession where
         msubs <- mapM (cmpJID cjid) subs
         return (Nothing `elem` msubs)
 
+    isBuddy s contact = do
+        handleIO (\e -> return False) $ do
+        user <- readIORef (unix_uid s) >>= getJabberUserForId
+        subs <- ConfigFiles.getBuddies user
+        putStrLn $ "isBuddy parsing: "<++>contact
+        cjid <- parseHostNameJID contact
+        msubs <- mapM (cmpJID cjid) subs
+        return (Nothing `elem` msubs)
+
+
     approveSubscriber s contact = do
         user <- readIORef (unix_uid s) >>= getJabberUserForId
         cjid <- parseHostNameJID contact
@@ -271,16 +281,40 @@ instance JabberClientSession ClientSession where
         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?)
+        
+        -- 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)
+
+        -- notify peer
         sendMessage (outGoingConnections . presence_state $ s) 
                     (Approval (JID (Just user) LocalHost Nothing) 
                               cjid)
                     (peer cjid)
+        presence <- getUserStatus (presence_state s) user
+        let cons = outGoingConnections . presence_state $ s
+        forM_ presence $ \p -> sendMessage cons (OutBoundPresence p) (peer cjid)
+        return ()
 
 
 tupleToJID (user,tty,pid) = jid user LocalHost tty
 
+getUserStatus state user = do
+        (tty,users) <- atomically $ do
+            tty <- readTVar $ currentTTY state
+            users <- readTVar $ activeUsers state
+            return (tty,users)
+        let jids = Set.filter (\(name,tty,pid) -> name ==user) users
+            ps = map (\jid -> Presence (tupleToJID jid) (matchResource' tty jid)) . Set.toList $ jids
+        if null ps
+            then return [Presence (JID { name=Just user, peer=LocalHost, resource=Nothing }) Offline]
+            else return ps
+
+
 data PeerSession = PeerSession {
     announced :: TVar (MultiMap JabberUser (JabberResource,JabberShow)),
     peer_name :: Peer,
@@ -310,18 +344,10 @@ instance JabberPeerSession PeerSession where
 
     peerAddress session = peer_name session
 
-    userStatus session user = do
-        let state = peer_global session
-        (tty,users) <- atomically $ do
-            tty <- readTVar $ currentTTY state
-            users <- readTVar $ activeUsers state
-            return (tty,users)
-        let jids = Set.filter (\(name,tty,pid) -> name ==user) users
-            ps = map (\jid -> Presence (tupleToJID jid) (matchResource' tty jid)) . Set.toList $ jids
-        if null ps
-            then return [Presence (JID { name=Just user, peer=LocalHost, resource=Nothing }) Offline]
-            else return ps
+    userStatus session user = getUserStatus (peer_global session) user
 
+    -- This should be used on inbound presence to inform clients.
+    -- For outbound, use sendPeerMessage and OutBoundPresence.
     announcePresence session (Presence jid status) = do
         (greedy,subs) <- atomically $ do
             subs <- readTVar $ subscriberMap (peer_global session)
@@ -384,7 +410,7 @@ instance JabberPeerSession PeerSession where
             isempty <- isEmptyTMVar rchan
             when (not isempty) $ do
             (_,ch) <- readTMVar rchan
-            writeTChan ch (PendingBuddy user buddy)
+            writeTChan ch (PendingSubscriber user buddy)
 
 
 data RefCountedChan = forall a. RefCountedChan (TMVar (RefCount,TChan a))