morpheus-graphql-app 0.27.3 → 0.28.0

raw patch · 16 files changed

+146/−38 lines, 16 filesdep +attoparsec-aesondep ~bytestringdep ~containersdep ~morpheus-graphql-appPVP ok

version bump matches the API change (PVP)

Dependencies added: attoparsec-aeson

Dependency ranges changed: bytestring, containers, morpheus-graphql-app, morpheus-graphql-core, morpheus-graphql-tests, tasty

API changes (from Hackage documentation)

Files

• morpheus-graphql-app.cabal +22/−11
• src/Data/Morpheus/App.hs +15/−8
• src/Data/Morpheus/App/Internal/Resolving/MonadResolver.hs +1/−0
• src/Data/Morpheus/App/Internal/Resolving/RootResolverValue.hs +15/−11
• src/Data/Morpheus/App/Internal/Resolving/SchemaAPI.hs +2/−1
• src/Data/Morpheus/App/MapAPI.hs +8/−6
• test/DisableIntrospection.hs +42/−0
• test/Spec.hs +4/−1
• test/disable-introspection/name/query.gql +3/−0
• test/disable-introspection/name/response.json +3/−0
• test/disable-introspection/resolvers.json +5/−0
• test/disable-introspection/schema.gql +3/−0
• test/disable-introspection/schema/query.gql +12/−0
• test/disable-introspection/schema/response.json +3/−0
• test/disable-introspection/type/query.gql +5/−0
• test/disable-introspection/type/response.json +3/−0

@@ -1,11 +1,11 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.35.0.+-- This file has been generated from package.yaml by hpack version 0.36.0. -- -- see: https://github.com/sol/hpack  name:           morpheus-graphql-app-version:        0.27.3+version:        0.28.0 synopsis:       Morpheus GraphQL App description:    Build GraphQL APIs with your favourite functional language! category:       web, graphql@@ -46,6 +46,10 @@     test/batching/objects-fields/query.gql     test/batching/objects-lists-fields/query.gql     test/batching/schema.gql+    test/disable-introspection/name/query.gql+    test/disable-introspection/schema.gql+    test/disable-introspection/schema/query.gql+    test/disable-introspection/type/query.gql     test/execution/many/query.gql     test/execution/schema.gql     test/execution/single/query.gql@@ -99,6 +103,10 @@     test/batching/objects-fields/response.json     test/batching/objects-lists-fields/batching.json     test/batching/objects-lists-fields/response.json+    test/disable-introspection/name/response.json+    test/disable-introspection/resolvers.json+    test/disable-introspection/schema/response.json+    test/disable-introspection/type/response.json     test/execution/many/response.json     test/execution/single/response.json     test/merge/schema/query-subscription-mutation/app-1.json@@ -153,12 +161,13 @@   ghc-options: -Wall   build-depends:       aeson >=1.4.4 && <3.0.0+    , attoparsec-aeson >=2.1.0.0 && <3.0.0     , base >=4.7.0 && <5.0.0-    , bytestring >=0.10.4 && <0.12.0-    , containers >=0.4.2.1 && <0.7.0+    , bytestring >=0.10.4 && <0.15.0+    , containers >=0.4.2.1 && <=0.7     , hashable >=1.0.0 && <2.0.0     , megaparsec >=7.0.0 && <10.0.0-    , morpheus-graphql-core >=0.27.0 && <0.28.0+    , morpheus-graphql-core >=0.28.0 && <0.29.0     , mtl >=2.0.0 && <3.0.0     , relude >=0.3.0 && <2.0.0     , scientific >=0.3.6.2 && <0.4.0@@ -176,6 +185,7 @@   other-modules:       APIConstraints       Batching+      DisableIntrospection       Execution       NamedResolvers       Paths_morpheus_graphql_app@@ -184,19 +194,20 @@   ghc-options: -Wall   build-depends:       aeson >=1.4.4 && <3.0.0+    , attoparsec-aeson >=2.1.0.0 && <3.0.0     , base >=4.7.0 && <5.0.0-    , bytestring >=0.10.4 && <0.12.0-    , containers >=0.4.2.1 && <0.7.0+    , bytestring >=0.10.4 && <0.15.0+    , containers >=0.4.2.1 && <=0.7     , directory >=1.0.0 && <2.0.0     , hashable >=1.0.0 && <2.0.0     , megaparsec >=7.0.0 && <10.0.0-    , morpheus-graphql-app-    , morpheus-graphql-core >=0.27.0 && <0.28.0-    , morpheus-graphql-tests >=0.27.0 && <0.28.0+    , morpheus-graphql-app >=0.28.0 && <0.29.0+    , morpheus-graphql-core >=0.28.0 && <0.29.0+    , morpheus-graphql-tests >=0.28.0 && <0.29.0     , mtl >=2.0.0 && <3.0.0     , relude >=0.3.0 && <2.0.0     , scientific >=0.3.6.2 && <0.4.0-    , tasty >=0.1.0 && <1.5.0+    , tasty >=0.1.0 && <=1.5     , tasty-hunit >=0.1.0 && <1.0.0     , template-haskell >=2.0.0 && <3.0.0     , text >=1.2.3 && <3.0.0

