dandri/simplex-chat
1
0
Fork 0
mirror of https://github.com/simplex-chat/simplex-chat.git synced 2026-03-30 14:15:55 +00:00
Code Issues Packages Projects Releases Wiki Activity

core: correctly communicate group acceptance state (#5852)

Browse Source
This commit is contained in:
spaced4ndy
2025-04-28 06:28:40 +00:00
committed by GitHub
parent 82be7d00fd
commit 60bfd9933a
11 changed files with 53 additions and 53 deletions
Download Patch File Download Diff File Expand all files Collapse all files

2
apps/simplex-directory-service/src/Directory/Service.hs
View File

@@ -167,7 +167,7 @@ acceptMemberHook
when (useMemberFilter img $ rejectNames a) checkName
pure $
if
| useMemberFilter img (passCaptcha a) -> (GAPending, GRMember)
| useMemberFilter img (passCaptcha a) -> (GAPendingApproval, GRMember)
| useMemberFilter img (makeObserver a) -> (GAAccepted, GRObserver)
| otherwise -> (GAAccepted, memberRole)
where

4
src/Simplex/Chat/Library/Commands.hs
View File

@@ -2062,7 +2062,7 @@ processChatCommand' vr = \case
let m' = m {memberStatus = GSMemPendingReview}
pure $ CRMemberAccepted user gInfo m'
Nothing -> do
let msg = XGrpLinkAcpt role (memberId' m)
let msg = XGrpLinkAcpt GAAccepted role (memberId' m)
void $ sendDirectMemberMessage mConn msg groupId
introduceToRemaining vr user gInfo m {memberRole = role}
when (groupFeatureAllowed SGFHistory gInfo) $ sendHistory user gInfo m
@@ -2073,7 +2073,7 @@ processChatCommand' vr = \case
let scope = Just $ GCSMemberSupport $ Just (groupMemberId' m)
modMs <- withFastStore' $ \db -> getGroupModerators db vr user gInfo
let rcpModMs' = filter memberCurrent modMs
msg = XGrpLinkAcpt role (memberId' m)
msg = XGrpLinkAcpt GAAccepted role (memberId' m)
void $ sendGroupMessage user gInfo scope ([m] <> rcpModMs') msg
m' <- withFastStore' $ \db -> updateGroupMemberAccepted db user m newMemberStatus role
pure $ CRMemberAccepted user gInfo m'

15
src/Simplex/Chat/Library/Internal.hs
View File

@@ -967,17 +967,16 @@ profileToSendOnAccept user ip = userProfileToSend user (getIncognitoProfile <$>
ExistingIncognito lp -> fromLocalProfile lp
introduceToModerators :: VersionRangeChat -> User -> GroupInfo -> GroupMember -> CM ()
introduceToModerators vr user gInfo@GroupInfo {groupId} m = do
when (maxVersion (memberChatVRange m) < groupKnockingVersion) $ sendPendingReviewMessage
introduceToModerators vr user gInfo@GroupInfo {groupId} m@GroupMember {memberRole, memberId} = do
forM_ (memberConn m) $ \mConn -> do
let msg =
if (maxVersion (memberChatVRange m) >= groupKnockingVersion)
then XGrpLinkAcpt GAPendingReview memberRole memberId
else XMsgNew $ MCSimple $ extMsgContent (MCText pendingReviewMessage) Nothing
void $ sendDirectMemberMessage mConn msg groupId
modMs <- withStore' $ \db -> getGroupModerators db vr user gInfo
let rcpModMs = filter memberCurrent modMs
introduceMember vr user gInfo m rcpModMs (Just $ MSMember $ memberId' m)
where
sendPendingReviewMessage = case memberConn m of
Just conn -> do
let event = XMsgNew $ MCSimple $ extMsgContent (MCText pendingReviewMessage) Nothing
sendGroupMemberMessages user conn [event] groupId
Nothing -> pure ()
introduceToAll :: VersionRangeChat -> User -> GroupInfo -> GroupMember -> CM ()
introduceToAll vr user gInfo m = do

41
src/Simplex/Chat/Library/Subscriber.hs
View File

@@ -872,7 +872,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
XFileAcptInv sharedMsgId fileConnReq_ fName -> xFileAcptInvGroup gInfo' m'' sharedMsgId fileConnReq_ fName
XInfo p -> xInfoMember gInfo' m'' p brokerTs
XGrpLinkMem p -> xGrpLinkMem gInfo' m'' conn' p
XGrpLinkAcpt role memberId -> xGrpLinkAcpt gInfo' m'' role memberId msg brokerTs
XGrpLinkAcpt acceptance role memberId -> xGrpLinkAcpt gInfo' m'' acceptance role memberId msg brokerTs
XGrpMemNew memInfo msgScope -> xGrpMemNew gInfo' m'' memInfo msgScope msg brokerTs
XGrpMemIntro memInfo memRestrictions_ -> xGrpMemIntro gInfo' m'' memInfo memRestrictions_
XGrpMemInv memId introInv -> xGrpMemInv gInfo' m'' memId introInv
@@ -2083,8 +2083,8 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
probeMatchingMemberContact m' connectedIncognito
else messageError "x.grp.link.mem error: invalid group link host profile update"
xGrpLinkAcpt :: GroupInfo -> GroupMember -> GroupMemberRole -> MemberId -> RcvMessage -> UTCTime -> CM ()
xGrpLinkAcpt gInfo@GroupInfo {membership} m role memberId msg brokerTs
xGrpLinkAcpt :: GroupInfo -> GroupMember -> GroupAcceptance -> GroupMemberRole -> MemberId -> RcvMessage -> UTCTime -> CM ()
xGrpLinkAcpt gInfo@GroupInfo {membership} m acceptance role memberId msg brokerTs
| sameMemberId memberId membership = processUserAccepted
| otherwise =
withStore' (\db -> runExceptT $ getGroupMemberByMemberId db vr user gInfo memberId) >>= \case
@@ -2102,16 +2102,24 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
Just c | connReady c -> GSMemConnected
_ -> GSMemAnnounced
where
processUserAccepted = do
membership' <- withStore' $ \db -> updateGroupMemberAccepted db user membership GSMemConnected role
let scopeInfo = Just $ GCSIMemberSupport {groupMember_ = Nothing}
ci <- saveRcvChatItemNoParse user (CDGroupRcv gInfo scopeInfo m) msg brokerTs (CIRcvGroupEvent RGEUserAccepted)
groupMsgToView gInfo scopeInfo ci
toView $ CRUserJoinedGroup user gInfo {membership = membership'} m
let cd = CDGroupRcv gInfo Nothing m
createInternalChatItem user cd (CIRcvGroupE2EEInfo E2EInfo {pqEnabled = PQEncOff}) Nothing
createGroupFeatureItems user cd CIRcvGroupFeature gInfo
maybeCreateGroupDescrLocal gInfo m
processUserAccepted = case acceptance of
GAAccepted -> do
membership' <- withStore' $ \db -> updateGroupMemberAccepted db user membership GSMemConnected role
let scopeInfo = Just $ GCSIMemberSupport {groupMember_ = Nothing}
ci <- saveRcvChatItemNoParse user (CDGroupRcv gInfo scopeInfo m) msg brokerTs (CIRcvGroupEvent RGEUserAccepted)
groupMsgToView gInfo scopeInfo ci
toView $ CRUserJoinedGroup user gInfo {membership = membership'} m
let cd = CDGroupRcv gInfo Nothing m
createInternalChatItem user cd (CIRcvGroupE2EEInfo E2EInfo {pqEnabled = PQEncOff}) Nothing
createGroupFeatureItems user cd CIRcvGroupFeature gInfo
maybeCreateGroupDescrLocal gInfo m
GAPendingReview -> do
membership' <- withStore' $ \db -> updateGroupMemberAccepted db user membership GSMemPendingReview role
let scopeInfo = Just $ GCSIMemberSupport {groupMember_ = Nothing}
createInternalChatItem user (CDGroupSnd gInfo scopeInfo) (CISndGroupEvent SGEUserPendingReview) Nothing
toView $ CRMemberAcceptedByOther user gInfo m membership'
GAPendingApproval ->
messageWarning "x.grp.link.acpt: unexpected group acceptance - pending approval"
introduceToRemainingMembers acceptedMember = do
introduceToRemaining vr user gInfo acceptedMember
when (groupFeatureAllowed SGFHistory gInfo) $ sendHistory user gInfo acceptedMember
@@ -2467,7 +2475,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
pure (announcedMember', Just scopeInfo)
xGrpMemIntro :: GroupInfo -> GroupMember -> MemberInfo -> Maybe MemberRestrictions -> CM ()
xGrpMemIntro gInfo@GroupInfo {membership, chatSettings} m@GroupMember {memberRole, localDisplayName = c} memInfo@(MemberInfo memId _ memChatVRange _) memRestrictions = do
xGrpMemIntro gInfo@GroupInfo {chatSettings} m@GroupMember {memberRole, localDisplayName = c} memInfo@(MemberInfo memId _ memChatVRange _) memRestrictions = do
case memberCategory m of
GCHostMember ->
withStore' (\db -> runExceptT $ getGroupMemberByMemberId db vr user gInfo memId) >>= \case
@@ -2478,11 +2486,6 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
Nothing -> messageError "x.grp.mem.intro: member chat version range incompatible"
Just (ChatVersionRange mcvr)
| maxVersion mcvr >= groupDirectInvVersion -> do
memCount <- withStore' $ \db -> getGroupMembersCount db user gInfo
-- only create SGEUserPendingReview item on the first introduction - when only 2 members are user and host
when (memberPending membership && memCount == 2) $ do
(gInfo', m', scopeInfo) <- mkGroupChatScope gInfo m
createInternalChatItem user (CDGroupSnd gInfo' scopeInfo) (CISndGroupEvent SGEUserPendingReview) Nothing
subMode <- chatReadVar subscriptionMode
-- [async agent commands] commands should be asynchronous, continuation is to send XGrpMemInv - have to remember one has completed and process on second
groupConnIds <- createConn subMode

6
src/Simplex/Chat/Protocol.hs
View File

@@ -346,7 +346,7 @@ data ChatMsgEvent (e :: MsgEncoding) where
XGrpLinkInv :: GroupLinkInvitation -> ChatMsgEvent 'Json
XGrpLinkReject :: GroupLinkRejection -> ChatMsgEvent 'Json
XGrpLinkMem :: Profile -> ChatMsgEvent 'Json
XGrpLinkAcpt :: GroupMemberRole -> MemberId -> ChatMsgEvent 'Json
XGrpLinkAcpt :: GroupAcceptance -> GroupMemberRole -> MemberId -> ChatMsgEvent 'Json
XGrpMemNew :: MemberInfo -> Maybe MsgScope -> ChatMsgEvent 'Json
XGrpMemIntro :: MemberInfo -> Maybe MemberRestrictions -> ChatMsgEvent 'Json
XGrpMemInv :: MemberId -> IntroInvitation -> ChatMsgEvent 'Json
@@ -1099,7 +1099,7 @@ appJsonToCM AppMessageJson {v, msgId, event, params} = do
XGrpLinkInv_ -> XGrpLinkInv <$> p "groupLinkInvitation"
XGrpLinkReject_ -> XGrpLinkReject <$> p "groupLinkRejection"
XGrpLinkMem_ -> XGrpLinkMem <$> p "profile"
XGrpLinkAcpt_ -> XGrpLinkAcpt <$> p "role" <*> p "memberId"
XGrpLinkAcpt_ -> XGrpLinkAcpt <$> p "acceptance" <*> p "role" <*> p "memberId"
XGrpMemNew_ -> XGrpMemNew <$> p "memberInfo" <*> opt "scope"
XGrpMemIntro_ -> XGrpMemIntro <$> p "memberInfo" <*> opt "memberRestrictions"
XGrpMemInv_ -> XGrpMemInv <$> p "memberId" <*> p "memberIntro"
@@ -1163,7 +1163,7 @@ chatToAppMessage ChatMessage {chatVRange, msgId, chatMsgEvent} = case encoding @
XGrpLinkInv groupLinkInv -> o ["groupLinkInvitation" .= groupLinkInv]
XGrpLinkReject groupLinkRjct -> o ["groupLinkRejection" .= groupLinkRjct]
XGrpLinkMem profile -> o ["profile" .= profile]
XGrpLinkAcpt role memberId -> o ["role" .= role, "memberId" .= memberId]
XGrpLinkAcpt acceptance role memberId -> o ["acceptance" .= acceptance, "role" .= role, "memberId" .= memberId]
XGrpMemNew memInfo scope -> o $ ("scope" .=? scope) ["memberInfo" .= memInfo]
XGrpMemIntro memInfo memRestrictions -> o $ ("memberRestrictions" .=? memRestrictions) ["memberInfo" .= memInfo]
XGrpMemInv memId memIntro -> o ["memberId" .= memId, "memberIntro" .= memIntro]

6
src/Simplex/Chat/Store/Groups.hs
View File

@@ -56,7 +56,6 @@ module Simplex.Chat.Store.Groups
getGroupMembers,
getGroupModerators,
getGroupMembersForExpiration,
getGroupMembersCount,
getGroupCurrentMembersCount,
deleteGroupChatItems,
deleteGroupMembers,
@@ -945,11 +944,6 @@ toContactMember :: VersionRangeChat -> User -> (GroupMemberRow :. MaybeConnectio
toContactMember vr User {userContactId} (memberRow :. connRow) =
(toGroupMember userContactId memberRow) {activeConn = toMaybeConnection vr connRow}
getGroupMembersCount :: DB.Connection -> User -> GroupInfo -> IO Int
getGroupMembersCount db User {userId} GroupInfo {groupId} =
fromOnly . head
<$> DB.query db "SELECT COUNT(1) FROM group_members WHERE group_id = ? AND user_id = ?" (groupId, userId)
getGroupCurrentMembersCount :: DB.Connection -> User -> GroupInfo -> IO Int
getGroupCurrentMembersCount db User {userId} GroupInfo {groupId} = do
statuses :: [GroupMemberStatus] <-

4
src/Simplex/Chat/Store/SQLite/Migrations/chat_query_plans.txt
View File

@@ -5650,10 +5650,6 @@ Query: SELECT COUNT(1) FROM contacts WHERE user_id = ? AND chat_item_ttl > 0
Plan:
SEARCH contacts USING INDEX idx_contacts_chat_ts (user_id=?)
Query: SELECT COUNT(1) FROM group_members WHERE group_id = ? AND user_id = ?
Plan:
SEARCH group_members USING COVERING INDEX idx_group_members_group_id (user_id=? AND group_id=?)
Query: SELECT COUNT(1) FROM groups WHERE user_id = ? AND chat_item_ttl > 0
Plan:
SEARCH groups USING INDEX idx_groups_chat_ts (user_id=?)

3
src/Simplex/Chat/Types.hs
View File

@@ -1050,7 +1050,8 @@ instance ToJSON GroupMemberStatus where
acceptanceToStatus :: Maybe GroupMemberAdmission -> GroupAcceptance -> GroupMemberStatus
acceptanceToStatus memberAdmission groupAcceptance
| groupAcceptance == GAPending = GSMemPendingApproval
| groupAcceptance == GAPendingApproval = GSMemPendingApproval
| groupAcceptance == GAPendingReview = GSMemPendingReview
| (memberAdmission >>= review) == Just MCAll = GSMemPendingReview
| otherwise = GSMemAccepted

8
src/Simplex/Chat/Types/Shared.hs
View File

@@ -49,15 +49,17 @@ instance ToJSON GroupMemberRole where
toJSON = strToJSON
toEncoding = strToJEncoding
data GroupAcceptance = GAAccepted | GAPending deriving (Eq, Show)
data GroupAcceptance = GAAccepted | GAPendingApproval | GAPendingReview deriving (Eq, Show)
instance StrEncoding GroupAcceptance where
strEncode = \case
GAAccepted -> "accepted"
GAPending -> "pending"
GAPendingApproval -> "pending"
GAPendingReview -> "pending_review"
strDecode = \case
"accepted" -> Right GAAccepted
"pending" -> Right GAPending
"pending" -> Right GAPendingApproval
"pending_review" -> Right GAPendingReview
r -> Left $ "bad GroupAcceptance " <> B.unpack r
strP = strDecode <$?> A.takeByteString

5
src/Simplex/Chat/View.hs
View File

@@ -1121,7 +1121,10 @@ viewMemberAccepted g m@GroupMember {memberStatus} = case memberStatus of
_ -> [ttyGroup' g <> ": " <> ttyMember m <> " accepted"]
viewMemberAcceptedByOther :: GroupInfo -> GroupMember -> GroupMember -> [StyledString]
viewMemberAcceptedByOther g acceptingMember m@GroupMember {memberCategory} = case memberCategory of
viewMemberAcceptedByOther g acceptingMember m@GroupMember {memberCategory, memberStatus} = case memberCategory of
GCUserMember -> case memberStatus of
GSMemPendingReview -> [ttyGroup' g <> ": " <> ttyMember acceptingMember <> " accepted you to the group, pending review"]
_ -> [ttyGroup' g <> ": " <> ttyMember acceptingMember <> " accepted you to the group [warning - unexpected]"]
GCInviteeMember -> [ttyGroup' g <> ": " <> ttyMember acceptingMember <> " accepted " <> ttyMember m <> " to the group (will introduce remaining members)"]
_ -> [ttyGroup' g <> ": " <> ttyMember acceptingMember <> " accepted " <> ttyMember m <> " to the group"]

12
tests/ChatTests/Groups.hs
View File

@@ -3032,7 +3032,7 @@ testGLinkApproveMember =
cath #> "#team hi group"
[alice, bob] *<# "#team cath> hi group"
where
cfg = testCfg {chatHooks = defaultChatHooks {acceptMember = Just (\_ _ _ -> pure $ Right (GAPending, GRObserver))}}
cfg = testCfg {chatHooks = defaultChatHooks {acceptMember = Just (\_ _ _ -> pure $ Right (GAPendingApproval, GRObserver))}}
testGLinkReviewMember :: HasCallStack => TestParams -> IO ()
testGLinkReviewMember =
@@ -3062,7 +3062,8 @@ testGLinkReviewMember =
concurrentlyN_
[ alice <## "#team: eve connected and pending review",
eve
<### [ "#team: joining the group...",
<### [ "#team: alice accepted you to the group, pending review",
"#team: joining the group...",
"#team: you joined the group, connecting to group moderators for admission to group",
"#team: member cath (Catherine) is connected",
"#team: member dan (Daniel) is connected"
@@ -3219,7 +3220,8 @@ testGLinkApproveThenReviewMember =
concurrentlyN_
[ alice <## "#team: eve accepted and pending review (will introduce moderators)",
eve
<### [ "#team: member cath (Catherine) is connected",
<### [ "#team: alice accepted you to the group, pending review",
"#team: member cath (Catherine) is connected",
"#team: member dan (Daniel) is connected"
],
do
@@ -3309,7 +3311,7 @@ testGLinkApproveThenReviewMember =
eve #> "#team 19"
[alice, bob, cath, dan] *<# "#team eve> 19"
where
cfg = testCfg {chatHooks = defaultChatHooks {acceptMember = Just (\_ _ _ -> pure $ Right (GAPending, GRObserver))}}
cfg = testCfg {chatHooks = defaultChatHooks {acceptMember = Just (\_ _ _ -> pure $ Right (GAPendingApproval, GRObserver))}}
testGLinkDeletePendingApprovalMember :: HasCallStack => TestParams -> IO ()
testGLinkDeletePendingApprovalMember =
@@ -3334,7 +3336,7 @@ testGLinkDeletePendingApprovalMember =
cath <## "#team: alice removed you from the group"
cath <## "use /d #team to delete the group"
where
cfg = testCfg {chatHooks = defaultChatHooks {acceptMember = Just (\_ _ _ -> pure $ Right (GAPending, GRObserver))}}
cfg = testCfg {chatHooks = defaultChatHooks {acceptMember = Just (\_ _ _ -> pure $ Right (GAPendingApproval, GRObserver))}}
testPlanGroupLinkKnown :: HasCallStack => TestParams -> IO ()
testPlanGroupLinkKnown =