server: rewrite remote input parsers to deal with partial variable expansion (fix hasura/graphql-engine#6656)

GitOrigin-RevId: e0b197a0fd1e259d43e6152b726b350c4d527a4b
This commit is contained in:
Antoine Leblanc 2021-05-24 21:12:53 +01:00 committed by hasura-bot
parent 3aff213978
commit 6e95f761f5
19 changed files with 991 additions and 564 deletions

View File

@ -10,6 +10,7 @@
### Bug fixes and improvements ### Bug fixes and improvements
- server: fix a bug where remote schema permissions would fail when used in conjunction with query variables (fix #6656)
- server: add `rename_source` metadata API (fix #6681) - server: add `rename_source` metadata API (fix #6681)
- server: fix subscriptions with session argument in user-defined function (fix #6657) - server: fix subscriptions with session argument in user-defined function (fix #6657)
- server: MSSQL: Support ORDER BY for text/ntext types. - server: MSSQL: Support ORDER BY for text/ntext types.

View File

@ -447,8 +447,6 @@ elif [ "$MODE" = "test" ]; then
# Using --metadata-database-url flag to test multiple backends # Using --metadata-database-url flag to test multiple backends
# HASURA_GRAPHQL_PG_SOURCE_URL_* For a couple multi-source pytests: # HASURA_GRAPHQL_PG_SOURCE_URL_* For a couple multi-source pytests:
HASURA_GRAPHQL_PG_SOURCE_URL_1="$PG_DB_URL" \
HASURA_GRAPHQL_PG_SOURCE_URL_2="$PG_DB_URL" \
cabal new-run --project-file=cabal.project.dev-sh -- exe:graphql-engine \ cabal new-run --project-file=cabal.project.dev-sh -- exe:graphql-engine \
--metadata-database-url="$PG_DB_URL" serve \ --metadata-database-url="$PG_DB_URL" serve \
--stringify-numeric-types \ --stringify-numeric-types \

View File

@ -634,12 +634,14 @@ test-suite graphql-engine-tests
, monad-control , monad-control
, mtl , mtl
, natural-transformation >=0.4 && <0.5 , natural-transformation >=0.4 && <0.5
, network-uri
, optparse-applicative , optparse-applicative
, pg-client , pg-client
, process , process
, QuickCheck , QuickCheck
, safe , safe
, split , split
, template-haskell
, text , text
, time , time
, transformers-base , transformers-base
@ -651,11 +653,13 @@ test-suite graphql-engine-tests
Data.Parser.CacheControlSpec Data.Parser.CacheControlSpec
Data.Parser.JSONPathSpec Data.Parser.JSONPathSpec
Data.Parser.URLTemplate Data.Parser.URLTemplate
Data.Text.RawString
Data.TimeSpec Data.TimeSpec
Hasura.CacheBoundedSpec Hasura.CacheBoundedSpec
Hasura.EventingSpec Hasura.EventingSpec
Hasura.GraphQL.Parser.DirectivesTest Hasura.GraphQL.Parser.DirectivesTest
Hasura.GraphQL.Parser.TestUtils Hasura.GraphQL.Parser.TestUtils
Hasura.GraphQL.Schema.RemoteTest
Hasura.IncrementalSpec Hasura.IncrementalSpec
Hasura.RQL.MetadataSpec Hasura.RQL.MetadataSpec
Hasura.RQL.Types.EndpointSpec Hasura.RQL.Types.EndpointSpec

View File

@ -324,7 +324,7 @@ fetchRemoteJoinFields
-> m AO.Object -> m AO.Object
fetchRemoteJoinFields env manager reqHdrs userInfo remoteJoins = do fetchRemoteJoinFields env manager reqHdrs userInfo remoteJoins = do
results <- forM (Map.toList remoteSchemaBatch) $ \(rsi, batch) -> do results <- forM (Map.toList remoteSchemaBatch) $ \(rsi, batch) -> do
resolvedRemoteFields <- traverse (traverse (resolveRemoteVariable userInfo)) $ _rjfField <$> batch resolvedRemoteFields <- runVariableCache $ traverse (traverse (resolveRemoteVariable userInfo)) $ _rjfField <$> batch
let gqlReq = fieldsToRequest resolvedRemoteFields let gqlReq = fieldsToRequest resolvedRemoteFields
-- NOTE: discard remote headers (for now): -- NOTE: discard remote headers (for now):
(_, _, respBody) <- execRemoteGQ env manager userInfo reqHdrs rsi gqlReq (_, _, respBody) <- execRemoteGQ env manager userInfo reqHdrs rsi gqlReq
@ -346,21 +346,8 @@ fetchRemoteJoinFields env manager reqHdrs userInfo remoteJoins = do
remoteSchemaBatch = Map.groupOnNE _rjfRemoteSchema remoteJoins remoteSchemaBatch = Map.groupOnNE _rjfRemoteSchema remoteJoins
fieldsToRequest :: NonEmpty (G.Field G.NoFragments Variable) -> GQLReqOutgoing fieldsToRequest :: NonEmpty (G.Field G.NoFragments Variable) -> GQLReqOutgoing
fieldsToRequest gFields@(headField :| _) = fieldsToRequest gFields =
let variableInfos = let variableInfos = foldMap collectVariablesFromField gFields
-- only the `headField` is used for collecting the variables here because
-- the variable information of all the fields will be the same.
-- For example:
-- {
-- author {
-- name
-- remote_relationship (extra_arg: $extra_arg)
-- }
-- }
--
-- If there are 10 authors, then there are 10 fields that will be requested
-- each containing exactly the same variable info.
collectVariablesFromField headField
in GQLReq in GQLReq
{ _grOperationName = Nothing { _grOperationName = Nothing
, _grVariables = , _grVariables =
@ -375,7 +362,7 @@ fetchRemoteJoinFields env manager reqHdrs userInfo remoteJoins = do
} }
} }
-- | Replace 'RemoteJoinField' in composite JSON with it's json value from remote server response. -- | Replace 'RemoteJoinField' in composite JSON with its json value from remote server response.
replaceRemoteFields replaceRemoteFields
:: MonadError QErr m :: MonadError QErr m
=> CompositeValue (Maybe RemoteJoinField) => CompositeValue (Maybe RemoteJoinField)

View File

@ -96,7 +96,7 @@ convertMutationSelectionSet env logger gqlContext SQLGenCtx{stringifyNum} userIn
\(SourceConfigWith sourceConfig (MDBR db)) -> \(SourceConfigWith sourceConfig (MDBR db)) ->
mkDBMutationPlan env manager reqHeaders userInfo stringifyNum sourceName sourceConfig db mkDBMutationPlan env manager reqHeaders userInfo stringifyNum sourceName sourceConfig db
RFRemote remoteField -> do RFRemote remoteField -> do
RemoteFieldG remoteSchemaInfo resolvedRemoteField <- resolveRemoteField userInfo remoteField RemoteFieldG remoteSchemaInfo resolvedRemoteField <- runVariableCache $ resolveRemoteField userInfo remoteField
pure $ buildExecStepRemote remoteSchemaInfo G.OperationTypeMutation $ [G.SelectionField resolvedRemoteField] pure $ buildExecStepRemote remoteSchemaInfo G.OperationTypeMutation $ [G.SelectionField resolvedRemoteField]
RFAction action -> do RFAction action -> do
(actionName, _fch) <- pure $ case action of (actionName, _fch) <- pure $ case action of

View File

@ -91,7 +91,7 @@ convertQuerySelSet env logger gqlContext userInfo manager reqHeaders directives
\(SourceConfigWith sourceConfig (QDBR db)) -> \(SourceConfigWith sourceConfig (QDBR db)) ->
mkDBQueryPlan env manager reqHeaders userInfo sourceName sourceConfig db mkDBQueryPlan env manager reqHeaders userInfo sourceName sourceConfig db
RFRemote rf -> do RFRemote rf -> do
RemoteFieldG remoteSchemaInfo remoteField <- for rf $ resolveRemoteVariable userInfo RemoteFieldG remoteSchemaInfo remoteField <- runVariableCache $ for rf $ resolveRemoteVariable userInfo
pure $ buildExecStepRemote remoteSchemaInfo G.OperationTypeQuery [G.SelectionField remoteField] pure $ buildExecStepRemote remoteSchemaInfo G.OperationTypeQuery [G.SelectionField remoteField]
RFAction a -> do RFAction a -> do
(action, actionName, fch) <- pure $ case a of (action, actionName, fch) <- pure $ case a of

View File

@ -4,6 +4,7 @@ module Hasura.GraphQL.Execute.Remote
, collectVariables , collectVariables
, resolveRemoteVariable , resolveRemoteVariable
, resolveRemoteField , resolveRemoteField
, runVariableCache
) where ) where
import Hasura.Prelude import Hasura.Prelude
@ -85,41 +86,60 @@ buildExecStepRemote remoteSchemaInfo tp selSet =
-- | resolveRemoteVariable resolves a `RemoteSchemaVariable` into a GraphQL `Variable`. A -- | resolveRemoteVariable resolves a `RemoteSchemaVariable` into a GraphQL `Variable`. A
-- `RemoteSchemaVariable` can either be a query variable i.e. variable provided in the -- `RemoteSchemaVariable` can either be a query variable i.e. variable provided in the
-- query or it can be a `SessionPresetVariable` in which case we look up the value of -- query or it can be a `SessionPresetVariable` in which case we look up the value of the
-- the session variable and coerce it into the appropriate type and then construct the -- session variable and coerce it into the appropriate type and then construct the GraphQL
-- GraphQL `Variable`. *NOTE*: The session variable preset is a hard preset i.e. if the -- `Variable`. *NOTE*: The session variable preset is a hard preset i.e. if the session
-- session variable doesn't exist, an error will be thrown. -- variable doesn't exist, an error will be thrown.
-- --
-- The name of the GraphQL variable generated will be a GraphQL-ized (replacing '-' by '_') -- The name of the GraphQL variable generated will be a GraphQL-ized (replacing '-' by
-- version of the session -- '_') version of the session variable, since session variables are not valid GraphQL
-- variable, since session variables are not valid GraphQL names. -- names.
-- --
-- For example, considering the following schema for a role: -- Additionally, we need to handle partially traversed JSON values; likewise, we create a
-- new variable out of thin air.
-- --
-- --
-- For example, considering the following schema for a role:
--
-- input UserName {
-- firstName : String! @preset(value:"Foo")
-- lastName : String!
-- }
--
-- type Query { -- type Query {
-- user(user_id: Int! @preset(value:"x-hasura-user-id")): User -- user(
-- user_id: Int! @preset(value:"x-hasura-user-id")
-- user_name: UserName!
-- ): User
-- } -- }
-- --
-- and the incoming query to the graphql-engine is: -- and the incoming query to the graphql-engine is:
-- --
-- query { -- query($foo: UserName!) {
-- user { id name } -- user(user_name: $foo) { id name }
-- } -- }
-- --
-- After resolving the session argument presets, the query that will -- with variables:
-- be sent to the remote server will be:
-- --
-- query ($x_hasura_user_id: Int!) { -- { "foo": {"lastName": "Bar"} }
-- user (user_id: $x_hasura_user_id) { id name } --
--
-- After resolving the session argument presets, the query that will be sent to the remote
-- server will be:
--
-- query ($x_hasura_user_id: Int!, $hasura_json_var_1: String!) {
-- user (user_id: $x_hasura_user_id, user_name: {firstName: "Foo", lastName: $hasura_json_var_1}) {
-- id
-- name
-- } -- }
-- }
-- --
resolveRemoteVariable resolveRemoteVariable
:: (MonadError QErr m) :: (MonadError QErr m)
=> UserInfo => UserInfo
-> RemoteSchemaVariable -> RemoteSchemaVariable
-> m Variable -> StateT (HashMap J.Value Int) m Variable
resolveRemoteVariable userInfo = \case resolveRemoteVariable userInfo = \case
SessionPresetVariable sessionVar typeName presetInfo -> do SessionPresetVariable sessionVar typeName presetInfo -> do
sessionVarVal <- onNothing (getSessionVariableValue sessionVar $ _uiSession userInfo) sessionVarVal <- onNothing (getSessionVariableValue sessionVar $ _uiSession userInfo)
@ -163,11 +183,25 @@ resolveRemoteVariable userInfo = \case
-- nullability is false, because we treat presets as hard presets -- nullability is false, because we treat presets as hard presets
let variableGType = G.TypeNamed (G.Nullability False) typeName let variableGType = G.TypeNamed (G.Nullability False) typeName
pure $ Variable (VIRequired varName) variableGType (GraphQLValue coercedValue) pure $ Variable (VIRequired varName) variableGType (GraphQLValue coercedValue)
RemoteJSONValue gtype jsonValue -> do
cache <- get
index <- Map.lookup jsonValue cache `onNothing` do
let i = Map.size cache + 1
put $ Map.insert jsonValue i cache
pure i
let varName = G.unsafeMkName $ "hasura_json_var_" <> tshow index
pure $ Variable (VIRequired varName) gtype $ JSONValue jsonValue
QueryVariable variable -> pure variable QueryVariable variable -> pure variable
resolveRemoteField resolveRemoteField
:: (MonadError QErr m) :: (MonadError QErr m)
=> UserInfo => UserInfo
-> RemoteField -> RemoteField
-> m (RemoteFieldG Variable) -> StateT (HashMap J.Value Int) m (RemoteFieldG Variable)
resolveRemoteField userInfo = traverse (resolveRemoteVariable userInfo) resolveRemoteField userInfo = traverse (resolveRemoteVariable userInfo)
runVariableCache
:: Monad m
=> StateT (HashMap J.Value Int) m a
-> m a
runVariableCache = flip evalStateT mempty

