From 8b7d614ad7722b426e88ecb536e17b381e23e138 Mon Sep 17 00:00:00 2001
From: joe <joe@jerkface.net>
Date: Mon, 3 Mar 2014 15:02:53 -0500
Subject: send probes and solicitations

---
 xmppServer.hs | 34 ++++++++++++++++++++--------------
 1 file changed, 20 insertions(+), 14 deletions(-)

(limited to 'xmppServer.hs')

diff --git a/xmppServer.hs b/xmppServer.hs
index 0f2b7c89..d450988c 100644
--- a/xmppServer.hs
+++ b/xmppServer.hs
@@ -4,6 +4,7 @@ import System.Posix.Signals
 import Control.Concurrent.STM
 import Control.Concurrent.STM.TMVar
 import Control.Monad.Trans.Resource (runResourceT)
+import Control.Monad.Trans
 import Control.Monad.IO.Class (MonadIO, liftIO)
 import Network.Socket
     ( addrAddress
@@ -240,21 +241,26 @@ getBuddies' = textAdapter ConfigFiles.getBuddies
 getSolicited' :: Text -> IO [Text]
 getSolicited' = textAdapter ConfigFiles.getSolicited
 
-sendProbesAndSolicitations state k chan = do
+sendProbesAndSolicitations state k laddr chan = do
     cbu <- atomically $ readTVar $ clientsByUser state
     -- get all buddies & solicited matching k for all users
-    us <- runTraversableT $ do
-            user <- liftT $ Map.keys cbu
-            (isbud,getter) <- liftT [(True ,getBuddies'  )
-                                    ,(False,getSolicited')]
-            bud  <- liftMT $ getter user
-            let (u,h,r) = splitJID bud
-            addr <- liftMT $ resolvePeer h
-            liftT $ guard (PeerKey addr == k)
-            return (isbud,u)
-    
-    let _ = us :: [(Bool,Maybe UserName)]
-    -- send probes for buddies, solicitations for solicited.
+    runTraversableT $ do
+        user <- liftT $ Map.keys cbu
+        (isbud,getter) <- liftT [(True ,getBuddies'  )
+                                ,(False,getSolicited')]
+        bud  <- liftMT $ getter user
+        let (u,h,r) = splitJID bud
+        addr <- liftMT $ resolvePeer h
+        liftT $ guard (PeerKey addr == k)
+        -- return (isbud,u)
+        let make = if isbud then presenceProbe 
+                            else presenceSolicitation
+            toh = peerKeyToText k
+            jid = unsplitJID (u,toh,r)
+            me = addrToText laddr
+        stanza <- lift $ make me jid
+        -- send probes for buddies, solicitations for solicited.
+        lift $ atomically $ writeTChan chan stanza
     return ()
 
 newConn state k addr outchan = do
@@ -262,7 +268,7 @@ newConn state k addr outchan = do
         $ Map.insert k Conn { connChan = outchan
                             , auxAddr  = addr }
     when (isPeerKey k)
-        $ sendProbesAndSolicitations state k outchan
+        $ sendProbesAndSolicitations state k addr outchan
 
 eofConn state k = atomically $ modifyTVar' (keyToChan state) $ Map.delete k
 
-- 
cgit v1.2.3