Skip to content

Commit

Permalink
Unhandled exceptions fixed (#2504)
Browse files Browse the repository at this point in the history 
* Revert "Revert "Send unhandled exceptions to the user (#2484)" (#2497)"

This reverts commit 5d2189c.

* Log when reactor thread exits

* log shakeSessionInit

* Do not assume that the build has been initialized
  • Loading branch information
@pepeiborra
pepeiborra authored Dec 19, 2021
1 parent 22540be commit c0d8a3b
Show file tree
Hide file tree
Showing 3 changed files with 77 additions and 56 deletions.
3 changes: 0 additions & 3 deletions ghcide/src/Development/IDE/Core/Rules.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -150,9 +150,6 @@ import Ide.Types (DynFlagsModificat
PluginId)
import Control.Concurrent.STM.Stats (atomically)
import Language.LSP.Server (LspT)
import System.Environment (getExecutablePath)
import System.Process.Extra (readProcessWithExitCode)
import Text.Read (readMaybe)
import System.Info.Extra (isMac)
import HIE.Bios.Ghc.Gap (hostIsDynamic)

Expand Down
10 changes: 6 additions & 4 deletions ghcide/src/Development/IDE/Core/Shake.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -154,7 +154,7 @@ import Data.Aeson (toJSON)
import qualified Data.ByteString.Char8 as BS8
import Data.Coerce (coerce)
import Data.Default
import Data.Foldable (toList)
import Data.Foldable (for_, toList)
import Data.HashSet (HashSet)
import qualified Data.HashSet as HSet
import Data.String (fromString)
Expand Down Expand Up @@ -583,15 +583,17 @@ startTelemetry db extras@ShakeExtras{..}

-- | Must be called in the 'Initialized' handler and only once
shakeSessionInit :: IdeState -> IO ()
shakeSessionInit IdeState{..} = do
shakeSessionInit ide@IdeState{..} = do
initSession <- newSession shakeExtras shakeDb [] "shakeSessionInit"
putMVar shakeSession initSession
logDebug (ideLogger ide) "Shake session initialized"

shakeShut :: IdeState -> IO ()
shakeShut IdeState{..} = withMVar shakeSession $ \runner -> do
shakeShut IdeState{..} = do
runner <- tryReadMVar shakeSession
-- Shake gets unhappy if you try to close when there is a running
-- request so we first abort that.
void $ cancelShakeSession runner
for_ runner cancelShakeSession
void $ shakeDatabaseProfile shakeDb
shakeClose
progressStop $ progress shakeExtras
Expand Down
120 changes: 71 additions & 49 deletions ghcide/src/Development/IDE/LSP/LanguageServer.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -38,8 +38,12 @@ import Development.IDE.Core.Tracing
import Development.IDE.LSP.HoverDefinition
import Development.IDE.Types.Logger

import Control.Monad.IO.Unlift (MonadUnliftIO)
import System.IO.Unsafe (unsafeInterleaveIO)

issueTrackerUrl :: T.Text
issueTrackerUrl = "https://github.com/haskell/haskell-language-server/issues"

runLanguageServer
:: forall config. (Show config)
=> LSP.Options
Expand All @@ -54,11 +58,16 @@ runLanguageServer
runLanguageServer options inH outH getHieDbLoc defaultConfig onConfigurationChange userHandlers getIdeState = do

-- This MVar becomes full when the server thread exits or we receive exit message from client.
-- LSP loop will be canceled when it's full.
-- LSP server will be canceled when it's full.
clientMsgVar <- newEmptyMVar
-- Forcefully exit
let exit = void $ tryPutMVar clientMsgVar ()

-- An MVar to control the lifetime of the reactor loop.
-- The loop will be stopped and resources freed when it's full
reactorLifetime <- newEmptyMVar
let stopReactorLoop = void $ tryPutMVar reactorLifetime ()

-- The set of requests ids that we have received but not finished processing
pendingRequests <- newTVarIO Set.empty
-- The set of requests that have been cancelled and are also in pendingRequests
Expand Down Expand Up @@ -93,7 +102,7 @@ runLanguageServer options inH outH getHieDbLoc defaultConfig onConfigurationChan
[ ideHandlers
, cancelHandler cancelRequest
, exitHandler exit
, shutdownHandler
, shutdownHandler stopReactorLoop
]
-- Cancel requests are special since they need to be handled
-- out of order to be useful. Existing handlers are run afterwards.
Expand All @@ -102,25 +111,23 @@ runLanguageServer options inH outH getHieDbLoc defaultConfig onConfigurationChan
let serverDefinition = LSP.ServerDefinition
{ LSP.onConfigurationChange = onConfigurationChange
, LSP.defaultConfig = defaultConfig
, LSP.doInitialize = handleInit exit clearReqId waitForCancel clientMsgChan
, LSP.doInitialize = handleInit reactorLifetime exit clearReqId waitForCancel clientMsgChan
, LSP.staticHandlers = asyncHandlers
, LSP.interpretHandler = \(env, st) -> LSP.Iso (LSP.runLspT env . flip runReaderT (clientMsgChan,st)) liftIO
, LSP.options = modifyOptions options
}

void $ waitAnyCancel =<< traverse async
[ void $ LSP.runServerWithHandles
void $ untilMVar clientMsgVar $
void $ LSP.runServerWithHandles
inH
outH
serverDefinition
, void $ readMVar clientMsgVar
]

where
handleInit
:: IO () -> (SomeLspId -> IO ()) -> (SomeLspId -> IO ()) -> Chan ReactorMessage
:: MVar () -> IO () -> (SomeLspId -> IO ()) -> (SomeLspId -> IO ()) -> Chan ReactorMessage
-> LSP.LanguageContextEnv config -> RequestMessage Initialize -> IO (Either err (LSP.LanguageContextEnv config, IdeState))
handleInit exitClientMsg clearReqId waitForCancel clientMsgChan env (RequestMessage _ _ m params) = otTracedHandler "Initialize" (show m) $ \sp -> do
handleInit lifetime exitClientMsg clearReqId waitForCancel clientMsgChan env (RequestMessage _ _ m params) = otTracedHandler "Initialize" (show m) $ \sp -> do
traceWithSpan sp params
let root = LSP.resRootPath env
dir <- maybe getCurrentDirectory return root
Expand All @@ -138,58 +145,73 @@ runLanguageServer options inH outH getHieDbLoc defaultConfig onConfigurationChan
registerIdeConfiguration (shakeExtras ide) initConfig

let handleServerException (Left e) = do
logError (ideLogger ide) $
logError logger $
T.pack $ "Fatal error in server thread: " <> show e
sendErrorMessage e
exitClientMsg
handleServerException _ = pure ()
handleServerException (Right _) = pure ()

sendErrorMessage (e :: SomeException) = do
LSP.runLspT env $ LSP.sendNotification SWindowShowMessage $
ShowMessageParams MtError $ T.unlines
[ "Unhandled exception, please [report](" <> issueTrackerUrl <> "): "
, T.pack(show e)
]

exceptionInHandler e = do
logError logger $ T.pack $
"Unexpected exception, please report!\n" ++
"Exception: " ++ show e
sendErrorMessage e

logger = ideLogger ide
_ <- flip forkFinally handleServerException $ runWithDb logger dbLoc $ \hiedb hieChan -> do
putMVar dbMVar (hiedb,hieChan)
forever $ do
msg <- readChan clientMsgChan
-- 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
case msg of
ReactorNotification act -> do
catch act $ \(e :: SomeException) ->
logError (ideLogger ide) $ T.pack $
"Unexpected exception on notification, please report!\n" ++
"Exception: " ++ show e
ReactorRequest _id act k -> void $ async $
checkCancelled ide clearReqId waitForCancel _id act k

checkCancelled _id act k =
flip finally (clearReqId _id) $
catch (do
-- We could optimize this by first checking if the id
-- is in the cancelled set. However, this is unlikely to be a
-- bottleneck and the additional check might hide
-- issues with async exceptions that need to be fixed.
cancelOrRes <- race (waitForCancel _id) act
case cancelOrRes of
Left () -> do
logDebug (ideLogger ide) $ T.pack $ "Cancelled request " <> show _id
k $ ResponseError RequestCancelled "" Nothing
Right res -> pure res
) $ \(e :: SomeException) -> do
exceptionInHandler e
k $ ResponseError InternalError (T.pack $ show e) Nothing
_ <- flip forkFinally handleServerException $ do
untilMVar lifetime $ runWithDb logger dbLoc $ \hiedb hieChan -> do
putMVar dbMVar (hiedb,hieChan)
forever $ do
msg <- readChan clientMsgChan
-- 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
case msg of
ReactorNotification act -> handle exceptionInHandler act
ReactorRequest _id act k -> void $ async $ checkCancelled _id act k
logInfo logger "Reactor thread stopped"
pure $ Right (env,ide)

checkCancelled
:: IdeState -> (SomeLspId -> IO ()) -> (SomeLspId -> IO ()) -> SomeLspId
-> IO () -> (ResponseError -> IO ()) -> IO ()
checkCancelled ide clearReqId waitForCancel _id act k =
flip finally (clearReqId _id) $
catch (do
-- We could optimize this by first checking if the id
-- is in the cancelled set. However, this is unlikely to be a
-- bottleneck and the additional check might hide
-- issues with async exceptions that need to be fixed.
cancelOrRes <- race (waitForCancel _id) act
case cancelOrRes of
Left () -> do
logDebug (ideLogger ide) $ T.pack $ "Cancelled request " <> show _id
k $ ResponseError RequestCancelled "" Nothing
Right res -> pure res
) $ \(e :: SomeException) -> do
logError (ideLogger ide) $ T.pack $
"Unexpected exception on request, please report!\n" ++
"Exception: " ++ show e
k $ ResponseError InternalError (T.pack $ show e) Nothing

-- | Runs the action until it ends or until the given MVar is put.
-- Rethrows any exceptions.
untilMVar :: MonadUnliftIO m => MVar () -> m () -> m ()
untilMVar mvar io = void $
waitAnyCancel =<< traverse async [ io , readMVar mvar ]

cancelHandler :: (SomeLspId -> IO ()) -> LSP.Handlers (ServerM c)
cancelHandler cancelRequest = LSP.notificationHandler SCancelRequest $ \NotificationMessage{_params=CancelParams{_id}} ->
liftIO $ cancelRequest (SomeLspId _id)

shutdownHandler :: LSP.Handlers (ServerM c)
shutdownHandler = LSP.requestHandler SShutdown $ \_ resp -> do
shutdownHandler :: IO () -> LSP.Handlers (ServerM c)
shutdownHandler stopReactor = LSP.requestHandler SShutdown $ \_ resp -> do
(_, ide) <- ask
liftIO $ logDebug (ideLogger ide) "Received exit message"
liftIO $ logDebug (ideLogger ide) "Received shutdown message"
-- stop the reactor to free up the hiedb connection
liftIO stopReactor
-- flush out the Shake session to record a Shake profile if applicable
liftIO $ shakeShut ide
resp $ Right Empty
Expand Down

0 comments on commit c0d8a3b

Please sign in to comment.