mirror of
https://github.com/hasura/graphql-engine.git
synced 2024-12-17 20:41:49 +03:00
106 lines
3.5 KiB
Haskell
106 lines
3.5 KiB
Haskell
module Hasura.GraphQL.Resolve
|
|
( resolveSelSet
|
|
) where
|
|
|
|
import Hasura.Prelude
|
|
|
|
import qualified Data.Aeson as J
|
|
import qualified Data.ByteString.Lazy as BL
|
|
import qualified Data.HashMap.Strict as Map
|
|
import qualified Database.PG.Query as Q
|
|
import qualified Language.GraphQL.Draft.Syntax as G
|
|
|
|
|
|
import Hasura.GraphQL.Context
|
|
import Hasura.GraphQL.Resolve.Context
|
|
import Hasura.GraphQL.Resolve.Introspect
|
|
import Hasura.GraphQL.Transport.HTTP.Protocol
|
|
import Hasura.GraphQL.Validate.Field
|
|
import Hasura.RQL.Types
|
|
import Hasura.SQL.Types
|
|
|
|
import qualified Hasura.GraphQL.Resolve.Insert as RI
|
|
import qualified Hasura.GraphQL.Resolve.Mutation as RM
|
|
import qualified Hasura.GraphQL.Resolve.Select as RS
|
|
|
|
-- {-# SCC buildTx #-}
|
|
buildTx :: UserInfo -> GCtx -> SQLGenCtx -> Field -> Q.TxE QErr BL.ByteString
|
|
buildTx userInfo gCtx sqlCtx fld = do
|
|
opCxt <- getOpCtx $ _fName fld
|
|
join $ fmap fst $ runConvert ( fldMap
|
|
, orderByCtx
|
|
, insCtxMap
|
|
, sqlCtx
|
|
) $ case opCxt of
|
|
|
|
OCSelect ctx ->
|
|
validateHdrs (_socHeaders ctx) >> RS.convertSelect ctx fld
|
|
|
|
OCSelectPkey ctx ->
|
|
validateHdrs (_spocHeaders ctx) >> RS.convertSelectByPKey ctx fld
|
|
|
|
OCSelectAgg ctx ->
|
|
validateHdrs (_socHeaders ctx) >> RS.convertAggSelect ctx fld
|
|
|
|
OCFuncQuery ctx ->
|
|
validateHdrs (_fqocHeaders ctx) >> RS.convertFuncQuery ctx False fld
|
|
|
|
OCFuncAggQuery ctx ->
|
|
validateHdrs (_fqocHeaders ctx) >> RS.convertFuncQuery ctx True fld
|
|
|
|
OCInsert ctx ->
|
|
validateHdrs (_iocHeaders ctx) >> RI.convertInsert roleName (_iocTable ctx) fld
|
|
|
|
OCUpdate ctx ->
|
|
validateHdrs (_uocHeaders ctx) >> RM.convertUpdate ctx fld
|
|
|
|
OCDelete ctx ->
|
|
validateHdrs (_docHeaders ctx) >> RM.convertDelete ctx fld
|
|
where
|
|
roleName = userRole userInfo
|
|
opCtxMap = _gOpCtxMap gCtx
|
|
fldMap = _gFields gCtx
|
|
orderByCtx = _gOrdByCtx gCtx
|
|
insCtxMap = _gInsCtxMap gCtx
|
|
|
|
getOpCtx f =
|
|
onNothing (Map.lookup f opCtxMap) $ throw500 $
|
|
"lookup failed: opctx: " <> showName f
|
|
|
|
validateHdrs hdrs = do
|
|
let receivedVars = userVars userInfo
|
|
forM_ hdrs $ \hdr ->
|
|
unless (isJust $ getVarVal hdr receivedVars) $
|
|
throw400 NotFound $ hdr <<> " header is expected but not found"
|
|
|
|
-- {-# SCC resolveFld #-}
|
|
resolveFld
|
|
:: (MonadTx m)
|
|
=> UserInfo -> GCtx -> SQLGenCtx
|
|
-> G.OperationType
|
|
-> Field
|
|
-> m BL.ByteString
|
|
resolveFld userInfo gCtx sqlGenCtx opTy fld =
|
|
case _fName fld of
|
|
"__type" -> J.encode <$> runReaderT (typeR fld) gCtx
|
|
"__schema" -> J.encode <$> runReaderT (schemaR fld) gCtx
|
|
"__typename" -> return $ J.encode $ mkRootTypeName opTy
|
|
_ -> liftTx $ buildTx userInfo gCtx sqlGenCtx fld
|
|
where
|
|
mkRootTypeName :: G.OperationType -> Text
|
|
mkRootTypeName = \case
|
|
G.OperationTypeQuery -> "query_root"
|
|
G.OperationTypeMutation -> "mutation_root"
|
|
G.OperationTypeSubscription -> "subscription_root"
|
|
|
|
resolveSelSet
|
|
:: (MonadTx m)
|
|
=> UserInfo -> GCtx -> SQLGenCtx
|
|
-> G.OperationType
|
|
-> SelSet
|
|
-> m BL.ByteString
|
|
resolveSelSet userInfo gCtx sqlGenCtx opTy fields =
|
|
fmap mkJSONObj $ forM (toList fields) $ \fld -> do
|
|
fldResp <- resolveFld userInfo gCtx sqlGenCtx opTy fld
|
|
return (G.unName $ G.unAlias $ _fAlias fld, fldResp)
|