Compare commits
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
a41380b965 | ||
|
|
b2a2504201 | ||
|
|
c45e85c5a6 | ||
|
|
2afe13fa89 | ||
|
|
36c24d9cbe | ||
|
|
d6ec171bcb | ||
|
|
06c9e246f4 | ||
|
|
b2b92e75cc | ||
|
|
506929c586 | ||
|
|
f75e77cf60 | ||
|
|
ba3ba9fd5b | ||
|
|
7de8d5446a | ||
|
|
4ac47df528 | ||
|
|
57bc3d805c | ||
|
|
3648986aa8 | ||
|
|
c050b61db8 | ||
|
|
92d00749a3 | ||
|
|
c5849ecbe0 | ||
|
|
fea38a4caf | ||
|
|
d24f0c8216 | ||
|
|
35a114a81b | ||
|
|
ed988100c6 | ||
|
|
b6a93aae1f | ||
|
|
70cae5beed | ||
|
|
0a24a83fa9 | ||
|
|
c8739aa8a3 | ||
|
|
d4950c6460 | ||
|
|
1d15060c63 | ||
|
|
401b98c5b4 | ||
|
|
d53949e4a4 | ||
|
|
421163dc75 | ||
|
|
eae169ca67 | ||
|
|
ec23067e3e | ||
|
|
bfacec3a67 | ||
|
|
e7b69cb99c | ||
|
|
fd7c23f7a1 | ||
|
|
84e03a16dd | ||
|
|
d556cea8ce | ||
|
|
8911afd079 | ||
|
|
d2df289696 | ||
|
|
2eb7c803e3 | ||
|
|
71a5748718 | ||
|
|
4ab5e63e58 | ||
|
|
c445105d55 | ||
|
|
2905753194 | ||
|
|
df49f482dc | ||
|
|
23e4c7fe6e | ||
|
|
5ac4c29a9e | ||
|
|
e0ba6b6d1c | ||
|
|
bdf1cbe111 | ||
|
|
9252ec2509 | ||
|
|
8230128ff6 | ||
|
|
6d7bf9faa9 | ||
|
|
28183a667c | ||
|
|
1eda7db0fb | ||
|
|
3cdc6d15d7 | ||
|
|
0708f46df3 | ||
|
|
7a7ceaf39a | ||
|
|
3e83bef9c4 | ||
|
|
169547aee6 | ||
|
|
f7745e1569 | ||
|
|
870f7a39b0 | ||
|
|
86c40e8df9 | ||
|
|
d87b622d64 | ||
|
|
7088e9d510 | ||
|
|
fe8b32d077 | ||
|
|
478c48cc84 | ||
|
|
c9c64fd71f | ||
|
|
93210f9380 | ||
|
|
c25473e001 | ||
|
|
f3cbab6f82 | ||
|
|
3d65d66b1b | ||
|
|
f582798276 | ||
|
|
ba87a60a47 | ||
|
|
356bff9cbd | ||
|
|
86574c89a8 | ||
|
|
734f8e6df2 | ||
|
|
df7d71db32 | ||
|
|
0c5d2e553e | ||
|
|
36ed7e2fb7 | ||
|
|
bac63f339d | ||
|
|
8d8074d500 | ||
|
|
63ebf6e92b | ||
|
|
d7f54e76f4 | ||
|
|
34d0f34620 | ||
|
|
14c882a566 | ||
|
|
ff56c3adf4 | ||
|
|
12967f8643 | ||
|
|
b056735535 | ||
|
|
f5afa419f1 | ||
|
|
7531c5490d | ||
|
|
bb62e559d6 | ||
|
|
e42bf30aeb | ||
|
|
2b8ffc8e61 | ||
|
|
48a3d1d516 | ||
|
|
5e6987b1d8 | ||
|
|
4dfcb59f73 | ||
|
|
620da2e776 | ||
|
|
f9688c3553 | ||
|
|
4ff2469f57 | ||
|
|
e3252a6e9e | ||
|
|
a9035bba2f | ||
|
|
4c8c3ccfb2 | ||
|
|
09f3e09c96 | ||
|
|
807364bd7b | ||
|
|
d14f745406 | ||
|
|
1cdc9169c7 | ||
|
|
9aa400c8f3 | ||
|
|
e4cdb8c491 | ||
|
|
c812a3fe3e | ||
|
|
1ab11de96c | ||
|
|
f7b173163c | ||
|
|
2be63b36d6 | ||
|
|
c60380b5fc | ||
|
|
d88b16e5ab | ||
|
|
867f2569a0 | ||
|
|
5a3fbd7111 | ||
|
|
a2349d90c0 | ||
|
|
980f27a6d1 | ||
|
|
ce96c88ba0 | ||
|
|
50b275d3e2 | ||
|
|
e90391b7ac | ||
|
|
5ad8800773 | ||
|
|
d2aa50be52 | ||
|
|
a8477b7822 | ||
|
|
115dae7484 | ||
|
|
e4006da9bc | ||
|
|
a47c59baca | ||
|
|
b191431530 | ||
|
|
9bdb4e5c4f | ||
|
|
07d619981e | ||
|
|
778b8d074d | ||
|
|
902e4e8921 | ||
|
|
d2719420f4 | ||
|
|
057e8d63bf | ||
|
|
f4e171aa2b | ||
|
|
7f1507b9fb | ||
|
|
cdcc175abf | ||
|
|
f995799e8f | ||
|
|
44e2b2fbb4 | ||
|
|
2eaf81334e | ||
|
|
c399b1f5f8 | ||
|
|
bc7d54c7d2 | ||
|
|
7589102c6c | ||
|
|
007f49a8bc | ||
|
|
a768bcbf20 | ||
|
|
cb145271ac | ||
|
|
9124dfd427 | ||
|
|
8e86177486 | ||
|
|
fe898c27ae | ||
|
|
f3f9030c48 | ||
|
|
73dc2692b1 | ||
|
|
87ffe39746 | ||
|
|
331e88ea39 | ||
|
|
f4becf99ad | ||
|
|
799daa7556 | ||
|
|
a3c1d9977f | ||
|
|
c803c4d0b6 | ||
|
|
8aef09574c | ||
|
|
efcc93ad89 | ||
|
|
d6834e8bf8 | ||
|
|
99d0b805df | ||
|
|
69070f341a | ||
|
|
dcf7ade5bc | ||
|
|
9021c96baa | ||
|
|
41a4396147 | ||
|
|
d9f7f6f509 | ||
|
|
bd62008e1c | ||
|
|
ded8981368 | ||
|
|
52d628f1ed | ||
|
|
9ca9a54d21 | ||
|
|
bf689565a5 | ||
|
|
9f1b5c0a81 | ||
|
|
87bd8e72cf | ||
|
|
8934190d43 | ||
|
|
c894b543b0 | ||
|
|
58f76f3d6d | ||
|
|
8980b09419 | ||
|
|
927ff6f1e5 | ||
|
|
8a722e2cfe | ||
|
|
271c329677 | ||
|
|
c63420f0e7 | ||
|
|
2fe2c9104b | ||
|
|
0ea36fc039 | ||
|
|
fc7113e52e | ||
|
|
c7cadcd776 | ||
|
|
fae1e168a7 | ||
|
|
d2791ea0e5 | ||
|
|
f4637c64c9 | ||
|
|
1b9a30cff4 | ||
|
|
5a627e76b2 | ||
|
|
d9e016be8b | ||
|
|
c3ade07ad6 | ||
|
|
05b5ecd23b | ||
|
|
dbbde6aae1 | ||
|
|
9ed30c0ba4 | ||
|
|
ec09b87940 | ||
|
|
6b5370f145 | ||
|
|
a25ad42644 | ||
|
|
995215c6a5 | ||
|
|
4b841dba61 | ||
|
|
9639cd5751 | ||
|
|
3c17f97c87 | ||
|
|
d97bf3b864 | ||
|
|
65f27653dc | ||
|
|
a134d8a493 | ||
|
|
3ded567f6d | ||
|
|
8b63d928ae | ||
|
|
8060fe3559 | ||
|
|
df5d9400fe | ||
|
|
6bc965e2a0 | ||
|
|
bfbec8fa36 | ||
|
|
51ee072f84 | ||
|
|
aa82d2e277 | ||
|
|
e13d912a79 | ||
|
|
826ae7459a | ||
|
|
cde9cd4ab7 | ||
|
|
b0a0c4768d | ||
|
|
4a9ca9bdae | ||
|
|
65a3ae08f0 | ||
|
|
bba6e96fd3 | ||
|
|
cc900787de | ||
|
|
01e65f5221 | ||
|
|
1e9031573c | ||
|
|
81ebdff977 | ||
|
|
9baad293e8 | ||
|
|
efc7a21427 | ||
|
|
b9c497a3ab | ||
|
|
5f43235370 | ||
|
|
57ff89be64 | ||
|
|
4f7ee6f36a | ||
|
|
14f3b25022 | ||
|
|
b99c8c897c | ||
|
|
ac3655df1d | ||
|
|
c858d158aa | ||
|
|
cc8a7ef0c2 | ||
|
|
c86e254a24 | ||
|
|
1c7ca51308 | ||
|
|
6a3f8ca828 | ||
|
|
031de4d35e | ||
|
|
595c2a5257 | ||
|
|
74f6e5225c | ||
|
|
c581148f1b | ||
|
|
0e20b47875 | ||
|
|
1cb00d3c62 | ||
|
|
bbc07d3f40 | ||
|
|
9c6597c351 | ||
|
|
defdcb85ef | ||
|
|
94115ff134 | ||
|
|
5a8d9b1246 | ||
|
|
32ff9dfb48 | ||
|
|
ab90bd24e0 | ||
|
|
c9f017c632 | ||
|
|
132ecd8d74 | ||
|
|
19c3ee2143 | ||
|
|
4fb0d1279c | ||
|
|
81f9bf290c | ||
|
|
dbef11869c | ||
|
|
b38564e623 | ||
|
|
2a2a4bdeac | ||
|
|
a65ac9b0f6 | ||
|
|
7ed8b10776 | ||
|
|
2f239b9048 | ||
|
|
c3854e7c74 | ||
|
|
b7dcc63e37 | ||
|
|
62243852b6 | ||
|
|
1b48531369 | ||
|
|
1981160536 | ||
|
|
f3eb8a317d | ||
|
|
7aedebecee | ||
|
|
d5afdc7c53 | ||
|
|
b7c261f520 | ||
|
|
942391c508 | ||
|
|
f333305491 | ||
|
|
88283801cb | ||
|
|
4e07846c5d | ||
|
|
bf58a3600a | ||
|
|
bae5afbad6 | ||
|
|
91689e28f0 | ||
|
|
041f73cae8 | ||
|
|
43c8bde8ce | ||
|
|
82dd1b732d | ||
|
|
41ac0d5d93 | ||
|
|
60db026dcc | ||
|
|
47b6f04a66 | ||
|
|
f228cccbae | ||
|
|
3820590649 | ||
|
|
8cc8531e49 | ||
|
|
65062364c4 | ||
|
|
ebe66cb985 | ||
|
|
9c172db534 | ||
|
|
de531b6b41 | ||
|
|
71cb8afc0d | ||
|
|
36dbd09459 | ||
|
|
fa4df95f55 | ||
|
|
4104f5fb75 | ||
|
|
abb6167caa | ||
|
|
15ea7dfe09 | ||
|
|
a2c2544271 | ||
|
|
2b22f889bd | ||
|
|
cd3013569e | ||
|
|
5dc37fc8e8 | ||
|
|
038d84b62d | ||
|
|
40f9a6068a | ||
|
|
5cd7d35966 | ||
|
|
71262fbc5c | ||
|
|
d16a4a9a2b | ||
|
|
2357961f48 | ||
|
|
162c4e38af | ||
|
|
0f95900822 | ||
|
|
8ac14447ef | ||
|
|
a1b3bca7fc | ||
|
|
8cde90b7fe | ||
|
|
3b83f536ca | ||
|
|
42d7cf8ae5 | ||
|
|
627c3c34b7 | ||
|
|
ee56dd5db1 | ||
|
|
bf91187e63 | ||
|
|
2982c5de2e | ||
|
|
add95c32ca | ||
|
|
243e4f0408 | ||
|
|
885ff60138 | ||
|
|
72a28a145d | ||
|
|
4a594d5e95 | ||
|
|
0ba133a0bd | ||
|
|
b05898d17f | ||
|
|
d4c6abbaec | ||
|
|
caaa34b5de | ||
|
|
c9a60373f6 | ||
|
|
ed5072f4b1 | ||
|
|
ed98ac9d7e | ||
|
|
d9f1ae6a46 | ||
|
|
5874482f03 | ||
|
|
0511e99dd4 | ||
|
|
4e4548d702 | ||
|
|
b3899e7aa4 | ||
|
|
6d9fcfa09f | ||
|
|
38e5b76996 | ||
|
|
ca4539e78d | ||
|
|
a54a61d00e | ||
|
|
142fc06b15 | ||
|
|
c7b1cda3ed | ||
|
|
fb2adea5e9 | ||
|
|
d9b15adb35 |
@@ -1,276 +0,0 @@
|
|||||||
version: 2
|
|
||||||
|
|
||||||
jobs:
|
|
||||||
# Make sure that there are no outstanding linting hints and that
|
|
||||||
# auto-formatting does not result in any changes.
|
|
||||||
style-check:
|
|
||||||
docker:
|
|
||||||
- image: nixos/nix:2.3
|
|
||||||
steps:
|
|
||||||
- checkout
|
|
||||||
- run:
|
|
||||||
name: Install linting and styling scripts
|
|
||||||
command: nix-env -f default.nix -iA style
|
|
||||||
- run:
|
|
||||||
name: Run linter
|
|
||||||
command: |
|
|
||||||
# Note: For checking this locally, use `nix-shell --run postgrest-lint`
|
|
||||||
postgrest-lint
|
|
||||||
- run:
|
|
||||||
name: Run style check
|
|
||||||
command: |
|
|
||||||
# 'Note: For checking this locally, use `nix-shell --run postgrest-style`
|
|
||||||
postgrest-style-check
|
|
||||||
|
|
||||||
# Run tests based on stack and docker against the oldest PostgreSQL version
|
|
||||||
# that we support.
|
|
||||||
stack-test:
|
|
||||||
docker:
|
|
||||||
- image: cimg/base:2021.03
|
|
||||||
environment:
|
|
||||||
- PGHOST=localhost
|
|
||||||
- image: circleci/postgres:9.5
|
|
||||||
environment:
|
|
||||||
- POSTGRES_USER=circleci
|
|
||||||
- POSTGRES_DB=circleci
|
|
||||||
- POSTGRES_HOST_AUTH_METHOD=trust
|
|
||||||
steps:
|
|
||||||
- checkout
|
|
||||||
- restore_cache:
|
|
||||||
keys:
|
|
||||||
- v1-stack-dependencies-{{ checksum "postgrest.cabal" }}-{{ checksum "stack.yaml" }}
|
|
||||||
- run:
|
|
||||||
name: install stack & dependencies
|
|
||||||
command: |
|
|
||||||
curl -L https://github.com/commercialhaskell/stack/releases/download/v2.3.1/stack-2.3.1-linux-x86_64.tar.gz | tar zx -C /tmp
|
|
||||||
sudo mv /tmp/stack-2.3.1-linux-x86_64/stack /usr/bin
|
|
||||||
sudo apt-get update
|
|
||||||
sudo apt-get install -y libgmp-dev postgresql-client
|
|
||||||
sudo apt-get install -y --only-upgrade binutils
|
|
||||||
stack setup
|
|
||||||
- run:
|
|
||||||
name: build src and tests dependencies
|
|
||||||
command: |
|
|
||||||
stack build --fast -j1 --only-dependencies
|
|
||||||
stack build --fast --test --no-run-tests --only-dependencies
|
|
||||||
- save_cache:
|
|
||||||
paths:
|
|
||||||
- "~/.stack"
|
|
||||||
- ".stack-work"
|
|
||||||
key: v1-stack-dependencies-{{ checksum "postgrest.cabal" }}-{{ checksum "stack.yaml" }}
|
|
||||||
- run:
|
|
||||||
name: build src and tests
|
|
||||||
command: |
|
|
||||||
stack build --fast -j1
|
|
||||||
stack build --fast --test --no-run-tests
|
|
||||||
- run:
|
|
||||||
name: run spec tests
|
|
||||||
command: |
|
|
||||||
test/create_test_db "postgres://circleci@localhost" postgrest_test stack test
|
|
||||||
- store_artifacts:
|
|
||||||
path: /tmp/postgrest
|
|
||||||
|
|
||||||
# Publish a new release. This only runs when a release is tagged (see
|
|
||||||
# workflow below).
|
|
||||||
release:
|
|
||||||
machine: true
|
|
||||||
steps:
|
|
||||||
- checkout
|
|
||||||
- run:
|
|
||||||
name: Install Nix
|
|
||||||
command: |
|
|
||||||
curl -L https://nixos.org/nix/install | sh
|
|
||||||
echo "source $HOME/.nix-profile/etc/profile.d/nix.sh" >> $BASH_ENV
|
|
||||||
- run:
|
|
||||||
name: Change postgrest.cabal if nightly
|
|
||||||
command: |
|
|
||||||
if test "$CIRCLE_TAG" = "nightly"
|
|
||||||
then
|
|
||||||
cabal_nightly_version=$(git show -s --format='%cd' --date='format:%Y%m%d')
|
|
||||||
sed -i "s/^version:.*/version:$cabal_nightly_version/" postgrest.cabal
|
|
||||||
fi
|
|
||||||
- run:
|
|
||||||
name: Install and use the Cachix binary cache
|
|
||||||
command: |
|
|
||||||
nix-env -iA cachix -f https://cachix.org/api/v1/install
|
|
||||||
cachix use postgrest
|
|
||||||
- run:
|
|
||||||
name: Install release scripts
|
|
||||||
command: nix-env -f default.nix -iA release
|
|
||||||
- run:
|
|
||||||
name: Publish GitHub release
|
|
||||||
command: |
|
|
||||||
export GITHUB_USERNAME="$CIRCLE_PROJECT_USERNAME"
|
|
||||||
export GITHUB_REPONAME="$CIRCLE_PROJECT_REPONAME"
|
|
||||||
postgrest-release-github $CIRCLE_TAG
|
|
||||||
- run:
|
|
||||||
name: Publish Docker images
|
|
||||||
command: |
|
|
||||||
export DOCKER_REPO=postgrest
|
|
||||||
postgrest-release-docker-login
|
|
||||||
postgrest-release-dockerhub $CIRCLE_TAG
|
|
||||||
if test "$CIRCLE_TAG" != "nightly"
|
|
||||||
then
|
|
||||||
postgrest-release-dockerhub-description
|
|
||||||
fi
|
|
||||||
- store_artifacts:
|
|
||||||
path: /tmp/postgrest
|
|
||||||
|
|
||||||
# Build everything in default.nix and push to the Cachix binary cache if running on main
|
|
||||||
nix-build:
|
|
||||||
machine: true
|
|
||||||
steps:
|
|
||||||
- checkout
|
|
||||||
- run:
|
|
||||||
name: Install Nix
|
|
||||||
command: |
|
|
||||||
curl -L https://nixos.org/nix/install | sh
|
|
||||||
echo "source $HOME/.nix-profile/etc/profile.d/nix.sh" >> $BASH_ENV
|
|
||||||
- run:
|
|
||||||
name: Install and use the Cachix binary cache
|
|
||||||
command: |
|
|
||||||
nix-env -iA cachix -f https://cachix.org/api/v1/install
|
|
||||||
cachix use postgrest
|
|
||||||
- run:
|
|
||||||
name: Change postgrest.cabal if nightly
|
|
||||||
command: |
|
|
||||||
if test "$CIRCLE_TAG" = "nightly"
|
|
||||||
then
|
|
||||||
cabal_nightly_version=$(git show -s --format='%cd' --date='format:%Y%m%d')
|
|
||||||
sed -i "s/^version:.*/version:$cabal_nightly_version/" postgrest.cabal
|
|
||||||
fi
|
|
||||||
- run:
|
|
||||||
name: Build all derivations from default.nix and push results to Cachix
|
|
||||||
command: |
|
|
||||||
# Only push to the cache when CircleCI makes the CACHIX_SIGNING_KEY
|
|
||||||
# available (e.g. not for pull requests).
|
|
||||||
if [ -n "${CACHIX_AUTH_TOKEN:-""}" ]; then
|
|
||||||
echo "Building and caching all derivations..."
|
|
||||||
cachix authtoken "$CACHIX_AUTH_TOKEN"
|
|
||||||
|
|
||||||
# Push new builds as we go
|
|
||||||
nix-build | cachix push postgrest
|
|
||||||
|
|
||||||
# Make sure that everything, including .drv files, is pushed
|
|
||||||
nix-env -f default.nix -iA devTools
|
|
||||||
postgrest-push-cachix
|
|
||||||
else
|
|
||||||
echo "Building all derivations (caching skipped for outside pull requests)..."
|
|
||||||
nix-build
|
|
||||||
fi
|
|
||||||
- store_artifacts:
|
|
||||||
path: /tmp/postgrest
|
|
||||||
|
|
||||||
# Run tests
|
|
||||||
nix-test:
|
|
||||||
machine: true
|
|
||||||
steps:
|
|
||||||
- checkout
|
|
||||||
- run:
|
|
||||||
name: Install Nix
|
|
||||||
command: |
|
|
||||||
curl -L https://nixos.org/nix/install | sh
|
|
||||||
echo "source $HOME/.nix-profile/etc/profile.d/nix.sh" >> $BASH_ENV
|
|
||||||
- run:
|
|
||||||
name: Install and use the Cachix binary cache
|
|
||||||
command: |
|
|
||||||
nix-env -iA cachix -f https://cachix.org/api/v1/install
|
|
||||||
cachix use postgrest
|
|
||||||
- run:
|
|
||||||
name: Install testing scripts
|
|
||||||
command: nix-env -f default.nix -iA tests memory withTools
|
|
||||||
- run:
|
|
||||||
name: Run coverage (io tests and spec tests against PostgreSQL 13)
|
|
||||||
command: postgrest-coverage
|
|
||||||
when: always
|
|
||||||
- run:
|
|
||||||
name: Skip tests on build or primary test failure
|
|
||||||
command: circleci-agent step halt
|
|
||||||
when: on_fail
|
|
||||||
- run:
|
|
||||||
name: Upload coverage to codecov
|
|
||||||
command: |
|
|
||||||
# Modified from:
|
|
||||||
# https://docs.codecov.io/docs/about-the-codecov-bash-uploader#validating-the-bash-script
|
|
||||||
curl -s https://codecov.io/bash > codecov;
|
|
||||||
VERSION=$(grep 'VERSION=\".*\"' codecov | cut -d'"' -f2);
|
|
||||||
shasum -a 512 -c <(curl -s https://raw.githubusercontent.com/codecov/codecov-bash/${VERSION}/SHA512SUM | grep codecov)
|
|
||||||
bash codecov -f coverage/codecov.json
|
|
||||||
- run:
|
|
||||||
name: Run the spec tests against PostgreSQL 12
|
|
||||||
command: postgrest-with-postgresql-12 postgrest-test-spec
|
|
||||||
when: always
|
|
||||||
- run:
|
|
||||||
name: Run the spec tests against PostgreSQL 11
|
|
||||||
command: postgrest-with-postgresql-11 postgrest-test-spec
|
|
||||||
when: always
|
|
||||||
- run:
|
|
||||||
name: Run the spec tests against PostgreSQL 10
|
|
||||||
command: postgrest-with-postgresql-10 postgrest-test-spec
|
|
||||||
when: always
|
|
||||||
- run:
|
|
||||||
name: Run the spec tests against PostgreSQL 9.6
|
|
||||||
command: postgrest-with-postgresql-9.6 postgrest-test-spec
|
|
||||||
when: always
|
|
||||||
- run:
|
|
||||||
name: Run the spec tests against PostgreSQL 9.5
|
|
||||||
command: postgrest-with-postgresql-9.5 postgrest-test-spec
|
|
||||||
when: always
|
|
||||||
- run:
|
|
||||||
name: Check the spec tests for idempotence
|
|
||||||
command: postgrest-test-spec-idempotence
|
|
||||||
when: always
|
|
||||||
- run:
|
|
||||||
name: Run memory tests
|
|
||||||
command: postgrest-test-memory
|
|
||||||
when: always
|
|
||||||
- store_artifacts:
|
|
||||||
path: /tmp/postgrest
|
|
||||||
|
|
||||||
workflows:
|
|
||||||
version: 2
|
|
||||||
build-test-release:
|
|
||||||
jobs:
|
|
||||||
- style-check:
|
|
||||||
# Make sure that this job also runs when releases are tagged.
|
|
||||||
filters:
|
|
||||||
tags:
|
|
||||||
only:
|
|
||||||
- /v[0-9]+(\.[0-9]+)*/
|
|
||||||
- nightly
|
|
||||||
- stack-test:
|
|
||||||
filters:
|
|
||||||
tags:
|
|
||||||
only:
|
|
||||||
- /v[0-9]+(\.[0-9]+)*/
|
|
||||||
- nightly
|
|
||||||
- nix-build:
|
|
||||||
filters:
|
|
||||||
tags:
|
|
||||||
only:
|
|
||||||
- /v[0-9]+(\.[0-9]+)*/
|
|
||||||
- nightly
|
|
||||||
context:
|
|
||||||
- cachix
|
|
||||||
- nix-test:
|
|
||||||
filters:
|
|
||||||
tags:
|
|
||||||
only:
|
|
||||||
- /v[0-9]+(\.[0-9]+)*/
|
|
||||||
- nightly
|
|
||||||
- release:
|
|
||||||
requires:
|
|
||||||
- style-check
|
|
||||||
- stack-test
|
|
||||||
- nix-build
|
|
||||||
- nix-test
|
|
||||||
filters:
|
|
||||||
tags:
|
|
||||||
only:
|
|
||||||
- /v[0-9]+(\.[0-9]+)*/
|
|
||||||
- nightly
|
|
||||||
branches:
|
|
||||||
ignore: /.*/
|
|
||||||
context:
|
|
||||||
- docker
|
|
||||||
- github
|
|
||||||
+9
-65
@@ -1,71 +1,15 @@
|
|||||||
freebsd_instance:
|
freebsd_instance:
|
||||||
image: freebsd-12-2-release-amd64
|
image_family: freebsd-13-1
|
||||||
|
|
||||||
build_task:
|
build_task:
|
||||||
env:
|
name: Build FreeBSD (Stack)
|
||||||
GITHUB_TOKEN: ENCRYPTED[!1ecc3020fe8c6463c06ebc22153533239e132ee56e4faad95ce336bd2ee2bde6aa89c0352e89faaa2c10f4a5bac9b7fc!]
|
install_script: pkg install -y postgresql13-client hs-stack
|
||||||
# caches the freebsd package downloads
|
|
||||||
# saves probably just a couple of seconds, but hey...
|
|
||||||
pkg_cache:
|
|
||||||
folder: /var/cache/pkg
|
|
||||||
|
|
||||||
install_script:
|
stack_cache:
|
||||||
# - pkg update
|
folders: /.stack
|
||||||
- pkg install -y postgresql12-client ghc hs-cabal-install jq git
|
fingerprint_script: cat postgrest.cabal stack.yaml.lock
|
||||||
|
|
||||||
# cache the hackage index file and downloads which are
|
|
||||||
# cabal v2-update downloads an incremental update, so we don't need to keep this up2date
|
|
||||||
packages_cache:
|
|
||||||
# warning: don't use ~/.cabal here, this will break the cache
|
|
||||||
folder: /.cabal/packages
|
|
||||||
reupload_on_changes: false
|
reupload_on_changes: false
|
||||||
|
|
||||||
# cache the dependencies built by cabal
|
build_script: stack build -j 1 --local-bin-path . --copy-bins
|
||||||
# they have to be uploaded on every change to make the next build fast
|
bin_artifacts:
|
||||||
store_cache:
|
path: postgrest
|
||||||
# warning: don't use ~/.cabal here, this will break the cache
|
|
||||||
folder: /.cabal/store
|
|
||||||
fingerprint_script: cat postgrest.cabal
|
|
||||||
reupload_on_changes: true
|
|
||||||
|
|
||||||
build_script:
|
|
||||||
- cabal v2-update
|
|
||||||
- |
|
|
||||||
if test "$CIRRUS_TAG" = "nightly"
|
|
||||||
then
|
|
||||||
cabal_nightly_version=$(git show -s --format='%cd' --date='format:%Y%m%d')
|
|
||||||
sed -i '' "s/^version:.*/version:$cabal_nightly_version/" postgrest.cabal
|
|
||||||
fi
|
|
||||||
## compile for 30 minutes tops
|
|
||||||
- timeout 1800 cabal v2-build -j1 || test "$?" = "124"
|
|
||||||
|
|
||||||
publish_script:
|
|
||||||
- |
|
|
||||||
if test ! "$CIRRUS_TAG"
|
|
||||||
then
|
|
||||||
echo 'No tag pushed. Skip release.'
|
|
||||||
else
|
|
||||||
cabal v2-install
|
|
||||||
|
|
||||||
bin_name=""
|
|
||||||
|
|
||||||
if test $CIRRUS_TAG = "nightly"
|
|
||||||
then
|
|
||||||
suffix=$(git show -s --format="%cd-%h" --date="format:%Y-%m-%d-%H-%M")
|
|
||||||
bin_name=postgrest-nightly-$suffix-freebsd.tar.xz
|
|
||||||
else
|
|
||||||
bin_name=postgrest-$CIRRUS_TAG-freebsd.tar.xz
|
|
||||||
fi
|
|
||||||
|
|
||||||
release_id=$(curl -s https://api.github.com/repos/$CIRRUS_REPO_FULL_NAME/releases/tags/$CIRRUS_TAG | jq .id)
|
|
||||||
|
|
||||||
echo "Uploading $bin_name to gh release: $release_id"
|
|
||||||
|
|
||||||
tar cvJf $bin_name --dereference -C /.cabal/bin postgrest
|
|
||||||
|
|
||||||
## We don't use ghr here because it doesn't provide freebsd binaries: https://github.com/tcnksm/ghr/issues/127
|
|
||||||
curl -X POST --data-binary @$bin_name \
|
|
||||||
-H "Authorization:token $GITHUB_TOKEN" \
|
|
||||||
-H "Content-Type:application/octet-stream" \
|
|
||||||
"https://uploads.github.com/repos/$CIRRUS_REPO_FULL_NAME/releases/$release_id/assets?name=$bin_name"
|
|
||||||
fi
|
|
||||||
|
|||||||
@@ -0,0 +1,21 @@
|
|||||||
|
name: Setup Nix
|
||||||
|
|
||||||
|
description: Installs nix, sets up cachix and installs a subset of tooling.
|
||||||
|
|
||||||
|
inputs:
|
||||||
|
authToken:
|
||||||
|
description: Token to pass to cachix
|
||||||
|
tools:
|
||||||
|
description: Tools to install with nix-env -iA <tools>
|
||||||
|
|
||||||
|
runs:
|
||||||
|
using: composite
|
||||||
|
steps:
|
||||||
|
- uses: cachix/install-nix-action@v16
|
||||||
|
- uses: cachix/cachix-action@v10
|
||||||
|
with:
|
||||||
|
name: postgrest
|
||||||
|
authToken: ${{ inputs.authToken }}
|
||||||
|
- if: ${{ inputs.tools }}
|
||||||
|
run: nix-env -f default.nix -iA ${{ inputs.tools }}
|
||||||
|
shell: bash
|
||||||
@@ -9,10 +9,10 @@ coverage:
|
|||||||
project:
|
project:
|
||||||
default:
|
default:
|
||||||
target: auto
|
target: auto
|
||||||
threshold: 0%
|
threshold: 1%
|
||||||
only_pulls: false
|
only_pulls: false
|
||||||
patch:
|
patch:
|
||||||
default:
|
default:
|
||||||
target: auto
|
target: auto
|
||||||
threshold: 0%
|
threshold: 1%
|
||||||
only_pulls: true
|
only_pulls: true
|
||||||
@@ -0,0 +1,6 @@
|
|||||||
|
version: 2
|
||||||
|
updates:
|
||||||
|
- package-ecosystem: github-actions
|
||||||
|
directory: /
|
||||||
|
schedule:
|
||||||
|
interval: weekly
|
||||||
Executable
+56
@@ -0,0 +1,56 @@
|
|||||||
|
#!/usr/bin/env bash
|
||||||
|
set -euo pipefail
|
||||||
|
|
||||||
|
# Get the FreeBSD PostgREST executable built by CirrusCI for the given GITHUB_COMMIT in GITHUB_REPOSITORY
|
||||||
|
|
||||||
|
# We use the GitHub API for 'check suites' to find the corresponding CirrusCI job, see:
|
||||||
|
# https://docs.github.com/en/rest/reference/checks#list-check-suites-for-a-git-reference
|
||||||
|
|
||||||
|
cirrus_artifact_name=bin
|
||||||
|
gh_accept_header="Accept: application/vnd.github.v3+json"
|
||||||
|
|
||||||
|
get_gh_check_runs_url() {
|
||||||
|
gh_checks_list_url="https://api.github.com/repos/$GITHUB_REPOSITORY/commits/$GITHUB_COMMIT/check-suites"
|
||||||
|
>&2 echo "Getting list of check-suites from $gh_checks_list_url ..."
|
||||||
|
curl --fail -H "$gh_accept_header" "$gh_checks_list_url" \
|
||||||
|
| jq -r '.check_suites[] | select(.app.slug == "cirrus-ci") | .check_runs_url'
|
||||||
|
}
|
||||||
|
|
||||||
|
wait_for_cirrusci() {
|
||||||
|
gh_check_runs_url="$(get_gh_check_runs_url)"
|
||||||
|
>&2 echo "Waiting to CirrusCI run to complete (two hours maximum)..."
|
||||||
|
for _ in $(seq 1 120); do
|
||||||
|
echo "Checking for CirrusCI task status at $gh_check_runs_url ..."
|
||||||
|
status=$(curl --fail "$gh_check_runs_url" | jq -r '.check_runs[] | .status')
|
||||||
|
if [ "$status" == "completed" ]; then
|
||||||
|
break
|
||||||
|
else
|
||||||
|
echo "CirrusCI task is still $status, waiting..."
|
||||||
|
sleep 60
|
||||||
|
fi
|
||||||
|
done
|
||||||
|
}
|
||||||
|
|
||||||
|
# The CirrusCI taskid can change if a new check run is started for the same commit,
|
||||||
|
# e.g. when pushing both a branch and tag. We make sure that we have the very
|
||||||
|
# latest taskid by re-loading the 'gh_check_runs_url' and the 'check run' itself.
|
||||||
|
get_cirrus_taskid() {
|
||||||
|
gh_check_runs_url="$(get_gh_check_runs_url)"
|
||||||
|
>&2 echo "Getting the CirrusCI task id from $gh_check_runs_url ..."
|
||||||
|
curl --fail -H "$gh_accept_header" "$gh_check_runs_url" \
|
||||||
|
| jq -r '.check_runs[] | .external_id'
|
||||||
|
}
|
||||||
|
|
||||||
|
download_artifact() {
|
||||||
|
cirrus_task_id="$(get_cirrus_taskid)"
|
||||||
|
cirrus_artifact_url="https://api.cirrus-ci.com/v1/artifact/task/$cirrus_task_id/$cirrus_artifact_name.zip"
|
||||||
|
>&2 echo "Attemping to download the CirrusCI artifact from $cirrus_artifact_url ..."
|
||||||
|
curl --fail "$cirrus_artifact_url" -o freebsd.zip
|
||||||
|
}
|
||||||
|
|
||||||
|
wait_for_cirrusci
|
||||||
|
download_artifact
|
||||||
|
|
||||||
|
echo "Unpacking executable..."
|
||||||
|
unzip freebsd.zip -d .
|
||||||
|
rm -rf freebsd.zip
|
||||||
Executable
+12
@@ -0,0 +1,12 @@
|
|||||||
|
#!/usr/bin/env bash
|
||||||
|
|
||||||
|
# Tag a release that will be built with Github Actions. The version is
|
||||||
|
# read from 'postgrest.cabal'.
|
||||||
|
|
||||||
|
version="$(grep -oP '^version:\s*\K.*' postgrest.cabal)"
|
||||||
|
|
||||||
|
echo "Tagging version v$version"
|
||||||
|
git tag -f "v$version"
|
||||||
|
|
||||||
|
echo "Pushing tag..."
|
||||||
|
git push -f origin "refs/tags/v$version"
|
||||||
@@ -0,0 +1,63 @@
|
|||||||
|
#!/bin/bash
|
||||||
|
|
||||||
|
# This script builds PostgREST in a remote ARM server
|
||||||
|
|
||||||
|
[ -z "$1" ] && { echo "Missing 1st argument: PostgREST github commit SHA"; exit 1; }
|
||||||
|
[ -z "$2" ] && { echo "Missing 2nd argument: Build environment directory name"; exit 1; }
|
||||||
|
|
||||||
|
PGRST_GITHUB_COMMIT="$1"
|
||||||
|
SCRIPT_DIR="$2"
|
||||||
|
|
||||||
|
DOCKER_BUILD_DIR="$SCRIPT_DIR/docker-env"
|
||||||
|
|
||||||
|
install_packages() {
|
||||||
|
sudo apt-get update -y
|
||||||
|
sudo apt-get upgrade -y
|
||||||
|
sudo apt-get install -y git build-essential curl libffi-dev libffi7 libgmp-dev libgmp10 libncurses-dev libncurses5 libtinfo5 llvm libnuma-dev zlib1g-dev libpq-dev jq gcc
|
||||||
|
sudo apt-get clean
|
||||||
|
}
|
||||||
|
|
||||||
|
install_ghcup() {
|
||||||
|
export BOOTSTRAP_HASKELL_NONINTERACTIVE=1
|
||||||
|
export BOOTSTRAP_HASKELL_MINIMAL=1
|
||||||
|
curl --proto '=https' --tlsv1.2 -sSf https://get-ghcup.haskell.org | sh
|
||||||
|
source ~/.ghcup/env
|
||||||
|
}
|
||||||
|
|
||||||
|
install_cabal() {
|
||||||
|
ghcup upgrade
|
||||||
|
ghcup install cabal 3.6.0.0
|
||||||
|
ghcup set cabal 3.6.0.0
|
||||||
|
}
|
||||||
|
|
||||||
|
install_ghc() {
|
||||||
|
ghcup install ghc 8.10.7
|
||||||
|
ghcup set ghc 8.10.7
|
||||||
|
}
|
||||||
|
|
||||||
|
install_packages
|
||||||
|
|
||||||
|
# Add ghcup to the PATH for this session
|
||||||
|
[ -f ~/.ghcup/env ] && source ~/.ghcup/env
|
||||||
|
|
||||||
|
ghcup --version || install_ghcup
|
||||||
|
cabal --version || install_cabal
|
||||||
|
ghc --version || install_ghc
|
||||||
|
|
||||||
|
cd ~/$SCRIPT_DIR
|
||||||
|
|
||||||
|
# Clone the repository and build the project
|
||||||
|
git clone https://github.com/PostgREST/postgrest.git
|
||||||
|
cd postgrest
|
||||||
|
git checkout $PGRST_GITHUB_COMMIT
|
||||||
|
cabal v2-update && cabal v2-build
|
||||||
|
|
||||||
|
# Copy the built binary to the Dockerfile directory
|
||||||
|
PGRST_BIN=$(cabal exec which postgrest | tail -1)
|
||||||
|
cp $PGRST_BIN ~/$DOCKER_BUILD_DIR
|
||||||
|
|
||||||
|
# Move and compress the built binary
|
||||||
|
mkdir -p ~/$SCRIPT_DIR/result
|
||||||
|
mv $PGRST_BIN ~/$SCRIPT_DIR/result
|
||||||
|
cd ~/$SCRIPT_DIR
|
||||||
|
tar -cJf result.tar.xz result
|
||||||
@@ -0,0 +1,16 @@
|
|||||||
|
# PostgREST docker hub image
|
||||||
|
|
||||||
|
FROM ubuntu:focal AS postgrest
|
||||||
|
|
||||||
|
RUN apt-get update -y \
|
||||||
|
&& apt install -y --no-install-recommends libpq-dev zlib1g-dev jq gcc libnuma-dev \
|
||||||
|
&& apt-get clean \
|
||||||
|
&& rm -rf /var/lib/apt/lists/*
|
||||||
|
|
||||||
|
COPY postgrest /usr/bin/postgrest
|
||||||
|
|
||||||
|
EXPOSE 3000
|
||||||
|
|
||||||
|
USER 1000
|
||||||
|
|
||||||
|
CMD postgrest
|
||||||
@@ -0,0 +1,50 @@
|
|||||||
|
#!/bin/bash
|
||||||
|
|
||||||
|
# This script publishes the Docker ARM images to Docker Hub.
|
||||||
|
|
||||||
|
[ -z "$1" ] && { echo "Missing 1st argument: PostgREST github commit SHA"; exit 1; }
|
||||||
|
[ -z "$2" ] && { echo "Missing 2nd argument: Docker repo"; exit 1; }
|
||||||
|
[ -z "$3" ] && { echo "Missing 3rd argument: Docker username"; exit 1; }
|
||||||
|
[ -z "$4" ] && { echo "Missing 4th argument: Docker password"; exit 1; }
|
||||||
|
[ -z "$5" ] && { echo "Missing 5th argument: Build environment directory name"; exit 1; }
|
||||||
|
[ -z "$6" ] && { echo "Missing 6th argument: PostgREST version"; exit 1; }
|
||||||
|
|
||||||
|
PGRST_GITHUB_COMMIT="$1"
|
||||||
|
DOCKER_REPO="$2"
|
||||||
|
DOCKER_USER="$3"
|
||||||
|
DOCKER_PASS="$4"
|
||||||
|
SCRIPT_DIR="$5"
|
||||||
|
PGRST_VERSION="v$6"
|
||||||
|
IS_PRERELEASE="$7"
|
||||||
|
|
||||||
|
DOCKER_BUILD_DIR="$SCRIPT_DIR/docker-env"
|
||||||
|
|
||||||
|
clean_env()
|
||||||
|
{
|
||||||
|
sudo docker logout
|
||||||
|
}
|
||||||
|
|
||||||
|
# Login to Docker
|
||||||
|
sudo docker logout
|
||||||
|
{ echo $DOCKER_PASS | sudo docker login -u $DOCKER_USER --password-stdin; } || { echo "Couldn't login to docker"; exit 1; }
|
||||||
|
|
||||||
|
trap clean_env sigint sigterm exit
|
||||||
|
|
||||||
|
# Move to the docker build environment
|
||||||
|
cd ~/$DOCKER_BUILD_DIR
|
||||||
|
|
||||||
|
# Push final images to Docker hub
|
||||||
|
# NOTE: This command publishes a separate ARM image because the builds cannot
|
||||||
|
# be added to the manifest if they are not in the registry beforehand.
|
||||||
|
# This image must be manually deleted from Docker Hub at the end of the process.
|
||||||
|
sudo docker buildx build --build-arg PGRST_GITHUB_COMMIT=$PGRST_GITHUB_COMMIT \
|
||||||
|
-t $DOCKER_REPO/postgrest:$PGRST_VERSION-arm \
|
||||||
|
--push .
|
||||||
|
|
||||||
|
# Add the arm images to the manifest
|
||||||
|
# NOTE: This assumes that there already is a `postgrest:<version>` image
|
||||||
|
# for the amd64 architecture pushed to Docker Hub
|
||||||
|
sudo docker buildx imagetools create --append -t $DOCKER_REPO/postgrest:$PGRST_VERSION $DOCKER_REPO/postgrest:$PGRST_VERSION-arm
|
||||||
|
[ -z $IS_PRERELEASE ] && sudo docker buildx imagetools create --append -t $DOCKER_REPO/postgrest:latest $DOCKER_REPO/postgrest:$PGRST_VERSION-arm
|
||||||
|
|
||||||
|
sudo docker logout
|
||||||
@@ -0,0 +1,476 @@
|
|||||||
|
name: CI
|
||||||
|
|
||||||
|
on:
|
||||||
|
push:
|
||||||
|
branches:
|
||||||
|
- main
|
||||||
|
- rel-*
|
||||||
|
tags:
|
||||||
|
- v*
|
||||||
|
pull_request:
|
||||||
|
branches:
|
||||||
|
- main
|
||||||
|
- rel-*
|
||||||
|
|
||||||
|
jobs:
|
||||||
|
Lint-Style:
|
||||||
|
name: Lint & check code style
|
||||||
|
runs-on: ubuntu-latest
|
||||||
|
steps:
|
||||||
|
- uses: actions/checkout@v3
|
||||||
|
- name: Setup Nix Environment
|
||||||
|
uses: ./.github/actions/setup-nix
|
||||||
|
with:
|
||||||
|
tools: style
|
||||||
|
- name: Run linter (check locally with `nix-shell --run postgrest-lint`)
|
||||||
|
run: postgrest-lint
|
||||||
|
- name: Run style check (auto-format with `nix-shell --run postgrest-style`)
|
||||||
|
run: postgrest-style-check
|
||||||
|
|
||||||
|
|
||||||
|
Test-Nix:
|
||||||
|
name: Test (Nix)
|
||||||
|
runs-on: ubuntu-latest
|
||||||
|
defaults:
|
||||||
|
run:
|
||||||
|
# Hack for enabling color output, see:
|
||||||
|
# https://github.com/actions/runner/issues/241#issuecomment-842566950
|
||||||
|
shell: script -qec "bash --noprofile --norc -eo pipefail {0}"
|
||||||
|
steps:
|
||||||
|
- uses: actions/checkout@v3
|
||||||
|
- name: Setup Nix Environment
|
||||||
|
uses: ./.github/actions/setup-nix
|
||||||
|
with:
|
||||||
|
tools: tests
|
||||||
|
|
||||||
|
- name: Run coverage (IO tests and Spec tests against PostgreSQL 14)
|
||||||
|
run: postgrest-coverage
|
||||||
|
- name: Upload coverage to codecov
|
||||||
|
uses: codecov/codecov-action@v3.1.0
|
||||||
|
with:
|
||||||
|
files: ./coverage/codecov.json
|
||||||
|
|
||||||
|
- name: Run doctests
|
||||||
|
if: always()
|
||||||
|
run: nix-shell --run postgrest-test-doctests
|
||||||
|
|
||||||
|
- name: Check the spec tests for idempotence
|
||||||
|
if: always()
|
||||||
|
run: postgrest-test-spec-idempotence
|
||||||
|
|
||||||
|
|
||||||
|
Test-Pg-Nix:
|
||||||
|
strategy:
|
||||||
|
fail-fast: false
|
||||||
|
matrix:
|
||||||
|
pgVersion: [9.6, 10, 11, 12, 13, 14]
|
||||||
|
name: Test PG ${{ matrix.pgVersion }} (Nix)
|
||||||
|
runs-on: ubuntu-latest
|
||||||
|
defaults:
|
||||||
|
run:
|
||||||
|
# Hack for enabling color output, see:
|
||||||
|
# https://github.com/actions/runner/issues/241#issuecomment-842566950
|
||||||
|
shell: script -qec "bash --noprofile --norc -eo pipefail {0}"
|
||||||
|
steps:
|
||||||
|
- uses: actions/checkout@v3
|
||||||
|
- name: Setup Nix Environment
|
||||||
|
uses: ./.github/actions/setup-nix
|
||||||
|
with:
|
||||||
|
tools: tests withTools
|
||||||
|
|
||||||
|
- name: Run spec tests
|
||||||
|
if: always()
|
||||||
|
run: postgrest-with-postgresql-${{ matrix.pgVersion }} postgrest-test-spec
|
||||||
|
|
||||||
|
- name: Run IO tests
|
||||||
|
if: always()
|
||||||
|
run: postgrest-with-postgresql-${{ matrix.pgVersion }} -f test/io/fixtures.sql postgrest-test-io
|
||||||
|
|
||||||
|
- name: Run query cost tests
|
||||||
|
if: always()
|
||||||
|
run: postgrest-with-postgresql-${{ matrix.pgVersion }} postgrest-test-querycost
|
||||||
|
|
||||||
|
|
||||||
|
Test-Memory-Nix:
|
||||||
|
name: Test memory (Nix)
|
||||||
|
runs-on: ubuntu-latest
|
||||||
|
steps:
|
||||||
|
- uses: actions/checkout@v3
|
||||||
|
- name: Setup Nix Environment
|
||||||
|
uses: ./.github/actions/setup-nix
|
||||||
|
with:
|
||||||
|
tools: memory
|
||||||
|
- name: Run memory tests
|
||||||
|
run: postgrest-test-memory
|
||||||
|
|
||||||
|
|
||||||
|
Build-Static-Nix:
|
||||||
|
name: Build Linux static (Nix)
|
||||||
|
runs-on: ubuntu-latest
|
||||||
|
steps:
|
||||||
|
- uses: actions/checkout@v3
|
||||||
|
- name: Setup Nix Environment
|
||||||
|
uses: ./.github/actions/setup-nix
|
||||||
|
with:
|
||||||
|
authToken: '${{ secrets.CACHIX_AUTH_TOKEN }}'
|
||||||
|
tools: tests
|
||||||
|
|
||||||
|
- name: Build static executable
|
||||||
|
run: nix-build -A postgrestStatic
|
||||||
|
- name: Check static executable
|
||||||
|
run: postgrest-check-static result/bin/postgrest
|
||||||
|
- name: Save built executable as artifact
|
||||||
|
uses: actions/upload-artifact@v3
|
||||||
|
with:
|
||||||
|
name: postgrest-linux-static-x64
|
||||||
|
path: result/bin/postgrest
|
||||||
|
if-no-files-found: error
|
||||||
|
|
||||||
|
- name: Build Docker image
|
||||||
|
run: nix-build -A docker.image --out-link postgrest-docker.tar.gz
|
||||||
|
- name: Save built Docker image as artifact
|
||||||
|
uses: actions/upload-artifact@v3
|
||||||
|
with:
|
||||||
|
name: postgrest-docker-x64
|
||||||
|
path: postgrest-docker.tar.gz
|
||||||
|
if-no-files-found: error
|
||||||
|
|
||||||
|
- name: Build and push everything to Cachix (main branch only)
|
||||||
|
if: ${{ github.ref == 'refs/heads/main' }}
|
||||||
|
run: |
|
||||||
|
nix-build
|
||||||
|
nix-env -f default.nix -iA devTools
|
||||||
|
postgrest-push-cachix
|
||||||
|
|
||||||
|
|
||||||
|
Build-Stack:
|
||||||
|
strategy:
|
||||||
|
fail-fast: false
|
||||||
|
matrix:
|
||||||
|
include:
|
||||||
|
- name: Linux & test
|
||||||
|
runs-on: ubuntu-latest
|
||||||
|
cache: |
|
||||||
|
~/.stack
|
||||||
|
.stack-work
|
||||||
|
artifact: postgrest-ubuntu-x64
|
||||||
|
|
||||||
|
- name: MacOS & test
|
||||||
|
runs-on: macos-latest
|
||||||
|
cache: |
|
||||||
|
~/.stack
|
||||||
|
.stack-work
|
||||||
|
artifact: postgrest-macos-x64
|
||||||
|
|
||||||
|
- name: Windows
|
||||||
|
runs-on: windows-latest
|
||||||
|
cache: |
|
||||||
|
~\AppData\Roaming\stack
|
||||||
|
~\AppData\Local\Programs\stack
|
||||||
|
.stack-work
|
||||||
|
deps: Add-Content $env:GITHUB_PATH $env:PGBIN
|
||||||
|
artifact: postgrest-windows-x64
|
||||||
|
|
||||||
|
name: Build ${{ matrix.name }} (Stack)
|
||||||
|
runs-on: ${{ matrix.runs-on }}
|
||||||
|
steps:
|
||||||
|
- uses: actions/checkout@v3
|
||||||
|
- name: Stack working files cache
|
||||||
|
uses: actions/cache@v3
|
||||||
|
with:
|
||||||
|
path: ${{ matrix.cache }}
|
||||||
|
key: ${{ runner.os }}-${{ hashFiles('stack.yaml.lock') }}
|
||||||
|
- name: Install dependencies
|
||||||
|
if: ${{ matrix.deps }}
|
||||||
|
run: ${{ matrix.deps }}
|
||||||
|
- name: Build with Stack
|
||||||
|
run: stack build --local-bin-path result --copy-bins
|
||||||
|
- name: Save built executable as artifact
|
||||||
|
uses: actions/upload-artifact@v3
|
||||||
|
with:
|
||||||
|
name: ${{ matrix.artifact }}
|
||||||
|
path: |
|
||||||
|
result/postgrest
|
||||||
|
result/postgrest.exe
|
||||||
|
if-no-files-found: error
|
||||||
|
|
||||||
|
Get-FreeBSD-CirrusCI:
|
||||||
|
name: Get FreeBSD build from CirrusCI
|
||||||
|
runs-on: ubuntu-latest
|
||||||
|
steps:
|
||||||
|
- uses: actions/checkout@v3
|
||||||
|
- name: Get FreeBSD executable from CirrusCI
|
||||||
|
env:
|
||||||
|
# GITHUB_SHA does weird things for pull request, so we roll our own:
|
||||||
|
GITHUB_COMMIT: ${{github.event.pull_request.head.sha || github.sha}}
|
||||||
|
run: .github/get_cirrusci_freebsd
|
||||||
|
- name: Save executable as artifact
|
||||||
|
uses: actions/upload-artifact@v3
|
||||||
|
with:
|
||||||
|
name: postgrest-freebsd-x64
|
||||||
|
path: postgrest
|
||||||
|
if-no-files-found: error
|
||||||
|
|
||||||
|
Build-Cabal-Arm:
|
||||||
|
name: Build aarch64 (Cabal)
|
||||||
|
if: ${{ github.ref == 'refs/heads/main' || startsWith(github.ref, 'refs/tags/v') || startsWith(github.ref, 'refs/heads/rel-') }}
|
||||||
|
runs-on: ubuntu-latest
|
||||||
|
outputs:
|
||||||
|
remotepath: ${{ steps.Remote-Dir.outputs.remotepath }}
|
||||||
|
env:
|
||||||
|
GITHUB_COMMIT: ${{ github.sha }}
|
||||||
|
steps:
|
||||||
|
- uses: actions/checkout@v2.4.0
|
||||||
|
- id: Remote-Dir
|
||||||
|
name: Unique directory name for the remote build
|
||||||
|
run: echo "::set-output name=remotepath::postgrest-build-$(uuidgen)"
|
||||||
|
- name: Copy script files to the remote server
|
||||||
|
uses: appleboy/scp-action@master
|
||||||
|
with:
|
||||||
|
host: ${{ secrets.SSH_ARM_HOST }}
|
||||||
|
username: ubuntu
|
||||||
|
key: ${{ secrets.SSH_ARM_PRIVATE_KEY }}
|
||||||
|
fingerprint: ${{ secrets.SSH_ARM_FINGERPRINT }}
|
||||||
|
source: ".github/scripts/arm/*"
|
||||||
|
target: ${{ steps.Remote-Dir.outputs.remotepath }}
|
||||||
|
strip_components: 3
|
||||||
|
- name: Build ARM
|
||||||
|
uses: appleboy/ssh-action@master
|
||||||
|
env:
|
||||||
|
REMOTE_DIR: ${{ steps.Remote-Dir.outputs.remotepath }}
|
||||||
|
with:
|
||||||
|
host: ${{ secrets.SSH_ARM_HOST }}
|
||||||
|
username: ubuntu
|
||||||
|
key: ${{ secrets.SSH_ARM_PRIVATE_KEY }}
|
||||||
|
fingerprint: ${{ secrets.SSH_ARM_FINGERPRINT }}
|
||||||
|
command_timeout: 120m
|
||||||
|
script_stop: true
|
||||||
|
envs: GITHUB_COMMIT,REMOTE_DIR
|
||||||
|
script: bash ~/$REMOTE_DIR/build.sh "$GITHUB_COMMIT" "$REMOTE_DIR"
|
||||||
|
- name: Download binaries from remote server
|
||||||
|
uses: nicklasfrahm/scp-action@main
|
||||||
|
with:
|
||||||
|
direction: download
|
||||||
|
host: ${{ secrets.SSH_ARM_HOST }}
|
||||||
|
username: ubuntu
|
||||||
|
key: ${{ secrets.SSH_ARM_PRIVATE_KEY }}
|
||||||
|
fingerprint: ${{ secrets.SSH_ARM_FINGERPRINT }}
|
||||||
|
source: "${{ steps.Remote-Dir.outputs.remotepath }}/result.tar.xz"
|
||||||
|
target: "result.tar.xz"
|
||||||
|
- name: Extract downloaded binaries
|
||||||
|
run: tar -xvf result.tar.xz && rm result.tar.xz
|
||||||
|
- name: Save aarch64 executable as artifact
|
||||||
|
uses: actions/upload-artifact@v2.3.1
|
||||||
|
with:
|
||||||
|
name: postgrest-ubuntu-aarch64
|
||||||
|
path: result/postgrest
|
||||||
|
if-no-files-found: error
|
||||||
|
|
||||||
|
|
||||||
|
Prepare-Release:
|
||||||
|
name: Prepare release
|
||||||
|
if: startsWith(github.ref, 'refs/tags/v')
|
||||||
|
runs-on: ubuntu-latest
|
||||||
|
needs:
|
||||||
|
- Lint-Style
|
||||||
|
- Test-Nix
|
||||||
|
- Test-Pg-Nix
|
||||||
|
- Test-Memory-Nix
|
||||||
|
- Build-Static-Nix
|
||||||
|
- Build-Stack
|
||||||
|
#- Get-FreeBSD-CirrusCI
|
||||||
|
- Build-Cabal-Arm
|
||||||
|
outputs:
|
||||||
|
version: ${{ steps.Identify-Version.outputs.version }}
|
||||||
|
isprerelease: ${{ steps.Identify-Version.outputs.isprerelease }}
|
||||||
|
steps:
|
||||||
|
- uses: actions/checkout@v3
|
||||||
|
- id: Identify-Version
|
||||||
|
name: Identify the version to be released
|
||||||
|
run: |
|
||||||
|
tag_version="${GITHUB_REF##*/}"
|
||||||
|
cabal_version="$(grep -oP '^version:\s*\K.*' postgrest.cabal)"
|
||||||
|
|
||||||
|
if [ "$tag_version" != "v$cabal_version" ]; then
|
||||||
|
echo "Tagged version ($tag_version) does not match the one in postgrest.cabal (v$cabal_version). Aborting release..."
|
||||||
|
exit 1
|
||||||
|
else
|
||||||
|
echo "Version to be released is $cabal_version"
|
||||||
|
echo "::set-output name=version::$cabal_version"
|
||||||
|
fi
|
||||||
|
|
||||||
|
if [[ "$cabal_version" != *.*.*.* ]]; then
|
||||||
|
echo "Version is for a full release (version does not have four components)"
|
||||||
|
else
|
||||||
|
echo "Version is for a pre-release (version has four components, e.g., 1.1.1.1)"
|
||||||
|
echo "::set-output name=isprerelease::1"
|
||||||
|
fi
|
||||||
|
- name: Identify changes from CHANGELOG.md
|
||||||
|
run: |
|
||||||
|
version="${{ steps.Identify-Version.outputs.version }}"
|
||||||
|
isprerelease="${{ steps.Identify-Version.outputs.isprerelease }}"
|
||||||
|
|
||||||
|
if [ -n "$isprerelease" ]; then
|
||||||
|
echo "Getting unreleased changes..."
|
||||||
|
sed -n "1,/## Unreleased/d;/## \[/q;p" CHANGELOG.md > CHANGES.md
|
||||||
|
else
|
||||||
|
echo "Full release (no '-' in version), getting changes for version $version ..."
|
||||||
|
sed -n "1,/## \[$version\]/d;/## \[/q;p" CHANGELOG.md > CHANGES.md
|
||||||
|
fi
|
||||||
|
|
||||||
|
echo "Relevant extract from CHANGELOG.md:"
|
||||||
|
cat CHANGES.md
|
||||||
|
- name: Save CHANGES.md as artifact
|
||||||
|
uses: actions/upload-artifact@v3
|
||||||
|
with:
|
||||||
|
name: release-changes
|
||||||
|
path: CHANGES.md
|
||||||
|
if-no-files-found: error
|
||||||
|
|
||||||
|
|
||||||
|
Release-GitHub:
|
||||||
|
name: Release on GitHub
|
||||||
|
permissions:
|
||||||
|
contents: write
|
||||||
|
runs-on: ubuntu-latest
|
||||||
|
needs: Prepare-Release
|
||||||
|
env:
|
||||||
|
VERSION: ${{ needs.Prepare-Release.outputs.version }}
|
||||||
|
steps:
|
||||||
|
- uses: actions/checkout@v3
|
||||||
|
- name: Download all artifacts
|
||||||
|
uses: actions/download-artifact@v3
|
||||||
|
with:
|
||||||
|
path: artifacts
|
||||||
|
- name: Create release bundle with archives for all builds
|
||||||
|
run: |
|
||||||
|
find artifacts -type f -iname postgrest -exec chmod +x {} \;
|
||||||
|
|
||||||
|
mkdir -p release-bundle
|
||||||
|
|
||||||
|
tar cJvf "release-bundle/postgrest-v$VERSION-linux-static-x64.tar.xz" \
|
||||||
|
-C artifacts/postgrest-linux-static-x64 postgrest
|
||||||
|
|
||||||
|
# No need to release Ubuntu, as the static Linux binary built with Nix
|
||||||
|
# covers all Linux use-cases
|
||||||
|
#tar cfJv "release-bundle/postgrest-v$VERSION-ubuntu-x64.tar.xz" \
|
||||||
|
# -C artifacts/postgrest-ubuntu-x64 postgrest
|
||||||
|
|
||||||
|
tar cJvf "release-bundle/postgrest-v$VERSION-macos-x64.tar.xz" \
|
||||||
|
-C artifacts/postgrest-macos-x64 postgrest
|
||||||
|
|
||||||
|
# TODO: Fix timeouts for FreeBSD builds in Cirrus
|
||||||
|
#tar cJvf "release-bundle/postgrest-v$VERSION-freebsd-x64.tar.xz" \
|
||||||
|
# -C artifacts/postgrest-freebsd-x64 postgrest
|
||||||
|
|
||||||
|
tar cJvf "release-bundle/postgrest-v$VERSION-ubuntu-aarch64.tar.xz" \
|
||||||
|
-C artifacts/postgrest-ubuntu-aarch64 postgrest
|
||||||
|
|
||||||
|
zip "release-bundle/postgrest-v$VERSION-windows-x64.zip" \
|
||||||
|
artifacts/postgrest-windows-x64/postgrest.exe
|
||||||
|
|
||||||
|
- name: Save release bundle
|
||||||
|
uses: actions/upload-artifact@v3
|
||||||
|
with:
|
||||||
|
name: release-bundle
|
||||||
|
path: release-bundle
|
||||||
|
if-no-files-found: error
|
||||||
|
|
||||||
|
- name: Publish release on GitHub
|
||||||
|
env:
|
||||||
|
GITHUB_TOKEN: ${{ secrets.GITHUB_TOKEN }}
|
||||||
|
run: |
|
||||||
|
isprerelease="${{ needs.Prepare-Release.outputs.isprerelease }}"
|
||||||
|
echo "Releasing version v$VERSION on GitHub (isprerelease=$isprerelease)..."
|
||||||
|
|
||||||
|
gh release delete "v$VERSION" || true
|
||||||
|
gh release create "v$VERSION" \
|
||||||
|
-F artifacts/release-changes/CHANGES.md \
|
||||||
|
${isprerelease:+"--prerelease"} \
|
||||||
|
release-bundle/*
|
||||||
|
|
||||||
|
|
||||||
|
Release-Docker:
|
||||||
|
name: Release on Docker Hub
|
||||||
|
runs-on: ubuntu-latest
|
||||||
|
needs:
|
||||||
|
- Build-Cabal-Arm
|
||||||
|
- Prepare-Release
|
||||||
|
env:
|
||||||
|
GITHUB_COMMIT: ${{ github.sha }}
|
||||||
|
DOCKER_REPO: postgrest
|
||||||
|
DOCKER_USER: stevechavez
|
||||||
|
DOCKER_PASS: ${{ secrets.DOCKER_PASS }}
|
||||||
|
VERSION: ${{ needs.Prepare-Release.outputs.version }}
|
||||||
|
ISPRERELEASE: ${{ needs.Prepare-Release.outputs.isprerelease }}
|
||||||
|
steps:
|
||||||
|
- uses: actions/checkout@v3
|
||||||
|
- name: Setup Nix Environment
|
||||||
|
uses: ./.github/actions/setup-nix
|
||||||
|
with:
|
||||||
|
tools: release
|
||||||
|
- name: Download Docker image
|
||||||
|
uses: actions/download-artifact@v3
|
||||||
|
with:
|
||||||
|
name: postgrest-docker-x64
|
||||||
|
- name: Publish images on Docker Hub
|
||||||
|
run: |
|
||||||
|
docker login -u "$DOCKER_USER" -p "$DOCKER_PASS"
|
||||||
|
docker load -i postgrest-docker.tar.gz
|
||||||
|
|
||||||
|
docker tag postgrest:latest "$DOCKER_REPO/postgrest:v$VERSION"
|
||||||
|
docker push "$DOCKER_REPO/postgrest:v$VERSION"
|
||||||
|
|
||||||
|
# Only tag 'latest' for full releases
|
||||||
|
if [[ -z "$ISPRERELEASE" ]]; then
|
||||||
|
echo "Pushing to 'latest' tag for full release of v$VERSION ..."
|
||||||
|
docker tag postgrest:latest "$DOCKER_REPO"/postgrest:latest
|
||||||
|
docker push "$DOCKER_REPO"/postgrest:latest
|
||||||
|
else
|
||||||
|
echo "Skipping pushing to 'latest' tag for v$VERSION pre-release..."
|
||||||
|
fi
|
||||||
|
- name: Publish images for ARM builds on Docker Hub
|
||||||
|
uses: appleboy/ssh-action@master
|
||||||
|
env:
|
||||||
|
REMOTE_DIR: ${{ needs.Build-Cabal-Arm.outputs.remotepath }}
|
||||||
|
with:
|
||||||
|
host: ${{ secrets.SSH_ARM_HOST }}
|
||||||
|
username: ubuntu
|
||||||
|
key: ${{ secrets.SSH_ARM_PRIVATE_KEY }}
|
||||||
|
fingerprint: ${{ secrets.SSH_ARM_FINGERPRINT }}
|
||||||
|
script_stop: true
|
||||||
|
envs: GITHUB_COMMIT,DOCKER_REPO,DOCKER_USER,DOCKER_PASS,REMOTE_DIR,VERSION,ISPRERELEASE
|
||||||
|
script: bash ~/$REMOTE_DIR/docker-publish.sh "$GITHUB_COMMIT" "$DOCKER_REPO" "$DOCKER_USER" "$DOCKER_PASS" "$REMOTE_DIR" "$VERSION" "$ISPRERELEASE"
|
||||||
|
# TODO: Enable dockerhub description update again, once a solution for the permission problem is found:
|
||||||
|
# https://github.com/docker/hub-feedback/issues/1927
|
||||||
|
# - name: Update descriptions on Docker Hub
|
||||||
|
# env:
|
||||||
|
# DOCKER_PASS: ${{ secrets.DOCKER_PASS }}
|
||||||
|
# run: |
|
||||||
|
# if [[ -z "$ISPRERELEASE" ]]; then
|
||||||
|
# echo "Updating description on Docker Hub..."
|
||||||
|
# postgrest-release-dockerhub-description
|
||||||
|
# else
|
||||||
|
# echo "Skipping updating description for pre-release..."
|
||||||
|
# fi
|
||||||
|
|
||||||
|
Clean-Arm-Server:
|
||||||
|
name: Remove copied files from server
|
||||||
|
needs:
|
||||||
|
- Build-Cabal-Arm
|
||||||
|
- Release-Docker
|
||||||
|
if: ${{ always() && (github.ref == 'refs/heads/main' || startsWith(github.ref, 'refs/tags/v') || startsWith(github.ref, 'refs/heads/rel-')) }}
|
||||||
|
runs-on: ubuntu-latest
|
||||||
|
env:
|
||||||
|
REMOTE_DIR: ${{ needs.Build-Cabal-Arm.outputs.remotepath }}
|
||||||
|
steps:
|
||||||
|
- uses: actions/checkout@v2.4.0
|
||||||
|
- name: Remove uploaded files from server
|
||||||
|
uses: appleboy/ssh-action@master
|
||||||
|
with:
|
||||||
|
host: ${{ secrets.SSH_ARM_HOST }}
|
||||||
|
username: ubuntu
|
||||||
|
key: ${{ secrets.SSH_ARM_PRIVATE_KEY }}
|
||||||
|
fingerprint: ${{ secrets.SSH_ARM_FINGERPRINT }}
|
||||||
|
envs: REMOTE_DIR
|
||||||
|
script: rm -rf $REMOTE_DIR
|
||||||
@@ -0,0 +1,34 @@
|
|||||||
|
name: Loadtest
|
||||||
|
|
||||||
|
on:
|
||||||
|
push:
|
||||||
|
branches:
|
||||||
|
- main
|
||||||
|
tags:
|
||||||
|
- v*
|
||||||
|
pull_request:
|
||||||
|
branches:
|
||||||
|
- main
|
||||||
|
|
||||||
|
jobs:
|
||||||
|
Loadtest-Nix:
|
||||||
|
name: Loadtest (Nix)
|
||||||
|
runs-on: ubuntu-latest
|
||||||
|
steps:
|
||||||
|
- uses: actions/checkout@v3
|
||||||
|
with:
|
||||||
|
fetch-depth: 0
|
||||||
|
- name: Setup Nix Environment
|
||||||
|
uses: ./.github/actions/setup-nix
|
||||||
|
with:
|
||||||
|
tools: loadtest
|
||||||
|
- name: Run loadtest
|
||||||
|
run: |
|
||||||
|
postgrest-loadtest-against main
|
||||||
|
postgrest-loadtest-report > loadtest/loadtest.md
|
||||||
|
- name: Upload report
|
||||||
|
uses: actions/upload-artifact@v3
|
||||||
|
with:
|
||||||
|
name: loadtest.md
|
||||||
|
path: loadtest/loadtest.md
|
||||||
|
if-no-files-found: error
|
||||||
@@ -0,0 +1,33 @@
|
|||||||
|
name: Upload Reports
|
||||||
|
|
||||||
|
on:
|
||||||
|
workflow_run:
|
||||||
|
workflows: ["Loadtest"]
|
||||||
|
types:
|
||||||
|
- completed
|
||||||
|
|
||||||
|
jobs:
|
||||||
|
upload:
|
||||||
|
name: Loadtest
|
||||||
|
permissions:
|
||||||
|
checks: write
|
||||||
|
runs-on: ubuntu-latest
|
||||||
|
if: ${{ github.event.workflow_run.conclusion == 'success' }}
|
||||||
|
steps:
|
||||||
|
- name: Download from Artifacts
|
||||||
|
uses: dawidd6/action-download-artifact@v2
|
||||||
|
with:
|
||||||
|
workflow: ${{ github.event.workflow.name }}
|
||||||
|
run_id: ${{github.event.workflow_run.id }}
|
||||||
|
name: loadtest.md
|
||||||
|
path: artifacts
|
||||||
|
- name: Upload to GitHub Checks
|
||||||
|
uses: LouisBrunner/checks-action@v1.2.0
|
||||||
|
with:
|
||||||
|
token: ${{ secrets.GITHUB_TOKEN }}
|
||||||
|
sha: ${{ github.event.workflow_run.head_sha }}
|
||||||
|
name: Loadtest Results
|
||||||
|
conclusion: neutral
|
||||||
|
output: |
|
||||||
|
{"summary":""}
|
||||||
|
output_text_description_file: artifacts/loadtest.md
|
||||||
@@ -21,3 +21,5 @@ __pycache__
|
|||||||
*.tix
|
*.tix
|
||||||
coverage
|
coverage
|
||||||
.hpc
|
.hpc
|
||||||
|
loadtest
|
||||||
|
.history
|
||||||
|
|||||||
-80
@@ -1,80 +0,0 @@
|
|||||||
language: generic
|
|
||||||
|
|
||||||
sudo: false
|
|
||||||
|
|
||||||
jobs:
|
|
||||||
include:
|
|
||||||
- name: Build OSX Binary
|
|
||||||
os: osx
|
|
||||||
cache:
|
|
||||||
timeout: 1000
|
|
||||||
directories:
|
|
||||||
- $HOME/.stack
|
|
||||||
- $HOME/.local/bin
|
|
||||||
before_install:
|
|
||||||
- mkdir -p "$HOME/.local/bin"
|
|
||||||
- export PATH="$PATH:$HOME/.local/bin"
|
|
||||||
install:
|
|
||||||
- |
|
|
||||||
if test -f "$HOME/.local/bin/stack"
|
|
||||||
then
|
|
||||||
echo 'Stack is already installed.'
|
|
||||||
else
|
|
||||||
echo "Installing Stack..."
|
|
||||||
travis_retry curl -L https://www.stackage.org/stack/osx-x86_64 > stack.tar.gz
|
|
||||||
gunzip stack.tar.gz
|
|
||||||
tar -x -f stack.tar --strip-components 1
|
|
||||||
mv stack "$HOME/.local/bin/"
|
|
||||||
rm stack.tar
|
|
||||||
fi
|
|
||||||
- |
|
|
||||||
if test -f "$HOME/.local/bin/ghr"
|
|
||||||
then
|
|
||||||
echo 'ghr is already installed.'
|
|
||||||
else
|
|
||||||
echo "Installing ghr..."
|
|
||||||
travis_retry curl -L https://github.com/tcnksm/ghr/releases/download/v0.5.4/ghr_v0.5.4_darwin_386.zip > ghr.zip
|
|
||||||
unzip ghr.zip -d "$HOME/.local/bin"
|
|
||||||
rm ghr.zip
|
|
||||||
fi
|
|
||||||
script:
|
|
||||||
- |
|
|
||||||
if test "$TRAVIS_TAG" = "nightly"
|
|
||||||
then
|
|
||||||
cabal_nightly_version=$(git show -s --format='%cd' --date='format:%Y%m%d')
|
|
||||||
sed -i '' "s/^version:.*/version:$cabal_nightly_version/" postgrest.cabal
|
|
||||||
fi
|
|
||||||
## Building the whole project can take longer than 50 minutes. Since Travis has a global timeout of 50 minutes
|
|
||||||
## we compile for 30 minutes tops(`gtimeout 1800`) and quit compiling with no error.
|
|
||||||
## Since we CACHE the compile results we can continue compiling from where we left off
|
|
||||||
## on the next commit.
|
|
||||||
- gtimeout 1800 stack build --no-terminal --only-snapshot --install-ghc || (($?==124))
|
|
||||||
- |
|
|
||||||
if test ! "$TRAVIS_TAG"
|
|
||||||
then
|
|
||||||
echo 'No tag pushed. Skip building binary.'
|
|
||||||
else
|
|
||||||
stack build --no-terminal --copy-bins --local-bin-path .
|
|
||||||
fi
|
|
||||||
- |
|
|
||||||
if test ! "$TRAVIS_TAG"
|
|
||||||
then
|
|
||||||
echo 'No tag pushed. Skipping release.'
|
|
||||||
else
|
|
||||||
owner="$(echo "$TRAVIS_REPO_SLUG" | cut -f1 -d/)"
|
|
||||||
repo="$(echo "$TRAVIS_REPO_SLUG" | cut -f2 -d/)"
|
|
||||||
if test $TRAVIS_TAG = "nightly"
|
|
||||||
then
|
|
||||||
suffix=$(git show -s --format="%cd-%h" --date="format:%Y-%m-%d-%H-%M")
|
|
||||||
strip postgrest
|
|
||||||
tar cJf postgrest-nightly-$suffix-osx.tar.xz postgrest
|
|
||||||
ghr -t $GITHUB_TOKEN -u $owner -r $repo --replace nightly postgrest-nightly-$suffix-osx.tar.xz
|
|
||||||
else
|
|
||||||
start=$TRAVIS_TAG
|
|
||||||
end='## \['
|
|
||||||
body=$(sed -n "1,/$start/d;/$end/q;p" CHANGELOG.md)
|
|
||||||
strip postgrest
|
|
||||||
tar cJf postgrest-$TRAVIS_TAG-osx.tar.xz postgrest
|
|
||||||
ghr -t $GITHUB_TOKEN -u $owner -r $repo -b "$body"--replace $TRAVIS_TAG postgrest-$TRAVIS_TAG-osx.tar.xz
|
|
||||||
fi
|
|
||||||
fi
|
|
||||||
+130
@@ -5,10 +5,140 @@ This project adheres to [Semantic Versioning](http://semver.org/).
|
|||||||
|
|
||||||
## Unreleased
|
## Unreleased
|
||||||
|
|
||||||
|
## [10.0.0] - 2022-08-18
|
||||||
|
|
||||||
### Added
|
### Added
|
||||||
|
|
||||||
|
- #1933, #2109, Add a minimal health check endpoint - @steve-chavez
|
||||||
|
+ For enabling this, the `admin-server-port` config must be set explictly
|
||||||
|
+ A `<host>:<admin_server_port>/live` endpoint is available for checking if postgrest is running on its port/socket. 200 OK = alive, 503 = dead.
|
||||||
|
+ A `<host>:<admin_server_port>/ready` endpoint is available for checking a correct internal state(the database connection plus the schema cache). 200 OK = ready, 503 = not ready.
|
||||||
|
- #1988, Add the current user to the request log on stdout - @DavidLindbom, @wolfgangwalther
|
||||||
|
- #1823, Add the ability to run postgrest without any configuration. - @wolfgangwalther
|
||||||
|
+ #1991, Add the ability to run without `db-uri` using libpq's PG environment variables to connect. - @wolfgangwalther
|
||||||
|
+ #1769, Add the ability to run without `db-schemas`, defaulting to `db-schemas=public`. - @wolfgangwalther
|
||||||
|
+ #1689, Add the ability to run without `db-anon-role` disabling anonymous access. - @wolfgangwalther
|
||||||
|
- #1543, Allow access to fields of composite types in select=, order= and filters through JSON operators -> and ->>. - @wolfgangwalther
|
||||||
|
- #2075, Allow access to array items in ?select=, ?order= and filters through JSON operators -> and ->>. - @wolfgangwalther
|
||||||
|
- #2156, #2211, Allow applying `limit/offset` to UPDATE/DELETE to only affect a subset of rows - @steve-chavez
|
||||||
|
+ It requires an explicit `order` on a unique column(s)
|
||||||
|
- #1917, Add error codes with the `"PGRST"` prefix to the error response body to differentiate PostgREST errors from PostgreSQL errors - @laurenceisla
|
||||||
|
- #1917, Normalize the error response body by always having the `detail` and `hint` error fields with a `null` value if they are empty - @laurenceisla
|
||||||
|
- #2176, Errors raised with `SQLSTATE` now include the message and the code in the response body - @laurenceisla
|
||||||
|
- #2236, Support POSIX regular expression operators for row filtering - @enote-kane
|
||||||
|
- #2202, Allow returning XML from RPCs - @fjf2002
|
||||||
|
- #2268, Allow returning XML from single-column queries - @fjf2002
|
||||||
|
- #2300, RPC POST for function w/single unnamed XML param #2300 - @fjf2002
|
||||||
|
- #1564, Allow geojson output by specifying the `Accept: application/geo+json` media type - @steve-chavez
|
||||||
|
+ Requires postgis >= 3.0
|
||||||
|
+ Works for GET, RPC, POST/PATCH/DELETE with `Prefer: return=representation`.
|
||||||
|
+ Resource embedding works and the embedded rows will go into the `properties` key
|
||||||
|
+ In case of multiple geometries in the same table, you can choose which one will go into the `geometry` key with the usual `?select` query parameter.
|
||||||
|
- #1082, Add security definitions to the OpenAPI output - @laurenceisla
|
||||||
|
- #2378, Support http OPTIONS method on RPC and root path - @steve-chavez
|
||||||
|
- #2354, Allow getting the EXPLAIN plan of a request by using the `Accept: application/vnd.pgrst.plan` header - @steve-chavez
|
||||||
|
+ Only allowed if the `db-plan-enabled` config is set to true
|
||||||
|
+ Can generate the plan for different media types using the `for` parameter: `Accept: application/vnd.pgrst.plan; for="application/vnd.pgrst.object"`
|
||||||
|
+ Different options for the plan can be used with the `options` parameter: `Accept: application/vnd.pgrst.plan; options=analyze|verbose|settings|buffers|wal`
|
||||||
|
+ The plan can be obtained in text or json by using different media type suffixes: `Accept: application/vnd.pgrst.plan+text` and `Accept: application/vnd.pgrst.plan+json`.
|
||||||
|
- #2144, Support computed relationships which allow extending and overriding relationships for resource embedding - @steve-chavez, @wolfgangwalther
|
||||||
|
- #1984, Detect one-to-one relationships for resource embedding - @steve-chavez
|
||||||
|
+ Detected when there's a foreign key with a unique constraint or when a foreign key is also a primary key
|
||||||
|
|
||||||
### Fixed
|
### Fixed
|
||||||
|
|
||||||
|
- #2058, Return 204 No Content without Content-Type for PUT - @wolfgangwalther
|
||||||
|
- #2107, Clarify error for failed schema cache load. - @steve-chavez
|
||||||
|
+ From `Database connection lost. Retrying the connection` to `Could not query the database for the schema cache. Retrying.`
|
||||||
|
- #1771, Fix silently ignoring filter on a non-existent embedded resource - @steve-chavez
|
||||||
|
- #2152, Remove functions, which are uncallable because of unnamend arguments from schema cache and OpenAPI output. - @wolfgangwalther
|
||||||
|
- #2145, Fix accessing json array fields with -> and ->> in ?select= and ?order=. - @wolfgangwalther
|
||||||
|
- #2155, Ignore `max-rows` on POST, PATCH, PUT and DELETE - @steve-chavez
|
||||||
|
- #2254, Fix inferring a foreign key column as a primary key column on views - @steve-chavez
|
||||||
|
- #2070, Restrict generated many-to-many relationships - @steve-chavez
|
||||||
|
+ Only adds many-to-many relationships when: a table has FKs to two other tables and these FK columns are part of the table's PK columns.
|
||||||
|
- #2278, Allow casting to types with underscores and numbers(e.g. `select=oid_array::_int4`) - @steve-chavez
|
||||||
|
- #2277, #2238, #1643, Prevent views from breaking one-to-many/many-to-one embeds when using column or FK as target - @steve-chavez
|
||||||
|
+ When using a column or FK as target for embedding(`/tbl?select=*,col-or-fk(*)`), only tables are now detected and views are not.
|
||||||
|
+ You can still use a column or an inferred FK on a view to embed a table(`/view?select=*,col-or-fk(*)`)
|
||||||
|
- #2317, Increase the `db-pool-timeout` to 1 hour to prevent frequent high connection latency - @steve-chavez
|
||||||
|
- #2341, The search path now correctly identifies schemas with uppercase and special characters in their names (regression) - @laurenceisla
|
||||||
|
- #2364, "404 Not Found" on nested routes and "405 Method Not Allowed" errors no longer start an empty database transaction - @steve-chavez
|
||||||
|
- #2342, Fix inaccurate result count when an inner embed was selected after a normal embed in the query string - @laurenceisla
|
||||||
|
- #2376, OPTIONS requests no longer start an empty database transaction - @steve-chavez
|
||||||
|
- #2395, Allow using columns with dollar sign($) without double quoting in filters and `select` - @steve-chavez
|
||||||
|
- #2410, Fix loop crash error on startup in Postgres 15 beta 3. Log: "UNION types \"char\" and text cannot be matched". - @yevon
|
||||||
|
- #2397, Fix race conditions managing database connection helper - @robx
|
||||||
|
- #2269, Allow `limit=0` in the request query to return an empty array - @gautam1168, @laurenceisla
|
||||||
|
|
||||||
|
### Changed
|
||||||
|
|
||||||
|
- #2001, Return 204 No Content without Content-Type for RPCs returning VOID - @wolfgangwalther
|
||||||
|
+ Previously, those RPCs would return "null" as a body with Content-Type: application/json.
|
||||||
|
- #2156, `limit/offset` now limits the affected rows on UPDATE/DELETE - @steve-chavez
|
||||||
|
+ Previously, `limit/offset` only limited the returned rows but not the actual updated rows
|
||||||
|
- #2155, `max-rows` is no longer applied on POST/PATCH/PUT/DELETE returned rows - @steve-chavez
|
||||||
|
+ This was misleading because the affected rows were not really affected by `max-rows`, only the returned rows were limited
|
||||||
|
- #2070, Restrict generated many-to-many relationships - @steve-chavez
|
||||||
|
+ A primary key that contains the foreign key columns is now needed for generating many-to-many relationships.
|
||||||
|
- #2277, Views now are not detected when embedding using the column or FK as target (`/view?select=*,column(*)`) - @steve-chavez
|
||||||
|
+ This embedding form was easily made ambiguous whenever a new view was added.
|
||||||
|
+ You can use computed relationships to keep this embedding form working
|
||||||
|
- #2312, Using `Prefer: return=representation` no longer returns a `Location` header - @laurenceisla
|
||||||
|
- #1984, For the cases where one to one relationships are detected, json objects will be returned instead of json arrays of length 1
|
||||||
|
+ If you wish to override this behavior, you can use computed relationships to return arrays again
|
||||||
|
|
||||||
|
## [9.0.1] - 2022-06-03
|
||||||
|
|
||||||
|
### Fixed
|
||||||
|
|
||||||
|
- #2165, Fix json/jsonb columns should not have type in OpenAPI spec - @clrnd
|
||||||
|
- #2020, Execute deferred constraint triggers when using `Prefer: tx=rollback` - @wolfgangwalther
|
||||||
|
- #2077, Fix `is` not working with upper or mixed case values like `NULL, TrUe, FaLsE` - @steve-chavez
|
||||||
|
- #2024, Fix schema cache loading when views with XMLTABLE and DEFAULT are present - @wolfgangwalther
|
||||||
|
- #1724, Fix wrong CORS header Authentication -> Authorization - @wolfgangwalther
|
||||||
|
- #2120, Fix reading database configuration properly when `=` is present in value - @wolfgangwalther
|
||||||
|
- #2135, Remove trigger functions from schema cache and OpenAPI output, because they can't be called directly anyway. - @wolfgangwalther
|
||||||
|
- #2101, Remove aggregates, procedures and window functions from the schema cache and OpenAPI output. - @wolfgangwalther
|
||||||
|
- #2153, Fix --dump-schema running with a wrong PG version. - @wolfgangwalther
|
||||||
|
- #2042, Keep working when EMFILE(Too many open files) is reached. - @steve-chavez
|
||||||
|
- #2147, Ignore `Content-Type` headers for `GET` requests when calling RPCs. - @laurenceisla
|
||||||
|
+ Previously, `GET` without parameters, but with `Content-Type: text/plain` or `Content-Type: application/octet-stream` would fail with `404 Not Found`, even if a function without arguments was available.
|
||||||
|
- #2239, Fix misleading disambiguation error where the content of the `relationship` key looks like valid syntax - @laurenceisla
|
||||||
|
- #2294, Disable parallel GC for better performance on higher core CPUs - @steve-chavez
|
||||||
|
- #1076, Fix using CPU while idle - @steve-chavez
|
||||||
|
|
||||||
|
## [9.0.0] - 2021-11-25
|
||||||
|
|
||||||
|
### Added
|
||||||
|
|
||||||
|
- #1783, Include partitioned tables into the schema cache. Allows embedding, UPSERT, INSERT with Location response, OPTIONS request and OpenAPI support for partitioned tables - @laurenceisla
|
||||||
|
- #1878, Add Retry-After hint header when in recovery mode - @gautam1168
|
||||||
|
- #1735, Allow calling function with single unnamed param through RPC POST. - @steve-chavez
|
||||||
|
+ Enables calling a function with a single json parameter without using `Prefer: params=single-object`
|
||||||
|
+ Enables uploading bytea to a function with `Content-Type: application/octet-stream`
|
||||||
|
+ Enables uploading raw text to a function with `Content-Type: text/plain`
|
||||||
|
- #1938, Allow escaping inside double quotes with a backslash, e.g. `?col=in.("Double\"Quote")`, `?col=in.("Back\\slash")` - @steve-chavez
|
||||||
|
- #1075, Allow filtering top-level resource based on embedded resources filters. This is enabled by adding `!inner` to the embedded resource, e.g. `/projects?select=*,clients!inner(*)&clients.id=eq.12`- @steve-chavez, @Iced-Sun
|
||||||
|
- #1857, Make GUC names for headers, cookies and jwt claims compatible with PostgreSQL v14 - @laurenceisla, @robertsosinski
|
||||||
|
+ Getting the value for a header GUC on PostgreSQL 14 is done using `current_setting('request.headers')::json->>'name-of-header'` and in a similar way for `request.cookies` and `request.jwt.claims`
|
||||||
|
+ PostgreSQL versions below 14 can opt in to the new JSON GUCs by setting the `db-use-legacy-gucs` config option to false (true by default)
|
||||||
|
- #1988, Allow specifying `unknown` for the `is` operator - @steve-chavez
|
||||||
|
- #2031, Improve error message for ambiguous embedding and add a relevant hint that includes unambiguous embedding suggestions - @laurenceisla
|
||||||
|
|
||||||
|
### Fixed
|
||||||
|
|
||||||
|
- #1871, Fix OpenAPI missing default values for String types and identify Array types as "array" instead of "string" - @laurenceisla
|
||||||
|
- #1930, Fix RPC return type handling for `RETURNS TABLE` with a single column. Regression of #1615. - @wolfgangwalther
|
||||||
|
- #1938, Fix using single double quotes(`"`) and backslashes(`/`) as values on the "in" operator - @steve-chavez
|
||||||
|
- #1992, Fix schema cache query failing with standard_conforming_strings = off - @wolfgangwalther
|
||||||
|
|
||||||
|
### Changed
|
||||||
|
|
||||||
|
- #1949, Drop support for embedding hints used with '.'(`select=projects.client_id(*)`), '!' should be used instead(`select=projects!client_id(*)`) - @steve-chavez
|
||||||
|
- #1783, Partitions (created using `PARTITION OF`) are no longer included in the schema cache. - @laurenceisla
|
||||||
|
- #2038, Dropped support for PostgreSQL 9.5 - @wolfgangwalther
|
||||||
|
|
||||||
## [8.0.0] - 2021-07-25
|
## [8.0.0] - 2021-07-25
|
||||||
|
|
||||||
### Added
|
### Added
|
||||||
|
|||||||
@@ -2,13 +2,10 @@
|
|||||||
|
|
||||||
[](https://www.patreon.com/postgrest)
|
[](https://www.patreon.com/postgrest)
|
||||||
[](https://www.paypal.me/postgrest)
|
[](https://www.paypal.me/postgrest)
|
||||||
<a href="https://heroku.com/deploy?template=https://github.com/PostgREST/postgrest">
|
|
||||||
<img src="https://img.shields.io/badge/%E2%86%91_Deploy_to-Heroku-7056bf.svg" alt="Deploy">
|
|
||||||
</a>
|
|
||||||
[](https://gitter.im/begriffs/postgrest)
|
[](https://gitter.im/begriffs/postgrest)
|
||||||
[](http://postgrest.org)
|
[](http://postgrest.org)
|
||||||
[](https://hub.docker.com/r/postgrest/postgrest/)
|
[](https://hub.docker.com/r/postgrest/postgrest/)
|
||||||
[](https://circleci.com/gh/PostgREST/postgrest/tree/main)
|
[](https://github.com/PostgREST/postgrest/actions?query=branch%3Amain)
|
||||||
[](https://app.codecov.io/gh/PostgREST/postgrest)
|
[](https://app.codecov.io/gh/PostgREST/postgrest)
|
||||||
[](http://hackage.haskell.org/package/postgrest)
|
[](http://hackage.haskell.org/package/postgrest)
|
||||||
|
|
||||||
@@ -112,15 +109,6 @@ the connection cannot do anything the user themselves couldn't. Other
|
|||||||
forms of authentication can be built on top of the JWT primitive. See
|
forms of authentication can be built on top of the JWT primitive. See
|
||||||
the docs for more information.
|
the docs for more information.
|
||||||
|
|
||||||
Since PostgreSQL 9.5 supports true [row-level
|
|
||||||
security](http://www.postgresql.org/docs/9.5/static/ddl-rowsecurity.html).
|
|
||||||
In previous versions it can be simulated with triggers and
|
|
||||||
security-barrier views. Because the possible queries to the database
|
|
||||||
are limited to certain templates using
|
|
||||||
[leakproof](http://blog.2ndquadrant.com/how-do-postgresql-security_barrier-views-work/)
|
|
||||||
functions, the trigger workaround does not compromise row-level
|
|
||||||
security.
|
|
||||||
|
|
||||||
## Versioning
|
## Versioning
|
||||||
|
|
||||||
A robust long-lived API needs the freedom to exist in multiple
|
A robust long-lived API needs the freedom to exist in multiple
|
||||||
|
|||||||
@@ -1,59 +0,0 @@
|
|||||||
{
|
|
||||||
"name": "PostgREST",
|
|
||||||
"description": "RESTful API for any PostgreSQL database.",
|
|
||||||
"logo": "https://avatars2.githubusercontent.com/u/15115011",
|
|
||||||
"repository": "https://github.com/PostgREST/postgrest",
|
|
||||||
"env": {
|
|
||||||
"BUILDPACK_URL": {
|
|
||||||
"description": "Heroku buildpack for deploying Haskell applications",
|
|
||||||
"value": "https://github.com/PostgREST/postgrest-heroku"
|
|
||||||
},
|
|
||||||
"POSTGREST_VER": {
|
|
||||||
"description": "Version of PostgREST to deploy",
|
|
||||||
"value": "8.0.0"
|
|
||||||
},
|
|
||||||
"DB_URI": {
|
|
||||||
"description": "Database connection string, e.g. postgres://user:pass@xxxxxxx.rds.amazonaws.com/mydb",
|
|
||||||
"required": true
|
|
||||||
},
|
|
||||||
"DB_SCHEMA": {
|
|
||||||
"description": "The database schema to expose to REST clients. Tables, views and stored procedures in this schema will get API endpoints",
|
|
||||||
"required": true,
|
|
||||||
"value": "public"
|
|
||||||
},
|
|
||||||
"DB_ANON_ROLE": {
|
|
||||||
"description": "The database role to use when executing commands on behalf of unauthenticated clients",
|
|
||||||
"required": true
|
|
||||||
},
|
|
||||||
"DB_POOL": {
|
|
||||||
"description": "Number of connections to keep open in PostgREST’s database pool",
|
|
||||||
"required": false,
|
|
||||||
"value": "10"
|
|
||||||
},
|
|
||||||
"SERVER_PROXY_URI": {
|
|
||||||
"description": "Overrides the base URL used within the OpenAPI self-documentation hosted at the API root path",
|
|
||||||
"required": false
|
|
||||||
},
|
|
||||||
"JWT_SECRET": {
|
|
||||||
"description": "The secret used to decode JWT tokens clients provide for authentication",
|
|
||||||
"required": false
|
|
||||||
},
|
|
||||||
"SECRET_IS_BASE64": {
|
|
||||||
"description": "When this is set to true, the value derived from jwt-secret will be treated as a base64 encoded secret",
|
|
||||||
"required": false,
|
|
||||||
"value": "false"
|
|
||||||
},
|
|
||||||
"JWT_AUD": {
|
|
||||||
"description": "The audience that should be validated if the JWT token contains an aud claim",
|
|
||||||
"required": false
|
|
||||||
},
|
|
||||||
"MAX_ROWS": {
|
|
||||||
"description": "A hard limit to the number of rows PostgREST will fetch from a view, table, or stored procedure",
|
|
||||||
"required": false
|
|
||||||
},
|
|
||||||
"PRE_REQUEST": {
|
|
||||||
"description": "A schema-qualified stored procedure name to call right after switching roles for a client request",
|
|
||||||
"required": false
|
|
||||||
}
|
|
||||||
}
|
|
||||||
}
|
|
||||||
@@ -1,47 +0,0 @@
|
|||||||
## AppVeyor is only used for building a Windows binary, no tests are run here.
|
|
||||||
platform: x64
|
|
||||||
image: Visual Studio 2015
|
|
||||||
|
|
||||||
cache:
|
|
||||||
- "c:\\sr"
|
|
||||||
- .stack-work
|
|
||||||
- "c:\\Users\\appveyor\\AppData\\Local\\Programs\\stack"
|
|
||||||
|
|
||||||
environment:
|
|
||||||
global:
|
|
||||||
STACK_ROOT: "c:\\sr"
|
|
||||||
GOPATH: c:\gopath
|
|
||||||
TMP: "c:\\tmp"
|
|
||||||
|
|
||||||
test: off
|
|
||||||
|
|
||||||
install:
|
|
||||||
- set PATH=C:\Program Files\PostgreSQL\9.6\bin\;%PATH%
|
|
||||||
- curl -sS -ostack.zip -L --insecure http://www.stackage.org/stack/windows-x86_64
|
|
||||||
- 7z x stack.zip stack.exe
|
|
||||||
- set PATH=%GOPATH%\bin;c:\go\bin;%PATH%
|
|
||||||
- go get -u github.com/tcnksm/ghr
|
|
||||||
|
|
||||||
build_script:
|
|
||||||
- ps: $env:cabal_nightly_version=(git show -s --format='%cd' --date='format:%Y%m%d')
|
|
||||||
- IF "%APPVEYOR_REPO_TAG_NAME%"=="nightly" bash -lc "sed -i -r \"s/^(version:\s+)\S+$/\1$cabal_nightly_version/\" postgrest.cabal"
|
|
||||||
- stack setup --no-terminal > nul
|
|
||||||
# Appveyor has a timeout of 60 mins, building can take longer, limit the time and make sure this succeeds,
|
|
||||||
# previous work will get cached and finish on next commit
|
|
||||||
- bash -lc "timeout 2700 'C:\projects\postgrest\stack.exe' build -j1 --copy-bins --local-bin-path . || (($?==124))"
|
|
||||||
|
|
||||||
artifacts:
|
|
||||||
- path: postgrest.exe
|
|
||||||
|
|
||||||
deploy_script:
|
|
||||||
## Use powershell(ps) for this because CMD commands having "%" don't work(even by escaping with "%%"). See https://github.com/appveyor/ci/issues/246.
|
|
||||||
- ps: $env:suffix=(git show -s --format="%cd-%h" --date="format:%Y-%m-%d-%H-%M")
|
|
||||||
- IF DEFINED APPVEYOR_REPO_TAG_NAME (
|
|
||||||
IF "%APPVEYOR_REPO_TAG_NAME%"=="nightly" (
|
|
||||||
7z a -tzip postgrest-nightly-%suffix%-windows-x64.zip postgrest.exe &&
|
|
||||||
bash -lc "exec 0</dev/null && cd $APPVEYOR_BUILD_FOLDER && ghr -t $GITHUB_TOKEN -u $APPVEYOR_ACCOUNT_NAME -r $APPVEYOR_PROJECT_NAME --replace nightly postgrest-nightly-$suffix-windows-x64.zip"
|
|
||||||
) ELSE (
|
|
||||||
7z a -tzip postgrest-%APPVEYOR_REPO_TAG_NAME%-windows-x64.zip postgrest.exe &&
|
|
||||||
bash -lc "exec 0</dev/null && cd $APPVEYOR_BUILD_FOLDER && ghr -t $GITHUB_TOKEN -u $APPVEYOR_ACCOUNT_NAME -r $APPVEYOR_PROJECT_NAME -b \"`sed -n \"1,/$APPVEYOR_REPO_TAG_NAME/d;/## \[/q;p\" CHANGELOG.md`\" --replace $APPVEYOR_REPO_TAG_NAME postgrest-$APPVEYOR_REPO_TAG_NAME-windows-x64.zip"
|
|
||||||
)
|
|
||||||
)
|
|
||||||
+25
-23
@@ -1,9 +1,11 @@
|
|||||||
|
{ system ? builtins.currentSystem }:
|
||||||
|
|
||||||
let
|
let
|
||||||
name =
|
name =
|
||||||
"postgrest";
|
"postgrest";
|
||||||
|
|
||||||
compiler =
|
compiler =
|
||||||
"ghc8104";
|
"ghc924";
|
||||||
|
|
||||||
# PostgREST source files, filtered based on the rules in the .gitignore files
|
# PostgREST source files, filtered based on the rules in the .gitignore files
|
||||||
# and file extensions. We want to include as litte as possible, as the files
|
# and file extensions. We want to include as litte as possible, as the files
|
||||||
@@ -33,25 +35,25 @@ let
|
|||||||
[
|
[
|
||||||
allOverlays.build-toolbox
|
allOverlays.build-toolbox
|
||||||
allOverlays.checked-shell-script
|
allOverlays.checked-shell-script
|
||||||
allOverlays.ghr
|
|
||||||
allOverlays.gitignore
|
allOverlays.gitignore
|
||||||
allOverlays.postgresql-default
|
allOverlays.postgresql-default
|
||||||
allOverlays.postgresql-legacy
|
allOverlays.postgresql-legacy
|
||||||
|
allOverlays.postgresql-future
|
||||||
(allOverlays.haskell-packages { inherit compiler; })
|
(allOverlays.haskell-packages { inherit compiler; })
|
||||||
];
|
];
|
||||||
|
|
||||||
# Evaluated expression of the Nixpkgs repository.
|
# Evaluated expression of the Nixpkgs repository.
|
||||||
pkgs =
|
pkgs =
|
||||||
import nixpkgs { inherit overlays; };
|
import nixpkgs { inherit overlays system; };
|
||||||
|
|
||||||
postgresqlVersions =
|
postgresqlVersions =
|
||||||
[
|
[
|
||||||
{ name = "postgresql-13"; postgresql = pkgs.postgresql_13; }
|
{ name = "postgresql-14"; postgresql = pkgs.postgresql_14.withPackages (p: [ p.postgis p.pg_safeupdate ]); }
|
||||||
{ name = "postgresql-12"; postgresql = pkgs.postgresql_12; }
|
{ name = "postgresql-13"; postgresql = pkgs.postgresql_13.withPackages (p: [ p.postgis p.pg_safeupdate ]); }
|
||||||
{ name = "postgresql-11"; postgresql = pkgs.postgresql_11; }
|
{ name = "postgresql-12"; postgresql = pkgs.postgresql_12.withPackages (p: [ p.postgis p.pg_safeupdate ]); }
|
||||||
{ name = "postgresql-10"; postgresql = pkgs.postgresql_10; }
|
{ name = "postgresql-11"; postgresql = pkgs.postgresql_11.withPackages (p: [ p.postgis p.pg_safeupdate ]); }
|
||||||
{ name = "postgresql-9.6"; postgresql = pkgs.postgresql_9_6; }
|
{ name = "postgresql-10"; postgresql = pkgs.postgresql_10.withPackages (p: [ p.postgis p.pg_safeupdate ]); }
|
||||||
{ name = "postgresql-9.5"; postgresql = pkgs.postgresql_9_5; }
|
{ name = "postgresql-9.6"; postgresql = pkgs.postgresql_9_6.withPackages (p: [ p.postgis p.pg_safeupdate ]); }
|
||||||
];
|
];
|
||||||
|
|
||||||
patches =
|
patches =
|
||||||
@@ -64,7 +66,7 @@ let
|
|||||||
# Function that derives a fully static Haskell package based on
|
# Function that derives a fully static Haskell package based on
|
||||||
# nh2/static-haskell-nix
|
# nh2/static-haskell-nix
|
||||||
staticHaskellPackage =
|
staticHaskellPackage =
|
||||||
import nix/static-haskell-package.nix { inherit nixpkgs compiler patches allOverlays; };
|
import nix/static-haskell-package.nix { inherit nixpkgs system compiler patches allOverlays; };
|
||||||
|
|
||||||
# Options passed to cabal in dev tools and tests
|
# Options passed to cabal in dev tools and tests
|
||||||
devCabalOptions =
|
devCabalOptions =
|
||||||
@@ -79,8 +81,7 @@ let
|
|||||||
}
|
}
|
||||||
);
|
);
|
||||||
|
|
||||||
lib =
|
inherit (pkgs.haskell) lib;
|
||||||
pkgs.haskell.lib;
|
|
||||||
in
|
in
|
||||||
rec {
|
rec {
|
||||||
inherit nixpkgs pkgs;
|
inherit nixpkgs pkgs;
|
||||||
@@ -103,13 +104,12 @@ rec {
|
|||||||
)
|
)
|
||||||
);
|
);
|
||||||
|
|
||||||
env =
|
inherit (postgrest) env;
|
||||||
postgrest.env;
|
|
||||||
|
|
||||||
# Tooling for analyzing Haskell imports and exports.
|
# Tooling for analyzing Haskell imports and exports.
|
||||||
hsie =
|
hsie =
|
||||||
pkgs.callPackage nix/hsie {
|
pkgs.callPackage nix/hsie {
|
||||||
ghcWithPackages = pkgs.haskell.packages.ghc884.ghcWithPackages;
|
inherit (pkgs.haskell.packages."${compiler}") ghcWithPackages;
|
||||||
};
|
};
|
||||||
|
|
||||||
### Tools
|
### Tools
|
||||||
@@ -119,12 +119,16 @@ rec {
|
|||||||
|
|
||||||
# Development tools.
|
# Development tools.
|
||||||
devTools =
|
devTools =
|
||||||
pkgs.callPackage nix/tools/devTools.nix { inherit tests style devCabalOptions hsie; };
|
pkgs.callPackage nix/tools/devTools.nix { inherit tests style devCabalOptions hsie withTools; };
|
||||||
|
|
||||||
# Docker images and loading script.
|
# Docker images and loading script.
|
||||||
docker =
|
docker =
|
||||||
pkgs.callPackage nix/tools/docker { postgrest = postgrestStatic; };
|
pkgs.callPackage nix/tools/docker { postgrest = postgrestStatic; };
|
||||||
|
|
||||||
|
# Load testing tools.
|
||||||
|
loadtest =
|
||||||
|
pkgs.callPackage nix/tools/loadtest.nix { inherit withTools; };
|
||||||
|
|
||||||
# Script for running memory tests.
|
# Script for running memory tests.
|
||||||
memory =
|
memory =
|
||||||
pkgs.callPackage nix/tools/memory.nix { inherit postgrestProfiled withTools; };
|
pkgs.callPackage nix/tools/memory.nix { inherit postgrestProfiled withTools; };
|
||||||
@@ -135,23 +139,21 @@ rec {
|
|||||||
|
|
||||||
# Scripts for publishing new releases.
|
# Scripts for publishing new releases.
|
||||||
release =
|
release =
|
||||||
pkgs.callPackage nix/tools/release {
|
pkgs.callPackage nix/tools/release { };
|
||||||
inherit docker;
|
|
||||||
postgrest = postgrestStatic;
|
|
||||||
};
|
|
||||||
|
|
||||||
# Linting and styling tools.
|
# Linting and styling tools.
|
||||||
style =
|
style =
|
||||||
pkgs.callPackage nix/tools/style.nix { };
|
pkgs.callPackage nix/tools/style.nix { inherit hsie; };
|
||||||
|
|
||||||
# Scripts for running tests.
|
# Scripts for running tests.
|
||||||
tests =
|
tests =
|
||||||
pkgs.callPackage nix/tools/tests.nix {
|
pkgs.callPackage nix/tools/tests.nix {
|
||||||
inherit postgrest devCabalOptions withTools;
|
inherit postgrest devCabalOptions withTools;
|
||||||
ghc = pkgs.haskell.compiler."${compiler}";
|
ghc = pkgs.haskell.compiler."${compiler}";
|
||||||
hpc-codecov = pkgs.haskell.packages."${compiler}".hpc-codecov;
|
inherit (pkgs.haskell.packages."${compiler}") hpc-codecov;
|
||||||
|
inherit (pkgs.haskell.packages."${compiler}") weeder;
|
||||||
};
|
};
|
||||||
|
|
||||||
withTools =
|
withTools =
|
||||||
pkgs.callPackage nix/tools/withTools.nix { inherit postgresqlVersions; };
|
pkgs.callPackage nix/tools/withTools.nix { inherit devCabalOptions postgresqlVersions postgrest; };
|
||||||
}
|
}
|
||||||
|
|||||||
+1
-6
@@ -2,15 +2,11 @@
|
|||||||
|
|
||||||
module Main (main) where
|
module Main (main) where
|
||||||
|
|
||||||
import qualified Data.Map.Strict as M
|
|
||||||
|
|
||||||
import System.IO (BufferMode (..), hSetBuffering)
|
import System.IO (BufferMode (..), hSetBuffering)
|
||||||
|
|
||||||
import qualified PostgREST.App as App
|
import qualified PostgREST.App as App
|
||||||
import qualified PostgREST.CLI as CLI
|
import qualified PostgREST.CLI as CLI
|
||||||
|
|
||||||
import PostgREST.Config (readPGRSTEnvironment)
|
|
||||||
|
|
||||||
import Protolude
|
import Protolude
|
||||||
|
|
||||||
#ifndef mingw32_HOST_OS
|
#ifndef mingw32_HOST_OS
|
||||||
@@ -20,8 +16,7 @@ import qualified PostgREST.Unix as Unix
|
|||||||
main :: IO ()
|
main :: IO ()
|
||||||
main = do
|
main = do
|
||||||
setBuffering
|
setBuffering
|
||||||
hasPGRSTEnv <- not . M.null <$> readPGRSTEnvironment
|
opts <- CLI.readCLIShowHelp
|
||||||
opts <- CLI.readCLIShowHelp hasPGRSTEnv
|
|
||||||
CLI.main installSignalHandlers runAppInSocket opts
|
CLI.main installSignalHandlers runAppInSocket opts
|
||||||
|
|
||||||
installSignalHandlers :: App.SignalHandlerInstaller
|
installSignalHandlers :: App.SignalHandlerInstaller
|
||||||
|
|||||||
+55
-7
@@ -80,8 +80,8 @@ postgrest-coverage postgrest-with-postgresql-10
|
|||||||
postgrest-lint postgrest-with-postgresql-11
|
postgrest-lint postgrest-with-postgresql-11
|
||||||
postgrest-run postgrest-with-postgresql-12
|
postgrest-run postgrest-with-postgresql-12
|
||||||
postgrest-style postgrest-with-postgresql-13
|
postgrest-style postgrest-with-postgresql-13
|
||||||
postgrest-style-check postgrest-with-postgresql-9.5
|
postgrest-style-check postgrest-with-postgresql-9.6
|
||||||
postgrest-test-io postgrest-with-postgresql-9.6
|
postgrest-test-io
|
||||||
...
|
...
|
||||||
|
|
||||||
[nix-shell]$
|
[nix-shell]$
|
||||||
@@ -104,8 +104,8 @@ postgrest-coverage postgrest-with-postgresql-10
|
|||||||
postgrest-lint postgrest-with-postgresql-11
|
postgrest-lint postgrest-with-postgresql-11
|
||||||
postgrest-run postgrest-with-postgresql-12
|
postgrest-run postgrest-with-postgresql-12
|
||||||
postgrest-style postgrest-with-postgresql-13
|
postgrest-style postgrest-with-postgresql-13
|
||||||
postgrest-style-check postgrest-with-postgresql-9.5
|
postgrest-style-check postgrest-with-postgresql-9.6
|
||||||
postgrest-test-io postgrest-with-postgresql-9.6
|
postgrest-test-io
|
||||||
postgrest-test-memory
|
postgrest-test-memory
|
||||||
...
|
...
|
||||||
|
|
||||||
@@ -149,13 +149,13 @@ the PostgREST repo. Paths are resolved relative to the repo root:
|
|||||||
$ cd src
|
$ cd src
|
||||||
# Even though the current directory is ./src, the config path must still start
|
# Even though the current directory is ./src, the config path must still start
|
||||||
# from the repo root:
|
# from the repo root:
|
||||||
$ postgrest-run test/io-tests/configs/simple.conf
|
$ postgrest-run test/io/configs/simple.conf
|
||||||
```
|
```
|
||||||
|
|
||||||
## Testing
|
## Testing
|
||||||
|
|
||||||
In nix-shell, you'll find utility scripts that make it very easy to run the
|
In nix-shell, you'll find utility scripts that make it very easy to run our
|
||||||
Haskell test suite, including setting up all required dependencies and
|
test suite, including setting up all required dependencies and
|
||||||
temporary test databases:
|
temporary test databases:
|
||||||
|
|
||||||
```bash
|
```bash
|
||||||
@@ -182,7 +182,55 @@ postgrest-test-io -k config
|
|||||||
# Run tests in parallel using xdist, specifying the number of processes:
|
# Run tests in parallel using xdist, specifying the number of processes:
|
||||||
postgrest-test-io -n auto
|
postgrest-test-io -n auto
|
||||||
postgrest-test-io -n 8
|
postgrest-test-io -n 8
|
||||||
|
```
|
||||||
|
|
||||||
|
The memory tests check that we don't surpass a memory threshold for big request bodies.
|
||||||
|
|
||||||
|
```bash
|
||||||
|
# Build the dependencies needed for the memory test
|
||||||
|
nix-shell --arg memory true
|
||||||
|
|
||||||
|
# Run the memory test
|
||||||
|
postgrest-test-memory
|
||||||
|
```
|
||||||
|
|
||||||
|
The loadtests ensure that performance doesn't drop on a change. Underlyingly they use
|
||||||
|
[vegeta](https://github.com/tsenart/vegeta).
|
||||||
|
|
||||||
|
```bash
|
||||||
|
# Run the loadtests on the latest commit(HEAD)
|
||||||
|
postgrest-loadtest
|
||||||
|
|
||||||
|
# You can loadtest comparing to a different branch
|
||||||
|
postgrest-loadtest-against master
|
||||||
|
|
||||||
|
# Produce a markdown report to be used on CI
|
||||||
|
postgrest-loadtest-report
|
||||||
|
```
|
||||||
|
|
||||||
|
Our query cost tests ensure that our generated queries don't surpass a threshold EXPLAIN cost.
|
||||||
|
|
||||||
|
```bash
|
||||||
|
postgrest-test-querycost
|
||||||
|
```
|
||||||
|
|
||||||
|
doctests for some of our modules are also available:
|
||||||
|
|
||||||
|
```bash
|
||||||
|
postgrest-test-doctest
|
||||||
|
```
|
||||||
|
|
||||||
|
## Code coverage
|
||||||
|
|
||||||
|
Code coverage is available under the `postgrest-coverage` command. This will produce a `./coverage` directory that can be visualized with a simple http server.
|
||||||
|
|
||||||
|
```bash
|
||||||
|
# Will run all the tests and produce a coverage dir
|
||||||
|
postgrest-coverage
|
||||||
|
|
||||||
|
# Visualize the output
|
||||||
|
cd coverage
|
||||||
|
python -mSimpleHTTPServer 8080
|
||||||
```
|
```
|
||||||
|
|
||||||
## Linting and styling code
|
## Linting and styling code
|
||||||
|
|||||||
+14
-11
@@ -17,12 +17,14 @@ module Main (main) where
|
|||||||
import qualified Data.Aeson as JSON
|
import qualified Data.Aeson as JSON
|
||||||
import qualified Data.ByteString.Lazy.Char8 as LBS8
|
import qualified Data.ByteString.Lazy.Char8 as LBS8
|
||||||
import qualified Data.Csv as Csv
|
import qualified Data.Csv as Csv
|
||||||
|
import qualified Data.List as List
|
||||||
import qualified Data.Map as Map
|
import qualified Data.Map as Map
|
||||||
import qualified Data.Set as Set
|
import qualified Data.Set as Set
|
||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
import qualified Data.Text.IO as T
|
import qualified Data.Text.IO as T
|
||||||
import qualified Dot
|
import qualified Dot
|
||||||
import qualified GHC
|
import qualified GHC
|
||||||
|
import qualified GHC.Paths
|
||||||
import qualified Language.Haskell.GHC.ExactPrint.Parsers as ExactPrint
|
import qualified Language.Haskell.GHC.ExactPrint.Parsers as ExactPrint
|
||||||
import qualified Options.Applicative as O
|
import qualified Options.Applicative as O
|
||||||
import qualified System.FilePath as FP
|
import qualified System.FilePath as FP
|
||||||
@@ -32,11 +34,12 @@ import Data.Function ((&))
|
|||||||
import Data.List (intercalate)
|
import Data.List (intercalate)
|
||||||
import Data.Maybe (catMaybes, mapMaybe)
|
import Data.Maybe (catMaybes, mapMaybe)
|
||||||
import Data.Text (Text)
|
import Data.Text (Text)
|
||||||
|
import GHC.Data.Bag (bagToList)
|
||||||
import GHC.Generics (Generic)
|
import GHC.Generics (Generic)
|
||||||
import HsExtension (GhcPs)
|
import GHC.Hs.Extension (GhcPs)
|
||||||
import Module (moduleNameString)
|
import GHC.Types.Name.Occurrence (occNameString)
|
||||||
import OccName (occNameString)
|
import GHC.Types.Name.Reader (rdrNameOcc)
|
||||||
import RdrName (rdrNameOcc)
|
import GHC.Unit.Module.Name (moduleNameString)
|
||||||
import System.Directory.Recursive (getFilesRecursive)
|
import System.Directory.Recursive (getFilesRecursive)
|
||||||
import System.Exit (exitFailure)
|
import System.Exit (exitFailure)
|
||||||
|
|
||||||
@@ -195,21 +198,21 @@ sourceSymbols source = do
|
|||||||
return $ concatMap (importSymbols source filepath . GHC.unLoc) hsmodImports
|
return $ concatMap (importSymbols source filepath . GHC.unLoc) hsmodImports
|
||||||
|
|
||||||
-- | Parse a Haskell module
|
-- | Parse a Haskell module
|
||||||
parseModule :: String -> IO (GHC.HsModule GhcPs)
|
parseModule :: FilePath -> IO GHC.HsModule
|
||||||
parseModule filepath = do
|
parseModule filepath = do
|
||||||
result <- ExactPrint.parseModule filepath
|
result <- ExactPrint.parseModule GHC.Paths.libdir filepath
|
||||||
case result of
|
case result of
|
||||||
Right (_, hsmod) ->
|
Right hsmod ->
|
||||||
return $ GHC.unLoc hsmod
|
return $ GHC.unLoc hsmod
|
||||||
Left (loc, err) ->
|
Left errs ->
|
||||||
fail $ "Error with " <> show filepath <> " at " <> show loc <> ": " <> err
|
fail $ "Errors with " <> show filepath <> ":\n "
|
||||||
|
<> List.intercalate "\n " (show <$> bagToList errs)
|
||||||
|
|
||||||
-- | Symbols imported in an import declaration.
|
-- | Symbols imported in an import declaration.
|
||||||
--
|
--
|
||||||
-- If the import is a wildcard, i.e. no symbols are selected for import, then
|
-- If the import is a wildcard, i.e. no symbols are selected for import, then
|
||||||
-- only one item is returned.
|
-- only one item is returned.
|
||||||
importSymbols :: FilePath -> FilePath -> GHC.ImportDecl GhcPs -> [ImportedSymbol]
|
importSymbols :: FilePath -> FilePath -> GHC.ImportDecl GhcPs -> [ImportedSymbol]
|
||||||
importSymbols _ _ (GHC.XImportDecl _) = mempty
|
|
||||||
importSymbols source filepath GHC.ImportDecl{..} =
|
importSymbols source filepath GHC.ImportDecl{..} =
|
||||||
case ideclHiding of
|
case ideclHiding of
|
||||||
Just (hiding, syms) ->
|
Just (hiding, syms) ->
|
||||||
@@ -223,7 +226,7 @@ importSymbols source filepath GHC.ImportDecl{..} =
|
|||||||
, impSource = source
|
, impSource = source
|
||||||
, impFromModule = T.pack $ moduleFromPath filepath
|
, impFromModule = T.pack $ moduleFromPath filepath
|
||||||
, impModule = T.pack . moduleNameString . GHC.unLoc $ ideclName
|
, impModule = T.pack . moduleNameString . GHC.unLoc $ ideclName
|
||||||
, impQualified = if ideclQualified then Qualified else NotQualified
|
, impQualified = if ideclQualified /= GHC.NotQualified then Qualified else NotQualified
|
||||||
, impAlias = T.pack . moduleNameString . GHC.unLoc <$> ideclAs
|
, impAlias = T.pack . moduleNameString . GHC.unLoc <$> ideclAs
|
||||||
, impInternal = External
|
, impInternal = External
|
||||||
, impType = hiding
|
, impType = hiding
|
||||||
|
|||||||
@@ -16,15 +16,20 @@ let
|
|||||||
ghc = ghcWithPackages modules;
|
ghc = ghcWithPackages modules;
|
||||||
hsie =
|
hsie =
|
||||||
runCommand "haskellimports" { inherit name src; }
|
runCommand "haskellimports" { inherit name src; }
|
||||||
"${ghc}/bin/ghc -O -Werror -Wall -package ghc $src -o $out";
|
''
|
||||||
|
cd $TMP
|
||||||
|
cp $src $TMP/Main.hs
|
||||||
|
${ghc}/bin/ghc -O -Werror -Wall -package ghc Main.hs -o Main
|
||||||
|
cp Main $out
|
||||||
|
'';
|
||||||
bin =
|
bin =
|
||||||
runCommand name { inherit hsie name; }
|
runCommand name { inherit hsie name; }
|
||||||
''
|
''
|
||||||
mkdir -p $out/bin
|
mkdir -p $out/bin
|
||||||
ln -s $hsie $out/bin/$name
|
ln -s $hsie $out/bin/$name
|
||||||
'';
|
'';
|
||||||
bashCompletion =
|
bash-completion =
|
||||||
runCommand "${name}-bash-completion" { inherit bin name; }
|
runCommand "${name}-bash-completion" { inherit bin name; }
|
||||||
"$bin/bin/$name --bash-completion-script $bin/bin/$name > $out";
|
"$bin/bin/$name --bash-completion-script $bin/bin/$name > $out";
|
||||||
in
|
in
|
||||||
hsie // { inherit bashCompletion bin; }
|
hsie // { inherit bash-completion bin; }
|
||||||
|
|||||||
@@ -1,6 +1,6 @@
|
|||||||
# Pinned version of Nixpkgs, generated with postgrest-nixpkgs-upgrade.
|
# Pinned version of Nixpkgs, generated with postgrest-nixpkgs-upgrade.
|
||||||
{
|
{
|
||||||
date = "2021-07-17";
|
date = "2022-08-09";
|
||||||
rev = "d00b5a5fa6fe8bdf7005abb06c46ae0245aec8b5";
|
rev = "9f15d6c3a74d2778c6e1af67947c95f100dc6fd2";
|
||||||
tarballHash = "08497wbpnf3w5dalcasqzymw3fmcn8qrnbkf8rxxwwvyjdnczxdv";
|
tarballHash = "14axdmi3kb6rlib39ik42yq907bm66x6vzswm5w1rsnw9vzgm31a";
|
||||||
}
|
}
|
||||||
|
|||||||
@@ -1,11 +1,11 @@
|
|||||||
# Creates an environment that exposes bashCompletion arguments from all checkedShellScripts
|
# Creates an environment that exposes bash-completion arguments from all checkedShellScripts
|
||||||
{ buildEnv }:
|
{ buildEnv }:
|
||||||
{ name
|
{ name
|
||||||
, tools
|
, tools
|
||||||
, extra ? { }
|
, extra ? { }
|
||||||
}:
|
}:
|
||||||
let
|
let
|
||||||
bashCompletion = builtins.map (tool: tool.bashCompletion) tools;
|
bash-completion = builtins.map (tool: tool.bash-completion) tools;
|
||||||
|
|
||||||
env = buildEnv {
|
env = buildEnv {
|
||||||
inherit name;
|
inherit name;
|
||||||
@@ -13,4 +13,4 @@ let
|
|||||||
};
|
};
|
||||||
|
|
||||||
in
|
in
|
||||||
env // { inherit bashCompletion; } // extra
|
env // { inherit bash-completion; } // extra
|
||||||
|
|||||||
@@ -14,18 +14,18 @@
|
|||||||
{ name
|
{ name
|
||||||
, docs
|
, docs
|
||||||
, args ? [ ]
|
, args ? [ ]
|
||||||
, addCommandCompletion ? false
|
, positionalCompletion ? ""
|
||||||
, inRootDir ? false
|
, inRootDir ? false
|
||||||
, redirectTixFiles ? true
|
, redirectTixFiles ? true
|
||||||
, withEnv ? null
|
, withEnv ? null
|
||||||
|
, withPath ? [ ]
|
||||||
, withTmpDir ? false
|
, withTmpDir ? false
|
||||||
}: text:
|
}: text:
|
||||||
let
|
let
|
||||||
|
# square brackets are a pain to escape - if even possible. just don't use them...
|
||||||
|
escape = builtins.replaceStrings [ "\n" ] [ " \\n" ];
|
||||||
|
|
||||||
argsTemplate =
|
argsTemplate =
|
||||||
let
|
|
||||||
# square brackets are a pain to escape - if even possible. just don't use them...
|
|
||||||
escapedDocs = builtins.replaceStrings [ "\n" ] [ " \\n" ] docs;
|
|
||||||
in
|
|
||||||
writeTextFile {
|
writeTextFile {
|
||||||
inherit name;
|
inherit name;
|
||||||
destination = "/${name}.m4"; # destination is needed to have the proper basename for completion
|
destination = "/${name}.m4"; # destination is needed to have the proper basename for completion
|
||||||
@@ -36,7 +36,7 @@ let
|
|||||||
# stripping the /nix/store/... path for nicer display
|
# stripping the /nix/store/... path for nicer display
|
||||||
BASH_ARGV0="$(basename "$0")"
|
BASH_ARGV0="$(basename "$0")"
|
||||||
|
|
||||||
# ARG_HELP([${name}], [${escapedDocs}])
|
# ARG_HELP([${name}], [${escape docs}])
|
||||||
${lib.strings.concatMapStrings (arg: "# " + arg) args}
|
${lib.strings.concatMapStrings (arg: "# " + arg) args}
|
||||||
# ARG_POSITIONAL_DOUBLEDASH()
|
# ARG_POSITIONAL_DOUBLEDASH()
|
||||||
# ARG_DEFAULTS_POS()
|
# ARG_DEFAULTS_POS()
|
||||||
@@ -58,14 +58,14 @@ let
|
|||||||
sed '/_positionals_count + 1/a\\t\t\t\tset -- "''${@:1:1}" "--" "''${@:2}"' -i $out
|
sed '/_positionals_count + 1/a\\t\t\t\tset -- "''${@:1:1}" "--" "''${@:2}"' -i $out
|
||||||
'';
|
'';
|
||||||
|
|
||||||
bashCompletion =
|
bash-completion =
|
||||||
runCommand "${name}-completion" { } (
|
runCommand "${name}-completion" { } (
|
||||||
''
|
''
|
||||||
${argbash}/bin/argbash --type completion --strip all ${argsTemplate}/${name}.m4 > $out
|
${argbash}/bin/argbash --type completion --strip all ${argsTemplate}/${name}.m4 > $out
|
||||||
''
|
''
|
||||||
|
|
||||||
+ lib.optionalString addCommandCompletion ''
|
+ lib.optionalString (positionalCompletion != "") ''
|
||||||
sed 's/COMPREPLY.*compgen -o bashdefault .*$/_command/' -i $out
|
sed 's#COMPREPLY.*compgen -o bashdefault .*$#${escape positionalCompletion}#' -i $out
|
||||||
''
|
''
|
||||||
);
|
);
|
||||||
|
|
||||||
@@ -114,6 +114,10 @@ let
|
|||||||
export PATH="$env/bin:$PATH"
|
export PATH="$env/bin:$PATH"
|
||||||
''
|
''
|
||||||
|
|
||||||
|
+ lib.optionalString (lib.length withPath > 0) ''
|
||||||
|
export PATH="${lib.concatMapStrings (p: p + "/bin:") withPath}$PATH"
|
||||||
|
''
|
||||||
|
|
||||||
+ "(${text})"
|
+ "(${text})"
|
||||||
|
|
||||||
+ lib.optionalString withTmpDir ''
|
+ lib.optionalString withTmpDir ''
|
||||||
@@ -134,4 +138,4 @@ let
|
|||||||
script =
|
script =
|
||||||
runCommand name { inherit bin name; } "ln -s $bin/bin/$name $out";
|
runCommand name { inherit bin name; } "ln -s $bin/bin/$name $out";
|
||||||
in
|
in
|
||||||
script // { inherit bin bashCompletion; }
|
script // { inherit bin bash-completion; }
|
||||||
|
|||||||
@@ -1,9 +1,9 @@
|
|||||||
{
|
{
|
||||||
build-toolbox = import ./build-toolbox;
|
build-toolbox = import ./build-toolbox;
|
||||||
checked-shell-script = import ./checked-shell-script;
|
checked-shell-script = import ./checked-shell-script;
|
||||||
ghr = import ./ghr;
|
|
||||||
gitignore = import ./gitignore.nix;
|
gitignore = import ./gitignore.nix;
|
||||||
haskell-packages = import ./haskell-packages.nix;
|
haskell-packages = import ./haskell-packages.nix;
|
||||||
postgresql-default = import ./postgresql-default.nix;
|
postgresql-default = import ./postgresql-default.nix;
|
||||||
postgresql-legacy = import ./postgresql-legacy.nix;
|
postgresql-legacy = import ./postgresql-legacy.nix;
|
||||||
|
postgresql-future = import ./postgresql-future.nix;
|
||||||
}
|
}
|
||||||
|
|||||||
@@ -1,7 +0,0 @@
|
|||||||
self: super:
|
|
||||||
# Overlay that adds `ghr`: Upload multiple artifacts to GitHub Release in
|
|
||||||
# parallel, http://tcnksm.github.io/ghr/
|
|
||||||
|
|
||||||
{
|
|
||||||
ghr = super.callPackage ./ghr.nix { };
|
|
||||||
}
|
|
||||||
@@ -1,18 +0,0 @@
|
|||||||
{ buildGoModule, fetchFromGitHub }:
|
|
||||||
|
|
||||||
buildGoModule rec {
|
|
||||||
pname = "ghr";
|
|
||||||
version = "0.14.0";
|
|
||||||
|
|
||||||
src = fetchFromGitHub {
|
|
||||||
rev = "v${version}";
|
|
||||||
owner = "tcnksm";
|
|
||||||
repo = "ghr";
|
|
||||||
sha256 = "1jjc3bwmyw831r1ayic1f1ysh5ggm88aszbndm0swg8byhz56pd4";
|
|
||||||
};
|
|
||||||
|
|
||||||
vendorSha256 = "06cbhsnxv4gisnwrhw61af7rpv2a9slf9z2wbn79r91xzkh51vzr";
|
|
||||||
|
|
||||||
# Disabling tests, as they require a GitHub API token
|
|
||||||
doCheck = false;
|
|
||||||
}
|
|
||||||
@@ -12,8 +12,8 @@ self: super:
|
|||||||
gitignoreSrc = super.fetchFromGitHub {
|
gitignoreSrc = super.fetchFromGitHub {
|
||||||
owner = "hercules-ci";
|
owner = "hercules-ci";
|
||||||
repo = "gitignore";
|
repo = "gitignore";
|
||||||
rev = "211907489e9f198594c0eb0ca9256a1949c9d412";
|
rev = "a20de23b925fd8264fd7fad6454652e142fd7f73";
|
||||||
sha256 = "06j7wpvj54khw0z10fjyi31kpafkr6hi1k0di13k1xp8kywvfyx8";
|
sha256 = "sha256-8DFJjXG8zqoONA1vXtgeKXy68KdJL5UaXR8NtVMUbx8=";
|
||||||
};
|
};
|
||||||
in
|
in
|
||||||
(super.callPackage gitignoreSrc { }).gitignoreSource;
|
(super.callPackage gitignoreSrc { }).gitignoreSource;
|
||||||
|
|||||||
@@ -2,8 +2,7 @@
|
|||||||
|
|
||||||
self: super:
|
self: super:
|
||||||
let
|
let
|
||||||
lib =
|
inherit (self.haskell) lib;
|
||||||
self.haskell.lib;
|
|
||||||
|
|
||||||
overrides =
|
overrides =
|
||||||
final: prev:
|
final: prev:
|
||||||
@@ -21,14 +20,17 @@ let
|
|||||||
# To get the sha256:
|
# To get the sha256:
|
||||||
# nix-prefetch-url --unpack https://hackage.haskell.org/package/protolude-0.3.0/protolude-0.3.0.tar.gz
|
# nix-prefetch-url --unpack https://hackage.haskell.org/package/protolude-0.3.0/protolude-0.3.0.tar.gz
|
||||||
|
|
||||||
hasql-dynamic-statements =
|
# To temporarily pin unreleased versions from GitHub:
|
||||||
lib.dontCheck (lib.unmarkBroken prev.hasql-dynamic-statements);
|
# <name> =
|
||||||
|
# prev.callCabal2nixWithOptions "<name>" (super.fetchFromGitHub {
|
||||||
hasql-implicits =
|
# owner = "<owner>";
|
||||||
lib.dontCheck (lib.unmarkBroken prev.hasql-implicits);
|
# repo = "<repo>";
|
||||||
|
# rev = "<commit>";
|
||||||
ptr =
|
# sha256 = "<sha256>";
|
||||||
lib.dontCheck (lib.unmarkBroken prev.ptr);
|
# }) "--subpath=<subpath>" {};
|
||||||
|
#
|
||||||
|
# To get the sha256:
|
||||||
|
# nix-prefetch-url --unpack https://github.com/<owner>/<repo>/archive/<commit>.tar.gz
|
||||||
} // extraOverrides final prev;
|
} // extraOverrides final prev;
|
||||||
in
|
in
|
||||||
{
|
{
|
||||||
|
|||||||
@@ -1,5 +1,5 @@
|
|||||||
self: super:
|
self: super:
|
||||||
# Overlay that sets the default version of PostgreSQL.
|
# Overlay that sets the default version of PostgreSQL.
|
||||||
{
|
{
|
||||||
postgresql = super.postgresql_13;
|
postgresql = super.postgresql_14;
|
||||||
}
|
}
|
||||||
|
|||||||
@@ -0,0 +1,19 @@
|
|||||||
|
self: super:
|
||||||
|
# Overlay that adds future versions of PostgreSQL that are supported by
|
||||||
|
# PostgREST.
|
||||||
|
{
|
||||||
|
## Example for including a postgresql version from a specific nixpks commit:
|
||||||
|
##
|
||||||
|
# postgresql_14 =
|
||||||
|
# let
|
||||||
|
# rev = "76b1e16c6659ccef7187ca69b287525fea133244";
|
||||||
|
# tarballHash = "1vsahpcx80k2bgslspb0sa6j4bmhdx77sw6la455drqcrqhdqj6a";
|
||||||
|
#
|
||||||
|
# pinnedPkgs =
|
||||||
|
# builtins.fetchTarball {
|
||||||
|
# url = "https://github.com/nixos/nixpkgs/archive/${rev}.tar.gz";
|
||||||
|
# sha256 = tarballHash;
|
||||||
|
# };
|
||||||
|
# in
|
||||||
|
# (import pinnedPkgs { }).pkgs.postgresql_14;
|
||||||
|
}
|
||||||
@@ -2,19 +2,18 @@ self: super:
|
|||||||
# Overlay that adds legacy versions of PostgreSQL that are supported by
|
# Overlay that adds legacy versions of PostgreSQL that are supported by
|
||||||
# PostgREST.
|
# PostgREST.
|
||||||
{
|
{
|
||||||
# PostgreSQL 9.5 was removed from Nixpkgs with
|
# PostgreSQL 9.6 was removed from Nixpkgs with
|
||||||
# https://github.com/NixOS/nixpkgs/commit/72ab382fb6b729b0d654f2c03f5eb25b39f11fbb
|
# https://github.com/NixOS/nixpkgs/commit/757dd008b2f2926fc0f7688fa8189f930ea47521
|
||||||
# We pin its parent commit to get the last version that was available.
|
# We pin its parent commit to get the last version that was available.
|
||||||
postgresql_9_5 =
|
postgresql_9_6 =
|
||||||
let
|
let
|
||||||
rev = "55ac7d4580c9ab67848c98cb9519317a1cc399c8";
|
rev = "571cbf3d1db477058303cef8754fb85a14e90eb7";
|
||||||
tarballHash = "02ffj9f8s1hwhmxj85nx04sv64qb6jm7w0122a1dz9n32fymgklj";
|
tarballHash = "0q74wn418i1bn5sssacmw8ykpmqvzr0s93sj6pbs3rf6bf134fkz";
|
||||||
|
|
||||||
pinnedPkgs =
|
pinnedPkgs =
|
||||||
builtins.fetchTarball {
|
builtins.fetchTarball {
|
||||||
url = "https://github.com/nixos/nixpkgs/archive/${rev}.tar.gz";
|
url = "https://github.com/nixos/nixpkgs/archive/${rev}.tar.gz";
|
||||||
sha256 = tarballHash;
|
sha256 = tarballHash;
|
||||||
};
|
};
|
||||||
in
|
in
|
||||||
(import pinnedPkgs { }).pkgs.postgresql_9_5;
|
(import pinnedPkgs { }).pkgs.postgresql_9_6;
|
||||||
}
|
}
|
||||||
|
|||||||
@@ -18,7 +18,8 @@
|
|||||||
done
|
done
|
||||||
'';
|
'';
|
||||||
|
|
||||||
# See: https://github.com/NixOS/nixpkgs/pull/87879
|
static-haskell-nix-ncurses =
|
||||||
nixpkgs-openssl-split-runtime-dependencies-of-static-builds =
|
./static-haskell-nix-ncurses.patch;
|
||||||
./nixpkgs-openssl-split-runtime-dependencies-of-static-builds.patch;
|
static-haskell-nix-ghc-bignum =
|
||||||
|
./static-haskell-nix-ghc-bignum.patch;
|
||||||
}
|
}
|
||||||
|
|||||||
@@ -1,76 +0,0 @@
|
|||||||
diff --git a/pkgs/development/libraries/openssl/default.nix b/pkgs/development/libraries/openssl/default.nix
|
|
||||||
index d4be8cc2428..3979698711f 100644
|
|
||||||
--- a/pkgs/development/libraries/openssl/default.nix
|
|
||||||
+++ b/pkgs/development/libraries/openssl/default.nix
|
|
||||||
@@ -50,9 +50,21 @@ let
|
|
||||||
substituteInPlace crypto/async/arch/async_posix.h \
|
|
||||||
--replace '!defined(__ANDROID__) && !defined(__OpenBSD__)' \
|
|
||||||
'!defined(__ANDROID__) && !defined(__OpenBSD__) && 0'
|
|
||||||
+ '' + optionalString static
|
|
||||||
+ # On static builds, the ENGINESDIR will be empty, but its path will be
|
|
||||||
+ # compiled into the library. In order to minimize the runtime dependencies
|
|
||||||
+ # of packages that statically link openssl, we move it into the OPENSSLDIR,
|
|
||||||
+ # which will be separated into the 'etc' output.
|
|
||||||
+ ''
|
|
||||||
+ substituteInPlace Configurations/unix-Makefile.tmpl \
|
|
||||||
+ --replace 'ENGINESDIR=$(libdir)/engines-{- $sover_dirname -}' \
|
|
||||||
+ 'ENGINESDIR=$(OPENSSLDIR)/engines-{- $sover_dirname -}'
|
|
||||||
'';
|
|
||||||
|
|
||||||
- outputs = [ "bin" "dev" "out" "man" ] ++ optional withDocs "doc";
|
|
||||||
+ outputs = [ "bin" "dev" "out" "man" ]
|
|
||||||
+ ++ optional withDocs "doc"
|
|
||||||
+ # Separate output for the runtime dependencies of the static build.
|
|
||||||
+ ++ optional static "etc";
|
|
||||||
setOutputFlags = false;
|
|
||||||
separateDebugInfo =
|
|
||||||
!stdenv.hostPlatform.isDarwin &&
|
|
||||||
@@ -101,7 +113,17 @@ let
|
|
||||||
configureFlags = [
|
|
||||||
"shared" # "shared" builds both shared and static libraries
|
|
||||||
"--libdir=lib"
|
|
||||||
- "--openssldir=etc/ssl"
|
|
||||||
+ (if !static then
|
|
||||||
+ "--openssldir=etc/ssl"
|
|
||||||
+ else
|
|
||||||
+ # Separate the OPENSSLDIR into its own output, as its path will be
|
|
||||||
+ # compiled into 'libcrypto.a'. This makes it a runtime dependency of
|
|
||||||
+ # any package that statically links openssl, so we want to keep that
|
|
||||||
+ # output minimal. We need to prepend '/.' to the path in order to make
|
|
||||||
+ # it appear absolute before variable expansion, the 'prefix' would be
|
|
||||||
+ # prepended to it otherwise.
|
|
||||||
+ "--openssldir=/.$(etc)/etc/ssl"
|
|
||||||
+ )
|
|
||||||
] ++ lib.optionals withCryptodev [
|
|
||||||
"-DHAVE_CRYPTODEV"
|
|
||||||
"-DUSE_CRYPTODEV_DIGESTS"
|
|
||||||
@@ -131,6 +153,9 @@ let
|
|
||||||
if [ -n "$(echo $out/lib/*.so $out/lib/*.dylib $out/lib/*.dll)" ]; then
|
|
||||||
rm "$out/lib/"*.a
|
|
||||||
fi
|
|
||||||
+
|
|
||||||
+ # 'etc' is a separate output on static builds only.
|
|
||||||
+ etc=$out
|
|
||||||
'' + lib.optionalString (!stdenv.hostPlatform.isWindows)
|
|
||||||
# Fix bin/c_rehash's perl interpreter line
|
|
||||||
#
|
|
||||||
@@ -152,14 +177,15 @@ let
|
|
||||||
mv $out/include $dev/
|
|
||||||
|
|
||||||
# remove dependency on Perl at runtime
|
|
||||||
- rm -r $out/etc/ssl/misc
|
|
||||||
+ rm -r $etc/etc/ssl/misc
|
|
||||||
|
|
||||||
- rmdir $out/etc/ssl/{certs,private}
|
|
||||||
+ rmdir $etc/etc/ssl/{certs,private}
|
|
||||||
'';
|
|
||||||
|
|
||||||
postFixup = lib.optionalString (!stdenv.hostPlatform.isWindows) ''
|
|
||||||
- # Check to make sure the main output doesn't depend on perl
|
|
||||||
- if grep -r '${buildPackages.perl}' $out; then
|
|
||||||
+ # Check to make sure the main output and the static runtime dependencies
|
|
||||||
+ # don't depend on perl
|
|
||||||
+ if grep -r '${buildPackages.perl}' $out $etc; then
|
|
||||||
echo "Found an erroneous dependency on perl ^^^" >&2
|
|
||||||
exit 1
|
|
||||||
fi
|
|
||||||
@@ -0,0 +1,12 @@
|
|||||||
|
diff --git a/survey/default.nix b/survey/default.nix
|
||||||
|
index 70afbbc..28cb0e9 100644
|
||||||
|
--- a/survey/default.nix
|
||||||
|
+++ b/survey/default.nix
|
||||||
|
@@ -81,6 +81,7 @@ let
|
||||||
|
# `.override` and the likes).
|
||||||
|
isProperHaskellPackage = val:
|
||||||
|
lib.isDerivation val && # must pass lib.isDerivation
|
||||||
|
+ val.pname != "ghc-bignum" &&
|
||||||
|
val ? env; # must have an .env key
|
||||||
|
|
||||||
|
# Function that tells us if a given Haskell package has an executable.
|
||||||
@@ -0,0 +1,13 @@
|
|||||||
|
diff --git a/survey/default.nix b/survey/default.nix
|
||||||
|
index 46d8066..a47f214 100644
|
||||||
|
--- a/survey/default.nix
|
||||||
|
+++ b/survey/default.nix
|
||||||
|
@@ -1519,7 +1519,7 @@ let
|
||||||
|
[
|
||||||
|
"--enable-executable-static" # requires `useFixedCabal`
|
||||||
|
# `enableShared` seems to be required to avoid `recompile with -fPIC` errors on some packages.
|
||||||
|
- "--extra-lib-dirs=${final.ncurses.override { enableStatic = true; enableShared = true; }}/lib"
|
||||||
|
+ "--extra-lib-dirs=${final.ncurses.override { enableStatic = true; }}/lib"
|
||||||
|
]
|
||||||
|
# TODO Figure out why this and the below libffi are necessary.
|
||||||
|
# `working` and `workingStackageExecutables` don't seem to need that,
|
||||||
@@ -1,5 +1,5 @@
|
|||||||
# Derive a fully static Haskell package based on musl instead of glibc.
|
# Derive a fully static Haskell package based on musl instead of glibc.
|
||||||
{ nixpkgs, compiler, patches, allOverlays }:
|
{ nixpkgs, system, compiler, patches, allOverlays }:
|
||||||
|
|
||||||
name: src:
|
name: src:
|
||||||
let
|
let
|
||||||
@@ -17,14 +17,8 @@ let
|
|||||||
patches.applyPatches "patched-static-haskell-nix"
|
patches.applyPatches "patched-static-haskell-nix"
|
||||||
static-haskell-nix
|
static-haskell-nix
|
||||||
[
|
[
|
||||||
# No patches currently required.
|
patches.static-haskell-nix-ncurses
|
||||||
];
|
patches.static-haskell-nix-ghc-bignum
|
||||||
|
|
||||||
patchedNixpkgs =
|
|
||||||
patches.applyPatches "patched-nixpkgs"
|
|
||||||
nixpkgs
|
|
||||||
[
|
|
||||||
patches.nixpkgs-openssl-split-runtime-dependencies-of-static-builds
|
|
||||||
];
|
];
|
||||||
|
|
||||||
extraOverrides =
|
extraOverrides =
|
||||||
@@ -39,16 +33,29 @@ let
|
|||||||
|
|
||||||
overlays =
|
overlays =
|
||||||
[
|
[
|
||||||
|
allOverlays.postgresql-future
|
||||||
|
allOverlays.postgresql-default
|
||||||
(allOverlays.haskell-packages { inherit compiler extraOverrides; })
|
(allOverlays.haskell-packages { inherit compiler extraOverrides; })
|
||||||
|
# Disable failing tests for postgresql on musl that should have no impact
|
||||||
|
# on the libpq that we need (collate.icu.utf8 and foreign regression
|
||||||
|
# tests)
|
||||||
|
(self: super:
|
||||||
|
{ postgresql = super.postgresql.overrideAttrs (_: { doCheck = false; }); }
|
||||||
|
)
|
||||||
];
|
];
|
||||||
|
|
||||||
# Apply our overlay to the given pkgs.
|
# Apply our overlay to nixpkgs.
|
||||||
normalPkgs =
|
normalPkgs =
|
||||||
import patchedNixpkgs { inherit overlays; };
|
import nixpkgs { inherit overlays system; };
|
||||||
|
|
||||||
|
defaultCabalPackageVersionComingWithGhc =
|
||||||
|
{
|
||||||
|
ghc924 = "Cabal_3_6_3_0";
|
||||||
|
}."${compiler}";
|
||||||
|
|
||||||
# The static-haskell-nix 'survey' derives a full static set of Haskell
|
# The static-haskell-nix 'survey' derives a full static set of Haskell
|
||||||
# packages, applying fixes where necessary.
|
# packages, applying fixes where necessary.
|
||||||
survey =
|
survey =
|
||||||
import "${patched-static-haskell-nix}/survey" { inherit normalPkgs compiler; };
|
import "${patched-static-haskell-nix}/survey" { inherit normalPkgs compiler defaultCabalPackageVersionComingWithGhc; };
|
||||||
in
|
in
|
||||||
survey.haskellPackages."${name}"
|
survey.haskellPackages."${name}"
|
||||||
|
|||||||
@@ -28,6 +28,8 @@ let
|
|||||||
''
|
''
|
||||||
# clean old coverage data, too
|
# clean old coverage data, too
|
||||||
rm -rf .hpc coverage
|
rm -rf .hpc coverage
|
||||||
|
# clean old hie files
|
||||||
|
find . -name "*.hie" -type f -delete
|
||||||
exec ${cabal-install}/bin/cabal v2-clean
|
exec ${cabal-install}/bin/cabal v2-clean
|
||||||
'';
|
'';
|
||||||
|
|
||||||
|
|||||||
+162
-6
@@ -4,12 +4,16 @@
|
|||||||
, checkedShellScript
|
, checkedShellScript
|
||||||
, devCabalOptions
|
, devCabalOptions
|
||||||
, entr
|
, entr
|
||||||
|
, git
|
||||||
|
, gnugrep
|
||||||
, graphviz
|
, graphviz
|
||||||
|
, haskellPackages
|
||||||
, hsie
|
, hsie
|
||||||
, nix
|
, nix
|
||||||
, silver-searcher
|
, silver-searcher
|
||||||
, style
|
, style
|
||||||
, tests
|
, tests
|
||||||
|
, withTools
|
||||||
}:
|
}:
|
||||||
let
|
let
|
||||||
watch =
|
watch =
|
||||||
@@ -28,7 +32,7 @@ let
|
|||||||
"ARG_POSITIONAL_SINGLE([command], [Command to run])"
|
"ARG_POSITIONAL_SINGLE([command], [Command to run])"
|
||||||
"ARG_LEFTOVERS([command arguments])"
|
"ARG_LEFTOVERS([command arguments])"
|
||||||
];
|
];
|
||||||
addCommandCompletion = true;
|
positionalCompletion = "_command";
|
||||||
redirectTixFiles = false; # will be done by sub-command
|
redirectTixFiles = false; # will be done by sub-command
|
||||||
inRootDir = true;
|
inRootDir = true;
|
||||||
}
|
}
|
||||||
@@ -63,21 +67,172 @@ let
|
|||||||
name = "postgrest-check";
|
name = "postgrest-check";
|
||||||
docs =
|
docs =
|
||||||
''
|
''
|
||||||
Run most checks that will also run on CI.
|
Run most checks that will also run on CI, but only against the
|
||||||
|
latest PostgreSQL version.
|
||||||
|
|
||||||
This currently excludes the memory tests, as those are particularly
|
This currently excludes the memory and spec-idempotence tests,
|
||||||
expensive.
|
as those are particularly expensive.
|
||||||
'';
|
'';
|
||||||
inRootDir = true;
|
inRootDir = true;
|
||||||
}
|
}
|
||||||
''
|
''
|
||||||
${tests}/bin/postgrest-with-all ${tests}/bin/postgrest-test-spec
|
${tests}/bin/postgrest-test-spec
|
||||||
${tests}/bin/postgrest-test-spec-idempotence
|
${tests}/bin/postgrest-test-querycost
|
||||||
|
${tests}/bin/postgrest-test-doctests
|
||||||
${tests}/bin/postgrest-test-io
|
${tests}/bin/postgrest-test-io
|
||||||
${style}/bin/postgrest-lint
|
${style}/bin/postgrest-lint
|
||||||
${style}/bin/postgrest-style-check
|
${style}/bin/postgrest-style-check
|
||||||
'';
|
'';
|
||||||
|
|
||||||
|
gitHooks =
|
||||||
|
let
|
||||||
|
name = "postgrest-git-hooks";
|
||||||
|
in
|
||||||
|
checkedShellScript
|
||||||
|
{
|
||||||
|
inherit name;
|
||||||
|
docs =
|
||||||
|
''
|
||||||
|
Enable or disable git pre-commit and pre-push hooks.
|
||||||
|
|
||||||
|
Basic is faster and will only run:
|
||||||
|
- pre-commit: postgrest-style
|
||||||
|
- pre-push: postgrest-lint
|
||||||
|
|
||||||
|
Full takes a lot more time and will run:
|
||||||
|
- pre-commit: postgrest-style && postgrest-lint
|
||||||
|
- pre-push: postgrest-check
|
||||||
|
|
||||||
|
Changes made by postgrest-style will be staged automatically.
|
||||||
|
|
||||||
|
Example usage:
|
||||||
|
postgrest-git-hooks disable
|
||||||
|
postgrest-git-hooks enable basic
|
||||||
|
postgrest-git-hooks enable full
|
||||||
|
|
||||||
|
The "run" operation and "--hook" argument are only used internally.
|
||||||
|
'';
|
||||||
|
args =
|
||||||
|
[
|
||||||
|
"ARG_POSITIONAL_SINGLE([operation], [Operation])"
|
||||||
|
"ARG_TYPE_GROUP_SET([OPERATION], [OPERATION], [operation], [disable,enable,run])"
|
||||||
|
"ARG_POSITIONAL_SINGLE([mode], [Mode], [basic])"
|
||||||
|
"ARG_TYPE_GROUP_SET([MODE], [MODE], [mode], [basic,full])"
|
||||||
|
"ARG_OPTIONAL_SINGLE([hook], , [Hook], [pre-commit])"
|
||||||
|
"ARG_TYPE_GROUP_SET([HOOK], [HOOK], [hook], [pre-commit,pre-push])"
|
||||||
|
];
|
||||||
|
positionalCompletion =
|
||||||
|
''
|
||||||
|
if test "$prev" == "${name}"; then
|
||||||
|
COMPREPLY=( $(compgen -W "enable disable" -- "$cur") )
|
||||||
|
elif test "$prev" == "enable" || test "$prev" == "disable"; then
|
||||||
|
COMPREPLY=( $(compgen -W "basic full" -- "$cur") )
|
||||||
|
fi
|
||||||
|
'';
|
||||||
|
inRootDir = true;
|
||||||
|
}
|
||||||
|
''
|
||||||
|
if [ run != "$_arg_operation" ]; then
|
||||||
|
# Remove all hooks first and ignore failures because the file might be missing.
|
||||||
|
# This assumes that we're only adding lines that include "postgrest-git-hooks"
|
||||||
|
# to the hook file.
|
||||||
|
sed -i -e '/postgrest-git-hooks/d' .git/hooks/pre-{commit,push} 2> /dev/null || true
|
||||||
|
|
||||||
|
if [ disable != "$_arg_operation" ]; then
|
||||||
|
# The nix-shell && + nix-shell || pattern makes sure we can run the hook
|
||||||
|
# in a pure nix-shell, where nix-shell itself is not available, too.
|
||||||
|
|
||||||
|
# The $(nix-shell --run "command -v ...") pattern ensures we only need to enable
|
||||||
|
# the hooks once and still run the latest of our hook scripts, even when we
|
||||||
|
# update them in the repo.
|
||||||
|
|
||||||
|
echo 'command -v nix-shell > /dev/null || postgrest-git-hooks --hook=pre-commit run' "$_arg_mode" \
|
||||||
|
>> .git/hooks/pre-commit
|
||||||
|
# shellcheck disable=SC2016
|
||||||
|
echo 'command -v nix-shell > /dev/null && $(nix-shell --quiet -Q --run "command -v postgrest-git-hooks") --hook=pre-commit run' "$_arg_mode" \
|
||||||
|
>> .git/hooks/pre-commit
|
||||||
|
chmod +x .git/hooks/pre-commit
|
||||||
|
|
||||||
|
echo 'command -v nix-shell > /dev/null || postgrest-git-hooks --hook=pre-push run' "$_arg_mode" \
|
||||||
|
>> .git/hooks/pre-push
|
||||||
|
# shellcheck disable=SC2016
|
||||||
|
echo 'command -v nix-shell > /dev/null && $(nix-shell --quiet -Q --run "command -v postgrest-git-hooks") --hook=pre-push run' "$_arg_mode" \
|
||||||
|
>> .git/hooks/pre-push
|
||||||
|
chmod +x .git/hooks/pre-push
|
||||||
|
fi
|
||||||
|
else
|
||||||
|
# When run from a git hook, the GIT_ environment variables conflict with our withGit helper.
|
||||||
|
# The following unsets all GIT_ variables.
|
||||||
|
unset "''${!GIT_@}"
|
||||||
|
|
||||||
|
function restore () {
|
||||||
|
ref="$(git stash list --format=format:%gD --grep "$1" -n1)"
|
||||||
|
# this will avoid merge conflicts when applying the stash
|
||||||
|
${git}/bin/git restore --source="$ref" .
|
||||||
|
# restore untracked files, too. could fail with no files
|
||||||
|
if [ "$(git show --numstat --format=oneline "$ref^3" | wc -l)" -gt 1 ]; then
|
||||||
|
${git}/bin/git restore --overlay --source="$ref^3" .
|
||||||
|
fi
|
||||||
|
${git}/bin/git stash drop "$ref"
|
||||||
|
}
|
||||||
|
|
||||||
|
case "$_arg_mode" in
|
||||||
|
basic)
|
||||||
|
case "$_arg_hook" in
|
||||||
|
pre-commit)
|
||||||
|
# To be able to automatically add only changes from postgrest-style to the staging area,
|
||||||
|
# we need to run postgrest-style twice. Otherwise we'd risk merge conflicts when popping
|
||||||
|
# the stash afterwards.
|
||||||
|
${style}/bin/postgrest-style
|
||||||
|
|
||||||
|
stash="postgrest-git-hooks-$RANDOM"
|
||||||
|
${git}/bin/git stash push --include-untracked --keep-index -m "$stash"
|
||||||
|
if [ "$(git stash list --grep $stash)" ]; then
|
||||||
|
# Only create the stash pop trap, if we actually created a stash.
|
||||||
|
# Otherwise stash pop will cause havoc.
|
||||||
|
trap 'restore "$stash"' EXIT
|
||||||
|
fi
|
||||||
|
|
||||||
|
${style}/bin/postgrest-style
|
||||||
|
${git}/bin/git add .
|
||||||
|
;;
|
||||||
|
pre-push)
|
||||||
|
# Create a clean working tree without any uncomitted changes.
|
||||||
|
${withTools.withGit} HEAD ${style}/bin/postgrest-lint
|
||||||
|
;;
|
||||||
|
esac
|
||||||
|
;;
|
||||||
|
full)
|
||||||
|
case "$_arg_hook" in
|
||||||
|
pre-commit)
|
||||||
|
# To be able to automatically add only changes from postgrest-style to the staging area,
|
||||||
|
# we need to run postgrest-style twice. Otherwise we'd risk merge conflicts when popping
|
||||||
|
# the stash afterwards.
|
||||||
|
${style}/bin/postgrest-style
|
||||||
|
|
||||||
|
stash="postgrest-git-hooks-$RANDOM"
|
||||||
|
${git}/bin/git stash push --include-untracked --keep-index -m "$stash"
|
||||||
|
if [ "$(git stash list --grep $stash)" ]; then
|
||||||
|
# Only create the stash pop trap, if we actually created a stash.
|
||||||
|
# Otherwise stash pop will cause havoc.
|
||||||
|
trap 'restore "$stash"' EXIT
|
||||||
|
fi
|
||||||
|
|
||||||
|
${style}/bin/postgrest-style
|
||||||
|
${git}/bin/git add .
|
||||||
|
|
||||||
|
${style}/bin/postgrest-lint
|
||||||
|
;;
|
||||||
|
pre-push)
|
||||||
|
# Create a clean working tree without any uncomitted changes.
|
||||||
|
${withTools.withGit} HEAD ${check}
|
||||||
|
;;
|
||||||
|
esac
|
||||||
|
;;
|
||||||
|
esac
|
||||||
|
fi
|
||||||
|
'';
|
||||||
|
|
||||||
dumpMinimalImports =
|
dumpMinimalImports =
|
||||||
checkedShellScript
|
checkedShellScript
|
||||||
{
|
{
|
||||||
@@ -143,6 +298,7 @@ buildToolbox
|
|||||||
watch
|
watch
|
||||||
pushCachix
|
pushCachix
|
||||||
check
|
check
|
||||||
|
gitHooks
|
||||||
dumpMinimalImports
|
dumpMinimalImports
|
||||||
hsieMinimalImports
|
hsieMinimalImports
|
||||||
hsieGraphModules
|
hsieGraphModules
|
||||||
|
|||||||
@@ -0,0 +1,178 @@
|
|||||||
|
{ buildToolbox
|
||||||
|
, checkedShellScript
|
||||||
|
, jq
|
||||||
|
, python3Packages
|
||||||
|
, vegeta
|
||||||
|
, withTools
|
||||||
|
, writers
|
||||||
|
}:
|
||||||
|
let
|
||||||
|
runner =
|
||||||
|
checkedShellScript
|
||||||
|
{
|
||||||
|
name = "postgrest-loadtest-runner";
|
||||||
|
docs = "Run vegeta. Assume PostgREST to be running.";
|
||||||
|
args = [
|
||||||
|
"ARG_LEFTOVERS([additional vegeta arguments])"
|
||||||
|
"ARG_USE_ENV([PGRST_SERVER_UNIX_SOCKET], [], [Unix socket to connect to running PostgREST instance])"
|
||||||
|
];
|
||||||
|
}
|
||||||
|
''
|
||||||
|
# ARG_USE_ENV only adds defaults or docs for environment variables
|
||||||
|
# We manually implement a required check here
|
||||||
|
# See also: https://github.com/matejak/argbash/issues/80
|
||||||
|
: "''${PGRST_SERVER_UNIX_SOCKET:?PGRST_SERVER_UNIX_SOCKET is required}"
|
||||||
|
|
||||||
|
${vegeta}/bin/vegeta -cpus 1 attack \
|
||||||
|
-unix-socket "$PGRST_SERVER_UNIX_SOCKET" \
|
||||||
|
-max-workers 1 \
|
||||||
|
-workers 1 \
|
||||||
|
-rate 0 \
|
||||||
|
-duration 60s \
|
||||||
|
"''${_arg_leftovers[@]}"
|
||||||
|
'';
|
||||||
|
|
||||||
|
loadtest =
|
||||||
|
checkedShellScript
|
||||||
|
{
|
||||||
|
name = "postgrest-loadtest";
|
||||||
|
docs = "Run the vegeta loadtests with PostgREST.";
|
||||||
|
args = [
|
||||||
|
"ARG_OPTIONAL_SINGLE([output], [o], [Filename to dump json output to], [./loadtest/result.bin])"
|
||||||
|
"ARG_OPTIONAL_SINGLE([testdir], [t], [Directory to load tests and fixtures from], [./test/load])"
|
||||||
|
"ARG_LEFTOVERS([additional vegeta arguments])"
|
||||||
|
];
|
||||||
|
inRootDir = true;
|
||||||
|
}
|
||||||
|
''
|
||||||
|
# previously required settings to make this work with older branches
|
||||||
|
export PGRST_DB_ANON_ROLE="postgrest_test_anonymous"
|
||||||
|
export PGRST_DB_URI="postgresql://"
|
||||||
|
export PGRST_DB_SCHEMAS="test"
|
||||||
|
|
||||||
|
export PGRST_DB_CONFIG="false"
|
||||||
|
export PGRST_DB_POOL="1"
|
||||||
|
export PGRST_DB_TX_END="rollback-allow-override"
|
||||||
|
export PGRST_LOG_LEVEL="crit"
|
||||||
|
|
||||||
|
mkdir -p "$(dirname "$_arg_output")"
|
||||||
|
|
||||||
|
# shellcheck disable=SC2145
|
||||||
|
${withTools.withPg} --fixtures "$_arg_testdir"/fixtures.sql \
|
||||||
|
${withTools.withPgrst} \
|
||||||
|
sh -c "cd \"$_arg_testdir\" && ${runner} -targets targets.http -output \"$_arg_output\" \"''${_arg_leftovers[@]}\""
|
||||||
|
${vegeta}/bin/vegeta report -type=text "$_arg_output"
|
||||||
|
'';
|
||||||
|
|
||||||
|
loadtestAgainst =
|
||||||
|
let
|
||||||
|
name = "postgrest-loadtest-against";
|
||||||
|
in
|
||||||
|
checkedShellScript
|
||||||
|
{
|
||||||
|
inherit name;
|
||||||
|
docs =
|
||||||
|
''
|
||||||
|
Run the vegeta loadtest twice:
|
||||||
|
- once on the <target> branch
|
||||||
|
- once in the current worktree
|
||||||
|
'';
|
||||||
|
args = [
|
||||||
|
"ARG_POSITIONAL_SINGLE([target], [Commit-ish reference to compare with])"
|
||||||
|
"ARG_LEFTOVERS([additional vegeta arguments])"
|
||||||
|
];
|
||||||
|
positionalCompletion =
|
||||||
|
''
|
||||||
|
if test "$prev" == "${name}"; then
|
||||||
|
__gitcomp_nl "$(__git_refs)"
|
||||||
|
fi
|
||||||
|
'';
|
||||||
|
inRootDir = true;
|
||||||
|
}
|
||||||
|
''
|
||||||
|
cat << EOF
|
||||||
|
|
||||||
|
Running loadtest on "$_arg_target"...
|
||||||
|
|
||||||
|
EOF
|
||||||
|
|
||||||
|
# Runs the test files from the current working tree
|
||||||
|
# to make sure both tests are run with the same files.
|
||||||
|
# Save the results in the current working tree, too,
|
||||||
|
# otherwise they'd be lost in the temporary working tree
|
||||||
|
# created by withTools.withGit.
|
||||||
|
${withTools.withGit} "$_arg_target" ${loadtest} --output "$PWD/loadtest/$_arg_target.bin" --testdir "$PWD/test/load" "''${_arg_leftovers[@]}"
|
||||||
|
|
||||||
|
cat << EOF
|
||||||
|
|
||||||
|
Done running on "$_arg_target".
|
||||||
|
|
||||||
|
EOF
|
||||||
|
|
||||||
|
cat << EOF
|
||||||
|
|
||||||
|
Running loadtest on HEAD...
|
||||||
|
|
||||||
|
EOF
|
||||||
|
|
||||||
|
${loadtest} --output "$PWD/loadtest/head.bin" --testdir "$PWD/test/load" "''${_arg_leftovers[@]}"
|
||||||
|
|
||||||
|
cat << EOF
|
||||||
|
|
||||||
|
Done running on HEAD.
|
||||||
|
|
||||||
|
EOF
|
||||||
|
'';
|
||||||
|
|
||||||
|
reporter =
|
||||||
|
checkedShellScript
|
||||||
|
{
|
||||||
|
name = "postgrest-loadtest-reporter";
|
||||||
|
docs = "Create a named json report for a single result file.";
|
||||||
|
args = [
|
||||||
|
"ARG_POSITIONAL_SINGLE([file], [Filename of result to create report for])"
|
||||||
|
"ARG_LEFTOVERS([additional vegeta arguments])"
|
||||||
|
];
|
||||||
|
inRootDir = true;
|
||||||
|
}
|
||||||
|
''
|
||||||
|
${vegeta}/bin/vegeta report -type=json "$_arg_file" \
|
||||||
|
| ${jq}/bin/jq --arg branch "$(basename "$_arg_file" .bin)" '. + {branch: $branch}'
|
||||||
|
'';
|
||||||
|
|
||||||
|
toMarkdown =
|
||||||
|
writers.writePython3 "postgrest-loadtest-to-markdown"
|
||||||
|
{
|
||||||
|
libraries = [ python3Packages.pandas python3Packages.tabulate ];
|
||||||
|
}
|
||||||
|
''
|
||||||
|
import sys
|
||||||
|
import pandas as pd
|
||||||
|
|
||||||
|
pd.read_json(sys.stdin) \
|
||||||
|
.set_index('param') \
|
||||||
|
.drop(['branch', 'earliest', 'end', 'latest']) \
|
||||||
|
.convert_dtypes() \
|
||||||
|
.to_markdown(sys.stdout, floatfmt='.0f')
|
||||||
|
'';
|
||||||
|
|
||||||
|
|
||||||
|
report =
|
||||||
|
checkedShellScript
|
||||||
|
{
|
||||||
|
name = "postgrest-loadtest-report";
|
||||||
|
docs = "Create a report of all loadtest reports as markdown.";
|
||||||
|
inRootDir = true;
|
||||||
|
}
|
||||||
|
''
|
||||||
|
find loadtest -type f -iname '*.bin' -exec ${reporter} {} \; \
|
||||||
|
| ${jq}/bin/jq '[leaf_paths as $path | {param: $path | join("."), (.branch): getpath($path)}]' \
|
||||||
|
| ${jq}/bin/jq --slurp 'flatten | group_by(.param) | map(add)' \
|
||||||
|
| ${toMarkdown}
|
||||||
|
'';
|
||||||
|
|
||||||
|
in
|
||||||
|
buildToolbox {
|
||||||
|
name = "postgrest-loadtest";
|
||||||
|
tools = [ loadtest loadtestAgainst report ];
|
||||||
|
}
|
||||||
@@ -14,11 +14,10 @@ let
|
|||||||
name = "postgrest-test-memory";
|
name = "postgrest-test-memory";
|
||||||
docs = "Run the memory tests.";
|
docs = "Run the memory tests.";
|
||||||
inRootDir = true;
|
inRootDir = true;
|
||||||
|
withPath = [ postgrestProfiled curl ];
|
||||||
}
|
}
|
||||||
''
|
''
|
||||||
export PATH="${postgrestProfiled}/bin:${curl}/bin:$PATH"
|
${withTools.withPg} test/memory/memory-tests.sh
|
||||||
|
|
||||||
${withTools.latest} test/memory-tests.sh
|
|
||||||
'';
|
'';
|
||||||
|
|
||||||
in
|
in
|
||||||
|
|||||||
@@ -14,13 +14,13 @@ let
|
|||||||
"postgrest-nixpkgs-upgrade";
|
"postgrest-nixpkgs-upgrade";
|
||||||
|
|
||||||
refUrl =
|
refUrl =
|
||||||
https://api.github.com/repos/nixos/nixpkgs/git/ref/heads/nixpkgs-unstable;
|
"https://api.github.com/repos/nixos/nixpkgs/git/ref/heads/nixpkgs-unstable";
|
||||||
|
|
||||||
githubV3Header =
|
githubV3Header =
|
||||||
"Accept: application/vnd.github.v3+json";
|
"Accept: application/vnd.github.v3+json";
|
||||||
|
|
||||||
tarballUrlBase =
|
tarballUrlBase =
|
||||||
https://github.com/nixos/nixpkgs/archive/;
|
"https://github.com/nixos/nixpkgs/archive/";
|
||||||
|
|
||||||
upgrade =
|
upgrade =
|
||||||
checkedShellScript
|
checkedShellScript
|
||||||
|
|||||||
+84
-131
@@ -1,124 +1,9 @@
|
|||||||
{ buildToolbox
|
{ buildToolbox
|
||||||
, checkedShellScript
|
, checkedShellScript
|
||||||
, curl
|
, curl
|
||||||
, docker
|
|
||||||
, envsubst
|
|
||||||
, ghr
|
|
||||||
, git
|
|
||||||
, jq
|
, jq
|
||||||
, postgrest
|
|
||||||
, runCommand
|
|
||||||
}:
|
}:
|
||||||
let
|
let
|
||||||
github =
|
|
||||||
checkedShellScript
|
|
||||||
{
|
|
||||||
name = "postgrest-release-github";
|
|
||||||
docs = "Push a new release to GitHub.";
|
|
||||||
args = [
|
|
||||||
"ARG_POSITIONAL_SINGLE([version], [git version tag to make release for])"
|
|
||||||
"ARG_USE_ENV([GITHUB_TOKEN], [], [GitHub token])"
|
|
||||||
"ARG_USE_ENV([GITHUB_USERNAME], [], [GitHub user name])"
|
|
||||||
"ARG_USE_ENV([GITHUB_REPONAME], [], [GitHub repository name])"
|
|
||||||
];
|
|
||||||
inRootDir = true;
|
|
||||||
}
|
|
||||||
''
|
|
||||||
# ARG_USE_ENV only adds defaults or docs for environment variables
|
|
||||||
# We manually implement a required check here
|
|
||||||
# See also: https://github.com/matejak/argbash/issues/80
|
|
||||||
GITHUB_TOKEN="''${GITHUB_TOKEN:?GITHUB_TOKEN is required}"
|
|
||||||
GITHUB_USERNAME="''${GITHUB_USERNAME:?GITHUB_USERNAME is required}"
|
|
||||||
GITHUB_REPONAME="''${GITHUB_REPONAME:?GITHUB_REPONAME is required}"
|
|
||||||
|
|
||||||
if test "$_arg_version" = "nightly"
|
|
||||||
then
|
|
||||||
suffix=$(${git}/bin/git show -s --format="%cd-%h" --date="format:%Y-%m-%d-%H-%M")
|
|
||||||
tar cvJf "postgrest-nightly-$suffix-linux-x64-static.tar.xz" \
|
|
||||||
-C ${postgrest}/bin postgrest
|
|
||||||
|
|
||||||
${ghr}/bin/ghr \
|
|
||||||
-t "$GITHUB_TOKEN" \
|
|
||||||
-u "$GITHUB_USERNAME" \
|
|
||||||
-r "$GITHUB_REPONAME" \
|
|
||||||
--replace nightly \
|
|
||||||
"postgrest-nightly-$suffix-linux-x64-static.tar.xz"
|
|
||||||
else
|
|
||||||
changes="$(sed -n "1,/$_arg_version/d;/## \[/q;p" ${../../../CHANGELOG.md})"
|
|
||||||
|
|
||||||
tar cvJf "postgrest-$_arg_version-linux-x64-static.tar.xz" \
|
|
||||||
-C ${postgrest}/bin postgrest
|
|
||||||
|
|
||||||
${ghr}/bin/ghr \
|
|
||||||
-t "$GITHUB_TOKEN" \
|
|
||||||
-u "$GITHUB_USERNAME" \
|
|
||||||
-r "$GITHUB_REPONAME" \
|
|
||||||
-b "$changes" \
|
|
||||||
--replace "$_arg_version" \
|
|
||||||
"postgrest-$_arg_version-linux-x64-static.tar.xz"
|
|
||||||
fi
|
|
||||||
'';
|
|
||||||
|
|
||||||
dockerLogin =
|
|
||||||
checkedShellScript
|
|
||||||
{
|
|
||||||
name = "postgrest-release-docker-login";
|
|
||||||
docs =
|
|
||||||
''
|
|
||||||
Log in to Docker Hub using the DOCKER_USER and DOCKER_PASS env vars.
|
|
||||||
|
|
||||||
Those env vars are usually provided by CircleCI. The DOCKER_USER is
|
|
||||||
not the same as DOCKER_REPO because we use the
|
|
||||||
https://hub.docker.com/u/postgrestbot account for uploading to dockerhub.
|
|
||||||
'';
|
|
||||||
args = [
|
|
||||||
"ARG_USE_ENV([DOCKER_USER], [], [DockerHub user name])"
|
|
||||||
"ARG_USE_ENV([DOCKER_PASS], [], [DockerHub password])"
|
|
||||||
];
|
|
||||||
}
|
|
||||||
''
|
|
||||||
# ARG_USE_ENV only adds defaults or docs for environment variables
|
|
||||||
# We manually implement a required check here
|
|
||||||
# See also: https://github.com/matejak/argbash/issues/80
|
|
||||||
DOCKER_USER="''${DOCKER_USER:?DOCKER_USER is required}"
|
|
||||||
DOCKER_PASS="''${DOCKER_PASS:?DOCKER_PASS is required}"
|
|
||||||
|
|
||||||
docker login -u "$DOCKER_USER" -p "$DOCKER_PASS"
|
|
||||||
'';
|
|
||||||
|
|
||||||
dockerHub =
|
|
||||||
checkedShellScript
|
|
||||||
{
|
|
||||||
name = "postgrest-release-dockerhub";
|
|
||||||
docs = "Push a new release to Docker Hub";
|
|
||||||
args = [
|
|
||||||
"ARG_POSITIONAL_SINGLE([version], [git version tag to tag image with])"
|
|
||||||
"ARG_USE_ENV([DOCKER_REPO], [], [DockerHub repository])"
|
|
||||||
];
|
|
||||||
}
|
|
||||||
''
|
|
||||||
# ARG_USE_ENV only adds defaults or docs for environment variables
|
|
||||||
# We manually implement a required check here
|
|
||||||
# See also: https://github.com/matejak/argbash/issues/80
|
|
||||||
DOCKER_REPO="''${DOCKER_REPO:?DOCKER_REPO is required}"
|
|
||||||
|
|
||||||
docker load -i ${docker.image}
|
|
||||||
|
|
||||||
if test "$_arg_version" = "nightly"
|
|
||||||
then
|
|
||||||
suffix=$(${git}/bin/git show -s --format="%cd-%h" --date="format:%Y-%m-%d-%H-%M")
|
|
||||||
|
|
||||||
docker tag postgrest:latest "$DOCKER_REPO/postgrest:nightly-$suffix"
|
|
||||||
docker push "$DOCKER_REPO/postgrest:nightly-$suffix"
|
|
||||||
else
|
|
||||||
docker tag postgrest:latest "$DOCKER_REPO"/postgrest:latest
|
|
||||||
docker tag postgrest:latest "$DOCKER_REPO/postgrest:$_arg_version"
|
|
||||||
|
|
||||||
docker push "$DOCKER_REPO"/postgrest:latest
|
|
||||||
docker push "$DOCKER_REPO/postgrest:$_arg_version"
|
|
||||||
fi
|
|
||||||
'';
|
|
||||||
|
|
||||||
dockerHubDescription =
|
dockerHubDescription =
|
||||||
let
|
let
|
||||||
description =
|
description =
|
||||||
@@ -141,34 +26,102 @@ let
|
|||||||
# ARG_USE_ENV only adds defaults or docs for environment variables
|
# ARG_USE_ENV only adds defaults or docs for environment variables
|
||||||
# We manually implement a required check here
|
# We manually implement a required check here
|
||||||
# See also: https://github.com/matejak/argbash/issues/80
|
# See also: https://github.com/matejak/argbash/issues/80
|
||||||
DOCKER_USER="''${DOCKER_USER:?DOCKER_USER is required}"
|
: "''${DOCKER_USER:?DOCKER_USER is required}"
|
||||||
DOCKER_PASS="''${DOCKER_PASS:?DOCKER_PASS is required}"
|
: "''${DOCKER_PASS:?DOCKER_PASS is required}"
|
||||||
DOCKER_REPO="''${DOCKER_REPO:?DOCKER_REPO is required}"
|
: "''${DOCKER_REPO:?DOCKER_REPO is required}"
|
||||||
|
|
||||||
# Login to Docker Hub and get a token.
|
echo "Logging in to Docker Hub to get an auth token..."
|
||||||
token="$(
|
token="$(
|
||||||
${curl}/bin/curl -s \
|
${curl}/bin/curl --fail -s \
|
||||||
--data-urlencode "username=$DOCKER_USER" \
|
--data-urlencode "username=$DOCKER_USER" \
|
||||||
--data-urlencode "password=$DOCKER_PASS" \
|
--data-urlencode "password=$DOCKER_PASS" \
|
||||||
"https://hub.docker.com/v2/users/login/" \
|
"https://hub.docker.com/v2/users/login/" \
|
||||||
| ${jq}/bin/jq -r .token
|
| ${jq}/bin/jq -r .token
|
||||||
)"
|
)"
|
||||||
|
|
||||||
# Patch both descriptions.
|
repo_url="https://hub.docker.com/v2/repositories/$DOCKER_REPO/postgrest/"
|
||||||
responseCode="$(
|
echo "Patching both descriptions at $repo_url ..."
|
||||||
${curl}/bin/curl -s --write-out "%{response_code}" \
|
${curl}/bin/curl --fail -X PATCH "$repo_url" \
|
||||||
--output /dev/null -H "Authorization: JWT $token" -X PATCH \
|
-H "Authorization: JWT $token" \
|
||||||
--data-urlencode description@${description} \
|
--data-urlencode description@${description} \
|
||||||
--data-urlencode full_description@${fullDescription} \
|
--data-urlencode full_description@${fullDescription}
|
||||||
"https://hub.docker.com/v2/repositories/$DOCKER_REPO/postgrest/"
|
'';
|
||||||
)"
|
|
||||||
|
|
||||||
[ "$responseCode" -eq 200 ]
|
release =
|
||||||
|
checkedShellScript
|
||||||
|
{
|
||||||
|
name = "postgrest-release";
|
||||||
|
docs = "Patch postgrest.cabal, tag and push all in one go.";
|
||||||
|
args = [ "ARG_POSITIONAL_SINGLE([version], [Version to release], [pre])" ];
|
||||||
|
inRootDir = true;
|
||||||
|
}
|
||||||
|
''
|
||||||
|
trap "echo You need to be on the main branch to proceed. Exiting ..." ERR
|
||||||
|
[ "$(git rev-parse --abbrev-ref HEAD)" == "main" ]
|
||||||
|
trap "" ERR
|
||||||
|
|
||||||
|
trap "echo You have uncommitted changes in postgrest.cabal. Exiting ..." ERR
|
||||||
|
git diff --exit-code HEAD postgrest.cabal > /dev/null
|
||||||
|
trap "" ERR
|
||||||
|
|
||||||
|
current_version="$(grep -oP '^version:\s*\K.*' postgrest.cabal)"
|
||||||
|
# shellcheck disable=SC2034
|
||||||
|
IFS=. read -r major minor patch pre <<< "$current_version"
|
||||||
|
echo "Current version is $current_version"
|
||||||
|
|
||||||
|
bump_pre="$major.$minor.$patch.$(date '+%Y%m%d')"
|
||||||
|
bump_patch="$major.$minor.$((patch+1))"
|
||||||
|
bump_minor="$major.$((minor+1)).0"
|
||||||
|
bump_major="$((major+1)).0.0"
|
||||||
|
|
||||||
|
PS3="Please select the new version: "
|
||||||
|
select new_version in "$bump_pre" "$bump_patch" "$bump_minor" "$bump_major"; do
|
||||||
|
case "$REPLY" in
|
||||||
|
1|2|3|4)
|
||||||
|
echo "Selected $new_version"
|
||||||
|
break
|
||||||
|
;;
|
||||||
|
*)
|
||||||
|
echo "Invalid option $REPLY"
|
||||||
|
;;
|
||||||
|
esac
|
||||||
|
done
|
||||||
|
|
||||||
|
echo "Updating postgrest.cabal ..."
|
||||||
|
sed -i -E "s/^(version:\s+).*$/\1$new_version/" postgrest.cabal > /dev/null
|
||||||
|
|
||||||
|
echo "Committing ..."
|
||||||
|
git add postgrest.cabal > /dev/null
|
||||||
|
git commit -m "bump version to $new_version" > /dev/null
|
||||||
|
|
||||||
|
echo "Tagging ..."
|
||||||
|
git tag "v$new_version" > /dev/null
|
||||||
|
|
||||||
|
trap "Couldn't find remote. Please push manually ..." ERR
|
||||||
|
remote="$(git remote -v | grep PostgREST/postgrest | grep push | cut -f1)"
|
||||||
|
trap "" ERR
|
||||||
|
|
||||||
|
push="git push --atomic $remote main v$new_version"
|
||||||
|
|
||||||
|
echo "To push both the branch and the new tag, the following will be run:"
|
||||||
|
echo
|
||||||
|
echo "$push"
|
||||||
|
echo
|
||||||
|
|
||||||
|
read -r -p 'Proceed? (y/N) ' REPLY
|
||||||
|
case "$REPLY" in
|
||||||
|
y|Y)
|
||||||
|
$push
|
||||||
|
;;
|
||||||
|
*)
|
||||||
|
echo "Aborting ..."
|
||||||
|
;;
|
||||||
|
esac
|
||||||
'';
|
'';
|
||||||
|
|
||||||
in
|
in
|
||||||
buildToolbox
|
buildToolbox
|
||||||
{
|
{
|
||||||
name = "postgrest-release";
|
name = "postgrest-release";
|
||||||
tools = [ github dockerLogin dockerHub dockerHubDescription ];
|
tools = [ dockerHubDescription release ];
|
||||||
}
|
}
|
||||||
|
|||||||
@@ -4,7 +4,7 @@
|
|||||||
[](https://www.patreon.com/postgrest)
|
[](https://www.patreon.com/postgrest)
|
||||||
[](https://www.paypal.me/postgrest)
|
[](https://www.paypal.me/postgrest)
|
||||||
[](http://postgrest.org)
|
[](http://postgrest.org)
|
||||||
[](https://circleci.com/gh/PostgREST/postgrest/tree/main)
|
[](https://github.com/PostgREST/postgrest/actions?query=branch%3Amain)
|
||||||
|
|
||||||
PostgREST serves a fully RESTful API from any existing PostgreSQL database. It
|
PostgREST serves a fully RESTful API from any existing PostgreSQL database. It
|
||||||
provides a cleaner, more standards-compliant, faster API than you are likely to
|
provides a cleaner, more standards-compliant, faster API than you are likely to
|
||||||
@@ -55,7 +55,7 @@ write from scratch.
|
|||||||
# Usage
|
# Usage
|
||||||
|
|
||||||
To learn how to use this container, see the [PostgREST Docker
|
To learn how to use this container, see the [PostgREST Docker
|
||||||
documentation](https://postgrest.com/en/stable/install.html#docker).
|
documentation](https://postgrest.org/en/stable/install.html#docker).
|
||||||
|
|
||||||
You can configure the PostgREST image by setting
|
You can configure the PostgREST image by setting
|
||||||
[enviroment variables](https://postgrest.org/en/stable/configuration.html).
|
[enviroment variables](https://postgrest.org/en/stable/configuration.html).
|
||||||
@@ -66,5 +66,5 @@ The image is built from scratch using
|
|||||||
[Nix](https://nixos.org/nixpkgs/manual/#sec-pkgs-dockerTools) instead of a
|
[Nix](https://nixos.org/nixpkgs/manual/#sec-pkgs-dockerTools) instead of a
|
||||||
`Dockerfile`, which yields a higly secure and optimized image. This is also why
|
`Dockerfile`, which yields a higly secure and optimized image. This is also why
|
||||||
no commands are listed in the image history. See the [PostgREST
|
no commands are listed in the image history. See the [PostgREST
|
||||||
respository](https://github.com/PostgREST/postgrest/tree/main/nix/docker) for
|
respository](https://github.com/PostgREST/postgrest/tree/main/nix/tools/docker) for
|
||||||
details on the build process and how to inspect the image.
|
details on the build process and how to inspect the image.
|
||||||
|
|||||||
+21
-6
@@ -1,11 +1,14 @@
|
|||||||
{ black
|
{ actionlint
|
||||||
|
, black
|
||||||
, buildToolbox
|
, buildToolbox
|
||||||
, checkedShellScript
|
, checkedShellScript
|
||||||
, git
|
, git
|
||||||
, hlint
|
, hlint
|
||||||
|
, hsie
|
||||||
, nixpkgs-fmt
|
, nixpkgs-fmt
|
||||||
, shellcheck
|
, shellcheck
|
||||||
, silver-searcher
|
, silver-searcher
|
||||||
|
, statix
|
||||||
, stylish-haskell
|
, stylish-haskell
|
||||||
}:
|
}:
|
||||||
let
|
let
|
||||||
@@ -18,6 +21,7 @@ let
|
|||||||
}
|
}
|
||||||
''
|
''
|
||||||
# Format Nix files
|
# Format Nix files
|
||||||
|
${statix}/bin/statix fix
|
||||||
${nixpkgs-fmt}/bin/nixpkgs-fmt . > /dev/null 2> /dev/null
|
${nixpkgs-fmt}/bin/nixpkgs-fmt . > /dev/null 2> /dev/null
|
||||||
|
|
||||||
# Format Haskell files
|
# Format Haskell files
|
||||||
@@ -40,24 +44,35 @@ let
|
|||||||
''
|
''
|
||||||
${style}
|
${style}
|
||||||
|
|
||||||
${git}/bin/git diff-index --exit-code HEAD -- '*.hs' '*.lhs' '*.nix'
|
trap "echo postgrest-style-check failed. Run postgrest-style to fix issues automatically." ERR
|
||||||
|
|
||||||
|
${git}/bin/git diff-index --exit-code HEAD -- '*.hs' '*.lhs' '*.nix' '*.py'
|
||||||
'';
|
'';
|
||||||
|
|
||||||
lint =
|
lint =
|
||||||
checkedShellScript
|
checkedShellScript
|
||||||
{
|
{
|
||||||
name = "postgrest-lint";
|
name = "postgrest-lint";
|
||||||
docs = "Lint all Haskell files and bash scripts.";
|
docs = "Lint all Haskell files, bash scripts and github workflows.";
|
||||||
inRootDir = true;
|
inRootDir = true;
|
||||||
}
|
}
|
||||||
''
|
''
|
||||||
# Lint Haskell files
|
echo "Checking consistency of import aliases in Haskell code..."
|
||||||
|
${hsie} check-aliases main src
|
||||||
|
|
||||||
|
|
||||||
|
echo "Linting Haskell files..."
|
||||||
# --vimgrep fixes a bug in ag: https://github.com/ggreer/the_silver_searcher/issues/753
|
# --vimgrep fixes a bug in ag: https://github.com/ggreer/the_silver_searcher/issues/753
|
||||||
${silver-searcher}/bin/ag -l --vimgrep -g '\.l?hs$' . \
|
${silver-searcher}/bin/ag -l --vimgrep -g '\.l?hs$' . \
|
||||||
| xargs ${hlint}/bin/hlint -X QuasiQuotes -X NoPatternSynonyms
|
| xargs ${hlint}/bin/hlint -X QuasiQuotes -X NoPatternSynonyms
|
||||||
|
|
||||||
# Lint bash scripts
|
echo "Linting bash scripts..."
|
||||||
${shellcheck}/bin/shellcheck test/create_test_db test/memory-tests.sh
|
${shellcheck}/bin/shellcheck \
|
||||||
|
.github/get_cirrusci_freebsd \
|
||||||
|
.github/release
|
||||||
|
|
||||||
|
echo "Linting workflows..."
|
||||||
|
${actionlint}/bin/actionlint
|
||||||
'';
|
'';
|
||||||
|
|
||||||
in
|
in
|
||||||
|
|||||||
+130
-57
@@ -3,14 +3,17 @@
|
|||||||
, checkedShellScript
|
, checkedShellScript
|
||||||
, devCabalOptions
|
, devCabalOptions
|
||||||
, ghc
|
, ghc
|
||||||
, glibcLocales
|
, glibcLocales ? null
|
||||||
, gnugrep
|
, gnugrep
|
||||||
, haskell
|
|
||||||
, hpc-codecov
|
, hpc-codecov
|
||||||
|
, hostPlatform
|
||||||
, jq
|
, jq
|
||||||
|
, lib
|
||||||
, postgrest
|
, postgrest
|
||||||
, python3
|
, python3
|
||||||
, runtimeShell
|
, runtimeShell
|
||||||
|
, stdenv
|
||||||
|
, weeder
|
||||||
, withTools
|
, withTools
|
||||||
, yq
|
, yq
|
||||||
}:
|
}:
|
||||||
@@ -19,12 +22,44 @@ let
|
|||||||
checkedShellScript
|
checkedShellScript
|
||||||
{
|
{
|
||||||
name = "postgrest-test-spec";
|
name = "postgrest-test-spec";
|
||||||
docs = "Run the Haskell test suite";
|
docs = "Run the Haskell test suite. Use --match PATTERN for running individual specs";
|
||||||
|
args = [ "ARG_LEFTOVERS([hspec arguments])" ];
|
||||||
inRootDir = true;
|
inRootDir = true;
|
||||||
withEnv = postgrest.env;
|
withEnv = postgrest.env;
|
||||||
}
|
}
|
||||||
''
|
''
|
||||||
${withTools.latest} ${cabal-install}/bin/cabal v2-test ${devCabalOptions}
|
${withTools.withPg} ${cabal-install}/bin/cabal v2-run ${devCabalOptions} \
|
||||||
|
test:spec -- "''${_arg_leftovers[@]}"
|
||||||
|
'';
|
||||||
|
|
||||||
|
testQuerycost =
|
||||||
|
checkedShellScript
|
||||||
|
{
|
||||||
|
name = "postgrest-test-querycost";
|
||||||
|
docs = "Run the Haskell test suite for query costs";
|
||||||
|
inRootDir = true;
|
||||||
|
withEnv = postgrest.env;
|
||||||
|
}
|
||||||
|
''
|
||||||
|
${withTools.withPg} ${cabal-install}/bin/cabal v2-run ${devCabalOptions} test:querycost
|
||||||
|
'';
|
||||||
|
|
||||||
|
testDoctests =
|
||||||
|
checkedShellScript
|
||||||
|
{
|
||||||
|
name = "postgrest-test-doctests";
|
||||||
|
docs = "Run the Haskell doctest test suite";
|
||||||
|
inRootDir = true;
|
||||||
|
withEnv = postgrest.env;
|
||||||
|
}
|
||||||
|
''
|
||||||
|
# For unknown reasons, doctests uses the wrong GHC package database outside
|
||||||
|
# nix-shell and fails, so we set the package path explicitly
|
||||||
|
#ghcWithPackages="$(cat ${postgrest.env})"
|
||||||
|
#ghcVersion="$(ls "$ghcWithPackages/lib")"
|
||||||
|
#export GHC_PACKAGE_PATH="$ghcWithPackages/lib/$ghcVersion/package.conf.d/"
|
||||||
|
|
||||||
|
${cabal-install}/bin/cabal v2-run ${devCabalOptions} test:doctests
|
||||||
'';
|
'';
|
||||||
|
|
||||||
testSpecIdempotence =
|
testSpecIdempotence =
|
||||||
@@ -36,9 +71,9 @@ let
|
|||||||
withEnv = postgrest.env;
|
withEnv = postgrest.env;
|
||||||
}
|
}
|
||||||
''
|
''
|
||||||
${withTools.latest} ${runtimeShell} -c " \
|
${withTools.withPg} ${runtimeShell} -c " \
|
||||||
${cabal-install}/bin/cabal v2-test ${devCabalOptions} && \
|
${cabal-install}/bin/cabal v2-run ${devCabalOptions} test:spec && \
|
||||||
${cabal-install}/bin/cabal v2-test ${devCabalOptions}"
|
${cabal-install}/bin/cabal v2-run ${devCabalOptions} test:spec"
|
||||||
'';
|
'';
|
||||||
|
|
||||||
ioTestPython =
|
ioTestPython =
|
||||||
@@ -55,15 +90,15 @@ let
|
|||||||
checkedShellScript
|
checkedShellScript
|
||||||
{
|
{
|
||||||
name = "postgrest-test-io";
|
name = "postgrest-test-io";
|
||||||
docs = "Run the pytest-based IO tests.";
|
docs = "Run the pytest-based IO tests. Add -k to run tests that match a given expression.";
|
||||||
args = [ "ARG_LEFTOVERS([pytest arguments])" ];
|
args = [ "ARG_LEFTOVERS([pytest arguments])" ];
|
||||||
inRootDir = true;
|
inRootDir = true;
|
||||||
withEnv = postgrest.env;
|
withEnv = postgrest.env;
|
||||||
}
|
}
|
||||||
''
|
''
|
||||||
${cabal-install}/bin/cabal v2-build ${devCabalOptions}
|
${cabal-install}/bin/cabal v2-build ${devCabalOptions}
|
||||||
${cabal-install}/bin/cabal v2-exec ${withTools.latest} \
|
${cabal-install}/bin/cabal v2-exec -- ${withTools.withPg} -f test/io/fixtures.sql \
|
||||||
${ioTestPython}/bin/pytest -- -v test/io-tests "''${_arg_leftovers[@]}"
|
${ioTestPython}/bin/pytest -v test/io "''${_arg_leftovers[@]}"
|
||||||
'';
|
'';
|
||||||
|
|
||||||
dumpSchema =
|
dumpSchema =
|
||||||
@@ -73,11 +108,10 @@ let
|
|||||||
docs = "Dump the loaded schema's DbStructure as a yaml file.";
|
docs = "Dump the loaded schema's DbStructure as a yaml file.";
|
||||||
inRootDir = true;
|
inRootDir = true;
|
||||||
withEnv = postgrest.env;
|
withEnv = postgrest.env;
|
||||||
|
withPath = [ jq ];
|
||||||
}
|
}
|
||||||
''
|
''
|
||||||
export PATH="${jq}/bin:$PATH"
|
${withTools.withPg} \
|
||||||
|
|
||||||
${withTools.latest} \
|
|
||||||
${cabal-install}/bin/cabal v2-run ${devCabalOptions} --verbose=0 -- \
|
${cabal-install}/bin/cabal v2-run ${devCabalOptions} --verbose=0 -- \
|
||||||
postgrest --dump-schema \
|
postgrest --dump-schema \
|
||||||
| ${yq}/bin/yq -y .
|
| ${yq}/bin/yq -y .
|
||||||
@@ -87,63 +121,79 @@ let
|
|||||||
checkedShellScript
|
checkedShellScript
|
||||||
{
|
{
|
||||||
name = "postgrest-coverage";
|
name = "postgrest-coverage";
|
||||||
docs = "Run spec and io tests while collecting hpc coverage data.";
|
docs = "Run spec and io tests while collecting hpc coverage data. First runs weeder to detect dead code.";
|
||||||
args = [ "ARG_LEFTOVERS([hpc report arguments])" ];
|
args = [ "ARG_LEFTOVERS([hpc report arguments])" ];
|
||||||
inRootDir = true;
|
inRootDir = true;
|
||||||
redirectTixFiles = false;
|
redirectTixFiles = false;
|
||||||
withEnv = postgrest.env;
|
withEnv = postgrest.env;
|
||||||
withTmpDir = true;
|
withTmpDir = true;
|
||||||
}
|
}
|
||||||
''
|
(
|
||||||
export LOCALE_ARCHIVE="${glibcLocales}/lib/locale/locale-archive"
|
# required for `hpc markup` in CI; glibcLocales is not available e.g. on Darwin
|
||||||
|
lib.optionalString (stdenv.isLinux && hostPlatform.libc == "glibc") ''
|
||||||
|
export LOCALE_ARCHIVE="${glibcLocales}/lib/locale/locale-archive"
|
||||||
|
'' +
|
||||||
|
|
||||||
# clean up previous coverage reports
|
''
|
||||||
mkdir -p coverage
|
# clean up previous coverage reports
|
||||||
rm -rf coverage/*
|
mkdir -p coverage
|
||||||
|
rm -rf coverage/*
|
||||||
|
|
||||||
# build once before running all the tests
|
# build once before running all the tests
|
||||||
${cabal-install}/bin/cabal v2-build ${devCabalOptions} exe:postgrest lib:postgrest test:spec test:spec-querycost
|
${cabal-install}/bin/cabal v2-build ${devCabalOptions} exe:postgrest lib:postgrest test:spec test:querycost
|
||||||
|
|
||||||
# collect all tests
|
(
|
||||||
HPCTIXFILE="$tmpdir"/io.tix \
|
trap 'echo Found dead code: Check file list above.' ERR ;
|
||||||
${withTools.latest} ${cabal-install}/bin/cabal v2-exec ${devCabalOptions} \
|
${weeder}/bin/weeder --config=./test/weeder.dhall
|
||||||
${ioTestPython}/bin/pytest -- -v test/io-tests
|
)
|
||||||
|
|
||||||
HPCTIXFILE="$tmpdir"/spec.tix \
|
|
||||||
${withTools.latest} ${cabal-install}/bin/cabal v2-test ${devCabalOptions}
|
|
||||||
|
|
||||||
# collect all the tix files
|
# collect all tests
|
||||||
${ghc}/bin/hpc sum --union --exclude=Paths_postgrest --output="$tmpdir"/tests.tix "$tmpdir"/io*.tix "$tmpdir"/spec.tix
|
HPCTIXFILE="$tmpdir"/io.tix \
|
||||||
|
${withTools.withPg} -f test/io/fixtures.sql ${cabal-install}/bin/cabal v2-exec ${devCabalOptions} -- \
|
||||||
|
${ioTestPython}/bin/pytest -v test/io
|
||||||
|
|
||||||
# prepare the overlay
|
HPCTIXFILE="$tmpdir"/spec.tix \
|
||||||
${ghc}/bin/hpc overlay --output="$tmpdir"/overlay.tix test/coverage.overlay
|
${withTools.withPg} ${cabal-install}/bin/cabal v2-run ${devCabalOptions} test:spec
|
||||||
${ghc}/bin/hpc sum --union --output="$tmpdir"/tests-overlay.tix "$tmpdir"/tests.tix "$tmpdir"/overlay.tix
|
|
||||||
|
|
||||||
# check nothing in the overlay is actually tested
|
HPCTIXFILE="$tmpdir"/querycost.tix \
|
||||||
${ghc}/bin/hpc map --function=inv --output="$tmpdir"/inverted.tix "$tmpdir"/tests.tix
|
${withTools.withPg} ${cabal-install}/bin/cabal v2-run ${devCabalOptions} test:querycost
|
||||||
${ghc}/bin/hpc combine --function=sub \
|
|
||||||
--output="$tmpdir"/check.tix "$tmpdir"/overlay.tix "$tmpdir"/inverted.tix
|
|
||||||
# returns zero exit code if any count="<non-zero>" lines are found, i.e.
|
|
||||||
# something is covered by both the overlay and the tests
|
|
||||||
if ${ghc}/bin/hpc report --xml "$tmpdir"/check.tix | ${gnugrep}/bin/grep -qP 'count="[^0]'
|
|
||||||
then
|
|
||||||
${ghc}/bin/hpc markup --highlight-covered --destdir=coverage/overlay "$tmpdir"/overlay.tix || true
|
|
||||||
${ghc}/bin/hpc markup --highlight-covered --destdir=coverage/check "$tmpdir"/check.tix || true
|
|
||||||
echo "ERROR: Something is covered by both the tests and the overlay:"
|
|
||||||
echo "file://$(pwd)/coverage/check/hpc_index.html"
|
|
||||||
exit 1
|
|
||||||
else
|
|
||||||
# copy the result .tix file to the coverage/ dir to make it available to postgrest-coverage-draft-overlay, too
|
|
||||||
cp "$tmpdir"/tests-overlay.tix coverage/postgrest.tix
|
|
||||||
# prepare codecov json report
|
|
||||||
${hpc-codecov}/bin/hpc-codecov --mix=.hpc --out=coverage/codecov.json coverage/postgrest.tix
|
|
||||||
|
|
||||||
# create html and stdout reports
|
# Note: No coverage for doctests, as doctests leverage GHCi and GHCi does not support hpc
|
||||||
${ghc}/bin/hpc markup --destdir=coverage coverage/postgrest.tix
|
|
||||||
echo "file://$(pwd)/coverage/hpc_index.html"
|
# collect all the tix files
|
||||||
${ghc}/bin/hpc report coverage/postgrest.tix "''${_arg_leftovers[@]}"
|
${ghc}/bin/hpc sum --union --exclude=Paths_postgrest --output="$tmpdir"/tests.tix \
|
||||||
fi
|
"$tmpdir"/io*.tix "$tmpdir"/spec.tix "$tmpdir"/querycost.tix
|
||||||
'';
|
|
||||||
|
# prepare the overlay
|
||||||
|
${ghc}/bin/hpc overlay --output="$tmpdir"/overlay.tix test/coverage.overlay
|
||||||
|
${ghc}/bin/hpc sum --union --output="$tmpdir"/tests-overlay.tix "$tmpdir"/tests.tix "$tmpdir"/overlay.tix
|
||||||
|
|
||||||
|
# check nothing in the overlay is actually tested
|
||||||
|
${ghc}/bin/hpc map --function=inv --output="$tmpdir"/inverted.tix "$tmpdir"/tests.tix
|
||||||
|
${ghc}/bin/hpc combine --function=sub \
|
||||||
|
--output="$tmpdir"/check.tix "$tmpdir"/overlay.tix "$tmpdir"/inverted.tix
|
||||||
|
# returns zero exit code if any count="<non-zero>" lines are found, i.e.
|
||||||
|
# something is covered by both the overlay and the tests
|
||||||
|
if ${ghc}/bin/hpc report --xml "$tmpdir"/check.tix | ${gnugrep}/bin/grep -qP 'count="[^0]'
|
||||||
|
then
|
||||||
|
${ghc}/bin/hpc markup --highlight-covered --destdir=coverage/overlay "$tmpdir"/overlay.tix || true
|
||||||
|
${ghc}/bin/hpc markup --highlight-covered --destdir=coverage/check "$tmpdir"/check.tix || true
|
||||||
|
echo "ERROR: Something is covered by both the tests and the overlay:"
|
||||||
|
echo "file://$(pwd)/coverage/check/hpc_index.html"
|
||||||
|
exit 1
|
||||||
|
else
|
||||||
|
# copy the result .tix file to the coverage/ dir to make it available to postgrest-coverage-draft-overlay, too
|
||||||
|
cp "$tmpdir"/tests-overlay.tix coverage/postgrest.tix
|
||||||
|
# prepare codecov json report
|
||||||
|
${hpc-codecov}/bin/hpc-codecov --mix=.hpc --out=coverage/codecov.json coverage/postgrest.tix
|
||||||
|
|
||||||
|
# create html and stdout reports
|
||||||
|
${ghc}/bin/hpc markup --destdir=coverage coverage/postgrest.tix
|
||||||
|
echo "file://$(pwd)/coverage/hpc_index.html"
|
||||||
|
${ghc}/bin/hpc report coverage/postgrest.tix "''${_arg_leftovers[@]}"
|
||||||
|
fi
|
||||||
|
''
|
||||||
|
);
|
||||||
|
|
||||||
coverageDraftOverlay =
|
coverageDraftOverlay =
|
||||||
checkedShellScript
|
checkedShellScript
|
||||||
@@ -157,6 +207,26 @@ let
|
|||||||
sed -i 's|^module \(.*\):|module \1/|g' test/coverage.overlay
|
sed -i 's|^module \(.*\):|module \1/|g' test/coverage.overlay
|
||||||
'';
|
'';
|
||||||
|
|
||||||
|
checkStatic =
|
||||||
|
checkedShellScript
|
||||||
|
{
|
||||||
|
name = "postgrest-check-static";
|
||||||
|
docs = "Verify that the argument is a static executable.";
|
||||||
|
args = [ "ARG_POSITIONAL_SINGLE([executable], [Executable])" ];
|
||||||
|
inRootDir = true;
|
||||||
|
withEnv = postgrest.env;
|
||||||
|
}
|
||||||
|
''
|
||||||
|
exe="$_arg_executable"
|
||||||
|
ldd_output=$(ldd "$exe" 2>&1 || true)
|
||||||
|
if ! grep -q "not a dynamic executable" <<< "$ldd_output"; then
|
||||||
|
echo "not a static executable, ldd output:"
|
||||||
|
echo "$ldd_output"
|
||||||
|
exit 1
|
||||||
|
fi
|
||||||
|
"$exe" --help
|
||||||
|
'';
|
||||||
|
|
||||||
in
|
in
|
||||||
buildToolbox
|
buildToolbox
|
||||||
{
|
{
|
||||||
@@ -164,10 +234,13 @@ buildToolbox
|
|||||||
tools =
|
tools =
|
||||||
[
|
[
|
||||||
testSpec
|
testSpec
|
||||||
|
testQuerycost
|
||||||
|
testDoctests
|
||||||
testSpecIdempotence
|
testSpecIdempotence
|
||||||
testIO
|
testIO
|
||||||
dumpSchema
|
dumpSchema
|
||||||
coverage
|
coverage
|
||||||
coverageDraftOverlay
|
coverageDraftOverlay
|
||||||
|
checkStatic
|
||||||
];
|
];
|
||||||
}
|
}
|
||||||
|
|||||||
+174
-31
@@ -1,9 +1,14 @@
|
|||||||
{ bashCompletion
|
{ bash-completion
|
||||||
, buildToolbox
|
, buildToolbox
|
||||||
|
, cabal-install
|
||||||
, checkedShellScript
|
, checkedShellScript
|
||||||
|
, curl
|
||||||
|
, devCabalOptions
|
||||||
|
, git
|
||||||
, lib
|
, lib
|
||||||
, postgresqlVersions
|
, postgresqlVersions
|
||||||
, writeTextFile
|
, postgrest
|
||||||
|
, writeText
|
||||||
}:
|
}:
|
||||||
let
|
let
|
||||||
withTmpDb =
|
withTmpDb =
|
||||||
@@ -14,26 +19,25 @@ let
|
|||||||
docs = "Run the given command in a temporary database with ${name}";
|
docs = "Run the given command in a temporary database with ${name}";
|
||||||
args =
|
args =
|
||||||
[
|
[
|
||||||
"ARG_OPTIONAL_SINGLE([fixtures], [f], [SQL file to load fixtures from], [test/fixtures/load.sql])"
|
"ARG_OPTIONAL_SINGLE([fixtures], [f], [SQL file to load fixtures from], [test/spec/fixtures/load.sql])"
|
||||||
"ARG_POSITIONAL_SINGLE([command], [Command to run])"
|
"ARG_POSITIONAL_SINGLE([command], [Command to run])"
|
||||||
"ARG_LEFTOVERS([command arguments])"
|
"ARG_LEFTOVERS([command arguments])"
|
||||||
"ARG_USE_ENV([PGUSER], [postgrest_test_authenticator], [Authenticator PG role])"
|
"ARG_USE_ENV([PGUSER], [postgrest_test_authenticator], [Authenticator PG role])"
|
||||||
"ARG_USE_ENV([PGDATABASE], [postgres], [PG database name])"
|
"ARG_USE_ENV([PGDATABASE], [postgres], [PG database name])"
|
||||||
"ARG_USE_ENV([PGRST_DB_SCHEMAS], [test], [Schema to expose])"
|
"ARG_USE_ENV([PGRST_DB_SCHEMAS], [test], [Schema to expose])"
|
||||||
"ARG_USE_ENV([PGRST_DB_ANON_ROLE], [postgrest_test_anonymous], [Anonymous PG role])"
|
|
||||||
];
|
];
|
||||||
addCommandCompletion = true;
|
positionalCompletion = "_command";
|
||||||
inRootDir = true;
|
inRootDir = true;
|
||||||
redirectTixFiles = false;
|
redirectTixFiles = false;
|
||||||
|
withPath = [ postgresql ];
|
||||||
withTmpDir = true;
|
withTmpDir = true;
|
||||||
}
|
}
|
||||||
''
|
''
|
||||||
# avoid starting multiple layers of withTmpDb
|
# avoid starting multiple layers of withTmpDb
|
||||||
if test -v PGRST_DB_URI; then
|
if test -v PGHOST; then
|
||||||
exec "$@"
|
exec "$_arg_command" "''${_arg_leftovers[@]}"
|
||||||
fi
|
fi
|
||||||
|
|
||||||
export PATH=${postgresql}/bin:"$PATH"
|
|
||||||
setuplog="$tmpdir/setup.log"
|
setuplog="$tmpdir/setup.log"
|
||||||
|
|
||||||
log () {
|
log () {
|
||||||
@@ -48,9 +52,7 @@ let
|
|||||||
export PGHOST="$tmpdir/socket"
|
export PGHOST="$tmpdir/socket"
|
||||||
export PGUSER
|
export PGUSER
|
||||||
export PGDATABASE
|
export PGDATABASE
|
||||||
export PGRST_DB_URI="postgresql:///$PGDATABASE?host=$PGHOST&user=$PGUSER"
|
|
||||||
export PGRST_DB_SCHEMAS
|
export PGRST_DB_SCHEMAS
|
||||||
export PGRST_DB_ANON_ROLE
|
|
||||||
|
|
||||||
log "Initializing database cluster..."
|
log "Initializing database cluster..."
|
||||||
# We try to make the database cluster as independent as possible from the host
|
# We try to make the database cluster as independent as possible from the host
|
||||||
@@ -60,18 +62,13 @@ let
|
|||||||
|
|
||||||
log "Starting the database cluster..."
|
log "Starting the database cluster..."
|
||||||
# Instead of listening on a local port, we will listen on a unix domain socket.
|
# Instead of listening on a local port, we will listen on a unix domain socket.
|
||||||
pg_ctl -l "$tmpdir/db.log" start -o "-F -c listen_addresses=\"\" -k $PGHOST" \
|
pg_ctl -l "$tmpdir/db.log" -w start -o "-F -c listen_addresses=\"\" -k $PGHOST -c log_statement=\"all\"" \
|
||||||
>> "$setuplog"
|
>> "$setuplog"
|
||||||
|
|
||||||
log "Waiting for the database cluster to be ready..."
|
|
||||||
# Waiting is required for older versions of Postgres (< 10).
|
|
||||||
until pg_isready >> "$setuplog"; do
|
|
||||||
sleep 0.1
|
|
||||||
done
|
|
||||||
|
|
||||||
stop () {
|
stop () {
|
||||||
log "Stopping the database cluster..."
|
log "Stopping the database cluster..."
|
||||||
pg_ctl stop -m i >> "$setuplog"
|
pg_ctl stop -m i >> "$setuplog"
|
||||||
|
rm -rf "$tmpdir/db"
|
||||||
}
|
}
|
||||||
trap stop EXIT
|
trap stop EXIT
|
||||||
|
|
||||||
@@ -83,27 +80,27 @@ let
|
|||||||
'';
|
'';
|
||||||
|
|
||||||
# Helper script for running a command against all PostgreSQL versions.
|
# Helper script for running a command against all PostgreSQL versions.
|
||||||
withAll =
|
withPgAll =
|
||||||
let
|
let
|
||||||
runners =
|
runners =
|
||||||
builtins.map
|
builtins.map
|
||||||
(pg:
|
(version:
|
||||||
''
|
''
|
||||||
cat << EOF
|
cat << EOF
|
||||||
|
|
||||||
Running against ${pg.name}...
|
Running against ${version.name}...
|
||||||
|
|
||||||
EOF
|
EOF
|
||||||
|
|
||||||
trap 'echo "Failed on ${pg.name}"' exit
|
trap 'echo "Failed on ${version.name}"' exit
|
||||||
|
|
||||||
(${withTmpDb pg} "$_arg_command" "''${_arg_leftovers[@]}")
|
(${withTmpDb version} "$_arg_command" "''${_arg_leftovers[@]}")
|
||||||
|
|
||||||
trap "" exit
|
trap "" exit
|
||||||
|
|
||||||
cat << EOF
|
cat << EOF
|
||||||
|
|
||||||
Done running against ${pg.name}.
|
Done running against ${version.name}.
|
||||||
|
|
||||||
EOF
|
EOF
|
||||||
'')
|
'')
|
||||||
@@ -118,21 +115,167 @@ let
|
|||||||
"ARG_POSITIONAL_SINGLE([command], [Command to run])"
|
"ARG_POSITIONAL_SINGLE([command], [Command to run])"
|
||||||
"ARG_LEFTOVERS([command arguments])"
|
"ARG_LEFTOVERS([command arguments])"
|
||||||
];
|
];
|
||||||
addCommandCompletion = true;
|
positionalCompletion = "_command";
|
||||||
inRootDir = true;
|
inRootDir = true;
|
||||||
}
|
}
|
||||||
(lib.concatStringsSep "\n\n" runners);
|
(lib.concatStringsSep "\n\n" runners);
|
||||||
|
|
||||||
# Create a `postgrest-with-postgresql-` for each PostgreSQL version
|
# Create a `postgrest-with-postgresql-` for each PostgreSQL version
|
||||||
withVersions = builtins.map withTmpDb postgresqlVersions;
|
withPgVersions = builtins.map withTmpDb postgresqlVersions;
|
||||||
|
|
||||||
|
withPg = builtins.head withPgVersions;
|
||||||
|
|
||||||
|
withGit =
|
||||||
|
let
|
||||||
|
name = "postgrest-with-git";
|
||||||
|
in
|
||||||
|
checkedShellScript
|
||||||
|
{
|
||||||
|
inherit name;
|
||||||
|
docs =
|
||||||
|
''
|
||||||
|
Create a new worktree of the postgrest repo in a temporary directory and
|
||||||
|
check out <commit>, then run <command> with arguments inside the temporary folder.
|
||||||
|
'';
|
||||||
|
args =
|
||||||
|
[
|
||||||
|
"ARG_POSITIONAL_SINGLE([commit], [Commit-ish reference to run command with])"
|
||||||
|
"ARG_POSITIONAL_SINGLE([command], [Command to run])"
|
||||||
|
"ARG_LEFTOVERS([command arguments])"
|
||||||
|
];
|
||||||
|
positionalCompletion =
|
||||||
|
''
|
||||||
|
if test "$prev" == "${name}"; then
|
||||||
|
__gitcomp_nl "$(__git_refs)"
|
||||||
|
else
|
||||||
|
_command_offset 2
|
||||||
|
fi
|
||||||
|
'';
|
||||||
|
inRootDir = true;
|
||||||
|
}
|
||||||
|
''
|
||||||
|
# not using withTmpDir here, because we don't want to keep the directory on error
|
||||||
|
tmpdir="$(mktemp -d)"
|
||||||
|
trap 'rm -rf "$tmpdir"' EXIT
|
||||||
|
|
||||||
|
${git}/bin/git worktree add -f "$tmpdir" "$_arg_commit" > /dev/null
|
||||||
|
|
||||||
|
cd "$tmpdir"
|
||||||
|
("$_arg_command" "''${_arg_leftovers[@]}")
|
||||||
|
|
||||||
|
${git}/bin/git worktree remove -f "$tmpdir" > /dev/null
|
||||||
|
'';
|
||||||
|
|
||||||
|
legacyConfig =
|
||||||
|
writeText "legacy.conf"
|
||||||
|
''
|
||||||
|
# Using this config file to support older postgrest versions for `postgrest-loadtest-against`
|
||||||
|
db-uri="$(PGRST_DB_URI)"
|
||||||
|
db-schema="$(PGRST_DB_SCHEMAS)"
|
||||||
|
db-anon-role="$(PGRST_DB_ANON_ROLE)"
|
||||||
|
db-pool="$(PGRST_DB_POOL)"
|
||||||
|
server-unix-socket="$(PGRST_SERVER_UNIX_SOCKET)"
|
||||||
|
log-level="$(PGRST_LOG_LEVEL)"
|
||||||
|
'';
|
||||||
|
|
||||||
|
waitForPgrstPid =
|
||||||
|
checkedShellScript
|
||||||
|
{
|
||||||
|
name = "postgrest-wait-for-pgrst-pid";
|
||||||
|
docs = "Wait for PostgREST to be running. Needs to be a separate command for timeout to work below.";
|
||||||
|
args = [
|
||||||
|
"ARG_USE_ENV([PGRST_SERVER_UNIX_SOCKET], [], [Unix socket to check for running PostgREST instance])"
|
||||||
|
];
|
||||||
|
}
|
||||||
|
''
|
||||||
|
# ARG_USE_ENV only adds defaults or docs for environment variables
|
||||||
|
# We manually implement a required check here
|
||||||
|
# See also: https://github.com/matejak/argbash/issues/80
|
||||||
|
: "''${PGRST_SERVER_UNIX_SOCKET:?PGRST_SERVER_UNIX_SOCKET is required}"
|
||||||
|
|
||||||
|
until [ -S "$PGRST_SERVER_UNIX_SOCKET" ]
|
||||||
|
do
|
||||||
|
sleep 0.1
|
||||||
|
done
|
||||||
|
|
||||||
|
# return pid of postgrest process
|
||||||
|
lsof -t -c '/^postgrest$/' "$PGRST_SERVER_UNIX_SOCKET"
|
||||||
|
'';
|
||||||
|
|
||||||
|
waitForPgrstReady =
|
||||||
|
checkedShellScript
|
||||||
|
{
|
||||||
|
name = "postgrest-wait-for-pgrst-ready";
|
||||||
|
docs = "Wait for PostgREST to be ready to serve requests. Needs to be a separate command for timeout to work below.";
|
||||||
|
args = [
|
||||||
|
"ARG_USE_ENV([PGRST_SERVER_UNIX_SOCKET], [], [Unix socket to check for running PostgREST instance])"
|
||||||
|
];
|
||||||
|
}
|
||||||
|
''
|
||||||
|
# ARG_USE_ENV only adds defaults or docs for environment variables
|
||||||
|
# We manually implement a required check here
|
||||||
|
# See also: https://github.com/matejak/argbash/issues/80
|
||||||
|
: "''${PGRST_SERVER_UNIX_SOCKET:?PGRST_SERVER_UNIX_SOCKET is required}"
|
||||||
|
|
||||||
|
function check_status () {
|
||||||
|
${curl}/bin/curl -s -o /dev/null -w "%{http_code}" --unix-socket "$PGRST_SERVER_UNIX_SOCKET" http://localhost/
|
||||||
|
}
|
||||||
|
|
||||||
|
while [[ "$(check_status)" != "200" ]];
|
||||||
|
do sleep 0.1;
|
||||||
|
done
|
||||||
|
'';
|
||||||
|
|
||||||
|
withPgrst =
|
||||||
|
checkedShellScript
|
||||||
|
{
|
||||||
|
name = "postgrest-with-pgrst";
|
||||||
|
docs = "Build and run PostgREST and run <command> with PGRST_SERVER_UNIX_SOCKET set.";
|
||||||
|
args =
|
||||||
|
[
|
||||||
|
"ARG_POSITIONAL_SINGLE([command], [Command to run])"
|
||||||
|
"ARG_LEFTOVERS([command arguments])"
|
||||||
|
];
|
||||||
|
positionalCompletion = "_command";
|
||||||
|
inRootDir = true;
|
||||||
|
withEnv = postgrest.env;
|
||||||
|
withTmpDir = true;
|
||||||
|
}
|
||||||
|
''
|
||||||
|
export PGRST_SERVER_UNIX_SOCKET="$tmpdir"/postgrest.socket
|
||||||
|
|
||||||
|
rm -f result
|
||||||
|
echo -n "Building postgrest... "
|
||||||
|
nix-build -A postgrestPackage > "$tmpdir"/build.log 2>&1 || {
|
||||||
|
echo "failed, output:"
|
||||||
|
cat "$tmpdir"/build.log
|
||||||
|
exit 1
|
||||||
|
}
|
||||||
|
echo "done."
|
||||||
|
|
||||||
|
echo -n "Starting postgrest... "
|
||||||
|
./result/bin/postgrest ${legacyConfig} > "$tmpdir"/run.log 2>&1 &
|
||||||
|
pid=$!
|
||||||
|
cleanup() {
|
||||||
|
kill "$pid" || true
|
||||||
|
}
|
||||||
|
trap cleanup EXIT
|
||||||
|
|
||||||
|
timeout -s TERM 5 ${waitForPgrstReady} || {
|
||||||
|
echo "timed out, output:"
|
||||||
|
cat "$tmpdir"/run.log
|
||||||
|
exit 1
|
||||||
|
}
|
||||||
|
echo "done."
|
||||||
|
|
||||||
|
("$_arg_command" "''${_arg_leftovers[@]}")
|
||||||
|
'';
|
||||||
|
|
||||||
in
|
in
|
||||||
buildToolbox
|
buildToolbox
|
||||||
{
|
{
|
||||||
name = "postgrest-with";
|
name = "postgrest-with";
|
||||||
tools = [ withAll ] ++ withVersions;
|
tools = [ withPgAll withGit withPgrst ] ++ withPgVersions;
|
||||||
extra = {
|
# make withTools available for other nix files
|
||||||
# make withTools.latest available for other nix files
|
extra = { inherit withGit withPg withPgAll withPgrst; };
|
||||||
latest = withTmpDb (builtins.head postgresqlVersions);
|
|
||||||
};
|
|
||||||
}
|
}
|
||||||
|
|||||||
+133
-109
@@ -1,8 +1,8 @@
|
|||||||
name: postgrest
|
name: postgrest
|
||||||
version: 8.0.0
|
version: 10.0.0
|
||||||
synopsis: REST API for any Postgres database
|
synopsis: REST API for any Postgres database
|
||||||
description: Reads the schema of a PostgreSQL database and creates RESTful routes
|
description: Reads the schema of a PostgreSQL database and creates RESTful routes
|
||||||
for the tables and views, supporting all HTTP verbs that security
|
for tables, views, and functions, supporting all HTTP methods that security
|
||||||
permits.
|
permits.
|
||||||
license: MIT
|
license: MIT
|
||||||
license-file: LICENSE
|
license-file: LICENSE
|
||||||
@@ -35,6 +35,7 @@ library
|
|||||||
NoImplicitPrelude
|
NoImplicitPrelude
|
||||||
hs-source-dirs: src
|
hs-source-dirs: src
|
||||||
exposed-modules: PostgREST.App
|
exposed-modules: PostgREST.App
|
||||||
|
PostgREST.Admin
|
||||||
PostgREST.AppState
|
PostgREST.AppState
|
||||||
PostgREST.Auth
|
PostgREST.Auth
|
||||||
PostgREST.CLI
|
PostgREST.CLI
|
||||||
@@ -43,7 +44,7 @@ library
|
|||||||
PostgREST.Config.JSPath
|
PostgREST.Config.JSPath
|
||||||
PostgREST.Config.PgVersion
|
PostgREST.Config.PgVersion
|
||||||
PostgREST.Config.Proxy
|
PostgREST.Config.Proxy
|
||||||
PostgREST.ContentType
|
PostgREST.Cors
|
||||||
PostgREST.DbStructure
|
PostgREST.DbStructure
|
||||||
PostgREST.DbStructure.Identifiers
|
PostgREST.DbStructure.Identifiers
|
||||||
PostgREST.DbStructure.Proc
|
PostgREST.DbStructure.Proc
|
||||||
@@ -51,7 +52,9 @@ library
|
|||||||
PostgREST.DbStructure.Table
|
PostgREST.DbStructure.Table
|
||||||
PostgREST.Error
|
PostgREST.Error
|
||||||
PostgREST.GucHeader
|
PostgREST.GucHeader
|
||||||
|
PostgREST.Logger
|
||||||
PostgREST.Middleware
|
PostgREST.Middleware
|
||||||
|
PostgREST.MediaType
|
||||||
PostgREST.OpenAPI
|
PostgREST.OpenAPI
|
||||||
PostgREST.Query.QueryBuilder
|
PostgREST.Query.QueryBuilder
|
||||||
PostgREST.Query.SqlFragment
|
PostgREST.Query.SqlFragment
|
||||||
@@ -59,32 +62,31 @@ library
|
|||||||
PostgREST.RangeQuery
|
PostgREST.RangeQuery
|
||||||
PostgREST.Request.ApiRequest
|
PostgREST.Request.ApiRequest
|
||||||
PostgREST.Request.DbRequestBuilder
|
PostgREST.Request.DbRequestBuilder
|
||||||
PostgREST.Request.Parsers
|
PostgREST.Request.MutateQuery
|
||||||
PostgREST.Request.Preferences
|
PostgREST.Request.Preferences
|
||||||
|
PostgREST.Request.QueryParams
|
||||||
|
PostgREST.Request.ReadQuery
|
||||||
PostgREST.Request.Types
|
PostgREST.Request.Types
|
||||||
PostgREST.Version
|
PostgREST.Version
|
||||||
PostgREST.Workers
|
PostgREST.Workers
|
||||||
other-modules: Paths_postgrest
|
other-modules: Paths_postgrest
|
||||||
build-depends: base >= 4.9 && < 4.15
|
build-depends: base >= 4.9 && < 4.17
|
||||||
, HTTP >= 4000.3.7 && < 4000.4
|
, HTTP >= 4000.3.7 && < 4000.4
|
||||||
, Ranged-sets >= 0.3 && < 0.5
|
, Ranged-sets >= 0.3 && < 0.5
|
||||||
, aeson >= 1.4.7 && < 1.6
|
, aeson >= 2.0.3 && < 2.1
|
||||||
, ansi-wl-pprint >= 0.6.7 && < 0.7
|
|
||||||
, auto-update >= 0.1.4 && < 0.2
|
, auto-update >= 0.1.4 && < 0.2
|
||||||
, base64-bytestring >= 1 && < 1.3
|
, base64-bytestring >= 1 && < 1.3
|
||||||
, bytestring >= 0.10.8 && < 0.11
|
, bytestring >= 0.10.8 && < 0.12
|
||||||
, case-insensitive >= 1.2 && < 1.3
|
, case-insensitive >= 1.2 && < 1.3
|
||||||
, cassava >= 0.4.5 && < 0.6
|
, cassava >= 0.4.5 && < 0.6
|
||||||
, configurator-pg >= 0.2 && < 0.3
|
, configurator-pg >= 0.2 && < 0.3
|
||||||
, containers >= 0.5.7 && < 0.7
|
, containers >= 0.5.7 && < 0.7
|
||||||
, contravariant >= 1.4 && < 1.6
|
|
||||||
, contravariant-extras >= 0.3.3 && < 0.4
|
, contravariant-extras >= 0.3.3 && < 0.4
|
||||||
, cookie >= 0.4.2 && < 0.5
|
, cookie >= 0.4.2 && < 0.5
|
||||||
, either >= 4.4.1 && < 5.1
|
, either >= 4.4.1 && < 5.1
|
||||||
, fast-logger >= 2.4.5
|
|
||||||
, gitrev >= 1.2 && < 1.4
|
, gitrev >= 1.2 && < 1.4
|
||||||
, hasql >= 1.4 && < 1.5
|
, hasql >= 1.4 && < 1.6
|
||||||
, hasql-dynamic-statements == 0.3.1
|
, hasql-dynamic-statements >= 0.3.1 && < 0.4
|
||||||
, hasql-notifications >= 0.1 && < 0.3
|
, hasql-notifications >= 0.1 && < 0.3
|
||||||
, hasql-pool >= 0.5 && < 0.6
|
, hasql-pool >= 0.5 && < 0.6
|
||||||
, hasql-transaction >= 1.0.1 && < 1.1
|
, hasql-transaction >= 1.0.1 && < 1.1
|
||||||
@@ -92,28 +94,33 @@ library
|
|||||||
, http-types >= 0.12.2 && < 0.13
|
, http-types >= 0.12.2 && < 0.13
|
||||||
, insert-ordered-containers >= 0.2.2 && < 0.3
|
, insert-ordered-containers >= 0.2.2 && < 0.3
|
||||||
, interpolatedstring-perl6 >= 1 && < 1.1
|
, interpolatedstring-perl6 >= 1 && < 1.1
|
||||||
, jose >= 0.8.1 && < 0.9
|
, jose >= 0.8.5.1 && < 0.10
|
||||||
, lens >= 4.14 && < 5.1
|
, lens >= 4.14 && < 5.2
|
||||||
, lens-aeson >= 1.0.1 && < 1.2
|
, lens-aeson >= 1.0.1 && < 1.2
|
||||||
, mtl >= 2.2.2 && < 2.3
|
, mtl >= 2.2.2 && < 2.3
|
||||||
|
, network >= 2.6 && < 3.2
|
||||||
, network-uri >= 2.6.1 && < 2.8
|
, network-uri >= 2.6.1 && < 2.8
|
||||||
, optparse-applicative >= 0.13 && < 0.17
|
, optparse-applicative >= 0.13 && < 0.17
|
||||||
, parsec >= 3.1.11 && < 3.2
|
, parsec >= 3.1.11 && < 3.2
|
||||||
, protolude >= 0.3 && < 0.4
|
, protolude >= 0.3.1 && < 0.4
|
||||||
, regex-tdfa >= 1.2.2 && < 1.4
|
, regex-tdfa >= 1.2.2 && < 1.4
|
||||||
, retry >= 0.7.4 && < 0.9
|
, retry >= 0.7.4 && < 0.10
|
||||||
, scientific >= 0.3.4 && < 0.4
|
, scientific >= 0.3.4 && < 0.4
|
||||||
, swagger2 >= 2.4 && < 2.7
|
, swagger2 >= 2.4 && < 2.9
|
||||||
, text >= 1.2.2 && < 1.3
|
, text >= 1.2.2 && < 1.3
|
||||||
, time >= 1.6 && < 1.11
|
, time >= 1.6 && < 1.12
|
||||||
, unordered-containers >= 0.2.8 && < 0.3
|
, unordered-containers >= 0.2.8 && < 0.3
|
||||||
|
, vault >= 0.3.1.5 && < 0.4
|
||||||
, vector >= 0.11 && < 0.13
|
, vector >= 0.11 && < 0.13
|
||||||
, wai >= 3.2.1 && < 3.3
|
, wai >= 3.2.1 && < 3.3
|
||||||
, wai-cors >= 0.2.5 && < 0.3
|
, wai-cors >= 0.2.5 && < 0.3
|
||||||
, wai-extra >= 3.0.19 && < 3.2
|
, wai-extra >= 3.1.8 && < 3.2
|
||||||
, wai-logger >= 2.3.2
|
-- We already depend on wai-logger >= 2.3.7 indirectly via wai-extra,
|
||||||
, wai-middleware-static >= 0.8.1 && < 0.10
|
-- but we want to depend on 2.4.0 which fixes 'unknownSocket' log output
|
||||||
, warp >= 3.2.12 && < 3.4
|
-- for unix sockets; this is tested in test/io/test_io.py. See
|
||||||
|
-- https://github.com/kazu-yamamoto/logger/commit/3a71ca70afdbb93d4ecf0083eeba1fbbbcab3fc3
|
||||||
|
, wai-logger >= 2.4.0
|
||||||
|
, warp >= 3.3.19 && < 3.4
|
||||||
-- -fno-spec-constr may help keep compile time memory use in check,
|
-- -fno-spec-constr may help keep compile time memory use in check,
|
||||||
-- see https://gitlab.haskell.org/ghc/ghc/issues/16017#note_219304
|
-- see https://gitlab.haskell.org/ghc/ghc/issues/16017#note_219304
|
||||||
-- -optP-Wno-nonportable-include-path
|
-- -optP-Wno-nonportable-include-path
|
||||||
@@ -123,7 +130,7 @@ library
|
|||||||
-fno-spec-constr -optP-Wno-nonportable-include-path
|
-fno-spec-constr -optP-Wno-nonportable-include-path
|
||||||
|
|
||||||
if flag(dev)
|
if flag(dev)
|
||||||
ghc-options: -O0
|
ghc-options: -O0 -fwrite-ide-info
|
||||||
if flag(hpc)
|
if flag(hpc)
|
||||||
ghc-options: -fhpc -hpcdir .hpc
|
ghc-options: -fhpc -hpcdir .hpc
|
||||||
else
|
else
|
||||||
@@ -133,7 +140,6 @@ library
|
|||||||
build-depends:
|
build-depends:
|
||||||
unix
|
unix
|
||||||
, directory >= 1.2.6 && < 1.4
|
, directory >= 1.2.6 && < 1.4
|
||||||
, network >= 2.6 && < 3.2
|
|
||||||
exposed-modules:
|
exposed-modules:
|
||||||
PostgREST.Unix
|
PostgREST.Unix
|
||||||
|
|
||||||
@@ -143,16 +149,18 @@ executable postgrest
|
|||||||
NoImplicitPrelude
|
NoImplicitPrelude
|
||||||
hs-source-dirs: main
|
hs-source-dirs: main
|
||||||
main-is: Main.hs
|
main-is: Main.hs
|
||||||
build-depends: base >= 4.9 && < 4.15
|
build-depends: base >= 4.9 && < 4.17
|
||||||
, containers >= 0.5.7 && < 0.7
|
, containers >= 0.5.7 && < 0.7
|
||||||
, postgrest
|
, postgrest
|
||||||
, protolude >= 0.3 && < 0.4
|
, protolude >= 0.3.1 && < 0.4
|
||||||
ghc-options: -threaded -rtsopts "-with-rtsopts=-N -I2"
|
ghc-options: -threaded -rtsopts "-with-rtsopts=-N -I0 -qg"
|
||||||
-O2 -Werror -Wall -fwarn-identities
|
-O2 -Werror -Wall -fwarn-identities
|
||||||
-fno-spec-constr -optP-Wno-nonportable-include-path
|
-fno-spec-constr -optP-Wno-nonportable-include-path
|
||||||
|
|
||||||
if flag(dev)
|
if flag(dev)
|
||||||
ghc-options: -O0
|
ghc-options: -O0 -fwrite-ide-info
|
||||||
|
-- https://github.com/PostgREST/postgrest/issues/387
|
||||||
|
-with-rtsopts=-K1K
|
||||||
if flag(hpc)
|
if flag(hpc)
|
||||||
ghc-options: -fhpc -hpcdir .hpc
|
ghc-options: -fhpc -hpcdir .hpc
|
||||||
else
|
else
|
||||||
@@ -164,118 +172,134 @@ test-suite spec
|
|||||||
default-extensions: OverloadedStrings
|
default-extensions: OverloadedStrings
|
||||||
QuasiQuotes
|
QuasiQuotes
|
||||||
NoImplicitPrelude
|
NoImplicitPrelude
|
||||||
hs-source-dirs: test
|
hs-source-dirs: test/spec
|
||||||
main-is: Main.hs
|
main-is: Main.hs
|
||||||
other-modules: Feature.AndOrParamsSpec
|
other-modules: Feature.Auth.AsymmetricJwtSpec
|
||||||
Feature.AsymmetricJwtSpec
|
Feature.Auth.AudienceJwtSecretSpec
|
||||||
Feature.AudienceJwtSecretSpec
|
Feature.Auth.AuthSpec
|
||||||
Feature.AuthSpec
|
Feature.Auth.BinaryJwtSecretSpec
|
||||||
Feature.BinaryJwtSecretSpec
|
Feature.Auth.NoAnonSpec
|
||||||
|
Feature.Auth.NoJwtSpec
|
||||||
Feature.ConcurrentSpec
|
Feature.ConcurrentSpec
|
||||||
Feature.CorsSpec
|
Feature.CorsSpec
|
||||||
Feature.DeleteSpec
|
|
||||||
Feature.DisabledOpenApiSpec
|
|
||||||
Feature.EmbedDisambiguationSpec
|
|
||||||
Feature.ExtraSearchPathSpec
|
Feature.ExtraSearchPathSpec
|
||||||
Feature.HtmlRawOutputSpec
|
Feature.LegacyGucsSpec
|
||||||
Feature.InsertSpec
|
Feature.OpenApi.DisabledOpenApiSpec
|
||||||
Feature.IgnorePrivOpenApiSpec
|
Feature.OpenApi.IgnorePrivOpenApiSpec
|
||||||
Feature.JsonOperatorSpec
|
Feature.OpenApi.OpenApiSpec
|
||||||
Feature.MultipleSchemaSpec
|
Feature.OpenApi.ProxySpec
|
||||||
Feature.NoJwtSpec
|
Feature.OpenApi.RootSpec
|
||||||
Feature.NonexistentSchemaSpec
|
Feature.OpenApi.SecurityOpenApiSpec
|
||||||
Feature.OpenApiSpec
|
|
||||||
Feature.OptionsSpec
|
Feature.OptionsSpec
|
||||||
Feature.ProxySpec
|
Feature.Query.AndOrParamsSpec
|
||||||
Feature.QueryLimitedSpec
|
Feature.Query.ComputedRelsSpec
|
||||||
Feature.QuerySpec
|
Feature.Query.DeleteSpec
|
||||||
Feature.RangeSpec
|
Feature.Query.EmbedDisambiguationSpec
|
||||||
Feature.RawOutputTypesSpec
|
Feature.Query.EmbedInnerJoinSpec
|
||||||
|
Feature.Query.PlanSpec
|
||||||
|
Feature.Query.HtmlRawOutputSpec
|
||||||
|
Feature.Query.InsertSpec
|
||||||
|
Feature.Query.JsonOperatorSpec
|
||||||
|
Feature.Query.MultipleSchemaSpec
|
||||||
|
Feature.Query.ErrorSpec
|
||||||
|
Feature.Query.PgSafeUpdateSpec
|
||||||
|
Feature.Query.PostGISSpec
|
||||||
|
Feature.Query.QueryLimitedSpec
|
||||||
|
Feature.Query.QuerySpec
|
||||||
|
Feature.Query.RangeSpec
|
||||||
|
Feature.Query.RawOutputTypesSpec
|
||||||
|
Feature.Query.RpcSpec
|
||||||
|
Feature.Query.SingularSpec
|
||||||
|
Feature.Query.UnicodeSpec
|
||||||
|
Feature.Query.UpdateSpec
|
||||||
|
Feature.Query.UpsertSpec
|
||||||
Feature.RollbackSpec
|
Feature.RollbackSpec
|
||||||
Feature.RootSpec
|
|
||||||
Feature.RpcPreRequestGucsSpec
|
Feature.RpcPreRequestGucsSpec
|
||||||
Feature.RpcSpec
|
|
||||||
Feature.SingularSpec
|
|
||||||
Feature.UnicodeSpec
|
|
||||||
Feature.UpdateSpec
|
|
||||||
Feature.UpsertSpec
|
|
||||||
SpecHelper
|
SpecHelper
|
||||||
TestTypes
|
TestTypes
|
||||||
build-depends: base >= 4.9 && < 4.15
|
build-depends: base >= 4.9 && < 4.17
|
||||||
, aeson >= 1.4.7 && < 1.6
|
, aeson >= 2.0.3 && < 2.1
|
||||||
, aeson-qq >= 0.8.1 && < 0.9
|
, aeson-qq >= 0.8.1 && < 0.9
|
||||||
, async >= 2.1.1 && < 2.3
|
, async >= 2.1.1 && < 2.3
|
||||||
, auto-update >= 0.1.4 && < 0.2
|
, auto-update >= 0.1.4 && < 0.2
|
||||||
, base64-bytestring >= 1 && < 1.3
|
, base64-bytestring >= 1 && < 1.3
|
||||||
, bytestring >= 0.10.8 && < 0.11
|
, bytestring >= 0.10.8 && < 0.12
|
||||||
, case-insensitive >= 1.2 && < 1.3
|
, case-insensitive >= 1.2 && < 1.3
|
||||||
, cassava >= 0.4.5 && < 0.6
|
|
||||||
, containers >= 0.5.7 && < 0.7
|
, containers >= 0.5.7 && < 0.7
|
||||||
, contravariant >= 1.4 && < 1.6
|
|
||||||
, hasql >= 1.4 && < 1.5
|
|
||||||
, hasql-pool >= 0.5 && < 0.6
|
, hasql-pool >= 0.5 && < 0.6
|
||||||
, hasql-transaction >= 1.0.1 && < 1.1
|
, hasql-transaction >= 1.0.1 && < 1.1
|
||||||
, heredoc >= 0.2 && < 0.3
|
, heredoc >= 0.2 && < 0.3
|
||||||
, hspec >= 2.3 && < 2.8
|
, hspec >= 2.3 && < 2.9
|
||||||
, hspec-wai >= 0.10 && < 0.12
|
, hspec-wai >= 0.10 && < 0.12
|
||||||
, hspec-wai-json >= 0.10 && < 0.12
|
, hspec-wai-json >= 0.10 && < 0.12
|
||||||
, http-types >= 0.12.3 && < 0.13
|
, http-types >= 0.12.3 && < 0.13
|
||||||
, lens >= 4.14 && < 5.1
|
, lens >= 4.14 && < 5.2
|
||||||
, lens-aeson >= 1.0.1 && < 1.2
|
, lens-aeson >= 1.0.1 && < 1.2
|
||||||
, monad-control >= 1.0.1 && < 1.1
|
, monad-control >= 1.0.1 && < 1.1
|
||||||
, postgrest
|
, postgrest
|
||||||
, process >= 1.4.2 && < 1.7
|
, process >= 1.4.2 && < 1.7
|
||||||
, protolude >= 0.3 && < 0.4
|
, protolude >= 0.3.1 && < 0.4
|
||||||
, regex-tdfa >= 1.2.2 && < 1.4
|
, regex-tdfa >= 1.2.2 && < 1.4
|
||||||
, text >= 1.2.2 && < 1.3
|
, text >= 1.2.2 && < 1.3
|
||||||
, time >= 1.6 && < 1.11
|
|
||||||
, transformers-base >= 0.4.4 && < 0.5
|
, transformers-base >= 0.4.4 && < 0.5
|
||||||
, wai >= 3.2.1 && < 3.3
|
, wai >= 3.2.1 && < 3.3
|
||||||
, wai-extra >= 3.0.19 && < 3.2
|
, wai-extra >= 3.0.19 && < 3.2
|
||||||
ghc-options: -O0 -Werror -Wall -fwarn-identities
|
ghc-options: -O0 -Werror -Wall -fwarn-identities
|
||||||
-fno-spec-constr -optP-Wno-nonportable-include-path
|
-fno-spec-constr -optP-Wno-nonportable-include-path
|
||||||
-fno-warn-missing-signatures
|
-fno-warn-missing-signatures
|
||||||
|
-fwrite-ide-info
|
||||||
|
-- https://github.com/PostgREST/postgrest/issues/387
|
||||||
|
-with-rtsopts=-K33K
|
||||||
|
|
||||||
test-suite spec-querycost
|
test-suite querycost
|
||||||
type: exitcode-stdio-1.0
|
type: exitcode-stdio-1.0
|
||||||
default-language: Haskell2010
|
default-language: Haskell2010
|
||||||
default-extensions: OverloadedStrings
|
default-extensions: OverloadedStrings
|
||||||
QuasiQuotes
|
QuasiQuotes
|
||||||
NoImplicitPrelude
|
NoImplicitPrelude
|
||||||
hs-source-dirs: test
|
hs-source-dirs: test/spec
|
||||||
main-is: QueryCost.hs
|
main-is: QueryCost.hs
|
||||||
other-modules: SpecHelper
|
other-modules: SpecHelper
|
||||||
build-depends: base >= 4.9 && < 4.15
|
build-depends: base >= 4.9 && < 4.17
|
||||||
, aeson >= 1.4.7 && < 1.6
|
, aeson >= 2.0.3 && < 2.1
|
||||||
, aeson-qq >= 0.8.1 && < 0.9
|
, base64-bytestring >= 1 && < 1.3
|
||||||
, async >= 2.1.1 && < 2.3
|
, bytestring >= 0.10.8 && < 0.12
|
||||||
, auto-update >= 0.1.4 && < 0.2
|
, case-insensitive >= 1.2 && < 1.3
|
||||||
, base64-bytestring >= 1 && < 1.3
|
, containers >= 0.5.7 && < 0.7
|
||||||
, bytestring >= 0.10.8 && < 0.11
|
, contravariant >= 1.4 && < 1.6
|
||||||
, case-insensitive >= 1.2 && < 1.3
|
, hasql >= 1.4 && < 1.6
|
||||||
, cassava >= 0.4.5 && < 0.6
|
, hasql-dynamic-statements >= 0.3.1 && < 0.4
|
||||||
, containers >= 0.5.7 && < 0.7
|
, hasql-pool >= 0.5 && < 0.6
|
||||||
, contravariant >= 1.4 && < 1.6
|
, hasql-transaction >= 1.0.1 && < 1.1
|
||||||
, hasql >= 1.4 && < 1.5
|
, heredoc >= 0.2 && < 0.3
|
||||||
, hasql-dynamic-statements == 0.3.1
|
, hspec >= 2.3 && < 2.9
|
||||||
, hasql-pool >= 0.5 && < 0.6
|
, hspec-wai >= 0.10 && < 0.12
|
||||||
, hasql-transaction >= 1.0.1 && < 1.1
|
, hspec-wai-json >= 0.10 && < 0.12
|
||||||
, heredoc >= 0.2 && < 0.3
|
, http-types >= 0.12.3 && < 0.13
|
||||||
, hspec >= 2.3 && < 2.8
|
, lens >= 4.14 && < 5.2
|
||||||
, hspec-wai >= 0.10 && < 0.12
|
, lens-aeson >= 1.0.1 && < 1.2
|
||||||
, hspec-wai-json >= 0.10 && < 0.12
|
, postgrest
|
||||||
, http-types >= 0.12.3 && < 0.13
|
, process >= 1.4.2 && < 1.7
|
||||||
, lens >= 4.14 && < 5.1
|
, protolude >= 0.3.1 && < 0.4
|
||||||
, lens-aeson >= 1.0.1 && < 1.2
|
, regex-tdfa >= 1.2.2 && < 1.4
|
||||||
, monad-control >= 1.0.1 && < 1.1
|
, wai-extra >= 3.0.19 && < 3.2
|
||||||
, postgrest
|
ghc-options: -O0 -Werror -Wall -fwarn-identities
|
||||||
, process >= 1.4.2 && < 1.7
|
-fno-spec-constr -optP-Wno-nonportable-include-path
|
||||||
, protolude >= 0.3 && < 0.4
|
-fwrite-ide-info
|
||||||
, regex-tdfa >= 1.2.2 && < 1.4
|
-- https://github.com/PostgREST/postgrest/issues/387
|
||||||
, text >= 1.2.2 && < 1.3
|
-with-rtsopts=-K1K
|
||||||
, time >= 1.6 && < 1.11
|
|
||||||
, transformers-base >= 0.4.4 && < 0.5
|
test-suite doctests
|
||||||
, wai >= 3.2.1 && < 3.3
|
type: exitcode-stdio-1.0
|
||||||
, wai-extra >= 3.0.19 && < 3.2
|
default-language: Haskell2010
|
||||||
ghc-options: -O0 -Werror -Wall -fwarn-identities
|
default-extensions: OverloadedStrings
|
||||||
-fno-spec-constr -optP-Wno-nonportable-include-path
|
NoImplicitPrelude
|
||||||
|
hs-source-dirs: test/doc
|
||||||
|
main-is: Main.hs
|
||||||
|
build-depends: base >= 4.9 && < 4.17
|
||||||
|
, doctest >= 0.8
|
||||||
|
, postgrest
|
||||||
|
, pretty-simple
|
||||||
|
, protolude >= 0.3.1 && < 0.4
|
||||||
|
ghc-options: -threaded -O0 -Werror -Wall -fwarn-identities
|
||||||
|
-fno-spec-constr -optP-Wno-nonportable-include-path
|
||||||
|
|||||||
@@ -2,39 +2,34 @@
|
|||||||
# disabled by default. You can activate them by passing arguments to nix-shell,
|
# disabled by default. You can activate them by passing arguments to nix-shell,
|
||||||
# e.g.:
|
# e.g.:
|
||||||
#
|
#
|
||||||
# nix-shell --arg release true
|
# nix-shell --arg docker true
|
||||||
#
|
|
||||||
# This will provide you with a shell where the `postgrest-release-*` scripts
|
|
||||||
# are available.
|
|
||||||
#
|
#
|
||||||
# We highly recommend that use the PostgREST binary cache by installing cachix
|
# We highly recommend that use the PostgREST binary cache by installing cachix
|
||||||
# (https://app.cachix.org/) and running `cachix use postgrest`.
|
# (https://app.cachix.org/) and running `cachix use postgrest`.
|
||||||
{ docker ? false
|
{ docker ? false
|
||||||
, memory ? false
|
, memory ? false
|
||||||
, release ? false
|
|
||||||
}:
|
}:
|
||||||
let
|
let
|
||||||
postgrest =
|
postgrest =
|
||||||
import ./default.nix;
|
import ./default.nix { };
|
||||||
|
|
||||||
pkgs =
|
inherit (postgrest) pkgs;
|
||||||
postgrest.pkgs;
|
|
||||||
|
|
||||||
lib =
|
inherit (pkgs) lib;
|
||||||
pkgs.lib;
|
|
||||||
|
|
||||||
toolboxes =
|
toolboxes =
|
||||||
[
|
[
|
||||||
postgrest.cabalTools
|
postgrest.cabalTools
|
||||||
postgrest.devTools
|
postgrest.devTools
|
||||||
|
postgrest.loadtest
|
||||||
postgrest.nixpkgsTools
|
postgrest.nixpkgsTools
|
||||||
postgrest.style
|
postgrest.style
|
||||||
postgrest.tests
|
postgrest.tests
|
||||||
postgrest.withTools
|
postgrest.withTools
|
||||||
|
postgrest.release
|
||||||
]
|
]
|
||||||
++ lib.optional docker postgrest.docker
|
++ lib.optional docker postgrest.docker
|
||||||
++ lib.optional memory postgrest.memory
|
++ lib.optional memory postgrest.memory;
|
||||||
++ lib.optional release postgrest.release;
|
|
||||||
|
|
||||||
in
|
in
|
||||||
lib.overrideDerivation postgrest.env (
|
lib.overrideDerivation postgrest.env (
|
||||||
@@ -43,6 +38,7 @@ lib.overrideDerivation postgrest.env (
|
|||||||
base.buildInputs ++ [
|
base.buildInputs ++ [
|
||||||
pkgs.cabal-install
|
pkgs.cabal-install
|
||||||
pkgs.cabal2nix
|
pkgs.cabal2nix
|
||||||
|
pkgs.git
|
||||||
pkgs.postgresql
|
pkgs.postgresql
|
||||||
postgrest.hsie.bin
|
postgrest.hsie.bin
|
||||||
]
|
]
|
||||||
@@ -50,13 +46,16 @@ lib.overrideDerivation postgrest.env (
|
|||||||
|
|
||||||
shellHook =
|
shellHook =
|
||||||
''
|
''
|
||||||
source ${pkgs.bashCompletion}/etc/profile.d/bash_completion.sh
|
export HISTFILE=.history
|
||||||
source ${postgrest.hsie.bashCompletion}
|
|
||||||
|
source ${pkgs.bash-completion}/etc/profile.d/bash_completion.sh
|
||||||
|
source ${pkgs.git}/share/git/contrib/completion/git-completion.bash
|
||||||
|
source ${postgrest.hsie.bash-completion}
|
||||||
|
|
||||||
''
|
''
|
||||||
+ builtins.concatStringsSep "\n" (
|
+ builtins.concatStringsSep "\n" (
|
||||||
builtins.map (bashCompletion: "source ${bashCompletion}") (
|
builtins.map (bash-completion: "source ${bash-completion}") (
|
||||||
builtins.concatLists (builtins.map (toolbox: toolbox.bashCompletion) toolboxes)
|
builtins.concatLists (builtins.map (toolbox: toolbox.bash-completion) toolboxes)
|
||||||
)
|
)
|
||||||
);
|
);
|
||||||
}
|
}
|
||||||
|
|||||||
@@ -0,0 +1,74 @@
|
|||||||
|
{-# LANGUAGE RecordWildCards #-}
|
||||||
|
module PostgREST.Admin
|
||||||
|
( postgrestAdmin
|
||||||
|
) where
|
||||||
|
|
||||||
|
import qualified Data.Text as T
|
||||||
|
|
||||||
|
import Network.Socket
|
||||||
|
import Network.Socket.ByteString
|
||||||
|
|
||||||
|
import qualified Network.HTTP.Types.Status as HTTP
|
||||||
|
import qualified Network.Wai as Wai
|
||||||
|
|
||||||
|
import qualified Hasql.Session as SQL
|
||||||
|
|
||||||
|
import qualified PostgREST.AppState as AppState
|
||||||
|
import PostgREST.Config (AppConfig (..))
|
||||||
|
|
||||||
|
import Protolude
|
||||||
|
|
||||||
|
-- | PostgREST admin application
|
||||||
|
postgrestAdmin :: AppState.AppState -> AppConfig -> Wai.Application
|
||||||
|
postgrestAdmin appState appConfig req respond = do
|
||||||
|
isMainAppReachable <- any isRight <$> reachMainApp appConfig
|
||||||
|
isSchemaCacheLoaded <- isJust <$> AppState.getDbStructure appState
|
||||||
|
isConnectionUp <-
|
||||||
|
if configDbChannelEnabled appConfig
|
||||||
|
then AppState.getIsListenerOn appState
|
||||||
|
else isRight <$> AppState.usePool appState (SQL.sql "SELECT 1")
|
||||||
|
|
||||||
|
case Wai.pathInfo req of
|
||||||
|
["ready"] ->
|
||||||
|
respond $ Wai.responseLBS (if isMainAppReachable && isConnectionUp && isSchemaCacheLoaded then HTTP.status200 else HTTP.status503) [] mempty
|
||||||
|
["live"] ->
|
||||||
|
respond $ Wai.responseLBS (if isMainAppReachable then HTTP.status200 else HTTP.status503) [] mempty
|
||||||
|
_ ->
|
||||||
|
respond $ Wai.responseLBS HTTP.status404 [] mempty
|
||||||
|
|
||||||
|
-- Try to connect to the main app socket
|
||||||
|
-- Note that it doesn't even send a valid HTTP request, we just want to check that the main app is accepting connections
|
||||||
|
-- The code for resolving the "*4", "!4", "*6", "!6", "*" special values is taken from
|
||||||
|
-- https://hackage.haskell.org/package/streaming-commons-0.2.2.4/docs/src/Data.Streaming.Network.html#bindPortGenEx
|
||||||
|
reachMainApp :: AppConfig -> IO [Either IOException ()]
|
||||||
|
reachMainApp AppConfig{..} =
|
||||||
|
case configServerUnixSocket of
|
||||||
|
Just path -> do
|
||||||
|
sock <- socket AF_UNIX Stream 0
|
||||||
|
(:[]) <$> try (do
|
||||||
|
connect sock $ SockAddrUnix path
|
||||||
|
withSocketsDo $ bracket (pure sock) close sendEmpty)
|
||||||
|
Nothing -> do
|
||||||
|
let
|
||||||
|
host | configServerHost `elem` ["*4", "!4", "*6", "!6", "*"] = Nothing
|
||||||
|
| otherwise = Just configServerHost
|
||||||
|
filterAddrs xs =
|
||||||
|
case configServerHost of
|
||||||
|
"*4" -> ipv4Addrs xs ++ ipv6Addrs xs
|
||||||
|
"!4" -> ipv4Addrs xs
|
||||||
|
"*6" -> ipv6Addrs xs ++ ipv4Addrs xs
|
||||||
|
"!6" -> ipv6Addrs xs
|
||||||
|
_ -> xs
|
||||||
|
ipv4Addrs = filter ((/=) AF_INET6 . addrFamily)
|
||||||
|
ipv6Addrs = filter ((==) AF_INET6 . addrFamily)
|
||||||
|
|
||||||
|
addrs <- getAddrInfo (Just $ defaultHints { addrSocketType = Stream }) (T.unpack <$> host) (Just . show $ configServerPort)
|
||||||
|
tryAddr `traverse` filterAddrs addrs
|
||||||
|
where
|
||||||
|
sendEmpty sock = void $ send sock mempty
|
||||||
|
tryAddr :: AddrInfo -> IO (Either IOException ())
|
||||||
|
tryAddr addr = do
|
||||||
|
sock <- socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr)
|
||||||
|
try $ do
|
||||||
|
connect sock $ addrAddress addr
|
||||||
|
withSocketsDo $ bracket (pure sock) close sendEmpty
|
||||||
+304
-260
@@ -20,18 +20,17 @@ module PostgREST.App
|
|||||||
import Control.Monad.Except (liftEither)
|
import Control.Monad.Except (liftEither)
|
||||||
import Data.Either.Combinators (mapLeft)
|
import Data.Either.Combinators (mapLeft)
|
||||||
import Data.List (union)
|
import Data.List (union)
|
||||||
|
import Data.Maybe (fromJust)
|
||||||
import Data.String (IsString (..))
|
import Data.String (IsString (..))
|
||||||
import Data.Time.Clock (UTCTime)
|
|
||||||
import Network.Wai.Handler.Warp (defaultSettings, setHost, setPort,
|
import Network.Wai.Handler.Warp (defaultSettings, setHost, setPort,
|
||||||
setServerName)
|
setServerName)
|
||||||
import System.Posix.Types (FileMode)
|
import System.Posix.Types (FileMode)
|
||||||
|
|
||||||
import qualified Data.ByteString.Char8 as BS8
|
import qualified Data.ByteString.Char8 as BS
|
||||||
import qualified Data.ByteString.Lazy as LBS
|
import qualified Data.ByteString.Lazy as LBS
|
||||||
import qualified Data.HashMap.Strict as Map
|
import qualified Data.HashMap.Strict as HM
|
||||||
import qualified Data.Set as Set
|
import qualified Data.Set as S
|
||||||
import qualified Hasql.DynamicStatements.Snippet as SQL
|
import qualified Hasql.DynamicStatements.Snippet as SQL (Snippet)
|
||||||
import qualified Hasql.Pool as SQL
|
|
||||||
import qualified Hasql.Transaction as SQL
|
import qualified Hasql.Transaction as SQL
|
||||||
import qualified Hasql.Transaction.Sessions as SQL
|
import qualified Hasql.Transaction.Sessions as SQL
|
||||||
import qualified Network.HTTP.Types.Header as HTTP
|
import qualified Network.HTTP.Types.Header as HTTP
|
||||||
@@ -40,10 +39,13 @@ import qualified Network.HTTP.Types.URI as HTTP
|
|||||||
import qualified Network.Wai as Wai
|
import qualified Network.Wai as Wai
|
||||||
import qualified Network.Wai.Handler.Warp as Warp
|
import qualified Network.Wai.Handler.Warp as Warp
|
||||||
|
|
||||||
|
import qualified PostgREST.Admin as Admin
|
||||||
import qualified PostgREST.AppState as AppState
|
import qualified PostgREST.AppState as AppState
|
||||||
import qualified PostgREST.Auth as Auth
|
import qualified PostgREST.Auth as Auth
|
||||||
|
import qualified PostgREST.Cors as Cors
|
||||||
import qualified PostgREST.DbStructure as DbStructure
|
import qualified PostgREST.DbStructure as DbStructure
|
||||||
import qualified PostgREST.Error as Error
|
import qualified PostgREST.Error as Error
|
||||||
|
import qualified PostgREST.Logger as Logger
|
||||||
import qualified PostgREST.Middleware as Middleware
|
import qualified PostgREST.Middleware as Middleware
|
||||||
import qualified PostgREST.OpenAPI as OpenAPI
|
import qualified PostgREST.OpenAPI as OpenAPI
|
||||||
import qualified PostgREST.Query.QueryBuilder as QueryBuilder
|
import qualified PostgREST.Query.QueryBuilder as QueryBuilder
|
||||||
@@ -51,15 +53,15 @@ import qualified PostgREST.Query.Statements as Statements
|
|||||||
import qualified PostgREST.RangeQuery as RangeQuery
|
import qualified PostgREST.RangeQuery as RangeQuery
|
||||||
import qualified PostgREST.Request.ApiRequest as ApiRequest
|
import qualified PostgREST.Request.ApiRequest as ApiRequest
|
||||||
import qualified PostgREST.Request.DbRequestBuilder as ReqBuilder
|
import qualified PostgREST.Request.DbRequestBuilder as ReqBuilder
|
||||||
|
import qualified PostgREST.Request.Types as ApiRequestTypes
|
||||||
|
|
||||||
import PostgREST.AppState (AppState)
|
import PostgREST.AppState (AppState)
|
||||||
|
import PostgREST.Auth (AuthResult (..))
|
||||||
import PostgREST.Config (AppConfig (..),
|
import PostgREST.Config (AppConfig (..),
|
||||||
LogLevel (..),
|
LogLevel (..),
|
||||||
OpenAPIMode (..))
|
OpenAPIMode (..))
|
||||||
import PostgREST.Config.PgVersion (PgVersion (..))
|
import PostgREST.Config.PgVersion (PgVersion (..))
|
||||||
import PostgREST.ContentType (ContentType (..))
|
import PostgREST.DbStructure (DbStructure (..))
|
||||||
import PostgREST.DbStructure (DbStructure (..),
|
|
||||||
tablePKCols)
|
|
||||||
import PostgREST.DbStructure.Identifiers (FieldName,
|
import PostgREST.DbStructure.Identifiers (FieldName,
|
||||||
QualifiedIdentifier (..),
|
QualifiedIdentifier (..),
|
||||||
Schema)
|
Schema)
|
||||||
@@ -70,23 +72,26 @@ import PostgREST.Error (Error)
|
|||||||
import PostgREST.GucHeader (GucHeader,
|
import PostgREST.GucHeader (GucHeader,
|
||||||
addHeadersIfNotIncluded,
|
addHeadersIfNotIncluded,
|
||||||
unwrapGucHeader)
|
unwrapGucHeader)
|
||||||
|
import PostgREST.MediaType (MTPlanAttrs (..),
|
||||||
|
MediaType (..))
|
||||||
|
import PostgREST.Query.Statements (ResultSet (..))
|
||||||
import PostgREST.Request.ApiRequest (Action (..),
|
import PostgREST.Request.ApiRequest (Action (..),
|
||||||
ApiRequest (..),
|
ApiRequest (..),
|
||||||
InvokeMethod (..),
|
InvokeMethod (..),
|
||||||
Target (..))
|
Mutation (..), Target (..))
|
||||||
import PostgREST.Request.Preferences (PreferCount (..),
|
import PostgREST.Request.Preferences (PreferCount (..),
|
||||||
PreferParameters (..),
|
PreferParameters (..),
|
||||||
PreferRepresentation (..))
|
PreferRepresentation (..),
|
||||||
import PostgREST.Request.Types (ReadRequest, fstFieldNames)
|
toAppliedHeader)
|
||||||
|
import PostgREST.Request.QueryParams (QueryParams (..))
|
||||||
|
import PostgREST.Request.ReadQuery (ReadRequest, fstFieldNames)
|
||||||
import PostgREST.Version (prettyVersion)
|
import PostgREST.Version (prettyVersion)
|
||||||
import PostgREST.Workers (connectionWorker, listener)
|
import PostgREST.Workers (connectionWorker, listener)
|
||||||
|
|
||||||
import qualified PostgREST.ContentType as ContentType
|
|
||||||
import qualified PostgREST.DbStructure.Proc as Proc
|
import qualified PostgREST.DbStructure.Proc as Proc
|
||||||
|
import qualified PostgREST.MediaType as MediaType
|
||||||
|
|
||||||
import Protolude hiding (Handler, toS)
|
import Protolude hiding (Handler)
|
||||||
import Protolude.Conv (toS)
|
|
||||||
|
|
||||||
|
|
||||||
data RequestContext = RequestContext
|
data RequestContext = RequestContext
|
||||||
{ ctxConfig :: AppConfig
|
{ ctxConfig :: AppConfig
|
||||||
@@ -113,6 +118,11 @@ run installHandlers maybeRunWithSocket appState = do
|
|||||||
when configDbChannelEnabled $ listener appState
|
when configDbChannelEnabled $ listener appState
|
||||||
|
|
||||||
let app = postgrest configLogLevel appState (connectionWorker appState)
|
let app = postgrest configLogLevel appState (connectionWorker appState)
|
||||||
|
adminApp = Admin.postgrestAdmin appState conf
|
||||||
|
|
||||||
|
whenJust configAdminServerPort $ \adminPort -> do
|
||||||
|
AppState.logWithZTime appState $ "Admin server listening on port " <> show adminPort
|
||||||
|
void . forkIO $ Warp.runSettings (serverSettings conf & setPort adminPort) adminApp
|
||||||
|
|
||||||
case configServerUnixSocket of
|
case configServerUnixSocket of
|
||||||
Just socket ->
|
Just socket ->
|
||||||
@@ -122,54 +132,68 @@ run installHandlers maybeRunWithSocket appState = do
|
|||||||
AppState.logWithZTime appState $ "Listening on unix socket " <> show socket
|
AppState.logWithZTime appState $ "Listening on unix socket " <> show socket
|
||||||
runWithSocket (serverSettings conf) app configServerUnixSocketMode socket
|
runWithSocket (serverSettings conf) app configServerUnixSocketMode socket
|
||||||
Nothing ->
|
Nothing ->
|
||||||
panic "Cannot run with socket on non-unix plattforms."
|
panic "Cannot run with unix socket on non-unix platforms."
|
||||||
Nothing ->
|
Nothing ->
|
||||||
do
|
do
|
||||||
AppState.logWithZTime appState $ "Listening on port " <> show configServerPort
|
AppState.logWithZTime appState $ "Listening on port " <> show configServerPort
|
||||||
Warp.runSettings (serverSettings conf) app
|
Warp.runSettings (serverSettings conf) app
|
||||||
|
where
|
||||||
|
whenJust :: Applicative m => Maybe a -> (a -> m ()) -> m ()
|
||||||
|
whenJust mg f = maybe (pure ()) f mg
|
||||||
|
|
||||||
serverSettings :: AppConfig -> Warp.Settings
|
serverSettings :: AppConfig -> Warp.Settings
|
||||||
serverSettings AppConfig{..} =
|
serverSettings AppConfig{..} =
|
||||||
defaultSettings
|
defaultSettings
|
||||||
& setHost (fromString $ toS configServerHost)
|
& setHost (fromString $ toS configServerHost)
|
||||||
& setPort configServerPort
|
& setPort configServerPort
|
||||||
& setServerName (toS $ "postgrest/" <> prettyVersion)
|
& setServerName ("postgrest/" <> prettyVersion)
|
||||||
|
|
||||||
-- | PostgREST application
|
-- | PostgREST application
|
||||||
postgrest :: LogLevel -> AppState.AppState -> IO () -> Wai.Application
|
postgrest :: LogLevel -> AppState.AppState -> IO () -> Wai.Application
|
||||||
postgrest logLev appState connWorker =
|
postgrest logLevel appState connWorker =
|
||||||
Middleware.pgrstMiddleware logLev $
|
Cors.middleware .
|
||||||
\req respond -> do
|
Auth.middleware appState .
|
||||||
time <- AppState.getTime appState
|
Logger.middleware logLevel $
|
||||||
conf <- AppState.getConfig appState
|
-- fromJust can be used, because the auth middleware will **always** add
|
||||||
maybeDbStructure <- AppState.getDbStructure appState
|
-- some AuthResult to the vault.
|
||||||
pgVer <- AppState.getPgVersion appState
|
\req respond -> case fromJust $ Auth.getResult req of
|
||||||
jsonDbS <- AppState.getJsonDbS appState
|
Left err -> respond $ Error.errorResponseFor err
|
||||||
|
Right authResult -> do
|
||||||
|
conf <- AppState.getConfig appState
|
||||||
|
maybeDbStructure <- AppState.getDbStructure appState
|
||||||
|
pgVer <- AppState.getPgVersion appState
|
||||||
|
jsonDbS <- AppState.getJsonDbS appState
|
||||||
|
|
||||||
let
|
let
|
||||||
eitherResponse :: IO (Either Error Wai.Response)
|
eitherResponse :: IO (Either Error Wai.Response)
|
||||||
eitherResponse =
|
eitherResponse =
|
||||||
runExceptT $ postgrestResponse conf maybeDbStructure jsonDbS pgVer (AppState.getPool appState) time req
|
runExceptT $ postgrestResponse appState conf maybeDbStructure jsonDbS pgVer authResult req
|
||||||
|
|
||||||
response <- either Error.errorResponseFor identity <$> eitherResponse
|
response <- either Error.errorResponseFor identity <$> eitherResponse
|
||||||
|
-- Launch the connWorker when the connection is down. The postgrest
|
||||||
|
-- function can respond successfully (with a stale schema cache) before
|
||||||
|
-- the connWorker is done.
|
||||||
|
let isPGAway = Wai.responseStatus response == HTTP.status503
|
||||||
|
when isPGAway connWorker
|
||||||
|
resp <- addRetryHint isPGAway appState response
|
||||||
|
respond resp
|
||||||
|
|
||||||
-- Launch the connWorker when the connection is down. The postgrest
|
addRetryHint :: Bool -> AppState -> Wai.Response -> IO Wai.Response
|
||||||
-- function can respond successfully (with a stale schema cache) before
|
addRetryHint shouldAdd appState response = do
|
||||||
-- the connWorker is done.
|
delay <- AppState.getRetryNextIn appState
|
||||||
when (Wai.responseStatus response == HTTP.status503) connWorker
|
let h = ("Retry-After", BS.pack $ show delay)
|
||||||
|
return $ Wai.mapResponseHeaders (\hs -> if shouldAdd then h:hs else hs) response
|
||||||
respond response
|
|
||||||
|
|
||||||
postgrestResponse
|
postgrestResponse
|
||||||
:: AppConfig
|
:: AppState.AppState
|
||||||
|
-> AppConfig
|
||||||
-> Maybe DbStructure
|
-> Maybe DbStructure
|
||||||
-> ByteString
|
-> ByteString
|
||||||
-> PgVersion
|
-> PgVersion
|
||||||
-> SQL.Pool
|
-> AuthResult
|
||||||
-> UTCTime
|
|
||||||
-> Wai.Request
|
-> Wai.Request
|
||||||
-> Handler IO Wai.Response
|
-> Handler IO Wai.Response
|
||||||
postgrestResponse conf maybeDbStructure jsonDbS pgVer pool time req = do
|
postgrestResponse appState conf@AppConfig{..} maybeDbStructure jsonDbS pgVer AuthResult{..} req = do
|
||||||
body <- lift $ Wai.strictRequestBody req
|
body <- lift $ Wai.strictRequestBody req
|
||||||
|
|
||||||
dbStructure <-
|
dbStructure <-
|
||||||
@@ -177,32 +201,30 @@ postgrestResponse conf maybeDbStructure jsonDbS pgVer pool time req = do
|
|||||||
Just dbStructure ->
|
Just dbStructure ->
|
||||||
return dbStructure
|
return dbStructure
|
||||||
Nothing ->
|
Nothing ->
|
||||||
throwError Error.ConnectionLostError
|
throwError Error.NoSchemaCacheError
|
||||||
|
|
||||||
apiRequest@ApiRequest{..} <-
|
apiRequest <-
|
||||||
liftEither . mapLeft Error.ApiRequestError $
|
liftEither . mapLeft Error.ApiRequestError $
|
||||||
ApiRequest.userApiRequest conf dbStructure req body
|
ApiRequest.userApiRequest conf dbStructure req body
|
||||||
|
|
||||||
-- The JWT must be checked before touching the db
|
let ctx apiReq = RequestContext conf dbStructure apiReq pgVer
|
||||||
jwtClaims <- Auth.jwtClaims conf (toS iJWT) time
|
|
||||||
|
|
||||||
let
|
if iAction apiRequest == ActionInfo then
|
||||||
handleReq apiReq =
|
handleInfo (iTarget apiRequest) (ctx apiRequest)
|
||||||
handleRequest $ RequestContext conf dbStructure apiReq pgVer
|
else
|
||||||
|
runDbHandler appState (txMode apiRequest) (Just authRole /= configDbAnonRole) configDbPreparedStatements .
|
||||||
|
Middleware.optionalRollback conf apiRequest $
|
||||||
|
Middleware.runPgLocals conf authClaims authRole (handleRequest . ctx) apiRequest jsonDbS pgVer
|
||||||
|
|
||||||
runDbHandler pool (txMode apiRequest) jwtClaims (configDbPreparedStatements conf) .
|
runDbHandler :: AppState.AppState -> SQL.Mode -> Bool -> Bool -> DbHandler b -> Handler IO b
|
||||||
Middleware.optionalRollback conf apiRequest $
|
runDbHandler appState mode authenticated prepared handler = do
|
||||||
Middleware.runPgLocals conf jwtClaims handleReq apiRequest jsonDbS
|
|
||||||
|
|
||||||
runDbHandler :: SQL.Pool -> SQL.Mode -> Auth.JWTClaims -> Bool -> DbHandler a -> Handler IO a
|
|
||||||
runDbHandler pool mode jwtClaims prepared handler = do
|
|
||||||
dbResp <-
|
dbResp <-
|
||||||
let transaction = if prepared then SQL.transaction else SQL.unpreparedTransaction in
|
let transaction = if prepared then SQL.transaction else SQL.unpreparedTransaction in
|
||||||
lift . SQL.use pool . transaction SQL.ReadCommitted mode $ runExceptT handler
|
lift . AppState.usePool appState . transaction SQL.ReadCommitted mode $ runExceptT handler
|
||||||
|
|
||||||
resp <-
|
resp <-
|
||||||
liftEither . mapLeft Error.PgErr $
|
liftEither . mapLeft Error.PgErr $
|
||||||
mapLeft (Error.PgError $ Auth.containsRole jwtClaims) dbResp
|
mapLeft (Error.PgError authenticated) dbResp
|
||||||
|
|
||||||
liftEither resp
|
liftEither resp
|
||||||
|
|
||||||
@@ -211,22 +233,22 @@ handleRequest context@(RequestContext _ _ ApiRequest{..} _) =
|
|||||||
case (iAction, iTarget) of
|
case (iAction, iTarget) of
|
||||||
(ActionRead headersOnly, TargetIdent identifier) ->
|
(ActionRead headersOnly, TargetIdent identifier) ->
|
||||||
handleRead headersOnly identifier context
|
handleRead headersOnly identifier context
|
||||||
(ActionCreate, TargetIdent identifier) ->
|
(ActionMutate MutationCreate, TargetIdent identifier) ->
|
||||||
handleCreate identifier context
|
handleCreate identifier context
|
||||||
(ActionUpdate, TargetIdent identifier) ->
|
(ActionMutate MutationUpdate, TargetIdent identifier) ->
|
||||||
handleUpdate identifier context
|
handleUpdate identifier context
|
||||||
(ActionSingleUpsert, TargetIdent identifier) ->
|
(ActionMutate MutationSingleUpsert, TargetIdent identifier) ->
|
||||||
handleSingleUpsert identifier context
|
handleSingleUpsert identifier context
|
||||||
(ActionDelete, TargetIdent identifier) ->
|
(ActionMutate MutationDelete, TargetIdent identifier) ->
|
||||||
handleDelete identifier context
|
handleDelete identifier context
|
||||||
(ActionInfo, TargetIdent identifier) ->
|
|
||||||
handleInfo identifier context
|
|
||||||
(ActionInvoke invMethod, TargetProc proc _) ->
|
(ActionInvoke invMethod, TargetProc proc _) ->
|
||||||
handleInvoke invMethod proc context
|
handleInvoke invMethod proc context
|
||||||
(ActionInspect headersOnly, TargetDefaultSpec tSchema) ->
|
(ActionInspect headersOnly, TargetDefaultSpec tSchema) ->
|
||||||
handleOpenApi headersOnly tSchema context
|
handleOpenApi headersOnly tSchema context
|
||||||
_ ->
|
_ ->
|
||||||
throwError Error.NotFound
|
-- This is unreachable as the ApiRequest.hs rejects it before
|
||||||
|
-- TODO Refactor the Action/Target types to remove this line
|
||||||
|
throwError $ Error.ApiRequestError ApiRequestTypes.NotFound
|
||||||
|
|
||||||
handleRead :: Bool -> QualifiedIdentifier -> RequestContext -> DbHandler Wai.Response
|
handleRead :: Bool -> QualifiedIdentifier -> RequestContext -> DbHandler Wai.Response
|
||||||
handleRead headersOnly identifier context@RequestContext{..} = do
|
handleRead headersOnly identifier context@RequestContext{..} = do
|
||||||
@@ -238,9 +260,9 @@ handleRead headersOnly identifier context@RequestContext{..} = do
|
|||||||
AppConfig{..} = ctxConfig
|
AppConfig{..} = ctxConfig
|
||||||
countQuery = QueryBuilder.readRequestToCountQuery req
|
countQuery = QueryBuilder.readRequestToCountQuery req
|
||||||
|
|
||||||
(tableTotal, queryTotal, _ , body, gucHeaders, gucStatus) <-
|
resultSet <-
|
||||||
lift . SQL.statement mempty $
|
lift . SQL.statement mempty $
|
||||||
Statements.createReadStatement
|
Statements.prepareRead
|
||||||
(QueryBuilder.readRequestToQuery req)
|
(QueryBuilder.readRequestToQuery req)
|
||||||
(if iPreferCount == Just EstimatedCount then
|
(if iPreferCount == Just EstimatedCount then
|
||||||
-- LIMIT maxRows + 1 so we can determine below that maxRows was surpassed
|
-- LIMIT maxRows + 1 so we can determine below that maxRows was surpassed
|
||||||
@@ -248,30 +270,33 @@ handleRead headersOnly identifier context@RequestContext{..} = do
|
|||||||
else
|
else
|
||||||
countQuery
|
countQuery
|
||||||
)
|
)
|
||||||
(iAcceptContentType == CTSingularJSON)
|
|
||||||
(shouldCount iPreferCount)
|
(shouldCount iPreferCount)
|
||||||
(iAcceptContentType == CTTextCSV)
|
iAcceptMediaType
|
||||||
bField
|
bField
|
||||||
ctxPgVersion
|
|
||||||
configDbPreparedStatements
|
configDbPreparedStatements
|
||||||
|
|
||||||
total <- readTotal ctxConfig ctxApiRequest tableTotal countQuery
|
case resultSet of
|
||||||
response <- liftEither $ gucResponse <$> gucStatus <*> gucHeaders
|
RSStandard{..} -> do
|
||||||
|
total <- readTotal ctxConfig ctxApiRequest rsTableTotal countQuery
|
||||||
|
response <- liftEither $ gucResponse <$> rsGucStatus <*> rsGucHeaders
|
||||||
|
|
||||||
let
|
let
|
||||||
(status, contentRange) = RangeQuery.rangeStatusHeader iTopLevelRange queryTotal total
|
(status, contentRange) = RangeQuery.rangeStatusHeader iTopLevelRange rsQueryTotal total
|
||||||
headers =
|
headers =
|
||||||
[ contentRange
|
[ contentRange
|
||||||
, ( "Content-Location"
|
, ( "Content-Location"
|
||||||
, "/"
|
, "/"
|
||||||
<> toS (qiName identifier)
|
<> toUtf8 (qiName identifier)
|
||||||
<> if BS8.null iCanonicalQS then mempty else "?" <> toS iCanonicalQS
|
<> if BS.null (qsCanonical iQueryParams) then mempty else "?" <> qsCanonical iQueryParams
|
||||||
)
|
)
|
||||||
]
|
]
|
||||||
++ contentTypeHeaders context
|
++ contentTypeHeaders context
|
||||||
|
|
||||||
failNotSingular iAcceptContentType queryTotal . response status headers $
|
failNotSingular iAcceptMediaType rsQueryTotal . response status headers $
|
||||||
if headersOnly then mempty else toS body
|
if headersOnly then mempty else LBS.fromStrict rsBody
|
||||||
|
|
||||||
|
RSPlan plan ->
|
||||||
|
pure $ Wai.responseLBS HTTP.status200 (contentTypeHeaders context) $ LBS.fromStrict plan
|
||||||
|
|
||||||
readTotal :: AppConfig -> ApiRequest -> Maybe Int64 -> SQL.Snippet -> DbHandler (Maybe Int64)
|
readTotal :: AppConfig -> ApiRequest -> Maybe Int64 -> SQL.Snippet -> DbHandler (Maybe Int64)
|
||||||
readTotal AppConfig{..} ApiRequest{..} tableTotal countQuery =
|
readTotal AppConfig{..} ApiRequest{..} tableTotal countQuery =
|
||||||
@@ -287,131 +312,159 @@ readTotal AppConfig{..} ApiRequest{..} tableTotal countQuery =
|
|||||||
return tableTotal
|
return tableTotal
|
||||||
where
|
where
|
||||||
explain =
|
explain =
|
||||||
lift . SQL.statement mempty . Statements.createExplainStatement countQuery $
|
lift . SQL.statement mempty . Statements.preparePlanRows countQuery $
|
||||||
configDbPreparedStatements
|
configDbPreparedStatements
|
||||||
|
|
||||||
handleCreate :: QualifiedIdentifier -> RequestContext -> DbHandler Wai.Response
|
handleCreate :: QualifiedIdentifier -> RequestContext -> DbHandler Wai.Response
|
||||||
handleCreate identifier@QualifiedIdentifier{..} context@RequestContext{..} = do
|
handleCreate identifier@QualifiedIdentifier{..} context@RequestContext{..} = do
|
||||||
let
|
let
|
||||||
ApiRequest{..} = ctxApiRequest
|
ApiRequest{..} = ctxApiRequest
|
||||||
pkCols = tablePKCols ctxDbStructure qiSchema qiName
|
pkCols = if iPreferRepresentation /= None || isJust iPreferResolution
|
||||||
|
then maybe mempty tablePKCols $ HM.lookup identifier $ dbTables ctxDbStructure
|
||||||
|
else mempty
|
||||||
|
|
||||||
WriteQueryResult{..} <- writeQuery identifier True pkCols context
|
resultSet <- writeQuery MutationCreate identifier True pkCols context
|
||||||
|
|
||||||
let
|
case resultSet of
|
||||||
response = gucResponse resGucStatus resGucHeaders
|
RSStandard{..} -> do
|
||||||
headers =
|
|
||||||
catMaybes
|
|
||||||
[ if null resFields then
|
|
||||||
Nothing
|
|
||||||
else
|
|
||||||
Just
|
|
||||||
( HTTP.hLocation
|
|
||||||
, "/"
|
|
||||||
<> toS qiName
|
|
||||||
<> HTTP.renderSimpleQuery True (splitKeyValue <$> resFields)
|
|
||||||
)
|
|
||||||
, Just . RangeQuery.contentRangeH 1 0 $
|
|
||||||
if shouldCount iPreferCount then Just resQueryTotal else Nothing
|
|
||||||
, if null pkCols && isNothing iOnConflict then
|
|
||||||
Nothing
|
|
||||||
else
|
|
||||||
(\x -> ("Preference-Applied", BS8.pack $ show x)) <$> iPreferResolution
|
|
||||||
]
|
|
||||||
|
|
||||||
failNotSingular iAcceptContentType resQueryTotal $
|
response <- liftEither $ gucResponse <$> rsGucStatus <*> rsGucHeaders
|
||||||
if iPreferRepresentation == Full then
|
|
||||||
response HTTP.status201 (headers ++ contentTypeHeaders context) (toS resBody)
|
let
|
||||||
else
|
headers =
|
||||||
response HTTP.status201 headers mempty
|
catMaybes
|
||||||
|
[ if null rsLocation then
|
||||||
|
Nothing
|
||||||
|
else
|
||||||
|
Just
|
||||||
|
( HTTP.hLocation
|
||||||
|
, "/"
|
||||||
|
<> toUtf8 qiName
|
||||||
|
<> HTTP.renderSimpleQuery True rsLocation
|
||||||
|
)
|
||||||
|
, Just . RangeQuery.contentRangeH 1 0 $
|
||||||
|
if shouldCount iPreferCount then Just rsQueryTotal else Nothing
|
||||||
|
, if null pkCols && isNothing (qsOnConflict iQueryParams) then
|
||||||
|
Nothing
|
||||||
|
else
|
||||||
|
toAppliedHeader <$> iPreferResolution
|
||||||
|
]
|
||||||
|
|
||||||
|
failNotSingular iAcceptMediaType rsQueryTotal $
|
||||||
|
if iPreferRepresentation == Full then
|
||||||
|
response HTTP.status201 (headers ++ contentTypeHeaders context) (LBS.fromStrict rsBody)
|
||||||
|
else
|
||||||
|
response HTTP.status201 headers mempty
|
||||||
|
|
||||||
|
RSPlan plan ->
|
||||||
|
pure $ Wai.responseLBS HTTP.status200 (contentTypeHeaders context) $ LBS.fromStrict plan
|
||||||
|
|
||||||
handleUpdate :: QualifiedIdentifier -> RequestContext -> DbHandler Wai.Response
|
handleUpdate :: QualifiedIdentifier -> RequestContext -> DbHandler Wai.Response
|
||||||
handleUpdate identifier context@(RequestContext _ _ ApiRequest{..} _) = do
|
handleUpdate identifier context@(RequestContext _ _ ApiRequest{..} _) = do
|
||||||
WriteQueryResult{..} <- writeQuery identifier False mempty context
|
resultSet <- writeQuery MutationUpdate identifier False mempty context
|
||||||
|
|
||||||
let
|
case resultSet of
|
||||||
response = gucResponse resGucStatus resGucHeaders
|
RSStandard{..} -> do
|
||||||
fullRepr = iPreferRepresentation == Full
|
response <- liftEither $ gucResponse <$> rsGucStatus <*> rsGucHeaders
|
||||||
updateIsNoOp = Set.null iColumns
|
|
||||||
status
|
|
||||||
| resQueryTotal == 0 && not updateIsNoOp = HTTP.status404
|
|
||||||
| fullRepr = HTTP.status200
|
|
||||||
| otherwise = HTTP.status204
|
|
||||||
contentRangeHeader =
|
|
||||||
RangeQuery.contentRangeH 0 (resQueryTotal - 1) $
|
|
||||||
if shouldCount iPreferCount then Just resQueryTotal else Nothing
|
|
||||||
|
|
||||||
failNotSingular iAcceptContentType resQueryTotal $
|
let
|
||||||
if fullRepr then
|
fullRepr = iPreferRepresentation == Full
|
||||||
response status (contentTypeHeaders context ++ [contentRangeHeader]) (toS resBody)
|
updateIsNoOp = S.null iColumns
|
||||||
else
|
status
|
||||||
response status [contentRangeHeader] mempty
|
| rsQueryTotal == 0 && not updateIsNoOp = HTTP.status404
|
||||||
|
| fullRepr = HTTP.status200
|
||||||
|
| otherwise = HTTP.status204
|
||||||
|
contentRangeHeader =
|
||||||
|
RangeQuery.contentRangeH 0 (rsQueryTotal - 1) $
|
||||||
|
if shouldCount iPreferCount then Just rsQueryTotal else Nothing
|
||||||
|
|
||||||
|
failChangesOffLimits (RangeQuery.rangeLimit iTopLevelRange) rsQueryTotal =<<
|
||||||
|
failNotSingular iAcceptMediaType rsQueryTotal (
|
||||||
|
if fullRepr then
|
||||||
|
response status (contentTypeHeaders context ++ [contentRangeHeader]) (LBS.fromStrict rsBody)
|
||||||
|
else
|
||||||
|
response status [contentRangeHeader] mempty)
|
||||||
|
|
||||||
|
RSPlan plan ->
|
||||||
|
pure $ Wai.responseLBS HTTP.status200 (contentTypeHeaders context) $ LBS.fromStrict plan
|
||||||
|
|
||||||
handleSingleUpsert :: QualifiedIdentifier -> RequestContext-> DbHandler Wai.Response
|
handleSingleUpsert :: QualifiedIdentifier -> RequestContext-> DbHandler Wai.Response
|
||||||
handleSingleUpsert identifier context@(RequestContext _ _ ApiRequest{..} _) = do
|
handleSingleUpsert identifier context@(RequestContext _ ctxDbStructure ApiRequest{..} _) = do
|
||||||
when (iTopLevelRange /= RangeQuery.allRange) $
|
let pkCols = maybe mempty tablePKCols $ HM.lookup identifier $ dbTables ctxDbStructure
|
||||||
throwError Error.PutRangeNotAllowedError
|
|
||||||
|
|
||||||
WriteQueryResult{..} <- writeQuery identifier False mempty context
|
resultSet <- writeQuery MutationSingleUpsert identifier False pkCols context
|
||||||
|
|
||||||
let response = gucResponse resGucStatus resGucHeaders
|
case resultSet of
|
||||||
|
RSStandard {..} -> do
|
||||||
|
|
||||||
-- Makes sure the querystring pk matches the payload pk
|
response <- liftEither $ gucResponse <$> rsGucStatus <*> rsGucHeaders
|
||||||
-- e.g. PUT /items?id=eq.1 { "id" : 1, .. } is accepted,
|
|
||||||
-- PUT /items?id=eq.14 { "id" : 2, .. } is rejected.
|
|
||||||
-- If this condition is not satisfied then nothing is inserted,
|
|
||||||
-- check the WHERE for INSERT in QueryBuilder.hs to see how it's done
|
|
||||||
when (resQueryTotal /= 1) $ do
|
|
||||||
lift SQL.condemn
|
|
||||||
throwError Error.PutMatchingPkError
|
|
||||||
|
|
||||||
return $
|
-- Makes sure the querystring pk matches the payload pk
|
||||||
if iPreferRepresentation == Full then
|
-- e.g. PUT /items?id=eq.1 { "id" : 1, .. } is accepted,
|
||||||
response HTTP.status200 (contentTypeHeaders context) (toS resBody)
|
-- PUT /items?id=eq.14 { "id" : 2, .. } is rejected.
|
||||||
else
|
-- If this condition is not satisfied then nothing is inserted,
|
||||||
response HTTP.status204 (contentTypeHeaders context) mempty
|
-- check the WHERE for INSERT in QueryBuilder.hs to see how it's done
|
||||||
|
when (rsQueryTotal /= 1) $ do
|
||||||
|
lift SQL.condemn
|
||||||
|
throwError Error.PutMatchingPkError
|
||||||
|
|
||||||
|
return $
|
||||||
|
if iPreferRepresentation == Full then
|
||||||
|
response HTTP.status200 (contentTypeHeaders context) (LBS.fromStrict rsBody)
|
||||||
|
else
|
||||||
|
response HTTP.status204 [] mempty
|
||||||
|
|
||||||
|
RSPlan plan ->
|
||||||
|
pure $ Wai.responseLBS HTTP.status200 (contentTypeHeaders context) $ LBS.fromStrict plan
|
||||||
|
|
||||||
handleDelete :: QualifiedIdentifier -> RequestContext -> DbHandler Wai.Response
|
handleDelete :: QualifiedIdentifier -> RequestContext -> DbHandler Wai.Response
|
||||||
handleDelete identifier context@(RequestContext _ _ ApiRequest{..} _) = do
|
handleDelete identifier context@(RequestContext _ _ ApiRequest{..} _) = do
|
||||||
WriteQueryResult{..} <- writeQuery identifier False mempty context
|
resultSet <- writeQuery MutationDelete identifier False mempty context
|
||||||
|
|
||||||
let
|
case resultSet of
|
||||||
response = gucResponse resGucStatus resGucHeaders
|
RSStandard {..} -> do
|
||||||
contentRangeHeader =
|
|
||||||
RangeQuery.contentRangeH 1 0 $
|
|
||||||
if shouldCount iPreferCount then Just resQueryTotal else Nothing
|
|
||||||
|
|
||||||
failNotSingular iAcceptContentType resQueryTotal $
|
response <- liftEither $ gucResponse <$> rsGucStatus <*> rsGucHeaders
|
||||||
if iPreferRepresentation == Full then
|
|
||||||
response HTTP.status200
|
|
||||||
(contentTypeHeaders context ++ [contentRangeHeader])
|
|
||||||
(toS resBody)
|
|
||||||
else
|
|
||||||
response HTTP.status204 [contentRangeHeader] mempty
|
|
||||||
|
|
||||||
handleInfo :: Monad m => QualifiedIdentifier -> RequestContext -> Handler m Wai.Response
|
let
|
||||||
handleInfo identifier RequestContext{..} =
|
contentRangeHeader =
|
||||||
case find tableMatches $ dbTables ctxDbStructure of
|
RangeQuery.contentRangeH 1 0 $
|
||||||
Just table ->
|
if shouldCount iPreferCount then Just rsQueryTotal else Nothing
|
||||||
return $ Wai.responseLBS HTTP.status200 [allOrigins, allowH table] mempty
|
|
||||||
Nothing ->
|
failChangesOffLimits (RangeQuery.rangeLimit iTopLevelRange) rsQueryTotal =<<
|
||||||
throwError Error.NotFound
|
failNotSingular iAcceptMediaType rsQueryTotal (
|
||||||
|
if iPreferRepresentation == Full then
|
||||||
|
response HTTP.status200
|
||||||
|
(contentTypeHeaders context ++ [contentRangeHeader])
|
||||||
|
(LBS.fromStrict rsBody)
|
||||||
|
else
|
||||||
|
response HTTP.status204 [contentRangeHeader] mempty)
|
||||||
|
|
||||||
|
RSPlan plan ->
|
||||||
|
pure $ Wai.responseLBS HTTP.status200 (contentTypeHeaders context) $ LBS.fromStrict plan
|
||||||
|
|
||||||
|
handleInfo :: Monad m => Target -> RequestContext -> Handler m Wai.Response
|
||||||
|
handleInfo target RequestContext{..} =
|
||||||
|
case target of
|
||||||
|
TargetIdent identifier ->
|
||||||
|
case HM.lookup identifier (dbTables ctxDbStructure) of
|
||||||
|
Just tbl -> infoResponse $ allowH tbl
|
||||||
|
Nothing -> throwError $ Error.ApiRequestError ApiRequestTypes.NotFound
|
||||||
|
TargetProc pd _
|
||||||
|
| pdVolatility pd == Volatile -> infoResponse "OPTIONS,POST"
|
||||||
|
| otherwise -> infoResponse "OPTIONS,GET,HEAD,POST"
|
||||||
|
TargetDefaultSpec _ -> infoResponse "OPTIONS,GET,HEAD"
|
||||||
where
|
where
|
||||||
|
infoResponse allowHeader = return $ Wai.responseLBS HTTP.status200 [allOrigins, (HTTP.hAllow, allowHeader)] mempty
|
||||||
allOrigins = ("Access-Control-Allow-Origin", "*")
|
allOrigins = ("Access-Control-Allow-Origin", "*")
|
||||||
allowH table =
|
allowH table =
|
||||||
( HTTP.hAllow
|
let hasPK = not . null $ tablePKCols table in
|
||||||
, BS8.intercalate "," $
|
BS.intercalate "," $
|
||||||
["OPTIONS,GET,HEAD"]
|
["OPTIONS,GET,HEAD"] ++
|
||||||
++ ["POST" | tableInsertable table]
|
["POST" | tableInsertable table] ++
|
||||||
++ ["PUT" | tableInsertable table && tableUpdatable table && hasPK]
|
["PUT" | tableInsertable table && tableUpdatable table && hasPK] ++
|
||||||
++ ["PATCH" | tableUpdatable table]
|
["PATCH" | tableUpdatable table] ++
|
||||||
++ ["DELETE" | tableDeletable table]
|
["DELETE" | tableDeletable table]
|
||||||
)
|
|
||||||
tableMatches table =
|
|
||||||
tableName table == qiName identifier
|
|
||||||
&& tableSchema table == qiSchema identifier
|
|
||||||
hasPK =
|
|
||||||
not $ null $ tablePKCols ctxDbStructure (qiSchema identifier) (qiName identifier)
|
|
||||||
|
|
||||||
handleInvoke :: InvokeMethod -> ProcDescription -> RequestContext -> DbHandler Wai.Response
|
handleInvoke :: InvokeMethod -> ProcDescription -> RequestContext -> DbHandler Wai.Response
|
||||||
handleInvoke invMethod proc context@RequestContext{..} = do
|
handleInvoke invMethod proc context@RequestContext{..} = do
|
||||||
@@ -423,67 +476,64 @@ handleInvoke invMethod proc context@RequestContext{..} = do
|
|||||||
(pdSchema proc)
|
(pdSchema proc)
|
||||||
(fromMaybe (pdName proc) $ Proc.procTableName proc)
|
(fromMaybe (pdName proc) $ Proc.procTableName proc)
|
||||||
|
|
||||||
returnsSingle (ApiRequest.TargetProc target _) = Proc.procReturnsSingle target
|
|
||||||
returnsSingle _ = False
|
|
||||||
|
|
||||||
req <- readRequest identifier context
|
req <- readRequest identifier context
|
||||||
bField <- binaryField context req
|
bField <- binaryField context req
|
||||||
|
|
||||||
(tableTotal, queryTotal, body, gucHeaders, gucStatus) <-
|
let callReq = ReqBuilder.callRequest proc ctxApiRequest req
|
||||||
|
|
||||||
|
resultSet <-
|
||||||
lift . SQL.statement mempty $
|
lift . SQL.statement mempty $
|
||||||
Statements.callProcStatement
|
Statements.prepareCall
|
||||||
(returnsScalar iTarget)
|
(Proc.procReturnsScalar proc)
|
||||||
(returnsSingle iTarget)
|
(Proc.procReturnsSingle proc)
|
||||||
(QueryBuilder.requestToCallProcQuery
|
(QueryBuilder.requestToCallProcQuery callReq)
|
||||||
(QualifiedIdentifier (pdSchema proc) (pdName proc))
|
|
||||||
(Proc.specifiedProcArgs iColumns proc)
|
|
||||||
iPayload
|
|
||||||
(returnsScalar iTarget)
|
|
||||||
iPreferParameters
|
|
||||||
(ReqBuilder.returningCols req [])
|
|
||||||
)
|
|
||||||
(QueryBuilder.readRequestToQuery req)
|
(QueryBuilder.readRequestToQuery req)
|
||||||
(QueryBuilder.readRequestToCountQuery req)
|
(QueryBuilder.readRequestToCountQuery req)
|
||||||
(shouldCount iPreferCount)
|
(shouldCount iPreferCount)
|
||||||
(iAcceptContentType == CTSingularJSON)
|
iAcceptMediaType
|
||||||
(iAcceptContentType == CTTextCSV)
|
|
||||||
(iPreferParameters == Just MultipleObjects)
|
(iPreferParameters == Just MultipleObjects)
|
||||||
bField
|
bField
|
||||||
ctxPgVersion
|
|
||||||
(configDbPreparedStatements ctxConfig)
|
(configDbPreparedStatements ctxConfig)
|
||||||
|
|
||||||
response <- liftEither $ gucResponse <$> gucStatus <*> gucHeaders
|
case resultSet of
|
||||||
|
RSStandard {..} -> do
|
||||||
|
response <- liftEither $ gucResponse <$> rsGucStatus <*> rsGucHeaders
|
||||||
|
let
|
||||||
|
(status, contentRange) =
|
||||||
|
RangeQuery.rangeStatusHeader iTopLevelRange rsQueryTotal rsTableTotal
|
||||||
|
|
||||||
let
|
failNotSingular iAcceptMediaType rsQueryTotal $
|
||||||
(status, contentRange) =
|
if Proc.procReturnsVoid proc then
|
||||||
RangeQuery.rangeStatusHeader iTopLevelRange queryTotal tableTotal
|
response HTTP.status204 [contentRange] mempty
|
||||||
|
else
|
||||||
|
response status
|
||||||
|
(contentTypeHeaders context ++ [contentRange])
|
||||||
|
(if invMethod == InvHead then mempty else LBS.fromStrict rsBody)
|
||||||
|
|
||||||
failNotSingular iAcceptContentType queryTotal $
|
RSPlan plan ->
|
||||||
response status
|
pure $ Wai.responseLBS HTTP.status200 (contentTypeHeaders context) $ LBS.fromStrict plan
|
||||||
(contentTypeHeaders context ++ [contentRange])
|
|
||||||
(if invMethod == InvHead then mempty else toS body)
|
|
||||||
|
|
||||||
handleOpenApi :: Bool -> Schema -> RequestContext -> DbHandler Wai.Response
|
handleOpenApi :: Bool -> Schema -> RequestContext -> DbHandler Wai.Response
|
||||||
handleOpenApi headersOnly tSchema (RequestContext conf@AppConfig{..} dbStructure apiRequest _) = do
|
handleOpenApi headersOnly tSchema (RequestContext conf@AppConfig{..} dbStructure apiRequest ctxPgVersion) = do
|
||||||
body <-
|
body <-
|
||||||
lift $ case configOpenApiMode of
|
lift $ case configOpenApiMode of
|
||||||
OAFollowPriv ->
|
OAFollowPriv ->
|
||||||
OpenAPI.encode conf dbStructure
|
OpenAPI.encode conf dbStructure
|
||||||
<$> SQL.statement tSchema (DbStructure.accessibleTables configDbPreparedStatements)
|
<$> SQL.statement [tSchema] (DbStructure.accessibleTables ctxPgVersion configDbPreparedStatements)
|
||||||
<*> SQL.statement tSchema (DbStructure.accessibleProcs configDbPreparedStatements)
|
<*> SQL.statement tSchema (DbStructure.accessibleProcs ctxPgVersion configDbPreparedStatements)
|
||||||
<*> SQL.statement tSchema (DbStructure.schemaDescription configDbPreparedStatements)
|
<*> SQL.statement tSchema (DbStructure.schemaDescription configDbPreparedStatements)
|
||||||
OAIgnorePriv ->
|
OAIgnorePriv ->
|
||||||
OpenAPI.encode conf dbStructure
|
OpenAPI.encode conf dbStructure
|
||||||
(filter (\x -> tableSchema x == tSchema) $ DbStructure.dbTables dbStructure)
|
(HM.filterWithKey (\(QualifiedIdentifier sch _) _ -> sch == tSchema) $ DbStructure.dbTables dbStructure)
|
||||||
(Map.filterWithKey (\(QualifiedIdentifier sch _) _ -> sch == tSchema) $ DbStructure.dbProcs dbStructure)
|
(HM.filterWithKey (\(QualifiedIdentifier sch _) _ -> sch == tSchema) $ DbStructure.dbProcs dbStructure)
|
||||||
<$> SQL.statement tSchema (DbStructure.schemaDescription configDbPreparedStatements)
|
<$> SQL.statement tSchema (DbStructure.schemaDescription configDbPreparedStatements)
|
||||||
OADisabled ->
|
OADisabled ->
|
||||||
pure mempty
|
pure mempty
|
||||||
|
|
||||||
return $
|
return $
|
||||||
Wai.responseLBS HTTP.status200
|
Wai.responseLBS HTTP.status200
|
||||||
(ContentType.toHeader CTOpenAPI : maybeToList (profileHeader apiRequest))
|
(MediaType.toContentType MTOpenAPI : maybeToList (profileHeader apiRequest))
|
||||||
(if headersOnly then mempty else toS body)
|
(if headersOnly then mempty else body)
|
||||||
|
|
||||||
txMode :: ApiRequest -> SQL.Mode
|
txMode :: ApiRequest -> SQL.Mode
|
||||||
txMode ApiRequest{..} =
|
txMode ApiRequest{..} =
|
||||||
@@ -505,39 +555,25 @@ txMode ApiRequest{..} =
|
|||||||
_ ->
|
_ ->
|
||||||
SQL.Write
|
SQL.Write
|
||||||
|
|
||||||
-- | Result from executing a write query on the database
|
writeQuery :: Mutation -> QualifiedIdentifier -> Bool -> [Text] -> RequestContext -> DbHandler ResultSet
|
||||||
data WriteQueryResult = WriteQueryResult
|
writeQuery mutation identifier@QualifiedIdentifier{..} isInsert pkCols context@RequestContext{..} = do
|
||||||
{ resQueryTotal :: Int64
|
|
||||||
, resFields :: [ByteString]
|
|
||||||
, resBody :: ByteString
|
|
||||||
, resGucStatus :: Maybe HTTP.Status
|
|
||||||
, resGucHeaders :: [GucHeader]
|
|
||||||
}
|
|
||||||
|
|
||||||
writeQuery :: QualifiedIdentifier -> Bool -> [Text] -> RequestContext -> DbHandler WriteQueryResult
|
|
||||||
writeQuery identifier@QualifiedIdentifier{..} isInsert pkCols context@RequestContext{..} = do
|
|
||||||
readReq <- readRequest identifier context
|
readReq <- readRequest identifier context
|
||||||
|
|
||||||
mutateReq <-
|
mutateReq <-
|
||||||
liftEither $
|
liftEither $
|
||||||
ReqBuilder.mutateRequest qiSchema qiName ctxApiRequest
|
ReqBuilder.mutateRequest mutation qiSchema qiName ctxApiRequest
|
||||||
(tablePKCols ctxDbStructure qiSchema qiName)
|
pkCols
|
||||||
readReq
|
readReq
|
||||||
|
|
||||||
(_, queryTotal, fields, body, gucHeaders, gucStatus) <-
|
lift . SQL.statement mempty $
|
||||||
lift . SQL.statement mempty $
|
Statements.prepareWrite
|
||||||
Statements.createWriteStatement
|
(QueryBuilder.readRequestToQuery readReq)
|
||||||
(QueryBuilder.readRequestToQuery readReq)
|
(QueryBuilder.mutateRequestToQuery mutateReq)
|
||||||
(QueryBuilder.mutateRequestToQuery mutateReq)
|
isInsert
|
||||||
(iAcceptContentType ctxApiRequest == CTSingularJSON)
|
(iAcceptMediaType ctxApiRequest)
|
||||||
isInsert
|
(iPreferRepresentation ctxApiRequest)
|
||||||
(iAcceptContentType ctxApiRequest == CTTextCSV)
|
pkCols
|
||||||
(iPreferRepresentation ctxApiRequest)
|
(configDbPreparedStatements ctxConfig)
|
||||||
pkCols
|
|
||||||
ctxPgVersion
|
|
||||||
(configDbPreparedStatements ctxConfig)
|
|
||||||
|
|
||||||
liftEither $ WriteQueryResult queryTotal fields body <$> gucStatus <*> gucHeaders
|
|
||||||
|
|
||||||
-- | Response with headers and status overridden from GUCs.
|
-- | Response with headers and status overridden from GUCs.
|
||||||
gucResponse
|
gucResponse
|
||||||
@@ -554,15 +590,25 @@ gucResponse gucStatus gucHeaders status headers =
|
|||||||
-- |
|
-- |
|
||||||
-- Fail a response if a single JSON object was requested and not exactly one
|
-- Fail a response if a single JSON object was requested and not exactly one
|
||||||
-- was found.
|
-- was found.
|
||||||
failNotSingular :: ContentType -> Int64 -> Wai.Response -> DbHandler Wai.Response
|
failNotSingular :: MediaType -> Int64 -> Wai.Response -> DbHandler Wai.Response
|
||||||
failNotSingular contentType queryTotal response =
|
failNotSingular mediaType queryTotal response =
|
||||||
if contentType == CTSingularJSON && queryTotal /= 1 then
|
if mediaType == MTSingularJSON && queryTotal /= 1 then
|
||||||
do
|
do
|
||||||
lift SQL.condemn
|
lift SQL.condemn
|
||||||
throwError $ Error.singularityError queryTotal
|
throwError $ Error.singularityError queryTotal
|
||||||
else
|
else
|
||||||
return response
|
return response
|
||||||
|
|
||||||
|
failChangesOffLimits :: Maybe Integer -> Int64 -> Wai.Response -> DbHandler Wai.Response
|
||||||
|
failChangesOffLimits (Just maxChanges) queryTotal response =
|
||||||
|
if queryTotal > fromIntegral maxChanges
|
||||||
|
then do
|
||||||
|
lift SQL.condemn
|
||||||
|
throwError $ Error.OffLimitsChangesError queryTotal maxChanges
|
||||||
|
else
|
||||||
|
return response
|
||||||
|
failChangesOffLimits _ _ response = return response
|
||||||
|
|
||||||
shouldCount :: Maybe PreferCount -> Bool
|
shouldCount :: Maybe PreferCount -> Bool
|
||||||
shouldCount preferCount =
|
shouldCount preferCount =
|
||||||
preferCount == Just ExactCount || preferCount == Just EstimatedCount
|
preferCount == Just ExactCount || preferCount == Just EstimatedCount
|
||||||
@@ -580,16 +626,16 @@ readRequest QualifiedIdentifier{..} (RequestContext AppConfig{..} dbStructure ap
|
|||||||
|
|
||||||
contentTypeHeaders :: RequestContext -> [HTTP.Header]
|
contentTypeHeaders :: RequestContext -> [HTTP.Header]
|
||||||
contentTypeHeaders RequestContext{..} =
|
contentTypeHeaders RequestContext{..} =
|
||||||
ContentType.toHeader (iAcceptContentType ctxApiRequest) : maybeToList (profileHeader ctxApiRequest)
|
MediaType.toContentType (iAcceptMediaType ctxApiRequest) : maybeToList (profileHeader ctxApiRequest)
|
||||||
|
|
||||||
-- | If raw(binary) output is requested, check that ContentType is one of the
|
-- | If raw(binary) output is requested, check that MediaType is one of the
|
||||||
-- admitted rawContentTypes and that`?select=...` contains only one field other
|
-- admitted rawMediaTypes and that`?select=...` contains only one field other
|
||||||
-- than `*`
|
-- than `*`
|
||||||
binaryField :: Monad m => RequestContext -> ReadRequest -> Handler m (Maybe FieldName)
|
binaryField :: Monad m => RequestContext -> ReadRequest -> Handler m (Maybe FieldName)
|
||||||
binaryField RequestContext{..} readReq
|
binaryField RequestContext{..} readReq
|
||||||
| returnsScalar (iTarget ctxApiRequest) && iAcceptContentType ctxApiRequest `elem` rawContentTypes ctxConfig =
|
| returnsScalar (iTarget ctxApiRequest) && isRawMediaType =
|
||||||
return $ Just "pgrst_scalar"
|
return $ Just "pgrst_scalar"
|
||||||
| iAcceptContentType ctxApiRequest `elem` rawContentTypes ctxConfig =
|
| isRawMediaType =
|
||||||
let
|
let
|
||||||
fldNames = fstFieldNames readReq
|
fldNames = fstFieldNames readReq
|
||||||
fieldName = headMay fldNames
|
fieldName = headMay fldNames
|
||||||
@@ -597,20 +643,18 @@ binaryField RequestContext{..} readReq
|
|||||||
if length fldNames == 1 && fieldName /= Just "*" then
|
if length fldNames == 1 && fieldName /= Just "*" then
|
||||||
return fieldName
|
return fieldName
|
||||||
else
|
else
|
||||||
throwError $ Error.BinaryFieldError (iAcceptContentType ctxApiRequest)
|
throwError $ Error.BinaryFieldError mediaType
|
||||||
| otherwise =
|
| otherwise =
|
||||||
return Nothing
|
return Nothing
|
||||||
|
where
|
||||||
rawContentTypes :: AppConfig -> [ContentType]
|
mediaType = iAcceptMediaType ctxApiRequest
|
||||||
rawContentTypes AppConfig{..} =
|
isRawMediaType = mediaType `elem` configRawMediaTypes ctxConfig `union` [MTOctetStream, MTTextPlain, MTTextXML] || isRawPlan mediaType
|
||||||
(ContentType.decodeContentType <$> configRawMediaTypes) `union` [CTOctetStream, CTTextPlain]
|
isRawPlan mt = case mt of
|
||||||
|
MTPlan (MTPlanAttrs (Just MTOctetStream) _ _) -> True
|
||||||
|
MTPlan (MTPlanAttrs (Just MTTextPlain) _ _) -> True
|
||||||
|
MTPlan (MTPlanAttrs (Just MTTextXML) _ _) -> True
|
||||||
|
_ -> False
|
||||||
|
|
||||||
profileHeader :: ApiRequest -> Maybe HTTP.Header
|
profileHeader :: ApiRequest -> Maybe HTTP.Header
|
||||||
profileHeader ApiRequest{..} =
|
profileHeader ApiRequest{..} =
|
||||||
(,) "Content-Profile" <$> (toS <$> iProfile)
|
(,) "Content-Profile" <$> (toUtf8 <$> iProfile)
|
||||||
|
|
||||||
splitKeyValue :: ByteString -> (ByteString, ByteString)
|
|
||||||
splitKeyValue kv =
|
|
||||||
(k, BS8.tail v)
|
|
||||||
where
|
|
||||||
(k, v) = BS8.break (== '=') kv
|
|
||||||
|
|||||||
+44
-23
@@ -2,28 +2,33 @@
|
|||||||
|
|
||||||
module PostgREST.AppState
|
module PostgREST.AppState
|
||||||
( AppState
|
( AppState
|
||||||
|
, destroy
|
||||||
, getConfig
|
, getConfig
|
||||||
, getDbStructure
|
, getDbStructure
|
||||||
, getIsWorkerOn
|
, getIsListenerOn
|
||||||
, getJsonDbS
|
, getJsonDbS
|
||||||
, getMainThreadId
|
, getMainThreadId
|
||||||
, getPgVersion
|
, getPgVersion
|
||||||
, getPool
|
, getRetryNextIn
|
||||||
, getTime
|
, getTime
|
||||||
|
, getWorkerSem
|
||||||
, init
|
, init
|
||||||
, initWithPool
|
, initWithPool
|
||||||
, logWithZTime
|
, logWithZTime
|
||||||
, putConfig
|
, putConfig
|
||||||
, putDbStructure
|
, putDbStructure
|
||||||
, putIsWorkerOn
|
, putIsListenerOn
|
||||||
, putJsonDbS
|
, putJsonDbS
|
||||||
, putPgVersion
|
, putPgVersion
|
||||||
|
, putRetryNextIn
|
||||||
, releasePool
|
, releasePool
|
||||||
, signalListener
|
, signalListener
|
||||||
|
, usePool
|
||||||
, waitListener
|
, waitListener
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import qualified Hasql.Pool as P
|
import qualified Hasql.Pool as SQL
|
||||||
|
import qualified Hasql.Session as SQL
|
||||||
|
|
||||||
import Control.AutoUpdate (defaultUpdateSettings, mkAutoUpdate,
|
import Control.AutoUpdate (defaultUpdateSettings, mkAutoUpdate,
|
||||||
updateAction)
|
updateAction)
|
||||||
@@ -37,21 +42,22 @@ import PostgREST.Config (AppConfig (..))
|
|||||||
import PostgREST.Config.PgVersion (PgVersion (..), minimumPgVersion)
|
import PostgREST.Config.PgVersion (PgVersion (..), minimumPgVersion)
|
||||||
import PostgREST.DbStructure (DbStructure)
|
import PostgREST.DbStructure (DbStructure)
|
||||||
|
|
||||||
import Protolude hiding (toS)
|
import Protolude
|
||||||
import Protolude.Conv (toS)
|
|
||||||
|
|
||||||
|
|
||||||
data AppState = AppState
|
data AppState = AppState
|
||||||
{ statePool :: P.Pool -- | Connection pool, either a 'Connection' or a 'ConnectionError'
|
{ statePool :: SQL.Pool -- | Connection pool, either a 'Connection' or a 'ConnectionError'
|
||||||
, statePgVersion :: IORef PgVersion
|
, statePgVersion :: IORef PgVersion
|
||||||
-- | No schema cache at the start. Will be filled in by the connectionWorker
|
-- | No schema cache at the start. Will be filled in by the connectionWorker
|
||||||
, stateDbStructure :: IORef (Maybe DbStructure)
|
, stateDbStructure :: IORef (Maybe DbStructure)
|
||||||
-- | Cached DbStructure in json
|
-- | Cached DbStructure in json
|
||||||
, stateJsonDbS :: IORef ByteString
|
, stateJsonDbS :: IORef ByteString
|
||||||
-- | Helper ref to make sure just one connectionWorker can run at a time
|
-- | Binary semaphore to make sure just one connectionWorker can run at a time
|
||||||
, stateIsWorkerOn :: IORef Bool
|
, stateWorkerSem :: MVar ()
|
||||||
-- | Binary semaphore used to sync the listener(NOTIFY reload) with the connectionWorker.
|
-- | Binary semaphore used to sync the listener(NOTIFY reload) with the connectionWorker.
|
||||||
, stateListener :: MVar ()
|
, stateListener :: MVar ()
|
||||||
|
-- | State of the LISTEN channel, used for the admin server checks
|
||||||
|
, stateIsListenerOn :: IORef Bool
|
||||||
-- | Config that can change at runtime
|
-- | Config that can change at runtime
|
||||||
, stateConf :: IORef AppConfig
|
, stateConf :: IORef AppConfig
|
||||||
-- | Time used for verifying JWT expiration
|
-- | Time used for verifying JWT expiration
|
||||||
@@ -60,6 +66,8 @@ data AppState = AppState
|
|||||||
, stateGetZTime :: IO ZonedTime
|
, stateGetZTime :: IO ZonedTime
|
||||||
-- | Used for killing the main thread in case a subthread fails
|
-- | Used for killing the main thread in case a subthread fails
|
||||||
, stateMainThreadId :: ThreadId
|
, stateMainThreadId :: ThreadId
|
||||||
|
-- | Keeps track of when the next retry for connecting to database is scheduled
|
||||||
|
, stateRetryNextIn :: IORef Int
|
||||||
}
|
}
|
||||||
|
|
||||||
init :: AppConfig -> IO AppState
|
init :: AppConfig -> IO AppState
|
||||||
@@ -67,28 +75,33 @@ init conf = do
|
|||||||
newPool <- initPool conf
|
newPool <- initPool conf
|
||||||
initWithPool newPool conf
|
initWithPool newPool conf
|
||||||
|
|
||||||
initWithPool :: P.Pool -> AppConfig -> IO AppState
|
initWithPool :: SQL.Pool -> AppConfig -> IO AppState
|
||||||
initWithPool newPool conf =
|
initWithPool newPool conf =
|
||||||
AppState newPool
|
AppState newPool
|
||||||
<$> newIORef minimumPgVersion -- assume we're in a supported version when starting, this will be corrected on a later step
|
<$> newIORef minimumPgVersion -- assume we're in a supported version when starting, this will be corrected on a later step
|
||||||
<*> newIORef Nothing
|
<*> newIORef Nothing
|
||||||
<*> newIORef mempty
|
<*> newIORef mempty
|
||||||
<*> newIORef False
|
|
||||||
<*> newEmptyMVar
|
<*> newEmptyMVar
|
||||||
|
<*> newEmptyMVar
|
||||||
|
<*> newIORef False
|
||||||
<*> newIORef conf
|
<*> newIORef conf
|
||||||
<*> mkAutoUpdate defaultUpdateSettings { updateAction = getCurrentTime }
|
<*> mkAutoUpdate defaultUpdateSettings { updateAction = getCurrentTime }
|
||||||
<*> mkAutoUpdate defaultUpdateSettings { updateAction = getZonedTime }
|
<*> mkAutoUpdate defaultUpdateSettings { updateAction = getZonedTime }
|
||||||
<*> myThreadId
|
<*> myThreadId
|
||||||
|
<*> newIORef 0
|
||||||
|
|
||||||
initPool :: AppConfig -> IO P.Pool
|
destroy :: AppState -> IO ()
|
||||||
|
destroy = releasePool
|
||||||
|
|
||||||
|
initPool :: AppConfig -> IO SQL.Pool
|
||||||
initPool AppConfig{..} =
|
initPool AppConfig{..} =
|
||||||
P.acquire (configDbPoolSize, configDbPoolTimeout, toS configDbUri)
|
SQL.acquire (configDbPoolSize, configDbPoolTimeout, toUtf8 configDbUri)
|
||||||
|
|
||||||
getPool :: AppState -> P.Pool
|
usePool :: AppState -> SQL.Session a -> IO (Either SQL.UsageError a)
|
||||||
getPool = statePool
|
usePool AppState{..} = SQL.use statePool
|
||||||
|
|
||||||
releasePool :: AppState -> IO ()
|
releasePool :: AppState -> IO ()
|
||||||
releasePool AppState{..} = P.release statePool >> throwTo stateMainThreadId UserInterrupt
|
releasePool AppState{..} = SQL.release statePool
|
||||||
|
|
||||||
getPgVersion :: AppState -> IO PgVersion
|
getPgVersion :: AppState -> IO PgVersion
|
||||||
getPgVersion = readIORef . statePgVersion
|
getPgVersion = readIORef . statePgVersion
|
||||||
@@ -99,9 +112,8 @@ putPgVersion = atomicWriteIORef . statePgVersion
|
|||||||
getDbStructure :: AppState -> IO (Maybe DbStructure)
|
getDbStructure :: AppState -> IO (Maybe DbStructure)
|
||||||
getDbStructure = readIORef . stateDbStructure
|
getDbStructure = readIORef . stateDbStructure
|
||||||
|
|
||||||
putDbStructure :: AppState -> DbStructure -> IO ()
|
putDbStructure :: AppState -> Maybe DbStructure -> IO ()
|
||||||
putDbStructure appState structure =
|
putDbStructure appState = atomicWriteIORef (stateDbStructure appState)
|
||||||
atomicWriteIORef (stateDbStructure appState) $ Just structure
|
|
||||||
|
|
||||||
getJsonDbS :: AppState -> IO ByteString
|
getJsonDbS :: AppState -> IO ByteString
|
||||||
getJsonDbS = readIORef . stateJsonDbS
|
getJsonDbS = readIORef . stateJsonDbS
|
||||||
@@ -109,11 +121,14 @@ getJsonDbS = readIORef . stateJsonDbS
|
|||||||
putJsonDbS :: AppState -> ByteString -> IO ()
|
putJsonDbS :: AppState -> ByteString -> IO ()
|
||||||
putJsonDbS appState = atomicWriteIORef (stateJsonDbS appState)
|
putJsonDbS appState = atomicWriteIORef (stateJsonDbS appState)
|
||||||
|
|
||||||
getIsWorkerOn :: AppState -> IO Bool
|
getWorkerSem :: AppState -> MVar ()
|
||||||
getIsWorkerOn = readIORef . stateIsWorkerOn
|
getWorkerSem = stateWorkerSem
|
||||||
|
|
||||||
putIsWorkerOn :: AppState -> Bool -> IO ()
|
getRetryNextIn :: AppState -> IO Int
|
||||||
putIsWorkerOn = atomicWriteIORef . stateIsWorkerOn
|
getRetryNextIn = readIORef . stateRetryNextIn
|
||||||
|
|
||||||
|
putRetryNextIn :: AppState -> Int -> IO ()
|
||||||
|
putRetryNextIn = atomicWriteIORef . stateRetryNextIn
|
||||||
|
|
||||||
getConfig :: AppState -> IO AppConfig
|
getConfig :: AppState -> IO AppConfig
|
||||||
getConfig = readIORef . stateConf
|
getConfig = readIORef . stateConf
|
||||||
@@ -143,3 +158,9 @@ waitListener = takeMVar . stateListener
|
|||||||
-- the connectionWorker is the only mvar producer.
|
-- the connectionWorker is the only mvar producer.
|
||||||
signalListener :: AppState -> IO ()
|
signalListener :: AppState -> IO ()
|
||||||
signalListener appState = void $ tryPutMVar (stateListener appState) ()
|
signalListener appState = void $ tryPutMVar (stateListener appState) ()
|
||||||
|
|
||||||
|
getIsListenerOn :: AppState -> IO Bool
|
||||||
|
getIsListenerOn = readIORef . stateIsListenerOn
|
||||||
|
|
||||||
|
putIsListenerOn :: AppState -> Bool -> IO ()
|
||||||
|
putIsListenerOn = atomicWriteIORef . stateIsListenerOn
|
||||||
|
|||||||
+73
-34
@@ -12,40 +12,55 @@ very simple authentication system inside the PostgreSQL database.
|
|||||||
-}
|
-}
|
||||||
{-# LANGUAGE RecordWildCards #-}
|
{-# LANGUAGE RecordWildCards #-}
|
||||||
module PostgREST.Auth
|
module PostgREST.Auth
|
||||||
( containsRole
|
( AuthResult (..)
|
||||||
, jwtClaims
|
, getResult
|
||||||
, JWTClaims
|
, getRole
|
||||||
|
, middleware
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import qualified Crypto.JWT as JWT
|
import qualified Crypto.JWT as JWT
|
||||||
import qualified Data.Aeson as JSON
|
import qualified Data.Aeson as JSON
|
||||||
import qualified Data.HashMap.Strict as M
|
import qualified Data.Aeson.Key as K
|
||||||
import qualified Data.Vector as V
|
import qualified Data.Aeson.KeyMap as KM
|
||||||
|
import qualified Data.Aeson.Types as JSON
|
||||||
|
import qualified Data.ByteString.Lazy.Char8 as LBS
|
||||||
|
import qualified Data.Text.Encoding as T
|
||||||
|
import qualified Data.Vault.Lazy as Vault
|
||||||
|
import qualified Data.Vector as V
|
||||||
|
import qualified Network.HTTP.Types.Header as HTTP
|
||||||
|
import qualified Network.Wai as Wai
|
||||||
|
import qualified Network.Wai.Middleware.HttpAuth as Wai
|
||||||
|
|
||||||
import Control.Lens (set)
|
import Control.Lens (set)
|
||||||
import Control.Monad.Except (liftEither)
|
import Control.Monad.Except (liftEither)
|
||||||
import Data.Either.Combinators (mapLeft)
|
import Data.Either.Combinators (mapLeft)
|
||||||
|
import Data.List (lookup)
|
||||||
import Data.Time.Clock (UTCTime)
|
import Data.Time.Clock (UTCTime)
|
||||||
|
import System.IO.Unsafe (unsafePerformIO)
|
||||||
|
|
||||||
import PostgREST.Config (AppConfig (..), JSPath, JSPathExp (..))
|
import PostgREST.AppState (AppState, getConfig, getTime)
|
||||||
import PostgREST.Error (Error (..))
|
import PostgREST.Config (AppConfig (..), JSPath, JSPathExp (..))
|
||||||
|
import PostgREST.Error (Error (..))
|
||||||
|
|
||||||
import Protolude
|
import Protolude
|
||||||
|
|
||||||
|
|
||||||
type JWTClaims = M.HashMap Text JSON.Value
|
data AuthResult = AuthResult
|
||||||
|
{ authClaims :: KM.KeyMap JSON.Value
|
||||||
|
, authRole :: Text
|
||||||
|
}
|
||||||
|
|
||||||
-- | Receives the JWT secret and audience (from config) and a JWT and returns a
|
-- | Receives the JWT secret and audience (from config) and a JWT and returns a
|
||||||
-- map of JWT claims.
|
-- JSON object of JWT claims.
|
||||||
jwtClaims :: Monad m =>
|
parseToken :: Monad m =>
|
||||||
AppConfig -> LByteString -> UTCTime -> ExceptT Error m JWTClaims
|
AppConfig -> LByteString -> UTCTime -> ExceptT Error m JSON.Value
|
||||||
jwtClaims _ "" _ = return M.empty
|
parseToken _ "" _ = return JSON.emptyObject
|
||||||
jwtClaims AppConfig{..} payload time = do
|
parseToken AppConfig{..} token time = do
|
||||||
secret <- liftEither . maybeToRight JwtTokenMissing $ configJWKS
|
secret <- liftEither . maybeToRight JwtTokenMissing $ configJWKS
|
||||||
eitherClaims <-
|
eitherClaims <-
|
||||||
lift . runExceptT $
|
lift . runExceptT $
|
||||||
JWT.verifyClaimsAt validation secret time =<< JWT.decodeCompact payload
|
JWT.verifyClaimsAt validation secret time =<< JWT.decodeCompact token
|
||||||
liftEither . mapLeft jwtClaimsError $ claimsMap configJwtRoleClaimKey <$> eitherClaims
|
liftEither . mapLeft jwtClaimsError $ JSON.toJSON <$> eitherClaims
|
||||||
where
|
where
|
||||||
validation =
|
validation =
|
||||||
JWT.defaultJWTValidationSettings audienceCheck & set JWT.allowedSkew 1
|
JWT.defaultJWTValidationSettings audienceCheck & set JWT.allowedSkew 1
|
||||||
@@ -57,26 +72,50 @@ jwtClaims AppConfig{..} payload time = do
|
|||||||
jwtClaimsError JWT.JWTExpired = JwtTokenInvalid "JWT expired"
|
jwtClaimsError JWT.JWTExpired = JwtTokenInvalid "JWT expired"
|
||||||
jwtClaimsError e = JwtTokenInvalid $ show e
|
jwtClaimsError e = JwtTokenInvalid $ show e
|
||||||
|
|
||||||
-- | Turn JWT ClaimSet into something easier to work with.
|
parseClaims :: Monad m =>
|
||||||
--
|
AppConfig -> JSON.Value -> ExceptT Error m AuthResult
|
||||||
-- Also, here the jspath is applied to put the "role" in the map.
|
parseClaims AppConfig{..} jclaims@(JSON.Object mclaims) = do
|
||||||
claimsMap :: JSPath -> JWT.ClaimsSet -> JWTClaims
|
-- role defaults to anon if not specified in jwt
|
||||||
claimsMap jspath claims =
|
role <- liftEither . maybeToRight JwtTokenRequired $
|
||||||
case JSON.toJSON claims of
|
unquoted <$> walkJSPath (Just jclaims) configJwtRoleClaimKey <|> configDbAnonRole
|
||||||
val@(JSON.Object o) ->
|
return AuthResult
|
||||||
M.delete "role" o `M.union` role val
|
{ authClaims = mclaims & KM.insert "role" (JSON.toJSON role)
|
||||||
_ ->
|
, authRole = role
|
||||||
M.empty
|
}
|
||||||
where
|
where
|
||||||
role value =
|
|
||||||
maybe M.empty (M.singleton "role") $ walkJSPath (Just value) jspath
|
|
||||||
|
|
||||||
walkJSPath :: Maybe JSON.Value -> JSPath -> Maybe JSON.Value
|
walkJSPath :: Maybe JSON.Value -> JSPath -> Maybe JSON.Value
|
||||||
walkJSPath x [] = x
|
walkJSPath x [] = x
|
||||||
walkJSPath (Just (JSON.Object o)) (JSPKey key:rest) = walkJSPath (M.lookup key o) rest
|
walkJSPath (Just (JSON.Object o)) (JSPKey key:rest) = walkJSPath (KM.lookup (K.fromText key) o) rest
|
||||||
walkJSPath (Just (JSON.Array ar)) (JSPIdx idx:rest) = walkJSPath (ar V.!? idx) rest
|
walkJSPath (Just (JSON.Array ar)) (JSPIdx idx:rest) = walkJSPath (ar V.!? idx) rest
|
||||||
walkJSPath _ _ = Nothing
|
walkJSPath _ _ = Nothing
|
||||||
|
|
||||||
-- | Whether a response from jwtClaims contains a role claim
|
unquoted :: JSON.Value -> Text
|
||||||
containsRole :: JWTClaims -> Bool
|
unquoted (JSON.String t) = t
|
||||||
containsRole = M.member "role"
|
unquoted v = T.decodeUtf8 . LBS.toStrict $ JSON.encode v
|
||||||
|
-- impossible case - just added to please -Wincomplete-patterns
|
||||||
|
parseClaims _ _ = return AuthResult { authClaims = KM.empty, authRole = mempty }
|
||||||
|
|
||||||
|
-- | Validate authorization header.
|
||||||
|
-- Parse and store JWT claims for future use in the request.
|
||||||
|
middleware :: AppState -> Wai.Middleware
|
||||||
|
middleware appState app req respond = do
|
||||||
|
conf <- getConfig appState
|
||||||
|
time <- getTime appState
|
||||||
|
|
||||||
|
let token = fromMaybe "" $ Wai.extractBearerAuth =<< lookup HTTP.hAuthorization (Wai.requestHeaders req)
|
||||||
|
authResult <- runExceptT $
|
||||||
|
parseToken conf (LBS.fromStrict token) time >>=
|
||||||
|
parseClaims conf
|
||||||
|
|
||||||
|
let req' = req { Wai.vault = Wai.vault req & Vault.insert authResultKey authResult }
|
||||||
|
app req' respond
|
||||||
|
|
||||||
|
authResultKey :: Vault.Key (Either Error AuthResult)
|
||||||
|
authResultKey = unsafePerformIO Vault.newKey
|
||||||
|
{-# NOINLINE authResultKey #-}
|
||||||
|
|
||||||
|
getResult :: Wai.Request -> Maybe (Either Error AuthResult)
|
||||||
|
getResult = Vault.lookup authResultKey . Wai.vault
|
||||||
|
|
||||||
|
getRole :: Wai.Request -> Maybe Text
|
||||||
|
getRole req = authRole <$> (rightToMaybe =<< getResult req)
|
||||||
|
|||||||
+93
-93
@@ -8,12 +8,11 @@ module PostgREST.CLI
|
|||||||
, readCLIShowHelp
|
, readCLIShowHelp
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import qualified Data.Aeson as Aeson
|
import qualified Data.Aeson as JSON
|
||||||
|
import qualified Data.ByteString.Char8 as BS
|
||||||
import qualified Data.ByteString.Lazy as LBS
|
import qualified Data.ByteString.Lazy as LBS
|
||||||
import qualified Hasql.Pool as P
|
import qualified Hasql.Transaction.Sessions as SQL
|
||||||
import qualified Hasql.Transaction.Sessions as HT
|
|
||||||
import qualified Options.Applicative as O
|
import qualified Options.Applicative as O
|
||||||
import qualified Protolude.Conv as Conv
|
|
||||||
|
|
||||||
import Data.Text.IO (hPutStrLn)
|
import Data.Text.IO (hPutStrLn)
|
||||||
import Text.Heredoc (str)
|
import Text.Heredoc (str)
|
||||||
@@ -35,38 +34,37 @@ main :: App.SignalHandlerInstaller -> Maybe App.SocketRunner -> CLI -> IO ()
|
|||||||
main installSignalHandlers runAppWithSocket CLI{cliCommand, cliPath} = do
|
main installSignalHandlers runAppWithSocket CLI{cliCommand, cliPath} = do
|
||||||
conf@AppConfig{..} <-
|
conf@AppConfig{..} <-
|
||||||
either panic identity <$> Config.readAppConfig mempty cliPath Nothing
|
either panic identity <$> Config.readAppConfig mempty cliPath Nothing
|
||||||
appState <- AppState.init conf
|
|
||||||
|
|
||||||
-- Override the config with config options from the db
|
-- Per https://github.com/PostgREST/postgrest/issues/268, we want to
|
||||||
-- TODO: the same operation is repeated on connectionWorker, ideally this
|
-- explicitly close the connections to PostgreSQL on shutdown.
|
||||||
-- would be done only once, but dump CmdDumpConfig needs it for tests.
|
-- 'AppState.destroy' takes care of that.
|
||||||
when configDbConfig $ reReadConfig True appState
|
bracket
|
||||||
|
(AppState.init conf)
|
||||||
exec cliCommand appState
|
AppState.destroy
|
||||||
where
|
(\appState -> case cliCommand of
|
||||||
exec :: Command -> AppState -> IO ()
|
CmdDumpConfig -> do
|
||||||
exec CmdDumpConfig appState = putStr . Config.toText =<< AppState.getConfig appState
|
when configDbConfig $ reReadConfig True appState
|
||||||
exec CmdDumpSchema appState = putStrLn =<< dumpSchema appState
|
putStr . Config.toText =<< AppState.getConfig appState
|
||||||
exec CmdRun appState = App.run installSignalHandlers runAppWithSocket appState
|
CmdDumpSchema -> putStrLn =<< dumpSchema appState
|
||||||
|
CmdRun -> App.run installSignalHandlers runAppWithSocket appState)
|
||||||
|
|
||||||
-- | Dump DbStructure schema to JSON
|
-- | Dump DbStructure schema to JSON
|
||||||
dumpSchema :: AppState -> IO LBS.ByteString
|
dumpSchema :: AppState -> IO LBS.ByteString
|
||||||
dumpSchema appState = do
|
dumpSchema appState = do
|
||||||
AppConfig{..} <- AppState.getConfig appState
|
AppConfig{..} <- AppState.getConfig appState
|
||||||
result <-
|
result <-
|
||||||
let transaction = if configDbPreparedStatements then HT.transaction else HT.unpreparedTransaction in
|
let transaction = if configDbPreparedStatements then SQL.transaction else SQL.unpreparedTransaction in
|
||||||
P.use (AppState.getPool appState) $
|
AppState.usePool appState $
|
||||||
transaction HT.ReadCommitted HT.Read $
|
transaction SQL.ReadCommitted SQL.Read $
|
||||||
queryDbStructure
|
queryDbStructure
|
||||||
(toList configDbSchemas)
|
(toList configDbSchemas)
|
||||||
configDbExtraSearchPath
|
configDbExtraSearchPath
|
||||||
configDbPreparedStatements
|
configDbPreparedStatements
|
||||||
P.release $ AppState.getPool appState
|
|
||||||
case result of
|
case result of
|
||||||
Left e -> do
|
Left e -> do
|
||||||
hPutStrLn stderr $ "An error ocurred when loading the schema cache:\n" <> show e
|
hPutStrLn stderr $ "An error ocurred when loading the schema cache:\n" <> show e
|
||||||
exitFailure
|
exitFailure
|
||||||
Right dbStructure -> return $ Aeson.encode dbStructure
|
Right dbStructure -> return $ JSON.encode dbStructure
|
||||||
|
|
||||||
-- | Command line interface options
|
-- | Command line interface options
|
||||||
data CLI = CLI
|
data CLI = CLI
|
||||||
@@ -80,25 +78,20 @@ data Command
|
|||||||
| CmdDumpSchema
|
| CmdDumpSchema
|
||||||
|
|
||||||
-- | Read command line interface options. Also prints help.
|
-- | Read command line interface options. Also prints help.
|
||||||
readCLIShowHelp :: Bool -> IO CLI
|
readCLIShowHelp :: IO CLI
|
||||||
readCLIShowHelp hasEnvironment =
|
readCLIShowHelp =
|
||||||
O.customExecParser prefs opts
|
O.customExecParser prefs opts
|
||||||
where
|
where
|
||||||
prefs = O.prefs $ O.showHelpOnError <> O.showHelpOnEmpty
|
prefs = O.prefs $ O.showHelpOnError <> O.showHelpOnEmpty
|
||||||
opts = O.info parser $ O.fullDesc <> progDesc <> footer
|
opts = O.info parser $ O.fullDesc <> progDesc
|
||||||
parser = O.helper <*> exampleParser <*> cliParser
|
parser = O.helper <*> exampleParser <*> cliParser
|
||||||
|
|
||||||
progDesc =
|
progDesc =
|
||||||
O.progDesc $
|
O.progDesc $
|
||||||
"PostgREST "
|
"PostgREST "
|
||||||
<> Conv.toS prettyVersion
|
<> BS.unpack prettyVersion
|
||||||
<> " / create a REST API to an existing Postgres database"
|
<> " / create a REST API to an existing Postgres database"
|
||||||
|
|
||||||
footer =
|
|
||||||
O.footer $
|
|
||||||
"To run PostgREST, please pass the FILENAME argument"
|
|
||||||
<> " or set PGRST_ environment variables."
|
|
||||||
|
|
||||||
exampleParser =
|
exampleParser =
|
||||||
O.infoOption exampleConfigFile $
|
O.infoOption exampleConfigFile $
|
||||||
O.long "example"
|
O.long "example"
|
||||||
@@ -109,12 +102,12 @@ readCLIShowHelp hasEnvironment =
|
|||||||
cliParser =
|
cliParser =
|
||||||
CLI
|
CLI
|
||||||
<$> (dumpConfigFlag <|> dumpSchemaFlag)
|
<$> (dumpConfigFlag <|> dumpSchemaFlag)
|
||||||
<*> optionalIf hasEnvironment configFileOption
|
<*> O.optional configFileOption
|
||||||
|
|
||||||
configFileOption =
|
configFileOption =
|
||||||
O.strArgument $
|
O.strArgument $
|
||||||
O.metavar "FILENAME"
|
O.metavar "FILENAME"
|
||||||
<> O.help "Path to configuration file (optional with PGRST_ environment variables)"
|
<> O.help "Path to configuration file"
|
||||||
|
|
||||||
dumpConfigFlag =
|
dumpConfigFlag =
|
||||||
O.flag CmdRun CmdDumpConfig $
|
O.flag CmdRun CmdDumpConfig $
|
||||||
@@ -126,36 +119,13 @@ readCLIShowHelp hasEnvironment =
|
|||||||
O.long "dump-schema"
|
O.long "dump-schema"
|
||||||
<> O.help "Dump loaded schema as JSON and exit (for debugging, output structure is unstable)"
|
<> O.help "Dump loaded schema as JSON and exit (for debugging, output structure is unstable)"
|
||||||
|
|
||||||
optionalIf :: Alternative f => Bool -> f a -> f (Maybe a)
|
|
||||||
optionalIf True = O.optional
|
|
||||||
optionalIf False = fmap Just
|
|
||||||
|
|
||||||
exampleConfigFile :: [Char]
|
exampleConfigFile :: [Char]
|
||||||
exampleConfigFile =
|
exampleConfigFile =
|
||||||
[str|### REQUIRED:
|
[str|## Admin server used for checks. It's disabled by default unless a port is specified.
|
||||||
|db-uri = "postgres://user:pass@localhost:5432/dbname"
|
|# admin-server-port = 3001
|
||||||
|db-schema = "public"
|
|
||||||
|db-anon-role = "postgres"
|
|
||||||
|
|
|
|
||||||
|### OPTIONAL:
|
|## The database role to use when no client authentication is provided
|
||||||
|## number of open connections in the pool
|
|# db-anon-role = "anon"
|
||||||
|db-pool = 10
|
|
||||||
|
|
|
||||||
|## Time to live, in seconds, for an idle database pool connection.
|
|
||||||
|db-pool-timeout = 10
|
|
||||||
|
|
|
||||||
|## extra schemas to add to the search_path of every request
|
|
||||||
|db-extra-search-path = "public"
|
|
||||||
|
|
|
||||||
|## limit rows in response
|
|
||||||
|# db-max-rows = 1000
|
|
||||||
|
|
|
||||||
|## stored proc to exec immediately after auth
|
|
||||||
|# db-pre-request = "stored_proc_name"
|
|
||||||
|
|
|
||||||
|## stored proc that overrides the root "/" spec
|
|
||||||
|## it must be inside the db-schema
|
|
||||||
|# db-root-spec = "stored_proc_name"
|
|
||||||
|
|
|
|
||||||
|## Notification channel for reloading the schema cache
|
|## Notification channel for reloading the schema cache
|
||||||
|db-channel = "pgrst"
|
|db-channel = "pgrst"
|
||||||
@@ -166,52 +136,82 @@ exampleConfigFile =
|
|||||||
|## Enable in-database configuration
|
|## Enable in-database configuration
|
||||||
|db-config = true
|
|db-config = true
|
||||||
|
|
|
|
||||||
|## how to terminate database transactions
|
|## Extra schemas to add to the search_path of every request
|
||||||
|## possible values are:
|
|db-extra-search-path = "public"
|
||||||
|
|
|
||||||
|
|## Limit rows in response
|
||||||
|
|# db-max-rows = 1000
|
||||||
|
|
|
||||||
|
|## Allow getting the EXPLAIN plan through the `Accept: application/vnd.pgrst.plan` header
|
||||||
|
|# db-plan-enabled = false
|
||||||
|
|
|
||||||
|
|## Number of open connections in the pool
|
||||||
|
|db-pool = 10
|
||||||
|
|
|
||||||
|
|## Time to live, in seconds, for an idle database pool connection
|
||||||
|
|db-pool-timeout = 3600
|
||||||
|
|
|
||||||
|
|## Stored proc to exec immediately after auth
|
||||||
|
|# db-pre-request = "stored_proc_name"
|
||||||
|
|
|
||||||
|
|## Enable or disable prepared statements. disabling is only necessary when behind a connection pooler.
|
||||||
|
|## When disabled, statements will be parametrized but won't be prepared.
|
||||||
|
|db-prepared-statements = true
|
||||||
|
|
|
||||||
|
|## The name of which database schema to expose to REST clients
|
||||||
|
|db-schemas = "public"
|
||||||
|
|
|
||||||
|
|## How to terminate database transactions
|
||||||
|
|## Possible values are:
|
||||||
|## commit (default)
|
|## commit (default)
|
||||||
|## transaction is always committed, this can not be overriden
|
|## Transaction is always committed, this can not be overriden
|
||||||
|## commit-allow-override
|
|## commit-allow-override
|
||||||
|## transaction is committed, but can be overriden with Prefer tx=rollback header
|
|## Transaction is committed, but can be overriden with Prefer tx=rollback header
|
||||||
|## rollback
|
|## rollback
|
||||||
|## transaction is always rolled back, this can not be overriden
|
|## Transaction is always rolled back, this can not be overriden
|
||||||
|## rollback-allow-override
|
|## rollback-allow-override
|
||||||
|## transaction is rolled back, but can be overriden with Prefer tx=commit header
|
|## Transaction is rolled back, but can be overriden with Prefer tx=commit header
|
||||||
|db-tx-end = "commit"
|
|db-tx-end = "commit"
|
||||||
|
|
|
|
||||||
|## enable or disable prepared statements. disabling is only necessary when behind a connection pooler.
|
|## The standard connection URI format, documented at
|
||||||
|## when disabled, statements will be parametrized but won't be prepared.
|
|## https://www.postgresql.org/docs/current/libpq-connect.html#LIBPQ-CONNSTRING
|
||||||
|db-prepared-statements = true
|
|db-uri = "postgresql://"
|
||||||
|
|
|
||||||
|
|## Determine if GUC request settings for headers, cookies and jwt claims use the legacy names (string with dashes, invalid starting from PostgreSQL v14) with text values instead of the new names (string without dashes, valid on all PostgreSQL versions) with json values.
|
||||||
|
|## For PostgreSQL v14 and up, this setting will be ignored.
|
||||||
|
|db-use-legacy-gucs = true
|
||||||
|
|
|
||||||
|
|# jwt-aud = "your_audience_claim"
|
||||||
|
|
|
||||||
|
|## Jspath to the role claim key
|
||||||
|
|jwt-role-claim-key = ".role"
|
||||||
|
|
|
||||||
|
|## Choose a secret, JSON Web Key (or set) to enable JWT auth
|
||||||
|
|## (use "@filename" to load from separate file)
|
||||||
|
|# jwt-secret = "secret_with_at_least_32_characters"
|
||||||
|
|jwt-secret-is-base64 = false
|
||||||
|
|
|
||||||
|
|## Logging level, the admitted values are: crit, error, warn and info.
|
||||||
|
|log-level = "error"
|
||||||
|
|
|
||||||
|
|## Determine if the OpenAPI output should follow or ignore role privileges or be disabled entirely.
|
||||||
|
|## Admitted values: follow-privileges, ignore-privileges, disabled
|
||||||
|
|openapi-mode = "follow-privileges"
|
||||||
|
|
|
||||||
|
|## Base url for the OpenAPI output
|
||||||
|
|openapi-server-proxy-uri = ""
|
||||||
|
|
|
||||||
|
|## Content types to produce raw output
|
||||||
|
|# raw-media-types="image/png, image/jpg"
|
||||||
|
|
|
|
||||||
|server-host = "!4"
|
|server-host = "!4"
|
||||||
|server-port = 3000
|
|server-port = 3000
|
||||||
|
|
|
|
||||||
|## unix socket location
|
|## Unix socket location
|
||||||
|## if specified it takes precedence over server-port
|
|## if specified it takes precedence over server-port
|
||||||
|# server-unix-socket = "/tmp/pgrst.sock"
|
|# server-unix-socket = "/tmp/pgrst.sock"
|
||||||
|
|
|
|
||||||
|## unix socket file mode
|
|## Unix socket file mode
|
||||||
|## when none is provided, 660 is applied by default
|
|## When none is provided, 660 is applied by default
|
||||||
|# server-unix-socket-mode = "660"
|
|# server-unix-socket-mode = "660"
|
||||||
|
|
|
||||||
|## determine if the OpenAPI output should follow or ignore role privileges or be disabled entirely
|
|
||||||
|## admitted values: follow-privileges, ignore-privileges, disabled
|
|
||||||
|openapi-mode = "follow-privileges"
|
|
||||||
|
|
|
||||||
|## base url for the OpenAPI output
|
|
||||||
|openapi-server-proxy-uri = ""
|
|
||||||
|
|
|
||||||
|## choose a secret, JSON Web Key (or set) to enable JWT auth
|
|
||||||
|## (use "@filename" to load from separate file)
|
|
||||||
|# jwt-secret = "secret_with_at_least_32_characters"
|
|
||||||
|# jwt-aud = "your_audience_claim"
|
|
||||||
|jwt-secret-is-base64 = false
|
|
||||||
|
|
|
||||||
|## jspath to the role claim key
|
|
||||||
|jwt-role-claim-key = ".role"
|
|
||||||
|
|
|
||||||
|## content types to produce raw output
|
|
||||||
|# raw-media-types="image/png, image/jpg"
|
|
||||||
|
|
|
||||||
|## logging level, the admitted values are: crit, error, warn and info.
|
|
||||||
|log-level = "error"
|
|
||||||
|]
|
|]
|
||||||
|
|||||||
+61
-60
@@ -29,19 +29,18 @@ module PostgREST.Config
|
|||||||
import qualified Crypto.JOSE.Types as JOSE
|
import qualified Crypto.JOSE.Types as JOSE
|
||||||
import qualified Crypto.JWT as JWT
|
import qualified Crypto.JWT as JWT
|
||||||
import qualified Data.Aeson as JSON
|
import qualified Data.Aeson as JSON
|
||||||
import qualified Data.ByteString as B
|
import qualified Data.ByteString as BS
|
||||||
import qualified Data.ByteString.Base64 as B64
|
import qualified Data.ByteString.Base64 as B64
|
||||||
import qualified Data.ByteString.Char8 as BS
|
import qualified Data.ByteString.Lazy as LBS
|
||||||
import qualified Data.Configurator as C
|
import qualified Data.Configurator as C
|
||||||
import qualified Data.Map.Strict as M
|
import qualified Data.Map.Strict as M
|
||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
|
import qualified Data.Text.Encoding as T
|
||||||
import qualified GHC.Show (show)
|
|
||||||
|
|
||||||
import Control.Lens (preview)
|
import Control.Lens (preview)
|
||||||
import Control.Monad (fail)
|
import Control.Monad (fail)
|
||||||
import Crypto.JWT (JWK, JWKSet, StringOrURI, stringOrUri)
|
import Crypto.JWT (JWK, JWKSet, StringOrURI, stringOrUri)
|
||||||
import Data.Aeson (encode, toJSON)
|
import Data.Aeson (toJSON)
|
||||||
import Data.Either.Combinators (mapLeft)
|
import Data.Either.Combinators (mapLeft)
|
||||||
import Data.List (lookup)
|
import Data.List (lookup)
|
||||||
import Data.List.NonEmpty (fromList, toList)
|
import Data.List.NonEmpty (fromList, toList)
|
||||||
@@ -53,22 +52,24 @@ import System.Environment (getEnvironment)
|
|||||||
import System.Posix.Types (FileMode)
|
import System.Posix.Types (FileMode)
|
||||||
|
|
||||||
import PostgREST.Config.JSPath (JSPath, JSPathExp (..),
|
import PostgREST.Config.JSPath (JSPath, JSPathExp (..),
|
||||||
pRoleClaimKey)
|
dumpJSPath, pRoleClaimKey)
|
||||||
import PostgREST.Config.Proxy (Proxy (..),
|
import PostgREST.Config.Proxy (Proxy (..),
|
||||||
isMalformedProxyUri, toURI)
|
isMalformedProxyUri, toURI)
|
||||||
import PostgREST.DbStructure.Identifiers (QualifiedIdentifier, toQi)
|
import PostgREST.DbStructure.Identifiers (QualifiedIdentifier, dumpQi,
|
||||||
|
toQi)
|
||||||
|
import PostgREST.MediaType (MediaType (..), toMime)
|
||||||
|
|
||||||
import Protolude hiding (Proxy, toList, toS)
|
import Protolude hiding (Proxy, toList)
|
||||||
import Protolude.Conv (toS)
|
|
||||||
|
|
||||||
|
|
||||||
data AppConfig = AppConfig
|
data AppConfig = AppConfig
|
||||||
{ configAppSettings :: [(Text, Text)]
|
{ configAppSettings :: [(Text, Text)]
|
||||||
, configDbAnonRole :: Text
|
, configDbAnonRole :: Maybe Text
|
||||||
, configDbChannel :: Text
|
, configDbChannel :: Text
|
||||||
, configDbChannelEnabled :: Bool
|
, configDbChannelEnabled :: Bool
|
||||||
, configDbExtraSearchPath :: [Text]
|
, configDbExtraSearchPath :: [Text]
|
||||||
, configDbMaxRows :: Maybe Integer
|
, configDbMaxRows :: Maybe Integer
|
||||||
|
, configDbPlanEnabled :: Bool
|
||||||
, configDbPoolSize :: Int
|
, configDbPoolSize :: Int
|
||||||
, configDbPoolTimeout :: NominalDiffTime
|
, configDbPoolTimeout :: NominalDiffTime
|
||||||
, configDbPreRequest :: Maybe QualifiedIdentifier
|
, configDbPreRequest :: Maybe QualifiedIdentifier
|
||||||
@@ -79,37 +80,42 @@ data AppConfig = AppConfig
|
|||||||
, configDbTxAllowOverride :: Bool
|
, configDbTxAllowOverride :: Bool
|
||||||
, configDbTxRollbackAll :: Bool
|
, configDbTxRollbackAll :: Bool
|
||||||
, configDbUri :: Text
|
, configDbUri :: Text
|
||||||
|
, configDbUseLegacyGucs :: Bool
|
||||||
, configFilePath :: Maybe FilePath
|
, configFilePath :: Maybe FilePath
|
||||||
, configJWKS :: Maybe JWKSet
|
, configJWKS :: Maybe JWKSet
|
||||||
, configJwtAudience :: Maybe StringOrURI
|
, configJwtAudience :: Maybe StringOrURI
|
||||||
, configJwtRoleClaimKey :: JSPath
|
, configJwtRoleClaimKey :: JSPath
|
||||||
, configJwtSecret :: Maybe B.ByteString
|
, configJwtSecret :: Maybe BS.ByteString
|
||||||
, configJwtSecretIsBase64 :: Bool
|
, configJwtSecretIsBase64 :: Bool
|
||||||
, configLogLevel :: LogLevel
|
, configLogLevel :: LogLevel
|
||||||
, configOpenApiMode :: OpenAPIMode
|
, configOpenApiMode :: OpenAPIMode
|
||||||
|
, configOpenApiSecurityActive :: Bool
|
||||||
, configOpenApiServerProxyUri :: Maybe Text
|
, configOpenApiServerProxyUri :: Maybe Text
|
||||||
, configRawMediaTypes :: [B.ByteString]
|
, configRawMediaTypes :: [MediaType]
|
||||||
, configServerHost :: Text
|
, configServerHost :: Text
|
||||||
, configServerPort :: Int
|
, configServerPort :: Int
|
||||||
, configServerUnixSocket :: Maybe FilePath
|
, configServerUnixSocket :: Maybe FilePath
|
||||||
, configServerUnixSocketMode :: FileMode
|
, configServerUnixSocketMode :: FileMode
|
||||||
|
, configAdminServerPort :: Maybe Int
|
||||||
}
|
}
|
||||||
|
|
||||||
data LogLevel = LogCrit | LogError | LogWarn | LogInfo
|
data LogLevel = LogCrit | LogError | LogWarn | LogInfo
|
||||||
|
|
||||||
instance Show LogLevel where
|
dumpLogLevel :: LogLevel -> Text
|
||||||
show LogCrit = "crit"
|
dumpLogLevel = \case
|
||||||
show LogError = "error"
|
LogCrit -> "crit"
|
||||||
show LogWarn = "warn"
|
LogError -> "error"
|
||||||
show LogInfo = "info"
|
LogWarn -> "warn"
|
||||||
|
LogInfo -> "info"
|
||||||
|
|
||||||
data OpenAPIMode = OAFollowPriv | OAIgnorePriv | OADisabled
|
data OpenAPIMode = OAFollowPriv | OAIgnorePriv | OADisabled
|
||||||
deriving Eq
|
deriving Eq
|
||||||
|
|
||||||
instance Show OpenAPIMode where
|
dumpOpenApiMode :: OpenAPIMode -> Text
|
||||||
show OAFollowPriv = "follow-privileges"
|
dumpOpenApiMode = \case
|
||||||
show OAIgnorePriv = "ignore-privileges"
|
OAFollowPriv -> "follow-privileges"
|
||||||
show OADisabled = "disabled"
|
OAIgnorePriv -> "ignore-privileges"
|
||||||
|
OADisabled -> "disabled"
|
||||||
|
|
||||||
-- | Dump the config
|
-- | Dump the config
|
||||||
toText :: AppConfig -> Text
|
toText :: AppConfig -> Text
|
||||||
@@ -118,32 +124,36 @@ toText conf =
|
|||||||
where
|
where
|
||||||
-- apply conf to all pgrst settings
|
-- apply conf to all pgrst settings
|
||||||
pgrstSettings = (\(k, v) -> (k, v conf)) <$>
|
pgrstSettings = (\(k, v) -> (k, v conf)) <$>
|
||||||
[("db-anon-role", q . configDbAnonRole)
|
[("db-anon-role", q . fromMaybe "" . configDbAnonRole)
|
||||||
,("db-channel", q . configDbChannel)
|
,("db-channel", q . configDbChannel)
|
||||||
,("db-channel-enabled", T.toLower . show . configDbChannelEnabled)
|
,("db-channel-enabled", T.toLower . show . configDbChannelEnabled)
|
||||||
,("db-extra-search-path", q . T.intercalate "," . configDbExtraSearchPath)
|
,("db-extra-search-path", q . T.intercalate "," . configDbExtraSearchPath)
|
||||||
,("db-max-rows", maybe "\"\"" show . configDbMaxRows)
|
,("db-max-rows", maybe "\"\"" show . configDbMaxRows)
|
||||||
|
,("db-plan-enabled", T.toLower . show . configDbPlanEnabled)
|
||||||
,("db-pool", show . configDbPoolSize)
|
,("db-pool", show . configDbPoolSize)
|
||||||
,("db-pool-timeout", show . floor . configDbPoolTimeout)
|
,("db-pool-timeout", show . floor . configDbPoolTimeout)
|
||||||
,("db-pre-request", q . maybe mempty show . configDbPreRequest)
|
,("db-pre-request", q . maybe mempty dumpQi . configDbPreRequest)
|
||||||
,("db-prepared-statements", T.toLower . show . configDbPreparedStatements)
|
,("db-prepared-statements", T.toLower . show . configDbPreparedStatements)
|
||||||
,("db-root-spec", q . maybe mempty show . configDbRootSpec)
|
,("db-root-spec", q . maybe mempty dumpQi . configDbRootSpec)
|
||||||
,("db-schemas", q . T.intercalate "," . toList . configDbSchemas)
|
,("db-schemas", q . T.intercalate "," . toList . configDbSchemas)
|
||||||
,("db-config", q . T.toLower . show . configDbConfig)
|
,("db-config", T.toLower . show . configDbConfig)
|
||||||
,("db-tx-end", q . showTxEnd)
|
,("db-tx-end", q . showTxEnd)
|
||||||
,("db-uri", q . configDbUri)
|
,("db-uri", q . configDbUri)
|
||||||
,("jwt-aud", toS . encode . maybe "" toJSON . configJwtAudience)
|
,("db-use-legacy-gucs", T.toLower . show . configDbUseLegacyGucs)
|
||||||
,("jwt-role-claim-key", q . T.intercalate mempty . fmap show . configJwtRoleClaimKey)
|
,("jwt-aud", T.decodeUtf8 . LBS.toStrict . JSON.encode . maybe "" toJSON . configJwtAudience)
|
||||||
,("jwt-secret", q . toS . showJwtSecret)
|
,("jwt-role-claim-key", q . T.intercalate mempty . fmap dumpJSPath . configJwtRoleClaimKey)
|
||||||
|
,("jwt-secret", q . T.decodeUtf8 . showJwtSecret)
|
||||||
,("jwt-secret-is-base64", T.toLower . show . configJwtSecretIsBase64)
|
,("jwt-secret-is-base64", T.toLower . show . configJwtSecretIsBase64)
|
||||||
,("log-level", q . show . configLogLevel)
|
,("log-level", q . dumpLogLevel . configLogLevel)
|
||||||
,("openapi-mode", q . show . configOpenApiMode)
|
,("openapi-mode", q . dumpOpenApiMode . configOpenApiMode)
|
||||||
|
,("openapi-security-active", T.toLower . show . configOpenApiSecurityActive)
|
||||||
,("openapi-server-proxy-uri", q . fromMaybe mempty . configOpenApiServerProxyUri)
|
,("openapi-server-proxy-uri", q . fromMaybe mempty . configOpenApiServerProxyUri)
|
||||||
,("raw-media-types", q . toS . B.intercalate "," . configRawMediaTypes)
|
,("raw-media-types", q . T.decodeUtf8 . BS.intercalate "," . fmap toMime . configRawMediaTypes)
|
||||||
,("server-host", q . configServerHost)
|
,("server-host", q . configServerHost)
|
||||||
,("server-port", show . configServerPort)
|
,("server-port", show . configServerPort)
|
||||||
,("server-unix-socket", q . maybe mempty T.pack . configServerUnixSocket)
|
,("server-unix-socket", q . maybe mempty T.pack . configServerUnixSocket)
|
||||||
,("server-unix-socket-mode", q . T.pack . showSocketMode)
|
,("server-unix-socket-mode", q . T.pack . showSocketMode)
|
||||||
|
,("admin-server-port", maybe "\"\"" show . configAdminServerPort)
|
||||||
]
|
]
|
||||||
|
|
||||||
-- quote all app.settings
|
-- quote all app.settings
|
||||||
@@ -159,7 +169,7 @@ toText conf =
|
|||||||
( True , True ) -> "rollback-allow-override"
|
( True , True ) -> "rollback-allow-override"
|
||||||
showJwtSecret c
|
showJwtSecret c
|
||||||
| configJwtSecretIsBase64 c = B64.encode secret
|
| configJwtSecretIsBase64 c = B64.encode secret
|
||||||
| otherwise = toS secret
|
| otherwise = secret
|
||||||
where
|
where
|
||||||
secret = fromMaybe mempty $ configJwtSecret c
|
secret = fromMaybe mempty $ configJwtSecret c
|
||||||
showSocketMode c = showOct (configServerUnixSocketMode c) mempty
|
showSocketMode c = showOct (configServerUnixSocketMode c) mempty
|
||||||
@@ -170,10 +180,10 @@ class JustIfMaybe a b where
|
|||||||
justIfMaybe :: a -> b
|
justIfMaybe :: a -> b
|
||||||
|
|
||||||
instance JustIfMaybe a a where
|
instance JustIfMaybe a a where
|
||||||
justIfMaybe a = a
|
justIfMaybe = identity
|
||||||
|
|
||||||
instance JustIfMaybe a (Maybe a) where
|
instance JustIfMaybe a (Maybe a) where
|
||||||
justIfMaybe a = Just a
|
justIfMaybe = Just
|
||||||
|
|
||||||
-- | Reads and parses the config and overrides its parameters from env vars,
|
-- | Reads and parses the config and overrides its parameters from env vars,
|
||||||
-- files or db settings.
|
-- files or db settings.
|
||||||
@@ -202,26 +212,27 @@ parser :: Maybe FilePath -> Environment -> [(Text, Text)] -> C.Parser C.Config A
|
|||||||
parser optPath env dbSettings =
|
parser optPath env dbSettings =
|
||||||
AppConfig
|
AppConfig
|
||||||
<$> parseAppSettings "app.settings"
|
<$> parseAppSettings "app.settings"
|
||||||
<*> reqString "db-anon-role"
|
<*> optString "db-anon-role"
|
||||||
<*> (fromMaybe "pgrst" <$> optString "db-channel")
|
<*> (fromMaybe "pgrst" <$> optString "db-channel")
|
||||||
<*> (fromMaybe True <$> optBool "db-channel-enabled")
|
<*> (fromMaybe True <$> optBool "db-channel-enabled")
|
||||||
<*> (maybe ["public"] splitOnCommas <$> optValue "db-extra-search-path")
|
<*> (maybe ["public"] splitOnCommas <$> optValue "db-extra-search-path")
|
||||||
<*> optWithAlias (optInt "db-max-rows")
|
<*> optWithAlias (optInt "db-max-rows")
|
||||||
(optInt "max-rows")
|
(optInt "max-rows")
|
||||||
|
<*> (fromMaybe False <$> optBool "db-plan-enabled")
|
||||||
<*> (fromMaybe 10 <$> optInt "db-pool")
|
<*> (fromMaybe 10 <$> optInt "db-pool")
|
||||||
<*> (fromIntegral . fromMaybe 10 <$> optInt "db-pool-timeout")
|
<*> (fromIntegral . fromMaybe 3600 <$> optInt "db-pool-timeout")
|
||||||
<*> (fmap toQi <$> optWithAlias (optString "db-pre-request")
|
<*> (fmap toQi <$> optWithAlias (optString "db-pre-request")
|
||||||
(optString "pre-request"))
|
(optString "pre-request"))
|
||||||
<*> (fromMaybe True <$> optBool "db-prepared-statements")
|
<*> (fromMaybe True <$> optBool "db-prepared-statements")
|
||||||
<*> (fmap toQi <$> optWithAlias (optString "db-root-spec")
|
<*> (fmap toQi <$> optWithAlias (optString "db-root-spec")
|
||||||
(optString "root-spec"))
|
(optString "root-spec"))
|
||||||
<*> (fromList . splitOnCommas <$> reqWithAlias (optValue "db-schemas")
|
<*> (fromList . maybe ["public"] splitOnCommas <$> optWithAlias (optValue "db-schemas")
|
||||||
(optValue "db-schema")
|
(optValue "db-schema"))
|
||||||
"missing key: either db-schemas or db-schema must be set")
|
|
||||||
<*> (fromMaybe True <$> optBool "db-config")
|
<*> (fromMaybe True <$> optBool "db-config")
|
||||||
<*> parseTxEnd "db-tx-end" snd
|
<*> parseTxEnd "db-tx-end" snd
|
||||||
<*> parseTxEnd "db-tx-end" fst
|
<*> parseTxEnd "db-tx-end" fst
|
||||||
<*> reqString "db-uri"
|
<*> (fromMaybe "postgresql://" <$> optString "db-uri")
|
||||||
|
<*> (fromMaybe True <$> optBool "db-use-legacy-gucs")
|
||||||
<*> pure optPath
|
<*> pure optPath
|
||||||
<*> pure Nothing
|
<*> pure Nothing
|
||||||
<*> parseJwtAudience "jwt-aud"
|
<*> parseJwtAudience "jwt-aud"
|
||||||
@@ -232,12 +243,14 @@ parser optPath env dbSettings =
|
|||||||
(optBool "secret-is-base64"))
|
(optBool "secret-is-base64"))
|
||||||
<*> parseLogLevel "log-level"
|
<*> parseLogLevel "log-level"
|
||||||
<*> parseOpenAPIMode "openapi-mode"
|
<*> parseOpenAPIMode "openapi-mode"
|
||||||
|
<*> (fromMaybe False <$> optBool "openapi-security-active")
|
||||||
<*> parseOpenAPIServerProxyURI "openapi-server-proxy-uri"
|
<*> parseOpenAPIServerProxyURI "openapi-server-proxy-uri"
|
||||||
<*> (maybe [] (fmap encodeUtf8 . splitOnCommas) <$> optValue "raw-media-types")
|
<*> (maybe [] (fmap (MTOther . encodeUtf8) . splitOnCommas) <$> optValue "raw-media-types")
|
||||||
<*> (fromMaybe "!4" <$> optString "server-host")
|
<*> (fromMaybe "!4" <$> optString "server-host")
|
||||||
<*> (fromMaybe 3000 <$> optInt "server-port")
|
<*> (fromMaybe 3000 <$> optInt "server-port")
|
||||||
<*> (fmap T.unpack <$> optString "server-unix-socket")
|
<*> (fmap T.unpack <$> optString "server-unix-socket")
|
||||||
<*> parseSocketFileMode "server-unix-socket-mode"
|
<*> parseSocketFileMode "server-unix-socket-mode"
|
||||||
|
<*> optInt "admin-server-port"
|
||||||
where
|
where
|
||||||
parseAppSettings :: C.Key -> C.Parser C.Config [(Text, Text)]
|
parseAppSettings :: C.Key -> C.Parser C.Config [(Text, Text)]
|
||||||
parseAppSettings key = addFromEnv . fmap (fmap coerceText) <$> C.subassocs key C.value
|
parseAppSettings key = addFromEnv . fmap (fmap coerceText) <$> C.subassocs key C.value
|
||||||
@@ -310,24 +323,12 @@ parser optPath env dbSettings =
|
|||||||
Nothing -> pure [JSPKey "role"]
|
Nothing -> pure [JSPKey "role"]
|
||||||
Just rck -> either (fail . show) pure $ pRoleClaimKey rck
|
Just rck -> either (fail . show) pure $ pRoleClaimKey rck
|
||||||
|
|
||||||
reqWithAlias :: C.Parser C.Config (Maybe a) -> C.Parser C.Config (Maybe a) -> [Char] -> C.Parser C.Config a
|
|
||||||
reqWithAlias orig alias err =
|
|
||||||
orig >>= \case
|
|
||||||
Just v -> pure v
|
|
||||||
Nothing ->
|
|
||||||
alias >>= \case
|
|
||||||
Just v -> pure v
|
|
||||||
Nothing -> fail err
|
|
||||||
|
|
||||||
optWithAlias :: C.Parser C.Config (Maybe a) -> C.Parser C.Config (Maybe a) -> C.Parser C.Config (Maybe a)
|
optWithAlias :: C.Parser C.Config (Maybe a) -> C.Parser C.Config (Maybe a) -> C.Parser C.Config (Maybe a)
|
||||||
optWithAlias orig alias =
|
optWithAlias orig alias =
|
||||||
orig >>= \case
|
orig >>= \case
|
||||||
Just v -> pure $ Just v
|
Just v -> pure $ Just v
|
||||||
Nothing -> alias
|
Nothing -> alias
|
||||||
|
|
||||||
reqString :: C.Key -> C.Parser C.Config Text
|
|
||||||
reqString k = overrideFromDbOrEnvironment C.required k coerceText
|
|
||||||
|
|
||||||
optString :: C.Key -> C.Parser C.Config (Maybe Text)
|
optString :: C.Key -> C.Parser C.Config (Maybe Text)
|
||||||
optString k = mfilter (/= "") <$> overrideFromDbOrEnvironment C.optional k coerceText
|
optString k = mfilter (/= "") <$> overrideFromDbOrEnvironment C.optional k coerceText
|
||||||
|
|
||||||
@@ -354,8 +355,8 @@ parser optPath env dbSettings =
|
|||||||
reloadableDbSetting =
|
reloadableDbSetting =
|
||||||
let dbSettingName = T.pack $ dashToUnderscore <$> toS key in
|
let dbSettingName = T.pack $ dashToUnderscore <$> toS key in
|
||||||
if dbSettingName `notElem` [
|
if dbSettingName `notElem` [
|
||||||
"server_host", "server_port", "server_unix_socket", "server_unix_socket_mode", "log_level",
|
"server_host", "server_port", "server_unix_socket", "server_unix_socket_mode", "admin_server_port", "log_level",
|
||||||
"db_anon_role", "db_uri", "db_channel_enabled", "db_channel", "db_pool", "db_pool_timeout", "db_config"]
|
"db_uri", "db_channel_enabled", "db_channel", "db_pool", "db_pool_timeout", "db_config"]
|
||||||
then lookup dbSettingName dbSettings
|
then lookup dbSettingName dbSettings
|
||||||
else Nothing
|
else Nothing
|
||||||
|
|
||||||
@@ -365,17 +366,17 @@ parser optPath env dbSettings =
|
|||||||
|
|
||||||
coerceInt :: (Read i, Integral i) => C.Value -> Maybe i
|
coerceInt :: (Read i, Integral i) => C.Value -> Maybe i
|
||||||
coerceInt (C.Number x) = rightToMaybe $ floatingOrInteger x
|
coerceInt (C.Number x) = rightToMaybe $ floatingOrInteger x
|
||||||
coerceInt (C.String x) = readMaybe $ toS x
|
coerceInt (C.String x) = readMaybe x
|
||||||
coerceInt _ = Nothing
|
coerceInt _ = Nothing
|
||||||
|
|
||||||
coerceBool :: C.Value -> Maybe Bool
|
coerceBool :: C.Value -> Maybe Bool
|
||||||
coerceBool (C.Bool b) = Just b
|
coerceBool (C.Bool b) = Just b
|
||||||
coerceBool (C.String s) =
|
coerceBool (C.String s) =
|
||||||
-- parse all kinds of text: True, true, TRUE, "true", ...
|
-- parse all kinds of text: True, true, TRUE, "true", ...
|
||||||
case readMaybe . toS $ T.toTitle $ T.filter isAlpha $ toS s of
|
case readMaybe $ T.toTitle $ T.filter isAlpha $ toS s of
|
||||||
Just b -> Just b
|
Just b -> Just b
|
||||||
-- numeric instead?
|
-- numeric instead?
|
||||||
Nothing -> (> 0) <$> (readMaybe $ toS s :: Maybe Integer)
|
Nothing -> (> 0) <$> (readMaybe s :: Maybe Integer)
|
||||||
coerceBool _ = Nothing
|
coerceBool _ = Nothing
|
||||||
|
|
||||||
splitOnCommas :: C.Value -> [Text]
|
splitOnCommas :: C.Value -> [Text]
|
||||||
@@ -420,8 +421,8 @@ parseSecret bytes =
|
|||||||
fromMaybe (maybe secret (\jwk' -> JWT.JWKSet [jwk']) maybeJWK)
|
fromMaybe (maybe secret (\jwk' -> JWT.JWKSet [jwk']) maybeJWK)
|
||||||
maybeJWKSet
|
maybeJWKSet
|
||||||
where
|
where
|
||||||
maybeJWKSet = JSON.decode (toS bytes) :: Maybe JWKSet
|
maybeJWKSet = JSON.decodeStrict bytes :: Maybe JWKSet
|
||||||
maybeJWK = JSON.decode (toS bytes) :: Maybe JWK
|
maybeJWK = JSON.decodeStrict bytes :: Maybe JWK
|
||||||
secret = JWT.JWKSet [JWT.fromKeyMaterial keyMaterial]
|
secret = JWT.JWKSet [JWT.fromKeyMaterial keyMaterial]
|
||||||
keyMaterial = JWT.OctKeyMaterial . JWT.OctKeyParameters $ JOSE.Base64Octets bytes
|
keyMaterial = JWT.OctKeyMaterial . JWT.OctKeyParameters $ JOSE.Base64Octets bytes
|
||||||
|
|
||||||
|
|||||||
@@ -1,7 +1,8 @@
|
|||||||
{-# LANGUAGE QuasiQuotes #-}
|
{-# LANGUAGE QuasiQuotes #-}
|
||||||
|
|
||||||
module PostgREST.Config.Database
|
module PostgREST.Config.Database
|
||||||
( queryDbSettings
|
( pgVersionStatement
|
||||||
|
, queryDbSettings
|
||||||
, queryPgVersion
|
, queryPgVersion
|
||||||
) where
|
) where
|
||||||
|
|
||||||
@@ -9,46 +10,54 @@ import PostgREST.Config.PgVersion (PgVersion (..))
|
|||||||
|
|
||||||
import qualified Hasql.Decoders as HD
|
import qualified Hasql.Decoders as HD
|
||||||
import qualified Hasql.Encoders as HE
|
import qualified Hasql.Encoders as HE
|
||||||
import qualified Hasql.Pool as P
|
import Hasql.Session (Session, statement)
|
||||||
import qualified Hasql.Session as H
|
import qualified Hasql.Statement as SQL
|
||||||
import qualified Hasql.Statement as H
|
import qualified Hasql.Transaction as SQL
|
||||||
import qualified Hasql.Transaction as HT
|
import qualified Hasql.Transaction.Sessions as SQL
|
||||||
import qualified Hasql.Transaction.Sessions as HT
|
|
||||||
|
|
||||||
import Text.InterpolatedString.Perl6 (q)
|
import Text.InterpolatedString.Perl6 (q)
|
||||||
|
|
||||||
import Protolude
|
import Protolude
|
||||||
|
|
||||||
queryPgVersion :: H.Session PgVersion
|
queryPgVersion :: Session PgVersion
|
||||||
queryPgVersion = H.statement mempty $ H.Statement sql HE.noParams versionRow False
|
queryPgVersion = statement mempty pgVersionStatement
|
||||||
|
|
||||||
|
pgVersionStatement :: SQL.Statement () PgVersion
|
||||||
|
pgVersionStatement = SQL.Statement sql HE.noParams versionRow False
|
||||||
where
|
where
|
||||||
sql = "SELECT current_setting('server_version_num')::integer, current_setting('server_version')"
|
sql = "SELECT current_setting('server_version_num')::integer, current_setting('server_version')"
|
||||||
versionRow = HD.singleRow $ PgVersion <$> column HD.int4 <*> column HD.text
|
versionRow = HD.singleRow $ PgVersion <$> column HD.int4 <*> column HD.text
|
||||||
|
|
||||||
queryDbSettings :: P.Pool -> Bool -> IO (Either P.UsageError [(Text, Text)])
|
queryDbSettings :: Bool -> Session [(Text, Text)]
|
||||||
queryDbSettings pool prepared =
|
queryDbSettings prepared =
|
||||||
let transaction = if prepared then HT.transaction else HT.unpreparedTransaction in
|
let transaction = if prepared then SQL.transaction else SQL.unpreparedTransaction in
|
||||||
P.use pool . transaction HT.ReadCommitted HT.Read $
|
transaction SQL.ReadCommitted SQL.Read $ SQL.statement mempty dbSettingsStatement
|
||||||
HT.statement mempty dbSettingsStatement
|
|
||||||
|
|
||||||
-- | Get db settings from the connection role. Global settings will be overridden by database specific settings.
|
-- | Get db settings from the connection role. Global settings will be overridden by database specific settings.
|
||||||
dbSettingsStatement :: H.Statement () [(Text, Text)]
|
dbSettingsStatement :: SQL.Statement () [(Text, Text)]
|
||||||
dbSettingsStatement = H.Statement sql HE.noParams decodeSettings False
|
dbSettingsStatement = SQL.Statement sql HE.noParams decodeSettings False
|
||||||
where
|
where
|
||||||
sql = [q|
|
sql = [q|
|
||||||
with
|
WITH
|
||||||
role_setting as (
|
role_setting (database, setting) AS (
|
||||||
select setdatabase, unnest(setconfig) as setting from pg_catalog.pg_db_role_setting
|
SELECT setdatabase,
|
||||||
where setrole = current_user::regrole::oid
|
unnest(setconfig)
|
||||||
and setdatabase in (0, (select oid from pg_catalog.pg_database where datname = current_catalog))
|
FROM pg_catalog.pg_db_role_setting
|
||||||
|
WHERE setrole = CURRENT_USER::regrole::oid
|
||||||
|
AND setdatabase IN (0, (SELECT oid FROM pg_catalog.pg_database WHERE datname = CURRENT_CATALOG))
|
||||||
),
|
),
|
||||||
kv_settings as (
|
kv_settings (database, k, v) AS (
|
||||||
select setdatabase, split_part(setting, '=', 1) as k, split_part(setting, '=', 2) as value from role_setting
|
SELECT database,
|
||||||
where setting like 'pgrst.%'
|
substr(setting, 1, strpos(setting, '=') - 1),
|
||||||
|
substr(setting, strpos(setting, '=') + 1)
|
||||||
|
FROM role_setting
|
||||||
|
WHERE setting LIKE 'pgrst.%'
|
||||||
)
|
)
|
||||||
select distinct on (key) replace(k, 'pgrst.', '') as key, value
|
SELECT DISTINCT ON (key)
|
||||||
from kv_settings
|
replace(k, 'pgrst.', '') AS key,
|
||||||
order by key, setdatabase desc;
|
v AS value
|
||||||
|
FROM kv_settings
|
||||||
|
ORDER BY key, database DESC;
|
||||||
|]
|
|]
|
||||||
decodeSettings = HD.rowList $ (,) <$> column HD.text <*> column HD.text
|
decodeSettings = HD.rowList $ (,) <$> column HD.text <*> column HD.text
|
||||||
|
|
||||||
|
|||||||
@@ -1,12 +1,7 @@
|
|||||||
{-|
|
|
||||||
Module : PostgREST.Types
|
|
||||||
Description : PostgREST common types and functions used by the rest of the modules
|
|
||||||
-}
|
|
||||||
{-# LANGUAGE DuplicateRecordFields #-}
|
|
||||||
|
|
||||||
module PostgREST.Config.JSPath
|
module PostgREST.Config.JSPath
|
||||||
( JSPath
|
( JSPath
|
||||||
, JSPathExp(..)
|
, JSPathExp(..)
|
||||||
|
, dumpJSPath
|
||||||
, pRoleClaimKey
|
, pRoleClaimKey
|
||||||
) where
|
) where
|
||||||
|
|
||||||
@@ -16,10 +11,7 @@ import Data.Either.Combinators (mapLeft)
|
|||||||
import Text.ParserCombinators.Parsec ((<?>))
|
import Text.ParserCombinators.Parsec ((<?>))
|
||||||
import Text.Read (read)
|
import Text.Read (read)
|
||||||
|
|
||||||
import qualified GHC.Show (show)
|
import Protolude
|
||||||
|
|
||||||
import Protolude hiding (toS)
|
|
||||||
import Protolude.Conv (toS)
|
|
||||||
|
|
||||||
|
|
||||||
-- | full jspath, e.g. .property[0].attr.detail
|
-- | full jspath, e.g. .property[0].attr.detail
|
||||||
@@ -30,10 +22,10 @@ data JSPathExp
|
|||||||
= JSPKey Text
|
= JSPKey Text
|
||||||
| JSPIdx Int
|
| JSPIdx Int
|
||||||
|
|
||||||
instance Show JSPathExp where
|
dumpJSPath :: JSPathExp -> Text
|
||||||
-- TODO: this needs to be quoted properly for special chars
|
-- TODO: this needs to be quoted properly for special chars
|
||||||
show (JSPKey k) = "." <> show k
|
dumpJSPath (JSPKey k) = "." <> show k
|
||||||
show (JSPIdx i) = "[" <> show i <> "]"
|
dumpJSPath (JSPIdx i) = "[" <> show i <> "]"
|
||||||
|
|
||||||
-- Used for the config value "role-claim-key"
|
-- Used for the config value "role-claim-key"
|
||||||
pRoleClaimKey :: Text -> Either Text JSPath
|
pRoleClaimKey :: Text -> Either Text JSPath
|
||||||
|
|||||||
@@ -3,15 +3,16 @@
|
|||||||
module PostgREST.Config.PgVersion
|
module PostgREST.Config.PgVersion
|
||||||
( PgVersion(..)
|
( PgVersion(..)
|
||||||
, minimumPgVersion
|
, minimumPgVersion
|
||||||
, pgVersion95
|
|
||||||
, pgVersion96
|
, pgVersion96
|
||||||
, pgVersion100
|
, pgVersion100
|
||||||
, pgVersion109
|
, pgVersion109
|
||||||
, pgVersion110
|
, pgVersion110
|
||||||
, pgVersion112
|
, pgVersion112
|
||||||
, pgVersion114
|
, pgVersion114
|
||||||
|
, pgVersion120
|
||||||
, pgVersion121
|
, pgVersion121
|
||||||
, pgVersion130
|
, pgVersion130
|
||||||
|
, pgVersion140
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import qualified Data.Aeson as JSON
|
import qualified Data.Aeson as JSON
|
||||||
@@ -30,10 +31,7 @@ instance Ord PgVersion where
|
|||||||
|
|
||||||
-- | Tells the minimum PostgreSQL version required by this version of PostgREST
|
-- | Tells the minimum PostgreSQL version required by this version of PostgREST
|
||||||
minimumPgVersion :: PgVersion
|
minimumPgVersion :: PgVersion
|
||||||
minimumPgVersion = pgVersion95
|
minimumPgVersion = pgVersion96
|
||||||
|
|
||||||
pgVersion95 :: PgVersion
|
|
||||||
pgVersion95 = PgVersion 90500 "9.5"
|
|
||||||
|
|
||||||
pgVersion96 :: PgVersion
|
pgVersion96 :: PgVersion
|
||||||
pgVersion96 = PgVersion 90600 "9.6"
|
pgVersion96 = PgVersion 90600 "9.6"
|
||||||
@@ -53,8 +51,14 @@ pgVersion112 = PgVersion 110002 "11.2"
|
|||||||
pgVersion114 :: PgVersion
|
pgVersion114 :: PgVersion
|
||||||
pgVersion114 = PgVersion 110004 "11.4"
|
pgVersion114 = PgVersion 110004 "11.4"
|
||||||
|
|
||||||
|
pgVersion120 :: PgVersion
|
||||||
|
pgVersion120 = PgVersion 120000 "12.0"
|
||||||
|
|
||||||
pgVersion121 :: PgVersion
|
pgVersion121 :: PgVersion
|
||||||
pgVersion121 = PgVersion 120001 "12.1"
|
pgVersion121 = PgVersion 120001 "12.1"
|
||||||
|
|
||||||
pgVersion130 :: PgVersion
|
pgVersion130 :: PgVersion
|
||||||
pgVersion130 = PgVersion 130000 "13.0"
|
pgVersion130 = PgVersion 130000 "13.0"
|
||||||
|
|
||||||
|
pgVersion140 :: PgVersion
|
||||||
|
pgVersion140 = PgVersion 140000 "14.0"
|
||||||
|
|||||||
@@ -8,13 +8,12 @@ module PostgREST.Config.Proxy
|
|||||||
, toURI
|
, toURI
|
||||||
) where
|
) where
|
||||||
|
|
||||||
|
import qualified Data.Text as T
|
||||||
|
|
||||||
import Data.Maybe (fromJust)
|
import Data.Maybe (fromJust)
|
||||||
import Data.Text (pack, toLower)
|
|
||||||
import Network.URI (URI (..), URIAuth (..), isAbsoluteURI, parseURI)
|
import Network.URI (URI (..), URIAuth (..), isAbsoluteURI, parseURI)
|
||||||
|
|
||||||
import Protolude hiding (Proxy, dropWhile, get, intercalate,
|
import Protolude hiding (Proxy)
|
||||||
toLower, toS, (&))
|
|
||||||
import Protolude.Conv (toS)
|
|
||||||
|
|
||||||
data Proxy = Proxy
|
data Proxy = Proxy
|
||||||
{ proxyScheme :: Text
|
{ proxyScheme :: Text
|
||||||
@@ -48,8 +47,8 @@ fAnd fs x = all ($ x) fs
|
|||||||
|
|
||||||
isSchemeValid :: URI -> Bool
|
isSchemeValid :: URI -> Bool
|
||||||
isSchemeValid URI {uriScheme = s}
|
isSchemeValid URI {uriScheme = s}
|
||||||
| toLower (pack s) == "https:" = True
|
| T.toLower (T.pack s) == "https:" = True
|
||||||
| toLower (pack s) == "http:" = True
|
| T.toLower (T.pack s) == "http:" = True
|
||||||
| otherwise = False
|
| otherwise = False
|
||||||
|
|
||||||
isQueryValid :: URI -> Bool
|
isQueryValid :: URI -> Bool
|
||||||
|
|||||||
@@ -1,64 +0,0 @@
|
|||||||
{-# LANGUAGE DuplicateRecordFields #-}
|
|
||||||
|
|
||||||
module PostgREST.ContentType
|
|
||||||
( ContentType(..)
|
|
||||||
, toHeader
|
|
||||||
, toMime
|
|
||||||
, decodeContentType
|
|
||||||
) where
|
|
||||||
|
|
||||||
import qualified Data.ByteString as BS
|
|
||||||
import qualified Data.ByteString.Internal as BS (c2w)
|
|
||||||
|
|
||||||
import Network.HTTP.Types.Header (Header, hContentType)
|
|
||||||
|
|
||||||
import Protolude
|
|
||||||
|
|
||||||
-- | Enumeration of currently supported response content types
|
|
||||||
data ContentType
|
|
||||||
= CTApplicationJSON
|
|
||||||
| CTSingularJSON
|
|
||||||
| CTTextCSV
|
|
||||||
| CTTextPlain
|
|
||||||
| CTOpenAPI
|
|
||||||
| CTUrlEncoded
|
|
||||||
| CTOctetStream
|
|
||||||
| CTAny
|
|
||||||
| CTOther ByteString
|
|
||||||
deriving (Eq)
|
|
||||||
|
|
||||||
-- | Convert from ContentType to a full HTTP Header
|
|
||||||
toHeader :: ContentType -> Header
|
|
||||||
toHeader ct = (hContentType, toMime ct <> charset)
|
|
||||||
where
|
|
||||||
charset = case ct of
|
|
||||||
CTOctetStream -> mempty
|
|
||||||
CTOther _ -> mempty
|
|
||||||
_ -> "; charset=utf-8"
|
|
||||||
|
|
||||||
-- | Convert from ContentType to a ByteString representing the mime type
|
|
||||||
toMime :: ContentType -> ByteString
|
|
||||||
toMime CTApplicationJSON = "application/json"
|
|
||||||
toMime CTTextCSV = "text/csv"
|
|
||||||
toMime CTTextPlain = "text/plain"
|
|
||||||
toMime CTOpenAPI = "application/openapi+json"
|
|
||||||
toMime CTSingularJSON = "application/vnd.pgrst.object+json"
|
|
||||||
toMime CTUrlEncoded = "application/x-www-form-urlencoded"
|
|
||||||
toMime CTOctetStream = "application/octet-stream"
|
|
||||||
toMime CTAny = "*/*"
|
|
||||||
toMime (CTOther ct) = ct
|
|
||||||
|
|
||||||
-- | Convert from ByteString to ContentType. Warning: discards MIME parameters
|
|
||||||
decodeContentType :: BS.ByteString -> ContentType
|
|
||||||
decodeContentType ct =
|
|
||||||
case BS.takeWhile (/= BS.c2w ';') ct of
|
|
||||||
"application/json" -> CTApplicationJSON
|
|
||||||
"text/csv" -> CTTextCSV
|
|
||||||
"text/plain" -> CTTextPlain
|
|
||||||
"application/openapi+json" -> CTOpenAPI
|
|
||||||
"application/vnd.pgrst.object+json" -> CTSingularJSON
|
|
||||||
"application/vnd.pgrst.object" -> CTSingularJSON
|
|
||||||
"application/x-www-form-urlencoded" -> CTUrlEncoded
|
|
||||||
"application/octet-stream" -> CTOctetStream
|
|
||||||
"*/*" -> CTAny
|
|
||||||
ct' -> CTOther ct'
|
|
||||||
@@ -0,0 +1,42 @@
|
|||||||
|
{-|
|
||||||
|
Module : PostgREST.Cors
|
||||||
|
Description : Wai Middleware to set cors policy.
|
||||||
|
-}
|
||||||
|
module PostgREST.Cors (middleware) where
|
||||||
|
|
||||||
|
import qualified Data.ByteString.Char8 as BS
|
||||||
|
import qualified Data.CaseInsensitive as CI
|
||||||
|
import qualified Network.Wai as Wai
|
||||||
|
import qualified Network.Wai.Middleware.Cors as Wai
|
||||||
|
|
||||||
|
import Data.List (lookup)
|
||||||
|
|
||||||
|
import Protolude
|
||||||
|
|
||||||
|
middleware :: Wai.Middleware
|
||||||
|
middleware = Wai.cors corsPolicy
|
||||||
|
|
||||||
|
-- | CORS policy to be used in by Wai Cors middleware
|
||||||
|
corsPolicy :: Wai.Request -> Maybe Wai.CorsResourcePolicy
|
||||||
|
corsPolicy req = case lookup "origin" headers of
|
||||||
|
Just origin ->
|
||||||
|
Just Wai.CorsResourcePolicy
|
||||||
|
{ Wai.corsOrigins = Just ([origin], True)
|
||||||
|
, Wai.corsMethods = ["GET", "POST", "PATCH", "PUT", "DELETE", "OPTIONS"]
|
||||||
|
, Wai.corsRequestHeaders = "Authorization" : accHeaders
|
||||||
|
, Wai.corsExposedHeaders = Just
|
||||||
|
[ "Content-Encoding", "Content-Location", "Content-Range", "Content-Type"
|
||||||
|
, "Date", "Location", "Server", "Transfer-Encoding", "Range-Unit"]
|
||||||
|
, Wai.corsMaxAge = Just $ 60*60*24
|
||||||
|
, Wai.corsVaryOrigin = False
|
||||||
|
, Wai.corsRequireOrigin = False
|
||||||
|
, Wai.corsIgnoreFailures = True
|
||||||
|
}
|
||||||
|
Nothing -> Nothing
|
||||||
|
where
|
||||||
|
headers = Wai.requestHeaders req
|
||||||
|
accHeaders = case lookup "access-control-request-headers" headers of
|
||||||
|
Just hdrs -> map (CI.mk . BS.strip) $ BS.split ',' hdrs
|
||||||
|
-- Impossible case, Middleware.Cors will not evaluate this when
|
||||||
|
-- the Access-Control-Request-Headers header is not set.
|
||||||
|
Nothing -> []
|
||||||
+556
-578
File diff suppressed because it is too large
Load Diff
@@ -6,12 +6,12 @@ module PostgREST.DbStructure.Identifiers
|
|||||||
, Schema
|
, Schema
|
||||||
, TableName
|
, TableName
|
||||||
, FieldName
|
, FieldName
|
||||||
|
, dumpQi
|
||||||
, toQi
|
, toQi
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import qualified Data.Aeson as JSON
|
import qualified Data.Aeson as JSON
|
||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
import qualified GHC.Show
|
|
||||||
|
|
||||||
import Protolude
|
import Protolude
|
||||||
|
|
||||||
@@ -26,9 +26,9 @@ data QualifiedIdentifier = QualifiedIdentifier
|
|||||||
|
|
||||||
instance Hashable QualifiedIdentifier
|
instance Hashable QualifiedIdentifier
|
||||||
|
|
||||||
instance Show QualifiedIdentifier where
|
dumpQi :: QualifiedIdentifier -> Text
|
||||||
show (QualifiedIdentifier s i) =
|
dumpQi (QualifiedIdentifier s i) =
|
||||||
(if T.null s then mempty else toS s <> ".") <> toS i
|
(if T.null s then mempty else s <> ".") <> i
|
||||||
|
|
||||||
-- TODO: Handle a case where the QI comes like this: "my.fav.schema"."my.identifier"
|
-- TODO: Handle a case where the QI comes like this: "my.fav.schema"."my.identifier"
|
||||||
-- Right now it only handles the schema.identifier case
|
-- Right now it only handles the schema.identifier case
|
||||||
|
|||||||
@@ -2,37 +2,26 @@
|
|||||||
{-# LANGUAGE DeriveGeneric #-}
|
{-# LANGUAGE DeriveGeneric #-}
|
||||||
|
|
||||||
module PostgREST.DbStructure.Proc
|
module PostgREST.DbStructure.Proc
|
||||||
( PgArg(..)
|
( PgType(..)
|
||||||
, PgType(..)
|
|
||||||
, ProcDescription(..)
|
, ProcDescription(..)
|
||||||
|
, ProcParam(..)
|
||||||
, ProcVolatility(..)
|
, ProcVolatility(..)
|
||||||
, ProcsMap
|
, ProcsMap
|
||||||
, RetType(..)
|
, RetType(..)
|
||||||
, procReturnsScalar
|
, procReturnsScalar
|
||||||
, procReturnsSingle
|
, procReturnsSingle
|
||||||
|
, procReturnsVoid
|
||||||
, procTableName
|
, procTableName
|
||||||
, specifiedProcArgs
|
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import qualified Data.Aeson as JSON
|
import qualified Data.Aeson as JSON
|
||||||
import qualified Data.HashMap.Strict as M
|
import qualified Data.HashMap.Strict as HM
|
||||||
import qualified Data.Set as S
|
|
||||||
|
|
||||||
import PostgREST.DbStructure.Identifiers (FieldName,
|
import PostgREST.DbStructure.Identifiers (QualifiedIdentifier (..),
|
||||||
QualifiedIdentifier (..),
|
|
||||||
Schema, TableName)
|
Schema, TableName)
|
||||||
|
|
||||||
import Protolude
|
import Protolude
|
||||||
|
|
||||||
|
|
||||||
data PgArg = PgArg
|
|
||||||
{ pgaName :: Text
|
|
||||||
, pgaType :: Text
|
|
||||||
, pgaReq :: Bool
|
|
||||||
, pgaVar :: Bool
|
|
||||||
}
|
|
||||||
deriving (Eq, Ord, Generic, JSON.ToJSON)
|
|
||||||
|
|
||||||
data PgType
|
data PgType
|
||||||
= Scalar
|
= Scalar
|
||||||
| Composite QualifiedIdentifier
|
| Composite QualifiedIdentifier
|
||||||
@@ -53,45 +42,50 @@ data ProcDescription = ProcDescription
|
|||||||
{ pdSchema :: Schema
|
{ pdSchema :: Schema
|
||||||
, pdName :: Text
|
, pdName :: Text
|
||||||
, pdDescription :: Maybe Text
|
, pdDescription :: Maybe Text
|
||||||
, pdArgs :: [PgArg]
|
, pdParams :: [ProcParam]
|
||||||
, pdReturnType :: RetType
|
, pdReturnType :: Maybe RetType
|
||||||
, pdVolatility :: ProcVolatility
|
, pdVolatility :: ProcVolatility
|
||||||
, pdHasVariadic :: Bool
|
, pdHasVariadic :: Bool
|
||||||
}
|
}
|
||||||
deriving (Eq, Generic, JSON.ToJSON)
|
deriving (Eq, Generic, JSON.ToJSON)
|
||||||
|
|
||||||
-- Order by least number of args in the case of overloaded functions
|
data ProcParam = ProcParam
|
||||||
|
{ ppName :: Text
|
||||||
|
, ppType :: Text
|
||||||
|
, ppReq :: Bool
|
||||||
|
, ppVar :: Bool
|
||||||
|
}
|
||||||
|
deriving (Eq, Ord, Generic, JSON.ToJSON)
|
||||||
|
|
||||||
|
-- Order by least number of params in the case of overloaded functions
|
||||||
instance Ord ProcDescription where
|
instance Ord ProcDescription where
|
||||||
ProcDescription schema1 name1 des1 args1 rt1 vol1 hasVar1 `compare` ProcDescription schema2 name2 des2 args2 rt2 vol2 hasVar2
|
ProcDescription schema1 name1 des1 prms1 rt1 vol1 hasVar1 `compare` ProcDescription schema2 name2 des2 prms2 rt2 vol2 hasVar2
|
||||||
| schema1 == schema2 && name1 == name2 && length args1 < length args2 = LT
|
| schema1 == schema2 && name1 == name2 && length prms1 < length prms2 = LT
|
||||||
| schema2 == schema2 && name1 == name2 && length args1 > length args2 = GT
|
| schema2 == schema2 && name1 == name2 && length prms1 > length prms2 = GT
|
||||||
| otherwise = (schema1, name1, des1, args1, rt1, vol1, hasVar1) `compare` (schema2, name2, des2, args2, rt2, vol2, hasVar2)
|
| otherwise = (schema1, name1, des1, prms1, rt1, vol1, hasVar1) `compare` (schema2, name2, des2, prms2, rt2, vol2, hasVar2)
|
||||||
|
|
||||||
-- | A map of all procs, all of which can be overloaded(one entry will have more than one ProcDescription).
|
-- | A map of all procs, all of which can be overloaded(one entry will have more than one ProcDescription).
|
||||||
-- | It uses a HashMap for a faster lookup.
|
-- | It uses a HashMap for a faster lookup.
|
||||||
type ProcsMap = M.HashMap QualifiedIdentifier [ProcDescription]
|
type ProcsMap = HM.HashMap QualifiedIdentifier [ProcDescription]
|
||||||
|
|
||||||
{-|
|
|
||||||
Search the procedure parameters by matching them with the specified keys.
|
|
||||||
If the key doesn't match a parameter, a parameter with a default type "text" is assumed.
|
|
||||||
-}
|
|
||||||
specifiedProcArgs :: S.Set FieldName -> ProcDescription -> [PgArg]
|
|
||||||
specifiedProcArgs keys proc =
|
|
||||||
(\k -> fromMaybe (PgArg k "text" True False) (find ((==) k . pgaName) (pdArgs proc))) <$> S.toList keys
|
|
||||||
|
|
||||||
procReturnsScalar :: ProcDescription -> Bool
|
procReturnsScalar :: ProcDescription -> Bool
|
||||||
procReturnsScalar proc = case proc of
|
procReturnsScalar proc = case proc of
|
||||||
ProcDescription{pdReturnType = (Single Scalar)} -> True
|
ProcDescription{pdReturnType = Just (Single Scalar)} -> True
|
||||||
ProcDescription{pdReturnType = (SetOf Scalar)} -> True
|
ProcDescription{pdReturnType = Just (SetOf Scalar)} -> True
|
||||||
_ -> False
|
_ -> False
|
||||||
|
|
||||||
procReturnsSingle :: ProcDescription -> Bool
|
procReturnsSingle :: ProcDescription -> Bool
|
||||||
procReturnsSingle proc = case proc of
|
procReturnsSingle proc = case proc of
|
||||||
ProcDescription{pdReturnType = (Single _)} -> True
|
ProcDescription{pdReturnType = Just (Single _)} -> True
|
||||||
_ -> False
|
_ -> False
|
||||||
|
|
||||||
|
procReturnsVoid :: ProcDescription -> Bool
|
||||||
|
procReturnsVoid proc = case proc of
|
||||||
|
ProcDescription{pdReturnType = Nothing} -> True
|
||||||
|
_ -> False
|
||||||
|
|
||||||
procTableName :: ProcDescription -> Maybe TableName
|
procTableName :: ProcDescription -> Maybe TableName
|
||||||
procTableName proc = case pdReturnType proc of
|
procTableName proc = case pdReturnType proc of
|
||||||
SetOf (Composite qi) -> Just $ qiName qi
|
Just (SetOf (Composite qi)) -> Just $ qiName qi
|
||||||
Single (Composite qi) -> Just $ qiName qi
|
Just (Single (Composite qi)) -> Just $ qiName qi
|
||||||
_ -> Nothing
|
_ -> Nothing
|
||||||
|
|||||||
@@ -3,60 +3,62 @@
|
|||||||
|
|
||||||
module PostgREST.DbStructure.Relationship
|
module PostgREST.DbStructure.Relationship
|
||||||
( Cardinality(..)
|
( Cardinality(..)
|
||||||
, PrimaryKey(..)
|
|
||||||
, Relationship(..)
|
, Relationship(..)
|
||||||
, Junction(..)
|
, Junction(..)
|
||||||
, isSelfReference
|
, RelationshipsMap
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import qualified Data.Aeson as JSON
|
import qualified Data.Aeson as JSON
|
||||||
|
import qualified Data.HashMap.Strict as HM
|
||||||
|
|
||||||
import PostgREST.DbStructure.Table (Column (..), Table (..))
|
import PostgREST.DbStructure.Identifiers (FieldName,
|
||||||
|
QualifiedIdentifier, Schema)
|
||||||
|
|
||||||
import Protolude
|
import Protolude
|
||||||
|
|
||||||
|
|
||||||
-- | Relationship between two tables.
|
-- | Relationship between two tables.
|
||||||
--
|
|
||||||
-- The order of the relColumns and relForeignColumns should be maintained to get the
|
|
||||||
-- join conditions right.
|
|
||||||
--
|
|
||||||
-- TODO merge relColumns and relForeignColumns to a tuple or Data.Bimap
|
|
||||||
data Relationship = Relationship
|
data Relationship = Relationship
|
||||||
{ relTable :: Table
|
{ relTable :: QualifiedIdentifier
|
||||||
, relColumns :: [Column]
|
, relForeignTable :: QualifiedIdentifier
|
||||||
, relForeignTable :: Table
|
, relIsSelf :: Bool -- ^ Whether is a self relationship
|
||||||
, relForeignColumns :: [Column]
|
, relCardinality :: Cardinality
|
||||||
, relCardinality :: Cardinality
|
, relTableIsView :: Bool
|
||||||
|
, relFTableIsView :: Bool
|
||||||
}
|
}
|
||||||
deriving (Eq, Generic, JSON.ToJSON)
|
| ComputedRelationship
|
||||||
|
{ relFunction :: QualifiedIdentifier
|
||||||
|
, relTable :: QualifiedIdentifier
|
||||||
|
, relForeignTable :: QualifiedIdentifier
|
||||||
|
, relToOne :: Bool
|
||||||
|
, relIsSelf :: Bool
|
||||||
|
}
|
||||||
|
deriving (Eq, Ord, Generic, JSON.ToJSON)
|
||||||
|
|
||||||
-- | The relationship cardinality
|
-- | The relationship cardinality
|
||||||
-- | https://en.wikipedia.org/wiki/Cardinality_(data_modeling)
|
-- | https://en.wikipedia.org/wiki/Cardinality_(data_modeling)
|
||||||
-- TODO: missing one-to-one
|
|
||||||
data Cardinality
|
data Cardinality
|
||||||
= O2M FKConstraint -- ^ one-to-many cardinality
|
= O2M {relCons :: FKConstraint, relColumns :: [(FieldName, FieldName)]}
|
||||||
| M2O FKConstraint -- ^ many-to-one cardinality
|
-- ^ one-to-many
|
||||||
| M2M Junction -- ^ many-to-many cardinality
|
| M2O {relCons :: FKConstraint, relColumns :: [(FieldName, FieldName)]}
|
||||||
deriving (Eq, Generic, JSON.ToJSON)
|
-- ^ many-to-one
|
||||||
|
| O2O {relCons :: FKConstraint, relColumns :: [(FieldName, FieldName)]}
|
||||||
|
-- ^ one-to-one, this is a refinement over M2O so operating on it is pretty much the same as M2O
|
||||||
|
| M2M Junction
|
||||||
|
-- ^ many-to-many
|
||||||
|
deriving (Eq, Ord, Generic, JSON.ToJSON)
|
||||||
|
|
||||||
type FKConstraint = Text
|
type FKConstraint = Text
|
||||||
|
|
||||||
-- | Junction table on an M2M relationship
|
-- | Junction table on an M2M relationship
|
||||||
data Junction = Junction
|
data Junction = Junction
|
||||||
{ junTable :: Table
|
{ junTable :: QualifiedIdentifier
|
||||||
, junConstraint1 :: FKConstraint
|
, junConstraint1 :: FKConstraint
|
||||||
, junColumns1 :: [Column]
|
|
||||||
, junConstraint2 :: FKConstraint
|
, junConstraint2 :: FKConstraint
|
||||||
, junColumns2 :: [Column]
|
, junColumns1 :: [(FieldName, FieldName)]
|
||||||
|
, junColumns2 :: [(FieldName, FieldName)]
|
||||||
}
|
}
|
||||||
deriving (Eq, Generic, JSON.ToJSON)
|
deriving (Eq, Ord, Generic, JSON.ToJSON)
|
||||||
|
|
||||||
isSelfReference :: Relationship -> Bool
|
-- | Key based on the source table and the foreign table schema
|
||||||
isSelfReference r = relTable r == relForeignTable r
|
type RelationshipsMap = HM.HashMap (QualifiedIdentifier, Schema) [Relationship]
|
||||||
|
|
||||||
data PrimaryKey = PrimaryKey
|
|
||||||
{ pkTable :: Table
|
|
||||||
, pkName :: Text
|
|
||||||
}
|
|
||||||
deriving (Generic, JSON.ToJSON)
|
|
||||||
|
|||||||
@@ -4,10 +4,11 @@
|
|||||||
module PostgREST.DbStructure.Table
|
module PostgREST.DbStructure.Table
|
||||||
( Column(..)
|
( Column(..)
|
||||||
, Table(..)
|
, Table(..)
|
||||||
, tableQi
|
, TablesMap
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import qualified Data.Aeson as JSON
|
import qualified Data.Aeson as JSON
|
||||||
|
import qualified Data.HashMap.Strict as HM
|
||||||
|
|
||||||
import PostgREST.DbStructure.Identifiers (FieldName,
|
import PostgREST.DbStructure.Identifiers (FieldName,
|
||||||
QualifiedIdentifier (..),
|
QualifiedIdentifier (..),
|
||||||
@@ -20,22 +21,22 @@ data Table = Table
|
|||||||
{ tableSchema :: Schema
|
{ tableSchema :: Schema
|
||||||
, tableName :: TableName
|
, tableName :: TableName
|
||||||
, tableDescription :: Maybe Text
|
, tableDescription :: Maybe Text
|
||||||
|
-- TODO Find a better way to separate tables and views
|
||||||
|
, tableIsView :: Bool
|
||||||
-- The following fields identify what can be done on the table/view, they're not related to the privileges granted to it
|
-- The following fields identify what can be done on the table/view, they're not related to the privileges granted to it
|
||||||
, tableInsertable :: Bool
|
, tableInsertable :: Bool
|
||||||
, tableUpdatable :: Bool
|
, tableUpdatable :: Bool
|
||||||
, tableDeletable :: Bool
|
, tableDeletable :: Bool
|
||||||
|
, tablePKCols :: [FieldName]
|
||||||
|
, tableColumns :: [Column]
|
||||||
}
|
}
|
||||||
deriving (Show, Ord, Generic, JSON.ToJSON)
|
deriving (Show, Ord, Generic, JSON.ToJSON)
|
||||||
|
|
||||||
instance Eq Table where
|
instance Eq Table where
|
||||||
Table{tableSchema=s1,tableName=n1} == Table{tableSchema=s2,tableName=n2} = s1 == s2 && n1 == n2
|
Table{tableSchema=s1,tableName=n1} == Table{tableSchema=s2,tableName=n2} = s1 == s2 && n1 == n2
|
||||||
|
|
||||||
tableQi :: Table -> QualifiedIdentifier
|
|
||||||
tableQi Table{tableSchema=s, tableName=n} = QualifiedIdentifier s n
|
|
||||||
|
|
||||||
data Column = Column
|
data Column = Column
|
||||||
{ colTable :: Table
|
{ colName :: FieldName
|
||||||
, colName :: FieldName
|
|
||||||
, colDescription :: Maybe Text
|
, colDescription :: Maybe Text
|
||||||
, colNullable :: Bool
|
, colNullable :: Bool
|
||||||
, colType :: Text
|
, colType :: Text
|
||||||
@@ -43,13 +44,6 @@ data Column = Column
|
|||||||
, colDefault :: Maybe Text
|
, colDefault :: Maybe Text
|
||||||
, colEnum :: [Text]
|
, colEnum :: [Text]
|
||||||
}
|
}
|
||||||
deriving (Ord, Generic, JSON.ToJSON)
|
deriving (Eq, Show, Ord, Generic, JSON.ToJSON)
|
||||||
|
|
||||||
instance Eq Column where
|
type TablesMap = HM.HashMap QualifiedIdentifier Table
|
||||||
Column{colTable=t1,colName=n1} == Column{colTable=t2,colName=n2} = t1 == t2 && n1 == n2
|
|
||||||
|
|
||||||
data PrimaryKey = PrimaryKey
|
|
||||||
{ pkTable :: Table
|
|
||||||
, pkName :: Text
|
|
||||||
}
|
|
||||||
deriving (Generic, JSON.ToJSON)
|
|
||||||
|
|||||||
+391
-214
@@ -16,32 +16,35 @@ module PostgREST.Error
|
|||||||
) where
|
) where
|
||||||
|
|
||||||
import qualified Data.Aeson as JSON
|
import qualified Data.Aeson as JSON
|
||||||
|
import qualified Data.ByteString.Char8 as BS
|
||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
import qualified Hasql.Pool as P
|
import qualified Data.Text.Encoding as T
|
||||||
import qualified Hasql.Session as H
|
import qualified Data.Text.Encoding.Error as T
|
||||||
import qualified Network.HTTP.Types.Status as HT
|
import qualified Hasql.Pool as SQL
|
||||||
|
import qualified Hasql.Session as SQL
|
||||||
|
import qualified Network.HTTP.Types.Status as HTTP
|
||||||
|
|
||||||
import Data.Aeson ((.=))
|
import Data.Aeson ((.=))
|
||||||
import Network.Wai (Response, responseLBS)
|
import Network.Wai (Response, responseLBS)
|
||||||
|
|
||||||
import Network.HTTP.Types.Header (Header)
|
import Network.HTTP.Types.Header (Header)
|
||||||
|
|
||||||
import PostgREST.ContentType (ContentType (..))
|
import PostgREST.MediaType (MediaType (..))
|
||||||
import qualified PostgREST.ContentType as ContentType
|
import qualified PostgREST.MediaType as MediaType
|
||||||
|
import PostgREST.Request.Types (ApiRequestError (..),
|
||||||
|
QPError (..))
|
||||||
|
|
||||||
import PostgREST.DbStructure.Proc (PgArg (..),
|
import PostgREST.DbStructure.Identifiers (QualifiedIdentifier (..))
|
||||||
ProcDescription (..))
|
import PostgREST.DbStructure.Proc (ProcDescription (..),
|
||||||
|
ProcParam (..))
|
||||||
import PostgREST.DbStructure.Relationship (Cardinality (..),
|
import PostgREST.DbStructure.Relationship (Cardinality (..),
|
||||||
Junction (..),
|
Junction (..),
|
||||||
Relationship (..))
|
Relationship (..))
|
||||||
import PostgREST.DbStructure.Table (Column (..), Table (..))
|
import Protolude
|
||||||
|
|
||||||
import Protolude hiding (toS)
|
|
||||||
import Protolude.Conv (toS, toSL)
|
|
||||||
|
|
||||||
|
|
||||||
class (JSON.ToJSON a) => PgrstError a where
|
class (JSON.ToJSON a) => PgrstError a where
|
||||||
status :: a -> HT.Status
|
status :: a -> HTTP.Status
|
||||||
headers :: a -> [Header]
|
headers :: a -> [Header]
|
||||||
|
|
||||||
errorPayload :: a -> LByteString
|
errorPayload :: a -> LByteString
|
||||||
@@ -50,272 +53,365 @@ class (JSON.ToJSON a) => PgrstError a where
|
|||||||
errorResponseFor :: a -> Response
|
errorResponseFor :: a -> Response
|
||||||
errorResponseFor err = responseLBS (status err) (headers err) $ errorPayload err
|
errorResponseFor err = responseLBS (status err) (headers err) $ errorPayload err
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
data ApiRequestError
|
|
||||||
= ActionInappropriate
|
|
||||||
| InvalidRange
|
|
||||||
| InvalidBody ByteString
|
|
||||||
| ParseRequestError Text Text
|
|
||||||
| NoRelBetween Text Text
|
|
||||||
| AmbiguousRelBetween Text Text [Relationship]
|
|
||||||
| AmbiguousRpc [ProcDescription]
|
|
||||||
| NoRpc Text Text [Text] Bool
|
|
||||||
| InvalidFilters
|
|
||||||
| UnacceptableSchema [Text]
|
|
||||||
| ContentTypeError [ByteString]
|
|
||||||
| UnsupportedVerb -- Unreachable?
|
|
||||||
|
|
||||||
instance PgrstError ApiRequestError where
|
instance PgrstError ApiRequestError where
|
||||||
status InvalidRange = HT.status416
|
status AmbiguousRelBetween{} = HTTP.status300
|
||||||
status InvalidFilters = HT.status405
|
status AmbiguousRpc{} = HTTP.status300
|
||||||
status (InvalidBody _) = HT.status400
|
status MediaTypeError{} = HTTP.status415
|
||||||
status UnsupportedVerb = HT.status405
|
status InvalidBody{} = HTTP.status400
|
||||||
status ActionInappropriate = HT.status405
|
status InvalidFilters = HTTP.status405
|
||||||
status (ParseRequestError _ _) = HT.status400
|
status InvalidRpcMethod{} = HTTP.status405
|
||||||
status (NoRelBetween _ _) = HT.status400
|
status InvalidRange = HTTP.status416
|
||||||
status AmbiguousRelBetween{} = HT.status300
|
status NotFound = HTTP.status404
|
||||||
status (AmbiguousRpc _) = HT.status300
|
status NoRelBetween{} = HTTP.status400
|
||||||
status NoRpc{} = HT.status404
|
status NoRpc{} = HTTP.status404
|
||||||
status (UnacceptableSchema _) = HT.status406
|
status NotEmbedded{} = HTTP.status400
|
||||||
status (ContentTypeError _) = HT.status415
|
status ParseRequestError{} = HTTP.status400
|
||||||
|
status PutRangeNotAllowedError = HTTP.status400
|
||||||
|
status QueryParamError{} = HTTP.status400
|
||||||
|
status UnacceptableSchema{} = HTTP.status406
|
||||||
|
status UnsupportedMethod{} = HTTP.status405
|
||||||
|
status LimitNoOrderError = HTTP.status400
|
||||||
|
|
||||||
headers _ = [ContentType.toHeader CTApplicationJSON]
|
headers _ = [MediaType.toContentType MTApplicationJSON]
|
||||||
|
|
||||||
instance JSON.ToJSON ApiRequestError where
|
instance JSON.ToJSON ApiRequestError where
|
||||||
toJSON (ParseRequestError message details) = JSON.object [
|
toJSON (QueryParamError (QPError message details)) = JSON.object [
|
||||||
"message" .= message, "details" .= details]
|
"code" .= ApiRequestErrorCode00,
|
||||||
toJSON ActionInappropriate = JSON.object [
|
"message" .= message,
|
||||||
"message" .= ("Bad Request" :: Text)]
|
"details" .= details,
|
||||||
|
"hint" .= JSON.Null]
|
||||||
|
toJSON (InvalidRpcMethod method) = JSON.object [
|
||||||
|
"code" .= ApiRequestErrorCode01,
|
||||||
|
"message" .= ("Cannot use the " <> T.decodeUtf8 method <> " method on RPC"),
|
||||||
|
"details" .= JSON.Null,
|
||||||
|
"hint" .= JSON.Null]
|
||||||
toJSON (InvalidBody errorMessage) = JSON.object [
|
toJSON (InvalidBody errorMessage) = JSON.object [
|
||||||
"message" .= (toS errorMessage :: Text)]
|
"code" .= ApiRequestErrorCode02,
|
||||||
|
"message" .= T.decodeUtf8 errorMessage,
|
||||||
|
"details" .= JSON.Null,
|
||||||
|
"hint" .= JSON.Null]
|
||||||
toJSON InvalidRange = JSON.object [
|
toJSON InvalidRange = JSON.object [
|
||||||
"message" .= ("HTTP Range error" :: Text)]
|
"code" .= ApiRequestErrorCode03,
|
||||||
toJSON (NoRelBetween parent child) = JSON.object [
|
"message" .= ("HTTP Range error" :: Text),
|
||||||
"hint" .= ("If a new foreign key between these entities was created in the database, try reloading the schema cache." :: Text),
|
"details" .= JSON.Null,
|
||||||
"message" .= ("Could not find a relationship between " <> parent <> " and " <> child <> " in the schema cache" :: Text)]
|
"hint" .= JSON.Null]
|
||||||
toJSON (AmbiguousRelBetween parent child rels) = JSON.object [
|
toJSON (ParseRequestError message details) = JSON.object [
|
||||||
"hint" .= ("By following the 'details' key, disambiguate the request by changing the url to /origin?select=relationship(*) or /origin?select=target!relationship(*)" :: Text),
|
"code" .= ApiRequestErrorCode04,
|
||||||
"message" .= ("More than one relationship was found for " <> parent <> " and " <> child :: Text),
|
"message" .= message,
|
||||||
"details" .= (compressedRel <$> rels) ]
|
"details" .= details,
|
||||||
toJSON (AmbiguousRpc procs) = JSON.object [
|
"hint" .= JSON.Null]
|
||||||
"hint" .= ("Overloaded functions with the same argument name but different types are not supported" :: Text),
|
|
||||||
"message" .= ("Could not choose the best candidate function between: " <> T.intercalate ", " [pdSchema p <> "." <> pdName p <> "(" <> T.intercalate ", " [pgaName a <> " => " <> pgaType a | a <- pdArgs p] <> ")" | p <- procs])]
|
|
||||||
toJSON (NoRpc schema procName payloadKeys hasPreferSingleObject) = JSON.object [
|
|
||||||
"hint" .= ("If a new function was created in the database with this name and arguments, try reloading the schema cache." :: Text),
|
|
||||||
"message" .= ("Could not find the " <> schema <> "." <> procName <> (if hasPreferSingleObject then " function with a single json or jsonb argument" else "(" <> T.intercalate ", " payloadKeys <> ")" <> " function") <> " in the schema cache")]
|
|
||||||
toJSON UnsupportedVerb = JSON.object [
|
|
||||||
"message" .= ("Unsupported HTTP verb" :: Text)]
|
|
||||||
toJSON InvalidFilters = JSON.object [
|
toJSON InvalidFilters = JSON.object [
|
||||||
"message" .= ("Filters must include all and only primary key columns with 'eq' operators" :: Text)]
|
"code" .= ApiRequestErrorCode05,
|
||||||
|
"message" .= ("Filters must include all and only primary key columns with 'eq' operators" :: Text),
|
||||||
|
"details" .= JSON.Null,
|
||||||
|
"hint" .= JSON.Null]
|
||||||
toJSON (UnacceptableSchema schemas) = JSON.object [
|
toJSON (UnacceptableSchema schemas) = JSON.object [
|
||||||
"message" .= ("The schema must be one of the following: " <> T.intercalate ", " schemas)]
|
"code" .= ApiRequestErrorCode06,
|
||||||
toJSON (ContentTypeError cts) = JSON.object [
|
"message" .= ("The schema must be one of the following: " <> T.intercalate ", " schemas),
|
||||||
"message" .= ("None of these Content-Types are available: " <> (toS . intercalate ", " . map toS) cts :: Text)]
|
"details" .= JSON.Null,
|
||||||
|
"hint" .= JSON.Null]
|
||||||
|
toJSON (MediaTypeError cts) = JSON.object [
|
||||||
|
"code" .= ApiRequestErrorCode07,
|
||||||
|
"message" .= ("None of these media types are available: " <> T.intercalate ", " (map T.decodeUtf8 cts)),
|
||||||
|
"details" .= JSON.Null,
|
||||||
|
"hint" .= JSON.Null]
|
||||||
|
toJSON NotFound = JSON.object []
|
||||||
|
toJSON (NotEmbedded resource) = JSON.object [
|
||||||
|
"code" .= ApiRequestErrorCode08,
|
||||||
|
"message" .= ("Cannot apply filter because '" <> resource <> "' is not an embedded resource in this request" :: Text),
|
||||||
|
"details" .= JSON.Null,
|
||||||
|
"hint" .= ("Verify that '" <> resource <> "' is included in the 'select' query parameter." :: Text)]
|
||||||
|
|
||||||
|
toJSON LimitNoOrderError = JSON.object [
|
||||||
|
"code" .= ApiRequestErrorCode09,
|
||||||
|
"message" .= ("A 'limit' was applied without an explicit 'order'":: Text),
|
||||||
|
"details" .= JSON.Null,
|
||||||
|
"hint" .= ("Apply an 'order' using unique column(s)" :: Text)]
|
||||||
|
|
||||||
|
toJSON PutRangeNotAllowedError = JSON.object [
|
||||||
|
"code" .= ApiRequestErrorCode14,
|
||||||
|
"message" .= ("Range header and limit/offset querystring parameters are not allowed for PUT" :: Text),
|
||||||
|
"details" .= JSON.Null,
|
||||||
|
"hint" .= JSON.Null]
|
||||||
|
|
||||||
|
toJSON (UnsupportedMethod method) = JSON.object [
|
||||||
|
"code" .= ApiRequestErrorCode17,
|
||||||
|
"message" .= ("Unsupported HTTP method: " <> T.decodeUtf8 method),
|
||||||
|
"details" .= JSON.Null,
|
||||||
|
"hint" .= JSON.Null]
|
||||||
|
|
||||||
|
toJSON (NoRelBetween parent child schema) = JSON.object [
|
||||||
|
"code" .= SchemaCacheErrorCode00,
|
||||||
|
"message" .= ("Could not find a relationship between '" <> parent <> "' and '" <> child <> "' in the schema cache" :: Text),
|
||||||
|
"details" .= JSON.Null,
|
||||||
|
"hint" .= ("Verify that '" <> parent <> "' and '" <> child <> "' exist in the schema '" <> schema <> "' and that there is a foreign key relationship between them. If a new relationship was created, try reloading the schema cache." :: Text)]
|
||||||
|
toJSON (AmbiguousRelBetween parent child rels) = JSON.object [
|
||||||
|
"code" .= SchemaCacheErrorCode01,
|
||||||
|
"message" .= ("Could not embed because more than one relationship was found for '" <> parent <> "' and '" <> child <> "'" :: Text),
|
||||||
|
"details" .= (compressedRel <$> rels),
|
||||||
|
"hint" .= ("Try changing '" <> child <> "' to one of the following: " <> relHint rels <> ". Find the desired relationship in the 'details' key." :: Text)]
|
||||||
|
toJSON (NoRpc schema procName argumentKeys hasPreferSingleObject contentType isInvPost) =
|
||||||
|
let prms = "(" <> T.intercalate ", " argumentKeys <> ")" in JSON.object [
|
||||||
|
"code" .= SchemaCacheErrorCode02,
|
||||||
|
"message" .= ("Could not find the " <> schema <> "." <> procName <>
|
||||||
|
(case (hasPreferSingleObject, isInvPost, contentType) of
|
||||||
|
(True, _, _) -> " function with a single json or jsonb parameter"
|
||||||
|
(_, True, MTTextPlain) -> " function with a single unnamed text parameter"
|
||||||
|
(_, True, MTTextXML) -> " function with a single unnamed xml parameter"
|
||||||
|
(_, True, MTOctetStream) -> " function with a single unnamed bytea parameter"
|
||||||
|
(_, True, MTApplicationJSON) -> prms <> " function or the " <> schema <> "." <> procName <>" function with a single unnamed json or jsonb parameter"
|
||||||
|
_ -> prms <> " function") <>
|
||||||
|
" in the schema cache"),
|
||||||
|
"details" .= JSON.Null,
|
||||||
|
"hint" .= ("If a new function was created in the database with this name and parameters, try reloading the schema cache." :: Text)]
|
||||||
|
toJSON (AmbiguousRpc procs) = JSON.object [
|
||||||
|
"code" .= SchemaCacheErrorCode03,
|
||||||
|
"message" .= ("Could not choose the best candidate function between: " <> T.intercalate ", " [pdSchema p <> "." <> pdName p <> "(" <> T.intercalate ", " [ppName a <> " => " <> ppType a | a <- pdParams p] <> ")" | p <- procs]),
|
||||||
|
"details" .= JSON.Null,
|
||||||
|
"hint" .= ("Try renaming the parameters or the function itself in the database so function overloading can be resolved" :: Text)]
|
||||||
|
|
||||||
compressedRel :: Relationship -> JSON.Value
|
compressedRel :: Relationship -> JSON.Value
|
||||||
|
-- An ambiguousness error cannot happen for computed relationships TODO refactor so this mempty is not needed
|
||||||
|
compressedRel ComputedRelationship{} = JSON.object mempty
|
||||||
compressedRel Relationship{..} =
|
compressedRel Relationship{..} =
|
||||||
let
|
let
|
||||||
fmtTbl Table{..} = tableSchema <> "." <> tableName
|
fmtEls els = "(" <> T.intercalate ", " els <> ")"
|
||||||
fmtEls els = "[" <> T.intercalate ", " els <> "]"
|
|
||||||
in
|
in
|
||||||
JSON.object $ [
|
JSON.object $
|
||||||
"origin" .= fmtTbl relTable
|
("embedding" .= (qiName relTable <> " with " <> qiName relForeignTable :: Text))
|
||||||
, "target" .= fmtTbl relForeignTable
|
: case relCardinality of
|
||||||
] ++
|
M2M Junction{..} -> [
|
||||||
case relCardinality of
|
"cardinality" .= ("many-to-many" :: Text)
|
||||||
M2M Junction{..} -> [
|
, "relationship" .= (qiName junTable <> " using " <> junConstraint1 <> fmtEls (snd <$> junColumns1) <> " and " <> junConstraint2 <> fmtEls (snd <$> junColumns2))
|
||||||
"cardinality" .= ("m2m" :: Text)
|
]
|
||||||
, "relationship" .= (fmtTbl junTable <> fmtEls [junConstraint1] <> fmtEls [junConstraint2])
|
M2O cons relColumns -> [
|
||||||
]
|
"cardinality" .= ("many-to-one" :: Text)
|
||||||
M2O cons -> [
|
, "relationship" .= (cons <> " using " <> qiName relTable <> fmtEls (fst <$> relColumns) <> " and " <> qiName relForeignTable <> fmtEls (snd <$> relColumns))
|
||||||
"cardinality" .= ("m2o" :: Text)
|
]
|
||||||
, "relationship" .= (cons <> fmtEls (colName <$> relColumns) <> fmtEls (colName <$> relForeignColumns))
|
O2O cons relColumns -> [
|
||||||
]
|
"cardinality" .= ("one-to-one" :: Text)
|
||||||
O2M cons -> [
|
, "relationship" .= (cons <> " using " <> qiName relTable <> fmtEls (fst <$> relColumns) <> " and " <> qiName relForeignTable <> fmtEls (snd <$> relColumns))
|
||||||
"cardinality" .= ("o2m" :: Text)
|
]
|
||||||
, "relationship" .= (cons <> fmtEls (colName <$> relColumns) <> fmtEls (colName <$> relForeignColumns))
|
O2M cons relColumns -> [
|
||||||
]
|
"cardinality" .= ("one-to-many" :: Text)
|
||||||
|
, "relationship" .= (cons <> " using " <> qiName relTable <> fmtEls (fst <$> relColumns) <> " and " <> qiName relForeignTable <> fmtEls (snd <$> relColumns))
|
||||||
|
]
|
||||||
|
|
||||||
data PgError = PgError Authenticated P.UsageError
|
relHint :: [Relationship] -> Text
|
||||||
|
relHint rels = T.intercalate ", " (hintList <$> rels)
|
||||||
|
where
|
||||||
|
hintList Relationship{..} =
|
||||||
|
let buildHint rel = "'" <> qiName relForeignTable <> "!" <> rel <> "'" in
|
||||||
|
case relCardinality of
|
||||||
|
M2M Junction{..} -> buildHint (qiName junTable)
|
||||||
|
M2O cons _ -> buildHint cons
|
||||||
|
O2O cons _ -> buildHint cons
|
||||||
|
O2M cons _ -> buildHint cons
|
||||||
|
-- An ambiguousness error cannot happen for computed relationships TODO refactor so this mempty is not needed
|
||||||
|
hintList ComputedRelationship{} = mempty
|
||||||
|
|
||||||
|
data PgError = PgError Authenticated SQL.UsageError
|
||||||
type Authenticated = Bool
|
type Authenticated = Bool
|
||||||
|
|
||||||
instance PgrstError PgError where
|
instance PgrstError PgError where
|
||||||
status (PgError authed usageError) = pgErrorStatus authed usageError
|
status (PgError authed usageError) = pgErrorStatus authed usageError
|
||||||
|
|
||||||
headers err =
|
headers err =
|
||||||
if status err == HT.status401
|
if status err == HTTP.status401
|
||||||
then [ContentType.toHeader CTApplicationJSON, ("WWW-Authenticate", "Bearer") :: Header]
|
then [MediaType.toContentType MTApplicationJSON, ("WWW-Authenticate", "Bearer") :: Header]
|
||||||
else [ContentType.toHeader CTApplicationJSON]
|
else [MediaType.toContentType MTApplicationJSON]
|
||||||
|
|
||||||
instance JSON.ToJSON PgError where
|
instance JSON.ToJSON PgError where
|
||||||
toJSON (PgError _ usageError) = JSON.toJSON usageError
|
toJSON (PgError _ usageError) = JSON.toJSON usageError
|
||||||
|
|
||||||
instance JSON.ToJSON P.UsageError where
|
instance JSON.ToJSON SQL.UsageError where
|
||||||
toJSON (P.ConnectionError e) = JSON.object [
|
toJSON (SQL.ConnectionError e) = JSON.object [
|
||||||
"code" .= ("" :: Text),
|
"code" .= ConnectionErrorCode00,
|
||||||
"message" .= ("Database connection error. Retrying the connection." :: Text),
|
"message" .= ("Database connection error. Retrying the connection." :: Text),
|
||||||
"details" .= (toSL $ fromMaybe "" e :: Text)]
|
"details" .= (T.decodeUtf8With T.lenientDecode $ fromMaybe "" e :: Text),
|
||||||
toJSON (P.SessionError e) = JSON.toJSON e -- H.Error
|
"hint" .= JSON.Null]
|
||||||
|
toJSON (SQL.SessionError e) = JSON.toJSON e -- SQL.Error
|
||||||
|
|
||||||
instance JSON.ToJSON H.QueryError where
|
instance JSON.ToJSON SQL.QueryError where
|
||||||
toJSON (H.QueryError _ _ e) = JSON.toJSON e
|
toJSON (SQL.QueryError _ _ e) = JSON.toJSON e
|
||||||
|
|
||||||
instance JSON.ToJSON H.CommandError where
|
instance JSON.ToJSON SQL.CommandError where
|
||||||
toJSON (H.ResultError (H.ServerError c m d h)) = case toS c of
|
toJSON (SQL.ResultError (SQL.ServerError c m d h)) = JSON.object [
|
||||||
'P':'T':_ -> JSON.object [
|
"code" .= (T.decodeUtf8 c :: Text),
|
||||||
"details" .= (fmap toS d :: Maybe Text),
|
"message" .= (T.decodeUtf8 m :: Text),
|
||||||
"hint" .= (fmap toS h :: Maybe Text)]
|
"details" .= (fmap T.decodeUtf8 d :: Maybe Text),
|
||||||
|
"hint" .= (fmap T.decodeUtf8 h :: Maybe Text)]
|
||||||
|
|
||||||
_ -> JSON.object [
|
toJSON (SQL.ResultError resultError) = JSON.object [
|
||||||
"code" .= (toS c :: Text),
|
"code" .= InternalErrorCode00,
|
||||||
"message" .= (toS m :: Text),
|
"message" .= (show resultError :: Text),
|
||||||
"details" .= (fmap toS d :: Maybe Text),
|
"details" .= JSON.Null,
|
||||||
"hint" .= (fmap toS h :: Maybe Text)]
|
"hint" .= JSON.Null]
|
||||||
|
|
||||||
toJSON (H.ResultError (H.UnexpectedResult m)) = JSON.object [
|
toJSON (SQL.ClientError d) = JSON.object [
|
||||||
"message" .= (m :: Text)]
|
"code" .= ConnectionErrorCode01,
|
||||||
toJSON (H.ResultError (H.RowError i H.EndOfInput)) = JSON.object [
|
|
||||||
"message" .= ("Row error: end of input" :: Text),
|
|
||||||
"details" .= ("Attempt to parse more columns than there are in the result" :: Text),
|
|
||||||
"hint" .= (("Row number " <> show i) :: Text)]
|
|
||||||
toJSON (H.ResultError (H.RowError i H.UnexpectedNull)) = JSON.object [
|
|
||||||
"message" .= ("Row error: unexpected null" :: Text),
|
|
||||||
"details" .= ("Attempt to parse a NULL as some value." :: Text),
|
|
||||||
"hint" .= (("Row number " <> show i) :: Text)]
|
|
||||||
toJSON (H.ResultError (H.RowError i (H.ValueError d))) = JSON.object [
|
|
||||||
"message" .= ("Row error: Wrong value parser used" :: Text),
|
|
||||||
"details" .= d,
|
|
||||||
"hint" .= (("Row number " <> show i) :: Text)]
|
|
||||||
toJSON (H.ResultError (H.UnexpectedAmountOfRows i)) = JSON.object [
|
|
||||||
"message" .= ("Unexpected amount of rows" :: Text),
|
|
||||||
"details" .= i]
|
|
||||||
toJSON (H.ClientError d) = JSON.object [
|
|
||||||
"message" .= ("Database client error. Retrying the connection." :: Text),
|
"message" .= ("Database client error. Retrying the connection." :: Text),
|
||||||
"details" .= (fmap toS d :: Maybe Text)]
|
"details" .= (fmap T.decodeUtf8 d :: Maybe Text),
|
||||||
|
"hint" .= JSON.Null]
|
||||||
|
|
||||||
pgErrorStatus :: Bool -> P.UsageError -> HT.Status
|
pgErrorStatus :: Bool -> SQL.UsageError -> HTTP.Status
|
||||||
pgErrorStatus _ (P.ConnectionError _) = HT.status503
|
pgErrorStatus _ (SQL.ConnectionError _) = HTTP.status503
|
||||||
pgErrorStatus _ (P.SessionError (H.QueryError _ _ (H.ClientError _))) = HT.status503
|
pgErrorStatus _ (SQL.SessionError (SQL.QueryError _ _ (SQL.ClientError _))) = HTTP.status503
|
||||||
pgErrorStatus authed (P.SessionError (H.QueryError _ _ (H.ResultError rError))) =
|
pgErrorStatus authed (SQL.SessionError (SQL.QueryError _ _ (SQL.ResultError rError))) =
|
||||||
case rError of
|
case rError of
|
||||||
(H.ServerError c m _ _) ->
|
(SQL.ServerError c m _ _) ->
|
||||||
case toS c of
|
case BS.unpack c of
|
||||||
'0':'8':_ -> HT.status503 -- pg connection err
|
'0':'8':_ -> HTTP.status503 -- pg connection err
|
||||||
'0':'9':_ -> HT.status500 -- triggered action exception
|
'0':'9':_ -> HTTP.status500 -- triggered action exception
|
||||||
'0':'L':_ -> HT.status403 -- invalid grantor
|
'0':'L':_ -> HTTP.status403 -- invalid grantor
|
||||||
'0':'P':_ -> HT.status403 -- invalid role specification
|
'0':'P':_ -> HTTP.status403 -- invalid role specification
|
||||||
"23503" -> HT.status409 -- foreign_key_violation
|
"23503" -> HTTP.status409 -- foreign_key_violation
|
||||||
"23505" -> HT.status409 -- unique_violation
|
"23505" -> HTTP.status409 -- unique_violation
|
||||||
"25006" -> HT.status405 -- read_only_sql_transaction
|
"25006" -> HTTP.status405 -- read_only_sql_transaction
|
||||||
'2':'5':_ -> HT.status500 -- invalid tx state
|
'2':'5':_ -> HTTP.status500 -- invalid tx state
|
||||||
'2':'8':_ -> HT.status403 -- invalid auth specification
|
'2':'8':_ -> HTTP.status403 -- invalid auth specification
|
||||||
'2':'D':_ -> HT.status500 -- invalid tx termination
|
'2':'D':_ -> HTTP.status500 -- invalid tx termination
|
||||||
'3':'8':_ -> HT.status500 -- external routine exception
|
'3':'8':_ -> HTTP.status500 -- external routine exception
|
||||||
'3':'9':_ -> HT.status500 -- external routine invocation
|
'3':'9':_ -> HTTP.status500 -- external routine invocation
|
||||||
'3':'B':_ -> HT.status500 -- savepoint exception
|
'3':'B':_ -> HTTP.status500 -- savepoint exception
|
||||||
'4':'0':_ -> HT.status500 -- tx rollback
|
'4':'0':_ -> HTTP.status500 -- tx rollback
|
||||||
'5':'3':_ -> HT.status503 -- insufficient resources
|
'5':'3':_ -> HTTP.status503 -- insufficient resources
|
||||||
'5':'4':_ -> HT.status413 -- too complex
|
'5':'4':_ -> HTTP.status413 -- too complex
|
||||||
'5':'5':_ -> HT.status500 -- obj not on prereq state
|
'5':'5':_ -> HTTP.status500 -- obj not on prereq state
|
||||||
'5':'7':_ -> HT.status500 -- operator intervention
|
'5':'7':_ -> HTTP.status500 -- operator intervention
|
||||||
'5':'8':_ -> HT.status500 -- system error
|
'5':'8':_ -> HTTP.status500 -- system error
|
||||||
'F':'0':_ -> HT.status500 -- conf file error
|
'F':'0':_ -> HTTP.status500 -- conf file error
|
||||||
'H':'V':_ -> HT.status500 -- foreign data wrapper error
|
'H':'V':_ -> HTTP.status500 -- foreign data wrapper error
|
||||||
"P0001" -> HT.status400 -- default code for "raise"
|
"P0001" -> HTTP.status400 -- default code for "raise"
|
||||||
'P':'0':_ -> HT.status500 -- PL/pgSQL Error
|
'P':'0':_ -> HTTP.status500 -- PL/pgSQL Error
|
||||||
'X':'X':_ -> HT.status500 -- internal Error
|
'X':'X':_ -> HTTP.status500 -- internal Error
|
||||||
"42883" -> HT.status404 -- undefined function
|
"42883"-> if BS.isPrefixOf "function xmlagg(" m
|
||||||
"42P01" -> HT.status404 -- undefined table
|
then HTTP.status406
|
||||||
"42501" -> if authed then HT.status403 else HT.status401 -- insufficient privilege
|
else HTTP.status404 -- undefined function
|
||||||
'P':'T':n -> fromMaybe HT.status500 (HT.mkStatus <$> readMaybe n <*> pure m)
|
"42P01" -> HTTP.status404 -- undefined table
|
||||||
_ -> HT.status400
|
"42501" -> if authed then HTTP.status403 else HTTP.status401 -- insufficient privilege
|
||||||
|
'P':'T':n -> fromMaybe HTTP.status500 (HTTP.mkStatus <$> readMaybe n <*> pure m)
|
||||||
|
_ -> HTTP.status400
|
||||||
|
|
||||||
_ -> HT.status500
|
_ -> HTTP.status500
|
||||||
|
|
||||||
checkIsFatal :: PgError -> Maybe Text
|
checkIsFatal :: PgError -> Maybe Text
|
||||||
checkIsFatal (PgError _ (P.ConnectionError e))
|
checkIsFatal (PgError _ (SQL.ConnectionError e))
|
||||||
| isAuthFailureMessage = Just $ toS failureMessage
|
| isAuthFailureMessage = Just $ toS failureMessage
|
||||||
| otherwise = Nothing
|
| otherwise = Nothing
|
||||||
where isAuthFailureMessage = "FATAL: password authentication failed" `isPrefixOf` toS failureMessage
|
where isAuthFailureMessage = "FATAL: password authentication failed" `isPrefixOf` failureMessage
|
||||||
failureMessage = fromMaybe mempty e
|
failureMessage = BS.unpack $ fromMaybe mempty e
|
||||||
checkIsFatal (PgError _ (P.SessionError (H.QueryError _ _ (H.ResultError serverError))))
|
checkIsFatal (PgError _ (SQL.SessionError (SQL.QueryError _ _ (SQL.ResultError serverError))))
|
||||||
= case serverError of
|
= case serverError of
|
||||||
-- Check for a syntax error (42601 is the pg code). This would mean the error is on our part somehow, so we treat it as fatal.
|
-- Check for a syntax error (42601 is the pg code). This would mean the error is on our part somehow, so we treat it as fatal.
|
||||||
H.ServerError "42601" _ _ _
|
SQL.ServerError "42601" _ _ _
|
||||||
-> Just "Hint: This is probably a bug in PostgREST, please report it at https://github.com/PostgREST/postgrest/issues"
|
-> Just "Hint: This is probably a bug in PostgREST, please report it at https://github.com/PostgREST/postgrest/issues"
|
||||||
-- Check for a "prepared statement <name> already exists" error (Code 42P05: duplicate_prepared_statement).
|
-- Check for a "prepared statement <name> already exists" error (Code 42P05: duplicate_prepared_statement).
|
||||||
-- This would mean that a connection pooler in transaction mode is being used
|
-- This would mean that a connection pooler in transaction mode is being used
|
||||||
-- while prepared statements are enabled in the PostgREST configuration,
|
-- while prepared statements are enabled in the PostgREST configuration,
|
||||||
-- both of which are incompatible with each other.
|
-- both of which are incompatible with each other.
|
||||||
H.ServerError "42P05" _ _ _
|
SQL.ServerError "42P05" _ _ _
|
||||||
-> Just "Hint: If you are using connection poolers in transaction mode, try setting db-prepared-statements to false."
|
-> Just "Hint: If you are using connection poolers in transaction mode, try setting db-prepared-statements to false."
|
||||||
-- Check for a "transaction blocks not allowed in statement pooling mode" error (Code 08P01: protocol_violation).
|
-- Check for a "transaction blocks not allowed in statement pooling mode" error (Code 08P01: protocol_violation).
|
||||||
-- This would mean that a connection pooler in statement mode is being used which is not supported in PostgREST.
|
-- This would mean that a connection pooler in statement mode is being used which is not supported in PostgREST.
|
||||||
H.ServerError "08P01" "transaction blocks not allowed in statement pooling mode" _ _
|
SQL.ServerError "08P01" "transaction blocks not allowed in statement pooling mode" _ _
|
||||||
-> Just "Hint: Connection poolers in statement mode are not supported."
|
-> Just "Hint: Connection poolers in statement mode are not supported."
|
||||||
_ -> Nothing
|
_ -> Nothing
|
||||||
checkIsFatal _ = Nothing
|
checkIsFatal _ = Nothing
|
||||||
|
|
||||||
|
|
||||||
data Error
|
data Error
|
||||||
= GucHeadersError
|
= ApiRequestError ApiRequestError
|
||||||
|
| BinaryFieldError MediaType
|
||||||
|
| GucHeadersError
|
||||||
| GucStatusError
|
| GucStatusError
|
||||||
| BinaryFieldError ContentType
|
|
||||||
| ConnectionLostError
|
|
||||||
| PutMatchingPkError
|
|
||||||
| PutRangeNotAllowedError
|
|
||||||
| JwtTokenMissing
|
|
||||||
| JwtTokenInvalid Text
|
| JwtTokenInvalid Text
|
||||||
| SingularityError Integer
|
| JwtTokenMissing
|
||||||
| NotFound
|
| JwtTokenRequired
|
||||||
| ApiRequestError ApiRequestError
|
| NoSchemaCacheError
|
||||||
|
| OffLimitsChangesError Int64 Integer
|
||||||
| PgErr PgError
|
| PgErr PgError
|
||||||
|
| PutMatchingPkError
|
||||||
|
| SingularityError Integer
|
||||||
|
|
||||||
instance PgrstError Error where
|
instance PgrstError Error where
|
||||||
status GucHeadersError = HT.status500
|
|
||||||
status GucStatusError = HT.status500
|
|
||||||
status (BinaryFieldError _) = HT.status406
|
|
||||||
status ConnectionLostError = HT.status503
|
|
||||||
status PutMatchingPkError = HT.status400
|
|
||||||
status PutRangeNotAllowedError = HT.status400
|
|
||||||
status JwtTokenMissing = HT.status500
|
|
||||||
status (JwtTokenInvalid _) = HT.unauthorized401
|
|
||||||
status (SingularityError _) = HT.status406
|
|
||||||
status NotFound = HT.status404
|
|
||||||
status (PgErr err) = status err
|
|
||||||
status (ApiRequestError err) = status err
|
status (ApiRequestError err) = status err
|
||||||
|
status BinaryFieldError{} = HTTP.status406
|
||||||
|
status GucHeadersError = HTTP.status500
|
||||||
|
status GucStatusError = HTTP.status500
|
||||||
|
status JwtTokenInvalid{} = HTTP.unauthorized401
|
||||||
|
status JwtTokenMissing = HTTP.status500
|
||||||
|
status JwtTokenRequired = HTTP.unauthorized401
|
||||||
|
status NoSchemaCacheError = HTTP.status503
|
||||||
|
status OffLimitsChangesError{} = HTTP.status400
|
||||||
|
status (PgErr err) = status err
|
||||||
|
status PutMatchingPkError = HTTP.status400
|
||||||
|
status SingularityError{} = HTTP.status406
|
||||||
|
|
||||||
headers (SingularityError _) = [ContentType.toHeader CTSingularJSON]
|
headers (ApiRequestError err) = headers err
|
||||||
headers (JwtTokenInvalid m) = [ContentType.toHeader CTApplicationJSON, invalidTokenHeader m]
|
headers (JwtTokenInvalid m) = [MediaType.toContentType MTApplicationJSON, invalidTokenHeader m]
|
||||||
headers (PgErr err) = headers err
|
headers JwtTokenRequired = [MediaType.toContentType MTApplicationJSON, requiredTokenHeader]
|
||||||
headers (ApiRequestError err) = headers err
|
headers (PgErr err) = headers err
|
||||||
headers _ = [ContentType.toHeader CTApplicationJSON]
|
headers SingularityError{} = [MediaType.toContentType MTSingularJSON]
|
||||||
|
headers _ = [MediaType.toContentType MTApplicationJSON]
|
||||||
|
|
||||||
instance JSON.ToJSON Error where
|
instance JSON.ToJSON Error where
|
||||||
toJSON GucHeadersError = JSON.object [
|
toJSON NoSchemaCacheError = JSON.object [
|
||||||
"message" .= ("response.headers guc must be a JSON array composed of objects with a single key and a string value" :: Text)]
|
"code" .= ConnectionErrorCode02,
|
||||||
toJSON GucStatusError = JSON.object [
|
"message" .= ("Could not query the database for the schema cache. Retrying." :: Text),
|
||||||
"message" .= ("response.status guc must be a valid status code" :: Text)]
|
"details" .= JSON.Null,
|
||||||
toJSON (BinaryFieldError ct) = JSON.object [
|
"hint" .= JSON.Null]
|
||||||
"message" .= ((toS (ContentType.toMime ct) <> " requested but more than one column was selected") :: Text)]
|
|
||||||
toJSON ConnectionLostError = JSON.object [
|
|
||||||
"message" .= ("Database connection lost. Retrying the connection." :: Text)]
|
|
||||||
|
|
||||||
toJSON PutRangeNotAllowedError = JSON.object [
|
toJSON JwtTokenMissing = JSON.object [
|
||||||
"message" .= ("Range header and limit/offset querystring parameters are not allowed for PUT" :: Text)]
|
"code" .= JWTErrorCode00,
|
||||||
toJSON PutMatchingPkError = JSON.object [
|
"message" .= ("Server lacks JWT secret" :: Text),
|
||||||
"message" .= ("Payload values do not match URL in primary key column(s)" :: Text)]
|
"details" .= JSON.Null,
|
||||||
|
"hint" .= JSON.Null]
|
||||||
toJSON (SingularityError n) = JSON.object [
|
|
||||||
"message" .= ("JSON object requested, multiple (or no) rows returned" :: Text),
|
|
||||||
"details" .= T.unwords ["Results contain", show n, "rows,", toS (ContentType.toMime CTSingularJSON), "requires 1 row"]]
|
|
||||||
|
|
||||||
toJSON JwtTokenMissing = JSON.object [
|
|
||||||
"message" .= ("Server lacks JWT secret" :: Text)]
|
|
||||||
toJSON (JwtTokenInvalid message) = JSON.object [
|
toJSON (JwtTokenInvalid message) = JSON.object [
|
||||||
"message" .= (message :: Text)]
|
"code" .= JWTErrorCode01,
|
||||||
toJSON NotFound = JSON.object []
|
"message" .= (message :: Text),
|
||||||
|
"details" .= JSON.Null,
|
||||||
|
"hint" .= JSON.Null]
|
||||||
|
toJSON JwtTokenRequired = JSON.object [
|
||||||
|
"code" .= JWTErrorCode02,
|
||||||
|
"message" .= ("Anonymous access is disabled" :: Text),
|
||||||
|
"details" .= JSON.Null,
|
||||||
|
"hint" .= JSON.Null]
|
||||||
|
|
||||||
|
toJSON (OffLimitsChangesError n maxs) = JSON.object [
|
||||||
|
"code" .= ApiRequestErrorCode10,
|
||||||
|
"message" .= ("The maximum number of rows allowed to change was surpassed" :: Text),
|
||||||
|
"details" .= T.unwords ["Results contain", show n, "rows changed but the maximum number allowed is", show maxs],
|
||||||
|
"hint" .= JSON.Null]
|
||||||
|
|
||||||
|
toJSON GucHeadersError = JSON.object [
|
||||||
|
"code" .= ApiRequestErrorCode11,
|
||||||
|
"message" .= ("response.headers guc must be a JSON array composed of objects with a single key and a string value" :: Text),
|
||||||
|
"details" .= JSON.Null,
|
||||||
|
"hint" .= JSON.Null]
|
||||||
|
toJSON GucStatusError = JSON.object [
|
||||||
|
"code" .= ApiRequestErrorCode12,
|
||||||
|
"message" .= ("response.status guc must be a valid status code" :: Text),
|
||||||
|
"details" .= JSON.Null,
|
||||||
|
"hint" .= JSON.Null]
|
||||||
|
toJSON (BinaryFieldError ct) = JSON.object [
|
||||||
|
"code" .= ApiRequestErrorCode13,
|
||||||
|
"message" .= ((T.decodeUtf8 (MediaType.toMime ct) <> " requested but more than one column was selected") :: Text),
|
||||||
|
"details" .= JSON.Null,
|
||||||
|
"hint" .= JSON.Null]
|
||||||
|
|
||||||
|
toJSON PutMatchingPkError = JSON.object [
|
||||||
|
"code" .= ApiRequestErrorCode15,
|
||||||
|
"message" .= ("Payload values do not match URL in primary key column(s)" :: Text),
|
||||||
|
"details" .= JSON.Null,
|
||||||
|
"hint" .= JSON.Null]
|
||||||
|
|
||||||
|
toJSON (SingularityError n) = JSON.object [
|
||||||
|
"code" .= ApiRequestErrorCode16,
|
||||||
|
"message" .= ("JSON object requested, multiple (or no) rows returned" :: Text),
|
||||||
|
"details" .= T.unwords ["Results contain", show n, "rows,", T.decodeUtf8 (MediaType.toMime MTSingularJSON), "requires 1 row"],
|
||||||
|
"hint" .= JSON.Null]
|
||||||
|
|
||||||
toJSON (PgErr err) = JSON.toJSON err
|
toJSON (PgErr err) = JSON.toJSON err
|
||||||
toJSON (ApiRequestError err) = JSON.toJSON err
|
toJSON (ApiRequestError err) = JSON.toJSON err
|
||||||
|
|
||||||
@@ -323,5 +419,86 @@ invalidTokenHeader :: Text -> Header
|
|||||||
invalidTokenHeader m =
|
invalidTokenHeader m =
|
||||||
("WWW-Authenticate", "Bearer error=\"invalid_token\", " <> "error_description=" <> encodeUtf8 (show m))
|
("WWW-Authenticate", "Bearer error=\"invalid_token\", " <> "error_description=" <> encodeUtf8 (show m))
|
||||||
|
|
||||||
|
requiredTokenHeader :: Header
|
||||||
|
requiredTokenHeader = ("WWW-Authenticate", "Bearer")
|
||||||
|
|
||||||
singularityError :: (Integral a) => a -> Error
|
singularityError :: (Integral a) => a -> Error
|
||||||
singularityError = SingularityError . toInteger
|
singularityError = SingularityError . toInteger
|
||||||
|
|
||||||
|
-- Error codes are grouped by common modules or characteristics
|
||||||
|
data ErrorCode
|
||||||
|
-- PostgreSQL connection errors
|
||||||
|
= ConnectionErrorCode00
|
||||||
|
| ConnectionErrorCode01
|
||||||
|
| ConnectionErrorCode02
|
||||||
|
-- API Request errors
|
||||||
|
| ApiRequestErrorCode00
|
||||||
|
| ApiRequestErrorCode01
|
||||||
|
| ApiRequestErrorCode02
|
||||||
|
| ApiRequestErrorCode03
|
||||||
|
| ApiRequestErrorCode04
|
||||||
|
| ApiRequestErrorCode05
|
||||||
|
| ApiRequestErrorCode06
|
||||||
|
| ApiRequestErrorCode07
|
||||||
|
| ApiRequestErrorCode08
|
||||||
|
| ApiRequestErrorCode09
|
||||||
|
| ApiRequestErrorCode10
|
||||||
|
| ApiRequestErrorCode11
|
||||||
|
| ApiRequestErrorCode12
|
||||||
|
| ApiRequestErrorCode13
|
||||||
|
| ApiRequestErrorCode14
|
||||||
|
| ApiRequestErrorCode15
|
||||||
|
| ApiRequestErrorCode16
|
||||||
|
| ApiRequestErrorCode17
|
||||||
|
-- Schema Cache errors
|
||||||
|
| SchemaCacheErrorCode00
|
||||||
|
| SchemaCacheErrorCode01
|
||||||
|
| SchemaCacheErrorCode02
|
||||||
|
| SchemaCacheErrorCode03
|
||||||
|
-- JWT authentication errors
|
||||||
|
| JWTErrorCode00
|
||||||
|
| JWTErrorCode01
|
||||||
|
| JWTErrorCode02
|
||||||
|
-- Internal errors related to the Hasql library
|
||||||
|
| InternalErrorCode00
|
||||||
|
|
||||||
|
instance JSON.ToJSON ErrorCode where
|
||||||
|
toJSON e = JSON.toJSON (buildErrorCode e)
|
||||||
|
|
||||||
|
-- New group of errors will be added at the end of all the groups and will have the next prefix in the sequence
|
||||||
|
-- New errors are added at the end of the group they belong to and will have the next code in the sequence
|
||||||
|
buildErrorCode :: ErrorCode -> Text
|
||||||
|
buildErrorCode code = "PGRST" <> case code of
|
||||||
|
ConnectionErrorCode00 -> "000"
|
||||||
|
ConnectionErrorCode01 -> "001"
|
||||||
|
ConnectionErrorCode02 -> "002"
|
||||||
|
|
||||||
|
ApiRequestErrorCode00 -> "100"
|
||||||
|
ApiRequestErrorCode01 -> "101"
|
||||||
|
ApiRequestErrorCode02 -> "102"
|
||||||
|
ApiRequestErrorCode03 -> "103"
|
||||||
|
ApiRequestErrorCode04 -> "104"
|
||||||
|
ApiRequestErrorCode05 -> "105"
|
||||||
|
ApiRequestErrorCode06 -> "106"
|
||||||
|
ApiRequestErrorCode07 -> "107"
|
||||||
|
ApiRequestErrorCode08 -> "108"
|
||||||
|
ApiRequestErrorCode09 -> "109"
|
||||||
|
ApiRequestErrorCode10 -> "110"
|
||||||
|
ApiRequestErrorCode11 -> "111"
|
||||||
|
ApiRequestErrorCode12 -> "112"
|
||||||
|
ApiRequestErrorCode13 -> "113"
|
||||||
|
ApiRequestErrorCode14 -> "114"
|
||||||
|
ApiRequestErrorCode15 -> "115"
|
||||||
|
ApiRequestErrorCode16 -> "116"
|
||||||
|
ApiRequestErrorCode17 -> "117"
|
||||||
|
|
||||||
|
SchemaCacheErrorCode00 -> "200"
|
||||||
|
SchemaCacheErrorCode01 -> "201"
|
||||||
|
SchemaCacheErrorCode02 -> "202"
|
||||||
|
SchemaCacheErrorCode03 -> "203"
|
||||||
|
|
||||||
|
JWTErrorCode00 -> "300"
|
||||||
|
JWTErrorCode01 -> "301"
|
||||||
|
JWTErrorCode02 -> "302"
|
||||||
|
|
||||||
|
InternalErrorCode00 -> "X00"
|
||||||
|
|||||||
@@ -5,13 +5,13 @@ module PostgREST.GucHeader
|
|||||||
) where
|
) where
|
||||||
|
|
||||||
import qualified Data.Aeson as JSON
|
import qualified Data.Aeson as JSON
|
||||||
|
import qualified Data.Aeson.Key as K
|
||||||
|
import qualified Data.Aeson.KeyMap as KM
|
||||||
import qualified Data.CaseInsensitive as CI
|
import qualified Data.CaseInsensitive as CI
|
||||||
import qualified Data.HashMap.Strict as M
|
|
||||||
|
|
||||||
import Network.HTTP.Types.Header (Header)
|
import Network.HTTP.Types.Header (Header)
|
||||||
|
|
||||||
import Protolude hiding (toS)
|
import Protolude
|
||||||
import Protolude.Conv (toS)
|
|
||||||
|
|
||||||
|
|
||||||
{-|
|
{-|
|
||||||
@@ -21,11 +21,11 @@ import Protolude.Conv (toS)
|
|||||||
newtype GucHeader = GucHeader (CI.CI ByteString, ByteString)
|
newtype GucHeader = GucHeader (CI.CI ByteString, ByteString)
|
||||||
|
|
||||||
instance JSON.FromJSON GucHeader where
|
instance JSON.FromJSON GucHeader where
|
||||||
parseJSON (JSON.Object o) = case headMay (M.toList o) of
|
parseJSON (JSON.Object o) =
|
||||||
Just (k, JSON.String s) | M.size o == 1 -> pure $ GucHeader (CI.mk $ toS k, toS s)
|
case KM.toList o of
|
||||||
| otherwise -> mzero
|
[(k, JSON.String s)] -> pure $ GucHeader (CI.mk $ toUtf8 $ K.toText k, toUtf8 s)
|
||||||
_ -> mzero
|
_ -> mzero
|
||||||
parseJSON _ = mzero
|
parseJSON _ = mzero
|
||||||
|
|
||||||
unwrapGucHeader :: GucHeader -> Header
|
unwrapGucHeader :: GucHeader -> Header
|
||||||
unwrapGucHeader (GucHeader (k, v)) = (k, v)
|
unwrapGucHeader (GucHeader (k, v)) = (k, v)
|
||||||
|
|||||||
@@ -0,0 +1,30 @@
|
|||||||
|
{-|
|
||||||
|
Module : PostgREST.Logger
|
||||||
|
Description : Wai Middleware to log requests to stdout.
|
||||||
|
-}
|
||||||
|
module PostgREST.Logger (middleware) where
|
||||||
|
|
||||||
|
import qualified Network.Wai as Wai
|
||||||
|
import qualified Network.Wai.Middleware.RequestLogger as Wai
|
||||||
|
|
||||||
|
import Network.HTTP.Types.Status (status400, status500)
|
||||||
|
import System.IO.Unsafe (unsafePerformIO)
|
||||||
|
|
||||||
|
import qualified PostgREST.Auth as Auth
|
||||||
|
import PostgREST.Config (LogLevel (..))
|
||||||
|
|
||||||
|
import Protolude
|
||||||
|
|
||||||
|
middleware :: LogLevel -> Wai.Middleware
|
||||||
|
middleware logLevel = case logLevel of
|
||||||
|
LogInfo -> requestLogger (const True)
|
||||||
|
LogWarn -> requestLogger (>= status400)
|
||||||
|
LogError -> requestLogger (>= status500)
|
||||||
|
LogCrit -> requestLogger (const False)
|
||||||
|
where
|
||||||
|
requestLogger filterStatus = unsafePerformIO $ Wai.mkRequestLogger Wai.defaultRequestLoggerSettings
|
||||||
|
{ Wai.outputFormat = Wai.ApacheWithSettings $
|
||||||
|
Wai.defaultApacheSettings
|
||||||
|
& Wai.setApacheRequestFilter (\_ res -> filterStatus $ Wai.responseStatus res)
|
||||||
|
& Wai.setApacheUserGetter (fmap encodeUtf8 . Auth.getRole)
|
||||||
|
}
|
||||||
@@ -0,0 +1,124 @@
|
|||||||
|
{-# LANGUAGE DuplicateRecordFields #-}
|
||||||
|
|
||||||
|
module PostgREST.MediaType
|
||||||
|
( MediaType(..)
|
||||||
|
, MTPlanOption (..)
|
||||||
|
, MTPlanFormat (..)
|
||||||
|
, MTPlanAttrs(..)
|
||||||
|
, toContentType
|
||||||
|
, toMime
|
||||||
|
, decodeMediaType
|
||||||
|
, getMediaType
|
||||||
|
) where
|
||||||
|
|
||||||
|
import qualified Data.ByteString as BS
|
||||||
|
import qualified Data.ByteString.Internal as BS (c2w)
|
||||||
|
import Data.Maybe (fromJust)
|
||||||
|
|
||||||
|
import Network.HTTP.Types.Header (Header, hContentType)
|
||||||
|
|
||||||
|
import Protolude
|
||||||
|
|
||||||
|
-- | Enumeration of currently supported media types
|
||||||
|
data MediaType
|
||||||
|
= MTApplicationJSON
|
||||||
|
| MTSingularJSON
|
||||||
|
| MTGeoJSON
|
||||||
|
| MTTextCSV
|
||||||
|
| MTTextPlain
|
||||||
|
| MTTextXML
|
||||||
|
| MTOpenAPI
|
||||||
|
| MTUrlEncoded
|
||||||
|
| MTOctetStream
|
||||||
|
| MTAny
|
||||||
|
| MTOther ByteString
|
||||||
|
| MTPlan MTPlanAttrs
|
||||||
|
deriving Eq
|
||||||
|
|
||||||
|
data MTPlanAttrs = MTPlanAttrs (Maybe MediaType) MTPlanFormat [MTPlanOption]
|
||||||
|
instance Eq MTPlanAttrs where
|
||||||
|
MTPlanAttrs {} == MTPlanAttrs {} = True -- we don't care about the attributes when comparing two MTPlan media types
|
||||||
|
|
||||||
|
data MTPlanOption
|
||||||
|
= PlanAnalyze | PlanVerbose | PlanSettings | PlanBuffers | PlanWAL
|
||||||
|
|
||||||
|
data MTPlanFormat
|
||||||
|
= PlanJSON | PlanText
|
||||||
|
|
||||||
|
-- | Convert MediaType to a Content-Type HTTP Header
|
||||||
|
toContentType :: MediaType -> Header
|
||||||
|
toContentType ct = (hContentType, toMime ct <> charset)
|
||||||
|
where
|
||||||
|
charset = case ct of
|
||||||
|
MTOctetStream -> mempty
|
||||||
|
MTOther _ -> mempty
|
||||||
|
_ -> "; charset=utf-8"
|
||||||
|
|
||||||
|
-- | Convert from MediaType to a ByteString representing the mime type
|
||||||
|
toMime :: MediaType -> ByteString
|
||||||
|
toMime MTApplicationJSON = "application/json"
|
||||||
|
toMime MTGeoJSON = "application/geo+json"
|
||||||
|
toMime MTTextCSV = "text/csv"
|
||||||
|
toMime MTTextPlain = "text/plain"
|
||||||
|
toMime MTTextXML = "text/xml"
|
||||||
|
toMime MTOpenAPI = "application/openapi+json"
|
||||||
|
toMime MTSingularJSON = "application/vnd.pgrst.object+json"
|
||||||
|
toMime MTUrlEncoded = "application/x-www-form-urlencoded"
|
||||||
|
toMime MTOctetStream = "application/octet-stream"
|
||||||
|
toMime MTAny = "*/*"
|
||||||
|
toMime (MTOther ct) = ct
|
||||||
|
toMime (MTPlan (MTPlanAttrs mt fmt opts)) =
|
||||||
|
"application/vnd.pgrst.plan+" <> toMimePlanFormat fmt <>
|
||||||
|
(if isNothing mt then mempty else "; for=\"" <> toMime (fromJust mt) <> "\"") <>
|
||||||
|
(if null opts then mempty else "; options=" <> BS.intercalate "|" (toMimePlanOption <$> opts))
|
||||||
|
|
||||||
|
toMimePlanOption :: MTPlanOption -> ByteString
|
||||||
|
toMimePlanOption PlanAnalyze = "analyze"
|
||||||
|
toMimePlanOption PlanVerbose = "verbose"
|
||||||
|
toMimePlanOption PlanSettings = "settings"
|
||||||
|
toMimePlanOption PlanBuffers = "buffers"
|
||||||
|
toMimePlanOption PlanWAL = "wal"
|
||||||
|
|
||||||
|
toMimePlanFormat :: MTPlanFormat -> ByteString
|
||||||
|
toMimePlanFormat PlanJSON = "json"
|
||||||
|
toMimePlanFormat PlanText = "text"
|
||||||
|
|
||||||
|
-- | Convert from ByteString to MediaType. Warning: discards MIME parameters
|
||||||
|
decodeMediaType :: BS.ByteString -> MediaType
|
||||||
|
decodeMediaType mt =
|
||||||
|
case BS.split (BS.c2w ';') mt of
|
||||||
|
"application/json":_ -> MTApplicationJSON
|
||||||
|
"application/geo+json":_ -> MTGeoJSON
|
||||||
|
"text/csv":_ -> MTTextCSV
|
||||||
|
"text/plain":_ -> MTTextPlain
|
||||||
|
"text/xml":_ -> MTTextXML
|
||||||
|
"application/openapi+json":_ -> MTOpenAPI
|
||||||
|
"application/vnd.pgrst.object+json":_ -> MTSingularJSON
|
||||||
|
"application/vnd.pgrst.object":_ -> MTSingularJSON
|
||||||
|
"application/x-www-form-urlencoded":_ -> MTUrlEncoded
|
||||||
|
"application/octet-stream":_ -> MTOctetStream
|
||||||
|
"application/vnd.pgrst.plan":rest -> getPlan PlanText rest
|
||||||
|
"application/vnd.pgrst.plan+text":rest -> getPlan PlanText rest
|
||||||
|
"application/vnd.pgrst.plan+json":rest -> getPlan PlanJSON rest
|
||||||
|
"*/*":_ -> MTAny
|
||||||
|
other:_ -> MTOther other
|
||||||
|
_ -> MTAny
|
||||||
|
where
|
||||||
|
getPlan fmt rest =
|
||||||
|
let
|
||||||
|
opts = BS.split (BS.c2w '|') $ fromMaybe mempty (BS.stripPrefix "options=" =<< find (BS.isPrefixOf "options=") rest)
|
||||||
|
inOpts str = str `elem` opts
|
||||||
|
mtFor = decodeMediaType . dropAround (== BS.c2w '"') <$> (BS.stripPrefix "for=" =<< find (BS.isPrefixOf "for=") rest)
|
||||||
|
dropAround p = BS.dropWhile p . BS.dropWhileEnd p in
|
||||||
|
MTPlan $ MTPlanAttrs mtFor fmt $
|
||||||
|
[PlanAnalyze | inOpts "analyze" ] ++
|
||||||
|
[PlanVerbose | inOpts "verbose" ] ++
|
||||||
|
[PlanSettings | inOpts "settings"] ++
|
||||||
|
[PlanBuffers | inOpts "buffers" ] ++
|
||||||
|
[PlanWAL | inOpts "wal" ]
|
||||||
|
|
||||||
|
getMediaType :: MediaType -> MediaType
|
||||||
|
getMediaType mt = case mt of
|
||||||
|
MTPlan (MTPlanAttrs (Just mType) _ _) -> mType
|
||||||
|
MTPlan (MTPlanAttrs Nothing _ _) -> MTApplicationJSON
|
||||||
|
other -> other
|
||||||
+68
-129
@@ -2,170 +2,94 @@
|
|||||||
Module : PostgREST.Middleware
|
Module : PostgREST.Middleware
|
||||||
Description : Sets CORS policy. Also the PostgreSQL GUCs, role, search_path and pre-request function.
|
Description : Sets CORS policy. Also the PostgreSQL GUCs, role, search_path and pre-request function.
|
||||||
-}
|
-}
|
||||||
|
{-# LANGUAGE BlockArguments #-}
|
||||||
{-# LANGUAGE RecordWildCards #-}
|
{-# LANGUAGE RecordWildCards #-}
|
||||||
module PostgREST.Middleware
|
module PostgREST.Middleware
|
||||||
( runPgLocals
|
( runPgLocals
|
||||||
, pgrstFormat
|
|
||||||
, pgrstMiddleware
|
|
||||||
, defaultCorsPolicy
|
|
||||||
, corsPolicy
|
|
||||||
, optionalRollback
|
, optionalRollback
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import qualified Data.Aeson as JSON
|
import qualified Data.Aeson as JSON
|
||||||
import qualified Data.ByteString.Char8 as BS
|
import qualified Data.Aeson.Key as K
|
||||||
import qualified Data.CaseInsensitive as CI
|
import qualified Data.Aeson.KeyMap as KM
|
||||||
import qualified Data.HashMap.Strict as M
|
import qualified Data.ByteString.Lazy.Char8 as LBS
|
||||||
import qualified Data.Text as T
|
import qualified Data.HashMap.Strict as HM
|
||||||
import qualified Hasql.Decoders as HD
|
import qualified Data.Text.Encoding as T
|
||||||
import qualified Hasql.DynamicStatements.Snippet as H hiding
|
import qualified Hasql.Decoders as HD
|
||||||
(sql)
|
import qualified Hasql.DynamicStatements.Snippet as SQL hiding (sql)
|
||||||
import qualified Hasql.DynamicStatements.Statement as H
|
import qualified Hasql.DynamicStatements.Statement as SQL
|
||||||
import qualified Hasql.Transaction as H
|
import qualified Hasql.Transaction as SQL
|
||||||
import qualified Network.HTTP.Types.Header as HTTP
|
import qualified Network.Wai as Wai
|
||||||
import qualified Network.Wai as Wai
|
|
||||||
import qualified Network.Wai.Logger as Wai
|
|
||||||
import qualified Network.Wai.Middleware.Cors as Wai
|
|
||||||
import qualified Network.Wai.Middleware.Gzip as Wai
|
|
||||||
import qualified Network.Wai.Middleware.RequestLogger as Wai
|
|
||||||
import qualified Network.Wai.Middleware.Static as Wai
|
|
||||||
|
|
||||||
import Data.Function (id)
|
|
||||||
import Data.List (lookup)
|
|
||||||
import Data.Scientific (FPFormat (..), formatScientific,
|
|
||||||
isInteger)
|
|
||||||
import Network.HTTP.Types.Status (Status, status400, status500,
|
|
||||||
statusCode)
|
|
||||||
import System.IO.Unsafe (unsafePerformIO)
|
|
||||||
import System.Log.FastLogger (toLogStr)
|
|
||||||
|
|
||||||
import PostgREST.Config (AppConfig (..), LogLevel (..))
|
import Control.Arrow ((***))
|
||||||
|
|
||||||
|
import Data.Scientific (FPFormat (..), formatScientific, isInteger)
|
||||||
|
|
||||||
|
import PostgREST.Config (AppConfig (..))
|
||||||
|
import PostgREST.Config.PgVersion (PgVersion (..), pgVersion140)
|
||||||
import PostgREST.Error (Error, errorResponseFor)
|
import PostgREST.Error (Error, errorResponseFor)
|
||||||
import PostgREST.GucHeader (addHeadersIfNotIncluded)
|
import PostgREST.GucHeader (addHeadersIfNotIncluded)
|
||||||
import PostgREST.Query.SqlFragment (fromQi, intercalateSnippet,
|
import PostgREST.Query.SqlFragment (fromQi, intercalateSnippet,
|
||||||
unknownEncoder)
|
pgFmtIdentList, unknownEncoder)
|
||||||
import PostgREST.Request.ApiRequest (ApiRequest (..), Target (..))
|
import PostgREST.Request.ApiRequest (ApiRequest (..), Target (..))
|
||||||
|
|
||||||
import PostgREST.Request.Preferences
|
import PostgREST.Request.Preferences
|
||||||
|
|
||||||
import Protolude hiding (head, toS)
|
import Protolude
|
||||||
import Protolude.Conv (toS)
|
|
||||||
|
|
||||||
-- | Runs local(transaction scoped) GUCs for every request, plus the pre-request function
|
-- | Runs local(transaction scoped) GUCs for every request, plus the pre-request function
|
||||||
runPgLocals :: AppConfig -> M.HashMap Text JSON.Value ->
|
runPgLocals :: AppConfig -> KM.KeyMap JSON.Value -> Text ->
|
||||||
(ApiRequest -> ExceptT Error H.Transaction Wai.Response) ->
|
(ApiRequest -> ExceptT Error SQL.Transaction Wai.Response) ->
|
||||||
ApiRequest -> ByteString -> ExceptT Error H.Transaction Wai.Response
|
ApiRequest -> ByteString -> PgVersion -> ExceptT Error SQL.Transaction Wai.Response
|
||||||
runPgLocals conf claims app req jsonDbS = do
|
runPgLocals conf claims role app req jsonDbS actualPgVersion = do
|
||||||
lift $ H.statement mempty $ H.dynamicallyParameterized
|
lift $ SQL.statement mempty $ SQL.dynamicallyParameterized
|
||||||
("select " <> intercalateSnippet ", " (searchPathSql : roleSql ++ claimsSql ++ [methodSql, pathSql] ++ headersSql ++ cookiesSql ++ appSettingsSql ++ specSql))
|
("select " <> intercalateSnippet ", " (searchPathSql : roleSql ++ claimsSql ++ [methodSql, pathSql] ++ headersSql ++ cookiesSql ++ appSettingsSql ++ specSql))
|
||||||
HD.noResult (configDbPreparedStatements conf)
|
HD.noResult (configDbPreparedStatements conf)
|
||||||
lift $ traverse_ H.sql preReqSql
|
lift $ traverse_ SQL.sql preReqSql
|
||||||
app req
|
app req
|
||||||
where
|
where
|
||||||
methodSql = setConfigLocal mempty ("request.method", iMethod req)
|
methodSql = setConfigLocal mempty ("request.method", iMethod req)
|
||||||
pathSql = setConfigLocal mempty ("request.path", iPath req)
|
pathSql = setConfigLocal mempty ("request.path", iPath req)
|
||||||
headersSql = setConfigLocal "request.header." <$> iHeaders req
|
headersSql = if usesLegacyGucs
|
||||||
cookiesSql = setConfigLocal "request.cookie." <$> iCookies req
|
then setConfigLocal "request.header." <$> iHeaders req
|
||||||
claimsWithRole =
|
else setConfigLocalJson "request.headers" (iHeaders req)
|
||||||
let anon = JSON.String . toS $ configDbAnonRole conf in -- role claim defaults to anon if not specified in jwt
|
cookiesSql = if usesLegacyGucs
|
||||||
M.union claims (M.singleton "role" anon)
|
then setConfigLocal "request.cookie." <$> iCookies req
|
||||||
claimsSql = setConfigLocal "request.jwt.claim." <$> [(toS c, toS $ unquoted v) | (c,v) <- M.toList claimsWithRole]
|
else setConfigLocalJson "request.cookies" (iCookies req)
|
||||||
roleSql = maybeToList $ (\x -> setConfigLocal mempty ("role", toS $ unquoted x)) <$> M.lookup "role" claimsWithRole
|
claimsSql = if usesLegacyGucs
|
||||||
appSettingsSql = setConfigLocal mempty <$> (join bimap toS <$> configAppSettings conf)
|
then setConfigLocal "request.jwt.claim." <$> [(toUtf8 $ K.toText c, toUtf8 $ unquoted v) | (c,v) <- KM.toList claims]
|
||||||
|
else [setConfigLocal mempty ("request.jwt.claims", LBS.toStrict $ JSON.encode claims)]
|
||||||
|
roleSql = [setConfigLocal mempty ("role", toUtf8 role)]
|
||||||
|
appSettingsSql = setConfigLocal mempty <$> (join bimap toUtf8 <$> configAppSettings conf)
|
||||||
searchPathSql =
|
searchPathSql =
|
||||||
let schemas = T.intercalate ", " (iSchema req : configDbExtraSearchPath conf) in
|
let schemas = pgFmtIdentList (iSchema req : configDbExtraSearchPath conf) in
|
||||||
setConfigLocal mempty ("search_path", toS schemas)
|
setConfigLocal mempty ("search_path", schemas)
|
||||||
preReqSql = (\f -> "select " <> fromQi f <> "();") <$> configDbPreRequest conf
|
preReqSql = (\f -> "select " <> fromQi f <> "();") <$> configDbPreRequest conf
|
||||||
specSql = case iTarget req of
|
specSql = case iTarget req of
|
||||||
TargetProc{tpIsRootSpec=True} -> [setConfigLocal mempty ("request.spec", jsonDbS)]
|
TargetProc{tpIsRootSpec=True} -> [setConfigLocal mempty ("request.spec", jsonDbS)]
|
||||||
_ -> mempty
|
_ -> mempty
|
||||||
-- | Do a pg set_config(setting, value, true) call. This is equivalent to a SET LOCAL.
|
usesLegacyGucs = configDbUseLegacyGucs conf && actualPgVersion < pgVersion140
|
||||||
setConfigLocal :: ByteString -> (ByteString, ByteString) -> H.Snippet
|
|
||||||
setConfigLocal prefix (k, v) =
|
|
||||||
"set_config(" <> unknownEncoder (prefix <> k) <> ", " <> unknownEncoder v <> ", true)"
|
|
||||||
|
|
||||||
-- | Log in apache format. Only requests that have a status greater than minStatus are logged.
|
unquoted :: JSON.Value -> Text
|
||||||
-- | There's no way to filter logs in the apache format on wai-extra: https://hackage.haskell.org/package/wai-extra-3.0.29.2/docs/Network-Wai-Middleware-RequestLogger.html#t:OutputFormat.
|
unquoted (JSON.String t) = t
|
||||||
-- | So here we copy wai-logger apacheLogStr function: https://github.com/kazu-yamamoto/logger/blob/a4f51b909a099c51af7a3f75cf16e19a06f9e257/wai-logger/Network/Wai/Logger/Apache.hs#L45
|
unquoted (JSON.Number n) =
|
||||||
-- | TODO: Add the ability to filter apache logs on wai-extra and remove this function.
|
toS $ formatScientific Fixed (if isInteger n then Just 0 else Nothing) n
|
||||||
pgrstFormat :: Status -> Wai.OutputFormatter
|
unquoted (JSON.Bool b) = show b
|
||||||
pgrstFormat minStatus date req status responseSize =
|
unquoted v = T.decodeUtf8 . LBS.toStrict $ JSON.encode v
|
||||||
if status < minStatus
|
|
||||||
then mempty
|
|
||||||
else toLogStr (getSourceFromSocket req)
|
|
||||||
<> " - - ["
|
|
||||||
<> toLogStr date
|
|
||||||
<> "] \""
|
|
||||||
<> toLogStr (Wai.requestMethod req)
|
|
||||||
<> " "
|
|
||||||
<> toLogStr (Wai.rawPathInfo req <> Wai.rawQueryString req)
|
|
||||||
<> " "
|
|
||||||
<> toLogStr (show (Wai.httpVersion req)::Text)
|
|
||||||
<> "\" "
|
|
||||||
<> toLogStr (show (statusCode status)::Text)
|
|
||||||
<> " "
|
|
||||||
<> toLogStr (maybe "-" show responseSize::Text)
|
|
||||||
<> " \""
|
|
||||||
<> toLogStr (fromMaybe mempty $ Wai.requestHeaderReferer req)
|
|
||||||
<> "\" \""
|
|
||||||
<> toLogStr (fromMaybe mempty $ Wai.requestHeaderUserAgent req)
|
|
||||||
<> "\"\n"
|
|
||||||
where
|
|
||||||
getSourceFromSocket = BS.pack . Wai.showSockAddr . Wai.remoteHost
|
|
||||||
|
|
||||||
pgrstMiddleware :: LogLevel -> Wai.Application -> Wai.Application
|
|
||||||
pgrstMiddleware logLevel =
|
|
||||||
logger
|
|
||||||
. Wai.cors corsPolicy
|
|
||||||
. Wai.staticPolicy (Wai.only [("favicon.ico", "static/favicon.ico")])
|
|
||||||
where
|
|
||||||
logger = case logLevel of
|
|
||||||
LogCrit -> id
|
|
||||||
LogError -> unsafePerformIO $ Wai.mkRequestLogger Wai.def { Wai.outputFormat = Wai.CustomOutputFormat $ pgrstFormat status500}
|
|
||||||
LogWarn -> unsafePerformIO $ Wai.mkRequestLogger Wai.def { Wai.outputFormat = Wai.CustomOutputFormat $ pgrstFormat status400}
|
|
||||||
LogInfo -> Wai.logStdout
|
|
||||||
|
|
||||||
defaultCorsPolicy :: Wai.CorsResourcePolicy
|
|
||||||
defaultCorsPolicy = Wai.CorsResourcePolicy Nothing
|
|
||||||
["GET", "POST", "PATCH", "PUT", "DELETE", "OPTIONS"] ["Authorization"] Nothing
|
|
||||||
(Just $ 60*60*24) False False True
|
|
||||||
|
|
||||||
-- | CORS policy to be used in by Wai Cors middleware
|
|
||||||
corsPolicy :: Wai.Request -> Maybe Wai.CorsResourcePolicy
|
|
||||||
corsPolicy req = case lookup "origin" headers of
|
|
||||||
Just origin -> Just defaultCorsPolicy {
|
|
||||||
Wai.corsOrigins = Just ([origin], True)
|
|
||||||
, Wai.corsRequestHeaders = "Authentication" : accHeaders
|
|
||||||
, Wai.corsExposedHeaders = Just [
|
|
||||||
"Content-Encoding", "Content-Location", "Content-Range", "Content-Type"
|
|
||||||
, "Date", "Location", "Server", "Transfer-Encoding", "Range-Unit"
|
|
||||||
]
|
|
||||||
}
|
|
||||||
Nothing -> Nothing
|
|
||||||
where
|
|
||||||
headers = Wai.requestHeaders req
|
|
||||||
accHeaders = case lookup "access-control-request-headers" headers of
|
|
||||||
Just hdrs -> map (CI.mk . toS . T.strip . toS) $ BS.split ',' hdrs
|
|
||||||
Nothing -> []
|
|
||||||
|
|
||||||
unquoted :: JSON.Value -> Text
|
|
||||||
unquoted (JSON.String t) = t
|
|
||||||
unquoted (JSON.Number n) =
|
|
||||||
toS $ formatScientific Fixed (if isInteger n then Just 0 else Nothing) n
|
|
||||||
unquoted (JSON.Bool b) = show b
|
|
||||||
unquoted v = toS $ JSON.encode v
|
|
||||||
|
|
||||||
-- | Set a transaction to eventually roll back if requested and set respective
|
-- | Set a transaction to eventually roll back if requested and set respective
|
||||||
-- headers on the response.
|
-- headers on the response.
|
||||||
optionalRollback
|
optionalRollback
|
||||||
:: AppConfig
|
:: AppConfig
|
||||||
-> ApiRequest
|
-> ApiRequest
|
||||||
-> ExceptT Error H.Transaction Wai.Response
|
-> ExceptT Error SQL.Transaction Wai.Response
|
||||||
-> ExceptT Error H.Transaction Wai.Response
|
-> ExceptT Error SQL.Transaction Wai.Response
|
||||||
optionalRollback AppConfig{..} ApiRequest{..} transaction = do
|
optionalRollback AppConfig{..} ApiRequest{..} transaction = do
|
||||||
resp <- catchError transaction $ return . errorResponseFor
|
resp <- catchError transaction $ return . errorResponseFor
|
||||||
when (shouldRollback || (configDbTxRollbackAll && not shouldCommit))
|
when (shouldRollback || (configDbTxRollbackAll && not shouldCommit)) $ lift do
|
||||||
(lift H.condemn)
|
SQL.sql "SET CONSTRAINTS ALL IMMEDIATE"
|
||||||
|
SQL.condemn
|
||||||
return $ Wai.mapResponseHeaders preferenceApplied resp
|
return $ Wai.mapResponseHeaders preferenceApplied resp
|
||||||
where
|
where
|
||||||
shouldCommit =
|
shouldCommit =
|
||||||
@@ -175,9 +99,24 @@ optionalRollback AppConfig{..} ApiRequest{..} transaction = do
|
|||||||
preferenceApplied
|
preferenceApplied
|
||||||
| shouldCommit =
|
| shouldCommit =
|
||||||
addHeadersIfNotIncluded
|
addHeadersIfNotIncluded
|
||||||
[(HTTP.hPreferenceApplied, BS.pack (show Commit))]
|
[toAppliedHeader Commit]
|
||||||
| shouldRollback =
|
| shouldRollback =
|
||||||
addHeadersIfNotIncluded
|
addHeadersIfNotIncluded
|
||||||
[(HTTP.hPreferenceApplied, BS.pack (show Rollback))]
|
[toAppliedHeader Rollback]
|
||||||
| otherwise =
|
| otherwise =
|
||||||
identity
|
identity
|
||||||
|
|
||||||
|
-- | Do a pg set_config(setting, value, true) call. This is equivalent to a SET LOCAL.
|
||||||
|
setConfigLocal :: ByteString -> (ByteString, ByteString) -> SQL.Snippet
|
||||||
|
setConfigLocal prefix (k, v) =
|
||||||
|
"set_config(" <> unknownEncoder (prefix <> k) <> ", " <> unknownEncoder v <> ", true)"
|
||||||
|
|
||||||
|
-- | Starting from PostgreSQL v14, some characters are not allowed for config names (mostly affecting headers with "-").
|
||||||
|
-- | A JSON format string is used to avoid this problem. See https://github.com/PostgREST/postgrest/issues/1857
|
||||||
|
setConfigLocalJson :: ByteString -> [(ByteString, ByteString)] -> [SQL.Snippet]
|
||||||
|
setConfigLocalJson prefix keyVals = [setConfigLocal mempty (prefix, gucJsonVal keyVals)]
|
||||||
|
where
|
||||||
|
gucJsonVal :: [(ByteString, ByteString)] -> ByteString
|
||||||
|
gucJsonVal = LBS.toStrict . JSON.encode . HM.fromList . arrayByteStringToText
|
||||||
|
arrayByteStringToText :: [(ByteString, ByteString)] -> [(Text,Text)]
|
||||||
|
arrayByteStringToText keyVal = (T.decodeUtf8 *** T.decodeUtf8) <$> keyVal
|
||||||
|
|||||||
+98
-80
@@ -3,15 +3,16 @@ Module : PostgREST.OpenAPI
|
|||||||
Description : Generates the OpenAPI output
|
Description : Generates the OpenAPI output
|
||||||
-}
|
-}
|
||||||
{-# LANGUAGE LambdaCase #-}
|
{-# LANGUAGE LambdaCase #-}
|
||||||
{-# LANGUAGE NamedFieldPuns #-}
|
|
||||||
{-# LANGUAGE RecordWildCards #-}
|
{-# LANGUAGE RecordWildCards #-}
|
||||||
module PostgREST.OpenAPI (encode) where
|
module PostgREST.OpenAPI (encode) where
|
||||||
|
|
||||||
import qualified Data.Aeson as JSON
|
import qualified Data.Aeson as JSON
|
||||||
import qualified Data.ByteString.Lazy as LBS
|
import qualified Data.ByteString.Char8 as BS
|
||||||
import qualified Data.HashMap.Strict as HashMap
|
import qualified Data.ByteString.Lazy as LBS
|
||||||
import qualified Data.HashSet.InsOrd as Set
|
import qualified Data.HashMap.Strict as HM
|
||||||
import qualified Data.Text as T
|
import qualified Data.HashSet.InsOrd as Set
|
||||||
|
import qualified Data.Text as T
|
||||||
|
import qualified Data.Text.Encoding as T
|
||||||
|
|
||||||
import Control.Arrow ((&&&))
|
import Control.Arrow ((&&&))
|
||||||
import Data.HashMap.Strict.InsOrd (InsOrdHashMap, fromList)
|
import Data.HashMap.Strict.InsOrd (InsOrdHashMap, fromList)
|
||||||
@@ -25,76 +26,89 @@ import Data.Swagger
|
|||||||
|
|
||||||
import PostgREST.Config (AppConfig (..), Proxy (..),
|
import PostgREST.Config (AppConfig (..), Proxy (..),
|
||||||
isMalformedProxyUri, toURI)
|
isMalformedProxyUri, toURI)
|
||||||
import PostgREST.DbStructure (DbStructure (..),
|
import PostgREST.DbStructure (DbStructure (..))
|
||||||
tableCols, tablePKCols)
|
import PostgREST.DbStructure.Identifiers (QualifiedIdentifier (..))
|
||||||
import PostgREST.DbStructure.Proc (PgArg (..),
|
import PostgREST.DbStructure.Proc (ProcDescription (..),
|
||||||
ProcDescription (..))
|
ProcParam (..))
|
||||||
import PostgREST.DbStructure.Relationship (Cardinality (..),
|
import PostgREST.DbStructure.Relationship (Cardinality (..),
|
||||||
PrimaryKey (..),
|
Relationship (..),
|
||||||
Relationship (..))
|
RelationshipsMap)
|
||||||
import PostgREST.DbStructure.Table (Column (..), Table (..))
|
import PostgREST.DbStructure.Table (Column (..), Table (..),
|
||||||
|
TablesMap)
|
||||||
import PostgREST.Version (docsVersion, prettyVersion)
|
import PostgREST.Version (docsVersion, prettyVersion)
|
||||||
|
|
||||||
import PostgREST.ContentType
|
import PostgREST.MediaType
|
||||||
|
|
||||||
import Protolude hiding (Proxy, get, toS)
|
import Protolude hiding (Proxy, get)
|
||||||
import Protolude.Conv (toS)
|
|
||||||
|
|
||||||
encode :: AppConfig -> DbStructure -> [Table] -> HashMap.HashMap k [ProcDescription] -> Maybe Text -> LBS.ByteString
|
encode :: AppConfig -> DbStructure -> TablesMap -> HM.HashMap k [ProcDescription] -> Maybe Text -> LBS.ByteString
|
||||||
encode conf dbStructure tables procs schemaDescription =
|
encode conf dbStructure tables procs schemaDescription =
|
||||||
JSON.encode $
|
JSON.encode $
|
||||||
postgrestSpec
|
postgrestSpec
|
||||||
(dbRelationships dbStructure)
|
(dbRelationships dbStructure)
|
||||||
(concat $ HashMap.elems procs)
|
(concat $ HM.elems procs)
|
||||||
(openApiTableInfo dbStructure <$> tables)
|
(snd <$> HM.toList tables)
|
||||||
(proxyUri conf)
|
(proxyUri conf)
|
||||||
schemaDescription
|
schemaDescription
|
||||||
(dbPrimaryKeys dbStructure)
|
(configOpenApiSecurityActive conf)
|
||||||
|
|
||||||
makeMimeList :: [ContentType] -> MimeList
|
makeMimeList :: [MediaType] -> MimeList
|
||||||
makeMimeList cs = MimeList $ fmap (fromString . toS . toMime) cs
|
makeMimeList cs = MimeList $ fmap (fromString . BS.unpack . toMime) cs
|
||||||
|
|
||||||
toSwaggerType :: Text -> SwaggerType t
|
toSwaggerType :: Text -> Maybe (SwaggerType t)
|
||||||
toSwaggerType "character varying" = SwaggerString
|
toSwaggerType "character varying" = Just SwaggerString
|
||||||
toSwaggerType "character" = SwaggerString
|
toSwaggerType "character" = Just SwaggerString
|
||||||
toSwaggerType "text" = SwaggerString
|
toSwaggerType "text" = Just SwaggerString
|
||||||
toSwaggerType "boolean" = SwaggerBoolean
|
toSwaggerType "boolean" = Just SwaggerBoolean
|
||||||
toSwaggerType "smallint" = SwaggerInteger
|
toSwaggerType "smallint" = Just SwaggerInteger
|
||||||
toSwaggerType "integer" = SwaggerInteger
|
toSwaggerType "integer" = Just SwaggerInteger
|
||||||
toSwaggerType "bigint" = SwaggerInteger
|
toSwaggerType "bigint" = Just SwaggerInteger
|
||||||
toSwaggerType "numeric" = SwaggerNumber
|
toSwaggerType "numeric" = Just SwaggerNumber
|
||||||
toSwaggerType "real" = SwaggerNumber
|
toSwaggerType "real" = Just SwaggerNumber
|
||||||
toSwaggerType "double precision" = SwaggerNumber
|
toSwaggerType "double precision" = Just SwaggerNumber
|
||||||
toSwaggerType _ = SwaggerString
|
toSwaggerType "ARRAY" = Just SwaggerArray
|
||||||
|
toSwaggerType "json" = Nothing
|
||||||
|
toSwaggerType "jsonb" = Nothing
|
||||||
|
toSwaggerType _ = Just SwaggerString
|
||||||
|
|
||||||
makeTableDef :: [Relationship] -> [PrimaryKey] -> (Table, [Column], [Text]) -> (Text, Schema)
|
parseDefault :: Text -> Text -> Text
|
||||||
makeTableDef rels pks (t, cs, _) =
|
parseDefault colType colDefault =
|
||||||
|
case toSwaggerType colType of
|
||||||
|
Just SwaggerString -> wrapInQuotations $ case T.stripSuffix ("::" <> colType) colDefault of
|
||||||
|
Just def -> T.dropAround (=='\'') def
|
||||||
|
Nothing -> colDefault
|
||||||
|
_ -> colDefault
|
||||||
|
where
|
||||||
|
wrapInQuotations text = "\"" <> text <> "\""
|
||||||
|
|
||||||
|
makeTableDef :: RelationshipsMap -> Table -> (Text, Schema)
|
||||||
|
makeTableDef rels t =
|
||||||
let tn = tableName t in
|
let tn = tableName t in
|
||||||
(tn, (mempty :: Schema)
|
(tn, (mempty :: Schema)
|
||||||
& description .~ tableDescription t
|
& description .~ tableDescription t
|
||||||
& type_ ?~ SwaggerObject
|
& type_ ?~ SwaggerObject
|
||||||
& properties .~ fromList (fmap (makeProperty rels pks) cs)
|
& properties .~ fromList (makeProperty t rels <$> tableColumns t)
|
||||||
& required .~ fmap colName (filter (not . colNullable) cs))
|
& required .~ fmap colName (filter (not . colNullable) $ tableColumns t))
|
||||||
|
|
||||||
makeProperty :: [Relationship] -> [PrimaryKey] -> Column -> (Text, Referenced Schema)
|
makeProperty :: Table -> RelationshipsMap -> Column -> (Text, Referenced Schema)
|
||||||
makeProperty rels pks c = (colName c, Inline s)
|
makeProperty tbl rels col = (colName col, Inline s)
|
||||||
where
|
where
|
||||||
e = if null $ colEnum c then Nothing else JSON.decode $ JSON.encode $ colEnum c
|
e = if null $ colEnum col then Nothing else JSON.decode $ JSON.encode $ colEnum col
|
||||||
fk :: Maybe Text
|
fk :: Maybe Text
|
||||||
fk =
|
fk =
|
||||||
let
|
let
|
||||||
-- Finds the relationship that has a single column foreign key
|
-- Finds the relationship that has a single column foreign key
|
||||||
rel = find (\case
|
rel = find (\case
|
||||||
Relationship{relColumns, relCardinality=M2O _} -> [c] == relColumns
|
Relationship{relCardinality=(M2O _ relColumns)} -> [colName col] == (fst <$> relColumns)
|
||||||
_ -> False
|
_ -> False
|
||||||
) rels
|
) $ fromMaybe mempty $ HM.lookup (QualifiedIdentifier (tableSchema tbl) (tableName tbl), tableSchema tbl) rels
|
||||||
fCol = colName <$> (headMay . relForeignColumns =<< rel)
|
fCol = (headMay . (\r -> snd <$> relColumns (relCardinality r)) =<< rel)
|
||||||
fTbl = tableName . relForeignTable <$> rel
|
fTbl = qiName . relForeignTable <$> rel
|
||||||
fTblCol = (,) <$> fTbl <*> fCol
|
fTblCol = (,) <$> fTbl <*> fCol
|
||||||
in
|
in
|
||||||
(\(a, b) -> T.intercalate "" ["This is a Foreign Key to `", a, ".", b, "`.<fk table='", a, "' column='", b, "'/>"]) <$> fTblCol
|
(\(a, b) -> T.intercalate "" ["This is a Foreign Key to `", a, ".", b, "`.<fk table='", a, "' column='", b, "'/>"]) <$> fTblCol
|
||||||
pk :: Bool
|
pk :: Bool
|
||||||
pk = any (\p -> pkTable p == colTable c && pkName p == colName c) pks
|
pk = colName col `elem` tablePKCols tbl
|
||||||
n = catMaybes
|
n = catMaybes
|
||||||
[ Just "Note:"
|
[ Just "Note:"
|
||||||
, if pk then Just "This is a Primary Key.<pk/>" else Nothing
|
, if pk then Just "This is a Primary Key.<pk/>" else Nothing
|
||||||
@@ -102,31 +116,31 @@ makeProperty rels pks c = (colName c, Inline s)
|
|||||||
]
|
]
|
||||||
d =
|
d =
|
||||||
if length n > 1 then
|
if length n > 1 then
|
||||||
Just $ T.append (maybe "" (`T.append` "\n\n") $ colDescription c) (T.intercalate "\n" n)
|
Just $ T.append (maybe "" (`T.append` "\n\n") $ colDescription col) (T.intercalate "\n" n)
|
||||||
else
|
else
|
||||||
colDescription c
|
colDescription col
|
||||||
s =
|
s =
|
||||||
(mempty :: Schema)
|
(mempty :: Schema)
|
||||||
& default_ .~ (JSON.decode . toS =<< colDefault c)
|
& default_ .~ (JSON.decode . toUtf8Lazy . parseDefault (colType col) =<< colDefault col)
|
||||||
& description .~ d
|
& description .~ d
|
||||||
& enum_ .~ e
|
& enum_ .~ e
|
||||||
& format ?~ colType c
|
& format ?~ colType col
|
||||||
& maxLength .~ (fromIntegral <$> colMaxLen c)
|
& maxLength .~ (fromIntegral <$> colMaxLen col)
|
||||||
& type_ ?~ toSwaggerType (colType c)
|
& type_ .~ toSwaggerType (colType col)
|
||||||
|
|
||||||
makeProcSchema :: ProcDescription -> Schema
|
makeProcSchema :: ProcDescription -> Schema
|
||||||
makeProcSchema pd =
|
makeProcSchema pd =
|
||||||
(mempty :: Schema)
|
(mempty :: Schema)
|
||||||
& description .~ pdDescription pd
|
& description .~ pdDescription pd
|
||||||
& type_ ?~ SwaggerObject
|
& type_ ?~ SwaggerObject
|
||||||
& properties .~ fromList (fmap makeProcProperty (pdArgs pd))
|
& properties .~ fromList (fmap makeProcProperty (pdParams pd))
|
||||||
& required .~ fmap pgaName (filter pgaReq (pdArgs pd))
|
& required .~ fmap ppName (filter ppReq (pdParams pd))
|
||||||
|
|
||||||
makeProcProperty :: PgArg -> (Text, Referenced Schema)
|
makeProcProperty :: ProcParam -> (Text, Referenced Schema)
|
||||||
makeProcProperty (PgArg n t _ _) = (n, Inline s)
|
makeProcProperty (ProcParam n t _ _) = (n, Inline s)
|
||||||
where
|
where
|
||||||
s = (mempty :: Schema)
|
s = (mempty :: Schema)
|
||||||
& type_ ?~ toSwaggerType t
|
& type_ .~ toSwaggerType t
|
||||||
& format ?~ t
|
& format ?~ t
|
||||||
|
|
||||||
makePreferParam :: [Text] -> Param
|
makePreferParam :: [Text] -> Param
|
||||||
@@ -149,7 +163,7 @@ makeProcParam pd =
|
|||||||
, Ref $ Reference "preferParams"
|
, Ref $ Reference "preferParams"
|
||||||
]
|
]
|
||||||
|
|
||||||
makeParamDefs :: [(Table, [Column], [Text])] -> [(Text, Param)]
|
makeParamDefs :: [Table] -> [(Text, Param)]
|
||||||
makeParamDefs ti =
|
makeParamDefs ti =
|
||||||
[ ("preferParams", makePreferParam ["params=single-object"])
|
[ ("preferParams", makePreferParam ["params=single-object"])
|
||||||
, ("preferReturn", makePreferParam ["return=representation", "return=minimal", "return=none"])
|
, ("preferReturn", makePreferParam ["return=representation", "return=minimal", "return=none"])
|
||||||
@@ -205,8 +219,8 @@ makeParamDefs ti =
|
|||||||
& in_ .~ ParamQuery
|
& in_ .~ ParamQuery
|
||||||
& type_ ?~ SwaggerString))
|
& type_ ?~ SwaggerString))
|
||||||
]
|
]
|
||||||
<> concat [ makeObjectBody (tableName t) : makeRowFilters (tableName t) cs
|
<> concat [ makeObjectBody (tableName t) : makeRowFilters (tableName t) (tableColumns t)
|
||||||
| (t, cs, _) <- ti
|
| t <- ti
|
||||||
]
|
]
|
||||||
|
|
||||||
makeObjectBody :: Text -> (Text, Param)
|
makeObjectBody :: Text -> (Text, Param)
|
||||||
@@ -231,8 +245,8 @@ makeRowFilter tn c =
|
|||||||
makeRowFilters :: Text -> [Column] -> [(Text, Param)]
|
makeRowFilters :: Text -> [Column] -> [(Text, Param)]
|
||||||
makeRowFilters tn = fmap (makeRowFilter tn)
|
makeRowFilters tn = fmap (makeRowFilter tn)
|
||||||
|
|
||||||
makePathItem :: (Table, [Column], [Text]) -> (FilePath, PathItem)
|
makePathItem :: Table -> (FilePath, PathItem)
|
||||||
makePathItem (t, cs, _) = ("/" ++ T.unpack tn, p $ tableInsertable t || tableUpdatable t || tableDeletable t)
|
makePathItem t = ("/" ++ T.unpack tn, p $ tableInsertable t || tableUpdatable t || tableDeletable t)
|
||||||
where
|
where
|
||||||
-- Use first line of table description as summary; rest as description (if present)
|
-- Use first line of table description as summary; rest as description (if present)
|
||||||
-- We strip leading newlines from description so that users can include a blank line between summary and description
|
-- We strip leading newlines from description so that users can include a blank line between summary and description
|
||||||
@@ -266,7 +280,7 @@ makePathItem (t, cs, _) = ("/" ++ T.unpack tn, p $ tableInsertable t || tableUpd
|
|||||||
p False = pr
|
p False = pr
|
||||||
p True = pw
|
p True = pw
|
||||||
tn = tableName t
|
tn = tableName t
|
||||||
rs = [ T.intercalate "." ["rowFilter", tn, colName c ] | c <- cs ]
|
rs = [ T.intercalate "." ["rowFilter", tn, colName c ] | c <- tableColumns t ]
|
||||||
ref = Ref . Reference
|
ref = Ref . Reference
|
||||||
|
|
||||||
makeProcPathItem :: ProcDescription -> (FilePath, PathItem)
|
makeProcPathItem :: ProcDescription -> (FilePath, PathItem)
|
||||||
@@ -281,7 +295,7 @@ makeProcPathItem pd = ("/rpc/" ++ toS (pdName pd), pe)
|
|||||||
& description .~ mfilter (/="") pDesc
|
& description .~ mfilter (/="") pDesc
|
||||||
& parameters .~ makeProcParam pd
|
& parameters .~ makeProcParam pd
|
||||||
& tags .~ Set.fromList ["(rpc) " <> pdName pd]
|
& tags .~ Set.fromList ["(rpc) " <> pdName pd]
|
||||||
& produces ?~ makeMimeList [CTApplicationJSON, CTSingularJSON]
|
& produces ?~ makeMimeList [MTApplicationJSON, MTSingularJSON]
|
||||||
& at 200 ?~ "OK"
|
& at 200 ?~ "OK"
|
||||||
pe = (mempty :: PathItem) & post ?~ postOp
|
pe = (mempty :: PathItem) & post ?~ postOp
|
||||||
|
|
||||||
@@ -291,15 +305,23 @@ makeRootPathItem = ("/", p)
|
|||||||
getOp = (mempty :: Operation)
|
getOp = (mempty :: Operation)
|
||||||
& tags .~ Set.fromList ["Introspection"]
|
& tags .~ Set.fromList ["Introspection"]
|
||||||
& summary ?~ "OpenAPI description (this document)"
|
& summary ?~ "OpenAPI description (this document)"
|
||||||
& produces ?~ makeMimeList [CTOpenAPI, CTApplicationJSON]
|
& produces ?~ makeMimeList [MTOpenAPI, MTApplicationJSON]
|
||||||
& at 200 ?~ "OK"
|
& at 200 ?~ "OK"
|
||||||
pr = (mempty :: PathItem) & get ?~ getOp
|
pr = (mempty :: PathItem) & get ?~ getOp
|
||||||
p = pr
|
p = pr
|
||||||
|
|
||||||
makePathItems :: [ProcDescription] -> [(Table, [Column], [Text])] -> InsOrdHashMap FilePath PathItem
|
makePathItems :: [ProcDescription] -> [Table] -> InsOrdHashMap FilePath PathItem
|
||||||
makePathItems pds ti = fromList $ makeRootPathItem :
|
makePathItems pds ti = fromList $ makeRootPathItem :
|
||||||
fmap makePathItem ti ++ fmap makeProcPathItem pds
|
fmap makePathItem ti ++ fmap makeProcPathItem pds
|
||||||
|
|
||||||
|
makeSecurityDefinitions :: Text -> Bool -> SecurityDefinitions
|
||||||
|
makeSecurityDefinitions secName allow
|
||||||
|
| allow = SecurityDefinitions (fromList [(secName, SecurityScheme secSchType secSchDescription)])
|
||||||
|
| otherwise = mempty
|
||||||
|
where
|
||||||
|
secSchType = SecuritySchemeApiKey (ApiKeyParams "Authorization" ApiKeyHeader)
|
||||||
|
secSchDescription = Just "Add the token prepending \"Bearer \" (without quotes) to it"
|
||||||
|
|
||||||
escapeHostName :: Text -> Text
|
escapeHostName :: Text -> Text
|
||||||
escapeHostName "*" = "0.0.0.0"
|
escapeHostName "*" = "0.0.0.0"
|
||||||
escapeHostName "*4" = "0.0.0.0"
|
escapeHostName "*4" = "0.0.0.0"
|
||||||
@@ -308,27 +330,30 @@ escapeHostName "*6" = "0.0.0.0"
|
|||||||
escapeHostName "!6" = "0.0.0.0"
|
escapeHostName "!6" = "0.0.0.0"
|
||||||
escapeHostName h = h
|
escapeHostName h = h
|
||||||
|
|
||||||
postgrestSpec :: [Relationship] -> [ProcDescription] -> [(Table, [Column], [Text])] -> (Text, Text, Integer, Text) -> Maybe Text -> [PrimaryKey] -> Swagger
|
postgrestSpec :: RelationshipsMap -> [ProcDescription] -> [Table] -> (Text, Text, Integer, Text) -> Maybe Text -> Bool -> Swagger
|
||||||
postgrestSpec rels pds ti (s, h, p, b) sd pks = (mempty :: Swagger)
|
postgrestSpec rels pds ti (s, h, p, b) sd allowSecurityDef = (mempty :: Swagger)
|
||||||
& basePath ?~ T.unpack b
|
& basePath ?~ T.unpack b
|
||||||
& schemes ?~ [s']
|
& schemes ?~ [s']
|
||||||
& info .~ ((mempty :: Info)
|
& info .~ ((mempty :: Info)
|
||||||
& version .~ prettyVersion
|
& version .~ T.decodeUtf8 prettyVersion
|
||||||
& title .~ "PostgREST API"
|
& title .~ "PostgREST API"
|
||||||
& description ?~ d)
|
& description ?~ d)
|
||||||
& externalDocs ?~ ((mempty :: ExternalDocs)
|
& externalDocs ?~ ((mempty :: ExternalDocs)
|
||||||
& description ?~ "PostgREST Documentation"
|
& description ?~ "PostgREST Documentation"
|
||||||
& url .~ URL ("https://postgrest.org/en/" <> docsVersion <> "/api.html"))
|
& url .~ URL ("https://postgrest.org/en/" <> docsVersion <> "/api.html"))
|
||||||
& host .~ h'
|
& host .~ h'
|
||||||
& definitions .~ fromList (makeTableDef rels pks <$> ti)
|
& definitions .~ fromList (makeTableDef rels <$> ti)
|
||||||
& parameters .~ fromList (makeParamDefs ti)
|
& parameters .~ fromList (makeParamDefs ti)
|
||||||
& paths .~ makePathItems pds ti
|
& paths .~ makePathItems pds ti
|
||||||
& produces .~ makeMimeList [CTApplicationJSON, CTSingularJSON, CTTextCSV]
|
& produces .~ makeMimeList [MTApplicationJSON, MTSingularJSON, MTTextCSV]
|
||||||
& consumes .~ makeMimeList [CTApplicationJSON, CTSingularJSON, CTTextCSV]
|
& consumes .~ makeMimeList [MTApplicationJSON, MTSingularJSON, MTTextCSV]
|
||||||
|
& securityDefinitions .~ makeSecurityDefinitions securityDefName allowSecurityDef
|
||||||
|
& security .~ [SecurityRequirement (fromList [(securityDefName, [])]) | allowSecurityDef]
|
||||||
where
|
where
|
||||||
s' = if s == "http" then Http else Https
|
s' = if s == "http" then Http else Https
|
||||||
h' = Just $ Host (T.unpack $ escapeHostName h) (Just (fromInteger p))
|
h' = Just $ Host (T.unpack $ escapeHostName h) (Just (fromInteger p))
|
||||||
d = fromMaybe "This is a dynamic API generated by PostgREST" sd
|
d = fromMaybe "This is a dynamic API generated by PostgREST" sd
|
||||||
|
securityDefName = "JWT"
|
||||||
|
|
||||||
pickProxy :: Maybe Text -> Maybe Proxy
|
pickProxy :: Maybe Text -> Maybe Proxy
|
||||||
pickProxy proxy
|
pickProxy proxy
|
||||||
@@ -366,10 +391,3 @@ proxyUri AppConfig{..} =
|
|||||||
(proxyScheme, proxyHost, proxyPort, proxyPath)
|
(proxyScheme, proxyHost, proxyPort, proxyPath)
|
||||||
Nothing ->
|
Nothing ->
|
||||||
("http", configServerHost, toInteger configServerPort, "/")
|
("http", configServerHost, toInteger configServerPort, "/")
|
||||||
|
|
||||||
openApiTableInfo :: DbStructure -> Table -> (Table, [Column], [Text])
|
|
||||||
openApiTableInfo dbStructure table =
|
|
||||||
( table
|
|
||||||
, tableCols dbStructure (tableSchema table) (tableName table)
|
|
||||||
, tablePKCols dbStructure (tableSchema table) (tableName table)
|
|
||||||
)
|
|
||||||
|
|||||||
@@ -1,4 +1,5 @@
|
|||||||
{-# LANGUAGE DuplicateRecordFields #-}
|
{-# LANGUAGE DuplicateRecordFields #-}
|
||||||
|
{-# LANGUAGE NamedFieldPuns #-}
|
||||||
{-|
|
{-|
|
||||||
Module : PostgREST.Query.QueryBuilder
|
Module : PostgREST.Query.QueryBuilder
|
||||||
Description : PostgREST SQL queries generating functions.
|
Description : PostgREST SQL queries generating functions.
|
||||||
@@ -17,68 +18,79 @@ module PostgREST.Query.QueryBuilder
|
|||||||
|
|
||||||
import qualified Data.ByteString.Char8 as BS
|
import qualified Data.ByteString.Char8 as BS
|
||||||
import qualified Data.Set as S
|
import qualified Data.Set as S
|
||||||
import qualified Hasql.DynamicStatements.Snippet as H
|
import qualified Hasql.DynamicStatements.Snippet as SQL
|
||||||
|
|
||||||
import Data.Tree (Tree (..))
|
import Data.Tree (Tree (..))
|
||||||
|
|
||||||
import PostgREST.DbStructure.Identifiers (FieldName,
|
import PostgREST.DbStructure.Identifiers (QualifiedIdentifier (..))
|
||||||
QualifiedIdentifier (..))
|
import PostgREST.DbStructure.Proc (ProcParam (..))
|
||||||
import PostgREST.DbStructure.Proc (PgArg (..))
|
|
||||||
import PostgREST.DbStructure.Relationship (Cardinality (..),
|
import PostgREST.DbStructure.Relationship (Cardinality (..),
|
||||||
|
Junction (..),
|
||||||
Relationship (..))
|
Relationship (..))
|
||||||
import PostgREST.DbStructure.Table (Table (..))
|
import PostgREST.Request.Preferences (PreferResolution (..))
|
||||||
import PostgREST.Request.ApiRequest (PayloadJSON (..))
|
|
||||||
import PostgREST.Request.Preferences (PreferParameters (..),
|
|
||||||
PreferResolution (..))
|
|
||||||
|
|
||||||
import PostgREST.Query.SqlFragment
|
import PostgREST.Query.SqlFragment
|
||||||
|
import PostgREST.RangeQuery (allRange)
|
||||||
|
import PostgREST.Request.MutateQuery
|
||||||
|
import PostgREST.Request.ReadQuery
|
||||||
import PostgREST.Request.Types
|
import PostgREST.Request.Types
|
||||||
|
|
||||||
import Protolude
|
import Protolude
|
||||||
|
|
||||||
readRequestToQuery :: ReadRequest -> H.Snippet
|
readRequestToQuery :: ReadRequest -> SQL.Snippet
|
||||||
readRequestToQuery (Node (Select colSelects mainQi tblAlias implJoins logicForest joinConditions_ ordts range, _) forest) =
|
readRequestToQuery (Node (Select colSelects mainQi tblAlias logicForest joinConditions_ ordts range, (_, rel, _, _, _, _)) forest) =
|
||||||
"SELECT " <>
|
"SELECT " <>
|
||||||
intercalateSnippet ", " ((pgFmtSelectItem qi <$> colSelects) ++ selects) <>
|
intercalateSnippet ", " ((pgFmtSelectItem qi <$> colSelects) ++ selects) <> " " <>
|
||||||
"FROM " <> H.sql (BS.intercalate ", " (tabl : implJs)) <> " " <>
|
fromFrag <> " " <>
|
||||||
intercalateSnippet " " joins <> " " <>
|
intercalateSnippet " " joins <> " " <>
|
||||||
(if null logicForest && null joinConditions_ then mempty else "WHERE " <> intercalateSnippet " AND " (map (pgFmtLogicTree qi) logicForest ++ map pgFmtJoinCondition joinConditions_))
|
(if null logicForest && null joinConditions_
|
||||||
<> " " <>
|
then mempty
|
||||||
(if null ordts then mempty else "ORDER BY " <> intercalateSnippet ", " (map (pgFmtOrderTerm qi) ordts)) <> " " <>
|
else "WHERE " <> intercalateSnippet " AND " (map (pgFmtLogicTree qi) logicForest ++ map pgFmtJoinCondition joinConditions_)) <> " " <>
|
||||||
|
orderF qi ordts <> " " <>
|
||||||
limitOffsetF range
|
limitOffsetF range
|
||||||
where
|
where
|
||||||
implJs = fromQi <$> implJoins
|
fromFrag = fromF rel mainQi tblAlias
|
||||||
tabl = fromQi mainQi <> maybe mempty (\a -> " AS " <> pgFmtIdent a) tblAlias
|
qi = getQualifiedIdentifier rel mainQi tblAlias
|
||||||
qi = maybe mainQi (QualifiedIdentifier mempty) tblAlias
|
(selects, joins) = foldr getSelectsJoins ([],[]) forest
|
||||||
(joins, selects) = foldr getJoinsSelects ([],[]) forest
|
|
||||||
|
|
||||||
getJoinsSelects :: ReadRequest -> ([H.Snippet], [H.Snippet]) -> ([H.Snippet], [H.Snippet])
|
getSelectsJoins :: ReadRequest -> ([SQL.Snippet], [SQL.Snippet]) -> ([SQL.Snippet], [SQL.Snippet])
|
||||||
getJoinsSelects rr@(Node (_, (name, Just Relationship{relCardinality=card,relTable=Table{tableName=table}}, alias, _, _)) _) (j,s) =
|
getSelectsJoins (Node (_, (_, Nothing, _, _, _, _)) _) _ = ([], [])
|
||||||
let subquery = readRequestToQuery rr in
|
getSelectsJoins rr@(Node (_, (name, Just rel, alias, _, joinType, _)) _) (selects,joins) =
|
||||||
case card of
|
let
|
||||||
M2O _ ->
|
subquery = readRequestToQuery rr
|
||||||
let aliasOrName = fromMaybe name alias
|
aliasOrName = fromMaybe name alias
|
||||||
localTableName = pgFmtIdent $ table <> "_" <> aliasOrName
|
locTblName = qiName (relTable rel) <> "_" <> aliasOrName
|
||||||
sel = H.sql ("row_to_json(" <> localTableName <> ".*) AS " <> pgFmtIdent aliasOrName)
|
localTableName = pgFmtIdent locTblName
|
||||||
joi = " LEFT JOIN LATERAL( " <> subquery <> " ) AS " <> H.sql localTableName <> " ON TRUE " in
|
internalTableName = pgFmtIdent $ "_" <> locTblName
|
||||||
(joi:j,sel:s)
|
correlatedSubquery sub al cond =
|
||||||
_ ->
|
(if joinType == Just JTInner then "INNER" else "LEFT") <> " JOIN LATERAL ( " <> sub <> " ) AS " <> SQL.sql al <> " ON " <> cond
|
||||||
let sel = "COALESCE (("
|
isToOne = case rel of
|
||||||
<> "SELECT json_agg(" <> H.sql (pgFmtIdent table) <> ".*) "
|
Relationship{relCardinality=M2O _ _} -> True
|
||||||
<> "FROM (" <> subquery <> ") " <> H.sql (pgFmtIdent table) <> " "
|
Relationship{relCardinality=O2O _ _} -> True
|
||||||
<> "), '[]') AS " <> H.sql (pgFmtIdent (fromMaybe name alias)) in
|
ComputedRelationship{relToOne=True} -> True
|
||||||
(j,sel:s)
|
_ -> False
|
||||||
getJoinsSelects (Node (_, (_, Nothing, _, _, _)) _) _ = ([], [])
|
(sel, joi) = if isToOne
|
||||||
|
then
|
||||||
|
( SQL.sql ("row_to_json(" <> localTableName <> ".*) AS " <> pgFmtIdent aliasOrName)
|
||||||
|
, correlatedSubquery subquery localTableName "TRUE")
|
||||||
|
else
|
||||||
|
( SQL.sql $ "COALESCE( " <> localTableName <> "." <> internalTableName <> ", '[]') AS " <> pgFmtIdent aliasOrName
|
||||||
|
, correlatedSubquery (
|
||||||
|
"SELECT json_agg(" <> SQL.sql internalTableName <> ") AS " <> SQL.sql internalTableName <>
|
||||||
|
"FROM (" <> subquery <> " ) AS " <> SQL.sql internalTableName
|
||||||
|
) localTableName $ if joinType == Just JTInner then SQL.sql localTableName <> " IS NOT NULL" else "TRUE")
|
||||||
|
in
|
||||||
|
(sel:selects, joi:joins)
|
||||||
|
|
||||||
mutateRequestToQuery :: MutateRequest -> H.Snippet
|
mutateRequestToQuery :: MutateRequest -> SQL.Snippet
|
||||||
mutateRequestToQuery (Insert mainQi iCols body onConflct putConditions returnings) =
|
mutateRequestToQuery (Insert mainQi iCols body onConflct putConditions returnings) =
|
||||||
"WITH " <> normalizedBody body <> " " <>
|
"WITH " <> normalizedBody body <> " " <>
|
||||||
"INSERT INTO " <> H.sql (fromQi mainQi) <> H.sql (if S.null iCols then " " else "(" <> cols <> ") ") <>
|
"INSERT INTO " <> SQL.sql (fromQi mainQi) <> SQL.sql (if S.null iCols then " " else "(" <> cols <> ") ") <>
|
||||||
"SELECT " <> H.sql cols <> " " <>
|
"SELECT " <> SQL.sql cols <> " " <>
|
||||||
H.sql ("FROM json_populate_recordset (null::" <> fromQi mainQi <> ", " <> selectBody <> ") _ ") <>
|
SQL.sql ("FROM json_populate_recordset (null::" <> fromQi mainQi <> ", " <> selectBody <> ") _ ") <>
|
||||||
-- Only used for PUT
|
-- Only used for PUT
|
||||||
(if null putConditions then mempty else "WHERE " <> intercalateSnippet " AND " (pgFmtLogicTree (QualifiedIdentifier mempty "_") <$> putConditions)) <>
|
(if null putConditions then mempty else "WHERE " <> intercalateSnippet " AND " (pgFmtLogicTree (QualifiedIdentifier mempty "_") <$> putConditions)) <>
|
||||||
H.sql (BS.unwords [
|
SQL.sql (BS.unwords [
|
||||||
maybe "" (\(oncDo, oncCols) ->
|
maybe "" (\(oncDo, oncCols) ->
|
||||||
if null oncCols then
|
if null oncCols then
|
||||||
mempty
|
mempty
|
||||||
@@ -95,61 +107,96 @@ mutateRequestToQuery (Insert mainQi iCols body onConflct putConditions returning
|
|||||||
])
|
])
|
||||||
where
|
where
|
||||||
cols = BS.intercalate ", " $ pgFmtIdent <$> S.toList iCols
|
cols = BS.intercalate ", " $ pgFmtIdent <$> S.toList iCols
|
||||||
mutateRequestToQuery (Update mainQi uCols body logicForest returnings) =
|
|
||||||
if S.null uCols
|
-- An update without a limit is always filtered with a WHERE
|
||||||
|
mutateRequestToQuery (Update mainQi uCols body logicForest range ordts returnings)
|
||||||
|
| S.null uCols =
|
||||||
-- if there are no columns we cannot do UPDATE table SET {empty}, it'd be invalid syntax
|
-- if there are no columns we cannot do UPDATE table SET {empty}, it'd be invalid syntax
|
||||||
-- selecting an empty resultset from mainQi gives us the column names to prevent errors when using &select=
|
-- selecting an empty resultset from mainQi gives us the column names to prevent errors when using &select=
|
||||||
-- the select has to be based on "returnings" to make computed overloaded functions not throw
|
-- the select has to be based on "returnings" to make computed overloaded functions not throw
|
||||||
then H.sql ("SELECT " <> emptyBodyReturnedColumns <> " FROM " <> fromQi mainQi <> " WHERE false")
|
SQL.sql $ "SELECT " <> emptyBodyReturnedColumns <> " FROM " <> fromQi mainQi <> " WHERE false"
|
||||||
else
|
|
||||||
"WITH " <> normalizedBody body <> " " <>
|
|
||||||
"UPDATE " <> H.sql (fromQi mainQi) <> " SET " <> H.sql cols <> " " <>
|
|
||||||
"FROM (SELECT * FROM json_populate_recordset (null::" <> H.sql (fromQi mainQi) <> " , " <> H.sql selectBody <> " )) _ " <>
|
|
||||||
(if null logicForest then mempty else "WHERE " <> intercalateSnippet " AND " (pgFmtLogicTree mainQi <$> logicForest)) <> " " <>
|
|
||||||
H.sql (returningF mainQi returnings)
|
|
||||||
where
|
|
||||||
cols = BS.intercalate ", " (pgFmtIdent <> const " = _." <> pgFmtIdent <$> S.toList uCols)
|
|
||||||
emptyBodyReturnedColumns :: SqlFragment
|
|
||||||
emptyBodyReturnedColumns
|
|
||||||
| null returnings = "NULL"
|
|
||||||
| otherwise = BS.intercalate ", " (pgFmtColumn (QualifiedIdentifier mempty $ qiName mainQi) <$> returnings)
|
|
||||||
mutateRequestToQuery (Delete mainQi logicForest returnings) =
|
|
||||||
"DELETE FROM " <> H.sql (fromQi mainQi) <> " " <>
|
|
||||||
(if null logicForest then mempty else "WHERE " <> intercalateSnippet " AND " (map (pgFmtLogicTree mainQi) logicForest)) <> " " <>
|
|
||||||
H.sql (returningF mainQi returnings)
|
|
||||||
|
|
||||||
requestToCallProcQuery :: QualifiedIdentifier -> [PgArg] -> Maybe PayloadJSON -> Bool -> Maybe PreferParameters -> [FieldName] -> H.Snippet
|
| range == allRange =
|
||||||
requestToCallProcQuery qi pgArgs pj returnsScalar preferParams returnings =
|
"WITH " <> normalizedBody body <> " " <>
|
||||||
argsCTE <> sourceBody
|
"UPDATE " <> mainTbl <> " SET " <> SQL.sql nonRangeCols <> " " <>
|
||||||
where
|
"FROM (SELECT * FROM json_populate_recordset (null::" <> mainTbl <> " , " <> SQL.sql selectBody <> " )) _ " <>
|
||||||
body = pjRaw <$> pj
|
whereLogic <> " " <>
|
||||||
paramsAsSingleObject = preferParams == Just SingleObject
|
SQL.sql (returningF mainQi returnings)
|
||||||
paramsAsMultipleObjects = preferParams == Just MultipleObjects
|
|
||||||
|
|
||||||
(argsCTE, args)
|
| otherwise =
|
||||||
| null pgArgs = (mempty, mempty)
|
"WITH " <> normalizedBody body <> ", " <>
|
||||||
| paramsAsSingleObject = ("WITH pgrst_args AS (SELECT NULL)", jsonPlaceHolder body)
|
"pgrst_update_body AS (SELECT * FROM json_populate_recordset (null::" <> mainTbl <> " , " <> SQL.sql selectBody <> " ) LIMIT 1), " <>
|
||||||
| otherwise = (
|
"pgrst_affected_rows AS (" <>
|
||||||
"WITH " <> normalizedBody body <> ", " <>
|
"SELECT " <> SQL.sql rangeIdF <> " FROM " <> mainTbl <>
|
||||||
H.sql (
|
whereLogic <> " " <>
|
||||||
|
orderF mainQi ordts <> " " <>
|
||||||
|
limitOffsetF range <>
|
||||||
|
") " <>
|
||||||
|
"UPDATE " <> mainTbl <> " SET " <> SQL.sql rangeCols <>
|
||||||
|
"FROM pgrst_affected_rows " <>
|
||||||
|
"WHERE " <> SQL.sql whereRangeIdF <> " " <>
|
||||||
|
SQL.sql (returningF mainQi returnings)
|
||||||
|
|
||||||
|
where
|
||||||
|
whereLogic = if null logicForest then mempty else " WHERE " <> intercalateSnippet " AND " (pgFmtLogicTree mainQi <$> logicForest)
|
||||||
|
mainTbl = SQL.sql (fromQi mainQi)
|
||||||
|
emptyBodyReturnedColumns = if null returnings then "NULL" else BS.intercalate ", " (pgFmtColumn (QualifiedIdentifier mempty $ qiName mainQi) <$> returnings)
|
||||||
|
nonRangeCols = BS.intercalate ", " (pgFmtIdent <> const " = _." <> pgFmtIdent <$> S.toList uCols)
|
||||||
|
rangeCols = BS.intercalate ", " ((\col -> pgFmtIdent col <> " = (SELECT " <> pgFmtIdent col <> " FROM pgrst_update_body) ") <$> S.toList uCols)
|
||||||
|
(whereRangeIdF, rangeIdF) = mutRangeF mainQi (fst . otTerm <$> ordts)
|
||||||
|
|
||||||
|
mutateRequestToQuery (Delete mainQi logicForest range ordts returnings)
|
||||||
|
| range == allRange =
|
||||||
|
"DELETE FROM " <> SQL.sql (fromQi mainQi) <> " " <>
|
||||||
|
whereLogic <> " " <>
|
||||||
|
SQL.sql (returningF mainQi returnings)
|
||||||
|
|
||||||
|
| otherwise =
|
||||||
|
"WITH " <>
|
||||||
|
"pgrst_affected_rows AS (" <>
|
||||||
|
"SELECT " <> SQL.sql rangeIdF <> " FROM " <> SQL.sql (fromQi mainQi) <>
|
||||||
|
whereLogic <> " " <>
|
||||||
|
orderF mainQi ordts <> " " <>
|
||||||
|
limitOffsetF range <>
|
||||||
|
") " <>
|
||||||
|
"DELETE FROM " <> SQL.sql (fromQi mainQi) <> " " <>
|
||||||
|
"USING pgrst_affected_rows " <>
|
||||||
|
"WHERE " <> SQL.sql whereRangeIdF <> " " <>
|
||||||
|
SQL.sql (returningF mainQi returnings)
|
||||||
|
|
||||||
|
where
|
||||||
|
whereLogic = if null logicForest then mempty else " WHERE " <> intercalateSnippet " AND " (pgFmtLogicTree mainQi <$> logicForest)
|
||||||
|
(whereRangeIdF, rangeIdF) = mutRangeF mainQi (fst . otTerm <$> ordts)
|
||||||
|
|
||||||
|
requestToCallProcQuery :: CallRequest -> SQL.Snippet
|
||||||
|
requestToCallProcQuery (FunctionCall qi params args returnsScalar multipleCall returnings) =
|
||||||
|
prmsCTE <> argsBody
|
||||||
|
where
|
||||||
|
(prmsCTE, argFrag) = case params of
|
||||||
|
OnePosParam prm -> ("WITH pgrst_args AS (SELECT NULL)", singleParameter args (encodeUtf8 $ ppType prm))
|
||||||
|
KeyParams [] -> (mempty, mempty)
|
||||||
|
KeyParams prms -> (
|
||||||
|
"WITH " <> normalizedBody args <> ", " <>
|
||||||
|
SQL.sql (
|
||||||
BS.unwords [
|
BS.unwords [
|
||||||
"pgrst_args AS (",
|
"pgrst_args AS (",
|
||||||
"SELECT * FROM json_to_recordset(" <> selectBody <> ") AS _(" <> fmtArgs (const mempty) (\a -> " " <> encodeUtf8 (pgaType a)) <> ")",
|
"SELECT * FROM json_to_recordset(" <> selectBody <> ") AS _(" <> fmtParams prms (const mempty) (\a -> " " <> encodeUtf8 (ppType a)) <> ")",
|
||||||
")"])
|
")"])
|
||||||
, H.sql $ if paramsAsMultipleObjects
|
, SQL.sql $ if multipleCall
|
||||||
then fmtArgs varadicPrefix (\a -> " := pgrst_args." <> pgFmtIdent (pgaName a))
|
then fmtParams prms varadicPrefix (\a -> " := pgrst_args." <> pgFmtIdent (ppName a))
|
||||||
else fmtArgs varadicPrefix (\a -> " := (SELECT " <> pgFmtIdent (pgaName a) <> " FROM pgrst_args LIMIT 1)")
|
else fmtParams prms varadicPrefix (\a -> " := (SELECT " <> pgFmtIdent (ppName a) <> " FROM pgrst_args LIMIT 1)")
|
||||||
)
|
)
|
||||||
|
|
||||||
fmtArgs :: (PgArg -> SqlFragment) -> (PgArg -> SqlFragment) -> SqlFragment
|
fmtParams :: [ProcParam] -> (ProcParam -> SqlFragment) -> (ProcParam -> SqlFragment) -> SqlFragment
|
||||||
fmtArgs argFragPre argFragSuf = BS.intercalate ", " ((\a -> argFragPre a <> pgFmtIdent (pgaName a) <> argFragSuf a) <$> pgArgs)
|
fmtParams prms prmFragPre prmFragSuf = BS.intercalate ", "
|
||||||
|
((\a -> prmFragPre a <> pgFmtIdent (ppName a) <> prmFragSuf a) <$> prms)
|
||||||
|
|
||||||
varadicPrefix :: PgArg -> SqlFragment
|
varadicPrefix :: ProcParam -> SqlFragment
|
||||||
varadicPrefix a = if pgaVar a then "VARIADIC " else mempty
|
varadicPrefix a = if ppVar a then "VARIADIC " else mempty
|
||||||
|
|
||||||
sourceBody :: H.Snippet
|
argsBody :: SQL.Snippet
|
||||||
sourceBody
|
argsBody
|
||||||
| paramsAsMultipleObjects =
|
| multipleCall =
|
||||||
if returnsScalar
|
if returnsScalar
|
||||||
then "SELECT " <> callIt <> " AS pgrst_scalar FROM pgrst_args"
|
then "SELECT " <> callIt <> " AS pgrst_scalar FROM pgrst_args"
|
||||||
else "SELECT pgrst_lat_args.* FROM pgrst_args, " <>
|
else "SELECT pgrst_lat_args.* FROM pgrst_args, " <>
|
||||||
@@ -159,23 +206,60 @@ requestToCallProcQuery qi pgArgs pj returnsScalar preferParams returnings =
|
|||||||
then "SELECT " <> callIt <> " AS pgrst_scalar"
|
then "SELECT " <> callIt <> " AS pgrst_scalar"
|
||||||
else "SELECT " <> returnedColumns <> " FROM " <> callIt
|
else "SELECT " <> returnedColumns <> " FROM " <> callIt
|
||||||
|
|
||||||
callIt :: H.Snippet
|
callIt :: SQL.Snippet
|
||||||
callIt = H.sql (fromQi qi) <> "(" <> args <> ")"
|
callIt = SQL.sql (fromQi qi) <> "(" <> argFrag <> ")"
|
||||||
|
|
||||||
returnedColumns :: H.Snippet
|
returnedColumns :: SQL.Snippet
|
||||||
returnedColumns
|
returnedColumns
|
||||||
| null returnings = "*"
|
| null returnings = "*"
|
||||||
| otherwise = H.sql $ BS.intercalate ", " (pgFmtColumn (QualifiedIdentifier mempty $ qiName qi) <$> returnings)
|
| otherwise = SQL.sql $ BS.intercalate ", " (pgFmtColumn (QualifiedIdentifier mempty $ qiName qi) <$> returnings)
|
||||||
|
|
||||||
|
|
||||||
-- | SQL query meant for COUNTing the root node of the Tree.
|
-- | SQL query meant for COUNTing the root node of the Tree.
|
||||||
-- It only takes WHERE into account and doesn't include LIMIT/OFFSET because it would reduce the COUNT.
|
-- It only takes WHERE into account and doesn't include LIMIT/OFFSET because it would reduce the COUNT.
|
||||||
-- SELECT 1 is done instead of SELECT * to prevent doing expensive operations(like functions based on the columns)
|
-- SELECT 1 is done instead of SELECT * to prevent doing expensive operations(like functions based on the columns)
|
||||||
-- inside the FROM target.
|
-- inside the FROM target.
|
||||||
readRequestToCountQuery :: ReadRequest -> H.Snippet
|
-- If the request contains INNER JOINs, then the COUNT of the root node will change.
|
||||||
readRequestToCountQuery (Node (Select{from=qi, where_=logicForest}, _) _) =
|
-- For this case, we use a WHERE EXISTS instead of an INNER JOIN on the count query.
|
||||||
"SELECT 1 " <> "FROM " <> H.sql (fromQi qi) <> " " <>
|
-- See https://github.com/PostgREST/postgrest/issues/2009#issuecomment-977473031
|
||||||
if null logicForest then mempty else "WHERE " <> intercalateSnippet " AND " (map (pgFmtLogicTree qi) logicForest)
|
-- Only for the nodes that have an INNER JOIN linked to the root level.
|
||||||
|
readRequestToCountQuery :: ReadRequest -> SQL.Snippet
|
||||||
|
readRequestToCountQuery (Node (Select{from=mainQi, fromAlias=tblAlias, where_=logicForest, joinConditions=joinConditions_}, (_, rel, _, _, _, _)) forest) =
|
||||||
|
"SELECT 1 " <> fromFrag <>
|
||||||
|
(if null logicForest && null joinConditions_ && null subQueries
|
||||||
|
then mempty
|
||||||
|
else " WHERE " ) <>
|
||||||
|
intercalateSnippet " AND " (
|
||||||
|
map (pgFmtLogicTree qi) logicForest ++
|
||||||
|
map pgFmtJoinCondition joinConditions_ ++
|
||||||
|
subQueries
|
||||||
|
)
|
||||||
|
where
|
||||||
|
qi = getQualifiedIdentifier rel mainQi tblAlias
|
||||||
|
fromFrag = fromF rel mainQi tblAlias
|
||||||
|
subQueries = foldr existsSubquery [] forest
|
||||||
|
existsSubquery :: ReadRequest -> [SQL.Snippet] -> [SQL.Snippet]
|
||||||
|
existsSubquery readReq@(Node (_, (_, _, _, _, joinType, _)) _) rest =
|
||||||
|
if joinType == Just JTInner
|
||||||
|
then ("EXISTS (" <> readRequestToCountQuery readReq <> " )"):rest
|
||||||
|
else rest
|
||||||
|
|
||||||
limitedQuery :: H.Snippet -> Maybe Integer -> H.Snippet
|
limitedQuery :: SQL.Snippet -> Maybe Integer -> SQL.Snippet
|
||||||
limitedQuery query maxRows = query <> H.sql (maybe mempty (\x -> " LIMIT " <> BS.pack (show x)) maxRows)
|
limitedQuery query maxRows = query <> SQL.sql (maybe mempty (\x -> " LIMIT " <> BS.pack (show x)) maxRows)
|
||||||
|
|
||||||
|
-- TODO refactor so this function is uneeded and ComputedRelationship QualifiedIdentifier comes from the ReadQuery type
|
||||||
|
getQualifiedIdentifier :: Maybe Relationship -> QualifiedIdentifier -> Maybe Alias -> QualifiedIdentifier
|
||||||
|
getQualifiedIdentifier rel mainQi tblAlias = case rel of
|
||||||
|
Just ComputedRelationship{relFunction} -> QualifiedIdentifier mempty $ fromMaybe (qiName relFunction) tblAlias
|
||||||
|
_ -> maybe mainQi (QualifiedIdentifier mempty) tblAlias
|
||||||
|
|
||||||
|
-- FROM clause plus implicit joins
|
||||||
|
fromF :: Maybe Relationship -> QualifiedIdentifier -> Maybe Alias -> SQL.Snippet
|
||||||
|
fromF rel mainQi tblAlias = SQL.sql $ "FROM " <>
|
||||||
|
(case rel of
|
||||||
|
Just ComputedRelationship{relFunction,relTable} -> fromQi relFunction <> "(" <> pgFmtIdent (qiName relTable) <> ")"
|
||||||
|
_ -> fromQi mainQi) <>
|
||||||
|
maybe mempty (\a -> " AS " <> pgFmtIdent a) tblAlias <>
|
||||||
|
(case rel of
|
||||||
|
Just Relationship{relCardinality=M2M Junction{junTable=jt}} -> ", " <> fromQi jt
|
||||||
|
_ -> mempty)
|
||||||
|
|||||||
+177
-111
@@ -11,18 +11,20 @@ module PostgREST.Query.SqlFragment
|
|||||||
, SqlFragment
|
, SqlFragment
|
||||||
, asBinaryF
|
, asBinaryF
|
||||||
, asCsvF
|
, asCsvF
|
||||||
|
, asGeoJsonF
|
||||||
, asJsonF
|
, asJsonF
|
||||||
, asJsonSingleF
|
, asJsonSingleF
|
||||||
|
, asXmlF
|
||||||
, countF
|
, countF
|
||||||
, fromQi
|
, fromQi
|
||||||
, ftsOperators
|
|
||||||
, jsonPlaceHolder
|
|
||||||
, limitOffsetF
|
, limitOffsetF
|
||||||
, locationF
|
, locationF
|
||||||
|
, mutRangeF
|
||||||
, normalizedBody
|
, normalizedBody
|
||||||
, operators
|
, orderF
|
||||||
, pgFmtColumn
|
, pgFmtColumn
|
||||||
, pgFmtIdent
|
, pgFmtIdent
|
||||||
|
, pgFmtIdentList
|
||||||
, pgFmtJoinCondition
|
, pgFmtJoinCondition
|
||||||
, pgFmtLogicTree
|
, pgFmtLogicTree
|
||||||
, pgFmtOrderTerm
|
, pgFmtOrderTerm
|
||||||
@@ -31,36 +33,45 @@ module PostgREST.Query.SqlFragment
|
|||||||
, responseStatusF
|
, responseStatusF
|
||||||
, returningF
|
, returningF
|
||||||
, selectBody
|
, selectBody
|
||||||
|
, singleParameter
|
||||||
, sourceCTEName
|
, sourceCTEName
|
||||||
, unknownEncoder
|
, unknownEncoder
|
||||||
, intercalateSnippet
|
, intercalateSnippet
|
||||||
|
, explainF
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import qualified Data.ByteString.Char8 as BS
|
import qualified Data.ByteString.Char8 as BS
|
||||||
import qualified Data.ByteString.Lazy as BL
|
import qualified Data.ByteString.Lazy as LBS
|
||||||
import qualified Data.HashMap.Strict as HM
|
|
||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
import qualified Hasql.DynamicStatements.Snippet as H
|
import qualified Hasql.DynamicStatements.Snippet as SQL
|
||||||
import qualified Hasql.Encoders as HE
|
import qualified Hasql.Encoders as HE
|
||||||
|
|
||||||
import Data.Foldable (foldr1)
|
import Data.Foldable (foldr1)
|
||||||
import Text.InterpolatedString.Perl6 (qc)
|
import Text.InterpolatedString.Perl6 (qc)
|
||||||
|
|
||||||
import PostgREST.Config.PgVersion (PgVersion, pgVersion96)
|
|
||||||
import PostgREST.DbStructure.Identifiers (FieldName,
|
import PostgREST.DbStructure.Identifiers (FieldName,
|
||||||
QualifiedIdentifier (..))
|
QualifiedIdentifier (..))
|
||||||
|
import PostgREST.MediaType (MTPlanFormat (..),
|
||||||
|
MTPlanOption (..))
|
||||||
import PostgREST.RangeQuery (NonnegRange, allRange,
|
import PostgREST.RangeQuery (NonnegRange, allRange,
|
||||||
rangeLimit, rangeOffset)
|
rangeLimit, rangeOffset)
|
||||||
|
import PostgREST.Request.ReadQuery (SelectItem)
|
||||||
import PostgREST.Request.Types (Alias, Field, Filter (..),
|
import PostgREST.Request.Types (Alias, Field, Filter (..),
|
||||||
|
FtsOperator (..),
|
||||||
JoinCondition (..),
|
JoinCondition (..),
|
||||||
JsonOperand (..),
|
JsonOperand (..),
|
||||||
JsonOperation (..),
|
JsonOperation (..),
|
||||||
JsonPath, LogicTree (..),
|
JsonPath,
|
||||||
OpExpr (..), Operation (..),
|
LogicOperator (..),
|
||||||
OrderTerm (..), SelectItem)
|
LogicTree (..), OpExpr (..),
|
||||||
|
Operation (..),
|
||||||
|
OrderDirection (..),
|
||||||
|
OrderNulls (..),
|
||||||
|
OrderTerm (..),
|
||||||
|
SimpleOperator (..),
|
||||||
|
TrileanVal (..))
|
||||||
|
|
||||||
import Protolude hiding (cast, toS)
|
import Protolude hiding (cast)
|
||||||
import Protolude.Conv (toS)
|
|
||||||
|
|
||||||
|
|
||||||
-- | A part of a SQL query that cannot be executed independently
|
-- | A part of a SQL query that cannot be executed independently
|
||||||
@@ -72,43 +83,43 @@ noLocationF = "array[]::text[]"
|
|||||||
sourceCTEName :: SqlFragment
|
sourceCTEName :: SqlFragment
|
||||||
sourceCTEName = "pgrst_source"
|
sourceCTEName = "pgrst_source"
|
||||||
|
|
||||||
operators :: HM.HashMap Text SqlFragment
|
singleValOperator :: SimpleOperator -> SqlFragment
|
||||||
operators = HM.union (HM.fromList [
|
singleValOperator = \case
|
||||||
("eq", "="),
|
OpEqual -> "="
|
||||||
("gte", ">="),
|
OpGreaterThanEqual -> ">="
|
||||||
("gt", ">"),
|
OpGreaterThan -> ">"
|
||||||
("lte", "<="),
|
OpLessThanEqual -> "<="
|
||||||
("lt", "<"),
|
OpLessThan -> "<"
|
||||||
("neq", "<>"),
|
OpNotEqual -> "<>"
|
||||||
("like", "LIKE"),
|
OpLike -> "like"
|
||||||
("ilike", "ILIKE"),
|
OpILike -> "ilike"
|
||||||
("in", "IN"),
|
OpContains -> "@>"
|
||||||
("is", "IS"),
|
OpContained -> "<@"
|
||||||
("cs", "@>"),
|
OpOverlap -> "&&"
|
||||||
("cd", "<@"),
|
OpStrictlyLeft -> "<<"
|
||||||
("ov", "&&"),
|
OpStrictlyRight -> ">>"
|
||||||
("sl", "<<"),
|
OpNotExtendsRight -> "&<"
|
||||||
("sr", ">>"),
|
OpNotExtendsLeft -> "&>"
|
||||||
("nxr", "&<"),
|
OpAdjacent -> "-|-"
|
||||||
("nxl", "&>"),
|
OpMatch -> "~"
|
||||||
("adj", "-|-")]) ftsOperators
|
OpIMatch -> "~*"
|
||||||
|
|
||||||
ftsOperators :: HM.HashMap Text SqlFragment
|
ftsOperator :: FtsOperator -> SqlFragment
|
||||||
ftsOperators = HM.fromList [
|
ftsOperator = \case
|
||||||
("fts", "@@ to_tsquery"),
|
FilterFts -> "@@ to_tsquery"
|
||||||
("plfts", "@@ plainto_tsquery"),
|
FilterFtsPlain -> "@@ plainto_tsquery"
|
||||||
("phfts", "@@ phraseto_tsquery"),
|
FilterFtsPhrase -> "@@ phraseto_tsquery"
|
||||||
("wfts", "@@ websearch_to_tsquery")
|
FilterFtsWebsearch -> "@@ websearch_to_tsquery"
|
||||||
]
|
|
||||||
|
|
||||||
-- |
|
-- |
|
||||||
-- These CTEs convert a json object into a json array, this way we can use json_populate_recordset for all json payloads
|
-- These CTEs convert a json object into a json array, this way we can use json_populate_recordset for all json payloads
|
||||||
-- Otherwise we'd have to use json_populate_record for json objects and json_populate_recordset for json arrays
|
-- Otherwise we'd have to use json_populate_record for json objects and json_populate_recordset for json arrays
|
||||||
-- We do this in SQL to avoid processing the JSON in application code
|
-- We do this in SQL to avoid processing the JSON in application code
|
||||||
normalizedBody :: Maybe BL.ByteString -> H.Snippet
|
-- TODO: At this stage there shouldn't be a Maybe since ApiRequest should ensure that an INSERT/UPDATE has a body
|
||||||
|
normalizedBody :: Maybe LBS.ByteString -> SQL.Snippet
|
||||||
normalizedBody body =
|
normalizedBody body =
|
||||||
"pgrst_payload AS (SELECT " <> jsonPlaceHolder body <> " AS json_data), " <>
|
"pgrst_payload AS (SELECT " <> jsonPlaceHolder <> " AS json_data), " <>
|
||||||
H.sql (BS.unwords [
|
SQL.sql (BS.unwords [
|
||||||
"pgrst_body AS (",
|
"pgrst_body AS (",
|
||||||
"SELECT",
|
"SELECT",
|
||||||
"CASE WHEN json_typeof(json_data) = 'array'",
|
"CASE WHEN json_typeof(json_data) = 'array'",
|
||||||
@@ -116,24 +127,31 @@ normalizedBody body =
|
|||||||
"ELSE json_build_array(json_data)",
|
"ELSE json_build_array(json_data)",
|
||||||
"END AS val",
|
"END AS val",
|
||||||
"FROM pgrst_payload)"])
|
"FROM pgrst_payload)"])
|
||||||
|
where
|
||||||
|
jsonPlaceHolder = SQL.encoderAndParam (HE.nullable HE.unknown) (LBS.toStrict <$> body) <> "::json"
|
||||||
|
|
||||||
-- | Equivalent to "$1::json"
|
singleParameter :: Maybe LBS.ByteString -> ByteString -> SQL.Snippet
|
||||||
-- | TODO: At this stage there shouldn't be a Maybe since ApiRequest should ensure that an INSERT/UPDATE has a body
|
singleParameter body typ =
|
||||||
jsonPlaceHolder :: Maybe BL.ByteString -> H.Snippet
|
if typ == "bytea"
|
||||||
jsonPlaceHolder body =
|
-- TODO: Hasql fails when using HE.unknown with bytea(pg tries to utf8 encode).
|
||||||
H.encoderAndParam (HE.nullable HE.unknown) (toS <$> body) <> "::json"
|
then SQL.encoderAndParam (HE.nullable HE.bytea) (LBS.toStrict <$> body)
|
||||||
|
else SQL.encoderAndParam (HE.nullable HE.unknown) (LBS.toStrict <$> body) <> "::" <> SQL.sql typ
|
||||||
|
|
||||||
selectBody :: SqlFragment
|
selectBody :: SqlFragment
|
||||||
selectBody = "(SELECT val FROM pgrst_body)"
|
selectBody = "(SELECT val FROM pgrst_body)"
|
||||||
|
|
||||||
pgFmtLit :: Text -> SqlFragment
|
-- Here we build the pg array literal, e.g '{"Hebdon, John","Other","Another"}', manually.
|
||||||
pgFmtLit x =
|
-- This is necessary to pass an "unknown" array and let pg infer the type.
|
||||||
let trimmed = trimNullChars x
|
-- There are backslashes here, but since this value is parametrized and is not a string constant
|
||||||
escaped = "'" <> T.replace "'" "''" trimmed <> "'"
|
-- https://www.postgresql.org/docs/current/sql-syntax-lexical.html#SQL-SYNTAX-STRINGS
|
||||||
slashed = T.replace "\\" "\\\\" escaped in
|
-- we don't need to use the E'string' form for C-style escapes
|
||||||
encodeUtf8 $ if "\\" `T.isInfixOf` escaped
|
-- https://www.postgresql.org/docs/current/sql-syntax-lexical.html#SQL-SYNTAX-STRINGS-ESCAPE
|
||||||
then "E" <> slashed
|
pgBuildArrayLiteral :: [Text] -> Text
|
||||||
else slashed
|
pgBuildArrayLiteral vals =
|
||||||
|
let trimmed = trimNullChars
|
||||||
|
slashed = T.replace "\\" "\\\\" . trimmed
|
||||||
|
escaped x = "\"" <> T.replace "\"" "\\\"" (slashed x) <> "\"" in
|
||||||
|
"{" <> T.intercalate "," (escaped <$> vals) <> "}"
|
||||||
|
|
||||||
-- TODO: refactor by following https://github.com/PostgREST/postgrest/pull/1631#issuecomment-711070833
|
-- TODO: refactor by following https://github.com/PostgREST/postgrest/pull/1631#issuecomment-711070833
|
||||||
pgFmtIdent :: Text -> SqlFragment
|
pgFmtIdent :: Text -> SqlFragment
|
||||||
@@ -142,6 +160,14 @@ pgFmtIdent x = encodeUtf8 $ "\"" <> T.replace "\"" "\"\"" (trimNullChars x) <> "
|
|||||||
trimNullChars :: Text -> Text
|
trimNullChars :: Text -> Text
|
||||||
trimNullChars = T.takeWhile (/= '\x0')
|
trimNullChars = T.takeWhile (/= '\x0')
|
||||||
|
|
||||||
|
-- |
|
||||||
|
-- Format a list of identifiers and separate them by commas.
|
||||||
|
--
|
||||||
|
-- >>> pgFmtIdentList ["schema_1", "schema_2", "SPECIAL \"@/\\#~_-"]
|
||||||
|
-- "\"schema_1\", \"schema_2\", \"SPECIAL \"\"@/\\#~_-\""
|
||||||
|
pgFmtIdentList :: [Text] -> SqlFragment
|
||||||
|
pgFmtIdentList schemas = BS.intercalate ", " $ pgFmtIdent <$> schemas
|
||||||
|
|
||||||
asCsvF :: SqlFragment
|
asCsvF :: SqlFragment
|
||||||
asCsvF = asCsvHeaderF <> " || '\n' || " <> asCsvBodyF
|
asCsvF = asCsvHeaderF <> " || '\n' || " <> asCsvBodyF
|
||||||
where
|
where
|
||||||
@@ -161,10 +187,16 @@ asJsonF returnsScalar
|
|||||||
| returnsScalar = "coalesce(json_agg(_postgrest_t.pgrst_scalar), '[]')::character varying"
|
| returnsScalar = "coalesce(json_agg(_postgrest_t.pgrst_scalar), '[]')::character varying"
|
||||||
| otherwise = "coalesce(json_agg(_postgrest_t), '[]')::character varying"
|
| otherwise = "coalesce(json_agg(_postgrest_t), '[]')::character varying"
|
||||||
|
|
||||||
asJsonSingleF :: Bool -> SqlFragment --TODO! unsafe when the query actually returns multiple rows, used only on inserting and returning single element
|
asJsonSingleF :: Bool -> SqlFragment
|
||||||
asJsonSingleF returnsScalar
|
asJsonSingleF returnsScalar
|
||||||
| returnsScalar = "coalesce(string_agg(to_json(_postgrest_t.pgrst_scalar)::text, ','), 'null')::character varying"
|
| returnsScalar = "coalesce((json_agg(_postgrest_t.pgrst_scalar)->0)::text, 'null')"
|
||||||
| otherwise = "coalesce(string_agg(to_json(_postgrest_t)::text, ','), '')::character varying"
|
| otherwise = "coalesce((json_agg(_postgrest_t)->0)::text, 'null')"
|
||||||
|
|
||||||
|
asXmlF :: FieldName -> SqlFragment
|
||||||
|
asXmlF fieldName = "coalesce(xmlagg(_postgrest_t." <> pgFmtIdent fieldName <> "), '')"
|
||||||
|
|
||||||
|
asGeoJsonF :: SqlFragment
|
||||||
|
asGeoJsonF = "json_build_object('type', 'FeatureCollection', 'features', coalesce(json_agg(ST_AsGeoJSON(_postgrest_t)::json), '[]'))"
|
||||||
|
|
||||||
asBinaryF :: FieldName -> SqlFragment
|
asBinaryF :: FieldName -> SqlFragment
|
||||||
asBinaryF fieldName = "coalesce(string_agg(_postgrest_t." <> pgFmtIdent fieldName <> ", ''), '')"
|
asBinaryF fieldName = "coalesce(string_agg(_postgrest_t." <> pgFmtIdent fieldName <> ", ''), '')"
|
||||||
@@ -189,67 +221,80 @@ pgFmtColumn :: QualifiedIdentifier -> Text -> SqlFragment
|
|||||||
pgFmtColumn table "*" = fromQi table <> ".*"
|
pgFmtColumn table "*" = fromQi table <> ".*"
|
||||||
pgFmtColumn table c = fromQi table <> "." <> pgFmtIdent c
|
pgFmtColumn table c = fromQi table <> "." <> pgFmtIdent c
|
||||||
|
|
||||||
pgFmtField :: QualifiedIdentifier -> Field -> H.Snippet
|
pgFmtField :: QualifiedIdentifier -> Field -> SQL.Snippet
|
||||||
pgFmtField table (c, jp) = H.sql (pgFmtColumn table c) <> pgFmtJsonPath jp
|
pgFmtField table (c, []) = SQL.sql (pgFmtColumn table c)
|
||||||
|
-- Using to_jsonb instead of to_json to avoid missing operator errors when filtering:
|
||||||
|
-- "operator does not exist: json = unknown"
|
||||||
|
pgFmtField table (c, jp) = SQL.sql ("to_jsonb(" <> pgFmtColumn table c <> ")") <> pgFmtJsonPath jp
|
||||||
|
|
||||||
pgFmtSelectItem :: QualifiedIdentifier -> SelectItem -> H.Snippet
|
pgFmtSelectItem :: QualifiedIdentifier -> SelectItem -> SQL.Snippet
|
||||||
pgFmtSelectItem table (f@(fName, jp), Nothing, alias, _) = pgFmtField table f <> H.sql (pgFmtAs fName jp alias)
|
pgFmtSelectItem table (f@(fName, jp), Nothing, alias, _, _) = pgFmtField table f <> SQL.sql (pgFmtAs fName jp alias)
|
||||||
-- Ideally we'd quote the cast with "pgFmtIdent cast". However, that would invalidate common casts such as "int", "bigint", etc.
|
-- Ideally we'd quote the cast with "pgFmtIdent cast". However, that would invalidate common casts such as "int", "bigint", etc.
|
||||||
-- Try doing: `select 1::"bigint"` - it'll err, using "int8" will work though. There's some parser magic that pg does that's invalidated when quoting.
|
-- Try doing: `select 1::"bigint"` - it'll err, using "int8" will work though. There's some parser magic that pg does that's invalidated when quoting.
|
||||||
-- Not quoting should be fine, we validate the input on Parsers.
|
-- Not quoting should be fine, we validate the input on Parsers.
|
||||||
pgFmtSelectItem table (f@(fName, jp), Just cast, alias, _) = "CAST (" <> pgFmtField table f <> " AS " <> H.sql (encodeUtf8 cast) <> " )" <> H.sql (pgFmtAs fName jp alias)
|
pgFmtSelectItem table (f@(fName, jp), Just cast, alias, _, _) = "CAST (" <> pgFmtField table f <> " AS " <> SQL.sql (encodeUtf8 cast) <> " )" <> SQL.sql (pgFmtAs fName jp alias)
|
||||||
|
|
||||||
pgFmtOrderTerm :: QualifiedIdentifier -> OrderTerm -> H.Snippet
|
pgFmtOrderTerm :: QualifiedIdentifier -> OrderTerm -> SQL.Snippet
|
||||||
pgFmtOrderTerm qi ot =
|
pgFmtOrderTerm qi ot =
|
||||||
pgFmtField qi (otTerm ot) <> " " <>
|
pgFmtField qi (otTerm ot) <> " " <>
|
||||||
H.sql (BS.unwords [
|
SQL.sql (BS.unwords [
|
||||||
BS.pack $ maybe mempty show $ otDirection ot,
|
maybe mempty direction $ otDirection ot,
|
||||||
BS.pack $ maybe mempty show $ otNullOrder ot])
|
maybe mempty nullOrder $ otNullOrder ot])
|
||||||
|
where
|
||||||
|
direction OrderAsc = "ASC"
|
||||||
|
direction OrderDesc = "DESC"
|
||||||
|
|
||||||
pgFmtFilter :: QualifiedIdentifier -> Filter -> H.Snippet
|
nullOrder OrderNullsFirst = "NULLS FIRST"
|
||||||
|
nullOrder OrderNullsLast = "NULLS LAST"
|
||||||
|
|
||||||
|
|
||||||
|
pgFmtFilter :: QualifiedIdentifier -> Filter -> SQL.Snippet
|
||||||
pgFmtFilter table (Filter fld (OpExpr hasNot oper)) = notOp <> " " <> case oper of
|
pgFmtFilter table (Filter fld (OpExpr hasNot oper)) = notOp <> " " <> case oper of
|
||||||
Op op val -> pgFmtFieldOp op <> " " <> case op of
|
Op op val -> pgFmtFieldOp op <> " " <> case op of
|
||||||
"like" -> unknownLiteral (T.map star val)
|
OpLike -> unknownLiteral (T.map star val)
|
||||||
"ilike" -> unknownLiteral (T.map star val)
|
OpILike -> unknownLiteral (T.map star val)
|
||||||
"is" -> isAllowed val
|
|
||||||
_ -> unknownLiteral val
|
_ -> unknownLiteral val
|
||||||
|
|
||||||
|
-- IS cannot be prepared. `PREPARE boolplan AS SELECT * FROM projects where id IS $1` will give a syntax error.
|
||||||
|
-- The above can be fixed by using `PREPARE boolplan AS SELECT * FROM projects where id IS NOT DISTINCT FROM $1;`
|
||||||
|
-- However that would not accept the TRUE/FALSE/NULL/UNKNOWN keywords. See: https://stackoverflow.com/questions/6133525/proper-way-to-set-preparedstatement-parameter-to-null-under-postgres.
|
||||||
|
-- This is why `IS` operands are whitelisted at the Parsers.hs level
|
||||||
|
Is triVal -> pgFmtField table fld <> " IS " <> case triVal of
|
||||||
|
TriTrue -> "TRUE"
|
||||||
|
TriFalse -> "FALSE"
|
||||||
|
TriNull -> "NULL"
|
||||||
|
TriUnknown -> "UNKNOWN"
|
||||||
|
|
||||||
-- We don't use "IN", we use "= ANY". IN has the following disadvantages:
|
-- We don't use "IN", we use "= ANY". IN has the following disadvantages:
|
||||||
-- + No way to use an empty value on IN: "col IN ()" is invalid syntax. With ANY we can do "= ANY('{}')"
|
-- + No way to use an empty value on IN: "col IN ()" is invalid syntax. With ANY we can do "= ANY('{}')"
|
||||||
-- + Can invalidate prepared statements: multiple parameters on an IN($1, $2, $3) will lead to using different prepared statements and not take advantage of caching.
|
-- + Can invalidate prepared statements: multiple parameters on an IN($1, $2, $3) will lead to using different prepared statements and not take advantage of caching.
|
||||||
In vals -> pgFmtField table fld <> " " <>
|
In vals -> pgFmtField table fld <> " " <> case vals of
|
||||||
case vals of
|
|
||||||
[""] -> "= ANY('{}') "
|
[""] -> "= ANY('{}') "
|
||||||
-- Here we build the pg array, e.g '{"Hebdon, John","Other","Another"}', manually. We quote the values to prevent the "," being treated as an element separator.
|
_ -> "= ANY (" <> unknownLiteral (pgBuildArrayLiteral vals) <> ") "
|
||||||
-- TODO: Ideally this would be done on Hasql with an encoder, but the "array unknown" is not working(Hasql doesn't pass any value).
|
|
||||||
_ -> "= ANY (" <> unknownLiteral ("{" <> T.intercalate "," ((\x -> "\"" <> x <> "\"") <$> vals) <> "}") <> ")"
|
|
||||||
|
|
||||||
Fts op lang val ->
|
Fts op lang val ->
|
||||||
pgFmtFieldOp op <> "(" <> ftsLang lang <> unknownLiteral val <> ") "
|
pgFmtFieldFts op <> "(" <> ftsLang lang <> unknownLiteral val <> ") "
|
||||||
where
|
where
|
||||||
ftsLang = maybe mempty (\l -> unknownLiteral l <> ", ")
|
ftsLang = maybe mempty (\l -> unknownLiteral l <> ", ")
|
||||||
pgFmtFieldOp op = pgFmtField table fld <> " " <> sqlOperator op
|
pgFmtFieldOp op = pgFmtField table fld <> " " <> SQL.sql (singleValOperator op)
|
||||||
sqlOperator o = H.sql $ HM.lookupDefault "=" o operators
|
pgFmtFieldFts op = pgFmtField table fld <> " " <> SQL.sql (ftsOperator op)
|
||||||
notOp = if hasNot then "NOT" else mempty
|
notOp = if hasNot then "NOT" else mempty
|
||||||
star c = if c == '*' then '%' else c
|
star c = if c == '*' then '%' else c
|
||||||
-- IS cannot be prepared. `PREPARE boolplan AS SELECT * FROM projects where id IS $1` will give a syntax error.
|
|
||||||
-- The above can be fixed by using `PREPARE boolplan AS SELECT * FROM projects where id IS NOT DISTINCT FROM $1;`
|
|
||||||
-- However that would not accept the TRUE/FALSE/NULL keywords. See: https://stackoverflow.com/questions/6133525/proper-way-to-set-preparedstatement-parameter-to-null-under-postgres.
|
|
||||||
isAllowed :: Text -> H.Snippet
|
|
||||||
isAllowed v = H.sql $ maybe
|
|
||||||
(pgFmtLit v <> "::unknown") encodeUtf8
|
|
||||||
(find ((==) . T.toLower $ v) ["null","true","false"])
|
|
||||||
|
|
||||||
pgFmtJoinCondition :: JoinCondition -> H.Snippet
|
pgFmtJoinCondition :: JoinCondition -> SQL.Snippet
|
||||||
pgFmtJoinCondition (JoinCondition (qi1, col1) (qi2, col2)) =
|
pgFmtJoinCondition (JoinCondition (qi1, col1) (qi2, col2)) =
|
||||||
H.sql $ pgFmtColumn qi1 col1 <> " = " <> pgFmtColumn qi2 col2
|
SQL.sql $ pgFmtColumn qi1 col1 <> " = " <> pgFmtColumn qi2 col2
|
||||||
|
|
||||||
pgFmtLogicTree :: QualifiedIdentifier -> LogicTree -> H.Snippet
|
pgFmtLogicTree :: QualifiedIdentifier -> LogicTree -> SQL.Snippet
|
||||||
pgFmtLogicTree qi (Expr hasNot op forest) = H.sql notOp <> " (" <> intercalateSnippet (" " <> BS.pack (show op) <> " ") (pgFmtLogicTree qi <$> forest) <> ")"
|
pgFmtLogicTree qi (Expr hasNot op forest) = SQL.sql notOp <> " (" <> intercalateSnippet (opSql op) (pgFmtLogicTree qi <$> forest) <> ")"
|
||||||
where notOp = if hasNot then "NOT" else mempty
|
where
|
||||||
|
notOp = if hasNot then "NOT" else mempty
|
||||||
|
|
||||||
|
opSql And = " AND "
|
||||||
|
opSql Or = " OR "
|
||||||
pgFmtLogicTree qi (Stmnt flt) = pgFmtFilter qi flt
|
pgFmtLogicTree qi (Stmnt flt) = pgFmtFilter qi flt
|
||||||
|
|
||||||
pgFmtJsonPath :: JsonPath -> H.Snippet
|
pgFmtJsonPath :: JsonPath -> SQL.Snippet
|
||||||
pgFmtJsonPath = \case
|
pgFmtJsonPath = \case
|
||||||
[] -> mempty
|
[] -> mempty
|
||||||
(JArrow x:xs) -> "->" <> pgFmtJsonOperand x <> pgFmtJsonPath xs
|
(JArrow x:xs) -> "->" <> pgFmtJsonOperand x <> pgFmtJsonPath xs
|
||||||
@@ -270,7 +315,7 @@ pgFmtAs fName jp Nothing = case jOp <$> lastMay jp of
|
|||||||
Nothing -> mempty
|
Nothing -> mempty
|
||||||
pgFmtAs _ _ (Just alias) = " AS " <> pgFmtIdent alias
|
pgFmtAs _ _ (Just alias) = " AS " <> pgFmtIdent alias
|
||||||
|
|
||||||
countF :: H.Snippet -> Bool -> (H.Snippet, SqlFragment)
|
countF :: SQL.Snippet -> Bool -> (SQL.Snippet, SqlFragment)
|
||||||
countF countQuery shouldCount =
|
countF countQuery shouldCount =
|
||||||
if shouldCount
|
if shouldCount
|
||||||
then (
|
then (
|
||||||
@@ -286,37 +331,58 @@ returningF qi returnings =
|
|||||||
then "RETURNING 1" -- For mutation cases where there's no ?select, we return 1 to know how many rows were modified
|
then "RETURNING 1" -- For mutation cases where there's no ?select, we return 1 to know how many rows were modified
|
||||||
else "RETURNING " <> BS.intercalate ", " (pgFmtColumn qi <$> returnings)
|
else "RETURNING " <> BS.intercalate ", " (pgFmtColumn qi <$> returnings)
|
||||||
|
|
||||||
limitOffsetF :: NonnegRange -> H.Snippet
|
limitOffsetF :: NonnegRange -> SQL.Snippet
|
||||||
limitOffsetF range =
|
limitOffsetF range =
|
||||||
if range == allRange then mempty else "LIMIT " <> limit <> " OFFSET " <> offset
|
if range == allRange then mempty else "LIMIT " <> limit <> " OFFSET " <> offset
|
||||||
where
|
where
|
||||||
limit = maybe "ALL" (\l -> unknownEncoder (BS.pack $ show l)) $ rangeLimit range
|
limit = maybe "ALL" (\l -> unknownEncoder (BS.pack $ show l)) $ rangeLimit range
|
||||||
offset = unknownEncoder (BS.pack . show $ rangeOffset range)
|
offset = unknownEncoder (BS.pack . show $ rangeOffset range)
|
||||||
|
|
||||||
responseHeadersF :: PgVersion -> SqlFragment
|
responseHeadersF :: SqlFragment
|
||||||
responseHeadersF pgVer =
|
responseHeadersF = currentSettingF "response.headers"
|
||||||
if pgVer >= pgVersion96
|
|
||||||
then currentSettingF "response.headers"
|
|
||||||
else "null"
|
|
||||||
|
|
||||||
responseStatusF :: PgVersion -> SqlFragment
|
responseStatusF :: SqlFragment
|
||||||
responseStatusF pgVer =
|
responseStatusF = currentSettingF "response.status"
|
||||||
if pgVer >= pgVersion96
|
|
||||||
then currentSettingF "response.status"
|
|
||||||
else "null"
|
|
||||||
|
|
||||||
currentSettingF :: Text -> SqlFragment
|
currentSettingF :: SqlFragment -> SqlFragment
|
||||||
currentSettingF setting =
|
currentSettingF setting =
|
||||||
-- nullif is used because of https://gist.github.com/steve-chavez/8d7033ea5655096903f3b52f8ed09a15
|
-- nullif is used because of https://gist.github.com/steve-chavez/8d7033ea5655096903f3b52f8ed09a15
|
||||||
"nullif(current_setting(" <> pgFmtLit setting <> ", true), '')"
|
"nullif(current_setting('" <> setting <> "', true), '')"
|
||||||
|
|
||||||
|
mutRangeF :: QualifiedIdentifier -> [FieldName] -> (SqlFragment, SqlFragment)
|
||||||
|
mutRangeF mainQi rangeId =
|
||||||
|
(
|
||||||
|
BS.intercalate " AND " $ (\col -> pgFmtColumn mainQi col <> " = " <> pgFmtColumn (QualifiedIdentifier mempty "pgrst_affected_rows") col) <$> rangeId
|
||||||
|
, BS.intercalate ", " (pgFmtColumn mainQi <$> rangeId)
|
||||||
|
)
|
||||||
|
|
||||||
|
orderF :: QualifiedIdentifier -> [OrderTerm] -> SQL.Snippet
|
||||||
|
orderF _ [] = mempty
|
||||||
|
orderF qi ordts = "ORDER BY " <> intercalateSnippet ", " (pgFmtOrderTerm qi <$> ordts)
|
||||||
|
|
||||||
-- Hasql Snippet utilities
|
-- Hasql Snippet utilities
|
||||||
unknownEncoder :: ByteString -> H.Snippet
|
unknownEncoder :: ByteString -> SQL.Snippet
|
||||||
unknownEncoder = H.encoderAndParam (HE.nonNullable HE.unknown)
|
unknownEncoder = SQL.encoderAndParam (HE.nonNullable HE.unknown)
|
||||||
|
|
||||||
unknownLiteral :: Text -> H.Snippet
|
unknownLiteral :: Text -> SQL.Snippet
|
||||||
unknownLiteral = unknownEncoder . encodeUtf8
|
unknownLiteral = unknownEncoder . encodeUtf8
|
||||||
|
|
||||||
intercalateSnippet :: ByteString -> [H.Snippet] -> H.Snippet
|
intercalateSnippet :: ByteString -> [SQL.Snippet] -> SQL.Snippet
|
||||||
intercalateSnippet _ [] = mempty
|
intercalateSnippet _ [] = mempty
|
||||||
intercalateSnippet frag snippets = foldr1 (\a b -> a <> H.sql frag <> b) snippets
|
intercalateSnippet frag snippets = foldr1 (\a b -> a <> SQL.sql frag <> b) snippets
|
||||||
|
|
||||||
|
explainF :: MTPlanFormat -> [MTPlanOption] -> SQL.Snippet -> SQL.Snippet
|
||||||
|
explainF fmt opts snip =
|
||||||
|
"EXPLAIN (" <>
|
||||||
|
SQL.sql (BS.intercalate ", " (fmtPlanFmt fmt : (fmtPlanOpt <$> opts))) <>
|
||||||
|
") " <> snip
|
||||||
|
where
|
||||||
|
fmtPlanOpt :: MTPlanOption -> BS.ByteString
|
||||||
|
fmtPlanOpt PlanAnalyze = "ANALYZE"
|
||||||
|
fmtPlanOpt PlanVerbose = "VERBOSE"
|
||||||
|
fmtPlanOpt PlanSettings = "SETTINGS"
|
||||||
|
fmtPlanOpt PlanBuffers = "BUFFERS"
|
||||||
|
fmtPlanOpt PlanWAL = "WAL"
|
||||||
|
|
||||||
|
fmtPlanFmt PlanJSON = "FORMAT JSON"
|
||||||
|
fmtPlanFmt PlanText = "FORMAT TEXT"
|
||||||
|
|||||||
+120
-106
@@ -6,67 +6,82 @@ This module constructs single SQL statements that can be parametrized and prepar
|
|||||||
|
|
||||||
- It consumes the SqlQuery types generated by the QueryBuilder module.
|
- It consumes the SqlQuery types generated by the QueryBuilder module.
|
||||||
- It generates the body format and some headers of the final HTTP response.
|
- It generates the body format and some headers of the final HTTP response.
|
||||||
|
|
||||||
TODO: Currently, createReadStatement is not using prepared statements. See https://github.com/PostgREST/postgrest/issues/718.
|
|
||||||
-}
|
-}
|
||||||
module PostgREST.Query.Statements
|
module PostgREST.Query.Statements
|
||||||
( createWriteStatement
|
( prepareWrite
|
||||||
, createReadStatement
|
, prepareRead
|
||||||
, callProcStatement
|
, prepareCall
|
||||||
, createExplainStatement
|
, preparePlanRows
|
||||||
|
, ResultSet (..)
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import qualified Data.Aeson as JSON
|
import qualified Data.Aeson as JSON
|
||||||
import qualified Data.Aeson.Lens as L
|
import qualified Data.Aeson.Lens as L
|
||||||
import qualified Data.ByteString.Char8 as BS
|
import qualified Data.ByteString.Char8 as BS
|
||||||
|
import qualified Data.ByteString.Lazy as LBS
|
||||||
import qualified Hasql.Decoders as HD
|
import qualified Hasql.Decoders as HD
|
||||||
import qualified Hasql.DynamicStatements.Snippet as H
|
import qualified Hasql.DynamicStatements.Snippet as SQL
|
||||||
import qualified Hasql.DynamicStatements.Statement as H
|
import qualified Hasql.DynamicStatements.Statement as SQL
|
||||||
import qualified Hasql.Statement as H
|
import qualified Hasql.Statement as SQL
|
||||||
|
|
||||||
import Control.Lens ((^?))
|
import Control.Lens ((^?))
|
||||||
import Data.Maybe (fromJust)
|
import Data.Maybe (fromJust)
|
||||||
import Data.Text.Read (decimal)
|
import Data.Text.Read (decimal)
|
||||||
import Network.HTTP.Types.Status (Status)
|
import Network.HTTP.Types.Status (Status)
|
||||||
|
|
||||||
import PostgREST.Config.PgVersion (PgVersion)
|
import PostgREST.Error (Error (..))
|
||||||
import PostgREST.Error (Error (..))
|
import PostgREST.GucHeader (GucHeader)
|
||||||
import PostgREST.GucHeader (GucHeader)
|
|
||||||
|
|
||||||
import PostgREST.DbStructure.Identifiers (FieldName)
|
import PostgREST.DbStructure.Identifiers (FieldName)
|
||||||
|
import PostgREST.MediaType (MTPlanAttrs (..),
|
||||||
|
MTPlanFormat (..),
|
||||||
|
MediaType (..),
|
||||||
|
getMediaType)
|
||||||
import PostgREST.Query.SqlFragment
|
import PostgREST.Query.SqlFragment
|
||||||
import PostgREST.Request.Preferences
|
import PostgREST.Request.Preferences
|
||||||
|
|
||||||
import Protolude hiding (toS)
|
import Protolude
|
||||||
import Protolude.Conv (toS)
|
|
||||||
|
|
||||||
{-| The generic query result format used by API responses. The location header
|
-- | Standard result set format used for all queries
|
||||||
is represented as a list of strings containing variable bindings like
|
data ResultSet
|
||||||
@"k1=eq.42"@, or the empty list if there is no location header.
|
= RSStandard
|
||||||
-}
|
{ rsTableTotal :: Maybe Int64
|
||||||
type ResultsWithCount = (Maybe Int64, Int64, [BS.ByteString], BS.ByteString, Either Error [GucHeader], Either Error (Maybe Status))
|
-- ^ count of all the table rows
|
||||||
|
, rsQueryTotal :: Int64
|
||||||
|
-- ^ count of the query rows
|
||||||
|
, rsLocation :: [(BS.ByteString, BS.ByteString)]
|
||||||
|
-- ^ The Location header(only used for inserts) is represented as a list of strings containing
|
||||||
|
-- variable bindings like @"k1=eq.42"@, or the empty list if there is no location header.
|
||||||
|
, rsBody :: BS.ByteString
|
||||||
|
-- ^ the aggregated body of the query
|
||||||
|
, rsGucHeaders :: Either Error [GucHeader]
|
||||||
|
-- ^ the HTTP headers to be added to the response
|
||||||
|
, rsGucStatus :: Either Error (Maybe Status)
|
||||||
|
-- ^ the HTTP status to be added to the response
|
||||||
|
}
|
||||||
|
| RSPlan BS.ByteString -- ^ the plan of the query
|
||||||
|
|
||||||
createWriteStatement :: H.Snippet -> H.Snippet -> Bool -> Bool -> Bool ->
|
|
||||||
PreferRepresentation -> [Text] -> PgVersion -> Bool ->
|
prepareWrite :: SQL.Snippet -> SQL.Snippet -> Bool -> MediaType ->
|
||||||
H.Statement () ResultsWithCount
|
PreferRepresentation -> [Text] -> Bool -> SQL.Statement () ResultSet
|
||||||
createWriteStatement selectQuery mutateQuery wantSingle isInsert asCsv rep pKeys pgVer =
|
prepareWrite selectQuery mutateQuery isInsert mt rep pKeys =
|
||||||
H.dynamicallyParameterized snippet decodeStandard
|
SQL.dynamicallyParameterized (mtSnippet mt snippet) decodeIt
|
||||||
where
|
where
|
||||||
snippet =
|
snippet =
|
||||||
"WITH " <> H.sql sourceCTEName <> " AS (" <> mutateQuery <> ") " <>
|
"WITH " <> SQL.sql sourceCTEName <> " AS (" <> mutateQuery <> ") " <>
|
||||||
H.sql (
|
SQL.sql (
|
||||||
"SELECT " <>
|
"SELECT " <>
|
||||||
"'' AS total_result_set, " <>
|
"'' AS total_result_set, " <>
|
||||||
"pg_catalog.count(_postgrest_t) AS page_total, " <>
|
"pg_catalog.count(_postgrest_t) AS page_total, " <>
|
||||||
locF <> " AS header, " <>
|
locF <> " AS header, " <>
|
||||||
bodyF <> " AS body, " <>
|
bodyF <> " AS body, " <>
|
||||||
responseHeadersF pgVer <> " AS response_headers, " <>
|
responseHeadersF <> " AS response_headers, " <>
|
||||||
responseStatusF pgVer <> " AS response_status "
|
responseStatusF <> " AS response_status "
|
||||||
) <>
|
) <>
|
||||||
"FROM (" <> selectF <> ") _postgrest_t"
|
"FROM (" <> selectF <> ") _postgrest_t"
|
||||||
|
|
||||||
locF =
|
locF =
|
||||||
if isInsert && rep `elem` [Full, HeadersOnly]
|
if isInsert && rep == HeadersOnly
|
||||||
then BS.unwords [
|
then BS.unwords [
|
||||||
"CASE WHEN pg_catalog.count(_postgrest_t) = 1",
|
"CASE WHEN pg_catalog.count(_postgrest_t) = 1",
|
||||||
"THEN coalesce(" <> locationF pKeys <> ", " <> noLocationF <> ")",
|
"THEN coalesce(" <> locationF pKeys <> ", " <> noLocationF <> ")",
|
||||||
@@ -75,121 +90,120 @@ createWriteStatement selectQuery mutateQuery wantSingle isInsert asCsv rep pKeys
|
|||||||
else noLocationF
|
else noLocationF
|
||||||
|
|
||||||
bodyF
|
bodyF
|
||||||
| rep `elem` [None, HeadersOnly] = "''"
|
| rep /= Full = "''"
|
||||||
| asCsv = asCsvF
|
| getMediaType mt == MTTextCSV = asCsvF
|
||||||
| wantSingle = asJsonSingleF False
|
| getMediaType mt == MTGeoJSON = asGeoJsonF
|
||||||
| otherwise = asJsonF False
|
| getMediaType mt == MTSingularJSON = asJsonSingleF False
|
||||||
|
| otherwise = asJsonF False
|
||||||
|
|
||||||
selectF
|
selectF
|
||||||
-- prevent using any of the column names in ?select= when no response is returned from the CTE
|
-- prevent using any of the column names in ?select= when no response is returned from the CTE
|
||||||
| rep `elem` [None, HeadersOnly] = H.sql ("SELECT * FROM " <> sourceCTEName)
|
| rep /= Full = SQL.sql ("SELECT * FROM " <> sourceCTEName)
|
||||||
| otherwise = selectQuery
|
| otherwise = selectQuery
|
||||||
|
|
||||||
decodeStandard :: HD.Result ResultsWithCount
|
decodeIt :: HD.Result ResultSet
|
||||||
decodeStandard =
|
decodeIt = case mt of
|
||||||
fromMaybe (Nothing, 0, [], mempty, Right [], Right Nothing) <$> HD.rowMaybe standardRow
|
MTPlan{} -> planRow
|
||||||
|
_ -> fromMaybe (RSStandard Nothing 0 mempty mempty (Right []) (Right Nothing)) <$> HD.rowMaybe (standardRow False)
|
||||||
|
|
||||||
createReadStatement :: H.Snippet -> H.Snippet -> Bool -> Bool -> Bool -> Maybe FieldName -> PgVersion -> Bool ->
|
prepareRead :: SQL.Snippet -> SQL.Snippet -> Bool -> MediaType -> Maybe FieldName -> Bool -> SQL.Statement () ResultSet
|
||||||
H.Statement () ResultsWithCount
|
prepareRead selectQuery countQuery countTotal mt binaryField =
|
||||||
createReadStatement selectQuery countQuery isSingle countTotal asCsv binaryField pgVer =
|
SQL.dynamicallyParameterized (mtSnippet mt snippet) decodeIt
|
||||||
H.dynamicallyParameterized snippet decodeStandard
|
|
||||||
where
|
where
|
||||||
snippet =
|
snippet =
|
||||||
"WITH " <>
|
"WITH " <>
|
||||||
H.sql sourceCTEName <> " AS ( " <> selectQuery <> " ) " <>
|
SQL.sql sourceCTEName <> " AS ( " <> selectQuery <> " ) " <>
|
||||||
countCTEF <> " " <>
|
countCTEF <> " " <>
|
||||||
H.sql ("SELECT " <>
|
SQL.sql ("SELECT " <>
|
||||||
countResultF <> " AS total_result_set, " <>
|
countResultF <> " AS total_result_set, " <>
|
||||||
"pg_catalog.count(_postgrest_t) AS page_total, " <>
|
"pg_catalog.count(_postgrest_t) AS page_total, " <>
|
||||||
noLocationF <> " AS header, " <>
|
|
||||||
bodyF <> " AS body, " <>
|
bodyF <> " AS body, " <>
|
||||||
responseHeadersF pgVer <> " AS response_headers, " <>
|
responseHeadersF <> " AS response_headers, " <>
|
||||||
responseStatusF pgVer <> " AS response_status " <>
|
responseStatusF <> " AS response_status " <>
|
||||||
"FROM ( SELECT * FROM " <> sourceCTEName <> " ) _postgrest_t")
|
"FROM ( SELECT * FROM " <> sourceCTEName <> " ) _postgrest_t")
|
||||||
|
|
||||||
(countCTEF, countResultF) = countF countQuery countTotal
|
(countCTEF, countResultF) = countF countQuery countTotal
|
||||||
|
|
||||||
bodyF
|
bodyF
|
||||||
| asCsv = asCsvF
|
| getMediaType mt == MTTextCSV = asCsvF
|
||||||
| isSingle = asJsonSingleF False
|
| getMediaType mt == MTSingularJSON = asJsonSingleF False
|
||||||
| isJust binaryField = asBinaryF $ fromJust binaryField
|
| getMediaType mt == MTGeoJSON = asGeoJsonF
|
||||||
| otherwise = asJsonF False
|
| isJust binaryField && getMediaType mt == MTTextXML = asXmlF $ fromJust binaryField
|
||||||
|
| isJust binaryField = asBinaryF $ fromJust binaryField
|
||||||
|
| otherwise = asJsonF False
|
||||||
|
|
||||||
decodeStandard :: HD.Result ResultsWithCount
|
decodeIt :: HD.Result ResultSet
|
||||||
decodeStandard =
|
decodeIt = case mt of
|
||||||
HD.singleRow standardRow
|
MTPlan{} -> planRow
|
||||||
|
_ -> HD.singleRow $ standardRow True
|
||||||
|
|
||||||
{-| Read and Write api requests use a similar response format which includes
|
prepareCall :: Bool -> Bool -> SQL.Snippet -> SQL.Snippet -> SQL.Snippet -> Bool ->
|
||||||
various record counts and possible location header. This is the decoder
|
MediaType -> Bool -> Maybe FieldName -> Bool ->
|
||||||
for that common type of query.
|
SQL.Statement () ResultSet
|
||||||
-}
|
prepareCall returnsScalar returnsSingle callProcQuery selectQuery countQuery countTotal mt multObjects binaryField =
|
||||||
standardRow :: HD.Row ResultsWithCount
|
SQL.dynamicallyParameterized (mtSnippet mt snippet) decodeIt
|
||||||
standardRow = (,,,,,) <$> nullableColumn HD.int8 <*> column HD.int8
|
|
||||||
<*> arrayColumn HD.bytea <*> column HD.bytea
|
|
||||||
<*> (fromMaybe (Right []) <$> nullableColumn decodeGucHeaders)
|
|
||||||
<*> (fromMaybe (Right Nothing) <$> nullableColumn decodeGucStatus)
|
|
||||||
|
|
||||||
type ProcResults = (Maybe Int64, Int64, ByteString, Either Error [GucHeader], Either Error (Maybe Status))
|
|
||||||
|
|
||||||
callProcStatement :: Bool -> Bool -> H.Snippet -> H.Snippet -> H.Snippet -> Bool ->
|
|
||||||
Bool -> Bool -> Bool -> Maybe FieldName -> PgVersion -> Bool ->
|
|
||||||
H.Statement () ProcResults
|
|
||||||
callProcStatement returnsScalar returnsSingle callProcQuery selectQuery countQuery countTotal asSingle asCsv multObjects binaryField pgVer =
|
|
||||||
H.dynamicallyParameterized snippet decodeProc
|
|
||||||
where
|
where
|
||||||
snippet =
|
snippet =
|
||||||
"WITH " <> H.sql sourceCTEName <> " AS (" <> callProcQuery <> ") " <>
|
"WITH " <> SQL.sql sourceCTEName <> " AS (" <> callProcQuery <> ") " <>
|
||||||
countCTEF <>
|
countCTEF <>
|
||||||
H.sql (
|
SQL.sql (
|
||||||
"SELECT " <>
|
"SELECT " <>
|
||||||
countResultF <> " AS total_result_set, " <>
|
countResultF <> " AS total_result_set, " <>
|
||||||
"pg_catalog.count(_postgrest_t) AS page_total, " <>
|
"pg_catalog.count(_postgrest_t) AS page_total, " <>
|
||||||
bodyF <> " AS body, " <>
|
bodyF <> " AS body, " <>
|
||||||
responseHeadersF pgVer <> " AS response_headers, " <>
|
responseHeadersF <> " AS response_headers, " <>
|
||||||
responseStatusF pgVer <> " AS response_status ") <>
|
responseStatusF <> " AS response_status ") <>
|
||||||
"FROM (" <> selectQuery <> ") _postgrest_t"
|
"FROM (" <> selectQuery <> ") _postgrest_t"
|
||||||
|
|
||||||
(countCTEF, countResultF) = countF countQuery countTotal
|
(countCTEF, countResultF) = countF countQuery countTotal
|
||||||
|
|
||||||
bodyF
|
bodyF
|
||||||
| asSingle = asJsonSingleF returnsScalar
|
| getMediaType mt == MTSingularJSON = asJsonSingleF returnsScalar
|
||||||
| asCsv = asCsvF
|
| getMediaType mt == MTTextCSV = asCsvF
|
||||||
| isJust binaryField = asBinaryF $ fromJust binaryField
|
| getMediaType mt == MTGeoJSON = asGeoJsonF
|
||||||
| returnsSingle
|
| isJust binaryField && getMediaType mt == MTTextXML = asXmlF $ fromJust binaryField
|
||||||
&& not multObjects = asJsonSingleF returnsScalar
|
| isJust binaryField = asBinaryF $ fromJust binaryField
|
||||||
| otherwise = asJsonF returnsScalar
|
| returnsSingle && not multObjects = asJsonSingleF returnsScalar
|
||||||
|
| otherwise = asJsonF returnsScalar
|
||||||
|
|
||||||
decodeProc :: HD.Result ProcResults
|
decodeIt :: HD.Result ResultSet
|
||||||
decodeProc =
|
decodeIt = case mt of
|
||||||
fromMaybe (Just 0, 0, mempty, defGucHeaders, defGucStatus) <$> HD.rowMaybe procRow
|
MTPlan{} -> planRow
|
||||||
where
|
_ -> fromMaybe (RSStandard (Just 0) 0 mempty mempty (Right []) (Right Nothing)) <$> HD.rowMaybe (standardRow True)
|
||||||
defGucHeaders = Right []
|
|
||||||
defGucStatus = Right Nothing
|
|
||||||
procRow = (,,,,) <$> nullableColumn HD.int8 <*> column HD.int8
|
|
||||||
<*> column HD.bytea
|
|
||||||
<*> (fromMaybe defGucHeaders <$> nullableColumn decodeGucHeaders)
|
|
||||||
<*> (fromMaybe defGucStatus <$> nullableColumn decodeGucStatus)
|
|
||||||
|
|
||||||
createExplainStatement :: H.Snippet -> Bool -> H.Statement () (Maybe Int64)
|
preparePlanRows :: SQL.Snippet -> Bool -> SQL.Statement () (Maybe Int64)
|
||||||
createExplainStatement countQuery =
|
preparePlanRows countQuery =
|
||||||
H.dynamicallyParameterized snippet decodeExplain
|
SQL.dynamicallyParameterized snippet decodeIt
|
||||||
where
|
where
|
||||||
snippet = "EXPLAIN (FORMAT JSON) " <> countQuery
|
snippet = explainF PlanJSON mempty countQuery
|
||||||
-- |
|
decodeIt :: HD.Result (Maybe Int64)
|
||||||
-- An `EXPLAIN (FORMAT JSON) select * from items;` output looks like this:
|
decodeIt =
|
||||||
-- [{
|
|
||||||
-- "Plan": {
|
|
||||||
-- "Node Type": "Seq Scan", "Parallel Aware": false, "Relation Name": "items",
|
|
||||||
-- "Alias": "items", "Startup Cost": 0.00, "Total Cost": 32.60,
|
|
||||||
-- "Plan Rows": 2260,"Plan Width": 8} }]
|
|
||||||
-- We only obtain the Plan Rows here.
|
|
||||||
decodeExplain :: HD.Result (Maybe Int64)
|
|
||||||
decodeExplain =
|
|
||||||
let row = HD.singleRow $ column HD.bytea in
|
let row = HD.singleRow $ column HD.bytea in
|
||||||
(^? L.nth 0 . L.key "Plan" . L.key "Plan Rows" . L._Integral) <$> row
|
(^? L.nth 0 . L.key "Plan" . L.key "Plan Rows" . L._Integral) <$> row
|
||||||
|
|
||||||
|
standardRow :: Bool -> HD.Row ResultSet
|
||||||
|
standardRow noLocation =
|
||||||
|
RSStandard <$> nullableColumn HD.int8 <*> column HD.int8
|
||||||
|
<*> (if noLocation then pure mempty else fmap splitKeyValue <$> arrayColumn HD.bytea) <*> column HD.bytea
|
||||||
|
<*> (fromMaybe (Right []) <$> nullableColumn decodeGucHeaders)
|
||||||
|
<*> (fromMaybe (Right Nothing) <$> nullableColumn decodeGucStatus)
|
||||||
|
where
|
||||||
|
splitKeyValue :: ByteString -> (ByteString, ByteString)
|
||||||
|
splitKeyValue kv =
|
||||||
|
let (k, v) = BS.break (== '=') kv in
|
||||||
|
(k, BS.tail v)
|
||||||
|
|
||||||
|
mtSnippet :: MediaType -> SQL.Snippet -> SQL.Snippet
|
||||||
|
mtSnippet mediaType snippet = case mediaType of
|
||||||
|
MTPlan (MTPlanAttrs _ fmt opts) -> explainF fmt opts snippet
|
||||||
|
_ -> snippet
|
||||||
|
|
||||||
|
-- | We use rowList because when doing EXPLAIN (FORMAT TEXT), the result comes as many rows. FORMAT JSON comes as one.
|
||||||
|
planRow :: HD.Result ResultSet
|
||||||
|
planRow = RSPlan . BS.unlines <$> HD.rowList (column HD.bytea)
|
||||||
|
|
||||||
decodeGucHeaders :: HD.Value (Either Error [GucHeader])
|
decodeGucHeaders :: HD.Value (Either Error [GucHeader])
|
||||||
decodeGucHeaders = first (const GucHeadersError) . JSON.eitherDecode . toS <$> HD.bytea
|
decodeGucHeaders = first (const GucHeadersError) . JSON.eitherDecode . LBS.fromStrict <$> HD.bytea
|
||||||
|
|
||||||
decodeGucStatus :: HD.Value (Either Error (Maybe Status))
|
decodeGucStatus :: HD.Value (Either Error (Maybe Status))
|
||||||
decodeGucStatus = first (const GucStatusError) . fmap (Just . toEnum . fst) . decimal <$> HD.text
|
decodeGucStatus = first (const GucStatusError) . fmap (Just . toEnum . fst) . decimal <$> HD.text
|
||||||
|
|||||||
@@ -10,6 +10,8 @@ module PostgREST.RangeQuery (
|
|||||||
, restrictRange
|
, restrictRange
|
||||||
, rangeGeq
|
, rangeGeq
|
||||||
, allRange
|
, allRange
|
||||||
|
, limitZeroRange
|
||||||
|
, hasLimitZero
|
||||||
, NonnegRange
|
, NonnegRange
|
||||||
, rangeStatusHeader
|
, rangeStatusHeader
|
||||||
, contentRangeH
|
, contentRangeH
|
||||||
@@ -26,8 +28,7 @@ import Data.Ranged.Ranges
|
|||||||
import Network.HTTP.Types.Header
|
import Network.HTTP.Types.Header
|
||||||
import Network.HTTP.Types.Status
|
import Network.HTTP.Types.Status
|
||||||
|
|
||||||
import Protolude hiding (toS)
|
import Protolude
|
||||||
import Protolude.Conv (toS)
|
|
||||||
|
|
||||||
type NonnegRange = Range Integer
|
type NonnegRange = Range Integer
|
||||||
|
|
||||||
@@ -35,13 +36,14 @@ rangeParse :: BS.ByteString -> NonnegRange
|
|||||||
rangeParse range = do
|
rangeParse range = do
|
||||||
let rangeRegex = "^([0-9]+)-([0-9]*)$" :: BS.ByteString
|
let rangeRegex = "^([0-9]+)-([0-9]*)$" :: BS.ByteString
|
||||||
|
|
||||||
case listToMaybe (range =~ rangeRegex :: [[BS.ByteString]]) of
|
case range =~ rangeRegex :: [[BS.ByteString]] of
|
||||||
Just parsedRange ->
|
[[_, l, u]] ->
|
||||||
let [_, mLower, mUpper] = readMaybe . toS <$> parsedRange
|
let lower = maybe emptyRange rangeGeq (readInteger l)
|
||||||
lower = maybe emptyRange rangeGeq mLower
|
upper = maybe allRange rangeLeq (readInteger u) in
|
||||||
upper = maybe allRange rangeLeq mUpper in
|
|
||||||
rangeIntersection lower upper
|
rangeIntersection lower upper
|
||||||
Nothing -> allRange
|
_ -> allRange
|
||||||
|
where
|
||||||
|
readInteger = readMaybe . BS.unpack
|
||||||
|
|
||||||
rangeRequested :: RequestHeaders -> NonnegRange
|
rangeRequested :: RequestHeaders -> NonnegRange
|
||||||
rangeRequested headers = maybe allRange rangeParse $ lookup hRange headers
|
rangeRequested headers = maybe allRange rangeParse $ lookup hRange headers
|
||||||
@@ -75,6 +77,15 @@ rangeLeq :: Integer -> NonnegRange
|
|||||||
rangeLeq n =
|
rangeLeq n =
|
||||||
Range BoundaryBelowAll (BoundaryAbove n)
|
Range BoundaryBelowAll (BoundaryAbove n)
|
||||||
|
|
||||||
|
-- Special case to allow limit 0 queries
|
||||||
|
-- https://github.com/PostgREST/postgrest/issues/1121
|
||||||
|
-- 0 <= x <= -1
|
||||||
|
limitZeroRange :: Range Integer
|
||||||
|
limitZeroRange = Range (BoundaryBelow 0) (BoundaryAbove (-1))
|
||||||
|
|
||||||
|
hasLimitZero :: Range Integer -> Bool
|
||||||
|
hasLimitZero r = rangeUpper r == rangeUpper limitZeroRange
|
||||||
|
|
||||||
rangeStatusHeader :: NonnegRange -> Int64 -> Maybe Int64 -> (Status, Header)
|
rangeStatusHeader :: NonnegRange -> Int64 -> Maybe Int64 -> (Status, Header)
|
||||||
rangeStatusHeader topLevelRange queryTotal tableTotal =
|
rangeStatusHeader topLevelRange queryTotal tableTotal =
|
||||||
let lower = rangeOffset topLevelRange
|
let lower = rangeOffset topLevelRange
|
||||||
|
|||||||
+276
-304
@@ -3,113 +3,115 @@ Module : PostgREST.Request.ApiRequest
|
|||||||
Description : PostgREST functions to translate HTTP request to a domain type called ApiRequest.
|
Description : PostgREST functions to translate HTTP request to a domain type called ApiRequest.
|
||||||
-}
|
-}
|
||||||
{-# LANGUAGE LambdaCase #-}
|
{-# LANGUAGE LambdaCase #-}
|
||||||
{-# LANGUAGE MultiWayIf #-}
|
|
||||||
{-# LANGUAGE NamedFieldPuns #-}
|
{-# LANGUAGE NamedFieldPuns #-}
|
||||||
{-# LANGUAGE RecordWildCards #-}
|
{-# LANGUAGE RecordWildCards #-}
|
||||||
|
|
||||||
module PostgREST.Request.ApiRequest
|
module PostgREST.Request.ApiRequest
|
||||||
( ApiRequest(..)
|
( ApiRequest(..)
|
||||||
, InvokeMethod(..)
|
, InvokeMethod(..)
|
||||||
, ContentType(..)
|
, Mutation(..)
|
||||||
|
, MediaType(..)
|
||||||
, Action(..)
|
, Action(..)
|
||||||
, Target(..)
|
, Target(..)
|
||||||
, PayloadJSON(..)
|
, Payload(..)
|
||||||
, userApiRequest
|
, userApiRequest
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import qualified Data.Aeson as JSON
|
import qualified Data.Aeson as JSON
|
||||||
import qualified Data.ByteString as BS
|
import qualified Data.Aeson.Key as K
|
||||||
import qualified Data.ByteString.Lazy as BL
|
import qualified Data.Aeson.KeyMap as KM
|
||||||
import qualified Data.CaseInsensitive as CI
|
import qualified Data.ByteString.Char8 as BS
|
||||||
import qualified Data.Csv as CSV
|
import qualified Data.ByteString.Lazy as LBS
|
||||||
import qualified Data.HashMap.Strict as M
|
import qualified Data.CaseInsensitive as CI
|
||||||
import qualified Data.List as L
|
import qualified Data.Csv as CSV
|
||||||
import qualified Data.Set as S
|
import qualified Data.HashMap.Strict as HM
|
||||||
import qualified Data.Text as T
|
import qualified Data.List as L
|
||||||
import qualified Data.Vector as V
|
import qualified Data.List.NonEmpty as NonEmptyList
|
||||||
|
import qualified Data.Map.Strict as M
|
||||||
|
import qualified Data.Set as S
|
||||||
|
import qualified Data.Text.Encoding as T
|
||||||
|
import qualified Data.Vector as V
|
||||||
|
|
||||||
import Control.Arrow ((***))
|
import Control.Arrow ((***))
|
||||||
import Data.Aeson.Types (emptyArray, emptyObject)
|
import Data.Aeson.Types (emptyArray, emptyObject)
|
||||||
import Data.List (last, lookup, partition, union)
|
import Data.List (lookup, union)
|
||||||
import Data.List.NonEmpty (head)
|
|
||||||
import Data.Maybe (fromJust)
|
import Data.Maybe (fromJust)
|
||||||
import Data.Ranged.Boundaries (Boundary (..))
|
import Data.Ranged.Ranges (emptyRange, rangeIntersection)
|
||||||
import Data.Ranged.Ranges (Range (..), emptyRange,
|
import Network.HTTP.Types.Header (hCookie)
|
||||||
rangeIntersection)
|
import Network.HTTP.Types.URI (parseSimpleQuery)
|
||||||
import Network.HTTP.Base (urlEncodeVars)
|
|
||||||
import Network.HTTP.Types.Header (hAuthorization, hCookie)
|
|
||||||
import Network.HTTP.Types.URI (parseQueryReplacePlus,
|
|
||||||
parseSimpleQuery)
|
|
||||||
import Network.Wai (Request (..))
|
import Network.Wai (Request (..))
|
||||||
import Network.Wai.Parse (parseHttpAccept)
|
import Network.Wai.Parse (parseHttpAccept)
|
||||||
import Web.Cookie (parseCookies)
|
import Web.Cookie (parseCookies)
|
||||||
|
|
||||||
import PostgREST.Config (AppConfig (..),
|
import PostgREST.Config (AppConfig (..),
|
||||||
OpenAPIMode (..))
|
OpenAPIMode (..))
|
||||||
import PostgREST.ContentType (ContentType (..))
|
|
||||||
import PostgREST.DbStructure (DbStructure (..))
|
import PostgREST.DbStructure (DbStructure (..))
|
||||||
import PostgREST.DbStructure.Identifiers (FieldName,
|
import PostgREST.DbStructure.Identifiers (FieldName,
|
||||||
QualifiedIdentifier (..),
|
QualifiedIdentifier (..),
|
||||||
Schema)
|
Schema)
|
||||||
import PostgREST.DbStructure.Proc (PgArg (..),
|
import PostgREST.DbStructure.Proc (ProcDescription (..),
|
||||||
ProcDescription (..),
|
ProcParam (..), ProcsMap)
|
||||||
ProcsMap)
|
import PostgREST.MediaType (MTPlanAttrs (..),
|
||||||
import PostgREST.Error (ApiRequestError (..))
|
MTPlanFormat (..),
|
||||||
import PostgREST.Query.SqlFragment (ftsOperators, operators)
|
MediaType (..))
|
||||||
import PostgREST.RangeQuery (NonnegRange, allRange,
|
import PostgREST.RangeQuery (NonnegRange, allRange,
|
||||||
rangeGeq, rangeLimit,
|
hasLimitZero,
|
||||||
rangeOffset, rangeRequested,
|
limitZeroRange,
|
||||||
restrictRange)
|
rangeRequested)
|
||||||
import PostgREST.Request.Parsers (pRequestColumns)
|
|
||||||
import PostgREST.Request.Preferences (PreferCount (..),
|
import PostgREST.Request.Preferences (PreferCount (..),
|
||||||
PreferParameters (..),
|
PreferParameters (..),
|
||||||
PreferRepresentation (..),
|
PreferRepresentation (..),
|
||||||
PreferResolution (..),
|
PreferResolution (..),
|
||||||
PreferTransaction (..))
|
PreferTransaction (..))
|
||||||
|
import PostgREST.Request.QueryParams (QueryParams (..))
|
||||||
|
import PostgREST.Request.Types (ApiRequestError (..))
|
||||||
|
|
||||||
import qualified PostgREST.ContentType as ContentType
|
import qualified PostgREST.MediaType as MediaType
|
||||||
|
import qualified PostgREST.Request.Preferences as Preferences
|
||||||
|
import qualified PostgREST.Request.QueryParams as QueryParams
|
||||||
|
|
||||||
import Protolude hiding (head, toS)
|
import Protolude
|
||||||
import Protolude.Conv (toS)
|
|
||||||
|
|
||||||
|
|
||||||
type RequestBody = BL.ByteString
|
type RequestBody = LBS.ByteString
|
||||||
|
|
||||||
data PayloadJSON
|
data Payload
|
||||||
= ProcessedJSON -- ^ Cached attributes of a JSON payload
|
= ProcessedJSON -- ^ Cached attributes of a JSON payload
|
||||||
{ pjRaw :: BL.ByteString
|
{ payRaw :: LBS.ByteString
|
||||||
-- ^ This is the raw ByteString that comes from the request body. We
|
-- ^ This is the raw ByteString that comes from the request body. We
|
||||||
-- cache this instead of an Aeson Value because it was detected that for
|
-- cache this instead of an Aeson Value because it was detected that for
|
||||||
-- large payloads the encoding had high memory usage, see
|
-- large payloads the encoding had high memory usage, see
|
||||||
-- https://github.com/PostgREST/postgrest/pull/1005 for more details
|
-- https://github.com/PostgREST/postgrest/pull/1005 for more details
|
||||||
, pjKeys :: S.Set Text
|
, payKeys :: S.Set Text
|
||||||
-- ^ Keys of the object or if it's an array these keys are guaranteed to
|
-- ^ Keys of the object or if it's an array these keys are guaranteed to
|
||||||
-- be the same across all its objects
|
-- be the same across all its objects
|
||||||
}
|
}
|
||||||
| RawJSON { pjRaw :: BL.ByteString }
|
| RawJSON { payRaw :: LBS.ByteString }
|
||||||
|
| RawPay { payRaw :: LBS.ByteString }
|
||||||
|
|
||||||
data InvokeMethod = InvHead | InvGet | InvPost deriving Eq
|
data InvokeMethod = InvHead | InvGet | InvPost deriving Eq
|
||||||
|
data Mutation = MutationCreate | MutationDelete | MutationSingleUpsert | MutationUpdate deriving Eq
|
||||||
|
|
||||||
-- | Types of things a user wants to do to tables/views/procs
|
-- | Types of things a user wants to do to tables/views/procs
|
||||||
data Action = ActionCreate | ActionRead{isHead :: Bool}
|
data Action
|
||||||
| ActionUpdate | ActionDelete
|
= ActionMutate Mutation
|
||||||
| ActionSingleUpsert | ActionInvoke InvokeMethod
|
| ActionRead {isHead :: Bool}
|
||||||
| ActionInfo | ActionInspect{isHead :: Bool}
|
| ActionInvoke InvokeMethod
|
||||||
deriving Eq
|
| ActionInfo
|
||||||
|
| ActionInspect {isHead :: Bool}
|
||||||
|
deriving Eq
|
||||||
-- | The path info that will be mapped to a target (used to handle validations and errors before defining the Target)
|
-- | The path info that will be mapped to a target (used to handle validations and errors before defining the Target)
|
||||||
data Path
|
data PathInfo
|
||||||
= PathInfo
|
= PathInfo
|
||||||
{ pSchema :: Schema,
|
{ pathName :: Text
|
||||||
pName :: Text,
|
, pathIsProc :: Bool
|
||||||
pHasRpc :: Bool,
|
, pathIsDefSpec :: Bool
|
||||||
pIsDefaultSpec :: Bool,
|
, pathIsRootSpec :: Bool
|
||||||
pIsRootSpec :: Bool
|
|
||||||
}
|
}
|
||||||
| PathUnknown
|
|
||||||
-- | The target db object of a user action
|
-- | The target db object of a user action
|
||||||
data Target = TargetIdent QualifiedIdentifier
|
data Target = TargetIdent QualifiedIdentifier
|
||||||
| TargetProc{tProc :: ProcDescription, tpIsRootSpec :: Bool}
|
| TargetProc{tProc :: ProcDescription, tpIsRootSpec :: Bool}
|
||||||
| TargetDefaultSpec{tdsSchema :: Schema} -- The default spec offered at root "/"
|
| TargetDefaultSpec{tdsSchema :: Schema} -- The default spec offered at root "/"
|
||||||
| TargetUnknown
|
|
||||||
|
|
||||||
-- | RPC query param value `/rpc/func?v=<value>`, used for VARIADIC functions on form-urlencoded POST and GETs
|
-- | RPC query param value `/rpc/func?v=<value>`, used for VARIADIC functions on form-urlencoded POST and GETs
|
||||||
-- | It can be fixed `?v=1` or repeated `?v=1&v=2&v=3.
|
-- | It can be fixed `?v=1` or repeated `?v=1&v=2&v=3.
|
||||||
@@ -119,25 +121,25 @@ instance JSON.ToJSON RpcParamValue where
|
|||||||
toJSON (Variadic v) = JSON.toJSON v
|
toJSON (Variadic v) = JSON.toJSON v
|
||||||
|
|
||||||
toRpcParamValue :: ProcDescription -> (Text, Text) -> (Text, RpcParamValue)
|
toRpcParamValue :: ProcDescription -> (Text, Text) -> (Text, RpcParamValue)
|
||||||
toRpcParamValue proc (k, v) | argIsVariadic k = (k, Variadic [v])
|
toRpcParamValue proc (k, v) | prmIsVariadic k = (k, Variadic [v])
|
||||||
| otherwise = (k, Fixed v)
|
| otherwise = (k, Fixed v)
|
||||||
where
|
where
|
||||||
argIsVariadic arg = isJust $ find (\PgArg{pgaName, pgaVar} -> pgaName == arg && pgaVar) $ pdArgs proc
|
prmIsVariadic prm = isJust $ find (\ProcParam{ppName, ppVar} -> ppName == prm && ppVar) $ pdParams proc
|
||||||
|
|
||||||
-- | Convert rpc params `/rpc/func?a=val1&b=val2` to json `{"a": "val1", "b": "val2"}
|
-- | Convert rpc params `/rpc/func?a=val1&b=val2` to json `{"a": "val1", "b": "val2"}
|
||||||
jsonRpcParams :: ProcDescription -> [(Text, Text)] -> PayloadJSON
|
jsonRpcParams :: ProcDescription -> [(Text, Text)] -> Payload
|
||||||
jsonRpcParams proc prms =
|
jsonRpcParams proc prms =
|
||||||
if not $ pdHasVariadic proc then -- if proc has no variadic arg, save steps and directly convert to json
|
if not $ pdHasVariadic proc then -- if proc has no variadic param, save steps and directly convert to json
|
||||||
ProcessedJSON (JSON.encode $ M.fromList $ second JSON.toJSON <$> prms) (S.fromList $ fst <$> prms)
|
ProcessedJSON (JSON.encode $ HM.fromList $ second JSON.toJSON <$> prms) (S.fromList $ fst <$> prms)
|
||||||
else
|
else
|
||||||
let paramsMap = M.fromListWith mergeParams $ toRpcParamValue proc <$> prms in
|
let paramsMap = HM.fromListWith mergeParams $ toRpcParamValue proc <$> prms in
|
||||||
ProcessedJSON (JSON.encode paramsMap) (S.fromList $ M.keys paramsMap)
|
ProcessedJSON (JSON.encode paramsMap) (S.fromList $ HM.keys paramsMap)
|
||||||
where
|
where
|
||||||
mergeParams :: RpcParamValue -> RpcParamValue -> RpcParamValue
|
mergeParams :: RpcParamValue -> RpcParamValue -> RpcParamValue
|
||||||
mergeParams (Variadic a) (Variadic b) = Variadic $ b ++ a
|
mergeParams (Variadic a) (Variadic b) = Variadic $ b ++ a
|
||||||
mergeParams v _ = v -- repeated params for non-variadic arguments are not merged
|
mergeParams v _ = v -- repeated params for non-variadic parameters are not merged
|
||||||
|
|
||||||
targetToJsonRpcParams :: Maybe Target -> [(Text, Text)] -> Maybe PayloadJSON
|
targetToJsonRpcParams :: Maybe Target -> [(Text, Text)] -> Maybe Payload
|
||||||
targetToJsonRpcParams target params =
|
targetToJsonRpcParams target params =
|
||||||
case target of
|
case target of
|
||||||
Just TargetProc{tProc} -> Just $ jsonRpcParams tProc params
|
Just TargetProc{tProc} -> Just $ jsonRpcParams tProc params
|
||||||
@@ -151,43 +153,77 @@ targetToJsonRpcParams target params =
|
|||||||
if it is an action we are able to perform.
|
if it is an action we are able to perform.
|
||||||
-}
|
-}
|
||||||
data ApiRequest = ApiRequest {
|
data ApiRequest = ApiRequest {
|
||||||
iAction :: Action -- ^ Similar but not identical to HTTP verb, e.g. Create/Invoke both POST
|
iAction :: Action -- ^ Similar but not identical to HTTP method, e.g. Create/Invoke both POST
|
||||||
, iRange :: M.HashMap ByteString NonnegRange -- ^ Requested range of rows within response
|
, iRange :: HM.HashMap Text NonnegRange -- ^ Requested range of rows within response
|
||||||
, iTopLevelRange :: NonnegRange -- ^ Requested range of rows from the top level
|
, iTopLevelRange :: NonnegRange -- ^ Requested range of rows from the top level
|
||||||
, iTarget :: Target -- ^ The target, be it calling a proc or accessing a table
|
, iTarget :: Target -- ^ The target, be it calling a proc or accessing a table
|
||||||
, iPayload :: Maybe PayloadJSON -- ^ Data sent by client and used for mutation actions
|
, iPayload :: Maybe Payload -- ^ Data sent by client and used for mutation actions
|
||||||
, iPreferRepresentation :: PreferRepresentation -- ^ If client wants created items echoed back
|
, iPreferRepresentation :: PreferRepresentation -- ^ If client wants created items echoed back
|
||||||
, iPreferParameters :: Maybe PreferParameters -- ^ How to pass parameters to a stored procedure
|
, iPreferParameters :: Maybe PreferParameters -- ^ How to pass parameters to a stored procedure
|
||||||
, iPreferCount :: Maybe PreferCount -- ^ Whether the client wants a result count
|
, iPreferCount :: Maybe PreferCount -- ^ Whether the client wants a result count
|
||||||
, iPreferResolution :: Maybe PreferResolution -- ^ Whether the client wants to UPSERT or ignore records on PK conflict
|
, iPreferResolution :: Maybe PreferResolution -- ^ Whether the client wants to UPSERT or ignore records on PK conflict
|
||||||
, iPreferTransaction :: Maybe PreferTransaction -- ^ Whether the clients wants to commit or rollback the transaction
|
, iPreferTransaction :: Maybe PreferTransaction -- ^ Whether the clients wants to commit or rollback the transaction
|
||||||
, iFilters :: [(Text, Text)] -- ^ Filters on the result ("id", "eq.10")
|
, iQueryParams :: QueryParams.QueryParams
|
||||||
, iLogic :: [(Text, Text)] -- ^ &and and &or parameters used for complex boolean logic
|
|
||||||
, iSelect :: Maybe Text -- ^ &select parameter used to shape the response
|
|
||||||
, iOnConflict :: Maybe Text -- ^ &on_conflict parameter used to upsert on specific unique keys
|
|
||||||
, iColumns :: S.Set FieldName -- ^ parsed colums from &columns parameter and payload
|
, iColumns :: S.Set FieldName -- ^ parsed colums from &columns parameter and payload
|
||||||
, iOrder :: [(Text, Text)] -- ^ &order parameters for each level
|
|
||||||
, iCanonicalQS :: ByteString -- ^ Alphabetized (canonical) request query string for response URLs
|
|
||||||
, iJWT :: Text -- ^ JSON Web Token
|
|
||||||
, iHeaders :: [(ByteString, ByteString)] -- ^ HTTP request headers
|
, iHeaders :: [(ByteString, ByteString)] -- ^ HTTP request headers
|
||||||
, iCookies :: [(ByteString, ByteString)] -- ^ Request Cookies
|
, iCookies :: [(ByteString, ByteString)] -- ^ Request Cookies
|
||||||
, iPath :: ByteString -- ^ Raw request path
|
, iPath :: ByteString -- ^ Raw request path
|
||||||
, iMethod :: ByteString -- ^ Raw request method
|
, iMethod :: ByteString -- ^ Raw request method
|
||||||
, iProfile :: Maybe Schema -- ^ The request profile for enabling use of multiple schemas. Follows the spec in hhttps://www.w3.org/TR/dx-prof-conneg/ttps://www.w3.org/TR/dx-prof-conneg/.
|
, iProfile :: Maybe Schema -- ^ The request profile for enabling use of multiple schemas. Follows the spec in hhttps://www.w3.org/TR/dx-prof-conneg/ttps://www.w3.org/TR/dx-prof-conneg/.
|
||||||
, iSchema :: Schema -- ^ The request schema. Can vary depending on iProfile.
|
, iSchema :: Schema -- ^ The request schema. Can vary depending on iProfile.
|
||||||
, iAcceptContentType :: ContentType
|
, iAcceptMediaType :: MediaType
|
||||||
}
|
}
|
||||||
|
|
||||||
-- | Examines HTTP request and translates it into user intent.
|
-- | Examines HTTP request and translates it into user intent.
|
||||||
userApiRequest :: AppConfig -> DbStructure -> Request -> RequestBody -> Either ApiRequestError ApiRequest
|
userApiRequest :: AppConfig -> DbStructure -> Request -> RequestBody -> Either ApiRequestError ApiRequest
|
||||||
userApiRequest conf@AppConfig{..} dbStructure req reqBody
|
userApiRequest conf dbStructure req reqBody = do
|
||||||
|
qPrms <- first QueryParamError $ QueryParams.parse $ rawQueryString req
|
||||||
|
pInfo <- getPathInfo conf $ pathInfo req
|
||||||
|
act <- getAction pInfo $ requestMethod req
|
||||||
|
apiRequest conf dbStructure req reqBody qPrms pInfo act
|
||||||
|
|
||||||
|
getPathInfo :: AppConfig -> [Text] -> Either ApiRequestError PathInfo
|
||||||
|
getPathInfo AppConfig{configOpenApiMode, configDbRootSpec} path =
|
||||||
|
case path of
|
||||||
|
[] -> case configDbRootSpec of
|
||||||
|
Just (QualifiedIdentifier _ pathName) -> Right $ PathInfo pathName True False True
|
||||||
|
Nothing | configOpenApiMode == OADisabled -> Left NotFound
|
||||||
|
| otherwise -> Right $ PathInfo mempty False True False
|
||||||
|
[table] -> Right $ PathInfo table False False False
|
||||||
|
["rpc", pName] -> Right $ PathInfo pName True False False
|
||||||
|
_ -> Left NotFound
|
||||||
|
|
||||||
|
getAction :: PathInfo -> ByteString -> Either ApiRequestError Action
|
||||||
|
getAction PathInfo{pathIsProc, pathIsDefSpec} method =
|
||||||
|
if pathIsProc && method `notElem` ["HEAD", "GET", "POST", "OPTIONS"]
|
||||||
|
then Left $ InvalidRpcMethod method
|
||||||
|
else case method of
|
||||||
|
-- The HEAD method is identical to GET except that the server MUST NOT return a message-body in the response
|
||||||
|
-- From https://www.w3.org/Protocols/rfc2616/rfc2616-sec9.html#sec9.4
|
||||||
|
"HEAD" | pathIsDefSpec -> Right $ ActionInspect{isHead=True}
|
||||||
|
| pathIsProc -> Right $ ActionInvoke InvHead
|
||||||
|
| otherwise -> Right $ ActionRead{isHead=True}
|
||||||
|
"GET" | pathIsDefSpec -> Right $ ActionInspect{isHead=False}
|
||||||
|
| pathIsProc -> Right $ ActionInvoke InvGet
|
||||||
|
| otherwise -> Right $ ActionRead{isHead=False}
|
||||||
|
"POST" | pathIsProc -> Right $ ActionInvoke InvPost
|
||||||
|
| otherwise -> Right $ ActionMutate MutationCreate
|
||||||
|
"PATCH" -> Right $ ActionMutate MutationUpdate
|
||||||
|
"PUT" -> Right $ ActionMutate MutationSingleUpsert
|
||||||
|
"DELETE" -> Right $ ActionMutate MutationDelete
|
||||||
|
"OPTIONS" -> Right ActionInfo
|
||||||
|
_ -> Left $ UnsupportedMethod method
|
||||||
|
|
||||||
|
apiRequest :: AppConfig -> DbStructure -> Request -> RequestBody -> QueryParams.QueryParams -> PathInfo -> Action -> Either ApiRequestError ApiRequest
|
||||||
|
apiRequest conf@AppConfig{..} dbStructure req reqBody queryparams@QueryParams{..} path@PathInfo{pathName, pathIsProc, pathIsRootSpec, pathIsDefSpec} action
|
||||||
| isJust profile && fromJust profile `notElem` configDbSchemas = Left $ UnacceptableSchema $ toList configDbSchemas
|
| isJust profile && fromJust profile `notElem` configDbSchemas = Left $ UnacceptableSchema $ toList configDbSchemas
|
||||||
| isTargetingProc && method `notElem` ["HEAD", "GET", "POST"] = Left ActionInappropriate
|
| isInvalidRange = Left InvalidRange
|
||||||
| topLevelRange == emptyRange = Left InvalidRange
|
| shouldParsePayload && isLeft payload = either (Left . InvalidBody) witness payload
|
||||||
| shouldParsePayload && isLeft payload = either (Left . InvalidBody . toS) witness payload
|
| not expectParams && not (L.null qsParams) = Left $ ParseRequestError "Unexpected param or filter missing operator" ("Failed to parse " <> show qsParams)
|
||||||
| isLeft parsedColumns = either Left witness parsedColumns
|
| method `elem` ["PATCH", "DELETE"] && not (null qsRanges) && null qsOrder = Left LimitNoOrderError
|
||||||
|
| method == "PUT" && topLevelRange /= allRange = Left PutRangeNotAllowedError
|
||||||
| otherwise = do
|
| otherwise = do
|
||||||
acceptContentType <- findAcceptContentType conf action path accepts
|
acceptMediaType <- findAcceptMediaType conf action path accepts
|
||||||
checkedTarget <- target
|
checkedTarget <- target
|
||||||
return ApiRequest {
|
return ApiRequest {
|
||||||
iAction = action
|
iAction = action
|
||||||
@@ -195,214 +231,133 @@ userApiRequest conf@AppConfig{..} dbStructure req reqBody
|
|||||||
, iRange = ranges
|
, iRange = ranges
|
||||||
, iTopLevelRange = topLevelRange
|
, iTopLevelRange = topLevelRange
|
||||||
, iPayload = relevantPayload
|
, iPayload = relevantPayload
|
||||||
, iPreferRepresentation = representation
|
, iPreferRepresentation = fromMaybe None preferRepresentation
|
||||||
, iPreferParameters = if | hasPrefer (show SingleObject) -> Just SingleObject
|
, iPreferParameters = preferParameters
|
||||||
| hasPrefer (show MultipleObjects) -> Just MultipleObjects
|
, iPreferCount = preferCount
|
||||||
| otherwise -> Nothing
|
, iPreferResolution = preferResolution
|
||||||
, iPreferCount = if | hasPrefer (show ExactCount) -> Just ExactCount
|
, iPreferTransaction = preferTransaction
|
||||||
| hasPrefer (show PlannedCount) -> Just PlannedCount
|
, iQueryParams = queryparams
|
||||||
| hasPrefer (show EstimatedCount) -> Just EstimatedCount
|
|
||||||
| otherwise -> Nothing
|
|
||||||
, iPreferResolution = if | hasPrefer (show MergeDuplicates) -> Just MergeDuplicates
|
|
||||||
| hasPrefer (show IgnoreDuplicates) -> Just IgnoreDuplicates
|
|
||||||
| otherwise -> Nothing
|
|
||||||
, iPreferTransaction = if | hasPrefer (show Commit) -> Just Commit
|
|
||||||
| hasPrefer (show Rollback) -> Just Rollback
|
|
||||||
| otherwise -> Nothing
|
|
||||||
, iFilters = filters
|
|
||||||
, iLogic = [(toS k, toS $ fromJust v) | (k,v) <- qParams, isJust v, endingIn ["and", "or"] k ]
|
|
||||||
, iSelect = toS <$> join (lookup "select" qParams)
|
|
||||||
, iOnConflict = toS <$> join (lookup "on_conflict" qParams)
|
|
||||||
, iColumns = payloadColumns
|
, iColumns = payloadColumns
|
||||||
, iOrder = [(toS k, toS $ fromJust v) | (k,v) <- qParams, isJust v, endingIn ["order"] k ]
|
|
||||||
, iCanonicalQS = toS $ urlEncodeVars
|
|
||||||
. L.sortOn fst
|
|
||||||
. map (join (***) toS . second (fromMaybe BS.empty))
|
|
||||||
$ qString
|
|
||||||
, iJWT = tokenStr
|
|
||||||
, iHeaders = [ (CI.foldedCase k, v) | (k,v) <- hdrs, k /= hCookie]
|
, iHeaders = [ (CI.foldedCase k, v) | (k,v) <- hdrs, k /= hCookie]
|
||||||
, iCookies = maybe [] parseCookies $ lookupHeader "Cookie"
|
, iCookies = maybe [] parseCookies $ lookupHeader "Cookie"
|
||||||
, iPath = rawPathInfo req
|
, iPath = rawPathInfo req
|
||||||
, iMethod = method
|
, iMethod = method
|
||||||
, iProfile = profile
|
, iProfile = profile
|
||||||
, iSchema = schema
|
, iSchema = schema
|
||||||
, iAcceptContentType = acceptContentType
|
, iAcceptMediaType = acceptMediaType
|
||||||
}
|
}
|
||||||
where
|
where
|
||||||
accepts = maybe [CTAny] (map ContentType.decodeContentType . parseHttpAccept) $ lookupHeader "accept"
|
accepts = maybe [MTAny] (map MediaType.decodeMediaType . parseHttpAccept) $ lookupHeader "accept"
|
||||||
-- queryString with '+' converted to ' '(space)
|
|
||||||
qString = parseQueryReplacePlus True $ rawQueryString req
|
expectParams = pathIsProc && method /= "POST"
|
||||||
-- rpcQParams = Rpc query params e.g. /rpc/name?param1=val1, similar to filter but with no operator(eq, lt..)
|
|
||||||
(filters, rpcQParams) =
|
contentMediaType = maybe MTApplicationJSON MediaType.decodeMediaType $ lookupHeader "content-type"
|
||||||
case action of
|
|
||||||
ActionInvoke InvGet -> partitionFlts
|
columns = case action of
|
||||||
ActionInvoke InvHead -> partitionFlts
|
ActionMutate MutationCreate -> qsColumns
|
||||||
_ -> (flts, [])
|
ActionMutate MutationUpdate -> qsColumns
|
||||||
partitionFlts = partition (liftM2 (||) (isEmbedPath . fst) (hasOperator . snd)) flts
|
ActionInvoke InvPost -> qsColumns
|
||||||
flts =
|
_ -> Nothing
|
||||||
[ (toS k, toS $ fromJust v) |
|
|
||||||
(k,v) <- qParams, isJust v,
|
|
||||||
k `notElem` ["select", "columns"],
|
|
||||||
not (endingIn ["order", "limit", "offset", "and", "or"] k) ]
|
|
||||||
hasOperator val = any (`T.isPrefixOf` val) $
|
|
||||||
((<> ".") <$> "not":M.keys operators) ++
|
|
||||||
((<> "(") <$> M.keys ftsOperators)
|
|
||||||
isEmbedPath = T.isInfixOf "."
|
|
||||||
isTargetingProc = case path of
|
|
||||||
PathInfo{pHasRpc, pIsRootSpec} -> pHasRpc || pIsRootSpec
|
|
||||||
_ -> False
|
|
||||||
isTargetingDefaultSpec = case path of
|
|
||||||
PathInfo{pIsDefaultSpec=True} -> True
|
|
||||||
_ -> False
|
|
||||||
contentType = ContentType.decodeContentType . fromMaybe "application/json" $ lookupHeader "content-type"
|
|
||||||
columns
|
|
||||||
| action `elem` [ActionCreate, ActionUpdate, ActionInvoke InvPost] = toS <$> join (lookup "columns" qParams)
|
|
||||||
| otherwise = Nothing
|
|
||||||
parsedColumns = pRequestColumns columns
|
|
||||||
payloadColumns =
|
payloadColumns =
|
||||||
case (contentType, action) of
|
case (contentMediaType, action) of
|
||||||
(_, ActionInvoke InvGet) -> S.fromList $ fst <$> rpcQParams
|
(_, ActionInvoke InvGet) -> S.fromList $ fst <$> qsParams
|
||||||
(_, ActionInvoke InvHead) -> S.fromList $ fst <$> rpcQParams
|
(_, ActionInvoke InvHead) -> S.fromList $ fst <$> qsParams
|
||||||
(CTUrlEncoded, _) -> S.fromList $ map (toS . fst) $ parseSimpleQuery $ toS reqBody
|
(MTUrlEncoded, _) -> S.fromList $ map (T.decodeUtf8 . fst) $ parseSimpleQuery $ LBS.toStrict reqBody
|
||||||
_ -> case (relevantPayload, fromRight Nothing parsedColumns) of
|
_ -> case (relevantPayload, columns) of
|
||||||
(Just ProcessedJSON{pjKeys}, _) -> pjKeys
|
(Just ProcessedJSON{payKeys}, _) -> payKeys
|
||||||
(Just RawJSON{}, Just cls) -> cls
|
(Just RawJSON{}, Just cls) -> cls
|
||||||
_ -> S.empty
|
_ -> S.empty
|
||||||
payload = case contentType of
|
payload :: Either ByteString Payload
|
||||||
CTApplicationJSON ->
|
payload = case (contentMediaType, pathIsProc) of
|
||||||
|
(MTApplicationJSON, _) ->
|
||||||
if isJust columns
|
if isJust columns
|
||||||
then Right $ RawJSON reqBody
|
then Right $ RawJSON reqBody
|
||||||
else note "All object keys must match" . payloadAttributes reqBody
|
else note "All object keys must match" . payloadAttributes reqBody
|
||||||
=<< if BL.null reqBody && isTargetingProc
|
=<< if LBS.null reqBody && pathIsProc
|
||||||
then Right emptyObject
|
then Right emptyObject
|
||||||
else JSON.eitherDecode reqBody
|
else first BS.pack $ JSON.eitherDecode reqBody
|
||||||
CTTextCSV -> do
|
(MTTextCSV, _) -> do
|
||||||
json <- csvToJson <$> CSV.decodeByName reqBody
|
json <- csvToJson <$> first BS.pack (CSV.decodeByName reqBody)
|
||||||
note "All lines must have same number of fields" $ payloadAttributes (JSON.encode json) json
|
note "All lines must have same number of fields" $ payloadAttributes (JSON.encode json) json
|
||||||
CTUrlEncoded ->
|
(MTUrlEncoded, _) ->
|
||||||
let paramsMap = M.fromList $ (toS *** JSON.String . toS) <$> parseSimpleQuery (toS reqBody) in
|
let paramsMap = HM.fromList $ (T.decodeUtf8 *** JSON.String . T.decodeUtf8) <$> parseSimpleQuery (LBS.toStrict reqBody) in
|
||||||
Right $ ProcessedJSON (JSON.encode paramsMap) $ S.fromList (M.keys paramsMap)
|
Right $ ProcessedJSON (JSON.encode paramsMap) $ S.fromList (HM.keys paramsMap)
|
||||||
ct ->
|
(MTTextPlain, True) -> Right $ RawPay reqBody
|
||||||
Left $ toS $ "Content-Type not acceptable: " <> ContentType.toMime ct
|
(MTTextXML, True) -> Right $ RawPay reqBody
|
||||||
topLevelRange = fromMaybe allRange $ M.lookup "limit" ranges -- if no limit is specified, get all the request rows
|
(MTOctetStream, True) -> Right $ RawPay reqBody
|
||||||
action =
|
(ct, _) -> Left $ "Content-Type not acceptable: " <> MediaType.toMime ct
|
||||||
case method of
|
topLevelRange = fromMaybe allRange $ HM.lookup "limit" ranges -- if no limit is specified, get all the request rows
|
||||||
-- The HEAD method is identical to GET except that the server MUST NOT return a message-body in the response
|
|
||||||
-- From https://www.w3.org/Protocols/rfc2616/rfc2616-sec9.html#sec9.4
|
|
||||||
"HEAD" | isTargetingDefaultSpec -> ActionInspect{isHead=True}
|
|
||||||
| isTargetingProc -> ActionInvoke InvHead
|
|
||||||
| otherwise -> ActionRead{isHead=True}
|
|
||||||
"GET" | isTargetingDefaultSpec -> ActionInspect{isHead=False}
|
|
||||||
| isTargetingProc -> ActionInvoke InvGet
|
|
||||||
| otherwise -> ActionRead{isHead=False}
|
|
||||||
"POST" -> if isTargetingProc
|
|
||||||
then ActionInvoke InvPost
|
|
||||||
else ActionCreate
|
|
||||||
"PATCH" -> ActionUpdate
|
|
||||||
"PUT" -> ActionSingleUpsert
|
|
||||||
"DELETE" -> ActionDelete
|
|
||||||
"OPTIONS" -> ActionInfo
|
|
||||||
_ -> ActionInspect{isHead=False}
|
|
||||||
|
|
||||||
defaultSchema = head configDbSchemas
|
defaultSchema = NonEmptyList.head configDbSchemas
|
||||||
profile
|
profile
|
||||||
| length configDbSchemas <= 1 -- only enable content negotiation by profile when there are multiple schemas specified in the config
|
| length configDbSchemas <= 1 -- only enable content negotiation by profile when there are multiple schemas specified in the config
|
||||||
= Nothing
|
= Nothing
|
||||||
| otherwise = case action of
|
| otherwise = case method of
|
||||||
-- POST/PATCH/PUT/DELETE don't use the same header as per the spec
|
-- POST/PATCH/PUT/DELETE don't use the same header as per the spec
|
||||||
ActionCreate -> contentProfile
|
"DELETE" -> contentProfile
|
||||||
ActionUpdate -> contentProfile
|
"PATCH" -> contentProfile
|
||||||
ActionSingleUpsert -> contentProfile
|
"POST" -> contentProfile
|
||||||
ActionDelete -> contentProfile
|
"PUT" -> contentProfile
|
||||||
ActionInvoke InvPost -> contentProfile
|
_ -> acceptProfile
|
||||||
_ -> acceptProfile
|
|
||||||
where
|
where
|
||||||
contentProfile = Just $ maybe defaultSchema toS $ lookupHeader "Content-Profile"
|
contentProfile = Just $ maybe defaultSchema T.decodeUtf8 $ lookupHeader "Content-Profile"
|
||||||
acceptProfile = Just $ maybe defaultSchema toS $ lookupHeader "Accept-Profile"
|
acceptProfile = Just $ maybe defaultSchema T.decodeUtf8 $ lookupHeader "Accept-Profile"
|
||||||
schema = fromMaybe defaultSchema profile
|
|
||||||
target =
|
|
||||||
let
|
|
||||||
callFindProc procSch procNam = findProc (QualifiedIdentifier procSch procNam) payloadColumns (hasPrefer (show SingleObject)) $ dbProcs dbStructure
|
|
||||||
in
|
|
||||||
case path of
|
|
||||||
PathInfo{pSchema, pName, pHasRpc, pIsRootSpec, pIsDefaultSpec}
|
|
||||||
| pHasRpc || pIsRootSpec -> (`TargetProc` pIsRootSpec) <$> callFindProc pSchema pName
|
|
||||||
| pIsDefaultSpec -> Right $ TargetDefaultSpec pSchema
|
|
||||||
| otherwise -> Right $ TargetIdent $ QualifiedIdentifier pSchema pName
|
|
||||||
PathUnknown -> Right TargetUnknown
|
|
||||||
|
|
||||||
shouldParsePayload = case (contentType, action) of
|
schema = fromMaybe defaultSchema profile
|
||||||
(CTUrlEncoded, ActionInvoke InvPost) -> False
|
|
||||||
(_, act) -> act `elem` [ActionCreate, ActionUpdate, ActionSingleUpsert, ActionInvoke InvPost]
|
target
|
||||||
relevantPayload = case (contentType, action) of
|
| pathIsProc = (`TargetProc` pathIsRootSpec) <$> callFindProc schema pathName
|
||||||
|
| pathIsDefSpec = Right $ TargetDefaultSpec schema
|
||||||
|
| otherwise = Right $ TargetIdent $ QualifiedIdentifier schema pathName
|
||||||
|
where
|
||||||
|
callFindProc procSch procNam = findProc
|
||||||
|
(QualifiedIdentifier procSch procNam) payloadColumns (preferParameters == Just SingleObject) (dbProcs dbStructure)
|
||||||
|
contentMediaType (action == ActionInvoke InvPost)
|
||||||
|
|
||||||
|
shouldParsePayload = case (action, contentMediaType) of
|
||||||
|
(ActionMutate MutationCreate, _) -> True
|
||||||
|
(ActionInvoke InvPost, MTUrlEncoded) -> False
|
||||||
|
(ActionInvoke InvPost, _) -> True
|
||||||
|
(ActionMutate MutationSingleUpsert, _) -> True
|
||||||
|
(ActionMutate MutationUpdate, _) -> True
|
||||||
|
_ -> False
|
||||||
|
relevantPayload = case (contentMediaType, action) of
|
||||||
-- Though ActionInvoke GET/HEAD doesn't really have a payload, we use the payload variable as a way
|
-- Though ActionInvoke GET/HEAD doesn't really have a payload, we use the payload variable as a way
|
||||||
-- to store the query string arguments to the function.
|
-- to store the query string arguments to the function.
|
||||||
(_, ActionInvoke InvGet) -> targetToJsonRpcParams (rightToMaybe target) rpcQParams
|
(_, ActionInvoke InvGet) -> targetToJsonRpcParams (rightToMaybe target) qsParams
|
||||||
(_, ActionInvoke InvHead) -> targetToJsonRpcParams (rightToMaybe target) rpcQParams
|
(_, ActionInvoke InvHead) -> targetToJsonRpcParams (rightToMaybe target) qsParams
|
||||||
(CTUrlEncoded, ActionInvoke InvPost) -> targetToJsonRpcParams (rightToMaybe target) $ (toS *** toS) <$> parseSimpleQuery (toS reqBody)
|
(MTUrlEncoded, ActionInvoke InvPost) -> targetToJsonRpcParams (rightToMaybe target) $ (T.decodeUtf8 *** T.decodeUtf8) <$> parseSimpleQuery (LBS.toStrict reqBody)
|
||||||
_ | shouldParsePayload -> rightToMaybe payload
|
_ | shouldParsePayload -> rightToMaybe payload
|
||||||
| otherwise -> Nothing
|
| otherwise -> Nothing
|
||||||
path =
|
|
||||||
case pathInfo req of
|
|
||||||
[] -> case configDbRootSpec of
|
|
||||||
Just (QualifiedIdentifier pSch pName) -> PathInfo (if pSch == mempty then schema else pSch) pName False False True
|
|
||||||
Nothing | configOpenApiMode == OADisabled -> PathUnknown
|
|
||||||
| otherwise -> PathInfo schema "" False True False
|
|
||||||
[table] -> PathInfo schema table False False False
|
|
||||||
["rpc", pName] -> PathInfo schema pName True False False
|
|
||||||
_ -> PathUnknown
|
|
||||||
method = requestMethod req
|
method = requestMethod req
|
||||||
hdrs = requestHeaders req
|
hdrs = requestHeaders req
|
||||||
qParams = [(toS k, v)|(k,v) <- qString]
|
|
||||||
lookupHeader = flip lookup hdrs
|
lookupHeader = flip lookup hdrs
|
||||||
hasPrefer :: Text -> Bool
|
Preferences.Preferences{..} = Preferences.fromHeaders hdrs
|
||||||
hasPrefer val = any (\(h,v) -> h == "Prefer" && val `elem` split v) hdrs
|
|
||||||
where
|
|
||||||
split :: BS.ByteString -> [Text]
|
|
||||||
split = map T.strip . T.split (==',') . toS
|
|
||||||
representation
|
|
||||||
| hasPrefer (show Full) = Full
|
|
||||||
| hasPrefer (show None) = None
|
|
||||||
| hasPrefer (show HeadersOnly) = HeadersOnly
|
|
||||||
| otherwise = None
|
|
||||||
auth = fromMaybe "" $ lookupHeader hAuthorization
|
|
||||||
tokenStr = case T.split (== ' ') (toS auth) of
|
|
||||||
("Bearer" : t : _) -> t
|
|
||||||
("bearer" : t : _) -> t
|
|
||||||
_ -> ""
|
|
||||||
endingIn:: [Text] -> Text -> Bool
|
|
||||||
endingIn xx key = lastWord `elem` xx
|
|
||||||
where lastWord = last $ T.split (=='.') key
|
|
||||||
|
|
||||||
headerRange = rangeRequested hdrs
|
headerRange = rangeRequested hdrs
|
||||||
replaceLast x s = T.intercalate "." $ L.init (T.split (=='.') s) ++ [x]
|
limitRange = fromMaybe allRange (HM.lookup "limit" qsRanges)
|
||||||
limitParams :: M.HashMap ByteString NonnegRange
|
headerAndLimitRange = rangeIntersection headerRange limitRange
|
||||||
limitParams = M.fromList [(toS (replaceLast "limit" k), restrictRange (readMaybe . toS =<< v) allRange) | (k,v) <- qParams, isJust v, endingIn ["limit"] k]
|
|
||||||
offsetParams :: M.HashMap ByteString NonnegRange
|
|
||||||
offsetParams = M.fromList [(toS (replaceLast "limit" k), maybe allRange rangeGeq (readMaybe . toS =<< v)) | (k,v) <- qParams, isJust v, endingIn ["offset"] k]
|
|
||||||
|
|
||||||
urlRange = M.unionWith f limitParams offsetParams
|
-- Bypass all the ranges and send only the limit zero range (0 <= x <= -1) if
|
||||||
where
|
-- limit=0 is present in the query params (not allowed for the Range header)
|
||||||
f rl ro = Range (BoundaryBelow o) (BoundaryAbove $ o + l - 1)
|
ranges = HM.insert "limit" (if hasLimitZero limitRange then limitZeroRange else headerAndLimitRange) qsRanges
|
||||||
where
|
-- The only emptyRange allowed is the limit zero range
|
||||||
l = fromMaybe 0 $ rangeLimit rl
|
isInvalidRange = topLevelRange == emptyRange && not (hasLimitZero limitRange)
|
||||||
o = rangeOffset ro
|
|
||||||
ranges = M.insert "limit" (rangeIntersection headerRange (fromMaybe allRange (M.lookup "limit" urlRange))) urlRange
|
|
||||||
|
|
||||||
{-|
|
{-|
|
||||||
Find the best match from a list of content types accepted by the
|
Find the best match from a list of media types accepted by the
|
||||||
client in order of decreasing preference and a list of types
|
client in order of decreasing preference and a list of types
|
||||||
producible by the server. If there is no match but the client
|
producible by the server. If there is no match but the client
|
||||||
accepts */* then return the top server pick.
|
accepts */* then return the top server pick.
|
||||||
-}
|
-}
|
||||||
mutuallyAgreeable :: [ContentType] -> [ContentType] -> Maybe ContentType
|
mutuallyAgreeable :: [MediaType] -> [MediaType] -> Maybe MediaType
|
||||||
mutuallyAgreeable sProduces cAccepts =
|
mutuallyAgreeable sProduces cAccepts =
|
||||||
let exact = listToMaybe $ L.intersect cAccepts sProduces in
|
let exact = listToMaybe $ L.intersect cAccepts sProduces in
|
||||||
if isNothing exact && CTAny `elem` cAccepts
|
if isNothing exact && MTAny `elem` cAccepts
|
||||||
then listToMaybe sProduces
|
then listToMaybe sProduces
|
||||||
else exact
|
else exact
|
||||||
|
|
||||||
type CsvData = V.Vector (M.HashMap Text BL.ByteString)
|
type CsvData = V.Vector (M.Map Text LBS.ByteString)
|
||||||
|
|
||||||
{-|
|
{-|
|
||||||
Converts CSV like
|
Converts CSV like
|
||||||
@@ -420,23 +375,23 @@ csvToJson :: (CSV.Header, CsvData) -> JSON.Value
|
|||||||
csvToJson (_, vals) =
|
csvToJson (_, vals) =
|
||||||
JSON.Array $ V.map rowToJsonObj vals
|
JSON.Array $ V.map rowToJsonObj vals
|
||||||
where
|
where
|
||||||
rowToJsonObj = JSON.Object .
|
rowToJsonObj = JSON.Object . KM.fromMapText .
|
||||||
M.map (\str ->
|
M.map (\str ->
|
||||||
if str == "NULL"
|
if str == "NULL"
|
||||||
then JSON.Null
|
then JSON.Null
|
||||||
else JSON.String $ toS str
|
else JSON.String . T.decodeUtf8 $ LBS.toStrict str
|
||||||
)
|
)
|
||||||
|
|
||||||
payloadAttributes :: RequestBody -> JSON.Value -> Maybe PayloadJSON
|
payloadAttributes :: RequestBody -> JSON.Value -> Maybe Payload
|
||||||
payloadAttributes raw json =
|
payloadAttributes raw json =
|
||||||
-- Test that Array contains only Objects having the same keys
|
-- Test that Array contains only Objects having the same keys
|
||||||
case json of
|
case json of
|
||||||
JSON.Array arr ->
|
JSON.Array arr ->
|
||||||
case arr V.!? 0 of
|
case arr V.!? 0 of
|
||||||
Just (JSON.Object o) ->
|
Just (JSON.Object o) ->
|
||||||
let canonicalKeys = S.fromList $ M.keys o
|
let canonicalKeys = S.fromList $ K.toText <$> KM.keys o
|
||||||
areKeysUniform = all (\case
|
areKeysUniform = all (\case
|
||||||
JSON.Object x -> S.fromList (M.keys x) == canonicalKeys
|
JSON.Object x -> S.fromList (K.toText <$> KM.keys x) == canonicalKeys
|
||||||
_ -> False) arr in
|
_ -> False) arr in
|
||||||
if areKeysUniform
|
if areKeysUniform
|
||||||
then Just $ ProcessedJSON raw canonicalKeys
|
then Just $ ProcessedJSON raw canonicalKeys
|
||||||
@@ -444,73 +399,90 @@ payloadAttributes raw json =
|
|||||||
Just _ -> Nothing
|
Just _ -> Nothing
|
||||||
Nothing -> Just emptyPJArray
|
Nothing -> Just emptyPJArray
|
||||||
|
|
||||||
JSON.Object o -> Just $ ProcessedJSON raw (S.fromList $ M.keys o)
|
JSON.Object o -> Just $ ProcessedJSON raw (S.fromList $ K.toText <$> KM.keys o)
|
||||||
|
|
||||||
-- truncate everything else to an empty array.
|
-- truncate everything else to an empty array.
|
||||||
_ -> Just emptyPJArray
|
_ -> Just emptyPJArray
|
||||||
where
|
where
|
||||||
emptyPJArray = ProcessedJSON (JSON.encode emptyArray) S.empty
|
emptyPJArray = ProcessedJSON (JSON.encode emptyArray) S.empty
|
||||||
|
|
||||||
findAcceptContentType :: AppConfig -> Action -> Path -> [ContentType] -> Either ApiRequestError ContentType
|
findAcceptMediaType :: AppConfig -> Action -> PathInfo -> [MediaType] -> Either ApiRequestError MediaType
|
||||||
findAcceptContentType conf action path accepts =
|
findAcceptMediaType conf action path accepts =
|
||||||
case mutuallyAgreeable (requestContentTypes conf action path) accepts of
|
case mutuallyAgreeable (requestMediaTypes conf action path) accepts of
|
||||||
Just ct ->
|
Just ct ->
|
||||||
Right ct
|
Right ct
|
||||||
Nothing ->
|
Nothing ->
|
||||||
Left . ContentTypeError $ map ContentType.toMime accepts
|
Left . MediaTypeError $ map MediaType.toMime accepts
|
||||||
|
|
||||||
requestContentTypes :: AppConfig -> Action -> Path -> [ContentType]
|
requestMediaTypes :: AppConfig -> Action -> PathInfo -> [MediaType]
|
||||||
requestContentTypes conf action path =
|
requestMediaTypes conf action path =
|
||||||
case action of
|
case action of
|
||||||
ActionRead _ -> defaultContentTypes ++ rawContentTypes conf
|
ActionRead _ -> defaultMediaTypes ++ rawMediaTypes
|
||||||
ActionInvoke _ -> invokeContentTypes
|
ActionInvoke _ -> invokeMediaTypes
|
||||||
ActionInspect _ -> [CTOpenAPI, CTApplicationJSON]
|
ActionInspect _ -> [MTOpenAPI, MTApplicationJSON]
|
||||||
ActionInfo -> [CTTextCSV]
|
ActionInfo -> [MTTextCSV]
|
||||||
_ -> defaultContentTypes
|
_ -> defaultMediaTypes
|
||||||
where
|
where
|
||||||
invokeContentTypes =
|
invokeMediaTypes =
|
||||||
defaultContentTypes
|
defaultMediaTypes
|
||||||
++ rawContentTypes conf
|
++ rawMediaTypes
|
||||||
++ [CTOpenAPI | pIsRootSpec path]
|
++ [MTOpenAPI | pathIsRootSpec path]
|
||||||
defaultContentTypes =
|
defaultMediaTypes =
|
||||||
[CTApplicationJSON, CTSingularJSON, CTTextCSV]
|
[MTApplicationJSON, MTSingularJSON, MTGeoJSON, MTTextCSV] ++
|
||||||
|
[MTPlan $ MTPlanAttrs Nothing PlanJSON mempty | configDbPlanEnabled conf]
|
||||||
rawContentTypes :: AppConfig -> [ContentType]
|
rawMediaTypes = configRawMediaTypes conf `union` [MTOctetStream, MTTextPlain, MTTextXML]
|
||||||
rawContentTypes AppConfig{..} =
|
|
||||||
(ContentType.decodeContentType <$> configRawMediaTypes) `union` [CTOctetStream, CTTextPlain]
|
|
||||||
|
|
||||||
{-|
|
{-|
|
||||||
Search a pg procedure by its parameters. Since a function can be overloaded, the name is not enough to find it.
|
Search a pg proc by matching name and arguments keys to parameters. Since a function can be overloaded,
|
||||||
An overloaded function can have a different volatility or even a different return type.
|
the name is not enough to find it. An overloaded function can have a different volatility or even a different return type.
|
||||||
-}
|
-}
|
||||||
findProc :: QualifiedIdentifier -> S.Set Text -> Bool -> ProcsMap -> Either ApiRequestError ProcDescription
|
findProc :: QualifiedIdentifier -> S.Set Text -> Bool -> ProcsMap -> MediaType -> Bool -> Either ApiRequestError ProcDescription
|
||||||
findProc qi payloadKeys paramsAsSingleObject allProcs =
|
findProc qi argumentsKeys paramsAsSingleObject allProcs contentMediaType isInvPost =
|
||||||
case bestMatch of
|
case matchProc of
|
||||||
[] -> Left $ NoRpc (qiSchema qi) (qiName qi) (S.toList payloadKeys) paramsAsSingleObject
|
([], []) -> Left $ NoRpc (qiSchema qi) (qiName qi) (S.toList argumentsKeys) paramsAsSingleObject contentMediaType isInvPost
|
||||||
[proc] -> Right proc
|
-- If there are no functions with named arguments, fallback to the single unnamed argument function
|
||||||
procs -> Left $ AmbiguousRpc (toList procs)
|
([], [proc]) -> Right proc
|
||||||
|
([], procs) -> Left $ AmbiguousRpc (toList procs)
|
||||||
|
-- Matches the functions with named arguments
|
||||||
|
([proc], _) -> Right proc
|
||||||
|
(procs, _) -> Left $ AmbiguousRpc (toList procs)
|
||||||
where
|
where
|
||||||
bestMatch =
|
matchProc = overloadedProcPartition $ HM.lookupDefault mempty qi allProcs -- first find the proc by name
|
||||||
case M.lookup qi allProcs of
|
-- The partition obtained has the form (overloadedProcs,fallbackProcs)
|
||||||
Nothing -> []
|
-- where fallbackProcs are functions with a single unnamed parameter
|
||||||
Just [proc] -> [proc | matches proc]
|
overloadedProcPartition = foldr select ([],[])
|
||||||
Just procs -> filter matches procs
|
select proc ~(ts,fs)
|
||||||
-- Find the exact arguments match
|
| matchesParams proc = (proc:ts,fs)
|
||||||
matches proc
|
| hasSingleUnnamedParam proc = (ts,proc:fs)
|
||||||
| paramsAsSingleObject = case pdArgs proc of
|
| otherwise = (ts,fs)
|
||||||
[arg] -> pgaType arg `elem` ["json", "jsonb"]
|
-- If the function is called with post and has a single unnamed parameter
|
||||||
_ -> False
|
-- it can be called depending on content type and the parameter type
|
||||||
| otherwise = case pdArgs proc of
|
hasSingleUnnamedParam ProcDescription{pdParams=[ProcParam{ppType}]} = isInvPost && case (contentMediaType, ppType) of
|
||||||
[] -> null payloadKeys
|
(MTApplicationJSON, "json") -> True
|
||||||
args -> matchesArg args
|
(MTApplicationJSON, "jsonb") -> True
|
||||||
matchesArg args =
|
(MTTextPlain, "text") -> True
|
||||||
-- The function's required arguments are separated from the ones with a default value assigned.
|
(MTTextXML, "xml") -> True
|
||||||
-- The set of names of those arguments is compared to the set of keys supplied by the client
|
(MTOctetStream, "bytea") -> True
|
||||||
-- 1. If only required arguments are found, the keys must be exactly the same as those arguments
|
_ -> False
|
||||||
-- 2. If only optional arguments are found, the keys must be a subset of those arguments
|
hasSingleUnnamedParam _ = False
|
||||||
-- 3. If both required and optional arguments are found, the result of taking away the optional arguments
|
matchesParams proc =
|
||||||
-- from the keys must be exactly the same as the required arguments
|
let
|
||||||
case L.partition pgaReq args of
|
params = pdParams proc
|
||||||
(reqArgs, []) -> payloadKeys == S.fromList (pgaName <$> reqArgs)
|
firstType = (ppType <$> headMay params)
|
||||||
([], defArgs) -> payloadKeys `S.isSubsetOf` S.fromList (pgaName <$> defArgs)
|
in
|
||||||
(reqArgs, defArgs) -> payloadKeys `S.difference` S.fromList (pgaName <$> defArgs) == S.fromList (pgaName <$> reqArgs)
|
-- exceptional case for Prefer: params=single-object
|
||||||
|
if paramsAsSingleObject
|
||||||
|
then length params == 1 && (firstType == Just "json" || firstType == Just "jsonb")
|
||||||
|
-- If the function has no parameters, the arguments keys must be empty as well
|
||||||
|
else if null params
|
||||||
|
then null argumentsKeys && not (isInvPost && contentMediaType `elem` [MTOctetStream, MTTextPlain, MTTextXML])
|
||||||
|
-- A function has optional and required parameters. Optional parameters have a default value and
|
||||||
|
-- don't require arguments for the function to be executed, required parameters must have an argument present.
|
||||||
|
else case L.partition ppReq params of
|
||||||
|
-- If the function only has required parameters, the arguments keys must match those parameters
|
||||||
|
(reqParams, []) -> argumentsKeys == S.fromList (ppName <$> reqParams)
|
||||||
|
-- If the function only has optional parameters, the arguments keys can match none or any of them(a subset)
|
||||||
|
([], optParams) -> argumentsKeys `S.isSubsetOf` S.fromList (ppName <$> optParams)
|
||||||
|
-- If the function has required and optional parameters, the arguments keys have to match the required parameters
|
||||||
|
-- and can match any or none of the default parameters.
|
||||||
|
(reqParams, optParams) -> argumentsKeys `S.difference` S.fromList (ppName <$> optParams) == S.fromList (ppName <$> reqParams)
|
||||||
|
|||||||
@@ -18,330 +18,339 @@ resource.
|
|||||||
module PostgREST.Request.DbRequestBuilder
|
module PostgREST.Request.DbRequestBuilder
|
||||||
( readRequest
|
( readRequest
|
||||||
, mutateRequest
|
, mutateRequest
|
||||||
, returningCols
|
, callRequest
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import qualified Data.HashMap.Strict as M
|
import qualified Data.HashMap.Strict as HM
|
||||||
import qualified Data.Set as S
|
import qualified Data.Set as S
|
||||||
|
|
||||||
import Control.Arrow ((***))
|
|
||||||
import Data.Either.Combinators (mapLeft)
|
import Data.Either.Combinators (mapLeft)
|
||||||
import Data.List (delete)
|
import Data.List (delete)
|
||||||
import Data.Text (isInfixOf)
|
|
||||||
import Data.Tree (Tree (..))
|
import Data.Tree (Tree (..))
|
||||||
|
|
||||||
import PostgREST.DbStructure.Identifiers (FieldName,
|
import PostgREST.DbStructure.Identifiers (FieldName,
|
||||||
QualifiedIdentifier (..),
|
QualifiedIdentifier (..),
|
||||||
Schema, TableName)
|
Schema, TableName)
|
||||||
|
import PostgREST.DbStructure.Proc (ProcDescription (..),
|
||||||
|
ProcParam (..),
|
||||||
|
procReturnsScalar)
|
||||||
import PostgREST.DbStructure.Relationship (Cardinality (..),
|
import PostgREST.DbStructure.Relationship (Cardinality (..),
|
||||||
Junction (..),
|
Junction (..),
|
||||||
Relationship (..))
|
Relationship (..),
|
||||||
import PostgREST.DbStructure.Table (Column (..), Table (..),
|
RelationshipsMap)
|
||||||
tableQi)
|
import PostgREST.Error (Error (..))
|
||||||
import PostgREST.Error (ApiRequestError (..),
|
|
||||||
Error (..))
|
|
||||||
import PostgREST.Query.SqlFragment (sourceCTEName)
|
import PostgREST.Query.SqlFragment (sourceCTEName)
|
||||||
import PostgREST.RangeQuery (NonnegRange, allRange,
|
import PostgREST.RangeQuery (NonnegRange, allRange,
|
||||||
restrictRange)
|
restrictRange)
|
||||||
import PostgREST.Request.ApiRequest (Action (..),
|
import PostgREST.Request.ApiRequest (Action (..),
|
||||||
ApiRequest (..),
|
ApiRequest (..),
|
||||||
PayloadJSON (..))
|
InvokeMethod (..),
|
||||||
|
Mutation (..),
|
||||||
|
Payload (..))
|
||||||
|
|
||||||
import PostgREST.Request.Parsers
|
import PostgREST.Request.MutateQuery
|
||||||
import PostgREST.Request.Preferences
|
import PostgREST.Request.Preferences
|
||||||
|
import PostgREST.Request.ReadQuery as ReadQuery
|
||||||
import PostgREST.Request.Types
|
import PostgREST.Request.Types
|
||||||
|
|
||||||
import qualified PostgREST.DbStructure.Relationship as Relationship
|
import qualified PostgREST.Request.QueryParams as QueryParams
|
||||||
|
|
||||||
import Protolude hiding (from)
|
import Protolude hiding (from)
|
||||||
|
|
||||||
-- | Builds the ReadRequest tree on a number of stages.
|
-- | Builds the ReadRequest tree on a number of stages.
|
||||||
-- | Adds filters, order, limits on its respective nodes.
|
-- | Adds filters, order, limits on its respective nodes.
|
||||||
-- | Adds joins conditions obtained from resource embedding.
|
-- | Adds joins conditions obtained from resource embedding.
|
||||||
readRequest :: Schema -> TableName -> Maybe Integer -> [Relationship] -> ApiRequest -> Either Error ReadRequest
|
readRequest :: Schema -> TableName -> Maybe Integer -> RelationshipsMap -> ApiRequest -> Either Error ReadRequest
|
||||||
readRequest schema rootTableName maxRows allRels apiRequest =
|
readRequest schema rootTableName maxRows allRels apiRequest =
|
||||||
mapLeft ApiRequestError $
|
mapLeft ApiRequestError $
|
||||||
treeRestrictRange maxRows =<<
|
treeRestrictRange maxRows (iAction apiRequest) =<<
|
||||||
augmentRequestWithJoin schema rootRels =<<
|
augmentRequestWithJoin schema allRels =<<
|
||||||
(addFiltersOrdersRanges apiRequest . initReadRequest rootName =<< pRequestSelect sel)
|
addLogicTrees apiRequest =<<
|
||||||
|
addRanges apiRequest =<<
|
||||||
|
addOrders apiRequest =<<
|
||||||
|
addFilters apiRequest (initReadRequest rootName rootAlias qsSelect)
|
||||||
where
|
where
|
||||||
sel = fromMaybe "*" $ iSelect apiRequest -- default to all columns requested (SELECT *) for a non existent ?select querystring param
|
QueryParams.QueryParams{..} = iQueryParams apiRequest
|
||||||
(rootName, rootRels) = rootWithRels schema rootTableName allRels (iAction apiRequest)
|
(rootName, rootAlias) = case iAction apiRequest of
|
||||||
|
ActionRead _ -> (QualifiedIdentifier schema rootTableName, Nothing)
|
||||||
-- Get the root table name with its relationships according to the Action type.
|
-- the CTE we use for non-read cases has a sourceCTEName(see Statements.hs) as the WITH name so we use the table name as an alias so findRel can find the right relationship
|
||||||
-- This is done because of the shape of the final SQL Query. The mutation cases
|
_ -> (QualifiedIdentifier mempty $ decodeUtf8 sourceCTEName, Just rootTableName)
|
||||||
-- are wrapped in a WITH {sourceCTEName}(see Statements.hs). So we need a FROM
|
|
||||||
-- {sourceCTEName} instead of FROM {tableName}.
|
|
||||||
rootWithRels :: Schema -> TableName -> [Relationship] -> Action -> (QualifiedIdentifier, [Relationship])
|
|
||||||
rootWithRels schema rootTableName allRels action = case action of
|
|
||||||
ActionRead _ -> (QualifiedIdentifier schema rootTableName, allRels) -- normal read case
|
|
||||||
_ -> (QualifiedIdentifier mempty _sourceCTEName, mapMaybe toSourceRel allRels ++ allRels) -- mutation cases and calling proc
|
|
||||||
where
|
|
||||||
_sourceCTEName = decodeUtf8 sourceCTEName
|
|
||||||
-- To enable embedding in the sourceCTEName cases we need to replace the
|
|
||||||
-- foreign key tableName in the Relationship with {sourceCTEName}. This way
|
|
||||||
-- findRel can find relationships with sourceCTEName.
|
|
||||||
toSourceRel :: Relationship -> Maybe Relationship
|
|
||||||
toSourceRel r@Relationship{relTable=t}
|
|
||||||
| rootTableName == tableName t = Just $ r {relTable=t {tableName=_sourceCTEName}}
|
|
||||||
| otherwise = Nothing
|
|
||||||
|
|
||||||
-- Build the initial tree with a Depth attribute so when a self join occurs we
|
-- Build the initial tree with a Depth attribute so when a self join occurs we
|
||||||
-- can differentiate the parent and child tables by having an alias like
|
-- can differentiate the parent and child tables by having an alias like
|
||||||
-- "table_depth", this is related to
|
-- "table_depth", this is related to
|
||||||
-- http://github.com/PostgREST/postgrest/issues/987.
|
-- http://github.com/PostgREST/postgrest/issues/987.
|
||||||
initReadRequest :: QualifiedIdentifier -> [Tree SelectItem] -> ReadRequest
|
initReadRequest :: QualifiedIdentifier -> Maybe Alias -> [Tree SelectItem] -> ReadRequest
|
||||||
initReadRequest rootQi =
|
initReadRequest rootQi rootAlias =
|
||||||
foldr (treeEntry rootDepth) initial
|
foldr (treeEntry rootDepth) initial
|
||||||
where
|
where
|
||||||
rootDepth = 0
|
rootDepth = 0
|
||||||
rootSchema = qiSchema rootQi
|
rootSchema = qiSchema rootQi
|
||||||
rootName = qiName rootQi
|
rootName = qiName rootQi
|
||||||
initial = Node (Select [] rootQi Nothing [] [] [] [] allRange, (rootName, Nothing, Nothing, Nothing, rootDepth)) []
|
initial = Node (Select [] rootQi rootAlias [] [] [] allRange, (rootName, Nothing, Nothing, Nothing, Nothing, rootDepth)) []
|
||||||
treeEntry :: Depth -> Tree SelectItem -> ReadRequest -> ReadRequest
|
treeEntry :: Depth -> Tree SelectItem -> ReadRequest -> ReadRequest
|
||||||
treeEntry depth (Node fld@((fn, _),_,alias, embedHint) fldForest) (Node (q, i) rForest) =
|
treeEntry depth (Node fld@((fn, _),_,alias, hint, joinType) fldForest) (Node (q, i) rForest) =
|
||||||
let nxtDepth = succ depth in
|
let nxtDepth = succ depth in
|
||||||
case fldForest of
|
case fldForest of
|
||||||
[] -> Node (q {select=fld:select q}, i) rForest
|
[] -> Node (q {select=fld:select q}, i) rForest
|
||||||
_ -> Node (q, i) $
|
_ -> Node (q, i) $
|
||||||
foldr (treeEntry nxtDepth)
|
foldr (treeEntry nxtDepth)
|
||||||
(Node (Select [] (QualifiedIdentifier rootSchema fn) Nothing [] [] [] [] allRange,
|
(Node (Select [] (QualifiedIdentifier rootSchema fn) Nothing [] [] [] allRange,
|
||||||
(fn, Nothing, alias, embedHint, nxtDepth)) [])
|
(fn, Nothing, alias, hint, joinType, nxtDepth)) [])
|
||||||
fldForest:rForest
|
fldForest:rForest
|
||||||
|
|
||||||
-- | Enforces the `max-rows` config on the result
|
-- | Enforces the `max-rows` config on the result
|
||||||
treeRestrictRange :: Maybe Integer -> ReadRequest -> Either ApiRequestError ReadRequest
|
treeRestrictRange :: Maybe Integer -> Action -> ReadRequest -> Either ApiRequestError ReadRequest
|
||||||
treeRestrictRange maxRows request = pure $ nodeRestrictRange maxRows <$> request
|
treeRestrictRange _ (ActionMutate _) request = Right request
|
||||||
|
treeRestrictRange maxRows _ request = pure $ nodeRestrictRange maxRows <$> request
|
||||||
where
|
where
|
||||||
nodeRestrictRange :: Maybe Integer -> ReadNode -> ReadNode
|
nodeRestrictRange :: Maybe Integer -> ReadNode -> ReadNode
|
||||||
nodeRestrictRange m (q@Select {range_=r}, i) = (q{range_=restrictRange m r }, i)
|
nodeRestrictRange m (q@Select {range_=r}, i) = (q{range_=restrictRange m r }, i)
|
||||||
|
|
||||||
augmentRequestWithJoin :: Schema -> [Relationship] -> ReadRequest -> Either ApiRequestError ReadRequest
|
augmentRequestWithJoin :: Schema -> RelationshipsMap -> ReadRequest -> Either ApiRequestError ReadRequest
|
||||||
augmentRequestWithJoin schema allRels request =
|
augmentRequestWithJoin schema allRels request =
|
||||||
addRels schema allRels Nothing request
|
addJoinConditions Nothing <$> addRels schema allRels Nothing request
|
||||||
>>= addJoinConditions Nothing
|
|
||||||
|
|
||||||
addRels :: Schema -> [Relationship] -> Maybe ReadRequest -> ReadRequest -> Either ApiRequestError ReadRequest
|
addRels :: Schema -> RelationshipsMap -> Maybe ReadRequest -> ReadRequest -> Either ApiRequestError ReadRequest
|
||||||
addRels schema allRels parentNode (Node (query@Select{from=tbl}, (nodeName, _, alias, hint, depth)) forest) =
|
addRels schema allRels parentNode (Node (query@Select{from=tbl}, (nodeName, _, alias, hint, joinType, depth)) forest) =
|
||||||
case parentNode of
|
case parentNode of
|
||||||
Just (Node (Select{from=parentNodeQi}, _) _) ->
|
Just (Node (Select{from=parentNodeQi, fromAlias=aliasQi}, _) _) ->
|
||||||
let newFrom r = if qiName tbl == nodeName then tableQi (relForeignTable r) else tbl
|
let newFrom r = if qiName tbl == nodeName then relForeignTable r else tbl
|
||||||
newReadNode = (\r -> (query{from=newFrom r}, (nodeName, Just r, alias, Nothing, depth))) <$> rel
|
newReadNode = (\r ->
|
||||||
rel = findRel schema allRels (qiName parentNodeQi) nodeName hint
|
if not $ relIsSelf r -- add alias if self rel TODO consolidate aliasing in another function
|
||||||
|
then (query{from=newFrom r}, (nodeName, Just r, alias, hint, joinType, depth))
|
||||||
|
else (query{from=newFrom r, fromAlias=Just (qiName (newFrom r) <> "_" <> show depth)}, (nodeName, Just r, alias, hint, joinType, depth))
|
||||||
|
) <$> rel
|
||||||
|
origin = if depth == 1 -- Only on depth 1 we check if the root(depth 0) has an alias so the sourceCTEName alias can be found as a relationship
|
||||||
|
then fromMaybe (qiName parentNodeQi) aliasQi
|
||||||
|
else qiName parentNodeQi
|
||||||
|
rel = findRel schema allRels origin nodeName hint
|
||||||
in
|
in
|
||||||
Node <$> newReadNode <*> (updateForest . hush $ Node <$> newReadNode <*> pure forest)
|
Node <$> newReadNode <*> (updateForest . hush $ Node <$> newReadNode <*> pure forest)
|
||||||
_ ->
|
_ ->
|
||||||
let rn = (query, (nodeName, Nothing, alias, Nothing, depth)) in
|
let rn = (query, (nodeName, Nothing, alias, Nothing, joinType, depth)) in
|
||||||
Node rn <$> updateForest (Just $ Node rn forest)
|
Node rn <$> updateForest (Just $ Node rn forest)
|
||||||
where
|
where
|
||||||
updateForest :: Maybe ReadRequest -> Either ApiRequestError [ReadRequest]
|
updateForest :: Maybe ReadRequest -> Either ApiRequestError [ReadRequest]
|
||||||
updateForest rq = addRels schema allRels rq `traverse` forest
|
updateForest rq = addRels schema allRels rq `traverse` forest
|
||||||
|
|
||||||
|
-- applies aliasing to join conditions TODO refactor, this should go into the querybuilder module
|
||||||
|
addJoinConditions :: Maybe Alias -> ReadRequest -> ReadRequest
|
||||||
|
addJoinConditions _ (Node node@(Select{fromAlias=tblAlias}, (_, Nothing, _, _, _, _)) forest) = Node node (addJoinConditions tblAlias <$> forest)
|
||||||
|
addJoinConditions _ (Node node@(Select{fromAlias=tblAlias}, (_, Just ComputedRelationship{}, _, _, _, _)) forest) = Node node (addJoinConditions tblAlias <$> forest)
|
||||||
|
addJoinConditions previousAlias (Node (query@Select{fromAlias=tblAlias}, nodeProps@(_, Just (Relationship QualifiedIdentifier{qiSchema=tSchema, qiName=tN} QualifiedIdentifier{qiName=ftN} _ card _ _), _, _, _, _)) forest) =
|
||||||
|
Node (query{joinConditions=joinConds}, nodeProps) (addJoinConditions tblAlias <$> forest)
|
||||||
|
where
|
||||||
|
joinConds =
|
||||||
|
case card of
|
||||||
|
M2M (Junction QualifiedIdentifier{qiName=jtn} _ _ jcols1 jcols2) ->
|
||||||
|
(toJoinCondition Nothing Nothing ftN jtn <$> jcols2) ++ (toJoinCondition previousAlias tblAlias tN jtn <$> jcols1)
|
||||||
|
O2M _ cols ->
|
||||||
|
toJoinCondition previousAlias tblAlias tN ftN <$> cols
|
||||||
|
M2O _ cols ->
|
||||||
|
toJoinCondition previousAlias tblAlias tN ftN <$> cols
|
||||||
|
O2O _ cols ->
|
||||||
|
toJoinCondition previousAlias tblAlias tN ftN <$> cols
|
||||||
|
toJoinCondition :: Maybe Alias -> Maybe Alias -> Text -> Text -> (FieldName, FieldName) -> JoinCondition
|
||||||
|
toJoinCondition prAl newAl tb ftb (c, fc) =
|
||||||
|
let qi1 = QualifiedIdentifier tSchema ftb
|
||||||
|
qi2 = QualifiedIdentifier tSchema tb in
|
||||||
|
JoinCondition (maybe qi1 (QualifiedIdentifier mempty) newAl, fc)
|
||||||
|
(maybe qi2 (QualifiedIdentifier mempty) prAl, c)
|
||||||
|
|
||||||
-- Finds a relationship between an origin and a target in the request:
|
-- Finds a relationship between an origin and a target in the request:
|
||||||
-- /origin?select=target(*) If more than one relationship is found then the
|
-- /origin?select=target(*) If more than one relationship is found then the
|
||||||
-- request is ambiguous and we return an error. In that case the request can
|
-- request is ambiguous and we return an error. In that case the request can
|
||||||
-- be disambiguated by adding precision to the target or by using a hint:
|
-- be disambiguated by adding precision to the target or by using a hint:
|
||||||
-- /origin?select=target!hint(*) The elements will be matched according to
|
-- /origin?select=target!hint(*). The origin can be a table or view.
|
||||||
-- these rules:
|
findRel :: Schema -> RelationshipsMap -> NodeName -> NodeName -> Maybe Hint -> Either ApiRequestError Relationship
|
||||||
-- origin = table / view
|
|
||||||
-- target = table / view / constraint / column-from-origin
|
|
||||||
-- hint = table / view / constraint / column-from-origin / column-from-target
|
|
||||||
-- (hint can take table / view values to aid in finding the junction in an m2m relationship)
|
|
||||||
findRel :: Schema -> [Relationship] -> NodeName -> NodeName -> Maybe EmbedHint -> Either ApiRequestError Relationship
|
|
||||||
findRel schema allRels origin target hint =
|
findRel schema allRels origin target hint =
|
||||||
case rel of
|
case rels of
|
||||||
[] -> Left $ NoRelBetween origin target
|
[] -> Left $ NoRelBetween origin target schema
|
||||||
[r] -> Right r
|
[r] -> Right r
|
||||||
-- Here we handle a self reference relationship to not cause a breaking
|
rs -> Left $ AmbiguousRelBetween origin target rs
|
||||||
-- change: In a self reference we get two relationships with the same
|
|
||||||
-- foreign key and relTable/relFtable but with different
|
|
||||||
-- cardinalities(m2o/o2m) We output the O2M rel, the M2O rel can be
|
|
||||||
-- obtained by using the origin column as an embed hint.
|
|
||||||
rs@[rel0, rel1] -> case (relCardinality rel0, relCardinality rel1, relTable rel0 == relTable rel1 && relForeignTable rel0 == relForeignTable rel1) of
|
|
||||||
(O2M cons1, M2O cons2, True) -> if cons1 == cons2 then Right rel0 else Left $ AmbiguousRelBetween origin target rs
|
|
||||||
(M2O cons1, O2M cons2, True) -> if cons1 == cons2 then Right rel1 else Left $ AmbiguousRelBetween origin target rs
|
|
||||||
_ -> Left $ AmbiguousRelBetween origin target rs
|
|
||||||
rs -> Left $ AmbiguousRelBetween origin target rs
|
|
||||||
where
|
where
|
||||||
matchFKSingleCol hint_ cols = length cols == 1 && hint_ == (colName <$> head cols)
|
matchFKSingleCol hint_ card = case card of
|
||||||
|
O2M _ [(col, _)] -> hint_ == col
|
||||||
|
M2O _ [(col, _)] -> hint_ == col
|
||||||
|
O2O _ [(col, _)] -> hint_ == col
|
||||||
|
_ -> False
|
||||||
|
matchFKRefSingleCol hint_ card = case card of
|
||||||
|
O2M _ [(_, fCol)] -> hint_ == fCol
|
||||||
|
M2O _ [(_, fCol)] -> hint_ == fCol
|
||||||
|
O2O _ [(_, fCol)] -> hint_ == fCol
|
||||||
|
_ -> False
|
||||||
matchConstraint tar card = case card of
|
matchConstraint tar card = case card of
|
||||||
O2M cons -> tar == Just cons
|
O2M cons _ -> tar == cons
|
||||||
M2O cons -> tar == Just cons
|
M2O cons _ -> tar == cons
|
||||||
_ -> False
|
O2O cons _ -> tar == cons
|
||||||
|
_ -> False
|
||||||
matchJunction hint_ card = case card of
|
matchJunction hint_ card = case card of
|
||||||
M2M Junction{junTable} -> hint_ == Just (tableName junTable)
|
M2M Junction{junTable} -> hint_ == qiName junTable
|
||||||
_ -> False
|
_ -> False
|
||||||
rel = filter (
|
isM2O card = case card of
|
||||||
\Relationship{..} ->
|
M2O _ _ -> True
|
||||||
-- Both relationship ends need to be on the exposed schema
|
_ -> False
|
||||||
schema == tableSchema relTable && schema == tableSchema relForeignTable &&
|
isO2M card = case card of
|
||||||
(
|
O2M _ _ -> True
|
||||||
-- /projects?select=clients(*)
|
_ -> False
|
||||||
origin == tableName relTable && -- projects
|
rels = filter (\case
|
||||||
target == tableName relForeignTable || -- clients
|
ComputedRelationship{relFunction} -> target == qiName relFunction
|
||||||
|
Relationship{..} ->
|
||||||
|
-- In a self-relationship we have a single foreign key but two relationships with different cardinalities: M2O/O2M. For disambiguation, we use the convention of getting:
|
||||||
|
-- TODO: handle one-to-one and many-to-many self-relationships
|
||||||
|
if relIsSelf
|
||||||
|
then case hint of
|
||||||
|
Nothing ->
|
||||||
|
-- The O2M by using the table name in the target
|
||||||
|
target == qiName relForeignTable && isO2M relCardinality -- /family_tree?select=children:family_tree(*)
|
||||||
|
||
|
||||||
|
-- The M2O by using the column name in the target
|
||||||
|
matchFKSingleCol target relCardinality && isM2O relCardinality -- /family_tree?select=parent(*)
|
||||||
|
Just hnt ->
|
||||||
|
-- /organizations?select=auditees:organizations!auditor(*)
|
||||||
|
target == qiName relForeignTable && isO2M relCardinality
|
||||||
|
&& matchFKRefSingleCol hnt relCardinality -- auditor
|
||||||
|
else case hint of
|
||||||
|
-- target = table / view / constraint / column-from-origin (constraint/column-from-origin can only come from tables https://github.com/PostgREST/postgrest/issues/2277)
|
||||||
|
-- hint = table / view / constraint / column-from-origin / column-from-target (hint can take table / view values to aid in finding the junction in an m2m relationship)
|
||||||
|
Nothing ->
|
||||||
|
-- /projects?select=clients(*)
|
||||||
|
target == qiName relForeignTable -- clients
|
||||||
|
||
|
||||||
|
-- /projects?select=projects_client_id_fkey(*)
|
||||||
|
matchConstraint target relCardinality -- projects_client_id_fkey
|
||||||
|
&& not relFTableIsView
|
||||||
|
||
|
||||||
|
-- /projects?select=client_id(*)
|
||||||
|
matchFKSingleCol target relCardinality -- client_id
|
||||||
|
&& not relFTableIsView
|
||||||
|
Just hnt ->
|
||||||
|
-- /projects?select=clients(*)
|
||||||
|
target == qiName relForeignTable -- clients
|
||||||
|
&& (
|
||||||
|
-- /projects?select=clients!projects_client_id_fkey(*)
|
||||||
|
matchConstraint hnt relCardinality || -- projects_client_id_fkey
|
||||||
|
|
||||||
-- /projects?select=projects_client_id_fkey(*)
|
-- /projects?select=clients!client_id(*) or /projects?select=clients!id(*)
|
||||||
(
|
matchFKSingleCol hnt relCardinality || -- client_id
|
||||||
origin == tableName relTable && -- projects
|
matchFKRefSingleCol hnt relCardinality || -- id
|
||||||
matchConstraint (Just target) relCardinality -- projects_client_id_fkey
|
|
||||||
) ||
|
|
||||||
-- /projects?select=client_id(*)
|
|
||||||
(
|
|
||||||
origin == tableName relTable && -- projects
|
|
||||||
matchFKSingleCol (Just target) relColumns -- client_id
|
|
||||||
)
|
|
||||||
) && (
|
|
||||||
isNothing hint || -- hint is optional
|
|
||||||
|
|
||||||
-- /projects?select=clients!projects_client_id_fkey(*)
|
-- /users?select=tasks!users_tasks(*) many-to-many between users and tasks
|
||||||
matchConstraint hint relCardinality || -- projects_client_id_fkey
|
matchJunction hnt relCardinality -- users_tasks
|
||||||
|
)
|
||||||
|
) $ fromMaybe mempty $ HM.lookup (QualifiedIdentifier schema origin, schema) allRels
|
||||||
|
|
||||||
-- /projects?select=clients!client_id(*) or /projects?select=clients!id(*)
|
addFilters :: ApiRequest -> ReadRequest -> Either ApiRequestError ReadRequest
|
||||||
matchFKSingleCol hint relColumns || -- client_id
|
addFilters ApiRequest{..} rReq =
|
||||||
matchFKSingleCol hint relForeignColumns || -- id
|
foldr addFilterToNode (Right rReq) flts
|
||||||
|
|
||||||
-- /users?select=tasks!users_tasks(*) many-to-many between users and tasks
|
|
||||||
matchJunction hint relCardinality -- users_tasks
|
|
||||||
)
|
|
||||||
) allRels
|
|
||||||
|
|
||||||
-- previousAlias is only used for the case of self joins
|
|
||||||
addJoinConditions :: Maybe Alias -> ReadRequest -> Either ApiRequestError ReadRequest
|
|
||||||
addJoinConditions previousAlias (Node node@(query@Select{from=tbl}, nodeProps@(_, rel, _, _, depth)) forest) =
|
|
||||||
case rel of
|
|
||||||
Just r@Relationship{relCardinality=M2M Junction{junTable}} ->
|
|
||||||
let rq = augmentQuery r in
|
|
||||||
Node (rq{implicitJoins=tableQi junTable:implicitJoins rq}, nodeProps) <$> updatedForest
|
|
||||||
Just r -> Node (augmentQuery r, nodeProps) <$> updatedForest
|
|
||||||
Nothing -> Node node <$> updatedForest
|
|
||||||
where
|
where
|
||||||
newAlias = case Relationship.isSelfReference <$> rel of
|
QueryParams.QueryParams{..} = iQueryParams
|
||||||
Just True
|
flts =
|
||||||
| depth /= 0 -> Just (qiName tbl <> "_" <> show depth) -- root node doesn't get aliased
|
case iAction of
|
||||||
| otherwise -> Nothing
|
ActionInvoke InvGet -> qsFilters
|
||||||
_ -> Nothing
|
ActionInvoke InvHead -> qsFilters
|
||||||
augmentQuery r =
|
ActionInvoke _ -> qsFilters
|
||||||
foldr
|
ActionRead _ -> qsFilters
|
||||||
(\jc rq@Select{joinConditions=jcs} -> rq{joinConditions=jc:jcs})
|
_ -> qsFiltersNotRoot
|
||||||
query{fromAlias=newAlias}
|
|
||||||
(getJoinConditions previousAlias newAlias r)
|
|
||||||
updatedForest = addJoinConditions newAlias `traverse` forest
|
|
||||||
|
|
||||||
-- previousAlias and newAlias are used in the case of self joins
|
addFilterToNode :: (EmbedPath, Filter) -> Either ApiRequestError ReadRequest -> Either ApiRequestError ReadRequest
|
||||||
getJoinConditions :: Maybe Alias -> Maybe Alias -> Relationship -> [JoinCondition]
|
addFilterToNode =
|
||||||
getJoinConditions previousAlias newAlias (Relationship Table{tableSchema=tSchema, tableName=tN} cols Table{tableName=ftN} fCols card) =
|
updateNode (\flt (Node (q@Select {where_=lf}, i) f) -> Node (q{ReadQuery.where_=addFilterToLogicForest flt lf}, i) f)
|
||||||
case card of
|
|
||||||
M2M (Junction Table{tableName=jtn} _ jc1 _ jc2) ->
|
addOrders :: ApiRequest -> ReadRequest -> Either ApiRequestError ReadRequest
|
||||||
zipWith (toJoinCondition tN jtn) cols jc1 ++ zipWith (toJoinCondition ftN jtn) fCols jc2
|
addOrders ApiRequest{..} rReq =
|
||||||
_ ->
|
case iAction of
|
||||||
zipWith (toJoinCondition tN ftN) cols fCols
|
ActionMutate _ -> Right rReq
|
||||||
|
_ -> foldr addOrderToNode (Right rReq) qsOrder
|
||||||
where
|
where
|
||||||
toJoinCondition :: Text -> Text -> Column -> Column -> JoinCondition
|
QueryParams.QueryParams{..} = iQueryParams
|
||||||
toJoinCondition tb ftb c fc =
|
|
||||||
let qi1 = removeSourceCTESchema tSchema tb
|
|
||||||
qi2 = removeSourceCTESchema tSchema ftb in
|
|
||||||
JoinCondition (maybe qi1 (QualifiedIdentifier mempty) previousAlias, colName c)
|
|
||||||
(maybe qi2 (QualifiedIdentifier mempty) newAlias, colName fc)
|
|
||||||
|
|
||||||
-- On mutation and calling proc cases we wrap the target table in a WITH
|
addOrderToNode :: (EmbedPath, [OrderTerm]) -> Either ApiRequestError ReadRequest -> Either ApiRequestError ReadRequest
|
||||||
-- {sourceCTEName} if this happens remove the schema `FROM
|
addOrderToNode = updateNode (\o (Node (q,i) f) -> Node (q{order=o}, i) f)
|
||||||
-- "schema"."{sourceCTEName}"` and use only the `FROM "{sourceCTEName}"`.
|
|
||||||
-- If the schema remains the FROM would be invalid.
|
|
||||||
removeSourceCTESchema :: Schema -> TableName -> QualifiedIdentifier
|
|
||||||
removeSourceCTESchema schema tbl = QualifiedIdentifier (if tbl == decodeUtf8 sourceCTEName then mempty else schema) tbl
|
|
||||||
|
|
||||||
addFiltersOrdersRanges :: ApiRequest -> ReadRequest -> Either ApiRequestError ReadRequest
|
addRanges :: ApiRequest -> ReadRequest -> Either ApiRequestError ReadRequest
|
||||||
addFiltersOrdersRanges apiRequest rReq = do
|
addRanges ApiRequest{..} rReq =
|
||||||
rFlts <- foldr addFilter rReq <$> filters
|
case iAction of
|
||||||
rOrds <- foldr addOrder rFlts <$> orders
|
ActionMutate _ -> Right rReq
|
||||||
rRngs <- foldr addRange rOrds <$> ranges
|
_ -> foldr addRangeToNode (Right rReq) =<< ranges
|
||||||
foldr addLogicTree rRngs <$> logicForest
|
|
||||||
where
|
where
|
||||||
filters :: Either ApiRequestError [(EmbedPath, Filter)]
|
|
||||||
filters = pRequestFilter `traverse` flts
|
|
||||||
orders :: Either ApiRequestError [(EmbedPath, [OrderTerm])]
|
|
||||||
orders = pRequestOrder `traverse` iOrder apiRequest
|
|
||||||
ranges :: Either ApiRequestError [(EmbedPath, NonnegRange)]
|
ranges :: Either ApiRequestError [(EmbedPath, NonnegRange)]
|
||||||
ranges = pRequestRange `traverse` M.toList (iRange apiRequest)
|
ranges = first QueryParamError $ QueryParams.pRequestRange `traverse` HM.toList iRange
|
||||||
logicForest :: Either ApiRequestError [(EmbedPath, LogicTree)]
|
|
||||||
logicForest = pRequestLogicTree `traverse` logFrst
|
|
||||||
action = iAction apiRequest
|
|
||||||
-- there can be no filters on the root table when we are doing insert/update/delete
|
|
||||||
(flts, logFrst) =
|
|
||||||
case action of
|
|
||||||
ActionInvoke _ -> (iFilters apiRequest, iLogic apiRequest)
|
|
||||||
ActionRead _ -> (iFilters apiRequest, iLogic apiRequest)
|
|
||||||
_ -> join (***) (filter (( "." `isInfixOf` ) . fst)) (iFilters apiRequest, iLogic apiRequest)
|
|
||||||
|
|
||||||
addFilterToNode :: Filter -> ReadRequest -> ReadRequest
|
addRangeToNode :: (EmbedPath, NonnegRange) -> Either ApiRequestError ReadRequest -> Either ApiRequestError ReadRequest
|
||||||
addFilterToNode flt (Node (q@Select {where_=lf}, i) f) = Node (q{where_=addFilterToLogicForest flt lf}::ReadQuery, i) f
|
addRangeToNode = updateNode (\r (Node (q,i) f) -> Node (q{range_=r}, i) f)
|
||||||
|
|
||||||
addFilter :: (EmbedPath, Filter) -> ReadRequest -> ReadRequest
|
addLogicTrees :: ApiRequest -> ReadRequest -> Either ApiRequestError ReadRequest
|
||||||
addFilter = addProperty addFilterToNode
|
addLogicTrees ApiRequest{..} rReq =
|
||||||
|
foldr addLogicTreeToNode (Right rReq) qsLogic
|
||||||
addOrderToNode :: [OrderTerm] -> ReadRequest -> ReadRequest
|
|
||||||
addOrderToNode o (Node (q,i) f) = Node (q{order=o}, i) f
|
|
||||||
|
|
||||||
addOrder :: (EmbedPath, [OrderTerm]) -> ReadRequest -> ReadRequest
|
|
||||||
addOrder = addProperty addOrderToNode
|
|
||||||
|
|
||||||
addRangeToNode :: NonnegRange -> ReadRequest -> ReadRequest
|
|
||||||
addRangeToNode r (Node (q,i) f) = Node (q{range_=r}, i) f
|
|
||||||
|
|
||||||
addRange :: (EmbedPath, NonnegRange) -> ReadRequest -> ReadRequest
|
|
||||||
addRange = addProperty addRangeToNode
|
|
||||||
|
|
||||||
addLogicTreeToNode :: LogicTree -> ReadRequest -> ReadRequest
|
|
||||||
addLogicTreeToNode t (Node (q@Select{where_=lf},i) f) = Node (q{where_=t:lf}::ReadQuery, i) f
|
|
||||||
|
|
||||||
addLogicTree :: (EmbedPath, LogicTree) -> ReadRequest -> ReadRequest
|
|
||||||
addLogicTree = addProperty addLogicTreeToNode
|
|
||||||
|
|
||||||
addProperty :: (a -> ReadRequest -> ReadRequest) -> (EmbedPath, a) -> ReadRequest -> ReadRequest
|
|
||||||
addProperty f ([], a) rr = f a rr
|
|
||||||
addProperty f (targetNodeName:remainingPath, a) (Node rn forest) =
|
|
||||||
case pathNode of
|
|
||||||
Nothing -> Node rn forest -- the property is silenty dropped in the Request does not contain the required path
|
|
||||||
Just tn -> Node rn (addProperty f (remainingPath, a) tn:delete tn forest)
|
|
||||||
where
|
where
|
||||||
pathNode = find (\(Node (_,(nodeName,_,alias,_,_)) _) -> nodeName == targetNodeName || alias == Just targetNodeName) forest
|
QueryParams.QueryParams{..} = iQueryParams
|
||||||
|
|
||||||
mutateRequest :: Schema -> TableName -> ApiRequest -> [FieldName] -> ReadRequest -> Either Error MutateRequest
|
addLogicTreeToNode :: (EmbedPath, LogicTree) -> Either ApiRequestError ReadRequest -> Either ApiRequestError ReadRequest
|
||||||
mutateRequest schema tName apiRequest pkCols readReq = mapLeft ApiRequestError $
|
addLogicTreeToNode = updateNode (\t (Node (q@Select{where_=lf},i) f) -> Node (q{ReadQuery.where_=t:lf}, i) f)
|
||||||
case action of
|
|
||||||
ActionCreate -> do
|
-- Find a Node of the Tree and apply a function to it
|
||||||
confCols <- case iOnConflict apiRequest of
|
updateNode :: (a -> ReadRequest -> ReadRequest) -> (EmbedPath, a) -> Either ApiRequestError ReadRequest -> Either ApiRequestError ReadRequest
|
||||||
Nothing -> pure pkCols
|
updateNode f ([], a) rr = f a <$> rr
|
||||||
Just param -> pRequestOnConflict param
|
updateNode _ _ (Left e) = Left e
|
||||||
pure $ Insert qi (iColumns apiRequest) body ((,) <$> iPreferResolution apiRequest <*> Just confCols) [] returnings
|
updateNode f (targetNodeName:remainingPath, a) (Right (Node rootNode forest)) =
|
||||||
ActionUpdate -> Update qi (iColumns apiRequest) body <$> combinedLogic <*> pure returnings
|
case findNode of
|
||||||
ActionSingleUpsert ->
|
Nothing -> Left $ NotEmbedded targetNodeName
|
||||||
(\flts ->
|
Just target ->
|
||||||
if null (iLogic apiRequest) &&
|
(\node -> Node rootNode $ node : delete target forest) <$>
|
||||||
S.fromList (fst <$> iFilters apiRequest) == S.fromList pkCols &&
|
updateNode f (remainingPath, a) (Right target)
|
||||||
|
where
|
||||||
|
findNode :: Maybe ReadRequest
|
||||||
|
findNode = find (\(Node (_,(nodeName,_,alias,_,_, _)) _) -> nodeName == targetNodeName || alias == Just targetNodeName) forest
|
||||||
|
|
||||||
|
mutateRequest :: Mutation -> Schema -> TableName -> ApiRequest -> [FieldName] -> ReadRequest -> Either Error MutateRequest
|
||||||
|
mutateRequest mutation schema tName ApiRequest{..} pkCols readReq = mapLeft ApiRequestError $
|
||||||
|
case mutation of
|
||||||
|
MutationCreate ->
|
||||||
|
Right $ Insert qi iColumns body ((,) <$> iPreferResolution <*> Just confCols) [] returnings
|
||||||
|
MutationUpdate -> Right $ Update qi iColumns body combinedLogic iTopLevelRange rootOrder returnings
|
||||||
|
MutationSingleUpsert ->
|
||||||
|
if null qsLogic &&
|
||||||
|
qsFilterFields == S.fromList pkCols &&
|
||||||
not (null (S.fromList pkCols)) &&
|
not (null (S.fromList pkCols)) &&
|
||||||
all (\case
|
all (\case
|
||||||
Filter _ (OpExpr False (Op "eq" _)) -> True
|
Filter _ (OpExpr False (Op OpEqual _)) -> True
|
||||||
_ -> False) flts
|
_ -> False) qsFiltersRoot
|
||||||
then Insert qi (iColumns apiRequest) body (Just (MergeDuplicates, pkCols)) <$> combinedLogic <*> pure returnings
|
then Right $ Insert qi iColumns body (Just (MergeDuplicates, pkCols)) combinedLogic returnings
|
||||||
else
|
else
|
||||||
Left InvalidFilters) =<< filters
|
Left InvalidFilters
|
||||||
ActionDelete -> Delete qi <$> combinedLogic <*> pure returnings
|
MutationDelete -> Right $ Delete qi combinedLogic iTopLevelRange rootOrder returnings
|
||||||
_ -> Left UnsupportedVerb
|
|
||||||
where
|
where
|
||||||
|
confCols = fromMaybe pkCols qsOnConflict
|
||||||
|
QueryParams.QueryParams{..} = iQueryParams
|
||||||
qi = QualifiedIdentifier schema tName
|
qi = QualifiedIdentifier schema tName
|
||||||
action = iAction apiRequest
|
|
||||||
returnings =
|
returnings =
|
||||||
if iPreferRepresentation apiRequest == None
|
if iPreferRepresentation == None
|
||||||
then []
|
then []
|
||||||
else returningCols readReq pkCols
|
else returningCols readReq pkCols
|
||||||
filters = map snd <$> pRequestFilter `traverse` mutateFilters
|
logic = map snd qsLogic
|
||||||
logic = map snd <$> pRequestLogicTree `traverse` logicFilters
|
rootOrder = maybe [] snd $ find (\(x, _) -> null x) qsOrder
|
||||||
combinedLogic = foldr addFilterToLogicForest <$> logic <*> filters
|
combinedLogic = foldr addFilterToLogicForest logic qsFiltersRoot
|
||||||
-- update/delete filters can be only on the root table
|
body = payRaw <$> iPayload -- the body is assumed to be json at this stage(ApiRequest validates)
|
||||||
(mutateFilters, logicFilters) = join (***) onlyRoot (iFilters apiRequest, iLogic apiRequest)
|
|
||||||
onlyRoot = filter (not . ( "." `isInfixOf` ) . fst)
|
callRequest :: ProcDescription -> ApiRequest -> ReadRequest -> CallRequest
|
||||||
body = pjRaw <$> iPayload apiRequest
|
callRequest proc apiReq readReq = FunctionCall {
|
||||||
|
funCQi = QualifiedIdentifier (pdSchema proc) (pdName proc)
|
||||||
|
, funCParams = callParams
|
||||||
|
, funCArgs = payRaw <$> iPayload apiReq
|
||||||
|
, funCScalar = procReturnsScalar proc
|
||||||
|
, funCMultipleCall = iPreferParameters apiReq == Just MultipleObjects
|
||||||
|
, funCReturning = returningCols readReq []
|
||||||
|
}
|
||||||
|
where
|
||||||
|
paramsAsSingleObject = iPreferParameters apiReq == Just SingleObject
|
||||||
|
callParams = case pdParams proc of
|
||||||
|
[prm] | paramsAsSingleObject -> OnePosParam prm
|
||||||
|
| ppName prm == mempty -> OnePosParam prm
|
||||||
|
| otherwise -> KeyParams $ specifiedParams [prm]
|
||||||
|
prms -> KeyParams $ specifiedParams prms
|
||||||
|
specifiedParams = filter (\x -> ppName x `S.member` iColumns apiReq)
|
||||||
|
|
||||||
returningCols :: ReadRequest -> [FieldName] -> [FieldName]
|
returningCols :: ReadRequest -> [FieldName] -> [FieldName]
|
||||||
returningCols rr@(Node _ forest) pkCols
|
returningCols rr@(Node _ forest) pkCols
|
||||||
@@ -358,9 +367,16 @@ returningCols rr@(Node _ forest) pkCols
|
|||||||
-- projects. So this adds the foreign key columns to ensure the embedding
|
-- projects. So this adds the foreign key columns to ensure the embedding
|
||||||
-- succeeds, result would be `RETURNING name, client_id`.
|
-- succeeds, result would be `RETURNING name, client_id`.
|
||||||
fkCols = concat $ mapMaybe (\case
|
fkCols = concat $ mapMaybe (\case
|
||||||
Node (_, (_, Just Relationship{relColumns=cols}, _, _, _)) _ -> Just cols
|
Node (_, (_, Just Relationship{relCardinality=O2M _ cols}, _, _, _, _)) _ -> Just $ fst <$> cols
|
||||||
|
Node (_, (_, Just Relationship{relCardinality=M2O _ cols}, _, _, _, _)) _ -> Just $ fst <$> cols
|
||||||
|
Node (_, (_, Just Relationship{relCardinality=O2O _ cols}, _, _, _, _)) _ -> Just $ fst <$> cols
|
||||||
|
Node (_, (_, Just Relationship{relCardinality=M2M Junction{junColumns1, junColumns2}}, _, _, _, _)) _ -> Just $ (fst <$> junColumns1) ++ (fst <$> junColumns2)
|
||||||
_ -> Nothing
|
_ -> Nothing
|
||||||
) forest
|
) forest
|
||||||
|
hasComputedRel = isJust $ find (\case
|
||||||
|
Node (_, (_, Just ComputedRelationship{}, _, _, _, _)) _ -> True
|
||||||
|
_ -> False
|
||||||
|
) forest
|
||||||
-- However if the "client_id" is present, e.g. mutateRequest to
|
-- However if the "client_id" is present, e.g. mutateRequest to
|
||||||
-- /projects?select=client_id,name,clients(name) we would get `RETURNING
|
-- /projects?select=client_id,name,clients(name) we would get `RETURNING
|
||||||
-- client_id, name, client_id` and then we would produce the "column
|
-- client_id, name, client_id` and then we would produce the "column
|
||||||
@@ -368,7 +384,10 @@ returningCols rr@(Node _ forest) pkCols
|
|||||||
-- deduplicate with Set: We are adding the primary key columns as well to
|
-- deduplicate with Set: We are adding the primary key columns as well to
|
||||||
-- make sure, that a proper location header can always be built for
|
-- make sure, that a proper location header can always be built for
|
||||||
-- INSERT/POST
|
-- INSERT/POST
|
||||||
returnings = S.toList . S.fromList $ fldNames ++ (colName <$> fkCols) ++ pkCols
|
returnings =
|
||||||
|
if not hasComputedRel
|
||||||
|
then S.toList . S.fromList $ fldNames ++ fkCols ++ pkCols
|
||||||
|
else ["*"] -- on computed relationships we cannot know the required columns for an embedding to succeed, so we just return all
|
||||||
|
|
||||||
-- Traditional filters(e.g. id=eq.1) are added as root nodes of the LogicTree
|
-- Traditional filters(e.g. id=eq.1) are added as root nodes of the LogicTree
|
||||||
-- they are later concatenated with AND in the QueryBuilder
|
-- they are later concatenated with AND in the QueryBuilder
|
||||||
|
|||||||
@@ -0,0 +1,44 @@
|
|||||||
|
module PostgREST.Request.MutateQuery
|
||||||
|
( MutateQuery(..)
|
||||||
|
, MutateRequest
|
||||||
|
)
|
||||||
|
where
|
||||||
|
|
||||||
|
import qualified Data.ByteString.Lazy as LBS
|
||||||
|
import qualified Data.Set as S
|
||||||
|
|
||||||
|
import PostgREST.DbStructure.Identifiers (FieldName,
|
||||||
|
QualifiedIdentifier)
|
||||||
|
import PostgREST.RangeQuery (NonnegRange)
|
||||||
|
import PostgREST.Request.Preferences (PreferResolution)
|
||||||
|
import PostgREST.Request.Types (LogicTree, OrderTerm)
|
||||||
|
|
||||||
|
import Protolude
|
||||||
|
|
||||||
|
type MutateRequest = MutateQuery
|
||||||
|
|
||||||
|
data MutateQuery
|
||||||
|
= Insert
|
||||||
|
{ in_ :: QualifiedIdentifier
|
||||||
|
, insCols :: S.Set FieldName
|
||||||
|
, insBody :: Maybe LBS.ByteString
|
||||||
|
, onConflict :: Maybe (PreferResolution, [FieldName])
|
||||||
|
, where_ :: [LogicTree]
|
||||||
|
, returning :: [FieldName]
|
||||||
|
}
|
||||||
|
| Update
|
||||||
|
{ in_ :: QualifiedIdentifier
|
||||||
|
, updCols :: S.Set FieldName
|
||||||
|
, updBody :: Maybe LBS.ByteString
|
||||||
|
, where_ :: [LogicTree]
|
||||||
|
, mutRange :: NonnegRange
|
||||||
|
, mutOrder :: [OrderTerm]
|
||||||
|
, returning :: [FieldName]
|
||||||
|
}
|
||||||
|
| Delete
|
||||||
|
{ in_ :: QualifiedIdentifier
|
||||||
|
, where_ :: [LogicTree]
|
||||||
|
, mutRange :: NonnegRange
|
||||||
|
, mutOrder :: [OrderTerm]
|
||||||
|
, returning :: [FieldName]
|
||||||
|
}
|
||||||
@@ -1,276 +0,0 @@
|
|||||||
{-|
|
|
||||||
Module : PostgREST.Request.Parsers
|
|
||||||
Description : PostgREST parser combinators
|
|
||||||
|
|
||||||
This module is in charge of parsing all the querystring values in an url, e.g. the select, id, order in `/projects?select=id,name&id=eq.1&order=id,name.desc`.
|
|
||||||
-}
|
|
||||||
module PostgREST.Request.Parsers
|
|
||||||
( pColumns
|
|
||||||
, pLogicPath
|
|
||||||
, pLogicSingleVal
|
|
||||||
, pLogicTree
|
|
||||||
, pOrder
|
|
||||||
, pOrderTerm
|
|
||||||
, pRequestColumns
|
|
||||||
, pRequestFilter
|
|
||||||
, pRequestLogicTree
|
|
||||||
, pRequestOnConflict
|
|
||||||
, pRequestOrder
|
|
||||||
, pRequestRange
|
|
||||||
, pRequestSelect
|
|
||||||
, pSingleVal
|
|
||||||
, pTreePath
|
|
||||||
) where
|
|
||||||
|
|
||||||
import qualified Data.HashMap.Strict as M
|
|
||||||
import qualified Data.Set as S
|
|
||||||
|
|
||||||
import Data.Either.Combinators (mapLeft)
|
|
||||||
import Data.Foldable (foldl1)
|
|
||||||
import Data.List (init, last)
|
|
||||||
import Data.Text (intercalate, replace, strip)
|
|
||||||
import Data.Tree (Tree (..))
|
|
||||||
import Text.Parsec.Error (errorMessages,
|
|
||||||
showErrorMessages)
|
|
||||||
import Text.ParserCombinators.Parsec (GenParser, ParseError, Parser,
|
|
||||||
anyChar, between, char, digit,
|
|
||||||
eof, errorPos, letter,
|
|
||||||
lookAhead, many1, noneOf,
|
|
||||||
notFollowedBy, oneOf, option,
|
|
||||||
optionMaybe, parse, sepBy1,
|
|
||||||
string, try, (<?>))
|
|
||||||
|
|
||||||
import PostgREST.DbStructure.Identifiers (FieldName)
|
|
||||||
import PostgREST.Error (ApiRequestError (ParseRequestError))
|
|
||||||
import PostgREST.Query.SqlFragment (ftsOperators, operators)
|
|
||||||
import PostgREST.RangeQuery (NonnegRange)
|
|
||||||
|
|
||||||
import PostgREST.Request.Types
|
|
||||||
|
|
||||||
import Protolude hiding (intercalate, option, replace, toS, try)
|
|
||||||
import Protolude.Conv (toS)
|
|
||||||
|
|
||||||
pRequestSelect :: Text -> Either ApiRequestError [Tree SelectItem]
|
|
||||||
pRequestSelect selStr =
|
|
||||||
mapError $ parse pFieldForest ("failed to parse select parameter (" <> toS selStr <> ")") (toS selStr)
|
|
||||||
|
|
||||||
pRequestOnConflict :: Text -> Either ApiRequestError [FieldName]
|
|
||||||
pRequestOnConflict oncStr =
|
|
||||||
mapError $ parse pColumns ("failed to parse on_conflict parameter (" <> toS oncStr <> ")") (toS oncStr)
|
|
||||||
|
|
||||||
pRequestFilter :: (Text, Text) -> Either ApiRequestError (EmbedPath, Filter)
|
|
||||||
pRequestFilter (k, v) = mapError $ (,) <$> path <*> (Filter <$> fld <*> oper)
|
|
||||||
where
|
|
||||||
treePath = parse pTreePath ("failed to parser tree path (" ++ toS k ++ ")") $ toS k
|
|
||||||
oper = parse (pOpExpr pSingleVal) ("failed to parse filter (" ++ toS v ++ ")") $ toS v
|
|
||||||
path = fst <$> treePath
|
|
||||||
fld = snd <$> treePath
|
|
||||||
|
|
||||||
pRequestOrder :: (Text, Text) -> Either ApiRequestError (EmbedPath, [OrderTerm])
|
|
||||||
pRequestOrder (k, v) = mapError $ (,) <$> path <*> ord'
|
|
||||||
where
|
|
||||||
treePath = parse pTreePath ("failed to parser tree path (" ++ toS k ++ ")") $ toS k
|
|
||||||
path = fst <$> treePath
|
|
||||||
ord' = parse pOrder ("failed to parse order (" ++ toS v ++ ")") $ toS v
|
|
||||||
|
|
||||||
pRequestRange :: (ByteString, NonnegRange) -> Either ApiRequestError (EmbedPath, NonnegRange)
|
|
||||||
pRequestRange (k, v) = mapError $ (,) <$> path <*> pure v
|
|
||||||
where
|
|
||||||
treePath = parse pTreePath ("failed to parser tree path (" ++ toS k ++ ")") $ toS k
|
|
||||||
path = fst <$> treePath
|
|
||||||
|
|
||||||
pRequestLogicTree :: (Text, Text) -> Either ApiRequestError (EmbedPath, LogicTree)
|
|
||||||
pRequestLogicTree (k, v) = mapError $ (,) <$> embedPath <*> logicTree
|
|
||||||
where
|
|
||||||
path = parse pLogicPath ("failed to parser logic path (" ++ toS k ++ ")") $ toS k
|
|
||||||
embedPath = fst <$> path
|
|
||||||
logicTree = do
|
|
||||||
op <- snd <$> path
|
|
||||||
-- Concat op and v to make pLogicTree argument regular,
|
|
||||||
-- in the form of "?and=and(.. , ..)" instead of "?and=(.. , ..)"
|
|
||||||
parse pLogicTree ("failed to parse logic tree (" ++ toS v ++ ")") $ toS (op <> v)
|
|
||||||
|
|
||||||
pRequestColumns :: Maybe Text -> Either ApiRequestError (Maybe (S.Set FieldName))
|
|
||||||
pRequestColumns colStr =
|
|
||||||
case colStr of
|
|
||||||
Just str ->
|
|
||||||
mapError $ Just . S.fromList <$> parse pColumns ("failed to parse columns parameter (" <> toS str <> ")") (toS str)
|
|
||||||
_ -> Right Nothing
|
|
||||||
|
|
||||||
ws :: Parser Text
|
|
||||||
ws = toS <$> many (oneOf " \t")
|
|
||||||
|
|
||||||
lexeme :: Parser a -> Parser a
|
|
||||||
lexeme p = ws *> p <* ws
|
|
||||||
|
|
||||||
pTreePath :: Parser (EmbedPath, Field)
|
|
||||||
pTreePath = do
|
|
||||||
p <- pFieldName `sepBy1` pDelimiter
|
|
||||||
jp <- option [] pJsonPath
|
|
||||||
return (init p, (last p, jp))
|
|
||||||
|
|
||||||
pFieldForest :: Parser [Tree SelectItem]
|
|
||||||
pFieldForest = pFieldTree `sepBy1` lexeme (char ',')
|
|
||||||
where
|
|
||||||
pFieldTree :: Parser (Tree SelectItem)
|
|
||||||
pFieldTree = try (Node <$> pRelationSelect <*> between (char '(') (char ')') pFieldForest) <|>
|
|
||||||
Node <$> pFieldSelect <*> pure []
|
|
||||||
|
|
||||||
pStar :: Parser Text
|
|
||||||
pStar = toS <$> (string "*" $> ("*"::ByteString))
|
|
||||||
|
|
||||||
pFieldName :: Parser Text
|
|
||||||
pFieldName =
|
|
||||||
pQuotedValue <|>
|
|
||||||
intercalate "-" . map toS <$> (many1 (letter <|> digit <|> oneOf "_ ") `sepBy1` dash) <?>
|
|
||||||
"field name (* or [a..z0..9_])"
|
|
||||||
where
|
|
||||||
isDash :: GenParser Char st ()
|
|
||||||
isDash = try ( char '-' >> notFollowedBy (char '>') )
|
|
||||||
dash :: Parser Char
|
|
||||||
dash = isDash $> '-'
|
|
||||||
|
|
||||||
pJsonPath :: Parser JsonPath
|
|
||||||
pJsonPath = many pJsonOperation
|
|
||||||
where
|
|
||||||
pJsonOperation :: Parser JsonOperation
|
|
||||||
pJsonOperation = pJsonArrow <*> pJsonOperand
|
|
||||||
|
|
||||||
pJsonArrow =
|
|
||||||
try (string "->>" $> J2Arrow) <|>
|
|
||||||
try (string "->" $> JArrow)
|
|
||||||
|
|
||||||
pJsonOperand =
|
|
||||||
let pJKey = JKey . toS <$> pFieldName
|
|
||||||
pJIdx = JIdx . toS <$> ((:) <$> option '+' (char '-') <*> many1 digit) <* pEnd
|
|
||||||
pEnd = try (void $ lookAhead (string "->")) <|>
|
|
||||||
try (void $ lookAhead (string "::")) <|>
|
|
||||||
try eof in
|
|
||||||
try pJIdx <|> try pJKey
|
|
||||||
|
|
||||||
pField :: Parser Field
|
|
||||||
pField = lexeme $ (,) <$> pFieldName <*> option [] pJsonPath
|
|
||||||
|
|
||||||
aliasSeparator :: Parser ()
|
|
||||||
aliasSeparator = char ':' >> notFollowedBy (char ':')
|
|
||||||
|
|
||||||
pRelationSelect :: Parser SelectItem
|
|
||||||
pRelationSelect = lexeme $ try ( do
|
|
||||||
alias <- optionMaybe ( try(pFieldName <* aliasSeparator) )
|
|
||||||
fld <- pField
|
|
||||||
hint <- optionMaybe (
|
|
||||||
try ( char '!' *> pFieldName) <|>
|
|
||||||
-- deprecated, remove in next major version
|
|
||||||
try ( char '.' *> pFieldName)
|
|
||||||
)
|
|
||||||
return (fld, Nothing, alias, hint)
|
|
||||||
)
|
|
||||||
|
|
||||||
pFieldSelect :: Parser SelectItem
|
|
||||||
pFieldSelect = lexeme $
|
|
||||||
try (
|
|
||||||
do
|
|
||||||
alias <- optionMaybe ( try(pFieldName <* aliasSeparator) )
|
|
||||||
fld <- pField
|
|
||||||
cast' <- optionMaybe (string "::" *> many letter)
|
|
||||||
return (fld, toS <$> cast', alias, Nothing)
|
|
||||||
)
|
|
||||||
<|> do
|
|
||||||
s <- pStar
|
|
||||||
return ((s, []), Nothing, Nothing, Nothing)
|
|
||||||
|
|
||||||
pOpExpr :: Parser SingleVal -> Parser OpExpr
|
|
||||||
pOpExpr pSVal = try ( string "not" *> pDelimiter *> (OpExpr True <$> pOperation)) <|> OpExpr False <$> pOperation
|
|
||||||
where
|
|
||||||
pOperation :: Parser Operation
|
|
||||||
pOperation =
|
|
||||||
Op . toS <$> foldl1 (<|>) (try . ((<* pDelimiter) . string) . toS <$> M.keys ops) <*> pSVal
|
|
||||||
<|> In <$> (try (string "in" *> pDelimiter) *> pListVal)
|
|
||||||
<|> pFts
|
|
||||||
<?> "operator (eq, gt, ...)"
|
|
||||||
|
|
||||||
pFts = do
|
|
||||||
op <- foldl1 (<|>) (try . string . toS <$> ftsOps)
|
|
||||||
lang <- optionMaybe $ try (between (char '(') (char ')') (many (letter <|> digit <|> oneOf "_")))
|
|
||||||
pDelimiter >> Fts (toS op) (toS <$> lang) <$> pSVal
|
|
||||||
|
|
||||||
ops = M.filterWithKey (const . flip notElem ("in":ftsOps)) operators
|
|
||||||
ftsOps = M.keys ftsOperators
|
|
||||||
|
|
||||||
pSingleVal :: Parser SingleVal
|
|
||||||
pSingleVal = toS <$> many anyChar
|
|
||||||
|
|
||||||
pListVal :: Parser ListVal
|
|
||||||
pListVal = lexeme (char '(') *> pListElement `sepBy1` char ',' <* lexeme (char ')')
|
|
||||||
|
|
||||||
pListElement :: Parser Text
|
|
||||||
pListElement = try (pQuotedValue <* notFollowedBy (noneOf ",)")) <|> (toS <$> many (noneOf ",)"))
|
|
||||||
|
|
||||||
pQuotedValue :: Parser Text
|
|
||||||
pQuotedValue = toS <$> (char '"' *> many (noneOf "\"") <* char '"')
|
|
||||||
|
|
||||||
pDelimiter :: Parser Char
|
|
||||||
pDelimiter = char '.' <?> "delimiter (.)"
|
|
||||||
|
|
||||||
pOrder :: Parser [OrderTerm]
|
|
||||||
pOrder = lexeme pOrderTerm `sepBy1` char ','
|
|
||||||
|
|
||||||
pOrderTerm :: Parser OrderTerm
|
|
||||||
pOrderTerm = do
|
|
||||||
fld <- pField
|
|
||||||
dir <- optionMaybe $
|
|
||||||
try (pDelimiter *> string "asc" $> OrderAsc) <|>
|
|
||||||
try (pDelimiter *> string "desc" $> OrderDesc)
|
|
||||||
nls <- optionMaybe pNulls <* pEnd <|>
|
|
||||||
pEnd $> Nothing
|
|
||||||
return $ OrderTerm fld dir nls
|
|
||||||
where
|
|
||||||
pNulls = try (pDelimiter *> string "nullsfirst" $> OrderNullsFirst) <|>
|
|
||||||
try (pDelimiter *> string "nullslast" $> OrderNullsLast)
|
|
||||||
pEnd = try (void $ lookAhead (char ',')) <|>
|
|
||||||
try eof
|
|
||||||
|
|
||||||
pLogicTree :: Parser LogicTree
|
|
||||||
pLogicTree = Stmnt <$> try pLogicFilter
|
|
||||||
<|> Expr <$> pNot <*> pLogicOp <*> (lexeme (char '(') *> pLogicTree `sepBy1` lexeme (char ',') <* lexeme (char ')'))
|
|
||||||
where
|
|
||||||
pLogicFilter :: Parser Filter
|
|
||||||
pLogicFilter = Filter <$> pField <* pDelimiter <*> pOpExpr pLogicSingleVal
|
|
||||||
pNot :: Parser Bool
|
|
||||||
pNot = try (string "not" *> pDelimiter $> True)
|
|
||||||
<|> pure False
|
|
||||||
<?> "negation operator (not)"
|
|
||||||
pLogicOp :: Parser LogicOperator
|
|
||||||
pLogicOp = try (string "and" $> And)
|
|
||||||
<|> string "or" $> Or
|
|
||||||
<?> "logic operator (and, or)"
|
|
||||||
|
|
||||||
pLogicSingleVal :: Parser SingleVal
|
|
||||||
pLogicSingleVal = try (pQuotedValue <* notFollowedBy (noneOf ",)")) <|> try pPgArray <|> (toS <$> many (noneOf ",)"))
|
|
||||||
where
|
|
||||||
pPgArray :: Parser Text
|
|
||||||
pPgArray = do
|
|
||||||
a <- string "{"
|
|
||||||
b <- many (noneOf "{}")
|
|
||||||
c <- string "}"
|
|
||||||
pure (toS $ a ++ b ++ c)
|
|
||||||
|
|
||||||
pLogicPath :: Parser (EmbedPath, Text)
|
|
||||||
pLogicPath = do
|
|
||||||
path <- pFieldName `sepBy1` pDelimiter
|
|
||||||
let op = last path
|
|
||||||
notOp = "not." <> op
|
|
||||||
return (filter (/= "not") (init path), if "not" `elem` path then notOp else op)
|
|
||||||
|
|
||||||
pColumns :: Parser [FieldName]
|
|
||||||
pColumns = pFieldName `sepBy1` lexeme (char ',')
|
|
||||||
|
|
||||||
mapError :: Either ParseError a -> Either ApiRequestError a
|
|
||||||
mapError = mapLeft translateError
|
|
||||||
where
|
|
||||||
translateError e =
|
|
||||||
ParseRequestError message details
|
|
||||||
where
|
|
||||||
message = show $ errorPos e
|
|
||||||
details = strip $ replace "\n" " " $ toS
|
|
||||||
$ showErrorMessages "or" "unknown parse error" "expecting" "unexpected" "end of input" (errorMessages e)
|
|
||||||
@@ -1,54 +1,200 @@
|
|||||||
module PostgREST.Request.Preferences where
|
-- |
|
||||||
|
-- Module: PostgREST.Request.Preferences
|
||||||
|
-- Description: Track client preferences to be employed when processing requests
|
||||||
|
--
|
||||||
|
-- Track client prefences set in HTTP 'Prefer' headers according to RFC7240[1].
|
||||||
|
--
|
||||||
|
-- [1] https://datatracker.ietf.org/doc/html/rfc7240
|
||||||
|
--
|
||||||
|
module PostgREST.Request.Preferences
|
||||||
|
( Preferences(..)
|
||||||
|
, PreferCount(..)
|
||||||
|
, PreferParameters(..)
|
||||||
|
, PreferRepresentation(..)
|
||||||
|
, PreferResolution(..)
|
||||||
|
, PreferTransaction(..)
|
||||||
|
, fromHeaders
|
||||||
|
, ToAppliedHeader(..)
|
||||||
|
) where
|
||||||
|
|
||||||
|
import qualified Data.ByteString.Char8 as BS
|
||||||
|
import qualified Data.Map as Map
|
||||||
|
import qualified Network.HTTP.Types.Header as HTTP
|
||||||
|
|
||||||
import GHC.Show
|
|
||||||
import Protolude
|
import Protolude
|
||||||
|
|
||||||
|
|
||||||
|
-- $setup
|
||||||
|
-- Setup for doctests
|
||||||
|
-- >>> import Text.Pretty.Simple (pPrint)
|
||||||
|
-- >>> deriving instance Show PreferResolution
|
||||||
|
-- >>> deriving instance Show PreferRepresentation
|
||||||
|
-- >>> deriving instance Show PreferParameters
|
||||||
|
-- >>> deriving instance Show PreferCount
|
||||||
|
-- >>> deriving instance Show PreferTransaction
|
||||||
|
-- >>> deriving instance Show Preferences
|
||||||
|
|
||||||
|
-- | Preferences recognized by the application.
|
||||||
|
data Preferences
|
||||||
|
= Preferences
|
||||||
|
{ preferResolution :: Maybe PreferResolution
|
||||||
|
, preferRepresentation :: Maybe PreferRepresentation
|
||||||
|
, preferParameters :: Maybe PreferParameters
|
||||||
|
, preferCount :: Maybe PreferCount
|
||||||
|
, preferTransaction :: Maybe PreferTransaction
|
||||||
|
}
|
||||||
|
|
||||||
|
-- |
|
||||||
|
-- Parse HTTP headers based on RFC7240[1] to identify preferences.
|
||||||
|
--
|
||||||
|
-- One header with comma-separated values can be used to set multiple preferences:
|
||||||
|
--
|
||||||
|
-- >>> pPrint $ fromHeaders [("Prefer", "resolution=ignore-duplicates, count=exact")]
|
||||||
|
-- Preferences
|
||||||
|
-- { preferResolution = Just IgnoreDuplicates
|
||||||
|
-- , preferRepresentation = Nothing
|
||||||
|
-- , preferParameters = Nothing
|
||||||
|
-- , preferCount = Just ExactCount
|
||||||
|
-- , preferTransaction = Nothing
|
||||||
|
-- }
|
||||||
|
--
|
||||||
|
-- Multiple headers can also be used:
|
||||||
|
--
|
||||||
|
-- >>> pPrint $ fromHeaders [("Prefer", "resolution=ignore-duplicates"), ("Prefer", "count=exact")]
|
||||||
|
-- Preferences
|
||||||
|
-- { preferResolution = Just IgnoreDuplicates
|
||||||
|
-- , preferRepresentation = Nothing
|
||||||
|
-- , preferParameters = Nothing
|
||||||
|
-- , preferCount = Just ExactCount
|
||||||
|
-- , preferTransaction = Nothing
|
||||||
|
-- }
|
||||||
|
--
|
||||||
|
-- If a preference is set more than once, only the first is used:
|
||||||
|
--
|
||||||
|
-- >>> preferTransaction $ fromHeaders [("Prefer", "tx=commit, tx=rollback")]
|
||||||
|
-- Just Commit
|
||||||
|
--
|
||||||
|
-- This is also the case across multiple headers:
|
||||||
|
--
|
||||||
|
-- >>> :{
|
||||||
|
-- preferResolution . fromHeaders $
|
||||||
|
-- [ ("Prefer", "resolution=ignore-duplicates")
|
||||||
|
-- , ("Prefer", "resolution=merge-duplicates")
|
||||||
|
-- ]
|
||||||
|
-- :}
|
||||||
|
-- Just IgnoreDuplicates
|
||||||
|
--
|
||||||
|
-- Preferences not recognized by the application are ignored:
|
||||||
|
--
|
||||||
|
-- >>> preferResolution $ fromHeaders [("Prefer", "resolution=foo")]
|
||||||
|
-- Nothing
|
||||||
|
--
|
||||||
|
-- Preferences can be separated by arbitrary amounts of space, lower-case header is also recognized:
|
||||||
|
--
|
||||||
|
-- >>> pPrint $ fromHeaders [("prefer", "count=exact, tx=commit ,return=minimal")]
|
||||||
|
-- Preferences
|
||||||
|
-- { preferResolution = Nothing
|
||||||
|
-- , preferRepresentation = Just None
|
||||||
|
-- , preferParameters = Nothing
|
||||||
|
-- , preferCount = Just ExactCount
|
||||||
|
-- , preferTransaction = Just Commit
|
||||||
|
-- }
|
||||||
|
--
|
||||||
|
fromHeaders :: [HTTP.Header] -> Preferences
|
||||||
|
fromHeaders headers =
|
||||||
|
Preferences
|
||||||
|
{ preferResolution = parsePrefs [MergeDuplicates, IgnoreDuplicates]
|
||||||
|
, preferRepresentation = parsePrefs [Full, None, HeadersOnly]
|
||||||
|
, preferParameters = parsePrefs [SingleObject, MultipleObjects]
|
||||||
|
, preferCount = parsePrefs [ExactCount, PlannedCount, EstimatedCount]
|
||||||
|
, preferTransaction = parsePrefs [Commit, Rollback]
|
||||||
|
}
|
||||||
|
where
|
||||||
|
prefHeaders = filter ((==) HTTP.hPrefer . fst) headers
|
||||||
|
prefs = fmap BS.strip . concatMap (BS.split ',' . snd) $ prefHeaders
|
||||||
|
|
||||||
|
parsePrefs :: ToHeaderValue a => [a] -> Maybe a
|
||||||
|
parsePrefs vals =
|
||||||
|
head $ mapMaybe (flip Map.lookup $ prefMap vals) prefs
|
||||||
|
|
||||||
|
prefMap :: ToHeaderValue a => [a] -> Map.Map ByteString a
|
||||||
|
prefMap = Map.fromList . fmap (\pref -> (toHeaderValue pref, pref))
|
||||||
|
|
||||||
|
-- |
|
||||||
|
-- Convert a preference into the value that we look for in the 'Prefer' headers.
|
||||||
|
--
|
||||||
|
-- >>> toHeaderValue MergeDuplicates
|
||||||
|
-- "resolution=merge-duplicates"
|
||||||
|
--
|
||||||
|
class ToHeaderValue a where
|
||||||
|
toHeaderValue :: a -> ByteString
|
||||||
|
|
||||||
|
-- |
|
||||||
|
-- Header to indicate that a preference has been applied.
|
||||||
|
--
|
||||||
|
-- >>> toAppliedHeader MergeDuplicates
|
||||||
|
-- ("Preference-Applied","resolution=merge-duplicates")
|
||||||
|
--
|
||||||
|
class ToHeaderValue a => ToAppliedHeader a where
|
||||||
|
toAppliedHeader :: a -> HTTP.Header
|
||||||
|
toAppliedHeader x = (HTTP.hPreferenceApplied, toHeaderValue x)
|
||||||
|
|
||||||
|
-- | How to handle duplicate values.
|
||||||
data PreferResolution
|
data PreferResolution
|
||||||
= MergeDuplicates
|
= MergeDuplicates
|
||||||
| IgnoreDuplicates
|
| IgnoreDuplicates
|
||||||
|
|
||||||
instance Show PreferResolution where
|
instance ToHeaderValue PreferResolution where
|
||||||
show MergeDuplicates = "resolution=merge-duplicates"
|
toHeaderValue MergeDuplicates = "resolution=merge-duplicates"
|
||||||
show IgnoreDuplicates = "resolution=ignore-duplicates"
|
toHeaderValue IgnoreDuplicates = "resolution=ignore-duplicates"
|
||||||
|
|
||||||
-- | How to return the mutated data. From https://tools.ietf.org/html/rfc7240#section-4.2
|
instance ToAppliedHeader PreferResolution
|
||||||
|
|
||||||
|
-- |
|
||||||
|
-- How to return the mutated data.
|
||||||
|
--
|
||||||
|
-- From https://tools.ietf.org/html/rfc7240#section-4.2
|
||||||
data PreferRepresentation
|
data PreferRepresentation
|
||||||
= Full -- ^ Return the body plus the Location header(in case of POST).
|
= Full -- ^ Return the body.
|
||||||
| HeadersOnly -- ^ Return the Location header(in case of POST). This needs a SELECT privilege on the pk.
|
| HeadersOnly -- ^ Return the Location header(in case of POST). This needs a SELECT privilege on the pk.
|
||||||
| None -- ^ Return nothing from the mutated data.
|
| None -- ^ Return nothing from the mutated data.
|
||||||
deriving Eq
|
deriving Eq
|
||||||
|
|
||||||
instance Show PreferRepresentation where
|
instance ToHeaderValue PreferRepresentation where
|
||||||
show Full = "return=representation"
|
toHeaderValue Full = "return=representation"
|
||||||
show None = "return=minimal"
|
toHeaderValue None = "return=minimal"
|
||||||
show HeadersOnly = "return=headers-only"
|
toHeaderValue HeadersOnly = "return=headers-only"
|
||||||
|
|
||||||
|
-- | How to pass parameters to stored procedures.
|
||||||
data PreferParameters
|
data PreferParameters
|
||||||
= SingleObject -- ^ Pass all parameters as a single json object to a stored procedure
|
= SingleObject -- ^ Pass all parameters as a single json object to a stored procedure.
|
||||||
| MultipleObjects -- ^ Pass an array of json objects as params to a stored procedure
|
| MultipleObjects -- ^ Pass an array of json objects as params to a stored procedure.
|
||||||
deriving Eq
|
deriving Eq
|
||||||
|
|
||||||
instance Show PreferParameters where
|
instance ToHeaderValue PreferParameters where
|
||||||
show SingleObject = "params=single-object"
|
toHeaderValue SingleObject = "params=single-object"
|
||||||
show MultipleObjects = "params=multiple-objects"
|
toHeaderValue MultipleObjects = "params=multiple-objects"
|
||||||
|
|
||||||
|
-- | How to determine the count of (expected) results
|
||||||
data PreferCount
|
data PreferCount
|
||||||
= ExactCount -- ^ exact count(slower)
|
= ExactCount -- ^ Exact count (slower).
|
||||||
| PlannedCount -- ^ PostgreSQL query planner rows count guess. Done by using EXPLAIN {query}.
|
| PlannedCount -- ^ PostgreSQL query planner rows count guess. Done by using EXPLAIN {query}.
|
||||||
| EstimatedCount -- ^ use the query planner rows if the count is superior to max-rows, otherwise get the exact count.
|
| EstimatedCount -- ^ Use the query planner rows if the count is superior to max-rows, otherwise get the exact count.
|
||||||
deriving Eq
|
deriving Eq
|
||||||
|
|
||||||
instance Show PreferCount where
|
instance ToHeaderValue PreferCount where
|
||||||
show ExactCount = "count=exact"
|
toHeaderValue ExactCount = "count=exact"
|
||||||
show PlannedCount = "count=planned"
|
toHeaderValue PlannedCount = "count=planned"
|
||||||
show EstimatedCount = "count=estimated"
|
toHeaderValue EstimatedCount = "count=estimated"
|
||||||
|
|
||||||
|
-- | Whether to commit or roll back transactions.
|
||||||
data PreferTransaction
|
data PreferTransaction
|
||||||
= Commit -- Commit transaction - the default.
|
= Commit -- ^ Commit transaction - the default.
|
||||||
| Rollback -- Rollback transaction after sending the response - does not persist changes, e.g. for running tests.
|
| Rollback -- ^ Rollback transaction after sending the response - does not persist changes, e.g. for running tests.
|
||||||
deriving Eq
|
deriving Eq
|
||||||
|
|
||||||
instance Show PreferTransaction where
|
instance ToHeaderValue PreferTransaction where
|
||||||
show Commit = "tx=commit"
|
toHeaderValue Commit = "tx=commit"
|
||||||
show Rollback = "tx=rollback"
|
toHeaderValue Rollback = "tx=rollback"
|
||||||
|
|
||||||
|
instance ToAppliedHeader PreferTransaction
|
||||||
|
|||||||
@@ -0,0 +1,523 @@
|
|||||||
|
-- |
|
||||||
|
-- Module : PostgREST.Request.QueryParams
|
||||||
|
-- Description : Parser for PostgREST Query paramters
|
||||||
|
--
|
||||||
|
-- This module is in charge of parsing all the querystring values in an url, e.g.
|
||||||
|
-- the select, id, order in `/projects?select=id,name&id=eq.1&order=id,name.desc`.
|
||||||
|
{-# LANGUAGE LambdaCase #-}
|
||||||
|
{-# LANGUAGE TupleSections #-}
|
||||||
|
module PostgREST.Request.QueryParams
|
||||||
|
( parse
|
||||||
|
, QueryParams(..)
|
||||||
|
, pRequestRange
|
||||||
|
) where
|
||||||
|
|
||||||
|
import qualified Data.ByteString.Char8 as BS
|
||||||
|
import qualified Data.HashMap.Strict as HM
|
||||||
|
import qualified Data.List as L
|
||||||
|
import qualified Data.Set as S
|
||||||
|
import qualified Data.Text as T
|
||||||
|
import qualified Data.Text.Encoding as T
|
||||||
|
import qualified Network.HTTP.Base as HTTP
|
||||||
|
import qualified Network.HTTP.Types.URI as HTTP
|
||||||
|
import qualified Text.ParserCombinators.Parsec as P
|
||||||
|
|
||||||
|
import Control.Arrow ((***))
|
||||||
|
import Data.Either.Combinators (mapLeft)
|
||||||
|
import Data.List (init, last)
|
||||||
|
import Data.Ranged.Boundaries (Boundary (..))
|
||||||
|
import Data.Ranged.Ranges (Range (..))
|
||||||
|
import Data.Tree (Tree (..))
|
||||||
|
import Text.Parsec.Error (errorMessages,
|
||||||
|
showErrorMessages)
|
||||||
|
import Text.Parsec.Prim (parserFail)
|
||||||
|
import Text.ParserCombinators.Parsec (GenParser, ParseError, Parser,
|
||||||
|
anyChar, between, char, digit,
|
||||||
|
eof, errorPos, letter,
|
||||||
|
lookAhead, many1, noneOf,
|
||||||
|
notFollowedBy, oneOf,
|
||||||
|
optionMaybe, sepBy1, string,
|
||||||
|
try, (<?>))
|
||||||
|
|
||||||
|
import PostgREST.DbStructure.Identifiers (FieldName)
|
||||||
|
import PostgREST.RangeQuery (NonnegRange, allRange,
|
||||||
|
rangeGeq, rangeLimit,
|
||||||
|
rangeOffset, restrictRange)
|
||||||
|
|
||||||
|
import PostgREST.Request.ReadQuery (SelectItem)
|
||||||
|
import PostgREST.Request.Types (EmbedParam (..), EmbedPath, Field,
|
||||||
|
Filter (..), FtsOperator (..),
|
||||||
|
JoinType (..), JsonOperand (..),
|
||||||
|
JsonOperation (..), JsonPath,
|
||||||
|
ListVal, LogicOperator (..),
|
||||||
|
LogicTree (..), OpExpr (..),
|
||||||
|
Operation (..),
|
||||||
|
OrderDirection (..),
|
||||||
|
OrderNulls (..), OrderTerm (..),
|
||||||
|
QPError (..), SimpleOperator (..),
|
||||||
|
SingleVal, TrileanVal (..))
|
||||||
|
|
||||||
|
import Protolude hiding (try)
|
||||||
|
|
||||||
|
|
||||||
|
-- $setup
|
||||||
|
-- Setup for doctests
|
||||||
|
-- >>> import Text.Pretty.Simple (pPrint)
|
||||||
|
-- >>> deriving instance Show QPError
|
||||||
|
-- >>> deriving instance Show TrileanVal
|
||||||
|
-- >>> deriving instance Show FtsOperator
|
||||||
|
-- >>> deriving instance Show SimpleOperator
|
||||||
|
-- >>> deriving instance Show Operation
|
||||||
|
-- >>> deriving instance Show OpExpr
|
||||||
|
-- >>> deriving instance Show JsonOperand
|
||||||
|
-- >>> deriving instance Show JsonOperation
|
||||||
|
-- >>> deriving instance Show Filter
|
||||||
|
-- >>> deriving instance Show JoinType
|
||||||
|
|
||||||
|
data QueryParams =
|
||||||
|
QueryParams
|
||||||
|
{ qsCanonical :: ByteString
|
||||||
|
-- ^ Canonical representation of the query params, sorted alphabetically
|
||||||
|
, qsParams :: [(Text, Text)]
|
||||||
|
-- ^ Parameters for RPC calls
|
||||||
|
, qsRanges :: HM.HashMap Text (Range Integer)
|
||||||
|
-- ^ Ranges derived from &limit and &offset params
|
||||||
|
, qsOrder :: [(EmbedPath, [OrderTerm])]
|
||||||
|
-- ^ &order parameters for each level
|
||||||
|
, qsLogic :: [(EmbedPath, LogicTree)]
|
||||||
|
-- ^ &and and &or parameters used for complex boolean logic
|
||||||
|
, qsColumns :: Maybe (S.Set FieldName)
|
||||||
|
-- ^ &columns parameter and payload
|
||||||
|
, qsSelect :: [Tree SelectItem]
|
||||||
|
-- ^ &select parameter used to shape the response
|
||||||
|
, qsFilters :: [(EmbedPath, Filter)]
|
||||||
|
-- ^ Filters on the result from e.g. &id=e.10
|
||||||
|
, qsFiltersRoot :: [Filter]
|
||||||
|
-- ^ Subset of the filters that apply on the root table. These are used on UPDATE/DELETE.
|
||||||
|
, qsFiltersNotRoot :: [(EmbedPath, Filter)]
|
||||||
|
-- ^ Subset of the filters that do not apply on the root table
|
||||||
|
, qsFilterFields :: S.Set FieldName
|
||||||
|
-- ^ Set of fields that filters apply to
|
||||||
|
, qsOnConflict :: Maybe [FieldName]
|
||||||
|
-- ^ &on_conflict parameter used to upsert on specific unique keys
|
||||||
|
}
|
||||||
|
|
||||||
|
-- |
|
||||||
|
-- Parse query parameters from a query string like "id=eq.1&select=name".
|
||||||
|
--
|
||||||
|
-- The canonical representation of the query string has paramters sorted alphabetically:
|
||||||
|
--
|
||||||
|
-- >>> qsCanonical <$> parse "a=1&c=3&b=2&d"
|
||||||
|
-- Right "a=1&b=2&c=3&d="
|
||||||
|
--
|
||||||
|
-- 'select' is a reserved parameter that selects the fields to be returned:
|
||||||
|
--
|
||||||
|
-- >>> qsSelect <$> parse "select=name,location"
|
||||||
|
-- Right [Node {rootLabel = (("name",[]),Nothing,Nothing,Nothing,Nothing), subForest = []},Node {rootLabel = (("location",[]),Nothing,Nothing,Nothing,Nothing), subForest = []}]
|
||||||
|
--
|
||||||
|
-- Filters are parameters whose value contains an operator, separated by a '.' from its value:
|
||||||
|
--
|
||||||
|
-- >>> qsFilters <$> parse "a.b=eq.0"
|
||||||
|
-- Right [(["a"],Filter {field = ("b",[]), opExpr = OpExpr False (Op OpEqual "0")})]
|
||||||
|
--
|
||||||
|
-- If the operator specified in a filter does not exist, parsing the query string fails:
|
||||||
|
--
|
||||||
|
-- >>> qsFilters <$> parse "a.b=noop.0"
|
||||||
|
-- Left (QPError "\"failed to parse filter (noop.0)\" (line 1, column 6)" "unknown single value operator noop")
|
||||||
|
parse :: ByteString -> Either QPError QueryParams
|
||||||
|
parse qs =
|
||||||
|
QueryParams
|
||||||
|
canonical
|
||||||
|
params
|
||||||
|
ranges
|
||||||
|
<$> pRequestOrder `traverse` order
|
||||||
|
<*> pRequestLogicTree `traverse` logic
|
||||||
|
<*> pRequestColumns columns
|
||||||
|
<*> pRequestSelect select
|
||||||
|
<*> pRequestFilter `traverse` filters
|
||||||
|
<*> (fmap snd <$> (pRequestFilter `traverse` filtersRoot))
|
||||||
|
<*> pRequestFilter `traverse` filtersNotRoot
|
||||||
|
<*> pure (S.fromList (fst <$> filters))
|
||||||
|
<*> sequenceA (pRequestOnConflict <$> onConflict)
|
||||||
|
where
|
||||||
|
logic = filter (endingIn ["and", "or"] . fst) nonemptyParams
|
||||||
|
select = fromMaybe "*" $ lookupParam "select"
|
||||||
|
onConflict = lookupParam "on_conflict"
|
||||||
|
columns = lookupParam "columns"
|
||||||
|
order = filter (endingIn ["order"] . fst) nonemptyParams
|
||||||
|
limits = filter (endingIn ["limit"] . fst) nonemptyParams
|
||||||
|
-- Replace .offset ending with .limit to be able to match those params later in a map
|
||||||
|
offsets = first (replaceLast "limit") <$> filter (endingIn ["offset"] . fst) nonemptyParams
|
||||||
|
lookupParam :: Text -> Maybe Text
|
||||||
|
lookupParam needle = toS <$> join (L.lookup needle qParams)
|
||||||
|
nonemptyParams = mapMaybe (\(k, v) -> (k,) <$> v) qParams
|
||||||
|
|
||||||
|
qString = HTTP.parseQueryReplacePlus True qs
|
||||||
|
|
||||||
|
qParams = [(T.decodeUtf8 k, T.decodeUtf8 <$> v)|(k,v) <- qString]
|
||||||
|
|
||||||
|
canonical =
|
||||||
|
BS.pack $ HTTP.urlEncodeVars
|
||||||
|
. L.sortOn fst
|
||||||
|
. map (join (***) BS.unpack . second (fromMaybe mempty))
|
||||||
|
$ qString
|
||||||
|
|
||||||
|
endingIn:: [Text] -> Text -> Bool
|
||||||
|
endingIn xx key = lastWord `elem` xx
|
||||||
|
where lastWord = L.last $ T.split (== '.') key
|
||||||
|
|
||||||
|
(filters, params) = L.partition isParam filtersAndParams
|
||||||
|
isParam (k, v) = isEmbedPath k || hasOperator v || hasFtsOperator v
|
||||||
|
|
||||||
|
filtersAndParams = filter (isFilterOrParam . fst) nonemptyParams
|
||||||
|
isFilterOrParam k = not (endingIn reservedEmbeddable k) && notElem k reserved
|
||||||
|
reserved = ["select", "columns", "on_conflict"]
|
||||||
|
reservedEmbeddable = ["order", "limit", "offset", "and", "or"]
|
||||||
|
|
||||||
|
(filtersNotRoot, filtersRoot) = L.partition isNotRoot filters
|
||||||
|
isNotRoot = flip T.isInfixOf "." . fst
|
||||||
|
|
||||||
|
-- TODO: These checks are redundant to the parsers, should use parsers to differentiate params
|
||||||
|
hasOperator val =
|
||||||
|
case T.splitOn "." val of
|
||||||
|
"not" : _ : _ -> True
|
||||||
|
"is" : _ -> True
|
||||||
|
"in" : _ -> True
|
||||||
|
x : _ -> isJust (operator x) || isJust (ftsOperator x)
|
||||||
|
_ -> False
|
||||||
|
|
||||||
|
hasFtsOperator val =
|
||||||
|
case T.splitOn "(" val of
|
||||||
|
x : _ : _ -> isJust $ ftsOperator x
|
||||||
|
_ -> False
|
||||||
|
|
||||||
|
isEmbedPath = T.isInfixOf "."
|
||||||
|
replaceLast x s = T.intercalate "." $ L.init (T.split (=='.') s) <> [x]
|
||||||
|
|
||||||
|
ranges :: HM.HashMap Text (Range Integer)
|
||||||
|
ranges = HM.unionWith f limitParams offsetParams
|
||||||
|
where
|
||||||
|
f rl ro = Range (BoundaryBelow o) (BoundaryAbove $ o + l - 1)
|
||||||
|
where
|
||||||
|
l = fromMaybe 0 $ rangeLimit rl
|
||||||
|
o = rangeOffset ro
|
||||||
|
|
||||||
|
limitParams =
|
||||||
|
HM.fromList [(k, restrictRange (readMaybe v) allRange) | (k,v) <- limits]
|
||||||
|
|
||||||
|
offsetParams =
|
||||||
|
HM.fromList [(k, maybe allRange rangeGeq (readMaybe v)) | (k,v) <- offsets]
|
||||||
|
|
||||||
|
operator :: Text -> Maybe SimpleOperator
|
||||||
|
operator = \case
|
||||||
|
"eq" -> Just OpEqual
|
||||||
|
"gte" -> Just OpGreaterThanEqual
|
||||||
|
"gt" -> Just OpGreaterThan
|
||||||
|
"lte" -> Just OpLessThanEqual
|
||||||
|
"lt" -> Just OpLessThan
|
||||||
|
"neq" -> Just OpNotEqual
|
||||||
|
"like" -> Just OpLike
|
||||||
|
"ilike" -> Just OpILike
|
||||||
|
"cs" -> Just OpContains
|
||||||
|
"cd" -> Just OpContained
|
||||||
|
"ov" -> Just OpOverlap
|
||||||
|
"sl" -> Just OpStrictlyLeft
|
||||||
|
"sr" -> Just OpStrictlyRight
|
||||||
|
"nxr" -> Just OpNotExtendsRight
|
||||||
|
"nxl" -> Just OpNotExtendsLeft
|
||||||
|
"adj" -> Just OpAdjacent
|
||||||
|
"match" -> Just OpMatch
|
||||||
|
"imatch" -> Just OpIMatch
|
||||||
|
_ -> Nothing
|
||||||
|
|
||||||
|
ftsOperator :: Text -> Maybe FtsOperator
|
||||||
|
ftsOperator = \case
|
||||||
|
"fts" -> Just FilterFts
|
||||||
|
"plfts" -> Just FilterFtsPlain
|
||||||
|
"phfts" -> Just FilterFtsPhrase
|
||||||
|
"wfts" -> Just FilterFtsWebsearch
|
||||||
|
_ -> Nothing
|
||||||
|
|
||||||
|
|
||||||
|
-- PARSERS
|
||||||
|
|
||||||
|
|
||||||
|
pRequestSelect :: Text -> Either QPError [Tree SelectItem]
|
||||||
|
pRequestSelect selStr =
|
||||||
|
mapError $ P.parse pFieldForest ("failed to parse select parameter (" <> toS selStr <> ")") (toS selStr)
|
||||||
|
|
||||||
|
pRequestOnConflict :: Text -> Either QPError [FieldName]
|
||||||
|
pRequestOnConflict oncStr =
|
||||||
|
mapError $ P.parse pColumns ("failed to parse on_conflict parameter (" <> toS oncStr <> ")") (toS oncStr)
|
||||||
|
|
||||||
|
pRequestFilter :: (Text, Text) -> Either QPError (EmbedPath, Filter)
|
||||||
|
pRequestFilter (k, v) = mapError $ (,) <$> path <*> (Filter <$> fld <*> oper)
|
||||||
|
where
|
||||||
|
treePath = P.parse pTreePath ("failed to parse tree path (" ++ toS k ++ ")") $ toS k
|
||||||
|
oper = P.parse (pOpExpr pSingleVal) ("failed to parse filter (" ++ toS v ++ ")") $ toS v
|
||||||
|
path = fst <$> treePath
|
||||||
|
fld = snd <$> treePath
|
||||||
|
|
||||||
|
pRequestOrder :: (Text, Text) -> Either QPError (EmbedPath, [OrderTerm])
|
||||||
|
pRequestOrder (k, v) = mapError $ (,) <$> path <*> ord'
|
||||||
|
where
|
||||||
|
treePath = P.parse pTreePath ("failed to parse tree path (" ++ toS k ++ ")") $ toS k
|
||||||
|
path = fst <$> treePath
|
||||||
|
ord' = P.parse pOrder ("failed to parse order (" ++ toS v ++ ")") $ toS v
|
||||||
|
|
||||||
|
pRequestRange :: (Text, NonnegRange) -> Either QPError (EmbedPath, NonnegRange)
|
||||||
|
pRequestRange (k, v) = mapError $ (,) <$> path <*> pure v
|
||||||
|
where
|
||||||
|
treePath = P.parse pTreePath ("failed to parse tree path (" ++ toS k ++ ")") $ toS k
|
||||||
|
path = fst <$> treePath
|
||||||
|
|
||||||
|
pRequestLogicTree :: (Text, Text) -> Either QPError (EmbedPath, LogicTree)
|
||||||
|
pRequestLogicTree (k, v) = mapError $ (,) <$> embedPath <*> logicTree
|
||||||
|
where
|
||||||
|
path = P.parse pLogicPath ("failed to parse logic path (" ++ toS k ++ ")") $ toS k
|
||||||
|
embedPath = fst <$> path
|
||||||
|
logicTree = do
|
||||||
|
op <- snd <$> path
|
||||||
|
-- Concat op and v to make pLogicTree argument regular,
|
||||||
|
-- in the form of "?and=and(.. , ..)" instead of "?and=(.. , ..)"
|
||||||
|
P.parse pLogicTree ("failed to parse logic tree (" ++ toS v ++ ")") $ toS (op <> v)
|
||||||
|
|
||||||
|
pRequestColumns :: Maybe Text -> Either QPError (Maybe (S.Set FieldName))
|
||||||
|
pRequestColumns colStr =
|
||||||
|
case colStr of
|
||||||
|
Just str ->
|
||||||
|
mapError $ Just . S.fromList <$> P.parse pColumns ("failed to parse columns parameter (" <> toS str <> ")") (toS str)
|
||||||
|
_ -> Right Nothing
|
||||||
|
|
||||||
|
ws :: Parser Text
|
||||||
|
ws = toS <$> many (oneOf " \t")
|
||||||
|
|
||||||
|
lexeme :: Parser a -> Parser a
|
||||||
|
lexeme p = ws *> p <* ws
|
||||||
|
|
||||||
|
pTreePath :: Parser (EmbedPath, Field)
|
||||||
|
pTreePath = do
|
||||||
|
p <- pFieldName `sepBy1` pDelimiter
|
||||||
|
jp <- P.option [] pJsonPath
|
||||||
|
return (init p, (last p, jp))
|
||||||
|
|
||||||
|
pFieldForest :: Parser [Tree SelectItem]
|
||||||
|
pFieldForest = pFieldTree `sepBy1` lexeme (char ',')
|
||||||
|
where
|
||||||
|
pFieldTree :: Parser (Tree SelectItem)
|
||||||
|
pFieldTree = try (Node <$> pRelationSelect <*> between (char '(') (char ')') pFieldForest) <|>
|
||||||
|
Node <$> pFieldSelect <*> pure []
|
||||||
|
|
||||||
|
pStar :: Parser Text
|
||||||
|
pStar = string "*" $> "*"
|
||||||
|
|
||||||
|
pFieldName :: Parser Text
|
||||||
|
pFieldName =
|
||||||
|
pQuotedValue <|>
|
||||||
|
T.intercalate "-" . map toS <$> (many1 pIdentifierChar `sepBy1` dash) <?>
|
||||||
|
"field name (* or [a..z0..9_])"
|
||||||
|
where
|
||||||
|
isDash :: GenParser Char st ()
|
||||||
|
isDash = try ( char '-' >> notFollowedBy (char '>') )
|
||||||
|
dash :: Parser Char
|
||||||
|
dash = isDash $> '-'
|
||||||
|
|
||||||
|
-- |
|
||||||
|
-- Parse json operators in select, order and filters
|
||||||
|
--
|
||||||
|
-- >>> P.parse pJsonPath "" "->text"
|
||||||
|
-- Right [JArrow {jOp = JKey {jVal = "text"}}]
|
||||||
|
--
|
||||||
|
-- >>> P.parse pJsonPath "" "->1"
|
||||||
|
-- Right [JArrow {jOp = JIdx {jVal = "+1"}}]
|
||||||
|
--
|
||||||
|
-- >>> P.parse pJsonPath "" "->>text"
|
||||||
|
-- Right [J2Arrow {jOp = JKey {jVal = "text"}}]
|
||||||
|
--
|
||||||
|
-- >>> P.parse pJsonPath "" "->>1"
|
||||||
|
-- Right [J2Arrow {jOp = JIdx {jVal = "+1"}}]
|
||||||
|
--
|
||||||
|
-- >>> P.parse pJsonPath "" "->0,other"
|
||||||
|
-- Right [JArrow {jOp = JIdx {jVal = "+0"}}]
|
||||||
|
--
|
||||||
|
-- >>> P.parse pJsonPath "" "->0.desc"
|
||||||
|
-- Right [JArrow {jOp = JIdx {jVal = "+0"}}]
|
||||||
|
pJsonPath :: Parser JsonPath
|
||||||
|
pJsonPath = many pJsonOperation
|
||||||
|
where
|
||||||
|
pJsonOperation :: Parser JsonOperation
|
||||||
|
pJsonOperation = pJsonArrow <*> pJsonOperand
|
||||||
|
|
||||||
|
pJsonArrow =
|
||||||
|
try (string "->>" $> J2Arrow) <|>
|
||||||
|
try (string "->" $> JArrow)
|
||||||
|
|
||||||
|
pJsonOperand =
|
||||||
|
let pJKey = JKey . toS <$> pFieldName
|
||||||
|
pJIdx = JIdx . toS <$> ((:) <$> P.option '+' (char '-') <*> many1 digit) <* pEnd
|
||||||
|
pEnd = try (void $ lookAhead (string "->")) <|>
|
||||||
|
try (void $ lookAhead (string "::")) <|>
|
||||||
|
try (void $ lookAhead (string ".")) <|>
|
||||||
|
try (void $ lookAhead (string ",")) <|>
|
||||||
|
try eof in
|
||||||
|
try pJIdx <|> try pJKey
|
||||||
|
|
||||||
|
pField :: Parser Field
|
||||||
|
pField = lexeme $ (,) <$> pFieldName <*> P.option [] pJsonPath
|
||||||
|
|
||||||
|
aliasSeparator :: Parser ()
|
||||||
|
aliasSeparator = char ':' >> notFollowedBy (char ':')
|
||||||
|
|
||||||
|
pRelationSelect :: Parser SelectItem
|
||||||
|
pRelationSelect = lexeme $ try ( do
|
||||||
|
alias <- optionMaybe ( try(pFieldName <* aliasSeparator) )
|
||||||
|
fld <- pField
|
||||||
|
prm1 <- optionMaybe pEmbedParam
|
||||||
|
prm2 <- optionMaybe pEmbedParam
|
||||||
|
return (fld, Nothing, alias, embedParamHint prm1 <|> embedParamHint prm2, embedParamJoin prm1 <|> embedParamJoin prm2)
|
||||||
|
)
|
||||||
|
where
|
||||||
|
pEmbedParam :: Parser EmbedParam
|
||||||
|
pEmbedParam =
|
||||||
|
char '!' *> (
|
||||||
|
try (string "left" $> EPJoinType JTLeft) <|>
|
||||||
|
try (string "inner" $> EPJoinType JTInner) <|>
|
||||||
|
try (EPHint <$> pFieldName))
|
||||||
|
embedParamHint prm = case prm of
|
||||||
|
Just (EPHint hint) -> Just hint
|
||||||
|
_ -> Nothing
|
||||||
|
embedParamJoin prm = case prm of
|
||||||
|
Just (EPJoinType jt) -> Just jt
|
||||||
|
_ -> Nothing
|
||||||
|
|
||||||
|
pFieldSelect :: Parser SelectItem
|
||||||
|
pFieldSelect = lexeme $
|
||||||
|
try (
|
||||||
|
do
|
||||||
|
alias <- optionMaybe ( try(pFieldName <* aliasSeparator) )
|
||||||
|
fld <- pField
|
||||||
|
cast' <- optionMaybe (string "::" *> many pIdentifierChar)
|
||||||
|
return (fld, toS <$> cast', alias, Nothing, Nothing)
|
||||||
|
)
|
||||||
|
<|> do
|
||||||
|
s <- pStar
|
||||||
|
return ((s, []), Nothing, Nothing, Nothing, Nothing)
|
||||||
|
|
||||||
|
pOpExpr :: Parser SingleVal -> Parser OpExpr
|
||||||
|
pOpExpr pSVal = try ( string "not" *> pDelimiter *> (OpExpr True <$> pOperation)) <|> OpExpr False <$> pOperation
|
||||||
|
where
|
||||||
|
pOperation :: Parser Operation
|
||||||
|
pOperation = pIn <|> pIs <|> try pFts <|> pOp <?> "operator (eq, gt, ...)"
|
||||||
|
|
||||||
|
pIn = In <$> (try (string "in" *> pDelimiter) *> pListVal)
|
||||||
|
pIs = Is <$> (try (string "is" *> pDelimiter) *> pTriVal)
|
||||||
|
|
||||||
|
pOp = do
|
||||||
|
opStr <- try (P.manyTill anyChar (try pDelimiter))
|
||||||
|
op <- parseMaybe ("unknown single value operator " <> opStr) . operator $ toS opStr
|
||||||
|
Op op <$> pSVal
|
||||||
|
|
||||||
|
pTriVal = try (ciString "null" $> TriNull)
|
||||||
|
<|> try (ciString "unknown" $> TriUnknown)
|
||||||
|
<|> try (ciString "true" $> TriTrue)
|
||||||
|
<|> try (ciString "false" $> TriFalse)
|
||||||
|
<?> "null or trilean value (unknown, true, false)"
|
||||||
|
|
||||||
|
pFts = do
|
||||||
|
opStr <- try (P.many (noneOf ".("))
|
||||||
|
op <- parseMaybe ("unknown fts operator " <> opStr) . ftsOperator $ toS opStr
|
||||||
|
lang <- optionMaybe $ try (between (char '(') (char ')') $ many pIdentifierChar)
|
||||||
|
pDelimiter >> Fts op (toS <$> lang) <$> pSVal
|
||||||
|
|
||||||
|
parseMaybe :: [Char] -> Maybe a -> Parser a
|
||||||
|
parseMaybe err Nothing = parserFail err
|
||||||
|
parseMaybe _ (Just x) = pure x
|
||||||
|
|
||||||
|
-- case insensitive char and string
|
||||||
|
ciChar :: Char -> GenParser Char state Char
|
||||||
|
ciChar c = char c <|> char (toUpper c)
|
||||||
|
ciString :: [Char] -> GenParser Char state [Char]
|
||||||
|
ciString = traverse ciChar
|
||||||
|
|
||||||
|
pSingleVal :: Parser SingleVal
|
||||||
|
pSingleVal = toS <$> many anyChar
|
||||||
|
|
||||||
|
pListVal :: Parser ListVal
|
||||||
|
pListVal = lexeme (char '(') *> pListElement `sepBy1` char ',' <* lexeme (char ')')
|
||||||
|
|
||||||
|
pListElement :: Parser Text
|
||||||
|
pListElement = try (pQuotedValue <* notFollowedBy (noneOf ",)")) <|> (toS <$> many (noneOf ",)"))
|
||||||
|
|
||||||
|
pQuotedValue :: Parser Text
|
||||||
|
pQuotedValue = toS <$> (char '"' *> many pCharsOrSlashed <* char '"')
|
||||||
|
where
|
||||||
|
pCharsOrSlashed = noneOf "\\\"" <|> (char '\\' *> anyChar)
|
||||||
|
|
||||||
|
pDelimiter :: Parser Char
|
||||||
|
pDelimiter = char '.' <?> "delimiter (.)"
|
||||||
|
|
||||||
|
pOrder :: Parser [OrderTerm]
|
||||||
|
pOrder = lexeme pOrderTerm `sepBy1` char ','
|
||||||
|
|
||||||
|
pOrderTerm :: Parser OrderTerm
|
||||||
|
pOrderTerm = do
|
||||||
|
fld <- pField
|
||||||
|
dir <- optionMaybe $
|
||||||
|
try (pDelimiter *> string "asc" $> OrderAsc) <|>
|
||||||
|
try (pDelimiter *> string "desc" $> OrderDesc)
|
||||||
|
nls <- optionMaybe pNulls <* pEnd <|>
|
||||||
|
pEnd $> Nothing
|
||||||
|
return $ OrderTerm fld dir nls
|
||||||
|
where
|
||||||
|
pNulls = try (pDelimiter *> string "nullsfirst" $> OrderNullsFirst) <|>
|
||||||
|
try (pDelimiter *> string "nullslast" $> OrderNullsLast)
|
||||||
|
pEnd = try (void $ lookAhead (char ',')) <|>
|
||||||
|
try eof
|
||||||
|
|
||||||
|
pLogicTree :: Parser LogicTree
|
||||||
|
pLogicTree = Stmnt <$> try pLogicFilter
|
||||||
|
<|> Expr <$> pNot <*> pLogicOp <*> (lexeme (char '(') *> pLogicTree `sepBy1` lexeme (char ',') <* lexeme (char ')'))
|
||||||
|
where
|
||||||
|
pLogicFilter :: Parser Filter
|
||||||
|
pLogicFilter = Filter <$> pField <* pDelimiter <*> pOpExpr pLogicSingleVal
|
||||||
|
pNot :: Parser Bool
|
||||||
|
pNot = try (string "not" *> pDelimiter $> True)
|
||||||
|
<|> pure False
|
||||||
|
<?> "negation operator (not)"
|
||||||
|
pLogicOp :: Parser LogicOperator
|
||||||
|
pLogicOp = try (string "and" $> And)
|
||||||
|
<|> string "or" $> Or
|
||||||
|
<?> "logic operator (and, or)"
|
||||||
|
|
||||||
|
pLogicSingleVal :: Parser SingleVal
|
||||||
|
pLogicSingleVal = try (pQuotedValue <* notFollowedBy (noneOf ",)")) <|> try pPgArray <|> (toS <$> many (noneOf ",)"))
|
||||||
|
where
|
||||||
|
pPgArray :: Parser Text
|
||||||
|
pPgArray = do
|
||||||
|
a <- string "{"
|
||||||
|
b <- many (noneOf "{}")
|
||||||
|
c <- string "}"
|
||||||
|
pure (toS $ a ++ b ++ c)
|
||||||
|
|
||||||
|
pLogicPath :: Parser (EmbedPath, Text)
|
||||||
|
pLogicPath = do
|
||||||
|
path <- pFieldName `sepBy1` pDelimiter
|
||||||
|
let op = last path
|
||||||
|
notOp = "not." <> op
|
||||||
|
return (filter (/= "not") (init path), if "not" `elem` path then notOp else op)
|
||||||
|
|
||||||
|
pColumns :: Parser [FieldName]
|
||||||
|
pColumns = pFieldName `sepBy1` lexeme (char ',')
|
||||||
|
|
||||||
|
pIdentifierChar :: Parser Char
|
||||||
|
pIdentifierChar = letter <|> digit <|> oneOf "_ $"
|
||||||
|
|
||||||
|
mapError :: Either ParseError a -> Either QPError a
|
||||||
|
mapError = mapLeft translateError
|
||||||
|
where
|
||||||
|
translateError e =
|
||||||
|
QPError message details
|
||||||
|
where
|
||||||
|
message = show $ errorPos e
|
||||||
|
details = T.strip $ T.replace "\n" " " $ toS
|
||||||
|
$ showErrorMessages "or" "unknown parse error" "expecting" "unexpected" "end of input" (errorMessages e)
|
||||||
@@ -0,0 +1,46 @@
|
|||||||
|
module PostgREST.Request.ReadQuery
|
||||||
|
( ReadNode
|
||||||
|
, ReadQuery(..)
|
||||||
|
, ReadRequest
|
||||||
|
, SelectItem
|
||||||
|
, fstFieldNames
|
||||||
|
) where
|
||||||
|
|
||||||
|
import Data.Tree (Tree (..))
|
||||||
|
|
||||||
|
import PostgREST.DbStructure.Identifiers (FieldName,
|
||||||
|
QualifiedIdentifier)
|
||||||
|
import PostgREST.DbStructure.Relationship (Relationship)
|
||||||
|
import PostgREST.RangeQuery (NonnegRange)
|
||||||
|
import PostgREST.Request.Types (Alias, Cast, Depth, Field,
|
||||||
|
Hint, JoinCondition,
|
||||||
|
JoinType, LogicTree,
|
||||||
|
NodeName, OrderTerm)
|
||||||
|
|
||||||
|
|
||||||
|
import Protolude
|
||||||
|
|
||||||
|
type ReadRequest = Tree ReadNode
|
||||||
|
|
||||||
|
type ReadNode =
|
||||||
|
(ReadQuery, (NodeName, Maybe Relationship, Maybe Alias, Maybe Hint, Maybe JoinType, Depth))
|
||||||
|
|
||||||
|
-- | The select value in `/tbl?select=alias:field::cast`
|
||||||
|
type SelectItem = (Field, Maybe Cast, Maybe Alias, Maybe Hint, Maybe JoinType)
|
||||||
|
|
||||||
|
data ReadQuery = Select
|
||||||
|
{ select :: [SelectItem]
|
||||||
|
, from :: QualifiedIdentifier
|
||||||
|
, fromAlias :: Maybe Alias
|
||||||
|
-- ^ A table alias is used in case of self joins
|
||||||
|
, where_ :: [LogicTree]
|
||||||
|
, joinConditions :: [JoinCondition]
|
||||||
|
, order :: [OrderTerm]
|
||||||
|
, range_ :: NonnegRange
|
||||||
|
}
|
||||||
|
deriving (Eq)
|
||||||
|
|
||||||
|
-- First level FieldNames(e.g get a,b from /table?select=a,b,other(c,d))
|
||||||
|
fstFieldNames :: ReadRequest -> [FieldName]
|
||||||
|
fstFieldNames (Node (sel, _) _) =
|
||||||
|
fst . (\(f, _, _, _, _) -> f) <$> select sel
|
||||||
+101
-82
@@ -1,73 +1,77 @@
|
|||||||
{-# LANGUAGE DuplicateRecordFields #-}
|
{-# LANGUAGE DuplicateRecordFields #-}
|
||||||
module PostgREST.Request.Types
|
module PostgREST.Request.Types
|
||||||
( Alias
|
( Alias
|
||||||
|
, Cast
|
||||||
, Depth
|
, Depth
|
||||||
, EmbedHint
|
, EmbedParam(..)
|
||||||
|
, ApiRequestError(..)
|
||||||
, EmbedPath
|
, EmbedPath
|
||||||
, Field
|
, Field
|
||||||
, Filter(..)
|
, Filter(..)
|
||||||
|
, Hint
|
||||||
|
, CallQuery(..)
|
||||||
|
, CallParams(..)
|
||||||
|
, CallRequest
|
||||||
, JoinCondition(..)
|
, JoinCondition(..)
|
||||||
|
, JoinType(..)
|
||||||
, JsonOperand(..)
|
, JsonOperand(..)
|
||||||
, JsonOperation(..)
|
, JsonOperation(..)
|
||||||
, JsonPath
|
, JsonPath
|
||||||
, ListVal
|
, ListVal
|
||||||
, LogicOperator(..)
|
, LogicOperator(..)
|
||||||
, LogicTree(..)
|
, LogicTree(..)
|
||||||
, MutateQuery(..)
|
|
||||||
, MutateRequest
|
|
||||||
, NodeName
|
, NodeName
|
||||||
, OpExpr(..)
|
, OpExpr(..)
|
||||||
, Operation (..)
|
, Operation (..)
|
||||||
, OrderDirection(..)
|
, OrderDirection(..)
|
||||||
, OrderNulls(..)
|
, OrderNulls(..)
|
||||||
, OrderTerm(..)
|
, OrderTerm(..)
|
||||||
, ReadNode
|
, QPError(..)
|
||||||
, ReadQuery(..)
|
|
||||||
, ReadRequest
|
|
||||||
, SelectItem
|
|
||||||
, SingleVal
|
, SingleVal
|
||||||
, fstFieldNames
|
, TrileanVal(..)
|
||||||
|
, SimpleOperator(..)
|
||||||
|
, FtsOperator(..)
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import qualified Data.ByteString.Lazy as BL
|
import qualified Data.ByteString.Lazy as LBS
|
||||||
import qualified Data.Set as S
|
|
||||||
|
|
||||||
import Data.Tree (Tree (..))
|
|
||||||
|
|
||||||
import qualified GHC.Show (show)
|
|
||||||
|
|
||||||
import PostgREST.DbStructure.Identifiers (FieldName,
|
import PostgREST.DbStructure.Identifiers (FieldName,
|
||||||
QualifiedIdentifier)
|
QualifiedIdentifier)
|
||||||
|
import PostgREST.DbStructure.Proc (ProcDescription (..),
|
||||||
|
ProcParam (..))
|
||||||
import PostgREST.DbStructure.Relationship (Relationship)
|
import PostgREST.DbStructure.Relationship (Relationship)
|
||||||
import PostgREST.RangeQuery (NonnegRange)
|
import PostgREST.MediaType (MediaType (..))
|
||||||
import PostgREST.Request.Preferences (PreferResolution)
|
|
||||||
|
|
||||||
import Protolude
|
import Protolude
|
||||||
|
|
||||||
|
|
||||||
type ReadRequest = Tree ReadNode
|
|
||||||
type MutateRequest = MutateQuery
|
|
||||||
|
|
||||||
type ReadNode =
|
data ApiRequestError
|
||||||
(ReadQuery, (NodeName, Maybe Relationship, Maybe Alias, Maybe EmbedHint, Depth))
|
= AmbiguousRelBetween Text Text [Relationship]
|
||||||
|
| AmbiguousRpc [ProcDescription]
|
||||||
|
| MediaTypeError [ByteString]
|
||||||
|
| InvalidBody ByteString
|
||||||
|
| InvalidFilters
|
||||||
|
| InvalidRange
|
||||||
|
| InvalidRpcMethod ByteString
|
||||||
|
| LimitNoOrderError
|
||||||
|
| NotFound
|
||||||
|
| NoRelBetween Text Text Text
|
||||||
|
| NoRpc Text Text [Text] Bool MediaType Bool
|
||||||
|
| NotEmbedded Text
|
||||||
|
| ParseRequestError Text Text
|
||||||
|
| PutRangeNotAllowedError
|
||||||
|
| QueryParamError QPError
|
||||||
|
| UnacceptableSchema [Text]
|
||||||
|
| UnsupportedMethod ByteString
|
||||||
|
|
||||||
|
data QPError = QPError Text Text
|
||||||
|
|
||||||
|
type CallRequest = CallQuery
|
||||||
|
|
||||||
type NodeName = Text
|
type NodeName = Text
|
||||||
type Depth = Integer
|
type Depth = Integer
|
||||||
|
|
||||||
data ReadQuery = Select
|
|
||||||
{ select :: [SelectItem]
|
|
||||||
, from :: QualifiedIdentifier
|
|
||||||
-- ^ A table alias is used in case of self joins
|
|
||||||
, fromAlias :: Maybe Alias
|
|
||||||
-- ^ Only used for Many to Many joins. Parent and Child joins use explicit joins.
|
|
||||||
, implicitJoins :: [QualifiedIdentifier]
|
|
||||||
, where_ :: [LogicTree]
|
|
||||||
, joinConditions :: [JoinCondition]
|
|
||||||
, order :: [OrderTerm]
|
|
||||||
, range_ :: NonnegRange
|
|
||||||
}
|
|
||||||
deriving (Eq)
|
|
||||||
|
|
||||||
data JoinCondition =
|
data JoinCondition =
|
||||||
JoinCondition
|
JoinCondition
|
||||||
(QualifiedIdentifier, FieldName)
|
(QualifiedIdentifier, FieldName)
|
||||||
@@ -86,52 +90,40 @@ data OrderDirection
|
|||||||
| OrderDesc
|
| OrderDesc
|
||||||
deriving (Eq)
|
deriving (Eq)
|
||||||
|
|
||||||
instance Show OrderDirection where
|
|
||||||
show OrderAsc = "ASC"
|
|
||||||
show OrderDesc = "DESC"
|
|
||||||
|
|
||||||
data OrderNulls
|
data OrderNulls
|
||||||
= OrderNullsFirst
|
= OrderNullsFirst
|
||||||
| OrderNullsLast
|
| OrderNullsLast
|
||||||
deriving (Eq)
|
deriving (Eq)
|
||||||
|
|
||||||
instance Show OrderNulls where
|
data CallQuery = FunctionCall
|
||||||
show OrderNullsFirst = "NULLS FIRST"
|
{ funCQi :: QualifiedIdentifier
|
||||||
show OrderNullsLast = "NULLS LAST"
|
, funCParams :: CallParams
|
||||||
|
, funCArgs :: Maybe LBS.ByteString
|
||||||
|
, funCScalar :: Bool
|
||||||
|
, funCMultipleCall :: Bool
|
||||||
|
, funCReturning :: [FieldName]
|
||||||
|
}
|
||||||
|
|
||||||
data MutateQuery
|
data CallParams
|
||||||
= Insert
|
= KeyParams [ProcParam] -- ^ Call with key params: func(a := val1, b:= val2)
|
||||||
{ in_ :: QualifiedIdentifier
|
| OnePosParam ProcParam -- ^ Call with positional params(only one supported): func(val)
|
||||||
, insCols :: S.Set FieldName
|
|
||||||
, insBody :: Maybe BL.ByteString
|
|
||||||
, onConflict :: Maybe (PreferResolution, [FieldName])
|
|
||||||
, where_ :: [LogicTree]
|
|
||||||
, returning :: [FieldName]
|
|
||||||
}
|
|
||||||
| Update
|
|
||||||
{ in_ :: QualifiedIdentifier
|
|
||||||
, updCols :: S.Set FieldName
|
|
||||||
, updBody :: Maybe BL.ByteString
|
|
||||||
, where_ :: [LogicTree]
|
|
||||||
, returning :: [FieldName]
|
|
||||||
}
|
|
||||||
| Delete
|
|
||||||
{ in_ :: QualifiedIdentifier
|
|
||||||
, where_ :: [LogicTree]
|
|
||||||
, returning :: [FieldName]
|
|
||||||
}
|
|
||||||
|
|
||||||
-- | The select value in `/tbl?select=alias:field::cast`
|
|
||||||
type SelectItem = (Field, Maybe Cast, Maybe Alias, Maybe EmbedHint)
|
|
||||||
|
|
||||||
type Field = (FieldName, JsonPath)
|
type Field = (FieldName, JsonPath)
|
||||||
type Cast = Text
|
type Cast = Text
|
||||||
type Alias = Text
|
type Alias = Text
|
||||||
|
type Hint = Text
|
||||||
|
|
||||||
-- | Disambiguates an embedding operation when there's multiple relationships
|
data EmbedParam
|
||||||
-- between two tables. Can be the name of a foreign key constraint, column
|
-- | Disambiguates an embedding operation when there's multiple relationships
|
||||||
-- name or the junction in an m2m relationship.
|
-- between two tables. Can be the name of a foreign key constraint, column
|
||||||
type EmbedHint = Text
|
-- name or the junction in an m2m relationship.
|
||||||
|
= EPHint Hint
|
||||||
|
| EPJoinType JoinType
|
||||||
|
|
||||||
|
data JoinType
|
||||||
|
= JTInner
|
||||||
|
| JTLeft
|
||||||
|
deriving Eq
|
||||||
|
|
||||||
-- | Path of the embedded levels, e.g "clients.projects.name=eq.." gives Path
|
-- | Path of the embedded levels, e.g "clients.projects.name=eq.." gives Path
|
||||||
-- ["clients", "projects"]
|
-- ["clients", "projects"]
|
||||||
@@ -155,12 +147,6 @@ data JsonOperand
|
|||||||
| JIdx { jVal :: Text }
|
| JIdx { jVal :: Text }
|
||||||
deriving (Eq)
|
deriving (Eq)
|
||||||
|
|
||||||
-- First level FieldNames(e.g get a,b from /table?select=a,b,other(c,d))
|
|
||||||
fstFieldNames :: ReadRequest -> [FieldName]
|
|
||||||
fstFieldNames (Node (sel, _) _) =
|
|
||||||
fst . (\(f, _, _, _) -> f) <$> select sel
|
|
||||||
|
|
||||||
|
|
||||||
-- | Boolean logic expression tree e.g. "and(name.eq.N,or(id.eq.1,id.eq.2))" is:
|
-- | Boolean logic expression tree e.g. "and(name.eq.N,or(id.eq.1,id.eq.2))" is:
|
||||||
--
|
--
|
||||||
-- And
|
-- And
|
||||||
@@ -178,10 +164,6 @@ data LogicOperator
|
|||||||
| Or
|
| Or
|
||||||
deriving Eq
|
deriving Eq
|
||||||
|
|
||||||
instance Show LogicOperator where
|
|
||||||
show And = "AND"
|
|
||||||
show Or = "OR"
|
|
||||||
|
|
||||||
data Filter = Filter
|
data Filter = Filter
|
||||||
{ field :: Field
|
{ field :: Field
|
||||||
, opExpr :: OpExpr
|
, opExpr :: OpExpr
|
||||||
@@ -193,12 +175,12 @@ data OpExpr =
|
|||||||
deriving (Eq)
|
deriving (Eq)
|
||||||
|
|
||||||
data Operation
|
data Operation
|
||||||
= Op Operator SingleVal
|
= Op SimpleOperator SingleVal
|
||||||
| In ListVal
|
| In ListVal
|
||||||
| Fts Operator (Maybe Language) SingleVal
|
| Is TrileanVal
|
||||||
|
| Fts FtsOperator (Maybe Language) SingleVal
|
||||||
deriving (Eq)
|
deriving (Eq)
|
||||||
|
|
||||||
type Operator = Text
|
|
||||||
type Language = Text
|
type Language = Text
|
||||||
|
|
||||||
-- | Represents a single value in a filter, e.g. id=eq.singleval
|
-- | Represents a single value in a filter, e.g. id=eq.singleval
|
||||||
@@ -206,3 +188,40 @@ type SingleVal = Text
|
|||||||
|
|
||||||
-- | Represents a list value in a filter, e.g. id=in.(val1,val2,val3)
|
-- | Represents a list value in a filter, e.g. id=in.(val1,val2,val3)
|
||||||
type ListVal = [Text]
|
type ListVal = [Text]
|
||||||
|
|
||||||
|
-- | Three-valued logic values
|
||||||
|
data TrileanVal
|
||||||
|
= TriTrue
|
||||||
|
| TriFalse
|
||||||
|
| TriNull
|
||||||
|
| TriUnknown
|
||||||
|
deriving Eq
|
||||||
|
|
||||||
|
data SimpleOperator
|
||||||
|
= OpEqual
|
||||||
|
| OpGreaterThanEqual
|
||||||
|
| OpGreaterThan
|
||||||
|
| OpLessThanEqual
|
||||||
|
| OpLessThan
|
||||||
|
| OpNotEqual
|
||||||
|
| OpLike
|
||||||
|
| OpILike
|
||||||
|
| OpContains
|
||||||
|
| OpContained
|
||||||
|
| OpOverlap
|
||||||
|
| OpStrictlyLeft
|
||||||
|
| OpStrictlyRight
|
||||||
|
| OpNotExtendsRight
|
||||||
|
| OpNotExtendsLeft
|
||||||
|
| OpAdjacent
|
||||||
|
| OpMatch
|
||||||
|
| OpIMatch
|
||||||
|
deriving Eq
|
||||||
|
|
||||||
|
-- | Operators for full text search operators
|
||||||
|
data FtsOperator
|
||||||
|
= FilterFts
|
||||||
|
| FilterFtsPlain
|
||||||
|
| FilterFtsPhrase
|
||||||
|
| FilterFtsWebsearch
|
||||||
|
deriving Eq
|
||||||
|
|||||||
@@ -43,10 +43,9 @@ runAppWithSocket settings app socketFileMode socketFilePath =
|
|||||||
-- | Set signal handlers, only for systems with signals
|
-- | Set signal handlers, only for systems with signals
|
||||||
installSignalHandlers :: AppState.AppState -> IO ()
|
installSignalHandlers :: AppState.AppState -> IO ()
|
||||||
installSignalHandlers appState = do
|
installSignalHandlers appState = do
|
||||||
-- Releases the connection pool whenever the program is terminated,
|
let interrupt = throwTo (AppState.getMainThreadId appState) UserInterrupt
|
||||||
-- see https://github.com/PostgREST/postgrest/issues/268
|
install Signals.sigINT interrupt
|
||||||
install Signals.sigINT $ AppState.releasePool appState
|
install Signals.sigTERM interrupt
|
||||||
install Signals.sigTERM $ AppState.releasePool appState
|
|
||||||
|
|
||||||
-- The SIGUSR1 signal updates the internal 'DbStructure' by running
|
-- The SIGUSR1 signal updates the internal 'DbStructure' by running
|
||||||
-- 'connectionWorker' exactly as before.
|
-- 'connectionWorker' exactly as before.
|
||||||
|
|||||||
+26
-11
@@ -1,29 +1,44 @@
|
|||||||
{-# LANGUAGE TemplateHaskell #-}
|
{-# LANGUAGE TemplateHaskell #-}
|
||||||
{-# OPTIONS_GHC -fno-warn-type-defaults #-}
|
|
||||||
module PostgREST.Version
|
module PostgREST.Version
|
||||||
( docsVersion
|
( docsVersion
|
||||||
, prettyVersion
|
, prettyVersion
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import qualified Data.Text as T
|
import qualified Data.ByteString as BS
|
||||||
|
import qualified Data.Text as T
|
||||||
|
|
||||||
import Data.Version (versionBranch)
|
import Data.Version (showVersion, versionBranch)
|
||||||
import Development.GitRev (gitHash)
|
import Development.GitRev (gitHash)
|
||||||
import Paths_postgrest (version)
|
import Paths_postgrest (version)
|
||||||
|
|
||||||
import Protolude
|
import Protolude
|
||||||
|
|
||||||
|
|
||||||
-- | User friendly version number
|
-- | User friendly version number such as '1.1.1'.
|
||||||
prettyVersion :: Text
|
-- Pre-release versions are tagged as such, e.g., '1.1.1.1 (pre-release)'.
|
||||||
|
-- If a git hash is available, it's added to the version, e.g., '1.1.1 (abcdef0)'.
|
||||||
|
prettyVersion :: ByteString
|
||||||
prettyVersion =
|
prettyVersion =
|
||||||
T.intercalate "." (map show $ versionBranch version) <> gitRev
|
toUtf8 (showVersion version) <> preRelease <> gitRev
|
||||||
where
|
where
|
||||||
gitRev =
|
gitRev =
|
||||||
if $(gitHash) == "UNKNOWN"
|
if $(gitHash) == ("UNKNOWN" :: Text) then
|
||||||
then mempty
|
mempty
|
||||||
else " (" <> T.take 7 $(gitHash) <> ")"
|
else
|
||||||
|
" (" <> BS.take 7 $(gitHash) <> ")"
|
||||||
|
preRelease = if isPreRelease then " (pre-release)" else mempty
|
||||||
|
|
||||||
-- | Version number used in docs
|
|
||||||
|
-- | Version number used in docs.
|
||||||
|
-- Pre-release versions link to the latest docs
|
||||||
|
-- Uses only the two first components of the version. Example: 'v1.1'
|
||||||
docsVersion :: Text
|
docsVersion :: Text
|
||||||
docsVersion = "v" <> T.dropEnd 1 (T.dropWhileEnd (/= '.') prettyVersion)
|
docsVersion
|
||||||
|
| isPreRelease = "latest"
|
||||||
|
| otherwise = "v" <> (T.intercalate "." . map show . take 2 $ versionBranch version)
|
||||||
|
|
||||||
|
|
||||||
|
-- | Versions with four components (e.g., '1.1.1.1') are treated as pre-releases.
|
||||||
|
isPreRelease :: Bool
|
||||||
|
isPreRelease =
|
||||||
|
length (versionBranch version) == 4
|
||||||
|
|||||||
+36
-32
@@ -9,13 +9,14 @@ module PostgREST.Workers
|
|||||||
|
|
||||||
import qualified Data.Aeson as JSON
|
import qualified Data.Aeson as JSON
|
||||||
import qualified Data.ByteString as BS
|
import qualified Data.ByteString as BS
|
||||||
import qualified Hasql.Connection as C
|
import qualified Data.ByteString.Lazy as LBS
|
||||||
import qualified Hasql.Notifications as N
|
import qualified Data.Text.Encoding as T
|
||||||
import qualified Hasql.Pool as P
|
import qualified Hasql.Notifications as SQL
|
||||||
import qualified Hasql.Transaction.Sessions as HT
|
import qualified Hasql.Transaction.Sessions as SQL
|
||||||
|
|
||||||
import Control.Retry (RetryStatus, capDelay, exponentialBackoff,
|
import Control.Retry (RetryStatus, capDelay, exponentialBackoff,
|
||||||
retrying, rsPreviousDelay)
|
retrying, rsPreviousDelay)
|
||||||
|
import Hasql.Connection (acquire)
|
||||||
|
|
||||||
import PostgREST.AppState (AppState)
|
import PostgREST.AppState (AppState)
|
||||||
import PostgREST.Config (AppConfig (..), readAppConfig)
|
import PostgREST.Config (AppConfig (..), readAppConfig)
|
||||||
@@ -27,8 +28,7 @@ import PostgREST.Error (PgError (PgError), checkIsFatal,
|
|||||||
|
|
||||||
import qualified PostgREST.AppState as AppState
|
import qualified PostgREST.AppState as AppState
|
||||||
|
|
||||||
import Protolude hiding (head, toS)
|
import Protolude
|
||||||
import Protolude.Conv (toS)
|
|
||||||
|
|
||||||
|
|
||||||
-- | Current database connection status data ConnectionStatus
|
-- | Current database connection status data ConnectionStatus
|
||||||
@@ -48,7 +48,7 @@ data SCacheStatus
|
|||||||
-- up-to-date schema cache(DbStructure). This method is meant to be called
|
-- up-to-date schema cache(DbStructure). This method is meant to be called
|
||||||
-- multiple times by the same thread, but does nothing if the previous
|
-- multiple times by the same thread, but does nothing if the previous
|
||||||
-- invocation has not terminated. In all cases this method does not halt the
|
-- invocation has not terminated. In all cases this method does not halt the
|
||||||
-- calling thread, the work is preformed in a separate thread.
|
-- calling thread, the work is performed in a separate thread.
|
||||||
--
|
--
|
||||||
-- Background thread that does the following :
|
-- Background thread that does the following :
|
||||||
-- 1. Tries to connect to pg server and will keep trying until success.
|
-- 1. Tries to connect to pg server and will keep trying until success.
|
||||||
@@ -57,13 +57,14 @@ data SCacheStatus
|
|||||||
-- 3. Obtains the dbStructure. If this fails, it goes back to 1.
|
-- 3. Obtains the dbStructure. If this fails, it goes back to 1.
|
||||||
connectionWorker :: AppState -> IO ()
|
connectionWorker :: AppState -> IO ()
|
||||||
connectionWorker appState = do
|
connectionWorker appState = do
|
||||||
isWorkerOn <- AppState.getIsWorkerOn appState
|
runExclusively (AppState.getWorkerSem appState) work
|
||||||
-- Prevents multiple workers to be running at the same time. Could happen on
|
-- Prevents multiple workers to be running at the same time. Could happen on
|
||||||
-- too many SIGUSR1s.
|
-- too many SIGUSR1s.
|
||||||
unless isWorkerOn $ do
|
|
||||||
AppState.putIsWorkerOn appState True
|
|
||||||
void $ forkIO work
|
|
||||||
where
|
where
|
||||||
|
runExclusively mvar action = mask_ $ do
|
||||||
|
success <- tryPutMVar mvar ()
|
||||||
|
when success $ do
|
||||||
|
void $ forkIO $ action `finally` takeMVar mvar
|
||||||
work = do
|
work = do
|
||||||
AppConfig{..} <- AppState.getConfig appState
|
AppConfig{..} <- AppState.getConfig appState
|
||||||
AppState.logWithZTime appState "Attempting to connect to the database..."
|
AppState.logWithZTime appState "Attempting to connect to the database..."
|
||||||
@@ -90,11 +91,11 @@ connectionWorker appState = do
|
|||||||
-- do nothing and proceed if the load was successful
|
-- do nothing and proceed if the load was successful
|
||||||
return ()
|
return ()
|
||||||
SCOnRetry ->
|
SCOnRetry ->
|
||||||
|
-- retry reloading the schema cache
|
||||||
work
|
work
|
||||||
SCFatalFail ->
|
SCFatalFail ->
|
||||||
-- die if our schema cache query has an error
|
-- die if our schema cache query has an error
|
||||||
killThread $ AppState.getMainThreadId appState
|
killThread $ AppState.getMainThreadId appState
|
||||||
AppState.putIsWorkerOn appState False
|
|
||||||
|
|
||||||
-- | Check if a connection from the pool allows access to the PostgreSQL
|
-- | Check if a connection from the pool allows access to the PostgreSQL
|
||||||
-- database. If not, the pool connections are released and a new connection is
|
-- database. If not, the pool connections are released and a new connection is
|
||||||
@@ -108,20 +109,19 @@ connectionWorker appState = do
|
|||||||
connectionStatus :: AppState -> IO ConnectionStatus
|
connectionStatus :: AppState -> IO ConnectionStatus
|
||||||
connectionStatus appState =
|
connectionStatus appState =
|
||||||
retrying retrySettings shouldRetry $
|
retrying retrySettings shouldRetry $
|
||||||
const $ P.release pool >> getConnectionStatus
|
const $ AppState.releasePool appState >> getConnectionStatus
|
||||||
where
|
where
|
||||||
pool = AppState.getPool appState
|
|
||||||
retrySettings = capDelay delayMicroseconds $ exponentialBackoff backoffMicroseconds
|
retrySettings = capDelay delayMicroseconds $ exponentialBackoff backoffMicroseconds
|
||||||
delayMicroseconds = 32000000 -- 32 seconds
|
delayMicroseconds = 32000000 -- 32 seconds
|
||||||
backoffMicroseconds = 1000000 -- 1 second
|
backoffMicroseconds = 1000000 -- 1 second
|
||||||
|
|
||||||
getConnectionStatus :: IO ConnectionStatus
|
getConnectionStatus :: IO ConnectionStatus
|
||||||
getConnectionStatus = do
|
getConnectionStatus = do
|
||||||
pgVersion <- P.use pool queryPgVersion
|
pgVersion <- AppState.usePool appState queryPgVersion
|
||||||
case pgVersion of
|
case pgVersion of
|
||||||
Left e -> do
|
Left e -> do
|
||||||
let err = PgError False e
|
let err = PgError False e
|
||||||
AppState.logWithZTime appState . toS $ errorPayload err
|
AppState.logWithZTime appState . T.decodeUtf8 . LBS.toStrict $ errorPayload err
|
||||||
case checkIsFatal err of
|
case checkIsFatal err of
|
||||||
Just reason ->
|
Just reason ->
|
||||||
return $ FatalConnectionError reason
|
return $ FatalConnectionError reason
|
||||||
@@ -144,6 +144,7 @@ connectionStatus appState =
|
|||||||
"Attempting to reconnect to the database in "
|
"Attempting to reconnect to the database in "
|
||||||
<> (show delay::Text)
|
<> (show delay::Text)
|
||||||
<> " seconds..."
|
<> " seconds..."
|
||||||
|
when itShould $ AppState.putRetryNextIn appState delay
|
||||||
return itShould
|
return itShould
|
||||||
|
|
||||||
-- | Load the DbStructure by using a connection from the pool.
|
-- | Load the DbStructure by using a connection from the pool.
|
||||||
@@ -151,14 +152,14 @@ loadSchemaCache :: AppState -> IO SCacheStatus
|
|||||||
loadSchemaCache appState = do
|
loadSchemaCache appState = do
|
||||||
AppConfig{..} <- AppState.getConfig appState
|
AppConfig{..} <- AppState.getConfig appState
|
||||||
result <-
|
result <-
|
||||||
let transaction = if configDbPreparedStatements then HT.transaction else HT.unpreparedTransaction in
|
let transaction = if configDbPreparedStatements then SQL.transaction else SQL.unpreparedTransaction in
|
||||||
P.use (AppState.getPool appState) . transaction HT.ReadCommitted HT.Read $
|
AppState.usePool appState . transaction SQL.ReadCommitted SQL.Read $
|
||||||
queryDbStructure (toList configDbSchemas) configDbExtraSearchPath configDbPreparedStatements
|
queryDbStructure (toList configDbSchemas) configDbExtraSearchPath configDbPreparedStatements
|
||||||
case result of
|
case result of
|
||||||
Left e -> do
|
Left e -> do
|
||||||
let
|
let
|
||||||
err = PgError False e
|
err = PgError False e
|
||||||
putErr = AppState.logWithZTime appState . toS $ errorPayload err
|
putErr = AppState.logWithZTime appState . T.decodeUtf8 . LBS.toStrict $ errorPayload err
|
||||||
case checkIsFatal err of
|
case checkIsFatal err of
|
||||||
Just hint -> do
|
Just hint -> do
|
||||||
AppState.logWithZTime appState "A fatal error ocurred when loading the schema cache"
|
AppState.logWithZTime appState "A fatal error ocurred when loading the schema cache"
|
||||||
@@ -166,14 +167,15 @@ loadSchemaCache appState = do
|
|||||||
AppState.logWithZTime appState hint
|
AppState.logWithZTime appState hint
|
||||||
return SCFatalFail
|
return SCFatalFail
|
||||||
Nothing -> do
|
Nothing -> do
|
||||||
|
AppState.putDbStructure appState Nothing
|
||||||
AppState.logWithZTime appState "An error ocurred when loading the schema cache"
|
AppState.logWithZTime appState "An error ocurred when loading the schema cache"
|
||||||
putErr
|
putErr
|
||||||
return SCOnRetry
|
return SCOnRetry
|
||||||
|
|
||||||
Right dbStructure -> do
|
Right dbStructure -> do
|
||||||
AppState.putDbStructure appState dbStructure
|
AppState.putDbStructure appState (Just dbStructure)
|
||||||
when (isJust configDbRootSpec) $
|
when (isJust configDbRootSpec) .
|
||||||
AppState.putJsonDbS appState $ toS $ JSON.encode dbStructure
|
AppState.putJsonDbS appState . LBS.toStrict $ JSON.encode dbStructure
|
||||||
AppState.logWithZTime appState "Schema cache loaded"
|
AppState.logWithZTime appState "Schema cache loaded"
|
||||||
return SCLoaded
|
return SCLoaded
|
||||||
|
|
||||||
@@ -193,18 +195,20 @@ listener appState = do
|
|||||||
|
|
||||||
-- forkFinally allows to detect if the thread dies
|
-- forkFinally allows to detect if the thread dies
|
||||||
void . flip forkFinally (handleFinally dbChannel) $ do
|
void . flip forkFinally (handleFinally dbChannel) $ do
|
||||||
dbOrError <- C.acquire $ toS configDbUri
|
dbOrError <- acquire $ toUtf8 configDbUri
|
||||||
case dbOrError of
|
case dbOrError of
|
||||||
Right db -> do
|
Right db -> do
|
||||||
AppState.logWithZTime appState $ "Listening for notifications on the " <> dbChannel <> " channel"
|
AppState.logWithZTime appState $ "Listening for notifications on the " <> dbChannel <> " channel"
|
||||||
N.listen db $ N.toPgIdentifier dbChannel
|
AppState.putIsListenerOn appState True
|
||||||
N.waitForNotifications handleNotification db
|
SQL.listen db $ SQL.toPgIdentifier dbChannel
|
||||||
|
SQL.waitForNotifications handleNotification db
|
||||||
_ ->
|
_ ->
|
||||||
die $ "Could not listen for notifications on the " <> dbChannel <> " channel"
|
die $ "Could not listen for notifications on the " <> dbChannel <> " channel"
|
||||||
where
|
where
|
||||||
handleFinally dbChannel _ = do
|
handleFinally dbChannel _ = do
|
||||||
-- if the thread dies, we try to recover
|
-- if the thread dies, we try to recover
|
||||||
AppState.logWithZTime appState $ "Retrying listening for notifications on the " <> dbChannel <> " channel.."
|
AppState.logWithZTime appState $ "Retrying listening for notifications on the " <> dbChannel <> " channel.."
|
||||||
|
AppState.putIsListenerOn appState False
|
||||||
-- assume the pool connection was also lost, call the connection worker
|
-- assume the pool connection was also lost, call the connection worker
|
||||||
connectionWorker appState
|
connectionWorker appState
|
||||||
-- retry the listener
|
-- retry the listener
|
||||||
@@ -228,12 +232,12 @@ reReadConfig startingUp appState = do
|
|||||||
AppConfig{..} <- AppState.getConfig appState
|
AppConfig{..} <- AppState.getConfig appState
|
||||||
dbSettings <-
|
dbSettings <-
|
||||||
if configDbConfig then do
|
if configDbConfig then do
|
||||||
qDbSettings <- queryDbSettings (AppState.getPool appState) configDbPreparedStatements
|
qDbSettings <- AppState.usePool appState $ queryDbSettings configDbPreparedStatements
|
||||||
case qDbSettings of
|
case qDbSettings of
|
||||||
Left e -> do
|
Left e -> do
|
||||||
let
|
let
|
||||||
err = PgError False e
|
err = PgError False e
|
||||||
putErr = AppState.logWithZTime appState . toS $ errorPayload err
|
putErr = AppState.logWithZTime appState . T.decodeUtf8 . LBS.toStrict $ errorPayload err
|
||||||
AppState.logWithZTime appState
|
AppState.logWithZTime appState
|
||||||
"An error ocurred when trying to query database settings for the config parameters"
|
"An error ocurred when trying to query database settings for the config parameters"
|
||||||
case checkIsFatal err of
|
case checkIsFatal err of
|
||||||
@@ -242,7 +246,7 @@ reReadConfig startingUp appState = do
|
|||||||
AppState.logWithZTime appState hint
|
AppState.logWithZTime appState hint
|
||||||
killThread (AppState.getMainThreadId appState)
|
killThread (AppState.getMainThreadId appState)
|
||||||
Nothing -> do
|
Nothing -> do
|
||||||
AppState.logWithZTime appState $ show e
|
putErr
|
||||||
pure []
|
pure []
|
||||||
Right x -> pure x
|
Right x -> pure x
|
||||||
else
|
else
|
||||||
@@ -252,10 +256,10 @@ reReadConfig startingUp appState = do
|
|||||||
if startingUp then
|
if startingUp then
|
||||||
panic err -- die on invalid config if the program is starting up
|
panic err -- die on invalid config if the program is starting up
|
||||||
else
|
else
|
||||||
AppState.logWithZTime appState $ "Failed re-loading config: " <> err
|
AppState.logWithZTime appState $ "Failed reloading config: " <> err
|
||||||
Right newConf -> do
|
Right newConf -> do
|
||||||
AppState.putConfig appState newConf
|
AppState.putConfig appState newConf
|
||||||
if startingUp then
|
if startingUp then
|
||||||
pass
|
pass
|
||||||
else
|
else
|
||||||
AppState.logWithZTime appState "Config re-loaded"
|
AppState.logWithZTime appState "Config reloaded"
|
||||||
|
|||||||
+10
-4
@@ -1,4 +1,4 @@
|
|||||||
resolver: lts-18.2 # 2021-07-10, GHC 8.10.4
|
resolver: lts-19.14 # 2022-07-01, GHC 9.0.2
|
||||||
|
|
||||||
nix:
|
nix:
|
||||||
packages:
|
packages:
|
||||||
@@ -10,6 +10,12 @@ nix:
|
|||||||
pure: false
|
pure: false
|
||||||
|
|
||||||
extra-deps:
|
extra-deps:
|
||||||
- hasql-dynamic-statements-0.3.1@sha256:c3a2c89c4a8b3711368dbd33f0ccfe46a493faa7efc2c85d3e354c56a01dfc48,2673
|
- HTTP-4000.3.16@sha256:6042643c15a0b43e522a6693f1e322f05000d519543a84149cb80aeffee34f71,5947
|
||||||
- hasql-implicits-0.1.0.2@sha256:5d54e09cb779a209681b139fb3cc726bae75134557932156340cc0a56dd834a8,1361
|
- configurator-pg-0.2.6@sha256:cd9b06a458428e493a4d6def725af7ab1ab0fef678fbd871f9586fc7f9aa70be,2849
|
||||||
- ptr-0.16.8.1@sha256:525219ec5f5da5c699725f7efcef91b00a7d44120fc019878b85c09440bf51d6,2686
|
- hasql-dynamic-statements-0.3.1.1@sha256:2cfe6e75990e690f595a87cbe553f2e90fcd738610f6c66749c81cc4396b2cc4,2675
|
||||||
|
- hasql-implicits-0.1.0.4@sha256:0848d3cbc9d94e1e539948fa0be4d0326b26335034161bf8076785293444ca6f,1361
|
||||||
|
- hasql-pool-0.5.2.2@sha256:b56d4dea112d97a2ef4b2749508c0ca646828cb2d77b827e8dc433d249bb2062,2438
|
||||||
|
- lens-aeson-1.1.3@sha256:52c8eaecd2d1c2a969c0762277c4a8ee72c339a686727d5785932e72ef9c3050,1764
|
||||||
|
- optparse-applicative-0.16.1.0@sha256:418c22ed6a19124d457d96bc66bd22c93ac22fad0c7100fe4972bbb4ac989731,4982
|
||||||
|
- protolude-0.3.2@sha256:2a38b3dad40d238ab644e234b692c8911423f9d3ed0e36b62287c4a698d92cd1,2240
|
||||||
|
- ptr-0.16.8.2@sha256:708ebb95117f2872d2c5a554eb6804cf1126e86abe793b2673f913f14e5eb1ac,3959
|
||||||
|
|||||||
+58
-16
@@ -5,29 +5,71 @@
|
|||||||
|
|
||||||
packages:
|
packages:
|
||||||
- completed:
|
- completed:
|
||||||
hackage: hasql-dynamic-statements-0.3.1@sha256:c3a2c89c4a8b3711368dbd33f0ccfe46a493faa7efc2c85d3e354c56a01dfc48,2673
|
hackage: HTTP-4000.3.16@sha256:6042643c15a0b43e522a6693f1e322f05000d519543a84149cb80aeffee34f71,5947
|
||||||
pantry-tree:
|
pantry-tree:
|
||||||
size: 641
|
size: 1428
|
||||||
sha256: b1b9a6a26ec765e5fe29f9a670a5c9ec7067ea00dee8491f0819284ff0201b6f
|
sha256: b73a7f6d21cf20bbf819e19039409c9010efb5000d2b72cdd8fd67a9027c14e8
|
||||||
original:
|
original:
|
||||||
hackage: hasql-dynamic-statements-0.3.1@sha256:c3a2c89c4a8b3711368dbd33f0ccfe46a493faa7efc2c85d3e354c56a01dfc48,2673
|
hackage: HTTP-4000.3.16@sha256:6042643c15a0b43e522a6693f1e322f05000d519543a84149cb80aeffee34f71,5947
|
||||||
- completed:
|
- completed:
|
||||||
hackage: hasql-implicits-0.1.0.2@sha256:5d54e09cb779a209681b139fb3cc726bae75134557932156340cc0a56dd834a8,1361
|
hackage: configurator-pg-0.2.6@sha256:cd9b06a458428e493a4d6def725af7ab1ab0fef678fbd871f9586fc7f9aa70be,2849
|
||||||
pantry-tree:
|
pantry-tree:
|
||||||
size: 310
|
size: 2463
|
||||||
sha256: 2f00d1467d0e226b966c2cd7bac433c8948e2f7bbdf8a44936029f66fc20b5f3
|
sha256: 97efe7a22afc93033bda5adcffdabc0f1c30dc32b2c3ba02114ce7cd74c942fd
|
||||||
original:
|
original:
|
||||||
hackage: hasql-implicits-0.1.0.2@sha256:5d54e09cb779a209681b139fb3cc726bae75134557932156340cc0a56dd834a8,1361
|
hackage: configurator-pg-0.2.6@sha256:cd9b06a458428e493a4d6def725af7ab1ab0fef678fbd871f9586fc7f9aa70be,2849
|
||||||
- completed:
|
- completed:
|
||||||
hackage: ptr-0.16.8.1@sha256:525219ec5f5da5c699725f7efcef91b00a7d44120fc019878b85c09440bf51d6,2686
|
hackage: hasql-dynamic-statements-0.3.1.1@sha256:2cfe6e75990e690f595a87cbe553f2e90fcd738610f6c66749c81cc4396b2cc4,2675
|
||||||
pantry-tree:
|
pantry-tree:
|
||||||
size: 1089
|
size: 595
|
||||||
sha256: d2b8440a738719ef8430ec38fe33b129e3940e4ccf2c016a727a1110a43656bb
|
sha256: b84ae10a5c776f88f546df73bc957a35e61056400b7e805dad0b254612907e97
|
||||||
original:
|
original:
|
||||||
hackage: ptr-0.16.8.1@sha256:525219ec5f5da5c699725f7efcef91b00a7d44120fc019878b85c09440bf51d6,2686
|
hackage: hasql-dynamic-statements-0.3.1.1@sha256:2cfe6e75990e690f595a87cbe553f2e90fcd738610f6c66749c81cc4396b2cc4,2675
|
||||||
|
- completed:
|
||||||
|
hackage: hasql-implicits-0.1.0.4@sha256:0848d3cbc9d94e1e539948fa0be4d0326b26335034161bf8076785293444ca6f,1361
|
||||||
|
pantry-tree:
|
||||||
|
size: 264
|
||||||
|
sha256: d49af8f8749ab7039fa668af4b78f997f7fa2928b4aded6798f573a3d08e76a0
|
||||||
|
original:
|
||||||
|
hackage: hasql-implicits-0.1.0.4@sha256:0848d3cbc9d94e1e539948fa0be4d0326b26335034161bf8076785293444ca6f,1361
|
||||||
|
- completed:
|
||||||
|
hackage: hasql-pool-0.5.2.2@sha256:b56d4dea112d97a2ef4b2749508c0ca646828cb2d77b827e8dc433d249bb2062,2438
|
||||||
|
pantry-tree:
|
||||||
|
size: 412
|
||||||
|
sha256: 2741a33f947d28b4076c798c20c1f646beecd21f5eaf522c8256cbeb34d4d6d0
|
||||||
|
original:
|
||||||
|
hackage: hasql-pool-0.5.2.2@sha256:b56d4dea112d97a2ef4b2749508c0ca646828cb2d77b827e8dc433d249bb2062,2438
|
||||||
|
- completed:
|
||||||
|
hackage: lens-aeson-1.1.3@sha256:52c8eaecd2d1c2a969c0762277c4a8ee72c339a686727d5785932e72ef9c3050,1764
|
||||||
|
pantry-tree:
|
||||||
|
size: 541
|
||||||
|
sha256: b31392b78f2a03111c805f4400007778eb93b49f998ab41dfbebaaf9b5526bad
|
||||||
|
original:
|
||||||
|
hackage: lens-aeson-1.1.3@sha256:52c8eaecd2d1c2a969c0762277c4a8ee72c339a686727d5785932e72ef9c3050,1764
|
||||||
|
- completed:
|
||||||
|
hackage: optparse-applicative-0.16.1.0@sha256:418c22ed6a19124d457d96bc66bd22c93ac22fad0c7100fe4972bbb4ac989731,4982
|
||||||
|
pantry-tree:
|
||||||
|
size: 2979
|
||||||
|
sha256: dd092d843091c08691485d68a1908517079b1bc6f3d73928f37635a19dc27fc1
|
||||||
|
original:
|
||||||
|
hackage: optparse-applicative-0.16.1.0@sha256:418c22ed6a19124d457d96bc66bd22c93ac22fad0c7100fe4972bbb4ac989731,4982
|
||||||
|
- completed:
|
||||||
|
hackage: protolude-0.3.2@sha256:2a38b3dad40d238ab644e234b692c8911423f9d3ed0e36b62287c4a698d92cd1,2240
|
||||||
|
pantry-tree:
|
||||||
|
size: 1594
|
||||||
|
sha256: a36d2912ac552d950ba4476de7d950b56b82dd28e48b9f4d0efee938f10bc525
|
||||||
|
original:
|
||||||
|
hackage: protolude-0.3.2@sha256:2a38b3dad40d238ab644e234b692c8911423f9d3ed0e36b62287c4a698d92cd1,2240
|
||||||
|
- completed:
|
||||||
|
hackage: ptr-0.16.8.2@sha256:708ebb95117f2872d2c5a554eb6804cf1126e86abe793b2673f913f14e5eb1ac,3959
|
||||||
|
pantry-tree:
|
||||||
|
size: 1303
|
||||||
|
sha256: 557c438345de19f82bf01d676100da2a191ef06f624e7a4b90b09ac17cbb52a5
|
||||||
|
original:
|
||||||
|
hackage: ptr-0.16.8.2@sha256:708ebb95117f2872d2c5a554eb6804cf1126e86abe793b2673f913f14e5eb1ac,3959
|
||||||
snapshots:
|
snapshots:
|
||||||
- completed:
|
- completed:
|
||||||
size: 585392
|
size: 618951
|
||||||
url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/18/2.yaml
|
url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/19/14.yaml
|
||||||
sha256: 7abb45c0cc5eb349448b66d8753655542d45d387ad26970419282eab3d860724
|
sha256: 4c31d4ef975b0211078862566aedf3b82b6cea569fc2cde4c72a51e5a8d236ce
|
||||||
original: lts-18.2
|
original: lts-19.14
|
||||||
|
|||||||
Binary file not shown.
|
Before Width: | Height: | Size: 4.2 KiB |
@@ -1,74 +0,0 @@
|
|||||||
module Feature.CorsSpec where
|
|
||||||
|
|
||||||
-- {{{ Imports
|
|
||||||
import qualified Data.ByteString.Lazy as BL
|
|
||||||
|
|
||||||
import Network.Wai (Application)
|
|
||||||
import Network.Wai.Test (SResponse (simpleBody, simpleHeaders))
|
|
||||||
|
|
||||||
import Network.HTTP.Types
|
|
||||||
import Test.Hspec
|
|
||||||
import Test.Hspec.Wai
|
|
||||||
|
|
||||||
import Protolude
|
|
||||||
import SpecHelper
|
|
||||||
-- }}}
|
|
||||||
|
|
||||||
spec :: SpecWith ((), Application)
|
|
||||||
spec =
|
|
||||||
describe "CORS" $ do
|
|
||||||
let preflightHeaders = [
|
|
||||||
("Accept", "*/*"),
|
|
||||||
("Origin", "http://example.com"),
|
|
||||||
("Access-Control-Request-Method", "POST"),
|
|
||||||
("Access-Control-Request-Headers", "Foo,Bar") ]
|
|
||||||
let normalCors = [
|
|
||||||
("Host", "localhost:3000"),
|
|
||||||
("User-Agent", "Mozilla/5.0 (Macintosh; Intel Mac OS X 10.9; rv:32.0) Gecko/20100101 Firefox/32.0"),
|
|
||||||
("Origin", "http://localhost:8000"),
|
|
||||||
("Accept", "text/csv, */*; q=0.01"),
|
|
||||||
("Accept-Language", "en-US,en;q=0.5"),
|
|
||||||
("Accept-Encoding", "gzip, deflate"),
|
|
||||||
("Referer", "http://localhost:8000/"),
|
|
||||||
("Connection", "keep-alive") ]
|
|
||||||
|
|
||||||
describe "preflight request" $ do
|
|
||||||
it "replies naively and permissively to preflight request" $ do
|
|
||||||
r <- request methodOptions "/items" preflightHeaders ""
|
|
||||||
liftIO $ do
|
|
||||||
let respHeaders = simpleHeaders r
|
|
||||||
respHeaders `shouldSatisfy` matchHeader
|
|
||||||
"Access-Control-Allow-Origin"
|
|
||||||
"http://example.com"
|
|
||||||
respHeaders `shouldSatisfy` matchHeader
|
|
||||||
"Access-Control-Allow-Credentials"
|
|
||||||
"true"
|
|
||||||
respHeaders `shouldSatisfy` matchHeader
|
|
||||||
"Access-Control-Allow-Methods"
|
|
||||||
"GET, POST, PATCH, PUT, DELETE, OPTIONS, HEAD"
|
|
||||||
respHeaders `shouldSatisfy` matchHeader
|
|
||||||
"Access-Control-Allow-Headers"
|
|
||||||
"Authentication, Foo, Bar, Accept, Accept-Language, Content-Language"
|
|
||||||
respHeaders `shouldSatisfy` matchHeader
|
|
||||||
"Access-Control-Max-Age"
|
|
||||||
"86400"
|
|
||||||
|
|
||||||
it "suppresses body in response" $ do
|
|
||||||
r <- request methodOptions "/" preflightHeaders ""
|
|
||||||
liftIO $ simpleBody r `shouldBe` ""
|
|
||||||
|
|
||||||
describe "regular request" $
|
|
||||||
it "exposes necesssary response headers" $ do
|
|
||||||
r <- request methodGet "/items" [("Origin", "http://example.com")] ""
|
|
||||||
liftIO $ simpleHeaders r `shouldSatisfy` matchHeader
|
|
||||||
"Access-Control-Expose-Headers"
|
|
||||||
"Content-Encoding, Content-Location, Content-Range, Content-Type, \
|
|
||||||
\Date, Location, Server, Transfer-Encoding, Range-Unit"
|
|
||||||
|
|
||||||
describe "postflight request" $
|
|
||||||
it "allows INFO body through even with CORS request headers present" $ do
|
|
||||||
r <- request methodOptions "/items" normalCors ""
|
|
||||||
liftIO $ do
|
|
||||||
simpleHeaders r `shouldSatisfy` matchHeader
|
|
||||||
"Access-Control-Allow-Origin" "\\*"
|
|
||||||
simpleBody r `shouldSatisfy` BL.null
|
|
||||||
@@ -1,92 +0,0 @@
|
|||||||
module Feature.DeleteSpec where
|
|
||||||
|
|
||||||
import Network.Wai (Application)
|
|
||||||
|
|
||||||
import Network.HTTP.Types
|
|
||||||
import Test.Hspec
|
|
||||||
import Test.Hspec.Wai
|
|
||||||
import Test.Hspec.Wai.JSON
|
|
||||||
|
|
||||||
import Protolude hiding (get)
|
|
||||||
|
|
||||||
spec :: SpecWith ((), Application)
|
|
||||||
spec =
|
|
||||||
describe "Deleting" $ do
|
|
||||||
context "existing record" $ do
|
|
||||||
it "succeeds with 204 and deletion count" $
|
|
||||||
request methodDelete "/items?id=eq.1" [] ""
|
|
||||||
`shouldRespondWith` ""
|
|
||||||
{ matchStatus = 204
|
|
||||||
, matchHeaders = ["Content-Range" <:> "*/*"]
|
|
||||||
}
|
|
||||||
|
|
||||||
it "returns the deleted item and count if requested" $
|
|
||||||
request methodDelete "/items?id=eq.2" [("Prefer", "return=representation"), ("Prefer", "count=exact")] ""
|
|
||||||
`shouldRespondWith` [json|[{"id":2}]|]
|
|
||||||
{ matchStatus = 200
|
|
||||||
, matchHeaders = ["Content-Range" <:> "*/1"]
|
|
||||||
}
|
|
||||||
|
|
||||||
it "ignores ?select= when return not set or return=minimal" $ do
|
|
||||||
request methodDelete "/items?id=eq.3&select=id" [] ""
|
|
||||||
`shouldRespondWith` ""
|
|
||||||
{ matchStatus = 204
|
|
||||||
, matchHeaders = ["Content-Range" <:> "*/*"]
|
|
||||||
}
|
|
||||||
request methodDelete "/items?id=eq.3&select=id" [("Prefer", "return=minimal")] ""
|
|
||||||
`shouldRespondWith` ""
|
|
||||||
{ matchStatus = 204
|
|
||||||
, matchHeaders = ["Content-Range" <:> "*/*"]
|
|
||||||
}
|
|
||||||
|
|
||||||
it "returns the deleted item and shapes the response" $
|
|
||||||
request methodDelete "/complex_items?id=eq.2&select=id,name" [("Prefer", "return=representation")] ""
|
|
||||||
`shouldRespondWith` [json|[{"id":2,"name":"Two"}]|]
|
|
||||||
{ matchStatus = 200
|
|
||||||
, matchHeaders = ["Content-Range" <:> "*/*"]
|
|
||||||
}
|
|
||||||
|
|
||||||
it "can rename and cast the selected columns" $
|
|
||||||
request methodDelete "/complex_items?id=eq.3&select=ciId:id::text,ciName:name" [("Prefer", "return=representation")] ""
|
|
||||||
`shouldRespondWith` [json|[{"ciId":"3","ciName":"Three"}]|]
|
|
||||||
|
|
||||||
it "can embed (parent) entities" $
|
|
||||||
request methodDelete "/tasks?id=eq.8&select=id,name,project:projects(id)" [("Prefer", "return=representation")] ""
|
|
||||||
`shouldRespondWith` [json|[{"id":8,"name":"Code OSX","project":{"id":4}}]|]
|
|
||||||
{ matchStatus = 200
|
|
||||||
, matchHeaders = ["Content-Range" <:> "*/*"]
|
|
||||||
}
|
|
||||||
|
|
||||||
context "known route, no records matched" $
|
|
||||||
it "includes [] body if return=rep" $
|
|
||||||
request methodDelete "/items?id=eq.101"
|
|
||||||
[("Prefer", "return=representation")] ""
|
|
||||||
`shouldRespondWith` "[]"
|
|
||||||
{ matchStatus = 200
|
|
||||||
, matchHeaders = ["Content-Range" <:> "*/*"]
|
|
||||||
}
|
|
||||||
|
|
||||||
context "totally unknown route" $
|
|
||||||
it "fails with 404" $
|
|
||||||
request methodDelete "/foozle?id=eq.101" [] "" `shouldRespondWith` 404
|
|
||||||
|
|
||||||
context "table with limited privileges" $ do
|
|
||||||
it "fails deleting the row when return=representation and selecting all the columns" $
|
|
||||||
request methodDelete "/app_users?id=eq.1" [("Prefer", "return=representation")] mempty
|
|
||||||
`shouldRespondWith` 401
|
|
||||||
|
|
||||||
it "succeeds deleting the row when return=representation and selecting only the privileged columns" $
|
|
||||||
request methodDelete "/app_users?id=eq.1&select=id,email" [("Prefer", "return=representation")]
|
|
||||||
[json| { "password": "passxyz" } |]
|
|
||||||
`shouldRespondWith` [json|[ { "id": 1, "email": "test@123.com" } ]|]
|
|
||||||
{ matchStatus = 200
|
|
||||||
, matchHeaders = ["Content-Range" <:> "*/*"]
|
|
||||||
}
|
|
||||||
|
|
||||||
it "suceeds deleting the row with no explicit select when using return=minimal" $
|
|
||||||
request methodDelete "/app_users?id=eq.2" [("Prefer", "return=minimal")] mempty
|
|
||||||
`shouldRespondWith` 204
|
|
||||||
|
|
||||||
it "suceeds deleting the row with no explicit select by default" $
|
|
||||||
request methodDelete "/app_users?id=eq.3" [] mempty
|
|
||||||
`shouldRespondWith` 204
|
|
||||||
@@ -1,31 +0,0 @@
|
|||||||
module Feature.NoJwtSpec where
|
|
||||||
|
|
||||||
-- {{{ Imports
|
|
||||||
|
|
||||||
import Network.Wai (Application)
|
|
||||||
|
|
||||||
import Network.HTTP.Types
|
|
||||||
import Test.Hspec
|
|
||||||
import Test.Hspec.Wai
|
|
||||||
import Test.Hspec.Wai.JSON
|
|
||||||
|
|
||||||
import Protolude
|
|
||||||
import SpecHelper
|
|
||||||
-- }}}
|
|
||||||
|
|
||||||
spec :: SpecWith ((), Application)
|
|
||||||
spec = describe "server started without JWT secret" $ do
|
|
||||||
|
|
||||||
-- this test will stop working 9999999999s after the UNIX EPOCH
|
|
||||||
it "responds with error on attempted auth" $ do
|
|
||||||
let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJleHAiOjk5OTk5OTk5OTksInJvbGUiOiJwb3N0Z3Jlc3RfdGVzdF9hdXRob3IiLCJpZCI6Impkb2UifQ.Dpss-QoLYjec5OTsOaAc3FNVsSjA89wACoV-0ra3ClA"
|
|
||||||
request methodGet "/authors_only" [auth] ""
|
|
||||||
`shouldRespondWith`
|
|
||||||
[json|{"message":"Server lacks JWT secret"}|]
|
|
||||||
{ matchStatus = 500
|
|
||||||
, matchHeaders = [ matchContentTypeJson ]
|
|
||||||
}
|
|
||||||
|
|
||||||
it "behaves normally when user does not attempt auth" $
|
|
||||||
request methodGet "/items" [] ""
|
|
||||||
`shouldRespondWith` 200
|
|
||||||
@@ -1,17 +0,0 @@
|
|||||||
module Feature.NonexistentSchemaSpec where
|
|
||||||
|
|
||||||
import Network.Wai (Application)
|
|
||||||
|
|
||||||
import Test.Hspec
|
|
||||||
import Test.Hspec.Wai
|
|
||||||
|
|
||||||
import Protolude hiding (get)
|
|
||||||
|
|
||||||
spec :: SpecWith ((), Application)
|
|
||||||
spec =
|
|
||||||
describe "Non existent api schema" $ do
|
|
||||||
it "succeeds when requesting root path" $
|
|
||||||
get "/" `shouldRespondWith` 200
|
|
||||||
|
|
||||||
it "gives 404 when requesting a nonexistent table in this nonexistent schema" $
|
|
||||||
get "/nonexistent_table" `shouldRespondWith` 404
|
|
||||||
@@ -1,71 +0,0 @@
|
|||||||
module Feature.OptionsSpec where
|
|
||||||
|
|
||||||
import Network.Wai (Application)
|
|
||||||
import Network.Wai.Test (SResponse (..))
|
|
||||||
|
|
||||||
import Network.HTTP.Types
|
|
||||||
import Test.Hspec
|
|
||||||
import Test.Hspec.Wai
|
|
||||||
|
|
||||||
import Protolude
|
|
||||||
import SpecHelper
|
|
||||||
|
|
||||||
spec :: SpecWith ((), Application)
|
|
||||||
spec = describe "Allow header" $ do
|
|
||||||
context "a table" $ do
|
|
||||||
it "includes read/write verbs for writeable table" $ do
|
|
||||||
r <- request methodOptions "/items" [] ""
|
|
||||||
liftIO $
|
|
||||||
simpleHeaders r `shouldSatisfy`
|
|
||||||
matchHeader "Allow" "OPTIONS,GET,HEAD,POST,PUT,PATCH,DELETE"
|
|
||||||
|
|
||||||
context "a view" $ do
|
|
||||||
context "auto updatable" $ do
|
|
||||||
it "includes read/write verbs for auto updatable views with pk" $ do
|
|
||||||
r <- request methodOptions "/projects_auto_updatable_view_with_pk" [] ""
|
|
||||||
liftIO $
|
|
||||||
simpleHeaders r `shouldSatisfy`
|
|
||||||
matchHeader "Allow" "OPTIONS,GET,HEAD,POST,PUT,PATCH,DELETE"
|
|
||||||
|
|
||||||
it "includes read/write verbs for auto updatable views without pk" $ do
|
|
||||||
r <- request methodOptions "/projects_auto_updatable_view_without_pk" [] ""
|
|
||||||
liftIO $
|
|
||||||
simpleHeaders r `shouldSatisfy`
|
|
||||||
matchHeader "Allow" "OPTIONS,GET,HEAD,POST,PATCH,DELETE"
|
|
||||||
|
|
||||||
context "non auto updatable" $ do
|
|
||||||
it "includes read verbs for non auto updatable views" $ do
|
|
||||||
r <- request methodOptions "/projects_view_without_triggers" [] ""
|
|
||||||
liftIO $
|
|
||||||
simpleHeaders r `shouldSatisfy`
|
|
||||||
matchHeader "Allow" "OPTIONS,GET,HEAD"
|
|
||||||
|
|
||||||
it "includes read/write verbs for insertable, updatable and deletable views with pk" $ do
|
|
||||||
r <- request methodOptions "/projects_view_with_all_triggers_with_pk" [] ""
|
|
||||||
liftIO $
|
|
||||||
simpleHeaders r `shouldSatisfy`
|
|
||||||
matchHeader "Allow" "OPTIONS,GET,HEAD,POST,PUT,PATCH,DELETE"
|
|
||||||
|
|
||||||
it "includes read/write verbs for insertable, updatable and deletable views without pk" $ do
|
|
||||||
r <- request methodOptions "/projects_view_with_all_triggers_without_pk" [] ""
|
|
||||||
liftIO $
|
|
||||||
simpleHeaders r `shouldSatisfy`
|
|
||||||
matchHeader "Allow" "OPTIONS,GET,HEAD,POST,PATCH,DELETE"
|
|
||||||
|
|
||||||
it "includes read and insert verbs for insertable views" $ do
|
|
||||||
r <- request methodOptions "/projects_view_with_insert_trigger" [] ""
|
|
||||||
liftIO $
|
|
||||||
simpleHeaders r `shouldSatisfy`
|
|
||||||
matchHeader "Allow" "OPTIONS,GET,HEAD,POST"
|
|
||||||
|
|
||||||
it "includes read and update verbs for updatable views" $ do
|
|
||||||
r <- request methodOptions "/projects_view_with_update_trigger" [] ""
|
|
||||||
liftIO $
|
|
||||||
simpleHeaders r `shouldSatisfy`
|
|
||||||
matchHeader "Allow" "OPTIONS,GET,HEAD,PATCH"
|
|
||||||
|
|
||||||
it "includes read and delete verbs for deletable views" $ do
|
|
||||||
r <- request methodOptions "/projects_view_with_delete_trigger" [] ""
|
|
||||||
liftIO $
|
|
||||||
simpleHeaders r `shouldSatisfy`
|
|
||||||
matchHeader "Allow" "OPTIONS,GET,HEAD,DELETE"
|
|
||||||
@@ -1,69 +0,0 @@
|
|||||||
module Feature.QueryLimitedSpec where
|
|
||||||
|
|
||||||
import Network.Wai (Application)
|
|
||||||
|
|
||||||
import Network.HTTP.Types
|
|
||||||
import Test.Hspec
|
|
||||||
import Test.Hspec.Wai
|
|
||||||
import Test.Hspec.Wai.JSON
|
|
||||||
|
|
||||||
import Protolude hiding (get)
|
|
||||||
import SpecHelper
|
|
||||||
|
|
||||||
spec :: SpecWith ((), Application)
|
|
||||||
spec =
|
|
||||||
describe "Requesting many items with server limits(max-rows) enabled" $ do
|
|
||||||
it "restricts results" $
|
|
||||||
get "/items?order=id"
|
|
||||||
`shouldRespondWith`
|
|
||||||
[json| [{"id":1},{"id":2}] |]
|
|
||||||
{ matchHeaders = ["Content-Range" <:> "0-1/*"] }
|
|
||||||
|
|
||||||
it "respects additional client limiting" $ do
|
|
||||||
request methodGet "/items"
|
|
||||||
(rangeHdrs $ ByteRangeFromTo 0 0)
|
|
||||||
""
|
|
||||||
`shouldRespondWith`
|
|
||||||
[json| [{"id":1}] |]
|
|
||||||
{ matchHeaders = ["Content-Range" <:> "0-0/*"] }
|
|
||||||
|
|
||||||
it "works on all levels" $
|
|
||||||
get "/users?select=id,tasks(id)&order=id.asc&tasks.order=id.asc"
|
|
||||||
`shouldRespondWith`
|
|
||||||
[json|[{"id":1,"tasks":[{"id":1},{"id":2}]},{"id":2,"tasks":[{"id":5},{"id":6}]}]|]
|
|
||||||
{ matchHeaders = ["Content-Range" <:> "0-1/*"] }
|
|
||||||
|
|
||||||
it "succeeds in getting parent embeds despite the limit, see #647" $
|
|
||||||
get "/tasks?select=id,project:projects(id)&id=gt.5"
|
|
||||||
`shouldRespondWith`
|
|
||||||
[json|[{"id":6,"project":{"id":3}},{"id":7,"project":{"id":4}}]|]
|
|
||||||
{ matchHeaders = ["Content-Range" <:> "0-1/*"] }
|
|
||||||
|
|
||||||
it "can offset the parent embed, being consistent with the other embed types" $
|
|
||||||
get "/tasks?select=id,project:projects(id)&id=gt.5&project.offset=1"
|
|
||||||
`shouldRespondWith`
|
|
||||||
[json|[{"id":6,"project":null}, {"id":7,"project":null}]|]
|
|
||||||
{ matchHeaders = ["Content-Range" <:> "0-1/*"] }
|
|
||||||
|
|
||||||
context "count=estimated" $ do
|
|
||||||
it "uses the query planner guess when query rows > maxRows" $
|
|
||||||
request methodHead "/getallprojects_view" [("Prefer", "count=estimated")] ""
|
|
||||||
`shouldRespondWith`
|
|
||||||
""
|
|
||||||
{ matchStatus = 206
|
|
||||||
, matchHeaders = ["Content-Range" <:> "0-1/2019"]
|
|
||||||
}
|
|
||||||
|
|
||||||
it "gives exact count when query rows <= maxRows" $
|
|
||||||
request methodHead "/getallprojects_view?id=lt.3" [("Prefer", "count=estimated")] ""
|
|
||||||
`shouldRespondWith`
|
|
||||||
""
|
|
||||||
{ matchHeaders = ["Content-Range" <:> "0-1/2"] }
|
|
||||||
|
|
||||||
it "only uses the query planner guess if it's indeed greater than the exact count" $
|
|
||||||
request methodHead "/get_projects_above_view" [("Prefer", "count=estimated")] ""
|
|
||||||
`shouldRespondWith`
|
|
||||||
""
|
|
||||||
{ matchStatus = 206
|
|
||||||
, matchHeaders = ["Content-Range" <:> "0-1/3"]
|
|
||||||
}
|
|
||||||
-227
@@ -1,227 +0,0 @@
|
|||||||
module Main where
|
|
||||||
|
|
||||||
import qualified Data.Aeson as JSON
|
|
||||||
import qualified Hasql.Pool as P
|
|
||||||
import qualified Hasql.Transaction.Sessions as HT
|
|
||||||
|
|
||||||
import Data.Function (id)
|
|
||||||
import Data.List.NonEmpty (toList)
|
|
||||||
|
|
||||||
import Test.Hspec
|
|
||||||
|
|
||||||
import PostgREST.App (postgrest)
|
|
||||||
import PostgREST.Config (AppConfig (..), LogLevel (..))
|
|
||||||
import PostgREST.Config.Database (queryPgVersion)
|
|
||||||
import PostgREST.Config.PgVersion (pgVersion96)
|
|
||||||
import PostgREST.DbStructure (queryDbStructure)
|
|
||||||
import Protolude hiding (toList, toS)
|
|
||||||
import Protolude.Conv (toS)
|
|
||||||
import SpecHelper
|
|
||||||
|
|
||||||
import qualified PostgREST.AppState as AppState
|
|
||||||
|
|
||||||
import qualified Feature.AndOrParamsSpec
|
|
||||||
import qualified Feature.AsymmetricJwtSpec
|
|
||||||
import qualified Feature.AudienceJwtSecretSpec
|
|
||||||
import qualified Feature.AuthSpec
|
|
||||||
import qualified Feature.BinaryJwtSecretSpec
|
|
||||||
import qualified Feature.ConcurrentSpec
|
|
||||||
import qualified Feature.CorsSpec
|
|
||||||
import qualified Feature.DeleteSpec
|
|
||||||
import qualified Feature.DisabledOpenApiSpec
|
|
||||||
import qualified Feature.EmbedDisambiguationSpec
|
|
||||||
import qualified Feature.ExtraSearchPathSpec
|
|
||||||
import qualified Feature.HtmlRawOutputSpec
|
|
||||||
import qualified Feature.IgnorePrivOpenApiSpec
|
|
||||||
import qualified Feature.InsertSpec
|
|
||||||
import qualified Feature.JsonOperatorSpec
|
|
||||||
import qualified Feature.MultipleSchemaSpec
|
|
||||||
import qualified Feature.NoJwtSpec
|
|
||||||
import qualified Feature.NonexistentSchemaSpec
|
|
||||||
import qualified Feature.OpenApiSpec
|
|
||||||
import qualified Feature.OptionsSpec
|
|
||||||
import qualified Feature.ProxySpec
|
|
||||||
import qualified Feature.QueryLimitedSpec
|
|
||||||
import qualified Feature.QuerySpec
|
|
||||||
import qualified Feature.RangeSpec
|
|
||||||
import qualified Feature.RawOutputTypesSpec
|
|
||||||
import qualified Feature.RollbackSpec
|
|
||||||
import qualified Feature.RootSpec
|
|
||||||
import qualified Feature.RpcPreRequestGucsSpec
|
|
||||||
import qualified Feature.RpcSpec
|
|
||||||
import qualified Feature.SingularSpec
|
|
||||||
import qualified Feature.UnicodeSpec
|
|
||||||
import qualified Feature.UpdateSpec
|
|
||||||
import qualified Feature.UpsertSpec
|
|
||||||
|
|
||||||
|
|
||||||
main :: IO ()
|
|
||||||
main = do
|
|
||||||
testDbConn <- getEnvVarWithDefault "PGRST_DB_URI" "postgres://postgrest_test@localhost/postgrest_test"
|
|
||||||
|
|
||||||
pool <- P.acquire (3, 10, toS testDbConn)
|
|
||||||
|
|
||||||
actualPgVersion <- either (panic.show) id <$> P.use pool queryPgVersion
|
|
||||||
|
|
||||||
baseDbStructure <-
|
|
||||||
loadDbStructure pool
|
|
||||||
(configDbSchemas $ testCfg testDbConn)
|
|
||||||
(configDbExtraSearchPath $ testCfg testDbConn)
|
|
||||||
|
|
||||||
let
|
|
||||||
-- For tests that run with the same refDbStructure
|
|
||||||
app cfg = do
|
|
||||||
let config = cfg testDbConn
|
|
||||||
appState <- AppState.initWithPool pool config
|
|
||||||
AppState.putPgVersion appState actualPgVersion
|
|
||||||
AppState.putDbStructure appState baseDbStructure
|
|
||||||
when (isJust $ configDbRootSpec config) $
|
|
||||||
AppState.putJsonDbS appState $ toS $ JSON.encode baseDbStructure
|
|
||||||
return ((), postgrest LogCrit appState $ pure ())
|
|
||||||
|
|
||||||
-- For tests that run with a different DbStructure(depends on configSchemas)
|
|
||||||
appDbs cfg = do
|
|
||||||
let config = cfg testDbConn
|
|
||||||
customDbStructure <-
|
|
||||||
loadDbStructure pool
|
|
||||||
(configDbSchemas config)
|
|
||||||
(configDbExtraSearchPath config)
|
|
||||||
appState <- AppState.initWithPool pool config
|
|
||||||
AppState.putDbStructure appState customDbStructure
|
|
||||||
when (isJust $ configDbRootSpec config) $
|
|
||||||
AppState.putJsonDbS appState $ toS $ JSON.encode baseDbStructure
|
|
||||||
return ((), postgrest LogCrit appState $ pure ())
|
|
||||||
|
|
||||||
let withApp = app testCfg
|
|
||||||
maxRowsApp = app testMaxRowsCfg
|
|
||||||
disabledOpenApi = app testDisabledOpenApiCfg
|
|
||||||
proxyApp = app testProxyCfg
|
|
||||||
noJwtApp = app testCfgNoJWT
|
|
||||||
binaryJwtApp = app testCfgBinaryJWT
|
|
||||||
audJwtApp = app testCfgAudienceJWT
|
|
||||||
asymJwkApp = app testCfgAsymJWK
|
|
||||||
asymJwkSetApp = app testCfgAsymJWKSet
|
|
||||||
rootSpecApp = app testCfgRootSpec
|
|
||||||
htmlRawOutputApp = app testCfgHtmlRawOutput
|
|
||||||
responseHeadersApp = app testCfgResponseHeaders
|
|
||||||
disallowRollbackApp = app testCfgDisallowRollback
|
|
||||||
forceRollbackApp = app testCfgForceRollback
|
|
||||||
|
|
||||||
extraSearchPathApp = appDbs testCfgExtraSearchPath
|
|
||||||
unicodeApp = appDbs testUnicodeCfg
|
|
||||||
nonexistentSchemaApp = appDbs testNonexistentSchemaCfg
|
|
||||||
multipleSchemaApp = appDbs testMultipleSchemaCfg
|
|
||||||
ignorePrivOpenApi = appDbs testIgnorePrivOpenApiCfg
|
|
||||||
|
|
||||||
let analyze :: IO ()
|
|
||||||
analyze = do
|
|
||||||
analyzeTable testDbConn "items"
|
|
||||||
analyzeTable testDbConn "child_entities"
|
|
||||||
|
|
||||||
specs = uncurry describe <$> [
|
|
||||||
("Feature.AndOrParamsSpec" , Feature.AndOrParamsSpec.spec actualPgVersion)
|
|
||||||
, ("Feature.AuthSpec" , Feature.AuthSpec.spec actualPgVersion)
|
|
||||||
, ("Feature.ConcurrentSpec" , Feature.ConcurrentSpec.spec)
|
|
||||||
, ("Feature.CorsSpec" , Feature.CorsSpec.spec)
|
|
||||||
, ("Feature.DeleteSpec" , Feature.DeleteSpec.spec)
|
|
||||||
, ("Feature.EmbedDisambiguationSpec" , Feature.EmbedDisambiguationSpec.spec)
|
|
||||||
, ("Feature.InsertSpec" , Feature.InsertSpec.spec actualPgVersion)
|
|
||||||
, ("Feature.JsonOperatorSpec" , Feature.JsonOperatorSpec.spec actualPgVersion)
|
|
||||||
, ("Feature.OpenApiSpec" , Feature.OpenApiSpec.spec)
|
|
||||||
, ("Feature.OptionsSpec" , Feature.OptionsSpec.spec)
|
|
||||||
, ("Feature.QuerySpec" , Feature.QuerySpec.spec actualPgVersion)
|
|
||||||
, ("Feature.RawOutputTypesSpec" , Feature.RawOutputTypesSpec.spec)
|
|
||||||
, ("Feature.RpcSpec" , Feature.RpcSpec.spec actualPgVersion)
|
|
||||||
, ("Feature.SingularSpec" , Feature.SingularSpec.spec)
|
|
||||||
, ("Feature.UpdateSpec" , Feature.UpdateSpec.spec)
|
|
||||||
, ("Feature.UpsertSpec" , Feature.UpsertSpec.spec)
|
|
||||||
]
|
|
||||||
|
|
||||||
hspec $ do
|
|
||||||
mapM_ (parallel . before withApp) specs
|
|
||||||
|
|
||||||
-- we analyze to get accurate results from EXPLAIN
|
|
||||||
parallel $ beforeAll_ analyze . before withApp $
|
|
||||||
describe "Feature.RangeSpec" Feature.RangeSpec.spec
|
|
||||||
|
|
||||||
-- this test runs with a raw-output-media-types set to text/html
|
|
||||||
parallel $ before htmlRawOutputApp $
|
|
||||||
describe "Feature.HtmlRawOutputSpec" Feature.HtmlRawOutputSpec.spec
|
|
||||||
|
|
||||||
-- this test runs with a different server flag
|
|
||||||
parallel $ before maxRowsApp $
|
|
||||||
describe "Feature.QueryLimitedSpec" Feature.QueryLimitedSpec.spec
|
|
||||||
|
|
||||||
-- this test runs with a different schema
|
|
||||||
parallel $ before unicodeApp $
|
|
||||||
describe "Feature.UnicodeSpec" Feature.UnicodeSpec.spec
|
|
||||||
|
|
||||||
-- this test runs with openapi-mode set to disabled
|
|
||||||
parallel $ before disabledOpenApi $
|
|
||||||
describe "Feature.DisabledOpenApiSpec" Feature.DisabledOpenApiSpec.spec
|
|
||||||
|
|
||||||
-- this test runs with openapi-mode set to ignore-acl
|
|
||||||
parallel $ before ignorePrivOpenApi $
|
|
||||||
describe "Feature.IgnorePrivOpenApiSpec" Feature.IgnorePrivOpenApiSpec.spec
|
|
||||||
|
|
||||||
-- this test runs with a proxy
|
|
||||||
parallel $ before proxyApp $
|
|
||||||
describe "Feature.ProxySpec" Feature.ProxySpec.spec
|
|
||||||
|
|
||||||
-- this test runs without a JWT secret
|
|
||||||
parallel $ before noJwtApp $
|
|
||||||
describe "Feature.NoJwtSpec" Feature.NoJwtSpec.spec
|
|
||||||
|
|
||||||
-- this test runs with a binary JWT secret
|
|
||||||
parallel $ before binaryJwtApp $
|
|
||||||
describe "Feature.BinaryJwtSecretSpec" Feature.BinaryJwtSecretSpec.spec
|
|
||||||
|
|
||||||
-- this test runs with a binary JWT secret and an audience claim
|
|
||||||
parallel $ before audJwtApp $
|
|
||||||
describe "Feature.AudienceJwtSecretSpec" Feature.AudienceJwtSecretSpec.spec
|
|
||||||
|
|
||||||
-- this test runs with asymmetric JWK
|
|
||||||
parallel $ before asymJwkApp $
|
|
||||||
describe "Feature.AsymmetricJwtSpec" Feature.AsymmetricJwtSpec.spec
|
|
||||||
|
|
||||||
-- this test runs with asymmetric JWKSet
|
|
||||||
parallel $ before asymJwkSetApp $
|
|
||||||
describe "Feature.AsymmetricJwtSpec" Feature.AsymmetricJwtSpec.spec
|
|
||||||
|
|
||||||
-- this test runs with a nonexistent db-schema
|
|
||||||
parallel $ before nonexistentSchemaApp $
|
|
||||||
describe "Feature.NonexistentSchemaSpec" Feature.NonexistentSchemaSpec.spec
|
|
||||||
|
|
||||||
-- this test runs with an extra search path
|
|
||||||
parallel $ before extraSearchPathApp $
|
|
||||||
describe "Feature.ExtraSearchPathSpec" Feature.ExtraSearchPathSpec.spec
|
|
||||||
|
|
||||||
when (actualPgVersion >= pgVersion96) $ do
|
|
||||||
-- this test runs with a root spec function override
|
|
||||||
parallel $ before rootSpecApp $
|
|
||||||
describe "Feature.RootSpec" Feature.RootSpec.spec
|
|
||||||
parallel $ before responseHeadersApp $
|
|
||||||
describe "Feature.RpcPreRequestGucsSpec" Feature.RpcPreRequestGucsSpec.spec
|
|
||||||
|
|
||||||
-- this test runs with multiple schemas
|
|
||||||
parallel $ before multipleSchemaApp $
|
|
||||||
describe "Feature.MultipleSchemaSpec" $ Feature.MultipleSchemaSpec.spec actualPgVersion
|
|
||||||
|
|
||||||
-- Note: the rollback tests can not run in parallel, because they test persistance and
|
|
||||||
-- this results in race conditions
|
|
||||||
|
|
||||||
-- this test runs with tx-rollback-all = true and tx-allow-override = true
|
|
||||||
before withApp $
|
|
||||||
describe"Feature.RollbackAllowedSpec" Feature.RollbackSpec.allowed
|
|
||||||
|
|
||||||
-- this test runs with tx-rollback-all = false and tx-allow-override = false
|
|
||||||
before disallowRollbackApp $
|
|
||||||
describe "Feature.RollbackDisallowedSpec" Feature.RollbackSpec.disallowed
|
|
||||||
|
|
||||||
-- this test runs with tx-rollback-all = true and tx-allow-override = false
|
|
||||||
before forceRollbackApp $
|
|
||||||
describe "Feature.RollbackForcedSpec" Feature.RollbackSpec.forced
|
|
||||||
|
|
||||||
where
|
|
||||||
loadDbStructure pool schemas extraSearchPath =
|
|
||||||
either (panic.show) id <$> P.use pool (HT.transaction HT.ReadCommitted HT.Read $ queryDbStructure (toList schemas) extraSearchPath True)
|
|
||||||
Some files were not shown because too many files have changed in this diff Show More
Reference in New Issue
Block a user