dandri/simplex-chat
1
0
Fork 0
mirror of https://github.com/simplex-chat/simplex-chat.git synced 2026-05-11 19:45:00 +00:00
Code Issues Packages Projects Releases Wiki Activity

core: api to forward messages (#3968)

Browse Source 
* wip

* wip

* test

* mute

* tests

* simplify (only bool flag)

* re-encrypt file

* tests

* more tests (wip)

* fix relative paths, refactor

* more tests

* more locks

* fix, tests

* more tests

* rework (revert from bool to ids)

* update schema

* more tests

* add to info

* ForwardedMsg container

* Revert "ForwardedMsg container"

This reverts commit bb57f12151.

* parser

* more tests

* rework api

* more locks

* test

* move

* remove from

* view

* prohibit editing

* item info view

---------

Co-authored-by: spaced4ndy <8711996+spaced4ndy@users.noreply.github.com>
This commit is contained in:
Evgeny Poberezkin
2024-04-09 13:02:59 +01:00
committed by GitHub
parent f8e6a78a3b
commit a5db36469d
17 changed files with 1061 additions and 211 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Simplex/Chat/View.hs
+73 -31
View File
@@ -536,60 +536,68 @@ viewChats ts tz = concatMap chatPreview . reverse
_ -> []
viewChatItem :: forall c d. MsgDirectionI d => ChatInfo c -> ChatItem c d -> Bool -> CurrentTime -> TimeZone -> [StyledString]
viewChatItem chat ci@ChatItem {chatDir, meta = meta@CIMeta {forwardedByMember}, content, quotedItem, file} doShow ts tz =
viewChatItem chat ci@ChatItem {chatDir, meta = meta@CIMeta {itemForwarded, forwardedByMember}, content, quotedItem, file} doShow ts tz =
withGroupMsgForwarded . withItemDeleted <$> viewCI
where
viewCI = case chat of
DirectChat c -> case chatDir of
CIDirectSnd -> case content of
CISndMsgContent mc -> hideLive meta $ withSndFile to $ sndMsg to quote mc
CISndMsgContent mc -> hideLive meta $ withSndFile to $ sndMsg to context mc
CISndGroupEvent {} -> showSndItemProhibited to
_ -> showSndItem to
where
to = ttyToContact' c
CIDirectRcv -> case content of
CIRcvMsgContent mc -> withRcvFile from $ rcvMsg from quote mc
CIRcvMsgContent mc -> withRcvFile from $ rcvMsg from context mc
CIRcvIntegrityError err -> viewRcvIntegrityError from err ts tz meta
CIRcvGroupEvent {} -> showRcvItemProhibited from
_ -> showRcvItem from
where
from = ttyFromContact c
where
quote = maybe [] (directQuote chatDir) quotedItem
context =
maybe
(maybe [] forwardedFrom itemForwarded)
(directQuote chatDir)
quotedItem
GroupChat g -> case chatDir of
CIGroupSnd -> case content of
CISndMsgContent mc -> hideLive meta $ withSndFile to $ sndMsg to quote mc
CISndMsgContent mc -> hideLive meta $ withSndFile to $ sndMsg to context mc
CISndGroupInvitation {} -> showSndItemProhibited to
_ -> showSndItem to
where
to = ttyToGroup g
CIGroupRcv m -> case content of
CIRcvMsgContent mc -> withRcvFile from $ rcvMsg from quote mc
CIRcvMsgContent mc -> withRcvFile from $ rcvMsg from context mc
CIRcvIntegrityError err -> viewRcvIntegrityError from err ts tz meta
CIRcvGroupInvitation {} -> showRcvItemProhibited from
CIRcvModerated {} -> receivedWithTime_ ts tz (ttyFromGroup g m) quote meta [plainContent content] False
CIRcvBlocked {} -> receivedWithTime_ ts tz (ttyFromGroup g m) quote meta [plainContent content] False
CIRcvModerated {} -> receivedWithTime_ ts tz (ttyFromGroup g m) context meta [plainContent content] False
CIRcvBlocked {} -> receivedWithTime_ ts tz (ttyFromGroup g m) context meta [plainContent content] False
_ -> showRcvItem from
where
from = ttyFromGroup g m
where
quote = maybe [] (groupQuote g) quotedItem
context =
maybe
(maybe [] forwardedFrom itemForwarded)
(groupQuote g)
quotedItem
LocalChat _ -> case chatDir of
CILocalSnd -> case content of
CISndMsgContent mc -> hideLive meta $ withLocalFile to $ sndMsg to quote mc
CISndMsgContent mc -> hideLive meta $ withLocalFile to $ sndMsg to context mc
CISndGroupEvent {} -> showSndItemProhibited to
_ -> showSndItem to
where
to = "* "
CILocalRcv -> case content of
CIRcvMsgContent mc -> withLocalFile from $ rcvMsg from quote mc
CIRcvMsgContent mc -> withLocalFile from $ rcvMsg from context mc
CIRcvIntegrityError err -> viewRcvIntegrityError from err ts tz meta
CIRcvGroupEvent {} -> showRcvItemProhibited from
_ -> showRcvItem from
where
from = "* "
where
quote = []
context = maybe [] forwardedFrom itemForwarded
ContactRequest {} -> []
ContactConnection {} -> []
withItemDeleted item = case chatItemDeletedText ci (chatInfoMembership chat) of
@@ -604,10 +612,10 @@ viewChatItem chat ci@ChatItem {chatDir, meta = meta@CIMeta {forwardedByMember},
withFile view dir l = maybe l (\f -> l <> view dir f ts tz meta) file
sndMsg = msg viewSentMessage
rcvMsg = msg viewReceivedMessage
msg view dir quote mc = case (msgContentText mc, file, quote) of
msg view dir context mc = case (msgContentText mc, file, context) of
("", Just _, []) -> []
("", Just CIFile {fileName}, _) -> view dir quote (MCText $ T.pack fileName) ts tz meta
_ -> view dir quote mc ts tz meta
("", Just CIFile {fileName}, _) -> view dir context (MCText $ T.pack fileName) ts tz meta
_ -> view dir context mc ts tz meta
showSndItem to = showItem $ sentWithTime_ ts tz [to <> plainContent content] meta
showRcvItem from = showItem $ receivedWithTime_ ts tz from [] meta [plainContent content] False
showSndItemProhibited to = showItem $ sentWithTime_ ts tz [to <> plainContent content <> " " <> prohibited] meta
@@ -617,11 +625,12 @@ viewChatItem chat ci@ChatItem {chatDir, meta = meta@CIMeta {forwardedByMember},
prohibited = styled (colored Red) ("[unexpected chat item created, please report to developers]" :: String)
viewChatItemInfo :: AChatItem -> ChatItemInfo -> TimeZone -> [StyledString]
viewChatItemInfo (AChatItem _ msgDir _ ChatItem {meta = CIMeta {itemTs, itemTimed, createdAt}}) ChatItemInfo {itemVersions} tz =
viewChatItemInfo (AChatItem _ msgDir _ ChatItem {meta = CIMeta {itemTs, itemTimed, createdAt}}) ChatItemInfo {itemVersions, forwardedFromChatItem} tz =
["sent at: " <> ts itemTs]
<> receivedAt
<> toBeDeletedAt
<> versions
<> forwardedFrom'
where
ts = styleTime . localTs tz
receivedAt = case msgDir of
@@ -634,7 +643,21 @@ viewChatItemInfo (AChatItem _ msgDir _ ChatItem {meta = CIMeta {itemTs, itemTime
if null itemVersions
then []
else ["message history:"] <> concatMap version itemVersions
version ChatItemVersion {msgContent, itemVersionTs} = prependFirst (ts itemVersionTs <> styleTime ": ") $ ttyMsgContent msgContent
where
version ChatItemVersion {msgContent, itemVersionTs} = prependFirst (ts itemVersionTs <> styleTime ": ") $ ttyMsgContent msgContent
forwardedFrom' =
case forwardedFromChatItem of
Just fwdACI@(AChatItem _ fwdMsgDir fwdChatInfo _) ->
[plain $ "forwarded from: " <> maybe "" (<> ", ") fwdDir_ <> fwdItemId]
where
fwdDir_ = case (fwdMsgDir, fwdChatInfo) of
(SMDSnd, DirectChat ct) -> Just $ "you @" <> viewContactName ct
(SMDRcv, DirectChat ct) -> Just $ "@" <> viewContactName ct
(SMDSnd, GroupChat gInfo) -> Just $ "you #" <> viewGroupName gInfo
(SMDRcv, GroupChat gInfo) -> Just $ "#" <> viewGroupName gInfo
_ -> Nothing
fwdItemId = "chat item id: " <> (T.pack . show $ aChatItemId fwdACI)
_ -> []
localTs :: TimeZone -> UTCTime -> String
localTs tz ts = do
@@ -666,37 +689,45 @@ viewDeliveryReceipt = \case
MRBadMsgHash -> ttyError' "⩗!"
viewItemUpdate :: MsgDirectionI d => ChatInfo c -> ChatItem c d -> Bool -> CurrentTime -> TimeZone -> [StyledString]
viewItemUpdate chat ChatItem {chatDir, meta = meta@CIMeta {itemEdited, itemLive}, content, quotedItem} liveItems ts tz = case chat of
viewItemUpdate chat ChatItem {chatDir, meta = meta@CIMeta {itemForwarded, itemEdited, itemLive}, content, quotedItem} liveItems ts tz = case chat of
DirectChat c -> case chatDir of
CIDirectRcv -> case content of
CIRcvMsgContent mc
| itemLive == Just True && not liveItems -> []
| otherwise -> viewReceivedUpdatedMessage from quote mc ts tz meta
| otherwise -> viewReceivedUpdatedMessage from context mc ts tz meta
_ -> []
where
from = if itemEdited then ttyFromContactEdited c else ttyFromContact c
CIDirectSnd -> case content of
CISndMsgContent mc -> hideLive meta $ viewSentMessage to quote mc ts tz meta
CISndMsgContent mc -> hideLive meta $ viewSentMessage to context mc ts tz meta
_ -> []
where
to = if itemEdited then ttyToContactEdited' c else ttyToContact' c
where
quote = maybe [] (directQuote chatDir) quotedItem
context =
maybe
(maybe [] forwardedFrom itemForwarded)
(directQuote chatDir)
quotedItem
GroupChat g -> case chatDir of
CIGroupRcv m -> case content of
CIRcvMsgContent mc
| itemLive == Just True && not liveItems -> []
| otherwise -> viewReceivedUpdatedMessage from quote mc ts tz meta
| otherwise -> viewReceivedUpdatedMessage from context mc ts tz meta
_ -> []
where
from = if itemEdited then ttyFromGroupEdited g m else ttyFromGroup g m
CIGroupSnd -> case content of
CISndMsgContent mc -> hideLive meta $ viewSentMessage to quote mc ts tz meta
CISndMsgContent mc -> hideLive meta $ viewSentMessage to context mc ts tz meta
_ -> []
where
to = if itemEdited then ttyToGroupEdited g else ttyToGroup g
where
quote = maybe [] (groupQuote g) quotedItem
context =
maybe
(maybe [] forwardedFrom itemForwarded)
(groupQuote g)
quotedItem
_ -> []
hideLive :: CIMeta c d -> [StyledString] -> [StyledString]
@@ -778,6 +809,14 @@ directQuote _ CIQuote {content = qmc, chatDir = quoteDir} =
groupQuote :: GroupInfo -> CIQuote 'CTGroup -> [StyledString]
groupQuote g CIQuote {content = qmc, chatDir = quoteDir} = quoteText qmc . ttyQuotedMember $ sentByMember g quoteDir
forwardedFrom :: CIForwardedFrom -> [StyledString]
forwardedFrom = \case
CIFFUnknown -> ["-> forwarded"]
CIFFContact c MDSnd _ _ -> ["<- you @" <> (plain . viewName) c]
CIFFContact c MDRcv _ _ -> ["<- @" <> (plain . viewName) c]
CIFFGroup g MDSnd _ _ -> ["<- you #" <> (plain . viewName) g]
CIFFGroup g MDRcv _ _ -> ["<- #" <> (plain . viewName) g]
sentByMember :: GroupInfo -> CIQDirection 'CTGroup -> Maybe GroupMember
sentByMember GroupInfo {membership} = \case
CIQGroupSnd -> Just membership
@@ -836,7 +875,9 @@ 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"]
_ -> []
LocalChat _ -> ["notes: all messages are removed"]
ContactRequest _ -> []
ContactConnection _ -> []
viewContactsList :: [Contact] -> [StyledString]
viewContactsList =
@@ -1484,17 +1525,17 @@ viewReceivedUpdatedMessage :: StyledString -> [StyledString] -> MsgContent -> Cu
viewReceivedUpdatedMessage = viewReceivedMessage_ True
viewReceivedMessage_ :: Bool -> StyledString -> [StyledString] -> MsgContent -> CurrentTime -> TimeZone -> CIMeta c d -> [StyledString]
viewReceivedMessage_ updated from quote mc ts tz meta = receivedWithTime_ ts tz from quote meta (ttyMsgContent mc) updated
viewReceivedMessage_ updated from context mc ts tz meta = receivedWithTime_ ts tz from context meta (ttyMsgContent mc) updated
viewReceivedReaction :: StyledString -> [StyledString] -> StyledString -> CurrentTime -> TimeZone -> UTCTime -> [StyledString]
viewReceivedReaction from styledMsg reactionText ts tz reactionTs =
prependFirst (ttyMsgTime ts tz reactionTs <> " " <> from) (styledMsg <> [" " <> reactionText])
receivedWithTime_ :: CurrentTime -> TimeZone -> StyledString -> [StyledString] -> CIMeta c d -> [StyledString] -> Bool -> [StyledString]
receivedWithTime_ ts tz from quote CIMeta {itemId, itemTs, itemEdited, itemDeleted, itemLive} styledMsg updated = do
prependFirst (ttyMsgTime ts tz itemTs <> " " <> from) (quote <> prependFirst (indent <> live) styledMsg)
receivedWithTime_ ts tz from context CIMeta {itemId, itemTs, itemEdited, itemDeleted, itemLive} styledMsg updated = do
prependFirst (ttyMsgTime ts tz itemTs <> " " <> from) (context <> prependFirst (indent <> live) styledMsg)
where
indent = if null quote then "" else " "
indent = if null context then "" else " "
live
| itemEdited || isJust itemDeleted = ""
| otherwise = case itemLive of
@@ -1522,9 +1563,9 @@ recent now tz time = do
|| (localNow < currentDay12 && localTime >= previousDay18 && localTimeDay < localNowDay)
viewSentMessage :: StyledString -> [StyledString] -> MsgContent -> CurrentTime -> TimeZone -> CIMeta c d -> [StyledString]
viewSentMessage to quote mc ts tz meta@CIMeta {itemEdited, itemDeleted, itemLive} = sentWithTime_ ts tz (prependFirst to $ quote <> prependFirst (indent <> live) (ttyMsgContent mc)) meta
viewSentMessage to context mc ts tz meta@CIMeta {itemEdited, itemDeleted, itemLive} = sentWithTime_ ts tz (prependFirst to $ context <> prependFirst (indent <> live) (ttyMsgContent mc)) meta
where
indent = if null quote then "" else " "
indent = if null context then "" else " "
live
| itemEdited || isJust itemDeleted = ""
| otherwise = case itemLive of
@@ -1926,6 +1967,7 @@ viewChatError logLevel testView = \case
CEFallbackToSMPProhibited fileId -> ["recipient tried to accept file " <> sShow fileId <> " via old protocol, prohibited"]
CEInlineFileProhibited _ -> ["A small file sent without acceptance - you can enable receiving such files with -f option."]
CEInvalidQuote -> ["cannot reply to this message"]
CEInvalidForward -> ["cannot forward this message"]
CEInvalidChatItemUpdate -> ["cannot update this item"]
CEInvalidChatItemDelete -> ["cannot delete this item"]
CEHasCurrentCall -> ["call already in progress"]