[config] some Settings moved directly to GargConfig

Eventually, Settings will be removed
parent 5c443218
...@@ -83,7 +83,8 @@ mkFrontendConfig (Ini.GargConfig { .. }) = ...@@ -83,7 +83,8 @@ mkFrontendConfig (Ini.GargConfig { .. }) =
, _fc_url_backend_api = _gc_url_backend_api , _fc_url_backend_api = _gc_url_backend_api
, _fc_jwt_settings = "TODO" , _fc_jwt_settings = "TODO"
, _fc_cors , _fc_cors
, _fc_microservices} , _fc_microservices
, _fc_appPort = 3000 }
where where
_fc_cors = CTypes.CORSSettings { _corsAllowedOrigins = [ _fc_cors = CTypes.CORSSettings { _corsAllowedOrigins = [
toCORSOrigin "https://demo.gargantext.org" toCORSOrigin "https://demo.gargantext.org"
......
...@@ -30,12 +30,12 @@ Pouillard (who mainly made it). ...@@ -30,12 +30,12 @@ Pouillard (who mainly made it).
{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeOperators #-}
module Gargantext.API module Gargantext.API
where where
import Control.Concurrent import Control.Concurrent
import Control.Concurrent.Async qualified as Async import Control.Concurrent.Async qualified as Async
import Control.Lens hiding (Level)
import Data.Cache qualified as InMemory import Data.Cache qualified as InMemory
import Data.List (lookup) import Data.List (lookup)
import Data.Set qualified as Set import Data.Set qualified as Set
...@@ -44,18 +44,18 @@ import Data.Text.Encoding qualified as TE ...@@ -44,18 +44,18 @@ import Data.Text.Encoding qualified as TE
import Data.Text.IO (putStrLn) import Data.Text.IO (putStrLn)
import Data.Validity import Data.Validity
import Gargantext.API.Admin.Auth.Types (AuthContext) import Gargantext.API.Admin.Auth.Types (AuthContext)
import Gargantext.API.Admin.EnvTypes (Env, Mode(..), _env_config) import Gargantext.API.Admin.EnvTypes (Env, Mode(..), env_config)
import Gargantext.API.Admin.Settings (newEnv) import Gargantext.API.Admin.Settings (newEnv)
import Gargantext.API.Admin.Types (FireWall(..), MicroServicesProxyStatus(..), PortNumber, cookieSettings, jwtSettings, settings, corsSettings, microServicesProxyStatus) import Gargantext.API.Admin.Types (FireWall(..), cookieSettings, jwtSettings, settings)
import Gargantext.API.Middleware (logStdoutDevSanitised) import Gargantext.API.Middleware (logStdoutDevSanitised)
import Gargantext.API.Routes.Named (API) import Gargantext.API.Routes.Named (API)
import Gargantext.API.Routes.Named.EKG import Gargantext.API.Routes.Named.EKG
import Gargantext.API.Server.Named (server) import Gargantext.API.Server.Named (server)
import Gargantext.Core.Config (_gc_notifications_config) import Gargantext.Core.Config (gc_notifications_config, gc_frontend_config)
import Gargantext.Core.Config.Types (CORSOrigin(..), CORSSettings, NotificationsConfig(..), SettingsFile(..), corsAllowedOrigins) import Gargantext.Core.Config.Types (CORSOrigin(..), CORSSettings, MicroServicesProxyStatus(..), NotificationsConfig(..), PortNumber, SettingsFile(..), corsAllowedOrigins, fc_cors, microServicesProxyStatus)
import Gargantext.Database.Prelude qualified as DB import Gargantext.Database.Prelude qualified as DB
import Gargantext.MicroServices.ReverseProxy (microServicesProxyApp) import Gargantext.MicroServices.ReverseProxy (microServicesProxyApp)
import Gargantext.Prelude hiding (putStrLn) import Gargantext.Prelude hiding (putStrLn, to)
import Gargantext.System.Logging import Gargantext.System.Logging
import Network.HTTP.Types hiding (Query) import Network.HTTP.Types hiding (Query)
import Network.Wai import Network.Wai
...@@ -73,11 +73,12 @@ import System.Cron.Schedule qualified as Cron ...@@ -73,11 +73,12 @@ import System.Cron.Schedule qualified as Cron
startGargantext :: Mode -> PortNumber -> SettingsFile -> IO () startGargantext :: Mode -> PortNumber -> SettingsFile -> IO ()
startGargantext mode port sf@(SettingsFile settingsFile) = withLoggerHoisted mode $ \logger -> do startGargantext mode port sf@(SettingsFile settingsFile) = withLoggerHoisted mode $ \logger -> do
env <- newEnv logger port sf env <- newEnv logger port sf
let proxyStatus = microServicesProxyStatus (env ^. settings) let fc = env ^. env_config . gc_frontend_config
let proxyStatus = microServicesProxyStatus fc
runDbCheck env runDbCheck env
portRouteInfo (_gc_notifications_config $ _env_config env) port proxyStatus portRouteInfo (env ^. env_config . gc_notifications_config) port proxyStatus
app <- makeApp env app <- makeApp env
mid <- makeGargMiddleware (env ^. settings.corsSettings) mode mid <- makeGargMiddleware (fc ^. fc_cors) mode
periodicActions <- schedulePeriodicActions env periodicActions <- schedulePeriodicActions env
let runServer = run port (mid app) `finally` stopGargantext periodicActions let runServer = run port (mid app) `finally` stopGargantext periodicActions
......
...@@ -10,6 +10,7 @@ module Gargantext.API.Admin.EnvTypes ( ...@@ -10,6 +10,7 @@ module Gargantext.API.Admin.EnvTypes (
, Mode(..) , Mode(..)
, modeToLoggingLevels , modeToLoggingLevels
, mkJobHandle , mkJobHandle
, env_config
, env_logger , env_logger
, env_manager , env_manager
, env_settings , env_settings
......
...@@ -32,8 +32,8 @@ import Gargantext.API.Errors.Types ...@@ -32,8 +32,8 @@ import Gargantext.API.Errors.Types
import Gargantext.API.Prelude import Gargantext.API.Prelude
import Gargantext.Core.AsyncUpdates.CentralExchange qualified as CE import Gargantext.Core.AsyncUpdates.CentralExchange qualified as CE
import Gargantext.Core.AsyncUpdates.Dispatcher qualified as D import Gargantext.Core.AsyncUpdates.Dispatcher qualified as D
import Gargantext.Core.Config (GargConfig(..), gc_jobs) import Gargantext.Core.Config (GargConfig(..), gc_jobs, gc_frontend_config)
import Gargantext.Core.Config.Types (SettingsFile(..), _fc_cors, _fc_microservices, jc_js_job_timeout, jc_js_id_timeout) import Gargantext.Core.Config.Types (PortNumber, SettingsFile(..), fc_appPort, jc_js_job_timeout, jc_js_id_timeout)
import Gargantext.Core.Config.Utils (readConfig) import Gargantext.Core.Config.Utils (readConfig)
import Gargantext.Core.NLP (nlpServerMap) import Gargantext.Core.NLP (nlpServerMap)
import Gargantext.Core.NodeStory import Gargantext.Core.NodeStory
...@@ -59,20 +59,16 @@ newtype JwkFile = JwkFile { _JwkFile :: FilePath } ...@@ -59,20 +59,16 @@ newtype JwkFile = JwkFile { _JwkFile :: FilePath }
newtype IniFile = IniFile { _IniFile :: FilePath } newtype IniFile = IniFile { _IniFile :: FilePath }
deriving (Show, Eq, IsString) deriving (Show, Eq, IsString)
devSettings :: JwkFile -> SettingsFile -> IO Settings devSettings :: JwkFile -> IO Settings
devSettings (JwkFile jwkFile) settingsFile = do devSettings (JwkFile jwkFile) = do
jwkExists <- doesFileExist jwkFile jwkExists <- doesFileExist jwkFile
when (not jwkExists) $ writeKey jwkFile when (not jwkExists) $ writeKey jwkFile
jwk <- readKey jwkFile jwk <- readKey jwkFile
-- GargTomlSettings{..} <- loadGargTomlSettings settingsFile -- GargTomlSettings{..} <- loadGargTomlSettings settingsFile
gc@(GargConfig {}) <- readConfig settingsFile
pure $ Settings pure $ Settings
{ -- _corsSettings = _gargCorsSettings { -- _corsSettings = _gargCorsSettings
_corsSettings = _fc_cors $ _gc_frontend_config gc
-- , _microservicesSettings = _gargMicroServicesSettings -- , _microservicesSettings = _gargMicroServicesSettings
, _microservicesSettings = _fc_microservices $ _gc_frontend_config gc _logLevelLimit = LevelDebug
, _appPort = 3000
, _logLevelLimit = LevelDebug
-- , _dbServer = "localhost" -- , _dbServer = "localhost"
, _sendLoginEmails = LogEmailToConsole , _sendLoginEmails = LogEmailToConsole
, _scrapydUrl = fromMaybe (panicTrace "Invalid scrapy URL") $ parseBaseUrl "http://localhost:6800" , _scrapydUrl = fromMaybe (panicTrace "Invalid scrapy URL") $ parseBaseUrl "http://localhost:6800"
...@@ -187,11 +183,11 @@ devJwkFile = JwkFile "dev.jwk" ...@@ -187,11 +183,11 @@ devJwkFile = JwkFile "dev.jwk"
newEnv :: Logger (GargM Env BackendInternalError) -> PortNumber -> SettingsFile -> IO Env newEnv :: Logger (GargM Env BackendInternalError) -> PortNumber -> SettingsFile -> IO Env
newEnv logger port settingsFile@(SettingsFile sf) = do newEnv logger port settingsFile@(SettingsFile sf) = do
!manager_env <- newTlsManager !manager_env <- newTlsManager
!settings' <- devSettings devJwkFile settingsFile <&> appPort .~ port -- TODO read from 'file' !settings' <- devSettings devJwkFile
when (port /= settings' ^. appPort) $ !config_env <- readConfig settingsFile <&> (gc_frontend_config . fc_appPort) .~ port -- TODO read from 'file'
when (port /= config_env ^. gc_frontend_config . fc_appPort) $
panicTrace "TODO: conflicting settings of port" panicTrace "TODO: conflicting settings of port"
!config_env <- readConfig settingsFile
prios <- withLogger () $ \ioLogger -> Jobs.readPrios ioLogger (sf <> ".jobs") prios <- withLogger () $ \ioLogger -> Jobs.readPrios ioLogger (sf <> ".jobs")
let prios' = Jobs.applyPrios prios Jobs.defaultPrios let prios' = Jobs.applyPrios prios Jobs.defaultPrios
putStrLn ("Overrides: " <> show prios :: Text) putStrLn ("Overrides: " <> show prios :: Text)
......
...@@ -5,13 +5,11 @@ module Gargantext.API.Admin.Types where ...@@ -5,13 +5,11 @@ module Gargantext.API.Admin.Types where
import Control.Lens import Control.Lens
import Control.Monad.Logger (LogLevel) import Control.Monad.Logger (LogLevel)
import GHC.Enum import GHC.Enum
import Gargantext.Core.Config.Types
import Gargantext.Prelude import Gargantext.Prelude
import Servant.Auth.Server (JWTSettings, CookieSettings(..)) import Servant.Auth.Server (JWTSettings, CookieSettings(..))
import Servant.Client (BaseUrl) import Servant.Client (BaseUrl)
type PortNumber = Int
data SendEmailType = SendEmailViaAws data SendEmailType = SendEmailViaAws
| LogEmailToConsole | LogEmailToConsole
...@@ -19,10 +17,7 @@ data SendEmailType = SendEmailViaAws ...@@ -19,10 +17,7 @@ data SendEmailType = SendEmailViaAws
deriving (Show, Read, Enum, Bounded, Generic) deriving (Show, Read, Enum, Bounded, Generic)
data Settings = Settings data Settings = Settings
{ _corsSettings :: !CORSSettings -- CORS settings { _logLevelLimit :: !LogLevel -- log level from the monad-logger package
, _microservicesSettings :: !MicroServicesSettings
, _appPort :: !PortNumber
, _logLevelLimit :: !LogLevel -- log level from the monad-logger package
-- , _dbServer :: Text -- , _dbServer :: Text
-- ^ this is not used yet -- ^ this is not used yet
, _jwtSettings :: !JWTSettings , _jwtSettings :: !JWTSettings
...@@ -33,17 +28,6 @@ data Settings = Settings ...@@ -33,17 +28,6 @@ data Settings = Settings
makeLenses ''Settings makeLenses ''Settings
data MicroServicesProxyStatus
= PXY_enabled PortNumber
| PXY_disabled
deriving (Show, Eq)
microServicesProxyStatus :: Settings -> MicroServicesProxyStatus
microServicesProxyStatus stgs =
if stgs ^. microservicesSettings.msProxyEnabled
then PXY_enabled (stgs ^. microservicesSettings.msProxyPort)
else PXY_disabled
class HasSettings env where class HasSettings env where
settings :: Getter env Settings settings :: Getter env Settings
......
...@@ -42,7 +42,7 @@ withDevEnv settingsFile k = withLoggerHoisted Dev $ \logger -> do ...@@ -42,7 +42,7 @@ withDevEnv settingsFile k = withLoggerHoisted Dev $ \logger -> do
--nodeStory_env <- fromDBNodeStoryEnv (_gc_repofilepath cfg) --nodeStory_env <- fromDBNodeStoryEnv (_gc_repofilepath cfg)
pool <- newPool (_gc_database_config cfg) pool <- newPool (_gc_database_config cfg)
nodeStory_env <- fromDBNodeStoryEnv pool nodeStory_env <- fromDBNodeStoryEnv pool
setts <- devSettings devJwkFile settingsFile setts <- devSettings devJwkFile
pure $ DevEnv pure $ DevEnv
{ _dev_env_pool = pool { _dev_env_pool = pool
, _dev_env_logger = logger , _dev_env_logger = logger
......
...@@ -7,11 +7,10 @@ module Gargantext.API.Node.ShareURL where ...@@ -7,11 +7,10 @@ module Gargantext.API.Node.ShareURL where
import Control.Lens import Control.Lens
import Data.Text qualified as T import Data.Text qualified as T
import Data.Validity qualified as V import Data.Validity qualified as V
import Gargantext.API.Admin.Types (appPort, settings, Settings)
import Gargantext.API.Prelude import Gargantext.API.Prelude
import Gargantext.API.Routes.Named.Share qualified as Named import Gargantext.API.Routes.Named.Share qualified as Named
import Gargantext.Core.Config (GargConfig, gc_frontend_config) import Gargantext.Core.Config (GargConfig, gc_frontend_config)
import Gargantext.Core.Config.Types (fc_url) import Gargantext.Core.Config.Types (fc_appPort, fc_url)
import Gargantext.Core.Types (NodeType, NodeId, unNodeId, _ValidationError) import Gargantext.Core.Types (NodeType, NodeId, unNodeId, _ValidationError)
import Gargantext.Database.Prelude (HasConfig (hasConfig), CmdCommon) import Gargantext.Database.Prelude (HasConfig (hasConfig), CmdCommon)
import Gargantext.Prelude import Gargantext.Prelude
...@@ -29,19 +28,17 @@ getUrl :: (IsGargServer env err m, CmdCommon env) ...@@ -29,19 +28,17 @@ getUrl :: (IsGargServer env err m, CmdCommon env)
getUrl nt id = do getUrl nt id = do
-- TODO add check that the node is able to be shared (in a shared folder) -- TODO add check that the node is able to be shared (in a shared folder)
gc <- view hasConfig gc <- view hasConfig
urlPort <- view settings case get_url nt id gc of
case get_url nt id gc urlPort of
Left err -> throwError $ _ValidationError # (V.check False err) Left err -> throwError $ _ValidationError # (V.check False err)
Right shareLink -> pure shareLink Right shareLink -> pure shareLink
get_url :: Maybe NodeType get_url :: Maybe NodeType
-> Maybe NodeId -> Maybe NodeId
-> GargConfig -> GargConfig
-> Settings
-> Either String Named.ShareLink -> Either String Named.ShareLink
get_url nt id gc stgs = do get_url nt id gc = do
let urlHost = T.unpack $ gc ^. gc_frontend_config . fc_url let urlHost = T.unpack $ gc ^. gc_frontend_config . fc_url
let urlPort = stgs ^. appPort let urlPort = gc ^. gc_frontend_config . fc_appPort
t <- maybe (Left "Invalid node Type") Right nt t <- maybe (Left "Invalid node Type") Right nt
i <- maybe (Left "Invalid node ID") Right id i <- maybe (Left "Invalid node ID") Right id
......
...@@ -103,8 +103,8 @@ instance ToTable GargConfig where ...@@ -103,8 +103,8 @@ instance ToTable GargConfig where
] ]
mkProxyUrl :: GargConfig -> MicroServicesSettings -> BaseUrl mkProxyUrl :: GargConfig -> BaseUrl
mkProxyUrl GargConfig{..} MicroServicesSettings{..} = mkProxyUrl GargConfig{..} =
case parseBaseUrl (T.unpack $ _fc_url _gc_frontend_config) of case parseBaseUrl (T.unpack $ _fc_url _gc_frontend_config) of
Nothing -> BaseUrl Http "localhost" 80 "" Nothing -> BaseUrl Http "localhost" 80 ""
Just bh -> bh { baseUrlPort = _msProxyPort } Just bh -> bh { baseUrlPort = _msProxyPort $ _fc_microservices _gc_frontend_config }
...@@ -25,6 +25,7 @@ module Gargantext.Core.Config.Types ...@@ -25,6 +25,7 @@ module Gargantext.Core.Config.Types
, f_visio_url , f_visio_url
, f_searx_url , f_searx_url
, f_istex_url , f_istex_url
, PortNumber
, FrontendConfig(..) , FrontendConfig(..)
, fc_url , fc_url
, fc_backend_name , fc_backend_name
...@@ -32,6 +33,9 @@ module Gargantext.Core.Config.Types ...@@ -32,6 +33,9 @@ module Gargantext.Core.Config.Types
, fc_jwt_settings , fc_jwt_settings
, fc_cors , fc_cors
, fc_microservices , fc_microservices
, fc_appPort
, MicroServicesProxyStatus(..)
, microServicesProxyStatus
, JobsConfig(..) , JobsConfig(..)
, jc_max_docs_parsers , jc_max_docs_parsers
, jc_max_docs_scrapers , jc_max_docs_scrapers
...@@ -179,6 +183,10 @@ instance ToTable FramesConfig where ...@@ -179,6 +183,10 @@ instance ToTable FramesConfig where
makeLenses ''FramesConfig makeLenses ''FramesConfig
type PortNumber = Int
-- TODO jwtSettings = defaultJWTSettings
data FrontendConfig = data FrontendConfig =
FrontendConfig { _fc_url :: !Text FrontendConfig { _fc_url :: !Text
, _fc_backend_name :: !Text , _fc_backend_name :: !Text
...@@ -186,6 +194,7 @@ data FrontendConfig = ...@@ -186,6 +194,7 @@ data FrontendConfig =
, _fc_jwt_settings :: !Text , _fc_jwt_settings :: !Text
, _fc_cors :: !CORSSettings , _fc_cors :: !CORSSettings
, _fc_microservices :: !MicroServicesSettings , _fc_microservices :: !MicroServicesSettings
, _fc_appPort :: !PortNumber
} }
deriving (Generic, Show) deriving (Generic, Show)
instance FromValue FrontendConfig where instance FromValue FrontendConfig where
...@@ -196,6 +205,7 @@ instance FromValue FrontendConfig where ...@@ -196,6 +205,7 @@ instance FromValue FrontendConfig where
_fc_jwt_settings <- reqKey "jwt_settings" _fc_jwt_settings <- reqKey "jwt_settings"
_fc_cors <- reqKey "cors" _fc_cors <- reqKey "cors"
_fc_microservices <- reqKey "microservices" _fc_microservices <- reqKey "microservices"
let _fc_appPort = 3000
return $ FrontendConfig { .. } return $ FrontendConfig { .. }
instance ToValue FrontendConfig where instance ToValue FrontendConfig where
toValue = defaultTableToValue toValue = defaultTableToValue
...@@ -209,6 +219,18 @@ instance ToTable FrontendConfig where ...@@ -209,6 +219,18 @@ instance ToTable FrontendConfig where
makeLenses ''FrontendConfig makeLenses ''FrontendConfig
data MicroServicesProxyStatus
= PXY_enabled PortNumber
| PXY_disabled
deriving (Show, Eq)
microServicesProxyStatus :: FrontendConfig -> MicroServicesProxyStatus
microServicesProxyStatus fc =
if fc ^. fc_microservices.msProxyEnabled
then PXY_enabled (fc ^. fc_microservices.msProxyPort)
else PXY_disabled
data SecretsConfig = data SecretsConfig =
SecretsConfig { _s_master_user :: !Text SecretsConfig { _s_master_user :: !Text
......
...@@ -19,10 +19,9 @@ module Gargantext.Database.Action.Node ...@@ -19,10 +19,9 @@ module Gargantext.Database.Action.Node
import Control.Lens (view) import Control.Lens (view)
import Data.Text qualified as T import Data.Text qualified as T
import Gargantext.API.Admin.Types (settings, _microservicesSettings, HasSettings)
import Gargantext.Core import Gargantext.Core
import Gargantext.Core.Config (GargConfig(..), mkProxyUrl) import Gargantext.Core.Config (GargConfig(..), gc_frames, gc_frontend_config, mkProxyUrl)
import Gargantext.Core.Config.Types (FramesConfig(..), MicroServicesSettings(..), SecretsConfig(..)) import Gargantext.Core.Config.Types (FramesConfig(..), f_write_url, fc_microservices, MicroServicesSettings(..), SecretsConfig(..))
import Gargantext.Core.Types (Name) import Gargantext.Core.Types (Name)
import Gargantext.Database.Admin.Types.Hyperdata import Gargantext.Database.Admin.Types.Hyperdata
import Gargantext.Database.Admin.Types.Hyperdata.Default import Gargantext.Database.Admin.Types.Hyperdata.Default
...@@ -37,7 +36,7 @@ import Servant.Client.Core.BaseUrl ...@@ -37,7 +36,7 @@ import Servant.Client.Core.BaseUrl
------------------------------------------------------------------------ ------------------------------------------------------------------------
-- | TODO mk all others nodes -- | TODO mk all others nodes
mkNodeWithParent :: (HasNodeError err, HasDBid NodeType, HasSettings env) mkNodeWithParent :: (HasNodeError err, HasDBid NodeType)
=> NodeType => NodeType
-> Maybe ParentId -> Maybe ParentId
-> UserId -> UserId
...@@ -71,7 +70,7 @@ mkNodeWithParent nt (Just pId) uId name = (:[]) <$> insertNode nt (Just name) N ...@@ -71,7 +70,7 @@ mkNodeWithParent nt (Just pId) uId name = (:[]) <$> insertNode nt (Just name) N
-- | Sugar to create a node, get its NodeId and update its Hyperdata after -- | Sugar to create a node, get its NodeId and update its Hyperdata after
mkNodeWithParent_ConfigureHyperdata :: (HasNodeError err, HasDBid NodeType, HasSettings env) mkNodeWithParent_ConfigureHyperdata :: (HasNodeError err, HasDBid NodeType)
=> NodeType => NodeType
-> Maybe ParentId -> Maybe ParentId
-> UserId -> UserId
...@@ -95,15 +94,15 @@ mkNodeWithParent_ConfigureHyperdata _ _ _ _ = nodeError NotImplYet ...@@ -95,15 +94,15 @@ mkNodeWithParent_ConfigureHyperdata _ _ _ _ = nodeError NotImplYet
-- | Creates the base URL for the notes microservices proxy, or defaults -- | Creates the base URL for the notes microservices proxy, or defaults
-- to the notes microservice if the proxy has been disabled from the settings. -- to the notes microservice if the proxy has been disabled from the settings.
internalNotesProxy :: GargConfig -> MicroServicesSettings -> T.Text internalNotesProxy :: GargConfig -> T.Text
internalNotesProxy cfg msSettings internalNotesProxy cfg
| _msProxyEnabled msSettings = T.pack $ showBaseUrl proxyUrl <> "/notes" | _msProxyEnabled (cfg ^. gc_frontend_config . fc_microservices) = T.pack $ showBaseUrl proxyUrl <> "/notes"
| otherwise = _f_write_url $ _gc_frames cfg | otherwise = cfg ^. gc_frames . f_write_url
where where
proxyUrl = mkProxyUrl cfg msSettings proxyUrl = mkProxyUrl cfg
-- | Function not exposed -- | Function not exposed
mkNodeWithParent_ConfigureHyperdata' :: (HasNodeError err, HasDBid NodeType, HasSettings env) mkNodeWithParent_ConfigureHyperdata' :: (HasNodeError err, HasDBid NodeType)
=> NodeType => NodeType
-> Maybe ParentId -> Maybe ParentId
-> UserId -> UserId
...@@ -117,9 +116,8 @@ mkNodeWithParent_ConfigureHyperdata' nt (Just i) uId name = do ...@@ -117,9 +116,8 @@ mkNodeWithParent_ConfigureHyperdata' nt (Just i) uId name = do
_ -> nodeError NeedsConfiguration _ -> nodeError NeedsConfiguration
cfg <- view hasConfig cfg <- view hasConfig
stt <- view settings
u <- case nt of u <- case nt of
Notes -> pure $ internalNotesProxy cfg (_microservicesSettings stt) Notes -> pure $ internalNotesProxy cfg
Calc -> pure $ _f_calc_url $ _gc_frames cfg Calc -> pure $ _f_calc_url $ _gc_frames cfg
NodeFrameVisio -> pure $ _f_visio_url $ _gc_frames cfg NodeFrameVisio -> pure $ _f_visio_url $ _gc_frames cfg
_ -> nodeError NeedsConfiguration _ -> nodeError NeedsConfiguration
......
{-# LANGUAGE LambdaCase #-} {-# LANGUAGE LambdaCase #-}
{-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeOperators #-}
{-# LANGUAGE ViewPatterns #-} {-# LANGUAGE ViewPatterns #-}
...@@ -17,8 +16,6 @@ module Gargantext.MicroServices.ReverseProxy ( ...@@ -17,8 +16,6 @@ module Gargantext.MicroServices.ReverseProxy (
, FrameId(..) , FrameId(..)
) where ) where
import Prelude
import Conduit import Conduit
import Data.ByteString qualified as B import Data.ByteString qualified as B
import Data.ByteString.Builder import Data.ByteString.Builder
...@@ -158,7 +155,7 @@ type ProxyCache = InMemory.Cache FrameId NodeId ...@@ -158,7 +155,7 @@ type ProxyCache = InMemory.Cache FrameId NodeId
microServicesProxyApp :: ProxyCache -> Env -> Application microServicesProxyApp :: ProxyCache -> Env -> Application
microServicesProxyApp cache env = genericServeTWithContext id (server cache env) cfg microServicesProxyApp cache env = genericServeTWithContext identity (server cache env) cfg
where where
cfg :: Context AuthContext cfg :: Context AuthContext
cfg = env ^. settings . jwtSettings cfg = env ^. settings . jwtSettings
...@@ -212,10 +209,10 @@ notesProxyImplementation :: ProxyCache -> Env -> NotesProxy AsServer ...@@ -212,10 +209,10 @@ notesProxyImplementation :: ProxyCache -> Env -> NotesProxy AsServer
notesProxyImplementation cache env = NotesProxy { notesProxyImplementation cache env = NotesProxy {
slideEp = \frameId -> slideProxyServer env frameId slideEp = \frameId -> slideProxyServer env frameId
, publishEp = \frameId -> publishProxyServer cache env frameId , publishEp = \frameId -> publishProxyServer cache env frameId
, configFile = defaultForwardServerWithSettings sty id env (configFileSettings env sty) , configFile = defaultForwardServerWithSettings sty identity env (configFileSettings env sty)
, notesSocket = socketIOProxyImplementation sty env , notesSocket = socketIOProxyImplementation sty env
, meEndpoint = proxyPassServer sty env , meEndpoint = proxyPassServer sty env
, notesEp = \frameId mbNodeId -> notesForwardServer cache frameId mbNodeId sty id env , notesEp = \frameId mbNodeId -> notesForwardServer cache frameId mbNodeId sty identity env
, notesStaticAssets = proxyPassServer sty env , notesStaticAssets = proxyPassServer sty env
} }
where where
...@@ -224,7 +221,7 @@ notesProxyImplementation cache env = NotesProxy { ...@@ -224,7 +221,7 @@ notesProxyImplementation cache env = NotesProxy {
socketIOProxyImplementation :: ServiceType -> Env -> SocketIOProxy AsServer socketIOProxyImplementation :: ServiceType -> Env -> SocketIOProxy AsServer
socketIOProxyImplementation sty env = SocketIOProxy { socketIOProxyImplementation sty env = SocketIOProxy {
socketIoEp = \_noteId -> defaultForwardServer sty id id env socketIoEp = \_noteId -> defaultForwardServer sty identity identity env
} }
removeServiceFromPath :: ServiceType -> Request -> Request removeServiceFromPath :: ServiceType -> Request -> Request
...@@ -236,7 +233,7 @@ removeServiceFromPath sty = removeProxyPath (T.pack $ serviceTypeToProxyPath sty ...@@ -236,7 +233,7 @@ removeServiceFromPath sty = removeProxyPath (T.pack $ serviceTypeToProxyPath sty
slideProxyServer :: Env -> FrameId -> ServerT Raw m slideProxyServer :: Env -> FrameId -> ServerT Raw m
slideProxyServer env (FrameId frameId) = slideProxyServer env (FrameId frameId) =
defaultForwardServer ST_notes (\rq -> rq { rawPathInfo = changePath (rawPathInfo rq) }) id env defaultForwardServer ST_notes (\rq -> rq { rawPathInfo = changePath (rawPathInfo rq) }) identity env
where where
changePath :: ByteString -> ByteString changePath :: ByteString -> ByteString
changePath _ = TE.encodeUtf8 $ "/p/" <> frameId <> "#/" changePath _ = TE.encodeUtf8 $ "/p/" <> frameId <> "#/"
...@@ -253,7 +250,7 @@ publishProxyServer cache env frameId = Tagged $ \req res -> do ...@@ -253,7 +250,7 @@ publishProxyServer cache env frameId = Tagged $ \req res -> do
Just nodeId Just nodeId
-> do -> do
-- Using a mock for now. -- Using a mock for now.
case Share.get_url (Just Notes) (Just nodeId) (_env_config env) (_env_settings env) of case Share.get_url (Just Notes) (Just nodeId) (_env_config env) of
Left _e -> Left _e ->
-- Invalid link, treat this as a normal proxy -- Invalid link, treat this as a normal proxy
forwardRaw req res forwardRaw req res
...@@ -264,14 +261,14 @@ publishProxyServer cache env frameId = Tagged $ \req res -> do ...@@ -264,14 +261,14 @@ publishProxyServer cache env frameId = Tagged $ \req res -> do
where where
forwardRaw = forwardRaw =
unTagged (defaultForwardServer ST_notes (\rq -> rq { rawPathInfo = changePath (rawPathInfo rq) }) id env) unTagged (defaultForwardServer ST_notes (\rq -> rq { rawPathInfo = changePath (rawPathInfo rq) }) identity env)
changePath :: ByteString -> ByteString changePath :: ByteString -> ByteString
changePath _ = TE.encodeUtf8 $ "/s/" <> (_FrameId frameId) changePath _ = TE.encodeUtf8 $ "/s/" <> (_FrameId frameId)
-- Generic server forwarder -- Generic server forwarder
proxyPassServer :: ServiceType -> Env -> ServerT Raw m proxyPassServer :: ServiceType -> Env -> ServerT Raw m
proxyPassServer sty env = defaultForwardServer sty id id env proxyPassServer sty env = defaultForwardServer sty identity identity env
mkProxyDestination :: Env -> ProxyDestination mkProxyDestination :: Env -> ProxyDestination
mkProxyDestination env = fromMaybe (panicTrace "Invalid URI found in the proxied Request.") $ do mkProxyDestination env = fromMaybe (panicTrace "Invalid URI found in the proxied Request.") $ do
...@@ -284,8 +281,8 @@ mkProxyDestination env = fromMaybe (panicTrace "Invalid URI found in the proxied ...@@ -284,8 +281,8 @@ mkProxyDestination env = fromMaybe (panicTrace "Invalid URI found in the proxied
removeFromReferer :: T.Text -> Request -> Request removeFromReferer :: T.Text -> Request -> Request
removeFromReferer pth originalRequest = removeFromReferer pth originalRequest =
originalRequest { requestHeaders = (Prelude.map tweakReferer (requestHeaders originalRequest)) originalRequest { requestHeaders = map tweakReferer (requestHeaders originalRequest)
} }
where where
tweakReferer :: Header -> Header tweakReferer :: Header -> Header
tweakReferer (k,v) tweakReferer (k,v)
...@@ -295,7 +292,7 @@ removeFromReferer pth originalRequest = ...@@ -295,7 +292,7 @@ removeFromReferer pth originalRequest =
= (k,v) = (k,v)
proxyUrl :: Env -> BaseUrl proxyUrl :: Env -> BaseUrl
proxyUrl env = mkProxyUrl (env ^. hasConfig) (env ^. env_settings . microservicesSettings) proxyUrl env = mkProxyUrl (env ^. hasConfig)
notesForwardServer :: ProxyCache notesForwardServer :: ProxyCache
-> FrameId -> FrameId
...@@ -307,7 +304,7 @@ notesForwardServer :: ProxyCache ...@@ -307,7 +304,7 @@ notesForwardServer :: ProxyCache
notesForwardServer cache frameId mbNodeId sty presendModifyRequest env = notesForwardServer cache frameId mbNodeId sty presendModifyRequest env =
case mbNodeId of case mbNodeId of
Nothing Nothing
-> defaultForwardServer sty presendModifyRequest id env -> defaultForwardServer sty presendModifyRequest identity env
Just nid Just nid
-> do -> do
-- Persist the node id in the cache -- Persist the node id in the cache
...@@ -317,7 +314,7 @@ notesForwardServer cache frameId mbNodeId sty presendModifyRequest env = ...@@ -317,7 +314,7 @@ notesForwardServer cache frameId mbNodeId sty presendModifyRequest env =
where where
setFrameIdCookie :: FrameId -> NodeId -> (ResponseHeaders -> ResponseHeaders) setFrameIdCookie :: FrameId -> NodeId -> (ResponseHeaders -> ResponseHeaders)
setFrameIdCookie (FrameId (T.unpack -> fid)) (UnsafeMkNodeId nid) origHeaders setFrameIdCookie (FrameId (T.unpack -> fid)) (UnsafeMkNodeId nid) origHeaders
= let sk = (hSetCookie, fromString $ fid <> "=" <> Prelude.show nid) = let sk = (hSetCookie, fromString $ fid <> "=" <> show nid)
in sk : origHeaders in sk : origHeaders
defaultForwardServerWithSettings :: ServiceType defaultForwardServerWithSettings :: ServiceType
...@@ -326,7 +323,7 @@ defaultForwardServerWithSettings :: ServiceType ...@@ -326,7 +323,7 @@ defaultForwardServerWithSettings :: ServiceType
-> WaiProxySettings -> WaiProxySettings
-> ServerT Raw m -> ServerT Raw m
defaultForwardServerWithSettings sty presendModifyRequest env proxySettings = defaultForwardServerWithSettings sty presendModifyRequest env proxySettings =
Tagged $ waiProxyToSettings forwardRequest (proxySettings) (env ^. env_manager) Tagged $ waiProxyToSettings forwardRequest proxySettings (env ^. env_manager)
where where
proxyDestination :: ProxyDestination proxyDestination :: ProxyDestination
...@@ -360,7 +357,7 @@ defaultForwardServer sty presendModifyRequest mapRespHeaders env = ...@@ -360,7 +357,7 @@ defaultForwardServer sty presendModifyRequest mapRespHeaders env =
defaultForwardServerWithSettings sty presendModifyRequest env $ defaultForwardServerWithSettings sty presendModifyRequest env $
defaultWaiProxySettings { defaultWaiProxySettings {
wpsProcessBody = \_req _res -> Just $ replaceRelativeLinks proxyDestination proxyPath wpsProcessBody = \_req _res -> Just $ replaceRelativeLinks proxyDestination proxyPath
, wpsModifyResponseHeaders = \_req _res -> (mapRespHeaders . tweakResponseHeaders) , wpsModifyResponseHeaders = \_req _res -> mapRespHeaders . tweakResponseHeaders
, wpsRedirectCounts = 5 , wpsRedirectCounts = 5
} }
where where
...@@ -382,7 +379,7 @@ noCache hdrs = (hCacheControl, fromString "no-cache") : filter ((/=) hCacheContr ...@@ -382,7 +379,7 @@ noCache hdrs = (hCacheControl, fromString "no-cache") : filter ((/=) hCacheContr
-- | Tweak the response headers so that they will have a bit more permissive -- | Tweak the response headers so that they will have a bit more permissive
-- 'Content-Security-Policy'. -- 'Content-Security-Policy'.
tweakResponseHeaders :: ResponseHeaders -> ResponseHeaders tweakResponseHeaders :: ResponseHeaders -> ResponseHeaders
tweakResponseHeaders = Prelude.map tweakHeader tweakResponseHeaders = map tweakHeader
where where
tweakHeader (k,v) tweakHeader (k,v)
| k == "Content-Security-Policy" | k == "Content-Security-Policy"
......
...@@ -13,16 +13,10 @@ import Data.Streaming.Network (bindPortTCP) ...@@ -13,16 +13,10 @@ import Data.Streaming.Network (bindPortTCP)
import Gargantext.API (makeApp) import Gargantext.API (makeApp)
import Gargantext.API.Admin.EnvTypes (Mode(Mock), Env (..)) import Gargantext.API.Admin.EnvTypes (Mode(Mock), Env (..))
import Gargantext.API.Admin.Settings import Gargantext.API.Admin.Settings
import Gargantext.API.Admin.Types
import Gargantext.API.Errors.Types import Gargantext.API.Errors.Types
import Gargantext.API.Prelude import Gargantext.API.Prelude
import Gargantext.Core.AsyncUpdates.CentralExchange qualified as CE
import Gargantext.Core.AsyncUpdates.Dispatcher qualified as D
import Gargantext.Core.AsyncUpdates.Dispatcher.Types qualified as DT
import Gargantext.Core.Config import Gargantext.Core.Config
import Gargantext.Core.Config.Mail qualified as Mail import Gargantext.Core.Config.Types (SettingsFile(..), jc_js_job_timeout, jc_js_id_timeout, fc_appPort)
import Gargantext.Core.Config.NLP qualified as NLP
import Gargantext.Core.Config.Types (SettingsFile(..), jc_js_job_timeout, jc_js_id_timeout)
import Gargantext.Core.Config.Utils (readConfig) import Gargantext.Core.Config.Utils (readConfig)
import Gargantext.Core.NLP import Gargantext.Core.NLP
import Gargantext.Core.NodeStory import Gargantext.Core.NodeStory
...@@ -61,9 +55,9 @@ newTestEnv :: TestEnv -> Logger (GargM Env BackendInternalError) -> Warp.Port -> ...@@ -61,9 +55,9 @@ newTestEnv :: TestEnv -> Logger (GargM Env BackendInternalError) -> Warp.Port ->
newTestEnv testEnv logger port = do newTestEnv testEnv logger port = do
tomlFile@(SettingsFile sf) <- fakeTomlPath tomlFile@(SettingsFile sf) <- fakeTomlPath
!manager_env <- newTlsManager !manager_env <- newTlsManager
!settings' <- devSettings devJwkFile tomlFile <&> appPort .~ port !settings' <- devSettings devJwkFile
!config_env <- readConfig tomlFile !config_env <- readConfig tomlFile <&> (gc_frontend_config . fc_appPort) .~ port
prios <- withLogger () $ \ioLogger -> Jobs.readPrios ioLogger (sf <> ".jobs") prios <- withLogger () $ \ioLogger -> Jobs.readPrios ioLogger (sf <> ".jobs")
let prios' = Jobs.applyPrios prios Jobs.defaultPrios let prios' = Jobs.applyPrios prios Jobs.defaultPrios
!self_url_env <- parseBaseUrl $ "http://0.0.0.0:" <> show port !self_url_env <- parseBaseUrl $ "http://0.0.0.0:" <> show port
......
...@@ -76,7 +76,7 @@ setup = do ...@@ -76,7 +76,7 @@ setup = do
bootstrapDB db pool gargConfig bootstrapDB db pool gargConfig
ugen <- emptyCounter ugen <- emptyCounter
test_nodeStory <- fromDBNodeStoryEnv pool test_nodeStory <- fromDBNodeStoryEnv pool
stgs <- devSettings devJwkFile =<< fakeTomlPath stgs <- devSettings devJwkFile
withLoggerHoisted Mock $ \logger -> do withLoggerHoisted Mock $ \logger -> do
pure $ TestEnv { test_db = DBHandle pool db pure $ TestEnv { test_db = DBHandle pool db
, test_config = gargConfig , test_config = gargConfig
......
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