{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} module Data.Morpheus.Validation.Internal.Value ( validateInputValue , validateEnum ) where import Data.List (elem) -- MORPHEUS import Data.Morpheus.Error.Input (InputError (..), InputValidation, Prop (..)) import Data.Morpheus.Rendering.RenderGQL (renderWrapped) import Data.Morpheus.Types.Internal.Data (DataField (..), DataTyCon (..), DataType (..), DataTypeLib (..), DataValidator (..), Key, TypeAlias (..), WrapperD (..), isNullable) import Data.Morpheus.Types.Internal.Value (Value (..)) import Data.Morpheus.Validation.Internal.Utils (getInputType, lookupField) -- Validate Variable Argument or all Possible input Values validateInputValue :: DataTypeLib -> [Prop] -> [WrapperD] -> DataType -> (Key, Value) -> InputValidation Value validateInputValue lib prop' = validate where throwError :: [WrapperD] -> DataType -> Value -> InputValidation Value throwError wrappers datatype value = Left $ UnexpectedType prop' (renderWrapped datatype wrappers) value Nothing -- VALIDATION validate :: [WrapperD] -> DataType -> (Key, Value) -> InputValidation Value -- Validate Null. value = null ? validate wrappers tName (_, Null) | isNullable wrappers = return Null | otherwise = throwError wrappers tName Null -- Validate LIST validate (MaybeD:wrappers) type' value' = validateInputValue lib prop' wrappers type' value' validate (ListD:wrappers) type' (key', List list') = List <$> mapM validateElement list' where validateElement element' = validateInputValue lib prop' wrappers type' (key', element') {-- 2. VALIDATE TYPES, all wrappers are already Processed --} {-- VALIDATE OBJECT--} validate [] (DataInputObject DataTyCon {typeData = parentFields'}) (_, Object fields) = Object <$> mapM validateField fields where validateField (_name, value) = do (type', currentProp') <- validationData value wrappers' <- aliasWrappers . fieldType <$> getField value'' <- validateInputValue lib currentProp' wrappers' type' (_name, value) return (_name, value'') where validationData x = do fieldTypeName' <- aliasTyCon . fieldType <$> getField let currentProp = prop' ++ [Prop _name fieldTypeName'] type' <- getInputType fieldTypeName' lib (typeMismatch x fieldTypeName' currentProp) return (type', currentProp) getField = lookupField _name parentFields' (UnknownField prop' _name) -- VALIDATE INPUT UNION -- TODO: Validate Union validate [] (DataInputUnion DataTyCon {typeData}) (_, Object fields) = return (Object fields) {-- VALIDATE SCALAR --} validate [] (DataEnum DataTyCon {typeData = tags', typeName = name'}) (_, value') = validateEnum (UnexpectedType prop' name' value' Nothing) tags' value' {-- VALIDATE ENUM --} validate [] (DataScalar DataTyCon {typeName = name', typeData = DataValidator {validateValue = validator'}}) (_, value') = case validator' value' of Right _ -> return value' Left "" -> Left $ UnexpectedType prop' name' value' Nothing Left errorMessage -> Left $ UnexpectedType prop' name' value' (Just errorMessage) {-- 3. THROW ERROR: on invalid values --} validate wrappers datatype (_, value) = throwError wrappers datatype value validateEnum :: error -> [Key] -> Value -> Either error Value validateEnum error' tags' (Enum enumValue) = if enumValue `elem` tags' then pure (Enum enumValue) else Left error' validateEnum error' _ _ = Left error' typeMismatch :: Value -> Key -> [Prop] -> InputError typeMismatch jsType expected' path' = UnexpectedType path' expected' jsType Nothing