{-| Module : Gargantext.API Description : REST API declaration Copyright : (c) CNRS, 2017-Present License : AGPL + CECILL v3 Maintainer : team@gargantext.org Stability : experimental Portability : POSIX Main (RESTful) API of the instance Gargantext. The Garg-API is typed to derive the documentation, the mock and tests. This API is indeed typed in order to be able to derive both the server and the client sides. The Garg-API-Monad enables: - Security (WIP) - Features (WIP) - Database connection (long term) - In Memory stack management (short term) - Logs (WIP) Thanks to Yann Esposito for our discussions at the start and to Nicolas Pouillard (who mainly made it). -} {-# LANGUAGE BangPatterns #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} module Gargantext.API where import Control.Concurrent.Async qualified as Async import Data.Cache qualified as InMemory import Data.List (lookup) import Data.Set qualified as Set import Data.Text (pack) import Data.Text.Encoding qualified as TE import Data.Text.IO (putStrLn) import Gargantext.API.Admin.Auth.Types (AuthContext) import Gargantext.API.Admin.EnvTypes (Env, FireWall(..), Mode(..), env_config, env_jwt_settings) import Gargantext.API.Admin.Settings (newEnv) import Gargantext.API.Middleware (logStdoutDevSanitised) import Gargantext.API.Routes.Named (API) import Gargantext.API.Routes.Named.EKG (EkgAPI) import Gargantext.API.Server.Named (server) import Gargantext.Core.Config import Gargantext.Core.Config.Types (CORSOrigin(..), CORSSettings, MicroServicesProxyStatus(..), NotificationsConfig(..), PortNumber, SettingsFile(..), corsAllowedOrigins, fc_appPort, fc_cors, fc_cookie_settings, microServicesProxyStatus) import Gargantext.Core.Config.Utils (readConfig) import Gargantext.Core.Notifications (withNotifications) import Gargantext.Database.Prelude qualified as DB import Gargantext.MicroServices.ReverseProxy (microServicesProxyApp) import Gargantext.Prelude hiding (putStrLn, to) import Gargantext.System.Logging (withLoggerIO, renderLogLevel) import Network.HTTP.Types hiding (Query) 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 () startGargantext mode port sf@(SettingsFile settingsFile) = withLoggerIO mode $ \logger -> do config <- readConfig sf <&> (gc_frontend_config . fc_appPort) .~ port when (port /= config ^. gc_frontend_config . fc_appPort) $ panicTrace "TODO: conflicting settings of port" withNotifications config $ \dispatcher -> do env <- newEnv logger config dispatcher let fc = env ^. env_config . gc_frontend_config let proxyStatus = microServicesProxyStatus fc runDbCheck env startupInfo config port proxyStatus app <- makeApp env mid <- makeGargMiddleware (fc ^. fc_cors) mode periodicActions <- schedulePeriodicActions env let runServer = run port (mid app) `finally` stopGargantext periodicActions case proxyStatus of PXY_disabled -> runServer -- the proxy is disabled, do not spawn the application PXY_enabled proxyPort -> do proxyCache <- InMemory.newCache (Just oneHour) let runProxy = run proxyPort (mid (microServicesProxyApp proxyCache env)) Async.race_ runServer runProxy where runDbCheck env = do r <- runExceptT (runReaderT DB.dbCheck env) `catch` (\(err :: SomeException) -> pure $ Left err) case r of Right True -> pure () Right False -> panicTrace $ "You must run 'gargantext init -c " <> pack settingsFile <> "' before running gargantext-server (only the first time)." Left err -> panicTrace $ "Unexpected exception:" <> show err oneHour = Clock.fromNanoSecs 3600_000_000_000 startupInfo :: GargConfig -> PortNumber -> MicroServicesProxyStatus -> IO () startupInfo config mainPort proxyStatus = do putStrLn "==========================================================================================================" putStrLn " GarganText Server" putStrLn "==========================================================================================================" putStrLn $ " - Log Level ...............................: " <> renderLogLevel ll putStrLn $ " - Web GarganText Frontend..................: " <> "http://localhost:" <> toUrlPiece mainPort <> "/index.html" putStrLn $ " - Swagger UI (API documentation)...........: " <> "http://localhost:" <> toUrlPiece mainPort <> "/swagger-ui" putStrLn $ " - Playground GraphQL (API documentation)...: " <> "http://localhost:" <> toUrlPiece mainPort <> "/gql" -- putStrLn $ " - Microservices proxy .....................: " <> "http://localhost:" <> toUrlPiece proxyStatus putStrLn renderProxyStatus putStrLn $ " - Central exchange.........................: " <> "nanomsg: " <> _nc_central_exchange_bind nc putStrLn $ " - Dispatcher internal......................: " <> "nanomsg: " <> _nc_dispatcher_bind nc putStrLn $ " - WebSocket address........................: " <> "ws://localhost:" <> toUrlPiece mainPort <> "/ws" putStrLn "==========================================================================================================" where nc = config ^. gc_notifications_config ll = config ^. gc_logging . lc_log_level renderProxyStatus = case proxyStatus of PXY_disabled -> " - Microservices proxy .....................: DISABLED (enable in gargantext-settings.toml)" PXY_enabled proxyPort -> " - Microservices proxy .....................: http://localhost:" <> toUrlPiece proxyPort -- | Stops the gargantext server and cancels all the periodic actions -- scheduled to run up to that point. -- TODO clean this Monad condition (more generic) ? stopGargantext :: [ThreadId] -> IO () stopGargantext scheduledPeriodicActions = do forM_ scheduledPeriodicActions killThread putStrLn "----- Stopping gargantext -----" -- | Schedules all sorts of useful periodic actions to be run while -- the server is alive accepting requests. schedulePeriodicActions :: env -> IO [ThreadId] schedulePeriodicActions _env = -- Add your scheduled actions here. let actions = [ -- refreshDBViews ] in foldlM (\ !acc action -> (`mappend` acc) <$> Cron.execSchedule action) [] actions {- where refreshDBViews :: Cron.Schedule () refreshDBViews = do let doRefresh = do res <- DB.runCmd env (refreshNgramsMaterialized :: Cmd IOException ()) case res of Left e -> liftIO $ putStrLn $ pack ("Refreshing Ngrams materialized view failed: " <> displayException e) Right () -> do _ <- liftIO $ putStrLn $ pack "Refresh Index Database done" pure () Cron.addJob doRefresh "* 2 * * *" -} ---------------------------------------------------------------------- fireWall :: Applicative f => Request -> FireWall -> f Bool fireWall req fw = do let origin = lookup "Origin" (requestHeaders req) let host = lookup "Host" (requestHeaders req) if origin == Just (encodeUtf8 "http://localhost:8008") && host == Just (encodeUtf8 "localhost:3000") || (not $ unFireWall fw) then pure True else pure False makeGargMiddleware :: CORSSettings -> Mode -> IO Middleware makeGargMiddleware crsSettings mode = do let corsMiddleware = cors $ \_incomingRq -> Just simpleCorsResourcePolicy { corsOrigins = Just $ (Set.toList $ Set.fromList $ map mkCorsOrigin (crsSettings ^. corsAllowedOrigins), True) , corsMethods = [ methodGet , methodPost , methodPut , methodDelete, methodOptions, methodHead] , corsIgnoreFailures = False , corsRequestHeaders = ["authorization", "content-type", "x-garg-error-scheme"] , corsMaxAge = Just ( 60*60*24 ) -- one day } case mode of Prod -> pure $ logStdout . corsMiddleware _ -> do loggerMiddleware <- logStdoutDevSanitised pure $ loggerMiddleware . corsMiddleware where mkCorsOrigin :: CORSOrigin -> Origin mkCorsOrigin (CORSOrigin u) = TE.encodeUtf8 . pack . showBaseUrl $ u --------------------------------------------------------------------- -- | API Global --------------------------------------------------------------------- makeApp :: Env -> IO Application makeApp env = do pure $ serveWithContext api cfg (server env) -- (ekgStore, ekgMid) <- newEkgStore api -- ekgDir <- ( "ekg-assets") <$> getDataDir -- pure $ ekgMid $ serveWithContext apiWithEkg cfg -- (WithEkg { ekgAPI = ekgServer ekgDir ekgStore -- , wrappedAPI = server env -- }) where cfg :: Servant.Context AuthContext cfg = env ^. env_jwt_settings :. env ^. env_config . gc_frontend_config . fc_cookie_settings :. EmptyContext --------------------------------------------------------------------- api :: Proxy (NamedRoutes API) api = Proxy data WithEkg api mode = WithEkg { ekgAPI :: mode :- NamedRoutes EkgAPI , wrappedAPI :: mode :- NamedRoutes api } deriving Generic apiWithEkg :: Proxy (NamedRoutes (WithEkg API)) apiWithEkg = Proxy