src/Gargantext/API/GraphQL.hs

   1 {-# OPTIONS_GHC -fprint-potential-instances #-}
   2
   3 {-# LANGUAGE DeriveAnyClass #-}
   4 {-# LANGUAGE DuplicateRecordFields #-}  -- permit duplications for field names in multiple constructors
   5 {-# LANGUAGE KindSignatures #-}  -- for use of Endpoint (name :: Symbol)
   6 {-# LANGUAGE PartialTypeSignatures #-}  -- to automatically use suggested type hole signatures during compilation
   7 {-# LANGUAGE TypeOperators #-}
   8
   9 module Gargantext.API.GraphQL where
  10
  11 import Data.ByteString.Lazy.Char8
  12   ( ByteString
  13   )
  14 import Data.Map.Strict (Map)
  15 import Data.Morpheus
  16   ( App
  17   , deriveApp )
  18 import Data.Morpheus.Server
  19   ( httpPlayground
  20   )
  21 import Data.Morpheus.Subscriptions
  22   ( Event (..)
  23   , Hashable
  24   , httpPubApp
  25   )
  26 import Data.Morpheus.Types
  27   ( GQLRequest
  28   , GQLResponse
  29   , GQLType
  30   , RootResolver(..)
  31   )
  32 import Data.Morpheus.Server.Types
  33   ( Undefined
  34   , defaultRootResolver
  35   )
  36 import Data.Proxy
  37 import Data.Text (Text)
  38 import Gargantext.API.Admin.Auth.Types (AuthenticatedUser)
  39 import Gargantext.API.Admin.Orchestrator.Types (JobLog)
  40 import Gargantext.API.Prelude (HasJobEnv')
  41 import qualified Gargantext.API.GraphQL.Annuaire as GQLA
  42 import qualified Gargantext.API.GraphQL.AsyncTask as GQLAT
  43 import qualified Gargantext.API.GraphQL.Context as GQLCTX
  44 import qualified Gargantext.API.GraphQL.IMT as GQLIMT
  45 import qualified Gargantext.API.GraphQL.NLP as GQLNLP
  46 import qualified Gargantext.API.GraphQL.Node as GQLNode
  47 import qualified Gargantext.API.GraphQL.User as GQLUser
  48 import qualified Gargantext.API.GraphQL.UserInfo as GQLUserInfo
  49 import qualified Gargantext.API.GraphQL.TreeFirstLevel as GQLTree
  50 import qualified Gargantext.API.GraphQL.Team as GQLTeam
  51 import Gargantext.API.Prelude (GargM, GargError)
  52 import Gargantext.API.Types
  53 import Gargantext.Core.NLP (HasNLPServer)
  54 import Gargantext.Database.Prelude (CmdCommon)
  55 import Gargantext.Prelude
  56 import GHC.Generics (Generic)
  57 import Servant
  58   ( (:<|>) (..)
  59   , (:>)
  60   , Get
  61   , JSON
  62   , Post
  63   , ReqBody
  64   ,  ServerT
  65   )
  66 import qualified Servant.Auth as SA
  67 import qualified Servant.Auth.Server as SAS
  68 import Gargantext.API.Admin.Types (HasSettings)
  69
  70
  71 -- | Represents possible GraphQL queries.
  72 data Query m
  73   = Query
  74     { annuaire_contacts   :: GQLA.AnnuaireContactArgs -> m [GQLA.AnnuaireContact]
  75     , context_ngrams      :: GQLCTX.ContextNgramsArgs -> m [Text]
  76     , contexts            :: GQLCTX.NodeContextArgs -> m [GQLCTX.NodeContextGQL]
  77     , contexts_for_ngrams :: GQLCTX.ContextsForNgramsArgs -> m [GQLCTX.ContextGQL]
  78     , imt_schools         :: GQLIMT.SchoolsArgs -> m [GQLIMT.School]
  79     , job_logs            :: GQLAT.JobLogArgs -> m (Map Int JobLog)
  80     , languages           :: GQLNLP.LanguagesArgs -> m GQLNLP.LanguagesMap
  81     , nodes               :: GQLNode.NodeArgs -> m [GQLNode.Node]
  82     , nodes_corpus        :: GQLNode.CorpusArgs -> m [GQLNode.Corpus]
  83     , node_parent         :: GQLNode.NodeParentArgs -> m [GQLNode.Node]
  84     , user_infos          :: GQLUserInfo.UserInfoArgs -> m [GQLUserInfo.UserInfo]
  85     , users               :: GQLUser.UserArgs -> m [GQLUser.User m]
  86     , tree                :: GQLTree.TreeArgs -> m (GQLTree.TreeFirstLevel m)
  87     , team                :: GQLTeam.TeamArgs -> m GQLTeam.Team
  88     } deriving (Generic, GQLType)
  89
  90 data Mutation m
  91   = Mutation
  92     { update_user_info       :: GQLUserInfo.UserInfoMArgs -> m Int
  93     , update_user_pubmed_api_key :: GQLUser.UserPubmedAPIKeyMArgs -> m Int
  94     , delete_team_membership :: GQLTeam.TeamDeleteMArgs -> m [Int]
  95     , update_node_context_category :: GQLCTX.NodeContextCategoryMArgs -> m [Int]
  96     } deriving (Generic, GQLType)
  97
  98 -- | Possible GraphQL Events, i.e. here we describe how we will
  99 -- manipulate the data.
 100 type EVENT m = Event Channel (Contet m)
 101
 102 -- | Channels are possible actions to call when manipulating the data.
 103 data Channel
 104   = Update
 105   | New
 106   deriving (Eq, Show, Generic, Hashable)
 107
 108 -- | This type describes what data we will operate on.
 109 data Contet m
 110   = UserContet [GQLUser.User m]
 111   | UserInfoContet [GQLUserInfo.UserInfo]
 112
 113 -- | The main GraphQL resolver: how queries, mutations and
 114 -- subscriptions are handled.
 115 rootResolver
 116   :: (CmdCommon env, HasNLPServer env, HasJobEnv' env, HasSettings env)
 117   => RootResolver (GargM env GargError) e Query Mutation Undefined
 118 rootResolver =
 119   defaultRootResolver
 120     { queryResolver = Query { annuaire_contacts   = GQLA.resolveAnnuaireContacts
 121                             , context_ngrams      = GQLCTX.resolveContextNgrams
 122                             , contexts            = GQLCTX.resolveNodeContext
 123                             , contexts_for_ngrams = GQLCTX.resolveContextsForNgrams
 124                             , imt_schools         = GQLIMT.resolveSchools
 125                             , job_logs            = GQLAT.resolveJobLogs
 126                             , languages           = GQLNLP.resolveLanguages
 127                             , nodes               = GQLNode.resolveNodes
 128                             , nodes_corpus        = GQLNode.resolveNodesCorpus
 129                             , node_parent         = GQLNode.resolveNodeParent
 130                             , user_infos          = GQLUserInfo.resolveUserInfos
 131                             , users               = GQLUser.resolveUsers
 132                             , tree                = GQLTree.resolveTree
 133                             , team                = GQLTeam.resolveTeam }
 134     , mutationResolver = Mutation { update_user_info       = GQLUserInfo.updateUserInfo
 135                                   , update_user_pubmed_api_key = GQLUser.updateUserPubmedAPIKey
 136                                   , delete_team_membership = GQLTeam.deleteTeamMembership
 137                                   , update_node_context_category = GQLCTX.updateNodeContextCategory }
 138     }
 139
 140 -- | Main GraphQL "app".
 141 app
 142   :: (Typeable env, CmdCommon env, HasJobEnv' env, HasNLPServer env, HasSettings env)
 143   => App (EVENT (GargM env GargError)) (GargM env GargError)
 144 app = deriveApp rootResolver
 145
 146 ----------------------------------------------
 147
 148 -- Now for some boilerplate to integrate the above GraphQL app with
 149 -- servant.
 150
 151 -- | Servant route for the app we defined above.
 152 type GQAPI = ReqBody '[JSON] GQLRequest :> Post '[JSON] GQLResponse
 153 -- type Schema = "schema" :> Get '[PlainText] Text
 154 -- | Servant route for the playground.
 155 type Playground = Get '[HTML] ByteString
 156 -- type API' (name :: Symbol) = name :> (GQAPI :<|> Schema :<|> Playground)
 157 -- | Our API consists of `GQAPI` and `Playground`.
 158 type API = SA.Auth '[SA.JWT, SA.Cookie] AuthenticatedUser
 159             :> "gql" :> (GQAPI :<|> Playground)
 160
 161 gqapi :: Proxy API
 162 gqapi = Proxy
 163
 164 -- serveEndpoint ::
 165 --   ( SubApp ServerApp e
 166 --   , PubApp e
 167 --   ) =>
 168 --   [e -> IO ()] ->
 169 --   App e IO ->
 170 --   Server (API name)
 171 -- serveEndpoint publish app' = (liftIO . httpPubApp publish app') :<|> withSchema app' :<|> pure httpPlayground
 172 --
 173 -- withSchema :: (Applicative f) => App e m -> f Text
 174 -- withSchema = pure . LT.toStrict . decodeUtf8 . render
 175
 176 -- | Implementation of our API.
 177 --api :: Server API
 178 api
 179   :: (Typeable env, CmdCommon env, HasJobEnv' env, HasSettings env)
 180   => ServerT API (GargM env GargError)
 181 api (SAS.Authenticated _auser) = httpPubApp [] app :<|> pure httpPlayground
 182 api _                          = panic "401 in graphql" -- SAS.throwAll (_ServerError # err401)