View File

@ -16,7 +16,6 @@ module Hasura.GraphQL.Parser
, json , json
, jsonb , jsonb
, identifier , identifier
, unsafeRawScalar
, enum , enum
, nullable , nullable

View File

@ -208,18 +208,6 @@ json, jsonb :: MonadParse m => Parser 'Both m A.Value
json = namedJSON $$(litName "json") Nothing json = namedJSON $$(litName "json") Nothing
jsonb = namedJSON $$(litName "jsonb") Nothing jsonb = namedJSON $$(litName "jsonb") Nothing
-- | Explicitly define any desired scalar type. This is unsafe because it does
-- not mark queries as unreusable when they should be.
unsafeRawScalar
:: MonadParse n
=> Name
-> Maybe Description
-> Parser 'Both n (InputValue Variable)
unsafeRawScalar name description = Parser
{ pType = NonNullable $ TNamed $ mkDefinition name description TIScalar
, pParser = pure
}
enum enum
:: MonadParse m :: MonadParse m
=> Name => Name

File diff suppressed because it is too large Load Diff

View File

@ -16,7 +16,6 @@ import qualified Language.GraphQL.Draft.Syntax as G
import Data.Text.Extended import Data.Text.Extended
import Hasura.GraphQL.Schema.Remote
import Hasura.RQL.Types.Backend import Hasura.RQL.Types.Backend
import Hasura.RQL.Types.Column import Hasura.RQL.Types.Column
import Hasura.RQL.Types.Common import Hasura.RQL.Types.Common

