core: fully delete direct chat items; clear chat API (#658)

2024-12-17 17:20:21 +01:00 · 2022-05-17 11:22:09 +04:00
parent 82445ec8d5
commit 84bf815e5c
6 changed files with 255 additions and 96 deletions
@@ -109,6 +109,7 @@ data ChatCommand
  | APIDeleteChatItem ChatRef ChatItemId CIDeleteMode
  | APIChatRead ChatRef (Maybe (ChatItemId, ChatItemId))
  | APIDeleteChat ChatRef
+  | APIClearChat ChatRef
  | APIAcceptContact Int64
  | APIRejectContact Int64
  | APISendCallInvitation ContactId CallType
@@ -132,6 +133,7 @@ data ChatCommand
  | Connect (Maybe AConnectionRequestUri)
  | ConnectSimplex
  | DeleteContact ContactName
+  | ClearContact ContactName
  | ListContacts
  | CreateMyAddress
  | DeleteMyAddress
@@ -151,6 +153,7 @@ data ChatCommand
  | MemberRole GroupName ContactName GroupMemberRole
  | LeaveGroup GroupName
  | DeleteGroup GroupName
+  | ClearGroup GroupName
  | ListMembers GroupName
  | ListGroups
  | SendGroupMessageQuote {groupName :: GroupName, contactName_ :: Maybe ContactName, quotedMsg :: ByteString, message :: ByteString}
@@ -179,6 +182,7 @@ data ChatResponse
  | CRChatItemStatusUpdated {chatItem :: AChatItem}
  | CRChatItemUpdated {chatItem :: AChatItem}
  | CRChatItemDeleted {deletedChatItem :: AChatItem, toChatItem :: AChatItem}
+  | CRChatItemDeletedNotFound {contact :: Contact, sharedMsgId :: SharedMsgId}
  | CRBroadcastSent MsgContent Int ZonedTime
  | CRMsgIntegrityError {msgerror :: MsgErrorType} -- TODO make it chat item to support in mobile
  | CRCmdAccepted {corr :: CorrId}
@@ -205,6 +209,7 @@ data ChatResponse
  | CRContactUpdated {fromContact :: Contact, toContact :: Contact}
  | CRContactsMerged {intoContact :: Contact, mergedContact :: Contact}
  | CRContactDeleted {contact :: Contact}
+  | CRChatCleared {chatInfo :: AChatInfo}
  | CRUserContactLinkCreated {connReqContact :: ConnReqContact}
  | CRUserContactLinkDeleted
  | CRReceivedContactRequest {contactRequest :: UserContactRequest}
@@ -82,6 +82,14 @@ jsonChatInfo = \case
  ContactRequest g -> JCInfoContactRequest g
  ContactConnection c -> JCInfoContactConnection c

+data AChatInfo = forall c. AChatInfo (SChatType c) (ChatInfo c)
+
+deriving instance Show AChatInfo
+
+instance ToJSON AChatInfo where
+  toJSON (AChatInfo _ c) = J.toJSON c
+  toEncoding (AChatInfo _ c) = J.toEncoding c
+
 data ChatItem (c :: ChatType) (d :: MsgDirection) = ChatItem
  { chatDir :: CIDirection c d,
    meta :: CIMeta d,
@@ -363,6 +371,13 @@ instance StrEncoding ACIFileStatus where
      "rcv_cancelled" -> pure $ AFS SMDRcv CIFSRcvCancelled
      _ -> fail "bad file status"

+-- to conveniently read file data from db
+data CIFileInfo = CIFileInfo
+  { fileId :: Int64,
+    fileStatus :: ACIFileStatus,
+    filePath :: Maybe FilePath
+  }
+
 data CIStatus (d :: MsgDirection) where
  CISSndNew :: CIStatus 'MDSnd
  CISSndSent :: CIStatus 'MDSnd
@@ -116,7 +116,9 @@ module Simplex.Chat.Store
    getFileTransfer,
    getFileTransferProgress,
    getSndFileTransfer,
-    getContactFiles,
+    getContactFileInfo,
+    getContactChatItemIdsAndFileInfo,
+    getGroupChatItemIdsAndFileInfo,
    createNewSndMessage,
    createSndMsgDelivery,
    createNewMessageAndRcvMsgDelivery,
@@ -143,9 +145,8 @@ module Simplex.Chat.Store
    updateDirectChatItemStatus,
    updateDirectCIFileStatus,
    updateDirectChatItem,
-    deleteDirectChatItemInternal,
+    deleteDirectChatItemLocal,
    deleteDirectChatItemRcvBroadcast,
-    deleteDirectChatItemSndBroadcast,
    updateGroupChatItem,
    deleteGroupChatItemInternal,
    deleteGroupChatItemRcvBroadcast,
@@ -2280,18 +2281,56 @@ getFileTransferMeta_ db userId fileId =
    fileTransferMeta (fileName, fileSize, chunkSize, filePath, cancelled_) =
      FileTransferMeta {fileId, fileName, filePath, fileSize, chunkSize, cancelled = fromMaybe False cancelled_}

-getContactFiles :: MonadUnliftIO m => SQLiteStore -> UserId -> Contact -> m [(Int64, ACIFileStatus, Maybe FilePath)]
-getContactFiles st userId Contact {contactId} =
+getContactFileInfo :: MonadUnliftIO m => SQLiteStore -> UserId -> Contact -> m [CIFileInfo]
+getContactFileInfo st userId Contact {contactId} =
  liftIO . withTransaction st $ \db ->
-    DB.query
-      db
-      [sql|
+    map toFileInfo
+      <$> DB.query
+        db
+        [sql|
        SELECT f.file_id, f.ci_file_status, f.file_path
        FROM chat_items i
        JOIN files f ON f.chat_item_id = i.chat_item_id
        WHERE i.user_id = ? AND i.contact_id = ?
      |]
-      (userId, contactId)
+        (userId, contactId)
+
+toFileInfo :: (Int64, ACIFileStatus, Maybe FilePath) -> CIFileInfo
+toFileInfo (fileId, fileStatus, filePath) = CIFileInfo {fileId, fileStatus, filePath}
+
+getContactChatItemIdsAndFileInfo :: MonadUnliftIO m => SQLiteStore -> UserId -> ContactId -> m [(ChatItemId, Maybe CIFileInfo)]
+getContactChatItemIdsAndFileInfo st userId contactId =
+  liftIO . withTransaction st $ \db ->
+    map toItemIdAndFileInfo
+      <$> DB.query
+        db
+        [sql|
+          SELECT i.chat_item_id, f.file_id, f.ci_file_status, f.file_path
+          FROM chat_items i
+          LEFT JOIN files f ON f.chat_item_id = i.chat_item_id
+          WHERE i.user_id = ? AND i.contact_id = ?
+        |]
+        (userId, contactId)
+
+getGroupChatItemIdsAndFileInfo :: MonadUnliftIO m => SQLiteStore -> UserId -> Int64 -> m [(ChatItemId, Maybe CIFileInfo)]
+getGroupChatItemIdsAndFileInfo st userId groupId =
+  liftIO . withTransaction st $ \db ->
+    map toItemIdAndFileInfo
+      <$> DB.query
+        db
+        [sql|
+          SELECT i.chat_item_id, f.file_id, f.ci_file_status, f.file_path
+          FROM chat_items i
+          LEFT JOIN files f ON f.chat_item_id = i.chat_item_id
+          WHERE i.user_id = ? AND i.group_id = ?
+        |]
+        (userId, groupId)
+
+toItemIdAndFileInfo :: (ChatItemId, Maybe Int64, Maybe ACIFileStatus, Maybe FilePath) -> (ChatItemId, Maybe CIFileInfo)
+toItemIdAndFileInfo (chatItemId, fileId_, fileStatus_, filePath) =
+  case (fileId_, fileStatus_) of
+    (Just fileId, Just fileStatus) -> (chatItemId, Just CIFileInfo {fileId, fileStatus, filePath})
+    _ -> (chatItemId, Nothing)

 createNewSndMessage :: StoreMonad m => SQLiteStore -> TVar ChaChaDRG -> ConnOrGroupId -> (SharedMsgId -> NewMessage) -> m SndMessage
 createNewSndMessage st gVar connOrGroupId mkMessage =
@@ -2449,8 +2488,8 @@ createNewSndChatItem st user chatDirection SndMessage {msgId, sharedMsgId} ciCon
          CIQGroupRcv (Just GroupMember {memberId}) -> (Just False, Just memberId)
          CIQGroupRcv Nothing -> (Just False, Nothing)

-createNewRcvChatItem :: MonadUnliftIO m => SQLiteStore -> User -> ChatDirection c 'MDRcv -> RcvMessage -> CIContent 'MDRcv -> UTCTime -> UTCTime -> m (ChatItemId, Maybe (CIQuote c))
-createNewRcvChatItem st user chatDirection RcvMessage {msgId, chatMsgEvent, sharedMsgId_} ciContent itemTs createdAt =
+createNewRcvChatItem :: MonadUnliftIO m => SQLiteStore -> User -> ChatDirection c 'MDRcv -> RcvMessage -> Maybe SharedMsgId -> CIContent 'MDRcv -> UTCTime -> UTCTime -> m (ChatItemId, Maybe (CIQuote c))
+createNewRcvChatItem st user chatDirection RcvMessage {msgId, chatMsgEvent} sharedMsgId_ ciContent itemTs createdAt =
  liftIO . withTransaction st $ \db -> do
    ciId <- createNewChatItem_ db user chatDirection (Just msgId) sharedMsgId_ ciContent quoteRow itemTs createdAt
    quotedItem <- mapM (getChatItemQuote_ db user chatDirection) quotedMsg
@@ -3229,13 +3268,39 @@ updateDirectChatItem_ db userId contactId itemId newContent currentTs = runExcep
    correctDir :: CChatItem c -> Either StoreError (ChatItem c d)
    correctDir (CChatItem _ ci) = first SEInternalError $ checkDirection ci

-deleteDirectChatItemInternal :: StoreMonad m => SQLiteStore -> UserId -> Contact -> ChatItemId -> m AChatItem
-deleteDirectChatItemInternal st userId ct itemId =
+deleteDirectChatItemLocal :: StoreMonad m => SQLiteStore -> UserId -> Contact -> ChatItemId -> CIDeleteMode -> m AChatItem
+deleteDirectChatItemLocal st userId ct itemId mode =
  liftIOEither . withTransaction st $ \db -> do
-    currentTs <- liftIO getCurrentTime
-    ci <- deleteDirectChatItem_ db userId ct itemId CIDMInternal True currentTs
-    setChatItemMessagesDeleted_ db itemId
-    pure ci
+    deleteChatItemMessages_ db itemId
+    deleteDirectChatItem_ db userId ct itemId mode
+
+deleteDirectChatItem_ :: DB.Connection -> UserId -> Contact -> ChatItemId -> CIDeleteMode -> IO (Either StoreError AChatItem)
+deleteDirectChatItem_ db userId ct@Contact {contactId} itemId mode = runExceptT $ do
+  (CChatItem msgDir ci) <- ExceptT $ getDirectChatItem_ db userId contactId itemId
+  let toContent = msgDirToDeletedContent_ msgDir mode
+  liftIO $ do
+    DB.execute
+      db
+      [sql|
+        DELETE FROM chat_items
+        WHERE user_id = ? AND contact_id = ? AND chat_item_id = ?
+      |]
+      (userId, contactId, itemId)
+  pure $ AChatItem SCTDirect msgDir (DirectChat ct) (ci {content = toContent, meta = (meta ci) {itemText = ciDeleteModeToText mode, itemDeleted = True}, formattedText = Nothing})
+
+deleteChatItemMessages_ :: DB.Connection -> ChatItemId -> IO ()
+deleteChatItemMessages_ db itemId =
+  DB.execute
+    db
+    [sql|
+      DELETE FROM messages
+      WHERE message_id IN (
+        SELECT message_id
+        FROM chat_item_messages
+        WHERE chat_item_id = ?
+      )
+    |]
+    (Only itemId)

 setChatItemMessagesDeleted_ :: DB.Connection -> ChatItemId -> IO ()
 setChatItemMessagesDeleted_ db itemId =
@@ -3256,38 +3321,26 @@ setChatItemMessagesDeleted_ db itemId =

 deleteDirectChatItemRcvBroadcast :: StoreMonad m => SQLiteStore -> UserId -> Contact -> ChatItemId -> MessageId -> m AChatItem
 deleteDirectChatItemRcvBroadcast st userId ct itemId msgId =
-  liftIOEither . withTransaction st $ \db -> deleteDirectChatItemBroadcast_ db userId ct itemId False msgId
-
-deleteDirectChatItemSndBroadcast :: StoreMonad m => SQLiteStore -> UserId -> Contact -> ChatItemId -> MessageId -> m AChatItem
-deleteDirectChatItemSndBroadcast st userId ct itemId msgId =
  liftIOEither . withTransaction st $ \db -> do
-    ci <- deleteDirectChatItemBroadcast_ db userId ct itemId True msgId
-    setChatItemMessagesDeleted_ db itemId
-    pure ci
+    currentTs <- liftIO getCurrentTime
+    insertChatItemMessage_ db itemId msgId currentTs
+    updateDirectChatItemRcvDeleted_ db userId ct itemId currentTs

-deleteDirectChatItemBroadcast_ :: DB.Connection -> UserId -> Contact -> ChatItemId -> Bool -> MessageId -> IO (Either StoreError AChatItem)
-deleteDirectChatItemBroadcast_ db userId ct itemId itemDeleted msgId = do
-  currentTs <- liftIO getCurrentTime
-  insertChatItemMessage_ db itemId msgId currentTs
-  deleteDirectChatItem_ db userId ct itemId CIDMBroadcast itemDeleted currentTs
-
-deleteDirectChatItem_ :: DB.Connection -> UserId -> Contact -> ChatItemId -> CIDeleteMode -> Bool -> UTCTime -> IO (Either StoreError AChatItem)
-deleteDirectChatItem_ db userId ct@Contact {contactId} itemId mode itemDeleted currentTs = runExceptT $ do
+updateDirectChatItemRcvDeleted_ :: DB.Connection -> UserId -> Contact -> ChatItemId -> UTCTime -> IO (Either StoreError AChatItem)
+updateDirectChatItemRcvDeleted_ db userId ct@Contact {contactId} itemId currentTs = runExceptT $ do
  (CChatItem msgDir ci) <- ExceptT $ getDirectChatItem_ db userId contactId itemId
-  let toContent = msgDirToDeletedContent_ msgDir mode
+  let toContent = msgDirToDeletedContent_ msgDir CIDMBroadcast
+      toText = ciDeleteModeToText CIDMBroadcast
  liftIO $ do
    DB.execute
      db
      [sql|
        UPDATE chat_items
-        SET item_content = ?, item_text = ?, item_deleted = ?, updated_at = ?
+        SET item_content = ?, item_text = ?, updated_at = ?
        WHERE user_id = ? AND contact_id = ? AND chat_item_id = ?
      |]
-      (toContent, toText, itemDeleted, currentTs, userId, contactId, itemId)
-    when itemDeleted $ deleteQuote_ db itemId
-  pure $ AChatItem SCTDirect msgDir (DirectChat ct) (ci {content = toContent, meta = (meta ci) {itemText = toText, itemDeleted}, formattedText = Nothing})
-  where
-    toText = ciDeleteModeToText mode
+      (toContent, toText, currentTs, userId, contactId, itemId)
+  pure $ AChatItem SCTDirect msgDir (DirectChat ct) (ci {content = toContent, meta = (meta ci) {itemText = toText}, formattedText = Nothing})

 deleteQuote_ :: DB.Connection -> ChatItemId -> IO ()
 deleteQuote_ db itemId =
@@ -54,6 +54,7 @@ responseToView testView = \case
  CRChatItemStatusUpdated _ -> []
  CRChatItemUpdated (AChatItem _ _ chat item) -> viewItemUpdate chat item
  CRChatItemDeleted (AChatItem _ _ chat deletedItem) (AChatItem _ _ _ toItem) -> viewItemDelete chat deletedItem toItem
+  CRChatItemDeletedNotFound Contact {localDisplayName = c} _ -> [ttyFrom $ c <> "> [deleted - original message not found]"]
  CRBroadcastSent mc n ts -> viewSentBroadcast mc n ts
  CRMsgIntegrityError mErr -> viewMsgIntegrityError mErr
  CRCmdAccepted _ -> []
@@ -83,6 +84,7 @@ responseToView testView = \case
  CRSentConfirmation -> ["confirmation sent!"]
  CRSentInvitation -> ["connection request sent!"]
  CRContactDeleted c -> [ttyContact' c <> ": contact is deleted"]
+  CRChatCleared chatInfo -> viewChatCleared chatInfo
  CRAcceptingContactRequest c -> [ttyFullContact c <> ": accepting contact request..."]
  CRContactAlreadyExists c -> [ttyFullContact c <> ": contact already exists"]
  CRContactRequestAlreadyAccepted c -> [ttyFullContact c <> ": sent you a duplicate contact request, but you are already connected, no action needed"]
@@ -254,14 +256,12 @@ viewItemDelete chat ChatItem {chatDir, meta, content = deletedContent} ChatItem
    (CIDirectRcv, CIRcvMsgContent mc, CIRcvDeleted mode) -> case mode of
      CIDMBroadcast -> viewReceivedMessage (ttyFromContactDeleted c) [] mc meta
      CIDMInternal -> ["message deleted"]
-    (CIDirectSnd, _, _) -> ["message deleted"]
-    _ -> []
+    _ -> ["message deleted"]
  GroupChat g -> case (chatDir, deletedContent, toContent) of
    (CIGroupRcv GroupMember {localDisplayName = m}, CIRcvMsgContent mc, CIRcvDeleted mode) -> case mode of
      CIDMBroadcast -> viewReceivedMessage (ttyFromGroupDeleted g m) [] mc meta
      CIDMInternal -> ["message deleted"]
-    (CIGroupSnd, _, _) -> ["message deleted"]
-    _ -> []
+    _ -> ["message deleted"]
  _ -> []

 directQuote :: forall d'. MsgDirectionI d' => CIDirection 'CTDirect d' -> CIQuote 'CTDirect -> [StyledString]
@@ -315,6 +315,12 @@ viewConnReqInvitation cReq =
    "and ask them to connect: " <> highlight' "/c <invitation_link_above>"
  ]

+viewChatCleared :: AChatInfo -> [StyledString]
+viewChatCleared (AChatInfo _ chatInfo) = case chatInfo of
+  DirectChat ct -> [ttyContact' ct <> ": all messages are removed locally ONLY"]
+  GroupChat gi -> [ttyGroup' gi <> ": all messages are removed locally ONLY"]
+  _ -> []
+
 viewContactsList :: [Contact] -> [StyledString]
 viewContactsList =
  let ldn = T.toLower . (localDisplayName :: Contact -> ContactName)