Send cached presence to client.

1 files changed, 30 insertions, 5 deletions

diff --git a/xmppServer.hs b/xmppServer.hs
index 63420076..709137dc 100644
--- a/xmppServer.hs
+++ b/xmppServer.hs
@@ -87,7 +87,7 @@ data LocalPresence = LocalPresence
     }
 
 data RemotePresence = RemotePresence
-    { resources :: Map Text ()
+    { resources :: Map Text Stanza
     -- , localSubscribers :: Map Text ()
     -- ^ subset of clientsByUser who should be
     -- notified about this presence.
@@ -490,8 +490,8 @@ informPeerPresence state k stanza = do
                          maybe (Map.empty)
                                (Map.delete resource . resources)
                              $ Map.lookup user umap
-                    _ -> maybe (Map.singleton resource ())
-                               (Map.insert resource () . resources )
+                    _ -> maybe (Map.singleton resource stanza) 
+                               (Map.insert resource stanza . resources )
                              $ Map.lookup user umap
             umap' = Map.insert user (RemotePresence rp) umap
         writeTVar (remotesByPeer state) $ Map.insert k umap' rbp
@@ -506,12 +506,12 @@ informPeerPresence state k stanza = do
         return (ck,con,client)
     putStrLn $ "xmppInformPeerPresence (length clients="++show (length clients)++")"
     forM_ clients $ \(ck,con,client) -> do
-        from' <- do
+        froms <- do
             let ClientKey laddr = ck
             (_,trip) <- multiplyJIDForClient laddr from
             return (map unsplitJID trip)
         putStrLn $ "sending to client: " ++ show (stanzaType stanza)
-        forM_ from' $ \from' -> do
+        forM_ froms $ \from' -> do
         dup <- cloneStanza stanza
         sendModifiedStanzaToClient (dup { stanzaFrom=Just from' })
                                    (connChan con)
@@ -551,6 +551,30 @@ answerProbe state k stanza chan = do
         pstanza <- makePresenceStanza "jabber:server" (Just jid) Offline
         atomically $ writeTChan (connChan conn) pstanza
 
+sendCachedPresence state k chan = do
+    -- TODO: send buddies in remotesByPeer
+    forClient state k (return ()) $ \client -> do
+    rbp <- atomically $ readTVar (remotesByPeer state)
+    jids <- configText ConfigFiles.getBuddies (clientUser client)
+    let hosts = map ((\(_,h,_)->h) . splitJID) jids
+    addrs <- resolveAllPeers hosts 
+    let onlines = rbp `Map.intersection` Map.mapKeys PeerKey addrs
+        ClientKey laddr = k
+    forM_ (Map.toList onlines) $ \(pk, umap) -> do
+        forM_ (Map.toList umap) $ \(user,rp) -> do
+        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
+        forM_ js $ \jid -> do
+        let from' = unsplitJID jid
+        dup <- cloneStanza stanza
+        sendModifiedStanzaToClient (dup { stanzaFrom=Just from' })
+                                   chan -- (connChan con)
+
+    -- TODO: send local buddies in clientsByUser
+    return ()
+
 main = runResourceT $ do
     state <- liftIO . atomically $ do
         clients <- newTVar Map.empty
@@ -586,6 +610,7 @@ main = runResourceT $ do
         , xmppInformClientPresence = informClientPresence state
         , xmppInformPeerPresence = informPeerPresence state
         , xmppAnswerProbe = answerProbe state
+        , xmppSendCachedPresenceToClient = sendCachedPresence state
         }
     liftIO $ do
     atomically $ putTMVar (server state) sv