1 files changed, 23 insertions, 4 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