View File

@ -50,7 +50,6 @@ import Data.List.Extended (duplicates, getDifference)
import Data.Text.Extended import Data.Text.Extended
import Hasura.Base.Error import Hasura.Base.Error
import Hasura.GraphQL.Schema.Remote
import Hasura.RQL.Types hiding (GraphQLType, defaultScalars) import Hasura.RQL.Types hiding (GraphQLType, defaultScalars)
import Hasura.Server.Utils (englishList, isSessionVariable) import Hasura.Server.Utils (englishList, isSessionVariable)
import Hasura.Session import Hasura.Session

View File

@ -7,14 +7,15 @@ import qualified Data.Aeson.TH as J
import qualified Data.Environment as Env import qualified Data.Environment as Env
import qualified Data.HashSet as Set import qualified Data.HashSet as Set
import qualified Data.Text as T import qualified Data.Text as T
import Data.Text.Extended
import Data.Text.NonEmpty
import qualified Database.PG.Query as Q import qualified Database.PG.Query as Q
import qualified Language.GraphQL.Draft.Printer as G import qualified Language.GraphQL.Draft.Printer as G
import qualified Language.GraphQL.Draft.Syntax as G import qualified Language.GraphQL.Draft.Syntax as G
import qualified Network.URI.Extended as N import qualified Network.URI.Extended as N
import qualified Text.Builder as TB import qualified Text.Builder as TB
import Data.Text.Extended
import Data.Text.NonEmpty
import Hasura.Base.Error import Hasura.Base.Error
import Hasura.GraphQL.Parser.Schema (Variable) import Hasura.GraphQL.Parser.Schema (Variable)
import Hasura.Incremental (Cacheable) import Hasura.Incremental (Cacheable)
@ -22,6 +23,7 @@ import Hasura.RQL.DDL.Headers (HeaderConf (..))
import Hasura.RQL.Types.Common import Hasura.RQL.Types.Common
import Hasura.Session import Hasura.Session
type UrlFromEnv = Text type UrlFromEnv = Text
-- | Remote schema identifier. -- | Remote schema identifier.
@ -176,6 +178,7 @@ instance Cacheable SessionArgumentPresetInfo
data RemoteSchemaVariable data RemoteSchemaVariable
= SessionPresetVariable !SessionVariable !G.Name !SessionArgumentPresetInfo = SessionPresetVariable !SessionVariable !G.Name !SessionArgumentPresetInfo
| QueryVariable !Variable | QueryVariable !Variable
| RemoteJSONValue !G.GType !J.Value
deriving (Show, Eq, Generic, Ord) deriving (Show, Eq, Generic, Ord)
instance Hashable RemoteSchemaVariable instance Hashable RemoteSchemaVariable
instance Cacheable RemoteSchemaVariable instance Cacheable RemoteSchemaVariable
@ -207,3 +210,67 @@ instance J.ToJSON RemoteSchemaPermsCtx where
toJSON = \case toJSON = \case
RemoteSchemaPermsEnabled -> J.Bool True RemoteSchemaPermsEnabled -> J.Bool True
RemoteSchemaPermsDisabled -> J.Bool False RemoteSchemaPermsDisabled -> J.Bool False
lookupType
:: RemoteSchemaIntrospection
-> G.Name
-> Maybe (G.TypeDefinition [G.Name] RemoteSchemaInputValueDefinition)
lookupType (RemoteSchemaIntrospection types) name = find (\tp -> getNamedTyp tp == name) types
where
getNamedTyp :: G.TypeDefinition possibleTypes RemoteSchemaInputValueDefinition -> G.Name
getNamedTyp ty = case ty of
G.TypeDefinitionScalar t -> G._stdName t
G.TypeDefinitionObject t -> G._otdName t
G.TypeDefinitionInterface t -> G._itdName t
G.TypeDefinitionUnion t -> G._utdName t
G.TypeDefinitionEnum t -> G._etdName t
G.TypeDefinitionInputObject t -> G._iotdName t
lookupObject
:: RemoteSchemaIntrospection
-> G.Name
-> Maybe (G.ObjectTypeDefinition RemoteSchemaInputValueDefinition)
lookupObject (RemoteSchemaIntrospection types) name = choice $ types <&> \case
G.TypeDefinitionObject t | G._otdName t == name -> Just t
_ -> Nothing
lookupInterface
:: RemoteSchemaIntrospection
-> G.Name
-> Maybe (G.InterfaceTypeDefinition [G.Name] RemoteSchemaInputValueDefinition)
lookupInterface (RemoteSchemaIntrospection types) name = choice $ types <&> \case
G.TypeDefinitionInterface t | G._itdName t == name -> Just t
_ -> Nothing
lookupScalar
:: RemoteSchemaIntrospection
-> G.Name
-> Maybe G.ScalarTypeDefinition
lookupScalar (RemoteSchemaIntrospection types) name = choice $ types <&> \case
G.TypeDefinitionScalar t | G._stdName t == name -> Just t
_ -> Nothing
lookupUnion
:: RemoteSchemaIntrospection
-> G.Name
-> Maybe G.UnionTypeDefinition
lookupUnion (RemoteSchemaIntrospection types) name = choice $ types <&> \case
G.TypeDefinitionUnion t | G._utdName t == name -> Just t
_ -> Nothing
lookupEnum
:: RemoteSchemaIntrospection
-> G.Name
-> Maybe G.EnumTypeDefinition
lookupEnum (RemoteSchemaIntrospection types) name = choice $ types <&> \case
G.TypeDefinitionEnum t | G._etdName t == name -> Just t
_ -> Nothing
lookupInputObject
:: RemoteSchemaIntrospection
-> G.Name
-> Maybe (G.InputObjectTypeDefinition RemoteSchemaInputValueDefinition)
lookupInputObject (RemoteSchemaIntrospection types) name = choice $ types <&> \case
G.TypeDefinitionInputObject t | G._iotdName t == name -> Just t
_ -> Nothing

