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
199
Issues
199
List
Board
Labels
Milestones
Merge Requests
12
Merge Requests
12
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
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
Pipeline
#2078
failed with stage
in 10 minutes and 12 seconds
Changes
5
Pipelines
1
Show 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