Verified Commit 890a8076 authored by Przemyslaw Kaminski's avatar Przemyslaw Kaminski

Merge branch '304-dev-toml-config-rewrite-and-update-deps' into 238-dev-async-job-worker

parents db2b4cff 261fb04e
Pipeline #6666 failed with stages
in 29 minutes and 56 seconds
...@@ -19,6 +19,7 @@ Import a corpus binary. ...@@ -19,6 +19,7 @@ Import a corpus binary.
module CLI.Ini where module CLI.Ini where
import CLI.Types import CLI.Types
import Control.Monad.Logger (LogLevel(LevelDebug))
import Data.Text qualified as T import Data.Text qualified as T
import Database.PostgreSQL.Simple qualified as PGS import Database.PostgreSQL.Simple qualified as PGS
import Gargantext.Core.Config qualified as Config import Gargantext.Core.Config qualified as Config
...@@ -56,7 +57,8 @@ ini_p = fmap CCMD_ini $ IniArgs ...@@ -56,7 +57,8 @@ ini_p = fmap CCMD_ini $ IniArgs
convertConfigs :: Ini.GargConfig -> IniMail.MailConfig -> IniNLP.NLPConfig -> PGS.ConnectInfo -> Config.GargConfig convertConfigs :: Ini.GargConfig -> IniMail.MailConfig -> IniNLP.NLPConfig -> PGS.ConnectInfo -> Config.GargConfig
convertConfigs ini@(Ini.GargConfig { .. }) iniMail nlpConfig connInfo = convertConfigs ini@(Ini.GargConfig { .. }) iniMail nlpConfig connInfo =
Config.GargConfig { _gc_secrets = CTypes.SecretsConfig { _s_master_user = _gc_masteruser Config.GargConfig { _gc_secrets = CTypes.SecretsConfig { _s_master_user = _gc_masteruser
, _s_secret_key = _gc_secretkey } , _s_secret_key = _gc_secretkey
, _s_jwk_file = CTypes.JWKFile "dev.jwk" }
, _gc_datafilepath , _gc_datafilepath
, _gc_mail_config = iniMail , _gc_mail_config = iniMail
, _gc_nlp_config = nlpConfig , _gc_nlp_config = nlpConfig
...@@ -74,7 +76,8 @@ convertConfigs ini@(Ini.GargConfig { .. }) iniMail nlpConfig connInfo = ...@@ -74,7 +76,8 @@ convertConfigs ini@(Ini.GargConfig { .. }) iniMail nlpConfig connInfo =
, _jc_js_id_timeout = _gc_js_id_timeout } , _jc_js_id_timeout = _gc_js_id_timeout }
, _gc_apis = CTypes.APIsConfig { _ac_pubmed_api_key = _gc_pubmed_api_key , _gc_apis = CTypes.APIsConfig { _ac_pubmed_api_key = _gc_pubmed_api_key
, _ac_epo_api_url = _gc_epo_api_url } , _ac_epo_api_url = _gc_epo_api_url }
, _gc_worker = WorkerSettings { _wsDefinitions = [] } -- not supported for ini file , _gc_worker = WorkerSettings { _wsDefinitions = [] }
, _gc_log_level = LevelDebug
} }
mkFrontendConfig :: Ini.GargConfig -> CTypes.FrontendConfig mkFrontendConfig :: Ini.GargConfig -> CTypes.FrontendConfig
...@@ -82,9 +85,9 @@ mkFrontendConfig (Ini.GargConfig { .. }) = ...@@ -82,9 +85,9 @@ mkFrontendConfig (Ini.GargConfig { .. }) =
CTypes.FrontendConfig { _fc_url = _gc_url CTypes.FrontendConfig { _fc_url = _gc_url
, _fc_backend_name = _gc_backend_name , _fc_backend_name = _gc_backend_name
, _fc_url_backend_api = _gc_url_backend_api , _fc_url_backend_api = _gc_url_backend_api
, _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"
......
...@@ -47,6 +47,9 @@ master_user = "gargantua" ...@@ -47,6 +47,9 @@ master_user = "gargantua"
# frame_id seeds are computed. # frame_id seeds are computed.
secret_key = "something_speciaL" secret_key = "something_speciaL"
# JWK token
jwk_file = "dev.jwk"
[paths] [paths]
......
...@@ -669,6 +669,7 @@ executable gargantext-cli ...@@ -669,6 +669,7 @@ executable gargantext-cli
, haskell-bee , haskell-bee
, ini ^>= 0.4.1 , ini ^>= 0.4.1
, lens >= 5.2.2 && < 5.3 , lens >= 5.2.2 && < 5.3
, monad-logger ^>= 0.3.36
, optparse-applicative , optparse-applicative
, optparse-generic ^>= 1.4.7 , optparse-generic ^>= 1.4.7
, parallel ^>= 3.2.2.0 , parallel ^>= 3.2.2.0
......
...@@ -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, env_jwt_settings)
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, 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
...@@ -203,7 +204,7 @@ makeApp env = do ...@@ -203,7 +204,7 @@ makeApp env = do
-- }) -- })
where where
cfg :: Servant.Context AuthContext cfg :: Servant.Context AuthContext
cfg = env ^. settings . jwtSettings cfg = env ^. env_jwt_settings
:. env ^. settings . cookieSettings :. env ^. settings . cookieSettings
:. EmptyContext :. EmptyContext
......
...@@ -56,6 +56,7 @@ import Gargantext.API.Admin.Types ...@@ -56,6 +56,7 @@ import Gargantext.API.Admin.Types
import Gargantext.API.Auth.PolicyCheck import Gargantext.API.Auth.PolicyCheck
import Gargantext.API.Errors import Gargantext.API.Errors
import Gargantext.API.Prelude (authenticationError, HasServerError, GargServerC, _ServerError, GargM, IsGargServer) import Gargantext.API.Prelude (authenticationError, HasServerError, GargServerC, _ServerError, GargM, IsGargServer)
import Gargantext.Core.Config (HasJWTSettings(..))
import Gargantext.Core.Mail (MailModel(..), mail) import Gargantext.Core.Mail (MailModel(..), mail)
import Gargantext.Core.Mail.Types (mailSettings) import Gargantext.Core.Mail.Types (mailSettings)
import Gargantext.Core.Types.Individu (User(..), Username, GargPassword(..)) import Gargantext.Core.Types.Individu (User(..), Username, GargPassword(..))
...@@ -83,18 +84,18 @@ import qualified Gargantext.API.Routes.Named as Named ...@@ -83,18 +84,18 @@ import qualified Gargantext.API.Routes.Named as Named
-- | Main functions of authorization -- | Main functions of authorization
makeTokenForUser :: (HasSettings env, HasAuthenticationError err) makeTokenForUser :: (HasJWTSettings env, HasAuthenticationError err)
=> NodeId => NodeId
-> UserId -> UserId
-> Cmd' env err Token -> Cmd' env err Token
makeTokenForUser nodeId userId = do makeTokenForUser nodeId userId = do
jwtS <- view $ settings . jwtSettings jwtS <- view jwtSettings
e <- liftBase $ makeJWT (AuthenticatedUser nodeId userId) jwtS Nothing e <- liftBase $ makeJWT (AuthenticatedUser nodeId userId) jwtS Nothing
-- TODO-SECURITY here we can implement token expiration ^^. -- TODO-SECURITY here we can implement token expiration ^^.
either (authenticationError . LoginFailed nodeId userId) (pure . toStrict . LE.decodeUtf8) e either (authenticationError . LoginFailed nodeId userId) (pure . toStrict . LE.decodeUtf8) e
-- TODO not sure about the encoding... -- TODO not sure about the encoding...
checkAuthRequest :: ( HasSettings env, HasAuthenticationError err, DbCmd' env err m ) checkAuthRequest :: ( HasJWTSettings env, HasAuthenticationError err, DbCmd' env err m )
=> Username => Username
-> GargPassword -> GargPassword
-> m CheckAuth -> m CheckAuth
...@@ -119,7 +120,7 @@ checkAuthRequest couldBeEmail (GargPassword p) = do ...@@ -119,7 +120,7 @@ checkAuthRequest couldBeEmail (GargPassword p) = do
token <- makeTokenForUser nodeId userLight_id token <- makeTokenForUser nodeId userLight_id
pure $ Valid token nodeId userLight_id pure $ Valid token nodeId userLight_id
auth :: (HasSettings env, HasAuthenticationError err, DbCmd' env err m) auth :: (HasJWTSettings env, HasAuthenticationError err, DbCmd' env err m)
=> AuthRequest -> m AuthResponse => AuthRequest -> m AuthResponse
auth (AuthRequest u p) = do auth (AuthRequest u p) = do
checkAuthRequest' <- checkAuthRequest u p checkAuthRequest' <- checkAuthRequest u p
......
...@@ -11,12 +11,15 @@ module Gargantext.API.Admin.EnvTypes ( ...@@ -11,12 +11,15 @@ 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
, env_self_url , env_self_url
, env_central_exchange , env_central_exchange
, env_dispatcher , env_dispatcher
, env_jwt_settings
, menv_firewall , menv_firewall
, dev_env_logger , dev_env_logger
...@@ -46,18 +49,18 @@ import Gargantext.Core.AsyncUpdates.CentralExchange qualified as CE ...@@ -46,18 +49,18 @@ import Gargantext.Core.AsyncUpdates.CentralExchange qualified as CE
import Gargantext.Core.AsyncUpdates.CentralExchange.Types qualified as CET import Gargantext.Core.AsyncUpdates.CentralExchange.Types qualified as CET
import Gargantext.Core.AsyncUpdates.Dispatcher (Dispatcher) import Gargantext.Core.AsyncUpdates.Dispatcher (Dispatcher)
import Gargantext.Core.AsyncUpdates.Dispatcher.Types (HasDispatcher(..)) import Gargantext.Core.AsyncUpdates.Dispatcher.Types (HasDispatcher(..))
import Gargantext.Core.Config (GargConfig(..), gc_mail_config, gc_nlp_config, HasJWTSettings(..), HasConfig(..))
import Gargantext.Core.Mail.Types (HasMail, mailSettings) import Gargantext.Core.Mail.Types (HasMail, mailSettings)
import Gargantext.Core.NLP (NLPServerMap, HasNLPServer(..)) import Gargantext.Core.NLP (HasNLPServer(..), nlpServerMap)
import Gargantext.Core.NodeStory import Gargantext.Core.NodeStory
import Gargantext.Database.Prelude (HasConnectionPool(..), HasConfig(..)) import Gargantext.Database.Prelude (HasConnectionPool(..))
import Gargantext.Prelude import Gargantext.Prelude hiding (to)
import Gargantext.Core.Config (GargConfig(..))
import Gargantext.Core.Config.Mail (MailConfig)
import Gargantext.System.Logging import Gargantext.System.Logging
import Gargantext.Utils.Jobs.Internal (pollJob) import Gargantext.Utils.Jobs.Internal (pollJob)
import Gargantext.Utils.Jobs.Map (LoggerM, J(..), jTask, rjGetLog) import Gargantext.Utils.Jobs.Map (LoggerM, J(..), jTask, rjGetLog)
import Gargantext.Utils.Jobs.Monad qualified as Jobs import Gargantext.Utils.Jobs.Monad qualified as Jobs
import Network.HTTP.Client (Manager) import Network.HTTP.Client (Manager)
import Servant.Auth.Server (JWTSettings)
import Servant.Client (BaseUrl) import Servant.Client (BaseUrl)
import Servant.Job.Async (HasJobEnv(..), Job) import Servant.Job.Async (HasJobEnv(..), Job)
import Servant.Job.Async qualified as SJ import Servant.Job.Async qualified as SJ
...@@ -169,19 +172,18 @@ instance ToJSON GargJob where ...@@ -169,19 +172,18 @@ instance ToJSON GargJob where
-- having to specify /everything/. This means that when we /construct/ an 'Env', -- having to specify /everything/. This means that when we /construct/ an 'Env',
-- we need to remember to force the fields to WHNF at that point. -- we need to remember to force the fields to WHNF at that point.
data Env = Env data Env = Env
{ _env_settings :: ~Settings { _env_settings :: ~Settings
, _env_logger :: ~(Logger (GargM Env BackendInternalError)) , _env_logger :: ~(Logger (GargM Env BackendInternalError))
, _env_pool :: ~(Pool Connection) , _env_pool :: ~(Pool Connection)
, _env_nodeStory :: ~NodeStoryEnv , _env_nodeStory :: ~NodeStoryEnv
, _env_manager :: ~Manager , _env_manager :: ~Manager
, _env_self_url :: ~BaseUrl , _env_self_url :: ~BaseUrl
, _env_scrapers :: ~ScrapersEnv , _env_scrapers :: ~ScrapersEnv
, _env_jobs :: ~(Jobs.JobEnv GargJob (Seq JobLog) JobLog) , _env_jobs :: ~(Jobs.JobEnv GargJob (Seq JobLog) JobLog)
, _env_config :: ~GargConfig , _env_config :: ~GargConfig
, _env_mail :: ~MailConfig
, _env_nlp :: ~NLPServerMap
, _env_central_exchange :: ~ThreadId , _env_central_exchange :: ~ThreadId
, _env_dispatcher :: ~Dispatcher , _env_dispatcher :: ~Dispatcher
, _env_jwt_settings :: ~JWTSettings
} }
deriving (Generic) deriving (Generic)
...@@ -205,11 +207,14 @@ instance HasNodeArchiveStoryImmediateSaver Env where ...@@ -205,11 +207,14 @@ instance HasNodeArchiveStoryImmediateSaver Env where
instance HasSettings Env where instance HasSettings Env where
settings = env_settings settings = env_settings
instance HasJWTSettings Env where
jwtSettings = env_jwt_settings
instance HasMail Env where instance HasMail Env where
mailSettings = env_mail mailSettings = env_config . gc_mail_config
instance HasNLPServer Env where instance HasNLPServer Env where
nlpServer = env_nlp nlpServer = env_config . gc_nlp_config . (to nlpServerMap)
instance HasDispatcher Env Dispatcher where instance HasDispatcher Env Dispatcher where
hasDispatcher = env_dispatcher hasDispatcher = env_dispatcher
...@@ -342,8 +347,6 @@ data DevEnv = DevEnv ...@@ -342,8 +347,6 @@ data DevEnv = DevEnv
, _dev_env_logger :: !(Logger (GargM DevEnv BackendInternalError)) , _dev_env_logger :: !(Logger (GargM DevEnv BackendInternalError))
, _dev_env_pool :: !(Pool Connection) , _dev_env_pool :: !(Pool Connection)
, _dev_env_nodeStory :: !NodeStoryEnv , _dev_env_nodeStory :: !NodeStoryEnv
, _dev_env_mail :: !MailConfig
, _dev_env_nlp :: !NLPServerMap
} }
makeLenses ''DevEnv makeLenses ''DevEnv
...@@ -402,10 +405,10 @@ instance HasNodeArchiveStoryImmediateSaver DevEnv where ...@@ -402,10 +405,10 @@ instance HasNodeArchiveStoryImmediateSaver DevEnv where
hasNodeArchiveStoryImmediateSaver = hasNodeStory . nse_archive_saver_immediate hasNodeArchiveStoryImmediateSaver = hasNodeStory . nse_archive_saver_immediate
instance HasMail DevEnv where instance HasMail DevEnv where
mailSettings = dev_env_mail mailSettings = dev_env_config . gc_mail_config
instance HasNLPServer DevEnv where instance HasNLPServer DevEnv where
nlpServer = dev_env_nlp nlpServer = dev_env_config . gc_nlp_config . (to nlpServerMap)
instance IsGargServer Env BackendInternalError (GargM Env BackendInternalError) instance IsGargServer Env BackendInternalError (GargM Env BackendInternalError)
...@@ -20,7 +20,6 @@ module Gargantext.API.Admin.Settings ...@@ -20,7 +20,6 @@ module Gargantext.API.Admin.Settings
import Codec.Serialise (Serialise(), serialise) import Codec.Serialise (Serialise(), serialise)
import Control.Lens import Control.Lens
import Control.Monad.Logger (LogLevel(..))
import Control.Monad.Reader import Control.Monad.Reader
import Data.ByteString.Lazy qualified as L import Data.ByteString.Lazy qualified as L
import Data.Pool (Pool) import Data.Pool (Pool)
...@@ -32,12 +31,10 @@ import Gargantext.API.Errors.Types ...@@ -32,12 +31,10 @@ 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, hasConfig)
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, jwtSettings)
import Gargantext.Core.Config.Utils (readConfig) import Gargantext.Core.Config.Utils (readConfig)
import Gargantext.Core.NLP (nlpServerMap)
import Gargantext.Core.NodeStory import Gargantext.Core.NodeStory
import Gargantext.Database.Prelude (hasConfig)
import Gargantext.Prelude import Gargantext.Prelude
import Gargantext.System.Logging import Gargantext.System.Logging
import Gargantext.Utils.Jobs qualified as Jobs import Gargantext.Utils.Jobs qualified as Jobs
...@@ -45,40 +42,27 @@ import Gargantext.Utils.Jobs.Monad qualified as Jobs ...@@ -45,40 +42,27 @@ import Gargantext.Utils.Jobs.Monad qualified as Jobs
import Gargantext.Utils.Jobs.Queue qualified as Jobs import Gargantext.Utils.Jobs.Queue qualified as Jobs
import Gargantext.Utils.Jobs.Settings qualified as Jobs import Gargantext.Utils.Jobs.Settings qualified as Jobs
import Network.HTTP.Client.TLS (newTlsManager) import Network.HTTP.Client.TLS (newTlsManager)
import Servant.Auth.Server (defaultJWTSettings, CookieSettings(..), XsrfCookieSettings(..), defaultCookieSettings, defaultXsrfCookieSettings, readKey, writeKey) import Servant.Auth.Server (CookieSettings(..), XsrfCookieSettings(..), defaultCookieSettings, defaultXsrfCookieSettings)
import Servant.Client (parseBaseUrl) import Servant.Client (parseBaseUrl)
import Servant.Job.Async (newJobEnv, defaultSettings) import Servant.Job.Async (newJobEnv, defaultSettings)
import System.Directory import System.Directory (renameFile)
import System.IO (hClose) import System.IO (hClose)
import System.IO.Temp (withTempFile) import System.IO.Temp (withTempFile)
newtype JwkFile = JwkFile { _JwkFile :: FilePath }
deriving (Show, Eq, IsString)
newtype IniFile = IniFile { _IniFile :: FilePath } newtype IniFile = IniFile { _IniFile :: FilePath }
deriving (Show, Eq, IsString) deriving (Show, Eq, IsString)
devSettings :: JwkFile -> SettingsFile -> IO Settings devSettings :: Settings
devSettings (JwkFile jwkFile) settingsFile = do devSettings =
jwkExists <- doesFileExist jwkFile
when (not jwkExists) $ writeKey jwkFile
jwk <- readKey jwkFile
-- GargTomlSettings{..} <- loadGargTomlSettings settingsFile -- GargTomlSettings{..} <- loadGargTomlSettings settingsFile
gc@(GargConfig {}) <- readConfig settingsFile 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
, _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"
, _cookieSettings = defaultCookieSettings { cookieXsrfSetting = Just xsrfCookieSetting } -- TODO-SECURITY tune , _cookieSettings = defaultCookieSettings { cookieXsrfSetting = Just xsrfCookieSetting } -- TODO-SECURITY tune
, _jwtSettings = defaultJWTSettings jwk -- TODO-SECURITY tune
, _workerSettings = _gc_worker gc
} }
where where
xsrfCookieSetting = defaultXsrfCookieSettings { xsrfExcludeGet = True } xsrfCookieSetting = defaultXsrfCookieSettings { xsrfExcludeGet = True }
...@@ -182,17 +166,14 @@ readRepoEnv repoDir = do ...@@ -182,17 +166,14 @@ readRepoEnv repoDir = do
pure $ RepoEnv { _renv_var = mvar, _renv_saver = saver, _renv_lock = lock } pure $ RepoEnv { _renv_var = mvar, _renv_saver = saver, _renv_lock = lock }
--} --}
devJwkFile :: JwkFile
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' let !settings' = devSettings
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)
...@@ -211,6 +192,8 @@ newEnv logger port settingsFile@(SettingsFile sf) = do ...@@ -211,6 +192,8 @@ newEnv logger port settingsFile@(SettingsFile sf) = do
!central_exchange <- forkIO $ CE.gServer (_gc_notifications_config config_env) !central_exchange <- forkIO $ CE.gServer (_gc_notifications_config config_env)
!dispatcher <- D.newDispatcher (_gc_notifications_config config_env) !dispatcher <- D.newDispatcher (_gc_notifications_config config_env)
!_env_jwt_settings <- jwtSettings (_gc_secrets config_env)
{- An 'Env' by default doesn't have strict fields, but when constructing one in production {- An 'Env' by default doesn't have strict fields, but when constructing one in production
we want to force them to WHNF to avoid accumulating unnecessary thunks. we want to force them to WHNF to avoid accumulating unnecessary thunks.
-} -}
...@@ -224,10 +207,9 @@ newEnv logger port settingsFile@(SettingsFile sf) = do ...@@ -224,10 +207,9 @@ newEnv logger port settingsFile@(SettingsFile sf) = do
, _env_jobs = jobs_env , _env_jobs = jobs_env
, _env_self_url = self_url_env , _env_self_url = self_url_env
, _env_config = config_env , _env_config = config_env
, _env_mail = _gc_mail_config config_env
, _env_nlp = nlpServerMap $ _gc_nlp_config config_env
, _env_central_exchange = central_exchange , _env_central_exchange = central_exchange
, _env_dispatcher = dispatcher , _env_dispatcher = dispatcher
, _env_jwt_settings
} }
newPool :: ConnectInfo -> IO (Pool Connection) newPool :: ConnectInfo -> IO (Pool Connection)
......
...@@ -3,16 +3,12 @@ ...@@ -3,16 +3,12 @@
module Gargantext.API.Admin.Types where module Gargantext.API.Admin.Types where
import Control.Lens import Control.Lens
import Control.Monad.Logger (LogLevel)
import GHC.Enum import GHC.Enum
import Gargantext.Core.Config.Worker (WorkerSettings)
import Gargantext.Core.Config.Types
import Gargantext.Prelude import Gargantext.Prelude
import Servant.Auth.Server (JWTSettings, CookieSettings(..)) import Servant.Auth.Server (CookieSettings(..))
import Servant.Client (BaseUrl) import Servant.Client (BaseUrl)
type PortNumber = Int
data SendEmailType = SendEmailViaAws data SendEmailType = SendEmailViaAws
| LogEmailToConsole | LogEmailToConsole
...@@ -20,32 +16,16 @@ data SendEmailType = SendEmailViaAws ...@@ -20,32 +16,16 @@ 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 {
, _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 _cookieSettings :: !CookieSettings
, _cookieSettings :: !CookieSettings
, _sendLoginEmails :: !SendEmailType , _sendLoginEmails :: !SendEmailType
, _scrapydUrl :: !BaseUrl , _scrapydUrl :: !BaseUrl
, _workerSettings :: !WorkerSettings
} }
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
......
...@@ -21,27 +21,26 @@ module Gargantext.API.Auth.PolicyCheck ( ...@@ -21,27 +21,26 @@ module Gargantext.API.Auth.PolicyCheck (
, alwaysDeny , alwaysDeny
) where ) where
import Control.Lens import Control.Lens (view)
import Control.Monad import Data.BoolExpr (BoolExpr(..), Signed(..))
import Data.BoolExpr import Gargantext.API.Admin.Auth.Types (AuthenticatedUser(..))
import Gargantext.API.Admin.Auth.Types import Gargantext.API.Errors.Types (BackendInternalError)
import Gargantext.API.Errors.Types import Gargantext.Core.Config (GargConfig(..), HasConfig(hasConfig))
import Gargantext.Core.Types
import Gargantext.Core.Types.Individu
import Gargantext.Database.Prelude (DBCmd, HasConfig (..))
import Gargantext.Database.Query.Table.Node.Error
import Gargantext.Database.Query.Tree
import Gargantext.Database.Query.Tree.Root
import Gargantext.Core.Config (GargConfig(..))
import Gargantext.Core.Config.Types (SecretsConfig(..)) import Gargantext.Core.Config.Types (SecretsConfig(..))
import Prelude import Gargantext.Core.Types (NodeId, UserId)
import Servant import Gargantext.Core.Types.Individu (User(UserName))
import Servant.API.Routes import Gargantext.Database.Prelude (DBCmd)
import Servant.Auth.Server.Internal.AddSetCookie import Gargantext.Database.Query.Table.Node.Error (HasNodeError)
import Servant.Client.Core import Gargantext.Database.Query.Tree (isDescendantOf, isOwnedBy, isSharedWith)
import Servant.Ekg import Gargantext.Database.Query.Tree.Root (getRootId)
import Servant.Server.Internal.Delayed import Gargantext.Prelude
import Servant.Server.Internal.DelayedIO import Servant (HasServer(..), ServerError, ServerT, err403, err500)
import Servant.API.Routes (HasRoutes(getRoutes))
import Servant.Auth.Server.Internal.AddSetCookie (AddSetCookieApi, AddSetCookies(..), Nat(S))
import Servant.Client.Core (HasClient(..), Client)
import Servant.Ekg (HasEndpoint(..))
import Servant.Server.Internal.Delayed (addParameterCheck)
import Servant.Server.Internal.DelayedIO (DelayedIO(..))
import Servant.Swagger qualified as Swagger import Servant.Swagger qualified as Swagger
------------------------------------------------------------------------------- -------------------------------------------------------------------------------
...@@ -122,13 +121,13 @@ accessPolicyManager = AccessPolicyManager (\ur ac -> interpretPolicy ur ac) ...@@ -122,13 +121,13 @@ accessPolicyManager = AccessPolicyManager (\ur ac -> interpretPolicy ur ac)
BFalse BFalse
-> pure $ Deny err403 -> pure $ Deny err403
BConst (Positive b) BConst (Positive b)
-> check ur b -> check' ur b
BConst (Negative b) BConst (Negative b)
-> check ur b -> check' ur b
check :: HasNodeError err => AuthenticatedUser -> AccessCheck -> DBCmd err AccessResult check' :: HasNodeError err => AuthenticatedUser -> AccessCheck -> DBCmd err AccessResult
check (AuthenticatedUser loggedUserNodeId loggedUserUserId) = \case check' (AuthenticatedUser loggedUserNodeId loggedUserUserId) = \case
AC_always_deny AC_always_deny
-> pure $ Deny err500 -> pure $ Deny err500
AC_always_allow AC_always_allow
......
...@@ -17,12 +17,11 @@ import Control.Monad (fail) ...@@ -17,12 +17,11 @@ import Control.Monad (fail)
import Data.Pool (withResource) import Data.Pool (withResource)
import Database.PostgreSQL.Simple qualified as PGS import Database.PostgreSQL.Simple qualified as PGS
import Gargantext.API.Admin.EnvTypes ( DevEnv(..), Mode(Dev) ) import Gargantext.API.Admin.EnvTypes ( DevEnv(..), Mode(Dev) )
import Gargantext.API.Admin.Settings ( devJwkFile, devSettings, newPool ) import Gargantext.API.Admin.Settings ( devSettings, newPool )
import Gargantext.API.Errors.Types ( BackendInternalError ) import Gargantext.API.Errors.Types ( BackendInternalError )
import Gargantext.API.Prelude ( GargM ) import Gargantext.API.Prelude ( GargM )
import Gargantext.Core.Config (_gc_database_config, _gc_mail_config, _gc_nlp_config) import Gargantext.Core.Config (_gc_database_config)
import Gargantext.Core.Config.Types (SettingsFile(..)) import Gargantext.Core.Config.Types (SettingsFile(..))
import Gargantext.Core.NLP (nlpServerMap)
import Gargantext.Core.NodeStory (fromDBNodeStoryEnv) import Gargantext.Core.NodeStory (fromDBNodeStoryEnv)
import Gargantext.Database.Prelude (Cmd', Cmd'', connPool, runCmd) import Gargantext.Database.Prelude (Cmd', Cmd'', connPool, runCmd)
import Gargantext.Prelude import Gargantext.Prelude
...@@ -42,15 +41,13 @@ withDevEnv settingsFile k = withLoggerHoisted Dev $ \logger -> do ...@@ -42,15 +41,13 @@ 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 let setts = devSettings
pure $ DevEnv pure $ DevEnv
{ _dev_env_pool = pool { _dev_env_pool = pool
, _dev_env_logger = logger , _dev_env_logger = logger
, _dev_env_nodeStory = nodeStory_env , _dev_env_nodeStory = nodeStory_env
, _dev_env_settings = setts , _dev_env_settings = setts
, _dev_env_config = cfg , _dev_env_config = cfg
, _dev_env_mail = _gc_mail_config cfg
, _dev_env_nlp = nlpServerMap (_gc_nlp_config cfg)
} }
defaultSettingsFile :: SettingsFile defaultSettingsFile :: SettingsFile
......
...@@ -28,7 +28,6 @@ import Data.Morpheus.Types ( GQLRequest, GQLResponse, GQLType, RootResolver(..), ...@@ -28,7 +28,6 @@ import Data.Morpheus.Types ( GQLRequest, GQLResponse, GQLType, RootResolver(..),
-- import Data.Proxy -- import Data.Proxy
import Gargantext.API.Admin.Auth.Types (AuthenticatedUser) import Gargantext.API.Admin.Auth.Types (AuthenticatedUser)
import Gargantext.API.Admin.Orchestrator.Types (JobLog) import Gargantext.API.Admin.Orchestrator.Types (JobLog)
import Gargantext.API.Admin.Types (HasSettings)
import Gargantext.API.Auth.PolicyCheck import Gargantext.API.Auth.PolicyCheck
import Gargantext.API.Errors.Types import Gargantext.API.Errors.Types
import Gargantext.API.GraphQL.Annuaire qualified as GQLA import Gargantext.API.GraphQL.Annuaire qualified as GQLA
...@@ -44,6 +43,7 @@ import Gargantext.API.GraphQL.UserInfo qualified as GQLUserInfo ...@@ -44,6 +43,7 @@ import Gargantext.API.GraphQL.UserInfo qualified as GQLUserInfo
import Gargantext.API.Prelude (GargM) import Gargantext.API.Prelude (GargM)
import Gargantext.API.Prelude (HasJobEnv') import Gargantext.API.Prelude (HasJobEnv')
import Gargantext.API.Types import Gargantext.API.Types
import Gargantext.Core.Config (HasJWTSettings)
import Gargantext.Core.NLP (HasNLPServer) import Gargantext.Core.NLP (HasNLPServer)
import Gargantext.Database.Prelude (CmdCommon) import Gargantext.Database.Prelude (CmdCommon)
import Gargantext.Prelude hiding (ByteString) import Gargantext.Prelude hiding (ByteString)
...@@ -102,7 +102,7 @@ data Contet m ...@@ -102,7 +102,7 @@ data Contet m
-- | The main GraphQL resolver: how queries, mutations and -- | The main GraphQL resolver: how queries, mutations and
-- subscriptions are handled. -- subscriptions are handled.
rootResolver rootResolver
:: (CmdCommon env, HasNLPServer env, HasJobEnv' env, HasSettings env) :: (CmdCommon env, HasNLPServer env, HasJobEnv' env, HasJWTSettings env)
=> AuthenticatedUser => AuthenticatedUser
-> AccessPolicyManager -> AccessPolicyManager
-> RootResolver (GargM env BackendInternalError) e Query Mutation Undefined -> RootResolver (GargM env BackendInternalError) e Query Mutation Undefined
...@@ -134,7 +134,7 @@ rootResolver authenticatedUser policyManager = ...@@ -134,7 +134,7 @@ rootResolver authenticatedUser policyManager =
-- | Main GraphQL "app". -- | Main GraphQL "app".
app app
:: (Typeable env, CmdCommon env, HasJobEnv' env, HasNLPServer env, HasSettings env) :: (Typeable env, CmdCommon env, HasJobEnv' env, HasNLPServer env, HasJWTSettings env)
=> AuthenticatedUser => AuthenticatedUser
-> AccessPolicyManager -> AccessPolicyManager
-> App (EVENT (GargM env BackendInternalError)) (GargM env BackendInternalError) -> App (EVENT (GargM env BackendInternalError)) (GargM env BackendInternalError)
...@@ -172,7 +172,7 @@ data GraphQLAPIEndpoints mode = GraphQLAPIEndpoints ...@@ -172,7 +172,7 @@ data GraphQLAPIEndpoints mode = GraphQLAPIEndpoints
-- | Implementation of our API. -- | Implementation of our API.
api api
:: (Typeable env, CmdCommon env, HasJobEnv' env, HasSettings env) :: (Typeable env, CmdCommon env, HasJobEnv' env, HasJWTSettings env)
=> GraphQLAPI (AsServerT (GargM env BackendInternalError)) => GraphQLAPI (AsServerT (GargM env BackendInternalError))
api = GraphQLAPI $ \case api = GraphQLAPI $ \case
(SAS.Authenticated auser) (SAS.Authenticated auser)
......
...@@ -20,7 +20,8 @@ import Data.Morpheus.Types ( GQLType, Resolver, QUERY ) ...@@ -20,7 +20,8 @@ import Data.Morpheus.Types ( GQLType, Resolver, QUERY )
import Gargantext.API.Admin.Orchestrator.Types (JobLog(..)) import Gargantext.API.Admin.Orchestrator.Types (JobLog(..))
import Gargantext.API.Errors.Types import Gargantext.API.Errors.Types
import Gargantext.API.Prelude (GargM, HasJobEnv') import Gargantext.API.Prelude (GargM, HasJobEnv')
import Gargantext.Database.Prelude (HasConnectionPool, HasConfig) import Gargantext.Core.Config (HasConfig)
import Gargantext.Database.Prelude (HasConnectionPool)
import Gargantext.Prelude import Gargantext.Prelude
import Servant.Job.Async (HasJobEnv(job_env), jenv_jobs, job_async) import Servant.Job.Async (HasJobEnv(job_env), jenv_jobs, job_async)
import Servant.Job.Core (env_item, env_map, env_state_mvar) import Servant.Job.Core (env_item, env_map, env_state_mvar)
......
...@@ -25,7 +25,6 @@ import Data.Morpheus.Types ...@@ -25,7 +25,6 @@ import Data.Morpheus.Types
import Data.Text (pack, unpack) import Data.Text (pack, unpack)
import qualified Data.Text as Text import qualified Data.Text as Text
import Data.Time.Format.ISO8601 (iso8601Show) import Data.Time.Format.ISO8601 (iso8601Show)
import Gargantext.API.Admin.Types (HasSettings)
import Gargantext.API.Errors.Types ( BackendInternalError ) import Gargantext.API.Errors.Types ( BackendInternalError )
import Gargantext.API.Prelude (GargM) import Gargantext.API.Prelude (GargM)
import Gargantext.Core.Types.Search (HyperdataRow(..), toHyperdataRow) import Gargantext.Core.Types.Search (HyperdataRow(..), toHyperdataRow)
...@@ -219,7 +218,7 @@ toHyperdataRowDocumentGQL hyperdata = ...@@ -219,7 +218,7 @@ toHyperdataRowDocumentGQL hyperdata =
} }
HyperdataRowContact { } -> Nothing HyperdataRowContact { } -> Nothing
updateNodeContextCategory :: (CmdCommon env, HasSettings env) updateNodeContextCategory :: (CmdCommon env)
=> NodeContextCategoryMArgs -> GqlM' e env [Int] => NodeContextCategoryMArgs -> GqlM' e env [Int]
updateNodeContextCategory NodeContextCategoryMArgs { context_id, node_id, category } = do updateNodeContextCategory NodeContextCategoryMArgs { context_id, node_id, category } = do
_ <- lift $ DNC.updateNodeContextCategory (UnsafeMkContextId context_id) (UnsafeMkNodeId node_id) category _ <- lift $ DNC.updateNodeContextCategory (UnsafeMkContextId context_id) (UnsafeMkNodeId node_id) category
......
...@@ -8,7 +8,8 @@ import Gargantext.API.Admin.Auth.Types ( AuthenticatedUser ) ...@@ -8,7 +8,8 @@ import Gargantext.API.Admin.Auth.Types ( AuthenticatedUser )
import Gargantext.API.Auth.PolicyCheck ( BoolExpr, AccessCheck, AccessPolicyManager(..), AccessResult(..)) import Gargantext.API.Auth.PolicyCheck ( BoolExpr, AccessCheck, AccessPolicyManager(..), AccessResult(..))
import Gargantext.API.Errors.Types ( BackendInternalError(..) ) import Gargantext.API.Errors.Types ( BackendInternalError(..) )
import Gargantext.API.GraphQL.Types (GqlM) import Gargantext.API.GraphQL.Types (GqlM)
import Gargantext.Database.Prelude (HasConnectionPool, HasConfig) import Gargantext.Core.Config (HasConfig)
import Gargantext.Database.Prelude (HasConnectionPool)
withPolicy :: (HasConnectionPool env, HasConfig env) withPolicy :: (HasConnectionPool env, HasConfig env)
=> AuthenticatedUser => AuthenticatedUser
......
...@@ -17,11 +17,11 @@ module Gargantext.API.GraphQL.Team where ...@@ -17,11 +17,11 @@ module Gargantext.API.GraphQL.Team where
import Data.Morpheus.Types (GQLType, ResolverM) import Data.Morpheus.Types (GQLType, ResolverM)
import Data.Text qualified as T import Data.Text qualified as T
import Gargantext.API.Admin.Auth.Types (AuthenticationError(..)) import Gargantext.API.Admin.Auth.Types (AuthenticationError(..))
import Gargantext.API.Admin.Types (HasSettings)
import Gargantext.API.Errors.Types import Gargantext.API.Errors.Types
import Gargantext.API.GraphQL.Types (GqlM) import Gargantext.API.GraphQL.Types (GqlM)
import Gargantext.API.GraphQL.Utils (authUser, AuthStatus (Invalid, Valid)) import Gargantext.API.GraphQL.Utils (authUser, AuthStatus (Invalid, Valid))
import Gargantext.API.Prelude (GargM) import Gargantext.API.Prelude (GargM)
import Gargantext.Core.Config (HasJWTSettings)
import Gargantext.Core.Types (NodeId(..), unNodeId) import Gargantext.Core.Types (NodeId(..), unNodeId)
import Gargantext.Core.Types.Individu qualified as Individu import Gargantext.Core.Types.Individu qualified as Individu
import Gargantext.Database.Action.Share (membersOf, deleteMemberShip) import Gargantext.Database.Action.Share (membersOf, deleteMemberShip)
...@@ -78,7 +78,7 @@ dbTeam nodeId = do ...@@ -78,7 +78,7 @@ dbTeam nodeId = do
getUsername ((UserLight {userLight_username}, _):_) = userLight_username getUsername ((UserLight {userLight_username}, _):_) = userLight_username
-- TODO: list as argument -- TODO: list as argument
deleteTeamMembership :: (CmdCommon env, HasSettings env) => deleteTeamMembership :: (CmdCommon env, HasJWTSettings env) =>
TeamDeleteMArgs -> GqlM' e env [Int] TeamDeleteMArgs -> GqlM' e env [Int]
deleteTeamMembership TeamDeleteMArgs { token, shared_folder_id, team_node_id } = do deleteTeamMembership TeamDeleteMArgs { token, shared_folder_id, team_node_id } = do
teamNode <- lift $ getNode $ UnsafeMkNodeId team_node_id teamNode <- lift $ getNode $ UnsafeMkNodeId team_node_id
......
...@@ -16,7 +16,6 @@ module Gargantext.API.GraphQL.User where ...@@ -16,7 +16,6 @@ module Gargantext.API.GraphQL.User where
import Data.Morpheus.Types ( GQLType ) import Data.Morpheus.Types ( GQLType )
import Gargantext.API.Admin.Auth.Types import Gargantext.API.Admin.Auth.Types
import Gargantext.API.Admin.Types (HasSettings)
import Gargantext.API.Auth.PolicyCheck import Gargantext.API.Auth.PolicyCheck
import Gargantext.API.GraphQL.PolicyCheck import Gargantext.API.GraphQL.PolicyCheck
import Gargantext.API.GraphQL.Types import Gargantext.API.GraphQL.Types
...@@ -88,21 +87,21 @@ resolveHyperdata ...@@ -88,21 +87,21 @@ resolveHyperdata
=> UserId -> GqlM e env (Maybe HyperdataUser) => UserId -> GqlM e env (Maybe HyperdataUser)
resolveHyperdata userid = lift (listToMaybe <$> DBUser.getUserHyperdata (Individu.UserDBId userid)) resolveHyperdata userid = lift (listToMaybe <$> DBUser.getUserHyperdata (Individu.UserDBId userid))
updateUserPubmedAPIKey :: ( CmdCommon env, HasSettings env) => updateUserPubmedAPIKey :: ( CmdCommon env ) =>
UserPubmedAPIKeyMArgs -> GqlM' e env Int UserPubmedAPIKeyMArgs -> GqlM' e env Int
updateUserPubmedAPIKey UserPubmedAPIKeyMArgs { user_id, api_key } = do updateUserPubmedAPIKey UserPubmedAPIKeyMArgs { user_id, api_key } = do
_ <- lift $ DBUser.updateUserPubmedAPIKey (Individu.RootId $ UnsafeMkNodeId user_id) api_key _ <- lift $ DBUser.updateUserPubmedAPIKey (Individu.RootId $ UnsafeMkNodeId user_id) api_key
pure 1 pure 1
updateUserEPOAPIUser :: ( CmdCommon env, HasSettings env) => updateUserEPOAPIUser :: ( CmdCommon env ) =>
UserEPOAPIUserMArgs -> GqlM' e env Int UserEPOAPIUserMArgs -> GqlM' e env Int
updateUserEPOAPIUser UserEPOAPIUserMArgs { user_id, api_user } = do updateUserEPOAPIUser UserEPOAPIUserMArgs { user_id, api_user } = do
_ <- lift $ DBUser.updateUserEPOAPIUser (Individu.RootId $ UnsafeMkNodeId user_id) api_user _ <- lift $ DBUser.updateUserEPOAPIUser (Individu.RootId $ UnsafeMkNodeId user_id) api_user
pure 1 pure 1
updateUserEPOAPIToken :: ( CmdCommon env, HasSettings env) => updateUserEPOAPIToken :: ( CmdCommon env ) =>
UserEPOAPITokenMArgs -> GqlM' e env Int UserEPOAPITokenMArgs -> GqlM' e env Int
updateUserEPOAPIToken UserEPOAPITokenMArgs { user_id, api_token } = do updateUserEPOAPIToken UserEPOAPITokenMArgs { user_id, api_token } = do
_ <- lift $ DBUser.updateUserEPOAPIToken (Individu.RootId $ UnsafeMkNodeId user_id) api_token _ <- lift $ DBUser.updateUserEPOAPIToken (Individu.RootId $ UnsafeMkNodeId user_id) api_token
......
...@@ -41,11 +41,11 @@ import Gargantext.Database.Admin.Types.Hyperdata.Contact ...@@ -41,11 +41,11 @@ import Gargantext.Database.Admin.Types.Hyperdata.Contact
, hc_who , hc_who
, hc_where) , hc_where)
import Gargantext.API.Admin.Auth.Types hiding (Valid) import Gargantext.API.Admin.Auth.Types hiding (Valid)
import Gargantext.API.Admin.Types (HasSettings)
import Gargantext.API.Auth.PolicyCheck import Gargantext.API.Auth.PolicyCheck
import Gargantext.API.GraphQL.PolicyCheck import Gargantext.API.GraphQL.PolicyCheck
import Gargantext.API.GraphQL.Types import Gargantext.API.GraphQL.Types
import Gargantext.API.GraphQL.Utils (AuthStatus(Invalid, Valid), authUser) import Gargantext.API.GraphQL.Utils (AuthStatus(Invalid, Valid), authUser)
import Gargantext.Core.Config (HasJWTSettings)
import Gargantext.Core.Types.Individu qualified as Individu import Gargantext.Core.Types.Individu qualified as Individu
import Gargantext.Database.Prelude (CmdCommon) import Gargantext.Database.Prelude (CmdCommon)
import Gargantext.Database.Query.Table.Node.UpdateOpaleye (updateHyperdata) import Gargantext.Database.Query.Table.Node.UpdateOpaleye (updateHyperdata)
...@@ -117,7 +117,7 @@ resolveUserInfos autUser mgr UserInfoArgs { user_id } = ...@@ -117,7 +117,7 @@ resolveUserInfos autUser mgr UserInfoArgs { user_id } =
-- | Mutation for user info -- | Mutation for user info
updateUserInfo updateUserInfo
:: (CmdCommon env, HasSettings env) :: (CmdCommon env, HasJWTSettings env)
-- => UserInfoMArgs -> ResolverM e (GargM env err) Int -- => UserInfoMArgs -> ResolverM e (GargM env err) Int
=> UserInfoMArgs -> GqlM' e env Int => UserInfoMArgs -> GqlM' e env Int
updateUserInfo (UserInfoMArgs { ui_id, .. }) = do updateUserInfo (UserInfoMArgs { ui_id, .. }) = do
......
...@@ -14,7 +14,7 @@ module Gargantext.API.GraphQL.Utils where ...@@ -14,7 +14,7 @@ module Gargantext.API.GraphQL.Utils where
import Control.Lens (view) import Control.Lens (view)
import Gargantext.API.Admin.Auth.Types (AuthenticatedUser (..), auth_node_id) import Gargantext.API.Admin.Auth.Types (AuthenticatedUser (..), auth_node_id)
import Gargantext.API.Admin.Types (jwtSettings, HasSettings (settings)) import Gargantext.Core.Config (HasJWTSettings(..))
import Gargantext.Database.Admin.Types.Node (NodeId) import Gargantext.Database.Admin.Types.Node (NodeId)
import Gargantext.Database.Prelude (Cmd') import Gargantext.Database.Prelude (Cmd')
import Gargantext.Prelude import Gargantext.Prelude
...@@ -22,10 +22,10 @@ import Servant.Auth.Server (verifyJWT, JWTSettings) ...@@ -22,10 +22,10 @@ import Servant.Auth.Server (verifyJWT, JWTSettings)
data AuthStatus = Valid | Invalid data AuthStatus = Valid | Invalid
authUser :: (HasSettings env) => NodeId -> Text -> Cmd' env err AuthStatus authUser :: (HasJWTSettings env) => NodeId -> Text -> Cmd' env err AuthStatus
authUser ui_id token = do authUser ui_id token = do
let token' = encodeUtf8 token let token' = encodeUtf8 token
jwtS <- view $ settings . jwtSettings jwtS <- view jwtSettings
u <- liftBase $ getUserFromToken jwtS token' u <- liftBase $ getUserFromToken jwtS token'
case u of case u of
Nothing -> pure Invalid Nothing -> pure Invalid
......
...@@ -38,13 +38,14 @@ import Data.TreeDiff ...@@ -38,13 +38,14 @@ import Data.TreeDiff
import Data.Validity ( Validity(..) ) import Data.Validity ( Validity(..) )
import Database.PostgreSQL.Simple.FromField (FromField, fromField, fromJSONField) import Database.PostgreSQL.Simple.FromField (FromField, fromField, fromJSONField)
import Database.PostgreSQL.Simple.ToField (ToField, toJSONField, toField) import Database.PostgreSQL.Simple.ToField (ToField, toJSONField, toField)
import Gargantext.Core.Config (HasConfig)
import Gargantext.Core.Text (size) import Gargantext.Core.Text (size)
import Gargantext.Core.Text.Ngrams qualified as Ngrams import Gargantext.Core.Text.Ngrams qualified as Ngrams
import Gargantext.Core.Types (ListType(..), ListId, NodeId, TODO) import Gargantext.Core.Types (ListType(..), ListId, NodeId, TODO)
import Gargantext.Core.Types.Query (Limit, Offset, MaxSize, MinSize) import Gargantext.Core.Types.Query (Limit, Offset, MaxSize, MinSize)
import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixUntagged, unPrefixSwagger, wellNamedSchema) import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixUntagged, unPrefixSwagger, wellNamedSchema)
import Gargantext.Database.Admin.Types.Node (ContextId) import Gargantext.Database.Admin.Types.Node (ContextId)
import Gargantext.Database.Prelude (fromField', HasConnectionPool, HasConfig, CmdM') import Gargantext.Database.Prelude (fromField', HasConnectionPool, CmdM')
import Gargantext.Prelude hiding (IsString, hash, from, replace, to) import Gargantext.Prelude hiding (IsString, hash, from, replace, to)
import Gargantext.Prelude.Crypto.Hash (IsHashable(..)) import Gargantext.Prelude.Crypto.Hash (IsHashable(..))
import Gargantext.Utils.Servant (TSV, ZIP) import Gargantext.Utils.Servant (TSV, ZIP)
......
...@@ -37,7 +37,7 @@ import Gargantext.API.Node.Corpus.Types ( Datafield(Web), database2origin ) ...@@ -37,7 +37,7 @@ import Gargantext.API.Node.Corpus.Types ( Datafield(Web), database2origin )
import Gargantext.API.Node.Corpus.Update (addLanguageToCorpus) import Gargantext.API.Node.Corpus.Update (addLanguageToCorpus)
import Gargantext.API.Node.Types import Gargantext.API.Node.Types
import Gargantext.Core (withDefaultLanguage, defaultLanguage) import Gargantext.Core (withDefaultLanguage, defaultLanguage)
import Gargantext.Core.Config (gc_jobs) import Gargantext.Core.Config (gc_jobs, hasConfig)
import Gargantext.Core.Config.Types (jc_max_docs_parsers) import Gargantext.Core.Config.Types (jc_max_docs_parsers)
import Gargantext.Core.NodeStory (HasNodeStoryImmediateSaver, HasNodeArchiveStoryImmediateSaver, currentVersion, NgramsStatePatch') import Gargantext.Core.NodeStory (HasNodeStoryImmediateSaver, HasNodeArchiveStoryImmediateSaver, currentVersion, NgramsStatePatch')
import Gargantext.Core.Text.Corpus.Parsers qualified as Parser (FileType(..), parseFormatC, _ParseFormatError) import Gargantext.Core.Text.Corpus.Parsers qualified as Parser (FileType(..), parseFormatC, _ParseFormatError)
...@@ -53,7 +53,6 @@ import Gargantext.Database.Admin.Types.Hyperdata.Document ( ToHyperdataDocument( ...@@ -53,7 +53,6 @@ import Gargantext.Database.Admin.Types.Hyperdata.Document ( ToHyperdataDocument(
import Gargantext.Database.Admin.Types.Hyperdata.File ( HyperdataFile(..) ) import Gargantext.Database.Admin.Types.Hyperdata.File ( HyperdataFile(..) )
import Gargantext.Database.Admin.Types.Node (CorpusId, NodeType(..), ParentId) import Gargantext.Database.Admin.Types.Node (CorpusId, NodeType(..), ParentId)
import Gargantext.Database.GargDB qualified as GargDB import Gargantext.Database.GargDB qualified as GargDB
import Gargantext.Database.Prelude (hasConfig)
import Gargantext.Database.Query.Table.Node (getNodeWith, getOrMkList) import Gargantext.Database.Query.Table.Node (getNodeWith, getOrMkList)
import Gargantext.Database.Query.Table.Node.UpdateOpaleye (updateHyperdata) import Gargantext.Database.Query.Table.Node.UpdateOpaleye (updateHyperdata)
import Gargantext.Database.Query.Tree.Root (MkCorpusUser(MkCorpusUserNormalCorpusIds)) import Gargantext.Database.Query.Tree.Root (MkCorpusUser(MkCorpusUserNormalCorpusIds))
......
...@@ -23,7 +23,7 @@ import Data.Time.Format (defaultTimeLocale, formatTime, parseTimeM) ...@@ -23,7 +23,7 @@ import Data.Time.Format (defaultTimeLocale, formatTime, parseTimeM)
import Data.Tuple.Select (sel1, sel2, sel3) import Data.Tuple.Select (sel1, sel2, sel3)
import Gargantext.API.Admin.Types (HasSettings) import Gargantext.API.Admin.Types (HasSettings)
import Gargantext.Core (Lang(..)) import Gargantext.Core (Lang(..))
import Gargantext.Core.Config (GargConfig(..)) import Gargantext.Core.Config (GargConfig(..), hasConfig)
import Gargantext.Core.Config.Types (FramesConfig(..)) import Gargantext.Core.Config.Types (FramesConfig(..))
import Gargantext.Core.NLP (HasNLPServer, nlpServerGet) import Gargantext.Core.NLP (HasNLPServer, nlpServerGet)
import Gargantext.Core.NodeStory.Types ( HasNodeStory ) import Gargantext.Core.NodeStory.Types ( HasNodeStory )
...@@ -40,7 +40,6 @@ import Gargantext.Database.Action.User (getUserId) ...@@ -40,7 +40,6 @@ import Gargantext.Database.Action.User (getUserId)
import Gargantext.Database.Admin.Types.Hyperdata.Corpus (HyperdataCorpus) import Gargantext.Database.Admin.Types.Hyperdata.Corpus (HyperdataCorpus)
import Gargantext.Database.Admin.Types.Hyperdata.Document (HyperdataDocument(..)) import Gargantext.Database.Admin.Types.Hyperdata.Document (HyperdataDocument(..))
import Gargantext.Database.Admin.Types.Node (CorpusId, ListId, NodeType(NodeTexts)) import Gargantext.Database.Admin.Types.Node (CorpusId, ListId, NodeType(NodeTexts))
import Gargantext.Database.Prelude (hasConfig)
import Gargantext.Database.Query.Table.Node (getOrMkList, insertDefaultNodeIfNotExists) import Gargantext.Database.Query.Table.Node (getOrMkList, insertDefaultNodeIfNotExists)
import Gargantext.Database.Query.Table.Node.Error (HasNodeError) import Gargantext.Database.Query.Table.Node.Error (HasNodeError)
import Gargantext.Database.Query.Tree.Error (HasTreeError) import Gargantext.Database.Query.Tree.Error (HasTreeError)
......
...@@ -21,6 +21,7 @@ import Data.Text qualified as T ...@@ -21,6 +21,7 @@ import Data.Text qualified as T
import Gargantext.API.Admin.Auth.Types ( auth_node_id, AuthenticatedUser ) import Gargantext.API.Admin.Auth.Types ( auth_node_id, AuthenticatedUser )
import Gargantext.API.Admin.EnvTypes (GargJob(..), Env) import Gargantext.API.Admin.EnvTypes (GargJob(..), Env)
import Gargantext.API.Admin.Orchestrator.Types (AsyncJobs(..)) import Gargantext.API.Admin.Orchestrator.Types (AsyncJobs(..))
import Gargantext.API.Admin.Types (HasSettings)
import Gargantext.API.Errors.Types ( BackendInternalError ) import Gargantext.API.Errors.Types ( BackendInternalError )
import Gargantext.API.Node.Corpus.New (addToCorpusWithForm) import Gargantext.API.Node.Corpus.New (addToCorpusWithForm)
import Gargantext.API.Node.Corpus.New.Types (FileFormat(..), FileType(..)) import Gargantext.API.Node.Corpus.New.Types (FileFormat(..), FileType(..))
...@@ -28,12 +29,12 @@ import Gargantext.API.Node.FrameCalcUpload.Types ...@@ -28,12 +29,12 @@ import Gargantext.API.Node.FrameCalcUpload.Types
import Gargantext.API.Node.Types (NewWithForm(..)) import Gargantext.API.Node.Types (NewWithForm(..))
import Gargantext.API.Prelude ( GargM ) import Gargantext.API.Prelude ( GargM )
import Gargantext.API.Routes.Named.FrameCalc qualified as Named import Gargantext.API.Routes.Named.FrameCalc qualified as Named
import Gargantext.Core.Config (HasConfig)
import Gargantext.Core.NodeStory.Types ( HasNodeArchiveStoryImmediateSaver ) import Gargantext.Core.NodeStory.Types ( HasNodeArchiveStoryImmediateSaver )
import Gargantext.Core.Types.Individu (User(..)) import Gargantext.Core.Types.Individu (User(..))
import Gargantext.Database.Action.Flow.Types ( FlowCmdM ) import Gargantext.Database.Action.Flow.Types ( FlowCmdM )
import Gargantext.Database.Admin.Types.Hyperdata.Frame ( HyperdataFrame(..) ) import Gargantext.Database.Admin.Types.Hyperdata.Frame ( HyperdataFrame(..) )
import Gargantext.Database.Admin.Types.Node ( NodeId, NodeType(NodeCorpus) ) import Gargantext.Database.Admin.Types.Node ( NodeId, NodeType(NodeCorpus) )
import Gargantext.Database.Prelude (HasConfig)
import Gargantext.Database.Query.Table.Node (getClosestParentIdByType, getNodeWith) import Gargantext.Database.Query.Table.Node (getClosestParentIdByType, getNodeWith)
import Gargantext.Database.Schema.Node (node_hyperdata) import Gargantext.Database.Schema.Node (node_hyperdata)
import Gargantext.Prelude import Gargantext.Prelude
...@@ -41,7 +42,6 @@ import Gargantext.Utils.Jobs (serveJobsAPI, MonadJobStatus(..), markFailureNoErr ...@@ -41,7 +42,6 @@ import Gargantext.Utils.Jobs (serveJobsAPI, MonadJobStatus(..), markFailureNoErr
import Network.HTTP.Client (newManager, httpLbs, parseRequest, responseBody) import Network.HTTP.Client (newManager, httpLbs, parseRequest, responseBody)
import Network.HTTP.Client.TLS (tlsManagerSettings) import Network.HTTP.Client.TLS (tlsManagerSettings)
import Servant.Server.Generic (AsServerT) import Servant.Server.Generic (AsServerT)
import Gargantext.API.Admin.Types (HasSettings)
api :: AuthenticatedUser -> NodeId -> Named.FrameCalcAPI (AsServerT (GargM Env BackendInternalError)) api :: AuthenticatedUser -> NodeId -> Named.FrameCalcAPI (AsServerT (GargM Env BackendInternalError))
......
...@@ -7,13 +7,12 @@ module Gargantext.API.Node.ShareURL where ...@@ -7,13 +7,12 @@ 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, HasConfig(hasConfig))
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 (CmdCommon)
import Gargantext.Prelude import Gargantext.Prelude
import Network.URI (parseURI) import Network.URI (parseURI)
import Prelude (String) import Prelude (String)
...@@ -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
......
...@@ -27,11 +27,12 @@ import Gargantext.API.Admin.Orchestrator.Types ...@@ -27,11 +27,12 @@ import Gargantext.API.Admin.Orchestrator.Types
import Gargantext.API.Admin.Types import Gargantext.API.Admin.Types
import Gargantext.API.Errors.Class import Gargantext.API.Errors.Class
import Gargantext.Core.AsyncUpdates.CentralExchange.Types (HasCentralExchangeNotification) import Gargantext.Core.AsyncUpdates.CentralExchange.Types (HasCentralExchangeNotification)
import Gargantext.Core.Config (HasConfig)
import Gargantext.Core.Mail.Types (HasMail) import Gargantext.Core.Mail.Types (HasMail)
import Gargantext.Core.NLP (HasNLPServer) import Gargantext.Core.NLP (HasNLPServer)
import Gargantext.Core.NodeStory import Gargantext.Core.NodeStory
import Gargantext.Core.Types import Gargantext.Core.Types
import Gargantext.Database.Prelude (CmdM, CmdRandom, HasConnectionPool, HasConfig) import Gargantext.Database.Prelude (CmdM, CmdRandom, HasConnectionPool)
import Gargantext.Database.Query.Table.Node.Error (HasNodeError(..)) import Gargantext.Database.Query.Table.Node.Error (HasNodeError(..))
import Gargantext.Database.Query.Tree import Gargantext.Database.Query.Tree
import Gargantext.Prelude import Gargantext.Prelude
......
...@@ -30,12 +30,11 @@ import Gargantext.API.Node.Corpus.New qualified as New ...@@ -30,12 +30,11 @@ import Gargantext.API.Node.Corpus.New qualified as New
import Gargantext.API.Prelude import Gargantext.API.Prelude
import Gargantext.API.Routes.Named.Annuaire qualified as Named import Gargantext.API.Routes.Named.Annuaire qualified as Named
import Gargantext.API.Routes.Named.Corpus qualified as Named import Gargantext.API.Routes.Named.Corpus qualified as Named
import Gargantext.Core.Config (gc_jobs) import Gargantext.Core.Config (gc_jobs, HasConfig(..))
import Gargantext.Core.Config.Types (jc_max_docs_scrapers) import Gargantext.Core.Config.Types (jc_max_docs_scrapers)
import Gargantext.Core.Types.Individu (User(..)) import Gargantext.Core.Types.Individu (User(..))
import Gargantext.Core.Worker.Jobs qualified as Jobs import Gargantext.Core.Worker.Jobs qualified as Jobs
import Gargantext.Core.Worker.Jobs.Types qualified as Jobs import Gargantext.Core.Worker.Jobs.Types qualified as Jobs
import Gargantext.Database.Prelude (HasConfig(..))
import Gargantext.Prelude import Gargantext.Prelude
import Gargantext.Utils.Jobs (serveJobsAPI) import Gargantext.Utils.Jobs (serveJobsAPI)
import Servant import Servant
......
...@@ -23,9 +23,8 @@ import Gargantext.API.Server.Named.Public (serverPublicGargAPI) ...@@ -23,9 +23,8 @@ import Gargantext.API.Server.Named.Public (serverPublicGargAPI)
import Gargantext.API.Swagger (swaggerDoc) import Gargantext.API.Swagger (swaggerDoc)
import Gargantext.API.ThrowAll (serverPrivateGargAPI) import Gargantext.API.ThrowAll (serverPrivateGargAPI)
import Gargantext.Core.AsyncUpdates.Dispatcher.WebSocket qualified as Dispatcher import Gargantext.Core.AsyncUpdates.Dispatcher.WebSocket qualified as Dispatcher
import Gargantext.Core.Config (gc_frontend_config) import Gargantext.Core.Config (gc_frontend_config, hasConfig)
import Gargantext.Core.Config.Types (fc_url_backend_api) import Gargantext.Core.Config.Types (fc_url_backend_api)
import Gargantext.Database.Prelude (hasConfig)
import Gargantext.Prelude hiding (Handler, catch) import Gargantext.Prelude hiding (Handler, catch)
import Gargantext.System.Logging (logLocM, LogLevel(..)) import Gargantext.System.Logging (logLocM, LogLevel(..))
import Paths_gargantext qualified as PG -- cabal magic build module import Paths_gargantext qualified as PG -- cabal magic build module
......
...@@ -31,7 +31,7 @@ import DeferredFolds.UnfoldlM qualified as UnfoldlM ...@@ -31,7 +31,7 @@ import DeferredFolds.UnfoldlM qualified as UnfoldlM
import Data.UUID.V4 as UUID import Data.UUID.V4 as UUID
import Gargantext.API.Admin.Auth.Types (AuthenticatedUser(_auth_user_id)) import Gargantext.API.Admin.Auth.Types (AuthenticatedUser(_auth_user_id))
import Gargantext.API.Admin.Orchestrator.Types (JobLog) import Gargantext.API.Admin.Orchestrator.Types (JobLog)
import Gargantext.API.Admin.Types (jwtSettings, Settings, jwtSettings) import Gargantext.API.Admin.Types (Settings)
import Gargantext.API.Prelude (IsGargServer) import Gargantext.API.Prelude (IsGargServer)
import Gargantext.Core.AsyncUpdates.CentralExchange.Types qualified as CETypes import Gargantext.Core.AsyncUpdates.CentralExchange.Types qualified as CETypes
import Gargantext.Core.Types (NodeId, UserId) import Gargantext.Core.Types (NodeId, UserId)
......
...@@ -23,17 +23,17 @@ import Control.Lens (view) ...@@ -23,17 +23,17 @@ import Control.Lens (view)
import Data.Aeson qualified as Aeson import Data.Aeson qualified as Aeson
import Data.UUID.V4 as UUID import Data.UUID.V4 as UUID
import Gargantext.API.Admin.Auth.Types (AuthenticatedUser(_auth_user_id)) import Gargantext.API.Admin.Auth.Types (AuthenticatedUser(_auth_user_id))
import Gargantext.API.Admin.Types (HasSettings(settings), Settings, jwtSettings)
import Gargantext.API.Prelude (IsGargServer) import Gargantext.API.Prelude (IsGargServer)
import Gargantext.Core.AsyncUpdates.Dispatcher.Subscriptions import Gargantext.Core.AsyncUpdates.Dispatcher.Subscriptions
import Gargantext.Core.AsyncUpdates.Dispatcher.Types import Gargantext.Core.AsyncUpdates.Dispatcher.Types
import Gargantext.Core.AsyncUpdates.Dispatcher (Dispatcher, dispatcherSubscriptions) import Gargantext.Core.AsyncUpdates.Dispatcher (Dispatcher, dispatcherSubscriptions)
import Gargantext.Core.Config (HasJWTSettings(jwtSettings))
import Gargantext.Prelude import Gargantext.Prelude
import Gargantext.System.Logging (LogLevel(DEBUG), logMsg, withLogger) import Gargantext.System.Logging (LogLevel(DEBUG), logMsg, withLogger)
import Network.WebSockets qualified as WS import Network.WebSockets qualified as WS
import Servant import Servant
import Servant.API.WebSocket qualified as WS (WebSocketPending) import Servant.API.WebSocket qualified as WS (WebSocketPending)
import Servant.Auth.Server (verifyJWT) import Servant.Auth.Server (JWTSettings, verifyJWT)
import Servant.Server.Generic (AsServerT) import Servant.Server.Generic (AsServerT)
import StmContainers.Set as SSet import StmContainers.Set as SSet
...@@ -43,19 +43,19 @@ newtype WSAPI mode = WSAPI { ...@@ -43,19 +43,19 @@ newtype WSAPI mode = WSAPI {
} deriving Generic } deriving Generic
wsServer :: ( IsGargServer env err m, HasDispatcher env Dispatcher, HasSettings env ) => WSAPI (AsServerT m) wsServer :: ( IsGargServer env err m, HasDispatcher env Dispatcher, HasJWTSettings env ) => WSAPI (AsServerT m)
wsServer = WSAPI { wsAPIServer = streamData } wsServer = WSAPI { wsAPIServer = streamData }
where where
streamData :: ( IsGargServer env err m, HasDispatcher env Dispatcher, HasSettings env ) streamData :: ( IsGargServer env err m, HasDispatcher env Dispatcher, HasJWTSettings env )
=> WS.PendingConnection -> m () => WS.PendingConnection -> m ()
streamData pc = do streamData pc = do
authSettings <- view settings jwtS <- view jwtSettings
d <- view hasDispatcher d <- view hasDispatcher
let subscriptions = dispatcherSubscriptions d let subscriptions = dispatcherSubscriptions d
key <- getWSKey pc key <- getWSKey pc
c <- liftBase $ WS.acceptRequest pc c <- liftBase $ WS.acceptRequest pc
let ws = WSKeyConnection (key, c) let ws = WSKeyConnection (key, c)
_ <- liftBase $ Async.concurrently (wsLoop authSettings subscriptions ws) (pingLoop ws) _ <- liftBase $ Async.concurrently (wsLoop jwtS subscriptions ws) (pingLoop ws)
-- _ <- liftIO $ Async.withAsync (pure ()) (\_ -> wsLoop ws) -- _ <- liftIO $ Async.withAsync (pure ()) (\_ -> wsLoop ws)
pure () pure ()
...@@ -73,8 +73,8 @@ pingLoop ws = do ...@@ -73,8 +73,8 @@ pingLoop ws = do
threadDelay $ 10 * 1000000 threadDelay $ 10 * 1000000
wsLoop :: Settings -> SSet.Set Subscription -> WSKeyConnection -> IO a wsLoop :: JWTSettings -> SSet.Set Subscription -> WSKeyConnection -> IO a
wsLoop authSettings subscriptions ws = flip finally disconnect $ do wsLoop jwtS subscriptions ws = flip finally disconnect $ do
withLogger () $ \ioLogger -> do withLogger () $ \ioLogger -> do
logMsg ioLogger DEBUG "[wsLoop] connecting" logMsg ioLogger DEBUG "[wsLoop] connecting"
wsLoop' CUPublic ioLogger wsLoop' CUPublic ioLogger
...@@ -105,7 +105,6 @@ wsLoop authSettings subscriptions ws = flip finally disconnect $ do ...@@ -105,7 +105,6 @@ wsLoop authSettings subscriptions ws = flip finally disconnect $ do
-- putText $ "[wsLoop] subscriptions: " <> show (showSub <$> ss) -- putText $ "[wsLoop] subscriptions: " <> show (showSub <$> ss)
return user return user
Just (WSAuthorize token) -> do Just (WSAuthorize token) -> do
let jwtS = authSettings ^. jwtSettings
mUser <- liftBase $ verifyJWT jwtS (encodeUtf8 token) mUser <- liftBase $ verifyJWT jwtS (encodeUtf8 token)
logMsg ioLogger DEBUG $ "[wsLoop] authorized user: " <> show mUser logMsg ioLogger DEBUG $ "[wsLoop] authorized user: " <> show mUser
......
...@@ -29,10 +29,16 @@ module Gargantext.Core.Config ( ...@@ -29,10 +29,16 @@ module Gargantext.Core.Config (
, gc_secrets , gc_secrets
, gc_apis , gc_apis
, gc_worker , gc_worker
, gc_log_level
, mkProxyUrl , mkProxyUrl
, HasJWTSettings(..)
, HasConfig(..)
) where ) where
import Control.Lens (Getter)
import Control.Monad.Logger (LogLevel(LevelDebug))
import Data.Text as T import Data.Text as T
import Database.PostgreSQL.Simple qualified as PSQL import Database.PostgreSQL.Simple qualified as PSQL
import Gargantext.Core.Config.Mail (MailConfig) import Gargantext.Core.Config.Mail (MailConfig)
...@@ -40,6 +46,7 @@ import Gargantext.Core.Config.NLP (NLPConfig) ...@@ -40,6 +46,7 @@ import Gargantext.Core.Config.NLP (NLPConfig)
import Gargantext.Core.Config.Worker (WorkerSettings) import Gargantext.Core.Config.Worker (WorkerSettings)
import Gargantext.Core.Config.Types import Gargantext.Core.Config.Types
import Gargantext.Prelude import Gargantext.Prelude
import Servant.Auth.Server (JWTSettings)
import Servant.Client (BaseUrl(..), Scheme(Http), parseBaseUrl) import Servant.Client (BaseUrl(..), Scheme(Http), parseBaseUrl)
import Toml.Schema import Toml.Schema
...@@ -51,7 +58,6 @@ import Toml.Schema ...@@ -51,7 +58,6 @@ import Toml.Schema
-- Non-strict data so that we can use it in tests -- Non-strict data so that we can use it in tests
data GargConfig = GargConfig { _gc_datafilepath :: ~FilePath data GargConfig = GargConfig { _gc_datafilepath :: ~FilePath
-- , _gc_repofilepath :: ~FilePath -- , _gc_repofilepath :: ~FilePath
, _gc_frontend_config :: ~FrontendConfig , _gc_frontend_config :: ~FrontendConfig
, _gc_mail_config :: ~MailConfig , _gc_mail_config :: ~MailConfig
, _gc_database_config :: ~PSQL.ConnectInfo , _gc_database_config :: ~PSQL.ConnectInfo
...@@ -62,6 +68,7 @@ data GargConfig = GargConfig { _gc_datafilepath :: ~FilePath ...@@ -62,6 +68,7 @@ data GargConfig = GargConfig { _gc_datafilepath :: ~FilePath
, _gc_secrets :: ~SecretsConfig , _gc_secrets :: ~SecretsConfig
, _gc_apis :: ~APIsConfig , _gc_apis :: ~APIsConfig
, _gc_worker :: ~WorkerSettings , _gc_worker :: ~WorkerSettings
, _gc_log_level :: ~LogLevel
} }
deriving (Generic, Show) deriving (Generic, Show)
...@@ -80,6 +87,7 @@ instance FromValue GargConfig where ...@@ -80,6 +87,7 @@ instance FromValue GargConfig where
_gc_apis <- reqKey "apis" _gc_apis <- reqKey "apis"
_gc_notifications_config <- reqKey "notifications" _gc_notifications_config <- reqKey "notifications"
_gc_worker <- reqKey "worker" _gc_worker <- reqKey "worker"
let _gc_log_level = LevelDebug
return $ GargConfig { _gc_datafilepath return $ GargConfig { _gc_datafilepath
, _gc_jobs , _gc_jobs
, _gc_apis , _gc_apis
...@@ -90,7 +98,8 @@ instance FromValue GargConfig where ...@@ -90,7 +98,8 @@ instance FromValue GargConfig where
, _gc_notifications_config , _gc_notifications_config
, _gc_frames , _gc_frames
, _gc_secrets , _gc_secrets
, _gc_worker } , _gc_worker
, _gc_log_level }
instance ToValue GargConfig where instance ToValue GargConfig where
toValue = defaultTableToValue toValue = defaultTableToValue
instance ToTable GargConfig where instance ToTable GargConfig where
...@@ -110,8 +119,19 @@ instance ToTable GargConfig where ...@@ -110,8 +119,19 @@ 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 }
class HasConfig env where
hasConfig :: Getter env GargConfig
instance HasConfig GargConfig where
hasConfig = identity
class HasJWTSettings env where
jwtSettings :: Getter env JWTSettings
...@@ -25,13 +25,16 @@ module Gargantext.Core.Config.Types ...@@ -25,13 +25,16 @@ 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
, fc_url_backend_api , fc_url_backend_api
, 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
...@@ -39,7 +42,9 @@ module Gargantext.Core.Config.Types ...@@ -39,7 +42,9 @@ module Gargantext.Core.Config.Types
, jc_js_id_timeout , jc_js_id_timeout
, MicroServicesSettings(..) , MicroServicesSettings(..)
, NotificationsConfig(..) , NotificationsConfig(..)
, JWKFile(..)
, SecretsConfig(..) , SecretsConfig(..)
, jwtSettings
, SettingsFile(..) , SettingsFile(..)
, TOMLConnectInfo(..) , TOMLConnectInfo(..)
...@@ -54,7 +59,9 @@ import Control.Monad.Fail (fail) ...@@ -54,7 +59,9 @@ import Control.Monad.Fail (fail)
import Data.Text qualified as T import Data.Text qualified as T
import Database.PostgreSQL.Simple qualified as PGS import Database.PostgreSQL.Simple qualified as PGS
import Gargantext.Prelude import Gargantext.Prelude
import Servant.Auth.Server (JWTSettings, defaultJWTSettings, readKey, writeKey)
import Servant.Client.Core (BaseUrl, parseBaseUrl, showBaseUrl) import Servant.Client.Core (BaseUrl, parseBaseUrl, showBaseUrl)
import System.Directory (doesFileExist)
import Toml import Toml
import Toml.Schema import Toml.Schema
...@@ -179,13 +186,17 @@ instance ToTable FramesConfig where ...@@ -179,13 +186,17 @@ 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
, _fc_url_backend_api :: !Text , _fc_url_backend_api :: !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
...@@ -193,9 +204,9 @@ instance FromValue FrontendConfig where ...@@ -193,9 +204,9 @@ instance FromValue FrontendConfig where
_fc_url <- reqKey "url" _fc_url <- reqKey "url"
_fc_backend_name <- reqKey "backend_name" _fc_backend_name <- reqKey "backend_name"
_fc_url_backend_api <- reqKey "url_backend_api" _fc_url_backend_api <- reqKey "url_backend_api"
_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
...@@ -203,28 +214,54 @@ instance ToTable FrontendConfig where ...@@ -203,28 +214,54 @@ instance ToTable FrontendConfig where
toTable (FrontendConfig { .. }) = table [ "url" .= _fc_url toTable (FrontendConfig { .. }) = table [ "url" .= _fc_url
, "backend_name" .= _fc_backend_name , "backend_name" .= _fc_backend_name
, "url_backend_api" .= _fc_url_backend_api , "url_backend_api" .= _fc_url_backend_api
, "jwt_settings" .= _fc_jwt_settings
, "cors" .= _fc_cors , "cors" .= _fc_cors
, "microservices" .= _fc_microservices ] , "microservices" .= _fc_microservices ]
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
newtype JWKFile = JWKFile { unJWKFile :: FilePath }
deriving (Show, Eq, Generic)
data SecretsConfig = data SecretsConfig =
SecretsConfig { _s_master_user :: !Text SecretsConfig { _s_master_user :: !Text
, _s_secret_key :: !Text , _s_secret_key :: !Text
, _s_jwk_file :: !JWKFile
} }
deriving (Generic, Show) deriving (Generic, Show)
instance FromValue SecretsConfig where instance FromValue SecretsConfig where
fromValue = parseTableFromValue $ do fromValue = parseTableFromValue $ do
_s_master_user <- reqKey "master_user" _s_master_user <- reqKey "master_user"
_s_secret_key <- reqKey "secret_key" _s_secret_key <- reqKey "secret_key"
jwkFile <- reqKey "jwk_file"
let _s_jwk_file = JWKFile jwkFile
return $ SecretsConfig { .. } return $ SecretsConfig { .. }
instance ToValue SecretsConfig where instance ToValue SecretsConfig where
toValue = defaultTableToValue toValue = defaultTableToValue
instance ToTable SecretsConfig where instance ToTable SecretsConfig where
toTable (SecretsConfig { .. }) = table [ "master_user" .= _s_master_user toTable (SecretsConfig { .. }) = table [ "master_user" .= _s_master_user
, "secret_key" .= _s_secret_key ] , "secret_key" .= _s_secret_key
, "jwk_file" .= unJWKFile _s_jwk_file ]
jwtSettings :: SecretsConfig -> IO JWTSettings
jwtSettings (SecretsConfig { _s_jwk_file = JWKFile jwkFile }) = do
jwkExists <- doesFileExist jwkFile
when (not jwkExists) $ writeKey jwkFile
jwk <- readKey jwkFile
pure $ defaultJWTSettings jwk
data JobsConfig = data JobsConfig =
......
...@@ -15,11 +15,10 @@ import Control.Lens (view) ...@@ -15,11 +15,10 @@ import Control.Lens (view)
import Control.Monad.Trans.Control (MonadBaseControl) import Control.Monad.Trans.Control (MonadBaseControl)
import Data.List qualified as List import Data.List qualified as List
import Data.Text (splitOn) import Data.Text (splitOn)
import Gargantext.Core.Config (gc_frontend_config) import Gargantext.Core.Config (gc_frontend_config, HasConfig(..))
import Gargantext.Core.Config.Types (fc_url, fc_backend_name) import Gargantext.Core.Config.Types (fc_url, fc_backend_name)
import Gargantext.Core.Config.Mail (gargMail, GargMail(..), MailConfig) import Gargantext.Core.Config.Mail (gargMail, GargMail(..), MailConfig)
import Gargantext.Core.Types.Individu import Gargantext.Core.Types.Individu
import Gargantext.Database.Prelude (HasConfig(..))
import Gargantext.Database.Schema.User (UserLight(..)) import Gargantext.Database.Schema.User (UserLight(..))
import Gargantext.Prelude import Gargantext.Prelude
import Network.URI.Encode (encodeText) import Network.URI.Encode (encodeText)
......
...@@ -24,12 +24,12 @@ import Data.Text qualified as T ...@@ -24,12 +24,12 @@ import Data.Text qualified as T
import Database.PostgreSQL.Simple (Connection) import Database.PostgreSQL.Simple (Connection)
import Gargantext.API.Admin.EnvTypes (ConcreteJobHandle, GargJob, Mode(Dev), modeToLoggingLevels) import Gargantext.API.Admin.EnvTypes (ConcreteJobHandle, GargJob, Mode(Dev), modeToLoggingLevels)
import Gargantext.API.Admin.Orchestrator.Types (JobLog, noJobLog) import Gargantext.API.Admin.Orchestrator.Types (JobLog, noJobLog)
import Gargantext.API.Admin.Settings ( devJwkFile, devSettings, newPool ) import Gargantext.API.Admin.Settings ( devSettings, newPool )
import Gargantext.API.Admin.Types (HasSettings(..), Settings(..)) import Gargantext.API.Admin.Types (HasSettings(..), Settings(..))
import Gargantext.API.Prelude (GargM) import Gargantext.API.Prelude (GargM)
import Gargantext.Core.AsyncUpdates.CentralExchange qualified as CE import Gargantext.Core.AsyncUpdates.CentralExchange qualified as CE
import Gargantext.Core.AsyncUpdates.CentralExchange.Types qualified as CET import Gargantext.Core.AsyncUpdates.CentralExchange.Types qualified as CET
import Gargantext.Core.Config (GargConfig(..)) import Gargantext.Core.Config (GargConfig(..), HasConfig(..))
import Gargantext.Core.Config.Mail qualified as Mail import Gargantext.Core.Config.Mail qualified as Mail
import Gargantext.Core.Config.Utils (readConfig) import Gargantext.Core.Config.Utils (readConfig)
import Gargantext.Core.Config.Types (SettingsFile(..)) import Gargantext.Core.Config.Types (SettingsFile(..))
...@@ -37,7 +37,7 @@ import Gargantext.Core.Mail.Types (HasMail(..)) ...@@ -37,7 +37,7 @@ import Gargantext.Core.Mail.Types (HasMail(..))
import Gargantext.Core.NLP (HasNLPServer(..), NLPServerMap, nlpServerMap) import Gargantext.Core.NLP (HasNLPServer(..), NLPServerMap, nlpServerMap)
import Gargantext.Core.NodeStory (HasNodeStoryEnv(..), HasNodeStoryImmediateSaver(..), HasNodeArchiveStoryImmediateSaver(..), NodeStoryEnv, fromDBNodeStoryEnv, nse_saver_immediate, nse_archive_saver_immediate) import Gargantext.Core.NodeStory (HasNodeStoryEnv(..), HasNodeStoryImmediateSaver(..), HasNodeArchiveStoryImmediateSaver(..), NodeStoryEnv, fromDBNodeStoryEnv, nse_saver_immediate, nse_archive_saver_immediate)
import Gargantext.Core.Types (HasValidationError(..)) import Gargantext.Core.Types (HasValidationError(..))
import Gargantext.Database.Prelude (HasConfig(..), HasConnectionPool(..)) import Gargantext.Database.Prelude (HasConnectionPool(..))
import Gargantext.Database.Query.Table.Node.Error (HasNodeError(..)) import Gargantext.Database.Query.Table.Node.Error (HasNodeError(..))
import Gargantext.Database.Query.Tree.Error (HasTreeError(..)) import Gargantext.Database.Query.Tree.Error (HasTreeError(..))
import Gargantext.Prelude hiding (to) import Gargantext.Prelude hiding (to)
...@@ -70,7 +70,7 @@ withWorkerEnv settingsFile k = withLoggerHoisted Dev $ \logger -> do ...@@ -70,7 +70,7 @@ withWorkerEnv 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 let setts = devSettings
pure $ WorkerEnv pure $ WorkerEnv
{ _w_env_pool = pool { _w_env_pool = pool
, _w_env_logger = logger , _w_env_logger = logger
......
...@@ -20,7 +20,7 @@ import Async.Worker.Types qualified as Worker ...@@ -20,7 +20,7 @@ import Async.Worker.Types qualified as Worker
import Async.Worker.Types (HasWorkerBroker) import Async.Worker.Types (HasWorkerBroker)
import Control.Lens (view) import Control.Lens (view)
import Database.Redis qualified as Redis import Database.Redis qualified as Redis
import Gargantext.API.Admin.Types (HasSettings, settings, workerSettings) import Gargantext.Core.Config (gc_worker, HasConfig(..))
import Gargantext.Core.Config.Worker (WorkerSettings(..), WorkerDefinition(..), wdToRedisConnectInfo) import Gargantext.Core.Config.Worker (WorkerSettings(..), WorkerDefinition(..), wdToRedisConnectInfo)
import Gargantext.Core.Worker.Jobs.Types (Job(..)) import Gargantext.Core.Worker.Jobs.Types (Job(..))
import Gargantext.Database.Prelude (Cmd') import Gargantext.Database.Prelude (Cmd')
...@@ -36,11 +36,11 @@ initializeRedisBroker connInfo = do ...@@ -36,11 +36,11 @@ initializeRedisBroker connInfo = do
initBroker initParams initBroker initParams
sendJob :: (HasWorkerBroker RedisBroker Job, HasSettings env) sendJob :: (HasWorkerBroker RedisBroker Job, HasConfig env)
=> Job => Job
-> Cmd' env err () -> Cmd' env err ()
sendJob job = do sendJob job = do
ws <- view $ settings . workerSettings ws <- view $ hasConfig . gc_worker
-- TODO Try to guess which worker should get this job -- TODO Try to guess which worker should get this job
-- let mWd = findDefinitionByName ws workerName -- let mWd = findDefinitionByName ws workerName
let mWd = head $ _wsDefinitions ws let mWd = head $ _wsDefinitions ws
......
...@@ -66,7 +66,7 @@ import EPO.API.Client.Types qualified as EPO ...@@ -66,7 +66,7 @@ import EPO.API.Client.Types qualified as EPO
import Gargantext.API.Ngrams.Tools (getTermsWith) import Gargantext.API.Ngrams.Tools (getTermsWith)
import Gargantext.Core (Lang(..), NLPServerConfig, withDefaultLanguage) import Gargantext.Core (Lang(..), NLPServerConfig, withDefaultLanguage)
import Gargantext.Core.AsyncUpdates.CentralExchange.Types (HasCentralExchangeNotification(ce_notify), CEMessage(..)) import Gargantext.Core.AsyncUpdates.CentralExchange.Types (HasCentralExchangeNotification(ce_notify), CEMessage(..))
import Gargantext.Core.Config (GargConfig(..)) import Gargantext.Core.Config (GargConfig(..), hasConfig)
import Gargantext.Core.Config.Types (APIsConfig(..)) import Gargantext.Core.Config.Types (APIsConfig(..))
import Gargantext.Core.Ext.IMTUser (readFile_Annuaire) import Gargantext.Core.Ext.IMTUser (readFile_Annuaire)
import Gargantext.Core.NLP (HasNLPServer, nlpServerGet) import Gargantext.Core.NLP (HasNLPServer, nlpServerGet)
...@@ -93,7 +93,7 @@ import Gargantext.Database.Admin.Types.Hyperdata.Contact ( HyperdataContact ) ...@@ -93,7 +93,7 @@ import Gargantext.Database.Admin.Types.Hyperdata.Contact ( HyperdataContact )
import Gargantext.Database.Admin.Types.Hyperdata.Corpus ( HyperdataAnnuaire, HyperdataCorpus(_hc_lang) ) import Gargantext.Database.Admin.Types.Hyperdata.Corpus ( HyperdataAnnuaire, HyperdataCorpus(_hc_lang) )
import Gargantext.Database.Admin.Types.Hyperdata.Document ( ToHyperdataDocument(toHyperdataDocument) ) import Gargantext.Database.Admin.Types.Hyperdata.Document ( ToHyperdataDocument(toHyperdataDocument) )
import Gargantext.Database.Admin.Types.Node hiding (DEBUG) -- (HyperdataDocument(..), NodeType(..), NodeId, UserId, ListId, CorpusId, RootId, MasterCorpusId, MasterUserId) import Gargantext.Database.Admin.Types.Node hiding (DEBUG) -- (HyperdataDocument(..), NodeType(..), NodeId, UserId, ListId, CorpusId, RootId, MasterCorpusId, MasterUserId)
import Gargantext.Database.Prelude (DbCmd', hasConfig, DBCmd') import Gargantext.Database.Prelude (DbCmd', DBCmd')
import Gargantext.Database.Query.Table.ContextNodeNgrams2 ( ContextNodeNgrams2Poly(..), insertContextNodeNgrams2 ) import Gargantext.Database.Query.Table.ContextNodeNgrams2 ( ContextNodeNgrams2Poly(..), insertContextNodeNgrams2 )
import Gargantext.Database.Query.Table.Node ( MkCorpus, insertDefaultNodeIfNotExists, getOrMkList, getNodeWith ) import Gargantext.Database.Query.Table.Node ( MkCorpus, insertDefaultNodeIfNotExists, getOrMkList, getNodeWith )
import Gargantext.Database.Query.Table.Node.Document.Add qualified as Doc (add) import Gargantext.Database.Query.Table.Node.Document.Add qualified as Doc (add)
......
...@@ -19,15 +19,14 @@ module Gargantext.Database.Action.Node ...@@ -19,15 +19,14 @@ 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, HasConfig(..))
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
import Gargantext.Database.Admin.Types.Node import Gargantext.Database.Admin.Types.Node
import Gargantext.Database.Prelude (HasConfig(..), DBCmd') import Gargantext.Database.Prelude (DBCmd')
import Gargantext.Database.Query.Table.Node import Gargantext.Database.Query.Table.Node
import Gargantext.Database.Query.Table.Node.Error import Gargantext.Database.Query.Table.Node.Error
import Gargantext.Database.Query.Table.Node.UpdateOpaleye (updateHyperdata) import Gargantext.Database.Query.Table.Node.UpdateOpaleye (updateHyperdata)
...@@ -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
......
...@@ -18,9 +18,8 @@ module Gargantext.Database.GargDB ...@@ -18,9 +18,8 @@ module Gargantext.Database.GargDB
import Control.Lens (view) import Control.Lens (view)
import Data.Text qualified as Text import Data.Text qualified as Text
import Data.Tuple.Extra (both) import Data.Tuple.Extra (both)
import Gargantext.Database.Prelude (HasConfig(..)) import Gargantext.Core.Config ( gc_datafilepath, HasConfig(..) )
import Gargantext.Prelude hiding (hash) import Gargantext.Prelude hiding (hash)
import Gargantext.Core.Config ( gc_datafilepath )
import Gargantext.Prelude.Crypto.Hash ( IsHashable(hash) ) import Gargantext.Prelude.Crypto.Hash ( IsHashable(hash) )
import Prelude qualified import Prelude qualified
import System.Directory (createDirectoryIfMissing) import System.Directory (createDirectoryIfMissing)
......
...@@ -29,7 +29,7 @@ import Database.PostgreSQL.Simple.FromField ( Conversion, ResultError(Conversion ...@@ -29,7 +29,7 @@ import Database.PostgreSQL.Simple.FromField ( Conversion, ResultError(Conversion
import Database.PostgreSQL.Simple.Internal (Field) import Database.PostgreSQL.Simple.Internal (Field)
import Database.PostgreSQL.Simple.Types (Query(..)) import Database.PostgreSQL.Simple.Types (Query(..))
import Gargantext.Core.AsyncUpdates.CentralExchange.Types qualified as CET import Gargantext.Core.AsyncUpdates.CentralExchange.Types qualified as CET
import Gargantext.Core.Config (GargConfig) import Gargantext.Core.Config (HasConfig(..))
import Gargantext.Core.Mail.Types (HasMail) import Gargantext.Core.Mail.Types (HasMail)
import Gargantext.Core.NLP (HasNLPServer) import Gargantext.Core.NLP (HasNLPServer)
import Gargantext.Prelude import Gargantext.Prelude
...@@ -45,12 +45,6 @@ class HasConnectionPool env where ...@@ -45,12 +45,6 @@ class HasConnectionPool env where
instance HasConnectionPool (Pool Connection) where instance HasConnectionPool (Pool Connection) where
connPool = identity connPool = identity
class HasConfig env where
hasConfig :: Getter env GargConfig
instance HasConfig GargConfig where
hasConfig = identity
------------------------------------------------------- -------------------------------------------------------
type JSONB = DefaultFromField SqlJsonb type JSONB = DefaultFromField SqlJsonb
------------------------------------------------------- -------------------------------------------------------
......
{-# 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
...@@ -38,10 +35,9 @@ import Gargantext.API.Node.ShareURL qualified as Share ...@@ -38,10 +35,9 @@ import Gargantext.API.Node.ShareURL qualified as Share
import Gargantext.API.Routes.Named.Private import Gargantext.API.Routes.Named.Private
import Gargantext.API.Routes.Named.Share (ShareLink(..)) import Gargantext.API.Routes.Named.Share (ShareLink(..))
import Gargantext.API.ThrowAll (throwAllRoutes) import Gargantext.API.ThrowAll (throwAllRoutes)
import Gargantext.Core.Config (gc_frames, mkProxyUrl) import Gargantext.Core.Config (gc_frames, mkProxyUrl, hasConfig)
import Gargantext.Core.Config.Types (f_write_url) import Gargantext.Core.Config.Types (f_write_url)
import Gargantext.Database.Admin.Types.Node (NodeType(..), NodeId (..)) import Gargantext.Database.Admin.Types.Node (NodeType(..), NodeId (..))
import Gargantext.Database.Prelude (hasConfig)
import Gargantext.Prelude hiding (Handler) import Gargantext.Prelude hiding (Handler)
import Network.HTTP.ReverseProxy import Network.HTTP.ReverseProxy
import Network.HTTP.Types (hCacheControl, RequestHeaders, hReferer, ResponseHeaders, Header) import Network.HTTP.Types (hCacheControl, RequestHeaders, hReferer, ResponseHeaders, Header)
...@@ -158,10 +154,10 @@ type ProxyCache = InMemory.Cache FrameId NodeId ...@@ -158,10 +154,10 @@ 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 ^. env_jwt_settings
:. env ^. settings . cookieSettings :. env ^. settings . cookieSettings
:. EmptyContext :. EmptyContext
...@@ -212,10 +208,10 @@ notesProxyImplementation :: ProxyCache -> Env -> NotesProxy AsServer ...@@ -212,10 +208,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 +220,7 @@ notesProxyImplementation cache env = NotesProxy { ...@@ -224,7 +220,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 +232,7 @@ removeServiceFromPath sty = removeProxyPath (T.pack $ serviceTypeToProxyPath sty ...@@ -236,7 +232,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 +249,7 @@ publishProxyServer cache env frameId = Tagged $ \req res -> do ...@@ -253,7 +249,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 +260,14 @@ publishProxyServer cache env frameId = Tagged $ \req res -> do ...@@ -264,14 +260,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 +280,8 @@ mkProxyDestination env = fromMaybe (panicTrace "Invalid URI found in the proxied ...@@ -284,8 +280,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 +291,7 @@ removeFromReferer pth originalRequest = ...@@ -295,7 +291,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 +303,7 @@ notesForwardServer :: ProxyCache ...@@ -307,7 +303,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 +313,7 @@ notesForwardServer cache frameId mbNodeId sty presendModifyRequest env = ...@@ -317,7 +313,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 +322,7 @@ defaultForwardServerWithSettings :: ServiceType ...@@ -326,7 +322,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 +356,7 @@ defaultForwardServer sty presendModifyRequest mapRespHeaders env = ...@@ -360,7 +356,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 +378,7 @@ noCache hdrs = (hCacheControl, fromString "no-cache") : filter ((/=) hCacheContr ...@@ -382,7 +378,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"
......
...@@ -15,6 +15,7 @@ enabled = false ...@@ -15,6 +15,7 @@ enabled = false
[secrets] [secrets]
master_user = "gargantua" master_user = "gargantua"
secret_key = "test_key" secret_key = "test_key"
jwk_file = "test.jwk"
[paths] [paths]
data_filepath = "~/.garg" data_filepath = "~/.garg"
......
...@@ -11,7 +11,6 @@ Portability : POSIX ...@@ -11,7 +11,6 @@ Portability : POSIX
{-# OPTIONS_GHC -Wno-orphans #-} {-# OPTIONS_GHC -Wno-orphans #-}
{-# LANGUAGE QuasiQuotes #-}
module Test.API.Notifications ( module Test.API.Notifications (
tests tests
...@@ -28,11 +27,9 @@ import Gargantext.Core.Config.Types (NotificationsConfig(..)) ...@@ -28,11 +27,9 @@ import Gargantext.Core.Config.Types (NotificationsConfig(..))
import Network.WebSockets.Client qualified as WS import Network.WebSockets.Client qualified as WS
import Network.WebSockets.Connection qualified as WS import Network.WebSockets.Connection qualified as WS
import Prelude import Prelude
import System.Timeout qualified as Timeout
import Test.API.Setup (withTestDBAndPort) -- , setupEnvironment, createAliceAndBob) import Test.API.Setup (withTestDBAndPort) -- , setupEnvironment, createAliceAndBob)
import Test.Hspec import Test.Hspec
import Test.Instances () import Test.Instances ()
import Text.RawString.QQ (r)
tests :: NotificationsConfig -> Spec tests :: NotificationsConfig -> Spec
......
...@@ -13,18 +13,11 @@ import Data.Streaming.Network (bindPortTCP) ...@@ -13,18 +13,11 @@ 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.Config (_gc_secrets, gc_frontend_config, gc_jobs, hasConfig)
import Gargantext.Core.AsyncUpdates.Dispatcher qualified as D import Gargantext.Core.Config.Types (SettingsFile(..), jc_js_job_timeout, jc_js_id_timeout, fc_appPort, jwtSettings)
import Gargantext.Core.AsyncUpdates.Dispatcher.Types qualified as DT
import Gargantext.Core.Config
import Gargantext.Core.Config.Mail qualified as Mail
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.NodeStory import Gargantext.Core.NodeStory
import Gargantext.Core.Types.Individu import Gargantext.Core.Types.Individu
import Gargantext.Database.Action.Flow import Gargantext.Database.Action.Flow
...@@ -32,7 +25,7 @@ import Gargantext.Database.Action.User.New ...@@ -32,7 +25,7 @@ import Gargantext.Database.Action.User.New
import Gargantext.Database.Admin.Config (userMaster) import Gargantext.Database.Admin.Config (userMaster)
import Gargantext.Database.Admin.Trigger.Init import Gargantext.Database.Admin.Trigger.Init
import Gargantext.Database.Admin.Types.Hyperdata import Gargantext.Database.Admin.Types.Hyperdata
import Gargantext.Database.Prelude import Gargantext.Database.Prelude ()
import Gargantext.Database.Query.Table.Node (getOrMkList) import Gargantext.Database.Query.Table.Node (getOrMkList)
import Gargantext.Database.Query.Tree.Root (MkCorpusUser(..)) import Gargantext.Database.Query.Tree.Root (MkCorpusUser(..))
import Gargantext.MicroServices.ReverseProxy (microServicesProxyApp) import Gargantext.MicroServices.ReverseProxy (microServicesProxyApp)
...@@ -61,9 +54,9 @@ newTestEnv :: TestEnv -> Logger (GargM Env BackendInternalError) -> Warp.Port -> ...@@ -61,9 +54,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 let !settings' = devSettings
!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
...@@ -78,6 +71,7 @@ newTestEnv testEnv logger port = do ...@@ -78,6 +71,7 @@ newTestEnv testEnv logger port = do
& Jobs.l_jsJobTimeout .~ (fromIntegral $ config_env ^. hasConfig ^. gc_jobs . jc_js_job_timeout) & Jobs.l_jsJobTimeout .~ (fromIntegral $ config_env ^. hasConfig ^. gc_jobs . jc_js_job_timeout)
& Jobs.l_jsIDTimeout .~ (fromIntegral $ config_env ^. hasConfig ^. gc_jobs . jc_js_id_timeout) & Jobs.l_jsIDTimeout .~ (fromIntegral $ config_env ^. hasConfig ^. gc_jobs . jc_js_id_timeout)
!jobs_env <- Jobs.newJobEnv jobs_settings prios' manager_env !jobs_env <- Jobs.newJobEnv jobs_settings prios' manager_env
!_env_jwt_settings <- jwtSettings (_gc_secrets config_env)
-- !central_exchange <- forkIO CE.gServer -- !central_exchange <- forkIO CE.gServer
-- !dispatcher <- D.dispatcher -- !dispatcher <- D.dispatcher
...@@ -92,12 +86,11 @@ newTestEnv testEnv logger port = do ...@@ -92,12 +86,11 @@ newTestEnv testEnv logger port = do
, _env_jobs = jobs_env , _env_jobs = jobs_env
, _env_self_url = self_url_env , _env_self_url = self_url_env
, _env_config = config_env , _env_config = config_env
, _env_mail = _gc_mail_config config_env
, _env_nlp = nlpServerMap $ _gc_nlp_config config_env
, _env_central_exchange = Prelude.error "central exchange not needed, but forced somewhere (check StrictData)" , _env_central_exchange = Prelude.error "central exchange not needed, but forced somewhere (check StrictData)"
, _env_dispatcher = Prelude.error "dispatcher not needed, but forced somewhere (check StrictData)" , _env_dispatcher = Prelude.error "dispatcher not needed, but forced somewhere (check StrictData)"
-- , _env_central_exchange = central_exchange -- , _env_central_exchange = central_exchange
-- , _env_dispatcher = dispatcher -- , _env_dispatcher = dispatcher
, _env_jwt_settings
} }
-- | Run the gargantext server on a random port, picked by Warp, which allows -- | Run the gargantext server on a random port, picked by Warp, which allows
......
...@@ -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 let stgs = devSettings
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
......
...@@ -31,10 +31,11 @@ import Gargantext.API.Admin.Orchestrator.Types ...@@ -31,10 +31,11 @@ import Gargantext.API.Admin.Orchestrator.Types
import Gargantext.API.Admin.Types 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.Config (HasConfig(..))
import Gargantext.Core.Mail.Types (HasMail(..)) import Gargantext.Core.Mail.Types (HasMail(..))
import Gargantext.Core.NLP (HasNLPServer(..)) import Gargantext.Core.NLP (HasNLPServer(..))
import Gargantext.Core.NodeStory import Gargantext.Core.NodeStory
import Gargantext.Database.Prelude (HasConfig(..), HasConnectionPool(..)) import Gargantext.Database.Prelude (HasConnectionPool(..))
import Gargantext.Database.Query.Table.Node.Error import Gargantext.Database.Query.Table.Node.Error
import Gargantext.Core.Config import Gargantext.Core.Config
import Gargantext.Core.Config.Mail (MailConfig(..), LoginType(NoAuth)) import Gargantext.Core.Config.Mail (MailConfig(..), LoginType(NoAuth))
......
...@@ -28,8 +28,7 @@ import Network.HTTP.Types.Header (hAccept, hAuthorization, hContentType) ...@@ -28,8 +28,7 @@ import Network.HTTP.Types.Header (hAccept, hAuthorization, hContentType)
import Network.Wai.Handler.Warp (Port) import Network.Wai.Handler.Warp (Port)
import Network.Wai.Test (SResponse(..)) import Network.Wai.Test (SResponse(..))
import Prelude qualified import Prelude qualified
import Servant.Client (ClientEnv, baseUrlPort, defaultMakeClientRequest, makeClientRequest, mkClientEnv, parseBaseUrl, runClientM) import Servant.Client (ClientEnv, baseUrlPort, mkClientEnv, parseBaseUrl, runClientM)
import Servant.Client.Core.Request (addHeader)
import System.Timeout qualified as Timeout import System.Timeout qualified as Timeout
import Test.API.Routes (auth_api, mkUrl) import Test.API.Routes (auth_api, mkUrl)
import Test.Hspec.Expectations import Test.Hspec.Expectations
......
...@@ -303,8 +303,6 @@ newTestEnv = do ...@@ -303,8 +303,6 @@ newTestEnv = do
, _env_scrapers = Prelude.error "scrapers not needed, but forced somewhere (check StrictData)" , _env_scrapers = Prelude.error "scrapers not needed, but forced somewhere (check StrictData)"
, _env_jobs = myEnv , _env_jobs = myEnv
, _env_config , _env_config
, _env_mail = Prelude.error "mail not needed, but forced somewhere (check StrictData)"
, _env_nlp = Prelude.error "nlp not needed, but forced somewhere (check StrictData)"
, _env_central_exchange = Prelude.error "central exchange not needed, but forced somewhere (check StrictData)" , _env_central_exchange = Prelude.error "central exchange not needed, but forced somewhere (check StrictData)"
, _env_dispatcher = Prelude.error "dispatcher not needed, but forced somewhere (check StrictData)" , _env_dispatcher = Prelude.error "dispatcher not needed, but forced somewhere (check StrictData)"
} }
......
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