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
145
Issues
145
List
Board
Labels
Milestones
Merge Requests
6
Merge Requests
6
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
bd0d341f
Commit
bd0d341f
authored
Nov 04, 2019
by
Alexandre Delanoë
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
[SECU] Doc routes.
parent
9ae2c370
Pipeline
#608
failed with stage
Changes
4
Pipelines
1
Hide whitespace changes
Inline
Side-by-side
Showing
4 changed files
with
78 additions
and
34 deletions
+78
-34
API.hs
src/Gargantext/API.hs
+14
-6
Auth.hs
src/Gargantext/API/Auth.hs
+19
-5
Node.hs
src/Gargantext/API/Node.hs
+11
-2
Tree.hs
src/Gargantext/Database/Tree.hs
+34
-21
No files found.
src/Gargantext/API.hs
View file @
bd0d341f
...
@@ -71,7 +71,7 @@ import Text.Blaze.Html (Html)
...
@@ -71,7 +71,7 @@ import Text.Blaze.Html (Html)
--import Gargantext.API.Swagger
--import Gargantext.API.Swagger
--import Gargantext.Database.Node.Contact (HyperdataContact)
--import Gargantext.Database.Node.Contact (HyperdataContact)
import
Gargantext.API.Auth
(
AuthRequest
,
AuthResponse
,
AuthenticatedUser
(
..
),
AuthContext
,
auth
,
withAccess
)
import
Gargantext.API.Auth
(
AuthRequest
,
AuthResponse
,
AuthenticatedUser
(
..
),
AuthContext
,
auth
,
withAccess
,
PathId
(
..
)
)
import
Gargantext.API.Count
(
CountAPI
,
count
,
Query
)
import
Gargantext.API.Count
(
CountAPI
,
count
,
Query
)
import
Gargantext.API.FrontEnd
(
FrontEndAPI
,
frontEndServer
)
import
Gargantext.API.FrontEnd
(
FrontEndAPI
,
frontEndServer
)
import
Gargantext.API.Ngrams
(
HasRepo
(
..
),
HasRepoSaver
(
..
),
saveRepo
,
TableNgramsApi
,
apiNgramsTableDoc
)
import
Gargantext.API.Ngrams
(
HasRepo
(
..
),
HasRepoSaver
(
..
),
saveRepo
,
TableNgramsApi
,
apiNgramsTableDoc
)
...
@@ -238,6 +238,13 @@ type GargPrivateAPI' =
...
@@ -238,6 +238,13 @@ type GargPrivateAPI' =
:<|>
"corpus"
:>
Summary
"Corpus endpoint"
:<|>
"corpus"
:>
Summary
"Corpus endpoint"
:>
Capture
"id"
CorpusId
:>
NodeAPI
HyperdataCorpus
:>
Capture
"id"
CorpusId
:>
NodeAPI
HyperdataCorpus
:<|>
"corpus"
:>
Summary
"Corpus endpoint"
:>
Capture
"node1_id"
NodeId
:>
"document"
:>
Capture
"node2_id"
NodeId
:>
NodeNodeAPI
HyperdataAny
-- Annuaire endpoint
-- Annuaire endpoint
:<|>
"annuaire"
:>
Summary
"Annuaire endpoint"
:<|>
"annuaire"
:>
Summary
"Annuaire endpoint"
:>
Capture
"id"
AnnuaireId
:>
NodeAPI
HyperdataAnnuaire
:>
Capture
"id"
AnnuaireId
:>
NodeAPI
HyperdataAnnuaire
...
@@ -320,12 +327,13 @@ serverPrivateGargAPI' (AuthenticatedUser (NodeId uid))
...
@@ -320,12 +327,13 @@ serverPrivateGargAPI' (AuthenticatedUser (NodeId uid))
=
serverGargAdminAPI
=
serverGargAdminAPI
:<|>
nodeAPI
(
Proxy
::
Proxy
HyperdataAny
)
uid
:<|>
nodeAPI
(
Proxy
::
Proxy
HyperdataAny
)
uid
:<|>
nodeAPI
(
Proxy
::
Proxy
HyperdataCorpus
)
uid
:<|>
nodeAPI
(
Proxy
::
Proxy
HyperdataCorpus
)
uid
:<|>
nodeAPI
(
Proxy
::
Proxy
HyperdataAnnuaire
)
uid
:<|>
nodeNodeAPI
(
Proxy
::
Proxy
HyperdataAny
)
uid
:<|>
withAccess
(
Proxy
::
Proxy
TableNgramsApi
)
Proxy
uid
<*>
apiNgramsTableDoc
:<|>
nodeAPI
(
Proxy
::
Proxy
HyperdataAnnuaire
)
uid
:<|>
withAccess
(
Proxy
::
Proxy
TableNgramsApi
)
Proxy
uid
<$>
PathNode
<*>
apiNgramsTableDoc
:<|>
count
-- TODO: undefined
:<|>
count
-- TODO: undefined
:<|>
withAccess
(
Proxy
::
Proxy
SearchPairsAPI
)
Proxy
uid
<*>
searchPairs
-- TODO: move elsewhere
:<|>
withAccess
(
Proxy
::
Proxy
SearchPairsAPI
)
Proxy
uid
<
$>
PathNode
<
*>
searchPairs
-- TODO: move elsewhere
:<|>
withAccess
(
Proxy
::
Proxy
GraphAPI
)
Proxy
uid
<*>
graphAPI
-- TODO: mock
:<|>
withAccess
(
Proxy
::
Proxy
GraphAPI
)
Proxy
uid
<
$>
PathNode
<
*>
graphAPI
-- TODO: mock
:<|>
withAccess
(
Proxy
::
Proxy
TreeAPI
)
Proxy
uid
<*>
treeAPI
:<|>
withAccess
(
Proxy
::
Proxy
TreeAPI
)
Proxy
uid
<
$>
PathNode
<
*>
treeAPI
:<|>
New
.
api
-- TODO-SECURITY
:<|>
New
.
api
-- TODO-SECURITY
:<|>
New
.
info
uid
-- TODO-SECURITY
:<|>
New
.
info
uid
-- TODO-SECURITY
...
...
src/Gargantext/API/Auth.hs
View file @
bd0d341f
...
@@ -47,8 +47,8 @@ import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger)
...
@@ -47,8 +47,8 @@ import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger)
import
Gargantext.API.Settings
import
Gargantext.API.Settings
import
Gargantext.API.Types
(
HasJoseError
(
..
),
joseError
,
HasServerError
,
serverError
,
GargServerC
)
import
Gargantext.API.Types
(
HasJoseError
(
..
),
joseError
,
HasServerError
,
serverError
,
GargServerC
)
import
Gargantext.Database.Root
(
getRoot
)
import
Gargantext.Database.Root
(
getRoot
)
import
Gargantext.Database.Tree
(
isDescendantOf
)
import
Gargantext.Database.Tree
(
isDescendantOf
,
isIn
)
import
Gargantext.Database.Types.Node
(
NodePoly
(
_node_id
),
NodeId
(
..
),
UserId
)
import
Gargantext.Database.Types.Node
(
NodePoly
(
_node_id
),
NodeId
(
..
),
UserId
,
ListId
,
DocId
)
import
Gargantext.Database.Utils
(
Cmd
'
,
CmdM
,
HasConnection
)
import
Gargantext.Database.Utils
(
Cmd
'
,
CmdM
,
HasConnection
)
import
Gargantext.Prelude
hiding
(
reverse
)
import
Gargantext.Prelude
hiding
(
reverse
)
import
Test.QuickCheck
(
elements
,
oneof
)
import
Test.QuickCheck
(
elements
,
oneof
)
...
@@ -178,15 +178,29 @@ instance Arbitrary AuthValid where
...
@@ -178,15 +178,29 @@ instance Arbitrary AuthValid where
,
tr
<-
[
1
..
3
]
,
tr
<-
[
1
..
3
]
]
]
withAccessM
::
(
CmdM
env
err
m
,
HasServerError
err
)
=>
UserId
->
NodeId
->
m
a
->
m
a
data
PathId
=
PathNode
NodeId
|
PathDoc
ListId
DocId
withAccessM
uId
id
m
=
do
withAccessM
::
(
CmdM
env
err
m
,
HasServerError
err
)
=>
UserId
->
PathId
->
m
a
->
m
a
withAccessM
uId
(
PathNode
id
)
m
=
do
d
<-
id
`
isDescendantOf
`
NodeId
uId
d
<-
id
`
isDescendantOf
`
NodeId
uId
if
d
then
m
else
serverError
err401
if
d
then
m
else
serverError
err401
withAccessM
uId
(
PathDoc
cId
docId
)
m
=
do
a
<-
isIn
cId
docId
-- TODO use one query for all ?
d
<-
cId
`
isDescendantOf
`
NodeId
uId
if
a
&&
d
then
m
else
serverError
err401
withAccess
::
forall
env
err
m
api
.
withAccess
::
forall
env
err
m
api
.
(
GargServerC
env
err
m
,
HasServer
api
'[
]
)
=>
(
GargServerC
env
err
m
,
HasServer
api
'[
]
)
=>
Proxy
api
->
Proxy
m
->
Proxy
api
->
Proxy
m
->
UserId
->
Node
Id
->
UserId
->
Path
Id
->
ServerT
api
m
->
ServerT
api
m
ServerT
api
m
->
ServerT
api
m
withAccess
p
_
uId
id
=
hoistServer
p
f
withAccess
p
_
uId
id
=
hoistServer
p
f
where
where
...
...
src/Gargantext/API/Node.hs
View file @
bd0d341f
...
@@ -48,7 +48,7 @@ import Data.Swagger
...
@@ -48,7 +48,7 @@ import Data.Swagger
import
Data.Text
(
Text
())
import
Data.Text
(
Text
())
import
Data.Time
(
UTCTime
)
import
Data.Time
(
UTCTime
)
import
GHC.Generics
(
Generic
)
import
GHC.Generics
(
Generic
)
import
Gargantext.API.Auth
(
withAccess
)
import
Gargantext.API.Auth
(
withAccess
,
PathId
(
..
)
)
import
Gargantext.API.Metrics
import
Gargantext.API.Metrics
import
Gargantext.API.Ngrams
(
TabType
(
..
),
TableNgramsApi
,
apiNgramsTableCorpus
,
QueryParamR
,
TODO
)
import
Gargantext.API.Ngrams
(
TabType
(
..
),
TableNgramsApi
,
apiNgramsTableCorpus
,
QueryParamR
,
TODO
)
import
Gargantext.API.Ngrams.NTree
(
MyTree
)
import
Gargantext.API.Ngrams.NTree
(
MyTree
)
...
@@ -160,10 +160,19 @@ type ChildrenApi a = Summary " Summary children"
...
@@ -160,10 +160,19 @@ type ChildrenApi a = Summary " Summary children"
:>
QueryParam
"limit"
Int
:>
QueryParam
"limit"
Int
:>
Get
'[
J
SON
]
[
Node
a
]
:>
Get
'[
J
SON
]
[
Node
a
]
------------------------------------------------------------------------
type
NodeNodeAPI
a
=
Get
'[
J
SON
]
(
Node
a
)
nodeNodeAPI
::
forall
proxy
a
.
(
JSONB
a
,
ToJSON
a
)
=>
proxy
a
->
UserId
->
CorpusId
->
NodeId
->
GargServer
(
NodeNodeAPI
a
)
nodeNodeAPI
p
uId
cId
nId
=
withAccess
(
Proxy
::
Proxy
(
NodeNodeAPI
a
))
Proxy
uId
(
PathDoc
cId
nId
)
nodeNodeAPI'
where
nodeNodeAPI'
::
GargServer
(
NodeNodeAPI
a
)
nodeNodeAPI'
=
getNode
nId
p
------------------------------------------------------------------------
------------------------------------------------------------------------
-- TODO: make the NodeId type indexed by `a`, then we no longer need the proxy.
-- TODO: make the NodeId type indexed by `a`, then we no longer need the proxy.
nodeAPI
::
forall
proxy
a
.
(
JSONB
a
,
ToJSON
a
)
=>
proxy
a
->
UserId
->
NodeId
->
GargServer
(
NodeAPI
a
)
nodeAPI
::
forall
proxy
a
.
(
JSONB
a
,
ToJSON
a
)
=>
proxy
a
->
UserId
->
NodeId
->
GargServer
(
NodeAPI
a
)
nodeAPI
p
uId
id
=
withAccess
(
Proxy
::
Proxy
(
NodeAPI
a
))
Proxy
uId
id
nodeAPI'
nodeAPI
p
uId
id
=
withAccess
(
Proxy
::
Proxy
(
NodeAPI
a
))
Proxy
uId
(
PathNode
id
)
nodeAPI'
where
where
nodeAPI'
::
GargServer
(
NodeAPI
a
)
nodeAPI'
::
GargServer
(
NodeAPI
a
)
nodeAPI'
=
getNode
id
p
nodeAPI'
=
getNode
id
p
...
...
src/Gargantext/Database/Tree.hs
View file @
bd0d341f
...
@@ -24,6 +24,7 @@ module Gargantext.Database.Tree
...
@@ -24,6 +24,7 @@ module Gargantext.Database.Tree
,
toNodeTree
,
toNodeTree
,
DbTreeNode
,
DbTreeNode
,
isDescendantOf
,
isDescendantOf
,
isIn
)
where
)
where
import
Control.Lens
(
Prism
'
,
(
#
),
(
^..
),
at
,
each
,
_Just
,
to
)
import
Control.Lens
(
Prism
'
,
(
#
),
(
^..
),
at
,
each
,
_Just
,
to
)
...
@@ -35,7 +36,7 @@ import Database.PostgreSQL.Simple.SqlQQ
...
@@ -35,7 +36,7 @@ import Database.PostgreSQL.Simple.SqlQQ
import
Gargantext.Prelude
import
Gargantext.Prelude
import
Gargantext.Core.Types.Main
(
NodeTree
(
..
),
Tree
(
..
))
import
Gargantext.Core.Types.Main
(
NodeTree
(
..
),
Tree
(
..
))
import
Gargantext.Database.Types.Node
(
NodeId
)
import
Gargantext.Database.Types.Node
(
NodeId
,
DocId
)
import
Gargantext.Database.Config
(
fromNodeTypeId
)
import
Gargantext.Database.Config
(
fromNodeTypeId
)
import
Gargantext.Database.Utils
(
Cmd
,
runPGSQuery
)
import
Gargantext.Database.Utils
(
Cmd
,
runPGSQuery
)
------------------------------------------------------------------------
------------------------------------------------------------------------
...
@@ -92,28 +93,29 @@ data DbTreeNode = DbTreeNode { dt_nodeId :: NodeId
...
@@ -92,28 +93,29 @@ data DbTreeNode = DbTreeNode { dt_nodeId :: NodeId
-- | Main DB Tree function
-- | Main DB Tree function
-- TODO add typenames as parameters
-- TODO add typenames as parameters
dbTree
::
RootId
->
Cmd
err
[
DbTreeNode
]
dbTree
::
RootId
->
Cmd
err
[
DbTreeNode
]
dbTree
rootId
=
map
(
\
(
nId
,
tId
,
pId
,
n
)
->
DbTreeNode
nId
tId
pId
n
)
<$>
runPGSQuery
[
sql
|
dbTree
rootId
=
map
(
\
(
nId
,
tId
,
pId
,
n
)
->
DbTreeNode
nId
tId
pId
n
)
WITH RECURSIVE
<$>
runPGSQuery
[
sql
|
tree (id, typename, parent_id, name) AS
WITH RECURSIVE
(
tree (id, typename, parent_id, name) AS
SELECT p.id, p.typename, p.parent_id, p.name
(
FROM nodes AS p
SELECT p.id, p.typename, p.parent_id, p.name
WHERE p.id = ?
FROM nodes AS p
WHERE p.id = ?
UNION
UNION
SELECT c.id, c.typename, c.parent_id, c.name
FROM nodes AS c
SELECT c.id, c.typename, c.parent_id, c.name
FROM nodes AS c
INNER JOIN tree AS s ON c.parent_id = s.id
WHERE c.typename IN (2,20,21,22,3,5,30,31,40,7,9,90)
INNER JOIN tree AS s ON c.parent_id = s.id
)
WHERE c.typename IN (2,20,21,22,3,5,30,31,40,7,9,90)
SELECT * from tree;
)
|]
(
Only
rootId
)
SELECT * from tree;
|]
(
Only
rootId
)
isDescendantOf
::
NodeId
->
RootId
->
Cmd
err
Bool
isDescendantOf
::
NodeId
->
RootId
->
Cmd
err
Bool
isDescendantOf
childId
rootId
=
(
==
[
Only
True
])
<$>
runPGSQuery
[
sql
|
isDescendantOf
childId
rootId
=
(
==
[
Only
True
])
WITH RECURSIVE
<$>
runPGSQuery
[
sql
|
WITH RECURSIVE
tree (id, parent_id) AS
tree (id, parent_id) AS
(
(
SELECT c.id, c.parent_id
SELECT c.id, c.parent_id
...
@@ -125,7 +127,18 @@ isDescendantOf childId rootId = (== [Only True]) <$> runPGSQuery [sql|
...
@@ -125,7 +127,18 @@ isDescendantOf childId rootId = (== [Only True]) <$> runPGSQuery [sql|
SELECT p.id, p.parent_id
SELECT p.id, p.parent_id
FROM nodes AS p
FROM nodes AS p
INNER JOIN tree AS t ON t.parent_id = p.id
INNER JOIN tree AS t ON t.parent_id = p.id
)
)
SELECT COUNT(*) = 1 from tree AS t
SELECT COUNT(*) = 1 from tree AS t
WHERE t.id = ?;
WHERE t.id = ?;
|]
(
childId
,
rootId
)
|]
(
childId
,
rootId
)
isIn
::
NodeId
->
DocId
->
Cmd
err
Bool
isIn
cId
docId
=
(
==
[
Only
True
])
<$>
runPGSQuery
[
sql
|
SELECT COUNT(*) = 1
FROM nodes_nodes nn
WHERE nn.node1_id = ?
AND nn.node2_id = ?;
|]
(
cId
,
docId
)
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