graphql/tests/Test/DirectiveSpec.hs
Eugen Wissner ae2210f659 Support subscriptions
This is experimental support.
The implementation is based on conduit and is boring. There is a new
resolver data constructor that should create a source event stream. The
executor receives the events, pipes them through the normal execution
and puts them into the response stream which is returned to the user.

- Tests are missing.
- The executor should check field value resolver on subscription types.
- The graphql function should probably return (Either
  ResponseEventStream Response), but I'm not sure about this. It will
  make the usage more complicated if no subscriptions are involved, but
  with the current API implementing subscriptions is more
  difficult than it should be.
2020-07-14 19:37:56 +02:00

92 lines
2.7 KiB
Haskell

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
module Test.DirectiveSpec
( spec
) where
import Data.Aeson (object, (.=))
import qualified Data.Aeson as Aeson
import qualified Data.HashMap.Strict as HashMap
import Language.GraphQL
import Language.GraphQL.Type
import qualified Language.GraphQL.Type.Out as Out
import Test.Hspec (Spec, describe, it, shouldBe)
import Text.RawString.QQ (r)
experimentalResolver :: Schema IO
experimentalResolver = Schema { query = queryType, mutation = Nothing }
where
queryType = Out.ObjectType "Query" Nothing []
$ HashMap.singleton "experimentalField"
$ Out.ValueResolver (Out.Field Nothing (Out.NamedScalarType int) mempty)
$ pure $ Int 5
emptyObject :: Aeson.Value
emptyObject = object
[ "data" .= object []
]
spec :: Spec
spec =
describe "Directive executor" $ do
it "should be able to @skip fields" $ do
let sourceQuery = [r|
{
experimentalField @skip(if: true)
}
|]
actual <- graphql experimentalResolver sourceQuery
actual `shouldBe` emptyObject
it "should not skip fields if @skip is false" $ do
let sourceQuery = [r|
{
experimentalField @skip(if: false)
}
|]
expected = object
[ "data" .= object
[ "experimentalField" .= (5 :: Int)
]
]
actual <- graphql experimentalResolver sourceQuery
actual `shouldBe` expected
it "should skip fields if @include is false" $ do
let sourceQuery = [r|
{
experimentalField @include(if: false)
}
|]
actual <- graphql experimentalResolver sourceQuery
actual `shouldBe` emptyObject
it "should be able to @skip a fragment spread" $ do
let sourceQuery = [r|
{
...experimentalFragment @skip(if: true)
}
fragment experimentalFragment on ExperimentalType {
experimentalField
}
|]
actual <- graphql experimentalResolver sourceQuery
actual `shouldBe` emptyObject
it "should be able to @skip an inline fragment" $ do
let sourceQuery = [r|
{
... on ExperimentalType @skip(if: true) {
experimentalField
}
}
|]
actual <- graphql experimentalResolver sourceQuery
actual `shouldBe` emptyObject