mirror of
https://github.com/simplex-chat/simplex-chat.git
synced 2026-06-05 16:42:39 +00:00
core: direct messages in group (#2994)
This commit is contained in:
spaced4ndy
@@ -25,6 +25,7 @@ module Simplex.Chat.Store.Messages
|
||||
createRcvMsgDeliveryEvent,
|
||||
createPendingGroupMessage,
|
||||
getPendingGroupMessages,
|
||||
deleteMessage,
|
||||
deletePendingGroupMessage,
|
||||
deleteOldMessages,
|
||||
updateChatTs,
|
||||
@@ -289,6 +290,10 @@ getPendingGroupMessages db groupMemberId =
|
||||
pendingGroupMessage (msgId, cmEventTag, msgBody, introId_) =
|
||||
PendingGroupMessage {msgId, cmEventTag, msgBody, introId_}
|
||||
|
||||
deleteMessage :: DB.Connection -> MessageId -> IO ()
|
||||
deleteMessage db msgId = do
|
||||
DB.execute db "DELETE FROM messages WHERE message_id = ?" (Only msgId)
|
||||
|
||||
deletePendingGroupMessage :: DB.Connection -> Int64 -> MessageId -> IO ()
|
||||
deletePendingGroupMessage db groupMemberId messageId =
|
||||
DB.execute db "DELETE FROM pending_group_messages WHERE group_member_id = ? AND message_id = ?" (groupMemberId, messageId)
|
||||
@@ -297,7 +302,7 @@ deleteOldMessages :: DB.Connection -> UTCTime -> IO ()
|
||||
deleteOldMessages db createdAtCutoff = do
|
||||
DB.execute db "DELETE FROM messages WHERE created_at <= ?" (Only createdAtCutoff)
|
||||
|
||||
type NewQuoteRow = (Maybe SharedMsgId, Maybe UTCTime, Maybe MsgContent, Maybe Bool, Maybe MemberId)
|
||||
type NewQuoteRow = (Maybe SharedMsgId, Maybe UTCTime, Maybe MsgContent, Maybe Bool, Maybe MemberId, Maybe MessageScope)
|
||||
|
||||
updateChatTs :: DB.Connection -> User -> ChatDirection c d -> UTCTime -> IO ()
|
||||
updateChatTs db User {userId} chatDirection chatTs = case toChatInfo chatDirection of
|
||||
@@ -320,14 +325,15 @@ createNewSndChatItem db user chatDirection SndMessage {msgId, sharedMsgId} ciCon
|
||||
createdByMsgId = if msgId == 0 then Nothing else Just msgId
|
||||
quoteRow :: NewQuoteRow
|
||||
quoteRow = case quotedItem of
|
||||
Nothing -> (Nothing, Nothing, Nothing, Nothing, Nothing)
|
||||
Just CIQuote {chatDir, sharedMsgId = quotedSharedMsgId, sentAt, content} ->
|
||||
uncurry (quotedSharedMsgId,Just sentAt,Just content,,) $ case chatDir of
|
||||
CIQDirectSnd -> (Just True, Nothing)
|
||||
CIQDirectRcv -> (Just False, Nothing)
|
||||
CIQGroupSnd -> (Just True, Nothing)
|
||||
CIQGroupRcv (Just GroupMember {memberId}) -> (Just False, Just memberId)
|
||||
CIQGroupRcv Nothing -> (Just False, Nothing)
|
||||
Nothing -> (Nothing, Nothing, Nothing, Nothing, Nothing, Nothing)
|
||||
Just CIQuote {chatDir, sharedMsgId = quotedSharedMsgId, sentAt, content} -> do
|
||||
let (quotedSent, quotedMemberId, quotedMsgScope) = case chatDir of
|
||||
CIQDirectSnd -> (Just True, Nothing, Nothing)
|
||||
CIQDirectRcv -> (Just False, Nothing, Nothing)
|
||||
CIQGroupSnd messageScope -> (Just True, Nothing, Just messageScope)
|
||||
CIQGroupRcv (Just GroupMember {memberId}) messageScope -> (Just False, Just memberId, Just messageScope)
|
||||
CIQGroupRcv Nothing messageScope -> (Just False, Nothing, Just messageScope)
|
||||
(quotedSharedMsgId, Just sentAt, Just content, quotedSent, quotedMemberId, quotedMsgScope)
|
||||
|
||||
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} sharedMsgId_ ciContent timed live itemTs createdAt = do
|
||||
@@ -338,19 +344,20 @@ createNewRcvChatItem db user chatDirection RcvMessage {msgId, chatMsgEvent} shar
|
||||
quotedMsg = cmToQuotedMsg chatMsgEvent
|
||||
quoteRow :: NewQuoteRow
|
||||
quoteRow = case quotedMsg of
|
||||
Nothing -> (Nothing, Nothing, Nothing, Nothing, Nothing)
|
||||
Just QuotedMsg {msgRef = MsgRef {msgId = sharedMsgId, sentAt, sent, memberId}, content} ->
|
||||
uncurry (sharedMsgId,Just sentAt,Just content,,) $ case chatDirection of
|
||||
CDDirectRcv _ -> (Just $ not sent, Nothing)
|
||||
CDGroupRcv GroupInfo {membership = GroupMember {memberId = userMemberId}} _ ->
|
||||
(Just $ Just userMemberId == memberId, memberId)
|
||||
Nothing -> (Nothing, Nothing, Nothing, Nothing, Nothing, Nothing)
|
||||
Just QuotedMsg {msgRef = MsgRef {msgId = sharedMsgId, sentAt, sent, memberId, msgScope}, content} -> do
|
||||
let (quotedSent, quotedMemberId, quotedMsgScope) = case chatDirection of
|
||||
CDDirectRcv _ -> (Just $ not sent, Nothing, Nothing)
|
||||
CDGroupRcv GroupInfo {membership = GroupMember {memberId = userMemberId}} _ _ ->
|
||||
(Just $ Just userMemberId == memberId, memberId, msgScope)
|
||||
(sharedMsgId, Just sentAt, Just content, quotedSent, quotedMemberId, quotedMsgScope)
|
||||
|
||||
createNewChatItemNoMsg :: forall c d. MsgDirectionI d => DB.Connection -> User -> ChatDirection c d -> CIContent d -> UTCTime -> UTCTime -> IO ChatItemId
|
||||
createNewChatItemNoMsg db user chatDirection ciContent =
|
||||
createNewChatItem_ db user chatDirection Nothing Nothing ciContent quoteRow Nothing False
|
||||
where
|
||||
quoteRow :: NewQuoteRow
|
||||
quoteRow = (Nothing, Nothing, Nothing, Nothing, Nothing)
|
||||
quoteRow = (Nothing, 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 -> UTCTime -> IO ChatItemId
|
||||
createNewChatItem_ db User {userId} chatDirection msgId_ sharedMsgId ciContent quoteRow timed live itemTs createdAt = do
|
||||
@@ -359,12 +366,12 @@ createNewChatItem_ db User {userId} chatDirection msgId_ sharedMsgId ciContent q
|
||||
[sql|
|
||||
INSERT INTO chat_items (
|
||||
-- user and IDs
|
||||
user_id, created_by_msg_id, contact_id, group_id, group_member_id,
|
||||
user_id, created_by_msg_id, contact_id, group_id, group_member_id, item_direct_group_member_id,
|
||||
-- meta
|
||||
item_sent, item_ts, item_content, item_text, item_status, shared_msg_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, quoted_message_scope
|
||||
) VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
|
||||
|]
|
||||
((userId, msgId_) :. idsRow :. itemRow :. quoteRow)
|
||||
ciId <- insertedRowId db
|
||||
@@ -373,12 +380,16 @@ createNewChatItem_ db User {userId} chatDirection msgId_ sharedMsgId ciContent q
|
||||
where
|
||||
itemRow :: (SMsgDirection d, UTCTime, CIContent d, Text, CIStatus d, Maybe SharedMsgId) :. (UTCTime, UTCTime, Maybe Bool) :. (Maybe Int, Maybe UTCTime)
|
||||
itemRow = (msgDirection @d, itemTs, ciContent, ciContentToText ciContent, ciCreateStatus ciContent, sharedMsgId) :. (createdAt, createdAt, justTrue live) :. ciTimedRow timed
|
||||
idsRow :: (Maybe Int64, Maybe Int64, Maybe Int64)
|
||||
idsRow :: (Maybe Int64, Maybe Int64, Maybe Int64, Maybe Int64)
|
||||
idsRow = case chatDirection of
|
||||
CDDirectRcv Contact {contactId} -> (Just contactId, Nothing, Nothing)
|
||||
CDDirectSnd Contact {contactId} -> (Just contactId, Nothing, Nothing)
|
||||
CDGroupRcv GroupInfo {groupId} GroupMember {groupMemberId} -> (Nothing, Just groupId, Just groupMemberId)
|
||||
CDGroupSnd GroupInfo {groupId} -> (Nothing, Just groupId, Nothing)
|
||||
CDDirectRcv Contact {contactId} -> (Just contactId, Nothing, Nothing, Nothing)
|
||||
CDDirectSnd Contact {contactId} -> (Just contactId, Nothing, Nothing, Nothing)
|
||||
CDGroupRcv GroupInfo {groupId} GroupMember {groupMemberId} messageScope -> case messageScope of
|
||||
MSGroup -> (Nothing, Just groupId, Just groupMemberId, Nothing)
|
||||
MSDirect -> (Nothing, Just groupId, Just groupMemberId, Just groupMemberId)
|
||||
CDGroupSnd GroupInfo {groupId} directMember -> case directMember of
|
||||
Nothing -> (Nothing, Just groupId, Nothing, Nothing)
|
||||
Just GroupMember {groupMemberId} -> (Nothing, Just groupId, Nothing, Just groupMemberId)
|
||||
|
||||
ciTimedRow :: Maybe CITimed -> (Maybe Int, Maybe UTCTime)
|
||||
ciTimedRow (Just CITimed {ttl, deleteAt}) = (Just ttl, deleteAt)
|
||||
@@ -388,19 +399,21 @@ insertChatItemMessage_ :: DB.Connection -> ChatItemId -> MessageId -> UTCTime ->
|
||||
insertChatItemMessage_ db ciId msgId ts = DB.execute db "INSERT INTO chat_item_messages (chat_item_id, message_id, created_at, updated_at) VALUES (?,?,?,?)" (ciId, msgId, ts, ts)
|
||||
|
||||
getChatItemQuote_ :: DB.Connection -> User -> ChatDirection c 'MDRcv -> QuotedMsg -> IO (CIQuote c)
|
||||
getChatItemQuote_ db User {userId, userContactId} chatDirection QuotedMsg {msgRef = MsgRef {msgId, sentAt, sent, memberId}, content} =
|
||||
getChatItemQuote_ db User {userId, userContactId} chatDirection QuotedMsg {msgRef = MsgRef {msgId, sentAt, sent, memberId, msgScope}, content} =
|
||||
case chatDirection of
|
||||
CDDirectRcv Contact {contactId} -> getDirectChatItemQuote_ contactId (not sent)
|
||||
CDGroupRcv GroupInfo {groupId, membership = GroupMember {memberId = userMemberId}} sender@GroupMember {memberId = senderMemberId} ->
|
||||
CDGroupRcv GroupInfo {groupId, membership = GroupMember {memberId = userMemberId}} sender@GroupMember {memberId = senderMemberId} _directMember ->
|
||||
case memberId of
|
||||
Just mId
|
||||
| mId == userMemberId -> (`ciQuote` CIQGroupSnd) <$> getUserGroupChatItemId_ groupId
|
||||
| mId == senderMemberId -> (`ciQuote` CIQGroupRcv (Just sender)) <$> getGroupChatItemId_ groupId mId
|
||||
| mId == userMemberId -> (`ciQuote` CIQGroupSnd messageScope) <$> getUserGroupChatItemId_ groupId
|
||||
| mId == senderMemberId -> (`ciQuote` CIQGroupRcv (Just sender) messageScope) <$> getGroupChatItemId_ groupId mId
|
||||
| otherwise -> getGroupChatItemQuote_ groupId mId
|
||||
_ -> pure . ciQuote Nothing $ CIQGroupRcv Nothing
|
||||
_ -> pure . ciQuote Nothing $ CIQGroupRcv Nothing messageScope
|
||||
where
|
||||
ciQuote :: Maybe ChatItemId -> CIQDirection c -> CIQuote c
|
||||
ciQuote itemId dir = CIQuote dir itemId msgId sentAt content . parseMaybeMarkdownList $ msgContentText content
|
||||
messageScope :: MessageScope
|
||||
messageScope = fromMaybe MSGroup msgScope
|
||||
getDirectChatItemQuote_ :: Int64 -> Bool -> IO (CIQuote 'CTDirect)
|
||||
getDirectChatItemQuote_ contactId userSent = do
|
||||
fmap ciQuoteDirect . maybeFirstRow fromOnly $
|
||||
@@ -447,8 +460,8 @@ getChatItemQuote_ db User {userId, userContactId} chatDirection QuotedMsg {msgRe
|
||||
[":user_id" := userId, ":group_id" := groupId, ":member_id" := mId, ":msg_id" := msgId]
|
||||
where
|
||||
ciQuoteGroup :: [Only (Maybe ChatItemId) :. GroupMemberRow] -> CIQuote 'CTGroup
|
||||
ciQuoteGroup [] = ciQuote Nothing $ CIQGroupRcv Nothing
|
||||
ciQuoteGroup ((Only itemId :. memberRow) : _) = ciQuote itemId . CIQGroupRcv . Just $ toGroupMember userContactId memberRow
|
||||
ciQuoteGroup [] = ciQuote Nothing $ CIQGroupRcv Nothing messageScope
|
||||
ciQuoteGroup ((Only itemId :. memberRow) : _) = ciQuote itemId $ CIQGroupRcv (Just $ toGroupMember userContactId memberRow) messageScope
|
||||
|
||||
getChatPreviews :: DB.Connection -> User -> Bool -> IO [AChat]
|
||||
getChatPreviews db user withPCC = do
|
||||
@@ -556,7 +569,7 @@ getGroupChatPreviews_ db User {userId, userContactId} = do
|
||||
m.member_status, m.invited_by, m.local_display_name, m.contact_id, m.contact_profile_id, p.contact_profile_id,
|
||||
p.display_name, p.full_name, p.image, p.contact_link, p.local_alias, p.preferences,
|
||||
-- quoted ChatItem
|
||||
ri.chat_item_id, i.quoted_shared_msg_id, i.quoted_sent_at, i.quoted_content, i.quoted_sent,
|
||||
ri.chat_item_id, i.quoted_shared_msg_id, i.quoted_sent_at, i.quoted_content, i.quoted_sent, i.quoted_message_scope,
|
||||
-- quoted GroupMember
|
||||
rm.group_member_id, rm.group_id, rm.member_id, rm.member_role, rm.member_category,
|
||||
rm.member_status, rm.invited_by, rm.local_display_name, rm.contact_id, rm.contact_profile_id, rp.contact_profile_id,
|
||||
@@ -564,7 +577,11 @@ getGroupChatPreviews_ db User {userId, userContactId} = do
|
||||
-- deleted by GroupMember
|
||||
dbm.group_member_id, dbm.group_id, dbm.member_id, dbm.member_role, dbm.member_category,
|
||||
dbm.member_status, dbm.invited_by, dbm.local_display_name, dbm.contact_id, dbm.contact_profile_id, dbp.contact_profile_id,
|
||||
dbp.display_name, dbp.full_name, dbp.image, dbp.contact_link, dbp.local_alias, dbp.preferences
|
||||
dbp.display_name, dbp.full_name, dbp.image, dbp.contact_link, dbp.local_alias, dbp.preferences,
|
||||
-- direct GroupMember
|
||||
dirm.group_member_id, dirm.group_id, dirm.member_id, dirm.member_role, dirm.member_category,
|
||||
dirm.member_status, dirm.invited_by, dirm.local_display_name, dirm.contact_id, dirm.contact_profile_id, dirp.contact_profile_id,
|
||||
dirp.display_name, dirp.full_name, dirp.image, dirp.contact_link, dirp.local_alias, dirp.preferences
|
||||
FROM groups g
|
||||
JOIN group_profiles gp ON gp.group_profile_id = g.group_profile_id
|
||||
JOIN group_members mu ON mu.group_id = g.group_id
|
||||
@@ -590,6 +607,8 @@ getGroupChatPreviews_ db User {userId, userContactId} = do
|
||||
LEFT JOIN contact_profiles rp ON rp.contact_profile_id = COALESCE(rm.member_profile_id, rm.contact_profile_id)
|
||||
LEFT JOIN group_members dbm ON dbm.group_member_id = i.item_deleted_by_group_member_id
|
||||
LEFT JOIN contact_profiles dbp ON dbp.contact_profile_id = COALESCE(dbm.member_profile_id, dbm.contact_profile_id)
|
||||
LEFT JOIN group_members dirm ON dirm.group_member_id = i.item_direct_group_member_id
|
||||
LEFT JOIN contact_profiles dirp ON dirp.contact_profile_id = COALESCE(dirm.member_profile_id, dirm.contact_profile_id)
|
||||
WHERE g.user_id = ? AND mu.contact_id = ?
|
||||
ORDER BY i.item_ts DESC
|
||||
|]
|
||||
@@ -967,10 +986,8 @@ toDirectQuote :: QuoteRow -> Maybe (CIQuote 'CTDirect)
|
||||
toDirectQuote qr@(_, _, _, _, quotedSent) = toQuote qr $ direction <$> quotedSent
|
||||
where
|
||||
direction sent = if sent then CIQDirectSnd else CIQDirectRcv
|
||||
|
||||
toQuote :: QuoteRow -> Maybe (CIQDirection c) -> Maybe (CIQuote c)
|
||||
toQuote (quotedItemId, quotedSharedMsgId, quotedSentAt, quotedMsgContent, _) dir =
|
||||
CIQuote <$> dir <*> pure quotedItemId <*> pure quotedSharedMsgId <*> quotedSentAt <*> quotedMsgContent <*> (parseMaybeMarkdownList . msgContentText <$> quotedMsgContent)
|
||||
toQuote (quotedItemId, quotedSharedMsgId, quotedSentAt, quotedMsgContent, _) dir =
|
||||
CIQuote <$> dir <*> pure quotedItemId <*> pure quotedSharedMsgId <*> quotedSentAt <*> quotedMsgContent <*> (parseMaybeMarkdownList . msgContentText <$> quotedMsgContent)
|
||||
|
||||
-- this function can be changed so it never fails, not only avoid failure on invalid json
|
||||
toDirectChatItem :: UTCTime -> ChatItemRow :. QuoteRow -> Either StoreError (CChatItem 'CTDirect)
|
||||
@@ -1013,37 +1030,60 @@ toDirectChatItemList currentTs (((Just itemId, Just itemTs, Just msgDir, Just it
|
||||
either (const []) (: []) $ toDirectChatItem currentTs (((itemId, itemTs, msgDir, itemContent, itemText, itemStatus, sharedMsgId) :. (itemDeleted, deletedTs, itemEdited, createdAt, updatedAt) :. (timedTTL, timedDeleteAt, itemLive) :. fileRow) :. quoteRow)
|
||||
toDirectChatItemList _ _ = []
|
||||
|
||||
type GroupQuoteRow = QuoteRow :. MaybeGroupMemberRow
|
||||
type GroupQuoteRow = (Maybe ChatItemId, Maybe SharedMsgId, Maybe UTCTime, Maybe MsgContent, Maybe Bool, Maybe MessageScope)
|
||||
|
||||
type MaybeGroupChatItemRow = MaybeChatItemRow :. MaybeGroupMemberRow :. GroupQuoteRow :. MaybeGroupMemberRow
|
||||
type GroupQuoteMemberRow = GroupQuoteRow :. MaybeGroupMemberRow
|
||||
|
||||
toGroupQuote :: QuoteRow -> Maybe GroupMember -> Maybe (CIQuote 'CTGroup)
|
||||
toGroupQuote qr@(_, _, _, _, quotedSent) quotedMember_ = toQuote qr $ direction quotedSent quotedMember_
|
||||
type MaybeGroupChatItemRow = MaybeChatItemRow :. MaybeGroupMemberRow :. GroupQuoteMemberRow :. MaybeGroupMemberRow :. MaybeGroupMemberRow
|
||||
|
||||
toGroupQuote :: GroupQuoteRow -> Maybe GroupMember -> Maybe (CIQuote 'CTGroup)
|
||||
toGroupQuote qr@(_, _, _, _, quotedSent, msgScope) quotedMember_ =
|
||||
toQuote qr $ direction quotedSent quotedMember_
|
||||
where
|
||||
direction (Just True) _ = Just CIQGroupSnd
|
||||
direction (Just False) (Just member) = Just . CIQGroupRcv $ Just member
|
||||
direction (Just False) Nothing = Just $ CIQGroupRcv Nothing
|
||||
direction (Just True) _ = Just $ CIQGroupSnd messageScope
|
||||
direction (Just False) (Just member) = Just $ CIQGroupRcv (Just member) messageScope
|
||||
direction (Just False) Nothing = Just $ CIQGroupRcv Nothing messageScope
|
||||
direction _ _ = Nothing
|
||||
messageScope = fromMaybe MSGroup msgScope
|
||||
toQuote (quotedItemId, quotedSharedMsgId, quotedSentAt, quotedMsgContent, _, _) dir =
|
||||
CIQuote <$> dir <*> pure quotedItemId <*> pure quotedSharedMsgId <*> quotedSentAt <*> quotedMsgContent <*> (parseMaybeMarkdownList . msgContentText <$> quotedMsgContent)
|
||||
|
||||
-- this function can be changed so it never fails, not only avoid failure on invalid json
|
||||
toGroupChatItem :: UTCTime -> Int64 -> ChatItemRow :. 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_)) :. memberRow_ :. (quoteRow :. quotedMemberRow_) :. deletedByGroupMemberRow_) = do
|
||||
toGroupChatItem :: UTCTime -> Int64 -> ChatItemRow :. MaybeGroupMemberRow :. GroupQuoteMemberRow :. MaybeGroupMemberRow :. 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_)) :. memberRow_ :. (quoteRow :. quotedMemberRow_) :. deletedByGroupMemberRow_ :. directMemberRow_) = do
|
||||
chatItem $ fromRight invalid $ dbParseACIContent itemContentText
|
||||
where
|
||||
member_ = toMaybeGroupMember userContactId memberRow_
|
||||
quotedMember_ = toMaybeGroupMember userContactId quotedMemberRow_
|
||||
deletedByGroupMember_ = toMaybeGroupMember userContactId deletedByGroupMemberRow_
|
||||
directMember_ = toMaybeGroupMember userContactId directMemberRow_
|
||||
invalid = ACIContent msgDir $ CIInvalidJSON itemContentText
|
||||
chatItem itemContent = case (itemContent, itemStatus, member_, fileStatus_) of
|
||||
(ACIContent SMDSnd ciContent, ACIStatus SMDSnd ciStatus, _, Just (AFS SMDSnd fileStatus)) ->
|
||||
Right $ cItem SMDSnd CIGroupSnd ciStatus ciContent (maybeCIFile fileStatus)
|
||||
Right $ cItem SMDSnd (CIGroupSnd directMember_) ciStatus ciContent (maybeCIFile fileStatus)
|
||||
(ACIContent SMDSnd ciContent, ACIStatus SMDSnd ciStatus, _, Nothing) ->
|
||||
Right $ cItem SMDSnd CIGroupSnd ciStatus ciContent Nothing
|
||||
Right $ cItem SMDSnd (CIGroupSnd directMember_) ciStatus ciContent Nothing
|
||||
-- read of group chat item can be refactored so that direct member is not read for rcv items:
|
||||
-- if item_direct_group_member_id is equal to group_member_id, then message scope is direct
|
||||
(ACIContent SMDRcv ciContent, ACIStatus SMDRcv ciStatus, Just member, Just (AFS SMDRcv fileStatus)) ->
|
||||
Right $ cItem SMDRcv (CIGroupRcv member) ciStatus ciContent (maybeCIFile fileStatus)
|
||||
case directMember_ of
|
||||
Just directMember
|
||||
| sameMember member directMember ->
|
||||
Right $ cItem SMDRcv (CIGroupRcv member MSDirect) ciStatus ciContent (maybeCIFile fileStatus)
|
||||
| otherwise -> badItem
|
||||
Nothing ->
|
||||
Right $ cItem SMDRcv (CIGroupRcv member MSGroup) ciStatus ciContent (maybeCIFile fileStatus)
|
||||
(ACIContent SMDRcv ciContent, ACIStatus SMDRcv ciStatus, Just member, Nothing) ->
|
||||
Right $ cItem SMDRcv (CIGroupRcv member) ciStatus ciContent Nothing
|
||||
case directMember_ of
|
||||
Just directMember
|
||||
| sameMember member directMember ->
|
||||
Right $ cItem SMDRcv (CIGroupRcv member MSDirect) ciStatus ciContent Nothing
|
||||
| otherwise -> badItem
|
||||
Nothing ->
|
||||
Right $ cItem SMDRcv (CIGroupRcv member MSGroup) ciStatus ciContent Nothing
|
||||
_ -> badItem
|
||||
sameMember :: GroupMember -> GroupMember -> Bool
|
||||
sameMember GroupMember {groupMemberId = gmId1} GroupMember {groupMemberId = gmId2} = gmId1 == gmId2
|
||||
maybeCIFile :: CIFileStatus d -> Maybe (CIFile d)
|
||||
maybeCIFile fileStatus =
|
||||
case (fileId_, fileName_, fileSize_, fileProtocol_) of
|
||||
@@ -1068,8 +1108,8 @@ toGroupChatItem currentTs userContactId (((itemId, itemTs, AMsgDirection msgDir,
|
||||
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) :. 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) :. 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) :. memberRow_ :. (quoteRow :. quotedMemberRow_) :. deletedByGroupMemberRow_ :. directMemberRow_) =
|
||||
either (const []) (: []) $ toGroupChatItem currentTs userContactId (((itemId, itemTs, msgDir, itemContent, itemText, itemStatus, sharedMsgId) :. (itemDeleted, deletedTs, itemEdited, createdAt, updatedAt) :. (timedTTL, timedDeleteAt, itemLive) :. fileRow) :. memberRow_ :. (quoteRow :. quotedMemberRow_) :. deletedByGroupMemberRow_ :. directMemberRow_)
|
||||
toGroupChatItemList _ _ _ = []
|
||||
|
||||
getAllChatItems :: DB.Connection -> User -> ChatPagination -> Maybe String -> ExceptT StoreError IO [AChatItem]
|
||||
@@ -1484,7 +1524,7 @@ getGroupChatItem db User {userId, userContactId} groupId itemId = ExceptT $ do
|
||||
m.member_status, m.invited_by, m.local_display_name, m.contact_id, m.contact_profile_id, p.contact_profile_id,
|
||||
p.display_name, p.full_name, p.image, p.contact_link, p.local_alias, p.preferences,
|
||||
-- quoted ChatItem
|
||||
ri.chat_item_id, i.quoted_shared_msg_id, i.quoted_sent_at, i.quoted_content, i.quoted_sent,
|
||||
ri.chat_item_id, i.quoted_shared_msg_id, i.quoted_sent_at, i.quoted_content, i.quoted_sent, i.quoted_message_scope,
|
||||
-- quoted GroupMember
|
||||
rm.group_member_id, rm.group_id, rm.member_id, rm.member_role, rm.member_category,
|
||||
rm.member_status, rm.invited_by, rm.local_display_name, rm.contact_id, rm.contact_profile_id, rp.contact_profile_id,
|
||||
@@ -1492,7 +1532,11 @@ getGroupChatItem db User {userId, userContactId} groupId itemId = ExceptT $ do
|
||||
-- deleted by GroupMember
|
||||
dbm.group_member_id, dbm.group_id, dbm.member_id, dbm.member_role, dbm.member_category,
|
||||
dbm.member_status, dbm.invited_by, dbm.local_display_name, dbm.contact_id, dbm.contact_profile_id, dbp.contact_profile_id,
|
||||
dbp.display_name, dbp.full_name, dbp.image, dbp.contact_link, dbp.local_alias, dbp.preferences
|
||||
dbp.display_name, dbp.full_name, dbp.image, dbp.contact_link, dbp.local_alias, dbp.preferences,
|
||||
-- direct GroupMember
|
||||
dirm.group_member_id, dirm.group_id, dirm.member_id, dirm.member_role, dirm.member_category,
|
||||
dirm.member_status, dirm.invited_by, dirm.local_display_name, dirm.contact_id, dirm.contact_profile_id, dirp.contact_profile_id,
|
||||
dirp.display_name, dirp.full_name, dirp.image, dirp.contact_link, dirp.local_alias, dirp.preferences
|
||||
FROM chat_items i
|
||||
LEFT JOIN files f ON f.chat_item_id = i.chat_item_id
|
||||
LEFT JOIN group_members m ON m.group_member_id = i.group_member_id
|
||||
@@ -1502,6 +1546,8 @@ getGroupChatItem db User {userId, userContactId} groupId itemId = ExceptT $ do
|
||||
LEFT JOIN contact_profiles rp ON rp.contact_profile_id = COALESCE(rm.member_profile_id, rm.contact_profile_id)
|
||||
LEFT JOIN group_members dbm ON dbm.group_member_id = i.item_deleted_by_group_member_id
|
||||
LEFT JOIN contact_profiles dbp ON dbp.contact_profile_id = COALESCE(dbm.member_profile_id, dbm.contact_profile_id)
|
||||
LEFT JOIN group_members dirm ON dirm.group_member_id = i.item_direct_group_member_id
|
||||
LEFT JOIN contact_profiles dirp ON dirp.contact_profile_id = COALESCE(dirm.member_profile_id, dirm.contact_profile_id)
|
||||
WHERE i.user_id = ? AND i.group_id = ? AND i.chat_item_id = ?
|
||||
|]
|
||||
(userId, groupId, itemId)
|
||||
|
||||
@@ -79,6 +79,7 @@ import Simplex.Chat.Migrations.M20230814_indexes
|
||||
import Simplex.Chat.Migrations.M20230827_file_encryption
|
||||
import Simplex.Chat.Migrations.M20230829_connections_chat_vrange
|
||||
import Simplex.Chat.Migrations.M20230903_connections_to_subscribe
|
||||
import Simplex.Chat.Migrations.M20230904_item_direct_group_member_id
|
||||
import Simplex.Messaging.Agent.Store.SQLite.Migrations (Migration (..))
|
||||
|
||||
schemaMigrations :: [(String, Query, Maybe Query)]
|
||||
@@ -157,7 +158,8 @@ schemaMigrations =
|
||||
("20230814_indexes", m20230814_indexes, Just down_m20230814_indexes),
|
||||
("20230827_file_encryption", m20230827_file_encryption, Just down_m20230827_file_encryption),
|
||||
("20230829_connections_chat_vrange", m20230829_connections_chat_vrange, Just down_m20230829_connections_chat_vrange),
|
||||
("20230903_connections_to_subscribe", m20230903_connections_to_subscribe, Just down_m20230903_connections_to_subscribe)
|
||||
("20230903_connections_to_subscribe", m20230903_connections_to_subscribe, Just down_m20230903_connections_to_subscribe),
|
||||
("20230904_item_direct_group_member_id", m20230904_item_direct_group_member_id, Just down_m20230904_item_direct_group_member_id)
|
||||
]
|
||||
|
||||
-- | The list of migrations in ascending order by date
|
||||
|
||||
Reference in New Issue
Block a user