module Data.Morpheus.PreProcess.Validate.Arguments ( validateArguments ) where import Data.Morpheus.Error.Arguments (argumentGotInvalidValue, argumentNameCollision, undefinedArgument, unknownArguments) import Data.Morpheus.Error.Input (InputValidation, inputErrorMessage) import Data.Morpheus.Error.Internal (internalUnknownTypeMessage) import Data.Morpheus.PreProcess.Input.Object (validateInput) import Data.Morpheus.PreProcess.Utils (checkForUnknownKeys, checkNameCollision, getInputType) import Data.Morpheus.Schema.Internal.Types (Field (..), InputField (..), ObjectField (..), TypeLib) import Data.Morpheus.Types.Core (EnhancedKey (..)) import Data.Morpheus.Types.Error (Validation) import Data.Morpheus.Types.JSType (JSType (JSNull)) import Data.Morpheus.Types.MetaInfo (Position) import Data.Morpheus.Types.Query.Selection (Argument (..), Arguments) import Data.Text (Text) handleInputError :: Text -> Int -> InputValidation a -> Validation () handleInputError key' position' (Left error') = Left $ argumentGotInvalidValue key' (inputErrorMessage error') position' handleInputError _ _ _ = pure () validateArgumentValue :: TypeLib -> Text -> (Text, Argument) -> Validation (Text, Argument) validateArgumentValue lib' typeID' (key', Argument value' position') = getInputType typeID' lib' (internalUnknownTypeMessage typeID') >>= checkType >> pure (key', Argument value' position') where checkType type' = handleInputError key' position' (validateInput lib' type' (key', value')) validateArgument :: TypeLib -> Position -> Arguments -> (Text, InputField) -> Validation (Text, Argument) validateArgument types position' requestArgs (key', InputField arg) = case lookup key' requestArgs of Nothing -> if notNull arg then Left $ undefinedArgument (EnhancedKey key' position') else pure (key', Argument JSNull position') Just (Argument value pos) -> validateArgumentValue types (fieldType arg) (key', Argument value pos) checkForUnknownArguments :: (Text, ObjectField) -> Arguments -> Validation [(Text, InputField)] checkForUnknownArguments (fieldKey', ObjectField fieldArgs _) args' = checkForUnknownKeys enhancedKeys' fieldKeys error' >> checkNameCollision enhancedKeys' fieldKeys argumentNameCollision >> pure fieldArgs where error' = unknownArguments fieldKey' enhancedKeys' = map argToKey args' argToKey (key', Argument _ pos) = EnhancedKey key' pos fieldKeys = map fst fieldArgs validateArguments :: TypeLib -> (Text, ObjectField) -> Position -> Arguments -> Validation Arguments validateArguments typeLib inputs pos args' = checkForUnknownArguments inputs args' >>= mapM (validateArgument typeLib pos args')