From 85e44dcb77192c5f518aeafa05d2d3aeb451be30 Mon Sep 17 00:00:00 2001 From: spaced4ndy <8711996+spaced4ndy@users.noreply.github.com> Date: Mon, 20 Nov 2023 13:05:59 +0400 Subject: [PATCH 1/2] core: split group message forwarding tests (#3400) --- tests/ChatTests/Groups.hs | 124 ++++++++++++++++++++++++++++++-------- 1 file changed, 100 insertions(+), 24 deletions(-) diff --git a/tests/ChatTests/Groups.hs b/tests/ChatTests/Groups.hs index edf3d2fab..9278d4071 100644 --- a/tests/ChatTests/Groups.hs +++ b/tests/ChatTests/Groups.hs @@ -105,8 +105,14 @@ chatGroupTests = do it "invited member replaces member contact reference if it already exists" testMemberContactInvitedConnectionReplaced it "share incognito profile" testMemberContactIncognito it "sends and updates profile when creating contact" testMemberContactProfileUpdate - describe "forwarding messages" $ do - it "admin should forward messages between invitee and introduced" testGroupMsgForward + describe "group message forwarding" $ do + it "forward messages between invitee and introduced (x.msg.new)" testGroupMsgForward + it "forward message edit (x.msg.update)" testGroupMsgForwardEdit + it "forward message reaction (x.msg.react)" testGroupMsgForwardReaction + it "forward message deletion (x.msg.del)" testGroupMsgForwardDeletion + it "forward file (x.msg.file.descr)" testGroupMsgForwardFile + it "forward role change (x.grp.mem.role)" testGroupMsgForwardChangeRole + it "forward new member announcement (x.grp.mem.new)" testGroupMsgForwardNewMember where _0 = supportedChatVRange -- don't create direct connections _1 = groupCreateDirectVRange @@ -3902,18 +3908,9 @@ testMemberContactProfileUpdate = testGroupMsgForward :: HasCallStack => FilePath -> IO () testGroupMsgForward = - testChatCfg4 cfg aliceProfile bobProfile cathProfile danProfile $ - \alice bob cath dan -> withXFTPServer $ do - createGroup3 "team" alice bob cath - - threadDelay 1000000 -- delay so intro_status doesn't get overwritten to connected - - void $ withCCTransaction bob $ \db -> - DB.execute_ db "UPDATE connections SET conn_status='deleted' WHERE group_member_id = 3" - void $ withCCTransaction cath $ \db -> - DB.execute_ db "UPDATE connections SET conn_status='deleted' WHERE group_member_id = 3" - void $ withCCTransaction alice $ \db -> - DB.execute_ db "UPDATE group_member_intros SET intro_status='fwd'" + testChat3 aliceProfile bobProfile cathProfile $ + \alice bob cath -> do + setupGroupForwarding3 "team" alice bob cath bob #> "#team hi there" alice <# "#team bob> hi there" @@ -3937,22 +3934,80 @@ testGroupMsgForward = cath <# "#team bob> hi there [>>]" cath <# "#team hey team" +setupGroupForwarding3 :: String -> TestCC -> TestCC -> TestCC -> IO () +setupGroupForwarding3 gName alice bob cath = do + createGroup3 gName alice bob cath + + threadDelay 1000000 -- delay so intro_status doesn't get overwritten to connected + + void $ withCCTransaction bob $ \db -> + DB.execute_ db "UPDATE connections SET conn_status='deleted' WHERE group_member_id = 3" + void $ withCCTransaction cath $ \db -> + DB.execute_ db "UPDATE connections SET conn_status='deleted' WHERE group_member_id = 3" + void $ withCCTransaction alice $ \db -> + DB.execute_ db "UPDATE group_member_intros SET intro_status='fwd'" + +testGroupMsgForwardEdit :: HasCallStack => FilePath -> IO () +testGroupMsgForwardEdit = + testChat3 aliceProfile bobProfile cathProfile $ + \alice bob cath -> do + setupGroupForwarding3 "team" alice bob cath + + bob #> "#team hi there" + alice <# "#team bob> hi there" + cath <# "#team bob> hi there [>>]" + bob ##> "! #team hello there" bob <# "#team [edited] hello there" alice <# "#team bob> [edited] hello there" cath <# "#team bob> [edited] hello there" -- TODO show as forwarded - cath ##> "+1 #team hello there" + alice ##> "/tail #team 1" + alice <# "#team bob> hello there" + + bob ##> "/tail #team 1" + bob <# "#team hello there" + + cath ##> "/tail #team 1" + cath <# "#team bob> hello there [>>]" + +testGroupMsgForwardReaction :: HasCallStack => FilePath -> IO () +testGroupMsgForwardReaction = + testChat3 aliceProfile bobProfile cathProfile $ + \alice bob cath -> do + setupGroupForwarding3 "team" alice bob cath + + bob #> "#team hi there" + alice <# "#team bob> hi there" + cath <# "#team bob> hi there [>>]" + + cath ##> "+1 #team hi there" cath <## "added 👍" - alice <# "#team cath> > bob hello there" + alice <# "#team cath> > bob hi there" alice <## " + 👍" - bob <# "#team cath> > bob hello there" + bob <# "#team cath> > bob hi there" bob <## " + 👍" - bob ##> "\\ #team hello there" +testGroupMsgForwardDeletion :: HasCallStack => FilePath -> IO () +testGroupMsgForwardDeletion = + testChat3 aliceProfile bobProfile cathProfile $ + \alice bob cath -> do + setupGroupForwarding3 "team" alice bob cath + + bob #> "#team hi there" + alice <# "#team bob> hi there" + cath <# "#team bob> hi there [>>]" + + bob ##> "\\ #team hi there" bob <## "message marked deleted" - alice <# "#team bob> [marked deleted] hello there" - cath <# "#team bob> [marked deleted] hello there" -- TODO show as forwarded + alice <# "#team bob> [marked deleted] hi there" + cath <# "#team bob> [marked deleted] hi there" -- TODO show as forwarded + +testGroupMsgForwardFile :: HasCallStack => FilePath -> IO () +testGroupMsgForwardFile = + testChatCfg3 cfg aliceProfile bobProfile cathProfile $ + \alice bob cath -> withXFTPServer $ do + setupGroupForwarding3 "team" alice bob cath bob #> "/f #team ./tests/fixtures/test.jpg" bob <## "use /fc 1 to cancel sending" @@ -3972,12 +4027,26 @@ testGroupMsgForward = src <- B.readFile "./tests/fixtures/test.jpg" dest <- B.readFile "./tests/tmp/test.jpg" dest `shouldBe` src + where + cfg = testCfg {xftpFileConfig = Just $ XFTPFileConfig {minFileSize = 0}, tempDir = Just "./tests/tmp"} + +testGroupMsgForwardChangeRole :: HasCallStack => FilePath -> IO () +testGroupMsgForwardChangeRole = + testChat3 aliceProfile bobProfile cathProfile $ + \alice bob cath -> do + setupGroupForwarding3 "team" alice bob cath cath ##> "/mr #team bob member" cath <## "#team: you changed the role of bob from admin to member" alice <## "#team: cath changed the role of bob from admin to member" bob <## "#team: cath changed your role from admin to member" -- TODO show as forwarded +testGroupMsgForwardNewMember :: HasCallStack => FilePath -> IO () +testGroupMsgForwardNewMember = + testChat4 aliceProfile bobProfile cathProfile danProfile $ + \alice bob cath dan -> do + setupGroupForwarding3 "team" alice bob cath + connectUsers cath dan cath ##> "/a #team dan" cath <## "invitation to join the group #team sent to dan" @@ -3994,14 +4063,21 @@ testGroupMsgForward = bob <## "#team: cath added dan (Daniel) to the group (connecting...)", -- TODO show as forwarded dan <## "#team: member alice (Alice) is connected" ] + dan #> "#team hello all" alice <# "#team dan> hello all" -- bob <# "#team dan> hello all [>>]" cath <# "#team dan> hello all" - + bob #> "#team hi all" alice <# "#team bob> hi all" cath <# "#team bob> hi all [>>]" - -- dan <# "#team bob> hi all" - where - cfg = testCfg {xftpFileConfig = Just $ XFTPFileConfig {minFileSize = 0}, tempDir = Just "./tests/tmp"} + -- dan <# "#team bob> hi all [>>]" + + bob ##> "/ms team" + bob + <### [ "alice (Alice): owner, host, connected", + "bob (Bob): admin, you, connected", + "cath (Catherine): admin, connected", + "dan (Daniel): member" + ] From 3a510eeaf0795fcc8ac5c6df4cd70f66b7aa611a Mon Sep 17 00:00:00 2001 From: spaced4ndy <8711996+spaced4ndy@users.noreply.github.com> Date: Mon, 20 Nov 2023 14:00:55 +0400 Subject: [PATCH 2/2] core: rename forwarded fields (#3401) --- src/Simplex/Chat.hs | 8 ++++---- src/Simplex/Chat/Messages.hs | 10 +++++----- src/Simplex/Chat/Store/Messages.hs | 26 +++++++++++++------------- src/Simplex/Chat/View.hs | 4 ++-- 4 files changed, 24 insertions(+), 24 deletions(-) diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs index 524fae2bd..91ae25944 100644 --- a/src/Simplex/Chat.hs +++ b/src/Simplex/Chat.hs @@ -5599,20 +5599,20 @@ saveRcvChatItem user cd msg@RcvMessage {sharedMsgId_} brokerTs content = saveRcvChatItem' user cd msg sharedMsgId_ brokerTs content Nothing Nothing False saveRcvChatItem' :: ChatMonad m => User -> ChatDirection c 'MDRcv -> RcvMessage -> Maybe SharedMsgId -> UTCTime -> CIContent 'MDRcv -> Maybe (CIFile 'MDRcv) -> Maybe CITimed -> Bool -> m (ChatItem c 'MDRcv) -saveRcvChatItem' user cd msg sharedMsgId_ brokerTs content ciFile itemTimed live = do +saveRcvChatItem' user cd msg@RcvMessage {forwardedByMember} sharedMsgId_ brokerTs content ciFile itemTimed live = do createdAt <- liftIO getCurrentTime (ciId, quotedItem) <- withStore' $ \db -> do when (ciRequiresAttention content) $ updateChatTs db user cd createdAt (ciId, quotedItem) <- createNewRcvChatItem db user cd msg sharedMsgId_ content itemTimed live brokerTs createdAt forM_ ciFile $ \CIFile {fileId} -> updateFileTransferChatItemId db fileId ciId createdAt pure (ciId, quotedItem) - liftIO $ mkChatItem cd ciId content ciFile quotedItem sharedMsgId_ itemTimed live brokerTs msg.forwardedByGroupMemberId createdAt + liftIO $ mkChatItem cd ciId content ciFile quotedItem sharedMsgId_ itemTimed live brokerTs forwardedByMember createdAt mkChatItem :: forall c d. MsgDirectionI d => ChatDirection c d -> ChatItemId -> CIContent d -> Maybe (CIFile d) -> Maybe (CIQuote c) -> Maybe SharedMsgId -> Maybe CITimed -> Bool -> ChatItemTs -> Maybe GroupMemberId -> UTCTime -> IO (ChatItem c d) -mkChatItem cd ciId content file quotedItem sharedMsgId itemTimed live itemTs forwardedByGroupMemberId currentTs = do +mkChatItem cd ciId content file quotedItem sharedMsgId itemTimed live itemTs forwardedByMember currentTs = do let itemText = ciContentToText content itemStatus = ciCreateStatus content - meta = mkCIMeta ciId content itemText itemStatus sharedMsgId Nothing False itemTimed (justTrue live) currentTs itemTs forwardedByGroupMemberId currentTs currentTs + meta = mkCIMeta ciId content itemText itemStatus sharedMsgId Nothing False itemTimed (justTrue live) currentTs itemTs forwardedByMember currentTs currentTs pure ChatItem {chatDir = toCIDirection cd, meta, content, formattedText = parseMaybeMarkdownList itemText, quotedItem, reactions = [], file} deleteDirectCI :: (ChatMonad m, MsgDirectionI d) => User -> Contact -> ChatItem 'CTDirect d -> Bool -> Bool -> m ChatResponse diff --git a/src/Simplex/Chat/Messages.hs b/src/Simplex/Chat/Messages.hs index d35ed8818..0cb7f5e82 100644 --- a/src/Simplex/Chat/Messages.hs +++ b/src/Simplex/Chat/Messages.hs @@ -341,18 +341,18 @@ data CIMeta (c :: ChatType) (d :: MsgDirection) = CIMeta itemTimed :: Maybe CITimed, itemLive :: Maybe Bool, editable :: Bool, - forwardedByGroupMemberId :: Maybe GroupMemberId, + forwardedByMember :: Maybe GroupMemberId, createdAt :: UTCTime, updatedAt :: UTCTime } deriving (Show, Generic) mkCIMeta :: ChatItemId -> CIContent d -> Text -> CIStatus d -> Maybe SharedMsgId -> Maybe (CIDeleted c) -> Bool -> Maybe CITimed -> Maybe Bool -> UTCTime -> ChatItemTs -> Maybe GroupMemberId -> UTCTime -> UTCTime -> CIMeta c d -mkCIMeta itemId itemContent itemText itemStatus itemSharedMsgId itemDeleted itemEdited itemTimed itemLive currentTs itemTs forwardedByGroupMemberId createdAt updatedAt = +mkCIMeta itemId itemContent itemText itemStatus itemSharedMsgId itemDeleted itemEdited itemTimed itemLive currentTs itemTs forwardedByMember createdAt updatedAt = let editable = case itemContent of CISndMsgContent _ -> diffUTCTime currentTs itemTs < nominalDay && isNothing itemDeleted _ -> False - in CIMeta {itemId, itemTs, itemText, itemStatus, itemSharedMsgId, itemDeleted, itemEdited, itemTimed, itemLive, editable, forwardedByGroupMemberId, createdAt, updatedAt} + in CIMeta {itemId, itemTs, itemText, itemStatus, itemSharedMsgId, itemDeleted, itemEdited, itemTimed, itemLive, editable, forwardedByMember, createdAt, updatedAt} instance ToJSON (CIMeta c d) where toEncoding = J.genericToEncoding J.defaultOptions @@ -816,8 +816,8 @@ data RcvMessage = RcvMessage chatMsgEvent :: AChatMsgEvent, sharedMsgId_ :: Maybe SharedMsgId, msgBody :: MsgBody, - authorGroupMemberId :: Maybe GroupMemberId, - forwardedByGroupMemberId :: Maybe GroupMemberId + authorMember :: Maybe GroupMemberId, + forwardedByMember :: Maybe GroupMemberId } data PendingGroupMessage = PendingGroupMessage diff --git a/src/Simplex/Chat/Store/Messages.hs b/src/Simplex/Chat/Store/Messages.hs index d98023ad8..343d33484 100644 --- a/src/Simplex/Chat/Store/Messages.hs +++ b/src/Simplex/Chat/Store/Messages.hs @@ -200,7 +200,7 @@ createNewMessageAndRcvMsgDelivery db connOrGroupId newMessage sharedMsgId_ RcvMs pure msg createNewRcvMessage :: forall e. (MsgEncodingI e) => DB.Connection -> ConnOrGroupId -> NewMessage e -> Maybe SharedMsgId -> Maybe GroupMemberId -> Maybe GroupMemberId -> ExceptT StoreError IO RcvMessage -createNewRcvMessage db connOrGroupId NewMessage{chatMsgEvent, msgBody} sharedMsgId_ authorGroupMemberId forwardedByGroupMemberId = +createNewRcvMessage db connOrGroupId NewMessage{chatMsgEvent, msgBody} sharedMsgId_ authorMember forwardedByMember = case connOrGroupId of ConnectionId connId -> liftIO $ insertRcvMsg (Just connId) Nothing GroupId groupId -> case sharedMsgId_ of @@ -230,9 +230,9 @@ createNewRcvMessage db connOrGroupId NewMessage{chatMsgEvent, msgBody} sharedMsg (msg_sent, chat_msg_event, msg_body, created_at, updated_at, connection_id, group_id, shared_msg_id, author_group_member_id, forwarded_by_group_member_id) VALUES (?,?,?,?,?,?,?,?,?,?) |] - (MDRcv, toCMEventTag chatMsgEvent, msgBody, currentTs, currentTs, connId_, groupId_, sharedMsgId_, authorGroupMemberId, forwardedByGroupMemberId) + (MDRcv, toCMEventTag chatMsgEvent, msgBody, currentTs, currentTs, connId_, groupId_, sharedMsgId_, authorMember, forwardedByMember) msgId <- insertedRowId db - pure RcvMessage{msgId, chatMsgEvent = ACME (encoding @e) chatMsgEvent, sharedMsgId_, msgBody, authorGroupMemberId, forwardedByGroupMemberId} + pure RcvMessage{msgId, chatMsgEvent = ACME (encoding @e) chatMsgEvent, sharedMsgId_, msgBody, authorMember, forwardedByMember} createSndMsgDeliveryEvent :: DB.Connection -> Int64 -> AgentMsgId -> MsgDeliveryStatus 'MDSnd -> ExceptT StoreError IO () createSndMsgDeliveryEvent db connId agentMsgId sndMsgDeliveryStatus = do @@ -366,8 +366,8 @@ createNewSndChatItem db user chatDirection SndMessage {msgId, sharedMsgId} ciCon CIQGroupRcv Nothing -> (Just False, Nothing) createNewRcvChatItem :: DB.Connection -> User -> ChatDirection c 'MDRcv -> RcvMessage -> Maybe SharedMsgId -> CIContent 'MDRcv -> Maybe CITimed -> Bool -> UTCTime -> UTCTime -> IO (ChatItemId, Maybe (CIQuote c)) -createNewRcvChatItem db user chatDirection RcvMessage {msgId, chatMsgEvent, forwardedByGroupMemberId} sharedMsgId_ ciContent timed live itemTs createdAt = do - ciId <- createNewChatItem_ db user chatDirection (Just msgId) sharedMsgId_ ciContent quoteRow timed live itemTs forwardedByGroupMemberId createdAt +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 timed live itemTs forwardedByMember createdAt quotedItem <- mapM (getChatItemQuote_ db user chatDirection) quotedMsg pure (ciId, quotedItem) where @@ -389,7 +389,7 @@ createNewChatItemNoMsg db user chatDirection ciContent itemTs = 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 -> Maybe CITimed -> Bool -> UTCTime -> Maybe GroupMemberId -> UTCTime -> IO ChatItemId -createNewChatItem_ db User {userId} chatDirection msgId_ sharedMsgId ciContent quoteRow timed live itemTs forwardedByGroupMemberId createdAt = do +createNewChatItem_ db User {userId} chatDirection msgId_ sharedMsgId ciContent quoteRow timed live itemTs forwardedByMember createdAt = do DB.execute db [sql| @@ -408,7 +408,7 @@ createNewChatItem_ db User {userId} chatDirection msgId_ sharedMsgId ciContent q pure ciId where itemRow :: (SMsgDirection d, UTCTime, CIContent d, Text, CIStatus d, Maybe SharedMsgId, Maybe GroupMemberId) :. (UTCTime, UTCTime, Maybe Bool) :. (Maybe Int, Maybe UTCTime) - itemRow = (msgDirection @d, itemTs, ciContent, ciContentToText ciContent, ciCreateStatus ciContent, sharedMsgId, forwardedByGroupMemberId) :. (createdAt, createdAt, justTrue live) :. ciTimedRow timed + itemRow = (msgDirection @d, itemTs, ciContent, ciContentToText ciContent, ciCreateStatus ciContent, sharedMsgId, forwardedByMember) :. (createdAt, createdAt, justTrue live) :. ciTimedRow timed idsRow :: (Maybe Int64, Maybe Int64, Maybe Int64) idsRow = case chatDirection of CDDirectRcv Contact {contactId} -> (Just contactId, Nothing, Nothing) @@ -594,7 +594,7 @@ getGroupChatPreviews_ db User {userId, userContactId} = do 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.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 forwardedByGroupMemberId + -- CIMeta forwardedByMember i.forwarded_by_group_member_id, -- Maybe GroupMember - sender m.group_member_id, m.group_id, m.member_id, m.peer_chat_min_version, m.peer_chat_max_version, m.member_role, m.member_category, @@ -1074,7 +1074,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) :. (itemDeleted, deletedTs, itemEdited, createdAt, updatedAt) :. (timedTTL, timedDeleteAt, itemLive) :. (fileId_, fileName_, fileSize_, filePath, fileKey, fileNonce, fileStatus_, fileProtocol_)) :. Only forwardedByGroupMemberId :. memberRow_ :. (quoteRow :. quotedMemberRow_) :. deletedByGroupMemberRow_) = do +toGroupChatItem currentTs userContactId (((itemId, itemTs, AMsgDirection msgDir, itemContentText, itemText, itemStatus, sharedMsgId) :. (itemDeleted, deletedTs, itemEdited, createdAt, updatedAt) :. (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_ @@ -1110,13 +1110,13 @@ toGroupChatItem currentTs userContactId (((itemId, itemTs, AMsgDirection msgDir, DBCIBlocked -> Just (CIBlocked @'CTGroup deletedTs) _ -> Just (maybe (CIDeleted @'CTGroup deletedTs) (CIModerated deletedTs) deletedByGroupMember_) itemEdited' = fromMaybe False itemEdited - in mkCIMeta itemId content itemText status sharedMsgId itemDeleted' itemEdited' ciTimed itemLive currentTs itemTs forwardedByGroupMemberId createdAt updatedAt + in mkCIMeta itemId content itemText status sharedMsgId itemDeleted' itemEdited' ciTimed itemLive currentTs itemTs forwardedByMember createdAt updatedAt ciTimed :: Maybe CITimed ciTimed = timedTTL >>= \ttl -> Just CITimed {ttl, deleteAt = timedDeleteAt} toGroupChatItemList :: UTCTime -> Int64 -> MaybeGroupChatItemRow -> [CChatItem 'CTGroup] -toGroupChatItemList currentTs userContactId (((Just itemId, Just itemTs, Just msgDir, Just itemContent, Just itemText, Just itemStatus, sharedMsgId) :. (Just itemDeleted, deletedTs, itemEdited, Just createdAt, Just updatedAt) :. (timedTTL, timedDeleteAt, itemLive) :. fileRow) :. forwardedByGroupMemberId :. memberRow_ :. (quoteRow :. quotedMemberRow_) :. deletedByGroupMemberRow_) = - either (const []) (: []) $ toGroupChatItem currentTs userContactId (((itemId, itemTs, msgDir, itemContent, itemText, itemStatus, sharedMsgId) :. (itemDeleted, deletedTs, itemEdited, createdAt, updatedAt) :. (timedTTL, timedDeleteAt, itemLive) :. fileRow) :. forwardedByGroupMemberId :. memberRow_ :. (quoteRow :. quotedMemberRow_) :. deletedByGroupMemberRow_) +toGroupChatItemList currentTs userContactId (((Just itemId, Just itemTs, Just msgDir, Just itemContent, Just itemText, Just itemStatus, sharedMsgId) :. (Just itemDeleted, deletedTs, itemEdited, Just createdAt, Just updatedAt) :. (timedTTL, timedDeleteAt, itemLive) :. fileRow) :. forwardedByMember :. memberRow_ :. (quoteRow :. quotedMemberRow_) :. deletedByGroupMemberRow_) = + either (const []) (: []) $ toGroupChatItem currentTs userContactId (((itemId, itemTs, msgDir, itemContent, itemText, itemStatus, sharedMsgId) :. (itemDeleted, deletedTs, itemEdited, createdAt, updatedAt) :. (timedTTL, timedDeleteAt, itemLive) :. fileRow) :. forwardedByMember :. memberRow_ :. (quoteRow :. quotedMemberRow_) :. deletedByGroupMemberRow_) toGroupChatItemList _ _ _ = [] getAllChatItems :: DB.Connection -> User -> ChatPagination -> Maybe String -> ExceptT StoreError IO [AChatItem] @@ -1560,7 +1560,7 @@ getGroupChatItem db User {userId, userContactId} groupId itemId = ExceptT $ do 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.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 forwardedByGroupMemberId + -- CIMeta forwardedByMember i.forwarded_by_group_member_id, -- GroupMember m.group_member_id, m.group_id, m.member_id, m.peer_chat_min_version, m.peer_chat_max_version, m.member_role, m.member_category, diff --git a/src/Simplex/Chat/View.hs b/src/Simplex/Chat/View.hs index 982c5208a..85511e09e 100644 --- a/src/Simplex/Chat/View.hs +++ b/src/Simplex/Chat/View.hs @@ -449,7 +449,7 @@ 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, content, quotedItem, file} doShow ts tz = +viewChatItem chat ci@ChatItem {chatDir, meta = meta@CIMeta {forwardedByMember}, content, quotedItem, file} doShow ts tz = withGroupMsgForwarded . withItemDeleted <$> (case chat of DirectChat c -> case chatDir of CIDirectSnd -> case content of @@ -489,7 +489,7 @@ viewChatItem chat ci@ChatItem {chatDir, meta = meta, content, quotedItem, file} withItemDeleted item = case chatItemDeletedText ci (chatInfoMembership chat) of Nothing -> item Just t -> item <> styled (colored Red) (" [" <> t <> "]") - withGroupMsgForwarded item = case meta.forwardedByGroupMemberId of + withGroupMsgForwarded item = case forwardedByMember of Nothing -> item Just _ -> item <> styled (colored Yellow) (" [>>]" :: String) withSndFile = withFile viewSentFileInvitation