Skip to content

haskell-gargantext
haskell-gargantext
Verified Commit 76eb1cf0 authored by Przemyslaw Kaminski's avatar Przemyslaw Kaminski
Browse files
Options

[toml] rewrite config to a toml file

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