From c64d1e83618eb66d92ee6008db4df41939631033 Mon Sep 17 00:00:00 2001 From: spaced4ndy <8711996+spaced4ndy@users.noreply.github.com> Date: Wed, 27 Sep 2023 19:36:13 +0400 Subject: [PATCH] core: notify contact about contact deletion (#3131) --- simplex-chat.cabal | 1 + src/Simplex/Chat.hs | 35 +++++++++++++------ src/Simplex/Chat/Controller.hs | 4 ++- src/Simplex/Chat/Messages/CIContent.hs | 34 ++++++++++++++++++ .../Migrations/M20230926_contact_status.hs | 18 ++++++++++ src/Simplex/Chat/Migrations/chat_schema.sql | 1 + src/Simplex/Chat/Protocol.hs | 7 ++++ src/Simplex/Chat/Store/Connections.hs | 8 ++--- src/Simplex/Chat/Store/Direct.hs | 24 ++++++++++--- src/Simplex/Chat/Store/Groups.hs | 25 ++++++------- src/Simplex/Chat/Store/Messages.hs | 2 +- src/Simplex/Chat/Store/Migrations.hs | 4 ++- src/Simplex/Chat/Store/Shared.hs | 10 +++--- src/Simplex/Chat/Types.hs | 28 ++++++++++++++- src/Simplex/Chat/View.hs | 2 ++ tests/ChatTests/Direct.hs | 6 ++-- tests/ChatTests/Files.hs | 8 ++++- tests/ChatTests/Groups.hs | 14 +++++--- tests/ChatTests/Profiles.hs | 5 +++ 19 files changed, 189 insertions(+), 47 deletions(-) create mode 100644 src/Simplex/Chat/Migrations/M20230926_contact_status.hs diff --git a/simplex-chat.cabal b/simplex-chat.cabal index 338346b65..dc3a23adc 100644 --- a/simplex-chat.cabal +++ b/simplex-chat.cabal @@ -113,6 +113,7 @@ library Simplex.Chat.Migrations.M20230903_connections_to_subscribe Simplex.Chat.Migrations.M20230913_member_contacts Simplex.Chat.Migrations.M20230914_member_probes + Simplex.Chat.Migrations.M20230926_contact_status Simplex.Chat.Mobile Simplex.Chat.Mobile.File Simplex.Chat.Mobile.Shared diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs index 1626fe8fd..3530fa82c 100644 --- a/src/Simplex/Chat.hs +++ b/src/Simplex/Chat.hs @@ -904,14 +904,15 @@ processChatCommand = \case liftIO $ updateGroupUnreadChat db user groupInfo unreadChat ok user _ -> pure $ chatCmdError (Just user) "not supported" - APIDeleteChat (ChatRef cType chatId) -> withUser $ \user@User {userId} -> case cType of + APIDeleteChat (ChatRef cType chatId) notify -> withUser $ \user@User {userId} -> case cType of CTDirect -> do ct@Contact {localDisplayName} <- withStore $ \db -> getContact db user chatId filesInfo <- withStore' $ \db -> getContactFileInfo db user ct - contactConnIds <- map aConnId <$> withStore (\db -> getContactConnections db userId ct) withChatLock "deleteChat direct" . procCmd $ do - fileAgentConnIds <- concat <$> forM filesInfo (deleteFile user) - deleteAgentConnectionsAsync user $ fileAgentConnIds <> contactConnIds + deleteFilesAndConns user filesInfo + when (contactActive ct && notify) . void $ sendDirectContactMessage ct XDirectDel + contactConnIds <- map aConnId <$> withStore (\db -> getContactConnections db userId ct) + deleteAgentConnectionsAsync user contactConnIds -- functions below are called in separate transactions to prevent crashes on android -- (possibly, race condition on integrity check?) withStore' $ \db -> deleteContactConnectionsAndFiles db userId ct @@ -1334,7 +1335,7 @@ processChatCommand = \case ConnectSimplex incognito -> withUser $ \user -> -- [incognito] generate profile to send connectViaContact user incognito adminContactReq - DeleteContact cName -> withContactName cName $ APIDeleteChat . ChatRef CTDirect + DeleteContact cName -> withContactName cName $ \ctId -> APIDeleteChat (ChatRef CTDirect ctId) True ClearContact cName -> withContactName cName $ APIClearChat . ChatRef CTDirect APIListContacts userId -> withUserId userId $ \user -> CRContactsList user <$> withStore' (`getUserContacts` user) @@ -1429,7 +1430,7 @@ processChatCommand = \case processChatCommand . APISendMessage chatRef True Nothing $ ComposedMessage Nothing Nothing mc SendMessageBroadcast msg -> withUser $ \user -> do contacts <- withStore' (`getUserContacts` user) - let cts = filter (\ct -> isReady ct && directOrUsed ct) contacts + let cts = filter (\ct -> isReady ct && contactActive ct && directOrUsed ct) contacts ChatConfig {logLevel} <- asks config withChatLock "sendMessageBroadcast" . procCmd $ do (successes, failures) <- foldM (sendAndCount user logLevel) (0, 0) cts @@ -1597,7 +1598,7 @@ processChatCommand = \case processChatCommand $ APILeaveGroup groupId DeleteGroup gName -> withUser $ \user -> do groupId <- withStore $ \db -> getGroupIdByName db user gName - processChatCommand $ APIDeleteChat (ChatRef CTGroup groupId) + processChatCommand $ APIDeleteChat (ChatRef CTGroup groupId) True ClearGroup gName -> withUser $ \user -> do groupId <- withStore $ \db -> getGroupIdByName db user gName processChatCommand $ APIClearChat (ChatRef CTGroup groupId) @@ -1979,7 +1980,7 @@ processChatCommand = \case -- read contacts before user update to correctly merge preferences -- [incognito] filter out contacts with whom user has incognito connections contacts <- - filter (\ct -> isReady ct && not (contactConnIncognito ct)) + filter (\ct -> isReady ct && contactActive ct && not (contactConnIncognito ct)) <$> withStore' (`getUserContacts` user) user' <- updateUser asks currentUser >>= atomically . (`writeTVar` Just user') @@ -3041,6 +3042,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do XFileCancel sharedMsgId -> xFileCancel ct' sharedMsgId msgMeta XFileAcptInv sharedMsgId fileConnReq_ fName -> xFileAcptInv ct' sharedMsgId fileConnReq_ fName msgMeta XInfo p -> xInfo ct' p + XDirectDel -> xDirectDel ct' msg msgMeta XGrpInv gInv -> processGroupInvitation ct' gInv msg msgMeta XInfoProbe probe -> xInfoProbe (CGMContact ct') probe XInfoProbeCheck probeHash -> xInfoProbeCheck ct' probeHash @@ -4245,6 +4247,18 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do xInfo :: Contact -> Profile -> m () xInfo c p' = void $ processContactProfileUpdate c p' True + xDirectDel :: Contact -> RcvMessage -> MsgMeta -> m () + xDirectDel c msg msgMeta = do + checkIntegrityCreateItem (CDDirectRcv c) msgMeta + ct' <- withStore' $ \db -> updateContactStatus db user c CSDeleted + contactConns <- withStore $ \db -> getContactConnections db userId ct' + deleteAgentConnectionsAsync user $ map aConnId contactConns + forM_ contactConns $ \conn -> withStore' $ \db -> updateConnectionStatus db conn ConnDeleted + let ct'' = ct' {activeConn = (contactConn ct') {connStatus = ConnDeleted}} :: Contact + ci <- saveRcvChatItem user (CDDirectRcv ct'') msg msgMeta (CIRcvDirectEvent RDEContactDeleted) + toView $ CRNewChatItem user (AChatItem SCTDirect SMDRcv (DirectChat ct'') ci) + toView $ CRContactDeletedByContact user ct'' + processContactProfileUpdate :: Contact -> Profile -> Bool -> m Contact processContactProfileUpdate c@Contact {profile = p} p' createItems | fromLocalProfile p /= p' = do @@ -4928,8 +4942,9 @@ deleteOrUpdateMemberRecord user@User {userId} member = Nothing -> deleteGroupMember db user member sendDirectContactMessage :: (MsgEncodingI e, ChatMonad m) => Contact -> ChatMsgEvent e -> m (SndMessage, Int64) -sendDirectContactMessage ct@Contact {activeConn = conn@Connection {connId, connStatus}} chatMsgEvent +sendDirectContactMessage ct@Contact {activeConn = conn@Connection {connId, connStatus}, contactStatus} chatMsgEvent | connStatus /= ConnReady && connStatus /= ConnSndReady = throwChatError $ CEContactNotReady ct + | contactStatus /= CSActive = throwChatError $ CEContactNotActive ct | connDisabled conn = throwChatError $ CEContactDisabled ct | otherwise = sendDirectMessage conn chatMsgEvent (ConnectionId connId) @@ -5418,7 +5433,7 @@ chatCommandP = "/_reaction " *> (APIChatItemReaction <$> chatRefP <* A.space <*> A.decimal <* A.space <*> onOffP <* A.space <*> jsonP), "/_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), + "/_delete " *> (APIDeleteChat <$> chatRefP <*> (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/Controller.hs b/src/Simplex/Chat/Controller.hs index 69bc13ddd..2931a874e 100644 --- a/src/Simplex/Chat/Controller.hs +++ b/src/Simplex/Chat/Controller.hs @@ -248,7 +248,7 @@ data ChatCommand | APIChatItemReaction {chatRef :: ChatRef, chatItemId :: ChatItemId, add :: Bool, reaction :: MsgReaction} | APIChatRead ChatRef (Maybe (ChatItemId, ChatItemId)) | APIChatUnread ChatRef Bool - | APIDeleteChat ChatRef + | APIDeleteChat ChatRef Bool -- `notify` flag is only applied to direct chats | APIClearChat ChatRef | APIAcceptContact IncognitoEnabled Int64 | APIRejectContact Int64 @@ -491,6 +491,7 @@ data ChatResponse | CRContactUpdated {user :: User, fromContact :: Contact, toContact :: Contact} | CRContactsMerged {user :: User, intoContact :: Contact, mergedContact :: Contact} | CRContactDeleted {user :: User, contact :: Contact} + | CRContactDeletedByContact {user :: User, contact :: Contact} | CRChatCleared {user :: User, chatInfo :: AChatInfo} | CRUserContactLinkCreated {user :: User, connReqContact :: ConnReqContact} | CRUserContactLinkDeleted {user :: User} @@ -898,6 +899,7 @@ data ChatErrorType | CEInvalidChatMessage {connection :: Connection, msgMeta :: Maybe MsgMetaJSON, messageData :: Text, message :: String} | CEContactNotFound {contactName :: ContactName, suspectedMember :: Maybe (GroupInfo, GroupMember)} | CEContactNotReady {contact :: Contact} + | CEContactNotActive {contact :: Contact} | CEContactDisabled {contact :: Contact} | CEConnectionDisabled {connection :: Connection} | CEGroupUserRole {groupInfo :: GroupInfo, requiredRole :: GroupMemberRole} diff --git a/src/Simplex/Chat/Messages/CIContent.hs b/src/Simplex/Chat/Messages/CIContent.hs index df22c2684..9abc8e464 100644 --- a/src/Simplex/Chat/Messages/CIContent.hs +++ b/src/Simplex/Chat/Messages/CIContent.hs @@ -132,6 +132,7 @@ data CIContent (d :: MsgDirection) where CIRcvDecryptionError :: MsgDecryptError -> Word32 -> CIContent 'MDRcv CIRcvGroupInvitation :: CIGroupInvitation -> GroupMemberRole -> CIContent 'MDRcv CISndGroupInvitation :: CIGroupInvitation -> GroupMemberRole -> CIContent 'MDSnd + CIRcvDirectEvent :: RcvDirectEvent -> CIContent 'MDRcv CIRcvGroupEvent :: RcvGroupEvent -> CIContent 'MDRcv CISndGroupEvent :: SndGroupEvent -> CIContent 'MDSnd CIRcvConnEvent :: RcvConnEvent -> CIContent 'MDRcv @@ -179,6 +180,7 @@ ciRequiresAttention content = case msgDirection @d of CIRcvIntegrityError _ -> True CIRcvDecryptionError {} -> True CIRcvGroupInvitation {} -> True + CIRcvDirectEvent _ -> False CIRcvGroupEvent rge -> case rge of RGEMemberAdded {} -> False RGEMemberConnected -> False @@ -300,6 +302,27 @@ instance ToJSON DBSndConnEvent where toJSON (SCE v) = J.genericToJSON (singleFieldJSON $ dropPrefix "SCE") v toEncoding (SCE v) = J.genericToEncoding (singleFieldJSON $ dropPrefix "SCE") v +data RcvDirectEvent = + -- RDEProfileChanged {...} + RDEContactDeleted + deriving (Show, Generic) + +instance FromJSON RcvDirectEvent where + parseJSON = J.genericParseJSON . sumTypeJSON $ dropPrefix "RDE" + +instance ToJSON RcvDirectEvent where + toJSON = J.genericToJSON . sumTypeJSON $ dropPrefix "RDE" + toEncoding = J.genericToEncoding . sumTypeJSON $ dropPrefix "RDE" + +newtype DBRcvDirectEvent = RDE RcvDirectEvent + +instance FromJSON DBRcvDirectEvent where + parseJSON v = RDE <$> J.genericParseJSON (singleFieldJSON $ dropPrefix "RDE") v + +instance ToJSON DBRcvDirectEvent where + toJSON (RDE v) = J.genericToJSON (singleFieldJSON $ dropPrefix "RDE") v + toEncoding (RDE v) = J.genericToEncoding (singleFieldJSON $ dropPrefix "RDE") v + newtype DBMsgErrorType = DBME MsgErrorType instance FromJSON DBMsgErrorType where @@ -348,6 +371,7 @@ ciContentToText = \case CIRcvDecryptionError err n -> msgDecryptErrorText err n CIRcvGroupInvitation groupInvitation memberRole -> "received " <> ciGroupInvitationToText groupInvitation memberRole CISndGroupInvitation groupInvitation memberRole -> "sent " <> ciGroupInvitationToText groupInvitation memberRole + CIRcvDirectEvent event -> rcvDirectEventToText event CIRcvGroupEvent event -> rcvGroupEventToText event CISndGroupEvent event -> sndGroupEventToText event CIRcvConnEvent event -> rcvConnEventToText event @@ -368,6 +392,10 @@ ciGroupInvitationToText :: CIGroupInvitation -> GroupMemberRole -> Text ciGroupInvitationToText CIGroupInvitation {groupProfile = GroupProfile {displayName, fullName}} role = "invitation to join group " <> displayName <> optionalFullName displayName fullName <> " as " <> (decodeLatin1 . strEncode $ role) +rcvDirectEventToText :: RcvDirectEvent -> Text +rcvDirectEventToText = \case + RDEContactDeleted -> "contact deleted" + rcvGroupEventToText :: RcvGroupEvent -> Text rcvGroupEventToText = \case RGEMemberAdded _ p -> "added " <> profileToText p @@ -486,6 +514,7 @@ data JSONCIContent | JCIRcvDecryptionError {msgDecryptError :: MsgDecryptError, msgCount :: Word32} | JCIRcvGroupInvitation {groupInvitation :: CIGroupInvitation, memberRole :: GroupMemberRole} | JCISndGroupInvitation {groupInvitation :: CIGroupInvitation, memberRole :: GroupMemberRole} + | JCIRcvDirectEvent {rcvDirectEvent :: RcvDirectEvent} | JCIRcvGroupEvent {rcvGroupEvent :: RcvGroupEvent} | JCISndGroupEvent {sndGroupEvent :: SndGroupEvent} | JCIRcvConnEvent {rcvConnEvent :: RcvConnEvent} @@ -522,6 +551,7 @@ jsonCIContent = \case CIRcvDecryptionError err n -> JCIRcvDecryptionError err n CIRcvGroupInvitation groupInvitation memberRole -> JCIRcvGroupInvitation {groupInvitation, memberRole} CISndGroupInvitation groupInvitation memberRole -> JCISndGroupInvitation {groupInvitation, memberRole} + CIRcvDirectEvent rcvDirectEvent -> JCIRcvDirectEvent {rcvDirectEvent} CIRcvGroupEvent rcvGroupEvent -> JCIRcvGroupEvent {rcvGroupEvent} CISndGroupEvent sndGroupEvent -> JCISndGroupEvent {sndGroupEvent} CIRcvConnEvent rcvConnEvent -> JCIRcvConnEvent {rcvConnEvent} @@ -550,6 +580,7 @@ aciContentJSON = \case JCIRcvDecryptionError err n -> ACIContent SMDRcv $ CIRcvDecryptionError err n JCIRcvGroupInvitation {groupInvitation, memberRole} -> ACIContent SMDRcv $ CIRcvGroupInvitation groupInvitation memberRole JCISndGroupInvitation {groupInvitation, memberRole} -> ACIContent SMDSnd $ CISndGroupInvitation groupInvitation memberRole + JCIRcvDirectEvent {rcvDirectEvent} -> ACIContent SMDRcv $ CIRcvDirectEvent rcvDirectEvent JCIRcvGroupEvent {rcvGroupEvent} -> ACIContent SMDRcv $ CIRcvGroupEvent rcvGroupEvent JCISndGroupEvent {sndGroupEvent} -> ACIContent SMDSnd $ CISndGroupEvent sndGroupEvent JCIRcvConnEvent {rcvConnEvent} -> ACIContent SMDRcv $ CIRcvConnEvent rcvConnEvent @@ -579,6 +610,7 @@ data DBJSONCIContent | DBJCIRcvDecryptionError {msgDecryptError :: MsgDecryptError, msgCount :: Word32} | DBJCIRcvGroupInvitation {groupInvitation :: CIGroupInvitation, memberRole :: GroupMemberRole} | DBJCISndGroupInvitation {groupInvitation :: CIGroupInvitation, memberRole :: GroupMemberRole} + | DBJCIRcvDirectEvent {rcvDirectEvent :: DBRcvDirectEvent} | DBJCIRcvGroupEvent {rcvGroupEvent :: DBRcvGroupEvent} | DBJCISndGroupEvent {sndGroupEvent :: DBSndGroupEvent} | DBJCIRcvConnEvent {rcvConnEvent :: DBRcvConnEvent} @@ -615,6 +647,7 @@ dbJsonCIContent = \case CIRcvDecryptionError err n -> DBJCIRcvDecryptionError err n CIRcvGroupInvitation groupInvitation memberRole -> DBJCIRcvGroupInvitation {groupInvitation, memberRole} CISndGroupInvitation groupInvitation memberRole -> DBJCISndGroupInvitation {groupInvitation, memberRole} + CIRcvDirectEvent rde -> DBJCIRcvDirectEvent $ RDE rde CIRcvGroupEvent rge -> DBJCIRcvGroupEvent $ RGE rge CISndGroupEvent sge -> DBJCISndGroupEvent $ SGE sge CIRcvConnEvent rce -> DBJCIRcvConnEvent $ RCE rce @@ -643,6 +676,7 @@ aciContentDBJSON = \case DBJCIRcvDecryptionError err n -> ACIContent SMDRcv $ CIRcvDecryptionError err n DBJCIRcvGroupInvitation {groupInvitation, memberRole} -> ACIContent SMDRcv $ CIRcvGroupInvitation groupInvitation memberRole DBJCISndGroupInvitation {groupInvitation, memberRole} -> ACIContent SMDSnd $ CISndGroupInvitation groupInvitation memberRole + DBJCIRcvDirectEvent (RDE rde) -> ACIContent SMDRcv $ CIRcvDirectEvent rde DBJCIRcvGroupEvent (RGE rge) -> ACIContent SMDRcv $ CIRcvGroupEvent rge DBJCISndGroupEvent (SGE sge) -> ACIContent SMDSnd $ CISndGroupEvent sge DBJCIRcvConnEvent (RCE rce) -> ACIContent SMDRcv $ CIRcvConnEvent rce diff --git a/src/Simplex/Chat/Migrations/M20230926_contact_status.hs b/src/Simplex/Chat/Migrations/M20230926_contact_status.hs new file mode 100644 index 000000000..b6c5dd955 --- /dev/null +++ b/src/Simplex/Chat/Migrations/M20230926_contact_status.hs @@ -0,0 +1,18 @@ +{-# LANGUAGE QuasiQuotes #-} + +module Simplex.Chat.Migrations.M20230926_contact_status where + +import Database.SQLite.Simple (Query) +import Database.SQLite.Simple.QQ (sql) + +m20230926_contact_status :: Query +m20230926_contact_status = + [sql| +ALTER TABLE contacts ADD COLUMN contact_status TEXT NOT NULL DEFAULT 'active'; +|] + +down_m20230926_contact_status :: Query +down_m20230926_contact_status = + [sql| +ALTER TABLE contacts DROP COLUMN contact_status; +|] diff --git a/src/Simplex/Chat/Migrations/chat_schema.sql b/src/Simplex/Chat/Migrations/chat_schema.sql index 141247e59..65ceb7d19 100644 --- a/src/Simplex/Chat/Migrations/chat_schema.sql +++ b/src/Simplex/Chat/Migrations/chat_schema.sql @@ -71,6 +71,7 @@ CREATE TABLE contacts( contact_group_member_id INTEGER REFERENCES group_members(group_member_id) ON DELETE SET NULL, contact_grp_inv_sent INTEGER NOT NULL DEFAULT 0, + contact_status TEXT NOT NULL DEFAULT 'active', FOREIGN KEY(user_id, local_display_name) REFERENCES display_names(user_id, local_display_name) ON DELETE CASCADE diff --git a/src/Simplex/Chat/Protocol.hs b/src/Simplex/Chat/Protocol.hs index 6e725e6c2..bbdddf8ce 100644 --- a/src/Simplex/Chat/Protocol.hs +++ b/src/Simplex/Chat/Protocol.hs @@ -215,6 +215,7 @@ data ChatMsgEvent (e :: MsgEncoding) where XFileCancel :: SharedMsgId -> ChatMsgEvent 'Json XInfo :: Profile -> ChatMsgEvent 'Json XContact :: Profile -> Maybe XContactId -> ChatMsgEvent 'Json + XDirectDel :: ChatMsgEvent 'Json XGrpInv :: GroupInvitation -> ChatMsgEvent 'Json XGrpAcpt :: MemberId -> ChatMsgEvent 'Json XGrpMemNew :: MemberInfo -> ChatMsgEvent 'Json @@ -550,6 +551,7 @@ data CMEventTag (e :: MsgEncoding) where XFileCancel_ :: CMEventTag 'Json XInfo_ :: CMEventTag 'Json XContact_ :: CMEventTag 'Json + XDirectDel_ :: CMEventTag 'Json XGrpInv_ :: CMEventTag 'Json XGrpAcpt_ :: CMEventTag 'Json XGrpMemNew_ :: CMEventTag 'Json @@ -596,6 +598,7 @@ instance MsgEncodingI e => StrEncoding (CMEventTag e) where XFileCancel_ -> "x.file.cancel" XInfo_ -> "x.info" XContact_ -> "x.contact" + XDirectDel_ -> "x.direct.del" XGrpInv_ -> "x.grp.inv" XGrpAcpt_ -> "x.grp.acpt" XGrpMemNew_ -> "x.grp.mem.new" @@ -643,6 +646,7 @@ instance StrEncoding ACMEventTag where "x.file.cancel" -> XFileCancel_ "x.info" -> XInfo_ "x.contact" -> XContact_ + "x.direct.del" -> XDirectDel_ "x.grp.inv" -> XGrpInv_ "x.grp.acpt" -> XGrpAcpt_ "x.grp.mem.new" -> XGrpMemNew_ @@ -686,6 +690,7 @@ toCMEventTag msg = case msg of XFileCancel _ -> XFileCancel_ XInfo _ -> XInfo_ XContact _ _ -> XContact_ + XDirectDel -> XDirectDel_ XGrpInv _ -> XGrpInv_ XGrpAcpt _ -> XGrpAcpt_ XGrpMemNew _ -> XGrpMemNew_ @@ -782,6 +787,7 @@ appJsonToCM AppMessageJson {v, msgId, event, params} = do XFileCancel_ -> XFileCancel <$> p "msgId" XInfo_ -> XInfo <$> p "profile" XContact_ -> XContact <$> p "profile" <*> opt "contactReqId" + XDirectDel_ -> pure XDirectDel XGrpInv_ -> XGrpInv <$> p "groupInvitation" XGrpAcpt_ -> XGrpAcpt <$> p "memberId" XGrpMemNew_ -> XGrpMemNew <$> p "memberInfo" @@ -839,6 +845,7 @@ chatToAppMessage ChatMessage {chatVRange, msgId, chatMsgEvent} = case encoding @ XFileCancel sharedMsgId -> o ["msgId" .= sharedMsgId] XInfo profile -> o ["profile" .= profile] XContact profile xContactId -> o $ ("contactReqId" .=? xContactId) ["profile" .= profile] + XDirectDel -> JM.empty XGrpInv groupInv -> o ["groupInvitation" .= groupInv] XGrpAcpt memId -> o ["memberId" .= memId] XGrpMemNew memInfo -> o ["memberInfo" .= memInfo] diff --git a/src/Simplex/Chat/Store/Connections.hs b/src/Simplex/Chat/Store/Connections.hs index 7da0d1ca8..93f3349ca 100644 --- a/src/Simplex/Chat/Store/Connections.hs +++ b/src/Simplex/Chat/Store/Connections.hs @@ -71,19 +71,19 @@ getConnectionEntity db user@User {userId, userContactId} agentConnId = do db [sql| SELECT - c.contact_profile_id, c.local_display_name, p.display_name, p.full_name, p.image, p.contact_link, p.local_alias, c.via_group, c.contact_used, c.enable_ntfs, c.send_rcpts, c.favorite, + c.contact_profile_id, c.local_display_name, p.display_name, p.full_name, p.image, p.contact_link, p.local_alias, c.via_group, 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 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 -> [(ProfileId, ContactName, Text, Text, Maybe ImageData, Maybe ConnReqContact, LocalAlias, Maybe Int64, Bool) :. (Maybe Bool, Maybe Bool, Bool, Maybe Preferences, Preferences, UTCTime, UTCTime, Maybe UTCTime, Maybe GroupMemberId, Bool)] -> Either StoreError Contact - toContact' contactId activeConn [(profileId, localDisplayName, displayName, fullName, image, contactLink, localAlias, viaGroup, contactUsed) :. (enableNtfs_, sendRcpts, favorite, preferences, userPreferences, createdAt, updatedAt, chatTs, contactGroupMemberId, contactGrpInvSent)] = + toContact' :: Int64 -> Connection -> [(ProfileId, ContactName, Text, Text, Maybe ImageData, Maybe ConnReqContact, LocalAlias, Maybe Int64, Bool, ContactStatus) :. (Maybe Bool, Maybe Bool, Bool, Maybe Preferences, Preferences, UTCTime, UTCTime, Maybe UTCTime, Maybe GroupMemberId, Bool)] -> Either StoreError Contact + toContact' contactId activeConn [(profileId, localDisplayName, displayName, fullName, image, contactLink, localAlias, viaGroup, contactUsed, contactStatus) :. (enableNtfs_, sendRcpts, favorite, preferences, userPreferences, createdAt, updatedAt, chatTs, contactGroupMemberId, contactGrpInvSent)] = let profile = LocalProfile {profileId, displayName, fullName, image, contactLink, preferences, localAlias} chatSettings = ChatSettings {enableNtfs = fromMaybe True enableNtfs_, sendRcpts, favorite} mergedPreferences = contactUserPreferences user userPreferences preferences $ connIncognito activeConn - in Right Contact {contactId, localDisplayName, profile, activeConn, viaGroup, contactUsed, chatSettings, userPreferences, mergedPreferences, createdAt, updatedAt, chatTs, contactGroupMemberId, contactGrpInvSent} + in Right Contact {contactId, localDisplayName, profile, activeConn, viaGroup, contactUsed, contactStatus, chatSettings, userPreferences, mergedPreferences, createdAt, updatedAt, chatTs, contactGroupMemberId, contactGrpInvSent} 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 7e8cee0e7..886c73505 100644 --- a/src/Simplex/Chat/Store/Direct.hs +++ b/src/Simplex/Chat/Store/Direct.hs @@ -42,6 +42,7 @@ module Simplex.Chat.Store.Direct deletePCCIncognitoProfile, updateContactUsed, updateContactUnreadChat, + updateContactStatus, updateGroupUnreadChat, setConnectionVerified, incConnectionAuthErrCounter, @@ -147,7 +148,7 @@ getConnReqContactXContactId db user@User {userId} cReqHash = do [sql| 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.enable_ntfs, ct.send_rcpts, ct.favorite, + 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, -- 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.local_alias, @@ -206,7 +207,7 @@ createDirectContact db user@User {userId} activeConn@Connection {connId, localAl let profile = toLocalProfile profileId p localAlias userPreferences = emptyChatPrefs mergedPreferences = contactUserPreferences user userPreferences preferences $ connIncognito activeConn - pure $ Contact {contactId, localDisplayName, profile, activeConn, viaGroup = Nothing, contactUsed = False, chatSettings = defaultChatSettings, userPreferences, mergedPreferences, createdAt, updatedAt = createdAt, chatTs = Just createdAt, contactGroupMemberId = Nothing, contactGrpInvSent = False} + pure $ Contact {contactId, localDisplayName, profile, activeConn, viaGroup = Nothing, contactUsed = False, contactStatus = CSActive, chatSettings = defaultChatSettings, userPreferences, mergedPreferences, createdAt, updatedAt = createdAt, chatTs = Just createdAt, contactGroupMemberId = Nothing, contactGrpInvSent = False} deleteContactConnectionsAndFiles :: DB.Connection -> UserId -> Contact -> IO () deleteContactConnectionsAndFiles db userId Contact {contactId} = do @@ -387,6 +388,19 @@ updateContactUnreadChat db User {userId} Contact {contactId} unreadChat = do updatedAt <- getCurrentTime DB.execute db "UPDATE contacts SET unread_chat = ?, updated_at = ? WHERE user_id = ? AND contact_id = ?" (unreadChat, updatedAt, userId, contactId) +updateContactStatus :: DB.Connection -> User -> Contact -> ContactStatus -> IO Contact +updateContactStatus db User {userId} ct@Contact {contactId} contactStatus = do + currentTs <- getCurrentTime + DB.execute + db + [sql| + UPDATE contacts + SET contact_status = ?, updated_at = ? + WHERE user_id = ? AND contact_id = ? + |] + (contactStatus, currentTs, userId, contactId) + pure ct {contactStatus} + updateGroupUnreadChat :: DB.Connection -> User -> GroupInfo -> Bool -> IO () updateGroupUnreadChat db User {userId} GroupInfo {groupId} unreadChat = do updatedAt <- getCurrentTime @@ -491,7 +505,7 @@ createOrUpdateContactRequest db user@User {userId} userContactLinkId invId (Vers [sql| 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.enable_ntfs, ct.send_rcpts, ct.favorite, + 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, -- 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.local_alias, @@ -637,7 +651,7 @@ createAcceptedContact db user@User {userId, profile = LocalProfile {preferences} contactId <- insertedRowId db activeConn <- createConnection_ db userId ConnContact (Just contactId) agentConnId cReqChatVRange Nothing (Just userContactLinkId) customUserProfileId 0 createdAt subMode let mergedPreferences = contactUserPreferences user userPreferences preferences $ connIncognito activeConn - pure $ Contact {contactId, localDisplayName, profile = toLocalProfile profileId profile "", activeConn, viaGroup = Nothing, contactUsed = False, chatSettings = defaultChatSettings, userPreferences, mergedPreferences, createdAt = createdAt, updatedAt = createdAt, chatTs = Just createdAt, contactGroupMemberId = Nothing, contactGrpInvSent = False} + pure $ Contact {contactId, localDisplayName, profile = toLocalProfile profileId profile "", activeConn, viaGroup = Nothing, contactUsed = False, contactStatus = CSActive, chatSettings = defaultChatSettings, userPreferences, mergedPreferences, createdAt = createdAt, updatedAt = createdAt, chatTs = Just createdAt, contactGroupMemberId = Nothing, contactGrpInvSent = False} getContactIdByName :: DB.Connection -> User -> ContactName -> ExceptT StoreError IO Int64 getContactIdByName db User {userId} cName = @@ -655,7 +669,7 @@ getContact_ db user@User {userId} contactId deleted = [sql| 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.enable_ntfs, ct.send_rcpts, ct.favorite, + 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, -- 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.local_alias, diff --git a/src/Simplex/Chat/Store/Groups.hs b/src/Simplex/Chat/Store/Groups.hs index d6aa3a5b9..e72ca8e8c 100644 --- a/src/Simplex/Chat/Store/Groups.hs +++ b/src/Simplex/Chat/Store/Groups.hs @@ -700,7 +700,7 @@ getContactViaMember db user@User {userId} GroupMember {groupMemberId} = [sql| 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.enable_ntfs, ct.send_rcpts, ct.favorite, + 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, -- 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.local_alias, @@ -1044,7 +1044,7 @@ getViaGroupContact db user@User {userId} GroupMember {groupMemberId} = db [sql| SELECT - ct.contact_id, ct.contact_profile_id, ct.local_display_name, p.display_name, p.full_name, p.image, p.contact_link, p.local_alias, ct.via_group, ct.contact_used, ct.enable_ntfs, ct.send_rcpts, ct.favorite, + ct.contact_id, ct.contact_profile_id, ct.local_display_name, p.display_name, p.full_name, p.image, p.contact_link, p.local_alias, ct.via_group, ct.contact_used, ct.contact_status, ct.enable_ntfs, ct.send_rcpts, ct.favorite, p.preferences, ct.user_preferences, ct.created_at, ct.updated_at, ct.chat_ts, ct.contact_group_member_id, ct.contact_grp_inv_sent, 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.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.auth_err_counter, @@ -1062,13 +1062,13 @@ getViaGroupContact db user@User {userId} GroupMember {groupMemberId} = |] (userId, groupMemberId) where - toContact' :: ((ContactId, ProfileId, ContactName, Text, Text, Maybe ImageData, Maybe ConnReqContact, LocalAlias, Maybe Int64, Bool) :. (Maybe Bool, Maybe Bool, Bool, Maybe Preferences, Preferences, UTCTime, UTCTime, Maybe UTCTime, Maybe GroupMemberId, Bool)) :. ConnectionRow -> Contact - toContact' (((contactId, profileId, localDisplayName, displayName, fullName, image, contactLink, localAlias, viaGroup, contactUsed) :. (enableNtfs_, sendRcpts, favorite, preferences, userPreferences, createdAt, updatedAt, chatTs, contactGroupMemberId, contactGrpInvSent)) :. connRow) = + toContact' :: ((ContactId, ProfileId, ContactName, Text, Text, Maybe ImageData, Maybe ConnReqContact, LocalAlias, Maybe Int64, Bool, ContactStatus) :. (Maybe Bool, Maybe Bool, Bool, Maybe Preferences, Preferences, UTCTime, UTCTime, Maybe UTCTime, Maybe GroupMemberId, Bool)) :. ConnectionRow -> Contact + toContact' (((contactId, profileId, localDisplayName, displayName, fullName, image, contactLink, localAlias, viaGroup, contactUsed, contactStatus) :. (enableNtfs_, sendRcpts, favorite, preferences, userPreferences, createdAt, updatedAt, chatTs, contactGroupMemberId, contactGrpInvSent)) :. connRow) = let profile = LocalProfile {profileId, displayName, fullName, image, contactLink, preferences, localAlias} chatSettings = ChatSettings {enableNtfs = fromMaybe True enableNtfs_, sendRcpts, favorite} activeConn = toConnection connRow mergedPreferences = contactUserPreferences user userPreferences preferences $ connIncognito activeConn - in Contact {contactId, localDisplayName, profile, activeConn, viaGroup, contactUsed, chatSettings, userPreferences, mergedPreferences, createdAt, updatedAt, chatTs, contactGroupMemberId, contactGrpInvSent} + in Contact {contactId, localDisplayName, profile, activeConn, viaGroup, contactUsed, contactStatus, chatSettings, userPreferences, mergedPreferences, createdAt, updatedAt, chatTs, contactGroupMemberId, contactGrpInvSent} updateGroupProfile :: DB.Connection -> User -> GroupInfo -> GroupProfile -> ExceptT StoreError IO GroupInfo updateGroupProfile db User {userId} g@GroupInfo {groupId, localDisplayName, groupProfile = GroupProfile {displayName}} p'@GroupProfile {displayName = newName, fullName, description, image, groupPreferences} @@ -1160,8 +1160,8 @@ getMatchingContacts :: DB.Connection -> User -> Contact -> IO [Contact] getMatchingContacts db user@User {userId} Contact {contactId, profile = LocalProfile {displayName, fullName, image}} = do contactIds <- map fromOnly <$> case image of - Just img -> DB.query db (q <> " AND p.image = ?") (userId, contactId, displayName, fullName, img) - Nothing -> DB.query db (q <> " AND p.image is NULL") (userId, contactId, displayName, fullName) + Just img -> DB.query db (q <> " AND p.image = ?") (userId, contactId, CSActive, displayName, fullName, img) + Nothing -> DB.query db (q <> " AND p.image is NULL") (userId, contactId, CSActive, displayName, fullName) rights <$> mapM (runExceptT . getContact db user) contactIds where -- this query is different from one in getMatchingMemberContacts @@ -1172,7 +1172,7 @@ getMatchingContacts db user@User {userId} Contact {contactId, profile = LocalPro FROM contacts ct JOIN contact_profiles p ON ct.contact_profile_id = p.contact_profile_id WHERE ct.user_id = ? AND ct.contact_id != ? - AND ct.deleted = 0 + AND ct.contact_status = ? AND ct.deleted = 0 AND p.display_name = ? AND p.full_name = ? |] @@ -1521,7 +1521,7 @@ createMemberContact connId <- insertedRowId db let ctConn = Connection {connId, agentConnId = AgentConnId acId, peerChatVRange, connType = ConnContact, entityId = Just contactId, viaContact = Nothing, viaUserContactLink = Nothing, viaGroupLink = False, groupLinkId = Nothing, customUserProfileId, connLevel, connStatus = ConnNew, localAlias = "", createdAt = currentTs, connectionCode = Nothing, authErrCounter = 0} mergedPreferences = contactUserPreferences user userPreferences preferences $ connIncognito ctConn - pure Contact {contactId, localDisplayName, profile = memberProfile, activeConn = ctConn, viaGroup = Nothing, contactUsed = True, chatSettings = defaultChatSettings, userPreferences, mergedPreferences, createdAt = currentTs, updatedAt = currentTs, chatTs = Just currentTs, contactGroupMemberId = Just groupMemberId, contactGrpInvSent = False} + pure Contact {contactId, localDisplayName, profile = memberProfile, activeConn = ctConn, viaGroup = Nothing, contactUsed = True, contactStatus = CSActive, chatSettings = defaultChatSettings, userPreferences, mergedPreferences, createdAt = currentTs, updatedAt = currentTs, chatTs = Just currentTs, contactGroupMemberId = Just groupMemberId, contactGrpInvSent = False} getMemberContact :: DB.Connection -> User -> ContactId -> ExceptT StoreError IO (GroupInfo, GroupMember, Contact, ConnReqInvitation) getMemberContact db user contactId = do @@ -1558,7 +1558,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 = ctConn, viaGroup = Nothing, contactUsed = True, chatSettings = defaultChatSettings, userPreferences, mergedPreferences, createdAt = currentTs, updatedAt = currentTs, chatTs = Just currentTs, contactGroupMemberId = Nothing, contactGrpInvSent = False} + mCt' = Contact {contactId, localDisplayName = memberLDN, profile = memberProfile, activeConn = ctConn, viaGroup = Nothing, contactUsed = True, contactStatus = CSActive, chatSettings = defaultChatSettings, userPreferences, mergedPreferences, createdAt = currentTs, updatedAt = currentTs, chatTs = Just currentTs, contactGroupMemberId = Nothing, contactGrpInvSent = False} m' = m {memberContactId = Just contactId} pure (mCt', m') where @@ -1586,8 +1586,9 @@ updateMemberContactInvited :: DB.Connection -> User -> (CommandId, ConnId) -> Gr updateMemberContactInvited db user connIds gInfo mConn ct@Contact {contactId, activeConn = oldContactConn} subMode = do updateConnectionStatus db oldContactConn ConnDeleted activeConn <- createMemberContactConn_ db user connIds gInfo mConn contactId subMode - ct' <- resetMemberContactFields db ct - pure (ct' :: Contact) {activeConn} + ct' <- updateContactStatus db user ct CSActive + ct'' <- resetMemberContactFields db ct' + pure (ct'' :: Contact) {activeConn} resetMemberContactFields :: DB.Connection -> Contact -> IO Contact resetMemberContactFields db ct@Contact {contactId} = do diff --git a/src/Simplex/Chat/Store/Messages.hs b/src/Simplex/Chat/Store/Messages.hs index c08e6b11d..458944b6e 100644 --- a/src/Simplex/Chat/Store/Messages.hs +++ b/src/Simplex/Chat/Store/Messages.hs @@ -478,7 +478,7 @@ getDirectChatPreviews_ db user@User {userId} = do [sql| 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.enable_ntfs, ct.send_rcpts, ct.favorite, + 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, -- 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.local_alias, diff --git a/src/Simplex/Chat/Store/Migrations.hs b/src/Simplex/Chat/Store/Migrations.hs index d8bab817e..2f5bfec9e 100644 --- a/src/Simplex/Chat/Store/Migrations.hs +++ b/src/Simplex/Chat/Store/Migrations.hs @@ -81,6 +81,7 @@ import Simplex.Chat.Migrations.M20230829_connections_chat_vrange import Simplex.Chat.Migrations.M20230903_connections_to_subscribe import Simplex.Chat.Migrations.M20230913_member_contacts import Simplex.Chat.Migrations.M20230914_member_probes +import Simplex.Chat.Migrations.M20230926_contact_status import Simplex.Messaging.Agent.Store.SQLite.Migrations (Migration (..)) schemaMigrations :: [(String, Query, Maybe Query)] @@ -161,7 +162,8 @@ schemaMigrations = ("20230829_connections_chat_vrange", m20230829_connections_chat_vrange, Just down_m20230829_connections_chat_vrange), ("20230903_connections_to_subscribe", m20230903_connections_to_subscribe, Just down_m20230903_connections_to_subscribe), ("20230913_member_contacts", m20230913_member_contacts, Just down_m20230913_member_contacts), - ("20230914_member_probes", m20230914_member_probes, Just down_m20230914_member_probes) + ("20230914_member_probes", m20230914_member_probes, Just down_m20230914_member_probes), + ("20230926_contact_status", m20230926_contact_status, Just down_m20230926_contact_status) ] -- | 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 e979c9006..4dc4f6e82 100644 --- a/src/Simplex/Chat/Store/Shared.hs +++ b/src/Simplex/Chat/Store/Shared.hs @@ -241,24 +241,24 @@ deleteUnusedIncognitoProfileById_ db User {userId} profileId = |] [":user_id" := userId, ":profile_id" := profileId] -type ContactRow = (ContactId, ProfileId, ContactName, Maybe Int64, ContactName, Text, Maybe ImageData, Maybe ConnReqContact, LocalAlias, Bool) :. (Maybe Bool, Maybe Bool, Bool, Maybe Preferences, Preferences, UTCTime, UTCTime, Maybe UTCTime, Maybe GroupMemberId, Bool) +type ContactRow = (ContactId, ProfileId, ContactName, Maybe Int64, ContactName, Text, Maybe ImageData, Maybe ConnReqContact, LocalAlias, Bool, ContactStatus) :. (Maybe Bool, Maybe Bool, Bool, Maybe Preferences, Preferences, UTCTime, UTCTime, Maybe UTCTime, Maybe GroupMemberId, Bool) toContact :: User -> ContactRow :. ConnectionRow -> Contact -toContact user (((contactId, profileId, localDisplayName, viaGroup, displayName, fullName, image, contactLink, localAlias, contactUsed) :. (enableNtfs_, sendRcpts, favorite, preferences, userPreferences, createdAt, updatedAt, chatTs, contactGroupMemberId, contactGrpInvSent)) :. connRow) = +toContact user (((contactId, profileId, localDisplayName, viaGroup, displayName, fullName, image, contactLink, localAlias, contactUsed, contactStatus) :. (enableNtfs_, sendRcpts, favorite, preferences, userPreferences, createdAt, updatedAt, chatTs, contactGroupMemberId, contactGrpInvSent)) :. connRow) = let profile = LocalProfile {profileId, displayName, fullName, image, contactLink, preferences, localAlias} activeConn = toConnection connRow chatSettings = ChatSettings {enableNtfs = fromMaybe True enableNtfs_, sendRcpts, favorite} mergedPreferences = contactUserPreferences user userPreferences preferences $ connIncognito activeConn - in Contact {contactId, localDisplayName, profile, activeConn, viaGroup, contactUsed, chatSettings, userPreferences, mergedPreferences, createdAt, updatedAt, chatTs, contactGroupMemberId, contactGrpInvSent} + in Contact {contactId, localDisplayName, profile, activeConn, viaGroup, contactUsed, contactStatus, chatSettings, userPreferences, mergedPreferences, createdAt, updatedAt, chatTs, contactGroupMemberId, contactGrpInvSent} toContactOrError :: User -> ContactRow :. MaybeConnectionRow -> Either StoreError Contact -toContactOrError user (((contactId, profileId, localDisplayName, viaGroup, displayName, fullName, image, contactLink, localAlias, contactUsed) :. (enableNtfs_, sendRcpts, favorite, preferences, userPreferences, createdAt, updatedAt, chatTs, contactGroupMemberId, contactGrpInvSent)) :. connRow) = +toContactOrError user (((contactId, profileId, localDisplayName, viaGroup, displayName, fullName, image, contactLink, localAlias, contactUsed, contactStatus) :. (enableNtfs_, sendRcpts, favorite, preferences, userPreferences, createdAt, updatedAt, chatTs, contactGroupMemberId, contactGrpInvSent)) :. connRow) = let profile = LocalProfile {profileId, displayName, fullName, image, contactLink, preferences, localAlias} chatSettings = ChatSettings {enableNtfs = fromMaybe True enableNtfs_, sendRcpts, favorite} in case toMaybeConnection connRow of Just activeConn -> let mergedPreferences = contactUserPreferences user userPreferences preferences $ connIncognito activeConn - in Right Contact {contactId, localDisplayName, profile, activeConn, viaGroup, contactUsed, chatSettings, userPreferences, mergedPreferences, createdAt, updatedAt, chatTs, contactGroupMemberId, contactGrpInvSent} + in Right Contact {contactId, localDisplayName, profile, activeConn, viaGroup, contactUsed, contactStatus, chatSettings, userPreferences, mergedPreferences, createdAt, updatedAt, chatTs, contactGroupMemberId, contactGrpInvSent} _ -> Left $ SEContactNotReady localDisplayName getProfileById :: DB.Connection -> UserId -> Int64 -> ExceptT StoreError IO LocalProfile diff --git a/src/Simplex/Chat/Types.hs b/src/Simplex/Chat/Types.hs index 93964316c..43265671b 100644 --- a/src/Simplex/Chat/Types.hs +++ b/src/Simplex/Chat/Types.hs @@ -169,6 +169,7 @@ data Contact = Contact activeConn :: Connection, viaGroup :: Maybe Int64, contactUsed :: Bool, + contactStatus :: ContactStatus, chatSettings :: ChatSettings, userPreferences :: Preferences, mergedPreferences :: ContactUserPreferences, @@ -185,7 +186,7 @@ instance ToJSON Contact where toEncoding = J.genericToEncoding J.defaultOptions {J.omitNothingFields = True} contactConn :: Contact -> Connection -contactConn Contact{activeConn} = activeConn +contactConn Contact {activeConn} = activeConn contactConnId :: Contact -> ConnId contactConnId = aConnId . contactConn @@ -205,9 +206,34 @@ directOrUsed ct@Contact {contactUsed} = anyDirectOrUsed :: Contact -> Bool anyDirectOrUsed Contact {contactUsed, activeConn = Connection {connLevel}} = connLevel == 0 || contactUsed +contactActive :: Contact -> Bool +contactActive Contact {contactStatus} = contactStatus == CSActive + contactSecurityCode :: Contact -> Maybe SecurityCode contactSecurityCode Contact {activeConn} = connectionCode activeConn +data ContactStatus + = CSActive + | CSDeleted -- contact deleted by contact + deriving (Eq, Show, Ord) + +instance FromField ContactStatus where fromField = fromTextField_ textDecode + +instance ToField ContactStatus where toField = toField . textEncode + +instance ToJSON ContactStatus where + toJSON = J.String . textEncode + toEncoding = JE.text . textEncode + +instance TextEncoding ContactStatus where + textDecode = \case + "active" -> Just CSActive + "deleted" -> Just CSDeleted + _ -> Nothing + textEncode = \case + CSActive -> "active" + CSDeleted -> "deleted" + data ContactRef = ContactRef { contactId :: ContactId, connId :: Int64, diff --git a/src/Simplex/Chat/View.hs b/src/Simplex/Chat/View.hs index 5db0c317e..01bdfba95 100644 --- a/src/Simplex/Chat/View.hs +++ b/src/Simplex/Chat/View.hs @@ -151,6 +151,7 @@ responseToView user_ ChatConfig {logLevel, showReactions, showReceipts, testView CRSentConfirmation u -> ttyUser u ["confirmation sent!"] CRSentInvitation u customUserProfile -> ttyUser u $ viewSentInvitation customUserProfile testView CRContactDeleted u c -> ttyUser u [ttyContact' c <> ": contact is deleted"] + CRContactDeletedByContact u c -> ttyUser u [ttyFullContact c <> " deleted contact with you"] CRChatCleared u chatInfo -> ttyUser u $ viewChatCleared chatInfo CRAcceptingContactRequest u c -> ttyUser u [ttyFullContact c <> ": accepting contact request..."] CRContactAlreadyExists u c -> ttyUser u [ttyFullContact c <> ": contact already exists"] @@ -1567,6 +1568,7 @@ viewChatError logLevel = \case ] CEContactNotFound cName m_ -> viewContactNotFound cName m_ CEContactNotReady c -> [ttyContact' c <> ": not ready"] + CEContactNotActive c -> [ttyContact' c <> ": not active"] CEContactDisabled Contact {localDisplayName = c} -> [ttyContact c <> ": disabled, to enable: " <> highlight ("/enable " <> c) <> ", to delete: " <> highlight ("/d " <> c)] CEConnectionDisabled Connection {connId, connType} -> [plain $ "connection " <> textEncode connType <> " (" <> tshow connId <> ") is disabled" | logLevel <= CLLWarning] CEGroupDuplicateMember c -> ["contact " <> ttyContact c <> " is already in the group"] diff --git a/tests/ChatTests/Direct.hs b/tests/ChatTests/Direct.hs index 7dbff89a2..36e74e11f 100644 --- a/tests/ChatTests/Direct.hs +++ b/tests/ChatTests/Direct.hs @@ -156,11 +156,12 @@ testAddContact = versionTestMatrix2 runTestAddContact -- test deleting contact alice ##> "/d bob_1" alice <## "bob_1: contact is deleted" + bob <## "alice_1 (Alice) deleted contact with you" alice ##> "@bob_1 hey" alice <## "no contact bob_1" alice @@@ [("@bob", "how are you?")] alice `hasContactProfiles` ["alice", "bob"] - bob @@@ [("@alice_1", "hi"), ("@alice", "how are you?")] + bob @@@ [("@alice_1", "contact deleted"), ("@alice", "how are you?")] bob `hasContactProfiles` ["alice", "alice", "bob"] -- test clearing chat alice #$> ("/clear bob", id, "bob: all messages are removed locally ONLY") @@ -202,6 +203,7 @@ testDeleteContactDeletesProfile = -- alice deletes contact, profile is deleted alice ##> "/d bob" alice <## "bob: contact is deleted" + bob <## "alice (Alice) deleted contact with you" alice ##> "/_contacts 1" (alice bob threadDelay 500000 - bob ##> "/d alice" + bob ##> "/_delete @2 notify=off" bob <## "alice: contact is deleted" forM_ [1 .. authErrDisableCount] $ \_ -> sendAuth alice alice <## "[bob] connection is disabled, to enable: /enable bob, to delete: /d bob" diff --git a/tests/ChatTests/Files.hs b/tests/ChatTests/Files.hs index f84d4dcb4..50f86d8e0 100644 --- a/tests/ChatTests/Files.hs +++ b/tests/ChatTests/Files.hs @@ -575,6 +575,7 @@ testSendImage = -- deleting contact without files folder set should not remove file bob ##> "/d alice" bob <## "alice: contact is deleted" + alice <## "bob (Bob) deleted contact with you" fileExists <- doesFileExist "./tests/tmp/test.jpg" fileExists `shouldBe` True @@ -637,6 +638,7 @@ testFilesFoldersSendImage = checkActionDeletesFile "./tests/tmp/app_files/test.jpg" $ do bob ##> "/d alice" bob <## "alice: contact is deleted" + alice <## "bob (Bob) deleted contact with you" testFilesFoldersImageSndDelete :: HasCallStack => FilePath -> IO () testFilesFoldersImageSndDelete = @@ -660,6 +662,7 @@ testFilesFoldersImageSndDelete = checkActionDeletesFile "./tests/tmp/alice_app_files/test_1MB.pdf" $ do alice ##> "/d bob" alice <## "bob: contact is deleted" + bob <## "alice (Alice) deleted contact with you" bob ##> "/fs 1" bob <##. "receiving file 1 (test_1MB.pdf) progress" -- deleting contact should remove cancelled file @@ -689,7 +692,10 @@ testFilesFoldersImageRcvDelete = checkActionDeletesFile "./tests/tmp/app_files/test.jpg" $ do bob ##> "/d alice" bob <## "alice: contact is deleted" - alice <## "bob cancelled receiving file 1 (test.jpg)" + alice + <### [ "bob (Bob) deleted contact with you", + "bob cancelled receiving file 1 (test.jpg)" + ] alice ##> "/fs 1" alice <## "sending file 1 (test.jpg) cancelled: bob" alice <## "file transfer cancelled" diff --git a/tests/ChatTests/Groups.hs b/tests/ChatTests/Groups.hs index bf740a960..4280810ca 100644 --- a/tests/ChatTests/Groups.hs +++ b/tests/ChatTests/Groups.hs @@ -220,6 +220,7 @@ testGroupShared alice bob cath checkMessages = do -- delete contact alice ##> "/d bob" alice <## "bob: contact is deleted" + bob <## "alice (Alice) deleted contact with you" alice `send` "@bob hey" alice <### [ "@bob hey", @@ -234,7 +235,7 @@ testGroupShared alice bob cath checkMessages = do alice <# "#team bob> received" when checkMessages $ do alice @@@ [("@cath", "sent invitation to join group team as admin"), ("#team", "received")] - bob @@@ [("@alice", "received invitation to join group team as admin"), ("@cath", "hey"), ("#team", "received")] + bob @@@ [("@alice", "contact deleted"), ("@cath", "hey"), ("#team", "received")] -- test clearing chat threadDelay 1000000 alice #$> ("/clear #team", id, "#team: all messages are removed locally ONLY") @@ -629,6 +630,7 @@ testGroupDeleteInvitedContact = threadDelay 500000 alice ##> "/d bob" alice <## "bob: contact is deleted" + bob <## "alice (Alice) deleted contact with you" bob ##> "/j team" concurrently_ (alice <## "#team: bob joined the group") @@ -700,10 +702,11 @@ testDeleteGroupMemberProfileKept = -- delete contact alice ##> "/d bob" alice <## "bob: contact is deleted" + bob <## "alice (Alice) deleted contact with you" alice ##> "@bob hey" alice <## "no contact bob, use @#club bob " - bob #> "@alice hey" - bob <## "[alice, contactId: 2, connId: 1] error: connection authorization failed - this could happen if connection was deleted, secured with different credentials, or due to a bug - please re-create the connection" + bob ##> "@alice hey" + bob <## "alice: not ready" (alice "/d #team" @@ -2785,6 +2788,8 @@ testMemberContactMessage = -- alice and bob delete contacts, connect alice ##> "/d bob" alice <## "bob: contact is deleted" + bob <## "alice (Alice) deleted contact with you" + bob ##> "/d alice" bob <## "alice: contact is deleted" @@ -2893,6 +2898,7 @@ testMemberContactInvitedConnectionReplaced tmp = do alice ##> "/d bob" alice <## "bob: contact is deleted" + bob <## "alice (Alice) deleted contact with you" alice ##> "@#team bob hi" alice @@ -2910,7 +2916,7 @@ testMemberContactInvitedConnectionReplaced tmp = do (alice <## "bob (Bob): contact is connected") (bob <## "alice (Alice): contact is connected") - bob #$> ("/_get chat @2 count=100", chat, chatFeatures <> [(0, "received invitation to join group team as admin"), (0, "hi"), (0, "security code changed")] <> chatFeatures) + bob #$> ("/_get chat @2 count=100", chat, chatFeatures <> [(0, "received invitation to join group team as admin"), (0, "contact deleted"), (0, "hi"), (0, "security code changed")] <> chatFeatures) withTestChat tmp "bob" $ \bob -> do subscriptions bob 1 diff --git a/tests/ChatTests/Profiles.hs b/tests/ChatTests/Profiles.hs index 1a2b74f76..44af70a65 100644 --- a/tests/ChatTests/Profiles.hs +++ b/tests/ChatTests/Profiles.hs @@ -558,6 +558,7 @@ testConnectIncognitoInvitationLink = testChat3 aliceProfile bobProfile cathProfi -- alice deletes contact, incognito profile is deleted alice ##> ("/d " <> bobIncognito) alice <## (bobIncognito <> ": contact is deleted") + bob <## (aliceIncognito <> " deleted contact with you") alice ##> "/contacts" alice <## "cath (Catherine)" alice `hasContactProfiles` ["alice", "cath"] @@ -601,6 +602,7 @@ testConnectIncognitoContactAddress = testChat2 aliceProfile bobProfile $ -- delete contact, incognito profile is deleted bob ##> "/d alice" bob <## "alice: contact is deleted" + alice <## (bobIncognito <> " deleted contact with you") bob ##> "/contacts" (bob "/d bob" alice <## "bob: contact is deleted" + bob <## (aliceIncognitoBob <> " deleted contact with you") alice ##> "/contacts" (alice "/d alice" bob <## "alice: contact is deleted" + alice <## (bobIncognito <> " deleted contact with you") bob ##> "/contacts" (bob "/d alice" bob <## "alice: contact is deleted" + alice <## (bobIncognito <> " deleted contact with you") bob ##> "/contacts" (bob