morpheus-graphql-app 0.21.0 → 0.22.0

raw patch · 16 files changed

+187/−18 lines, 16 filesdep ~morpheus-graphql-coredep ~morpheus-graphql-testsPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: morpheus-graphql-core, morpheus-graphql-tests

API changes (from Hackage documentation)

Files

• morpheus-graphql-app.cabal +14/−4
• src/Data/Morpheus/App.hs +36/−9
• src/Data/Morpheus/App/Internal/Resolving/Resolver.hs +1/−0
• src/Data/Morpheus/App/Internal/Stitching.hs +8/−2
• src/Data/Morpheus/App/RenderIntrospection.hs +1/−2
• test/APIConstraints.hs +83/−0
• test/Spec.hs +3/−1
• test/api-constraints/forbidden/query.gql +3/−0
• test/api-constraints/forbidden/response.json +7/−0
• test/api-constraints/over-limit/query.gql +3/−0
• test/api-constraints/over-limit/response.json +7/−0
• test/api-constraints/schema.gql +5/−0
• test/api-constraints/success/query.gql +3/−0
• test/api-constraints/success/response.json +5/−0
• test/api-constraints/under-limit/query.gql +3/−0
• test/api-constraints/under-limit/response.json +5/−0

@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack  name:           morpheus-graphql-app-version:        0.21.0+version:        0.22.0 synopsis:       Morpheus GraphQL App description:    Build GraphQL APIs with your favourite functional language! category:       web, graphql@@ -21,6 +21,11 @@     README.md     changelog.md data-files:+    test/api-constraints/forbidden/query.gql+    test/api-constraints/over-limit/query.gql+    test/api-constraints/schema.gql+    test/api-constraints/success/query.gql+    test/api-constraints/under-limit/query.gql     test/api/deity/interface/query.gql     test/api/deity/schema.gql     test/api/deity/simple/query.gql@@ -57,6 +62,10 @@     test/named-resolvers/realm-simple/query.gql     test/named-resolvers/realms.gql     test/named-resolvers/realms/query.gql+    test/api-constraints/forbidden/response.json+    test/api-constraints/over-limit/response.json+    test/api-constraints/success/response.json+    test/api-constraints/under-limit/response.json     test/api/deity/interface/response.json     test/api/deity/resolvers.json     test/api/deity/simple/response.json@@ -123,7 +132,7 @@     , containers >=0.4.2.1 && <0.7.0     , hashable >=1.0.0 && <2.0.0     , megaparsec >=7.0.0 && <10.0.0-    , morpheus-graphql-core >=0.21.0 && <0.22.0+    , morpheus-graphql-core >=0.22.0 && <0.23.0     , mtl >=2.0.0 && <3.0.0     , relude >=0.3.0 && <2.0.0     , scientific >=0.3.6.2 && <0.4.0@@ -139,6 +148,7 @@   type: exitcode-stdio-1.0   main-is: Spec.hs   other-modules:+      APIConstraints       NamedResolvers       Paths_morpheus_graphql_app   hs-source-dirs:@@ -153,8 +163,8 @@     , hashable >=1.0.0 && <2.0.0     , megaparsec >=7.0.0 && <10.0.0     , morpheus-graphql-app-    , morpheus-graphql-core >=0.21.0 && <0.22.0-    , morpheus-graphql-tests >=0.21.0 && <0.22.0+    , morpheus-graphql-core >=0.22.0 && <0.23.0+    , morpheus-graphql-tests >=0.22.0 && <0.23.0     , mtl >=2.0.0 && <3.0.0     , relude >=0.3.0 && <2.0.0     , scientific >=0.3.6.2 && <0.4.0

