ddd/airgql
ddd/airgql
1
Fork 0
mirror of https://github.com/Airsequel/AirGQL.git synced 2025-09-18 19:34:32 +02:00
Code Activity

Add tests for _by_pk queries

Browse source
This commit is contained in:
prescientmoon 2024-11-15 14:34:36 +01:00
commit 768b711a6f
3 changed files with 860 additions and 721 deletions
source/AirGQL
Lib.hs
tests
Spec.hs
Tests
QuerySpec.hs

5
source/AirGQL/Lib.hs
View file

@ -738,7 +738,10 @@ lintTable allEntries parsed =
CreateTable names _ _ CreateTable names _ _
| Just name <- getFirstName (Just names) | Just name <- getFirstName (Just names)
, "_by_pk" `isInfixOf` name -> , "_by_pk" `isInfixOf` name ->
pure "Table names cannot contain \"_by_pk\"" pure $
"Table names shouldn't contain \"_by_pk\", yet \""
<> name
<> "\" does"
_ -> [] _ -> []
in in
rowidReferenceWarnings <> withoutRowidWarning <> illegalName rowidReferenceWarnings <> withoutRowidWarning <> illegalName

738
tests/Spec.hs
View file

@ -15,7 +15,6 @@ import Protolude (
Maybe (Just, Nothing), Maybe (Just, Nothing),
Monoid (mempty), Monoid (mempty),
fromMaybe, fromMaybe,
show,
($), ($),
(&), (&),
(<>), (<>),
@ -27,7 +26,6 @@ import Data.Aeson qualified as Ae
import Data.Aeson.KeyMap qualified as KeyMap import Data.Aeson.KeyMap qualified as KeyMap
import Data.Aeson.Types (Object) import Data.Aeson.Types (Object)
import Data.List qualified as List import Data.List qualified as List
import Data.Text (pack)
import Data.Text qualified as T import Data.Text qualified as T
import Database.SQLite.Simple ( import Database.SQLite.Simple (
Query, Query,
@ -107,11 +105,11 @@ import AirGQL.Utils (
withRetryConn, withRetryConn,
) )
import Tests.IntrospectionSpec qualified import Tests.IntrospectionSpec qualified
import Tests.QuerySpec qualified
import Tests.Utils ( import Tests.Utils (
dbPath, dbPath,
fixtureDbId, fixtureDbId,
rmSpaces, rmSpaces,
shouldSaveDbs,
testRoot, testRoot,
unorderedShouldBe, unorderedShouldBe,
withDataDbConn, withDataDbConn,
@ -669,6 +667,22 @@ testSuite = do
result.errors `shouldBe` [expectedMessage] result.errors `shouldBe` [expectedMessage]
it "should not allow '_by_pk' in table names" $ do
let dbId = "api-sql-by-pk-name"
let query = "CREATE TABLE foo_by_pk ( bar TEXT )"
withDataDbConn dbId $ \_ -> do
Right result <-
runHandler $
sqlQueryPostHandler
PragmaConf.defaultConf
("_TEST_" <> dbId)
SQLPost{query = query}
let expectedMessage =
[raw|Table names shouldn't contain "_by_pk", yet "foo_by_pk" does|]
result.errors `shouldBe` [expectedMessage]
it "should return no affected tables on a simple select" $ do it "should return no affected tables on a simple select" $ do
let dbId = "api-sql-simple-select" let dbId = "api-sql-simple-select"
withDataDbConn dbId $ \conn -> do withDataDbConn dbId $ \conn -> do
@ -760,723 +774,6 @@ testSuite = do
result.affectedTables `shouldMatchList` ["notes", "todos"] result.affectedTables `shouldMatchList` ["notes", "todos"]
describe "Queries" $ do
it "supports retrieving data" $ do
conn <- SS.open dbPath
execute_
conn
[sql|
insert into users (name, email, created_utc)
values ('Adrian', 'adrian@example.com', '2021-01-01T00:00Z')
|]
Right tables <- getEnrichedTables conn
schema <-
getDerivedSchema
defaultSchemaConf
conn
fixtureDbId
tables
Right result <- graphql schema Nothing mempty "{ users { name } }"
Ae.encode result
`shouldBe` [gql|
{"data":{"users":[{"name":"Adrian"}]}}
|]
it "supports retrieving data from tables with special names" $ do
let testDbPath = testRoot </> "special_table_name.db"
removeIfExists testDbPath
let dbPathNorm = if shouldSaveDbs then testDbPath else ":memory:"
withRetryConn dbPathNorm $ \conn -> do
execute_
conn
[sql|
CREATE TABLE "name with-special$chars" (
name TEXT
)
|]
execute_
conn
[sql|
INSERT INTO "name with-special$chars" (name)
VALUES ('John')
|]
Right tables <- getEnrichedTables conn
schema <-
getDerivedSchema
defaultSchemaConf
conn
fixtureDbId
tables
Right result <-
graphql
schema
Nothing
mempty
"{ nameXX0withXXDspecialXX4chars { name } }"
Ae.encode result
`shouldBe` [gql|
{"data":{"nameXX0withXXDspecialXX4chars":[{"name":"John"}]}}
|]
describe "column names with special characters" $ do
let
dbPathSpaces :: FilePath = testRoot </> "spaces-test.db"
setupDatabaseSpaces = do
removeIfExists dbPathSpaces
conn <- open dbPathSpaces
execute_
conn
[sql|
CREATE TABLE IF NOT EXISTS test_entries (
id INTEGER PRIMARY KEY,
`column with spaces` TEXT
)
|]
execute_
conn
[sql|
INSERT INTO test_entries (id, `column with spaces`)
VALUES (0, 'Just a test')
|]
before_ setupDatabaseSpaces $ it "supports column names with spaces" $ do
conn <- open dbPathSpaces
Right tables <- getEnrichedTables conn
schema <-
getDerivedSchema
defaultSchemaConf
conn
(pack dbPathSpaces)
tables
Right result <-
graphql
schema
Nothing
mempty
"{ test_entries { columnXX0withXX0spaces } }"
Ae.encode result
`shouldBe` rmSpaces
[raw|
{ "data": {
"test_entries": [
{ "columnXX0withXX0spaces": "Just a test" }
]
}}
|]
before_ setupDatabaseSpaces $
it "generates introspection schema for column names with spaces" $
do
conn <- open dbPathSpaces
Right tables <- getEnrichedTables conn
schema <- getDerivedSchema defaultSchemaConf conn fixtureDbId tables
Right result <-
graphql
schema
Nothing
mempty
"{ __schema{ types { name fields { name } } } } }"
show (Ae.encode result) `shouldContain` "columnXX0withXX0spaces"
it "avoids column name remapping collisions" $ do
let dbPathSpaces = testRoot </> "spaces-collision-test.db"
removeIfExists dbPathSpaces
conn <- open dbPathSpaces
execute_
conn
[sql|
CREATE TABLE IF NOT EXISTS test_entries (
id INTEGER PRIMARY KEY,
`the column` TEXT,
`the_column` TEXT,
`the_column_1` TEXT,
`the_column_2` TEXT
)
|]
execute_
conn
[sql|
INSERT INTO test_entries
(id, `the column`, the_column, the_column_1, the_column_2)
VALUES
(0, 'with spaces', 'no spaces', 'no spaces 1', 'no spaces 2')
|]
Right tables <- getEnrichedTables conn
schema <- getDerivedSchema defaultSchemaConf conn fixtureDbId tables
Right result <-
graphql
schema
Nothing
mempty
[gql|
{ test_entries {
theXX0column
the_column
the_column_1
the_column_2
}
}
|]
Ae.encode result
`shouldBe` rmSpaces
[raw|
{ "data": {
"test_entries": [
{ "theXX0column": "with spaces",
"the_column": "no spaces",
"the_column_1": "no spaces 1",
"the_column_2": "no spaces 2"
}
]
}}
|]
it "includes rowid and sorts by rowid" $ do
let dbPathSpaces = testRoot </> "rowid_test.db"
removeIfExists dbPathSpaces
conn <- open dbPathSpaces
execute_
conn
[sql|
CREATE TABLE IF NOT EXISTS "users" (
"email" TEXT NOT NULL UNIQUE PRIMARY KEY,
"number_of_logins" INTEGER
);
|]
execute_
conn
[sql|
INSERT INTO users (email, number_of_logins)
VALUES ('john@example.com', 0), ('eve@example.com', 4);
|]
Right tables <- getEnrichedTables conn
schema <- getDerivedSchema defaultSchemaConf conn fixtureDbId tables
Right result <-
graphql
schema
Nothing
mempty
[gql|
{
users {
rowid
}
}
|]
Ae.encode result
`shouldBe` rmSpaces
[raw|
{
"data": {
"users": [
{ "rowid": 1 },
{ "rowid": 2 }
]
}
}
|]
it "supports aliases" $ do
conn <- open dbPath
execute_
conn
[sql|
insert into users (name, email, created_utc)
values ('Adrian', 'adrian@example.com', '2021-01-01T00:00Z')
|]
let
query =
[gql|
{
userA: users { name }
userB: users { email }
}
|]
expected =
rmSpaces
[raw|
{"data":{
"userB":[{"email":"adrian@example.com"}],
"userA":[{"name":"Adrian"}]
}}
|]
Right tables <- getEnrichedTables conn
schema <- getDerivedSchema defaultSchemaConf conn fixtureDbId tables
Right result <- graphql schema Nothing mempty query
Ae.encode result `shouldBe` expected
it "supports fragments" $ do
conn <- SS.open dbPath
execute_
conn
[sql|
insert into users (name, email, created_utc)
values ('Adrian', 'adrian@example.com', '2021-01-01T00:00Z')
|]
let
query =
[gql|
{
userA: users { ...basicFields }
userB: users { ...basicFields }
}
fragment basicFields on users_row {
name
email
}
|]
expected =
rmSpaces
[raw|
{ "data": {
"userB":[{"email":"adrian@example.com","name":"Adrian"}],
"userA":[{"email":"adrian@example.com","name":"Adrian"}]
}}
|]
Right tables <- getEnrichedTables conn
schema <- getDerivedSchema defaultSchemaConf conn fixtureDbId tables
Right result <- graphql schema Nothing mempty query
Ae.encode result `shouldBe` expected
it "supports directives" $ do
conn <- SS.open dbPath
execute_
conn
[sql|
insert into users (name, email, created_utc)
values
('John', 'john@example.com', '2021-01-01T00:00Z'),
('Eve', 'eve@example.com', '2019-01-01T00:00Z')
|]
let
query =
[gql|
query DirectiveTest ($withName: Boolean!) {
users {
name @include(if: $withName)
}
}
|]
variables :: Object
variables =
fromMaybe mempty $ Ae.decode "{ \"withName\": true }"
expected =
rmSpaces
[raw|
{ "data": {
"users": [
{ "name": "John" },
{ "name": "Eve" }
]
}}
|]
Right tables <- getEnrichedTables conn
schema <- getDerivedSchema defaultSchemaConf conn fixtureDbId tables
Right result <- graphql schema Nothing variables query
Ae.encode result `shouldBe` expected
it "supports retrieving records with a filter" $ do
conn <- SS.open dbPath
execute_
conn
[sql|
insert into users (name, email, created_utc)
values
('John', 'john@example.com', '2021-01-01T00:00Z'),
('Eve', 'eve@example.com', '2019-01-01T00:00Z')
|]
Right tables <- getEnrichedTables conn
schema <- getDerivedSchema defaultSchemaConf conn fixtureDbId tables
Right result <-
graphql
schema
Nothing
mempty
[gql|
{
users (filter: {email: {eq: "eve@example.com"}}) {
name
}
}
|]
Ae.encode result
`shouldBe` "{\"data\":{\"users\":[{\"name\":\"Eve\"}]}}"
it "supports retrieving records with a filter over int and float" $ do
conn <- SS.open dbPath
execute_
conn
[sql|
insert into users (name, email, created_utc, progress)
values
('John', 'john@example.com', '2021-01-01T00:00Z', 0.7),
('Eve', 'eve@example.com', '2019-01-01T00:00Z', 0.4)
|]
Right tables <- getEnrichedTables conn
schema <- getDerivedSchema defaultSchemaConf conn fixtureDbId tables
Right result1 <-
graphql
schema
Nothing
mempty
[gql|{
users (filter: {rowid: {eq: 2}}) {
name
}
}|]
Ae.encode result1
`shouldBe` "{\"data\":{\"users\":[{\"name\":\"Eve\"}]}}"
Right result2 <-
graphql
schema
Nothing
mempty
[gql|{
users (filter: {progress: {eq: 0.4}}) {
name
}
}|]
Ae.encode result2
`shouldBe` "{\"data\":{\"users\":[{\"name\":\"Eve\"}]}}"
it "supports retrieving records with a filter over boolean and null" $ do
let dbPathFilter = testRoot </> "filter_eq_boolean.db"
removeIfExists dbPathFilter
conn <- open dbPathFilter
execute_
conn
[sql|
CREATE TABLE IF NOT EXISTS "users" (
"name" TEXT,
"is_admin" BOOLEAN
);
|]
execute_
conn
[sql|
INSERT INTO USERS (name, is_admin)
VALUES
('John', TRUE),
('Eve', FALSE),
('Anna', NULL)
|]
Right tables <- getEnrichedTables conn
schema <- getDerivedSchema defaultSchemaConf conn fixtureDbId tables
Right result1 <-
graphql
schema
Nothing
mempty
[gql|{
users (filter: {is_admin: {eq: false}}) {
name
}
}|]
Ae.encode result1
`shouldBe` "{\"data\":{\"users\":[{\"name\":\"Eve\"}]}}"
Right result2 <-
graphql
schema
Nothing
mempty
[gql|{
users (filter: {is_admin: {eq: null}}) {
name
}
}|]
Ae.encode result2
`shouldBe` "{\"data\":{\"users\":[{\"name\":\"Anna\"}]}}"
it "supports retrieving records with like and ilike filter" $ do
withRetryConn dbPath $ \conn -> do
execute_
conn
[sql|
insert into users (name, email, created_utc)
values
('John', 'john@example.com', '2021-01-01T00:00Z'),
('Anna', 'anna@EXAMPLE.COM', '2019-01-01T00:00Z'),
('Eve', 'eve@evil.com', '2019-01-01T00:00Z')
|]
Right tables <- getEnrichedTables conn
schema <- getDerivedSchema defaultSchemaConf conn fixtureDbId tables
Right likeResult <-
graphql
schema
Nothing
mempty
[gql|
{
users (filter: {email: {like: "%example%"}}) {
name
}
}
|]
Ae.encode likeResult
`shouldBe` "{\"data\":{\"users\":[{\"name\":\"John\"}]}}"
Right ilikeResult <-
graphql
schema
Nothing
mempty
[gql|
{
users (filter: {email: {ilike: "%example%"}}) {
name
}
}
|]
Ae.encode ilikeResult
`shouldBe` "{\"data\":{\"users\":\
\[{\"name\":\"John\"},{\"name\":\"Anna\"}]}}"
it "supports retrieving records with several filters" $ do
withRetryConn dbPath $ \conn -> do
execute_
conn
[sql|
insert into users (name, email, created_utc)
values
('John', 'john@example.com', '2021-01-01T00:00Z'),
('Anna', 'anna@example.com', '2019-01-01T00:00Z'),
('Eve', 'eve@evil.com', '2019-01-01T00:00Z')
|]
Right tables <- getEnrichedTables conn
schema <- getDerivedSchema defaultSchemaConf conn fixtureDbId tables
Right likeResult <-
graphql
schema
Nothing
mempty
[gql|
{
users (
filter: {
email: { like: "%example%" },
name: { gt: "B" }
}
) {
name
}
}
|]
Ae.encode likeResult
`shouldBe` "{\"data\":{\"users\":[{\"name\":\"John\"}]}}"
it "supports mutating records with several filters" $ do
withRetryConn dbPath $ \conn -> do
execute_
conn
[sql|
insert into users (name, email, created_utc)
values
('John', 'john@example.com', '2021-01-01T00:00Z'),
('Anna', 'anna@example.com', '2019-01-01T00:00Z'),
('Eve', 'eve@evil.com', '2019-01-01T00:00Z')
|]
Right tables <- getEnrichedTables conn
schema <- getDerivedSchema defaultSchemaConf conn fixtureDbId tables
Right likeResult <-
graphql
schema
Nothing
mempty
[gql|
mutation UpdateEmailAddress {
update_users (
filter: {
email: { like: "%example%" }
name: { gt: "B" }
}
set: { email: "john@new.com" }
) {
affected_rows
returning {
email
}
}
}
|]
Ae.encode likeResult
`shouldBe` "{\"data\":{\"update_users\":\
\{\"affected_rows\":1,\
\\"returning\":[{\"email\":\"john@new.com\"}]}}}"
it "supports retrieving multi-type columns" $ do
withTestDbConn "multi-type_columns.db" $ \conn -> do
execute_
conn
[sql|
CREATE VIEW "multi_type_column" AS
SELECT 1 AS col UNION
SELECT 2.2 AS col UNION
SELECT 'three' AS col UNION
SELECT NULL AS col
|]
Right tables <- getEnrichedTables conn
schema <- getDerivedSchema defaultSchemaConf conn fixtureDbId tables
Right result1 <-
graphql
schema
Nothing
mempty
[gql|{
multi_type_column { col }
}|]
let expected =
rmSpaces
[raw|
{
"data": {
"multi_type_column": [
{ "col": null },
{ "col": "1" },
{ "col": "2.2" },
{ "col": "three" }
]
}
}
|]
Ae.encode result1 `shouldBe` expected
it "supports querying a single entry" $ do
conn <- SS.open dbPath
execute_
conn
[sql|
insert into users (name, email, created_utc)
values
('John', 'john@example.com', '2021-01-01T00:00Z'),
('Eve', 'eve@example.com', '2019-01-01T00:00Z')
|]
Right tables <- getEnrichedTables conn
schema <- getDerivedSchema defaultSchemaConf conn fixtureDbId tables
Right result <-
graphql
schema
Nothing
mempty
[gql|
{
users_by_pk (email: "eve@example.com") {
name
}
}
|]
pendingWith "Not implemented yet"
Ae.encode result
`shouldBe` "{\"data\":{\"users\":[{\"name\":\"Eve\"}]}}"
it "errors out on integer overflows" $ do
withTestDbConn "integer-overflows.db" $ \conn -> do
execute_
conn
[sql|
CREATE TABLE test (
big INTEGER,
alsobig INTEGER
)
|]
execute_
conn
[sql|
INSERT INTO test(big, alsobig)
VALUES (8000000000, 9000000000)
|]
Right tables <- getEnrichedTables conn
schema <- getDerivedSchema defaultSchemaConf conn fixtureDbId tables
Right result <-
graphql
schema
Nothing
mempty
[gql|
{
test {
big,
alsobig
}
}
|]
let expected =
rmSpaces
[raw|
{
"data": null,
"errors": [{
"locations": [{
"column": 3,
"line": 2
}],
"message":
"user error (Multiple errors occurred:\nOn column \"big\": Integer 8000000000 would overflow. This happens because SQLite uses 64-bit ints, but GraphQL uses 32-bit ints. Use a Number (64-bit float) or Text column instead.\nOn column \"alsobig\": Integer 9000000000 would overflow. This happens because SQLite uses 64-bit ints, but GraphQL uses 32-bit ints. Use a Number (64-bit float) or Text column instead.\n)",
"path": ["test"]
}]
}
|]
Ae.encode result `shouldBe` expected
describe "Mutations" $ do describe "Mutations" $ do
it "supports inserting data" $ do it "supports inserting data" $ do
let let
@ -2663,6 +1960,7 @@ testSuite = do
Ae.encode result `shouldBe` expected Ae.encode result `shouldBe` expected
describe "Query" Tests.QuerySpec.main
describe "Introspection" Tests.IntrospectionSpec.main describe "Introspection" Tests.IntrospectionSpec.main

838
tests/Tests/QuerySpec.hs Normal file
View file

@ -0,0 +1,838 @@
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE NoMonomorphismRestriction #-}
{-# OPTIONS_GHC -Wno-missing-local-signatures #-}
module Tests.QuerySpec (main) where
import Protolude (
Either (Right),
FilePath,
Maybe (Nothing),
Monoid (mempty),
bracket_,
finally,
flip,
fromMaybe,
show,
void,
($),
)
import Data.Aeson qualified as Ae
import Database.SQLite.Simple qualified as SS
import Database.SQLite.Simple.QQ (sql)
import Language.GraphQL.JSON (graphql)
import Language.GraphQL.TH (gql)
import System.FilePath ((</>))
import Test.Hspec (Spec, before_, describe, it, pendingWith, shouldBe, shouldContain)
import AirGQL.GraphQL (getDerivedSchema)
import AirGQL.Lib (getEnrichedTables)
import AirGQL.Raw (raw)
import AirGQL.Types.SchemaConf (defaultSchemaConf)
import AirGQL.Utils (removeIfExists, withRetryConn)
import Data.Text qualified as T
import Tests.Utils (dbPath, fixtureDbId, rmSpaces, shouldSaveDbs, testRoot, unorderedShouldBe, withTestDbConn)
main :: Spec
main = void $ do
it "supports retrieving data" $ do
conn <- SS.open dbPath
SS.execute_
conn
[sql|
insert into users (name, email, created_utc)
values ('Adrian', 'adrian@example.com', '2021-01-01T00:00Z')
|]
Right tables <- getEnrichedTables conn
schema <-
getDerivedSchema
defaultSchemaConf
conn
fixtureDbId
tables
Right result <- graphql schema Nothing mempty "{ users { name } }"
Ae.encode result
`shouldBe` [gql|
{"data":{"users":[{"name":"Adrian"}]}}
|]
it "supports retrieving data from tables with special names" $ do
let testDbPath = testRoot </> "special_table_name.db"
removeIfExists testDbPath
let dbPathNorm = if shouldSaveDbs then testDbPath else ":memory:"
withRetryConn dbPathNorm $ \conn -> do
SS.execute_
conn
[sql|
CREATE TABLE "name with-special$chars" (
name TEXT
)
|]
SS.execute_
conn
[sql|
INSERT INTO "name with-special$chars" (name)
VALUES ('John')
|]
Right tables <- getEnrichedTables conn
schema <-
getDerivedSchema
defaultSchemaConf
conn
fixtureDbId
tables
Right result <-
graphql
schema
Nothing
mempty
"{ nameXX0withXXDspecialXX4chars { name } }"
Ae.encode result
`shouldBe` [gql|
{"data":{"nameXX0withXXDspecialXX4chars":[{"name":"John"}]}}
|]
describe "column names with special characters" $ do
let
dbPathSpaces :: FilePath = testRoot </> "spaces-test.db"
setupDatabaseSpaces = do
removeIfExists dbPathSpaces
conn <- SS.open dbPathSpaces
SS.execute_
conn
[sql|
CREATE TABLE IF NOT EXISTS test_entries (
id INTEGER PRIMARY KEY,
`column with spaces` TEXT
)
|]
SS.execute_
conn
[sql|
INSERT INTO test_entries (id, `column with spaces`)
VALUES (0, 'Just a test')
|]
before_ setupDatabaseSpaces $ it "supports column names with spaces" $ do
conn <- SS.open dbPathSpaces
Right tables <- getEnrichedTables conn
schema <-
getDerivedSchema
defaultSchemaConf
conn
(T.pack dbPathSpaces)
tables
Right result <-
graphql
schema
Nothing
mempty
"{ test_entries { columnXX0withXX0spaces } }"
Ae.encode result
`shouldBe` rmSpaces
[raw|
{ "data": {
"test_entries": [
{ "columnXX0withXX0spaces": "Just a test" }
]
}}
|]
before_ setupDatabaseSpaces $
it "generates introspection schema for column names with spaces" $ do
conn <- SS.open dbPathSpaces
Right tables <- getEnrichedTables conn
schema <- getDerivedSchema defaultSchemaConf conn fixtureDbId tables
Right result <-
graphql
schema
Nothing
mempty
"{ __schema{ types { name fields { name } } } } }"
show (Ae.encode result) `shouldContain` "columnXX0withXX0spaces"
it "avoids column name remapping collisions" $ do
let dbPathSpaces = testRoot </> "spaces-collision-test.db"
removeIfExists dbPathSpaces
conn <- SS.open dbPathSpaces
SS.execute_
conn
[sql|
CREATE TABLE IF NOT EXISTS test_entries (
id INTEGER PRIMARY KEY,
`the column` TEXT,
`the_column` TEXT,
`the_column_1` TEXT,
`the_column_2` TEXT
)
|]
SS.execute_
conn
[sql|
INSERT INTO test_entries
(id, `the column`, the_column, the_column_1, the_column_2)
VALUES
(0, 'with spaces', 'no spaces', 'no spaces 1', 'no spaces 2')
|]
Right tables <- getEnrichedTables conn
schema <- getDerivedSchema defaultSchemaConf conn fixtureDbId tables
Right result <-
graphql
schema
Nothing
mempty
[gql|
{ test_entries {
theXX0column
the_column
the_column_1
the_column_2
}
}
|]
Ae.encode result
`shouldBe` rmSpaces
[raw|
{ "data": {
"test_entries": [
{ "theXX0column": "with spaces",
"the_column": "no spaces",
"the_column_1": "no spaces 1",
"the_column_2": "no spaces 2"
}
]
}}
|]
it "includes rowid and sorts by rowid" $ do
let dbPathSpaces = testRoot </> "rowid_test.db"
removeIfExists dbPathSpaces
conn <- SS.open dbPathSpaces
SS.execute_
conn
[sql|
CREATE TABLE IF NOT EXISTS "users" (
"email" TEXT NOT NULL UNIQUE PRIMARY KEY,
"number_of_logins" INTEGER
);
|]
SS.execute_
conn
[sql|
INSERT INTO users (email, number_of_logins)
VALUES ('john@example.com', 0), ('eve@example.com', 4);
|]
Right tables <- getEnrichedTables conn
schema <- getDerivedSchema defaultSchemaConf conn fixtureDbId tables
Right result <-
graphql
schema
Nothing
mempty
[gql|
{
users {
rowid
}
}
|]
Ae.encode result
`shouldBe` rmSpaces
[raw|
{
"data": {
"users": [
{ "rowid": 1 },
{ "rowid": 2 }
]
}
}
|]
it "supports aliases" $ do
conn <- SS.open dbPath
SS.execute_
conn
[sql|
insert into users (name, email, created_utc)
values ('Adrian', 'adrian@example.com', '2021-01-01T00:00Z')
|]
let
query =
[gql|
{
userA: users { name }
userB: users { email }
}
|]
expected =
rmSpaces
[raw|
{"data":{
"userB":[{"email":"adrian@example.com"}],
"userA":[{"name":"Adrian"}]
}}
|]
Right tables <- getEnrichedTables conn
schema <- getDerivedSchema defaultSchemaConf conn fixtureDbId tables
Right result <- graphql schema Nothing mempty query
Ae.encode result `shouldBe` expected
it "supports fragments" $ do
conn <- SS.open dbPath
SS.execute_
conn
[sql|
insert into users (name, email, created_utc)
values ('Adrian', 'adrian@example.com', '2021-01-01T00:00Z')
|]
let
query =
[gql|
{
userA: users { ...basicFields }
userB: users { ...basicFields }
}
fragment basicFields on users_row {
name
email
}
|]
expected =
rmSpaces
[raw|
{ "data": {
"userB":[{"email":"adrian@example.com","name":"Adrian"}],
"userA":[{"email":"adrian@example.com","name":"Adrian"}]
}}
|]
Right tables <- getEnrichedTables conn
schema <- getDerivedSchema defaultSchemaConf conn fixtureDbId tables
Right result <- graphql schema Nothing mempty query
Ae.encode result `shouldBe` expected
it "supports directives" $ do
conn <- SS.open dbPath
SS.execute_
conn
[sql|
insert into users (name, email, created_utc)
values
('John', 'john@example.com', '2021-01-01T00:00Z'),
('Eve', 'eve@example.com', '2019-01-01T00:00Z')
|]
let
query =
[gql|
query DirectiveTest ($withName: Boolean!) {
users {
name @include(if: $withName)
}
}
|]
variables :: Ae.Object
variables =
fromMaybe mempty $ Ae.decode "{ \"withName\": true }"
expected =
rmSpaces
[raw|
{ "data": {
"users": [
{ "name": "John" },
{ "name": "Eve" }
]
}}
|]
Right tables <- getEnrichedTables conn
schema <- getDerivedSchema defaultSchemaConf conn fixtureDbId tables
Right result <- graphql schema Nothing variables query
Ae.encode result `shouldBe` expected
it "supports retrieving records with a filter" $ do
conn <- SS.open dbPath
SS.execute_
conn
[sql|
insert into users (name, email, created_utc)
values
('John', 'john@example.com', '2021-01-01T00:00Z'),
('Eve', 'eve@example.com', '2019-01-01T00:00Z')
|]
Right tables <- getEnrichedTables conn
schema <- getDerivedSchema defaultSchemaConf conn fixtureDbId tables
Right result <-
graphql
schema
Nothing
mempty
[gql|
{
users (filter: {email: {eq: "eve@example.com"}}) {
name
}
}
|]
Ae.encode result
`shouldBe` "{\"data\":{\"users\":[{\"name\":\"Eve\"}]}}"
it "supports retrieving records with a filter over int and float" $ do
conn <- SS.open dbPath
SS.execute_
conn
[sql|
insert into users (name, email, created_utc, progress)
values
('John', 'john@example.com', '2021-01-01T00:00Z', 0.7),
('Eve', 'eve@example.com', '2019-01-01T00:00Z', 0.4)
|]
Right tables <- getEnrichedTables conn
schema <- getDerivedSchema defaultSchemaConf conn fixtureDbId tables
Right result1 <-
graphql
schema
Nothing
mempty
[gql|{
users (filter: {rowid: {eq: 2}}) {
name
}
}|]
Ae.encode result1
`shouldBe` "{\"data\":{\"users\":[{\"name\":\"Eve\"}]}}"
Right result2 <-
graphql
schema
Nothing
mempty
[gql|{
users (filter: {progress: {eq: 0.4}}) {
name
}
}|]
Ae.encode result2
`shouldBe` "{\"data\":{\"users\":[{\"name\":\"Eve\"}]}}"
it "supports retrieving records with a filter over boolean and null" $ do
let dbPathFilter = testRoot </> "filter_eq_boolean.db"
removeIfExists dbPathFilter
conn <- SS.open dbPathFilter
SS.execute_
conn
[sql|
CREATE TABLE IF NOT EXISTS "users" (
"name" TEXT,
"is_admin" BOOLEAN
);
|]
SS.execute_
conn
[sql|
INSERT INTO USERS (name, is_admin)
VALUES
('John', TRUE),
('Eve', FALSE),
('Anna', NULL)
|]
Right tables <- getEnrichedTables conn
schema <- getDerivedSchema defaultSchemaConf conn fixtureDbId tables
Right result1 <-
graphql
schema
Nothing
mempty
[gql|{
users (filter: {is_admin: {eq: false}}) {
name
}
}|]
Ae.encode result1
`shouldBe` "{\"data\":{\"users\":[{\"name\":\"Eve\"}]}}"
Right result2 <-
graphql
schema
Nothing
mempty
[gql|{
users (filter: {is_admin: {eq: null}}) {
name
}
}|]
Ae.encode result2
`shouldBe` "{\"data\":{\"users\":[{\"name\":\"Anna\"}]}}"
it "supports retrieving records with like and ilike filter" $ do
withRetryConn dbPath $ \conn -> do
SS.execute_
conn
[sql|
insert into users (name, email, created_utc)
values
('John', 'john@example.com', '2021-01-01T00:00Z'),
('Anna', 'anna@EXAMPLE.COM', '2019-01-01T00:00Z'),
('Eve', 'eve@evil.com', '2019-01-01T00:00Z')
|]
Right tables <- getEnrichedTables conn
schema <- getDerivedSchema defaultSchemaConf conn fixtureDbId tables
Right likeResult <-
graphql
schema
Nothing
mempty
[gql|
{
users (filter: {email: {like: "%example%"}}) {
name
}
}
|]
Ae.encode likeResult
`shouldBe` "{\"data\":{\"users\":[{\"name\":\"John\"}]}}"
Right ilikeResult <-
graphql
schema
Nothing
mempty
[gql|
{
users (filter: {email: {ilike: "%example%"}}) {
name
}
}
|]
Ae.encode ilikeResult
`shouldBe` "{\"data\":{\"users\":\
\[{\"name\":\"John\"},{\"name\":\"Anna\"}]}}"
it "supports retrieving records with several filters" $ do
withRetryConn dbPath $ \conn -> do
SS.execute_
conn
[sql|
insert into users (name, email, created_utc)
values
('John', 'john@example.com', '2021-01-01T00:00Z'),
('Anna', 'anna@example.com', '2019-01-01T00:00Z'),
('Eve', 'eve@evil.com', '2019-01-01T00:00Z')
|]
Right tables <- getEnrichedTables conn
schema <- getDerivedSchema defaultSchemaConf conn fixtureDbId tables
Right likeResult <-
graphql
schema
Nothing
mempty
[gql|
{
users (
filter: {
email: { like: "%example%" },
name: { gt: "B" }
}
) {
name
}
}
|]
Ae.encode likeResult
`shouldBe` "{\"data\":{\"users\":[{\"name\":\"John\"}]}}"
it "supports mutating records with several filters" $ do
withRetryConn dbPath $ \conn -> do
SS.execute_
conn
[sql|
insert into users (name, email, created_utc)
values
('John', 'john@example.com', '2021-01-01T00:00Z'),
('Anna', 'anna@example.com', '2019-01-01T00:00Z'),
('Eve', 'eve@evil.com', '2019-01-01T00:00Z')
|]
Right tables <- getEnrichedTables conn
schema <- getDerivedSchema defaultSchemaConf conn fixtureDbId tables
Right likeResult <-
graphql
schema
Nothing
mempty
[gql|
mutation UpdateEmailAddress {
update_users (
filter: {
email: { like: "%example%" }
name: { gt: "B" }
}
set: { email: "john@new.com" }
) {
affected_rows
returning {
email
}
}
}
|]
Ae.encode likeResult
`shouldBe` "{\"data\":{\"update_users\":\
\{\"affected_rows\":1,\
\\"returning\":[{\"email\":\"john@new.com\"}]}}}"
it "supports retrieving multi-type columns" $ do
withTestDbConn "multi-type_columns.db" $ \conn -> do
SS.execute_
conn
[sql|
CREATE VIEW "multi_type_column" AS
SELECT 1 AS col UNION
SELECT 2.2 AS col UNION
SELECT 'three' AS col UNION
SELECT NULL AS col
|]
Right tables <- getEnrichedTables conn
schema <- getDerivedSchema defaultSchemaConf conn fixtureDbId tables
Right result1 <-
graphql
schema
Nothing
mempty
[gql|{
multi_type_column { col }
}|]
let expected =
rmSpaces
[raw|
{
"data": {
"multi_type_column": [
{ "col": null },
{ "col": "1" },
{ "col": "2.2" },
{ "col": "three" }
]
}
}
|]
Ae.encode result1 `shouldBe` expected
it "supports querying a single entry by inferred pk" $ do
conn <- SS.open dbPath
SS.execute_
conn
[sql|
insert into users (name, email, created_utc)
values
('John', 'john@example.com', '2021-01-01T00:00Z'),
('Eve', 'eve@example.com', '2019-01-01T00:00Z')
|]
Right tables <- getEnrichedTables conn
schema <- getDerivedSchema defaultSchemaConf conn fixtureDbId tables
Right result <-
graphql
schema
Nothing
mempty
[gql|
{
users_by_pk (email: "eve@example.com") {
name
}
}
|]
let expected =
[raw|
{
"data": {
"users_by_pk": {
"name":"Eve"
}
}
}
|]
result `unorderedShouldBe` expected
it "supports querying a single entry by composite pk" $ do
conn <- SS.open dbPath
-- The changes we make here influence other tests. At some point we
-- should probably come up with a better system, but for now I'm just
-- rollbacking so the creation of the table does not influence
-- introspection tests and whatnot.
bracket_
(SS.execute_ conn [sql| begin transaction |])
(SS.execute_ conn [sql| rollback |])
$ do
SS.execute_
conn
[sql|
create table users_liked_songs (
email TEXT REFERENCES users,
song_id INT REFERENCES songs,
rating INT NOT NULL,
PRIMARY KEY (email, song_id)
)
|]
SS.execute_
conn
[sql|
insert into users (name, email, created_utc)
values
('John', 'john@example.com', '2021-01-01T00:00Z'),
('Eve', 'eve@example.com', '2019-01-01T00:00Z')
|]
SS.execute_
conn
[sql|
insert into songs (name, duration_seconds)
values
('Never Gonna Give You Up', 215),
('Beethoven — Symphony No. 9', 3600);
|]
SS.execute_
conn
[sql|
insert into users_liked_songs (email, song_id, rating)
values
('eve@example.com', 1, 8),
('john@example.com', 2, 9),
('eve@example.com', 2, 7);
|]
Right tables <- getEnrichedTables conn
schema <- getDerivedSchema defaultSchemaConf conn fixtureDbId tables
Right result <-
graphql
schema
Nothing
mempty
[gql|
{
users_liked_songs_by_pk (email: "eve@example.com", song_id: 2) {
rating
}
}
|]
let expected =
[raw|
{
"data": {
"users_liked_songs_by_pk": {
"rating": 7
}
}
}
|]
result `unorderedShouldBe` expected
it "errors out on integer overflows" $ do
withTestDbConn "integer-overflows.db" $ \conn -> do
SS.execute_
conn
[sql|
CREATE TABLE test (
big INTEGER,
alsobig INTEGER
)
|]
SS.execute_
conn
[sql|
INSERT INTO test(big, alsobig)
VALUES (8000000000, 9000000000)
|]
Right tables <- getEnrichedTables conn
schema <- getDerivedSchema defaultSchemaConf conn fixtureDbId tables
Right result <-
graphql
schema
Nothing
mempty
[gql|
{
test {
big,
alsobig
}
}
|]
let expected =
rmSpaces
[raw|
{
"data": null,
"errors": [{
"locations": [{
"column": 3,
"line": 2
}],
"message":
"user error (Multiple errors occurred:\nOn column \"big\": Integer 8000000000 would overflow. This happens because SQLite uses 64-bit ints, but GraphQL uses 32-bit ints. Use a Number (64-bit float) or Text column instead.\nOn column \"alsobig\": Integer 9000000000 would overflow. This happens because SQLite uses 64-bit ints, but GraphQL uses 32-bit ints. Use a Number (64-bit float) or Text column instead.\n)",
"path": ["test"]
}]
}
|]
Ae.encode result `shouldBe` expected