+{-# OPTIONS_GHC -fprint-potential-instances #-}
+
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DuplicateRecordFields #-} -- permit duplications for field names in multiple constructors
{-# LANGUAGE KindSignatures #-} -- for use of Endpoint (name :: Symbol)
import Data.ByteString.Lazy.Char8
( ByteString
)
-import Data.List.NonEmpty (NonEmpty ((:|)))
import Data.Map (Map)
import Data.Morpheus
( App
, RootResolver(..)
, Undefined(..)
)
+import Data.Proxy
import Gargantext.API.Admin.Auth.Types (AuthenticatedUser)
import Gargantext.API.Admin.Orchestrator.Types (JobLog)
import Gargantext.API.Prelude (HasJobEnv')
+import qualified Gargantext.API.GraphQL.Annuaire as GQLA
import qualified Gargantext.API.GraphQL.AsyncTask as GQLAT
-import qualified Gargantext.API.GraphQL.Ethercalc as GQLEthercalc
+import qualified Gargantext.API.GraphQL.Context as GQLCTX
+import qualified Gargantext.API.GraphQL.IMT as GQLIMT
import qualified Gargantext.API.GraphQL.Node as GQLNode
import qualified Gargantext.API.GraphQL.User as GQLUser
import qualified Gargantext.API.GraphQL.UserInfo as GQLUserInfo
+import qualified Gargantext.API.GraphQL.TreeFirstLevel as GQLTree
+import qualified Gargantext.API.GraphQL.Team as GQLTeam
import Gargantext.API.Prelude (GargM, GargError)
+import Gargantext.API.Types
import Gargantext.Core.Mail.Types (HasMail)
import Gargantext.Database.Prelude (HasConnectionPool, HasConfig)
import Gargantext.Prelude
import GHC.Generics (Generic)
-import Network.HTTP.Media ((//), (/:))
-import qualified Prelude as Prelude
import Servant
( (:<|>) (..)
, (:>)
- , Accept (..)
, Get
, JSON
- , MimeRender (..)
, Post
, ReqBody
, ServerT
)
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
= Query
- { job_logs :: GQLAT.JobLogArgs -> m (Map Int JobLog)
- , nodes :: GQLNode.NodeArgs -> m [GQLNode.Node]
- , node_parent :: GQLNode.NodeParentArgs -> m [GQLNode.Node]
- , user_infos :: GQLUserInfo.UserInfoArgs -> m [GQLUserInfo.UserInfo]
- , users :: GQLUser.UserArgs -> m [GQLUser.User m]
+ { annuaire_contacts :: GQLA.AnnuaireContactArgs -> m [GQLA.AnnuaireContact]
+ , contexts :: GQLCTX.NodeContextArgs -> m [GQLCTX.NodeContextGQL]
+ , contexts_for_ngrams :: GQLCTX.ContextsForNgramsArgs -> m [GQLCTX.ContextGQL]
+ , imt_schools :: GQLIMT.SchoolsArgs -> m [GQLIMT.School]
+ , job_logs :: GQLAT.JobLogArgs -> m (Map Int JobLog)
+ , nodes :: GQLNode.NodeArgs -> m [GQLNode.Node]
+ , node_parent :: GQLNode.NodeParentArgs -> m [GQLNode.Node]
+ , user_infos :: GQLUserInfo.UserInfoArgs -> m [GQLUserInfo.UserInfo]
+ , users :: GQLUser.UserArgs -> m [GQLUser.User m]
+ , tree :: GQLTree.TreeArgs -> m (GQLTree.TreeFirstLevel m)
+ , team :: GQLTeam.TeamArgs -> m GQLTeam.Team
} deriving (Generic, GQLType)
data Mutation m
= Mutation
- { ethercalc_csv_download :: GQLEthercalc.EthercalcCSVDownloadArgs -> m Int
- , update_user_info :: GQLUserInfo.UserInfoMArgs -> m Int }
- deriving (Generic, GQLType)
+ { update_user_info :: GQLUserInfo.UserInfoMArgs -> m Int
+ , delete_team_membership :: GQLTeam.TeamDeleteMArgs -> m [Int]
+ , update_node_context_category :: GQLCTX.NodeContextCategoryMArgs -> m [Int]
+ } deriving (Generic, GQLType)
-- | Possible GraphQL Events, i.e. here we describe how we will
-- manipulate the data.
-- | 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
- { queryResolver = Query { job_logs = GQLAT.resolveJobLogs
- , nodes = GQLNode.resolveNodes
- , node_parent = GQLNode.resolveNodeParent
- , user_infos = GQLUserInfo.resolveUserInfos
- , users = GQLUser.resolveUsers }
- , mutationResolver = Mutation { ethercalc_csv_download = GQLEthercalc.ethercalcCSVDownload
- , update_user_info = GQLUserInfo.updateUserInfo }
+ { queryResolver = Query { annuaire_contacts = GQLA.resolveAnnuaireContacts
+ , contexts = GQLCTX.resolveNodeContext
+ , contexts_for_ngrams = GQLCTX.resolveContextsForNgrams
+ , imt_schools = GQLIMT.resolveSchools
+ , job_logs = GQLAT.resolveJobLogs
+ , nodes = GQLNode.resolveNodes
+ , node_parent = GQLNode.resolveNodeParent
+ , user_infos = GQLUserInfo.resolveUserInfos
+ , users = GQLUser.resolveUsers
+ , tree = GQLTree.resolveTree
+ , team = GQLTeam.resolveTeam }
+ , mutationResolver = Mutation { update_user_info = GQLUserInfo.updateUserInfo
+ , delete_team_membership = GQLTeam.deleteTeamMembership
+ , update_node_context_category = GQLCTX.updateNodeContextCategory }
, subscriptionResolver = Undefined }
-- | 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
-- Now for some boilerplate to integrate the above GraphQL app with
-- servant.
--- | HTML type is needed for the GraphQL Playground.
-data HTML deriving (Typeable)
-instance Accept HTML where
- contentTypes _ = "text" // "html" /: ("charset", "utf-8") :| ["text" // "html"]
-instance MimeRender HTML ByteString where
- mimeRender _ = Prelude.id
-
-- | Servant route for the app we defined above.
type GQAPI = ReqBody '[JSON] GQLRequest :> Post '[JSON] GQLResponse
-- type Schema = "schema" :> Get '[PlainText] Text
type API = SA.Auth '[SA.JWT, SA.Cookie] AuthenticatedUser
:> "gql" :> (GQAPI :<|> Playground)
+gqapi :: Proxy API
+gqapi = Proxy
+
-- serveEndpoint ::
-- ( SubApp ServerApp e
-- , PubApp e
-- App e IO ->
-- Server (API name)
-- serveEndpoint publish app' = (liftIO . httpPubApp publish app') :<|> withSchema app' :<|> pure httpPlayground
---
+--
-- withSchema :: (Applicative f) => App e m -> f Text
-- withSchema = pure . LT.toStrict . decodeUtf8 . render
-- | 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 _ = panic "401 in graphql" --SAS.throwAll (_ServerError # err401)
-api _ = httpPubApp [] app :<|> pure httpPlayground
+api _ = panic "401 in graphql" -- SAS.throwAll (_ServerError # err401)