Skip to content
Projects
Groups
Snippets
Help
Loading...
Help
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
H
haskell-gargantext
Project
Project
Details
Activity
Releases
Cycle Analytics
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Charts
Issues
0
Issues
0
List
Board
Labels
Milestones
Merge Requests
0
Merge Requests
0
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
Przemyslaw Kaminski
haskell-gargantext
Commits
3005b6fb
Commit
3005b6fb
authored
Nov 12, 2021
by
Przemyslaw Kaminski
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
[graphql] first asynctask work
parent
49436f17
Changes
5
Hide whitespace changes
Inline
Side-by-side
Showing
5 changed files
with
60 additions
and
14 deletions
+60
-14
Types.hs
src/Gargantext/API/Admin/Orchestrator/Types.hs
+6
-3
GraphQL.hs
src/Gargantext/API/GraphQL.hs
+4
-3
AsyncTask.hs
src/Gargantext/API/GraphQL/AsyncTask.hs
+40
-0
User.hs
src/Gargantext/API/GraphQL/User.hs
+5
-4
UserInfo.hs
src/Gargantext/API/GraphQL/UserInfo.hs
+5
-4
No files found.
src/Gargantext/API/Admin/Orchestrator/Types.hs
View file @
3005b6fb
...
...
@@ -7,6 +7,9 @@ module Gargantext.API.Admin.Orchestrator.Types
import
Control.Lens
hiding
(
elements
)
import
Data.Aeson
import
Data.Morpheus.Types
(
GQLType
,
typeOptions
)
import
Data.Proxy
import
Data.Swagger
hiding
(
URL
,
url
,
port
)
import
Data.Text
(
Text
)
...
...
@@ -18,6 +21,7 @@ import Servant.Job.Utils (jsonOptions)
import
Test.QuickCheck
(
elements
)
import
Test.QuickCheck.Arbitrary
import
qualified
Gargantext.API.GraphQL.Utils
as
GQLU
import
Gargantext.Core.Types
(
TODO
(
..
))
import
Gargantext.Prelude
...
...
@@ -109,14 +113,13 @@ instance Arbitrary JobLog where
<*>
arbitrary
<*>
arbitrary
<*>
arbitrary
instance
ToJSON
JobLog
where
toJSON
=
genericToJSON
$
jsonOptions
"_scst_"
instance
FromJSON
JobLog
where
parseJSON
=
genericParseJSON
$
jsonOptions
"_scst_"
instance
ToSchema
JobLog
-- TODO _scst_ prefix
instance
GQLType
JobLog
where
typeOptions
_
=
GQLU
.
unPrefix
"_scst_"
instance
ToSchema
ScraperInput
-- TODO _scin_ prefix
instance
ToSchema
ScraperEvent
-- TODO _scev_ prefix
...
...
src/Gargantext/API/GraphQL.hs
View file @
3005b6fb
...
...
@@ -52,6 +52,7 @@ import Gargantext.API.Admin.Auth.Types (AuthenticatedUser)
import
qualified
Gargantext.API.GraphQL.User
as
GQLUser
import
qualified
Gargantext.API.GraphQL.UserInfo
as
GQLUserInfo
import
Gargantext.API.Prelude
(
GargServerT
,
GargM
,
GargError
,
_ServerError
)
import
Gargantext.Core.Mail.Types
(
HasMail
)
import
Gargantext.Database.Prelude
(
Cmd
,
HasConnectionPool
,
HasConfig
)
import
Gargantext.Database.Schema.User
(
UserPoly
(
..
))
import
Gargantext.Prelude
...
...
@@ -108,7 +109,7 @@ data Contet m
-- | The main GraphQL resolver: how queries, mutations and
-- subscriptions are handled.
rootResolver
::
(
HasConnectionPool
env
,
HasConfig
env
)
::
(
HasConnectionPool
env
,
HasConfig
env
,
HasMail
env
)
=>
RootResolver
(
GargM
env
GargError
)
e
Query
Mutation
Undefined
rootResolver
=
RootResolver
...
...
@@ -119,7 +120,7 @@ rootResolver =
-- | Main GraphQL "app".
app
::
(
Typeable
env
,
HasConnectionPool
env
,
HasConfig
env
)
::
(
Typeable
env
,
HasConnectionPool
env
,
HasConfig
env
,
HasMail
env
)
=>
App
(
EVENT
(
GargM
env
GargError
))
(
GargM
env
GargError
)
app
=
deriveApp
rootResolver
...
...
@@ -160,7 +161,7 @@ type API = SA.Auth '[SA.JWT, SA.Cookie] AuthenticatedUser
-- | Implementation of our API.
--api :: Server API
api
::
(
Typeable
env
,
HasConnectionPool
env
,
HasConfig
env
)
::
(
Typeable
env
,
HasConnectionPool
env
,
HasConfig
env
,
HasMail
env
)
=>
ServerT
API
(
GargM
env
GargError
)
api
(
SAS
.
Authenticated
_auser
)
=
httpPubApp
[]
app
:<|>
pure
httpPlayground
api
_
=
panic
"401 in graphql"
--SAS.throwAll (_ServerError # err401)
src/Gargantext/API/GraphQL/AsyncTask.hs
0 → 100644
View file @
3005b6fb
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DuplicateRecordFields #-}
module
Gargantext.API.GraphQL.AsyncTask
where
import
Control.Lens
import
Data.Morpheus.Types
(
GQLType
,
Resolver
,
ResolverM
,
QUERY
,
lift
)
import
Data.Text
(
Text
)
import
qualified
Data.Text
as
T
import
Gargantext.API.Admin.Orchestrator.Types
(
JobLog
(
..
))
import
Gargantext.API.Prelude
(
GargM
,
GargError
)
import
Gargantext.Core.Mail.Types
(
HasMail
)
import
Gargantext.Database.Admin.Types.Node
(
NodeId
(
..
))
import
Gargantext.Database.Prelude
(
HasConnectionPool
,
HasConfig
)
import
Gargantext.Prelude
import
GHC.Generics
(
Generic
)
data
JobLogArgs
=
JobLogArgs
{
job_log_id
::
Int
}
deriving
(
Generic
,
GQLType
)
type
GqlM
e
env
=
Resolver
QUERY
e
(
GargM
env
GargError
)
resolveJobLogs
::
(
HasConnectionPool
env
,
HasConfig
env
)
=>
JobLogArgs
->
GqlM
e
env
[
JobLog
]
resolveJobLogs
JobLogArgs
{
job_log_id
}
=
dbJobLogs
job_log_id
dbJobLogs
::
(
HasConnectionPool
env
,
HasConfig
env
)
=>
Int
->
GqlM
e
env
[
JobLog
]
dbJobLogs
job_log_id
=
do
getJobLogs
job_log_id
src/Gargantext/API/GraphQL/User.hs
View file @
3005b6fb
...
...
@@ -10,6 +10,7 @@ import Data.Morpheus.Types
)
import
Data.Text
(
Text
)
import
Gargantext.API.Prelude
(
GargM
,
GargError
)
import
Gargantext.Core.Mail.Types
(
HasMail
)
import
Gargantext.Database.Admin.Types.Hyperdata
(
HyperdataUser
(
..
))
import
Gargantext.Database.Prelude
(
HasConnectionPool
,
HasConfig
)
import
Gargantext.Database.Query.Table.User
(
getUsersWithId
,
getUserHyperdata
)
...
...
@@ -34,18 +35,18 @@ type GqlM e env = Resolver QUERY e (GargM env GargError)
-- | Function to resolve user from a query.
resolveUsers
::
(
HasConnectionPool
env
,
HasConfig
env
)
::
(
HasConnectionPool
env
,
HasConfig
env
,
HasMail
env
)
=>
UserArgs
->
GqlM
e
env
[
User
(
GqlM
e
env
)]
resolveUsers
UserArgs
{
user_id
}
=
dbUsers
user_id
-- | Inner function to fetch the user from DB.
dbUsers
::
(
HasConnectionPool
env
,
HasConfig
env
)
::
(
HasConnectionPool
env
,
HasConfig
env
,
HasMail
env
)
=>
Int
->
GqlM
e
env
([
User
(
GqlM
e
env
)])
dbUsers
user_id
=
lift
(
map
toUser
<$>
getUsersWithId
user_id
)
toUser
::
(
HasConnectionPool
env
,
HasConfig
env
)
::
(
HasConnectionPool
env
,
HasConfig
env
,
HasMail
env
)
=>
UserLight
->
User
(
GqlM
e
env
)
toUser
(
UserLight
{
..
})
=
User
{
u_email
=
userLight_email
,
u_hyperdata
=
resolveHyperdata
userLight_id
...
...
@@ -53,6 +54,6 @@ toUser (UserLight { .. }) = User { u_email = userLight_email
,
u_username
=
userLight_username
}
resolveHyperdata
::
(
HasConnectionPool
env
,
HasConfig
env
)
::
(
HasConnectionPool
env
,
HasConfig
env
,
HasMail
env
)
=>
Int
->
GqlM
e
env
(
Maybe
HyperdataUser
)
resolveHyperdata
userid
=
lift
(
listToMaybe
<$>
getUserHyperdata
userid
)
src/Gargantext/API/GraphQL/UserInfo.hs
View file @
3005b6fb
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DuplicateRecordFields #-}
module
Gargantext.API.GraphQL.UserInfo
where
...
...
@@ -14,6 +14,7 @@ import Data.Morpheus.Types
import
Data.Text
(
Text
)
import
qualified
Data.Text
as
T
import
Gargantext.API.Prelude
(
GargM
,
GargError
)
import
Gargantext.Core.Mail.Types
(
HasMail
)
import
Gargantext.Database.Admin.Types.Hyperdata
(
HyperdataUser
(
..
)
,
hc_source
...
...
@@ -92,13 +93,13 @@ type GqlM e env = Resolver QUERY e (GargM env GargError)
-- | Function to resolve user from a query.
resolveUserInfos
::
(
HasConnectionPool
env
,
HasConfig
env
)
::
(
HasConnectionPool
env
,
HasConfig
env
,
HasMail
env
)
=>
UserInfoArgs
->
GqlM
e
env
[
UserInfo
]
resolveUserInfos
UserInfoArgs
{
user_id
}
=
dbUsers
user_id
-- | Mutation for user info
updateUserInfo
::
(
HasConnectionPool
env
,
HasConfig
env
)
::
(
HasConnectionPool
env
,
HasConfig
env
,
HasMail
env
)
=>
UserInfoMArgs
->
ResolverM
e
(
GargM
env
GargError
)
Int
updateUserInfo
(
UserInfoMArgs
{
ui_id
,
..
})
=
do
lift
$
printDebug
"[updateUserInfo] ui_id"
ui_id
...
...
@@ -132,7 +133,7 @@ updateUserInfo (UserInfoMArgs { ui_id, .. }) = do
-- | Inner function to fetch the user from DB.
dbUsers
::
(
HasConnectionPool
env
,
HasConfig
env
)
::
(
HasConnectionPool
env
,
HasConfig
env
,
HasMail
env
)
=>
Int
->
GqlM
e
env
[
UserInfo
]
dbUsers
user_id
=
do
-- user <- getUsersWithId user_id
...
...
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