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
118
Issues
118
List
Board
Labels
Milestones
Merge Requests
7
Merge Requests
7
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
cecb48e8
Commit
cecb48e8
authored
Oct 23, 2023
by
Alexandre Delanoë
Browse files
Options
Browse Files
Download
Plain Diff
Merge remote-tracking branch 'origin/adinapoli/issue-279' into dev
parents
83d3839a
ece85195
Pipeline
#5296
passed with stages
in 71 minutes and 22 seconds
Changes
8
Pipelines
1
Show whitespace changes
Inline
Side-by-side
Showing
8 changed files
with
74 additions
and
24 deletions
+74
-24
PolicyCheck.hs
src/Gargantext/API/Auth/PolicyCheck.hs
+22
-9
Node.hs
src/Gargantext/API/GraphQL/Node.hs
+1
-3
TreeFirstLevel.hs
src/Gargantext/API/GraphQL/TreeFirstLevel.hs
+1
-3
User.hs
src/Gargantext/API/GraphQL/User.hs
+2
-2
UserInfo.hs
src/Gargantext/API/GraphQL/UserInfo.hs
+1
-1
Node.hs
src/Gargantext/Database/Admin/Types/Node.hs
+12
-2
Tree.hs
src/Gargantext/Database/Query/Tree.hs
+33
-0
Private.hs
test/Test/API/Private.hs
+2
-4
No files found.
src/Gargantext/API/Auth/PolicyCheck.hs
View file @
cecb48e8
...
...
@@ -15,6 +15,7 @@ module Gargantext.API.Auth.PolicyCheck (
,
nodeSuper
,
nodeUser
,
nodeChecks
,
userMe
,
alwaysAllow
,
alwaysDeny
)
where
...
...
@@ -72,11 +73,15 @@ data AccessPolicyManager = AccessPolicyManager
data
AccessCheck
=
-- | Grants access if the input 'NodeId' is a descendant of the
-- one for the logged-in user.
AC_node_descendant
NodeId
AC_node_descendant
!
NodeId
-- | Grants access if the input 'NodeId' is shared with the logged-in user.
|
AC_node_shared
!
NodeId
-- | Grants access if the input 'NodeId' /is/ the logged-in user.
|
AC_user_node
NodeId
|
AC_user_node
!
NodeId
-- | Grants access if the logged-in user is the user.
|
AC_user
!
UserId
-- | Grants access if the logged-in user is the master user.
|
AC_master_user
NodeId
|
AC_master_user
!
NodeId
-- | Always grant access, effectively a public route.
|
AC_always_allow
-- | Always denies access.
...
...
@@ -119,13 +124,16 @@ accessPolicyManager = AccessPolicyManager (\ur ac -> interpretPolicy ur ac)
check
::
HasNodeError
err
=>
AuthenticatedUser
->
AccessCheck
->
DBCmd
err
AccessResult
check
(
AuthenticatedUser
loggedUserNodeId
_
loggedUserUserId
)
=
\
case
check
(
AuthenticatedUser
loggedUserNodeId
loggedUserUserId
)
=
\
case
AC_always_deny
->
pure
$
Deny
err500
AC_always_allow
->
pure
Allow
AC_user_node
requestedNodeId
->
enforce
err403
$
loggedUserNodeId
==
requestedNodeId
->
do
ownedByMe
<-
requestedNodeId
`
isOwnedBy
`
loggedUserUserId
enforce
err403
$
(
loggedUserNodeId
==
requestedNodeId
||
ownedByMe
)
AC_user
requestedUserId
->
enforce
err403
$
(
loggedUserUserId
==
requestedUserId
)
AC_master_user
_requestedNodeId
->
do
masterUsername
<-
_gc_masteruser
<$>
view
hasConfig
...
...
@@ -133,6 +141,8 @@ check (AuthenticatedUser loggedUserNodeId _loggedUserUserId) = \case
enforce
err403
$
masterNodeId
==
loggedUserNodeId
AC_node_descendant
nodeId
->
enforce
err403
=<<
nodeId
`
isDescendantOf
`
loggedUserNodeId
AC_node_shared
nodeId
->
enforce
err403
=<<
nodeId
`
isSharedWith
`
loggedUserNodeId
-------------------------------------------------------------------------------
-- Smart constructors of access checks
...
...
@@ -141,17 +151,20 @@ check (AuthenticatedUser loggedUserNodeId _loggedUserUserId) = \case
nodeUser
::
NodeId
->
BoolExpr
AccessCheck
nodeUser
=
BConst
.
Positive
.
AC_user_node
userMe
::
UserId
->
BoolExpr
AccessCheck
userMe
=
BConst
.
Positive
.
AC_user
nodeSuper
::
NodeId
->
BoolExpr
AccessCheck
nodeSuper
=
BConst
.
Positive
.
AC_master_user
nodeDescendant
::
NodeId
->
BoolExpr
AccessCheck
nodeDescendant
=
BConst
.
Positive
.
AC_node_descendant
-- FIXME(adinapoli) Checks temporarily disabled.
nodeShared
::
NodeId
->
BoolExpr
AccessCheck
nodeShared
=
BConst
.
Positive
.
AC_node_shared
nodeChecks
::
NodeId
->
BoolExpr
AccessCheck
nodeChecks
_nid
=
alwaysAllow
where
_disabled
=
nodeUser
_nid
`
BOr
`
nodeSuper
_nid
`
BOr
`
nodeDescendant
_nid
nodeChecks
nid
=
nodeUser
nid
`
BOr
`
nodeSuper
nid
`
BOr
`
nodeDescendant
nid
`
BOr
`
nodeShared
nid
alwaysAllow
::
BoolExpr
AccessCheck
alwaysAllow
=
BConst
.
Positive
$
AC_always_allow
...
...
src/Gargantext/API/GraphQL/Node.hs
View file @
cecb48e8
...
...
@@ -63,9 +63,7 @@ resolveNodes
->
NodeArgs
->
GqlM
e
env
[
Node
]
resolveNodes
autUser
mgr
NodeArgs
{
node_id
}
=
-- FIXME(adn) We should have a way to enforce the access policy on
-- the public or public folders, instead of using 'alwaysAllow'.
withPolicy
autUser
mgr
alwaysAllow
$
dbNodes
node_id
withPolicy
autUser
mgr
(
nodeChecks
$
NN
.
UnsafeMkNodeId
node_id
)
$
dbNodes
node_id
resolveNodesCorpus
::
(
CmdCommon
env
)
...
...
src/Gargantext/API/GraphQL/TreeFirstLevel.hs
View file @
cecb48e8
...
...
@@ -69,9 +69,7 @@ resolveTree :: (CmdCommon env)
->
TreeArgs
->
GqlM
e
env
(
TreeFirstLevel
(
GqlM
e
env
))
resolveTree
autUser
mgr
TreeArgs
{
root_id
}
=
-- FIXME(adn) We should have a way to enforce the access policy on
-- the public or public folders, instead of using 'alwaysAllow'.
withPolicy
autUser
mgr
alwaysAllow
$
dbTree
root_id
withPolicy
autUser
mgr
(
nodeChecks
$
UnsafeMkNodeId
root_id
)
$
dbTree
root_id
dbTree
::
(
CmdCommon
env
)
=>
Int
->
GqlM
e
env
(
TreeFirstLevel
(
GqlM
e
env
))
...
...
src/Gargantext/API/GraphQL/User.hs
View file @
cecb48e8
...
...
@@ -55,8 +55,8 @@ resolveUsers
->
UserArgs
->
GqlM
e
env
[
User
(
GqlM
e
env
)]
resolveUsers
autUser
mgr
UserArgs
{
user_id
}
=
do
--
FIXME(adn) we should use a proper policy, not 'alwaysAllow'
.
withPolicy
autUser
mgr
alwaysAllow
$
dbUsers
user_id
--
We are given the /node id/ of the logged-in user
.
withPolicy
autUser
mgr
(
nodeChecks
$
UnsafeMkNodeId
user_id
)
$
dbUsers
user_id
-- | Inner function to fetch the user from DB.
dbUsers
::
(
CmdCommon
env
)
...
...
src/Gargantext/API/GraphQL/UserInfo.hs
View file @
cecb48e8
...
...
@@ -113,7 +113,7 @@ resolveUserInfos
->
UserInfoArgs
->
GqlM
e
env
[
UserInfo
]
resolveUserInfos
autUser
mgr
UserInfoArgs
{
user_id
}
=
-- FIXME(adn) we should use a proper policy, not 'alwaysAllow'.
withPolicy
autUser
mgr
alwaysAllow
$
dbUsers
(
UnsafeMkUserId
user_id
)
withPolicy
autUser
mgr
(
userMe
$
UnsafeMkUserId
user_id
)
$
dbUsers
(
UnsafeMkUserId
user_id
)
-- | Mutation for user info
updateUserInfo
...
...
src/Gargantext/Database/Admin/Types/Node.hs
View file @
cecb48e8
...
...
@@ -15,6 +15,7 @@ Portability : POSIX
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}
-- {-# LANGUAGE DuplicateRecordFields #-}
...
...
@@ -26,7 +27,8 @@ import Data.Aeson
import
Data.Aeson.TH
(
deriveJSON
)
import
Data.Csv
qualified
as
Csv
import
Data.Either
import
Data.Morpheus.Types
(
GQLType
)
import
Data.Morpheus.Kind
(
SCALAR
)
import
Data.Morpheus.Types
import
Data.Swagger
import
Data.Text
(
unpack
,
pack
)
import
Data.Time
(
UTCTime
)
...
...
@@ -59,7 +61,15 @@ newtype UserId = UnsafeMkUserId { _UserId :: Int }
deriving
stock
(
Show
,
Eq
,
Ord
,
Generic
)
deriving
newtype
(
ToSchema
,
ToJSON
,
FromJSON
,
FromField
,
ToField
)
instance
GQLType
UserId
-- The 'UserId' is isomprohic to an 'Int'.
instance
GQLType
UserId
where
type
KIND
UserId
=
SCALAR
instance
EncodeScalar
UserId
where
encodeScalar
=
encodeScalar
.
_UserId
instance
DecodeScalar
UserId
where
decodeScalar
=
fmap
UnsafeMkUserId
.
decodeScalar
instance
ResourceId
UserId
where
isPositive
=
(
>
0
)
.
_UserId
...
...
src/Gargantext/Database/Query/Tree.hs
View file @
cecb48e8
...
...
@@ -20,6 +20,8 @@ Let a Root Node, return the Tree of the Node as a directed acyclic graph
module
Gargantext.Database.Query.Tree
(
module
Gargantext
.
Database
.
Query
.
Tree
.
Error
,
isDescendantOf
,
isOwnedBy
,
isSharedWith
,
isIn
,
tree
,
tree_flat
...
...
@@ -377,6 +379,37 @@ isDescendantOf childId rootId = (== [Only True])
WHERE t.id = ?;
|]
(
childId
,
rootId
)
isOwnedBy
::
NodeId
->
UserId
->
DBCmd
err
Bool
isOwnedBy
nodeId
userId
=
(
==
[
Only
True
])
<$>
runPGSQuery
[
sql
|
SELECT COUNT(*) = 1 from nodes AS c where c.id = ? AND c.user_id = ?
|]
(
nodeId
,
userId
)
isSharedWith
::
NodeId
->
NodeId
->
DBCmd
err
Bool
isSharedWith
targetNode
targetUserNode
=
(
==
[
Only
True
])
<$>
runPGSQuery
[
sql
|
BEGIN;
SET TRANSACTION READ ONLY;
COMMIT;
WITH RECURSIVE SharePath AS (
SELECT nn.node1_id, nn.node2_id AS shared_node_id
FROM nodes_nodes nn
WHERE nn.node1_id IN (SELECT id FROM nodes WHERE parent_id = ?)
UNION ALL
SELECT nn.node1_id, nn.node2_id
FROM nodes_nodes nn
JOIN SharePath sp ON nn.node1_id = sp.shared_node_id
)
SELECT
EXISTS (
SELECT 1
FROM nodes n
JOIN SharePath sp ON n.parent_id = sp.shared_node_id
WHERE n.id = ?
OR n.parent_id = ?
) AS share_exists;
|]
(
targetUserNode
,
targetNode
,
targetNode
)
-- TODO should we check the category?
isIn
::
NodeId
->
DocId
->
DBCmd
err
Bool
isIn
cId
docId
=
(
==
[
Only
True
])
...
...
test/Test/API/Private.hs
View file @
cecb48e8
...
...
@@ -111,8 +111,7 @@ tests = sequential $ aroundAll withTestDBAndPort $ do
it
"forbids 'alice' to see others node private info"
$
\
((
_testEnv
,
port
),
app
)
->
do
withApplication
app
$
do
withValidLogin
port
"alice"
(
GargPassword
"alice"
)
$
\
token
->
do
let
_unused
=
protected
token
"GET"
(
mkUrl
port
"/node/1"
)
""
`
shouldRespondWith
`
403
in
liftIO
$
pendingWith
"POLICY CHECK DISABLED FOR NOW (ISSUE #279)"
protected
token
"GET"
(
mkUrl
port
"/node/1"
)
""
`
shouldRespondWith
`
403
describe
"GET /api/v1.0/tree"
$
do
it
"unauthorised users shouldn't see anything"
$
\
((
_testEnv
,
port
),
app
)
->
do
...
...
@@ -128,5 +127,4 @@ tests = sequential $ aroundAll withTestDBAndPort $ do
it
"forbids 'alice' to see others node private info"
$
\
((
_testEnv
,
port
),
app
)
->
do
withApplication
app
$
do
withValidLogin
port
"alice"
(
GargPassword
"alice"
)
$
\
token
->
do
let
_unused
=
protected
token
"GET"
(
mkUrl
port
"/tree/1"
)
""
`
shouldRespondWith
`
403
in
liftIO
$
pendingWith
"POLICY CHECK DISABLED FOR NOW (ISSUE #279)"
protected
token
"GET"
(
mkUrl
port
"/tree/1"
)
""
`
shouldRespondWith
`
403
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