From 41adc928f46a70c88f2f64ee1dfe36e3501883bb Mon Sep 17 00:00:00 2001
From: joe <joe@jerkface.net>
Date: Wed, 20 Jun 2018 21:47:43 -0400
Subject: Avoid spamming friend-requests to xmpp client.

---
 ToxToXMPP.hs | 16 ++++++++++++----
 1 file changed, 12 insertions(+), 4 deletions(-)

(limited to 'ToxToXMPP.hs')

diff --git a/ToxToXMPP.hs b/ToxToXMPP.hs
index 5495f5ad..367e5bf7 100644
--- a/ToxToXMPP.hs
+++ b/ToxToXMPP.hs
@@ -103,12 +103,15 @@ key2jid nospam key = T.pack $ show $ NoSpamId nsp key
 type JabberClients = Map.Map ConnectionKey PerClient
 
 data PerClient = PerClient
-    {
+    { pcDeliveredFRs :: TVar (Set.Set Tox.FriendRequest)
     }
 
 initPerClient :: STM PerClient
 initPerClient = do
-    return PerClient {}
+    frs <- newTVar Set.empty
+    return PerClient
+        { pcDeliveredFRs = frs
+        }
 
 data ToxToXMPP = ToxToXMPP
     { txAnnouncer :: Announcer
@@ -130,7 +133,7 @@ dispatch tx (OnionRouted  theirkey (OnionFriendRequest fr) ) = do
                   , txPresence  = st } = tx
     k2c <- atomically $ do
         refs <- readTVar (accountExtra acnt)
-        k2c <- Map.filterWithKey (\k _ -> isJust $ k `Map.lookup` refs) <$> readTVar (keyToChan st)
+        k2c <- Map.intersectionWith (,) refs <$> readTVar (keyToChan st)
         clients <- readTVar (clients st)
         return $ Map.intersectionWith (,) k2c clients
     -- TODO: Below we're using a hard coded default as their jabber user id.
@@ -139,7 +142,12 @@ dispatch tx (OnionRouted  theirkey (OnionFriendRequest fr) ) = do
     -- after a zero-termination, or as visible text (nospam:...).
     let default_nospam = 0x6a7a27fc -- big-endian base64: anon/A==
         theirjid = key2jid default_nospam theirkey
-    forM_ k2c $ \(conn,client) -> do
+    forM_ k2c $ \((PerClient{pcDeliveredFRs},conn),client) -> do
+        alreadyDelivered <- atomically $ do
+            frs <- readTVar pcDeliveredFRs
+            writeTVar pcDeliveredFRs $ Set.insert fr frs
+            return $ Set.member fr frs
+        when (not alreadyDelivered) $ do
         self <- localJID (clientUser client) (clientProfile client) (clientResource client)
         ask <- presenceSolicitation theirjid self
         -- TODO Send friend-request text as an instant message or at least
-- 
cgit v1.2.3