Skip to content

Commit baf2fec

Browse files
joyfulmantisjoyfulmantis
authored
Catch exceptions in commands and notification handlers and use lsp null (#3696)
1 parent 7007861 commit baf2fec

File tree

15 files changed

+95
-64
lines changed

15 files changed

+95
-64
lines changed

‎ghcide/src/Development/IDE/Plugin/HLS.hs

Lines changed: 45 additions & 13 deletions
Original file line numberDiff line numberDiff line change
@@ -51,15 +51,19 @@ import UnliftIO.Exception (catchAny)
5151
--
5252

5353
data Log
54-
= LogPluginError PluginId ResponseError
54+
= LogPluginError PluginId ResponseError
5555
| LogNoPluginForMethod (Some SMethod)
5656
| LogInvalidCommandIdentifier
57+
| ExceptionInPlugin PluginId (Some SMethod) SomeException
58+
5759
instance Pretty Log where
5860
pretty = \case
5961
LogPluginError (PluginId pId) err -> pretty pId <> ":" <+> prettyResponseError err
6062
LogNoPluginForMethod (Some method) ->
6163
"No plugin enabled for " <> pretty (show method)
6264
LogInvalidCommandIdentifier-> "Invalid command identifier"
65+
ExceptionInPlugin plId (Some method) exception ->
66+
"Exception in plugin " <> viaShow plId <> " while processing "<> viaShow method <> ": " <> viaShow exception
6367

6468
instance Show Log where show = renderString . layoutCompact . pretty
6569

@@ -92,13 +96,24 @@ failedToParseArgs (CommandId com) (PluginId pid) err arg =
9296
"Error while parsing args for " <> com <> " in plugin " <> pid <> ": "
9397
<> T.pack err <> ", arg = " <> T.pack (show arg)
9498

99+
exceptionInPlugin :: PluginId -> SMethod m -> SomeException -> Text
100+
exceptionInPlugin plId method exception =
101+
"Exception in plugin " <> T.pack (show plId) <> " while processing "<> T.pack (show method) <> ": " <> T.pack (show exception)
102+
95103
-- | Build a ResponseError and log it before returning to the caller
96104
logAndReturnError :: Recorder (WithPriority Log) -> PluginId -> (LSPErrorCodes |? ErrorCodes) -> Text -> LSP.LspT Config IO (Either ResponseError a)
97105
logAndReturnError recorder p errCode msg = do
98106
let err = ResponseError errCode msg Nothing
99107
logWith recorder Warning $ LogPluginError p err
100108
pure $ Left err
101109

110+
-- | Logs the provider error before returning it to the caller
111+
logAndReturnError' :: Recorder (WithPriority Log) -> (LSPErrorCodes |? ErrorCodes) -> Log -> LSP.LspT Config IO (Either ResponseError a)
112+
logAndReturnError' recorder errCode msg = do
113+
let err = ResponseError errCode (fromString $ show msg) Nothing
114+
logWith recorder Warning $ msg
115+
pure $ Left err
116+
102117
-- | Map a set of plugins to the underlying ghcide engine.
103118
asGhcIdePlugin :: Recorder (WithPriority Log) -> IdePlugins IdeState -> Plugin Config
104119
asGhcIdePlugin recorder (IdePlugins ls) =
@@ -177,9 +192,9 @@ executeCommandHandlers recorder ecs = requestHandler SMethod_WorkspaceExecuteCom
177192
-- If we have a command, continue to execute it
178193
Just (Command _ innerCmdId innerArgs)
179194
-> execCmd ide (ExecuteCommandParams Nothing innerCmdId innerArgs)
180-
Nothing -> return $ Right $ InL A.Null
195+
Nothing -> return $ Right $ InR Null
181196

182-
A.Error _str -> return $ Right $ InL A.Null
197+
A.Error _str -> return $ Right $ InR Null
183198

184199
-- Just an ordinary HIE command
185200
Just (plugin, cmd) -> runPluginCommand ide plugin cmd cmdParams
@@ -197,7 +212,9 @@ executeCommandHandlers recorder ecs = requestHandler SMethod_WorkspaceExecuteCom
197212
Nothing -> logAndReturnError recorder p (InR ErrorCodes_InvalidRequest) (commandDoesntExist com p xs)
198213
Just (PluginCommand _ _ f) -> case A.fromJSON arg of
199214
A.Error err -> logAndReturnError recorder p (InR ErrorCodes_InvalidParams) (failedToParseArgs com p err arg)
200-
A.Success a -> fmap InL <$> f ide a
215+
A.Success a ->
216+
f ide a `catchAny` -- See Note [Exception handling in plugins]
217+
(\e -> logAndReturnError' recorder (InR ErrorCodes_InternalError) (ExceptionInPlugin p (Some SMethod_WorkspaceApplyEdit) e))
201218

202219
-- ---------------------------------------------------------------------
203220

@@ -225,9 +242,8 @@ extensiblePlugins recorder xs = mempty { P.pluginHandlers = handlers }
225242
msg = pluginNotEnabled m fs'
226243
return $ Left err
227244
Just fs -> do
228-
let msg e pid = "Exception in plugin " <> T.pack (show pid) <> " while processing " <> T.pack (show m) <> ": " <> T.pack (show e)
229-
handlers = fmap (\(plid,_,handler) -> (plid,handler)) fs
230-
es <- runConcurrently msg (show m) handlers ide params
245+
let handlers = fmap (\(plid,_,handler) -> (plid,handler)) fs
246+
es <- runConcurrently exceptionInPlugin m handlers ide params
231247

232248
let (errs,succs) = partitionEithers $ toList $ join $ NE.zipWith (\(pId,_) -> fmap (first (pId,))) handlers es
233249
unless (null errs) $ forM_ errs $ \(pId, err) ->
@@ -261,22 +277,25 @@ extensibleNotificationPlugins recorder xs = mempty { P.pluginHandlers = handlers
261277
Just fs -> do
262278
-- We run the notifications in order, so the core ghcide provider
263279
-- (which restarts the shake process) hopefully comes last
264-
mapM_ (\(pid,_,f) -> otTracedProvider pid (fromString $ show m) $ f ide vfs params) fs
280+
mapM_ (\(pid,_,f) -> otTracedProvider pid (fromString $ show m) $ f ide vfs params
281+
`catchAny` -- See Note [Exception handling in plugins]
282+
(\e -> logWith recorder Warning (ExceptionInPlugin pid (Some m) e))) fs
283+
265284

266285
-- ---------------------------------------------------------------------
267286

268287
runConcurrently
269288
:: MonadUnliftIO m
270-
=> (SomeException -> PluginId -> T.Text)
271-
-> String -- ^ label
289+
=> (PluginId -> SMethod method -> SomeException -> T.Text)
290+
-> SMethod method -- ^ Method (used for errors and tracing)
272291
-> NonEmpty (PluginId, a -> b -> m (NonEmpty (Either ResponseError d)))
273292
-- ^ Enabled plugin actions that we are allowed to run
274293
-> a
275294
-> b
276295
-> m (NonEmpty(NonEmpty (Either ResponseError d)))
277-
runConcurrently msg method fs a b = forConcurrently fs $ \(pid,f) -> otTracedProvider pid (fromString method) $ do
278-
f a b
279-
`catchAny` (\e -> pure $ pure $ Left $ ResponseError (InR ErrorCodes_InternalError) (msg e pid) Nothing)
296+
runConcurrently msg method fs a b = forConcurrently fs $ \(pid,f) -> otTracedProvider pid (fromString (show method)) $ do
297+
f a b -- See Note [Exception handling in plugins]
298+
`catchAny` (\e -> pure $ pure $ Left $ ResponseError (InR ErrorCodes_InternalError) (msg pid method e) Nothing)
280299

281300
combineErrors :: [ResponseError] -> ResponseError
282301
combineErrors [x] = x
@@ -308,3 +327,16 @@ instance Semigroup IdeNotificationHandlers where
308327
go _ (IdeNotificationHandler a) (IdeNotificationHandler b) = IdeNotificationHandler (a <> b)
309328
instance Monoid IdeNotificationHandlers where
310329
mempty = IdeNotificationHandlers mempty
330+
331+
{- Note [Exception handling in plugins]
332+
Plugins run in LspM, and so have access to IO. This means they are likely to
333+
throw exceptions, even if only by accident or through calling libraries that
334+
throw exceptions. Ultimately, we're running a bunch of less-trusted IO code,
335+
so we should be robust to it throwing.
336+
337+
We don't want these to bring down HLS. So we catch and log exceptions wherever
338+
we run a handler defined in a plugin.
339+
340+
The flip side of this is that it's okay for plugins to throw exceptions as a
341+
way of signalling failure!
342+
-}

‎ghcide/src/Development/IDE/Plugin/Test.hs

Lines changed: 9 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -16,8 +16,9 @@ import Control.Concurrent (threadDelay)
1616
import Control.Monad
1717
import Control.Monad.IO.Class
1818
import Control.Monad.STM
19-
import Data.Aeson
20-
import Data.Aeson.Types
19+
import Data.Aeson (FromJSON (parseJSON),
20+
ToJSON (toJSON), Value)
21+
import qualified Data.Aeson.Types as A
2122
import Data.Bifunctor
2223
import Data.CaseInsensitive (CI, original)
2324
import qualified Data.HashMap.Strict as HM
@@ -46,7 +47,7 @@ import GHC.Generics (Generic)
4647
import Ide.Plugin.Config (CheckParents)
4748
import Ide.Types
4849
import Language.LSP.Protocol.Message
49-
import Language.LSP.Protocol.Types hiding (Null)
50+
import Language.LSP.Protocol.Types
5051
import qualified Language.LSP.Server as LSP
5152
import qualified "list-t" ListT
5253
import qualified StmContainers.Map as STM
@@ -80,7 +81,7 @@ plugin = (defaultPluginDescriptor "test") {
8081
}
8182
where
8283
testRequestHandler' ide req
83-
| Just customReq <- parseMaybe parseJSON req
84+
| Just customReq <- A.parseMaybe parseJSON req
8485
= testRequestHandler ide customReq
8586
| otherwise
8687
= return $ Left
@@ -94,7 +95,7 @@ testRequestHandler _ (BlockSeconds secs) = do
9495
LSP.sendNotification (SMethod_CustomMethod (Proxy @"ghcide/blocking/request")) $
9596
toJSON secs
9697
liftIO $ sleep secs
97-
return (Right Null)
98+
return (Right A.Null)
9899
testRequestHandler s (GetInterfaceFilesDir file) = liftIO $ do
99100
let nfp = fromUri $ toNormalizedUri file
100101
sess <- runAction "Test - GhcSession" s $ use_ GhcSession nfp
@@ -107,7 +108,7 @@ testRequestHandler s WaitForShakeQueue = liftIO $ do
107108
atomically $ do
108109
n <- countQueue $ actionQueue $ shakeExtras s
109110
when (n>0) retry
110-
return $ Right Null
111+
return $ Right A.Null
111112
testRequestHandler s (WaitForIdeRule k file) = liftIO $ do
112113
let nfp = fromUri $ toNormalizedUri file
113114
success <- runAction ("WaitForIdeRule " <> k <> " " <> show file) s $ parseAction (fromString k) nfp
@@ -172,6 +173,6 @@ blockCommandDescriptor plId = (defaultPluginDescriptor plId) {
172173

173174
blockCommandHandler :: CommandFunction state ExecuteCommandParams
174175
blockCommandHandler _ideState _params = do
175-
LSP.sendNotification (SMethod_CustomMethod (Proxy @"ghcide/blocking/command")) Null
176+
LSP.sendNotification (SMethod_CustomMethod (Proxy @"ghcide/blocking/command")) A.Null
176177
liftIO $ threadDelay maxBound
177-
return (Right Null)
178+
return (Right $ InR Null)

‎ghcide/src/Development/IDE/Plugin/TypeLenses.hs

Lines changed: 4 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -18,7 +18,7 @@ import Control.DeepSeq (rwhnf)
1818
import Control.Monad (mzero)
1919
import Control.Monad.Extra (whenMaybe)
2020
import Control.Monad.IO.Class (MonadIO (liftIO))
21-
import Data.Aeson.Types (Value (..), toJSON)
21+
import Data.Aeson.Types (Value, toJSON)
2222
import qualified Data.Aeson.Types as A
2323
import Data.List (find)
2424
import qualified Data.Map as Map
@@ -69,10 +69,11 @@ import Language.LSP.Protocol.Types (ApplyWorkspaceEditParams
6969
CodeLens (CodeLens),
7070
CodeLensParams (CodeLensParams, _textDocument),
7171
Diagnostic (..),
72+
Null (Null),
7273
TextDocumentIdentifier (TextDocumentIdentifier),
7374
TextEdit (TextEdit),
7475
WorkspaceEdit (WorkspaceEdit),
75-
type (|?) (InL))
76+
type (|?) (..))
7677
import qualified Language.LSP.Server as LSP
7778
import Text.Regex.TDFA ((=~), (=~~))
7879

@@ -161,7 +162,7 @@ generateLens pId _range title edit =
161162
commandHandler :: CommandFunction IdeState WorkspaceEdit
162163
commandHandler _ideState wedit = do
163164
_ <- LSP.sendRequest SMethod_WorkspaceApplyEdit (ApplyWorkspaceEditParams Nothing wedit) (\_ -> pure ())
164-
return $ Right Null
165+
return $ Right $ InR Null
165166

166167
--------------------------------------------------------------------------------
167168

‎hls-plugin-api/src/Ide/Types.hs

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -873,7 +873,7 @@ data PluginCommand ideState = forall a. (FromJSON a) =>
873873
type CommandFunction ideState a
874874
= ideState
875875
-> a
876-
-> LspM Config (Either ResponseError Value)
876+
-> LspM Config (Either ResponseError (Value |? Null))
877877

878878
-- ---------------------------------------------------------------------
879879

@@ -1093,7 +1093,7 @@ mkCodeActionWithResolveAndCommand plId codeActionMethod codeResolveMethod =
10931093
case resolveResult of
10941094
Right CodeAction {_edit = Just wedits } -> do
10951095
_ <- sendRequest SMethod_WorkspaceApplyEdit (ApplyWorkspaceEditParams Nothing wedits) (\_ -> pure ())
1096-
pure $ Right Data.Aeson.Null
1096+
pure $ Right $ InR Null
10971097
Right _ -> pure $ Left $ responseError "No edit in CodeAction"
10981098
Left err -> pure $ Left err
10991099

‎plugins/hls-class-plugin/src/Ide/Plugin/Class/CodeAction.hs

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -12,7 +12,7 @@ import Control.Monad.IO.Class (liftIO)
1212
import Control.Monad.Trans.Class (lift)
1313
import Control.Monad.Trans.Except (ExceptT, throwE)
1414
import Control.Monad.Trans.Maybe
15-
import Data.Aeson
15+
import Data.Aeson hiding (Null)
1616
import Data.Bifunctor (second)
1717
import Data.Either.Extra (rights)
1818
import Data.List
@@ -37,7 +37,7 @@ import Ide.PluginUtils
3737
import Ide.Types
3838
import qualified Language.LSP.Protocol.Lens as L
3939
import Language.LSP.Protocol.Message
40-
import Language.LSP.Protocol.Types hiding (Null)
40+
import Language.LSP.Protocol.Types
4141
import Language.LSP.Server
4242

4343
addMethodPlaceholders :: PluginId -> CommandFunction IdeState AddMinimalMethodsParams
@@ -64,7 +64,7 @@ addMethodPlaceholders _ state param@AddMinimalMethodsParams{..} = do
6464

6565
void $ lift $ sendRequest SMethod_WorkspaceApplyEdit (ApplyWorkspaceEditParams Nothing edit) (\_ -> pure ())
6666

67-
pure Null
67+
pure $ InR Null
6868
where
6969
toTextDocumentEdit edit =
7070
TextDocumentEdit (verTxtDocId ^.re _versionedTextDocumentIdentifier) [InL edit]

‎plugins/hls-class-plugin/src/Ide/Plugin/Class/CodeLens.hs

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -7,7 +7,7 @@ module Ide.Plugin.Class.CodeLens where
77

88
import Control.Lens ((^.))
99
import Control.Monad.IO.Class (liftIO)
10-
import Data.Aeson
10+
import Data.Aeson hiding (Null)
1111
import Data.Maybe (mapMaybe, maybeToList)
1212
import qualified Data.Text as T
1313
import Development.IDE
@@ -21,7 +21,7 @@ import Ide.PluginUtils
2121
import Ide.Types
2222
import qualified Language.LSP.Protocol.Lens as L
2323
import Language.LSP.Protocol.Message
24-
import Language.LSP.Protocol.Types hiding (Null)
24+
import Language.LSP.Protocol.Types
2525
import Language.LSP.Server (sendRequest)
2626

2727
codeLens :: PluginMethodHandler IdeState Method_TextDocumentCodeLens
@@ -143,4 +143,4 @@ codeLens state plId CodeLensParams{..} = pluginResponse $ do
143143
codeLensCommandHandler :: CommandFunction IdeState WorkspaceEdit
144144
codeLensCommandHandler _ wedit = do
145145
_ <- sendRequest SMethod_WorkspaceApplyEdit (ApplyWorkspaceEditParams Nothing wedit) (\_ -> pure ())
146-
return $ Right Null
146+
return $ Right $ InR Null

‎plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Util.hs

Lines changed: 4 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -18,7 +18,7 @@ import Control.Exception (SomeException, evaluate,
1818
import Control.Monad.IO.Class (MonadIO (liftIO))
1919
import Control.Monad.Trans.Except (ExceptT (..),
2020
runExceptT)
21-
import Data.Aeson (Value (Null))
21+
import Data.Aeson (Value)
2222
import Data.String (IsString (fromString))
2323
import qualified Data.Text as T
2424
import Development.IDE (IdeState, Priority (..),
@@ -32,7 +32,7 @@ import GHC.Stack (HasCallStack, callStack,
3232
srcLocStartCol,
3333
srcLocStartLine)
3434
import Language.LSP.Protocol.Message
35-
import Language.LSP.Protocol.Types hiding (Null)
35+
import Language.LSP.Protocol.Types
3636
import Language.LSP.Server
3737
import System.FilePath (takeExtension)
3838
import System.Time.Extra (duration, showDuration)
@@ -66,7 +66,7 @@ logLevel = Debug -- Info
6666
isLiterate :: FilePath -> Bool
6767
isLiterate x = takeExtension x `elem` [".lhs", ".lhs-boot"]
6868

69-
response' :: ExceptT String (LspM c) WorkspaceEdit -> LspM c (Either ResponseError Value)
69+
response' :: ExceptT String (LspM c) WorkspaceEdit -> LspM c (Either ResponseError (Value |? Null))
7070
response' act = do
7171
res <- runExceptT act
7272
`catchAny` showErr
@@ -75,7 +75,7 @@ response' act = do
7575
return $ Left (ResponseError (InR ErrorCodes_InternalError) (fromString e) Nothing)
7676
Right a -> do
7777
_ <- sendRequest SMethod_WorkspaceApplyEdit (ApplyWorkspaceEditParams Nothing a) (\_ -> pure ())
78-
return $ Right Null
78+
return $ Right $ InR Null
7979

8080
gStrictTry :: (MonadIO m, MonadCatch m) => m b -> m (Either String b)
8181
gStrictTry op =

‎plugins/hls-explicit-imports-plugin/src/Ide/Plugin/ExplicitImports.hs

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -21,7 +21,7 @@ module Ide.Plugin.ExplicitImports
2121
import Control.DeepSeq
2222
import Control.Monad.IO.Class
2323
import Data.Aeson (ToJSON (toJSON),
24-
Value (Null))
24+
Value ())
2525
import Data.Aeson.Types (FromJSON)
2626
import qualified Data.HashMap.Strict as HashMap
2727
import Data.IORef (readIORef)
@@ -41,7 +41,7 @@ import GHC.Generics (Generic)
4141
import Ide.PluginUtils (mkLspCommand)
4242
import Ide.Types
4343
import Language.LSP.Protocol.Message
44-
import Language.LSP.Protocol.Types hiding (Null)
44+
import Language.LSP.Protocol.Types
4545
import Language.LSP.Server
4646

4747
importCommandId :: CommandId
@@ -97,7 +97,7 @@ runImportCommand :: CommandFunction IdeState ImportCommandParams
9797
runImportCommand _state (ImportCommandParams edit) = do
9898
-- This command simply triggers a workspace edit!
9999
_ <- sendRequest SMethod_WorkspaceApplyEdit (ApplyWorkspaceEditParams Nothing edit) (\_ -> pure ())
100-
return (Right Null)
100+
return (Right $ InR Null)
101101

102102
-- | For every implicit import statement, return a code lens of the corresponding explicit import
103103
-- Example - for the module below:

‎plugins/hls-gadt-plugin/src/Ide/Plugin/GADT.hs

Lines changed: 3 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -12,8 +12,7 @@ import Control.Lens ((^.))
1212
import Control.Monad.Except
1313
import Control.Monad.IO.Class
1414
import Control.Monad.Trans.Class
15-
import Data.Aeson (FromJSON, ToJSON, Value (Null),
16-
toJSON)
15+
import Data.Aeson (FromJSON, ToJSON, Value, toJSON)
1716
import Data.Either.Extra (maybeToEither)
1817
import qualified Data.Map as Map
1918
import qualified Data.Text as T
@@ -29,7 +28,7 @@ import Ide.PluginUtils
2928
import Ide.Types
3029
import qualified Language.LSP.Protocol.Lens as L
3130
import Language.LSP.Protocol.Message
32-
import Language.LSP.Protocol.Types hiding (Null)
31+
import Language.LSP.Protocol.Types
3332
import Language.LSP.Server (sendRequest)
3433

3534
descriptor :: PluginId -> PluginDescriptor IdeState
@@ -72,7 +71,7 @@ toGADTCommand pId@(PluginId pId') state ToGADTParams{..} = pluginResponse $ do
7271
(ApplyWorkspaceEditParams Nothing (workSpaceEdit nfp (TextEdit range txt : insertEdit)))
7372
(\_ -> pure ())
7473

75-
pure Null
74+
pure $ InR Null
7675
where
7776
workSpaceEdit nfp edits = WorkspaceEdit
7877
(pure $ Map.fromList

0 commit comments

Comments
 (0)