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
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
75afdbb5
Commit
75afdbb5
authored
Apr 10, 2022
by
Karen Konou
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
[GQL] Match updated user with user from token
parent
5a8f7ecd
Pipeline
#2687
failed with stage
in 63 minutes and 50 seconds
Changes
4
Pipelines
1
Hide whitespace changes
Inline
Side-by-side
Showing
4 changed files
with
14 additions
and
10 deletions
+14
-10
GraphQL.hs
src/Gargantext/API/GraphQL.hs
+5
-4
UserInfo.hs
src/Gargantext/API/GraphQL/UserInfo.hs
+8
-4
Utils.hs
src/Gargantext/API/GraphQL/Utils.hs
+0
-2
Prelude.hs
src/Gargantext/API/Prelude.hs
+1
-0
No files found.
src/Gargantext/API/GraphQL.hs
View file @
75afdbb5
...
...
@@ -59,6 +59,7 @@ import Servant
)
import
qualified
Servant.Auth
as
SA
import
qualified
Servant.Auth.Server
as
SAS
import
Gargantext.API.Admin.Types
(
HasSettings
)
-- | Represents possible GraphQL queries.
data
Query
m
...
...
@@ -95,7 +96,7 @@ data Contet m
-- | The main GraphQL resolver: how queries, mutations and
-- subscriptions are handled.
rootResolver
::
(
HasConnectionPool
env
,
HasConfig
env
,
HasMail
env
,
HasJobEnv'
env
)
::
(
HasConnectionPool
env
,
HasConfig
env
,
HasMail
env
,
HasJobEnv'
env
,
HasSettings
env
)
=>
RootResolver
(
GargM
env
GargError
)
e
Query
Mutation
Undefined
rootResolver
=
RootResolver
...
...
@@ -111,7 +112,7 @@ rootResolver =
-- | Main GraphQL "app".
app
::
(
Typeable
env
,
HasConnectionPool
env
,
HasConfig
env
,
HasMail
env
,
HasJobEnv'
env
)
::
(
Typeable
env
,
HasConnectionPool
env
,
HasConfig
env
,
HasMail
env
,
HasJobEnv'
env
,
HasSettings
env
)
=>
App
(
EVENT
(
GargM
env
GargError
))
(
GargM
env
GargError
)
app
=
deriveApp
rootResolver
...
...
@@ -155,7 +156,7 @@ gqapi = Proxy
-- | Implementation of our API.
--api :: Server API
api
::
(
Typeable
env
,
HasConnectionPool
env
,
HasConfig
env
,
HasMail
env
,
HasJobEnv'
env
)
::
(
Typeable
env
,
HasConnectionPool
env
,
HasConfig
env
,
HasMail
env
,
HasJobEnv'
env
,
HasSettings
env
)
=>
ServerT
API
(
GargM
env
GargError
)
api
(
SAS
.
Authenticated
_auser
)
=
httpPubApp
[]
app
:<|>
pure
httpPlayground
api
_
=
SAS
.
throwAll
(
_ServerError
#
err401
)
api
_
=
panic
"401 in graphql"
--
SAS.throwAll (_ServerError # err401)
src/Gargantext/API/GraphQL/UserInfo.hs
View file @
75afdbb5
...
...
@@ -42,10 +42,12 @@ import Gargantext.Database.Prelude (HasConnectionPool, HasConfig)
import
Gargantext.Database.Query.Table.Node.UpdateOpaleye
(
updateHyperdata
)
import
Gargantext.Database.Query.Table.User
(
getUsersWithHyperdata
,
getUsersWithNodeHyperdata
,
updateUserEmail
)
import
Gargantext.Database.Schema.User
(
UserLight
(
..
))
import
Gargantext.Database.Schema.Node
(
node_id
,
node_hyperdata
)
import
Gargantext.Database.Schema.Node
(
node_id
,
node_hyperdata
,
NodePoly
(
Node
,
_node_id
)
)
import
Gargantext.Prelude
import
GHC.Generics
(
Generic
)
import
Gargantext.API.GraphQL.Utils
(
AuthStatus
(
Invalid
,
Valid
),
authUser
)
import
Gargantext.API.Admin.Types
(
HasSettings
)
import
Gargantext.Database.Admin.Types.Node
(
unNodeId
)
data
UserInfo
=
UserInfo
{
ui_id
::
Int
...
...
@@ -94,6 +96,7 @@ data UserInfoMArgs
}
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
...
...
@@ -103,16 +106,16 @@ resolveUserInfos UserInfoArgs { user_id } = dbUsers user_id
-- | Mutation for user info
updateUserInfo
::
(
HasConnectionPool
env
,
HasConfig
env
,
HasMail
env
)
::
(
HasConnectionPool
env
,
HasConfig
env
,
HasMail
env
,
HasSettings
env
)
-- => UserInfoMArgs -> ResolverM e (GargM env err) Int
=>
UserInfoMArgs
->
GqlM
e
env
Int
=>
UserInfoMArgs
->
GqlM
'
e
env
err
updateUserInfo
(
UserInfoMArgs
{
ui_id
,
..
})
=
do
-- lift $ printDebug "[updateUserInfo] ui_id" ui_id
users
<-
lift
(
getUsersWithNodeHyperdata
ui_id
)
case
users
of
[]
->
panic
$
"[updateUserInfo] User with id "
<>
(
T
.
pack
$
show
ui_id
)
<>
" doesn't exist."
((
UserLight
{
..
},
node_u
)
:
_
)
->
do
testAuthUser
<-
authUser
ui_id
token
testAuthUser
<-
lift
$
authUser
(
nId
node_u
)
token
case
testAuthUser
of
Invalid
->
panic
"[updateUserInfo] failed to validate user"
Valid
->
do
...
...
@@ -149,6 +152,7 @@ updateUserInfo (UserInfoMArgs { ui_id, .. }) = do
uh
lens'
(
Just
val
)
u_hyperdata
=
u_hyperdata
&
lens'
.~
Just
val
uh'
_
Nothing
u_hyperdata
=
u_hyperdata
uh'
lens'
(
Just
val
)
u_hyperdata
=
u_hyperdata
&
lens'
.~
val
nId
Node
{
_node_id
}
=
unNodeId
_node_id
-- | Inner function to fetch the user from DB.
dbUsers
...
...
src/Gargantext/API/GraphQL/Utils.hs
View file @
75afdbb5
...
...
@@ -15,7 +15,6 @@ import qualified Data.Text as T
import
Gargantext.Core.Utils.Prefix
(
unCapitalize
,
dropPrefix
)
import
Gargantext.Prelude
import
Data.Text
(
Text
)
import
Control.Monad.Error.Class
(
MonadError
(
..
))
import
Data.Text.Encoding
(
encodeUtf8
)
import
Gargantext.API.Admin.Types
(
jwtSettings
,
HasSettings
(
settings
))
import
Servant.Auth.Server
(
verifyJWT
,
JWTSettings
)
...
...
@@ -48,4 +47,3 @@ authUser ui_id token = do
getUserFromToken
::
JWTSettings
->
ByteString
->
IO
(
Maybe
AuthenticatedUser
)
getUserFromToken
=
verifyJWT
src/Gargantext/API/Prelude.hs
View file @
75afdbb5
...
...
@@ -26,6 +26,7 @@ import Control.Lens (Prism', (#))
import
Control.Lens.TH
(
makePrisms
)
import
Control.Monad.Except
(
ExceptT
)
import
Control.Monad.Reader
(
ReaderT
)
import
Control.Monad.Error.Class
(
MonadError
(
..
))
import
Crypto.JOSE.Error
as
Jose
import
Data.Aeson.Types
import
Data.Typeable
...
...
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