From 8b3b1bbe37656459c56f2141047c80c17b30cf4b Mon Sep 17 00:00:00 2001
From: prescientmoon <git@moonythm.dev>
Date: Sat, 7 Dec 2024 20:00:09 +0100
Subject: [PATCH] Add insertonly test
Moreover, this fixes the test for writeonly tokens, which used to create
a table in a db, and then try querying from a separate db, which ended
up not testing what it was supposed to at all.
I also changed the way mutations are guarded (the end result is pretty
much the same)
---
source/AirGQL/GraphQL.hs | 139 +++++++++++++------------------
tests/Tests/IntrospectionSpec.hs | 117 ++++++++++++++++++--------
tests/Tests/MutationSpec.hs | 11 ++-
3 files changed, 150 insertions(+), 117 deletions(-)
diff --git a/source/AirGQL/GraphQL.hs b/source/AirGQL/GraphQL.hs
index b13038c..6b2a4ae 100644
--- a/source/AirGQL/GraphQL.hs
+++ b/source/AirGQL/GraphQL.hs
@@ -36,7 +36,6 @@ import Protolude (
(&),
(&&),
(.),
- (<$>),
(<&>),
(<=),
(>),
@@ -814,6 +813,9 @@ queryType connection accessMode dbId tables = do
, Introspection.typeNameResolver
, resolvers
]
+ -- TODO: is it better to wrap the resolvers here,
+ -- or to just return an empty list of resolvers
+ -- when given a token that cannot read?
<&> wrapResolver requireRead
}
@@ -1074,94 +1076,73 @@ mutationType connection maxRowsPerTable accessMode dbId tables = do
numOfChanges <- SS.changes connection
mutationByPKResponse table numOfChanges $ P.head deletedRows
- getMutationResolvers :: IO (HashMap.HashMap Text (Resolver IO))
- getMutationResolvers = do
- let
- getInsertTableTuple :: TableEntry -> IO (Text, Resolver IO)
- getInsertTableTuple table =
- makeResolver
- (Introspection.tableInsertField accessMode table)
- (executeDbInserts table)
+ getInsertTableTuple :: TableEntry -> IO (Text, Resolver IO)
+ getInsertTableTuple table =
+ makeResolver
+ (Introspection.tableInsertField accessMode table)
+ (executeDbInserts table)
- getUpdateTableTuple :: TableEntry -> IO (Text, Resolver IO)
- getUpdateTableTuple table =
- makeResolver
- (Introspection.tableUpdateField accessMode table)
- (executeDbUpdates table)
+ getUpdateTableTuple :: TableEntry -> IO (Text, Resolver IO)
+ getUpdateTableTuple table =
+ makeResolver
+ (Introspection.tableUpdateField accessMode table)
+ (executeDbUpdates table)
- getUpdateByPKTableTuple :: TableEntry -> IO (Maybe (Text, Resolver IO))
- getUpdateByPKTableTuple table =
- P.for (Introspection.tableUpdateFieldByPk accessMode tables table) $
- \field -> makeResolver field (executeDbUpdatesByPK table)
+ getUpdateByPKTableTuple :: TableEntry -> IO (Maybe (Text, Resolver IO))
+ getUpdateByPKTableTuple table =
+ P.for (Introspection.tableUpdateFieldByPk accessMode tables table) $
+ \field -> makeResolver field (executeDbUpdatesByPK table)
- getDeleteTableTuple :: TableEntry -> IO (Text, Resolver IO)
- getDeleteTableTuple table =
- makeResolver
- (Introspection.tableDeleteField accessMode table)
- (executeDbDeletions table)
+ getDeleteTableTuple :: TableEntry -> IO (Text, Resolver IO)
+ getDeleteTableTuple table =
+ makeResolver
+ (Introspection.tableDeleteField accessMode table)
+ (executeDbDeletions table)
- getDeleteByPKTableTuple :: TableEntry -> IO (Maybe (Text, Resolver IO))
- getDeleteByPKTableTuple table =
- P.for (Introspection.tableDeleteFieldByPK accessMode tables table) $
- \field -> makeResolver field (executeDbDeletionsByPK table)
+ getDeleteByPKTableTuple :: TableEntry -> IO (Maybe (Text, Resolver IO))
+ getDeleteByPKTableTuple table =
+ P.for (Introspection.tableDeleteFieldByPK accessMode tables table) $
+ \field -> makeResolver field (executeDbDeletionsByPK table)
- tablesWithoutViews :: [TableEntry]
- tablesWithoutViews =
- List.filter
- (\table -> table.object_type == Table)
- tables
+ tablesWithoutViews :: [TableEntry]
+ tablesWithoutViews =
+ List.filter
+ (\table -> table.object_type == Table)
+ tables
- insertTuples <-
- P.fold
- [ P.for tablesWithoutViews getInsertTableTuple
- ]
+ insertTuples <-
+ P.fold
+ [ P.for tablesWithoutViews getInsertTableTuple
+ ]
- writeTuples <-
- P.fold
- [ P.for tablesWithoutViews getUpdateTableTuple
- , P.for tablesWithoutViews getDeleteTableTuple
- , P.for tablesWithoutViews getUpdateByPKTableTuple
- <&> P.catMaybes
- , P.for tablesWithoutViews getDeleteByPKTableTuple
- <&> P.catMaybes
- ]
+ writeTuples <-
+ P.fold
+ [ P.for tablesWithoutViews getUpdateTableTuple
+ , P.for tablesWithoutViews getDeleteTableTuple
+ , P.for tablesWithoutViews getUpdateByPKTableTuple
+ <&> P.catMaybes
+ , P.for tablesWithoutViews getDeleteByPKTableTuple
+ <&> P.catMaybes
+ ]
- let
- requireWrite :: Out.Resolve IO -> Out.Resolve IO
- requireWrite resolve = do
- when (P.not $ canWrite accessMode) $ do
- throw $
- ResolverException $
- userError "Cannot write field using the provided token"
- resolve
+ let
+ insertResolvers =
+ if canInsert accessMode
+ then HashMap.fromList insertTuples
+ else mempty
- requireInsert :: Out.Resolve IO -> Out.Resolve IO
- requireInsert resolve = do
- when (P.not $ canInsert accessMode) $ do
- throw $
- ResolverException $
- userError "Cannot insert entries using the provided token"
- resolve
+ writeResolvers =
+ if canWrite accessMode
+ then HashMap.fromList writeTuples
+ else mempty
- insertResolvers =
- HashMap.fromList insertTuples
- <&> wrapResolver requireInsert
-
- writeResolvers =
- HashMap.fromList writeTuples
- <&> wrapResolver requireWrite
-
- pure $ insertResolvers <> writeResolvers
-
- if canWrite accessMode
- then
- Just
- . Out.ObjectType
- "Mutation"
- Nothing
- []
- <$> getMutationResolvers
- else pure Nothing
+ pure
+ $ Just
+ $ Out.ObjectType
+ "Mutation"
+ Nothing
+ []
+ $ insertResolvers <> writeResolvers
-- | Automatically generated schema derived from the SQLite database
diff --git a/tests/Tests/IntrospectionSpec.hs b/tests/Tests/IntrospectionSpec.hs
index d6141a5..e86eba1 100644
--- a/tests/Tests/IntrospectionSpec.hs
+++ b/tests/Tests/IntrospectionSpec.hs
@@ -24,7 +24,7 @@ import System.FilePath ((</>))
import Test.Hspec (Spec, describe, it, shouldBe)
import AirGQL.GraphQL (getDerivedSchema)
-import AirGQL.Lib (getEnrichedTables, writeOnly)
+import AirGQL.Lib (getEnrichedTables, insertOnly, writeOnly)
import AirGQL.Raw (raw)
import AirGQL.Types.SchemaConf (SchemaConf (accessMode), defaultSchemaConf)
import AirGQL.Utils (withRetryConn)
@@ -181,7 +181,7 @@ main = void $ do
"data": null,
"errors": [{
"locations": [{ "column":3, "line":2 }],
- "message": "user error (Cannot read field using writeonly access code)",
+ "message": "user error (Cannot read field using the provided token)",
"path": ["__schema"]
}]
}
@@ -644,41 +644,88 @@ main = void $ do
)
|]
- let
- query :: Text
- query =
- [gql|
- mutation items {
- update_items(filter: { id: { eq: 0 }}, set: { id: 0 }) {
- returning { id }
- }
- }
- |]
-
- expected =
- rmSpaces
- [raw|
- {
- "data": null,
- "errors": [{
- "locations": [{ "column":3, "line":2 }],
- "message": "Cannot query field \"update_items\" on type \"Mutation\"."
- }]
+ let
+ query :: Text
+ query =
+ [gql|
+ mutation items {
+ update_items(filter: { id: { eq: 0 }}, set: { id: 0 }) {
+ returning { id }
+ }
}
|]
- schema <- withRetryConn dbPath $ \conn -> do
+ expected =
+ rmSpaces
+ [raw|
+ {
+ "data": null,
+ "errors": [{
+ "locations": [{ "column":5, "line":3 }],
+ "message": "Cannot query field \"returning\" on type \"items_mutation_response\"."
+ }]
+ }
+ |]
+
Right tables <- getEnrichedTables conn
- getDerivedSchema
- defaultSchemaConf{accessMode = writeOnly}
+ schema <-
+ getDerivedSchema
+ defaultSchemaConf{accessMode = writeOnly}
+ conn
+ fixtureDbId
+ tables
+
+ Right response <-
+ graphql schema Nothing mempty query
+
+ Ae.encode response `shouldBe` expected
+
+ it "doesn't allow insertonly tokens to update data" $ do
+ let dbName = "no-insertonly-return.db"
+ withTestDbConn dbName $ \conn -> do
+ SS.execute_
conn
- fixtureDbId
- tables
+ [sql|
+ CREATE TABLE items (
+ id INTEGER PRIMARY KEY
+ )
+ |]
- Right response <-
- graphql schema Nothing mempty query
+ let
+ query :: Text
+ query =
+ [gql|
+ mutation items {
+ update_items_by_pk(id: 0, set: { id: 0 }) {
+ affected_rows
+ }
+ }
+ |]
- Ae.encode response `shouldBe` expected
+ expected =
+ rmSpaces
+ [raw|
+ {
+ "data": null,
+ "errors": [{
+ "locations": [{ "column":3, "line":2 }],
+ "message": "Cannot query field \"update_items_by_pk\" on type \"Mutation\"."
+ }]
+ }
+ |]
+
+ Right tables <- getEnrichedTables conn
+ schema <-
+ getDerivedSchema
+ defaultSchemaConf{accessMode = insertOnly}
+ conn
+ fixtureDbId
+ tables
+
+ Right response <-
+ graphql schema Nothing mempty query
+
+ Ae.encode response `shouldBe` expected
describe "Naming conflicts" $ do
it "appends _ at the end of queries to avoid conflicts with table names" $ do
@@ -747,32 +794,32 @@ main = void $ do
"__schema": {
"mutationType": {
"fields": [
- {
+ {
"name": "insert_foo",
"args": [
{ "name": "objects" },
{ "name": "on_conflict" }
]
},
- {
+ {
"name": "update_foo",
"args": [
{ "name": "set" },
{ "name": "filter" }
]
},
- {
+ {
"name": "update_foo_by_pk",
"args": [
{ "name": "set" },
{ "name": "set_" }
]
},
- {
+ {
"name": "delete_foo",
"args": [{ "name": "filter" }]
},
- {
+ {
"name": "delete_foo_by_pk",
"args": [{ "name": "set" }]
}
diff --git a/tests/Tests/MutationSpec.hs b/tests/Tests/MutationSpec.hs
index 49a7b64..b2b8d89 100644
--- a/tests/Tests/MutationSpec.hs
+++ b/tests/Tests/MutationSpec.hs
@@ -24,11 +24,11 @@ import System.FilePath ((</>))
import Test.Hspec (Spec, describe, it, shouldBe)
import AirGQL.GraphQL (getDerivedSchema)
-import AirGQL.Lib (SQLPost (SQLPost, query), getEnrichedTables)
+import AirGQL.Lib (SQLPost (SQLPost, query), getEnrichedTables, insertOnly)
import AirGQL.Raw (raw)
import AirGQL.Servant.SqlQuery (sqlQueryPostHandler)
import AirGQL.Types.PragmaConf qualified as PragmaConf
-import AirGQL.Types.SchemaConf (defaultSchemaConf)
+import AirGQL.Types.SchemaConf (SchemaConf (accessMode), defaultSchemaConf)
import AirGQL.Types.SqlQueryPostResult (
SqlQueryPostResult (rows),
)
@@ -75,7 +75,12 @@ main = void $ do
conn <- SS.open dbPath
Right tables <- getEnrichedTables conn
- schema <- getDerivedSchema defaultSchemaConf conn fixtureDbId tables
+ schema <-
+ getDerivedSchema
+ defaultSchemaConf{accessMode = insertOnly}
+ conn
+ fixtureDbId
+ tables
Right result <- graphql schema Nothing mempty query
Ae.encode result `shouldBe` expected