mirror of
https://github.com/hasura/graphql-engine.git
synced 2024-12-18 04:51:35 +03:00
d52bfcda4e
* move user info related code to Hasura.User module
* the RFC #4120 implementation; insert permissions with admin secret
* revert back to old RoleName based schema maps
An attempt made to avoid duplication of schema contexts in types
if any role doesn't possess any admin secret specific schema
* fix compile errors in haskell test
* keep 'user_vars' for session variables in http-logs
* no-op refacto
* tests for admin only inserts
* update docs for admin only inserts
* updated CHANGELOG.md
* default behaviour when admin secret is not set
* fix x-hasura-role to X-Hasura-Role in pytests
* introduce effective timeout in actions async tests
* update docs for admin-secret not configured case
* Update docs/graphql/manual/api-reference/schema-metadata-api/permission.rst
Co-Authored-By: Marion Schleifer <marion@hasura.io>
* Apply suggestions from code review
Co-Authored-By: Marion Schleifer <marion@hasura.io>
* a complete iteration
backend insert permissions accessable via 'x-hasura-backend-privilege'
session variable
* console changes for backend-only permissions
* provide tooltip id; update labels and tooltips;
* requested changes
* requested changes
- remove className from Toggle component
- use appropriate function name (capitalizeFirstChar -> capitalize)
* use toggle props from definitelyTyped
* fix accidental commit
* Revert "introduce effective timeout in actions async tests"
This reverts commit b7a59c19d6.
* generate complete schema for both 'default' and 'backend' sessions
* Apply suggestions from code review
Co-Authored-By: Marion Schleifer <marion@hasura.io>
* remove unnecessary import, export Toggle as is
* update session variable in tooltip
* 'x-hasura-use-backend-only-permissions' variable to switch
* update help texts
* update docs
* update docs
* update console help text
* regenerate package-lock
* serve no backend schema when backend_only: false and header set to true
- Few type name refactor as suggested by @0x777
* update CHANGELOG.md
* Update CHANGELOG.md
* Update CHANGELOG.md
* fix a merge bug where a certain entity didn't get removed
Co-authored-by: Marion Schleifer <marion@hasura.io>
Co-authored-by: Rishichandra Wawhal <rishi@hasura.io>
Co-authored-by: rikinsk <rikin.kachhia@gmail.com>
Co-authored-by: Tirumarai Selvan <tiru@hasura.io>
358 lines
11 KiB
Haskell
358 lines
11 KiB
Haskell
module Hasura.GraphQL.Resolve.Introspect
|
|
( schemaR
|
|
, typeR
|
|
) where
|
|
|
|
import Data.Has
|
|
import Hasura.Prelude
|
|
|
|
import qualified Data.Aeson as J
|
|
import qualified Data.HashMap.Strict as Map
|
|
import qualified Data.HashSet as Set
|
|
import qualified Data.Text as T
|
|
import qualified Language.GraphQL.Draft.Syntax as G
|
|
|
|
import Hasura.GraphQL.Context
|
|
import Hasura.GraphQL.Resolve.Context
|
|
import Hasura.GraphQL.Resolve.InputValue
|
|
import Hasura.GraphQL.Validate.Context
|
|
import Hasura.GraphQL.Validate.Field
|
|
import Hasura.GraphQL.Validate.InputValue
|
|
import Hasura.GraphQL.Validate.Types
|
|
import Hasura.RQL.Types
|
|
|
|
data TypeKind
|
|
= TKSCALAR
|
|
| TKOBJECT
|
|
| TKINTERFACE
|
|
| TKUNION
|
|
| TKENUM
|
|
| TKINPUT_OBJECT
|
|
| TKLIST
|
|
| TKNON_NULL
|
|
deriving (Show, Eq)
|
|
|
|
instance J.ToJSON TypeKind where
|
|
toJSON = J.toJSON . T.pack . drop 2 . show
|
|
|
|
withSubFields
|
|
:: (Monad m)
|
|
=> SelSet
|
|
-> (Field -> m J.Value)
|
|
-> m J.Object
|
|
withSubFields selSet fn =
|
|
fmap Map.fromList $ forM (toList selSet) $ \fld -> do
|
|
val <- fn fld
|
|
return (G.unName $ G.unAlias $ _fAlias fld, val)
|
|
|
|
namedTyToTxt :: G.NamedType -> Text
|
|
namedTyToTxt = G.unName . G.unNamedType
|
|
|
|
retJ :: (Applicative m, J.ToJSON a) => a -> m J.Value
|
|
retJ = pure . J.toJSON
|
|
|
|
retJT :: (Applicative m) => Text -> m J.Value
|
|
retJT = pure . J.toJSON
|
|
|
|
-- 4.5.2.1
|
|
scalarR
|
|
:: (Monad m)
|
|
=> ScalarTyInfo
|
|
-> Field
|
|
-> m J.Object
|
|
scalarR (ScalarTyInfo descM name _ _) fld =
|
|
withSubFields (_fSelSet fld) $ \subFld ->
|
|
case _fName subFld of
|
|
"__typename" -> retJT "__Type"
|
|
"kind" -> retJ TKSCALAR
|
|
"description" -> retJ $ fmap G.unDescription descM
|
|
"name" -> retJ name
|
|
_ -> return J.Null
|
|
|
|
-- 4.5.2.2
|
|
objectTypeR
|
|
:: ( MonadReader r m, Has TypeMap r
|
|
, MonadError QErr m)
|
|
=> ObjTyInfo
|
|
-> Field
|
|
-> m J.Object
|
|
objectTypeR objectType fld =
|
|
withSubFields (_fSelSet fld) $ \subFld ->
|
|
case _fName subFld of
|
|
"__typename" -> retJT "__Type"
|
|
"kind" -> retJ TKOBJECT
|
|
"name" -> retJ $ namedTyToTxt n
|
|
"description" -> retJ $ fmap G.unDescription descM
|
|
"interfaces" -> fmap J.toJSON $ mapM (`ifaceR` subFld) $ Set.toList iFaces
|
|
"fields" -> fmap J.toJSON $ mapM (`fieldR` subFld) $
|
|
sortOn _fiName $
|
|
filter notBuiltinFld $ Map.elems flds
|
|
_ -> return J.Null
|
|
where
|
|
descM = _otiDesc objectType
|
|
n = _otiName objectType
|
|
iFaces = _otiImplIFaces objectType
|
|
flds = _otiFields objectType
|
|
|
|
notBuiltinFld :: ObjFldInfo -> Bool
|
|
notBuiltinFld f =
|
|
fldName /= "__typename" && fldName /= "__type" && fldName /= "__schema"
|
|
where
|
|
fldName = _fiName f
|
|
|
|
getImplTypes :: (MonadReader t m, Has TypeMap t) => AsObjType -> m [ObjTyInfo]
|
|
getImplTypes aot = do
|
|
tyInfo :: TypeMap <- asks getter
|
|
return $ sortOn _otiName $
|
|
Map.elems $ getPossibleObjTypes' tyInfo aot
|
|
|
|
-- 4.5.2.3
|
|
unionR
|
|
:: (MonadReader t m, MonadError QErr m, Has TypeMap t)
|
|
=> UnionTyInfo -> Field -> m J.Object
|
|
unionR u@(UnionTyInfo descM n _) fld =
|
|
withSubFields (_fSelSet fld) $ \subFld ->
|
|
case _fName subFld of
|
|
"__typename" -> retJT "__Field"
|
|
"kind" -> retJ TKUNION
|
|
"name" -> retJ $ namedTyToTxt n
|
|
"description" -> retJ $ fmap G.unDescription descM
|
|
"possibleTypes" -> fmap J.toJSON $
|
|
mapM (`objectTypeR` subFld) =<< getImplTypes (AOTUnion u)
|
|
_ -> return J.Null
|
|
|
|
-- 4.5.2.4
|
|
ifaceR
|
|
:: ( MonadReader r m, Has TypeMap r
|
|
, MonadError QErr m)
|
|
=> G.NamedType
|
|
-> Field
|
|
-> m J.Object
|
|
ifaceR n fld = do
|
|
tyInfo <- getTyInfo n
|
|
case tyInfo of
|
|
TIIFace ifaceTyInfo -> ifaceR' ifaceTyInfo fld
|
|
_ -> throw500 $ "Unknown interface " <> showNamedTy n
|
|
|
|
ifaceR'
|
|
:: ( MonadReader r m, Has TypeMap r
|
|
, MonadError QErr m)
|
|
=> IFaceTyInfo
|
|
-> Field
|
|
-> m J.Object
|
|
ifaceR' i@(IFaceTyInfo descM n flds) fld =
|
|
withSubFields (_fSelSet fld) $ \subFld ->
|
|
case _fName subFld of
|
|
"__typename" -> retJT "__Type"
|
|
"kind" -> retJ TKINTERFACE
|
|
"name" -> retJ $ namedTyToTxt n
|
|
"description" -> retJ $ fmap G.unDescription descM
|
|
"fields" -> fmap J.toJSON $ mapM (`fieldR` subFld) $
|
|
sortOn _fiName $
|
|
filter notBuiltinFld $ Map.elems flds
|
|
"possibleTypes" -> fmap J.toJSON $ mapM (`objectTypeR` subFld)
|
|
=<< getImplTypes (AOTIFace i)
|
|
_ -> return J.Null
|
|
|
|
-- 4.5.2.5
|
|
enumTypeR
|
|
:: ( Monad m )
|
|
=> EnumTyInfo
|
|
-> Field
|
|
-> m J.Object
|
|
enumTypeR (EnumTyInfo descM n vals _) fld =
|
|
withSubFields (_fSelSet fld) $ \subFld ->
|
|
case _fName subFld of
|
|
"__typename" -> retJT "__Type"
|
|
"kind" -> retJ TKENUM
|
|
"name" -> retJ $ namedTyToTxt n
|
|
"description" -> retJ $ fmap G.unDescription descM
|
|
"enumValues" -> fmap J.toJSON $ mapM (enumValueR subFld) $
|
|
sortOn _eviVal $ Map.elems (normalizeEnumValues vals)
|
|
_ -> return J.Null
|
|
|
|
-- 4.5.2.6
|
|
inputObjR
|
|
:: ( MonadReader r m, Has TypeMap r
|
|
, MonadError QErr m)
|
|
=> InpObjTyInfo
|
|
-> Field
|
|
-> m J.Object
|
|
inputObjR (InpObjTyInfo descM nt flds _) fld =
|
|
withSubFields (_fSelSet fld) $ \subFld ->
|
|
case _fName subFld of
|
|
"__typename" -> retJT "__Type"
|
|
"kind" -> retJ TKINPUT_OBJECT
|
|
"name" -> retJ $ namedTyToTxt nt
|
|
"description" -> retJ $ fmap G.unDescription descM
|
|
"inputFields" -> fmap J.toJSON $ mapM (inputValueR subFld) $
|
|
sortOn _iviName $ Map.elems flds
|
|
_ -> return J.Null
|
|
|
|
-- 4.5.2.7
|
|
listTypeR
|
|
:: ( MonadReader r m, Has TypeMap r
|
|
, MonadError QErr m)
|
|
=> G.ListType -> Field -> m J.Object
|
|
listTypeR (G.ListType ty) fld =
|
|
withSubFields (_fSelSet fld) $ \subFld ->
|
|
case _fName subFld of
|
|
"__typename" -> retJT "__Type"
|
|
"kind" -> retJ TKLIST
|
|
"ofType" -> J.toJSON <$> gtypeR ty subFld
|
|
_ -> return J.Null
|
|
|
|
-- 4.5.2.8
|
|
nonNullR
|
|
:: ( MonadReader r m, Has TypeMap r
|
|
, MonadError QErr m)
|
|
=> G.GType -> Field -> m J.Object
|
|
nonNullR gTyp fld =
|
|
withSubFields (_fSelSet fld) $ \subFld ->
|
|
case _fName subFld of
|
|
"__typename" -> retJT "__Type"
|
|
"kind" -> retJ TKNON_NULL
|
|
"ofType" -> case gTyp of
|
|
G.TypeNamed (G.Nullability False) nt -> J.toJSON <$> namedTypeR nt subFld
|
|
G.TypeList (G.Nullability False) lt -> J.toJSON <$> listTypeR lt subFld
|
|
_ -> throw500 "nullable type passed to nonNullR"
|
|
_ -> return J.Null
|
|
|
|
namedTypeR
|
|
:: ( MonadReader r m, Has TypeMap r
|
|
, MonadError QErr m)
|
|
=> G.NamedType
|
|
-> Field
|
|
-> m J.Object
|
|
namedTypeR nt fld = do
|
|
tyInfo <- getTyInfo nt
|
|
namedTypeR' fld tyInfo
|
|
|
|
namedTypeR'
|
|
:: ( MonadReader r m, Has TypeMap r
|
|
, MonadError QErr m)
|
|
=> Field
|
|
-> TypeInfo
|
|
-> m J.Object
|
|
namedTypeR' fld = \case
|
|
TIScalar colTy -> scalarR colTy fld
|
|
TIObj objTyInfo -> objectTypeR objTyInfo fld
|
|
TIEnum enumTypeInfo -> enumTypeR enumTypeInfo fld
|
|
TIInpObj inpObjTyInfo -> inputObjR inpObjTyInfo fld
|
|
TIIFace iFaceTyInfo -> ifaceR' iFaceTyInfo fld
|
|
TIUnion unionTyInfo -> unionR unionTyInfo fld
|
|
|
|
-- 4.5.3
|
|
fieldR
|
|
:: ( MonadReader r m, Has TypeMap r
|
|
, MonadError QErr m)
|
|
=> ObjFldInfo -> Field -> m J.Object
|
|
fieldR (ObjFldInfo descM n params ty _) fld =
|
|
withSubFields (_fSelSet fld) $ \subFld ->
|
|
case _fName subFld of
|
|
"__typename" -> retJT "__Field"
|
|
"name" -> retJ $ G.unName n
|
|
"description" -> retJ $ fmap G.unDescription descM
|
|
"args" -> fmap J.toJSON $ mapM (inputValueR subFld) $
|
|
sortOn _iviName $ Map.elems params
|
|
"type" -> J.toJSON <$> gtypeR ty subFld
|
|
"isDeprecated" -> retJ False
|
|
_ -> return J.Null
|
|
|
|
-- 4.5.4
|
|
inputValueR
|
|
:: ( MonadReader r m, Has TypeMap r
|
|
, MonadError QErr m)
|
|
=> Field -> InpValInfo -> m J.Object
|
|
inputValueR fld (InpValInfo descM n defM ty) =
|
|
withSubFields (_fSelSet fld) $ \subFld ->
|
|
case _fName subFld of
|
|
"__typename" -> retJT "__InputValue"
|
|
"name" -> retJ $ G.unName n
|
|
"description" -> retJ $ fmap G.unDescription descM
|
|
"type" -> J.toJSON <$> gtypeR ty subFld
|
|
-- TODO: figure out what the spec means by 'string encoding'
|
|
"defaultValue" -> retJ $ pPrintValueC <$> defM
|
|
_ -> return J.Null
|
|
|
|
-- 4.5.5
|
|
enumValueR
|
|
:: (Monad m)
|
|
=> Field -> EnumValInfo -> m J.Object
|
|
enumValueR fld (EnumValInfo descM enumVal isDeprecated) =
|
|
withSubFields (_fSelSet fld) $ \subFld ->
|
|
case _fName subFld of
|
|
"__typename" -> retJT "__EnumValue"
|
|
"name" -> retJ $ G.unName $ G.unEnumValue enumVal
|
|
"description" -> retJ $ fmap G.unDescription descM
|
|
"isDeprecated" -> retJ isDeprecated
|
|
_ -> return J.Null
|
|
|
|
-- 4.5.6
|
|
directiveR
|
|
:: ( MonadReader r m, Has TypeMap r
|
|
, MonadError QErr m)
|
|
=> Field -> DirectiveInfo -> m J.Object
|
|
directiveR fld (DirectiveInfo descM n args locs) =
|
|
withSubFields (_fSelSet fld) $ \subFld ->
|
|
case _fName subFld of
|
|
"__typename" -> retJT "__Directive"
|
|
"name" -> retJ $ G.unName n
|
|
"description" -> retJ $ fmap G.unDescription descM
|
|
"locations" -> retJ $ map showDirLoc locs
|
|
"args" -> fmap J.toJSON $ mapM (inputValueR subFld) $
|
|
sortOn _iviName $ Map.elems args
|
|
_ -> return J.Null
|
|
|
|
showDirLoc :: G.DirectiveLocation -> Text
|
|
showDirLoc = \case
|
|
G.DLExecutable edl -> T.pack $ drop 3 $ show edl
|
|
G.DLTypeSystem tsdl -> T.pack $ drop 4 $ show tsdl
|
|
|
|
gtypeR
|
|
:: ( MonadReader r m, Has TypeMap r
|
|
, MonadError QErr m)
|
|
=> G.GType -> Field -> m J.Object
|
|
gtypeR ty fld =
|
|
case ty of
|
|
G.TypeList (G.Nullability True) lt -> listTypeR lt fld
|
|
G.TypeList (G.Nullability False) _ -> nonNullR ty fld
|
|
G.TypeNamed (G.Nullability True) nt -> namedTypeR nt fld
|
|
G.TypeNamed (G.Nullability False) _ -> nonNullR ty fld
|
|
|
|
schemaR
|
|
:: ( MonadReader r m, Has TypeMap r
|
|
, MonadError QErr m)
|
|
=> Field -> m J.Object
|
|
schemaR fld =
|
|
withSubFields (_fSelSet fld) $ \subFld -> do
|
|
(tyMap :: TypeMap) <- asks getter
|
|
case _fName subFld of
|
|
"__typename" -> retJT "__Schema"
|
|
"types" -> fmap J.toJSON $ mapM (namedTypeR' subFld) $
|
|
sortOn getNamedTy $ Map.elems tyMap
|
|
"queryType" -> J.toJSON <$> namedTypeR queryRootNamedType subFld
|
|
"mutationType" -> typeR' mutationRootNamedType subFld
|
|
"subscriptionType" -> typeR' subscriptionRootNamedType subFld
|
|
"directives" -> J.toJSON <$> mapM (directiveR subFld)
|
|
(sortOn _diName defaultDirectives)
|
|
_ -> return J.Null
|
|
|
|
typeR
|
|
:: (MonadReusability m, MonadError QErr m, MonadReader r m, Has TypeMap r)
|
|
=> Field -> m J.Value
|
|
typeR fld = do
|
|
name <- asPGColText =<< getArg args "name"
|
|
typeR' (G.NamedType $ G.Name name) fld
|
|
where
|
|
args = _fArguments fld
|
|
|
|
typeR'
|
|
:: (MonadReader r m, Has TypeMap r, MonadError QErr m)
|
|
=> G.NamedType -> Field -> m J.Value
|
|
typeR' n fld = do
|
|
tyMap <- asks getter
|
|
case Map.lookup n tyMap of
|
|
Nothing -> return J.Null
|
|
Just tyInfo -> J.Object <$> namedTypeR' fld tyInfo
|