View File

@ -0,0 +1,17 @@
module Data.Text.RawString (raw) where
import Hasura.Prelude
import Language.Haskell.TH
import Language.Haskell.TH.Quote
raw :: QuasiQuoter
raw = QuasiQuoter
{ quoteExp = pure . LitE . StringL
, quotePat = const $ failWith "pattern"
, quoteType = const $ failWith "type"
, quoteDec = const $ failWith "declaration"
}
where
failWith t = fail $ "illegal raw string quote location; expected expresion, got " <> t

View File

@ -0,0 +1,295 @@
module Hasura.GraphQL.Schema.RemoteTest (spec) where
import Hasura.Prelude
import qualified Data.Aeson as J
import qualified Data.ByteString.Lazy as LBS
import qualified Data.HashMap.Strict as M
import qualified Data.Text as T
import qualified Language.GraphQL.Draft.Parser as G
import qualified Language.GraphQL.Draft.Syntax as G
import qualified Network.URI as N
import Data.Text.Extended
import Data.Text.RawString
import Test.Hspec
import qualified Hasura.GraphQL.Parser.Internal.Parser as P
import Hasura.Base.Error
import Hasura.GraphQL.Context
import Hasura.GraphQL.Execute.Inline
import Hasura.GraphQL.Execute.Resolve
import Hasura.GraphQL.Parser.Monad
import Hasura.GraphQL.Parser.Schema
import Hasura.GraphQL.Parser.TestUtils
import Hasura.GraphQL.Schema.Remote
import Hasura.RQL.Types.RemoteSchema
import Hasura.RQL.Types.SchemaCache
import Hasura.Session
-- test tools
runError :: Monad m => ExceptT QErr m a -> m a
runError = runExceptT >=> (`onLeft` (error . T.unpack . qeError))
mkTestRemoteSchema :: Text -> RemoteSchemaIntrospection
mkTestRemoteSchema schema = RemoteSchemaIntrospection $ runIdentity $ runError $ do
G.SchemaDocument types <- G.parseSchemaDocument schema `onLeft` throw500
pure $ flip mapMaybe types \case
G.TypeSystemDefinitionSchema _ -> Nothing
G.TypeSystemDefinitionType td -> Just $ case fmap toRemoteInputValue td of
G.TypeDefinitionScalar std -> G.TypeDefinitionScalar std
G.TypeDefinitionObject otd -> G.TypeDefinitionObject otd
G.TypeDefinitionUnion utd -> G.TypeDefinitionUnion utd
G.TypeDefinitionEnum etd -> G.TypeDefinitionEnum etd
G.TypeDefinitionInputObject itd -> G.TypeDefinitionInputObject itd
G.TypeDefinitionInterface itd -> G.TypeDefinitionInterface $ G.InterfaceTypeDefinition
{ G._itdDescription = G._itdDescription itd
, G._itdName = G._itdName itd
, G._itdDirectives = G._itdDirectives itd
, G._itdFieldsDefinition = G._itdFieldsDefinition itd
, G._itdPossibleTypes = []
}
where
toRemoteInputValue ivd = RemoteSchemaInputValueDefinition
{ _rsitdDefinition = ivd
, _rsitdPresetArgument = choice $ G._ivdDirectives ivd <&> \dir -> do
guard $ G._dName dir == $$(G.litName "preset")
value <- M.lookup $$(G.litName "value") $ G._dArguments dir
Just $ case value of
G.VString "x-hasura-test" -> G.VVariable $
SessionPresetVariable (mkSessionVariable "x-hasura-test") $$(G.litName "String") SessionArgumentPresetScalar
_ -> absurd <$> value
}
mkTestExecutableDocument :: Text -> ([G.VariableDefinition], G.SelectionSet G.NoFragments G.Name)
mkTestExecutableDocument t = runIdentity $ runError $ do
G.ExecutableDocument execDoc <- G.parseExecutableDoc t `onLeft` throw500
case execDoc of
[G.ExecutableDefinitionOperation op] -> case op of
G.OperationDefinitionUnTyped selSet -> ([],) <$> inlineSelectionSet [] selSet
G.OperationDefinitionTyped opDef -> do
unless (G._todType opDef == G.OperationTypeQuery) $
throw500 "only queries for now"
resSelSet <- inlineSelectionSet [] $ G._todSelectionSet opDef
pure (G._todVariableDefinitions opDef, resSelSet)
_ -> throw500 "must have only one query in the document"
mkTestVariableValues :: LBS.ByteString -> M.HashMap G.Name J.Value
mkTestVariableValues vars = runIdentity $ runError $ do
value <- J.eitherDecode vars `onLeft` (throw500 . T.pack)
case value of
J.Object vs -> M.fromList <$> for (M.toList vs) \(name, val) -> do
gname <- G.mkName name `onNothing` throw500 ("wrong Name: " <>> name)
pure (gname, val)
_ -> throw500 "variables must be an object"
buildQueryParsers
:: RemoteSchemaIntrospection
-> IO (P.FieldParser TestMonad (G.Field G.NoFragments RemoteSchemaVariable))
buildQueryParsers introspection = do
let introResult = IntrospectionResult introspection $$(G.litName "Query") Nothing Nothing
(query, _, _) <- runError
$ runSchemaT
$ buildRemoteParser introResult
$ RemoteSchemaInfo
N.nullURI [] False 60
pure $ head query <&> \(RemoteFieldG _ f) -> f
runQueryParser
:: P.FieldParser TestMonad a
-> ([G.VariableDefinition], G.SelectionSet G.NoFragments G.Name)
-> M.HashMap G.Name J.Value
-> a
runQueryParser parser (varDefs, selSet) vars = runIdentity $ runError $ do
(_, resolvedSelSet) <- resolveVariables varDefs vars [] selSet
field <- case resolvedSelSet of
[G.SelectionField f] -> pure f
_ -> error "expecting only one field in the query"
runTest (P.fParser parser field) `onLeft` throw500
run
:: Text -- schema
-> Text -- query
-> LBS.ByteString -- variables
-> IO (G.Field G.NoFragments RemoteSchemaVariable)
run s q v = do
parser <- buildQueryParsers $ mkTestRemoteSchema s
pure $ runQueryParser
parser
(mkTestExecutableDocument q)
(mkTestVariableValues v)
-- actual test
spec :: Spec
spec = do
testNoVarExpansionIfNoPreset
testNoVarExpansionIfNoPresetUnlessTopLevelOptionalField
testPartialVarExpansionIfPreset
testNoVarExpansionIfNoPreset :: Spec
testNoVarExpansionIfNoPreset = it "variables aren't expanded if there's no preset" $ do
field <- run
-- schema
[raw|
scalar Int
input A {
b: B
}
input B {
c: C
}
input C {
i: Int
}
type Query {
test(a: A!): Int
}
|]
-- query
[raw|
query($a: A!) {
test(a: $a)
}
|]
-- variables
[raw|
{
"a": {
"b": {
"c": {
"i": 0
}
}
}
}
|]
let arg = head $ M.toList $ G._fArguments field
arg `shouldBe`
( $$(G.litName "a")
-- the parser did not create a new JSON variable, and forwarded the query variable unmodified
, G.VVariable $ QueryVariable $ Variable
(VIRequired $$(G.litName "a"))
(G.TypeNamed (G.Nullability False) $$(G.litName "A"))
(JSONValue $ J.Object $ M.fromList [("b", J.Object $ M.fromList [("c", J.Object $ M.fromList [("i", J.Number 0)])])])
)
testNoVarExpansionIfNoPresetUnlessTopLevelOptionalField :: Spec
testNoVarExpansionIfNoPresetUnlessTopLevelOptionalField = it "unless fieldOptional peels the variable first" $ do
field <- run
-- schema
[raw|
scalar Int
input A {
b: B
}
input B {
c: C
}
input C {
i: Int
}
type Query {
test(a: A): Int
}
|]
-- query
[raw|
query($a: A) {
test(a: $a)
}
|]
-- variables
[raw|
{
"a": {
"b": {
"c": {
"i": 0
}
}
}
}
|]
let arg = head $ M.toList $ G._fArguments field
arg `shouldBe`
( $$(G.litName "a")
-- fieldOptional has peeled the variable; all we see is a JSON blob, and in doubt
-- we repackage it as a newly minted JSON variable
, G.VVariable $ RemoteJSONValue
(G.TypeNamed (G.Nullability True) $$(G.litName "A"))
(J.Object $ M.fromList [("b", J.Object $ M.fromList [("c", J.Object $ M.fromList [("i", J.Number 0)])])])
)
testPartialVarExpansionIfPreset :: Spec
testPartialVarExpansionIfPreset = it "presets cause partial var expansion" $ do
field <- run
-- schema
[raw|
scalar Int
input A {
x: Int @preset(value: 0)
b: B
}
input B {
c: C
}
input C {
i: Int
}
type Query {
test(a: A!): Int
}
|]
-- query
[raw|
query($a: A!) {
test(a: $a)
}
|]
-- variables
[raw|
{
"a": {
"b": {
"c": {
"i": 0
}
}
}
}
|]
let arg = head $ M.toList $ G._fArguments field
arg `shouldBe`
( $$(G.litName "a")
-- the preset has caused partial variable expansion, only up to where it's needed
, G.VObject $ M.fromList
[ ( $$(G.litName "x")
, G.VInt 0
)
, ( $$(G.litName "b")
, G.VVariable $ RemoteJSONValue
(G.TypeNamed (G.Nullability True) $$(G.litName "B"))
(J.Object $ M.fromList [("c", J.Object $ M.fromList [("i", J.Number 0)])])
)
]
)

