From f40ba6f04ddf908dc36df403a02dd4d811b2199b Mon Sep 17 00:00:00 2001 From: spaced4ndy <8711996+spaced4ndy@users.noreply.github.com> Date: Mon, 13 May 2024 16:51:54 +0400 Subject: [PATCH] core: api to differentiate contacts and conversations (#4111) --- simplex-chat.cabal | 1 + src/Simplex/Chat.hs | 58 +++++++++++++------ src/Simplex/Chat/AppSettings.hs | 16 +++-- src/Simplex/Chat/Controller.hs | 10 +++- src/Simplex/Chat/Messages.hs | 6 ++ .../Chat/Migrations/M20240501_chat_deleted.hs | 18 ++++++ src/Simplex/Chat/Migrations/chat_schema.sql | 1 + src/Simplex/Chat/Store/Connections.hs | 6 +- src/Simplex/Chat/Store/Direct.hs | 28 ++++++--- src/Simplex/Chat/Store/Groups.hs | 4 +- src/Simplex/Chat/Store/Messages.hs | 2 +- src/Simplex/Chat/Store/Migrations.hs | 4 +- src/Simplex/Chat/Store/Shared.hs | 7 ++- src/Simplex/Chat/Types.hs | 8 ++- tests/ChatTests/Direct.hs | 41 ++++++++++++- 15 files changed, 164 insertions(+), 46 deletions(-) create mode 100644 src/Simplex/Chat/Migrations/M20240501_chat_deleted.hs diff --git a/simplex-chat.cabal b/simplex-chat.cabal index 6d66e19696..8f31af7ccc 100644 --- a/simplex-chat.cabal +++ b/simplex-chat.cabal @@ -142,6 +142,7 @@ library Simplex.Chat.Migrations.M20240324_custom_data Simplex.Chat.Migrations.M20240402_item_forwarded Simplex.Chat.Migrations.M20240430_ui_theme + Simplex.Chat.Migrations.M20240501_chat_deleted Simplex.Chat.Mobile Simplex.Chat.Mobile.File Simplex.Chat.Mobile.Shared diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs index 9ddcd28876..8b333e7a1d 100644 --- a/src/Simplex/Chat.hs +++ b/src/Simplex/Chat.hs @@ -1022,22 +1022,41 @@ processChatCommand' vr = \case liftIO $ updateNoteFolderUnreadChat db user nf unreadChat ok user _ -> pure $ chatCmdError (Just user) "not supported" - APIDeleteChat (ChatRef cType chatId) notify -> withUser $ \user@User {userId} -> case cType of + APIDeleteChat cRef@(ChatRef cType chatId) chatDeleteMode -> withUser $ \user@User {userId} -> case cType of CTDirect -> do ct <- withStore $ \db -> getContact db vr user chatId filesInfo <- withStore' $ \db -> getContactFileInfo db user ct - withContactLock "deleteChat direct" chatId . procCmd $ do - cancelFilesInProgress user filesInfo - deleteFilesLocally filesInfo - let doSendDel = contactReady ct && contactActive ct && notify - when doSendDel $ void (sendDirectContactMessage user ct XDirectDel) `catchChatError` const (pure ()) - contactConnIds <- map aConnId <$> withStore' (\db -> getContactConnections db vr userId ct) - deleteAgentConnectionsAsync' user contactConnIds doSendDel - -- functions below are called in separate transactions to prevent crashes on android - -- (possibly, race condition on integrity check?) - withStore' $ \db -> deleteContactConnectionsAndFiles db userId ct - withStore $ \db -> deleteContact db user ct - pure $ CRContactDeleted user ct + withContactLock "deleteChat direct" chatId . procCmd $ + case chatDeleteMode of + CDMFull notify -> do + cancelFilesInProgress user filesInfo + deleteFilesLocally filesInfo + sendDelDeleteConns ct notify + -- functions below are called in separate transactions to prevent crashes on android + -- (possibly, race condition on integrity check?) + withStore' $ \db -> do + deleteContactConnections db user ct + deleteContactFiles db user ct + withStore $ \db -> deleteContact db user ct + pure $ CRContactDeleted user ct + CDMEntity notify -> do + cancelFilesInProgress user filesInfo + sendDelDeleteConns ct notify + ct' <- withStore $ \db -> do + liftIO $ deleteContactConnections db user ct + liftIO $ void $ updateContactStatus db user ct CSDeletedByUser + getContact db vr user chatId + pure $ CRContactDeleted user ct' + CDMMessages -> do + void $ processChatCommand $ APIClearChat cRef + withStore' $ \db -> setContactChatDeleted db user ct True + pure $ CRContactDeleted user ct {chatDeleted = True} + where + sendDelDeleteConns ct notify = do + let doSendDel = contactReady ct && contactActive ct && notify + when doSendDel $ void (sendDirectContactMessage user ct XDirectDel) `catchChatError` const (pure ()) + contactConnIds <- map aConnId <$> withStore' (\db -> getContactConnections db vr userId ct) + deleteAgentConnectionsAsync' user contactConnIds doSendDel CTContactConnection -> withConnectionLock "deleteChat contactConnection" chatId . procCmd $ do conn@PendingContactConnection {pccAgentConnId = AgentConnId acId} <- withStore $ \db -> getPendingContactConnection db userId chatId deleteAgentConnectionAsync user acId @@ -1554,7 +1573,7 @@ processChatCommand' vr = \case CPContactAddress (CAPContactViaAddress Contact {contactId}) -> processChatCommand $ APIConnectContactViaAddress userId incognito contactId _ -> processChatCommand $ APIConnect userId incognito (Just cReqUri) - DeleteContact cName -> withContactName cName $ \ctId -> APIDeleteChat (ChatRef CTDirect ctId) True + DeleteContact cName -> withContactName cName $ \ctId -> APIDeleteChat (ChatRef CTDirect ctId) (CDMFull True) ClearContact cName -> withContactName cName $ APIClearChat . ChatRef CTDirect APIListContacts userId -> withUserId userId $ \user -> CRContactsList user <$> withStore' (\db -> getUserContacts db vr user) @@ -1889,7 +1908,7 @@ processChatCommand' vr = \case processChatCommand $ APILeaveGroup groupId DeleteGroup gName -> withUser $ \user -> do groupId <- withStore $ \db -> getGroupIdByName db user gName - processChatCommand $ APIDeleteChat (ChatRef CTGroup groupId) True + processChatCommand $ APIDeleteChat (ChatRef CTGroup groupId) (CDMFull True) ClearGroup gName -> withUser $ \user -> do groupId <- withStore $ \db -> getGroupIdByName db user gName processChatCommand $ APIClearChat (ChatRef CTGroup groupId) @@ -6676,7 +6695,7 @@ saveSndChatItem' :: ChatTypeI c => User -> ChatDirection c 'MDSnd -> SndMessage saveSndChatItem' user cd msg@SndMessage {sharedMsgId} content ciFile quotedItem itemForwarded itemTimed live = do createdAt <- liftIO getCurrentTime ciId <- withStore' $ \db -> do - when (ciRequiresAttention content) $ updateChatTs db user cd createdAt + when (ciRequiresAttention content || contactChatDeleted cd) $ updateChatTs db user cd createdAt ciId <- createNewSndChatItem db user cd msg content quotedItem itemForwarded itemTimed live createdAt forM_ ciFile $ \CIFile {fileId} -> updateFileTransferChatItemId db fileId ciId createdAt pure ciId @@ -6690,7 +6709,7 @@ saveRcvChatItem' :: (ChatTypeI c, ChatTypeQuotable c) => User -> ChatDirection c saveRcvChatItem' user cd msg@RcvMessage {forwardedByMember} sharedMsgId_ brokerTs content ciFile itemTimed live = do createdAt <- liftIO getCurrentTime (ciId, quotedItem, itemForwarded) <- withStore' $ \db -> do - when (ciRequiresAttention content) $ updateChatTs db user cd createdAt + when (ciRequiresAttention content || contactChatDeleted cd) $ updateChatTs db user cd createdAt r@(ciId, _, _) <- createNewRcvChatItem db user cd msg sharedMsgId_ content itemTimed live brokerTs createdAt forM_ ciFile $ \CIFile {fileId} -> updateFileTransferChatItemId db fileId ciId createdAt pure r @@ -6956,7 +6975,7 @@ createInternalItemsForChats user itemTs_ dirsCIContents = do where updateChat :: DB.Connection -> UTCTime -> ChatDirection c d -> [CIContent d] -> IO () updateChat db createdAt cd contents - | any ciRequiresAttention contents = updateChatTs db user cd createdAt + | any ciRequiresAttention contents || contactChatDeleted cd = updateChatTs db user cd createdAt | otherwise = pure () createACIs :: DB.Connection -> UTCTime -> UTCTime -> ChatDirection c d -> [CIContent d] -> [IO AChatItem] createACIs db itemTs createdAt cd = map $ \content -> do @@ -7104,7 +7123,8 @@ chatCommandP = "/read user" $> UserRead, "/_read chat " *> (APIChatRead <$> chatRefP <*> optional (A.space *> ((,) <$> ("from=" *> A.decimal) <* A.space <*> ("to=" *> A.decimal)))), "/_unread chat " *> (APIChatUnread <$> chatRefP <* A.space <*> onOffP), - "/_delete " *> (APIDeleteChat <$> chatRefP <*> (A.space *> "notify=" *> onOffP <|> pure True)), + "/_delete " *> (APIDeleteChat <$> chatRefP <* A.space <*> jsonP), + "/_delete " *> (APIDeleteChat <$> chatRefP <*> (CDMFull <$> (A.space *> "notify=" *> onOffP <|> pure True))), "/_clear chat " *> (APIClearChat <$> chatRefP), "/_accept" *> (APIAcceptContact <$> incognitoOnOffP <* A.space <*> A.decimal), "/_reject " *> (APIRejectContact <$> A.decimal), diff --git a/src/Simplex/Chat/AppSettings.hs b/src/Simplex/Chat/AppSettings.hs index 62fc900bd0..3d63cb2109 100644 --- a/src/Simplex/Chat/AppSettings.hs +++ b/src/Simplex/Chat/AppSettings.hs @@ -50,7 +50,8 @@ data AppSettings = AppSettings uiColorScheme :: Maybe UIColorScheme, uiDarkColorScheme :: Maybe DarkColorScheme, uiCurrentThemeIds :: Maybe (Map ThemeColorScheme Text), - uiThemes :: Maybe [UITheme] + uiThemes :: Maybe [UITheme], + oneHandUI :: Maybe Bool } deriving (Show) @@ -81,7 +82,8 @@ defaultAppSettings = uiColorScheme = Just UCSSystem, uiDarkColorScheme = Just DCSSimplex, uiCurrentThemeIds = Nothing, - uiThemes = Nothing + uiThemes = Nothing, + oneHandUI = Just True } defaultParseAppSettings :: AppSettings @@ -111,7 +113,8 @@ defaultParseAppSettings = uiColorScheme = Nothing, uiDarkColorScheme = Nothing, uiCurrentThemeIds = Nothing, - uiThemes = Nothing + uiThemes = Nothing, + oneHandUI = Nothing } combineAppSettings :: AppSettings -> AppSettings -> AppSettings @@ -141,7 +144,8 @@ combineAppSettings platformDefaults storedSettings = uiColorScheme = p uiColorScheme, uiDarkColorScheme = p uiDarkColorScheme, uiCurrentThemeIds = p uiCurrentThemeIds, - uiThemes = p uiThemes + uiThemes = p uiThemes, + oneHandUI = p oneHandUI } where p :: (AppSettings -> Maybe a) -> Maybe a @@ -184,6 +188,7 @@ instance FromJSON AppSettings where uiDarkColorScheme <- p "uiDarkColorScheme" uiCurrentThemeIds <- p "uiCurrentThemeIds" uiThemes <- p "uiThemes" + oneHandUI <- p "oneHandUI" pure AppSettings { appPlatform, @@ -210,7 +215,8 @@ instance FromJSON AppSettings where uiColorScheme, uiDarkColorScheme, uiCurrentThemeIds, - uiThemes + uiThemes, + oneHandUI } where p key = v .:? key <|> pure Nothing diff --git a/src/Simplex/Chat/Controller.hs b/src/Simplex/Chat/Controller.hs index 26ace9c772..5f71657ed8 100644 --- a/src/Simplex/Chat/Controller.hs +++ b/src/Simplex/Chat/Controller.hs @@ -296,7 +296,7 @@ data ChatCommand | UserRead | APIChatRead ChatRef (Maybe (ChatItemId, ChatItemId)) | APIChatUnread ChatRef Bool - | APIDeleteChat ChatRef Bool -- `notify` flag is only applied to direct chats + | APIDeleteChat ChatRef ChatDeleteMode -- currently delete mode settings are only applied to direct chats | APIClearChat ChatRef | APIAcceptContact IncognitoEnabled Int64 | APIRejectContact Int64 @@ -824,6 +824,12 @@ data ChatListQuery clqNoFilters :: ChatListQuery clqNoFilters = CLQFilters {favorite = False, unread = False} +data ChatDeleteMode + = CDMFull {notify :: Bool} -- delete both contact and conversation + | CDMEntity {notify :: Bool} -- delete contact (connection), keep conversation + | CDMMessages -- delete conversation, keep contact - can be re-opened from Contacts view + deriving (Show) + data ConnectionPlan = CPInvitationLink {invitationLinkPlan :: InvitationLinkPlan} | CPContactAddress {contactAddressPlan :: ContactAddressPlan} @@ -1392,6 +1398,8 @@ $(JQ.deriveJSON (enumJSON $ dropPrefix "HS") ''HelpSection) $(JQ.deriveJSON (sumTypeJSON $ dropPrefix "CLQ") ''ChatListQuery) +$(JQ.deriveJSON (sumTypeJSON $ dropPrefix "CDM") ''ChatDeleteMode) + $(JQ.deriveJSON (sumTypeJSON $ dropPrefix "ILP") ''InvitationLinkPlan) $(JQ.deriveJSON (sumTypeJSON $ dropPrefix "CAP") ''ContactAddressPlan) diff --git a/src/Simplex/Chat/Messages.hs b/src/Simplex/Chat/Messages.hs index b1c314c04b..9ca191d3f9 100644 --- a/src/Simplex/Chat/Messages.hs +++ b/src/Simplex/Chat/Messages.hs @@ -278,6 +278,12 @@ toChatInfo = \case CDLocalSnd l -> LocalChat l CDLocalRcv l -> LocalChat l +contactChatDeleted :: ChatDirection c d -> Bool +contactChatDeleted = \case + CDDirectSnd Contact {chatDeleted} -> chatDeleted + CDDirectRcv Contact {chatDeleted} -> chatDeleted + _ -> False + data NewChatItem d = NewChatItem { createdByMsgId :: Maybe MessageId, itemSent :: SMsgDirection d, diff --git a/src/Simplex/Chat/Migrations/M20240501_chat_deleted.hs b/src/Simplex/Chat/Migrations/M20240501_chat_deleted.hs new file mode 100644 index 0000000000..a7faf33472 --- /dev/null +++ b/src/Simplex/Chat/Migrations/M20240501_chat_deleted.hs @@ -0,0 +1,18 @@ +{-# LANGUAGE QuasiQuotes #-} + +module Simplex.Chat.Migrations.M20240501_chat_deleted where + +import Database.SQLite.Simple (Query) +import Database.SQLite.Simple.QQ (sql) + +m20240501_chat_deleted :: Query +m20240501_chat_deleted = + [sql| +ALTER TABLE contacts ADD COLUMN chat_deleted INTEGER NOT NULL DEFAULT 0; +|] + +down_m20240501_chat_deleted :: Query +down_m20240501_chat_deleted = + [sql| +ALTER TABLE contacts DROP COLUMN chat_deleted; +|] diff --git a/src/Simplex/Chat/Migrations/chat_schema.sql b/src/Simplex/Chat/Migrations/chat_schema.sql index f2f94d019c..e700acd4d4 100644 --- a/src/Simplex/Chat/Migrations/chat_schema.sql +++ b/src/Simplex/Chat/Migrations/chat_schema.sql @@ -76,6 +76,7 @@ CREATE TABLE contacts( contact_status TEXT NOT NULL DEFAULT 'active', custom_data BLOB, ui_themes TEXT, + chat_deleted INTEGER NOT NULL DEFAULT 0, FOREIGN KEY(user_id, local_display_name) REFERENCES display_names(user_id, local_display_name) ON DELETE CASCADE diff --git a/src/Simplex/Chat/Store/Connections.hs b/src/Simplex/Chat/Store/Connections.hs index bae9d00bfd..1c3e949562 100644 --- a/src/Simplex/Chat/Store/Connections.hs +++ b/src/Simplex/Chat/Store/Connections.hs @@ -98,19 +98,19 @@ getConnectionEntity db vr user@User {userId, userContactId} agentConnId = do [sql| SELECT c.contact_profile_id, c.local_display_name, c.via_group, p.display_name, p.full_name, p.image, p.contact_link, p.local_alias, c.contact_used, c.contact_status, c.enable_ntfs, c.send_rcpts, c.favorite, - p.preferences, c.user_preferences, c.created_at, c.updated_at, c.chat_ts, c.contact_group_member_id, c.contact_grp_inv_sent, c.ui_themes, c.custom_data + p.preferences, c.user_preferences, c.created_at, c.updated_at, c.chat_ts, c.contact_group_member_id, c.contact_grp_inv_sent, c.ui_themes, c.chat_deleted, c.custom_data FROM contacts c JOIN contact_profiles p ON c.contact_profile_id = p.contact_profile_id WHERE c.user_id = ? AND c.contact_id = ? AND c.deleted = 0 |] (userId, contactId) toContact' :: Int64 -> Connection -> [ContactRow'] -> Either StoreError Contact - toContact' contactId conn [(profileId, localDisplayName, viaGroup, displayName, fullName, image, contactLink, localAlias, contactUsed, contactStatus) :. (enableNtfs_, sendRcpts, favorite, preferences, userPreferences, createdAt, updatedAt, chatTs, contactGroupMemberId, contactGrpInvSent, uiThemes, customData)] = + toContact' contactId conn [(profileId, localDisplayName, viaGroup, displayName, fullName, image, contactLink, localAlias, contactUsed, contactStatus) :. (enableNtfs_, sendRcpts, favorite, preferences, userPreferences, createdAt, updatedAt, chatTs) :. (contactGroupMemberId, contactGrpInvSent, uiThemes, chatDeleted, customData)] = let profile = LocalProfile {profileId, displayName, fullName, image, contactLink, preferences, localAlias} chatSettings = ChatSettings {enableNtfs = fromMaybe MFAll enableNtfs_, sendRcpts, favorite} mergedPreferences = contactUserPreferences user userPreferences preferences $ connIncognito conn activeConn = Just conn - in Right Contact {contactId, localDisplayName, profile, activeConn, viaGroup, contactUsed, contactStatus, chatSettings, userPreferences, mergedPreferences, createdAt, updatedAt, chatTs, contactGroupMemberId, contactGrpInvSent, uiThemes, customData} + in Right Contact {contactId, localDisplayName, profile, activeConn, viaGroup, contactUsed, contactStatus, chatSettings, userPreferences, mergedPreferences, createdAt, updatedAt, chatTs, contactGroupMemberId, contactGrpInvSent, uiThemes, chatDeleted, customData} toContact' _ _ _ = Left $ SEInternalError "referenced contact not found" getGroupAndMember_ :: Int64 -> Connection -> ExceptT StoreError IO (GroupInfo, GroupMember) getGroupAndMember_ groupMemberId c = ExceptT $ do diff --git a/src/Simplex/Chat/Store/Direct.hs b/src/Simplex/Chat/Store/Direct.hs index deb0f9fc4c..ecba9be7fa 100644 --- a/src/Simplex/Chat/Store/Direct.hs +++ b/src/Simplex/Chat/Store/Direct.hs @@ -30,7 +30,8 @@ module Simplex.Chat.Store.Direct getConnReqContactXContactId, getContactByConnReqHash, createDirectContact, - deleteContactConnectionsAndFiles, + deleteContactConnections, + deleteContactFiles, deleteContact, deleteContactWithoutGroups, setContactDeleted, @@ -70,6 +71,7 @@ module Simplex.Chat.Store.Direct resetContactConnInitiated, setContactCustomData, setContactUIThemes, + setContactChatDeleted, ) where @@ -178,7 +180,7 @@ getContactByConnReqHash db vr user@User {userId} cReqHash = SELECT -- Contact ct.contact_id, ct.contact_profile_id, ct.local_display_name, ct.via_group, cp.display_name, cp.full_name, cp.image, cp.contact_link, cp.local_alias, ct.contact_used, ct.contact_status, ct.enable_ntfs, ct.send_rcpts, ct.favorite, - cp.preferences, ct.user_preferences, ct.created_at, ct.updated_at, ct.chat_ts, ct.contact_group_member_id, ct.contact_grp_inv_sent, ct.ui_themes, ct.custom_data, + cp.preferences, ct.user_preferences, ct.created_at, ct.updated_at, ct.chat_ts, ct.contact_group_member_id, ct.contact_grp_inv_sent, ct.ui_themes, ct.chat_deleted, ct.custom_data, -- Connection c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact, c.via_user_contact_link, c.via_group_link, c.group_link_id, c.custom_user_profile_id, c.conn_status, c.conn_type, c.contact_conn_initiated, c.local_alias, c.contact_id, c.group_member_id, c.snd_file_id, c.rcv_file_id, c.user_contact_link_id, c.created_at, c.security_code, c.security_code_verified_at, c.pq_support, c.pq_encryption, c.pq_snd_enabled, c.pq_rcv_enabled, c.auth_err_counter, @@ -241,12 +243,13 @@ createDirectContact db user@User {userId} conn@Connection {connId, localAlias} p chatTs = Just currentTs, contactGroupMemberId = Nothing, contactGrpInvSent = False, - customData = Nothing, - uiThemes = Nothing + uiThemes = Nothing, + chatDeleted = False, + customData = Nothing } -deleteContactConnectionsAndFiles :: DB.Connection -> UserId -> Contact -> IO () -deleteContactConnectionsAndFiles db userId Contact {contactId} = do +deleteContactConnections :: DB.Connection -> User -> Contact -> IO () +deleteContactConnections db User {userId} Contact {contactId} = do DB.execute db [sql| @@ -258,6 +261,9 @@ deleteContactConnectionsAndFiles db userId Contact {contactId} = do ) |] (userId, contactId) + +deleteContactFiles :: DB.Connection -> User -> Contact -> IO () +deleteContactFiles db User {userId} Contact {contactId} = do DB.execute db "DELETE FROM files WHERE user_id = ? AND contact_id = ?" (userId, contactId) deleteContact :: DB.Connection -> User -> Contact -> ExceptT StoreError IO () @@ -600,7 +606,7 @@ createOrUpdateContactRequest db vr user@User {userId} userContactLinkId invId (V SELECT -- Contact ct.contact_id, ct.contact_profile_id, ct.local_display_name, ct.via_group, cp.display_name, cp.full_name, cp.image, cp.contact_link, cp.local_alias, ct.contact_used, ct.contact_status, ct.enable_ntfs, ct.send_rcpts, ct.favorite, - cp.preferences, ct.user_preferences, ct.created_at, ct.updated_at, ct.chat_ts, ct.contact_group_member_id, ct.contact_grp_inv_sent, ct.ui_themes, ct.custom_data, + cp.preferences, ct.user_preferences, ct.created_at, ct.updated_at, ct.chat_ts, ct.contact_group_member_id, ct.contact_grp_inv_sent, ct.ui_themes, ct.chat_deleted, ct.custom_data, -- Connection c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact, c.via_user_contact_link, c.via_group_link, c.group_link_id, c.custom_user_profile_id, c.conn_status, c.conn_type, c.contact_conn_initiated, c.local_alias, c.contact_id, c.group_member_id, c.snd_file_id, c.rcv_file_id, c.user_contact_link_id, c.created_at, c.security_code, c.security_code_verified_at, c.pq_support, c.pq_encryption, c.pq_snd_enabled, c.pq_rcv_enabled, c.auth_err_counter, @@ -764,6 +770,7 @@ createAcceptedContact db user@User {userId, profile = LocalProfile {preferences} contactGroupMemberId = Nothing, contactGrpInvSent = False, uiThemes = Nothing, + chatDeleted = False, customData = Nothing } @@ -784,7 +791,7 @@ getContact_ db vr user@User {userId} contactId deleted = SELECT -- Contact ct.contact_id, ct.contact_profile_id, ct.local_display_name, ct.via_group, cp.display_name, cp.full_name, cp.image, cp.contact_link, cp.local_alias, ct.contact_used, ct.contact_status, ct.enable_ntfs, ct.send_rcpts, ct.favorite, - cp.preferences, ct.user_preferences, ct.created_at, ct.updated_at, ct.chat_ts, ct.contact_group_member_id, ct.contact_grp_inv_sent, ct.ui_themes, ct.custom_data, + cp.preferences, ct.user_preferences, ct.created_at, ct.updated_at, ct.chat_ts, ct.contact_group_member_id, ct.contact_grp_inv_sent, ct.ui_themes, ct.chat_deleted, ct.custom_data, -- Connection c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact, c.via_user_contact_link, c.via_group_link, c.group_link_id, c.custom_user_profile_id, c.conn_status, c.conn_type, c.contact_conn_initiated, c.local_alias, c.contact_id, c.group_member_id, c.snd_file_id, c.rcv_file_id, c.user_contact_link_id, c.created_at, c.security_code, c.security_code_verified_at, c.pq_support, c.pq_encryption, c.pq_snd_enabled, c.pq_rcv_enabled, c.auth_err_counter, @@ -934,3 +941,8 @@ setContactUIThemes :: DB.Connection -> User -> Contact -> Maybe UIThemeEntityOve setContactUIThemes db User {userId} Contact {contactId} uiThemes = do updatedAt <- getCurrentTime DB.execute db "UPDATE contacts SET ui_themes = ?, updated_at = ? WHERE user_id = ? AND contact_id = ?" (uiThemes, updatedAt, userId, contactId) + +setContactChatDeleted :: DB.Connection -> User -> Contact -> Bool -> IO () +setContactChatDeleted db User {userId} Contact {contactId} chatDeleted = do + updatedAt <- getCurrentTime + DB.execute db "UPDATE contacts SET chat_deleted = ?, updated_at = ? WHERE user_id = ? AND contact_id = ?" (chatDeleted, updatedAt, userId, contactId) diff --git a/src/Simplex/Chat/Store/Groups.hs b/src/Simplex/Chat/Store/Groups.hs index d8655c818b..5e603a40c9 100644 --- a/src/Simplex/Chat/Store/Groups.hs +++ b/src/Simplex/Chat/Store/Groups.hs @@ -1960,7 +1960,7 @@ createMemberContact authErrCounter = 0 } mergedPreferences = contactUserPreferences user userPreferences preferences $ connIncognito ctConn - pure Contact {contactId, localDisplayName, profile = memberProfile, activeConn = Just ctConn, viaGroup = Nothing, contactUsed = True, contactStatus = CSActive, chatSettings = defaultChatSettings, userPreferences, mergedPreferences, createdAt = currentTs, updatedAt = currentTs, chatTs = Just currentTs, contactGroupMemberId = Just groupMemberId, contactGrpInvSent = False, uiThemes = Nothing, customData = Nothing} + pure Contact {contactId, localDisplayName, profile = memberProfile, activeConn = Just ctConn, viaGroup = Nothing, contactUsed = True, contactStatus = CSActive, chatSettings = defaultChatSettings, userPreferences, mergedPreferences, createdAt = currentTs, updatedAt = currentTs, chatTs = Just currentTs, contactGroupMemberId = Just groupMemberId, contactGrpInvSent = False, uiThemes = Nothing, chatDeleted = False, customData = Nothing} getMemberContact :: DB.Connection -> VersionRangeChat -> User -> ContactId -> ExceptT StoreError IO (GroupInfo, GroupMember, Contact, ConnReqInvitation) getMemberContact db vr user contactId = do @@ -1997,7 +1997,7 @@ createMemberContactInvited contactId <- createContactUpdateMember currentTs userPreferences ctConn <- createMemberContactConn_ db user connIds gInfo mConn contactId subMode let mergedPreferences = contactUserPreferences user userPreferences preferences $ connIncognito ctConn - mCt' = Contact {contactId, localDisplayName = memberLDN, profile = memberProfile, activeConn = Just ctConn, viaGroup = Nothing, contactUsed = True, contactStatus = CSActive, chatSettings = defaultChatSettings, userPreferences, mergedPreferences, createdAt = currentTs, updatedAt = currentTs, chatTs = Just currentTs, contactGroupMemberId = Nothing, contactGrpInvSent = False, uiThemes = Nothing, customData = Nothing} + mCt' = Contact {contactId, localDisplayName = memberLDN, profile = memberProfile, activeConn = Just ctConn, viaGroup = Nothing, contactUsed = True, contactStatus = CSActive, chatSettings = defaultChatSettings, userPreferences, mergedPreferences, createdAt = currentTs, updatedAt = currentTs, chatTs = Just currentTs, contactGroupMemberId = Nothing, contactGrpInvSent = False, uiThemes = Nothing, chatDeleted = False, customData = Nothing} m' = m {memberContactId = Just contactId} pure (mCt', m') where diff --git a/src/Simplex/Chat/Store/Messages.hs b/src/Simplex/Chat/Store/Messages.hs index 8163bd336c..35e515cc2a 100644 --- a/src/Simplex/Chat/Store/Messages.hs +++ b/src/Simplex/Chat/Store/Messages.hs @@ -315,7 +315,7 @@ updateChatTs db User {userId} chatDirection chatTs = case toChatInfo chatDirecti DirectChat Contact {contactId} -> DB.execute db - "UPDATE contacts SET chat_ts = ? WHERE user_id = ? AND contact_id = ?" + "UPDATE contacts SET chat_ts = ?, chat_deleted = 0 WHERE user_id = ? AND contact_id = ?" (chatTs, userId, contactId) GroupChat GroupInfo {groupId} -> DB.execute diff --git a/src/Simplex/Chat/Store/Migrations.hs b/src/Simplex/Chat/Store/Migrations.hs index 2b44778272..e25f255bd8 100644 --- a/src/Simplex/Chat/Store/Migrations.hs +++ b/src/Simplex/Chat/Store/Migrations.hs @@ -106,6 +106,7 @@ import Simplex.Chat.Migrations.M20240313_drop_agent_ack_cmd_id import Simplex.Chat.Migrations.M20240324_custom_data import Simplex.Chat.Migrations.M20240402_item_forwarded import Simplex.Chat.Migrations.M20240430_ui_theme +import Simplex.Chat.Migrations.M20240501_chat_deleted import Simplex.Messaging.Agent.Store.SQLite.Migrations (Migration (..)) schemaMigrations :: [(String, Query, Maybe Query)] @@ -211,7 +212,8 @@ schemaMigrations = ("20240313_drop_agent_ack_cmd_id", m20240313_drop_agent_ack_cmd_id, Just down_m20240313_drop_agent_ack_cmd_id), ("20240324_custom_data", m20240324_custom_data, Just down_m20240324_custom_data), ("20240402_item_forwarded", m20240402_item_forwarded, Just down_m20240402_item_forwarded), - ("20240430_ui_theme", m20240430_ui_theme, Just down_m20240430_ui_theme) + ("20240430_ui_theme", m20240430_ui_theme, Just down_m20240430_ui_theme), + ("20240501_chat_deleted", m20240501_chat_deleted, Just down_m20240501_chat_deleted) ] -- | The list of migrations in ascending order by date diff --git a/src/Simplex/Chat/Store/Shared.hs b/src/Simplex/Chat/Store/Shared.hs index 1f16ebfef0..113a84966d 100644 --- a/src/Simplex/Chat/Store/Shared.hs +++ b/src/Simplex/Chat/Store/Shared.hs @@ -381,18 +381,19 @@ deleteUnusedIncognitoProfileById_ db User {userId} profileId = |] [":user_id" := userId, ":profile_id" := profileId] -type ContactRow' = (ProfileId, ContactName, Maybe Int64, ContactName, Text, Maybe ImageData, Maybe ConnReqContact, LocalAlias, Bool, ContactStatus) :. (Maybe MsgFilter, Maybe Bool, Bool, Maybe Preferences, Preferences, UTCTime, UTCTime, Maybe UTCTime, Maybe GroupMemberId, Bool, Maybe UIThemeEntityOverrides, Maybe CustomData) + +type ContactRow' = (ProfileId, ContactName, Maybe Int64, ContactName, Text, Maybe ImageData, Maybe ConnReqContact, LocalAlias, Bool, ContactStatus) :. (Maybe MsgFilter, Maybe Bool, Bool, Maybe Preferences, Preferences, UTCTime, UTCTime, Maybe UTCTime) :. (Maybe GroupMemberId, Bool, Maybe UIThemeEntityOverrides, Bool, Maybe CustomData) type ContactRow = Only ContactId :. ContactRow' toContact :: VersionRangeChat -> User -> ContactRow :. MaybeConnectionRow -> Contact -toContact vr user ((Only contactId :. (profileId, localDisplayName, viaGroup, displayName, fullName, image, contactLink, localAlias, contactUsed, contactStatus) :. (enableNtfs_, sendRcpts, favorite, preferences, userPreferences, createdAt, updatedAt, chatTs, contactGroupMemberId, contactGrpInvSent, uiThemes, customData)) :. connRow) = +toContact vr user ((Only contactId :. (profileId, localDisplayName, viaGroup, displayName, fullName, image, contactLink, localAlias, contactUsed, contactStatus) :. (enableNtfs_, sendRcpts, favorite, preferences, userPreferences, createdAt, updatedAt, chatTs) :. (contactGroupMemberId, contactGrpInvSent, uiThemes, chatDeleted, customData)) :. connRow) = let profile = LocalProfile {profileId, displayName, fullName, image, contactLink, preferences, localAlias} activeConn = toMaybeConnection vr connRow chatSettings = ChatSettings {enableNtfs = fromMaybe MFAll enableNtfs_, sendRcpts, favorite} incognito = maybe False connIncognito activeConn mergedPreferences = contactUserPreferences user userPreferences preferences incognito - in Contact {contactId, localDisplayName, profile, activeConn, viaGroup, contactUsed, contactStatus, chatSettings, userPreferences, mergedPreferences, createdAt, updatedAt, chatTs, contactGroupMemberId, contactGrpInvSent, uiThemes, customData} + in Contact {contactId, localDisplayName, profile, activeConn, viaGroup, contactUsed, contactStatus, chatSettings, userPreferences, mergedPreferences, createdAt, updatedAt, chatTs, contactGroupMemberId, contactGrpInvSent, uiThemes, chatDeleted, customData} getProfileById :: DB.Connection -> UserId -> Int64 -> ExceptT StoreError IO LocalProfile getProfileById db userId profileId = diff --git a/src/Simplex/Chat/Types.hs b/src/Simplex/Chat/Types.hs index 4d8e954312..336448d7f5 100644 --- a/src/Simplex/Chat/Types.hs +++ b/src/Simplex/Chat/Types.hs @@ -177,6 +177,7 @@ data Contact = Contact contactGroupMemberId :: Maybe GroupMemberId, contactGrpInvSent :: Bool, uiThemes :: Maybe UIThemeEntityOverrides, + chatDeleted :: Bool, customData :: Maybe CustomData } deriving (Eq, Show) @@ -226,7 +227,7 @@ contactActive :: Contact -> Bool contactActive Contact {contactStatus} = contactStatus == CSActive contactDeleted :: Contact -> Bool -contactDeleted Contact {contactStatus} = contactStatus == CSDeleted +contactDeleted Contact {contactStatus} = contactStatus == CSDeleted || contactStatus == CSDeletedByUser contactSecurityCode :: Contact -> Maybe SecurityCode contactSecurityCode Contact {activeConn} = connectionCode =<< activeConn @@ -236,7 +237,8 @@ contactPQEnabled Contact {activeConn} = maybe PQEncOff connPQEnabled activeConn data ContactStatus = CSActive - | CSDeleted -- contact deleted by contact + | CSDeleted + | CSDeletedByUser deriving (Eq, Show, Ord) instance FromField ContactStatus where fromField = fromTextField_ textDecode @@ -254,10 +256,12 @@ instance TextEncoding ContactStatus where textDecode = \case "active" -> Just CSActive "deleted" -> Just CSDeleted + "deletedByUser" -> Just CSDeletedByUser _ -> Nothing textEncode = \case CSActive -> "active" CSDeleted -> "deleted" + CSDeletedByUser -> "deletedByUser" data ContactRef = ContactRef { contactId :: ContactId, diff --git a/tests/ChatTests/Direct.hs b/tests/ChatTests/Direct.hs index 1579dedaa7..16082cb30b 100644 --- a/tests/ChatTests/Direct.hs +++ b/tests/ChatTests/Direct.hs @@ -37,6 +37,8 @@ chatDirectTests = do describe "add contact and send/receive messages" testAddContact it "clear chat with contact" testContactClear it "deleting contact deletes profile" testDeleteContactDeletesProfile + it "delete contact keeping conversation" testDeleteContactKeepConversation + it "delete conversation keeping contact" testDeleteConversationKeepContact it "unused contact is deleted silently" testDeleteUnusedContactSilent it "direct message quoted replies" testDirectMessageQuotedReply it "direct message update" testDirectMessageUpdate @@ -344,7 +346,7 @@ testDeleteContactDeletesProfile = connectUsers alice bob alice <##> bob -- alice deletes contact, profile is deleted - alice ##> "/d bob" + alice ##> "/_delete @2 {\"type\": \"full\", \"notify\": true}" alice <## "bob: contact is deleted" bob <## "alice (Alice) deleted contact with you" alice ##> "/_contacts 1" @@ -357,6 +359,43 @@ testDeleteContactDeletesProfile = (bob FilePath -> IO () +testDeleteContactKeepConversation = + testChat2 aliceProfile bobProfile $ + \alice bob -> do + connectUsers alice bob + alice <##> bob + + alice ##> "/_delete @2 {\"type\": \"entity\", \"notify\": true}" + alice <## "bob: contact is deleted" + bob <## "alice (Alice) deleted contact with you" + + alice @@@ [("@bob", "hey")] + alice ##> "@bob hi" + alice <## "bob: not ready" + bob @@@ [("@alice", "contact deleted")] + bob ##> "@alice hey" + bob <## "alice: not ready" + +testDeleteConversationKeepContact :: HasCallStack => FilePath -> IO () +testDeleteConversationKeepContact = + testChat2 aliceProfile bobProfile $ + \alice bob -> do + connectUsers alice bob + alice <##> bob + + alice @@@ [("@bob", "hey")] + + alice ##> "/_delete @2 {\"type\": \"messages\", \"notify\": true}" + alice <## "bob: contact is deleted" + + alice @@@ [("@bob", "")] -- UI would filter + bob @@@ [("@alice", "hey")] + bob #> "@alice hi" + alice <# "bob> hi" + alice @@@ [("@bob", "hi")] + alice <##> bob + testDeleteUnusedContactSilent :: HasCallStack => FilePath -> IO () testDeleteUnusedContactSilent = testChatCfg3 testCfgCreateGroupDirect aliceProfile bobProfile cathProfile $