@@ -15,6 +15,7 @@     AppData (..),     runApp,     withDebugger,+    disableIntrospection,     mkApp,     runAppStream,     MapAPI (..),@@ -74,7 +75,7 @@ import qualified Data.Morpheus.Types.Internal.AST as AST import Relude hiding (ByteString, empty) -mkApp :: ValidateSchema s => Schema s -> RootResolverValue e m -> App e m+mkApp :: (ValidateSchema s) => Schema s -> RootResolverValue e m -> App e m mkApp appSchema appResolvers =   resultOr     FailApp@@ -89,7 +90,7 @@   renderGQL App {app} = renderGQL app   renderGQL FailApp {appErrors} = renderGQL $ A.encode $ toList appErrors -instance Monad m => Semigroup (App e m) where+instance (Monad m) => Semigroup (App e m) where   (FailApp err1) <> (FailApp err2) = FailApp (err1 <> err2)   FailApp {appErrors} <> App {} = FailApp appErrors   App {} <> FailApp {appErrors} = FailApp appErrors@@ -107,7 +108,7 @@ instance RenderGQL (AppData e m s) where   renderGQL = renderGQL . appSchema -instance Monad m => Stitching (AppData e m s) where+instance (Monad m) => Stitching (AppData e m s) where   stitch x y =     AppData       (appConfig y)@@ -177,12 +178,12 @@ rootType OPERATION_SUBSCRIPTION = subscription  stateless ::-  Functor m =>+  (Functor m) =>   ResponseStream event m (Value VALID) ->   m GQLResponse stateless = fmap (renderResponse . fmap snd) . runResultT -runAppStream :: Monad m => App event m -> GQLRequest -> ResponseStream event m (Value VALID)+runAppStream :: (Monad m) => App event m -> GQLRequest -> ResponseStream event m (Value VALID) runAppStream App {app} = runAppData app runAppStream FailApp {appErrors} = const $ throwErrors appErrors @@ -194,10 +195,16 @@   App {app = f app} mapApp _ x = x -withDebugger :: App e m -> App e m-withDebugger = mapApp f+mapConfig :: (Config -> Config) -> App e m -> App e m+mapConfig g = mapApp f   where-    f AppData {appConfig = Config {..}, ..} = AppData {appConfig = Config {debug = True, ..}, ..}+    f AppData {appConfig, ..} = AppData {appConfig = g appConfig, ..}++withDebugger :: App e m -> App e m+withDebugger = mapConfig (\c -> c {debug = True})++disableIntrospection :: App e m -> App e m+disableIntrospection = mapConfig (\c -> c {introspection = False})  withConstraint :: APIConstraint -> App e m -> App e m withConstraint constraint = mapApp f