View File

@ -5,6 +5,11 @@ import Hasura.Prelude
import qualified Data.Aeson as A import qualified Data.Aeson as A
import qualified Data.ByteString.Lazy.Char8 as BL import qualified Data.ByteString.Lazy.Char8 as BL
import qualified Data.Environment as Env import qualified Data.Environment as Env
import qualified Data.NonNegativeIntSpec as NonNegetiveIntSpec
import qualified Data.Parser.CacheControlSpec as CacheControlParser
import qualified Data.Parser.JSONPathSpec as JsonPath
import qualified Data.Parser.URLTemplate as URLTemplate
import qualified Data.TimeSpec as TimeSpec
import qualified Database.PG.Query as Q import qualified Database.PG.Query as Q
import qualified Network.HTTP.Client as HTTP import qualified Network.HTTP.Client as HTTP
import qualified Network.HTTP.Client.TLS as HTTP import qualified Network.HTTP.Client.TLS as HTTP
@ -19,14 +24,10 @@ import System.Environment (getEnvironment)
import System.Exit (exitFailure) import System.Exit (exitFailure)
import Test.Hspec import Test.Hspec
import qualified Data.NonNegativeIntSpec as NonNegetiveIntSpec
import qualified Data.Parser.CacheControlSpec as CacheControlParser
import qualified Data.Parser.JSONPathSpec as JsonPath
import qualified Data.Parser.URLTemplate as URLTemplate
import qualified Data.TimeSpec as TimeSpec
import qualified Hasura.CacheBoundedSpec as CacheBoundedSpec import qualified Hasura.CacheBoundedSpec as CacheBoundedSpec
import qualified Hasura.EventingSpec as EventingSpec import qualified Hasura.EventingSpec as EventingSpec
import qualified Hasura.GraphQL.Parser.DirectivesTest as GraphQLDirectivesSpec import qualified Hasura.GraphQL.Parser.DirectivesTest as GraphQLDirectivesSpec
import qualified Hasura.GraphQL.Schema.RemoteTest as GraphRemoteSchemaSpec
import qualified Hasura.IncrementalSpec as IncrementalSpec import qualified Hasura.IncrementalSpec as IncrementalSpec
import qualified Hasura.RQL.Types.EndpointSpec as EndpointSpec import qualified Hasura.RQL.Types.EndpointSpec as EndpointSpec
import qualified Hasura.SQL.WKTSpec as WKTSpec import qualified Hasura.SQL.WKTSpec as WKTSpec
@ -75,6 +76,7 @@ unitSpecs = do
describe "Hasura.Cache.Bounded" CacheBoundedSpec.spec describe "Hasura.Cache.Bounded" CacheBoundedSpec.spec
describe "Hasura.Eventing" EventingSpec.spec describe "Hasura.Eventing" EventingSpec.spec
describe "Hasura.GraphQL.Parser.Directives" GraphQLDirectivesSpec.spec describe "Hasura.GraphQL.Parser.Directives" GraphQLDirectivesSpec.spec
describe "Hasura.GraphQL.Schema.Remote" GraphRemoteSchemaSpec.spec
describe "Hasura.Incremental" IncrementalSpec.spec describe "Hasura.Incremental" IncrementalSpec.spec
describe "Hasura.RQL.Types.Endpoint" EndpointSpec.spec describe "Hasura.RQL.Types.Endpoint" EndpointSpec.spec
describe "Hasura.SQL.WKT" WKTSpec.spec describe "Hasura.SQL.WKT" WKTSpec.spec

