diff --git a/apps/simplex-directory-service/src/Directory/Service.hs b/apps/simplex-directory-service/src/Directory/Service.hs index 825212c888..d10656c750 100644 --- a/apps/simplex-directory-service/src/Directory/Service.hs +++ b/apps/simplex-directory-service/src/Directory/Service.hs @@ -473,7 +473,7 @@ directoryServiceEvent st opts@DirectoryOpts {adminUsers, superUsers, serviceName let role = if useMemberFilter image (makeObserver a) then GRObserver else maybe GRMember (\GroupLinkInfo {memberRole} -> memberRole) gli_ gmId = groupMemberId' m sendChatCmd cc (APIAcceptMember groupId gmId role) >>= \case - CRJoinedGroupMember {member} -> do + CRMemberAccepted {member} -> do atomically $ TM.delete gmId $ pendingCaptchas env if memberStatus member == GSMemPendingReview then logInfo $ "Member " <> viewName displayName <> " accepted and pending review, group " <> tshow groupId <> ":" <> viewGroupName g diff --git a/src/Simplex/Chat/Controller.hs b/src/Simplex/Chat/Controller.hs index c187dc10ba..1ea2991c24 100644 --- a/src/Simplex/Chat/Controller.hs +++ b/src/Simplex/Chat/Controller.hs @@ -524,6 +524,7 @@ data ChatCommand | SetContactFeature AChatFeature ContactName (Maybe FeatureAllowed) | SetGroupFeature AGroupFeatureNoRole GroupName GroupFeatureEnabled | SetGroupFeatureRole AGroupFeatureRole GroupName GroupFeatureEnabled (Maybe GroupMemberRole) + | SetGroupMemberAdmissionReview GroupName (Maybe MemberCriteria) | SetUserTimedMessages Bool -- UserId (not used in UI) | SetContactTimedMessages ContactName (Maybe TimedMessagesEnabled) | SetGroupTimedMessages GroupName (Maybe Int) diff --git a/src/Simplex/Chat/Library/Commands.hs b/src/Simplex/Chat/Library/Commands.hs index cf56fafd14..4bcfcdd1b0 100644 --- a/src/Simplex/Chat/Library/Commands.hs +++ b/src/Simplex/Chat/Library/Commands.hs @@ -2044,14 +2044,16 @@ processChatCommand' vr = \case assertUserGroupRole gInfo GRModerator case memberStatus m of GSMemPendingApproval | memberCategory m == GCInviteeMember -> do -- only host can approve + let GroupInfo {groupProfile = GroupProfile {memberAdmission}} = gInfo case memberConn m of - Just mConn - | groupFeatureAllowed SGFNewMemberReview gInfo -> do + Just mConn -> + case memberAdmission >>= review of + Just MCAll -> do introduceToModerators vr user gInfo m withFastStore' $ \db -> updateGroupMemberStatus db userId m GSMemPendingReview let m' = m {memberStatus = GSMemPendingReview} pure $ CRMemberAccepted user gInfo m' - | otherwise -> do + Nothing -> do let msg = XGrpLinkAcpt role (Just $ memberId' m) void $ sendDirectMemberMessage mConn msg groupId introduceToRemaining vr user gInfo m {memberRole = role} @@ -2556,6 +2558,11 @@ processChatCommand' vr = \case SetGroupFeatureRole (AGFR f) gName enabled role -> updateGroupProfileByName gName $ \p -> p {groupPreferences = Just . setGroupPreferenceRole f enabled role $ groupPreferences p} + SetGroupMemberAdmissionReview gName reviewAdmissionApplication -> + updateGroupProfileByName gName $ \p@GroupProfile {memberAdmission} -> + case memberAdmission of + Nothing -> p {memberAdmission = Just (emptyGroupMemberAdmission :: GroupMemberAdmission) {review = reviewAdmissionApplication}} + Just ma -> p {memberAdmission = Just (ma :: GroupMemberAdmission) {review = reviewAdmissionApplication}} SetUserTimedMessages onOff -> withUser $ \user@User {profile} -> do let allowed = if onOff then FAYes else FANo pref = TimedMessagesPreference allowed Nothing @@ -4187,7 +4194,6 @@ chatCommandP = "/set voice " *> (SetUserFeature (ACF SCFVoice) <$> strP), "/set files #" *> (SetGroupFeatureRole (AGFR SGFFiles) <$> displayNameP <*> _strP <*> optional memberRole), "/set history #" *> (SetGroupFeature (AGFNR SGFHistory) <$> displayNameP <*> (A.space *> strP)), - "/set new member review #" *> (SetGroupFeature (AGFNR SGFNewMemberReview) <$> displayNameP <*> (A.space *> strP)), "/set reactions #" *> (SetGroupFeature (AGFNR SGFReactions) <$> displayNameP <*> (A.space *> strP)), "/set calls @" *> (SetContactFeature (ACF SCFCalls) <$> displayNameP <*> optional (A.space *> strP)), "/set calls " *> (SetUserFeature (ACF SCFCalls) <$> strP), @@ -4200,6 +4206,7 @@ chatCommandP = "/set disappear " *> (SetUserTimedMessages <$> (("yes" $> True) <|> ("no" $> False))), "/set reports #" *> (SetGroupFeature (AGFNR SGFReports) <$> displayNameP <*> _strP), "/set links #" *> (SetGroupFeatureRole (AGFR SGFSimplexLinks) <$> displayNameP <*> _strP <*> optional memberRole), + "/set admission review #" *> (SetGroupMemberAdmissionReview <$> displayNameP <*> (A.space *> memberCriteriaP)), ("/incognito" <* optional (A.space *> onOffP)) $> ChatHelp HSIncognito, "/set device name " *> (SetLocalDeviceName <$> textP), "/list remote hosts" $> ListRemoteHosts, @@ -4299,7 +4306,8 @@ chatCommandP = { directMessages = Just DirectMessagesGroupPreference {enable = FEOn, role = Nothing}, history = Just HistoryGroupPreference {enable = FEOn} } - pure GroupProfile {displayName = gName, fullName, description = Nothing, image = Nothing, groupPreferences} + pure GroupProfile {displayName = gName, fullName, description = Nothing, image = Nothing, groupPreferences, memberAdmission = Nothing} + memberCriteriaP = ("all" $> Just MCAll) <|> ("off" $> Nothing) fullNameP = A.space *> textP <|> pure "" textP = safeDecodeUtf8 <$> A.takeByteString pwdP = jsonP <|> (UserPwd . safeDecodeUtf8 <$> A.takeTill (== ' ')) diff --git a/src/Simplex/Chat/Library/Internal.hs b/src/Simplex/Chat/Library/Internal.hs index f41d67d37a..5ef97442da 100644 --- a/src/Simplex/Chat/Library/Internal.hs +++ b/src/Simplex/Chat/Library/Internal.hs @@ -859,13 +859,13 @@ acceptContactRequestAsync user cReq@UserContactRequest {agentInvitationId = Agen acceptGroupJoinRequestAsync :: User -> GroupInfo -> UserContactRequest -> GroupAcceptance -> GroupMemberRole -> Maybe IncognitoProfile -> CM GroupMember acceptGroupJoinRequestAsync user - gInfo@GroupInfo {groupProfile, fullGroupPreferences, membership, businessChat} + gInfo@GroupInfo {groupProfile, membership, businessChat} ucr@UserContactRequest {agentInvitationId = AgentInvId invId, cReqChatVRange} gAccepted gLinkMemRole incognitoProfile = do gVar <- asks random - let initialStatus = acceptanceToStatus fullGroupPreferences gAccepted + let initialStatus = acceptanceToStatus (memberAdmission groupProfile) gAccepted (groupMemberId, memberId) <- withStore $ \db -> do liftIO $ deleteContactRequestRec db user ucr createJoiningMember db gVar user gInfo ucr gLinkMemRole initialStatus @@ -957,7 +957,7 @@ acceptBusinessJoinRequestAsync where businessGroupProfile :: Profile -> GroupPreferences -> GroupProfile businessGroupProfile Profile {displayName, fullName, image} groupPreferences = - GroupProfile {displayName, fullName, description = Nothing, image, groupPreferences = Just groupPreferences} + GroupProfile {displayName, fullName, description = Nothing, image, groupPreferences = Just groupPreferences, memberAdmission = Nothing} profileToSendOnAccept :: User -> Maybe IncognitoProfile -> Bool -> Profile profileToSendOnAccept user ip = userProfileToSend user (getIncognitoProfile <$> ip) Nothing diff --git a/src/Simplex/Chat/Store/Connections.hs b/src/Simplex/Chat/Store/Connections.hs index 8d2b1326e5..b63ea91126 100644 --- a/src/Simplex/Chat/Store/Connections.hs +++ b/src/Simplex/Chat/Store/Connections.hs @@ -134,7 +134,7 @@ getConnectionEntity db vr user@User {userId, userContactId} agentConnId = do SELECT -- GroupInfo g.group_id, g.local_display_name, gp.display_name, gp.full_name, g.local_alias, gp.description, gp.image, - g.enable_ntfs, g.send_rcpts, g.favorite, gp.preferences, + g.enable_ntfs, g.send_rcpts, g.favorite, gp.preferences, gp.member_admission, g.created_at, g.updated_at, g.chat_ts, g.user_member_profile_sent_at, g.business_chat, g.business_member_id, g.customer_member_id, g.ui_themes, g.custom_data, g.chat_item_ttl, g.mods_support_chat_ts, g.mods_support_chat_unanswered, -- GroupInfo {membership} diff --git a/src/Simplex/Chat/Store/Groups.hs b/src/Simplex/Chat/Store/Groups.hs index 36169c1a06..054fc24519 100644 --- a/src/Simplex/Chat/Store/Groups.hs +++ b/src/Simplex/Chat/Store/Groups.hs @@ -278,7 +278,7 @@ getGroupAndMember db User {userId, userContactId} groupMemberId vr = do SELECT -- GroupInfo g.group_id, g.local_display_name, gp.display_name, gp.full_name, g.local_alias, gp.description, gp.image, - g.enable_ntfs, g.send_rcpts, g.favorite, gp.preferences, + g.enable_ntfs, g.send_rcpts, g.favorite, gp.preferences, gp.member_admission, g.created_at, g.updated_at, g.chat_ts, g.user_member_profile_sent_at, g.business_chat, g.business_member_id, g.customer_member_id, g.ui_themes, g.custom_data, g.chat_item_ttl, g.mods_support_chat_ts, g.mods_support_chat_unanswered, -- GroupInfo {membership} @@ -529,8 +529,7 @@ deleteContactCardKeepConn db connId Contact {contactId, profile = LocalProfile { createGroupInvitedViaLink :: DB.Connection -> VersionRangeChat -> User -> Connection -> GroupLinkInvitation -> ExceptT StoreError IO (GroupInfo, GroupMember) createGroupInvitedViaLink db vr user conn GroupLinkInvitation {fromMember, fromMemberName, invitedMember, groupProfile, accepted, business} = do let fromMemberProfile = profileFromName fromMemberName - fullGroupPreferences = mergeGroupPreferences $ groupPreferences groupProfile - initialStatus = maybe GSMemAccepted (acceptanceToStatus fullGroupPreferences) accepted + initialStatus = maybe GSMemAccepted (acceptanceToStatus $ memberAdmission groupProfile) accepted createGroupViaLink' db vr user conn fromMember fromMemberProfile invitedMember groupProfile business initialStatus createGroupRejectedViaLink :: DB.Connection -> VersionRangeChat -> User -> Connection -> GroupLinkRejection -> ExceptT StoreError IO (GroupInfo, GroupMember) @@ -769,7 +768,7 @@ getUserGroupDetails db vr User {userId, userContactId} _contactId_ search_ = do [sql| SELECT g.group_id, g.local_display_name, gp.display_name, gp.full_name, g.local_alias, gp.description, gp.image, - g.enable_ntfs, g.send_rcpts, g.favorite, gp.preferences, + g.enable_ntfs, g.send_rcpts, g.favorite, gp.preferences, gp.member_admission, g.created_at, g.updated_at, g.chat_ts, g.user_member_profile_sent_at, g.business_chat, g.business_member_id, g.customer_member_id, g.ui_themes, g.custom_data, g.chat_item_ttl, g.mods_support_chat_ts, g.mods_support_chat_unanswered, mu.group_member_id, g.group_id, mu.member_id, mu.peer_chat_min_version, mu.peer_chat_max_version, mu.member_role, mu.member_category, mu.member_status, mu.show_messages, mu.member_restriction, @@ -1569,7 +1568,7 @@ getViaGroupMember db vr User {userId, userContactId} Contact {contactId} = do SELECT -- GroupInfo g.group_id, g.local_display_name, gp.display_name, gp.full_name, g.local_alias, gp.description, gp.image, - g.enable_ntfs, g.send_rcpts, g.favorite, gp.preferences, + g.enable_ntfs, g.send_rcpts, g.favorite, gp.preferences, gp.member_admission, g.created_at, g.updated_at, g.chat_ts, g.user_member_profile_sent_at, g.business_chat, g.business_member_id, g.customer_member_id, g.ui_themes, g.custom_data, g.chat_item_ttl, g.mods_support_chat_ts, g.mods_support_chat_unanswered, -- GroupInfo {membership} @@ -1627,7 +1626,7 @@ getViaGroupContact db vr user@User {userId} GroupMember {groupMemberId} = do maybe (pure Nothing) (fmap eitherToMaybe . runExceptT . getContact db vr user) contactId_ updateGroupProfile :: DB.Connection -> User -> GroupInfo -> GroupProfile -> ExceptT StoreError IO GroupInfo -updateGroupProfile db user@User {userId} g@GroupInfo {groupId, localDisplayName, groupProfile = GroupProfile {displayName}} p'@GroupProfile {displayName = newName, fullName, description, image, groupPreferences} +updateGroupProfile db user@User {userId} g@GroupInfo {groupId, localDisplayName, groupProfile = GroupProfile {displayName}} p'@GroupProfile {displayName = newName, fullName, description, image, groupPreferences, memberAdmission} | displayName == newName = liftIO $ do currentTs <- getCurrentTime updateGroupProfile_ currentTs @@ -1645,14 +1644,14 @@ updateGroupProfile db user@User {userId} g@GroupInfo {groupId, localDisplayName, db [sql| UPDATE group_profiles - SET display_name = ?, full_name = ?, description = ?, image = ?, preferences = ?, updated_at = ? + SET display_name = ?, full_name = ?, description = ?, image = ?, preferences = ?, member_admission = ?, updated_at = ? WHERE group_profile_id IN ( SELECT group_profile_id FROM groups WHERE user_id = ? AND group_id = ? ) |] - (newName, fullName, description, image, groupPreferences, currentTs, userId, groupId) + (newName, fullName, description, image, groupPreferences, memberAdmission, currentTs, userId, groupId) updateGroup_ ldn currentTs = do DB.execute db @@ -1690,14 +1689,14 @@ updateGroupProfileFromMember db user g@GroupInfo {groupId} Profile {displayName DB.query db [sql| - SELECT gp.display_name, gp.full_name, gp.description, gp.image, gp.preferences + SELECT gp.display_name, gp.full_name, gp.description, gp.image, gp.preferences, gp.member_admission FROM group_profiles gp JOIN groups g ON gp.group_profile_id = g.group_profile_id WHERE g.group_id = ? |] (Only groupId) - toGroupProfile (displayName, fullName, description, image, groupPreferences) = - GroupProfile {displayName, fullName, description, image, groupPreferences} + toGroupProfile (displayName, fullName, description, image, groupPreferences, memberAdmission) = + GroupProfile {displayName, fullName, description, image, groupPreferences, memberAdmission} getGroupInfo :: DB.Connection -> VersionRangeChat -> User -> Int64 -> ExceptT StoreError IO GroupInfo getGroupInfo db vr User {userId, userContactId} groupId = ExceptT $ do diff --git a/src/Simplex/Chat/Store/SQLite/Migrations/M20250310_group_scope.hs b/src/Simplex/Chat/Store/SQLite/Migrations/M20250310_group_scope.hs index 11db5f7084..fa48bb8660 100644 --- a/src/Simplex/Chat/Store/SQLite/Migrations/M20250310_group_scope.hs +++ b/src/Simplex/Chat/Store/SQLite/Migrations/M20250310_group_scope.hs @@ -16,6 +16,8 @@ import Database.SQLite.Simple.QQ (sql) m20250310_group_scope :: Query m20250310_group_scope = [sql| +ALTER TABLE group_profiles ADD COLUMN member_admission TEXT; + ALTER TABLE groups ADD COLUMN mods_support_chat_ts TEXT; ALTER TABLE groups ADD COLUMN mods_support_chat_unanswered INTEGER; @@ -51,4 +53,6 @@ ALTER TABLE group_members DROP COLUMN support_chat_unanswered; ALTER TABLE groups DROP COLUMN mods_support_chat_ts; ALTER TABLE groups DROP COLUMN mods_support_chat_unanswered; + +ALTER TABLE group_profiles DROP COLUMN member_admission; |] diff --git a/src/Simplex/Chat/Store/SQLite/Migrations/chat_query_plans.txt b/src/Simplex/Chat/Store/SQLite/Migrations/chat_query_plans.txt index 195617c38d..3f8f114a4a 100644 --- a/src/Simplex/Chat/Store/SQLite/Migrations/chat_query_plans.txt +++ b/src/Simplex/Chat/Store/SQLite/Migrations/chat_query_plans.txt @@ -35,7 +35,7 @@ Query: SELECT -- GroupInfo g.group_id, g.local_display_name, gp.display_name, gp.full_name, g.local_alias, gp.description, gp.image, - g.enable_ntfs, g.send_rcpts, g.favorite, gp.preferences, + g.enable_ntfs, g.send_rcpts, g.favorite, gp.preferences, gp.member_admission, g.created_at, g.updated_at, g.chat_ts, g.user_member_profile_sent_at, g.business_chat, g.business_member_id, g.customer_member_id, g.ui_themes, g.custom_data, g.chat_item_ttl, g.mods_support_chat_ts, g.mods_support_chat_unanswered, -- GroupInfo {membership} @@ -529,7 +529,7 @@ SEARCH m USING INTEGER PRIMARY KEY (rowid=?) SEARCH ct USING INTEGER PRIMARY KEY (rowid=?) Query: - SELECT gp.display_name, gp.full_name, gp.description, gp.image, gp.preferences + SELECT gp.display_name, gp.full_name, gp.description, gp.image, gp.preferences, gp.member_admission FROM group_profiles gp JOIN groups g ON gp.group_profile_id = g.group_profile_id WHERE g.group_id = ? @@ -793,7 +793,7 @@ Query: SELECT -- GroupInfo g.group_id, g.local_display_name, gp.display_name, gp.full_name, g.local_alias, gp.description, gp.image, - g.enable_ntfs, g.send_rcpts, g.favorite, gp.preferences, + g.enable_ntfs, g.send_rcpts, g.favorite, gp.preferences, gp.member_admission, g.created_at, g.updated_at, g.chat_ts, g.user_member_profile_sent_at, g.business_chat, g.business_member_id, g.customer_member_id, g.ui_themes, g.custom_data, g.chat_item_ttl, g.mods_support_chat_ts, g.mods_support_chat_unanswered, -- GroupInfo {membership} @@ -839,7 +839,7 @@ SEARCH cc USING COVERING INDEX idx_connections_group_member (user_id=? AND group Query: SELECT g.group_id, g.local_display_name, gp.display_name, gp.full_name, g.local_alias, gp.description, gp.image, - g.enable_ntfs, g.send_rcpts, g.favorite, gp.preferences, + g.enable_ntfs, g.send_rcpts, g.favorite, gp.preferences, gp.member_admission, g.created_at, g.updated_at, g.chat_ts, g.user_member_profile_sent_at, g.business_chat, g.business_member_id, g.customer_member_id, g.ui_themes, g.custom_data, g.chat_item_ttl, g.mods_support_chat_ts, g.mods_support_chat_unanswered, mu.group_member_id, g.group_id, mu.member_id, mu.peer_chat_min_version, mu.peer_chat_max_version, mu.member_role, mu.member_category, mu.member_status, mu.show_messages, mu.member_restriction, @@ -1225,7 +1225,7 @@ SEARCH group_members USING INTEGER PRIMARY KEY (rowid=?) Query: UPDATE group_profiles - SET display_name = ?, full_name = ?, description = ?, image = ?, preferences = ?, updated_at = ? + SET display_name = ?, full_name = ?, description = ?, image = ?, preferences = ?, member_admission = ?, updated_at = ? WHERE group_profile_id IN ( SELECT group_profile_id FROM groups @@ -2956,6 +2956,14 @@ Query: Plan: SEARCH user_contact_links USING INDEX sqlite_autoindex_user_contact_links_1 (user_id=? AND local_display_name=?) +Query: + SELECT conn_req_contact, auto_accept, business_address, auto_accept_incognito, auto_reply_msg_content, group_id, group_link_member_role + FROM user_contact_links + WHERE user_id = ? AND user_contact_link_id = ? + +Plan: +SEARCH user_contact_links USING INTEGER PRIMARY KEY (rowid=?) + Query: SELECT connection_id, agent_conn_id, conn_level, via_contact, via_user_contact_link, via_group_link, group_link_id, custom_user_profile_id, conn_status, conn_type, contact_conn_initiated, local_alias, contact_id, group_member_id, snd_file_id, rcv_file_id, user_contact_link_id, @@ -4464,7 +4472,7 @@ Query: SELECT -- GroupInfo g.group_id, g.local_display_name, gp.display_name, gp.full_name, g.local_alias, gp.description, gp.image, - g.enable_ntfs, g.send_rcpts, g.favorite, gp.preferences, + g.enable_ntfs, g.send_rcpts, g.favorite, gp.preferences, gp.member_admission, g.created_at, g.updated_at, g.chat_ts, g.user_member_profile_sent_at, g.business_chat, g.business_member_id, g.customer_member_id, g.ui_themes, g.custom_data, g.chat_item_ttl, g.mods_support_chat_ts, g.mods_support_chat_unanswered, -- GroupMember - membership @@ -4487,7 +4495,7 @@ Query: SELECT -- GroupInfo g.group_id, g.local_display_name, gp.display_name, gp.full_name, g.local_alias, gp.description, gp.image, - g.enable_ntfs, g.send_rcpts, g.favorite, gp.preferences, + g.enable_ntfs, g.send_rcpts, g.favorite, gp.preferences, gp.member_admission, g.created_at, g.updated_at, g.chat_ts, g.user_member_profile_sent_at, g.business_chat, g.business_member_id, g.customer_member_id, g.ui_themes, g.custom_data, g.chat_item_ttl, g.mods_support_chat_ts, g.mods_support_chat_unanswered, -- GroupMember - membership @@ -4682,14 +4690,6 @@ SEARCH c USING INTEGER PRIMARY KEY (rowid=?) LEFT-JOIN CORRELATED SCALAR SUBQUERY 1 SEARCH cc USING COVERING INDEX idx_connections_group_member (user_id=? AND group_member_id=?) -Query: - SELECT conn_req_contact, auto_accept, business_address, auto_accept_incognito, auto_reply_msg_content, group_id, group_link_member_role - FROM user_contact_links - WHERE user_id = ? - AND user_contact_link_id = ? -Plan: -SEARCH user_contact_links USING INTEGER PRIMARY KEY (rowid=?) - Query: SELECT f.file_id, f.ci_file_status, f.file_path FROM chat_items i diff --git a/src/Simplex/Chat/Store/SQLite/Migrations/chat_schema.sql b/src/Simplex/Chat/Store/SQLite/Migrations/chat_schema.sql index 22cb883a14..3fde7ce08e 100644 --- a/src/Simplex/Chat/Store/SQLite/Migrations/chat_schema.sql +++ b/src/Simplex/Chat/Store/SQLite/Migrations/chat_schema.sql @@ -108,7 +108,8 @@ CREATE TABLE group_profiles( image TEXT, user_id INTEGER DEFAULT NULL REFERENCES users ON DELETE CASCADE, preferences TEXT, - description TEXT NULL + description TEXT NULL, + member_admission TEXT ); CREATE TABLE groups( group_id INTEGER PRIMARY KEY, -- local group ID diff --git a/src/Simplex/Chat/Store/Shared.hs b/src/Simplex/Chat/Store/Shared.hs index adb20d1d33..093382f3ee 100644 --- a/src/Simplex/Chat/Store/Shared.hs +++ b/src/Simplex/Chat/Store/Shared.hs @@ -577,16 +577,16 @@ safeDeleteLDN db User {userId} localDisplayName = do type BusinessChatInfoRow = (Maybe BusinessChatType, Maybe MemberId, Maybe MemberId) -type GroupInfoRow = (Int64, GroupName, GroupName, Text, Text, Maybe Text, Maybe ImageData, Maybe MsgFilter, Maybe BoolInt, BoolInt, Maybe GroupPreferences) :. (UTCTime, UTCTime, Maybe UTCTime, Maybe UTCTime) :. BusinessChatInfoRow :. (Maybe UIThemeEntityOverrides, Maybe CustomData, Maybe Int64) :. (Maybe UTCTime, Maybe BoolInt) :. GroupMemberRow +type GroupInfoRow = (Int64, GroupName, GroupName, Text, Text, Maybe Text, Maybe ImageData, Maybe MsgFilter, Maybe BoolInt, BoolInt, Maybe GroupPreferences, Maybe GroupMemberAdmission) :. (UTCTime, UTCTime, Maybe UTCTime, Maybe UTCTime) :. BusinessChatInfoRow :. (Maybe UIThemeEntityOverrides, Maybe CustomData, Maybe Int64) :. (Maybe UTCTime, Maybe BoolInt) :. GroupMemberRow type GroupMemberRow = (Int64, Int64, MemberId, VersionChat, VersionChat, GroupMemberRole, GroupMemberCategory, GroupMemberStatus, BoolInt, Maybe MemberRestrictionStatus) :. (Maybe Int64, Maybe GroupMemberId, ContactName, Maybe ContactId, ProfileId, ProfileId, ContactName, Text, Maybe ImageData, Maybe ConnReqContact, LocalAlias, Maybe Preferences) :. (UTCTime, UTCTime) :. (Maybe UTCTime, Maybe BoolInt) toGroupInfo :: VersionRangeChat -> Int64 -> [ChatTagId] -> GroupInfoRow -> GroupInfo -toGroupInfo vr userContactId chatTags ((groupId, localDisplayName, displayName, fullName, localAlias, description, image, enableNtfs_, sendRcpts, BI favorite, groupPreferences) :. (createdAt, updatedAt, chatTs, userMemberProfileSentAt) :. businessRow :. (uiThemes, customData, chatItemTTL) :. (modsSupportChatTs_, modsSupportChatUnanswered_) :. userMemberRow) = +toGroupInfo vr userContactId chatTags ((groupId, localDisplayName, displayName, fullName, localAlias, description, image, enableNtfs_, sendRcpts, BI favorite, groupPreferences, memberAdmission) :. (createdAt, updatedAt, chatTs, userMemberProfileSentAt) :. businessRow :. (uiThemes, customData, chatItemTTL) :. (modsSupportChatTs_, modsSupportChatUnanswered_) :. userMemberRow) = let membership = (toGroupMember userContactId userMemberRow) {memberChatVRange = vr} chatSettings = ChatSettings {enableNtfs = fromMaybe MFAll enableNtfs_, sendRcpts = unBI <$> sendRcpts, favorite} fullGroupPreferences = mergeGroupPreferences groupPreferences - groupProfile = GroupProfile {displayName, fullName, description, image, groupPreferences} + groupProfile = GroupProfile {displayName, fullName, description, image, groupPreferences, memberAdmission} businessChat = toBusinessChatInfo businessRow modsSupportChat = case (modsSupportChatTs_, modsSupportChatUnanswered_) of (Just modsChatTs, unanswered_) -> Just GroupSupportChat {chatTs = modsChatTs, unanswered = maybe False unBI unanswered_} @@ -616,7 +616,7 @@ groupInfoQuery = SELECT -- GroupInfo g.group_id, g.local_display_name, gp.display_name, gp.full_name, g.local_alias, gp.description, gp.image, - g.enable_ntfs, g.send_rcpts, g.favorite, gp.preferences, + g.enable_ntfs, g.send_rcpts, g.favorite, gp.preferences, gp.member_admission, g.created_at, g.updated_at, g.chat_ts, g.user_member_profile_sent_at, g.business_chat, g.business_member_id, g.customer_member_id, g.ui_themes, g.custom_data, g.chat_item_ttl, g.mods_support_chat_ts, g.mods_support_chat_unanswered, -- GroupMember - membership diff --git a/src/Simplex/Chat/Types.hs b/src/Simplex/Chat/Types.hs index 7d09c54210..6ce902a48d 100644 --- a/src/Simplex/Chat/Types.hs +++ b/src/Simplex/Chat/Types.hs @@ -57,7 +57,7 @@ import Simplex.Messaging.Crypto.File (CryptoFileArgs (..)) import Simplex.Messaging.Crypto.Ratchet (PQEncryption (..), PQSupport, pattern PQEncOff) import Simplex.Messaging.Encoding.String import Simplex.Messaging.Parsers (defaultJSON, dropPrefix, enumJSON, sumTypeJSON) -import Simplex.Messaging.Util (safeDecodeUtf8, (<$?>)) +import Simplex.Messaging.Util (decodeJSON, encodeJSON, safeDecodeUtf8, (<$?>)) import Simplex.Messaging.Version import Simplex.Messaging.Version.Internal #if defined(dbPostgres) @@ -621,10 +621,24 @@ data GroupProfile = GroupProfile fullName :: Text, description :: Maybe Text, image :: Maybe ImageData, - groupPreferences :: Maybe GroupPreferences + groupPreferences :: Maybe GroupPreferences, + memberAdmission :: Maybe GroupMemberAdmission } deriving (Eq, Show) +data GroupMemberAdmission = GroupMemberAdmission + { -- names :: Maybe MemberCriteria, + -- captcha :: Maybe MemberCriteria, + review :: Maybe MemberCriteria + } + deriving (Eq, Show) + +data MemberCriteria = MCAll + deriving (Eq, Show) + +emptyGroupMemberAdmission :: GroupMemberAdmission +emptyGroupMemberAdmission = GroupMemberAdmission Nothing + newtype ImageData = ImageData Text deriving (Eq, Show) @@ -1031,10 +1045,10 @@ instance ToJSON GroupMemberStatus where toJSON = J.String . textEncode toEncoding = JE.text . textEncode -acceptanceToStatus :: FullGroupPreferences -> GroupAcceptance -> GroupMemberStatus -acceptanceToStatus prefs groupAcceptance +acceptanceToStatus :: Maybe GroupMemberAdmission -> GroupAcceptance -> GroupMemberStatus +acceptanceToStatus memberAdmission groupAcceptance | groupAcceptance == GAPending = GSMemPendingApproval - | groupFeatureAllowed' SGFNewMemberReview prefs = GSMemPendingReview + | (memberAdmission >>= review) == Just MCAll = GSMemPendingReview | otherwise = GSMemAccepted memberActive :: GroupMember -> Bool @@ -1833,6 +1847,16 @@ $(JQ.deriveJSON defaultJSON ''LocalProfile) $(JQ.deriveJSON defaultJSON ''UserContactRequest) +$(JQ.deriveJSON (enumJSON $ dropPrefix "MC") ''MemberCriteria) + +$(JQ.deriveJSON defaultJSON ''GroupMemberAdmission) + +instance ToField GroupMemberAdmission where + toField = toField . encodeJSON + +instance FromField GroupMemberAdmission where + fromField = fromTextField_ decodeJSON + $(JQ.deriveJSON defaultJSON ''GroupProfile) $(JQ.deriveJSON (sumTypeJSON $ dropPrefix "IB") ''InvitedBy) diff --git a/src/Simplex/Chat/Types/Preferences.hs b/src/Simplex/Chat/Types/Preferences.hs index 8098db9b50..63d80657dc 100644 --- a/src/Simplex/Chat/Types/Preferences.hs +++ b/src/Simplex/Chat/Types/Preferences.hs @@ -152,7 +152,6 @@ data GroupFeature | GFSimplexLinks | GFReports | GFHistory - | GFNewMemberReview deriving (Show) data SGroupFeature (f :: GroupFeature) where @@ -165,7 +164,6 @@ data SGroupFeature (f :: GroupFeature) where SGFSimplexLinks :: SGroupFeature 'GFSimplexLinks SGFReports :: SGroupFeature 'GFReports SGFHistory :: SGroupFeature 'GFHistory - SGFNewMemberReview :: SGroupFeature 'GFNewMemberReview deriving instance Show (SGroupFeature f) @@ -192,7 +190,6 @@ groupFeatureNameText = \case GFSimplexLinks -> "SimpleX links" GFReports -> "Member reports" GFHistory -> "Recent history" - GFNewMemberReview -> "New member review" groupFeatureNameText' :: SGroupFeature f -> Text groupFeatureNameText' = groupFeatureNameText . toGroupFeature @@ -216,12 +213,11 @@ allGroupFeatures = AGF SGFFiles, AGF SGFSimplexLinks, AGF SGFReports, - AGF SGFHistory, - AGF SGFNewMemberReview + AGF SGFHistory ] groupPrefSel :: SGroupFeature f -> GroupPreferences -> Maybe (GroupFeaturePreference f) -groupPrefSel f GroupPreferences {timedMessages, directMessages, fullDelete, reactions, voice, files, simplexLinks, reports, history, newMemberReview} = case f of +groupPrefSel f GroupPreferences {timedMessages, directMessages, fullDelete, reactions, voice, files, simplexLinks, reports, history} = case f of SGFTimedMessages -> timedMessages SGFDirectMessages -> directMessages SGFFullDelete -> fullDelete @@ -231,7 +227,6 @@ groupPrefSel f GroupPreferences {timedMessages, directMessages, fullDelete, reac SGFSimplexLinks -> simplexLinks SGFReports -> reports SGFHistory -> history - SGFNewMemberReview -> newMemberReview toGroupFeature :: SGroupFeature f -> GroupFeature toGroupFeature = \case @@ -244,7 +239,6 @@ toGroupFeature = \case SGFSimplexLinks -> GFSimplexLinks SGFReports -> GFReports SGFHistory -> GFHistory - SGFNewMemberReview -> GFNewMemberReview class GroupPreferenceI p where getGroupPreference :: SGroupFeature f -> p -> GroupFeaturePreference f @@ -256,7 +250,7 @@ instance GroupPreferenceI (Maybe GroupPreferences) where getGroupPreference pt prefs = fromMaybe (getGroupPreference pt defaultGroupPrefs) (groupPrefSel pt =<< prefs) instance GroupPreferenceI FullGroupPreferences where - getGroupPreference f FullGroupPreferences {timedMessages, directMessages, fullDelete, reactions, voice, files, simplexLinks, reports, history, newMemberReview} = case f of + getGroupPreference f FullGroupPreferences {timedMessages, directMessages, fullDelete, reactions, voice, files, simplexLinks, reports, history} = case f of SGFTimedMessages -> timedMessages SGFDirectMessages -> directMessages SGFFullDelete -> fullDelete @@ -266,7 +260,6 @@ instance GroupPreferenceI FullGroupPreferences where SGFSimplexLinks -> simplexLinks SGFReports -> reports SGFHistory -> history - SGFNewMemberReview -> newMemberReview {-# INLINE getGroupPreference #-} -- collection of optional group preferences @@ -279,8 +272,7 @@ data GroupPreferences = GroupPreferences files :: Maybe FilesGroupPreference, simplexLinks :: Maybe SimplexLinksGroupPreference, reports :: Maybe ReportsGroupPreference, - history :: Maybe HistoryGroupPreference, - newMemberReview :: Maybe NewMemberReviewGroupPreference + history :: Maybe HistoryGroupPreference } deriving (Eq, Show) @@ -315,7 +307,6 @@ setGroupPreference_ f pref prefs = SGFSimplexLinks -> prefs {simplexLinks = pref} SGFReports -> prefs {reports = pref} SGFHistory -> prefs {history = pref} - SGFNewMemberReview -> prefs {newMemberReview = pref} setGroupTimedMessagesPreference :: TimedMessagesGroupPreference -> Maybe GroupPreferences -> GroupPreferences setGroupTimedMessagesPreference pref prefs_ = @@ -345,8 +336,7 @@ data FullGroupPreferences = FullGroupPreferences files :: FilesGroupPreference, simplexLinks :: SimplexLinksGroupPreference, reports :: ReportsGroupPreference, - history :: HistoryGroupPreference, - newMemberReview :: NewMemberReviewGroupPreference + history :: HistoryGroupPreference } deriving (Eq, Show) @@ -404,12 +394,11 @@ defaultGroupPrefs = files = FilesGroupPreference {enable = FEOn, role = Nothing}, simplexLinks = SimplexLinksGroupPreference {enable = FEOn, role = Nothing}, reports = ReportsGroupPreference {enable = FEOn}, - history = HistoryGroupPreference {enable = FEOff}, - newMemberReview = NewMemberReviewGroupPreference {enable = FEOff} + history = HistoryGroupPreference {enable = FEOff} } emptyGroupPrefs :: GroupPreferences -emptyGroupPrefs = GroupPreferences Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing +emptyGroupPrefs = GroupPreferences Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing businessGroupPrefs :: Preferences -> GroupPreferences businessGroupPrefs Preferences {timedMessages, fullDelete, reactions, voice} = @@ -436,8 +425,7 @@ defaultBusinessGroupPrefs = files = Just $ FilesGroupPreference FEOn Nothing, simplexLinks = Just $ SimplexLinksGroupPreference FEOn Nothing, reports = Just $ ReportsGroupPreference FEOff, - history = Just $ HistoryGroupPreference FEOn, - newMemberReview = Just $ NewMemberReviewGroupPreference FEOff + history = Just $ HistoryGroupPreference FEOn } data TimedMessagesPreference = TimedMessagesPreference @@ -545,10 +533,6 @@ data HistoryGroupPreference = HistoryGroupPreference {enable :: GroupFeatureEnabled} deriving (Eq, Show) -data NewMemberReviewGroupPreference = NewMemberReviewGroupPreference - {enable :: GroupFeatureEnabled} - deriving (Eq, Show) - class (Eq (GroupFeaturePreference f), HasField "enable" (GroupFeaturePreference f) GroupFeatureEnabled) => GroupFeatureI f where type GroupFeaturePreference (f :: GroupFeature) = p | p -> f sGroupFeature :: SGroupFeature f @@ -589,9 +573,6 @@ instance HasField "enable" ReportsGroupPreference GroupFeatureEnabled where instance HasField "enable" HistoryGroupPreference GroupFeatureEnabled where hasField p@HistoryGroupPreference {enable} = (\e -> p {enable = e}, enable) -instance HasField "enable" NewMemberReviewGroupPreference GroupFeatureEnabled where - hasField p@NewMemberReviewGroupPreference {enable} = (\e -> p {enable = e}, enable) - instance GroupFeatureI 'GFTimedMessages where type GroupFeaturePreference 'GFTimedMessages = TimedMessagesGroupPreference sGroupFeature = SGFTimedMessages @@ -646,12 +627,6 @@ instance GroupFeatureI 'GFHistory where groupPrefParam _ = Nothing groupPrefRole _ = Nothing -instance GroupFeatureI 'GFNewMemberReview where - type GroupFeaturePreference 'GFNewMemberReview = NewMemberReviewGroupPreference - sGroupFeature = SGFNewMemberReview - groupPrefParam _ = Nothing - groupPrefRole _ = Nothing - instance GroupFeatureNoRoleI 'GFTimedMessages instance GroupFeatureNoRoleI 'GFFullDelete @@ -662,8 +637,6 @@ instance GroupFeatureNoRoleI 'GFReports instance GroupFeatureNoRoleI 'GFHistory -instance GroupFeatureNoRoleI 'GFNewMemberReview - instance HasField "role" DirectMessagesGroupPreference (Maybe GroupMemberRole) where hasField p@DirectMessagesGroupPreference {role} = (\r -> p {role = r}, role) @@ -817,8 +790,7 @@ mergeGroupPreferences groupPreferences = files = pref SGFFiles, simplexLinks = pref SGFSimplexLinks, reports = pref SGFReports, - history = pref SGFHistory, - newMemberReview = pref SGFNewMemberReview + history = pref SGFHistory } where pref :: SGroupFeature f -> GroupFeaturePreference f @@ -835,8 +807,7 @@ toGroupPreferences groupPreferences = files = pref SGFFiles, simplexLinks = pref SGFSimplexLinks, reports = pref SGFReports, - history = pref SGFHistory, - newMemberReview = pref SGFNewMemberReview + history = pref SGFHistory } where pref :: SGroupFeature f -> Maybe (GroupFeaturePreference f) @@ -948,8 +919,6 @@ $(J.deriveJSON defaultJSON ''ReportsGroupPreference) $(J.deriveJSON defaultJSON ''HistoryGroupPreference) -$(J.deriveJSON defaultJSON ''NewMemberReviewGroupPreference) - $(J.deriveJSON defaultJSON ''GroupPreferences) instance ToField GroupPreferences where diff --git a/src/Simplex/Chat/View.hs b/src/Simplex/Chat/View.hs index db5be7b734..8f875fa008 100644 --- a/src/Simplex/Chat/View.hs +++ b/src/Simplex/Chat/View.hs @@ -1637,10 +1637,10 @@ countactUserPrefText cup = case cup of viewGroupUpdated :: GroupInfo -> GroupInfo -> Maybe GroupMember -> [StyledString] viewGroupUpdated - GroupInfo {localDisplayName = n, groupProfile = GroupProfile {fullName, description, image, groupPreferences = gps}} - g'@GroupInfo {localDisplayName = n', groupProfile = GroupProfile {fullName = fullName', description = description', image = image', groupPreferences = gps'}} + GroupInfo {localDisplayName = n, groupProfile = GroupProfile {fullName, description, image, groupPreferences = gps, memberAdmission = ma}} + g'@GroupInfo {localDisplayName = n', groupProfile = GroupProfile {fullName = fullName', description = description', image = image', groupPreferences = gps', memberAdmission = ma'}} m = do - let update = groupProfileUpdated <> groupPrefsUpdated + let update = groupProfileUpdated <> groupPrefsUpdated <> memberAdmissionUpdated if null update then [] else memberUpdated <> update @@ -1661,6 +1661,9 @@ viewGroupUpdated | otherwise = Just . plain $ groupPreferenceText (pref gps') where pref = getGroupPreference f . mergeGroupPreferences + memberAdmissionUpdated + | ma == ma' = [] + | otherwise = ["changed member admission rules"] viewGroupProfile :: GroupInfo -> [StyledString] viewGroupProfile g@GroupInfo {groupProfile = GroupProfile {description, image, groupPreferences = gps}} = diff --git a/tests/Bots/DirectoryTests.hs b/tests/Bots/DirectoryTests.hs index 6601032a79..9675959bb1 100644 --- a/tests/Bots/DirectoryTests.hs +++ b/tests/Bots/DirectoryTests.hs @@ -981,10 +981,11 @@ testCapthaScreening ps = bob <## "Use /filter 1 [name] [captcha] to enable and /filter 1 off to disable filter." -- connect with captcha screen _ <- join cath groupLink - cath #> "#privacy 123" -- sending incorrect captcha - cath <# "#privacy SimpleX-Directory!> > cath 123" + cath ##> "/_send #1(_support) text 123" -- sending incorrect captcha + cath <# "#privacy (support) 123" + cath <# "#privacy (support) SimpleX-Directory!> > cath 123" cath <## " Incorrect text, please try again." - captcha <- dropStrPrefix "#privacy SimpleX-Directory> " . dropTime <$> getTermLine cath + captcha <- dropStrPrefix "#privacy (support) SimpleX-Directory> " . dropTime <$> getTermLine cath sendCaptcha cath captcha cath <#. "#privacy SimpleX-Directory> Link to join the group privacy: https://" cath <## "#privacy: member bob (Bob) is connected" @@ -1028,13 +1029,14 @@ testCapthaScreening ps = cath <## "connection request sent!" cath <## "#privacy: joining the group..." cath <## "#privacy: you joined the group, pending approval" - cath <# "#privacy SimpleX-Directory> Captcha is generated by SimpleX Directory service." + cath <# "#privacy (support) SimpleX-Directory> Captcha is generated by SimpleX Directory service." cath <## "" cath <## "Send captcha text to join the group privacy." - dropStrPrefix "#privacy SimpleX-Directory> " . dropTime <$> getTermLine cath + dropStrPrefix "#privacy (support) SimpleX-Directory> " . dropTime <$> getTermLine cath sendCaptcha cath captcha = do - cath #> ("#privacy " <> captcha) - cath <# ("#privacy SimpleX-Directory!> > cath " <> captcha) + cath ##> ("/_send #1(_support) text " <> captcha) + cath <# ("#privacy (support) " <> captcha) + cath <# ("#privacy (support) SimpleX-Directory!> > cath " <> captcha) cath <## " Correct, you joined the group privacy" cath <## "#privacy: you joined the group" diff --git a/tests/ChatTests/ChatList.hs b/tests/ChatTests/ChatList.hs index 0c0f0b0ddc..dcd18a9818 100644 --- a/tests/ChatTests/ChatList.hs +++ b/tests/ChatTests/ChatList.hs @@ -200,14 +200,14 @@ testPaginationAllChatTypes = ts7 <- iso8601Show <$> getCurrentTime - getChats_ alice "count=10" [("*", "psst"), ("@dan", "hey"), ("#team", "New member review: off"), (":3", ""), ("<@cath", ""), ("@bob", "hey")] - getChats_ alice "count=3" [("*", "psst"), ("@dan", "hey"), ("#team", "New member review: off")] + getChats_ alice "count=10" [("*", "psst"), ("@dan", "hey"), ("#team", "Recent history: on"), (":3", ""), ("<@cath", ""), ("@bob", "hey")] + getChats_ alice "count=3" [("*", "psst"), ("@dan", "hey"), ("#team", "Recent history: on")] getChats_ alice ("after=" <> ts2 <> " count=2") [(":3", ""), ("<@cath", "")] - getChats_ alice ("before=" <> ts5 <> " count=2") [("#team", "New member review: off"), (":3", "")] - getChats_ alice ("after=" <> ts3 <> " count=10") [("*", "psst"), ("@dan", "hey"), ("#team", "New member review: off"), (":3", "")] + getChats_ alice ("before=" <> ts5 <> " count=2") [("#team", "Recent history: on"), (":3", "")] + getChats_ alice ("after=" <> ts3 <> " count=10") [("*", "psst"), ("@dan", "hey"), ("#team", "Recent history: on"), (":3", "")] getChats_ alice ("before=" <> ts4 <> " count=10") [(":3", ""), ("<@cath", ""), ("@bob", "hey")] - getChats_ alice ("after=" <> ts1 <> " count=10") [("*", "psst"), ("@dan", "hey"), ("#team", "New member review: off"), (":3", ""), ("<@cath", ""), ("@bob", "hey")] - getChats_ alice ("before=" <> ts7 <> " count=10") [("*", "psst"), ("@dan", "hey"), ("#team", "New member review: off"), (":3", ""), ("<@cath", ""), ("@bob", "hey")] + getChats_ alice ("after=" <> ts1 <> " count=10") [("*", "psst"), ("@dan", "hey"), ("#team", "Recent history: on"), (":3", ""), ("<@cath", ""), ("@bob", "hey")] + getChats_ alice ("before=" <> ts7 <> " count=10") [("*", "psst"), ("@dan", "hey"), ("#team", "Recent history: on"), (":3", ""), ("<@cath", ""), ("@bob", "hey")] getChats_ alice ("after=" <> ts7 <> " count=10") [] getChats_ alice ("before=" <> ts1 <> " count=10") [] @@ -219,11 +219,11 @@ testPaginationAllChatTypes = alice ##> "/_settings #1 {\"enableNtfs\":\"all\",\"favorite\":true}" alice <## "ok" - getChats_ alice queryFavorite [("#team", "New member review: off"), ("@bob", "hey")] + getChats_ alice queryFavorite [("#team", "Recent history: on"), ("@bob", "hey")] getChats_ alice ("before=" <> ts4 <> " count=1 " <> queryFavorite) [("@bob", "hey")] - getChats_ alice ("before=" <> ts5 <> " count=1 " <> queryFavorite) [("#team", "New member review: off")] + getChats_ alice ("before=" <> ts5 <> " count=1 " <> queryFavorite) [("#team", "Recent history: on")] getChats_ alice ("after=" <> ts1 <> " count=1 " <> queryFavorite) [("@bob", "hey")] - getChats_ alice ("after=" <> ts4 <> " count=1 " <> queryFavorite) [("#team", "New member review: off")] + getChats_ alice ("after=" <> ts4 <> " count=1 " <> queryFavorite) [("#team", "Recent history: on")] let queryUnread = "{\"type\": \"filters\", \"favorite\": false, \"unread\": true}" diff --git a/tests/ChatTests/Groups.hs b/tests/ChatTests/Groups.hs index e238b4b1bb..5969a49b7b 100644 --- a/tests/ChatTests/Groups.hs +++ b/tests/ChatTests/Groups.hs @@ -387,7 +387,7 @@ testChatPaginationInitial = testChatOpts2 opts aliceProfile bobProfile $ \alice forM_ ([1 .. 10] :: [Int]) $ \n -> bob <# ("#team alice> " <> show n) -- All messages are unread for bob, should return area around unread - bob #$> ("/_get chat #1 initial=2", chat, [(0, "New member review: off"), (0, "connected"), (0, "1"), (0, "2"), (0, "3")]) + bob #$> ("/_get chat #1 initial=2", chat, [(0, "Recent history: on"), (0, "connected"), (0, "1"), (0, "2"), (0, "3")]) -- Read next 2 items let itemIds = intercalate "," $ map groupItemId [1 .. 2] @@ -1571,7 +1571,6 @@ testGroupDescription = testChat4 aliceProfile bobProfile cathProfile danProfile alice <## "SimpleX links: on" alice <## "Member reports: on" alice <## "Recent history: on" - alice <## "New member review: off" bobAddedDan :: HasCallStack => TestCC -> IO () bobAddedDan cc = do cc <## "#team: bob added dan (Daniel) to the group (connecting...)" @@ -3040,22 +3039,18 @@ testGLinkReviewMember = \alice bob cath dan eve -> do createGroup4 "team" alice (bob, GRMember) (cath, GRModerator) (dan, GRModerator) - alice ##> "/set new member review #team on" - alice <## "updated group preferences:" - alice <## "New member review: on" + alice ##> "/set admission review #team all" + alice <## "changed member admission rules" concurrentlyN_ [ do bob <## "alice updated group #team:" - bob <## "updated group preferences:" - bob <## "New member review: on", + bob <## "changed member admission rules", do cath <## "alice updated group #team:" - cath <## "updated group preferences:" - cath <## "New member review: on", + cath <## "changed member admission rules", do dan <## "alice updated group #team:" - dan <## "updated group preferences:" - dan <## "New member review: on" + dan <## "changed member admission rules" ] alice ##> "/create link #team" @@ -3164,22 +3159,18 @@ testGLinkApproveThenReviewMember = \alice bob cath dan eve -> do createGroup4 "team" alice (bob, GRMember) (cath, GRModerator) (dan, GRModerator) - alice ##> "/set new member review #team on" - alice <## "updated group preferences:" - alice <## "New member review: on" + alice ##> "/set admission review #team all" + alice <## "changed member admission rules" concurrentlyN_ [ do bob <## "alice updated group #team:" - bob <## "updated group preferences:" - bob <## "New member review: on", + bob <## "changed member admission rules", do cath <## "alice updated group #team:" - cath <## "updated group preferences:" - cath <## "New member review: on", + cath <## "changed member admission rules", do dan <## "alice updated group #team:" - dan <## "updated group preferences:" - dan <## "New member review: on" + dan <## "changed member admission rules" ] alice ##> "/create link #team" diff --git a/tests/ChatTests/Utils.hs b/tests/ChatTests/Utils.hs index 2ca5a0f5b0..b9068a2e21 100644 --- a/tests/ChatTests/Utils.hs +++ b/tests/ChatTests/Utils.hs @@ -310,8 +310,7 @@ groupFeatures'' dir = ((dir, "Files and media: on"), Nothing, Nothing), ((dir, "SimpleX links: on"), Nothing, Nothing), ((dir, "Member reports: on"), Nothing, Nothing), - ((dir, "Recent history: on"), Nothing, Nothing), - ((dir, "New member review: off"), Nothing, Nothing) + ((dir, "Recent history: on"), Nothing, Nothing) ] itemId :: Int -> String diff --git a/tests/ProtocolTests.hs b/tests/ProtocolTests.hs index ea8d54a0bd..ab2b4b0af2 100644 --- a/tests/ProtocolTests.hs +++ b/tests/ProtocolTests.hs @@ -101,13 +101,13 @@ testChatPreferences :: Maybe Preferences testChatPreferences = Just Preferences {voice = Just VoicePreference {allow = FAYes}, fullDelete = Nothing, timedMessages = Nothing, calls = Nothing, reactions = Just ReactionsPreference {allow = FAYes}} testGroupPreferences :: Maybe GroupPreferences -testGroupPreferences = Just GroupPreferences {timedMessages = Nothing, directMessages = Nothing, reactions = Just ReactionsGroupPreference {enable = FEOn}, voice = Just VoiceGroupPreference {enable = FEOn, role = Nothing}, files = Nothing, fullDelete = Nothing, simplexLinks = Nothing, history = Nothing, reports = Nothing, newMemberReview = Nothing} +testGroupPreferences = Just GroupPreferences {timedMessages = Nothing, directMessages = Nothing, reactions = Just ReactionsGroupPreference {enable = FEOn}, voice = Just VoiceGroupPreference {enable = FEOn, role = Nothing}, files = Nothing, fullDelete = Nothing, simplexLinks = Nothing, history = Nothing, reports = Nothing} testProfile :: Profile testProfile = Profile {displayName = "alice", fullName = "Alice", image = Just (ImageData "data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII="), contactLink = Nothing, preferences = testChatPreferences} testGroupProfile :: GroupProfile -testGroupProfile = GroupProfile {displayName = "team", fullName = "Team", description = Nothing, image = Nothing, groupPreferences = testGroupPreferences} +testGroupProfile = GroupProfile {displayName = "team", fullName = "Team", description = Nothing, image = Nothing, groupPreferences = testGroupPreferences, memberAdmission = Nothing} decodeChatMessageTest :: Spec decodeChatMessageTest = describe "Chat message encoding/decoding" $ do