@@ -4,6 +4,7 @@ {-# LANGUAGE GADTs #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-} {-# LANGUAGE NoImplicitPrelude #-}  module Data.Morpheus.App.Internal.Resolving.MonadResolver

@@ -5,6 +5,7 @@ {-# LANGUAGE RankNTypes #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeOperators #-} {-# LANGUAGE NoImplicitPrelude #-}  module Data.Morpheus.App.Internal.Resolving.RootResolverValue@@ -34,6 +35,7 @@ import Data.Morpheus.App.Internal.Resolving.Utils   ( lookupResJSON,   )+import Data.Morpheus.Core (Config (..)) import Data.Morpheus.Types.Internal.AST   ( MUTATION,     Operation (..),@@ -65,7 +67,7 @@   | NamedResolversValue       {queryResolverMap :: ResolverMap (Resolver QUERY e m)} -instance Monad m => FromJSON (RootResolverValue e m) where+instance (Monad m) => FromJSON (RootResolverValue e m) where   parseJSON res =     pure       RootResolverValue@@ -80,7 +82,7 @@   root <- liftState (toResolverStateT res)   resolvePlainRoot root selection -runRootResolverValue :: Monad m => RootResolverValue e m -> ResolverContext -> ResponseStream e m (Value VALID)+runRootResolverValue :: (Monad m) => RootResolverValue e m -> ResolverContext -> ResponseStream e m (Value VALID) runRootResolverValue   RootResolverValue     { queryResolver,@@ -88,34 +90,36 @@       subscriptionResolver,       channelMap     }-  ctx@ResolverContext {operation = Operation {..}} =+  ctx@ResolverContext {operation = Operation {..}, config} =     selectByOperation operationType     where       selectByOperation OPERATION_QUERY =-        runResolver channelMap (rootResolver (withIntroFields <$> queryResolver) operationSelection) ctx+        runResolver channelMap (rootResolver (withIntroFields config <$> queryResolver) operationSelection) ctx       selectByOperation OPERATION_MUTATION =         runResolver channelMap (rootResolver mutationResolver operationSelection) ctx       selectByOperation OPERATION_SUBSCRIPTION =         runResolver channelMap (rootResolver subscriptionResolver operationSelection) ctx runRootResolverValue   NamedResolversValue {queryResolverMap}-  ctx@ResolverContext {operation = Operation {..}} =+  ctx@ResolverContext {operation = Operation {..}, config} =     selectByOperation operationType     where       selectByOperation OPERATION_QUERY = runResolver Nothing queryResolver ctx         where           queryResolver = do             name <- asks (typeName . query . schema)-            resolveNamedRoot name (withNamedIntroFields name queryResolverMap) operationSelection+            resolveNamedRoot name (withNamedIntroFields config name queryResolverMap) operationSelection       selectByOperation _ = throwError "mutation and subscription is not supported for namedResolvers" -withNamedIntroFields :: (MonadResolver m, MonadOperation m ~ QUERY) => TypeName -> ResolverMap m -> ResolverMap m-withNamedIntroFields = adjust updateNamed+withNamedIntroFields :: (MonadResolver m, MonadOperation m ~ QUERY) => Config -> TypeName -> ResolverMap m -> ResolverMap m+withNamedIntroFields config = adjust updateNamed   where     updateNamed NamedResolver {..} = NamedResolver {resolverFun = const (updateResult <$> resolverFun ["ROOT"]), ..}       where-        updateResult [NamedObjectResolver obj] = [NamedObjectResolver (withIntroFields obj)]+        updateResult [NamedObjectResolver obj] = [NamedObjectResolver (withIntroFields config obj)]         updateResult value = value -withIntroFields :: (MonadResolver m, MonadOperation m ~ QUERY) => ObjectTypeResolver m -> ObjectTypeResolver m-withIntroFields (ObjectTypeResolver fields) = ObjectTypeResolver (fields <> objectFields schemaAPI)+withIntroFields :: Config -> (MonadResolver m, MonadOperation m ~ QUERY) => ObjectTypeResolver m -> ObjectTypeResolver m+withIntroFields config (ObjectTypeResolver fields)+  | introspection config = ObjectTypeResolver (fields <> objectFields schemaAPI)+  | otherwise = ObjectTypeResolver fields

@@ -3,6 +3,7 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-} {-# LANGUAGE NoImplicitPrelude #-}  module Data.Morpheus.App.Internal.Resolving.SchemaAPI@@ -39,7 +40,7 @@   ) import Relude hiding (empty) -resolveSchema :: MonadResolver m => Schema VALID -> m (ResolverValue m)+resolveSchema :: (MonadResolver m) => Schema VALID -> m (ResolverValue m) resolveSchema schema@Schema {..} =   pure $     mkObject

@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE NoImplicitPrelude #-}@@ -11,14 +12,15 @@ import Data.Aeson   ( encode,   )-import Data.Aeson.Internal-  ( formatError,-    ifromJSON,-  ) import Data.Aeson.Parser   ( eitherDecodeWith,     jsonNoDup,   )+#if MIN_VERSION_aeson(2,1,0)+import Data.Aeson.Types ( formatError,ifromJSON,)+#else+import Data.Aeson.Internal ( formatError,ifromJSON,)+#endif import Data.ByteString.Lazy.Char8 (pack) import qualified Data.ByteString.Lazy.Char8 as LB   ( ByteString,@@ -43,13 +45,13 @@     encodeUtf8,   ) -decodeNoDup :: MonadError LB.ByteString m => LB.ByteString -> m GQLRequest+decodeNoDup :: (MonadError LB.ByteString m) => LB.ByteString -> m GQLRequest decodeNoDup str = case eitherDecodeWith jsonNoDup ifromJSON str of   Left (path, x) -> throwError $ pack $ "Bad Request. Could not decode Request body: " <> formatError path x   Right value -> pure value  class MapAPI a b where-  mapAPI :: Applicative m => (GQLRequest -> m GQLResponse) -> a -> m b+  mapAPI :: (Applicative m) => (GQLRequest -> m GQLResponse) -> a -> m b  instance MapAPI GQLRequest GQLResponse where   mapAPI f = f

@@ -0,0 +1,42 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE NoImplicitPrelude #-}++module DisableIntrospection+  ( runNamedDisableIntrospectionTest,+    runDisableIntrospectionTest,+  )+where++import qualified Data.ByteString.Lazy.Char8 as LBS+import Data.Morpheus.App (disableIntrospection, mkApp, runApp)+import Data.Morpheus.App.Internal.Resolving (resultOr)+import Data.Morpheus.App.NamedResolvers (object, queryResolvers)+import Data.Morpheus.Core (parseSchema)+import Data.Morpheus.Internal.Ext (toEither)+import Data.Morpheus.Types.IO (GQLRequest (..), GQLResponse)+import Relude hiding (ByteString)+import Test.Morpheus+  ( FileUrl,+    file,+    getAppsBy,+    testApi,+  )+import Test.Tasty (TestTree)++runNamedDisableIntrospectionTest :: FileUrl -> FileUrl -> TestTree+runNamedDisableIntrospectionTest url = testApi api+  where+    api :: GQLRequest -> IO GQLResponse+    api req = do+      schema <- LBS.readFile (toString (file url "schema.gql")) >>= resultOr (fail . show) pure . parseSchema+      let resolvers = queryResolvers [("Query", traverse (const $ object [("name", pure "Morpheus")]))]+      let app = disableIntrospection (mkApp schema resolvers)+      runApp app req++runDisableIntrospectionTest :: FileUrl -> FileUrl -> TestTree+runDisableIntrospectionTest url = testApi api+  where+    api :: GQLRequest -> IO GQLResponse+    api req = do+      app <- getAppsBy (toEither . parseSchema, mkApp) url+      runApp (disableIntrospection app) req

@@ -25,6 +25,7 @@   ( GQLRequest (..),     GQLResponse,   )+import DisableIntrospection (runDisableIntrospectionTest, runNamedDisableIntrospectionTest) import Execution (runExecutionTest) import NamedResolvers (runNamedResolversTest) import Relude hiding (ByteString)@@ -68,5 +69,7 @@       deepScan (map . runNamedResolversTest) (mkUrl "named-resolvers"),       deepScan (map . runAPIConstraints) (mkUrl "api-constraints"),       deepScan (map . runBatchingTest) (mkUrl "batching"),-      deepScan (map . runExecutionTest) (mkUrl "execution")+      deepScan (map . runExecutionTest) (mkUrl "execution"),+      deepScan (map . runNamedDisableIntrospectionTest) (mkUrl "disable-introspection"),+      deepScan (map . runDisableIntrospectionTest) (mkUrl "disable-introspection")     ]

@@ -0,0 +1,3 @@+query {+  name+}

@@ -0,0 +1,3 @@+{+  "data": { "name": "Morpheus" }+}

@@ -0,0 +1,5 @@+{+  "query": {+    "name": "Morpheus"+  }+}

@@ -0,0 +1,3 @@+type Query {+  name: String+}

@@ -0,0 +1,12 @@+query Get__Type {+  __schema {+    types {+      name+    }+    directives {+      name+      description+      locations+    }+  }+}

@@ -0,0 +1,3 @@+{+  "data": { "__schema": null }+}

@@ -0,0 +1,5 @@+query Get__Type {+  __type(name: "Query") {+    name+  }+}

@@ -0,0 +1,3 @@+{+  "data": { "__type": null }+}