[config] add internal_url to toml file

This is used mainly to specify at which port the server will listen.

The 'url' param is the external URL (sometimes it's needed for the
server to know where it is hosted, e.g. when sending out emails).
parent 713ec1a9
......@@ -11,10 +11,7 @@ Import a corpus binary.
-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE Strict #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE TypeApplications #-}
module CLI.Ini where
......@@ -103,6 +100,7 @@ convertConfigs ini@(Ini.GargConfig { .. }) iniMail nlpConfig connInfo =
mkFrontendConfig :: Ini.GargConfig -> CTypes.FrontendConfig
mkFrontendConfig (Ini.GargConfig { .. }) =
CTypes.FrontendConfig { _fc_url
, _fc_internal_url = _fc_url
, _fc_backend_name = _gc_backend_name
, _fc_url_backend_api = _gc_url_backend_api
, _fc_cors
......
[frontend]
# Main url serving the FrontEnd
# Main url serving the FrontEnd (public URL)
url = "http://localhost:8008"
# in case this is behind a reverse proxy
internal_url = "http://localhost:8008"
backend_name = "localhost"
......
......@@ -49,7 +49,7 @@ 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_cors, fc_cookie_settings, fc_url, microServicesProxyStatus)
import Gargantext.Core.Config.Types (CORSOrigin(..), CORSSettings, MicroServicesProxyStatus(..), NotificationsConfig(..), PortNumber, SettingsFile(..), corsAllowedOrigins, fc_cors, fc_cookie_settings, fc_internal_url, microServicesProxyStatus)
import Gargantext.Core.Config.Utils (readConfig)
import Gargantext.Core.Notifications (withNotifications)
import Gargantext.Database.Prelude qualified as DB
......@@ -75,7 +75,7 @@ startGargantext mode sf@(SettingsFile settingsFile) = do
env <- newEnv logger config dispatcher
let fc = env ^. env_config . gc_frontend_config
let proxyStatus = microServicesProxyStatus fc
let port = baseUrlPort (fc ^. fc_url)
let port = baseUrlPort (fc ^. fc_internal_url)
runDbCheck env
startupInfo config port proxyStatus
app <- makeApp env
......
......@@ -28,6 +28,7 @@ module Gargantext.Core.Config.Types
, PortNumber
, FrontendConfig(..)
, fc_url
, fc_internal_url
, fc_backend_name
, fc_url_backend_api
, fc_cors
......@@ -200,6 +201,7 @@ defaultCookieSettings = SAuth.defaultCookieSettings { cookieXsrfSetting = Just x
-- TODO jwtSettings = defaultJWTSettings
data FrontendConfig =
FrontendConfig { _fc_url :: !BaseUrl
, _fc_internal_url :: !BaseUrl
, _fc_backend_name :: !Text
, _fc_url_backend_api :: !Text
, _fc_cors :: !CORSSettings
......@@ -214,6 +216,11 @@ instance FromValue FrontendConfig where
case parseBaseUrl (T.unpack _fc_url_txt) of
Nothing -> fail "cannot parse fc_url"
Just b -> pure b
_fc_internal_url_txt <- reqKey "internal_url"
_fc_internal_url <-
case parseBaseUrl (T.unpack _fc_internal_url_txt) of
Nothing -> fail "cannot parse fc_internal_url"
Just b -> pure b
_fc_backend_name <- reqKey "backend_name"
_fc_url_backend_api <- reqKey "url_backend_api"
_fc_cors <- reqKey "cors"
......@@ -223,11 +230,13 @@ instance FromValue FrontendConfig where
instance ToValue FrontendConfig where
toValue = defaultTableToValue
instance ToTable FrontendConfig where
toTable (FrontendConfig { .. }) = table [ "url" .= (T.pack $ showBaseUrl _fc_url)
, "backend_name" .= _fc_backend_name
, "url_backend_api" .= _fc_url_backend_api
, "cors" .= _fc_cors
, "microservices" .= _fc_microservices ]
toTable (FrontendConfig { .. }) = table
[ "url" .= (T.pack $ showBaseUrl _fc_url)
, "internal_url" .= (T.pack $ showBaseUrl _fc_internal_url)
, "backend_name" .= _fc_backend_name
, "url_backend_api" .= _fc_url_backend_api
, "cors" .= _fc_cors
, "microservices" .= _fc_microservices ]
makeLenses ''FrontendConfig
......
[frontend]
url = "http://localhost"
internal_url = "http://localhost"
backend_name = "localhost"
url_backend_api = "http://localhost:8008/api/v1.0"
jwt_settings = "TODO"
......
......@@ -25,7 +25,7 @@ import Gargantext.API.Admin.EnvTypes (Env (..), env_dispatcher)
import Gargantext.API.Errors.Types
import Gargantext.API.Prelude
import Gargantext.Core.Config hiding (jwtSettings)
import Gargantext.Core.Config.Types (jwtSettings, fc_url)
import Gargantext.Core.Config.Types (jwtSettings, fc_url, fc_internal_url)
import Gargantext.Core.Notifications (withNotifications)
import Gargantext.Core.Types.Individu
import Gargantext.Database.Action.Flow
......@@ -74,7 +74,9 @@ newTestEnv :: TestEnv -> Logger (GargM Env BackendInternalError) -> Warp.Port ->
newTestEnv testEnv logger port = do
!manager_env <- newTlsManager
let config_env = test_config testEnv & (gc_frontend_config . fc_url) %~ (\b -> b { baseUrlPort = port })
let config_env = test_config testEnv
& (gc_frontend_config . fc_url) %~ (\b -> b { baseUrlPort = port })
& (gc_frontend_config . fc_internal_url) %~ (\b -> b { baseUrlPort = port })
-- dbParam <- pure $ testEnvToPgConnectionInfo testEnv
-- !pool <- newPool dbParam
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment