{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE NoMonomorphismRestriction #-}
{-# OPTIONS_GHC -Wno-missing-local-signatures #-}
module Tests.IntrospectionSpec (main) where
import Protolude (
Either (Right),
Maybe (Nothing),
Monoid (mempty),
Text,
readFile,
void,
($),
)
import Data.Aeson qualified as Ae
import Database.SQLite.Simple qualified as SS
import Database.SQLite.Simple.QQ (sql)
import Language.GraphQL.Class (gql)
import Language.GraphQL.JSON (graphql)
import System.Directory (makeAbsolute)
import System.FilePath ((</>))
import Test.Hspec (Spec, describe, it, shouldBe)
import AirGQL.GraphQL (getDerivedSchema)
import AirGQL.Lib (getEnrichedTables, insertOnly, writeOnly)
import AirGQL.Raw (raw)
import AirGQL.Types.SchemaConf (SchemaConf (accessMode), defaultSchemaConf)
import AirGQL.Utils (withRetryConn)
import Tests.Utils (dbPath, fixtureDbId, rmSpaces, testRoot, unorderedShouldBe, withTestDbConn)
main :: Spec
main = void $ do
describe "Query" $ do
it "supports a minimal introspection query" $ do
let
introspectionQuery :: Text
introspectionQuery =
[gql|
query IntrospectionQuery {
__schema {
queryType { name }
}
}
|]
expected =
rmSpaces
[raw|
{
"data": {
"__schema": {
"queryType": {
"name": "Query"
}
}
}
}
|]
conn <- SS.open dbPath
Right tables <- getEnrichedTables conn
schema <- getDerivedSchema defaultSchemaConf conn fixtureDbId tables
Right result <- graphql schema Nothing mempty introspectionQuery
Ae.encode result `shouldBe` expected
it "supports an optional filter argument" $ do
let
introspectionQuery :: Text
introspectionQuery =
[gql|
query IntrospectionQuery {
__schema {
queryType {
name
fields {
name
args {
name
type {
name
}
}
}
}
}
}
|]
expected =
rmSpaces
[raw|{
"data": {
"__schema": {
"queryType": {
"name": "Query",
"fields": [
{
"name": "users",
"args": [
{ "name": "where",
"type": { "name": "users_filter" }
},
{ "name": "order_by",
"type": { "name": null }
},
{ "name": "limit",
"type": { "name": "Int" }
},
{ "name": "offset",
"type": { "name": "Int" }
}
]
},
{
"name": "songs",
"args": [
{ "name": "where",
"type": { "name": "songs_filter" }
},
{ "name": "order_by",
"type": { "name": null }
},
{ "name": "limit",
"type": { "name": "Int" }
},
{ "name": "offset",
"type": { "name": "Int" }
}
]
},
{
"name": "users_by_pk",
"args": [
{ "name": "email",
"type": { "name": null }
}
]
},
{
"name": "songs_by_pk",
"args": [
{ "name": "rowid",
"type": { "name": null }
}
]
}
]
}
}
}
}|]
conn <- SS.open dbPath
Right tables <- getEnrichedTables conn
schema <- getDerivedSchema defaultSchemaConf conn fixtureDbId tables
Right result <- graphql schema Nothing mempty introspectionQuery
Ae.encode result `shouldBe` expected
it "doesn't allow writeonly tokens to read data" $ do
let
introspectionQuery :: Text
introspectionQuery =
[gql|
query IntrospectionQuery {
__schema {
queryType { name }
}
}
|]
expected =
rmSpaces
[raw|
{
"data": null,
"errors": [{
"locations": [{ "column":3, "line":2 }],
"message": "user error (Cannot read field using the provided token)",
"path": ["__schema"]
}]
}
|]
schema <- withRetryConn dbPath $ \conn -> do
Right tables <- getEnrichedTables conn
getDerivedSchema
defaultSchemaConf{accessMode = writeOnly}
conn
fixtureDbId
tables
Right response <-
graphql schema Nothing mempty introspectionQuery
Ae.encode response `shouldBe` expected
describe "Mutation" $ do
it "supports introspection queries" $ do
let
introspectionQuery :: Text
introspectionQuery =
[gql|
query IntrospectionQuery {
__schema {
mutationType {
name
fields {
name
args {
name
}
}
}
}
}
|]
expected =
[raw|
{
"data": {
"__schema": {
"mutationType": {
"name": "Mutation",
"fields": [
{
"name": "insert_users",
"args": [ { "name": "objects" }, { "name": "on_conflict" } ]
},
{
"name": "update_users",
"args": [
{ "name": "where" },
{ "name": "_set" }
]
},
{
"name": "update_users_by_pk",
"args": [
{ "name": "email" },
{ "name": "_set" }
]
},
{
"name": "delete_users",
"args": [ { "name": "where" } ]
},
{
"name": "delete_users_by_pk",
"args": [ { "name": "email" } ]
},
{
"name": "insert_songs",
"args": [ { "name": "objects" }, { "name": "on_conflict" } ]
},
{
"name": "update_songs",
"args": [
{ "name": "where" },
{ "name": "_set" }
]
},
{
"name": "update_songs_by_pk",
"args": [
{ "name": "rowid" },
{ "name": "_set" }
]
},
{
"name": "delete_songs",
"args": [ { "name": "where" } ]
},
{
"name": "delete_songs_by_pk",
"args": [ { "name": "rowid" } ]
}
]
}
}
}
}
|]
conn <- SS.open dbPath
Right tables <- getEnrichedTables conn
schema <- getDerivedSchema defaultSchemaConf conn fixtureDbId tables
Right result <- graphql schema Nothing mempty introspectionQuery
result `unorderedShouldBe` expected
it "supports __typename on root query" $ do
let
introspectionQuery =
[gql|
query TypeName {
__typename
}
|]
expected =
rmSpaces
[raw|
{
"data": {
"__typename" : "Query"
}
}
|]
conn <- SS.open dbPath
Right tables <- getEnrichedTables conn
schema <- getDerivedSchema defaultSchemaConf conn fixtureDbId tables
Right result <- graphql schema Nothing mempty introspectionQuery
Ae.encode result `shouldBe` expected
it "returns fields for {query,mutation,subscription}Type" $ do
let
introspectionQuery =
[gql|
query {
__schema {
queryType { fields { name } }
mutationType { fields { name } }
subscriptionType { fields { name } }
}
}
|]
expected =
[raw|
{
"data": {
"__schema": {
"queryType": {
"fields": [
{ "name": "users" },
{ "name": "songs" },
{ "name": "users_by_pk" },
{ "name": "songs_by_pk" }
]
},
"subscriptionType": null,
"mutationType": {
"fields": [
{ "name": "insert_users" },
{ "name": "update_users" },
{ "name": "delete_users" },
{ "name": "insert_songs" },
{ "name": "update_songs" },
{ "name": "delete_songs" },
{ "name": "update_users_by_pk" },
{ "name": "delete_users_by_pk" },
{ "name": "update_songs_by_pk" },
{ "name": "delete_songs_by_pk" }
]
}
}
}
}
|]
conn <- SS.open dbPath
Right tables <- getEnrichedTables conn
schema <- getDerivedSchema defaultSchemaConf conn fixtureDbId tables
Right result <- graphql schema Nothing mempty introspectionQuery
result `unorderedShouldBe` expected
it "supports __typename fields" $ do
let
introspectionQuery =
[gql|
query UsersTypeName {
users {
__typename
}
}
|]
expected =
rmSpaces
[raw|
{
"data": {
"users": [
{ "__typename" : "users_row" }
]
}
}
|]
conn <- SS.open dbPath
SS.execute_
conn
[sql|
insert into users (name, email, created_utc)
values ('John', 'john@example.com', '2022-01-01T00:00Z')
|]
Right tables <- getEnrichedTables conn
schema <- getDerivedSchema defaultSchemaConf conn fixtureDbId tables
Right result <- graphql schema Nothing mempty introspectionQuery
Ae.encode result `shouldBe` expected
it "returns types" $ do
let
introspectionQuery =
[gql|
query {
__schema {
types {
kind
name
}
}
}
|]
expected =
[raw|
{
"data": {
"__schema": {
"types": [
{ "kind": "OBJECT", "name": "users_row" },
{ "kind": "OBJECT", "name": "users_mutation_response" },
{ "kind": "OBJECT", "name": "users_mutation_by_pk_response" },
{ "kind": "INPUT_OBJECT", "name": "users_insert_input" },
{ "kind": "ENUM", "name": "users_column" },
{ "kind": "INPUT_OBJECT", "name": "users_upsert_on_conflict" },
{ "kind": "INPUT_OBJECT", "name": "users_set_input" },
{ "kind": "INPUT_OBJECT", "name": "users_filter" },
{ "kind": "INPUT_OBJECT", "name": "users_order_by" },
{ "kind": "OBJECT", "name": "songs_row" },
{ "kind": "OBJECT", "name": "songs_mutation_response" },
{ "kind": "OBJECT", "name": "songs_mutation_by_pk_response" },
{ "kind": "INPUT_OBJECT", "name": "songs_insert_input" },
{ "kind": "ENUM", "name": "songs_column" },
{ "kind": "INPUT_OBJECT", "name": "songs_upsert_on_conflict" },
{ "kind": "INPUT_OBJECT", "name": "songs_set_input" },
{ "kind": "INPUT_OBJECT", "name": "songs_filter" },
{ "kind": "INPUT_OBJECT", "name": "songs_order_by" },
{ "kind": "INPUT_OBJECT", "name": "IntComparison" },
{ "kind": "INPUT_OBJECT", "name": "FloatComparison" },
{ "kind": "INPUT_OBJECT", "name": "StringComparison" },
{ "kind": "ENUM", "name": "OrderingTerm" },
{ "kind": "OBJECT", "name": "Query" },
{ "kind": "OBJECT", "name": "Mutation" },
{ "kind": "SCALAR", "name": "Boolean" },
{ "kind": "SCALAR", "name": "Int" },
{ "kind": "SCALAR", "name": "Float" },
{ "kind": "SCALAR", "name": "String" },
{ "kind": "SCALAR", "name": "ID" },
{ "kind": "OBJECT", "name": "__Schema" },
{ "kind": "OBJECT", "name": "__Type" },
{ "kind": "ENUM", "name": "__TypeKind" },
{ "kind": "OBJECT", "name": "__Field" },
{ "kind": "OBJECT", "name": "__InputValue" },
{ "kind": "OBJECT", "name": "__EnumValue" },
{ "kind": "OBJECT", "name": "__Directive" },
{ "kind": "ENUM", "name": "__DirectiveLocation" }
]
}
}
}
|]
conn <- SS.open dbPath
Right tables <- getEnrichedTables conn
schema <- getDerivedSchema defaultSchemaConf conn fixtureDbId tables
Right result <- graphql schema Nothing mempty introspectionQuery
result `unorderedShouldBe` expected
it "returns directives on __schema" $ do
let
introspectionQuery :: Text =
[gql|
query UsersTypeName {
__schema {
directives {
name
description
locations
args {
name
description
defaultValue
type { ...TypeRef }
}
}
}
}
fragment TypeRef on __Type {
kind
name
ofType {
kind
name
ofType {
kind
name
ofType {
kind
name
ofType {
kind
name
ofType {
kind
name
ofType {
kind
name
ofType {
kind
name
}
}
}
}
}
}
}
}
|]
expected =
rmSpaces
[raw|
{
"data": {
"__schema": {
"directives": [
{
"name": "skip",
"args": [
{
"name": "if",
"defaultValue": null,
"type": {
"kind": "NON_NULL",
"name": null,
"ofType": {
"kind":"SCALAR",
"name":"Boolean",
"ofType":null
}
},
"description": "Skipped when true."
}
],
"locations": [
"INLINE_FRAGMENT",
"FRAGMENT_SPREAD",
"FIELD"
],
"description": "Directs the executor to skip this field or fragment when the `if` argument is true."
},
{
"name": "include",
"args": [
{
"name": "if",
"defaultValue": null,
"type": {
"kind": "NON_NULL",
"name": null,
"ofType": {
"kind":"SCALAR",
"name":"Boolean",
"ofType":null
}
},
"description": "Included when true."
}
],
"locations": [
"INLINE_FRAGMENT",
"FRAGMENT_SPREAD",
"FIELD"
],
"description":
"Directs the executor to include this field or fragment only when the `if` argument is true."
}
]
}
}
}
|]
conn <- SS.open dbPath
Right tables <- getEnrichedTables conn
schema <- getDerivedSchema defaultSchemaConf conn fixtureDbId tables
Right result <- graphql schema Nothing mempty introspectionQuery
Ae.encode result `shouldBe` expected
it "supports a full introspection query" $ do
gqlFile <- makeAbsolute $ testRoot </> "introspection_query.gql"
introspectionQuery <- readFile gqlFile
jsonFile <- makeAbsolute $ testRoot </> "introspection_result.json"
expected <- readFile jsonFile
conn <- SS.open dbPath
Right tables <- getEnrichedTables conn
schema <- getDerivedSchema defaultSchemaConf conn fixtureDbId tables
Right result <- graphql schema Nothing mempty introspectionQuery
-- Uncomment to write the new file to disk (for easier diffing)
-- P.writeFile (testRoot </> "new_introspection_result.json") $
-- P.decodeUtf8 $
-- BL.toStrict $
-- Ae.encode result
result `unorderedShouldBe` expected
it "doesn't allow writeonly tokens to return data" $ do
let dbName = "no-writeonly-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(filter: { id: { eq: 0 }}, set: { id: 0 }) {
returning { id }
}
}
|]
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
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
[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"
withTestDbConn dbName $ \conn -> do
SS.execute_ conn [sql| CREATE TABLE foo (id INT) |]
SS.execute_ conn [sql| CREATE TABLE foo_by_pk (id INT) |]
SS.execute_ conn [sql| CREATE TABLE foo_by_pk_ (id INT) |]
let
introspectionQuery =
[gql|
query {
__schema {
queryType { fields { name } }
}
}
|]
expected =
[raw|
{
"data": {
"__schema": {
"queryType": {
"fields": [
{ "name": "foo" },
{ "name": "foo_by_pk" },
{ "name": "foo_by_pk_" },
{ "name": "foo_by_pk__" },
{ "name": "foo_by_pk_by_pk" },
{ "name": "foo_by_pk__by_pk" }
]
}
}
}
}
|]
Right tables <- getEnrichedTables conn
schema <- getDerivedSchema defaultSchemaConf conn fixtureDbId tables
Right result <- graphql schema Nothing mempty introspectionQuery
result `unorderedShouldBe` expected
it "appends _ at the end of argument names to avoid conflicts" $ do
let dbName = "by-pk-arg-names.db"
withTestDbConn dbName $ \conn -> do
SS.execute_ conn [sql| CREATE TABLE foo ("_set" INT PRIMARY KEY) |]
let
introspectionQuery =
[gql|
query {
__schema {
mutationType { fields { name, args { name } } }
}
}
|]
expected =
[raw|
{
"data": {
"__schema": {
"mutationType": {
"fields": [
{
"name": "insert_foo",
"args": [
{ "name": "objects" },
{ "name": "on_conflict" }
]
},
{
"name": "update_foo",
"args": [
{ "name": "_set" },
{ "name": "where" }
]
},
{
"name": "update_foo_by_pk",
"args": [
{ "name": "_set" },
{ "name": "_set_" }
]
},
{
"name": "delete_foo",
"args": [{ "name": "where" }]
},
{
"name": "delete_foo_by_pk",
"args": [{ "name": "_set" }]
}
]
}
}
}
}
|]
Right tables <- getEnrichedTables conn
schema <- getDerivedSchema defaultSchemaConf conn fixtureDbId tables
Right result <- graphql schema Nothing mempty introspectionQuery
result `unorderedShouldBe` expected