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