From 6b8705e9f46551a5812e9c8e2124eebbb2bbd907 Mon Sep 17 00:00:00 2001 From: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com> Date: Fri, 16 Dec 2022 07:51:04 +0000 Subject: [PATCH] core: support for live messages (#1577) --- simplex-chat.cabal | 1 + src/Simplex/Chat.hs | 201 +++++++++--------- src/Simplex/Chat/Controller.hs | 4 +- src/Simplex/Chat/Messages.hs | 11 +- .../Chat/Migrations/M20221214_live_message.hs | 12 ++ src/Simplex/Chat/Migrations/chat_schema.sql | 3 +- src/Simplex/Chat/Protocol.hs | 8 +- src/Simplex/Chat/Store.hs | 90 ++++---- tests/ProtocolTests.hs | 21 +- 9 files changed, 188 insertions(+), 163 deletions(-) create mode 100644 src/Simplex/Chat/Migrations/M20221214_live_message.hs diff --git a/simplex-chat.cabal b/simplex-chat.cabal index 1d96aba2db..10a2b667ca 100644 --- a/simplex-chat.cabal +++ b/simplex-chat.cabal @@ -69,6 +69,7 @@ library Simplex.Chat.Migrations.M20221210_idxs Simplex.Chat.Migrations.M20221211_group_description Simplex.Chat.Migrations.M20221212_chat_items_timed + Simplex.Chat.Migrations.M20221214_live_message Simplex.Chat.Mobile Simplex.Chat.Options Simplex.Chat.ProfileGenerator diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs index ab6f843914..2f6fecdeed 100644 --- a/src/Simplex/Chat.hs +++ b/src/Simplex/Chat.hs @@ -297,7 +297,7 @@ processChatCommand = \case CTContactRequest -> pure $ chatCmdError "not implemented" CTContactConnection -> pure $ chatCmdError "not supported" APIGetChatItems _pagination -> pure $ chatCmdError "not implemented" - APISendMessage (ChatRef cType chatId) (ComposedMessage file_ quotedItemId_ mc) -> withUser $ \user@User {userId} -> withChatLock "sendMessage" $ case cType of + APISendMessage (ChatRef cType chatId) live (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 assertDirectAllowed user MDSnd ct XMsgNew_ @@ -313,7 +313,7 @@ processChatCommand = \case Just ft@FileTransferMeta {fileInline = Just IFMSent} -> sendDirectFileInline ct ft sharedMsgId _ -> pure () - ci <- saveSndChatItemTimed user (CDDirectSnd ct) msg (CISndMsgContent mc) ciFile_ quotedItem_ timed_ + ci <- saveSndChatItem' user (CDDirectSnd ct) msg (CISndMsgContent mc) ciFile_ quotedItem_ timed_ live case timed_ of Just CITimed {ttl, deleteAt = Just deleteAt} -> when (ttl <= cleanupManagerInterval) $ startTimedItemThread user (ChatRef CTDirect contactId, chatItemId' ci) deleteAt @@ -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_ $ ciTimedToTTL timed_), Nothing) + Nothing -> pure (MCSimple (ExtMsgContent mc fileInvitation_ (ciTimedToTTL timed_) (justTrue live)), 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_ $ ciTimedToTTL timed_), Just quotedItem) + pure (MCQuote QuotedMsg {msgRef, content = qmc} (ExtMsgContent mc fileInvitation_ (ciTimedToTTL timed_) (justTrue live)), Just quotedItem) where quoteData :: ChatItem c d -> m (MsgContent, CIQDirection 'CTDirect, Bool) quoteData ChatItem {meta = CIMeta {itemDeleted = True}} = throwChatError CEInvalidQuote @@ -372,7 +372,7 @@ processChatCommand = \case (msgContainer, quotedItem_) <- prepareMsg fileInvitation_ timed_ membership msg@SndMessage {sharedMsgId} <- sendGroupMessage gInfo ms (XMsgNew msgContainer) mapM_ (sendGroupFileInline ms sharedMsgId) ft_ - ci <- saveSndChatItemTimed user (CDGroupSnd gInfo) msg (CISndMsgContent mc) ciFile_ quotedItem_ timed_ + ci <- saveSndChatItem' user (CDGroupSnd gInfo) msg (CISndMsgContent mc) ciFile_ quotedItem_ timed_ live case timed_ of Just CITimed {ttl, deleteAt = Just deleteAt} -> when (ttl <= cleanupManagerInterval) $ startTimedItemThread user (ChatRef CTGroup groupId, chatItemId' ci) deleteAt @@ -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_ $ ciTimedToTTL timed_), Nothing) + Nothing -> pure (MCSimple (ExtMsgContent mc fileInvitation_ (ciTimedToTTL timed_) (justTrue live)), 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_ $ ciTimedToTTL timed_), Just quotedItem) + pure (MCQuote QuotedMsg {msgRef, content = qmc} (ExtMsgContent mc fileInvitation_ (ciTimedToTTL timed_) (justTrue live)), Just quotedItem) where quoteData :: ChatItem c d -> GroupMember -> m (MsgContent, CIQDirection 'CTGroup, Bool, GroupMember) quoteData ChatItem {meta = CIMeta {itemDeleted = True}} _ = throwChatError CEInvalidQuote @@ -450,16 +450,17 @@ processChatCommand = \case unzipMaybe3 :: Maybe (a, b, c) -> (Maybe a, Maybe b, Maybe c) unzipMaybe3 (Just (a, b, c)) = (Just a, Just b, Just c) unzipMaybe3 _ = (Nothing, Nothing, Nothing) - APIUpdateChatItem (ChatRef cType chatId) itemId mc -> withUser $ \user@User {userId} -> withChatLock "updateChatItem" $ case cType of + APIUpdateChatItem (ChatRef cType chatId) itemId live mc -> withUser $ \user@User {userId} -> withChatLock "updateChatItem" $ case cType of CTDirect -> do (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, timed}, content = ciContent} -> do + CChatItem SMDSnd ChatItem {meta = CIMeta {itemSharedMsgId, itemTimed, itemLive}, content = ciContent} -> do case (ciContent, itemSharedMsgId) of (CISndMsgContent _, Just itemSharedMId) -> do - (SndMessage {msgId}, _) <- sendDirectContactMessage ct (XMsgUpdate itemSharedMId mc (ciTimedToTTL timed) Nothing) - updCi <- withStore $ \db -> updateDirectChatItem db userId contactId itemId (CISndMsgContent mc) $ Just msgId + let live' = itemLive && live + (SndMessage {msgId}, _) <- sendDirectContactMessage ct (XMsgUpdate itemSharedMId mc (ciTimedToTTL itemTimed) (justTrue live')) + updCi <- withStore $ \db -> updateDirectChatItem db userId contactId itemId (CISndMsgContent mc) live' $ Just msgId setActive $ ActiveC c pure . CRChatItemUpdated $ AChatItem SCTDirect SMDSnd (DirectChat ct) updCi _ -> throwChatError CEInvalidChatItemUpdate @@ -469,11 +470,12 @@ processChatCommand = \case unless (memberActive membership) $ throwChatError CEGroupMemberUserRemoved ci <- withStore $ \db -> getGroupChatItem db user chatId itemId case ci of - CChatItem SMDSnd ChatItem {meta = CIMeta {itemSharedMsgId, timed}, content = ciContent} -> do + CChatItem SMDSnd ChatItem {meta = CIMeta {itemSharedMsgId, itemTimed, itemLive}, content = ciContent} -> do case (ciContent, itemSharedMsgId) of (CISndMsgContent _, Just itemSharedMId) -> do - SndMessage {msgId} <- sendGroupMessage gInfo ms (XMsgUpdate itemSharedMId mc (ciTimedToTTL timed) Nothing) - updCi <- withStore $ \db -> updateGroupChatItem db user groupId itemId (CISndMsgContent mc) msgId + let live' = itemLive && live + SndMessage {msgId} <- sendGroupMessage gInfo ms (XMsgUpdate itemSharedMId mc (ciTimedToTTL itemTimed) (justTrue live')) + updCi <- withStore $ \db -> updateGroupChatItem db user groupId itemId (CISndMsgContent mc) live' msgId setActive $ ActiveG gName pure . CRChatItemUpdated $ AChatItem SCTGroup SMDSnd (GroupChat gInfo) updCi _ -> throwChatError CEInvalidChatItemUpdate @@ -643,7 +645,7 @@ processChatCommand = \case let invitation = CallInvitation {callType, callDhPubKey = fst <$> dhKeyPair} callState = CallInvitationSent {localCallType = callType, localDhPrivKey = snd <$> dhKeyPair} (msg, _) <- sendDirectContactMessage ct (XCallInv callId invitation) - ci <- saveSndChatItem user (CDDirectSnd ct) msg (CISndCall CISCallPending 0) Nothing Nothing + ci <- saveSndChatItem user (CDDirectSnd ct) msg (CISndCall CISCallPending 0) let call' = Call {contactId, callId, chatItemId = chatItemId' ci, callState, callTs = chatItemTs' ci} call_ <- atomically $ TM.lookupInsert contactId call' calls forM_ call_ $ \call -> updateCallItemStatus userId ct call WCSDisconnected Nothing @@ -658,7 +660,7 @@ processChatCommand = \case CallInvitationReceived {} -> do let aciContent = ACIContent SMDRcv $ CIRcvCall CISCallRejected 0 withStore' $ \db -> updateDirectChatItemsRead db userId contactId $ Just (chatItemId, chatItemId) - updateDirectChatItemView userId ct chatItemId aciContent Nothing $> Nothing + updateDirectChatItemView userId ct chatItemId aciContent False Nothing $> Nothing _ -> throwChatError . CECallState $ callStateTag callState APISendCallOffer contactId WebRTCCallOffer {callType, rtcSession} -> -- party accepting call @@ -670,7 +672,7 @@ processChatCommand = \case aciContent = ACIContent SMDRcv $ CIRcvCall CISCallAccepted 0 (SndMessage {msgId}, _) <- sendDirectContactMessage ct (XCallOffer callId offer) withStore' $ \db -> updateDirectChatItemsRead db userId contactId $ Just (chatItemId, chatItemId) - updateDirectChatItemView userId ct chatItemId aciContent $ Just msgId + updateDirectChatItemView userId ct chatItemId aciContent False $ Just msgId pure $ Just call {callState = callState'} _ -> throwChatError . CECallState $ callStateTag callState APISendCallAnswer contactId rtcSession -> @@ -680,7 +682,7 @@ processChatCommand = \case let callState' = CallNegotiated {localCallType, peerCallType, localCallSession = rtcSession, peerCallSession, sharedKey} aciContent = ACIContent SMDSnd $ CISndCall CISCallNegotiated 0 (SndMessage {msgId}, _) <- sendDirectContactMessage ct (XCallAnswer callId CallAnswer {rtcSession}) - updateDirectChatItemView userId ct chatItemId aciContent $ Just msgId + updateDirectChatItemView userId ct chatItemId aciContent False $ Just msgId pure $ Just call {callState = callState'} _ -> throwChatError . CECallState $ callStateTag callState APISendCallExtraInfo contactId rtcExtraInfo -> @@ -908,7 +910,7 @@ processChatCommand = \case SendMessage chatName msg -> withUser $ \user -> do chatRef <- getChatRef user chatName let mc = MCText $ safeDecodeUtf8 msg - processChatCommand . APISendMessage chatRef $ ComposedMessage Nothing Nothing mc + processChatCommand . APISendMessage chatRef False $ ComposedMessage Nothing Nothing mc SendMessageBroadcast msg -> withUser $ \user -> do contacts <- withStore' (`getUserContacts` user) withChatLock "sendMessageBroadcast" . procCmd $ do @@ -917,8 +919,8 @@ processChatCommand = \case forM_ cts $ \ct -> void ( do - (sndMsg, _) <- sendDirectContactMessage ct (XMsgNew $ MCSimple (extMsgContent mc Nothing Nothing)) - saveSndChatItem user (CDDirectSnd ct) sndMsg (CISndMsgContent mc) Nothing Nothing + (sndMsg, _) <- sendDirectContactMessage ct (XMsgNew $ MCSimple (extMsgContent mc Nothing)) + saveSndChatItem user (CDDirectSnd ct) sndMsg (CISndMsgContent mc) ) `catchError` (toView . CRChatError) CRBroadcastSent mc (length cts) <$> liftIO getZonedTime @@ -926,7 +928,7 @@ processChatCommand = \case contactId <- withStore $ \db -> getContactIdByName db user cName quotedItemId <- withStore $ \db -> getDirectChatItemIdByText db userId contactId msgDir (safeDecodeUtf8 quotedMsg) let mc = MCText $ safeDecodeUtf8 msg - processChatCommand . APISendMessage (ChatRef CTDirect contactId) $ ComposedMessage Nothing (Just quotedItemId) mc + processChatCommand . APISendMessage (ChatRef CTDirect contactId) False $ ComposedMessage Nothing (Just quotedItemId) mc DeleteMessage chatName deletedMsg -> withUser $ \user -> do chatRef <- getChatRef user chatName deletedItemId <- getSentChatItemIdByText user chatRef deletedMsg @@ -935,7 +937,7 @@ processChatCommand = \case chatRef <- getChatRef user chatName editedItemId <- getSentChatItemIdByText user chatRef editedMsg let mc = MCText $ safeDecodeUtf8 msg - processChatCommand $ APIUpdateChatItem chatRef editedItemId mc + processChatCommand $ APIUpdateChatItem chatRef editedItemId False mc NewGroup gProfile -> withUser $ \user -> do gVar <- asks idsDrg groupInfo <- withStore (\db -> createNewGroup db gVar user gProfile) @@ -985,7 +987,7 @@ processChatCommand = \case case (cInfo, content) of (DirectChat ct, CIRcvGroupInvitation ciGroupInv memRole) -> do let aciContent = ACIContent SMDRcv $ CIRcvGroupInvitation ciGroupInv {status = CIGISAccepted} memRole - updateDirectChatItemView userId ct itemId aciContent Nothing + updateDirectChatItemView userId ct itemId aciContent False Nothing _ -> pure () -- prohibited APIMemberRole groupId memberId memRole -> withUser $ \user -> do Group gInfo@GroupInfo {membership} members <- withStore $ \db -> getGroup db user groupId @@ -1010,7 +1012,7 @@ processChatCommand = \case _ -> throwChatError $ CEGroupCantResendInvitation gInfo cName _ -> do msg <- sendGroupMessage gInfo members $ XGrpMemRole mId memRole - ci <- saveSndChatItem user (CDGroupSnd gInfo) msg (CISndGroupEvent gEvent) Nothing Nothing + ci <- saveSndChatItem user (CDGroupSnd gInfo) msg (CISndGroupEvent gEvent) toView . CRNewChatItem $ AChatItem SCTGroup SMDSnd (GroupChat gInfo) ci pure CRMemberRoleUser {groupInfo = gInfo, member = m {memberRole = memRole}, fromRole = mRole, toRole = memRole} APIRemoveMember groupId memberId -> withUser $ \user -> do @@ -1028,7 +1030,7 @@ processChatCommand = \case withStore' $ \db -> deleteGroupMember db user m _ -> do msg <- sendGroupMessage gInfo members $ XGrpMemDel mId - ci <- saveSndChatItem user (CDGroupSnd gInfo) msg (CISndGroupEvent $ SGEMemberDeleted memberId (fromLocalProfile memberProfile)) Nothing Nothing + ci <- saveSndChatItem user (CDGroupSnd gInfo) msg (CISndGroupEvent $ SGEMemberDeleted memberId (fromLocalProfile memberProfile)) toView . CRNewChatItem $ AChatItem SCTGroup SMDSnd (GroupChat gInfo) ci deleteMemberConnection user m -- undeleted "member connected" chat item will prevent deletion of member record @@ -1038,7 +1040,7 @@ processChatCommand = \case Group gInfo@GroupInfo {membership} members <- withStore $ \db -> getGroup db user groupId withChatLock "leaveGroup" . procCmd $ do msg <- sendGroupMessage gInfo members XGrpLeave - ci <- saveSndChatItem user (CDGroupSnd gInfo) msg (CISndGroupEvent SGEUserLeft) Nothing Nothing + ci <- saveSndChatItem user (CDGroupSnd gInfo) msg (CISndGroupEvent SGEUserLeft) toView . CRNewChatItem $ AChatItem SCTGroup SMDSnd (GroupChat gInfo) ci -- TODO delete direct connections that were unused deleteGroupLink' user gInfo `catchError` \_ -> pure () @@ -1107,7 +1109,7 @@ processChatCommand = \case groupId <- withStore $ \db -> getGroupIdByName db user gName quotedItemId <- withStore $ \db -> getGroupChatItemIdByText db user groupId cName (safeDecodeUtf8 quotedMsg) let mc = MCText $ safeDecodeUtf8 msg - processChatCommand . APISendMessage (ChatRef CTGroup groupId) $ ComposedMessage Nothing (Just quotedItemId) mc + processChatCommand . APISendMessage (ChatRef CTGroup groupId) False $ ComposedMessage Nothing (Just quotedItemId) mc LastMessages (Just chatName) count search -> withUser $ \user -> do chatRef <- getChatRef user chatName CRLastMessages . aChatItems . chat <$> processChatCommand (APIGetChat chatRef (CPLast count) search) @@ -1115,14 +1117,14 @@ processChatCommand = \case CRLastMessages <$> getAllChatItems db user (CPLast count) search SendFile chatName f -> withUser $ \user -> do chatRef <- getChatRef user chatName - processChatCommand . APISendMessage chatRef $ ComposedMessage (Just f) Nothing (MCFile "") + processChatCommand . APISendMessage chatRef False $ ComposedMessage (Just f) Nothing (MCFile "") SendImage chatName f -> withUser $ \user -> do chatRef <- getChatRef user chatName filePath <- toFSFilePath f unless (".jpg" `isSuffixOf` f || ".jpeg" `isSuffixOf` f) $ throwChatError CEFileImageType {filePath} fileSize <- getFileSize filePath unless (fileSize <= maxImageSize) $ throwChatError CEFileImageSize {filePath} - processChatCommand . APISendMessage chatRef $ ComposedMessage (Just f) Nothing (MCImage "" fixedImagePreview) + processChatCommand . APISendMessage chatRef False $ ComposedMessage (Just f) Nothing (MCImage "" fixedImagePreview) ForwardFile chatName fileId -> forwardFile chatName fileId SendFile ForwardImage chatName fileId -> forwardFile chatName fileId SendImage ReceiveFile fileId rcvInline_ filePath_ -> withUser $ \user -> @@ -1310,7 +1312,7 @@ processChatCommand = \case msg <- sendGroupMessage g' ms (XGrpInfo p') let cd = CDGroupSnd g' unless (sameGroupProfileInfo p p') $ do - ci <- saveSndChatItem user cd msg (CISndGroupEvent $ SGEGroupUpdated p') Nothing Nothing + ci <- saveSndChatItem user cd msg (CISndGroupEvent $ SGEGroupUpdated p') toView . CRNewChatItem $ AChatItem SCTGroup SMDSnd (GroupChat g') ci createGroupFeatureChangedItems user cd CISndGroupFeature p p' pure $ CRGroupUpdated g g' Nothing @@ -1362,7 +1364,7 @@ processChatCommand = \case groupInv = GroupInvitation (MemberIdRole userMemberId userRole) (MemberIdRole memberId memRole) cReq groupProfile Nothing (msg, _) <- sendDirectContactMessage ct $ XGrpInv groupInv let content = CISndGroupInvitation (CIGroupInvitation {groupId, groupMemberId, localDisplayName, groupProfile, status = CIGISPending}) memRole - ci <- saveSndChatItem user (CDDirectSnd ct) msg content Nothing Nothing + ci <- saveSndChatItem user (CDDirectSnd ct) msg content toView . CRNewChatItem $ AChatItem SCTDirect SMDSnd (DirectChat ct) ci setActive $ ActiveG localDisplayName @@ -1411,11 +1413,11 @@ deleteFile user CIFileInfo {filePath, fileId, fileStatus} = updateCallItemStatus :: ChatMonad m => UserId -> Contact -> Call -> WebRTCCallStatus -> Maybe MessageId -> m () updateCallItemStatus userId ct Call {chatItemId} receivedStatus msgId_ = do aciContent_ <- callStatusItemContent userId ct chatItemId receivedStatus - forM_ aciContent_ $ \aciContent -> updateDirectChatItemView userId ct chatItemId aciContent msgId_ + forM_ aciContent_ $ \aciContent -> updateDirectChatItemView userId ct chatItemId aciContent False msgId_ -updateDirectChatItemView :: ChatMonad m => UserId -> Contact -> ChatItemId -> ACIContent -> Maybe MessageId -> m () -updateDirectChatItemView userId ct@Contact {contactId} chatItemId (ACIContent msgDir ciContent) msgId_ = do - updCi <- withStore $ \db -> updateDirectChatItem db userId contactId chatItemId ciContent msgId_ +updateDirectChatItemView :: ChatMonad m => UserId -> Contact -> ChatItemId -> ACIContent -> Bool -> Maybe MessageId -> m () +updateDirectChatItemView userId ct@Contact {contactId} chatItemId (ACIContent msgDir ciContent) itemLive msgId_ = do + updCi <- withStore $ \db -> updateDirectChatItem db userId contactId chatItemId ciContent itemLive msgId_ toView . CRChatItemUpdated $ AChatItem SCTDirect msgDir (DirectChat ct) updCi callStatusItemContent :: ChatMonad m => UserId -> Contact -> ChatItemId -> WebRTCCallStatus -> m (Maybe ACIContent) @@ -1889,7 +1891,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 ttl _ -> messageUpdate ct sharedMsgId mContent ttl msg msgMeta + XMsgUpdate sharedMsgId mContent ttl live -> messageUpdate ct sharedMsgId mContent msg msgMeta ttl live XMsgDel sharedMsgId -> messageDelete ct sharedMsgId msg msgMeta -- TODO discontinue XFile XFile fInv -> processFileInvitation' ct fInv msg msgMeta @@ -1943,8 +1945,8 @@ processAgentMessage (Just user@User {userId}) corrId agentConnId agentMessage = withStore' (\db -> getUserContactLinkById db userId userContactLinkId) >>= \case Just (UserContactLink {autoAccept = Just AutoAccept {autoReply = mc_}}, groupId_) -> do forM_ mc_ $ \mc -> do - (msg, _) <- sendDirectContactMessage ct (XMsgNew $ MCSimple (extMsgContent mc Nothing Nothing)) - ci <- saveSndChatItem user (CDDirectSnd ct) msg (CISndMsgContent mc) Nothing Nothing + (msg, _) <- sendDirectContactMessage ct (XMsgNew $ MCSimple (extMsgContent mc Nothing)) + ci <- saveSndChatItem user (CDDirectSnd ct) msg (CISndMsgContent mc) toView . CRNewChatItem $ AChatItem SCTDirect SMDSnd (DirectChat ct) ci forM_ groupId_ $ \groupId -> do gVar <- asks idsDrg @@ -2095,7 +2097,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 ttl _ -> groupMessageUpdate gInfo m sharedMsgId mContent ttl msg msgMeta + XMsgUpdate sharedMsgId mContent ttl live -> groupMessageUpdate gInfo m sharedMsgId mContent msg msgMeta ttl live XMsgDel sharedMsgId -> groupMessageDelete gInfo m sharedMsgId msg -- TODO discontinue XFile XFile fInv -> processGroupFileInvitation' gInfo m fInv msg msgMeta @@ -2396,25 +2398,26 @@ processAgentMessage (Just user@User {userId}) corrId agentConnId agentMessage = messageError = toView . CRMessageError "error" newContentMessage :: Contact -> MsgContainer -> RcvMessage -> MsgMeta -> m () - newContentMessage ct@Contact {localDisplayName = c, contactUsed, chatSettings} mc msg msgMeta = do + newContentMessage ct@Contact {localDisplayName = c, contactUsed, chatSettings} mc msg@RcvMessage {sharedMsgId_} msgMeta = do unless contactUsed $ withStore' $ \db -> updateContactUsed db user ct checkIntegrityCreateItem (CDDirectRcv ct) msgMeta let ExtMsgContent content fileInvitation_ _ _ = mcExtMsgContent mc if isVoice content && not (featureAllowed SCFVoice forContact ct) then do - void $ newChatItem (CIRcvChatFeatureRejected CFVoice) Nothing Nothing + void $ newChatItem (CIRcvChatFeatureRejected CFVoice) Nothing Nothing False setActive $ ActiveC c else do - let ExtMsgContent _ _ itemTTL _ = mcExtMsgContent mc + let ExtMsgContent _ _ itemTTL live_ = mcExtMsgContent mc timed_ = rcvMsgCITimed (contactCITimedTTL ct) itemTTL + live = fromMaybe False live_ ciFile_ <- processFileInvitation fileInvitation_ content $ \db -> createRcvFileTransfer db userId ct - ChatItem {formattedText} <- newChatItem (CIRcvMsgContent content) ciFile_ timed_ + ChatItem {formattedText} <- newChatItem (CIRcvMsgContent content) ciFile_ timed_ live when (enableNtfs chatSettings) $ do showMsgToast (c <> "> ") content formattedText setActive $ ActiveC c where - newChatItem ciContent ciFile_ timed_ = do - ci <- saveRcvChatItemTimed user (CDDirectRcv ct) msg msgMeta ciContent ciFile_ timed_ + newChatItem ciContent ciFile_ timed_ live = do + ci <- saveRcvChatItem' user (CDDirectRcv ct) msg sharedMsgId_ msgMeta ciContent ciFile_ timed_ live toView . CRNewChatItem $ AChatItem SCTDirect SMDRcv (DirectChat ct) ci pure ci @@ -2431,8 +2434,8 @@ processAgentMessage (Just user@User {userId}) corrId agentConnId agentMessage = _ -> pure (Nothing, CIFSRcvInvitation) pure CIFile {fileId, fileName, fileSize, filePath, fileStatus} - messageUpdate :: Contact -> SharedMsgId -> MsgContent -> Maybe Int -> RcvMessage -> MsgMeta -> m () - messageUpdate ct@Contact {contactId, localDisplayName = c} sharedMsgId mc ttl msg@RcvMessage {msgId} msgMeta = do + messageUpdate :: Contact -> SharedMsgId -> MsgContent -> RcvMessage -> MsgMeta -> Maybe Int -> Maybe Bool -> m () + messageUpdate ct@Contact {contactId, localDisplayName = c} sharedMsgId mc msg@RcvMessage {msgId} msgMeta ttl live_ = do checkIntegrityCreateItem (CDDirectRcv ct) msgMeta updateRcvChatItem `catchError` \e -> case e of @@ -2441,15 +2444,16 @@ processAgentMessage (Just user@User {userId}) corrId agentConnId agentMessage = -- 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... let timed_ = rcvMsgCITimed (contactCITimedTTL ct) ttl - ci <- saveRcvChatItem' user (CDDirectRcv ct) msg (Just sharedMsgId) msgMeta (CIRcvMsgContent mc) Nothing timed_ + ci <- saveRcvChatItem' user (CDDirectRcv ct) msg (Just sharedMsgId) msgMeta (CIRcvMsgContent mc) Nothing timed_ live toView . CRChatItemUpdated $ AChatItem SCTDirect SMDRcv (DirectChat ct) ci setActive $ ActiveC c _ -> throwError e where + live = fromMaybe False live_ updateRcvChatItem = do - CChatItem msgDir ChatItem {meta = CIMeta {itemId}} <- withStore $ \db -> getDirectChatItemBySharedMsgId db userId contactId sharedMsgId + CChatItem msgDir ChatItem {meta = CIMeta {itemId, itemLive}} <- withStore $ \db -> getDirectChatItemBySharedMsgId db userId contactId sharedMsgId case msgDir of - SMDRcv -> updateDirectChatItemView userId ct itemId (ACIContent SMDRcv $ CIRcvMsgContent mc) $ Just msgId + SMDRcv -> updateDirectChatItemView userId ct itemId (ACIContent SMDRcv $ CIRcvMsgContent mc) (live && itemLive) $ Just msgId SMDSnd -> messageError "x.msg.update: contact attempted invalid message update" messageDelete :: Contact -> SharedMsgId -> RcvMessage -> MsgMeta -> m () @@ -2470,46 +2474,48 @@ processAgentMessage (Just user@User {userId}) corrId agentConnId agentMessage = SMDSnd -> messageError "x.msg.del: contact attempted invalid message delete" newGroupContentMessage :: GroupInfo -> GroupMember -> MsgContainer -> RcvMessage -> MsgMeta -> m () - newGroupContentMessage gInfo@GroupInfo {chatSettings} m@GroupMember {localDisplayName = c} mc msg msgMeta = do + newGroupContentMessage gInfo@GroupInfo {chatSettings} m@GroupMember {localDisplayName = c} mc msg@RcvMessage {sharedMsgId_} msgMeta = do let (ExtMsgContent content fInv_ _ _) = mcExtMsgContent mc if isVoice content && not (groupFeatureAllowed SGFVoice gInfo) - then void $ newChatItem (CIRcvGroupFeatureRejected GFVoice) Nothing Nothing + then void $ newChatItem (CIRcvGroupFeatureRejected GFVoice) Nothing Nothing False else do - let ExtMsgContent _ _ itemTTL _ = mcExtMsgContent mc + let ExtMsgContent _ _ itemTTL live_ = mcExtMsgContent mc timed_ = rcvMsgCITimed (groupCITimedTTL gInfo) itemTTL + live = fromMaybe False live_ ciFile_ <- processFileInvitation fInv_ content $ \db -> createRcvGroupFileTransfer db userId m - ChatItem {formattedText} <- newChatItem (CIRcvMsgContent content) ciFile_ timed_ + ChatItem {formattedText} <- newChatItem (CIRcvMsgContent content) ciFile_ timed_ live let g = groupName' gInfo when (enableNtfs chatSettings) $ do showMsgToast ("#" <> g <> " " <> c <> "> ") content formattedText setActive $ ActiveG g where - newChatItem ciContent ciFile_ timed_ = do - ci <- saveRcvChatItemTimed user (CDGroupRcv gInfo m) msg msgMeta ciContent ciFile_ timed_ + newChatItem ciContent ciFile_ timed_ live = do + ci <- saveRcvChatItem' user (CDGroupRcv gInfo m) msg sharedMsgId_ msgMeta ciContent ciFile_ timed_ live groupMsgToView gInfo m ci msgMeta pure ci - 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 = + groupMessageUpdate :: GroupInfo -> GroupMember -> SharedMsgId -> MsgContent -> RcvMessage -> MsgMeta -> Maybe Int -> Maybe Bool -> m () + groupMessageUpdate gInfo@GroupInfo {groupId, localDisplayName = g} m@GroupMember {groupMemberId, memberId} sharedMsgId mc msg@RcvMessage {msgId} msgMeta ttl_ live_ = 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... - let timed_ = rcvMsgCITimed (groupCITimedTTL gInfo) ttl - 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_ live toView . CRChatItemUpdated $ AChatItem SCTGroup SMDRcv (GroupChat gInfo) ci setActive $ ActiveG g _ -> throwError e where + live = fromMaybe False live_ updateRcvChatItem = do - CChatItem msgDir ChatItem {chatDir, meta = CIMeta {itemId}} <- withStore $ \db -> getGroupChatItemBySharedMsgId db user groupId groupMemberId sharedMsgId + CChatItem msgDir ChatItem {chatDir, meta = CIMeta {itemId, itemLive}} <- withStore $ \db -> getGroupChatItemBySharedMsgId db user groupId groupMemberId sharedMsgId case (msgDir, chatDir) of (SMDRcv, CIGroupRcv m') -> if sameMemberId memberId m' then do - updCi <- withStore $ \db -> updateGroupChatItem db user groupId itemId (CIRcvMsgContent mc) msgId + updCi <- withStore $ \db -> updateGroupChatItem db user groupId itemId (CIRcvMsgContent mc) (live && itemLive) msgId toView . CRChatItemUpdated $ AChatItem SCTGroup SMDRcv (GroupChat gInfo) updCi setActive $ ActiveG g else messageError "x.msg.update: group member attempted to update a message of another member" -- shouldn't happen now that query includes group member id @@ -2530,25 +2536,25 @@ processAgentMessage (Just user@User {userId}) corrId agentConnId agentMessage = -- TODO remove once XFile is discontinued processFileInvitation' :: Contact -> FileInvitation -> RcvMessage -> MsgMeta -> m () - processFileInvitation' ct@Contact {localDisplayName = c} fInv@FileInvitation {fileName, fileSize} msg msgMeta = do + processFileInvitation' ct@Contact {localDisplayName = c} fInv@FileInvitation {fileName, fileSize} msg@RcvMessage {sharedMsgId_} msgMeta = do checkIntegrityCreateItem (CDDirectRcv ct) msgMeta chSize <- asks $ fileChunkSize . config inline <- receiveInlineMode fInv Nothing chSize RcvFileTransfer {fileId} <- withStore' $ \db -> createRcvFileTransfer db userId ct fInv inline chSize let ciFile = Just $ CIFile {fileId, fileName, fileSize, filePath = Nothing, fileStatus = CIFSRcvInvitation} - ci <- saveRcvChatItem user (CDDirectRcv ct) msg msgMeta (CIRcvMsgContent $ MCFile "") ciFile + ci <- saveRcvChatItem' user (CDDirectRcv ct) msg sharedMsgId_ msgMeta (CIRcvMsgContent $ MCFile "") ciFile Nothing False toView . CRNewChatItem $ AChatItem SCTDirect SMDRcv (DirectChat ct) ci showToast (c <> "> ") "wants to send a file" setActive $ ActiveC c -- TODO remove once XFile is discontinued processGroupFileInvitation' :: GroupInfo -> GroupMember -> FileInvitation -> RcvMessage -> MsgMeta -> m () - processGroupFileInvitation' gInfo m@GroupMember {localDisplayName = c} fInv@FileInvitation {fileName, fileSize} msg msgMeta = do + processGroupFileInvitation' gInfo m@GroupMember {localDisplayName = c} fInv@FileInvitation {fileName, fileSize} msg@RcvMessage {sharedMsgId_} msgMeta = do chSize <- asks $ fileChunkSize . config inline <- receiveInlineMode fInv Nothing chSize RcvFileTransfer {fileId} <- withStore' $ \db -> createRcvGroupFileTransfer db userId m fInv inline chSize let ciFile = Just $ CIFile {fileId, fileName, fileSize, filePath = Nothing, fileStatus = CIFSRcvInvitation} - ci <- saveRcvChatItem user (CDGroupRcv gInfo m) msg msgMeta (CIRcvMsgContent $ MCFile "") ciFile + ci <- saveRcvChatItem' user (CDGroupRcv gInfo m) msg sharedMsgId_ msgMeta (CIRcvMsgContent $ MCFile "") ciFile Nothing False groupMsgToView gInfo m ci msgMeta let g = groupName' gInfo showToast ("#" <> g <> " " <> c <> "> ") "wants to send a file" @@ -2699,7 +2705,7 @@ processAgentMessage (Just user@User {userId}) corrId agentConnId agentMessage = toView $ CRUserAcceptedGroupSent gInfo {membership = membership {memberStatus = GSMemAccepted}} (Just ct) else do let content = CIRcvGroupInvitation (CIGroupInvitation {groupId, groupMemberId, localDisplayName, groupProfile, status = CIGISPending}) memRole - ci <- saveRcvChatItem user (CDDirectRcv ct) msg msgMeta content Nothing + ci <- saveRcvChatItem user (CDDirectRcv ct) msg msgMeta content withStore' $ \db -> setGroupInvitationChatItemId db user groupId (chatItemId' ci) toView . CRNewChatItem $ AChatItem SCTDirect SMDRcv (DirectChat ct) ci toView $ CRReceivedGroupInvitation gInfo ct memRole @@ -2784,7 +2790,7 @@ processAgentMessage (Just user@User {userId}) corrId agentConnId agentMessage = toView . CRCallInvitation $ RcvCallInvitation {contact = ct, callType, sharedKey, callTs = chatItemTs' ci} toView . CRNewChatItem $ AChatItem SCTDirect SMDRcv (DirectChat ct) ci where - saveCallItem status = saveRcvChatItem user (CDDirectRcv ct) msg msgMeta (CIRcvCall status 0) Nothing + saveCallItem status = saveRcvChatItem user (CDDirectRcv ct) msg msgMeta (CIRcvCall status 0) -- to party initiating call xCallOffer :: Contact -> CallId -> CallOffer -> RcvMessage -> MsgMeta -> m () @@ -2858,7 +2864,7 @@ processAgentMessage (Just user@User {userId}) corrId agentConnId agentMessage = withStore' $ \db -> deleteCalls db user ctId' atomically $ TM.delete ctId' calls forM_ aciContent_ $ \aciContent -> - updateDirectChatItemView userId ct chatItemId aciContent $ Just msgId + updateDirectChatItemView userId ct chatItemId aciContent False $ Just msgId msgCallStateError :: Text -> Call -> m () msgCallStateError eventName Call {callState} = @@ -2888,7 +2894,7 @@ processAgentMessage (Just user@User {userId}) corrId agentConnId agentMessage = then messageError "x.grp.mem.new error: member already exists" else do newMember@GroupMember {groupMemberId} <- withStore $ \db -> createNewGroupMember db user gInfo memInfo GCPostMember GSMemAnnounced - ci <- saveRcvChatItem user (CDGroupRcv gInfo m) msg msgMeta (CIRcvGroupEvent $ RGEMemberAdded groupMemberId memberProfile) Nothing + ci <- saveRcvChatItem user (CDGroupRcv gInfo m) msg msgMeta (CIRcvGroupEvent $ RGEMemberAdded groupMemberId memberProfile) groupMsgToView gInfo m ci msgMeta toView $ CRJoinedGroupMemberConnecting gInfo m newMember @@ -2964,7 +2970,7 @@ processAgentMessage (Just user@User {userId}) corrId agentConnId agentMessage = | senderRole < GRAdmin || senderRole < fromRole = messageError "x.grp.mem.role with insufficient member permissions" | otherwise = do withStore' $ \db -> updateGroupMemberRole db user member memRole - ci <- saveRcvChatItem user (CDGroupRcv gInfo m) msg msgMeta (CIRcvGroupEvent gEvent) Nothing + ci <- saveRcvChatItem user (CDGroupRcv gInfo m) msg msgMeta (CIRcvGroupEvent gEvent) groupMsgToView gInfo m ci msgMeta toView CRMemberRole {groupInfo = gInfo', byMember = m, member = member {memberRole = memRole}, fromRole, toRole = memRole} @@ -2998,7 +3004,7 @@ processAgentMessage (Just user@User {userId}) corrId agentConnId agentMessage = messageError "x.grp.mem.del with insufficient member permissions" | otherwise = a deleteMemberItem gEvent = do - ci <- saveRcvChatItem user (CDGroupRcv gInfo m) msg msgMeta (CIRcvGroupEvent gEvent) Nothing + ci <- saveRcvChatItem user (CDGroupRcv gInfo m) msg msgMeta (CIRcvGroupEvent gEvent) groupMsgToView gInfo m ci msgMeta sameMemberId :: MemberId -> GroupMember -> Bool @@ -3009,7 +3015,7 @@ processAgentMessage (Just user@User {userId}) corrId agentConnId agentMessage = deleteMemberConnection user m -- member record is not deleted to allow creation of "member left" chat item withStore' $ \db -> updateGroupMemberStatus db userId m GSMemLeft - ci <- saveRcvChatItem user (CDGroupRcv gInfo m) msg msgMeta (CIRcvGroupEvent RGEMemberLeft) Nothing + ci <- saveRcvChatItem user (CDGroupRcv gInfo m) msg msgMeta (CIRcvGroupEvent RGEMemberLeft) groupMsgToView gInfo m ci msgMeta toView $ CRLeftMember gInfo m {memberStatus = GSMemLeft} @@ -3022,7 +3028,7 @@ processAgentMessage (Just user@User {userId}) corrId agentConnId agentMessage = pure members -- member records are not deleted to keep history forM_ ms $ deleteMemberConnection user - ci <- saveRcvChatItem user (CDGroupRcv gInfo m) msg msgMeta (CIRcvGroupEvent RGEGroupDeleted) Nothing + ci <- saveRcvChatItem user (CDGroupRcv gInfo m) msg msgMeta (CIRcvGroupEvent RGEGroupDeleted) groupMsgToView gInfo m ci msgMeta toView $ CRGroupDeleted gInfo {membership = membership {memberStatus = GSMemGroupDeleted}} m @@ -3034,7 +3040,7 @@ processAgentMessage (Just user@User {userId}) corrId agentConnId agentMessage = toView . CRGroupUpdated g g' $ Just m let cd = CDGroupRcv g' m unless (sameGroupProfileInfo p p') $ do - ci <- saveRcvChatItem user cd msg msgMeta (CIRcvGroupEvent $ RGEGroupUpdated p') Nothing + ci <- saveRcvChatItem user cd msg msgMeta (CIRcvGroupEvent $ RGEGroupUpdated p') groupMsgToView g' m ci msgMeta createGroupFeatureChangedItems user cd CIRcvGroupFeature p p' @@ -3253,37 +3259,33 @@ saveRcvMSG Connection {connId} connOrGroupId agentMsgMeta msgBody agentAckCmdId rcvMsgDelivery = RcvMsgDelivery {connId, agentMsgId, agentMsgMeta, agentAckCmdId} withStore' $ \db -> createNewMessageAndRcvMsgDelivery db connOrGroupId newMsg sharedMsgId_ rcvMsgDelivery -saveSndChatItem :: ChatMonad m => User -> ChatDirection c 'MDSnd -> SndMessage -> CIContent 'MDSnd -> Maybe (CIFile 'MDSnd) -> Maybe (CIQuote c) -> m (ChatItem c 'MDSnd) -saveSndChatItem user cd msg content ciFile quotedItem = - saveSndChatItemTimed user cd msg content ciFile quotedItem Nothing +saveSndChatItem :: ChatMonad m => User -> ChatDirection c 'MDSnd -> SndMessage -> CIContent 'MDSnd -> m (ChatItem c 'MDSnd) +saveSndChatItem user cd msg content = saveSndChatItem' user cd msg content Nothing Nothing Nothing False -saveSndChatItemTimed :: ChatMonad m => User -> ChatDirection c 'MDSnd -> SndMessage -> CIContent 'MDSnd -> Maybe (CIFile 'MDSnd) -> Maybe (CIQuote c) -> Maybe CITimed -> m (ChatItem c 'MDSnd) -saveSndChatItemTimed user cd msg@SndMessage {sharedMsgId} content ciFile quotedItem timed = do +saveSndChatItem' :: ChatMonad m => User -> ChatDirection c 'MDSnd -> SndMessage -> CIContent 'MDSnd -> Maybe (CIFile 'MDSnd) -> Maybe (CIQuote c) -> Maybe CITimed -> Bool -> m (ChatItem c 'MDSnd) +saveSndChatItem' user cd msg@SndMessage {sharedMsgId} content ciFile quotedItem itemTimed itemLive = do createdAt <- liftIO getCurrentTime - ciId <- withStore' $ \db -> createNewSndChatItem db user cd msg content quotedItem createdAt timed + ciId <- withStore' $ \db -> createNewSndChatItem db user cd msg content quotedItem itemTimed itemLive createdAt forM_ ciFile $ \CIFile {fileId} -> withStore' $ \db -> updateFileTransferChatItemId db fileId ciId - liftIO $ mkChatItem cd ciId content ciFile quotedItem (Just sharedMsgId) createdAt createdAt timed + liftIO $ mkChatItem cd ciId content ciFile quotedItem (Just sharedMsgId) itemTimed itemLive createdAt createdAt -saveRcvChatItem :: ChatMonad m => User -> ChatDirection c 'MDRcv -> RcvMessage -> MsgMeta -> CIContent 'MDRcv -> Maybe (CIFile 'MDRcv) -> m (ChatItem c 'MDRcv) -saveRcvChatItem user cd msg msgMeta content ciFile = - saveRcvChatItemTimed user cd msg msgMeta content ciFile Nothing +saveRcvChatItem :: ChatMonad m => User -> ChatDirection c 'MDRcv -> RcvMessage -> MsgMeta -> CIContent 'MDRcv -> m (ChatItem c 'MDRcv) +saveRcvChatItem user cd msg@RcvMessage {sharedMsgId_} msgMeta content = + saveRcvChatItem' user cd msg sharedMsgId_ msgMeta content Nothing Nothing False -saveRcvChatItemTimed :: ChatMonad m => User -> ChatDirection c 'MDRcv -> RcvMessage -> MsgMeta -> CIContent 'MDRcv -> Maybe (CIFile 'MDRcv) -> Maybe CITimed -> m (ChatItem c 'MDRcv) -saveRcvChatItemTimed user cd msg@RcvMessage {sharedMsgId_} = saveRcvChatItem' user cd msg sharedMsgId_ - -saveRcvChatItem' :: ChatMonad m => User -> ChatDirection c 'MDRcv -> RcvMessage -> Maybe SharedMsgId -> MsgMeta -> CIContent 'MDRcv -> Maybe (CIFile 'MDRcv) -> Maybe CITimed -> m (ChatItem c 'MDRcv) -saveRcvChatItem' user cd msg sharedMsgId_ MsgMeta {broker = (_, brokerTs)} content ciFile timed = do +saveRcvChatItem' :: ChatMonad m => User -> ChatDirection c 'MDRcv -> RcvMessage -> Maybe SharedMsgId -> MsgMeta -> CIContent 'MDRcv -> Maybe (CIFile 'MDRcv) -> Maybe CITimed -> Bool -> m (ChatItem c 'MDRcv) +saveRcvChatItem' user cd msg sharedMsgId_ MsgMeta {broker = (_, brokerTs)} content ciFile itemTimed itemLive = do createdAt <- liftIO getCurrentTime - (ciId, quotedItem) <- withStore' $ \db -> createNewRcvChatItem db user cd msg sharedMsgId_ content brokerTs createdAt timed + (ciId, quotedItem) <- withStore' $ \db -> createNewRcvChatItem db user cd msg sharedMsgId_ content itemTimed itemLive brokerTs createdAt forM_ ciFile $ \CIFile {fileId} -> withStore' $ \db -> updateFileTransferChatItemId db fileId ciId - liftIO $ mkChatItem cd ciId content ciFile quotedItem sharedMsgId_ brokerTs createdAt timed + liftIO $ mkChatItem cd ciId content ciFile quotedItem sharedMsgId_ itemTimed itemLive brokerTs createdAt -mkChatItem :: ChatDirection c d -> ChatItemId -> CIContent d -> Maybe (CIFile d) -> Maybe (CIQuote c) -> Maybe SharedMsgId -> ChatItemTs -> UTCTime -> Maybe CITimed -> IO (ChatItem c d) -mkChatItem cd ciId content file quotedItem sharedMsgId itemTs currentTs timed = do +mkChatItem :: ChatDirection c d -> ChatItemId -> CIContent d -> Maybe (CIFile d) -> Maybe (CIQuote c) -> Maybe SharedMsgId -> Maybe CITimed -> Bool -> ChatItemTs -> UTCTime -> IO (ChatItem c d) +mkChatItem cd ciId content file quotedItem sharedMsgId itemTimed itemLive itemTs currentTs = do tz <- getCurrentTimeZone let itemText = ciContentToText content itemStatus = ciCreateStatus content - meta = mkCIMeta ciId content itemText itemStatus sharedMsgId False False tz currentTs itemTs currentTs currentTs timed + meta = mkCIMeta ciId content itemText itemStatus sharedMsgId False False itemTimed itemLive tz currentTs itemTs currentTs currentTs pure ChatItem {chatDir = toCIDirection cd, meta, content, formattedText = parseMaybeMarkdownList itemText, quotedItem, file} deleteDirectCI :: ChatMonad m => User -> Contact -> CChatItem 'CTDirect -> Bool -> Bool -> m ChatResponse @@ -3377,7 +3379,7 @@ createInternalChatItem user cd content itemTs_ = do createdAt <- liftIO getCurrentTime let itemTs = fromMaybe createdAt itemTs_ ciId <- withStore' $ \db -> createNewChatItemNoMsg db user cd content itemTs createdAt - ci <- liftIO $ mkChatItem cd ciId content Nothing Nothing Nothing itemTs createdAt Nothing + ci <- liftIO $ mkChatItem cd ciId content Nothing Nothing Nothing Nothing False itemTs createdAt toView $ CRNewChatItem $ AChatItem (chatTypeI @c) (msgDirection @d) (toChatInfo cd) ci getCreateActiveUser :: SQLiteStore -> IO User @@ -3513,8 +3515,8 @@ chatCommandP = "/_get chats" *> (APIGetChats <$> (" pcc=on" $> True <|> " pcc=off" $> False <|> pure False)), "/_get chat " *> (APIGetChat <$> chatRefP <* A.space <*> chatPaginationP <*> optional (" search=" *> stringP)), "/_get items count=" *> (APIGetChatItems <$> A.decimal), - "/_send " *> (APISendMessage <$> chatRefP <*> (" json " *> jsonP <|> " text " *> (ComposedMessage Nothing Nothing <$> mcTextP))), - "/_update item " *> (APIUpdateChatItem <$> chatRefP <* A.space <*> A.decimal <* A.space <*> msgContentP), + "/_send " *> (APISendMessage <$> chatRefP <*> liveMessageP <*> (" json " *> jsonP <|> " text " *> (ComposedMessage Nothing Nothing <$> mcTextP))), + "/_update item " *> (APIUpdateChatItem <$> chatRefP <* A.space <*> A.decimal <*> liveMessageP <* A.space <*> msgContentP), "/_delete item " *> (APIDeleteChatItem <$> chatRefP <* A.space <*> A.decimal <* A.space <*> ciDeleteMode), "/_read chat " *> (APIChatRead <$> chatRefP <*> optional (A.space *> ((,) <$> ("from=" *> A.decimal) <* A.space <*> ("to=" *> A.decimal)))), "/_unread chat " *> (APIChatUnread <$> chatRefP <* A.space <*> onOffP), @@ -3669,6 +3671,7 @@ chatCommandP = sendMsgQuote msgDir = SendMessageQuote <$> displayName <* A.space <*> pure msgDir <*> quotedMsg <*> A.takeByteString quotedMsg = A.char '(' *> A.takeTill (== ')') <* A.char ')' <* optional A.space refChar c = c > ' ' && c /= '#' && c /= '@' + liveMessageP = " live=" *> onOffP <|> pure False onOffP = ("on" $> True) <|> ("off" $> False) userNames = do cName <- displayName diff --git a/src/Simplex/Chat/Controller.hs b/src/Simplex/Chat/Controller.hs index 61078a31c4..21708a823c 100644 --- a/src/Simplex/Chat/Controller.hs +++ b/src/Simplex/Chat/Controller.hs @@ -154,8 +154,8 @@ data ChatCommand | APIGetChats {pendingConnections :: Bool} | APIGetChat ChatRef ChatPagination (Maybe String) | APIGetChatItems Int - | APISendMessage ChatRef ComposedMessage - | APIUpdateChatItem ChatRef ChatItemId MsgContent + | APISendMessage {chatRef :: ChatRef, liveMessage :: Bool, composedMessage :: ComposedMessage} + | APIUpdateChatItem {chatRef :: ChatRef, chatItemId :: ChatItemId, liveMessage :: Bool, msgContent :: MsgContent} | APIDeleteChatItem ChatRef ChatItemId CIDeleteMode | APIChatRead ChatRef (Maybe (ChatItemId, ChatItemId)) | APIChatUnread ChatRef Bool diff --git a/src/Simplex/Chat/Messages.hs b/src/Simplex/Chat/Messages.hs index bd54ab39af..6d637c71bc 100644 --- a/src/Simplex/Chat/Messages.hs +++ b/src/Simplex/Chat/Messages.hs @@ -273,21 +273,22 @@ data CIMeta (d :: MsgDirection) = CIMeta itemSharedMsgId :: Maybe SharedMsgId, itemDeleted :: Bool, itemEdited :: Bool, + itemTimed :: Maybe CITimed, + itemLive :: Bool, editable :: Bool, localItemTs :: ZonedTime, createdAt :: UTCTime, - updatedAt :: UTCTime, - timed :: Maybe CITimed + updatedAt :: UTCTime } deriving (Show, Generic) -mkCIMeta :: ChatItemId -> CIContent d -> Text -> CIStatus d -> Maybe SharedMsgId -> Bool -> Bool -> TimeZone -> UTCTime -> ChatItemTs -> UTCTime -> UTCTime -> Maybe CITimed -> CIMeta d -mkCIMeta itemId itemContent itemText itemStatus itemSharedMsgId itemDeleted itemEdited tz currentTs itemTs createdAt updatedAt timed = +mkCIMeta :: ChatItemId -> CIContent d -> Text -> CIStatus d -> Maybe SharedMsgId -> Bool -> Bool -> Maybe CITimed -> Bool -> TimeZone -> UTCTime -> ChatItemTs -> UTCTime -> UTCTime -> CIMeta d +mkCIMeta itemId itemContent itemText itemStatus itemSharedMsgId itemDeleted itemEdited itemTimed itemLive tz currentTs itemTs createdAt updatedAt = let localItemTs = utcToZonedTime tz itemTs editable = case itemContent of CISndMsgContent _ -> diffUTCTime currentTs itemTs < nominalDay && not itemDeleted _ -> False - in CIMeta {itemId, itemTs, itemText, itemStatus, itemSharedMsgId, itemDeleted, itemEdited, editable, localItemTs, createdAt, updatedAt, timed} + in CIMeta {itemId, itemTs, itemText, itemStatus, itemSharedMsgId, itemDeleted, itemEdited, itemTimed, itemLive, editable, localItemTs, createdAt, updatedAt} instance ToJSON (CIMeta d) where toEncoding = J.genericToEncoding J.defaultOptions diff --git a/src/Simplex/Chat/Migrations/M20221214_live_message.hs b/src/Simplex/Chat/Migrations/M20221214_live_message.hs new file mode 100644 index 0000000000..959ec75ae4 --- /dev/null +++ b/src/Simplex/Chat/Migrations/M20221214_live_message.hs @@ -0,0 +1,12 @@ +{-# LANGUAGE QuasiQuotes #-} + +module Simplex.Chat.Migrations.M20221214_live_message where + +import Database.SQLite.Simple (Query) +import Database.SQLite.Simple.QQ (sql) + +m20221214_live_message :: Query +m20221214_live_message = + [sql| +ALTER TABLE chat_items ADD COLUMN item_live INTEGER; +|] diff --git a/src/Simplex/Chat/Migrations/chat_schema.sql b/src/Simplex/Chat/Migrations/chat_schema.sql index 6315776c8c..effd79a668 100644 --- a/src/Simplex/Chat/Migrations/chat_schema.sql +++ b/src/Simplex/Chat/Migrations/chat_schema.sql @@ -367,7 +367,8 @@ CREATE TABLE chat_items( quoted_member_id BLOB, item_edited INTEGER, timed_ttl INTEGER, - timed_delete_at TEXT + timed_delete_at TEXT, + item_live INTEGER ); CREATE TABLE chat_item_messages( chat_item_id INTEGER NOT NULL REFERENCES chat_items ON DELETE CASCADE, diff --git a/src/Simplex/Chat/Protocol.hs b/src/Simplex/Chat/Protocol.hs index 885f27aae5..6361056e47 100644 --- a/src/Simplex/Chat/Protocol.hs +++ b/src/Simplex/Chat/Protocol.hs @@ -367,8 +367,12 @@ parseMsgContainer v = where mc = ExtMsgContent <$> v .: "content" <*> v .:? "file" <*> v .:? "ttl" <*> v .:? "live" -extMsgContent :: MsgContent -> Maybe FileInvitation -> Maybe Int -> ExtMsgContent -extMsgContent mc file ttl = ExtMsgContent mc file ttl Nothing +extMsgContent :: MsgContent -> Maybe FileInvitation -> ExtMsgContent +extMsgContent mc file = ExtMsgContent mc file Nothing Nothing + +justTrue :: Bool -> Maybe Bool +justTrue True = Just True +justTrue False = Nothing instance FromJSON MsgContent where parseJSON (J.Object v) = diff --git a/src/Simplex/Chat/Store.hs b/src/Simplex/Chat/Store.hs index c6a1981cf6..2f7408b440 100644 --- a/src/Simplex/Chat/Store.hs +++ b/src/Simplex/Chat/Store.hs @@ -316,6 +316,7 @@ import Simplex.Chat.Migrations.M20221209_verified_connection import Simplex.Chat.Migrations.M20221210_idxs import Simplex.Chat.Migrations.M20221211_group_description import Simplex.Chat.Migrations.M20221212_chat_items_timed +import Simplex.Chat.Migrations.M20221214_live_message import Simplex.Chat.Protocol import Simplex.Chat.Types import Simplex.Messaging.Agent.Protocol (ACorrId, AgentMsgId, ConnId, InvitationId, MsgMeta (..)) @@ -370,7 +371,8 @@ schemaMigrations = ("20221209_verified_connection", m20221209_verified_connection), ("20221210_idxs", m20221210_idxs), ("20221211_group_description", m20221211_group_description), - ("20221212_chat_items_timed", m20221212_chat_items_timed) + ("20221212_chat_items_timed", m20221212_chat_items_timed), + ("20221214_live_message", m20221214_live_message) ] -- | The list of migrations in ascending order by date @@ -3137,9 +3139,9 @@ deletePendingGroupMessage db groupMemberId messageId = type NewQuoteRow = (Maybe SharedMsgId, Maybe UTCTime, Maybe MsgContent, Maybe Bool, Maybe MemberId) -createNewSndChatItem :: DB.Connection -> User -> ChatDirection c 'MDSnd -> SndMessage -> CIContent 'MDSnd -> Maybe (CIQuote c) -> UTCTime -> Maybe CITimed -> IO ChatItemId -createNewSndChatItem db user chatDirection SndMessage {msgId, sharedMsgId} ciContent quotedItem createdAt = - createNewChatItem_ db user chatDirection createdByMsgId (Just sharedMsgId) ciContent quoteRow createdAt createdAt +createNewSndChatItem :: DB.Connection -> User -> ChatDirection c 'MDSnd -> SndMessage -> CIContent 'MDSnd -> Maybe (CIQuote c) -> Maybe CITimed -> Bool -> UTCTime -> IO ChatItemId +createNewSndChatItem db user chatDirection SndMessage {msgId, sharedMsgId} ciContent quotedItem timed live createdAt = + createNewChatItem_ db user chatDirection createdByMsgId (Just sharedMsgId) ciContent quoteRow timed live createdAt createdAt where createdByMsgId = if msgId == 0 then Nothing else Just msgId quoteRow :: NewQuoteRow @@ -3153,9 +3155,9 @@ createNewSndChatItem db user chatDirection SndMessage {msgId, sharedMsgId} ciCon CIQGroupRcv (Just GroupMember {memberId}) -> (Just False, Just memberId) CIQGroupRcv Nothing -> (Just False, Nothing) -createNewRcvChatItem :: DB.Connection -> User -> ChatDirection c 'MDRcv -> RcvMessage -> Maybe SharedMsgId -> CIContent 'MDRcv -> UTCTime -> UTCTime -> Maybe CITimed -> IO (ChatItemId, Maybe (CIQuote c)) -createNewRcvChatItem db user chatDirection RcvMessage {msgId, chatMsgEvent} sharedMsgId_ ciContent itemTs createdAt timed = do - ciId <- createNewChatItem_ db user chatDirection (Just msgId) sharedMsgId_ ciContent quoteRow itemTs createdAt timed +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 + ciId <- createNewChatItem_ db user chatDirection (Just msgId) sharedMsgId_ ciContent quoteRow timed live itemTs createdAt quotedItem <- mapM (getChatItemQuote_ db user chatDirection) quotedMsg pure (ciId, quotedItem) where @@ -3170,14 +3172,14 @@ createNewRcvChatItem db user chatDirection RcvMessage {msgId, chatMsgEvent} shar (Just $ Just userMemberId == memberId, memberId) createNewChatItemNoMsg :: forall c d. MsgDirectionI d => DB.Connection -> User -> ChatDirection c d -> CIContent d -> UTCTime -> UTCTime -> IO ChatItemId -createNewChatItemNoMsg db user chatDirection ciContent itemTs createdAt = - createNewChatItem_ db user chatDirection Nothing Nothing ciContent quoteRow itemTs createdAt Nothing +createNewChatItemNoMsg db user chatDirection ciContent = + createNewChatItem_ db user chatDirection Nothing Nothing ciContent quoteRow Nothing False where quoteRow :: NewQuoteRow 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 -> UTCTime -> UTCTime -> Maybe CITimed -> IO ChatItemId -createNewChatItem_ db User {userId} chatDirection msgId_ sharedMsgId ciContent quoteRow itemTs createdAt timed = do +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 DB.execute db [sql| @@ -3185,18 +3187,18 @@ createNewChatItem_ db User {userId} chatDirection msgId_ sharedMsgId ciContent q -- user and IDs user_id, created_by_msg_id, contact_id, group_id, group_member_id, -- meta - item_sent, item_ts, item_content, item_text, item_status, shared_msg_id, created_at, updated_at, timed_ttl, timed_delete_at, + item_sent, item_ts, item_content, item_text, item_status, shared_msg_id, created_at, updated_at, timed_ttl, timed_delete_at, item_live, -- quote quoted_shared_msg_id, quoted_sent_at, quoted_content, quoted_sent, quoted_member_id - ) VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?) + ) VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?) |] ((userId, msgId_) :. idsRow :. itemRow :. quoteRow) ciId <- insertedRowId db forM_ msgId_ $ \msgId -> insertChatItemMessage_ db ciId msgId createdAt pure ciId where - itemRow :: (SMsgDirection d, UTCTime, CIContent d, Text, CIStatus d, Maybe SharedMsgId, UTCTime, UTCTime, Maybe Int, Maybe UTCTime) - itemRow = (msgDirection @d, itemTs, ciContent, ciContentToText ciContent, ciCreateStatus ciContent, sharedMsgId, createdAt, createdAt, timedTTL, timedDeleteAt) + itemRow :: (SMsgDirection d, UTCTime, CIContent d, Text, CIStatus d, Maybe SharedMsgId) :. (UTCTime, UTCTime, Maybe Int, Maybe UTCTime, Bool) + itemRow = (msgDirection @d, itemTs, ciContent, ciContentToText ciContent, ciCreateStatus ciContent, sharedMsgId) :. (createdAt, createdAt, timedTTL, timedDeleteAt, live) where (timedTTL, timedDeleteAt) = case timed of Just CITimed {ttl, deleteAt} -> (Just ttl, deleteAt) @@ -3303,7 +3305,7 @@ getDirectChatPreviews_ db user@User {userId} = do -- ChatStats COALESCE(ChatStats.UnreadCount, 0), COALESCE(ChatStats.MinUnread, 0), ct.unread_chat, -- ChatItem - i.chat_item_id, i.item_ts, i.item_content, i.item_text, i.item_status, i.shared_msg_id, i.item_deleted, i.item_edited, i.created_at, i.updated_at, i.timed_ttl, i.timed_delete_at, + i.chat_item_id, i.item_ts, i.item_content, i.item_text, i.item_status, i.shared_msg_id, i.item_deleted, 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.ci_file_status, -- DirectQuote @@ -3368,7 +3370,7 @@ getGroupChatPreviews_ db User {userId, userContactId} = do -- ChatStats COALESCE(ChatStats.UnreadCount, 0), COALESCE(ChatStats.MinUnread, 0), g.unread_chat, -- ChatItem - i.chat_item_id, i.item_ts, i.item_content, i.item_text, i.item_status, i.shared_msg_id, i.item_deleted, i.item_edited, i.created_at, i.updated_at, i.timed_ttl, i.timed_delete_at, + i.chat_item_id, i.item_ts, i.item_content, i.item_text, i.item_status, i.shared_msg_id, i.item_deleted, 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.ci_file_status, -- Maybe GroupMember - sender @@ -3527,7 +3529,7 @@ getDirectChatLast_ db user@User {userId} contactId count search = do [sql| SELECT -- ChatItem - i.chat_item_id, i.item_ts, i.item_content, i.item_text, i.item_status, i.shared_msg_id, i.item_deleted, i.item_edited, i.created_at, i.updated_at, i.timed_ttl, i.timed_delete_at, + i.chat_item_id, i.item_ts, i.item_content, i.item_text, i.item_status, i.shared_msg_id, i.item_deleted, 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.ci_file_status, -- DirectQuote @@ -3558,7 +3560,7 @@ getDirectChatAfter_ db user@User {userId} contactId afterChatItemId count search [sql| SELECT -- ChatItem - i.chat_item_id, i.item_ts, i.item_content, i.item_text, i.item_status, i.shared_msg_id, i.item_deleted, i.item_edited, i.created_at, i.updated_at, i.timed_ttl, i.timed_delete_at, + i.chat_item_id, i.item_ts, i.item_content, i.item_text, i.item_status, i.shared_msg_id, i.item_deleted, 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.ci_file_status, -- DirectQuote @@ -3590,7 +3592,7 @@ getDirectChatBefore_ db user@User {userId} contactId beforeChatItemId count sear [sql| SELECT -- ChatItem - i.chat_item_id, i.item_ts, i.item_content, i.item_text, i.item_status, i.shared_msg_id, i.item_deleted, i.item_edited, i.created_at, i.updated_at, i.timed_ttl, i.timed_delete_at, + i.chat_item_id, i.item_ts, i.item_content, i.item_text, i.item_status, i.shared_msg_id, i.item_deleted, 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.ci_file_status, -- DirectQuote @@ -3834,15 +3836,15 @@ updateDirectChatItemStatus db userId contactId itemId itemStatus = do correctDir :: CChatItem c -> Either StoreError (ChatItem c d) correctDir (CChatItem _ ci) = first SEInternalError $ checkDirection ci -updateDirectChatItem :: forall d. MsgDirectionI d => DB.Connection -> UserId -> Int64 -> ChatItemId -> CIContent d -> Maybe MessageId -> ExceptT StoreError IO (ChatItem 'CTDirect d) -updateDirectChatItem db userId contactId itemId newContent msgId_ = do +updateDirectChatItem :: forall d. MsgDirectionI d => DB.Connection -> UserId -> Int64 -> ChatItemId -> CIContent d -> Bool -> Maybe MessageId -> ExceptT StoreError IO (ChatItem 'CTDirect d) +updateDirectChatItem db userId contactId itemId newContent itemLive msgId_ = do currentTs <- liftIO getCurrentTime - ci <- updateDirectChatItem_ db userId contactId itemId newContent currentTs + ci <- updateDirectChatItem_ db userId contactId itemId newContent itemLive currentTs forM_ msgId_ $ \msgId -> liftIO $ insertChatItemMessage_ db itemId msgId currentTs pure ci -updateDirectChatItem_ :: forall d. (MsgDirectionI d) => DB.Connection -> UserId -> Int64 -> ChatItemId -> CIContent d -> UTCTime -> ExceptT StoreError IO (ChatItem 'CTDirect d) -updateDirectChatItem_ db userId contactId itemId newContent currentTs = do +updateDirectChatItem_ :: forall d. (MsgDirectionI d) => DB.Connection -> UserId -> Int64 -> ChatItemId -> CIContent d -> Bool -> UTCTime -> ExceptT StoreError IO (ChatItem 'CTDirect d) +updateDirectChatItem_ db userId contactId itemId newContent itemLive currentTs = do ci <- liftEither . correctDir =<< getDirectChatItem db userId contactId itemId let newText = ciContentToText newContent liftIO $ do @@ -3850,10 +3852,10 @@ updateDirectChatItem_ db userId contactId itemId newContent currentTs = do db [sql| UPDATE chat_items - SET item_content = ?, item_text = ?, item_deleted = 0, item_edited = 1, updated_at = ? + SET item_content = ?, item_text = ?, item_deleted = 0, item_edited = 1, updated_at = ?, item_live = ? WHERE user_id = ? AND contact_id = ? AND chat_item_id = ? |] - (newContent, newText, currentTs, userId, contactId, itemId) + (newContent, newText, currentTs, itemLive, userId, contactId, itemId) pure ci {content = newContent, meta = (meta ci) {itemText = newText, itemEdited = True}, formattedText = parseMaybeMarkdownList newText} where correctDir :: CChatItem c -> Either StoreError (ChatItem c d) @@ -3936,7 +3938,7 @@ getDirectChatItem db userId contactId itemId = ExceptT $ do [sql| SELECT -- ChatItem - i.chat_item_id, i.item_ts, i.item_content, i.item_text, i.item_status, i.shared_msg_id, i.item_deleted, i.item_edited, i.created_at, i.updated_at, i.timed_ttl, i.timed_delete_at, + i.chat_item_id, i.item_ts, i.item_content, i.item_text, i.item_status, i.shared_msg_id, i.item_deleted, 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.ci_file_status, -- DirectQuote @@ -3962,8 +3964,8 @@ getDirectChatItemIdByText db userId contactId msgDir quotedMsg = |] (userId, contactId, msgDir, quotedMsg <> "%") -updateGroupChatItem :: forall d. MsgDirectionI d => DB.Connection -> User -> Int64 -> ChatItemId -> CIContent d -> MessageId -> ExceptT StoreError IO (ChatItem 'CTGroup d) -updateGroupChatItem db user@User {userId} groupId itemId newContent msgId = do +updateGroupChatItem :: forall d. MsgDirectionI d => DB.Connection -> User -> Int64 -> ChatItemId -> CIContent d -> Bool -> MessageId -> ExceptT StoreError IO (ChatItem 'CTGroup d) +updateGroupChatItem db user@User {userId} groupId itemId newContent itemLive msgId = do ci <- liftEither . correctDir =<< getGroupChatItem db user groupId itemId currentTs <- liftIO getCurrentTime let newText = ciContentToText newContent @@ -3972,10 +3974,10 @@ updateGroupChatItem db user@User {userId} groupId itemId newContent msgId = do db [sql| UPDATE chat_items - SET item_content = ?, item_text = ?, item_deleted = 0, item_edited = 1, updated_at = ? + SET item_content = ?, item_text = ?, item_deleted = 0, item_edited = 1, updated_at = ?, item_live = ? WHERE user_id = ? AND group_id = ? AND chat_item_id = ? |] - (newContent, newText, currentTs, userId, groupId, itemId) + (newContent, newText, currentTs, itemLive, userId, groupId, itemId) insertChatItemMessage_ db itemId msgId currentTs pure ci {content = newContent, meta = (meta ci) {itemText = newText, itemEdited = True}, formattedText = parseMaybeMarkdownList newText} where @@ -4037,7 +4039,7 @@ getGroupChatItem db User {userId, userContactId} groupId itemId = ExceptT $ do [sql| SELECT -- ChatItem - i.chat_item_id, i.item_ts, i.item_content, i.item_text, i.item_status, i.shared_msg_id, i.item_deleted, i.item_edited, i.created_at, i.updated_at, i.timed_ttl, i.timed_delete_at, + i.chat_item_id, i.item_ts, i.item_content, i.item_text, i.item_status, i.shared_msg_id, i.item_deleted, 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.ci_file_status, -- GroupMember @@ -4269,9 +4271,11 @@ toChatStats (unreadCount, minUnreadItemId, unreadChat) = ChatStats {unreadCount, type MaybeCIFIleRow = (Maybe Int64, Maybe String, Maybe Integer, Maybe FilePath, Maybe ACIFileStatus) -type ChatItemRow = (Int64, ChatItemTs, ACIContent, Text, ACIStatus, Maybe SharedMsgId, Bool, Maybe Bool, UTCTime, UTCTime, Maybe Int, Maybe UTCTime) :. MaybeCIFIleRow +type ChatItemModeRow = (Maybe Int, Maybe UTCTime, Maybe Bool) -type MaybeChatItemRow = (Maybe Int64, Maybe ChatItemTs, Maybe ACIContent, Maybe Text, Maybe ACIStatus, Maybe SharedMsgId, Maybe Bool, Maybe Bool, Maybe UTCTime, Maybe UTCTime, Maybe Int, Maybe UTCTime) :. MaybeCIFIleRow +type ChatItemRow = (Int64, ChatItemTs, ACIContent, Text, ACIStatus, Maybe SharedMsgId, Bool, Maybe Bool, UTCTime, UTCTime) :. ChatItemModeRow :. MaybeCIFIleRow + +type MaybeChatItemRow = (Maybe Int64, Maybe ChatItemTs, Maybe ACIContent, Maybe Text, Maybe ACIStatus, Maybe SharedMsgId, Maybe Bool, Maybe Bool, Maybe UTCTime, Maybe UTCTime) :. ChatItemModeRow :. MaybeCIFIleRow type QuoteRow = (Maybe ChatItemId, Maybe SharedMsgId, Maybe UTCTime, Maybe MsgContent, Maybe Bool) @@ -4285,7 +4289,7 @@ toQuote (quotedItemId, quotedSharedMsgId, quotedSentAt, quotedMsgContent, _) dir CIQuote <$> dir <*> pure quotedItemId <*> pure quotedSharedMsgId <*> quotedSentAt <*> quotedMsgContent <*> (parseMaybeMarkdownList . msgContentText <$> quotedMsgContent) toDirectChatItem :: TimeZone -> UTCTime -> ChatItemRow :. QuoteRow -> Either StoreError (CChatItem 'CTDirect) -toDirectChatItem tz currentTs (((itemId, itemTs, itemContent, itemText, itemStatus, sharedMsgId, itemDeleted, itemEdited, createdAt, updatedAt, timedTTL, timedDeleteAt) :. (fileId_, fileName_, fileSize_, filePath, fileStatus_)) :. quoteRow) = +toDirectChatItem tz currentTs (((itemId, itemTs, itemContent, itemText, itemStatus, sharedMsgId, itemDeleted, itemEdited, createdAt, updatedAt) :. (timedTTL, timedDeleteAt, itemLive) :. (fileId_, fileName_, fileSize_, filePath, fileStatus_)) :. quoteRow) = case (itemContent, itemStatus, fileStatus_) of (ACIContent SMDSnd ciContent, ACIStatus SMDSnd ciStatus, Just (AFS SMDSnd fileStatus)) -> Right $ cItem SMDSnd CIDirectSnd ciStatus ciContent (maybeCIFile fileStatus) @@ -4307,7 +4311,7 @@ toDirectChatItem tz currentTs (((itemId, itemTs, itemContent, itemText, itemStat CChatItem d ChatItem {chatDir, meta = ciMeta content ciStatus, content, formattedText = parseMaybeMarkdownList itemText, quotedItem = toDirectQuote quoteRow, file} badItem = Left $ SEBadChatItem itemId ciMeta :: CIContent d -> CIStatus d -> CIMeta d - ciMeta content status = mkCIMeta itemId content itemText status sharedMsgId itemDeleted (fromMaybe False itemEdited) tz currentTs itemTs createdAt updatedAt ciTimed + ciMeta content status = mkCIMeta itemId content itemText status sharedMsgId itemDeleted (fromMaybe False itemEdited) ciTimed (fromMaybe False itemLive) tz currentTs itemTs createdAt updatedAt ciTimed :: Maybe CITimed ciTimed = case (timedTTL, timedDeleteAt) of @@ -4315,8 +4319,8 @@ toDirectChatItem tz currentTs (((itemId, itemTs, itemContent, itemText, itemStat _ -> Nothing toDirectChatItemList :: TimeZone -> UTCTime -> MaybeChatItemRow :. QuoteRow -> [CChatItem 'CTDirect] -toDirectChatItemList tz currentTs (((Just itemId, Just itemTs, Just itemContent, Just itemText, Just itemStatus, sharedMsgId, Just itemDeleted, itemEdited, Just createdAt, Just updatedAt, timedTTL, timedDeleteAt) :. fileRow) :. quoteRow) = - either (const []) (: []) $ toDirectChatItem tz currentTs (((itemId, itemTs, itemContent, itemText, itemStatus, sharedMsgId, itemDeleted, itemEdited, createdAt, updatedAt, timedTTL, timedDeleteAt) :. fileRow) :. quoteRow) +toDirectChatItemList tz currentTs (((Just itemId, Just itemTs, Just itemContent, Just itemText, Just itemStatus, sharedMsgId, Just itemDeleted, itemEdited, Just createdAt, Just updatedAt) :. (timedTTL, timedDeleteAt, itemLive) :. fileRow) :. quoteRow) = + either (const []) (: []) $ toDirectChatItem tz currentTs (((itemId, itemTs, itemContent, itemText, itemStatus, sharedMsgId, itemDeleted, itemEdited, createdAt, updatedAt) :. (timedTTL, timedDeleteAt, itemLive) :. fileRow) :. quoteRow) toDirectChatItemList _ _ _ = [] type GroupQuoteRow = QuoteRow :. MaybeGroupMemberRow @@ -4332,7 +4336,7 @@ toGroupQuote qr@(_, _, _, _, quotedSent) quotedMember_ = toQuote qr $ direction direction _ _ = Nothing toGroupChatItem :: TimeZone -> UTCTime -> Int64 -> ChatItemRow :. MaybeGroupMemberRow :. GroupQuoteRow -> Either StoreError (CChatItem 'CTGroup) -toGroupChatItem tz currentTs userContactId (((itemId, itemTs, itemContent, itemText, itemStatus, sharedMsgId, itemDeleted, itemEdited, createdAt, updatedAt, timedTTL, timedDeleteAt) :. (fileId_, fileName_, fileSize_, filePath, fileStatus_)) :. memberRow_ :. quoteRow :. quotedMemberRow_) = do +toGroupChatItem tz currentTs userContactId (((itemId, itemTs, itemContent, itemText, itemStatus, sharedMsgId, itemDeleted, itemEdited, createdAt, updatedAt) :. (timedTTL, timedDeleteAt, itemLive) :. (fileId_, fileName_, fileSize_, filePath, fileStatus_)) :. memberRow_ :. quoteRow :. quotedMemberRow_) = do let member_ = toMaybeGroupMember userContactId memberRow_ let quotedMember_ = toMaybeGroupMember userContactId quotedMemberRow_ case (itemContent, itemStatus, member_, fileStatus_) of @@ -4356,7 +4360,7 @@ toGroupChatItem tz currentTs userContactId (((itemId, itemTs, itemContent, itemT CChatItem d ChatItem {chatDir, meta = ciMeta content ciStatus, content, formattedText = parseMaybeMarkdownList itemText, quotedItem = toGroupQuote quoteRow quotedMember_, file} badItem = Left $ SEBadChatItem itemId ciMeta :: CIContent d -> CIStatus d -> CIMeta d - ciMeta content status = mkCIMeta itemId content itemText status sharedMsgId itemDeleted (fromMaybe False itemEdited) tz currentTs itemTs createdAt updatedAt ciTimed + ciMeta content status = mkCIMeta itemId content itemText status sharedMsgId itemDeleted (fromMaybe False itemEdited) ciTimed (fromMaybe False itemLive) tz currentTs itemTs createdAt updatedAt ciTimed :: Maybe CITimed ciTimed = case (timedTTL, timedDeleteAt) of @@ -4364,8 +4368,8 @@ toGroupChatItem tz currentTs userContactId (((itemId, itemTs, itemContent, itemT _ -> Nothing toGroupChatItemList :: TimeZone -> UTCTime -> Int64 -> MaybeGroupChatItemRow -> [CChatItem 'CTGroup] -toGroupChatItemList tz currentTs userContactId (((Just itemId, Just itemTs, Just itemContent, Just itemText, Just itemStatus, sharedMsgId, Just itemDeleted, itemEdited, Just createdAt, Just updatedAt, timedTTL, timedDeleteAt) :. fileRow) :. memberRow_ :. quoteRow :. quotedMemberRow_) = - either (const []) (: []) $ toGroupChatItem tz currentTs userContactId (((itemId, itemTs, itemContent, itemText, itemStatus, sharedMsgId, itemDeleted, itemEdited, createdAt, updatedAt, timedTTL, timedDeleteAt) :. fileRow) :. memberRow_ :. quoteRow :. quotedMemberRow_) +toGroupChatItemList tz currentTs userContactId (((Just itemId, Just itemTs, Just itemContent, Just itemText, Just itemStatus, sharedMsgId, Just itemDeleted, itemEdited, Just createdAt, Just updatedAt) :. (timedTTL, timedDeleteAt, itemLive) :. fileRow) :. memberRow_ :. quoteRow :. quotedMemberRow_) = + either (const []) (: []) $ toGroupChatItem tz currentTs userContactId (((itemId, itemTs, itemContent, itemText, itemStatus, sharedMsgId, itemDeleted, itemEdited, createdAt, updatedAt) :. (timedTTL, timedDeleteAt, itemLive) :. fileRow) :. memberRow_ :. quoteRow :. quotedMemberRow_) toGroupChatItemList _ _ _ _ = [] getSMPServers :: DB.Connection -> User -> IO [ServerCfg] diff --git a/tests/ProtocolTests.hs b/tests/ProtocolTests.hs index e1e5db65bd..7abd76176b 100644 --- a/tests/ProtocolTests.hs +++ b/tests/ProtocolTests.hs @@ -101,7 +101,7 @@ decodeChatMessageTest :: Spec decodeChatMessageTest = describe "Chat message encoding/decoding" $ do it "x.msg.new simple text" $ "{\"event\":\"x.msg.new\",\"params\":{\"content\":{\"text\":\"hello\",\"type\":\"text\"}}}" - #==# XMsgNew (MCSimple (extMsgContent (MCText "hello") Nothing Nothing)) + #==# XMsgNew (MCSimple (extMsgContent (MCText "hello") Nothing)) it "x.msg.new simple text - timed message TTL" $ "{\"event\":\"x.msg.new\",\"params\":{\"content\":{\"text\":\"hello\",\"type\":\"text\"},\"ttl\":3600}}" #==# XMsgNew (MCSimple (ExtMsgContent (MCText "hello") Nothing (Just 3600) Nothing)) @@ -110,21 +110,21 @@ decodeChatMessageTest = describe "Chat message encoding/decoding" $ do #==# XMsgNew (MCSimple (ExtMsgContent (MCText "hello") Nothing Nothing (Just True))) it "x.msg.new simple link" $ "{\"event\":\"x.msg.new\",\"params\":{\"content\":{\"text\":\"https://simplex.chat\",\"type\":\"link\",\"preview\":{\"description\":\"SimpleX Chat\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgA\",\"title\":\"SimpleX Chat\",\"uri\":\"https://simplex.chat\"}}}}" - #==# XMsgNew (MCSimple (extMsgContent (MCLink "https://simplex.chat" $ LinkPreview {uri = "https://simplex.chat", title = "SimpleX Chat", description = "SimpleX Chat", image = ImageData "data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgA"}) Nothing Nothing)) + #==# XMsgNew (MCSimple (extMsgContent (MCLink "https://simplex.chat" $ LinkPreview {uri = "https://simplex.chat", title = "SimpleX Chat", description = "SimpleX Chat", image = ImageData "data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgA"}) Nothing)) it "x.msg.new simple image" $ "{\"event\":\"x.msg.new\",\"params\":{\"content\":{\"text\":\"\",\"type\":\"image\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\"}}}" - #==# XMsgNew (MCSimple (extMsgContent (MCImage "" $ ImageData "data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=") Nothing Nothing)) + #==# XMsgNew (MCSimple (extMsgContent (MCImage "" $ ImageData "data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=") Nothing)) it "x.msg.new simple image with text" $ "{\"event\":\"x.msg.new\",\"params\":{\"content\":{\"text\":\"here's an image\",\"type\":\"image\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\"}}}" - #==# XMsgNew (MCSimple (extMsgContent (MCImage "here's an image" $ ImageData "data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=") Nothing Nothing)) + #==# XMsgNew (MCSimple (extMsgContent (MCImage "here's an image" $ ImageData "data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=") Nothing)) it "x.msg.new chat message " $ "{\"msgId\":\"AQIDBA==\",\"event\":\"x.msg.new\",\"params\":{\"content\":{\"text\":\"hello\",\"type\":\"text\"}}}" - ##==## ChatMessage (Just $ SharedMsgId "\1\2\3\4") (XMsgNew (MCSimple (extMsgContent (MCText "hello") Nothing Nothing))) + ##==## ChatMessage (Just $ SharedMsgId "\1\2\3\4") (XMsgNew (MCSimple (extMsgContent (MCText "hello") Nothing))) it "x.msg.new quote" $ "{\"msgId\":\"AQIDBA==\",\"event\":\"x.msg.new\",\"params\":{\"content\":{\"text\":\"hello to you too\",\"type\":\"text\"},\"quote\":{\"content\":{\"text\":\"hello there!\",\"type\":\"text\"},\"msgRef\":{\"msgId\":\"BQYHCA==\",\"sent\":true,\"sentAt\":\"1970-01-01T00:00:01.000000001Z\"}}}}" ##==## ChatMessage (Just $ SharedMsgId "\1\2\3\4") - (XMsgNew (MCQuote quotedMsg (extMsgContent (MCText "hello to you too") Nothing Nothing))) + (XMsgNew (MCQuote quotedMsg (extMsgContent (MCText "hello to you too") Nothing))) it "x.msg.new quote - timed message TTL" $ "{\"msgId\":\"AQIDBA==\",\"event\":\"x.msg.new\",\"params\":{\"content\":{\"text\":\"hello to you too\",\"type\":\"text\"},\"quote\":{\"content\":{\"text\":\"hello there!\",\"type\":\"text\"},\"msgRef\":{\"msgId\":\"BQYHCA==\",\"sent\":true,\"sentAt\":\"1970-01-01T00:00:01.000000001Z\"}},\"ttl\":3600}}" ##==## ChatMessage @@ -137,7 +137,7 @@ decodeChatMessageTest = describe "Chat message encoding/decoding" $ do (XMsgNew (MCQuote quotedMsg (ExtMsgContent (MCText "hello to you too") Nothing Nothing (Just True)))) it "x.msg.new forward" $ "{\"msgId\":\"AQIDBA==\",\"event\":\"x.msg.new\",\"params\":{\"content\":{\"text\":\"hello\",\"type\":\"text\"},\"forward\":true}}" - ##==## ChatMessage (Just $ SharedMsgId "\1\2\3\4") (XMsgNew $ MCForward (extMsgContent (MCText "hello") Nothing Nothing)) + ##==## ChatMessage (Just $ SharedMsgId "\1\2\3\4") (XMsgNew $ MCForward (extMsgContent (MCText "hello") Nothing)) it "x.msg.new forward - timed message TTL" $ "{\"msgId\":\"AQIDBA==\",\"event\":\"x.msg.new\",\"params\":{\"content\":{\"text\":\"hello\",\"type\":\"text\"},\"forward\":true,\"ttl\":3600}}" ##==## ChatMessage (Just $ SharedMsgId "\1\2\3\4") (XMsgNew $ MCForward (ExtMsgContent (MCText "hello") Nothing (Just 3600) Nothing)) @@ -146,10 +146,10 @@ decodeChatMessageTest = describe "Chat message encoding/decoding" $ do ##==## ChatMessage (Just $ SharedMsgId "\1\2\3\4") (XMsgNew $ MCForward (ExtMsgContent (MCText "hello") Nothing Nothing (Just True))) it "x.msg.new simple text with file" $ "{\"event\":\"x.msg.new\",\"params\":{\"content\":{\"text\":\"hello\",\"type\":\"text\"},\"file\":{\"fileSize\":12345,\"fileName\":\"photo.jpg\"}}}" - #==# XMsgNew (MCSimple (extMsgContent (MCText "hello") (Just FileInvitation {fileName = "photo.jpg", fileSize = 12345, fileConnReq = Nothing, fileInline = Nothing}) Nothing)) + #==# XMsgNew (MCSimple (extMsgContent (MCText "hello") (Just FileInvitation {fileName = "photo.jpg", fileSize = 12345, fileConnReq = Nothing, fileInline = Nothing}))) it "x.msg.new simple file with file" $ "{\"event\":\"x.msg.new\",\"params\":{\"content\":{\"text\":\"\",\"type\":\"file\"},\"file\":{\"fileSize\":12345,\"fileName\":\"file.txt\"}}}" - #==# XMsgNew (MCSimple (extMsgContent (MCFile "") (Just FileInvitation {fileName = "file.txt", fileSize = 12345, fileConnReq = Nothing, fileInline = Nothing}) Nothing)) + #==# XMsgNew (MCSimple (extMsgContent (MCFile "") (Just FileInvitation {fileName = "file.txt", fileSize = 12345, fileConnReq = Nothing, fileInline = Nothing}))) it "x.msg.new quote with file" $ "{\"msgId\":\"AQIDBA==\",\"event\":\"x.msg.new\",\"params\":{\"content\":{\"text\":\"hello to you too\",\"type\":\"text\"},\"quote\":{\"content\":{\"text\":\"hello there!\",\"type\":\"text\"},\"msgRef\":{\"msgId\":\"BQYHCA==\",\"sent\":true,\"sentAt\":\"1970-01-01T00:00:01.000000001Z\"}},\"file\":{\"fileSize\":12345,\"fileName\":\"photo.jpg\"}}}" ##==## ChatMessage @@ -160,13 +160,12 @@ decodeChatMessageTest = describe "Chat message encoding/decoding" $ do ( extMsgContent (MCText "hello to you too") (Just FileInvitation {fileName = "photo.jpg", fileSize = 12345, fileConnReq = Nothing, fileInline = Nothing}) - Nothing ) ) ) it "x.msg.new forward with file" $ "{\"msgId\":\"AQIDBA==\",\"event\":\"x.msg.new\",\"params\":{\"content\":{\"text\":\"hello\",\"type\":\"text\"},\"forward\":true,\"file\":{\"fileSize\":12345,\"fileName\":\"photo.jpg\"}}}" - ##==## ChatMessage (Just $ SharedMsgId "\1\2\3\4") (XMsgNew $ MCForward (extMsgContent (MCText "hello") (Just FileInvitation {fileName = "photo.jpg", fileSize = 12345, fileConnReq = Nothing, fileInline = Nothing}) Nothing)) + ##==## ChatMessage (Just $ SharedMsgId "\1\2\3\4") (XMsgNew $ MCForward (extMsgContent (MCText "hello") (Just FileInvitation {fileName = "photo.jpg", fileSize = 12345, fileConnReq = Nothing, fileInline = Nothing}))) it "x.msg.update" $ "{\"event\":\"x.msg.update\",\"params\":{\"msgId\":\"AQIDBA==\", \"content\":{\"text\":\"hello\",\"type\":\"text\"}}}" #==# XMsgUpdate (SharedMsgId "\1\2\3\4") (MCText "hello") Nothing Nothing