From 2948f0f2adeee1fa9d7154c7da54eccae38ed9ba Mon Sep 17 00:00:00 2001 From: Jost Berthold <jost.berthold@gmail.com> Date: Wed, 18 Dec 2024 15:42:20 +1100 Subject: [PATCH] only run the respond function in a bound thread --- kore-rpc-types/src/Kore/JsonRpc/Server.hs | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) diff --git a/kore-rpc-types/src/Kore/JsonRpc/Server.hs b/kore-rpc-types/src/Kore/JsonRpc/Server.hs index 1796bd581a..1b220ca3c9 100644 --- a/kore-rpc-types/src/Kore/JsonRpc/Server.hs +++ b/kore-rpc-types/src/Kore/JsonRpc/Server.hs @@ -14,7 +14,7 @@ module Kore.JsonRpc.Server ( JsonRpcHandler (..), ) where -import Control.Concurrent (forkIO, forkOS, throwTo) +import Control.Concurrent (forkIO, runInBoundThread, throwTo) import Control.Concurrent.STM.TChan (newTChan, readTChan, writeTChan) import Control.Exception (Exception (fromException), catch, mask, throw) import Control.Monad (forever) @@ -135,7 +135,10 @@ srv runBound respond handlers = do sendResponses r = Log.runNoLoggingT $ flip runReaderT rpcSession $ sendBatchResponse r respondTo :: Request -> IO (Maybe Response) - respondTo req = buildResponse (respond req) req + respondTo req + | runBound = runInBoundThread $ buildResponse (respond req) req + | otherwise = buildResponse (respond req) req + -- workers should run in bound threads (to secure foreign calls) when flagged cancelReq :: ErrorObj -> BatchRequest -> IO () cancelReq err = \case @@ -174,8 +177,7 @@ srv runBound respond handlers = do restore (thing a) `catch` catchesHandler a liftIO $ - -- workers should run in bound threads (to secure foreign calls) when flagged - (if runBound then forkOS else forkIO) $ + forkIO $ forever $ bracketOnReqException (atomically $ readTChan reqQueue)