From d67caca38d807e4b4e9753600c8038a074a09ab1 Mon Sep 17 00:00:00 2001
From: joe <joe@jerkface.net>
Date: Sat, 1 Mar 2014 22:40:17 -0500
Subject: improved variable name writeTos -> keyToChan

---
 xmppServer.hs | 29 +++++++++++++++++------------
 1 file changed, 17 insertions(+), 12 deletions(-)

(limited to 'xmppServer.hs')

diff --git a/xmppServer.hs b/xmppServer.hs
index 8601d72b..11de871d 100644
--- a/xmppServer.hs
+++ b/xmppServer.hs
@@ -96,7 +96,7 @@ data PresenceState = PresenceState
     , clientsByUser :: TVar (Map Text PresenceContainer)
     , associatedPeers :: TVar (Map SockAddr ())
     , server :: TMVar XMPPServer
-    , writeTos :: TVar (Map ConnectionKey Conn)
+    , keyToChan :: TVar (Map ConnectionKey Conn)
     }
 
 
@@ -211,11 +211,11 @@ data Conn = Conn { connChan :: TChan Stanza
                  , auxAddr :: SockAddr }
 
 newConn state k addr outchan =
-    atomically $ modifyTVar' (writeTos state)
+    atomically $ modifyTVar' (keyToChan state)
         $ Map.insert k Conn { connChan = outchan
                             , auxAddr  = addr }
 
-eofConn state k = atomically $ modifyTVar' (writeTos state) $ Map.delete k
+eofConn state k = atomically $ modifyTVar' (keyToChan state) $ Map.delete k
 
 rewriteJIDForClient1:: Text -> IO (Maybe ((Maybe Text,Text,Maybe Text),SockAddr))
 rewriteJIDForClient1 jid = do
@@ -285,7 +285,7 @@ deliverMessage state fail msg =
              mto
             $ \(to',addr) -> do
         let k = PeerKey addr
-        chans <- atomically $ readTVar (writeTos state)
+        chans <- atomically $ readTVar (keyToChan state)
         flip (maybe fail) (Map.lookup k chans) $ \(Conn { connChan=chan
                                                         , auxAddr=laddr }) -> do
         (n,r) <- forClient state senderk (return (Nothing,Nothing))
@@ -296,8 +296,8 @@ deliverMessage state fail msg =
         let dup = (msg { stanzaTo=Just to', stanzaFrom=Just from' })
         sendModifiedStanzaToPeer dup chan
       NetworkOrigin senderk@(PeerKey {}) _ -> do
-        chans <- atomically $ readTVar (writeTos state)
-        flip (maybe fail) (Map.lookup senderk chans)
+        key_to_chan <- atomically $ readTVar (keyToChan state)
+        flip (maybe fail) (Map.lookup senderk key_to_chan)
             $ \(Conn { connChan=sender_chan
                      , auxAddr=laddr }) -> do
         flip (maybe fail) (stanzaTo msg) $ \to -> do
@@ -312,11 +312,16 @@ deliverMessage state fail msg =
         flip (maybe fail) n $ \n -> do
         flip (maybe fail) (Map.lookup n cmap) $ \presence_container -> do
         let ks = Map.keys (networkClients presence_container)
-            cs = mapMaybe (flip Map.lookup chans) ks
-        if null cs then fail
-                   else do
-        forM_ cs $ \Conn { connChan=chan} -> do
+            chans = mapMaybe (flip Map.lookup key_to_chan) ks
+        if null chans then fail else do
+        forM_ chans $ \Conn { connChan=chan} -> do
         putStrLn $ "sending "++show (stanzaId msg)++" to clients "++show ks
+        -- TODO: Cloning isn't really neccessary unless there are multiple
+        -- destinations and we should probably transition to minimal cloning,
+        -- or else we should distinguish between announcable stanzas and
+        -- consumable stanzas and announcables use write-only broadcast
+        -- channels that must be cloned in order to be consumed.
+        -- For now, we are doing redundant cloning.
         dup <- cloneStanza (msg { stanzaTo=Just to'
                                 , stanzaFrom=from' })
         sendModifiedStanzaToClient dup
@@ -329,12 +334,12 @@ main = runResourceT $ do
         clientsByUser <- newTVar Map.empty
         associatedPeers <- newTVar Map.empty
         xmpp <- newEmptyTMVar
-        writeTos <- newTVar Map.empty
+        keyToChan <- newTVar Map.empty
         return PresenceState
             { clients = clients
             , clientsByUser = clientsByUser
             , associatedPeers = associatedPeers
-            , writeTos = writeTos
+            , keyToChan = keyToChan
             , server = xmpp
             }
     sv <- xmppServer
-- 
cgit v1.2.3