From 115aa026724a688bc7ca57d622c83d0ccb2d2bb2 Mon Sep 17 00:00:00 2001
From: Eugen Wissner <belka@caraus.de>
Date: Wed, 13 Nov 2019 20:40:09 +0100
Subject: Fail on cyclic fragments, fix #22

---
 tests/Test/FragmentSpec.hs | 30 ++++++++++++++++++++++++++----
 1 file changed, 26 insertions(+), 4 deletions(-)

(limited to 'tests/Test/FragmentSpec.hs')

diff --git a/tests/Test/FragmentSpec.hs b/tests/Test/FragmentSpec.hs
index a102104..69f1344 100644
--- a/tests/Test/FragmentSpec.hs
+++ b/tests/Test/FragmentSpec.hs
@@ -10,7 +10,13 @@ import Data.List.NonEmpty (NonEmpty(..))
 import Data.Text (Text)
 import Language.GraphQL
 import qualified Language.GraphQL.Schema as Schema
-import Test.Hspec (Spec, describe, it, shouldBe, shouldNotSatisfy)
+import Test.Hspec ( Spec
+                  , describe
+                  , it
+                  , shouldBe
+                  , shouldSatisfy
+                  , shouldNotSatisfy
+                  )
 import Text.RawString.QQ (r)
 
 size :: Schema.Resolver IO
@@ -37,6 +43,10 @@ inlineQuery = [r|{
   }
 }|]
 
+hasErrors :: Value -> Bool
+hasErrors (Object object') = HashMap.member "errors" object'
+hasErrors _ = True
+
 spec :: Spec
 spec = describe "Inline fragment executor" $ do
     it "chooses the first selection if the type matches" $ do
@@ -91,9 +101,7 @@ spec = describe "Inline fragment executor" $ do
         }|]
 
         actual <- graphql (size :| []) query
-        let hasErrors (Object object') = HashMap.member "errors" object'
-            hasErrors _ = True
-         in actual `shouldNotSatisfy` hasErrors
+        actual `shouldNotSatisfy` hasErrors
 
     it "evaluates nested fragments" $ do
         let query = [r|
@@ -140,3 +148,17 @@ spec = describe "Inline fragment executor" $ do
                     ]
                 ]
          in actual `shouldBe` expected
+
+    it "rejects recursive" $ do
+        let query = [r|
+          {
+            ...circumferenceFragment
+          }
+
+          fragment circumferenceFragment on Hat {
+            ...circumferenceFragment
+          }
+        |]
+
+        actual <- graphql (circumference :| []) query
+        actual `shouldSatisfy` hasErrors
-- 
cgit v1.2.3