From 054b25499630c84531c728119e2ed1e1f624f94d Mon Sep 17 00:00:00 2001 From: Curtis Chin Jen Sem Date: Sun, 5 Apr 2026 22:07:34 +0200 Subject: [PATCH 1/4] Shutdown shake session prior to closing sqlite connection The shake session holds references to the sqlite connection. When the stop signal is given and the scope is exitted, the sqlite connections are closed, which outstanding threads may still be using. This leads to use-after-frees. Ensure the session is shutdown prior to leaving the worker scope. --- ghcide/src/Development/IDE/LSP/LanguageServer.hs | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/ghcide/src/Development/IDE/LSP/LanguageServer.hs b/ghcide/src/Development/IDE/LSP/LanguageServer.hs index ad21bc68f7..72720e302c 100644 --- a/ghcide/src/Development/IDE/LSP/LanguageServer.hs +++ b/ghcide/src/Development/IDE/LSP/LanguageServer.hs @@ -36,6 +36,7 @@ import UnliftIO.Directory import UnliftIO.Exception import qualified Colog.Core as Colog +import Control.Concurrent.Async (cancelMany) import Control.Concurrent.Extra (newBarrier, signalBarrier, waitBarrier) @@ -54,6 +55,7 @@ import Language.LSP.Server (LanguageContextEnv, LspServerLog, type (<~>)) import System.Timeout (timeout) + data Log = LogRegisteringIdeConfig !IdeConfiguration | LogReactorThreadException !SomeException @@ -332,7 +334,7 @@ handleInit lifecycleCtx env (TRequestMessage _ _ m params) = otTracedHandler "In putMVar ideMVar ide -- Keep this after putMVar ideMVar ide; otherwise shutdown during -- initialization could leave handleInit blocked indefinitely on readMVar. - untilReactorStopSignal $ forever $ do + untilReactorStopSignal $ flip finally (shutdown ide) $ forever $ do msg <- readChan $ ctxClientMsgChan lifecycleCtx -- We dispatch notifications synchronously and requests asynchronously -- This is to ensure that all file edits and config changes are applied before a request is handled From 94c8cc093d45a8989917156653e1b144c34329fe Mon Sep 17 00:00:00 2001 From: Curtis Chin Jen Sem Date: Wed, 8 Apr 2026 22:21:45 +0200 Subject: [PATCH 2/4] fixup! Shutdown shake session prior to closing sqlite connection --- .../src/Development/IDE/LSP/LanguageServer.hs | 33 +++++++++++-------- ghcide/src/Development/IDE/Main.hs | 4 +-- 2 files changed, 22 insertions(+), 15 deletions(-) diff --git a/ghcide/src/Development/IDE/LSP/LanguageServer.hs b/ghcide/src/Development/IDE/LSP/LanguageServer.hs index 72720e302c..ca137dabf3 100644 --- a/ghcide/src/Development/IDE/LSP/LanguageServer.hs +++ b/ghcide/src/Development/IDE/LSP/LanguageServer.hs @@ -36,12 +36,12 @@ import UnliftIO.Directory import UnliftIO.Exception import qualified Colog.Core as Colog -import Control.Concurrent.Async (cancelMany) import Control.Concurrent.Extra (newBarrier, signalBarrier, waitBarrier) import Control.Monad.IO.Unlift (MonadUnliftIO) -import Control.Monad.Trans.Cont (evalContT) +import Control.Monad.Trans.Cont (ContT (..), evalContT) +import Data.Foldable (traverse_) import Development.IDE.Core.IdeConfiguration import Development.IDE.Core.Service (shutdown) import Development.IDE.Core.Shake hiding (Log) @@ -293,9 +293,8 @@ handleInit lifecycleCtx env (TRequestMessage _ _ m params) = otTracedHandler "In ideMVar <- newEmptyMVar let - handleServerExceptionOrShutDown me = do + loggedTeardown me = do -- shutdown shake - tryReadMVar ideMVar >>= mapM_ shutdown case me of Left e -> do lifetimeConfirm "due to exception in reactor thread" @@ -328,13 +327,17 @@ handleInit lifecycleCtx env (TRequestMessage _ _ m params) = otTracedHandler "In $ \(e :: SomeException) -> do exceptionInHandler e k $ TResponseError (InR ErrorCodes_InternalError) (T.pack $ show e) Nothing - _ <- flip forkFinally handleServerExceptionOrShutDown $ do - runWithWorkerThreads (cmapWithPrio LogSession recorder) dbLoc $ \withHieDb' threadQueue' -> do + _ <- flip forkFinally loggedTeardown $ do + -- Need to be careful about when the shutdown occurs, it needs to be shut + -- down after the session loader and restarting threads, and before the + -- hiedb connections are closed. + let shutdownSession = tryReadMVar ideMVar >>= traverse_ shutdown + runWithWorkerThreads (cmapWithPrio LogSession recorder) dbLoc shutdownSession $ \withHieDb' threadQueue' -> do ide <- ctxGetIdeState lifecycleCtx env root withHieDb' threadQueue' putMVar ideMVar ide -- Keep this after putMVar ideMVar ide; otherwise shutdown during -- initialization could leave handleInit blocked indefinitely on readMVar. - untilReactorStopSignal $ flip finally (shutdown ide) $ forever $ do + untilReactorStopSignal $ forever $ do msg <- readChan $ ctxClientMsgChan lifecycleCtx -- We dispatch notifications synchronously and requests asynchronously -- This is to ensure that all file edits and config changes are applied before a request is handled @@ -351,12 +354,16 @@ handleInit lifecycleCtx env (TRequestMessage _ _ m params) = otTracedHandler "In -- | runWithWorkerThreads -- create several threads to run the session, db and session loader -- see Note [Serializing runs in separate thread] -runWithWorkerThreads :: Recorder (WithPriority Session.Log) -> FilePath -> (WithHieDb -> ThreadQueue -> IO ()) -> IO () -runWithWorkerThreads recorder dbLoc f = evalContT $ do - (WithHieDbShield hiedb, threadQueue) <- runWithDb recorder dbLoc - sessionRestartTQueue <- withWorkerQueueSimple (cmapWithPrio Session.LogSessionWorkerThread recorder) "RestartTQueue" - sessionLoaderTQueue <- withWorkerQueueSimple (cmapWithPrio Session.LogSessionWorkerThread recorder) "SessionLoaderTQueue" - liftIO $ f hiedb (ThreadQueue threadQueue sessionRestartTQueue sessionLoaderTQueue) +runWithWorkerThreads :: Recorder (WithPriority Session.Log) -> FilePath -> IO () -> (WithHieDb -> ThreadQueue -> IO ()) -> IO () +runWithWorkerThreads recorder dbLoc shutdownSession f = evalContT $ do + (WithHieDbShield hiedb, threadQueue) <- runWithDb recorder dbLoc + -- The shake session needs to be shut down prior to the hiedb connections + -- being cleaned up, otherwise shake could be referencing dead connections. + -- This is passed in via the callsites. + void $ ContT $ \action -> action () `finally` shutdownSession + sessionRestartTQueue <- withWorkerQueueSimple (cmapWithPrio Session.LogSessionWorkerThread recorder) "RestartTQueue" + sessionLoaderTQueue <- withWorkerQueueSimple (cmapWithPrio Session.LogSessionWorkerThread recorder) "SessionLoaderTQueue" + liftIO $ f hiedb (ThreadQueue threadQueue sessionRestartTQueue sessionLoaderTQueue) -- | Runs the action until it ends or until the given MVar is put. -- It is important, that the thread that puts the 'MVar' is not dropped before it puts the 'MVar' i.e. it should diff --git a/ghcide/src/Development/IDE/Main.hs b/ghcide/src/Development/IDE/Main.hs index 58cffe27e7..feb0050a79 100644 --- a/ghcide/src/Development/IDE/Main.hs +++ b/ghcide/src/Development/IDE/Main.hs @@ -378,7 +378,7 @@ defaultMain recorder Arguments{..} = withHeapStats (cmapWithPrio LogHeapStats re Check argFiles -> do let dir = argsProjectRoot dbLoc <- getHieDbLoc dir - runWithWorkerThreads (cmapWithPrio LogSession recorder) dbLoc $ \hiedb threadQueue -> do + runWithWorkerThreads (cmapWithPrio LogSession recorder) dbLoc mempty $ \hiedb threadQueue -> do -- GHC produces messages with UTF8 in them, so make sure the terminal doesn't error hSetEncoding stdout utf8 hSetEncoding stderr utf8 @@ -436,7 +436,7 @@ defaultMain recorder Arguments{..} = withHeapStats (cmapWithPrio LogHeapStats re Custom (IdeCommand c) -> do let root = argsProjectRoot dbLoc <- getHieDbLoc root - runWithWorkerThreads (cmapWithPrio LogSession recorder) dbLoc $ \hiedb threadQueue -> do + runWithWorkerThreads (cmapWithPrio LogSession recorder) dbLoc mempty $ \hiedb threadQueue -> do sessionLoader <- loadSessionWithOptions (cmapWithPrio LogSession recorder) argsSessionLoadingOptions "." (tLoaderQueue threadQueue) let def_options = argsIdeOptions argsDefaultHlsConfig sessionLoader ideOptions = def_options From b81cfa7db9f7b9b6c23f5b75abdaa39b7677ee7a Mon Sep 17 00:00:00 2001 From: Curtis Chin Jen Sem Date: Thu, 9 Apr 2026 11:10:29 +0200 Subject: [PATCH 3/4] fixup! fixup! Shutdown shake session prior to closing sqlite connection --- ghcide/src/Development/IDE/LSP/LanguageServer.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ghcide/src/Development/IDE/LSP/LanguageServer.hs b/ghcide/src/Development/IDE/LSP/LanguageServer.hs index ca137dabf3..7ccc4ac369 100644 --- a/ghcide/src/Development/IDE/LSP/LanguageServer.hs +++ b/ghcide/src/Development/IDE/LSP/LanguageServer.hs @@ -360,7 +360,7 @@ runWithWorkerThreads recorder dbLoc shutdownSession f = evalContT $ do -- The shake session needs to be shut down prior to the hiedb connections -- being cleaned up, otherwise shake could be referencing dead connections. -- This is passed in via the callsites. - void $ ContT $ \action -> action () `finally` shutdownSession + ContT $ \action -> action () `finally` shutdownSession sessionRestartTQueue <- withWorkerQueueSimple (cmapWithPrio Session.LogSessionWorkerThread recorder) "RestartTQueue" sessionLoaderTQueue <- withWorkerQueueSimple (cmapWithPrio Session.LogSessionWorkerThread recorder) "SessionLoaderTQueue" liftIO $ f hiedb (ThreadQueue threadQueue sessionRestartTQueue sessionLoaderTQueue) From aa81155aa299abd897d4ecc26aa3ec6e66eda647 Mon Sep 17 00:00:00 2001 From: Curtis Chin Jen Sem Date: Fri, 10 Apr 2026 14:26:54 +0200 Subject: [PATCH 4/4] Keep communication pipes alive for the entire test --- hls-test-utils/hls-test-utils.cabal | 1 + hls-test-utils/src/Test/Hls.hs | 33 ++++++++++++++++------------- 2 files changed, 19 insertions(+), 15 deletions(-) diff --git a/hls-test-utils/hls-test-utils.cabal b/hls-test-utils/hls-test-utils.cabal index cbe167ba1c..18aa56c740 100644 --- a/hls-test-utils/hls-test-utils.cabal +++ b/hls-test-utils/hls-test-utils.cabal @@ -50,6 +50,7 @@ library , lsp , lsp-test ^>=0.18 , lsp-types ^>=2.4 + , primitive , safe-exceptions , string-interpolate >= 0.3.1 , tasty diff --git a/hls-test-utils/src/Test/Hls.hs b/hls-test-utils/src/Test/Hls.hs index 3c0180bef1..63bfed3297 100644 --- a/hls-test-utils/src/Test/Hls.hs +++ b/hls-test-utils/src/Test/Hls.hs @@ -82,6 +82,7 @@ import Control.Lens.Extras (is) import Control.Monad (guard, unless, void) import Control.Monad.Extra (forM) import Control.Monad.IO.Class +import Control.Monad.Primitive (keepAlive) import Data.Aeson (Result (Success), Value (Null), fromJSON, toJSON) @@ -830,8 +831,8 @@ wrapClientLogger logger = do runSessionWithTestConfig :: Pretty b => TestConfig b -> (FilePath -> Session a) -> IO a runSessionWithTestConfig TestConfig{..} session = runSessionInVFS testDirLocation $ \root -> shiftRoot root $ do - (inR, inW) <- createPipe - (outR, outW) <- createPipe + pipeIn@(inR, inW) <- createPipe + pipeOut@(outR, outW) <- createPipe let serverRoot = fromMaybe root testServerRoot let clientRoot = fromMaybe root testClientRoot @@ -850,19 +851,21 @@ runSessionWithTestConfig TestConfig{..} session = timeoutOverride <- fmap read <$> lookupEnv "LSP_TIMEOUT" let sconf' = testConfigSession { lspConfig = hlsConfigToClientConfig testLspConfig, messageTimeout = fromMaybe (messageTimeout defaultConfig) timeoutOverride} arguments = testingArgs serverRoot recorderIde plugins - server <- async $ - IDEMain.defaultMain (cmapWithPrio LogIDEMain recorderIde) - arguments { argsHandleIn = pure inR , argsHandleOut = pure outW } - result <- runSessionWithHandles inW outR sconf' testConfigCaps clientRoot (session root) - hClose inW - timeout 3 (wait server) >>= \case - Just () -> pure () - Nothing -> do - logWith testRecorder Info (TestServerExitTimeoutSeconds 3) - (t, _) <- duration $ cancel server - logWith testRecorder Info (TestServerCancelFinished (showDuration t)) - logWith testRecorder Info TestRunFinished - pure result + + keepAlive (pipeIn, pipeOut) $ do + server <- async $ + IDEMain.defaultMain (cmapWithPrio LogIDEMain recorderIde) + arguments { argsHandleIn = pure inR , argsHandleOut = pure outW } + result <- runSessionWithHandles inW outR sconf' testConfigCaps clientRoot (session root) + hClose inW + timeout 3 (wait server) >>= \case + Just () -> pure () + Nothing -> do + logWith testRecorder Info (TestServerExitTimeoutSeconds 3) + (t, _) <- duration $ cancel server + logWith testRecorder Info (TestServerCancelFinished (showDuration t)) + logWith testRecorder Info TestRunFinished + pure result where shiftRoot shiftTarget f =