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
195
Issues
195
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
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