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