diff --git a/simplex-chat.cabal b/simplex-chat.cabal index 52e40d6c6f..0ae425be48 100644 --- a/simplex-chat.cabal +++ b/simplex-chat.cabal @@ -104,6 +104,7 @@ library Simplex.Chat.Store.Postgres.Migrations Simplex.Chat.Store.Postgres.Migrations.M20241220_initial Simplex.Chat.Store.Postgres.Migrations.M20250402_short_links + Simplex.Chat.Store.Postgres.Migrations.M20250512_member_admission else exposed-modules: Simplex.Chat.Archive @@ -234,6 +235,7 @@ library Simplex.Chat.Store.SQLite.Migrations.M20250129_delete_unused_contacts Simplex.Chat.Store.SQLite.Migrations.M20250130_indexes Simplex.Chat.Store.SQLite.Migrations.M20250402_short_links + Simplex.Chat.Store.SQLite.Migrations.M20250512_member_admission other-modules: Paths_simplex_chat hs-source-dirs: diff --git a/src/Simplex/Chat/Library/Commands.hs b/src/Simplex/Chat/Library/Commands.hs index f21c9526a5..d3b945af4f 100644 --- a/src/Simplex/Chat/Library/Commands.hs +++ b/src/Simplex/Chat/Library/Commands.hs @@ -4290,7 +4290,7 @@ 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} 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 8158df5c94..bbefbcfde0 100644 --- a/src/Simplex/Chat/Library/Internal.hs +++ b/src/Simplex/Chat/Library/Internal.hs @@ -972,7 +972,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 0a4f5392c0..5c177969b9 100644 --- a/src/Simplex/Chat/Store/Connections.hs +++ b/src/Simplex/Chat/Store/Connections.hs @@ -136,7 +136,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, -- GroupInfo {membership} mu.group_member_id, mu.group_id, mu.member_id, mu.peer_chat_min_version, mu.peer_chat_max_version, mu.member_role, mu.member_category, diff --git a/src/Simplex/Chat/Store/Groups.hs b/src/Simplex/Chat/Store/Groups.hs index 0c49338a2e..fc23c9ef44 100644 --- a/src/Simplex/Chat/Store/Groups.hs +++ b/src/Simplex/Chat/Store/Groups.hs @@ -277,7 +277,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, -- GroupInfo {membership} mu.group_member_id, mu.group_id, mu.member_id, mu.peer_chat_min_version, mu.peer_chat_max_version, mu.member_role, mu.member_category, @@ -318,7 +318,7 @@ getGroupAndMember db User {userId, userContactId} groupMemberId vr = do -- | creates completely new group with a single member - the current user createNewGroup :: DB.Connection -> VersionRangeChat -> TVar ChaChaDRG -> User -> GroupProfile -> Maybe Profile -> ExceptT StoreError IO GroupInfo createNewGroup db vr gVar user@User {userId} groupProfile incognitoProfile = ExceptT $ do - let GroupProfile {displayName, fullName, description, image, groupPreferences} = groupProfile + let GroupProfile {displayName, fullName, description, image, groupPreferences, memberAdmission} = groupProfile fullGroupPreferences = mergeGroupPreferences groupPreferences currentTs <- getCurrentTime customUserProfileId <- mapM (createIncognitoProfile_ db userId currentTs) incognitoProfile @@ -326,8 +326,8 @@ createNewGroup db vr gVar user@User {userId} groupProfile incognitoProfile = Exc groupId <- liftIO $ do DB.execute db - "INSERT INTO group_profiles (display_name, full_name, description, image, user_id, preferences, created_at, updated_at) VALUES (?,?,?,?,?,?,?,?)" - (displayName, fullName, description, image, userId, groupPreferences, currentTs, currentTs) + "INSERT INTO group_profiles (display_name, full_name, description, image, user_id, preferences, member_admission, created_at, updated_at) VALUES (?,?,?,?,?,?,?,?,?)" + (displayName, fullName, description, image, userId, groupPreferences, memberAdmission, currentTs, currentTs) profileId <- insertedRowId db DB.execute db @@ -387,7 +387,7 @@ createGroupInvitation db vr user@User {userId} contact@Contact {contactId, activ DB.query db "SELECT group_id FROM groups WHERE inv_queue_info = ? AND user_id = ? LIMIT 1" (connRequest, userId) createGroupInvitation_ :: ExceptT StoreError IO (GroupInfo, GroupMemberId) createGroupInvitation_ = do - let GroupProfile {displayName, fullName, description, image, groupPreferences} = groupProfile + let GroupProfile {displayName, fullName, description, image, groupPreferences, memberAdmission} = groupProfile fullGroupPreferences = mergeGroupPreferences groupPreferences ExceptT $ withLocalDisplayName db userId displayName $ \localDisplayName -> runExceptT $ do @@ -395,8 +395,8 @@ createGroupInvitation db vr user@User {userId} contact@Contact {contactId, activ groupId <- liftIO $ do DB.execute db - "INSERT INTO group_profiles (display_name, full_name, description, image, user_id, preferences, created_at, updated_at) VALUES (?,?,?,?,?,?,?,?)" - (displayName, fullName, description, image, userId, groupPreferences, currentTs, currentTs) + "INSERT INTO group_profiles (display_name, full_name, description, image, user_id, preferences, member_admission, created_at, updated_at) VALUES (?,?,?,?,?,?,?,?,?)" + (displayName, fullName, description, image, userId, groupPreferences, memberAdmission, currentTs, currentTs) profileId <- insertedRowId db DB.execute db @@ -554,13 +554,13 @@ createGroupViaLink' (,) <$> getGroupInfo db vr user groupId <*> getGroupMemberById db vr user hostMemberId where insertGroup_ currentTs = ExceptT $ do - let GroupProfile {displayName, fullName, description, image, groupPreferences} = groupProfile + let GroupProfile {displayName, fullName, description, image, groupPreferences, memberAdmission} = groupProfile withLocalDisplayName db userId displayName $ \localDisplayName -> runExceptT $ do liftIO $ do DB.execute db - "INSERT INTO group_profiles (display_name, full_name, description, image, user_id, preferences, created_at, updated_at) VALUES (?,?,?,?,?,?,?,?)" - (displayName, fullName, description, image, userId, groupPreferences, currentTs, currentTs) + "INSERT INTO group_profiles (display_name, full_name, description, image, user_id, preferences, member_admission, created_at, updated_at) VALUES (?,?,?,?,?,?,?,?,?)" + (displayName, fullName, description, image, userId, groupPreferences, memberAdmission, currentTs, currentTs) profileId <- insertedRowId db DB.execute db @@ -763,7 +763,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, 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, mu.invited_by, mu.invited_by_group_member_id, mu.local_display_name, mu.contact_id, mu.contact_profile_id, pu.contact_profile_id, pu.display_name, pu.full_name, pu.image, pu.contact_link, pu.local_alias, pu.preferences, @@ -1544,7 +1544,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, -- GroupInfo {membership} mu.group_member_id, mu.group_id, mu.member_id, mu.peer_chat_min_version, mu.peer_chat_max_version, mu.member_role, mu.member_category, @@ -1601,7 +1601,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 @@ -1619,14 +1619,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 @@ -1664,14 +1664,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/Postgres/Migrations.hs b/src/Simplex/Chat/Store/Postgres/Migrations.hs index dc7202edc8..c392c17db1 100644 --- a/src/Simplex/Chat/Store/Postgres/Migrations.hs +++ b/src/Simplex/Chat/Store/Postgres/Migrations.hs @@ -6,12 +6,14 @@ import Data.List (sortOn) import Data.Text (Text) import Simplex.Chat.Store.Postgres.Migrations.M20241220_initial import Simplex.Chat.Store.Postgres.Migrations.M20250402_short_links +import Simplex.Chat.Store.Postgres.Migrations.M20250512_member_admission import Simplex.Messaging.Agent.Store.Shared (Migration (..)) schemaMigrations :: [(String, Text, Maybe Text)] schemaMigrations = [ ("20241220_initial", m20241220_initial, Nothing), - ("20250402_short_links", m20250402_short_links, Just down_m20250402_short_links) + ("20250402_short_links", m20250402_short_links, Just down_m20250402_short_links), + ("20250512_member_admission", m20250512_member_admission, Just down_m20250512_member_admission) ] -- | The list of migrations in ascending order by date diff --git a/src/Simplex/Chat/Store/Postgres/Migrations/M20250402_short_links.hs b/src/Simplex/Chat/Store/Postgres/Migrations/M20250402_short_links.hs index de4f699377..4b3b7e9640 100644 --- a/src/Simplex/Chat/Store/Postgres/Migrations/M20250402_short_links.hs +++ b/src/Simplex/Chat/Store/Postgres/Migrations/M20250402_short_links.hs @@ -12,6 +12,7 @@ m20250402_short_links = [r| ALTER TABLE user_contact_links ADD COLUMN short_link_contact BYTEA; ALTER TABLE connections ADD COLUMN short_link_inv BYTEA; +ALTER TABLE connections ADD COLUMN via_short_link_contact BYTEA; |] down_m20250402_short_links :: Text @@ -20,4 +21,5 @@ down_m20250402_short_links = [r| ALTER TABLE user_contact_links DROP COLUMN short_link_contact; ALTER TABLE connections DROP COLUMN short_link_inv; +ALTER TABLE connections DROP COLUMN via_short_link_contact; |] diff --git a/src/Simplex/Chat/Store/Postgres/Migrations/M20250512_member_admission.hs b/src/Simplex/Chat/Store/Postgres/Migrations/M20250512_member_admission.hs new file mode 100644 index 0000000000..eb0d73a523 --- /dev/null +++ b/src/Simplex/Chat/Store/Postgres/Migrations/M20250512_member_admission.hs @@ -0,0 +1,21 @@ +{-# LANGUAGE QuasiQuotes #-} + +module Simplex.Chat.Store.Postgres.Migrations.M20250512_member_admission where + +import Data.Text (Text) +import qualified Data.Text as T +import Text.RawString.QQ (r) + +m20250512_member_admission :: Text +m20250512_member_admission = + T.pack + [r| +ALTER TABLE group_profiles ADD COLUMN member_admission TEXT; +|] + +down_m20250512_member_admission :: Text +down_m20250512_member_admission = + T.pack + [r| +ALTER TABLE group_profiles DROP COLUMN member_admission; +|] diff --git a/src/Simplex/Chat/Store/SQLite/Migrations.hs b/src/Simplex/Chat/Store/SQLite/Migrations.hs index 81253c5b87..183d699f01 100644 --- a/src/Simplex/Chat/Store/SQLite/Migrations.hs +++ b/src/Simplex/Chat/Store/SQLite/Migrations.hs @@ -129,6 +129,7 @@ import Simplex.Chat.Store.SQLite.Migrations.M20250126_mentions import Simplex.Chat.Store.SQLite.Migrations.M20250129_delete_unused_contacts import Simplex.Chat.Store.SQLite.Migrations.M20250130_indexes import Simplex.Chat.Store.SQLite.Migrations.M20250402_short_links +import Simplex.Chat.Store.SQLite.Migrations.M20250512_member_admission import Simplex.Messaging.Agent.Store.Shared (Migration (..)) schemaMigrations :: [(String, Query, Maybe Query)] @@ -257,7 +258,8 @@ schemaMigrations = ("20250126_mentions", m20250126_mentions, Just down_m20250126_mentions), ("20250129_delete_unused_contacts", m20250129_delete_unused_contacts, Just down_m20250129_delete_unused_contacts), ("20250130_indexes", m20250130_indexes, Just down_m20250130_indexes), - ("20250402_short_links", m20250402_short_links, Just down_m20250402_short_links) + ("20250402_short_links", m20250402_short_links, Just down_m20250402_short_links), + ("20250512_member_admission", m20250512_member_admission, Just down_m20250512_member_admission) ] -- | The list of migrations in ascending order by date diff --git a/src/Simplex/Chat/Store/SQLite/Migrations/M20250512_member_admission.hs b/src/Simplex/Chat/Store/SQLite/Migrations/M20250512_member_admission.hs new file mode 100644 index 0000000000..e1f45beef1 --- /dev/null +++ b/src/Simplex/Chat/Store/SQLite/Migrations/M20250512_member_admission.hs @@ -0,0 +1,18 @@ +{-# LANGUAGE QuasiQuotes #-} + +module Simplex.Chat.Store.SQLite.Migrations.M20250512_member_admission where + +import Database.SQLite.Simple (Query) +import Database.SQLite.Simple.QQ (sql) + +m20250512_member_admission :: Query +m20250512_member_admission = + [sql| +ALTER TABLE group_profiles ADD COLUMN member_admission TEXT; +|] + +down_m20250512_member_admission :: Query +down_m20250512_member_admission = + [sql| +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 e3eff0f6f1..88c6c33b41 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, -- GroupInfo {membership} mu.group_member_id, mu.group_id, mu.member_id, mu.peer_chat_min_version, mu.peer_chat_max_version, mu.member_role, mu.member_category, @@ -544,7 +544,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 = ? @@ -805,7 +805,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, -- GroupInfo {membership} mu.group_member_id, mu.group_id, mu.member_id, mu.peer_chat_min_version, mu.peer_chat_max_version, mu.member_role, mu.member_category, @@ -850,7 +850,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, 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, mu.invited_by, mu.invited_by_group_member_id, mu.local_display_name, mu.contact_id, mu.contact_profile_id, pu.contact_profile_id, pu.display_name, pu.full_name, pu.image, pu.contact_link, pu.local_alias, pu.preferences, @@ -1235,7 +1235,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 @@ -4458,7 +4458,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, -- GroupMember - membership mu.group_member_id, mu.group_id, mu.member_id, mu.peer_chat_min_version, mu.peer_chat_max_version, mu.member_role, mu.member_category, @@ -4480,7 +4480,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, -- GroupMember - membership mu.group_member_id, mu.group_id, mu.member_id, mu.peer_chat_min_version, mu.peer_chat_max_version, mu.member_role, mu.member_category, @@ -5387,7 +5387,7 @@ Plan: Query: INSERT INTO files (user_id, group_id, file_name, file_size, chunk_size, file_inline, ci_file_status, protocol, created_at, updated_at) VALUES (?,?,?,?,?,?,?,?,?,?) Plan: -Query: INSERT INTO group_profiles (display_name, full_name, description, image, user_id, preferences, created_at, updated_at) VALUES (?,?,?,?,?,?,?,?) +Query: INSERT INTO group_profiles (display_name, full_name, description, image, user_id, preferences, member_admission, created_at, updated_at) VALUES (?,?,?,?,?,?,?,?,?) Plan: Query: INSERT INTO group_profiles (display_name, full_name, image, user_id, preferences, created_at, updated_at) VALUES (?,?,?,?,?,?,?) diff --git a/src/Simplex/Chat/Store/SQLite/Migrations/chat_schema.sql b/src/Simplex/Chat/Store/SQLite/Migrations/chat_schema.sql index 33b800f4ef..6fbed97d27 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 c681180759..b32fd07bb5 100644 --- a/src/Simplex/Chat/Store/Shared.hs +++ b/src/Simplex/Chat/Store/Shared.hs @@ -579,16 +579,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) :. 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) :. 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 ConnLinkContact, LocalAlias, Maybe Preferences) :. (UTCTime, UTCTime) 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) :. 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) :. 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 in GroupInfo {groupId, localDisplayName, groupProfile, localAlias, businessChat, fullGroupPreferences, membership, chatSettings, createdAt, updatedAt, chatTs, userMemberProfileSentAt, chatTags, chatItemTTL, uiThemes, customData} @@ -612,7 +612,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, -- GroupMember - membership mu.group_member_id, mu.group_id, mu.member_id, mu.peer_chat_min_version, mu.peer_chat_max_version, mu.member_role, mu.member_category, diff --git a/src/Simplex/Chat/Types.hs b/src/Simplex/Chat/Types.hs index 9d875f5bf4..0063f711c7 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) @@ -616,10 +616,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) @@ -1816,6 +1830,16 @@ $(JQ.deriveJSON defaultJSON ''LocalProfile) $(JQ.deriveJSON defaultJSON ''UserContactRequest) +$(JQ.deriveJSON (enumJSON $ dropPrefix "MC") {J.tagSingleConstructors = True} ''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/View.hs b/src/Simplex/Chat/View.hs index c07fcc952d..42d1132961 100644 --- a/src/Simplex/Chat/View.hs +++ b/src/Simplex/Chat/View.hs @@ -1680,10 +1680,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 @@ -1704,6 +1704,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/ProtocolTests.hs b/tests/ProtocolTests.hs index 50d2c1eef0..1d37a52459 100644 --- a/tests/ProtocolTests.hs +++ b/tests/ProtocolTests.hs @@ -107,7 +107,7 @@ 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