grapesy 1.2.2 → 1.2.3
raw patch · 7 files changed
+262/−129 lines, 7 filesdep ~http2PVP ok
version bump matches the API change (PVP)
Dependency ranges changed: http2
API changes (from Hackage documentation)
+ Network.GRPC.Client: expectCancellation :: forall {k} m (rpc :: k). MonadIO m => Call rpc -> m ()
+ Network.GRPC.Client: setOnCancellation :: forall {k} m (rpc :: k). MonadIO m => Call rpc -> (GrpcException -> IO ()) -> m ()
Files
- CHANGELOG.md +18/−5
- grapesy.cabal +2/−2
- src/Network/GRPC/Client.hs +4/−0
- src/Network/GRPC/Client/Call.hs +84/−50
- src/Network/GRPC/Client/Connection.hs +12/−4
- src/Network/GRPC/Client/Run.hs +92/−53
- test-grapesy/Test/Sanity/Cancellation.hs +50/−15
CHANGELOG.md view
@@ -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]
grapesy.cabal view
@@ -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
src/Network/GRPC/Client.hs view
@@ -30,6 +30,10 @@ , Call -- opaque , withRPC + -- ** Cancellation+ , setOnCancellation+ , expectCancellation+ -- ** Parameters , CallParams -- opaque , callTimeout
src/Network/GRPC/Client/Call.hs view
@@ -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 <https://grpc.io/docs/guides/cancellation/>).------ 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 <https://stackoverflow.com/questions/55511528/should-grpc-server-side-half-closing-implicitly-terminate-the-client>.)------ 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 <https://grpc.io/docs/guides/cancellation/>.+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 <https://github.com/grpc/grpc/blob/master/doc/interop-test-descriptions.md#cancel_after_first_response> 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 "
src/Network/GRPC/Client/Connection.hs view
@@ -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
src/Network/GRPC/Client/Run.hs view
@@ -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 ()
test-grapesy/Test/Sanity/Cancellation.hs view
@@ -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 --