@@ -19,9 +19,12 @@     runAppStream,     MapAPI (..),     eitherSchema,+    withConstraint,+    APIConstraint,   ) where +import Control.Monad.Except (throwError) import qualified Data.Aeson as A import Data.ByteString.Lazy (ByteString) import Data.Morpheus.App.Internal.Resolving@@ -45,7 +48,7 @@     parseRequestWith,     render,   )-import Data.Morpheus.Internal.Ext ((<:>))+import Data.Morpheus.Internal.Ext (GQLResult, (<:>)) import Data.Morpheus.Internal.Utils   ( empty,     prop,@@ -75,7 +78,7 @@ mkApp appSchema appResolvers =   resultOr     FailApp-    (App . AppData defaultConfig appResolvers)+    (App . AppData defaultConfig [] appResolvers)     (validateSchema True defaultConfig appSchema)  data App event (m :: Type -> Type)@@ -92,8 +95,11 @@   App {} <> FailApp {appErrors} = FailApp appErrors   (App x) <> (App y) = resultOr FailApp App (stitch x y) +type APIConstraint = Schema VALID -> Operation VALID -> Either String ()+ data AppData event (m :: Type -> Type) s = AppData   { appConfig :: Config,+    constraints :: [APIConstraint],     appResolvers :: RootResolverValue event m,     appSchema :: Schema s   }@@ -103,33 +109,44 @@  instance Monad m => Stitching (AppData e m s) where   stitch x y =-    AppData (appConfig y)+    AppData+      (appConfig y)+      (constraints x <> constraints y)       <$> prop stitch appResolvers x y       <*> prop stitch appSchema x y +checkConstraints :: Schema VALID -> Operation VALID -> [APIConstraint] -> GQLResult ()+checkConstraints appSchema validRequest constraints =+  either+    (throwError . fromString . ("API Constraint: " <>))+    (const $ pure ())+    (traverse (\f -> f appSchema validRequest) constraints)+ runAppData ::   (Monad m, ValidateSchema s) =>   AppData event m s ->   GQLRequest ->   ResponseStream event m (Value VALID)-runAppData AppData {appConfig, appSchema, appResolvers} request = do-  validRequest <- validateReq appSchema appConfig request+runAppData AppData {appConfig, appSchema, appResolvers, constraints} request = do+  validRequest <- validateReq constraints appSchema appConfig request   runRootResolverValue appResolvers validRequest  validateReq ::   ( Monad m,     ValidateSchema s   ) =>+  [APIConstraint] ->   Schema s ->   Config ->   GQLRequest ->   ResponseStream event m ResolverContext-validateReq inputSchema config request = ResultT $+validateReq constraints inputSchema config request = ResultT $   pure $     do       validSchema <- validateSchema True config inputSchema       schema <- internalSchema <:> validSchema       operation <- parseRequestWith config validSchema request+      checkConstraints schema operation constraints       pure         ( [],           ResolverContext@@ -171,10 +188,20 @@ runApp :: (MapAPI a b, Monad m) => App e m -> a -> m b runApp app = mapAPI (stateless . runAppStream app) +mapApp :: (AppData e m VALID -> AppData e m VALID) -> App e m -> App e m+mapApp f App {app} =+  App {app = f app}+mapApp _ x = x+ withDebugger :: App e m -> App e m-withDebugger App {app = AppData {appConfig = Config {..}, ..}} =-  App {app = AppData {appConfig = Config {debug = True, ..}, ..}, ..}-withDebugger x = x+withDebugger = mapApp f+  where+    f AppData {appConfig = Config {..}, ..} = AppData {appConfig = Config {debug = True, ..}, ..}++withConstraint :: APIConstraint -> App e m -> App e m+withConstraint constraint = mapApp f+  where+    f AppData {..} = AppData {constraints = constraint : constraints, ..}  eitherSchema :: App event m -> Either [GQLError] ByteString eitherSchema (App AppData {appSchema}) = Right (render appSchema)

@@ -175,6 +175,7 @@ -- Using the 'ResolverContext' itself is unsafe because it exposes internal structures -- of the AST, but you can use the "Data.Morpheus.Types.SelectionTree" typeClass to manipulate -- the internal AST with a safe interface.+{-# DEPRECATED unsafeInternalContext "use asks" #-} unsafeInternalContext :: (Monad m, LiftOperation o) => Resolver o e m ResolverContext unsafeInternalContext = ask 

@@ -31,7 +31,8 @@     prop,   ) import Data.Morpheus.Types.Internal.AST-  ( Directives,+  ( DirectiveDefinition,+    Directives,     DirectivesDefinition,     FieldDefinition,     FieldsDefinition,@@ -74,7 +75,7 @@   stitch x y = runResolutionT (mergeT x y) unsafeFromList (resolveWith stitch)  instance Stitching (DirectivesDefinition s) where-  stitch = merge+  stitch x y = runResolutionT (mergeT x y) unsafeFromList (resolveWith stitch)  instance Stitching (Directives s) where   stitch = merge@@ -95,6 +96,11 @@     <*> prop fstM typeName x y     <*> prop stitch typeDirectives x y     <*> prop stitch typeContent x y++instance Stitching (DirectiveDefinition s) where+  stitch x y+    | x == y = pure x+    | otherwise = throwError "only directives with same structure can be merged"  instance Stitching (TypeDefinition cat s) where   stitch x y =

@@ -19,7 +19,6 @@ import Data.Morpheus.App.Internal.Resolving.Resolver   ( Resolver,     ResolverContext (..),-    unsafeInternalContext,   ) import Data.Morpheus.App.Internal.Resolving.Types   ( ResolverValue,@@ -86,7 +85,7 @@   getSchema :: m (Schema VALID)  instance Monad m => WithSchema (Resolver QUERY e m) where-  getSchema = schema <$> unsafeInternalContext+  getSchema = schema <$> ask  selectType ::   WithSchema m =>

@@ -0,0 +1,83 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE NoImplicitPrelude #-}++module APIConstraints+  ( runAPIConstraints,+  )+where++import Data.Aeson (Value (..))+import qualified Data.ByteString.Lazy.Char8 as LBS+import Data.Morpheus.App+  ( APIConstraint,+    App,+    mkApp,+    runApp,+    withConstraint,+  )+import Data.Morpheus.App.Internal.Resolving (resultOr)+import Data.Morpheus.App.NamedResolvers+  ( RootResolverValue,+    object,+    queryResolvers,+  )+import Data.Morpheus.Core+  ( parseSchema,+  )+import Data.Morpheus.Types.IO+  ( GQLRequest,+    GQLResponse,+  )+import Data.Morpheus.Types.Internal.AST+  ( Schema,+    VALID,+  )+import Data.Morpheus.Types.SelectionTree+  ( SelectionTree (..),+  )+import Relude hiding (ByteString)+import Test.Morpheus+  ( FileUrl,+    testApi,+  )+import Test.Tasty+  ( TestTree,+  )++resolvers :: Monad m => RootResolverValue e m+resolvers =+  queryResolvers+    [ ( "Query",+        const $+          object+            [ ("success", pure "success"),+              ("forbidden", pure "forbidden!"),+              ("limited", pure "num <= 5")+            ]+      )+    ]++getSchema :: String -> IO (Schema VALID)+getSchema url = LBS.readFile url >>= resultOr (fail . show) pure . parseSchema++getApp :: FileUrl -> IO (App e IO)+getApp _ = (`mkApp` resolvers) <$> getSchema "test/api-constraints/schema.gql"++forbidden :: APIConstraint+forbidden _ query+  | hasChild ("forbidden" :: String) query = Left "no forbidden field!"+  | otherwise = Right ()++max5 :: APIConstraint+max5 _ query =+  case getChild ("limited" :: Text) query >>= getArgument ("num" :: Text) of+    Just (Number n) | n > 5 -> Left ("num " <> show n <> " is greater then 5! but found ")+    _ -> pure ()++runAPIConstraints :: FileUrl -> FileUrl -> TestTree+runAPIConstraints url = testApi api+  where+    api :: GQLRequest -> IO GQLResponse+    api req = do+      app <- withConstraint max5 . withConstraint forbidden <$> getApp url+      runApp app req

@@ -7,6 +7,7 @@   ) where +import APIConstraints (runAPIConstraints) import Data.Morpheus.App   ( App (..),     eitherSchema,@@ -62,5 +63,6 @@     "App Tests"     [ deepScan runMergeTest (mkUrl "merge"),       deepScan runApiTest (mkUrl "api"),-      deepScan (map . runNamedResolversTest) (mkUrl "named-resolvers")+      deepScan (map . runNamedResolversTest) (mkUrl "named-resolvers"),+      deepScan (map . runAPIConstraints) (mkUrl "api-constraints")     ]

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

@@ -0,0 +1,7 @@+{+  "errors": [+    {+      "message": "API Constraint: no forbidden field!"+    }+  ]+}

@@ -0,0 +1,3 @@+query {+  limited(num: 7)+}

@@ -0,0 +1,7 @@+{+  "errors": [+    {+      "message": "API Constraint: num 7.0 is greater then 5! but found "+    }+  ]+}

@@ -0,0 +1,5 @@+type Query {+  success: String+  forbidden: String+  limited(num: Int): String+}

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

@@ -0,0 +1,5 @@+{+  "data": {+    "success": "success"+  }+}

@@ -0,0 +1,3 @@+query {+  limited(num: 4)+}

@@ -0,0 +1,5 @@+{+  "data": {+    "limited": "num <= 5"+  }+}