From 563125c8dc8c73b6382708637a12c72110cd0662 Mon Sep 17 00:00:00 2001 From: joe Date: Thu, 11 Jul 2013 15:57:30 -0400 Subject: roster updates and presence notification in case of a new subscription. --- Presence/XMPP.hs | 27 +++++++++++++++++++++++---- 1 file changed, 23 insertions(+), 4 deletions(-) (limited to 'Presence/XMPP.hs') 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 -- cgit v1.2.3