remotesByPeer map for tracking presence of remote users

1 files changed, 20 insertions, 2 deletions

diff --git a/xmppServer.hs b/xmppServer.hs
index 11de871d..606bd05e 100644
--- a/xmppServer.hs
+++ b/xmppServer.hs
@@ -40,7 +40,10 @@ unsplitJID (n,h,r) = jid
     jid0 = maybe h (\n->n<>"@"<>h) n
     jid = maybe jid0 (\r->jid0<>"/"<>r) r
 
-splitJID :: Text -> (Maybe Text,Text,Maybe Text)
+type UserName = Text
+type ResourceName = Text
+
+splitJID :: Text -> (Maybe UserName,Text,Maybe ResourceName)
 splitJID bjid = 
     let xs = splitAll '@' bjid
         ys = splitAll '/' (last xs)
@@ -56,6 +59,11 @@ splitJID bjid =
                 _       -> Nothing
     in (name,server,rsrc)
 
+isPeerKey :: ConnectionKey -> Bool
+isPeerKey k = case k of { PeerKey {} -> True ; _ -> False }
+
+isClientKey :: ConnectionKey -> Bool
+isClientKey k = case k of { ClientKey {} -> True ; _ -> False }
 
 textHostName = fmap Text.pack BSD.getHostName
 
@@ -94,6 +102,9 @@ pcIsEmpty pc = Map.null (networkClients pc)
 data PresenceState = PresenceState
     { clients :: TVar (Map ConnectionKey ClientState)
     , clientsByUser :: TVar (Map Text PresenceContainer)
+    , remotesByPeer :: TVar (Map ConnectionKey
+                                 (Map UserName
+                                      (Map ResourceName ())))
     , associatedPeers :: TVar (Map SockAddr ())
     , server :: TMVar XMPPServer
     , keyToChan :: TVar (Map ConnectionKey Conn)
@@ -210,10 +221,15 @@ rosterGetSubscribers = rosterGetStuff ConfigFiles.getSubscribers
 data Conn = Conn { connChan :: TChan Stanza
                  , auxAddr :: SockAddr }
 
-newConn state k addr outchan =
+sendProbesAndSlocitations state k chan = do
+    return ()
+
+newConn state k addr outchan = do
     atomically $ modifyTVar' (keyToChan state)
         $ Map.insert k Conn { connChan = outchan
                             , auxAddr  = addr }
+    when (isPeerKey k)
+        $ sendProbesAndSlocitations state k outchan
 
 eofConn state k = atomically $ modifyTVar' (keyToChan state) $ Map.delete k
 
@@ -332,12 +348,14 @@ main = runResourceT $ do
     state <- liftIO . atomically $ do
         clients <- newTVar Map.empty
         clientsByUser <- newTVar Map.empty
+        remotesByPeer <- newTVar Map.empty
         associatedPeers <- newTVar Map.empty
         xmpp <- newEmptyTMVar
         keyToChan <- newTVar Map.empty
         return PresenceState
             { clients = clients
             , clientsByUser = clientsByUser
+            , remotesByPeer = remotesByPeer
             , associatedPeers = associatedPeers
             , keyToChan = keyToChan
             , server = xmpp