diff options
-rw-r--r-- | xmppServer.hs | 18 |
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 | |||
787 | peerInformSubscription state fail k stanza = do | 791 | peerInformSubscription state fail k stanza = do |
788 | putStrLn $ "TODO: peerInformSubscription" | 792 | putStrLn $ "TODO: peerInformSubscription" |
789 | -- remove from solicited | 793 | -- remove from solicited |