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