1 files changed, 19 insertions, 29 deletions

diff --git a/Presence/XMPPServer.hs b/Presence/XMPPServer.hs
index 76c14f52..4f61646f 100644
--- a/Presence/XMPPServer.hs
+++ b/Presence/XMPPServer.hs
@@ -38,7 +38,6 @@ import Text.XML.HaXml.Parse  (XParser,xmlParseWith,element,{-doctypedecl,-}proce
 import Text.XML.HaXml.Types as Hax hiding (Element) -- (ElemTag,QName(..),Namespace(..),Element(..),Content(..),AttValue(..))
 import qualified Text.XML.HaXml.Types as Hax (Element(..))
 import Text.XML.HaXml.Posn (Posn, posnLine, posnColumn)
-import Text.XML.HaXml.Lex  (TokenT)
 import qualified Text.XML.HaXml.Pretty as PP
 import Text.PrettyPrint
 import Data.Maybe
@@ -432,13 +431,25 @@ connect_to_server chan peer = (>> return ()) . runMaybeT $ do
 
     connected <- liftIO . async $ connect' (unpack peer) port
 
+    -- We'll cache Presence notifications until the socket
+    -- is ready.
+    cached <- liftIO $ newIORef Map.empty
+
     sock <- MaybeT . fix $ \loop -> do
         e <- atomically $ orElse
                 (fmap Right $ waitSTM connected)
                 (fmap Left  $ readTChan chan)
         case e of
+            Left (OutBoundPresence (Presence jid Offline)) -> do
+                cached_map <- readIORef cached
+                writeIORef cached (Map.delete jid cached_map)
+                loop
+            Left (OutBoundPresence p@(Presence jid st)) -> do
+                cached_map <- readIORef cached
+                writeIORef cached (Map.insert jid st cached_map)
+                loop
             Left event -> do
-                L.putStrLn $ "REMOTE-OUT NOT READY: " <++> bshow event
+                L.putStrLn $ "REMOTE-OUT DISCARDED: " <++> bshow event
                 loop
             Right sock -> return sock
 
@@ -447,6 +458,12 @@ connect_to_server chan peer = (>> return ()) . runMaybeT $ do
         hSetBuffering h NoBuffering
         hPutStrLn h "<stream>"
         L.putStrLn $ "REMOTE-OUT: <stream>"
+        cache <- fmap Map.assocs . readIORef $ cached
+        writeIORef cached Map.empty -- hint garbage collector: we're done with this
+        forM_ cache $ \(jid,st) -> do
+            let r = xmlifyPresence (Presence jid st)
+            hPutStrLn h r
+            L.putStrLn $ "REMOTE-OUT (cache):\n" <++> r <++> "\n"
         fix $ \loop -> do
             event <- atomically $ readTChan chan
             case event of
@@ -459,33 +476,6 @@ connect_to_server chan peer = (>> return ()) . runMaybeT $ do
         L.putStrLn $ "REMOTE-OUT: </stream>"
 
 
-    {-
-    pending <- newTVarIO True
-    thread <- forkIO $
-        runMaybeT $ do
-            let port = "5269"
-            sock <- MaybeT $ connect' (unpack peer) port
-            liftIO $ do
-                h <- socketToHandle sock ReadWriteMode
-                hSetBuffering h NoBuffering
-                hPutStrLn h "<stream>"
-                atomically $ writeTVar pending False
-                fix $ \loop -> do
-                    event <- atomically $ readTChan chan
-                    case event of
-                      OutBoundPresence p -> do
-                        let r = xmlifyPresence p
-                        hPutStrLn h r
-                        L.putStrLn $ "REMOTE:\n" <++> r <++> "\n"
-                    loop
-                hPutStrLn h "</stream>"
-    fix $ \loop -> do
-        event <- atomically $ readTChan chan
-        when (readTVarIO pending) loop
-    joinThread thread
-    return ()
-    -}
-
 parseJID :: ByteString -> JID
 parseJID bjid = 
     let xs = L.splitWith (=='@') bjid