message replies and chat item references (#394)

* rfc for message replies and chat item references

* update replies rfc

* save received/sent shared message ids, migration and types for replies

* include reply/forward into MsgContent type

* add sharedMsgId to CIMeta

* save/get shared_msg_id to/from chat items table

* parameterize CIRef by chat type

* add CIRef to ChatItem when it is read from the db

* terminal command to send message replies

* include quoted content into chat items

* quoted message direction in direct chats (TODO test)

* test for replies with quotes to group messages - own and others

* split MsgContainer from MsgContent

* make quoting usable in the terminal

* add formattedText to quotes

* rename migration

* update JSON encoding for MsgContainer

* allow quoted replies to messages from clients not supporting it/not sending msg IDs

* update rfc

* fix group replies

* add APISendMessageQuote and use it for terminal commands

* change how quoted messages are shown in groups

src/Simplex/Chat/View.hs

@@ -151,34 +151,49 @@ responseToView testView = \case
         toChatView :: CChatItem c -> (Int, Text)
         toChatView (CChatItem dir ChatItem {meta}) = (msgDirectionInt $ toMsgDirection dir, itemText meta)
     viewErrorsSummary :: [a] -> StyledString -> [StyledString]
-    viewErrorsSummary summary s = if null summary then [] else [styled (colored Red) (T.pack . show $ length summary) <> s <> " (run with -c option to show each error)"]
+    viewErrorsSummary summary s = if null summary then [] else [ttyError (T.pack . show $ length summary) <> s <> " (run with -c option to show each error)"]
 
 viewChatItem :: ChatInfo c -> ChatItem c d -> [StyledString]
-viewChatItem chat (ChatItem cd meta content _) = case (chat, cd) of
-  (DirectChat c, CIDirectSnd) -> case content of
-    CISndMsgContent mc -> viewSentMessage to mc meta
-    CISndFileInvitation fId fPath -> viewSentFileInvitation to fId fPath meta
+viewChatItem chat (ChatItem {chatDir, meta, content, quotedItem}) = case chat of
+  DirectChat c -> case chatDir of
+    CIDirectSnd -> case content of
+      CISndMsgContent mc -> viewSentMessage to quote mc meta
+      CISndFileInvitation fId fPath -> viewSentFileInvitation to fId fPath meta
+      where
+        to = ttyToContact' c
+        quote = maybe [] (directQuote True) quotedItem
+    CIDirectRcv -> case content of
+      CIRcvMsgContent mc -> viewReceivedMessage from quote meta mc
+      CIRcvFileInvitation ft -> viewReceivedFileInvitation from meta ft
+      where
+        from = ttyFromContact' c
+        quote = maybe [] (directQuote False) quotedItem
+  GroupChat g -> case chatDir of
+    CIGroupSnd -> case content of
+      CISndMsgContent mc -> viewSentMessage to quote mc meta
+      CISndFileInvitation fId fPath -> viewSentFileInvitation to fId fPath meta
+      where
+        to = ttyToGroup g
+    CIGroupRcv m -> case content of
+      CIRcvMsgContent mc -> viewReceivedMessage from quote meta mc
+      CIRcvFileInvitation ft -> viewReceivedFileInvitation from meta ft
+      where
+        from = ttyFromGroup' g m
     where
-      to = ttyToContact' c
-  (DirectChat c, CIDirectRcv) -> case content of
-    CIRcvMsgContent mc -> viewReceivedMessage from meta mc -- mOk
-    CIRcvFileInvitation ft -> viewReceivedFileInvitation from meta ft -- mOk
-    where
-      from = ttyFromContact' c
-  (GroupChat g, CIGroupSnd) -> case content of
-    CISndMsgContent mc -> viewSentMessage to mc meta
-    CISndFileInvitation fId fPath -> viewSentFileInvitation to fId fPath meta
-    where
-      to = ttyToGroup g
-  (GroupChat g, CIGroupRcv m) -> case content of
-    CIRcvMsgContent mc -> viewReceivedMessage from meta mc -- mOk
-    CIRcvFileInvitation ft -> viewReceivedFileInvitation from meta ft -- mOk
-    where
-      from = ttyFromGroup' g m
+      quote = maybe [] groupQuote quotedItem
+  _ -> []
   where
-    ttyToContact' Contact {localDisplayName = c} = ttyToContact c
-    ttyFromContact' Contact {localDisplayName = c} = ttyFromContact c
-    ttyFromGroup' g GroupMember {localDisplayName = m} = ttyFromGroup g m
+    directQuote :: Bool -> CIQuote 'CTDirect -> [StyledString]
+    directQuote msgSent (CIQuoteDirect CIQuoteData {content = qmc} qouteSent) =
+      quoteText qmc $ if msgSent == qouteSent then ">>" else ">"
+    groupQuote :: CIQuote 'CTGroup -> [StyledString]
+    groupQuote (CIQuoteGroup CIQuoteData {content = qmc} m) = quoteText qmc $ ttyQuotedMember m
+    quoteText qmc sentBy = prependFirst (sentBy <> " ") $ msgPreview qmc
+    msgPreview = msgPlain . preview . msgContentText
+      where
+        preview t
+          | T.length t <= 60 = t
+          | otherwise = t <> "..."
 
 viewMsgIntegrityError :: MsgErrorType -> [StyledString]
 viewMsgIntegrityError err = msgError $ case err of
@@ -190,7 +205,7 @@ viewMsgIntegrityError err = msgError $ case err of
   MsgDuplicate -> "duplicate message ID"
   where
     msgError :: String -> [StyledString]
-    msgError s = [styled (colored Red) s]
+    msgError s = [ttyError s]
 
 viewInvalidConnReq :: [StyledString]
 viewInvalidConnReq =
@@ -357,13 +372,14 @@ viewContactUpdated
     where
       fullNameUpdate = if T.null fullName' || fullName' == n' then " removed full name" else " updated full name: " <> plain fullName'
 
-viewReceivedMessage :: StyledString -> CIMeta d -> MsgContent -> [StyledString]
-viewReceivedMessage from meta mc = receivedWithTime_ from meta (ttyMsgContent mc)
+viewReceivedMessage :: StyledString -> [StyledString] -> CIMeta d -> MsgContent -> [StyledString]
+viewReceivedMessage from quote meta = receivedWithTime_ from quote meta . ttyMsgContent
 
-receivedWithTime_ :: StyledString -> CIMeta d -> [StyledString] -> [StyledString]
-receivedWithTime_ from CIMeta {localItemTs, createdAt} styledMsg = do
-  prependFirst (formattedTime <> " " <> from) styledMsg -- ++ showIntegrity mOk
+receivedWithTime_ :: StyledString -> [StyledString] -> CIMeta d -> [StyledString] -> [StyledString]
+receivedWithTime_ from quote CIMeta {localItemTs, createdAt} styledMsg = do
+  prependFirst (formattedTime <> " " <> from) (quote <> prependFirst indent styledMsg)
   where
+    indent = if null quote then "" else "      "
     formattedTime :: StyledString
     formattedTime =
       let localTime = zonedTimeToLocalTime localItemTs
@@ -375,8 +391,10 @@ receivedWithTime_ from CIMeta {localItemTs, createdAt} styledMsg = do
               else "%H:%M"
        in styleTime $ formatTime defaultTimeLocale format localTime
 
-viewSentMessage :: StyledString -> MsgContent -> CIMeta d -> [StyledString]
-viewSentMessage to = sentWithTime_ . prependFirst to . ttyMsgContent
+viewSentMessage :: StyledString -> [StyledString] -> MsgContent -> CIMeta d -> [StyledString]
+viewSentMessage to quote mc = sentWithTime_ . prependFirst to $ quote <> prependFirst indent (ttyMsgContent mc)
+  where
+    indent = if null quote then "" else "      "
 
 viewSentFileInvitation :: StyledString -> FileTransferId -> FilePath -> CIMeta d -> [StyledString]
 viewSentFileInvitation to fId fPath = sentWithTime_ $ ttySentFile to fId fPath
@@ -389,9 +407,7 @@ ttyMsgTime :: ZonedTime -> StyledString
 ttyMsgTime = styleTime . formatTime defaultTimeLocale "%H:%M"
 
 ttyMsgContent :: MsgContent -> [StyledString]
-ttyMsgContent = \case
-  MCText t -> msgPlain t
-  MCUnknown _ t -> msgPlain t
+ttyMsgContent = msgPlain . msgContentText
 
 ttySentFile :: StyledString -> FileTransferId -> FilePath -> [StyledString]
 ttySentFile to fId fPath = ["/f " <> to <> ttyFilePath fPath, "use " <> highlight ("/fc " <> show fId) <> " to cancel sending"]
@@ -421,7 +437,7 @@ sndFile :: SndFileTransfer -> StyledString
 sndFile SndFileTransfer {fileId, fileName} = fileTransferStr fileId fileName
 
 viewReceivedFileInvitation :: StyledString -> CIMeta d -> RcvFileTransfer -> [StyledString]
-viewReceivedFileInvitation from meta ft = receivedWithTime_ from meta (receivedFileInvitation_ ft)
+viewReceivedFileInvitation from meta ft = receivedWithTime_ from [] meta (receivedFileInvitation_ ft)
 
 receivedFileInvitation_ :: RcvFileTransfer -> [StyledString]
 receivedFileInvitation_ RcvFileTransfer {fileId, fileInvitation = FileInvitation {fileName, fileSize}} =
@@ -523,6 +539,7 @@ viewChatError = \case
     CEFileSend fileId e -> ["error sending file " <> sShow fileId <> ": " <> sShow e]
     CEFileRcvChunk e -> ["error receiving file: " <> plain e]
     CEFileInternal e -> ["file error: " <> plain e]
+    CEInvalidQuote -> ["cannot reply to this message"]
     CEAgentVersion -> ["unsupported agent version"]
     CECommandError e -> ["bad chat command: " <> plain e]
   -- e -> ["chat error: " <> sShow e]
@@ -539,6 +556,7 @@ viewChatError = \case
     SEUserContactLinkNotFound -> ["no chat address, to create: " <> highlight' "/ad"]
     SEContactRequestNotFoundByName c -> ["no contact request from " <> ttyContact c]
     SEConnectionNotFound _ -> [] -- TODO mutes delete group error, but also mutes any error from getConnectionEntity
+    SEQuotedChatItemNotFound -> ["message not found - reply is not sent"]
     e -> ["chat db error: " <> sShow e]
   ChatErrorAgent err -> case err of
     SMP SMP.AUTH -> ["error: this connection is deleted"]
@@ -547,7 +565,7 @@ viewChatError = \case
     fileNotFound fileId = ["file " <> sShow fileId <> " not found"]
 
 ttyContact :: ContactName -> StyledString
-ttyContact = styled (colored Green)
+ttyContact = styled $ colored Green
 
 ttyContact' :: Contact -> StyledString
 ttyContact' Contact {localDisplayName = c} = ttyContact c
@@ -570,7 +588,19 @@ ttyToContact :: ContactName -> StyledString
 ttyToContact c = styled (colored Cyan) $ "@" <> c <> " "
 
 ttyFromContact :: ContactName -> StyledString
-ttyFromContact c = styled (colored Yellow) $ c <> "> "
+ttyFromContact c = ttyFrom $ c <> "> "
+
+ttyToContact' :: Contact -> StyledString
+ttyToContact' Contact {localDisplayName = c} = ttyToContact c
+
+ttyQuotedContact :: Contact -> StyledString
+ttyQuotedContact Contact {localDisplayName = c} = ttyFrom $ c <> ">"
+
+ttyQuotedMember :: GroupMember -> StyledString
+ttyQuotedMember GroupMember {localDisplayName = c} = "> " <> ttyFrom c
+
+ttyFromContact' :: Contact -> StyledString
+ttyFromContact' Contact {localDisplayName = c} = ttyFromContact c
 
 ttyGroup :: GroupName -> StyledString
 ttyGroup g = styled (colored Blue) $ "#" <> g
@@ -588,7 +618,13 @@ ttyFullGroup GroupInfo {localDisplayName = g, groupProfile = GroupProfile {fullN
   ttyGroup g <> optFullName g fullName
 
 ttyFromGroup :: GroupInfo -> ContactName -> StyledString
-ttyFromGroup GroupInfo {localDisplayName = g} c = styled (colored Yellow) $ "#" <> g <> " " <> c <> "> "
+ttyFromGroup GroupInfo {localDisplayName = g} c = ttyFrom $ "#" <> g <> " " <> c <> "> "
+
+ttyFrom :: Text -> StyledString
+ttyFrom = styled $ colored Yellow
+
+ttyFromGroup' :: GroupInfo -> GroupMember -> StyledString
+ttyFromGroup' g GroupMember {localDisplayName = m} = ttyFromGroup g m
 
 ttyToGroup :: GroupInfo -> StyledString
 ttyToGroup GroupInfo {localDisplayName = g} = styled (colored Cyan) $ "#" <> g <> " "
@@ -602,10 +638,16 @@ optFullName localDisplayName fullName
   | otherwise = plain (" (" <> fullName <> ")")
 
 highlight :: StyledFormat a => a -> StyledString
-highlight = styled (colored Cyan)
+highlight = styled $ colored Cyan
 
 highlight' :: String -> StyledString
 highlight' = highlight
 
 styleTime :: String -> StyledString
 styleTime = Styled [SetColor Foreground Vivid Black]
+
+ttyError :: StyledFormat a => a -> StyledString
+ttyError = styled $ colored Red
+
+ttyError' :: String -> StyledString
+ttyError' = ttyError