diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,13 @@ # Revision history for grapesy +## 1.2.3 -- 2026-11-06 + +* Update haddocks for `withRPC` for the changes made in 1.2.0 [#391] +* Add `setOnCancellation` and `expectCancellation` [#391] +* If a call is cancelled by the client aborting, that abort is propagated + (previously a `GrpcException` would be thrown instead). +* Use `http2-5.4.13`. + ## 1.2.2 -- 2026-10-30 * Support configurable HTTP/2 client idle timeout and keepalive ping, via @@ -19,13 +27,18 @@ ## 1.2.0 -- 2026-09-02 * Use `http2-5.4.4` (which brings in `crypton-1.1.*`). -* Improve handling of of `http2` exceptions +* Improve handling of `http2` exceptions * Reduce test-suite flakiness * `recvNextOutputElem` checks trailing metadata [#369] -* Send `RST_STREAM` even if client has already sent their final message [#372]. - The RST_STREAM tells the server that the client is no longer interested in - receiving any more messages from the server; it's therefore independent from - whether or not the client has sent _its_ final message _to_ the server. +* Consider leaving the scope of `withRPC` to be a cancellation until the call is + finished (sending `RST_STREAM` to the server and raising a `GrpcException` + with `GrpcCancelled` in the client), even if the client has already sent their + final message [#372]. The `RST_STREAM` tells the server that the client is no + longer interested in receiving any more messages from the server; it's + therefore independent from whether or not the client has sent _its_ final + message _to_ the server. + **NOTE**: While this change was made in version 1.2.0, the Haddocks were not + updated until version 1.2.3. * The set of trailers included in a response no longer need to be static per RPC, but can vary based on the request; see `setResponseInitialMetadataAndTrailers` [#375] diff --git a/grapesy.cabal b/grapesy.cabal --- a/grapesy.cabal +++ b/grapesy.cabal @@ -1,6 +1,6 @@ cabal-version: 3.0 name: grapesy -version: 1.2.2 +version: 1.2.3 synopsis: Native Haskell implementation of the gRPC framework description: This is a fully compliant and feature complete native Haskell implementation of gRPC, Google's RPC framework. @@ -204,7 +204,7 @@ -- any new version should be tested against the full grapesy test suite -- (regular tests, stress tests and interop tests). build-depends: - , http2 == 5.4.12 + , http2 == 5.4.13 , http-semantics >= 0.4 && < 0.5 , http2-tls >= 0.5 && < 0.6 , network-run >= 0.5 && < 0.8 diff --git a/src/Network/GRPC/Client.hs b/src/Network/GRPC/Client.hs --- a/src/Network/GRPC/Client.hs +++ b/src/Network/GRPC/Client.hs @@ -30,6 +30,10 @@ , Call -- opaque , withRPC + -- ** Cancellation + , setOnCancellation + , expectCancellation + -- ** Parameters , CallParams -- opaque , callTimeout diff --git a/src/Network/GRPC/Client/Call.hs b/src/Network/GRPC/Client/Call.hs --- a/src/Network/GRPC/Client/Call.hs +++ b/src/Network/GRPC/Client/Call.hs @@ -8,6 +8,10 @@ Call -- opaque , withRPC + -- ** Cancellation + , setOnCancellation + , expectCancellation + -- * Open (ongoing) call , sendInput , recvOutput @@ -39,7 +43,9 @@ import Control.Monad.Catch (MonadMask) import Control.Monad.Catch qualified as Exceptions import Data.ByteString.Char8 qualified as BS.Strict.C8 +import Data.IORef import Data.Text qualified as Text +import GHC.IO (unsafeUnmask) import Network.GRPC.Client.Connection (Connection, ConnParams(..)) import Network.GRPC.Client.Connection qualified as Connection @@ -65,7 +71,8 @@ -- -- This type is kept abstract (opaque) in the public facing API. data Call rpc = SupportsClientRpc rpc => Call { - callChannel :: Session.Channel (ClientSession rpc) + callChannel :: Session.Channel (ClientSession rpc) + , callOnCancellation :: IORef (GrpcException -> IO ()) } -- | Scoped RPC call @@ -79,29 +86,23 @@ -- > withRPC conn def (Proxy @ListFeatures) $ \call -> do -- > .. use 'call' to send and receive messages -- --- for some previously established connection 'conn' --- (see 'Network.GRPC.Client.withConnection') and where @ListFeatures@ is some --- kind of RPC. +-- for some previously established connection @conn@ (see +-- 'Network.GRPC.Client.withConnection') and where @ListFeatures@ is some kind +-- of RPC. -- --- The call is setup in the background, and might not yet have been established --- when the body is run. If you want to be sure that the call has been setup, +-- The call is set up in the background, and might not yet have been established +-- when the body is run. If you want to be sure that the call has been set up, -- you can call 'recvResponseMetadata'. -- --- Leaving the scope of 'withRPC' before the client informs the server that they --- have sent their last message (using 'sendInput' or 'sendEndOfInput') is --- considered a cancellation, and accordingly throws a 'GrpcException' with --- 'GrpcCancelled' (see also ). --- --- There is one exception to this rule: if the server unilaterally closes the --- RPC (that is, the server already sent the trailers), then the call is --- considered closed and the cancellation exception is not raised. Under normal --- circumstances (with well-behaved server handlers) this should not arise. --- (The gRPC specification itself is not very specific about this case; see --- discussion at .) --- --- If there are still /inbound/ messages upon leaving the scope of 'withRPC' no --- exception is raised (but the call is nonetheless still closed, and the server --- handler will be informed that the client has disappeared). +-- Leaving the scope of 'withRPC' before the call has finished (in particular, +-- before the client has read all outputs from the server) is considered a +-- cancellation: the server is sent a @RST_STREAM@ with error code @CANCEL@ and, +-- by default, a 'GrpcException' with 'GrpcCancelled' is raised in the client. +-- If the cancellation is deliberate, use 'expectCancellation' (or +-- 'setOnCancellation') to avoid the exception. If the client throws an +-- exception or otherwise aborts, the server is instead sent a @RST_STREAM@ with +-- error code @INTERNAL_ERROR@, and the exception (or abort) is propagated +-- as-is. -- -- Note on timeouts: if a timeout is specified for the call (either through -- 'callTimeout' or through 'connDefaultTimeout'), when the timeout is reached @@ -114,12 +115,38 @@ => Connection -> CallParams rpc -> Proxy rpc -> (Call rpc -> m a) -> m a withRPC conn callParams proxy k = fmap fst $ Exceptions.generalBracket - (liftIO $ - startRPC conn proxy callParams) - (\(Call{callChannel}, cancelRequest) exitCase -> liftIO $ - closeRPC callChannel cancelRequest exitCase) - (k . fst) + ( liftIO $ + startRPC conn proxy callParams + ) + (\(call, cancelRequest) exitCase -> liftIO $ + closeRPC call cancelRequest exitCase + ) + ( k . fst ) +-- | Action to run when an RPC is cancelled +-- +-- When we leave the scope of 'withRPC' before the call is finished, this +-- amounts to a /cancellation/ (see 'withRPC' for detailed discussion). By +-- default, @grapesy@ will throw a 'GrpcException' in the client when this +-- happens (as well as informing the server), as suggested by the gRPC spec. +-- When cancellation is deliberate, 'setOnCancellation' or 'expectCancellation' +-- can be used to override this behaviour. +-- +-- The handler is only called if the client terminates normally (not when it +-- throws an exception or otherwise aborts). +-- +-- See also . +setOnCancellation :: MonadIO m => Call rpc -> (GrpcException -> IO ()) -> m () +setOnCancellation Call{callOnCancellation} = + liftIO . writeIORef callOnCancellation + +-- | Expect cancellation +-- +-- Prevents a 'GrpcException' being raised in the client when it cancels an RPC. +-- See also 'setOnCancellation'. +expectCancellation :: MonadIO m => Call rpc -> m () +expectCancellation call = setOnCancellation call $ \_ -> return () + -- | Open new channel to the server -- -- This is a non-blocking call; the connection will be set up in a @@ -237,14 +264,15 @@ let exitReason :: ExitCase () exitReason = case mErr of - Nothing -> + Right () -> ExitCaseSuccess () - Just exitWithException -> + Left exitWithException -> ExitCaseException . toException $ serverDisconnected backtrace exitWithException Session.close channel exitReason - return (Call channel, cancelRequest) + onCancellation <- newIORef throwM + return (Call channel onCancellation, cancelRequest) where connParams :: ConnParams connParams = Connection.connParams conn @@ -296,11 +324,10 @@ -- -- This is more subtle than one might think. The spec mandates that when a -- client cancels a request (which in grapesy means exiting the scope of --- withRPC), the client receives a CANCELLED exception. We need to deal with the --- edge case mentioned in 'withRPC', however: the server might have already --- closed the connection. The client must have evidence that this is the case, --- which could mean one of two things: +-- withRPC), the client receives a CANCELLED exception. -- +-- We consider closing to be cancellation, /unless/ +-- -- o The client received the final message from the server -- o The server threw an exception, and the client saw this -- @@ -323,7 +350,7 @@ -- o closeRPC :: HasCallStack - => Session.Channel rpc + => Call rpc -> Session.CancelRequest -> ExitCase a -- ^ Reason for closing the connection @@ -333,21 +360,22 @@ -- o Further interaction with the connection will throw an exception -- reflecting the reason that the connection was closed. -- - -- o If 'closeRPC' is called /before/ the client sent their final message - -- to the server, the server is sent a @RST_FRAME@. The error code in - -- the @RST_FRAME@ depends on the 'ExitCase': + -- o If 'closeRPC' is called /before/ the call is finished, the server is + -- sent a @RST_STREAM@. The error code in the @RST_STREAM@ depends on the + -- 'ExitCase': -- -- a. If the 'ExitCase' is 'ExitCaseSuccess', indicating that the client -- terminated normally, this is interpreted as the client cancelling - -- the request. The error code in the @RST_FRAME@ will therefore be - -- @CANCEL@, and a 'GrpcCancelled' exception is raised in the thread - -- calling 'closeRPC' (as mandated by the gRPC spec). - -- b. If not, the client terminated with an exception; since gRPC does - -- not support client-side trailers, we have no way of communicating - -- the nature of the client error to the client; instead, the - -- @RST_FRAME@ will have error code @INTERNAL_ERROR@. + -- the request. The error code in the @RST_STREAM@ will therefore be + -- @CANCEL@, and by default a 'GrpcCancelled' exception is raised in + -- the thread calling 'closeRPC' (as mandated by the gRPC spec); see + -- also 'setOnCancellation'. + -- b. If not, the client terminated with an exception or aborted; since + -- gRPC does not support client-side trailers, we have no way of + -- communicating the nature of the client error to the server; + -- instead, the @RST_STREAM@ will have error code @INTERNAL_ERROR@. -> IO () -closeRPC callChannel cancelRequest exitCase = do +closeRPC Call{callChannel, callOnCancellation} cancelRequest exitCase = do backtrace <- collectBacktraces canDiscard <- checkCanDiscard @@ -362,12 +390,13 @@ unless canDiscard $ sendResetFrame backtrace Session.close callChannel exitCase - -- Throw the gRPC mandated local 'GrpcCancelled' exception, unless the - -- client itself already terminated with an exception + -- Unless the client itself terminated with an exception or an abort (which + -- would be propagated by generalBracket), throw the gRPC mandated local + -- 'GrpcCancelled' exception (though see 'setOnCancellation'). unless canDiscard $ case exitCase of - ExitCaseException e -> throwIO e - _otherwise -> throwCancelled backtrace + ExitCaseSuccess{} -> throwCancelled backtrace + _otherwise -> return () where sendResetFrame :: Backtraces -> IO () sendResetFrame backtrace = do @@ -391,7 +420,12 @@ throwCancelled :: Backtraces -> IO () throwCancelled backtrace = do - throwM $ GrpcException { + onCancellation <- readIORef callOnCancellation + -- We are in the @release@ handler of @generalBracket@ here, but all + -- cleanup has been done so it's safe to unmask exceptions; running + -- arbitrary user code ('setOnCancellation') with exceptions masked + -- may be problematic. + unsafeUnmask $ onCancellation $ GrpcException { grpcError = GrpcCancelled , grpcErrorMessage = Just $ mconcat [ "Channel discarded by client at " diff --git a/src/Network/GRPC/Client/Connection.hs b/src/Network/GRPC/Client/Connection.hs --- a/src/Network/GRPC/Client/Connection.hs +++ b/src/Network/GRPC/Client/Connection.hs @@ -302,15 +302,17 @@ getConnectionToServer :: forall. HasCallStack => Connection - -> IO (TMVar (Maybe ExactException), Session.ConnectionToServer) + -> IO (TMVar (Either ExactException ()), Session.ConnectionToServer) getConnectionToServer Connection{connStateVar} = atomically $ do connState <- STM.readTVar connStateVar case connState of ConnectionNotReady -> STM.retry ConnectionReady connClosed conn -> return (connClosed, conn) ConnectionAbandoned err -> STM.throwSTM err - ConnectionOutOfScope -> error "impossible" + -- This can only happen if the 'Connection' object is not scoped properly. + ConnectionOutOfScope -> error "connection used after closeConnection" + -- | Get outbound compression algorithm -- -- This is stateful, because it depends on whether or not compression negotation @@ -341,8 +343,14 @@ -- | The connection is ready -- - -- The nested @TMVar@ is written to when the connection is closed. - | ConnectionReady (TMVar (Maybe ExactException)) Session.ConnectionToServer + -- The 'TMVar' belongs to /one/ connection attempt. It is written exactly + -- once, when that HTTP/2 connection ends: @Right ()@ if it was shut down + -- ('closeConnection'), @Left err@ if it was lost. + -- + -- RPCs started on this connection monitor it, so that they are + -- closed when the connection they are using goes away, even if the + -- 'Connection' as a whole reconnects. + | ConnectionReady (TMVar (Either ExactException ())) Session.ConnectionToServer -- | We gave up trying to (re)establish the connection | ConnectionAbandoned ExactException diff --git a/src/Network/GRPC/Client/Run.hs b/src/Network/GRPC/Client/Run.hs --- a/src/Network/GRPC/Client/Run.hs +++ b/src/Network/GRPC/Client/Run.hs @@ -122,6 +122,14 @@ pure Connection {connParams, connMetaVar, connStateVar, connOutOfScope} -- | Close a connection to the server. +-- +-- Like most things in @grapesy@, 'closeConnection' is asynchronous: the +-- socket /will/ be closed after calling 'closeConnection', but may still be +-- open when 'closeConnection' returns. +-- +-- If a 'Connection' has /failed/, 'closeConnection' may race with the reconnect +-- policy: after 'closeConnection', the reconnect policy may be run at most once +-- more (and so at most one more connection attempt may be made). closeConnection :: Connection -> IO () closeConnection conn = putMVar (connOutOfScope conn) () @@ -145,27 +153,38 @@ -- -- This is an internal data structure used only in 'stayConnected' and helpers. data Attempt = ConnectionAttempt { - attemptParams :: ConnParams - , attemptOnConnection :: OnConnection - , attemptState :: TVar ConnectionState - , attemptOutOfScope :: MVar () - , attemptClosed :: TMVar (Maybe ExactException) + -- | Action to run upon successful (re)connection to a server + -- + -- On the first attempt this is 'connOnConnection'. + -- After reconnecting, this may be replaced by 'onReconnect'. + attemptOnConnection :: OnConnection + + -- | Connection state + -- + -- This is shared across all attempts (@connStateVar@) + , attemptState :: TVar ConnectionState + + -- | Connection scope + -- + -- This too is shared across all attempts (@connOutOfScope@). + -- Only filled in 'closeConnection'. + , attemptOutOfScope :: MVar () + + -- | State of the /current/ attempt + -- + -- See 'ConnectionReady' for discussion. + , attemptClosed :: TMVar (Either ExactException ()) } newConnectionAttempt :: - ConnParams - -> OnConnection + OnConnection -> TVar ConnectionState -> MVar () -> IO Attempt -newConnectionAttempt attemptParams - attemptOnConnection - attemptState - attemptOutOfScope = do +newConnectionAttempt attemptOnConnection attemptState attemptOutOfScope = do attemptClosed <- STM.newEmptyTMVarIO return ConnectionAttempt{ - attemptParams - , attemptOnConnection + attemptOnConnection , attemptState , attemptOutOfScope , attemptClosed @@ -187,7 +206,7 @@ loop :: Server -> OnConnection -> ReconnectPolicy -> IO () loop server onConnection remainingReconnectPolicy = do -- Start new attempt (this just allocates some internal state) - attempt <- newConnectionAttempt connParams onConnection connStateVar connOutOfScope + attempt <- newConnectionAttempt onConnection connStateVar connOutOfScope -- Just like in 'runHandler' on the server side, it is important that -- 'stayConnected' runs in a separate thread. If it does not, then the @@ -200,6 +219,10 @@ -- is the low-level exception reported by @http2@ (something about -- stream errors), rather than the informative gRPC exception we want. + -- Connect to the server. + -- + -- This only returns after 'closeConnection', or when the connection + -- fails or is lost. mRes <- tryExact $ case server of ServerInsecure addr -> @@ -209,53 +232,69 @@ ServerUnix path -> connectUnix connParams attempt path - thisReconnectPolicy <- atomically $ do - STM.putTMVar (attemptClosed attempt) $ either Just (\() -> Nothing) mRes - connState <- STM.readTVar connStateVar - return $ case connState of - ConnectionReady{}-> - -- Suppose we have a maximum of 5x to try and connect to a server. - -- Then if we manage to connect, and /then/ lose the connection, - -- we should have those same 5x tries again. - connReconnectPolicy connParams - _otherwise -> - remainingReconnectPolicy + -- The connection failing does not imply that it wasn't /also/ closed; + -- if that is the case, we should not try to reconnect. + connWasClosed <- not <$> isEmptyMVar connOutOfScope + -- Notify any running RPC on this now-dead connection. + atomically $ STM.putTMVar (attemptClosed attempt) mRes + case mRes of - Right () -> do + Right () -> + -- Connection was closed deliberately. atomically $ STM.writeTVar connStateVar $ ConnectionOutOfScope - Left err - | isFatalException err -> - atomically $ STM.writeTVar connStateVar $ ConnectionAbandoned err - | otherwise -> do - -- Mark the connection as not ready /before/ running the reconnt - -- policy. This prevents any attempts to use the connection - -- while the policy is running. - atomically $ STM.writeTVar connStateVar $ ConnectionNotReady - runReconnectPolicy thisReconnectPolicy >>= \case - DontReconnect -> do - atomically $ STM.writeTVar connStateVar $ ConnectionAbandoned err - DoReconnect reconnect -> do - let - nextServer = - case reconnectTo reconnect of - ReconnectToPrevious -> server - ReconnectToOriginal -> initialServer - ReconnectToNew new -> new + Left _err | connWasClosed -> + -- The HTTP connection failed or was lost, but the 'Connection' was + -- closed so no need to reconnect, and we can ignore the error. + atomically $ STM.writeTVar connStateVar $ ConnectionOutOfScope + Left err | isFatalException err -> + -- Don't try to reconnect after a fatal exception + atomically $ STM.writeTVar connStateVar $ ConnectionAbandoned err + Left err -> do + -- Connection failed or was lost: check the reconnect policy. + thisReconnectPolicy <- atomically $ do + connState <- STM.readTVar connStateVar + return $ case connState of + ConnectionReady{}-> + -- After a successful connection, reset the reconnect policy. + -- + -- Suppose we have a maximum of 5x to try and connect to a + -- server. Then if we manage to connect, and /then/ lose the + -- connection, we should have those same 5x tries again. + connReconnectPolicy connParams + _otherwise -> + remainingReconnectPolicy - onReconnect' = - case onReconnect reconnect of - Just act -> act - Nothing -> connOnConnection connParams + -- Mark the connection as not ready /before/ running the reconnect + -- policy. This prevents any attempts to use the connection while + -- the policy is running. + atomically $ STM.writeTVar connStateVar $ ConnectionNotReady + runReconnectPolicy thisReconnectPolicy >>= \case + DontReconnect -> atomically $ do + STM.writeTVar connStateVar $ ConnectionAbandoned err + DoReconnect reconnect -> do + let nextServer :: Server + nextServer = + case reconnectTo reconnect of + ReconnectToPrevious -> server + ReconnectToOriginal -> initialServer + ReconnectToNew new -> new - loop nextServer onReconnect' $ nextPolicy reconnect + onReconnect' :: OnConnection + onReconnect' = + case onReconnect reconnect of + Just act -> act + Nothing -> connOnConnection connParams + loop nextServer onReconnect' (nextPolicy reconnect) + -- | Unix domain socket connection connectUnix :: ConnParams -> Attempt -> FilePath -> IO () -connectUnix connParams attempt path = do - client <- Socket.socket Socket.AF_UNIX Socket.Stream Socket.defaultProtocol - Socket.connect client $ Socket.SockAddrUnix path - connectSocket connParams attempt "localhost" client +connectUnix connParams attempt path = + bracket (Socket.socket Socket.AF_UNIX Socket.Stream Socket.defaultProtocol) + Socket.close $ \sock -> do + Socket.connect sock $ Socket.SockAddrUnix path + connectSocket connParams attempt "localhost" sock -- | Insecure connection (no TLS) connectInsecure :: ConnParams -> Attempt -> Address -> IO () diff --git a/test-grapesy/Test/Sanity/Cancellation.hs b/test-grapesy/Test/Sanity/Cancellation.hs --- a/test-grapesy/Test/Sanity/Cancellation.hs +++ b/test-grapesy/Test/Sanity/Cancellation.hs @@ -45,21 +45,37 @@ testCase "beforeHalfClosed" $ testReset Client.sendNextInput - (return ()) + (\_ -> return ()) + checkClientThrowsCancelled , testCase "afterHalfClosed" $ testReset Client.sendFinalInput - (return ()) + (\_ -> return ()) + checkClientThrowsCancelled ] + , testGroup "expectCancellation" [ + testCase "beforeHalfClosed" $ + testReset + Client.sendNextInput + Client.expectCancellation + checkClientTerminatesNormally + , testCase "afterHalfClosed" $ + testReset + Client.sendFinalInput + Client.expectCancellation + checkClientTerminatesNormally + ] , testGroup "withException" [ testCase "beforeHalfClosed" $ testReset Client.sendNextInput - (throwIO $ DeliberateClientException 1) + (\_ -> throwIO $ DeliberateClientException 1) + checkClientThrowsDeliberate , testCase "afterHalfClosed" $ testReset Client.sendFinalInput - (throwIO $ DeliberateClientException 1) + (\_ -> throwIO $ DeliberateClientException 1) + checkClientThrowsDeliberate ] ] @@ -71,11 +87,12 @@ (Client.Call EchoUntilCancelled -> Lazy.ByteString -> IO ()) -- ^ How should we send the input? -- ('sendNextInput', 'sendFinalInput') - -> IO () + -> (Client.Call EchoUntilCancelled -> IO ()) -- ^ How should the client exit the scope of 'withRPC'? - -- (@return ()@, @throwIO@) + -> (IO () -> IO ()) + -- ^ How should we verify the client's result? -> Assertion -testReset sendInput leaveScope = do +testReset sendInput leaveScope checkClientException = do resultVar <- newEmptyMVar testClientServer ClientServerTest{ config = def @@ -86,7 +103,7 @@ sendInput call "ABCDE" resp <- Client.recvOutput call assertEqual "" (StreamElem "ABCDE") $ resp - leaveScope + leaveScope call handlerResult <- readMVar resultVar case handlerResult of @@ -139,11 +156,9 @@ Expected exceptions -------------------------------------------------------------------------------} --- | Check client-side exception --- --- We expected 'GrpcCancelled' unless the client threw an exception itself. -checkClientException :: IO () -> IO () -checkClientException client = do +-- | Check client throws gRPC exception +checkClientThrowsCancelled :: IO () -> IO () +checkClientThrowsCancelled client = do clientResult :: Either ExactException () <- E.try client case clientResult of Right () -> @@ -152,11 +167,31 @@ <- E.fromException (unwrapExactException e) , grpcError e' == GrpcCancelled -> return () + Left e -> + assertFailure $ "Unexpected " ++ show e + +-- | Check client throws deliberate exception (and /not/ 'GrpcException') +checkClientThrowsDeliberate :: IO () -> IO () +checkClientThrowsDeliberate client = do + clientResult :: Either ExactException () <- E.try client + case clientResult of + Right () -> + assertFailure "Expected client exception" Left e | Just DeliberateClientException{} <- E.fromException (unwrapExactException e) -> return () - _otherwise -> - assertFailure $ "Unexpected " ++ show clientResult + Left e -> + assertFailure $ "Unexpected " ++ show e + +-- | Check client terminates normally +checkClientTerminatesNormally :: IO () -> IO () +checkClientTerminatesNormally client = do + clientResult :: Either ExactException () <- E.try client + case clientResult of + Right () -> + return () + Left e -> + assertFailure $ "Unexpected " ++ show e -- | Check server-side exception --