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

@@ -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,9 +1076,6 @@ 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
@@ -1127,41 +1126,23 @@ mutationType connection maxRowsPerTable accessMode dbId tables = do
       ]
 
   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
-
-        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
-
     insertResolvers =
-          HashMap.fromList insertTuples
-            <&> wrapResolver requireInsert
+      if canInsert accessMode
+        then HashMap.fromList insertTuples
+        else mempty
 
     writeResolvers =
-          HashMap.fromList writeTuples
-            <&> wrapResolver requireWrite
-
-      pure $ insertResolvers <> writeResolvers
-
       if canWrite accessMode
-    then
-      Just
-        . Out.ObjectType
+        then HashMap.fromList writeTuples
+        else mempty
+
+  pure
+    $ Just
+    $ Out.ObjectType
       "Mutation"
       Nothing
       []
-        <$> getMutationResolvers
-    else pure Nothing
+    $ insertResolvers <> writeResolvers
 
 
 -- | Automatically generated schema derived from the SQLite database

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"]
                 }]
               }
@@ -661,14 +661,14 @@ main = void $ do
               {
                 "data": null,
                 "errors": [{
-                "locations": [{ "column":3, "line":2 }],
-                "message": "Cannot query field \"update_items\" on type \"Mutation\"."
+                  "locations": [{ "column":5, "line":3 }],
+                  "message": "Cannot query field \"returning\" on type \"items_mutation_response\"."
                 }]
               }
             |]
 
-    schema <- withRetryConn dbPath $ \conn -> do
       Right tables <- getEnrichedTables conn
+      schema <-
         getDerivedSchema
           defaultSchemaConf{accessMode = writeOnly}
           conn
@@ -680,6 +680,53 @@ main = void $ do
 
       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
+        [sql|
+          CREATE TABLE items (
+            id INTEGER PRIMARY KEY
+          )
+        |]
+
+      let
+        query :: Text
+        query =
+          [gql|
+            mutation items {
+              update_items_by_pk(id: 0, set: { id: 0 }) {
+                affected_rows
+              }
+            }
+          |]
+
+        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
       let dbName = "by-pk-table-names.db"

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