core: keep chat item edit history (#2410)

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}

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

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

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
+);

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

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}

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 =

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]