3 files changed, 69 insertions, 20 deletions

diff --git a/Presence/XMPP.hs b/Presence/XMPP.hs
index 173e7cdf..7d69e126 100644
--- a/Presence/XMPP.hs
+++ b/Presence/XMPP.hs
@@ -535,7 +535,7 @@ toClient session pchan cmdChan rchan = toClient' False False
                     , attr   "type" "subscribed"
                     ]
                  , EventEndElement "{jabber:client}presence" ]
-            let f True  = "from"
+            let f True  = "both"
                 f False = "to"
             subscription <- fmap f (liftIO $ isSubscribed session contact)
             r <- liftIO . handleIO (\e -> putStrLn ("Roster NewBuddy error: "++show e) >> return []) $ do
@@ -544,7 +544,24 @@ toClient session pchan cmdChan rchan = toClient' False False
                                      [attr "subscription" subscription]
             send r
         loop
-      RChan   (PendingBuddy who contact) ->  do
+      RChan   (NewSubscriber who contact) ->  do
+        liftIO . putStrLn $ "Roster push: NewSubscriber "++show (isInterested,who,contact)
+        (jid,me) <- liftIO $ do
+                        jid <- getJID session
+                        me <- asHostNameJID jid
+                        return (jid,me)
+        withJust me $ \me -> do
+        when (isInterested && Just who==name jid) $ do
+            let f True  = "both"
+                f False = "from"
+            subscription <- fmap f (liftIO $ isBuddy session contact)
+            r <- liftIO . handleIO (\e -> putStrLn ("Roster NewSubscriber error: "++show e) >> return []) $ do
+                            rosterPush jid 
+                                     (toStrict . L.decodeUtf8 $ contact) 
+                                     [attr "subscription" subscription]
+            send r
+        loop
+      RChan   (PendingSubscriber who contact) ->  do
         liftIO . putStrLn $ "Roster: Pending buddy "++show (isInterested,who,contact)
         (jid,me) <- liftIO $ do
                         jid <- getJID session
@@ -726,7 +743,8 @@ handlePresenceProbe session stanza = do
                 putStrLn $ "comparing " ++show (peer sub , peerAddress session)
                 when (peer sub == discardPort (peerAddress session)) $ do
                 ps <- userStatus session user
-                mapM_ (announcePresence session) ps
+                -- todo: Consider making this a directed presence
+                mapM_ (sendPeerMessage session . OutBoundPresence) ps
     return ()
 
 subscribeToPresence subscribers peer_jid user = do
@@ -826,7 +844,8 @@ peerRequestsSubsription session stanza = do
         liftIO $ do
              sendPeerMessage session (Approval tojid fromjid)
              ps <- userStatus session user
-             mapM_ (announcePresence session) ps
+             -- todo: consider making this a directed presence
+             mapM_ (sendPeerMessage session . OutBoundPresence) ps
       else
         liftIO $ processRequest session user fromjid
 
diff --git a/Presence/XMPPTypes.hs b/Presence/XMPPTypes.hs
index 6d00d509..0e98a77b 100644
--- a/Presence/XMPPTypes.hs
+++ b/Presence/XMPPTypes.hs
@@ -57,6 +57,7 @@ class JabberClientSession session where
     getMySolicited     :: session -> IO [ByteString]
     addSolicited :: session -> ByteString -> JID ->  IO ()
     isSubscribed :: session -> ByteString -> IO Bool
+    isBuddy      :: session -> ByteString -> IO Bool
     approveSubscriber :: session -> ByteString -> IO ()
 
 class JabberPeerSession session where
@@ -94,7 +95,10 @@ data RosterEvent = RequestedSubscription
                  | NewBuddy 
                     {- user: -} ByteString
                     {- contact: -} ByteString
-                 | PendingBuddy
+                 | PendingSubscriber
+                    {- user: -} ByteString
+                    {- contact: -} ByteString
+                 | NewSubscriber 
                     {- user: -} ByteString
                     {- contact: -} ByteString
  deriving Prelude.Show
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))