Use Async.race in serverCLI start-all to fix initialisation bug

This commit uses the `race` function from the async library to fix a bug
where exceptions raised from the server async wouldn't be caught by the
top-level code.

The bug was stemming from the fact that `runAllWorkers` is **blocking**,
despite its usage of `forConcurrently_`. Therefore we were never
actually running the `wait` function below, but rather we were hanging
waiting on the result of the first function.

As a result the server could die but the workers could keep the main
thread alive, causing the bug we just saw as part of #463.

bin/gargantext-cli/CLI/Server.hs

+{-# LANGUAGE TemplateHaskell #-}
 {-|
 Module      : CLI.Server
 Description : Gargantext Server
@@ -15,16 +16,18 @@ module CLI.Server where
 import CLI.Parsers (settings_p)
 import CLI.Types
 import CLI.Worker (runAllWorkers)
+import Control.Concurrent.Async qualified as Async
 import Control.Monad.IO.Class
+import Data.Text qualified as T
 import Data.Version (showVersion)
-import Gargantext.API.Admin.EnvTypes (Mode(..))
+import GHC.IO.Encoding (setLocaleEncoding, utf8)
 import Gargantext.API (startGargantext)
+import Gargantext.API.Admin.EnvTypes (Mode(..))
 import Gargantext.Core.Config
 import Gargantext.Core.Config.Types (_SettingsFile)
 import Gargantext.Core.Config.Utils (readConfig)
 import Gargantext.Prelude
 import Gargantext.System.Logging
-import GHC.IO.Encoding (setLocaleEncoding, utf8)
 import Options.Applicative
 import Paths_gargantext qualified as PG -- cabal magic build module
 
@@ -41,8 +44,15 @@ serverCLI (CLIS_start serverArgs) = withServerCLILogger serverArgs $ \ioLogger -
 
 serverCLI (CLIS_startAll serverArgs@(ServerArgs { .. })) = withServerCLILogger serverArgs $ \ioLogger -> do
   withAsync (startServerCLI ioLogger serverArgs) $ \aServer -> do
-    runAllWorkers ioLogger server_toml
-    wait aServer
+    res <- Async.race (runAllWorkers ioLogger server_toml) (waitCatch aServer)
+    case res of
+      Left ()  -> pure ()
+      Right (Left ex)
+        -> do
+          $(logLoc) ioLogger ERROR $ "Exception raised when running the server:\n\n" <> T.pack (displayException ex)
+          exitFailure
+      Right (Right ())
+        -> pure ()
 
 serverCLI (CLIS_version) = withLogger (LogConfig Nothing DEBUG) $ \ioLogger -> do
     -- Sets the locale to avoid encoding issues like in #284.

src/Gargantext/API.hs

@@ -61,12 +61,10 @@ import Network.Wai (Middleware, Request, requestHeaders)
 import Network.Wai.Handler.Warp hiding (defaultSettings)
 import Network.Wai.Middleware.Cors
 import Network.Wai.Middleware.RequestLogger (logStdout)
--- import Paths_gargantext (getDataDir)
 import Servant hiding (Header)
 import Servant.Client.Core.BaseUrl (showBaseUrl)
 import System.Clock qualified as Clock
 import System.Cron.Schedule qualified as Cron
--- import System.FilePath
 
 -- | startGargantext takes as parameters port number and Toml file.
 startGargantext :: Mode -> PortNumber -> SettingsFile -> IO ()