View File

@ -37,6 +37,11 @@ args:
eq : String eq : String
} }
input IncludeInpObj {
id: [Int] @preset(value: [1,2,3])
name: [String]
}
type Photo { type Photo {
height : Int height : Int
width : Int width : Int
@ -49,7 +54,7 @@ args:
type Query { type Query {
hello: String hello: String
messages(where: MessageWhereInpObj @preset(value: {id: {eq: 1}})): [Message] messages(where: MessageWhereInpObj @preset(value: {id: {eq: 1}}), includes: IncludeInpObj): [Message]
user(user_id: Int! @preset(value: 2)): User user(user_id: Int! @preset(value: 2)): User
users(user_ids: [Int]!): [User] users(user_ids: [Int]!): [User]
message(id: Int!) : Message message(id: Int!) : Message

View File

@ -118,3 +118,23 @@
__type: __type:
profilePicture: profilePicture:
width: 101 width: 101
- description: "query in which a preset field is within a variable"
url: /v1/graphql
status: 200
headers:
X-Hasura-Role: user
query:
query: |
query($i: IncludeInpObj) {
messages(includes: $i) {
id
}
}
variables:
i:
name: ["alice"]
response:
data:
messages:
- id: 1

View File

@ -16,7 +16,7 @@
code: validation-failed code: validation-failed
message: '"user" has no argument named "foo"' message: '"user" has no argument named "foo"'
- description: query the remote with a non-existing input argument 'foo' - description: query the remote with a string literal for an int
url: /v1/graphql url: /v1/graphql
status: 200 status: 200
query: query:
@ -28,11 +28,12 @@
} }
} }
response: response:
data:
errors: errors:
- extensions: - message: "Argument \"id\" has invalid value \"1\".\nExpected type \"Int\", found \"1\"."
path: $.selectionSet.user.args.id locations:
code: validation-failed - line: 1
message: "expected a 32-bit integer for type \"Int\", but found a string" column: 19
- description: query the remote with a non-existing input object field 'foo' - description: query the remote with a non-existing input object field 'foo'
url: /v1/graphql url: /v1/graphql