1 files changed, 25 insertions, 44 deletions

diff --git a/xmppServer.hs b/xmppServer.hs
index d5ad7c6a..1ab36cd6 100644
--- a/xmppServer.hs
+++ b/xmppServer.hs
@@ -37,6 +37,7 @@ import LocalPeerCred
 import XMPPServer
 import PeerResolve
 import ConsoleWriter
+import ClientState
 
 type UserName = Text
 type ResourceName = Text
@@ -74,28 +75,6 @@ localJID user resource = do
     hostname <- textHostName
     return $ user <> "@" <> hostname <> "/" <> resource
 
-cf_available :: Int8
-cf_available = 0x1
-cf_interested :: Int8
-cf_interested = 0x2
-
-data ClientState = ClientState
-    { clientResource :: Text
-    , clientUser :: Text
-    , clientPid :: Maybe ProcessID
-    , clientStatus :: TVar (Maybe Stanza)
-    , clientFlags :: TVar Int8
-    }
-
--- | True if the client has sent an initial presence
-clientIsAvailable c  = do
-    flgs <- readTVar (clientFlags c)
-    return $ flgs .&. cf_available /= 0
-
--- | True if the client has requested a roster
-clientIsInterested c = do
-    flgs <- readTVar (clientFlags c)
-    return $ flgs .&. cf_interested /= 0
 
 data LocalPresence = LocalPresence
     { networkClients :: Map ConnectionKey ClientState
@@ -130,7 +109,7 @@ pcIsEmpty pc = Map.null (networkClients pc)
 data PresenceState = PresenceState
     { clients :: TVar (Map ConnectionKey ClientState)
     , clientsByUser :: TVar (Map Text LocalPresence)
-    , remotesByPeer :: TVar (Map (Maybe ConnectionKey)
+    , remotesByPeer :: TVar (Map ConnectionKey
                                  (Map UserName
                                       RemotePresence))
     , associatedPeers :: TVar (Map SockAddr ())
@@ -326,13 +305,13 @@ eofConn state k = do
             jids <- atomically $ do
                 rbp <- readTVar (remotesByPeer state)
                 return $ do
-                    umap <- maybeToList $ Map.lookup (Just k) rbp
+                    umap <- maybeToList $ Map.lookup k rbp
                     (u,rp) <- Map.toList umap
                     r <- Map.keys (resources rp)
                     return $ unsplitJID (Just u, h, Just r)
             forM_ jids $ \jid -> do
             stanza <- makePresenceStanza "jabber:client" (Just jid) Offline
-            informPeerPresence state (Just k) stanza
+            informPeerPresence state k stanza
 
 {-
 rewriteJIDForClient1:: Text -> IO (Maybe ((Maybe Text,Text,Maybe Text),SockAddr))
@@ -480,10 +459,13 @@ deliverMessage state fail msg =
 
 
 setClientFlag state k flag = 
-        atomically $ do
-            cmap <- readTVar (clients state)
-            flip (maybe $ return ()) (Map.lookup k cmap) $ \client -> do
-            modifyTVar' (clientFlags client) (\flgs -> flgs .|. flag)
+    atomically $ do
+        cmap <- readTVar (clients state)
+        flip (maybe $ return ()) (Map.lookup k cmap) $ \client -> do
+        setClientFlag0 client flag
+
+setClientFlag0 client flag = 
+    modifyTVar' (clientFlags client) (\flgs -> flgs .|. flag)
 
 informSentRoster state k = do
     setClientFlag state k cf_interested
@@ -503,16 +485,16 @@ clientJID con client = unsplitJID ( Just $ clientUser client
 -- Note that a full JID from address will be added to the
 -- stanza if it is not present.
 informClientPresence state k stanza = do
-    dup <- cloneStanza stanza
-    atomically $ do
-        mb <- fmap (Map.lookup k) $ readTVar (clients state)
-        flip (maybe $ return ()) mb $ \cstate -> do
-        writeTVar (clientStatus cstate) $ Just dup
     forClient state k (return ()) $ \client -> do
+    informClientPresence0 state (Just k) client stanza
+
+informClientPresence0 state mbk client stanza = do
+    dup <- cloneStanza stanza
+    atomically $ writeTVar (clientStatus client) $ Just dup
     is_avail <- atomically $ clientIsAvailable client
     when (not is_avail) $ do
-        setClientFlag state k cf_available
-        sendCachedPresence state k
+        atomically $ setClientFlag0 client cf_available
+        maybe (return ()) (sendCachedPresence state) mbk
     addrs <- subscribedPeers (clientUser client)
     ktc <- atomically $ readTVar (keyToChan state)
     let connected = mapMaybe (flip Map.lookup ktc . PeerKey) addrs
@@ -579,7 +561,7 @@ informPeerPresence state k stanza = do
         is_avail <- atomically $ clientIsAvailable client
         when is_avail $ do
         putStrLn $ "reversing for client: " ++ show from
-        froms <- flip (maybe $ return [from]) k . const $ do
+        froms <- do -- flip (maybe $ return [from]) k . const $ do
             let ClientKey laddr = ck
             (_,trip) <- multiplyJIDForClient laddr from
             return (map unsplitJID trip)
@@ -649,16 +631,15 @@ sendCachedPresence state k = do
     jids <- configText ConfigFiles.getBuddies (clientUser client)
     let hosts = map ((\(_,h,_)->h) . splitJID) jids
     addrs <- resolveAllPeers hosts 
-    let onlines = rbp `Map.intersection` (Map.insert Nothing () -- send console presences
-                                            $ Map.mapKeys (Just . PeerKey) addrs)
+    let onlines = rbp `Map.intersection` Map.mapKeys PeerKey addrs
         ClientKey laddr = k
     mcon <- atomically $ do ktc <- readTVar (keyToChan state)
                             return $ Map.lookup k ktc
     flip (maybe $ return ()) mcon $ \con -> do
-    me <- textHostName
+    -- me <- textHostName
     forM_ (Map.toList onlines) $ \(pk, umap) -> do
         forM_ (Map.toList umap) $ \(user,rp) -> do
-        let h = maybe me peerKeyToText pk
+        let h = peerKeyToText pk
         forM_ (Map.toList $ resources rp) $ \(resource,stanza) -> do
         let jid = unsplitJID (Just user,h,Just resource)
         (mine,js) <- multiplyJIDForClient laddr jid
@@ -1002,7 +983,7 @@ main = runResourceT $ do
         , xmppSubscribeToRoster = informSentRoster state
         , xmppDeliverMessage = deliverMessage state
         , xmppInformClientPresence = informClientPresence state
-        , xmppInformPeerPresence = \k -> informPeerPresence state (Just k)
+        , xmppInformPeerPresence = informPeerPresence state
         , xmppAnswerProbe = \k stanza chan -> answerProbe state (stanzaTo stanza) k chan
         , xmppClientSubscriptionRequest = clientSubscriptionRequest state
         , xmppPeerSubscriptionRequest = peerSubscriptionRequest state
@@ -1020,8 +1001,8 @@ main = runResourceT $ do
         console <- atomically $ dupTChan (cwPresenceChan $ consoleWriter state)
         fix $ \loop -> do
         what <- atomically
-            $ orElse (do stanza <- readTChan console
-                         return $ do informPeerPresence state Nothing stanza
+            $ orElse (do (client,stanza) <- readTChan console
+                         return $ do informClientPresence0 state Nothing client stanza
                                      loop)
                      (do readTMVar quitVar
                          return $ return ())