From 15fdab597bb89d6721689dcd3b1ba25f3645fd69 Mon Sep 17 00:00:00 2001
From: spaced4ndy <8711996+spaced4ndy@users.noreply.github.com>
Date: Thu, 23 Nov 2023 01:36:52 +0400
Subject: [PATCH] core: shuffle members when sending messages and
 introductions; send to admins and owners first (#3431)

* core: shuffle members when sending messages and introductions; send to admins and owners first

* refactor

---------

Co-authored-by: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com>
---
 src/Simplex/Chat.hs | 20 ++++++++++++++++----
 1 file changed, 16 insertions(+), 4 deletions(-)

diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs
index b67fa1f3d..2696b5311 100644
--- a/src/Simplex/Chat.hs
+++ b/src/Simplex/Chat.hs
@@ -39,19 +39,20 @@ import Data.Either (fromRight, rights)
 import Data.Fixed (div')
 import Data.Functor (($>))
 import Data.Int (Int64)
-import Data.List (find, foldl', isSuffixOf, partition, sortOn)
+import Data.List (find, foldl', isSuffixOf, partition, sortBy, sortOn)
 import Data.List.NonEmpty (NonEmpty, nonEmpty)
 import qualified Data.List.NonEmpty as L
 import Data.Map.Strict (Map)
 import qualified Data.Map.Strict as M
 import Data.Maybe (catMaybes, fromMaybe, isJust, isNothing, listToMaybe, mapMaybe, maybeToList)
+import Data.Ord (comparing)
 import Data.Text (Text)
 import qualified Data.Text as T
 import Data.Text.Encoding (decodeLatin1, encodeUtf8)
 import Data.Time (NominalDiffTime, addUTCTime, defaultTimeLocale, formatTime)
 import Data.Time.Clock (UTCTime, diffUTCTime, getCurrentTime, nominalDay, nominalDiffTimeToSeconds)
 import Data.Time.Clock.System (SystemTime, systemToUTCTime)
-import Data.Word (Word32)
+import Data.Word (Word16, Word32)
 import qualified Database.SQLite.Simple as SQL
 import Simplex.Chat.Archive
 import Simplex.Chat.Call
@@ -3552,7 +3553,8 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
             members <- withStore' $ \db -> getGroupMembers db user gInfo
             intros <- withStore' $ \db -> createIntroductions db members m
             void . sendGroupMessage user gInfo members . XGrpMemNew $ memberInfo m
-            forM_ intros $ \intro ->
+            shuffledIntros <- liftIO $ shuffleMembers intros $ \GroupMemberIntro {reMember = GroupMember {memberRole}} -> memberRole
+            forM_ shuffledIntros $ \intro ->
               processIntro intro `catchChatError` (toView . CRChatError (Just user))
             where
               sendXGrpLinkMem = do
@@ -5525,7 +5527,8 @@ sendGroupMessage' :: forall e m. (MsgEncodingI e, ChatMonad m) => User -> [Group
 sendGroupMessage' user members chatMsgEvent groupId introId_ postDeliver = do
   msg <- createSndMessage chatMsgEvent (GroupId groupId)
   -- TODO collect failed deliveries into a single error
-  rs <- forM (filter memberCurrent members) $ \m ->
+  recipientMembers <- liftIO $ shuffleMembers (filter memberCurrent members) $ \GroupMember {memberRole} -> memberRole
+  rs <- forM recipientMembers $ \m ->
     messageMember m msg `catchChatError` (\e -> toView (CRChatError (Just user) e) $> Nothing)
   let sentToMembers = catMaybes rs
   pure (msg, sentToMembers)
@@ -5563,6 +5566,15 @@ sendGroupMessage' user members chatMsgEvent groupId introId_ postDeliver = do
           XGrpMsgForward {} -> True
           _ -> False
 
+shuffleMembers :: [a] -> (a -> GroupMemberRole) -> IO [a]
+shuffleMembers ms role = do
+  let (adminMs, otherMs) = partition ((GRAdmin <=) . role) ms
+  liftM2 (<>) (shuffle adminMs) (shuffle otherMs)
+  where
+    random :: IO Word16
+    random = randomRIO (0, 65535)
+    shuffle xs = map snd . sortBy (comparing fst) <$> mapM (\x -> (,x) <$> random) xs
+
 sendPendingGroupMessages :: ChatMonad m => User -> GroupMember -> Connection -> m ()
 sendPendingGroupMessages user GroupMember {groupMemberId, localDisplayName} conn = do
   pendingMessages <- withStore' $ \db -> getPendingGroupMessages db groupMemberId