{-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE NoImplicitPrelude #-} module Data.Morpheus.Validation.Query.Validation ( validateRequest, ) where import Data.Morpheus.Ext.Result ( GQLResult, ) import Data.Morpheus.Internal.Utils (empty) import Data.Morpheus.Types.Internal.AST ( ExecutableDocument (..), Operation (..), Schema (..), TypeKind (..), VALID, mkBaseType, ) import Data.Morpheus.Types.Internal.Config (Config (..)) import Data.Morpheus.Types.Internal.Validation ( OperationContext (..), Scope (..), ScopeKind (..), runValidator, ) import Data.Morpheus.Validation.Query.Fragment ( validateFragments, ) import Data.Morpheus.Validation.Query.FragmentPreconditions ( checkFragmentPreconditions, ) import Data.Morpheus.Validation.Query.Selection ( validateFragmentSelection, validateOperation, ) import Data.Morpheus.Validation.Query.Variable ( resolveOperationVariables, ) import Relude hiding ( empty, fromList, ) validateRequest :: Config -> Schema VALID -> ExecutableDocument -> GQLResult (Operation VALID) validateRequest :: Config -> Schema VALID -> ExecutableDocument -> GQLResult (Operation VALID) validateRequest Config config Schema VALID schema ExecutableDocument { Fragments RAW $sel:fragments:ExecutableDocument :: ExecutableDocument -> Fragments RAW fragments :: Fragments RAW fragments, Variables $sel:inputVariables:ExecutableDocument :: ExecutableDocument -> Variables inputVariables :: Variables inputVariables, $sel:operation:ExecutableDocument :: ExecutableDocument -> Operation RAW operation = operation :: Operation RAW operation@Operation { Maybe FieldName operationName :: forall (s :: Stage). Operation s -> Maybe FieldName operationName :: Maybe FieldName operationName, SelectionSet RAW operationSelection :: forall (s :: Stage). Operation s -> SelectionSet s operationSelection :: SelectionSet RAW operationSelection, Position operationPosition :: forall (s :: Stage). Operation s -> Position operationPosition :: Position operationPosition } } = do VariableDefinitions VALID variables <- forall (s :: Stage) ctx a. Validator s ctx a -> Config -> Schema s -> Scope -> ctx -> GQLResult a runValidator Validator VALID (OperationContext RAW RAW) (VariableDefinitions VALID) validateHelpers Config config Schema VALID schema Scope scope ( OperationContext { Maybe FieldName operationName :: Maybe FieldName operationName :: Maybe FieldName operationName, Fragments RAW fragments :: Fragments RAW fragments :: Fragments RAW fragments, variables :: VariableDefinitions RAW variables = forall coll. Empty coll => coll empty } ) Fragments VALID validFragments <- forall (s :: Stage) ctx a. Validator s ctx a -> Config -> Schema s -> Scope -> ctx -> GQLResult a runValidator ((Fragment RAW -> FragmentValidator RAW (SelectionSet VALID)) -> FragmentValidator RAW (Fragments VALID) validateFragments forall (s :: Stage). ValidateFragmentSelection s => Fragment RAW -> FragmentValidator s (SelectionSet VALID) validateFragmentSelection) Config config Schema VALID schema Scope scope ( OperationContext { Maybe FieldName operationName :: Maybe FieldName operationName :: Maybe FieldName operationName, Fragments RAW fragments :: Fragments RAW fragments :: Fragments RAW fragments, VariableDefinitions VALID variables :: VariableDefinitions VALID variables :: VariableDefinitions VALID variables } ) forall (s :: Stage) ctx a. Validator s ctx a -> Config -> Schema s -> Scope -> ctx -> GQLResult a runValidator (Operation RAW -> SelectionValidator (Operation VALID) validateOperation Operation RAW operation) Config config Schema VALID schema Scope scope ( OperationContext { Maybe FieldName operationName :: Maybe FieldName operationName :: Maybe FieldName operationName, fragments :: Fragments VALID fragments = Fragments VALID validFragments, VariableDefinitions VALID variables :: VariableDefinitions VALID variables :: VariableDefinitions VALID variables } ) where scope :: Scope scope = Scope { kind :: ScopeKind kind = ScopeKind SELECTION, currentTypeName :: TypeName currentTypeName = TypeName "Root", currentTypeKind :: TypeKind currentTypeKind = Maybe OperationType -> TypeKind KindObject forall a. Maybe a Nothing, currentTypeWrappers :: TypeWrapper currentTypeWrappers = TypeWrapper mkBaseType, fieldName :: FieldName fieldName = FieldName "Root", position :: Maybe Position position = forall a. a -> Maybe a Just Position operationPosition, path :: [PropName] path = [] } validateHelpers :: Validator VALID (OperationContext RAW RAW) (VariableDefinitions VALID) validateHelpers = SelectionSet RAW -> BaseValidator () checkFragmentPreconditions SelectionSet RAW operationSelection forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b *> Config -> Variables -> Operation RAW -> BaseValidator (VariableDefinitions VALID) resolveOperationVariables Config config Variables inputVariables Operation RAW operation