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
199
Issues
199
List
Board
Labels
Milestones
Merge Requests
12
Merge Requests
12
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
ca5f6c02
Commit
ca5f6c02
authored
Jun 26, 2024
by
Alfredo Di Napoli
1
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Fix executables
parent
4b6991a3
Pipeline
#6281
failed with stages
in 10 minutes and 52 seconds
Changes
4
Pipelines
1
Hide whitespace changes
Inline
Side-by-side
Showing
4 changed files
with
18 additions
and
6 deletions
+18
-6
Main.hs
bin/gargantext-init/Main.hs
+6
-4
Main.hs
bin/gargantext-invitations/Main.hs
+2
-1
Setup.hs
test/Test/Database/Setup.hs
+5
-1
Types.hs
test/Test/Database/Types.hs
+5
-0
No files found.
bin/gargantext-init/Main.hs
View file @
ca5f6c02
...
@@ -24,12 +24,14 @@ import Gargantext.Database.Action.Flow (getOrMkRoot, getOrMkRootWithCorpus)
...
@@ -24,12 +24,14 @@ import Gargantext.Database.Action.Flow (getOrMkRoot, getOrMkRootWithCorpus)
import
Gargantext.Database.Admin.Trigger.Init
(
initFirstTriggers
,
initLastTriggers
)
import
Gargantext.Database.Admin.Trigger.Init
(
initFirstTriggers
,
initLastTriggers
)
import
Gargantext.Database.Admin.Types.Hyperdata
(
HyperdataCorpus
)
import
Gargantext.Database.Admin.Types.Hyperdata
(
HyperdataCorpus
)
import
Gargantext.Database.Admin.Types.Node
import
Gargantext.Database.Admin.Types.Node
import
Gargantext.Database.Prelude
(
Cmd
,
DBCmd
)
import
Gargantext.Database.Prelude
(
DBCmd
)
import
Gargantext.Database.Query.Table.Node
(
getOrMkList
)
import
Gargantext.Database.Query.Table.Node
(
getOrMkList
)
import
Gargantext.Database.Query.Table.User
(
insertNewUsers
,
)
import
Gargantext.Database.Query.Table.User
(
insertNewUsers
,
)
import
Gargantext.Database.Query.Tree.Root
(
MkCorpusUser
(
MkCorpusUserMaster
))
import
Gargantext.Database.Query.Tree.Root
(
MkCorpusUser
(
MkCorpusUserMaster
))
import
Gargantext.Prelude
import
Gargantext.Prelude
import
Gargantext.Prelude.Config
(
GargConfig
(
..
),
readConfig
)
import
Gargantext.Prelude.Config
(
GargConfig
(
..
),
readConfig
)
import
Gargantext.API.Admin.Types
import
Gargantext.Database.Prelude
(
DBCmd
'
)
main
::
IO
()
main
::
IO
()
...
@@ -49,18 +51,18 @@ main = do
...
@@ -49,18 +51,18 @@ main = do
cfg
<-
readConfig
iniPath
cfg
<-
readConfig
iniPath
let
secret
=
_gc_secretkey
cfg
let
secret
=
_gc_secretkey
cfg
let
createUsers
::
Cmd
BackendInternalError
Int64
let
createUsers
::
forall
env
.
HasSettings
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
::
Cmd
BackendInternalError
[(
UserId
,
RootId
)]
mkRoots
::
forall
env
.
HasSettings
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
::
Cmd
BackendInternalError
(
UserId
,
RootId
,
CorpusId
,
ListId
)
initMaster
::
forall
env
.
HasSettings
env
=>
DBCmd'
env
BackendInternalError
(
UserId
,
RootId
,
CorpusId
,
ListId
)
initMaster
=
do
initMaster
=
do
(
masterUserId
,
masterRootId
,
masterCorpusId
)
(
masterUserId
,
masterRootId
,
masterCorpusId
)
<-
getOrMkRootWithCorpus
MkCorpusUserMaster
<-
getOrMkRootWithCorpus
MkCorpusUserMaster
...
...
bin/gargantext-invitations/Main.hs
View file @
ca5f6c02
...
@@ -17,6 +17,7 @@ module Main where
...
@@ -17,6 +17,7 @@ module Main where
import
Gargantext.API.Dev
(
withDevEnv
,
runCmdDev
)
import
Gargantext.API.Dev
(
withDevEnv
,
runCmdDev
)
import
Gargantext.API.Node
()
-- instances only
import
Gargantext.API.Node
()
-- instances only
import
Gargantext.API.Errors.Types
import
Gargantext.API.Errors.Types
import
Gargantext.API.Admin.Types
import
Gargantext.Core.NLP
(
HasNLPServer
)
import
Gargantext.Core.NLP
(
HasNLPServer
)
import
Gargantext.Core.Types.Individu
(
User
(
..
))
import
Gargantext.Core.Types.Individu
(
User
(
..
))
import
Gargantext.Database.Admin.Types.Node
import
Gargantext.Database.Admin.Types.Node
...
@@ -37,7 +38,7 @@ main = do
...
@@ -37,7 +38,7 @@ main = do
_cfg
<-
readConfig
iniPath
_cfg
<-
readConfig
iniPath
let
invite
::
(
CmdRandom
env
BackendInternalError
m
,
HasNLPServer
env
)
=>
m
Int
let
invite
::
(
HasSettings
env
,
CmdRandom
env
BackendInternalError
m
,
HasNLPServer
env
)
=>
m
Int
invite
=
Share
.
api
(
UserName
$
cs
user
)
(
UnsafeMkNodeId
$
(
read
node_id
::
Int
))
(
Share
.
ShareTeamParams
$
cs
email
)
invite
=
Share
.
api
(
UserName
$
cs
user
)
(
UnsafeMkNodeId
$
(
read
node_id
::
Int
))
(
Share
.
ShareTeamParams
$
cs
email
)
withDevEnv
iniPath
$
\
env
->
do
withDevEnv
iniPath
$
\
env
->
do
...
...
test/Test/Database/Setup.hs
View file @
ca5f6c02
...
@@ -15,6 +15,7 @@ import Database.PostgreSQL.Simple.Options qualified as Client
...
@@ -15,6 +15,7 @@ import Database.PostgreSQL.Simple.Options qualified as Client
import
Database.PostgreSQL.Simple.Options
qualified
as
Opts
import
Database.PostgreSQL.Simple.Options
qualified
as
Opts
import
Database.Postgres.Temp
qualified
as
Tmp
import
Database.Postgres.Temp
qualified
as
Tmp
import
Gargantext.API.Admin.EnvTypes
(
Mode
(
Mock
))
import
Gargantext.API.Admin.EnvTypes
(
Mode
(
Mock
))
import
Gargantext.API.Admin.Settings
import
Gargantext.Core.NodeStory
(
fromDBNodeStoryEnv
)
import
Gargantext.Core.NodeStory
(
fromDBNodeStoryEnv
)
import
Gargantext.Prelude
import
Gargantext.Prelude
import
Gargantext.Prelude.Config
import
Gargantext.Prelude.Config
...
@@ -73,12 +74,15 @@ setup = do
...
@@ -73,12 +74,15 @@ setup = do
bootstrapDB
db
pool
gargConfig
bootstrapDB
db
pool
gargConfig
ugen
<-
emptyCounter
ugen
<-
emptyCounter
test_nodeStory
<-
fromDBNodeStoryEnv
pool
test_nodeStory
<-
fromDBNodeStoryEnv
pool
stgs
<-
devSettings
devJwkFile
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
()
withTestDB
=
bracket
setup
teardown
withTestDB
=
bracket
setup
teardown
...
...
test/Test/Database/Types.hs
View file @
ca5f6c02
...
@@ -28,6 +28,7 @@ import Database.Postgres.Temp qualified as Tmp
...
@@ -28,6 +28,7 @@ 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.Mail.Types
(
HasMail
(
..
))
import
Gargantext.Core.Mail.Types
(
HasMail
(
..
))
...
@@ -61,6 +62,7 @@ data TestEnv = TestEnv {
...
@@ -61,6 +62,7 @@ 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
}
...
@@ -104,6 +106,9 @@ instance HasConnectionPool TestEnv where
...
@@ -104,6 +106,9 @@ 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
...
...
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