mirror of
https://github.com/simplex-chat/simplex-chat.git
synced 2026-09-01 22:18:43 +00:00
core: member admission (#5798)
This commit is contained in:
@@ -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
|
||||
|
||||
@@ -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)
|
||||
|
||||
@@ -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 (== ' '))
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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}
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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;
|
||||
|]
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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)
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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}} =
|
||||
|
||||
@@ -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"
|
||||
|
||||
|
||||
@@ -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}"
|
||||
|
||||
|
||||
+11
-20
@@ -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"
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
Reference in New Issue
Block a user