offline notifications

1 files changed, 57 insertions, 11 deletions

diff --git a/xmppServer.hs b/xmppServer.hs
index 107054bf..699c6a7a 100644
--- a/xmppServer.hs
+++ b/xmppServer.hs
@@ -292,7 +292,24 @@ newConn state k addr outchan = do
     when (isPeerKey k)
         $ sendProbesAndSolicitations state k addr outchan
 
-eofConn state k = atomically $ modifyTVar' (keyToChan state) $ Map.delete k
+eofConn state k = do
+    atomically $ modifyTVar' (keyToChan state) $ Map.delete k
+    case k of
+        ClientKey {} -> do
+            stanza <- makePresenceStanza "{jabber:server}" Nothing Offline
+            informClientPresence state k stanza
+        PeerKey {} -> do
+            let h = peerKeyToText k
+            jids <- atomically $ do
+                rbp <- readTVar (remotesByPeer state)
+                return $ do
+                    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 k stanza
 
 {-
 rewriteJIDForClient1:: Text -> IO (Maybe ((Maybe Text,Text,Maybe Text),SockAddr))
@@ -427,6 +444,9 @@ deliverMessage state fail msg =
         sendModifiedStanzaToClient dup
                                   chan
 
+-- | Send presence notification to subscribed peers.
+-- 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
@@ -461,9 +481,24 @@ informPeerPresence state k stanza = do
     flip (maybe $ return ()) muser           $ \user -> do
     
     clients <- atomically $ do
-        -- TODO: Store the stanza
+
+        -- Update remotesByPeer...
+        rbp <- readTVar (remotesByPeer state)
+        let umap = maybe Map.empty id $ Map.lookup k rbp
+            rp = case (presenceShow $ stanzaType stanza) of
+                    Offline ->
+                         maybe (Map.empty)
+                               (Map.delete resource . resources)
+                             $ Map.lookup user umap
+                    _ -> maybe (Map.singleton resource ())
+                               (Map.insert resource () . resources )
+                             $ Map.lookup user umap
+            umap' = Map.insert user (RemotePresence rp) umap
+        writeTVar (remotesByPeer state) $ Map.insert k umap' rbp
+        -- TODO: Store or delete the stanza (remotesByPeer)
+        
         -- For now, all clients:
-        -- (TODO: interested/authorized clients only.)
+        -- (TODO: interested/auteorized clients only.)
         ktc <- readTVar (keyToChan state)
         runTraversableT $ do
         (ck,client) <- liftMT $ fmap Map.toList $ readTVar (clients state)
@@ -482,15 +517,21 @@ informPeerPresence state k stanza = do
                                    (connChan con)
 
 answerProbe state k stanza chan = do
-    putStrLn $ "answerProbe! " ++ show (stanzaType stanza)
+    -- putStrLn $ "answerProbe! " ++ show (stanzaType stanza)
     ktc <- atomically $ readTVar (keyToChan state)
-    replies <- runTraversableT $ do
-        to <- liftMaybe $ stanzaTo stanza
-        conn <- liftMaybe $ Map.lookup k ktc
+    muser <- runTraversableT $ do
+        to <- liftT $ stanzaTo stanza
+        conn <- liftT $ Map.lookup k ktc
         let (mu,h,_) = splitJID to -- TODO: currently resource-id is ignored on presence
                                    --  probes.  Is this correct? Check the spec.
-        liftIOMaybe $ guardPortStrippedAddress h (auxAddr conn)
-        u <- liftMaybe mu
+        liftMT $ guardPortStrippedAddress h (auxAddr conn)
+        u <- liftT mu
+        let ch = addrToText (auxAddr conn)
+        return (u,conn,ch)
+
+    flip (maybe $ return ()) muser $ \(u,conn,ch) -> do
+
+    replies <- runTraversableT $ do
         cbu <- lift . atomically $ readTVar (clientsByUser state)
         lpres <- liftMaybe $ Map.lookup u cbu
         clientState <- liftT $ Map.elems (networkClients lpres)
@@ -499,11 +540,16 @@ answerProbe state k stanza chan = do
         let jid = unsplitJID (Just $ clientUser clientState
                              , ch
                              ,Just $ clientResource clientState)
-            ch = addrToText (auxAddr conn)
         return stanza { stanzaFrom = Just jid }
+
     forM_ replies $ \reply -> do
         sendModifiedStanzaToPeer reply chan
-    -- TODO: if null replies, send offline message
+
+    -- if no presence, send offline message
+    when (null replies) $ do
+        let jid = unsplitJID (Just u,ch,Nothing)
+        pstanza <- makePresenceStanza "{jabber:server}" (Just jid) Offline
+        atomically $ writeTChan (connChan conn) pstanza
 
 main = runResourceT $ do
     state <- liftIO . atomically $ do