-- Unit and integration tests
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE NoMonomorphismRestriction #-}
{-# OPTIONS_GHC -Wno-missing-local-signatures #-}
{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
{-# HLINT ignore "Replace case with maybe" #-}
import Protolude (
Bool (False, True),
Either (Right),
FilePath,
IO,
Maybe (Just, Nothing),
($),
(&),
(<>),
)
import Protolude qualified as P
import Data.Aeson (Value (Number))
import Data.Aeson.KeyMap qualified as KeyMap
import Data.List qualified as List
import Data.Text qualified as T
import Database.SQLite.Simple (
Query,
execute_,
open,
)
import Database.SQLite.Simple qualified as SS
import Database.SQLite.Simple.QQ (sql)
import Servant.Server (runHandler)
import System.Directory (createDirectoryIfMissing)
import System.FilePath ((</>))
import System.Posix (changeWorkingDirectory, getWorkingDirectory)
import Test.Hspec (
SpecWith,
before_,
describe,
it,
pendingWith,
shouldBe,
shouldContain,
shouldMatchList,
)
import Test.Hspec qualified as Hspec
import AirGQL.Lib (
ColumnEntry (
ColumnEntry,
column_name,
column_name_gql,
datatype,
datatype_gql,
dflt_value,
isGenerated,
isOmittable,
isUnique,
notnull,
primary_key,
select_options
),
GqlTypeName (GqlTypeName, full, root),
ObjectType (Table),
SQLPost (SQLPost),
TableEntryRaw (
TableEntryRaw,
name,
object_type,
rootpage,
tbl_name
),
getColumns,
getTables,
replaceCaseInsensitive,
stringToGqlTypeName,
)
import AirGQL.Lib qualified
import AirGQL.Raw (raw)
import AirGQL.Servant.SqlQuery (sqlQueryPostHandler)
import AirGQL.Types.PragmaConf qualified as PragmaConf
import AirGQL.Types.SqlQueryPostResult (
SqlQueryPostResult (
affectedTables,
errors,
rows
),
)
import AirGQL.Types.Utils (encodeToText)
import AirGQL.Utils (
getOrderOfLinkedList,
removeIfExists,
withRetryConn,
)
import Tests.IntrospectionSpec qualified
import Tests.MutationSpec qualified
import Tests.QuerySpec qualified
import Tests.Utils (
dbPath,
fixtureDbId,
withDataDbConn,
withTestDbConn,
)
createUsersTableQuery :: Query
createUsersTableQuery =
[sql|
CREATE TABLE IF NOT EXISTS "users" (
"name" TEXT,
"email" TEXT NOT NULL UNIQUE,
"created_utc" TEXT NOT NULL,
"number_of_logins" INTEGER,
"progress" REAL,
PRIMARY KEY("email")
);
|]
createUsersTable :: SS.Connection -> IO ()
createUsersTable conn =
execute_ conn createUsersTableQuery
createSongsTableQuery :: Query
createSongsTableQuery =
[sql|
CREATE TABLE IF NOT EXISTS "songs" (
"name" TEXT NOT NULL,
"duration_seconds" INTEGER NOT NULL
);
|]
createSongsTable :: SS.Connection -> IO ()
createSongsTable conn =
execute_ conn createSongsTableQuery
-- prettyPrintSchema :: Schema m -> Text
-- prettyPrintSchema schema =
-- let
-- ObjectType name queryDesc interfaceTypes resolvers = query schema
-- in ""
-- <> "Description:\n" <> show (description schema) <> "\n\n"
-- <> "Query:\n\n"
-- <> " Name:\n" <> name <> "\n\n"
-- <> " Description:\n" <> show queryDesc <> "\n\n"
-- <> " InterfaceTypes:\n" <> show interfaceTypes <> "\n\n"
-- <> " Resolvers:\n" <> show resolvers <> "\n\n"
-- <> "Mutation:\n\n" <> show (mutation schema) <> "\n\n"
-- <> "Subscriptions:\n" <> show (subscription schema) <> "\n\n"
-- -- "Directives:\n" <> show (directives schema) <> "\n\n" <>
-- -- "Types:\n" <> show (types schema) <> "\n\n" <>
-- -- "Interface Implementations:\n" <> show (implementations schema) <> "\n\n"
-- <> ""
testSuite :: SpecWith ()
testSuite = do
describe "Utils" $ do
-- Hspec.fit "pretty prints the schema" $ do
-- conn <- open $ unpack dbPath
-- tables <- getTables conn
-- schema <-
-- getDerivedSchema defaultSchemaConf conn dbPath tables
-- putText $ prettyPrintSchema schema
-- True `shouldBe` True
it "replaces strings case insensitively" $ do
let
results =
[ replaceCaseInsensitive "hello" "hi" "hello world"
, replaceCaseInsensitive "hello" "hi" "Hello World"
, replaceCaseInsensitive "l" "L" "Hello World"
]
results `shouldBe` ["hi world", "hi World", "HeLLo WorLd"]
it "loads all tables from database" $ do
tables <- withRetryConn dbPath $ \conn ->
getTables conn
shouldBe
tables
[ TableEntryRaw
{ name = "users"
, tbl_name = "users"
, object_type = Table
, rootpage = 2
, AirGQL.Lib.sql =
"\
\CREATE TABLE \"users\" (\n\
\ \"name\" TEXT,\n\
\ \"email\" TEXT NOT NULL UNIQUE,\n\
\ \"created_utc\" TEXT NOT NULL,\n\
\ \"number_of_logins\" INTEGER,\n\
\ \"progress\" REAL,\n\
\ PRIMARY KEY(\"email\")\n\
\ )"
}
, TableEntryRaw
{ name = "songs"
, tbl_name = "songs"
, object_type = Table
, rootpage = 4
, AirGQL.Lib.sql =
"\
\CREATE TABLE \"songs\" (\n\
\ \"name\" TEXT NOT NULL,\n\
\ \"duration_seconds\" INTEGER NOT NULL\n\
\ )"
}
]
describe "getColumns" $ do
it "loads all columns from users table" $ do
tableColumns <- withRetryConn dbPath $ \conn ->
getColumns fixtureDbId conn "users"
let
columnsExpected =
[ ColumnEntry
{ column_name = "rowid"
, column_name_gql = "rowid"
, datatype = "INTEGER"
, datatype_gql = Just $ stringToGqlTypeName "Int"
, select_options = Nothing
, notnull = True
, isUnique = True
, isOmittable = True
, isGenerated = False
, isReference = False
, dflt_value = Nothing
, primary_key = True
, isRowid = True
}
, ColumnEntry
{ column_name = "name"
, column_name_gql = "name"
, datatype = "TEXT"
, datatype_gql = Just $ stringToGqlTypeName "String"
, select_options = Nothing
, notnull = False
, isUnique = False
, isOmittable = True
, isGenerated = False
, isReference = False
, dflt_value = Nothing
, primary_key = False
, isRowid = False
}
, ColumnEntry
{ column_name = "email"
, column_name_gql = "email"
, datatype = "TEXT"
, datatype_gql = Just $ stringToGqlTypeName "String"
, select_options = Nothing
, notnull = True
, isUnique = True
, isOmittable = False
, isGenerated = False
, isReference = False
, dflt_value = Nothing
, primary_key = True
, isRowid = False
}
, ColumnEntry
{ column_name = "created_utc"
, column_name_gql = "created_utc"
, datatype = "TEXT"
, datatype_gql = Just $ stringToGqlTypeName "String"
, select_options = Nothing
, notnull = True
, isUnique = False
, isOmittable = False
, isGenerated = False
, isReference = False
, dflt_value = Nothing
, primary_key = False
, isRowid = False
}
, ColumnEntry
{ column_name = "number_of_logins"
, column_name_gql = "number_of_logins"
, datatype = "INTEGER"
, datatype_gql = Just $ stringToGqlTypeName "Int"
, select_options = Nothing
, notnull = False
, isUnique = False
, isOmittable = True
, isGenerated = False
, isReference = False
, dflt_value = Nothing
, primary_key = False
, isRowid = False
}
, ColumnEntry
{ column_name = "progress"
, column_name_gql = "progress"
, datatype = "REAL"
, datatype_gql = Just $ stringToGqlTypeName "Float"
, select_options = Nothing
, notnull = False
, isUnique = False
, isOmittable = True
, isGenerated = False
, isReference = False
, dflt_value = Nothing
, primary_key = False
, isRowid = False
}
]
tableColumns `shouldBe` columnsExpected
it "loads a nullable single-select column" $ do
let dbName = "creates_nullable_single-select.db"
withTestDbConn dbName $ \conn -> do
execute_
conn
[sql|
CREATE TABLE checks (
color TEXT CHECK (color IN ('red', 'green', 'blue'))
)
|]
tableColumns <- getColumns dbName conn "checks"
let
columnExpected =
ColumnEntry
{ column_name = "color"
, column_name_gql = "color"
, datatype = "TEXT"
, datatype_gql =
Just $
GqlTypeName
{ full = "checks_color_String"
, root = "String"
}
, select_options = Just ["red", "green", "blue"]
, notnull = False
, isUnique = False
, isOmittable = True
, isGenerated = False
, isReference = False
, dflt_value = Nothing
, primary_key = False
, isRowid = False
}
P.lastMay tableColumns `shouldBe` Just columnExpected
it "loads a non-null single-select column" $ do
let dbName = "creates_non-null_single-select.db"
withTestDbConn dbName $ \conn -> do
execute_
conn
[sql|
CREATE TABLE checks (
color TEXT CHECK (color IN ('red', 'green', 'blue')) NOT NULL
)
|]
tableColumns <- getColumns dbName conn "checks"
let
columnExpected =
ColumnEntry
{ column_name = "color"
, column_name_gql = "color"
, datatype = "TEXT"
, datatype_gql =
Just $
GqlTypeName
{ full = "checks_color_String"
, root = "String"
}
, select_options = Just ["red", "green", "blue"]
, notnull = True
, isUnique = False
, isOmittable = False
, isGenerated = False
, isReference = False
, dflt_value = Nothing
, primary_key = False
, isRowid = False
}
P.lastMay tableColumns `shouldBe` Just columnExpected
it "coerces a multi-type single-select column to text" $ do
let dbName = "multi-type_single-select.db"
withTestDbConn dbName $ \conn -> do
execute_
conn
[sql|
CREATE TABLE checks (
value TEXT CHECK (value IN (1, 2.2, 'three'))
)
|]
tableColumns <- getColumns dbName conn "checks"
let
columnExpected =
ColumnEntry
{ column_name = "value"
, column_name_gql = "value"
, datatype = "TEXT"
, datatype_gql =
Just $
GqlTypeName
{ full = "checks_value_String"
, root = "String"
}
, select_options = Just ["1", "2.2", "three"]
, notnull = False
, isUnique = False
, isOmittable = True
, isGenerated = False
, isReference = False
, dflt_value = Nothing
, primary_key = False
, isRowid = False
}
P.lastMay tableColumns `shouldBe` Just columnExpected
it "marks integer primary keys as omittable" $ do
let dbName = "integer-omittable-primary-key.db"
withTestDbConn dbName $ \conn -> do
execute_
conn
[sql|
CREATE TABLE items (
id INTEGER PRIMARY KEY
)
|]
tableColumns <- getColumns dbName conn "items"
let
columnExpected =
ColumnEntry
{ column_name = "id"
, column_name_gql = "id"
, datatype = "INTEGER"
, datatype_gql = Just $ stringToGqlTypeName "Int"
, select_options = Nothing
, notnull = True
, isUnique = True
, isOmittable = True
, isGenerated = False
, isReference = False
, dflt_value = Nothing
, primary_key = True
, isRowid = False
}
P.lastMay tableColumns `shouldBe` Just columnExpected
it "correctly parses generated columns" $ do
let dbName = "generated-columns.db"
withTestDbConn dbName $ \conn -> do
execute_
conn
[sql|
CREATE TABLE "generated_columns" (
"start" REAL NOT NULL,
"end" REAL NOT NULL,
"distance_km" REAL GENERATED ALWAYS AS ("end" - "start") STORED,
"distance_miles" REAL GENERATED ALWAYS AS (distance_km * 1.6) VIRTUAL
)
|]
tableColumns <- getColumns dbName conn "generated_columns"
let (generated, non_generated) =
-- => [ColumnDef]
tableColumns
-- => ([ColumnDef], [ColumnDef])
& List.partition (\c -> c.isGenerated)
-- => (Text, Text)
& P.bimap
(P.fmap column_name)
(P.fmap column_name)
-- We use `shouldMatchList` because the order does not matter
non_generated `shouldMatchList` ["start", "end", "rowid"]
generated `shouldMatchList` ["distance_km", "distance_miles"]
it "sorts the tables from the metadata table" $ do
getOrderOfLinkedList [("a", Nothing), ("b", Just "a"), ("c", Just "b")]
`shouldBe` ["a", "b", "c"]
getOrderOfLinkedList [("a", Nothing), ("c", Just "b"), ("b", Just "a")]
`shouldBe` ["a", "b", "c"]
getOrderOfLinkedList [("b", Just "a"), ("c", Just "b"), ("a", Nothing)]
`shouldBe` ["a", "b", "c"]
getOrderOfLinkedList [("a", Just "x"), ("c", Just "b"), ("b", Just "a")]
`shouldBe` ["x", "a", "b", "c"]
getOrderOfLinkedList [("c", Just "b"), ("b", Just "a"), ("a", Just "x")]
`shouldBe` ["x", "a", "b", "c"]
getOrderOfLinkedList [("a", Nothing), ("b", Just "a"), ("c", Nothing)]
`shouldBe` ["a", "b", "c"]
getOrderOfLinkedList [("a", Nothing), ("b", Nothing), ("c", Nothing)]
`shouldBe` ["a", "b", "c"]
getOrderOfLinkedList [("a", Nothing), ("b", Just "a"), ("d", Just "c")]
`shouldBe` ["a", "b", "c", "d"]
-- Nothing must always be first
getOrderOfLinkedList [("c", Just "b"), ("d", Just "c"), ("a", Nothing)]
`shouldBe` ["a", "b", "c", "d"]
-- Should *not* error out on cycles
getOrderOfLinkedList [("c", Just "a"), ("b", Just "a"), ("a", Just "b")]
`shouldBe` ["a", "b", "c"]
describe "REST API" $ do
describe "SQL" $ do
it "supports retrieving the schema" $ do
-- let query = "CREATE TABLE users (name TEXT, email TEXT);"
-- let dbPost = DatabasePost "test-db" (Just "test-team") "" (Just query)
-- Right schemaResult <-
-- runHandler $
-- apiDatabaseSchemaGetHandler ctx "TODO"
-- T.strip schemaResult `shouldBe` query
pendingWith "Create database first"
it "supports executing an SQL query" $ do
let dbId = "api-sql-query"
withDataDbConn dbId $ \_ -> do
Right result <-
runHandler $
sqlQueryPostHandler
PragmaConf.defaultConf
("_TEST_" <> dbId)
SQLPost{query = "SELECT TRUE, 123, 'test'"}
result.rows
`shouldBe` [ KeyMap.fromList
[ ("TRUE", Number 1)
, ("123", Number 123)
, ("'test'", "test")
]
]
result.affectedTables `shouldMatchList` []
it "return columns in the requested order" $ do
-- Even though JSON objects are unordered by definition,
-- the fields (columns) must be returned in the requested order
-- as Elm relies on it for decoding.
let dbId = "api-sql-col-order"
withDataDbConn dbId $ \_ -> do
Right result <-
runHandler $
sqlQueryPostHandler
PragmaConf.defaultConf
("_TEST_" <> dbId)
SQLPost{query = "SELECT 0 AS b, 0 AS a"}
(result & encodeToText & T.unpack)
`shouldContain` "[{\"b\":0,\"a\":0}]"
result.affectedTables `shouldMatchList` []
it "supports using math functions" $ do
let dbId = "api-sql-math-query"
withDataDbConn dbId $ \_ -> do
Right result <-
runHandler $
sqlQueryPostHandler
PragmaConf.defaultConf
("_TEST_" <> dbId)
SQLPost{query = "SELECT abs(floor(cos(2 * pi() / 3)))"}
result.rows
`shouldBe` [ KeyMap.singleton
"abs(floor(cos(2 * pi() / 3)))"
(Number 1.0)
]
result.affectedTables `shouldMatchList` []
-- The following few tests verify that different operations return
-- the proper set of affected tables. This query creates a completely
-- unrelated table just to ensure it is not getting returned by the
-- methods tested below
let createUnrelatedTable = do
[sql|
CREATE TABLE IF NOT EXISTS todos (
title TEXT,
content TEXT,
done INTEGER
)
|]
-- This query creates a table commonly used by the following few tests.
let createNotesTable = do
[sql|
CREATE TABLE IF NOT EXISTS notes (
content TEXT
)
|]
it "should not allow rowid references" $ do
let dbId = "api-sql-rowid-references"
let query = "CREATE TABLE foo ( bar TEXT references goo(rowid) )"
withDataDbConn dbId $ \_ -> do
Right result <-
runHandler $
sqlQueryPostHandler
PragmaConf.defaultConf
("_TEST_" <> dbId)
SQLPost{query = query}
let
expectedMessage =
"Column 'bar' references the rowid column of table 'goo'.\n"
<> "This is not supported by SQLite:\n"
<> "https://www.sqlite.org/foreignkeys.html"
result.errors `shouldBe` [expectedMessage]
it "should error out on `without rowid` table creation" $ do
let dbId = "api-sql-without-rowid"
let query = "CREATE TABLE foo (bar INTEGER PRIMARY KEY) WITHOUT ROWID"
withDataDbConn dbId $ \_ -> do
Right result <-
runHandler $
sqlQueryPostHandler
PragmaConf.defaultConf
("_TEST_" <> dbId)
SQLPost{query = query}
let
expectedMessage =
"Table 'foo' does not have a rowid column. "
<> "Such tables are not currently supported by Airsequel."
result.errors `shouldBe` [expectedMessage]
it "should return no affected tables on a simple select" $ do
let dbId = "api-sql-simple-select"
withDataDbConn dbId $ \conn -> do
execute_ conn createUnrelatedTable
execute_ conn createNotesTable
execute_
conn
[sql|
INSERT INTO notes VALUES ("hello")
|]
Right result <-
runHandler $
sqlQueryPostHandler
PragmaConf.defaultConf
("_TEST_" <> dbId)
SQLPost{query = "SELECT * from notes"}
result.rows
`shouldBe` [KeyMap.singleton "content" "hello"]
result.affectedTables `shouldMatchList` []
it "should return the correct affected tables when creating tables" $ do
let dbId = "api-sql-simple-create"
withDataDbConn dbId $ \conn -> do
execute_ conn createUnrelatedTable
Right result <-
runHandler $
sqlQueryPostHandler
PragmaConf.defaultConf
("_TEST_" <> dbId)
SQLPost
{ query = SS.fromQuery createNotesTable
}
result.affectedTables
`shouldMatchList` ["notes"]
it "should return the correct affected tables when dropping tables" $ do
let dbId = "api-sql-simple-drop"
withDataDbConn dbId $ \conn -> do
execute_ conn createUnrelatedTable
execute_ conn createNotesTable
Right result <-
runHandler $
sqlQueryPostHandler
PragmaConf.defaultConf
("_TEST_" <> dbId)
SQLPost{query = "DROP TABLE notes"}
result.affectedTables `shouldMatchList` ["notes"]
it "should return the correct affected tables when editing tables" $ do
let dbId = "api-sql-add-column"
withDataDbConn dbId $ \conn -> do
execute_ conn createUnrelatedTable
execute_ conn createNotesTable
Right result <-
runHandler $
sqlQueryPostHandler
PragmaConf.defaultConf
("_TEST_" <> dbId)
SQLPost
{ query =
"ALTER TABLE notes ADD COLUMN title TEXT"
}
result.affectedTables `shouldMatchList` ["notes"]
it "should mark every table as affected when changes are detected" $ do
let dbId = "api-sql-insert-values"
withDataDbConn dbId $ \conn -> do
execute_ conn createUnrelatedTable
execute_ conn createNotesTable
Right result <-
runHandler $
sqlQueryPostHandler
PragmaConf.defaultConf
("_TEST_" <> dbId)
SQLPost
{ query =
[raw| INSERT INTO "notes" VALUES ("hello") |]
}
result.affectedTables `shouldMatchList` ["notes", "todos"]
describe "Query" Tests.QuerySpec.main
describe "Mutation" Tests.MutationSpec.main
describe "Introspection" Tests.IntrospectionSpec.main
deleteDbEntries :: FilePath -> IO ()
deleteDbEntries databasePath = do
conn <- open databasePath
execute_ conn "delete from users"
execute_ conn "delete from songs"
main :: IO ()
main = do
cwd <- getWorkingDirectory
createDirectoryIfMissing True (".." </> "data" </> "TEST" </> "data")
changeWorkingDirectory (cwd </> ".." </> "data" </> "TEST")
removeIfExists dbPath
withRetryConn dbPath $ \conn -> do
createUsersTable conn
createSongsTable conn
Hspec.hspec $ before_ (deleteDbEntries dbPath) testSuite