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
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
Christian Merten
haskell-gargantext
Commits
0389f732
Commit
0389f732
authored
Oct 07, 2024
by
Alfredo Di Napoli
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Add public nodes SQL queries
It also adds tests for getUserRootPublicNode
parent
66dbcdac
Changes
15
Hide whitespace changes
Inline
Side-by-side
Showing
15 changed files
with
150 additions
and
21 deletions
+150
-21
gargantext.cabal
gargantext.cabal
+2
-0
Errors.hs
src/Gargantext/API/Errors.hs
+2
-0
Types.hs
src/Gargantext/API/Errors/Types.hs
+15
-0
Backend.hs
src/Gargantext/API/Errors/Types/Backend.hs
+1
-0
Node.hs
src/Gargantext/Database/Query/Table/Node.hs
+58
-2
Error.hs
src/Gargantext/Database/Query/Table/Node/Error.hs
+2
-0
NodeNode.hs
src/Gargantext/Database/Query/Table/NodeNode.hs
+14
-2
Share.hs
test/Test/API/Private/Share.hs
+1
-1
Setup.hs
test/Test/API/Setup.hs
+11
-9
UpdateList.hs
test/Test/API/UpdateList.hs
+1
-1
Operations.hs
test/Test/Database/Operations.hs
+4
-1
PublishNode.hs
test/Test/Database/Operations/PublishNode.hs
+32
-0
Instances.hs
test/Test/Instances.hs
+3
-0
ReverseProxy.hs
test/Test/Server/ReverseProxy.hs
+2
-1
Main.hs
test/drivers/hspec/Main.hs
+2
-4
No files found.
gargantext.cabal
View file @
0389f732
...
@@ -813,6 +813,7 @@ test-suite garg-test-tasty
...
@@ -813,6 +813,7 @@ test-suite garg-test-tasty
Test.Database.Operations
Test.Database.Operations
Test.Database.Operations.DocumentSearch
Test.Database.Operations.DocumentSearch
Test.Database.Operations.NodeStory
Test.Database.Operations.NodeStory
Test.Database.Operations.PublishNode
Test.Database.Setup
Test.Database.Setup
Test.Database.Types
Test.Database.Types
Test.Graph.Clustering
Test.Graph.Clustering
...
@@ -863,6 +864,7 @@ test-suite garg-test-hspec
...
@@ -863,6 +864,7 @@ test-suite garg-test-hspec
Test.Database.Operations
Test.Database.Operations
Test.Database.Operations.DocumentSearch
Test.Database.Operations.DocumentSearch
Test.Database.Operations.NodeStory
Test.Database.Operations.NodeStory
Test.Database.Operations.PublishNode
Test.Database.Setup
Test.Database.Setup
Test.Database.Types
Test.Database.Types
Test.Instances
Test.Instances
...
...
src/Gargantext/API/Errors.hs
View file @
0389f732
...
@@ -155,6 +155,8 @@ nodeErrorToFrontendError ne = case ne of
...
@@ -155,6 +155,8 @@ nodeErrorToFrontendError ne = case ne of
->
mkFrontendErrShow
$
FE_node_lookup_failed_username_not_found
uname
->
mkFrontendErrShow
$
FE_node_lookup_failed_username_not_found
uname
UserHasTooManyRoots
uid
roots
UserHasTooManyRoots
uid
roots
->
mkFrontendErrShow
$
FE_node_lookup_failed_user_too_many_roots
uid
roots
->
mkFrontendErrShow
$
FE_node_lookup_failed_user_too_many_roots
uid
roots
UserPublicFolderDoesNotExist
uid
->
mkFrontendErrShow
$
FE_node_lookup_failed_user_no_public_folder
uid
NotImplYet
NotImplYet
->
mkFrontendErrShow
FE_node_not_implemented_yet
->
mkFrontendErrShow
FE_node_not_implemented_yet
NoContextFound
contextId
NoContextFound
contextId
...
...
src/Gargantext/API/Errors/Types.hs
View file @
0389f732
...
@@ -215,6 +215,10 @@ data instance ToFrontendErrorData 'EC_400__node_lookup_failed_user_too_many_root
...
@@ -215,6 +215,10 @@ data instance ToFrontendErrorData 'EC_400__node_lookup_failed_user_too_many_root
}
}
deriving
(
Show
,
Eq
,
Generic
)
deriving
(
Show
,
Eq
,
Generic
)
data
instance
ToFrontendErrorData
'E
C
_404__node_lookup_failed_user_no_public_folder
=
FE_node_lookup_failed_user_no_public_folder
{
nenpf_user_id
::
UserId
}
deriving
(
Show
,
Eq
,
Generic
)
newtype
instance
ToFrontendErrorData
'E
C
_404__node_context_not_found
=
newtype
instance
ToFrontendErrorData
'E
C
_404__node_context_not_found
=
FE_node_context_not_found
{
necnf_context_id
::
ContextId
}
FE_node_context_not_found
{
necnf_context_id
::
ContextId
}
deriving
(
Show
,
Eq
,
Generic
)
deriving
(
Show
,
Eq
,
Generic
)
...
@@ -400,6 +404,14 @@ instance FromJSON (ToFrontendErrorData 'EC_400__node_lookup_failed_user_too_many
...
@@ -400,6 +404,14 @@ instance FromJSON (ToFrontendErrorData 'EC_400__node_lookup_failed_user_too_many
netmr_roots
<-
o
.:
"roots"
netmr_roots
<-
o
.:
"roots"
pure
FE_node_lookup_failed_user_too_many_roots
{
..
}
pure
FE_node_lookup_failed_user_too_many_roots
{
..
}
instance
ToJSON
(
ToFrontendErrorData
'E
C
_404__node_lookup_failed_user_no_public_folder
)
where
toJSON
(
FE_node_lookup_failed_user_no_public_folder
userId
)
=
object
[
"user_id"
.=
toJSON
userId
]
instance
FromJSON
(
ToFrontendErrorData
'E
C
_404__node_lookup_failed_user_no_public_folder
)
where
parseJSON
=
withObject
"FE_node_lookup_failed_user_no_public_folder"
$
\
o
->
do
nenpf_user_id
<-
o
.:
"user_id"
pure
FE_node_lookup_failed_user_no_public_folder
{
..
}
instance
ToJSON
(
ToFrontendErrorData
'E
C
_404__node_context_not_found
)
where
instance
ToJSON
(
ToFrontendErrorData
'E
C
_404__node_context_not_found
)
where
toJSON
(
FE_node_context_not_found
cId
)
=
object
[
"context_id"
.=
toJSON
cId
]
toJSON
(
FE_node_context_not_found
cId
)
=
object
[
"context_id"
.=
toJSON
cId
]
instance
FromJSON
(
ToFrontendErrorData
'E
C
_404__node_context_not_found
)
where
instance
FromJSON
(
ToFrontendErrorData
'E
C
_404__node_context_not_found
)
where
...
@@ -616,6 +628,9 @@ instance FromJSON FrontendError where
...
@@ -616,6 +628,9 @@ instance FromJSON FrontendError where
EC_400__node_lookup_failed_user_too_many_roots
->
do
EC_400__node_lookup_failed_user_too_many_roots
->
do
(
fe_data
::
ToFrontendErrorData
'E
C
_400__node_lookup_failed_user_too_many_roots
)
<-
o
.:
"data"
(
fe_data
::
ToFrontendErrorData
'E
C
_400__node_lookup_failed_user_too_many_roots
)
<-
o
.:
"data"
pure
FrontendError
{
..
}
pure
FrontendError
{
..
}
EC_404__node_lookup_failed_user_no_public_folder
->
do
(
fe_data
::
ToFrontendErrorData
'E
C
_404__node_lookup_failed_user_no_public_folder
)
<-
o
.:
"data"
pure
FrontendError
{
..
}
EC_500__node_not_implemented_yet
->
do
EC_500__node_not_implemented_yet
->
do
(
fe_data
::
ToFrontendErrorData
'E
C
_500__node_not_implemented_yet
)
<-
o
.:
"data"
(
fe_data
::
ToFrontendErrorData
'E
C
_500__node_not_implemented_yet
)
<-
o
.:
"data"
pure
FrontendError
{
..
}
pure
FrontendError
{
..
}
...
...
src/Gargantext/API/Errors/Types/Backend.hs
View file @
0389f732
...
@@ -23,6 +23,7 @@ data BackendErrorCode
...
@@ -23,6 +23,7 @@ data BackendErrorCode
|
EC_400__node_lookup_failed_user_too_many_roots
|
EC_400__node_lookup_failed_user_too_many_roots
|
EC_404__node_lookup_failed_user_not_found
|
EC_404__node_lookup_failed_user_not_found
|
EC_404__node_lookup_failed_username_not_found
|
EC_404__node_lookup_failed_username_not_found
|
EC_404__node_lookup_failed_user_no_public_folder
|
EC_404__node_corpus_not_found
|
EC_404__node_corpus_not_found
|
EC_500__node_not_implemented_yet
|
EC_500__node_not_implemented_yet
|
EC_404__node_context_not_found
|
EC_404__node_context_not_found
...
...
src/Gargantext/Database/Query/Table/Node.hs
View file @
0389f732
...
@@ -15,8 +15,46 @@ Portability : POSIX
...
@@ -15,8 +15,46 @@ Portability : POSIX
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE ViewPatterns #-}
{-# OPTIONS_GHC -fno-warn-unused-binds #-}
module
Gargantext.Database.Query.Table.Node
module
Gargantext.Database.Query.Table.Node
where
(
-- * Smart constructors, classes, defaults and helper functions
defaultList
,
MkCorpus
(
..
)
,
node
,
queryNodeSearchTable
-- * Queries that returns a single node
,
getClosestParentIdByType
,
getClosestParentIdByType'
,
getCorporaWithParentId
,
getNode
,
getNodeWith
,
getNodeWithType
,
getOrMkList
,
getUserRootPublicNode
,
selectNode
-- * Queries that returns multiple nodes
,
getChildrenByType
,
getClosestChildrenByType
,
getListsWithParentId
,
getNodesIdWithType
,
getNodesWith
,
getNodesWithParentId
,
getNodesWithType
-- * Creating one or more nodes
,
insertDefaultNode
,
insertDefaultNodeIfNotExists
,
insertNode
,
insertNodesWithParentR
-- * Deleting one or more nodes
,
deleteNode
,
deleteNodes
)
where
import
Control.Arrow
(
returnA
)
import
Control.Arrow
(
returnA
)
import
Control.Lens
(
set
,
view
)
import
Control.Lens
(
set
,
view
)
...
@@ -28,11 +66,12 @@ import Gargantext.Core.Types
...
@@ -28,11 +66,12 @@ import Gargantext.Core.Types
import
Gargantext.Core.Types.Query
(
Limit
,
Offset
)
import
Gargantext.Core.Types.Query
(
Limit
,
Offset
)
import
Gargantext.Database.Admin.Types.Hyperdata.Any
(
HyperdataAny
)
import
Gargantext.Database.Admin.Types.Hyperdata.Any
(
HyperdataAny
)
import
Gargantext.Database.Admin.Types.Hyperdata.Corpus
(
HyperdataAnnuaire
,
HyperdataCorpus
)
import
Gargantext.Database.Admin.Types.Hyperdata.Corpus
(
HyperdataAnnuaire
,
HyperdataCorpus
)
import
Gargantext.Database.Admin.Types.Hyperdata.Default
(
defaultHyperdata
,
DefaultHyperdata
(
..
)
)
import
Gargantext.Database.Admin.Types.Hyperdata.Document
(
HyperdataDocument
,
HyperdataDocumentV3
)
import
Gargantext.Database.Admin.Types.Hyperdata.Document
(
HyperdataDocument
,
HyperdataDocumentV3
)
import
Gargantext.Database.Admin.Types.Hyperdata.Folder
(
HyperdataFolder
)
import
Gargantext.Database.Admin.Types.Hyperdata.List
(
HyperdataList
)
import
Gargantext.Database.Admin.Types.Hyperdata.List
(
HyperdataList
)
import
Gargantext.Database.Admin.Types.Hyperdata.Model
(
HyperdataModel
)
import
Gargantext.Database.Admin.Types.Hyperdata.Model
(
HyperdataModel
)
import
Gargantext.Database.Admin.Types.Hyperdata.Prelude
(
Hyperdata
)
import
Gargantext.Database.Admin.Types.Hyperdata.Prelude
(
Hyperdata
)
import
Gargantext.Database.Admin.Types.Hyperdata.Default
(
defaultHyperdata
,
DefaultHyperdata
(
..
)
)
import
Gargantext.Database.Prelude
(
DBCmd
,
JSONB
,
mkCmd
,
runPGSQuery
,
runOpaQuery
)
import
Gargantext.Database.Prelude
(
DBCmd
,
JSONB
,
mkCmd
,
runPGSQuery
,
runOpaQuery
)
import
Gargantext.Database.Query.Filter
(
limit'
,
offset'
)
import
Gargantext.Database.Query.Filter
(
limit'
,
offset'
)
import
Gargantext.Database.Query.Table.Node.Error
import
Gargantext.Database.Query.Table.Node.Error
...
@@ -442,3 +481,20 @@ defaultListMaybe cId = headMay <$> map (view node_id ) <$> getListsWithParentId
...
@@ -442,3 +481,20 @@ defaultListMaybe cId = headMay <$> map (view node_id ) <$> getListsWithParentId
getListsWithParentId
::
HasDBid
NodeType
=>
NodeId
->
DBCmd
err
[
Node
HyperdataList
]
getListsWithParentId
::
HasDBid
NodeType
=>
NodeId
->
DBCmd
err
[
Node
HyperdataList
]
getListsWithParentId
n
=
runOpaQuery
$
selectNodesWith'
n
(
Just
NodeList
)
getListsWithParentId
n
=
runOpaQuery
$
selectNodesWith'
n
(
Just
NodeList
)
-- | Returns the /root/ public node for the input user. By root we mean that
-- if we were to traverse all the parents of the result, we wouldn't find any
-- other parent which 'NodeType' was 'NodeFolderPublic'.
getUserRootPublicNode
::
(
HasNodeError
err
,
HasDBid
NodeType
)
=>
UserId
->
DBCmd
err
(
Node
HyperdataFolder
)
getUserRootPublicNode
userId
=
do
result
<-
runOpaQuery
$
do
n
<-
queryNodeTable
where_
$
(
n
^.
node_typename
.==
sqlInt4
(
toDBid
NodeFolderPublic
))
.&&
(
n
^.
node_user_id
.==
sqlInt4
(
_UserId
userId
))
pure
n
case
result
of
[]
->
nodeError
$
NodeLookupFailed
$
UserPublicFolderDoesNotExist
userId
[
n
]
->
pure
n
folders
->
nodeError
$
NodeLookupFailed
$
UserHasTooManyRoots
userId
(
map
_node_id
folders
)
src/Gargantext/Database/Query/Table/Node/Error.hs
View file @
0389f732
...
@@ -57,6 +57,7 @@ data NodeLookupError
...
@@ -57,6 +57,7 @@ data NodeLookupError
|
UserDoesNotExist
UserId
|
UserDoesNotExist
UserId
|
UserNameDoesNotExist
Username
|
UserNameDoesNotExist
Username
|
UserHasTooManyRoots
UserId
[
NodeId
]
|
UserHasTooManyRoots
UserId
[
NodeId
]
|
UserPublicFolderDoesNotExist
UserId
deriving
(
Show
,
Eq
,
Generic
)
deriving
(
Show
,
Eq
,
Generic
)
instance
ToJSON
NodeLookupError
instance
ToJSON
NodeLookupError
...
@@ -68,6 +69,7 @@ renderNodeLookupFailed = \case
...
@@ -68,6 +69,7 @@ renderNodeLookupFailed = \case
UserDoesNotExist
uid
->
"user with id "
<>
T
.
pack
(
show
uid
)
<>
" couldn't be found."
UserDoesNotExist
uid
->
"user with id "
<>
T
.
pack
(
show
uid
)
<>
" couldn't be found."
UserNameDoesNotExist
uname
->
"user with username '"
<>
uname
<>
"' couldn't be found."
UserNameDoesNotExist
uname
->
"user with username '"
<>
uname
<>
"' couldn't be found."
UserHasTooManyRoots
uid
roots
->
"user with id "
<>
T
.
pack
(
show
uid
)
<>
" has too many roots: ["
<>
T
.
intercalate
","
(
map
(
T
.
pack
.
show
)
roots
)
UserHasTooManyRoots
uid
roots
->
"user with id "
<>
T
.
pack
(
show
uid
)
<>
" has too many roots: ["
<>
T
.
intercalate
","
(
map
(
T
.
pack
.
show
)
roots
)
UserPublicFolderDoesNotExist
uid
->
"no public folder was found for user with id "
<>
T
.
pack
(
show
uid
)
------------------------------------------------------------------------
------------------------------------------------------------------------
data
NodeError
=
NoListFound
ListId
data
NodeError
=
NoListFound
ListId
...
...
src/Gargantext/Database/Query/Table/NodeNode.hs
View file @
0389f732
...
@@ -26,20 +26,23 @@ module Gargantext.Database.Query.Table.NodeNode
...
@@ -26,20 +26,23 @@ module Gargantext.Database.Query.Table.NodeNode
,
selectDocNodes
,
selectDocNodes
,
selectDocs
,
selectDocs
,
selectDocsDates
,
selectDocsDates
-- Queries on public nodes
,
selectPublicNodes
,
selectPublicNodes
,
isNodeReadOnly
)
)
where
where
import
Control.Arrow
(
returnA
)
import
Control.Arrow
(
returnA
)
import
Control.Lens
(
view
)
import
Control.Lens
(
view
)
import
Data.Text
(
splitOn
)
import
Database.PostgreSQL.Simple
qualified
as
PGS
import
Database.PostgreSQL.Simple
qualified
as
PGS
import
Database.PostgreSQL.Simple.SqlQQ
(
sql
)
import
Database.PostgreSQL.Simple.SqlQQ
(
sql
)
import
Database.PostgreSQL.Simple.Types
(
Values
(
..
),
QualifiedIdentifier
(
..
))
import
Database.PostgreSQL.Simple.Types
(
Values
(
..
),
QualifiedIdentifier
(
..
))
import
Data.Text
(
splitOn
)
import
Gargantext.Core
(
HasDBid
(
toDBid
)
)
import
Gargantext.Core
(
HasDBid
(
toDBid
)
)
import
Gargantext.Database.Admin.Types.Node
import
Gargantext.Database.Admin.Types.Hyperdata.Document
(
HyperdataDocument
,
hd_publication_date
)
import
Gargantext.Database.Admin.Types.Hyperdata.Document
(
HyperdataDocument
,
hd_publication_date
)
import
Gargantext.Database.Admin.Types.Hyperdata.Prelude
(
Hyperdata
)
import
Gargantext.Database.Admin.Types.Hyperdata.Prelude
(
Hyperdata
)
import
Gargantext.Database.Admin.Types.Node
import
Gargantext.Database.Prelude
(
DBCmd
,
mkCmd
,
runPGSQuery
,
runCountOpaQuery
,
runOpaQuery
)
import
Gargantext.Database.Prelude
(
DBCmd
,
mkCmd
,
runPGSQuery
,
runCountOpaQuery
,
runOpaQuery
)
import
Gargantext.Database.Schema.Ngrams
()
import
Gargantext.Database.Schema.Ngrams
()
import
Gargantext.Database.Schema.Node
import
Gargantext.Database.Schema.Node
...
@@ -227,10 +230,19 @@ joinInCorpus = proc () -> do
...
@@ -227,10 +230,19 @@ joinInCorpus = proc () -> do
------------------------------------------------------------------------
------------------------------------------------------------------------
-- | Returns /all/ the public nodes, i.e. nodes which 'NodeType' is
-- 'NodeFolderPublic'. Each user, upon creation, receives his/her personal
-- public folder. Nodes placed inside /any/ public folder is visible into
-- /any other/ public folder.
selectPublicNodes
::
HasDBid
NodeType
=>
(
Hyperdata
a
,
DefaultFromField
SqlJsonb
a
)
selectPublicNodes
::
HasDBid
NodeType
=>
(
Hyperdata
a
,
DefaultFromField
SqlJsonb
a
)
=>
DBCmd
err
[(
Node
a
,
Maybe
Int
)]
=>
DBCmd
err
[(
Node
a
,
Maybe
Int
)]
selectPublicNodes
=
runOpaQuery
(
queryWithType
NodeFolderPublic
)
selectPublicNodes
=
runOpaQuery
(
queryWithType
NodeFolderPublic
)
-- | A 'Node' is read-only if there exist a match in the node_nodes directory
-- where the source is a public folder.
isNodeReadOnly
::
NodeId
->
DBCmd
err
Bool
isNodeReadOnly
_
=
panicTrace
"todo isNodeReadOnly"
queryWithType
::
HasDBid
NodeType
queryWithType
::
HasDBid
NodeType
=>
NodeType
=>
NodeType
->
O
.
Select
(
NodeRead
,
MaybeFields
(
Column
SqlInt4
))
->
O
.
Select
(
NodeRead
,
MaybeFields
(
Column
SqlInt4
))
...
...
test/Test/API/Private/Share.hs
View file @
0389f732
...
@@ -46,7 +46,7 @@ tests = sequential $ aroundAll withTestDBAndPort $ do
...
@@ -46,7 +46,7 @@ tests = sequential $ aroundAll withTestDBAndPort $ do
it
"setup DB triggers"
$
\
((
testEnv
,
_
),
_
)
->
do
it
"setup DB triggers"
$
\
((
testEnv
,
_
),
_
)
->
do
setupEnvironment
testEnv
setupEnvironment
testEnv
-- Let's create the Alice user.
-- Let's create the Alice user.
createAliceAndBob
testEnv
void
$
createAliceAndBob
testEnv
it
"should fail if no node type is specified"
$
\
((
_testEnv
,
serverPort
),
app
)
->
do
it
"should fail if no node type is specified"
$
\
((
_testEnv
,
serverPort
),
app
)
->
do
withApplication
app
$
do
withApplication
app
$
do
...
...
test/Test/API/Setup.hs
View file @
0389f732
...
@@ -10,10 +10,10 @@ import Control.Monad.Reader
...
@@ -10,10 +10,10 @@ import Control.Monad.Reader
import
Data.ByteString.Lazy.Char8
qualified
as
C8L
import
Data.ByteString.Lazy.Char8
qualified
as
C8L
import
Data.Cache
qualified
as
InMemory
import
Data.Cache
qualified
as
InMemory
import
Data.Streaming.Network
(
bindPortTCP
)
import
Data.Streaming.Network
(
bindPortTCP
)
import
Gargantext.API
(
makeApp
)
import
Gargantext.API.Admin.EnvTypes
(
Mode
(
Mock
),
Env
(
..
))
import
Gargantext.API.Admin.EnvTypes
(
Mode
(
Mock
),
Env
(
..
))
import
Gargantext.API.Admin.Settings
import
Gargantext.API.Admin.Settings
import
Gargantext.API.Errors.Types
import
Gargantext.API.Errors.Types
import
Gargantext.API
(
makeApp
)
import
Gargantext.API.Prelude
import
Gargantext.API.Prelude
import
Gargantext.Core.Config
(
_gc_secrets
,
gc_frontend_config
,
gc_jobs
,
hasConfig
)
import
Gargantext.Core.Config
(
_gc_secrets
,
gc_frontend_config
,
gc_jobs
,
hasConfig
)
import
Gargantext.Core.Config.Types
(
SettingsFile
(
..
),
jc_js_job_timeout
,
jc_js_id_timeout
,
fc_appPort
,
jwtSettings
)
import
Gargantext.Core.Config.Types
(
SettingsFile
(
..
),
jc_js_job_timeout
,
jc_js_id_timeout
,
fc_appPort
,
jwtSettings
)
...
@@ -25,22 +25,23 @@ import Gargantext.Database.Action.User.New
...
@@ -25,22 +25,23 @@ import Gargantext.Database.Action.User.New
import
Gargantext.Database.Admin.Config
(
userMaster
)
import
Gargantext.Database.Admin.Config
(
userMaster
)
import
Gargantext.Database.Admin.Trigger.Init
import
Gargantext.Database.Admin.Trigger.Init
import
Gargantext.Database.Admin.Types.Hyperdata
import
Gargantext.Database.Admin.Types.Hyperdata
import
Gargantext.Database.Admin.Types.Node
import
Gargantext.Database.Prelude
()
import
Gargantext.Database.Prelude
()
import
Gargantext.Database.Query.Table.Node
(
getOrMkList
)
import
Gargantext.Database.Query.Table.Node
(
getOrMkList
)
import
Gargantext.Database.Query.Tree.Root
(
MkCorpusUser
(
..
))
import
Gargantext.Database.Query.Tree.Root
(
MkCorpusUser
(
..
))
import
Gargantext.MicroServices.ReverseProxy
(
microServicesProxyApp
)
import
Gargantext.MicroServices.ReverseProxy
(
microServicesProxyApp
)
import
Gargantext.System.Logging
import
Gargantext.System.Logging
import
Gargantext.Utils.Jobs
qualified
as
Jobs
import
Gargantext.Utils.Jobs.Monad
qualified
as
Jobs
import
Gargantext.Utils.Jobs.Monad
qualified
as
Jobs
import
Gargantext.Utils.Jobs
qualified
as
Jobs
import
Gargantext.Utils.Jobs.Queue
qualified
as
Jobs
import
Gargantext.Utils.Jobs.Queue
qualified
as
Jobs
import
Gargantext.Utils.Jobs.Settings
qualified
as
Jobs
import
Gargantext.Utils.Jobs.Settings
qualified
as
Jobs
import
Network.HTTP.Client.TLS
(
newTlsManager
)
import
Network.HTTP.Client.TLS
(
newTlsManager
)
import
Network.HTTP.Types
import
Network.HTTP.Types
import
Network.Wai
(
Application
,
responseLBS
)
import
Network.Wai
(
Application
,
responseLBS
)
import
Network.Wai
qualified
as
Wai
import
Network.Wai.Handler.Warp
(
runSettingsSocket
)
import
Network.Wai.Handler.Warp
qualified
as
Warp
import
Network.Wai.Handler.Warp.Internal
import
Network.Wai.Handler.Warp.Internal
import
Network.Wai.Handler.Warp
qualified
as
Warp
import
Network.Wai.Handler.Warp
(
runSettingsSocket
)
import
Network.Wai
qualified
as
Wai
import
Prelude
import
Prelude
import
Servant.Auth.Client
()
import
Servant.Auth.Client
()
import
Servant.Client
import
Servant.Client
...
@@ -155,14 +156,15 @@ setupEnvironment env = flip runReaderT env $ runTestMonad $ do
...
@@ -155,14 +156,15 @@ setupEnvironment env = flip runReaderT env $ runTestMonad $ do
-- | Creates two users, Alice & Bob. Alice shouldn't be able to see
-- | Creates two users, Alice & Bob. Alice shouldn't be able to see
-- Bob's private data and vice-versa.
-- Bob's private data and vice-versa.
createAliceAndBob
::
TestEnv
->
IO
()
createAliceAndBob
::
TestEnv
->
IO
[
UserId
]
createAliceAndBob
testEnv
=
do
createAliceAndBob
testEnv
=
do
void
$
flip
runReaderT
testEnv
$
runTestMonad
$
do
flip
runReaderT
testEnv
$
runTestMonad
$
do
let
nur1
=
mkNewUser
"alice@gargan.text"
(
GargPassword
"alice"
)
let
nur1
=
mkNewUser
"alice@gargan.text"
(
GargPassword
"alice"
)
let
nur2
=
mkNewUser
"bob@gargan.text"
(
GargPassword
"bob"
)
let
nur2
=
mkNewUser
"bob@gargan.text"
(
GargPassword
"bob"
)
void
$
new_user
nur1
aliceId
<-
new_user
nur1
void
$
new_user
nur2
bobId
<-
new_user
nur2
pure
[
aliceId
,
bobId
]
-- show the full exceptions during testing, rather than shallowing them under a generic
-- show the full exceptions during testing, rather than shallowing them under a generic
-- "Something went wrong".
-- "Something went wrong".
...
...
test/Test/API/UpdateList.hs
View file @
0389f732
...
@@ -116,7 +116,7 @@ tests = sequential $ aroundAll withTestDBAndPort $ do
...
@@ -116,7 +116,7 @@ tests = sequential $ aroundAll withTestDBAndPort $ do
describe
"UpdateList API"
$
do
describe
"UpdateList API"
$
do
it
"setup DB triggers and users"
$
\
((
testEnv
,
_
),
_
)
->
do
it
"setup DB triggers and users"
$
\
((
testEnv
,
_
),
_
)
->
do
setupEnvironment
testEnv
setupEnvironment
testEnv
createAliceAndBob
testEnv
void
$
createAliceAndBob
testEnv
describe
"POST /api/v1.0/lists/:id/add/form/async (JSON)"
$
do
describe
"POST /api/v1.0/lists/:id/add/form/async (JSON)"
$
do
...
...
test/Test/Database/Operations.hs
View file @
0389f732
...
@@ -30,6 +30,7 @@ import Gargantext.Prelude
...
@@ -30,6 +30,7 @@ import Gargantext.Prelude
import
Test.API.Setup
(
setupEnvironment
)
import
Test.API.Setup
(
setupEnvironment
)
import
Test.Database.Operations.DocumentSearch
import
Test.Database.Operations.DocumentSearch
import
Test.Database.Operations.NodeStory
import
Test.Database.Operations.NodeStory
import
Test.Database.Operations.PublishNode
import
Test.Database.Setup
(
withTestDB
)
import
Test.Database.Setup
(
withTestDB
)
import
Test.Database.Types
import
Test.Database.Types
import
Test.Hspec
import
Test.Hspec
...
@@ -68,7 +69,9 @@ tests = sequential $ aroundAll withTestDB $ describe "Database" $ do
...
@@ -68,7 +69,9 @@ tests = sequential $ aroundAll withTestDB $ describe "Database" $ do
it
"Can perform more complex searches using the boolean API"
corpusSearch03
it
"Can perform more complex searches using the boolean API"
corpusSearch03
it
"Can correctly count doc score"
corpusScore01
it
"Can correctly count doc score"
corpusScore01
it
"Can perform search with spaces for doc in db"
corpusSearchDB01
it
"Can perform search with spaces for doc in db"
corpusSearchDB01
describe
"Publishing a node"
$
do
it
"Returns the root public folder for a user"
testGetUserRootPublicNode
nodeStoryTests
::
Spec
nodeStoryTests
::
Spec
nodeStoryTests
=
sequential
$
nodeStoryTests
=
sequential
$
-- run 'withTestDB' before _every_ test item
-- run 'withTestDB' before _every_ test item
...
...
test/Test/Database/Operations/PublishNode.hs
0 → 100644
View file @
0389f732
{-|
Module : Test.Database.Operations.PublishNode
Description : GarganText database tests
Copyright : (c) CNRS, 2017-Present
License : AGPL + CECILL v3
Maintainer : team@gargantext.org
Stability : experimental
Portability : POSIX
-}
{-# LANGUAGE QuasiQuotes #-}
module
Test.Database.Operations.PublishNode
where
import
Prelude
import
Control.Monad.Reader
import
Gargantext.Core
import
Gargantext.Database.Admin.Types.Node
import
Gargantext.Database.Query.Table.Node
import
Gargantext.Database.Schema.Node
(
NodePoly
(
..
))
import
Test.API.Setup
(
createAliceAndBob
)
import
Test.Database.Types
import
Test.Tasty.HUnit
testGetUserRootPublicNode
::
TestEnv
->
Assertion
testGetUserRootPublicNode
testEnv
=
do
[
aliceId
,
_bobId
]
<-
createAliceAndBob
testEnv
alicePublicFolder
<-
flip
runReaderT
testEnv
$
runTestMonad
$
do
getUserRootPublicNode
aliceId
_node_typename
alicePublicFolder
@?=
(
toDBid
NodeFolderPublic
)
test/Test/Instances.hs
View file @
0389f732
...
@@ -266,6 +266,9 @@ genFrontendErr be = do
...
@@ -266,6 +266,9 @@ genFrontendErr be = do
->
do
userId
<-
arbitrary
->
do
userId
<-
arbitrary
roots
<-
arbitrary
roots
<-
arbitrary
pure
$
Errors
.
mkFrontendErr'
txt
(
Errors
.
FE_node_lookup_failed_user_too_many_roots
userId
roots
)
pure
$
Errors
.
mkFrontendErr'
txt
(
Errors
.
FE_node_lookup_failed_user_too_many_roots
userId
roots
)
Errors
.
EC_404__node_lookup_failed_user_no_public_folder
->
do
userId
<-
arbitrary
pure
$
Errors
.
mkFrontendErr'
txt
(
Errors
.
FE_node_lookup_failed_user_no_public_folder
userId
)
Errors
.
EC_404__node_context_not_found
Errors
.
EC_404__node_context_not_found
->
do
contextId
<-
arbitrary
->
do
contextId
<-
arbitrary
pure
$
Errors
.
mkFrontendErr'
txt
(
Errors
.
FE_node_context_not_found
contextId
)
pure
$
Errors
.
mkFrontendErr'
txt
(
Errors
.
FE_node_context_not_found
contextId
)
...
...
test/Test/Server/ReverseProxy.hs
View file @
0389f732
module
Test.Server.ReverseProxy
where
module
Test.Server.ReverseProxy
where
import
Control.Monad
(
void
)
import
Data.Function
((
&
))
import
Data.Function
((
&
))
import
Gargantext.MicroServices.ReverseProxy
import
Gargantext.MicroServices.ReverseProxy
import
Network.HTTP.Client
import
Network.HTTP.Client
...
@@ -52,7 +53,7 @@ writeFrameTests = sequential $ aroundAll withBackendServerAndProxy $ do
...
@@ -52,7 +53,7 @@ writeFrameTests = sequential $ aroundAll withBackendServerAndProxy $ do
it
"should allow authenticated requests"
$
\
(
testEnv
,
serverPort
,
proxyPort
)
->
do
it
"should allow authenticated requests"
$
\
(
testEnv
,
serverPort
,
proxyPort
)
->
do
-- Let's create the Alice user.
-- Let's create the Alice user.
createAliceAndBob
testEnv
void
$
createAliceAndBob
testEnv
baseUrl
<-
parseBaseUrl
"http://localhost"
baseUrl
<-
parseBaseUrl
"http://localhost"
manager
<-
newManager
defaultManagerSettings
manager
<-
newManager
defaultManagerSettings
let
clientEnv
prt
=
mkClientEnv
manager
(
baseUrl
{
baseUrlPort
=
prt
})
let
clientEnv
prt
=
mkClientEnv
manager
(
baseUrl
{
baseUrlPort
=
prt
})
...
...
test/drivers/hspec/Main.hs
View file @
0389f732
...
@@ -8,7 +8,6 @@ import Control.Monad
...
@@ -8,7 +8,6 @@ import Control.Monad
import
Data.Text
(
isInfixOf
)
import
Data.Text
(
isInfixOf
)
import
Gargantext.Core.AsyncUpdates.CentralExchange
qualified
as
CE
import
Gargantext.Core.AsyncUpdates.CentralExchange
qualified
as
CE
import
Gargantext.Core.AsyncUpdates.Dispatcher
qualified
as
D
import
Gargantext.Core.AsyncUpdates.Dispatcher
qualified
as
D
import
Gargantext.Core.AsyncUpdates.Dispatcher.Types
qualified
as
DT
import
Gargantext.Core.Config.Types
(
NotificationsConfig
(
..
))
import
Gargantext.Core.Config.Types
(
NotificationsConfig
(
..
))
import
Shelly
hiding
(
FilePath
)
import
Shelly
hiding
(
FilePath
)
import
System.IO
import
System.IO
...
@@ -82,11 +81,10 @@ main = do
...
@@ -82,11 +81,10 @@ main = do
hSetBuffering
stdout
NoBuffering
hSetBuffering
stdout
NoBuffering
-- TODO Ideally remove start/stop notifications and use
-- TODO Ideally remove start/stop notifications and use
-- Test/API/Setup to initialize this in env
-- Test/API/Setup to initialize this in env
withNotifications
$
\
(
nc
,
_
,
_
)
->
do
withNotifications
$
\
(
nc
fg
,
_
,
_
)
->
do
bracket
startCoreNLPServer
stopCoreNLPServer
$
\
_
->
hspec
$
do
bracket
startCoreNLPServer
stopCoreNLPServer
$
\
_
->
hspec
$
do
API
.
tests
nc
API
.
tests
nc
fg
ReverseProxy
.
tests
ReverseProxy
.
tests
DB
.
tests
DB
.
tests
DB
.
nodeStoryTests
DB
.
nodeStoryTests
runIO
$
putText
"tests finished"
runIO
$
putText
"tests finished"
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