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 =
,
_jc_js_job_timeout
=
_gc_js_job_timeout
,
_jc_js_id_timeout
=
_gc_js_id_timeout
}
,
_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
}
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
{
..
})
=
...
...
bin/gargantext-cli/CLI/Init.hs
View file @
5d2efe0d
...
...
@@ -18,7 +18,6 @@ module CLI.Init where
import
CLI.Parsers
import
CLI.Types
import
Data.List.NonEmpty
qualified
as
NE
import
Gargantext.API.Admin.Types
import
Gargantext.API.Dev
(
withDevEnv
,
runCmdDev
)
import
Gargantext.API.Errors.Types
import
Gargantext.API.Node
()
-- instances only
...
...
@@ -50,18 +49,18 @@ initCLI (InitArgs settingsPath) = do
cfg
<-
readConfig
settingsPath
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
)
NE
.:|
arbitraryNewUsers
)
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
)
-- TODO create all users roots
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
(
masterUserId
,
masterRootId
,
masterCorpusId
)
<-
getOrMkRootWithCorpus
MkCorpusUserMaster
...
...
bin/gargantext-cli/CLI/Invitations.hs
View file @
5d2efe0d
...
...
@@ -16,7 +16,6 @@ module CLI.Invitations where
import
CLI.Parsers
import
CLI.Types
import
Gargantext.API.Admin.Types
import
Gargantext.API.Dev
(
withDevEnv
,
runCmdDev
)
import
Gargantext.API.Errors.Types
import
Gargantext.API.Node
()
-- instances only
...
...
@@ -35,8 +34,7 @@ invitationsCLI :: InvitationsArgs -> IO ()
invitationsCLI
(
InvitationsArgs
settingsPath
user
node_id
email
)
=
do
-- _cfg <- readConfig settingsPath
let
invite
::
(
HasSettings
env
,
CmdRandom
env
BackendInternalError
m
let
invite
::
(
CmdRandom
env
BackendInternalError
m
,
HasNLPServer
env
,
CET
.
HasCentralExchangeNotification
env
)
=>
m
Int
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
[apis.epo]
api_url = EPO_API_URL
[apis.scrapyd]
url = "http://localhost:6800"
[external]
...
...
gargantext.cabal
View file @
5d2efe0d
...
...
@@ -108,7 +108,6 @@ library
Gargantext.API.Admin.EnvTypes
Gargantext.API.Admin.Orchestrator.Types
Gargantext.API.Admin.Settings
Gargantext.API.Admin.Types
Gargantext.API.Auth.PolicyCheck
Gargantext.API.Count.Types
Gargantext.API.Dev
...
...
src/Gargantext/API.hs
View file @
5d2efe0d
...
...
@@ -44,9 +44,8 @@ import Data.Text.Encoding qualified as TE
import
Data.Text.IO
(
putStrLn
)
import
Data.Validity
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.Types
(
FireWall
(
..
))
import
Gargantext.API.Middleware
(
logStdoutDevSanitised
)
import
Gargantext.API.Routes.Named
(
API
)
import
Gargantext.API.Routes.Named.EKG
...
...
src/Gargantext/API/Admin/Auth.hs
View file @
5d2efe0d
...
...
@@ -51,7 +51,6 @@ import Data.UUID.V4 (nextRandom)
import
Gargantext.API.Admin.Auth.Types
import
Gargantext.API.Admin.EnvTypes
(
GargJob
(
..
),
Env
)
import
Gargantext.API.Admin.Orchestrator.Types
(
AsyncJobs
(
..
))
import
Gargantext.API.Admin.Types
import
Gargantext.API.Auth.PolicyCheck
import
Gargantext.API.Errors
import
Gargantext.API.Prelude
(
authenticationError
,
HasServerError
,
GargServerC
,
_ServerError
,
GargM
,
IsGargServer
)
...
...
@@ -251,7 +250,7 @@ forgotPasswordPost (ForgotPasswordRequest email) = do
-- users' emails
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
forgotPasswordGet
Nothing
=
pure
$
ForgotPasswordGet
""
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
forgotPasswordGetUser
(
UserLight
{
..
})
=
do
-- pick some random password
...
...
src/Gargantext/API/Admin/EnvTypes.hs
View file @
5d2efe0d
...
...
@@ -13,7 +13,6 @@ module Gargantext.API.Admin.EnvTypes (
,
env_config
,
env_logger
,
env_manager
,
env_settings
,
env_self_url
,
env_central_exchange
,
env_dispatcher
...
...
@@ -22,6 +21,7 @@ module Gargantext.API.Admin.EnvTypes (
,
menv_firewall
,
dev_env_logger
,
FireWall
(
..
)
,
MockEnv
(
..
)
,
DevEnv
(
..
)
,
DevJobHandle
(
..
)
...
...
@@ -37,7 +37,6 @@ import Data.Sequence (ViewL(..), viewl)
import
Data.Text
qualified
as
T
import
Database.PostgreSQL.Simple
(
Connection
)
import
Gargantext.API.Admin.Orchestrator.Types
import
Gargantext.API.Admin.Types
import
Gargantext.API.Errors.Types
import
Gargantext.API.Job
import
Gargantext.API.Prelude
(
GargM
,
IsGargServer
)
...
...
@@ -123,8 +122,7 @@ data GargJob
-- 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.
data
Env
=
Env
{
_env_settings
::
~
Settings
,
_env_logger
::
~
(
Logger
(
GargM
Env
BackendInternalError
))
{
_env_logger
::
~
(
Logger
(
GargM
Env
BackendInternalError
))
,
_env_pool
::
~
(
Pool
Connection
)
,
_env_nodeStory
::
~
NodeStoryEnv
,
_env_manager
::
~
Manager
...
...
@@ -155,9 +153,6 @@ instance HasNodeStoryImmediateSaver Env where
instance
HasNodeArchiveStoryImmediateSaver
Env
where
hasNodeArchiveStoryImmediateSaver
=
hasNodeStory
.
nse_archive_saver_immediate
instance
HasSettings
Env
where
settings
=
env_settings
instance
HasJWTSettings
Env
where
jwtSettings
=
env_jwt_settings
...
...
@@ -264,6 +259,8 @@ instance Jobs.MonadJobStatus (GargM Env err) where
addMoreSteps
steps
jh
=
updateJobProgress
jh
(
jobLogAddMore
steps
)
data
FireWall
=
FireWall
{
unFireWall
::
Bool
}
data
MockEnv
=
MockEnv
{
_menv_firewall
::
!
FireWall
}
...
...
@@ -293,8 +290,7 @@ instance HasLogger (GargM DevEnv BackendInternalError) where
logTxt
lgr
lvl
msg
=
logMsg
lgr
lvl
(
FL
.
toLogStr
$
T
.
unpack
msg
)
data
DevEnv
=
DevEnv
{
_dev_env_settings
::
!
Settings
,
_dev_env_config
::
!
GargConfig
{
_dev_env_config
::
!
GargConfig
,
_dev_env_logger
::
!
(
Logger
(
GargM
DevEnv
BackendInternalError
))
,
_dev_env_pool
::
!
(
Pool
Connection
)
,
_dev_env_nodeStory
::
!
NodeStoryEnv
...
...
@@ -342,9 +338,6 @@ instance HasConfig DevEnv where
instance
HasConnectionPool
DevEnv
where
connPool
=
dev_env_pool
instance
HasSettings
DevEnv
where
settings
=
dev_env_settings
instance
HasNodeStoryEnv
DevEnv
where
hasNodeStory
=
dev_env_nodeStory
...
...
src/Gargantext/API/Admin/Settings.hs
View file @
5d2efe0d
...
...
@@ -26,7 +26,6 @@ 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.Types
import
Gargantext.API.Errors.Types
import
Gargantext.API.Prelude
import
Gargantext.Core.AsyncUpdates.CentralExchange
qualified
as
CE
...
...
@@ -52,16 +51,6 @@ import System.IO.Temp (withTempFile)
newtype
IniFile
=
IniFile
{
_IniFile
::
FilePath
}
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
import System.Environment (lookupEnv)
...
...
@@ -164,7 +153,6 @@ readRepoEnv repoDir = do
newEnv
::
Logger
(
GargM
Env
BackendInternalError
)
->
PortNumber
->
SettingsFile
->
IO
Env
newEnv
logger
port
settingsFile
@
(
SettingsFile
sf
)
=
do
!
manager_env
<-
newTlsManager
let
!
settings'
=
devSettings
!
config_env
<-
readConfig
settingsFile
<&>
(
gc_frontend_config
.
fc_appPort
)
.~
port
-- TODO read from 'file'
when
(
port
/=
config_env
^.
gc_frontend_config
.
fc_appPort
)
$
panicTrace
"TODO: conflicting settings of port"
...
...
@@ -193,8 +181,7 @@ newEnv logger port settingsFile@(SettingsFile sf) = do
we want to force them to WHNF to avoid accumulating unnecessary thunks.
-}
pure
$
Env
{
_env_settings
=
settings'
,
_env_logger
=
logger
{
_env_logger
=
logger
,
_env_pool
=
pool
,
_env_nodeStory
=
nodeStory_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)
import
Data.Pool
(
withResource
)
import
Database.PostgreSQL.Simple
qualified
as
PGS
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.Prelude
(
GargM
)
import
Gargantext.Core.Config
(
_gc_database_config
)
...
...
@@ -41,12 +41,10 @@ withDevEnv settingsFile k = withLoggerHoisted Dev $ \logger -> do
--nodeStory_env <- fromDBNodeStoryEnv (_gc_repofilepath cfg)
pool
<-
newPool
(
_gc_database_config
cfg
)
nodeStory_env
<-
fromDBNodeStoryEnv
pool
let
setts
=
devSettings
pure
$
DevEnv
{
_dev_env_pool
=
pool
,
_dev_env_logger
=
logger
,
_dev_env_nodeStory
=
nodeStory_env
,
_dev_env_settings
=
setts
,
_dev_env_config
=
cfg
}
...
...
src/Gargantext/API/Node/Contact.hs
View file @
5d2efe0d
...
...
@@ -22,7 +22,6 @@ import Conduit ( yield )
import
Gargantext.API.Admin.Auth.Types
(
AuthenticatedUser
(
AuthenticatedUser
)
)
import
Gargantext.API.Admin.EnvTypes
(
Env
,
GargJob
(
..
))
import
Gargantext.API.Admin.Orchestrator.Types
(
AsyncJobs
(
..
))
import
Gargantext.API.Admin.Types
(
HasSettings
)
import
Gargantext.API.Errors.Types
(
BackendInternalError
)
import
Gargantext.API.Node
(
nodeNodeAPI
)
import
Gargantext.API.Node.Contact.Types
...
...
@@ -54,7 +53,7 @@ api_async u nId = Named.ContactAsyncAPI $ AsyncJobs $
serveJobsAPI
AddContactJob
$
\
jHandle
p
->
addContact
u
nId
p
jHandle
addContact
::
(
HasSettings
env
,
FlowCmdM
env
err
m
,
MonadJobStatus
m
)
addContact
::
(
FlowCmdM
env
err
m
,
MonadJobStatus
m
)
=>
User
->
NodeId
->
AddContactParams
...
...
src/Gargantext/API/Node/Corpus/New.hs
View file @
5d2efe0d
...
...
@@ -29,7 +29,6 @@ import Data.Text qualified as T
import
Data.Text.Encoding
qualified
as
TE
import
EPO.API.Client.Types
qualified
as
EPO
import
Gargantext.API.Admin.Orchestrator.Types
qualified
as
API
import
Gargantext.API.Admin.Types
(
HasSettings
)
import
Gargantext.API.Ngrams
(
commitStatePatch
,
Versioned
(
..
))
import
Gargantext.API.Node.Corpus.New.Types
(
FileFormat
(
..
),
FileType
(
..
)
)
import
Gargantext.API.Node.Corpus.Searx
(
triggerSearxSearch
)
...
...
@@ -148,7 +147,6 @@ addToCorpusWithQuery :: ( FlowCmdM env err m
,
MonadJobStatus
m
,
HasNodeStoryImmediateSaver
env
,
HasNodeArchiveStoryImmediateSaver
env
,
HasSettings
env
)
=>
User
->
CorpusId
...
...
@@ -222,7 +220,6 @@ addToCorpusWithForm :: ( FlowCmdM env err m
,
MonadJobStatus
m
,
HasNodeStoryImmediateSaver
env
,
HasNodeArchiveStoryImmediateSaver
env
,
HasSettings
env
)
=>
User
->
CorpusId
...
...
@@ -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
->
CorpusId
->
NewWithFile
...
...
src/Gargantext/API/Node/Corpus/Searx.hs
View file @
5d2efe0d
...
...
@@ -21,7 +21,6 @@ import Data.Text qualified as Text
import
Data.Time.Calendar
(
Day
,
toGregorian
)
import
Data.Time.Format
(
defaultTimeLocale
,
formatTime
,
parseTimeM
)
import
Data.Tuple.Select
(
sel1
,
sel2
,
sel3
)
import
Gargantext.API.Admin.Types
(
HasSettings
)
import
Gargantext.Core
(
Lang
(
..
))
import
Gargantext.Core.Config
(
GargConfig
(
..
),
hasConfig
)
import
Gargantext.Core.Config.Types
(
FramesConfig
(
..
))
...
...
@@ -123,7 +122,6 @@ insertSearxResponse :: ( MonadBase IO m
,
HasNodeError
err
,
HasTreeError
err
,
HasValidationError
err
,
HasSettings
env
)
=>
User
->
CorpusId
...
...
@@ -168,7 +166,6 @@ triggerSearxSearch :: ( MonadBase IO m
,
HasTreeError
err
,
HasValidationError
err
,
MonadJobStatus
m
,
HasSettings
env
)
=>
User
->
CorpusId
...
...
src/Gargantext/API/Node/DocumentUpload.hs
View file @
5d2efe0d
...
...
@@ -20,7 +20,6 @@ import Control.Lens (view)
import
Data.Text
qualified
as
T
import
Gargantext.API.Admin.EnvTypes
(
GargJob
(
..
),
Env
)
import
Gargantext.API.Admin.Orchestrator.Types
import
Gargantext.API.Admin.Types
(
HasSettings
)
import
Gargantext.API.Errors.Types
(
BackendInternalError
)
import
Gargantext.API.Node.DocumentUpload.Types
import
Gargantext.API.Prelude
(
GargM
)
...
...
@@ -45,7 +44,7 @@ api nId = Named.DocumentUploadAPI $ AsyncJobs $
serveJobsAPI
UploadDocumentJob
$
\
jHandle
q
->
do
documentUploadAsync
nId
q
jHandle
documentUploadAsync
::
(
FlowCmdM
env
err
m
,
MonadJobStatus
m
,
HasSettings
env
)
documentUploadAsync
::
(
FlowCmdM
env
err
m
,
MonadJobStatus
m
)
=>
NodeId
->
DocumentUpload
->
JobHandle
m
...
...
@@ -56,7 +55,7 @@ documentUploadAsync nId doc jobHandle = do
-- printDebug "documentUploadAsync" docIds
markComplete
jobHandle
documentUpload
::
(
FlowCmdM
env
err
m
,
HasSettings
env
)
documentUpload
::
(
FlowCmdM
env
err
m
)
=>
NodeId
->
DocumentUpload
->
m
[
DocId
]
...
...
src/Gargantext/API/Node/DocumentsFromWriteNodes.hs
View file @
5d2efe0d
...
...
@@ -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.EnvTypes
(
Env
,
GargJob
(
..
))
import
Gargantext.API.Admin.Orchestrator.Types
import
Gargantext.API.Admin.Types
(
HasSettings
)
import
Gargantext.API.Errors.Types
(
BackendInternalError
)
import
Gargantext.API.Ngrams
(
commitStatePatch
,
Versioned
(
..
))
import
Gargantext.API.Node.DocumentsFromWriteNodes.Types
...
...
@@ -55,8 +54,7 @@ api authenticatedUser nId = Named.DocumentsFromWriteNodesAPI $ AsyncJobs $
serveJobsAPI
DocumentFromWriteNodeJob
$
\
jHandle
p
->
documentsFromWriteNodes
authenticatedUser
nId
p
jHandle
documentsFromWriteNodes
::
(
HasSettings
env
,
FlowCmdM
env
err
m
documentsFromWriteNodes
::
(
FlowCmdM
env
err
m
,
MonadJobStatus
m
,
HasNodeStoryImmediateSaver
env
,
HasNodeArchiveStoryImmediateSaver
env
)
...
...
src/Gargantext/API/Node/File.hs
View file @
5d2efe0d
...
...
@@ -22,7 +22,6 @@ import Data.Text qualified as T
import
Gargantext.API.Admin.Auth.Types
(
AuthenticatedUser
,
auth_user_id
)
import
Gargantext.API.Admin.EnvTypes
(
GargJob
(
..
),
Env
)
import
Gargantext.API.Admin.Orchestrator.Types
(
AsyncJobs
(
..
))
import
Gargantext.API.Admin.Types
(
HasSettings
)
import
Gargantext.API.Errors.Types
(
BackendInternalError
)
import
Gargantext.API.Node.File.Types
import
Gargantext.API.Node.Types
(
NewWithFile
(
NewWithFile
)
)
...
...
@@ -41,12 +40,12 @@ import Gargantext.Utils.Jobs (serveJobsAPI, MonadJobStatus(..))
import
Servant
import
Servant.Server.Generic
(
AsServerT
)
fileApi
::
(
HasSettings
env
,
FlowCmdM
env
err
m
)
fileApi
::
(
FlowCmdM
env
err
m
)
=>
NodeId
->
m
(
Headers
'[
S
ervant
.
Header
"Content-Type"
Text
]
BSResponse
)
fileApi
nId
=
fileDownload
nId
fileDownload
::
(
HasSettings
env
,
FlowCmdM
env
err
m
)
fileDownload
::
(
FlowCmdM
env
err
m
)
=>
NodeId
->
m
(
Headers
'[
S
ervant
.
Header
"Content-Type"
Text
]
BSResponse
)
fileDownload
nId
=
do
...
...
@@ -83,7 +82,7 @@ fileAsyncApi authenticatedUser nId = Named.FileAsyncAPI $ AsyncJobs $
addWithFile
authenticatedUser
nId
i
jHandle
addWithFile
::
(
HasSettings
env
,
FlowCmdM
env
err
m
,
MonadJobStatus
m
)
addWithFile
::
(
FlowCmdM
env
err
m
,
MonadJobStatus
m
)
=>
AuthenticatedUser
-- ^ The logged-in user
->
NodeId
...
...
src/Gargantext/API/Node/FrameCalcUpload.hs
View file @
5d2efe0d
...
...
@@ -21,7 +21,6 @@ import Data.Text qualified as T
import
Gargantext.API.Admin.Auth.Types
(
auth_node_id
,
AuthenticatedUser
)
import
Gargantext.API.Admin.EnvTypes
(
GargJob
(
..
),
Env
)
import
Gargantext.API.Admin.Orchestrator.Types
(
AsyncJobs
(
..
))
import
Gargantext.API.Admin.Types
(
HasSettings
)
import
Gargantext.API.Errors.Types
(
BackendInternalError
)
import
Gargantext.API.Node.Corpus.New
(
addToCorpusWithForm
)
import
Gargantext.API.Node.Corpus.New.Types
(
FileFormat
(
..
),
FileType
(
..
))
...
...
@@ -55,7 +54,6 @@ frameCalcUploadAsync :: ( HasConfig env
,
FlowCmdM
env
err
m
,
MonadJobStatus
m
,
HasNodeArchiveStoryImmediateSaver
env
,
HasSettings
env
)
=>
AuthenticatedUser
-- ^ 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(..))
import
Gargantext.Prelude
import
Gargantext.Utils.Jobs
(
serveJobsAPI
,
MonadJobStatus
(
..
))
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
-- ^ The logged-in user
->
NodeId
...
...
@@ -64,7 +63,7 @@ postNodeAsyncAPI authenticatedUser nId = Named.PostNodeAsyncAPI $ AsyncJobs $
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
-- ^ The logged in user
->
NodeId
...
...
src/Gargantext/API/Node/Share.hs
View file @
5d2efe0d
...
...
@@ -33,7 +33,6 @@ import Gargantext.Database.Query.Table.Node.Error (HasNodeError(..))
import
Gargantext.Database.Query.Tree
(
findNodesWithType
)
import
Gargantext.Prelude
import
Servant.Server.Generic
(
AsServerT
)
import
Gargantext.API.Admin.Types
(
HasSettings
)
------------------------------------------------------------------------
-- TODO permission
...
...
@@ -42,7 +41,6 @@ import Gargantext.API.Admin.Types (HasSettings)
api
::
(
HasNodeError
err
,
HasNLPServer
env
,
CmdRandom
env
err
m
,
HasSettings
env
,
HasCentralExchangeNotification
env
)
=>
User
->
NodeId
...
...
src/Gargantext/API/Node/Update.hs
View file @
5d2efe0d
...
...
@@ -18,7 +18,6 @@ import Control.Lens (view)
import
Data.Set
qualified
as
Set
import
Gargantext.API.Admin.EnvTypes
(
GargJob
(
..
),
Env
)
import
Gargantext.API.Admin.Orchestrator.Types
(
AsyncJobs
(
..
))
import
Gargantext.API.Admin.Types
(
HasSettings
)
import
Gargantext.API.Errors.Types
(
BackendInternalError
)
import
Gargantext.API.Metrics
qualified
as
Metrics
import
Gargantext.API.Ngrams.Types
qualified
as
NgramsTypes
...
...
@@ -52,7 +51,6 @@ api nId = Named.UpdateAPI $ AsyncJobs $
updateNode
nId
p
jHandle
updateNode
::
(
HasNodeStory
env
err
m
,
HasSettings
env
,
MonadJobStatus
m
,
MonadLogger
m
)
...
...
src/Gargantext/API/Prelude.hs
View file @
5d2efe0d
...
...
@@ -24,7 +24,6 @@ import Control.Lens ((#))
import
Data.Aeson.Types
import
Gargantext.API.Admin.Auth.Types
(
AuthenticationError
)
import
Gargantext.API.Admin.Orchestrator.Types
import
Gargantext.API.Admin.Types
import
Gargantext.API.Errors.Class
import
Gargantext.Core.AsyncUpdates.CentralExchange.Types
(
HasCentralExchangeNotification
)
import
Gargantext.Core.Config
(
HasConfig
)
...
...
@@ -49,7 +48,6 @@ type HasJobEnv' env = HasJobEnv env JobLog JobLog
type
EnvC
env
=
(
HasConnectionPool
env
,
HasSettings
env
-- TODO rename HasDbSettings
,
HasJobEnv
env
JobLog
JobLog
,
HasConfig
env
,
HasNodeStoryEnv
env
...
...
@@ -97,7 +95,6 @@ type GargNoServer t =
type
GargNoServer'
env
err
m
=
(
CmdM
env
err
m
,
HasNodeStory
env
err
m
,
HasSettings
env
,
HasNodeError
err
)
...
...
src/Gargantext/API/Server/Named/Ngrams.hs
View file @
5d2efe0d
...
...
@@ -12,7 +12,6 @@ import Gargantext.API.Admin.Auth (withNamedAccess)
import
Gargantext.API.Admin.Auth.Types
(
AuthenticatedUser
,
PathId
(
..
))
import
Gargantext.API.Admin.EnvTypes
import
Gargantext.API.Admin.Orchestrator.Types
(
AsyncJobs
(
..
))
import
Gargantext.API.Admin.Types
(
HasSettings
)
import
Gargantext.API.Errors.Types
(
BackendInternalError
)
import
Gargantext.API.Metrics
qualified
as
Metrics
import
Gargantext.API.Ngrams
...
...
@@ -72,7 +71,6 @@ apiNgramsAsync _dId = Named.TableNgramsAsyncAPI $ AsyncJobs $
tableNgramsPostChartsAsync
::
(
HasNodeStory
env
err
m
,
HasSettings
env
,
MonadJobStatus
m
)
=>
UpdateTableNgramsCharts
->
JobHandle
m
...
...
src/Gargantext/Core/AsyncUpdates/Dispatcher/Types.hs
View file @
5d2efe0d
...
...
@@ -31,7 +31,6 @@ import DeferredFolds.UnfoldlM qualified as UnfoldlM
import
Data.UUID.V4
as
UUID
import
Gargantext.API.Admin.Auth.Types
(
AuthenticatedUser
(
_auth_user_id
))
import
Gargantext.API.Admin.Orchestrator.Types
(
JobLog
)
import
Gargantext.API.Admin.Types
(
Settings
)
import
Gargantext.API.Prelude
(
IsGargServer
)
import
Gargantext.Core.AsyncUpdates.CentralExchange.Types
qualified
as
CETypes
import
Gargantext.Core.Types
(
NodeId
,
UserId
)
...
...
src/Gargantext/Core/Config/Types.hs
View file @
5d2efe0d
...
...
@@ -17,6 +17,7 @@ module Gargantext.Core.Config.Types
(
APIsConfig
(
..
)
,
ac_pubmed_api_key
,
ac_epo_api_url
,
ac_scrapyd_url
,
CORSOrigin
(
..
)
,
CORSSettings
(
..
)
,
FramesConfig
(
..
)
...
...
@@ -299,18 +300,25 @@ makeLenses ''JobsConfig
data
APIsConfig
=
APIsConfig
{
_ac_pubmed_api_key
::
!
Text
,
_ac_epo_api_url
::
!
Text
}
,
_ac_epo_api_url
::
!
Text
,
_ac_scrapyd_url
::
!
BaseUrl
}
deriving
(
Generic
,
Show
)
instance
FromValue
APIsConfig
where
fromValue
=
parseTableFromValue
$
do
_ac_pubmed_api_key
<-
reqKeyOf
"pubmed"
$
parseTableFromValue
$
reqKey
"api_key"
_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
{
..
}
instance
ToValue
APIsConfig
where
toValue
=
defaultTableToValue
instance
ToTable
APIsConfig
where
toTable
(
APIsConfig
{
..
})
=
table
[
"pubmed"
.=
table
[
"api_key"
.=
_ac_pubmed_api_key
]
,
"epo"
.=
table
[
"api_url"
.=
_ac_epo_api_url
]
,
"scrapyd"
.=
table
[
"url"
.=
showBaseUrl
_ac_scrapyd_url
]
]
makeLenses
''
A
PIsConfig
...
...
src/Gargantext/Core/Viz/Graph/API.hs
View file @
5d2efe0d
...
...
@@ -21,7 +21,6 @@ module Gargantext.Core.Viz.Graph.API
import
Control.Lens
(
set
,
_Just
,
(
^?
),
at
)
import
Data.HashMap.Strict
qualified
as
HashMap
import
Gargantext.API.Admin.EnvTypes
(
GargJob
(
..
),
Env
)
import
Gargantext.API.Admin.Types
(
HasSettings
)
import
Gargantext.API.Errors.Types
(
BackendInternalError
)
import
Gargantext.API.Ngrams.Tools
import
Gargantext.API.Prelude
(
GargM
)
...
...
@@ -267,7 +266,7 @@ recomputeVersions :: HasNodeStory env err m
recomputeVersions
nId
=
recomputeGraph
nId
Spinglass
BridgenessMethod_Basic
Nothing
Nothing
NgramsTerms
NgramsTerms
False
------------------------------------------------------------
graphClone
::
(
HasNodeError
err
,
HasSettings
env
)
graphClone
::
(
HasNodeError
err
)
=>
UserId
->
NodeId
->
HyperdataGraphAPI
...
...
src/Gargantext/Database/Action/Flow.hs
View file @
5d2efe0d
...
...
@@ -112,7 +112,6 @@ import PUBMED.Types qualified as PUBMED
------------------------------------------------------------------------
-- Imports for upgrade function
import
Gargantext.Database.Query.Tree.Error
(
HasTreeError
)
import
Gargantext.API.Admin.Types
(
HasSettings
)
------------------------------------------------------------------------
...
...
@@ -129,7 +128,7 @@ printDataText (DataNew (maybeInt, conduitData)) = do
putText
$
show
(
maybeInt
,
res
)
-- TODO use the split parameter in config file
getDataText
::
(
HasNodeError
err
,
HasSettings
env
)
getDataText
::
(
HasNodeError
err
)
=>
DataOrigin
->
TermType
Lang
->
API
.
RawQuery
...
...
@@ -146,7 +145,7 @@ getDataText (InternalOrigin _) la q _ _ _li = do
ids
<-
map
fst
<$>
searchDocInDatabase
cId
(
stem
(
_tt_lang
la
)
GargPorterAlgorithm
$
API
.
getRawQuery
q
)
pure
$
Right
$
DataOld
ids
getDataText_Debug
::
(
HasNodeError
err
,
HasSettings
env
)
getDataText_Debug
::
(
HasNodeError
err
)
=>
DataOrigin
->
TermType
Lang
->
API
.
RawQuery
...
...
@@ -168,7 +167,6 @@ flowDataText :: forall env err m.
,
HasTreeError
err
,
HasValidationError
err
,
MonadJobStatus
m
,
HasSettings
env
,
HasCentralExchangeNotification
env
)
=>
User
...
...
@@ -199,7 +197,6 @@ flowAnnuaire :: ( DbCmd' env err m
,
HasTreeError
err
,
HasValidationError
err
,
MonadJobStatus
m
,
HasSettings
env
,
HasCentralExchangeNotification
env
)
=>
MkCorpusUser
->
TermType
Lang
...
...
@@ -219,7 +216,6 @@ flowCorpusFile :: ( DbCmd' env err m
,
HasTreeError
err
,
HasValidationError
err
,
MonadJobStatus
m
,
HasSettings
env
,
HasCentralExchangeNotification
env
)
=>
MkCorpusUser
->
Limit
-- Limit the number of docs (for dev purpose)
...
...
@@ -250,7 +246,6 @@ flowCorpus :: ( DbCmd' env err m
,
HasValidationError
err
,
FlowCorpus
a
,
MonadJobStatus
m
,
HasSettings
env
,
HasCentralExchangeNotification
env
)
=>
MkCorpusUser
->
TermType
Lang
...
...
@@ -271,7 +266,6 @@ flow :: forall env err m a c.
,
FlowCorpus
a
,
MkCorpus
c
,
MonadJobStatus
m
,
HasSettings
env
,
HasCentralExchangeNotification
env
)
=>
Maybe
c
...
...
@@ -309,7 +303,6 @@ addDocumentsToHyperCorpus :: ( DbCmd' env err m
,
HasNodeError
err
,
FlowCorpus
document
,
MkCorpus
corpus
,
HasSettings
env
)
=>
NLPServerConfig
->
Maybe
corpus
...
...
@@ -323,7 +316,7 @@ addDocumentsToHyperCorpus ncs mb_hyper la corpusId docs = do
pure
ids
------------------------------------------------------------------------
createNodes
::
(
DbCmd'
env
err
m
,
HasNodeError
err
,
HasSettings
env
createNodes
::
(
DbCmd'
env
err
m
,
HasNodeError
err
,
MkCorpus
c
,
HasCentralExchangeNotification
env
)
...
...
@@ -356,7 +349,6 @@ flowCorpusUser :: ( HasNodeError err
,
HasTreeError
err
,
HasNodeStory
env
err
m
,
MkCorpus
c
,
HasSettings
env
)
=>
Lang
->
User
...
...
@@ -386,7 +378,6 @@ buildSocialList :: ( HasNodeError err
,
HasTreeError
err
,
HasNodeStory
env
err
m
,
MkCorpus
c
,
HasSettings
env
)
=>
Lang
->
User
...
...
@@ -422,7 +413,6 @@ insertMasterDocs :: ( DbCmd' env err m
,
HasNodeError
err
,
FlowCorpus
a
,
MkCorpus
c
,
HasSettings
env
)
=>
NLPServerConfig
->
Maybe
c
...
...
src/Gargantext/Database/Action/User/New.hs
View file @
5d2efe0d
...
...
@@ -29,7 +29,6 @@ import Control.Lens (view)
import
Control.Monad.Random
import
Data.Text
(
splitOn
)
import
Data.Text
qualified
as
Text
import
Gargantext.API.Admin.Types
(
HasSettings
)
import
Gargantext.Core.Mail
import
Gargantext.Core.Mail.Types
(
HasMail
,
mailSettings
)
import
Gargantext.Core.Types.Individu
...
...
@@ -46,7 +45,7 @@ import qualified Data.List.NonEmpty as NE
------------------------------------------------------------------------
-- | Creates a new 'User' from the input 'EmailAddress', which needs to
-- 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
->
m
UserId
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
-- notification, and thus lives in the 'DbCmd' effect stack. You may want to
-- use 'newUser' instead for standard Gargantext code.
new_user
::
(
HasNodeError
err
,
HasSettings
env
)
new_user
::
(
HasNodeError
err
)
=>
NewUser
GargPassword
->
DBCmd'
env
err
UserId
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
-- notification, and thus lives in the 'DbCmd' effect stack. You may want to
-- use 'newUsers' instead for standard Gargantext code.
new_users
::
(
HasNodeError
err
,
HasSettings
env
)
new_users
::
(
HasNodeError
err
)
=>
NonEmpty
(
NewUser
GargPassword
)
-- ^ A list of users to create.
->
DBCmd'
env
err
(
NonEmpty
UserId
)
...
...
@@ -83,7 +82,7 @@ new_users us = do
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
->
m
(
NonEmpty
UserId
)
newUsers
us
=
do
...
...
@@ -109,7 +108,7 @@ guessUserName n = case splitOn "@" n of
_
->
Nothing
------------------------------------------------------------------------
newUsers'
::
(
HasNodeError
err
,
HasSettings
env
)
newUsers'
::
(
HasNodeError
err
)
=>
MailConfig
->
NonEmpty
(
NewUser
GargPassword
)
->
DBCmd'
env
err
(
NonEmpty
UserId
)
newUsers'
cfg
us
=
do
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)
import
Gargantext.Prelude
import
Opaleye
(
restrict
,
(
.==
),
Select
)
import
Opaleye.SqlTypes
(
sqlStrictText
,
sqlInt4
)
import
Gargantext.API.Admin.Types
(
HasSettings
)
getRootId
::
(
HasNodeError
err
)
=>
User
->
DBCmd
err
NodeId
...
...
@@ -43,7 +42,7 @@ getRootId u = do
getRoot
::
User
->
DBCmd
err
[
Node
HyperdataUser
]
getRoot
=
runOpaQuery
.
selectRoot
getOrMkRoot
::
(
HasNodeError
err
,
HasSettings
env
)
getOrMkRoot
::
(
HasNodeError
err
)
=>
User
->
DBCmd'
env
err
(
UserId
,
RootId
)
getOrMkRoot
user
=
do
...
...
@@ -78,7 +77,7 @@ userFromMkCorpusUser (MkCorpusUserNormalCorpusIds u _cids) = u
userFromMkCorpusUser
(
MkCorpusUserNormalCorpusName
u
_cname
)
=
u
getOrMkRootWithCorpus
::
(
HasNodeError
err
,
MkCorpus
a
,
HasSettings
env
)
getOrMkRootWithCorpus
::
(
HasNodeError
err
,
MkCorpus
a
)
=>
MkCorpusUser
->
Maybe
a
->
DBCmd'
env
err
(
UserId
,
RootId
,
CorpusId
)
...
...
@@ -120,7 +119,7 @@ mkCorpus cName c rootId userId = do
pure
(
userId
,
rootId
,
corpusId
)
mkRoot
::
(
HasNodeError
err
,
HasSettings
env
)
mkRoot
::
(
HasNodeError
err
)
=>
User
->
DBCmd'
env
err
[
RootId
]
mkRoot
user
=
do
...
...
test-data/test_config.toml
View file @
5d2efe0d
...
...
@@ -28,6 +28,10 @@ api_key = "no_key"
[apis.epo]
api_url
=
""
[apis.scrapyd]
url
=
"http://localhost:6800"
[external]
[external.frames]
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 ->
newTestEnv
testEnv
logger
port
=
do
tomlFile
@
(
SettingsFile
sf
)
<-
fakeTomlPath
!
manager_env
<-
newTlsManager
let
!
settings'
=
devSettings
!
config_env
<-
readConfig
tomlFile
<&>
(
gc_frontend_config
.
fc_appPort
)
.~
port
prios
<-
withLogger
()
$
\
ioLogger
->
Jobs
.
readPrios
ioLogger
(
sf
<>
".jobs"
)
...
...
@@ -77,8 +76,7 @@ newTestEnv testEnv logger port = do
-- !dispatcher <- D.dispatcher
pure
$
Env
{
_env_settings
=
settings'
,
_env_logger
=
logger
{
_env_logger
=
logger
,
_env_pool
=
pool
,
_env_nodeStory
=
nodeStory_env
,
_env_manager
=
manager_env
...
...
test/Test/Database/Setup.hs
View file @
5d2efe0d
...
...
@@ -76,14 +76,12 @@ setup = do
bootstrapDB
db
pool
gargConfig
ugen
<-
emptyCounter
test_nodeStory
<-
fromDBNodeStoryEnv
pool
let
stgs
=
devSettings
withLoggerHoisted
Mock
$
\
logger
->
do
pure
$
TestEnv
{
test_db
=
DBHandle
pool
db
,
test_config
=
gargConfig
,
test_nodeStory
,
test_usernameGen
=
ugen
,
test_logger
=
logger
,
test_settings
=
stgs
}
withTestDB
::
(
TestEnv
->
IO
()
)
->
IO
()
...
...
test/Test/Database/Types.hs
View file @
5d2efe0d
...
...
@@ -28,7 +28,6 @@ import Database.Postgres.Temp qualified as Tmp
import
Gargantext
hiding
(
to
)
import
Gargantext.API.Admin.EnvTypes
import
Gargantext.API.Admin.Orchestrator.Types
import
Gargantext.API.Admin.Types
import
Gargantext.API.Errors.Types
import
Gargantext.API.Prelude
import
Gargantext.Core.Config
(
HasConfig
(
..
))
...
...
@@ -63,7 +62,6 @@ data TestEnv = TestEnv {
,
test_nodeStory
::
!
NodeStoryEnv
,
test_usernameGen
::
!
Counter
,
test_logger
::
!
(
Logger
(
GargM
TestEnv
BackendInternalError
))
,
test_settings
::
!
Settings
}
newtype
TestMonad
a
=
TestMonad
{
runTestMonad
::
ReaderT
TestEnv
IO
a
}
...
...
@@ -107,9 +105,6 @@ instance HasConnectionPool TestEnv where
instance
HasConfig
TestEnv
where
hasConfig
=
to
test_config
instance
HasSettings
TestEnv
where
settings
=
to
test_settings
instance
HasMail
TestEnv
where
mailSettings
=
to
$
const
(
MailConfig
{
_mc_mail_host
=
"localhost"
,
_mc_mail_port
=
25
...
...
test/Test/Utils/Jobs.hs
View file @
5d2efe0d
...
...
@@ -291,8 +291,7 @@ newTestEnv = do
,
_gc_log_level
=
Prelude
.
error
"gc_log_level not needed, but forced somewhere (check StrictData)"
}
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_nodeStory
=
Prelude
.
error
"env_nodeStory not needed, but forced somewhere (check StrictData)"
,
_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