[toml] rewrite config to a toml file

parent d6c03dc3
......@@ -34,6 +34,7 @@ _darcs
*.pdf
*.sql
*.ini
*.toml
!test-data/test_config.ini
# Runtime
......
......@@ -19,8 +19,8 @@ import Options.Applicative
import Prelude (String)
adminCLI :: AdminArgs -> IO ()
adminCLI (AdminArgs iniPath settingsPath mails) = do
withDevEnv iniPath settingsPath $ \env -> do
adminCLI (AdminArgs settingsPath mails) = do
withDevEnv settingsPath $ \env -> do
x <- runCmdDev env ((newUsers $ NE.map cs (NE.fromList mails)) :: Cmd'' DevEnv BackendInternalError (NonEmpty UserId))
putStrLn (show x :: Text)
......@@ -29,7 +29,7 @@ adminCmd = command "admin" (info (helper <*> fmap CLISub admin_p) (progDesc "Cre
admin_p :: Parser CLICmd
admin_p = fmap CCMD_admin $ AdminArgs
<$> ini_p <*> settings_p
<$> settings_p
<*> ( option (maybeReader emails_p) ( long "emails"
<> metavar "email1,email2,..."
<> help "A comma-separated list of emails."
......
......@@ -40,7 +40,7 @@ import qualified Data.Text as T
importCLI :: ImportArgs -> IO ()
importCLI (ImportArgs fun user name iniPath settingsPath limit corpusPath) = do
importCLI (ImportArgs fun user name settingsPath limit corpusPath) = do
let
tt = Multi EN
format = TsvGargV3
......@@ -54,7 +54,7 @@ importCLI (ImportArgs fun user name iniPath settingsPath limit corpusPath) = do
annuaire :: forall m. (FlowCmdM DevEnv BackendInternalError m, MonadJobStatus m, JobHandle m ~ DevJobHandle) => m CorpusId
annuaire = flowAnnuaire (MkCorpusUserNormalCorpusName (UserName $ cs user) "Annuaire") (Multi EN) corpusPath DevJobHandle
withDevEnv iniPath settingsPath $ \env -> do
withDevEnv settingsPath $ \env -> do
void $ case fun of
IF_corpus
-> runCmdGargDev env corpus
......@@ -76,7 +76,6 @@ import_p = fmap CCMD_import $ ImportArgs
) )
<*> ( option str ( long "user") )
<*> ( option str ( long "name") )
<*> ini_p
<*> settings_p
<*> (fmap Limit ( option auto ( long "limit" <> metavar "INT" <> help "The limit for the query") ))
<*> ( option str ( long "corpus-path" <> help "Path to corpus file") )
......
......@@ -23,7 +23,8 @@ import Gargantext.API.Admin.Types
import Gargantext.API.Dev (withDevEnv, runCmdDev)
import Gargantext.API.Errors.Types
import Gargantext.API.Node () -- instances only
import Gargantext.Core.Config (GargConfig(..), readConfig)
import Gargantext.Core.Config (GargConfig(..))
import Gargantext.Core.Config.Utils (readConfig)
import Gargantext.Core.Types.Individu (User(..), arbitraryNewUsers, NewUser(..), arbitraryUsername, GargPassword(..))
import Gargantext.Database.Action.Flow (getOrMkRoot, getOrMkRootWithCorpus)
import Gargantext.Database.Admin.Trigger.Init (initFirstTriggers, initLastTriggers)
......@@ -39,14 +40,14 @@ import Options.Applicative
initCLI :: InitArgs -> IO ()
initCLI (InitArgs iniPath settingsPath) = do
initCLI (InitArgs settingsPath) = do
putStrLn ("Enter master user (gargantua) _password_ :" :: Text)
password <- getLine
putStrLn ("Enter master user (gargantua) _email_ :" :: Text)
email <- getLine
cfg <- readConfig (_IniFile iniPath)
cfg <- readConfig settingsPath
let secret = _gc_secretkey cfg
let createUsers :: forall env. HasSettings env => DBCmd' env BackendInternalError Int64
......@@ -69,7 +70,7 @@ initCLI (InitArgs iniPath settingsPath) = do
_triggers <- initLastTriggers masterListId
pure (masterUserId, masterRootId, masterCorpusId, masterListId)
withDevEnv iniPath settingsPath $ \env -> do
withDevEnv settingsPath $ \env -> do
_ <- runCmdDev env (initFirstTriggers secret :: DBCmd BackendInternalError [Int64])
_ <- runCmdDev env createUsers
x <- runCmdDev env initMaster
......@@ -81,4 +82,4 @@ initCmd = command "init" (info (helper <*> fmap CLISub init_p) (progDesc "Initia
init_p :: Parser CLICmd
init_p = fmap CCMD_init $ InitArgs
<$> ini_p <*> settings_p
<$> settings_p
......@@ -23,7 +23,7 @@ import Gargantext.API.Errors.Types
import Gargantext.API.Node () -- instances only
import Gargantext.API.Node.Share qualified as Share
import Gargantext.API.Node.Share.Types qualified as Share
import Gargantext.Core.Config (readConfig)
import Gargantext.Core.Config.Utils (readConfig)
import Gargantext.Core.NLP (HasNLPServer)
import Gargantext.Core.Types
import Gargantext.Core.Types.Individu (User(..))
......@@ -33,13 +33,13 @@ import Options.Applicative
import Prelude (String)
invitationsCLI :: InvitationsArgs -> IO ()
invitationsCLI (InvitationsArgs iniPath settingsPath user node_id email) = do
_cfg <- readConfig (_IniFile iniPath)
invitationsCLI (InvitationsArgs settingsPath user node_id email) = do
-- _cfg <- readConfig settingsPath
let invite :: (HasSettings env, CmdRandom env BackendInternalError m, HasNLPServer env) => m Int
invite = Share.api (UserName $ cs user) node_id (Share.ShareTeamParams $ cs email)
withDevEnv iniPath settingsPath $ \env -> do
withDevEnv settingsPath $ \env -> do
void $ runCmdDev env invite
invitationsCmd :: HasCallStack => Mod CommandFields CLI
......@@ -47,8 +47,7 @@ invitationsCmd = command "invitations" (info (helper <*> fmap CLISub invitations
invitations_p :: Parser CLICmd
invitations_p = fmap CCMD_invitations $ InvitationsArgs
<$> ini_p
<*> settings_p
<$> settings_p
<*> ( strOption ( long "user" ) )
<*> ( option (eitherReader node_p) ( long "node-id" <> metavar "POSITIVE-INT" <> help "The node ID.") )
<*> ( strOption ( long "email" <> help "The email address.") )
......
......@@ -5,15 +5,9 @@ module CLI.Parsers where
import Prelude
import Gargantext.API.Admin.Settings
import Gargantext.Core.Config.Types (SettingsFile(..))
import Options.Applicative
ini_p :: Parser IniFile
ini_p = maybe (IniFile "gargantext.ini") IniFile <$>
optional ( strOption ( long "ini-path"
<> metavar "FILEPATH"
<> help "Location of the .ini file"
) )
settings_p :: Parser SettingsFile
settings_p = maybe (SettingsFile "gargantext-settings.toml") SettingsFile <$>
optional ( strOption ( long "settings-path"
......
......@@ -4,6 +4,7 @@ module CLI.Types where
import Data.String
import Data.Text (Text)
import Gargantext.API.Admin.Settings
import Gargantext.Core.Config.Types (SettingsFile(..))
import Gargantext.Core.Types (NodeId)
import Gargantext.Core.Types.Query
import Prelude
......@@ -26,8 +27,7 @@ data ObfuscateDBArgs = ObfuscateDBArgs {
} deriving (Show, Eq)
data AdminArgs = AdminArgs
{ iniPath :: !IniFile
, settingsPath :: !SettingsFile
{ settingsPath :: !SettingsFile
, emails :: [String]
} deriving (Show, Eq)
......@@ -41,20 +41,17 @@ data ImportArgs = ImportArgs
{ imp_function :: !ImportFunction
, imp_user :: !Text
, imp_name :: !Text
, imp_ini :: !IniFile
, imp_settings :: !SettingsFile
, imp_limit :: !Limit
, imp_corpus_path :: !FilePath
} deriving (Show, Eq)
data InitArgs = InitArgs
{ init_ini :: !IniFile
, init_settings :: !SettingsFile
{ init_settings :: !SettingsFile
} deriving (Show, Eq)
data InvitationsArgs = InvitationsArgs
{ inv_path :: !IniFile
, inv_settings :: !SettingsFile
{ inv_settings :: !SettingsFile
, inv_user :: !Text
, inv_node_id :: !NodeId
, inv_email :: !Text
......@@ -65,8 +62,7 @@ data PhyloArgs = PhyloArgs
} deriving (Show, Eq)
data UpgradeArgs = UpgradeArgs
{ upgrade_ini :: !IniFile
, upgrade_settings :: !SettingsFile
{ upgrade_settings :: !SettingsFile
} deriving (Show, Eq)
data GoldenFileDiffArgs = GoldenFileDiffArgs
......
......@@ -22,13 +22,14 @@ import Data.List qualified as List (cycle, concat, take, unlines)
import Gargantext.API.Admin.Settings
import Gargantext.API.Dev (withDevEnv)
import Gargantext.API.Node () -- instances only
import Gargantext.Core.Config (GargConfig(..), readConfig)
import Gargantext.Core.Config (GargConfig(..))
import Gargantext.Core.Config.Utils (readConfig)
import Gargantext.Prelude
import Options.Applicative
import Prelude qualified
upgradeCLI :: UpgradeArgs -> IO ()
upgradeCLI (UpgradeArgs iniPath settingsFile) = do
upgradeCLI (UpgradeArgs settingsFile) = do
let ___ = putStrLn ((List.concat
$ List.take 72
......@@ -47,10 +48,10 @@ upgradeCLI (UpgradeArgs iniPath settingsFile) = do
_ok <- getLine
cfg <- readConfig (_IniFile iniPath)
cfg <- readConfig settingsFile
let _secret = _gc_secretkey cfg
withDevEnv iniPath settingsFile $ \_env -> do
withDevEnv settingsFile $ \_env -> do
-- _ <- runCmdDev env addIndex
-- _ <- runCmdDev env refreshIndex
......@@ -97,5 +98,4 @@ upgradeCmd = command "upgrade" (info (helper <*> fmap CLISub upgrade_p) (progDes
upgrade_p :: Parser CLICmd
upgrade_p = fmap CCMD_upgrade $ UpgradeArgs
<$> ini_p
<*> settings_p
<$> settings_p
......@@ -15,7 +15,7 @@ Script to start gargantext with different modes (Dev, Prod, Mock).
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE Strict #-}
{-# LANGUAGE TypeOperators #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
-- {-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE TypeFamilies #-}
......@@ -28,10 +28,10 @@ import GHC.IO.Encoding
import Gargantext.API (startGargantext) -- , startGargantextMock)
import Gargantext.API.Admin.EnvTypes
import Gargantext.API.Admin.Settings
import Gargantext.Core.Config.Types (SettingsFile(..))
import Gargantext.Prelude
import Gargantext.System.Logging
import Options.Generic
import Prelude (String)
import System.Exit (exitSuccess)
import qualified Paths_gargantext as PG -- cabal magic build module
......@@ -45,9 +45,7 @@ data MyOptions w =
<?> "Possible modes: Dev | Mock | Prod"
, port :: w ::: Maybe Int
<?> "By default: 8008"
, ini :: w ::: Maybe Text
<?> "Ini-file path of gargantext.ini"
, settings :: w ::: Maybe String
, toml :: w ::: Maybe FilePath
<?> "By default: gargantext-settings.toml"
, version :: w ::: Bool
<?> "Show version number and exit"
......@@ -64,7 +62,7 @@ main = withLogger () $ \ioLogger -> do
setLocaleEncoding utf8
currentLocale <- getLocaleEncoding
MyOptions myMode myPort myIniFile mb_settingsFile myVersion <- unwrapRecord
MyOptions myMode myPort mb_tomlFile myVersion <- unwrapRecord
"Gargantext server"
---------------------------------------------------------------
if myVersion then do
......@@ -77,18 +75,14 @@ main = withLogger () $ \ioLogger -> do
Just p -> p
Nothing -> 8008
myIniFile' = case myIniFile of
Nothing -> panicTrace "[ERROR] gargantext.ini needed"
Just i -> IniFile $ unpack i
settingsFile = SettingsFile $ case mb_settingsFile of
tomlFile = SettingsFile $ case mb_tomlFile of
Nothing -> "gargantext-settings.toml"
Just i -> i
---------------------------------------------------------------
let start = case myMode of
Mock -> panicTrace "[ERROR] Mock mode unsupported"
_ -> startGargantext myMode myPort' myIniFile' settingsFile
_ -> startGargantext myMode myPort' tomlFile
logMsg ioLogger INFO $ "Starting with " <> show myMode <> " mode."
logMsg ioLogger INFO $ "Machine locale: " <> show currentLocale
start
......
......@@ -18,8 +18,8 @@ fi
# with the `sha256sum` result calculated on the `cabal.project` and
# `cabal.project.freeze`. This ensures the files stay deterministic so that CI
# cache can kick in.
expected_cabal_project_hash="66d93bf833eaa39e8f06c3f3c79d87ad9418438b959a79ab5fc11551d67015a3"
expected_cabal_project_freeze_hash="05ee74fc30b25edf135f4f9c53a2c134752184545b7a9e837f27e36d507a7a80"
expected_cabal_project_hash="72e706e2a48ab404346b7edae38b04207e31821416f56328d324f743e7a5756a"
expected_cabal_project_freeze_hash="d51d800b35946a4d51c75aab21e3b54fde500f54e4a1565a4d21d71aaae34bef"
cabal --store-dir=$STORE_DIR v2-build --dry-run
cabal2stack --system-ghc --allow-newer --resolver lts-21.17 --resolver-file devops/stack/lts-21.17.yaml -o stack.yaml
......
......@@ -175,6 +175,11 @@ source-repository-package
location: https://github.com/fpringle/servant-routes.git
tag: 7694f62af6bc1596d754b42af16da131ac403b3a
source-repository-package
type: git
location: https://github.com/glguy/toml-parser
tag: toml-parser-2.0.1.0
allow-older: *
allow-newer: *
......
......@@ -479,7 +479,6 @@ constraints: any.Cabal ==3.8.1.0,
any.scientific ==0.3.7.0,
scientific -bytestring-builder -integer-simple,
any.securemem ==0.1.10,
any.selective ==0.7,
any.semialign ==1.3,
semialign +semigroupoids,
any.semigroupoids ==5.3.7,
......@@ -602,8 +601,7 @@ constraints: any.Cabal ==3.8.1.0,
any.tls ==1.6.0,
tls +compat -hans +network,
any.tmp-postgres ==1.34.1.0,
any.tomland ==1.3.3.2,
tomland -build-play-tomland -build-readme,
any.toml-parser ==2.0.1.0,
any.transformers ==0.5.6.2,
any.transformers-base ==0.4.6,
transformers-base +orphaninstances,
......@@ -639,7 +637,6 @@ constraints: any.Cabal ==3.8.1.0,
any.utility-ht ==0.0.17,
any.uuid ==1.3.15,
any.uuid-types ==1.0.5.1,
any.validation-selective ==0.2.0.0,
any.validity ==0.12.0.2,
any.vault ==0.3.1.5,
vault +useghc,
......
[cors]
allowed-origins = [
"https://demo.gargantext.org"
, "https://formation.gargantext.org"
, "https://academia.sub.gargantext.org"
, "https://cnrs.gargantext.org"
, "https://imt.sub.gargantext.org"
, "https://helloword.gargantext.org"
, "https://complexsystems.gargantext.org"
, "https://europa.gargantext.org"
, "https://earth.sub.gargantext.org"
, "https://health.sub.gargantext.org"
, "https://msh.sub.gargantext.org"
, "https://dev.sub.gargantext.org"
, "http://localhost:8008"
, "http://localhost:3000"
]
use-origins-for-hosts = true
[microservices.proxy]
port = 8009
enabled = false
......@@ -107,9 +107,6 @@ library
Gargantext.API.Admin.EnvTypes
Gargantext.API.Admin.Orchestrator.Types
Gargantext.API.Admin.Settings
Gargantext.API.Admin.Settings.CORS
Gargantext.API.Admin.Settings.MicroServices
Gargantext.API.Admin.Settings.TOML
Gargantext.API.Admin.Types
Gargantext.API.Auth.PolicyCheck
Gargantext.API.Count.Types
......@@ -166,8 +163,14 @@ library
Gargantext.API.Viz.Types
Gargantext.Core
Gargantext.Core.Config
Gargantext.Core.Config.CORS
Gargantext.Core.Config.Database
Gargantext.Core.Config.Frontend
Gargantext.Core.Config.Mail
Gargantext.Core.Config.MicroServices
Gargantext.Core.Config.NLP
Gargantext.Core.Config.Types
Gargantext.Core.Config.Utils
Gargantext.Core.Mail.Types
Gargantext.Core.Methods.Similarities
Gargantext.Core.Methods.Similarities.Conditional
......@@ -679,7 +682,7 @@ library
, transformers ^>= 0.5.6.2
, transformers-base ^>= 0.4.6
, tree-diff
, tomland >= 1.3.3.2
, toml-parser >= 2.0.1.0 && < 3
, tuple ^>= 0.3.0.2
, unordered-containers ^>= 0.2.16.0
, unicode-collation >= 0.1.3.6
......
......@@ -46,15 +46,16 @@ import Data.Text.IO (putStrLn)
import Data.Validity
import Gargantext.API.Admin.Auth.Types (AuthContext)
import Gargantext.API.Admin.EnvTypes (Env, Mode(..))
import Gargantext.API.Admin.Settings (newEnv, IniFile(..), SettingsFile)
import Gargantext.API.Admin.Settings.CORS
import Gargantext.API.Admin.Settings.MicroServices
import Gargantext.API.Admin.Settings (newEnv)
import Gargantext.API.Admin.Types (FireWall(..), PortNumber, cookieSettings, jwtSettings, settings, corsSettings, microservicesSettings)
import Gargantext.API.Middleware (logStdoutDevSanitised)
import Gargantext.API.Routes.Named (API)
import Gargantext.API.Routes.Named.EKG
import Gargantext.API.Server.Named (server)
import Gargantext.API.Server.Named.EKG
import Gargantext.Core.Config.CORS
import Gargantext.Core.Config.MicroServices
import Gargantext.Core.Config.Types (SettingsFile(..))
import Gargantext.Database.Prelude qualified as DB
import Gargantext.MicroServices.ReverseProxy (microServicesProxyApp)
import Gargantext.Prelude hiding (putStrLn)
......@@ -72,9 +73,9 @@ import System.Cron.Schedule qualified as Cron
import System.FilePath
-- | startGargantext takes as parameters port number and Ini file.
startGargantext :: Mode -> PortNumber -> IniFile -> SettingsFile -> IO ()
startGargantext mode port iniFile settingsFile = withLoggerHoisted mode $ \logger -> do
env <- newEnv logger port iniFile settingsFile
startGargantext :: Mode -> PortNumber -> SettingsFile -> IO ()
startGargantext mode port sf@(SettingsFile settingsFile) = withLoggerHoisted mode $ \logger -> do
env <- newEnv logger port sf
let proxyPort = env ^. settings.microservicesSettings.msProxyPort
runDbCheck env
portRouteInfo port proxyPort
......@@ -94,7 +95,7 @@ startGargantext mode port iniFile settingsFile = withLoggerHoisted mode $ \logge
case r of
Right True -> pure ()
_ -> panicTrace $
"You must run 'gargantext-init " <> pack (_IniFile iniFile) <>
"You must run 'gargantext-init " <> pack settingsFile <>
"' before running gargantext-server (only the first time)."
oneHour = Clock.fromNanoSecs 3600_000_000_000
......
......@@ -25,19 +25,20 @@ import Control.Monad.Logger (LogLevel(..))
import Control.Monad.Reader
import Data.ByteString.Lazy qualified as L
import Data.Pool (Pool)
import Data.Pool qualified as Pool
import Database.PostgreSQL.Simple (Connection, connect, close, ConnectInfo)
import Gargantext.API.Admin.EnvTypes
import Gargantext.API.Admin.Settings.TOML (GargTomlSettings(..), loadGargTomlSettings)
import Gargantext.API.Admin.Types
import Gargantext.API.Errors.Types
import Gargantext.API.Prelude
import Gargantext.Core.Config (GargConfig(..), gc_js_job_timeout, gc_js_id_timeout)
import Gargantext.Core.Config.Frontend qualified as Frontend
import Gargantext.Core.Config.Types (SettingsFile(..))
import Gargantext.Core.Config.Utils (readConfig)
import Gargantext.Core.NLP (nlpServerMap)
import Gargantext.Core.NodeStory
import Gargantext.Database.Prelude (databaseParameters, hasConfig)
import Gargantext.Database.Prelude (hasConfig)
import Gargantext.Prelude
import Gargantext.Core.Config (gc_js_job_timeout, gc_js_id_timeout, readConfig)
import Gargantext.Core.Config.Mail qualified as Mail
import Gargantext.Core.Config.NLP qualified as NLP
import Gargantext.System.Logging
import Gargantext.Utils.Jobs qualified as Jobs
import Gargantext.Utils.Jobs.Monad qualified as Jobs
......@@ -50,26 +51,26 @@ import Servant.Job.Async (newJobEnv, defaultSettings)
import System.Directory
import System.IO (hClose)
import System.IO.Temp (withTempFile)
import qualified Data.Pool as Pool
newtype JwkFile = JwkFile { _JwkFile :: FilePath }
deriving (Show, Eq, IsString)
newtype SettingsFile = SettingsFile { _SettingsFile :: FilePath }
newtype JwkFile = JwkFile { _JwkFile :: FilePath }
deriving (Show, Eq, IsString)
newtype IniFile = IniFile { _IniFile :: FilePath }
deriving (Show, Eq, IsString)
devSettings :: JwkFile -> SettingsFile -> IO Settings
devSettings (JwkFile jwkFile) (SettingsFile settingsFile) = do
devSettings (JwkFile jwkFile) settingsFile = do
jwkExists <- doesFileExist jwkFile
when (not jwkExists) $ writeKey jwkFile
jwk <- readKey jwkFile
GargTomlSettings{..} <- loadGargTomlSettings settingsFile
-- GargTomlSettings{..} <- loadGargTomlSettings settingsFile
gc@(GargConfig {}) <- readConfig settingsFile
pure $ Settings
{ _corsSettings = _gargCorsSettings
, _microservicesSettings = _gargMicroServicesSettings
{ -- _corsSettings = _gargCorsSettings
_corsSettings = Frontend._fc_cors $ _gc_frontend_config gc
-- , _microservicesSettings = _gargMicroServicesSettings
, _microservicesSettings = Frontend._fc_microservices $ _gc_frontend_config gc
, _appPort = 3000
, _logLevelLimit = LevelDebug
-- , _dbServer = "localhost"
......@@ -183,22 +184,20 @@ readRepoEnv repoDir = do
devJwkFile :: JwkFile
devJwkFile = JwkFile "dev.jwk"
newEnv :: Logger (GargM Env BackendInternalError) -> PortNumber -> IniFile -> SettingsFile -> IO Env
newEnv logger port (IniFile file) settingsFile = do
newEnv :: Logger (GargM Env BackendInternalError) -> PortNumber -> SettingsFile -> IO Env
newEnv logger port settingsFile@(SettingsFile sf) = do
!manager_env <- newTlsManager
!settings' <- devSettings devJwkFile settingsFile <&> appPort .~ port -- TODO read from 'file'
when (port /= settings' ^. appPort) $
panicTrace "TODO: conflicting settings of port"
!config_env <- readConfig file
prios <- withLogger () $ \ioLogger -> Jobs.readPrios ioLogger (file <> ".jobs")
!config_env <- readConfig settingsFile
prios <- withLogger () $ \ioLogger -> Jobs.readPrios ioLogger (sf <> ".jobs")
let prios' = Jobs.applyPrios prios Jobs.defaultPrios
putStrLn ("Overrides: " <> show prios :: Text)
putStrLn ("New priorities: " <> show prios' :: Text)
!self_url_env <- parseBaseUrl $ "http://0.0.0.0:" <> show port
dbParam <- databaseParameters file
!pool <- newPool dbParam
--nodeStory_env <- fromDBNodeStoryEnv (_gc_repofilepath config_env)
!pool <- newPool $ _gc_database_config config_env
!nodeStory_env <- fromDBNodeStoryEnv pool
!scrapers_env <- newJobEnv defaultSettings manager_env
......@@ -207,8 +206,6 @@ newEnv logger port (IniFile file) settingsFile = do
& Jobs.l_jsJobTimeout .~ (fromIntegral $ config_env ^. hasConfig ^. gc_js_job_timeout)
& Jobs.l_jsIDTimeout .~ (fromIntegral $ config_env ^. hasConfig ^. gc_js_id_timeout)
!jobs_env <- Jobs.newJobEnv jobs_settings prios' manager_env
!config_mail <- Mail.readConfig file
!nlp_env <- nlpServerMap <$> NLP.readConfig file
{- 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.
......@@ -223,8 +220,8 @@ newEnv logger port (IniFile file) settingsFile = do
, _env_jobs = jobs_env
, _env_self_url = self_url_env
, _env_config = config_env
, _env_mail = config_mail
, _env_nlp = nlp_env
, _env_mail = _gc_mail_config config_env
, _env_nlp = nlpServerMap $ _gc_nlp_config config_env
}
newPool :: ConnectInfo -> IO (Pool Connection)
......
{-# LANGUAGE TemplateHaskell #-}
module Gargantext.API.Admin.Settings.TOML where
import Control.Lens hiding ((.=))
import Data.Text qualified as T
import Gargantext.API.Admin.Settings.CORS
import Gargantext.API.Admin.Settings.MicroServices
import Gargantext.Prelude (panicTrace)
import Gargantext.System.Logging
import Prelude
import Toml
import Servant.Client.Core.BaseUrl
-- | Compatibility bridge until we fix #304 (move to Toml)
data GargTomlSettings = GargTomlSettings
{ _gargCorsSettings :: !CORSSettings
, _gargMicroServicesSettings :: !MicroServicesSettings
}
makeLenses ''GargTomlSettings
settingsCodec :: TomlCodec GargTomlSettings
settingsCodec = GargTomlSettings
<$> (Toml.table corsSettingsCodec "cors" .= _gargCorsSettings)
<*> (Toml.table microServicesSettingsCodec "microservices.proxy" .= _gargMicroServicesSettings)
-- | Extends the 'allowed-origins' in the CORSettings with the URLs embellished
-- with the proxy port.
addProxyToAllowedOrigins :: GargTomlSettings -> GargTomlSettings
addProxyToAllowedOrigins stgs =
stgs & over gargCorsSettings (addProxies $ stgs ^. gargMicroServicesSettings . msProxyPort)
where
addProxies :: Int -> CORSSettings -> CORSSettings
addProxies port cors =
let origins = _corsAllowedOrigins cors
mkUrl (CORSOrigin bh) = CORSOrigin $ bh { baseUrlPort = port }
in cors { _corsAllowedOrigins = origins <> Prelude.map mkUrl origins }
-- | Loads the 'CORSSettings' from the 'toml' file.
loadGargTomlSettings :: FilePath -> IO GargTomlSettings
loadGargTomlSettings tomlFile = do
tomlRes <- Toml.decodeFileEither settingsCodec tomlFile
case tomlRes of
Left errs -> do
withLogger () $ \ioLogger -> do
logMsg ioLogger ERROR $ T.unpack $ "Error, gargantext-settings.toml parsing failed: " <> Toml.prettyTomlDecodeErrors errs
panicTrace "Please fix the errors in your gargantext-settings.toml file."
Right settings0 -> case settings0 ^. gargCorsSettings . corsUseOriginsForHosts of
True -> pure $ addProxyToAllowedOrigins $
settings0 & over (gargCorsSettings . corsAllowedHosts)
(\_ -> (settings0 ^. gargCorsSettings . corsAllowedOrigins))
False -> pure $ addProxyToAllowedOrigins settings0
......@@ -5,11 +5,11 @@ module Gargantext.API.Admin.Types where
import Control.Lens
import Control.Monad.Logger (LogLevel)
import GHC.Enum
import Gargantext.API.Admin.Settings.CORS
import Gargantext.Core.Config.CORS
import Gargantext.Core.Config.MicroServices
import Gargantext.Prelude
import Servant.Auth.Server (JWTSettings, CookieSettings(..))
import Servant.Client (BaseUrl)
import Gargantext.API.Admin.Settings.MicroServices
type PortNumber = Int
......
......@@ -17,54 +17,48 @@ import Control.Monad (fail)
import Data.Pool (withResource)
import Database.PostgreSQL.Simple qualified as PGS
import Gargantext.API.Admin.EnvTypes ( DevEnv(..), Mode(Dev) )
import Gargantext.API.Admin.Settings ( devJwkFile, devSettings, newPool, SettingsFile (..), IniFile (..) )
import Gargantext.API.Admin.Settings ( devJwkFile, devSettings, newPool )
import Gargantext.API.Errors.Types ( BackendInternalError )
import Gargantext.API.Prelude ( GargM )
import Gargantext.Core.Config (_gc_database_config, _gc_mail_config, _gc_nlp_config)
import Gargantext.Core.Config.Types (SettingsFile(..))
import Gargantext.Core.NLP (nlpServerMap)
import Gargantext.Core.NodeStory (fromDBNodeStoryEnv)
import Gargantext.Database.Prelude (Cmd', Cmd'', connPool, databaseParameters, runCmd)
import Gargantext.Database.Prelude (Cmd', Cmd'', connPool, runCmd)
import Gargantext.Prelude
import Gargantext.Core.Config (readConfig)
import Gargantext.Core.Config.Mail qualified as Mail
import Gargantext.Core.Config.NLP qualified as NLP
import Gargantext.Core.Config.Utils (readConfig)
import Gargantext.System.Logging ( withLoggerHoisted )
import Servant ( ServerError )
-------------------------------------------------------------------
withDevEnv :: IniFile -> SettingsFile -> (DevEnv -> IO a) -> IO a
withDevEnv (IniFile iniPath) settingsFile k = withLoggerHoisted Dev $ \logger -> do
withDevEnv :: SettingsFile -> (DevEnv -> IO a) -> IO a
withDevEnv settingsFile k = withLoggerHoisted Dev $ \logger -> do
env <- newDevEnv logger
k env -- `finally` cleanEnv env
where
newDevEnv logger = do
cfg <- readConfig iniPath
dbParam <- databaseParameters iniPath
cfg <- readConfig settingsFile
--nodeStory_env <- fromDBNodeStoryEnv (_gc_repofilepath cfg)
pool <- newPool dbParam
pool <- newPool (_gc_database_config cfg)
nodeStory_env <- fromDBNodeStoryEnv pool
setts <- devSettings devJwkFile settingsFile
mail <- Mail.readConfig iniPath
nlp_config <- NLP.readConfig iniPath
pure $ DevEnv
{ _dev_env_pool = pool
, _dev_env_logger = logger
, _dev_env_nodeStory = nodeStory_env
, _dev_env_settings = setts
, _dev_env_config = cfg
, _dev_env_mail = mail
, _dev_env_nlp = nlpServerMap nlp_config
, _dev_env_mail = _gc_mail_config cfg
, _dev_env_nlp = nlpServerMap (_gc_nlp_config cfg)
}
defaultIniFile :: IniFile
defaultIniFile = IniFile "gargantext.ini"
defaultSettingsFile :: SettingsFile
defaultSettingsFile = SettingsFile "gargantext-settings.toml"
-- | Run Cmd Sugar for the Repl (GHCI)
runCmdRepl :: Show err => Cmd'' DevEnv err a -> IO a
runCmdRepl f = withDevEnv defaultIniFile defaultSettingsFile $ \env -> runCmdDev env f
runCmdRepl f = withDevEnv defaultSettingsFile $ \env -> runCmdDev env f
runCmdReplServantErr :: Cmd'' DevEnv ServerError a -> IO a
runCmdReplServantErr = runCmdRepl
......@@ -88,7 +82,7 @@ runCmdDevServantErr :: DevEnv -> Cmd' DevEnv ServerError a -> IO a
runCmdDevServantErr = runCmdDev
runCmdReplEasy :: Cmd'' DevEnv BackendInternalError a -> IO a
runCmdReplEasy f = withDevEnv defaultIniFile defaultSettingsFile $ \env -> runCmdDev env f
runCmdReplEasy f = withDevEnv defaultSettingsFile $ \env -> runCmdDev env f
-- | Execute a function that takes PSQL.Connection from the DB pool as
-- first parameter.
......
......@@ -32,27 +32,32 @@ module Gargantext.Core.Config (
, gc_max_docs_parsers
, gc_max_docs_scrapers
, gc_pubmed_api_key
, gc_repofilepath
, gc_secretkey
, gc_url
, gc_url_backend_api
, gc_frontend_config
, gc_mail_config
, gc_database_config
, gc_nlp_config
-- * Utility functions
, readIniFile'
, readConfig
, val
, mkProxyUrl
) where
import Data.Ini (readIniFile, lookupValue, Ini)
import Data.Text as T
import Prelude (read)
import Database.PostgreSQL.Simple qualified as PSQL
import Gargantext.Core.Config.Database (TOMLConnectInfo(..))
import Gargantext.Core.Config.Frontend (FrontendConfig(..))
import Gargantext.Core.Config.Mail (MailConfig)
import Gargantext.Core.Config.MicroServices (MicroServicesSettings(..))
import Gargantext.Core.Config.NLP (NLPConfig)
import Gargantext.Prelude
import Servant.Client (BaseUrl(..), Scheme(Http), parseBaseUrl)
import Toml.Schema
-- | strip a given character from end of string
stripRight :: Char -> T.Text -> T.Text
stripRight c s = if T.last s == c then stripRight c (T.take (T.length s - 1) s) else s
-- stripRight :: Char -> T.Text -> T.Text
-- stripRight c s = if T.last s == c then stripRight c (T.take (T.length s - 1) s) else s
data GargConfig = GargConfig { _gc_backend_name :: !T.Text
, _gc_url :: !T.Text
......@@ -62,7 +67,7 @@ data GargConfig = GargConfig { _gc_backend_name :: !T.Text
, _gc_secretkey :: !T.Text
, _gc_datafilepath :: !FilePath
, _gc_repofilepath :: !FilePath
-- , _gc_repofilepath :: !FilePath
, _gc_frame_write_url :: !T.Text
, _gc_frame_calc_url :: !T.Text
......@@ -74,53 +79,97 @@ data GargConfig = GargConfig { _gc_backend_name :: !T.Text
, _gc_max_docs_parsers :: !Integer
, _gc_max_docs_scrapers :: !Integer
, _gc_pubmed_api_key :: !T.Text
, _gc_js_job_timeout :: !Integer
, _gc_js_id_timeout :: !Integer
, _gc_pubmed_api_key :: !T.Text
, _gc_epo_api_url :: !T.Text
, _gc_frontend_config :: !FrontendConfig
, _gc_mail_config :: !MailConfig
, _gc_database_config :: !PSQL.ConnectInfo
, _gc_nlp_config :: !NLPConfig
}
deriving (Generic, Show)
makeLenses ''GargConfig
readIniFile' :: FilePath -> IO Ini
readIniFile' fp = do
ini <- readIniFile fp
case ini of
Left e -> panicTrace $ T.pack $ "ini file not found " <> show e
Right ini' -> pure ini'
val :: Ini -> Text -> Text -> Text
val ini section key = do
case (lookupValue section key ini) of
Left e -> panicTrace $ "ERROR: add " <> key <> " in section \"" <> section <> "\" to your gargantext.ini. " <> show e
Right p' -> p'
readConfig :: FilePath -> IO GargConfig
readConfig fp = do
ini <- readIniFile' fp
let val' = val ini "gargantext"
pure $ GargConfig
{ _gc_backend_name = cs $ val' "BACKEND_NAME"
, _gc_url = stripRight '/' $ val' "URL"
, _gc_url_backend_api = stripRight '/' $ val' "URL_BACKEND_API"
, _gc_masteruser = val' "MASTER_USER"
, _gc_secretkey = val' "SECRET_KEY"
, _gc_datafilepath = cs $ val' "DATA_FILEPATH"
, _gc_repofilepath = cs $ val' "REPO_FILEPATH"
, _gc_frame_write_url = stripRight '/' $ val' "FRAME_WRITE_URL"
, _gc_frame_calc_url = stripRight '/' $ val' "FRAME_CALC_URL"
, _gc_frame_visio_url = stripRight '/' $ val' "FRAME_VISIO_URL"
, _gc_frame_searx_url = stripRight '/' $ val' "FRAME_SEARX_URL"
, _gc_frame_istex_url = stripRight '/' $ val' "FRAME_ISTEX_URL"
, _gc_max_docs_parsers = read $ cs $ val' "MAX_DOCS_PARSERS"
, _gc_max_docs_scrapers = read $ cs $ val' "MAX_DOCS_SCRAPERS"
, _gc_pubmed_api_key = val' "PUBMED_API_KEY"
, _gc_js_job_timeout = read $ cs $ val' "JS_JOB_TIMEOUT"
, _gc_js_id_timeout = read $ cs $ val' "JS_ID_TIMEOUT"
, _gc_epo_api_url = cs $ val' "EPO_API_URL"
}
instance FromValue GargConfig where
fromValue = parseTableFromValue $ do
_gc_frontend_config@(FrontendConfig { .. }) <- reqKey "frontend"
_gc_mail_config <- reqKey "mail"
db_config <- reqKey "database"
_gc_nlp_config <- reqKey "nlp"
return $ GargConfig { _gc_backend_name = _fc_backend_name
, _gc_url = _fc_url
, _gc_url_backend_api = _fc_url_backend_api
, _gc_masteruser = ""
, _gc_secretkey = ""
, _gc_datafilepath = ""
, _gc_frame_write_url = ""
, _gc_frame_calc_url = ""
, _gc_frame_visio_url = ""
, _gc_frame_searx_url = ""
, _gc_frame_istex_url = ""
, _gc_max_docs_parsers = 0
, _gc_max_docs_scrapers = 0
, _gc_js_job_timeout = 0
, _gc_js_id_timeout = 0
, _gc_pubmed_api_key = ""
, _gc_epo_api_url = ""
, _gc_frontend_config
, _gc_mail_config
, _gc_database_config = unTOMLConnectInfo db_config
, _gc_nlp_config }
-- configCodec :: Toml.TomlCodec GargConfig
-- configCodec = GargConfig
-- <$> Toml.text "frontend.backend_name" .= _gc_backend_name
-- <*> (stripRight '/' <$> Toml.text "frontend.url") .= _gc_url
-- <*> (stripRight '/' <$> Toml.text "frontend.url_backend_api") .= _gc_url_backend_api
-- <*> Toml.text "secrets.master_user" .= _gc_masteruser
-- <*> Toml.text "secrets.secret_key" .= _gc_secretkey
-- <*> Toml.string "paths.data_filepath" .= _gc_datafilepath
-- <*> (stripRight '/' <$> Toml.text "external.frames.write_url") .= _gc_frame_write_url
-- <*> (stripRight '/' <$> Toml.text "external.frames.calc_url") .= _gc_frame_calc_url
-- <*> (stripRight '/' <$> Toml.text "external.frames.visio_url") .= _gc_frame_visio_url
-- <*> (stripRight '/' <$> Toml.text "external.frames.searx_url") .= _gc_frame_searx_url
-- <*> (stripRight '/' <$> Toml.text "external.frames.istex_url") .= _gc_frame_istex_url
-- <*> Toml.integer "jobs.max_docs_parsers" .= _gc_max_docs_parsers
-- <*> Toml.integer "jobs.max_docs_scrapers" .= _gc_max_docs_scrapers
-- <*> Toml.integer "jobs.js_job_timeout" .= _gc_js_job_timeout
-- <*> Toml.integer "jobs.js_id_timeout" .= _gc_js_id_timeout
-- <*> Toml.text "apis.pubmed.api_key" .= _gc_pubmed_api_key
-- <*> Toml.text "apis.epo.api_url" .= _gc_epo_api_url
-- pure $ GargConfig
-- { _gc_backend_name = cs $ val' "BACKEND_NAME"
-- , _gc_url = stripRight '/' $ val' "URL"
-- , _gc_url_backend_api = stripRight '/' $ val' "URL_BACKEND_API"
-- , _gc_masteruser = val' "MASTER_USER"
-- , _gc_secretkey = val' "SECRET_KEY"
-- , _gc_datafilepath = cs $ val' "DATA_FILEPATH"
-- , _gc_repofilepath = cs $ val' "REPO_FILEPATH"
-- , _gc_frame_write_url = stripRight '/' $ val' "FRAME_WRITE_URL"
-- , _gc_frame_calc_url = stripRight '/' $ val' "FRAME_CALC_URL"
-- , _gc_frame_visio_url = stripRight '/' $ val' "FRAME_VISIO_URL"
-- , _gc_frame_searx_url = stripRight '/' $ val' "FRAME_SEARX_URL"
-- , _gc_frame_istex_url = stripRight '/' $ val' "FRAME_ISTEX_URL"
-- , _gc_max_docs_parsers = read $ cs $ val' "MAX_DOCS_PARSERS"
-- , _gc_max_docs_scrapers = read $ cs $ val' "MAX_DOCS_SCRAPERS"
-- , _gc_pubmed_api_key = val' "PUBMED_API_KEY"
-- , _gc_js_job_timeout = read $ cs $ val' "JS_JOB_TIMEOUT"
-- , _gc_js_id_timeout = read $ cs $ val' "JS_ID_TIMEOUT"
-- , _gc_epo_api_url = cs $ val' "EPO_API_URL"
-- }
mkProxyUrl :: GargConfig -> MicroServicesSettings -> BaseUrl
mkProxyUrl GargConfig{..} MicroServicesSettings{..} =
case parseBaseUrl (T.unpack _gc_url) of
Nothing -> BaseUrl Http "localhost" 80 ""
Just bh -> bh { baseUrlPort = _msProxyPort }
{--| Support in Gargantext for CORS (Cross-origin resource sharing) --}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE ViewPatterns #-}
module Gargantext.API.Admin.Settings.CORS where
import Prelude
module Gargantext.Core.Config.CORS where
import Control.Arrow
import Control.Monad.Fail (fail)
import Data.Text qualified as T
import Gargantext.Prelude
import Servant.Client.Core (BaseUrl, parseBaseUrl)
import Toml
import Control.Lens hiding (iso, (.=))
import Servant.Client.Core
import Data.Maybe (fromMaybe)
import Toml.Schema
newtype CORSOrigin = CORSOrigin { _CORSOrigin :: BaseUrl }
deriving (Show, Eq)
instance FromValue CORSOrigin where
fromValue (Toml.Text' _ t) =
case parseBaseUrl (T.unpack t) of
Nothing -> fail $ "Cannot parse base url for: " <> T.unpack t
Just b -> return $ CORSOrigin b
fromValue _ = fail "Incorrect key type, expected Text"
data CORSSettings =
CORSSettings {
_corsAllowedOrigins :: [CORSOrigin]
......@@ -28,17 +33,24 @@ data CORSSettings =
, _corsUseOriginsForHosts :: !Bool
} deriving (Show, Eq)
corsOriginCodec :: TomlBiMap CORSOrigin AnyValue
corsOriginCodec = _Orig >>> _Text
where
_Orig :: BiMap e CORSOrigin T.Text
_Orig = iso (T.pack . showBaseUrl . _CORSOrigin)
(\(T.unpack -> u) -> CORSOrigin . fromMaybe (error $ "invalid origin: " <> u) . parseBaseUrl $ u)
corsSettingsCodec :: TomlCodec CORSSettings
corsSettingsCodec = CORSSettings
<$> Toml.arrayOf corsOriginCodec "allowed-origins" .= _corsAllowedOrigins
<*> pure mempty -- FIXME(adn) Currently we don't need to support this field.
<*> Toml.bool "use-origins-for-hosts" .= _corsUseOriginsForHosts
instance FromValue CORSSettings where
fromValue = parseTableFromValue $ do
_corsAllowedOrigins <- reqKey "allowed-origins"
let _corsAllowedHosts = mempty
_corsUseOriginsForHosts <- reqKey "use-origins-for-hosts"
return $ CORSSettings { .. }
-- corsOriginCodec :: TomlBiMap CORSOrigin AnyValue
-- corsOriginCodec = _Orig >>> _Text
-- where
-- _Orig :: BiMap e CORSOrigin T.Text
-- _Orig = iso (T.pack . showBaseUrl . _CORSOrigin)
-- (\(T.unpack -> u) -> CORSOrigin . fromMaybe (error $ "invalid origin: " <> u) . parseBaseUrl $ u)
-- corsSettingsCodec :: TomlCodec CORSSettings
-- corsSettingsCodec = CORSSettings
-- <$> Toml.arrayOf corsOriginCodec "allowed-origins" .= _corsAllowedOrigins
-- <*> pure mempty -- FIXME(adn) Currently we don't need to support this field.
-- <*> Toml.bool "use-origins-for-hosts" .= _corsUseOriginsForHosts
makeLenses ''CORSSettings
{-|
Module : Gargantext.Core.Config.Database
Description :
Copyright : (c) CNRS, 2024-Present
License : AGPL + CECILL v3
Maintainer : team@gargantext.org
Stability : experimental
Portability : POSIX
-}
module Gargantext.Core.Config.Database (
TOMLConnectInfo(..)
)
where
import Database.PostgreSQL.Simple qualified as PGS
import Gargantext.Prelude
import Toml.Schema
newtype TOMLConnectInfo = TOMLConnectInfo { unTOMLConnectInfo :: PGS.ConnectInfo }
instance FromValue TOMLConnectInfo where
fromValue = parseTableFromValue $ do
host <- reqKey "host"
port <- reqKey "port"
user <- reqKey "user"
password <- reqKey "pass"
db <- reqKey "name"
return $ TOMLConnectInfo $ PGS.ConnectInfo { PGS.connectHost = host
, PGS.connectPort = port
, PGS.connectUser = user
, PGS.connectPassword = password
, PGS.connectDatabase = db }
-- pgsCodec :: Toml.TomlCodec PGS.ConnectInfo
-- pgsCodec = PGS.ConnectInfo
-- <$> Toml.string "database.host" .= PGS.connectHost
-- <*> word16Toml "database.port" .= PGS.connectPort
-- <*> Toml.string "database.user" .= PGS.connectUser
-- <*> Toml.string "database.password" .= PGS.connectPassword
-- <*> Toml.string "database.name" .= PGS.connectDatabase
-- ini <- readIniFile' fp
-- let val' key = unpack $ val ini "database" key
-- let dbPortRaw = val' "DB_PORT"
-- let dbPort = case (readMaybe dbPortRaw :: Maybe Word16) of
-- Nothing -> panicTrace $ "DB_PORT incorrect: " <> (pack dbPortRaw)
-- Just d -> d
-- pure $ PGS.ConnectInfo { PGS.connectHost = val' "DB_HOST"
-- , PGS.connectPort = dbPort
-- , PGS.connectUser = val' "DB_USER"
-- , PGS.connectPassword = val' "DB_PASS"
-- , PGS.connectDatabase = val' "DB_NAME"
-- }
{-|
Module : Gargantext.Core.Config.Frontend
Description :
Copyright : (c) CNRS, 2024-Present
License : AGPL + CECILL v3
Maintainer : team@gargantext.org
Stability : experimental
Portability : POSIX
-}
{-# LANGUAGE TemplateHaskell #-}
module Gargantext.Core.Config.Frontend (
-- * Types
FrontendConfig(..)
)
where
import Gargantext.Core.Config.CORS (CORSSettings)
import Gargantext.Core.Config.MicroServices (MicroServicesSettings)
import Gargantext.Prelude
import Toml.Schema
data FrontendConfig =
FrontendConfig { _fc_url :: !Text
, _fc_backend_name :: !Text
, _fc_url_backend_api :: !Text
, _fc_jwt_settings :: !Text
, _fc_cors :: !CORSSettings
, _fc_microservices :: !MicroServicesSettings
}
deriving (Generic, Show)
instance FromValue FrontendConfig where
fromValue = parseTableFromValue $ do
_fc_url <- reqKey "url"
_fc_backend_name <- reqKey "backend_name"
_fc_url_backend_api <- reqKey "url_backend_api"
_fc_jwt_settings <- reqKey "jwt_settings"
_fc_cors <- reqKey "cors"
_fc_microservices <- reqKey "microservices"
return $ FrontendConfig { .. }
......@@ -19,7 +19,6 @@ module Gargantext.Core.Config.Mail (
-- * Utility functions
, gargMail
, readConfig
-- * Lenses
, mc_mail_from
......@@ -31,15 +30,16 @@ module Gargantext.Core.Config.Mail (
)
where
import Control.Monad.Fail (fail)
import Data.Maybe
import Data.Text (unpack)
import Data.Text qualified as T
import Gargantext.Core.Config (readIniFile', val)
import Gargantext.Prelude
import Network.Mail.Mime (plainPart)
import Network.Mail.SMTP hiding (htmlPart, STARTTLS)
import Network.Socket (PortNumber)
import Prelude (read)
import Toml
import Toml.Schema
type Email = Text
......@@ -48,6 +48,17 @@ type Name = Text
data LoginType = NoAuth | Normal | SSL | TLS | STARTTLS
deriving (Generic, Eq, Show, Read)
instance FromValue LoginType where
fromValue (Toml.Text' _ t) =
case t of
"NoAuth" -> return NoAuth
"Normal" -> return Normal
"SSL" -> return SSL
"TLS" -> return TLS
"STARTTLS" -> return STARTTLS
_ -> fail ("Cannot parse login type from " <> T.unpack t)
fromValue _ = fail ("Expected text for login type")
data MailConfig = MailConfig { _mc_mail_host :: !T.Text
, _mc_mail_port :: !PortNumber
, _mc_mail_user :: !T.Text
......@@ -57,18 +68,41 @@ data MailConfig = MailConfig { _mc_mail_host :: !T.Text
}
deriving (Generic, Show)
readConfig :: FilePath -> IO MailConfig
readConfig fp = do
ini <- readIniFile' fp
let val' = val ini "mail"
pure $ MailConfig { _mc_mail_host = cs $ val' "MAIL_HOST"
, _mc_mail_port = read $ cs $ val' "MAIL_PORT"
, _mc_mail_user = cs $ val' "MAIL_USER"
, _mc_mail_from = cs $ val' "MAIL_FROM"
, _mc_mail_password = cs $ val' "MAIL_PASSWORD"
, _mc_mail_login_type = read $ cs $ val' "MAIL_LOGIN_TYPE"
}
instance FromValue MailConfig where
fromValue = parseTableFromValue $ do
_mc_mail_host <- reqKey "m-host"
port <- reqKey "port" :: ParseTable l Int
_mc_mail_user <- reqKey "user"
_mc_mail_password <- reqKey "password"
_mc_mail_login_type <- reqKey "login_type"
_mc_mail_from <- reqKey "from"
return $ MailConfig { _mc_mail_port = fromIntegral port, .. }
-- readConfig :: SettingsFile -> IO MailConfig
-- readConfig (SettingsFile fp) = do
-- eRes <- Toml.decodeFileEither mailCodec fp
-- case eRes of
-- Left err -> panicTrace ("Error reading TOML file (mail): " <> show err :: Text)
-- Right config -> return config
-- mailCodec :: Toml.TomlCodec MailConfig
-- mailCodec = MailConfig
-- <$> Toml.text "mail.host" .= _mc_mail_host
-- <*> Toml.read "mail.port" .= _mc_mail_port
-- <*> Toml.text "mail.user" .= _mc_mail_user
-- <*> Toml.text "mail.password" .= _mc_mail_password
-- <*> Toml.read "mail.login_type" .= _mc_mail_login_type
-- <*> Toml.text "mail.from" .= _mc_mail_from
-- pure $ MailConfig { _mc_mail_host = cs $ val' "MAIL_HOST"
-- , _mc_mail_port = read $ cs $ val' "MAIL_PORT"
-- , _mc_mail_user = cs $ val' "MAIL_USER"
-- , _mc_mail_from = cs $ val' "MAIL_FROM"
-- , _mc_mail_password = cs $ val' "MAIL_PASSWORD"
-- , _mc_mail_login_type = read $ cs $ val' "MAIL_LOGIN_TYPE"
-- }
data GargMail = GargMail { gm_to :: Email
......
{-# LANGUAGE OverloadedStrings #-}
{-|
Module : Gargantext.Core.Config.MicroServices
Description :
Copyright : (c) CNRS, 2024-Present
License : AGPL + CECILL v3
Maintainer : team@gargantext.org
Stability : experimental
Portability : POSIX
-}
{-# LANGUAGE TemplateHaskell #-}
module Gargantext.API.Admin.Settings.MicroServices where
import Prelude
module Gargantext.Core.Config.MicroServices where
import Control.Lens.TH
import Data.Text qualified as T
import Gargantext.Core.Config
import Servant.Client.Core.BaseUrl
import Toml
import Gargantext.Prelude
import Toml.Schema
data MicroServicesSettings =
MicroServicesSettings {
......@@ -17,16 +25,11 @@ data MicroServicesSettings =
, _msProxyEnabled :: !Bool
} deriving (Show, Eq)
microServicesSettingsCodec :: TomlCodec MicroServicesSettings
microServicesSettingsCodec = MicroServicesSettings
<$> Toml.int "port" .= _msProxyPort
<*> Toml.bool "enabled" .= _msProxyEnabled
mkProxyUrl :: GargConfig -> MicroServicesSettings -> BaseUrl
mkProxyUrl GargConfig{..} MicroServicesSettings{..} =
case parseBaseUrl (T.unpack _gc_url) of
Nothing -> BaseUrl Http "localhost" 80 ""
Just bh -> bh { baseUrlPort = _msProxyPort }
instance FromValue MicroServicesSettings where
fromValue = parseTableFromValue $ reqKeyOf "proxy" $ parseTableFromValue $ do
_msProxyPort <- reqKey "port"
_msProxyEnabled <- reqKey "enabled"
return $ MicroServicesSettings { .. }
makeLenses ''MicroServicesSettings
......@@ -9,15 +9,13 @@ Portability : POSIX
-}
{-# OPTIONS_GHC -fno-warn-orphans #-} -- orphan 'FromValue URI' instance
{-# LANGUAGE TemplateHaskell #-}
module Gargantext.Core.Config.NLP (
-- * Types
NLPConfig(..)
-- * Utility functions
, readConfig
-- * Lenses
, nlp_default
, nlp_languages
......@@ -25,41 +23,66 @@ module Gargantext.Core.Config.NLP (
)
where
import Data.Ini qualified as Ini
import Control.Monad.Fail (fail)
import Data.Map.Strict qualified as Map
import Data.Maybe
import Data.Text qualified as T
import Gargantext.Core.Config (readIniFile', val)
import Gargantext.Prelude
import Gargantext.Prelude.Utils (listToMaybeAll)
import Network.URI (URI)
import Network.URI (parseURI)
import Network.URI (URI, parseURI)
import Toml
import Toml.Schema
instance FromValue URI where
fromValue (Toml.Text' _ t) =
case parseURI (T.unpack t) of
Nothing -> fail ("Cannot parse URI " <> T.unpack t)
Just uri -> return uri
fromValue _ = fail ("Expected text for URI")
data NLPConfig = NLPConfig { _nlp_default :: URI
, _nlp_languages :: (Map.Map T.Text URI) }
, _nlp_languages :: Map.Map T.Text URI }
deriving (Generic, Show)
iniSection :: Text
iniSection = "nlp"
instance FromValue NLPConfig where
fromValue = parseTableFromValue $ do
_nlp_default <- reqKey "EN"
-- _nlp_languages <- fromValue <$> getTable
let _nlp_languages = mempty
return $ NLPConfig { .. }
-- readConfig :: SettingsFile -> IO NLPConfig
-- readConfig (SettingsFile fp) = do
-- eRes <- Toml.decodeFileEither nlpCodec fp
-- case eRes of
-- Left err -> panicTrace ("Error reading TOML file (nlp): " <> show err)
-- Right config -> return config
-- nlpCodec :: Toml.TomlCodec NLPConfig
-- nlpCodec = NLPConfig
-- <$> uriToml "nlp.EN" .= _nlp_default
-- <*> Toml.tableMap Toml._KeyText uriToml "nlp" .= _nlp_languages
readConfig :: FilePath -> IO NLPConfig
readConfig fp = do
ini <- readIniFile' fp
let val' = val ini iniSection
let lang_default_text = "EN" -- Change this value by one of your choice: "All", "FR", or "EN"
-- readConfig :: FilePath -> IO NLPConfig
-- readConfig fp = do
-- ini <- readIniFile' fp
-- let val' = val ini iniSection
-- let lang_default_text = "EN" -- Change this value by one of your choice: "All", "FR", or "EN"
let m_nlp_default = parseURI $ cs $ val' lang_default_text
-- let m_nlp_default = parseURI $ cs $ val' lang_default_text
let m_nlp_keys = filter (\k -> k `notElem` [lang_default_text]) $ fromRight [] $ Ini.keys iniSection ini
let m_nlp_other = listToMaybeAll $ (\k -> (,) k <$> (parseURI $ cs $ val' k)) <$> m_nlp_keys
-- let m_nlp_keys = filter (\k -> k `notElem` [lang_default_text]) $ fromRight [] $ Ini.keys iniSection ini
-- let m_nlp_other = listToMaybeAll $ (\k -> (,) k <$> (parseURI $ cs $ val' k)) <$> m_nlp_keys
let mRet = NLPConfig <$> m_nlp_default <*> (Map.fromList <$> m_nlp_other)
-- let mRet = NLPConfig <$> m_nlp_default <*> (Map.fromList <$> m_nlp_other)
case mRet of
Nothing -> panicTrace $ T.concat [ "Cannot read config file: _nlp_default = "
, T.pack $ show m_nlp_default
, ", _nlp_other = "
, T.pack $ show m_nlp_other ]
Just ret -> pure ret
-- case mRet of
-- Nothing -> panicTrace $ T.concat [ "Cannot read config file: _nlp_default = "
-- , T.pack $ show m_nlp_default
-- , ", _nlp_other = "
-- , T.pack $ show m_nlp_other ]
-- Just ret -> pure ret
makeLenses ''NLPConfig
{-|
Module : Gargantext.Core.Config.Types
Description : Settings of the API (Server and Client)
Copyright : (c) CNRS, 2024-Present
License : AGPL + CECILL v3
Maintainer : team@gargantext.org
Stability : experimental
Portability : POSIX
TODO-SECURITY: Critical
-}
module Gargantext.Core.Config.Types where
import Gargantext.Prelude
newtype SettingsFile = SettingsFile { _SettingsFile :: FilePath }
deriving (Show, Eq, IsString)
{-|
Module : Gargantext.Core.Config.Utils
Description :
Copyright : (c) CNRS, 2024-Present
License : AGPL + CECILL v3
Maintainer : team@gargantext.org
Stability : experimental
Portability : POSIX
-}
module Gargantext.Core.Config.Utils (
readConfig
)
where
import Gargantext.Core.Config.Types (SettingsFile(..))
import Gargantext.Prelude
-- import Network.URI (URI)
-- import Network.URI (parseURI)
import Toml
import Toml.Schema
readConfig :: FromValue a => SettingsFile -> IO a
readConfig (SettingsFile fp) = do
c <- readFile fp
case decode c of
Failure err -> panicTrace ("Error reading TOML file: " <> show err)
Success _ r -> return r
-- _URI :: Toml.TomlBiMap URI Text
-- _URI = Toml.BiMap (Right . show) parseURI'
-- where
-- parseURI' :: Text -> Either Toml.TomlBiMapError URI
-- parseURI' t =
-- case parseURI (T.unpack t) of
-- Nothing -> Left $ Toml.ArbitraryError "Cannot parse URI"
-- Just u -> Right u
-- uriToml :: Toml.Key -> Toml.TomlCodec URI
-- uriToml = Toml.match (_URI >>> Toml._Text)
-- _Word16 :: Toml.TomlBiMap Word16 Toml.AnyValue
-- _Word16 = Toml._BoundedInteger >>> Toml._Integer
-- word16Toml :: Toml.Key -> Toml.TomlCodec Word16
-- word16Toml = Toml.match _Word16
......@@ -68,3 +68,4 @@ nlpServerMap (NLPConfig { .. }) =
((\lang ->
uncurryMaybeSecond (lang, Map.lookup (show lang) _nlp_languages >>= nlpServerConfigFromURI ))
<$> allLangs)
......@@ -22,10 +22,10 @@ module Gargantext.Database.Action.Node
import Control.Lens (view)
import Data.Text qualified as T
import Gargantext.API.Admin.Settings.MicroServices
import Gargantext.API.Admin.Types (settings, _microservicesSettings, HasSettings)
import Gargantext.Core
import Gargantext.Core.Config (GargConfig(..))
import Gargantext.Core.Config (GargConfig(..), mkProxyUrl)
import Gargantext.Core.Config.MicroServices (MicroServicesSettings(..))
import Gargantext.Core.Types (Name)
import Gargantext.Database.Admin.Types.Hyperdata
import Gargantext.Database.Admin.Types.Hyperdata.Default
......
......@@ -23,16 +23,15 @@ import Data.ByteString qualified as DB
import Data.List qualified as DL
import Data.Pool (Pool, withResource)
import Data.Profunctor.Product.Default (Default)
import Data.Text (pack, unpack)
import Database.PostgreSQL.Simple (Connection, connect)
import Database.PostgreSQL.Simple (Connection)
import Database.PostgreSQL.Simple qualified as PGS
import Database.PostgreSQL.Simple.FromField ( Conversion, ResultError(ConversionFailed), fromField, returnError)
import Database.PostgreSQL.Simple.Internal (Field)
import Database.PostgreSQL.Simple.Types (Query(..))
import Gargantext.Core.Config (GargConfig)
import Gargantext.Core.Mail.Types (HasMail)
import Gargantext.Core.NLP (HasNLPServer)
import Gargantext.Prelude
import Gargantext.Core.Config (GargConfig, readIniFile', val)
import Opaleye (Unpackspec, showSql, FromFields, Select, runSelect, SqlJsonb, DefaultFromField, toFields, matchMaybe, MaybeFields)
import Opaleye.Aggregate (countRows)
import Opaleye.Internal.Constant qualified
......@@ -181,24 +180,9 @@ execPGSQuery :: PGS.ToRow a => PGS.Query -> a -> DBCmd err Int64
execPGSQuery q a = mkCmd $ \conn -> PGS.execute conn q a
------------------------------------------------------------------------
databaseParameters :: FilePath -> IO PGS.ConnectInfo
databaseParameters fp = do
ini <- readIniFile' fp
let val' key = unpack $ val ini "database" key
let dbPortRaw = val' "DB_PORT"
let dbPort = case (readMaybe dbPortRaw :: Maybe Word16) of
Nothing -> panicTrace $ "DB_PORT incorrect: " <> (pack dbPortRaw)
Just d -> d
pure $ PGS.ConnectInfo { PGS.connectHost = val' "DB_HOST"
, PGS.connectPort = dbPort
, PGS.connectUser = val' "DB_USER"
, PGS.connectPassword = val' "DB_PASS"
, PGS.connectDatabase = val' "DB_NAME"
}
connectGargandb :: FilePath -> IO Connection
connectGargandb fp = databaseParameters fp >>= \params -> connect params
-- connectGargandb :: SettingsFile -> IO Connection
-- connectGargandb sf = readConfig sf >>= \params -> connect (DBConfig.unTOMLConnectInfo params)
fromField' :: (Typeable b, FromJSON b) => Field -> Maybe DB.ByteString -> Conversion b
fromField' field mb = do
......
......@@ -35,13 +35,12 @@ import Data.Text.Encoding qualified as TE
import GHC.Generics
import Gargantext.API.Admin.Auth.Types (AuthContext)
import Gargantext.API.Admin.EnvTypes
import Gargantext.API.Admin.Settings.MicroServices
import Gargantext.API.Admin.Types
import Gargantext.API.Node.ShareURL qualified as Share
import Gargantext.API.Routes.Named.Private
import Gargantext.API.Routes.Named.Share (ShareLink(..))
import Gargantext.API.ThrowAll (throwAllRoutes)
import Gargantext.Core.Config (gc_frame_write_url)
import Gargantext.Core.Config (gc_frame_write_url, mkProxyUrl)
import Gargantext.Database.Admin.Types.Node (NodeType(..), NodeId (..))
import Gargantext.Database.Prelude (hasConfig)
import Gargantext.Prelude hiding (Handler)
......
......@@ -43,8 +43,6 @@
- "stemmer-0.5.2"
- "taggy-0.2.1"
- "taggy-lens-0.1.2"
- "tomland-1.3.3.2"
- "validation-selective-0.2.0.0"
- "vector-0.12.3.0"
- "wai-3.2.4"
- "wai-util-0.8"
......@@ -112,6 +110,10 @@
git: "https://github.com/fpringle/servant-routes.git"
subdirs:
- .
- commit: 4a291783f4aa83548eac5009e16e8bdcb5ddc667
git: "https://github.com/glguy/toml-parser"
subdirs:
- .
- commit: 4fd2edf30c141600ffad6d730cc4c1c08a6dbce4
git: "https://github.com/robstewart57/rdf4h.git"
subdirs:
......@@ -545,9 +547,6 @@ flags:
compat: true
hans: false
network: true
tomland:
"build-play-tomland": false
"build-readme": false
"transformers-base":
orphaninstances: true
"transformers-compat":
......
......@@ -18,6 +18,8 @@ import Gargantext.API.Prelude
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(..))
import Gargantext.Core.Config.Utils (readConfig)
import Gargantext.Core.NLP
import Gargantext.Core.NodeStory
import Gargantext.Core.Types.Individu
......@@ -44,20 +46,19 @@ import Prelude
import Servant.Auth.Client ()
import Servant.Client
import Servant.Job.Async qualified as ServantAsync
import Test.Database.Setup (withTestDB, fakeIniPath, testEnvToPgConnectionInfo, fakeSettingsPath)
import Test.Database.Setup (withTestDB, fakeTomlPath, testEnvToPgConnectionInfo)
import Test.Database.Types
import UnliftIO qualified
newTestEnv :: TestEnv -> Logger (GargM Env BackendInternalError) -> Warp.Port -> IO Env
newTestEnv testEnv logger port = do
file <- fakeIniPath
settingsP <- SettingsFile <$> fakeSettingsPath
tomlFile@(SettingsFile sf) <- fakeTomlPath
!manager_env <- newTlsManager
!settings' <- devSettings devJwkFile settingsP <&> appPort .~ port
!settings' <- devSettings devJwkFile tomlFile <&> appPort .~ port
!config_env <- readConfig file
prios <- withLogger () $ \ioLogger -> Jobs.readPrios ioLogger (file <> ".jobs")
!config_env <- readConfig tomlFile
prios <- withLogger () $ \ioLogger -> Jobs.readPrios ioLogger (sf <> ".jobs")
let prios' = Jobs.applyPrios prios Jobs.defaultPrios
!self_url_env <- parseBaseUrl $ "http://0.0.0.0:" <> show port
dbParam <- pure $ testEnvToPgConnectionInfo testEnv
......@@ -71,8 +72,6 @@ newTestEnv testEnv logger port = do
& Jobs.l_jsJobTimeout .~ (fromIntegral $ config_env ^. hasConfig ^. gc_js_job_timeout)
& Jobs.l_jsIDTimeout .~ (fromIntegral $ config_env ^. hasConfig ^. gc_js_id_timeout)
!jobs_env <- Jobs.newJobEnv jobs_settings prios' manager_env
!config_mail <- Mail.readConfig file
!nlp_env <- nlpServerMap <$> NLP.readConfig file
pure $ Env
{ _env_settings = settings'
......@@ -84,8 +83,8 @@ newTestEnv testEnv logger port = do
, _env_jobs = jobs_env
, _env_self_url = self_url_env
, _env_config = config_env
, _env_mail = config_mail
, _env_nlp = nlp_env
, _env_mail = _gc_mail_config config_env
, _env_nlp = nlpServerMap $ _gc_nlp_config config_env
}
-- | Run the gargantext server on a random port, picked by Warp, which allows
......
{-# LANGUAGE TupleSections #-}
module Test.Database.Setup (
withTestDB
, fakeIniPath
, fakeSettingsPath
, fakeTomlPath
, testEnvToPgConnectionInfo
) where
......@@ -17,6 +16,8 @@ import Database.PostgreSQL.Simple.Options qualified as Opts
import Database.Postgres.Temp qualified as Tmp
import Gargantext.API.Admin.EnvTypes (Mode(Mock))
import Gargantext.API.Admin.Settings
import Gargantext.Core.Config.Types (SettingsFile(..))
import Gargantext.Core.Config.Utils (readConfig)
import Gargantext.Core.NodeStory (fromDBNodeStoryEnv)
import Gargantext.Prelude
import Gargantext.Core.Config
......@@ -33,11 +34,8 @@ dbUser = "gargantua"
dbPassword = "gargantua_test"
dbName = "gargandb_test"
fakeIniPath :: IO FilePath
fakeIniPath = getDataFileName "test-data/test_config.ini"
fakeSettingsPath :: IO FilePath
fakeSettingsPath = getDataFileName "test-data/gargantext-settings.toml"
fakeTomlPath :: IO SettingsFile
fakeTomlPath = SettingsFile <$> getDataFileName "test-data/test_config.toml"
gargDBSchema :: IO FilePath
gargDBSchema = getDataFileName "devops/postgres/schema.sql"
......@@ -72,13 +70,13 @@ setup = do
case res of
Left err -> Prelude.fail $ show err
Right db -> do
gargConfig <- fakeIniPath >>= readConfig
gargConfig <- fakeTomlPath >>= readConfig
pool <- createPool (PG.connectPostgreSQL (Tmp.toConnectionString db))
(PG.close) 2 60 2
bootstrapDB db pool gargConfig
ugen <- emptyCounter
test_nodeStory <- fromDBNodeStoryEnv pool
stgs <- devSettings devJwkFile =<< (SettingsFile <$> fakeSettingsPath)
stgs <- devSettings devJwkFile =<< fakeTomlPath
withLoggerHoisted Mock $ \logger -> do
pure $ TestEnv { test_db = DBHandle pool db
, test_config = gargConfig
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment