graphql-engine/server/src-lib/Hasura/GraphQL/Resolve/Context.hs
Rakesh Emmadi 9bd5826020 allow customising graphql schema for a table (close #981) (#2509)
* allow customizing GraphQL root field names, close #981

* document v2 track_table API in reference

* support customising column field names in GraphQL schema

* [docs] add custom column fields doc in API reference

* add tests

* rename 'ColField' to 'ColumnField'

* embed column's graphql field in 'PGColumnInfo'

-> Value constructor of 'PGCol' is not exposed
-> Using 'parseJSON' to construct 'PGCol' in 'FromJSON' instances

* avoid using 'Maybe TableConfig'

* refactors & 'custom_column_fields' -> 'custom_column_names'

* cli-test: add configuration field in metadata export test

* update expected keys in `FromJSON` instance of `TableMeta`

* use `buildSchemaCacheFor` to update configuration in v2 track_table

* remove 'GraphQLName' type and use 'isValidName' exposed from parser lib

* point graphql-parser-hs library git repo to hasura

* support 'set_table_custom_fields' query API & added docs and tests
2019-09-19 10:17:36 +05:30

161 lines
4.4 KiB
Haskell

module Hasura.GraphQL.Resolve.Context
( FuncArgItem(..)
, OrdByItem(..)
, UpdPermForIns(..)
, InsCtx(..)
, RespTx
, LazyRespTx
, AnnPGVal(..)
, UnresolvedVal(..)
, resolveValPrep
, resolveValTxt
, InsertTxConflictCtx(..)
, getFldInfo
, getPGColInfo
, getArg
, withArg
, withArgM
, nameAsPath
, PrepArgs
, prepare
, prepareColVal
, withPrepArgs
, txtConverter
, withSelSet
, fieldAsPath
, resolvePGCol
, module Hasura.GraphQL.Utils
, module Hasura.GraphQL.Resolve.Types
) where
import Data.Has
import Hasura.Prelude
import qualified Data.HashMap.Strict as Map
import qualified Data.Sequence as Seq
import qualified Database.PG.Query as Q
import qualified Language.GraphQL.Draft.Syntax as G
import Hasura.GraphQL.Resolve.Types
import Hasura.GraphQL.Utils
import Hasura.GraphQL.Validate.Field
import Hasura.GraphQL.Validate.Types
import Hasura.RQL.DML.Internal (sessVarFromCurrentSetting)
import Hasura.RQL.Types
import Hasura.SQL.Types
import Hasura.SQL.Value
import qualified Hasura.SQL.DML as S
getFldInfo
:: (MonadError QErr m, MonadReader r m, Has FieldMap r)
=> G.NamedType -> G.Name
-> m (Either PGColumnInfo RelationshipField)
getFldInfo nt n = do
fldMap <- asks getter
onNothing (Map.lookup (nt,n) fldMap) $
throw500 $ "could not lookup " <> showName n <> " in " <>
showNamedTy nt
getPGColInfo
:: (MonadError QErr m, MonadReader r m, Has FieldMap r)
=> G.NamedType -> G.Name -> m PGColumnInfo
getPGColInfo nt n = do
fldInfo <- getFldInfo nt n
case fldInfo of
Left pgColInfo -> return pgColInfo
Right _ -> throw500 $
"found relinfo when expecting pgcolinfo for "
<> showNamedTy nt <> ":" <> showName n
getArg
:: (MonadError QErr m)
=> ArgsMap
-> G.Name
-> m AnnInpVal
getArg args arg =
onNothing (Map.lookup arg args) $
throw500 $ "missing argument: " <> showName arg
prependArgsInPath
:: (MonadError QErr m)
=> m a -> m a
prependArgsInPath = withPathK "args"
nameAsPath
:: (MonadError QErr m)
=> G.Name -> m a -> m a
nameAsPath name = withPathK (G.unName name)
withArg
:: (MonadError QErr m)
=> ArgsMap
-> G.Name
-> (AnnInpVal -> m a)
-> m a
withArg args arg f = prependArgsInPath $ nameAsPath arg $
getArg args arg >>= f
withArgM
:: (MonadResolve m)
=> ArgsMap
-> G.Name
-> (AnnInpVal -> m a)
-> m (Maybe a)
withArgM args argName f = do
wrappedArg <- for (Map.lookup argName args) $ \arg -> do
when (isJust (_aivVariable arg) && G.isNullable (_aivType arg)) markNotReusable
pure . bool (Just arg) Nothing $ hasNullVal (_aivValue arg)
prependArgsInPath . nameAsPath argName $ traverse f (join wrappedArg)
type PrepArgs = Seq.Seq Q.PrepArg
prepare :: (MonadState PrepArgs m) => AnnPGVal -> m S.SQLExp
prepare (AnnPGVal _ _ scalarValue) = prepareColVal scalarValue
resolveValPrep
:: (MonadState PrepArgs m)
=> UnresolvedVal -> m S.SQLExp
resolveValPrep = \case
UVPG annPGVal -> prepare annPGVal
UVSessVar colTy sessVar -> sessVarFromCurrentSetting colTy sessVar
UVSQL sqlExp -> return sqlExp
resolveValTxt :: (Applicative f) => UnresolvedVal -> f S.SQLExp
resolveValTxt = \case
UVPG annPGVal -> txtConverter annPGVal
UVSessVar colTy sessVar -> sessVarFromCurrentSetting colTy sessVar
UVSQL sqlExp -> pure sqlExp
withPrepArgs :: StateT PrepArgs m a -> m (a, PrepArgs)
withPrepArgs m = runStateT m Seq.empty
prepareColVal
:: (MonadState PrepArgs m)
=> WithScalarType PGScalarValue -> m S.SQLExp
prepareColVal (WithScalarType scalarType colVal) = do
preparedArgs <- get
put (preparedArgs Seq.|> binEncoder colVal)
return $ toPrepParam (Seq.length preparedArgs + 1) scalarType
txtConverter :: Applicative f => AnnPGVal -> f S.SQLExp
txtConverter (AnnPGVal _ _ scalarValue) = pure $ toTxtValue scalarValue
withSelSet :: (Monad m) => SelSet -> (Field -> m a) -> m [(Text, a)]
withSelSet selSet f =
forM (toList selSet) $ \fld -> do
res <- f fld
return (G.unName $ G.unAlias $ _fAlias fld, res)
fieldAsPath :: (MonadError QErr m) => Field -> m a -> m a
fieldAsPath = nameAsPath . _fName
resolvePGCol :: (MonadError QErr m)
=> PGColGNameMap -> G.Name -> m PGColumnInfo
resolvePGCol colFldMap fldName =
onNothing (Map.lookup fldName colFldMap) $ throw500 $
"no column associated with name " <> G.unName fldName