core: member admission (#5798)

This commit is contained in:
spaced4ndy
2025-04-03 08:55:32 +00:00
committed by GitHub
parent 4718494329
commit 9654e193af
18 changed files with 131 additions and 130 deletions
@@ -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
+1
View File
@@ -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)
+13 -5
View File
@@ -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 (== ' '))
+3 -3
View File
@@ -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
+1 -1
View File
@@ -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}
+10 -11
View File
@@ -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
+4 -4
View File
@@ -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
+29 -5
View File
@@ -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)
+10 -41
View File
@@ -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
+6 -3
View File
@@ -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}} =
+9 -7
View File
@@ -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"
+9 -9
View File
@@ -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
View File
@@ -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"
+1 -2
View File
@@ -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
+2 -2
View File
@@ -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