tox-to-xmpp: presence updates.

1 files changed, 19 insertions, 5 deletions

diff --git a/Presence/Presence.hs b/Presence/Presence.hs
index 4ca49f78..59926d13 100644
--- a/Presence/Presence.hs
+++ b/Presence/Presence.hs
@@ -178,7 +178,7 @@ data LocalPresence = LocalPresence
     }
 
 data RemotePresence = RemotePresence
-    { resources :: Map Text Stanza
+    { resources :: Map ResourceName Stanza
     -- , localSubscribers :: Map Text ()
     -- ^ subset of clientsByUser who should be
     -- notified about this presence.
@@ -764,7 +764,14 @@ informPeerPresence state k stanza = do
     -- Presence must indicate full JID with resource...
     dput XJabber $ "xmppInformPeerPresence checking from address..."
     forM_ (stanzaFrom stanza) $ \from -> do
-    let (muser,h,mresource) = splitJID from
+    let (muser0,h,mresource0) = splitJID from
+        -- We'll allow the case that user and resource are simultaneously
+        -- absent.  They will be stored in the remotesByPeer map using the
+        -- empty string.  This is to accomodate the tox protocol which didn't
+        -- anticipate a single peer would have multiple users or front-ends.
+        (muser,mresource) = case (muser0,mresource0) of
+            (Nothing,Nothing) -> (Just "", Just "")
+            _                 -> (muser0,mresource0)
     dput XJabber $ "xmppInformPeerPresence from  = " ++ show from
     -- forM_ mresource       $ \resource -> do
     forM_ muser           $ \user -> do
@@ -806,15 +813,22 @@ informPeerPresence state k stanza = do
         con <- liftMaybe $ Map.lookup ck ktc
         return (ck,con,client)
     dput XJabber $ "xmppInformPeerPresence (length clients="++show (length clients)++")"
+    (ctyp,cprof) <- atomically $ do
+        mconn <- Map.lookup k <$> readTVar (pkeyToChan state)
+        return $ fromMaybe (XMPP,".") $ do
+            ConnectionData _ ctyp cprof <- auxData <$> mconn
+            return (ctyp,cprof)
     forM_ clients $ \(ck,con,client) -> do
         -- (TODO: appropriately authorized clients only.)
         -- For now, all "available" clients (available = sent initial presence)
         is_avail <- atomically $ clientIsAvailable client
         when is_avail $ do
         dput XJabber $ "reversing for client: " ++ show from
-        froms <- do -- flip (maybe $ return [from]) k . const $ do
-            (_,trip) <- multiplyJIDForClient ck from
-            return (map unsplitJID trip)
+        froms <- case ctyp of
+            Tox | clientProfile client == cprof -> return [from]
+            _ -> do -- flip (maybe $ return [from]) k . const $ do
+                (_,trip) <- multiplyJIDForClient ck from
+                return (map unsplitJID trip)
 
         dput XJabber $ "sending to client: " ++ show (stanzaType stanza,froms)
         forM_ froms $ \from' -> do