Merge branch 'dev' into dev-hackathon-fixes
[gargantext.git] / src / Gargantext / API / GraphQL.hs
index cac6d763f5e5397b52a88b8fe5da50e6bd80120c..c16adbe4bd6d93dc9a7f1a63a10d56eb869cce56 100644 (file)
@@ -1,3 +1,5 @@
+{-# 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)
@@ -9,7 +11,6 @@ module Gargantext.API.GraphQL where
 import Data.ByteString.Lazy.Char8
   ( ByteString
   )
-import Data.List.NonEmpty (NonEmpty ((:|)))
 import Data.Map (Map)
 import Data.Morpheus
   ( App
@@ -29,50 +30,61 @@ import Data.Morpheus.Types
   , 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.
@@ -92,22 +104,29 @@ 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
-    { 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
 
@@ -116,13 +135,6 @@ 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
@@ -133,6 +145,9 @@ type Playground = Get '[HTML] ByteString
 type API = SA.Auth '[SA.JWT, SA.Cookie] AuthenticatedUser
             :> "gql" :> (GQAPI :<|> Playground)
 
+gqapi :: Proxy API
+gqapi = Proxy
+
 -- serveEndpoint ::
 --   ( SubApp ServerApp e
 --   , PubApp e
@@ -141,15 +156,14 @@ type API = SA.Auth '[SA.JWT, SA.Cookie] AuthenticatedUser
 --   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)