Merge branch 'master' into remote-desktop

This commit is contained in:
Evgeny Poberezkin
2023-10-21 19:07:30 +01:00
41 changed files with 704 additions and 306 deletions
+14 -13
View File
@@ -604,11 +604,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)
@@ -669,11 +669,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)
@@ -780,8 +780,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
@@ -803,7 +804,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
@@ -2423,8 +2424,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)
@@ -4029,7 +4030,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)
@@ -4167,7 +4169,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)
@@ -4972,7 +4975,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 ()
@@ -4995,7 +4998,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 ()
@@ -5235,9 +5238,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 =
+3 -3
View File
@@ -1090,7 +1090,7 @@ instance ChatTypeI c => ToJSON (CIDeleted c) where
data JSONCIDeleted
= JCIDDeleted {deletedTs :: Maybe UTCTime, chatType :: ChatType}
| JCIBlocked {deletedTs :: Maybe UTCTime}
| JCIDBlocked {deletedTs :: Maybe UTCTime}
| JCIDModerated {deletedTs :: Maybe UTCTime, byGroupMember :: GroupMember}
deriving (Show, Generic)
@@ -1104,13 +1104,13 @@ instance ToJSON JSONCIDeleted where
jsonCIDeleted :: forall d. ChatTypeI d => CIDeleted d -> JSONCIDeleted
jsonCIDeleted = \case
CIDeleted ts -> JCIDDeleted ts (toChatType $ chatTypeI @d)
CIBlocked ts -> JCIBlocked ts
CIBlocked ts -> JCIDBlocked ts
CIModerated ts m -> JCIDModerated ts m
jsonACIDeleted :: JSONCIDeleted -> ACIDeleted
jsonACIDeleted = \case
JCIDDeleted ts cType -> case aChatType cType of ACT c -> ACIDeleted c $ CIDeleted ts
JCIBlocked ts -> ACIDeleted SCTGroup $ CIBlocked ts
JCIDBlocked ts -> ACIDeleted SCTGroup $ CIBlocked ts
JCIDModerated ts m -> ACIDeleted SCTGroup (CIModerated ts m)
itemDeletedTs :: CIDeleted d -> Maybe UTCTime
+44 -36
View File
@@ -15,7 +15,6 @@
module Simplex.Chat.Store.Messages
( getContactConnIds_,
getDirectChatReactions_,
-- * Message and chat item functions
deleteContactCIs,
@@ -68,9 +67,11 @@ module Simplex.Chat.Store.Messages
setGroupReaction,
getChatItemIdByAgentMsgId,
getDirectChatItem,
getDirectCIWithReactions,
getDirectChatItemBySharedMsgId,
getDirectChatItemByAgentMsgId,
getGroupChatItem,
getGroupCIWithReactions,
getGroupChatItemBySharedMsgId,
getGroupMemberCIBySharedMsgId,
getGroupChatItemByAgentMsgId,
@@ -755,7 +756,7 @@ getGroupChat :: DB.Connection -> User -> Int64 -> ChatPagination -> Maybe String
getGroupChat db user groupId pagination search_ = do
let search = fromMaybe "" search_
g <- getGroupInfo db user groupId
liftIO . getGroupChatReactions_ db g =<< case pagination of
case pagination of
CPLast count -> getGroupChatLast_ db user g count search
CPAfter afterId count -> getGroupChatAfter_ db user g afterId count search
CPBefore beforeId count -> getGroupChatBefore_ db user g beforeId count search
@@ -764,7 +765,7 @@ getGroupChatLast_ :: DB.Connection -> User -> GroupInfo -> Int -> String -> Exce
getGroupChatLast_ db user@User {userId} g@GroupInfo {groupId} count search = do
let stats = ChatStats {unreadCount = 0, minUnreadItemId = 0, unreadChat = False}
chatItemIds <- liftIO getGroupChatItemIdsLast_
chatItems <- mapM (getGroupChatItem db user groupId) chatItemIds
chatItems <- mapM (getGroupCIWithReactions db user g) chatItemIds
pure $ Chat (GroupChat g) (reverse chatItems) stats
where
getGroupChatItemIdsLast_ :: IO [ChatItemId]
@@ -802,7 +803,7 @@ getGroupChatAfter_ db user@User {userId} g@GroupInfo {groupId} afterChatItemId c
let stats = ChatStats {unreadCount = 0, minUnreadItemId = 0, unreadChat = False}
afterChatItem <- getGroupChatItem db user groupId afterChatItemId
chatItemIds <- liftIO $ getGroupChatItemIdsAfter_ (chatItemTs afterChatItem)
chatItems <- mapM (getGroupChatItem db user groupId) chatItemIds
chatItems <- mapM (getGroupCIWithReactions db user g) chatItemIds
pure $ Chat (GroupChat g) chatItems stats
where
getGroupChatItemIdsAfter_ :: UTCTime -> IO [ChatItemId]
@@ -825,7 +826,7 @@ getGroupChatBefore_ db user@User {userId} g@GroupInfo {groupId} beforeChatItemId
let stats = ChatStats {unreadCount = 0, minUnreadItemId = 0, unreadChat = False}
beforeChatItem <- getGroupChatItem db user groupId beforeChatItemId
chatItemIds <- liftIO $ getGroupChatItemIdsBefore_ (chatItemTs beforeChatItem)
chatItems <- mapM (getGroupChatItem db user groupId) chatItemIds
chatItems <- mapM (getGroupCIWithReactions db user g) chatItemIds
pure $ Chat (GroupChat g) (reverse chatItems) stats
where
getGroupChatItemIdsBefore_ :: UTCTime -> IO [ChatItemId]
@@ -1149,23 +1150,24 @@ getChatItemIdByAgentMsgId db connId msgId =
|]
(connId, msgId)
updateDirectChatItemStatus :: forall d. MsgDirectionI d => DB.Connection -> User -> Int64 -> ChatItemId -> CIStatus d -> ExceptT StoreError IO (ChatItem 'CTDirect d)
updateDirectChatItemStatus db user@User {userId} contactId itemId itemStatus = do
ci <- liftEither . correctDir =<< getDirectChatItem db user contactId itemId
updateDirectChatItemStatus :: forall d. MsgDirectionI d => DB.Connection -> User -> Contact -> ChatItemId -> CIStatus d -> ExceptT StoreError IO (ChatItem 'CTDirect d)
updateDirectChatItemStatus db user@User {userId} ct@Contact {contactId} itemId itemStatus = do
ci <- liftEither . correctDir =<< getDirectCIWithReactions db user ct itemId
currentTs <- liftIO getCurrentTime
liftIO $ DB.execute db "UPDATE chat_items SET item_status = ?, updated_at = ? WHERE user_id = ? AND contact_id = ? AND chat_item_id = ?" (itemStatus, currentTs, userId, contactId, itemId)
pure ci {meta = (meta ci) {itemStatus}}
where
correctDir :: CChatItem c -> Either StoreError (ChatItem c d)
correctDir (CChatItem _ ci) = first SEInternalError $ checkDirection ci
updateDirectChatItem :: forall d. MsgDirectionI d => DB.Connection -> User -> Int64 -> ChatItemId -> CIContent d -> Bool -> Maybe MessageId -> ExceptT StoreError IO (ChatItem 'CTDirect d)
updateDirectChatItem db user contactId itemId newContent live msgId_ = do
ci <- liftEither . correctDir =<< getDirectChatItem db user contactId itemId
updateDirectChatItem :: MsgDirectionI d => DB.Connection -> User -> Contact -> ChatItemId -> CIContent d -> Bool -> Maybe MessageId -> ExceptT StoreError IO (ChatItem 'CTDirect d)
updateDirectChatItem db user ct@Contact {contactId} itemId newContent live msgId_ = do
ci <- liftEither . correctDir =<< getDirectCIWithReactions db user ct itemId
liftIO $ updateDirectChatItem' db user contactId ci newContent live msgId_
where
correctDir :: CChatItem c -> Either StoreError (ChatItem c d)
correctDir (CChatItem _ ci) = first SEInternalError $ checkDirection ci
getDirectCIWithReactions :: DB.Connection -> User -> Contact -> ChatItemId -> ExceptT StoreError IO (CChatItem 'CTDirect)
getDirectCIWithReactions db user ct@Contact {contactId} itemId =
liftIO . directCIWithReactions db ct =<< getDirectChatItem db user contactId itemId
correctDir :: MsgDirectionI d => CChatItem c -> Either StoreError (ChatItem c d)
correctDir (CChatItem _ ci) = first SEInternalError $ checkDirection ci
updateDirectChatItem' :: forall d. MsgDirectionI d => DB.Connection -> User -> Int64 -> ChatItem 'CTDirect d -> CIContent d -> Bool -> Maybe MessageId -> IO (ChatItem 'CTDirect d)
updateDirectChatItem' db User {userId} contactId ci newContent live msgId_ = do
@@ -1303,7 +1305,7 @@ getDirectChatItemIdBySharedMsgId_ db userId contactId sharedMsgId =
getDirectChatItem :: DB.Connection -> User -> Int64 -> ChatItemId -> ExceptT StoreError IO (CChatItem 'CTDirect)
getDirectChatItem db User {userId} contactId itemId = ExceptT $ do
currentTs <- getCurrentTime
join <$> firstRow (toDirectChatItem currentTs) (SEChatItemNotFound itemId) getItem
firstRow' (toDirectChatItem currentTs) (SEChatItemNotFound itemId) getItem
where
getItem =
DB.query
@@ -1351,17 +1353,26 @@ getDirectChatItemIdByText' db User {userId} contactId msg =
|]
(userId, contactId, msg <> "%")
updateGroupChatItemStatus :: forall d. MsgDirectionI d => DB.Connection -> User -> GroupId -> ChatItemId -> CIStatus d -> ExceptT StoreError IO (ChatItem 'CTGroup d)
updateGroupChatItemStatus db user@User {userId} groupId itemId itemStatus = do
ci <- liftEither . correctDir =<< getGroupChatItem db user groupId itemId
updateGroupChatItemStatus :: MsgDirectionI d => DB.Connection -> User -> GroupInfo -> ChatItemId -> CIStatus d -> ExceptT StoreError IO (ChatItem 'CTGroup d)
updateGroupChatItemStatus db user@User {userId} g@GroupInfo {groupId} itemId itemStatus = do
ci <- liftEither . correctDir =<< getGroupCIWithReactions db user g itemId
currentTs <- liftIO getCurrentTime
liftIO $ DB.execute db "UPDATE chat_items SET item_status = ?, updated_at = ? WHERE user_id = ? AND group_id = ? AND chat_item_id = ?" (itemStatus, currentTs, userId, groupId, itemId)
pure ci {meta = (meta ci) {itemStatus}}
where
correctDir :: CChatItem c -> Either StoreError (ChatItem c d)
correctDir (CChatItem _ ci) = first SEInternalError $ checkDirection ci
updateGroupChatItem :: forall d. MsgDirectionI d => DB.Connection -> User -> Int64 -> ChatItem 'CTGroup d -> CIContent d -> Bool -> Maybe MessageId -> IO (ChatItem 'CTGroup d)
getGroupCIWithReactions :: DB.Connection -> User -> GroupInfo -> ChatItemId -> ExceptT StoreError IO (CChatItem 'CTGroup)
getGroupCIWithReactions db user g@GroupInfo {groupId} itemId = do
liftIO . groupCIWithReactions db g =<< getGroupChatItem db user groupId itemId
groupCIWithReactions :: DB.Connection -> GroupInfo -> CChatItem 'CTGroup -> IO (CChatItem 'CTGroup)
groupCIWithReactions db g cci@(CChatItem md ci@ChatItem {meta = CIMeta {itemSharedMsgId}}) = case itemSharedMsgId of
Just sharedMsgId -> do
let GroupMember {memberId} = chatItemMember g ci
reactions <- getGroupCIReactions db g memberId sharedMsgId
pure $ CChatItem md ci {reactions}
Nothing -> pure cci
updateGroupChatItem :: MsgDirectionI d => DB.Connection -> User -> Int64 -> ChatItem 'CTGroup d -> CIContent d -> Bool -> Maybe MessageId -> IO (ChatItem 'CTGroup d)
updateGroupChatItem db user groupId ci newContent live msgId_ = do
currentTs <- liftIO getCurrentTime
let ci' = updatedChatItem ci newContent live currentTs
@@ -1370,7 +1381,7 @@ updateGroupChatItem db user groupId ci newContent live msgId_ = do
-- this function assumes that the group item with correct chat direction already exists,
-- it should be checked before calling it
updateGroupChatItem_ :: forall d. MsgDirectionI d => DB.Connection -> User -> Int64 -> ChatItem 'CTGroup d -> Maybe MessageId -> IO ()
updateGroupChatItem_ :: MsgDirectionI d => DB.Connection -> User -> Int64 -> ChatItem 'CTGroup d -> Maybe MessageId -> IO ()
updateGroupChatItem_ db User {userId} groupId ChatItem {content, meta} msgId_ = do
let CIMeta {itemId, itemText, itemStatus, itemDeleted, itemEdited, itemTimed, itemLive, updatedAt} = meta
itemDeleted' = isJust itemDeleted
@@ -1501,7 +1512,7 @@ getGroupChatItemByAgentMsgId db user groupId connId msgId = do
getGroupChatItem :: DB.Connection -> User -> Int64 -> ChatItemId -> ExceptT StoreError IO (CChatItem 'CTGroup)
getGroupChatItem db User {userId, userContactId} groupId itemId = ExceptT $ do
currentTs <- getCurrentTime
join <$> firstRow (toGroupChatItem currentTs userContactId) (SEChatItemNotFound itemId) getItem
firstRow' (toGroupChatItem currentTs userContactId) (SEChatItemNotFound itemId) getItem
where
getItem =
DB.query
@@ -1671,18 +1682,15 @@ getChatItemVersions db itemId = do
getDirectChatReactions_ :: DB.Connection -> Contact -> Chat 'CTDirect -> IO (Chat 'CTDirect)
getDirectChatReactions_ db ct c@Chat {chatItems} = do
chatItems' <- forM chatItems $ \(CChatItem md ci@ChatItem {meta = CIMeta {itemSharedMsgId}}) -> do
reactions <- maybe (pure []) (getDirectCIReactions db ct) itemSharedMsgId
pure $ CChatItem md ci {reactions}
chatItems' <- mapM (directCIWithReactions db ct) chatItems
pure c {chatItems = chatItems'}
getGroupChatReactions_ :: DB.Connection -> GroupInfo -> Chat 'CTGroup -> IO (Chat 'CTGroup)
getGroupChatReactions_ db g c@Chat {chatItems} = do
chatItems' <- forM chatItems $ \(CChatItem md ci@ChatItem {meta = CIMeta {itemSharedMsgId}}) -> do
let GroupMember {memberId} = chatItemMember g ci
reactions <- maybe (pure []) (getGroupCIReactions db g memberId) itemSharedMsgId
directCIWithReactions :: DB.Connection -> Contact -> CChatItem 'CTDirect -> IO (CChatItem 'CTDirect)
directCIWithReactions db ct cci@(CChatItem md ci@ChatItem {meta = CIMeta {itemSharedMsgId}}) = case itemSharedMsgId of
Just sharedMsgId -> do
reactions <- getDirectCIReactions db ct sharedMsgId
pure $ CChatItem md ci {reactions}
pure c {chatItems = chatItems'}
Nothing -> pure cci
getDirectCIReactions :: DB.Connection -> Contact -> SharedMsgId -> IO [CIReactionCount]
getDirectCIReactions db Contact {contactId} itemSharedMsgId =