tests: Use async instead of forkIO in test setup

PR-URL: https://github.com/hasura/graphql-engine-mono/pull/5544
GitOrigin-RevId: e932e1f76c6e20121c64a429a6eb613d550c6eca

server/tests-hspec/Harness/GraphqlEngine.hs

@@ -39,7 +39,7 @@ where
 
 -------------------------------------------------------------------------------
 
-import Control.Concurrent (forkIO)
+import Control.Concurrent.Async qualified as Async
 import Control.Concurrent.Extended (sleep)
 import Control.Monad.Trans.Managed (ManagedT (..), lowerManagedT)
 import Data.Aeson (Value, object, (.=))
@@ -223,18 +223,18 @@ args:
 -- The port availability is subject to races.
 startServerThread :: Maybe (String, Int) -> IO Server
 startServerThread murlPrefixport = do
-  (urlPrefix, port, threadId) <-
+  (urlPrefix, port, thread) <-
     case murlPrefixport of
       Just (urlPrefix, port) -> do
-        threadId <- forkIO (forever (sleep 1)) -- Just wait.
-        pure (urlPrefix, port, threadId)
+        thread <- Async.async (forever (sleep 1)) -- Just wait.
+        pure (urlPrefix, port, thread)
       Nothing -> do
         port <- bracket (Warp.openFreePort) (Socket.close . snd) (pure . fst)
         let urlPrefix = "http://127.0.0.1"
-        threadId <-
-          forkIO (runApp Constants.serveOptions {soPort = unsafePort port})
-        pure (urlPrefix, port, threadId)
-  let server = Server {port = fromIntegral port, urlPrefix, threadId}
+        thread <-
+          Async.async (runApp Constants.serveOptions {soPort = unsafePort port})
+        pure (urlPrefix, port, thread)
+  let server = Server {port = fromIntegral port, urlPrefix, thread}
   Http.healthCheck (serverUrl server)
   pure server
 

server/tests-hspec/Harness/RemoteServer.hs

@@ -9,7 +9,7 @@ where
 
 -------------------------------------------------------------------------------
 
-import Control.Concurrent (forkIO)
+import Control.Concurrent.Async qualified as Async
 import Control.Exception.Safe (bracket)
 import Data.Aeson qualified as Aeson
 import Data.ByteString.Lazy qualified as Lazy (ByteString)
@@ -58,7 +58,7 @@ run ::
 run (Interpreter interpreter) = do
   let urlPrefix = "http://127.0.0.1"
   port <- bracket (Warp.openFreePort) (Socket.close . snd) (pure . fst)
-  threadId <- forkIO $
+  thread <- Async.async $
     Spock.runSpockNoBanner port $
       Spock.spockT id $ do
         Spock.get "/" $ do
@@ -69,7 +69,7 @@ run (Interpreter interpreter) = do
           result <- liftIO $ interpreter body
           Spock.setHeader "Content-Type" "application/json; charset=utf-8"
           Spock.lazyBytes result
-  let server = Server {port = fromIntegral port, urlPrefix, threadId}
+  let server = Server {port = fromIntegral port, urlPrefix, thread}
   Http.healthCheck $ serverUrl server
   pure server
 

server/tests-hspec/Harness/TestEnvironment.hs

@@ -11,7 +11,8 @@ module Harness.TestEnvironment
   )
 where
 
-import Control.Concurrent (ThreadId, killThread)
+import Control.Concurrent.Async (Async)
+import Control.Concurrent.Async qualified as Async
 import Data.UUID (UUID)
 import Data.Word
 import Harness.Test.BackendType
@@ -44,7 +45,7 @@ data Server = Server
     -- | The full URI prefix e.g. http://localhost
     urlPrefix :: String,
     -- | The thread that the server is running on, so we can stop it later.
-    threadId :: ThreadId
+    thread :: Async ()
   }
 
 -- | Retrieve the 'Server' associated with some 'TestEnvironment'.
@@ -62,4 +63,4 @@ serverUrl Server {urlPrefix, port} = urlPrefix ++ ":" ++ show port
 
 -- | Forcibly stop a given 'Server'.
 stopServer :: Server -> IO ()
-stopServer Server {threadId} = killThread threadId
+stopServer Server {thread} = Async.cancel thread

server/tests-hspec/Harness/Webhook.hs

@@ -5,7 +5,7 @@ module Harness.Webhook
   )
 where
 
-import Control.Concurrent (forkIO)
+import Control.Concurrent.Async as Async
 import Control.Concurrent.Chan qualified as Chan
 import Control.Exception.Safe (bracket)
 import Data.Aeson qualified as Aeson
@@ -42,7 +42,7 @@ run = do
   port <- bracket (Warp.openFreePort) (Socket.close . snd) (pure . fst)
   eventsQueueChan <- Chan.newChan
   let eventsQueue = EventsQueue eventsQueueChan
-  threadId <- forkIO $
+  thread <- Async.async $
     Spock.runSpockNoBanner port $
       Spock.spockT id $ do
         Spock.get "/" $
@@ -63,6 +63,6 @@ run = do
               fromMaybe (error "error in parsing the event data from the body") eventDataPayload
           Spock.setHeader "Content-Type" "application/json; charset=utf-8"
           Spock.json $ Aeson.object ["success" Aeson..= True]
-  let server = Server {port = fromIntegral port, urlPrefix, threadId}
+  let server = Server {port = fromIntegral port, urlPrefix, thread}
   Http.healthCheck $ serverUrl server
   pure (server, eventsQueue)