dandri/simplex-chat
1
0
Fork 0
mirror of https://github.com/simplex-chat/simplex-chat.git synced 2026-05-24 19:35:33 +00:00
Code Issues Packages Projects Releases Wiki Activity

core: add ttl to XMsgUpdate (#1581)

Browse Source
This commit is contained in:
JRoberts
2022-12-15 17:29:46 +04:00
committed by GitHub
parent 0e837ae392
commit aa264690ab
4 changed files with 42 additions and 40 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Simplex/Chat.hs
+30 -36
View File
@@ -346,7 +346,7 @@ processChatCommand = \case
Nothing -> pure Nothing
prepareMsg :: Maybe FileInvitation -> Maybe CITimed -> m (MsgContainer, Maybe (CIQuote 'CTDirect))
prepareMsg fileInvitation_ timed_ = case quotedItemId_ of
Nothing -> pure (MCSimple (extMsgContent mc fileInvitation_ $ ttl_ timed_), Nothing)
Nothing -> pure (MCSimple (extMsgContent mc fileInvitation_ $ ciTimedToTTL timed_), Nothing)
Just quotedItemId -> do
CChatItem _ qci@ChatItem {meta = CIMeta {itemTs, itemSharedMsgId}, formattedText, file} <-
withStore $ \db -> getDirectChatItem db userId chatId quotedItemId
@@ -354,7 +354,7 @@ processChatCommand = \case
let msgRef = MsgRef {msgId = itemSharedMsgId, sentAt = itemTs, sent, memberId = Nothing}
qmc = quoteContent origQmc file
quotedItem = CIQuote {chatDir = qd, itemId = Just quotedItemId, sharedMsgId = itemSharedMsgId, sentAt = itemTs, content = qmc, formattedText}
pure (MCQuote QuotedMsg {msgRef, content = qmc} (extMsgContent mc fileInvitation_ $ ttl_ timed_), Just quotedItem)
pure (MCQuote QuotedMsg {msgRef, content = qmc} (extMsgContent mc fileInvitation_ $ ciTimedToTTL timed_), Just quotedItem)
where
quoteData :: ChatItem c d -> m (MsgContent, CIQDirection 'CTDirect, Bool)
quoteData ChatItem {meta = CIMeta {itemDeleted = True}} = throwChatError CEInvalidQuote
@@ -407,7 +407,7 @@ processChatCommand = \case
_ -> pure ()
prepareMsg :: Maybe FileInvitation -> Maybe CITimed -> GroupMember -> m (MsgContainer, Maybe (CIQuote 'CTGroup))
prepareMsg fileInvitation_ timed_ membership = case quotedItemId_ of
Nothing -> pure (MCSimple (extMsgContent mc fileInvitation_ $ ttl_ timed_), Nothing)
Nothing -> pure (MCSimple (extMsgContent mc fileInvitation_ $ ciTimedToTTL timed_), Nothing)
Just quotedItemId -> do
CChatItem _ qci@ChatItem {meta = CIMeta {itemTs, itemSharedMsgId}, formattedText, file} <-
withStore $ \db -> getGroupChatItem db user chatId quotedItemId
@@ -415,7 +415,7 @@ processChatCommand = \case
let msgRef = MsgRef {msgId = itemSharedMsgId, sentAt = itemTs, sent, memberId = Just memberId}
qmc = quoteContent origQmc file
quotedItem = CIQuote {chatDir = qd, itemId = Just quotedItemId, sharedMsgId = itemSharedMsgId, sentAt = itemTs, content = qmc, formattedText}
pure (MCQuote QuotedMsg {msgRef, content = qmc} (extMsgContent mc fileInvitation_ $ ttl_ timed_), Just quotedItem)
pure (MCQuote QuotedMsg {msgRef, content = qmc} (extMsgContent mc fileInvitation_ $ ciTimedToTTL timed_), Just quotedItem)
where
quoteData :: ChatItem c d -> GroupMember -> m (MsgContent, CIQDirection 'CTGroup, Bool, GroupMember)
quoteData ChatItem {meta = CIMeta {itemDeleted = True}} _ = throwChatError CEInvalidQuote
@@ -425,8 +425,6 @@ processChatCommand = \case
CTContactRequest -> pure $ chatCmdError "not supported"
CTContactConnection -> pure $ chatCmdError "not supported"
where
ttl_ :: Maybe CITimed -> Maybe Int
ttl_ timed_ = timed_ >>= \CITimed {ttl} -> Just ttl
quoteContent :: forall d. MsgContent -> Maybe (CIFile d) -> MsgContent
quoteContent qmc ciFile_
| replaceContent = MCText qTextOrFile
@@ -457,10 +455,10 @@ processChatCommand = \case
(ct@Contact {contactId, localDisplayName = c}, ci) <- withStore $ \db -> (,) <$> getContact db user chatId <*> getDirectChatItem db userId chatId itemId
assertDirectAllowed user MDSnd ct XMsgUpdate_
case ci of
CChatItem SMDSnd ChatItem {meta = CIMeta {itemSharedMsgId}, content = ciContent} -> do
CChatItem SMDSnd ChatItem {meta = CIMeta {itemSharedMsgId, timed}, content = ciContent} -> do
case (ciContent, itemSharedMsgId) of
(CISndMsgContent _, Just itemSharedMId) -> do
(SndMessage {msgId}, _) <- sendDirectContactMessage ct (XMsgUpdate itemSharedMId mc Nothing)
(SndMessage {msgId}, _) <- sendDirectContactMessage ct (XMsgUpdate itemSharedMId mc (ciTimedToTTL timed) Nothing)
updCi <- withStore $ \db -> updateDirectChatItem db userId contactId itemId (CISndMsgContent mc) $ Just msgId
setActive $ ActiveC c
pure . CRChatItemUpdated $ AChatItem SCTDirect SMDSnd (DirectChat ct) updCi
@@ -471,10 +469,10 @@ processChatCommand = \case
unless (memberActive membership) $ throwChatError CEGroupMemberUserRemoved
ci <- withStore $ \db -> getGroupChatItem db user chatId itemId
case ci of
CChatItem SMDSnd ChatItem {meta = CIMeta {itemSharedMsgId}, content = ciContent} -> do
CChatItem SMDSnd ChatItem {meta = CIMeta {itemSharedMsgId, timed}, content = ciContent} -> do
case (ciContent, itemSharedMsgId) of
(CISndMsgContent _, Just itemSharedMId) -> do
SndMessage {msgId} <- sendGroupMessage gInfo ms (XMsgUpdate itemSharedMId mc Nothing)
SndMessage {msgId} <- sendGroupMessage gInfo ms (XMsgUpdate itemSharedMId mc (ciTimedToTTL timed) Nothing)
updCi <- withStore $ \db -> updateGroupChatItem db user groupId itemId (CISndMsgContent mc) msgId
setActive $ ActiveG gName
pure . CRChatItemUpdated $ AChatItem SCTGroup SMDSnd (GroupChat gInfo) updCi
@@ -1891,7 +1889,7 @@ processAgentMessage (Just user@User {userId}) corrId agentConnId agentMessage =
updateChatLock "directMessage" event
case event of
XMsgNew mc -> newContentMessage ct mc msg msgMeta
XMsgUpdate sharedMsgId mContent _ -> messageUpdate ct sharedMsgId mContent msg msgMeta
XMsgUpdate sharedMsgId mContent ttl _ -> messageUpdate ct sharedMsgId mContent ttl msg msgMeta
XMsgDel sharedMsgId -> messageDelete ct sharedMsgId msg msgMeta
-- TODO discontinue XFile
XFile fInv -> processFileInvitation' ct fInv msg msgMeta
@@ -2097,7 +2095,7 @@ processAgentMessage (Just user@User {userId}) corrId agentConnId agentMessage =
withAckMessage agentConnId cmdId msgMeta $
case event of
XMsgNew mc -> newGroupContentMessage gInfo m mc msg msgMeta
XMsgUpdate sharedMsgId mContent _ -> groupMessageUpdate gInfo m sharedMsgId mContent msg msgMeta
XMsgUpdate sharedMsgId mContent ttl _ -> groupMessageUpdate gInfo m sharedMsgId mContent ttl msg msgMeta
XMsgDel sharedMsgId -> groupMessageDelete gInfo m sharedMsgId msg
-- TODO discontinue XFile
XFile fInv -> processGroupFileInvitation' gInfo m fInv msg msgMeta
@@ -2404,22 +2402,21 @@ processAgentMessage (Just user@User {userId}) corrId agentConnId agentMessage =
let ExtMsgContent content fileInvitation_ _ _ = mcExtMsgContent mc
if isVoice content && not (featureAllowed SCFVoice forContact ct)
then do
void $ newChatItem (CIRcvChatFeatureRejected CFVoice) Nothing
void $ newChatItem (CIRcvChatFeatureRejected CFVoice) Nothing Nothing
setActive $ ActiveC c
else do
let ExtMsgContent _ _ itemTTL _ = mcExtMsgContent mc
timed_ = rcvMsgCITimed (contactCITimedTTL ct) itemTTL
ciFile_ <- processFileInvitation fileInvitation_ content $ \db -> createRcvFileTransfer db userId ct
ChatItem {formattedText} <- newChatItem (CIRcvMsgContent content) ciFile_
ChatItem {formattedText} <- newChatItem (CIRcvMsgContent content) ciFile_ timed_
when (enableNtfs chatSettings) $ do
showMsgToast (c <> "> ") content formattedText
setActive $ ActiveC c
where
newChatItem ciContent ciFile_ = do
ci <- saveRcvChatItemTimed user (CDDirectRcv ct) msg msgMeta ciContent ciFile_ timed
newChatItem ciContent ciFile_ timed_ = do
ci <- saveRcvChatItemTimed user (CDDirectRcv ct) msg msgMeta ciContent ciFile_ timed_
toView . CRNewChatItem $ AChatItem SCTDirect SMDRcv (DirectChat ct) ci
pure ci
timed = case (contactCITimedTTL ct, mcExtMsgContent mc) of
(Just _, ExtMsgContent _ _ (Just ttl) _) -> Just $ CITimed ttl Nothing
_ -> Nothing
processFileInvitation :: Maybe FileInvitation -> MsgContent -> (DB.Connection -> FileInvitation -> Maybe InlineFileMode -> Integer -> IO RcvFileTransfer) -> m (Maybe (CIFile 'MDRcv))
processFileInvitation fInv_ mc createRcvFT = forM fInv_ $ \fInv@FileInvitation {fileName, fileSize} -> do
@@ -2434,8 +2431,8 @@ processAgentMessage (Just user@User {userId}) corrId agentConnId agentMessage =
_ -> pure (Nothing, CIFSRcvInvitation)
pure CIFile {fileId, fileName, fileSize, filePath, fileStatus}
messageUpdate :: Contact -> SharedMsgId -> MsgContent -> RcvMessage -> MsgMeta -> m ()
messageUpdate ct@Contact {contactId, localDisplayName = c} sharedMsgId mc msg@RcvMessage {msgId} msgMeta = do
messageUpdate :: Contact -> SharedMsgId -> MsgContent -> Maybe Int -> RcvMessage -> MsgMeta -> m ()
messageUpdate ct@Contact {contactId, localDisplayName = c} sharedMsgId mc ttl msg@RcvMessage {msgId} msgMeta = do
checkIntegrityCreateItem (CDDirectRcv ct) msgMeta
updateRcvChatItem `catchError` \e ->
case e of
@@ -2443,11 +2440,10 @@ processAgentMessage (Just user@User {userId}) corrId agentConnId agentMessage =
-- This patches initial sharedMsgId into chat item when locally deleted chat item
-- received an update from the sender, so that it can be referenced later (e.g. by broadcast delete).
-- Chat item and update message which created it will have different sharedMsgId in this case...
ci <- saveRcvChatItem' user (CDDirectRcv ct) msg (Just sharedMsgId) msgMeta (CIRcvMsgContent mc) Nothing timed
let timed_ = rcvMsgCITimed (contactCITimedTTL ct) ttl
ci <- saveRcvChatItem' user (CDDirectRcv ct) msg (Just sharedMsgId) msgMeta (CIRcvMsgContent mc) Nothing timed_
toView . CRChatItemUpdated $ AChatItem SCTDirect SMDRcv (DirectChat ct) ci
setActive $ ActiveC c
where
timed = contactCITimedTTL ct >>= \ttl -> Just $ CITimed ttl Nothing
_ -> throwError e
where
updateRcvChatItem = do
@@ -2477,36 +2473,34 @@ processAgentMessage (Just user@User {userId}) corrId agentConnId agentMessage =
newGroupContentMessage gInfo@GroupInfo {chatSettings} m@GroupMember {localDisplayName = c} mc msg msgMeta = do
let (ExtMsgContent content fInv_ _ _) = mcExtMsgContent mc
if isVoice content && not (groupFeatureAllowed SGFVoice gInfo)
then void $ newChatItem (CIRcvGroupFeatureRejected GFVoice) Nothing
then void $ newChatItem (CIRcvGroupFeatureRejected GFVoice) Nothing Nothing
else do
let ExtMsgContent _ _ itemTTL _ = mcExtMsgContent mc
timed_ = rcvMsgCITimed (groupCITimedTTL gInfo) itemTTL
ciFile_ <- processFileInvitation fInv_ content $ \db -> createRcvGroupFileTransfer db userId m
ChatItem {formattedText} <- newChatItem (CIRcvMsgContent content) ciFile_
ChatItem {formattedText} <- newChatItem (CIRcvMsgContent content) ciFile_ timed_
let g = groupName' gInfo
when (enableNtfs chatSettings) $ do
showMsgToast ("#" <> g <> " " <> c <> "> ") content formattedText
setActive $ ActiveG g
where
newChatItem ciContent ciFile_ = do
ci <- saveRcvChatItemTimed user (CDGroupRcv gInfo m) msg msgMeta ciContent ciFile_ timed
newChatItem ciContent ciFile_ timed_ = do
ci <- saveRcvChatItemTimed user (CDGroupRcv gInfo m) msg msgMeta ciContent ciFile_ timed_
groupMsgToView gInfo m ci msgMeta
pure ci
timed = case (groupCITimedTTL gInfo, mcExtMsgContent mc) of
(Just _, ExtMsgContent _ _ (Just ttl) _) -> Just $ CITimed ttl Nothing
_ -> Nothing
groupMessageUpdate :: GroupInfo -> GroupMember -> SharedMsgId -> MsgContent -> RcvMessage -> MsgMeta -> m ()
groupMessageUpdate gInfo@GroupInfo {groupId, localDisplayName = g} m@GroupMember {groupMemberId, memberId} sharedMsgId mc msg@RcvMessage {msgId} msgMeta =
groupMessageUpdate :: GroupInfo -> GroupMember -> SharedMsgId -> MsgContent -> Maybe Int -> RcvMessage -> MsgMeta -> m ()
groupMessageUpdate gInfo@GroupInfo {groupId, localDisplayName = g} m@GroupMember {groupMemberId, memberId} sharedMsgId mc ttl msg@RcvMessage {msgId} msgMeta =
updateRcvChatItem `catchError` \e ->
case e of
(ChatErrorStore (SEChatItemSharedMsgIdNotFound _)) -> do
-- This patches initial sharedMsgId into chat item when locally deleted chat item
-- received an update from the sender, so that it can be referenced later (e.g. by broadcast delete).
-- Chat item and update message which created it will have different sharedMsgId in this case...
ci <- saveRcvChatItem' user (CDGroupRcv gInfo m) msg (Just sharedMsgId) msgMeta (CIRcvMsgContent mc) Nothing timed
let timed_ = rcvMsgCITimed (groupCITimedTTL gInfo) ttl
ci <- saveRcvChatItem' user (CDGroupRcv gInfo m) msg (Just sharedMsgId) msgMeta (CIRcvMsgContent mc) Nothing timed_
toView . CRChatItemUpdated $ AChatItem SCTGroup SMDRcv (GroupChat gInfo) ci
setActive $ ActiveG g
where
timed = groupCITimedTTL gInfo >>= \ttl -> Just $ CITimed ttl Nothing
_ -> throwError e
where
updateRcvChatItem = do
src/Simplex/Chat/Messages.hs
+8
View File
@@ -299,6 +299,9 @@ data CITimed = CITimed
instance ToJSON CITimed where toEncoding = J.genericToEncoding J.defaultOptions
ciTimedToTTL :: Maybe CITimed -> Maybe Int
ciTimedToTTL timed_ = timed_ >>= \CITimed {ttl} -> Just ttl
contactCITimedTTL :: Contact -> Maybe Int
contactCITimedTTL Contact {mergedPreferences = ContactUserPreferences {timedMessages = ContactUserPreference {enabled, userPreference}}}
| forUser enabled && forContact enabled = case userPreference of
@@ -311,6 +314,11 @@ groupCITimedTTL GroupInfo {fullGroupPreferences = FullGroupPreferences {timedMes
| enable == FEOn = Just ttl
| otherwise = Nothing
rcvMsgCITimed :: Maybe Int -> Maybe Int -> Maybe CITimed
rcvMsgCITimed chatTTL itemTTL = case (chatTTL, itemTTL) of
(Just _, Just ttl) -> Just $ CITimed ttl Nothing
_ -> Nothing
data CIQuote (c :: ChatType) = CIQuote
{ chatDir :: CIQDirection c,
itemId :: Maybe ChatItemId, -- Nothing in case MsgRef references the item the user did not receive yet
src/Simplex/Chat/Protocol.hs
+3 -3
View File
@@ -179,7 +179,7 @@ instance StrEncoding AChatMessage where
data ChatMsgEvent (e :: MsgEncoding) where
XMsgNew :: MsgContainer -> ChatMsgEvent 'Json
XMsgUpdate :: {msgId :: SharedMsgId, content :: MsgContent, live :: Maybe Bool} -> ChatMsgEvent 'Json
XMsgUpdate :: {msgId :: SharedMsgId, content :: MsgContent, ttl :: Maybe Int, live :: Maybe Bool} -> ChatMsgEvent 'Json
XMsgDel :: SharedMsgId -> ChatMsgEvent 'Json
XMsgDeleted :: ChatMsgEvent 'Json
XFile :: FileInvitation -> ChatMsgEvent 'Json -- TODO discontinue
@@ -638,7 +638,7 @@ appJsonToCM AppMessageJson {msgId, event, params} = do
msg :: CMEventTag 'Json -> Either String (ChatMsgEvent 'Json)
msg = \case
XMsgNew_ -> XMsgNew <$> JT.parseEither parseMsgContainer params
XMsgUpdate_ -> XMsgUpdate <$> p "msgId" <*> p "content" <*> opt "live"
XMsgUpdate_ -> XMsgUpdate <$> p "msgId" <*> p "content" <*> opt "ttl" <*> opt "live"
XMsgDel_ -> XMsgDel <$> p "msgId"
XMsgDeleted_ -> pure XMsgDeleted
XFile_ -> XFile <$> p "file"
@@ -691,7 +691,7 @@ chatToAppMessage ChatMessage {msgId, chatMsgEvent} = case encoding @e of
params :: ChatMsgEvent 'Json -> J.Object
params = \case
XMsgNew container -> msgContainerJSON container
XMsgUpdate msgId' content live -> o $ ("live" .=? live) ["msgId" .= msgId', "content" .= content]
XMsgUpdate msgId' content ttl live -> o $ ("ttl" .=? ttl) $ ("live" .=? live) ["msgId" .= msgId', "content" .= content]
XMsgDel msgId' -> o ["msgId" .= msgId']
XMsgDeleted -> JM.empty
XFile fileInv -> o ["file" .= fileInv]