From 309b71817e408863a6c0d16d6665ce6ea6fbed8c Mon Sep 17 00:00:00 2001 From: spaced4ndy <8711996+spaced4ndy@users.noreply.github.com> Date: Fri, 5 Apr 2024 20:25:39 +0400 Subject: [PATCH] rework (revert from bool to ids) --- src/Simplex/Chat.hs | 109 ++++++++++++------ src/Simplex/Chat/Messages.hs | 39 ++++++- src/Simplex/Chat/Messages/CIContent.hs | 2 + .../Migrations/M20240402_item_forwarded.hs | 27 +++-- src/Simplex/Chat/Protocol.hs | 5 - src/Simplex/Chat/Store/Messages.hs | 87 +++++++++----- src/Simplex/Chat/View.hs | 39 +++++-- tests/ChatTests/Forward.hs | 58 ++++------ 8 files changed, 246 insertions(+), 120 deletions(-) diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs index 8615dcf8b2..223fece350 100644 --- a/src/Simplex/Chat.hs +++ b/src/Simplex/Chat.hs @@ -708,14 +708,14 @@ processChatCommand' vr = \case pure $ CRChatItemInfo user aci ChatItemInfo {itemVersions, memberDeliveryStatuses} APISendMessage (ChatRef cType chatId) live itemTTL cm -> withUser $ \user -> case cType of CTDirect -> withContactLock "sendMessage" chatId $ - sendContactContentMessage user chatId live itemTTL cm False + sendContactContentMessage user chatId live itemTTL cm Nothing CTGroup -> withGroupLock "sendMessage" chatId $ - sendGroupContentMessage user chatId live itemTTL cm False + sendGroupContentMessage user chatId live itemTTL cm Nothing CTLocal -> pure $ chatCmdError (Just user) "not supported" CTContactRequest -> pure $ chatCmdError (Just user) "not supported" CTContactConnection -> pure $ chatCmdError (Just user) "not supported" APICreateChatItem folderId cm -> withUser $ \user -> - createNoteFolderContentItem user folderId cm False + createNoteFolderContentItem user folderId cm Nothing APIUpdateChatItem (ChatRef cType chatId) itemId live mc -> withUser $ \user -> case cType of CTDirect -> withContactLock "updateChatItem" chatId $ do ct@Contact {contactId} <- withStore $ \db -> getContact db vr user chatId @@ -860,31 +860,64 @@ processChatCommand' vr = \case throwChatError (CECommandError $ "reaction already " <> if add then "added" else "removed") when (add && length rs >= maxMsgReactions) $ throwChatError (CECommandError "too many reactions") - APIForwardChatItem fromChatRef (ChatRef toCType toChatId) itemId -> withUser $ \user -> case toCType of + APIForwardChatItem (ChatRef fromCType fromChatId) (ChatRef toCType toChatId) itemId -> withUser $ \user -> case toCType of CTDirect -> withContactLock "sendMessage" toChatId $ do - cm <- prepareForward user - sendContactContentMessage user toChatId False Nothing cm True + (cm, ciff) <- prepareForward user + sendContactContentMessage user toChatId False Nothing cm ciff CTGroup -> withGroupLock "sendMessage" toChatId $ do - cm <- prepareForward user - sendGroupContentMessage user toChatId False Nothing cm True + (cm, ciff) <- prepareForward user + sendGroupContentMessage user toChatId False Nothing cm ciff CTLocal -> do - cm <- prepareForward user - createNoteFolderContentItem user toChatId cm True + (cm, ciff) <- prepareForward user + createNoteFolderContentItem user toChatId cm ciff CTContactRequest -> pure $ chatCmdError (Just user) "not supported" CTContactConnection -> pure $ chatCmdError (Just user) "not supported" where - prepareForward :: User -> CM ComposedMessage - prepareForward user = do - (AChatItem _ _ _ ci) <- withStore $ \db -> getAChatItem db vr user fromChatRef itemId - mc <- forwardMC ci - file <- forwardCryptoFile ci `catchChatError` (\e -> toView (CRChatError (Just user) e) $> Nothing) - pure $ ComposedMessage file Nothing mc + prepareForward :: User -> CM (ComposedMessage, Maybe CIForwardedFrom) + prepareForward user = case fromCType of + CTDirect -> do + (ct, CChatItem _ ci) <- withStore $ \db -> do + ct <- getContact db vr user fromChatId + cci <- getDirectChatItem db user fromChatId itemId + pure (ct, cci) + (mc, mDir) <- forwardMC ci + file <- forwardCryptoFile ci `catchChatError` (\e -> toView (CRChatError (Just user) e) $> Nothing) + let ciff = forwardCIFF ci $ Just (CIFFContact (forwardName ct) mDir (Just fromChatId) (Just itemId)) + pure (ComposedMessage file Nothing mc, ciff) + where + forwardName :: Contact -> ContactName + forwardName Contact {profile = LocalProfile {displayName, localAlias}} + | localAlias /= "" = localAlias + | otherwise = displayName + CTGroup -> do + (gInfo, CChatItem _ ci) <- withStore $ \db -> do + gInfo <- getGroupInfo db vr user fromChatId + cci <- getGroupChatItem db user fromChatId itemId + pure (gInfo, cci) + (mc, mDir) <- forwardMC ci + file <- forwardCryptoFile ci `catchChatError` (\e -> toView (CRChatError (Just user) e) $> Nothing) + let ciff = forwardCIFF ci $ Just (CIFFGroup (forwardName gInfo) mDir (Just fromChatId) (Just itemId)) + pure (ComposedMessage file Nothing mc, ciff) + where + forwardName :: GroupInfo -> ContactName + forwardName GroupInfo {groupProfile = GroupProfile {displayName}} = displayName + CTLocal -> do + (CChatItem _ ci) <- withStore $ \db -> getLocalChatItem db user fromChatId itemId + (mc, _) <- forwardMC ci + file <- forwardCryptoFile ci `catchChatError` (\e -> toView (CRChatError (Just user) e) $> Nothing) + let ciff = forwardCIFF ci Nothing + pure (ComposedMessage file Nothing mc, ciff) + CTContactRequest -> throwChatError $ CECommandError "not supported" + CTContactConnection -> throwChatError $ CECommandError "not supported" where - forwardMC :: ChatItem c d -> CM MsgContent + forwardMC :: ChatItem c d -> CM (MsgContent, MsgDirection) forwardMC ChatItem {meta = CIMeta {itemDeleted = Just _}} = throwChatError CEInvalidForward - forwardMC ChatItem {content = CISndMsgContent fmc} = pure fmc - forwardMC ChatItem {content = CIRcvMsgContent fmc} = pure fmc + forwardMC ChatItem {content = CISndMsgContent fmc} = pure (fmc, MDSnd) + forwardMC ChatItem {content = CIRcvMsgContent fmc} = pure (fmc, MDRcv) forwardMC _ = throwChatError CEInvalidForward + forwardCIFF :: ChatItem c d -> Maybe CIForwardedFrom -> Maybe CIForwardedFrom + forwardCIFF ChatItem {meta = CIMeta {itemForwarded = Just ciff}} _ = Just ciff + forwardCIFF _ ciff = ciff forwardCryptoFile :: ChatItem c d -> CM (Maybe CryptoFile) forwardCryptoFile ChatItem {file = Just CIFile {fileName, fileStatus, fileSource = Just fromCF@CryptoFile {filePath}}} | ciFileLoaded fileStatus = @@ -1600,7 +1633,7 @@ processChatCommand' vr = \case combineResults _ _ (Left e) = Left e createCI :: DB.Connection -> User -> UTCTime -> (Contact, SndMessage) -> IO () createCI db user createdAt (ct, sndMsg) = - void $ createNewSndChatItem db user (CDDirectSnd ct) sndMsg (CISndMsgContent mc) Nothing False Nothing False createdAt + void $ createNewSndChatItem db user (CDDirectSnd ct) sndMsg (CISndMsgContent mc) Nothing Nothing Nothing False createdAt SendMessageQuote cName (AMsgDirection msgDir) quotedMsg msg -> withUser $ \user@User {userId} -> do contactId <- withStore $ \db -> getContactIdByName db user cName quotedItemId <- withStore $ \db -> getDirectChatItemIdByText db userId contactId msgDir quotedMsg @@ -2564,7 +2597,7 @@ processChatCommand' vr = \case let aciContent = ACIContent SMDRcv $ CIRcvGroupInvitation ciGroupInv {status = newStatus} memRole updateDirectChatItemView user ct itemId aciContent False Nothing _ -> pure () -- prohibited - sendContactContentMessage :: User -> ContactId -> Bool -> Maybe Int -> ComposedMessage -> Bool -> CM ChatResponse + sendContactContentMessage :: User -> ContactId -> Bool -> Maybe Int -> ComposedMessage -> Maybe CIForwardedFrom -> CM ChatResponse sendContactContentMessage user contactId live itemTTL (ComposedMessage file_ quotedItemId_ mc) itemForwarded = do ct@Contact {contactUsed} <- withStore $ \db -> getContact db vr user contactId assertDirectAllowed user MDSnd ct XMsgNew_ @@ -2587,9 +2620,9 @@ processChatCommand' vr = \case xftpSndFileTransfer user file fileSize 1 $ CGContact ct prepareMsg :: Maybe FileInvitation -> Maybe CITimed -> CM (MsgContainer, Maybe (CIQuote 'CTDirect)) prepareMsg fInv_ timed_ = case (quotedItemId_, itemForwarded) of - (Nothing, False) -> pure (MCSimple (ExtMsgContent mc fInv_ (ttl' <$> timed_) (justTrue live)), Nothing) - (Nothing, True) -> pure (MCForward (ExtMsgContent mc fInv_ (ttl' <$> timed_) (justTrue live)), Nothing) - (Just quotedItemId, False) -> do + (Nothing, Nothing) -> pure (MCSimple (ExtMsgContent mc fInv_ (ttl' <$> timed_) (justTrue live)), Nothing) + (Nothing, Just _) -> pure (MCForward (ExtMsgContent mc fInv_ (ttl' <$> timed_) (justTrue live)), Nothing) + (Just quotedItemId, Nothing) -> do CChatItem _ qci@ChatItem {meta = CIMeta {itemTs, itemSharedMsgId}, formattedText, file} <- withStore $ \db -> getDirectChatItem db user contactId quotedItemId (origQmc, qd, sent) <- quoteData qci @@ -2597,14 +2630,14 @@ processChatCommand' vr = \case qmc = quoteContent mc origQmc file quotedItem = CIQuote {chatDir = qd, itemId = Just quotedItemId, sharedMsgId = itemSharedMsgId, sentAt = itemTs, content = qmc, formattedText} pure (MCQuote QuotedMsg {msgRef, content = qmc} (ExtMsgContent mc fInv_ (ttl' <$> timed_) (justTrue live)), Just quotedItem) - (Just _, True) -> throwChatError CEInvalidQuote + (Just _, Just _) -> throwChatError CEInvalidQuote where quoteData :: ChatItem c d -> CM (MsgContent, CIQDirection 'CTDirect, Bool) quoteData ChatItem {meta = CIMeta {itemDeleted = Just _}} = throwChatError CEInvalidQuote quoteData ChatItem {content = CISndMsgContent qmc} = pure (qmc, CIQDirectSnd, True) quoteData ChatItem {content = CIRcvMsgContent qmc} = pure (qmc, CIQDirectRcv, False) quoteData _ = throwChatError CEInvalidQuote - sendGroupContentMessage :: User -> GroupId -> Bool -> Maybe Int -> ComposedMessage -> Bool -> CM ChatResponse + sendGroupContentMessage :: User -> GroupId -> Bool -> Maybe Int -> ComposedMessage -> Maybe CIForwardedFrom -> CM ChatResponse sendGroupContentMessage user groupId live itemTTL (ComposedMessage file_ quotedItemId_ mc) itemForwarded = do g@(Group gInfo _) <- withStore $ \db -> getGroup db vr user groupId assertUserGroupRole gInfo GRAuthor @@ -2645,7 +2678,7 @@ processChatCommand' vr = \case \db -> createSndFTDescrXFTP db user (Just m) conn ft dummyFileDescr saveMemberFD _ = pure () pure (fInv, ciFile) - createNoteFolderContentItem :: User -> NoteFolderId -> ComposedMessage -> Bool -> CM ChatResponse + createNoteFolderContentItem :: User -> NoteFolderId -> ComposedMessage -> Maybe CIForwardedFrom -> CM ChatResponse createNoteFolderContentItem user folderId (ComposedMessage file_ quotedItemId_ mc) itemForwarded = do forM_ quotedItemId_ $ \_ -> throwError $ ChatError $ CECommandError "not supported" nf <- withStore $ \db -> getNoteFolder db user folderId @@ -2676,11 +2709,11 @@ data ChangedProfileContact = ChangedProfileContact conn :: Connection } -prepareGroupMsg :: User -> GroupInfo -> MsgContent -> Maybe ChatItemId -> Bool -> Maybe FileInvitation -> Maybe CITimed -> Bool -> CM (MsgContainer, Maybe (CIQuote 'CTGroup)) +prepareGroupMsg :: User -> GroupInfo -> MsgContent -> Maybe ChatItemId -> Maybe CIForwardedFrom -> Maybe FileInvitation -> Maybe CITimed -> Bool -> CM (MsgContainer, Maybe (CIQuote 'CTGroup)) prepareGroupMsg user GroupInfo {groupId, membership} mc quotedItemId_ itemForwarded fInv_ timed_ live = case (quotedItemId_, itemForwarded) of - (Nothing, False) -> pure (MCSimple (ExtMsgContent mc fInv_ (ttl' <$> timed_) (justTrue live)), Nothing) - (Nothing, True) -> pure (MCForward (ExtMsgContent mc fInv_ (ttl' <$> timed_) (justTrue live)), Nothing) - (Just quotedItemId, False) -> do + (Nothing, Nothing) -> pure (MCSimple (ExtMsgContent mc fInv_ (ttl' <$> timed_) (justTrue live)), Nothing) + (Nothing, Just _) -> pure (MCForward (ExtMsgContent mc fInv_ (ttl' <$> timed_) (justTrue live)), Nothing) + (Just quotedItemId, Nothing) -> do CChatItem _ qci@ChatItem {meta = CIMeta {itemTs, itemSharedMsgId}, formattedText, file} <- withStore $ \db -> getGroupChatItem db user groupId quotedItemId (origQmc, qd, sent, GroupMember {memberId}) <- quoteData qci membership @@ -2688,7 +2721,7 @@ prepareGroupMsg user GroupInfo {groupId, membership} mc quotedItemId_ itemForwar qmc = quoteContent mc origQmc file quotedItem = CIQuote {chatDir = qd, itemId = Just quotedItemId, sharedMsgId = itemSharedMsgId, sentAt = itemTs, content = qmc, formattedText} pure (MCQuote QuotedMsg {msgRef, content = qmc} (ExtMsgContent mc fInv_ (ttl' <$> timed_) (justTrue live)), Just quotedItem) - (Just _, True) -> throwChatError CEInvalidQuote + (Just _, Just _) -> throwChatError CEInvalidQuote where quoteData :: ChatItem c d -> GroupMember -> CM (MsgContent, CIQDirection 'CTGroup, Bool, GroupMember) quoteData ChatItem {meta = CIMeta {itemDeleted = Just _}} _ = throwChatError CEInvalidQuote @@ -4126,7 +4159,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = let CIMeta {itemTs, itemSharedMsgId, itemTimed} = meta quotedItemId_ = quoteItemId =<< quotedItem fInv_ = fst <$> fInvDescr_ - (msgContainer, _) <- prepareGroupMsg user gInfo mc quotedItemId_ False fInv_ itemTimed False + (msgContainer, _) <- prepareGroupMsg user gInfo mc quotedItemId_ Nothing fInv_ itemTimed False let senderVRange = memberChatVRange' sender xMsgNewChatMsg = ChatMessage {chatVRange = senderVRange, msgId = itemSharedMsgId, chatMsgEvent = XMsgNew msgContainer} fileDescrEvents <- case (snd <$> fInvDescr_, itemSharedMsgId) of @@ -6518,9 +6551,9 @@ saveGroupFwdRcvMsg user groupId forwardingMember refAuthorMember@GroupMember {me _ -> throwError e saveSndChatItem :: ChatTypeI c => User -> ChatDirection c 'MDSnd -> SndMessage -> CIContent 'MDSnd -> CM (ChatItem c 'MDSnd) -saveSndChatItem user cd msg content = saveSndChatItem' user cd msg content Nothing Nothing False Nothing False +saveSndChatItem user cd msg content = saveSndChatItem' user cd msg content Nothing Nothing Nothing Nothing False -saveSndChatItem' :: ChatTypeI c => User -> ChatDirection c 'MDSnd -> SndMessage -> CIContent 'MDSnd -> Maybe (CIFile 'MDSnd) -> Maybe (CIQuote c) -> Bool -> Maybe CITimed -> Bool -> CM (ChatItem c 'MDSnd) +saveSndChatItem' :: ChatTypeI c => User -> ChatDirection c 'MDSnd -> SndMessage -> CIContent 'MDSnd -> Maybe (CIFile 'MDSnd) -> Maybe (CIQuote c) -> Maybe CIForwardedFrom -> Maybe CITimed -> Bool -> CM (ChatItem c 'MDSnd) saveSndChatItem' user cd msg@SndMessage {sharedMsgId} content ciFile quotedItem itemForwarded itemTimed live = do createdAt <- liftIO getCurrentTime ciId <- withStore' $ \db -> do @@ -6544,7 +6577,7 @@ saveRcvChatItem' user cd msg@RcvMessage {forwardedByMember} sharedMsgId_ brokerT pure r pure $ mkChatItem cd ciId content ciFile quotedItem sharedMsgId_ itemForwarded itemTimed live brokerTs forwardedByMember createdAt -mkChatItem :: (ChatTypeI c, MsgDirectionI d) => ChatDirection c d -> ChatItemId -> CIContent d -> Maybe (CIFile d) -> Maybe (CIQuote c) -> Maybe SharedMsgId -> Bool -> Maybe CITimed -> Bool -> ChatItemTs -> Maybe GroupMemberId -> UTCTime -> ChatItem c d +mkChatItem :: (ChatTypeI c, MsgDirectionI d) => ChatDirection c d -> ChatItemId -> CIContent d -> Maybe (CIFile d) -> Maybe (CIQuote c) -> Maybe SharedMsgId -> Maybe CIForwardedFrom -> Maybe CITimed -> Bool -> ChatItemTs -> Maybe GroupMemberId -> UTCTime -> ChatItem c d mkChatItem cd ciId content file quotedItem sharedMsgId itemForwarded itemTimed live itemTs forwardedByMember currentTs = let itemText = ciContentToText content itemStatus = ciCreateStatus content @@ -6809,10 +6842,10 @@ createInternalItemsForChats user itemTs_ dirsCIContents = do createACIs :: DB.Connection -> UTCTime -> UTCTime -> ChatDirection c d -> [CIContent d] -> [IO AChatItem] createACIs db itemTs createdAt cd = map $ \content -> do ciId <- createNewChatItemNoMsg db user cd content itemTs createdAt - let ci = mkChatItem cd ciId content Nothing Nothing Nothing False Nothing False itemTs Nothing createdAt + let ci = mkChatItem cd ciId content Nothing Nothing Nothing Nothing Nothing False itemTs Nothing createdAt pure $ AChatItem (chatTypeI @c) (msgDirection @d) (toChatInfo cd) ci -createLocalChatItem :: MsgDirectionI d => User -> ChatDirection 'CTLocal d -> CIContent d -> Bool -> UTCTime -> CM ChatItemId +createLocalChatItem :: MsgDirectionI d => User -> ChatDirection 'CTLocal d -> CIContent d -> Maybe CIForwardedFrom -> UTCTime -> CM ChatItemId createLocalChatItem user cd content itemForwarded createdAt = do gVar <- asks random withStore $ \db -> do diff --git a/src/Simplex/Chat/Messages.hs b/src/Simplex/Chat/Messages.hs index 9f0bb038ac..50ec1dd80e 100644 --- a/src/Simplex/Chat/Messages.hs +++ b/src/Simplex/Chat/Messages.hs @@ -339,7 +339,7 @@ data CIMeta (c :: ChatType) (d :: MsgDirection) = CIMeta itemText :: Text, itemStatus :: CIStatus d, itemSharedMsgId :: Maybe SharedMsgId, - itemForwarded :: Bool, + itemForwarded :: Maybe CIForwardedFrom, itemDeleted :: Maybe (CIDeleted c), itemEdited :: Bool, itemTimed :: Maybe CITimed, @@ -351,7 +351,7 @@ data CIMeta (c :: ChatType) (d :: MsgDirection) = CIMeta } deriving (Show) -mkCIMeta :: forall c d. ChatTypeI c => ChatItemId -> CIContent d -> Text -> CIStatus d -> Maybe SharedMsgId -> Bool -> Maybe (CIDeleted c) -> Bool -> Maybe CITimed -> Maybe Bool -> UTCTime -> ChatItemTs -> Maybe GroupMemberId -> UTCTime -> UTCTime -> CIMeta c d +mkCIMeta :: forall c d. ChatTypeI c => ChatItemId -> CIContent d -> Text -> CIStatus d -> Maybe SharedMsgId -> Maybe CIForwardedFrom -> Maybe (CIDeleted c) -> Bool -> Maybe CITimed -> Maybe Bool -> UTCTime -> ChatItemTs -> Maybe GroupMemberId -> UTCTime -> UTCTime -> CIMeta c d mkCIMeta itemId itemContent itemText itemStatus itemSharedMsgId itemForwarded itemDeleted itemEdited itemTimed itemLive currentTs itemTs forwardedByMember createdAt updatedAt = let editable = case itemContent of CISndMsgContent _ -> @@ -369,7 +369,7 @@ dummyMeta itemId ts itemText = itemText, itemStatus = CISSndNew, itemSharedMsgId = Nothing, - itemForwarded = False, + itemForwarded = Nothing, itemDeleted = Nothing, itemEdited = False, itemTimed = Nothing, @@ -998,6 +998,37 @@ itemDeletedTs = \case CIBlockedByAdmin ts -> ts CIModerated ts _ -> ts +data CIForwardedFrom + = CIFFUnknown + | CIFFContact {chatName :: Text, msgDir :: MsgDirection, contactId :: Maybe ContactId, chatItemId :: Maybe ChatItemId} + | CIFFGroup {chatName :: Text, msgDir :: MsgDirection, groupId :: Maybe GroupId, chatItemId :: Maybe ChatItemId} + deriving (Show) + +cmForwardedFrom :: AChatMsgEvent -> Maybe CIForwardedFrom +cmForwardedFrom = \case + ACME _ (XMsgNew (MCForward _)) -> Just CIFFUnknown + _ -> Nothing + +data CIForwardedFromTag + = CIFFUnknown_ + | CIFFContact_ + | CIFFGroup_ + +instance FromField CIForwardedFromTag where fromField = fromTextField_ textDecode + +instance ToField CIForwardedFromTag where toField = toField . textEncode + +instance TextEncoding CIForwardedFromTag where + textDecode = \case + "unknown" -> Just CIFFUnknown_ + "contact" -> Just CIFFContact_ + "group" -> Just CIFFGroup_ + _ -> Nothing + textEncode = \case + CIFFUnknown_ -> "unknown" + CIFFContact_ -> "contact" + CIFFGroup_ -> "group" + data ChatItemInfo = ChatItemInfo { itemVersions :: [ChatItemVersion], memberDeliveryStatuses :: Maybe [MemberDeliveryStatus] @@ -1060,6 +1091,8 @@ instance ChatTypeI c => ToJSON (CIDeleted c) where toJSON = J.toJSON . jsonCIDeleted toEncoding = J.toEncoding . jsonCIDeleted +$(JQ.deriveJSON (sumTypeJSON $ dropPrefix "CIFF") ''CIForwardedFrom) + $(JQ.deriveJSON defaultJSON ''CITimed) $(JQ.deriveJSON (enumJSON $ dropPrefix "SSP") ''SndCIStatusProgress) diff --git a/src/Simplex/Chat/Messages/CIContent.hs b/src/Simplex/Chat/Messages/CIContent.hs index 9266a0c1ca..13aa7ace10 100644 --- a/src/Simplex/Chat/Messages/CIContent.hs +++ b/src/Simplex/Chat/Messages/CIContent.hs @@ -43,6 +43,8 @@ $(JQ.deriveJSON (enumJSON $ dropPrefix "MD") ''MsgDirection) instance FromField AMsgDirection where fromField = fromIntField_ $ fmap fromMsgDirection . msgDirectionIntP +instance FromField MsgDirection where fromField = fromIntField_ msgDirectionIntP + instance ToField MsgDirection where toField = toField . msgDirectionInt data SMsgDirection (d :: MsgDirection) where diff --git a/src/Simplex/Chat/Migrations/M20240402_item_forwarded.hs b/src/Simplex/Chat/Migrations/M20240402_item_forwarded.hs index 8b6b7e1c85..850c8be2d9 100644 --- a/src/Simplex/Chat/Migrations/M20240402_item_forwarded.hs +++ b/src/Simplex/Chat/Migrations/M20240402_item_forwarded.hs @@ -8,16 +8,29 @@ import Database.SQLite.Simple.QQ (sql) m20240402_item_forwarded :: Query m20240402_item_forwarded = [sql| -ALTER TABLE chat_items ADD COLUMN item_forwarded INTEGER; +ALTER TABLE chat_items ADD COLUMN fwd_from_tag TEXT; +ALTER TABLE chat_items ADD COLUMN fwd_from_chat_name TEXT; +ALTER TABLE chat_items ADD COLUMN fwd_from_msg_dir INTEGER; +ALTER TABLE chat_items ADD COLUMN fwd_from_contact_id INTEGER REFERENCES contacts ON DELETE SET NULL; +ALTER TABLE chat_items ADD COLUMN fwd_from_group_id INTEGER REFERENCES groups ON DELETE SET NULL; +ALTER TABLE chat_items ADD COLUMN fwd_from_chat_item_id INTEGER REFERENCES chat_items ON DELETE SET NULL; + +CREATE INDEX idx_chat_items_fwd_from_contact_id ON chat_items(fwd_from_contact_id); +CREATE INDEX idx_chat_items_fwd_from_group_id ON chat_items(fwd_from_group_id); +CREATE INDEX idx_chat_items_fwd_from_chat_item_id ON chat_items(fwd_from_chat_item_id); |] down_m20240402_item_forwarded :: Query down_m20240402_item_forwarded = [sql| -ALTER TABLE chat_items DROP COLUMN item_forwarded; -|] +DROP INDEX idx_chat_items_fwd_from_contact_id; +DROP INDEX idx_chat_items_fwd_from_group_id; +DROP INDEX idx_chat_items_fwd_from_chat_item_id; --- ALTER TABLE chat_items DROP COLUMN forwarded_from_str; --- ALTER TABLE chat_items DROP COLUMN forwarded_from_contact_id; --- ALTER TABLE chat_items DROP COLUMN forwarded_from_group_id; --- ALTER TABLE chat_items DROP COLUMN forwarded_from_note_folder_id; +ALTER TABLE chat_items DROP COLUMN fwd_from_tag; +ALTER TABLE chat_items DROP COLUMN fwd_from_chat_name; +ALTER TABLE chat_items DROP COLUMN fwd_from_msg_dir; +ALTER TABLE chat_items DROP COLUMN fwd_from_contact_id; +ALTER TABLE chat_items DROP COLUMN fwd_from_group_id; +ALTER TABLE chat_items DROP COLUMN fwd_from_chat_item_id; +|] diff --git a/src/Simplex/Chat/Protocol.hs b/src/Simplex/Chat/Protocol.hs index 617d8c469e..e262de0e74 100644 --- a/src/Simplex/Chat/Protocol.hs +++ b/src/Simplex/Chat/Protocol.hs @@ -418,11 +418,6 @@ cmToQuotedMsg = \case ACME _ (XMsgNew (MCQuote quotedMsg _)) -> Just quotedMsg _ -> Nothing -cmToItemForwarded :: AChatMsgEvent -> Bool -cmToItemForwarded = \case - ACME _ (XMsgNew (MCForward _)) -> True - _ -> False - data MsgContentTag = MCText_ | MCLink_ | MCImage_ | MCVideo_ | MCVoice_ | MCFile_ | MCUnknown_ Text deriving (Eq) diff --git a/src/Simplex/Chat/Store/Messages.hs b/src/Simplex/Chat/Store/Messages.hs index 296d98c154..11068ff5cb 100644 --- a/src/Simplex/Chat/Store/Messages.hs +++ b/src/Simplex/Chat/Store/Messages.hs @@ -330,7 +330,7 @@ updateChatTs db User {userId} chatDirection chatTs = case toChatInfo chatDirecti (chatTs, userId, noteFolderId) _ -> pure () -createNewSndChatItem :: DB.Connection -> User -> ChatDirection c 'MDSnd -> SndMessage -> CIContent 'MDSnd -> Maybe (CIQuote c) -> Bool -> Maybe CITimed -> Bool -> UTCTime -> IO ChatItemId +createNewSndChatItem :: DB.Connection -> User -> ChatDirection c 'MDSnd -> SndMessage -> CIContent 'MDSnd -> Maybe (CIQuote c) -> Maybe CIForwardedFrom -> Maybe CITimed -> Bool -> UTCTime -> IO ChatItemId createNewSndChatItem db user chatDirection SndMessage {msgId, sharedMsgId} ciContent quotedItem itemForwarded timed live createdAt = createNewChatItem_ db user chatDirection createdByMsgId (Just sharedMsgId) ciContent quoteRow itemForwarded timed live createdAt Nothing createdAt where @@ -346,13 +346,13 @@ createNewSndChatItem db user chatDirection SndMessage {msgId, sharedMsgId} ciCon CIQGroupRcv (Just GroupMember {memberId}) -> (Just False, Just memberId) CIQGroupRcv Nothing -> (Just False, Nothing) -createNewRcvChatItem :: ChatTypeQuotable c => DB.Connection -> User -> ChatDirection c 'MDRcv -> RcvMessage -> Maybe SharedMsgId -> CIContent 'MDRcv -> Maybe CITimed -> Bool -> UTCTime -> UTCTime -> IO (ChatItemId, Maybe (CIQuote c), Bool) +createNewRcvChatItem :: ChatTypeQuotable c => DB.Connection -> User -> ChatDirection c 'MDRcv -> RcvMessage -> Maybe SharedMsgId -> CIContent 'MDRcv -> Maybe CITimed -> Bool -> UTCTime -> UTCTime -> IO (ChatItemId, Maybe (CIQuote c), Maybe CIForwardedFrom) createNewRcvChatItem db user chatDirection RcvMessage {msgId, chatMsgEvent, forwardedByMember} sharedMsgId_ ciContent timed live itemTs createdAt = do ciId <- createNewChatItem_ db user chatDirection (Just msgId) sharedMsgId_ ciContent quoteRow itemForwarded timed live itemTs forwardedByMember createdAt quotedItem <- mapM (getChatItemQuote_ db user chatDirection) quotedMsg pure (ciId, quotedItem, itemForwarded) where - itemForwarded = cmToItemForwarded chatMsgEvent + itemForwarded = cmForwardedFrom chatMsgEvent quotedMsg = cmToQuotedMsg chatMsgEvent quoteRow :: NewQuoteRow quoteRow = case quotedMsg of @@ -365,12 +365,12 @@ createNewRcvChatItem db user chatDirection RcvMessage {msgId, chatMsgEvent, forw createNewChatItemNoMsg :: forall c d. MsgDirectionI d => DB.Connection -> User -> ChatDirection c d -> CIContent d -> UTCTime -> UTCTime -> IO ChatItemId createNewChatItemNoMsg db user chatDirection ciContent itemTs = - createNewChatItem_ db user chatDirection Nothing Nothing ciContent quoteRow False Nothing False itemTs Nothing + createNewChatItem_ db user chatDirection Nothing Nothing ciContent quoteRow Nothing Nothing False itemTs Nothing where quoteRow :: NewQuoteRow quoteRow = (Nothing, Nothing, Nothing, Nothing, Nothing) -createNewChatItem_ :: forall c d. MsgDirectionI d => DB.Connection -> User -> ChatDirection c d -> Maybe MessageId -> Maybe SharedMsgId -> CIContent d -> NewQuoteRow -> Bool -> Maybe CITimed -> Bool -> UTCTime -> Maybe GroupMemberId -> UTCTime -> IO ChatItemId +createNewChatItem_ :: forall c d. MsgDirectionI d => DB.Connection -> User -> ChatDirection c d -> Maybe MessageId -> Maybe SharedMsgId -> CIContent d -> NewQuoteRow -> Maybe CIForwardedFrom -> Maybe CITimed -> Bool -> UTCTime -> Maybe GroupMemberId -> UTCTime -> IO ChatItemId createNewChatItem_ db User {userId} chatDirection msgId_ sharedMsgId ciContent quoteRow itemForwarded timed live itemTs forwardedByMember createdAt = do DB.execute db @@ -379,19 +379,21 @@ createNewChatItem_ db User {userId} chatDirection msgId_ sharedMsgId ciContent q -- user and IDs user_id, created_by_msg_id, contact_id, group_id, group_member_id, note_folder_id, -- meta - item_sent, item_ts, item_content, item_content_tag, item_text, item_status, shared_msg_id, item_forwarded, + item_sent, item_ts, item_content, item_content_tag, item_text, item_status, shared_msg_id, forwarded_by_group_member_id, created_at, updated_at, item_live, timed_ttl, timed_delete_at, -- quote - quoted_shared_msg_id, quoted_sent_at, quoted_content, quoted_sent, quoted_member_id - ) VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?) + quoted_shared_msg_id, quoted_sent_at, quoted_content, quoted_sent, quoted_member_id, + -- forwarded from + fwd_from_tag, fwd_from_chat_name, fwd_from_msg_dir, fwd_from_contact_id, fwd_from_group_id, fwd_from_chat_item_id + ) VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?) |] - ((userId, msgId_) :. idsRow :. itemRow :. quoteRow) + ((userId, msgId_) :. idsRow :. itemRow :. quoteRow :. forwardedFromRow) ciId <- insertedRowId db forM_ msgId_ $ \msgId -> insertChatItemMessage_ db ciId msgId createdAt pure ciId where - itemRow :: (SMsgDirection d, UTCTime, CIContent d, Text, Text, CIStatus d, Maybe SharedMsgId, Bool, Maybe GroupMemberId) :. (UTCTime, UTCTime, Maybe Bool) :. (Maybe Int, Maybe UTCTime) - itemRow = (msgDirection @d, itemTs, ciContent, toCIContentTag ciContent, ciContentToText ciContent, ciCreateStatus ciContent, sharedMsgId, itemForwarded, forwardedByMember) :. (createdAt, createdAt, justTrue live) :. ciTimedRow timed + itemRow :: (SMsgDirection d, UTCTime, CIContent d, Text, Text, CIStatus d, Maybe SharedMsgId, Maybe GroupMemberId) :. (UTCTime, UTCTime, Maybe Bool) :. (Maybe Int, Maybe UTCTime) + itemRow = (msgDirection @d, itemTs, ciContent, toCIContentTag ciContent, ciContentToText ciContent, ciCreateStatus ciContent, sharedMsgId, forwardedByMember) :. (createdAt, createdAt, justTrue live) :. ciTimedRow timed idsRow :: (Maybe Int64, Maybe Int64, Maybe Int64, Maybe Int64) idsRow = case chatDirection of CDDirectRcv Contact {contactId} -> (Just contactId, Nothing, Nothing, Nothing) @@ -400,6 +402,16 @@ createNewChatItem_ db User {userId} chatDirection msgId_ sharedMsgId ciContent q CDGroupSnd GroupInfo {groupId} -> (Nothing, Just groupId, Nothing, Nothing) CDLocalRcv NoteFolder {noteFolderId} -> (Nothing, Nothing, Nothing, Just noteFolderId) CDLocalSnd NoteFolder {noteFolderId} -> (Nothing, Nothing, Nothing, Just noteFolderId) + forwardedFromRow :: (Maybe CIForwardedFromTag, Maybe Text, Maybe MsgDirection, Maybe Int64, Maybe Int64, Maybe Int64) + forwardedFromRow = case itemForwarded of + Nothing -> + (Nothing, Nothing, Nothing, Nothing, Nothing, Nothing) + Just CIFFUnknown -> + (Just CIFFUnknown_, Nothing, Nothing, Nothing, Nothing, Nothing) + Just CIFFContact {chatName, msgDir, contactId, chatItemId} -> + (Just CIFFContact_, Just chatName, Just msgDir, contactId, Nothing, chatItemId) + Just CIFFGroup {chatName, msgDir, groupId, chatItemId} -> + (Just CIFFContact_, Just chatName, Just msgDir, Nothing, groupId, chatItemId) ciTimedRow :: Maybe CITimed -> (Maybe Int, Maybe UTCTime) ciTimedRow (Just CITimed {ttl, deleteAt}) = (Just ttl, deleteAt) @@ -795,7 +807,7 @@ getLocalChatPreview_ db user (LocalChatPD _ noteFolderId lastItemId_ stats) = do -- this function can be changed so it never fails, not only avoid failure on invalid json toLocalChatItem :: UTCTime -> ChatItemRow -> Either StoreError (CChatItem 'CTLocal) -toLocalChatItem currentTs ((itemId, itemTs, AMsgDirection msgDir, itemContentText, itemText, itemStatus, sharedMsgId, itemForwarded) :. (itemDeleted, deletedTs, itemEdited, createdAt, updatedAt) :. (timedTTL, timedDeleteAt, itemLive) :. (fileId_, fileName_, fileSize_, filePath, fileKey, fileNonce, fileStatus_, fileProtocol_)) = +toLocalChatItem currentTs ((itemId, itemTs, AMsgDirection msgDir, itemContentText, itemText, itemStatus, sharedMsgId) :. (itemDeleted, deletedTs, itemEdited, createdAt, updatedAt) :. forwardedFromRow :. (timedTTL, timedDeleteAt, itemLive) :. (fileId_, fileName_, fileSize_, filePath, fileKey, fileNonce, fileStatus_, fileProtocol_)) = chatItem $ fromRight invalid $ dbParseACIContent itemContentText where invalid = ACIContent msgDir $ CIInvalidJSON itemContentText @@ -827,8 +839,8 @@ toLocalChatItem currentTs ((itemId, itemTs, AMsgDirection msgDir, itemContentTex DBCINotDeleted -> Nothing _ -> Just (CIDeleted @CTLocal deletedTs) itemEdited' = fromMaybe False itemEdited - itemForwarded' = fromMaybe False itemForwarded - in mkCIMeta itemId content itemText status sharedMsgId itemForwarded' itemDeleted' itemEdited' ciTimed itemLive currentTs itemTs Nothing createdAt updatedAt + itemForwarded = toCIForwardedFrom forwardedFromRow + in mkCIMeta itemId content itemText status sharedMsgId itemForwarded itemDeleted' itemEdited' ciTimed itemLive currentTs itemTs Nothing createdAt updatedAt ciTimed :: Maybe CITimed ciTimed = timedTTL >>= \ttl -> Just CITimed {ttl, deleteAt = timedDeleteAt} @@ -1393,7 +1405,14 @@ type MaybeCIFIleRow = (Maybe Int64, Maybe String, Maybe Integer, Maybe FilePath, type ChatItemModeRow = (Maybe Int, Maybe UTCTime, Maybe Bool) -type ChatItemRow = (Int64, ChatItemTs, AMsgDirection, Text, Text, ACIStatus, Maybe SharedMsgId, Maybe Bool) :. (Int, Maybe UTCTime, Maybe Bool, UTCTime, UTCTime) :. ChatItemModeRow :. MaybeCIFIleRow +type ChatItemForwardedFromRow = (Maybe CIForwardedFromTag, Maybe Text, Maybe MsgDirection, Maybe Int64, Maybe Int64, Maybe Int64) + +type ChatItemRow = + (Int64, ChatItemTs, AMsgDirection, Text, Text, ACIStatus, Maybe SharedMsgId) + :. (Int, Maybe UTCTime, Maybe Bool, UTCTime, UTCTime) + :. ChatItemForwardedFromRow + :. ChatItemModeRow + :. MaybeCIFIleRow type QuoteRow = (Maybe ChatItemId, Maybe SharedMsgId, Maybe UTCTime, Maybe MsgContent, Maybe Bool) @@ -1408,7 +1427,7 @@ toQuote (quotedItemId, quotedSharedMsgId, quotedSentAt, quotedMsgContent, _) dir -- this function can be changed so it never fails, not only avoid failure on invalid json toDirectChatItem :: UTCTime -> ChatItemRow :. QuoteRow -> Either StoreError (CChatItem 'CTDirect) -toDirectChatItem currentTs (((itemId, itemTs, AMsgDirection msgDir, itemContentText, itemText, itemStatus, sharedMsgId, itemForwarded) :. (itemDeleted, deletedTs, itemEdited, createdAt, updatedAt) :. (timedTTL, timedDeleteAt, itemLive) :. (fileId_, fileName_, fileSize_, filePath, fileKey, fileNonce, fileStatus_, fileProtocol_)) :. quoteRow) = +toDirectChatItem currentTs (((itemId, itemTs, AMsgDirection msgDir, itemContentText, itemText, itemStatus, sharedMsgId) :. (itemDeleted, deletedTs, itemEdited, createdAt, updatedAt) :. forwardedFromRow :. (timedTTL, timedDeleteAt, itemLive) :. (fileId_, fileName_, fileSize_, filePath, fileKey, fileNonce, fileStatus_, fileProtocol_)) :. quoteRow) = chatItem $ fromRight invalid $ dbParseACIContent itemContentText where invalid = ACIContent msgDir $ CIInvalidJSON itemContentText @@ -1440,11 +1459,19 @@ toDirectChatItem currentTs (((itemId, itemTs, AMsgDirection msgDir, itemContentT DBCINotDeleted -> Nothing _ -> Just (CIDeleted @CTDirect deletedTs) itemEdited' = fromMaybe False itemEdited - itemForwarded' = fromMaybe False itemForwarded - in mkCIMeta itemId content itemText status sharedMsgId itemForwarded' itemDeleted' itemEdited' ciTimed itemLive currentTs itemTs Nothing createdAt updatedAt + itemForwarded = toCIForwardedFrom forwardedFromRow + in mkCIMeta itemId content itemText status sharedMsgId itemForwarded itemDeleted' itemEdited' ciTimed itemLive currentTs itemTs Nothing createdAt updatedAt ciTimed :: Maybe CITimed ciTimed = timedTTL >>= \ttl -> Just CITimed {ttl, deleteAt = timedDeleteAt} +toCIForwardedFrom :: ChatItemForwardedFromRow -> Maybe CIForwardedFrom +toCIForwardedFrom (fwdFromTag, fwdFromChatName, fwdFromMsgDir, fwdFromContactId, fwdFromGroupId, fwdFromChatItemId) = + case (fwdFromTag, fwdFromChatName, fwdFromMsgDir, fwdFromContactId, fwdFromGroupId, fwdFromChatItemId) of + (Just CIFFUnknown_, Nothing, Nothing, Nothing, Nothing, Nothing) -> Just CIFFUnknown + (Just CIFFContact_, Just chatName, Just msgDir, contactId, Nothing, chatId) -> Just $ CIFFContact chatName msgDir contactId chatId + (Just CIFFGroup_, Just chatName, Just msgDir, Nothing, groupId, chatId) -> Just $ CIFFGroup chatName msgDir groupId chatId + _ -> Nothing + type GroupQuoteRow = QuoteRow :. MaybeGroupMemberRow toGroupQuote :: QuoteRow -> Maybe GroupMember -> Maybe (CIQuote 'CTGroup) @@ -1457,7 +1484,7 @@ toGroupQuote qr@(_, _, _, _, quotedSent) quotedMember_ = toQuote qr $ direction -- this function can be changed so it never fails, not only avoid failure on invalid json toGroupChatItem :: UTCTime -> Int64 -> ChatItemRow :. Only (Maybe GroupMemberId) :. MaybeGroupMemberRow :. GroupQuoteRow :. MaybeGroupMemberRow -> Either StoreError (CChatItem 'CTGroup) -toGroupChatItem currentTs userContactId (((itemId, itemTs, AMsgDirection msgDir, itemContentText, itemText, itemStatus, sharedMsgId, itemForwarded) :. (itemDeleted, deletedTs, itemEdited, createdAt, updatedAt) :. (timedTTL, timedDeleteAt, itemLive) :. (fileId_, fileName_, fileSize_, filePath, fileKey, fileNonce, fileStatus_, fileProtocol_)) :. Only forwardedByMember :. memberRow_ :. (quoteRow :. quotedMemberRow_) :. deletedByGroupMemberRow_) = do +toGroupChatItem currentTs userContactId (((itemId, itemTs, AMsgDirection msgDir, itemContentText, itemText, itemStatus, sharedMsgId) :. (itemDeleted, deletedTs, itemEdited, createdAt, updatedAt) :. forwardedFromRow :. (timedTTL, timedDeleteAt, itemLive) :. (fileId_, fileName_, fileSize_, filePath, fileKey, fileNonce, fileStatus_, fileProtocol_)) :. Only forwardedByMember :. memberRow_ :. (quoteRow :. quotedMemberRow_) :. deletedByGroupMemberRow_) = do chatItem $ fromRight invalid $ dbParseACIContent itemContentText where member_ = toMaybeGroupMember userContactId memberRow_ @@ -1494,8 +1521,8 @@ toGroupChatItem currentTs userContactId (((itemId, itemTs, AMsgDirection msgDir, DBCIBlockedByAdmin -> Just (CIBlockedByAdmin deletedTs) _ -> Just (maybe (CIDeleted @CTGroup deletedTs) (CIModerated deletedTs) deletedByGroupMember_) itemEdited' = fromMaybe False itemEdited - itemForwarded' = fromMaybe False itemForwarded - in mkCIMeta itemId content itemText status sharedMsgId itemForwarded' itemDeleted' itemEdited' ciTimed itemLive currentTs itemTs forwardedByMember createdAt updatedAt + itemForwarded = toCIForwardedFrom forwardedFromRow + in mkCIMeta itemId content itemText status sharedMsgId itemForwarded itemDeleted' itemEdited' ciTimed itemLive currentTs itemTs forwardedByMember createdAt updatedAt ciTimed :: Maybe CITimed ciTimed = timedTTL >>= \ttl -> Just CITimed {ttl, deleteAt = timedDeleteAt} @@ -1730,8 +1757,10 @@ getDirectChatItem db User {userId} contactId itemId = ExceptT $ do [sql| SELECT -- ChatItem - i.chat_item_id, i.item_ts, i.item_sent, i.item_content, i.item_text, i.item_status, i.shared_msg_id, i.item_forwarded, - i.item_deleted, i.item_deleted_ts, i.item_edited, i.created_at, i.updated_at, i.timed_ttl, i.timed_delete_at, i.item_live, + i.chat_item_id, i.item_ts, i.item_sent, i.item_content, i.item_text, i.item_status, i.shared_msg_id, + i.item_deleted, i.item_deleted_ts, i.item_edited, i.created_at, i.updated_at, + i.fwd_from_tag, i.fwd_from_chat_name, i.fwd_from_msg_dir, i.fwd_from_contact_id, i.fwd_from_group_id, i.fwd_from_chat_item_id, + i.timed_ttl, i.timed_delete_at, i.item_live, -- CIFile f.file_id, f.file_name, f.file_size, f.file_path, f.file_crypto_key, f.file_crypto_nonce, f.ci_file_status, f.protocol, -- DirectQuote @@ -1971,8 +2000,10 @@ getGroupChatItem db User {userId, userContactId} groupId itemId = ExceptT $ do [sql| SELECT -- ChatItem - i.chat_item_id, i.item_ts, i.item_sent, i.item_content, i.item_text, i.item_status, i.shared_msg_id, i.item_forwarded, - i.item_deleted, i.item_deleted_ts, i.item_edited, i.created_at, i.updated_at, i.timed_ttl, i.timed_delete_at, i.item_live, + i.chat_item_id, i.item_ts, i.item_sent, i.item_content, i.item_text, i.item_status, i.shared_msg_id, + i.item_deleted, i.item_deleted_ts, i.item_edited, i.created_at, i.updated_at, + i.fwd_from_tag, i.fwd_from_chat_name, i.fwd_from_msg_dir, i.fwd_from_contact_id, i.fwd_from_group_id, i.fwd_from_chat_item_id, + i.timed_ttl, i.timed_delete_at, i.item_live, -- CIFile f.file_id, f.file_name, f.file_size, f.file_path, f.file_crypto_key, f.file_crypto_nonce, f.ci_file_status, f.protocol, -- CIMeta forwardedByMember @@ -2073,8 +2104,10 @@ getLocalChatItem db User {userId} folderId itemId = ExceptT $ do [sql| SELECT -- ChatItem - i.chat_item_id, i.item_ts, i.item_sent, i.item_content, i.item_text, i.item_status, i.shared_msg_id, i.item_forwarded, - i.item_deleted, i.item_deleted_ts, i.item_edited, i.created_at, i.updated_at, i.timed_ttl, i.timed_delete_at, i.item_live, + i.chat_item_id, i.item_ts, i.item_sent, i.item_content, i.item_text, i.item_status, i.shared_msg_id, + i.item_deleted, i.item_deleted_ts, i.item_edited, i.created_at, i.updated_at, + i.fwd_from_tag, i.fwd_from_chat_name, i.fwd_from_msg_dir, i.fwd_from_contact_id, i.fwd_from_group_id, i.fwd_from_chat_item_id, + i.timed_ttl, i.timed_delete_at, i.item_live, -- CIFile f.file_id, f.file_name, f.file_size, f.file_path, f.file_crypto_key, f.file_crypto_nonce, f.ci_file_status, f.protocol FROM chat_items i diff --git a/src/Simplex/Chat/View.hs b/src/Simplex/Chat/View.hs index 47eb2f87d4..635c6a3b10 100644 --- a/src/Simplex/Chat/View.hs +++ b/src/Simplex/Chat/View.hs @@ -555,7 +555,11 @@ viewChatItem chat ci@ChatItem {chatDir, meta = meta@CIMeta {itemForwarded, forwa where from = ttyFromContact c where - context = maybe (forwarded itemForwarded) (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 context mc @@ -573,7 +577,11 @@ viewChatItem chat ci@ChatItem {chatDir, meta = meta@CIMeta {itemForwarded, forwa where from = ttyFromGroup g m where - context = maybe (forwarded itemForwarded) (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 context mc @@ -589,7 +597,7 @@ viewChatItem chat ci@ChatItem {chatDir, meta = meta@CIMeta {itemForwarded, forwa where from = "* " where - context = forwarded itemForwarded + context = maybe [] forwardedFrom itemForwarded ContactRequest {} -> [] ContactConnection {} -> [] withItemDeleted item = case chatItemDeletedText ci (chatInfoMembership chat) of @@ -681,7 +689,11 @@ viewItemUpdate chat ChatItem {chatDir, meta = meta@CIMeta {itemForwarded, itemEd where to = if itemEdited then ttyToContactEdited' c else ttyToContact' c where - context = maybe (forwarded itemForwarded) (directQuote chatDir) quotedItem + context = + maybe + (maybe [] forwardedFrom itemForwarded) + (directQuote chatDir) + quotedItem GroupChat g -> case chatDir of CIGroupRcv m -> case content of CIRcvMsgContent mc @@ -696,7 +708,11 @@ viewItemUpdate chat ChatItem {chatDir, meta = meta@CIMeta {itemForwarded, itemEd where to = if itemEdited then ttyToGroupEdited g else ttyToGroup g where - context = maybe (forwarded itemForwarded) (groupQuote g) quotedItem + context = + maybe + (maybe [] forwardedFrom itemForwarded) + (groupQuote g) + quotedItem _ -> [] hideLive :: CIMeta c d -> [StyledString] -> [StyledString] @@ -778,8 +794,17 @@ directQuote _ CIQuote {content = qmc, chatDir = quoteDir} = groupQuote :: GroupInfo -> CIQuote 'CTGroup -> [StyledString] groupQuote g CIQuote {content = qmc, chatDir = quoteDir} = quoteText qmc . ttyQuotedMember $ sentByMember g quoteDir -forwarded :: Bool -> [StyledString] -forwarded itemForwarded = ["-> forwarded" | itemForwarded] +forwardedFrom :: CIForwardedFrom -> [StyledString] +forwardedFrom = \case + CIFFUnknown -> ["-> forwarded"] + CIFFContact _ MDSnd _ _ -> ["-> from you"] + CIFFContact c MDRcv cId_ _ -> case cId_ of + Nothing -> ["-> from " <> ttyContact c] + Just cId -> ["-> from " <> ttyContact c <> " (contact id: " <> sShow cId <> ")"] + CIFFGroup _ MDSnd _ _ -> ["-> from you"] + CIFFGroup c MDRcv gId_ _ -> case gId_ of + Nothing -> ["-> from " <> ttyGroup c] + Just gId -> ["-> from " <> ttyGroup c <> " (group id: " <> sShow gId <> ")"] sentByMember :: GroupInfo -> CIQDirection 'CTGroup -> Maybe GroupMember sentByMember GroupInfo {membership} = \case diff --git a/tests/ChatTests/Forward.hs b/tests/ChatTests/Forward.hs index 747d0f4f1d..5a6bc533e7 100644 --- a/tests/ChatTests/Forward.hs +++ b/tests/ChatTests/Forward.hs @@ -42,21 +42,21 @@ testForwardContactToContact = alice <# "bob> hey" alice ##> ("/_forward @2 @3 " <> msgId) - alice <# "@cath -> forwarded" + alice <# "@cath -> from you" alice <## " hi" cath <# "alice> -> forwarded" cath <## " hi" alice `send` "> @bob -> @cath hey" - alice <# "@cath -> forwarded" + alice <# "@cath -> from bob (contact id: 2)" alice <## " hey" cath <# "alice> -> forwarded" cath <## " hey" alice ##> "/tail @cath 2" - alice <# "@cath -> forwarded" + alice <# "@cath -> from you" alice <## " hi" - alice <# "@cath -> forwarded" + alice <# "@cath -> from bob (contact id: 2)" alice <## " hey" cath ##> "/tail @alice 2" @@ -78,13 +78,13 @@ testForwardContactToGroup = alice <# "bob> hey" alice `send` ">> @bob -> #team hi" - alice <# "#team -> forwarded" + alice <# "#team -> from you" alice <## " hi" cath <# "#team alice> -> forwarded" cath <## " hi" alice `send` "> @bob -> #team hey" - alice <# "#team -> forwarded" + alice <# "#team -> from bob (contact id: 2)" alice <## " hey" cath <# "#team alice> -> forwarded" cath <## " hey" @@ -102,11 +102,11 @@ testForwardContactToNotes = alice <# "bob> hey" alice `send` ">> @bob -> * hi" - alice <# "* -> forwarded" + alice <# "* -> from you" alice <## " hi" alice `send` "> @bob -> * hey" - alice <# "* -> forwarded" + alice <# "* -> from bob (contact id: 2)" alice <## " hey" testForwardGroupToContact :: HasCallStack => FilePath -> IO () @@ -122,13 +122,13 @@ testForwardGroupToContact = alice <# "#team bob> hey" alice `send` "> #team -> @cath hi" - alice <# "@cath -> forwarded" + alice <# "@cath -> from you" alice <## " hi" cath <# "alice> -> forwarded" cath <## " hi" alice `send` "> #team -> @cath hey" - alice <# "@cath -> forwarded" + alice <# "@cath -> from #team (group id: 1)" alice <## " hey" cath <# "alice> -> forwarded" cath <## " hey" @@ -146,13 +146,13 @@ testForwardGroupToGroup = alice <# "#team bob> hey" alice `send` "> #team -> #club hi" - alice <# "#club -> forwarded" + alice <# "#club -> from you" alice <## " hi" cath <# "#club alice> -> forwarded" cath <## " hi" alice `send` "> #team -> #club hey" - alice <# "#club -> forwarded" + alice <# "#club -> from #team (group id: 1)" alice <## " hey" cath <# "#club alice> -> forwarded" cath <## " hey" @@ -170,11 +170,11 @@ testForwardGroupToNotes = alice <# "#team bob> hey" alice `send` "> #team -> * hi" - alice <# "* -> forwarded" + alice <# "* -> from you" alice <## " hi" alice `send` "> #team -> * hey" - alice <# "* -> forwarded" + alice <# "* -> from #team (group id: 1)" alice <## " hey" testForwardNotesToContact :: HasCallStack => FilePath -> IO () @@ -187,10 +187,8 @@ testForwardNotesToContact = alice /* "hi" alice `send` "> * -> @cath hi" - alice <# "@cath -> forwarded" - alice <## " hi" - cath <# "alice> -> forwarded" - cath <## " hi" + alice <# "@cath hi" + cath <# "alice> hi" testForwardNotesToGroup :: HasCallStack => FilePath -> IO () testForwardNotesToGroup = @@ -202,10 +200,8 @@ testForwardNotesToGroup = alice /* "hi" alice `send` "> * -> #team hi" - alice <# "#team -> forwarded" - alice <## " hi" - cath <# "#team alice> -> forwarded" - cath <## " hi" + alice <# "#team hi" + cath <# "#team alice> hi" testForwardNotesToNotes :: HasCallStack => FilePath -> IO () testForwardNotesToNotes tmp = @@ -215,13 +211,11 @@ testForwardNotesToNotes tmp = alice /* "hi" alice `send` "> * -> * hi" - alice <# "* -> forwarded" - alice <## " hi" + alice <# "* hi" alice ##> "/tail * 2" alice <# "* hi" - alice <# "* -> forwarded" - alice <## " hi" + alice <# "* hi" testForwardFileNoFilesFolder :: HasCallStack => FilePath -> IO () testForwardFileNoFilesFolder = @@ -255,7 +249,7 @@ testForwardFileNoFilesFolder = -- forward file bob `send` "> @alice -> @cath hi" - bob <# "@cath -> forwarded" + bob <# "@cath -> from alice (contact id: 2)" bob <## " hi" bob <# "/f @cath ./tests/tmp/test.pdf" bob <## "use /fc 2 to cancel sending" @@ -312,7 +306,7 @@ testForwardFileContactToContact = -- forward file bob `send` "> @alice -> @cath hi" - bob <# "@cath -> forwarded" + bob <# "@cath -> from alice (contact id: 2)" bob <## " hi" bob <# "/f @cath test_1.pdf" bob <## "use /fc 2 to cancel sending" @@ -377,7 +371,7 @@ testForwardFileGroupToNotes = -- forward file cath `send` "> #team -> * hi" - cath <# "* -> forwarded" + cath <# "* -> from #team (group id: 1)" cath <## " hi" cath <# "* file 2 (test_1.pdf)" @@ -408,12 +402,10 @@ testForwardFileNotesToGroup = -- forward file alice `send` "> * -> #team hi" - alice <# "#team -> forwarded" - alice <## " hi" + alice <# "#team hi" alice <# "/f #team test_1.pdf" alice <## "use /fc 2 to cancel sending" - cath <# "#team alice> -> forwarded" - cath <## " hi" + cath <# "#team alice> hi" cath <# "#team alice> sends file test_1.pdf (266.0 KiB / 272376 bytes)" cath <## "use /fr 1 [/ | ] to receive it"