From 2a20f788772f87576bc4a0d56546b22ca5c98efd Mon Sep 17 00:00:00 2001 From: JRoberts <8711996+jr-simplex@users.noreply.github.com> Date: Tue, 24 Jan 2023 16:24:34 +0400 Subject: [PATCH] core: use batch connection deletion api (#1814) --- apps/ios/Shared/Model/SimpleXAPI.swift | 4 +- .../Views/UserSettings/UserProfilesView.swift | 2 +- apps/ios/SimpleXChat/APITypes.swift | 4 +- cabal.project | 2 +- scripts/nix/sha256map.nix | 2 +- src/Simplex/Chat.hs | 179 ++++++++++-------- src/Simplex/Chat/Controller.hs | 4 +- src/Simplex/Chat/Types.hs | 2 +- stack.yaml | 2 +- tests/ChatTests.hs | 31 ++- 10 files changed, 141 insertions(+), 91 deletions(-) diff --git a/apps/ios/Shared/Model/SimpleXAPI.swift b/apps/ios/Shared/Model/SimpleXAPI.swift index 35dbf0370c..20d6aaffde 100644 --- a/apps/ios/Shared/Model/SimpleXAPI.swift +++ b/apps/ios/Shared/Model/SimpleXAPI.swift @@ -145,8 +145,8 @@ func apiSetActiveUser(_ userId: Int64) throws -> User { throw r } -func apiDeleteUser(_ userId: Int64) throws { - let r = chatSendCmdSync(.apiDeleteUser(userId: userId)) +func apiDeleteUser(_ userId: Int64, _ delSMPQueues: Bool) throws { + let r = chatSendCmdSync(.apiDeleteUser(userId: userId, delSMPQueues: delSMPQueues)) if case .cmdOk = r { return } throw r } diff --git a/apps/ios/Shared/Views/UserSettings/UserProfilesView.swift b/apps/ios/Shared/Views/UserSettings/UserProfilesView.swift index adb75d6a10..a96bf501f4 100644 --- a/apps/ios/Shared/Views/UserSettings/UserProfilesView.swift +++ b/apps/ios/Shared/Views/UserSettings/UserProfilesView.swift @@ -66,7 +66,7 @@ struct UserProfilesView: View { private func removeUser(index: Int) { do { - try apiDeleteUser(m.users[index].user.userId) + try apiDeleteUser(m.users[index].user.userId, true) m.users.remove(at: index) } catch let error { let a = getErrorAlert(error, "Error deleting user profile") diff --git a/apps/ios/SimpleXChat/APITypes.swift b/apps/ios/SimpleXChat/APITypes.swift index eb03b9a27d..83ec0a766e 100644 --- a/apps/ios/SimpleXChat/APITypes.swift +++ b/apps/ios/SimpleXChat/APITypes.swift @@ -17,7 +17,7 @@ public enum ChatCommand { case createActiveUser(profile: Profile) case listUsers case apiSetActiveUser(userId: Int64) - case apiDeleteUser(userId: Int64) + case apiDeleteUser(userId: Int64, delSMPQueues: Bool) case startChat(subscribe: Bool, expire: Bool) case apiStopChat case apiActivateChat @@ -102,7 +102,7 @@ public enum ChatCommand { case let .createActiveUser(profile): return "/create user \(profile.displayName) \(profile.fullName)" case .listUsers: return "/users" case let .apiSetActiveUser(userId): return "/_user \(userId)" - case let .apiDeleteUser(userId): return "/_delete user \(userId)" + case let .apiDeleteUser(userId, delSMPQueues): return "/_delete user \(userId) delSMPQueues=\(onOff(delSMPQueues))" case let .startChat(subscribe, expire): return "/_start subscribe=\(onOff(subscribe)) expire=\(onOff(expire))" case .apiStopChat: return "/_stop" case .apiActivateChat: return "/_app activate" diff --git a/cabal.project b/cabal.project index 431f2b8afa..5b06cedbfd 100644 --- a/cabal.project +++ b/cabal.project @@ -7,7 +7,7 @@ constraints: zip +disable-bzip2 +disable-zstd source-repository-package type: git location: https://github.com/simplex-chat/simplexmq.git - tag: f66e8239f4dcaea37c760c82fecd7395de718294 + tag: d4fc638478a9dee69234ea0aaf212fee5cd0e323 source-repository-package type: git diff --git a/scripts/nix/sha256map.nix b/scripts/nix/sha256map.nix index 240c1b96f4..5ecb0b1353 100644 --- a/scripts/nix/sha256map.nix +++ b/scripts/nix/sha256map.nix @@ -1,5 +1,5 @@ { - "https://github.com/simplex-chat/simplexmq.git"."f66e8239f4dcaea37c760c82fecd7395de718294" = "00wycsq18z7mxmv85yhpvjvdj58msi8rnn0lafjr15pf2v0dalwf"; + "https://github.com/simplex-chat/simplexmq.git"."d4fc638478a9dee69234ea0aaf212fee5cd0e323" = "011ac45zxg9vwh12x8ykr3f1kyld8lj4lpnc5fs5b3978qcndhv2"; "https://github.com/simplex-chat/hs-socks.git"."a30cc7a79a08d8108316094f8f2f82a0c5e1ac51" = "0yasvnr7g91k76mjkamvzab2kvlb1g5pspjyjn2fr6v83swjhj38"; "https://github.com/simplex-chat/direct-sqlcipher.git"."34309410eb2069b029b8fc1872deb1e0db123294" = "0kwkmhyfsn2lixdlgl15smgr1h5gjk7fky6abzh8rng2h5ymnffd"; "https://github.com/simplex-chat/sqlcipher-simple.git"."5e154a2aeccc33ead6c243ec07195ab673137221" = "1d1gc5wax4vqg0801ajsmx1sbwvd9y7p7b8mmskvqsmpbwgbh0m0"; diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs index 2f8d5e7506..71fdf7a928 100644 --- a/src/Simplex/Chat.hs +++ b/src/Simplex/Chat.hs @@ -38,7 +38,7 @@ import Data.List.NonEmpty (NonEmpty, nonEmpty) import qualified Data.List.NonEmpty as L import Data.Map.Strict (Map) import qualified Data.Map.Strict as M -import Data.Maybe (fromMaybe, isJust, isNothing, listToMaybe, mapMaybe) +import Data.Maybe (catMaybes, fromMaybe, isJust, isNothing, listToMaybe, mapMaybe, maybeToList) import Data.Text (Text) import qualified Data.Text as T import Data.Time (NominalDiffTime, addUTCTime) @@ -306,7 +306,7 @@ processChatCommand = \case atomically . writeTVar u $ Just user pure $ CRActiveUser user SetActiveUser uName -> withUserName uName APISetActiveUser - APIDeleteUser userId -> do + APIDeleteUser userId delSMPQueues -> do user <- withStore (`getUser` userId) when (activeUser user) $ throwChatError (CECantDeleteActiveUser userId) users <- withStore' getUsers @@ -315,11 +315,11 @@ processChatCommand = \case filesInfo <- withStore' (`getUserFileInfo` user) withChatLock "deleteUser" . procCmd $ do forM_ filesInfo $ \fileInfo -> deleteFile user fileInfo - withAgent (`deleteUser` aUserId user) + withAgent $ \a -> deleteUser a (aUserId user) delSMPQueues withStore' (`deleteUserRecord` user) setActive ActiveNone ok_ - DeleteUser uName -> withUserName uName APIDeleteUser + DeleteUser uName delSMPQueues -> withUserName uName $ \uId -> APIDeleteUser uId delSMPQueues StartChat subConns enableExpireCIs -> withUser' $ \_ -> asks agentAsync >>= readTVarIO >>= \case Just _ -> pure CRChatRunning @@ -599,10 +599,10 @@ processChatCommand = \case CTDirect -> do ct@Contact {localDisplayName} <- withStore $ \db -> getContact db user chatId filesInfo <- withStore' $ \db -> getContactFileInfo db user ct - conns <- withStore $ \db -> getContactConnections db userId ct + contactConnIds <- map aConnId <$> withStore (\db -> getContactConnections db userId ct) withChatLock "deleteChat direct" . procCmd $ do - forM_ filesInfo $ \fileInfo -> deleteFile user fileInfo - forM_ conns $ \conn -> deleteAgentConnectionAsync user conn `catchError` \_ -> pure () + fileAgentConnIds <- concat <$> forM filesInfo (deleteFile user) + deleteAgentConnectionsAsync user $ fileAgentConnIds <> contactConnIds -- functions below are called in separate transactions to prevent crashes on android -- (possibly, race condition on integrity check?) withStore' $ \db -> deleteContactConnectionsAndFiles db userId ct @@ -610,8 +610,8 @@ processChatCommand = \case unsetActive $ ActiveC localDisplayName pure $ CRContactDeleted user ct CTContactConnection -> withChatLock "deleteChat contactConnection" . procCmd $ do - conn@PendingContactConnection {pccConnId, pccAgentConnId} <- withStore $ \db -> getPendingContactConnection db userId chatId - deleteAgentConnectionAsync' user pccConnId pccAgentConnId + conn@PendingContactConnection {pccAgentConnId = AgentConnId acId} <- withStore $ \db -> getPendingContactConnection db userId chatId + deleteAgentConnectionAsync user acId withStore' $ \db -> deletePendingContactConnection db userId chatId pure $ CRContactConnectionDeleted user conn CTGroup -> do @@ -620,10 +620,10 @@ processChatCommand = \case unless canDelete $ throwChatError CEGroupUserRole filesInfo <- withStore' $ \db -> getGroupFileInfo db user gInfo withChatLock "deleteChat group" . procCmd $ do - forM_ filesInfo $ \fileInfo -> deleteFile user fileInfo + deleteFilesAndConns user filesInfo when (memberActive membership) . void $ sendGroupMessage user gInfo members XGrpDel deleteGroupLink' user gInfo `catchError` \_ -> pure () - forM_ members $ deleteMemberConnection user + deleteMembersConnections user members -- functions below are called in separate transactions to prevent crashes on android -- (possibly, race condition on integrity check?) withStore' $ \db -> deleteGroupConnectionsAndFiles db user gInfo members @@ -640,20 +640,20 @@ processChatCommand = \case ctGroupId <- withStore' $ \db -> checkContactHasGroups db user ct when (isNothing ctGroupId) $ do conns <- withStore $ \db -> getContactConnections db userId ct - forM_ conns $ \conn -> deleteAgentConnectionAsync user conn `catchError` \_ -> pure () + deleteAgentConnectionsAsync user $ map aConnId conns withStore' $ \db -> deleteContactWithoutGroups db user ct CTContactRequest -> pure $ chatCmdError (Just user) "not supported" APIClearChat (ChatRef cType chatId) -> withUser $ \user -> case cType of CTDirect -> do ct <- withStore $ \db -> getContact db user chatId filesInfo <- withStore' $ \db -> getContactFileInfo db user ct - forM_ filesInfo $ \fileInfo -> deleteFile user fileInfo + deleteFilesAndConns user filesInfo withStore' $ \db -> deleteContactCIs db user ct pure $ CRChatCleared user (AChatInfo SCTDirect $ DirectChat ct) CTGroup -> do gInfo <- withStore $ \db -> getGroupInfo db user chatId filesInfo <- withStore' $ \db -> getGroupFileInfo db user gInfo - forM_ filesInfo $ \fileInfo -> deleteFile user fileInfo + deleteFilesAndConns user filesInfo withStore' $ \db -> deleteGroupCIs db user gInfo membersToDelete <- withStore' $ \db -> getGroupMembersForExpiration db user gInfo forM_ membersToDelete $ \m -> withStore' $ \db -> deleteGroupMember db user m @@ -975,7 +975,7 @@ processChatCommand = \case APIDeleteMyAddress userId -> withUserId userId $ \user -> withChatLock "deleteMyAddress" $ do conns <- withStore (`getUserAddressConnections` user) procCmd $ do - forM_ conns $ \conn -> deleteAgentConnectionAsync user conn `catchError` \_ -> pure () + deleteAgentConnectionsAsync user $ map aConnId conns withStore' (`deleteUserAddress` user) pure $ CRUserContactLinkDeleted user DeleteMyAddress -> withUser $ \User {userId} -> @@ -1139,7 +1139,7 @@ processChatCommand = \case -- TODO delete direct connections that were unused deleteGroupLink' user gInfo `catchError` \_ -> pure () -- member records are not deleted to keep history - forM_ members $ deleteMemberConnection user + deleteMembersConnections user members withStore' $ \db -> updateGroupMemberStatus db userId membership GSMemLeft pure $ CRLeftMemberUser user gInfo {membership = membership {memberStatus = GSMemLeft}} APIListMembers groupId -> withUser $ \user -> @@ -1259,7 +1259,8 @@ processChatCommand = \case withStore (\db -> getFileTransfer db user fileId) >>= \case FTSnd ftm@FileTransferMeta {cancelled} fts -> do unless cancelled $ do - cancelSndFile user ftm fts True + fileAgentConnIds <- cancelSndFile user ftm fts True + deleteAgentConnectionsAsync user fileAgentConnIds sharedMsgId <- withStore $ \db -> getSharedMsgIdByFileId db userId fileId withStore (\db -> getChatRefByFileId db user fileId) >>= \case ChatRef CTDirect contactId -> do @@ -1272,7 +1273,8 @@ processChatCommand = \case ci <- withStore $ \db -> getChatItemByFileId db user fileId pure $ CRSndGroupFileCancelled user ci ftm fts FTRcv ftr@RcvFileTransfer {cancelled} -> do - unless cancelled $ cancelRcvFileTransfer user ftr + unless cancelled $ + cancelRcvFileTransfer user ftr >>= mapM_ (deleteAgentConnectionAsync user) pure $ CRRcvFileCancelled user ftr FileStatus fileId -> withUser $ \user -> do fileStatus <- withStore $ \db -> getFileTransferProgress db user fileId @@ -1577,22 +1579,34 @@ setAllExpireCIFlags b = do keys <- M.keys <$> readTVar expireFlags forM_ keys $ \k -> TM.insert k b expireFlags -deleteFile :: forall m. ChatMonad m => User -> CIFileInfo -> m () +deleteFilesAndConns :: forall m. ChatMonad m => User -> [CIFileInfo] -> m () +deleteFilesAndConns user filesInfo = do + connIds <- mapM (deleteFile user) filesInfo + deleteAgentConnectionsAsync user $ concat connIds + +deleteFile :: forall m. ChatMonad m => User -> CIFileInfo -> m [ConnId] deleteFile user fileInfo = deleteFile' user fileInfo False -deleteFile' :: forall m. ChatMonad m => User -> CIFileInfo -> Bool -> m () -deleteFile' user CIFileInfo {filePath, fileId, fileStatus} sendCancel = - (cancel' >> delete) `catchError` (toView . CRChatError (Just user)) +deleteFile' :: forall m. ChatMonad m => User -> CIFileInfo -> Bool -> m [ConnId] +deleteFile' user CIFileInfo {filePath, fileId, fileStatus} sendCancel = do + aConnIds <- case fileStatus of + Just fStatus -> cancel' fStatus `catchError` (\e -> toView (CRChatError (Just user) e) >> pure []) + Nothing -> pure [] + delete `catchError` (toView . CRChatError (Just user)) + pure aConnIds where - cancel' = forM_ fileStatus $ \(AFS dir status) -> - unless (ciFileEnded status) $ - case dir of + cancel' :: ACIFileStatus -> m [ConnId] + cancel' (AFS dir status) = + if ciFileEnded status + then pure [] + else case dir of SMDSnd -> do (ftm@FileTransferMeta {cancelled}, fts) <- withStore (\db -> getSndFileTransfer db user fileId) - unless cancelled $ cancelSndFile user ftm fts sendCancel + if cancelled then pure [] else cancelSndFile user ftm fts sendCancel SMDRcv -> do ft@RcvFileTransfer {cancelled} <- withStore (\db -> getRcvFileTransfer db user fileId) - unless cancelled $ cancelRcvFileTransfer user ft + if cancelled then pure [] else maybeToList <$> cancelRcvFileTransfer user ft + delete :: m () delete = withFilesFolder $ \filesFolder -> forM_ filePath $ \fPath -> do let fsFilePath = filesFolder <> "/" <> fPath @@ -1763,7 +1777,7 @@ profileToSendOnAccept user ip = userProfileToSend user (getIncognitoProfile <$> deleteGroupLink' :: ChatMonad m => User -> GroupInfo -> m () deleteGroupLink' user gInfo = do conn <- withStore $ \db -> getGroupLinkConnection db user gInfo - deleteAgentConnectionAsync user conn `catchError` \_ -> pure () + deleteAgentConnectionAsync user $ aConnId conn withStore' $ \db -> deleteGroupLink db user gInfo agentSubscriber :: (MonadUnliftIO m, MonadReader ChatController m) => m () @@ -1980,12 +1994,12 @@ expireChatItems user@User {userId} ttl sync = do processContact :: UTCTime -> Contact -> m () processContact expirationDate ct = do filesInfo <- withStore' $ \db -> getContactExpiredFileInfo db user ct expirationDate - forM_ filesInfo $ \fileInfo -> deleteFile user fileInfo + deleteFilesAndConns user filesInfo withStore' $ \db -> deleteContactExpiredCIs db user ct expirationDate processGroup :: UTCTime -> UTCTime -> GroupInfo -> m () processGroup expirationDate createdAtCutoff gInfo = do filesInfo <- withStore' $ \db -> getGroupExpiredFileInfo db user gInfo expirationDate createdAtCutoff - forM_ filesInfo $ \fileInfo -> deleteFile user fileInfo + deleteFilesAndConns user filesInfo withStore' $ \db -> deleteGroupExpiredCIs db user gInfo expirationDate createdAtCutoff membersToDelete <- withStore' $ \db -> getGroupMembersForExpiration db user gInfo forM_ membersToDelete $ \m -> withStore' $ \db -> deleteGroupMember db user m @@ -2380,7 +2394,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do withStore' $ \db -> updateSndFileChunkSent db ft msgId unless (fileStatus == FSCancelled) $ sendFileChunk user ft MERR _ err -> do - cancelSndFileTransfer user ft True + cancelSndFileTransfer user ft True >>= mapM_ (deleteAgentConnectionAsync user) case err of SMP SMP.AUTH -> unless (fileStatus == FSCancelled) $ do ci <- withStore $ \db -> getChatItemByFileId db user fileId @@ -2459,7 +2473,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do receiveFileChunk ft@RcvFileTransfer {fileId, chunkSize, cancelled} conn_ MsgMeta {recipient = (msgId, _), integrity} = \case FileChunkCancel -> unless cancelled $ do - cancelRcvFileTransfer user ft + cancelRcvFileTransfer user ft >>= mapM_ (deleteAgentConnectionAsync user) toView $ CRRcvFileSndCancelled user ft FileChunk {chunkNo, chunkBytes = chunk} -> do case integrity of @@ -2485,7 +2499,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do getChatItemByFileId db user fileId toView $ CRRcvFileComplete user ci closeFileHandle fileId rcvFiles - mapM_ (deleteAgentConnectionAsync user) conn_ + forM_ conn_ $ \conn -> deleteAgentConnectionAsync user (aConnId conn) RcvChunkDuplicate -> pure () RcvChunkError -> badRcvFileChunk ft $ "incorrect chunk number " <> show chunkNo @@ -2592,7 +2606,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do badRcvFileChunk :: RcvFileTransfer -> String -> m () badRcvFileChunk ft@RcvFileTransfer {cancelled} err = unless cancelled $ do - cancelRcvFileTransfer user ft + cancelRcvFileTransfer user ft >>= mapM_ (deleteAgentConnectionAsync user) throwChatError $ CEFileRcvChunk err memberConnectedChatItem :: GroupInfo -> GroupMember -> m () @@ -2821,7 +2835,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do fileId <- withStore $ \db -> getFileIdBySharedMsgId db userId contactId sharedMsgId ft@RcvFileTransfer {cancelled} <- withStore (\db -> getRcvFileTransfer db user fileId) unless cancelled $ do - cancelRcvFileTransfer user ft + cancelRcvFileTransfer user ft >>= mapM_ (deleteAgentConnectionAsync user) toView $ CRRcvFileSndCancelled user ft xFileAcptInv :: Contact -> SharedMsgId -> Maybe ConnReqInvitation -> String -> MsgMeta -> m () @@ -2897,7 +2911,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do then do ft@RcvFileTransfer {cancelled} <- withStore (\db -> getRcvFileTransfer db user fileId) unless cancelled $ do - cancelRcvFileTransfer user ft + cancelRcvFileTransfer user ft >>= mapM_ (deleteAgentConnectionAsync user) toView $ CRRcvFileSndCancelled user ft else messageError "x.file.cancel: group member attempted to cancel file of another member" -- shouldn't happen now that query includes group member id (SMDSnd, _) -> messageError "x.file.cancel: group member attempted invalid file cancel" @@ -3250,7 +3264,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do then checkRole membership $ do deleteGroupLink' user gInfo `catchError` \_ -> pure () -- member records are not deleted to keep history - forM_ members $ deleteMemberConnection user + deleteMembersConnections user members withStore' $ \db -> updateGroupMemberStatus db userId membership GSMemRemoved deleteMemberItem RGEUserDeleted toView $ CRDeletedMemberUser user gInfo {membership = membership {memberStatus = GSMemRemoved}} m @@ -3292,7 +3306,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do updateGroupMemberStatus db userId membership GSMemGroupDeleted pure members -- member records are not deleted to keep history - forM_ ms $ deleteMemberConnection user + deleteMembersConnections user ms ci <- saveRcvChatItem user (CDGroupRcv gInfo m) msg msgMeta (CIRcvGroupEvent RGEGroupDeleted) groupMsgToView gInfo m ci msgMeta toView $ CRGroupDeleted user gInfo {membership = membership {memberStatus = GSMemGroupDeleted}} m @@ -3338,7 +3352,7 @@ parseAChatMessage :: ChatMonad m => ByteString -> m AChatMessage parseAChatMessage = liftEither . first (ChatError . CEInvalidChatMessage) . strDecode sendFileChunk :: ChatMonad m => User -> SndFileTransfer -> m () -sendFileChunk user ft@SndFileTransfer {fileId, fileStatus, connId, agentConnId} = +sendFileChunk user ft@SndFileTransfer {fileId, fileStatus, agentConnId = AgentConnId acId} = unless (fileStatus == FSComplete || fileStatus == FSCancelled) $ withStore' (`createSndFileChunk` ft) >>= \case Just chunkNo -> sendFileChunkNo ft chunkNo @@ -3349,7 +3363,7 @@ sendFileChunk user ft@SndFileTransfer {fileId, fileStatus, connId, agentConnId} updateDirectCIFileStatus db user fileId CIFSSndComplete toView $ CRSndFileComplete user ci ft closeFileHandle fileId sndFiles - deleteAgentConnectionAsync' user connId agentConnId + deleteAgentConnectionAsync user acId sendFileChunkNo :: ChatMonad m => SndFileTransfer -> Integer -> m () sendFileChunkNo ft@SndFileTransfer {agentConnId = AgentConnId acId} chunkNo = do @@ -3405,35 +3419,39 @@ isFileActive fileId files = do fs <- asks files isJust . M.lookup fileId <$> readTVarIO fs -cancelRcvFileTransfer :: ChatMonad m => User -> RcvFileTransfer -> m () -cancelRcvFileTransfer user ft@RcvFileTransfer {fileId, fileStatus, rcvFileInline} = do - closeFileHandle fileId rcvFiles - withStore' $ \db -> do - updateFileCancelled db user fileId CIFSRcvCancelled - updateRcvFileStatus db ft FSCancelled - deleteRcvFileChunks db ft - when (isNothing rcvFileInline) $ case fileStatus of - RFSAccepted RcvFileInfo {connId = Just connId, agentConnId = Just agentConnId} -> - deleteAgentConnectionAsync' user connId agentConnId - RFSConnected RcvFileInfo {connId = Just connId, agentConnId = Just agentConnId} -> - deleteAgentConnectionAsync' user connId agentConnId - _ -> pure () +cancelRcvFileTransfer :: ChatMonad m => User -> RcvFileTransfer -> m (Maybe ConnId) +cancelRcvFileTransfer user ft@RcvFileTransfer {fileId, rcvFileInline} = + cancel' `catchError` (\e -> toView (CRChatError (Just user) e) >> pure fileConnId) + where + cancel' = do + closeFileHandle fileId rcvFiles + withStore' $ \db -> do + updateFileCancelled db user fileId CIFSRcvCancelled + updateRcvFileStatus db ft FSCancelled + deleteRcvFileChunks db ft + pure fileConnId + fileConnId = if isNothing rcvFileInline then liveRcvFileTransferConnId ft else Nothing -cancelSndFile :: ChatMonad m => User -> FileTransferMeta -> [SndFileTransfer] -> Bool -> m () +cancelSndFile :: ChatMonad m => User -> FileTransferMeta -> [SndFileTransfer] -> Bool -> m [ConnId] cancelSndFile user FileTransferMeta {fileId} fts sendCancel = do - withStore' $ \db -> updateFileCancelled db user fileId CIFSSndCancelled - forM_ fts $ \ft' -> cancelSndFileTransfer user ft' sendCancel + withStore' (\db -> updateFileCancelled db user fileId CIFSSndCancelled) + `catchError` (toView . CRChatError (Just user)) + catMaybes <$> forM fts (\ft -> cancelSndFileTransfer user ft sendCancel) -cancelSndFileTransfer :: ChatMonad m => User -> SndFileTransfer -> Bool -> m () -cancelSndFileTransfer user ft@SndFileTransfer {connId, agentConnId = agentConnId@(AgentConnId acId), fileStatus, fileInline} sendCancel = - unless (fileStatus == FSCancelled || fileStatus == FSComplete) $ do - withStore' $ \db -> do - updateSndFileStatus db ft FSCancelled - deleteSndFileChunks db ft - when sendCancel $ - withAgent (\a -> void (sendMessage a acId SMP.noMsgFlags $ smpEncode FileChunkCancel)) - `catchError` (toView . CRChatError (Just user)) - when (isNothing fileInline) $ deleteAgentConnectionAsync' user connId agentConnId +cancelSndFileTransfer :: ChatMonad m => User -> SndFileTransfer -> Bool -> m (Maybe ConnId) +cancelSndFileTransfer user ft@SndFileTransfer {agentConnId = AgentConnId acId, fileStatus, fileInline} sendCancel = + if fileStatus == FSCancelled || fileStatus == FSComplete + then pure Nothing + else cancel' `catchError` (\e -> toView (CRChatError (Just user) e) >> pure fileConnId) + where + cancel' = do + withStore' $ \db -> do + updateSndFileStatus db ft FSCancelled + deleteSndFileChunks db ft + when sendCancel $ + withAgent (\a -> void (sendMessage a acId SMP.noMsgFlags $ smpEncode FileChunkCancel)) + pure fileConnId + fileConnId = if isNothing fileInline then Just acId else Nothing closeFileHandle :: ChatMonad m => Int64 -> (ChatController -> TVar (Map Int64 Handle)) -> m () closeFileHandle fileId files = do @@ -3444,10 +3462,16 @@ closeFileHandle fileId files = do throwChatError :: ChatMonad m => ChatErrorType -> m a throwChatError = throwError . ChatError +deleteMembersConnections :: ChatMonad m => User -> [GroupMember] -> m () +deleteMembersConnections user members = do + let memberConns = mapMaybe (\GroupMember {activeConn} -> activeConn) members + deleteAgentConnectionsAsync user $ map aConnId memberConns + forM_ memberConns $ \conn -> withStore' $ \db -> updateConnectionStatus db conn ConnDeleted + deleteMemberConnection :: ChatMonad m => User -> GroupMember -> m () deleteMemberConnection user GroupMember {activeConn} = do forM_ activeConn $ \conn -> do - deleteAgentConnectionAsync user conn `catchError` \_ -> pure () + deleteAgentConnectionAsync user $ aConnId conn withStore' $ \db -> updateConnectionStatus db conn ConnDeleted deleteOrUpdateMemberRecord :: ChatMonad m => User -> GroupMember -> m () @@ -3586,7 +3610,8 @@ deleteCIFile :: (ChatMonad m, MsgDirectionI d) => User -> Maybe (CIFile d) -> m deleteCIFile user file = forM_ file $ \CIFile {fileId, filePath, fileStatus} -> do let fileInfo = CIFileInfo {fileId, fileStatus = Just $ AFS msgDirection fileStatus, filePath} - deleteFile' user fileInfo True + fileAgentConnIds <- deleteFile' user fileInfo True + deleteAgentConnectionsAsync user fileAgentConnIds markDirectCIDeleted :: ChatMonad m => User -> Contact -> CChatItem 'CTDirect -> MessageId -> Bool -> m ChatResponse markDirectCIDeleted user ct ci@(CChatItem msgDir deletedItem) msgId byUser = do @@ -3622,14 +3647,14 @@ agentAcceptContactAsync user enableNtfs invId msg = do connId <- withAgent $ \a -> acceptContactAsync a (aCorrId cmdId) enableNtfs invId $ directMessage msg pure (cmdId, connId) -deleteAgentConnectionAsync :: ChatMonad m => User -> Connection -> m () -deleteAgentConnectionAsync user Connection {agentConnId, connId} = - deleteAgentConnectionAsync' user connId agentConnId +deleteAgentConnectionAsync :: ChatMonad m => User -> ConnId -> m () +deleteAgentConnectionAsync user acId = + withAgent (`deleteConnectionAsync` acId) `catchError` (toView . CRChatError (Just user)) -deleteAgentConnectionAsync' :: ChatMonad m => User -> Int64 -> AgentConnId -> m () -deleteAgentConnectionAsync' user connId (AgentConnId acId) = do - cmdId <- withStore' $ \db -> createCommand db user (Just connId) CFDeleteConn - withAgent $ \a -> deleteConnectionAsync a (aCorrId cmdId) acId +deleteAgentConnectionsAsync :: ChatMonad m => User -> [ConnId] -> m () +deleteAgentConnectionsAsync _ [] = pure () +deleteAgentConnectionsAsync user acIds = + withAgent (`deleteConnectionsAsync` acIds) `catchError` (toView . CRChatError (Just user)) userProfileToSend :: User -> Maybe Profile -> Maybe Contact -> Profile userProfileToSend user@User {profile = p} incognitoProfile ct = @@ -3840,8 +3865,8 @@ chatCommandP = "/users" $> ListUsers, "/_user " *> (APISetActiveUser <$> A.decimal), ("/user " <|> "/u ") *> (SetActiveUser <$> displayName), - "/_delete user " *> (APIDeleteUser <$> A.decimal), - "/delete user " *> (DeleteUser <$> displayName), + "/_delete user " *> (APIDeleteUser <$> A.decimal <* " delSMPQueues=" <*> onOffP), + "/delete user " *> (DeleteUser <$> displayName <*> pure True), ("/user" <|> "/u") $> ShowActiveUser, "/_start subscribe=" *> (StartChat <$> onOffP <* " expire=" <*> onOffP), "/_start" $> StartChat True True, diff --git a/src/Simplex/Chat/Controller.hs b/src/Simplex/Chat/Controller.hs index 85b0b0316d..0372ad86a2 100644 --- a/src/Simplex/Chat/Controller.hs +++ b/src/Simplex/Chat/Controller.hs @@ -181,8 +181,8 @@ data ChatCommand | ListUsers | APISetActiveUser UserId | SetActiveUser UserName - | APIDeleteUser UserId - | DeleteUser UserName + | APIDeleteUser UserId Bool + | DeleteUser UserName Bool | StartChat {subscribeConnections :: Bool, enableExpireChatItems :: Bool} | APIStopChat | APIActivateChat diff --git a/src/Simplex/Chat/Types.hs b/src/Simplex/Chat/Types.hs index fb1eb7f55b..15717672e0 100644 --- a/src/Simplex/Chat/Types.hs +++ b/src/Simplex/Chat/Types.hs @@ -1865,7 +1865,7 @@ data CommandFunction | CFAllowConn | CFAcceptContact | CFAckMessage - | CFDeleteConn + | CFDeleteConn -- not used deriving (Eq, Show, Generic) instance FromField CommandFunction where fromField = fromTextField_ textDecode diff --git a/stack.yaml b/stack.yaml index b92f4da791..d9ef82d1d9 100644 --- a/stack.yaml +++ b/stack.yaml @@ -49,7 +49,7 @@ extra-deps: # - simplexmq-1.0.0@sha256:34b2004728ae396e3ae449cd090ba7410781e2b3cefc59259915f4ca5daa9ea8,8561 # - ../simplexmq - github: simplex-chat/simplexmq - commit: f66e8239f4dcaea37c760c82fecd7395de718294 + commit: d4fc638478a9dee69234ea0aaf212fee5cd0e323 # - ../direct-sqlcipher - github: simplex-chat/direct-sqlcipher commit: 34309410eb2069b029b8fc1872deb1e0db123294 diff --git a/tests/ChatTests.hs b/tests/ChatTests.hs index 4321a93d34..55ce82849b 100644 --- a/tests/ChatTests.hs +++ b/tests/ChatTests.hs @@ -4585,9 +4585,13 @@ testDeleteUser = \alice bob cath -> do connectUsers alice bob - alice ##> "/_delete user 1" + -- cannot delete active user + + alice ##> "/_delete user 1 delSMPQueues=off" alice <## "cannot delete active user" + -- delete user without deleting SMP queues + alice ##> "/create user alisa" showActiveUser alice "alisa" @@ -4597,16 +4601,18 @@ testDeleteUser = alice <## "alice (Alice)" alice <## "alisa (active)" - alice ##> "/delete user alice" + alice ##> "/_delete user 1 delSMPQueues=off" alice <## "ok" alice ##> "/users" alice <## "alisa (active)" bob #> "@alice hey" - -- bob <## "[alice, contactId: 2, connId: 1] error: connection authorization failed - this could happen if connection was deleted, secured with different credentials, or due to a bug - please re-create the connection" + -- no connection authorization error - connection wasn't deleted (alice "/delete user alisa" alice <## "cannot delete active user" @@ -4615,6 +4621,25 @@ testDeleteUser = alice <##> cath + -- delete user deleting SMP queues + + alice ##> "/create user alisa2" + showActiveUser alice "alisa2" + + alice ##> "/users" + alice <## "alisa" + alice <## "alisa2 (active)" + + alice ##> "/delete user alisa" + alice <## "ok" + + alice ##> "/users" + alice <## "alisa2 (active)" + + cath #> "@alisa hey" + cath <## "[alisa, contactId: 2, connId: 1] error: connection authorization failed - this could happen if connection was deleted, secured with different credentials, or due to a bug - please re-create the connection" + (alice