diff options
author | joe <joe@jerkface.net> | 2013-07-11 15:57:30 -0400 |
---|---|---|
committer | joe <joe@jerkface.net> | 2013-07-11 15:57:30 -0400 |
commit | 563125c8dc8c73b6382708637a12c72110cd0662 (patch) | |
tree | ac36cfe81370d9d1eadb7b276c89150bed980862 /Presence/XMPP.hs | |
parent | e532b9d2ae3263513d7de4aec4913e234b3f3b46 (diff) |
roster updates and presence notification in case of a new subscription.
Diffstat (limited to 'Presence/XMPP.hs')
-rw-r--r-- | Presence/XMPP.hs | 27 |
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 | |||
535 | , attr "type" "subscribed" | 535 | , attr "type" "subscribed" |
536 | ] | 536 | ] |
537 | , EventEndElement "{jabber:client}presence" ] | 537 | , EventEndElement "{jabber:client}presence" ] |
538 | let f True = "from" | 538 | let f True = "both" |
539 | f False = "to" | 539 | f False = "to" |
540 | subscription <- fmap f (liftIO $ isSubscribed session contact) | 540 | subscription <- fmap f (liftIO $ isSubscribed session contact) |
541 | r <- liftIO . handleIO (\e -> putStrLn ("Roster NewBuddy error: "++show e) >> return []) $ do | 541 | r <- liftIO . handleIO (\e -> putStrLn ("Roster NewBuddy error: "++show e) >> return []) $ do |
@@ -544,7 +544,24 @@ toClient session pchan cmdChan rchan = toClient' False False | |||
544 | [attr "subscription" subscription] | 544 | [attr "subscription" subscription] |
545 | send r | 545 | send r |
546 | loop | 546 | loop |
547 | RChan (PendingBuddy who contact) -> do | 547 | RChan (NewSubscriber who contact) -> do |
548 | liftIO . putStrLn $ "Roster push: NewSubscriber "++show (isInterested,who,contact) | ||
549 | (jid,me) <- liftIO $ do | ||
550 | jid <- getJID session | ||
551 | me <- asHostNameJID jid | ||
552 | return (jid,me) | ||
553 | withJust me $ \me -> do | ||
554 | when (isInterested && Just who==name jid) $ do | ||
555 | let f True = "both" | ||
556 | f False = "from" | ||
557 | subscription <- fmap f (liftIO $ isBuddy session contact) | ||
558 | r <- liftIO . handleIO (\e -> putStrLn ("Roster NewSubscriber error: "++show e) >> return []) $ do | ||
559 | rosterPush jid | ||
560 | (toStrict . L.decodeUtf8 $ contact) | ||
561 | [attr "subscription" subscription] | ||
562 | send r | ||
563 | loop | ||
564 | RChan (PendingSubscriber who contact) -> do | ||
548 | liftIO . putStrLn $ "Roster: Pending buddy "++show (isInterested,who,contact) | 565 | liftIO . putStrLn $ "Roster: Pending buddy "++show (isInterested,who,contact) |
549 | (jid,me) <- liftIO $ do | 566 | (jid,me) <- liftIO $ do |
550 | jid <- getJID session | 567 | jid <- getJID session |
@@ -726,7 +743,8 @@ handlePresenceProbe session stanza = do | |||
726 | putStrLn $ "comparing " ++show (peer sub , peerAddress session) | 743 | putStrLn $ "comparing " ++show (peer sub , peerAddress session) |
727 | when (peer sub == discardPort (peerAddress session)) $ do | 744 | when (peer sub == discardPort (peerAddress session)) $ do |
728 | ps <- userStatus session user | 745 | ps <- userStatus session user |
729 | mapM_ (announcePresence session) ps | 746 | -- todo: Consider making this a directed presence |
747 | mapM_ (sendPeerMessage session . OutBoundPresence) ps | ||
730 | return () | 748 | return () |
731 | 749 | ||
732 | subscribeToPresence subscribers peer_jid user = do | 750 | subscribeToPresence subscribers peer_jid user = do |
@@ -826,7 +844,8 @@ peerRequestsSubsription session stanza = do | |||
826 | liftIO $ do | 844 | liftIO $ do |
827 | sendPeerMessage session (Approval tojid fromjid) | 845 | sendPeerMessage session (Approval tojid fromjid) |
828 | ps <- userStatus session user | 846 | ps <- userStatus session user |
829 | mapM_ (announcePresence session) ps | 847 | -- todo: consider making this a directed presence |
848 | mapM_ (sendPeerMessage session . OutBoundPresence) ps | ||
830 | else | 849 | else |
831 | liftIO $ processRequest session user fromjid | 850 | liftIO $ processRequest session user fromjid |
832 | 851 | ||