From 58ad97fe6d9f83a9c53fff412e405ee91b2de36e Mon Sep 17 00:00:00 2001 From: spaced4ndy <8711996+spaced4ndy@users.noreply.github.com> Date: Mon, 8 Jan 2024 17:28:01 +0400 Subject: [PATCH] core: pause cleanup when chat is suspended (#3658) --- src/Simplex/Chat.hs | 25 +++++++++++++++++++------ src/Simplex/Chat/Controller.hs | 1 + 2 files changed, 20 insertions(+), 6 deletions(-) diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs index 2feb51fc1f..8fbd978c51 100644 --- a/src/Simplex/Chat.hs +++ b/src/Simplex/Chat.hs @@ -234,6 +234,7 @@ newChatController expireCIFlags <- newTVarIO M.empty cleanupManagerAsync <- newTVarIO Nothing timedItemThreads <- atomically TM.empty + chatActivated <- newTVarIO (not backgroundMode) showLiveItems <- newTVarIO False encryptLocalFiles <- newTVarIO False userXFTPFileConfig <- newTVarIO $ xftpFileConfig cfg @@ -269,6 +270,7 @@ newChatController expireCIFlags, cleanupManagerAsync, timedItemThreads, + chatActivated, showLiveItems, encryptLocalFiles, userXFTPFileConfig, @@ -554,6 +556,7 @@ processChatCommand' vr = \case APIActivateChat restoreChat -> withUser $ \_ -> do when restoreChat restoreCalls withAgent foregroundAgent + chatWriteVar chatActivated True when restoreChat $ do users <- withStoreCtx' (Just "APIActivateChat, getUsers") getUsers void . forkIO $ subscribeUsers True users @@ -561,6 +564,7 @@ processChatCommand' vr = \case setAllExpireCIFlags True ok_ APISuspendChat t -> do + chatWriteVar chatActivated False setAllExpireCIFlags False stopRemoteCtrl withAgent (`suspendAgent` t) @@ -2479,6 +2483,7 @@ startExpireCIThread user@User {userId} = do flip catchChatError (toView . CRChatError (Just user)) $ do expireFlags <- asks expireCIFlags atomically $ TM.lookup userId expireFlags >>= \b -> unless (b == Just True) retry + waitChatStartedAndActivated ttl <- withStoreCtx' (Just "startExpireCIThread, getChatItemTTL") (`getChatItemTTL` user) forM_ ttl $ \t -> expireChatItems user t False liftIO $ threadDelay' interval @@ -2972,7 +2977,7 @@ cleanupManager = do stepDelay <- asks (cleanupManagerStepDelay . config) forever $ do flip catchChatError (toView . CRChatError Nothing) $ do - waitChatStarted + waitChatStartedAndActivated users <- withStoreCtx' (Just "cleanupManager, getUsers 1") getUsers let (us, us') = partition activeUser users forM_ us $ cleanupUser interval stepDelay @@ -2982,7 +2987,7 @@ cleanupManager = do liftIO $ threadDelay' $ diffToMicroseconds interval where runWithoutInitialDelay cleanupInterval = flip catchChatError (toView . CRChatError Nothing) $ do - waitChatStarted + waitChatStartedAndActivated users <- withStoreCtx' (Just "cleanupManager, getUsers 2") getUsers let (us, us') = partition activeUser users forM_ us $ \u -> cleanupTimedItems cleanupInterval u `catchChatError` (toView . CRChatError (Just u)) @@ -3037,7 +3042,7 @@ deleteTimedItem :: ChatMonad m => User -> (ChatRef, ChatItemId) -> UTCTime -> m deleteTimedItem user (ChatRef cType chatId, itemId) deleteAt = do ts <- liftIO getCurrentTime liftIO $ threadDelay' $ diffToMicroseconds $ diffUTCTime deleteAt ts - waitChatStarted + waitChatStartedAndActivated vr <- chatVersionRange case cType of CTDirect -> do @@ -3063,8 +3068,10 @@ expireChatItems user@User {userId} ttl sync = do let expirationDate = addUTCTime (-1 * fromIntegral ttl) currentTs -- this is to keep group messages created during last 12 hours even if they're expired according to item_ts createdAtCutoff = addUTCTime (-43200 :: NominalDiffTime) currentTs + waitChatStartedAndActivated contacts <- withStoreCtx' (Just "expireChatItems, getUserContacts") (`getUserContacts` user) loop contacts $ processContact expirationDate + waitChatStartedAndActivated groups <- withStoreCtx' (Just "expireChatItems, getUserGroupDetails") (\db -> getUserGroupDetails db vr user Nothing Nothing) loop groups $ processGroup expirationDate createdAtCutoff where @@ -3083,11 +3090,13 @@ expireChatItems user@User {userId} ttl sync = do when (expire == Just True) $ threadDelay 100000 >> a processContact :: UTCTime -> Contact -> m () processContact expirationDate ct = do + waitChatStartedAndActivated filesInfo <- withStoreCtx' (Just "processContact, getContactExpiredFileInfo") $ \db -> getContactExpiredFileInfo db user ct expirationDate deleteFilesAndConns user filesInfo withStoreCtx' (Just "processContact, deleteContactExpiredCIs") $ \db -> deleteContactExpiredCIs db user ct expirationDate processGroup :: UTCTime -> UTCTime -> GroupInfo -> m () processGroup expirationDate createdAtCutoff gInfo = do + waitChatStartedAndActivated filesInfo <- withStoreCtx' (Just "processGroup, getGroupExpiredFileInfo") $ \db -> getGroupExpiredFileInfo db user gInfo expirationDate createdAtCutoff deleteFilesAndConns user filesInfo withStoreCtx' (Just "processGroup, deleteGroupExpiredCIs") $ \db -> deleteGroupExpiredCIs db user gInfo expirationDate createdAtCutoff @@ -6113,10 +6122,14 @@ checkSameUser userId User {userId = activeUserId} = when (userId /= activeUserId chatStarted :: ChatMonad m => m Bool chatStarted = fmap isJust . readTVarIO =<< asks agentAsync -waitChatStarted :: ChatMonad m => m () -waitChatStarted = do +waitChatStartedAndActivated :: ChatMonad m => m () +waitChatStartedAndActivated = do agentStarted <- asks agentAsync - atomically $ readTVar agentStarted >>= \a -> unless (isJust a) retry + chatActivated <- asks chatActivated + atomically $ do + started <- readTVar agentStarted + activated <- readTVar chatActivated + unless (isJust started && activated) retry chatVersionRange :: ChatMonad' m => m VersionRange chatVersionRange = do diff --git a/src/Simplex/Chat/Controller.hs b/src/Simplex/Chat/Controller.hs index 52181b3c9e..faf3a21a03 100644 --- a/src/Simplex/Chat/Controller.hs +++ b/src/Simplex/Chat/Controller.hs @@ -200,6 +200,7 @@ data ChatController = ChatController expireCIThreads :: TMap UserId (Maybe (Async ())), expireCIFlags :: TMap UserId Bool, cleanupManagerAsync :: TVar (Maybe (Async ())), + chatActivated :: TVar Bool, timedItemThreads :: TMap (ChatRef, ChatItemId) (TVar (Maybe (Weak ThreadId))), showLiveItems :: TVar Bool, encryptLocalFiles :: TVar Bool,