mirror of
https://github.com/unclechu/gRPC-haskell.git
synced 2024-11-14 07:09:41 +01:00
Fix async exception handling (#86)
Previously, grpc-haskell used a lot of code in the form of ``` do x <- acquireResource f x `finally` releaseResource x ``` This is not safe since you can get killed after acquiring the resource but before installing the exception handler via `finally`. We have seen various gRPC assertion errors and crashes on shutdown when this got triggered.
This commit is contained in:
parent
a26497c82c
commit
35163c3c18
4 changed files with 36 additions and 24 deletions
|
@ -11,7 +11,7 @@
|
|||
-- `Network.GRPC.LowLevel.Client.Unregistered`.
|
||||
module Network.GRPC.LowLevel.Client where
|
||||
|
||||
import Control.Exception (bracket, finally)
|
||||
import Control.Exception (bracket)
|
||||
import Control.Concurrent.MVar
|
||||
import Control.Monad
|
||||
import Control.Monad.IO.Class
|
||||
|
@ -222,9 +222,12 @@ withClientCallParent :: Client
|
|||
-> (ClientCall -> IO (Either GRPCIOError a))
|
||||
-> IO (Either GRPCIOError a)
|
||||
withClientCallParent cl rm tm parent f =
|
||||
clientCreateCallParent cl rm tm parent >>= \case
|
||||
bracket (clientCreateCallParent cl rm tm parent) cleanup $ \case
|
||||
Left e -> return (Left e)
|
||||
Right c -> f c `finally` do
|
||||
Right c -> f c
|
||||
where
|
||||
cleanup (Left _) = pure ()
|
||||
cleanup (Right c) = do
|
||||
debugClientCall c
|
||||
grpcDebug "withClientCall(R): destroying."
|
||||
destroyClientCall c
|
||||
|
|
|
@ -1,10 +1,11 @@
|
|||
{-# LANGUAGE LambdaCase #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
{-# LANGUAGE ViewPatterns #-}
|
||||
|
||||
module Network.GRPC.LowLevel.Client.Unregistered where
|
||||
|
||||
import Control.Arrow
|
||||
import Control.Exception (finally)
|
||||
import Control.Exception (bracket)
|
||||
import Control.Monad (join)
|
||||
import Data.ByteString (ByteString)
|
||||
import Foreign.Ptr (nullPtr)
|
||||
|
@ -40,13 +41,15 @@ withClientCall :: Client
|
|||
-> TimeoutSeconds
|
||||
-> (ClientCall -> IO (Either GRPCIOError a))
|
||||
-> IO (Either GRPCIOError a)
|
||||
withClientCall client method timeout f = do
|
||||
createResult <- clientCreateCall client method timeout
|
||||
case createResult of
|
||||
withClientCall client method timeout f =
|
||||
bracket (clientCreateCall client method timeout) cleanup $ \case
|
||||
Left x -> return $ Left x
|
||||
Right call -> f call `finally` logDestroy call
|
||||
where logDestroy c = grpcDebug "withClientCall(U): destroying."
|
||||
>> destroyClientCall c
|
||||
Right call -> f call
|
||||
where
|
||||
cleanup (Left _) = pure ()
|
||||
cleanup (Right call) = do
|
||||
grpcDebug "withClientCall(U): destroying."
|
||||
destroyClientCall call
|
||||
|
||||
-- | Makes a normal (non-streaming) request without needing to register a method
|
||||
-- first. Probably only useful for testing.
|
||||
|
|
|
@ -26,7 +26,7 @@ import Control.Concurrent.STM.TVar (TVar
|
|||
, writeTVar
|
||||
, readTVarIO
|
||||
, newTVarIO)
|
||||
import Control.Exception (bracket, finally)
|
||||
import Control.Exception (bracket)
|
||||
import Control.Monad
|
||||
import Control.Monad.IO.Class
|
||||
import Control.Monad.Trans.Except
|
||||
|
@ -343,13 +343,16 @@ withServerCall :: Server
|
|||
-> (ServerCall (MethodPayload mt) -> IO (Either GRPCIOError a))
|
||||
-> IO (Either GRPCIOError a)
|
||||
withServerCall s rm f =
|
||||
serverCreateCall s rm >>= \case
|
||||
Left e -> return (Left e)
|
||||
Right c -> do
|
||||
debugServerCall c
|
||||
f c `finally` do
|
||||
grpcDebug "withServerCall(R): destroying."
|
||||
destroyServerCall c
|
||||
bracket (serverCreateCall s rm) cleanup $ \case
|
||||
Left e -> return (Left e)
|
||||
Right c -> do
|
||||
debugServerCall c
|
||||
f c
|
||||
where
|
||||
cleanup (Left _) = pure ()
|
||||
cleanup (Right c) = do
|
||||
grpcDebug "withServerCall(R): destroying."
|
||||
destroyServerCall c
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
-- serverReader (server side of client streaming mode)
|
||||
|
|
|
@ -3,7 +3,7 @@
|
|||
|
||||
module Network.GRPC.LowLevel.Server.Unregistered where
|
||||
|
||||
import Control.Exception (finally)
|
||||
import Control.Exception (bracket, finally, mask)
|
||||
import Control.Monad
|
||||
import Control.Monad.Trans.Except
|
||||
import Data.ByteString (ByteString)
|
||||
|
@ -30,9 +30,12 @@ withServerCall :: Server
|
|||
-> (ServerCall -> IO (Either GRPCIOError a))
|
||||
-> IO (Either GRPCIOError a)
|
||||
withServerCall s f =
|
||||
serverCreateCall s >>= \case
|
||||
Left e -> return (Left e)
|
||||
Right c -> f c `finally` do
|
||||
bracket (serverCreateCall s) cleanup $ \case
|
||||
Left e -> return (Left e)
|
||||
Right c -> f c
|
||||
where
|
||||
cleanup (Left _) = pure ()
|
||||
cleanup (Right c) = do
|
||||
grpcDebug "withServerCall: destroying."
|
||||
destroyServerCall c
|
||||
|
||||
|
@ -44,13 +47,13 @@ withServerCall s f =
|
|||
withServerCallAsync :: Server
|
||||
-> (ServerCall -> IO ())
|
||||
-> IO ()
|
||||
withServerCallAsync s f =
|
||||
withServerCallAsync s f = mask $ \unmask ->
|
||||
serverCreateCall s >>= \case
|
||||
Left e -> do grpcDebug $ "withServerCallAsync: call error: " ++ show e
|
||||
return ()
|
||||
Right c -> do wasForkSuccess <- forkServer s handler
|
||||
unless wasForkSuccess destroy
|
||||
where handler = f c `finally` destroy
|
||||
where handler = unmask (f c) `finally` destroy
|
||||
-- TODO: We sometimes never finish cleanup if the server
|
||||
-- is shutting down and calls killThread. This causes gRPC
|
||||
-- core to complain about leaks. I think the cause of
|
||||
|
|
Loading…
Reference in a new issue