Skip to content
Projects
Groups
Snippets
Help
Loading...
Help
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
H
haskell-gargantext
Project
Project
Details
Activity
Releases
Cycle Analytics
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Charts
Issues
0
Issues
0
List
Board
Labels
Milestones
Merge Requests
0
Merge Requests
0
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
Przemyslaw Kaminski
haskell-gargantext
Commits
33fe28c3
Commit
33fe28c3
authored
Oct 12, 2020
by
Nicolas Pouillard
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Cleanup refactoring of config/settings/env
parent
b3e16c15
Changes
12
Hide whitespace changes
Inline
Side-by-side
Showing
12 changed files
with
48 additions
and
55 deletions
+48
-55
API.hs
src/Gargantext/API.hs
+4
-9
Settings.hs
src/Gargantext/API/Admin/Settings.hs
+10
-11
Types.hs
src/Gargantext/API/Admin/Types.hs
+3
-4
Routes.hs
src/Gargantext/API/Routes.hs
+3
-4
Server.hs
src/Gargantext/API/Server.hs
+6
-3
Learn.hs
src/Gargantext/Core/Text/List/Learn.hs
+2
-5
Delete.hs
src/Gargantext/Database/Action/Delete.hs
+1
-2
Node.hs
src/Gargantext/Database/Action/Node.hs
+4
-4
New.hs
src/Gargantext/Database/Action/User/New.hs
+3
-3
Prelude.hs
src/Gargantext/Database/Prelude.hs
+2
-2
Config.hs
src/Gargantext/Prelude/Config.hs
+2
-0
Utils.hs
src/Gargantext/Prelude/Utils.hs
+8
-8
No files found.
src/Gargantext/API.hs
View file @
33fe28c3
...
...
@@ -36,7 +36,6 @@ import Control.Exception (finally)
import
Control.Lens
import
Control.Monad.Reader
(
runReaderT
)
import
Data.List
(
lookup
)
import
Data.Text
(
Text
)
import
Data.Text.Encoding
(
encodeUtf8
)
import
Data.Validity
import
GHC.Base
(
Applicative
)
...
...
@@ -50,10 +49,9 @@ import Servant
import
System.IO
(
FilePath
)
import
Data.Text.IO
(
putStrLn
)
import
Gargantext.Prelude.Config
(
gc_url_backend_api
)
import
Gargantext.API.Admin.Auth
(
AuthContext
)
import
Gargantext.API.Admin.Settings
(
newEnv
)
import
Gargantext.API.Admin.Types
(
FireWall
(
..
),
PortNumber
,
cookieSettings
,
env_gargConfig
,
jwtSettings
,
settings
)
import
Gargantext.API.Admin.Types
(
FireWall
(
..
),
PortNumber
,
cookieSettings
,
jwtSettings
,
settings
)
import
Gargantext.API.Ngrams
(
saveRepo
)
import
Gargantext.API.Ngrams.Types
(
HasRepoSaver
(
..
))
import
Gargantext.API.Prelude
...
...
@@ -70,10 +68,7 @@ startGargantext :: Mode -> PortNumber -> FilePath -> IO ()
startGargantext
mode
port
file
=
do
env
<-
newEnv
port
file
portRouteInfo
port
let
baseUrl
=
env
^.
env_gargConfig
.
gc_url_backend_api
app
<-
makeApp
env
baseUrl
app
<-
makeApp
env
mid
<-
makeDevMiddleware
mode
run
port
(
mid
app
)
`
finally
`
stopGargantext
env
...
...
@@ -198,8 +193,8 @@ serverGargAdminAPI = roots
--gargMock :: Server GargAPI
--gargMock = mock apiGarg Proxy
---------------------------------------------------------------------
makeApp
::
EnvC
env
=>
env
->
Text
->
IO
Application
makeApp
env
baseUrl
=
serveWithContext
api
cfg
<$>
server
env
baseUrl
makeApp
::
EnvC
env
=>
env
->
IO
Application
makeApp
env
=
serveWithContext
api
cfg
<$>
server
env
where
cfg
::
Servant
.
Context
AuthContext
cfg
=
env
^.
settings
.
jwtSettings
...
...
src/Gargantext/API/Admin/Settings.hs
View file @
33fe28c3
...
...
@@ -47,7 +47,7 @@ import Gargantext.API.Ngrams.Types (NgramsRepo, HasRepo(..), RepoEnv(..), r_vers
import
Gargantext.API.Ngrams
(
saveRepo
)
import
Gargantext.Database.Prelude
(
databaseParameters
,
Cmd
'
,
Cmd
''
,
runCmd
,
HasConfig
(
..
))
import
Gargantext.Prelude
import
Gargantext.Prelude.Config
(
GargConfig
(
..
),
gc_repofilepath
,
readConfig
,
defaultConfig
)
import
Gargantext.Prelude.Config
(
GargConfig
(
..
),
gc_repofilepath
,
readConfig
)
devSettings
::
FilePath
->
IO
Settings
devSettings
jwkFile
=
do
...
...
@@ -64,7 +64,6 @@ devSettings jwkFile = do
,
_scrapydUrl
=
fromMaybe
(
panic
"Invalid scrapy URL"
)
$
parseBaseUrl
"http://localhost:6800"
,
_cookieSettings
=
defaultCookieSettings
{
cookieXsrfSetting
=
Just
xsrfCookieSetting
}
-- TODO-SECURITY tune
,
_jwtSettings
=
defaultJWTSettings
jwk
-- TODO-SECURITY tune
,
_config
=
defaultConfig
}
where
xsrfCookieSetting
=
defaultXsrfCookieSettings
{
xsrfExcludeGet
=
True
}
...
...
@@ -178,14 +177,14 @@ newEnv port file = do
logger
<-
newStderrLoggerSet
defaultBufSize
pure
$
Env
{
_env_settings
=
settings
,
_env_logger
=
logger
,
_env_pool
=
pool
,
_env_repo
=
repo
,
_env_manager
=
manager
,
_env_scrapers
=
scrapers_env
,
_env_self_url
=
self_url
,
_env_
gargConfig
=
config
{
_env_settings
=
settings
,
_env_logger
=
logger
,
_env_pool
=
pool
,
_env_repo
=
repo
,
_env_manager
=
manager
,
_env_scrapers
=
scrapers_env
,
_env_self_url
=
self_url
,
_env_
config
=
config
}
newPool
::
ConnectInfo
->
IO
(
Pool
Connection
)
...
...
@@ -194,7 +193,7 @@ newPool param = createPool (connect param) close 1 (60*60) 8
cleanEnv
::
(
HasConfig
env
,
HasRepo
env
)
=>
env
->
IO
()
cleanEnv
env
=
do
r
<-
takeMVar
(
env
^.
repoEnv
.
renv_var
)
repoSaverAction
(
env
^.
hasC
onfig
.
gc_repofilepath
)
r
repoSaverAction
(
env
^.
c
onfig
.
gc_repofilepath
)
r
unlockFile
(
env
^.
repoEnv
.
renv_lock
)
type
IniPath
=
FilePath
...
...
src/Gargantext/API/Admin/Types.hs
View file @
33fe28c3
...
...
@@ -43,7 +43,6 @@ data Settings = Settings
,
_cookieSettings
::
CookieSettings
,
_sendLoginEmails
::
SendEmailType
,
_scrapydUrl
::
BaseUrl
,
_config
::
GargConfig
}
makeLenses
''
S
ettings
...
...
@@ -62,14 +61,14 @@ data Env = Env
,
_env_manager
::
!
Manager
,
_env_self_url
::
!
BaseUrl
,
_env_scrapers
::
!
ScrapersEnv
,
_env_
gargConfig
::
!
GargConfig
,
_env_
config
::
!
GargConfig
}
deriving
(
Generic
)
makeLenses
''
E
nv
instance
HasConfig
Env
where
hasConfig
=
env_gargC
onfig
config
=
env_c
onfig
instance
HasConnectionPool
Env
where
connPool
=
env_pool
...
...
@@ -110,7 +109,7 @@ data DevEnv = DevEnv
makeLenses
''
D
evEnv
instance
HasConfig
DevEnv
where
hasC
onfig
=
dev_env_config
c
onfig
=
dev_env_config
instance
HasConnectionPool
DevEnv
where
connPool
=
dev_env_pool
...
...
src/Gargantext/API/Routes.hs
View file @
33fe28c3
...
...
@@ -40,7 +40,7 @@ import Gargantext.Database.Prelude (HasConfig(..))
import
Gargantext.Database.Admin.Types.Hyperdata
import
Gargantext.Database.Admin.Types.Node
import
Gargantext.Prelude
import
Gargantext.Prelude.Config
(
GargConfig
(
..
)
)
import
Gargantext.Prelude.Config
(
gc_max_docs_scrapers
)
import
Servant
import
Servant.Auth
as
SA
import
Servant.Auth.Swagger
()
...
...
@@ -249,9 +249,8 @@ addCorpusWithQuery :: User -> GargServer New.AddWithQuery
addCorpusWithQuery
user
cid
=
serveJobsAPI
$
JobFunction
(
\
q
log
->
do
conf
<-
view
hasConfig
let
limit
=
Just
$
_gc_max_docs_scrapers
conf
New
.
addToCorpusWithQuery
user
cid
q
limit
(
liftBase
.
log
)
limit
<-
view
$
config
.
gc_max_docs_scrapers
New
.
addToCorpusWithQuery
user
cid
q
(
Just
limit
)
(
liftBase
.
log
)
{- let log' x = do
printDebug "addToCorpusWithQuery" x
liftBase $ log x
...
...
src/Gargantext/API/Server.hs
View file @
33fe28c3
...
...
@@ -13,6 +13,7 @@ Portability : POSIX
---------------------------------------------------------------------
module
Gargantext.API.Server
where
---------------------------------------------------------------------
import
Control.Lens
((
^.
))
import
Control.Monad.Except
(
withExceptT
)
import
Control.Monad.Reader
(
runReaderT
)
import
Data.Text
(
Text
)
...
...
@@ -31,6 +32,8 @@ import Gargantext.API.Routes
import
Gargantext.API.Swagger
(
swaggerDoc
)
import
Gargantext.API.ThrowAll
(
serverPrivateGargAPI
)
import
Gargantext.Prelude
import
Gargantext.Prelude.Config
(
gc_url_backend_api
)
import
Gargantext.Database.Prelude
(
config
)
serverGargAPI
::
Text
->
GargServerM
env
err
GargAPI
...
...
@@ -46,15 +49,15 @@ serverGargAPI baseUrl -- orchestrator
gargVersion
=
pure
(
cs
$
showVersion
PG
.
version
)
-- | Server declarations
server
::
forall
env
.
EnvC
env
=>
env
->
Text
->
IO
(
Server
API
)
server
env
baseUrl
=
do
server
::
forall
env
.
EnvC
env
=>
env
->
IO
(
Server
API
)
server
env
=
do
-- orchestrator <- scrapyOrchestrator env
pure
$
swaggerSchemaUIServer
swaggerDoc
:<|>
hoistServerWithContext
(
Proxy
::
Proxy
GargAPI
)
(
Proxy
::
Proxy
AuthContext
)
transform
(
serverGargAPI
baseUrl
)
(
serverGargAPI
(
env
^.
config
.
gc_url_backend_api
)
)
:<|>
frontEndServer
where
transform
::
forall
a
.
GargM
env
GargError
a
->
Handler
a
...
...
src/Gargantext/Core/Text/List/Learn.hs
View file @
33fe28c3
...
...
@@ -17,8 +17,6 @@ CSV parser for Gargantext corpus files.
module
Gargantext.Core.Text.List.Learn
where
import
Control.Monad.Reader
(
MonadReader
)
-- TODO remvoe this deps
import
qualified
Data.IntMap
as
IntMap
import
qualified
Data.List
as
List
import
Data.Map
(
Map
)
...
...
@@ -26,7 +24,6 @@ import qualified Data.Map as Map
import
qualified
Data.SVM
as
SVM
import
qualified
Data.Vector
as
Vec
import
Gargantext.API.Admin.Types
import
Gargantext.Core.Text.Metrics.Count
(
occurrencesWith
)
import
Gargantext.Core.Types.Main
(
ListType
(
..
),
listTypeId
,
fromListTypeId
)
import
Gargantext.Prelude
...
...
@@ -85,12 +82,12 @@ type Tests = Map ListType [Vec.Vector Double]
type
Score
=
Double
type
Param
=
Double
grid
::
(
Monad
Reader
env
m
,
MonadBase
IO
m
,
HasSettings
env
)
grid
::
(
Monad
Base
IO
m
)
=>
Param
->
Param
->
Train
->
[
Tests
]
->
m
(
Maybe
Model
)
grid
_
_
_
[]
=
panic
"Gargantext.Core.Text.List.Learn.grid : empty test data"
grid
s
e
tr
te
=
do
let
grid'
::
(
Monad
Reader
env
m
,
MonadBase
IO
m
,
HasSettings
env
)
grid'
::
(
Monad
Base
IO
m
)
=>
Double
->
Double
->
Train
->
[
Tests
]
...
...
src/Gargantext/Database/Action/Delete.hs
View file @
33fe28c3
...
...
@@ -21,7 +21,6 @@ import Control.Lens (view, (^.))
import
Data.Text
import
Servant
import
Gargantext.API.Admin.Types
import
Gargantext.Core.Types.Individu
(
User
(
..
))
import
Gargantext.Database.Action.User
(
getUserId
)
import
Gargantext.Database.Action.Share
(
delFolderTeam
)
...
...
@@ -38,7 +37,7 @@ import qualified Gargantext.Prelude.Utils as GPU
------------------------------------------------------------------------
deleteNode
::
(
HasConfig
env
,
HasConnectionPool
env
,
HasNodeError
err
,
HasSettings
env
)
deleteNode
::
(
HasConfig
env
,
HasConnectionPool
env
,
HasNodeError
err
)
=>
User
->
NodeId
->
Cmd'
env
err
Int
...
...
src/Gargantext/Database/Action/Node.hs
View file @
33fe28c3
...
...
@@ -91,13 +91,13 @@ mkNodeWithParent_ConfigureHyperdata' nt (Just i) uId name = do
case
maybeNodeId
of
[]
->
nodeError
(
DoesNotExist
i
)
[
n
]
->
do
c
onfig
<-
view
hasC
onfig
c
fg
<-
view
c
onfig
u
<-
case
nt
of
NodeFrameWrite
->
pure
$
_gc_frame_write_url
c
onfi
g
NodeFrameCalc
->
pure
$
_gc_frame_calc_url
c
onfi
g
NodeFrameWrite
->
pure
$
_gc_frame_write_url
c
f
g
NodeFrameCalc
->
pure
$
_gc_frame_calc_url
c
f
g
_
->
nodeError
NeedsConfiguration
let
s
=
_gc_secretkey
c
onfi
g
s
=
_gc_secretkey
c
f
g
hd
=
HyperdataFrame
u
(
hash
$
s
<>
(
cs
$
show
n
))
_
<-
updateHyperdata
n
hd
pure
[
n
]
...
...
src/Gargantext/Database/Action/User/New.hs
View file @
33fe28c3
...
...
@@ -34,9 +34,9 @@ type EmailAddress = Text
newUsers
::
(
CmdM
env
err
m
,
MonadRandom
m
,
HasNodeError
err
)
=>
[
EmailAddress
]
->
m
Int64
newUsers
us
=
do
us'
<-
mapM
newUserQuick
us
conf
<-
view
hasConfig
newUsers'
(
_gc_url
conf
)
us'
us'
<-
mapM
newUserQuick
us
url
<-
view
$
config
.
gc_url
newUsers'
url
us'
------------------------------------------------------------------------
newUserQuick
::
(
MonadRandom
m
)
=>
Text
->
m
(
NewUser
GargPassword
)
...
...
src/Gargantext/Database/Prelude.hs
View file @
33fe28c3
...
...
@@ -51,10 +51,10 @@ instance HasConnectionPool (Pool Connection) where
connPool
=
identity
class
HasConfig
env
where
hasC
onfig
::
Getter
env
GargConfig
c
onfig
::
Getter
env
GargConfig
instance
HasConfig
GargConfig
where
hasC
onfig
=
identity
c
onfig
=
identity
-------------------------------------------------------
type
JSONB
=
QueryRunnerColumnDefault
PGJsonb
...
...
src/Gargantext/Prelude/Config.hs
View file @
33fe28c3
...
...
@@ -67,6 +67,7 @@ readConfig fp = do
(
val
"FRAME_ISTEX_URL"
)
(
read
$
cs
$
val
"MAX_DOCS_SCRAPERS"
)
{- UNUSED
defaultConfig :: GargConfig
defaultConfig = GargConfig "https://localhost"
"https://localhost:8008/api/v1.0"
...
...
@@ -79,3 +80,4 @@ defaultConfig = GargConfig "https://localhost"
"https://frame_searx.url"
"https://frame_istex.url"
1000
-}
\ No newline at end of file
src/Gargantext/Prelude/Utils.hs
View file @
33fe28c3
...
...
@@ -14,7 +14,7 @@ module Gargantext.Prelude.Utils
import
Control.Exception
import
Control.Lens
(
view
)
import
Control.Monad.Reader
(
ask
,
MonadReader
)
import
Control.Monad.Reader
(
MonadReader
)
import
Control.Monad.Random.Class
(
MonadRandom
)
import
Data.Text
(
Text
)
import
qualified
Data.Text
as
Text
...
...
@@ -25,9 +25,9 @@ import System.IO.Error
import
System.Random
(
newStdGen
)
import
qualified
System.Random.Shuffle
as
SRS
import
Gargantext.API.Admin.Types
import
Gargantext.Prelude.Config
import
Gargantext.Prelude.Crypto.Hash
import
Gargantext.Database.Prelude
(
HasConfig
(
..
))
import
Gargantext.Database.Admin.Types.Node
(
NodeId
,
NodeType
)
import
Gargantext.Prelude
...
...
@@ -71,10 +71,10 @@ folderFilePath = do
pure
(
foldPath
,
fileName
)
writeFile
::
(
MonadReader
env
m
,
MonadBase
IO
m
,
Has
Settings
env
,
SaveFile
a
)
writeFile
::
(
MonadReader
env
m
,
MonadBase
IO
m
,
Has
Config
env
,
SaveFile
a
)
=>
a
->
m
FilePath
writeFile
a
=
do
dataPath
<-
view
(
settings
.
config
.
gc_datafilepath
)
<$>
ask
dataPath
<-
view
$
config
.
gc_datafilepath
(
foldPath
,
fileName
)
<-
folderFilePath
...
...
@@ -88,16 +88,16 @@ writeFile a = do
pure
filePath
readFile
::
(
MonadReader
env
m
,
MonadBase
IO
m
,
Has
Settings
env
,
ReadFile
a
)
readFile
::
(
MonadReader
env
m
,
MonadBase
IO
m
,
Has
Config
env
,
ReadFile
a
)
=>
FilePath
->
m
a
readFile
fp
=
do
dataPath
<-
view
(
settings
.
config
.
gc_datafilepath
)
<$>
ask
dataPath
<-
view
$
config
.
gc_datafilepath
liftBase
$
readFile'
$
dataPath
<>
"/"
<>
fp
removeFile
::
(
MonadReader
env
m
,
MonadBase
IO
m
,
Has
Settings
env
)
removeFile
::
(
MonadReader
env
m
,
MonadBase
IO
m
,
Has
Config
env
)
=>
FilePath
->
m
()
removeFile
fp
=
do
dataPath
<-
view
(
settings
.
config
.
gc_datafilepath
)
<$>
ask
dataPath
<-
view
$
config
.
gc_datafilepath
liftBase
$
SD
.
removeFile
(
dataPath
<>
"/"
<>
fp
)
`
catch
`
handleExists
where
handleExists
e
...
...
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