mirror of
https://github.com/Airsequel/AirGQL.git
synced 2025-07-07 18:59:31 +02:00
AirGQL: Clean up documentation, remove obsolete references to Airsequel
This commit is contained in:
commit
fbee31a849
34 changed files with 13964 additions and 0 deletions
5
.gitignore
vendored
Normal file
5
.gitignore
vendored
Normal file
|
@ -0,0 +1,5 @@
|
||||||
|
.stack-work
|
||||||
|
*.hie
|
||||||
|
/bruno_collection
|
||||||
|
/data
|
||||||
|
/tests/*.db
|
4
Setup.hs
Normal file
4
Setup.hs
Normal file
|
@ -0,0 +1,4 @@
|
||||||
|
import Distribution.Simple
|
||||||
|
|
||||||
|
|
||||||
|
main = defaultMain
|
218
app/Main.hs
Normal file
218
app/Main.hs
Normal file
|
@ -0,0 +1,218 @@
|
||||||
|
{-# LANGUAGE DeriveDataTypeable #-}
|
||||||
|
-- To look up git hash
|
||||||
|
{-# LANGUAGE TemplateHaskell #-}
|
||||||
|
|
||||||
|
-- Necessary for cmdArgs
|
||||||
|
{-# OPTIONS -Wno-partial-fields #-}
|
||||||
|
|
||||||
|
module Main (main) where
|
||||||
|
|
||||||
|
import Protolude (
|
||||||
|
Applicative (pure),
|
||||||
|
Eq ((==)),
|
||||||
|
FilePath,
|
||||||
|
IO,
|
||||||
|
Int,
|
||||||
|
Maybe (Just),
|
||||||
|
Semigroup ((<>)),
|
||||||
|
Show,
|
||||||
|
Text,
|
||||||
|
const,
|
||||||
|
putText,
|
||||||
|
repeat,
|
||||||
|
show,
|
||||||
|
($),
|
||||||
|
(&),
|
||||||
|
(||),
|
||||||
|
)
|
||||||
|
import Protolude qualified as P
|
||||||
|
|
||||||
|
import Data.Data (Data)
|
||||||
|
import Data.Text qualified as T
|
||||||
|
import Database.SQLite.Simple qualified as SS
|
||||||
|
import GitHash (giDirty, giTag, tGitInfoCwd)
|
||||||
|
import Network.HTTP.Client.MultipartFormData ()
|
||||||
|
import Network.Wai (Middleware)
|
||||||
|
import Network.Wai.Handler.Warp (
|
||||||
|
defaultSettings,
|
||||||
|
runSettings,
|
||||||
|
setOnException,
|
||||||
|
setPort,
|
||||||
|
)
|
||||||
|
import Network.Wai.Middleware.Cors (
|
||||||
|
cors,
|
||||||
|
corsMethods,
|
||||||
|
corsRequestHeaders,
|
||||||
|
simpleCorsResourcePolicy,
|
||||||
|
simpleMethods,
|
||||||
|
)
|
||||||
|
import System.Console.CmdArgs as CmdArgs (
|
||||||
|
Default (def),
|
||||||
|
args,
|
||||||
|
auto,
|
||||||
|
cmdArgs,
|
||||||
|
help,
|
||||||
|
modes,
|
||||||
|
program,
|
||||||
|
summary,
|
||||||
|
typ,
|
||||||
|
(&=),
|
||||||
|
)
|
||||||
|
|
||||||
|
import AirGQL.ExternalAppContext (getExternalAppContext)
|
||||||
|
import AirGQL.Utils (
|
||||||
|
getGraphiQLVersion,
|
||||||
|
getSqliteBinaryVersion,
|
||||||
|
getSqliteEmbeddedVersion,
|
||||||
|
)
|
||||||
|
import Server.Server (platformApp)
|
||||||
|
|
||||||
|
|
||||||
|
data Cli
|
||||||
|
= Help
|
||||||
|
| Version
|
||||||
|
| -- Start the AirGQL server
|
||||||
|
-- serving the GraphQL endpoint for the specified SQLite database
|
||||||
|
Serve
|
||||||
|
{ dbFilePath :: FilePath
|
||||||
|
-- TODO: , readOnly :: Bool
|
||||||
|
}
|
||||||
|
deriving (Show, Data)
|
||||||
|
|
||||||
|
|
||||||
|
cliHelp :: Cli
|
||||||
|
cliHelp =
|
||||||
|
Help
|
||||||
|
&= auto
|
||||||
|
|
||||||
|
|
||||||
|
cliVersion :: Cli
|
||||||
|
cliVersion = Version
|
||||||
|
|
||||||
|
|
||||||
|
cliServe :: Cli
|
||||||
|
cliServe =
|
||||||
|
Serve
|
||||||
|
{ dbFilePath = def &= typ "Path to database file" &= args
|
||||||
|
-- TODO: , readOnly = def
|
||||||
|
}
|
||||||
|
&= help "Serve database via GraphQL"
|
||||||
|
|
||||||
|
|
||||||
|
corsMiddleware :: Middleware
|
||||||
|
corsMiddleware =
|
||||||
|
let
|
||||||
|
policy =
|
||||||
|
simpleCorsResourcePolicy
|
||||||
|
{ corsRequestHeaders = ["Content-Type", "Authorization"]
|
||||||
|
, corsMethods = "PUT" : simpleMethods
|
||||||
|
}
|
||||||
|
in
|
||||||
|
cors (const $ Just policy)
|
||||||
|
|
||||||
|
|
||||||
|
-- | Imitates output from `git describe --always --dirty`
|
||||||
|
versionSlug :: Text
|
||||||
|
versionSlug =
|
||||||
|
T.pack $
|
||||||
|
giTag $$tGitInfoCwd
|
||||||
|
<> (if giDirty $$tGitInfoCwd then "-dirty" else "")
|
||||||
|
|
||||||
|
|
||||||
|
main :: IO ()
|
||||||
|
main = do
|
||||||
|
let
|
||||||
|
port :: Int = 4189
|
||||||
|
|
||||||
|
separatorLine = "\n" <> T.concat (P.take 80 $ repeat "=")
|
||||||
|
separatorLineThin = "\n" <> T.concat (P.take 80 $ repeat "-")
|
||||||
|
|
||||||
|
runWarp =
|
||||||
|
runSettings $
|
||||||
|
defaultSettings
|
||||||
|
& setPort port
|
||||||
|
& setOnException
|
||||||
|
( \_ exception -> do
|
||||||
|
let exceptionText :: Text = show exception
|
||||||
|
if (exceptionText == "Thread killed by timeout manager")
|
||||||
|
|| ( exceptionText
|
||||||
|
== "Warp: Client closed connection prematurely"
|
||||||
|
)
|
||||||
|
then pure ()
|
||||||
|
else do
|
||||||
|
putText exceptionText
|
||||||
|
)
|
||||||
|
|
||||||
|
buildBanner
|
||||||
|
:: Text
|
||||||
|
-> Text
|
||||||
|
-> Text
|
||||||
|
-> Text
|
||||||
|
-> Text
|
||||||
|
buildBanner
|
||||||
|
sqliteEmbeddedVersion
|
||||||
|
sqliteBinaryVersion
|
||||||
|
graphiQLVersion
|
||||||
|
baseUrl =
|
||||||
|
separatorLine
|
||||||
|
<> "\n\n"
|
||||||
|
<> "AirGQL Server\n"
|
||||||
|
<> separatorLineThin
|
||||||
|
<> "\n\n"
|
||||||
|
<> "Version:\t\t "
|
||||||
|
<> versionSlug
|
||||||
|
<> "\n\
|
||||||
|
\GraphQL URL:\t\t "
|
||||||
|
<> baseUrl
|
||||||
|
<> "/graphql"
|
||||||
|
<> "\n\
|
||||||
|
\\n\
|
||||||
|
\SQLite Embedded version: "
|
||||||
|
<> sqliteEmbeddedVersion
|
||||||
|
<> "\n\
|
||||||
|
\SQLite Binary version:\t "
|
||||||
|
<> sqliteBinaryVersion
|
||||||
|
<> "\n\
|
||||||
|
\GraphiQL version:\t "
|
||||||
|
<> graphiQLVersion
|
||||||
|
<> "\n"
|
||||||
|
<> separatorLine
|
||||||
|
<> "\n"
|
||||||
|
|
||||||
|
providedArgs <-
|
||||||
|
cmdArgs $
|
||||||
|
modes
|
||||||
|
[ cliHelp
|
||||||
|
, cliVersion
|
||||||
|
, cliServe
|
||||||
|
]
|
||||||
|
&= program "airgql"
|
||||||
|
&= summary (T.unpack versionSlug)
|
||||||
|
&= help "Automatic GraphQL API generation for SQLite databases"
|
||||||
|
|
||||||
|
case providedArgs of
|
||||||
|
Help ->
|
||||||
|
putText "Run `airgql --help` for detailed usage instructions"
|
||||||
|
----------
|
||||||
|
Version ->
|
||||||
|
putText versionSlug
|
||||||
|
----------
|
||||||
|
Serve{dbFilePath} -> do
|
||||||
|
SS.withConnection dbFilePath $ \conn -> do
|
||||||
|
P.when (dbFilePath == "") $
|
||||||
|
P.die "ERROR: No database file path was specified"
|
||||||
|
|
||||||
|
let baseUrl :: Text = "http://localhost:" <> show port
|
||||||
|
ctx <- getExternalAppContext baseUrl
|
||||||
|
sqliteEmbeddedVersion <- getSqliteEmbeddedVersion conn
|
||||||
|
sqliteBinaryVersion <- getSqliteBinaryVersion ctx
|
||||||
|
graphiQLVersion <- getGraphiQLVersion
|
||||||
|
|
||||||
|
putText $
|
||||||
|
buildBanner
|
||||||
|
sqliteEmbeddedVersion
|
||||||
|
sqliteBinaryVersion
|
||||||
|
graphiQLVersion
|
||||||
|
baseUrl
|
||||||
|
|
||||||
|
runWarp $ corsMiddleware $ platformApp ctx dbFilePath
|
BIN
images/sql_to_graphql.png
Normal file
BIN
images/sql_to_graphql.png
Normal file
Binary file not shown.
After ![]() (image error) Size: 71 KiB |
12
makefile
Normal file
12
makefile
Normal file
|
@ -0,0 +1,12 @@
|
||||||
|
.PHONY: test
|
||||||
|
test:
|
||||||
|
stack \
|
||||||
|
--stack-yaml stack-standalone.yaml \
|
||||||
|
test
|
||||||
|
|
||||||
|
|
||||||
|
.PHONY: install
|
||||||
|
install:
|
||||||
|
stack \
|
||||||
|
--stack-yaml stack-standalone.yaml \
|
||||||
|
install
|
143
package.yaml
Normal file
143
package.yaml
Normal file
|
@ -0,0 +1,143 @@
|
||||||
|
name: airgql
|
||||||
|
version: 0.7.1.2
|
||||||
|
synopsis: Automatically generate a GraphQL API for an SQLite database
|
||||||
|
description: |
|
||||||
|
AirGQL automatically generates a GraphQL API for SQLite databases.
|
||||||
|
It analyses the database schema
|
||||||
|
and builds the corresponding GraphQL introspection and data resolvers.
|
||||||
|
|
||||||
|
The generated API supports all basic CRUD operations and
|
||||||
|
even complex queries and mutations including filters and pagination.
|
||||||
|
It's the perferct solution for easily integrating GraphQL support
|
||||||
|
into existing Haskell servers.
|
||||||
|
|
||||||
|
AirGQL is part of the Airsequel project, which provides a complete solution
|
||||||
|
for building web applications on top of SQLite databases.
|
||||||
|
homepage: https://github.com/Airsequel/AirGQL
|
||||||
|
license: AGPL-3.0-or-later
|
||||||
|
author: Feram GmbH
|
||||||
|
maintainer: adrian@feram.io
|
||||||
|
copyright: 2024 Feram GmbH
|
||||||
|
category: Web, Database, SQL, SQLite, GraphQL, Servant, CLI Tool
|
||||||
|
|
||||||
|
extra-source-files:
|
||||||
|
- readme.md
|
||||||
|
|
||||||
|
flags:
|
||||||
|
lib-only:
|
||||||
|
description: Only build/install the library and not the CLI tool.
|
||||||
|
manual: true
|
||||||
|
default: false
|
||||||
|
|
||||||
|
dependencies:
|
||||||
|
- base >= 4.18.2 && < 4.19
|
||||||
|
- protolude >= 0.3.4 && < 0.4
|
||||||
|
- text >= 2.0.2 && < 2.1
|
||||||
|
- sqlite-simple >= 0.4.19 && < 0.5
|
||||||
|
|
||||||
|
default-extensions:
|
||||||
|
- DataKinds
|
||||||
|
- DeriveGeneric
|
||||||
|
- DerivingStrategies
|
||||||
|
- DuplicateRecordFields
|
||||||
|
- FlexibleContexts
|
||||||
|
- FlexibleInstances
|
||||||
|
- GADTs
|
||||||
|
- GeneralizedNewtypeDeriving
|
||||||
|
- ImportQualifiedPost
|
||||||
|
- LambdaCase
|
||||||
|
- MultiParamTypeClasses
|
||||||
|
- MultiWayIf
|
||||||
|
- NamedFieldPuns
|
||||||
|
- NoImplicitPrelude
|
||||||
|
- NumericUnderscores
|
||||||
|
- OverloadedRecordDot
|
||||||
|
- OverloadedStrings
|
||||||
|
- RankNTypes
|
||||||
|
- RecordWildCards
|
||||||
|
- ScopedTypeVariables
|
||||||
|
- StandaloneDeriving
|
||||||
|
- TupleSections
|
||||||
|
- TypeApplications
|
||||||
|
- TypeFamilies
|
||||||
|
- TypeOperators
|
||||||
|
- TypeSynonymInstances
|
||||||
|
- UndecidableInstances
|
||||||
|
|
||||||
|
ghc-options:
|
||||||
|
- -fno-warn-orphans
|
||||||
|
- -fwrite-ide-info
|
||||||
|
- -Weverything
|
||||||
|
- -Wno-all-missed-specialisations
|
||||||
|
- -Wno-missing-deriving-strategies
|
||||||
|
- -Wno-missing-kind-signatures
|
||||||
|
- -Wno-missing-safe-haskell-mode
|
||||||
|
- -Wno-unsafe
|
||||||
|
|
||||||
|
library:
|
||||||
|
source-dirs: source
|
||||||
|
dependencies:
|
||||||
|
- aeson >= 2.1.2.1 && < 2.3
|
||||||
|
- blaze-markup >= 0.8.3 && < 0.9
|
||||||
|
- bytestring >= 0.11.5 && < 0.12
|
||||||
|
- conduit >= 1.3.5 && < 1.4
|
||||||
|
- directory >= 1.3.8 && < 1.4
|
||||||
|
- double-x-encoding >= 1.2.1 && < 1.3
|
||||||
|
- exceptions >= 0.10.7 && < 0.11
|
||||||
|
- extra >= 1.7.14 && < 1.8
|
||||||
|
- filepath >= 1.4.200 && < 1.5
|
||||||
|
- graphql >= 1.2.0.1 && < 1.4
|
||||||
|
- graphql-spice >= 1.0.2 && < 1.1
|
||||||
|
- http-types >= 0.12.4 && < 0.13
|
||||||
|
- process >= 1.6.17 && < 1.7
|
||||||
|
- scientific >= 0.3.7 && < 0.4
|
||||||
|
- servant >= 0.20.1 && < 0.21
|
||||||
|
- servant-blaze >= 0.9.1 && < 0.10
|
||||||
|
- servant-docs >= 0.13 && < 0.14
|
||||||
|
- servant-multipart >= 0.12.1 && < 0.13
|
||||||
|
- servant-server >= 0.20 && < 0.21
|
||||||
|
- simple-sql-parser >= 0.6.1 && < 0.8
|
||||||
|
- template-haskell >= 2.20.0 && < 2.21
|
||||||
|
- time >= 1.12.2 && < 1.13
|
||||||
|
- typed-process >= 0.2.11 && < 0.3
|
||||||
|
- unix >= 2.8.4 && < 2.9
|
||||||
|
- unordered-containers >= 0.2.20 && < 0.3
|
||||||
|
- wai >= 3.2.4 && < 3.3
|
||||||
|
- wai-extra >= 3.1.14 && < 3.2
|
||||||
|
|
||||||
|
executables:
|
||||||
|
airgql:
|
||||||
|
when:
|
||||||
|
- condition: flag(lib-only)
|
||||||
|
then: { buildable: false }
|
||||||
|
else: { buildable: true }
|
||||||
|
source-dirs: app
|
||||||
|
main: Main.hs
|
||||||
|
ghc-options:
|
||||||
|
- -threaded
|
||||||
|
dependencies:
|
||||||
|
- airgql
|
||||||
|
- cmdargs >= 0.10.22 && < 0.11
|
||||||
|
- githash >= 0.1.7 && < 0.2
|
||||||
|
- http-client >= 0.7.17 && < 0.8
|
||||||
|
- wai >= 3.2.4 && < 3.3
|
||||||
|
- wai-cors >= 0.2.7 && < 0.3
|
||||||
|
- warp >= 3.3.31 && < 3.4
|
||||||
|
|
||||||
|
tests:
|
||||||
|
airgql-test:
|
||||||
|
main: Spec.hs
|
||||||
|
source-dirs: tests
|
||||||
|
dependencies:
|
||||||
|
- aeson >= 2.1.2.1 && < 2.3
|
||||||
|
- airgql
|
||||||
|
- bytestring >= 0.11.5 && < 0.12
|
||||||
|
- directory >= 1.3.8 && < 1.4
|
||||||
|
- exceptions >= 0.10.7 && < 0.11
|
||||||
|
- filepath >= 1.4.200 && < 1.5
|
||||||
|
- graphql >= 1.2.0.1 && < 1.4
|
||||||
|
- graphql-spice >= 1.0.2 && < 1.1
|
||||||
|
- hspec >= 2.11.8 && < 2.12
|
||||||
|
- servant-server >= 0.20 && < 0.21
|
||||||
|
- unix >= 2.8.4 && < 2.9
|
||||||
|
- unordered-containers >= 0.2.20 && < 0.3
|
101
readme.md
Normal file
101
readme.md
Normal file
|
@ -0,0 +1,101 @@
|
||||||
|
# AirGQL
|
||||||
|
|
||||||
|
Automatically generate a GraphQL API for an SQLite database.
|
||||||
|
|
||||||
|
<img
|
||||||
|
alt="Diagram of SQL to GraphQL conversion"
|
||||||
|
src="./images/sql_to_graphql.png"
|
||||||
|
style="width: 60%;"
|
||||||
|
/>
|
||||||
|
|
||||||
|
## How It Works
|
||||||
|
|
||||||
|
It analyses the database schema
|
||||||
|
and builds the corresponding GraphQL introspection and data resolvers.
|
||||||
|
|
||||||
|
The generated API supports all basic CRUD operations and
|
||||||
|
even complex queries and mutations including filters and pagination.
|
||||||
|
|
||||||
|
It is designed to be either used a Haskell library
|
||||||
|
for integrating GraphQL support into existing servers
|
||||||
|
or as a standalone CLI app for quickly spinning up a backend.
|
||||||
|
|
||||||
|
AirGQL is the core component of [Airsequel](https://www.airsequel.com/),
|
||||||
|
which provides a complete solution for building web applications
|
||||||
|
on top of SQLite databases.
|
||||||
|
|
||||||
|
|
||||||
|
## Installation
|
||||||
|
|
||||||
|
### CLI Tool
|
||||||
|
|
||||||
|
You can install the CLI app using
|
||||||
|
[Stack](https://docs.haskellstack.org/en/stable/):
|
||||||
|
|
||||||
|
```sh
|
||||||
|
git clone https://github.com/Airsequel/AirGQL
|
||||||
|
cd AirGQL
|
||||||
|
make install
|
||||||
|
```
|
||||||
|
|
||||||
|
|
||||||
|
### Library
|
||||||
|
|
||||||
|
You can also use AirGQL in your Haskell project
|
||||||
|
by adding the [Hackage package](https://hackage.haskell.org/package/airgql)
|
||||||
|
as a dependency to your `package.yaml` or your `*.cabal` file:
|
||||||
|
|
||||||
|
```yaml
|
||||||
|
dependencies:
|
||||||
|
- airgql
|
||||||
|
- …
|
||||||
|
```
|
||||||
|
|
||||||
|
|
||||||
|
## Usage
|
||||||
|
|
||||||
|
### CLI App
|
||||||
|
|
||||||
|
Run following command to start a GraphQL API server
|
||||||
|
for an existing SQLite database:
|
||||||
|
|
||||||
|
```sh
|
||||||
|
stack run -- serve tests/example.sqlite
|
||||||
|
```
|
||||||
|
|
||||||
|
Then you can query the API like this:
|
||||||
|
|
||||||
|
```sh
|
||||||
|
http POST http://localhost:4189/graphql \
|
||||||
|
query='query {
|
||||||
|
songs(limit: 2) {
|
||||||
|
id
|
||||||
|
title
|
||||||
|
}
|
||||||
|
}'
|
||||||
|
```
|
||||||
|
|
||||||
|
It also supports mutations:
|
||||||
|
|
||||||
|
```sh
|
||||||
|
http POST http://localhost:4189/graphql \
|
||||||
|
query='mutation {
|
||||||
|
insert_songs(objects: [{ title: "New Song" }]) {
|
||||||
|
returning {
|
||||||
|
id
|
||||||
|
title
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}'
|
||||||
|
```
|
||||||
|
|
||||||
|
Check out the documentation at
|
||||||
|
[docs.airsequel.com/graphql-api](https://docs.airsequel.com/graphql-api)
|
||||||
|
for more details on how to use all of its GraphQL features.
|
||||||
|
|
||||||
|
|
||||||
|
### Library
|
||||||
|
|
||||||
|
Check out the code in [app/Main.hs](./app/Main.hs) file for an example
|
||||||
|
of how to build a simple [Servant](https://www.servant.dev/) server
|
||||||
|
leveraging AirGQL.
|
42
source/AirGQL/Config.hs
Normal file
42
source/AirGQL/Config.hs
Normal file
|
@ -0,0 +1,42 @@
|
||||||
|
module AirGQL.Config (
|
||||||
|
Config (..),
|
||||||
|
maxGraphqlResultCount,
|
||||||
|
defaultConfig,
|
||||||
|
)
|
||||||
|
where
|
||||||
|
|
||||||
|
import Data.Bool (Bool (False))
|
||||||
|
import Data.Int (Int)
|
||||||
|
|
||||||
|
|
||||||
|
-- | The maximum number of results allowed for the GraphiQL playground
|
||||||
|
maxGraphqlResultCount :: Int
|
||||||
|
maxGraphqlResultCount = 10000
|
||||||
|
|
||||||
|
|
||||||
|
data Config = Config
|
||||||
|
{ maxTablesPerDb :: Int
|
||||||
|
, maxColumnsPerTable :: Int
|
||||||
|
, maxRowsPerTable :: Int
|
||||||
|
, maxVisibleCellsPerTable :: Int
|
||||||
|
, maxDbSize :: Int -- Bytes
|
||||||
|
, maxCellSize :: Int -- Bytes
|
||||||
|
, hardHeapLimit :: Int -- Bytes
|
||||||
|
, sqlTimeoutTime :: Int -- Seconds
|
||||||
|
, allowRecursiveTriggers :: Bool
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
defaultConfig :: Config
|
||||||
|
defaultConfig =
|
||||||
|
Config
|
||||||
|
{ maxTablesPerDb = 100
|
||||||
|
, maxColumnsPerTable = 500
|
||||||
|
, maxRowsPerTable = 100_000
|
||||||
|
, maxVisibleCellsPerTable = 0 -- Not used currently
|
||||||
|
, maxDbSize = 100_000_000 -- Bytes
|
||||||
|
, maxCellSize = 10_000_000 -- Bytes
|
||||||
|
, hardHeapLimit = 500_000_000 -- Bytes
|
||||||
|
, sqlTimeoutTime = 20
|
||||||
|
, allowRecursiveTriggers = False
|
||||||
|
}
|
75
source/AirGQL/ExternalAppContext.hs
Normal file
75
source/AirGQL/ExternalAppContext.hs
Normal file
|
@ -0,0 +1,75 @@
|
||||||
|
{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
|
||||||
|
|
||||||
|
{-# HLINT ignore "Use maybe" #-}
|
||||||
|
module AirGQL.ExternalAppContext (
|
||||||
|
SandboxingConfig (..),
|
||||||
|
ExternalAppContext (..),
|
||||||
|
getExternalAppContext,
|
||||||
|
) where
|
||||||
|
|
||||||
|
import Protolude (
|
||||||
|
FilePath,
|
||||||
|
IO,
|
||||||
|
Maybe (Just, Nothing),
|
||||||
|
Show,
|
||||||
|
Text,
|
||||||
|
not,
|
||||||
|
pure,
|
||||||
|
($),
|
||||||
|
(&&),
|
||||||
|
(/=),
|
||||||
|
(<|>),
|
||||||
|
(==),
|
||||||
|
)
|
||||||
|
import Protolude qualified as P
|
||||||
|
|
||||||
|
import Data.ByteString qualified as BS
|
||||||
|
import Data.Text qualified as T
|
||||||
|
import System.Environment (lookupEnv)
|
||||||
|
import System.Info (os)
|
||||||
|
import System.Process.Typed (ExitCode (ExitSuccess), proc, readProcessStdout)
|
||||||
|
|
||||||
|
|
||||||
|
lookupBinaryPath :: Text -> IO (Maybe FilePath)
|
||||||
|
lookupBinaryPath name = do
|
||||||
|
(code, resultBS) <- readProcessStdout $ proc "which" [T.unpack name]
|
||||||
|
let result = T.strip $ P.decodeUtf8 $ BS.toStrict resultBS
|
||||||
|
pure $
|
||||||
|
if code == ExitSuccess
|
||||||
|
&& result /= ""
|
||||||
|
&& not ("which: no" `T.isInfixOf` result)
|
||||||
|
then Just $ T.unpack result
|
||||||
|
else Nothing
|
||||||
|
|
||||||
|
|
||||||
|
data SandboxingConfig = SandboxingConfig
|
||||||
|
{ firejail :: FilePath
|
||||||
|
, extraBinds :: [FilePath]
|
||||||
|
}
|
||||||
|
deriving (Show)
|
||||||
|
|
||||||
|
|
||||||
|
data ExternalAppContext = ExternalAppContext
|
||||||
|
{ sqlite :: FilePath
|
||||||
|
, sqliteLib :: Maybe FilePath
|
||||||
|
, baseUrl :: Text
|
||||||
|
}
|
||||||
|
deriving (Show)
|
||||||
|
|
||||||
|
|
||||||
|
getExternalAppContext :: Text -> IO ExternalAppContext
|
||||||
|
getExternalAppContext baseUrl = do
|
||||||
|
sqlite <- lookupBinaryPath "sqlite3"
|
||||||
|
sqliteEnv <- lookupEnv "AIRGQL_SQLITE_BIN"
|
||||||
|
sqliteLib <- lookupEnv "AIRGQL_SQLITE_LIB"
|
||||||
|
|
||||||
|
pure $
|
||||||
|
ExternalAppContext
|
||||||
|
{ baseUrl = baseUrl
|
||||||
|
, sqlite = P.fromMaybe "/usr/bin/sqlite3" $ sqliteEnv <|> sqlite
|
||||||
|
, sqliteLib =
|
||||||
|
sqliteLib
|
||||||
|
<|> if os == "darwin"
|
||||||
|
then Just "/usr/local/opt/sqlite/lib/libsqlite3.dylib"
|
||||||
|
else Nothing
|
||||||
|
}
|
47
source/AirGQL/GQLWrapper.hs
Normal file
47
source/AirGQL/GQLWrapper.hs
Normal file
|
@ -0,0 +1,47 @@
|
||||||
|
{-|
|
||||||
|
Increase readability of code
|
||||||
|
by wrapping `graphql` library with descriptive wrappers
|
||||||
|
-}
|
||||||
|
module AirGQL.GQLWrapper (
|
||||||
|
OutField (..),
|
||||||
|
outFieldToField,
|
||||||
|
InArgument (..),
|
||||||
|
inArgumentToArgument,
|
||||||
|
)
|
||||||
|
where
|
||||||
|
|
||||||
|
import Protolude (Maybe, Text)
|
||||||
|
|
||||||
|
import Language.GraphQL.Type (Value)
|
||||||
|
import Language.GraphQL.Type.In qualified as In
|
||||||
|
import Language.GraphQL.Type.Out qualified as Out
|
||||||
|
|
||||||
|
|
||||||
|
data OutField m = OutField
|
||||||
|
{ descriptionMb :: Maybe Text
|
||||||
|
, fieldType :: Out.Type m
|
||||||
|
, arguments :: In.Arguments
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
outFieldToField :: OutField m -> Out.Field m
|
||||||
|
outFieldToField outField =
|
||||||
|
Out.Field
|
||||||
|
outField.descriptionMb
|
||||||
|
outField.fieldType
|
||||||
|
outField.arguments
|
||||||
|
|
||||||
|
|
||||||
|
data InArgument = InArgument
|
||||||
|
{ argDescMb :: Maybe Text
|
||||||
|
, argType :: In.Type
|
||||||
|
, valueMb :: Maybe Value
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
inArgumentToArgument :: InArgument -> In.Argument
|
||||||
|
inArgumentToArgument inArgument =
|
||||||
|
In.Argument
|
||||||
|
inArgument.argDescMb
|
||||||
|
inArgument.argType
|
||||||
|
inArgument.valueMb
|
1674
source/AirGQL/GraphQL.hs
Normal file
1674
source/AirGQL/GraphQL.hs
Normal file
File diff suppressed because it is too large
Load diff
2540
source/AirGQL/Introspection.hs
Normal file
2540
source/AirGQL/Introspection.hs
Normal file
File diff suppressed because it is too large
Load diff
1272
source/AirGQL/Lib.hs
Normal file
1272
source/AirGQL/Lib.hs
Normal file
File diff suppressed because it is too large
Load diff
30
source/AirGQL/Raw.hs
Normal file
30
source/AirGQL/Raw.hs
Normal file
|
@ -0,0 +1,30 @@
|
||||||
|
{-# OPTIONS_GHC -Wno-deprecations #-}
|
||||||
|
|
||||||
|
module AirGQL.Raw (raw) where
|
||||||
|
|
||||||
|
import Protolude (pure, (.))
|
||||||
|
import Protolude.Error (error)
|
||||||
|
|
||||||
|
import Language.Haskell.TH (Exp (LitE), Lit (StringL))
|
||||||
|
import Language.Haskell.TH.Quote (
|
||||||
|
QuasiQuoter (QuasiQuoter, quoteDec, quoteExp, quotePat, quoteType),
|
||||||
|
)
|
||||||
|
|
||||||
|
|
||||||
|
raw :: QuasiQuoter
|
||||||
|
raw =
|
||||||
|
QuasiQuoter
|
||||||
|
{ quoteExp = pure . LitE . StringL
|
||||||
|
, quotePat = \_ ->
|
||||||
|
error
|
||||||
|
"Illegal raw string QuasiQuote \
|
||||||
|
\(allowed as expression only, used as a pattern)"
|
||||||
|
, quoteType = \_ ->
|
||||||
|
error
|
||||||
|
"Illegal raw string QuasiQuote \
|
||||||
|
\(allowed as expression only, used as a type)"
|
||||||
|
, quoteDec = \_ ->
|
||||||
|
error
|
||||||
|
"Illegal raw string QuasiQuote \
|
||||||
|
\(allowed as expression only, used as a declaration)"
|
||||||
|
}
|
46
source/AirGQL/Servant/Database.hs
Normal file
46
source/AirGQL/Servant/Database.hs
Normal file
|
@ -0,0 +1,46 @@
|
||||||
|
{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
|
||||||
|
|
||||||
|
{-# HLINT ignore "Use maybe" #-}
|
||||||
|
{-# HLINT ignore "Avoid lambda" #-}
|
||||||
|
{-# HLINT ignore "Replace case with maybe" #-}
|
||||||
|
|
||||||
|
module AirGQL.Servant.Database (
|
||||||
|
apiDatabaseSchemaGetHandler,
|
||||||
|
apiDatabaseVacuumPostHandler,
|
||||||
|
) where
|
||||||
|
|
||||||
|
import Protolude (
|
||||||
|
Applicative (pure),
|
||||||
|
MonadIO (liftIO),
|
||||||
|
Monoid (mempty),
|
||||||
|
($),
|
||||||
|
)
|
||||||
|
|
||||||
|
import Data.Aeson (Object)
|
||||||
|
import Data.Text (Text)
|
||||||
|
import Database.SQLite.Simple qualified as SS
|
||||||
|
import Servant.Server qualified as Servant
|
||||||
|
|
||||||
|
import AirGQL.ExternalAppContext (ExternalAppContext)
|
||||||
|
import AirGQL.Utils (
|
||||||
|
getMainDbPath,
|
||||||
|
runSqliteCommand,
|
||||||
|
withRetryConn,
|
||||||
|
)
|
||||||
|
|
||||||
|
|
||||||
|
apiDatabaseSchemaGetHandler
|
||||||
|
:: ExternalAppContext
|
||||||
|
-> Text
|
||||||
|
-> Servant.Handler Text
|
||||||
|
apiDatabaseSchemaGetHandler ctx dbId = do
|
||||||
|
runSqliteCommand ctx (getMainDbPath dbId) ".schema"
|
||||||
|
|
||||||
|
|
||||||
|
apiDatabaseVacuumPostHandler
|
||||||
|
:: Text
|
||||||
|
-> Servant.Handler Object
|
||||||
|
apiDatabaseVacuumPostHandler dbId = do
|
||||||
|
liftIO $ withRetryConn (getMainDbPath dbId) $ \conn ->
|
||||||
|
SS.execute_ conn "VACUUM"
|
||||||
|
pure mempty
|
149
source/AirGQL/Servant/GraphQL.hs
Normal file
149
source/AirGQL/Servant/GraphQL.hs
Normal file
|
@ -0,0 +1,149 @@
|
||||||
|
module AirGQL.Servant.GraphQL (
|
||||||
|
gqlQueryGetHandler,
|
||||||
|
gqlQueryPostHandler,
|
||||||
|
playgroundDefaultQueryHandler,
|
||||||
|
readOnlyGqlPostHandler,
|
||||||
|
writeOnlyGqlPostHandler,
|
||||||
|
) where
|
||||||
|
|
||||||
|
import Protolude (
|
||||||
|
Applicative (pure),
|
||||||
|
MonadIO (liftIO),
|
||||||
|
Monoid (mempty),
|
||||||
|
Semigroup ((<>)),
|
||||||
|
($),
|
||||||
|
(&),
|
||||||
|
)
|
||||||
|
import Protolude qualified as P
|
||||||
|
|
||||||
|
import Control.Monad.Catch (catchAll)
|
||||||
|
import Data.Aeson (Object)
|
||||||
|
import Data.Text (Text)
|
||||||
|
import Data.Text qualified as T
|
||||||
|
import DoubleXEncoding (doubleXEncodeGql)
|
||||||
|
import Servant (NoContent, err303, errHeaders)
|
||||||
|
import Servant.Server qualified as Servant
|
||||||
|
import System.Directory (makeAbsolute)
|
||||||
|
|
||||||
|
import AirGQL.Lib (
|
||||||
|
AccessMode (ReadOnly, WriteOnly),
|
||||||
|
column_name,
|
||||||
|
getColumns,
|
||||||
|
getTableNames,
|
||||||
|
)
|
||||||
|
import AirGQL.ServerUtils (executeQuery)
|
||||||
|
import AirGQL.Types.SchemaConf (SchemaConf (accessMode), defaultSchemaConf)
|
||||||
|
import AirGQL.Types.Types (GQLPost (operationName, query, variables))
|
||||||
|
import AirGQL.Utils (
|
||||||
|
getDbDir,
|
||||||
|
getMainDbPath,
|
||||||
|
getReadOnlyFilePath,
|
||||||
|
throwErr400WithMsg,
|
||||||
|
throwErr404WithMsg,
|
||||||
|
withRetryConn,
|
||||||
|
)
|
||||||
|
import System.FilePath (pathSeparator, takeDirectory)
|
||||||
|
|
||||||
|
|
||||||
|
gqlQueryGetHandler :: Text -> Servant.Handler NoContent
|
||||||
|
gqlQueryGetHandler dbId =
|
||||||
|
P.throwError
|
||||||
|
err303
|
||||||
|
{ errHeaders =
|
||||||
|
[("Location", P.encodeUtf8 $ "/dbs/" <> dbId <> "/graphiql")]
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
gqlQueryPostHandler
|
||||||
|
:: SchemaConf
|
||||||
|
-> Text
|
||||||
|
-> GQLPost
|
||||||
|
-> Servant.Handler Object
|
||||||
|
gqlQueryPostHandler schemaConf dbIdOrPath gqlPost = do
|
||||||
|
let
|
||||||
|
handleNoDbError :: P.SomeException -> Servant.Handler a
|
||||||
|
handleNoDbError excpetion = do
|
||||||
|
let errMsg = P.show excpetion
|
||||||
|
|
||||||
|
if "unable to open database file" `T.isInfixOf` errMsg
|
||||||
|
then
|
||||||
|
throwErr404WithMsg $
|
||||||
|
"Database \"" <> dbIdOrPath <> "\" does not exist"
|
||||||
|
else do
|
||||||
|
P.putErrLn $
|
||||||
|
"Error during execution of GraphQL query: " <> errMsg
|
||||||
|
throwErr400WithMsg errMsg
|
||||||
|
|
||||||
|
catchAll
|
||||||
|
( liftIO $ do
|
||||||
|
reqDir <-
|
||||||
|
if pathSeparator `T.elem` dbIdOrPath
|
||||||
|
then pure $ takeDirectory $ T.unpack dbIdOrPath
|
||||||
|
else makeAbsolute $ getDbDir dbIdOrPath
|
||||||
|
|
||||||
|
executeQuery
|
||||||
|
schemaConf
|
||||||
|
dbIdOrPath
|
||||||
|
reqDir
|
||||||
|
gqlPost.query
|
||||||
|
(gqlPost.variables & P.fromMaybe mempty)
|
||||||
|
gqlPost.operationName
|
||||||
|
)
|
||||||
|
handleNoDbError
|
||||||
|
|
||||||
|
|
||||||
|
readOnlyGqlPostHandler :: Text -> GQLPost -> Servant.Handler Object
|
||||||
|
readOnlyGqlPostHandler dbIdOrPath gqlPost =
|
||||||
|
liftIO $ do
|
||||||
|
reqDir <- makeAbsolute $ getReadOnlyFilePath dbIdOrPath
|
||||||
|
|
||||||
|
executeQuery
|
||||||
|
defaultSchemaConf{accessMode = ReadOnly}
|
||||||
|
dbIdOrPath
|
||||||
|
reqDir
|
||||||
|
gqlPost.query
|
||||||
|
(gqlPost.variables & P.fromMaybe mempty)
|
||||||
|
gqlPost.operationName
|
||||||
|
|
||||||
|
|
||||||
|
writeOnlyGqlPostHandler :: Text -> GQLPost -> Servant.Handler Object
|
||||||
|
writeOnlyGqlPostHandler dbPath gqlPost =
|
||||||
|
liftIO $ do
|
||||||
|
reqDir <- makeAbsolute $ getReadOnlyFilePath dbPath
|
||||||
|
|
||||||
|
executeQuery
|
||||||
|
defaultSchemaConf{accessMode = WriteOnly}
|
||||||
|
dbPath
|
||||||
|
reqDir
|
||||||
|
gqlPost.query
|
||||||
|
(gqlPost.variables & P.fromMaybe mempty)
|
||||||
|
gqlPost.operationName
|
||||||
|
|
||||||
|
|
||||||
|
playgroundDefaultQueryHandler
|
||||||
|
:: Text
|
||||||
|
-> Servant.Handler Text
|
||||||
|
playgroundDefaultQueryHandler dbId = do
|
||||||
|
liftIO $ withRetryConn (getMainDbPath dbId) $ \mainConn -> do
|
||||||
|
tableEntries <- getTableNames mainConn
|
||||||
|
|
||||||
|
case tableEntries of
|
||||||
|
(headTable : _) -> do
|
||||||
|
cols <- getColumns dbId mainConn headTable
|
||||||
|
pure $
|
||||||
|
P.fold
|
||||||
|
[ "query "
|
||||||
|
, doubleXEncodeGql headTable
|
||||||
|
, "Query {\n"
|
||||||
|
, " "
|
||||||
|
, doubleXEncodeGql headTable
|
||||||
|
, "( limit: 100 ) {\n"
|
||||||
|
, cols
|
||||||
|
& P.foldMap
|
||||||
|
( \col ->
|
||||||
|
" " <> doubleXEncodeGql col.column_name <> "\n"
|
||||||
|
)
|
||||||
|
, " }\n"
|
||||||
|
, "}"
|
||||||
|
]
|
||||||
|
_ -> pure ""
|
198
source/AirGQL/Servant/SqlQuery.hs
Normal file
198
source/AirGQL/Servant/SqlQuery.hs
Normal file
|
@ -0,0 +1,198 @@
|
||||||
|
module AirGQL.Servant.SqlQuery (
|
||||||
|
getAffectedTables,
|
||||||
|
sqlQueryPostHandler,
|
||||||
|
)
|
||||||
|
where
|
||||||
|
|
||||||
|
import Protolude (
|
||||||
|
Applicative (pure),
|
||||||
|
Either (Left, Right),
|
||||||
|
Maybe (Just, Nothing),
|
||||||
|
MonadIO (liftIO),
|
||||||
|
Semigroup ((<>)),
|
||||||
|
otherwise,
|
||||||
|
show,
|
||||||
|
when,
|
||||||
|
($),
|
||||||
|
(&),
|
||||||
|
(*),
|
||||||
|
(-),
|
||||||
|
(/=),
|
||||||
|
(<&>),
|
||||||
|
(>),
|
||||||
|
)
|
||||||
|
import Protolude qualified as P
|
||||||
|
|
||||||
|
import Data.Aeson.Key qualified as Key
|
||||||
|
import Data.Aeson.KeyMap qualified as KeyMap
|
||||||
|
import Data.Text (Text)
|
||||||
|
import Data.Text qualified as T
|
||||||
|
import Data.Time (diffUTCTime, getCurrentTime, nominalDiffTimeToSeconds)
|
||||||
|
import Database.SQLite.Simple qualified as SS
|
||||||
|
import Language.SQL.SimpleSQL.Parse (ParseError (peFormattedError))
|
||||||
|
import Language.SQL.SimpleSQL.Syntax (Statement (CreateTable))
|
||||||
|
import Servant.Server qualified as Servant
|
||||||
|
import System.Timeout (timeout)
|
||||||
|
|
||||||
|
import AirGQL.Config (defaultConfig, sqlTimeoutTime)
|
||||||
|
import AirGQL.Lib (
|
||||||
|
SQLPost (query),
|
||||||
|
TableEntryRaw (sql, tbl_name),
|
||||||
|
getTables,
|
||||||
|
lintTableCreationCode,
|
||||||
|
parseSql,
|
||||||
|
sqlDataToAesonValue,
|
||||||
|
)
|
||||||
|
import AirGQL.Types.PragmaConf (PragmaConf, getSQLitePragmas)
|
||||||
|
import AirGQL.Types.SqlQueryPostResult (
|
||||||
|
SqlQueryPostResult (
|
||||||
|
SqlQueryPostResult,
|
||||||
|
affectedTables,
|
||||||
|
columns,
|
||||||
|
errors,
|
||||||
|
rows,
|
||||||
|
runtimeSeconds
|
||||||
|
),
|
||||||
|
resultWithErrors,
|
||||||
|
)
|
||||||
|
import AirGQL.Utils (
|
||||||
|
getMainDbPath,
|
||||||
|
throwErr400WithMsg,
|
||||||
|
withRetryConn,
|
||||||
|
)
|
||||||
|
|
||||||
|
|
||||||
|
getAffectedTables :: [TableEntryRaw] -> [TableEntryRaw] -> [Text]
|
||||||
|
getAffectedTables pre post =
|
||||||
|
let
|
||||||
|
loop left right = do
|
||||||
|
case (left, right) of
|
||||||
|
([], _) -> right <&> tbl_name
|
||||||
|
(_, []) -> left <&> tbl_name
|
||||||
|
(headLeft : tailLeft, headRight : tailRight) ->
|
||||||
|
case P.compare headLeft.tbl_name headRight.tbl_name of
|
||||||
|
P.LT -> headLeft.tbl_name : loop tailLeft right
|
||||||
|
P.GT -> headRight.tbl_name : loop left tailRight
|
||||||
|
P.EQ
|
||||||
|
| headLeft.sql /= headRight.sql ->
|
||||||
|
headLeft.tbl_name : loop tailLeft tailRight
|
||||||
|
| otherwise ->
|
||||||
|
loop tailLeft tailRight
|
||||||
|
in
|
||||||
|
loop
|
||||||
|
(P.sortOn tbl_name pre)
|
||||||
|
(P.sortOn tbl_name post)
|
||||||
|
|
||||||
|
|
||||||
|
sqlQueryPostHandler
|
||||||
|
:: PragmaConf
|
||||||
|
-> Text
|
||||||
|
-> SQLPost
|
||||||
|
-> Servant.Handler SqlQueryPostResult
|
||||||
|
sqlQueryPostHandler pragmaConf dbId sqlPost = do
|
||||||
|
let maxSqlQueryLength :: P.Int = 100_000
|
||||||
|
|
||||||
|
when (T.length sqlPost.query > maxSqlQueryLength) $ do
|
||||||
|
throwErr400WithMsg $
|
||||||
|
"SQL query is too long ("
|
||||||
|
<> show (T.length sqlPost.query)
|
||||||
|
<> " characters, maximum is "
|
||||||
|
<> show maxSqlQueryLength
|
||||||
|
<> ")"
|
||||||
|
|
||||||
|
validationErrors <- liftIO $ case parseSql sqlPost.query of
|
||||||
|
Left error -> pure [T.pack error.peFormattedError]
|
||||||
|
Right statement@(CreateTable _ _) ->
|
||||||
|
SS.withConnection (getMainDbPath dbId) $ \conn ->
|
||||||
|
lintTableCreationCode (Just conn) statement
|
||||||
|
_ -> pure []
|
||||||
|
|
||||||
|
case validationErrors of
|
||||||
|
[] -> do
|
||||||
|
let
|
||||||
|
dbFilePath = getMainDbPath dbId
|
||||||
|
microsecondsPerSecond = 1000000 :: P.Int
|
||||||
|
|
||||||
|
timeoutTimeMicroseconds =
|
||||||
|
defaultConfig.sqlTimeoutTime
|
||||||
|
* microsecondsPerSecond
|
||||||
|
|
||||||
|
sqlitePragmas <- liftIO $ getSQLitePragmas pragmaConf
|
||||||
|
|
||||||
|
let
|
||||||
|
performSqlOperations =
|
||||||
|
withRetryConn dbFilePath $ \conn -> do
|
||||||
|
preTables <- getTables conn
|
||||||
|
|
||||||
|
P.for_ sqlitePragmas $ SS.execute_ conn
|
||||||
|
SS.execute_ conn "PRAGMA foreign_keys = True"
|
||||||
|
|
||||||
|
let query = SS.Query sqlPost.query
|
||||||
|
|
||||||
|
columnNames <- SS.withStatement conn query $ \statement -> do
|
||||||
|
numCols <- SS.columnCount statement
|
||||||
|
P.for [0 .. (numCols - 1)] $ SS.columnName statement
|
||||||
|
|
||||||
|
tableRowsMb :: Maybe [[SS.SQLData]] <-
|
||||||
|
timeout timeoutTimeMicroseconds $ SS.query_ conn query
|
||||||
|
changes <- SS.changes conn
|
||||||
|
|
||||||
|
postTables <- getTables conn
|
||||||
|
|
||||||
|
pure $ case tableRowsMb of
|
||||||
|
Just tableRows ->
|
||||||
|
Right (columnNames, tableRows, changes, preTables, postTables)
|
||||||
|
Nothing -> Left "Sql query execution timed out"
|
||||||
|
|
||||||
|
startTime <- liftIO getCurrentTime
|
||||||
|
sqlResults <-
|
||||||
|
liftIO $
|
||||||
|
P.catches
|
||||||
|
performSqlOperations
|
||||||
|
[ P.Handler $
|
||||||
|
\(error :: SS.SQLError) -> pure $ Left $ show error
|
||||||
|
, P.Handler $
|
||||||
|
\(error :: SS.ResultError) -> pure $ Left $ show error
|
||||||
|
, P.Handler $
|
||||||
|
\(error :: SS.FormatError) -> pure $ Left $ show error
|
||||||
|
]
|
||||||
|
endTime <- liftIO getCurrentTime
|
||||||
|
|
||||||
|
let measuredTime =
|
||||||
|
nominalDiffTimeToSeconds
|
||||||
|
(diffUTCTime endTime startTime)
|
||||||
|
|
||||||
|
case sqlResults of
|
||||||
|
Left error ->
|
||||||
|
pure $ resultWithErrors measuredTime [error]
|
||||||
|
Right (columnNames, tableRows, changes, preTables, postTables) -> do
|
||||||
|
-- TODO: Use GQL error format {"message": "…", "code": …, …} instead
|
||||||
|
let
|
||||||
|
keys = columnNames <&> Key.fromText
|
||||||
|
|
||||||
|
rowList =
|
||||||
|
tableRows
|
||||||
|
<&> \row ->
|
||||||
|
row
|
||||||
|
<&> sqlDataToAesonValue ""
|
||||||
|
& P.zip keys
|
||||||
|
& KeyMap.fromList
|
||||||
|
|
||||||
|
affectedTables =
|
||||||
|
if changes > 0
|
||||||
|
then postTables <&> tbl_name
|
||||||
|
else getAffectedTables preTables postTables
|
||||||
|
|
||||||
|
pure $
|
||||||
|
SqlQueryPostResult
|
||||||
|
{ rows = rowList
|
||||||
|
, columns = columnNames
|
||||||
|
, runtimeSeconds = measuredTime
|
||||||
|
, affectedTables = affectedTables
|
||||||
|
, errors = []
|
||||||
|
}
|
||||||
|
_ ->
|
||||||
|
pure $
|
||||||
|
resultWithErrors
|
||||||
|
0
|
||||||
|
validationErrors
|
71
source/AirGQL/ServerUtils.hs
Normal file
71
source/AirGQL/ServerUtils.hs
Normal file
|
@ -0,0 +1,71 @@
|
||||||
|
module AirGQL.ServerUtils (
|
||||||
|
executeQuery,
|
||||||
|
) where
|
||||||
|
|
||||||
|
import Protolude (
|
||||||
|
Applicative (pure),
|
||||||
|
Either (Left, Right),
|
||||||
|
FilePath,
|
||||||
|
IO,
|
||||||
|
Maybe (Just, Nothing),
|
||||||
|
toList,
|
||||||
|
($),
|
||||||
|
(&),
|
||||||
|
(<&>),
|
||||||
|
)
|
||||||
|
import Protolude qualified as P
|
||||||
|
|
||||||
|
import Conduit (sourceToList)
|
||||||
|
import Control.Arrow ((>>>))
|
||||||
|
import Data.Aeson (Object, Value (String))
|
||||||
|
import Data.Text (Text)
|
||||||
|
import Data.Text qualified as T
|
||||||
|
import Database.SQLite.Simple qualified as SS
|
||||||
|
import Language.GraphQL.Error (Error (Error), Response (Response))
|
||||||
|
import Language.GraphQL.JSON (graphql)
|
||||||
|
import System.FilePath (pathSeparator, (</>))
|
||||||
|
|
||||||
|
import AirGQL.GraphQL (getDerivedSchema)
|
||||||
|
import AirGQL.Lib (getTables)
|
||||||
|
import AirGQL.Types.SchemaConf (SchemaConf)
|
||||||
|
import AirGQL.Types.Types (
|
||||||
|
GQLResponse (GQLResponse, data_, errors),
|
||||||
|
gqlResponseToObject,
|
||||||
|
)
|
||||||
|
|
||||||
|
|
||||||
|
executeQuery
|
||||||
|
:: SchemaConf
|
||||||
|
-> Text
|
||||||
|
-> FilePath
|
||||||
|
-> Text
|
||||||
|
-> Object
|
||||||
|
-> Maybe Text
|
||||||
|
-> IO Object
|
||||||
|
executeQuery schemaConf dbIdOrPath reqDir query vars opNameMb = do
|
||||||
|
let dbFilePath =
|
||||||
|
if pathSeparator `T.elem` dbIdOrPath
|
||||||
|
then T.unpack dbIdOrPath
|
||||||
|
else reqDir </> "main.sqlite"
|
||||||
|
|
||||||
|
theConn <- SS.open dbFilePath
|
||||||
|
tables <- getTables theConn
|
||||||
|
schema <- getDerivedSchema schemaConf theConn dbIdOrPath tables
|
||||||
|
result <- graphql schema opNameMb vars query
|
||||||
|
SS.close theConn
|
||||||
|
|
||||||
|
case result of
|
||||||
|
Left errMsg -> do
|
||||||
|
errors <- sourceToList errMsg
|
||||||
|
pure $
|
||||||
|
gqlResponseToObject $
|
||||||
|
GQLResponse
|
||||||
|
{ data_ = Nothing
|
||||||
|
, errors =
|
||||||
|
Just $
|
||||||
|
errors
|
||||||
|
<&> ((\(Response _ errs) -> errs) >>> toList)
|
||||||
|
& P.concat
|
||||||
|
<&> (\(Error msg _ _) -> String msg)
|
||||||
|
}
|
||||||
|
Right response -> pure response
|
28
source/AirGQL/Types/OutObjectType.hs
Normal file
28
source/AirGQL/Types/OutObjectType.hs
Normal file
|
@ -0,0 +1,28 @@
|
||||||
|
module AirGQL.Types.OutObjectType (
|
||||||
|
OutObjectType (OutObjectType, name, descriptionMb, interfaceTypes, fields),
|
||||||
|
outObjectTypeToObjectType,
|
||||||
|
)
|
||||||
|
where
|
||||||
|
|
||||||
|
import Protolude (Maybe, Text, (&))
|
||||||
|
|
||||||
|
import Data.HashMap.Strict (HashMap)
|
||||||
|
import Language.GraphQL.Type (InterfaceType)
|
||||||
|
import Language.GraphQL.Type.Out qualified as Out
|
||||||
|
|
||||||
|
|
||||||
|
data OutObjectType m = OutObjectType
|
||||||
|
{ name :: Text
|
||||||
|
, descriptionMb :: Maybe Text
|
||||||
|
, interfaceTypes :: [InterfaceType m]
|
||||||
|
, fields :: HashMap Text (Out.Resolver m)
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
outObjectTypeToObjectType :: OutObjectType m -> Out.ObjectType m
|
||||||
|
outObjectTypeToObjectType objectType =
|
||||||
|
Out.ObjectType
|
||||||
|
(objectType & name)
|
||||||
|
(objectType & (descriptionMb :: OutObjectType m -> Maybe Text))
|
||||||
|
(objectType & interfaceTypes)
|
||||||
|
(objectType & fields)
|
56
source/AirGQL/Types/PragmaConf.hs
Normal file
56
source/AirGQL/Types/PragmaConf.hs
Normal file
|
@ -0,0 +1,56 @@
|
||||||
|
module AirGQL.Types.PragmaConf (
|
||||||
|
PragmaConf (..),
|
||||||
|
getSQLitePragmas,
|
||||||
|
defaultConf,
|
||||||
|
)
|
||||||
|
where
|
||||||
|
|
||||||
|
import Protolude (
|
||||||
|
Bool (True),
|
||||||
|
IO,
|
||||||
|
Int,
|
||||||
|
Integer,
|
||||||
|
pure,
|
||||||
|
show,
|
||||||
|
($),
|
||||||
|
(<>),
|
||||||
|
)
|
||||||
|
|
||||||
|
import Database.SQLite.Simple qualified as SS
|
||||||
|
|
||||||
|
|
||||||
|
data PragmaConf = PragmaConf
|
||||||
|
{ maxPageCount :: Int
|
||||||
|
, hardHeapLimit :: Integer
|
||||||
|
, allowRecursTrig :: Bool
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
defaultConf :: PragmaConf
|
||||||
|
defaultConf =
|
||||||
|
PragmaConf
|
||||||
|
{ maxPageCount = 4096
|
||||||
|
, hardHeapLimit = 500_000_000 -- Bytes
|
||||||
|
, allowRecursTrig = True
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
-- | Get the SQLite pragmas to use for a database
|
||||||
|
getSQLitePragmas :: PragmaConf -> IO [SS.Query]
|
||||||
|
getSQLitePragmas pragConf = do
|
||||||
|
let
|
||||||
|
getPrag key value =
|
||||||
|
SS.Query $ "PRAGMA " <> key <> " = " <> value
|
||||||
|
|
||||||
|
pure
|
||||||
|
[ getPrag "case_sensitive_like" "True"
|
||||||
|
, getPrag "foreign_keys" "True"
|
||||||
|
, -- TODO: Check if this really works
|
||||||
|
getPrag "hard_heap_limit" $ show @Integer pragConf.hardHeapLimit
|
||||||
|
, getPrag "max_page_count" $ show @Int pragConf.maxPageCount
|
||||||
|
, getPrag "recursive_triggers" $ show @Bool pragConf.allowRecursTrig
|
||||||
|
, -- TODO: Reactivate after https://sqlite.org/forum/forumpost/d7b9a365e0
|
||||||
|
-- (Also activate in SqlQuery.hs)
|
||||||
|
-- , getPrag "trusted_schema" "False"
|
||||||
|
getPrag "writable_schema" "False"
|
||||||
|
]
|
26
source/AirGQL/Types/SchemaConf.hs
Normal file
26
source/AirGQL/Types/SchemaConf.hs
Normal file
|
@ -0,0 +1,26 @@
|
||||||
|
module AirGQL.Types.SchemaConf (
|
||||||
|
SchemaConf (..),
|
||||||
|
defaultSchemaConf,
|
||||||
|
) where
|
||||||
|
|
||||||
|
import Protolude (Integer)
|
||||||
|
|
||||||
|
import AirGQL.Lib (AccessMode (ReadAndWrite))
|
||||||
|
import AirGQL.Types.PragmaConf (PragmaConf, defaultConf)
|
||||||
|
|
||||||
|
|
||||||
|
data SchemaConf = SchemaConf
|
||||||
|
{ accessMode :: AccessMode
|
||||||
|
, pragmaConf :: PragmaConf
|
||||||
|
, maxRowsPerTable :: Integer
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
-- | Default schema configuration
|
||||||
|
defaultSchemaConf :: SchemaConf
|
||||||
|
defaultSchemaConf =
|
||||||
|
SchemaConf
|
||||||
|
{ accessMode = ReadAndWrite
|
||||||
|
, pragmaConf = AirGQL.Types.PragmaConf.defaultConf
|
||||||
|
, maxRowsPerTable = 100_000
|
||||||
|
}
|
107
source/AirGQL/Types/SqlQueryPostResult.hs
Normal file
107
source/AirGQL/Types/SqlQueryPostResult.hs
Normal file
|
@ -0,0 +1,107 @@
|
||||||
|
module AirGQL.Types.SqlQueryPostResult (
|
||||||
|
SqlQueryPostResult (..),
|
||||||
|
resultWithErrors,
|
||||||
|
)
|
||||||
|
where
|
||||||
|
|
||||||
|
import Protolude (
|
||||||
|
Generic,
|
||||||
|
Show,
|
||||||
|
Text,
|
||||||
|
foldMap,
|
||||||
|
fromMaybe,
|
||||||
|
($),
|
||||||
|
(&),
|
||||||
|
(<>),
|
||||||
|
)
|
||||||
|
|
||||||
|
import Control.Arrow ((>>>))
|
||||||
|
import Data.Aeson (
|
||||||
|
FromJSON,
|
||||||
|
Object,
|
||||||
|
ToJSON,
|
||||||
|
Value (Null, Number),
|
||||||
|
)
|
||||||
|
import Data.Aeson.Encoding (list, pair, pairs)
|
||||||
|
import Data.Aeson.Key qualified as Key
|
||||||
|
import Data.Aeson.KeyMap qualified as KeyMap
|
||||||
|
import Data.Aeson.Types (toEncoding, (.=))
|
||||||
|
import Data.Fixed (Pico)
|
||||||
|
import Servant.Docs (ToSample (toSamples), singleSample)
|
||||||
|
|
||||||
|
|
||||||
|
data SqlQueryPostResult = SqlQueryPostResult
|
||||||
|
{ affectedTables :: [Text]
|
||||||
|
, rows :: [Object]
|
||||||
|
, columns :: [Text] -- Only necessary for order of columns in the result
|
||||||
|
, runtimeSeconds :: Pico -- Precision contained by `NominalDiffTime`
|
||||||
|
, errors :: [Text]
|
||||||
|
}
|
||||||
|
deriving (Show, Generic)
|
||||||
|
|
||||||
|
|
||||||
|
instance FromJSON SqlQueryPostResult
|
||||||
|
|
||||||
|
|
||||||
|
{-| 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.
|
||||||
|
-}
|
||||||
|
instance ToJSON SqlQueryPostResult where
|
||||||
|
toEncoding sqlQueryPostResult =
|
||||||
|
pairs $
|
||||||
|
"affectedTables" .= sqlQueryPostResult.affectedTables
|
||||||
|
<> "rows"
|
||||||
|
`pair` ( sqlQueryPostResult.rows
|
||||||
|
& list
|
||||||
|
( \(row :: Object) ->
|
||||||
|
-- Apply order of columns
|
||||||
|
sqlQueryPostResult.columns
|
||||||
|
& foldMap
|
||||||
|
( Key.fromText
|
||||||
|
>>> ( \col ->
|
||||||
|
col
|
||||||
|
.= ( row
|
||||||
|
& KeyMap.lookup col
|
||||||
|
& fromMaybe Null
|
||||||
|
)
|
||||||
|
)
|
||||||
|
)
|
||||||
|
& pairs
|
||||||
|
)
|
||||||
|
)
|
||||||
|
<> "runtimeSeconds" .= sqlQueryPostResult.runtimeSeconds
|
||||||
|
<> "errors" .= sqlQueryPostResult.errors
|
||||||
|
|
||||||
|
|
||||||
|
instance ToSample SqlQueryPostResult where
|
||||||
|
toSamples _ =
|
||||||
|
singleSample $
|
||||||
|
SqlQueryPostResult
|
||||||
|
{ affectedTables = ["users"]
|
||||||
|
, rows =
|
||||||
|
[ KeyMap.fromList
|
||||||
|
[ (Key.fromText "id", Number 1)
|
||||||
|
, (Key.fromText "name", "John")
|
||||||
|
]
|
||||||
|
, KeyMap.fromList
|
||||||
|
[ (Key.fromText "id", Number 2)
|
||||||
|
, (Key.fromText "name", "Jane")
|
||||||
|
]
|
||||||
|
]
|
||||||
|
, columns = ["id", "name"]
|
||||||
|
, runtimeSeconds = 0.05
|
||||||
|
, errors = []
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
-- | Construct a result for a failed sql query execution.
|
||||||
|
resultWithErrors :: Pico -> [Text] -> SqlQueryPostResult
|
||||||
|
resultWithErrors runtimeSeconds errors =
|
||||||
|
SqlQueryPostResult
|
||||||
|
{ affectedTables = []
|
||||||
|
, rows = []
|
||||||
|
, columns = []
|
||||||
|
, runtimeSeconds = runtimeSeconds
|
||||||
|
, errors = errors
|
||||||
|
}
|
31
source/AirGQL/Types/TextNullable.hs
Normal file
31
source/AirGQL/Types/TextNullable.hs
Normal file
|
@ -0,0 +1,31 @@
|
||||||
|
module AirGQL.Types.TextNullable (
|
||||||
|
TextNullable (..),
|
||||||
|
)
|
||||||
|
where
|
||||||
|
|
||||||
|
import Protolude (
|
||||||
|
Eq,
|
||||||
|
Generic,
|
||||||
|
Show,
|
||||||
|
Text,
|
||||||
|
pure,
|
||||||
|
($),
|
||||||
|
)
|
||||||
|
|
||||||
|
import Data.Aeson (
|
||||||
|
FromJSON,
|
||||||
|
ToJSON,
|
||||||
|
Value (Null, String),
|
||||||
|
parseJSON,
|
||||||
|
)
|
||||||
|
|
||||||
|
|
||||||
|
data TextNullable = TextUndefined | TextNull | TextValue Text
|
||||||
|
deriving (Show, Eq, Generic)
|
||||||
|
|
||||||
|
|
||||||
|
instance FromJSON TextNullable where
|
||||||
|
parseJSON (String str) = pure $ TextValue str
|
||||||
|
parseJSON Null = pure TextNull
|
||||||
|
parseJSON _ = pure TextUndefined
|
||||||
|
instance ToJSON TextNullable
|
135
source/AirGQL/Types/Types.hs
Normal file
135
source/AirGQL/Types/Types.hs
Normal file
|
@ -0,0 +1,135 @@
|
||||||
|
module AirGQL.Types.Types (
|
||||||
|
FileFormat (..),
|
||||||
|
FilenameField (..),
|
||||||
|
GQLPost (..),
|
||||||
|
GQLResponse (..),
|
||||||
|
gqlResponseToObject,
|
||||||
|
MetadataPair (..),
|
||||||
|
RawJsonMime,
|
||||||
|
Database (..),
|
||||||
|
UsageError (..),
|
||||||
|
)
|
||||||
|
where
|
||||||
|
|
||||||
|
import Protolude (
|
||||||
|
Eq,
|
||||||
|
Generic,
|
||||||
|
Maybe (Nothing),
|
||||||
|
Monoid (mempty),
|
||||||
|
Show,
|
||||||
|
Text,
|
||||||
|
)
|
||||||
|
import Protolude qualified as P
|
||||||
|
|
||||||
|
import Data.Aeson (
|
||||||
|
FromJSON,
|
||||||
|
KeyValue ((.=)),
|
||||||
|
Object,
|
||||||
|
ToJSON (toJSON),
|
||||||
|
Value (Object),
|
||||||
|
object,
|
||||||
|
)
|
||||||
|
import Database.SQLite.Simple qualified as SS
|
||||||
|
import Servant.Docs (ToSample (toSamples), singleSample)
|
||||||
|
|
||||||
|
|
||||||
|
-- Necessary to avoid JSON string quoting
|
||||||
|
data RawJsonMime
|
||||||
|
|
||||||
|
|
||||||
|
data FileFormat
|
||||||
|
= SQLiteFile
|
||||||
|
| CSVFile
|
||||||
|
| PlainTextFile
|
||||||
|
| DisallowedFile Text
|
||||||
|
deriving (Show, Eq)
|
||||||
|
|
||||||
|
|
||||||
|
data GQLPost = GQLPost
|
||||||
|
{ query :: Text
|
||||||
|
, operationName :: Maybe Text
|
||||||
|
, variables :: Maybe Object
|
||||||
|
}
|
||||||
|
deriving (Eq, Show, Generic)
|
||||||
|
|
||||||
|
|
||||||
|
instance ToJSON GQLPost
|
||||||
|
instance FromJSON GQLPost
|
||||||
|
|
||||||
|
|
||||||
|
instance ToSample GQLPost where
|
||||||
|
toSamples _ =
|
||||||
|
singleSample
|
||||||
|
GQLPost
|
||||||
|
{ query = "{ users { name, email } }"
|
||||||
|
, variables = Nothing
|
||||||
|
, operationName = Nothing
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
data GQLResponse = GQLResponse
|
||||||
|
{ data_ :: Maybe Value
|
||||||
|
, errors :: Maybe [Value]
|
||||||
|
}
|
||||||
|
deriving (Eq, Show, Generic)
|
||||||
|
|
||||||
|
|
||||||
|
instance ToJSON GQLResponse where
|
||||||
|
toJSON GQLResponse{data_, errors} =
|
||||||
|
object
|
||||||
|
[ "data" .= data_
|
||||||
|
, "errors" .= errors
|
||||||
|
]
|
||||||
|
|
||||||
|
|
||||||
|
-- emptyGQLResponse :: GQLResponse
|
||||||
|
-- emptyGQLResponse = GQLResponse
|
||||||
|
-- { data_ = Nothing
|
||||||
|
-- , errors = Nothing
|
||||||
|
-- }
|
||||||
|
|
||||||
|
newtype FilenameField = FilenameField Text
|
||||||
|
deriving (Generic, Show)
|
||||||
|
|
||||||
|
|
||||||
|
instance SS.FromRow FilenameField
|
||||||
|
|
||||||
|
|
||||||
|
data MetadataPair = MetadataPair
|
||||||
|
{ attribute :: Text
|
||||||
|
, value :: Text
|
||||||
|
}
|
||||||
|
deriving (Eq, Show, Generic)
|
||||||
|
|
||||||
|
|
||||||
|
instance SS.FromRow MetadataPair
|
||||||
|
|
||||||
|
|
||||||
|
gqlResponseToObject :: GQLResponse -> Object
|
||||||
|
gqlResponseToObject gqlRes =
|
||||||
|
case toJSON gqlRes of
|
||||||
|
Object obj -> obj
|
||||||
|
_ -> mempty
|
||||||
|
|
||||||
|
|
||||||
|
data Database = Database
|
||||||
|
{ id :: Text
|
||||||
|
, name :: Text
|
||||||
|
, environment :: Maybe Text
|
||||||
|
, ownership_utc :: Text
|
||||||
|
}
|
||||||
|
deriving (Generic, Show)
|
||||||
|
|
||||||
|
|
||||||
|
instance FromJSON Database
|
||||||
|
instance ToJSON Database
|
||||||
|
instance SS.FromRow Database
|
||||||
|
|
||||||
|
|
||||||
|
-- Errors
|
||||||
|
|
||||||
|
newtype UsageError = UsageError Text
|
||||||
|
deriving (Eq, Show)
|
||||||
|
|
||||||
|
|
||||||
|
instance P.Exception UsageError
|
14
source/AirGQL/Types/Utils.hs
Normal file
14
source/AirGQL/Types/Utils.hs
Normal file
|
@ -0,0 +1,14 @@
|
||||||
|
module AirGQL.Types.Utils (
|
||||||
|
encodeToText,
|
||||||
|
)
|
||||||
|
where
|
||||||
|
|
||||||
|
import Data.Aeson (ToJSON, encode)
|
||||||
|
import Data.ByteString.Lazy (toStrict)
|
||||||
|
import Data.Text.Encoding (decodeUtf8)
|
||||||
|
import Protolude (Text, (.))
|
||||||
|
|
||||||
|
|
||||||
|
encodeToText :: (ToJSON a) => a -> Text
|
||||||
|
encodeToText =
|
||||||
|
decodeUtf8 . toStrict . encode
|
361
source/AirGQL/Utils.hs
Normal file
361
source/AirGQL/Utils.hs
Normal file
|
@ -0,0 +1,361 @@
|
||||||
|
-- For embedded SQL queries
|
||||||
|
{-# LANGUAGE QuasiQuotes #-}
|
||||||
|
{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
|
||||||
|
|
||||||
|
{-# HLINT ignore "Use maybe" #-}
|
||||||
|
-- HLint can't figure out where TemplateHaskell is used,
|
||||||
|
-- even though it throws an error without the pragma.
|
||||||
|
{-# HLINT ignore "Unused LANGUAGE pragma" #-}
|
||||||
|
|
||||||
|
module AirGQL.Utils (
|
||||||
|
collectAllErrorsAsText,
|
||||||
|
collectErrorList,
|
||||||
|
colToFileUrl,
|
||||||
|
escDoubleQuotes,
|
||||||
|
escSingleQuotes,
|
||||||
|
getDbDir,
|
||||||
|
getGraphiQLVersion,
|
||||||
|
getMainDbPath,
|
||||||
|
getOrderOfLinkedList,
|
||||||
|
getReadOnlyFilePath,
|
||||||
|
getDbIdFromReadOnlyId,
|
||||||
|
getSqliteBinaryVersion,
|
||||||
|
getSqliteEmbeddedVersion,
|
||||||
|
headerJsonContent,
|
||||||
|
quoteKeyword,
|
||||||
|
quoteText,
|
||||||
|
removeIfExists,
|
||||||
|
runSqliteCommand,
|
||||||
|
throwErr400WithMsg,
|
||||||
|
throwErr404WithMsg,
|
||||||
|
throwErr500WithMsg,
|
||||||
|
withRetryConn,
|
||||||
|
DiffKind (..),
|
||||||
|
) where
|
||||||
|
|
||||||
|
import Protolude (
|
||||||
|
Applicative (pure),
|
||||||
|
ExitCode (ExitFailure, ExitSuccess),
|
||||||
|
FilePath,
|
||||||
|
IO,
|
||||||
|
Maybe (Just, Nothing),
|
||||||
|
Monoid (mempty),
|
||||||
|
Semigroup ((<>)),
|
||||||
|
Text,
|
||||||
|
catch,
|
||||||
|
liftIO,
|
||||||
|
not,
|
||||||
|
show,
|
||||||
|
throwError,
|
||||||
|
throwIO,
|
||||||
|
when,
|
||||||
|
($),
|
||||||
|
(&),
|
||||||
|
(.),
|
||||||
|
(/=),
|
||||||
|
(<&>),
|
||||||
|
)
|
||||||
|
import Protolude qualified as P
|
||||||
|
|
||||||
|
import Control.Monad.Catch (catchAll)
|
||||||
|
import Data.Aeson (KeyValue ((.=)), Value (String), encode, object)
|
||||||
|
import Data.ByteString qualified as BS
|
||||||
|
import Data.ByteString.Builder (toLazyByteString)
|
||||||
|
import Data.ByteString.Lazy qualified as BL
|
||||||
|
import Data.Either.Extra (mapLeft)
|
||||||
|
import Data.List qualified as List
|
||||||
|
import Data.Text qualified as T
|
||||||
|
import Data.Text.Encoding qualified as T
|
||||||
|
import Database.SQLite.Simple (Connection)
|
||||||
|
import Database.SQLite.Simple qualified as SS
|
||||||
|
import Network.HTTP.Types (HeaderName, encodePathSegments)
|
||||||
|
import Servant.Server (
|
||||||
|
ServerError (errBody, errHeaders),
|
||||||
|
err400,
|
||||||
|
err404,
|
||||||
|
err500,
|
||||||
|
)
|
||||||
|
import Servant.Server qualified as Servant
|
||||||
|
import System.Directory (removeFile)
|
||||||
|
import System.FilePath (takeFileName, (</>))
|
||||||
|
import System.IO.Error (IOError, isDoesNotExistError)
|
||||||
|
import System.Posix.Files (readSymbolicLink)
|
||||||
|
import System.Process (readProcess)
|
||||||
|
import System.Process.Typed (
|
||||||
|
byteStringInput,
|
||||||
|
createPipe,
|
||||||
|
proc,
|
||||||
|
readProcessInterleaved,
|
||||||
|
setStderr,
|
||||||
|
setStdin,
|
||||||
|
setStdout,
|
||||||
|
)
|
||||||
|
|
||||||
|
import AirGQL.ExternalAppContext (ExternalAppContext (sqlite))
|
||||||
|
|
||||||
|
|
||||||
|
getDbDir :: Text -> FilePath
|
||||||
|
getDbDir dbId =
|
||||||
|
"data"
|
||||||
|
</> "databases"
|
||||||
|
</> T.unpack dbId
|
||||||
|
|
||||||
|
|
||||||
|
getMainDbPath :: Text -> FilePath
|
||||||
|
getMainDbPath dbId =
|
||||||
|
getDbDir dbId
|
||||||
|
</> "main.sqlite"
|
||||||
|
|
||||||
|
|
||||||
|
getReadOnlyFilePath :: Text -> FilePath
|
||||||
|
getReadOnlyFilePath readonlyId =
|
||||||
|
"data" </> "readonly" </> T.unpack readonlyId
|
||||||
|
|
||||||
|
|
||||||
|
getSqliteEmbeddedVersion :: Connection -> IO Text
|
||||||
|
getSqliteEmbeddedVersion conn = do
|
||||||
|
sqliteEmbeddedVersion <-
|
||||||
|
SS.query_
|
||||||
|
conn
|
||||||
|
"select sqlite_version()"
|
||||||
|
:: IO [[SS.SQLData]]
|
||||||
|
case sqliteEmbeddedVersion of
|
||||||
|
[[SS.SQLText verTxt]] -> pure verTxt
|
||||||
|
_ -> pure mempty
|
||||||
|
|
||||||
|
|
||||||
|
getSqliteBinaryVersion :: ExternalAppContext -> IO Text
|
||||||
|
getSqliteBinaryVersion ctx = do
|
||||||
|
P.fmap (T.strip . T.pack) $
|
||||||
|
readProcess
|
||||||
|
ctx.sqlite
|
||||||
|
["--safe", ":memory:"]
|
||||||
|
(T.unpack "select sqlite_version()")
|
||||||
|
|
||||||
|
|
||||||
|
getGraphiQLVersion :: IO Text
|
||||||
|
getGraphiQLVersion = do
|
||||||
|
-- let packageJson :: BL.ByteString =
|
||||||
|
-- $( "package.json"
|
||||||
|
-- & makeRelativeToProject
|
||||||
|
-- P.>>= embedStringFile
|
||||||
|
-- )
|
||||||
|
--
|
||||||
|
-- pure $
|
||||||
|
-- (Aeson.decode packageJson :: Maybe Object)
|
||||||
|
-- P.>>= KeyMap.lookup "dependencies"
|
||||||
|
-- P.>>= ( \case
|
||||||
|
-- Aeson.Object o -> KeyMap.lookup "graphiql" o
|
||||||
|
-- _ -> Nothing
|
||||||
|
-- )
|
||||||
|
-- P.>>= ( \case
|
||||||
|
-- Aeson.String s -> Just s
|
||||||
|
-- _ -> Nothing
|
||||||
|
-- )
|
||||||
|
-- & fromMaybe ""
|
||||||
|
pure "TODO"
|
||||||
|
|
||||||
|
|
||||||
|
-- | Escape double quotes in SQL strings
|
||||||
|
escDoubleQuotes :: Text -> Text
|
||||||
|
escDoubleQuotes =
|
||||||
|
T.replace "\"" "\"\""
|
||||||
|
|
||||||
|
|
||||||
|
-- | Quote a keyword in an SQL query
|
||||||
|
quoteKeyword :: Text -> Text
|
||||||
|
quoteKeyword keyword =
|
||||||
|
keyword
|
||||||
|
& escDoubleQuotes
|
||||||
|
& (\word -> "\"" <> word <> "\"")
|
||||||
|
|
||||||
|
|
||||||
|
-- | Escape single quotes in SQL strings
|
||||||
|
escSingleQuotes :: Text -> Text
|
||||||
|
escSingleQuotes =
|
||||||
|
T.replace "'" "''"
|
||||||
|
|
||||||
|
|
||||||
|
-- | Quote literal text in an SQL query
|
||||||
|
quoteText :: Text -> Text
|
||||||
|
quoteText keyword =
|
||||||
|
keyword
|
||||||
|
& escSingleQuotes
|
||||||
|
& (\word -> "'" <> word <> "'")
|
||||||
|
|
||||||
|
|
||||||
|
headerJsonContent :: [(HeaderName, BS.ByteString)]
|
||||||
|
headerJsonContent =
|
||||||
|
[("Content-Type", "application/json;charset=utf-8")]
|
||||||
|
|
||||||
|
|
||||||
|
-- | Throw the specified server error with a message
|
||||||
|
throwServerErrorWithMsg :: ServerError -> Text -> Servant.Handler a
|
||||||
|
throwServerErrorWithMsg serverError errorMsg =
|
||||||
|
throwError $
|
||||||
|
serverError
|
||||||
|
{ errHeaders = headerJsonContent
|
||||||
|
, errBody =
|
||||||
|
encode $
|
||||||
|
object
|
||||||
|
["errors" .= [String errorMsg]]
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
-- | Throw an "400 Bad Request" error with a message
|
||||||
|
throwErr400WithMsg :: Text -> Servant.Handler a
|
||||||
|
throwErr400WithMsg = throwServerErrorWithMsg err400
|
||||||
|
|
||||||
|
|
||||||
|
-- | Throw an "404 Not Found" error with a message
|
||||||
|
throwErr404WithMsg :: Text -> Servant.Handler a
|
||||||
|
throwErr404WithMsg = throwServerErrorWithMsg err404
|
||||||
|
|
||||||
|
|
||||||
|
-- | Throw an "500 Internal Server Error" error with a message
|
||||||
|
throwErr500WithMsg :: Text -> Servant.Handler a
|
||||||
|
throwErr500WithMsg = throwServerErrorWithMsg err500
|
||||||
|
|
||||||
|
|
||||||
|
{-| Get the order of a linked list.
|
||||||
|
| Each tuple is `(name, previous name in list)`.
|
||||||
|
| The first's element previous name is `Nothing`.
|
||||||
|
| Tries to find the longest chain of elements if no start element is found.
|
||||||
|
| It's quite complicated to also handle incomplete orderings correctly.
|
||||||
|
-}
|
||||||
|
getOrderOfLinkedList :: [(Text, Maybe Text)] -> [Text]
|
||||||
|
getOrderOfLinkedList tables =
|
||||||
|
let
|
||||||
|
findAfter :: [(Text, Maybe Text)] -> (Text, Maybe Text) -> [Text]
|
||||||
|
findAfter remaining (tableName, previousTableMb) =
|
||||||
|
P.maybeToList previousTableMb
|
||||||
|
<> case P.find ((P.== Just tableName) P.. P.snd) remaining of
|
||||||
|
Just found@(name, _) ->
|
||||||
|
let remaining' = List.filter (/= found) remaining
|
||||||
|
in tableName : findAfter remaining' (name, Nothing)
|
||||||
|
Nothing -> [tableName]
|
||||||
|
in
|
||||||
|
if P.null tables
|
||||||
|
then []
|
||||||
|
else
|
||||||
|
let
|
||||||
|
sortByLength :: [[Text]] -> [[Text]]
|
||||||
|
sortByLength =
|
||||||
|
P.sortBy (\x y -> P.compare (P.length y) (P.length x))
|
||||||
|
|
||||||
|
chainsByLength =
|
||||||
|
tables
|
||||||
|
<&> findAfter tables
|
||||||
|
& sortByLength
|
||||||
|
|
||||||
|
-- First table ist always the (x, Nothing) table entry
|
||||||
|
firstElement =
|
||||||
|
case P.find ((P.== Nothing) P.. P.snd) tables of
|
||||||
|
Just tableEntry -> [P.fst tableEntry]
|
||||||
|
Nothing -> []
|
||||||
|
in
|
||||||
|
-- Sort them by length, combine them, and remove duplicates
|
||||||
|
([firstElement] <> chainsByLength)
|
||||||
|
& P.concat
|
||||||
|
& List.nub
|
||||||
|
|
||||||
|
|
||||||
|
getDbIdFromReadOnlyId :: Text -> IO (Maybe Text)
|
||||||
|
getDbIdFromReadOnlyId readOnlyId = do
|
||||||
|
catchAll
|
||||||
|
( do
|
||||||
|
dbId <- liftIO $ readSymbolicLink $ getReadOnlyFilePath readOnlyId
|
||||||
|
pure $ Just $ T.pack $ takeFileName dbId
|
||||||
|
)
|
||||||
|
( \err -> do
|
||||||
|
when (not $ "does not exist" `P.isInfixOf` show err) $ do
|
||||||
|
P.putErrText $ "Error while reading readonly symlink:\n" <> show err
|
||||||
|
pure Nothing
|
||||||
|
)
|
||||||
|
|
||||||
|
|
||||||
|
colToFileUrl :: Text -> Text -> Text -> Text -> Text
|
||||||
|
colToFileUrl readonlyId tableName colName rowid =
|
||||||
|
T.decodeUtf8 $
|
||||||
|
BL.toStrict $
|
||||||
|
toLazyByteString $
|
||||||
|
encodePathSegments
|
||||||
|
[ "readonly"
|
||||||
|
, readonlyId
|
||||||
|
, "tables"
|
||||||
|
, tableName
|
||||||
|
, "columns"
|
||||||
|
, colName
|
||||||
|
, "files"
|
||||||
|
, "rowid"
|
||||||
|
, rowid
|
||||||
|
]
|
||||||
|
|
||||||
|
|
||||||
|
removeIfExists :: FilePath -> IO ()
|
||||||
|
removeIfExists fileName =
|
||||||
|
let
|
||||||
|
handleExists :: IOError -> IO ()
|
||||||
|
handleExists e
|
||||||
|
| isDoesNotExistError e = pure ()
|
||||||
|
| P.otherwise = throwIO e
|
||||||
|
in
|
||||||
|
removeFile fileName `catch` handleExists
|
||||||
|
|
||||||
|
|
||||||
|
runSqliteCommand :: ExternalAppContext -> FilePath -> BL.ByteString -> Servant.Handler Text
|
||||||
|
runSqliteCommand ctx dbPath command = do
|
||||||
|
let
|
||||||
|
processConfig =
|
||||||
|
setStdin
|
||||||
|
(byteStringInput command)
|
||||||
|
$ setStdout createPipe
|
||||||
|
$ setStderr createPipe
|
||||||
|
$ proc ctx.sqlite [dbPath]
|
||||||
|
|
||||||
|
(exitCode, output) <- readProcessInterleaved processConfig
|
||||||
|
|
||||||
|
let outputText = P.decodeUtf8 $ BS.toStrict output
|
||||||
|
|
||||||
|
case exitCode of
|
||||||
|
ExitSuccess ->
|
||||||
|
pure outputText
|
||||||
|
ExitFailure _ ->
|
||||||
|
throwErr500WithMsg outputText
|
||||||
|
|
||||||
|
|
||||||
|
-- | Similar to `sequence`, except it doesn't stop on the first error.
|
||||||
|
collectErrorList :: [P.Either e b] -> P.Either [e] [b]
|
||||||
|
collectErrorList results =
|
||||||
|
case P.lefts results of
|
||||||
|
[] -> P.Right (P.rights results)
|
||||||
|
lefts -> P.Left lefts
|
||||||
|
|
||||||
|
|
||||||
|
{-|
|
||||||
|
Similar to `sequence`, except it doesn't stop on the first error.
|
||||||
|
What differentiates this from `collectErrorList` is
|
||||||
|
that it also merges the errors into a single error message.
|
||||||
|
-}
|
||||||
|
collectAllErrorsAsText :: [P.Either Text b] -> P.Either Text [b]
|
||||||
|
collectAllErrorsAsText results =
|
||||||
|
collectErrorList results
|
||||||
|
& mapLeft
|
||||||
|
( \lefts ->
|
||||||
|
"Multiple errors occurred:\n" <> P.unlines lefts
|
||||||
|
)
|
||||||
|
|
||||||
|
|
||||||
|
data DiffKind = Added | Removed | Kept
|
||||||
|
deriving (P.Eq, P.Ord, P.Show)
|
||||||
|
|
||||||
|
|
||||||
|
{-| Run an action with a connection, retrying if the database is busy.
|
||||||
|
| Necessary because of WAL mode:
|
||||||
|
| https://sqlite.org/wal.html#sometimes_queries_return_sqlite_busy_in_wal_mode
|
||||||
|
-}
|
||||||
|
withRetryConn :: FilePath -> (Connection -> IO a) -> IO a
|
||||||
|
withRetryConn filePath action = do
|
||||||
|
SS.withConnection filePath $ \conn -> do
|
||||||
|
SS.execute_ conn "PRAGMA busy_timeout = 5000;" -- 5 seconds
|
||||||
|
action conn
|
194
source/Server/Server.hs
Normal file
194
source/Server/Server.hs
Normal file
|
@ -0,0 +1,194 @@
|
||||||
|
-- Necessary for servant-docs instances
|
||||||
|
{-# OPTIONS_GHC -Wno-orphans #-}
|
||||||
|
{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
|
||||||
|
|
||||||
|
module Server.Server (platformAPI, platformApp)
|
||||||
|
where
|
||||||
|
|
||||||
|
import Protolude (
|
||||||
|
Int,
|
||||||
|
Monoid (mempty),
|
||||||
|
Proxy (Proxy),
|
||||||
|
($),
|
||||||
|
)
|
||||||
|
import Protolude qualified as P
|
||||||
|
|
||||||
|
import Data.Aeson (Object, Value, object)
|
||||||
|
import Data.Aeson.KeyMap qualified as KeyMap
|
||||||
|
import Data.ByteString.Lazy qualified as BL
|
||||||
|
import Data.Text (Text)
|
||||||
|
import Data.Text qualified as T
|
||||||
|
import Network.Wai (Application)
|
||||||
|
import Network.Wai.Parse (
|
||||||
|
defaultParseRequestBodyOptions,
|
||||||
|
setMaxRequestFilesSize,
|
||||||
|
setMaxRequestNumFiles,
|
||||||
|
)
|
||||||
|
import Servant (Context (EmptyContext, (:.)), NoContent)
|
||||||
|
import Servant.API (
|
||||||
|
Capture,
|
||||||
|
Get,
|
||||||
|
JSON,
|
||||||
|
PlainText,
|
||||||
|
Post,
|
||||||
|
ReqBody,
|
||||||
|
(:<|>) ((:<|>)),
|
||||||
|
(:>),
|
||||||
|
)
|
||||||
|
import Servant.Docs (
|
||||||
|
DocCapture (DocCapture),
|
||||||
|
ToCapture (toCapture),
|
||||||
|
ToSample,
|
||||||
|
singleSample,
|
||||||
|
toSamples,
|
||||||
|
)
|
||||||
|
import Servant.HTML.Blaze (HTML)
|
||||||
|
import Servant.Multipart (
|
||||||
|
MultipartData (MultipartData),
|
||||||
|
MultipartOptions (generalOptions),
|
||||||
|
Tmp,
|
||||||
|
ToMultipartSample (toMultipartSamples),
|
||||||
|
defaultMultipartOptions,
|
||||||
|
)
|
||||||
|
import Servant.Server (Server)
|
||||||
|
import Servant.Server qualified as Servant
|
||||||
|
import Text.Blaze.Internal (MarkupM)
|
||||||
|
|
||||||
|
import AirGQL.Config (Config (maxDbSize), defaultConfig)
|
||||||
|
import AirGQL.ExternalAppContext (ExternalAppContext)
|
||||||
|
import AirGQL.Lib (SQLPost)
|
||||||
|
import AirGQL.Servant.Database (
|
||||||
|
apiDatabaseSchemaGetHandler,
|
||||||
|
apiDatabaseVacuumPostHandler,
|
||||||
|
)
|
||||||
|
import AirGQL.Servant.GraphQL (
|
||||||
|
gqlQueryGetHandler,
|
||||||
|
gqlQueryPostHandler,
|
||||||
|
playgroundDefaultQueryHandler,
|
||||||
|
readOnlyGqlPostHandler,
|
||||||
|
writeOnlyGqlPostHandler,
|
||||||
|
)
|
||||||
|
import AirGQL.Servant.SqlQuery (sqlQueryPostHandler)
|
||||||
|
import AirGQL.Types.SchemaConf (SchemaConf (pragmaConf), defaultSchemaConf)
|
||||||
|
import AirGQL.Types.SqlQueryPostResult (SqlQueryPostResult)
|
||||||
|
import AirGQL.Types.Types (GQLPost)
|
||||||
|
|
||||||
|
|
||||||
|
{- FOURMOLU_DISABLE -}
|
||||||
|
-- ATTENTION: Order of handlers matters!
|
||||||
|
type PlatformAPI =
|
||||||
|
-- gqlQueryGetHandler
|
||||||
|
-- Redirect to GraphiQL playground
|
||||||
|
"graphql" :> Get '[HTML] NoContent
|
||||||
|
|
||||||
|
-- gqlQueryPostHandler
|
||||||
|
:<|> "graphql"
|
||||||
|
:> ReqBody '[JSON] GQLPost
|
||||||
|
:> Post '[JSON] Object
|
||||||
|
|
||||||
|
-- writeOnlyGqlPostHandler
|
||||||
|
:<|> "readonly" :> "graphql"
|
||||||
|
:> ReqBody '[JSON] GQLPost
|
||||||
|
:> Post '[JSON] Object
|
||||||
|
|
||||||
|
-- writeOnlyGqlPostHandler
|
||||||
|
:<|> "writeonly" :> "graphql"
|
||||||
|
:> ReqBody '[JSON] GQLPost
|
||||||
|
:> Post '[JSON] Object
|
||||||
|
|
||||||
|
-- playgroundDefaultQueryHandler
|
||||||
|
:<|> "playground" :> "default-query"
|
||||||
|
:> Get '[PlainText] Text
|
||||||
|
|
||||||
|
-- apiDatabaseSchemaGetHandler
|
||||||
|
:<|> "schema" :> Get '[PlainText] Text
|
||||||
|
|
||||||
|
-- apiDatabaseVacuumPostHandler
|
||||||
|
:<|> "vacuum" :> Post '[JSON] Object
|
||||||
|
|
||||||
|
-- sqlQueryPostHandler
|
||||||
|
:<|> "sql"
|
||||||
|
:> ReqBody '[JSON] SQLPost
|
||||||
|
:> Post '[JSON] SqlQueryPostResult
|
||||||
|
|
||||||
|
{- FOURMOLU_ENABLE -}
|
||||||
|
|
||||||
|
|
||||||
|
-- | Instances for automatic documentation generation via servant-docs
|
||||||
|
instance ToSample (MultipartData Tmp) where
|
||||||
|
toSamples _ = singleSample $ MultipartData mempty mempty
|
||||||
|
|
||||||
|
|
||||||
|
instance ToMultipartSample Tmp (MultipartData Tmp) where
|
||||||
|
toMultipartSamples _ = []
|
||||||
|
|
||||||
|
|
||||||
|
instance ToSample Value where
|
||||||
|
toSamples _ = singleSample $ object []
|
||||||
|
|
||||||
|
|
||||||
|
instance ToSample (KeyMap.KeyMap Value) where
|
||||||
|
toSamples _ = singleSample $ KeyMap.fromList []
|
||||||
|
|
||||||
|
|
||||||
|
instance ToSample (MarkupM ()) where
|
||||||
|
toSamples _ = singleSample mempty
|
||||||
|
|
||||||
|
|
||||||
|
instance ToSample BL.ByteString where
|
||||||
|
toSamples _ = singleSample mempty
|
||||||
|
|
||||||
|
|
||||||
|
instance ToSample Text where
|
||||||
|
toSamples _ = singleSample mempty
|
||||||
|
|
||||||
|
|
||||||
|
instance ToSample P.ByteString where
|
||||||
|
toSamples _ = singleSample mempty
|
||||||
|
|
||||||
|
|
||||||
|
instance ToCapture (Capture "readonlyId" Text) where
|
||||||
|
toCapture _ = DocCapture "readonlyId" "Read-only ID of the database"
|
||||||
|
|
||||||
|
|
||||||
|
instance ToCapture (Capture "dbId" Text) where
|
||||||
|
toCapture _ = DocCapture "dbId" "ID of the database to be served"
|
||||||
|
|
||||||
|
|
||||||
|
platformAPI :: Proxy PlatformAPI
|
||||||
|
platformAPI = Proxy
|
||||||
|
|
||||||
|
|
||||||
|
platformServer :: ExternalAppContext -> P.FilePath -> Server PlatformAPI
|
||||||
|
platformServer ctx filePath = do
|
||||||
|
let dbPath = T.pack filePath
|
||||||
|
gqlQueryGetHandler dbPath
|
||||||
|
:<|> gqlQueryPostHandler defaultSchemaConf dbPath
|
||||||
|
:<|> readOnlyGqlPostHandler dbPath
|
||||||
|
:<|> writeOnlyGqlPostHandler dbPath
|
||||||
|
:<|> playgroundDefaultQueryHandler dbPath
|
||||||
|
:<|> apiDatabaseSchemaGetHandler ctx dbPath
|
||||||
|
:<|> apiDatabaseVacuumPostHandler dbPath
|
||||||
|
:<|> sqlQueryPostHandler defaultSchemaConf.pragmaConf dbPath
|
||||||
|
|
||||||
|
|
||||||
|
platformApp :: ExternalAppContext -> P.FilePath -> Application
|
||||||
|
platformApp ctx filePath = do
|
||||||
|
let
|
||||||
|
maxFileSizeInByte :: Int = defaultConfig.maxDbSize
|
||||||
|
|
||||||
|
multipartOpts :: MultipartOptions Tmp
|
||||||
|
multipartOpts =
|
||||||
|
(defaultMultipartOptions (Proxy :: Proxy Tmp))
|
||||||
|
{ generalOptions =
|
||||||
|
setMaxRequestNumFiles 1 $
|
||||||
|
setMaxRequestFilesSize
|
||||||
|
(P.fromIntegral maxFileSizeInByte)
|
||||||
|
defaultParseRequestBodyOptions
|
||||||
|
}
|
||||||
|
|
||||||
|
context :: Context '[MultipartOptions Tmp]
|
||||||
|
context =
|
||||||
|
multipartOpts :. EmptyContext
|
||||||
|
|
||||||
|
Servant.serveWithContext platformAPI context $ platformServer ctx filePath
|
18
stack-standalone.yaml
Normal file
18
stack-standalone.yaml
Normal file
|
@ -0,0 +1,18 @@
|
||||||
|
resolver: lts-22.19
|
||||||
|
|
||||||
|
extra-deps:
|
||||||
|
- double-x-encoding-1.1.1
|
||||||
|
|
||||||
|
- graphql-spice-1.0.2.0
|
||||||
|
|
||||||
|
- github: Airsequel/simple-sql-parser
|
||||||
|
commit: 680f2b77c53fcc086dc7d5f498f764ad2235b828
|
||||||
|
|
||||||
|
allow-newer: true
|
||||||
|
|
||||||
|
flags:
|
||||||
|
aeson-pretty:
|
||||||
|
lib-only: true
|
||||||
|
|
||||||
|
direct-sqlite:
|
||||||
|
mathfunctions: true
|
37
stack-standalone.yaml.lock
Normal file
37
stack-standalone.yaml.lock
Normal file
|
@ -0,0 +1,37 @@
|
||||||
|
# This file was autogenerated by Stack.
|
||||||
|
# You should not edit this file by hand.
|
||||||
|
# For more information, please see the documentation at:
|
||||||
|
# https://docs.haskellstack.org/en/stable/lock_files
|
||||||
|
|
||||||
|
packages:
|
||||||
|
- completed:
|
||||||
|
hackage: double-x-encoding-1.1.1@sha256:f3b99d41172e51451532391ceefcd3cddcd6c4e494c6f744c3e91b2a31cc452d,1781
|
||||||
|
pantry-tree:
|
||||||
|
sha256: 383992adc327adfc2b5ecfc7e026105f8f162dccf76bb2b157c642e41ca8e28d
|
||||||
|
size: 188
|
||||||
|
original:
|
||||||
|
hackage: double-x-encoding-1.1.1
|
||||||
|
- completed:
|
||||||
|
hackage: graphql-spice-1.0.2.0@sha256:97d22da8ec38342408bcd237e91e76ffcdad4f14df666f62b0b1ccba6bf39b87,2000
|
||||||
|
pantry-tree:
|
||||||
|
sha256: d60774d462c7c0af08c82b3f754e0ac49e598640e382c417e1809880192747cb
|
||||||
|
size: 937
|
||||||
|
original:
|
||||||
|
hackage: graphql-spice-1.0.2.0
|
||||||
|
- completed:
|
||||||
|
name: simple-sql-parser
|
||||||
|
pantry-tree:
|
||||||
|
sha256: a7f399e93b6cb3056e43702b57ecda1a6a86dfdbeca4361ae3d2d27518ba4fe7
|
||||||
|
size: 3846
|
||||||
|
sha256: 5731c4471e011dede78b8f1d8812dd5eeb1c79024307f0b03f1855f9028e43e0
|
||||||
|
size: 137333
|
||||||
|
url: https://github.com/Airsequel/simple-sql-parser/archive/680f2b77c53fcc086dc7d5f498f764ad2235b828.tar.gz
|
||||||
|
version: 0.6.1
|
||||||
|
original:
|
||||||
|
url: https://github.com/Airsequel/simple-sql-parser/archive/680f2b77c53fcc086dc7d5f498f764ad2235b828.tar.gz
|
||||||
|
snapshots:
|
||||||
|
- completed:
|
||||||
|
sha256: e5cac927cf7ccbd52aa41476baa68b88c564ee6ddc3bc573dbf4210069287fe7
|
||||||
|
size: 713340
|
||||||
|
url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/22/19.yaml
|
||||||
|
original: lts-22.19
|
3395
tests/Spec.hs
Normal file
3395
tests/Spec.hs
Normal file
File diff suppressed because it is too large
Load diff
41
tests/Tests/Utils.hs
Normal file
41
tests/Tests/Utils.hs
Normal file
|
@ -0,0 +1,41 @@
|
||||||
|
module Tests.Utils (
|
||||||
|
testRoot,
|
||||||
|
withDataDbConn,
|
||||||
|
withTestDbConn,
|
||||||
|
) where
|
||||||
|
|
||||||
|
import Protolude (
|
||||||
|
Bool (True),
|
||||||
|
FilePath,
|
||||||
|
IO,
|
||||||
|
($),
|
||||||
|
(<>),
|
||||||
|
)
|
||||||
|
|
||||||
|
import Database.SQLite.Simple qualified as SS
|
||||||
|
import System.Directory (createDirectoryIfMissing, removePathForcibly)
|
||||||
|
import System.FilePath ((</>))
|
||||||
|
|
||||||
|
import AirGQL.Utils (removeIfExists, withRetryConn)
|
||||||
|
|
||||||
|
|
||||||
|
testRoot :: FilePath
|
||||||
|
testRoot = "../../airgql/tests"
|
||||||
|
|
||||||
|
|
||||||
|
-- | Get a connection to a database in the test database directory
|
||||||
|
withTestDbConn :: Bool -> FilePath -> (SS.Connection -> IO a) -> IO a
|
||||||
|
withTestDbConn shouldSaveDbs testDbPath callback = do
|
||||||
|
removeIfExists $ testRoot </> testDbPath
|
||||||
|
withRetryConn
|
||||||
|
(if shouldSaveDbs then testRoot </> testDbPath else ":memory:")
|
||||||
|
callback
|
||||||
|
|
||||||
|
|
||||||
|
-- | Get a connection to a test database in the main data directory
|
||||||
|
withDataDbConn :: FilePath -> (SS.Connection -> IO a) -> IO a
|
||||||
|
withDataDbConn testDbDir callback = do
|
||||||
|
let fullPath = "data" </> "databases" </> "_TEST_" <> testDbDir
|
||||||
|
removePathForcibly fullPath
|
||||||
|
createDirectoryIfMissing True fullPath
|
||||||
|
withRetryConn (fullPath </> "main.sqlite") callback
|
BIN
tests/example.sqlite
Normal file
BIN
tests/example.sqlite
Normal file
Binary file not shown.
96
tests/introspection_query.gql
Normal file
96
tests/introspection_query.gql
Normal file
|
@ -0,0 +1,96 @@
|
||||||
|
query IntrospectionQuery {
|
||||||
|
__schema {
|
||||||
|
|
||||||
|
queryType { name }
|
||||||
|
mutationType { name }
|
||||||
|
subscriptionType { name }
|
||||||
|
types {
|
||||||
|
...FullType
|
||||||
|
}
|
||||||
|
directives {
|
||||||
|
name
|
||||||
|
description
|
||||||
|
|
||||||
|
locations
|
||||||
|
args {
|
||||||
|
...InputValue
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
fragment FullType on __Type {
|
||||||
|
kind
|
||||||
|
name
|
||||||
|
description
|
||||||
|
|
||||||
|
fields(includeDeprecated: true) {
|
||||||
|
name
|
||||||
|
description
|
||||||
|
args {
|
||||||
|
...InputValue
|
||||||
|
}
|
||||||
|
type {
|
||||||
|
...TypeRef
|
||||||
|
}
|
||||||
|
isDeprecated
|
||||||
|
deprecationReason
|
||||||
|
}
|
||||||
|
inputFields {
|
||||||
|
...InputValue
|
||||||
|
}
|
||||||
|
interfaces {
|
||||||
|
...TypeRef
|
||||||
|
}
|
||||||
|
enumValues(includeDeprecated: true) {
|
||||||
|
name
|
||||||
|
description
|
||||||
|
isDeprecated
|
||||||
|
deprecationReason
|
||||||
|
}
|
||||||
|
possibleTypes {
|
||||||
|
...TypeRef
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
fragment InputValue on __InputValue {
|
||||||
|
name
|
||||||
|
description
|
||||||
|
type { ...TypeRef }
|
||||||
|
defaultValue
|
||||||
|
|
||||||
|
|
||||||
|
}
|
||||||
|
|
||||||
|
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
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
2798
tests/introspection_result.json
Normal file
2798
tests/introspection_result.json
Normal file
File diff suppressed because it is too large
Load diff
Loading…
Add table
Add a link
Reference in a new issue