announcePresence interface

1 files changed, 19 insertions, 16 deletions

diff --git a/Presence/main.hs b/Presence/main.hs
index b0721292..ed247bca 100644
--- a/Presence/main.hs
+++ b/Presence/main.hs
@@ -87,11 +87,14 @@ instance XMPPSession UnixSession where
         return (JID (Just user) host rsc)
     closeSession _             = L.putStrLn "SESSION: close"
     subscribe session Nothing = do
-        let tmvar = greedySubscriber (presence_state session)
+        let tmvar = localSubscriber (presence_state session)
         atomically $ subscribeToChan tmvar
     subscribe session (Just jid) = do
         let tvar = subscriberMap (presence_state session)
         atomically $ subscribeToMap tvar jid
+    announcePresence session (Presence jid status) = do
+        subs <- readTVarIO $ subscriberMap (presence_state session)
+        update_presence Nothing (fmap snd subs) (Set.singleton jid) (const status)
 
 
 subscribeToChan tmvar =
@@ -128,14 +131,14 @@ sendPresence chan jid status =
 
 lookupT jid subscribers = MaybeT . return $ Map.lookup jid subscribers 
 
-update_presence greedy subscribers state getStatus =
+update_presence locals_greedy subscribers state getStatus =
     forM_ (Set.toList state) $ \jid -> do
       let status = getStatus jid 
       runMaybeT $ do
         chan <- lookupT jid subscribers
         sendPresence chan jid status
       runMaybeT $ do
-        chan <- MaybeT . return $ greedy
+        chan <- MaybeT . return $ locals_greedy
         sendPresence chan jid status
       putStrLn $ bshow jid <++> " " <++> bshow status
 
@@ -146,15 +149,15 @@ data PresenceState = PresenceState
     , currentTTY    :: TVar ByteString
     , activeUsers   :: TVar (Set JID)
     , subscriberMap :: TVar (Map JID (RefCount,TChan Presence))
-    , greedySubscriber :: TMVar (RefCount,TChan Presence)
+    , localSubscriber :: TMVar (RefCount,TChan Presence)
     }
 
 newPresenceState hostname = atomically $ do
     tty  <- newTVar ""
     us   <- newTVar (Set.empty)
     subs <- newTVar (Map.empty)
-    greedy <- newEmptyTMVar
-    return $ PresenceState hostname tty us subs greedy
+    locals_greedy <- newEmptyTMVar
+    return $ PresenceState hostname tty us subs locals_greedy
 
 track_login host state e = do
 #ifndef NOUTMP
@@ -167,27 +170,27 @@ track_login host state e = do
               then Just (jid user host tty)
               else Nothing
         new_users = Set.fromList $ mapMaybe (toJabberId host) us
-    (tty,known_users,subs,greedy) <- atomically $ do
+    (tty,known_users,subs,locals_greedy) <- atomically $ do
             tty <- readTVar                $ currentTTY state
             st  <- flip swapTVar new_users $ activeUsers state
             xs  <- readTVar                $ subscriberMap state
-            greedy <- tryReadTMVar $ greedySubscriber state
-            return (tty,st,fmap snd xs,fmap snd greedy)
+            locals_greedy <- tryReadTMVar $ localSubscriber state
+            return (tty,st,fmap snd xs,fmap snd locals_greedy)
     let arrivals   = new_users \\ known_users
         departures = known_users \\ new_users
-    update_presence greedy subs departures $ const Offline
-    update_presence greedy subs arrivals   $ matchResource tty
+    update_presence locals_greedy subs departures $ const Offline
+    update_presence locals_greedy subs arrivals   $ matchResource tty
 
 on_chvt state vtnum = do
     let tty = L.snoc "tty" $ intToDigit (fromIntegral vtnum)
     L.putStrLn $ "VT switch: " <++> tty
-    (users,subs,greedy) <- atomically $ do
+    (users,subs,locals_greedy) <- atomically $ do
         us   <- readTVar $ activeUsers state
         subs <- readTVar $ subscriberMap state
         writeTVar (currentTTY state) tty
-        greedy <- tryReadTMVar $ greedySubscriber state
-        return (us,fmap snd subs,fmap snd greedy)
-    update_presence greedy subs users $ matchResource tty
+        locals_greedy <- tryReadTMVar $ localSubscriber state
+        return (us,fmap snd subs,fmap snd locals_greedy)
+    update_presence locals_greedy subs users $ matchResource tty
 
 data UnixConfig = UnixConfig
 
@@ -201,7 +204,7 @@ start host = do
     let dologin e = track_login host tracked e
         dologin :: t -> IO ()
 
-    chan <- atomically $ subscribeToChan (greedySubscriber tracked)
+    chan <- atomically $ subscribeToChan (localSubscriber tracked)
     remotes <- forkIO $ seekRemotePeers (/=host) UnixConfig chan
 
     installHandler sigUSR1 (Catch (dologin (userError "signaled"))) Nothing