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
152
Issues
152
List
Board
Labels
Milestones
Merge Requests
8
Merge Requests
8
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
2cc2359d
Commit
2cc2359d
authored
1 year ago
by
Alfredo Di Napoli
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Add userMe policy and isomorphic GQLType UserId instance
parent
4046bc84
1 merge request
!216
Another attempt at a sane access policy
Pipeline
#5293
passed with stages
in 70 minutes and 22 seconds
Changes
6
Pipelines
1
Show whitespace changes
Inline
Side-by-side
Showing
6 changed files
with
27 additions
and
13 deletions
+27
-13
PolicyCheck.hs
src/Gargantext/API/Auth/PolicyCheck.hs
+12
-4
Node.hs
src/Gargantext/API/GraphQL/Node.hs
+0
-2
TreeFirstLevel.hs
src/Gargantext/API/GraphQL/TreeFirstLevel.hs
+0
-2
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
No files found.
src/Gargantext/API/Auth/PolicyCheck.hs
View file @
2cc2359d
...
...
@@ -15,6 +15,7 @@ module Gargantext.API.Auth.PolicyCheck (
,
nodeSuper
,
nodeUser
,
nodeChecks
,
userMe
,
alwaysAllow
,
alwaysDeny
)
where
...
...
@@ -72,13 +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
|
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.
...
...
@@ -129,6 +132,8 @@ check (AuthenticatedUser loggedUserNodeId loggedUserUserId) = \case
AC_user_node
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
...
...
@@ -146,6 +151,9 @@ 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
...
...
This diff is collapsed.
Click to expand it.
src/Gargantext/API/GraphQL/Node.hs
View file @
2cc2359d
...
...
@@ -63,8 +63,6 @@ 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
(
nodeChecks
$
NN
.
UnsafeMkNodeId
node_id
)
$
dbNodes
node_id
resolveNodesCorpus
...
...
This diff is collapsed.
Click to expand it.
src/Gargantext/API/GraphQL/TreeFirstLevel.hs
View file @
2cc2359d
...
...
@@ -69,8 +69,6 @@ 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
(
nodeChecks
$
UnsafeMkNodeId
root_id
)
$
dbTree
root_id
dbTree
::
(
CmdCommon
env
)
=>
...
...
This diff is collapsed.
Click to expand it.
src/Gargantext/API/GraphQL/User.hs
View file @
2cc2359d
...
...
@@ -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
)
...
...
This diff is collapsed.
Click to expand it.
src/Gargantext/API/GraphQL/UserInfo.hs
View file @
2cc2359d
...
...
@@ -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
...
...
This diff is collapsed.
Click to expand it.
src/Gargantext/Database/Admin/Types/Node.hs
View file @
2cc2359d
...
...
@@ -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
...
...
This diff is collapsed.
Click to expand it.
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