mirror of
https://github.com/simplex-chat/simplex-chat.git
synced 2024-12-17 17:20:21 +01:00
core: support for live messages (#1577)
This commit is contained in:
Evgeny Poberezkin
committed by
GitHub
GitHub
parent
acfb98bd81
commit
6b8705e9f4
+102
-99
@@ -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
|
||||
|
||||
Reference in New Issue
Block a user