1 files changed, 31 insertions, 17 deletions

diff --git a/Presence/XMPP.hs b/Presence/XMPP.hs
index 9190ee3c..173e7cdf 100644
--- a/Presence/XMPP.hs
+++ b/Presence/XMPP.hs
@@ -419,6 +419,7 @@ handleIQGet session cmdChan tag = do
             atomically $ do
                 writeTChan cmdChan InterestedInRoster
                 writeTChan cmdChan . Send $ roster
+            sendPending session
         req -> unhandledGet req
     
 
@@ -502,15 +503,17 @@ toClient session pchan cmdChan rchan = toClient' False False
     let loop = toClient' isBound isInterested
         send xs = yield xs >> prettyPrint ">C: " xs
     event <- liftIO . atomically $ 
-              foldr1 orElse [fmap PChan   $ readTChan pchan
+              foldr1 orElse [fmap CmdChan $ readTChan cmdChan
                             ,fmap RChan   $ readTChan rchan
-                            ,fmap CmdChan $ readTChan cmdChan
+                            ,fmap PChan   $ readTChan pchan
                             ]
     case event of
       CmdChan QuitThread -> return ()
       CmdChan (Send xs)  -> send xs >> loop
       CmdChan BoundToResource    -> toClient' True    isInterested
-      CmdChan InterestedInRoster -> toClient' isBound True
+      CmdChan InterestedInRoster -> do
+        liftIO . putStrLn $ "Roster: interested"
+        toClient' isBound True
       -- CmdChan cmd        -> liftIO (putStrLn $ "unhandled event: "++show cmd) >> loop
       RChan   (RequestedSubscription who contact) ->  do
         jid <- liftIO $ getJID session
@@ -520,11 +523,15 @@ toClient session pchan cmdChan rchan = toClient' False False
         loop
       RChan   (NewBuddy who contact) ->  do
         liftIO . putStrLn $ "Roster push: NewBuddy "++show (isInterested,who,contact)
-        jid <- liftIO $ getJID session
+        (jid,me) <- liftIO $ do
+                        jid <- getJID session
+                        me <- asHostNameJID jid
+                        return (jid,me)
+        withJust me $ \me -> do
         when (isInterested && Just who==name jid) $ do
             send [ EventBeginElement "{jabber:client}presence" 
                     [ attrbs "from" contact
-                    , attrbs "to"   (L.show jid)
+                    , attrbs "to"   me
                     , attr   "type" "subscribed"
                     ]
                  , EventEndElement "{jabber:client}presence" ]
@@ -537,12 +544,28 @@ toClient session pchan cmdChan rchan = toClient' False False
                                      [attr "subscription" subscription]
             send r
         loop
+      RChan   (PendingBuddy who contact) ->  do
+        liftIO . putStrLn $ "Roster: Pending buddy "++show (isInterested,who,contact)
+        (jid,me) <- liftIO $ do
+                        jid <- getJID session
+                        me <- asHostNameJID jid
+                        return (jid,me)
+        withJust me $ \me -> do
+        when (isInterested && Just who==name jid) $ do
+            send [ EventBeginElement "{jabber:client}presence" 
+                    [ attrbs "from" contact
+                    , attrbs "to"   me
+                    , attr   "type" "subscribe"
+                    ]
+                 , EventEndElement "{jabber:client}presence" ]
+        loop
       PChan presence   -> do 
         when isBound $ do
             xs <- liftIO $ xmlifyPresenceForClient presence
             send xs
         loop
 
+
 handleClient
   :: (SocketLike sock, HHead l (XMPPClass session),
       JabberClientSession session) =>
@@ -805,21 +828,12 @@ peerRequestsSubsription session stanza = do
              ps <- userStatus session user
              mapM_ (announcePresence session) ps
       else
-        -- TODO
-        -- if no client:
-        --   add pending
-        -- else:
-        --   notify client(s)
-        return ()
-    return ()
+        liftIO $ processRequest session user fromjid
 
 clientApprovesSubscription session stanza = do
     liftIO $ putStrLn $ "CLIENT APPROVES SUBSCRIPTION"
-    -- add subscribers
-    -- remove pending
-    -- remove others
-    -- notify peer
-    return ()
+    withJust (lookupAttrib "to" (tagAttrs stanza)) $ \to_str -> do
+    liftIO $ approveSubscriber session (textToByteString to_str)
 
 peerApprovesSubscription session stanza = do
     liftIO $ putStrLn $ "PEER APPROVES SUBSCRIPTION"