graphql-engine/server/src-lib/Hasura/GraphQL/Context.hs
hasura-bot 2c56254e5a server: simplify JSON instances
GITHUB_PR_NUMBER: 6152
GITHUB_PR_URL: https://github.com/hasura/graphql-engine/pull/6152

Co-authored-by: Antoine Leblanc <1618949+nicuveo@users.noreply.github.com>
GitOrigin-RevId: 6c94aef8c57e852b3d41b8355c09e64fce756a7c
2021-01-19 19:15:42 +00:00

142 lines
4.6 KiB
Haskell

{-# LANGUAGE StrictData #-}
module Hasura.GraphQL.Context
( RoleContext(..)
, GQLContext(..)
, ParserFn
, RootField(..)
, traverseDB
, traverseAction
, traverseRemoteField
, QueryDB(..)
, ActionQuery(..)
, QueryRootField
, MutationDB(..)
, ActionMutation(..)
, MutationRootField
, SubscriptionRootField
, SubscriptionRootFieldResolved
, RemoteFieldG (..)
, RemoteField
) where
import Hasura.Prelude
import qualified Data.Aeson as J
import qualified Language.GraphQL.Draft.Syntax as G
import Data.Aeson.TH
import Hasura.SQL.Backend
import qualified Hasura.Backends.Postgres.Connection as PG
import qualified Hasura.Backends.Postgres.SQL.DML as PG
import qualified Hasura.RQL.IR.Delete as IR
import qualified Hasura.RQL.IR.Insert as IR
import qualified Hasura.RQL.IR.Select as IR
import qualified Hasura.RQL.IR.Update as IR
import qualified Hasura.RQL.Types.Action as RQL
import qualified Hasura.RQL.Types.Common as RQL
import qualified Hasura.RQL.Types.RemoteSchema as RQL
import Hasura.GraphQL.Parser
-- | For storing both a normal GQLContext and one for the backend variant.
-- Currently, this is to enable the backend variant to have certain insert
-- permissions which the frontend variant does not.
data RoleContext a
= RoleContext
{ _rctxDefault :: !a -- ^ The default context for normal sessions
, _rctxBackend :: !(Maybe a) -- ^ The context for sessions with backend privilege.
} deriving (Show, Eq, Functor, Foldable, Traversable)
$(deriveToJSON hasuraJSON ''RoleContext)
data GQLContext = GQLContext
{ gqlQueryParser :: ParserFn (InsOrdHashMap G.Name (QueryRootField (UnpreparedValue 'Postgres)))
, gqlMutationParser :: Maybe (ParserFn (InsOrdHashMap G.Name (MutationRootField (UnpreparedValue 'Postgres))))
}
instance J.ToJSON GQLContext where
toJSON GQLContext{} = J.String "The GraphQL schema parsers"
type ParserFn a
= G.SelectionSet G.NoFragments Variable
-> Either (NESeq ParseError) (a, QueryReusability)
data RootField db remote action raw
= RFDB !RQL.SourceName !PG.PGExecCtx db
| RFRemote remote
| RFAction action
| RFRaw raw
traverseDB :: forall db db' remote action raw f
. Applicative f
=> (db -> f db')
-> RootField db remote action raw
-> f (RootField db' remote action raw)
traverseDB f = \case
RFDB s e x -> RFDB s e <$> f x
RFRemote x -> pure $ RFRemote x
RFAction x -> pure $ RFAction x
RFRaw x -> pure $ RFRaw x
traverseAction :: forall db remote action action' raw f
. Applicative f
=> (action -> f action')
-> RootField db remote action raw
-> f (RootField db remote action' raw)
traverseAction f = \case
RFDB s e x -> pure $ RFDB s e x
RFRemote x -> pure $ RFRemote x
RFAction x -> RFAction <$> f x
RFRaw x -> pure $ RFRaw x
traverseRemoteField :: forall db remote remote' action raw f
. Applicative f
=> (remote -> f remote')
-> RootField db remote action raw
-> f (RootField db remote' action raw)
traverseRemoteField f = \case
RFDB s e x -> pure $ RFDB s e x
RFRemote x -> RFRemote <$> f x
RFAction x -> pure $ RFAction x
RFRaw x -> pure $ RFRaw x
data QueryDB b v
= QDBSimple (IR.AnnSimpleSelG b v)
| QDBPrimaryKey (IR.AnnSimpleSelG b v)
| QDBAggregation (IR.AnnAggregateSelectG b v)
| QDBConnection (IR.ConnectionSelect b v)
data ActionQuery (b :: BackendType) v
= AQQuery !(RQL.AnnActionExecution b v)
| AQAsync !(RQL.AnnActionAsyncQuery b v)
data RemoteFieldG var
= RemoteFieldG
{ _rfRemoteSchemaInfo :: !RQL.RemoteSchemaInfo
, _rfField :: !(G.Field G.NoFragments var)
} deriving (Functor, Foldable, Traversable)
type RemoteField = RemoteFieldG RQL.RemoteSchemaVariable
type QueryRootField v = RootField (QueryDB 'Postgres v) RemoteField (ActionQuery 'Postgres v) J.Value
data MutationDB (b :: BackendType) v
= MDBInsert (IR.AnnInsert b v)
| MDBUpdate (IR.AnnUpdG b v)
| MDBDelete (IR.AnnDelG b v)
| MDBFunction (IR.AnnSimpleSelG b v)
-- ^ This represents a VOLATILE function, and is AnnSimpleSelG for easy
-- re-use of non-VOLATILE function tracking code.
data ActionMutation (b :: BackendType) v
= AMSync !(RQL.AnnActionExecution b v)
| AMAsync !RQL.AnnActionMutationAsync
type MutationRootField v =
RootField (MutationDB 'Postgres v) RemoteField (ActionMutation 'Postgres v) J.Value
type SubscriptionRootField v = RootField (QueryDB 'Postgres v) Void Void Void
type SubscriptionRootFieldResolved = RootField (QueryDB 'Postgres PG.SQLExp) Void Void Void