From 51a852c24d1dd767bd4e82803457a35aa3e845ab Mon Sep 17 00:00:00 2001 From: "Evgeny @ SimpleX Chat" <259188159+evgeny-simplex@users.noreply.github.com> Date: Fri, 31 Jul 2026 14:58:47 +0000 Subject: [PATCH] only mark as "key sent" when forwarder supports binary encoding --- src/Simplex/Chat/Library/Commands.hs | 6 ++-- src/Simplex/Chat/Library/Internal.hs | 42 ++++++++++++++-------------- 2 files changed, 24 insertions(+), 24 deletions(-) diff --git a/src/Simplex/Chat/Library/Commands.hs b/src/Simplex/Chat/Library/Commands.hs index 1cf758e6b0..12ad89563d 100644 --- a/src/Simplex/Chat/Library/Commands.hs +++ b/src/Simplex/Chat/Library/Commands.hs @@ -64,7 +64,7 @@ import Simplex.Chat.Delivery (DeliveryJobScope (..), DeliveryJobSpec (..), Deliv import Simplex.Chat.Files import Simplex.Chat.Markdown import Simplex.Chat.Messages -import Simplex.Chat.Messages.Batch (encodeBatchElement) +import Simplex.Chat.Messages.Batch (BatchMode, encodeBatchElement) import Simplex.Chat.Messages.CIContent import Simplex.Chat.Messages.CIContent.Events import Simplex.Chat.Operators @@ -4838,8 +4838,8 @@ processChatCommand cxt nm = \case Right _ -> GSSNew Left e -> GSSError $ SndErrOther $ tshow e forM_ ciIds $ \ciId -> createGroupSndStatus db ciId (groupMemberId' m) status - processForwarded :: DB.Connection -> GroupMember -> IO () - processForwarded db GroupMember {groupMemberId} = + processForwarded :: DB.Connection -> (GroupMember, BatchMode) -> IO () + processForwarded db (GroupMember {groupMemberId}, _) = forM_ cis_ $ \ci_ -> forM_ ci_ $ \ci -> createGroupSndStatus db (chatItemId' ci) groupMemberId GSSForwarded processPending :: DB.Connection -> Map MessageId ChatItemId -> (GroupMember, Either ChatError MessageId, Either ChatError ()) -> IO () diff --git a/src/Simplex/Chat/Library/Internal.hs b/src/Simplex/Chat/Library/Internal.hs index f61688d681..88359f1c80 100644 --- a/src/Simplex/Chat/Library/Internal.hs +++ b/src/Simplex/Chat/Library/Internal.hs @@ -40,7 +40,7 @@ import Data.Foldable (foldr') import Data.Functor (($>)) import Data.Functor.Identity import Data.Int (Int64) -import Data.List (foldl', mapAccumL, partition) +import Data.List (find, foldl', mapAccumL, partition) import Data.List.NonEmpty (NonEmpty (..), (<|)) import qualified Data.List.NonEmpty as L import Data.Map.Strict (Map) @@ -2507,12 +2507,11 @@ sendGroupProfileUpdate user gInfo scope asGroup members recordKeyStatus gsr recordKeyStatus GroupSndResult {sentTo, pending, forwarded, failed} = withStore' $ \db -> do - setMembersKeyStatus db KSSent $ deliveredIds <> keyMemIds forwarded - setMembersKeyStatus db KSFailed $ keyMemIds failed + setMembersKeyStatus db KSSent $ deliveredIds <> [groupMemberId' m | (m, BMBinary) <- forwarded, memberNeedsKey m] + setMembersKeyStatus db KSFailed $ map groupMemberId' (filter memberNeedsKey failed) incMembersKeyAttempts db retriableIds forM_ finalErrs $ \(mId, e) -> setMemberKeyStatus db (KSError $ tshow e) mId where - keyMemIds = map groupMemberId' . filter memberNeedsKey (deliveredIds, retriableIds, finalErrs) = foldr addResult (foldr addResult ([], [], []) pending) sentTo where addResult :: (GroupMember, a, Either ChatError b) -> ([GroupMemberId], [GroupMemberId], [(GroupMemberId, ChatError)]) -> ([GroupMemberId], [GroupMemberId], [(GroupMemberId, ChatError)]) @@ -2534,7 +2533,7 @@ sendGroupProfileUpdate user gInfo scope asGroup members data GroupSndResult = GroupSndResult { sentTo :: [(GroupMember, Either ChatError [MessageId], Either ChatError ([Int64], PQEncryption))], pending :: [(GroupMember, Either ChatError MessageId, Either ChatError ())], - forwarded :: [GroupMember], + forwarded :: [(GroupMember, BatchMode)], failed :: [GroupMember] } @@ -2572,21 +2571,18 @@ sendGroupSignedMessages_ gInfo@GroupInfo {groupId} recipientMembers signedEvents liftM2 (<>) (shuffle adminMs) (shuffle otherMs) where isAdmin GroupMember {memberRole} = memberRole >= GRAdmin - batchMode m - | useRelays' gInfo || m `supportsVersion` relayWebCapVersion = BMBinary - | otherwise = BMJson addMember members m acc@(toSend@(toSendBin, toSendJson), pending, forwarded, failed, !mIds, !dups) = case memberSendAction gInfo events members m of Just a | mId `S.member` mIds -> (toSend, pending, forwarded, failed, mIds, dups + 1) | otherwise -> case a of MSASend conn -> - let toSend' = case batchMode m of + let toSend' = case batchMode gInfo m of BMBinary -> ((m, conn) : toSendBin, toSendJson) BMJson -> (toSendBin, (m, conn) : toSendJson) in (toSend', pending, forwarded, failed, mIds', dups) MSAPending -> (toSend, m : pending, forwarded, failed, mIds', dups) - MSAForwarded -> (toSend, pending, m : forwarded, failed, mIds', dups) + MSAForwarded mode -> (toSend, pending, (m, mode) : forwarded, failed, mIds', dups) MSAFail -> (toSend, pending, forwarded, m : failed, mIds', dups) Nothing -> acc where @@ -2632,7 +2628,12 @@ sendGroupSignedMessages_ gInfo@GroupInfo {groupId} recipientMembers signedEvents createPendingMsg db (groupMemberId, msgId) = createPendingGroupMessage db groupMemberId msgId $> Right () -data MemberSendAction = MSASend Connection | MSAPending | MSAForwarded | MSAFail +batchMode :: GroupInfo -> GroupMember -> BatchMode +batchMode gInfo m + | useRelays' gInfo || m `supportsVersion` relayWebCapVersion = BMBinary + | otherwise = BMJson + +data MemberSendAction = MSASend Connection | MSAPending | MSAForwarded BatchMode | MSAFail memberSendAction :: GroupInfo -> NonEmpty (ChatMsgEvent e) -> [GroupMember] -> GroupMember -> Maybe MemberSendAction memberSendAction gInfo@GroupInfo {membership} events members m@GroupMember {memberStatus} @@ -2659,16 +2660,15 @@ memberSendAction gInfo@GroupInfo {membership} events members m@GroupMember {memb GCPreMember -> forwardSupportedOrPending (invitedByGroupMemberId membership) GCPostMember -> forwardSupportedOrPending (invitedByGroupMemberId m) where - forwardSupportedOrPending invitingMemberId_ - | hasInvitingMember && all isForwardedGroupMsg events = Just MSAForwarded - | any isXGrpMsgForward events = Nothing - | otherwise = Just MSAPending + forwardSupportedOrPending invitingMemberId_ = case invitingMember_ of + Just forwarder | all isForwardedGroupMsg events -> Just (MSAForwarded (batchMode gInfo forwarder)) + _ + | any isXGrpMsgForward events -> Nothing + | otherwise -> Just MSAPending where - hasInvitingMember = case invitingMemberId_ of - Just invMemberId -> - -- can be optimized for large groups by replacing [GroupMember] with Map GroupMemberId GroupMember - any (\m' -> groupMemberId' m' == invMemberId) members - Nothing -> False + invitingMember_ = invitingMemberId_ >>= \invMemberId -> + -- can be optimized for large groups by replacing [GroupMember] with Map GroupMemberId GroupMember + find (\m' -> groupMemberId' m' == invMemberId) members isXGrpMsgForward event = case event of XGrpMsgForward {} -> True _ -> False @@ -2693,7 +2693,7 @@ sendGroupMemberMessage gInfo@GroupInfo {groupId} m@GroupMember {groupMemberId} c messageMember SndMessage {msgId, msgBody} = forM_ (memberSendAction gInfo (chatMsgEvent :| []) [m] m) $ \case MSASend conn -> void $ deliverMessage conn (toCMEventTag chatMsgEvent) msgBody msgId MSAPending -> withStore' $ \db -> createPendingGroupMessage db groupMemberId msgId - MSAForwarded -> pure () + MSAForwarded _ -> pure () MSAFail -> pure () -- Send pre-encoded forwarded message preserving original signature