From d327d9d1ce9670e51b7eef7a4272aaf3b6290228 Mon Sep 17 00:00:00 2001
From: Eugen Wissner <belka@caraus.de>
Date: Sat, 5 Sep 2020 10:00:58 +0200
Subject: Validate fragment spread type existence

---
 src/Language/GraphQL/Validate/Rules.hs | 22 ++++++++++++++++++----
 1 file changed, 18 insertions(+), 4 deletions(-)

(limited to 'src/Language/GraphQL/Validate/Rules.hs')

diff --git a/src/Language/GraphQL/Validate/Rules.hs b/src/Language/GraphQL/Validate/Rules.hs
index ec51bbd..78d1901 100644
--- a/src/Language/GraphQL/Validate/Rules.hs
+++ b/src/Language/GraphQL/Validate/Rules.hs
@@ -89,7 +89,7 @@ singleFieldSubscriptionsRule = OperationDefinitionRule $ \case
     errorMessage =
         "Anonymous Subscription must select only one top level field."
     collectFields selectionSet = foldM forEach HashSet.empty selectionSet
-    forEach accumulator (Field alias name _ directives _)
+    forEach accumulator (Field alias name _ directives _ _)
         | any skip directives = pure accumulator
         | Just aliasedName <- alias = pure
             $ HashSet.insert aliasedName accumulator
@@ -101,7 +101,7 @@ singleFieldSubscriptionsRule = OperationDefinitionRule $ \case
             if inVisitetFragments
                then pure accumulator
                else collectFromSpread fragmentName accumulator
-    forEach accumulator (InlineFragment typeCondition' directives selectionSet)
+    forEach accumulator (InlineFragment typeCondition' directives selectionSet _)
         | any skip directives = pure accumulator
         | Just typeCondition <- typeCondition' =
             collectFromFragment typeCondition selectionSet accumulator
@@ -269,7 +269,16 @@ fragmentSpreadTypeExistenceRule = SelectionRule $ \case
         types' <- asks types
         case HashMap.lookup typeCondition types' of
             Nothing -> pure $ Error
-                { message = error' fragmentName typeCondition
+                { message = spreadError fragmentName typeCondition
+                , locations = [location]
+                , path = []
+                }
+            Just _ -> lift Nothing
+    InlineFragment (Just typeCondition) _ _ location -> do
+        types' <- asks types
+        case HashMap.lookup typeCondition types' of
+            Nothing -> pure $ Error
+                { message = inlineError typeCondition
                 , locations = [location]
                 , path = []
                 }
@@ -280,10 +289,15 @@ fragmentSpreadTypeExistenceRule = SelectionRule $ \case
         let FragmentDefinition _ typeCondition _ _ _ = fragmentDefinition
          in pure typeCondition
     extractTypeCondition _ = lift Nothing
-    error' fragmentName typeCondition = concat
+    spreadError fragmentName typeCondition = concat
         [ "Fragment \""
         , Text.unpack fragmentName
         , "\" is specified on type \""
         , Text.unpack typeCondition
         , "\" which doesn't exist in the schema."
         ]
+    inlineError typeCondition = concat
+        [ "Inline fragment is specified on type \""
+        , Text.unpack typeCondition
+        , "\" which doesn't exist in the schema."
+        ]
-- 
cgit v1.2.3