Validate leaf selections

CHANGELOG.md

@@ -47,6 +47,7 @@ and this project adheres to
   - `noUnusedVariablesRule`
   - `uniqueInputFieldNamesRule`
   - `fieldsOnCorrectTypeRule`
+  - `scalarLeafsRule`
 - `AST.Document.Field`.
 - `AST.Document.FragmentSpread`.
 - `AST.Document.InlineFragment`.

src/Language/GraphQL/Validate/Rules.hs

@@ -19,6 +19,7 @@ module Language.GraphQL.Validate.Rules
     , noUndefinedVariablesRule
     , noUnusedFragmentsRule
     , noUnusedVariablesRule
+    , scalarLeafsRule
     , singleFieldSubscriptionsRule
     , specifiedRules
     , uniqueArgumentNamesRule
@@ -41,7 +42,7 @@ import Data.HashMap.Strict (HashMap)
 import Data.HashSet (HashSet)
 import qualified Data.HashSet as HashSet
 import Data.List (groupBy, sortBy, sortOn)
-import Data.Maybe (isJust, mapMaybe)
+import Data.Maybe (mapMaybe)
 import Data.Ord (comparing)
 import Data.Sequence (Seq(..))
 import qualified Data.Sequence as Seq
@@ -68,6 +69,7 @@ specifiedRules =
     , uniqueOperationNamesRule
     -- Fields
     , fieldsOnCorrectTypeRule
+    , scalarLeafsRule
     -- Arguments.
     , uniqueArgumentNamesRule
     -- Fragments.
@@ -687,26 +689,79 @@ fieldsOnCorrectTypeRule = SelectionRule go
        fieldRule objectType fieldSelection
     go _ _ = lift mempty
     fieldRule objectType (Field _ fieldName _ _ _ location)
-        | isJust (lookupTypeField fieldName objectType) = lift mempty
+        | Nothing <- lookupTypeField fieldName objectType
-        | otherwise = pure $ Error
+        , Just typeName <- compositeTypeName objectType = pure $ Error
-            { message = errorMessage fieldName objectType
+            { message = errorMessage fieldName typeName
             , locations = [location]
             }
-    errorMessage fieldName objectType = concat
+        | otherwise = lift mempty
+    errorMessage fieldName typeName = concat
         [ "Cannot query field \""
         , Text.unpack fieldName
         , "\" on type \""
-        , Text.unpack $ outputTypeName objectType
+        , Text.unpack typeName
         , "\"."
         ]
-    outputTypeName (Out.ObjectBaseType (Out.ObjectType typeName _ _ _)) =
+    compositeTypeName (Out.ObjectBaseType (Out.ObjectType typeName _ _ _)) =
-        typeName
+        Just typeName
-    outputTypeName (Out.InterfaceBaseType (Out.InterfaceType typeName _ _ _)) =
+    compositeTypeName (Out.InterfaceBaseType interfaceType) =
-        typeName
+        let Out.InterfaceType typeName _ _ _ = interfaceType
-    outputTypeName (Out.UnionBaseType (Out.UnionType typeName _ _)) =
+         in Just typeName
-        typeName
+    compositeTypeName (Out.UnionBaseType (Out.UnionType typeName _ _)) =
-    outputTypeName (Out.ScalarBaseType (Definition.ScalarType typeName _)) =
+        Just typeName
-        typeName
+    compositeTypeName (Out.ScalarBaseType _) =
-    outputTypeName (Out.EnumBaseType (Definition.EnumType typeName _ _)) =
+        Nothing
-        typeName
+    compositeTypeName (Out.EnumBaseType _) =
-    outputTypeName (Out.ListBaseType wrappedType) = outputTypeName wrappedType
+        Nothing
+    compositeTypeName (Out.ListBaseType wrappedType) =
+        compositeTypeName wrappedType
+
+-- | Field selections on scalars or enums are never allowed, because they are
+-- the leaf nodes of any GraphQL query.
+scalarLeafsRule :: forall m. Rule m
+scalarLeafsRule = SelectionRule go
+  where
+    go (Just objectType) (FieldSelection fieldSelection) =
+       fieldRule objectType fieldSelection
+    go _ _ = lift mempty
+    fieldRule objectType selectionField@(Field _ fieldName _ _ _ _)
+        | Just fieldType <- lookupTypeField fieldName objectType =
+            lift $ check fieldType selectionField
+        | otherwise = lift mempty
+    check (Out.ObjectBaseType (Out.ObjectType typeName _ _ _)) =
+        checkNotEmpty typeName
+    check (Out.InterfaceBaseType (Out.InterfaceType typeName _ _ _)) =
+        checkNotEmpty typeName
+    check (Out.UnionBaseType (Out.UnionType typeName _ _)) =
+        checkNotEmpty typeName
+    check (Out.ScalarBaseType (Definition.ScalarType typeName _)) =
+        checkEmpty typeName
+    check (Out.EnumBaseType (Definition.EnumType typeName _ _)) =
+        checkEmpty typeName
+    check (Out.ListBaseType wrappedType) = check wrappedType
+    checkNotEmpty typeName (Field _ fieldName _ _ [] location) =
+        let fieldName' = Text.unpack fieldName
+         in makeError location $ concat
+            [ "Field \""
+            , fieldName'
+            , "\" of type \""
+            , Text.unpack typeName
+            , "\" must have a selection of subfields. Did you mean \""
+            , fieldName'
+            , " { ... }\"?"
+            ]
+    checkNotEmpty _ _ = mempty
+    checkEmpty _ (Field _ _ _ _ [] _) = mempty
+    checkEmpty typeName field' =
+        let Field _ fieldName _ _ _ location = field'
+         in makeError location $ concat
+            [ "Field \""
+            , Text.unpack fieldName
+            , "\" must not have a selection since type \""
+            , Text.unpack typeName
+            , "\" has no subfields."
+            ]
+    makeError location errorMessage = pure $ Error
+        { message = errorMessage
+        , locations = [location]
+        }

tests/Language/GraphQL/ValidateSpec.hs

@@ -500,7 +500,9 @@ spec =
         it "rejects duplicate fields in input objects" $
             let queryString = [r|
               {
-                findDog(complex: { name: "Fido", name: "Jack" })
+                findDog(complex: { name: "Fido", name: "Jack" }) {
+                  name
+                }
               }
             |]
                 expected = Error
@@ -509,3 +511,36 @@ spec =
                     , locations = [AST.Location 3 36, AST.Location 3 50]
                     }
              in validate queryString `shouldBe` [expected]
+
+        it "rejects undefined fields" $
+            let queryString = [r|
+              {
+                dog {
+                  meowVolume
+                }
+              }
+            |]
+                expected = Error
+                    { message =
+                        "Cannot query field \"meowVolume\" on type \"Dog\"."
+                    , locations = [AST.Location 4 19]
+                    }
+             in validate queryString `shouldBe` [expected]
+
+        it "rejects scalar fields with not empty selection set" $
+            let queryString = [r|
+              {
+                dog {
+                  barkVolume {
+                    sinceWhen
+                  }
+                }
+              }
+            |]
+                expected = Error
+                    { message =
+                        "Field \"barkVolume\" must not have a selection since \
+                        \type \"Int\" has no subfields."
+                    , locations = [AST.Location 4 19]
+                    }
+             in validate queryString `shouldBe` [expected]