mirror of
https://github.com/simplex-chat/simplex-chat.git
synced 2024-12-17 17:20:21 +01:00
core: deleted timestamps for chat item (#2459)
* core: edited and deleted timestamps for item * migration * add deleted timestamp to chat item, use chat item if there are no versions * use broker timestamp for remote deletions * refactor
This commit is contained in:
Evgeny Poberezkin
committed by
GitHub
GitHub
parent
f155611d29
commit
9978957e6c
+26
-23
@@ -469,9 +469,10 @@ processChatCommand = \case
|
||||
chatItems <- withStore $ \db -> getAllChatItems db user pagination search
|
||||
pure $ CRChatItems user chatItems
|
||||
APIGetChatItemInfo chatRef itemId -> withUser $ \user -> do
|
||||
(chatItem, itemVersions) <- withStore $ \db ->
|
||||
(aci@(AChatItem _ _ _ ci), versions) <- withStore $ \db ->
|
||||
(,) <$> getAChatItem db user chatRef itemId <*> liftIO (getChatItemVersions db itemId)
|
||||
pure $ CRChatItemInfo user chatItem ChatItemInfo {itemVersions}
|
||||
let itemVersions = if null versions then maybeToList $ mkItemVersion ci else versions
|
||||
pure $ CRChatItemInfo user aci ChatItemInfo {itemVersions}
|
||||
APISendMessage (ChatRef cType chatId) live itemTTL (ComposedMessage file_ quotedItemId_ mc) -> withUser $ \user@User {userId} -> withChatLock "sendMessage" $ case cType of
|
||||
CTDirect -> do
|
||||
ct@Contact {contactId, localDisplayName = c, contactUsed} <- withStore $ \db -> getContact db user chatId
|
||||
@@ -704,13 +705,13 @@ processChatCommand = \case
|
||||
setActive $ ActiveC c
|
||||
if featureAllowed SCFFullDelete forUser ct
|
||||
then deleteDirectCI user ct ci True False
|
||||
else markDirectCIDeleted user ct ci msgId True
|
||||
else markDirectCIDeleted user ct ci msgId True =<< liftIO getCurrentTime
|
||||
(CIDMBroadcast, _, _) -> throwChatError CEInvalidChatItemDelete
|
||||
CTGroup -> do
|
||||
Group gInfo ms <- withStore $ \db -> getGroup db user chatId
|
||||
ci@(CChatItem msgDir ChatItem {meta = CIMeta {itemSharedMsgId}}) <- withStore $ \db -> getGroupChatItem db user chatId itemId
|
||||
case (mode, msgDir, itemSharedMsgId) of
|
||||
(CIDMInternal, _, _) -> deleteGroupCI user gInfo ci True False Nothing
|
||||
(CIDMInternal, _, _) -> deleteGroupCI user gInfo ci True False Nothing =<< liftIO getCurrentTime
|
||||
(CIDMBroadcast, SMDSnd, Just itemSharedMId) -> do
|
||||
assertUserGroupRole gInfo GRObserver -- can still delete messages sent earlier
|
||||
SndMessage {msgId} <- sendGroupMessage user gInfo ms $ XMsgDel itemSharedMId Nothing
|
||||
@@ -1778,9 +1779,10 @@ processChatCommand = \case
|
||||
delGroupChatItem :: User -> GroupInfo -> CChatItem 'CTGroup -> MessageId -> Maybe GroupMember -> m ChatResponse
|
||||
delGroupChatItem user gInfo@GroupInfo {localDisplayName = gName} ci msgId byGroupMember = do
|
||||
setActive $ ActiveG gName
|
||||
deletedTs <- liftIO getCurrentTime
|
||||
if groupFeatureAllowed SGFFullDelete gInfo
|
||||
then deleteGroupCI user gInfo ci True False byGroupMember
|
||||
else markGroupCIDeleted user gInfo ci msgId True byGroupMember
|
||||
then deleteGroupCI user gInfo ci True False byGroupMember deletedTs
|
||||
else markGroupCIDeleted user gInfo ci msgId True byGroupMember deletedTs
|
||||
updateGroupProfileByName :: GroupName -> (GroupProfile -> GroupProfile) -> m ChatResponse
|
||||
updateGroupProfileByName gName update = withUser $ \user -> do
|
||||
g@(Group GroupInfo {groupProfile = p} _) <- withStore $ \db ->
|
||||
@@ -2402,7 +2404,8 @@ deleteTimedItem user (ChatRef cType chatId, itemId) deleteAt = do
|
||||
deleteDirectCI user ct ci True True >>= toView
|
||||
CTGroup -> do
|
||||
(gInfo, ci) <- withStore $ \db -> (,) <$> getGroupInfo db user chatId <*> getGroupChatItem db user chatId itemId
|
||||
deleteGroupCI user gInfo ci True True Nothing >>= toView
|
||||
deletedTs <- liftIO getCurrentTime
|
||||
deleteGroupCI user gInfo ci True True Nothing deletedTs >>= toView
|
||||
_ -> toView . CRChatError (Just user) . ChatError $ CEInternalError "bad deleteTimedItem cType"
|
||||
|
||||
startUpdatedTimedItemThread :: ChatMonad m => User -> ChatRef -> ChatItem c d -> ChatItem c d -> m ()
|
||||
@@ -2932,7 +2935,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
|
||||
XMsgFileDescr sharedMsgId fileDescr -> canSend $ groupMessageFileDescription gInfo m sharedMsgId fileDescr msgMeta
|
||||
XMsgFileCancel sharedMsgId -> cancelGroupMessageFile gInfo m sharedMsgId msgMeta
|
||||
XMsgUpdate sharedMsgId mContent ttl live -> canSend $ groupMessageUpdate gInfo m sharedMsgId mContent msg msgMeta ttl live
|
||||
XMsgDel sharedMsgId memberId -> groupMessageDelete gInfo m sharedMsgId memberId msg
|
||||
XMsgDel sharedMsgId memberId -> groupMessageDelete gInfo m sharedMsgId memberId msg msgMeta
|
||||
XMsgReact sharedMsgId (Just memberId) reaction add -> groupMsgReaction gInfo m sharedMsgId memberId reaction add msg msgMeta
|
||||
-- TODO discontinue XFile
|
||||
XFile fInv -> processGroupFileInvitation' gInfo m fInv msg msgMeta
|
||||
@@ -3399,7 +3402,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
|
||||
_ -> messageError "x.msg.update: contact attempted invalid message update"
|
||||
|
||||
messageDelete :: Contact -> SharedMsgId -> RcvMessage -> MsgMeta -> m ()
|
||||
messageDelete ct@Contact {contactId} sharedMsgId RcvMessage {msgId} msgMeta = do
|
||||
messageDelete ct@Contact {contactId} sharedMsgId RcvMessage {msgId} msgMeta@MsgMeta {broker = (_, brokerTs)} = do
|
||||
checkIntegrityCreateItem (CDDirectRcv ct) msgMeta
|
||||
deleteRcvChatItem `catchCINotFound` (toView . CRChatItemDeletedNotFound user ct)
|
||||
where
|
||||
@@ -3409,7 +3412,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
|
||||
SMDRcv ->
|
||||
if featureAllowed SCFFullDelete forContact ct
|
||||
then deleteDirectCI user ct ci False False >>= toView
|
||||
else markDirectCIDeleted user ct ci msgId False >>= toView
|
||||
else markDirectCIDeleted user ct ci msgId False brokerTs >>= toView
|
||||
SMDSnd -> messageError "x.msg.del: contact attempted invalid message delete"
|
||||
|
||||
directMsgReaction :: Contact -> SharedMsgId -> MsgReaction -> Bool -> RcvMessage -> MsgMeta -> m ()
|
||||
@@ -3523,8 +3526,8 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
|
||||
else messageError "x.msg.update: group member attempted to update a message of another member"
|
||||
_ -> messageError "x.msg.update: group member attempted invalid message update"
|
||||
|
||||
groupMessageDelete :: GroupInfo -> GroupMember -> SharedMsgId -> Maybe MemberId -> RcvMessage -> m ()
|
||||
groupMessageDelete gInfo@GroupInfo {groupId, membership} m@GroupMember {memberId, memberRole = senderRole} sharedMsgId sndMemberId_ RcvMessage {msgId} = do
|
||||
groupMessageDelete :: GroupInfo -> GroupMember -> SharedMsgId -> Maybe MemberId -> RcvMessage -> MsgMeta -> m ()
|
||||
groupMessageDelete gInfo@GroupInfo {groupId, membership} m@GroupMember {memberId, memberRole = senderRole} sharedMsgId sndMemberId_ RcvMessage {msgId} MsgMeta {broker = (_, brokerTs)} = do
|
||||
let msgMemberId = fromMaybe memberId sndMemberId_
|
||||
withStore' (\db -> runExceptT $ getGroupMemberCIBySharedMsgId db user groupId msgMemberId sharedMsgId) >>= \case
|
||||
Right ci@(CChatItem _ ChatItem {chatDir}) -> case chatDir of
|
||||
@@ -3545,8 +3548,8 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
|
||||
messageError "x.msg.del: message of another member with insufficient member permissions"
|
||||
| otherwise = a
|
||||
delete ci byGroupMember
|
||||
| groupFeatureAllowed SGFFullDelete gInfo = deleteGroupCI user gInfo ci False False byGroupMember
|
||||
| otherwise = markGroupCIDeleted user gInfo ci msgId False byGroupMember
|
||||
| groupFeatureAllowed SGFFullDelete gInfo = deleteGroupCI user gInfo ci False False byGroupMember brokerTs
|
||||
| otherwise = markGroupCIDeleted user gInfo ci msgId False byGroupMember brokerTs
|
||||
|
||||
-- TODO remove once XFile is discontinued
|
||||
processFileInvitation' :: Contact -> FileInvitation -> RcvMessage -> MsgMeta -> m ()
|
||||
@@ -4409,13 +4412,13 @@ deleteDirectCI user ct ci@(CChatItem msgDir deletedItem@ChatItem {file}) byUser
|
||||
withStore' $ \db -> deleteDirectChatItem db user ct ci
|
||||
pure $ CRChatItemDeleted user (AChatItem SCTDirect msgDir (DirectChat ct) deletedItem) Nothing byUser timed
|
||||
|
||||
deleteGroupCI :: ChatMonad m => User -> GroupInfo -> CChatItem 'CTGroup -> Bool -> Bool -> Maybe GroupMember -> m ChatResponse
|
||||
deleteGroupCI user gInfo ci@(CChatItem msgDir deletedItem@ChatItem {file}) byUser timed byGroupMember_ = do
|
||||
deleteGroupCI :: ChatMonad m => User -> GroupInfo -> CChatItem 'CTGroup -> Bool -> Bool -> Maybe GroupMember -> UTCTime -> m ChatResponse
|
||||
deleteGroupCI user gInfo ci@(CChatItem msgDir deletedItem@ChatItem {file}) byUser timed byGroupMember_ deletedTs = do
|
||||
deleteCIFile user file
|
||||
toCi <- withStore' $ \db ->
|
||||
case byGroupMember_ of
|
||||
Nothing -> deleteGroupChatItem db user gInfo ci $> Nothing
|
||||
Just m -> Just <$> updateGroupChatItemModerated db user gInfo ci m
|
||||
Just m -> Just <$> updateGroupChatItemModerated db user gInfo ci m deletedTs
|
||||
pure $ CRChatItemDeleted user (AChatItem SCTGroup msgDir (GroupChat gInfo) deletedItem) toCi byUser timed
|
||||
|
||||
deleteCIFile :: (ChatMonad m, MsgDirectionI d) => User -> Maybe (CIFile d) -> m ()
|
||||
@@ -4425,21 +4428,21 @@ deleteCIFile user file =
|
||||
fileAgentConnIds <- deleteFile' user fileInfo True
|
||||
deleteAgentConnectionsAsync user fileAgentConnIds
|
||||
|
||||
markDirectCIDeleted :: ChatMonad m => User -> Contact -> CChatItem 'CTDirect -> MessageId -> Bool -> m ChatResponse
|
||||
markDirectCIDeleted user ct@Contact {contactId} ci@(CChatItem _ ChatItem {file}) msgId byUser = do
|
||||
markDirectCIDeleted :: ChatMonad m => User -> Contact -> CChatItem 'CTDirect -> MessageId -> Bool -> UTCTime -> m ChatResponse
|
||||
markDirectCIDeleted user ct@Contact {contactId} ci@(CChatItem _ ChatItem {file}) msgId byUser deletedTs = do
|
||||
cancelCIFile user file
|
||||
toCi <- withStore $ \db -> do
|
||||
liftIO $ markDirectChatItemDeleted db user ct ci msgId
|
||||
liftIO $ markDirectChatItemDeleted db user ct ci msgId deletedTs
|
||||
getDirectChatItem db user contactId (cchatItemId ci)
|
||||
pure $ CRChatItemDeleted user (ctItem ci) (Just $ ctItem toCi) byUser False
|
||||
where
|
||||
ctItem (CChatItem msgDir ci') = AChatItem SCTDirect msgDir (DirectChat ct) ci'
|
||||
|
||||
markGroupCIDeleted :: ChatMonad m => User -> GroupInfo -> CChatItem 'CTGroup -> MessageId -> Bool -> Maybe GroupMember -> m ChatResponse
|
||||
markGroupCIDeleted user gInfo@GroupInfo {groupId} ci@(CChatItem _ ChatItem {file}) msgId byUser byGroupMember_ = do
|
||||
markGroupCIDeleted :: ChatMonad m => User -> GroupInfo -> CChatItem 'CTGroup -> MessageId -> Bool -> Maybe GroupMember -> UTCTime -> m ChatResponse
|
||||
markGroupCIDeleted user gInfo@GroupInfo {groupId} ci@(CChatItem _ ChatItem {file}) msgId byUser byGroupMember_ deletedTs = do
|
||||
cancelCIFile user file
|
||||
toCi <- withStore $ \db -> do
|
||||
liftIO $ markGroupChatItemDeleted db user gInfo ci msgId byGroupMember_
|
||||
liftIO $ markGroupChatItemDeleted db user gInfo ci msgId byGroupMember_ deletedTs
|
||||
getGroupChatItem db user groupId (cchatItemId ci)
|
||||
pure $ CRChatItemDeleted user (gItem ci) (Just $ gItem toCi) byUser False
|
||||
where
|
||||
|
||||
Reference in New Issue
Block a user