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