{-# LANGUAGE TemplateHaskell #-} {-| Module : CLI.Server Description : Gargantext Server Copyright : (c) CNRS, 2017-Present License : AGPL + CECILL v3 Maintainer : team@gargantext.org Stability : experimental Portability : POSIX -} 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 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 Options.Applicative import Paths_gargantext qualified as PG -- cabal magic build module withServerCLILogger :: ServerArgs -> (Logger IO -> IO a) -> IO a withServerCLILogger ServerArgs{..} f = do cfg <- liftIO $ readConfig server_toml withLogger (cfg ^. gc_logging) $ \logger -> f logger serverCLI :: CLIServer -> IO () serverCLI (CLIS_start serverArgs) = withServerCLILogger serverArgs $ \ioLogger -> startServerCLI ioLogger serverArgs serverCLI (CLIS_startAll serverArgs@(ServerArgs { .. })) = withServerCLILogger serverArgs $ \ioLogger -> do withAsync (startServerCLI ioLogger serverArgs) $ \aServer -> do 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. setLocaleEncoding utf8 logMsg ioLogger INFO $ "Version: " <> showVersion PG.version serverCmd :: HasCallStack => Mod CommandFields CLI serverCmd = command "server" (info (helper <*> (fmap CLISub $ fmap CCMD_server serverParser)) (progDesc "Gargantext server.")) serverParser :: Parser CLIServer serverParser = hsubparser ( command "start" (info (helper <*> start_p) (progDesc "Start the server")) <> command "start-all" (info (helper <*> start_all_p) (progDesc "Start the server and all workers (forked)")) <> command "version" (info (helper <*> version_p) (progDesc "Show version and exit")) ) start_p :: Parser CLIServer start_p = fmap CLIS_start $ ServerArgs <$> mode_p <*> settings_p start_all_p :: Parser CLIServer start_all_p = fmap CLIS_startAll $ ServerArgs <$> mode_p <*> settings_p mode_p :: Parser Mode mode_p = option auto ( long "mode" <> short 'm' <> metavar "M" <> help "Possible modes: Dev | Mock | Prod" ) version_p :: Parser CLIServer version_p = pure CLIS_version startServerCLI :: Logger IO -> ServerArgs -> IO () startServerCLI ioLogger (ServerArgs { .. }) = do logMsg ioLogger INFO $ "starting server, mode: " <> show server_mode <> ", config: " <> _SettingsFile server_toml -- Sets the locale to avoid encoding issues like in #284. setLocaleEncoding utf8 when (server_mode == Mock) $ do logMsg ioLogger ERROR "Mock mode not supported!" exitFailure startGargantext server_mode server_toml