Skip to content
Projects
Groups
Snippets
Help
Loading...
Help
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
haskell-gargantext
Project
Project
Details
Activity
Releases
Cycle Analytics
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Charts
Issues
153
Issues
153
List
Board
Labels
Milestones
Merge Requests
9
Merge Requests
9
CI / CD
CI / CD
Pipelines
Jobs
Schedules
Charts
Wiki
Wiki
Snippets
Snippets
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Charts
Create a new issue
Jobs
Commits
Issue Boards
Open sidebar
gargantext
haskell-gargantext
Commits
76eb1cf0
Verified
Commit
76eb1cf0
authored
Aug 28, 2024
by
Przemyslaw Kaminski
1
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
[toml] rewrite config to a toml file
parent
d6c03dc3
Changes
35
Show whitespace changes
Inline
Side-by-side
Showing
35 changed files
with
583 additions
and
333 deletions
+583
-333
.gitignore
.gitignore
+1
-0
Admin.hs
bin/gargantext-cli/CLI/Admin.hs
+3
-3
Import.hs
bin/gargantext-cli/CLI/Import.hs
+2
-3
Init.hs
bin/gargantext-cli/CLI/Init.hs
+6
-5
Invitations.hs
bin/gargantext-cli/CLI/Invitations.hs
+5
-6
Parsers.hs
bin/gargantext-cli/CLI/Parsers.hs
+1
-7
Types.hs
bin/gargantext-cli/CLI/Types.hs
+5
-9
Upgrade.hs
bin/gargantext-cli/CLI/Upgrade.hs
+6
-6
Main.hs
bin/gargantext-server/Main.hs
+6
-12
update-project-dependencies
bin/update-project-dependencies
+2
-2
cabal.project
cabal.project
+5
-0
cabal.project.freeze
cabal.project.freeze
+1
-4
gargantext-settings.toml
gargantext-settings.toml
+0
-25
gargantext.cabal
gargantext.cabal
+7
-4
API.hs
src/Gargantext/API.hs
+8
-7
Settings.hs
src/Gargantext/API/Admin/Settings.hs
+21
-24
TOML.hs
src/Gargantext/API/Admin/Settings/TOML.hs
+0
-52
Types.hs
src/Gargantext/API/Admin/Types.hs
+2
-2
Dev.hs
src/Gargantext/API/Dev.hs
+13
-19
Config.hs
src/Gargantext/Core/Config.hs
+101
-52
CORS.hs
src/Gargantext/Core/Config/CORS.hs
+56
-0
Database.hs
src/Gargantext/Core/Config/Database.hs
+55
-0
Frontend.hs
src/Gargantext/Core/Config/Frontend.hs
+44
-0
Mail.hs
src/Gargantext/Core/Config/Mail.hs
+49
-15
MicroServices.hs
src/Gargantext/Core/Config/MicroServices.hs
+35
-0
NLP.hs
src/Gargantext/Core/Config/NLP.hs
+50
-27
Types.hs
src/Gargantext/Core/Config/Types.hs
+18
-0
Utils.hs
src/Gargantext/Core/Config/Utils.hs
+52
-0
NLP.hs
src/Gargantext/Core/NLP.hs
+1
-0
Node.hs
src/Gargantext/Database/Action/Node.hs
+2
-2
Prelude.hs
src/Gargantext/Database/Prelude.hs
+5
-21
ReverseProxy.hs
src/Gargantext/MicroServices/ReverseProxy.hs
+1
-2
stack.yaml
stack.yaml
+4
-5
Setup.hs
test/Test/API/Setup.hs
+9
-10
Setup.hs
test/Test/Database/Setup.hs
+7
-9
No files found.
.gitignore
View file @
76eb1cf0
...
...
@@ -34,6 +34,7 @@ _darcs
*.pdf
*.sql
*.ini
*.toml
!test-data/test_config.ini
# Runtime
...
...
bin/gargantext-cli/CLI/Admin.hs
View file @
76eb1cf0
...
...
@@ -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."
...
...
bin/gargantext-cli/CLI/Import.hs
View file @
76eb1cf0
...
...
@@ -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"
)
)
...
...
bin/gargantext-cli/CLI/Init.hs
View file @
76eb1cf0
...
...
@@ -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
bin/gargantext-cli/CLI/Invitations.hs
View file @
76eb1cf0
...
...
@@ -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."
)
)
...
...
bin/gargantext-cli/CLI/Parsers.hs
View file @
76eb1cf0
...
...
@@ -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"
...
...
bin/gargantext-cli/CLI/Types.hs
View file @
76eb1cf0
...
...
@@ -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
...
...
bin/gargantext-cli/CLI/Upgrade.hs
View file @
76eb1cf0
...
...
@@ -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
bin/gargantext-server/Main.hs
View file @
76eb1cf0
...
...
@@ -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
m
yIniFile
mb_settings
File
myVersion
<-
unwrapRecord
MyOptions
myMode
myPort
m
b_toml
File
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'
settings
File
_
->
startGargantext
myMode
myPort'
toml
File
logMsg
ioLogger
INFO
$
"Starting with "
<>
show
myMode
<>
" mode."
logMsg
ioLogger
INFO
$
"Machine locale: "
<>
show
currentLocale
start
...
...
bin/update-project-dependencies
View file @
76eb1cf0
...
...
@@ -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
...
...
cabal.project
View file @
76eb1cf0
...
...
@@ -175,6 +175,11 @@ source-repository-package
location
:
https
://
github
.
com
/
fpringle
/
servant
-
routes
.
git
tag
:
7694f62
af6bc1596d754b42af16da131ac403b3a
source
-
repository
-
package
type
:
git
location
:
https
://
github
.
com
/
glguy
/
toml
-
parser
tag
:
toml
-
parser
-
2.0.1.0
allow
-
older
:
*
allow
-
newer
:
*
...
...
cabal.project.freeze
View file @
76eb1cf0
...
...
@@ -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,
...
...
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
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
, toml
and >= 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
...
...
src/Gargantext/API.hs
View file @
76eb1cf0
...
...
@@ -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
...
...
src/Gargantext/API/Admin/Settings.hs
View file @
76eb1cf0
...
...
@@ -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
{
_Settings
File
::
FilePath
}
newtype
JwkFile
=
JwkFile
{
_Jwk
File
::
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
f
ile
prios
<-
withLogger
()
$
\
ioLogger
->
Jobs
.
readPrios
ioLogger
(
file
<>
".jobs"
)
!
config_env
<-
readConfig
settingsF
ile
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
=
nlp
ServerMap
$
_gc_nlp_config
config
_env
}
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
''
G
argTomlSettings
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
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
...
...
src/Gargantext/API/Dev.hs
View file @
76eb1cf0
...
...
@@ -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
default
IniFile
default
SettingsFile
$
\
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
default
IniFile
default
SettingsFile
$
\
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.
...
...
src/Gargantext/Core/Config.hs
View file @
76eb1cf0
...
...
@@ -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
''
G
argConfig
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
}
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) --}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE ViewPatterns #-}
module
Gargantext.API.Admin.Settings.CORS
where
import
Prelud
e
module
Gargantext.Core.Config.CORS
wher
e
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
''
C
ORSSettings
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 (
-- * 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
...
...
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 #-}
module
Gargantext.API.Admin.Settings.MicroServices
where
import
Prelud
e
module
Gargantext.Core.Config.MicroServices
wher
e
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
''
M
icroServicesSettings
src/Gargantext/Core/Config/NLP.hs
View file @
76eb1cf0
...
...
@@ -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
''
N
LPConfig
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 { .. }) =
((
\
lang
->
uncurryMaybeSecond
(
lang
,
Map
.
lookup
(
show
lang
)
_nlp_languages
>>=
nlpServerConfigFromURI
))
<$>
allLangs
)
src/Gargantext/Database/Action/Node.hs
View file @
76eb1cf0
...
...
@@ -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
...
...
src/Gargantext/Database/Prelude.hs
View file @
76eb1cf0
...
...
@@ -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
...
...
src/Gargantext/MicroServices/ReverseProxy.hs
View file @
76eb1cf0
...
...
@@ -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
)
...
...
stack.yaml
View file @
76eb1cf0
...
...
@@ -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"
:
...
...
test/Test/API/Setup.hs
View file @
76eb1cf0
...
...
@@ -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
,
fake
IniPath
,
testEnvToPgConnectionInfo
,
fakeSettingsPath
)
import
Test.Database.Setup
(
withTestDB
,
fake
TomlPath
,
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
f
ile
prios
<-
withLogger
()
$
\
ioLogger
->
Jobs
.
readPrios
ioLogger
(
file
<>
".jobs"
)
!
config_env
<-
readConfig
tomlF
ile
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
=
nlp
ServerMap
$
_gc_nlp_config
config
_env
}
-- | Run the gargantext server on a random port, picked by Warp, which allows
...
...
test/Test/Database/Setup.hs
View file @
76eb1cf0
{-# 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
<-
fake
Ini
Path
>>=
readConfig
gargConfig
<-
fake
Toml
Path
>>=
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
...
...
Przemyslaw Kaminski
@cgenie
mentioned in commit
5660aec0
·
Oct 08, 2024
mentioned in commit
5660aec0
mentioned in commit 5660aec07ec5a0a0a5468f440092c1a8f57a864e
Toggle commit list
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment