diff --git a/src/Simplex/Chat/Library/Commands.hs b/src/Simplex/Chat/Library/Commands.hs index 123a7e9cf9..3db4802aff 100644 --- a/src/Simplex/Chat/Library/Commands.hs +++ b/src/Simplex/Chat/Library/Commands.hs @@ -3815,6 +3815,7 @@ chatCommandP = "/_ntf conn messages " *> (ApiGetConnNtfMessages <$> strP), "/_add #" *> (APIAddMember <$> A.decimal <* A.space <*> A.decimal <*> memberRole), "/_join #" *> (APIJoinGroup <$> A.decimal <*> pure MFAll), -- needs to be changed to support in UI + "/_accept member #" *> (APIAcceptMember <$> A.decimal <* A.space <*> A.decimal <*> memberRole), "/_member role #" *> (APIMemberRole <$> A.decimal <* A.space <*> A.decimal <*> memberRole), "/_block #" *> (APIBlockMemberForAll <$> A.decimal <* A.space <*> A.decimal <* A.space <* "blocked=" <*> onOffP), "/_remove #" *> (APIRemoveMember <$> A.decimal <* A.space <*> A.decimal), diff --git a/src/Simplex/Chat/Library/Internal.hs b/src/Simplex/Chat/Library/Internal.hs index 83a1978913..b63f30d5a0 100644 --- a/src/Simplex/Chat/Library/Internal.hs +++ b/src/Simplex/Chat/Library/Internal.hs @@ -820,17 +820,19 @@ acceptContactRequestAsync user cReq@UserContactRequest {agentInvitationId = Agen setCommandConnId db user cmdId connId pure ct -acceptGroupJoinRequestAsync :: User -> GroupInfo -> UserContactRequest -> GroupMemberRole -> Maybe IncognitoProfile -> CM GroupMember +acceptGroupJoinRequestAsync :: User -> GroupInfo -> UserContactRequest -> GroupAcceptance -> GroupMemberRole -> Maybe IncognitoProfile -> CM GroupMember acceptGroupJoinRequestAsync user gInfo@GroupInfo {groupProfile, membership, businessChat} ucr@UserContactRequest {agentInvitationId = AgentInvId invId, cReqChatVRange} + gAcceptance gLinkMemRole incognitoProfile = do gVar <- asks random + let initialStatus = acceptanceToStatus gAcceptance (groupMemberId, memberId) <- withStore $ \db -> do liftIO $ deleteContactRequestRec db user ucr - createJoiningMember db gVar user gInfo ucr gLinkMemRole GSMemAccepted + createJoiningMember db gVar user gInfo ucr gLinkMemRole initialStatus currentMemCount <- withStore' $ \db -> getGroupCurrentMembersCount db user gInfo let Profile {displayName} = profileToSendOnAccept user incognitoProfile True GroupMember {memberRole = userRole, memberId = userMemberId} = membership @@ -841,7 +843,7 @@ acceptGroupJoinRequestAsync fromMemberName = displayName, invitedMember = MemberIdRole memberId gLinkMemRole, groupProfile, - acceptance = Nothing, -- TODO [knocking] + acceptance = Just gAcceptance, business = businessChat, groupSize = Just currentMemCount } @@ -901,7 +903,7 @@ acceptBusinessJoinRequestAsync fromMemberName = displayName, invitedMember = MemberIdRole memberId GRMember, groupProfile = businessGroupProfile userProfile groupPreferences, - acceptance = Nothing, -- TODO [knocking] + acceptance = Just GAAuto, -- This refers to the "title member" that defines the group name and profile. -- This coincides with fromMember to be current user when accepting the connecting user, -- but it will be different when inviting somebody else. diff --git a/src/Simplex/Chat/Library/Subscriber.hs b/src/Simplex/Chat/Library/Subscriber.hs index efcadeaf13..38daba4ffb 100644 --- a/src/Simplex/Chat/Library/Subscriber.hs +++ b/src/Simplex/Chat/Library/Subscriber.hs @@ -594,13 +594,14 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = ucl <- withStore $ \db -> getUserContactLinkById db userId userContactLinkId let (UserContactLink {autoAccept}, gli_) = ucl when (connChatVersion < batchSend2Version) $ sendAutoReply ct' autoAccept - -- -- TODO [knocking] legacy branch - do nothing? - -- forM_ gli_ $ \GroupLinkInfo {groupId, memberRole = gLinkMemRole, acceptance = _acceptance} -> do - -- groupInfo <- withStore $ \db -> getGroupInfo db vr user groupId - -- subMode <- chatReadVar subscriptionMode - -- groupConnIds <- createAgentConnectionAsync user CFCreateConnGrpInv True SCMInvitation subMode - -- gVar <- asks random - -- withStore $ \db -> createNewContactMemberAsync db gVar user groupInfo ct' gLinkMemRole groupConnIds connChatVersion peerChatVRange subMode + -- TODO REMOVE LEGACY vvv + forM_ gli_ $ \GroupLinkInfo {groupId, memberRole = gLinkMemRole, acceptance = _acceptance} -> do + groupInfo <- withStore $ \db -> getGroupInfo db vr user groupId + subMode <- chatReadVar subscriptionMode + groupConnIds <- createAgentConnectionAsync user CFCreateConnGrpInv True SCMInvitation subMode + gVar <- asks random + withStore $ \db -> createNewContactMemberAsync db gVar user groupInfo ct' gLinkMemRole groupConnIds connChatVersion peerChatVRange subMode + -- TODO REMOVE LEGACY ^^^ Just (gInfo, m@GroupMember {activeConn}) -> when (maybe False ((== ConnReady) . connStatus) activeConn) $ do notifyMemberConnected gInfo m $ Just ct @@ -704,6 +705,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = liftIO $ setConnConnReqInv db user connId cReq getHostConnId db user groupId sendXGrpMemInv hostConnId Nothing XGrpMemIntroCont {groupId, groupMemberId, memberId, groupConnReq} + -- TODO REMOVE LEGACY vvv -- [async agent commands] group link auto-accept continuation on receiving INV CFCreateConnGrpInv -> do ct <- withStore $ \db -> getContactViaMember db vr user m @@ -729,6 +731,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = (_msg, _) <- sendDirectContactMessage user ct $ XGrpInv groupInv -- we could link chat item with sent group invitation message (_msg) createInternalChatItem user (CDGroupRcv gInfo m) (CIRcvGroupEvent RGEInvitedViaGroupLink) Nothing + -- TODO REMOVE LEGACY ^^^ _ -> throwChatError $ CECommandError "unexpected cmdFunction" CRContactUri _ -> throwChatError $ CECommandError "unexpected ConnectionRequestUri type" CONF confId _pqSupport _ connInfo -> do @@ -766,7 +769,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = | otherwise -> messageError "x.grp.mem.info: memberId is different from expected" -- sent when connecting via group link XInfo _ -> - -- TODO [group rejection] Keep rejected member record and connection for ability to start dialogue. + -- TODO Keep rejected member to allow them to appeal against rejection. when (memberStatus m == GSMemRejected) $ do deleteMemberConnection' user m True withStore' $ \db -> deleteGroupMember db user m @@ -774,17 +777,20 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = _ -> messageError "INFO from member must have x.grp.mem.info, x.info or x.ok" pure () CON _pqEnc -> unless (memberStatus m == GSMemRejected) $ do - withStore' $ \db -> do - updateGroupMemberStatus db userId m GSMemConnected - unless (memberActive membership) $ - updateGroupMemberStatus db userId membership GSMemConnected - -- possible improvement: check for each pending message, requires keeping track of connection state - unless (connDisabled conn) $ sendPendingGroupMessages user m conn + status' <- case memberStatus m of + GSMemPendingApproval -> pure GSMemPendingApproval + _ -> do + withStore' $ \db -> do + updateGroupMemberStatus db userId m GSMemConnected + unless (memberActive membership) $ + updateGroupMemberStatus db userId membership GSMemConnected + -- possible improvement: check for each pending message, requires keeping track of connection state + unless (connDisabled conn) $ sendPendingGroupMessages user m conn + pure GSMemConnected withAgent $ \a -> toggleConnectionNtfs a (aConnId conn) $ chatHasNtfs chatSettings case memberCategory m of GCHostMember -> do - -- TODO [knocking] here it will communicate whether user is approved as member as status of membership - toView $ CRUserJoinedGroup user gInfo {membership = membership {memberStatus = GSMemConnected}} m {memberStatus = GSMemConnected} + toView $ CRUserJoinedGroup user gInfo {membership = membership {memberStatus = status'}} m {memberStatus = status'} let cd = CDGroupRcv gInfo m createInternalChatItem user cd (CIRcvGroupE2EEInfo E2EInfo {pqEnabled = PQEncOff}) Nothing createGroupFeatureItems user cd CIRcvGroupFeature gInfo @@ -795,16 +801,17 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = expectHistory = groupFeatureAllowed SGFHistory gInfo && m `supportsVersion` groupHistoryIncludeWelcomeVersion GCInviteeMember -> do memberConnectedChatItem gInfo m - -- TODO [knocking] here it will communicate whether member needs to be approved as member status - toView $ CRJoinedGroupMember user gInfo m {memberStatus = GSMemConnected} + toView $ CRJoinedGroupMember user gInfo m {memberStatus = status'} let Connection {viaUserContactLink} = conn when (isJust viaUserContactLink && isNothing (memberContactId m)) sendXGrpLinkMem - members <- withStore' $ \db -> getGroupMembers db vr user gInfo - void . sendGroupMessage user gInfo members . XGrpMemNew $ memberInfo m - sendIntroductions members - when (groupFeatureAllowed SGFHistory gInfo) sendHistory when (connChatVersion < batchSend2Version) sendGroupAutoReply + unless (status' == GSMemPendingApproval) introduceToGroup where + introduceToGroup = do + members <- withStore' $ \db -> getGroupMembers db vr user gInfo + void . sendGroupMessage user gInfo members . XGrpMemNew $ memberInfo m + sendIntroductions members + when (groupFeatureAllowed SGFHistory gInfo) sendHistory sendXGrpLinkMem = do let profileMode = ExistingIncognito <$> incognitoMembershipProfile gInfo profileToSend = profileToSendOnAccept user profileMode True @@ -1331,7 +1338,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = messageError "processUserContactRequest: chat version range incompatible for accepting group join request" | otherwise -> do let profileMode = ExistingIncognito <$> incognitoMembershipProfile gInfo - mem <- acceptGroupJoinRequestAsync user gInfo cReq useRole profileMode + mem <- acceptGroupJoinRequestAsync user gInfo cReq acceptance useRole profileMode createInternalChatItem user (CDGroupRcv gInfo mem) (CIRcvGroupEvent RGEInvitedViaGroupLink) Nothing toView $ CRAcceptingGroupJoinRequestMember user gInfo mem Left rjctReason @@ -1341,19 +1348,19 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = mem <- acceptGroupJoinSendRejectAsync user gInfo cReq rjctReason toViewTE $ TERejectingGroupJoinRequestMember user gInfo mem rjctReason _ -> toView $ CRReceivedContactRequest user cReq - -- TODO [knocking] move logic to bot - -- where - -- rejectionReason ChatConfig {profileNameLimit, allowedProfileName} - -- | T.length displayName > profileNameLimit = Just GRRLongName - -- | maybe False (\f -> not $ f displayName) allowedProfileName = Just GRRBlockedName - -- | otherwise = Nothing - -- userMemberRole linkRole = \case - -- Just AOAll -> GRObserver - -- Just AONameOnly | noImage -> GRObserver - -- Just AOIncognito | noImage && isRandomName displayName -> GRObserver - -- _ -> linkRole - -- where - -- noImage = maybe True (\(ImageData i) -> i == "") image + -- TODO [knocking] move logic to bot + -- where + -- rejectionReason ChatConfig {profileNameLimit, allowedProfileName} + -- | T.length displayName > profileNameLimit = Just GRRLongName + -- | maybe False (\f -> not $ f displayName) allowedProfileName = Just GRRBlockedName + -- | otherwise = Nothing + -- userMemberRole linkRole = \case + -- Just AOAll -> GRObserver + -- Just AONameOnly | noImage -> GRObserver + -- Just AOIncognito | noImage && isRandomName displayName -> GRObserver + -- _ -> linkRole + -- where + -- noImage = maybe True (\(ImageData i) -> i == "") image memberCanSend :: GroupMember -> CM () -> CM () memberCanSend GroupMember {memberRole} a @@ -2176,16 +2183,22 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = xInfoMember gInfo m p' brokerTs = void $ processMemberProfileUpdate gInfo m p' True (Just brokerTs) xGrpLinkMem :: GroupInfo -> GroupMember -> Connection -> Profile -> CM () - xGrpLinkMem gInfo@GroupInfo {membership, businessChat} m@GroupMember {groupMemberId, memberCategory} Connection {viaGroupLink} p' = do + xGrpLinkMem gInfo@GroupInfo {membership, businessChat} m@GroupMember {groupMemberId, memberCategory, memberStatus} Connection {viaGroupLink} p' = do xGrpLinkMemReceived <- withStore $ \db -> getXGrpLinkMemReceived db groupMemberId if (viaGroupLink || isJust businessChat) && isNothing (memberContactId m) && memberCategory == GCHostMember && not xGrpLinkMemReceived then do m' <- processMemberProfileUpdate gInfo m p' False Nothing withStore' $ \db -> setXGrpLinkMemReceived db groupMemberId True - let connectedIncognito = memberIncognito membership - probeMatchingMemberContact m' connectedIncognito + unless (memberStatus == GSMemPendingApproval) $ do + let connectedIncognito = memberIncognito membership + probeMatchingMemberContact m' connectedIncognito else messageError "x.grp.link.mem error: invalid group link host profile update" + -- TODO [knocking] + -- xGrpLinkAcpt + -- set statuses to GSMemConnected + -- probeMatchingMemberContact + processMemberProfileUpdate :: GroupInfo -> GroupMember -> Profile -> Bool -> Maybe UTCTime -> CM GroupMember processMemberProfileUpdate gInfo m@GroupMember {memberProfile = p, memberContactId} p' createItems itemTs_ | redactedMemberProfile (fromLocalProfile p) /= redactedMemberProfile p' = do diff --git a/src/Simplex/Chat/Store/Groups.hs b/src/Simplex/Chat/Store/Groups.hs index 67722ebd0f..256c81fe6d 100644 --- a/src/Simplex/Chat/Store/Groups.hs +++ b/src/Simplex/Chat/Store/Groups.hs @@ -520,9 +520,10 @@ deleteContactCardKeepConn db connId Contact {contactId, profile = LocalProfile { DB.execute db "DELETE FROM contact_profiles WHERE contact_profile_id = ?" (Only profileId) createGroupInvitedViaLink :: DB.Connection -> VersionRangeChat -> User -> Connection -> GroupLinkInvitation -> ExceptT StoreError IO (GroupInfo, GroupMember) -createGroupInvitedViaLink db vr user conn GroupLinkInvitation {fromMember, fromMemberName, invitedMember, groupProfile, business} = do +createGroupInvitedViaLink db vr user conn GroupLinkInvitation {fromMember, fromMemberName, invitedMember, groupProfile, acceptance, business} = do let fromMemberProfile = profileFromName fromMemberName - createGroupViaLink' db vr user conn fromMember fromMemberProfile invitedMember groupProfile business GSMemAccepted + initialStatus = maybe GSMemAccepted acceptanceToStatus acceptance + createGroupViaLink' db vr user conn fromMember fromMemberProfile invitedMember groupProfile business initialStatus createGroupRejectedViaLink :: DB.Connection -> VersionRangeChat -> User -> Connection -> GroupLinkRejection -> ExceptT StoreError IO (GroupInfo, GroupMember) createGroupRejectedViaLink db vr user conn GroupLinkRejection {fromMember = fromMember@MemberIdRole {memberId}, invitedMember, groupProfile} = do diff --git a/src/Simplex/Chat/Types.hs b/src/Simplex/Chat/Types.hs index 9d54a24fb2..0920750646 100644 --- a/src/Simplex/Chat/Types.hs +++ b/src/Simplex/Chat/Types.hs @@ -1019,6 +1019,11 @@ instance ToJSON GroupMemberStatus where toJSON = J.String . textEncode toEncoding = JE.text . textEncode +acceptanceToStatus :: GroupAcceptance -> GroupMemberStatus +acceptanceToStatus = \case + GAAuto -> GSMemAccepted + GAManual -> GSMemPendingApproval + memberActive :: GroupMember -> Bool memberActive m = case memberStatus m of GSMemRejected -> False @@ -1027,7 +1032,7 @@ memberActive m = case memberStatus m of GSMemGroupDeleted -> False GSMemUnknown -> False GSMemInvited -> False - GSMemPendingApproval -> True -- TODO [knocking] False? + GSMemPendingApproval -> True GSMemIntroduced -> False GSMemIntroInvited -> False GSMemAccepted -> False @@ -1048,7 +1053,7 @@ memberCurrent' = \case GSMemGroupDeleted -> False GSMemUnknown -> False GSMemInvited -> False - GSMemPendingApproval -> False -- TODO [knocking] True? + GSMemPendingApproval -> False GSMemIntroduced -> True GSMemIntroInvited -> True GSMemAccepted -> True diff --git a/src/Simplex/Chat/Types/Shared.hs b/src/Simplex/Chat/Types/Shared.hs index f0ed96b1af..b0c759d3ac 100644 --- a/src/Simplex/Chat/Types/Shared.hs +++ b/src/Simplex/Chat/Types/Shared.hs @@ -51,6 +51,7 @@ instance ToJSON GroupMemberRole where data GroupAcceptance = GAAuto | GAManual deriving (Eq, Show) +-- TODO [knocking] encoding doesn't match field type instance FromField GroupAcceptance where fromField = blobFieldDecoder strDecode instance ToField GroupAcceptance where toField = toField . strEncode diff --git a/src/Simplex/Chat/View.hs b/src/Simplex/Chat/View.hs index a8c2d215a8..b0dbb23390 100644 --- a/src/Simplex/Chat/View.hs +++ b/src/Simplex/Chat/View.hs @@ -1080,8 +1080,12 @@ viewUserJoinedGroup g = Nothing -> [ttyGroup' g <> ": you joined the group"] viewJoinedGroupMember :: GroupInfo -> GroupMember -> [StyledString] -viewJoinedGroupMember g m = - [ttyGroup' g <> ": " <> ttyMember m <> " joined the group "] +viewJoinedGroupMember g@GroupInfo {groupId} m@GroupMember {groupMemberId, memberStatus} = case memberStatus of + GSMemPendingApproval -> + [ (ttyGroup' g <> ": " <> ttyMember m <> " connected and pending approval, ") + <> ("use " <> highlight ("/_accept member #" <> show groupId <> " " <> show groupMemberId <> " ") <> " to accept member") + ] + _ -> [ttyGroup' g <> ": " <> ttyMember m <> " joined the group "] viewReceivedGroupInvitation :: GroupInfo -> Contact -> GroupMemberRole -> [StyledString] viewReceivedGroupInvitation g c role = diff --git a/tests/ChatTests/Groups.hs b/tests/ChatTests/Groups.hs index 05f4a54f39..b4325b5d68 100644 --- a/tests/ChatTests/Groups.hs +++ b/tests/ChatTests/Groups.hs @@ -87,7 +87,7 @@ chatGroupTests = do xit'' "shared batch body is reused" testSharedBatchBody describe "async group connections" $ do xit "create and join group when clients go offline" testGroupAsync - describe "group links" $ do + fdescribe "group links" $ do it "create group link, join via group link" testGroupLink it "invitees were previously connected as contacts" testGroupLinkInviteesWereConnected it "all members were previously connected as contacts" testGroupLinkAllMembersWereConnected