{-# 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