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     , delete_team_membership :: GQLTeam.TeamDeleteMArgs -> m [Int]
  91     , update_node_context_category :: GQLCTX.NodeContextCategoryMArgs -> m [Int]
  92     } deriving (Generic, GQLType)
  93
  94 -- | Possible GraphQL Events, i.e. here we describe how we will
  95 -- manipulate the data.
  96 type EVENT m = Event Channel (Contet m)
  97
  98 -- | Channels are possible actions to call when manipulating the data.
  99 data Channel
 100   = Update
 101   | New
 102   deriving (Eq, Show, Generic, Hashable)
 103
 104 -- | This type describes what data we will operate on.
 105 data Contet m
 106   = UserContet [GQLUser.User m]
 107   | UserInfoContet [GQLUserInfo.UserInfo]
 108
 109 -- | The main GraphQL resolver: how queries, mutations and
 110 -- subscriptions are handled.
 111 rootResolver
 112   :: (CmdCommon env, HasNLPServer env, HasJobEnv' env, HasSettings env)
 113   => RootResolver (GargM env GargError) e Query Mutation Undefined
 114 rootResolver =
 115   RootResolver
 116     { queryResolver = Query { annuaire_contacts   = GQLA.resolveAnnuaireContacts
 117                             , context_ngrams      = GQLCTX.resolveContextNgrams
 118                             , contexts            = GQLCTX.resolveNodeContext
 119                             , contexts_for_ngrams = GQLCTX.resolveContextsForNgrams
 120                             , imt_schools         = GQLIMT.resolveSchools
 121                             , job_logs            = GQLAT.resolveJobLogs
 122                             , languages           = GQLNLP.resolveLanguages
 123                             , nodes               = GQLNode.resolveNodes
 124                             , nodes_corpus        = GQLNode.resolveNodesCorpus
 125                             , node_parent         = GQLNode.resolveNodeParent
 126                             , user_infos          = GQLUserInfo.resolveUserInfos
 127                             , users               = GQLUser.resolveUsers
 128                             , tree                = GQLTree.resolveTree
 129                             , team                = GQLTeam.resolveTeam }
 130     , mutationResolver = Mutation { update_user_info       = GQLUserInfo.updateUserInfo
 131                                   , delete_team_membership = GQLTeam.deleteTeamMembership
 132                                   , update_node_context_category = GQLCTX.updateNodeContextCategory }
 133     , subscriptionResolver = Undefined }
 134
 135 -- | Main GraphQL "app".
 136 app
 137   :: (Typeable env, CmdCommon env, HasJobEnv' env, HasNLPServer env, HasSettings env)
 138   => App (EVENT (GargM env GargError)) (GargM env GargError)
 139 app = deriveApp rootResolver
 140
 141 ----------------------------------------------
 142
 143 -- Now for some boilerplate to integrate the above GraphQL app with
 144 -- servant.
 145
 146 -- | Servant route for the app we defined above.
 147 type GQAPI = ReqBody '[JSON] GQLRequest :> Post '[JSON] GQLResponse
 148 -- type Schema = "schema" :> Get '[PlainText] Text
 149 -- | Servant route for the playground.
 150 type Playground = Get '[HTML] ByteString
 151 -- type API' (name :: Symbol) = name :> (GQAPI :<|> Schema :<|> Playground)
 152 -- | Our API consists of `GQAPI` and `Playground`.
 153 type API = SA.Auth '[SA.JWT, SA.Cookie] AuthenticatedUser
 154             :> "gql" :> (GQAPI :<|> Playground)
 155
 156 gqapi :: Proxy API
 157 gqapi = Proxy
 158
 159 -- serveEndpoint ::
 160 --   ( SubApp ServerApp e
 161 --   , PubApp e
 162 --   ) =>
 163 --   [e -> IO ()] ->
 164 --   App e IO ->
 165 --   Server (API name)
 166 -- serveEndpoint publish app' = (liftIO . httpPubApp publish app') :<|> withSchema app' :<|> pure httpPlayground
 167 --
 168 -- withSchema :: (Applicative f) => App e m -> f Text
 169 -- withSchema = pure . LT.toStrict . decodeUtf8 . render
 170
 171 -- | Implementation of our API.
 172 --api :: Server API
 173 api
 174   :: (Typeable env, CmdCommon env, HasJobEnv' env, HasSettings env)
 175   => ServerT API (GargM env GargError)
 176 api (SAS.Authenticated _auser) = httpPubApp [] app :<|> pure httpPlayground
 177 api _                          = panic "401 in graphql" -- SAS.throwAll (_ServerError # err401)