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
148
Issues
148
List
Board
Labels
Milestones
Merge Requests
7
Merge Requests
7
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
5d2efe0d
Verified
Commit
5d2efe0d
authored
Sep 19, 2024
by
Przemyslaw Kaminski
1
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
[config] Settings removed completely
Now everything is in Core/Config
parent
39b0d18c
Pipeline
#6672
canceled with stages
Changes
34
Pipelines
1
Hide whitespace changes
Inline
Side-by-side
Showing
34 changed files
with
61 additions
and
141 deletions
+61
-141
Ini.hs
bin/gargantext-cli/CLI/Ini.hs
+7
-1
Init.hs
bin/gargantext-cli/CLI/Init.hs
+3
-4
Invitations.hs
bin/gargantext-cli/CLI/Invitations.hs
+1
-3
gargantext-settings.toml_toModify
gargantext-settings.toml_toModify
+3
-0
gargantext.cabal
gargantext.cabal
+0
-1
API.hs
src/Gargantext/API.hs
+1
-2
Auth.hs
src/Gargantext/API/Admin/Auth.hs
+2
-3
EnvTypes.hs
src/Gargantext/API/Admin/EnvTypes.hs
+5
-12
Settings.hs
src/Gargantext/API/Admin/Settings.hs
+1
-14
Types.hs
src/Gargantext/API/Admin/Types.hs
+0
-26
Dev.hs
src/Gargantext/API/Dev.hs
+1
-3
Contact.hs
src/Gargantext/API/Node/Contact.hs
+1
-2
New.hs
src/Gargantext/API/Node/Corpus/New.hs
+1
-4
Searx.hs
src/Gargantext/API/Node/Corpus/Searx.hs
+0
-3
DocumentUpload.hs
src/Gargantext/API/Node/DocumentUpload.hs
+2
-3
DocumentsFromWriteNodes.hs
src/Gargantext/API/Node/DocumentsFromWriteNodes.hs
+1
-3
File.hs
src/Gargantext/API/Node/File.hs
+3
-4
FrameCalcUpload.hs
src/Gargantext/API/Node/FrameCalcUpload.hs
+0
-2
New.hs
src/Gargantext/API/Node/New.hs
+2
-3
Share.hs
src/Gargantext/API/Node/Share.hs
+0
-2
Update.hs
src/Gargantext/API/Node/Update.hs
+0
-2
Prelude.hs
src/Gargantext/API/Prelude.hs
+0
-3
Ngrams.hs
src/Gargantext/API/Server/Named/Ngrams.hs
+0
-2
Types.hs
src/Gargantext/Core/AsyncUpdates/Dispatcher/Types.hs
+0
-1
Types.hs
src/Gargantext/Core/Config/Types.hs
+9
-1
API.hs
src/Gargantext/Core/Viz/Graph/API.hs
+1
-2
Flow.hs
src/Gargantext/Database/Action/Flow.hs
+3
-13
New.hs
src/Gargantext/Database/Action/User/New.hs
+5
-6
Root.hs
src/Gargantext/Database/Query/Tree/Root.hs
+3
-4
test_config.toml
test-data/test_config.toml
+4
-0
Setup.hs
test/Test/API/Setup.hs
+1
-3
Setup.hs
test/Test/Database/Setup.hs
+0
-2
Types.hs
test/Test/Database/Types.hs
+0
-5
Jobs.hs
test/Test/Utils/Jobs.hs
+1
-2
No files found.
bin/gargantext-cli/CLI/Ini.hs
View file @
5d2efe0d
...
@@ -74,9 +74,15 @@ convertConfigs ini@(Ini.GargConfig { .. }) iniMail nlpConfig connInfo =
...
@@ -74,9 +74,15 @@ convertConfigs ini@(Ini.GargConfig { .. }) iniMail nlpConfig connInfo =
,
_jc_js_job_timeout
=
_gc_js_job_timeout
,
_jc_js_job_timeout
=
_gc_js_job_timeout
,
_jc_js_id_timeout
=
_gc_js_id_timeout
}
,
_jc_js_id_timeout
=
_gc_js_id_timeout
}
,
_gc_apis
=
CTypes
.
APIsConfig
{
_ac_pubmed_api_key
=
_gc_pubmed_api_key
,
_gc_apis
=
CTypes
.
APIsConfig
{
_ac_pubmed_api_key
=
_gc_pubmed_api_key
,
_ac_epo_api_url
=
_gc_epo_api_url
}
,
_ac_epo_api_url
=
_gc_epo_api_url
,
_ac_scrapyd_url
}
,
_gc_log_level
=
LevelDebug
,
_gc_log_level
=
LevelDebug
}
}
where
_ac_scrapyd_url
=
case
parseBaseUrl
"http://localhost:6800"
of
Nothing
->
panicTrace
"Cannot parse base url for scrapyd"
Just
b
->
b
mkFrontendConfig
::
Ini
.
GargConfig
->
CTypes
.
FrontendConfig
mkFrontendConfig
::
Ini
.
GargConfig
->
CTypes
.
FrontendConfig
mkFrontendConfig
(
Ini
.
GargConfig
{
..
})
=
mkFrontendConfig
(
Ini
.
GargConfig
{
..
})
=
...
...
bin/gargantext-cli/CLI/Init.hs
View file @
5d2efe0d
...
@@ -18,7 +18,6 @@ module CLI.Init where
...
@@ -18,7 +18,6 @@ module CLI.Init where
import
CLI.Parsers
import
CLI.Parsers
import
CLI.Types
import
CLI.Types
import
Data.List.NonEmpty
qualified
as
NE
import
Data.List.NonEmpty
qualified
as
NE
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
...
@@ -50,18 +49,18 @@ initCLI (InitArgs settingsPath) = do
...
@@ -50,18 +49,18 @@ initCLI (InitArgs settingsPath) = do
cfg
<-
readConfig
settingsPath
cfg
<-
readConfig
settingsPath
let
secret
=
_s_secret_key
$
_gc_secrets
cfg
let
secret
=
_s_secret_key
$
_gc_secrets
cfg
let
createUsers
::
forall
env
.
HasSettings
env
=>
DBCmd'
env
BackendInternalError
Int64
let
createUsers
::
forall
env
.
DBCmd'
env
BackendInternalError
Int64
createUsers
=
insertNewUsers
(
NewUser
"gargantua"
(
cs
email
)
(
GargPassword
$
cs
password
)
createUsers
=
insertNewUsers
(
NewUser
"gargantua"
(
cs
email
)
(
GargPassword
$
cs
password
)
NE
.:|
arbitraryNewUsers
NE
.:|
arbitraryNewUsers
)
)
let
let
mkRoots
::
forall
env
.
HasSettings
env
=>
DBCmd'
env
BackendInternalError
[(
UserId
,
RootId
)]
mkRoots
::
forall
env
.
DBCmd'
env
BackendInternalError
[(
UserId
,
RootId
)]
mkRoots
=
mapM
getOrMkRoot
$
map
UserName
(
"gargantua"
:
arbitraryUsername
)
mkRoots
=
mapM
getOrMkRoot
$
map
UserName
(
"gargantua"
:
arbitraryUsername
)
-- TODO create all users roots
-- TODO create all users roots
let
let
initMaster
::
forall
env
.
HasSettings
env
=>
DBCmd'
env
BackendInternalError
(
UserId
,
RootId
,
CorpusId
,
ListId
)
initMaster
::
forall
env
.
DBCmd'
env
BackendInternalError
(
UserId
,
RootId
,
CorpusId
,
ListId
)
initMaster
=
do
initMaster
=
do
(
masterUserId
,
masterRootId
,
masterCorpusId
)
(
masterUserId
,
masterRootId
,
masterCorpusId
)
<-
getOrMkRootWithCorpus
MkCorpusUserMaster
<-
getOrMkRootWithCorpus
MkCorpusUserMaster
...
...
bin/gargantext-cli/CLI/Invitations.hs
View file @
5d2efe0d
...
@@ -16,7 +16,6 @@ module CLI.Invitations where
...
@@ -16,7 +16,6 @@ module CLI.Invitations where
import
CLI.Parsers
import
CLI.Parsers
import
CLI.Types
import
CLI.Types
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
...
@@ -35,8 +34,7 @@ invitationsCLI :: InvitationsArgs -> IO ()
...
@@ -35,8 +34,7 @@ invitationsCLI :: InvitationsArgs -> IO ()
invitationsCLI
(
InvitationsArgs
settingsPath
user
node_id
email
)
=
do
invitationsCLI
(
InvitationsArgs
settingsPath
user
node_id
email
)
=
do
-- _cfg <- readConfig settingsPath
-- _cfg <- readConfig settingsPath
let
invite
::
(
HasSettings
env
let
invite
::
(
CmdRandom
env
BackendInternalError
m
,
CmdRandom
env
BackendInternalError
m
,
HasNLPServer
env
,
HasNLPServer
env
,
CET
.
HasCentralExchangeNotification
env
)
=>
m
Int
,
CET
.
HasCentralExchangeNotification
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
)
...
...
gargantext-settings.toml_toModify
View file @
5d2efe0d
...
@@ -65,6 +65,9 @@ api_key = ENTER_PUBMED_API_KEY
...
@@ -65,6 +65,9 @@ api_key = ENTER_PUBMED_API_KEY
[apis.epo]
[apis.epo]
api_url = EPO_API_URL
api_url = EPO_API_URL
[apis.scrapyd]
url = "http://localhost:6800"
[external]
[external]
...
...
gargantext.cabal
View file @
5d2efe0d
...
@@ -108,7 +108,6 @@ library
...
@@ -108,7 +108,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.Types
Gargantext.API.Auth.PolicyCheck
Gargantext.API.Auth.PolicyCheck
Gargantext.API.Count.Types
Gargantext.API.Count.Types
Gargantext.API.Dev
Gargantext.API.Dev
...
...
src/Gargantext/API.hs
View file @
5d2efe0d
...
@@ -44,9 +44,8 @@ import Data.Text.Encoding qualified as TE
...
@@ -44,9 +44,8 @@ import Data.Text.Encoding qualified as TE
import
Data.Text.IO
(
putStrLn
)
import
Data.Text.IO
(
putStrLn
)
import
Data.Validity
import
Data.Validity
import
Gargantext.API.Admin.Auth.Types
(
AuthContext
)
import
Gargantext.API.Admin.Auth.Types
(
AuthContext
)
import
Gargantext.API.Admin.EnvTypes
(
Env
,
Mode
(
..
),
env_config
,
env_jwt_settings
)
import
Gargantext.API.Admin.EnvTypes
(
Env
,
FireWall
(
..
),
Mode
(
..
),
env_config
,
env_jwt_settings
)
import
Gargantext.API.Admin.Settings
(
newEnv
)
import
Gargantext.API.Admin.Settings
(
newEnv
)
import
Gargantext.API.Admin.Types
(
FireWall
(
..
))
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
...
...
src/Gargantext/API/Admin/Auth.hs
View file @
5d2efe0d
...
@@ -51,7 +51,6 @@ import Data.UUID.V4 (nextRandom)
...
@@ -51,7 +51,6 @@ import Data.UUID.V4 (nextRandom)
import
Gargantext.API.Admin.Auth.Types
import
Gargantext.API.Admin.Auth.Types
import
Gargantext.API.Admin.EnvTypes
(
GargJob
(
..
),
Env
)
import
Gargantext.API.Admin.EnvTypes
(
GargJob
(
..
),
Env
)
import
Gargantext.API.Admin.Orchestrator.Types
(
AsyncJobs
(
..
))
import
Gargantext.API.Admin.Orchestrator.Types
(
AsyncJobs
(
..
))
import
Gargantext.API.Admin.Types
import
Gargantext.API.Auth.PolicyCheck
import
Gargantext.API.Auth.PolicyCheck
import
Gargantext.API.Errors
import
Gargantext.API.Errors
import
Gargantext.API.Prelude
(
authenticationError
,
HasServerError
,
GargServerC
,
_ServerError
,
GargM
,
IsGargServer
)
import
Gargantext.API.Prelude
(
authenticationError
,
HasServerError
,
GargServerC
,
_ServerError
,
GargM
,
IsGargServer
)
...
@@ -251,7 +250,7 @@ forgotPasswordPost (ForgotPasswordRequest email) = do
...
@@ -251,7 +250,7 @@ forgotPasswordPost (ForgotPasswordRequest email) = do
-- users' emails
-- users' emails
pure
$
ForgotPasswordResponse
"ok"
pure
$
ForgotPasswordResponse
"ok"
forgotPasswordGet
::
(
HasSettings
env
,
CmdCommon
env
,
HasAuthenticationError
err
,
HasServerError
err
)
forgotPasswordGet
::
(
CmdCommon
env
,
HasAuthenticationError
err
,
HasServerError
err
)
=>
Maybe
Text
->
Cmd'
env
err
ForgotPasswordGet
=>
Maybe
Text
->
Cmd'
env
err
ForgotPasswordGet
forgotPasswordGet
Nothing
=
pure
$
ForgotPasswordGet
""
forgotPasswordGet
Nothing
=
pure
$
ForgotPasswordGet
""
forgotPasswordGet
(
Just
uuid
)
=
do
forgotPasswordGet
(
Just
uuid
)
=
do
...
@@ -268,7 +267,7 @@ forgotPasswordGet (Just uuid) = do
...
@@ -268,7 +267,7 @@ forgotPasswordGet (Just uuid) = do
---------------------
---------------------
forgotPasswordGetUser
::
(
HasSettings
env
,
CmdCommon
env
,
HasAuthenticationError
err
,
HasServerError
err
)
forgotPasswordGetUser
::
(
CmdCommon
env
,
HasAuthenticationError
err
,
HasServerError
err
)
=>
UserLight
->
Cmd'
env
err
ForgotPasswordGet
=>
UserLight
->
Cmd'
env
err
ForgotPasswordGet
forgotPasswordGetUser
(
UserLight
{
..
})
=
do
forgotPasswordGetUser
(
UserLight
{
..
})
=
do
-- pick some random password
-- pick some random password
...
...
src/Gargantext/API/Admin/EnvTypes.hs
View file @
5d2efe0d
...
@@ -13,7 +13,6 @@ module Gargantext.API.Admin.EnvTypes (
...
@@ -13,7 +13,6 @@ module Gargantext.API.Admin.EnvTypes (
,
env_config
,
env_config
,
env_logger
,
env_logger
,
env_manager
,
env_manager
,
env_settings
,
env_self_url
,
env_self_url
,
env_central_exchange
,
env_central_exchange
,
env_dispatcher
,
env_dispatcher
...
@@ -22,6 +21,7 @@ module Gargantext.API.Admin.EnvTypes (
...
@@ -22,6 +21,7 @@ module Gargantext.API.Admin.EnvTypes (
,
menv_firewall
,
menv_firewall
,
dev_env_logger
,
dev_env_logger
,
FireWall
(
..
)
,
MockEnv
(
..
)
,
MockEnv
(
..
)
,
DevEnv
(
..
)
,
DevEnv
(
..
)
,
DevJobHandle
(
..
)
,
DevJobHandle
(
..
)
...
@@ -37,7 +37,6 @@ import Data.Sequence (ViewL(..), viewl)
...
@@ -37,7 +37,6 @@ import Data.Sequence (ViewL(..), viewl)
import
Data.Text
qualified
as
T
import
Data.Text
qualified
as
T
import
Database.PostgreSQL.Simple
(
Connection
)
import
Database.PostgreSQL.Simple
(
Connection
)
import
Gargantext.API.Admin.Orchestrator.Types
import
Gargantext.API.Admin.Orchestrator.Types
import
Gargantext.API.Admin.Types
import
Gargantext.API.Errors.Types
import
Gargantext.API.Errors.Types
import
Gargantext.API.Job
import
Gargantext.API.Job
import
Gargantext.API.Prelude
(
GargM
,
IsGargServer
)
import
Gargantext.API.Prelude
(
GargM
,
IsGargServer
)
...
@@ -123,8 +122,7 @@ data GargJob
...
@@ -123,8 +122,7 @@ data GargJob
-- having to specify /everything/. This means that when we /construct/ an 'Env',
-- having to specify /everything/. This means that when we /construct/ an 'Env',
-- we need to remember to force the fields to WHNF at that point.
-- we need to remember to force the fields to WHNF at that point.
data
Env
=
Env
data
Env
=
Env
{
_env_settings
::
~
Settings
{
_env_logger
::
~
(
Logger
(
GargM
Env
BackendInternalError
))
,
_env_logger
::
~
(
Logger
(
GargM
Env
BackendInternalError
))
,
_env_pool
::
~
(
Pool
Connection
)
,
_env_pool
::
~
(
Pool
Connection
)
,
_env_nodeStory
::
~
NodeStoryEnv
,
_env_nodeStory
::
~
NodeStoryEnv
,
_env_manager
::
~
Manager
,
_env_manager
::
~
Manager
...
@@ -155,9 +153,6 @@ instance HasNodeStoryImmediateSaver Env where
...
@@ -155,9 +153,6 @@ instance HasNodeStoryImmediateSaver Env where
instance
HasNodeArchiveStoryImmediateSaver
Env
where
instance
HasNodeArchiveStoryImmediateSaver
Env
where
hasNodeArchiveStoryImmediateSaver
=
hasNodeStory
.
nse_archive_saver_immediate
hasNodeArchiveStoryImmediateSaver
=
hasNodeStory
.
nse_archive_saver_immediate
instance
HasSettings
Env
where
settings
=
env_settings
instance
HasJWTSettings
Env
where
instance
HasJWTSettings
Env
where
jwtSettings
=
env_jwt_settings
jwtSettings
=
env_jwt_settings
...
@@ -264,6 +259,8 @@ instance Jobs.MonadJobStatus (GargM Env err) where
...
@@ -264,6 +259,8 @@ instance Jobs.MonadJobStatus (GargM Env err) where
addMoreSteps
steps
jh
=
updateJobProgress
jh
(
jobLogAddMore
steps
)
addMoreSteps
steps
jh
=
updateJobProgress
jh
(
jobLogAddMore
steps
)
data
FireWall
=
FireWall
{
unFireWall
::
Bool
}
data
MockEnv
=
MockEnv
data
MockEnv
=
MockEnv
{
_menv_firewall
::
!
FireWall
{
_menv_firewall
::
!
FireWall
}
}
...
@@ -293,8 +290,7 @@ instance HasLogger (GargM DevEnv BackendInternalError) where
...
@@ -293,8 +290,7 @@ instance HasLogger (GargM DevEnv BackendInternalError) where
logTxt
lgr
lvl
msg
=
logMsg
lgr
lvl
(
FL
.
toLogStr
$
T
.
unpack
msg
)
logTxt
lgr
lvl
msg
=
logMsg
lgr
lvl
(
FL
.
toLogStr
$
T
.
unpack
msg
)
data
DevEnv
=
DevEnv
data
DevEnv
=
DevEnv
{
_dev_env_settings
::
!
Settings
{
_dev_env_config
::
!
GargConfig
,
_dev_env_config
::
!
GargConfig
,
_dev_env_logger
::
!
(
Logger
(
GargM
DevEnv
BackendInternalError
))
,
_dev_env_logger
::
!
(
Logger
(
GargM
DevEnv
BackendInternalError
))
,
_dev_env_pool
::
!
(
Pool
Connection
)
,
_dev_env_pool
::
!
(
Pool
Connection
)
,
_dev_env_nodeStory
::
!
NodeStoryEnv
,
_dev_env_nodeStory
::
!
NodeStoryEnv
...
@@ -342,9 +338,6 @@ instance HasConfig DevEnv where
...
@@ -342,9 +338,6 @@ instance HasConfig DevEnv where
instance
HasConnectionPool
DevEnv
where
instance
HasConnectionPool
DevEnv
where
connPool
=
dev_env_pool
connPool
=
dev_env_pool
instance
HasSettings
DevEnv
where
settings
=
dev_env_settings
instance
HasNodeStoryEnv
DevEnv
where
instance
HasNodeStoryEnv
DevEnv
where
hasNodeStory
=
dev_env_nodeStory
hasNodeStory
=
dev_env_nodeStory
...
...
src/Gargantext/API/Admin/Settings.hs
View file @
5d2efe0d
...
@@ -26,7 +26,6 @@ import Data.Pool (Pool)
...
@@ -26,7 +26,6 @@ import Data.Pool (Pool)
import
Data.Pool
qualified
as
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.Types
import
Gargantext.API.Errors.Types
import
Gargantext.API.Errors.Types
import
Gargantext.API.Prelude
import
Gargantext.API.Prelude
import
Gargantext.Core.AsyncUpdates.CentralExchange
qualified
as
CE
import
Gargantext.Core.AsyncUpdates.CentralExchange
qualified
as
CE
...
@@ -52,16 +51,6 @@ import System.IO.Temp (withTempFile)
...
@@ -52,16 +51,6 @@ import System.IO.Temp (withTempFile)
newtype
IniFile
=
IniFile
{
_IniFile
::
FilePath
}
newtype
IniFile
=
IniFile
{
_IniFile
::
FilePath
}
deriving
(
Show
,
Eq
,
IsString
)
deriving
(
Show
,
Eq
,
IsString
)
devSettings
::
Settings
devSettings
=
-- GargTomlSettings{..} <- loadGargTomlSettings settingsFile
Settings
{
-- _corsSettings = _gargCorsSettings
-- , _microservicesSettings = _gargMicroServicesSettings
-- , _dbServer = "localhost"
_scrapydUrl
=
fromMaybe
(
panicTrace
"Invalid scrapy URL"
)
$
parseBaseUrl
"http://localhost:6800"
}
{- NOT USED YET
{- NOT USED YET
import System.Environment (lookupEnv)
import System.Environment (lookupEnv)
...
@@ -164,7 +153,6 @@ readRepoEnv repoDir = do
...
@@ -164,7 +153,6 @@ readRepoEnv repoDir = do
newEnv
::
Logger
(
GargM
Env
BackendInternalError
)
->
PortNumber
->
SettingsFile
->
IO
Env
newEnv
::
Logger
(
GargM
Env
BackendInternalError
)
->
PortNumber
->
SettingsFile
->
IO
Env
newEnv
logger
port
settingsFile
@
(
SettingsFile
sf
)
=
do
newEnv
logger
port
settingsFile
@
(
SettingsFile
sf
)
=
do
!
manager_env
<-
newTlsManager
!
manager_env
<-
newTlsManager
let
!
settings'
=
devSettings
!
config_env
<-
readConfig
settingsFile
<&>
(
gc_frontend_config
.
fc_appPort
)
.~
port
-- TODO read from 'file'
!
config_env
<-
readConfig
settingsFile
<&>
(
gc_frontend_config
.
fc_appPort
)
.~
port
-- TODO read from 'file'
when
(
port
/=
config_env
^.
gc_frontend_config
.
fc_appPort
)
$
when
(
port
/=
config_env
^.
gc_frontend_config
.
fc_appPort
)
$
panicTrace
"TODO: conflicting settings of port"
panicTrace
"TODO: conflicting settings of port"
...
@@ -193,8 +181,7 @@ newEnv logger port settingsFile@(SettingsFile sf) = do
...
@@ -193,8 +181,7 @@ newEnv logger port settingsFile@(SettingsFile sf) = do
we want to force them to WHNF to avoid accumulating unnecessary thunks.
we want to force them to WHNF to avoid accumulating unnecessary thunks.
-}
-}
pure
$
Env
pure
$
Env
{
_env_settings
=
settings'
{
_env_logger
=
logger
,
_env_logger
=
logger
,
_env_pool
=
pool
,
_env_pool
=
pool
,
_env_nodeStory
=
nodeStory_env
,
_env_nodeStory
=
nodeStory_env
,
_env_manager
=
manager_env
,
_env_manager
=
manager_env
...
...
src/Gargantext/API/Admin/Types.hs
deleted
100644 → 0
View file @
39b0d18c
{-# LANGUAGE TemplateHaskell #-}
module
Gargantext.API.Admin.Types
where
import
Control.Lens
import
Gargantext.Prelude
import
Servant.Client
(
BaseUrl
)
data
Settings
=
Settings
{
-- , _dbServer :: Text
-- ^ this is not used yet
_scrapydUrl
::
!
BaseUrl
}
makeLenses
''
S
ettings
class
HasSettings
env
where
settings
::
Getter
env
Settings
instance
HasSettings
Settings
where
settings
=
identity
data
FireWall
=
FireWall
{
unFireWall
::
Bool
}
src/Gargantext/API/Dev.hs
View file @
5d2efe0d
...
@@ -17,7 +17,7 @@ import Control.Monad (fail)
...
@@ -17,7 +17,7 @@ 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
(
devSettings
,
newPool
)
import
Gargantext.API.Admin.Settings
(
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
)
import
Gargantext.Core.Config
(
_gc_database_config
)
...
@@ -41,12 +41,10 @@ withDevEnv settingsFile k = withLoggerHoisted Dev $ \logger -> do
...
@@ -41,12 +41,10 @@ withDevEnv settingsFile k = withLoggerHoisted Dev $ \logger -> do
--nodeStory_env <- fromDBNodeStoryEnv (_gc_repofilepath cfg)
--nodeStory_env <- fromDBNodeStoryEnv (_gc_repofilepath cfg)
pool
<-
newPool
(
_gc_database_config
cfg
)
pool
<-
newPool
(
_gc_database_config
cfg
)
nodeStory_env
<-
fromDBNodeStoryEnv
pool
nodeStory_env
<-
fromDBNodeStoryEnv
pool
let
setts
=
devSettings
pure
$
DevEnv
pure
$
DevEnv
{
_dev_env_pool
=
pool
{
_dev_env_pool
=
pool
,
_dev_env_logger
=
logger
,
_dev_env_logger
=
logger
,
_dev_env_nodeStory
=
nodeStory_env
,
_dev_env_nodeStory
=
nodeStory_env
,
_dev_env_settings
=
setts
,
_dev_env_config
=
cfg
,
_dev_env_config
=
cfg
}
}
...
...
src/Gargantext/API/Node/Contact.hs
View file @
5d2efe0d
...
@@ -22,7 +22,6 @@ import Conduit ( yield )
...
@@ -22,7 +22,6 @@ import Conduit ( yield )
import
Gargantext.API.Admin.Auth.Types
(
AuthenticatedUser
(
AuthenticatedUser
)
)
import
Gargantext.API.Admin.Auth.Types
(
AuthenticatedUser
(
AuthenticatedUser
)
)
import
Gargantext.API.Admin.EnvTypes
(
Env
,
GargJob
(
..
))
import
Gargantext.API.Admin.EnvTypes
(
Env
,
GargJob
(
..
))
import
Gargantext.API.Admin.Orchestrator.Types
(
AsyncJobs
(
..
))
import
Gargantext.API.Admin.Orchestrator.Types
(
AsyncJobs
(
..
))
import
Gargantext.API.Admin.Types
(
HasSettings
)
import
Gargantext.API.Errors.Types
(
BackendInternalError
)
import
Gargantext.API.Errors.Types
(
BackendInternalError
)
import
Gargantext.API.Node
(
nodeNodeAPI
)
import
Gargantext.API.Node
(
nodeNodeAPI
)
import
Gargantext.API.Node.Contact.Types
import
Gargantext.API.Node.Contact.Types
...
@@ -54,7 +53,7 @@ api_async u nId = Named.ContactAsyncAPI $ AsyncJobs $
...
@@ -54,7 +53,7 @@ api_async u nId = Named.ContactAsyncAPI $ AsyncJobs $
serveJobsAPI
AddContactJob
$
\
jHandle
p
->
serveJobsAPI
AddContactJob
$
\
jHandle
p
->
addContact
u
nId
p
jHandle
addContact
u
nId
p
jHandle
addContact
::
(
HasSettings
env
,
FlowCmdM
env
err
m
,
MonadJobStatus
m
)
addContact
::
(
FlowCmdM
env
err
m
,
MonadJobStatus
m
)
=>
User
=>
User
->
NodeId
->
NodeId
->
AddContactParams
->
AddContactParams
...
...
src/Gargantext/API/Node/Corpus/New.hs
View file @
5d2efe0d
...
@@ -29,7 +29,6 @@ import Data.Text qualified as T
...
@@ -29,7 +29,6 @@ import Data.Text qualified as T
import
Data.Text.Encoding
qualified
as
TE
import
Data.Text.Encoding
qualified
as
TE
import
EPO.API.Client.Types
qualified
as
EPO
import
EPO.API.Client.Types
qualified
as
EPO
import
Gargantext.API.Admin.Orchestrator.Types
qualified
as
API
import
Gargantext.API.Admin.Orchestrator.Types
qualified
as
API
import
Gargantext.API.Admin.Types
(
HasSettings
)
import
Gargantext.API.Ngrams
(
commitStatePatch
,
Versioned
(
..
))
import
Gargantext.API.Ngrams
(
commitStatePatch
,
Versioned
(
..
))
import
Gargantext.API.Node.Corpus.New.Types
(
FileFormat
(
..
),
FileType
(
..
)
)
import
Gargantext.API.Node.Corpus.New.Types
(
FileFormat
(
..
),
FileType
(
..
)
)
import
Gargantext.API.Node.Corpus.Searx
(
triggerSearxSearch
)
import
Gargantext.API.Node.Corpus.Searx
(
triggerSearxSearch
)
...
@@ -148,7 +147,6 @@ addToCorpusWithQuery :: ( FlowCmdM env err m
...
@@ -148,7 +147,6 @@ addToCorpusWithQuery :: ( FlowCmdM env err m
,
MonadJobStatus
m
,
MonadJobStatus
m
,
HasNodeStoryImmediateSaver
env
,
HasNodeStoryImmediateSaver
env
,
HasNodeArchiveStoryImmediateSaver
env
,
HasNodeArchiveStoryImmediateSaver
env
,
HasSettings
env
)
)
=>
User
=>
User
->
CorpusId
->
CorpusId
...
@@ -222,7 +220,6 @@ addToCorpusWithForm :: ( FlowCmdM env err m
...
@@ -222,7 +220,6 @@ addToCorpusWithForm :: ( FlowCmdM env err m
,
MonadJobStatus
m
,
MonadJobStatus
m
,
HasNodeStoryImmediateSaver
env
,
HasNodeStoryImmediateSaver
env
,
HasNodeArchiveStoryImmediateSaver
env
,
HasNodeArchiveStoryImmediateSaver
env
,
HasSettings
env
)
)
=>
User
=>
User
->
CorpusId
->
CorpusId
...
@@ -326,7 +323,7 @@ addToCorpusWithFile cid input filetype logStatus = do
...
@@ -326,7 +323,7 @@ addToCorpusWithFile cid input filetype logStatus = do
}
}
-}
-}
addToCorpusWithFile
::
(
HasSettings
env
,
FlowCmdM
env
err
m
,
MonadJobStatus
m
)
addToCorpusWithFile
::
(
FlowCmdM
env
err
m
,
MonadJobStatus
m
)
=>
User
=>
User
->
CorpusId
->
CorpusId
->
NewWithFile
->
NewWithFile
...
...
src/Gargantext/API/Node/Corpus/Searx.hs
View file @
5d2efe0d
...
@@ -21,7 +21,6 @@ import Data.Text qualified as Text
...
@@ -21,7 +21,6 @@ import Data.Text qualified as Text
import
Data.Time.Calendar
(
Day
,
toGregorian
)
import
Data.Time.Calendar
(
Day
,
toGregorian
)
import
Data.Time.Format
(
defaultTimeLocale
,
formatTime
,
parseTimeM
)
import
Data.Time.Format
(
defaultTimeLocale
,
formatTime
,
parseTimeM
)
import
Data.Tuple.Select
(
sel1
,
sel2
,
sel3
)
import
Data.Tuple.Select
(
sel1
,
sel2
,
sel3
)
import
Gargantext.API.Admin.Types
(
HasSettings
)
import
Gargantext.Core
(
Lang
(
..
))
import
Gargantext.Core
(
Lang
(
..
))
import
Gargantext.Core.Config
(
GargConfig
(
..
),
hasConfig
)
import
Gargantext.Core.Config
(
GargConfig
(
..
),
hasConfig
)
import
Gargantext.Core.Config.Types
(
FramesConfig
(
..
))
import
Gargantext.Core.Config.Types
(
FramesConfig
(
..
))
...
@@ -123,7 +122,6 @@ insertSearxResponse :: ( MonadBase IO m
...
@@ -123,7 +122,6 @@ insertSearxResponse :: ( MonadBase IO m
,
HasNodeError
err
,
HasNodeError
err
,
HasTreeError
err
,
HasTreeError
err
,
HasValidationError
err
,
HasValidationError
err
,
HasSettings
env
)
)
=>
User
=>
User
->
CorpusId
->
CorpusId
...
@@ -168,7 +166,6 @@ triggerSearxSearch :: ( MonadBase IO m
...
@@ -168,7 +166,6 @@ triggerSearxSearch :: ( MonadBase IO m
,
HasTreeError
err
,
HasTreeError
err
,
HasValidationError
err
,
HasValidationError
err
,
MonadJobStatus
m
,
MonadJobStatus
m
,
HasSettings
env
)
)
=>
User
=>
User
->
CorpusId
->
CorpusId
...
...
src/Gargantext/API/Node/DocumentUpload.hs
View file @
5d2efe0d
...
@@ -20,7 +20,6 @@ import Control.Lens (view)
...
@@ -20,7 +20,6 @@ import Control.Lens (view)
import
Data.Text
qualified
as
T
import
Data.Text
qualified
as
T
import
Gargantext.API.Admin.EnvTypes
(
GargJob
(
..
),
Env
)
import
Gargantext.API.Admin.EnvTypes
(
GargJob
(
..
),
Env
)
import
Gargantext.API.Admin.Orchestrator.Types
import
Gargantext.API.Admin.Orchestrator.Types
import
Gargantext.API.Admin.Types
(
HasSettings
)
import
Gargantext.API.Errors.Types
(
BackendInternalError
)
import
Gargantext.API.Errors.Types
(
BackendInternalError
)
import
Gargantext.API.Node.DocumentUpload.Types
import
Gargantext.API.Node.DocumentUpload.Types
import
Gargantext.API.Prelude
(
GargM
)
import
Gargantext.API.Prelude
(
GargM
)
...
@@ -45,7 +44,7 @@ api nId = Named.DocumentUploadAPI $ AsyncJobs $
...
@@ -45,7 +44,7 @@ api nId = Named.DocumentUploadAPI $ AsyncJobs $
serveJobsAPI
UploadDocumentJob
$
\
jHandle
q
->
do
serveJobsAPI
UploadDocumentJob
$
\
jHandle
q
->
do
documentUploadAsync
nId
q
jHandle
documentUploadAsync
nId
q
jHandle
documentUploadAsync
::
(
FlowCmdM
env
err
m
,
MonadJobStatus
m
,
HasSettings
env
)
documentUploadAsync
::
(
FlowCmdM
env
err
m
,
MonadJobStatus
m
)
=>
NodeId
=>
NodeId
->
DocumentUpload
->
DocumentUpload
->
JobHandle
m
->
JobHandle
m
...
@@ -56,7 +55,7 @@ documentUploadAsync nId doc jobHandle = do
...
@@ -56,7 +55,7 @@ documentUploadAsync nId doc jobHandle = do
-- printDebug "documentUploadAsync" docIds
-- printDebug "documentUploadAsync" docIds
markComplete
jobHandle
markComplete
jobHandle
documentUpload
::
(
FlowCmdM
env
err
m
,
HasSettings
env
)
documentUpload
::
(
FlowCmdM
env
err
m
)
=>
NodeId
=>
NodeId
->
DocumentUpload
->
DocumentUpload
->
m
[
DocId
]
->
m
[
DocId
]
...
...
src/Gargantext/API/Node/DocumentsFromWriteNodes.hs
View file @
5d2efe0d
...
@@ -22,7 +22,6 @@ import Data.Text qualified as T
...
@@ -22,7 +22,6 @@ import Data.Text qualified as T
import
Gargantext.API.Admin.Auth.Types
(
AuthenticatedUser
,
auth_node_id
,
auth_user_id
)
import
Gargantext.API.Admin.Auth.Types
(
AuthenticatedUser
,
auth_node_id
,
auth_user_id
)
import
Gargantext.API.Admin.EnvTypes
(
Env
,
GargJob
(
..
))
import
Gargantext.API.Admin.EnvTypes
(
Env
,
GargJob
(
..
))
import
Gargantext.API.Admin.Orchestrator.Types
import
Gargantext.API.Admin.Orchestrator.Types
import
Gargantext.API.Admin.Types
(
HasSettings
)
import
Gargantext.API.Errors.Types
(
BackendInternalError
)
import
Gargantext.API.Errors.Types
(
BackendInternalError
)
import
Gargantext.API.Ngrams
(
commitStatePatch
,
Versioned
(
..
))
import
Gargantext.API.Ngrams
(
commitStatePatch
,
Versioned
(
..
))
import
Gargantext.API.Node.DocumentsFromWriteNodes.Types
import
Gargantext.API.Node.DocumentsFromWriteNodes.Types
...
@@ -55,8 +54,7 @@ api authenticatedUser nId = Named.DocumentsFromWriteNodesAPI $ AsyncJobs $
...
@@ -55,8 +54,7 @@ api authenticatedUser nId = Named.DocumentsFromWriteNodesAPI $ AsyncJobs $
serveJobsAPI
DocumentFromWriteNodeJob
$
\
jHandle
p
->
serveJobsAPI
DocumentFromWriteNodeJob
$
\
jHandle
p
->
documentsFromWriteNodes
authenticatedUser
nId
p
jHandle
documentsFromWriteNodes
authenticatedUser
nId
p
jHandle
documentsFromWriteNodes
::
(
HasSettings
env
documentsFromWriteNodes
::
(
FlowCmdM
env
err
m
,
FlowCmdM
env
err
m
,
MonadJobStatus
m
,
MonadJobStatus
m
,
HasNodeStoryImmediateSaver
env
,
HasNodeStoryImmediateSaver
env
,
HasNodeArchiveStoryImmediateSaver
env
)
,
HasNodeArchiveStoryImmediateSaver
env
)
...
...
src/Gargantext/API/Node/File.hs
View file @
5d2efe0d
...
@@ -22,7 +22,6 @@ import Data.Text qualified as T
...
@@ -22,7 +22,6 @@ import Data.Text qualified as T
import
Gargantext.API.Admin.Auth.Types
(
AuthenticatedUser
,
auth_user_id
)
import
Gargantext.API.Admin.Auth.Types
(
AuthenticatedUser
,
auth_user_id
)
import
Gargantext.API.Admin.EnvTypes
(
GargJob
(
..
),
Env
)
import
Gargantext.API.Admin.EnvTypes
(
GargJob
(
..
),
Env
)
import
Gargantext.API.Admin.Orchestrator.Types
(
AsyncJobs
(
..
))
import
Gargantext.API.Admin.Orchestrator.Types
(
AsyncJobs
(
..
))
import
Gargantext.API.Admin.Types
(
HasSettings
)
import
Gargantext.API.Errors.Types
(
BackendInternalError
)
import
Gargantext.API.Errors.Types
(
BackendInternalError
)
import
Gargantext.API.Node.File.Types
import
Gargantext.API.Node.File.Types
import
Gargantext.API.Node.Types
(
NewWithFile
(
NewWithFile
)
)
import
Gargantext.API.Node.Types
(
NewWithFile
(
NewWithFile
)
)
...
@@ -41,12 +40,12 @@ import Gargantext.Utils.Jobs (serveJobsAPI, MonadJobStatus(..))
...
@@ -41,12 +40,12 @@ import Gargantext.Utils.Jobs (serveJobsAPI, MonadJobStatus(..))
import
Servant
import
Servant
import
Servant.Server.Generic
(
AsServerT
)
import
Servant.Server.Generic
(
AsServerT
)
fileApi
::
(
HasSettings
env
,
FlowCmdM
env
err
m
)
fileApi
::
(
FlowCmdM
env
err
m
)
=>
NodeId
=>
NodeId
->
m
(
Headers
'[
S
ervant
.
Header
"Content-Type"
Text
]
BSResponse
)
->
m
(
Headers
'[
S
ervant
.
Header
"Content-Type"
Text
]
BSResponse
)
fileApi
nId
=
fileDownload
nId
fileApi
nId
=
fileDownload
nId
fileDownload
::
(
HasSettings
env
,
FlowCmdM
env
err
m
)
fileDownload
::
(
FlowCmdM
env
err
m
)
=>
NodeId
=>
NodeId
->
m
(
Headers
'[
S
ervant
.
Header
"Content-Type"
Text
]
BSResponse
)
->
m
(
Headers
'[
S
ervant
.
Header
"Content-Type"
Text
]
BSResponse
)
fileDownload
nId
=
do
fileDownload
nId
=
do
...
@@ -83,7 +82,7 @@ fileAsyncApi authenticatedUser nId = Named.FileAsyncAPI $ AsyncJobs $
...
@@ -83,7 +82,7 @@ fileAsyncApi authenticatedUser nId = Named.FileAsyncAPI $ AsyncJobs $
addWithFile
authenticatedUser
nId
i
jHandle
addWithFile
authenticatedUser
nId
i
jHandle
addWithFile
::
(
HasSettings
env
,
FlowCmdM
env
err
m
,
MonadJobStatus
m
)
addWithFile
::
(
FlowCmdM
env
err
m
,
MonadJobStatus
m
)
=>
AuthenticatedUser
=>
AuthenticatedUser
-- ^ The logged-in user
-- ^ The logged-in user
->
NodeId
->
NodeId
...
...
src/Gargantext/API/Node/FrameCalcUpload.hs
View file @
5d2efe0d
...
@@ -21,7 +21,6 @@ import Data.Text qualified as T
...
@@ -21,7 +21,6 @@ import Data.Text qualified as T
import
Gargantext.API.Admin.Auth.Types
(
auth_node_id
,
AuthenticatedUser
)
import
Gargantext.API.Admin.Auth.Types
(
auth_node_id
,
AuthenticatedUser
)
import
Gargantext.API.Admin.EnvTypes
(
GargJob
(
..
),
Env
)
import
Gargantext.API.Admin.EnvTypes
(
GargJob
(
..
),
Env
)
import
Gargantext.API.Admin.Orchestrator.Types
(
AsyncJobs
(
..
))
import
Gargantext.API.Admin.Orchestrator.Types
(
AsyncJobs
(
..
))
import
Gargantext.API.Admin.Types
(
HasSettings
)
import
Gargantext.API.Errors.Types
(
BackendInternalError
)
import
Gargantext.API.Errors.Types
(
BackendInternalError
)
import
Gargantext.API.Node.Corpus.New
(
addToCorpusWithForm
)
import
Gargantext.API.Node.Corpus.New
(
addToCorpusWithForm
)
import
Gargantext.API.Node.Corpus.New.Types
(
FileFormat
(
..
),
FileType
(
..
))
import
Gargantext.API.Node.Corpus.New.Types
(
FileFormat
(
..
),
FileType
(
..
))
...
@@ -55,7 +54,6 @@ frameCalcUploadAsync :: ( HasConfig env
...
@@ -55,7 +54,6 @@ frameCalcUploadAsync :: ( HasConfig env
,
FlowCmdM
env
err
m
,
FlowCmdM
env
err
m
,
MonadJobStatus
m
,
MonadJobStatus
m
,
HasNodeArchiveStoryImmediateSaver
env
,
HasNodeArchiveStoryImmediateSaver
env
,
HasSettings
env
)
)
=>
AuthenticatedUser
=>
AuthenticatedUser
-- ^ The logged-in user
-- ^ The logged-in user
...
...
src/Gargantext/API/Node/New.hs
View file @
5d2efe0d
...
@@ -36,10 +36,9 @@ import Gargantext.Database.Query.Table.Node.Error (HasNodeError(..))
...
@@ -36,10 +36,9 @@ import Gargantext.Database.Query.Table.Node.Error (HasNodeError(..))
import
Gargantext.Prelude
import
Gargantext.Prelude
import
Gargantext.Utils.Jobs
(
serveJobsAPI
,
MonadJobStatus
(
..
))
import
Gargantext.Utils.Jobs
(
serveJobsAPI
,
MonadJobStatus
(
..
))
import
Servant.Server.Generic
(
AsServerT
)
import
Servant.Server.Generic
(
AsServerT
)
import
Gargantext.API.Admin.Types
(
HasSettings
)
------------------------------------------------------------------------
------------------------------------------------------------------------
postNode
::
(
HasNodeError
err
,
HasSettings
env
,
CE
.
HasCentralExchangeNotification
env
)
postNode
::
(
HasNodeError
err
,
CE
.
HasCentralExchangeNotification
env
)
=>
AuthenticatedUser
=>
AuthenticatedUser
-- ^ The logged-in user
-- ^ The logged-in user
->
NodeId
->
NodeId
...
@@ -64,7 +63,7 @@ postNodeAsyncAPI authenticatedUser nId = Named.PostNodeAsyncAPI $ AsyncJobs $
...
@@ -64,7 +63,7 @@ postNodeAsyncAPI authenticatedUser nId = Named.PostNodeAsyncAPI $ AsyncJobs $
serveJobsAPI
NewNodeJob
$
\
jHandle
p
->
postNodeAsync
authenticatedUser
nId
p
jHandle
serveJobsAPI
NewNodeJob
$
\
jHandle
p
->
postNodeAsync
authenticatedUser
nId
p
jHandle
------------------------------------------------------------------------
------------------------------------------------------------------------
postNodeAsync
::
(
FlowCmdM
env
err
m
,
MonadJobStatus
m
,
HasSettings
env
,
CE
.
HasCentralExchangeNotification
env
)
postNodeAsync
::
(
FlowCmdM
env
err
m
,
MonadJobStatus
m
,
CE
.
HasCentralExchangeNotification
env
)
=>
AuthenticatedUser
=>
AuthenticatedUser
-- ^ The logged in user
-- ^ The logged in user
->
NodeId
->
NodeId
...
...
src/Gargantext/API/Node/Share.hs
View file @
5d2efe0d
...
@@ -33,7 +33,6 @@ import Gargantext.Database.Query.Table.Node.Error (HasNodeError(..))
...
@@ -33,7 +33,6 @@ import Gargantext.Database.Query.Table.Node.Error (HasNodeError(..))
import
Gargantext.Database.Query.Tree
(
findNodesWithType
)
import
Gargantext.Database.Query.Tree
(
findNodesWithType
)
import
Gargantext.Prelude
import
Gargantext.Prelude
import
Servant.Server.Generic
(
AsServerT
)
import
Servant.Server.Generic
(
AsServerT
)
import
Gargantext.API.Admin.Types
(
HasSettings
)
------------------------------------------------------------------------
------------------------------------------------------------------------
-- TODO permission
-- TODO permission
...
@@ -42,7 +41,6 @@ import Gargantext.API.Admin.Types (HasSettings)
...
@@ -42,7 +41,6 @@ import Gargantext.API.Admin.Types (HasSettings)
api
::
(
HasNodeError
err
api
::
(
HasNodeError
err
,
HasNLPServer
env
,
HasNLPServer
env
,
CmdRandom
env
err
m
,
CmdRandom
env
err
m
,
HasSettings
env
,
HasCentralExchangeNotification
env
)
,
HasCentralExchangeNotification
env
)
=>
User
=>
User
->
NodeId
->
NodeId
...
...
src/Gargantext/API/Node/Update.hs
View file @
5d2efe0d
...
@@ -18,7 +18,6 @@ import Control.Lens (view)
...
@@ -18,7 +18,6 @@ import Control.Lens (view)
import
Data.Set
qualified
as
Set
import
Data.Set
qualified
as
Set
import
Gargantext.API.Admin.EnvTypes
(
GargJob
(
..
),
Env
)
import
Gargantext.API.Admin.EnvTypes
(
GargJob
(
..
),
Env
)
import
Gargantext.API.Admin.Orchestrator.Types
(
AsyncJobs
(
..
))
import
Gargantext.API.Admin.Orchestrator.Types
(
AsyncJobs
(
..
))
import
Gargantext.API.Admin.Types
(
HasSettings
)
import
Gargantext.API.Errors.Types
(
BackendInternalError
)
import
Gargantext.API.Errors.Types
(
BackendInternalError
)
import
Gargantext.API.Metrics
qualified
as
Metrics
import
Gargantext.API.Metrics
qualified
as
Metrics
import
Gargantext.API.Ngrams.Types
qualified
as
NgramsTypes
import
Gargantext.API.Ngrams.Types
qualified
as
NgramsTypes
...
@@ -52,7 +51,6 @@ api nId = Named.UpdateAPI $ AsyncJobs $
...
@@ -52,7 +51,6 @@ api nId = Named.UpdateAPI $ AsyncJobs $
updateNode
nId
p
jHandle
updateNode
nId
p
jHandle
updateNode
::
(
HasNodeStory
env
err
m
updateNode
::
(
HasNodeStory
env
err
m
,
HasSettings
env
,
MonadJobStatus
m
,
MonadJobStatus
m
,
MonadLogger
m
,
MonadLogger
m
)
)
...
...
src/Gargantext/API/Prelude.hs
View file @
5d2efe0d
...
@@ -24,7 +24,6 @@ import Control.Lens ((#))
...
@@ -24,7 +24,6 @@ import Control.Lens ((#))
import
Data.Aeson.Types
import
Data.Aeson.Types
import
Gargantext.API.Admin.Auth.Types
(
AuthenticationError
)
import
Gargantext.API.Admin.Auth.Types
(
AuthenticationError
)
import
Gargantext.API.Admin.Orchestrator.Types
import
Gargantext.API.Admin.Orchestrator.Types
import
Gargantext.API.Admin.Types
import
Gargantext.API.Errors.Class
import
Gargantext.API.Errors.Class
import
Gargantext.Core.AsyncUpdates.CentralExchange.Types
(
HasCentralExchangeNotification
)
import
Gargantext.Core.AsyncUpdates.CentralExchange.Types
(
HasCentralExchangeNotification
)
import
Gargantext.Core.Config
(
HasConfig
)
import
Gargantext.Core.Config
(
HasConfig
)
...
@@ -49,7 +48,6 @@ type HasJobEnv' env = HasJobEnv env JobLog JobLog
...
@@ -49,7 +48,6 @@ type HasJobEnv' env = HasJobEnv env JobLog JobLog
type
EnvC
env
=
type
EnvC
env
=
(
HasConnectionPool
env
(
HasConnectionPool
env
,
HasSettings
env
-- TODO rename HasDbSettings
,
HasJobEnv
env
JobLog
JobLog
,
HasJobEnv
env
JobLog
JobLog
,
HasConfig
env
,
HasConfig
env
,
HasNodeStoryEnv
env
,
HasNodeStoryEnv
env
...
@@ -97,7 +95,6 @@ type GargNoServer t =
...
@@ -97,7 +95,6 @@ type GargNoServer t =
type
GargNoServer'
env
err
m
=
type
GargNoServer'
env
err
m
=
(
CmdM
env
err
m
(
CmdM
env
err
m
,
HasNodeStory
env
err
m
,
HasNodeStory
env
err
m
,
HasSettings
env
,
HasNodeError
err
,
HasNodeError
err
)
)
...
...
src/Gargantext/API/Server/Named/Ngrams.hs
View file @
5d2efe0d
...
@@ -12,7 +12,6 @@ import Gargantext.API.Admin.Auth (withNamedAccess)
...
@@ -12,7 +12,6 @@ import Gargantext.API.Admin.Auth (withNamedAccess)
import
Gargantext.API.Admin.Auth.Types
(
AuthenticatedUser
,
PathId
(
..
))
import
Gargantext.API.Admin.Auth.Types
(
AuthenticatedUser
,
PathId
(
..
))
import
Gargantext.API.Admin.EnvTypes
import
Gargantext.API.Admin.EnvTypes
import
Gargantext.API.Admin.Orchestrator.Types
(
AsyncJobs
(
..
))
import
Gargantext.API.Admin.Orchestrator.Types
(
AsyncJobs
(
..
))
import
Gargantext.API.Admin.Types
(
HasSettings
)
import
Gargantext.API.Errors.Types
(
BackendInternalError
)
import
Gargantext.API.Errors.Types
(
BackendInternalError
)
import
Gargantext.API.Metrics
qualified
as
Metrics
import
Gargantext.API.Metrics
qualified
as
Metrics
import
Gargantext.API.Ngrams
import
Gargantext.API.Ngrams
...
@@ -72,7 +71,6 @@ apiNgramsAsync _dId = Named.TableNgramsAsyncAPI $ AsyncJobs $
...
@@ -72,7 +71,6 @@ apiNgramsAsync _dId = Named.TableNgramsAsyncAPI $ AsyncJobs $
tableNgramsPostChartsAsync
::
(
HasNodeStory
env
err
m
tableNgramsPostChartsAsync
::
(
HasNodeStory
env
err
m
,
HasSettings
env
,
MonadJobStatus
m
)
,
MonadJobStatus
m
)
=>
UpdateTableNgramsCharts
=>
UpdateTableNgramsCharts
->
JobHandle
m
->
JobHandle
m
...
...
src/Gargantext/Core/AsyncUpdates/Dispatcher/Types.hs
View file @
5d2efe0d
...
@@ -31,7 +31,6 @@ import DeferredFolds.UnfoldlM qualified as UnfoldlM
...
@@ -31,7 +31,6 @@ import DeferredFolds.UnfoldlM qualified as UnfoldlM
import
Data.UUID.V4
as
UUID
import
Data.UUID.V4
as
UUID
import
Gargantext.API.Admin.Auth.Types
(
AuthenticatedUser
(
_auth_user_id
))
import
Gargantext.API.Admin.Auth.Types
(
AuthenticatedUser
(
_auth_user_id
))
import
Gargantext.API.Admin.Orchestrator.Types
(
JobLog
)
import
Gargantext.API.Admin.Orchestrator.Types
(
JobLog
)
import
Gargantext.API.Admin.Types
(
Settings
)
import
Gargantext.API.Prelude
(
IsGargServer
)
import
Gargantext.API.Prelude
(
IsGargServer
)
import
Gargantext.Core.AsyncUpdates.CentralExchange.Types
qualified
as
CETypes
import
Gargantext.Core.AsyncUpdates.CentralExchange.Types
qualified
as
CETypes
import
Gargantext.Core.Types
(
NodeId
,
UserId
)
import
Gargantext.Core.Types
(
NodeId
,
UserId
)
...
...
src/Gargantext/Core/Config/Types.hs
View file @
5d2efe0d
...
@@ -17,6 +17,7 @@ module Gargantext.Core.Config.Types
...
@@ -17,6 +17,7 @@ module Gargantext.Core.Config.Types
(
APIsConfig
(
..
)
(
APIsConfig
(
..
)
,
ac_pubmed_api_key
,
ac_pubmed_api_key
,
ac_epo_api_url
,
ac_epo_api_url
,
ac_scrapyd_url
,
CORSOrigin
(
..
)
,
CORSOrigin
(
..
)
,
CORSSettings
(
..
)
,
CORSSettings
(
..
)
,
FramesConfig
(
..
)
,
FramesConfig
(
..
)
...
@@ -299,18 +300,25 @@ makeLenses ''JobsConfig
...
@@ -299,18 +300,25 @@ makeLenses ''JobsConfig
data
APIsConfig
=
data
APIsConfig
=
APIsConfig
{
_ac_pubmed_api_key
::
!
Text
APIsConfig
{
_ac_pubmed_api_key
::
!
Text
,
_ac_epo_api_url
::
!
Text
}
,
_ac_epo_api_url
::
!
Text
,
_ac_scrapyd_url
::
!
BaseUrl
}
deriving
(
Generic
,
Show
)
deriving
(
Generic
,
Show
)
instance
FromValue
APIsConfig
where
instance
FromValue
APIsConfig
where
fromValue
=
parseTableFromValue
$
do
fromValue
=
parseTableFromValue
$
do
_ac_pubmed_api_key
<-
reqKeyOf
"pubmed"
$
parseTableFromValue
$
reqKey
"api_key"
_ac_pubmed_api_key
<-
reqKeyOf
"pubmed"
$
parseTableFromValue
$
reqKey
"api_key"
_ac_epo_api_url
<-
reqKeyOf
"epo"
$
parseTableFromValue
$
reqKey
"api_url"
_ac_epo_api_url
<-
reqKeyOf
"epo"
$
parseTableFromValue
$
reqKey
"api_url"
scrapyd_url
<-
reqKeyOf
"scrapyd"
$
parseTableFromValue
$
reqKey
"url"
_ac_scrapyd_url
<-
case
parseBaseUrl
(
T
.
unpack
scrapyd_url
)
of
Nothing
->
fail
$
"Cannot parse scrapyd base url for: "
<>
T
.
unpack
scrapyd_url
Just
b
->
return
b
return
$
APIsConfig
{
..
}
return
$
APIsConfig
{
..
}
instance
ToValue
APIsConfig
where
instance
ToValue
APIsConfig
where
toValue
=
defaultTableToValue
toValue
=
defaultTableToValue
instance
ToTable
APIsConfig
where
instance
ToTable
APIsConfig
where
toTable
(
APIsConfig
{
..
})
=
table
[
"pubmed"
.=
table
[
"api_key"
.=
_ac_pubmed_api_key
]
toTable
(
APIsConfig
{
..
})
=
table
[
"pubmed"
.=
table
[
"api_key"
.=
_ac_pubmed_api_key
]
,
"epo"
.=
table
[
"api_url"
.=
_ac_epo_api_url
]
,
"epo"
.=
table
[
"api_url"
.=
_ac_epo_api_url
]
,
"scrapyd"
.=
table
[
"url"
.=
showBaseUrl
_ac_scrapyd_url
]
]
]
makeLenses
''
A
PIsConfig
makeLenses
''
A
PIsConfig
...
...
src/Gargantext/Core/Viz/Graph/API.hs
View file @
5d2efe0d
...
@@ -21,7 +21,6 @@ module Gargantext.Core.Viz.Graph.API
...
@@ -21,7 +21,6 @@ module Gargantext.Core.Viz.Graph.API
import
Control.Lens
(
set
,
_Just
,
(
^?
),
at
)
import
Control.Lens
(
set
,
_Just
,
(
^?
),
at
)
import
Data.HashMap.Strict
qualified
as
HashMap
import
Data.HashMap.Strict
qualified
as
HashMap
import
Gargantext.API.Admin.EnvTypes
(
GargJob
(
..
),
Env
)
import
Gargantext.API.Admin.EnvTypes
(
GargJob
(
..
),
Env
)
import
Gargantext.API.Admin.Types
(
HasSettings
)
import
Gargantext.API.Errors.Types
(
BackendInternalError
)
import
Gargantext.API.Errors.Types
(
BackendInternalError
)
import
Gargantext.API.Ngrams.Tools
import
Gargantext.API.Ngrams.Tools
import
Gargantext.API.Prelude
(
GargM
)
import
Gargantext.API.Prelude
(
GargM
)
...
@@ -267,7 +266,7 @@ recomputeVersions :: HasNodeStory env err m
...
@@ -267,7 +266,7 @@ recomputeVersions :: HasNodeStory env err m
recomputeVersions
nId
=
recomputeGraph
nId
Spinglass
BridgenessMethod_Basic
Nothing
Nothing
NgramsTerms
NgramsTerms
False
recomputeVersions
nId
=
recomputeGraph
nId
Spinglass
BridgenessMethod_Basic
Nothing
Nothing
NgramsTerms
NgramsTerms
False
------------------------------------------------------------
------------------------------------------------------------
graphClone
::
(
HasNodeError
err
,
HasSettings
env
)
graphClone
::
(
HasNodeError
err
)
=>
UserId
=>
UserId
->
NodeId
->
NodeId
->
HyperdataGraphAPI
->
HyperdataGraphAPI
...
...
src/Gargantext/Database/Action/Flow.hs
View file @
5d2efe0d
...
@@ -112,7 +112,6 @@ import PUBMED.Types qualified as PUBMED
...
@@ -112,7 +112,6 @@ import PUBMED.Types qualified as PUBMED
------------------------------------------------------------------------
------------------------------------------------------------------------
-- Imports for upgrade function
-- Imports for upgrade function
import
Gargantext.Database.Query.Tree.Error
(
HasTreeError
)
import
Gargantext.Database.Query.Tree.Error
(
HasTreeError
)
import
Gargantext.API.Admin.Types
(
HasSettings
)
------------------------------------------------------------------------
------------------------------------------------------------------------
...
@@ -129,7 +128,7 @@ printDataText (DataNew (maybeInt, conduitData)) = do
...
@@ -129,7 +128,7 @@ printDataText (DataNew (maybeInt, conduitData)) = do
putText
$
show
(
maybeInt
,
res
)
putText
$
show
(
maybeInt
,
res
)
-- TODO use the split parameter in config file
-- TODO use the split parameter in config file
getDataText
::
(
HasNodeError
err
,
HasSettings
env
)
getDataText
::
(
HasNodeError
err
)
=>
DataOrigin
=>
DataOrigin
->
TermType
Lang
->
TermType
Lang
->
API
.
RawQuery
->
API
.
RawQuery
...
@@ -146,7 +145,7 @@ getDataText (InternalOrigin _) la q _ _ _li = do
...
@@ -146,7 +145,7 @@ getDataText (InternalOrigin _) la q _ _ _li = do
ids
<-
map
fst
<$>
searchDocInDatabase
cId
(
stem
(
_tt_lang
la
)
GargPorterAlgorithm
$
API
.
getRawQuery
q
)
ids
<-
map
fst
<$>
searchDocInDatabase
cId
(
stem
(
_tt_lang
la
)
GargPorterAlgorithm
$
API
.
getRawQuery
q
)
pure
$
Right
$
DataOld
ids
pure
$
Right
$
DataOld
ids
getDataText_Debug
::
(
HasNodeError
err
,
HasSettings
env
)
getDataText_Debug
::
(
HasNodeError
err
)
=>
DataOrigin
=>
DataOrigin
->
TermType
Lang
->
TermType
Lang
->
API
.
RawQuery
->
API
.
RawQuery
...
@@ -168,7 +167,6 @@ flowDataText :: forall env err m.
...
@@ -168,7 +167,6 @@ flowDataText :: forall env err m.
,
HasTreeError
err
,
HasTreeError
err
,
HasValidationError
err
,
HasValidationError
err
,
MonadJobStatus
m
,
MonadJobStatus
m
,
HasSettings
env
,
HasCentralExchangeNotification
env
,
HasCentralExchangeNotification
env
)
)
=>
User
=>
User
...
@@ -199,7 +197,6 @@ flowAnnuaire :: ( DbCmd' env err m
...
@@ -199,7 +197,6 @@ flowAnnuaire :: ( DbCmd' env err m
,
HasTreeError
err
,
HasTreeError
err
,
HasValidationError
err
,
HasValidationError
err
,
MonadJobStatus
m
,
MonadJobStatus
m
,
HasSettings
env
,
HasCentralExchangeNotification
env
)
,
HasCentralExchangeNotification
env
)
=>
MkCorpusUser
=>
MkCorpusUser
->
TermType
Lang
->
TermType
Lang
...
@@ -219,7 +216,6 @@ flowCorpusFile :: ( DbCmd' env err m
...
@@ -219,7 +216,6 @@ flowCorpusFile :: ( DbCmd' env err m
,
HasTreeError
err
,
HasTreeError
err
,
HasValidationError
err
,
HasValidationError
err
,
MonadJobStatus
m
,
MonadJobStatus
m
,
HasSettings
env
,
HasCentralExchangeNotification
env
)
,
HasCentralExchangeNotification
env
)
=>
MkCorpusUser
=>
MkCorpusUser
->
Limit
-- Limit the number of docs (for dev purpose)
->
Limit
-- Limit the number of docs (for dev purpose)
...
@@ -250,7 +246,6 @@ flowCorpus :: ( DbCmd' env err m
...
@@ -250,7 +246,6 @@ flowCorpus :: ( DbCmd' env err m
,
HasValidationError
err
,
HasValidationError
err
,
FlowCorpus
a
,
FlowCorpus
a
,
MonadJobStatus
m
,
MonadJobStatus
m
,
HasSettings
env
,
HasCentralExchangeNotification
env
)
,
HasCentralExchangeNotification
env
)
=>
MkCorpusUser
=>
MkCorpusUser
->
TermType
Lang
->
TermType
Lang
...
@@ -271,7 +266,6 @@ flow :: forall env err m a c.
...
@@ -271,7 +266,6 @@ flow :: forall env err m a c.
,
FlowCorpus
a
,
FlowCorpus
a
,
MkCorpus
c
,
MkCorpus
c
,
MonadJobStatus
m
,
MonadJobStatus
m
,
HasSettings
env
,
HasCentralExchangeNotification
env
,
HasCentralExchangeNotification
env
)
)
=>
Maybe
c
=>
Maybe
c
...
@@ -309,7 +303,6 @@ addDocumentsToHyperCorpus :: ( DbCmd' env err m
...
@@ -309,7 +303,6 @@ addDocumentsToHyperCorpus :: ( DbCmd' env err m
,
HasNodeError
err
,
HasNodeError
err
,
FlowCorpus
document
,
FlowCorpus
document
,
MkCorpus
corpus
,
MkCorpus
corpus
,
HasSettings
env
)
)
=>
NLPServerConfig
=>
NLPServerConfig
->
Maybe
corpus
->
Maybe
corpus
...
@@ -323,7 +316,7 @@ addDocumentsToHyperCorpus ncs mb_hyper la corpusId docs = do
...
@@ -323,7 +316,7 @@ addDocumentsToHyperCorpus ncs mb_hyper la corpusId docs = do
pure
ids
pure
ids
------------------------------------------------------------------------
------------------------------------------------------------------------
createNodes
::
(
DbCmd'
env
err
m
,
HasNodeError
err
,
HasSettings
env
createNodes
::
(
DbCmd'
env
err
m
,
HasNodeError
err
,
MkCorpus
c
,
MkCorpus
c
,
HasCentralExchangeNotification
env
,
HasCentralExchangeNotification
env
)
)
...
@@ -356,7 +349,6 @@ flowCorpusUser :: ( HasNodeError err
...
@@ -356,7 +349,6 @@ flowCorpusUser :: ( HasNodeError err
,
HasTreeError
err
,
HasTreeError
err
,
HasNodeStory
env
err
m
,
HasNodeStory
env
err
m
,
MkCorpus
c
,
MkCorpus
c
,
HasSettings
env
)
)
=>
Lang
=>
Lang
->
User
->
User
...
@@ -386,7 +378,6 @@ buildSocialList :: ( HasNodeError err
...
@@ -386,7 +378,6 @@ buildSocialList :: ( HasNodeError err
,
HasTreeError
err
,
HasTreeError
err
,
HasNodeStory
env
err
m
,
HasNodeStory
env
err
m
,
MkCorpus
c
,
MkCorpus
c
,
HasSettings
env
)
)
=>
Lang
=>
Lang
->
User
->
User
...
@@ -422,7 +413,6 @@ insertMasterDocs :: ( DbCmd' env err m
...
@@ -422,7 +413,6 @@ insertMasterDocs :: ( DbCmd' env err m
,
HasNodeError
err
,
HasNodeError
err
,
FlowCorpus
a
,
FlowCorpus
a
,
MkCorpus
c
,
MkCorpus
c
,
HasSettings
env
)
)
=>
NLPServerConfig
=>
NLPServerConfig
->
Maybe
c
->
Maybe
c
...
...
src/Gargantext/Database/Action/User/New.hs
View file @
5d2efe0d
...
@@ -29,7 +29,6 @@ import Control.Lens (view)
...
@@ -29,7 +29,6 @@ import Control.Lens (view)
import
Control.Monad.Random
import
Control.Monad.Random
import
Data.Text
(
splitOn
)
import
Data.Text
(
splitOn
)
import
Data.Text
qualified
as
Text
import
Data.Text
qualified
as
Text
import
Gargantext.API.Admin.Types
(
HasSettings
)
import
Gargantext.Core.Mail
import
Gargantext.Core.Mail
import
Gargantext.Core.Mail.Types
(
HasMail
,
mailSettings
)
import
Gargantext.Core.Mail.Types
(
HasMail
,
mailSettings
)
import
Gargantext.Core.Types.Individu
import
Gargantext.Core.Types.Individu
...
@@ -46,7 +45,7 @@ import qualified Data.List.NonEmpty as NE
...
@@ -46,7 +45,7 @@ import qualified Data.List.NonEmpty as NE
------------------------------------------------------------------------
------------------------------------------------------------------------
-- | Creates a new 'User' from the input 'EmailAddress', which needs to
-- | Creates a new 'User' from the input 'EmailAddress', which needs to
-- be valid (i.e. a valid username needs to be inferred via 'guessUsername').
-- be valid (i.e. a valid username needs to be inferred via 'guessUsername').
newUser
::
(
CmdM
env
err
m
,
MonadRandom
m
,
HasNodeError
err
,
HasMail
env
,
HasSettings
env
)
newUser
::
(
CmdM
env
err
m
,
MonadRandom
m
,
HasNodeError
err
,
HasMail
env
)
=>
EmailAddress
=>
EmailAddress
->
m
UserId
->
m
UserId
newUser
emailAddress
=
do
newUser
emailAddress
=
do
...
@@ -61,7 +60,7 @@ newUser emailAddress = do
...
@@ -61,7 +60,7 @@ newUser emailAddress = do
-- This is an internal function and as such it /doesn't/ send out any email
-- This is an internal function and as such it /doesn't/ send out any email
-- notification, and thus lives in the 'DbCmd' effect stack. You may want to
-- notification, and thus lives in the 'DbCmd' effect stack. You may want to
-- use 'newUser' instead for standard Gargantext code.
-- use 'newUser' instead for standard Gargantext code.
new_user
::
(
HasNodeError
err
,
HasSettings
env
)
new_user
::
(
HasNodeError
err
)
=>
NewUser
GargPassword
=>
NewUser
GargPassword
->
DBCmd'
env
err
UserId
->
DBCmd'
env
err
UserId
new_user
rq
=
do
new_user
rq
=
do
...
@@ -73,7 +72,7 @@ new_user rq = do
...
@@ -73,7 +72,7 @@ new_user rq = do
-- This is an internal function and as such it /doesn't/ send out any email
-- This is an internal function and as such it /doesn't/ send out any email
-- notification, and thus lives in the 'DbCmd' effect stack. You may want to
-- notification, and thus lives in the 'DbCmd' effect stack. You may want to
-- use 'newUsers' instead for standard Gargantext code.
-- use 'newUsers' instead for standard Gargantext code.
new_users
::
(
HasNodeError
err
,
HasSettings
env
)
new_users
::
(
HasNodeError
err
)
=>
NonEmpty
(
NewUser
GargPassword
)
=>
NonEmpty
(
NewUser
GargPassword
)
-- ^ A list of users to create.
-- ^ A list of users to create.
->
DBCmd'
env
err
(
NonEmpty
UserId
)
->
DBCmd'
env
err
(
NonEmpty
UserId
)
...
@@ -83,7 +82,7 @@ new_users us = do
...
@@ -83,7 +82,7 @@ new_users us = do
mapM
(
fmap
fst
.
getOrMkRoot
)
$
NE
.
map
(
\
u
->
UserName
(
_nu_username
u
))
us
mapM
(
fmap
fst
.
getOrMkRoot
)
$
NE
.
map
(
\
u
->
UserName
(
_nu_username
u
))
us
------------------------------------------------------------------------
------------------------------------------------------------------------
newUsers
::
(
CmdM
env
err
m
,
MonadRandom
m
,
HasNodeError
err
,
HasMail
env
,
HasSettings
env
)
newUsers
::
(
CmdM
env
err
m
,
MonadRandom
m
,
HasNodeError
err
,
HasMail
env
)
=>
NonEmpty
EmailAddress
=>
NonEmpty
EmailAddress
->
m
(
NonEmpty
UserId
)
->
m
(
NonEmpty
UserId
)
newUsers
us
=
do
newUsers
us
=
do
...
@@ -109,7 +108,7 @@ guessUserName n = case splitOn "@" n of
...
@@ -109,7 +108,7 @@ guessUserName n = case splitOn "@" n of
_
->
Nothing
_
->
Nothing
------------------------------------------------------------------------
------------------------------------------------------------------------
newUsers'
::
(
HasNodeError
err
,
HasSettings
env
)
newUsers'
::
(
HasNodeError
err
)
=>
MailConfig
->
NonEmpty
(
NewUser
GargPassword
)
->
DBCmd'
env
err
(
NonEmpty
UserId
)
=>
MailConfig
->
NonEmpty
(
NewUser
GargPassword
)
->
DBCmd'
env
err
(
NonEmpty
UserId
)
newUsers'
cfg
us
=
do
newUsers'
cfg
us
=
do
us'
<-
liftBase
$
mapM
toUserHash
us
us'
<-
liftBase
$
mapM
toUserHash
us
...
...
src/Gargantext/Database/Query/Tree/Root.hs
View file @
5d2efe0d
...
@@ -30,7 +30,6 @@ import Gargantext.Database.Schema.Node (NodePoly(..), NodeRead, queryNodeTable)
...
@@ -30,7 +30,6 @@ import Gargantext.Database.Schema.Node (NodePoly(..), NodeRead, queryNodeTable)
import
Gargantext.Prelude
import
Gargantext.Prelude
import
Opaleye
(
restrict
,
(
.==
),
Select
)
import
Opaleye
(
restrict
,
(
.==
),
Select
)
import
Opaleye.SqlTypes
(
sqlStrictText
,
sqlInt4
)
import
Opaleye.SqlTypes
(
sqlStrictText
,
sqlInt4
)
import
Gargantext.API.Admin.Types
(
HasSettings
)
getRootId
::
(
HasNodeError
err
)
=>
User
->
DBCmd
err
NodeId
getRootId
::
(
HasNodeError
err
)
=>
User
->
DBCmd
err
NodeId
...
@@ -43,7 +42,7 @@ getRootId u = do
...
@@ -43,7 +42,7 @@ getRootId u = do
getRoot
::
User
->
DBCmd
err
[
Node
HyperdataUser
]
getRoot
::
User
->
DBCmd
err
[
Node
HyperdataUser
]
getRoot
=
runOpaQuery
.
selectRoot
getRoot
=
runOpaQuery
.
selectRoot
getOrMkRoot
::
(
HasNodeError
err
,
HasSettings
env
)
getOrMkRoot
::
(
HasNodeError
err
)
=>
User
=>
User
->
DBCmd'
env
err
(
UserId
,
RootId
)
->
DBCmd'
env
err
(
UserId
,
RootId
)
getOrMkRoot
user
=
do
getOrMkRoot
user
=
do
...
@@ -78,7 +77,7 @@ userFromMkCorpusUser (MkCorpusUserNormalCorpusIds u _cids) = u
...
@@ -78,7 +77,7 @@ userFromMkCorpusUser (MkCorpusUserNormalCorpusIds u _cids) = u
userFromMkCorpusUser
(
MkCorpusUserNormalCorpusName
u
_cname
)
=
u
userFromMkCorpusUser
(
MkCorpusUserNormalCorpusName
u
_cname
)
=
u
getOrMkRootWithCorpus
::
(
HasNodeError
err
,
MkCorpus
a
,
HasSettings
env
)
getOrMkRootWithCorpus
::
(
HasNodeError
err
,
MkCorpus
a
)
=>
MkCorpusUser
=>
MkCorpusUser
->
Maybe
a
->
Maybe
a
->
DBCmd'
env
err
(
UserId
,
RootId
,
CorpusId
)
->
DBCmd'
env
err
(
UserId
,
RootId
,
CorpusId
)
...
@@ -120,7 +119,7 @@ mkCorpus cName c rootId userId = do
...
@@ -120,7 +119,7 @@ mkCorpus cName c rootId userId = do
pure
(
userId
,
rootId
,
corpusId
)
pure
(
userId
,
rootId
,
corpusId
)
mkRoot
::
(
HasNodeError
err
,
HasSettings
env
)
mkRoot
::
(
HasNodeError
err
)
=>
User
=>
User
->
DBCmd'
env
err
[
RootId
]
->
DBCmd'
env
err
[
RootId
]
mkRoot
user
=
do
mkRoot
user
=
do
...
...
test-data/test_config.toml
View file @
5d2efe0d
...
@@ -28,6 +28,10 @@ api_key = "no_key"
...
@@ -28,6 +28,10 @@ api_key = "no_key"
[apis.epo]
[apis.epo]
api_url
=
""
api_url
=
""
[apis.scrapyd]
url
=
"http://localhost:6800"
[external]
[external]
[external.frames]
[external.frames]
write_url
=
"URL_TO_CHANGE"
write_url
=
"URL_TO_CHANGE"
...
...
test/Test/API/Setup.hs
View file @
5d2efe0d
...
@@ -54,7 +54,6 @@ newTestEnv :: TestEnv -> Logger (GargM Env BackendInternalError) -> Warp.Port ->
...
@@ -54,7 +54,6 @@ newTestEnv :: TestEnv -> Logger (GargM Env BackendInternalError) -> Warp.Port ->
newTestEnv
testEnv
logger
port
=
do
newTestEnv
testEnv
logger
port
=
do
tomlFile
@
(
SettingsFile
sf
)
<-
fakeTomlPath
tomlFile
@
(
SettingsFile
sf
)
<-
fakeTomlPath
!
manager_env
<-
newTlsManager
!
manager_env
<-
newTlsManager
let
!
settings'
=
devSettings
!
config_env
<-
readConfig
tomlFile
<&>
(
gc_frontend_config
.
fc_appPort
)
.~
port
!
config_env
<-
readConfig
tomlFile
<&>
(
gc_frontend_config
.
fc_appPort
)
.~
port
prios
<-
withLogger
()
$
\
ioLogger
->
Jobs
.
readPrios
ioLogger
(
sf
<>
".jobs"
)
prios
<-
withLogger
()
$
\
ioLogger
->
Jobs
.
readPrios
ioLogger
(
sf
<>
".jobs"
)
...
@@ -77,8 +76,7 @@ newTestEnv testEnv logger port = do
...
@@ -77,8 +76,7 @@ newTestEnv testEnv logger port = do
-- !dispatcher <- D.dispatcher
-- !dispatcher <- D.dispatcher
pure
$
Env
pure
$
Env
{
_env_settings
=
settings'
{
_env_logger
=
logger
,
_env_logger
=
logger
,
_env_pool
=
pool
,
_env_pool
=
pool
,
_env_nodeStory
=
nodeStory_env
,
_env_nodeStory
=
nodeStory_env
,
_env_manager
=
manager_env
,
_env_manager
=
manager_env
...
...
test/Test/Database/Setup.hs
View file @
5d2efe0d
...
@@ -76,14 +76,12 @@ setup = do
...
@@ -76,14 +76,12 @@ setup = do
bootstrapDB
db
pool
gargConfig
bootstrapDB
db
pool
gargConfig
ugen
<-
emptyCounter
ugen
<-
emptyCounter
test_nodeStory
<-
fromDBNodeStoryEnv
pool
test_nodeStory
<-
fromDBNodeStoryEnv
pool
let
stgs
=
devSettings
withLoggerHoisted
Mock
$
\
logger
->
do
withLoggerHoisted
Mock
$
\
logger
->
do
pure
$
TestEnv
{
test_db
=
DBHandle
pool
db
pure
$
TestEnv
{
test_db
=
DBHandle
pool
db
,
test_config
=
gargConfig
,
test_config
=
gargConfig
,
test_nodeStory
,
test_nodeStory
,
test_usernameGen
=
ugen
,
test_usernameGen
=
ugen
,
test_logger
=
logger
,
test_logger
=
logger
,
test_settings
=
stgs
}
}
withTestDB
::
(
TestEnv
->
IO
()
)
->
IO
()
withTestDB
::
(
TestEnv
->
IO
()
)
->
IO
()
...
...
test/Test/Database/Types.hs
View file @
5d2efe0d
...
@@ -28,7 +28,6 @@ import Database.Postgres.Temp qualified as Tmp
...
@@ -28,7 +28,6 @@ import Database.Postgres.Temp qualified as Tmp
import
Gargantext
hiding
(
to
)
import
Gargantext
hiding
(
to
)
import
Gargantext.API.Admin.EnvTypes
import
Gargantext.API.Admin.EnvTypes
import
Gargantext.API.Admin.Orchestrator.Types
import
Gargantext.API.Admin.Orchestrator.Types
import
Gargantext.API.Admin.Types
import
Gargantext.API.Errors.Types
import
Gargantext.API.Errors.Types
import
Gargantext.API.Prelude
import
Gargantext.API.Prelude
import
Gargantext.Core.Config
(
HasConfig
(
..
))
import
Gargantext.Core.Config
(
HasConfig
(
..
))
...
@@ -63,7 +62,6 @@ data TestEnv = TestEnv {
...
@@ -63,7 +62,6 @@ data TestEnv = TestEnv {
,
test_nodeStory
::
!
NodeStoryEnv
,
test_nodeStory
::
!
NodeStoryEnv
,
test_usernameGen
::
!
Counter
,
test_usernameGen
::
!
Counter
,
test_logger
::
!
(
Logger
(
GargM
TestEnv
BackendInternalError
))
,
test_logger
::
!
(
Logger
(
GargM
TestEnv
BackendInternalError
))
,
test_settings
::
!
Settings
}
}
newtype
TestMonad
a
=
TestMonad
{
runTestMonad
::
ReaderT
TestEnv
IO
a
}
newtype
TestMonad
a
=
TestMonad
{
runTestMonad
::
ReaderT
TestEnv
IO
a
}
...
@@ -107,9 +105,6 @@ instance HasConnectionPool TestEnv where
...
@@ -107,9 +105,6 @@ instance HasConnectionPool TestEnv where
instance
HasConfig
TestEnv
where
instance
HasConfig
TestEnv
where
hasConfig
=
to
test_config
hasConfig
=
to
test_config
instance
HasSettings
TestEnv
where
settings
=
to
test_settings
instance
HasMail
TestEnv
where
instance
HasMail
TestEnv
where
mailSettings
=
to
$
const
(
MailConfig
{
_mc_mail_host
=
"localhost"
mailSettings
=
to
$
const
(
MailConfig
{
_mc_mail_host
=
"localhost"
,
_mc_mail_port
=
25
,
_mc_mail_port
=
25
...
...
test/Test/Utils/Jobs.hs
View file @
5d2efe0d
...
@@ -291,8 +291,7 @@ newTestEnv = do
...
@@ -291,8 +291,7 @@ newTestEnv = do
,
_gc_log_level
=
Prelude
.
error
"gc_log_level not needed, but forced somewhere (check StrictData)"
,
_gc_log_level
=
Prelude
.
error
"gc_log_level not needed, but forced somewhere (check StrictData)"
}
}
pure
$
Env
pure
$
Env
{
_env_settings
=
Prelude
.
error
"env_settings not needed, but forced somewhere (check StrictData)"
{
_env_logger
=
Prelude
.
error
"env_logger not needed, but forced somewhere (check StrictData)"
,
_env_logger
=
Prelude
.
error
"env_logger not needed, but forced somewhere (check StrictData)"
,
_env_pool
=
Prelude
.
error
"env_pool not needed, but forced somewhere (check StrictData)"
,
_env_pool
=
Prelude
.
error
"env_pool not needed, but forced somewhere (check StrictData)"
,
_env_nodeStory
=
Prelude
.
error
"env_nodeStory not needed, but forced somewhere (check StrictData)"
,
_env_nodeStory
=
Prelude
.
error
"env_nodeStory not needed, but forced somewhere (check StrictData)"
,
_env_manager
=
testTlsManager
,
_env_manager
=
testTlsManager
...
...
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