Merge remote-tracking branch 'origin/adinapoli/test-ctrl-c-properly' into dev

gargantext.cabal

@@ -865,7 +865,9 @@ test-suite garg-test-hspec
     , commonTestDependencies
   type: exitcode-stdio-1.0
   main-is: drivers/hspec/Main.hs
-  build-depends: process ^>= 1.6.18.0
+  build-depends:
+      process ^>= 1.6.18.0
+    , unix >= 2.7.3 && < 2.9
   other-modules:
       Paths_gargantext
       Test.API

test/drivers/hspec/Main.hs

@@ -6,9 +6,10 @@ import Control.Monad
 import Data.Text (isInfixOf)
 import Data.Text qualified as T
 import Gargantext.Prelude hiding (isInfixOf)
-import Shelly hiding (FilePath)
 import System.IO
 import System.Process
+import System.Posix.Process
+import System.Posix.Signals
 import Test.API qualified as API
 import Test.Database.Operations qualified as DB
 import Test.Hspec
@@ -21,7 +22,13 @@ startCoreNLPServer = do
   devNull <- openFile "/dev/null" WriteMode
   let p = proc "./startServer.sh" []
   (_, _, _, hdl) <- (createProcess $ p { cwd = Just "devops/coreNLP/stanford-corenlp-current"
-                    , delegate_ctlc = True
+                    -- NOTE(adn) Issue #451, this one has to stay disabled, because if we
+                    -- turn it on, despite the confusing documentation on the `process` library
+                    -- it will cause the Haskell RTS to completely ignore the Ctrl^c and instead
+                    -- delegate it exclusively to the process here, which means that our CoreNLP
+                    -- server will shut down correctly, but the test running will stop responding
+                    -- to Ctrl^C requests.
+                    , delegate_ctlc = False
                     , create_group = True
                     , std_out = UseHandle devNull
                     , std_err = UseHandle devNull
@@ -34,12 +41,14 @@ startCoreNLPServer = do
                                              | otherwise -> throwIO e
   pure hdl
 
-stopCoreNLPServer :: ProcessHandle -> IO ()
-stopCoreNLPServer ph = do
-  putText "calling stop core nlp"
-  interruptProcessGroupOf ph
-  putText "calling stop core nlp - done"
-
+killProcessTree :: ProcessHandle -> IO ()
+killProcessTree ph = do
+  pid <- getPid ph
+  case pid of
+    Nothing -> putText "Process already terminated"
+    Just p -> do
+      pgid <- getProcessGroupIDOf p
+      signalProcessGroup keyboardSignal pgid
 
 -- It's especially important to use Hspec for DB tests, because,
 -- unlike 'tasty', 'Hspec' has explicit control over parallelism,
@@ -55,9 +64,9 @@ stopCoreNLPServer ph = do
 main :: IO ()
 main = do
   hSetBuffering stdout NoBuffering
-  -- TODO Ideally remove start/stop notifications and use
-  -- Test/API/Setup to initialize this in env
-  bracket startCoreNLPServer stopCoreNLPServer $ \_ -> hspec $ sequential $ do
+  bracket startCoreNLPServer killProcessTree (const run_tests)
+  where
+    run_tests = hspec $ sequential $ do
       API.tests
       ReverseProxy.tests
       DB.tests