summaryrefslogtreecommitdiff
path: root/xmppServer.hs
diff options
context:
space:
mode:
authorjoe <joe@jerkface.net>2014-03-08 23:17:03 -0500
committerjoe <joe@jerkface.net>2014-03-08 23:17:03 -0500
commitf857a452f0b7ec41d0dc211845c55fd642a510ae (patch)
tree6bad586fdb8739b1a1e789f7b078486a1de5bb83 /xmppServer.hs
parent892b54876593fc0753026697175daf58ef85d0d3 (diff)
WIP: peerInformSubscription
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