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)