Send offline events when a peer goes down.

1 files changed, 16 insertions, 5 deletions

diff --git a/Presence/XMPPServer.hs b/Presence/XMPPServer.hs
index 3684925a..3413dcfb 100644
--- a/Presence/XMPPServer.hs
+++ b/Presence/XMPPServer.hs
@@ -481,12 +481,17 @@ startPeer session_factory sock st = do
     let h = hOccursFst st :: Handle 
     name <- fmap bshow $ getPeerName sock
     L.putStrLn $ "IN peer: connected " <++> name
-    let quit = L.putStrLn $ "IN peer: disconnected " <++> name
+    jids <- newTVarIO Set.empty
     session <- newSession session_factory sock h
-    return ( session .*. ConnectionFinalizer quit .*. st )
+    let quit = do
+            L.putStrLn $ "IN peer: disconnected " <++> name
+            js <- fmap Set.toList (readTVarIO jids)
+            let offline jid = Presence jid Offline
+            forM_ js $ announcePresence session . offline
+    return ( (session,jids) .*. ConnectionFinalizer quit .*. st )
 
 doPeer st elem cont = do
-    let session = hHead st
+    let (session,jids) = hHead st
     L.putStrLn $ "IN peer: " <++> bshow elem
     case elem of
       Element e@(Elem (N "presence") attrs content) -> do
@@ -497,10 +502,13 @@ doPeer st elem cont = do
             L.putStrLn $ "IN peer: PRESENCE! Offline jid=" <++> jid
             -- parseAddressJID -- convert peer reported user@address to JID data structure
             peer_jid <- parseAddressJID jid
+            atomically $ do
+                jids_ <- readTVar jids
+                writeTVar jids (Set.delete peer_jid jids_)
             announcePresence session (Presence peer_jid Offline)
           (Just jid,Just typ) -> 
             -- possible probe, ignored for now
-            L.putStrLn $ "IN peer: PRESENCE! "<++>typ<++>" jid="<++>jid
+            L.putStrLn $ "IN peer: Ignored presence! "<++>typ<++>" jid="<++>jid
           (Just jid,Nothing) -> do
             let string (CString _ s _) = [s]
                 stat = listToMaybe . Prelude.concatMap string . tagcontent "show" $ content
@@ -513,8 +521,11 @@ doPeer st elem cont = do
                          _       -> Available
             -- Available or Away.
             pjid <- parseAddressJID jid
-            names <- getNamesForPeer  (peer pjid)
+            -- names <- getNamesForPeer  (peer pjid)
             -- L.putStrLn $ "IN peer: PRESENCE! "<++>bshow (stat,names)<++>" avail/away jid=" <++> jid
+            atomically $ do
+                jids_ <- readTVar jids
+                writeTVar jids (Set.insert pjid jids_)
             announcePresence session (Presence pjid stat')
             L.putStrLn $ "IN peer: " <++> bshow (Presence pjid stat')
       _ -> return () -- putStrLn $ "inbound unhandled: "++show v