mirror of
https://github.com/simplex-chat/simplex-chat.git
synced 2026-05-14 19:05:27 +00:00
core: refactor chat item updates (#1611)
* core: refactor chat item updates * removed unused function * refactor * refactor
This commit is contained in:
Evgeny Poberezkin
committed by
GitHub
GitHub
parent
64fb1f0b85
commit
5e9b7366cc
+43
-43
@@ -341,7 +341,7 @@ processChatCommand = \case
|
||||
Nothing -> pure (MCSimple (ExtMsgContent mc fileInvitation_ (ttl' <$> timed_) (justTrue live)), Nothing)
|
||||
Just quotedItemId -> do
|
||||
CChatItem _ qci@ChatItem {meta = CIMeta {itemTs, itemSharedMsgId}, formattedText, file} <-
|
||||
withStore $ \db -> getDirectChatItem db userId chatId quotedItemId
|
||||
withStore $ \db -> getDirectChatItem db user chatId quotedItemId
|
||||
(origQmc, qd, sent) <- quoteData qci
|
||||
let msgRef = MsgRef {msgId = itemSharedMsgId, sentAt = itemTs, sent, memberId = Nothing}
|
||||
qmc = quoteContent origQmc file
|
||||
@@ -433,16 +433,16 @@ 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 live mc -> withUser $ \user@User {userId} -> withChatLock "updateChatItem" $ case cType of
|
||||
APIUpdateChatItem (ChatRef cType chatId) itemId live mc -> withUser $ \user -> withChatLock "updateChatItem" $ case cType of
|
||||
CTDirect -> do
|
||||
(ct@Contact {contactId, localDisplayName = c}, cci) <- withStore $ \db -> (,) <$> getContact db user chatId <*> getDirectChatItem db userId chatId itemId
|
||||
(ct@Contact {contactId, localDisplayName = c}, cci) <- withStore $ \db -> (,) <$> getContact db user chatId <*> getDirectChatItem db user chatId itemId
|
||||
assertDirectAllowed user MDSnd ct XMsgUpdate_
|
||||
case cci of
|
||||
CChatItem SMDSnd ci@ChatItem {meta = CIMeta {itemSharedMsgId, itemTimed, itemLive}, content = ciContent} -> do
|
||||
case (ciContent, itemSharedMsgId) of
|
||||
(CISndMsgContent _, Just itemSharedMId) -> do
|
||||
(SndMessage {msgId}, _) <- sendDirectContactMessage ct (XMsgUpdate itemSharedMId mc (ttl' <$> itemTimed) (justTrue . (live &&) =<< itemLive))
|
||||
ci' <- withStore $ \db -> updateDirectChatItem db userId contactId itemId (CISndMsgContent mc) live $ Just msgId
|
||||
ci' <- withStore' $ \db -> updateDirectChatItem' db user contactId ci (CISndMsgContent mc) live $ Just msgId
|
||||
startUpdatedTimedItemThread user (ChatRef CTDirect contactId) ci ci'
|
||||
setActive $ ActiveC c
|
||||
pure . CRChatItemUpdated $ AChatItem SCTDirect SMDSnd (DirectChat ct) ci'
|
||||
@@ -457,7 +457,7 @@ processChatCommand = \case
|
||||
case (ciContent, itemSharedMsgId) of
|
||||
(CISndMsgContent _, Just itemSharedMId) -> do
|
||||
SndMessage {msgId} <- sendGroupMessage gInfo ms (XMsgUpdate itemSharedMId mc (ttl' <$> itemTimed) (justTrue . (live &&) =<< itemLive))
|
||||
ci' <- withStore $ \db -> updateGroupChatItem db user groupId itemId (CISndMsgContent mc) live $ Just msgId
|
||||
ci' <- withStore' $ \db -> updateGroupChatItem db user groupId ci (CISndMsgContent mc) live $ Just msgId
|
||||
startUpdatedTimedItemThread user (ChatRef CTGroup groupId) ci ci'
|
||||
setActive $ ActiveG gName
|
||||
pure . CRChatItemUpdated $ AChatItem SCTGroup SMDSnd (GroupChat gInfo) ci'
|
||||
@@ -465,9 +465,9 @@ processChatCommand = \case
|
||||
CChatItem SMDRcv _ -> throwChatError CEInvalidChatItemUpdate
|
||||
CTContactRequest -> pure $ chatCmdError "not supported"
|
||||
CTContactConnection -> pure $ chatCmdError "not supported"
|
||||
APIDeleteChatItem (ChatRef cType chatId) itemId mode -> withUser $ \user@User {userId} -> withChatLock "deleteChatItem" $ case cType of
|
||||
APIDeleteChatItem (ChatRef cType chatId) itemId mode -> withUser $ \user -> withChatLock "deleteChatItem" $ case cType of
|
||||
CTDirect -> do
|
||||
(ct@Contact {localDisplayName = c}, ci@(CChatItem msgDir ChatItem {meta = CIMeta {itemSharedMsgId}})) <- withStore $ \db -> (,) <$> getContact db user chatId <*> getDirectChatItem db userId chatId itemId
|
||||
(ct@Contact {localDisplayName = c}, ci@(CChatItem msgDir ChatItem {meta = CIMeta {itemSharedMsgId}})) <- withStore $ \db -> (,) <$> getContact db user chatId <*> getDirectChatItem db user chatId itemId
|
||||
case (mode, msgDir, itemSharedMsgId) of
|
||||
(CIDMInternal, _, _) -> deleteDirectCI user ct ci True False
|
||||
(CIDMBroadcast, SMDSnd, Just itemSharedMId) -> do
|
||||
@@ -501,7 +501,7 @@ processChatCommand = \case
|
||||
let deleteAt = addUTCTime (realToFrac ttl) ts
|
||||
withStore' $ \db -> setDirectChatItemDeleteAt db user chatId itemId deleteAt
|
||||
startProximateTimedItemThread user (ChatRef CTDirect chatId, itemId) deleteAt
|
||||
withStore' $ \db -> updateDirectChatItemsRead db userId chatId fromToIds
|
||||
withStore' $ \db -> updateDirectChatItemsRead db user chatId fromToIds
|
||||
pure CRCmdOk
|
||||
CTGroup -> do
|
||||
timedItems <- withStore' $ \db -> getGroupUnreadTimedItems db user chatId fromToIds
|
||||
@@ -617,7 +617,7 @@ processChatCommand = \case
|
||||
`E.finally` liftIO (deleteContactRequest db userId connReqId)
|
||||
withAgent $ \a -> rejectContact a connId invId
|
||||
pure $ CRContactRequestRejected cReq
|
||||
APISendCallInvitation contactId callType -> withUser $ \user@User {userId} -> do
|
||||
APISendCallInvitation contactId callType -> withUser $ \user -> do
|
||||
-- party initiating call
|
||||
ct <- withStore $ \db -> getContact db user contactId
|
||||
assertDirectAllowed user MDSnd ct XCallInv_
|
||||
@@ -631,7 +631,7 @@ processChatCommand = \case
|
||||
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
|
||||
forM_ call_ $ \call -> updateCallItemStatus user ct call WCSDisconnected Nothing
|
||||
toView . CRNewChatItem $ AChatItem SCTDirect SMDSnd (DirectChat ct) ci
|
||||
pure CRCmdOk
|
||||
SendCallInvitation cName callType -> withUser $ \user -> do
|
||||
@@ -639,11 +639,11 @@ processChatCommand = \case
|
||||
processChatCommand $ APISendCallInvitation contactId callType
|
||||
APIRejectCall contactId ->
|
||||
-- party accepting call
|
||||
withCurrentCall contactId $ \userId ct Call {chatItemId, callState} -> case callState of
|
||||
withCurrentCall contactId $ \user ct Call {chatItemId, callState} -> case callState of
|
||||
CallInvitationReceived {} -> do
|
||||
let aciContent = ACIContent SMDRcv $ CIRcvCall CISCallRejected 0
|
||||
withStore' $ \db -> updateDirectChatItemsRead db userId contactId $ Just (chatItemId, chatItemId)
|
||||
updateDirectChatItemView userId ct chatItemId aciContent False Nothing $> Nothing
|
||||
withStore' $ \db -> updateDirectChatItemsRead db user contactId $ Just (chatItemId, chatItemId)
|
||||
updateDirectChatItemView user ct chatItemId aciContent False Nothing $> Nothing
|
||||
_ -> throwChatError . CECallState $ callStateTag callState
|
||||
APISendCallOffer contactId WebRTCCallOffer {callType, rtcSession} ->
|
||||
-- party accepting call
|
||||
@@ -967,12 +967,12 @@ processChatCommand = \case
|
||||
updateCIGroupInvitationStatus user
|
||||
pure $ CRUserAcceptedGroupSent g {membership = membership {memberStatus = GSMemAccepted}} Nothing
|
||||
where
|
||||
updateCIGroupInvitationStatus user@User {userId} = do
|
||||
updateCIGroupInvitationStatus user = do
|
||||
AChatItem _ _ cInfo ChatItem {content, meta = CIMeta {itemId}} <- withStore $ \db -> getChatItemByGroupId db user groupId
|
||||
case (cInfo, content) of
|
||||
(DirectChat ct, CIRcvGroupInvitation ciGroupInv memRole) -> do
|
||||
let aciContent = ACIContent SMDRcv $ CIRcvGroupInvitation ciGroupInv {status = CIGISAccepted} memRole
|
||||
updateDirectChatItemView userId ct itemId aciContent False Nothing
|
||||
updateDirectChatItemView user 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
|
||||
@@ -1337,8 +1337,8 @@ processChatCommand = \case
|
||||
isReady ct =
|
||||
let s = connStatus $ activeConn (ct :: Contact)
|
||||
in s == ConnReady || s == ConnSndReady
|
||||
withCurrentCall :: ContactId -> (UserId -> Contact -> Call -> m (Maybe Call)) -> m ChatResponse
|
||||
withCurrentCall ctId action = withUser $ \user@User {userId} -> do
|
||||
withCurrentCall :: ContactId -> (User -> Contact -> Call -> m (Maybe Call)) -> m ChatResponse
|
||||
withCurrentCall ctId action = withUser $ \user -> do
|
||||
ct <- withStore $ \db -> getContact db user ctId
|
||||
calls <- asks currentCalls
|
||||
withChatLock "currentCall" $
|
||||
@@ -1346,7 +1346,7 @@ processChatCommand = \case
|
||||
Nothing -> throwChatError CENoCurrentCall
|
||||
Just call@Call {contactId}
|
||||
| ctId == contactId -> do
|
||||
call_ <- action userId ct call
|
||||
call_ <- action user ct call
|
||||
case call_ of
|
||||
Just call' -> do
|
||||
unless (isRcvInvitation call') $ withStore' $ \db -> deleteCalls db user ctId
|
||||
@@ -1436,20 +1436,20 @@ deleteFile user CIFileInfo {filePath, fileId, fileStatus} =
|
||||
withFilesFolder :: (FilePath -> m ()) -> m ()
|
||||
withFilesFolder action = asks filesFolder >>= readTVarIO >>= mapM_ action
|
||||
|
||||
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 False msgId_
|
||||
updateCallItemStatus :: ChatMonad m => User -> Contact -> Call -> WebRTCCallStatus -> Maybe MessageId -> m ()
|
||||
updateCallItemStatus user ct Call {chatItemId} receivedStatus msgId_ = do
|
||||
aciContent_ <- callStatusItemContent user ct chatItemId receivedStatus
|
||||
forM_ aciContent_ $ \aciContent -> updateDirectChatItemView user ct chatItemId aciContent False msgId_
|
||||
|
||||
updateDirectChatItemView :: ChatMonad m => UserId -> Contact -> ChatItemId -> ACIContent -> Bool -> Maybe MessageId -> m ()
|
||||
updateDirectChatItemView userId ct@Contact {contactId} chatItemId (ACIContent msgDir ciContent) live msgId_ = do
|
||||
ci' <- withStore $ \db -> updateDirectChatItem db userId contactId chatItemId ciContent live 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_
|
||||
toView . CRChatItemUpdated $ AChatItem SCTDirect msgDir (DirectChat ct) ci'
|
||||
|
||||
callStatusItemContent :: ChatMonad m => UserId -> Contact -> ChatItemId -> WebRTCCallStatus -> m (Maybe ACIContent)
|
||||
callStatusItemContent userId Contact {contactId} chatItemId receivedStatus = do
|
||||
callStatusItemContent :: ChatMonad m => User -> Contact -> ChatItemId -> WebRTCCallStatus -> m (Maybe ACIContent)
|
||||
callStatusItemContent user Contact {contactId} chatItemId receivedStatus = do
|
||||
CChatItem msgDir ChatItem {meta = CIMeta {updatedAt}, content} <-
|
||||
withStore $ \db -> getDirectChatItem db userId contactId chatItemId
|
||||
withStore $ \db -> getDirectChatItem db user contactId chatItemId
|
||||
ts <- liftIO getCurrentTime
|
||||
let callDuration :: Int = nominalDiffTimeToSeconds (ts `diffUTCTime` updatedAt) `div'` 1
|
||||
callStatus = case content of
|
||||
@@ -1764,12 +1764,12 @@ startTimedItemThread user itemRef deleteAt = do
|
||||
atomically $ writeTVar threadTVar (Just tId)
|
||||
|
||||
deleteTimedItem :: ChatMonad m => User -> (ChatRef, ChatItemId) -> UTCTime -> m ()
|
||||
deleteTimedItem user@User {userId} (ChatRef cType chatId, itemId) deleteAt = do
|
||||
deleteTimedItem user (ChatRef cType chatId, itemId) deleteAt = do
|
||||
ts <- liftIO getCurrentTime
|
||||
threadDelay $ diffInMicros deleteAt ts
|
||||
case cType of
|
||||
CTDirect -> do
|
||||
(ct, ci) <- withStore $ \db -> (,) <$> getContact db user chatId <*> getDirectChatItem db userId chatId itemId
|
||||
(ct, ci) <- withStore $ \db -> (,) <$> getContact db user chatId <*> getDirectChatItem db user chatId itemId
|
||||
deleteDirectCI user ct ci True True >>= toView
|
||||
CTGroup -> do
|
||||
(gInfo, ci) <- withStore $ \db -> (,) <$> getGroupInfo db user chatId <*> getGroupChatItem db user chatId itemId
|
||||
@@ -2000,9 +2000,9 @@ processAgentMessage (Just user@User {userId}) corrId agentConnId agentMessage =
|
||||
SENT msgId -> do
|
||||
sentMsgDeliveryEvent conn msgId
|
||||
checkSndInlineFTComplete conn msgId
|
||||
withStore' (\db -> getDirectChatItemByAgentMsgId db userId contactId connId msgId) >>= \case
|
||||
withStore' (\db -> getDirectChatItemByAgentMsgId db user contactId connId msgId) >>= \case
|
||||
Just (CChatItem SMDSnd ci) -> do
|
||||
chatItem <- withStore $ \db -> updateDirectChatItemStatus db userId contactId (chatItemId' ci) CISSndSent
|
||||
chatItem <- withStore $ \db -> updateDirectChatItemStatus db user contactId (chatItemId' ci) CISSndSent
|
||||
toView $ CRChatItemStatusUpdated (AChatItem SCTDirect SMDSnd (DirectChat ct) chatItem)
|
||||
_ -> pure ()
|
||||
SWITCH qd phase cStats -> do
|
||||
@@ -2017,7 +2017,7 @@ processAgentMessage (Just user@User {userId}) corrId agentConnId agentMessage =
|
||||
MERR msgId err -> do
|
||||
chatItemId_ <- withStore' $ \db -> getChatItemIdByAgentMsgId db connId msgId
|
||||
forM_ chatItemId_ $ \chatItemId -> do
|
||||
chatItem <- withStore $ \db -> updateDirectChatItemStatus db userId contactId chatItemId (agentErrToItemStatus err)
|
||||
chatItem <- withStore $ \db -> updateDirectChatItemStatus db user contactId chatItemId (agentErrToItemStatus err)
|
||||
toView $ CRChatItemStatusUpdated (AChatItem SCTDirect SMDSnd (DirectChat ct) chatItem)
|
||||
ERR err -> do
|
||||
toView . CRChatError $ ChatErrorAgent err
|
||||
@@ -2484,7 +2484,7 @@ processAgentMessage (Just user@User {userId}) corrId agentConnId agentMessage =
|
||||
-- Chat item and update message which created it will have different sharedMsgId in this case...
|
||||
let timed_ = rcvContactCITimed ct ttl
|
||||
ci <- saveRcvChatItem' user (CDDirectRcv ct) msg (Just sharedMsgId) msgMeta content Nothing timed_ live
|
||||
ci' <- withStore $ \db -> updateDirectChatItem db userId contactId (chatItemId' ci) content live Nothing
|
||||
ci' <- withStore' $ \db -> updateDirectChatItem' db user contactId ci content live Nothing
|
||||
toView . CRChatItemUpdated $ AChatItem SCTDirect SMDRcv (DirectChat ct) ci'
|
||||
setActive $ ActiveC c
|
||||
_ -> throwError e
|
||||
@@ -2492,10 +2492,10 @@ processAgentMessage (Just user@User {userId}) corrId agentConnId agentMessage =
|
||||
content = CIRcvMsgContent mc
|
||||
live = fromMaybe False live_
|
||||
updateRcvChatItem = do
|
||||
CChatItem msgDir ci@ChatItem {meta = CIMeta {itemId}} <- withStore $ \db -> getDirectChatItemBySharedMsgId db userId contactId sharedMsgId
|
||||
CChatItem msgDir ci <- withStore $ \db -> getDirectChatItemBySharedMsgId db user contactId sharedMsgId
|
||||
case msgDir of
|
||||
SMDRcv -> do
|
||||
ci' <- withStore $ \db -> updateDirectChatItem db userId contactId itemId content live $ Just msgId
|
||||
ci' <- withStore' $ \db -> updateDirectChatItem' db user contactId ci content live $ Just msgId
|
||||
toView . CRChatItemUpdated $ AChatItem SCTDirect SMDRcv (DirectChat ct) ci'
|
||||
startUpdatedTimedItemThread user (ChatRef CTDirect contactId) ci ci'
|
||||
SMDSnd -> messageError "x.msg.update: contact attempted invalid message update"
|
||||
@@ -2509,7 +2509,7 @@ processAgentMessage (Just user@User {userId}) corrId agentConnId agentMessage =
|
||||
_ -> throwError e
|
||||
where
|
||||
deleteRcvChatItem = do
|
||||
ci@(CChatItem msgDir _) <- withStore $ \db -> getDirectChatItemBySharedMsgId db userId contactId sharedMsgId
|
||||
ci@(CChatItem msgDir _) <- withStore $ \db -> getDirectChatItemBySharedMsgId db user contactId sharedMsgId
|
||||
case msgDir of
|
||||
SMDRcv ->
|
||||
if featureAllowed SCFFullDelete forContact ct
|
||||
@@ -2548,7 +2548,7 @@ processAgentMessage (Just user@User {userId}) corrId agentConnId agentMessage =
|
||||
-- Chat item and update message which created it will have different sharedMsgId in this case...
|
||||
let timed_ = rcvGroupCITimed gInfo ttl_
|
||||
ci <- saveRcvChatItem' user (CDGroupRcv gInfo m) msg (Just sharedMsgId) msgMeta content Nothing timed_ live
|
||||
ci' <- withStore $ \db -> updateGroupChatItem db user groupId (chatItemId' ci) content live Nothing
|
||||
ci' <- withStore' $ \db -> updateGroupChatItem db user groupId ci content live Nothing
|
||||
toView . CRChatItemUpdated $ AChatItem SCTGroup SMDRcv (GroupChat gInfo) ci'
|
||||
setActive $ ActiveG g
|
||||
_ -> throwError e
|
||||
@@ -2556,12 +2556,12 @@ processAgentMessage (Just user@User {userId}) corrId agentConnId agentMessage =
|
||||
content = CIRcvMsgContent mc
|
||||
live = fromMaybe False live_
|
||||
updateRcvChatItem = do
|
||||
CChatItem msgDir ci@ChatItem {chatDir, meta = CIMeta {itemId}} <- withStore $ \db -> getGroupChatItemBySharedMsgId db user groupId groupMemberId sharedMsgId
|
||||
CChatItem msgDir ci@ChatItem {chatDir} <- withStore $ \db -> getGroupChatItemBySharedMsgId db user groupId groupMemberId sharedMsgId
|
||||
case (msgDir, chatDir) of
|
||||
(SMDRcv, CIGroupRcv m') ->
|
||||
if sameMemberId memberId m'
|
||||
then do
|
||||
ci' <- withStore $ \db -> updateGroupChatItem db user groupId itemId content live $ Just msgId
|
||||
ci' <- withStore' $ \db -> updateGroupChatItem db user groupId ci content live $ Just msgId
|
||||
toView . CRChatItemUpdated $ AChatItem SCTGroup SMDRcv (GroupChat gInfo) ci'
|
||||
setActive $ ActiveG g
|
||||
startUpdatedTimedItemThread user (ChatRef CTGroup groupId) ci ci'
|
||||
@@ -2833,7 +2833,7 @@ processAgentMessage (Just user@User {userId}) corrId agentConnId agentMessage =
|
||||
-- practically, this should not happen
|
||||
withStore' $ \db -> createCall db user call' $ chatItemTs' ci
|
||||
call_ <- atomically (TM.lookupInsert contactId call' calls)
|
||||
forM_ call_ $ \call -> updateCallItemStatus userId ct call WCSDisconnected Nothing
|
||||
forM_ call_ $ \call -> updateCallItemStatus user ct call WCSDisconnected Nothing
|
||||
toView . CRCallInvitation $ RcvCallInvitation {contact = ct, callType, sharedKey, callTs = chatItemTs' ci}
|
||||
toView . CRNewChatItem $ AChatItem SCTDirect SMDRcv (DirectChat ct) ci
|
||||
where
|
||||
@@ -2891,7 +2891,7 @@ processAgentMessage (Just user@User {userId}) corrId agentConnId agentMessage =
|
||||
xCallEnd ct callId msg msgMeta =
|
||||
msgCurrentCall ct callId "x.call.end" msg msgMeta $ \Call {chatItemId} -> do
|
||||
toView $ CRCallEnded ct
|
||||
(Nothing,) <$> callStatusItemContent userId ct chatItemId WCSDisconnected
|
||||
(Nothing,) <$> callStatusItemContent user ct chatItemId WCSDisconnected
|
||||
|
||||
msgCurrentCall :: Contact -> CallId -> Text -> RcvMessage -> MsgMeta -> (Call -> m (Maybe Call, Maybe ACIContent)) -> m ()
|
||||
msgCurrentCall ct@Contact {contactId = ctId'} callId' eventName RcvMessage {msgId} msgMeta action = do
|
||||
@@ -2911,7 +2911,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 False $ Just msgId
|
||||
updateDirectChatItemView user ct chatItemId aciContent False $ Just msgId
|
||||
|
||||
msgCallStateError :: Text -> Call -> m ()
|
||||
msgCallStateError eventName Call {callState} =
|
||||
|
||||
+82
-75
@@ -203,6 +203,7 @@ module Simplex.Chat.Store
|
||||
updateDirectChatItemStatus,
|
||||
updateDirectCIFileStatus,
|
||||
updateDirectChatItem,
|
||||
updateDirectChatItem',
|
||||
deleteDirectChatItem,
|
||||
markDirectChatItemDeleted,
|
||||
updateGroupChatItem,
|
||||
@@ -3189,7 +3190,7 @@ 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_live,
|
||||
item_sent, item_ts, item_content, item_text, item_status, shared_msg_id, created_at, updated_at, item_live, timed_ttl, timed_delete_at,
|
||||
-- quote
|
||||
quoted_shared_msg_id, quoted_sent_at, quoted_content, quoted_sent, quoted_member_id
|
||||
) VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
|
||||
@@ -3199,12 +3200,8 @@ createNewChatItem_ db User {userId} chatDirection msgId_ sharedMsgId ciContent q
|
||||
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, Maybe Bool)
|
||||
itemRow = (msgDirection @d, itemTs, ciContent, ciContentToText ciContent, ciCreateStatus ciContent, sharedMsgId) :. (createdAt, createdAt, timedTTL, timedDeleteAt, justTrue live)
|
||||
where
|
||||
(timedTTL, timedDeleteAt) = case timed of
|
||||
Just CITimed {ttl, deleteAt} -> (Just ttl, deleteAt)
|
||||
Nothing -> (Nothing, Nothing)
|
||||
itemRow :: (SMsgDirection d, UTCTime, CIContent d, Text, CIStatus d, Maybe SharedMsgId) :. (UTCTime, UTCTime, Maybe Bool) :. (Maybe Int, Maybe UTCTime)
|
||||
itemRow = (msgDirection @d, itemTs, ciContent, ciContentToText ciContent, ciCreateStatus ciContent, sharedMsgId) :. (createdAt, createdAt, justTrue live) :. ciTimedRow timed
|
||||
idsRow :: (Maybe Int64, Maybe Int64, Maybe Int64)
|
||||
idsRow = case chatDirection of
|
||||
CDDirectRcv Contact {contactId} -> (Just contactId, Nothing, Nothing)
|
||||
@@ -3212,6 +3209,10 @@ createNewChatItem_ db User {userId} chatDirection msgId_ sharedMsgId ciContent q
|
||||
CDGroupRcv GroupInfo {groupId} GroupMember {groupMemberId} -> (Nothing, Just groupId, Just groupMemberId)
|
||||
CDGroupSnd GroupInfo {groupId} -> (Nothing, Just groupId, Nothing)
|
||||
|
||||
ciTimedRow :: Maybe CITimed -> (Maybe Int, Maybe UTCTime)
|
||||
ciTimedRow (Just CITimed {ttl, deleteAt}) = (Just ttl, deleteAt)
|
||||
ciTimedRow _ = (Nothing, Nothing)
|
||||
|
||||
insertChatItemMessage_ :: DB.Connection -> ChatItemId -> MessageId -> UTCTime -> IO ()
|
||||
insertChatItemMessage_ db ciId msgId ts = DB.execute db "INSERT INTO chat_item_messages (chat_item_id, message_id, created_at, updated_at) VALUES (?,?,?,?)" (ciId, msgId, ts, ts)
|
||||
|
||||
@@ -3828,9 +3829,9 @@ getChatItemIdByAgentMsgId db connId msgId =
|
||||
|]
|
||||
(connId, msgId)
|
||||
|
||||
updateDirectChatItemStatus :: forall d. MsgDirectionI d => DB.Connection -> UserId -> Int64 -> ChatItemId -> CIStatus d -> ExceptT StoreError IO (ChatItem 'CTDirect d)
|
||||
updateDirectChatItemStatus db userId contactId itemId itemStatus = do
|
||||
ci <- liftEither . correctDir =<< getDirectChatItem db userId contactId itemId
|
||||
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
|
||||
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}}
|
||||
@@ -3838,41 +3839,49 @@ 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 -> Bool -> Maybe MessageId -> ExceptT StoreError IO (ChatItem 'CTDirect d)
|
||||
updateDirectChatItem db userId contactId itemId newContent live msgId_ = do
|
||||
currentTs <- liftIO getCurrentTime
|
||||
ci <- updateDirectChatItem_ db userId contactId itemId newContent live currentTs
|
||||
forM_ msgId_ $ \msgId -> liftIO $ insertChatItemMessage_ db itemId msgId currentTs
|
||||
pure ci
|
||||
|
||||
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 live currentTs = do
|
||||
ci@ChatItem {meta = meta@CIMeta {itemEdited, itemTimed, itemLive}} <- liftEither . correctDir =<< getDirectChatItem db userId contactId itemId
|
||||
let newText = ciContentToText newContent
|
||||
edited' = itemEdited || (itemLive /= Just True)
|
||||
live' = (live &&) <$> itemLive
|
||||
delAt' = ciLiveDeleteAt meta live currentTs
|
||||
timed' = (\timed -> timed {deleteAt = delAt'}) <$> itemTimed
|
||||
liftIO $ do
|
||||
DB.execute
|
||||
db
|
||||
[sql|
|
||||
UPDATE chat_items
|
||||
SET item_content = ?, item_text = ?, item_deleted = 0, item_edited = ?, timed_delete_at = ?, item_live = ?, updated_at = ?
|
||||
WHERE user_id = ? AND contact_id = ? AND chat_item_id = ?
|
||||
|]
|
||||
(newContent, newText, edited', delAt', live', currentTs, userId, contactId, itemId)
|
||||
pure ci {content = newContent, meta = meta {itemText = newText, itemEdited = edited', itemTimed = timed', itemLive = live'}, formattedText = parseMaybeMarkdownList newText}
|
||||
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
|
||||
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
|
||||
|
||||
-- the condition to enable the timed deletion when the item that was live is updated
|
||||
ciLiveDeleteAt :: CIMeta d -> Bool -> UTCTime -> Maybe UTCTime
|
||||
ciLiveDeleteAt CIMeta {itemTimed, itemStatus = CISRcvNew} _live _ = itemTimed >>= deleteAt
|
||||
ciLiveDeleteAt CIMeta {itemTimed = Just CITimed {ttl, deleteAt = Nothing}, itemLive = Just True} False currentTs =
|
||||
Just $ addUTCTime (realToFrac ttl) currentTs
|
||||
ciLiveDeleteAt CIMeta {itemTimed} _ _ = itemTimed >>= deleteAt
|
||||
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
|
||||
currentTs <- liftIO getCurrentTime
|
||||
let ci' = updatedChatItem ci newContent live currentTs
|
||||
liftIO $ updateDirectChatItem_ db userId contactId ci' msgId_
|
||||
pure ci'
|
||||
|
||||
updatedChatItem :: ChatItem c d -> CIContent d -> Bool -> UTCTime -> ChatItem c d
|
||||
updatedChatItem ci@ChatItem {meta = meta@CIMeta {itemStatus, itemEdited, itemTimed, itemLive}} newContent live currentTs =
|
||||
let newText = ciContentToText newContent
|
||||
edited' = itemEdited || (itemLive /= Just True)
|
||||
live' = (live &&) <$> itemLive
|
||||
timed' = case (itemStatus, itemTimed, itemLive, live) of
|
||||
(CISRcvNew, _, _, _) -> itemTimed
|
||||
(_, Just CITimed {ttl, deleteAt = Nothing}, Just True, False) ->
|
||||
-- timed item, sent or read, not set for deletion, was live, now not live
|
||||
let deleteAt' = addUTCTime (realToFrac ttl) currentTs
|
||||
in Just CITimed {ttl, deleteAt = Just deleteAt'}
|
||||
_ -> itemTimed
|
||||
in ci {content = newContent, meta = meta {itemText = newText, itemEdited = edited', itemTimed = timed', itemLive = live'}, formattedText = parseMaybeMarkdownList newText}
|
||||
|
||||
-- this function assumes that direct item with correct chat direction already exists,
|
||||
-- it should be checked before calling it
|
||||
updateDirectChatItem_ :: forall d. MsgDirectionI d => DB.Connection -> UserId -> Int64 -> ChatItem 'CTDirect d -> Maybe MessageId -> IO ()
|
||||
updateDirectChatItem_ db userId contactId ChatItem {meta, content} msgId_ = do
|
||||
let CIMeta {itemId, itemText, itemStatus, itemDeleted, itemEdited, itemTimed, itemLive, updatedAt} = meta
|
||||
DB.execute
|
||||
db
|
||||
[sql|
|
||||
UPDATE chat_items
|
||||
SET item_content = ?, item_text = ?, item_status = ?, item_deleted = ?, item_edited = ?, item_live = ?, updated_at = ?, timed_ttl = ?, timed_delete_at = ?
|
||||
WHERE user_id = ? AND contact_id = ? AND chat_item_id = ?
|
||||
|]
|
||||
((content, itemText, itemStatus, itemDeleted, itemEdited, itemLive, updatedAt) :. ciTimedRow itemTimed :. (userId, contactId, itemId))
|
||||
forM_ msgId_ $ \msgId -> liftIO $ insertChatItemMessage_ db itemId msgId updatedAt
|
||||
|
||||
deleteDirectChatItem :: DB.Connection -> User -> Contact -> CChatItem 'CTDirect -> IO ()
|
||||
deleteDirectChatItem db User {userId} Contact {contactId} (CChatItem _ ci) = do
|
||||
@@ -3915,15 +3924,15 @@ markDirectChatItemDeleted db User {userId} ct@Contact {contactId} (CChatItem msg
|
||||
(currentTs, userId, contactId, itemId)
|
||||
pure $ AChatItem SCTDirect msgDir (DirectChat ct) (ci {meta = (meta ci) {itemDeleted = True, editable = False}})
|
||||
|
||||
getDirectChatItemBySharedMsgId :: DB.Connection -> UserId -> ContactId -> SharedMsgId -> ExceptT StoreError IO (CChatItem 'CTDirect)
|
||||
getDirectChatItemBySharedMsgId db userId contactId sharedMsgId = do
|
||||
getDirectChatItemBySharedMsgId :: DB.Connection -> User -> ContactId -> SharedMsgId -> ExceptT StoreError IO (CChatItem 'CTDirect)
|
||||
getDirectChatItemBySharedMsgId db user@User {userId} contactId sharedMsgId = do
|
||||
itemId <- getDirectChatItemIdBySharedMsgId_ db userId contactId sharedMsgId
|
||||
getDirectChatItem db userId contactId itemId
|
||||
getDirectChatItem db user contactId itemId
|
||||
|
||||
getDirectChatItemByAgentMsgId :: DB.Connection -> UserId -> ContactId -> Int64 -> AgentMsgId -> IO (Maybe (CChatItem 'CTDirect))
|
||||
getDirectChatItemByAgentMsgId db userId contactId connId msgId = do
|
||||
getDirectChatItemByAgentMsgId :: DB.Connection -> User -> ContactId -> Int64 -> AgentMsgId -> IO (Maybe (CChatItem 'CTDirect))
|
||||
getDirectChatItemByAgentMsgId db user contactId connId msgId = do
|
||||
itemId_ <- getChatItemIdByAgentMsgId db connId msgId
|
||||
maybe (pure Nothing) (fmap eitherToMaybe . runExceptT . getDirectChatItem db userId contactId) itemId_
|
||||
maybe (pure Nothing) (fmap eitherToMaybe . runExceptT . getDirectChatItem db user contactId) itemId_
|
||||
|
||||
getDirectChatItemIdBySharedMsgId_ :: DB.Connection -> UserId -> Int64 -> SharedMsgId -> ExceptT StoreError IO Int64
|
||||
getDirectChatItemIdBySharedMsgId_ db userId contactId sharedMsgId =
|
||||
@@ -3939,8 +3948,8 @@ getDirectChatItemIdBySharedMsgId_ db userId contactId sharedMsgId =
|
||||
|]
|
||||
(userId, contactId, sharedMsgId)
|
||||
|
||||
getDirectChatItem :: DB.Connection -> UserId -> Int64 -> ChatItemId -> ExceptT StoreError IO (CChatItem 'CTDirect)
|
||||
getDirectChatItem db userId contactId itemId = ExceptT $ do
|
||||
getDirectChatItem :: DB.Connection -> User -> Int64 -> ChatItemId -> ExceptT StoreError IO (CChatItem 'CTDirect)
|
||||
getDirectChatItem db User {userId} contactId itemId = ExceptT $ do
|
||||
tz <- getCurrentTimeZone
|
||||
currentTs <- getCurrentTime
|
||||
join <$> firstRow (toDirectChatItem tz currentTs) (SEChatItemNotFound itemId) getItem
|
||||
@@ -3977,29 +3986,27 @@ getDirectChatItemIdByText db userId contactId msgDir quotedMsg =
|
||||
|]
|
||||
(userId, contactId, msgDir, quotedMsg <> "%")
|
||||
|
||||
updateGroupChatItem :: forall d. MsgDirectionI d => DB.Connection -> User -> Int64 -> ChatItemId -> CIContent d -> Bool -> Maybe MessageId -> ExceptT StoreError IO (ChatItem 'CTGroup d)
|
||||
updateGroupChatItem db user@User {userId} groupId itemId newContent live msgId_ = do
|
||||
ci@ChatItem {meta = meta@CIMeta {itemEdited, itemTimed, itemLive}} <- liftEither . correctDir =<< getGroupChatItem db user groupId itemId
|
||||
updateGroupChatItem :: forall d. 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 newText = ciContentToText newContent
|
||||
edited' = itemEdited || (itemLive /= Just True)
|
||||
live' = (live &&) <$> itemLive
|
||||
delAt' = ciLiveDeleteAt meta live currentTs
|
||||
timed' = (\timed -> timed {deleteAt = delAt'}) <$> itemTimed
|
||||
liftIO $ do
|
||||
DB.execute
|
||||
db
|
||||
[sql|
|
||||
UPDATE chat_items
|
||||
SET item_content = ?, item_text = ?, item_deleted = 0, item_edited = ?, timed_delete_at = ?, item_live = ?, updated_at = ?
|
||||
WHERE user_id = ? AND group_id = ? AND chat_item_id = ?
|
||||
|]
|
||||
(newContent, newText, edited', delAt', live', currentTs, userId, groupId, itemId)
|
||||
forM_ msgId_ $ \msgId -> insertChatItemMessage_ db itemId msgId currentTs
|
||||
pure ci {content = newContent, meta = meta {itemText = newText, itemEdited = edited', itemTimed = timed', itemLive = live'}, formattedText = parseMaybeMarkdownList newText}
|
||||
where
|
||||
correctDir :: CChatItem c -> Either StoreError (ChatItem c d)
|
||||
correctDir (CChatItem _ ci) = first SEInternalError $ checkDirection ci
|
||||
let ci' = updatedChatItem ci newContent live currentTs
|
||||
liftIO $ updateGroupChatItem_ db user groupId ci' msgId_
|
||||
pure ci'
|
||||
|
||||
-- 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_ db User {userId} groupId ChatItem {content, meta} msgId_ = do
|
||||
let CIMeta {itemId, itemText, itemStatus, itemDeleted, itemEdited, itemTimed, itemLive, updatedAt} = meta
|
||||
DB.execute
|
||||
db
|
||||
[sql|
|
||||
UPDATE chat_items
|
||||
SET item_content = ?, item_text = ?, item_status = ?, item_deleted = ?, item_deleted = 0, item_edited = ?, item_live = ?, updated_at = ?, timed_ttl = ?, timed_delete_at = ?
|
||||
WHERE user_id = ? AND group_id = ? AND chat_item_id = ?
|
||||
|]
|
||||
((content, itemText, itemStatus, itemDeleted, itemEdited, itemLive, updatedAt) :. ciTimedRow itemTimed :. (userId, groupId, itemId))
|
||||
forM_ msgId_ $ \msgId -> insertChatItemMessage_ db itemId msgId updatedAt
|
||||
|
||||
deleteGroupChatItem :: DB.Connection -> User -> GroupInfo -> CChatItem 'CTGroup -> IO ()
|
||||
deleteGroupChatItem db User {userId} GroupInfo {groupId} (CChatItem _ ci) = do
|
||||
@@ -4169,10 +4176,10 @@ getAChatItem db user@User {userId} itemId = do
|
||||
(_, _) -> Left $ SEBadChatItem itemId
|
||||
|
||||
getAChatItem_ :: DB.Connection -> User -> ChatItemId -> ChatRef -> ExceptT StoreError IO AChatItem
|
||||
getAChatItem_ db user@User {userId} itemId = \case
|
||||
getAChatItem_ db user itemId = \case
|
||||
ChatRef CTDirect contactId -> do
|
||||
ct <- getContact db user contactId
|
||||
(CChatItem msgDir ci) <- getDirectChatItem db userId contactId itemId
|
||||
(CChatItem msgDir ci) <- getDirectChatItem db user contactId itemId
|
||||
pure $ AChatItem SCTDirect msgDir (DirectChat ct) ci
|
||||
ChatRef CTGroup groupId -> do
|
||||
gInfo <- getGroupInfo db user groupId
|
||||
@@ -4195,8 +4202,8 @@ toChatItemRef = \case
|
||||
(itemId, Nothing, Just groupId) -> Right (itemId, ChatRef CTGroup groupId)
|
||||
(itemId, _, _) -> Left $ SEBadChatItem itemId
|
||||
|
||||
updateDirectChatItemsRead :: DB.Connection -> UserId -> ContactId -> Maybe (ChatItemId, ChatItemId) -> IO ()
|
||||
updateDirectChatItemsRead db userId contactId itemsRange_ = do
|
||||
updateDirectChatItemsRead :: DB.Connection -> User -> ContactId -> Maybe (ChatItemId, ChatItemId) -> IO ()
|
||||
updateDirectChatItemsRead db User {userId} contactId itemsRange_ = do
|
||||
currentTs <- getCurrentTime
|
||||
case itemsRange_ of
|
||||
Just (fromItemId, toItemId) ->
|
||||
|
||||
+1
-1
@@ -3471,7 +3471,7 @@ testUpdateGroupPrefs =
|
||||
alice #$> ("/_get chat #1 count=100", chat, [(0, "connected"), (1, "Full deletion: on"), (1, "Full deletion: off"), (1, "Voice messages: off"), (1, "Voice messages: on")])
|
||||
alice #> "#team hey"
|
||||
bob <# "#team alice> hey"
|
||||
threadDelay 500000
|
||||
threadDelay 1000000
|
||||
bob #> "#team hi"
|
||||
alice <# "#team bob> hi"
|
||||
threadDelay 500000
|
||||
|
||||
Reference in New Issue
Block a user