2 files changed, 24 insertions, 17 deletions

diff --git a/Presence/XMPP.hs b/Presence/XMPP.hs
index 01852f43..9dfee14e 100644
--- a/Presence/XMPP.hs
+++ b/Presence/XMPP.hs
@@ -478,27 +478,20 @@ handlePeer st src snk = do
         session_factory = hHead st'
     name <- fmap bshow $ getPeerName sock
     L.putStrLn $ "(P) connected " <++> name
-    jids <- newTVarIO Set.empty
     session <- newSession session_factory sock
 
-    finally ( src $= parseBytes def $$ fromPeer (session,jids) )
+    finally ( src $= parseBytes def $$ fromPeer session )
         $ do 
             L.putStrLn $ "(P) disconnected " <++> name
-            js <- fmap Set.toList (readTVarIO jids)
-            let offline jid = Presence jid Offline
-            forM_ js $ announcePresence session . offline
             closeSession session
 
 
-handlePeerPresence (session,jids) stanza False = do
+handlePeerPresence session stanza False = do
     -- Offline
     withJust (lookupAttrib "from" (tagAttrs stanza)) $ \jid -> do
     peer_jid <- liftIO $ parseAddressJID (L.fromChunks [S.encodeUtf8 jid])
-    liftIO . atomically $ do
-        jids_ <- readTVar jids
-        writeTVar jids (Set.delete peer_jid jids_)
     liftIO $ announcePresence session (Presence peer_jid Offline)
-handlePeerPresence (session,jids) stanza True = do
+handlePeerPresence session stanza True = do
     -- online (Available or Away)
     let log  = liftIO . L.putStrLn . ("(P) " <++>)
     withJust (lookupAttrib "from" (tagAttrs stanza)) $ \jid -> do
@@ -517,10 +510,6 @@ handlePeerPresence (session,jids) stanza True = do
         toStat "chat" = Available
 
     stat' <- parseChildren Available
-
-    liftIO . atomically $ do
-        jids_ <- readTVar jids
-        writeTVar jids (Set.insert pjid jids_)
     liftIO $ announcePresence session (Presence pjid stat')
     log $ bshow (Presence pjid stat')
 
@@ -546,7 +535,7 @@ isPresenceOf (EventBeginElement name attrs) testType
 isPresenceOf _ _ = False
 
 fromPeer :: (MonadThrow m,MonadIO m, XMPPSession session) => 
-    (session, TVar (Set JID))  -> Sink XML.Event m ()
+    session -> Sink XML.Event m ()
 fromPeer session = doNestingXML $ do
     let log  = liftIO . L.putStrLn . ("(P) " <++>)
     withXML $ \begindoc -> do
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 =