summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--xmppServer.hs18
1 files changed, 11 insertions, 7 deletions
diff --git a/xmppServer.hs b/xmppServer.hs
index d10fe4c2..4270f89c 100644
--- a/xmppServer.hs
+++ b/xmppServer.hs
@@ -760,17 +760,14 @@ clientInformSubscription state fail k stanza = do
760 , ConfigFiles.modifySubscribers ) 760 , ConfigFiles.modifySubscribers )
761 addToRosterFile addf (clientUser client) to addrs 761 addToRosterFile addf (clientUser client) to addrs
762 removeFromRosterFile remf (clientUser client) to addrs 762 removeFromRosterFile remf (clientUser client) to addrs
763 -- TODO 763
764 -- send roster update to clients 764 -- send roster update to clients
765 -- approve: both ( ∈ buddies) else from
766 -- reject: to ( ∈ buddies ) else none
767 (clients,ktc) <- atomically $ do 765 (clients,ktc) <- atomically $ do
768 cbu <- readTVar (clientsByUser state) 766 cbu <- readTVar (clientsByUser state)
769 let mlp = mu >>= flip Map.lookup cbu 767 let mlp = mu >>= flip Map.lookup cbu
770 let cs = maybe [] (Map.toList . networkClients) mlp 768 let cs = maybe [] (Map.toList . networkClients) mlp
771 ktc <- readTVar (keyToChan state) 769 ktc <- readTVar (keyToChan state)
772 return (cs,ktc) 770 return (cs,ktc)
773
774 forM_ clients $ \(ck, client) -> do 771 forM_ clients $ \(ck, client) -> do
775 when (clientIsInterested client) $ do 772 when (clientIsInterested client) $ do
776 flip (maybe $ return ()) (Map.lookup ck ktc) $ \con -> do 773 flip (maybe $ return ()) (Map.lookup ck ktc) $ \con -> do
@@ -780,10 +777,17 @@ clientInformSubscription state fail k stanza = do
780 update <- makeRosterUpdate cjid to relationship 777 update <- makeRosterUpdate cjid to relationship
781 sendModifiedStanzaToClient update (connChan con) 778 sendModifiedStanzaToClient update (connChan con)
782 779
783
784 -- notify peer 780 -- notify peer
785 return () 781 let dsts = Map.fromList $ map ((,()) . PeerKey) addrs
786 782 cdsts = ktc Map.\\ dsts
783 forM_ (Map.toList cdsts) $ \(pk,con) -> do
784 let from = clientJID con client
785 to' = unsplitJID (mu, peerKeyToText pk, Nothing)
786 dup <- cloneStanza stanza
787 sendModifiedStanzaToPeer (dup { stanzaTo = Just $ to'
788 , stanzaFrom = Just from })
789 (connChan con)
790
787peerInformSubscription state fail k stanza = do 791peerInformSubscription state fail k stanza = do
788 putStrLn $ "TODO: peerInformSubscription" 792 putStrLn $ "TODO: peerInformSubscription"
789 -- remove from solicited 793 -- remove from solicited