Merge branch 'master' into remote-desktop

This commit is contained in:
Evgeny Poberezkin 2023-11-20 10:35:20 +00:00
commit 970ca3a409
6 changed files with 124 additions and 49 deletions

View File

@ -15,7 +15,6 @@
<uses-permission android:name="android.permission.RECEIVE_BOOT_COMPLETED" /> <uses-permission android:name="android.permission.RECEIVE_BOOT_COMPLETED" />
<uses-permission android:name="android.permission.VIBRATE" /> <uses-permission android:name="android.permission.VIBRATE" />
<uses-permission android:name="android.permission.INTERNET" /> <uses-permission android:name="android.permission.INTERNET" />
<uses-permission android:name="android.permission.ACCESS_WIFI_STATE" />
<uses-permission android:name="android.permission.ACCESS_NETWORK_STATE" /> <uses-permission android:name="android.permission.ACCESS_NETWORK_STATE" />
<uses-permission android:name="android.permission.WRITE_EXTERNAL_STORAGE" <uses-permission android:name="android.permission.WRITE_EXTERNAL_STORAGE"
tools:ignore="ScopedStorage" /> tools:ignore="ScopedStorage" />

View File

@ -5646,20 +5646,20 @@ saveRcvChatItem user cd msg@RcvMessage {sharedMsgId_} brokerTs content =
saveRcvChatItem' user cd msg sharedMsgId_ brokerTs content Nothing Nothing False 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' :: 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 createdAt <- liftIO getCurrentTime
(ciId, quotedItem) <- withStore' $ \db -> do (ciId, quotedItem) <- withStore' $ \db -> do
when (ciRequiresAttention content) $ updateChatTs db user cd createdAt when (ciRequiresAttention content) $ updateChatTs db user cd createdAt
(ciId, quotedItem) <- createNewRcvChatItem db user cd msg sharedMsgId_ content itemTimed live brokerTs createdAt (ciId, quotedItem) <- createNewRcvChatItem db user cd msg sharedMsgId_ content itemTimed live brokerTs createdAt
forM_ ciFile $ \CIFile {fileId} -> updateFileTransferChatItemId db fileId ciId createdAt forM_ ciFile $ \CIFile {fileId} -> updateFileTransferChatItemId db fileId ciId createdAt
pure (ciId, quotedItem) 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 :: 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 let itemText = ciContentToText content
itemStatus = ciCreateStatus 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} 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 deleteDirectCI :: (ChatMonad m, MsgDirectionI d) => User -> Contact -> ChatItem 'CTDirect d -> Bool -> Bool -> m ChatResponse

View File

@ -318,18 +318,18 @@ data CIMeta (c :: ChatType) (d :: MsgDirection) = CIMeta
itemTimed :: Maybe CITimed, itemTimed :: Maybe CITimed,
itemLive :: Maybe Bool, itemLive :: Maybe Bool,
editable :: Bool, editable :: Bool,
forwardedByGroupMemberId :: Maybe GroupMemberId, forwardedByMember :: Maybe GroupMemberId,
createdAt :: UTCTime, createdAt :: UTCTime,
updatedAt :: UTCTime updatedAt :: UTCTime
} }
deriving (Show) deriving (Show)
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 :: 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 let editable = case itemContent of
CISndMsgContent _ -> diffUTCTime currentTs itemTs < nominalDay && isNothing itemDeleted CISndMsgContent _ -> diffUTCTime currentTs itemTs < nominalDay && isNothing itemDeleted
_ -> False _ -> 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}
data CITimed = CITimed data CITimed = CITimed
{ ttl :: Int, -- seconds { ttl :: Int, -- seconds
@ -784,8 +784,8 @@ data RcvMessage = RcvMessage
chatMsgEvent :: AChatMsgEvent, chatMsgEvent :: AChatMsgEvent,
sharedMsgId_ :: Maybe SharedMsgId, sharedMsgId_ :: Maybe SharedMsgId,
msgBody :: MsgBody, msgBody :: MsgBody,
authorGroupMemberId :: Maybe GroupMemberId, authorMember :: Maybe GroupMemberId,
forwardedByGroupMemberId :: Maybe GroupMemberId forwardedByMember :: Maybe GroupMemberId
} }
data PendingGroupMessage = PendingGroupMessage data PendingGroupMessage = PendingGroupMessage

View File

