1 files changed, 13 insertions, 11 deletions

diff --git a/Presence/XMPP.hs b/Presence/XMPP.hs
index 89fd420f..3c68da4a 100644
--- a/Presence/XMPP.hs
+++ b/Presence/XMPP.hs
@@ -578,14 +578,14 @@ seekRemotePeers config chan = do
     return ()
 -}
 
-data OutBoundMessage = OutBoundPresence Presence | PresenceProbe JID
+data OutBoundMessage = OutBoundPresence Presence | PresenceProbe JID JID
  deriving Prelude.Show
 
 newServerConnections = newTVar Map.empty
 
 data CachedMessages = CachedMessages 
     { presences :: Map JID JabberShow
-    , probes :: Set JID
+    , probes :: Map JID (Set JID)
     }
 
 connect_to_server chan peer = (>> return ()) . runMaybeT $ do
@@ -595,7 +595,7 @@ connect_to_server chan peer = (>> return ()) . runMaybeT $ do
 
     -- We'll cache Presence notifications until the socket
     -- is ready.
-    cached <- liftIO $ newIORef (CachedMessages Map.empty Set.empty)
+    cached <- liftIO $ newIORef (CachedMessages Map.empty Map.empty)
 
     sock <- MaybeT . fix $ \loop -> do
         e <- atomically $ orElse
@@ -610,9 +610,10 @@ connect_to_server chan peer = (>> return ()) . runMaybeT $ do
                 cache <- readIORef cached
                 writeIORef cached (cache { presences=Map.insert jid st . presences $ cache })
                 loop
-            Left (PresenceProbe jid) -> do
+            Left (PresenceProbe from to) -> do
                 cache <- readIORef cached
-                writeIORef cached (cache { probes=Set.insert jid . probes $ cache })
+                let probes' = Map.adjust (Set.insert from) to $ probes cache
+                writeIORef cached (cache { probes=probes' })
                 loop
             {-
             Left event -> do
@@ -627,7 +628,7 @@ connect_to_server chan peer = (>> return ()) . runMaybeT $ do
         let snk = packetSink h
         cache <- readIORef $ cached
         -- hint garbage collector: we're done with this...
-        writeIORef cached (CachedMessages Map.empty Set.empty) 
+        writeIORef cached (CachedMessages Map.empty Map.empty) 
         handleOutgoingToPeer (restrictSocket sock) cache chan snk
 
 
@@ -651,18 +652,19 @@ toPeer sock cache chan = do
     forM_ (Map.assocs . presences $ cache) $ \(jid,st) -> do
         r <- lift $ xmlifyPresenceForPeer sock (Presence jid st)
         send r
-    forM_ (Set.toList . probes $ cache) $ \jid -> do
-        -- TODO: send probe
-        return ()
+    forM_ (Map.assocs . probes $ cache) $ \(to,froms) -> do
+        forM_ (Set.toList froms) $ \from ->
+            -- TODO: send probe
+            return ()
     fix $ \loop -> do
         event <- lift . atomically $ readTChan chan
         case event of
           OutBoundPresence p -> do
             r <- lift $ xmlifyPresenceForPeer sock p
             send r
-          PresenceProbe jid  -> do
+          PresenceProbe from to -> do
             -- TODO: send probe
-            liftIO $ putStrLn ("Connection ready, PresenceProbe " ++ show jid ++ " (NOT IMPLEMENTED)")
+            liftIO $ putStrLn ("Connection ready, PresenceProbe " ++ show (from,to) ++ " (NOT IMPLEMENTED)")
         loop
     send goodbyePeer