From c87f4e68f723966cc208b3a5d2d643a8421011bf Mon Sep 17 00:00:00 2001 From: spaced4ndy <8711996+spaced4ndy@users.noreply.github.com> Date: Mon, 8 May 2023 20:07:51 +0400 Subject: [PATCH] core: keep chat item edit history (#2410) --- apps/simplex-chat/Main.hs | 4 +- simplex-chat.cabal | 1 + src/Simplex/Chat.hs | 67 +++++++++---- src/Simplex/Chat/Controller.hs | 3 + src/Simplex/Chat/Messages.hs | 21 +++++ .../M20230505_chat_item_versions.hs | 29 ++++++ src/Simplex/Chat/Migrations/chat_schema.sql | 12 +++ src/Simplex/Chat/Protocol.hs | 3 + src/Simplex/Chat/Store.hs | 94 +++++++++++++++++-- src/Simplex/Chat/Terminal/Output.hs | 4 +- src/Simplex/Chat/View.hs | 36 +++++-- tests/ChatTests/Direct.hs | 80 ++++++++++++++++ tests/ChatTests/Groups.hs | 84 +++++++++++++++++ tests/ChatTests/Utils.hs | 7 ++ 14 files changed, 415 insertions(+), 30 deletions(-) create mode 100644 src/Simplex/Chat/Migrations/M20230505_chat_item_versions.hs diff --git a/apps/simplex-chat/Main.hs b/apps/simplex-chat/Main.hs index 06ed0759d..b16bbd8ee 100644 --- a/apps/simplex-chat/Main.hs +++ b/apps/simplex-chat/Main.hs @@ -4,6 +4,7 @@ module Main where import Control.Concurrent (threadDelay) import Data.Time.Clock (getCurrentTime) +import Data.Time.LocalTime (getCurrentTimeZone) import Server import Simplex.Chat.Controller (versionNumber, versionString) import Simplex.Chat.Core @@ -29,7 +30,8 @@ main = do else simplexChatCore terminalChatConfig opts Nothing $ \user cc -> do r <- sendChatCmd cc chatCmd ts <- getCurrentTime - putStrLn $ serializeChatResponse (Just user) ts r + tz <- getCurrentTimeZone + putStrLn $ serializeChatResponse (Just user) ts tz r threadDelay $ chatCmdDelay opts * 1000000 welcome :: ChatOpts -> IO () diff --git a/simplex-chat.cabal b/simplex-chat.cabal index 73ec3cc8d..591d677ca 100644 --- a/simplex-chat.cabal +++ b/simplex-chat.cabal @@ -94,6 +94,7 @@ library Simplex.Chat.Migrations.M20230420_rcv_files_to_receive Simplex.Chat.Migrations.M20230422_profile_contact_links Simplex.Chat.Migrations.M20230504_recreate_msg_delivery_events_cleanup_messages + Simplex.Chat.Migrations.M20230505_chat_item_versions Simplex.Chat.Mobile Simplex.Chat.Mobile.WebRTC Simplex.Chat.Options diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs index bcd32b587..497be8f6c 100644 --- a/src/Simplex/Chat.hs +++ b/src/Simplex/Chat.hs @@ -457,6 +457,14 @@ processChatCommand = \case APIGetChatItems pagination search -> withUser $ \user -> do chatItems <- withStore $ \db -> getAllChatItems db user pagination search pure $ CRChatItems user chatItems + APIGetChatItemInfo itemId -> withUser $ \user -> do + (chatItem@(AChatItem _ _ _ ChatItem {meta}), itemVersions) <- withStore $ \db -> do + ci <- getAChatItem db user itemId + versions <- liftIO $ getChatItemVersions db itemId + pure (ci, versions) + let CIMeta {itemTs, createdAt, updatedAt} = meta + ciInfo = ChatItemInfo {chatItemId = itemId, itemTs, createdAt, updatedAt, itemVersions} + pure $ CRChatItemInfo user chatItem ciInfo APISendMessage (ChatRef cType chatId) live (ComposedMessage file_ quotedItemId_ mc) -> withUser $ \user@User {userId} -> withChatLock "sendMessage" $ case cType of CTDirect -> do ct@Contact {contactId, localDisplayName = c, contactUsed} <- withStore $ \db -> getContact db user chatId @@ -637,9 +645,12 @@ processChatCommand = \case case cci of CChatItem SMDSnd ci@ChatItem {meta = CIMeta {itemSharedMsgId, itemTimed, itemLive}, content = ciContent} -> do case (ciContent, itemSharedMsgId) of - (CISndMsgContent _, Just itemSharedMId) -> do + (CISndMsgContent oldMC, Just itemSharedMId) -> do (SndMessage {msgId}, _) <- sendDirectContactMessage ct (XMsgUpdate itemSharedMId mc (ttl' <$> itemTimed) (justTrue . (live &&) =<< itemLive)) - ci' <- withStore' $ \db -> updateDirectChatItem' db user contactId ci (CISndMsgContent mc) live $ Just msgId + ci' <- withStore' $ \db -> do + currentTs <- liftIO getCurrentTime + addInitialAndNewCIVersions db itemId (chatItemTs' ci, oldMC) (currentTs, mc) + updateDirectChatItem' db user contactId ci (CISndMsgContent mc) live $ Just msgId startUpdatedTimedItemThread user (ChatRef CTDirect contactId) ci ci' setActive $ ActiveC c pure $ CRChatItemUpdated user (AChatItem SCTDirect SMDSnd (DirectChat ct) ci') @@ -652,9 +663,12 @@ processChatCommand = \case case cci of CChatItem SMDSnd ci@ChatItem {meta = CIMeta {itemSharedMsgId, itemTimed, itemLive}, content = ciContent} -> do case (ciContent, itemSharedMsgId) of - (CISndMsgContent _, Just itemSharedMId) -> do + (CISndMsgContent oldMC, Just itemSharedMId) -> do SndMessage {msgId} <- sendGroupMessage user gInfo ms (XMsgUpdate itemSharedMId mc (ttl' <$> itemTimed) (justTrue . (live &&) =<< itemLive)) - ci' <- withStore' $ \db -> updateGroupChatItem db user groupId ci (CISndMsgContent mc) live $ Just msgId + ci' <- withStore' $ \db -> do + currentTs <- liftIO getCurrentTime + addInitialAndNewCIVersions db itemId (chatItemTs' ci, oldMC) (currentTs, mc) + updateGroupChatItem db user groupId ci (CISndMsgContent mc) live $ Just msgId startUpdatedTimedItemThread user (ChatRef CTGroup groupId) ci ci' setActive $ ActiveG gName pure $ CRChatItemUpdated user (AChatItem SCTGroup SMDSnd (GroupChat gInfo) ci') @@ -1402,6 +1416,10 @@ processChatCommand = \case ShowChatItem Nothing -> withUser $ \user -> do chatItems <- withStore $ \db -> getAllChatItems db user (CPLast 1) Nothing pure $ CRChatItems user chatItems + ShowChatItemInfo chatName msg -> withUser $ \user -> do + chatRef <- getChatRef user chatName + itemId <- getChatItemIdByText user chatRef msg + processChatCommand $ APIGetChatItemInfo itemId ShowLiveItems on -> withUser $ \_ -> asks showLiveItems >>= atomically . (`writeTVar` on) >> ok_ SendFile chatName f -> withUser $ \user -> do @@ -1582,6 +1600,11 @@ processChatCommand = \case CTDirect -> withStore $ \db -> getDirectChatItemIdByText db userId cId SMDSnd msg CTGroup -> withStore $ \db -> getGroupChatItemIdByText db user cId (Just localDisplayName) msg _ -> throwChatError $ CECommandError "not supported" + getChatItemIdByText :: User -> ChatRef -> Text -> m Int64 + getChatItemIdByText user (ChatRef cType cId) msg = case cType of + CTDirect -> withStore $ \db -> getDirectChatItemIdByText' db user cId msg + CTGroup -> withStore $ \db -> getGroupChatItemIdByText' db user cId msg + _ -> throwChatError $ CECommandError "not supported" connectViaContact :: User -> ConnectionRequestUri 'CMContact -> m ChatResponse connectViaContact user@User {userId} cReq@(CRContactUri ConnReqUriData {crClientData}) = withChatLock "connectViaContact" $ do let cReqHash = ConnReqUriHash . C.sha256Hash $ strEncode cReq @@ -3283,21 +3306,26 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do -- Chat item and update message which created it will have different sharedMsgId in this case... let timed_ = rcvContactCITimed ct ttl ci <- saveRcvChatItem' user (CDDirectRcv ct) msg (Just sharedMsgId) msgMeta content Nothing timed_ live - ci' <- withStore' $ \db -> updateDirectChatItem' db user contactId ci content live Nothing + ci' <- withStore' $ \db -> do + createChatItemVersion db (chatItemId' ci) brokerTs mc + updateDirectChatItem' db user contactId ci content live Nothing toView $ CRChatItemUpdated user (AChatItem SCTDirect SMDRcv (DirectChat ct) ci') setActive $ ActiveC c _ -> throwError e where + MsgMeta {broker = (_, brokerTs)} = msgMeta content = CIRcvMsgContent mc live = fromMaybe False live_ updateRcvChatItem = do - CChatItem msgDir ci <- withStore $ \db -> getDirectChatItemBySharedMsgId db user contactId sharedMsgId - case msgDir of - SMDRcv -> do - ci' <- withStore' $ \db -> updateDirectChatItem' db user contactId ci content live $ Just msgId + cci <- withStore $ \db -> getDirectChatItemBySharedMsgId db user contactId sharedMsgId + case cci of + CChatItem SMDRcv ci@ChatItem {content = CIRcvMsgContent oldMC} -> do + ci' <- withStore' $ \db -> do + addInitialAndNewCIVersions db (chatItemId' ci) (chatItemTs' ci, oldMC) (brokerTs, mc) + updateDirectChatItem' db user contactId ci content live $ Just msgId toView $ CRChatItemUpdated user (AChatItem SCTDirect SMDRcv (DirectChat ct) ci') startUpdatedTimedItemThread user (ChatRef CTDirect contactId) ci ci' - SMDSnd -> messageError "x.msg.update: contact attempted invalid message update" + _ -> messageError "x.msg.update: contact attempted invalid message update" messageDelete :: Contact -> SharedMsgId -> RcvMessage -> MsgMeta -> m () messageDelete ct@Contact {contactId} sharedMsgId RcvMessage {msgId} msgMeta = do @@ -3347,25 +3375,30 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do -- Chat item and update message which created it will have different sharedMsgId in this case... let timed_ = rcvGroupCITimed gInfo ttl_ ci <- saveRcvChatItem' user (CDGroupRcv gInfo m) msg (Just sharedMsgId) msgMeta content Nothing timed_ live - ci' <- withStore' $ \db -> updateGroupChatItem db user groupId ci content live Nothing + ci' <- withStore' $ \db -> do + createChatItemVersion db (chatItemId' ci) brokerTs mc + updateGroupChatItem db user groupId ci content live Nothing toView $ CRChatItemUpdated user (AChatItem SCTGroup SMDRcv (GroupChat gInfo) ci') setActive $ ActiveG g _ -> throwError e where + MsgMeta {broker = (_, brokerTs)} = msgMeta content = CIRcvMsgContent mc live = fromMaybe False live_ updateRcvChatItem = do - CChatItem msgDir ci@ChatItem {chatDir} <- withStore $ \db -> getGroupChatItemBySharedMsgId db user groupId groupMemberId sharedMsgId - case (msgDir, chatDir) of - (SMDRcv, CIGroupRcv m') -> + cci <- withStore $ \db -> getGroupChatItemBySharedMsgId db user groupId groupMemberId sharedMsgId + case cci of + CChatItem SMDRcv ci@ChatItem {chatDir = CIGroupRcv m', content = CIRcvMsgContent oldMC} -> do if sameMemberId memberId m' then do - ci' <- withStore' $ \db -> updateGroupChatItem db user groupId ci content live $ Just msgId + ci' <- withStore' $ \db -> do + addInitialAndNewCIVersions db (chatItemId' ci) (chatItemTs' ci, oldMC) (brokerTs, mc) + updateGroupChatItem db user groupId ci content live $ Just msgId toView $ CRChatItemUpdated user (AChatItem SCTGroup SMDRcv (GroupChat gInfo) ci') setActive $ ActiveG g startUpdatedTimedItemThread user (ChatRef CTGroup groupId) ci ci' else messageError "x.msg.update: group member attempted to update a message of another member" -- shouldn't happen now that query includes group member id - (SMDSnd, _) -> messageError "x.msg.update: group member attempted invalid message update" + _ -> messageError "x.msg.update: group member attempted invalid message update" groupMessageDelete :: GroupInfo -> GroupMember -> SharedMsgId -> Maybe MemberId -> RcvMessage -> m () groupMessageDelete gInfo@GroupInfo {groupId, membership} m@GroupMember {memberId, memberRole = senderRole} sharedMsgId sndMemberId_ RcvMessage {msgId} = do @@ -4594,6 +4627,7 @@ chatCommandP = "/_get chats " *> (APIGetChats <$> A.decimal <*> (" pcc=on" $> True <|> " pcc=off" $> False <|> pure False)), "/_get chat " *> (APIGetChat <$> chatRefP <* A.space <*> chatPaginationP <*> optional (" search=" *> stringP)), "/_get items " *> (APIGetChatItems <$> chatPaginationP <*> optional (" search=" *> stringP)), + "/_get item info " *> (APIGetChatItemInfo <$> A.decimal), "/_send " *> (APISendMessage <$> chatRefP <*> liveMessageP <*> (" json " *> jsonP <|> " text " *> (ComposedMessage Nothing Nothing <$> mcTextP))), "/_update item " *> (APIUpdateChatItem <$> chatRefP <* A.space <*> A.decimal <*> liveMessageP <* A.space <*> msgContentP), "/_delete item " *> (APIDeleteChatItem <$> chatRefP <* A.space <*> A.decimal <* A.space <*> ciDeleteMode), @@ -4723,6 +4757,7 @@ chatCommandP = "/last_item_id" *> (LastChatItemId <$> optional (A.space *> chatNameP) <*> (A.space *> A.decimal <|> pure 0)), "/show" *> (ShowLiveItems <$> (A.space *> onOffP <|> pure True)), "/show " *> (ShowChatItem . Just <$> A.decimal), + "/item info " *> (ShowChatItemInfo <$> chatNameP <* A.space <*> msgTextP), ("/file " <|> "/f ") *> (SendFile <$> chatNameP' <* A.space <*> filePath), ("/image " <|> "/img ") *> (SendImage <$> chatNameP' <* A.space <*> filePath), ("/fforward " <|> "/ff ") *> (ForwardFile <$> chatNameP' <* A.space <*> A.decimal), diff --git a/src/Simplex/Chat/Controller.hs b/src/Simplex/Chat/Controller.hs index 54a780384..553752494 100644 --- a/src/Simplex/Chat/Controller.hs +++ b/src/Simplex/Chat/Controller.hs @@ -213,6 +213,7 @@ data ChatCommand | APIGetChats {userId :: UserId, pendingConnections :: Bool} | APIGetChat ChatRef ChatPagination (Maybe String) | APIGetChatItems ChatPagination (Maybe String) + | APIGetChatItemInfo ChatItemId | APISendMessage {chatRef :: ChatRef, liveMessage :: Bool, composedMessage :: ComposedMessage} | APIUpdateChatItem {chatRef :: ChatRef, chatItemId :: ChatItemId, liveMessage :: Bool, msgContent :: MsgContent} | APIDeleteChatItem ChatRef ChatItemId CIDeleteMode @@ -341,6 +342,7 @@ data ChatCommand | LastMessages (Maybe ChatName) Int (Maybe String) -- UserId (not used in UI) | LastChatItemId (Maybe ChatName) Int -- UserId (not used in UI) | ShowChatItem (Maybe ChatItemId) -- UserId (not used in UI) + | ShowChatItemInfo ChatName Text | ShowLiveItems Bool | SendFile ChatName FilePath | SendImage ChatName FilePath @@ -378,6 +380,7 @@ data ChatResponse | CRChats {chats :: [AChat]} | CRApiChat {user :: User, chat :: AChat} | CRChatItems {user :: User, chatItems :: [AChatItem]} + | CRChatItemInfo {user :: User, chatItem :: AChatItem, chatItemInfo :: ChatItemInfo} | CRChatItemId User (Maybe ChatItemId) | CRApiParsedMarkdown {formattedText :: Maybe MarkdownList} | CRUserProtoServers {user :: User, servers :: AUserProtoServers} diff --git a/src/Simplex/Chat/Messages.hs b/src/Simplex/Chat/Messages.hs index 584840cd1..fa29d4054 100644 --- a/src/Simplex/Chat/Messages.hs +++ b/src/Simplex/Chat/Messages.hs @@ -1451,3 +1451,24 @@ jsonCIDeleted :: CIDeleted d -> JSONCIDeleted jsonCIDeleted = \case CIDeleted -> JCIDDeleted CIModerated m -> JCIDModerated m + +data ChatItemInfo = ChatItemInfo + { chatItemId :: ChatItemId, + itemTs :: UTCTime, + createdAt :: UTCTime, + updatedAt :: UTCTime, + itemVersions :: [ChatItemVersion] + } + deriving (Eq, Show, Generic) + +instance ToJSON ChatItemInfo where toEncoding = J.genericToEncoding J.defaultOptions + +data ChatItemVersion = ChatItemVersion + { chatItemVersionId :: Int64, + msgContent :: MsgContent, + itemVersionTs :: UTCTime, + createdAt :: UTCTime + } + deriving (Eq, Show, Generic) + +instance ToJSON ChatItemVersion where toEncoding = J.genericToEncoding J.defaultOptions diff --git a/src/Simplex/Chat/Migrations/M20230505_chat_item_versions.hs b/src/Simplex/Chat/Migrations/M20230505_chat_item_versions.hs new file mode 100644 index 000000000..7e2e0f771 --- /dev/null +++ b/src/Simplex/Chat/Migrations/M20230505_chat_item_versions.hs @@ -0,0 +1,29 @@ +{-# LANGUAGE QuasiQuotes #-} + +module Simplex.Chat.Migrations.M20230505_chat_item_versions where + +import Database.SQLite.Simple (Query) +import Database.SQLite.Simple.QQ (sql) + +m20230505_chat_item_versions :: Query +m20230505_chat_item_versions = + [sql| +CREATE TABLE chat_item_versions ( -- contains versions only for edited chat items, including current version + chat_item_version_id INTEGER PRIMARY KEY AUTOINCREMENT, + chat_item_id INTEGER NOT NULL REFERENCES chat_items ON DELETE CASCADE, + msg_content TEXT NOT NULL, + item_version_ts TEXT NOT NULL, + created_at TEXT NOT NULL DEFAULT(datetime('now')), + updated_at TEXT NOT NULL DEFAULT(datetime('now')) +); + +CREATE INDEX idx_chat_item_versions_chat_item_id ON chat_item_versions(chat_item_id); +|] + +down_m20230505_chat_item_versions :: Query +down_m20230505_chat_item_versions = + [sql| +DROP INDEX idx_chat_item_versions_chat_item_id; + +DROP TABLE chat_item_versions; +|] diff --git a/src/Simplex/Chat/Migrations/chat_schema.sql b/src/Simplex/Chat/Migrations/chat_schema.sql index dcfc84822..83a8ec652 100644 --- a/src/Simplex/Chat/Migrations/chat_schema.sql +++ b/src/Simplex/Chat/Migrations/chat_schema.sql @@ -454,6 +454,15 @@ CREATE TABLE msg_delivery_events( created_at TEXT NOT NULL DEFAULT(datetime('now')), updated_at TEXT NOT NULL DEFAULT(datetime('now')) ); +CREATE TABLE chat_item_versions( + -- contains versions only for edited chat items, including current version + chat_item_version_id INTEGER PRIMARY KEY AUTOINCREMENT, + chat_item_id INTEGER NOT NULL REFERENCES chat_items ON DELETE CASCADE, + msg_content TEXT NOT NULL, + item_version_ts TEXT NOT NULL, + created_at TEXT NOT NULL DEFAULT(datetime('now')), + updated_at TEXT NOT NULL DEFAULT(datetime('now')) +); CREATE INDEX contact_profiles_index ON contact_profiles( display_name, full_name @@ -595,3 +604,6 @@ CREATE INDEX idx_extra_xftp_file_descriptions_user_id ON extra_xftp_file_descrip CREATE INDEX idx_xftp_file_descriptions_user_id ON xftp_file_descriptions( user_id ); +CREATE INDEX idx_chat_item_versions_chat_item_id ON chat_item_versions( + chat_item_id +); diff --git a/src/Simplex/Chat/Protocol.hs b/src/Simplex/Chat/Protocol.hs index 4e686d2e8..f14efbc10 100644 --- a/src/Simplex/Chat/Protocol.hs +++ b/src/Simplex/Chat/Protocol.hs @@ -358,6 +358,9 @@ msgContentText = \case MCFile t -> t MCUnknown {text} -> text +toMCText :: MsgContent -> MsgContent +toMCText = MCText . msgContentText + durationText :: Int -> Text durationText duration = let (mins, secs) = duration `divMod` 60 in T.pack $ "(" <> with0 mins <> ":" <> with0 secs <> ")" diff --git a/src/Simplex/Chat/Store.hs b/src/Simplex/Chat/Store.hs index 38a602407..e2aa28ad2 100644 --- a/src/Simplex/Chat/Store.hs +++ b/src/Simplex/Chat/Store.hs @@ -226,6 +226,7 @@ module Simplex.Chat.Store getGroupChat, getAllChatItems, getAChatItem, + getChatItemVersions, getChatItemIdByAgentMsgId, getDirectChatItem, getDirectChatItemBySharedMsgId, @@ -236,13 +237,17 @@ module Simplex.Chat.Store getGroupMemberCIBySharedMsgId, getGroupMemberChatItemLast, getDirectChatItemIdByText, + getDirectChatItemIdByText', getGroupChatItemIdByText, + getGroupChatItemIdByText', getChatItemByFileId, getChatItemByGroupId, updateDirectChatItemStatus, updateDirectCIFileStatus, updateDirectChatItem, updateDirectChatItem', + addInitialAndNewCIVersions, + createChatItemVersion, deleteDirectChatItem, markDirectChatItemDeleted, updateGroupChatItem, @@ -377,6 +382,7 @@ import Simplex.Chat.Migrations.M20230411_extra_xftp_file_descriptions import Simplex.Chat.Migrations.M20230420_rcv_files_to_receive import Simplex.Chat.Migrations.M20230422_profile_contact_links import Simplex.Chat.Migrations.M20230504_recreate_msg_delivery_events_cleanup_messages +import Simplex.Chat.Migrations.M20230505_chat_item_versions import Simplex.Chat.Protocol import Simplex.Chat.Types import Simplex.Chat.Util (week) @@ -453,7 +459,8 @@ schemaMigrations = ("20230411_extra_xftp_file_descriptions", m20230411_extra_xftp_file_descriptions, Just down_m20230411_extra_xftp_file_descriptions), ("20230420_rcv_files_to_receive", m20230420_rcv_files_to_receive, Just down_m20230420_rcv_files_to_receive), ("20230422_profile_contact_links", m20230422_profile_contact_links, Just down_m20230422_profile_contact_links), - ("20230504_recreate_msg_delivery_events_cleanup_messages", m20230504_recreate_msg_delivery_events_cleanup_messages, Just down_m20230504_recreate_msg_delivery_events_cleanup_messages) + ("20230504_recreate_msg_delivery_events_cleanup_messages", m20230504_recreate_msg_delivery_events_cleanup_messages, Just down_m20230504_recreate_msg_delivery_events_cleanup_messages), + ("20230505_chat_item_versions", m20230505_chat_item_versions, Just down_m20230505_chat_item_versions) ] -- | The list of migrations in ascending order by date @@ -4399,10 +4406,35 @@ updateDirectChatItem_ db userId contactId ChatItem {meta, content} msgId_ = do ((content, itemText, itemStatus, itemDeleted', itemEdited, itemLive, updatedAt) :. ciTimedRow itemTimed :. (userId, contactId, itemId)) forM_ msgId_ $ \msgId -> liftIO $ insertChatItemMessage_ db itemId msgId updatedAt +addInitialAndNewCIVersions :: DB.Connection -> ChatItemId -> (UTCTime, MsgContent) -> (UTCTime, MsgContent) -> IO () +addInitialAndNewCIVersions db itemId (initialTs, initialMC) (newTs, newMC) = do + versionsCount <- getChatItemVersionsCount db itemId + when (versionsCount == 0) $ + createChatItemVersion db itemId initialTs initialMC + createChatItemVersion db itemId newTs newMC + +getChatItemVersionsCount :: DB.Connection -> ChatItemId -> IO Int +getChatItemVersionsCount db itemId = do + count <- + maybeFirstRow fromOnly $ + DB.query db "SELECT COUNT(1) FROM chat_item_versions WHERE chat_item_id = ?" (Only itemId) + pure $ fromMaybe 0 count + +createChatItemVersion :: DB.Connection -> ChatItemId -> UTCTime -> MsgContent -> IO () +createChatItemVersion db itemId itemVersionTs msgContent = + DB.execute + db + [sql| + INSERT INTO chat_item_versions (chat_item_id, msg_content, item_version_ts) + VALUES (?,?,?) + |] + (itemId, toMCText msgContent, itemVersionTs) + deleteDirectChatItem :: DB.Connection -> User -> Contact -> CChatItem 'CTDirect -> IO () deleteDirectChatItem db User {userId} Contact {contactId} (CChatItem _ ci) = do let itemId = chatItemId' ci deleteChatItemMessages_ db itemId + deleteChatItemVersions_ db itemId DB.execute db [sql| @@ -4425,6 +4457,10 @@ deleteChatItemMessages_ db itemId = |] (Only itemId) +deleteChatItemVersions_ :: DB.Connection -> ChatItemId -> IO () +deleteChatItemVersions_ db itemId = + DB.execute db "DELETE FROM chat_item_versions WHERE chat_item_id = ?" (Only itemId) + markDirectChatItemDeleted :: DB.Connection -> User -> Contact -> CChatItem 'CTDirect -> MessageId -> IO () markDirectChatItemDeleted db User {userId} Contact {contactId} (CChatItem _ ci) msgId = do currentTs <- liftIO getCurrentTime @@ -4489,18 +4525,32 @@ getDirectChatItem db User {userId} contactId itemId = ExceptT $ do getDirectChatItemIdByText :: DB.Connection -> UserId -> Int64 -> SMsgDirection d -> Text -> ExceptT StoreError IO ChatItemId getDirectChatItemIdByText db userId contactId msgDir quotedMsg = - ExceptT . firstRow fromOnly SEQuotedChatItemNotFound $ + ExceptT . firstRow fromOnly (SEChatItemNotFoundByText quotedMsg) $ DB.query db [sql| SELECT chat_item_id FROM chat_items - WHERE user_id = ? AND contact_id = ? AND item_sent = ? AND item_text like ? + WHERE user_id = ? AND contact_id = ? AND item_sent = ? AND item_text LIKE ? ORDER BY chat_item_id DESC LIMIT 1 |] (userId, contactId, msgDir, quotedMsg <> "%") +getDirectChatItemIdByText' :: DB.Connection -> User -> ContactId -> Text -> ExceptT StoreError IO ChatItemId +getDirectChatItemIdByText' db User {userId} contactId msg = + ExceptT . firstRow fromOnly (SEChatItemNotFoundByText msg) $ + DB.query + db + [sql| + SELECT chat_item_id + FROM chat_items + WHERE user_id = ? AND contact_id = ? AND item_text LIKE ? + ORDER BY chat_item_id DESC + LIMIT 1 + |] + (userId, contactId, msg <> "%") + updateGroupChatItem :: forall d. MsgDirectionI d => DB.Connection -> User -> Int64 -> ChatItem 'CTGroup d -> CIContent d -> Bool -> Maybe MessageId -> IO (ChatItem 'CTGroup d) updateGroupChatItem db user groupId ci newContent live msgId_ = do currentTs <- liftIO getCurrentTime @@ -4528,6 +4578,7 @@ deleteGroupChatItem :: DB.Connection -> User -> GroupInfo -> CChatItem 'CTGroup deleteGroupChatItem db User {userId} GroupInfo {groupId} (CChatItem _ ci) = do let itemId = chatItemId' ci deleteChatItemMessages_ db itemId + deleteChatItemVersions_ db itemId DB.execute db [sql| @@ -4543,6 +4594,7 @@ updateGroupChatItemModerated db User {userId} gInfo@GroupInfo {groupId} (CChatIt toText = ciModeratedText itemId = chatItemId' ci deleteChatItemMessages_ db itemId + deleteChatItemVersions_ db itemId liftIO $ DB.execute db @@ -4648,9 +4700,9 @@ getGroupChatItem db User {userId, userContactId} groupId itemId = ExceptT $ do |] (userId, groupId, itemId) -getGroupChatItemIdByText :: DB.Connection -> User -> Int64 -> Maybe ContactName -> Text -> ExceptT StoreError IO ChatItemId +getGroupChatItemIdByText :: DB.Connection -> User -> GroupId -> Maybe ContactName -> Text -> ExceptT StoreError IO ChatItemId getGroupChatItemIdByText db User {userId, localDisplayName = userName} groupId contactName_ quotedMsg = - ExceptT . firstRow fromOnly SEQuotedChatItemNotFound $ case contactName_ of + ExceptT . firstRow fromOnly (SEChatItemNotFoundByText quotedMsg) $ case contactName_ of Nothing -> anyMemberChatItem_ Just cName | userName == cName -> userChatItem_ @@ -4692,6 +4744,20 @@ getGroupChatItemIdByText db User {userId, localDisplayName = userName} groupId c |] (userId, groupId, cName, quotedMsg <> "%") +getGroupChatItemIdByText' :: DB.Connection -> User -> GroupId -> Text -> ExceptT StoreError IO ChatItemId +getGroupChatItemIdByText' db User {userId} groupId msg = + ExceptT . firstRow fromOnly (SEChatItemNotFoundByText msg) $ + DB.query + db + [sql| + SELECT chat_item_id + FROM chat_items + WHERE user_id = ? AND group_id = ? AND item_text like ? + ORDER BY chat_item_id DESC + LIMIT 1 + |] + (userId, groupId, msg <> "%") + getChatItemByFileId :: DB.Connection -> User -> Int64 -> ExceptT StoreError IO AChatItem getChatItemByFileId db user@User {userId} fileId = do (itemId, chatRef) <- @@ -4748,6 +4814,22 @@ getAChatItem_ db user itemId = \case pure $ AChatItem SCTGroup msgDir (GroupChat gInfo) ci _ -> throwError $ SEChatItemNotFound itemId +getChatItemVersions :: DB.Connection -> ChatItemId -> IO [ChatItemVersion] +getChatItemVersions db itemId = do + map toChatItemVersion + <$> DB.query + db + [sql| + SELECT chat_item_version_id, msg_content, item_version_ts, created_at + FROM chat_item_versions + WHERE chat_item_id = ? + ORDER BY chat_item_version_id DESC + |] + (Only itemId) + where + toChatItemVersion :: (Int64, MsgContent, UTCTime, UTCTime) -> ChatItemVersion + toChatItemVersion (chatItemVersionId, msgContent, itemVersionTs, createdAt) = ChatItemVersion {chatItemVersionId, msgContent, itemVersionTs, createdAt} + updateDirectCIFileStatus :: forall d. MsgDirectionI d => DB.Connection -> User -> Int64 -> CIFileStatus d -> ExceptT StoreError IO AChatItem updateDirectCIFileStatus db user fileId fileStatus = do aci@(AChatItem cType d cInfo ci) <- getChatItemByFileId db user fileId @@ -5353,7 +5435,7 @@ data StoreError | SENoMsgDelivery {connId :: Int64, agentMsgId :: AgentMsgId} | SEBadChatItem {itemId :: ChatItemId} | SEChatItemNotFound {itemId :: ChatItemId} - | SEQuotedChatItemNotFound + | SEChatItemNotFoundByText {text :: Text} | SEChatItemSharedMsgIdNotFound {sharedMsgId :: SharedMsgId} | SEChatItemNotFoundByFileId {fileId :: FileTransferId} | SEChatItemNotFoundByGroupId {groupId :: GroupId} diff --git a/src/Simplex/Chat/Terminal/Output.hs b/src/Simplex/Chat/Terminal/Output.hs index d39c0b946..94d76b8a3 100644 --- a/src/Simplex/Chat/Terminal/Output.hs +++ b/src/Simplex/Chat/Terminal/Output.hs @@ -14,6 +14,7 @@ import Control.Monad.Except import Control.Monad.Reader import Data.List (intercalate) import Data.Time.Clock (getCurrentTime) +import Data.Time.LocalTime (getCurrentTimeZone) import Simplex.Chat (processChatCommand) import Simplex.Chat.Controller import Simplex.Chat.Messages hiding (NewChatItem (..)) @@ -137,7 +138,8 @@ responseString :: ChatController -> Bool -> ChatResponse -> IO [StyledString] responseString cc liveItems r = do user <- readTVarIO $ currentUser cc ts <- getCurrentTime - pure $ responseToView user (config cc) liveItems ts r + tz <- getCurrentTimeZone + pure $ responseToView user (config cc) liveItems ts tz r printToTerminal :: ChatTerminal -> [StyledString] -> IO () printToTerminal ct s = diff --git a/src/Simplex/Chat/View.hs b/src/Simplex/Chat/View.hs index f4ae01c86..313a0bf63 100644 --- a/src/Simplex/Chat/View.hs +++ b/src/Simplex/Chat/View.hs @@ -26,7 +26,7 @@ import qualified Data.Text as T import Data.Text.Encoding (decodeLatin1) import Data.Time.Clock (DiffTime, UTCTime) import Data.Time.Format (defaultTimeLocale, formatTime) -import Data.Time.LocalTime (ZonedTime (..), localDay, localTimeOfDay, timeOfDayToTime, utcToZonedTime) +import Data.Time.LocalTime (TimeZone, ZonedTime (..), localDay, localTimeOfDay, timeOfDayToTime, utcToLocalTime, utcToZonedTime) import Data.Word (Word32) import GHC.Generics (Generic) import qualified Network.HTTP.Types as Q @@ -57,11 +57,11 @@ import System.Console.ANSI.Types type CurrentTime = UTCTime -serializeChatResponse :: Maybe User -> CurrentTime -> ChatResponse -> String -serializeChatResponse user_ ts = unlines . map unStyle . responseToView user_ defaultChatConfig False ts +serializeChatResponse :: Maybe User -> CurrentTime -> TimeZone -> ChatResponse -> String +serializeChatResponse user_ ts tz = unlines . map unStyle . responseToView user_ defaultChatConfig False ts tz -responseToView :: Maybe User -> ChatConfig -> Bool -> CurrentTime -> ChatResponse -> [StyledString] -responseToView user_ ChatConfig {logLevel, testView} liveItems ts = \case +responseToView :: Maybe User -> ChatConfig -> Bool -> CurrentTime -> TimeZone -> ChatResponse -> [StyledString] +responseToView user_ ChatConfig {logLevel, testView} liveItems ts tz = \case CRActiveUser User {profile} -> viewUserProfile $ fromLocalProfile profile CRUsersList users -> viewUsersList users CRChatStarted -> ["chat started"] @@ -85,6 +85,7 @@ responseToView user_ ChatConfig {logLevel, testView} liveItems ts = \case CRGroupMemberCode u g m code -> ttyUser u $ viewGroupMemberCode g m code testView CRNewChatItem u (AChatItem _ _ chat item) -> ttyUser u $ unmuted chat item $ viewChatItem chat item False ts CRChatItems u chatItems -> ttyUser u $ concatMap (\(AChatItem _ _ chat item) -> viewChatItem chat item True ts) chatItems + CRChatItemInfo u ci ciInfo -> ttyUser u $ viewChatItemInfo ci ciInfo tz CRChatItemId u itemId -> ttyUser u [plain $ maybe "no item" show itemId] CRChatItemStatusUpdated u _ -> ttyUser u [] CRChatItemUpdated u (AChatItem _ _ chat item) -> ttyUser u $ unmuted chat item $ viewItemUpdate chat item liveItems ts @@ -415,6 +416,29 @@ viewChatItem chat ci@ChatItem {chatDir, meta = meta, content, quotedItem, file} plainContent = plain . ciContentToText prohibited = styled (colored Red) ("[unexpected chat item created, please report to developers]" :: String) +viewChatItemInfo :: AChatItem -> ChatItemInfo -> TimeZone -> [StyledString] +viewChatItemInfo (AChatItem _ msgDir _ _) ChatItemInfo {itemTs, createdAt, itemVersions} tz = case msgDir of + SMDRcv -> + [ "sent at: " <> ts itemTs, + "received at: " <> ts createdAt + ] + <> versions + SMDSnd -> + ["sent at: " <> ts itemTs] <> versions + where + ts = styleTime . localTs tz + versions = + if null itemVersions + then [] + else ["message history:"] <> concatMap version itemVersions + version ChatItemVersion {msgContent, itemVersionTs} = prependFirst (ts itemVersionTs <> styleTime ": ") $ ttyMsgContent msgContent + +localTs :: TimeZone -> UTCTime -> String +localTs tz ts = do + let localTime = utcToLocalTime tz ts + formattedTime = formatTime defaultTimeLocale "%Y-%m-%d %H:%M:%S" localTime + formattedTime + viewItemUpdate :: MsgDirectionI d => ChatInfo c -> ChatItem c d -> Bool -> CurrentTime -> [StyledString] viewItemUpdate chat ChatItem {chatDir, meta = meta@CIMeta {itemEdited, itemLive}, content, quotedItem} liveItems ts = case chat of DirectChat c -> case chatDir of @@ -1368,7 +1392,7 @@ viewChatError logLevel = \case SEContactRequestNotFoundByName c -> ["no contact request from " <> ttyContact c] SEFileIdNotFoundBySharedMsgId _ -> [] -- recipient tried to accept cancelled file SEConnectionNotFound agentConnId -> ["event connection not found, agent ID: " <> sShow agentConnId | logLevel <= CLLWarning] -- mutes delete group error - SEQuotedChatItemNotFound -> ["message not found - reply is not sent"] + SEChatItemNotFoundByText text -> ["message not found by text: " <> plain text] SEDuplicateGroupLink g -> ["you already have link for this group, to show: " <> highlight ("/show link #" <> groupName' g)] SEGroupLinkNotFound g -> ["no group link, to create: " <> highlight ("/create link #" <> groupName' g)] e -> ["chat db error: " <> sShow e] diff --git a/tests/ChatTests/Direct.hs b/tests/ChatTests/Direct.hs index 0f5fe5f71..66893d0f9 100644 --- a/tests/ChatTests/Direct.hs +++ b/tests/ChatTests/Direct.hs @@ -31,6 +31,7 @@ chatDirectTests = do it "deleting contact deletes profile" testDeleteContactDeletesProfile it "direct message quoted replies" testDirectMessageQuotedReply it "direct message update" testDirectMessageUpdate + it "direct message edit history" testDirectMessageEditHistory it "direct message delete" testDirectMessageDelete it "direct live message" testDirectLiveMessage it "repeat AUTH errors disable contact" testRepeatAuthErrorsDisableContact @@ -268,6 +269,73 @@ testDirectMessageUpdate = alice #$> ("/_get chat @2 count=100", chat', chatFeatures' <> [((1, "greetings 🤝"), Nothing), ((0, "hey Alice"), Just (1, "hello 🙂")), ((0, "greetings Alice"), Just (1, "hey 👋"))]) bob #$> ("/_get chat @2 count=100", chat', chatFeatures' <> [((0, "greetings 🤝"), Nothing), ((1, "hey Alice"), Just (0, "hello 🙂")), ((1, "greetings Alice"), Just (0, "hey 👋"))]) +testDirectMessageEditHistory :: HasCallStack => FilePath -> IO () +testDirectMessageEditHistory = + testChat2 aliceProfile bobProfile $ + \alice bob -> do + connectUsers alice bob + alice #> "@bob hello!" + bob <# "alice> hello!" + + alice ##> ("/_get item info " <> itemId 1) + alice <##. "sent at: " + bob ##> ("/_get item info " <> itemId 1) + bob <##. "sent at: " + bob <##. "received at: " + + alice ##> ("/_update item @2 " <> itemId 1 <> " text hey 👋") + alice <# "@bob [edited] hey 👋" + bob <# "alice> [edited] hey 👋" + + alice ##> ("/_get item info " <> itemId 1) + alice <##. "sent at: " + alice <## "message history:" + alice .<## ": hey 👋" + alice .<## ": hello!" + bob ##> ("/_get item info " <> itemId 1) + bob <##. "sent at: " + bob <##. "received at: " + bob <## "message history:" + bob .<## ": hey 👋" + bob .<## ": hello!" + + alice ##> ("/_update item @2 " <> itemId 1 <> " text hello there") + alice <# "@bob [edited] hello there" + bob <# "alice> [edited] hello there" + + alice ##> "/item info @bob hello" + alice <##. "sent at: " + alice <## "message history:" + alice .<## ": hello there" + alice .<## ": hey 👋" + alice .<## ": hello!" + bob ##> "/item info @alice hello" + bob <##. "sent at: " + bob <##. "received at: " + bob <## "message history:" + bob .<## ": hello there" + bob .<## ": hey 👋" + bob .<## ": hello!" + + bob #$> ("/_delete item @2 " <> itemId 1 <> " internal", id, "message deleted") + + alice ##> ("/_update item @2 " <> itemId 1 <> " text hey there") + alice <# "@bob [edited] hey there" + bob <# "alice> [edited] hey there" + + alice ##> "/item info @bob hey" + alice <##. "sent at: " + alice <## "message history:" + alice .<## ": hey there" + alice .<## ": hello there" + alice .<## ": hey 👋" + alice .<## ": hello!" + bob ##> "/item info @alice hey" + bob <##. "sent at: " + bob <##. "received at: " + bob <## "message history:" + bob .<## ": hey there" + testDirectMessageDelete :: HasCallStack => FilePath -> IO () testDirectMessageDelete = testChat2 aliceProfile bobProfile $ @@ -359,6 +427,18 @@ testDirectLiveMessage = alice ##> ("/_update item @2 " <> itemId 2 <> " text hello 2") alice <# "@bob [LIVE] hello 2" bob <# "alice> [LIVE ended] hello 2" + -- live message has edit history + alice ##> ("/_get item info " <> itemId 2) + alice <##. "sent at: " + alice <## "message history:" + alice .<## ": hello 2" + alice .<## ":" + bob ##> ("/_get item info " <> itemId 2) + bob <##. "sent at: " + bob <##. "received at: " + bob <## "message history:" + bob .<## ": hello 2" + bob .<## ":" testRepeatAuthErrorsDisableContact :: HasCallStack => FilePath -> IO () testRepeatAuthErrorsDisableContact = diff --git a/tests/ChatTests/Groups.hs b/tests/ChatTests/Groups.hs index e74071c3b..32e4ff05b 100644 --- a/tests/ChatTests/Groups.hs +++ b/tests/ChatTests/Groups.hs @@ -32,6 +32,7 @@ chatGroupTests = do it "list groups containing group invitations" testGroupList it "group message quoted replies" testGroupMessageQuotedReply it "group message update" testGroupMessageUpdate + it "group message edit history" testGroupMessageEditHistory it "group message delete" testGroupMessageDelete it "group live message" testGroupLiveMessage it "update group profile" testUpdateGroupProfile @@ -875,6 +876,76 @@ testGroupMessageUpdate = bob #$> ("/_get chat #1 count=3", chat', [((0, "greetings 🤝"), Nothing), ((1, "hi alice"), Just (0, "hey 👋")), ((0, "greetings!"), Just (0, "greetings 🤝"))]) cath #$> ("/_get chat #1 count=3", chat', [((0, "greetings 🤝"), Nothing), ((0, "hi alice"), Just (0, "hey 👋")), ((1, "greetings!"), Just (0, "greetings 🤝"))]) +testGroupMessageEditHistory :: HasCallStack => FilePath -> IO () +testGroupMessageEditHistory = + testChat2 aliceProfile bobProfile $ + \alice bob -> do + createGroup2 "team" alice bob + threadDelay 1000000 + alice #> "#team hello!" + bob <# "#team alice> hello!" + aliceItemId <- lastItemId alice + bobItemId <- lastItemId bob + + alice ##> ("/_get item info " <> aliceItemId) + alice <##. "sent at: " + bob ##> ("/_get item info " <> bobItemId) + bob <##. "sent at: " + bob <##. "received at: " + + alice ##> ("/_update item #1 " <> aliceItemId <> " text hey 👋") + alice <# "#team [edited] hey 👋" + bob <# "#team alice> [edited] hey 👋" + + alice ##> ("/_get item info " <> aliceItemId) + alice <##. "sent at: " + alice <## "message history:" + alice .<## ": hey 👋" + alice .<## ": hello!" + bob ##> ("/_get item info " <> bobItemId) + bob <##. "sent at: " + bob <##. "received at: " + bob <## "message history:" + bob .<## ": hey 👋" + bob .<## ": hello!" + + alice ##> ("/_update item #1 " <> aliceItemId <> " text hello there") + alice <# "#team [edited] hello there" + bob <# "#team alice> [edited] hello there" + + alice ##> "/item info #team hello" + alice <##. "sent at: " + alice <## "message history:" + alice .<## ": hello there" + alice .<## ": hey 👋" + alice .<## ": hello!" + bob ##> "/item info #team hello" + bob <##. "sent at: " + bob <##. "received at: " + bob <## "message history:" + bob .<## ": hello there" + bob .<## ": hey 👋" + bob .<## ": hello!" + + bob #$> ("/_delete item #1 " <> bobItemId <> " internal", id, "message deleted") + + alice ##> ("/_update item #1 " <> aliceItemId <> " text hey there") + alice <# "#team [edited] hey there" + bob <# "#team alice> [edited] hey there" + + alice ##> "/item info #team hey" + alice <##. "sent at: " + alice <## "message history:" + alice .<## ": hey there" + alice .<## ": hello there" + alice .<## ": hey 👋" + alice .<## ": hello!" + bob ##> "/item info #team hey" + bob <##. "sent at: " + bob <##. "received at: " + bob <## "message history:" + bob .<## ": hey there" + testGroupMessageDelete :: HasCallStack => FilePath -> IO () testGroupMessageDelete = testChat3 aliceProfile bobProfile cathProfile $ @@ -981,6 +1052,19 @@ testGroupLiveMessage = alice <# "#team [LIVE] hello 2" bob <# "#team alice> [LIVE ended] hello 2" cath <# "#team alice> [LIVE ended] hello 2" + -- live message has edit history + alice ##> ("/_get item info " <> msgItemId2) + alice <##. "sent at: " + alice <## "message history:" + alice .<## ": hello 2" + alice .<## ":" + bobItemId <- lastItemId bob + bob ##> ("/_get item info " <> bobItemId) + bob <##. "sent at: " + bob <##. "received at: " + bob <## "message history:" + bob .<## ": hello 2" + bob .<## ":" testUpdateGroupProfile :: HasCallStack => FilePath -> IO () testUpdateGroupProfile = diff --git a/tests/ChatTests/Utils.hs b/tests/ChatTests/Utils.hs index 18866fe2d..5abfbb013 100644 --- a/tests/ChatTests/Utils.hs +++ b/tests/ChatTests/Utils.hs @@ -231,6 +231,13 @@ cc <##. line = do unless prefix $ print ("expected to start from: " <> line, ", got: " <> l) prefix `shouldBe` True +(.<##) :: HasCallStack => TestCC -> String -> Expectation +cc .<## line = do + l <- getTermLine cc + let suffix = line `isSuffixOf` l + unless suffix $ print ("expected to end with: " <> line, ", got: " <> l) + suffix `shouldBe` True + (<#.) :: HasCallStack => TestCC -> String -> Expectation cc <#. line = do l <- dropTime <$> getTermLine cc