From 4b5864a94582efc8d2fc689b103f59b2d814a2db Mon Sep 17 00:00:00 2001 From: Evgeny Poberezkin Date: Fri, 31 Jul 2026 12:33:35 +0100 Subject: [PATCH] fuse --- src/Simplex/Chat/Library/Internal.hs | 29 +++++++++++++------------- src/Simplex/Chat/Library/Subscriber.hs | 2 +- src/Simplex/Chat/Store/Groups.hs | 10 ++++----- 3 files changed, 21 insertions(+), 20 deletions(-) diff --git a/src/Simplex/Chat/Library/Internal.hs b/src/Simplex/Chat/Library/Internal.hs index fdaf0d058c..d26ee230b3 100644 --- a/src/Simplex/Chat/Library/Internal.hs +++ b/src/Simplex/Chat/Library/Internal.hs @@ -2507,22 +2507,23 @@ sendGroupProfileUpdate user gInfo scope asGroup members recordKeyStatus gsr recordKeyStatus GroupSndResult {sentTo, pending, forwarded, failed} = withStore' $ \db -> do - unless (null sentIds) $ setMembersKeyStatus db KSSent sentIds - unless (null failedIds) $ setMembersKeyStatus db KSFailed failedIds + setMembersKeyStatus db KSSent $ deliveredIds <> keyMemIds forwarded + setMembersKeyStatus db KSFailed $ keyMemIds failed unless (null retriableIds) $ incMembersKeyAttempts db retriableIds - forM_ terminal $ \(m, e) -> setMembersKeyStatus db (KSError $ tshow e) [groupMemberId' m] + forM_ finalErrs $ \(mId, e) -> setMemberKeyStatus db (KSError $ tshow e) mId where - keyIdsOf = map groupMemberId' . filter memberNeedsKey - sentIds = keyIdsOf $ delivered <> forwarded - failedIds = keyIdsOf failed - retriableIds = map (groupMemberId' . fst) retriable - (terminal, retriable) = partition (terminalKeySend . snd) $ filter (memberNeedsKey . fst) errored - (delivered, errored) = foldr part (foldr part ([], []) pending) sentTo - part :: (GroupMember, a, Either ChatError b) -> ([GroupMember], [(GroupMember, ChatError)]) -> ([GroupMember], [(GroupMember, ChatError)]) - part (m, _, r) (d, e) = case r of - Right _ -> (m : d, e) - Left err -> (d, (m, err) : e) - terminalKeySend = \case + 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)]) + addResult (m, _, r) acc@(delivered, retriable, final) + | memberNeedsKey m = case r of + Right _ -> (groupMemberId' m : delivered, retriable, final) + Left e + | finalError e -> (delivered, retriable, (groupMemberId' m, e) : final) + | otherwise -> (delivered, groupMemberId' m : retriable, final) + | otherwise = acc + finalError = \case ChatErrorAgent {agentError} -> case agentError of CONN SIMPLEX _ -> True CONN NOT_FOUND _ -> True diff --git a/src/Simplex/Chat/Library/Subscriber.hs b/src/Simplex/Chat/Library/Subscriber.hs index 596b25ce08..508efc9eb5 100644 --- a/src/Simplex/Chat/Library/Subscriber.hs +++ b/src/Simplex/Chat/Library/Subscriber.hs @@ -932,7 +932,7 @@ processAgentMessageConn cxt user@User {userId} corrId agentConnId agentMessage = let incognitoProfile = ExistingIncognito <$> incognitoMembershipProfile gInfo'' profileToSend <- presentUserBadge user incognitoProfile $ userProfileInGroup user gInfo'' (fromIncognitoProfile <$> incognitoProfile) sendGroupMemberMessages user gInfo'' conn [XGrpLinkMem profileToSend (groupMemberKey gInfo'')] - when (m' `supportsVersion` groupMemberKeyVersion) $ withStore' (`setMemberKeySent` groupMemberId' m') + when (m' `supportsVersion` groupMemberKeyVersion) $ withStore' $ \db -> setMemberKeyStatus db KSSent $ groupMemberId' m' _ -> do unless (memberPending m) $ withStore' $ \db -> updateGroupMemberStatus db userId m GSMemConnected notifyMemberConnected gInfo m Nothing diff --git a/src/Simplex/Chat/Store/Groups.hs b/src/Simplex/Chat/Store/Groups.hs index c73604959b..be31729d1e 100644 --- a/src/Simplex/Chat/Store/Groups.hs +++ b/src/Simplex/Chat/Store/Groups.hs @@ -108,7 +108,7 @@ module Simplex.Chat.Store.Groups setGroupMemberKeyRole, setUserMemberKey, setMemberPubKey, - setMemberKeySent, + setMemberKeyStatus, setMembersKeyStatus, incMembersKeyAttempts, setGroupMemberVerified, @@ -1700,13 +1700,13 @@ setMemberPubKey db groupMemberId pubKey = do currentTs <- getCurrentTime DB.execute db "UPDATE group_members SET member_pub_key = ?, updated_at = ? WHERE group_member_id = ?" (pubKey, currentTs, groupMemberId) -setMemberKeySent :: DB.Connection -> GroupMemberId -> IO () -setMemberKeySent db groupMemberId = do +setMemberKeyStatus :: DB.Connection -> KeySendStatus -> GroupMemberId -> IO () +setMemberKeyStatus db status groupMemberId = do currentTs <- getCurrentTime - DB.execute db "UPDATE group_members SET user_member_key_status = ?, updated_at = ? WHERE group_member_id = ?" (keySendStatusText KSSent, currentTs, groupMemberId) + DB.execute db "UPDATE group_members SET user_member_key_status = ?, updated_at = ? WHERE group_member_id = ?" (keySendStatusText status, currentTs, groupMemberId) setMembersKeyStatus :: DB.Connection -> KeySendStatus -> [GroupMemberId] -> IO () -setMembersKeyStatus db status memberIds = do +setMembersKeyStatus db status memberIds = unless (null memberIds) $ do currentTs <- getCurrentTime #if defined(dbPostgres) DB.execute