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
153
Issues
153
List
Board
Labels
Milestones
Merge Requests
9
Merge Requests
9
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
4e054277
Commit
4e054277
authored
1 year ago
by
Alfredo Di Napoli
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Add policy protection to some GraphQL routes
parent
8eb55509
Changes
15
Hide whitespace changes
Inline
Side-by-side
Showing
15 changed files
with
155 additions
and
99 deletions
+155
-99
gargantext.cabal
gargantext.cabal
+2
-0
Auth.hs
src/Gargantext/API/Admin/Auth.hs
+6
-8
PolicyCheck.hs
src/Gargantext/API/Auth/PolicyCheck.hs
+7
-0
GraphQL.hs
src/Gargantext/API/GraphQL.hs
+16
-11
Annuaire.hs
src/Gargantext/API/GraphQL/Annuaire.hs
+1
-5
IMT.hs
src/Gargantext/API/GraphQL/IMT.hs
+3
-9
NLP.hs
src/Gargantext/API/GraphQL/NLP.hs
+3
-9
Node.hs
src/Gargantext/API/GraphQL/Node.hs
+20
-19
PolicyCheck.hs
src/Gargantext/API/GraphQL/PolicyCheck.hs
+25
-0
Team.hs
src/Gargantext/API/GraphQL/Team.hs
+6
-8
TreeFirstLevel.hs
src/Gargantext/API/GraphQL/TreeFirstLevel.hs
+12
-6
Types.hs
src/Gargantext/API/GraphQL/Types.hs
+8
-0
User.hs
src/Gargantext/API/GraphQL/User.hs
+12
-9
UserInfo.hs
src/Gargantext/API/GraphQL/UserInfo.hs
+11
-10
Private.hs
test/Test/API/Private.hs
+23
-5
No files found.
gargantext.cabal
View file @
4e054277
...
...
@@ -164,8 +164,10 @@ library
Gargantext.API.GraphQL.IMT
Gargantext.API.GraphQL.NLP
Gargantext.API.GraphQL.Node
Gargantext.API.GraphQL.PolicyCheck
Gargantext.API.GraphQL.Team
Gargantext.API.GraphQL.TreeFirstLevel
Gargantext.API.GraphQL.Types
Gargantext.API.GraphQL.User
Gargantext.API.GraphQL.UserInfo
Gargantext.API.GraphQL.Utils
...
...
This diff is collapsed.
Click to expand it.
src/Gargantext/API/Admin/Auth.hs
View file @
4e054277
...
...
@@ -170,14 +170,12 @@ withPolicy :: GargServerC env GargError m
->
m
a
->
AccessPolicyManager
->
m
a
withPolicy
ur
checks
h
mgr
=
do
a
<-
h
case
mgr
of
AccessPolicyManager
{
runAccessPolicy
}
->
do
res
<-
runAccessPolicy
ur
checks
case
res
of
Allow
->
pure
a
Deny
err
->
throwError
$
GargServerError
$
err
withPolicy
ur
checks
m
mgr
=
case
mgr
of
AccessPolicyManager
{
runAccessPolicy
}
->
do
res
<-
runAccessPolicy
ur
checks
case
res
of
Allow
->
m
Deny
err
->
throwError
$
GargServerError
$
err
{- | Collaborative Schema
User at his root can create Teams Folder
...
...
This diff is collapsed.
Click to expand it.
src/Gargantext/API/Auth/PolicyCheck.hs
View file @
4e054277
...
...
@@ -16,6 +16,7 @@ module Gargantext.API.Auth.PolicyCheck (
,
nodeUser
,
nodeChecks
,
alwaysAllow
,
alwaysDeny
)
where
import
Control.Lens
...
...
@@ -78,6 +79,7 @@ data AccessCheck
|
AC_master_user
NodeId
-- | Always grant access, effectively a public route.
|
AC_always_allow
|
AC_always_deny
deriving
(
Show
,
Eq
)
-------------------------------------------------------------------------------
...
...
@@ -117,6 +119,8 @@ accessPolicyManager = AccessPolicyManager (\ur ac -> interpretPolicy ur ac)
check
::
HasNodeError
err
=>
AuthenticatedUser
->
AccessCheck
->
DBCmd
err
AccessResult
check
(
AuthenticatedUser
loggedUserNodeId
)
=
\
case
AC_always_deny
->
pure
$
Deny
err500
AC_always_allow
->
pure
Allow
AC_user_node
requestedNodeId
...
...
@@ -149,6 +153,9 @@ nodeChecks nid =
alwaysAllow
::
BoolExpr
AccessCheck
alwaysAllow
=
BConst
.
Positive
$
AC_always_allow
alwaysDeny
::
BoolExpr
AccessCheck
alwaysDeny
=
BConst
.
Positive
$
AC_always_deny
-------------------------------------------------------------------------------
-- Instances
-------------------------------------------------------------------------------
...
...
This diff is collapsed.
Click to expand it.
src/Gargantext/API/GraphQL.hs
View file @
4e054277
...
...
@@ -63,6 +63,7 @@ import Servant
import
qualified
Servant.Auth
as
SA
import
qualified
Servant.Auth.Server
as
SAS
import
Gargantext.API.Admin.Types
(
HasSettings
)
import
Gargantext.API.Auth.PolicyCheck
-- | Represents possible GraphQL queries.
...
...
@@ -111,8 +112,10 @@ data Contet m
-- subscriptions are handled.
rootResolver
::
(
CmdCommon
env
,
HasNLPServer
env
,
HasJobEnv'
env
,
HasSettings
env
)
=>
RootResolver
(
GargM
env
GargError
)
e
Query
Mutation
Undefined
rootResolver
=
=>
AuthenticatedUser
->
AccessPolicyManager
->
RootResolver
(
GargM
env
GargError
)
e
Query
Mutation
Undefined
rootResolver
authenticatedUser
policyManager
=
RootResolver
{
queryResolver
=
Query
{
annuaire_contacts
=
GQLA
.
resolveAnnuaireContacts
,
context_ngrams
=
GQLCTX
.
resolveContextNgrams
...
...
@@ -121,12 +124,12 @@ rootResolver =
,
imt_schools
=
GQLIMT
.
resolveSchools
,
job_logs
=
GQLAT
.
resolveJobLogs
,
languages
=
GQLNLP
.
resolveLanguages
,
nodes
=
GQLNode
.
resolveNodes
,
nodes
=
GQLNode
.
resolveNodes
authenticatedUser
policyManager
,
nodes_corpus
=
GQLNode
.
resolveNodesCorpus
,
node_parent
=
GQLNode
.
resolveNodeParent
,
user_infos
=
GQLUserInfo
.
resolveUserInfos
,
users
=
GQLUser
.
resolveUsers
,
tree
=
GQLTree
.
resolveTree
,
user_infos
=
GQLUserInfo
.
resolveUserInfos
authenticatedUser
policyManager
,
users
=
GQLUser
.
resolveUsers
authenticatedUser
policyManager
,
tree
=
GQLTree
.
resolveTree
authenticatedUser
policyManager
,
team
=
GQLTeam
.
resolveTeam
}
,
mutationResolver
=
Mutation
{
update_user_info
=
GQLUserInfo
.
updateUserInfo
,
update_user_pubmed_api_key
=
GQLUser
.
updateUserPubmedAPIKey
...
...
@@ -137,8 +140,10 @@ rootResolver =
-- | Main GraphQL "app".
app
::
(
Typeable
env
,
CmdCommon
env
,
HasJobEnv'
env
,
HasNLPServer
env
,
HasSettings
env
)
=>
App
(
EVENT
(
GargM
env
GargError
))
(
GargM
env
GargError
)
app
=
deriveApp
rootResolver
=>
AuthenticatedUser
->
AccessPolicyManager
->
App
(
EVENT
(
GargM
env
GargError
))
(
GargM
env
GargError
)
app
authenticatedUser
policyManager
=
deriveApp
(
rootResolver
authenticatedUser
policyManager
)
----------------------------------------------
...
...
@@ -153,7 +158,7 @@ type Playground = Get '[HTML] ByteString
-- type API' (name :: Symbol) = name :> (GQAPI :<|> Schema :<|> Playground)
-- | Our API consists of `GQAPI` and `Playground`.
type
API
=
SA
.
Auth
'[
S
A
.
JWT
,
SA
.
Cookie
]
AuthenticatedUser
:>
"gql"
:>
(
GQAPI
:<|>
Playground
)
:>
"gql"
:>
(
PolicyChecked
GQAPI
:<|>
Playground
)
gqapi
::
Proxy
API
gqapi
=
Proxy
...
...
@@ -175,5 +180,5 @@ gqapi = Proxy
api
::
(
Typeable
env
,
CmdCommon
env
,
HasJobEnv'
env
,
HasSettings
env
)
=>
ServerT
API
(
GargM
env
GargError
)
api
(
SAS
.
Authenticated
_auser
)
=
httpPubApp
[]
app
:<|>
pure
httpPlayground
api
_
=
panic
"401 in graphql"
-- SAS.throwAll (_ServerError # err401)
api
(
SAS
.
Authenticated
auser
)
=
(
httpPubApp
[]
.
app
auser
)
:<|>
pure
httpPlayground
api
_
=
panic
"401 in graphql"
-- SAS.throwAll (_ServerError # err401)
This diff is collapsed.
Click to expand it.
src/Gargantext/API/GraphQL/Annuaire.hs
View file @
4e054277
...
...
@@ -6,13 +6,10 @@ module Gargantext.API.GraphQL.Annuaire where
import
Control.Lens
import
Data.Morpheus.Types
(
GQLType
,
Resolver
,
QUERY
,
lift
)
import
Data.Proxy
import
Data.Text
(
Text
)
import
Gargantext.API.Prelude
(
GargM
,
GargError
)
import
Gargantext.Database.Admin.Types.Hyperdata.Contact
(
HyperdataContact
,
ContactWho
...
...
@@ -25,6 +22,7 @@ import Gargantext.Database.Query.Table.Context (getContextWith)
import
Gargantext.Database.Schema.Node
(
node_hyperdata
)
import
Gargantext.Prelude
import
GHC.Generics
(
Generic
)
import
Gargantext.API.GraphQL.Types
data
AnnuaireContact
=
AnnuaireContact
{
ac_title
::
!
(
Maybe
Text
)
...
...
@@ -50,8 +48,6 @@ data AnnuaireContactArgs
{
contact_id
::
Int
}
deriving
(
Generic
,
GQLType
)
type
GqlM
e
env
=
Resolver
QUERY
e
(
GargM
env
GargError
)
-- | Function to resolve user from a query.
resolveAnnuaireContacts
::
(
CmdCommon
env
)
...
...
This diff is collapsed.
Click to expand it.
src/Gargantext/API/GraphQL/IMT.hs
View file @
4e054277
...
...
@@ -8,22 +8,16 @@ module Gargantext.API.GraphQL.IMT
)
where
import
Data.Morpheus.Types
(
GQLType
,
Resolver
,
QUERY
)
import
Gargantext.API.Prelude
(
GargM
,
GargError
)
import
Data.Morpheus.Types
(
GQLType
)
import
GHC.Generics
(
Generic
)
import
Gargantext.API.GraphQL.Types
import
Gargantext.Core.Ext.IMT
(
School
(
..
),
schools
)
import
Gargantext.Prelude
import
GHC.Generics
(
Generic
)
data
SchoolsArgs
=
SchoolsArgs
{
}
deriving
(
Generic
,
GQLType
)
type
GqlM
e
env
=
Resolver
QUERY
e
(
GargM
env
GargError
)
resolveSchools
::
SchoolsArgs
->
GqlM
e
env
[
School
]
resolveSchools
SchoolsArgs
{
}
=
pure
$
schools
This diff is collapsed.
Click to expand it.
src/Gargantext/API/GraphQL/NLP.hs
View file @
4e054277
...
...
@@ -10,24 +10,18 @@ module Gargantext.API.GraphQL.NLP
where
import
Control.Lens
(
view
)
import
qualified
Data.Map.Strict
as
Map
import
Data.Morpheus.Types
(
GQLType
,
Resolver
,
QUERY
)
import
Gargantext.API.Prelude
(
GargM
,
GargError
)
import
Data.Morpheus.Types
(
GQLType
)
import
Gargantext.API.GraphQL.Types
import
Gargantext.Core
(
Lang
(
..
),
NLPServerConfig
(
..
),
PosTagAlgo
)
-- , allLangs)
import
Gargantext.Core.NLP
(
HasNLPServer
(
..
))
import
Gargantext.Prelude
import
Protolude
import
qualified
Data.Map.Strict
as
Map
data
LanguagesArgs
=
LanguagesArgs
{
}
deriving
(
Generic
,
GQLType
)
type
GqlM
e
env
=
Resolver
QUERY
e
(
GargM
env
GargError
)
type
LanguagesMap
=
Map
.
Map
Lang
NLPServer
data
NLPServer
=
NLPServer
...
...
This diff is collapsed.
Click to expand it.
src/Gargantext/API/GraphQL/Node.hs
View file @
4e054277
...
...
@@ -3,28 +3,27 @@
module
Gargantext.API.GraphQL.Node
where
import
Control.Monad.Except
(
lift
)
import
Data.Aeson
import
Data.Either
(
Either
(
..
))
import
qualified
Data.HashMap.Strict
as
HashMap
import
Data.Morpheus.Types
(
GQLType
,
Resolver
,
QUERY
,
lift
)
import
Data.Morpheus.Types
(
GQLType
)
import
Data.Text
(
Text
)
import
qualified
Data.Text
as
T
import
Gargantext.API.Prelude
(
GargM
,
GargError
)
import
GHC.Generics
(
Generic
)
import
Gargantext.API.Admin.Auth.Types
import
Gargantext.API.Auth.PolicyCheck
import
Gargantext.API.GraphQL.PolicyCheck
(
withPolicy
)
import
Gargantext.API.GraphQL.Types
import
Gargantext.Database.Admin.Types.Node
(
NodeId
(
..
),
NodeType
)
import
qualified
Gargantext.Database.Admin.Types.Node
as
NN
import
Gargantext.Database.Query.Table.Node
(
getClosestParentIdByType
,
getNode
)
import
Gargantext.Database.Prelude
(
CmdCommon
)
-- , JSONB)
import
qualified
Gargantext.Database.Schema.Node
as
N
import
Gargantext.Database.Query.Table.Node
(
getClosestParentIdByType
,
getNode
)
import
Gargantext.Prelude
import
GHC.Generics
(
Generic
)
import
qualified
Prelude
import
qualified
PUBMED.Types
as
PUBMED
import
Text.Read
(
readEither
)
import
qualified
Data.HashMap.Strict
as
HashMap
import
qualified
Data.Text
as
T
import
qualified
Gargantext.Database.Admin.Types.Node
as
NN
import
qualified
Gargantext.Database.Schema.Node
as
N
import
qualified
PUBMED.Types
as
PUBMED
import
qualified
Prelude
data
Corpus
=
Corpus
{
id
::
Int
...
...
@@ -50,13 +49,15 @@ data NodeArgs
{
node_id
::
Int
}
deriving
(
Generic
,
GQLType
)
type
GqlM
e
env
=
Resolver
QUERY
e
(
GargM
env
GargError
)
-- | Function to resolve user from a query.
resolveNodes
::
(
CmdCommon
env
)
=>
NodeArgs
->
GqlM
e
env
[
Node
]
resolveNodes
NodeArgs
{
node_id
}
=
dbNodes
node_id
=>
AuthenticatedUser
->
AccessPolicyManager
->
NodeArgs
->
GqlM
e
env
[
Node
]
resolveNodes
autUser
mgr
NodeArgs
{
node_id
}
=
withPolicy
autUser
mgr
(
nodeChecks
(
NodeId
node_id
))
$
dbNodes
node_id
resolveNodesCorpus
::
(
CmdCommon
env
)
...
...
This diff is collapsed.
Click to expand it.
src/Gargantext/API/GraphQL/PolicyCheck.hs
0 → 100644
View file @
4e054277
module
Gargantext.API.GraphQL.PolicyCheck
where
import
Prelude
import
Control.Monad.Except
import
Gargantext.API.Admin.Auth.Types
import
Gargantext.API.Auth.PolicyCheck
import
Gargantext.API.GraphQL.Types
import
Gargantext.API.Prelude
import
Gargantext.Database.Prelude
withPolicy
::
(
HasConnectionPool
env
,
HasConfig
env
)
=>
AuthenticatedUser
->
AccessPolicyManager
->
BoolExpr
AccessCheck
->
GqlM
e
env
a
->
GqlM
e
env
a
withPolicy
ur
mgr
checks
m
=
case
mgr
of
AccessPolicyManager
{
runAccessPolicy
}
->
do
res
<-
lift
$
runAccessPolicy
ur
checks
case
res
of
Allow
->
m
Deny
err
->
lift
$
throwError
$
GargServerError
$
err
This diff is collapsed.
Click to expand it.
src/Gargantext/API/GraphQL/Team.hs
View file @
4e054277
...
...
@@ -3,23 +3,23 @@
module
Gargantext.API.GraphQL.Team
where
import
Gargantext.Prelude
import
GHC.Generics
(
Generic
)
import
Data.Morpheus.Types
(
GQLType
,
Resolver
,
QUERY
,
ResolverM
,
lift
)
import
Data.Morpheus.Types
(
GQLType
,
ResolverM
,
lift
)
import
Data.Text
(
Text
)
import
GHC.Generics
(
Generic
)
import
Gargantext.API.Admin.Types
(
HasSettings
)
import
Gargantext.API.GraphQL.Types
(
GqlM
)
import
Gargantext.API.GraphQL.Utils
(
authUser
,
AuthStatus
(
Invalid
,
Valid
))
import
Gargantext.API.Prelude
(
GargM
,
GargError
)
import
Gargantext.Core.Types
(
NodeId
(
..
),
unNodeId
)
import
qualified
Gargantext.Core.Types.Individu
as
Individu
import
Gargantext.Database.Action.Share
(
membersOf
,
deleteMemberShip
)
import
Gargantext.Database.Prelude
(
CmdCommon
)
import
Gargantext.Database.Query.Table.Node
(
getNode
)
import
Gargantext.Database.Query.Table.User
(
getUsersWithNodeHyperdata
)
import
Gargantext.Database.Schema.Node
(
NodePoly
(
Node
,
_node_id
),
_node_user_id
)
import
qualified
Data.Text
as
T
import
Gargantext.Database.Schema.User
(
UserLight
(
..
))
import
Gargantext.Prelude
import
qualified
Data.Text
as
T
import
qualified
Gargantext.Core.Types.Individu
as
Individu
data
TeamArgs
=
TeamArgs
{
team_node_id
::
Int
}
deriving
(
Generic
,
GQLType
)
...
...
@@ -40,10 +40,8 @@ data TeamDeleteMArgs = TeamDeleteMArgs
,
team_node_id
::
Int
}
deriving
(
Generic
,
GQLType
)
type
GqlM
e
env
=
Resolver
QUERY
e
(
GargM
env
GargError
)
type
GqlM'
e
env
a
=
ResolverM
e
(
GargM
env
GargError
)
a
resolveTeam
::
(
CmdCommon
env
)
=>
TeamArgs
->
GqlM
e
env
Team
resolveTeam
TeamArgs
{
team_node_id
}
=
dbTeam
team_node_id
...
...
This diff is collapsed.
Click to expand it.
src/Gargantext/API/GraphQL/TreeFirstLevel.hs
View file @
4e054277
...
...
@@ -3,10 +3,13 @@
module
Gargantext.API.GraphQL.TreeFirstLevel
where
import
Data.Morpheus.Types
(
GQLType
,
lift
,
Resolver
,
QUERY
)
import
Data.Morpheus.Types
(
GQLType
,
lift
)
import
Data.Text
(
Text
)
import
GHC.Generics
(
Generic
)
import
Gargantext.API.Prelude
(
GargM
,
GargError
)
import
Gargantext.API.Admin.Auth.Types
import
Gargantext.API.Auth.PolicyCheck
import
Gargantext.API.GraphQL.PolicyCheck
import
Gargantext.API.GraphQL.Types
import
Gargantext.Core.Types
(
Tree
,
NodeTree
,
NodeType
)
import
Gargantext.Core.Types.Main
(
Tree
(
TreeN
),
_tn_node
,
_tn_children
,
NodeTree
(
NodeTree
,
_nt_id
,
_nt_type
),
_nt_name
)
import
Gargantext.Database.Admin.Config
(
fromNodeTypeId
)
...
...
@@ -39,12 +42,15 @@ data TreeFirstLevel m = TreeFirstLevel
,
children
::
[
TreeNode
]
}
deriving
(
Generic
,
GQLType
)
type
GqlM
e
env
=
Resolver
QUERY
e
(
GargM
env
GargError
)
type
ParentId
=
Maybe
NodeId
resolveTree
::
(
CmdCommon
env
)
=>
TreeArgs
->
GqlM
e
env
(
TreeFirstLevel
(
GqlM
e
env
))
resolveTree
TreeArgs
{
root_id
}
=
dbTree
root_id
resolveTree
::
(
CmdCommon
env
)
=>
AuthenticatedUser
->
AccessPolicyManager
->
TreeArgs
->
GqlM
e
env
(
TreeFirstLevel
(
GqlM
e
env
))
resolveTree
autUser
mgr
TreeArgs
{
root_id
}
=
withPolicy
autUser
mgr
(
nodeChecks
(
NodeId
root_id
))
$
dbTree
root_id
dbTree
::
(
CmdCommon
env
)
=>
Int
->
GqlM
e
env
(
TreeFirstLevel
(
GqlM
e
env
))
...
...
This diff is collapsed.
Click to expand it.
src/Gargantext/API/GraphQL/Types.hs
0 → 100644
View file @
4e054277
module
Gargantext.API.GraphQL.Types
where
import
Data.Morpheus.Types
import
Gargantext.API.Prelude
type
GqlM
e
env
=
Resolver
QUERY
e
(
GargM
env
GargError
)
type
GqlM'
e
env
a
=
ResolverM
e
(
GargM
env
GargError
)
a
This diff is collapsed.
Click to expand it.
src/Gargantext/API/GraphQL/User.hs
View file @
4e054277
...
...
@@ -6,20 +6,22 @@ module Gargantext.API.GraphQL.User where
import
Data.Maybe
(
listToMaybe
)
import
Data.Morpheus.Types
(
GQLType
,
Resolver
,
ResolverM
,
QUERY
,
lift
)
import
Data.Text
(
Text
)
import
GHC.Generics
(
Generic
)
import
Gargantext.API.Admin.Types
(
HasSettings
)
import
Gargantext.API.
Prelude
(
GargM
,
GargError
)
import
Gargantext.API.
GraphQL.Types
import
Gargantext.Database.Admin.Types.Hyperdata
(
HyperdataUser
(
..
))
import
Gargantext.Database.Admin.Types.Node
(
NodeId
(
..
))
import
Gargantext.Database.Prelude
(
CmdCommon
)
import
qualified
Gargantext.Database.Query.Table.User
as
DBUser
import
Gargantext.Database.Schema.User
(
UserLight
(
..
))
import
Gargantext.Prelude
import
GHC.Generics
(
Generic
)
import
qualified
Gargantext.Core.Types.Individu
as
Individu
import
qualified
Gargantext.Database.Query.Table.User
as
DBUser
import
Gargantext.API.Admin.Auth.Types
import
Gargantext.API.Auth.PolicyCheck
import
Gargantext.API.GraphQL.PolicyCheck
data
User
m
=
User
{
u_email
::
Text
...
...
@@ -40,14 +42,15 @@ data UserPubmedAPIKeyMArgs
,
api_key
::
Text
}
deriving
(
Generic
,
GQLType
)
type
GqlM
e
env
=
Resolver
QUERY
e
(
GargM
env
GargError
)
type
GqlM'
e
env
a
=
ResolverM
e
(
GargM
env
GargError
)
a
-- | Function to resolve user from a query.
resolveUsers
::
(
CmdCommon
env
)
=>
UserArgs
->
GqlM
e
env
[
User
(
GqlM
e
env
)]
resolveUsers
UserArgs
{
user_id
}
=
dbUsers
user_id
=>
AuthenticatedUser
->
AccessPolicyManager
->
UserArgs
->
GqlM
e
env
[
User
(
GqlM
e
env
)]
resolveUsers
autUser
mgr
UserArgs
{
user_id
}
=
do
withPolicy
autUser
mgr
(
nodeChecks
(
NodeId
user_id
))
$
dbUsers
user_id
-- | Inner function to fetch the user from DB.
dbUsers
...
...
This diff is collapsed.
Click to expand it.
src/Gargantext/API/GraphQL/UserInfo.hs
View file @
4e054277
...
...
@@ -7,15 +7,11 @@ import Control.Lens
import
Data.Maybe
(
fromMaybe
)
import
Data.Morpheus.Types
(
GQLType
,
Resolver
,
ResolverM
,
QUERY
,
description
,
lift
)
import
Data.Text
(
Text
)
import
qualified
Data.Text
as
T
import
Gargantext.API.Prelude
(
GargM
,
GargError
)
import
Gargantext.Database.Admin.Types.Hyperdata
(
HyperdataUser
(
..
)
,
hc_source
...
...
@@ -49,6 +45,11 @@ import GHC.Generics (Generic)
import
Gargantext.API.GraphQL.Utils
(
AuthStatus
(
Invalid
,
Valid
),
authUser
)
import
Gargantext.API.Admin.Types
(
HasSettings
)
import
qualified
Gargantext.Core.Types.Individu
as
Individu
import
Gargantext.API.GraphQL.Types
import
Gargantext.API.Admin.Auth.Types
hiding
(
Valid
)
import
Gargantext.API.Auth.PolicyCheck
import
Gargantext.API.GraphQL.PolicyCheck
import
Gargantext.Database.Admin.Types.Node
data
UserInfo
=
UserInfo
{
ui_id
::
Int
...
...
@@ -100,20 +101,20 @@ data UserInfoMArgs
,
ui_cwDescription
::
Maybe
Text
}
deriving
(
Generic
,
GQLType
)
type
GqlM
e
env
=
Resolver
QUERY
e
(
GargM
env
GargError
)
type
GqlM'
e
env
err
=
ResolverM
e
(
GargM
env
err
)
Int
-- | Function to resolve user from a query.
resolveUserInfos
::
(
CmdCommon
env
)
=>
UserInfoArgs
->
GqlM
e
env
[
UserInfo
]
resolveUserInfos
UserInfoArgs
{
user_id
}
=
dbUsers
user_id
=>
AuthenticatedUser
->
AccessPolicyManager
->
UserInfoArgs
->
GqlM
e
env
[
UserInfo
]
resolveUserInfos
autUser
mgr
UserInfoArgs
{
user_id
}
=
withPolicy
autUser
mgr
(
nodeChecks
(
NodeId
user_id
))
$
dbUsers
user_id
-- | Mutation for user info
updateUserInfo
::
(
CmdCommon
env
,
HasSettings
env
)
-- => UserInfoMArgs -> ResolverM e (GargM env err) Int
=>
UserInfoMArgs
->
GqlM'
e
env
err
=>
UserInfoMArgs
->
GqlM'
e
env
Int
updateUserInfo
(
UserInfoMArgs
{
ui_id
,
..
})
=
do
-- lift $ printDebug "[updateUserInfo] ui_id" ui_id
users
<-
lift
(
getUsersWithNodeHyperdata
(
Individu
.
UserDBId
ui_id
))
...
...
This diff is collapsed.
Click to expand it.
test/Test/API/Private.hs
View file @
4e054277
...
...
@@ -8,6 +8,7 @@ module Test.API.Private where
import
Control.Exception
import
Control.Monad
import
Control.Monad.Reader
import
Data.ByteString
(
ByteString
)
import
Data.Maybe
import
Data.Proxy
import
Fmt
...
...
@@ -16,6 +17,8 @@ import Gargantext.API.Routes
import
Gargantext.Core.Types.Individu
import
Gargantext.Database.Action.User.New
import
Network.HTTP.Client
hiding
(
Proxy
)
import
Network.HTTP.Types
import
Network.Wai.Test
(
SResponse
)
import
Prelude
import
Servant
import
Servant.Auth.Client
()
...
...
@@ -26,14 +29,12 @@ import Test.Database.Types
import
Test.Hspec
import
Test.Hspec.Wai
hiding
(
pendingWith
)
import
Test.Hspec.Wai.Internal
(
withApplication
)
import
Test.Hspec.Wai.JSON
(
json
)
import
Test.Utils
(
jsonFragment
,
shouldRespondWith'
)
import
qualified
Data.ByteString.Lazy
as
L
import
qualified
Data.Text.Encoding
as
TE
import
qualified
Network.Wai.Handler.Warp
as
Wai
import
qualified
Servant.Auth.Client
as
SA
import
Data.ByteString
(
ByteString
)
import
Network.Wai.Test
(
SResponse
)
import
Network.HTTP.Types
import
qualified
Data.ByteString.Lazy
as
L
import
Test.Utils
(
jsonFragment
,
shouldRespondWith'
)
type
Env
=
((
TestEnv
,
Wai
.
Port
),
Application
)
...
...
@@ -126,3 +127,20 @@ tests = sequential $ aroundAll withTestDBAndPort $ do
withValidLogin
port
"alice"
(
GargPassword
"alice"
)
$
\
token
->
do
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
withApplication
app
$
do
get
(
mkUrl
port
"/tree/1"
)
`
shouldRespondWith
`
401
it
"allows 'alice' to see her own node info"
$
\
((
_testEnv
,
port
),
app
)
->
do
withApplication
app
$
do
withValidLogin
port
"alice"
(
GargPassword
"alice"
)
$
\
token
->
do
protected
token
"GET"
(
mkUrl
port
"/tree/8"
)
""
`
shouldRespondWith'
`
[
jsonFragment
|
{ "node": {"id":8, "name":"alice", "type": "NodeUser" } }
|]
it
"forbids 'alice' to see others node private info"
$
\
((
_testEnv
,
port
),
app
)
->
do
withApplication
app
$
do
withValidLogin
port
"alice"
(
GargPassword
"alice"
)
$
\
token
->
do
protected
token
"GET"
(
mkUrl
port
"/tree/1"
)
""
`
shouldRespondWith
`
[
json
|
{}
|]
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