send probes and solicitations

1 files changed, 20 insertions, 14 deletions

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