diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs index c7f91545d5..0d85d6a7cd 100644 --- a/src/Simplex/Chat.hs +++ b/src/Simplex/Chat.hs @@ -389,23 +389,24 @@ startChatController :: Bool -> Bool -> CM' (Async ()) startChatController mainApp enableSndFiles = do asks smpAgent >>= liftIO . resumeAgentClient unless mainApp $ chatWriteVar' subscriptionMode SMOnlyCreate - void $ forkIO restoreCalls + users <- fromRight [] <$> runExceptT (withStore' getUsers) + restoreCalls s <- asks agentAsync - readTVarIO s >>= maybe (start s) (pure . fst) + readTVarIO s >>= maybe (start s users) (pure . fst) where - start s = do + start s users = do a1 <- async agentSubscriber a2 <- if mainApp - then Just <$> async (subscribeUsers False) + then Just <$> async (subscribeUsers False users) else pure Nothing atomically . writeTVar s $ Just (a1, a2) if mainApp then do startXFTP xftpStartWorkers - void $ forkIO startFilesToReceive + void $ forkIO $ startFilesToReceive users startCleanupManager - void $ forkIO startExpireCIs + void $ forkIO $ startExpireCIs users else when enableSndFiles $ startXFTP xftpStartSndWorkers pure a1 @@ -421,17 +422,15 @@ startChatController mainApp enableSndFiles = do a <- Just <$> async (void $ runExceptT cleanupManager) atomically $ writeTVar cleanupAsync a _ -> pure () - startExpireCIs = do - users <- fromRight [] <$> runExceptT (withStore' getUsers) + startExpireCIs users = forM_ users $ \user -> do ttl <- fromRight Nothing <$> runExceptT (withStore' (`getChatItemTTL` user)) forM_ ttl $ \_ -> do startExpireCIThread user setExpireCIFlag user True -subscribeUsers :: Bool -> CM' () -subscribeUsers onlyNeeded = do - users <- fromRight [] <$> runExceptT (withStore' getUsers) +subscribeUsers :: Bool -> [User] -> CM' () +subscribeUsers onlyNeeded users = do let (us, us') = partition activeUser users vr <- chatVersionRange' subscribe vr us @@ -440,9 +439,8 @@ subscribeUsers onlyNeeded = do subscribe :: VersionRangeChat -> [User] -> CM' () subscribe vr = mapM_ $ runExceptT . subscribeUserConnections vr onlyNeeded Agent.subscribeConnections -startFilesToReceive :: CM' () -startFilesToReceive = do - users <- fromRight [] <$> runExceptT (withStore' getUsers) +startFilesToReceive :: [User] -> CM' () +startFilesToReceive users = do let (us, us') = partition activeUser users startReceive us startReceive us' @@ -634,10 +632,12 @@ processChatCommand' vr = \case lift $ when restoreChat restoreCalls lift $ withAgent' foregroundAgent chatWriteVar chatActivated True - when restoreChat $ lift $ do - void . forkIO $ subscribeUsers True - void . forkIO $ startFilesToReceive - setAllExpireCIFlags True + when restoreChat $ do + users <- withStore' getUsers + lift $ do + void . forkIO $ subscribeUsers True users + void . forkIO $ startFilesToReceive users + setAllExpireCIFlags True ok_ APISuspendChat t -> do chatWriteVar chatActivated False @@ -645,7 +645,7 @@ processChatCommand' vr = \case stopRemoteCtrl lift $ withAgent' (`suspendAgent` t) ok_ - ResubscribeAllConnections -> lift (subscribeUsers False) >> ok_ + ResubscribeAllConnections -> withStore' getUsers >>= lift . subscribeUsers False >> ok_ -- has to be called before StartChat SetTempFolder tf -> do createDirectoryIfMissing True tf