summaryrefslogtreecommitdiff
path: root/xmppServer.hs
diff options
context:
space:
mode:
Diffstat (limited to 'xmppServer.hs')
-rw-r--r--xmppServer.hs37
1 files changed, 30 insertions, 7 deletions
diff --git a/xmppServer.hs b/xmppServer.hs
index 4270f89c..94a20c8a 100644
--- a/xmppServer.hs
+++ b/xmppServer.hs
@@ -791,13 +791,36 @@ clientInformSubscription state fail k stanza = do
791peerInformSubscription state fail k stanza = do 791peerInformSubscription state fail k stanza = do
792 putStrLn $ "TODO: peerInformSubscription" 792 putStrLn $ "TODO: peerInformSubscription"
793 -- remove from solicited 793 -- remove from solicited
794 -- if it was in solicited: 794 flip (maybe fail) (stanzaFrom stanza) $ \from -> do
795 -- approval: 795 ktc <- atomically $ readTVar (keyToChan state)
796 -- add to buddies 796 flip (maybe fail) (Map.lookup k ktc)
797 -- remove from others 797 $ \(Conn { connChan=sender_chan
798 -- rejection: 798 , auxAddr=laddr }) -> do
799 -- remove from buddies 799 (_,from'@(from_u,from_h,_)) <- rewriteJIDForClient laddr from
800 -- add to others 800 let from'' = unsplitJID from'
801 muser = do
802 to <- stanzaTo stanza
803 let (mu,to_h,to_r) = splitJID to
804 mu
805 flip (maybe fail) muser $ \user -> do
806 addrs <- resolvePeer from_h
807 was_solicited <- removeFromRosterFile ConfigFiles.modifySolicited user from'' addrs
808 subs <- resolvedFromRoster ConfigFiles.getSubscribers user
809 let is_sub = not . null $ map ((from_u,) . PeerKey) addrs \\ subs
810 let (relationship,addf,remf) =
811 case stanzaType stanza of
812 PresenceInformSubscription True ->
813 ( if is_sub then "both"
814 else "to"
815 , ConfigFiles.modifyBuddies
816 , ConfigFiles.modifyOthers )
817 _ -> ( if is_sub then "from"
818 else "none"
819 , ConfigFiles.modifyOthers
820 , ConfigFiles.modifyBuddies )
821 addToRosterFile addf user from'' addrs
822 removeFromRosterFile remf user from'' addrs
823 -- TODO
801 -- send update to clients 824 -- send update to clients
802 return () 825 return ()
803 826