Merge branch 'master' into master-ghc8107

This commit is contained in:
Evgeny Poberezkin
2023-10-18 22:44:27 +01:00
41 changed files with 703 additions and 305 deletions
+14 -13
View File
@@ -580,11 +580,11 @@ processChatCommand = \case
timed_ <- sndContactCITimed live ct itemTTL
(msgContainer, quotedItem_) <- prepareMsg fInv_ timed_
(msg@SndMessage {sharedMsgId}, _) <- sendDirectContactMessage ct (XMsgNew msgContainer)
ci <- saveSndChatItem' user (CDDirectSnd ct) msg (CISndMsgContent mc) ciFile_ quotedItem_ timed_ live
case ft_ of
Just ft@FileTransferMeta {fileInline = Just IFMSent} ->
sendDirectFileInline ct ft sharedMsgId
_ -> pure ()
ci <- saveSndChatItem' user (CDDirectSnd ct) msg (CISndMsgContent mc) ciFile_ quotedItem_ timed_ live
forM_ (timed_ >>= timedDeleteAt') $
startProximateTimedItemThread user (ChatRef CTDirect contactId, chatItemId' ci)
pure $ CRNewChatItem user (AChatItem SCTDirect SMDSnd (DirectChat ct) ci)
@@ -645,11 +645,11 @@ processChatCommand = \case
timed_ <- sndGroupCITimed live gInfo itemTTL
(msgContainer, quotedItem_) <- prepareMsg fInv_ timed_ membership
(msg@SndMessage {sharedMsgId}, sentToMembers) <- sendGroupMessage user gInfo ms (XMsgNew msgContainer)
mapM_ (sendGroupFileInline ms sharedMsgId) ft_
ci <- saveSndChatItem' user (CDGroupSnd gInfo) msg (CISndMsgContent mc) ciFile_ quotedItem_ timed_ live
withStore' $ \db ->
forM_ sentToMembers $ \GroupMember {groupMemberId} ->
createGroupSndStatus db (chatItemId' ci) groupMemberId CISSndNew
mapM_ (sendGroupFileInline ms sharedMsgId) ft_
forM_ (timed_ >>= timedDeleteAt') $
startProximateTimedItemThread user (ChatRef CTGroup groupId, chatItemId' ci)
pure $ CRNewChatItem user (AChatItem SCTGroup SMDSnd (GroupChat gInfo) ci)
@@ -754,8 +754,9 @@ processChatCommand = \case
unzipMaybe3 _ = (Nothing, Nothing, Nothing)
APIUpdateChatItem (ChatRef cType chatId) itemId live mc -> withUser $ \user -> withChatLock "updateChatItem" $ case cType of
CTDirect -> do
(ct@Contact {contactId}, cci) <- withStore $ \db -> (,) <$> getContact db user chatId <*> getDirectChatItem db user chatId itemId
ct@Contact {contactId} <- withStore $ \db -> getContact db user chatId
assertDirectAllowed user MDSnd ct XMsgUpdate_
cci <- withStore $ \db -> getDirectCIWithReactions db user ct itemId
case cci of
CChatItem SMDSnd ci@ChatItem {meta = CIMeta {itemSharedMsgId, itemTimed, itemLive, editable}, content = ciContent} -> do
case (ciContent, itemSharedMsgId, editable) of
@@ -777,7 +778,7 @@ processChatCommand = \case
CTGroup -> do
Group gInfo@GroupInfo {groupId} ms <- withStore $ \db -> getGroup db user chatId
assertUserGroupRole gInfo GRAuthor
cci <- withStore $ \db -> getGroupChatItem db user chatId itemId
cci <- withStore $ \db -> getGroupCIWithReactions db user gInfo itemId
case cci of
CChatItem SMDSnd ci@ChatItem {meta = CIMeta {itemSharedMsgId, itemTimed, itemLive, editable}, content = ciContent} -> do
case (ciContent, itemSharedMsgId, editable) of
@@ -2384,8 +2385,8 @@ updateCallItemStatus user ct Call {chatItemId} receivedStatus msgId_ = do
forM_ aciContent_ $ \aciContent -> updateDirectChatItemView user ct chatItemId aciContent False msgId_
updateDirectChatItemView :: ChatMonad m => User -> Contact -> ChatItemId -> ACIContent -> Bool -> Maybe MessageId -> m ()
updateDirectChatItemView user ct@Contact {contactId} chatItemId (ACIContent msgDir ciContent) live msgId_ = do
ci' <- withStore $ \db -> updateDirectChatItem db user contactId chatItemId ciContent live msgId_
updateDirectChatItemView user ct chatItemId (ACIContent msgDir ciContent) live msgId_ = do
ci' <- withStore $ \db -> updateDirectChatItem db user ct chatItemId ciContent live msgId_
toView $ CRChatItemUpdated user (AChatItem SCTDirect msgDir (DirectChat ct) ci')
callStatusItemContent :: ChatMonad m => User -> Contact -> ChatItemId -> WebRTCCallStatus -> m (Maybe ACIContent)
@@ -3989,7 +3990,8 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
ci' <- withStore' $ \db -> do
when changed $
addInitialAndNewCIVersions db (chatItemId' ci) (chatItemTs' ci, oldMC) (brokerTs, mc)
updateDirectChatItem' db user contactId ci content live $ Just msgId
reactions <- getDirectCIReactions db ct sharedMsgId
updateDirectChatItem' db user contactId ci {reactions} content live $ Just msgId
toView $ CRChatItemUpdated user (AChatItem SCTDirect SMDRcv (DirectChat ct) ci')
startUpdatedTimedItemThread user (ChatRef CTDirect contactId) ci ci'
else toView $ CRChatItemNotChanged user (AChatItem SCTDirect SMDRcv (DirectChat ct) ci)
@@ -4127,7 +4129,8 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
ci' <- withStore' $ \db -> do
when changed $
addInitialAndNewCIVersions db (chatItemId' ci) (chatItemTs' ci, oldMC) (brokerTs, mc)
updateGroupChatItem db user groupId ci content live $ Just msgId
reactions <- getGroupCIReactions db gInfo memberId sharedMsgId
updateGroupChatItem db user groupId ci {reactions} content live $ Just msgId
toView $ CRChatItemUpdated user (AChatItem SCTGroup SMDRcv (GroupChat gInfo) ci')
startUpdatedTimedItemThread user (ChatRef CTGroup groupId) ci ci'
else toView $ CRChatItemNotChanged user (AChatItem SCTGroup SMDRcv (GroupChat gInfo) ci)
@@ -4932,7 +4935,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
Just (CChatItem SMDSnd ChatItem {meta = CIMeta {itemId, itemStatus}})
| itemStatus == newStatus -> pure ()
| otherwise -> do
chatItem <- withStore $ \db -> updateDirectChatItemStatus db user contactId itemId newStatus
chatItem <- withStore $ \db -> updateDirectChatItemStatus db user ct itemId newStatus
toView $ CRChatItemStatusUpdated user (AChatItem SCTDirect SMDSnd (DirectChat ct) chatItem)
_ -> pure ()
@@ -4955,7 +4958,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
memStatusCounts <- withStore' (`getGroupSndStatusCounts` itemId)
let newStatus = membersGroupItemStatus memStatusCounts
when (newStatus /= itemStatus) $ do
chatItem <- withStore $ \db -> updateGroupChatItemStatus db user groupId itemId newStatus
chatItem <- withStore $ \db -> updateGroupChatItemStatus db user gInfo itemId newStatus
toView $ CRChatItemStatusUpdated user (AChatItem SCTGroup SMDSnd (GroupChat gInfo) chatItem)
_ -> pure ()
@@ -5198,9 +5201,7 @@ deliverMessage conn@Connection {connId} cmEventTag msgBody msgId = do
let msgFlags = MsgFlags {notification = hasNotification cmEventTag}
agentMsgId <- withAgent $ \a -> sendMessage a (aConnId conn) msgFlags msgBody
let sndMsgDelivery = SndMsgDelivery {connId, agentMsgId}
withStoreCtx'
(Just $ "createSndMsgDelivery, sndMsgDelivery: " <> show sndMsgDelivery <> ", msgId: " <> show msgId <> ", cmEventTag: " <> show cmEventTag <> ", msgDeliveryStatus: MDSSndAgent")
$ \db -> createSndMsgDelivery db sndMsgDelivery msgId
withStore' $ \db -> createSndMsgDelivery db sndMsgDelivery msgId
sendGroupMessage :: (MsgEncodingI e, ChatMonad m) => User -> GroupInfo -> [GroupMember] -> ChatMsgEvent e -> m (SndMessage, [GroupMember])
sendGroupMessage user GroupInfo {groupId} members chatMsgEvent =