{-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE NoImplicitPrelude #-} module Data.Morpheus.Validation.Query.Validation ( validateRequest, ) where import Data.HashMap.Lazy (fromList) import Data.Morpheus.Internal.Utils (empty) import Data.Morpheus.Types.Internal.AST ( GQLQuery (..), Operation (..), Schema (..), TypeKind (..), VALID, ) import Data.Morpheus.Types.Internal.Config (Config (..)) import Data.Morpheus.Types.Internal.Resolving ( Eventless, ) import Data.Morpheus.Types.Internal.Validation ( CurrentSelection (..), OperationContext (..), Scope (..), ScopeKind (..), runValidator, ) import Data.Morpheus.Validation.Query.Fragment ( validateFragments, ) import Data.Morpheus.Validation.Query.FragmentPreconditions ( checkFragmentPreconditions, ) import Data.Morpheus.Validation.Query.Selection ( vaidateFragmentSelection, validateOperation, ) import Data.Morpheus.Validation.Query.Variable ( resolveOperationVariables, ) import Relude hiding ( empty, fromList, ) validateRequest :: Config -> Schema VALID -> GQLQuery -> Eventless (Operation VALID) validateRequest :: Config -> Schema VALID -> GQLQuery -> Eventless (Operation VALID) validateRequest Config config Schema VALID schema GQLQuery { Fragments RAW $sel:fragments:GQLQuery :: GQLQuery -> Fragments RAW fragments :: Fragments RAW fragments, [(FieldName, ResolvedValue)] $sel:inputVariables:GQLQuery :: GQLQuery -> [(FieldName, ResolvedValue)] inputVariables :: [(FieldName, ResolvedValue)] inputVariables, $sel:operation:GQLQuery :: GQLQuery -> 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 <- Validator VALID (OperationContext RAW RAW) (VariableDefinitions VALID) -> Config -> Schema VALID -> Scope -> OperationContext RAW RAW -> Eventless (VariableDefinitions VALID) forall (s :: Stage) ctx a. Validator s ctx a -> Config -> Schema s -> Scope -> ctx -> Eventless a runValidator Validator VALID (OperationContext RAW RAW) (VariableDefinitions VALID) validateHelpers Config config Schema VALID schema Scope scope ( OperationContext :: forall (s1 :: Stage) (s2 :: Stage). Fragments s2 -> VariableDefinitions s1 -> CurrentSelection -> OperationContext s1 s2 OperationContext { CurrentSelection selection :: CurrentSelection selection :: CurrentSelection selection, Fragments RAW fragments :: Fragments RAW fragments :: Fragments RAW fragments, variables :: VariableDefinitions RAW variables = VariableDefinitions RAW forall a coll. Collection a coll => coll empty } ) Fragments VALID validFragments <- Validator VALID (OperationContext VALID RAW) (Fragments VALID) -> Config -> Schema VALID -> Scope -> OperationContext VALID RAW -> Eventless (Fragments VALID) forall (s :: Stage) ctx a. Validator s ctx a -> Config -> Schema s -> Scope -> ctx -> Eventless a runValidator ((Fragment RAW -> FragmentValidator RAW (SelectionSet VALID)) -> Validator VALID (OperationContext VALID RAW) (Fragments VALID) validateFragments Fragment RAW -> FragmentValidator RAW (SelectionSet VALID) forall (s :: Stage). ResolveFragment s => Fragment RAW -> FragmentValidator s (SelectionSet VALID) vaidateFragmentSelection) Config config Schema VALID schema Scope scope ( OperationContext :: forall (s1 :: Stage) (s2 :: Stage). Fragments s2 -> VariableDefinitions s1 -> CurrentSelection -> OperationContext s1 s2 OperationContext { CurrentSelection selection :: CurrentSelection selection :: CurrentSelection selection, Fragments RAW fragments :: Fragments RAW fragments :: Fragments RAW fragments, VariableDefinitions VALID variables :: VariableDefinitions VALID variables :: VariableDefinitions VALID variables } ) Validator VALID (OperationContext VALID VALID) (Operation VALID) -> Config -> Schema VALID -> Scope -> OperationContext VALID VALID -> Eventless (Operation VALID) forall (s :: Stage) ctx a. Validator s ctx a -> Config -> Schema s -> Scope -> ctx -> Eventless a runValidator (Operation RAW -> Validator VALID (OperationContext VALID VALID) (Operation VALID) validateOperation Operation RAW operation) Config config Schema VALID schema Scope scope ( OperationContext :: forall (s1 :: Stage) (s2 :: Stage). Fragments s2 -> VariableDefinitions s1 -> CurrentSelection -> OperationContext s1 s2 OperationContext { CurrentSelection selection :: CurrentSelection selection :: CurrentSelection selection, fragments :: Fragments VALID fragments = Fragments VALID validFragments, VariableDefinitions VALID variables :: VariableDefinitions VALID variables :: VariableDefinitions VALID variables } ) where scope :: Scope scope = Scope :: Maybe Position -> TypeName -> TypeKind -> [TypeWrapper] -> FieldName -> ScopeKind -> Scope Scope { kind :: ScopeKind kind = ScopeKind SELECTION, currentTypeName :: TypeName currentTypeName = TypeName "Root", currentTypeKind :: TypeKind currentTypeKind = Maybe OperationType -> TypeKind KindObject Maybe OperationType forall a. Maybe a Nothing, currentTypeWrappers :: [TypeWrapper] currentTypeWrappers = [], fieldname :: FieldName fieldname = FieldName "Root", position :: Maybe Position position = Position -> Maybe Position forall a. a -> Maybe a Just Position operationPosition } selection :: CurrentSelection selection = CurrentSelection :: Maybe FieldName -> CurrentSelection CurrentSelection {Maybe FieldName operationName :: Maybe FieldName operationName :: Maybe FieldName operationName} validateHelpers :: Validator VALID (OperationContext RAW RAW) (VariableDefinitions VALID) validateHelpers = SelectionSet RAW -> BaseValidator () checkFragmentPreconditions SelectionSet RAW operationSelection BaseValidator () -> Validator VALID (OperationContext RAW RAW) (VariableDefinitions VALID) -> Validator VALID (OperationContext RAW RAW) (VariableDefinitions VALID) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b *> Config -> Variables -> Operation RAW -> Validator VALID (OperationContext RAW RAW) (VariableDefinitions VALID) resolveOperationVariables Config config ([(FieldName, ResolvedValue)] -> Variables forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v fromList [(FieldName, ResolvedValue)] inputVariables) Operation RAW operation