graphql-engine/server/src-lib/Hasura/GraphQL/Resolve.hs
Vamshi Surabhi 52bf885f14
refactor schema.hs into multiple modules (#2661)
Mostly moving around things across modules. No change in
functionality.
2019-08-09 14:49:17 +05:30

140 lines
4.1 KiB
Haskell

module Hasura.GraphQL.Resolve
( mutFldToTx
, queryFldToPGAST
, RS.traverseQueryRootFldAST
, RS.toPGQuery
, UnresolvedVal(..)
, AnnPGVal(..)
, txtConverter
, RS.QueryRootFldUnresolved
, resolveValPrep
, queryFldToSQL
, RIntro.schemaR
, RIntro.typeR
) where
import Data.Has
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.Resolve.Context
import Hasura.Prelude
import Hasura.RQL.DML.Internal (sessVarFromCurrentSetting)
import Hasura.RQL.Types
import Hasura.SQL.Types
import qualified Hasura.GraphQL.Resolve.Insert as RI
import qualified Hasura.GraphQL.Resolve.Introspect as RIntro
import qualified Hasura.GraphQL.Resolve.Mutation as RM
import qualified Hasura.GraphQL.Resolve.Select as RS
import qualified Hasura.GraphQL.Validate as V
validateHdrs
:: (Foldable t, QErrM m) => UserInfo -> t Text -> m ()
validateHdrs userInfo hdrs = do
let receivedVars = userVars userInfo
forM_ hdrs $ \hdr ->
unless (isJust $ getVarVal hdr receivedVars) $
throw400 NotFound $ hdr <<> " header is expected but not found"
queryFldToPGAST
:: ( MonadError QErr m, MonadReader r m, Has FieldMap r
, Has OrdByCtx r, Has SQLGenCtx r, Has UserInfo r
, Has OpCtxMap r
)
=> V.Field
-> m RS.QueryRootFldUnresolved
queryFldToPGAST fld = do
opCtx <- getOpCtx $ V._fName fld
userInfo <- asks getter
case opCtx of
OCSelect ctx -> do
validateHdrs userInfo (_socHeaders ctx)
RS.convertSelect ctx fld
OCSelectPkey ctx -> do
validateHdrs userInfo (_spocHeaders ctx)
RS.convertSelectByPKey ctx fld
OCSelectAgg ctx -> do
validateHdrs userInfo (_socHeaders ctx)
RS.convertAggSelect ctx fld
OCFuncQuery ctx -> do
validateHdrs userInfo (_fqocHeaders ctx)
RS.convertFuncQuerySimple ctx fld
OCFuncAggQuery ctx -> do
validateHdrs userInfo (_fqocHeaders ctx)
RS.convertFuncQueryAgg ctx fld
OCInsert _ ->
throw500 "unexpected OCInsert for query field context"
OCUpdate _ ->
throw500 "unexpected OCUpdate for query field context"
OCDelete _ ->
throw500 "unexpected OCDelete for query field context"
queryFldToSQL
:: ( MonadError QErr m, MonadReader r m, Has FieldMap r
, Has OrdByCtx r, Has SQLGenCtx r, Has UserInfo r
, Has OpCtxMap r
)
=> PrepFn m
-> V.Field
-> m Q.Query
queryFldToSQL fn fld = do
pgAST <- queryFldToPGAST fld
resolvedAST <- flip RS.traverseQueryRootFldAST pgAST $ \case
UVPG annPGVal -> fn annPGVal
UVSQL sqlExp -> return sqlExp
UVSessVar colTy sessVar -> sessVarFromCurrentSetting colTy sessVar
return $ RS.toPGQuery resolvedAST
mutFldToTx
:: ( MonadError QErr m
, MonadReader r m
, Has UserInfo r
, Has OpCtxMap r
, Has FieldMap r
, Has OrdByCtx r
, Has SQLGenCtx r
, Has InsCtxMap r
)
=> V.Field
-> m RespTx
mutFldToTx fld = do
userInfo <- asks getter
opCtx <- getOpCtx $ V._fName fld
case opCtx of
OCInsert ctx -> do
let roleName = userRole userInfo
validateHdrs userInfo (_iocHeaders ctx)
RI.convertInsert roleName (_iocTable ctx) fld
OCUpdate ctx -> do
validateHdrs userInfo (_uocHeaders ctx)
RM.convertUpdate ctx fld
OCDelete ctx -> do
validateHdrs userInfo (_docHeaders ctx)
RM.convertDelete ctx fld
OCSelect _ ->
throw500 "unexpected query field context for a mutation field"
OCSelectPkey _ ->
throw500 "unexpected query field context for a mutation field"
OCSelectAgg _ ->
throw500 "unexpected query field context for a mutation field"
OCFuncQuery _ ->
throw500 "unexpected query field context for a mutation field"
OCFuncAggQuery _ ->
throw500 "unexpected query field context for a mutation field"
getOpCtx
:: ( MonadError QErr m
, MonadReader r m
, Has OpCtxMap r
)
=> G.Name -> m OpCtx
getOpCtx f = do
opCtxMap <- asks getter
onNothing (Map.lookup f opCtxMap) $ throw500 $
"lookup failed: opctx: " <> showName f