@ -200,7 +200,7 @@ createNewMessageAndRcvMsgDelivery db connOrGroupId newMessage sharedMsgId_ RcvMs
pure msg pure msg
createNewRcvMessage :: forall e. (MsgEncodingI e) => DB.Connection -> ConnOrGroupId -> NewMessage e -> Maybe SharedMsgId -> Maybe GroupMemberId -> Maybe GroupMemberId -> ExceptT StoreError IO RcvMessage 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 case connOrGroupId of
ConnectionId connId -> liftIO $ insertRcvMsg (Just connId) Nothing ConnectionId connId -> liftIO $ insertRcvMsg (Just connId) Nothing
GroupId groupId -> case sharedMsgId_ of 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) (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 (?,?,?,?,?,?,?,?,?,?) 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 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.Connection -> Int64 -> AgentMsgId -> MsgDeliveryStatus 'MDSnd -> ExceptT StoreError IO ()
createSndMsgDeliveryEvent db connId agentMsgId sndMsgDeliveryStatus = do createSndMsgDeliveryEvent db connId agentMsgId sndMsgDeliveryStatus = do
@ -366,8 +366,8 @@ createNewSndChatItem db user chatDirection SndMessage {msgId, sharedMsgId} ciCon
CIQGroupRcv Nothing -> (Just False, Nothing) 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.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 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 forwardedByGroupMemberId createdAt ciId <- createNewChatItem_ db user chatDirection (Just msgId) sharedMsgId_ ciContent quoteRow timed live itemTs forwardedByMember createdAt
quotedItem <- mapM (getChatItemQuote_ db user chatDirection) quotedMsg quotedItem <- mapM (getChatItemQuote_ db user chatDirection) quotedMsg
pure (ciId, quotedItem) pure (ciId, quotedItem)
where where
@ -389,7 +389,7 @@ createNewChatItemNoMsg db user chatDirection ciContent itemTs =
quoteRow = (Nothing, Nothing, Nothing, Nothing, Nothing) 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_ :: 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.execute
db db
[sql| [sql|
@ -408,7 +408,7 @@ createNewChatItem_ db User {userId} chatDirection msgId_ sharedMsgId ciContent q
pure ciId pure ciId
where where
itemRow :: (SMsgDirection d, UTCTime, CIContent d, Text, CIStatus d, Maybe SharedMsgId, Maybe GroupMemberId) :. (UTCTime, UTCTime, Maybe Bool) :. (Maybe Int, Maybe UTCTime) 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 :: (Maybe Int64, Maybe Int64, Maybe Int64)
idsRow = case chatDirection of idsRow = case chatDirection of
CDDirectRcv Contact {contactId} -> (Just contactId, Nothing, Nothing) 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, 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 -- 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, 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, i.forwarded_by_group_member_id,
-- Maybe GroupMember - sender -- 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, 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 -- 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 :: 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 chatItem $ fromRight invalid $ dbParseACIContent itemContentText
where where
member_ = toMaybeGroupMember userContactId memberRow_ member_ = toMaybeGroupMember userContactId memberRow_
@ -1110,13 +1110,13 @@ toGroupChatItem currentTs userContactId (((itemId, itemTs, AMsgDirection msgDir,
DBCIBlocked -> Just (CIBlocked deletedTs) DBCIBlocked -> Just (CIBlocked deletedTs)
_ -> Just (maybe (CIDeleted @'CTGroup deletedTs) (CIModerated deletedTs) deletedByGroupMember_) _ -> Just (maybe (CIDeleted @'CTGroup deletedTs) (CIModerated deletedTs) deletedByGroupMember_)
itemEdited' = fromMaybe False itemEdited 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 :: Maybe CITimed
ciTimed = timedTTL >>= \ttl -> Just CITimed {ttl, deleteAt = timedDeleteAt} ciTimed = timedTTL >>= \ttl -> Just CITimed {ttl, deleteAt = timedDeleteAt}
toGroupChatItemList :: UTCTime -> Int64 -> MaybeGroupChatItemRow -> [CChatItem 'CTGroup] 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_) = 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) :. 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) :. forwardedByMember :. memberRow_ :. (quoteRow :. quotedMemberRow_) :. deletedByGroupMemberRow_)
toGroupChatItemList _ _ _ = [] toGroupChatItemList _ _ _ = []
getAllChatItems :: DB.Connection -> User -> ChatPagination -> Maybe String -> ExceptT StoreError IO [AChatItem] 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, 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 -- 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, 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, i.forwarded_by_group_member_id,
-- GroupMember -- 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, 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,

View File

@ -508,7 +508,7 @@ viewChats ts tz = concatMap chatPreview . reverse
_ -> [] _ -> []
viewChatItem :: forall c d. MsgDirectionI d => ChatInfo c -> ChatItem c d -> Bool -> CurrentTime -> TimeZone -> [StyledString] 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 withGroupMsgForwarded . withItemDeleted <$> (case chat of
DirectChat c -> case chatDir of DirectChat c -> case chatDir of
CIDirectSnd -> case content of CIDirectSnd -> case content of
@ -548,7 +548,7 @@ viewChatItem chat ci@ChatItem {chatDir, meta = meta, content, quotedItem, file}
withItemDeleted item = case chatItemDeletedText ci (chatInfoMembership chat) of withItemDeleted item = case chatItemDeletedText ci (chatInfoMembership chat) of
Nothing -> item Nothing -> item
Just t -> item <> styled (colored Red) (" [" <> t <> "]") Just t -> item <> styled (colored Red) (" [" <> t <> "]")
withGroupMsgForwarded item = case meta.forwardedByGroupMemberId of withGroupMsgForwarded item = case forwardedByMember of
Nothing -> item Nothing -> item
Just _ -> item <> styled (colored Yellow) (" [>>]" :: String) Just _ -> item <> styled (colored Yellow) (" [>>]" :: String)
withSndFile = withFile viewSentFileInvitation withSndFile = withFile viewSentFileInvitation

View File

@ -105,8 +105,14 @@ chatGroupTests = do
it "invited member replaces member contact reference if it already exists" testMemberContactInvitedConnectionReplaced it "invited member replaces member contact reference if it already exists" testMemberContactInvitedConnectionReplaced
it "share incognito profile" testMemberContactIncognito it "share incognito profile" testMemberContactIncognito
it "sends and updates profile when creating contact" testMemberContactProfileUpdate it "sends and updates profile when creating contact" testMemberContactProfileUpdate
describe "forwarding messages" $ do describe "group message forwarding" $ do
it "admin should forward messages between invitee and introduced" testGroupMsgForward 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 where
_0 = supportedChatVRange -- don't create direct connections _0 = supportedChatVRange -- don't create direct connections
_1 = groupCreateDirectVRange _1 = groupCreateDirectVRange
@ -3902,18 +3908,9 @@ testMemberContactProfileUpdate =
testGroupMsgForward :: HasCallStack => FilePath -> IO () testGroupMsgForward :: HasCallStack => FilePath -> IO ()
testGroupMsgForward = testGroupMsgForward =
testChatCfg4 cfg aliceProfile bobProfile cathProfile danProfile $ testChat3 aliceProfile bobProfile cathProfile $
\alice bob cath dan -> withXFTPServer $ do \alice bob cath -> do
createGroup3 "team" alice bob cath setupGroupForwarding3 "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'"
bob #> "#team hi there" bob #> "#team hi there"
alice <# "#team bob> hi there" alice <# "#team bob> hi there"
@ -3937,22 +3934,80 @@ testGroupMsgForward =
cath <# "#team bob> hi there [>>]" cath <# "#team bob> hi there [>>]"
cath <# "#team hey team" 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 hello there"
bob <# "#team [edited] hello there" bob <# "#team [edited] hello there"
alice <# "#team bob> [edited] hello there" alice <# "#team bob> [edited] hello there"
cath <# "#team bob> [edited] hello there" -- TODO show as forwarded 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 👍" cath <## "added 👍"
alice <# "#team cath> > bob hello there" alice <# "#team cath> > bob hi there"
alice <## " + 👍" alice <## " + 👍"
bob <# "#team cath> > bob hello there" bob <# "#team cath> > bob hi there"
bob <## " + 👍" 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" bob <## "message marked deleted"
alice <# "#team bob> [marked deleted] hello there" alice <# "#team bob> [marked deleted] hi there"
cath <# "#team bob> [marked deleted] hello there" -- TODO show as forwarded 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 #> "/f #team ./tests/fixtures/test.jpg"
bob <## "use /fc 1 to cancel sending" bob <## "use /fc 1 to cancel sending"
@ -3972,12 +4027,26 @@ testGroupMsgForward =
src <- B.readFile "./tests/fixtures/test.jpg" src <- B.readFile "./tests/fixtures/test.jpg"
dest <- B.readFile "./tests/tmp/test.jpg" dest <- B.readFile "./tests/tmp/test.jpg"
dest `shouldBe` src 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 ##> "/mr #team bob member"
cath <## "#team: you changed the role of bob from admin to 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" 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 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 connectUsers cath dan
cath ##> "/a #team dan" cath ##> "/a #team dan"
cath <## "invitation to join the group #team sent to 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 bob <## "#team: cath added dan (Daniel) to the group (connecting...)", -- TODO show as forwarded
dan <## "#team: member alice (Alice) is connected" dan <## "#team: member alice (Alice) is connected"
] ]
dan #> "#team hello all" dan #> "#team hello all"
alice <# "#team dan> hello all" alice <# "#team dan> hello all"
-- bob <# "#team dan> hello all [>>]" -- bob <# "#team dan> hello all [>>]"
cath <# "#team dan> hello all" cath <# "#team dan> hello all"
bob #> "#team hi all" bob #> "#team hi all"
alice <# "#team bob> hi all" alice <# "#team bob> hi all"
cath <# "#team bob> hi all [>>]" cath <# "#team bob> hi all [>>]"
-- dan <# "#team bob> hi all" -- dan <# "#team bob> hi all [>>]"
where
cfg = testCfg {xftpFileConfig = Just $ XFTPFileConfig {minFileSize = 0}, tempDir = Just "./tests/tmp"} bob ##> "/ms team"
bob
<### [ "alice (Alice): owner, host, connected",
"bob (Bob): admin, you, connected",
"cath (Catherine): admin, connected",
"dan (Daniel): member"
]