Moved set of announced presences from fromPeer thread to the associated

UnixSession.

1 files changed, 20 insertions, 2 deletions

diff --git a/Presence/main.hs b/Presence/main.hs
index 816d1537..9c11baae 100644
--- a/Presence/main.hs
+++ b/Presence/main.hs
@@ -61,20 +61,25 @@ data UnixSession = UnixSession {
     localhost :: Peer, -- ByteString,
     unix_uid :: (IORef (Maybe UserID)),
     unix_resource :: (IORef (Maybe L.ByteString)),
+    announced :: TVar (Set JID),
     presence_state :: PresenceState
 }
 
 instance XMPPSession UnixSession where
     data XMPPClass UnixSession = UnixSessions PresenceState
+
     newSession (UnixSessions state) sock = do
         muid <- getLocalPeerCred sock
         L.putStrLn $ "SESSION: open " <++> bshow muid
         uid_ref <- newIORef muid
         res_ref <- newIORef Nothing
-        return $ UnixSession (hostname state) uid_ref res_ref state
+        jids <- newTVarIO Set.empty
+        return $ UnixSession (hostname state) uid_ref res_ref jids state
+
     setResource  s  resource    = do
         writeIORef (unix_resource s) (Just resource)
         L.putStrLn $ "SESSION: resource " <++> resource
+
     getJID       s             = do
         let host = localhost s
         muid <- readIORef (unix_uid s)
@@ -91,19 +96,32 @@ instance XMPPSession UnixSession where
         -- let jid = user <++> "@" <++> host <++?> "/" <++$> rsc
         L.putStrLn $ "SESSION: jid " <++> L.show (JID (Just user) host rsc)
         return (JID (Just user) host rsc)
-    closeSession _             = L.putStrLn "SESSION: close"
+
+    closeSession session  = do
+        L.putStrLn "SESSION: close"
+        js <- fmap Set.toList (readTVarIO . announced $ session)
+        let offline jid = Presence jid Offline
+        forM_ js $ announcePresence session . offline
+
     subscribe session Nothing = do
         let tmvar = localSubscriber (presence_state session)
         atomically $ subscribeToChan tmvar
     subscribe session (Just jid) = do -- UNUSED as yet
         let tvar = subscriberMap (presence_state session)
         atomically $ subscribeToMap tvar jid
+
     announcePresence session (Presence jid status) = do
         (greedy,subs) <- atomically $ do
             subs <- readTVar $ subscriberMap (presence_state session)
             greedy <- fmap snd $ readTMVar $ localSubscriber (presence_state session)
             return (greedy,subs)
         update_presence (Just greedy) (fmap snd subs) (Set.singleton jid) (const status)
+        liftIO . atomically $ do
+            jids <- readTVar . announced $ session
+            writeTVar (announced session) 
+                $ case status of
+                    Offline -> Set.delete jid jids
+                    _       -> Set.insert jid jids
 
 
 subscribeToChan tmvar =