dandri/simplex-chat
1
0
Fork 0
mirror of https://github.com/simplex-chat/simplex-chat.git synced 2026-03-30 22:55:48 +00:00
Code Issues Packages Projects Releases Wiki Activity

core: api to differentiate contacts and conversations (#4111)

Browse Source
This commit is contained in:
spaced4ndy
2024-05-13 16:51:54 +04:00
committed by GitHub
parent 06d61ea73e
commit f40ba6f04d
15 changed files with 164 additions and 46 deletions
Download Patch File Download Diff File Expand all files Collapse all files

1
simplex-chat.cabal
View File

@@ -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

58
src/Simplex/Chat.hs
View File

@@ -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),

16
src/Simplex/Chat/AppSettings.hs
View File

@@ -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

10
src/Simplex/Chat/Controller.hs
View File

@@ -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)

6
src/Simplex/Chat/Messages.hs
View File

@@ -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,

18
src/Simplex/Chat/Migrations/M20240501_chat_deleted.hs Normal file
View File

@@ -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;
|]

1
src/Simplex/Chat/Migrations/chat_schema.sql
View File

@@ -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

6
src/Simplex/Chat/Store/Connections.hs
View File

@@ -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

28
src/Simplex/Chat/Store/Direct.hs
View File

@@ -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)

4
src/Simplex/Chat/Store/Groups.hs
View File

@@ -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

2
src/Simplex/Chat/Store/Messages.hs
View File

@@ -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

4
src/Simplex/Chat/Store/Migrations.hs
View File

@@ -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

7
src/Simplex/Chat/Store/Shared.hs
View File

@@ -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 =

8
src/Simplex/Chat/Types.hs
View File

@@ -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,

41
tests/ChatTests/Direct.hs
View File

@@ -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 </)
bob `hasContactProfiles` ["bob"]
testDeleteContactKeepConversation :: HasCallStack => 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 $