From f857a452f0b7ec41d0dc211845c55fd642a510ae Mon Sep 17 00:00:00 2001
From: joe <joe@jerkface.net>
Date: Sat, 8 Mar 2014 23:17:03 -0500
Subject: WIP: peerInformSubscription

---
 xmppServer.hs | 37 ++++++++++++++++++++++++++++++-------
 1 file changed, 30 insertions(+), 7 deletions(-)

(limited to 'xmppServer.hs')

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
 peerInformSubscription state fail k stanza = do
     putStrLn $ "TODO: peerInformSubscription"
     -- remove from solicited
-    -- if it was in solicited:
-    --   approval:
-    --     add to buddies
-    --     remove from others
-    --   rejection:
-    --     remove from buddies
-    --     add to others
+    flip (maybe fail) (stanzaFrom stanza) $ \from -> do
+    ktc <- atomically $ readTVar (keyToChan state)
+    flip (maybe fail) (Map.lookup k ktc)
+        $ \(Conn { connChan=sender_chan
+                 , auxAddr=laddr }) -> do
+    (_,from'@(from_u,from_h,_)) <- rewriteJIDForClient laddr from
+    let from'' = unsplitJID from'
+        muser = do
+            to <- stanzaTo stanza
+            let (mu,to_h,to_r) = splitJID to
+            mu
+    flip (maybe fail) muser $ \user -> do
+    addrs <- resolvePeer from_h
+    was_solicited <- removeFromRosterFile ConfigFiles.modifySolicited user from'' addrs
+    subs <- resolvedFromRoster ConfigFiles.getSubscribers user
+    let is_sub = not . null $ map ((from_u,) . PeerKey) addrs \\ subs
+    let (relationship,addf,remf) =
+         case stanzaType stanza of
+           PresenceInformSubscription True ->
+                ( if is_sub then "both"
+                            else "to"
+                , ConfigFiles.modifyBuddies
+                , ConfigFiles.modifyOthers )
+           _ -> ( if is_sub then "from"
+                            else "none"
+                , ConfigFiles.modifyOthers
+                , ConfigFiles.modifyBuddies )
+    addToRosterFile      addf user from'' addrs
+    removeFromRosterFile remf user from'' addrs
+    -- TODO
     --   send update to clients
     return ()
 
-- 
cgit v1.2.3