diff options
Diffstat (limited to 'src/Language/GraphQL/Validate/Rules.hs')
| -rw-r--r-- | src/Language/GraphQL/Validate/Rules.hs | 59 |
1 files changed, 37 insertions, 22 deletions
diff --git a/src/Language/GraphQL/Validate/Rules.hs b/src/Language/GraphQL/Validate/Rules.hs index 71455d3..46a14b7 100644 --- a/src/Language/GraphQL/Validate/Rules.hs +++ b/src/Language/GraphQL/Validate/Rules.hs @@ -1502,15 +1502,6 @@ variablesInAllowedPositionRule = OperationDefinitionRule $ \case hasNonNullVariableDefaultValue (Just (Full.Node Full.ConstNull _)) = False hasNonNullVariableDefaultValue Nothing = False hasNonNullVariableDefaultValue _ = True - unwrapInType (In.NonNullScalarType nonNullType) = - Just $ In.NamedScalarType nonNullType - unwrapInType (In.NonNullEnumType nonNullType) = - Just $ In.NamedEnumType nonNullType - unwrapInType (In.NonNullInputObjectType nonNullType) = - Just $ In.NamedInputObjectType nonNullType - unwrapInType (In.NonNullListType nonNullType) = - Just $ In.ListType nonNullType - unwrapInType _ = Nothing makeError variableDefinition expectedType = let Full.VariableDefinition variableName variableType _ location' = variableDefinition @@ -1527,6 +1518,17 @@ variablesInAllowedPositionRule = OperationDefinitionRule $ \case , locations = [location'] } +unwrapInType :: In.Type -> Maybe In.Type +unwrapInType (In.NonNullScalarType nonNullType) = + Just $ In.NamedScalarType nonNullType +unwrapInType (In.NonNullEnumType nonNullType) = + Just $ In.NamedEnumType nonNullType +unwrapInType (In.NonNullInputObjectType nonNullType) = + Just $ In.NamedInputObjectType nonNullType +unwrapInType (In.NonNullListType nonNullType) = + Just $ In.ListType nonNullType +unwrapInType _ = Nothing + -- | Literal values must be compatible with the type expected in the position -- they are found as per the coercion rules. -- @@ -1540,7 +1542,7 @@ valuesOfCorrectTypeRule = ValueRule go constGo go (Just inputType) value | Just constValue <- toConstNode value = lift $ check inputType constValue - go _ _ = lift mempty + go _ _ = lift mempty -- This rule checks only literals. toConstNode Full.Node{..} = flip Full.Node location <$> toConst node toConst (Full.Variable _) = Nothing toConst (Full.Int integer) = Just $ Full.ConstInt integer @@ -1550,7 +1552,7 @@ valuesOfCorrectTypeRule = ValueRule go constGo toConst Full.Null = Just Full.ConstNull toConst (Full.Enum enum) = Just $ Full.ConstEnum enum toConst (Full.List values) = - Just $ Full.ConstList $ catMaybes $ toConst <$> values + Just $ Full.ConstList $ catMaybes $ toConstNode <$> values toConst (Full.Object fields) = Just $ Full.ConstObject $ catMaybes $ constObjectField <$> fields constObjectField Full.ObjectField{..} @@ -1582,24 +1584,37 @@ valuesOfCorrectTypeRule = ValueRule go constGo , Full.ConstEnum memberValue <- node , HashMap.member memberValue members = mempty check (In.InputObjectBaseType objectType) Full.Node{ node } - | In.InputObjectType _ _ typeFields <- objectType - , Full.ConstObject valueFields <- node = - foldMap (checkObjectField typeFields) valueFields + -- Skip, objects are checked recursively by the validation traverser. + | In.InputObjectType{} <- objectType + , Full.ConstObject{} <- node = mempty check (In.ListBaseType listType) constValue@Full.Node{ .. } - | Full.ConstList listValues <- node = - foldMap (check listType) $ flip Full.Node location <$> listValues + | Full.ConstList values <- node = + foldMap (checkNull listType) values | otherwise = check listType constValue check inputType Full.Node{ .. } = pure $ Error { message = concat [ "Value " - , show node, " cannot be coerced to type \"" + , show node + , " cannot be coerced to type \"" , show inputType , "\"." ] , locations = [location] } - checkObjectField typeFields Full.ObjectField{..} - | Just typeField <- HashMap.lookup name typeFields - , In.InputField _ fieldType _ <- typeField = - check fieldType value - checkObjectField _ _ = mempty + checkNull inputType constValue = + let checkResult = check inputType constValue + in case null checkResult of + True + | Just unwrappedType <- unwrapInType inputType + , Full.Node{ node = Full.ConstNull, .. } <- constValue -> + pure $ Error + { message = concat + [ "List of non-null values of type \"" + , show unwrappedType + , "\" cannot contain null values." + ] + , locations = [location] + } + | otherwise -> mempty + _ -> checkResult + |