Compare commits
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
f884da79fe | ||
|
|
10e72ba0c1 | ||
|
|
e1e0cea494 | ||
|
|
d07b5acf15 | ||
|
|
64d02d7375 | ||
|
|
5c822b7ec4 | ||
|
|
de97f646a4 | ||
|
|
a45c639a97 | ||
|
|
1e711051da | ||
|
|
79077c873f | ||
|
|
2ed163945b | ||
|
|
cf3cd4b8d0 | ||
|
|
38ea4378da | ||
|
|
226f1caa24 | ||
|
|
6475f254f7 | ||
|
|
d6cd5d0fb4 | ||
|
|
c73282c3f0 | ||
|
|
d7dfdaa03f | ||
|
|
6c8ce3929c | ||
|
|
f84bc6a0ff | ||
|
|
82ecf836c4 | ||
|
|
c820efb64a | ||
|
|
e30bf53afa | ||
|
|
5ce020d5bc | ||
|
|
fbf9bf21c2 | ||
|
|
d490bf09fd | ||
|
|
aa53623aac | ||
|
|
0fce7ca361 | ||
|
|
d0a71de2da | ||
|
|
40c2bcd4a1 | ||
|
|
0dc67bed0b | ||
|
|
2d00d7d248 | ||
|
|
2977d09779 | ||
|
|
630e0a1691 | ||
|
|
28d5278d62 | ||
|
|
e332f038ef | ||
|
|
905fcb05cc | ||
|
|
774d015eb5 | ||
|
|
e752224f14 | ||
|
|
add10bd10c | ||
|
|
52d3026133 | ||
|
|
5cdafb23e7 | ||
|
|
20b06efabe | ||
|
|
7508230760 | ||
|
|
a17dd41d6b | ||
|
|
0a1564ba5a | ||
|
|
078c6ec08c | ||
|
|
83cf15fb7e | ||
|
|
40dc46ed2e | ||
|
|
d9261fa674 | ||
|
|
856d450775 | ||
|
|
c1a8661ab3 | ||
|
|
aa15f4782e | ||
|
|
77cd9387d4 | ||
|
|
3cd3a3f8c6 | ||
|
|
78821a8fe7 | ||
|
|
5c372df487 | ||
|
|
fad47324c3 | ||
|
|
11a9849152 | ||
|
|
1f13e43abe | ||
|
|
fac797c766 | ||
|
|
07cb0b582e | ||
|
|
d54a2f48de | ||
|
|
bcce7b1c53 | ||
|
|
8d1961ce07 | ||
|
|
9a19dff83e | ||
|
|
54b9a0b8b3 | ||
|
|
9a3d453bf4 | ||
|
|
4f6c466031 | ||
|
|
a852b766eb | ||
|
|
14be3fb671 | ||
|
|
8a3686d86b | ||
|
|
009250006e | ||
|
|
38ad8c04e1 | ||
|
|
54cbf147e3 | ||
|
|
f9f0f79fa9 | ||
|
|
a867d79c42 | ||
|
|
4197d2f739 | ||
|
|
c10ba8e214 | ||
|
|
887948d259 | ||
|
|
c63786733a | ||
|
|
4fe696dd96 | ||
|
|
67936b343f | ||
|
|
b0e395f495 | ||
|
|
3b55a27ef3 | ||
|
|
43da81c30c | ||
|
|
dd2f5511d8 | ||
|
|
49c349c846 | ||
|
|
aaf77902f6 | ||
|
|
4c555cbd5d | ||
|
|
3e53796120 | ||
|
|
0a2b7064c7 | ||
|
|
ce378e6b3a | ||
|
|
feadf59bb3 | ||
|
|
ad7d80a430 | ||
|
|
e572d1d1a2 | ||
|
|
c06237cc56 | ||
|
|
c656a870f4 | ||
|
|
1b625cb77a | ||
|
|
394bd22148 | ||
|
|
963416ae29 | ||
|
|
d3b10e7b2a | ||
|
|
acf62320ef | ||
|
|
16f2849724 | ||
|
|
d945e8c06a | ||
|
|
bc1fb67df0 | ||
|
|
1442e02f5f | ||
|
|
68d2d834ba | ||
|
|
eb777cf823 | ||
|
|
1aed55be68 | ||
|
|
032f07f3f0 | ||
|
|
7629eff51d | ||
|
|
46fd856fc6 | ||
|
|
caaa9a3944 | ||
|
|
439a96c578 | ||
|
|
e731241b97 | ||
|
|
216dc833fd | ||
|
|
a8e02f766b | ||
|
|
cae1c67b00 | ||
|
|
b05ea14122 | ||
|
|
666114f81d | ||
|
|
3e99995e6a | ||
|
|
8213c58452 | ||
|
|
ee036f8397 | ||
|
|
5b6421d03a | ||
|
|
ba00cb98f4 | ||
|
|
6184921edc | ||
|
|
9e0ea113fb | ||
|
|
0d5d209bfb | ||
|
|
253f2bf537 | ||
|
|
2a2889020a | ||
|
|
6a79de67ce | ||
|
|
c49932d3a8 | ||
|
|
95d71281d6 | ||
|
|
a1e2fe308f | ||
|
|
a9d66d1dac | ||
|
|
f4135bb3ff | ||
|
|
d7868235d8 | ||
|
|
60f4446fd8 | ||
|
|
c893ac15dc | ||
|
|
ecada119f8 | ||
|
|
57e32ca0a3 | ||
|
|
eb3f7c696a | ||
|
|
09249f97ab | ||
|
|
754282c385 | ||
|
|
52ba757ebe | ||
|
|
7aadaa44e8 | ||
|
|
0139cd8261 | ||
|
|
7874bee879 | ||
|
|
12ad7d0585 | ||
|
|
9065ed65fa | ||
|
|
8aa79086d2 | ||
|
|
775c006806 | ||
|
|
be6c30a0fb | ||
|
|
8f80cd1469 | ||
|
|
5fd6b3956e | ||
|
|
f353711ed2 | ||
|
|
0a56d6ce88 | ||
|
|
43ad6d6aa0 | ||
|
|
5a0f83ecb8 | ||
|
|
4ddd5b4a76 | ||
|
|
1f69757835 | ||
|
|
e0df95844b | ||
|
|
5a660e0cbe | ||
|
|
566c6fe53f | ||
|
|
d93bb95d83 | ||
|
|
3773cce246 | ||
|
|
52c011f896 | ||
|
|
81cd9d4b15 | ||
|
|
781fa592ca | ||
|
|
1065021348 | ||
|
|
aecc53d8f9 | ||
|
|
a5465e20d0 | ||
|
|
9e567216e9 | ||
|
|
5e9dba5292 | ||
|
|
f7009635d6 | ||
|
|
e5c77385ae | ||
|
|
3103060f4b | ||
|
|
315b01ebf7 | ||
|
|
25f65065f4 | ||
|
|
60c0c11c1d | ||
|
|
cb99270a8f | ||
|
|
cca0b5ae66 | ||
|
|
2aa0e091bb | ||
|
|
78d45b4e32 | ||
|
|
ef42d1c87f | ||
|
|
aaa4fbc370 | ||
|
|
5e65b2afaf | ||
|
|
3408998629 | ||
|
|
b8c5d212ea | ||
|
|
c8e4f38984 | ||
|
|
44dd73adcc | ||
|
|
b2935ef799 | ||
|
|
0b1f8358c6 | ||
|
|
2c31c64325 | ||
|
|
425ab70ec7 | ||
|
|
2cce82bdd5 | ||
|
|
800873ed91 | ||
|
|
b702c5fbe4 | ||
|
|
cfd0ee35d3 | ||
|
|
31cd0bbff4 | ||
|
|
78ec8a095a | ||
|
|
39959fa330 | ||
|
|
fc3a01fabe | ||
|
|
03b810ffa5 | ||
|
|
177ec4df85 | ||
|
|
dbf645b899 | ||
|
|
e274706088 | ||
|
|
da632ac7d3 | ||
|
|
b78b096ae4 | ||
|
|
bbbc308b6f | ||
|
|
ecf54bef43 | ||
|
|
8c0d187044 | ||
|
|
ae8625a7b6 | ||
|
|
7c7a04a27e | ||
|
|
2289defe4b | ||
|
|
772d3c4e01 | ||
|
|
45e7aac218 | ||
|
|
5d126bf0a3 | ||
|
|
f9f572a5d2 | ||
|
|
88b5966a44 | ||
|
|
3d2880d40a | ||
|
|
958e052de5 | ||
|
|
793acd276a | ||
|
|
9be6747b66 | ||
|
|
3bee6b1e27 | ||
|
|
6fe1617348 | ||
|
|
2158f3d039 | ||
|
|
ca338ae401 | ||
|
|
5135fea797 | ||
|
|
df538bfd98 | ||
|
|
7ace8ace49 | ||
|
|
c8b39c6cde | ||
|
|
5f5a0c7764 | ||
|
|
922da4520f | ||
|
|
64e047e5d7 | ||
|
|
efecf007e8 | ||
|
|
b81e15d0c5 | ||
|
|
0fbb116dd2 | ||
|
|
e4b98d51be | ||
|
|
d37e14c4db | ||
|
|
cfaeff8a5a | ||
|
|
6398dd2b32 | ||
|
|
11385bbd9f | ||
|
|
858e4405ec | ||
|
|
46307ca64a | ||
|
|
fd67c8480c | ||
|
|
f54dc2e20e | ||
|
|
e356783cc9 | ||
|
|
b5080fa2d7 | ||
|
|
e564ed6e3e | ||
|
|
8d369a2195 | ||
|
|
92e28bd902 | ||
|
|
c27e7be028 | ||
|
|
9d3bbc736b | ||
|
|
38ecaa44db | ||
|
|
efd65ff1f4 | ||
|
|
d5e662567b | ||
|
|
334f500f7c | ||
|
|
bb52fb9b0e | ||
|
|
74ee6cd674 | ||
|
|
524c6a7c2c | ||
|
|
c9f7504d09 | ||
|
|
ba1fcfd1e3 | ||
|
|
554db21f49 | ||
|
|
ebc34561fa | ||
|
|
5ae9a2b1cf | ||
|
|
e2aa227597 | ||
|
|
81f42d4b8a | ||
|
|
90eaaefe12 | ||
|
|
cdce929159 | ||
|
|
79b865ba79 | ||
|
|
8e96e3b3ae | ||
|
|
0595e564da | ||
|
|
9bb0bc1750 | ||
|
|
950070ce4e | ||
|
|
3b290d524c | ||
|
|
906fac2dd6 | ||
|
|
377944502d |
+1
-1
@@ -3,7 +3,7 @@ freebsd_instance:
|
||||
|
||||
build_task:
|
||||
name: Build FreeBSD (Stack)
|
||||
install_script: pkg install -y postgresql13-client hs-stack
|
||||
install_script: pkg install -y postgresql13-client hs-stack git
|
||||
|
||||
stack_cache:
|
||||
folders: /.stack
|
||||
|
||||
@@ -11,8 +11,10 @@ inputs:
|
||||
runs:
|
||||
using: composite
|
||||
steps:
|
||||
- uses: cachix/install-nix-action@v16
|
||||
- uses: cachix/cachix-action@v10
|
||||
- uses: cachix/install-nix-action@v23
|
||||
with:
|
||||
install_url: https://releases.nixos.org/nix/nix-2.13.3/install
|
||||
- uses: cachix/cachix-action@v12
|
||||
with:
|
||||
name: postgrest
|
||||
authToken: ${{ inputs.authToken }}
|
||||
|
||||
@@ -1,6 +1,11 @@
|
||||
version: 2
|
||||
updates:
|
||||
- package-ecosystem: github-actions
|
||||
directory: /
|
||||
schedule:
|
||||
interval: weekly
|
||||
- package-ecosystem: github-actions
|
||||
directory: /
|
||||
schedule:
|
||||
interval: weekly
|
||||
|
||||
- package-ecosystem: github-actions
|
||||
directory: /.github/actions/setup-nix
|
||||
schedule:
|
||||
interval: weekly
|
||||
|
||||
@@ -7,12 +7,13 @@ set -euo pipefail
|
||||
# https://docs.github.com/en/rest/reference/checks#list-check-suites-for-a-git-reference
|
||||
|
||||
cirrus_artifact_name=bin
|
||||
gh_auth_header="Authorization: Bearer $GITHUB_TOKEN"
|
||||
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" \
|
||||
curl --fail -H "$gh_auth_header" -H "$gh_accept_header" "$gh_checks_list_url" \
|
||||
| jq -r '.check_suites[] | select(.app.slug == "cirrus-ci") | .check_runs_url'
|
||||
}
|
||||
|
||||
@@ -21,7 +22,7 @@ wait_for_cirrusci() {
|
||||
>&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')
|
||||
status=$(curl --fail -H "$gh_auth_header" "$gh_check_runs_url" | jq -r '.check_runs[] | .status')
|
||||
if [ "$status" == "completed" ]; then
|
||||
break
|
||||
else
|
||||
@@ -37,7 +38,7 @@ wait_for_cirrusci() {
|
||||
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" \
|
||||
curl --fail -H "$gh_auth_header" -H "$gh_accept_header" "$gh_check_runs_url" \
|
||||
| jq -r '.check_runs[] | .external_id'
|
||||
}
|
||||
|
||||
|
||||
@@ -4,11 +4,15 @@
|
||||
|
||||
[ -z "$1" ] && { echo "Missing 1st argument: PostgREST github commit SHA"; exit 1; }
|
||||
[ -z "$2" ] && { echo "Missing 2nd argument: Build environment directory name"; exit 1; }
|
||||
[ -z "$3" ] && { echo "Missing 3rd argument: GHC version"; exit 1; }
|
||||
|
||||
PGRST_GITHUB_COMMIT="$1"
|
||||
SCRIPT_DIR="$2"
|
||||
|
||||
DOCKER_BUILD_DIR="$SCRIPT_DIR/docker-env"
|
||||
# latest is a shortcut documented on https://www.haskell.org/ghcup/guide/#tags-and-shortcuts
|
||||
CABAL_VERSION="latest"
|
||||
GHC_VERSION="$3"
|
||||
|
||||
install_packages() {
|
||||
sudo apt-get update -y
|
||||
@@ -26,13 +30,14 @@ install_ghcup() {
|
||||
|
||||
install_cabal() {
|
||||
ghcup upgrade
|
||||
ghcup install cabal 3.6.0.0
|
||||
ghcup set cabal 3.6.0.0
|
||||
ghcup install cabal $CABAL_VERSION
|
||||
ghcup set cabal $CABAL_VERSION
|
||||
}
|
||||
|
||||
install_ghc() {
|
||||
ghcup install ghc 8.10.7
|
||||
ghcup set ghc 8.10.7
|
||||
ghcup upgrade
|
||||
ghcup install ghc $GHC_VERSION
|
||||
ghcup set ghc $GHC_VERSION
|
||||
}
|
||||
|
||||
install_packages
|
||||
@@ -41,8 +46,8 @@ install_packages
|
||||
[ -f ~/.ghcup/env ] && source ~/.ghcup/env
|
||||
|
||||
ghcup --version || install_ghcup
|
||||
cabal --version || install_cabal
|
||||
ghc --version || install_ghc
|
||||
ghcup set cabal $CABAL_VERSION || install_cabal
|
||||
ghcup set ghc $GHC_VERSION || install_ghc
|
||||
|
||||
cd ~/$SCRIPT_DIR
|
||||
|
||||
|
||||
@@ -13,4 +13,6 @@ EXPOSE 3000
|
||||
|
||||
USER 1000
|
||||
|
||||
CMD postgrest
|
||||
# Use the array form to avoid running the command using bash, which does not handle `SIGTERM` properly.
|
||||
# See https://docs.docker.com/compose/faq/#why-do-my-services-take-10-seconds-to-recreate-or-stop
|
||||
CMD ["postgrest"]
|
||||
|
||||
@@ -0,0 +1,78 @@
|
||||
name: Cachix
|
||||
|
||||
# This workflow serves to
|
||||
# - keep cachix up to date with the main branch
|
||||
# - incrementally update cachix for large dependency
|
||||
# updates, e.g. after running postgrest-nixpkgs-upgrade,
|
||||
# which can cause the main CI workflow to time out
|
||||
|
||||
on:
|
||||
workflow_dispatch:
|
||||
push:
|
||||
branches:
|
||||
- main
|
||||
- rel-*
|
||||
tags:
|
||||
- v*
|
||||
|
||||
jobs:
|
||||
Seed-Cachix:
|
||||
strategy:
|
||||
fail-fast: false
|
||||
matrix:
|
||||
include:
|
||||
- os: Linux
|
||||
runs-on: ubuntu-latest
|
||||
- os: MacOS
|
||||
runs-on: macos-latest
|
||||
name: Seed ${{ matrix.os }}
|
||||
runs-on: ${{ matrix.runs-on }}
|
||||
steps:
|
||||
- uses: actions/checkout@v4
|
||||
- name: Setup Nix Environment
|
||||
uses: ./.github/actions/setup-nix
|
||||
with:
|
||||
authToken: '${{ secrets.CACHIX_AUTH_TOKEN }}'
|
||||
|
||||
- name: Install cachix tooling
|
||||
run: |
|
||||
nix-env -f default.nix -iA devTools.pushCachix.bin
|
||||
postgrest-push-cachix
|
||||
|
||||
- name: Seed dynamic postgrest build
|
||||
run: |
|
||||
nix-build -A postgrestPackage
|
||||
postgrest-push-cachix
|
||||
|
||||
- name: Seed style tools
|
||||
run: |
|
||||
nix-build -A style
|
||||
postgrest-push-cachix
|
||||
|
||||
- name: Seed test tools
|
||||
run: |
|
||||
nix-build -A tests
|
||||
postgrest-push-cachix
|
||||
|
||||
- name: Seed static toolchain
|
||||
if: matrix.os == 'Linux'
|
||||
run: |
|
||||
nix-build -A packagesStatic.haskellPackages.hello
|
||||
postgrest-push-cachix
|
||||
|
||||
- name: Seed static postgresql build (for libpq)
|
||||
if: matrix.os == 'Linux'
|
||||
run: |
|
||||
nix-build -A packagesStatic.pkgs.postgresql
|
||||
postgrest-push-cachix
|
||||
|
||||
- name: Seed static postgrest build
|
||||
if: matrix.os == 'Linux'
|
||||
run: |
|
||||
nix-build -A postgrestStatic
|
||||
postgrest-push-cachix
|
||||
|
||||
- name: Build and push everything to Cachix
|
||||
run: |
|
||||
nix-build
|
||||
postgrest-push-cachix
|
||||
+109
-50
@@ -17,7 +17,7 @@ jobs:
|
||||
name: Lint & check code style
|
||||
runs-on: ubuntu-latest
|
||||
steps:
|
||||
- uses: actions/checkout@v3
|
||||
- uses: actions/checkout@v4
|
||||
- name: Setup Nix Environment
|
||||
uses: ./.github/actions/setup-nix
|
||||
with:
|
||||
@@ -37,16 +37,16 @@ jobs:
|
||||
# https://github.com/actions/runner/issues/241#issuecomment-842566950
|
||||
shell: script -qec "bash --noprofile --norc -eo pipefail {0}"
|
||||
steps:
|
||||
- uses: actions/checkout@v3
|
||||
- uses: actions/checkout@v4
|
||||
- name: Setup Nix Environment
|
||||
uses: ./.github/actions/setup-nix
|
||||
with:
|
||||
tools: tests
|
||||
|
||||
- name: Run coverage (IO tests and Spec tests against PostgreSQL 14)
|
||||
- name: Run coverage (IO tests and Spec tests against PostgreSQL 15)
|
||||
run: postgrest-coverage
|
||||
- name: Upload coverage to codecov
|
||||
uses: codecov/codecov-action@v3.1.0
|
||||
uses: codecov/codecov-action@v3.1.4
|
||||
with:
|
||||
files: ./coverage/codecov.json
|
||||
|
||||
@@ -63,7 +63,7 @@ jobs:
|
||||
strategy:
|
||||
fail-fast: false
|
||||
matrix:
|
||||
pgVersion: [9.6, 10, 11, 12, 13, 14]
|
||||
pgVersion: [9.6, 10, 11, 12, 13, 14, 15, 16]
|
||||
name: Test PG ${{ matrix.pgVersion }} (Nix)
|
||||
runs-on: ubuntu-latest
|
||||
defaults:
|
||||
@@ -72,7 +72,7 @@ jobs:
|
||||
# https://github.com/actions/runner/issues/241#issuecomment-842566950
|
||||
shell: script -qec "bash --noprofile --norc -eo pipefail {0}"
|
||||
steps:
|
||||
- uses: actions/checkout@v3
|
||||
- uses: actions/checkout@v4
|
||||
- name: Setup Nix Environment
|
||||
uses: ./.github/actions/setup-nix
|
||||
with:
|
||||
@@ -84,18 +84,14 @@ jobs:
|
||||
|
||||
- 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
|
||||
run: postgrest-with-postgresql-${{ matrix.pgVersion }} -f test/io/fixtures.sql postgrest-test-io -vv
|
||||
|
||||
|
||||
Test-Memory-Nix:
|
||||
name: Test memory (Nix)
|
||||
runs-on: ubuntu-latest
|
||||
steps:
|
||||
- uses: actions/checkout@v3
|
||||
- uses: actions/checkout@v4
|
||||
- name: Setup Nix Environment
|
||||
uses: ./.github/actions/setup-nix
|
||||
with:
|
||||
@@ -108,11 +104,10 @@ jobs:
|
||||
name: Build Linux static (Nix)
|
||||
runs-on: ubuntu-latest
|
||||
steps:
|
||||
- uses: actions/checkout@v3
|
||||
- uses: actions/checkout@v4
|
||||
- name: Setup Nix Environment
|
||||
uses: ./.github/actions/setup-nix
|
||||
with:
|
||||
authToken: '${{ secrets.CACHIX_AUTH_TOKEN }}'
|
||||
tools: tests
|
||||
|
||||
- name: Build static executable
|
||||
@@ -135,12 +130,18 @@ jobs:
|
||||
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' }}
|
||||
|
||||
Build-Macos-Nix:
|
||||
name: Build MacOS (Nix)
|
||||
runs-on: macos-latest
|
||||
steps:
|
||||
- uses: actions/checkout@v4
|
||||
- name: Setup Nix Environment
|
||||
uses: ./.github/actions/setup-nix
|
||||
|
||||
- name: Build everything
|
||||
run: |
|
||||
nix-build
|
||||
nix-env -f default.nix -iA devTools
|
||||
postgrest-push-cachix
|
||||
|
||||
|
||||
Build-Stack:
|
||||
@@ -148,14 +149,14 @@ jobs:
|
||||
fail-fast: false
|
||||
matrix:
|
||||
include:
|
||||
- name: Linux & test
|
||||
- name: Linux
|
||||
runs-on: ubuntu-latest
|
||||
cache: |
|
||||
~/.stack
|
||||
.stack-work
|
||||
artifact: postgrest-ubuntu-x64
|
||||
|
||||
- name: MacOS & test
|
||||
- name: MacOS
|
||||
runs-on: macos-latest
|
||||
cache: |
|
||||
~/.stack
|
||||
@@ -174,7 +175,7 @@ jobs:
|
||||
name: Build ${{ matrix.name }} (Stack)
|
||||
runs-on: ${{ matrix.runs-on }}
|
||||
steps:
|
||||
- uses: actions/checkout@v3
|
||||
- uses: actions/checkout@v4
|
||||
- name: Stack working files cache
|
||||
uses: actions/cache@v3
|
||||
with:
|
||||
@@ -198,11 +199,12 @@ jobs:
|
||||
name: Get FreeBSD build from CirrusCI
|
||||
runs-on: ubuntu-latest
|
||||
steps:
|
||||
- uses: actions/checkout@v3
|
||||
- uses: actions/checkout@v4
|
||||
- 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}}
|
||||
GITHUB_COMMIT: ${{ github.event.pull_request.head.sha || github.sha }}
|
||||
GITHUB_TOKEN: ${{ secrets.GITHUB_TOKEN }}
|
||||
run: .github/get_cirrusci_freebsd
|
||||
- name: Save executable as artifact
|
||||
uses: actions/upload-artifact@v3
|
||||
@@ -211,19 +213,57 @@ jobs:
|
||||
path: postgrest
|
||||
if-no-files-found: error
|
||||
|
||||
Build-Cabal:
|
||||
strategy:
|
||||
matrix:
|
||||
ghc: ['9.0.2', '9.2.4']
|
||||
fail-fast: false
|
||||
name: Build Linux (Cabal, GHC ${{ matrix.ghc }})
|
||||
runs-on: ubuntu-latest
|
||||
steps:
|
||||
- uses: actions/checkout@v4
|
||||
- name: Workaround runner image issue
|
||||
# https://github.com/actions/runner-images/issues/7061
|
||||
run: sudo chown -R "$USER" /usr/local/.ghcup
|
||||
- name: ghcup
|
||||
run: |
|
||||
ghcup install ghc ${{ matrix.ghc }}
|
||||
ghcup set ghc ${{ matrix.ghc }}
|
||||
- name: Copy cabal.project
|
||||
run: |
|
||||
cp cabal.project.non-nix cabal.project
|
||||
- name: Cache
|
||||
uses: actions/cache@v3
|
||||
with:
|
||||
path: ~/.cabal
|
||||
key: ${{ runner.os }}-${{ matrix.ghc }}-${{ hashFiles('**/*.cabal') }}-${{ hashFiles('**/cabal.project') }}
|
||||
restore-keys: |
|
||||
${{ runner.os }}-${{ matrix.ghc }}-
|
||||
- name: Install dependencies
|
||||
run: |
|
||||
cabal update
|
||||
cabal build --only-dependencies --enable-tests --enable-benchmarks
|
||||
- name: Build
|
||||
run: cabal build --enable-tests --enable-benchmarks all
|
||||
|
||||
Build-Cabal-Arm:
|
||||
name: Build aarch64 (Cabal)
|
||||
strategy:
|
||||
matrix:
|
||||
ghc: ['9.2.4']
|
||||
fail-fast: false
|
||||
name: Build aarch64 (Cabal, GHC ${{ matrix.ghc }})
|
||||
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 }}
|
||||
GHC_VERSION: ${{ matrix.ghc }}
|
||||
steps:
|
||||
- uses: actions/checkout@v2.4.0
|
||||
- uses: actions/checkout@v4
|
||||
- id: Remote-Dir
|
||||
name: Unique directory name for the remote build
|
||||
run: echo "::set-output name=remotepath::postgrest-build-$(uuidgen)"
|
||||
run: echo "remotepath=postgrest-build-$(uuidgen)" >> "$GITHUB_OUTPUT"
|
||||
- name: Copy script files to the remote server
|
||||
uses: appleboy/scp-action@master
|
||||
with:
|
||||
@@ -245,8 +285,8 @@ jobs:
|
||||
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"
|
||||
envs: GITHUB_COMMIT,REMOTE_DIR,GHC_VERSION
|
||||
script: bash ~/$REMOTE_DIR/build.sh "$GITHUB_COMMIT" "$REMOTE_DIR" "GHC_VERSION"
|
||||
- name: Download binaries from remote server
|
||||
uses: nicklasfrahm/scp-action@main
|
||||
with:
|
||||
@@ -260,7 +300,7 @@ jobs:
|
||||
- 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
|
||||
uses: actions/upload-artifact@v3
|
||||
with:
|
||||
name: postgrest-ubuntu-aarch64
|
||||
path: result/postgrest
|
||||
@@ -284,7 +324,7 @@ jobs:
|
||||
version: ${{ steps.Identify-Version.outputs.version }}
|
||||
isprerelease: ${{ steps.Identify-Version.outputs.isprerelease }}
|
||||
steps:
|
||||
- uses: actions/checkout@v3
|
||||
- uses: actions/checkout@v4
|
||||
- id: Identify-Version
|
||||
name: Identify the version to be released
|
||||
run: |
|
||||
@@ -296,14 +336,14 @@ jobs:
|
||||
exit 1
|
||||
else
|
||||
echo "Version to be released is $cabal_version"
|
||||
echo "::set-output name=version::$cabal_version"
|
||||
echo "version=$cabal_version" >> "$GITHUB_OUTPUT"
|
||||
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"
|
||||
echo "isprerelease=1" >> "$GITHUB_OUTPUT"
|
||||
fi
|
||||
- name: Identify changes from CHANGELOG.md
|
||||
run: |
|
||||
@@ -337,7 +377,7 @@ jobs:
|
||||
env:
|
||||
VERSION: ${{ needs.Prepare-Release.outputs.version }}
|
||||
steps:
|
||||
- uses: actions/checkout@v3
|
||||
- uses: actions/checkout@v4
|
||||
- name: Download all artifacts
|
||||
uses: actions/download-artifact@v3
|
||||
with:
|
||||
@@ -394,7 +434,6 @@ jobs:
|
||||
name: Release on Docker Hub
|
||||
runs-on: ubuntu-latest
|
||||
needs:
|
||||
- Build-Cabal-Arm
|
||||
- Prepare-Release
|
||||
env:
|
||||
GITHUB_COMMIT: ${{ github.sha }}
|
||||
@@ -404,7 +443,7 @@ jobs:
|
||||
VERSION: ${{ needs.Prepare-Release.outputs.version }}
|
||||
ISPRERELEASE: ${{ needs.Prepare-Release.outputs.isprerelease }}
|
||||
steps:
|
||||
- uses: actions/checkout@v3
|
||||
- uses: actions/checkout@v4
|
||||
- name: Setup Nix Environment
|
||||
uses: ./.github/actions/setup-nix
|
||||
with:
|
||||
@@ -429,18 +468,6 @@ jobs:
|
||||
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
|
||||
@@ -454,17 +481,49 @@ jobs:
|
||||
# echo "Skipping updating description for pre-release..."
|
||||
# fi
|
||||
|
||||
Release-Docker-Arm:
|
||||
name: Release Arm Builds on Docker Hub
|
||||
runs-on: ubuntu-latest
|
||||
needs:
|
||||
- Build-Cabal-Arm
|
||||
- Prepare-Release
|
||||
- Release-Docker
|
||||
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@v4
|
||||
- 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"
|
||||
|
||||
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-')) }}
|
||||
- Release-Docker-Arm
|
||||
if: success() ||
|
||||
needs.Build-Cabal-Arm.result == 'failure' ||
|
||||
needs.Build-Cabal-Arm.result == 'cancelled' ||
|
||||
(needs.Build-Cabal-Arm.result == 'success' && !startsWith(github.ref, 'refs/tags/v'))
|
||||
runs-on: ubuntu-latest
|
||||
env:
|
||||
REMOTE_DIR: ${{ needs.Build-Cabal-Arm.outputs.remotepath }}
|
||||
steps:
|
||||
- uses: actions/checkout@v2.4.0
|
||||
- uses: actions/checkout@v4
|
||||
- name: Remove uploaded files from server
|
||||
uses: appleboy/ssh-action@master
|
||||
with:
|
||||
|
||||
@@ -15,7 +15,7 @@ jobs:
|
||||
name: Loadtest (Nix)
|
||||
runs-on: ubuntu-latest
|
||||
steps:
|
||||
- uses: actions/checkout@v3
|
||||
- uses: actions/checkout@v4
|
||||
with:
|
||||
fetch-depth: 0
|
||||
- name: Setup Nix Environment
|
||||
|
||||
@@ -22,7 +22,7 @@ jobs:
|
||||
name: loadtest.md
|
||||
path: artifacts
|
||||
- name: Upload to GitHub Checks
|
||||
uses: LouisBrunner/checks-action@v1.2.0
|
||||
uses: LouisBrunner/checks-action@v1.6.2
|
||||
with:
|
||||
token: ${{ secrets.GITHUB_TOKEN }}
|
||||
sha: ${{ github.event.workflow_run.head_sha }}
|
||||
|
||||
@@ -0,0 +1,68 @@
|
||||
# Architecture
|
||||
|
||||
This document describes the high-level architecture of PostgREST.
|
||||
|
||||
## Bird's Eye View
|
||||
|
||||
```haskell
|
||||
postgrest :: Request -> Either Error SQLStatement -> Response
|
||||
```
|
||||
|
||||
On the highest level, PostgREST processes an HTTP request, if it's accepted it builds a SQL statement for it, executes it, and produces a response.
|
||||
|
||||
## Code Map
|
||||
|
||||
This section talks briefly about various important modules.
|
||||
|
||||
The starting point of the program is `main/Main.hs`, which calls `src/PostgREST/CLI.hs` which then calls `src/PostgREST/App.hs`.
|
||||
|
||||
`App.hs` is then in charge of composing the different modules.
|
||||
|
||||
### ApiRequest.hs
|
||||
|
||||
PostgREST operates over two types of resources: database relations(tables or views) and database functions; providing different representations(depending on the media type)
|
||||
for them.
|
||||
|
||||
This module is in charge of representing the operation over an `ApiRequest` type. It parses the URL querystring following PostgREST syntax, the request headers, and the request body
|
||||
(if possible it avoids parsing the body and sends it directly to the db).
|
||||
|
||||
A request might be rejected at this level if it's invalid, e.g. providing an unknown media type to PostgREST or using an unknown HTTP method.
|
||||
|
||||
### Plan.hs
|
||||
|
||||
Using the Schema Cache, this module enables more complex functionality(like resource embedding) by enriching the ApiRequest. It generates Plan types(`ReadPlan`, `MutatePlan`)
|
||||
that then will be used to generate a SQL statement.
|
||||
|
||||
A request might be rejected at this level if it's invalid, e.g. by doing resource embedding on a nonexistent resource.
|
||||
|
||||
An OPTIONS request doesn't require a plan to be generated.
|
||||
|
||||
### Query.hs
|
||||
|
||||
This module constructs single SQL statements that can be parametrized and prepared. Only at this stage a PostgreSQL connection from the pool is used.
|
||||
|
||||
A query might fail(and be rollbacked) at this level if it doesn't comply to certain conditions, e.g. by not returning a single row when a ``Accept: application/vnd.pgrst.object`` header is specified.
|
||||
|
||||
An OPTIONS request doesn't require a query to be executed.
|
||||
|
||||
### Response.hs
|
||||
|
||||
This module constructs the HTTP response body with the right headers.
|
||||
|
||||
It builds the OpenAPI response using the schema cache.
|
||||
|
||||
### Auth.hs
|
||||
|
||||
This module provides functions to deal with JWT authorization.
|
||||
|
||||
### SchemaCache.hs
|
||||
|
||||
This queries the PostgreSQL system catalogs and caches the metadata into a SchemaCache type,
|
||||
|
||||
### AppState.hs
|
||||
|
||||
The state of the App which is kept across requests.
|
||||
|
||||
This spawns threads which are used to execute concurrent jobs.
|
||||
|
||||
Jobs include connection recover and a listener for the PostgreSQL LISTEN command.
|
||||
@@ -46,12 +46,14 @@ PostgREST ongoing development is only possible thanks to our Sponsors and Backer
|
||||
|
||||
## Lead Backers
|
||||
|
||||
- [Roboflow](https://github.com/roboflow)
|
||||
- Evans Fernandes
|
||||
- [Jan Sommer](https://github.com/nerfpops)
|
||||
- [Franz Gusenbauer](https://www.igutech.at/)
|
||||
|
||||
## Backers
|
||||
|
||||
- Zac Miller
|
||||
- Tsingson Qin
|
||||
- Michel Pelletier
|
||||
- Jay Hannah
|
||||
|
||||
+220
@@ -5,6 +5,225 @@ This project adheres to [Semantic Versioning](http://semver.org/).
|
||||
|
||||
## Unreleased
|
||||
|
||||
## [11.2.2] - 2023-10-25
|
||||
|
||||
### Fixed
|
||||
|
||||
- #2824, Fix regression by reverting fix that returned 206 when first position = length in a `Range` header - @laurenceisla, @strengthless
|
||||
|
||||
## [11.2.1] - 2023-10-03
|
||||
|
||||
### Fixed
|
||||
|
||||
- #2899, Fix `application/vnd.pgrst.array` not accepted as a valid mediatype - @taimoorzaeem
|
||||
- #2524, Fix schema cache and configuration reloading with `NOTIFY` not working on Windows - @diogob, @laurenceisla
|
||||
- #2915, Fix duplicate headers in response - @taimoorzaeem
|
||||
- #2824, Fix range request with first position same as length return status 206 - @taimoorzaeem
|
||||
- #2939, Fix wrong `Preference-Applied` with `Prefer: tx=commit` when transaction is rollbacked - @steve-chavez
|
||||
- #2939, Fix `count=exact` not being included in `Preference-Applied` - @steve-chavez
|
||||
- #2800, Fix not including to-one embed resources that had a `NULL` value in any of the selected fields when doing null filtering on them - @laurenceisla
|
||||
- #2846, Fix error when requesting `Prefer: count=<type>` and doing null filtering on embedded resources - @laurenceisla
|
||||
- #2959, Fix setting `default_transaction_isolation` unnecessarily - @steve-chavez
|
||||
- #2929, Fix arrow filtering on RPC returning dynamic TABLE with composite type - @steve-chavez
|
||||
- #2963, Fix RPCs not embedding correctly when using overloaded functions for computed relationships - @laurenceisla
|
||||
- #2970, Fix regression that rejects URI connection strings with certain unescaped characters in the password - @laurenceisla, @steve-chavez
|
||||
|
||||
## [11.2.0] - 2023-08-10
|
||||
|
||||
### Added
|
||||
|
||||
- #2523, Data representations - @aljungberg
|
||||
+ Allows for flexible API output formatting and input parsing on a per-column type basis using regular SQL functions configured in the database
|
||||
+ Enables greater flexibility in the form and shape of your APIs, both for output and input, making PostgREST a more versatile general-purpose API server
|
||||
+ Examples include base64 encode/decode your binary data (like a `bytea` column containing an image), choose whether to present a timestamp column as seconds since the Unix epoch or as an ISO 8601 string, or represent fixed precision decimals as strings, not doubles, to preserve precision
|
||||
+ ...and accept the same in `POST/PUT/PATCH` by configuring the reverse transformation(s)
|
||||
+ Other use-cases include custom representation of enums, arrays, nested objects, CSS hex colour strings, gzip compressed fields, metric to imperial conversions, and much more
|
||||
+ Works when using the `select` parameter to select only a subset of columns, embedding through complex joins, renaming fields, with views and computed columns
|
||||
+ Works when filtering on a formatted column without extra indexes by parsing to the canonical representation
|
||||
+ Works for data `RETURNING` operations, such as requesting the full body in a POST/PUT/PATCH with `Prefer: return=representation`
|
||||
+ Works for batch updates and inserts
|
||||
+ Completely optional, define the functions in the database and they will be used automatically everywhere
|
||||
+ Data representations preserve the ability to write to the original column and require no extra storage or complex triggers (compared to using `GENERATED ALWAYS` columns)
|
||||
+ Note: data representations require Postgres 10 (Postgres 11 if using `IN` predicates); data representations are not implemented for RPC
|
||||
- #2647, Allow to verify the PostgREST version in SQL: `select distinct application_name from pg_stat_activity`. - @laurenceisla
|
||||
- #2856, Add the `--version` CLI option that prints the version information - @laurenceisla
|
||||
- #1655, Improve `details` field of the singular error response - @taimoorzaeem
|
||||
- #740, Add `Preference-Applied` in response for `Prefer: return=representation/headers-only/minimal` - @taimoorzaeem
|
||||
- #1601, Add optional `nulls=stripped` parameter for mediatypes `application/vnd.pgrst.array+json` and `application/vnd.pgrst.object+json` - @taimoorzaeem
|
||||
|
||||
### Fixed
|
||||
|
||||
- #2821, Fix OPTIONS not accepting all available media types - @steve-chavez
|
||||
- #2834, Fix compilation on Ubuntu by being compatible with GHC 9.0.2 - @steve-chavez
|
||||
- #2840, Fix `Prefer: missing=default` with DOMAIN default values - @steve-chavez
|
||||
- #2849, Fix HEAD unnecessarily executing aggregates - @steve-chavez
|
||||
- #2594, Fix unused index on jsonb/jsonb arrow filter and order (``/bets?data->>contractId=eq.1`` and ``/bets?order=data->>contractId``) - @steve-chavez
|
||||
- #2861, Fix character and bit columns with fixed length not inserting/updating properly - @laurenceisla
|
||||
+ Fixes the error "value too long for type character(1)" when the char length of the column was bigger than one.
|
||||
- #2862, Fix null filtering on embedded resource when using a column name equal to the relation name - @steve-chavez
|
||||
- #1586, Fix function parameters of type character and bit not ignoring length - @laurenceisla
|
||||
+ Fixes the error "value too long for type character(1)" when the char length of the parameter was bigger than one.
|
||||
- #2881, Fix error when a function returns `RECORD` or `SET OF RECORD` - @laurenceisla
|
||||
- #2896, Fix applying superuser settings for impersonated role - @steve-chavez
|
||||
|
||||
### Deprecated
|
||||
|
||||
- #2863, Deprecate resource embedding target disambiguation - @steve-chavez
|
||||
+ The `/table?select=*,other!fk(*)` must be used to disambiguate
|
||||
+ The server aids in choosing the `!fk` by sending a `hint` on the error whenever an ambiguous request happens.
|
||||
|
||||
## [11.1.0] - 2023-06-07
|
||||
|
||||
### Added
|
||||
|
||||
- #2786, Limit idle postgresql connection lifetime - @robx
|
||||
+ New option `db-pool-max-idletime` (default 30s).
|
||||
+ This is equivalent to the old option `db-pool-timeout` of PostgREST 10.0.0.
|
||||
+ A config alias for `db-pool-timeout` is included.
|
||||
- #2703, Add pre-config function - @steve-chavez
|
||||
+ New config option `db-pre-config`(empty by default)
|
||||
+ Allows using the in-database configuration without SUPERUSER
|
||||
- #2781, When `db-channel-enabled` is false, start automatic connection recovery on a new request when pool connections are closed with `pg_terminate_backend` - @steve-chavez
|
||||
+ Mitigates the lack of LISTEN/NOTIFY for schema cache reloading on read replicas.
|
||||
|
||||
### Fixed
|
||||
|
||||
- #2791, Fix dropping schema cache reload notifications - @steve-chavez
|
||||
- #2801, Stop retrying connection when "no password supplied" - @steve-chavez
|
||||
|
||||
## [11.0.1] - 2023-04-27
|
||||
|
||||
### Fixed
|
||||
|
||||
- #2762, Fixes "permission denied for schema" error during schema cache load - @steve-chavez
|
||||
- #2756, Fix bad error message on generated columns when using `Prefer: missing=default` - @steve-chavez
|
||||
- #1139, Allow a 30 second skew for JWT validation - @steve-chavez
|
||||
+ It used to be 1 second, which was too strict
|
||||
|
||||
## [11.0.0] - 2023-04-16
|
||||
|
||||
### Added
|
||||
|
||||
- #1414, Add related orders - @steve-chavez
|
||||
+ On a many-to-one or one-to-one relationship, you can order a parent by a child column `/projects?select=*,clients(*)&order=clients(name).desc.nullsfirst`
|
||||
- #1233, #1907, #2566, Allow spreading embedded resources - @steve-chavez
|
||||
+ On a many-to-one or one-to-one relationship, you can unnest a json object with `/projects?select=*,...clients(client_name:name)`
|
||||
+ Allows including the join table columns when resource embedding
|
||||
+ Allows disambiguating a recursive m2m embed
|
||||
+ Allows disambiguating an embed that has a many-to-many relationship using two foreign keys on a junction
|
||||
- #2340, Allow embedding without selecting any column - @steve-chavez
|
||||
- #2563, Allow `is.null` or `not.is.null` on an embedded resource - @steve-chavez
|
||||
+ Offers a more flexible replacement for `!inner`, e.g. `/projects?select=*,clients(*)&clients=not.is.null`
|
||||
+ Allows doing an anti join, e.g. `/projects?select=*,clients(*)&clients=is.null`
|
||||
+ Allows using or across related tables conditions
|
||||
- #1100, Customizable OpenAPI title - @AnthonyFisi
|
||||
- #2506, Add `server-trace-header` for tracing HTTP requests. - @steve-chavez
|
||||
+ When the client sends the request header specified in the config it will be included in the response headers.
|
||||
- #2694, Make `db-root-spec` stable. - @steve-chavez
|
||||
+ This can be used to override the OpenAPI spec with a custom database function
|
||||
- #1567, On bulk inserts, missing values can get the column DEFAULT by using the `Prefer: missing=default` header - @steve-chavez
|
||||
- #2501, Allow filtering by`IS DISTINCT FROM` using the `isdistinct` operator, e.g. `/people?alias=isdistinct.foo`
|
||||
- #1569, Allow `any/all` modifiers on the `eq,like,ilike,gt,gte,lt,lte,match,imatch` operators, e.g. `/tbl?id=eq(any).{1,2,3}` - @steve-chavez
|
||||
- This converts the input into an array type
|
||||
- #2561, Configurable role settings - @steve-chavez
|
||||
- Database roles that are members of the connection role get their settings applied, e.g. doing
|
||||
`ALTER ROLE anon SET statement_timeout TO '5s'` will result in that `statement_timeout` getting applied for that role.
|
||||
- Works when switching roles when a JWT is sent
|
||||
- Settings can be reloaded with `NOTIFY pgrst, 'reload config'`.
|
||||
- #2468, Configurable transaction isolation level with `default_transaction_isolation` - @steve-chavez
|
||||
- Can be set per function `create function .. set default_transaction_isolation = 'repeatable read'`
|
||||
- Or per role `alter role .. set default_transaction_isolation = 'serializable'`
|
||||
|
||||
### Fixed
|
||||
|
||||
- #2651, Add the missing `get` path item for RPCs to the OpenAPI output - @laurenceisla
|
||||
- #2648, Fix inaccurate error codes with new ones - @laurenceisla
|
||||
+ `PGRST204`: Column is not found
|
||||
+ `PGRST003`: Timed out when acquiring connection to db
|
||||
- #1652, Fix function call with arguments not inlining - @steve-chavez
|
||||
- #2705, Fix bug when using the `Range` header on `PATCH/DELETE` - @laurenceisla
|
||||
+ Fix the`"message": "syntax error at or near \"RETURNING\""` error
|
||||
+ Fix doing a limited update/delete when an `order` query parameter was present
|
||||
- #2742, Fix db settings and pg version queries not getting prepared - @steve-chavez
|
||||
- #2618, Fix `PATCH` requests not recognizing embedded filters and using the top-level resource instead - @steve-chavez
|
||||
|
||||
### Changed
|
||||
|
||||
- #2705, The `Range` header is now only considered on `GET` requests and is ignored for any other method - @laurenceisla
|
||||
+ Other methods should use the `limit/offset` query parameters for sub-ranges
|
||||
+ `PUT` requests no longer return an error when this header is present (using `limit/offset` still triggers the error)
|
||||
- #2733, Remove bulk RPC call with the `Prefer: params=multiple-objects` header. A function with a JSON array or object parameter should be used instead.
|
||||
|
||||
## [10.2.0] - 2023-04-12
|
||||
|
||||
### Added
|
||||
|
||||
- #2663, Limit maximal postgresql connection lifetime - @robx
|
||||
+ New option `db-pool-max-lifetime` (default 30m)
|
||||
+ `db-pool-acquisition-timeout` is no longer optional and defaults to 10s
|
||||
+ Fixes postgresql resource leak with long-lived connections (#2638)
|
||||
|
||||
### Fixed
|
||||
|
||||
- #2667, Fix `db-pool-acquisition-timeout` not logging to stderr when the timeout is reached - @steve-chavez
|
||||
|
||||
## [10.1.2] - 2023-02-01
|
||||
|
||||
### Fixed
|
||||
|
||||
- #2565, Fix bad M2M embedding on RPC - @steve-chavez
|
||||
- #2575, Replace misleading error message when no function is found with a hint containing functions/parameters names suggestions - @laurenceisla
|
||||
- #2582, Move explanation about "single parameters" from the `message` to the `details` in the error output - @laurenceisla
|
||||
- #2569, Replace misleading error message when no relationship is found with a hint containing parent/child names suggestions - @laurenceisla
|
||||
- #1405, Add the required OpenAPI items object when the parameter is an array - @laurenceisla
|
||||
- #2592, Add upsert headers for POST requests to the OpenAPI output - @laurenceisla
|
||||
- #2623, Fix FK pointing to VIEW instead of TABLE in OpenAPI output - @laurenceisla
|
||||
- #2622, Consider any PostgreSQL authentication failure as fatal and exit immediately - @michivi
|
||||
- #2620, Fix `NOTIFY pgrst` not reloading the db connections catalog cache - @steve-chavez
|
||||
|
||||
## [10.1.1] - 2022-11-08
|
||||
|
||||
### Fixed
|
||||
|
||||
- #2548, Fix regression when embedding views with partial references to multi column FKs - @wolfgangwalther
|
||||
- #2558, Fix regression when requesting limit=0 and `db-max-row` is set - @laurenceisla
|
||||
- #2542, Return a clear error without hitting the database when trying to update or insert an unknown column with `?columns` - @aljungberg
|
||||
|
||||
## [10.1.0] - 2022-10-28
|
||||
|
||||
### Added
|
||||
|
||||
- #2348, Add `db-pool-acquisition-timeout` configuration option, time in seconds to wait to acquire a connection. - @robx
|
||||
|
||||
### Fixed
|
||||
|
||||
- #2261, #2349, #2467, Reduce allocations communication with PostgreSQL, particularly for request bodies. - @robx
|
||||
- #2401, #2444, Fix SIGUSR1 to fully flush connections pool. - @robx
|
||||
- #2428, Fix opening an empty transaction on failed resource embedding - @steve-chavez
|
||||
- #2455, Fix embedding the same table multiple times - @steve-chavez
|
||||
- #2518, Fix a regression when embedding views where base tables have a different column order for FK columns - @wolfgangwalther
|
||||
- #2458, Fix a regression with the location header when inserting into views with PKs from multiple tables - @wolfgangwalther
|
||||
- #2356, Fix a regression in openapi output with mode follow-privileges - @wolfgangwalther
|
||||
- #2283, Fix infinite recursion when loading schema cache with self-referencing view - @wolfgangwalther
|
||||
- #2343, Return status code 200 for PATCH requests which don't affect any rows - @wolfgangwalther
|
||||
- #2481, Treat computed relationships not marked SETOF as M2O/O2O relationship - @wolfgangwalther
|
||||
- #2534, Fix embedding a computed relationship with a normal relationship - @steve-chavez
|
||||
- #2362, Fix error message when [] is used inside select - @wolfgangwalther
|
||||
- #2475, Disallow !inner on computed columns - @wolfgangwalther
|
||||
- #2285, Ignore leading and trailing spaces in column names when parsing the query string - @wolfgangwalther
|
||||
- #2545, Fix UPSERT with PostgreSQL 15 - @wolfgangwalther
|
||||
- #2459, Fix embedding views with multiple references to the same base column - @wolfgangwalther
|
||||
|
||||
### Changed
|
||||
|
||||
- #2444, Removed `db-pool-timeout` option, because this was removed upstream in hasql-pool. - @robx
|
||||
- #2343, PATCH requests that don't affect any rows no longer return 404 - @wolfgangwalther
|
||||
- #2537, Stricter parsing of query string. Instead of silently ignoring, the parser now throws on invalid syntax like json paths for embeddings, hints for regular columns, empty casts or fts languages, etc. - @wolfgangwalther
|
||||
|
||||
### Deprecated
|
||||
|
||||
- #1385, Deprecate bulk-calls when including the `Prefer: params=multiple-objects` in the request. A function with a JSON array or object parameter should be used instead for a better performance.
|
||||
|
||||
## [10.0.0] - 2022-08-18
|
||||
|
||||
### Added
|
||||
@@ -70,6 +289,7 @@ This project adheres to [Semantic Versioning](http://semver.org/).
|
||||
- #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
|
||||
- #2401, Ensure database connections can't outlive SIGUSR1 - @robx
|
||||
|
||||
### Changed
|
||||
|
||||
|
||||
@@ -0,0 +1,20 @@
|
||||
-- Settings to allow building with plain cabal. If this was
|
||||
-- named just cabal.project, it would interfere with the default
|
||||
-- nix build.
|
||||
|
||||
packages: .
|
||||
|
||||
-- Example of depending on a forked repository (the same dependency
|
||||
-- would be mentioned in nix/overlays/haskell-packages.nix and
|
||||
-- stack.yaml, and should refer to a main branch commit of the
|
||||
-- repository.
|
||||
--
|
||||
-- source-repository-package
|
||||
-- type: git
|
||||
-- location: https://github.com/PostgREST/hasql-pool.git
|
||||
-- tag: 4d462c4d47d762effefc7de6c85eaed55f144f1d
|
||||
|
||||
source-repository-package
|
||||
type: git
|
||||
location: https://github.com/PostgREST/postgresql-libpq.git
|
||||
tag: 890a0a16cf57dd401420fdc6c7d576fb696003bc
|
||||
+34
-12
@@ -36,10 +36,12 @@ let
|
||||
allOverlays.build-toolbox
|
||||
allOverlays.checked-shell-script
|
||||
allOverlays.gitignore
|
||||
allOverlays.postgresql-default
|
||||
allOverlays.postgis
|
||||
(allOverlays.postgresql-default { inherit patches; })
|
||||
allOverlays.postgresql-legacy
|
||||
allOverlays.postgresql-future
|
||||
(allOverlays.haskell-packages { inherit compiler; })
|
||||
allOverlays.slocat
|
||||
];
|
||||
|
||||
# Evaluated expression of the Nixpkgs repository.
|
||||
@@ -48,6 +50,20 @@ let
|
||||
|
||||
postgresqlVersions =
|
||||
[
|
||||
{
|
||||
name = "postgresql-16";
|
||||
postgresql = pkgs.postgresql_16.withPackages (p: [
|
||||
p.postgis
|
||||
(p.pg_safeupdate.overrideAttrs (old: {
|
||||
installPhase = ''
|
||||
mkdir -p $out/bin
|
||||
cp safeupdate.dylib safeupdate.so || true
|
||||
install -D safeupdate.so -t $out/lib
|
||||
'';
|
||||
}))
|
||||
]);
|
||||
}
|
||||
{ name = "postgresql-15"; postgresql = pkgs.postgresql_15.withPackages (p: [ p.postgis p.pg_safeupdate ]); }
|
||||
{ name = "postgresql-14"; postgresql = pkgs.postgresql_14.withPackages (p: [ p.postgis p.pg_safeupdate ]); }
|
||||
{ name = "postgresql-13"; postgresql = pkgs.postgresql_13.withPackages (p: [ p.postgis p.pg_safeupdate ]); }
|
||||
{ name = "postgresql-12"; postgresql = pkgs.postgresql_12.withPackages (p: [ p.postgis p.pg_safeupdate ]); }
|
||||
@@ -63,11 +79,17 @@ let
|
||||
postgrest =
|
||||
pkgs.haskell.packages."${compiler}".callCabal2nix name src { };
|
||||
|
||||
# Function that derives a fully static Haskell package based on
|
||||
# Functionality that derives a fully static Haskell package based on
|
||||
# nh2/static-haskell-nix
|
||||
staticHaskellPackage =
|
||||
import nix/static-haskell-package.nix { inherit nixpkgs system compiler patches allOverlays; };
|
||||
|
||||
# Static executable.
|
||||
postgrestStatic =
|
||||
lib.justStaticExecutables (lib.dontCheck (staticHaskellPackage name src).package);
|
||||
|
||||
packagesStatic = (staticHaskellPackage name src).survey;
|
||||
|
||||
# Options passed to cabal in dev tools and tests
|
||||
devCabalOptions =
|
||||
"-f dev --test-show-detail=direct";
|
||||
@@ -92,10 +114,6 @@ rec {
|
||||
postgrestPackage =
|
||||
lib.dontCheck postgrest;
|
||||
|
||||
# Static executable.
|
||||
postgrestStatic =
|
||||
lib.justStaticExecutables (lib.dontCheck (staticHaskellPackage name src));
|
||||
|
||||
# Profiled dynamic executable.
|
||||
postgrestProfiled =
|
||||
lib.enableExecutableProfiling (
|
||||
@@ -117,14 +135,13 @@ rec {
|
||||
cabalTools =
|
||||
pkgs.callPackage nix/tools/cabalTools.nix { inherit devCabalOptions postgrest; };
|
||||
|
||||
withTools =
|
||||
pkgs.callPackage nix/tools/withTools.nix { inherit cabalTools devCabalOptions postgresqlVersions postgrest; };
|
||||
|
||||
# Development tools.
|
||||
devTools =
|
||||
pkgs.callPackage nix/tools/devTools.nix { inherit tests style devCabalOptions hsie withTools; };
|
||||
|
||||
# Docker images and loading script.
|
||||
docker =
|
||||
pkgs.callPackage nix/tools/docker { postgrest = postgrestStatic; };
|
||||
|
||||
# Load testing tools.
|
||||
loadtest =
|
||||
pkgs.callPackage nix/tools/loadtest.nix { inherit withTools; };
|
||||
@@ -153,7 +170,12 @@ rec {
|
||||
inherit (pkgs.haskell.packages."${compiler}") hpc-codecov;
|
||||
inherit (pkgs.haskell.packages."${compiler}") weeder;
|
||||
};
|
||||
} // pkgs.lib.optionalAttrs pkgs.stdenv.isLinux rec {
|
||||
# Static executable.
|
||||
inherit postgrestStatic;
|
||||
inherit packagesStatic;
|
||||
|
||||
withTools =
|
||||
pkgs.callPackage nix/tools/withTools.nix { inherit devCabalOptions postgresqlVersions postgrest; };
|
||||
# Docker images and loading script.
|
||||
docker =
|
||||
pkgs.callPackage nix/tools/docker { postgrest = postgrestStatic; };
|
||||
}
|
||||
|
||||
+25
-35
@@ -5,24 +5,14 @@ for developing, testing and building PostgREST.
|
||||
|
||||
## Getting started with Nix
|
||||
|
||||
You'll need to [get Nix](https://nixos.org/download.html). The installer will
|
||||
create your Nix store in the `/nix/` directory, where all build artifacts and
|
||||
their dependencies will be stored. It will also link the Nix executables like
|
||||
`nix-env`, `nix-build` and `nix-shell` into your PATH. Nix will manage all
|
||||
other PostgREST dependencies from here on out. To clean up older build
|
||||
artifacts from the `/nix/store`, you can run `nix-collect-garbage`.
|
||||
|
||||
If you are on a system that does not support nix, for example Windows, you can
|
||||
run the nix development environment in a docker container. Inside the `nix/`
|
||||
directory run `docker-compose run --rm nix` to start the docker container. This
|
||||
will set up the binary cache and launch `nix-shell` automatically.
|
||||
You'll need to [get Nix](https://nixos.org/download.html). Follow the recommended installation for your operating system from the official download website.
|
||||
|
||||
## Building PostgREST
|
||||
|
||||
To build PostgREST from your local checkout of the repository, run:
|
||||
|
||||
```bash
|
||||
nix-build --attr postgrestPackage
|
||||
$ nix-build --attr postgrestPackage
|
||||
|
||||
```
|
||||
|
||||
@@ -39,10 +29,10 @@ We recommend that you use the PostgREST binary cache on
|
||||
|
||||
```bash
|
||||
# Install cachix:
|
||||
nix-env -iA cachix -f https://cachix.org/api/v1/install
|
||||
$ nix-env -iA cachix -f https://cachix.org/api/v1/install
|
||||
|
||||
# Set cachix up to use the PostgREST binary cache:
|
||||
cachix use postgrest
|
||||
$ cachix use postgrest
|
||||
|
||||
```
|
||||
|
||||
@@ -56,7 +46,7 @@ following command will put you into a new shell that has GHC and Cabal on the
|
||||
PATH:
|
||||
|
||||
```bash
|
||||
nix-shell
|
||||
$ nix-shell
|
||||
|
||||
```
|
||||
|
||||
@@ -146,10 +136,10 @@ Note: Once inside nix-shell, the utilities work from any directory inside
|
||||
the PostgREST repo. Paths are resolved relative to the repo root:
|
||||
|
||||
```bash
|
||||
$ cd src
|
||||
[nix-shell]$ cd src
|
||||
# Even though the current directory is ./src, the config path must still start
|
||||
# from the repo root:
|
||||
$ postgrest-run test/io/configs/simple.conf
|
||||
[nix-shell]$ postgrest-run test/io/configs/simple.conf
|
||||
```
|
||||
|
||||
## Testing
|
||||
@@ -177,21 +167,21 @@ run with `postgrest-test-io`. The test runner under the hood is
|
||||
|
||||
```bash
|
||||
# Filter the tests to run by name, including all that contain 'config':
|
||||
postgrest-test-io -k config
|
||||
[nix-shell]$ postgrest-test-io -k config
|
||||
|
||||
# Run tests in parallel using xdist, specifying the number of processes:
|
||||
postgrest-test-io -n auto
|
||||
postgrest-test-io -n 8
|
||||
[nix-shell]$ postgrest-test-io -n auto
|
||||
[nix-shell]$ 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
|
||||
$ nix-shell --arg memory true
|
||||
|
||||
# Run the memory test
|
||||
postgrest-test-memory
|
||||
[nix-shell]$ postgrest-test-memory
|
||||
```
|
||||
|
||||
The loadtests ensure that performance doesn't drop on a change. Underlyingly they use
|
||||
@@ -199,25 +189,25 @@ The loadtests ensure that performance doesn't drop on a change. Underlyingly the
|
||||
|
||||
```bash
|
||||
# Run the loadtests on the latest commit(HEAD)
|
||||
postgrest-loadtest
|
||||
[nix-shell]$ postgrest-loadtest
|
||||
|
||||
# You can loadtest comparing to a different branch
|
||||
postgrest-loadtest-against master
|
||||
[nix-shell]$ postgrest-loadtest-against master
|
||||
|
||||
# You can simulate latency client/postgrest and postgrest/database
|
||||
[nix-shell]$ PGRST_DELAY=5ms PGDELAY=5ms postgrest-loadtest
|
||||
|
||||
# You can build postgrest directly with cabal for faster iteration
|
||||
[nix-shell]$ PGRST_BUILD_CABAL=1 postgrest-loadtest
|
||||
|
||||
# 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
|
||||
[nix-shell]$ postgrest-loadtest-report
|
||||
```
|
||||
|
||||
doctests for some of our modules are also available:
|
||||
|
||||
```bash
|
||||
postgrest-test-doctest
|
||||
[nix-shell]$ postgrest-test-doctest
|
||||
```
|
||||
|
||||
## Code coverage
|
||||
@@ -226,11 +216,11 @@ Code coverage is available under the `postgrest-coverage` command. This will pro
|
||||
|
||||
```bash
|
||||
# Will run all the tests and produce a coverage dir
|
||||
postgrest-coverage
|
||||
[nix-shell]$ postgrest-coverage
|
||||
|
||||
# Visualize the output
|
||||
cd coverage
|
||||
python -mSimpleHTTPServer 8080
|
||||
[nix-shell]$ cd coverage
|
||||
[nix-shell]$ python -mSimpleHTTPServer 8080
|
||||
```
|
||||
|
||||
## Linting and styling code
|
||||
|
||||
@@ -1,6 +1,6 @@
|
||||
# Pinned version of Nixpkgs, generated with postgrest-nixpkgs-upgrade.
|
||||
{
|
||||
date = "2022-08-09";
|
||||
rev = "9f15d6c3a74d2778c6e1af67947c95f100dc6fd2";
|
||||
tarballHash = "14axdmi3kb6rlib39ik42yq907bm66x6vzswm5w1rsnw9vzgm31a";
|
||||
date = "2023-03-25";
|
||||
rev = "dbf5322e93bcc6cfc52268367a8ad21c09d76fea";
|
||||
tarballHash = "0lwk4v9dkvd28xpqch0b0jrac4xl9lwm6snrnzx8k5lby72kmkng";
|
||||
}
|
||||
|
||||
@@ -2,7 +2,7 @@
|
||||
# directly, or use the .bin attribute to get the script in a bin/ directory,
|
||||
# to be used in a path for example.
|
||||
{ argbash
|
||||
, bash_5
|
||||
, bash
|
||||
, coreutils
|
||||
, git
|
||||
, lib
|
||||
@@ -77,7 +77,7 @@ let
|
||||
|
||||
text =
|
||||
''
|
||||
#!${bash_5}/bin/bash
|
||||
#!${bash}/bin/bash
|
||||
source ${argsParser}
|
||||
set -euo pipefail
|
||||
''
|
||||
|
||||
@@ -3,7 +3,9 @@
|
||||
checked-shell-script = import ./checked-shell-script;
|
||||
gitignore = import ./gitignore.nix;
|
||||
haskell-packages = import ./haskell-packages.nix;
|
||||
postgis = import ./postgis.nix;
|
||||
postgresql-default = import ./postgresql-default.nix;
|
||||
postgresql-legacy = import ./postgresql-legacy.nix;
|
||||
postgresql-future = import ./postgresql-future.nix;
|
||||
slocat = import ./slocat.nix;
|
||||
}
|
||||
|
||||
@@ -13,13 +13,10 @@ let
|
||||
# {
|
||||
# pkg = "protolude";
|
||||
# ver = "0.3.0";
|
||||
# sha256 = "0iwh4wsjhb7pms88lw1afhdal9f86nrrkkvv65f9wxbd1b159n72";
|
||||
# sha256 = "<sha256>";
|
||||
# }
|
||||
# { };
|
||||
#
|
||||
# To get the sha256:
|
||||
# nix-prefetch-url --unpack https://hackage.haskell.org/package/protolude-0.3.0/protolude-0.3.0.tar.gz
|
||||
|
||||
# To temporarily pin unreleased versions from GitHub:
|
||||
# <name> =
|
||||
# prev.callCabal2nixWithOptions "<name>" (super.fetchFromGitHub {
|
||||
@@ -29,8 +26,36 @@ let
|
||||
# sha256 = "<sha256>";
|
||||
# }) "--subpath=<subpath>" {};
|
||||
#
|
||||
# To get the sha256:
|
||||
# nix-prefetch-url --unpack https://github.com/<owner>/<repo>/archive/<commit>.tar.gz
|
||||
# To fill in the sha256:
|
||||
# update-nix-fetchgit nix/overlays/haskell-packages.nix
|
||||
|
||||
postgresql-libpq = lib.dontCheck
|
||||
(prev.callCabal2nix "postgresql-libpq"
|
||||
(super.fetchFromGitHub {
|
||||
owner = "PostgREST";
|
||||
repo = "postgresql-libpq";
|
||||
rev = "890a0a16cf57dd401420fdc6c7d576fb696003bc"; # master
|
||||
sha256 = "1wmyhldk0k14y8whp1p4akrkqxf5snh8qsbm7fv5f7kz95nyffd0";
|
||||
})
|
||||
{ });
|
||||
|
||||
hasql-notifications = lib.dontCheck
|
||||
(prev.callHackageDirect
|
||||
{
|
||||
pkg = "hasql-notifications";
|
||||
ver = "0.2.0.6";
|
||||
sha256 = "sha256-7PyFlB2B70njudOjaX6tk1m77ol9vnF5fI0LF86kVAI=";
|
||||
}
|
||||
{ });
|
||||
|
||||
hasql-pool = lib.dontCheck
|
||||
(prev.callHackageDirect
|
||||
{
|
||||
pkg = "hasql-pool";
|
||||
ver = "0.10";
|
||||
sha256 = "sha256-kHzoqtNV9BFWnn1h560JRqMooQRwxokVKgDRBexamNI=";
|
||||
}
|
||||
{ });
|
||||
} // extraOverrides final prev;
|
||||
in
|
||||
{
|
||||
|
||||
@@ -0,0 +1,27 @@
|
||||
final: prev:
|
||||
let
|
||||
postgis_3_2_3 = rec {
|
||||
version = "3.2.3";
|
||||
src = final.fetchurl {
|
||||
url = "https://download.osgeo.org/postgis/source/postgis-${version}.tar.gz";
|
||||
sha256 = "sha256-G02LXHVuWrpZ77wYM7Iu/k1lYneO7KVvpJf+susTZow=";
|
||||
};
|
||||
};
|
||||
in
|
||||
{
|
||||
postgresql_11 = prev.postgresql_11.override { this = final.postgresql_11; } // {
|
||||
pkgs = prev.postgresql_11.pkgs // {
|
||||
postgis = prev.postgresql_11.pkgs.postgis.overrideAttrs (_: postgis_3_2_3);
|
||||
};
|
||||
};
|
||||
postgresql_10 = prev.postgresql_10.override { this = final.postgresql_11; } // {
|
||||
pkgs = prev.postgresql_10.pkgs // {
|
||||
postgis = prev.postgresql_10.pkgs.postgis.overrideAttrs (_: postgis_3_2_3);
|
||||
};
|
||||
};
|
||||
postgresql_9_6 = prev.postgresql_9_6.override { this = final.postgresql_11; } // {
|
||||
pkgs = prev.postgresql_9_6.pkgs // {
|
||||
postgis = prev.postgresql_9_6.pkgs.postgis.overrideAttrs (_: postgis_3_2_3);
|
||||
};
|
||||
};
|
||||
}
|
||||
@@ -1,5 +1,8 @@
|
||||
self: super:
|
||||
{ patches }: self: super:
|
||||
# Overlay that sets the default version of PostgreSQL.
|
||||
with patches;
|
||||
{
|
||||
postgresql = super.postgresql_14;
|
||||
postgresql = super.postgresql_15.overrideAttrs ({ patches ? [ ], ... }: {
|
||||
patches = patches ++ [ postgresql-atexit ];
|
||||
});
|
||||
}
|
||||
|
||||
@@ -4,16 +4,16 @@ self: super:
|
||||
{
|
||||
## 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;
|
||||
postgresql_16 =
|
||||
let
|
||||
rev = "5148520bfab61f99fd25fb9ff7bfbb50dad3c9db";
|
||||
tarballHash = "1dfjmz65h8z4lk845724vypzmf3dbgsdndjpj8ydlhx6c7rpcq3p";
|
||||
|
||||
pinnedPkgs =
|
||||
builtins.fetchTarball {
|
||||
url = "https://github.com/nixos/nixpkgs/archive/${rev}.tar.gz";
|
||||
sha256 = tarballHash;
|
||||
};
|
||||
in
|
||||
(import pinnedPkgs { }).pkgs.postgresql_16;
|
||||
}
|
||||
|
||||
@@ -16,4 +16,19 @@ self: super:
|
||||
};
|
||||
in
|
||||
(import pinnedPkgs { }).pkgs.postgresql_9_6;
|
||||
|
||||
# PostgreSQL 10 was removed from Nixpkgs with
|
||||
# https://github.com/NixOS/nixpkgs/commit/aa1483114bb329fee7e1266100b8d8921ed4723f
|
||||
# We pin its parent commit to get the last version that was available.
|
||||
postgresql_10 =
|
||||
let
|
||||
rev = "79661ba7e2fb96ebefbb537458a5bbae9dc5bd1a";
|
||||
tarballHash = "0rn796pfn4sg90ai9fdnwmr10a2s835p1arazzgz46h6s5cxvq97";
|
||||
pinnedPkgs =
|
||||
builtins.fetchTarball {
|
||||
url = "https://github.com/nixos/nixpkgs/archive/${rev}.tar.gz";
|
||||
sha256 = tarballHash;
|
||||
};
|
||||
in
|
||||
(import pinnedPkgs { }).pkgs.postgresql_10;
|
||||
}
|
||||
|
||||
@@ -0,0 +1,13 @@
|
||||
final: prev:
|
||||
{
|
||||
slocat = prev.buildGoModule {
|
||||
name = "slocat";
|
||||
src = prev.fetchFromGitHub {
|
||||
owner = "robx";
|
||||
repo = "slocat";
|
||||
rev = "52e7512c6029fd00483e41ccce260a3b4b9b3b64";
|
||||
sha256 = "sha256-qn6luuh5wqREu3s8RfuMCP5PKdS2WdwPrujRYTpfzQ8=";
|
||||
};
|
||||
vendorSha256 = "sha256-pQpattmS9VmO3ZIQUFn66az8GSmB4IvYhTTCFn6SUmo=";
|
||||
};
|
||||
}
|
||||
@@ -22,4 +22,8 @@
|
||||
./static-haskell-nix-ncurses.patch;
|
||||
static-haskell-nix-ghc-bignum =
|
||||
./static-haskell-nix-ghc-bignum.patch;
|
||||
static-haskell-nix-openssl =
|
||||
./static-haskell-nix-openssl.patch;
|
||||
postgresql-atexit =
|
||||
./postgresql-atexit.patch;
|
||||
}
|
||||
|
||||
@@ -0,0 +1,11 @@
|
||||
--- a/src/interfaces/libpq/Makefile
|
||||
+++ b/src/interfaces/libpq/Makefile
|
||||
@@ -118,7 +118,7 @@ backend_src = $(top_srcdir)/src/backend
|
||||
libpq-refs-stamp: $(shlib)
|
||||
ifneq ($(enable_coverage), yes)
|
||||
ifeq (,$(filter aix solaris,$(PORTNAME)))
|
||||
- @if nm -A -u $< 2>/dev/null | grep -v __cxa_atexit | grep exit; then \
|
||||
+ @if nm -A -u $< 2>/dev/null | grep " exit"; then \
|
||||
echo 'libpq must not be calling any function which invokes exit'; exit 1; \
|
||||
fi
|
||||
endif
|
||||
@@ -0,0 +1,12 @@
|
||||
diff --git a/survey/default.nix b/survey/default.nix
|
||||
index cf1bd31..9d34753 100644
|
||||
--- a/survey/default.nix
|
||||
+++ b/survey/default.nix
|
||||
@@ -736,6 +736,7 @@ let
|
||||
openblas = previous.openblas.override { enableStatic = true; };
|
||||
|
||||
openssl = previous.openssl.override { static = true; };
|
||||
+ openssl_1_1 = previous.openssl_1_1.override { static = true; };
|
||||
|
||||
libsass = previous.libsass.overrideAttrs (old: { dontDisableStatic = true; });
|
||||
|
||||
@@ -19,6 +19,7 @@ let
|
||||
[
|
||||
patches.static-haskell-nix-ncurses
|
||||
patches.static-haskell-nix-ghc-bignum
|
||||
patches.static-haskell-nix-openssl
|
||||
];
|
||||
|
||||
extraOverrides =
|
||||
@@ -34,7 +35,7 @@ let
|
||||
overlays =
|
||||
[
|
||||
allOverlays.postgresql-future
|
||||
allOverlays.postgresql-default
|
||||
(allOverlays.postgresql-default { inherit patches; })
|
||||
(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
|
||||
@@ -58,4 +59,7 @@ let
|
||||
survey =
|
||||
import "${patched-static-haskell-nix}/survey" { inherit normalPkgs compiler defaultCabalPackageVersionComingWithGhc; };
|
||||
in
|
||||
survey.haskellPackages."${name}"
|
||||
{
|
||||
inherit survey;
|
||||
package = survey.haskellPackages."${name}";
|
||||
}
|
||||
|
||||
@@ -37,12 +37,22 @@ let
|
||||
checkedShellScript
|
||||
{
|
||||
name = "postgrest-run";
|
||||
docs = "Run PostgREST after buidling it interactively with cabal-install";
|
||||
args = [ "ARG_LEFTOVERS([PostgREST arguments])" ];
|
||||
docs = "Run PostgREST after building it interactively with cabal-install";
|
||||
args =
|
||||
[
|
||||
"ARG_USE_ENV([PGRST_DB_ANON_ROLE], [postgrest_test_anonymous], [PostgREST anonymous role])"
|
||||
"ARG_USE_ENV([PGRST_DB_POOL], [1], [PostgREST pool size])"
|
||||
"ARG_USE_ENV([PGRST_DB_POOL_ACQUISITION_TIMEOUT], [1], [PostgREST pool size])"
|
||||
"ARG_LEFTOVERS([PostgREST arguments])"
|
||||
];
|
||||
inRootDir = true;
|
||||
withEnv = postgrest.env;
|
||||
}
|
||||
''
|
||||
export PGRST_DB_ANON_ROLE
|
||||
export PGRST_DB_POOL
|
||||
export PGRST_DB_POOL_ACQUISITION_TIMEOUT
|
||||
|
||||
exec ${cabal-install}/bin/cabal v2-run ${devCabalOptions} --verbose=0 -- \
|
||||
postgrest "''${_arg_leftovers[@]}"
|
||||
'';
|
||||
|
||||
@@ -77,7 +77,6 @@ let
|
||||
}
|
||||
''
|
||||
${tests}/bin/postgrest-test-spec
|
||||
${tests}/bin/postgrest-test-querycost
|
||||
${tests}/bin/postgrest-test-doctests
|
||||
${tests}/bin/postgrest-test-io
|
||||
${style}/bin/postgrest-lint
|
||||
@@ -165,6 +164,7 @@ let
|
||||
# The following unsets all GIT_ variables.
|
||||
unset "''${!GIT_@}"
|
||||
|
||||
# shellcheck disable=SC2317
|
||||
function restore () {
|
||||
ref="$(git stash list --format=format:%gD --grep "$1" -n1)"
|
||||
# this will avoid merge conflicts when applying the stash
|
||||
@@ -304,4 +304,5 @@ buildToolbox
|
||||
hsieGraphModules
|
||||
hsieGraphSymbols
|
||||
];
|
||||
extra = { inherit pushCachix; };
|
||||
}
|
||||
|
||||
@@ -93,3 +93,18 @@ Image efficiency score: 100 %
|
||||
|
||||
Count Total Space Path
|
||||
```
|
||||
|
||||
# Deriving from the optimized image
|
||||
|
||||
Since the docker image is minimal, it does not contain a shell or other utilities.
|
||||
To derive a non-minimal image, you can do the following:
|
||||
|
||||
```Dockerfile
|
||||
# derive from any base image you want
|
||||
FROM alpine:latest
|
||||
|
||||
# copy PostgREST over
|
||||
COPY --from=postgrest/postgrest /bin/postgrest /bin
|
||||
|
||||
# add your other stuff
|
||||
```
|
||||
|
||||
@@ -8,7 +8,7 @@ let
|
||||
dockerTools.buildImage {
|
||||
name = "postgrest";
|
||||
tag = "latest";
|
||||
contents = postgrest;
|
||||
copyToRoot = postgrest;
|
||||
|
||||
# Set the current time as the image creation date. This makes the build
|
||||
# non-reproducible, but that should not be an issue for us.
|
||||
|
||||
@@ -56,11 +56,14 @@ let
|
||||
export PGRST_LOG_LEVEL="crit"
|
||||
|
||||
mkdir -p "$(dirname "$_arg_output")"
|
||||
abs_output="$(realpath "$_arg_output")"
|
||||
|
||||
# shellcheck disable=SC2145
|
||||
${withTools.withPg} --fixtures "$_arg_testdir"/fixtures.sql \
|
||||
${withTools.withSlowPg} \
|
||||
${withTools.withPgrst} \
|
||||
sh -c "cd \"$_arg_testdir\" && ${runner} -targets targets.http -output \"$_arg_output\" \"''${_arg_leftovers[@]}\""
|
||||
${withTools.withSlowPgrst} \
|
||||
sh -c "cd \"$_arg_testdir\" && ${runner} -targets targets.http -output \"$abs_output\" \"''${_arg_leftovers[@]}\""
|
||||
${vegeta}/bin/vegeta report -type=text "$_arg_output"
|
||||
'';
|
||||
|
||||
|
||||
@@ -1,5 +1,6 @@
|
||||
{ buildToolbox
|
||||
, checkedShellScript
|
||||
, coreutils
|
||||
, curl
|
||||
, jq
|
||||
, nix
|
||||
@@ -33,7 +34,7 @@ let
|
||||
commitHash="$(${curl}/bin/curl "${refUrl}" -H "${githubV3Header}" | ${jq}/bin/jq -r .object.sha)"
|
||||
tarballUrl="${tarballUrlBase}$commitHash.tar.gz"
|
||||
tarballHash="$(${nix}/bin/nix-prefetch-url --unpack "$tarballUrl")"
|
||||
currentDate="$(date --iso)"
|
||||
currentDate="$(${coreutils}/bin/date --iso)"
|
||||
|
||||
cat > nix/nixpkgs-version.nix << EOF
|
||||
# Pinned version of Nixpkgs, generated with ${name}.
|
||||
|
||||
@@ -40,7 +40,7 @@ let
|
||||
)"
|
||||
|
||||
repo_url="https://hub.docker.com/v2/repositories/$DOCKER_REPO/postgrest/"
|
||||
echo "Patching both descriptions at $repo_url ..."
|
||||
echo "Patching both descriptions at $repo_url ..."
|
||||
${curl}/bin/curl --fail -X PATCH "$repo_url" \
|
||||
-H "Authorization: JWT $token" \
|
||||
--data-urlencode description@${description} \
|
||||
@@ -51,7 +51,7 @@ let
|
||||
checkedShellScript
|
||||
{
|
||||
name = "postgrest-release";
|
||||
docs = "Patch postgrest.cabal, tag and push all in one go.";
|
||||
docs = "Patch postgrest.cabal, CHANGELOG.md, tag and push all in one go.";
|
||||
args = [ "ARG_POSITIONAL_SINGLE([version], [Version to release], [pre])" ];
|
||||
inRootDir = true;
|
||||
}
|
||||
@@ -69,15 +69,18 @@ let
|
||||
IFS=. read -r major minor patch pre <<< "$current_version"
|
||||
echo "Current version is $current_version"
|
||||
|
||||
bump_pre="$major.$minor.$patch.$(date '+%Y%m%d')"
|
||||
today_date="$(date '+%Y%m%d')"
|
||||
today_date_for_changelog="$(date '+%Y-%m-%d')"
|
||||
bump_pre="$major.$minor.$patch.$today_date"
|
||||
bump_pre_minor="$major.$((minor+1)).0.$today_date"
|
||||
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
|
||||
select new_version in "$bump_pre" "$bump_pre_minor" "$bump_patch" "$bump_minor" "$bump_major"; do
|
||||
case "$REPLY" in
|
||||
1|2|3|4)
|
||||
1|2|3|4|5)
|
||||
echo "Selected $new_version"
|
||||
break
|
||||
;;
|
||||
@@ -92,12 +95,19 @@ let
|
||||
|
||||
echo "Committing ..."
|
||||
git add postgrest.cabal > /dev/null
|
||||
|
||||
if [[ "$new_version" != "$bump_pre" && "$new_version" != "$bump_pre_minor" ]]; then
|
||||
echo "Updating CHANGELOG.md ..."
|
||||
sed -i -E "s/Unreleased/&\n\n## [$new_version] - $today_date_for_changelog/" CHANGELOG.md > /dev/null
|
||||
git add CHANGELOG.md > /dev/null
|
||||
fi
|
||||
|
||||
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
|
||||
trap "echo Remote not found. Please push manually ..." ERR
|
||||
remote="$(git remote -v | grep PostgREST/postgrest | grep push | cut -f1)"
|
||||
trap "" ERR
|
||||
|
||||
@@ -107,9 +117,9 @@ let
|
||||
echo
|
||||
echo "$push"
|
||||
echo
|
||||
|
||||
|
||||
read -r -p 'Proceed? (y/N) ' REPLY
|
||||
case "$REPLY" in
|
||||
case "$REPLY" in
|
||||
y|Y)
|
||||
$push
|
||||
;;
|
||||
|
||||
+4
-20
@@ -32,18 +32,6 @@ let
|
||||
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
|
||||
{
|
||||
@@ -80,7 +68,7 @@ let
|
||||
python3.withPackages (ps: [
|
||||
ps.pyjwt
|
||||
ps.pytest
|
||||
ps.pytest_xdist
|
||||
ps.pytest-xdist
|
||||
ps.pyyaml
|
||||
ps.requests
|
||||
ps.requests-unixsocket
|
||||
@@ -105,7 +93,7 @@ let
|
||||
checkedShellScript
|
||||
{
|
||||
name = "postgrest-dump-schema";
|
||||
docs = "Dump the loaded schema's DbStructure as a yaml file.";
|
||||
docs = "Dump the loaded schema's SchemaCache as a yaml file.";
|
||||
inRootDir = true;
|
||||
withEnv = postgrest.env;
|
||||
withPath = [ jq ];
|
||||
@@ -140,7 +128,7 @@ let
|
||||
rm -rf coverage/*
|
||||
|
||||
# build once before running all the tests
|
||||
${cabal-install}/bin/cabal v2-build ${devCabalOptions} exe:postgrest lib:postgrest test:spec test:querycost
|
||||
${cabal-install}/bin/cabal v2-build ${devCabalOptions} exe:postgrest lib:postgrest test:spec
|
||||
|
||||
(
|
||||
trap 'echo Found dead code: Check file list above.' ERR ;
|
||||
@@ -155,14 +143,11 @@ let
|
||||
HPCTIXFILE="$tmpdir"/spec.tix \
|
||||
${withTools.withPg} ${cabal-install}/bin/cabal v2-run ${devCabalOptions} test:spec
|
||||
|
||||
HPCTIXFILE="$tmpdir"/querycost.tix \
|
||||
${withTools.withPg} ${cabal-install}/bin/cabal v2-run ${devCabalOptions} test:querycost
|
||||
|
||||
# Note: No coverage for doctests, as doctests leverage GHCi and GHCi does not support hpc
|
||||
|
||||
# collect all the tix files
|
||||
${ghc}/bin/hpc sum --union --exclude=Paths_postgrest --output="$tmpdir"/tests.tix \
|
||||
"$tmpdir"/io*.tix "$tmpdir"/spec.tix "$tmpdir"/querycost.tix
|
||||
"$tmpdir"/io*.tix "$tmpdir"/spec.tix
|
||||
|
||||
# prepare the overlay
|
||||
${ghc}/bin/hpc overlay --output="$tmpdir"/overlay.tix test/coverage.overlay
|
||||
@@ -234,7 +219,6 @@ buildToolbox
|
||||
tools =
|
||||
[
|
||||
testSpec
|
||||
testQuerycost
|
||||
testDoctests
|
||||
testSpecIdempotence
|
||||
testIO
|
||||
|
||||
+121
-15
@@ -1,6 +1,7 @@
|
||||
{ bash-completion
|
||||
, buildToolbox
|
||||
, cabal-install
|
||||
, cabalTools
|
||||
, checkedShellScript
|
||||
, curl
|
||||
, devCabalOptions
|
||||
@@ -8,15 +9,20 @@
|
||||
, lib
|
||||
, postgresqlVersions
|
||||
, postgrest
|
||||
, slocat
|
||||
, writeText
|
||||
}:
|
||||
let
|
||||
withTmpDb =
|
||||
{ name, postgresql }:
|
||||
let
|
||||
commandName = "postgrest-with-${name}";
|
||||
superuserRole = "postgres";
|
||||
in
|
||||
checkedShellScript
|
||||
{
|
||||
name = "postgrest-with-${name}";
|
||||
docs = "Run the given command in a temporary database with ${name}";
|
||||
name = commandName;
|
||||
docs = "Run the given command in a temporary database with ${name}. If you wish to mutate the database, login with the '${superuserRole}' role.";
|
||||
args =
|
||||
[
|
||||
"ARG_OPTIONAL_SINGLE([fixtures], [f], [SQL file to load fixtures from], [test/spec/fixtures/load.sql])"
|
||||
@@ -25,6 +31,8 @@ let
|
||||
"ARG_USE_ENV([PGUSER], [postgrest_test_authenticator], [Authenticator PG role])"
|
||||
"ARG_USE_ENV([PGDATABASE], [postgres], [PG database name])"
|
||||
"ARG_USE_ENV([PGRST_DB_SCHEMAS], [test], [Schema to expose])"
|
||||
"ARG_USE_ENV([PGTZ], [utc], [Timezone to use])"
|
||||
"ARG_USE_ENV([PGOPTIONS], [-c search_path=public,test], [PG options to use])"
|
||||
];
|
||||
positionalCompletion = "_command";
|
||||
inRootDir = true;
|
||||
@@ -53,18 +61,26 @@ let
|
||||
export PGUSER
|
||||
export PGDATABASE
|
||||
export PGRST_DB_SCHEMAS
|
||||
export PGTZ
|
||||
export PGOPTIONS
|
||||
|
||||
HBA_FILE="$tmpdir/pg_hba.conf"
|
||||
echo "local $PGDATABASE some_protected_user password" > "$HBA_FILE"
|
||||
echo "local $PGDATABASE all trust" >> "$HBA_FILE"
|
||||
|
||||
log "Initializing database cluster..."
|
||||
# We try to make the database cluster as independent as possible from the host
|
||||
# by specifying the timezone, locale and encoding.
|
||||
PGTZ=UTC initdb --no-locale --encoding=UTF8 --nosync -U "$PGUSER" --auth=trust \
|
||||
# initdb -U creates a superuser(man initdb)
|
||||
PGTZ=UTC initdb --no-locale --encoding=UTF8 --nosync -U "${superuserRole}" --auth=trust \
|
||||
>> "$setuplog"
|
||||
|
||||
log "Starting the database cluster..."
|
||||
# Instead of listening on a local port, we will listen on a unix domain socket.
|
||||
pg_ctl -l "$tmpdir/db.log" -w start -o "-F -c listen_addresses=\"\" -k $PGHOST -c log_statement=\"all\"" \
|
||||
pg_ctl -l "$tmpdir/db.log" -w start -o "-F -c listen_addresses=\"\" -c hba_file=$HBA_FILE -k $PGHOST -c log_statement=\"all\" " \
|
||||
>> "$setuplog"
|
||||
|
||||
# shellcheck disable=SC2317
|
||||
stop () {
|
||||
log "Stopping the database cluster..."
|
||||
pg_ctl stop -m i >> "$setuplog"
|
||||
@@ -72,10 +88,17 @@ let
|
||||
}
|
||||
trap stop EXIT
|
||||
|
||||
log "Loading fixtures..."
|
||||
psql -v ON_ERROR_STOP=1 -f "$_arg_fixtures" >> "$setuplog"
|
||||
log "Creating a minimally privileged $PGUSER connection role..."
|
||||
createuser "$PGUSER" -U "${superuserRole}" --host="$tmpdir/socket" --no-createdb --no-inherit --no-superuser --no-createrole --no-replication --login
|
||||
|
||||
log "Loading fixtures under the ${superuserRole} role..."
|
||||
psql -U "${superuserRole}" -v PGUSER="$PGUSER" -v ON_ERROR_STOP=1 -f "$_arg_fixtures" >> "$setuplog"
|
||||
|
||||
log "Done. Running command..."
|
||||
|
||||
echo "${commandName}: You can connect with: psql 'postgres:///$PGDATABASE?host=$tmpdir/socket' -U ${superuserRole}"
|
||||
echo "${commandName}: You can tail the logs with: tail -f $tmpdir/db.log"
|
||||
|
||||
("$_arg_command" "''${_arg_leftovers[@]}")
|
||||
'';
|
||||
|
||||
@@ -125,6 +148,81 @@ let
|
||||
|
||||
withPg = builtins.head withPgVersions;
|
||||
|
||||
withSlowPg =
|
||||
checkedShellScript
|
||||
{
|
||||
name = "postgrest-with-slow-pg";
|
||||
docs = "Run the given command with simulated high latency postgresql";
|
||||
args =
|
||||
[
|
||||
"ARG_POSITIONAL_SINGLE([command], [Command to run])"
|
||||
"ARG_LEFTOVERS([command arguments])"
|
||||
"ARG_USE_ENV([PGHOST], [], [PG host (socket name)])"
|
||||
"ARG_USE_ENV([PGDELAY], [0ms], [extra PG latency (duration)])"
|
||||
];
|
||||
positionalCompletion = "_command";
|
||||
inRootDir = true;
|
||||
redirectTixFiles = false;
|
||||
withTmpDir = true;
|
||||
}
|
||||
''
|
||||
delay="''${PGDELAY:-0ms}"
|
||||
echo "delaying data to/from postgres by $delay"
|
||||
|
||||
REALPGHOST="$PGHOST"
|
||||
export PGHOST="$tmpdir/socket"
|
||||
mkdir -p "$PGHOST"
|
||||
|
||||
${slocat}/bin/slocat -delay "$delay" -src "$PGHOST/.s.PGSQL.5432" -dst "$REALPGHOST/.s.PGSQL.5432" &
|
||||
SLOCAT_PID=$!
|
||||
# shellcheck disable=SC2317
|
||||
stop_slocat() {
|
||||
kill "$SLOCAT_PID" || true
|
||||
wait "$SLOCAT_PID" || true
|
||||
}
|
||||
trap stop_slocat EXIT
|
||||
sleep 1 # should wait for socket file to appear instead
|
||||
|
||||
("$_arg_command" "''${_arg_leftovers[@]}")
|
||||
'';
|
||||
|
||||
withSlowPgrst =
|
||||
checkedShellScript
|
||||
{
|
||||
name = "postgrest-with-slow-postgrest";
|
||||
docs = "Run the given command with simulated high latency postgrest";
|
||||
args =
|
||||
[
|
||||
"ARG_POSITIONAL_SINGLE([command], [Command to run])"
|
||||
"ARG_LEFTOVERS([command arguments])"
|
||||
"ARG_USE_ENV([PGRST_SERVER_UNIX_SOCKET], [], [PostgREST host (socket name)])"
|
||||
"ARG_USE_ENV([PGRST_DELAY], [0ms], [extra PostgREST latency (duration)])"
|
||||
];
|
||||
positionalCompletion = "_command";
|
||||
inRootDir = true;
|
||||
redirectTixFiles = false;
|
||||
withTmpDir = true;
|
||||
}
|
||||
''
|
||||
delay="''${PGRST_DELAY:-0ms}"
|
||||
echo "delaying data to/from PostgREST by $delay"
|
||||
|
||||
REAL_PGRST_SERVER_UNIX_SOCKET="$PGRST_SERVER_UNIX_SOCKET"
|
||||
export PGRST_SERVER_UNIX_SOCKET="$tmpdir/postgrest.socket"
|
||||
|
||||
${slocat}/bin/slocat -delay "$delay" -src "$PGRST_SERVER_UNIX_SOCKET" -dst "$REAL_PGRST_SERVER_UNIX_SOCKET" &
|
||||
SLOCAT_PID=$!
|
||||
# shellcheck disable=SC2317
|
||||
stop_slocat() {
|
||||
kill "$SLOCAT_PID" || true
|
||||
wait "$SLOCAT_PID" || true
|
||||
}
|
||||
trap stop_slocat EXIT
|
||||
sleep 1 # should wait for socket file to appear instead
|
||||
|
||||
("$_arg_command" "''${_arg_leftovers[@]}")
|
||||
'';
|
||||
|
||||
withGit =
|
||||
let
|
||||
name = "postgrest-with-git";
|
||||
@@ -245,17 +343,25 @@ let
|
||||
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
|
||||
}
|
||||
if [ -z "''${PGRST_BUILD_CABAL:-}" ]; then
|
||||
echo -n "Building postgrest (nix)... "
|
||||
nix-build -A postgrestPackage > "$tmpdir"/build.log 2>&1 || {
|
||||
echo "failed, output:"
|
||||
cat "$tmpdir"/build.log
|
||||
exit 1
|
||||
}
|
||||
PGRST_CMD=./result/bin/postgrest
|
||||
else
|
||||
echo -n "Building postgrest (cabal)... "
|
||||
postgrest-build
|
||||
PGRST_CMD=postgrest-run
|
||||
fi
|
||||
echo "done."
|
||||
|
||||
echo -n "Starting postgrest... "
|
||||
./result/bin/postgrest ${legacyConfig} > "$tmpdir"/run.log 2>&1 &
|
||||
$PGRST_CMD ${legacyConfig} > "$tmpdir"/run.log 2>&1 &
|
||||
pid=$!
|
||||
# shellcheck disable=SC2317
|
||||
cleanup() {
|
||||
kill "$pid" || true
|
||||
}
|
||||
@@ -275,7 +381,7 @@ in
|
||||
buildToolbox
|
||||
{
|
||||
name = "postgrest-with";
|
||||
tools = [ withPgAll withGit withPgrst ] ++ withPgVersions;
|
||||
tools = [ withPgAll withGit withPgrst withSlowPg withSlowPgrst ] ++ withPgVersions;
|
||||
# make withTools available for other nix files
|
||||
extra = { inherit withGit withPg withPgAll withPgrst; };
|
||||
extra = { inherit withGit withPg withPgAll withPgrst withSlowPg withSlowPgrst; };
|
||||
}
|
||||
|
||||
+46
-74
@@ -1,5 +1,5 @@
|
||||
name: postgrest
|
||||
version: 10.0.0
|
||||
version: 11.2.2
|
||||
synopsis: REST API for any Postgres database
|
||||
description: Reads the schema of a PostgreSQL database and creates RESTful routes
|
||||
for tables, views, and functions, supporting all HTTP methods that security
|
||||
@@ -34,8 +34,8 @@ library
|
||||
default-extensions: OverloadedStrings
|
||||
NoImplicitPrelude
|
||||
hs-source-dirs: src
|
||||
exposed-modules: PostgREST.App
|
||||
PostgREST.Admin
|
||||
exposed-modules: PostgREST.Admin
|
||||
PostgREST.App
|
||||
PostgREST.AppState
|
||||
PostgREST.Auth
|
||||
PostgREST.CLI
|
||||
@@ -45,35 +45,38 @@ library
|
||||
PostgREST.Config.PgVersion
|
||||
PostgREST.Config.Proxy
|
||||
PostgREST.Cors
|
||||
PostgREST.DbStructure
|
||||
PostgREST.DbStructure.Identifiers
|
||||
PostgREST.DbStructure.Proc
|
||||
PostgREST.DbStructure.Relationship
|
||||
PostgREST.DbStructure.Table
|
||||
PostgREST.SchemaCache
|
||||
PostgREST.SchemaCache.Identifiers
|
||||
PostgREST.SchemaCache.Routine
|
||||
PostgREST.SchemaCache.Relationship
|
||||
PostgREST.SchemaCache.Representations
|
||||
PostgREST.SchemaCache.Table
|
||||
PostgREST.Error
|
||||
PostgREST.GucHeader
|
||||
PostgREST.Logger
|
||||
PostgREST.Middleware
|
||||
PostgREST.MediaType
|
||||
PostgREST.OpenAPI
|
||||
PostgREST.Query
|
||||
PostgREST.Query.QueryBuilder
|
||||
PostgREST.Query.SqlFragment
|
||||
PostgREST.Query.Statements
|
||||
PostgREST.Plan
|
||||
PostgREST.Plan.CallPlan
|
||||
PostgREST.Plan.MutatePlan
|
||||
PostgREST.Plan.ReadPlan
|
||||
PostgREST.Plan.Types
|
||||
PostgREST.RangeQuery
|
||||
PostgREST.Request.ApiRequest
|
||||
PostgREST.Request.DbRequestBuilder
|
||||
PostgREST.Request.MutateQuery
|
||||
PostgREST.Request.Preferences
|
||||
PostgREST.Request.QueryParams
|
||||
PostgREST.Request.ReadQuery
|
||||
PostgREST.Request.Types
|
||||
PostgREST.ApiRequest
|
||||
PostgREST.ApiRequest.Preferences
|
||||
PostgREST.ApiRequest.QueryParams
|
||||
PostgREST.ApiRequest.Types
|
||||
PostgREST.Response
|
||||
PostgREST.Response.OpenAPI
|
||||
PostgREST.Response.GucHeader
|
||||
PostgREST.Version
|
||||
PostgREST.Workers
|
||||
other-modules: Paths_postgrest
|
||||
build-depends: base >= 4.9 && < 4.17
|
||||
, HTTP >= 4000.3.7 && < 4000.4
|
||||
, HTTP >= 4000.3.7 && < 4000.5
|
||||
, Ranged-sets >= 0.3 && < 0.5
|
||||
, aeson >= 2.0.3 && < 2.1
|
||||
, aeson >= 2.0.3 && < 2.2
|
||||
, auto-update >= 0.1.4 && < 0.2
|
||||
, base64-bytestring >= 1 && < 1.3
|
||||
, bytestring >= 0.10.8 && < 0.12
|
||||
@@ -84,23 +87,25 @@ library
|
||||
, contravariant-extras >= 0.3.3 && < 0.4
|
||||
, cookie >= 0.4.2 && < 0.5
|
||||
, either >= 4.4.1 && < 5.1
|
||||
, extra >= 1.7.0 && < 2.0
|
||||
, fuzzyset >= 0.2.3
|
||||
, gitrev >= 1.2 && < 1.4
|
||||
, hasql >= 1.4 && < 1.6
|
||||
, hasql >= 1.6.1.1 && < 1.7
|
||||
, hasql-dynamic-statements >= 0.3.1 && < 0.4
|
||||
, hasql-notifications >= 0.1 && < 0.3
|
||||
, hasql-pool >= 0.5 && < 0.6
|
||||
, hasql-notifications >= 0.2.0.6 && < 0.3
|
||||
, hasql-pool >= 0.10 && < 0.11
|
||||
, hasql-transaction >= 1.0.1 && < 1.1
|
||||
, heredoc >= 0.2 && < 0.3
|
||||
, http-types >= 0.12.2 && < 0.13
|
||||
, insert-ordered-containers >= 0.2.2 && < 0.3
|
||||
, interpolatedstring-perl6 >= 1 && < 1.1
|
||||
, jose >= 0.8.5.1 && < 0.10
|
||||
, lens >= 4.14 && < 5.2
|
||||
, lens-aeson >= 1.0.1 && < 1.2
|
||||
, jose >= 0.8.5.1 && < 0.11
|
||||
, lens >= 4.14 && < 5.3
|
||||
, lens-aeson >= 1.0.1 && < 1.3
|
||||
, mtl >= 2.2.2 && < 2.3
|
||||
, network >= 2.6 && < 3.2
|
||||
, network-uri >= 2.6.1 && < 2.8
|
||||
, optparse-applicative >= 0.13 && < 0.17
|
||||
, optparse-applicative >= 0.13 && < 0.18
|
||||
, parsec >= 3.1.11 && < 3.2
|
||||
, protolude >= 0.3.1 && < 0.4
|
||||
, regex-tdfa >= 1.2.2 && < 1.4
|
||||
@@ -111,7 +116,7 @@ library
|
||||
, time >= 1.6 && < 1.12
|
||||
, unordered-containers >= 0.2.8 && < 0.3
|
||||
, vault >= 0.3.1.5 && < 0.4
|
||||
, vector >= 0.11 && < 0.13
|
||||
, vector >= 0.11 && < 0.14
|
||||
, wai >= 3.2.1 && < 3.3
|
||||
, wai-cors >= 0.2.5 && < 0.3
|
||||
, wai-extra >= 3.1.8 && < 3.2
|
||||
@@ -184,6 +189,8 @@ test-suite spec
|
||||
Feature.CorsSpec
|
||||
Feature.ExtraSearchPathSpec
|
||||
Feature.LegacyGucsSpec
|
||||
Feature.NoSuperuserSpec
|
||||
Feature.ObservabilitySpec
|
||||
Feature.OpenApi.DisabledOpenApiSpec
|
||||
Feature.OpenApi.IgnorePrivOpenApiSpec
|
||||
Feature.OpenApi.OpenApiSpec
|
||||
@@ -208,17 +215,19 @@ test-suite spec
|
||||
Feature.Query.QuerySpec
|
||||
Feature.Query.RangeSpec
|
||||
Feature.Query.RawOutputTypesSpec
|
||||
Feature.Query.RelatedQueriesSpec
|
||||
Feature.Query.RpcSpec
|
||||
Feature.Query.SingularSpec
|
||||
Feature.Query.NullsStrip
|
||||
Feature.Query.SpreadQueriesSpec
|
||||
Feature.Query.UnicodeSpec
|
||||
Feature.Query.UpdateSpec
|
||||
Feature.Query.UpsertSpec
|
||||
Feature.RollbackSpec
|
||||
Feature.RpcPreRequestGucsSpec
|
||||
SpecHelper
|
||||
TestTypes
|
||||
build-depends: base >= 4.9 && < 4.17
|
||||
, aeson >= 2.0.3 && < 2.1
|
||||
, aeson >= 2.0.3 && < 2.2
|
||||
, aeson-qq >= 0.8.1 && < 0.9
|
||||
, async >= 2.1.1 && < 2.3
|
||||
, auto-update >= 0.1.4 && < 0.2
|
||||
@@ -226,69 +235,32 @@ test-suite spec
|
||||
, bytestring >= 0.10.8 && < 0.12
|
||||
, case-insensitive >= 1.2 && < 1.3
|
||||
, containers >= 0.5.7 && < 0.7
|
||||
, hasql-pool >= 0.5 && < 0.6
|
||||
, hasql-pool >= 0.10 && < 0.11
|
||||
, hasql-transaction >= 1.0.1 && < 1.1
|
||||
, heredoc >= 0.2 && < 0.3
|
||||
, hspec >= 2.3 && < 2.9
|
||||
, hspec >= 2.3 && < 2.10
|
||||
, hspec-wai >= 0.10 && < 0.12
|
||||
, hspec-wai-json >= 0.10 && < 0.12
|
||||
, http-types >= 0.12.3 && < 0.13
|
||||
, lens >= 4.14 && < 5.2
|
||||
, lens-aeson >= 1.0.1 && < 1.2
|
||||
, lens >= 4.14 && < 5.3
|
||||
, lens-aeson >= 1.0.1 && < 1.3
|
||||
, monad-control >= 1.0.1 && < 1.1
|
||||
, postgrest
|
||||
, process >= 1.4.2 && < 1.7
|
||||
, protolude >= 0.3.1 && < 0.4
|
||||
, regex-tdfa >= 1.2.2 && < 1.4
|
||||
, scientific >= 0.3.4 && < 0.4
|
||||
, text >= 1.2.2 && < 1.3
|
||||
, transformers-base >= 0.4.4 && < 0.5
|
||||
, wai >= 3.2.1 && < 3.3
|
||||
, wai-extra >= 3.0.19 && < 3.2
|
||||
ghc-options: -O0 -Werror -Wall -fwarn-identities
|
||||
ghc-options: -threaded -O0 -Werror -Wall -fwarn-identities
|
||||
-fno-spec-constr -optP-Wno-nonportable-include-path
|
||||
-fno-warn-missing-signatures
|
||||
-fwrite-ide-info
|
||||
-- https://github.com/PostgREST/postgrest/issues/387
|
||||
-with-rtsopts=-K33K
|
||||
|
||||
test-suite querycost
|
||||
type: exitcode-stdio-1.0
|
||||
default-language: Haskell2010
|
||||
default-extensions: OverloadedStrings
|
||||
QuasiQuotes
|
||||
NoImplicitPrelude
|
||||
hs-source-dirs: test/spec
|
||||
main-is: QueryCost.hs
|
||||
other-modules: SpecHelper
|
||||
build-depends: base >= 4.9 && < 4.17
|
||||
, aeson >= 2.0.3 && < 2.1
|
||||
, base64-bytestring >= 1 && < 1.3
|
||||
, bytestring >= 0.10.8 && < 0.12
|
||||
, case-insensitive >= 1.2 && < 1.3
|
||||
, containers >= 0.5.7 && < 0.7
|
||||
, contravariant >= 1.4 && < 1.6
|
||||
, hasql >= 1.4 && < 1.6
|
||||
, hasql-dynamic-statements >= 0.3.1 && < 0.4
|
||||
, hasql-pool >= 0.5 && < 0.6
|
||||
, hasql-transaction >= 1.0.1 && < 1.1
|
||||
, heredoc >= 0.2 && < 0.3
|
||||
, hspec >= 2.3 && < 2.9
|
||||
, hspec-wai >= 0.10 && < 0.12
|
||||
, hspec-wai-json >= 0.10 && < 0.12
|
||||
, http-types >= 0.12.3 && < 0.13
|
||||
, lens >= 4.14 && < 5.2
|
||||
, lens-aeson >= 1.0.1 && < 1.2
|
||||
, postgrest
|
||||
, process >= 1.4.2 && < 1.7
|
||||
, protolude >= 0.3.1 && < 0.4
|
||||
, regex-tdfa >= 1.2.2 && < 1.4
|
||||
, wai-extra >= 3.0.19 && < 3.2
|
||||
ghc-options: -O0 -Werror -Wall -fwarn-identities
|
||||
-fno-spec-constr -optP-Wno-nonportable-include-path
|
||||
-fwrite-ide-info
|
||||
-- https://github.com/PostgREST/postgrest/issues/387
|
||||
-with-rtsopts=-K1K
|
||||
|
||||
test-suite doctests
|
||||
type: exitcode-stdio-1.0
|
||||
default-language: Haskell2010
|
||||
|
||||
@@ -40,6 +40,7 @@ lib.overrideDerivation postgrest.env (
|
||||
pkgs.cabal2nix
|
||||
pkgs.git
|
||||
pkgs.postgresql
|
||||
pkgs.update-nix-fetchgit
|
||||
postgrest.hsie.bin
|
||||
]
|
||||
++ toolboxes;
|
||||
|
||||
+23
-10
@@ -1,28 +1,41 @@
|
||||
{-# LANGUAGE NamedFieldPuns #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
|
||||
module PostgREST.Admin
|
||||
( postgrestAdmin
|
||||
( runAdmin
|
||||
) where
|
||||
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Text as T
|
||||
import qualified Hasql.Session as SQL
|
||||
import qualified Network.HTTP.Types.Status as HTTP
|
||||
import qualified Network.Wai as Wai
|
||||
import qualified Network.Wai.Handler.Warp as Warp
|
||||
|
||||
import Control.Monad.Extra (whenJust)
|
||||
|
||||
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 PostgREST.AppState (AppState)
|
||||
import PostgREST.Config (AppConfig (..))
|
||||
|
||||
import qualified PostgREST.AppState as AppState
|
||||
import PostgREST.Config (AppConfig (..))
|
||||
|
||||
import Protolude
|
||||
|
||||
runAdmin :: AppConfig -> AppState -> Warp.Settings -> IO ()
|
||||
runAdmin conf@AppConfig{configAdminServerPort} appState settings =
|
||||
whenJust configAdminServerPort $ \adminPort -> do
|
||||
AppState.logWithZTime appState $ "Admin server listening on port " <> show adminPort
|
||||
void . forkIO $ Warp.runSettings (settings & Warp.setPort adminPort) adminApp
|
||||
where
|
||||
adminApp = admin appState conf
|
||||
|
||||
-- | PostgREST admin application
|
||||
postgrestAdmin :: AppState.AppState -> AppConfig -> Wai.Application
|
||||
postgrestAdmin appState appConfig req respond = do
|
||||
admin :: AppState.AppState -> AppConfig -> Wai.Application
|
||||
admin appState appConfig req respond = do
|
||||
isMainAppReachable <- any isRight <$> reachMainApp appConfig
|
||||
isSchemaCacheLoaded <- isJust <$> AppState.getDbStructure appState
|
||||
isSchemaCacheLoaded <- isJust <$> AppState.getSchemaCache appState
|
||||
isConnectionUp <-
|
||||
if configDbChannelEnabled appConfig
|
||||
then AppState.getIsListenerOn appState
|
||||
|
||||
@@ -0,0 +1,379 @@
|
||||
{-|
|
||||
Module : PostgREST.Request.ApiRequest
|
||||
Description : PostgREST functions to translate HTTP request to a domain type called ApiRequest.
|
||||
-}
|
||||
{-# LANGUAGE LambdaCase #-}
|
||||
{-# LANGUAGE MultiWayIf #-}
|
||||
{-# LANGUAGE NamedFieldPuns #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
|
||||
module PostgREST.ApiRequest
|
||||
( ApiRequest(..)
|
||||
, InvokeMethod(..)
|
||||
, Mutation(..)
|
||||
, MediaType(..)
|
||||
, Action(..)
|
||||
, Target(..)
|
||||
, Payload(..)
|
||||
, userApiRequest
|
||||
) where
|
||||
|
||||
import qualified Data.Aeson as JSON
|
||||
import qualified Data.Aeson.Key as K
|
||||
import qualified Data.Aeson.KeyMap as KM
|
||||
import qualified Data.ByteString.Char8 as BS
|
||||
import qualified Data.ByteString.Lazy as LBS
|
||||
import qualified Data.CaseInsensitive as CI
|
||||
import qualified Data.Csv as CSV
|
||||
import qualified Data.HashMap.Strict as HM
|
||||
import qualified Data.List as L
|
||||
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 Data.Either.Combinators (mapBoth)
|
||||
|
||||
import Control.Arrow ((***))
|
||||
import Data.Aeson.Types (emptyArray, emptyObject)
|
||||
import Data.List (lookup, union)
|
||||
import Data.Ranged.Ranges (emptyRange, rangeIntersection,
|
||||
rangeIsEmpty)
|
||||
import Network.HTTP.Types.Header (RequestHeaders, hCookie)
|
||||
import Network.HTTP.Types.URI (parseSimpleQuery)
|
||||
import Network.Wai (Request (..))
|
||||
import Network.Wai.Parse (parseHttpAccept)
|
||||
import Web.Cookie (parseCookies)
|
||||
|
||||
import PostgREST.ApiRequest.QueryParams (QueryParams (..))
|
||||
import PostgREST.ApiRequest.Types (ApiRequestError (..),
|
||||
RangeError (..))
|
||||
import PostgREST.Config (AppConfig (..),
|
||||
OpenAPIMode (..))
|
||||
import PostgREST.MediaType (MTPlanFormat (..),
|
||||
MediaType (..))
|
||||
import PostgREST.RangeQuery (NonnegRange, allRange,
|
||||
convertToLimitZeroRange,
|
||||
hasLimitZero,
|
||||
rangeRequested)
|
||||
import PostgREST.SchemaCache.Identifiers (FieldName,
|
||||
QualifiedIdentifier (..),
|
||||
Schema)
|
||||
|
||||
import qualified PostgREST.ApiRequest.Preferences as Preferences
|
||||
import qualified PostgREST.ApiRequest.QueryParams as QueryParams
|
||||
import qualified PostgREST.MediaType as MediaType
|
||||
|
||||
import Protolude
|
||||
|
||||
|
||||
type RequestBody = LBS.ByteString
|
||||
|
||||
data Payload
|
||||
= ProcessedJSON -- ^ Cached attributes of a JSON payload
|
||||
{ payRaw :: LBS.ByteString
|
||||
-- ^ 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
|
||||
-- large payloads the encoding had high memory usage, see
|
||||
-- https://github.com/PostgREST/postgrest/pull/1005 for more details
|
||||
, payKeys :: S.Set Text
|
||||
-- ^ Keys of the object or if it's an array these keys are guaranteed to
|
||||
-- be the same across all its objects
|
||||
}
|
||||
| ProcessedUrlEncoded { payArray :: [(Text, Text)], payKeys :: S.Set Text }
|
||||
| RawJSON { payRaw :: LBS.ByteString }
|
||||
| RawPay { payRaw :: LBS.ByteString }
|
||||
|
||||
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
|
||||
data Action
|
||||
= ActionMutate Mutation
|
||||
| ActionRead {isHead :: Bool}
|
||||
| ActionInvoke InvokeMethod
|
||||
| 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)
|
||||
data PathInfo
|
||||
= PathInfo
|
||||
{ pathName :: Text
|
||||
, pathIsProc :: Bool
|
||||
, pathIsDefSpec :: Bool
|
||||
, pathIsRootSpec :: Bool
|
||||
}
|
||||
-- | The target db object of a user action
|
||||
data Target = TargetIdent QualifiedIdentifier
|
||||
| TargetProc{tProc :: QualifiedIdentifier, tpIsRootSpec :: Bool}
|
||||
| TargetDefaultSpec{tdsSchema :: Schema} -- The default spec offered at root "/"
|
||||
|
||||
{-|
|
||||
Describes what the user wants to do. This data type is a
|
||||
translation of the raw elements of an HTTP request into domain
|
||||
specific language. There is no guarantee that the intent is
|
||||
sensible, it is up to a later stage of processing to determine
|
||||
if it is an action we are able to perform.
|
||||
-}
|
||||
data ApiRequest = ApiRequest {
|
||||
iAction :: Action -- ^ Similar but not identical to HTTP method, e.g. Create/Invoke both POST
|
||||
, iRange :: HM.HashMap Text NonnegRange -- ^ Requested range of rows within response
|
||||
, iTopLevelRange :: NonnegRange -- ^ Requested range of rows from the top level
|
||||
, iTarget :: Target -- ^ The target, be it calling a proc or accessing a table
|
||||
, iPayload :: Maybe Payload -- ^ Data sent by client and used for mutation actions
|
||||
, iPreferences :: Preferences.Preferences -- ^ Prefer header values
|
||||
, iQueryParams :: QueryParams.QueryParams
|
||||
, iColumns :: S.Set FieldName -- ^ parsed colums from &columns parameter and payload
|
||||
, iHeaders :: [(ByteString, ByteString)] -- ^ HTTP request headers
|
||||
, iCookies :: [(ByteString, ByteString)] -- ^ Request Cookies
|
||||
, iPath :: ByteString -- ^ Raw request path
|
||||
, iMethod :: ByteString -- ^ Raw request method
|
||||
, iSchema :: Schema -- ^ The request schema. Can vary depending on profile headers.
|
||||
, iNegotiatedByProfile :: Bool -- ^ If schema was was chosen according to the profile spec https://www.w3.org/TR/dx-prof-conneg/
|
||||
, iAcceptMediaType :: MediaType -- ^ The media type in the Accept header
|
||||
, iContentMediaType :: MediaType -- ^ The media type in the Content-Type header
|
||||
}
|
||||
|
||||
-- | Examines HTTP request and translates it into user intent.
|
||||
userApiRequest :: AppConfig -> Request -> RequestBody -> Either ApiRequestError ApiRequest
|
||||
userApiRequest conf req reqBody = do
|
||||
pInfo@PathInfo{..} <- getPathInfo conf $ pathInfo req
|
||||
act <- getAction pInfo method
|
||||
qPrms <- first QueryParamError $ QueryParams.parse (pathIsProc && act `elem` [ActionInvoke InvGet, ActionInvoke InvHead]) $ rawQueryString req
|
||||
(acceptMediaType, contentMediaType) <- getMediaTypes conf hdrs act pInfo
|
||||
(schema, negotiatedByProfile) <- getSchema conf hdrs method
|
||||
(topLevelRange, ranges) <- getRanges method qPrms hdrs
|
||||
(payload, columns) <- getPayload reqBody contentMediaType qPrms act pInfo
|
||||
return $ ApiRequest {
|
||||
iAction = act
|
||||
, iTarget = if | pathIsProc -> TargetProc (QualifiedIdentifier schema pathName) pathIsRootSpec
|
||||
| pathIsDefSpec -> TargetDefaultSpec schema
|
||||
| otherwise -> TargetIdent $ QualifiedIdentifier schema pathName
|
||||
, iRange = ranges
|
||||
, iTopLevelRange = topLevelRange
|
||||
, iPayload = payload
|
||||
, iPreferences = Preferences.fromHeaders (configDbTxAllowOverride conf) hdrs
|
||||
, iQueryParams = qPrms
|
||||
, iColumns = columns
|
||||
, iHeaders = iHdrs
|
||||
, iCookies = iCkies
|
||||
, iPath = rawPathInfo req
|
||||
, iMethod = method
|
||||
, iSchema = schema
|
||||
, iNegotiatedByProfile = negotiatedByProfile
|
||||
, iAcceptMediaType = acceptMediaType
|
||||
, iContentMediaType = contentMediaType
|
||||
}
|
||||
where
|
||||
method = requestMethod req
|
||||
hdrs = requestHeaders req
|
||||
lookupHeader = flip lookup hdrs
|
||||
iHdrs = [ (CI.foldedCase k, v) | (k,v) <- hdrs, k /= hCookie]
|
||||
iCkies = maybe [] parseCookies $ lookupHeader "Cookie"
|
||||
|
||||
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
|
||||
|
||||
getMediaTypes :: AppConfig -> RequestHeaders -> Action -> PathInfo -> Either ApiRequestError (MediaType, MediaType)
|
||||
getMediaTypes conf hdrs action path = do
|
||||
acceptMediaType <- negotiateContent conf action path accepts
|
||||
pure (acceptMediaType, contentMediaType)
|
||||
where
|
||||
accepts = maybe [MTAny] (map MediaType.decodeMediaType . parseHttpAccept) $ lookupHeader "accept"
|
||||
contentMediaType = maybe MTApplicationJSON MediaType.decodeMediaType $ lookupHeader "content-type"
|
||||
lookupHeader = flip lookup hdrs
|
||||
|
||||
getSchema :: AppConfig -> RequestHeaders -> ByteString -> Either ApiRequestError (Schema, Bool)
|
||||
getSchema AppConfig{configDbSchemas} hdrs method = do
|
||||
case profile of
|
||||
Just p | p `notElem` configDbSchemas -> Left $ UnacceptableSchema $ toList configDbSchemas
|
||||
| otherwise -> Right (p, True)
|
||||
Nothing -> Right (defaultSchema, length configDbSchemas /= 1) -- if we have many schemas, assume the default schema was negotiated
|
||||
where
|
||||
defaultSchema = NonEmptyList.head configDbSchemas
|
||||
profile = case method of
|
||||
-- POST/PATCH/PUT/DELETE don't use the same header as per the spec
|
||||
"DELETE" -> contentProfile
|
||||
"PATCH" -> contentProfile
|
||||
"POST" -> contentProfile
|
||||
"PUT" -> contentProfile
|
||||
_ -> acceptProfile
|
||||
contentProfile = T.decodeUtf8 <$> lookupHeader "Content-Profile"
|
||||
acceptProfile = T.decodeUtf8 <$> lookupHeader "Accept-Profile"
|
||||
lookupHeader = flip lookup hdrs
|
||||
|
||||
getRanges :: ByteString -> QueryParams -> RequestHeaders -> Either ApiRequestError (NonnegRange, HM.HashMap Text NonnegRange)
|
||||
getRanges method QueryParams{qsOrder,qsRanges} hdrs
|
||||
| isInvalidRange = Left $ InvalidRange (if rangeIsEmpty headerRange then LowerGTUpper else NegativeLimit)
|
||||
| method `elem` ["PATCH", "DELETE"] && not (null qsRanges) && null qsOrder = Left LimitNoOrderError
|
||||
| method == "PUT" && topLevelRange /= allRange = Left PutLimitNotAllowedError
|
||||
| otherwise = Right (topLevelRange, ranges)
|
||||
where
|
||||
-- According to the RFC (https://www.rfc-editor.org/rfc/rfc9110.html#name-range),
|
||||
-- the Range header must be ignored for all methods other than GET
|
||||
headerRange = if method == "GET" then rangeRequested hdrs else allRange
|
||||
limitRange = fromMaybe allRange (HM.lookup "limit" qsRanges)
|
||||
headerAndLimitRange = rangeIntersection headerRange limitRange
|
||||
-- Bypass all the ranges and send only the limit zero range (0 <= x <= -1) if
|
||||
-- limit=0 is present in the query params (not allowed for the Range header)
|
||||
ranges = HM.insert "limit" (convertToLimitZeroRange limitRange headerAndLimitRange) qsRanges
|
||||
-- The only emptyRange allowed is the limit zero range
|
||||
isInvalidRange = topLevelRange == emptyRange && not (hasLimitZero limitRange)
|
||||
topLevelRange = fromMaybe allRange $ HM.lookup "limit" ranges -- if no limit is specified, get all the request rows
|
||||
|
||||
getPayload :: RequestBody -> MediaType -> QueryParams.QueryParams -> Action -> PathInfo -> Either ApiRequestError (Maybe Payload, S.Set FieldName)
|
||||
getPayload reqBody contentMediaType QueryParams{qsColumns} action PathInfo{pathIsProc}= do
|
||||
checkedPayload <- if shouldParsePayload then payload else Right Nothing
|
||||
let cols = case (checkedPayload, columns) of
|
||||
(Just ProcessedJSON{payKeys}, _) -> payKeys
|
||||
(Just ProcessedUrlEncoded{payKeys}, _) -> payKeys
|
||||
(Just RawJSON{}, Just cls) -> cls
|
||||
_ -> S.empty
|
||||
return (checkedPayload, cols)
|
||||
where
|
||||
payload :: Either ApiRequestError (Maybe Payload)
|
||||
payload = mapBoth InvalidBody Just $ case (contentMediaType, pathIsProc) of
|
||||
(MTApplicationJSON, _) ->
|
||||
if isJust columns
|
||||
then Right $ RawJSON reqBody
|
||||
else note "All object keys must match" . payloadAttributes reqBody
|
||||
=<< if LBS.null reqBody && pathIsProc
|
||||
then Right emptyObject
|
||||
else first BS.pack $ JSON.eitherDecode reqBody
|
||||
(MTTextCSV, _) -> do
|
||||
json <- csvToJson <$> first BS.pack (CSV.decodeByName reqBody)
|
||||
note "All lines must have same number of fields" $ payloadAttributes (JSON.encode json) json
|
||||
(MTUrlEncoded, isProc) -> do
|
||||
let params = (T.decodeUtf8 *** T.decodeUtf8) <$> parseSimpleQuery (LBS.toStrict reqBody)
|
||||
if isProc
|
||||
then Right $ ProcessedUrlEncoded params (S.fromList $ fst <$> params)
|
||||
else
|
||||
let paramsMap = HM.fromList $ (identity *** JSON.String) <$> params in
|
||||
Right $ ProcessedJSON (JSON.encode paramsMap) $ S.fromList (HM.keys paramsMap)
|
||||
(MTTextPlain, True) -> Right $ RawPay reqBody
|
||||
(MTTextXML, True) -> Right $ RawPay reqBody
|
||||
(MTOctetStream, True) -> Right $ RawPay reqBody
|
||||
(ct, _) -> Left $ "Content-Type not acceptable: " <> MediaType.toMime ct
|
||||
|
||||
shouldParsePayload = case (action, contentMediaType) of
|
||||
(ActionMutate MutationCreate, _) -> True
|
||||
(ActionInvoke InvPost, _) -> True
|
||||
(ActionMutate MutationSingleUpsert, _) -> True
|
||||
(ActionMutate MutationUpdate, _) -> True
|
||||
_ -> False
|
||||
|
||||
columns = case action of
|
||||
ActionMutate MutationCreate -> qsColumns
|
||||
ActionMutate MutationUpdate -> qsColumns
|
||||
ActionInvoke InvPost -> qsColumns
|
||||
_ -> Nothing
|
||||
|
||||
type CsvData = V.Vector (M.Map Text LBS.ByteString)
|
||||
|
||||
{-|
|
||||
Converts CSV like
|
||||
a,b
|
||||
1,hi
|
||||
2,bye
|
||||
|
||||
into a JSON array like
|
||||
[ {"a": "1", "b": "hi"}, {"a": 2, "b": "bye"} ]
|
||||
|
||||
The reason for its odd signature is so that it can compose
|
||||
directly with CSV.decodeByName
|
||||
-}
|
||||
csvToJson :: (CSV.Header, CsvData) -> JSON.Value
|
||||
csvToJson (_, vals) =
|
||||
JSON.Array $ V.map rowToJsonObj vals
|
||||
where
|
||||
rowToJsonObj = JSON.Object . KM.fromMapText .
|
||||
M.map (\str ->
|
||||
if str == "NULL"
|
||||
then JSON.Null
|
||||
else JSON.String . T.decodeUtf8 $ LBS.toStrict str
|
||||
)
|
||||
|
||||
payloadAttributes :: RequestBody -> JSON.Value -> Maybe Payload
|
||||
payloadAttributes raw json =
|
||||
-- Test that Array contains only Objects having the same keys
|
||||
case json of
|
||||
JSON.Array arr ->
|
||||
case arr V.!? 0 of
|
||||
Just (JSON.Object o) ->
|
||||
let canonicalKeys = S.fromList $ K.toText <$> KM.keys o
|
||||
areKeysUniform = all (\case
|
||||
JSON.Object x -> S.fromList (K.toText <$> KM.keys x) == canonicalKeys
|
||||
_ -> False) arr in
|
||||
if areKeysUniform
|
||||
then Just $ ProcessedJSON raw canonicalKeys
|
||||
else Nothing
|
||||
Just _ -> Nothing
|
||||
Nothing -> Just emptyPJArray
|
||||
|
||||
JSON.Object o -> Just $ ProcessedJSON raw (S.fromList $ K.toText <$> KM.keys o)
|
||||
|
||||
-- truncate everything else to an empty array.
|
||||
_ -> Just emptyPJArray
|
||||
where
|
||||
emptyPJArray = ProcessedJSON (JSON.encode emptyArray) S.empty
|
||||
|
||||
|
||||
-- | Do content negotiation. i.e. choose a media type based on the intersection of accepted/produced media types.
|
||||
negotiateContent :: AppConfig -> Action -> PathInfo -> [MediaType] -> Either ApiRequestError MediaType
|
||||
negotiateContent conf action path accepts =
|
||||
case firstAcceptedPick of
|
||||
Just MTAny -> Right MTApplicationJSON -- by default(for */*) we respond with json
|
||||
Just mt -> Right mt
|
||||
Nothing -> Left . MediaTypeError $ map MediaType.toMime accepts
|
||||
where
|
||||
-- if there are multiple accepted media types, pick the first
|
||||
firstAcceptedPick = listToMaybe $ L.intersect accepts $ producedMediaTypes conf action path
|
||||
|
||||
producedMediaTypes :: AppConfig -> Action -> PathInfo -> [MediaType]
|
||||
producedMediaTypes conf action path =
|
||||
case action of
|
||||
ActionRead _ -> defaultMediaTypes ++ rawMediaTypes
|
||||
ActionInvoke _ -> invokeMediaTypes
|
||||
ActionInfo -> defaultMediaTypes
|
||||
ActionMutate _ -> defaultMediaTypes
|
||||
ActionInspect _ -> inspectMediaTypes
|
||||
where
|
||||
inspectMediaTypes = [MTOpenAPI, MTApplicationJSON, MTArrayJSONStrip, MTAny]
|
||||
invokeMediaTypes =
|
||||
defaultMediaTypes
|
||||
++ rawMediaTypes
|
||||
++ [MTOpenAPI | pathIsRootSpec path]
|
||||
defaultMediaTypes =
|
||||
[MTApplicationJSON, MTArrayJSONStrip, MTSingularJSON True, MTSingularJSON False, MTGeoJSON, MTTextCSV] ++
|
||||
[MTPlan MTApplicationJSON PlanText mempty | configDbPlanEnabled conf] ++ [MTAny]
|
||||
rawMediaTypes = configRawMediaTypes conf `union` [MTOctetStream, MTTextPlain, MTTextXML]
|
||||
@@ -1,20 +1,23 @@
|
||||
-- |
|
||||
-- Module: PostgREST.Request.Preferences
|
||||
-- Module: PostgREST.ApiRequest.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
|
||||
{-# LANGUAGE NamedFieldPuns #-}
|
||||
module PostgREST.ApiRequest.Preferences
|
||||
( Preferences(..)
|
||||
, PreferCount(..)
|
||||
, PreferMissing(..)
|
||||
, PreferParameters(..)
|
||||
, PreferRepresentation(..)
|
||||
, PreferResolution(..)
|
||||
, PreferTransaction(..)
|
||||
, fromHeaders
|
||||
, ToAppliedHeader(..)
|
||||
, shouldCount
|
||||
, prefAppliedHeader
|
||||
) where
|
||||
|
||||
import qualified Data.ByteString.Char8 as BS
|
||||
@@ -32,6 +35,7 @@ import Protolude
|
||||
-- >>> deriving instance Show PreferParameters
|
||||
-- >>> deriving instance Show PreferCount
|
||||
-- >>> deriving instance Show PreferTransaction
|
||||
-- >>> deriving instance Show PreferMissing
|
||||
-- >>> deriving instance Show Preferences
|
||||
|
||||
-- | Preferences recognized by the application.
|
||||
@@ -42,6 +46,7 @@ data Preferences
|
||||
, preferParameters :: Maybe PreferParameters
|
||||
, preferCount :: Maybe PreferCount
|
||||
, preferTransaction :: Maybe PreferTransaction
|
||||
, preferMissing :: Maybe PreferMissing
|
||||
}
|
||||
|
||||
-- |
|
||||
@@ -49,35 +54,37 @@ data Preferences
|
||||
--
|
||||
-- One header with comma-separated values can be used to set multiple preferences:
|
||||
--
|
||||
-- >>> pPrint $ fromHeaders [("Prefer", "resolution=ignore-duplicates, count=exact")]
|
||||
-- >>> pPrint $ fromHeaders True [("Prefer", "resolution=ignore-duplicates, count=exact")]
|
||||
-- Preferences
|
||||
-- { preferResolution = Just IgnoreDuplicates
|
||||
-- , preferRepresentation = Nothing
|
||||
-- , preferParameters = Nothing
|
||||
-- , preferCount = Just ExactCount
|
||||
-- , preferTransaction = Nothing
|
||||
-- , preferMissing = Nothing
|
||||
-- }
|
||||
--
|
||||
-- Multiple headers can also be used:
|
||||
--
|
||||
-- >>> pPrint $ fromHeaders [("Prefer", "resolution=ignore-duplicates"), ("Prefer", "count=exact")]
|
||||
-- >>> pPrint $ fromHeaders True [("Prefer", "resolution=ignore-duplicates"), ("Prefer", "count=exact"), ("Prefer", "missing=null")]
|
||||
-- Preferences
|
||||
-- { preferResolution = Just IgnoreDuplicates
|
||||
-- , preferRepresentation = Nothing
|
||||
-- , preferParameters = Nothing
|
||||
-- , preferCount = Just ExactCount
|
||||
-- , preferTransaction = Nothing
|
||||
-- , preferMissing = Just ApplyNulls
|
||||
-- }
|
||||
--
|
||||
-- If a preference is set more than once, only the first is used:
|
||||
--
|
||||
-- >>> preferTransaction $ fromHeaders [("Prefer", "tx=commit, tx=rollback")]
|
||||
-- >>> preferTransaction $ fromHeaders True [("Prefer", "tx=commit, tx=rollback")]
|
||||
-- Just Commit
|
||||
--
|
||||
-- This is also the case across multiple headers:
|
||||
--
|
||||
-- >>> :{
|
||||
-- preferResolution . fromHeaders $
|
||||
-- preferResolution . fromHeaders True $
|
||||
-- [ ("Prefer", "resolution=ignore-duplicates")
|
||||
-- , ("Prefer", "resolution=merge-duplicates")
|
||||
-- ]
|
||||
@@ -86,28 +93,30 @@ data Preferences
|
||||
--
|
||||
-- Preferences not recognized by the application are ignored:
|
||||
--
|
||||
-- >>> preferResolution $ fromHeaders [("Prefer", "resolution=foo")]
|
||||
-- >>> preferResolution $ fromHeaders True [("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")]
|
||||
-- >>> pPrint $ fromHeaders True [("prefer", "count=exact, tx=commit ,return=representation , missing=default")]
|
||||
-- Preferences
|
||||
-- { preferResolution = Nothing
|
||||
-- , preferRepresentation = Just None
|
||||
-- , preferRepresentation = Just Full
|
||||
-- , preferParameters = Nothing
|
||||
-- , preferCount = Just ExactCount
|
||||
-- , preferTransaction = Just Commit
|
||||
-- , preferMissing = Just ApplyDefaults
|
||||
-- }
|
||||
--
|
||||
fromHeaders :: [HTTP.Header] -> Preferences
|
||||
fromHeaders headers =
|
||||
fromHeaders :: Bool -> [HTTP.Header] -> Preferences
|
||||
fromHeaders allowTxEndOverride headers =
|
||||
Preferences
|
||||
{ preferResolution = parsePrefs [MergeDuplicates, IgnoreDuplicates]
|
||||
{ preferResolution = parsePrefs [MergeDuplicates, IgnoreDuplicates]
|
||||
, preferRepresentation = parsePrefs [Full, None, HeadersOnly]
|
||||
, preferParameters = parsePrefs [SingleObject, MultipleObjects]
|
||||
, preferCount = parsePrefs [ExactCount, PlannedCount, EstimatedCount]
|
||||
, preferTransaction = parsePrefs [Commit, Rollback]
|
||||
, preferParameters = parsePrefs [SingleObject]
|
||||
, preferCount = parsePrefs [ExactCount, PlannedCount, EstimatedCount]
|
||||
, preferTransaction = if allowTxEndOverride then parsePrefs [Commit, Rollback] else Nothing
|
||||
, preferMissing = parsePrefs [ApplyDefaults, ApplyNulls]
|
||||
}
|
||||
where
|
||||
prefHeaders = filter ((==) HTTP.hPrefer . fst) headers
|
||||
@@ -120,6 +129,22 @@ fromHeaders headers =
|
||||
prefMap :: ToHeaderValue a => [a] -> Map.Map ByteString a
|
||||
prefMap = Map.fromList . fmap (\pref -> (toHeaderValue pref, pref))
|
||||
|
||||
prefAppliedHeader :: Preferences -> Maybe HTTP.Header
|
||||
prefAppliedHeader Preferences {preferResolution, preferRepresentation, preferParameters, preferCount, preferTransaction, preferMissing } =
|
||||
if null prefsVals
|
||||
then Nothing
|
||||
else Just (HTTP.hPreferenceApplied, combined)
|
||||
where
|
||||
combined = BS.intercalate ", " prefsVals
|
||||
prefsVals = catMaybes [
|
||||
toHeaderValue <$> preferResolution
|
||||
, toHeaderValue <$> preferMissing
|
||||
, toHeaderValue <$> preferRepresentation
|
||||
, toHeaderValue <$> preferParameters
|
||||
, toHeaderValue <$> preferCount
|
||||
, toHeaderValue <$> preferTransaction
|
||||
]
|
||||
|
||||
-- |
|
||||
-- Convert a preference into the value that we look for in the 'Prefer' headers.
|
||||
--
|
||||
@@ -129,16 +154,6 @@ fromHeaders headers =
|
||||
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
|
||||
= MergeDuplicates
|
||||
@@ -148,8 +163,6 @@ instance ToHeaderValue PreferResolution where
|
||||
toHeaderValue MergeDuplicates = "resolution=merge-duplicates"
|
||||
toHeaderValue IgnoreDuplicates = "resolution=ignore-duplicates"
|
||||
|
||||
instance ToAppliedHeader PreferResolution
|
||||
|
||||
-- |
|
||||
-- How to return the mutated data.
|
||||
--
|
||||
@@ -168,12 +181,10 @@ instance ToHeaderValue PreferRepresentation where
|
||||
-- | How to pass parameters to stored procedures.
|
||||
data PreferParameters
|
||||
= 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.
|
||||
deriving Eq
|
||||
|
||||
instance ToHeaderValue PreferParameters where
|
||||
toHeaderValue SingleObject = "params=single-object"
|
||||
toHeaderValue MultipleObjects = "params=multiple-objects"
|
||||
|
||||
-- | How to determine the count of (expected) results
|
||||
data PreferCount
|
||||
@@ -187,6 +198,10 @@ instance ToHeaderValue PreferCount where
|
||||
toHeaderValue PlannedCount = "count=planned"
|
||||
toHeaderValue EstimatedCount = "count=estimated"
|
||||
|
||||
shouldCount :: Maybe PreferCount -> Bool
|
||||
shouldCount prefCount =
|
||||
prefCount == Just ExactCount || prefCount == Just EstimatedCount
|
||||
|
||||
-- | Whether to commit or roll back transactions.
|
||||
data PreferTransaction
|
||||
= Commit -- ^ Commit transaction - the default.
|
||||
@@ -197,4 +212,14 @@ instance ToHeaderValue PreferTransaction where
|
||||
toHeaderValue Commit = "tx=commit"
|
||||
toHeaderValue Rollback = "tx=rollback"
|
||||
|
||||
instance ToAppliedHeader PreferTransaction
|
||||
-- |
|
||||
-- How to handle the insertion/update when the keys specified in ?columns are not present
|
||||
-- in the json body.
|
||||
data PreferMissing
|
||||
= ApplyDefaults -- ^ Use the default column value for missing values.
|
||||
| ApplyNulls -- ^ Use the null value for missing values.
|
||||
deriving Eq
|
||||
|
||||
instance ToHeaderValue PreferMissing where
|
||||
toHeaderValue ApplyDefaults = "missing=default"
|
||||
toHeaderValue ApplyNulls = "missing=null"
|
||||
@@ -0,0 +1,813 @@
|
||||
-- |
|
||||
-- Module : PostgREST.ApiRequest.QueryParams
|
||||
-- Description : Parser for PostgREST Query parameters
|
||||
--
|
||||
-- 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.ApiRequest.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.ParserCombinators.Parsec (GenParser, ParseError, Parser,
|
||||
anyChar, between, char, digit,
|
||||
eof, errorPos, letter,
|
||||
lookAhead, many1, noneOf,
|
||||
notFollowedBy, oneOf,
|
||||
optionMaybe, sepBy, sepBy1,
|
||||
string, try, (<?>))
|
||||
|
||||
import PostgREST.RangeQuery (NonnegRange, allRange,
|
||||
rangeGeq, rangeLimit,
|
||||
rangeOffset, restrictRange)
|
||||
import PostgREST.SchemaCache.Identifiers (FieldName)
|
||||
|
||||
import PostgREST.ApiRequest.Types (EmbedParam (..), EmbedPath, Field,
|
||||
Filter (..), FtsOperator (..),
|
||||
Hint, JoinType (..),
|
||||
JsonOperand (..),
|
||||
JsonOperation (..), JsonPath,
|
||||
ListVal, LogicOperator (..),
|
||||
LogicTree (..), OpExpr (..),
|
||||
OpQuantifier (..), Operation (..),
|
||||
OrderDirection (..),
|
||||
OrderNulls (..), OrderTerm (..),
|
||||
QPError (..), QuantOperator (..),
|
||||
SelectItem (..),
|
||||
SimpleOperator (..), SingleVal,
|
||||
TrileanVal (..))
|
||||
|
||||
import Protolude hiding (try)
|
||||
|
||||
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 parameters sorted alphabetically:
|
||||
--
|
||||
-- >>> qsCanonical <$> parse True "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 False "select=name,location"
|
||||
-- Right [Node {rootLabel = SelectField {selField = ("name",[]), selCast = Nothing, selAlias = Nothing}, subForest = []},Node {rootLabel = SelectField {selField = ("location",[]), selCast = Nothing, selAlias = Nothing}, subForest = []}]
|
||||
--
|
||||
-- Filters are parameters whose value contains an operator, separated by a '.' from its value:
|
||||
--
|
||||
-- >>> qsFilters <$> parse False "a.b=eq.0"
|
||||
-- Right [(["a"],Filter {field = ("b",[]), opExpr = OpExpr False (OpQuant OpEqual Nothing "0")})]
|
||||
--
|
||||
-- If the operator specified in a filter does not exist, parsing the query string fails:
|
||||
--
|
||||
-- >>> qsFilters <$> parse False "a.b=noop.0"
|
||||
-- Left (QPError "\"failed to parse filter (noop.0)\" (line 1, column 1)" "unexpected \"o\" expecting \"not\" or operator (eq, gt, ...)")
|
||||
parse :: Bool -> ByteString -> Either QPError QueryParams
|
||||
parse isRpcGet qs = do
|
||||
rOrd <- pRequestOrder `traverse` order
|
||||
rLogic <- pRequestLogicTree `traverse` logic
|
||||
rCols <- pRequestColumns columns
|
||||
rSel <- pRequestSelect select
|
||||
(rFlts, params) <- L.partition hasOp <$> pRequestFilter isRpcGet `traverse` filters
|
||||
(rFltsRoot, rFltsNotRoot) <- pure $ L.partition hasRootFilter rFlts
|
||||
rOnConflict <- pRequestOnConflict `traverse` onConflict
|
||||
|
||||
let rFltsFields = S.fromList (fst <$> filters)
|
||||
params' = mapMaybe (\case {(_, Filter (fld, _) (NoOpExpr v)) -> Just (fld,v); _ -> Nothing}) params
|
||||
rFltsRoot' = snd <$> rFltsRoot
|
||||
|
||||
return $ QueryParams canonical params' ranges rOrd rLogic rCols rSel rFlts rFltsRoot' rFltsNotRoot rFltsFields rOnConflict
|
||||
where
|
||||
hasRootFilter, hasOp :: (EmbedPath, Filter) -> Bool
|
||||
hasRootFilter ([], _) = True
|
||||
hasRootFilter _ = False
|
||||
hasOp (_, Filter (_, _) (NoOpExpr _)) = False
|
||||
hasOp _ = True
|
||||
|
||||
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 = filter (isFilter . fst) nonemptyParams
|
||||
isFilter k = not (endingIn reservedEmbeddable k) && notElem k reserved
|
||||
reserved = ["select", "columns", "on_conflict"]
|
||||
reservedEmbeddable = ["order", "limit", "offset", "and", "or"]
|
||||
|
||||
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]
|
||||
|
||||
simpleOperator :: Parser SimpleOperator
|
||||
simpleOperator =
|
||||
try (string "neq" $> OpNotEqual) <|>
|
||||
try (string "cs" $> OpContains) <|>
|
||||
try (string "cd" $> OpContained) <|>
|
||||
try (string "ov" $> OpOverlap) <|>
|
||||
try (string "sl" $> OpStrictlyLeft) <|>
|
||||
try (string "sr" $> OpStrictlyRight) <|>
|
||||
try (string "nxr" $> OpNotExtendsRight) <|>
|
||||
try (string "nxl" $> OpNotExtendsLeft) <|>
|
||||
try (string "adj" $> OpAdjacent) <?>
|
||||
"unknown single value operator"
|
||||
|
||||
quantOperator :: Parser QuantOperator
|
||||
quantOperator =
|
||||
try (string "eq" $> OpEqual) <|>
|
||||
try (string "gte" $> OpGreaterThanEqual) <|>
|
||||
try (string "gt" $> OpGreaterThan) <|>
|
||||
try (string "lte" $> OpLessThanEqual) <|>
|
||||
try (string "lt" $> OpLessThan) <|>
|
||||
try (string "like" $> OpLike) <|>
|
||||
try (string "ilike" $> OpILike) <|>
|
||||
try (string "match" $> OpMatch) <|>
|
||||
try (string "imatch" $> OpIMatch) <?>
|
||||
"unknown single value operator"
|
||||
|
||||
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)
|
||||
|
||||
-- |
|
||||
-- Parse `id=eq.1`(id, eq.1) into (EmbedPath, Filter)
|
||||
--
|
||||
-- >>> pRequestFilter False ("id", "eq.1")
|
||||
-- Right ([],Filter {field = ("id",[]), opExpr = OpExpr False (OpQuant OpEqual Nothing "1")})
|
||||
--
|
||||
-- >>> pRequestFilter False ("id", "val")
|
||||
-- Left (QPError "\"failed to parse filter (val)\" (line 1, column 1)" "unexpected \"v\" expecting \"not\" or operator (eq, gt, ...)")
|
||||
--
|
||||
-- >>> pRequestFilter True ("id", "val")
|
||||
-- Right ([],Filter {field = ("id",[]), opExpr = NoOpExpr "val"})
|
||||
pRequestFilter :: Bool -> (Text, Text) -> Either QPError (EmbedPath, Filter)
|
||||
pRequestFilter isRpcGet (k, v) = mapError $ (,) <$> path <*> (Filter <$> fld <*> oper)
|
||||
where
|
||||
treePath = P.parse pTreePath ("failed to parse tree path (" ++ toS k ++ ")") $ toS k
|
||||
oper = P.parse parseFlt ("failed to parse filter (" ++ toS v ++ ")") $ toS v
|
||||
parseFlt = if isRpcGet
|
||||
then pOpExpr pSingleVal <|> pure (NoOpExpr v)
|
||||
else pOpExpr pSingleVal
|
||||
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))
|
||||
|
||||
-- |
|
||||
-- Parse select= into a Forest of SelectItems
|
||||
--
|
||||
-- >>> P.parse pFieldForest "" "id"
|
||||
-- Right [Node {rootLabel = SelectField {selField = ("id",[]), selCast = Nothing, selAlias = Nothing}, subForest = []}]
|
||||
--
|
||||
-- >>> P.parse pFieldForest "" "client(id)"
|
||||
-- Right [Node {rootLabel = SelectRelation {selRelation = "client", selAlias = Nothing, selHint = Nothing, selJoinType = Nothing}, subForest = [Node {rootLabel = SelectField {selField = ("id",[]), selCast = Nothing, selAlias = Nothing}, subForest = []}]}]
|
||||
--
|
||||
-- >>> P.parse pFieldForest "" "*,client(*,nested(*))"
|
||||
-- Right [Node {rootLabel = SelectField {selField = ("*",[]), selCast = Nothing, selAlias = Nothing}, subForest = []},Node {rootLabel = SelectRelation {selRelation = "client", selAlias = Nothing, selHint = Nothing, selJoinType = Nothing}, subForest = [Node {rootLabel = SelectField {selField = ("*",[]), selCast = Nothing, selAlias = Nothing}, subForest = []},Node {rootLabel = SelectRelation {selRelation = "nested", selAlias = Nothing, selHint = Nothing, selJoinType = Nothing}, subForest = [Node {rootLabel = SelectField {selField = ("*",[]), selCast = Nothing, selAlias = Nothing}, subForest = []}]}]}]
|
||||
--
|
||||
-- >>> P.parse pFieldForest "" "*,...client(*),other(*)"
|
||||
-- Right [Node {rootLabel = SelectField {selField = ("*",[]), selCast = Nothing, selAlias = Nothing}, subForest = []},Node {rootLabel = SpreadRelation {selRelation = "client", selHint = Nothing, selJoinType = Nothing}, subForest = [Node {rootLabel = SelectField {selField = ("*",[]), selCast = Nothing, selAlias = Nothing}, subForest = []}]},Node {rootLabel = SelectRelation {selRelation = "other", selAlias = Nothing, selHint = Nothing, selJoinType = Nothing}, subForest = [Node {rootLabel = SelectField {selField = ("*",[]), selCast = Nothing, selAlias = Nothing}, subForest = []}]}]
|
||||
--
|
||||
-- >>> P.parse pFieldForest "" ""
|
||||
-- Right []
|
||||
--
|
||||
-- >>> P.parse pFieldForest "" "id,clients(name[])"
|
||||
-- Left (line 1, column 16):
|
||||
-- unexpected '['
|
||||
-- expecting letter, digit, "-", "->>", "->", "::", ")", "," or end of input
|
||||
--
|
||||
-- >>> P.parse pFieldForest "" "data->>-78xy"
|
||||
-- Left (line 1, column 11):
|
||||
-- unexpected 'x'
|
||||
-- expecting digit, "->", "::", ".", "," or end of input
|
||||
pFieldForest :: Parser [Tree SelectItem]
|
||||
pFieldForest = pFieldTree `sepBy` lexeme (char ',')
|
||||
where
|
||||
pFieldTree = Node <$> try pSpreadRelationSelect <*> between (char '(') (char ')') pFieldForest <|>
|
||||
Node <$> try pRelationSelect <*> between (char '(') (char ')') pFieldForest <|>
|
||||
Node <$> pFieldSelect <*> pure []
|
||||
|
||||
-- |
|
||||
-- Parse field names
|
||||
--
|
||||
-- >>> P.parse pFieldName "" "identifier"
|
||||
-- Right "identifier"
|
||||
--
|
||||
-- >>> P.parse pFieldName "" "identifier with spaces"
|
||||
-- Right "identifier with spaces"
|
||||
--
|
||||
-- >>> P.parse pFieldName "" "identifier-with-dashes"
|
||||
-- Right "identifier-with-dashes"
|
||||
--
|
||||
-- >>> P.parse pFieldName "" "123"
|
||||
-- Right "123"
|
||||
--
|
||||
-- >>> P.parse pFieldName "" "_"
|
||||
-- Right "_"
|
||||
--
|
||||
-- >>> P.parse pFieldName "" "$"
|
||||
-- Right "$"
|
||||
--
|
||||
-- >>> P.parse pFieldName "" ":"
|
||||
-- Left (line 1, column 1):
|
||||
-- unexpected ":"
|
||||
-- expecting field name (* or [a..z0..9_$])
|
||||
--
|
||||
-- >>> P.parse pFieldName "" "\":\""
|
||||
-- Right ":"
|
||||
--
|
||||
-- >>> P.parse pFieldName "" " no leading or trailing spaces "
|
||||
-- Right "no leading or trailing spaces"
|
||||
--
|
||||
-- >>> P.parse pFieldName "" "\" leading and trailing spaces \""
|
||||
-- Right " leading and trailing spaces "
|
||||
pFieldName :: Parser Text
|
||||
pFieldName =
|
||||
pQuotedValue <|>
|
||||
T.intercalate "-" . map toS <$> (pIdentifier `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"}}]
|
||||
--
|
||||
-- Fails on badly formed negatives
|
||||
--
|
||||
-- >>> P.parse pJsonPath "" "->>-78xy"
|
||||
-- Left (line 1, column 7):
|
||||
-- unexpected 'x'
|
||||
-- expecting digit, "->", "::", ".", "," or end of input
|
||||
--
|
||||
-- >>> P.parse pJsonPath "" "->>--34"
|
||||
-- Left (line 1, column 5):
|
||||
-- unexpected "-"
|
||||
-- expecting digit
|
||||
--
|
||||
-- >>> P.parse pJsonPath "" "->>-xy-4"
|
||||
-- Left (line 1, column 5):
|
||||
-- unexpected "x"
|
||||
-- expecting digit
|
||||
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 ':')
|
||||
|
||||
-- |
|
||||
-- Parse regular fields in select
|
||||
--
|
||||
-- >>> P.parse pRelationSelect "" "rel(*)"
|
||||
-- Right (SelectRelation {selRelation = "rel", selAlias = Nothing, selHint = Nothing, selJoinType = Nothing})
|
||||
--
|
||||
-- >>> P.parse pRelationSelect "" "alias:rel(*)"
|
||||
-- Right (SelectRelation {selRelation = "rel", selAlias = Just "alias", selHint = Nothing, selJoinType = Nothing})
|
||||
--
|
||||
-- >>> P.parse pRelationSelect "" "rel!hint(*)"
|
||||
-- Right (SelectRelation {selRelation = "rel", selAlias = Nothing, selHint = Just "hint", selJoinType = Nothing})
|
||||
--
|
||||
-- >>> P.parse pRelationSelect "" "rel!inner(*)"
|
||||
-- Right (SelectRelation {selRelation = "rel", selAlias = Nothing, selHint = Nothing, selJoinType = Just JTInner})
|
||||
--
|
||||
-- >>> P.parse pRelationSelect "" "rel!hint!inner(*)"
|
||||
-- Right (SelectRelation {selRelation = "rel", selAlias = Nothing, selHint = Just "hint", selJoinType = Just JTInner})
|
||||
--
|
||||
-- >>> P.parse pRelationSelect "" "alias:rel!inner!hint(*)"
|
||||
-- Right (SelectRelation {selRelation = "rel", selAlias = Just "alias", selHint = Just "hint", selJoinType = Just JTInner})
|
||||
--
|
||||
-- >>> P.parse pRelationSelect "" "rel->jsonpath(*)"
|
||||
-- Left (line 1, column 6):
|
||||
-- unexpected '>'
|
||||
--
|
||||
-- >>> P.parse pRelationSelect "" "rel->jsonpath!hint(*)"
|
||||
-- Left (line 1, column 6):
|
||||
-- unexpected '>'
|
||||
pRelationSelect :: Parser SelectItem
|
||||
pRelationSelect = lexeme $ do
|
||||
alias <- optionMaybe ( try(pFieldName <* aliasSeparator) )
|
||||
name <- pFieldName
|
||||
(hint, jType) <- pEmbedParams
|
||||
try (void $ lookAhead (string "("))
|
||||
return $ SelectRelation name alias hint jType
|
||||
|
||||
-- |
|
||||
-- Parse regular fields in select
|
||||
--
|
||||
-- >>> P.parse pFieldSelect "" "name"
|
||||
-- Right (SelectField {selField = ("name",[]), selCast = Nothing, selAlias = Nothing})
|
||||
--
|
||||
-- >>> P.parse pFieldSelect "" "name->jsonpath"
|
||||
-- Right (SelectField {selField = ("name",[JArrow {jOp = JKey {jVal = "jsonpath"}}]), selCast = Nothing, selAlias = Nothing})
|
||||
--
|
||||
-- >>> P.parse pFieldSelect "" "name::cast"
|
||||
-- Right (SelectField {selField = ("name",[]), selCast = Just "cast", selAlias = Nothing})
|
||||
--
|
||||
-- >>> P.parse pFieldSelect "" "alias:name"
|
||||
-- Right (SelectField {selField = ("name",[]), selCast = Nothing, selAlias = Just "alias"})
|
||||
--
|
||||
-- >>> P.parse pFieldSelect "" "alias:name->jsonpath::cast"
|
||||
-- Right (SelectField {selField = ("name",[JArrow {jOp = JKey {jVal = "jsonpath"}}]), selCast = Just "cast", selAlias = Just "alias"})
|
||||
--
|
||||
-- >>> P.parse pFieldSelect "" "*"
|
||||
-- Right (SelectField {selField = ("*",[]), selCast = Nothing, selAlias = Nothing})
|
||||
--
|
||||
-- >>> P.parse pFieldSelect "" "name!hint"
|
||||
-- Left (line 1, column 5):
|
||||
-- unexpected '!'
|
||||
-- expecting letter, digit, "-", "->>", "->", "::", ")", "," or end of input
|
||||
--
|
||||
-- >>> P.parse pFieldSelect "" "*!hint"
|
||||
-- Left (line 1, column 2):
|
||||
-- unexpected '!'
|
||||
-- expecting ")", "," or end of input
|
||||
--
|
||||
-- >>> P.parse pFieldSelect "" "name::"
|
||||
-- Left (line 1, column 7):
|
||||
-- unexpected end of input
|
||||
-- expecting letter or digit
|
||||
pFieldSelect :: Parser SelectItem
|
||||
pFieldSelect = lexeme $ try (do
|
||||
s <- pStar
|
||||
pEnd
|
||||
return $ SelectField (s, []) Nothing Nothing)
|
||||
<|> do
|
||||
alias <- optionMaybe ( try(pFieldName <* aliasSeparator) )
|
||||
fld <- pField
|
||||
cast' <- optionMaybe (string "::" *> pIdentifier)
|
||||
pEnd
|
||||
return $ SelectField fld (toS <$> cast') alias
|
||||
where
|
||||
pEnd = try (void $ lookAhead (string ")")) <|>
|
||||
try (void $ lookAhead (string ",")) <|>
|
||||
try eof
|
||||
pStar = string "*" $> "*"
|
||||
|
||||
|
||||
-- |
|
||||
-- Parse spread relations in select
|
||||
--
|
||||
-- >>> P.parse pSpreadRelationSelect "" "...rel(*)"
|
||||
-- Right (SpreadRelation {selRelation = "rel", selHint = Nothing, selJoinType = Nothing})
|
||||
--
|
||||
-- >>> P.parse pSpreadRelationSelect "" "...rel!hint!inner(*)"
|
||||
-- Right (SpreadRelation {selRelation = "rel", selHint = Just "hint", selJoinType = Just JTInner})
|
||||
--
|
||||
-- >>> P.parse pSpreadRelationSelect "" "rel(*)"
|
||||
-- Left (line 1, column 1):
|
||||
-- unexpected "r"
|
||||
-- expecting "..."
|
||||
--
|
||||
-- >>> P.parse pSpreadRelationSelect "" "alias:...rel(*)"
|
||||
-- Left (line 1, column 1):
|
||||
-- unexpected "a"
|
||||
-- expecting "..."
|
||||
--
|
||||
-- >>> P.parse pSpreadRelationSelect "" "...rel->jsonpath(*)"
|
||||
-- Left (line 1, column 9):
|
||||
-- unexpected '>'
|
||||
pSpreadRelationSelect :: Parser SelectItem
|
||||
pSpreadRelationSelect = lexeme $ do
|
||||
name <- string "..." >> pFieldName
|
||||
(hint, jType) <- pEmbedParams
|
||||
try (void $ lookAhead (string "("))
|
||||
return $ SpreadRelation name hint jType
|
||||
|
||||
pEmbedParams :: Parser (Maybe Hint, Maybe JoinType)
|
||||
pEmbedParams = do
|
||||
prm1 <- optionMaybe pEmbedParam
|
||||
prm2 <- optionMaybe pEmbedParam
|
||||
return (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
|
||||
|
||||
-- |
|
||||
-- Parse operator expression used in horizontal filtering
|
||||
--
|
||||
-- >>> P.parse (pOpExpr pSingleVal) "" "fts().value"
|
||||
-- Left (line 1, column 5):
|
||||
-- unexpected ")"
|
||||
-- expecting operator (eq, gt, ...)
|
||||
--
|
||||
-- >>> P.parse (pOpExpr pSingleVal) "" "eq(any).value"
|
||||
-- Right (OpExpr False (OpQuant OpEqual (Just QuantAny) "value"))
|
||||
--
|
||||
-- >>> P.parse (pOpExpr pSingleVal) "" "eq(all).value"
|
||||
-- Right (OpExpr False (OpQuant OpEqual (Just QuantAll) "value"))
|
||||
--
|
||||
-- >>> P.parse (pOpExpr pSingleVal) "" "not.eq(all).value"
|
||||
-- Right (OpExpr True (OpQuant OpEqual (Just QuantAll) "value"))
|
||||
--
|
||||
-- >>> P.parse (pOpExpr pSingleVal) "" "eq().value"
|
||||
-- Left (line 1, column 4):
|
||||
-- unexpected ")"
|
||||
-- expecting operator (eq, gt, ...)
|
||||
--
|
||||
-- >>> P.parse (pOpExpr pSingleVal) "" "is().value"
|
||||
-- Left (line 1, column 3):
|
||||
-- unexpected "("
|
||||
-- expecting operator (eq, gt, ...)
|
||||
--
|
||||
-- >>> P.parse (pOpExpr pSingleVal) "" "in().value"
|
||||
-- Left (line 1, column 3):
|
||||
-- unexpected "("
|
||||
-- expecting operator (eq, gt, ...)
|
||||
pOpExpr :: Parser SingleVal -> Parser OpExpr
|
||||
pOpExpr pSVal = do
|
||||
boolExpr <- try (string "not" *> pDelimiter $> True) <|> pure False
|
||||
OpExpr boolExpr <$> pOperation
|
||||
where
|
||||
pOperation :: Parser Operation
|
||||
pOperation = pIn <|> pIs <|> pIsDist <|> try pFts <|> try pSimpleOp <|> try pQuantOp <?> "operator (eq, gt, ...)"
|
||||
|
||||
pIn = In <$> (try (string "in" *> pDelimiter) *> pListVal)
|
||||
pIs = Is <$> (try (string "is" *> pDelimiter) *> pTriVal)
|
||||
|
||||
pIsDist = IsDistinctFrom <$> (try (string "isdistinct" *> pDelimiter) *> pSVal)
|
||||
|
||||
pSimpleOp = do
|
||||
op <- simpleOperator
|
||||
pDelimiter *> (Op op <$> pSVal)
|
||||
|
||||
pQuantOp = do
|
||||
op <- quantOperator
|
||||
quant <- optionMaybe $ try (between (char '(') (char ')') (try (string "any" $> QuantAny) <|> string "all" $> QuantAll))
|
||||
pDelimiter *> (OpQuant op quant <$> 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
|
||||
op <- try (string "fts" $> FilterFts)
|
||||
<|> try (string "plfts" $> FilterFtsPlain)
|
||||
<|> try (string "phfts" $> FilterFtsPhrase)
|
||||
<|> try (string "wfts" $> FilterFtsWebsearch)
|
||||
|
||||
lang <- optionMaybe $ try (between (char '(') (char ')') pIdentifier)
|
||||
pDelimiter >> Fts op (toS <$> lang) <$> pSVal
|
||||
|
||||
-- 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 (.)"
|
||||
|
||||
-- |
|
||||
-- Parses the elements in the order query parameter
|
||||
--
|
||||
-- >>> P.parse pOrder "" "name.desc.nullsfirst"
|
||||
-- Right [OrderTerm {otTerm = ("name",[]), otDirection = Just OrderDesc, otNullOrder = Just OrderNullsFirst}]
|
||||
--
|
||||
-- >>> P.parse pOrder "" "json_col->key.asc.nullslast"
|
||||
-- Right [OrderTerm {otTerm = ("json_col",[JArrow {jOp = JKey {jVal = "key"}}]), otDirection = Just OrderAsc, otNullOrder = Just OrderNullsLast}]
|
||||
--
|
||||
-- >>> P.parse pOrder "" "clients(json_col->key).desc.nullsfirst"
|
||||
-- Right [OrderRelationTerm {otRelation = "clients", otRelTerm = ("json_col",[JArrow {jOp = JKey {jVal = "key"}}]), otDirection = Just OrderDesc, otNullOrder = Just OrderNullsFirst}]
|
||||
--
|
||||
-- >>> P.parse pOrder "" "clients(name,id)"
|
||||
-- Left (line 1, column 8):
|
||||
-- unexpected '('
|
||||
-- expecting letter, digit, "-", "->>", "->", delimiter (.), "," or end of input
|
||||
--
|
||||
-- >>> P.parse pOrder "" "name,clients(name),id"
|
||||
-- Right [OrderTerm {otTerm = ("name",[]), otDirection = Nothing, otNullOrder = Nothing},OrderRelationTerm {otRelation = "clients", otRelTerm = ("name",[]), otDirection = Nothing, otNullOrder = Nothing},OrderTerm {otTerm = ("id",[]), otDirection = Nothing, otNullOrder = Nothing}]
|
||||
--
|
||||
-- >>> P.parse pOrder "" "id.ac"
|
||||
-- Left (line 1, column 4):
|
||||
-- unexpected "c"
|
||||
-- expecting "asc", "desc", "nullsfirst" or "nullslast"
|
||||
--
|
||||
-- >>> P.parse pOrder "" "id.descc"
|
||||
-- Left (line 1, column 8):
|
||||
-- unexpected 'c'
|
||||
-- expecting delimiter (.), "," or end of input
|
||||
--
|
||||
-- >>> P.parse pOrder "" "id.nulsfist"
|
||||
-- Left (line 1, column 4):
|
||||
-- unexpected "n"
|
||||
-- expecting "asc", "desc", "nullsfirst" or "nullslast"
|
||||
--
|
||||
-- >>> P.parse pOrder "" "id.nullslasttt"
|
||||
-- Left (line 1, column 13):
|
||||
-- unexpected 't'
|
||||
-- expecting "," or end of input
|
||||
--
|
||||
-- >>> P.parse pOrder "" "id.smth34"
|
||||
-- Left (line 1, column 4):
|
||||
-- unexpected "s"
|
||||
-- expecting "asc", "desc", "nullsfirst" or "nullslast"
|
||||
--
|
||||
-- >>> P.parse pOrder "" "id.asc.nlsfst"
|
||||
-- Left (line 1, column 8):
|
||||
-- unexpected "l"
|
||||
-- expecting "nullsfirst" or "nullslast"
|
||||
--
|
||||
-- >>> P.parse pOrder "" "id.asc.nullslasttt"
|
||||
-- Left (line 1, column 17):
|
||||
-- unexpected 't'
|
||||
-- expecting "," or end of input
|
||||
--
|
||||
-- >>> P.parse pOrder "" "id.asc.smth34"
|
||||
-- Left (line 1, column 8):
|
||||
-- unexpected "s"
|
||||
-- expecting "nullsfirst" or "nullslast"
|
||||
pOrder :: Parser [OrderTerm]
|
||||
pOrder = lexeme (try pOrderRelationTerm <|> pOrderTerm) `sepBy1` char ','
|
||||
where
|
||||
pOrderTerm = do
|
||||
fld <- pField
|
||||
dir <- optionMaybe pOrdDir
|
||||
nls <- optionMaybe pNulls <* pEnd <|>
|
||||
pEnd $> Nothing
|
||||
return $ OrderTerm fld dir nls
|
||||
|
||||
pOrderRelationTerm = do
|
||||
nam <- pFieldName
|
||||
fld <- between (char '(') (char ')') pField
|
||||
dir <- optionMaybe pOrdDir
|
||||
nls <- optionMaybe pNulls <* pEnd <|> pEnd $> Nothing
|
||||
return $ OrderRelationTerm nam fld dir nls
|
||||
|
||||
pNulls :: Parser OrderNulls
|
||||
pNulls = try (pDelimiter *> string "nullsfirst" $> OrderNullsFirst) <|>
|
||||
try (pDelimiter *> string "nullslast" $> OrderNullsLast)
|
||||
|
||||
pOrdDir :: Parser OrderDirection
|
||||
pOrdDir = try (pDelimiter *> string "asc" $> OrderAsc) <|>
|
||||
try (pDelimiter *> string "desc" $> OrderDesc)
|
||||
|
||||
pEnd = try (void $ lookAhead (char ',')) <|> try eof
|
||||
|
||||
-- |
|
||||
-- Parses the elements inside or/and
|
||||
--
|
||||
-- >>> P.parse pLogicTree "" "or()"
|
||||
-- Left (line 1, column 4):
|
||||
-- unexpected ")"
|
||||
-- expecting field name (* or [a..z0..9_$]), negation operator (not) or logic operator (and, or)
|
||||
--
|
||||
-- >>> P.parse pLogicTree "" "or(id.in.1,2,id.eq.3)"
|
||||
-- Left (line 1, column 10):
|
||||
-- unexpected "1"
|
||||
-- expecting "("
|
||||
--
|
||||
-- >>> P.parse pLogicTree "" "or)("
|
||||
-- Left (line 1, column 3):
|
||||
-- unexpected ")"
|
||||
-- expecting "("
|
||||
--
|
||||
-- >>> P.parse pLogicTree "" "and(ord(id.eq.1,id.eq.1),id.eq.2)"
|
||||
-- Left (line 1, column 7):
|
||||
-- unexpected "d"
|
||||
-- expecting "("
|
||||
--
|
||||
-- >>> P.parse pLogicTree "" "or(id.eq.1,not.xor(id.eq.2,id.eq.3))"
|
||||
-- Left (line 1, column 16):
|
||||
-- unexpected "x"
|
||||
-- expecting logic operator (and, or)
|
||||
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 ',')
|
||||
|
||||
pIdentifier :: Parser Text
|
||||
pIdentifier = T.strip . toS <$> many1 pIdentifierChar
|
||||
|
||||
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)
|
||||
@@ -1,5 +1,5 @@
|
||||
{-# LANGUAGE DuplicateRecordFields #-}
|
||||
module PostgREST.Request.Types
|
||||
module PostgREST.ApiRequest.Types
|
||||
( Alias
|
||||
, Cast
|
||||
, Depth
|
||||
@@ -9,10 +9,6 @@ module PostgREST.Request.Types
|
||||
, Field
|
||||
, Filter(..)
|
||||
, Hint
|
||||
, CallQuery(..)
|
||||
, CallParams(..)
|
||||
, CallRequest
|
||||
, JoinCondition(..)
|
||||
, JoinType(..)
|
||||
, JsonOperand(..)
|
||||
, JsonOperation(..)
|
||||
@@ -23,90 +19,109 @@ module PostgREST.Request.Types
|
||||
, NodeName
|
||||
, OpExpr(..)
|
||||
, Operation (..)
|
||||
, OpQuantifier(..)
|
||||
, OrderDirection(..)
|
||||
, OrderNulls(..)
|
||||
, OrderTerm(..)
|
||||
, QPError(..)
|
||||
, RangeError(..)
|
||||
, SingleVal
|
||||
, TrileanVal(..)
|
||||
, SimpleOperator(..)
|
||||
, QuantOperator(..)
|
||||
, FtsOperator(..)
|
||||
, SelectItem(..)
|
||||
) where
|
||||
|
||||
import qualified Data.ByteString.Lazy as LBS
|
||||
|
||||
import PostgREST.DbStructure.Identifiers (FieldName,
|
||||
QualifiedIdentifier)
|
||||
import PostgREST.DbStructure.Proc (ProcDescription (..),
|
||||
ProcParam (..))
|
||||
import PostgREST.DbStructure.Relationship (Relationship)
|
||||
import PostgREST.MediaType (MediaType (..))
|
||||
import PostgREST.SchemaCache.Identifiers (FieldName,
|
||||
QualifiedIdentifier)
|
||||
import PostgREST.SchemaCache.Relationship (Relationship,
|
||||
RelationshipsMap)
|
||||
import PostgREST.SchemaCache.Routine (Routine (..))
|
||||
|
||||
import Protolude
|
||||
|
||||
|
||||
-- | The value in `/tbl?select=alias:field::cast`
|
||||
data SelectItem
|
||||
= SelectField
|
||||
{ selField :: Field
|
||||
, selCast :: Maybe Cast
|
||||
, selAlias :: Maybe Alias
|
||||
}
|
||||
-- | The value in `/tbl?select=alias:another_tbl(*)`
|
||||
| SelectRelation
|
||||
{ selRelation :: FieldName
|
||||
, selAlias :: Maybe Alias
|
||||
, selHint :: Maybe Hint
|
||||
, selJoinType :: Maybe JoinType
|
||||
}
|
||||
-- | The value in `/tbl?select=...another_tbl(*)`
|
||||
| SpreadRelation
|
||||
{ selRelation :: FieldName
|
||||
, selHint :: Maybe Hint
|
||||
, selJoinType :: Maybe JoinType
|
||||
}
|
||||
deriving (Eq, Show)
|
||||
|
||||
data ApiRequestError
|
||||
= AmbiguousRelBetween Text Text [Relationship]
|
||||
| AmbiguousRpc [ProcDescription]
|
||||
| AmbiguousRpc [Routine]
|
||||
| BinaryFieldError MediaType
|
||||
| MediaTypeError [ByteString]
|
||||
| InvalidBody ByteString
|
||||
| InvalidFilters
|
||||
| InvalidRange
|
||||
| InvalidRange RangeError
|
||||
| InvalidRpcMethod ByteString
|
||||
| LimitNoOrderError
|
||||
| NotFound
|
||||
| NoRelBetween Text Text Text
|
||||
| NoRpc Text Text [Text] Bool MediaType Bool
|
||||
| NoRelBetween Text Text (Maybe Text) Text RelationshipsMap
|
||||
| NoRpc Text Text [Text] Bool MediaType Bool [QualifiedIdentifier] [Routine]
|
||||
| NotEmbedded Text
|
||||
| ParseRequestError Text Text
|
||||
| PutRangeNotAllowedError
|
||||
| PutLimitNotAllowedError
|
||||
| QueryParamError QPError
|
||||
| RelatedOrderNotToOne Text Text
|
||||
| SpreadNotToOne Text Text
|
||||
| UnacceptableFilter Text
|
||||
| UnacceptableSchema [Text]
|
||||
| UnsupportedMethod ByteString
|
||||
| ColumnNotFound Text Text
|
||||
deriving Show
|
||||
|
||||
data QPError = QPError Text Text
|
||||
|
||||
type CallRequest = CallQuery
|
||||
deriving Show
|
||||
data RangeError
|
||||
= NegativeLimit
|
||||
| LowerGTUpper
|
||||
| OutOfBounds Text Text
|
||||
deriving Show
|
||||
|
||||
type NodeName = Text
|
||||
type Depth = Integer
|
||||
|
||||
data JoinCondition =
|
||||
JoinCondition
|
||||
(QualifiedIdentifier, FieldName)
|
||||
(QualifiedIdentifier, FieldName)
|
||||
deriving (Eq)
|
||||
|
||||
data OrderTerm = OrderTerm
|
||||
{ otTerm :: Field
|
||||
, otDirection :: Maybe OrderDirection
|
||||
, otNullOrder :: Maybe OrderNulls
|
||||
}
|
||||
deriving (Eq)
|
||||
data OrderTerm
|
||||
= OrderTerm
|
||||
{ otTerm :: Field
|
||||
, otDirection :: Maybe OrderDirection
|
||||
, otNullOrder :: Maybe OrderNulls
|
||||
}
|
||||
| OrderRelationTerm
|
||||
{ otRelation :: FieldName
|
||||
, otRelTerm :: Field
|
||||
, otDirection :: Maybe OrderDirection
|
||||
, otNullOrder :: Maybe OrderNulls
|
||||
}
|
||||
deriving (Eq, Show)
|
||||
|
||||
data OrderDirection
|
||||
= OrderAsc
|
||||
| OrderDesc
|
||||
deriving (Eq)
|
||||
deriving (Eq, Show)
|
||||
|
||||
data OrderNulls
|
||||
= OrderNullsFirst
|
||||
| OrderNullsLast
|
||||
deriving (Eq)
|
||||
|
||||
data CallQuery = FunctionCall
|
||||
{ funCQi :: QualifiedIdentifier
|
||||
, funCParams :: CallParams
|
||||
, funCArgs :: Maybe LBS.ByteString
|
||||
, funCScalar :: Bool
|
||||
, funCMultipleCall :: Bool
|
||||
, funCReturning :: [FieldName]
|
||||
}
|
||||
|
||||
data CallParams
|
||||
= KeyParams [ProcParam] -- ^ Call with key params: func(a := val1, b:= val2)
|
||||
| OnePosParam ProcParam -- ^ Call with positional params(only one supported): func(val)
|
||||
deriving (Eq, Show)
|
||||
|
||||
type Field = (FieldName, JsonPath)
|
||||
type Cast = Text
|
||||
@@ -123,7 +138,7 @@ data EmbedParam
|
||||
data JoinType
|
||||
= JTInner
|
||||
| JTLeft
|
||||
deriving Eq
|
||||
deriving (Eq, Show)
|
||||
|
||||
-- | Path of the embedded levels, e.g "clients.projects.name=eq.." gives Path
|
||||
-- ["clients", "projects"]
|
||||
@@ -137,7 +152,7 @@ type JsonPath = [JsonOperation]
|
||||
data JsonOperation
|
||||
= JArrow { jOp :: JsonOperand }
|
||||
| J2Arrow { jOp :: JsonOperand }
|
||||
deriving (Eq)
|
||||
deriving (Eq, Show, Ord)
|
||||
|
||||
-- | Represents the key(`->'key'`) or index(`->'1`::int`), the index is Text
|
||||
-- because we reuse our escaping functons and let pg do the casting with
|
||||
@@ -145,7 +160,7 @@ data JsonOperation
|
||||
data JsonOperand
|
||||
= JKey { jVal :: Text }
|
||||
| JIdx { jVal :: Text }
|
||||
deriving (Eq)
|
||||
deriving (Eq, Show, Ord)
|
||||
|
||||
-- | Boolean logic expression tree e.g. "and(name.eq.N,or(id.eq.1,id.eq.2))" is:
|
||||
--
|
||||
@@ -157,29 +172,36 @@ data JsonOperand
|
||||
data LogicTree
|
||||
= Expr Bool LogicOperator [LogicTree]
|
||||
| Stmnt Filter
|
||||
deriving (Eq)
|
||||
deriving (Eq, Show)
|
||||
|
||||
data LogicOperator
|
||||
= And
|
||||
| Or
|
||||
deriving Eq
|
||||
deriving (Eq, Show)
|
||||
|
||||
data Filter = Filter
|
||||
data Filter
|
||||
= Filter
|
||||
{ field :: Field
|
||||
, opExpr :: OpExpr
|
||||
}
|
||||
deriving (Eq)
|
||||
deriving (Eq, Show)
|
||||
|
||||
data OpExpr =
|
||||
OpExpr Bool Operation
|
||||
deriving (Eq)
|
||||
data OpExpr
|
||||
= OpExpr Bool Operation
|
||||
| NoOpExpr Text
|
||||
deriving (Eq, Show)
|
||||
|
||||
data OpQuantifier = QuantAny | QuantAll
|
||||
deriving (Eq, Show)
|
||||
|
||||
data Operation
|
||||
= Op SimpleOperator SingleVal
|
||||
| OpQuant QuantOperator (Maybe OpQuantifier) SingleVal
|
||||
| In ListVal
|
||||
| Is TrileanVal
|
||||
| IsDistinctFrom SingleVal
|
||||
| Fts FtsOperator (Maybe Language) SingleVal
|
||||
deriving (Eq)
|
||||
deriving (Eq, Show)
|
||||
|
||||
type Language = Text
|
||||
|
||||
@@ -195,17 +217,23 @@ data TrileanVal
|
||||
| TriFalse
|
||||
| TriNull
|
||||
| TriUnknown
|
||||
deriving Eq
|
||||
deriving (Eq, Show)
|
||||
|
||||
data SimpleOperator
|
||||
-- Operators that are quantifiable, i.e. they can be used with the any/all modifiers
|
||||
data QuantOperator
|
||||
= OpEqual
|
||||
| OpGreaterThanEqual
|
||||
| OpGreaterThan
|
||||
| OpLessThanEqual
|
||||
| OpLessThan
|
||||
| OpNotEqual
|
||||
| OpLike
|
||||
| OpILike
|
||||
| OpMatch
|
||||
| OpIMatch
|
||||
deriving (Eq, Show)
|
||||
|
||||
data SimpleOperator
|
||||
= OpNotEqual
|
||||
| OpContains
|
||||
| OpContained
|
||||
| OpOverlap
|
||||
@@ -214,14 +242,13 @@ data SimpleOperator
|
||||
| OpNotExtendsRight
|
||||
| OpNotExtendsLeft
|
||||
| OpAdjacent
|
||||
| OpMatch
|
||||
| OpIMatch
|
||||
deriving Eq
|
||||
deriving (Eq, Show)
|
||||
|
||||
--
|
||||
-- | Operators for full text search operators
|
||||
data FtsOperator
|
||||
= FilterFts
|
||||
| FilterFtsPlain
|
||||
| FilterFtsPhrase
|
||||
| FilterFtsWebsearch
|
||||
deriving Eq
|
||||
deriving (Eq, Show)
|
||||
+111
-546
@@ -17,112 +17,64 @@ module PostgREST.App
|
||||
, run
|
||||
) where
|
||||
|
||||
|
||||
import Control.Monad.Except (liftEither)
|
||||
import Data.Either.Combinators (mapLeft)
|
||||
import Data.List (union)
|
||||
import Data.Maybe (fromJust)
|
||||
import Data.String (IsString (..))
|
||||
import Network.Wai.Handler.Warp (defaultSettings, setHost, setPort,
|
||||
setServerName)
|
||||
import System.Posix.Types (FileMode)
|
||||
|
||||
import qualified Data.ByteString.Char8 as BS
|
||||
import qualified Data.ByteString.Lazy as LBS
|
||||
import qualified Data.HashMap.Strict as HM
|
||||
import qualified Data.Set as S
|
||||
import qualified Hasql.DynamicStatements.Snippet as SQL (Snippet)
|
||||
import qualified Hasql.Transaction as SQL
|
||||
import qualified Hasql.Transaction.Sessions as SQL
|
||||
import qualified Network.HTTP.Types.Header as HTTP
|
||||
import qualified Network.HTTP.Types.Status as HTTP
|
||||
import qualified Network.HTTP.Types.URI as HTTP
|
||||
import qualified Network.Wai as Wai
|
||||
import qualified Network.Wai.Handler.Warp as Warp
|
||||
import qualified Data.HashMap.Strict as HM
|
||||
import qualified Data.Text.Encoding as T
|
||||
import qualified Hasql.Transaction.Sessions as SQL
|
||||
import qualified Network.Wai as Wai
|
||||
import qualified Network.Wai.Handler.Warp as Warp
|
||||
|
||||
import qualified PostgREST.Admin as Admin
|
||||
import qualified PostgREST.AppState as AppState
|
||||
import qualified PostgREST.Auth as Auth
|
||||
import qualified PostgREST.Cors as Cors
|
||||
import qualified PostgREST.DbStructure as DbStructure
|
||||
import qualified PostgREST.Error as Error
|
||||
import qualified PostgREST.Logger as Logger
|
||||
import qualified PostgREST.Middleware as Middleware
|
||||
import qualified PostgREST.OpenAPI as OpenAPI
|
||||
import qualified PostgREST.Query.QueryBuilder as QueryBuilder
|
||||
import qualified PostgREST.Query.Statements as Statements
|
||||
import qualified PostgREST.RangeQuery as RangeQuery
|
||||
import qualified PostgREST.Request.ApiRequest as ApiRequest
|
||||
import qualified PostgREST.Request.DbRequestBuilder as ReqBuilder
|
||||
import qualified PostgREST.Request.Types as ApiRequestTypes
|
||||
import qualified PostgREST.Admin as Admin
|
||||
import qualified PostgREST.ApiRequest as ApiRequest
|
||||
import qualified PostgREST.ApiRequest.Types as ApiRequestTypes
|
||||
import qualified PostgREST.AppState as AppState
|
||||
import qualified PostgREST.Auth as Auth
|
||||
import qualified PostgREST.Cors as Cors
|
||||
import qualified PostgREST.Error as Error
|
||||
import qualified PostgREST.Logger as Logger
|
||||
import qualified PostgREST.Plan as Plan
|
||||
import qualified PostgREST.Query as Query
|
||||
import qualified PostgREST.Response as Response
|
||||
|
||||
import PostgREST.AppState (AppState)
|
||||
import PostgREST.Auth (AuthResult (..))
|
||||
import PostgREST.Config (AppConfig (..),
|
||||
LogLevel (..),
|
||||
OpenAPIMode (..))
|
||||
import PostgREST.Config.PgVersion (PgVersion (..))
|
||||
import PostgREST.DbStructure (DbStructure (..))
|
||||
import PostgREST.DbStructure.Identifiers (FieldName,
|
||||
QualifiedIdentifier (..),
|
||||
Schema)
|
||||
import PostgREST.DbStructure.Proc (ProcDescription (..),
|
||||
ProcVolatility (..))
|
||||
import PostgREST.DbStructure.Table (Table (..))
|
||||
import PostgREST.Error (Error)
|
||||
import PostgREST.GucHeader (GucHeader,
|
||||
addHeadersIfNotIncluded,
|
||||
unwrapGucHeader)
|
||||
import PostgREST.MediaType (MTPlanAttrs (..),
|
||||
MediaType (..))
|
||||
import PostgREST.Query.Statements (ResultSet (..))
|
||||
import PostgREST.Request.ApiRequest (Action (..),
|
||||
ApiRequest (..),
|
||||
InvokeMethod (..),
|
||||
Mutation (..), Target (..))
|
||||
import PostgREST.Request.Preferences (PreferCount (..),
|
||||
PreferParameters (..),
|
||||
PreferRepresentation (..),
|
||||
toAppliedHeader)
|
||||
import PostgREST.Request.QueryParams (QueryParams (..))
|
||||
import PostgREST.Request.ReadQuery (ReadRequest, fstFieldNames)
|
||||
import PostgREST.Version (prettyVersion)
|
||||
import PostgREST.Workers (connectionWorker, listener)
|
||||
|
||||
import qualified PostgREST.DbStructure.Proc as Proc
|
||||
import qualified PostgREST.MediaType as MediaType
|
||||
import PostgREST.ApiRequest (Action (..), ApiRequest (..),
|
||||
Mutation (..), Target (..))
|
||||
import PostgREST.AppState (AppState)
|
||||
import PostgREST.Auth (AuthResult (..))
|
||||
import PostgREST.Config (AppConfig (..))
|
||||
import PostgREST.Config.PgVersion (PgVersion (..))
|
||||
import PostgREST.Error (Error)
|
||||
import PostgREST.Query (DbHandler)
|
||||
import PostgREST.SchemaCache (SchemaCache (..))
|
||||
import PostgREST.SchemaCache.Routine (Routine (..))
|
||||
import PostgREST.Version (docsVersion, prettyVersion)
|
||||
|
||||
import Protolude hiding (Handler)
|
||||
|
||||
data RequestContext = RequestContext
|
||||
{ ctxConfig :: AppConfig
|
||||
, ctxDbStructure :: DbStructure
|
||||
, ctxApiRequest :: ApiRequest
|
||||
, ctxPgVersion :: PgVersion
|
||||
}
|
||||
|
||||
type Handler = ExceptT Error
|
||||
|
||||
type DbHandler = Handler SQL.Transaction
|
||||
|
||||
type SignalHandlerInstaller = AppState -> IO()
|
||||
|
||||
type SocketRunner = Warp.Settings -> Wai.Application -> FileMode -> FilePath -> IO()
|
||||
|
||||
|
||||
run :: SignalHandlerInstaller -> Maybe SocketRunner -> AppState -> IO ()
|
||||
run installHandlers maybeRunWithSocket appState = do
|
||||
conf@AppConfig{..} <- AppState.getConfig appState
|
||||
connectionWorker appState -- Loads the initial DbStructure
|
||||
AppState.connectionWorker appState -- Loads the initial SchemaCache
|
||||
installHandlers appState
|
||||
-- reload schema cache + config on NOTIFY
|
||||
when configDbChannelEnabled $ listener appState
|
||||
AppState.runListener conf appState
|
||||
|
||||
let app = postgrest configLogLevel appState (connectionWorker appState)
|
||||
adminApp = Admin.postgrestAdmin appState conf
|
||||
Admin.runAdmin conf appState $ serverSettings conf
|
||||
|
||||
whenJust configAdminServerPort $ \adminPort -> do
|
||||
AppState.logWithZTime appState $ "Admin server listening on port " <> show adminPort
|
||||
void . forkIO $ Warp.runSettings (serverSettings conf & setPort adminPort) adminApp
|
||||
let app = postgrest conf appState (AppState.connectionWorker appState)
|
||||
|
||||
case configServerUnixSocket of
|
||||
Just socket ->
|
||||
@@ -137,9 +89,6 @@ run installHandlers maybeRunWithSocket appState = do
|
||||
do
|
||||
AppState.logWithZTime appState $ "Listening on port " <> show configServerPort
|
||||
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{..} =
|
||||
@@ -149,78 +98,65 @@ serverSettings AppConfig{..} =
|
||||
& setServerName ("postgrest/" <> prettyVersion)
|
||||
|
||||
-- | PostgREST application
|
||||
postgrest :: LogLevel -> AppState.AppState -> IO () -> Wai.Application
|
||||
postgrest logLevel appState connWorker =
|
||||
postgrest :: AppConfig -> AppState.AppState -> IO () -> Wai.Application
|
||||
postgrest conf appState connWorker =
|
||||
Response.traceHeaderMiddleware conf .
|
||||
Cors.middleware .
|
||||
Auth.middleware appState .
|
||||
Logger.middleware logLevel $
|
||||
Logger.middleware (configLogLevel conf) $
|
||||
-- fromJust can be used, because the auth middleware will **always** add
|
||||
-- some AuthResult to the vault.
|
||||
\req respond -> case fromJust $ Auth.getResult req of
|
||||
Left err -> respond $ Error.errorResponseFor err
|
||||
Right authResult -> do
|
||||
conf <- AppState.getConfig appState
|
||||
maybeDbStructure <- AppState.getDbStructure appState
|
||||
appConf <- AppState.getConfig appState -- the config must be read again because it can reload
|
||||
maybeSchemaCache <- AppState.getSchemaCache appState
|
||||
pgVer <- AppState.getPgVersion appState
|
||||
jsonDbS <- AppState.getJsonDbS appState
|
||||
|
||||
let
|
||||
eitherResponse :: IO (Either Error Wai.Response)
|
||||
eitherResponse =
|
||||
runExceptT $ postgrestResponse appState conf maybeDbStructure jsonDbS pgVer authResult req
|
||||
runExceptT $ postgrestResponse appState appConf maybeSchemaCache pgVer authResult req
|
||||
|
||||
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
|
||||
when (Response.isServiceUnavailable response) connWorker
|
||||
resp <- do
|
||||
delay <- AppState.getRetryNextIn appState
|
||||
return $ Response.addRetryHint delay response
|
||||
respond resp
|
||||
|
||||
addRetryHint :: Bool -> AppState -> Wai.Response -> IO Wai.Response
|
||||
addRetryHint shouldAdd appState response = do
|
||||
delay <- AppState.getRetryNextIn appState
|
||||
let h = ("Retry-After", BS.pack $ show delay)
|
||||
return $ Wai.mapResponseHeaders (\hs -> if shouldAdd then h:hs else hs) response
|
||||
|
||||
postgrestResponse
|
||||
:: AppState.AppState
|
||||
-> AppConfig
|
||||
-> Maybe DbStructure
|
||||
-> ByteString
|
||||
-> Maybe SchemaCache
|
||||
-> PgVersion
|
||||
-> AuthResult
|
||||
-> Wai.Request
|
||||
-> Handler IO Wai.Response
|
||||
postgrestResponse appState conf@AppConfig{..} maybeDbStructure jsonDbS pgVer AuthResult{..} req = do
|
||||
body <- lift $ Wai.strictRequestBody req
|
||||
|
||||
dbStructure <-
|
||||
case maybeDbStructure of
|
||||
Just dbStructure ->
|
||||
return dbStructure
|
||||
postgrestResponse appState conf@AppConfig{..} maybeSchemaCache pgVer authResult@AuthResult{..} req = do
|
||||
sCache <-
|
||||
case maybeSchemaCache of
|
||||
Just sCache ->
|
||||
return sCache
|
||||
Nothing ->
|
||||
throwError Error.NoSchemaCacheError
|
||||
|
||||
body <- lift $ Wai.strictRequestBody req
|
||||
|
||||
apiRequest <-
|
||||
liftEither . mapLeft Error.ApiRequestError $
|
||||
ApiRequest.userApiRequest conf dbStructure req body
|
||||
ApiRequest.userApiRequest conf req body
|
||||
|
||||
let ctx apiReq = RequestContext conf dbStructure apiReq pgVer
|
||||
handleRequest authResult conf appState (Just authRole /= configDbAnonRole) configDbPreparedStatements pgVer apiRequest sCache
|
||||
|
||||
if iAction apiRequest == ActionInfo then
|
||||
handleInfo (iTarget apiRequest) (ctx apiRequest)
|
||||
else
|
||||
runDbHandler appState (txMode apiRequest) (Just authRole /= configDbAnonRole) configDbPreparedStatements .
|
||||
Middleware.optionalRollback conf apiRequest $
|
||||
Middleware.runPgLocals conf authClaims authRole (handleRequest . ctx) apiRequest jsonDbS pgVer
|
||||
|
||||
runDbHandler :: AppState.AppState -> SQL.Mode -> Bool -> Bool -> DbHandler b -> Handler IO b
|
||||
runDbHandler appState mode authenticated prepared handler = do
|
||||
dbResp <-
|
||||
let transaction = if prepared then SQL.transaction else SQL.unpreparedTransaction in
|
||||
lift . AppState.usePool appState . transaction SQL.ReadCommitted mode $ runExceptT handler
|
||||
runDbHandler :: AppState.AppState -> SQL.IsolationLevel -> SQL.Mode -> Bool -> Bool -> DbHandler b -> Handler IO b
|
||||
runDbHandler appState isoLvl mode authenticated prepared handler = do
|
||||
dbResp <- lift $ do
|
||||
let transaction = if prepared then SQL.transaction else SQL.unpreparedTransaction
|
||||
AppState.usePool appState . transaction isoLvl mode $ runExceptT handler
|
||||
|
||||
resp <-
|
||||
liftEither . mapLeft Error.PgErr $
|
||||
@@ -228,433 +164,62 @@ runDbHandler appState mode authenticated prepared handler = do
|
||||
|
||||
liftEither resp
|
||||
|
||||
handleRequest :: RequestContext -> DbHandler Wai.Response
|
||||
handleRequest context@(RequestContext _ _ ApiRequest{..} _) =
|
||||
handleRequest :: AuthResult -> AppConfig -> AppState.AppState -> Bool -> Bool -> PgVersion -> ApiRequest -> SchemaCache -> Handler IO Wai.Response
|
||||
handleRequest AuthResult{..} conf appState authenticated prepared pgVer apiReq@ApiRequest{..} sCache =
|
||||
case (iAction, iTarget) of
|
||||
(ActionRead headersOnly, TargetIdent identifier) ->
|
||||
handleRead headersOnly identifier context
|
||||
(ActionMutate MutationCreate, TargetIdent identifier) ->
|
||||
handleCreate identifier context
|
||||
(ActionMutate MutationUpdate, TargetIdent identifier) ->
|
||||
handleUpdate identifier context
|
||||
(ActionMutate MutationSingleUpsert, TargetIdent identifier) ->
|
||||
handleSingleUpsert identifier context
|
||||
(ActionMutate MutationDelete, TargetIdent identifier) ->
|
||||
handleDelete identifier context
|
||||
(ActionInvoke invMethod, TargetProc proc _) ->
|
||||
handleInvoke invMethod proc context
|
||||
(ActionInspect headersOnly, TargetDefaultSpec tSchema) ->
|
||||
handleOpenApi headersOnly tSchema context
|
||||
(ActionRead headersOnly, TargetIdent identifier) -> do
|
||||
wrPlan <- liftEither $ Plan.wrappedReadPlan identifier conf sCache apiReq
|
||||
resultSet <- runQuery roleIsoLvl (Plan.wrTxMode wrPlan) $ Query.readQuery wrPlan conf apiReq
|
||||
return $ Response.readResponse headersOnly identifier apiReq resultSet
|
||||
|
||||
(ActionMutate MutationCreate, TargetIdent identifier) -> do
|
||||
mrPlan <- liftEither $ Plan.mutateReadPlan MutationCreate apiReq identifier conf sCache
|
||||
resultSet <- runQuery roleIsoLvl (Plan.mrTxMode mrPlan) $ Query.createQuery mrPlan apiReq conf
|
||||
return $ Response.createResponse identifier mrPlan apiReq resultSet
|
||||
|
||||
(ActionMutate MutationUpdate, TargetIdent identifier) -> do
|
||||
mrPlan <- liftEither $ Plan.mutateReadPlan MutationUpdate apiReq identifier conf sCache
|
||||
resultSet <- runQuery roleIsoLvl (Plan.mrTxMode mrPlan) $ Query.updateQuery mrPlan apiReq conf
|
||||
return $ Response.updateResponse apiReq resultSet
|
||||
|
||||
(ActionMutate MutationSingleUpsert, TargetIdent identifier) -> do
|
||||
mrPlan <- liftEither $ Plan.mutateReadPlan MutationSingleUpsert apiReq identifier conf sCache
|
||||
resultSet <- runQuery roleIsoLvl (Plan.mrTxMode mrPlan) $ Query.singleUpsertQuery mrPlan apiReq conf
|
||||
return $ Response.singleUpsertResponse apiReq resultSet
|
||||
|
||||
(ActionMutate MutationDelete, TargetIdent identifier) -> do
|
||||
mrPlan <- liftEither $ Plan.mutateReadPlan MutationDelete apiReq identifier conf sCache
|
||||
resultSet <- runQuery roleIsoLvl (Plan.mrTxMode mrPlan) $ Query.deleteQuery mrPlan apiReq conf
|
||||
return $ Response.deleteResponse apiReq resultSet
|
||||
|
||||
(ActionInvoke invMethod, TargetProc identifier _) -> do
|
||||
cPlan <- liftEither $ Plan.callReadPlan identifier conf sCache apiReq invMethod
|
||||
resultSet <- runQuery (fromMaybe roleIsoLvl $ pdIsoLvl (Plan.crProc cPlan))(Plan.crTxMode cPlan) $ Query.invokeQuery (Plan.crProc cPlan) cPlan apiReq conf pgVer
|
||||
return $ Response.invokeResponse invMethod (Plan.crProc cPlan) apiReq resultSet
|
||||
|
||||
(ActionInspect headersOnly, TargetDefaultSpec tSchema) -> do
|
||||
oaiResult <- runQuery roleIsoLvl Plan.inspectPlanTxMode $ Query.openApiQuery sCache pgVer conf tSchema
|
||||
return $ Response.openApiResponse (T.decodeUtf8 prettyVersion, docsVersion) headersOnly oaiResult conf sCache iSchema iNegotiatedByProfile
|
||||
|
||||
(ActionInfo, TargetIdent identifier) ->
|
||||
return $ Response.infoIdentResponse identifier sCache
|
||||
|
||||
(ActionInfo, TargetProc identifier _) -> do
|
||||
cPlan <- liftEither $ Plan.callReadPlan identifier conf sCache apiReq ApiRequest.InvHead
|
||||
return $ Response.infoProcResponse (Plan.crProc cPlan)
|
||||
|
||||
(ActionInfo, TargetDefaultSpec _) ->
|
||||
return Response.infoRootResponse
|
||||
|
||||
_ ->
|
||||
-- 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 headersOnly identifier context@RequestContext{..} = do
|
||||
req <- readRequest identifier context
|
||||
bField <- binaryField context req
|
||||
|
||||
let
|
||||
ApiRequest{..} = ctxApiRequest
|
||||
AppConfig{..} = ctxConfig
|
||||
countQuery = QueryBuilder.readRequestToCountQuery req
|
||||
|
||||
resultSet <-
|
||||
lift . SQL.statement mempty $
|
||||
Statements.prepareRead
|
||||
(QueryBuilder.readRequestToQuery req)
|
||||
(if iPreferCount == Just EstimatedCount then
|
||||
-- LIMIT maxRows + 1 so we can determine below that maxRows was surpassed
|
||||
QueryBuilder.limitedQuery countQuery ((+ 1) <$> configDbMaxRows)
|
||||
else
|
||||
countQuery
|
||||
)
|
||||
(shouldCount iPreferCount)
|
||||
iAcceptMediaType
|
||||
bField
|
||||
configDbPreparedStatements
|
||||
|
||||
case resultSet of
|
||||
RSStandard{..} -> do
|
||||
total <- readTotal ctxConfig ctxApiRequest rsTableTotal countQuery
|
||||
response <- liftEither $ gucResponse <$> rsGucStatus <*> rsGucHeaders
|
||||
|
||||
let
|
||||
(status, contentRange) = RangeQuery.rangeStatusHeader iTopLevelRange rsQueryTotal total
|
||||
headers =
|
||||
[ contentRange
|
||||
, ( "Content-Location"
|
||||
, "/"
|
||||
<> toUtf8 (qiName identifier)
|
||||
<> if BS.null (qsCanonical iQueryParams) then mempty else "?" <> qsCanonical iQueryParams
|
||||
)
|
||||
]
|
||||
++ contentTypeHeaders context
|
||||
|
||||
failNotSingular iAcceptMediaType rsQueryTotal . response status headers $
|
||||
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{..} tableTotal countQuery =
|
||||
case iPreferCount of
|
||||
Just PlannedCount ->
|
||||
explain
|
||||
Just EstimatedCount ->
|
||||
if tableTotal > (fromIntegral <$> configDbMaxRows) then
|
||||
max tableTotal <$> explain
|
||||
else
|
||||
return tableTotal
|
||||
_ ->
|
||||
return tableTotal
|
||||
where
|
||||
explain =
|
||||
lift . SQL.statement mempty . Statements.preparePlanRows countQuery $
|
||||
configDbPreparedStatements
|
||||
|
||||
handleCreate :: QualifiedIdentifier -> RequestContext -> DbHandler Wai.Response
|
||||
handleCreate identifier@QualifiedIdentifier{..} context@RequestContext{..} = do
|
||||
let
|
||||
ApiRequest{..} = ctxApiRequest
|
||||
pkCols = if iPreferRepresentation /= None || isJust iPreferResolution
|
||||
then maybe mempty tablePKCols $ HM.lookup identifier $ dbTables ctxDbStructure
|
||||
else mempty
|
||||
|
||||
resultSet <- writeQuery MutationCreate identifier True pkCols context
|
||||
|
||||
case resultSet of
|
||||
RSStandard{..} -> do
|
||||
|
||||
response <- liftEither $ gucResponse <$> rsGucStatus <*> rsGucHeaders
|
||||
|
||||
let
|
||||
headers =
|
||||
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 identifier context@(RequestContext _ _ ApiRequest{..} _) = do
|
||||
resultSet <- writeQuery MutationUpdate identifier False mempty context
|
||||
|
||||
case resultSet of
|
||||
RSStandard{..} -> do
|
||||
response <- liftEither $ gucResponse <$> rsGucStatus <*> rsGucHeaders
|
||||
|
||||
let
|
||||
fullRepr = iPreferRepresentation == Full
|
||||
updateIsNoOp = S.null iColumns
|
||||
status
|
||||
| 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 identifier context@(RequestContext _ ctxDbStructure ApiRequest{..} _) = do
|
||||
let pkCols = maybe mempty tablePKCols $ HM.lookup identifier $ dbTables ctxDbStructure
|
||||
|
||||
resultSet <- writeQuery MutationSingleUpsert identifier False pkCols context
|
||||
|
||||
case resultSet of
|
||||
RSStandard {..} -> do
|
||||
|
||||
response <- liftEither $ gucResponse <$> rsGucStatus <*> rsGucHeaders
|
||||
|
||||
-- Makes sure the querystring pk matches the payload pk
|
||||
-- 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 (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 identifier context@(RequestContext _ _ ApiRequest{..} _) = do
|
||||
resultSet <- writeQuery MutationDelete identifier False mempty context
|
||||
|
||||
case resultSet of
|
||||
RSStandard {..} -> do
|
||||
|
||||
response <- liftEither $ gucResponse <$> rsGucStatus <*> rsGucHeaders
|
||||
|
||||
let
|
||||
contentRangeHeader =
|
||||
RangeQuery.contentRangeH 1 0 $
|
||||
if shouldCount iPreferCount then Just rsQueryTotal else Nothing
|
||||
|
||||
failChangesOffLimits (RangeQuery.rangeLimit iTopLevelRange) rsQueryTotal =<<
|
||||
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
|
||||
infoResponse allowHeader = return $ Wai.responseLBS HTTP.status200 [allOrigins, (HTTP.hAllow, allowHeader)] mempty
|
||||
allOrigins = ("Access-Control-Allow-Origin", "*")
|
||||
allowH table =
|
||||
let hasPK = not . null $ tablePKCols table in
|
||||
BS.intercalate "," $
|
||||
["OPTIONS,GET,HEAD"] ++
|
||||
["POST" | tableInsertable table] ++
|
||||
["PUT" | tableInsertable table && tableUpdatable table && hasPK] ++
|
||||
["PATCH" | tableUpdatable table] ++
|
||||
["DELETE" | tableDeletable table]
|
||||
|
||||
handleInvoke :: InvokeMethod -> ProcDescription -> RequestContext -> DbHandler Wai.Response
|
||||
handleInvoke invMethod proc context@RequestContext{..} = do
|
||||
let
|
||||
ApiRequest{..} = ctxApiRequest
|
||||
|
||||
identifier =
|
||||
QualifiedIdentifier
|
||||
(pdSchema proc)
|
||||
(fromMaybe (pdName proc) $ Proc.procTableName proc)
|
||||
|
||||
req <- readRequest identifier context
|
||||
bField <- binaryField context req
|
||||
|
||||
let callReq = ReqBuilder.callRequest proc ctxApiRequest req
|
||||
|
||||
resultSet <-
|
||||
lift . SQL.statement mempty $
|
||||
Statements.prepareCall
|
||||
(Proc.procReturnsScalar proc)
|
||||
(Proc.procReturnsSingle proc)
|
||||
(QueryBuilder.requestToCallProcQuery callReq)
|
||||
(QueryBuilder.readRequestToQuery req)
|
||||
(QueryBuilder.readRequestToCountQuery req)
|
||||
(shouldCount iPreferCount)
|
||||
iAcceptMediaType
|
||||
(iPreferParameters == Just MultipleObjects)
|
||||
bField
|
||||
(configDbPreparedStatements ctxConfig)
|
||||
|
||||
case resultSet of
|
||||
RSStandard {..} -> do
|
||||
response <- liftEither $ gucResponse <$> rsGucStatus <*> rsGucHeaders
|
||||
let
|
||||
(status, contentRange) =
|
||||
RangeQuery.rangeStatusHeader iTopLevelRange rsQueryTotal rsTableTotal
|
||||
|
||||
failNotSingular iAcceptMediaType rsQueryTotal $
|
||||
if Proc.procReturnsVoid proc then
|
||||
response HTTP.status204 [contentRange] mempty
|
||||
else
|
||||
response status
|
||||
(contentTypeHeaders context ++ [contentRange])
|
||||
(if invMethod == InvHead then mempty else LBS.fromStrict rsBody)
|
||||
|
||||
RSPlan plan ->
|
||||
pure $ Wai.responseLBS HTTP.status200 (contentTypeHeaders context) $ LBS.fromStrict plan
|
||||
|
||||
handleOpenApi :: Bool -> Schema -> RequestContext -> DbHandler Wai.Response
|
||||
handleOpenApi headersOnly tSchema (RequestContext conf@AppConfig{..} dbStructure apiRequest ctxPgVersion) = do
|
||||
body <-
|
||||
lift $ case configOpenApiMode of
|
||||
OAFollowPriv ->
|
||||
OpenAPI.encode conf dbStructure
|
||||
<$> SQL.statement [tSchema] (DbStructure.accessibleTables ctxPgVersion configDbPreparedStatements)
|
||||
<*> SQL.statement tSchema (DbStructure.accessibleProcs ctxPgVersion configDbPreparedStatements)
|
||||
<*> SQL.statement tSchema (DbStructure.schemaDescription configDbPreparedStatements)
|
||||
OAIgnorePriv ->
|
||||
OpenAPI.encode conf dbStructure
|
||||
(HM.filterWithKey (\(QualifiedIdentifier sch _) _ -> sch == tSchema) $ DbStructure.dbTables dbStructure)
|
||||
(HM.filterWithKey (\(QualifiedIdentifier sch _) _ -> sch == tSchema) $ DbStructure.dbProcs dbStructure)
|
||||
<$> SQL.statement tSchema (DbStructure.schemaDescription configDbPreparedStatements)
|
||||
OADisabled ->
|
||||
pure mempty
|
||||
|
||||
return $
|
||||
Wai.responseLBS HTTP.status200
|
||||
(MediaType.toContentType MTOpenAPI : maybeToList (profileHeader apiRequest))
|
||||
(if headersOnly then mempty else body)
|
||||
|
||||
txMode :: ApiRequest -> SQL.Mode
|
||||
txMode ApiRequest{..} =
|
||||
case (iAction, iTarget) of
|
||||
(ActionRead _, _) ->
|
||||
SQL.Read
|
||||
(ActionInfo, _) ->
|
||||
SQL.Read
|
||||
(ActionInspect _, _) ->
|
||||
SQL.Read
|
||||
(ActionInvoke InvGet, _) ->
|
||||
SQL.Read
|
||||
(ActionInvoke InvHead, _) ->
|
||||
SQL.Read
|
||||
(ActionInvoke InvPost, TargetProc ProcDescription{pdVolatility=Stable} _) ->
|
||||
SQL.Read
|
||||
(ActionInvoke InvPost, TargetProc ProcDescription{pdVolatility=Immutable} _) ->
|
||||
SQL.Read
|
||||
_ ->
|
||||
SQL.Write
|
||||
|
||||
writeQuery :: Mutation -> QualifiedIdentifier -> Bool -> [Text] -> RequestContext -> DbHandler ResultSet
|
||||
writeQuery mutation identifier@QualifiedIdentifier{..} isInsert pkCols context@RequestContext{..} = do
|
||||
readReq <- readRequest identifier context
|
||||
|
||||
mutateReq <-
|
||||
liftEither $
|
||||
ReqBuilder.mutateRequest mutation qiSchema qiName ctxApiRequest
|
||||
pkCols
|
||||
readReq
|
||||
|
||||
lift . SQL.statement mempty $
|
||||
Statements.prepareWrite
|
||||
(QueryBuilder.readRequestToQuery readReq)
|
||||
(QueryBuilder.mutateRequestToQuery mutateReq)
|
||||
isInsert
|
||||
(iAcceptMediaType ctxApiRequest)
|
||||
(iPreferRepresentation ctxApiRequest)
|
||||
pkCols
|
||||
(configDbPreparedStatements ctxConfig)
|
||||
|
||||
-- | Response with headers and status overridden from GUCs.
|
||||
gucResponse
|
||||
:: Maybe HTTP.Status
|
||||
-> [GucHeader]
|
||||
-> HTTP.Status
|
||||
-> [HTTP.Header]
|
||||
-> LBS.ByteString
|
||||
-> Wai.Response
|
||||
gucResponse gucStatus gucHeaders status headers =
|
||||
Wai.responseLBS (fromMaybe status gucStatus) $
|
||||
addHeadersIfNotIncluded headers (map unwrapGucHeader gucHeaders)
|
||||
|
||||
-- |
|
||||
-- Fail a response if a single JSON object was requested and not exactly one
|
||||
-- was found.
|
||||
failNotSingular :: MediaType -> Int64 -> Wai.Response -> DbHandler Wai.Response
|
||||
failNotSingular mediaType queryTotal response =
|
||||
if mediaType == MTSingularJSON && queryTotal /= 1 then
|
||||
do
|
||||
lift SQL.condemn
|
||||
throwError $ Error.singularityError queryTotal
|
||||
else
|
||||
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 preferCount =
|
||||
preferCount == Just ExactCount || preferCount == Just EstimatedCount
|
||||
|
||||
returnsScalar :: ApiRequest.Target -> Bool
|
||||
returnsScalar (TargetProc proc _) = Proc.procReturnsScalar proc
|
||||
returnsScalar _ = False
|
||||
|
||||
readRequest :: Monad m => QualifiedIdentifier -> RequestContext -> Handler m ReadRequest
|
||||
readRequest QualifiedIdentifier{..} (RequestContext AppConfig{..} dbStructure apiRequest _) =
|
||||
liftEither $
|
||||
ReqBuilder.readRequest qiSchema qiName configDbMaxRows
|
||||
(dbRelationships dbStructure)
|
||||
apiRequest
|
||||
|
||||
contentTypeHeaders :: RequestContext -> [HTTP.Header]
|
||||
contentTypeHeaders RequestContext{..} =
|
||||
MediaType.toContentType (iAcceptMediaType ctxApiRequest) : maybeToList (profileHeader ctxApiRequest)
|
||||
|
||||
-- | If raw(binary) output is requested, check that MediaType is one of the
|
||||
-- admitted rawMediaTypes and that`?select=...` contains only one field other
|
||||
-- than `*`
|
||||
binaryField :: Monad m => RequestContext -> ReadRequest -> Handler m (Maybe FieldName)
|
||||
binaryField RequestContext{..} readReq
|
||||
| returnsScalar (iTarget ctxApiRequest) && isRawMediaType =
|
||||
return $ Just "pgrst_scalar"
|
||||
| isRawMediaType =
|
||||
let
|
||||
fldNames = fstFieldNames readReq
|
||||
fieldName = headMay fldNames
|
||||
in
|
||||
if length fldNames == 1 && fieldName /= Just "*" then
|
||||
return fieldName
|
||||
else
|
||||
throwError $ Error.BinaryFieldError mediaType
|
||||
| otherwise =
|
||||
return Nothing
|
||||
where
|
||||
mediaType = iAcceptMediaType ctxApiRequest
|
||||
isRawMediaType = mediaType `elem` configRawMediaTypes ctxConfig `union` [MTOctetStream, MTTextPlain, MTTextXML] || isRawPlan mediaType
|
||||
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{..} =
|
||||
(,) "Content-Profile" <$> (toUtf8 <$> iProfile)
|
||||
roleSettings = fromMaybe mempty (HM.lookup authRole $ configRoleSettings conf)
|
||||
roleIsoLvl = HM.findWithDefault SQL.ReadCommitted authRole $ configRoleIsoLvl conf
|
||||
runQuery isoLvl mode query =
|
||||
runDbHandler appState isoLvl mode authenticated prepared $ do
|
||||
Query.setPgLocals conf authClaims authRole (HM.toList roleSettings) apiReq pgVer
|
||||
Query.runPreReq conf
|
||||
query
|
||||
|
||||
+365
-53
@@ -1,87 +1,105 @@
|
||||
{-# LANGUAGE LambdaCase #-}
|
||||
{-# LANGUAGE NamedFieldPuns #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
|
||||
module PostgREST.AppState
|
||||
( AppState
|
||||
, destroy
|
||||
, getConfig
|
||||
, getDbStructure
|
||||
, getSchemaCache
|
||||
, getIsListenerOn
|
||||
, getJsonDbS
|
||||
, getMainThreadId
|
||||
, getPgVersion
|
||||
, getRetryNextIn
|
||||
, getTime
|
||||
, getWorkerSem
|
||||
, init
|
||||
, initWithPool
|
||||
, logWithZTime
|
||||
, putConfig
|
||||
, putDbStructure
|
||||
, putIsListenerOn
|
||||
, putJsonDbS
|
||||
, putSchemaCache
|
||||
, putPgVersion
|
||||
, putRetryNextIn
|
||||
, releasePool
|
||||
, signalListener
|
||||
, usePool
|
||||
, waitListener
|
||||
, loadSchemaCache
|
||||
, reReadConfig
|
||||
, connectionWorker
|
||||
, runListener
|
||||
) where
|
||||
|
||||
import qualified Hasql.Pool as SQL
|
||||
import qualified Hasql.Session as SQL
|
||||
import qualified Data.ByteString.Char8 as BS
|
||||
import qualified Data.ByteString.Lazy as LBS
|
||||
import Data.Either.Combinators (whenLeft)
|
||||
import qualified Data.Text.Encoding as T
|
||||
import Hasql.Connection (acquire)
|
||||
import qualified Hasql.Notifications as SQL
|
||||
import qualified Hasql.Pool as SQL
|
||||
import qualified Hasql.Session as SQL
|
||||
import qualified Hasql.Transaction.Sessions as SQL
|
||||
import qualified PostgREST.Error as Error
|
||||
import PostgREST.Version (prettyVersion)
|
||||
|
||||
import Control.AutoUpdate (defaultUpdateSettings, mkAutoUpdate,
|
||||
updateAction)
|
||||
import Control.Debounce
|
||||
import Control.Retry (RetryStatus, capDelay, exponentialBackoff,
|
||||
retrying, rsPreviousDelay)
|
||||
import Data.IORef (IORef, atomicWriteIORef, newIORef,
|
||||
readIORef)
|
||||
import Data.Time (ZonedTime, defaultTimeLocale, formatTime,
|
||||
getZonedTime)
|
||||
import Data.Time.Clock (UTCTime, getCurrentTime)
|
||||
|
||||
import PostgREST.Config (AppConfig (..))
|
||||
import PostgREST.Config.PgVersion (PgVersion (..), minimumPgVersion)
|
||||
import PostgREST.DbStructure (DbStructure)
|
||||
import PostgREST.Config (AppConfig (..),
|
||||
addFallbackAppName,
|
||||
readAppConfig)
|
||||
import PostgREST.Config.Database (queryDbSettings,
|
||||
queryPgVersion,
|
||||
queryRoleSettings)
|
||||
import PostgREST.Config.PgVersion (PgVersion (..),
|
||||
minimumPgVersion)
|
||||
import PostgREST.SchemaCache (SchemaCache,
|
||||
querySchemaCache)
|
||||
import PostgREST.SchemaCache.Identifiers (dumpQi)
|
||||
|
||||
import Protolude
|
||||
|
||||
|
||||
data AppState = AppState
|
||||
{ statePool :: SQL.Pool -- | Connection pool, either a 'Connection' or a 'ConnectionError'
|
||||
, statePgVersion :: IORef PgVersion
|
||||
-- | Database connection pool
|
||||
{ statePool :: SQL.Pool
|
||||
-- | Database server version, will be updated by the connectionWorker
|
||||
, statePgVersion :: IORef PgVersion
|
||||
-- | No schema cache at the start. Will be filled in by the connectionWorker
|
||||
, stateDbStructure :: IORef (Maybe DbStructure)
|
||||
-- | Cached DbStructure in json
|
||||
, stateJsonDbS :: IORef ByteString
|
||||
-- | Binary semaphore to make sure just one connectionWorker can run at a time
|
||||
, stateWorkerSem :: MVar ()
|
||||
, stateSchemaCache :: IORef (Maybe SchemaCache)
|
||||
-- | starts the connection worker with a debounce
|
||||
, debouncedConnectionWorker :: IO ()
|
||||
-- | 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
|
||||
, stateIsListenerOn :: IORef Bool
|
||||
-- | Config that can change at runtime
|
||||
, stateConf :: IORef AppConfig
|
||||
, stateConf :: IORef AppConfig
|
||||
-- | Time used for verifying JWT expiration
|
||||
, stateGetTime :: IO UTCTime
|
||||
, stateGetTime :: IO UTCTime
|
||||
-- | Time with time zone used for worker logs
|
||||
, stateGetZTime :: IO ZonedTime
|
||||
, stateGetZTime :: IO ZonedTime
|
||||
-- | 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
|
||||
, stateRetryNextIn :: IORef Int
|
||||
-- | Logs a pool error with a debounce
|
||||
, debounceLogAcquisitionTimeout :: IO ()
|
||||
}
|
||||
|
||||
init :: AppConfig -> IO AppState
|
||||
init conf = do
|
||||
newPool <- initPool conf
|
||||
initWithPool newPool conf
|
||||
pool <- initPool conf
|
||||
initWithPool pool conf
|
||||
|
||||
initWithPool :: SQL.Pool -> AppConfig -> IO AppState
|
||||
initWithPool newPool conf =
|
||||
AppState newPool
|
||||
initWithPool pool conf = do
|
||||
appState <- AppState pool
|
||||
<$> newIORef minimumPgVersion -- assume we're in a supported version when starting, this will be corrected on a later step
|
||||
<*> newIORef Nothing
|
||||
<*> newIORef mempty
|
||||
<*> newEmptyMVar
|
||||
<*> pure (pure ())
|
||||
<*> newEmptyMVar
|
||||
<*> newIORef False
|
||||
<*> newIORef conf
|
||||
@@ -89,19 +107,56 @@ initWithPool newPool conf =
|
||||
<*> mkAutoUpdate defaultUpdateSettings { updateAction = getZonedTime }
|
||||
<*> myThreadId
|
||||
<*> newIORef 0
|
||||
<*> pure (pure ())
|
||||
|
||||
|
||||
debLogTimeout <-
|
||||
let oneSecond = 1000000 in
|
||||
mkDebounce defaultDebounceSettings
|
||||
{ debounceAction = logPgrstError appState SQL.AcquisitionTimeoutUsageError
|
||||
, debounceFreq = 5*oneSecond
|
||||
, debounceEdge = leadingEdge -- logs at the start and the end
|
||||
}
|
||||
|
||||
debWorker <-
|
||||
let decisecond = 100000 in
|
||||
mkDebounce defaultDebounceSettings
|
||||
{ debounceAction = internalConnectionWorker appState
|
||||
, debounceFreq = decisecond
|
||||
, debounceEdge = leadingEdge -- runs the worker at the start and the end
|
||||
}
|
||||
|
||||
return appState { debounceLogAcquisitionTimeout = debLogTimeout, debouncedConnectionWorker = debWorker }
|
||||
|
||||
destroy :: AppState -> IO ()
|
||||
destroy = releasePool
|
||||
destroy = destroyPool
|
||||
|
||||
initPool :: AppConfig -> IO SQL.Pool
|
||||
initPool AppConfig{..} =
|
||||
SQL.acquire (configDbPoolSize, configDbPoolTimeout, toUtf8 configDbUri)
|
||||
SQL.acquire
|
||||
configDbPoolSize
|
||||
(fromIntegral configDbPoolAcquisitionTimeout)
|
||||
(fromIntegral configDbPoolMaxLifetime)
|
||||
(fromIntegral configDbPoolMaxIdletime)
|
||||
(toUtf8 $ addFallbackAppName prettyVersion configDbUri)
|
||||
|
||||
-- | Run an action with a database connection.
|
||||
usePool :: AppState -> SQL.Session a -> IO (Either SQL.UsageError a)
|
||||
usePool AppState{..} = SQL.use statePool
|
||||
usePool AppState{..} x = do
|
||||
res <- SQL.use statePool x
|
||||
whenLeft res (\case
|
||||
SQL.AcquisitionTimeoutUsageError -> debounceLogAcquisitionTimeout -- this can happen rapidly for many requests, so we debounce
|
||||
_ -> pure ())
|
||||
return res
|
||||
|
||||
releasePool :: AppState -> IO ()
|
||||
releasePool AppState{..} = SQL.release statePool
|
||||
-- | Flush the connection pool so that any future use of the pool will
|
||||
-- use connections freshly established after this call.
|
||||
flushPool :: AppState -> IO ()
|
||||
flushPool AppState{..} = SQL.release statePool
|
||||
|
||||
-- | Destroy the pool on shutdown.
|
||||
destroyPool :: AppState -> IO ()
|
||||
destroyPool AppState{..} = SQL.release statePool
|
||||
|
||||
getPgVersion :: AppState -> IO PgVersion
|
||||
getPgVersion = readIORef . statePgVersion
|
||||
@@ -109,20 +164,14 @@ getPgVersion = readIORef . statePgVersion
|
||||
putPgVersion :: AppState -> PgVersion -> IO ()
|
||||
putPgVersion = atomicWriteIORef . statePgVersion
|
||||
|
||||
getDbStructure :: AppState -> IO (Maybe DbStructure)
|
||||
getDbStructure = readIORef . stateDbStructure
|
||||
getSchemaCache :: AppState -> IO (Maybe SchemaCache)
|
||||
getSchemaCache = readIORef . stateSchemaCache
|
||||
|
||||
putDbStructure :: AppState -> Maybe DbStructure -> IO ()
|
||||
putDbStructure appState = atomicWriteIORef (stateDbStructure appState)
|
||||
putSchemaCache :: AppState -> Maybe SchemaCache -> IO ()
|
||||
putSchemaCache appState = atomicWriteIORef (stateSchemaCache appState)
|
||||
|
||||
getJsonDbS :: AppState -> IO ByteString
|
||||
getJsonDbS = readIORef . stateJsonDbS
|
||||
|
||||
putJsonDbS :: AppState -> ByteString -> IO ()
|
||||
putJsonDbS appState = atomicWriteIORef (stateJsonDbS appState)
|
||||
|
||||
getWorkerSem :: AppState -> MVar ()
|
||||
getWorkerSem = stateWorkerSem
|
||||
connectionWorker :: AppState -> IO ()
|
||||
connectionWorker = debouncedConnectionWorker
|
||||
|
||||
getRetryNextIn :: AppState -> IO Int
|
||||
getRetryNextIn = readIORef . stateRetryNextIn
|
||||
@@ -145,6 +194,9 @@ logWithZTime appState txt = do
|
||||
zTime <- stateGetZTime appState
|
||||
hPutStrLn stderr $ toS (formatTime defaultTimeLocale "%d/%b/%Y:%T %z: " zTime) <> txt
|
||||
|
||||
logPgrstError :: AppState -> SQL.UsageError -> IO ()
|
||||
logPgrstError appState e = logWithZTime appState . T.decodeUtf8 . LBS.toStrict $ Error.errorPayload $ Error.PgError False e
|
||||
|
||||
getMainThreadId :: AppState -> ThreadId
|
||||
getMainThreadId = stateMainThreadId
|
||||
|
||||
@@ -164,3 +216,263 @@ getIsListenerOn = readIORef . stateIsListenerOn
|
||||
|
||||
putIsListenerOn :: AppState -> Bool -> IO ()
|
||||
putIsListenerOn = atomicWriteIORef . stateIsListenerOn
|
||||
|
||||
-- | Schema cache status
|
||||
data SCacheStatus
|
||||
= SCLoaded
|
||||
| SCOnRetry
|
||||
| SCFatalFail
|
||||
|
||||
-- | Load the SchemaCache by using a connection from the pool.
|
||||
loadSchemaCache :: AppState -> IO SCacheStatus
|
||||
loadSchemaCache appState = do
|
||||
conf@AppConfig{..} <- getConfig appState
|
||||
result <-
|
||||
let transaction = if configDbPreparedStatements then SQL.transaction else SQL.unpreparedTransaction in
|
||||
usePool appState . transaction SQL.ReadCommitted SQL.Read $
|
||||
querySchemaCache conf
|
||||
case result of
|
||||
Left e -> do
|
||||
case checkIsFatal e of
|
||||
Just hint -> do
|
||||
logWithZTime appState "A fatal error ocurred when loading the schema cache"
|
||||
logPgrstError appState e
|
||||
logWithZTime appState hint
|
||||
return SCFatalFail
|
||||
Nothing -> do
|
||||
putSchemaCache appState Nothing
|
||||
logWithZTime appState "An error ocurred when loading the schema cache"
|
||||
logPgrstError appState e
|
||||
return SCOnRetry
|
||||
|
||||
Right sCache -> do
|
||||
putSchemaCache appState (Just sCache)
|
||||
logWithZTime appState "Schema cache loaded"
|
||||
return SCLoaded
|
||||
|
||||
-- | Current database connection status data ConnectionStatus
|
||||
data ConnectionStatus
|
||||
= NotConnected
|
||||
| Connected PgVersion
|
||||
| FatalConnectionError Text
|
||||
deriving (Eq)
|
||||
|
||||
-- | The purpose of this worker is to obtain a healthy connection to pg and an
|
||||
-- up-to-date schema cache(SchemaCache). This method is meant to be called
|
||||
-- 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
|
||||
-- calling thread, the work is performed in a separate thread.
|
||||
--
|
||||
-- Background thread that does the following :
|
||||
-- 1. Tries to connect to pg server and will keep trying until success.
|
||||
-- 2. Checks if the pg version is supported and if it's not it kills the main
|
||||
-- program.
|
||||
-- 3. Obtains the sCache. If this fails, it goes back to 1.
|
||||
internalConnectionWorker :: AppState -> IO ()
|
||||
internalConnectionWorker appState = work
|
||||
where
|
||||
work = do
|
||||
AppConfig{..} <- getConfig appState
|
||||
logWithZTime appState $ "Starting PostgREST " <> T.decodeUtf8 prettyVersion <> "..."
|
||||
logWithZTime appState "Attempting to connect to the database..."
|
||||
connected <- establishConnection appState
|
||||
case connected of
|
||||
FatalConnectionError reason ->
|
||||
-- Fatal error when connecting
|
||||
logWithZTime appState reason >> killThread (getMainThreadId appState)
|
||||
NotConnected ->
|
||||
-- Unreachable because establishConnection will keep trying to connect
|
||||
return ()
|
||||
Connected actualPgVersion -> do
|
||||
-- Procede with initialization
|
||||
putPgVersion appState actualPgVersion
|
||||
when configDbChannelEnabled $
|
||||
signalListener appState
|
||||
logWithZTime appState "Connection successful"
|
||||
-- this could be fail because the connection drops, but the loadSchemaCache will pick the error and retry again
|
||||
-- We cannot retry after it fails immediately, because db-pre-config could have user errors. We just log the error and continue.
|
||||
when configDbConfig $ reReadConfig False appState
|
||||
scStatus <- loadSchemaCache appState
|
||||
case scStatus of
|
||||
SCLoaded ->
|
||||
-- do nothing and proceed if the load was successful
|
||||
return ()
|
||||
SCOnRetry ->
|
||||
-- retry reloading the schema cache
|
||||
work
|
||||
SCFatalFail ->
|
||||
-- die if our schema cache query has an error
|
||||
killThread $ getMainThreadId appState
|
||||
|
||||
-- | Repeatedly flush the pool, and check if a connection from the
|
||||
-- pool allows access to the PostgreSQL database.
|
||||
--
|
||||
-- Releasing the pool is key for rapid recovery. Otherwise, the pool
|
||||
-- timeout would have to be reached for new healthy connections to be acquired.
|
||||
-- Which might not happen if the server is busy with requests. No idle
|
||||
-- connection, no pool timeout.
|
||||
--
|
||||
-- The connection tries are capped, but if the connection times out no error is
|
||||
-- thrown, just 'False' is returned.
|
||||
establishConnection :: AppState -> IO ConnectionStatus
|
||||
establishConnection appState =
|
||||
retrying retrySettings shouldRetry $
|
||||
const $ flushPool appState >> getConnectionStatus
|
||||
where
|
||||
retrySettings = capDelay delayMicroseconds $ exponentialBackoff backoffMicroseconds
|
||||
delayMicroseconds = 32000000 -- 32 seconds
|
||||
backoffMicroseconds = 1000000 -- 1 second
|
||||
|
||||
getConnectionStatus :: IO ConnectionStatus
|
||||
getConnectionStatus = do
|
||||
pgVersion <- usePool appState $ queryPgVersion False -- No need to prepare the query here, as the connection might not be established
|
||||
case pgVersion of
|
||||
Left e -> do
|
||||
logPgrstError appState e
|
||||
case checkIsFatal e of
|
||||
Just reason ->
|
||||
return $ FatalConnectionError reason
|
||||
Nothing ->
|
||||
return NotConnected
|
||||
Right version ->
|
||||
if version < minimumPgVersion then
|
||||
return . FatalConnectionError $
|
||||
"Cannot run in this PostgreSQL version, PostgREST needs at least "
|
||||
<> pgvName minimumPgVersion
|
||||
else
|
||||
return . Connected $ version
|
||||
|
||||
shouldRetry :: RetryStatus -> ConnectionStatus -> IO Bool
|
||||
shouldRetry rs isConnSucc = do
|
||||
let
|
||||
delay = fromMaybe 0 (rsPreviousDelay rs) `div` backoffMicroseconds
|
||||
itShould = NotConnected == isConnSucc
|
||||
when itShould . logWithZTime appState $
|
||||
"Attempting to reconnect to the database in "
|
||||
<> (show delay::Text)
|
||||
<> " seconds..."
|
||||
when itShould $ putRetryNextIn appState delay
|
||||
return itShould
|
||||
|
||||
-- | Re-reads the config plus config options from the db
|
||||
reReadConfig :: Bool -> AppState -> IO ()
|
||||
reReadConfig startingUp appState = do
|
||||
AppConfig{..} <- getConfig appState
|
||||
dbSettings <-
|
||||
if configDbConfig then do
|
||||
qDbSettings <- usePool appState $ queryDbSettings (dumpQi <$> configDbPreConfig) configDbPreparedStatements
|
||||
case qDbSettings of
|
||||
Left e -> do
|
||||
logWithZTime appState
|
||||
"An error ocurred when trying to query database settings for the config parameters"
|
||||
case checkIsFatal e of
|
||||
Just hint -> do
|
||||
logPgrstError appState e
|
||||
logWithZTime appState hint
|
||||
killThread (getMainThreadId appState)
|
||||
Nothing -> do
|
||||
logPgrstError appState e
|
||||
pure mempty
|
||||
Right x -> pure x
|
||||
else
|
||||
pure mempty
|
||||
(roleSettings, roleIsolationLvl) <-
|
||||
if configDbConfig then do
|
||||
rSettings <- usePool appState $ queryRoleSettings configDbPreparedStatements
|
||||
case rSettings of
|
||||
Left e -> do
|
||||
logWithZTime appState "An error ocurred when trying to query the role settings"
|
||||
logPgrstError appState e
|
||||
pure (mempty, mempty)
|
||||
Right x -> pure x
|
||||
else
|
||||
pure mempty
|
||||
readAppConfig dbSettings configFilePath (Just configDbUri) roleSettings roleIsolationLvl >>= \case
|
||||
Left err ->
|
||||
if startingUp then
|
||||
panic err -- die on invalid config if the program is starting up
|
||||
else
|
||||
logWithZTime appState $ "Failed reloading config: " <> err
|
||||
Right newConf -> do
|
||||
putConfig appState newConf
|
||||
if startingUp then
|
||||
pass
|
||||
else
|
||||
logWithZTime appState "Config reloaded"
|
||||
|
||||
|
||||
runListener :: AppConfig -> AppState -> IO ()
|
||||
runListener AppConfig{configDbChannelEnabled} appState =
|
||||
when configDbChannelEnabled $ listener appState
|
||||
|
||||
-- | Starts a dedicated pg connection to LISTEN for notifications. When a
|
||||
-- NOTIFY <db-channel> - with an empty payload - is done, it refills the schema
|
||||
-- cache. It uses the connectionWorker in case the LISTEN connection dies.
|
||||
listener :: AppState -> IO ()
|
||||
listener appState = do
|
||||
AppConfig{..} <- getConfig appState
|
||||
let dbChannel = toS configDbChannel
|
||||
|
||||
-- The listener has to wait for a signal from the connectionWorker.
|
||||
-- This is because when the connection to the db is lost, the listener also
|
||||
-- tries to recover the connection, but not with the same pace as the connectionWorker.
|
||||
-- Not waiting makes stderr quickly fill with connection retries messages from the listener.
|
||||
waitListener appState
|
||||
|
||||
-- forkFinally allows to detect if the thread dies
|
||||
void . flip forkFinally (handleFinally dbChannel) $ do
|
||||
dbOrError <- acquire $ toUtf8 (addFallbackAppName prettyVersion configDbUri)
|
||||
case dbOrError of
|
||||
Right db -> do
|
||||
logWithZTime appState $ "Listening for notifications on the " <> dbChannel <> " channel"
|
||||
putIsListenerOn appState True
|
||||
SQL.listen db $ SQL.toPgIdentifier dbChannel
|
||||
SQL.waitForNotifications handleNotification db
|
||||
_ ->
|
||||
die $ "Could not listen for notifications on the " <> dbChannel <> " channel"
|
||||
where
|
||||
handleFinally dbChannel _ = do
|
||||
-- if the thread dies, we try to recover
|
||||
logWithZTime appState $ "Retrying listening for notifications on the " <> dbChannel <> " channel.."
|
||||
putIsListenerOn appState False
|
||||
-- assume the pool connection was also lost, call the connection worker
|
||||
connectionWorker appState
|
||||
-- retry the listener
|
||||
listener appState
|
||||
|
||||
handleNotification _ msg
|
||||
| BS.null msg = cacheReloader
|
||||
| msg == "reload schema" = cacheReloader
|
||||
| msg == "reload config" = reReadConfig False appState
|
||||
| otherwise = pure () -- Do nothing if anything else than an empty message is sent
|
||||
|
||||
cacheReloader =
|
||||
-- reloads the schema cache + restarts pool connections
|
||||
-- it's necessary to restart the pg connections because they cache the pg catalog(see #2620)
|
||||
connectionWorker appState
|
||||
|
||||
checkIsFatal :: SQL.UsageError -> Maybe Text
|
||||
checkIsFatal (SQL.ConnectionUsageError e)
|
||||
| isAuthFailureMessage = Just $ toS failureMessage
|
||||
| otherwise = Nothing
|
||||
where isAuthFailureMessage =
|
||||
("FATAL: password authentication failed" `isInfixOf` failureMessage) ||
|
||||
("no password supplied" `isInfixOf` failureMessage)
|
||||
failureMessage = BS.unpack $ fromMaybe mempty e
|
||||
checkIsFatal(SQL.SessionUsageError (SQL.QueryError _ _ (SQL.ResultError serverError)))
|
||||
= 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.
|
||||
SQL.ServerError "42601" _ _ _ _
|
||||
-> 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).
|
||||
-- This would mean that a connection pooler in transaction mode is being used
|
||||
-- while prepared statements are enabled in the PostgREST configuration,
|
||||
-- both of which are incompatible with each other.
|
||||
SQL.ServerError "42P05" _ _ _ _
|
||||
-> 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).
|
||||
-- This would mean that a connection pooler in statement mode is being used which is not supported in PostgREST.
|
||||
SQL.ServerError "08P01" "transaction blocks not allowed in statement pooling mode" _ _ _
|
||||
-> Just "Hint: Connection poolers in statement mode are not supported."
|
||||
_ -> Nothing
|
||||
checkIsFatal _ = Nothing
|
||||
|
||||
@@ -23,8 +23,8 @@ import qualified Data.Aeson as JSON
|
||||
import qualified Data.Aeson.Key as K
|
||||
import qualified Data.Aeson.KeyMap as KM
|
||||
import qualified Data.Aeson.Types as JSON
|
||||
import qualified Data.ByteString as BS
|
||||
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
|
||||
@@ -47,7 +47,7 @@ import Protolude
|
||||
|
||||
data AuthResult = AuthResult
|
||||
{ authClaims :: KM.KeyMap JSON.Value
|
||||
, authRole :: Text
|
||||
, authRole :: BS.ByteString
|
||||
}
|
||||
|
||||
-- | Receives the JWT secret and audience (from config) and a JWT and returns a
|
||||
@@ -63,7 +63,7 @@ parseToken AppConfig{..} token time = do
|
||||
liftEither . mapLeft jwtClaimsError $ JSON.toJSON <$> eitherClaims
|
||||
where
|
||||
validation =
|
||||
JWT.defaultJWTValidationSettings audienceCheck & set JWT.allowedSkew 1
|
||||
JWT.defaultJWTValidationSettings audienceCheck & set JWT.allowedSkew 30
|
||||
|
||||
audienceCheck :: JWT.StringOrURI -> Bool
|
||||
audienceCheck = maybe (const True) (==) configJwtAudience
|
||||
@@ -79,7 +79,7 @@ parseClaims AppConfig{..} jclaims@(JSON.Object mclaims) = do
|
||||
role <- liftEither . maybeToRight JwtTokenRequired $
|
||||
unquoted <$> walkJSPath (Just jclaims) configJwtRoleClaimKey <|> configDbAnonRole
|
||||
return AuthResult
|
||||
{ authClaims = mclaims & KM.insert "role" (JSON.toJSON role)
|
||||
{ authClaims = mclaims & KM.insert "role" (JSON.toJSON $ decodeUtf8 role)
|
||||
, authRole = role
|
||||
}
|
||||
where
|
||||
@@ -89,9 +89,9 @@ parseClaims AppConfig{..} jclaims@(JSON.Object mclaims) = do
|
||||
walkJSPath (Just (JSON.Array ar)) (JSPIdx idx:rest) = walkJSPath (ar V.!? idx) rest
|
||||
walkJSPath _ _ = Nothing
|
||||
|
||||
unquoted :: JSON.Value -> Text
|
||||
unquoted (JSON.String t) = t
|
||||
unquoted v = T.decodeUtf8 . LBS.toStrict $ JSON.encode v
|
||||
unquoted :: JSON.Value -> BS.ByteString
|
||||
unquoted (JSON.String t) = encodeUtf8 t
|
||||
unquoted v = LBS.toStrict $ JSON.encode v
|
||||
-- impossible case - just added to please -Wincomplete-patterns
|
||||
parseClaims _ _ = return AuthResult { authClaims = KM.empty, authRole = mempty }
|
||||
|
||||
@@ -117,5 +117,5 @@ authResultKey = unsafePerformIO Vault.newKey
|
||||
getResult :: Wai.Request -> Maybe (Either Error AuthResult)
|
||||
getResult = Vault.lookup authResultKey . Wai.vault
|
||||
|
||||
getRole :: Wai.Request -> Maybe Text
|
||||
getRole :: Wai.Request -> Maybe BS.ByteString
|
||||
getRole req = authRole <$> (rightToMaybe =<< getResult req)
|
||||
|
||||
+25
-14
@@ -19,9 +19,8 @@ import Text.Heredoc (str)
|
||||
|
||||
import PostgREST.AppState (AppState)
|
||||
import PostgREST.Config (AppConfig (..))
|
||||
import PostgREST.DbStructure (queryDbStructure)
|
||||
import PostgREST.SchemaCache (querySchemaCache)
|
||||
import PostgREST.Version (prettyVersion)
|
||||
import PostgREST.Workers (reReadConfig)
|
||||
|
||||
import qualified PostgREST.App as App
|
||||
import qualified PostgREST.AppState as AppState
|
||||
@@ -33,7 +32,7 @@ import Protolude hiding (hPutStrLn)
|
||||
main :: App.SignalHandlerInstaller -> Maybe App.SocketRunner -> CLI -> IO ()
|
||||
main installSignalHandlers runAppWithSocket CLI{cliCommand, cliPath} = do
|
||||
conf@AppConfig{..} <-
|
||||
either panic identity <$> Config.readAppConfig mempty cliPath Nothing
|
||||
either panic identity <$> Config.readAppConfig mempty cliPath Nothing mempty mempty
|
||||
|
||||
-- Per https://github.com/PostgREST/postgrest/issues/268, we want to
|
||||
-- explicitly close the connections to PostgreSQL on shutdown.
|
||||
@@ -43,28 +42,25 @@ main installSignalHandlers runAppWithSocket CLI{cliCommand, cliPath} = do
|
||||
AppState.destroy
|
||||
(\appState -> case cliCommand of
|
||||
CmdDumpConfig -> do
|
||||
when configDbConfig $ reReadConfig True appState
|
||||
when configDbConfig $ AppState.reReadConfig True appState
|
||||
putStr . Config.toText =<< AppState.getConfig appState
|
||||
CmdDumpSchema -> putStrLn =<< dumpSchema appState
|
||||
CmdRun -> App.run installSignalHandlers runAppWithSocket appState)
|
||||
|
||||
-- | Dump DbStructure schema to JSON
|
||||
-- | Dump SchemaCache schema to JSON
|
||||
dumpSchema :: AppState -> IO LBS.ByteString
|
||||
dumpSchema appState = do
|
||||
AppConfig{..} <- AppState.getConfig appState
|
||||
conf@AppConfig{..} <- AppState.getConfig appState
|
||||
result <-
|
||||
let transaction = if configDbPreparedStatements then SQL.transaction else SQL.unpreparedTransaction in
|
||||
AppState.usePool appState $
|
||||
transaction SQL.ReadCommitted SQL.Read $
|
||||
queryDbStructure
|
||||
(toList configDbSchemas)
|
||||
configDbExtraSearchPath
|
||||
configDbPreparedStatements
|
||||
querySchemaCache conf
|
||||
case result of
|
||||
Left e -> do
|
||||
hPutStrLn stderr $ "An error ocurred when loading the schema cache:\n" <> show e
|
||||
exitFailure
|
||||
Right dbStructure -> return $ JSON.encode dbStructure
|
||||
Right sCache -> return $ JSON.encode sCache
|
||||
|
||||
-- | Command line interface options
|
||||
data CLI = CLI
|
||||
@@ -84,7 +80,7 @@ readCLIShowHelp =
|
||||
where
|
||||
prefs = O.prefs $ O.showHelpOnError <> O.showHelpOnEmpty
|
||||
opts = O.info parser $ O.fullDesc <> progDesc
|
||||
parser = O.helper <*> exampleParser <*> cliParser
|
||||
parser = O.helper <*> versionFlag <*> exampleParser <*> cliParser
|
||||
|
||||
progDesc =
|
||||
O.progDesc $
|
||||
@@ -92,6 +88,12 @@ readCLIShowHelp =
|
||||
<> BS.unpack prettyVersion
|
||||
<> " / create a REST API to an existing Postgres database"
|
||||
|
||||
versionFlag =
|
||||
O.infoOption ("PostgREST " <> BS.unpack prettyVersion) $
|
||||
O.long "version"
|
||||
<> O.short 'v'
|
||||
<> O.help "Show the version information"
|
||||
|
||||
exampleParser =
|
||||
O.infoOption exampleConfigFile $
|
||||
O.long "example"
|
||||
@@ -136,6 +138,9 @@ exampleConfigFile =
|
||||
|## Enable in-database configuration
|
||||
|db-config = true
|
||||
|
|
||||
|## Function for in-database configuration
|
||||
|## db-pre-config = "postgrest.pre_config"
|
||||
|
|
||||
|## Extra schemas to add to the search_path of every request
|
||||
|db-extra-search-path = "public"
|
||||
|
|
||||
@@ -148,8 +153,14 @@ exampleConfigFile =
|
||||
|## 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
|
||||
|## Time in seconds to wait to acquire a slot from the connection pool
|
||||
|# db-pool-acquisition-timeout = 10
|
||||
|
|
||||
|## Time in seconds after which to recycle pool connections
|
||||
|# db-pool-max-lifetime = 1800
|
||||
|
|
||||
|## Time in seconds after which to recycle unused pool connections
|
||||
|# db-pool-max-idletime = 30
|
||||
|
|
||||
|## Stored proc to exec immediately after auth
|
||||
|# db-pre-request = "stored_proc_name"
|
||||
|
||||
+112
-55
@@ -24,6 +24,7 @@ module PostgREST.Config
|
||||
, readPGRSTEnvironment
|
||||
, toURI
|
||||
, parseSecret
|
||||
, addFallbackAppName
|
||||
) where
|
||||
|
||||
import qualified Crypto.JOSE.Types as JOSE
|
||||
@@ -32,6 +33,7 @@ import qualified Data.Aeson as JSON
|
||||
import qualified Data.ByteString as BS
|
||||
import qualified Data.ByteString.Base64 as B64
|
||||
import qualified Data.ByteString.Lazy as LBS
|
||||
import qualified Data.CaseInsensitive as CI
|
||||
import qualified Data.Configurator as C
|
||||
import qualified Data.Map.Strict as M
|
||||
import qualified Data.Text as T
|
||||
@@ -46,57 +48,68 @@ import Data.List (lookup)
|
||||
import Data.List.NonEmpty (fromList, toList)
|
||||
import Data.Maybe (fromJust)
|
||||
import Data.Scientific (floatingOrInteger)
|
||||
import Data.Time.Clock (NominalDiffTime)
|
||||
import Network.URI (escapeURIString,
|
||||
isUnescapedInURIComponent, parseURI,
|
||||
uriQuery)
|
||||
import Numeric (readOct, showOct)
|
||||
import System.Environment (getEnvironment)
|
||||
import System.Posix.Types (FileMode)
|
||||
|
||||
import PostgREST.Config.Database (RoleIsolationLvl,
|
||||
RoleSettings)
|
||||
import PostgREST.Config.JSPath (JSPath, JSPathExp (..),
|
||||
dumpJSPath, pRoleClaimKey)
|
||||
import PostgREST.Config.Proxy (Proxy (..),
|
||||
isMalformedProxyUri, toURI)
|
||||
import PostgREST.DbStructure.Identifiers (QualifiedIdentifier, dumpQi,
|
||||
toQi)
|
||||
import PostgREST.MediaType (MediaType (..), toMime)
|
||||
import PostgREST.SchemaCache.Identifiers (QualifiedIdentifier, dumpQi,
|
||||
toQi)
|
||||
|
||||
import Protolude hiding (Proxy, toList)
|
||||
|
||||
|
||||
data AppConfig = AppConfig
|
||||
{ configAppSettings :: [(Text, Text)]
|
||||
, configDbAnonRole :: Maybe Text
|
||||
, configDbChannel :: Text
|
||||
, configDbChannelEnabled :: Bool
|
||||
, configDbExtraSearchPath :: [Text]
|
||||
, configDbMaxRows :: Maybe Integer
|
||||
, configDbPlanEnabled :: Bool
|
||||
, configDbPoolSize :: Int
|
||||
, configDbPoolTimeout :: NominalDiffTime
|
||||
, configDbPreRequest :: Maybe QualifiedIdentifier
|
||||
, configDbPreparedStatements :: Bool
|
||||
, configDbRootSpec :: Maybe QualifiedIdentifier
|
||||
, configDbSchemas :: NonEmpty Text
|
||||
, configDbConfig :: Bool
|
||||
, configDbTxAllowOverride :: Bool
|
||||
, configDbTxRollbackAll :: Bool
|
||||
, configDbUri :: Text
|
||||
, configDbUseLegacyGucs :: Bool
|
||||
, configFilePath :: Maybe FilePath
|
||||
, configJWKS :: Maybe JWKSet
|
||||
, configJwtAudience :: Maybe StringOrURI
|
||||
, configJwtRoleClaimKey :: JSPath
|
||||
, configJwtSecret :: Maybe BS.ByteString
|
||||
, configJwtSecretIsBase64 :: Bool
|
||||
, configLogLevel :: LogLevel
|
||||
, configOpenApiMode :: OpenAPIMode
|
||||
, configOpenApiSecurityActive :: Bool
|
||||
, configOpenApiServerProxyUri :: Maybe Text
|
||||
, configRawMediaTypes :: [MediaType]
|
||||
, configServerHost :: Text
|
||||
, configServerPort :: Int
|
||||
, configServerUnixSocket :: Maybe FilePath
|
||||
, configServerUnixSocketMode :: FileMode
|
||||
, configAdminServerPort :: Maybe Int
|
||||
{ configAppSettings :: [(Text, Text)]
|
||||
, configDbAnonRole :: Maybe BS.ByteString
|
||||
, configDbChannel :: Text
|
||||
, configDbChannelEnabled :: Bool
|
||||
, configDbExtraSearchPath :: [Text]
|
||||
, configDbMaxRows :: Maybe Integer
|
||||
, configDbPlanEnabled :: Bool
|
||||
, configDbPoolSize :: Int
|
||||
, configDbPoolAcquisitionTimeout :: Int
|
||||
, configDbPoolMaxLifetime :: Int
|
||||
, configDbPoolMaxIdletime :: Int
|
||||
, configDbPreRequest :: Maybe QualifiedIdentifier
|
||||
, configDbPreparedStatements :: Bool
|
||||
, configDbRootSpec :: Maybe QualifiedIdentifier
|
||||
, configDbSchemas :: NonEmpty Text
|
||||
, configDbConfig :: Bool
|
||||
, configDbPreConfig :: Maybe QualifiedIdentifier
|
||||
, configDbTxAllowOverride :: Bool
|
||||
, configDbTxRollbackAll :: Bool
|
||||
, configDbUri :: Text
|
||||
, configDbUseLegacyGucs :: Bool
|
||||
, configFilePath :: Maybe FilePath
|
||||
, configJWKS :: Maybe JWKSet
|
||||
, configJwtAudience :: Maybe StringOrURI
|
||||
, configJwtRoleClaimKey :: JSPath
|
||||
, configJwtSecret :: Maybe BS.ByteString
|
||||
, configJwtSecretIsBase64 :: Bool
|
||||
, configLogLevel :: LogLevel
|
||||
, configOpenApiMode :: OpenAPIMode
|
||||
, configOpenApiSecurityActive :: Bool
|
||||
, configOpenApiServerProxyUri :: Maybe Text
|
||||
, configRawMediaTypes :: [MediaType]
|
||||
, configServerHost :: Text
|
||||
, configServerPort :: Int
|
||||
, configServerTraceHeader :: Maybe (CI.CI BS.ByteString)
|
||||
, configServerUnixSocket :: Maybe FilePath
|
||||
, configServerUnixSocketMode :: FileMode
|
||||
, configAdminServerPort :: Maybe Int
|
||||
, configRoleSettings :: RoleSettings
|
||||
, configRoleIsoLvl :: RoleIsolationLvl
|
||||
, configInternalSCSleep :: Maybe Int32
|
||||
}
|
||||
|
||||
data LogLevel = LogCrit | LogError | LogWarn | LogInfo
|
||||
@@ -124,19 +137,22 @@ toText conf =
|
||||
where
|
||||
-- apply conf to all pgrst settings
|
||||
pgrstSettings = (\(k, v) -> (k, v conf)) <$>
|
||||
[("db-anon-role", q . fromMaybe "" . configDbAnonRole)
|
||||
[("db-anon-role", q . T.decodeUtf8 . fromMaybe "" . configDbAnonRole)
|
||||
,("db-channel", q . configDbChannel)
|
||||
,("db-channel-enabled", T.toLower . show . configDbChannelEnabled)
|
||||
,("db-extra-search-path", q . T.intercalate "," . configDbExtraSearchPath)
|
||||
,("db-max-rows", maybe "\"\"" show . configDbMaxRows)
|
||||
,("db-plan-enabled", T.toLower . show . configDbPlanEnabled)
|
||||
,("db-pool", show . configDbPoolSize)
|
||||
,("db-pool-timeout", show . floor . configDbPoolTimeout)
|
||||
,("db-pool-acquisition-timeout", show . configDbPoolAcquisitionTimeout)
|
||||
,("db-pool-max-lifetime", show . configDbPoolMaxLifetime)
|
||||
,("db-pool-max-idletime", show . configDbPoolMaxIdletime)
|
||||
,("db-pre-request", q . maybe mempty dumpQi . configDbPreRequest)
|
||||
,("db-prepared-statements", T.toLower . show . configDbPreparedStatements)
|
||||
,("db-root-spec", q . maybe mempty dumpQi . configDbRootSpec)
|
||||
,("db-schemas", q . T.intercalate "," . toList . configDbSchemas)
|
||||
,("db-config", T.toLower . show . configDbConfig)
|
||||
,("db-pre-config", q . maybe mempty dumpQi . configDbPreConfig)
|
||||
,("db-tx-end", q . showTxEnd)
|
||||
,("db-uri", q . configDbUri)
|
||||
,("db-use-legacy-gucs", T.toLower . show . configDbUseLegacyGucs)
|
||||
@@ -151,6 +167,7 @@ toText conf =
|
||||
,("raw-media-types", q . T.decodeUtf8 . BS.intercalate "," . fmap toMime . configRawMediaTypes)
|
||||
,("server-host", q . configServerHost)
|
||||
,("server-port", show . configServerPort)
|
||||
,("server-trace-header", q . T.decodeUtf8 . maybe mempty CI.original . configServerTraceHeader)
|
||||
,("server-unix-socket", q . maybe mempty T.pack . configServerUnixSocket)
|
||||
,("server-unix-socket-mode", q . T.pack . showSocketMode)
|
||||
,("admin-server-port", maybe "\"\"" show . configAdminServerPort)
|
||||
@@ -187,13 +204,13 @@ instance JustIfMaybe a (Maybe a) where
|
||||
|
||||
-- | Reads and parses the config and overrides its parameters from env vars,
|
||||
-- files or db settings.
|
||||
readAppConfig :: [(Text, Text)] -> Maybe FilePath -> Maybe Text -> IO (Either Text AppConfig)
|
||||
readAppConfig dbSettings optPath prevDbUri = do
|
||||
readAppConfig :: [(Text, Text)] -> Maybe FilePath -> Maybe Text -> RoleSettings -> RoleIsolationLvl -> IO (Either Text AppConfig)
|
||||
readAppConfig dbSettings optPath prevDbUri roleSettings roleIsolationLvl = do
|
||||
env <- readPGRSTEnvironment
|
||||
-- if no filename provided, start with an empty map to read config from environment
|
||||
conf <- maybe (return $ Right M.empty) loadConfig optPath
|
||||
|
||||
case C.runParser (parser optPath env dbSettings) =<< mapLeft show conf of
|
||||
case C.runParser (parser optPath env dbSettings roleSettings roleIsolationLvl) =<< mapLeft show conf of
|
||||
Left err ->
|
||||
return . Left $ "Error in config " <> err
|
||||
Right parsedConfig ->
|
||||
@@ -208,11 +225,11 @@ readAppConfig dbSettings optPath prevDbUri = do
|
||||
decodeJWKS <$>
|
||||
(decodeSecret =<< readSecretFile =<< readDbUriFile prevDbUri parsedConfig)
|
||||
|
||||
parser :: Maybe FilePath -> Environment -> [(Text, Text)] -> C.Parser C.Config AppConfig
|
||||
parser optPath env dbSettings =
|
||||
parser :: Maybe FilePath -> Environment -> [(Text, Text)] -> RoleSettings -> RoleIsolationLvl -> C.Parser C.Config AppConfig
|
||||
parser optPath env dbSettings roleSettings roleIsolationLvl =
|
||||
AppConfig
|
||||
<$> parseAppSettings "app.settings"
|
||||
<*> optString "db-anon-role"
|
||||
<*> (fmap encodeUtf8 <$> optString "db-anon-role")
|
||||
<*> (fromMaybe "pgrst" <$> optString "db-channel")
|
||||
<*> (fromMaybe True <$> optBool "db-channel-enabled")
|
||||
<*> (maybe ["public"] splitOnCommas <$> optValue "db-extra-search-path")
|
||||
@@ -220,7 +237,10 @@ parser optPath env dbSettings =
|
||||
(optInt "max-rows")
|
||||
<*> (fromMaybe False <$> optBool "db-plan-enabled")
|
||||
<*> (fromMaybe 10 <$> optInt "db-pool")
|
||||
<*> (fromIntegral . fromMaybe 3600 <$> optInt "db-pool-timeout")
|
||||
<*> (fromMaybe 10 <$> optInt "db-pool-acquisition-timeout")
|
||||
<*> (fromMaybe 1800 <$> optInt "db-pool-max-lifetime")
|
||||
<*> (fromMaybe 30 <$> optWithAlias (optInt "db-pool-timeout")
|
||||
(optInt "db-pool-max-idletime"))
|
||||
<*> (fmap toQi <$> optWithAlias (optString "db-pre-request")
|
||||
(optString "pre-request"))
|
||||
<*> (fromMaybe True <$> optBool "db-prepared-statements")
|
||||
@@ -229,6 +249,7 @@ parser optPath env dbSettings =
|
||||
<*> (fromList . maybe ["public"] splitOnCommas <$> optWithAlias (optValue "db-schemas")
|
||||
(optValue "db-schema"))
|
||||
<*> (fromMaybe True <$> optBool "db-config")
|
||||
<*> (fmap toQi <$> optString "db-pre-config")
|
||||
<*> parseTxEnd "db-tx-end" snd
|
||||
<*> parseTxEnd "db-tx-end" fst
|
||||
<*> (fromMaybe "postgresql://" <$> optString "db-uri")
|
||||
@@ -248,9 +269,13 @@ parser optPath env dbSettings =
|
||||
<*> (maybe [] (fmap (MTOther . encodeUtf8) . splitOnCommas) <$> optValue "raw-media-types")
|
||||
<*> (fromMaybe "!4" <$> optString "server-host")
|
||||
<*> (fromMaybe 3000 <$> optInt "server-port")
|
||||
<*> (fmap (CI.mk . encodeUtf8) <$> optString "server-trace-header")
|
||||
<*> (fmap T.unpack <$> optString "server-unix-socket")
|
||||
<*> parseSocketFileMode "server-unix-socket-mode"
|
||||
<*> optInt "admin-server-port"
|
||||
<*> pure roleSettings
|
||||
<*> pure roleIsolationLvl
|
||||
<*> optInt "internal-schema-cache-sleep"
|
||||
where
|
||||
parseAppSettings :: C.Key -> C.Parser C.Config [(Text, Text)]
|
||||
parseAppSettings key = addFromEnv . fmap (fmap coerceText) <$> C.subassocs key C.value
|
||||
@@ -345,20 +370,14 @@ parser optPath env dbSettings =
|
||||
(C.Key -> C.Parser C.Value a -> C.Parser C.Config b) ->
|
||||
C.Key -> (C.Value -> a) -> C.Parser C.Config b
|
||||
overrideFromDbOrEnvironment necessity key coercion =
|
||||
case reloadableDbSetting <|> M.lookup envVarName env of
|
||||
case dbConf <|> M.lookup envVarName env of
|
||||
Just dbOrEnvVal -> pure $ justIfMaybe $ coercion $ C.String dbOrEnvVal
|
||||
Nothing -> necessity key (coercion <$> C.value)
|
||||
Nothing -> necessity key (coercion <$> C.value)
|
||||
where
|
||||
dashToUnderscore '-' = '_'
|
||||
dashToUnderscore c = c
|
||||
envVarName = "PGRST_" <> (toUpper . dashToUnderscore <$> toS key)
|
||||
reloadableDbSetting =
|
||||
let dbSettingName = T.pack $ dashToUnderscore <$> toS key in
|
||||
if dbSettingName `notElem` [
|
||||
"server_host", "server_port", "server_unix_socket", "server_unix_socket_mode", "admin_server_port", "log_level",
|
||||
"db_uri", "db_channel_enabled", "db_channel", "db_pool", "db_pool_timeout", "db_config"]
|
||||
then lookup dbSettingName dbSettings
|
||||
else Nothing
|
||||
dbConf = lookup (T.pack $ dashToUnderscore <$> toS key) dbSettings
|
||||
|
||||
coerceText :: C.Value -> Text
|
||||
coerceText (C.String s) = s
|
||||
@@ -445,3 +464,41 @@ type Environment = M.Map [Char] Text
|
||||
readPGRSTEnvironment :: IO Environment
|
||||
readPGRSTEnvironment =
|
||||
M.map T.pack . M.fromList . filter (isPrefixOf "PGRST_" . fst) <$> getEnvironment
|
||||
|
||||
-- | Adds a `fallback_application_name` value to the connection string. This allows querying the PostgREST version on pg_stat_activity.
|
||||
--
|
||||
-- >>> let ver = "11.1.0 (5a04ec7)"::ByteString
|
||||
-- >>> let strangeVer = "11'1&0@#$%,.:\"[]{}?+^()=asdfqwer"::ByteString
|
||||
--
|
||||
-- >>> addFallbackAppName ver "postgres://user:pass@host:5432/postgres"
|
||||
-- "postgres://user:pass@host:5432/postgres?fallback_application_name=PostgREST%2011.1.0%20%285a04ec7%29"
|
||||
--
|
||||
-- >>> addFallbackAppName ver "postgres://user:pass@host:5432/postgres?"
|
||||
-- "postgres://user:pass@host:5432/postgres?fallback_application_name=PostgREST%2011.1.0%20%285a04ec7%29"
|
||||
--
|
||||
-- >>> addFallbackAppName ver "postgres:///postgres?host=server&port=5432"
|
||||
-- "postgres:///postgres?host=server&port=5432&fallback_application_name=PostgREST%2011.1.0%20%285a04ec7%29"
|
||||
--
|
||||
-- >>> addFallbackAppName ver "postgresql://"
|
||||
-- "postgresql://?fallback_application_name=PostgREST%2011.1.0%20%285a04ec7%29"
|
||||
--
|
||||
-- >>> addFallbackAppName strangeVer "postgres:///postgres?host=server&port=5432"
|
||||
-- "postgres:///postgres?host=server&port=5432&fallback_application_name=PostgREST%2011%271%260%40%23%24%25%2C.%3A%22%5B%5D%7B%7D%3F%2B%5E%28%29%3Dasdfqwer"
|
||||
--
|
||||
-- >>> addFallbackAppName ver "postgres://user:invalid_chars[]#@host:5432/postgres"
|
||||
-- "postgres://user:invalid_chars[]#@host:5432/postgres"
|
||||
--
|
||||
-- >>> addFallbackAppName ver "invalid_uri1=val1 invalid_uri2=val2"
|
||||
-- "invalid_uri1=val1 invalid_uri2=val2"
|
||||
addFallbackAppName :: ByteString -> Text -> Text
|
||||
addFallbackAppName version dbUri = dbUri <>
|
||||
case uriQuery <$> parseURI (toS dbUri) of
|
||||
-- Does not add the application name to key=val connection strings or invalid URIs
|
||||
Nothing -> mempty
|
||||
Just "" -> "?" <> uriFmt
|
||||
Just "?" -> uriFmt
|
||||
_ -> "&" <> uriFmt
|
||||
where
|
||||
uriFmt = pKeyWord <> toS (escapeURIString isUnescapedInURIComponent $ toS pgrstVer)
|
||||
pKeyWord = "fallback_application_name="
|
||||
pgrstVer = "PostgREST " <> T.decodeUtf8 version
|
||||
|
||||
@@ -3,11 +3,19 @@
|
||||
module PostgREST.Config.Database
|
||||
( pgVersionStatement
|
||||
, queryDbSettings
|
||||
, queryRoleSettings
|
||||
, queryPgVersion
|
||||
, RoleSettings
|
||||
, RoleIsolationLvl
|
||||
, toIsolationLevel
|
||||
) where
|
||||
|
||||
import Control.Arrow ((***))
|
||||
|
||||
import PostgREST.Config.PgVersion (PgVersion (..))
|
||||
|
||||
import qualified Data.HashMap.Strict as HM
|
||||
|
||||
import qualified Hasql.Decoders as HD
|
||||
import qualified Hasql.Encoders as HE
|
||||
import Hasql.Session (Session, statement)
|
||||
@@ -15,51 +23,174 @@ import qualified Hasql.Statement as SQL
|
||||
import qualified Hasql.Transaction as SQL
|
||||
import qualified Hasql.Transaction.Sessions as SQL
|
||||
|
||||
import Text.InterpolatedString.Perl6 (q)
|
||||
import Text.InterpolatedString.Perl6 (q, qc)
|
||||
|
||||
import Protolude
|
||||
|
||||
queryPgVersion :: Session PgVersion
|
||||
queryPgVersion = statement mempty pgVersionStatement
|
||||
type RoleSettings = (HM.HashMap ByteString (HM.HashMap ByteString ByteString))
|
||||
type RoleIsolationLvl = HM.HashMap ByteString SQL.IsolationLevel
|
||||
|
||||
pgVersionStatement :: SQL.Statement () PgVersion
|
||||
pgVersionStatement = SQL.Statement sql HE.noParams versionRow False
|
||||
toIsolationLevel :: (Eq a, IsString a) => a -> SQL.IsolationLevel
|
||||
toIsolationLevel a = case a of
|
||||
"repeatable read" -> SQL.RepeatableRead
|
||||
"serializable" -> SQL.Serializable
|
||||
_ -> SQL.ReadCommitted
|
||||
|
||||
prefix :: Text
|
||||
prefix = "pgrst."
|
||||
|
||||
-- | In-db settings names
|
||||
dbSettingsNames :: [Text]
|
||||
dbSettingsNames =
|
||||
(prefix <>) <$>
|
||||
["db_anon_role"
|
||||
,"db_pre_config"
|
||||
,"db_extra_search_path"
|
||||
,"db_max_rows"
|
||||
,"db_plan_enabled"
|
||||
,"db_pre_request"
|
||||
,"db_prepared_statements"
|
||||
,"db_root_spec"
|
||||
,"db_schemas"
|
||||
,"db_tx_end"
|
||||
,"db_use_legacy_gucs"
|
||||
,"jwt_aud"
|
||||
,"jwt_role_claim_key"
|
||||
,"jwt_secret"
|
||||
,"jwt_secret_is_base64"
|
||||
,"openapi_mode"
|
||||
,"openapi_security_active"
|
||||
,"openapi_server_proxy_uri"
|
||||
,"raw_media_types"
|
||||
,"server_trace_header"
|
||||
]
|
||||
|
||||
queryPgVersion :: Bool -> Session PgVersion
|
||||
queryPgVersion prepared = statement mempty $ pgVersionStatement prepared
|
||||
|
||||
pgVersionStatement :: Bool -> SQL.Statement () PgVersion
|
||||
pgVersionStatement = SQL.Statement sql HE.noParams versionRow
|
||||
where
|
||||
sql = "SELECT current_setting('server_version_num')::integer, current_setting('server_version')"
|
||||
versionRow = HD.singleRow $ PgVersion <$> column HD.int4 <*> column HD.text
|
||||
|
||||
queryDbSettings :: Bool -> Session [(Text, Text)]
|
||||
queryDbSettings prepared =
|
||||
-- | Query the in-database configuration. The settings have the following priorities:
|
||||
--
|
||||
-- 1. Role + with database-specific settings:
|
||||
-- ALTER ROLE authenticator IN DATABASE postgres SET <prefix>jwt_aud = 'val';
|
||||
-- 2. Role + with settings:
|
||||
-- ALTER ROLE authenticator SET <prefix>jwt_aud = 'overridden';
|
||||
-- 3. pre-config function:
|
||||
-- CREATE FUNCTION pre_config() .. PERFORM set_config(<prefix>jwt_aud, 'pre_config_aud'..)
|
||||
--
|
||||
-- The example above will result in <prefix>jwt_aud = 'val'
|
||||
-- A setting on the database only will have no effect: ALTER DATABASE postgres SET <prefix>jwt_aud = 'xx'
|
||||
queryDbSettings :: Maybe Text -> Bool -> Session [(Text, Text)]
|
||||
queryDbSettings preConfFunc prepared =
|
||||
let transaction = if prepared then SQL.transaction else SQL.unpreparedTransaction in
|
||||
transaction SQL.ReadCommitted SQL.Read $ SQL.statement mempty dbSettingsStatement
|
||||
|
||||
-- | Get db settings from the connection role. Global settings will be overridden by database specific settings.
|
||||
dbSettingsStatement :: SQL.Statement () [(Text, Text)]
|
||||
dbSettingsStatement = SQL.Statement sql HE.noParams decodeSettings False
|
||||
transaction SQL.ReadCommitted SQL.Read $ SQL.statement dbSettingsNames $ SQL.Statement sql (arrayParam HE.text) decodeSettings prepared
|
||||
where
|
||||
sql = [q|
|
||||
sql = [qc|
|
||||
WITH
|
||||
role_setting (database, setting) AS (
|
||||
SELECT setdatabase,
|
||||
unnest(setconfig)
|
||||
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))
|
||||
role_setting AS (
|
||||
SELECT setdatabase as database,
|
||||
unnest(setconfig) as setting
|
||||
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 (database, k, v) AS (
|
||||
kv_settings AS (
|
||||
SELECT database,
|
||||
substr(setting, 1, strpos(setting, '=') - 1),
|
||||
substr(setting, strpos(setting, '=') + 1)
|
||||
FROM role_setting
|
||||
WHERE setting LIKE 'pgrst.%'
|
||||
substr(setting, 1, strpos(setting, '=') - 1) as k,
|
||||
substr(setting, strpos(setting, '=') + 1) as v
|
||||
FROM role_setting
|
||||
{preConfigF}
|
||||
)
|
||||
SELECT DISTINCT ON (key)
|
||||
replace(k, 'pgrst.', '') AS key,
|
||||
replace(k, '{prefix}', '') AS key,
|
||||
v AS value
|
||||
FROM kv_settings
|
||||
ORDER BY key, database DESC;
|
||||
FROM kv_settings
|
||||
WHERE k = ANY($1) AND v IS NOT NULL
|
||||
ORDER BY key, database DESC NULLS LAST;
|
||||
|]
|
||||
preConfigF = case preConfFunc of
|
||||
Nothing -> mempty
|
||||
Just func -> [qc|
|
||||
UNION
|
||||
SELECT
|
||||
null as database,
|
||||
x as k,
|
||||
current_setting(x, true) as v
|
||||
FROM unnest($1) x
|
||||
JOIN {func}() _ ON TRUE
|
||||
|]::Text
|
||||
decodeSettings = HD.rowList $ (,) <$> column HD.text <*> column HD.text
|
||||
|
||||
queryRoleSettings :: Bool -> Session (RoleSettings, RoleIsolationLvl)
|
||||
queryRoleSettings prepared =
|
||||
let transaction = if prepared then SQL.transaction else SQL.unpreparedTransaction in
|
||||
transaction SQL.ReadCommitted SQL.Read $ SQL.statement mempty $ SQL.Statement sql HE.noParams (processRows <$> rows) prepared
|
||||
where
|
||||
sql = [q|
|
||||
with
|
||||
role_setting as (
|
||||
select r.rolname, unnest(r.rolconfig) as setting
|
||||
from pg_auth_members m
|
||||
join pg_roles r on r.oid = m.roleid
|
||||
where member = current_user::regrole::oid
|
||||
),
|
||||
kv_settings AS (
|
||||
SELECT
|
||||
rolname,
|
||||
substr(setting, 1, strpos(setting, '=') - 1) as key,
|
||||
lower(substr(setting, strpos(setting, '=') + 1)) as value
|
||||
FROM role_setting
|
||||
),
|
||||
iso_setting AS (
|
||||
SELECT rolname, value
|
||||
FROM kv_settings
|
||||
WHERE key = 'default_transaction_isolation'
|
||||
)
|
||||
select
|
||||
kv.rolname,
|
||||
i.value as iso_lvl,
|
||||
coalesce(array_agg(row(kv.key, kv.value)) filter (where key <> 'default_transaction_isolation'), '{}') as role_settings
|
||||
from kv_settings kv
|
||||
join pg_settings ps on ps.name = kv.key and ps.context = 'user'
|
||||
left join iso_setting i on i.rolname = kv.rolname
|
||||
group by kv.rolname, i.value;
|
||||
|]
|
||||
|
||||
processRows :: [(Text, Maybe Text, [(Text, Text)])] -> (RoleSettings, RoleIsolationLvl)
|
||||
processRows rs =
|
||||
let
|
||||
rowsWRoleSettings = [ (x, z) | (x, _, z) <- rs ]
|
||||
rowsWIsolation = [ (x, y) | (x, Just y, _) <- rs ]
|
||||
in
|
||||
( HM.fromList $ bimap encodeUtf8 (HM.fromList . ((encodeUtf8 *** encodeUtf8) <$>)) <$> rowsWRoleSettings
|
||||
, HM.fromList $ (encodeUtf8 *** toIsolationLevel) <$> rowsWIsolation
|
||||
)
|
||||
|
||||
rows :: HD.Result [(Text, Maybe Text, [(Text, Text)])]
|
||||
rows = HD.rowList $ (,,) <$> column HD.text <*> nullableColumn HD.text <*> compositeArrayColumn ((,) <$> compositeField HD.text <*> compositeField HD.text)
|
||||
|
||||
column :: HD.Value a -> HD.Row a
|
||||
column = HD.column . HD.nonNullable
|
||||
|
||||
nullableColumn :: HD.Value a -> HD.Row (Maybe a)
|
||||
nullableColumn = HD.column . HD.nullable
|
||||
|
||||
compositeField :: HD.Value a -> HD.Composite a
|
||||
compositeField = HD.field . HD.nonNullable
|
||||
|
||||
compositeArrayColumn :: HD.Composite a -> HD.Row [a]
|
||||
compositeArrayColumn = arrayColumn . HD.composite
|
||||
|
||||
arrayColumn :: HD.Value a -> HD.Row [a]
|
||||
arrayColumn = column . HD.listArray . HD.nonNullable
|
||||
|
||||
param :: HE.Value a -> HE.Params a
|
||||
param = HE.param . HE.nonNullable
|
||||
|
||||
arrayParam :: HE.Value a -> HE.Params [a]
|
||||
arrayParam = param . HE.foldableArray . HE.nonNullable
|
||||
|
||||
@@ -1,91 +0,0 @@
|
||||
{-# LANGUAGE DeriveAnyClass #-}
|
||||
{-# LANGUAGE DeriveGeneric #-}
|
||||
|
||||
module PostgREST.DbStructure.Proc
|
||||
( PgType(..)
|
||||
, ProcDescription(..)
|
||||
, ProcParam(..)
|
||||
, ProcVolatility(..)
|
||||
, ProcsMap
|
||||
, RetType(..)
|
||||
, procReturnsScalar
|
||||
, procReturnsSingle
|
||||
, procReturnsVoid
|
||||
, procTableName
|
||||
) where
|
||||
|
||||
import qualified Data.Aeson as JSON
|
||||
import qualified Data.HashMap.Strict as HM
|
||||
|
||||
import PostgREST.DbStructure.Identifiers (QualifiedIdentifier (..),
|
||||
Schema, TableName)
|
||||
|
||||
import Protolude
|
||||
|
||||
data PgType
|
||||
= Scalar
|
||||
| Composite QualifiedIdentifier
|
||||
deriving (Eq, Ord, Generic, JSON.ToJSON)
|
||||
|
||||
data RetType
|
||||
= Single PgType
|
||||
| SetOf PgType
|
||||
deriving (Eq, Ord, Generic, JSON.ToJSON)
|
||||
|
||||
data ProcVolatility
|
||||
= Volatile
|
||||
| Stable
|
||||
| Immutable
|
||||
deriving (Eq, Ord, Generic, JSON.ToJSON)
|
||||
|
||||
data ProcDescription = ProcDescription
|
||||
{ pdSchema :: Schema
|
||||
, pdName :: Text
|
||||
, pdDescription :: Maybe Text
|
||||
, pdParams :: [ProcParam]
|
||||
, pdReturnType :: Maybe RetType
|
||||
, pdVolatility :: ProcVolatility
|
||||
, pdHasVariadic :: Bool
|
||||
}
|
||||
deriving (Eq, Generic, JSON.ToJSON)
|
||||
|
||||
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
|
||||
ProcDescription schema1 name1 des1 prms1 rt1 vol1 hasVar1 `compare` ProcDescription schema2 name2 des2 prms2 rt2 vol2 hasVar2
|
||||
| schema1 == schema2 && name1 == name2 && length prms1 < length prms2 = LT
|
||||
| schema2 == schema2 && name1 == name2 && length prms1 > length prms2 = GT
|
||||
| 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).
|
||||
-- | It uses a HashMap for a faster lookup.
|
||||
type ProcsMap = HM.HashMap QualifiedIdentifier [ProcDescription]
|
||||
|
||||
procReturnsScalar :: ProcDescription -> Bool
|
||||
procReturnsScalar proc = case proc of
|
||||
ProcDescription{pdReturnType = Just (Single Scalar)} -> True
|
||||
ProcDescription{pdReturnType = Just (SetOf Scalar)} -> True
|
||||
_ -> False
|
||||
|
||||
procReturnsSingle :: ProcDescription -> Bool
|
||||
procReturnsSingle proc = case proc of
|
||||
ProcDescription{pdReturnType = Just (Single _)} -> True
|
||||
_ -> False
|
||||
|
||||
procReturnsVoid :: ProcDescription -> Bool
|
||||
procReturnsVoid proc = case proc of
|
||||
ProcDescription{pdReturnType = Nothing} -> True
|
||||
_ -> False
|
||||
|
||||
procTableName :: ProcDescription -> Maybe TableName
|
||||
procTableName proc = case pdReturnType proc of
|
||||
Just (SetOf (Composite qi)) -> Just $ qiName qi
|
||||
Just (Single (Composite qi)) -> Just $ qiName qi
|
||||
_ -> Nothing
|
||||
+215
-84
@@ -11,12 +11,13 @@ module PostgREST.Error
|
||||
, PgError(..)
|
||||
, Error(..)
|
||||
, errorPayload
|
||||
, checkIsFatal
|
||||
, singularityError
|
||||
) where
|
||||
|
||||
import qualified Data.Aeson as JSON
|
||||
import qualified Data.ByteString.Char8 as BS
|
||||
import qualified Data.FuzzySet as Fuzzy
|
||||
import qualified Data.HashMap.Strict as HM
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Text.Encoding as T
|
||||
import qualified Data.Text.Encoding.Error as T
|
||||
@@ -29,17 +30,20 @@ import Network.Wai (Response, responseLBS)
|
||||
|
||||
import Network.HTTP.Types.Header (Header)
|
||||
|
||||
import PostgREST.MediaType (MediaType (..))
|
||||
import qualified PostgREST.MediaType as MediaType
|
||||
import PostgREST.Request.Types (ApiRequestError (..),
|
||||
QPError (..))
|
||||
import PostgREST.ApiRequest.Types (ApiRequestError (..),
|
||||
QPError (..),
|
||||
RangeError (..))
|
||||
import PostgREST.MediaType (MediaType (..))
|
||||
import qualified PostgREST.MediaType as MediaType
|
||||
|
||||
import PostgREST.DbStructure.Identifiers (QualifiedIdentifier (..))
|
||||
import PostgREST.DbStructure.Proc (ProcDescription (..),
|
||||
ProcParam (..))
|
||||
import PostgREST.DbStructure.Relationship (Cardinality (..),
|
||||
import PostgREST.SchemaCache.Identifiers (QualifiedIdentifier (..),
|
||||
Schema)
|
||||
import PostgREST.SchemaCache.Relationship (Cardinality (..),
|
||||
Junction (..),
|
||||
Relationship (..))
|
||||
Relationship (..),
|
||||
RelationshipsMap)
|
||||
import PostgREST.SchemaCache.Routine (Routine (..),
|
||||
RoutineParam (..))
|
||||
import Protolude
|
||||
|
||||
|
||||
@@ -56,21 +60,26 @@ class (JSON.ToJSON a) => PgrstError a where
|
||||
instance PgrstError ApiRequestError where
|
||||
status AmbiguousRelBetween{} = HTTP.status300
|
||||
status AmbiguousRpc{} = HTTP.status300
|
||||
status BinaryFieldError{} = HTTP.status406
|
||||
status MediaTypeError{} = HTTP.status415
|
||||
status InvalidBody{} = HTTP.status400
|
||||
status InvalidFilters = HTTP.status405
|
||||
status InvalidRpcMethod{} = HTTP.status405
|
||||
status InvalidRange = HTTP.status416
|
||||
status InvalidRange{} = HTTP.status416
|
||||
status NotFound = HTTP.status404
|
||||
|
||||
status NoRelBetween{} = HTTP.status400
|
||||
status NoRpc{} = HTTP.status404
|
||||
status NotEmbedded{} = HTTP.status400
|
||||
status ParseRequestError{} = HTTP.status400
|
||||
status PutRangeNotAllowedError = HTTP.status400
|
||||
status PutLimitNotAllowedError = HTTP.status400
|
||||
status QueryParamError{} = HTTP.status400
|
||||
status RelatedOrderNotToOne{} = HTTP.status400
|
||||
status SpreadNotToOne{} = HTTP.status400
|
||||
status UnacceptableFilter{} = HTTP.status400
|
||||
status UnacceptableSchema{} = HTTP.status406
|
||||
status UnsupportedMethod{} = HTTP.status405
|
||||
status LimitNoOrderError = HTTP.status400
|
||||
status ColumnNotFound{} = HTTP.status400
|
||||
|
||||
headers _ = [MediaType.toContentType MTApplicationJSON]
|
||||
|
||||
@@ -90,15 +99,13 @@ instance JSON.ToJSON ApiRequestError where
|
||||
"message" .= T.decodeUtf8 errorMessage,
|
||||
"details" .= JSON.Null,
|
||||
"hint" .= JSON.Null]
|
||||
toJSON InvalidRange = JSON.object [
|
||||
toJSON (InvalidRange rangeError) = JSON.object [
|
||||
"code" .= ApiRequestErrorCode03,
|
||||
"message" .= ("HTTP Range error" :: Text),
|
||||
"details" .= JSON.Null,
|
||||
"hint" .= JSON.Null]
|
||||
toJSON (ParseRequestError message details) = JSON.object [
|
||||
"code" .= ApiRequestErrorCode04,
|
||||
"message" .= message,
|
||||
"details" .= details,
|
||||
"message" .= ("Requested range not satisfiable" :: Text),
|
||||
"details" .= (case rangeError of
|
||||
NegativeLimit -> "Limit should be greater than or equal to zero."
|
||||
LowerGTUpper -> "The lower boundary must be lower than or equal to the upper boundary in the Range header."
|
||||
OutOfBounds lower total -> "An offset of " <> lower <> " was requested, but there are only " <> total <> " rows."),
|
||||
"hint" .= JSON.Null]
|
||||
toJSON InvalidFilters = JSON.object [
|
||||
"code" .= ApiRequestErrorCode05,
|
||||
@@ -118,7 +125,7 @@ instance JSON.ToJSON ApiRequestError where
|
||||
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),
|
||||
"message" .= ("'" <> 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)]
|
||||
|
||||
@@ -128,9 +135,15 @@ instance JSON.ToJSON ApiRequestError where
|
||||
"details" .= JSON.Null,
|
||||
"hint" .= ("Apply an 'order' using unique column(s)" :: Text)]
|
||||
|
||||
toJSON PutRangeNotAllowedError = JSON.object [
|
||||
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 PutLimitNotAllowedError = JSON.object [
|
||||
"code" .= ApiRequestErrorCode14,
|
||||
"message" .= ("Range header and limit/offset querystring parameters are not allowed for PUT" :: Text),
|
||||
"message" .= ("limit/offset querystring parameters are not allowed for PUT" :: Text),
|
||||
"details" .= JSON.Null,
|
||||
"hint" .= JSON.Null]
|
||||
|
||||
@@ -140,35 +153,165 @@ instance JSON.ToJSON ApiRequestError where
|
||||
"details" .= JSON.Null,
|
||||
"hint" .= JSON.Null]
|
||||
|
||||
toJSON (NoRelBetween parent child schema) = JSON.object [
|
||||
toJSON (RelatedOrderNotToOne origin target) = JSON.object [
|
||||
"code" .= ApiRequestErrorCode18,
|
||||
"message" .= ("A related order on '" <> target <> "' is not possible" :: Text),
|
||||
"details" .= ("'" <> origin <> "' and '" <> target <> "' do not form a many-to-one or one-to-one relationship" :: Text),
|
||||
"hint" .= JSON.Null]
|
||||
|
||||
toJSON (SpreadNotToOne origin target) = JSON.object [
|
||||
"code" .= ApiRequestErrorCode19,
|
||||
"message" .= ("A spread operation on '" <> target <> "' is not possible" :: Text),
|
||||
"details" .= ("'" <> origin <> "' and '" <> target <> "' do not form a many-to-one or one-to-one relationship" :: Text),
|
||||
"hint" .= JSON.Null]
|
||||
|
||||
toJSON (UnacceptableFilter target) = JSON.object [
|
||||
"code" .= ApiRequestErrorCode20,
|
||||
"message" .= ("Bad operator on the '" <> target <> "' embedded resource":: Text),
|
||||
"details" .= ("Only is null or not is null filters are allowed on embedded resources":: Text),
|
||||
"hint" .= JSON.Null]
|
||||
|
||||
toJSON (NoRelBetween parent child embedHint schema allRels) = 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)]
|
||||
"details" .= ("Searched for a foreign key relationship between '" <> parent <> "' and '" <> child <> maybe mempty ("' using the hint '" <>) embedHint <> "' in the schema '" <> schema <> "', but no matches were found."),
|
||||
"hint" .= noRelBetweenHint parent child schema allRels]
|
||||
|
||||
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 [
|
||||
toJSON (NoRpc schema procName argumentKeys hasPreferSingleObject contentType isInvPost allProcs overloadedProcs) =
|
||||
let func = schema <> "." <> procName
|
||||
prms = T.intercalate ", " argumentKeys
|
||||
prmsMsg = "(" <> prms <> ")"
|
||||
prmsDet = " with parameter" <> (if length argumentKeys > 1 then "s " else " ") <> prms
|
||||
fmtPrms p = if null argumentKeys then " without parameters" else p
|
||||
onlySingleParams = hasPreferSingleObject || (isInvPost && contentType `elem` [MTTextPlain, MTTextXML, MTOctetStream])
|
||||
in JSON.object [
|
||||
"code" .= SchemaCacheErrorCode02,
|
||||
"message" .= ("Could not find the " <> schema <> "." <> procName <>
|
||||
"message" .= ("Could not find the function " <> func <> (if onlySingleParams then "" else fmtPrms prmsMsg) <> " in the schema cache"),
|
||||
"details" .= ("Searched for the function " <> func <>
|
||||
(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)]
|
||||
(True, _, _) -> " with a single json/jsonb parameter"
|
||||
(_, True, MTTextPlain) -> " with a single unnamed text parameter"
|
||||
(_, True, MTTextXML) -> " with a single unnamed xml parameter"
|
||||
(_, True, MTOctetStream) -> " with a single unnamed bytea parameter"
|
||||
(_, True, MTApplicationJSON) -> fmtPrms prmsDet <> " or with a single unnamed json/jsonb parameter"
|
||||
_ -> fmtPrms prmsDet) <>
|
||||
", but no matches were found in the schema cache."),
|
||||
-- The hint will be null in the case of single unnamed parameter functions
|
||||
"hint" .= if onlySingleParams
|
||||
then Nothing
|
||||
else noRpcHint schema procName argumentKeys allProcs overloadedProcs ]
|
||||
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)]
|
||||
toJSON (ColumnNotFound relName colName) = JSON.object [
|
||||
"code" .= SchemaCacheErrorCode04,
|
||||
"message" .= ("Column '" <> colName <> "' of relation '" <> relName <> "' does not exist" :: Text),
|
||||
"details" .= JSON.Null,
|
||||
"hint" .= JSON.Null]
|
||||
|
||||
-- |
|
||||
-- If no relationship is found then:
|
||||
--
|
||||
-- Looks for parent suggestions if parent not found
|
||||
-- Looks for child suggestions if parent is found but child is not
|
||||
-- Gives no suggestions if both are found (it means that there is a problem with the embed hint)
|
||||
--
|
||||
-- >>> :set -Wno-missing-fields
|
||||
-- >>> let qi t = QualifiedIdentifier "api" t
|
||||
-- >>> let rel ft = Relationship{relForeignTable = qi ft}
|
||||
-- >>> let rels = HM.fromList [((qi "films", "api"), [rel "directors", rel "roles", rel "actors"])]
|
||||
--
|
||||
-- >>> noRelBetweenHint "film" "directors" "api" rels
|
||||
-- Just "Perhaps you meant 'films' instead of 'film'."
|
||||
--
|
||||
-- >>> noRelBetweenHint "films" "role" "api" rels
|
||||
-- Just "Perhaps you meant 'roles' instead of 'role'."
|
||||
--
|
||||
-- >>> noRelBetweenHint "films" "role" "api" rels
|
||||
-- Just "Perhaps you meant 'roles' instead of 'role'."
|
||||
--
|
||||
-- >>> noRelBetweenHint "films" "actors" "api" rels
|
||||
-- Nothing
|
||||
--
|
||||
-- >>> noRelBetweenHint "noclosealternative" "roles" "api" rels
|
||||
-- Nothing
|
||||
--
|
||||
-- >>> noRelBetweenHint "films" "noclosealternative" "api" rels
|
||||
-- Nothing
|
||||
--
|
||||
-- >>> noRelBetweenHint "films" "noclosealternative" "noclosealternative" rels
|
||||
-- Nothing
|
||||
--
|
||||
noRelBetweenHint :: Text -> Text -> Schema -> RelationshipsMap -> Maybe Text
|
||||
noRelBetweenHint parent child schema allRels = ("Perhaps you meant '" <>) <$>
|
||||
if isJust findParent
|
||||
then (<> "' instead of '" <> child <> "'.") <$> suggestChild
|
||||
else (<> "' instead of '" <> parent <> "'.") <$> suggestParent
|
||||
where
|
||||
findParent = HM.lookup (QualifiedIdentifier schema parent, schema) allRels
|
||||
fuzzySetOfParents = Fuzzy.fromList [qiName (fst p) | p <- HM.keys allRels, snd p == schema]
|
||||
fuzzySetOfChildren = Fuzzy.fromList [qiName (relForeignTable c) | c <- fromMaybe [] findParent]
|
||||
suggestParent = Fuzzy.getOne fuzzySetOfParents parent
|
||||
-- Do not give suggestion if the child is found in the relations (weight = 1.0)
|
||||
suggestChild = headMay [snd k | k <- Fuzzy.get fuzzySetOfChildren child, fst k < 1.0]
|
||||
|
||||
-- |
|
||||
-- If no function is found with the given name, it does a fuzzy search to all the functions
|
||||
-- in the same schema and shows the best match as hint.
|
||||
--
|
||||
-- >>> :set -Wno-missing-fields
|
||||
-- >>> let procs = [(QualifiedIdentifier "api" "test"), (QualifiedIdentifier "api" "another"), (QualifiedIdentifier "private" "other")]
|
||||
--
|
||||
-- >>> noRpcHint "api" "testt" ["val", "param", "name"] procs []
|
||||
-- Just "Perhaps you meant to call the function api.test"
|
||||
--
|
||||
-- >>> noRpcHint "api" "other" [] procs []
|
||||
-- Just "Perhaps you meant to call the function api.another"
|
||||
--
|
||||
-- >>> noRpcHint "api" "noclosealternative" [] procs []
|
||||
-- Nothing
|
||||
--
|
||||
-- If a function is found with the given name, but no params match, then it does a fuzzy search
|
||||
-- to all the overloaded functions' params using the form "param1, param2, param3, ..."
|
||||
-- and shows the best match as hint.
|
||||
--
|
||||
-- >>> let procsDesc = [Function {pdParams = [RoutineParam {ppName="val"}, RoutineParam {ppName="param"}, RoutineParam {ppName="name"}]}, Function {pdParams = [RoutineParam {ppName="id"}, RoutineParam {ppName="attr"}]}]
|
||||
--
|
||||
-- >>> noRpcHint "api" "test" ["vall", "pqaram", "nam"] procs procsDesc
|
||||
-- Just "Perhaps you meant to call the function api.test(name, param, val)"
|
||||
--
|
||||
-- >>> noRpcHint "api" "test" ["val", "param"] procs procsDesc
|
||||
-- Just "Perhaps you meant to call the function api.test(name, param, val)"
|
||||
--
|
||||
-- >>> noRpcHint "api" "test" ["id", "attrs"] procs procsDesc
|
||||
-- Just "Perhaps you meant to call the function api.test(attr, id)"
|
||||
--
|
||||
-- >>> noRpcHint "api" "test" ["id"] procs procsDesc
|
||||
-- Just "Perhaps you meant to call the function api.test(attr, id)"
|
||||
--
|
||||
-- >>> noRpcHint "api" "test" ["noclosealternative"] procs procsDesc
|
||||
-- Nothing
|
||||
--
|
||||
noRpcHint :: Text -> Text -> [Text] -> [QualifiedIdentifier] -> [Routine] -> Maybe Text
|
||||
noRpcHint schema procName params allProcs overloadedProcs =
|
||||
fmap (("Perhaps you meant to call the function " <> schema <> ".") <>) possibleProcs
|
||||
where
|
||||
fuzzySetOfProcs = Fuzzy.fromList [qiName k | k <- allProcs, qiSchema k == schema]
|
||||
fuzzySetOfParams = Fuzzy.fromList $ listToText <$> [[ppName prm | prm <- pdParams ov] | ov <- overloadedProcs]
|
||||
-- Cannot do a fuzzy search like: Fuzzy.getOne [[Text]] [Text], where [[Text]] is the list of params for each
|
||||
-- overloaded function and [Text] the given params. This converts those lists to text to make fuzzy search possible.
|
||||
-- E.g. ["val", "param", "name"] into "(name, param, val)"
|
||||
listToText = ("(" <>) . (<> ")") . T.intercalate ", " . sort
|
||||
possibleProcs
|
||||
| null overloadedProcs = Fuzzy.getOne fuzzySetOfProcs procName
|
||||
| otherwise = (procName <>) <$> Fuzzy.getOne fuzzySetOfParams (listToText params)
|
||||
|
||||
compressedRel :: Relationship -> JSON.Value
|
||||
-- An ambiguousness error cannot happen for computed relationships TODO refactor so this mempty is not needed
|
||||
@@ -182,7 +325,7 @@ compressedRel Relationship{..} =
|
||||
: case relCardinality of
|
||||
M2M Junction{..} -> [
|
||||
"cardinality" .= ("many-to-many" :: Text)
|
||||
, "relationship" .= (qiName junTable <> " using " <> junConstraint1 <> fmtEls (snd <$> junColumns1) <> " and " <> junConstraint2 <> fmtEls (snd <$> junColumns2))
|
||||
, "relationship" .= (qiName junTable <> " using " <> junConstraint1 <> fmtEls (snd <$> junColsSource) <> " and " <> junConstraint2 <> fmtEls (snd <$> junColsTarget))
|
||||
]
|
||||
M2O cons relColumns -> [
|
||||
"cardinality" .= ("many-to-one" :: Text)
|
||||
@@ -225,22 +368,27 @@ instance JSON.ToJSON PgError where
|
||||
toJSON (PgError _ usageError) = JSON.toJSON usageError
|
||||
|
||||
instance JSON.ToJSON SQL.UsageError where
|
||||
toJSON (SQL.ConnectionError e) = JSON.object [
|
||||
toJSON (SQL.ConnectionUsageError e) = JSON.object [
|
||||
"code" .= ConnectionErrorCode00,
|
||||
"message" .= ("Database connection error. Retrying the connection." :: Text),
|
||||
"details" .= (T.decodeUtf8With T.lenientDecode $ fromMaybe "" e :: Text),
|
||||
"hint" .= JSON.Null]
|
||||
toJSON (SQL.SessionError e) = JSON.toJSON e -- SQL.Error
|
||||
toJSON (SQL.SessionUsageError e) = JSON.toJSON e -- SQL.Error
|
||||
toJSON SQL.AcquisitionTimeoutUsageError = JSON.object [
|
||||
"code" .= ConnectionErrorCode03,
|
||||
"message" .= ("Timed out acquiring connection from connection pool." :: Text),
|
||||
"details" .= JSON.Null,
|
||||
"hint" .= JSON.Null]
|
||||
|
||||
instance JSON.ToJSON SQL.QueryError where
|
||||
toJSON (SQL.QueryError _ _ e) = JSON.toJSON e
|
||||
|
||||
instance JSON.ToJSON SQL.CommandError where
|
||||
toJSON (SQL.ResultError (SQL.ServerError c m d h)) = JSON.object [
|
||||
"code" .= (T.decodeUtf8 c :: Text),
|
||||
"message" .= (T.decodeUtf8 m :: Text),
|
||||
"details" .= (fmap T.decodeUtf8 d :: Maybe Text),
|
||||
"hint" .= (fmap T.decodeUtf8 h :: Maybe Text)]
|
||||
toJSON (SQL.ResultError (SQL.ServerError c m d h _p)) = JSON.object [
|
||||
"code" .= (T.decodeUtf8 c :: Text),
|
||||
"message" .= (T.decodeUtf8 m :: Text),
|
||||
"details" .= (fmap T.decodeUtf8 d :: Maybe Text),
|
||||
"hint" .= (fmap T.decodeUtf8 h :: Maybe Text)]
|
||||
|
||||
toJSON (SQL.ResultError resultError) = JSON.object [
|
||||
"code" .= InternalErrorCode00,
|
||||
@@ -254,12 +402,14 @@ instance JSON.ToJSON SQL.CommandError where
|
||||
"details" .= (fmap T.decodeUtf8 d :: Maybe Text),
|
||||
"hint" .= JSON.Null]
|
||||
|
||||
|
||||
pgErrorStatus :: Bool -> SQL.UsageError -> HTTP.Status
|
||||
pgErrorStatus _ (SQL.ConnectionError _) = HTTP.status503
|
||||
pgErrorStatus _ (SQL.SessionError (SQL.QueryError _ _ (SQL.ClientError _))) = HTTP.status503
|
||||
pgErrorStatus authed (SQL.SessionError (SQL.QueryError _ _ (SQL.ResultError rError))) =
|
||||
pgErrorStatus _ (SQL.ConnectionUsageError _) = HTTP.status503
|
||||
pgErrorStatus _ SQL.AcquisitionTimeoutUsageError = HTTP.status504
|
||||
pgErrorStatus _ (SQL.SessionUsageError (SQL.QueryError _ _ (SQL.ClientError _))) = HTTP.status503
|
||||
pgErrorStatus authed (SQL.SessionUsageError (SQL.QueryError _ _ (SQL.ResultError rError))) =
|
||||
case rError of
|
||||
(SQL.ServerError c m _ _) ->
|
||||
(SQL.ServerError c m _ _ _) ->
|
||||
case BS.unpack c of
|
||||
'0':'8':_ -> HTTP.status503 -- pg connection err
|
||||
'0':'9':_ -> HTTP.status500 -- triggered action exception
|
||||
@@ -278,6 +428,7 @@ pgErrorStatus authed (SQL.SessionError (SQL.QueryError _ _ (SQL.ResultError rErr
|
||||
'5':'3':_ -> HTTP.status503 -- insufficient resources
|
||||
'5':'4':_ -> HTTP.status413 -- too complex
|
||||
'5':'5':_ -> HTTP.status500 -- obj not on prereq state
|
||||
'5':'7':'P':'0':'1':_ -> HTTP.status503 -- terminating connection due to administrator command
|
||||
'5':'7':_ -> HTTP.status500 -- operator intervention
|
||||
'5':'8':_ -> HTTP.status500 -- system error
|
||||
'F':'0':_ -> HTTP.status500 -- conf file error
|
||||
@@ -295,34 +446,10 @@ pgErrorStatus authed (SQL.SessionError (SQL.QueryError _ _ (SQL.ResultError rErr
|
||||
|
||||
_ -> HTTP.status500
|
||||
|
||||
checkIsFatal :: PgError -> Maybe Text
|
||||
checkIsFatal (PgError _ (SQL.ConnectionError e))
|
||||
| isAuthFailureMessage = Just $ toS failureMessage
|
||||
| otherwise = Nothing
|
||||
where isAuthFailureMessage = "FATAL: password authentication failed" `isPrefixOf` failureMessage
|
||||
failureMessage = BS.unpack $ fromMaybe mempty e
|
||||
checkIsFatal (PgError _ (SQL.SessionError (SQL.QueryError _ _ (SQL.ResultError serverError))))
|
||||
= 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.
|
||||
SQL.ServerError "42601" _ _ _
|
||||
-> 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).
|
||||
-- This would mean that a connection pooler in transaction mode is being used
|
||||
-- while prepared statements are enabled in the PostgREST configuration,
|
||||
-- both of which are incompatible with each other.
|
||||
SQL.ServerError "42P05" _ _ _
|
||||
-> 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).
|
||||
-- This would mean that a connection pooler in statement mode is being used which is not supported in PostgREST.
|
||||
SQL.ServerError "08P01" "transaction blocks not allowed in statement pooling mode" _ _
|
||||
-> Just "Hint: Connection poolers in statement mode are not supported."
|
||||
_ -> Nothing
|
||||
checkIsFatal _ = Nothing
|
||||
|
||||
|
||||
data Error
|
||||
= ApiRequestError ApiRequestError
|
||||
| BinaryFieldError MediaType
|
||||
| GucHeadersError
|
||||
| GucStatusError
|
||||
| JwtTokenInvalid Text
|
||||
@@ -336,7 +463,6 @@ data Error
|
||||
|
||||
instance PgrstError Error where
|
||||
status (ApiRequestError err) = status err
|
||||
status BinaryFieldError{} = HTTP.status406
|
||||
status GucHeadersError = HTTP.status500
|
||||
status GucStatusError = HTTP.status500
|
||||
status JwtTokenInvalid{} = HTTP.unauthorized401
|
||||
@@ -352,7 +478,7 @@ instance PgrstError Error where
|
||||
headers (JwtTokenInvalid m) = [MediaType.toContentType MTApplicationJSON, invalidTokenHeader m]
|
||||
headers JwtTokenRequired = [MediaType.toContentType MTApplicationJSON, requiredTokenHeader]
|
||||
headers (PgErr err) = headers err
|
||||
headers SingularityError{} = [MediaType.toContentType MTSingularJSON]
|
||||
headers SingularityError{} = [MediaType.toContentType (MTSingularJSON False)]
|
||||
headers _ = [MediaType.toContentType MTApplicationJSON]
|
||||
|
||||
instance JSON.ToJSON Error where
|
||||
@@ -394,11 +520,6 @@ instance JSON.ToJSON Error where
|
||||
"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,
|
||||
@@ -409,7 +530,7 @@ instance JSON.ToJSON Error where
|
||||
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"],
|
||||
"details" .= T.unwords ["The result contains", show n, "rows"],
|
||||
"hint" .= JSON.Null]
|
||||
|
||||
toJSON (PgErr err) = JSON.toJSON err
|
||||
@@ -431,12 +552,13 @@ data ErrorCode
|
||||
= ConnectionErrorCode00
|
||||
| ConnectionErrorCode01
|
||||
| ConnectionErrorCode02
|
||||
| ConnectionErrorCode03
|
||||
-- API Request errors
|
||||
| ApiRequestErrorCode00
|
||||
| ApiRequestErrorCode01
|
||||
| ApiRequestErrorCode02
|
||||
| ApiRequestErrorCode03
|
||||
| ApiRequestErrorCode04
|
||||
| ApiRequestErrorCode04 -- no longer used (used to be mapped to ParseRequestError)
|
||||
| ApiRequestErrorCode05
|
||||
| ApiRequestErrorCode06
|
||||
| ApiRequestErrorCode07
|
||||
@@ -450,11 +572,15 @@ data ErrorCode
|
||||
| ApiRequestErrorCode15
|
||||
| ApiRequestErrorCode16
|
||||
| ApiRequestErrorCode17
|
||||
| ApiRequestErrorCode18
|
||||
| ApiRequestErrorCode19
|
||||
| ApiRequestErrorCode20
|
||||
-- Schema Cache errors
|
||||
| SchemaCacheErrorCode00
|
||||
| SchemaCacheErrorCode01
|
||||
| SchemaCacheErrorCode02
|
||||
| SchemaCacheErrorCode03
|
||||
| SchemaCacheErrorCode04
|
||||
-- JWT authentication errors
|
||||
| JWTErrorCode00
|
||||
| JWTErrorCode01
|
||||
@@ -472,6 +598,7 @@ buildErrorCode code = "PGRST" <> case code of
|
||||
ConnectionErrorCode00 -> "000"
|
||||
ConnectionErrorCode01 -> "001"
|
||||
ConnectionErrorCode02 -> "002"
|
||||
ConnectionErrorCode03 -> "003"
|
||||
|
||||
ApiRequestErrorCode00 -> "100"
|
||||
ApiRequestErrorCode01 -> "101"
|
||||
@@ -491,11 +618,15 @@ buildErrorCode code = "PGRST" <> case code of
|
||||
ApiRequestErrorCode15 -> "115"
|
||||
ApiRequestErrorCode16 -> "116"
|
||||
ApiRequestErrorCode17 -> "117"
|
||||
ApiRequestErrorCode18 -> "118"
|
||||
ApiRequestErrorCode19 -> "119"
|
||||
ApiRequestErrorCode20 -> "120"
|
||||
|
||||
SchemaCacheErrorCode00 -> "200"
|
||||
SchemaCacheErrorCode01 -> "201"
|
||||
SchemaCacheErrorCode02 -> "202"
|
||||
SchemaCacheErrorCode03 -> "203"
|
||||
SchemaCacheErrorCode04 -> "204"
|
||||
|
||||
JWTErrorCode00 -> "300"
|
||||
JWTErrorCode01 -> "301"
|
||||
|
||||
@@ -26,5 +26,5 @@ middleware logLevel = case logLevel of
|
||||
{ Wai.outputFormat = Wai.ApacheWithSettings $
|
||||
Wai.defaultApacheSettings
|
||||
& Wai.setApacheRequestFilter (\_ res -> filterStatus $ Wai.responseStatus res)
|
||||
& Wai.setApacheUserGetter (fmap encodeUtf8 . Auth.getRole)
|
||||
& Wai.setApacheUserGetter Auth.getRole
|
||||
}
|
||||
|
||||
+102
-57
@@ -4,16 +4,13 @@ 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)
|
||||
|
||||
@@ -22,7 +19,8 @@ import Protolude
|
||||
-- | Enumeration of currently supported media types
|
||||
data MediaType
|
||||
= MTApplicationJSON
|
||||
| MTSingularJSON
|
||||
| MTArrayJSONStrip
|
||||
| MTSingularJSON Bool
|
||||
| MTGeoJSON
|
||||
| MTTextCSV
|
||||
| MTTextPlain
|
||||
@@ -32,18 +30,32 @@ data MediaType
|
||||
| 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
|
||||
-- TODO MTPlan should only have its options as [Text]. Its ResultAggregate should have the typed attributes.
|
||||
| MTPlan MediaType MTPlanFormat [MTPlanOption]
|
||||
deriving Show
|
||||
instance Eq MediaType where
|
||||
MTApplicationJSON == MTApplicationJSON = True
|
||||
MTArrayJSONStrip == MTArrayJSONStrip = True
|
||||
MTSingularJSON x == MTSingularJSON y = x == y
|
||||
MTGeoJSON == MTGeoJSON = True
|
||||
MTTextCSV == MTTextCSV = True
|
||||
MTTextPlain == MTTextPlain = True
|
||||
MTTextXML == MTTextXML = True
|
||||
MTOpenAPI == MTOpenAPI = True
|
||||
MTUrlEncoded == MTUrlEncoded = True
|
||||
MTOctetStream == MTOctetStream = True
|
||||
MTAny == MTAny = True
|
||||
MTOther x == MTOther y = x == y
|
||||
MTPlan{} == MTPlan{} = True
|
||||
_ == _ = False
|
||||
|
||||
data MTPlanOption
|
||||
= PlanAnalyze | PlanVerbose | PlanSettings | PlanBuffers | PlanWAL
|
||||
deriving (Eq, Show)
|
||||
|
||||
data MTPlanFormat
|
||||
= PlanJSON | PlanText
|
||||
deriving (Eq, Show)
|
||||
|
||||
-- | Convert MediaType to a Content-Type HTTP Header
|
||||
toContentType :: MediaType -> Header
|
||||
@@ -56,20 +68,22 @@ toContentType ct = (hContentType, toMime ct <> charset)
|
||||
|
||||
-- | 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)) =
|
||||
toMime MTApplicationJSON = "application/json"
|
||||
toMime MTArrayJSONStrip = "application/vnd.pgrst.array+json;nulls=stripped"
|
||||
toMime MTGeoJSON = "application/geo+json"
|
||||
toMime MTTextCSV = "text/csv"
|
||||
toMime MTTextPlain = "text/plain"
|
||||
toMime MTTextXML = "text/xml"
|
||||
toMime MTOpenAPI = "application/openapi+json"
|
||||
toMime (MTSingularJSON True) = "application/vnd.pgrst.object+json;nulls=stripped"
|
||||
toMime (MTSingularJSON False) = "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 mt fmt opts) =
|
||||
"application/vnd.pgrst.plan+" <> toMimePlanFormat fmt <>
|
||||
(if isNothing mt then mempty else "; for=\"" <> toMime (fromJust mt) <> "\"") <>
|
||||
("; for=\"" <> toMime mt <> "\"") <>
|
||||
(if null opts then mempty else "; options=" <> BS.intercalate "|" (toMimePlanOption <$> opts))
|
||||
|
||||
toMimePlanOption :: MTPlanOption -> ByteString
|
||||
@@ -83,42 +97,73 @@ toMimePlanFormat :: MTPlanFormat -> ByteString
|
||||
toMimePlanFormat PlanJSON = "json"
|
||||
toMimePlanFormat PlanText = "text"
|
||||
|
||||
-- | Convert from ByteString to MediaType. Warning: discards MIME parameters
|
||||
-- | Convert from ByteString to MediaType.
|
||||
--
|
||||
-- >>> decodeMediaType "application/json"
|
||||
-- MTApplicationJSON
|
||||
--
|
||||
-- >>> decodeMediaType "application/vnd.pgrst.plan;"
|
||||
-- MTPlan MTApplicationJSON PlanText []
|
||||
--
|
||||
-- >>> decodeMediaType "application/vnd.pgrst.plan;for=\"application/json\""
|
||||
-- MTPlan MTApplicationJSON PlanText []
|
||||
--
|
||||
-- >>> decodeMediaType "application/vnd.pgrst.plan+json;for=\"text/csv\""
|
||||
-- MTPlan MTTextCSV PlanJSON []
|
||||
--
|
||||
-- >>> decodeMediaType "application/vnd.pgrst.array+json;nulls=stripped"
|
||||
-- MTArrayJSONStrip
|
||||
--
|
||||
-- >>> decodeMediaType "application/vnd.pgrst.array+json"
|
||||
-- MTApplicationJSON
|
||||
--
|
||||
-- >>> decodeMediaType "application/vnd.pgrst.object+json;nulls=stripped"
|
||||
-- MTSingularJSON True
|
||||
--
|
||||
-- >>> decodeMediaType "application/vnd.pgrst.object+json"
|
||||
-- MTSingularJSON False
|
||||
|
||||
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
|
||||
"application/json":_ -> MTApplicationJSON
|
||||
"application/geo+json":_ -> MTGeoJSON
|
||||
"text/csv":_ -> MTTextCSV
|
||||
"text/plain":_ -> MTTextPlain
|
||||
"text/xml":_ -> MTTextXML
|
||||
"application/openapi+json":_ -> MTOpenAPI
|
||||
"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
|
||||
"application/vnd.pgrst.object+json":rest -> checkSingularNullStrip rest
|
||||
"application/vnd.pgrst.object":rest -> checkSingularNullStrip rest
|
||||
"application/vnd.pgrst.array+json":rest -> checkArrayNullStrip rest
|
||||
"application/vnd.pgrst.array":rest -> checkArrayNullStrip 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" ]
|
||||
checkArrayNullStrip ["nulls=stripped"] = MTArrayJSONStrip
|
||||
checkArrayNullStrip _ = MTApplicationJSON
|
||||
|
||||
getMediaType :: MediaType -> MediaType
|
||||
getMediaType mt = case mt of
|
||||
MTPlan (MTPlanAttrs (Just mType) _ _) -> mType
|
||||
MTPlan (MTPlanAttrs Nothing _ _) -> MTApplicationJSON
|
||||
other -> other
|
||||
checkSingularNullStrip ["nulls=stripped"] = MTSingularJSON True
|
||||
checkSingularNullStrip _ = MTSingularJSON False
|
||||
|
||||
getPlan fmt rest =
|
||||
let
|
||||
opts = BS.split (BS.c2w '|') $ fromMaybe mempty (BS.stripPrefix "options=" =<< find (BS.isPrefixOf "options=") rest)
|
||||
inOpts str = str `elem` opts
|
||||
dropAround p = BS.dropWhile p . BS.dropWhileEnd p
|
||||
mtFor = fromMaybe MTApplicationJSON $ do
|
||||
foundFor <- find (BS.isPrefixOf "for=") rest
|
||||
strippedFor <- BS.stripPrefix "for=" foundFor
|
||||
pure . decodeMediaType $ dropAround (== BS.c2w '"') strippedFor
|
||||
in
|
||||
MTPlan mtFor fmt $
|
||||
[PlanAnalyze | inOpts "analyze" ] ++
|
||||
[PlanVerbose | inOpts "verbose" ] ++
|
||||
[PlanSettings | inOpts "settings"] ++
|
||||
[PlanBuffers | inOpts "buffers" ] ++
|
||||
[PlanWAL | inOpts "wal" ]
|
||||
|
||||
@@ -1,122 +0,0 @@
|
||||
{-|
|
||||
Module : PostgREST.Middleware
|
||||
Description : Sets CORS policy. Also the PostgreSQL GUCs, role, search_path and pre-request function.
|
||||
-}
|
||||
{-# LANGUAGE BlockArguments #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
module PostgREST.Middleware
|
||||
( runPgLocals
|
||||
, optionalRollback
|
||||
) where
|
||||
|
||||
import qualified Data.Aeson as JSON
|
||||
import qualified Data.Aeson.Key as K
|
||||
import qualified Data.Aeson.KeyMap as KM
|
||||
import qualified Data.ByteString.Lazy.Char8 as LBS
|
||||
import qualified Data.HashMap.Strict as HM
|
||||
import qualified Data.Text.Encoding as T
|
||||
import qualified Hasql.Decoders as HD
|
||||
import qualified Hasql.DynamicStatements.Snippet as SQL hiding (sql)
|
||||
import qualified Hasql.DynamicStatements.Statement as SQL
|
||||
import qualified Hasql.Transaction as SQL
|
||||
import qualified Network.Wai as Wai
|
||||
|
||||
|
||||
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.GucHeader (addHeadersIfNotIncluded)
|
||||
import PostgREST.Query.SqlFragment (fromQi, intercalateSnippet,
|
||||
pgFmtIdentList, unknownEncoder)
|
||||
import PostgREST.Request.ApiRequest (ApiRequest (..), Target (..))
|
||||
|
||||
import PostgREST.Request.Preferences
|
||||
|
||||
import Protolude
|
||||
|
||||
-- | Runs local(transaction scoped) GUCs for every request, plus the pre-request function
|
||||
runPgLocals :: AppConfig -> KM.KeyMap JSON.Value -> Text ->
|
||||
(ApiRequest -> ExceptT Error SQL.Transaction Wai.Response) ->
|
||||
ApiRequest -> ByteString -> PgVersion -> ExceptT Error SQL.Transaction Wai.Response
|
||||
runPgLocals conf claims role app req jsonDbS actualPgVersion = do
|
||||
lift $ SQL.statement mempty $ SQL.dynamicallyParameterized
|
||||
("select " <> intercalateSnippet ", " (searchPathSql : roleSql ++ claimsSql ++ [methodSql, pathSql] ++ headersSql ++ cookiesSql ++ appSettingsSql ++ specSql))
|
||||
HD.noResult (configDbPreparedStatements conf)
|
||||
lift $ traverse_ SQL.sql preReqSql
|
||||
app req
|
||||
where
|
||||
methodSql = setConfigLocal mempty ("request.method", iMethod req)
|
||||
pathSql = setConfigLocal mempty ("request.path", iPath req)
|
||||
headersSql = if usesLegacyGucs
|
||||
then setConfigLocal "request.header." <$> iHeaders req
|
||||
else setConfigLocalJson "request.headers" (iHeaders req)
|
||||
cookiesSql = if usesLegacyGucs
|
||||
then setConfigLocal "request.cookie." <$> iCookies req
|
||||
else setConfigLocalJson "request.cookies" (iCookies req)
|
||||
claimsSql = if usesLegacyGucs
|
||||
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 =
|
||||
let schemas = pgFmtIdentList (iSchema req : configDbExtraSearchPath conf) in
|
||||
setConfigLocal mempty ("search_path", schemas)
|
||||
preReqSql = (\f -> "select " <> fromQi f <> "();") <$> configDbPreRequest conf
|
||||
specSql = case iTarget req of
|
||||
TargetProc{tpIsRootSpec=True} -> [setConfigLocal mempty ("request.spec", jsonDbS)]
|
||||
_ -> mempty
|
||||
usesLegacyGucs = configDbUseLegacyGucs conf && actualPgVersion < pgVersion140
|
||||
|
||||
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 = T.decodeUtf8 . LBS.toStrict $ JSON.encode v
|
||||
|
||||
-- | Set a transaction to eventually roll back if requested and set respective
|
||||
-- headers on the response.
|
||||
optionalRollback
|
||||
:: AppConfig
|
||||
-> ApiRequest
|
||||
-> ExceptT Error SQL.Transaction Wai.Response
|
||||
-> ExceptT Error SQL.Transaction Wai.Response
|
||||
optionalRollback AppConfig{..} ApiRequest{..} transaction = do
|
||||
resp <- catchError transaction $ return . errorResponseFor
|
||||
when (shouldRollback || (configDbTxRollbackAll && not shouldCommit)) $ lift do
|
||||
SQL.sql "SET CONSTRAINTS ALL IMMEDIATE"
|
||||
SQL.condemn
|
||||
return $ Wai.mapResponseHeaders preferenceApplied resp
|
||||
where
|
||||
shouldCommit =
|
||||
configDbTxAllowOverride && iPreferTransaction == Just Commit
|
||||
shouldRollback =
|
||||
configDbTxAllowOverride && iPreferTransaction == Just Rollback
|
||||
preferenceApplied
|
||||
| shouldCommit =
|
||||
addHeadersIfNotIncluded
|
||||
[toAppliedHeader Commit]
|
||||
| shouldRollback =
|
||||
addHeadersIfNotIncluded
|
||||
[toAppliedHeader Rollback]
|
||||
| otherwise =
|
||||
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
|
||||
@@ -0,0 +1,872 @@
|
||||
{-|
|
||||
Module : PostgREST.Plan
|
||||
Description : PostgREST Request Planner
|
||||
|
||||
This module is in charge of building an intermediate
|
||||
representation between the HTTP request and the
|
||||
final resulting SQL query.
|
||||
|
||||
A query tree is built in case of resource embedding. By inferring the
|
||||
relationship between tables, join conditions are added for every embedded
|
||||
resource.
|
||||
-}
|
||||
{-# LANGUAGE DuplicateRecordFields #-}
|
||||
{-# LANGUAGE LambdaCase #-}
|
||||
{-# LANGUAGE NamedFieldPuns #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
|
||||
module PostgREST.Plan
|
||||
( wrappedReadPlan
|
||||
, mutateReadPlan
|
||||
, callReadPlan
|
||||
, WrappedReadPlan(..)
|
||||
, MutateReadPlan(..)
|
||||
, CallReadPlan(..)
|
||||
, inspectPlanTxMode
|
||||
) where
|
||||
|
||||
import qualified Data.ByteString.Lazy as LBS
|
||||
import qualified Data.HashMap.Strict as HM
|
||||
import qualified Data.HashMap.Strict.InsOrd as HMI
|
||||
import qualified Data.List as L
|
||||
import qualified Data.Set as S
|
||||
import qualified PostgREST.SchemaCache.Routine as Routine
|
||||
|
||||
import Data.Either.Combinators (mapLeft, mapRight)
|
||||
import Data.List (delete)
|
||||
import Data.Tree (Tree (..))
|
||||
|
||||
import PostgREST.ApiRequest (Action (..),
|
||||
ApiRequest (..),
|
||||
InvokeMethod (..),
|
||||
Mutation (..),
|
||||
Payload (..))
|
||||
import PostgREST.Config (AppConfig (..))
|
||||
import PostgREST.Error (Error (..))
|
||||
import PostgREST.MediaType (MediaType (..))
|
||||
import PostgREST.Query.SqlFragment (sourceCTEName)
|
||||
import PostgREST.RangeQuery (NonnegRange, allRange,
|
||||
convertToLimitZeroRange,
|
||||
restrictRange)
|
||||
import PostgREST.SchemaCache (SchemaCache (..))
|
||||
import PostgREST.SchemaCache.Identifiers (FieldName,
|
||||
QualifiedIdentifier (..),
|
||||
Schema)
|
||||
import PostgREST.SchemaCache.Relationship (Cardinality (..),
|
||||
Junction (..),
|
||||
Relationship (..),
|
||||
RelationshipsMap,
|
||||
relIsToOne)
|
||||
import PostgREST.SchemaCache.Representations (DataRepresentation (..),
|
||||
RepresentationsMap)
|
||||
import PostgREST.SchemaCache.Routine (ResultAggregate (..),
|
||||
Routine (..),
|
||||
RoutineMap,
|
||||
RoutineParam (..),
|
||||
funcReturnsCompositeAlias,
|
||||
funcReturnsScalar,
|
||||
funcReturnsSetOfScalar)
|
||||
import PostgREST.SchemaCache.Table (Column (..), Table (..),
|
||||
TablesMap,
|
||||
tableColumnsList,
|
||||
tablePKCols)
|
||||
|
||||
import PostgREST.ApiRequest.Preferences
|
||||
import PostgREST.ApiRequest.Types
|
||||
import PostgREST.Plan.CallPlan
|
||||
import PostgREST.Plan.MutatePlan
|
||||
import PostgREST.Plan.ReadPlan as ReadPlan
|
||||
import PostgREST.Plan.Types
|
||||
|
||||
import qualified Hasql.Transaction.Sessions as SQL
|
||||
import qualified PostgREST.ApiRequest.QueryParams as QueryParams
|
||||
|
||||
import Protolude hiding (from)
|
||||
|
||||
-- $setup
|
||||
-- Setup for doctests
|
||||
-- >>> import Data.Ranged.Ranges (fullRange)
|
||||
|
||||
data WrappedReadPlan = WrappedReadPlan {
|
||||
wrReadPlan :: ReadPlanTree
|
||||
, wrTxMode :: SQL.Mode
|
||||
, wrResAgg :: ResultAggregate
|
||||
}
|
||||
|
||||
data MutateReadPlan = MutateReadPlan {
|
||||
mrReadPlan :: ReadPlanTree
|
||||
, mrMutatePlan :: MutatePlan
|
||||
, mrTxMode :: SQL.Mode
|
||||
, mrResAgg :: ResultAggregate
|
||||
}
|
||||
|
||||
data CallReadPlan = CallReadPlan {
|
||||
crReadPlan :: ReadPlanTree
|
||||
, crCallPlan :: CallPlan
|
||||
, crTxMode :: SQL.Mode
|
||||
, crProc :: Routine
|
||||
, crResAgg :: ResultAggregate
|
||||
}
|
||||
|
||||
wrappedReadPlan :: QualifiedIdentifier -> AppConfig -> SchemaCache -> ApiRequest -> Either Error WrappedReadPlan
|
||||
wrappedReadPlan identifier conf sCache apiRequest = do
|
||||
rPlan <- readPlan identifier conf sCache apiRequest
|
||||
binField <- mapLeft ApiRequestError $ binaryField conf (iAcceptMediaType apiRequest) Nothing rPlan
|
||||
return $ WrappedReadPlan rPlan SQL.Read $ mediaToAggregate (iAcceptMediaType apiRequest) binField apiRequest
|
||||
|
||||
mutateReadPlan :: Mutation -> ApiRequest -> QualifiedIdentifier -> AppConfig -> SchemaCache -> Either Error MutateReadPlan
|
||||
mutateReadPlan mutation apiRequest identifier conf sCache = do
|
||||
rPlan <- readPlan identifier conf sCache apiRequest
|
||||
binField <- mapLeft ApiRequestError $ binaryField conf (iAcceptMediaType apiRequest) Nothing rPlan
|
||||
mPlan <- mutatePlan mutation identifier apiRequest sCache rPlan
|
||||
return $ MutateReadPlan rPlan mPlan SQL.Write $ mediaToAggregate (iAcceptMediaType apiRequest) binField apiRequest
|
||||
|
||||
callReadPlan :: QualifiedIdentifier -> AppConfig -> SchemaCache -> ApiRequest -> InvokeMethod -> Either Error CallReadPlan
|
||||
callReadPlan identifier conf sCache apiRequest invMethod = do
|
||||
let paramKeys = case invMethod of
|
||||
InvGet -> S.fromList $ fst <$> qsParams'
|
||||
InvHead -> S.fromList $ fst <$> qsParams'
|
||||
InvPost -> iColumns apiRequest
|
||||
proc@Function{..} <- mapLeft ApiRequestError $
|
||||
findProc identifier paramKeys (preferParameters == Just SingleObject) (dbRoutines sCache) (iContentMediaType apiRequest) (invMethod == InvPost)
|
||||
let relIdentifier = QualifiedIdentifier pdSchema (fromMaybe pdName $ Routine.funcTableName proc) -- done so a set returning function can embed other relations
|
||||
rPlan <- readPlan relIdentifier conf sCache apiRequest
|
||||
let args = case (invMethod, iContentMediaType apiRequest) of
|
||||
(InvGet, _) -> jsonRpcParams proc qsParams'
|
||||
(InvHead, _) -> jsonRpcParams proc qsParams'
|
||||
(InvPost, MTUrlEncoded) -> maybe mempty (jsonRpcParams proc . payArray) $ iPayload apiRequest
|
||||
(InvPost, _) -> maybe mempty payRaw $ iPayload apiRequest
|
||||
txMode = case (invMethod, pdVolatility) of
|
||||
(InvGet, _) -> SQL.Read
|
||||
(InvHead, _) -> SQL.Read
|
||||
(InvPost, Routine.Stable) -> SQL.Read
|
||||
(InvPost, Routine.Immutable) -> SQL.Read
|
||||
(InvPost, Routine.Volatile) -> SQL.Write
|
||||
cPlan = callPlan proc apiRequest paramKeys args rPlan
|
||||
binField <- mapLeft ApiRequestError $ binaryField conf (iAcceptMediaType apiRequest) (Just proc) rPlan
|
||||
return $ CallReadPlan rPlan cPlan txMode proc $ mediaToAggregate (iAcceptMediaType apiRequest) binField apiRequest
|
||||
where
|
||||
Preferences{..} = iPreferences apiRequest
|
||||
qsParams' = QueryParams.qsParams (iQueryParams apiRequest)
|
||||
|
||||
{-|
|
||||
Search a pg proc by matching name and arguments keys to parameters. Since a function can be overloaded,
|
||||
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 -> RoutineMap -> MediaType -> Bool -> Either ApiRequestError Routine
|
||||
findProc qi argumentsKeys paramsAsSingleObject allProcs contentMediaType isInvPost =
|
||||
case matchProc of
|
||||
([], []) -> Left $ NoRpc (qiSchema qi) (qiName qi) (S.toList argumentsKeys) paramsAsSingleObject contentMediaType isInvPost (HM.keys allProcs) lookupProcName
|
||||
-- If there are no functions with named arguments, fallback to the single unnamed argument function
|
||||
([], [proc]) -> Right proc
|
||||
([], procs) -> Left $ AmbiguousRpc (toList procs)
|
||||
-- Matches the functions with named arguments
|
||||
([proc], _) -> Right proc
|
||||
(procs, _) -> Left $ AmbiguousRpc (toList procs)
|
||||
where
|
||||
matchProc = overloadedProcPartition lookupProcName
|
||||
-- First find the proc by name
|
||||
lookupProcName = HM.lookupDefault mempty qi allProcs
|
||||
-- The partition obtained has the form (overloadedProcs,fallbackProcs)
|
||||
-- where fallbackProcs are functions with a single unnamed parameter
|
||||
overloadedProcPartition = foldr select ([],[])
|
||||
select proc ~(ts,fs)
|
||||
| matchesParams proc = (proc:ts,fs)
|
||||
| hasSingleUnnamedParam proc = (ts,proc:fs)
|
||||
| otherwise = (ts,fs)
|
||||
-- If the function is called with post and has a single unnamed parameter
|
||||
-- it can be called depending on content type and the parameter type
|
||||
hasSingleUnnamedParam Function{pdParams=[RoutineParam{ppType}]} = isInvPost && case (contentMediaType, ppType) of
|
||||
(MTApplicationJSON, "json") -> True
|
||||
(MTApplicationJSON, "jsonb") -> True
|
||||
(MTTextPlain, "text") -> True
|
||||
(MTTextXML, "xml") -> True
|
||||
(MTOctetStream, "bytea") -> True
|
||||
_ -> False
|
||||
hasSingleUnnamedParam _ = False
|
||||
matchesParams proc =
|
||||
let
|
||||
params = pdParams proc
|
||||
firstType = (ppType <$> headMay params)
|
||||
in
|
||||
-- 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)
|
||||
|
||||
inspectPlanTxMode :: SQL.Mode
|
||||
inspectPlanTxMode = SQL.Read
|
||||
|
||||
-- | During planning we need to resolve Field -> CoercibleField (finding the context specific target type and map function).
|
||||
-- | ResolverContext facilitates this without the need to pass around a laundry list of parameters.
|
||||
data ResolverContext = ResolverContext
|
||||
{ tables :: TablesMap
|
||||
, representations :: RepresentationsMap
|
||||
, qi :: QualifiedIdentifier -- ^ The table we're currently attending; changes as we recurse into joins etc.
|
||||
, outputType :: Text -- ^ The output type for the response payload; e.g. "csv", "json", "binary".
|
||||
}
|
||||
|
||||
resolveColumnField :: Column -> CoercibleField
|
||||
resolveColumnField col = CoercibleField (colName col) mempty False (colNominalType col) Nothing (colDefault col)
|
||||
|
||||
resolveTableFieldName :: Table -> FieldName -> CoercibleField
|
||||
resolveTableFieldName table fieldName =
|
||||
fromMaybe (unknownField fieldName []) $ HMI.lookup fieldName (tableColumns table) >>=
|
||||
Just . resolveColumnField
|
||||
|
||||
-- | Resolve a type within the context based on the given field name and JSON path. Although there are situations where failure to resolve a field is considered an error (see `resolveOrError`), there are also situations where we allow it (RPC calls). If it should be an error and `resolveOrError` doesn't fit, ensure to check the `cfIRType` isn't empty.
|
||||
resolveTypeOrUnknown :: ResolverContext -> Field -> CoercibleField
|
||||
resolveTypeOrUnknown ResolverContext{..} (fn, jp) =
|
||||
case res of
|
||||
-- types that are already json/jsonb don't need to be converted with `to_jsonb` for using arrow operators `data->attr`
|
||||
-- this prevents indexes not applying https://github.com/PostgREST/postgrest/issues/2594
|
||||
cf@CoercibleField{cfIRType="json"} -> cf{cfJsonPath=jp, cfToJson=False}
|
||||
cf@CoercibleField{cfIRType="jsonb"} -> cf{cfJsonPath=jp, cfToJson=False}
|
||||
-- other types will get converted `to_jsonb(col)->attr`, even unknown types
|
||||
cf -> cf{cfJsonPath=jp, cfToJson=True}
|
||||
where
|
||||
res = fromMaybe (unknownField fn jp) $ HM.lookup qi tables >>=
|
||||
Just . flip resolveTableFieldName fn
|
||||
|
||||
-- | Install any pre-defined data representation from source to target to coerce this reference.
|
||||
--
|
||||
-- Note that we change the IR type here. This might seem unintuitive. The short of it is that for a CoercibleField without a transformer, input type == output type. A transformer maps from a -> b, so by definition the input type will be a and the output type b after. And cfIRType is the *input* type.
|
||||
--
|
||||
-- It might feel odd that once a transformer is added we 'forget' the target type (because now a /= b). You might also note there's no obvious way to stack transforms (even if there was a stack, you erased what type you're working with so it's awkward). Alas as satisfying as it would be to engineer a layered mapping system with full type information, we just don't need it.
|
||||
withTransformer :: ResolverContext -> Text -> Text -> CoercibleField -> CoercibleField
|
||||
withTransformer ResolverContext{representations} sourceType targetType field =
|
||||
fromMaybe field $ HM.lookup (sourceType, targetType) representations >>=
|
||||
(\fieldRepresentation -> Just field{cfIRType=sourceType, cfTransform=Just (drFunction fieldRepresentation)})
|
||||
|
||||
-- | Map the intermediate representation type to the output type, if available.
|
||||
withOutputFormat :: ResolverContext -> CoercibleField -> CoercibleField
|
||||
withOutputFormat ctx@ResolverContext{outputType} field@CoercibleField{cfIRType} = withTransformer ctx cfIRType outputType field
|
||||
|
||||
-- | Map text into the intermediate representation type, if available.
|
||||
withTextParse :: ResolverContext -> CoercibleField -> CoercibleField
|
||||
withTextParse ctx field@CoercibleField{cfIRType} = withTransformer ctx "text" cfIRType field
|
||||
|
||||
-- | Map json into the intermediate representation type, if available.
|
||||
withJsonParse :: ResolverContext -> CoercibleField -> CoercibleField
|
||||
withJsonParse ctx field@CoercibleField{cfIRType} = withTransformer ctx "json" cfIRType field
|
||||
|
||||
-- | Map the intermediate representation type to the output type defined by the resolver context (normally json), if available.
|
||||
resolveOutputField :: ResolverContext -> Field -> CoercibleField
|
||||
resolveOutputField ctx field = withOutputFormat ctx $ resolveTypeOrUnknown ctx field
|
||||
|
||||
-- | Map the query string format of a value (text) into the intermediate representation type, if available.
|
||||
resolveQueryInputField :: ResolverContext -> Field -> CoercibleField
|
||||
resolveQueryInputField ctx field = withTextParse ctx $ resolveTypeOrUnknown ctx field
|
||||
|
||||
-- | Builds the ReadPlan tree on a number of stages.
|
||||
-- | Adds filters, order, limits on its respective nodes.
|
||||
-- | Adds joins conditions obtained from resource embedding.
|
||||
readPlan :: QualifiedIdentifier -> AppConfig -> SchemaCache -> ApiRequest -> Either Error ReadPlanTree
|
||||
readPlan qi@QualifiedIdentifier{..} AppConfig{configDbMaxRows} SchemaCache{dbTables, dbRelationships, dbRepresentations} apiRequest =
|
||||
let
|
||||
-- JSON output format hardcoded for now. In the future we might want to support other output mappings such as CSV.
|
||||
ctx = ResolverContext dbTables dbRepresentations qi "json"
|
||||
in
|
||||
mapLeft ApiRequestError $
|
||||
treeRestrictRange configDbMaxRows (iAction apiRequest) =<<
|
||||
addNullEmbedFilters =<<
|
||||
validateSpreadEmbeds =<<
|
||||
addRelatedOrders =<<
|
||||
addDataRepresentationAliases =<<
|
||||
expandStarsForDataRepresentations ctx =<<
|
||||
addRels qiSchema (iAction apiRequest) dbRelationships Nothing =<<
|
||||
addLogicTrees ctx apiRequest =<<
|
||||
addRanges apiRequest =<<
|
||||
addOrders ctx apiRequest =<<
|
||||
addFilters ctx apiRequest (initReadRequest ctx $ QueryParams.qsSelect $ iQueryParams apiRequest)
|
||||
|
||||
-- Build the initial read plan tree
|
||||
initReadRequest :: ResolverContext -> [Tree SelectItem] -> ReadPlanTree
|
||||
initReadRequest ctx@ResolverContext{qi=QualifiedIdentifier{..}} =
|
||||
foldr (treeEntry rootDepth) $ Node defReadPlan{from=qi ctx, relName=qiName, depth=rootDepth} []
|
||||
where
|
||||
rootDepth = 0
|
||||
defReadPlan = ReadPlan [] (QualifiedIdentifier mempty mempty) Nothing [] [] allRange mempty Nothing [] Nothing mempty Nothing Nothing False rootDepth
|
||||
treeEntry :: Depth -> Tree SelectItem -> ReadPlanTree -> ReadPlanTree
|
||||
treeEntry depth (Node si fldForest) (Node q rForest) =
|
||||
let nxtDepth = succ depth in
|
||||
case si of
|
||||
SelectRelation{..} ->
|
||||
Node q $
|
||||
foldr (treeEntry nxtDepth)
|
||||
(Node defReadPlan{from=QualifiedIdentifier qiSchema selRelation, relName=selRelation, relAlias=selAlias, relHint=selHint, relJoinType=selJoinType, depth=nxtDepth} [])
|
||||
fldForest:rForest
|
||||
SpreadRelation{..} ->
|
||||
Node q $
|
||||
foldr (treeEntry nxtDepth)
|
||||
(Node defReadPlan{from=QualifiedIdentifier qiSchema selRelation, relName=selRelation, relHint=selHint, relJoinType=selJoinType, depth=nxtDepth, relIsSpread=True} [])
|
||||
fldForest:rForest
|
||||
SelectField{..} ->
|
||||
Node q{select=(resolveOutputField ctx{qi=from q} selField, selCast, selAlias):select q} rForest
|
||||
|
||||
-- | Preserve the original field name if data representation is used to coerce the value.
|
||||
addDataRepresentationAliases :: ReadPlanTree -> Either ApiRequestError ReadPlanTree
|
||||
addDataRepresentationAliases rPlanTree = Right $ fmap (\rPlan@ReadPlan{select=sel} -> rPlan{select=map aliasSelectItem sel}) rPlanTree
|
||||
where
|
||||
aliasSelectItem :: (CoercibleField, Maybe Cast, Maybe Alias) -> (CoercibleField, Maybe Cast, Maybe Alias)
|
||||
-- If there already is an alias, don't overwrite it.
|
||||
aliasSelectItem (fld@(CoercibleField{cfName=fieldName, cfTransform=(Just _)}), Nothing, Nothing) = (fld, Nothing, Just fieldName)
|
||||
aliasSelectItem fld = fld
|
||||
|
||||
knownColumnsInContext :: ResolverContext -> [Column]
|
||||
knownColumnsInContext ResolverContext{..} =
|
||||
fromMaybe [] $ HM.lookup qi tables >>=
|
||||
Just . tableColumnsList
|
||||
|
||||
-- | Expand "select *" into explicit field names of the table, if necessary to apply data representations.
|
||||
expandStarsForDataRepresentations :: ResolverContext -> ReadPlanTree -> Either ApiRequestError ReadPlanTree
|
||||
expandStarsForDataRepresentations ctx@ResolverContext{qi} rPlanTree = Right $ fmap expandStars rPlanTree
|
||||
where
|
||||
expandStars :: ReadPlan -> ReadPlan
|
||||
-- When the schema is "" and the table is the source CTE, we assume the true source table is given in the from
|
||||
-- alias and belongs to the request schema. See the bit in `addRels` with `newFrom = ...`.
|
||||
expandStars rPlan@ReadPlan{from=(QualifiedIdentifier "" "pgrst_source"), fromAlias=(Just tblAlias)} =
|
||||
expandStarsForTable ctx{qi=qi{qiName=tblAlias}} rPlan
|
||||
expandStars rPlan@ReadPlan{from=fromTable} =
|
||||
expandStarsForTable ctx{qi=fromTable} rPlan
|
||||
|
||||
expandStarsForTable :: ResolverContext -> ReadPlan -> ReadPlan
|
||||
expandStarsForTable ctx@ResolverContext{representations, outputType} rplan@ReadPlan{select=selectItems} =
|
||||
-- If we have a '*' select AND the target table has at least one data representation, expand.
|
||||
if ("*" `elem` map (\(field, _, _) -> cfName field) selectItems) && any hasOutputRep knownColumns
|
||||
then rplan{select=concatMap (expandStarSelectItem knownColumns) selectItems}
|
||||
else rplan
|
||||
where
|
||||
knownColumns = knownColumnsInContext ctx
|
||||
|
||||
hasOutputRep :: Column -> Bool
|
||||
hasOutputRep col = HM.member (colNominalType col, outputType) representations
|
||||
|
||||
expandStarSelectItem :: [Column] -> (CoercibleField, Maybe Cast, Maybe Alias) -> [(CoercibleField, Maybe Cast, Maybe Alias)]
|
||||
expandStarSelectItem columns (CoercibleField{cfName="*", cfJsonPath=[]}, b, c) = map (\col -> (withOutputFormat ctx $ resolveColumnField col, b, c)) columns
|
||||
expandStarSelectItem _ selectItem = [selectItem]
|
||||
|
||||
-- | Enforces the `max-rows` config on the result
|
||||
treeRestrictRange :: Maybe Integer -> Action -> ReadPlanTree -> Either ApiRequestError ReadPlanTree
|
||||
treeRestrictRange _ (ActionMutate _) request = Right request
|
||||
treeRestrictRange maxRows _ request = pure $ nodeRestrictRange maxRows <$> request
|
||||
where
|
||||
nodeRestrictRange :: Maybe Integer -> ReadPlan -> ReadPlan
|
||||
nodeRestrictRange m q@ReadPlan{range_=r} = q{range_= convertToLimitZeroRange r (restrictRange m r) }
|
||||
|
||||
-- add relationships to the nodes of the tree by traversing the forest while keeping track of the parentNode(https://stackoverflow.com/questions/22721064/get-the-parent-of-a-node-in-data-tree-haskell#comment34627048_22721064)
|
||||
-- also adds aliasing
|
||||
addRels :: Schema -> Action -> RelationshipsMap -> Maybe ReadPlanTree -> ReadPlanTree -> Either ApiRequestError ReadPlanTree
|
||||
addRels schema action allRels parentNode (Node rPlan@ReadPlan{relName,relHint,relAlias,depth} forest) =
|
||||
case parentNode of
|
||||
Just (Node ReadPlan{from=parentNodeQi, fromAlias=parentAlias} _) ->
|
||||
let
|
||||
newReadPlan = (\r ->
|
||||
let newAlias = Just (qiName (relForeignTable r) <> "_" <> show depth)
|
||||
aggAlias = qiName (relTable r) <> "_" <> fromMaybe relName relAlias <> "_" <> show depth in
|
||||
case r of
|
||||
Relationship{relCardinality=M2M _} -> -- m2m does internal implicit joins that don't need aliasing
|
||||
rPlan{from=relForeignTable r, relToParent=Just r, relAggAlias=aggAlias, relJoinConds=getJoinConditions Nothing parentAlias r}
|
||||
ComputedRelationship{} ->
|
||||
rPlan{from=relForeignTable r, relToParent=Just r{relTableAlias=maybe (relTable r) (QualifiedIdentifier mempty) parentAlias}, relAggAlias=aggAlias, fromAlias=newAlias}
|
||||
_ ->
|
||||
rPlan{from=relForeignTable r, relToParent=Just r, relAggAlias=aggAlias, fromAlias=newAlias, relJoinConds=getJoinConditions newAlias parentAlias r}
|
||||
) <$> 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) parentAlias
|
||||
else qiName parentNodeQi
|
||||
rel = findRel schema allRels origin relName relHint
|
||||
in
|
||||
Node <$> newReadPlan <*> (updateForest . hush $ Node <$> newReadPlan <*> pure forest)
|
||||
Nothing -> -- root case
|
||||
let
|
||||
newFrom = QualifiedIdentifier mempty sourceCTEName
|
||||
newAlias = Just (qiName $ from rPlan)
|
||||
newReadPlan = case action of
|
||||
-- the CTE for mutations/rpc is used as WITH sourceCTEName .. SELECT .. FROM sourceCTEName as alias,
|
||||
-- we use the table name as an alias so findRel can find the right relationship.
|
||||
ActionMutate _ -> rPlan{from=newFrom, fromAlias=newAlias}
|
||||
ActionInvoke _ -> rPlan{from=newFrom, fromAlias=newAlias}
|
||||
_ -> rPlan
|
||||
in
|
||||
Node newReadPlan <$> updateForest (Just $ Node newReadPlan forest)
|
||||
where
|
||||
updateForest :: Maybe ReadPlanTree -> Either ApiRequestError [ReadPlanTree]
|
||||
updateForest rq = addRels schema action allRels rq `traverse` forest
|
||||
|
||||
getJoinConditions :: Maybe Alias -> Maybe Alias -> Relationship -> [JoinCondition]
|
||||
getJoinConditions _ _ ComputedRelationship{} = []
|
||||
getJoinConditions tblAlias parentAlias Relationship{relTable=qi,relForeignTable=fQi,relCardinality=card} =
|
||||
case card of
|
||||
M2M (Junction QualifiedIdentifier{qiName=jtn} _ _ jcols1 jcols2) ->
|
||||
(toJoinCondition Nothing Nothing ftN jtn <$> jcols2) ++ (toJoinCondition parentAlias tblAlias tN jtn <$> jcols1)
|
||||
O2M _ cols ->
|
||||
toJoinCondition parentAlias tblAlias tN ftN <$> cols
|
||||
M2O _ cols ->
|
||||
toJoinCondition parentAlias tblAlias tN ftN <$> cols
|
||||
O2O _ cols ->
|
||||
toJoinCondition parentAlias tblAlias tN ftN <$> cols
|
||||
where
|
||||
QualifiedIdentifier{qiSchema=tSchema, qiName=tN} = qi
|
||||
QualifiedIdentifier{qiName=ftN} = fQi
|
||||
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:
|
||||
-- /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
|
||||
-- be disambiguated by adding precision to the target or by using a hint:
|
||||
-- /origin?select=target!hint(*). The origin can be a table or view.
|
||||
findRel :: Schema -> RelationshipsMap -> NodeName -> NodeName -> Maybe Hint -> Either ApiRequestError Relationship
|
||||
findRel schema allRels origin target hint =
|
||||
case rels of
|
||||
[] -> Left $ NoRelBetween origin target hint schema allRels
|
||||
[r] -> Right r
|
||||
rs -> Left $ AmbiguousRelBetween origin target rs
|
||||
where
|
||||
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
|
||||
O2M cons _ -> tar == cons
|
||||
M2O cons _ -> tar == cons
|
||||
O2O cons _ -> tar == cons
|
||||
_ -> False
|
||||
matchJunction hint_ card = case card of
|
||||
M2M Junction{junTable} -> hint_ == qiName junTable
|
||||
_ -> False
|
||||
isM2O card = case card of
|
||||
M2O _ _ -> True
|
||||
_ -> False
|
||||
isO2M card = case card of
|
||||
O2M _ _ -> True
|
||||
_ -> False
|
||||
rels = filter (\case
|
||||
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
|
||||
-- DEPRECATED(remove after 2 major releases since v11.1.0): remove target
|
||||
-- target = table / view / constraint / column-from-origin (constraint/column-from-origin can only come from tables https://github.com/PostgREST/postgrest/issues/2277)
|
||||
-- DEPRECATED(remove after 2 major releases since v11.1.0): remove hint as table/view/columns and only leave it as constraint
|
||||
-- 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=clients!client_id(*) or /projects?select=clients!id(*)
|
||||
matchFKSingleCol hnt relCardinality || -- client_id
|
||||
matchFKRefSingleCol hnt relCardinality || -- id
|
||||
|
||||
-- /users?select=tasks!users_tasks(*) many-to-many between users and tasks
|
||||
matchJunction hnt relCardinality -- users_tasks
|
||||
)
|
||||
) $ fromMaybe mempty $ HM.lookup (QualifiedIdentifier schema origin, schema) allRels
|
||||
|
||||
addFilters :: ResolverContext -> ApiRequest -> ReadPlanTree -> Either ApiRequestError ReadPlanTree
|
||||
addFilters ctx ApiRequest{..} rReq =
|
||||
foldr addFilterToNode (Right rReq) flts
|
||||
where
|
||||
QueryParams.QueryParams{..} = iQueryParams
|
||||
flts =
|
||||
case iAction of
|
||||
ActionInvoke _ -> qsFilters
|
||||
ActionRead _ -> qsFilters
|
||||
_ -> qsFiltersNotRoot
|
||||
|
||||
addFilterToNode :: (EmbedPath, Filter) -> Either ApiRequestError ReadPlanTree -> Either ApiRequestError ReadPlanTree
|
||||
addFilterToNode =
|
||||
updateNode (\flt (Node q@ReadPlan{from=fromTable, where_=lf} f) -> Node q{ReadPlan.where_=addFilterToLogicForest (resolveFilter ctx{qi=fromTable} flt) lf} f)
|
||||
|
||||
addOrders :: ResolverContext -> ApiRequest -> ReadPlanTree -> Either ApiRequestError ReadPlanTree
|
||||
addOrders ctx ApiRequest{..} rReq =
|
||||
case iAction of
|
||||
ActionMutate _ -> Right rReq
|
||||
_ -> foldr addOrderToNode (Right rReq) qsOrder
|
||||
where
|
||||
QueryParams.QueryParams{..} = iQueryParams
|
||||
|
||||
addOrderToNode :: (EmbedPath, [OrderTerm]) -> Either ApiRequestError ReadPlanTree -> Either ApiRequestError ReadPlanTree
|
||||
addOrderToNode = updateNode (\o (Node q f) -> Node q{order=resolveOrder ctx <$> o} f)
|
||||
|
||||
resolveOrder :: ResolverContext -> OrderTerm -> CoercibleOrderTerm
|
||||
resolveOrder _ (OrderRelationTerm a b c d) = CoercibleOrderRelationTerm a b c d
|
||||
resolveOrder ctx (OrderTerm fld dir nulls) = CoercibleOrderTerm (resolveTypeOrUnknown ctx fld) dir nulls
|
||||
|
||||
-- Validates that the related resource on the order is an embedded resource,
|
||||
-- e.g. if `clients` is inside the `select` in /projects?order=clients(id)&select=*,clients(*),
|
||||
-- and if it's a to-one relationship, it adds the right alias to the OrderRelationTerm so the generated query can succeed.
|
||||
addRelatedOrders :: ReadPlanTree -> Either ApiRequestError ReadPlanTree
|
||||
addRelatedOrders (Node rp@ReadPlan{order,from} forest) = do
|
||||
newOrder <- newRelOrder `traverse` order
|
||||
Node rp{order=newOrder} <$> addRelatedOrders `traverse` forest
|
||||
where
|
||||
newRelOrder cot@CoercibleOrderTerm{} = Right cot
|
||||
newRelOrder cot@CoercibleOrderRelationTerm{coRelation} =
|
||||
let foundRP = rootLabel <$> find (\(Node ReadPlan{relName, relAlias} _) -> coRelation == fromMaybe relName relAlias) forest in
|
||||
case foundRP of
|
||||
Just ReadPlan{relName,relAlias,relAggAlias,relToParent} ->
|
||||
let isToOne = relIsToOne <$> relToParent
|
||||
name = fromMaybe relName relAlias in
|
||||
if isToOne == Just True
|
||||
then Right $ cot{coRelation=relAggAlias}
|
||||
else Left $ RelatedOrderNotToOne (qiName from) name
|
||||
Nothing ->
|
||||
Left $ NotEmbedded coRelation
|
||||
|
||||
-- | Searches for null filters on embeds, e.g. `projects=not.is.null` on `GET /clients?select=*,projects(*)&projects=not.is.null`
|
||||
--
|
||||
-- (It doesn't err but uses an Either ApiRequestError type so it can combine with the other functions that modify the read plan tree)
|
||||
--
|
||||
-- Setup:
|
||||
--
|
||||
-- >>> let nullOp = OpExpr True (Is TriNull)
|
||||
-- >>> let nonNullOp = OpExpr False (Is TriNull)
|
||||
-- >>> let notEqOp = OpExpr True (Op OpNotEqual "val")
|
||||
-- >>> :{
|
||||
-- -- this represents the `projects(*)` part on `/clients?select=*,projects(*)`
|
||||
-- let
|
||||
-- subForestPlan =
|
||||
-- [
|
||||
-- Node {
|
||||
-- rootLabel = ReadPlan {
|
||||
-- select = [], -- there will be fields at this stage but we just omit them for brevity
|
||||
-- from = QualifiedIdentifier {qiSchema = "test", qiName = "projects"},
|
||||
-- fromAlias = Just "projects_1", where_ = [], order = [], range_ = fullRange,
|
||||
-- relName = "projects",
|
||||
-- relToParent = Nothing,
|
||||
-- relJoinConds = [],
|
||||
-- relAlias = Nothing, relAggAlias = "clients_projects_1", relHint = Nothing, relJoinType = Nothing, relIsSpread = False, depth = 1
|
||||
-- },
|
||||
-- subForest = []
|
||||
-- }
|
||||
-- ]
|
||||
-- :}
|
||||
--
|
||||
-- >>> :{
|
||||
-- -- this represents the full URL `/clients?select=*,projects(*)&projects=not.is.null`, if subForst takes the above subForestPlan and nullOp
|
||||
-- let
|
||||
-- readPlanTree op subForst =
|
||||
-- Node {
|
||||
-- rootLabel = ReadPlan {
|
||||
-- select = [], -- there will be fields at this stage but we just omit them for brevity
|
||||
-- from = QualifiedIdentifier { qiSchema = "test", qiName = "clients"},
|
||||
-- fromAlias = Nothing,
|
||||
-- where_ = [
|
||||
-- CoercibleStmnt (
|
||||
-- CoercibleFilter {
|
||||
-- field = CoercibleField {cfName = "projects", cfJsonPath = [], cfToJson=False, cfIRType = "", cfTransform = Nothing, cfDefault = Nothing},
|
||||
-- opExpr = op
|
||||
-- }
|
||||
-- )
|
||||
-- ],
|
||||
-- order = [], range_ = fullRange, relName = "clients", relToParent = Nothing, relJoinConds = [], relAlias = Nothing, relAggAlias = "", relHint = Nothing,
|
||||
-- relJoinType = Nothing, relIsSpread = False, depth = 0
|
||||
-- },
|
||||
-- subForest = subForst
|
||||
-- }
|
||||
-- :}
|
||||
--
|
||||
-- Don't do anything to the filter if there's no embedding (a subtree) on projects. Assume it's a normal filter.
|
||||
--
|
||||
-- >>> ReadPlan.where_ . rootLabel <$> addNullEmbedFilters (readPlanTree nullOp [])
|
||||
-- Right [CoercibleStmnt (CoercibleFilter {field = CoercibleField {cfName = "projects", cfJsonPath = [], cfToJson = False, cfIRType = "", cfTransform = Nothing, cfDefault = Nothing}, opExpr = OpExpr True (Is TriNull)})]
|
||||
--
|
||||
-- If there's an embedding on projects, then change the filter to use the internal aggregate name (`clients_projects_1`) so the filter can succeed later.
|
||||
--
|
||||
-- >>> ReadPlan.where_ . rootLabel <$> addNullEmbedFilters (readPlanTree nullOp subForestPlan)
|
||||
-- Right [CoercibleStmnt (CoercibleFilterNullEmbed True "clients_projects_1")]
|
||||
--
|
||||
-- >>> ReadPlan.where_ . rootLabel <$> addNullEmbedFilters (readPlanTree nonNullOp subForestPlan)
|
||||
-- Right [CoercibleStmnt (CoercibleFilterNullEmbed False "clients_projects_1")]
|
||||
addNullEmbedFilters :: ReadPlanTree -> Either ApiRequestError ReadPlanTree
|
||||
addNullEmbedFilters (Node rp@ReadPlan{where_=curLogic} forest) = do
|
||||
let forestReadPlans = rootLabel <$> forest
|
||||
newLogic <- newNullFilters forestReadPlans `traverse` curLogic
|
||||
Node rp{ReadPlan.where_= newLogic} <$> (addNullEmbedFilters `traverse` forest)
|
||||
where
|
||||
newNullFilters :: [ReadPlan] -> CoercibleLogicTree -> Either ApiRequestError CoercibleLogicTree
|
||||
newNullFilters rPlans = \case
|
||||
(CoercibleExpr b lOp trees) ->
|
||||
CoercibleExpr b lOp <$> (newNullFilters rPlans `traverse` trees)
|
||||
flt@(CoercibleStmnt (CoercibleFilter (CoercibleField fld [] _ _ _ _) opExpr)) ->
|
||||
let foundRP = find (\ReadPlan{relName, relAlias} -> fld == fromMaybe relName relAlias) rPlans in
|
||||
case (foundRP, opExpr) of
|
||||
(Just ReadPlan{relAggAlias}, OpExpr b (Is TriNull)) -> Right $ CoercibleStmnt $ CoercibleFilterNullEmbed b relAggAlias
|
||||
_ -> Right flt
|
||||
flt@(CoercibleStmnt _) ->
|
||||
Right flt
|
||||
|
||||
addRanges :: ApiRequest -> ReadPlanTree -> Either ApiRequestError ReadPlanTree
|
||||
addRanges ApiRequest{..} rReq =
|
||||
case iAction of
|
||||
ActionMutate _ -> Right rReq
|
||||
_ -> foldr addRangeToNode (Right rReq) =<< ranges
|
||||
where
|
||||
ranges :: Either ApiRequestError [(EmbedPath, NonnegRange)]
|
||||
ranges = first QueryParamError $ QueryParams.pRequestRange `traverse` HM.toList iRange
|
||||
|
||||
addRangeToNode :: (EmbedPath, NonnegRange) -> Either ApiRequestError ReadPlanTree -> Either ApiRequestError ReadPlanTree
|
||||
addRangeToNode = updateNode (\r (Node q f) -> Node q{range_=r} f)
|
||||
|
||||
addLogicTrees :: ResolverContext -> ApiRequest -> ReadPlanTree -> Either ApiRequestError ReadPlanTree
|
||||
addLogicTrees ctx ApiRequest{..} rReq =
|
||||
foldr addLogicTreeToNode (Right rReq) qsLogic
|
||||
where
|
||||
QueryParams.QueryParams{..} = iQueryParams
|
||||
|
||||
addLogicTreeToNode :: (EmbedPath, LogicTree) -> Either ApiRequestError ReadPlanTree -> Either ApiRequestError ReadPlanTree
|
||||
addLogicTreeToNode = updateNode (\t (Node q@ReadPlan{from=fromTable, where_=lf} f) -> Node q{ReadPlan.where_=resolveLogicTree ctx{qi=fromTable} t:lf} f)
|
||||
|
||||
resolveLogicTree :: ResolverContext -> LogicTree -> CoercibleLogicTree
|
||||
resolveLogicTree ctx (Stmnt flt) = CoercibleStmnt $ resolveFilter ctx flt
|
||||
resolveLogicTree ctx (Expr b op lts) = CoercibleExpr b op (map (resolveLogicTree ctx) lts)
|
||||
|
||||
resolveFilter :: ResolverContext -> Filter -> CoercibleFilter
|
||||
resolveFilter ctx (Filter fld opExpr) = CoercibleFilter{field=resolveQueryInputField ctx fld, opExpr=opExpr}
|
||||
|
||||
-- Validates that spread embeds are only done on to-one relationships
|
||||
validateSpreadEmbeds :: ReadPlanTree -> Either ApiRequestError ReadPlanTree
|
||||
validateSpreadEmbeds (Node rp@ReadPlan{relToParent=Nothing} forest) = Node rp <$> validateSpreadEmbeds `traverse` forest
|
||||
validateSpreadEmbeds (Node rp@ReadPlan{relIsSpread,relToParent=Just rel,relName} forest) = do
|
||||
validRP <- if relIsSpread && not (relIsToOne rel)
|
||||
then Left $ SpreadNotToOne (qiName $ relTable rel) relName -- TODO using relTable is not entirely right because ReadPlan might have an alias, need to store the parent alias on ReadPlan
|
||||
else Right rp
|
||||
Node validRP <$> validateSpreadEmbeds `traverse` forest
|
||||
|
||||
-- Find a Node of the Tree and apply a function to it
|
||||
updateNode :: (a -> ReadPlanTree -> ReadPlanTree) -> (EmbedPath, a) -> Either ApiRequestError ReadPlanTree -> Either ApiRequestError ReadPlanTree
|
||||
updateNode f ([], a) rr = f a <$> rr
|
||||
updateNode _ _ (Left e) = Left e
|
||||
updateNode f (targetNodeName:remainingPath, a) (Right (Node rootNode forest)) =
|
||||
case findNode of
|
||||
Nothing -> Left $ NotEmbedded targetNodeName
|
||||
Just target ->
|
||||
(\node -> Node rootNode $ node : delete target forest) <$>
|
||||
updateNode f (remainingPath, a) (Right target)
|
||||
where
|
||||
findNode :: Maybe ReadPlanTree
|
||||
findNode = find (\(Node ReadPlan{relName, relAlias} _) -> relName == targetNodeName || relAlias == Just targetNodeName) forest
|
||||
|
||||
mutatePlan :: Mutation -> QualifiedIdentifier -> ApiRequest -> SchemaCache -> ReadPlanTree -> Either Error MutatePlan
|
||||
mutatePlan mutation qi ApiRequest{iPreferences=Preferences{..}, ..} SchemaCache{dbTables, dbRepresentations} readReq = mapLeft ApiRequestError $
|
||||
case mutation of
|
||||
MutationCreate ->
|
||||
mapRight (\typedColumns -> Insert qi typedColumns body ((,) <$> preferResolution <*> Just confCols) [] returnings pkCols applyDefaults) typedColumnsOrError
|
||||
MutationUpdate ->
|
||||
mapRight (\typedColumns -> Update qi typedColumns body combinedLogic iTopLevelRange rootOrder returnings applyDefaults) typedColumnsOrError
|
||||
MutationSingleUpsert ->
|
||||
if null qsLogic &&
|
||||
qsFilterFields == S.fromList pkCols &&
|
||||
not (null (S.fromList pkCols)) &&
|
||||
all (\case
|
||||
Filter _ (OpExpr False (OpQuant OpEqual Nothing _)) -> True
|
||||
_ -> False) qsFiltersRoot
|
||||
then mapRight (\typedColumns -> Insert qi typedColumns body (Just (MergeDuplicates, pkCols)) combinedLogic returnings mempty False) typedColumnsOrError
|
||||
else
|
||||
Left InvalidFilters
|
||||
MutationDelete -> Right $ Delete qi combinedLogic iTopLevelRange rootOrder returnings
|
||||
where
|
||||
ctx = ResolverContext dbTables dbRepresentations qi "json"
|
||||
confCols = fromMaybe pkCols qsOnConflict
|
||||
QueryParams.QueryParams{..} = iQueryParams
|
||||
returnings =
|
||||
if preferRepresentation == Just None || isNothing preferRepresentation
|
||||
then []
|
||||
else inferColsEmbedNeeds readReq pkCols
|
||||
tbl = HM.lookup qi dbTables
|
||||
pkCols = maybe mempty tablePKCols tbl
|
||||
logic = map (resolveLogicTree ctx . snd) qsLogic
|
||||
rootOrder = resolveOrder ctx <$> maybe [] snd (find (\(x, _) -> null x) qsOrder)
|
||||
combinedLogic = foldr (addFilterToLogicForest . resolveFilter ctx) logic qsFiltersRoot
|
||||
body = payRaw <$> iPayload -- the body is assumed to be json at this stage(ApiRequest validates)
|
||||
applyDefaults = preferMissing == Just ApplyDefaults
|
||||
typedColumnsOrError = resolveOrError ctx tbl `traverse` S.toList iColumns
|
||||
|
||||
resolveOrError :: ResolverContext -> Maybe Table -> FieldName -> Either ApiRequestError CoercibleField
|
||||
resolveOrError _ Nothing _ = Left NotFound
|
||||
resolveOrError ctx (Just table) field =
|
||||
case resolveTableFieldName table field of
|
||||
CoercibleField{cfIRType=""} -> Left $ ColumnNotFound (tableName table) field
|
||||
cf -> Right $ withJsonParse ctx cf
|
||||
|
||||
callPlan :: Routine -> ApiRequest -> S.Set FieldName -> LBS.ByteString -> ReadPlanTree -> CallPlan
|
||||
callPlan proc ApiRequest{iPreferences=Preferences{..}} paramKeys args readReq = FunctionCall {
|
||||
funCQi = QualifiedIdentifier (pdSchema proc) (pdName proc)
|
||||
, funCParams = callParams
|
||||
, funCArgs = Just args
|
||||
, funCScalar = funcReturnsScalar proc
|
||||
, funCSetOfScalar = funcReturnsSetOfScalar proc
|
||||
, funCRetCompositeAlias = funcReturnsCompositeAlias proc
|
||||
, funCReturning = inferColsEmbedNeeds readReq []
|
||||
}
|
||||
where
|
||||
paramsAsSingleObject = preferParameters == Just SingleObject
|
||||
specifiedParams = filter (\x -> ppName x `S.member` paramKeys)
|
||||
callParams = case pdParams proc of
|
||||
[prm] | paramsAsSingleObject -> OnePosParam prm
|
||||
| ppName prm == mempty -> OnePosParam prm
|
||||
| otherwise -> KeyParams $ specifiedParams [prm]
|
||||
prms -> KeyParams $ specifiedParams prms
|
||||
|
||||
-- | Infers the columns needed for an embed to be successful after a mutation or a function call.
|
||||
inferColsEmbedNeeds :: ReadPlanTree -> [FieldName] -> [FieldName]
|
||||
inferColsEmbedNeeds (Node ReadPlan{select} forest) pkCols
|
||||
-- if * is part of the select, we must not add pk or fk columns manually -
|
||||
-- otherwise those would be selected and output twice
|
||||
| "*" `elem` fldNames = ["*"]
|
||||
| otherwise = returnings
|
||||
where
|
||||
fldNames = cfName . (\(f, _, _) -> f) <$> select
|
||||
-- Without fkCols, when a mutatePlan to
|
||||
-- /projects?select=name,clients(name) occurs, the RETURNING SQL part would
|
||||
-- be `RETURNING name`(see QueryBuilder). This would make the embedding
|
||||
-- fail because the following JOIN would need the "client_id" column from
|
||||
-- projects. So this adds the foreign key columns to ensure the embedding
|
||||
-- succeeds, result would be `RETURNING name, client_id`.
|
||||
fkCols = concat $ mapMaybe (\case
|
||||
Node ReadPlan{relToParent=Just Relationship{relCardinality=O2M _ cols}} _ ->
|
||||
Just $ fst <$> cols
|
||||
Node ReadPlan{relToParent=Just Relationship{relCardinality=M2O _ cols}} _ ->
|
||||
Just $ fst <$> cols
|
||||
Node ReadPlan{relToParent=Just Relationship{relCardinality=O2O _ cols}} _ ->
|
||||
Just $ fst <$> cols
|
||||
Node ReadPlan{relToParent=Just Relationship{relCardinality=M2M Junction{junColsSource=cols}}} _ ->
|
||||
Just $ fst <$> cols
|
||||
Node ReadPlan{relToParent=Just ComputedRelationship{}} _ ->
|
||||
Nothing
|
||||
Node ReadPlan{relToParent=Nothing} _ ->
|
||||
Nothing
|
||||
) forest
|
||||
hasComputedRel = isJust $ find (\case
|
||||
Node ReadPlan{relToParent=Just ComputedRelationship{}} _ -> True
|
||||
_ -> False
|
||||
) forest
|
||||
-- However if the "client_id" is present, e.g. mutatePlan to
|
||||
-- /projects?select=client_id,name,clients(name) we would get `RETURNING
|
||||
-- client_id, name, client_id` and then we would produce the "column
|
||||
-- reference \"client_id\" is ambiguous" error from PostgreSQL. So we
|
||||
-- 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
|
||||
-- INSERT/POST
|
||||
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
|
||||
-- they are later concatenated with AND in the QueryBuilder
|
||||
addFilterToLogicForest :: CoercibleFilter -> [CoercibleLogicTree] -> [CoercibleLogicTree]
|
||||
addFilterToLogicForest flt lf = CoercibleStmnt flt : lf
|
||||
|
||||
-- | If raw(binary) output is requested, check that MediaType is one of the
|
||||
-- admitted rawMediaTypes and that`?select=...` contains only one field other
|
||||
-- than `*`
|
||||
binaryField :: AppConfig -> MediaType -> Maybe Routine -> ReadPlanTree -> Either ApiRequestError (Maybe FieldName)
|
||||
binaryField AppConfig{configRawMediaTypes} acceptMediaType proc rpTree
|
||||
| isRawMediaType =
|
||||
if (funcReturnsScalar <$> proc) == Just True ||
|
||||
(funcReturnsSetOfScalar <$> proc) == Just True
|
||||
then Right $ Just "pgrst_scalar"
|
||||
else
|
||||
let
|
||||
fieldName = fstFieldName rpTree
|
||||
in
|
||||
case fieldName of
|
||||
Just fld -> Right $ Just fld
|
||||
Nothing -> Left $ BinaryFieldError acceptMediaType
|
||||
| otherwise =
|
||||
Right Nothing
|
||||
where
|
||||
isRawMediaType = acceptMediaType `elem` configRawMediaTypes `L.union` [MTOctetStream, MTTextPlain, MTTextXML] || isRawPlan acceptMediaType
|
||||
isRawPlan mt = case mt of
|
||||
MTPlan MTOctetStream _ _ -> True
|
||||
MTPlan MTTextPlain _ _ -> True
|
||||
MTPlan MTTextXML _ _ -> True
|
||||
_ -> False
|
||||
|
||||
fstFieldName :: ReadPlanTree -> Maybe FieldName
|
||||
fstFieldName (Node ReadPlan{select=(CoercibleField{cfName="*", cfJsonPath=[]}, _, _):_} []) = Nothing
|
||||
fstFieldName (Node ReadPlan{select=[(CoercibleField{cfName=fld, cfJsonPath=[]}, _, _)]} []) = Just fld
|
||||
fstFieldName _ = Nothing
|
||||
|
||||
|
||||
mediaToAggregate :: MediaType -> Maybe FieldName -> ApiRequest -> ResultAggregate
|
||||
mediaToAggregate mt binField apiReq@ApiRequest{iAction=act, iPreferences=Preferences{preferRepresentation=rep}} =
|
||||
if noAgg then NoAgg
|
||||
else case mt of
|
||||
MTApplicationJSON -> BuiltinAggJson
|
||||
MTSingularJSON strip -> BuiltinAggSingleJson strip
|
||||
MTArrayJSONStrip -> BuiltinAggArrayJsonStrip
|
||||
MTGeoJSON -> BuiltinAggGeoJson
|
||||
MTTextCSV -> BuiltinAggCsv
|
||||
MTAny -> BuiltinAggJson
|
||||
MTOpenAPI -> BuiltinAggJson
|
||||
MTUrlEncoded -> NoAgg -- TODO: unreachable since a previous step (producedMediaTypes) whitelists the media types that can become aggregates.
|
||||
|
||||
-- binary types
|
||||
MTTextPlain -> BuiltinAggBinary binField
|
||||
MTTextXML -> BuiltinAggXml binField
|
||||
MTOctetStream -> BuiltinAggBinary binField
|
||||
MTOther _ -> BuiltinAggBinary binField
|
||||
|
||||
-- Doing `Accept: application/vnd.pgrst.plan; for="application/vnd.pgrst.plan"` doesn't make sense, so we just empty the body.
|
||||
-- TODO: fail instead to be more strict
|
||||
MTPlan (MTPlan{}) _ _ -> NoAgg
|
||||
MTPlan media _ _ -> mediaToAggregate media binField apiReq
|
||||
where
|
||||
noAgg = case act of
|
||||
ActionMutate _ -> rep == Just HeadersOnly || rep == Just None || isNothing rep
|
||||
ActionRead _isHead -> _isHead -- no need for an aggregate on HEAD https://github.com/PostgREST/postgrest/issues/2849
|
||||
ActionInvoke invMethod -> invMethod == InvHead
|
||||
_ -> False
|
||||
@@ -0,0 +1,57 @@
|
||||
{-# LANGUAGE NamedFieldPuns #-}
|
||||
module PostgREST.Plan.CallPlan
|
||||
( CallPlan(..)
|
||||
, CallParams(..)
|
||||
, jsonRpcParams
|
||||
)
|
||||
where
|
||||
|
||||
import qualified Data.Aeson as JSON
|
||||
import qualified Data.ByteString.Lazy as LBS
|
||||
import qualified Data.HashMap.Strict as HM
|
||||
import PostgREST.SchemaCache.Identifiers (FieldName,
|
||||
QualifiedIdentifier)
|
||||
import PostgREST.SchemaCache.Routine (Routine (..),
|
||||
RoutineParam (..))
|
||||
|
||||
import Protolude
|
||||
|
||||
data CallPlan = FunctionCall
|
||||
{ funCQi :: QualifiedIdentifier
|
||||
, funCParams :: CallParams
|
||||
, funCArgs :: Maybe LBS.ByteString
|
||||
, funCScalar :: Bool
|
||||
, funCSetOfScalar :: Bool
|
||||
, funCRetCompositeAlias :: Bool
|
||||
, funCReturning :: [FieldName]
|
||||
}
|
||||
|
||||
data CallParams
|
||||
= KeyParams [RoutineParam] -- ^ Call with key params: func(a := val1, b:= val2)
|
||||
| OnePosParam RoutineParam -- ^ Call with positional params(only one supported): func(val)
|
||||
|
||||
-- | Convert rpc params `/rpc/func?a=val1&b=val2` to json `{"a": "val1", "b": "val2"}
|
||||
jsonRpcParams :: Routine -> [(Text, Text)] -> LBS.ByteString
|
||||
jsonRpcParams proc prms =
|
||||
if not $ pdHasVariadic proc then -- if proc has no variadic param, save steps and directly convert to json
|
||||
JSON.encode $ HM.fromList $ second JSON.toJSON <$> prms
|
||||
else
|
||||
let paramsMap = HM.fromListWith mergeParams $ toRpcParamValue proc <$> prms in
|
||||
JSON.encode paramsMap
|
||||
where
|
||||
mergeParams :: RpcParamValue -> RpcParamValue -> RpcParamValue
|
||||
mergeParams (Variadic a) (Variadic b) = Variadic $ b ++ a
|
||||
mergeParams v _ = v -- repeated params for non-variadic parameters are not merged
|
||||
|
||||
toRpcParamValue :: Routine -> (Text, Text) -> (Text, RpcParamValue)
|
||||
toRpcParamValue proc (k, v) | prmIsVariadic k = (k, Variadic [v])
|
||||
| otherwise = (k, Fixed v)
|
||||
where
|
||||
prmIsVariadic prm = isJust $ find (\RoutineParam{ppName, ppVar} -> ppName == prm && ppVar) $ pdParams proc
|
||||
|
||||
-- | 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.
|
||||
data RpcParamValue = Fixed Text | Variadic [Text]
|
||||
instance JSON.ToJSON RpcParamValue where
|
||||
toJSON (Fixed v) = JSON.toJSON v
|
||||
toJSON (Variadic v) = JSON.toJSON v
|
||||
@@ -0,0 +1,46 @@
|
||||
module PostgREST.Plan.MutatePlan
|
||||
( MutatePlan(..)
|
||||
)
|
||||
where
|
||||
|
||||
import qualified Data.ByteString.Lazy as LBS
|
||||
|
||||
import PostgREST.ApiRequest.Preferences (PreferResolution)
|
||||
import PostgREST.Plan.Types (CoercibleField,
|
||||
CoercibleLogicTree,
|
||||
CoercibleOrderTerm)
|
||||
import PostgREST.RangeQuery (NonnegRange)
|
||||
import PostgREST.SchemaCache.Identifiers (FieldName,
|
||||
QualifiedIdentifier)
|
||||
|
||||
|
||||
import Protolude
|
||||
|
||||
data MutatePlan
|
||||
= Insert
|
||||
{ in_ :: QualifiedIdentifier
|
||||
, insCols :: [CoercibleField]
|
||||
, insBody :: Maybe LBS.ByteString
|
||||
, onConflict :: Maybe (PreferResolution, [FieldName])
|
||||
, where_ :: [CoercibleLogicTree]
|
||||
, returning :: [FieldName]
|
||||
, insPkCols :: [FieldName]
|
||||
, applyDefs :: Bool
|
||||
}
|
||||
| Update
|
||||
{ in_ :: QualifiedIdentifier
|
||||
, updCols :: [CoercibleField]
|
||||
, updBody :: Maybe LBS.ByteString
|
||||
, where_ :: [CoercibleLogicTree]
|
||||
, mutRange :: NonnegRange
|
||||
, mutOrder :: [CoercibleOrderTerm]
|
||||
, returning :: [FieldName]
|
||||
, applyDefs :: Bool
|
||||
}
|
||||
| Delete
|
||||
{ in_ :: QualifiedIdentifier
|
||||
, where_ :: [CoercibleLogicTree]
|
||||
, mutRange :: NonnegRange
|
||||
, mutOrder :: [CoercibleOrderTerm]
|
||||
, returning :: [FieldName]
|
||||
}
|
||||
@@ -0,0 +1,48 @@
|
||||
module PostgREST.Plan.ReadPlan
|
||||
( ReadPlanTree
|
||||
, ReadPlan(..)
|
||||
, JoinCondition(..)
|
||||
) where
|
||||
|
||||
import Data.Tree (Tree (..))
|
||||
|
||||
import PostgREST.ApiRequest.Types (Alias, Cast, Depth, Hint,
|
||||
JoinType, NodeName)
|
||||
import PostgREST.Plan.Types (CoercibleField (..),
|
||||
CoercibleLogicTree,
|
||||
CoercibleOrderTerm)
|
||||
import PostgREST.RangeQuery (NonnegRange)
|
||||
import PostgREST.SchemaCache.Identifiers (FieldName,
|
||||
QualifiedIdentifier)
|
||||
import PostgREST.SchemaCache.Relationship (Relationship)
|
||||
|
||||
|
||||
import Protolude
|
||||
|
||||
type ReadPlanTree = Tree ReadPlan
|
||||
|
||||
data JoinCondition =
|
||||
JoinCondition
|
||||
(QualifiedIdentifier, FieldName)
|
||||
(QualifiedIdentifier, FieldName)
|
||||
deriving (Eq, Show)
|
||||
|
||||
data ReadPlan = ReadPlan
|
||||
{ select :: [(CoercibleField, Maybe Cast, Maybe Alias)]
|
||||
, from :: QualifiedIdentifier
|
||||
, fromAlias :: Maybe Alias
|
||||
, where_ :: [CoercibleLogicTree]
|
||||
, order :: [CoercibleOrderTerm]
|
||||
, range_ :: NonnegRange
|
||||
, relName :: NodeName
|
||||
, relToParent :: Maybe Relationship
|
||||
, relJoinConds :: [JoinCondition]
|
||||
, relAlias :: Maybe Alias
|
||||
, relAggAlias :: Alias
|
||||
, relHint :: Maybe Hint
|
||||
, relJoinType :: Maybe JoinType
|
||||
, relIsSpread :: Bool
|
||||
, depth :: Depth
|
||||
-- ^ used for aliasing
|
||||
}
|
||||
deriving (Eq, Show)
|
||||
@@ -0,0 +1,67 @@
|
||||
module PostgREST.Plan.Types
|
||||
( CoercibleField(..)
|
||||
, unknownField
|
||||
, CoercibleLogicTree(..)
|
||||
, CoercibleFilter(..)
|
||||
, TransformerProc
|
||||
, CoercibleOrderTerm(..)
|
||||
) where
|
||||
|
||||
import PostgREST.ApiRequest.Types (Field, JsonPath, LogicOperator,
|
||||
OpExpr, OrderDirection, OrderNulls)
|
||||
|
||||
import PostgREST.SchemaCache.Identifiers (FieldName)
|
||||
|
||||
import Protolude
|
||||
|
||||
type TransformerProc = Text
|
||||
|
||||
-- | A CoercibleField pairs the name of a query element with any type coercion information we need for some specific use case.
|
||||
-- |
|
||||
-- | As suggested by the name, it's often a reference to a field in a table but really it can be any nameable element (function parameter, calculation with an alias, etc) with a knowable type.
|
||||
-- |
|
||||
-- | In the simplest case, it allows us to parse JSON payloads with `json_to_recordset`, for which we need to know both the name and the type of each thing we'd like to extract. At a higher level, CoercibleField generalises to reflect that any value we work with in a query may need type specific handling.
|
||||
-- |
|
||||
-- | CoercibleField is the foundation for the Data Representations feature. This feature allow user-definable mappings between database types so that the same data can be presented or interpreted in various ways as needed. Sometimes the way Postgres coerces data implicitly isn't right for the job. Different mappings might be appropriate for different situations: parsing a filter from a query string requires one function (text -> field type) while parsing a payload from JSON takes another (json -> field type). And the reverse, outputting a field as JSON, requires yet a third (field type -> json). CoercibleField is that "job specific" reference to an element paired with the type we desire for that particular purpose and the function we'll use to get there, if any.
|
||||
-- |
|
||||
-- | In the planning phase, we "resolve" generic named elements into these specialised CoercibleFields. Again this is context specific: two different CoercibleFields both representing the exact same table column in the database, even in the same query, might have two different target types and mapping functions. For example, one might represent a column in a filter, and another the very same column in an output role to be sent in the response body.
|
||||
-- |
|
||||
-- | The type value is allowed to be the empty string. The analog here is soft type checking in programming languages: sometimes we don't need a variable to have a specified type and things will work anyhow. So the empty type variant is valid when we don't know and *don't need to know* about the specific type in some context. Note that this variation should not be used if it guarantees failure: in that case you should instead raise an error at the planning stage and bail out. For example, we can't parse JSON with `json_to_recordset` without knowing the types of each recipient field, and so error out. Using the empty string for the type would be incorrect and futile. On the other hand we use the empty type for RPC calls since type resolution isn't implemented for RPC, but it's fine because the query still works with Postgres' implicit coercion. In the future, hopefully we will support data representations across the board and then the empty type may be permanently retired.
|
||||
data CoercibleField = CoercibleField
|
||||
{ cfName :: FieldName
|
||||
, cfJsonPath :: JsonPath
|
||||
, cfToJson :: Bool
|
||||
, cfIRType :: Text -- ^ The native Postgres type of the field, the intermediate (IR) type before mapping.
|
||||
, cfTransform :: Maybe TransformerProc -- ^ The optional mapping from irType -> targetType.
|
||||
, cfDefault :: Maybe Text
|
||||
} deriving (Eq, Show)
|
||||
|
||||
unknownField :: FieldName -> JsonPath -> CoercibleField
|
||||
unknownField name path = CoercibleField name path False "" Nothing Nothing
|
||||
|
||||
-- | Like an API request LogicTree, but with coercible field information.
|
||||
data CoercibleLogicTree
|
||||
= CoercibleExpr Bool LogicOperator [CoercibleLogicTree]
|
||||
| CoercibleStmnt CoercibleFilter
|
||||
deriving (Eq, Show)
|
||||
|
||||
data CoercibleFilter = CoercibleFilter
|
||||
{ field :: CoercibleField
|
||||
, opExpr :: OpExpr
|
||||
}
|
||||
| CoercibleFilterNullEmbed Bool FieldName
|
||||
deriving (Eq, Show)
|
||||
|
||||
data CoercibleOrderTerm
|
||||
= CoercibleOrderTerm
|
||||
{ coField :: CoercibleField
|
||||
, coDirection :: Maybe OrderDirection
|
||||
, coNullOrder :: Maybe OrderNulls
|
||||
}
|
||||
| CoercibleOrderRelationTerm
|
||||
{ coRelation :: FieldName
|
||||
, coRelTerm :: Field
|
||||
, coDirection :: Maybe OrderDirection
|
||||
, coNullOrder :: Maybe OrderNulls
|
||||
}
|
||||
deriving (Eq, Show)
|
||||
@@ -0,0 +1,274 @@
|
||||
{-# LANGUAGE NamedFieldPuns #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
module PostgREST.Query
|
||||
( createQuery
|
||||
, deleteQuery
|
||||
, invokeQuery
|
||||
, openApiQuery
|
||||
, readQuery
|
||||
, singleUpsertQuery
|
||||
, updateQuery
|
||||
, setPgLocals
|
||||
, runPreReq
|
||||
, DbHandler
|
||||
) where
|
||||
|
||||
import qualified Data.Aeson as JSON
|
||||
import qualified Data.Aeson.Key as K
|
||||
import qualified Data.Aeson.KeyMap as KM
|
||||
import qualified Data.ByteString as BS
|
||||
import qualified Data.ByteString.Lazy.Char8 as LBS
|
||||
import qualified Data.HashMap.Strict as HM
|
||||
import qualified Data.Set as S
|
||||
import qualified Data.Text.Encoding as T
|
||||
import qualified Hasql.Decoders as HD
|
||||
import qualified Hasql.DynamicStatements.Snippet as SQL (Snippet)
|
||||
import qualified Hasql.DynamicStatements.Statement as SQL
|
||||
import qualified Hasql.Transaction as SQL
|
||||
|
||||
import qualified PostgREST.Error as Error
|
||||
import qualified PostgREST.Query.QueryBuilder as QueryBuilder
|
||||
import qualified PostgREST.Query.Statements as Statements
|
||||
import qualified PostgREST.RangeQuery as RangeQuery
|
||||
import qualified PostgREST.SchemaCache as SchemaCache
|
||||
|
||||
import Data.Scientific (FPFormat (..), formatScientific, isInteger)
|
||||
|
||||
import PostgREST.ApiRequest (ApiRequest (..))
|
||||
import PostgREST.ApiRequest.Preferences (PreferCount (..),
|
||||
PreferTransaction (..),
|
||||
Preferences (..),
|
||||
shouldCount)
|
||||
import PostgREST.Config (AppConfig (..),
|
||||
OpenAPIMode (..))
|
||||
import PostgREST.Config.PgVersion (PgVersion (..),
|
||||
pgVersion140)
|
||||
import PostgREST.Error (Error)
|
||||
import PostgREST.MediaType (MediaType (..))
|
||||
import PostgREST.Plan (CallReadPlan (..),
|
||||
MutateReadPlan (..),
|
||||
WrappedReadPlan (..))
|
||||
import PostgREST.Plan.MutatePlan (MutatePlan (..))
|
||||
import PostgREST.Query.SqlFragment (escapeIdentList, fromQi,
|
||||
intercalateSnippet,
|
||||
setConfigLocal,
|
||||
setConfigLocalJson)
|
||||
import PostgREST.Query.Statements (ResultSet (..))
|
||||
import PostgREST.SchemaCache (SchemaCache (..))
|
||||
import PostgREST.SchemaCache.Identifiers (QualifiedIdentifier (..),
|
||||
Schema)
|
||||
import PostgREST.SchemaCache.Routine (Routine (..), RoutineMap)
|
||||
import PostgREST.SchemaCache.Table (TablesMap)
|
||||
|
||||
import Protolude hiding (Handler)
|
||||
|
||||
type DbHandler = ExceptT Error SQL.Transaction
|
||||
|
||||
readQuery :: WrappedReadPlan -> AppConfig -> ApiRequest -> DbHandler ResultSet
|
||||
readQuery WrappedReadPlan{wrReadPlan, wrResAgg} conf@AppConfig{..} apiReq@ApiRequest{iPreferences=Preferences{..}, ..} = do
|
||||
let countQuery = QueryBuilder.readPlanToCountQuery wrReadPlan
|
||||
resultSet <-
|
||||
lift . SQL.statement mempty $
|
||||
Statements.prepareRead
|
||||
(QueryBuilder.readPlanToQuery wrReadPlan)
|
||||
(if preferCount == Just EstimatedCount then
|
||||
-- LIMIT maxRows + 1 so we can determine below that maxRows was surpassed
|
||||
QueryBuilder.limitedQuery countQuery ((+ 1) <$> configDbMaxRows)
|
||||
else
|
||||
countQuery
|
||||
)
|
||||
(shouldCount preferCount)
|
||||
iAcceptMediaType
|
||||
wrResAgg
|
||||
configDbPreparedStatements
|
||||
failNotSingular iAcceptMediaType resultSet
|
||||
optionalRollback conf apiReq
|
||||
resultSetWTotal conf apiReq resultSet countQuery
|
||||
|
||||
resultSetWTotal :: AppConfig -> ApiRequest -> ResultSet -> SQL.Snippet -> DbHandler ResultSet
|
||||
resultSetWTotal _ _ rs@RSPlan{} _ = return rs
|
||||
resultSetWTotal AppConfig{..} ApiRequest{iPreferences=Preferences{..}} rs@RSStandard{rsTableTotal=tableTotal} countQuery =
|
||||
case preferCount of
|
||||
Just PlannedCount -> do
|
||||
total <- explain
|
||||
return rs{rsTableTotal=total}
|
||||
Just EstimatedCount ->
|
||||
if tableTotal > (fromIntegral <$> configDbMaxRows) then do
|
||||
total <- max tableTotal <$> explain
|
||||
return rs{rsTableTotal=total}
|
||||
else
|
||||
return rs
|
||||
Just ExactCount ->
|
||||
return rs
|
||||
Nothing ->
|
||||
return rs
|
||||
where
|
||||
explain =
|
||||
lift . SQL.statement mempty . Statements.preparePlanRows countQuery $
|
||||
configDbPreparedStatements
|
||||
|
||||
createQuery :: MutateReadPlan -> ApiRequest -> AppConfig -> DbHandler ResultSet
|
||||
createQuery mrPlan apiReq@ApiRequest{..} conf = do
|
||||
resultSet <- writeQuery mrPlan apiReq conf
|
||||
failNotSingular iAcceptMediaType resultSet
|
||||
optionalRollback conf apiReq
|
||||
pure resultSet
|
||||
|
||||
updateQuery :: MutateReadPlan -> ApiRequest -> AppConfig -> DbHandler ResultSet
|
||||
updateQuery mrPlan apiReq@ApiRequest{..} conf = do
|
||||
resultSet <- writeQuery mrPlan apiReq conf
|
||||
failNotSingular iAcceptMediaType resultSet
|
||||
failsChangesOffLimits (RangeQuery.rangeLimit iTopLevelRange) resultSet
|
||||
optionalRollback conf apiReq
|
||||
pure resultSet
|
||||
|
||||
singleUpsertQuery :: MutateReadPlan -> ApiRequest -> AppConfig -> DbHandler ResultSet
|
||||
singleUpsertQuery mrPlan apiReq conf = do
|
||||
resultSet <- writeQuery mrPlan apiReq conf
|
||||
failPut resultSet
|
||||
optionalRollback conf apiReq
|
||||
pure resultSet
|
||||
|
||||
-- Makes sure the querystring pk matches the payload pk
|
||||
-- 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
|
||||
failPut :: ResultSet -> DbHandler ()
|
||||
failPut RSPlan{} = pure ()
|
||||
failPut RSStandard{rsQueryTotal=queryTotal} =
|
||||
when (queryTotal /= 1) $ do
|
||||
lift SQL.condemn
|
||||
throwError Error.PutMatchingPkError
|
||||
|
||||
deleteQuery :: MutateReadPlan -> ApiRequest -> AppConfig -> DbHandler ResultSet
|
||||
deleteQuery mrPlan apiReq@ApiRequest{..} conf = do
|
||||
resultSet <- writeQuery mrPlan apiReq conf
|
||||
failNotSingular iAcceptMediaType resultSet
|
||||
failsChangesOffLimits (RangeQuery.rangeLimit iTopLevelRange) resultSet
|
||||
optionalRollback conf apiReq
|
||||
pure resultSet
|
||||
|
||||
invokeQuery :: Routine -> CallReadPlan -> ApiRequest -> AppConfig -> PgVersion -> DbHandler ResultSet
|
||||
invokeQuery rout CallReadPlan{crReadPlan, crCallPlan, crResAgg} apiReq@ApiRequest{iPreferences=Preferences{..}, ..} conf@AppConfig{..} pgVer = do
|
||||
resultSet <-
|
||||
lift . SQL.statement mempty $
|
||||
Statements.prepareCall
|
||||
rout
|
||||
(QueryBuilder.callPlanToQuery crCallPlan pgVer)
|
||||
(QueryBuilder.readPlanToQuery crReadPlan)
|
||||
(QueryBuilder.readPlanToCountQuery crReadPlan)
|
||||
(shouldCount preferCount)
|
||||
iAcceptMediaType
|
||||
crResAgg
|
||||
configDbPreparedStatements
|
||||
|
||||
optionalRollback conf apiReq
|
||||
failNotSingular iAcceptMediaType resultSet
|
||||
pure resultSet
|
||||
|
||||
openApiQuery :: SchemaCache -> PgVersion -> AppConfig -> Schema -> DbHandler (Maybe (TablesMap, RoutineMap, Maybe Text))
|
||||
openApiQuery sCache pgVer AppConfig{..} tSchema =
|
||||
lift $ case configOpenApiMode of
|
||||
OAFollowPriv -> do
|
||||
tableAccess <- SQL.statement [tSchema] (SchemaCache.accessibleTables pgVer configDbPreparedStatements)
|
||||
Just <$> ((,,)
|
||||
(HM.filterWithKey (\qi _ -> S.member qi tableAccess) $ SchemaCache.dbTables sCache)
|
||||
<$> SQL.statement tSchema (SchemaCache.accessibleFuncs pgVer configDbPreparedStatements)
|
||||
<*> SQL.statement tSchema (SchemaCache.schemaDescription configDbPreparedStatements))
|
||||
OAIgnorePriv ->
|
||||
Just <$> ((,,)
|
||||
(HM.filterWithKey (\(QualifiedIdentifier sch _) _ -> sch == tSchema) $ SchemaCache.dbTables sCache)
|
||||
(HM.filterWithKey (\(QualifiedIdentifier sch _) _ -> sch == tSchema) $ SchemaCache.dbRoutines sCache)
|
||||
<$> SQL.statement tSchema (SchemaCache.schemaDescription configDbPreparedStatements))
|
||||
OADisabled ->
|
||||
pure Nothing
|
||||
|
||||
writeQuery :: MutateReadPlan -> ApiRequest -> AppConfig -> DbHandler ResultSet
|
||||
writeQuery MutateReadPlan{mrReadPlan, mrMutatePlan, mrResAgg} apiReq@ApiRequest{iPreferences=Preferences{..}} conf =
|
||||
let
|
||||
(isInsert, pkCols) = case mrMutatePlan of {Insert{insPkCols} -> (True, insPkCols); _ -> (False, mempty);}
|
||||
in
|
||||
lift . SQL.statement mempty $
|
||||
Statements.prepareWrite
|
||||
(QueryBuilder.readPlanToQuery mrReadPlan)
|
||||
(QueryBuilder.mutatePlanToQuery mrMutatePlan)
|
||||
isInsert
|
||||
(iAcceptMediaType apiReq)
|
||||
mrResAgg
|
||||
preferRepresentation
|
||||
pkCols
|
||||
(configDbPreparedStatements conf)
|
||||
|
||||
-- |
|
||||
-- Fail a response if a single JSON object was requested and not exactly one
|
||||
-- was found.
|
||||
failNotSingular :: MediaType -> ResultSet -> DbHandler ()
|
||||
failNotSingular _ RSPlan{} = pure ()
|
||||
failNotSingular mediaType RSStandard{rsQueryTotal=queryTotal} =
|
||||
when (elem mediaType [MTSingularJSON True,MTSingularJSON False] && queryTotal /= 1) $ do
|
||||
lift SQL.condemn
|
||||
throwError $ Error.singularityError queryTotal
|
||||
|
||||
failsChangesOffLimits :: Maybe Integer -> ResultSet -> DbHandler ()
|
||||
failsChangesOffLimits _ RSPlan{} = pure ()
|
||||
failsChangesOffLimits Nothing _ = pure ()
|
||||
failsChangesOffLimits (Just maxChanges) RSStandard{rsQueryTotal=queryTotal} =
|
||||
when (queryTotal > fromIntegral maxChanges) $ do
|
||||
lift SQL.condemn
|
||||
throwError $ Error.OffLimitsChangesError queryTotal maxChanges
|
||||
|
||||
-- | Set a transaction to roll back if requested
|
||||
optionalRollback :: AppConfig -> ApiRequest -> DbHandler ()
|
||||
optionalRollback AppConfig{..} ApiRequest{iPreferences=Preferences{..}} = do
|
||||
lift $ when (shouldRollback || (configDbTxRollbackAll && not shouldCommit)) $ do
|
||||
SQL.sql "SET CONSTRAINTS ALL IMMEDIATE"
|
||||
SQL.condemn
|
||||
where
|
||||
shouldCommit =
|
||||
preferTransaction == Just Commit
|
||||
shouldRollback =
|
||||
preferTransaction == Just Rollback
|
||||
|
||||
-- | Runs local (transaction scoped) GUCs for every request.
|
||||
setPgLocals :: AppConfig -> KM.KeyMap JSON.Value -> BS.ByteString -> [(ByteString, ByteString)] ->
|
||||
ApiRequest -> PgVersion -> DbHandler ()
|
||||
setPgLocals AppConfig{..} claims role roleSettings req actualPgVersion = lift $
|
||||
SQL.statement mempty $ SQL.dynamicallyParameterized
|
||||
("select " <> intercalateSnippet ", " (searchPathSql : roleSql ++ roleSettingsSql ++ claimsSql ++ [methodSql, pathSql] ++ headersSql ++ cookiesSql ++ appSettingsSql))
|
||||
HD.noResult configDbPreparedStatements
|
||||
where
|
||||
methodSql = setConfigLocal mempty ("request.method", iMethod req)
|
||||
pathSql = setConfigLocal mempty ("request.path", iPath req)
|
||||
headersSql = if usesLegacyGucs
|
||||
then setConfigLocal "request.header." <$> iHeaders req
|
||||
else setConfigLocalJson "request.headers" (iHeaders req)
|
||||
cookiesSql = if usesLegacyGucs
|
||||
then setConfigLocal "request.cookie." <$> iCookies req
|
||||
else setConfigLocalJson "request.cookies" (iCookies req)
|
||||
claimsSql = if usesLegacyGucs
|
||||
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", role)]
|
||||
roleSettingsSql = setConfigLocal mempty <$> roleSettings
|
||||
appSettingsSql = setConfigLocal mempty <$> (join bimap toUtf8 <$> configAppSettings)
|
||||
searchPathSql =
|
||||
let schemas = escapeIdentList (iSchema req : configDbExtraSearchPath) in
|
||||
setConfigLocal mempty ("search_path", schemas)
|
||||
usesLegacyGucs = configDbUseLegacyGucs && actualPgVersion < pgVersion140
|
||||
|
||||
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 = T.decodeUtf8 . LBS.toStrict $ JSON.encode v
|
||||
|
||||
-- | Runs the pre-request function.
|
||||
runPreReq :: AppConfig -> DbHandler ()
|
||||
runPreReq conf = lift $ traverse_ (SQL.statement mempty . stmt) (configDbPreRequest conf)
|
||||
where
|
||||
stmt req = SQL.dynamicallyParameterized
|
||||
("select " <> fromQi req <> "()")
|
||||
HD.noResult
|
||||
(configDbPreparedStatements conf)
|
||||
+133
-146
@@ -5,215 +5,188 @@ Module : PostgREST.Query.QueryBuilder
|
||||
Description : PostgREST SQL queries generating functions.
|
||||
|
||||
This module provides functions to consume data types that
|
||||
represent database queries (e.g. ReadRequest, MutateRequest) and SqlFragment
|
||||
represent database queries (e.g. ReadPlanTree, MutatePlan) and SqlFragment
|
||||
to produce SqlQuery type outputs.
|
||||
-}
|
||||
module PostgREST.Query.QueryBuilder
|
||||
( readRequestToQuery
|
||||
, mutateRequestToQuery
|
||||
, readRequestToCountQuery
|
||||
, requestToCallProcQuery
|
||||
( readPlanToQuery
|
||||
, mutatePlanToQuery
|
||||
, readPlanToCountQuery
|
||||
, callPlanToQuery
|
||||
, limitedQuery
|
||||
) where
|
||||
|
||||
import qualified Data.ByteString.Char8 as BS
|
||||
import qualified Data.Set as S
|
||||
import qualified Hasql.DynamicStatements.Snippet as SQL
|
||||
|
||||
import Data.Tree (Tree (..))
|
||||
|
||||
import PostgREST.DbStructure.Identifiers (QualifiedIdentifier (..))
|
||||
import PostgREST.DbStructure.Proc (ProcParam (..))
|
||||
import PostgREST.DbStructure.Relationship (Cardinality (..),
|
||||
import PostgREST.ApiRequest.Preferences (PreferResolution (..))
|
||||
import PostgREST.Config.PgVersion (PgVersion, pgVersion110,
|
||||
pgVersion130)
|
||||
import PostgREST.SchemaCache.Identifiers (QualifiedIdentifier (..))
|
||||
import PostgREST.SchemaCache.Relationship (Cardinality (..),
|
||||
Junction (..),
|
||||
Relationship (..))
|
||||
import PostgREST.Request.Preferences (PreferResolution (..))
|
||||
Relationship (..),
|
||||
relIsToOne)
|
||||
import PostgREST.SchemaCache.Routine (RoutineParam (..))
|
||||
|
||||
import PostgREST.ApiRequest.Types
|
||||
import PostgREST.Plan.CallPlan
|
||||
import PostgREST.Plan.MutatePlan
|
||||
import PostgREST.Plan.ReadPlan
|
||||
import PostgREST.Plan.Types
|
||||
import PostgREST.Query.SqlFragment
|
||||
import PostgREST.RangeQuery (allRange)
|
||||
import PostgREST.Request.MutateQuery
|
||||
import PostgREST.Request.ReadQuery
|
||||
import PostgREST.Request.Types
|
||||
import PostgREST.RangeQuery (allRange)
|
||||
|
||||
import Protolude
|
||||
|
||||
readRequestToQuery :: ReadRequest -> SQL.Snippet
|
||||
readRequestToQuery (Node (Select colSelects mainQi tblAlias logicForest joinConditions_ ordts range, (_, rel, _, _, _, _)) forest) =
|
||||
readPlanToQuery :: ReadPlanTree -> SQL.Snippet
|
||||
readPlanToQuery (Node ReadPlan{select,from=mainQi,fromAlias,where_=logicForest,order, range_=readRange, relToParent, relJoinConds} forest) =
|
||||
"SELECT " <>
|
||||
intercalateSnippet ", " ((pgFmtSelectItem qi <$> colSelects) ++ selects) <> " " <>
|
||||
intercalateSnippet ", " ((pgFmtSelectItem qi <$> (if null select && null forest then defSelect else select)) ++ selects) <> " " <>
|
||||
fromFrag <> " " <>
|
||||
intercalateSnippet " " joins <> " " <>
|
||||
(if null logicForest && null joinConditions_
|
||||
(if null logicForest && null relJoinConds
|
||||
then mempty
|
||||
else "WHERE " <> intercalateSnippet " AND " (map (pgFmtLogicTree qi) logicForest ++ map pgFmtJoinCondition joinConditions_)) <> " " <>
|
||||
orderF qi ordts <> " " <>
|
||||
limitOffsetF range
|
||||
else "WHERE " <> intercalateSnippet " AND " (map (pgFmtLogicTree qi) logicForest ++ map pgFmtJoinCondition relJoinConds)) <> " " <>
|
||||
orderF qi order <> " " <>
|
||||
limitOffsetF readRange
|
||||
where
|
||||
fromFrag = fromF rel mainQi tblAlias
|
||||
qi = getQualifiedIdentifier rel mainQi tblAlias
|
||||
fromFrag = fromF relToParent mainQi fromAlias
|
||||
qi = getQualifiedIdentifier relToParent mainQi fromAlias
|
||||
defSelect = [(unknownField "*" [], Nothing, Nothing)] -- gets all the columns in case of an empty select, ignoring/obtaining these columns is done at the aggregation stage
|
||||
(selects, joins) = foldr getSelectsJoins ([],[]) forest
|
||||
|
||||
getSelectsJoins :: ReadRequest -> ([SQL.Snippet], [SQL.Snippet]) -> ([SQL.Snippet], [SQL.Snippet])
|
||||
getSelectsJoins (Node (_, (_, Nothing, _, _, _, _)) _) _ = ([], [])
|
||||
getSelectsJoins rr@(Node (_, (name, Just rel, alias, _, joinType, _)) _) (selects,joins) =
|
||||
getSelectsJoins :: ReadPlanTree -> ([SQL.Snippet], [SQL.Snippet]) -> ([SQL.Snippet], [SQL.Snippet])
|
||||
getSelectsJoins (Node ReadPlan{relToParent=Nothing} _) _ = ([], [])
|
||||
getSelectsJoins rr@(Node ReadPlan{select, relName, relToParent=Just rel, relAggAlias, relAlias, relJoinType, relIsSpread} forest) (selects,joins) =
|
||||
let
|
||||
subquery = readRequestToQuery rr
|
||||
aliasOrName = fromMaybe name alias
|
||||
locTblName = qiName (relTable rel) <> "_" <> aliasOrName
|
||||
localTableName = pgFmtIdent locTblName
|
||||
internalTableName = pgFmtIdent $ "_" <> locTblName
|
||||
subquery = readPlanToQuery rr
|
||||
aliasOrName = pgFmtIdent $ fromMaybe relName relAlias
|
||||
aggAlias = pgFmtIdent relAggAlias
|
||||
correlatedSubquery sub al cond =
|
||||
(if joinType == Just JTInner then "INNER" else "LEFT") <> " JOIN LATERAL ( " <> sub <> " ) AS " <> SQL.sql al <> " ON " <> cond
|
||||
isToOne = case rel of
|
||||
Relationship{relCardinality=M2O _ _} -> True
|
||||
Relationship{relCardinality=O2O _ _} -> True
|
||||
ComputedRelationship{relToOne=True} -> True
|
||||
_ -> False
|
||||
(sel, joi) = if isToOne
|
||||
(if relJoinType == Just JTInner then "INNER" else "LEFT") <> " JOIN LATERAL ( " <> sub <> " ) AS " <> al <> " ON " <> cond
|
||||
(sel, joi) = if relIsToOne rel
|
||||
then
|
||||
( SQL.sql ("row_to_json(" <> localTableName <> ".*) AS " <> pgFmtIdent aliasOrName)
|
||||
, correlatedSubquery subquery localTableName "TRUE")
|
||||
( if relIsSpread
|
||||
then aggAlias <> ".*"
|
||||
else "row_to_json(" <> aggAlias <> ".*) AS " <> aliasOrName
|
||||
, correlatedSubquery subquery aggAlias "TRUE")
|
||||
else
|
||||
( SQL.sql $ "COALESCE( " <> localTableName <> "." <> internalTableName <> ", '[]') AS " <> pgFmtIdent aliasOrName
|
||||
( "COALESCE( " <> aggAlias <> "." <> aggAlias <> ", '[]') AS " <> 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")
|
||||
"SELECT json_agg(" <> aggAlias <> ") AS " <> aggAlias <>
|
||||
"FROM (" <> subquery <> " ) AS " <> aggAlias
|
||||
) aggAlias $ if relJoinType == Just JTInner then aggAlias <> " IS NOT NULL" else "TRUE")
|
||||
in
|
||||
(sel:selects, joi:joins)
|
||||
(if null select && null forest then selects else sel:selects, joi:joins)
|
||||
|
||||
mutateRequestToQuery :: MutateRequest -> SQL.Snippet
|
||||
mutateRequestToQuery (Insert mainQi iCols body onConflct putConditions returnings) =
|
||||
"WITH " <> normalizedBody body <> " " <>
|
||||
"INSERT INTO " <> SQL.sql (fromQi mainQi) <> SQL.sql (if S.null iCols then " " else "(" <> cols <> ") ") <>
|
||||
"SELECT " <> SQL.sql cols <> " " <>
|
||||
SQL.sql ("FROM json_populate_recordset (null::" <> fromQi mainQi <> ", " <> selectBody <> ") _ ") <>
|
||||
mutatePlanToQuery :: MutatePlan -> SQL.Snippet
|
||||
mutatePlanToQuery (Insert mainQi iCols body onConflct putConditions returnings _ applyDefaults) =
|
||||
"INSERT INTO " <> fromQi mainQi <> (if null iCols then " " else "(" <> cols <> ") ") <>
|
||||
fromJsonBodyF body iCols True False applyDefaults <>
|
||||
-- Only used for PUT
|
||||
(if null putConditions then mempty else "WHERE " <> intercalateSnippet " AND " (pgFmtLogicTree (QualifiedIdentifier mempty "_") <$> putConditions)) <>
|
||||
SQL.sql (BS.unwords [
|
||||
maybe "" (\(oncDo, oncCols) ->
|
||||
if null oncCols then
|
||||
mempty
|
||||
else
|
||||
"ON CONFLICT(" <> BS.intercalate ", " (pgFmtIdent <$> oncCols) <> ") " <> case oncDo of
|
||||
IgnoreDuplicates ->
|
||||
"DO NOTHING"
|
||||
MergeDuplicates ->
|
||||
if S.null iCols
|
||||
then "DO NOTHING"
|
||||
else "DO UPDATE SET " <> BS.intercalate ", " (pgFmtIdent <> const " = EXCLUDED." <> pgFmtIdent <$> S.toList iCols)
|
||||
) onConflct,
|
||||
returningF mainQi returnings
|
||||
])
|
||||
(if null putConditions then mempty else "WHERE " <> intercalateSnippet " AND " (pgFmtLogicTree (QualifiedIdentifier mempty "pgrst_body") <$> putConditions)) <>
|
||||
maybe mempty (\(oncDo, oncCols) ->
|
||||
if null oncCols then
|
||||
mempty
|
||||
else
|
||||
" ON CONFLICT(" <> intercalateSnippet ", " (pgFmtIdent <$> oncCols) <> ") " <> case oncDo of
|
||||
IgnoreDuplicates ->
|
||||
"DO NOTHING"
|
||||
MergeDuplicates ->
|
||||
if null iCols
|
||||
then "DO NOTHING"
|
||||
else "DO UPDATE SET " <> intercalateSnippet ", " ((pgFmtIdent . cfName) <> const " = EXCLUDED." <> (pgFmtIdent . cfName) <$> iCols)
|
||||
) onConflct <> " " <>
|
||||
returningF mainQi returnings
|
||||
where
|
||||
cols = BS.intercalate ", " $ pgFmtIdent <$> S.toList iCols
|
||||
cols = intercalateSnippet ", " $ pgFmtIdent . cfName <$> iCols
|
||||
|
||||
-- An update without a limit is always filtered with a WHERE
|
||||
mutateRequestToQuery (Update mainQi uCols body logicForest range ordts returnings)
|
||||
| S.null uCols =
|
||||
mutatePlanToQuery (Update mainQi uCols body logicForest range ordts returnings applyDefaults)
|
||||
| null uCols =
|
||||
-- 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=
|
||||
-- the select has to be based on "returnings" to make computed overloaded functions not throw
|
||||
SQL.sql $ "SELECT " <> emptyBodyReturnedColumns <> " FROM " <> fromQi mainQi <> " WHERE false"
|
||||
"SELECT " <> emptyBodyReturnedColumns <> " FROM " <> fromQi mainQi <> " WHERE false"
|
||||
|
||||
| range == allRange =
|
||||
"WITH " <> normalizedBody body <> " " <>
|
||||
"UPDATE " <> mainTbl <> " SET " <> SQL.sql nonRangeCols <> " " <>
|
||||
"FROM (SELECT * FROM json_populate_recordset (null::" <> mainTbl <> " , " <> SQL.sql selectBody <> " )) _ " <>
|
||||
"UPDATE " <> mainTbl <> " SET " <> nonRangeCols <> " " <>
|
||||
fromJsonBodyF body uCols False False applyDefaults <>
|
||||
whereLogic <> " " <>
|
||||
SQL.sql (returningF mainQi returnings)
|
||||
returningF mainQi returnings
|
||||
|
||||
| otherwise =
|
||||
"WITH " <> normalizedBody body <> ", " <>
|
||||
"pgrst_update_body AS (SELECT * FROM json_populate_recordset (null::" <> mainTbl <> " , " <> SQL.sql selectBody <> " ) LIMIT 1), " <>
|
||||
"WITH " <>
|
||||
"pgrst_update_body AS (" <> fromJsonBodyF body uCols True True applyDefaults <> "), " <>
|
||||
"pgrst_affected_rows AS (" <>
|
||||
"SELECT " <> SQL.sql rangeIdF <> " FROM " <> mainTbl <>
|
||||
"SELECT " <> rangeIdF <> " FROM " <> mainTbl <>
|
||||
whereLogic <> " " <>
|
||||
orderF mainQi ordts <> " " <>
|
||||
limitOffsetF range <>
|
||||
") " <>
|
||||
"UPDATE " <> mainTbl <> " SET " <> SQL.sql rangeCols <>
|
||||
"UPDATE " <> mainTbl <> " SET " <> rangeCols <>
|
||||
"FROM pgrst_affected_rows " <>
|
||||
"WHERE " <> SQL.sql whereRangeIdF <> " " <>
|
||||
SQL.sql (returningF mainQi returnings)
|
||||
"WHERE " <> whereRangeIdF <> " " <>
|
||||
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)
|
||||
mainTbl = fromQi mainQi
|
||||
emptyBodyReturnedColumns = if null returnings then "NULL" else intercalateSnippet ", " (pgFmtColumn (QualifiedIdentifier mempty $ qiName mainQi) <$> returnings)
|
||||
nonRangeCols = intercalateSnippet ", " (pgFmtIdent . cfName <> const " = " <> pgFmtColumn (QualifiedIdentifier mempty "pgrst_body") . cfName <$> uCols)
|
||||
rangeCols = intercalateSnippet ", " ((\col -> pgFmtIdent (cfName col) <> " = (SELECT " <> pgFmtIdent (cfName col) <> " FROM pgrst_update_body) ") <$> uCols)
|
||||
(whereRangeIdF, rangeIdF) = mutRangeF mainQi (cfName . coField <$> ordts)
|
||||
|
||||
mutateRequestToQuery (Delete mainQi logicForest range ordts returnings)
|
||||
mutatePlanToQuery (Delete mainQi logicForest range ordts returnings)
|
||||
| range == allRange =
|
||||
"DELETE FROM " <> SQL.sql (fromQi mainQi) <> " " <>
|
||||
"DELETE FROM " <> fromQi mainQi <> " " <>
|
||||
whereLogic <> " " <>
|
||||
SQL.sql (returningF mainQi returnings)
|
||||
returningF mainQi returnings
|
||||
|
||||
| otherwise =
|
||||
"WITH " <>
|
||||
"pgrst_affected_rows AS (" <>
|
||||
"SELECT " <> SQL.sql rangeIdF <> " FROM " <> SQL.sql (fromQi mainQi) <>
|
||||
"SELECT " <> rangeIdF <> " FROM " <> fromQi mainQi <>
|
||||
whereLogic <> " " <>
|
||||
orderF mainQi ordts <> " " <>
|
||||
limitOffsetF range <>
|
||||
") " <>
|
||||
"DELETE FROM " <> SQL.sql (fromQi mainQi) <> " " <>
|
||||
"DELETE FROM " <> fromQi mainQi <> " " <>
|
||||
"USING pgrst_affected_rows " <>
|
||||
"WHERE " <> SQL.sql whereRangeIdF <> " " <>
|
||||
SQL.sql (returningF mainQi returnings)
|
||||
"WHERE " <> whereRangeIdF <> " " <>
|
||||
returningF mainQi returnings
|
||||
|
||||
where
|
||||
whereLogic = if null logicForest then mempty else " WHERE " <> intercalateSnippet " AND " (pgFmtLogicTree mainQi <$> logicForest)
|
||||
(whereRangeIdF, rangeIdF) = mutRangeF mainQi (fst . otTerm <$> ordts)
|
||||
(whereRangeIdF, rangeIdF) = mutRangeF mainQi (cfName . coField <$> ordts)
|
||||
|
||||
requestToCallProcQuery :: CallRequest -> SQL.Snippet
|
||||
requestToCallProcQuery (FunctionCall qi params args returnsScalar multipleCall returnings) =
|
||||
prmsCTE <> argsBody
|
||||
callPlanToQuery :: CallPlan -> PgVersion -> SQL.Snippet
|
||||
callPlanToQuery (FunctionCall qi params args returnsScalar returnsSetOfScalar returnsCompositeAlias returnings) pgVer =
|
||||
"SELECT " <> (if returnsScalar || returnsSetOfScalar then "pgrst_call.pgrst_scalar" else returnedColumns) <> " " <>
|
||||
fromCall
|
||||
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 [
|
||||
"pgrst_args AS (",
|
||||
"SELECT * FROM json_to_recordset(" <> selectBody <> ") AS _(" <> fmtParams prms (const mempty) (\a -> " " <> encodeUtf8 (ppType a)) <> ")",
|
||||
")"])
|
||||
, SQL.sql $ if multipleCall
|
||||
then fmtParams prms varadicPrefix (\a -> " := pgrst_args." <> pgFmtIdent (ppName a))
|
||||
else fmtParams prms varadicPrefix (\a -> " := (SELECT " <> pgFmtIdent (ppName a) <> " FROM pgrst_args LIMIT 1)")
|
||||
)
|
||||
fromCall = case params of
|
||||
OnePosParam prm -> "FROM " <> callIt (singleParameter args $ encodeUtf8 $ ppType prm)
|
||||
KeyParams [] -> "FROM " <> callIt mempty
|
||||
KeyParams prms -> fromJsonBodyF args ((\p -> CoercibleField (ppName p) mempty False (ppTypeMaxLength p) Nothing Nothing) <$> prms) False True False <> ", " <>
|
||||
"LATERAL " <> callIt (fmtParams prms)
|
||||
|
||||
fmtParams :: [ProcParam] -> (ProcParam -> SqlFragment) -> (ProcParam -> SqlFragment) -> SqlFragment
|
||||
fmtParams prms prmFragPre prmFragSuf = BS.intercalate ", "
|
||||
((\a -> prmFragPre a <> pgFmtIdent (ppName a) <> prmFragSuf a) <$> prms)
|
||||
callIt :: SQL.Snippet -> SQL.Snippet
|
||||
callIt argument | pgVer < pgVersion130 && pgVer >= pgVersion110 && returnsCompositeAlias = "(SELECT (" <> fromQi qi <> "(" <> argument <> ")).*) pgrst_call"
|
||||
| returnsScalar || returnsSetOfScalar = "(SELECT " <> fromQi qi <> "(" <> argument <> ") pgrst_scalar) pgrst_call"
|
||||
| otherwise = fromQi qi <> "(" <> argument <> ") pgrst_call"
|
||||
|
||||
varadicPrefix :: ProcParam -> SqlFragment
|
||||
varadicPrefix a = if ppVar a then "VARIADIC " else mempty
|
||||
|
||||
argsBody :: SQL.Snippet
|
||||
argsBody
|
||||
| multipleCall =
|
||||
if returnsScalar
|
||||
then "SELECT " <> callIt <> " AS pgrst_scalar FROM pgrst_args"
|
||||
else "SELECT pgrst_lat_args.* FROM pgrst_args, " <>
|
||||
"LATERAL ( SELECT " <> returnedColumns <> " FROM " <> callIt <> " ) pgrst_lat_args"
|
||||
| otherwise =
|
||||
if returnsScalar
|
||||
then "SELECT " <> callIt <> " AS pgrst_scalar"
|
||||
else "SELECT " <> returnedColumns <> " FROM " <> callIt
|
||||
|
||||
callIt :: SQL.Snippet
|
||||
callIt = SQL.sql (fromQi qi) <> "(" <> argFrag <> ")"
|
||||
fmtParams :: [RoutineParam] -> SQL.Snippet
|
||||
fmtParams prms = intercalateSnippet ", "
|
||||
((\a -> (if ppVar a then "VARIADIC " else mempty) <> pgFmtIdent (ppName a) <> " := pgrst_body." <> pgFmtIdent (ppName a)) <$> prms)
|
||||
|
||||
returnedColumns :: SQL.Snippet
|
||||
returnedColumns
|
||||
| null returnings = "*"
|
||||
| otherwise = SQL.sql $ BS.intercalate ", " (pgFmtColumn (QualifiedIdentifier mempty $ qiName qi) <$> returnings)
|
||||
|
||||
| otherwise = intercalateSnippet ", " (pgFmtColumn (QualifiedIdentifier mempty "pgrst_call") <$> returnings)
|
||||
|
||||
-- | 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.
|
||||
@@ -223,31 +196,43 @@ requestToCallProcQuery (FunctionCall qi params args returnsScalar multipleCall r
|
||||
-- For this case, we use a WHERE EXISTS instead of an INNER JOIN on the count query.
|
||||
-- See https://github.com/PostgREST/postgrest/issues/2009#issuecomment-977473031
|
||||
-- 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) =
|
||||
readPlanToCountQuery :: ReadPlanTree -> SQL.Snippet
|
||||
readPlanToCountQuery (Node ReadPlan{from=mainQi, fromAlias=tblAlias, where_=logicForest, relToParent=rel, relJoinConds} forest) =
|
||||
"SELECT 1 " <> fromFrag <>
|
||||
(if null logicForest && null joinConditions_ && null subQueries
|
||||
(if null logicForest && null relJoinConds && null subQueries
|
||||
then mempty
|
||||
else " WHERE " ) <>
|
||||
intercalateSnippet " AND " (
|
||||
map (pgFmtLogicTree qi) logicForest ++
|
||||
map pgFmtJoinCondition joinConditions_ ++
|
||||
map (pgFmtLogicTreeCount qi) logicForest ++
|
||||
map pgFmtJoinCondition relJoinConds ++
|
||||
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 =
|
||||
existsSubquery :: ReadPlanTree -> [SQL.Snippet] -> [SQL.Snippet]
|
||||
existsSubquery readReq@(Node ReadPlan{relJoinType=joinType} _) rest =
|
||||
if joinType == Just JTInner
|
||||
then ("EXISTS (" <> readRequestToCountQuery readReq <> " )"):rest
|
||||
then ("EXISTS (" <> readPlanToCountQuery readReq <> " )"):rest
|
||||
else rest
|
||||
findNullEmbedRel fld = find (\(Node ReadPlan{relAggAlias} _) -> fld == relAggAlias) forest
|
||||
|
||||
-- https://github.com/PostgREST/postgrest/pull/2930#discussion_r1325293698
|
||||
pgFmtLogicTreeCount :: QualifiedIdentifier -> CoercibleLogicTree -> SQL.Snippet
|
||||
pgFmtLogicTreeCount qiCount (CoercibleExpr hasNot op frst) = SQL.sql notOp <> " (" <> intercalateSnippet (opSql op) (pgFmtLogicTreeCount qiCount <$> frst) <> ")"
|
||||
where
|
||||
notOp = if hasNot then "NOT" else mempty
|
||||
opSql And = " AND "
|
||||
opSql Or = " OR "
|
||||
pgFmtLogicTreeCount _ (CoercibleStmnt (CoercibleFilterNullEmbed hasNot fld)) =
|
||||
maybe mempty (\x -> (if not hasNot then "NOT " else mempty) <> "EXISTS (" <> readPlanToCountQuery x <> ")") (findNullEmbedRel fld)
|
||||
pgFmtLogicTreeCount qiCount (CoercibleStmnt flt) = pgFmtFilter qiCount flt
|
||||
|
||||
limitedQuery :: SQL.Snippet -> Maybe Integer -> SQL.Snippet
|
||||
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
|
||||
-- TODO refactor so this function is uneeded and ComputedRelationship QualifiedIdentifier comes from the ReadPlan type
|
||||
getQualifiedIdentifier :: Maybe Relationship -> QualifiedIdentifier -> Maybe Alias -> QualifiedIdentifier
|
||||
getQualifiedIdentifier rel mainQi tblAlias = case rel of
|
||||
Just ComputedRelationship{relFunction} -> QualifiedIdentifier mempty $ fromMaybe (qiName relFunction) tblAlias
|
||||
@@ -255,10 +240,12 @@ getQualifiedIdentifier rel mainQi tblAlias = case rel of
|
||||
|
||||
-- FROM clause plus implicit joins
|
||||
fromF :: Maybe Relationship -> QualifiedIdentifier -> Maybe Alias -> SQL.Snippet
|
||||
fromF rel mainQi tblAlias = SQL.sql $ "FROM " <>
|
||||
fromF rel mainQi tblAlias = "FROM " <>
|
||||
(case rel of
|
||||
Just ComputedRelationship{relFunction,relTable} -> fromQi relFunction <> "(" <> pgFmtIdent (qiName relTable) <> ")"
|
||||
_ -> fromQi mainQi) <>
|
||||
-- Due to the use of CTEs on RPC, we need to cast the parameter to the table name in case of function overloading.
|
||||
-- See https://github.com/PostgREST/postgrest/issues/2963#issuecomment-1736557386
|
||||
Just ComputedRelationship{relFunction,relTableAlias,relTable} -> fromQi relFunction <> "(" <> pgFmtIdent (qiName relTableAlias) <> "::" <> fromQi relTable <> ")"
|
||||
_ -> fromQi mainQi) <>
|
||||
maybe mempty (\a -> " AS " <> pgFmtIdent a) tblAlias <>
|
||||
(case rel of
|
||||
Just Relationship{relCardinality=M2M Junction{junTable=jt}} -> ", " <> fromQi jt
|
||||
|
||||
+254
-133
@@ -1,135 +1,130 @@
|
||||
{-# LANGUAGE LambdaCase #-}
|
||||
{-# LANGUAGE QuasiQuotes #-}
|
||||
{-# LANGUAGE LambdaCase #-}
|
||||
{-# LANGUAGE NamedFieldPuns #-}
|
||||
{-# LANGUAGE QuasiQuotes #-}
|
||||
{-|
|
||||
Module : PostgREST.Query.SqlFragment
|
||||
Description : Helper functions for PostgREST.QueryBuilder.
|
||||
|
||||
Any function that outputs a SqlFragment should be in this module.
|
||||
-}
|
||||
module PostgREST.Query.SqlFragment
|
||||
( noLocationF
|
||||
, SqlFragment
|
||||
, asBinaryF
|
||||
, asCsvF
|
||||
, asGeoJsonF
|
||||
, asJsonF
|
||||
, asJsonSingleF
|
||||
, asXmlF
|
||||
, aggF
|
||||
, countF
|
||||
, fromQi
|
||||
, limitOffsetF
|
||||
, locationF
|
||||
, mutRangeF
|
||||
, normalizedBody
|
||||
, orderF
|
||||
, pgFmtColumn
|
||||
, pgFmtFilter
|
||||
, pgFmtIdent
|
||||
, pgFmtIdentList
|
||||
, pgFmtJoinCondition
|
||||
, pgFmtLogicTree
|
||||
, pgFmtOrderTerm
|
||||
, pgFmtSelectItem
|
||||
, fromJsonBodyF
|
||||
, responseHeadersF
|
||||
, responseStatusF
|
||||
, returningF
|
||||
, selectBody
|
||||
, singleParameter
|
||||
, sourceCTE
|
||||
, sourceCTEName
|
||||
, unknownEncoder
|
||||
, intercalateSnippet
|
||||
, explainF
|
||||
, setConfigLocal
|
||||
, setConfigLocalJson
|
||||
, escapeIdent
|
||||
, escapeIdentList
|
||||
) where
|
||||
|
||||
import qualified Data.Aeson as JSON
|
||||
import qualified Data.ByteString.Char8 as BS
|
||||
import qualified Data.ByteString.Lazy as LBS
|
||||
import qualified Data.HashMap.Strict as HM
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Text.Encoding as T
|
||||
import qualified Hasql.DynamicStatements.Snippet as SQL
|
||||
import qualified Hasql.Encoders as HE
|
||||
|
||||
import Control.Arrow ((***))
|
||||
|
||||
import Data.Foldable (foldr1)
|
||||
import Text.InterpolatedString.Perl6 (qc)
|
||||
|
||||
import PostgREST.DbStructure.Identifiers (FieldName,
|
||||
QualifiedIdentifier (..))
|
||||
import PostgREST.MediaType (MTPlanFormat (..),
|
||||
MTPlanOption (..))
|
||||
import PostgREST.RangeQuery (NonnegRange, allRange,
|
||||
rangeLimit, rangeOffset)
|
||||
import PostgREST.Request.ReadQuery (SelectItem)
|
||||
import PostgREST.Request.Types (Alias, Field, Filter (..),
|
||||
import PostgREST.ApiRequest.Types (Alias, Cast,
|
||||
FtsOperator (..),
|
||||
JoinCondition (..),
|
||||
JsonOperand (..),
|
||||
JsonOperation (..),
|
||||
JsonPath,
|
||||
LogicOperator (..),
|
||||
LogicTree (..), OpExpr (..),
|
||||
OpExpr (..),
|
||||
OpQuantifier (..),
|
||||
Operation (..),
|
||||
OrderDirection (..),
|
||||
OrderNulls (..),
|
||||
OrderTerm (..),
|
||||
QuantOperator (..),
|
||||
SimpleOperator (..),
|
||||
TrileanVal (..))
|
||||
import PostgREST.MediaType (MTPlanFormat (..),
|
||||
MTPlanOption (..))
|
||||
import PostgREST.Plan.ReadPlan (JoinCondition (..))
|
||||
import PostgREST.Plan.Types (CoercibleField (..),
|
||||
CoercibleFilter (..),
|
||||
CoercibleLogicTree (..),
|
||||
CoercibleOrderTerm (..),
|
||||
unknownField)
|
||||
import PostgREST.RangeQuery (NonnegRange, allRange,
|
||||
rangeLimit, rangeOffset)
|
||||
import PostgREST.SchemaCache.Identifiers (FieldName,
|
||||
QualifiedIdentifier (..))
|
||||
import PostgREST.SchemaCache.Routine (ResultAggregate (..),
|
||||
Routine (..),
|
||||
funcReturnsScalar,
|
||||
funcReturnsSetOfScalar,
|
||||
funcReturnsSingleComposite)
|
||||
|
||||
import Protolude hiding (cast)
|
||||
|
||||
|
||||
-- | A part of a SQL query that cannot be executed independently
|
||||
type SqlFragment = ByteString
|
||||
|
||||
noLocationF :: SqlFragment
|
||||
noLocationF = "array[]::text[]"
|
||||
|
||||
sourceCTEName :: SqlFragment
|
||||
sourceCTEName :: Text
|
||||
sourceCTEName = "pgrst_source"
|
||||
|
||||
singleValOperator :: SimpleOperator -> SqlFragment
|
||||
singleValOperator = \case
|
||||
sourceCTE :: SQL.Snippet
|
||||
sourceCTE = "pgrst_source"
|
||||
|
||||
noLocationF :: SQL.Snippet
|
||||
noLocationF = "array[]::text[]"
|
||||
|
||||
simpleOperator :: SimpleOperator -> SQL.Snippet
|
||||
simpleOperator = \case
|
||||
OpNotEqual -> "<>"
|
||||
OpContains -> "@>"
|
||||
OpContained -> "<@"
|
||||
OpOverlap -> "&&"
|
||||
OpStrictlyLeft -> "<<"
|
||||
OpStrictlyRight -> ">>"
|
||||
OpNotExtendsRight -> "&<"
|
||||
OpNotExtendsLeft -> "&>"
|
||||
OpAdjacent -> "-|-"
|
||||
|
||||
quantOperator :: QuantOperator -> SQL.Snippet
|
||||
quantOperator = \case
|
||||
OpEqual -> "="
|
||||
OpGreaterThanEqual -> ">="
|
||||
OpGreaterThan -> ">"
|
||||
OpLessThanEqual -> "<="
|
||||
OpLessThan -> "<"
|
||||
OpNotEqual -> "<>"
|
||||
OpLike -> "like"
|
||||
OpILike -> "ilike"
|
||||
OpContains -> "@>"
|
||||
OpContained -> "<@"
|
||||
OpOverlap -> "&&"
|
||||
OpStrictlyLeft -> "<<"
|
||||
OpStrictlyRight -> ">>"
|
||||
OpNotExtendsRight -> "&<"
|
||||
OpNotExtendsLeft -> "&>"
|
||||
OpAdjacent -> "-|-"
|
||||
OpMatch -> "~"
|
||||
OpIMatch -> "~*"
|
||||
|
||||
ftsOperator :: FtsOperator -> SqlFragment
|
||||
ftsOperator :: FtsOperator -> SQL.Snippet
|
||||
ftsOperator = \case
|
||||
FilterFts -> "@@ to_tsquery"
|
||||
FilterFtsPlain -> "@@ plainto_tsquery"
|
||||
FilterFtsPhrase -> "@@ phraseto_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
|
||||
-- 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
|
||||
-- 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 =
|
||||
"pgrst_payload AS (SELECT " <> jsonPlaceHolder <> " AS json_data), " <>
|
||||
SQL.sql (BS.unwords [
|
||||
"pgrst_body AS (",
|
||||
"SELECT",
|
||||
"CASE WHEN json_typeof(json_data) = 'array'",
|
||||
"THEN json_data",
|
||||
"ELSE json_build_array(json_data)",
|
||||
"END AS val",
|
||||
"FROM pgrst_payload)"])
|
||||
where
|
||||
jsonPlaceHolder = SQL.encoderAndParam (HE.nullable HE.unknown) (LBS.toStrict <$> body) <> "::json"
|
||||
|
||||
singleParameter :: Maybe LBS.ByteString -> ByteString -> SQL.Snippet
|
||||
singleParameter body typ =
|
||||
if typ == "bytea"
|
||||
@@ -137,9 +132,6 @@ singleParameter body typ =
|
||||
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 = "(SELECT val FROM pgrst_body)"
|
||||
|
||||
-- Here we build the pg array literal, e.g '{"Hebdon, John","Other","Another"}', manually.
|
||||
-- This is necessary to pass an "unknown" array and let pg infer the type.
|
||||
-- There are backslashes here, but since this value is parametrized and is not a string constant
|
||||
@@ -154,8 +146,21 @@ pgBuildArrayLiteral vals =
|
||||
"{" <> T.intercalate "," (escaped <$> vals) <> "}"
|
||||
|
||||
-- TODO: refactor by following https://github.com/PostgREST/postgrest/pull/1631#issuecomment-711070833
|
||||
pgFmtIdent :: Text -> SqlFragment
|
||||
pgFmtIdent x = encodeUtf8 $ "\"" <> T.replace "\"" "\"\"" (trimNullChars x) <> "\""
|
||||
pgFmtIdent :: Text -> SQL.Snippet
|
||||
pgFmtIdent x = SQL.sql $ escapeIdent x
|
||||
|
||||
escapeIdent :: Text -> ByteString
|
||||
escapeIdent x = encodeUtf8 $ "\"" <> T.replace "\"" "\"\"" (trimNullChars x) <> "\""
|
||||
|
||||
-- Only use it if the input comes from the database itself, like on `jsonb_build_object('column_from_a_table', val)..`
|
||||
pgFmtLit :: Text -> Text
|
||||
pgFmtLit x =
|
||||
let trimmed = trimNullChars x
|
||||
escaped = "'" <> T.replace "'" "''" trimmed <> "'"
|
||||
slashed = T.replace "\\" "\\\\" escaped in
|
||||
if "\\" `T.isInfixOf` escaped
|
||||
then "E" <> slashed
|
||||
else slashed
|
||||
|
||||
trimNullChars :: Text -> Text
|
||||
trimNullChars = T.takeWhile (/= '\x0')
|
||||
@@ -163,12 +168,12 @@ trimNullChars = T.takeWhile (/= '\x0')
|
||||
-- |
|
||||
-- Format a list of identifiers and separate them by commas.
|
||||
--
|
||||
-- >>> pgFmtIdentList ["schema_1", "schema_2", "SPECIAL \"@/\\#~_-"]
|
||||
-- >>> escapeIdentList ["schema_1", "schema_2", "SPECIAL \"@/\\#~_-"]
|
||||
-- "\"schema_1\", \"schema_2\", \"SPECIAL \"\"@/\\#~_-\""
|
||||
pgFmtIdentList :: [Text] -> SqlFragment
|
||||
pgFmtIdentList schemas = BS.intercalate ", " $ pgFmtIdent <$> schemas
|
||||
escapeIdentList :: [Text] -> ByteString
|
||||
escapeIdentList schemas = BS.intercalate ", " $ escapeIdent <$> schemas
|
||||
|
||||
asCsvF :: SqlFragment
|
||||
asCsvF :: SQL.Snippet
|
||||
asCsvF = asCsvHeaderF <> " || '\n' || " <> asCsvBodyF
|
||||
where
|
||||
asCsvHeaderF =
|
||||
@@ -176,32 +181,49 @@ asCsvF = asCsvHeaderF <> " || '\n' || " <> asCsvBodyF
|
||||
" FROM (" <>
|
||||
" SELECT json_object_keys(r)::text as k" <>
|
||||
" FROM ( " <>
|
||||
" SELECT row_to_json(hh) as r from " <> sourceCTEName <> " as hh limit 1" <>
|
||||
" SELECT row_to_json(hh) as r from " <> sourceCTE <> " as hh limit 1" <>
|
||||
" ) s" <>
|
||||
" ) a" <>
|
||||
")"
|
||||
asCsvBodyF = "coalesce(string_agg(substring(_postgrest_t::text, 2, length(_postgrest_t::text) - 2), '\n'), '')"
|
||||
|
||||
asJsonF :: Bool -> SqlFragment
|
||||
asJsonF returnsScalar
|
||||
| returnsScalar = "coalesce(json_agg(_postgrest_t.pgrst_scalar), '[]')::character varying"
|
||||
| otherwise = "coalesce(json_agg(_postgrest_t), '[]')::character varying"
|
||||
addNullsToSnip :: Bool -> SQL.Snippet -> SQL.Snippet
|
||||
addNullsToSnip strip snip =
|
||||
if strip then "json_strip_nulls(" <> snip <> ")" else snip
|
||||
|
||||
asJsonSingleF :: Bool -> SqlFragment
|
||||
asJsonSingleF returnsScalar
|
||||
| returnsScalar = "coalesce((json_agg(_postgrest_t.pgrst_scalar)->0)::text, 'null')"
|
||||
| otherwise = "coalesce((json_agg(_postgrest_t)->0)::text, 'null')"
|
||||
asJsonSingleF :: Maybe Routine -> Bool -> SQL.Snippet
|
||||
asJsonSingleF rout strip
|
||||
| returnsScalar = "coalesce(" <> addNullsToSnip strip "json_agg(_postgrest_t.pgrst_scalar)->0" <> ", 'null')"
|
||||
| otherwise = "coalesce(" <> addNullsToSnip strip "json_agg(_postgrest_t)->0" <> ", 'null')"
|
||||
where
|
||||
returnsScalar = maybe False funcReturnsScalar rout
|
||||
|
||||
asXmlF :: FieldName -> SqlFragment
|
||||
asXmlF fieldName = "coalesce(xmlagg(_postgrest_t." <> pgFmtIdent fieldName <> "), '')"
|
||||
asJsonF :: Maybe Routine -> Bool -> SQL.Snippet
|
||||
asJsonF rout strip
|
||||
| returnsSingleComposite = "coalesce(" <> addNullsToSnip strip "json_agg(_postgrest_t)->0" <> ", 'null')"
|
||||
| returnsScalar = "coalesce(" <> addNullsToSnip strip "json_agg(_postgrest_t.pgrst_scalar)->0" <> ", 'null')"
|
||||
| returnsSetOfScalar = "coalesce(" <> addNullsToSnip strip "json_agg(_postgrest_t.pgrst_scalar)" <> ", '[]')"
|
||||
| otherwise = "coalesce(" <> addNullsToSnip strip "json_agg(_postgrest_t)" <> ", '[]')"
|
||||
where
|
||||
(returnsSingleComposite, returnsScalar, returnsSetOfScalar) = case rout of
|
||||
Just r -> (funcReturnsSingleComposite r, funcReturnsScalar r, funcReturnsSetOfScalar r)
|
||||
Nothing -> (False, False, False)
|
||||
|
||||
asGeoJsonF :: SqlFragment
|
||||
|
||||
asXmlF :: Maybe FieldName -> SQL.Snippet
|
||||
asXmlF (Just fieldName) = "coalesce(xmlagg(_postgrest_t." <> pgFmtIdent fieldName <> "), '')"
|
||||
-- TODO unreachable because a previous step(binaryField) will validate that there's a field. This will be cleared once custom media types are implemented.
|
||||
asXmlF Nothing = "coalesce(xmlagg(_postgrest_t), '')"
|
||||
|
||||
asGeoJsonF :: SQL.Snippet
|
||||
asGeoJsonF = "json_build_object('type', 'FeatureCollection', 'features', coalesce(json_agg(ST_AsGeoJSON(_postgrest_t)::json), '[]'))"
|
||||
|
||||
asBinaryF :: FieldName -> SqlFragment
|
||||
asBinaryF fieldName = "coalesce(string_agg(_postgrest_t." <> pgFmtIdent fieldName <> ", ''), '')"
|
||||
asBinaryF :: Maybe FieldName -> SQL.Snippet
|
||||
asBinaryF (Just fieldName) = "coalesce(string_agg(_postgrest_t." <> pgFmtIdent fieldName <> ", ''), '')"
|
||||
-- TODO unreachable because a previous step(binaryField) will validate that there's a field. This will be cleared once custom media types are implemented.
|
||||
asBinaryF Nothing = "coalesce(string_agg(_postgrest_t, ''), '')"
|
||||
|
||||
locationF :: [Text] -> SqlFragment
|
||||
locationF :: [Text] -> SQL.Snippet
|
||||
locationF pKeys = [qc|(
|
||||
WITH data AS (SELECT row_to_json(_) AS row FROM {sourceCTEName} AS _ LIMIT 1)
|
||||
SELECT array_agg(json_data.key || '=' || coalesce('eq.' || json_data.value, 'is.null'))
|
||||
@@ -211,88 +233,161 @@ locationF pKeys = [qc|(
|
||||
where
|
||||
fmtPKeys = T.intercalate "','" pKeys
|
||||
|
||||
fromQi :: QualifiedIdentifier -> SqlFragment
|
||||
fromQi :: QualifiedIdentifier -> SQL.Snippet
|
||||
fromQi t = (if T.null s then mempty else pgFmtIdent s <> ".") <> pgFmtIdent n
|
||||
where
|
||||
n = qiName t
|
||||
s = qiSchema t
|
||||
|
||||
pgFmtColumn :: QualifiedIdentifier -> Text -> SqlFragment
|
||||
pgFmtColumn :: QualifiedIdentifier -> Text -> SQL.Snippet
|
||||
pgFmtColumn table "*" = fromQi table <> ".*"
|
||||
pgFmtColumn table c = fromQi table <> "." <> pgFmtIdent c
|
||||
|
||||
pgFmtField :: QualifiedIdentifier -> Field -> SQL.Snippet
|
||||
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
|
||||
pgFmtCallUnary :: Text -> SQL.Snippet -> SQL.Snippet
|
||||
pgFmtCallUnary f x = SQL.sql (encodeUtf8 f) <> "(" <> x <> ")"
|
||||
|
||||
pgFmtSelectItem :: QualifiedIdentifier -> SelectItem -> SQL.Snippet
|
||||
pgFmtSelectItem table (f@(fName, jp), Nothing, alias, _, _) = pgFmtField table f <> SQL.sql (pgFmtAs fName jp alias)
|
||||
pgFmtField :: QualifiedIdentifier -> CoercibleField -> SQL.Snippet
|
||||
pgFmtField table CoercibleField{cfName=fn, cfJsonPath=[]} = pgFmtColumn table fn
|
||||
pgFmtField table CoercibleField{cfName=fn, cfToJson=doToJson, cfJsonPath=jp} | doToJson = "to_jsonb(" <> pgFmtColumn table fn <> ")" <> pgFmtJsonPath jp
|
||||
| otherwise = pgFmtColumn table fn <> pgFmtJsonPath jp
|
||||
|
||||
-- Select the value of a named element from a table, applying its optional coercion mapping if any.
|
||||
pgFmtTableCoerce :: QualifiedIdentifier -> CoercibleField -> SQL.Snippet
|
||||
pgFmtTableCoerce table fld@(CoercibleField{cfTransform=(Just formatterProc)}) = pgFmtCallUnary formatterProc (pgFmtField table fld)
|
||||
pgFmtTableCoerce table f = pgFmtField table f
|
||||
|
||||
-- | Like the previous but now we just have a name so no namespace or JSON paths.
|
||||
pgFmtCoerceNamed :: CoercibleField -> SQL.Snippet
|
||||
pgFmtCoerceNamed CoercibleField{cfName=fn, cfTransform=(Just formatterProc)} = pgFmtCallUnary formatterProc (pgFmtIdent fn) <> " AS " <> pgFmtIdent fn
|
||||
pgFmtCoerceNamed CoercibleField{cfName=fn} = pgFmtIdent fn
|
||||
|
||||
pgFmtSelectItem :: QualifiedIdentifier -> (CoercibleField, Maybe Cast, Maybe Alias) -> SQL.Snippet
|
||||
pgFmtSelectItem table (fld, Nothing, alias) = pgFmtTableCoerce table fld <> pgFmtAs (cfName fld) (cfJsonPath fld) alias
|
||||
-- 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.
|
||||
-- Not quoting should be fine, we validate the input on Parsers.
|
||||
pgFmtSelectItem table (f@(fName, jp), Just cast, alias, _, _) = "CAST (" <> pgFmtField table f <> " AS " <> SQL.sql (encodeUtf8 cast) <> " )" <> SQL.sql (pgFmtAs fName jp alias)
|
||||
pgFmtSelectItem table (fld, Just cast, alias) = "CAST (" <> pgFmtTableCoerce table fld <> " AS " <> SQL.sql (encodeUtf8 cast) <> " )" <> pgFmtAs (cfName fld) (cfJsonPath fld) alias
|
||||
|
||||
pgFmtOrderTerm :: QualifiedIdentifier -> OrderTerm -> SQL.Snippet
|
||||
pgFmtOrderTerm qi ot =
|
||||
pgFmtField qi (otTerm ot) <> " " <>
|
||||
SQL.sql (BS.unwords [
|
||||
maybe mempty direction $ otDirection ot,
|
||||
maybe mempty nullOrder $ otNullOrder ot])
|
||||
-- TODO: At this stage there shouldn't be a Maybe since ApiRequest should ensure that an INSERT/UPDATE has a body
|
||||
fromJsonBodyF :: Maybe LBS.ByteString -> [CoercibleField] -> Bool -> Bool -> Bool -> SQL.Snippet
|
||||
fromJsonBodyF body fields includeSelect includeLimitOne includeDefaults =
|
||||
(if includeSelect then "SELECT " <> namedCols <> " " else mempty) <>
|
||||
"FROM (SELECT " <> jsonPlaceHolder <> " AS json_data) pgrst_payload, " <>
|
||||
-- convert a json object into a json array, this way we can use json_to_recordset for all json payloads
|
||||
-- Otherwise we'd have to use json_to_record for json objects and json_to_recordset for json arrays
|
||||
-- We do this in SQL to avoid processing the JSON in application code
|
||||
"LATERAL (SELECT CASE WHEN " <> jsonTypeofF <> "(pgrst_payload.json_data) = 'array' THEN pgrst_payload.json_data ELSE " <> jsonBuildArrayF <> "(pgrst_payload.json_data) END AS val) pgrst_uniform_json, " <>
|
||||
(if includeDefaults
|
||||
then "LATERAL (SELECT jsonb_agg(jsonb_build_object(" <> defsJsonb <> ") || elem) AS val from jsonb_array_elements(pgrst_uniform_json.val) elem) pgrst_json_defs, "
|
||||
else mempty) <>
|
||||
"LATERAL (SELECT " <> parsedCols <> " FROM " <>
|
||||
(if null fields
|
||||
-- When we are inserting no columns (e.g. using default values), we can't use our ordinary `json_to_recordset`
|
||||
-- because it can't extract records with no columns (there's no valid syntax for the `AS (colName colType,...)`
|
||||
-- part). But we still need to ensure as many rows are created as there are array elements.
|
||||
then SQL.sql $ jsonArrayElementsF <> "(" <> finalBodyF <> ") _ "
|
||||
else jsonToRecordsetF <> "(" <> SQL.sql finalBodyF <> ") AS _(" <> typedCols <> ") " <> if includeLimitOne then "LIMIT 1" else mempty
|
||||
) <>
|
||||
") pgrst_body "
|
||||
where
|
||||
namedCols = intercalateSnippet ", " $ fromQi . QualifiedIdentifier "pgrst_body" . cfName <$> fields
|
||||
parsedCols = intercalateSnippet ", " $ pgFmtCoerceNamed <$> fields
|
||||
typedCols = intercalateSnippet ", " $ pgFmtIdent . cfName <> const " " <> SQL.sql . encodeUtf8 . cfIRType <$> fields
|
||||
defsJsonb = SQL.sql $ BS.intercalate "," fieldsWDefaults
|
||||
fieldsWDefaults = mapMaybe (\case
|
||||
CoercibleField{cfName=nam, cfDefault=Just def} -> Just $ encodeUtf8 (pgFmtLit nam <> ", " <> def)
|
||||
CoercibleField{cfDefault=Nothing} -> Nothing
|
||||
) fields
|
||||
(finalBodyF, jsonTypeofF, jsonBuildArrayF, jsonArrayElementsF, jsonToRecordsetF) =
|
||||
if includeDefaults
|
||||
then ("pgrst_json_defs.val", "jsonb_typeof", "jsonb_build_array", "jsonb_array_elements", "jsonb_to_recordset")
|
||||
else ("pgrst_uniform_json.val", "json_typeof", "json_build_array", "json_array_elements", "json_to_recordset")
|
||||
jsonPlaceHolder = SQL.encoderAndParam (HE.nullable $ if includeDefaults then HE.jsonbLazyBytes else HE.jsonLazyBytes) body
|
||||
|
||||
pgFmtOrderTerm :: QualifiedIdentifier -> CoercibleOrderTerm -> SQL.Snippet
|
||||
pgFmtOrderTerm qi ot =
|
||||
fmtOTerm ot <> " " <>
|
||||
SQL.sql (BS.unwords [
|
||||
maybe mempty direction $ coDirection ot,
|
||||
maybe mempty nullOrder $ coNullOrder ot])
|
||||
where
|
||||
fmtOTerm = \case
|
||||
CoercibleOrderTerm{coField=cof} -> pgFmtField qi cof
|
||||
CoercibleOrderRelationTerm{coRelation, coRelTerm=(fn, jp)} -> pgFmtField (QualifiedIdentifier mempty coRelation) (unknownField fn jp)
|
||||
|
||||
direction OrderAsc = "ASC"
|
||||
direction OrderDesc = "DESC"
|
||||
|
||||
nullOrder OrderNullsFirst = "NULLS FIRST"
|
||||
nullOrder OrderNullsLast = "NULLS LAST"
|
||||
|
||||
-- | Interpret a literal in the way the planner indicated through the CoercibleField.
|
||||
pgFmtUnknownLiteralForField :: SQL.Snippet -> CoercibleField -> SQL.Snippet
|
||||
pgFmtUnknownLiteralForField value CoercibleField{cfTransform=(Just parserProc)} = pgFmtCallUnary parserProc value
|
||||
-- But when no transform is requested, we just use the literal as-is.
|
||||
pgFmtUnknownLiteralForField value _ = value
|
||||
|
||||
pgFmtFilter :: QualifiedIdentifier -> Filter -> SQL.Snippet
|
||||
pgFmtFilter table (Filter fld (OpExpr hasNot oper)) = notOp <> " " <> case oper of
|
||||
Op op val -> pgFmtFieldOp op <> " " <> case op of
|
||||
OpLike -> unknownLiteral (T.map star val)
|
||||
OpILike -> unknownLiteral (T.map star val)
|
||||
_ -> unknownLiteral val
|
||||
-- | Array version of the above, used by ANY().
|
||||
pgFmtArrayLiteralForField :: [Text] -> CoercibleField -> SQL.Snippet
|
||||
-- When a transformation is requested, we need to apply the transformation to each element of the array. This could be done by just making a query with `parser(value)` for each value, but may lead to huge query lengths. Imagine `data_representations.color_from_text('...'::text)` for repeated for a hundred values. Instead we use `unnest()` to unpack a standard array literal and then apply the transformation to each element, like a map.
|
||||
-- Note the literals will be treated as text since in every case when we use ANY() the parameters are textual (coming from a query string). We want to rely on the `text->domain` parser to do the right thing.
|
||||
pgFmtArrayLiteralForField values CoercibleField{cfTransform=(Just parserProc)} = SQL.sql "(SELECT " <> pgFmtCallUnary parserProc (SQL.sql "unnest(" <> unknownLiteral (pgBuildArrayLiteral values) <> "::text[])") <> ")"
|
||||
-- When no transformation is requested, we don't need a subquery.
|
||||
pgFmtArrayLiteralForField values _ = unknownLiteral (pgBuildArrayLiteral values)
|
||||
|
||||
|
||||
pgFmtFilter :: QualifiedIdentifier -> CoercibleFilter -> SQL.Snippet
|
||||
pgFmtFilter _ (CoercibleFilterNullEmbed hasNot fld) = pgFmtIdent fld <> " IS " <> (if not hasNot then "NOT " else mempty) <> "DISTINCT FROM NULL"
|
||||
pgFmtFilter _ (CoercibleFilter _ (NoOpExpr _)) = mempty -- TODO unreachable because NoOpExpr is filtered on QueryParams
|
||||
pgFmtFilter table (CoercibleFilter fld (OpExpr hasNot oper)) = notOp <> " " <> pgFmtField table fld <> case oper of
|
||||
Op op val -> " " <> simpleOperator op <> " " <> pgFmtUnknownLiteralForField (unknownLiteral val) fld
|
||||
|
||||
OpQuant op quant val -> " " <> quantOperator op <> " " <> case op of
|
||||
OpLike -> fmtQuant quant $ unknownLiteral (T.map star val)
|
||||
OpILike -> fmtQuant quant $ unknownLiteral (T.map star val)
|
||||
_ -> fmtQuant quant $ pgFmtUnknownLiteralForField (unknownLiteral val) fld
|
||||
|
||||
-- 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
|
||||
Is triVal -> " IS " <> case triVal of
|
||||
TriTrue -> "TRUE"
|
||||
TriFalse -> "FALSE"
|
||||
TriNull -> "NULL"
|
||||
TriUnknown -> "UNKNOWN"
|
||||
|
||||
IsDistinctFrom val -> " IS DISTINCT FROM " <> unknownLiteral val
|
||||
|
||||
-- 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('{}')"
|
||||
-- + 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 <> " " <> case vals of
|
||||
In vals -> " " <> case vals of
|
||||
[""] -> "= ANY('{}') "
|
||||
_ -> "= ANY (" <> unknownLiteral (pgBuildArrayLiteral vals) <> ") "
|
||||
_ -> "= ANY (" <> pgFmtArrayLiteralForField vals fld <> ") "
|
||||
|
||||
Fts op lang val ->
|
||||
pgFmtFieldFts op <> "(" <> ftsLang lang <> unknownLiteral val <> ") "
|
||||
Fts op lang val -> " " <> ftsOperator op <> "(" <> ftsLang lang <> unknownLiteral val <> ") "
|
||||
where
|
||||
ftsLang = maybe mempty (\l -> unknownLiteral l <> ", ")
|
||||
pgFmtFieldOp op = pgFmtField table fld <> " " <> SQL.sql (singleValOperator op)
|
||||
pgFmtFieldFts op = pgFmtField table fld <> " " <> SQL.sql (ftsOperator op)
|
||||
notOp = if hasNot then "NOT" else mempty
|
||||
star c = if c == '*' then '%' else c
|
||||
fmtQuant q val = case q of
|
||||
Just QuantAny -> "ANY(" <> val <> ")"
|
||||
Just QuantAll -> "ALL(" <> val <> ")"
|
||||
Nothing -> val
|
||||
|
||||
pgFmtJoinCondition :: JoinCondition -> SQL.Snippet
|
||||
pgFmtJoinCondition (JoinCondition (qi1, col1) (qi2, col2)) =
|
||||
SQL.sql $ pgFmtColumn qi1 col1 <> " = " <> pgFmtColumn qi2 col2
|
||||
pgFmtColumn qi1 col1 <> " = " <> pgFmtColumn qi2 col2
|
||||
|
||||
pgFmtLogicTree :: QualifiedIdentifier -> LogicTree -> SQL.Snippet
|
||||
pgFmtLogicTree qi (Expr hasNot op forest) = SQL.sql notOp <> " (" <> intercalateSnippet (opSql op) (pgFmtLogicTree qi <$> forest) <> ")"
|
||||
pgFmtLogicTree :: QualifiedIdentifier -> CoercibleLogicTree -> SQL.Snippet
|
||||
pgFmtLogicTree qi (CoercibleExpr hasNot op forest) = SQL.sql notOp <> " (" <> intercalateSnippet (opSql op) (pgFmtLogicTree qi <$> forest) <> ")"
|
||||
where
|
||||
notOp = if hasNot then "NOT" else mempty
|
||||
|
||||
opSql And = " AND "
|
||||
opSql Or = " OR "
|
||||
pgFmtLogicTree qi (Stmnt flt) = pgFmtFilter qi flt
|
||||
pgFmtLogicTree qi (CoercibleStmnt flt) = pgFmtFilter qi flt
|
||||
|
||||
pgFmtJsonPath :: JsonPath -> SQL.Snippet
|
||||
pgFmtJsonPath = \case
|
||||
@@ -303,7 +398,7 @@ pgFmtJsonPath = \case
|
||||
pgFmtJsonOperand (JKey k) = unknownLiteral k
|
||||
pgFmtJsonOperand (JIdx i) = unknownLiteral i <> "::int"
|
||||
|
||||
pgFmtAs :: FieldName -> JsonPath -> Maybe Alias -> SqlFragment
|
||||
pgFmtAs :: FieldName -> JsonPath -> Maybe Alias -> SQL.Snippet
|
||||
pgFmtAs _ [] Nothing = mempty
|
||||
pgFmtAs fName jp Nothing = case jOp <$> lastMay jp of
|
||||
Just (JKey key) -> " AS " <> pgFmtIdent key
|
||||
@@ -315,7 +410,7 @@ pgFmtAs fName jp Nothing = case jOp <$> lastMay jp of
|
||||
Nothing -> mempty
|
||||
pgFmtAs _ _ (Just alias) = " AS " <> pgFmtIdent alias
|
||||
|
||||
countF :: SQL.Snippet -> Bool -> (SQL.Snippet, SqlFragment)
|
||||
countF :: SQL.Snippet -> Bool -> (SQL.Snippet, SQL.Snippet)
|
||||
countF countQuery shouldCount =
|
||||
if shouldCount
|
||||
then (
|
||||
@@ -325,11 +420,11 @@ countF countQuery shouldCount =
|
||||
mempty
|
||||
, "null::bigint")
|
||||
|
||||
returningF :: QualifiedIdentifier -> [FieldName] -> SqlFragment
|
||||
returningF :: QualifiedIdentifier -> [FieldName] -> SQL.Snippet
|
||||
returningF qi returnings =
|
||||
if null returnings
|
||||
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 " <> intercalateSnippet ", " (pgFmtColumn qi <$> returnings)
|
||||
|
||||
limitOffsetF :: NonnegRange -> SQL.Snippet
|
||||
limitOffsetF range =
|
||||
@@ -338,25 +433,25 @@ limitOffsetF range =
|
||||
limit = maybe "ALL" (\l -> unknownEncoder (BS.pack $ show l)) $ rangeLimit range
|
||||
offset = unknownEncoder (BS.pack . show $ rangeOffset range)
|
||||
|
||||
responseHeadersF :: SqlFragment
|
||||
responseHeadersF :: SQL.Snippet
|
||||
responseHeadersF = currentSettingF "response.headers"
|
||||
|
||||
responseStatusF :: SqlFragment
|
||||
responseStatusF :: SQL.Snippet
|
||||
responseStatusF = currentSettingF "response.status"
|
||||
|
||||
currentSettingF :: SqlFragment -> SqlFragment
|
||||
currentSettingF :: SQL.Snippet -> SQL.Snippet
|
||||
currentSettingF setting =
|
||||
-- nullif is used because of https://gist.github.com/steve-chavez/8d7033ea5655096903f3b52f8ed09a15
|
||||
"nullif(current_setting('" <> setting <> "', true), '')"
|
||||
|
||||
mutRangeF :: QualifiedIdentifier -> [FieldName] -> (SqlFragment, SqlFragment)
|
||||
mutRangeF :: QualifiedIdentifier -> [FieldName] -> (SQL.Snippet, SQL.Snippet)
|
||||
mutRangeF mainQi rangeId =
|
||||
(
|
||||
BS.intercalate " AND " $ (\col -> pgFmtColumn mainQi col <> " = " <> pgFmtColumn (QualifiedIdentifier mempty "pgrst_affected_rows") col) <$> rangeId
|
||||
, BS.intercalate ", " (pgFmtColumn mainQi <$> rangeId)
|
||||
intercalateSnippet " AND " $ (\col -> pgFmtColumn mainQi col <> " = " <> pgFmtColumn (QualifiedIdentifier mempty "pgrst_affected_rows") col) <$> rangeId
|
||||
, intercalateSnippet ", " (pgFmtColumn mainQi <$> rangeId)
|
||||
)
|
||||
|
||||
orderF :: QualifiedIdentifier -> [OrderTerm] -> SQL.Snippet
|
||||
orderF :: QualifiedIdentifier -> [CoercibleOrderTerm] -> SQL.Snippet
|
||||
orderF _ [] = mempty
|
||||
orderF qi ordts = "ORDER BY " <> intercalateSnippet ", " (pgFmtOrderTerm qi <$> ordts)
|
||||
|
||||
@@ -384,5 +479,31 @@ explainF fmt opts snip =
|
||||
fmtPlanOpt PlanBuffers = "BUFFERS"
|
||||
fmtPlanOpt PlanWAL = "WAL"
|
||||
|
||||
fmtPlanFmt PlanJSON = "FORMAT JSON"
|
||||
fmtPlanFmt PlanText = "FORMAT TEXT"
|
||||
fmtPlanFmt PlanJSON = "FORMAT JSON"
|
||||
|
||||
-- | 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
|
||||
|
||||
aggF :: Maybe Routine -> ResultAggregate -> SQL.Snippet
|
||||
aggF rout = \case
|
||||
BuiltinAggJson -> asJsonF rout False
|
||||
BuiltinAggArrayJsonStrip -> asJsonF rout True
|
||||
BuiltinAggSingleJson strip -> asJsonSingleF rout strip
|
||||
BuiltinAggGeoJson -> asGeoJsonF
|
||||
BuiltinAggCsv -> asCsvF
|
||||
BuiltinAggXml bField -> asXmlF bField
|
||||
BuiltinAggBinary bField -> asBinaryF bField
|
||||
NoAgg -> "''::text"
|
||||
|
||||
@@ -15,30 +15,21 @@ module PostgREST.Query.Statements
|
||||
, ResultSet (..)
|
||||
) where
|
||||
|
||||
import qualified Data.Aeson as JSON
|
||||
import qualified Data.Aeson.Lens as L
|
||||
import qualified Data.ByteString.Char8 as BS
|
||||
import qualified Data.ByteString.Lazy as LBS
|
||||
import qualified Hasql.Decoders as HD
|
||||
import qualified Hasql.DynamicStatements.Snippet as SQL
|
||||
import qualified Hasql.DynamicStatements.Statement as SQL
|
||||
import qualified Hasql.Statement as SQL
|
||||
|
||||
import Control.Lens ((^?))
|
||||
import Data.Maybe (fromJust)
|
||||
import Data.Text.Read (decimal)
|
||||
import Network.HTTP.Types.Status (Status)
|
||||
import Control.Lens ((^?))
|
||||
|
||||
import PostgREST.Error (Error (..))
|
||||
import PostgREST.GucHeader (GucHeader)
|
||||
|
||||
import PostgREST.DbStructure.Identifiers (FieldName)
|
||||
import PostgREST.MediaType (MTPlanAttrs (..),
|
||||
MTPlanFormat (..),
|
||||
MediaType (..),
|
||||
getMediaType)
|
||||
import PostgREST.ApiRequest.Preferences
|
||||
import PostgREST.MediaType (MTPlanFormat (..),
|
||||
MediaType (..))
|
||||
import PostgREST.Query.SqlFragment
|
||||
import PostgREST.Request.Preferences
|
||||
import PostgREST.SchemaCache.Routine (ResultAggregate (..),
|
||||
Routine)
|
||||
|
||||
import Protolude
|
||||
|
||||
@@ -54,122 +45,94 @@ data ResultSet
|
||||
-- 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]
|
||||
, rsGucHeaders :: Maybe BS.ByteString
|
||||
-- ^ the HTTP headers to be added to the response
|
||||
, rsGucStatus :: Either Error (Maybe Status)
|
||||
, rsGucStatus :: Maybe Text
|
||||
-- ^ the HTTP status to be added to the response
|
||||
}
|
||||
| RSPlan BS.ByteString -- ^ the plan of the query
|
||||
|
||||
|
||||
prepareWrite :: SQL.Snippet -> SQL.Snippet -> Bool -> MediaType ->
|
||||
PreferRepresentation -> [Text] -> Bool -> SQL.Statement () ResultSet
|
||||
prepareWrite selectQuery mutateQuery isInsert mt rep pKeys =
|
||||
prepareWrite :: SQL.Snippet -> SQL.Snippet -> Bool -> MediaType -> ResultAggregate ->
|
||||
Maybe PreferRepresentation -> [Text] -> Bool -> SQL.Statement () ResultSet
|
||||
prepareWrite selectQuery mutateQuery isInsert mt rAgg rep pKeys =
|
||||
SQL.dynamicallyParameterized (mtSnippet mt snippet) decodeIt
|
||||
where
|
||||
snippet =
|
||||
"WITH " <> SQL.sql sourceCTEName <> " AS (" <> mutateQuery <> ") " <>
|
||||
SQL.sql (
|
||||
"WITH " <> sourceCTE <> " AS (" <> mutateQuery <> ") " <>
|
||||
"SELECT " <>
|
||||
"'' AS total_result_set, " <>
|
||||
"pg_catalog.count(_postgrest_t) AS page_total, " <>
|
||||
locF <> " AS header, " <>
|
||||
bodyF <> " AS body, " <>
|
||||
aggF Nothing rAgg <> " AS body, " <>
|
||||
responseHeadersF <> " AS response_headers, " <>
|
||||
responseStatusF <> " AS response_status "
|
||||
) <>
|
||||
responseStatusF <> " AS response_status " <>
|
||||
"FROM (" <> selectF <> ") _postgrest_t"
|
||||
|
||||
locF =
|
||||
if isInsert && rep == HeadersOnly
|
||||
then BS.unwords [
|
||||
"CASE WHEN pg_catalog.count(_postgrest_t) = 1",
|
||||
"THEN coalesce(" <> locationF pKeys <> ", " <> noLocationF <> ")",
|
||||
"ELSE " <> noLocationF,
|
||||
"END"]
|
||||
if isInsert && rep == Just HeadersOnly
|
||||
then
|
||||
"CASE WHEN pg_catalog.count(_postgrest_t) = 1 " <>
|
||||
"THEN coalesce(" <> locationF pKeys <> ", " <> noLocationF <> ") " <>
|
||||
"ELSE " <> noLocationF <> " " <>
|
||||
"END"
|
||||
else noLocationF
|
||||
|
||||
bodyF
|
||||
| rep /= Full = "''"
|
||||
| getMediaType mt == MTTextCSV = asCsvF
|
||||
| getMediaType mt == MTGeoJSON = asGeoJsonF
|
||||
| getMediaType mt == MTSingularJSON = asJsonSingleF False
|
||||
| otherwise = asJsonF False
|
||||
|
||||
selectF
|
||||
-- prevent using any of the column names in ?select= when no response is returned from the CTE
|
||||
| rep /= Full = SQL.sql ("SELECT * FROM " <> sourceCTEName)
|
||||
| otherwise = selectQuery
|
||||
| rAgg == NoAgg = "SELECT * FROM " <> sourceCTE
|
||||
| otherwise = selectQuery
|
||||
|
||||
decodeIt :: HD.Result ResultSet
|
||||
decodeIt = case mt of
|
||||
MTPlan{} -> planRow
|
||||
_ -> fromMaybe (RSStandard Nothing 0 mempty mempty (Right []) (Right Nothing)) <$> HD.rowMaybe (standardRow False)
|
||||
_ -> fromMaybe (RSStandard Nothing 0 mempty mempty Nothing Nothing) <$> HD.rowMaybe (standardRow False)
|
||||
|
||||
prepareRead :: SQL.Snippet -> SQL.Snippet -> Bool -> MediaType -> Maybe FieldName -> Bool -> SQL.Statement () ResultSet
|
||||
prepareRead selectQuery countQuery countTotal mt binaryField =
|
||||
prepareRead :: SQL.Snippet -> SQL.Snippet -> Bool -> MediaType -> ResultAggregate -> Bool -> SQL.Statement () ResultSet
|
||||
prepareRead selectQuery countQuery countTotal mt rAgg =
|
||||
SQL.dynamicallyParameterized (mtSnippet mt snippet) decodeIt
|
||||
where
|
||||
snippet =
|
||||
"WITH " <>
|
||||
SQL.sql sourceCTEName <> " AS ( " <> selectQuery <> " ) " <>
|
||||
"WITH " <> sourceCTE <> " AS ( " <> selectQuery <> " ) " <>
|
||||
countCTEF <> " " <>
|
||||
SQL.sql ("SELECT " <>
|
||||
"SELECT " <>
|
||||
countResultF <> " AS total_result_set, " <>
|
||||
"pg_catalog.count(_postgrest_t) AS page_total, " <>
|
||||
bodyF <> " AS body, " <>
|
||||
aggF Nothing rAgg <> " AS body, " <>
|
||||
responseHeadersF <> " AS response_headers, " <>
|
||||
responseStatusF <> " AS response_status " <>
|
||||
"FROM ( SELECT * FROM " <> sourceCTEName <> " ) _postgrest_t")
|
||||
"FROM ( SELECT * FROM " <> sourceCTE <> " ) _postgrest_t"
|
||||
|
||||
(countCTEF, countResultF) = countF countQuery countTotal
|
||||
|
||||
bodyF
|
||||
| getMediaType mt == MTTextCSV = asCsvF
|
||||
| getMediaType mt == MTSingularJSON = asJsonSingleF False
|
||||
| getMediaType mt == MTGeoJSON = asGeoJsonF
|
||||
| isJust binaryField && getMediaType mt == MTTextXML = asXmlF $ fromJust binaryField
|
||||
| isJust binaryField = asBinaryF $ fromJust binaryField
|
||||
| otherwise = asJsonF False
|
||||
|
||||
decodeIt :: HD.Result ResultSet
|
||||
decodeIt = case mt of
|
||||
MTPlan{} -> planRow
|
||||
_ -> HD.singleRow $ standardRow True
|
||||
|
||||
prepareCall :: Bool -> Bool -> SQL.Snippet -> SQL.Snippet -> SQL.Snippet -> Bool ->
|
||||
MediaType -> Bool -> Maybe FieldName -> Bool ->
|
||||
prepareCall :: Routine -> SQL.Snippet -> SQL.Snippet -> SQL.Snippet -> Bool ->
|
||||
MediaType -> ResultAggregate -> Bool ->
|
||||
SQL.Statement () ResultSet
|
||||
prepareCall returnsScalar returnsSingle callProcQuery selectQuery countQuery countTotal mt multObjects binaryField =
|
||||
prepareCall rout callProcQuery selectQuery countQuery countTotal mt rAgg =
|
||||
SQL.dynamicallyParameterized (mtSnippet mt snippet) decodeIt
|
||||
where
|
||||
snippet =
|
||||
"WITH " <> SQL.sql sourceCTEName <> " AS (" <> callProcQuery <> ") " <>
|
||||
"WITH " <> sourceCTE <> " AS (" <> callProcQuery <> ") " <>
|
||||
countCTEF <>
|
||||
SQL.sql (
|
||||
"SELECT " <>
|
||||
countResultF <> " AS total_result_set, " <>
|
||||
"pg_catalog.count(_postgrest_t) AS page_total, " <>
|
||||
bodyF <> " AS body, " <>
|
||||
aggF (Just rout) rAgg <> " AS body, " <>
|
||||
responseHeadersF <> " AS response_headers, " <>
|
||||
responseStatusF <> " AS response_status ") <>
|
||||
responseStatusF <> " AS response_status " <>
|
||||
"FROM (" <> selectQuery <> ") _postgrest_t"
|
||||
|
||||
(countCTEF, countResultF) = countF countQuery countTotal
|
||||
|
||||
bodyF
|
||||
| getMediaType mt == MTSingularJSON = asJsonSingleF returnsScalar
|
||||
| getMediaType mt == MTTextCSV = asCsvF
|
||||
| getMediaType mt == MTGeoJSON = asGeoJsonF
|
||||
| isJust binaryField && getMediaType mt == MTTextXML = asXmlF $ fromJust binaryField
|
||||
| isJust binaryField = asBinaryF $ fromJust binaryField
|
||||
| returnsSingle && not multObjects = asJsonSingleF returnsScalar
|
||||
| otherwise = asJsonF returnsScalar
|
||||
|
||||
decodeIt :: HD.Result ResultSet
|
||||
decodeIt = case mt of
|
||||
MTPlan{} -> planRow
|
||||
_ -> fromMaybe (RSStandard (Just 0) 0 mempty mempty (Right []) (Right Nothing)) <$> HD.rowMaybe (standardRow True)
|
||||
_ -> fromMaybe (RSStandard (Just 0) 0 mempty mempty Nothing Nothing) <$> HD.rowMaybe (standardRow True)
|
||||
|
||||
preparePlanRows :: SQL.Snippet -> Bool -> SQL.Statement () (Maybe Int64)
|
||||
preparePlanRows countQuery =
|
||||
@@ -185,8 +148,8 @@ 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)
|
||||
<*> nullableColumn HD.bytea
|
||||
<*> nullableColumn HD.text
|
||||
where
|
||||
splitKeyValue :: ByteString -> (ByteString, ByteString)
|
||||
splitKeyValue kv =
|
||||
@@ -195,19 +158,13 @@ standardRow noLocation =
|
||||
|
||||
mtSnippet :: MediaType -> SQL.Snippet -> SQL.Snippet
|
||||
mtSnippet mediaType snippet = case mediaType of
|
||||
MTPlan (MTPlanAttrs _ fmt opts) -> explainF fmt opts snippet
|
||||
_ -> snippet
|
||||
MTPlan _ 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 = first (const GucHeadersError) . JSON.eitherDecode . LBS.fromStrict <$> HD.bytea
|
||||
|
||||
decodeGucStatus :: HD.Value (Either Error (Maybe Status))
|
||||
decodeGucStatus = first (const GucStatusError) . fmap (Just . toEnum . fst) . decimal <$> HD.text
|
||||
|
||||
column :: HD.Value a -> HD.Row a
|
||||
column = HD.column . HD.nonNullable
|
||||
|
||||
|
||||
@@ -12,6 +12,7 @@ module PostgREST.RangeQuery (
|
||||
, allRange
|
||||
, limitZeroRange
|
||||
, hasLimitZero
|
||||
, convertToLimitZeroRange
|
||||
, NonnegRange
|
||||
, rangeStatusHeader
|
||||
, contentRangeH
|
||||
@@ -86,6 +87,12 @@ limitZeroRange = Range (BoundaryBelow 0) (BoundaryAbove (-1))
|
||||
hasLimitZero :: Range Integer -> Bool
|
||||
hasLimitZero r = rangeUpper r == rangeUpper limitZeroRange
|
||||
|
||||
-- Used to convert a range into a special limitZeroRange if it has a
|
||||
-- limit=0 in order to bypass validations for empty ranges.
|
||||
convertToLimitZeroRange :: Range Integer -> Range Integer -> Range Integer
|
||||
convertToLimitZeroRange range fallbackRange =
|
||||
if hasLimitZero range then limitZeroRange else fallbackRange
|
||||
|
||||
rangeStatusHeader :: NonnegRange -> Int64 -> Maybe Int64 -> (Status, Header)
|
||||
rangeStatusHeader topLevelRange queryTotal tableTotal =
|
||||
let lower = rangeOffset topLevelRange
|
||||
|
||||
@@ -1,488 +0,0 @@
|
||||
{-|
|
||||
Module : PostgREST.Request.ApiRequest
|
||||
Description : PostgREST functions to translate HTTP request to a domain type called ApiRequest.
|
||||
-}
|
||||
{-# LANGUAGE LambdaCase #-}
|
||||
{-# LANGUAGE NamedFieldPuns #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
|
||||
module PostgREST.Request.ApiRequest
|
||||
( ApiRequest(..)
|
||||
, InvokeMethod(..)
|
||||
, Mutation(..)
|
||||
, MediaType(..)
|
||||
, Action(..)
|
||||
, Target(..)
|
||||
, Payload(..)
|
||||
, userApiRequest
|
||||
) where
|
||||
|
||||
import qualified Data.Aeson as JSON
|
||||
import qualified Data.Aeson.Key as K
|
||||
import qualified Data.Aeson.KeyMap as KM
|
||||
import qualified Data.ByteString.Char8 as BS
|
||||
import qualified Data.ByteString.Lazy as LBS
|
||||
import qualified Data.CaseInsensitive as CI
|
||||
import qualified Data.Csv as CSV
|
||||
import qualified Data.HashMap.Strict as HM
|
||||
import qualified Data.List as L
|
||||
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 Data.Aeson.Types (emptyArray, emptyObject)
|
||||
import Data.List (lookup, union)
|
||||
import Data.Maybe (fromJust)
|
||||
import Data.Ranged.Ranges (emptyRange, rangeIntersection)
|
||||
import Network.HTTP.Types.Header (hCookie)
|
||||
import Network.HTTP.Types.URI (parseSimpleQuery)
|
||||
import Network.Wai (Request (..))
|
||||
import Network.Wai.Parse (parseHttpAccept)
|
||||
import Web.Cookie (parseCookies)
|
||||
|
||||
import PostgREST.Config (AppConfig (..),
|
||||
OpenAPIMode (..))
|
||||
import PostgREST.DbStructure (DbStructure (..))
|
||||
import PostgREST.DbStructure.Identifiers (FieldName,
|
||||
QualifiedIdentifier (..),
|
||||
Schema)
|
||||
import PostgREST.DbStructure.Proc (ProcDescription (..),
|
||||
ProcParam (..), ProcsMap)
|
||||
import PostgREST.MediaType (MTPlanAttrs (..),
|
||||
MTPlanFormat (..),
|
||||
MediaType (..))
|
||||
import PostgREST.RangeQuery (NonnegRange, allRange,
|
||||
hasLimitZero,
|
||||
limitZeroRange,
|
||||
rangeRequested)
|
||||
import PostgREST.Request.Preferences (PreferCount (..),
|
||||
PreferParameters (..),
|
||||
PreferRepresentation (..),
|
||||
PreferResolution (..),
|
||||
PreferTransaction (..))
|
||||
import PostgREST.Request.QueryParams (QueryParams (..))
|
||||
import PostgREST.Request.Types (ApiRequestError (..))
|
||||
|
||||
import qualified PostgREST.MediaType as MediaType
|
||||
import qualified PostgREST.Request.Preferences as Preferences
|
||||
import qualified PostgREST.Request.QueryParams as QueryParams
|
||||
|
||||
import Protolude
|
||||
|
||||
|
||||
type RequestBody = LBS.ByteString
|
||||
|
||||
data Payload
|
||||
= ProcessedJSON -- ^ Cached attributes of a JSON payload
|
||||
{ payRaw :: LBS.ByteString
|
||||
-- ^ 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
|
||||
-- large payloads the encoding had high memory usage, see
|
||||
-- https://github.com/PostgREST/postgrest/pull/1005 for more details
|
||||
, payKeys :: S.Set Text
|
||||
-- ^ Keys of the object or if it's an array these keys are guaranteed to
|
||||
-- be the same across all its objects
|
||||
}
|
||||
| RawJSON { payRaw :: LBS.ByteString }
|
||||
| RawPay { payRaw :: LBS.ByteString }
|
||||
|
||||
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
|
||||
data Action
|
||||
= ActionMutate Mutation
|
||||
| ActionRead {isHead :: Bool}
|
||||
| ActionInvoke InvokeMethod
|
||||
| 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)
|
||||
data PathInfo
|
||||
= PathInfo
|
||||
{ pathName :: Text
|
||||
, pathIsProc :: Bool
|
||||
, pathIsDefSpec :: Bool
|
||||
, pathIsRootSpec :: Bool
|
||||
}
|
||||
-- | The target db object of a user action
|
||||
data Target = TargetIdent QualifiedIdentifier
|
||||
| TargetProc{tProc :: ProcDescription, tpIsRootSpec :: Bool}
|
||||
| TargetDefaultSpec{tdsSchema :: Schema} -- The default spec offered at root "/"
|
||||
|
||||
-- | 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.
|
||||
data RpcParamValue = Fixed Text | Variadic [Text]
|
||||
instance JSON.ToJSON RpcParamValue where
|
||||
toJSON (Fixed v) = JSON.toJSON v
|
||||
toJSON (Variadic v) = JSON.toJSON v
|
||||
|
||||
toRpcParamValue :: ProcDescription -> (Text, Text) -> (Text, RpcParamValue)
|
||||
toRpcParamValue proc (k, v) | prmIsVariadic k = (k, Variadic [v])
|
||||
| otherwise = (k, Fixed v)
|
||||
where
|
||||
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"}
|
||||
jsonRpcParams :: ProcDescription -> [(Text, Text)] -> Payload
|
||||
jsonRpcParams proc prms =
|
||||
if not $ pdHasVariadic proc then -- if proc has no variadic param, save steps and directly convert to json
|
||||
ProcessedJSON (JSON.encode $ HM.fromList $ second JSON.toJSON <$> prms) (S.fromList $ fst <$> prms)
|
||||
else
|
||||
let paramsMap = HM.fromListWith mergeParams $ toRpcParamValue proc <$> prms in
|
||||
ProcessedJSON (JSON.encode paramsMap) (S.fromList $ HM.keys paramsMap)
|
||||
where
|
||||
mergeParams :: RpcParamValue -> RpcParamValue -> RpcParamValue
|
||||
mergeParams (Variadic a) (Variadic b) = Variadic $ b ++ a
|
||||
mergeParams v _ = v -- repeated params for non-variadic parameters are not merged
|
||||
|
||||
targetToJsonRpcParams :: Maybe Target -> [(Text, Text)] -> Maybe Payload
|
||||
targetToJsonRpcParams target params =
|
||||
case target of
|
||||
Just TargetProc{tProc} -> Just $ jsonRpcParams tProc params
|
||||
_ -> Nothing
|
||||
|
||||
{-|
|
||||
Describes what the user wants to do. This data type is a
|
||||
translation of the raw elements of an HTTP request into domain
|
||||
specific language. There is no guarantee that the intent is
|
||||
sensible, it is up to a later stage of processing to determine
|
||||
if it is an action we are able to perform.
|
||||
-}
|
||||
data ApiRequest = ApiRequest {
|
||||
iAction :: Action -- ^ Similar but not identical to HTTP method, e.g. Create/Invoke both POST
|
||||
, iRange :: HM.HashMap Text NonnegRange -- ^ Requested range of rows within response
|
||||
, iTopLevelRange :: NonnegRange -- ^ Requested range of rows from the top level
|
||||
, iTarget :: Target -- ^ The target, be it calling a proc or accessing a table
|
||||
, iPayload :: Maybe Payload -- ^ Data sent by client and used for mutation actions
|
||||
, iPreferRepresentation :: PreferRepresentation -- ^ If client wants created items echoed back
|
||||
, iPreferParameters :: Maybe PreferParameters -- ^ How to pass parameters to a stored procedure
|
||||
, 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
|
||||
, iPreferTransaction :: Maybe PreferTransaction -- ^ Whether the clients wants to commit or rollback the transaction
|
||||
, iQueryParams :: QueryParams.QueryParams
|
||||
, iColumns :: S.Set FieldName -- ^ parsed colums from &columns parameter and payload
|
||||
, iHeaders :: [(ByteString, ByteString)] -- ^ HTTP request headers
|
||||
, iCookies :: [(ByteString, ByteString)] -- ^ Request Cookies
|
||||
, iPath :: ByteString -- ^ Raw request path
|
||||
, 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/.
|
||||
, iSchema :: Schema -- ^ The request schema. Can vary depending on iProfile.
|
||||
, iAcceptMediaType :: MediaType
|
||||
}
|
||||
|
||||
-- | Examines HTTP request and translates it into user intent.
|
||||
userApiRequest :: AppConfig -> DbStructure -> Request -> RequestBody -> Either ApiRequestError ApiRequest
|
||||
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
|
||||
| isInvalidRange = Left InvalidRange
|
||||
| shouldParsePayload && isLeft payload = either (Left . InvalidBody) witness payload
|
||||
| not expectParams && not (L.null qsParams) = Left $ ParseRequestError "Unexpected param or filter missing operator" ("Failed to parse " <> show qsParams)
|
||||
| method `elem` ["PATCH", "DELETE"] && not (null qsRanges) && null qsOrder = Left LimitNoOrderError
|
||||
| method == "PUT" && topLevelRange /= allRange = Left PutRangeNotAllowedError
|
||||
| otherwise = do
|
||||
acceptMediaType <- findAcceptMediaType conf action path accepts
|
||||
checkedTarget <- target
|
||||
return ApiRequest {
|
||||
iAction = action
|
||||
, iTarget = checkedTarget
|
||||
, iRange = ranges
|
||||
, iTopLevelRange = topLevelRange
|
||||
, iPayload = relevantPayload
|
||||
, iPreferRepresentation = fromMaybe None preferRepresentation
|
||||
, iPreferParameters = preferParameters
|
||||
, iPreferCount = preferCount
|
||||
, iPreferResolution = preferResolution
|
||||
, iPreferTransaction = preferTransaction
|
||||
, iQueryParams = queryparams
|
||||
, iColumns = payloadColumns
|
||||
, iHeaders = [ (CI.foldedCase k, v) | (k,v) <- hdrs, k /= hCookie]
|
||||
, iCookies = maybe [] parseCookies $ lookupHeader "Cookie"
|
||||
, iPath = rawPathInfo req
|
||||
, iMethod = method
|
||||
, iProfile = profile
|
||||
, iSchema = schema
|
||||
, iAcceptMediaType = acceptMediaType
|
||||
}
|
||||
where
|
||||
accepts = maybe [MTAny] (map MediaType.decodeMediaType . parseHttpAccept) $ lookupHeader "accept"
|
||||
|
||||
expectParams = pathIsProc && method /= "POST"
|
||||
|
||||
contentMediaType = maybe MTApplicationJSON MediaType.decodeMediaType $ lookupHeader "content-type"
|
||||
|
||||
columns = case action of
|
||||
ActionMutate MutationCreate -> qsColumns
|
||||
ActionMutate MutationUpdate -> qsColumns
|
||||
ActionInvoke InvPost -> qsColumns
|
||||
_ -> Nothing
|
||||
|
||||
payloadColumns =
|
||||
case (contentMediaType, action) of
|
||||
(_, ActionInvoke InvGet) -> S.fromList $ fst <$> qsParams
|
||||
(_, ActionInvoke InvHead) -> S.fromList $ fst <$> qsParams
|
||||
(MTUrlEncoded, _) -> S.fromList $ map (T.decodeUtf8 . fst) $ parseSimpleQuery $ LBS.toStrict reqBody
|
||||
_ -> case (relevantPayload, columns) of
|
||||
(Just ProcessedJSON{payKeys}, _) -> payKeys
|
||||
(Just RawJSON{}, Just cls) -> cls
|
||||
_ -> S.empty
|
||||
payload :: Either ByteString Payload
|
||||
payload = case (contentMediaType, pathIsProc) of
|
||||
(MTApplicationJSON, _) ->
|
||||
if isJust columns
|
||||
then Right $ RawJSON reqBody
|
||||
else note "All object keys must match" . payloadAttributes reqBody
|
||||
=<< if LBS.null reqBody && pathIsProc
|
||||
then Right emptyObject
|
||||
else first BS.pack $ JSON.eitherDecode reqBody
|
||||
(MTTextCSV, _) -> do
|
||||
json <- csvToJson <$> first BS.pack (CSV.decodeByName reqBody)
|
||||
note "All lines must have same number of fields" $ payloadAttributes (JSON.encode json) json
|
||||
(MTUrlEncoded, _) ->
|
||||
let paramsMap = HM.fromList $ (T.decodeUtf8 *** JSON.String . T.decodeUtf8) <$> parseSimpleQuery (LBS.toStrict reqBody) in
|
||||
Right $ ProcessedJSON (JSON.encode paramsMap) $ S.fromList (HM.keys paramsMap)
|
||||
(MTTextPlain, True) -> Right $ RawPay reqBody
|
||||
(MTTextXML, True) -> Right $ RawPay reqBody
|
||||
(MTOctetStream, True) -> Right $ RawPay reqBody
|
||||
(ct, _) -> Left $ "Content-Type not acceptable: " <> MediaType.toMime ct
|
||||
topLevelRange = fromMaybe allRange $ HM.lookup "limit" ranges -- if no limit is specified, get all the request rows
|
||||
|
||||
defaultSchema = NonEmptyList.head configDbSchemas
|
||||
profile
|
||||
| length configDbSchemas <= 1 -- only enable content negotiation by profile when there are multiple schemas specified in the config
|
||||
= Nothing
|
||||
| otherwise = case method of
|
||||
-- POST/PATCH/PUT/DELETE don't use the same header as per the spec
|
||||
"DELETE" -> contentProfile
|
||||
"PATCH" -> contentProfile
|
||||
"POST" -> contentProfile
|
||||
"PUT" -> contentProfile
|
||||
_ -> acceptProfile
|
||||
where
|
||||
contentProfile = Just $ maybe defaultSchema T.decodeUtf8 $ lookupHeader "Content-Profile"
|
||||
acceptProfile = Just $ maybe defaultSchema T.decodeUtf8 $ lookupHeader "Accept-Profile"
|
||||
|
||||
schema = fromMaybe defaultSchema profile
|
||||
|
||||
target
|
||||
| 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
|
||||
-- to store the query string arguments to the function.
|
||||
(_, ActionInvoke InvGet) -> targetToJsonRpcParams (rightToMaybe target) qsParams
|
||||
(_, ActionInvoke InvHead) -> targetToJsonRpcParams (rightToMaybe target) qsParams
|
||||
(MTUrlEncoded, ActionInvoke InvPost) -> targetToJsonRpcParams (rightToMaybe target) $ (T.decodeUtf8 *** T.decodeUtf8) <$> parseSimpleQuery (LBS.toStrict reqBody)
|
||||
_ | shouldParsePayload -> rightToMaybe payload
|
||||
| otherwise -> Nothing
|
||||
method = requestMethod req
|
||||
hdrs = requestHeaders req
|
||||
lookupHeader = flip lookup hdrs
|
||||
Preferences.Preferences{..} = Preferences.fromHeaders hdrs
|
||||
headerRange = rangeRequested hdrs
|
||||
limitRange = fromMaybe allRange (HM.lookup "limit" qsRanges)
|
||||
headerAndLimitRange = rangeIntersection headerRange limitRange
|
||||
|
||||
-- Bypass all the ranges and send only the limit zero range (0 <= x <= -1) if
|
||||
-- limit=0 is present in the query params (not allowed for the Range header)
|
||||
ranges = HM.insert "limit" (if hasLimitZero limitRange then limitZeroRange else headerAndLimitRange) qsRanges
|
||||
-- The only emptyRange allowed is the limit zero range
|
||||
isInvalidRange = topLevelRange == emptyRange && not (hasLimitZero limitRange)
|
||||
|
||||
{-|
|
||||
Find the best match from a list of media types accepted by the
|
||||
client in order of decreasing preference and a list of types
|
||||
producible by the server. If there is no match but the client
|
||||
accepts */* then return the top server pick.
|
||||
-}
|
||||
mutuallyAgreeable :: [MediaType] -> [MediaType] -> Maybe MediaType
|
||||
mutuallyAgreeable sProduces cAccepts =
|
||||
let exact = listToMaybe $ L.intersect cAccepts sProduces in
|
||||
if isNothing exact && MTAny `elem` cAccepts
|
||||
then listToMaybe sProduces
|
||||
else exact
|
||||
|
||||
type CsvData = V.Vector (M.Map Text LBS.ByteString)
|
||||
|
||||
{-|
|
||||
Converts CSV like
|
||||
a,b
|
||||
1,hi
|
||||
2,bye
|
||||
|
||||
into a JSON array like
|
||||
[ {"a": "1", "b": "hi"}, {"a": 2, "b": "bye"} ]
|
||||
|
||||
The reason for its odd signature is so that it can compose
|
||||
directly with CSV.decodeByName
|
||||
-}
|
||||
csvToJson :: (CSV.Header, CsvData) -> JSON.Value
|
||||
csvToJson (_, vals) =
|
||||
JSON.Array $ V.map rowToJsonObj vals
|
||||
where
|
||||
rowToJsonObj = JSON.Object . KM.fromMapText .
|
||||
M.map (\str ->
|
||||
if str == "NULL"
|
||||
then JSON.Null
|
||||
else JSON.String . T.decodeUtf8 $ LBS.toStrict str
|
||||
)
|
||||
|
||||
payloadAttributes :: RequestBody -> JSON.Value -> Maybe Payload
|
||||
payloadAttributes raw json =
|
||||
-- Test that Array contains only Objects having the same keys
|
||||
case json of
|
||||
JSON.Array arr ->
|
||||
case arr V.!? 0 of
|
||||
Just (JSON.Object o) ->
|
||||
let canonicalKeys = S.fromList $ K.toText <$> KM.keys o
|
||||
areKeysUniform = all (\case
|
||||
JSON.Object x -> S.fromList (K.toText <$> KM.keys x) == canonicalKeys
|
||||
_ -> False) arr in
|
||||
if areKeysUniform
|
||||
then Just $ ProcessedJSON raw canonicalKeys
|
||||
else Nothing
|
||||
Just _ -> Nothing
|
||||
Nothing -> Just emptyPJArray
|
||||
|
||||
JSON.Object o -> Just $ ProcessedJSON raw (S.fromList $ K.toText <$> KM.keys o)
|
||||
|
||||
-- truncate everything else to an empty array.
|
||||
_ -> Just emptyPJArray
|
||||
where
|
||||
emptyPJArray = ProcessedJSON (JSON.encode emptyArray) S.empty
|
||||
|
||||
findAcceptMediaType :: AppConfig -> Action -> PathInfo -> [MediaType] -> Either ApiRequestError MediaType
|
||||
findAcceptMediaType conf action path accepts =
|
||||
case mutuallyAgreeable (requestMediaTypes conf action path) accepts of
|
||||
Just ct ->
|
||||
Right ct
|
||||
Nothing ->
|
||||
Left . MediaTypeError $ map MediaType.toMime accepts
|
||||
|
||||
requestMediaTypes :: AppConfig -> Action -> PathInfo -> [MediaType]
|
||||
requestMediaTypes conf action path =
|
||||
case action of
|
||||
ActionRead _ -> defaultMediaTypes ++ rawMediaTypes
|
||||
ActionInvoke _ -> invokeMediaTypes
|
||||
ActionInspect _ -> [MTOpenAPI, MTApplicationJSON]
|
||||
ActionInfo -> [MTTextCSV]
|
||||
_ -> defaultMediaTypes
|
||||
where
|
||||
invokeMediaTypes =
|
||||
defaultMediaTypes
|
||||
++ rawMediaTypes
|
||||
++ [MTOpenAPI | pathIsRootSpec path]
|
||||
defaultMediaTypes =
|
||||
[MTApplicationJSON, MTSingularJSON, MTGeoJSON, MTTextCSV] ++
|
||||
[MTPlan $ MTPlanAttrs Nothing PlanJSON mempty | configDbPlanEnabled conf]
|
||||
rawMediaTypes = configRawMediaTypes conf `union` [MTOctetStream, MTTextPlain, MTTextXML]
|
||||
|
||||
{-|
|
||||
Search a pg proc by matching name and arguments keys to parameters. Since a function can be overloaded,
|
||||
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 -> MediaType -> Bool -> Either ApiRequestError ProcDescription
|
||||
findProc qi argumentsKeys paramsAsSingleObject allProcs contentMediaType isInvPost =
|
||||
case matchProc of
|
||||
([], []) -> Left $ NoRpc (qiSchema qi) (qiName qi) (S.toList argumentsKeys) paramsAsSingleObject contentMediaType isInvPost
|
||||
-- If there are no functions with named arguments, fallback to the single unnamed argument function
|
||||
([], [proc]) -> Right proc
|
||||
([], procs) -> Left $ AmbiguousRpc (toList procs)
|
||||
-- Matches the functions with named arguments
|
||||
([proc], _) -> Right proc
|
||||
(procs, _) -> Left $ AmbiguousRpc (toList procs)
|
||||
where
|
||||
matchProc = overloadedProcPartition $ HM.lookupDefault mempty qi allProcs -- first find the proc by name
|
||||
-- The partition obtained has the form (overloadedProcs,fallbackProcs)
|
||||
-- where fallbackProcs are functions with a single unnamed parameter
|
||||
overloadedProcPartition = foldr select ([],[])
|
||||
select proc ~(ts,fs)
|
||||
| matchesParams proc = (proc:ts,fs)
|
||||
| hasSingleUnnamedParam proc = (ts,proc:fs)
|
||||
| otherwise = (ts,fs)
|
||||
-- If the function is called with post and has a single unnamed parameter
|
||||
-- it can be called depending on content type and the parameter type
|
||||
hasSingleUnnamedParam ProcDescription{pdParams=[ProcParam{ppType}]} = isInvPost && case (contentMediaType, ppType) of
|
||||
(MTApplicationJSON, "json") -> True
|
||||
(MTApplicationJSON, "jsonb") -> True
|
||||
(MTTextPlain, "text") -> True
|
||||
(MTTextXML, "xml") -> True
|
||||
(MTOctetStream, "bytea") -> True
|
||||
_ -> False
|
||||
hasSingleUnnamedParam _ = False
|
||||
matchesParams proc =
|
||||
let
|
||||
params = pdParams proc
|
||||
firstType = (ppType <$> headMay params)
|
||||
in
|
||||
-- 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)
|
||||
@@ -1,395 +0,0 @@
|
||||
{-|
|
||||
Module : PostgREST.Request.DbRequestBuilder
|
||||
Description : PostgREST database request builder
|
||||
|
||||
This module is in charge of building an intermediate
|
||||
representation(ReadRequest, MutateRequest) between the HTTP request and the
|
||||
final resulting SQL query.
|
||||
|
||||
A query tree is built in case of resource embedding. By inferring the
|
||||
relationship between tables, join conditions are added for every embedded
|
||||
resource.
|
||||
-}
|
||||
{-# LANGUAGE DuplicateRecordFields #-}
|
||||
{-# LANGUAGE LambdaCase #-}
|
||||
{-# LANGUAGE NamedFieldPuns #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
|
||||
module PostgREST.Request.DbRequestBuilder
|
||||
( readRequest
|
||||
, mutateRequest
|
||||
, callRequest
|
||||
) where
|
||||
|
||||
import qualified Data.HashMap.Strict as HM
|
||||
import qualified Data.Set as S
|
||||
|
||||
import Data.Either.Combinators (mapLeft)
|
||||
import Data.List (delete)
|
||||
import Data.Tree (Tree (..))
|
||||
|
||||
import PostgREST.DbStructure.Identifiers (FieldName,
|
||||
QualifiedIdentifier (..),
|
||||
Schema, TableName)
|
||||
import PostgREST.DbStructure.Proc (ProcDescription (..),
|
||||
ProcParam (..),
|
||||
procReturnsScalar)
|
||||
import PostgREST.DbStructure.Relationship (Cardinality (..),
|
||||
Junction (..),
|
||||
Relationship (..),
|
||||
RelationshipsMap)
|
||||
import PostgREST.Error (Error (..))
|
||||
import PostgREST.Query.SqlFragment (sourceCTEName)
|
||||
import PostgREST.RangeQuery (NonnegRange, allRange,
|
||||
restrictRange)
|
||||
import PostgREST.Request.ApiRequest (Action (..),
|
||||
ApiRequest (..),
|
||||
InvokeMethod (..),
|
||||
Mutation (..),
|
||||
Payload (..))
|
||||
|
||||
import PostgREST.Request.MutateQuery
|
||||
import PostgREST.Request.Preferences
|
||||
import PostgREST.Request.ReadQuery as ReadQuery
|
||||
import PostgREST.Request.Types
|
||||
|
||||
import qualified PostgREST.Request.QueryParams as QueryParams
|
||||
|
||||
import Protolude hiding (from)
|
||||
|
||||
-- | Builds the ReadRequest tree on a number of stages.
|
||||
-- | Adds filters, order, limits on its respective nodes.
|
||||
-- | Adds joins conditions obtained from resource embedding.
|
||||
readRequest :: Schema -> TableName -> Maybe Integer -> RelationshipsMap -> ApiRequest -> Either Error ReadRequest
|
||||
readRequest schema rootTableName maxRows allRels apiRequest =
|
||||
mapLeft ApiRequestError $
|
||||
treeRestrictRange maxRows (iAction apiRequest) =<<
|
||||
augmentRequestWithJoin schema allRels =<<
|
||||
addLogicTrees apiRequest =<<
|
||||
addRanges apiRequest =<<
|
||||
addOrders apiRequest =<<
|
||||
addFilters apiRequest (initReadRequest rootName rootAlias qsSelect)
|
||||
where
|
||||
QueryParams.QueryParams{..} = iQueryParams apiRequest
|
||||
(rootName, rootAlias) = case iAction apiRequest of
|
||||
ActionRead _ -> (QualifiedIdentifier schema rootTableName, Nothing)
|
||||
-- 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
|
||||
_ -> (QualifiedIdentifier mempty $ decodeUtf8 sourceCTEName, Just rootTableName)
|
||||
|
||||
-- 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
|
||||
-- "table_depth", this is related to
|
||||
-- http://github.com/PostgREST/postgrest/issues/987.
|
||||
initReadRequest :: QualifiedIdentifier -> Maybe Alias -> [Tree SelectItem] -> ReadRequest
|
||||
initReadRequest rootQi rootAlias =
|
||||
foldr (treeEntry rootDepth) initial
|
||||
where
|
||||
rootDepth = 0
|
||||
rootSchema = qiSchema rootQi
|
||||
rootName = qiName rootQi
|
||||
initial = Node (Select [] rootQi rootAlias [] [] [] allRange, (rootName, Nothing, Nothing, Nothing, Nothing, rootDepth)) []
|
||||
treeEntry :: Depth -> Tree SelectItem -> ReadRequest -> ReadRequest
|
||||
treeEntry depth (Node fld@((fn, _),_,alias, hint, joinType) fldForest) (Node (q, i) rForest) =
|
||||
let nxtDepth = succ depth in
|
||||
case fldForest of
|
||||
[] -> Node (q {select=fld:select q}, i) rForest
|
||||
_ -> Node (q, i) $
|
||||
foldr (treeEntry nxtDepth)
|
||||
(Node (Select [] (QualifiedIdentifier rootSchema fn) Nothing [] [] [] allRange,
|
||||
(fn, Nothing, alias, hint, joinType, nxtDepth)) [])
|
||||
fldForest:rForest
|
||||
|
||||
-- | Enforces the `max-rows` config on the result
|
||||
treeRestrictRange :: Maybe Integer -> Action -> ReadRequest -> Either ApiRequestError ReadRequest
|
||||
treeRestrictRange _ (ActionMutate _) request = Right request
|
||||
treeRestrictRange maxRows _ request = pure $ nodeRestrictRange maxRows <$> request
|
||||
where
|
||||
nodeRestrictRange :: Maybe Integer -> ReadNode -> ReadNode
|
||||
nodeRestrictRange m (q@Select {range_=r}, i) = (q{range_=restrictRange m r }, i)
|
||||
|
||||
augmentRequestWithJoin :: Schema -> RelationshipsMap -> ReadRequest -> Either ApiRequestError ReadRequest
|
||||
augmentRequestWithJoin schema allRels request =
|
||||
addJoinConditions Nothing <$> addRels schema allRels Nothing request
|
||||
|
||||
addRels :: Schema -> RelationshipsMap -> Maybe ReadRequest -> ReadRequest -> Either ApiRequestError ReadRequest
|
||||
addRels schema allRels parentNode (Node (query@Select{from=tbl}, (nodeName, _, alias, hint, joinType, depth)) forest) =
|
||||
case parentNode of
|
||||
Just (Node (Select{from=parentNodeQi, fromAlias=aliasQi}, _) _) ->
|
||||
let newFrom r = if qiName tbl == nodeName then relForeignTable r else tbl
|
||||
newReadNode = (\r ->
|
||||
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
|
||||
Node <$> newReadNode <*> (updateForest . hush $ Node <$> newReadNode <*> pure forest)
|
||||
_ ->
|
||||
let rn = (query, (nodeName, Nothing, alias, Nothing, joinType, depth)) in
|
||||
Node rn <$> updateForest (Just $ Node rn forest)
|
||||
where
|
||||
updateForest :: Maybe ReadRequest -> Either ApiRequestError [ReadRequest]
|
||||
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:
|
||||
-- /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
|
||||
-- be disambiguated by adding precision to the target or by using a hint:
|
||||
-- /origin?select=target!hint(*). The origin can be a table or view.
|
||||
findRel :: Schema -> RelationshipsMap -> NodeName -> NodeName -> Maybe Hint -> Either ApiRequestError Relationship
|
||||
findRel schema allRels origin target hint =
|
||||
case rels of
|
||||
[] -> Left $ NoRelBetween origin target schema
|
||||
[r] -> Right r
|
||||
rs -> Left $ AmbiguousRelBetween origin target rs
|
||||
where
|
||||
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
|
||||
O2M cons _ -> tar == cons
|
||||
M2O cons _ -> tar == cons
|
||||
O2O cons _ -> tar == cons
|
||||
_ -> False
|
||||
matchJunction hint_ card = case card of
|
||||
M2M Junction{junTable} -> hint_ == qiName junTable
|
||||
_ -> False
|
||||
isM2O card = case card of
|
||||
M2O _ _ -> True
|
||||
_ -> False
|
||||
isO2M card = case card of
|
||||
O2M _ _ -> True
|
||||
_ -> False
|
||||
rels = filter (\case
|
||||
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=clients!client_id(*) or /projects?select=clients!id(*)
|
||||
matchFKSingleCol hnt relCardinality || -- client_id
|
||||
matchFKRefSingleCol hnt relCardinality || -- id
|
||||
|
||||
-- /users?select=tasks!users_tasks(*) many-to-many between users and tasks
|
||||
matchJunction hnt relCardinality -- users_tasks
|
||||
)
|
||||
) $ fromMaybe mempty $ HM.lookup (QualifiedIdentifier schema origin, schema) allRels
|
||||
|
||||
addFilters :: ApiRequest -> ReadRequest -> Either ApiRequestError ReadRequest
|
||||
addFilters ApiRequest{..} rReq =
|
||||
foldr addFilterToNode (Right rReq) flts
|
||||
where
|
||||
QueryParams.QueryParams{..} = iQueryParams
|
||||
flts =
|
||||
case iAction of
|
||||
ActionInvoke InvGet -> qsFilters
|
||||
ActionInvoke InvHead -> qsFilters
|
||||
ActionInvoke _ -> qsFilters
|
||||
ActionRead _ -> qsFilters
|
||||
_ -> qsFiltersNotRoot
|
||||
|
||||
addFilterToNode :: (EmbedPath, Filter) -> Either ApiRequestError ReadRequest -> Either ApiRequestError ReadRequest
|
||||
addFilterToNode =
|
||||
updateNode (\flt (Node (q@Select {where_=lf}, i) f) -> Node (q{ReadQuery.where_=addFilterToLogicForest flt lf}, i) f)
|
||||
|
||||
addOrders :: ApiRequest -> ReadRequest -> Either ApiRequestError ReadRequest
|
||||
addOrders ApiRequest{..} rReq =
|
||||
case iAction of
|
||||
ActionMutate _ -> Right rReq
|
||||
_ -> foldr addOrderToNode (Right rReq) qsOrder
|
||||
where
|
||||
QueryParams.QueryParams{..} = iQueryParams
|
||||
|
||||
addOrderToNode :: (EmbedPath, [OrderTerm]) -> Either ApiRequestError ReadRequest -> Either ApiRequestError ReadRequest
|
||||
addOrderToNode = updateNode (\o (Node (q,i) f) -> Node (q{order=o}, i) f)
|
||||
|
||||
addRanges :: ApiRequest -> ReadRequest -> Either ApiRequestError ReadRequest
|
||||
addRanges ApiRequest{..} rReq =
|
||||
case iAction of
|
||||
ActionMutate _ -> Right rReq
|
||||
_ -> foldr addRangeToNode (Right rReq) =<< ranges
|
||||
where
|
||||
ranges :: Either ApiRequestError [(EmbedPath, NonnegRange)]
|
||||
ranges = first QueryParamError $ QueryParams.pRequestRange `traverse` HM.toList iRange
|
||||
|
||||
addRangeToNode :: (EmbedPath, NonnegRange) -> Either ApiRequestError ReadRequest -> Either ApiRequestError ReadRequest
|
||||
addRangeToNode = updateNode (\r (Node (q,i) f) -> Node (q{range_=r}, i) f)
|
||||
|
||||
addLogicTrees :: ApiRequest -> ReadRequest -> Either ApiRequestError ReadRequest
|
||||
addLogicTrees ApiRequest{..} rReq =
|
||||
foldr addLogicTreeToNode (Right rReq) qsLogic
|
||||
where
|
||||
QueryParams.QueryParams{..} = iQueryParams
|
||||
|
||||
addLogicTreeToNode :: (EmbedPath, LogicTree) -> Either ApiRequestError ReadRequest -> Either ApiRequestError ReadRequest
|
||||
addLogicTreeToNode = updateNode (\t (Node (q@Select{where_=lf},i) f) -> Node (q{ReadQuery.where_=t:lf}, i) f)
|
||||
|
||||
-- Find a Node of the Tree and apply a function to it
|
||||
updateNode :: (a -> ReadRequest -> ReadRequest) -> (EmbedPath, a) -> Either ApiRequestError ReadRequest -> Either ApiRequestError ReadRequest
|
||||
updateNode f ([], a) rr = f a <$> rr
|
||||
updateNode _ _ (Left e) = Left e
|
||||
updateNode f (targetNodeName:remainingPath, a) (Right (Node rootNode forest)) =
|
||||
case findNode of
|
||||
Nothing -> Left $ NotEmbedded targetNodeName
|
||||
Just target ->
|
||||
(\node -> Node rootNode $ node : delete target forest) <$>
|
||||
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)) &&
|
||||
all (\case
|
||||
Filter _ (OpExpr False (Op OpEqual _)) -> True
|
||||
_ -> False) qsFiltersRoot
|
||||
then Right $ Insert qi iColumns body (Just (MergeDuplicates, pkCols)) combinedLogic returnings
|
||||
else
|
||||
Left InvalidFilters
|
||||
MutationDelete -> Right $ Delete qi combinedLogic iTopLevelRange rootOrder returnings
|
||||
where
|
||||
confCols = fromMaybe pkCols qsOnConflict
|
||||
QueryParams.QueryParams{..} = iQueryParams
|
||||
qi = QualifiedIdentifier schema tName
|
||||
returnings =
|
||||
if iPreferRepresentation == None
|
||||
then []
|
||||
else returningCols readReq pkCols
|
||||
logic = map snd qsLogic
|
||||
rootOrder = maybe [] snd $ find (\(x, _) -> null x) qsOrder
|
||||
combinedLogic = foldr addFilterToLogicForest logic qsFiltersRoot
|
||||
body = payRaw <$> iPayload -- the body is assumed to be json at this stage(ApiRequest validates)
|
||||
|
||||
callRequest :: ProcDescription -> ApiRequest -> ReadRequest -> CallRequest
|
||||
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 rr@(Node _ forest) pkCols
|
||||
-- if * is part of the select, we must not add pk or fk columns manually -
|
||||
-- otherwise those would be selected and output twice
|
||||
| "*" `elem` fldNames = ["*"]
|
||||
| otherwise = returnings
|
||||
where
|
||||
fldNames = fstFieldNames rr
|
||||
-- Without fkCols, when a mutateRequest to
|
||||
-- /projects?select=name,clients(name) occurs, the RETURNING SQL part would
|
||||
-- be `RETURNING name`(see QueryBuilder). This would make the embedding
|
||||
-- fail because the following JOIN would need the "client_id" column from
|
||||
-- projects. So this adds the foreign key columns to ensure the embedding
|
||||
-- succeeds, result would be `RETURNING name, client_id`.
|
||||
fkCols = concat $ mapMaybe (\case
|
||||
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
|
||||
) forest
|
||||
hasComputedRel = isJust $ find (\case
|
||||
Node (_, (_, Just ComputedRelationship{}, _, _, _, _)) _ -> True
|
||||
_ -> False
|
||||
) forest
|
||||
-- However if the "client_id" is present, e.g. mutateRequest to
|
||||
-- /projects?select=client_id,name,clients(name) we would get `RETURNING
|
||||
-- client_id, name, client_id` and then we would produce the "column
|
||||
-- reference \"client_id\" is ambiguous" error from PostgreSQL. So we
|
||||
-- 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
|
||||
-- INSERT/POST
|
||||
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
|
||||
-- they are later concatenated with AND in the QueryBuilder
|
||||
addFilterToLogicForest :: Filter -> [LogicTree] -> [LogicTree]
|
||||
addFilterToLogicForest flt lf = Stmnt flt : lf
|
||||
@@ -1,44 +0,0 @@
|
||||
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,523 +0,0 @@
|
||||
-- |
|
||||
-- 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)
|
||||
@@ -1,46 +0,0 @@
|
||||
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
|
||||
@@ -0,0 +1,291 @@
|
||||
{- |
|
||||
Module : PostgREST.Response
|
||||
Description : Generate HTTP Response
|
||||
-}
|
||||
{-# LANGUAGE NamedFieldPuns #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
module PostgREST.Response
|
||||
( createResponse
|
||||
, deleteResponse
|
||||
, infoIdentResponse
|
||||
, infoProcResponse
|
||||
, infoRootResponse
|
||||
, invokeResponse
|
||||
, openApiResponse
|
||||
, readResponse
|
||||
, singleUpsertResponse
|
||||
, updateResponse
|
||||
, addRetryHint
|
||||
, isServiceUnavailable
|
||||
, traceHeaderMiddleware
|
||||
) where
|
||||
|
||||
import qualified Data.Aeson as JSON
|
||||
import qualified Data.ByteString.Char8 as BS
|
||||
import qualified Data.ByteString.Lazy as LBS
|
||||
import qualified Data.HashMap.Strict as HM
|
||||
import qualified Data.List as L
|
||||
import Data.Text.Read (decimal)
|
||||
import qualified Network.HTTP.Types.Header as HTTP
|
||||
import qualified Network.HTTP.Types.Status as HTTP
|
||||
import qualified Network.HTTP.Types.URI as HTTP
|
||||
import qualified Network.Wai as Wai
|
||||
|
||||
import qualified PostgREST.Error as Error
|
||||
import qualified PostgREST.MediaType as MediaType
|
||||
import qualified PostgREST.RangeQuery as RangeQuery
|
||||
import qualified PostgREST.Response.OpenAPI as OpenAPI
|
||||
|
||||
import PostgREST.ApiRequest (ApiRequest (..),
|
||||
InvokeMethod (..))
|
||||
import PostgREST.ApiRequest.Preferences (PreferRepresentation (..),
|
||||
Preferences (..),
|
||||
prefAppliedHeader,
|
||||
shouldCount)
|
||||
import PostgREST.ApiRequest.QueryParams (QueryParams (..))
|
||||
import PostgREST.Config (AppConfig (..))
|
||||
import PostgREST.MediaType (MediaType (..))
|
||||
import PostgREST.Plan (MutateReadPlan (..))
|
||||
import PostgREST.Plan.MutatePlan (MutatePlan (..))
|
||||
import PostgREST.Query.Statements (ResultSet (..))
|
||||
import PostgREST.Response.GucHeader (GucHeader, unwrapGucHeader)
|
||||
import PostgREST.SchemaCache (SchemaCache (..))
|
||||
import PostgREST.SchemaCache.Identifiers (QualifiedIdentifier (..),
|
||||
Schema)
|
||||
import PostgREST.SchemaCache.Routine (FuncVolatility (..),
|
||||
Routine (..), RoutineMap)
|
||||
import PostgREST.SchemaCache.Table (Table (..), TablesMap)
|
||||
|
||||
import qualified PostgREST.ApiRequest.Types as ApiRequestTypes
|
||||
import qualified PostgREST.SchemaCache.Routine as Routine
|
||||
|
||||
import Protolude hiding (Handler, toS)
|
||||
import Protolude.Conv (toS)
|
||||
|
||||
|
||||
readResponse :: Bool -> QualifiedIdentifier -> ApiRequest -> ResultSet -> Wai.Response
|
||||
readResponse headersOnly identifier ctxApiRequest@ApiRequest{iPreferences=Preferences{..},..} resultSet = case resultSet of
|
||||
RSStandard{..} -> do
|
||||
let
|
||||
(status, contentRange) = RangeQuery.rangeStatusHeader iTopLevelRange rsQueryTotal rsTableTotal
|
||||
response = gucResponse rsGucStatus rsGucHeaders
|
||||
prefHeader = maybeToList . prefAppliedHeader $ Preferences Nothing Nothing Nothing preferCount preferTransaction Nothing
|
||||
headers =
|
||||
[ contentRange
|
||||
, ( "Content-Location"
|
||||
, "/"
|
||||
<> toUtf8 (qiName identifier)
|
||||
<> if BS.null (qsCanonical iQueryParams) then mempty else "?" <> qsCanonical iQueryParams
|
||||
)
|
||||
]
|
||||
++ contentTypeHeaders ctxApiRequest
|
||||
++ prefHeader
|
||||
rsOrErrBody = if status == HTTP.status416
|
||||
then Error.errorPayload $ Error.ApiRequestError $ ApiRequestTypes.InvalidRange
|
||||
$ ApiRequestTypes.OutOfBounds (show $ RangeQuery.rangeOffset iTopLevelRange) (maybe "0" show rsTableTotal)
|
||||
else LBS.fromStrict rsBody
|
||||
|
||||
response status headers $ if headersOnly then mempty else rsOrErrBody
|
||||
|
||||
RSPlan plan ->
|
||||
Wai.responseLBS HTTP.status200 (contentTypeHeaders ctxApiRequest) $ LBS.fromStrict plan
|
||||
|
||||
createResponse :: QualifiedIdentifier -> MutateReadPlan -> ApiRequest -> ResultSet -> Wai.Response
|
||||
createResponse QualifiedIdentifier{..} MutateReadPlan{mrMutatePlan} ctxApiRequest@ApiRequest{iPreferences=Preferences{..}, ..} resultSet = case resultSet of
|
||||
RSStandard{..} -> do
|
||||
let
|
||||
pkCols = case mrMutatePlan of { Insert{insPkCols} -> insPkCols; _ -> mempty;}
|
||||
response = gucResponse rsGucStatus rsGucHeaders
|
||||
prefHeader = prefAppliedHeader $
|
||||
Preferences (if null pkCols && isNothing (qsOnConflict iQueryParams) then Nothing else preferResolution)
|
||||
preferRepresentation Nothing preferCount preferTransaction preferMissing
|
||||
headers =
|
||||
catMaybes
|
||||
[ if null rsLocation then
|
||||
Nothing
|
||||
else
|
||||
Just
|
||||
( HTTP.hLocation
|
||||
, "/"
|
||||
<> toUtf8 qiName
|
||||
<> HTTP.renderSimpleQuery True rsLocation
|
||||
)
|
||||
, Just . RangeQuery.contentRangeH 1 0 $
|
||||
if shouldCount preferCount then Just rsQueryTotal else Nothing
|
||||
, prefHeader
|
||||
]
|
||||
|
||||
case preferRepresentation of
|
||||
Just Full -> response HTTP.status201 (headers ++ contentTypeHeaders ctxApiRequest) (LBS.fromStrict rsBody)
|
||||
Just None -> response HTTP.status201 headers mempty
|
||||
Just HeadersOnly -> response HTTP.status201 headers mempty
|
||||
Nothing -> response HTTP.status201 headers mempty
|
||||
|
||||
RSPlan plan ->
|
||||
Wai.responseLBS HTTP.status200 (contentTypeHeaders ctxApiRequest) $ LBS.fromStrict plan
|
||||
|
||||
|
||||
updateResponse :: ApiRequest -> ResultSet -> Wai.Response
|
||||
updateResponse ctxApiRequest@ApiRequest{iPreferences=Preferences{..}} resultSet = case resultSet of
|
||||
RSStandard{..} -> do
|
||||
let
|
||||
response = gucResponse rsGucStatus rsGucHeaders
|
||||
contentRangeHeader =
|
||||
Just . RangeQuery.contentRangeH 0 (rsQueryTotal - 1) $
|
||||
if shouldCount preferCount then Just rsQueryTotal else Nothing
|
||||
prefHeader = prefAppliedHeader $ Preferences Nothing preferRepresentation Nothing preferCount preferTransaction preferMissing
|
||||
headers = catMaybes [contentRangeHeader, prefHeader]
|
||||
|
||||
case preferRepresentation of
|
||||
Just Full -> response HTTP.status200 (headers ++ contentTypeHeaders ctxApiRequest) (LBS.fromStrict rsBody)
|
||||
Just None -> response HTTP.status204 headers mempty
|
||||
_ -> response HTTP.status204 headers mempty
|
||||
|
||||
RSPlan plan ->
|
||||
Wai.responseLBS HTTP.status200 (contentTypeHeaders ctxApiRequest) $ LBS.fromStrict plan
|
||||
|
||||
singleUpsertResponse :: ApiRequest -> ResultSet -> Wai.Response
|
||||
singleUpsertResponse ctxApiRequest@ApiRequest{iPreferences=Preferences{..}} resultSet = case resultSet of
|
||||
RSStandard {..} -> do
|
||||
let
|
||||
response = gucResponse rsGucStatus rsGucHeaders
|
||||
prefHeader = maybeToList . prefAppliedHeader $ Preferences Nothing preferRepresentation Nothing preferCount preferTransaction Nothing
|
||||
|
||||
case preferRepresentation of
|
||||
Just Full -> response HTTP.status200 (contentTypeHeaders ctxApiRequest ++ prefHeader) (LBS.fromStrict rsBody)
|
||||
Just None -> response HTTP.status204 prefHeader mempty
|
||||
_ -> response HTTP.status204 prefHeader mempty
|
||||
|
||||
RSPlan plan ->
|
||||
Wai.responseLBS HTTP.status200 (contentTypeHeaders ctxApiRequest) $ LBS.fromStrict plan
|
||||
|
||||
deleteResponse :: ApiRequest -> ResultSet -> Wai.Response
|
||||
deleteResponse ctxApiRequest@ApiRequest{iPreferences=Preferences{..}} resultSet = case resultSet of
|
||||
RSStandard {..} -> do
|
||||
let
|
||||
response = gucResponse rsGucStatus rsGucHeaders
|
||||
contentRangeHeader =
|
||||
RangeQuery.contentRangeH 1 0 $
|
||||
if shouldCount preferCount then Just rsQueryTotal else Nothing
|
||||
prefHeader = maybeToList . prefAppliedHeader $ Preferences Nothing preferRepresentation Nothing preferCount preferTransaction Nothing
|
||||
headers = contentRangeHeader : prefHeader
|
||||
|
||||
case preferRepresentation of
|
||||
Just Full -> response HTTP.status200 (headers ++ contentTypeHeaders ctxApiRequest) (LBS.fromStrict rsBody)
|
||||
Just None -> response HTTP.status204 headers mempty
|
||||
_ -> response HTTP.status204 headers mempty
|
||||
|
||||
RSPlan plan ->
|
||||
Wai.responseLBS HTTP.status200 (contentTypeHeaders ctxApiRequest) $ LBS.fromStrict plan
|
||||
|
||||
infoIdentResponse :: QualifiedIdentifier -> SchemaCache -> Wai.Response
|
||||
infoIdentResponse identifier sCache =
|
||||
case HM.lookup identifier (dbTables sCache) of
|
||||
Just tbl -> respondInfo $ allowH tbl
|
||||
Nothing -> Error.errorResponseFor $ Error.ApiRequestError ApiRequestTypes.NotFound
|
||||
where
|
||||
allowH table =
|
||||
let hasPK = not . null $ tablePKCols table in
|
||||
BS.intercalate "," $
|
||||
["OPTIONS,GET,HEAD"] ++
|
||||
["POST" | tableInsertable table] ++
|
||||
["PUT" | tableInsertable table && tableUpdatable table && hasPK] ++
|
||||
["PATCH" | tableUpdatable table] ++
|
||||
["DELETE" | tableDeletable table]
|
||||
|
||||
infoProcResponse :: Routine -> Wai.Response
|
||||
infoProcResponse proc | pdVolatility proc == Volatile = respondInfo "OPTIONS,POST"
|
||||
| otherwise = respondInfo "OPTIONS,GET,HEAD,POST"
|
||||
|
||||
infoRootResponse :: Wai.Response
|
||||
infoRootResponse = respondInfo "OPTIONS,GET,HEAD"
|
||||
|
||||
respondInfo :: ByteString -> Wai.Response
|
||||
respondInfo allowHeader =
|
||||
let allOrigins = ("Access-Control-Allow-Origin", "*") in
|
||||
Wai.responseLBS HTTP.status200 [allOrigins, (HTTP.hAllow, allowHeader)] mempty
|
||||
|
||||
invokeResponse :: InvokeMethod -> Routine -> ApiRequest -> ResultSet -> Wai.Response
|
||||
invokeResponse invMethod proc ctxApiRequest@ApiRequest{iPreferences=Preferences{..}, ..} resultSet = case resultSet of
|
||||
RSStandard {..} -> do
|
||||
let
|
||||
response = gucResponse rsGucStatus rsGucHeaders
|
||||
(status, contentRange) =
|
||||
RangeQuery.rangeStatusHeader iTopLevelRange rsQueryTotal rsTableTotal
|
||||
rsOrErrBody = if status == HTTP.status416
|
||||
then Error.errorPayload $ Error.ApiRequestError $ ApiRequestTypes.InvalidRange
|
||||
$ ApiRequestTypes.OutOfBounds (show $ RangeQuery.rangeOffset iTopLevelRange) (maybe "0" show rsTableTotal)
|
||||
else LBS.fromStrict rsBody
|
||||
prefHeader = maybeToList . prefAppliedHeader $ Preferences Nothing Nothing preferParameters preferCount preferTransaction Nothing
|
||||
headers = contentRange : prefHeader
|
||||
|
||||
if Routine.funcReturnsVoid proc then
|
||||
response HTTP.status204 headers mempty
|
||||
else
|
||||
response status
|
||||
(headers ++ contentTypeHeaders ctxApiRequest)
|
||||
(if invMethod == InvHead then mempty else rsOrErrBody)
|
||||
|
||||
RSPlan plan ->
|
||||
Wai.responseLBS HTTP.status200 (contentTypeHeaders ctxApiRequest) $ LBS.fromStrict plan
|
||||
|
||||
openApiResponse :: (Text, Text) -> Bool -> Maybe (TablesMap, RoutineMap, Maybe Text) -> AppConfig -> SchemaCache -> Schema -> Bool -> Wai.Response
|
||||
openApiResponse versions headersOnly body conf sCache schema negotiatedByProfile =
|
||||
Wai.responseLBS HTTP.status200
|
||||
(MediaType.toContentType MTOpenAPI : maybeToList (profileHeader schema negotiatedByProfile))
|
||||
(maybe mempty (\(x, y, z) -> if headersOnly then mempty else OpenAPI.encode versions conf sCache x y z) body)
|
||||
|
||||
-- | Response with headers and status overridden from GUCs.
|
||||
gucResponse
|
||||
:: Maybe Text
|
||||
-> Maybe BS.ByteString
|
||||
-> HTTP.Status
|
||||
-> [HTTP.Header]
|
||||
-> LBS.ByteString
|
||||
-> Wai.Response
|
||||
gucResponse rsGucStatus rsGucHeaders status headers body =
|
||||
case (,) <$> decodeGucStatus rsGucStatus <*> decodeGucHeaders rsGucHeaders of
|
||||
Left err -> Error.errorResponseFor err
|
||||
Right (gucStatus, gucHeaders) ->
|
||||
Wai.responseLBS (fromMaybe status gucStatus) (addHeadersIfNotIncluded headers (map unwrapGucHeader gucHeaders)) body
|
||||
|
||||
decodeGucHeaders :: Maybe BS.ByteString -> Either Error.Error [GucHeader]
|
||||
decodeGucHeaders =
|
||||
maybe (Right []) $ first (const Error.GucHeadersError) . JSON.eitherDecode . LBS.fromStrict
|
||||
|
||||
decodeGucStatus :: Maybe Text -> Either Error.Error (Maybe HTTP.Status)
|
||||
decodeGucStatus =
|
||||
maybe (Right Nothing) $ first (const Error.GucStatusError) . fmap (Just . toEnum . fst) . decimal
|
||||
|
||||
contentTypeHeaders :: ApiRequest -> [HTTP.Header]
|
||||
contentTypeHeaders ApiRequest{..} =
|
||||
MediaType.toContentType iAcceptMediaType : maybeToList (profileHeader iSchema iNegotiatedByProfile)
|
||||
|
||||
profileHeader :: Schema -> Bool -> Maybe HTTP.Header
|
||||
profileHeader schema negotiatedByProfile =
|
||||
if negotiatedByProfile
|
||||
then Just $ (,) "Content-Profile" (toS schema)
|
||||
else
|
||||
Nothing
|
||||
|
||||
addRetryHint :: Int -> Wai.Response -> Wai.Response
|
||||
addRetryHint delay response = do
|
||||
let h = ("Retry-After", BS.pack $ show delay)
|
||||
Wai.mapResponseHeaders (\hs -> if isServiceUnavailable response then h:hs else hs) response
|
||||
|
||||
isServiceUnavailable :: Wai.Response -> Bool
|
||||
isServiceUnavailable response = Wai.responseStatus response == HTTP.status503
|
||||
|
||||
-- | Add headers not already included to allow the user to override them instead of duplicating them
|
||||
addHeadersIfNotIncluded :: [HTTP.Header] -> [HTTP.Header] -> [HTTP.Header]
|
||||
addHeadersIfNotIncluded newHeaders initialHeaders =
|
||||
filter (\(nk, _) -> isNothing $ find (\(ik, _) -> ik == nk) initialHeaders) newHeaders ++
|
||||
initialHeaders
|
||||
|
||||
traceHeaderMiddleware :: AppConfig -> Wai.Middleware
|
||||
traceHeaderMiddleware AppConfig{configServerTraceHeader} app req respond =
|
||||
case configServerTraceHeader of
|
||||
Nothing -> app req respond
|
||||
Just hdr ->
|
||||
let hdrVal = L.lookup hdr $ Wai.requestHeaders req in
|
||||
app req (respond . Wai.mapResponseHeaders ([(hdr, fromMaybe mempty hdrVal)] ++))
|
||||
@@ -1,7 +1,6 @@
|
||||
module PostgREST.GucHeader
|
||||
module PostgREST.Response.GucHeader
|
||||
( GucHeader
|
||||
, unwrapGucHeader
|
||||
, addHeadersIfNotIncluded
|
||||
) where
|
||||
|
||||
import qualified Data.Aeson as JSON
|
||||
@@ -29,9 +28,3 @@ instance JSON.FromJSON GucHeader where
|
||||
|
||||
unwrapGucHeader :: GucHeader -> Header
|
||||
unwrapGucHeader (GucHeader (k, v)) = (k, v)
|
||||
|
||||
-- | Add headers not already included to allow the user to override them instead of duplicating them
|
||||
addHeadersIfNotIncluded :: [Header] -> [Header] -> [Header]
|
||||
addHeadersIfNotIncluded newHeaders initialHeaders =
|
||||
filter (\(nk, _) -> isNothing $ find (\(ik, _) -> ik == nk) initialHeaders) newHeaders ++
|
||||
initialHeaders
|
||||
@@ -4,7 +4,7 @@ Description : Generates the OpenAPI output
|
||||
-}
|
||||
{-# LANGUAGE LambdaCase #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
module PostgREST.OpenAPI (encode) where
|
||||
module PostgREST.Response.OpenAPI (encode) where
|
||||
|
||||
import qualified Data.Aeson as JSON
|
||||
import qualified Data.ByteString.Char8 as BS
|
||||
@@ -12,7 +12,6 @@ import qualified Data.ByteString.Lazy as LBS
|
||||
import qualified Data.HashMap.Strict as HM
|
||||
import qualified Data.HashSet.InsOrd as Set
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Text.Encoding as T
|
||||
|
||||
import Control.Arrow ((&&&))
|
||||
import Data.HashMap.Strict.InsOrd (InsOrdHashMap, fromList)
|
||||
@@ -26,26 +25,27 @@ import Data.Swagger
|
||||
|
||||
import PostgREST.Config (AppConfig (..), Proxy (..),
|
||||
isMalformedProxyUri, toURI)
|
||||
import PostgREST.DbStructure (DbStructure (..))
|
||||
import PostgREST.DbStructure.Identifiers (QualifiedIdentifier (..))
|
||||
import PostgREST.DbStructure.Proc (ProcDescription (..),
|
||||
ProcParam (..))
|
||||
import PostgREST.DbStructure.Relationship (Cardinality (..),
|
||||
import PostgREST.SchemaCache (SchemaCache (..))
|
||||
import PostgREST.SchemaCache.Identifiers (QualifiedIdentifier (..))
|
||||
import PostgREST.SchemaCache.Relationship (Cardinality (..),
|
||||
Relationship (..),
|
||||
RelationshipsMap)
|
||||
import PostgREST.DbStructure.Table (Column (..), Table (..),
|
||||
TablesMap)
|
||||
import PostgREST.Version (docsVersion, prettyVersion)
|
||||
import PostgREST.SchemaCache.Routine (Routine (..),
|
||||
RoutineParam (..))
|
||||
import PostgREST.SchemaCache.Table (Column (..), Table (..),
|
||||
TablesMap,
|
||||
tableColumnsList)
|
||||
|
||||
import PostgREST.MediaType
|
||||
|
||||
import Protolude hiding (Proxy, get)
|
||||
|
||||
encode :: AppConfig -> DbStructure -> TablesMap -> HM.HashMap k [ProcDescription] -> Maybe Text -> LBS.ByteString
|
||||
encode conf dbStructure tables procs schemaDescription =
|
||||
encode :: (Text, Text) -> AppConfig -> SchemaCache -> TablesMap -> HM.HashMap k [Routine] -> Maybe Text -> LBS.ByteString
|
||||
encode versions conf sCache tables procs schemaDescription =
|
||||
JSON.encode $
|
||||
postgrestSpec
|
||||
(dbRelationships dbStructure)
|
||||
versions
|
||||
(dbRelationships sCache)
|
||||
(concat $ HM.elems procs)
|
||||
(snd <$> HM.toList tables)
|
||||
(proxyUri conf)
|
||||
@@ -66,10 +66,22 @@ toSwaggerType "bigint" = Just SwaggerInteger
|
||||
toSwaggerType "numeric" = Just SwaggerNumber
|
||||
toSwaggerType "real" = Just SwaggerNumber
|
||||
toSwaggerType "double precision" = Just SwaggerNumber
|
||||
toSwaggerType "ARRAY" = Just SwaggerArray
|
||||
toSwaggerType "json" = Nothing
|
||||
toSwaggerType "jsonb" = Nothing
|
||||
toSwaggerType _ = Just SwaggerString
|
||||
toSwaggerType colType = case T.takeEnd 2 colType of
|
||||
"[]" -> Just SwaggerArray
|
||||
_ -> Just SwaggerString
|
||||
|
||||
typeFromArray :: Text -> Text
|
||||
typeFromArray = T.dropEnd 2
|
||||
|
||||
toSwaggerTypeFromArray :: Text -> Maybe (SwaggerType t)
|
||||
toSwaggerTypeFromArray arrType = toSwaggerType $ typeFromArray arrType
|
||||
|
||||
makePropertyItems :: Text -> Maybe (Referenced Schema)
|
||||
makePropertyItems arrType = case toSwaggerType arrType of
|
||||
Just SwaggerArray -> Just $ Inline (mempty & type_ .~ toSwaggerTypeFromArray arrType)
|
||||
_ -> Nothing
|
||||
|
||||
parseDefault :: Text -> Text -> Text
|
||||
parseDefault colType colDefault =
|
||||
@@ -87,8 +99,8 @@ makeTableDef rels t =
|
||||
(tn, (mempty :: Schema)
|
||||
& description .~ tableDescription t
|
||||
& type_ ?~ SwaggerObject
|
||||
& properties .~ fromList (makeProperty t rels <$> tableColumns t)
|
||||
& required .~ fmap colName (filter (not . colNullable) $ tableColumns t))
|
||||
& properties .~ fromList (makeProperty t rels <$> tableColumnsList t)
|
||||
& required .~ fmap colName (filter (not . colNullable) $ tableColumnsList t))
|
||||
|
||||
makeProperty :: Table -> RelationshipsMap -> Column -> (Text, Referenced Schema)
|
||||
makeProperty tbl rels col = (colName col, Inline s)
|
||||
@@ -97,11 +109,14 @@ makeProperty tbl rels col = (colName col, Inline s)
|
||||
fk :: Maybe Text
|
||||
fk =
|
||||
let
|
||||
searchedRels = fromMaybe mempty $ HM.lookup (QualifiedIdentifier (tableSchema tbl) (tableName tbl), tableSchema tbl) rels
|
||||
-- Sorts the relationship list to get tables first
|
||||
relsSortedByIsView = sortOn relFTableIsView [ r | r@Relationship{} <- searchedRels]
|
||||
-- Finds the relationship that has a single column foreign key
|
||||
rel = find (\case
|
||||
Relationship{relCardinality=(M2O _ relColumns)} -> [colName col] == (fst <$> relColumns)
|
||||
_ -> False
|
||||
) $ fromMaybe mempty $ HM.lookup (QualifiedIdentifier (tableSchema tbl) (tableName tbl), tableSchema tbl) rels
|
||||
) relsSortedByIsView
|
||||
fCol = (headMay . (\r -> snd <$> relColumns (relCardinality r)) =<< rel)
|
||||
fTbl = qiName . relForeignTable <$> rel
|
||||
fTblCol = (,) <$> fTbl <*> fCol
|
||||
@@ -127,8 +142,9 @@ makeProperty tbl rels col = (colName col, Inline s)
|
||||
& format ?~ colType col
|
||||
& maxLength .~ (fromIntegral <$> colMaxLen col)
|
||||
& type_ .~ toSwaggerType (colType col)
|
||||
& items .~ (SwaggerItemsObject <$> makePropertyItems (colType col))
|
||||
|
||||
makeProcSchema :: ProcDescription -> Schema
|
||||
makeProcSchema :: Routine -> Schema
|
||||
makeProcSchema pd =
|
||||
(mempty :: Schema)
|
||||
& description .~ pdDescription pd
|
||||
@@ -136,11 +152,12 @@ makeProcSchema pd =
|
||||
& properties .~ fromList (fmap makeProcProperty (pdParams pd))
|
||||
& required .~ fmap ppName (filter ppReq (pdParams pd))
|
||||
|
||||
makeProcProperty :: ProcParam -> (Text, Referenced Schema)
|
||||
makeProcProperty (ProcParam n t _ _) = (n, Inline s)
|
||||
makeProcProperty :: RoutineParam -> (Text, Referenced Schema)
|
||||
makeProcProperty (RoutineParam n t _ _ _) = (n, Inline s)
|
||||
where
|
||||
s = (mempty :: Schema)
|
||||
& type_ .~ toSwaggerType t
|
||||
& items .~ (SwaggerItemsObject <$> makePropertyItems t)
|
||||
& format ?~ t
|
||||
|
||||
makePreferParam :: [Text] -> Param
|
||||
@@ -152,10 +169,47 @@ makePreferParam ts =
|
||||
& schema .~ ParamOther ((mempty :: ParamOtherSchema)
|
||||
& in_ .~ ParamHeader
|
||||
& type_ ?~ SwaggerString
|
||||
& enum_ .~ JSON.decode (JSON.encode ts))
|
||||
& enum_ .~ JSON.decode (JSON.encode $ foldl (<>) [] (val <$> ts)))
|
||||
where
|
||||
val :: Text -> [Text]
|
||||
val = \case
|
||||
"count" -> ["count=none"]
|
||||
"params" -> ["params=single-object"]
|
||||
"return" -> ["return=representation", "return=minimal", "return=none"]
|
||||
"resolution" -> ["resolution=ignore-duplicates", "resolution=merge-duplicates"]
|
||||
_ -> []
|
||||
|
||||
makeProcParam :: ProcDescription -> [Referenced Param]
|
||||
makeProcParam pd =
|
||||
makeProcGetParam :: RoutineParam -> Referenced Param
|
||||
makeProcGetParam (RoutineParam n t _ r v) =
|
||||
Inline $ (mempty :: Param)
|
||||
& name .~ n
|
||||
& required ?~ r
|
||||
& schema .~ ParamOther fullSchema
|
||||
where
|
||||
fullSchema = if v then schemaMulti else schemaNotMulti
|
||||
baseSchema = (mempty :: ParamOtherSchema)
|
||||
& in_ .~ ParamQuery
|
||||
schemaNotMulti = baseSchema
|
||||
& format ?~ t
|
||||
& type_ ?~ toParamType (toSwaggerType t)
|
||||
schemaMulti = baseSchema
|
||||
& type_ ?~ fromMaybe SwaggerString (toSwaggerType t)
|
||||
& items ?~ SwaggerItemsPrimitive (Just CollectionMulti)
|
||||
((mempty :: ParamSchema x)
|
||||
& type_ .~ toSwaggerTypeFromArray t
|
||||
& format ?~ typeFromArray t)
|
||||
toParamType paramType = case paramType of
|
||||
-- Array uses {} in query params
|
||||
Just SwaggerArray -> SwaggerString
|
||||
-- Type must be specified in query params
|
||||
Nothing -> SwaggerString
|
||||
_ -> fromJust paramType
|
||||
|
||||
makeProcGetParams :: [RoutineParam] -> [Referenced Param]
|
||||
makeProcGetParams = fmap makeProcGetParam
|
||||
|
||||
makeProcPostParams :: Routine -> [Referenced Param]
|
||||
makeProcPostParams pd =
|
||||
[ Inline $ (mempty :: Param)
|
||||
& name .~ "args"
|
||||
& required ?~ True
|
||||
@@ -165,9 +219,11 @@ makeProcParam pd =
|
||||
|
||||
makeParamDefs :: [Table] -> [(Text, Param)]
|
||||
makeParamDefs ti =
|
||||
[ ("preferParams", makePreferParam ["params=single-object"])
|
||||
, ("preferReturn", makePreferParam ["return=representation", "return=minimal", "return=none"])
|
||||
, ("preferCount", makePreferParam ["count=none"])
|
||||
-- TODO: create Prefer for each method (GET, PATCH, etc.)
|
||||
[ ("preferParams", makePreferParam ["params"])
|
||||
, ("preferReturn", makePreferParam ["return"])
|
||||
, ("preferCount", makePreferParam ["count"])
|
||||
, ("preferPost", makePreferParam ["return", "resolution"])
|
||||
, ("select", (mempty :: Param)
|
||||
& name .~ "select"
|
||||
& description ?~ "Filtering Columns"
|
||||
@@ -219,7 +275,7 @@ makeParamDefs ti =
|
||||
& in_ .~ ParamQuery
|
||||
& type_ ?~ SwaggerString))
|
||||
]
|
||||
<> concat [ makeObjectBody (tableName t) : makeRowFilters (tableName t) (tableColumns t)
|
||||
<> concat [ makeObjectBody (tableName t) : makeRowFilters (tableName t) (tableColumnsList t)
|
||||
| t <- ti
|
||||
]
|
||||
|
||||
@@ -267,7 +323,7 @@ makePathItem t = ("/" ++ T.unpack tn, p $ tableInsertable t || tableUpdatable t
|
||||
)
|
||||
)
|
||||
postOp = tOp
|
||||
& parameters .~ fmap ref ["body." <> tn, "select", "preferReturn"]
|
||||
& parameters .~ fmap ref ["body." <> tn, "select", "preferPost"]
|
||||
& at 201 ?~ "Created"
|
||||
patchOp = tOp
|
||||
& parameters .~ fmap ref (rs <> ["body." <> tn, "preferReturn"])
|
||||
@@ -280,24 +336,29 @@ makePathItem t = ("/" ++ T.unpack tn, p $ tableInsertable t || tableUpdatable t
|
||||
p False = pr
|
||||
p True = pw
|
||||
tn = tableName t
|
||||
rs = [ T.intercalate "." ["rowFilter", tn, colName c ] | c <- tableColumns t ]
|
||||
rs = [ T.intercalate "." ["rowFilter", tn, colName c ] | c <- tableColumnsList t ]
|
||||
ref = Ref . Reference
|
||||
|
||||
makeProcPathItem :: ProcDescription -> (FilePath, PathItem)
|
||||
makeProcPathItem :: Routine -> (FilePath, PathItem)
|
||||
makeProcPathItem pd = ("/rpc/" ++ toS (pdName pd), pe)
|
||||
where
|
||||
-- Use first line of proc 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
|
||||
(pSum, pDesc) = fmap fst &&& fmap (T.dropWhile (=='\n') . snd) $
|
||||
T.breakOn "\n" <$> pdDescription pd
|
||||
postOp = (mempty :: Operation)
|
||||
procOp = (mempty :: Operation)
|
||||
& summary .~ pSum
|
||||
& description .~ mfilter (/="") pDesc
|
||||
& parameters .~ makeProcParam pd
|
||||
& tags .~ Set.fromList ["(rpc) " <> pdName pd]
|
||||
& produces ?~ makeMimeList [MTApplicationJSON, MTSingularJSON]
|
||||
& produces ?~ makeMimeList [MTApplicationJSON, MTSingularJSON True, MTSingularJSON False]
|
||||
& at 200 ?~ "OK"
|
||||
pe = (mempty :: PathItem) & post ?~ postOp
|
||||
getOp = procOp
|
||||
& parameters .~ makeProcGetParams (pdParams pd)
|
||||
postOp = procOp
|
||||
& parameters .~ makeProcPostParams pd
|
||||
pe = (mempty :: PathItem)
|
||||
& get ?~ getOp
|
||||
& post ?~ postOp
|
||||
|
||||
makeRootPathItem :: (FilePath, PathItem)
|
||||
makeRootPathItem = ("/", p)
|
||||
@@ -310,7 +371,7 @@ makeRootPathItem = ("/", p)
|
||||
pr = (mempty :: PathItem) & get ?~ getOp
|
||||
p = pr
|
||||
|
||||
makePathItems :: [ProcDescription] -> [Table] -> InsOrdHashMap FilePath PathItem
|
||||
makePathItems :: [Routine] -> [Table] -> InsOrdHashMap FilePath PathItem
|
||||
makePathItems pds ti = fromList $ makeRootPathItem :
|
||||
fmap makePathItem ti ++ fmap makeProcPathItem pds
|
||||
|
||||
@@ -330,14 +391,14 @@ escapeHostName "*6" = "0.0.0.0"
|
||||
escapeHostName "!6" = "0.0.0.0"
|
||||
escapeHostName h = h
|
||||
|
||||
postgrestSpec :: RelationshipsMap -> [ProcDescription] -> [Table] -> (Text, Text, Integer, Text) -> Maybe Text -> Bool -> Swagger
|
||||
postgrestSpec rels pds ti (s, h, p, b) sd allowSecurityDef = (mempty :: Swagger)
|
||||
postgrestSpec :: (Text, Text) -> RelationshipsMap -> [Routine] -> [Table] -> (Text, Text, Integer, Text) -> Maybe Text -> Bool -> Swagger
|
||||
postgrestSpec (prettyVersion, docsVersion) rels pds ti (s, h, p, b) sd allowSecurityDef = (mempty :: Swagger)
|
||||
& basePath ?~ T.unpack b
|
||||
& schemes ?~ [s']
|
||||
& info .~ ((mempty :: Info)
|
||||
& version .~ T.decodeUtf8 prettyVersion
|
||||
& title .~ "PostgREST API"
|
||||
& description ?~ d)
|
||||
& version .~ prettyVersion
|
||||
& title .~ fromMaybe "PostgREST API" dTitle
|
||||
& description ?~ fromMaybe "This is a dynamic API generated by PostgREST" dDesc)
|
||||
& externalDocs ?~ ((mempty :: ExternalDocs)
|
||||
& description ?~ "PostgREST Documentation"
|
||||
& url .~ URL ("https://postgrest.org/en/" <> docsVersion <> "/api.html"))
|
||||
@@ -345,15 +406,16 @@ postgrestSpec rels pds ti (s, h, p, b) sd allowSecurityDef = (mempty :: Swagger)
|
||||
& definitions .~ fromList (makeTableDef rels <$> ti)
|
||||
& parameters .~ fromList (makeParamDefs ti)
|
||||
& paths .~ makePathItems pds ti
|
||||
& produces .~ makeMimeList [MTApplicationJSON, MTSingularJSON, MTTextCSV]
|
||||
& consumes .~ makeMimeList [MTApplicationJSON, MTSingularJSON, MTTextCSV]
|
||||
& produces .~ makeMimeList [MTApplicationJSON, MTSingularJSON True, MTSingularJSON False, MTTextCSV]
|
||||
& consumes .~ makeMimeList [MTApplicationJSON, MTSingularJSON True, MTSingularJSON False, MTTextCSV]
|
||||
& securityDefinitions .~ makeSecurityDefinitions securityDefName allowSecurityDef
|
||||
& security .~ [SecurityRequirement (fromList [(securityDefName, [])]) | allowSecurityDef]
|
||||
where
|
||||
s' = if s == "http" then Http else Https
|
||||
h' = Just $ Host (T.unpack $ escapeHostName h) (Just (fromInteger p))
|
||||
d = fromMaybe "This is a dynamic API generated by PostgREST" sd
|
||||
securityDefName = "JWT"
|
||||
(dTitle, dDesc) = fmap fst &&& fmap (T.dropWhile (=='\n') . snd) $
|
||||
T.breakOn "\n" <$> sd
|
||||
|
||||
pickProxy :: Maybe Text -> Maybe Proxy
|
||||
pickProxy proxy
|
||||
@@ -1,8 +1,8 @@
|
||||
{-|
|
||||
Module : PostgREST.DbStructure
|
||||
Module : PostgREST.SchemaCache
|
||||
Description : PostgREST schema cache
|
||||
|
||||
This module contains queries that target PostgreSQL system catalogs, these are used to build the schema cache(DbStructure).
|
||||
This module(used to be named DbStructure) contains queries that target PostgreSQL system catalogs, these are used to build the schema cache(SchemaCache).
|
||||
|
||||
The schema cache is necessary for resource embedding, foreign keys are used for inferring the relationships between tables.
|
||||
|
||||
@@ -18,60 +18,91 @@ These queries are executed once at startup or when PostgREST is reloaded.
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
{-# LANGUAGE TypeSynonymInstances #-}
|
||||
|
||||
module PostgREST.DbStructure
|
||||
( DbStructure(..)
|
||||
, queryDbStructure
|
||||
module PostgREST.SchemaCache
|
||||
( SchemaCache(..)
|
||||
, querySchemaCache
|
||||
, accessibleTables
|
||||
, accessibleProcs
|
||||
, accessibleFuncs
|
||||
, schemaDescription
|
||||
) where
|
||||
|
||||
import qualified Data.Aeson as JSON
|
||||
import qualified Data.HashMap.Strict as HM
|
||||
import qualified Data.Set as S
|
||||
import qualified Hasql.Decoders as HD
|
||||
import qualified Hasql.Encoders as HE
|
||||
import qualified Hasql.Statement as SQL
|
||||
import qualified Hasql.Transaction as SQL
|
||||
import Control.Monad.Extra (whenJust)
|
||||
|
||||
import qualified Data.Aeson as JSON
|
||||
import qualified Data.HashMap.Strict as HM
|
||||
import qualified Data.HashMap.Strict.InsOrd as HMI
|
||||
import qualified Data.Set as S
|
||||
import qualified Hasql.Decoders as HD
|
||||
import qualified Hasql.Encoders as HE
|
||||
import qualified Hasql.Statement as SQL
|
||||
import qualified Hasql.Transaction as SQL
|
||||
|
||||
import Contravariant.Extras (contrazip2)
|
||||
import Text.InterpolatedString.Perl6 (q)
|
||||
|
||||
import PostgREST.Config.Database (pgVersionStatement)
|
||||
import PostgREST.Config.PgVersion (PgVersion, pgVersion100,
|
||||
pgVersion110)
|
||||
import PostgREST.DbStructure.Identifiers (FieldName,
|
||||
QualifiedIdentifier (..),
|
||||
Schema)
|
||||
import PostgREST.DbStructure.Proc (PgType (..),
|
||||
ProcDescription (..),
|
||||
ProcParam (..),
|
||||
ProcVolatility (..),
|
||||
ProcsMap, RetType (..))
|
||||
import PostgREST.DbStructure.Relationship (Cardinality (..),
|
||||
Junction (..),
|
||||
Relationship (..),
|
||||
RelationshipsMap)
|
||||
import PostgREST.DbStructure.Table (Column (..), Table (..),
|
||||
TablesMap)
|
||||
import PostgREST.Config (AppConfig (..))
|
||||
import PostgREST.Config.Database (pgVersionStatement,
|
||||
toIsolationLevel)
|
||||
import PostgREST.Config.PgVersion (PgVersion, pgVersion100,
|
||||
pgVersion110,
|
||||
pgVersion120)
|
||||
import PostgREST.SchemaCache.Identifiers (AccessSet, FieldName,
|
||||
QualifiedIdentifier (..),
|
||||
Schema)
|
||||
import PostgREST.SchemaCache.Relationship (Cardinality (..),
|
||||
Junction (..),
|
||||
Relationship (..),
|
||||
RelationshipsMap)
|
||||
import PostgREST.SchemaCache.Representations (DataRepresentation (..),
|
||||
RepresentationsMap)
|
||||
import PostgREST.SchemaCache.Routine (FuncVolatility (..),
|
||||
PgType (..),
|
||||
RetType (..),
|
||||
Routine (..),
|
||||
RoutineMap,
|
||||
RoutineParam (..))
|
||||
import PostgREST.SchemaCache.Table (Column (..), ColumnMap,
|
||||
Table (..), TablesMap)
|
||||
|
||||
import Protolude
|
||||
|
||||
|
||||
data DbStructure = DbStructure
|
||||
{ dbTables :: TablesMap
|
||||
, dbRelationships :: RelationshipsMap
|
||||
, dbProcs :: ProcsMap
|
||||
data SchemaCache = SchemaCache
|
||||
{ dbTables :: TablesMap
|
||||
, dbRelationships :: RelationshipsMap
|
||||
, dbRoutines :: RoutineMap
|
||||
, dbRepresentations :: RepresentationsMap
|
||||
}
|
||||
deriving (Generic, JSON.ToJSON)
|
||||
|
||||
-- | A view foreign key or primary key dependency detected on its source table
|
||||
-- Each column of the key could be referenced multiple times in the view, e.g.
|
||||
--
|
||||
-- create view projects_view as
|
||||
-- select
|
||||
-- id as id_1,
|
||||
-- id as id_2,
|
||||
-- id as id_3,
|
||||
-- name
|
||||
-- from projects
|
||||
--
|
||||
-- In this case, the keyDepCols mapping maps projects.id to all three of the columns:
|
||||
--
|
||||
-- [('id', ['id_1', 'id_2', 'id_3'])]
|
||||
--
|
||||
-- Depending on key type, we can then choose how to handle this case. Primary keys
|
||||
-- can arbitrarily choose one of the columns, but for foreign keys we need to create
|
||||
-- relationships for each possible mutations.
|
||||
--
|
||||
-- Previously, we stored a (FieldName, FieldName) tuple only, but then we had no
|
||||
-- way to make a difference between a multi-column-key and a single-column-key with multiple
|
||||
-- references in the view. Or even worse in the multi-column-key-multi-reference case...
|
||||
data ViewKeyDependency = ViewKeyDependency {
|
||||
keyDepTable :: QualifiedIdentifier
|
||||
, keyDepView :: QualifiedIdentifier
|
||||
, keyDepCons :: Text
|
||||
, keyDepType :: KeyDep
|
||||
, keyDepCols :: [(FieldName, FieldName)] -- ^ First element is the table column, second is the view column
|
||||
, keyDepCols :: [(FieldName, [FieldName])] -- ^ First element is the table column, second is a list of view columns
|
||||
} deriving (Eq)
|
||||
data KeyDep
|
||||
= PKDep -- ^ PK dependency
|
||||
@@ -82,24 +113,32 @@ data KeyDep
|
||||
-- | A SQL query that can be executed independently
|
||||
type SqlQuery = ByteString
|
||||
|
||||
queryDbStructure :: [Schema] -> [Schema] -> Bool -> SQL.Transaction DbStructure
|
||||
queryDbStructure schemas extraSearchPath prepared = do
|
||||
querySchemaCache :: AppConfig -> SQL.Transaction SchemaCache
|
||||
querySchemaCache AppConfig{..} = do
|
||||
SQL.sql "set local schema ''" -- This voids the search path. The following queries need this for getting the fully qualified name(schema.name) of every db object
|
||||
pgVer <- SQL.statement mempty pgVersionStatement
|
||||
pgVer <- SQL.statement mempty $ pgVersionStatement prepared
|
||||
tabs <- SQL.statement schemas $ allTables pgVer prepared
|
||||
keyDeps <- SQL.statement (schemas, extraSearchPath) $ allViewsKeyDependencies prepared
|
||||
keyDeps <- SQL.statement (schemas, configDbExtraSearchPath) $ allViewsKeyDependencies prepared
|
||||
m2oRels <- SQL.statement mempty $ allM2OandO2ORels pgVer prepared
|
||||
procs <- SQL.statement schemas $ allProcs pgVer prepared
|
||||
funcs <- SQL.statement schemas $ allFunctions pgVer prepared
|
||||
cRels <- SQL.statement mempty $ allComputedRels prepared
|
||||
reps <- SQL.statement schemas $ dataRepresentations prepared
|
||||
_ <-
|
||||
let sleepCall = SQL.Statement "select pg_sleep($1)" (param HE.int4) HD.noResult prepared in
|
||||
whenJust configInternalSCSleep (`SQL.statement` sleepCall) -- only used for testing
|
||||
|
||||
let tabsWViewsPks = addViewPrimaryKeys tabs keyDeps
|
||||
rels = addInverseRels $ addM2MRels tabsWViewsPks $ addViewM2OAndO2ORels keyDeps m2oRels
|
||||
|
||||
return $ removeInternal schemas $ DbStructure {
|
||||
return $ removeInternal schemas $ SchemaCache {
|
||||
dbTables = tabsWViewsPks
|
||||
, dbRelationships = getOverrideRelationshipsMap rels cRels
|
||||
, dbProcs = procs
|
||||
, dbRoutines = funcs
|
||||
, dbRepresentations = reps
|
||||
}
|
||||
where
|
||||
schemas = toList configDbSchemas
|
||||
prepared = configDbPreparedStatements
|
||||
|
||||
-- | overrides detected relationships with the computed relationships and gets the RelationshipsMap
|
||||
getOverrideRelationshipsMap :: [Relationship] -> [Relationship] -> RelationshipsMap
|
||||
@@ -121,14 +160,15 @@ getOverrideRelationshipsMap rels cRels =
|
||||
deformedRelMap = HM.fromListWith (++) . fmap addDeformedRelKey . HM.toList
|
||||
addDeformedRelKey ((relT, relFT), rls) = ((relT, qiSchema relFT), rls)
|
||||
|
||||
-- | Remove db objects that belong to an internal schema(not exposed through the API) from the DbStructure.
|
||||
removeInternal :: [Schema] -> DbStructure -> DbStructure
|
||||
-- | Remove db objects that belong to an internal schema(not exposed through the API) from the SchemaCache.
|
||||
removeInternal :: [Schema] -> SchemaCache -> SchemaCache
|
||||
removeInternal schemas dbStruct =
|
||||
DbStructure {
|
||||
dbTables = HM.filterWithKey (\(QualifiedIdentifier sch _) _ -> sch `elem` schemas) $ dbTables dbStruct
|
||||
, dbRelationships = filter (\r -> qiSchema (relForeignTable r) `elem` schemas && not (hasInternalJunction r)) <$>
|
||||
HM.filterWithKey (\(QualifiedIdentifier sch _, _) _ -> sch `elem` schemas ) (dbRelationships dbStruct)
|
||||
, dbProcs = dbProcs dbStruct -- procs are only obtained from the exposed schemas, no need to filter them.
|
||||
SchemaCache {
|
||||
dbTables = HM.filterWithKey (\(QualifiedIdentifier sch _) _ -> sch `elem` schemas) $ dbTables dbStruct
|
||||
, dbRelationships = filter (\r -> qiSchema (relForeignTable r) `elem` schemas && not (hasInternalJunction r)) <$>
|
||||
HM.filterWithKey (\(QualifiedIdentifier sch _, _) _ -> sch `elem` schemas ) (dbRelationships dbStruct)
|
||||
, dbRoutines = dbRoutines dbStruct -- procs are only obtained from the exposed schemas, no need to filter them.
|
||||
, dbRepresentations = dbRepresentations dbStruct -- no need to filter, not directly exposed through the API
|
||||
}
|
||||
where
|
||||
hasInternalJunction ComputedRelationship{} = False
|
||||
@@ -136,6 +176,14 @@ removeInternal schemas dbStruct =
|
||||
M2M Junction{junTable} -> qiSchema junTable `notElem` schemas
|
||||
_ -> False
|
||||
|
||||
decodeAccessibleIdentifiers :: HD.Result AccessSet
|
||||
decodeAccessibleIdentifiers =
|
||||
S.fromList <$> HD.rowList row
|
||||
where
|
||||
row = QualifiedIdentifier
|
||||
<$> column HD.text
|
||||
<*> column HD.text
|
||||
|
||||
decodeTables :: HD.Result TablesMap
|
||||
decodeTables =
|
||||
HM.fromList . map (\tbl@Table{tableSchema, tableName} -> (QualifiedIdentifier tableSchema tableName, tbl)) <$> HD.rowList tblRow
|
||||
@@ -149,15 +197,20 @@ decodeTables =
|
||||
<*> column HD.bool
|
||||
<*> column HD.bool
|
||||
<*> arrayColumn HD.text
|
||||
<*> compositeArrayColumn
|
||||
(Column
|
||||
<*> parseCols (compositeArrayColumn
|
||||
(Column
|
||||
<$> compositeField HD.text
|
||||
<*> nullableCompositeField HD.text
|
||||
<*> compositeField HD.bool
|
||||
<*> compositeField HD.text
|
||||
<*> compositeField HD.text
|
||||
<*> nullableCompositeField HD.int4
|
||||
<*> nullableCompositeField HD.text
|
||||
<*> compositeFieldArray HD.text)
|
||||
<*> compositeFieldArray HD.text))
|
||||
|
||||
|
||||
parseCols :: HD.Row [Column] -> HD.Row ColumnMap
|
||||
parseCols = fmap (HMI.fromList . map (\col@Column{colName} -> (colName, col)))
|
||||
|
||||
decodeRels :: HD.Result [Relationship]
|
||||
decodeRels =
|
||||
@@ -184,28 +237,29 @@ decodeViewKeyDeps =
|
||||
<*> compositeArrayColumn
|
||||
((,)
|
||||
<$> compositeField HD.text
|
||||
<*> compositeField HD.text)
|
||||
<*> compositeFieldArray HD.text)
|
||||
|
||||
viewKeyDepFromRow :: (Text,Text,Text,Text,Text,Text,[(Text, Text)]) -> ViewKeyDependency
|
||||
viewKeyDepFromRow :: (Text,Text,Text,Text,Text,Text,[(Text, [Text])]) -> ViewKeyDependency
|
||||
viewKeyDepFromRow (s1,t1,s2,v2,cons,consType,sCols) = ViewKeyDependency (QualifiedIdentifier s1 t1) (QualifiedIdentifier s2 v2) cons keyDep sCols
|
||||
where
|
||||
keyDep | consType == "p" = PKDep
|
||||
| consType == "f" = FKDep
|
||||
| otherwise = FKDepRef -- f_ref, we build this type in the query
|
||||
|
||||
decodeProcs :: HD.Result ProcsMap
|
||||
decodeProcs =
|
||||
-- Duplicate rows for a function means they're overloaded, order these by least args according to ProcDescription Ord instance
|
||||
map sort . HM.fromListWith (++) . map ((\(x,y) -> (x, [y])) . addKey) <$> HD.rowList procRow
|
||||
decodeFuncs :: HD.Result RoutineMap
|
||||
decodeFuncs =
|
||||
-- Duplicate rows for a function means they're overloaded, order these by least args according to Routine Ord instance
|
||||
map sort . HM.fromListWith (++) . map ((\(x,y) -> (x, [y])) . addKey) <$> HD.rowList funcRow
|
||||
where
|
||||
procRow = ProcDescription
|
||||
funcRow = Function
|
||||
<$> column HD.text
|
||||
<*> column HD.text
|
||||
<*> nullableColumn HD.text
|
||||
<*> compositeArrayColumn
|
||||
(ProcParam
|
||||
(RoutineParam
|
||||
<$> compositeField HD.text
|
||||
<*> compositeField HD.text
|
||||
<*> compositeField HD.text
|
||||
<*> compositeField HD.bool
|
||||
<*> compositeField HD.bool)
|
||||
<*> (parseRetType
|
||||
@@ -216,38 +270,74 @@ decodeProcs =
|
||||
<*> column HD.bool)
|
||||
<*> (parseVolatility <$> column HD.char)
|
||||
<*> column HD.bool
|
||||
<*> nullableColumn (toIsolationLevel <$> HD.text)
|
||||
|
||||
addKey :: ProcDescription -> (QualifiedIdentifier, ProcDescription)
|
||||
addKey :: Routine -> (QualifiedIdentifier, Routine)
|
||||
addKey pd = (QualifiedIdentifier (pdSchema pd) (pdName pd), pd)
|
||||
|
||||
parseRetType :: Text -> Text -> Bool -> Bool -> Bool -> Maybe RetType
|
||||
parseRetType schema name isSetOf isComposite isVoid
|
||||
| isVoid = Nothing
|
||||
| isSetOf = Just (SetOf pgType)
|
||||
| otherwise = Just (Single pgType)
|
||||
parseRetType :: Text -> Text -> Bool -> Bool -> Bool -> RetType
|
||||
parseRetType schema name isSetOf isComposite isCompositeAlias
|
||||
| isSetOf = SetOf pgType
|
||||
| otherwise = Single pgType
|
||||
where
|
||||
qi = QualifiedIdentifier schema name
|
||||
pgType
|
||||
| isComposite = Composite qi
|
||||
| otherwise = Scalar
|
||||
| isComposite = Composite qi isCompositeAlias
|
||||
| otherwise = Scalar qi
|
||||
|
||||
parseVolatility :: Char -> ProcVolatility
|
||||
parseVolatility :: Char -> FuncVolatility
|
||||
parseVolatility v | v == 'i' = Immutable
|
||||
| v == 's' = Stable
|
||||
| otherwise = Volatile -- only 'v' can happen here
|
||||
|
||||
allProcs :: PgVersion -> Bool -> SQL.Statement [Schema] ProcsMap
|
||||
allProcs pgVer = SQL.Statement sql (arrayParam HE.text) decodeProcs
|
||||
decodeRepresentations :: HD.Result RepresentationsMap
|
||||
decodeRepresentations =
|
||||
HM.fromList . map (\rep@DataRepresentation{drSourceType, drTargetType} -> ((drSourceType, drTargetType), rep)) <$> HD.rowList row
|
||||
where
|
||||
sql = procsSqlQuery pgVer <> " AND pn.nspname = ANY($1)"
|
||||
row = DataRepresentation
|
||||
<$> column HD.text
|
||||
<*> column HD.text
|
||||
<*> column HD.text
|
||||
|
||||
accessibleProcs :: PgVersion -> Bool -> SQL.Statement Schema ProcsMap
|
||||
accessibleProcs pgVer = SQL.Statement sql (param HE.text) decodeProcs
|
||||
-- Selects all potential data representation transformations. To qualify the cast must be
|
||||
-- 1. to or from a domain
|
||||
-- 2. implicit
|
||||
-- For the time being it must also be to/from JSON or text, although one can imagine a future where we support special
|
||||
-- cases like CSV specific representations.
|
||||
dataRepresentations :: Bool -> SQL.Statement [Schema] RepresentationsMap
|
||||
dataRepresentations = SQL.Statement sql (arrayParam HE.text) decodeRepresentations
|
||||
where
|
||||
sql = procsSqlQuery pgVer <> " AND pn.nspname = $1 AND has_function_privilege(p.oid, 'execute')"
|
||||
sql = [q|
|
||||
SELECT
|
||||
c.castsource::regtype::text,
|
||||
c.casttarget::regtype::text,
|
||||
c.castfunc::regproc::text
|
||||
FROM
|
||||
pg_catalog.pg_cast c
|
||||
JOIN pg_catalog.pg_type src_t
|
||||
ON c.castsource::oid = src_t.oid
|
||||
JOIN pg_catalog.pg_type dst_t
|
||||
ON c.casttarget::oid = dst_t.oid
|
||||
WHERE
|
||||
c.castcontext = 'i'
|
||||
AND c.castmethod = 'f'
|
||||
AND has_function_privilege(c.castfunc, 'execute')
|
||||
AND ((src_t.typtype = 'd' AND c.casttarget IN ('json'::regtype::oid , 'text'::regtype::oid))
|
||||
OR (dst_t.typtype = 'd' AND c.castsource IN ('json'::regtype::oid , 'text'::regtype::oid)))
|
||||
|]
|
||||
|
||||
procsSqlQuery :: PgVersion -> SqlQuery
|
||||
procsSqlQuery pgVer = [q|
|
||||
allFunctions :: PgVersion -> Bool -> SQL.Statement [Schema] RoutineMap
|
||||
allFunctions pgVer = SQL.Statement sql (arrayParam HE.text) decodeFuncs
|
||||
where
|
||||
sql = funcsSqlQuery pgVer <> " AND pn.nspname = ANY($1)"
|
||||
|
||||
accessibleFuncs :: PgVersion -> Bool -> SQL.Statement Schema RoutineMap
|
||||
accessibleFuncs pgVer = SQL.Statement sql (param HE.text) decodeFuncs
|
||||
where
|
||||
sql = funcsSqlQuery pgVer <> " AND pn.nspname = $1 AND has_function_privilege(p.oid, 'execute')"
|
||||
|
||||
funcsSqlQuery :: PgVersion -> SqlQuery
|
||||
funcsSqlQuery pgVer = [q|
|
||||
-- Recursively get the base types of domains
|
||||
WITH
|
||||
base_types AS (
|
||||
@@ -278,6 +368,13 @@ procsSqlQuery pgVer = [q|
|
||||
array_agg((
|
||||
COALESCE(name, ''), -- name
|
||||
type::regtype::text, -- type
|
||||
CASE type
|
||||
WHEN 'bit'::regtype THEN 'bit varying'
|
||||
WHEN 'bit[]'::regtype THEN 'bit varying[]'
|
||||
WHEN 'character'::regtype THEN 'character varying'
|
||||
WHEN 'character[]'::regtype THEN 'character varying[]'
|
||||
ELSE type::regtype::text
|
||||
END, -- convert types that ignore the lenth and accept any value till maximum size
|
||||
idx <= (pronargs - pronargdefaults), -- is_required
|
||||
COALESCE(mode = 'v', FALSE) -- is_variadic
|
||||
) ORDER BY idx) AS args,
|
||||
@@ -304,9 +401,10 @@ procsSqlQuery pgVer = [q|
|
||||
-- if any TABLE, INOUT or OUT arguments present, treat as composite
|
||||
or COALESCE(proargmodes::text[] && '{t,b,o}', false)
|
||||
) AS rettype_is_composite,
|
||||
('void'::regtype = t.oid) AS rettype_is_void,
|
||||
bt.oid <> bt.base as rettype_is_composite_alias,
|
||||
p.provolatile,
|
||||
p.provariadic > 0 as hasvariadic
|
||||
p.provariadic > 0 as hasvariadic,
|
||||
lower((regexp_split_to_array((regexp_split_to_array(config, '='))[2], ','))[1]) AS transaction_isolation_level
|
||||
FROM pg_proc p
|
||||
LEFT JOIN arguments a ON a.oid = p.oid
|
||||
JOIN pg_namespace pn ON pn.oid = p.pronamespace
|
||||
@@ -315,6 +413,7 @@ procsSqlQuery pgVer = [q|
|
||||
JOIN pg_namespace tn ON tn.oid = t.typnamespace
|
||||
LEFT JOIN pg_class comp ON comp.oid = t.typrelid
|
||||
LEFT JOIN pg_description as d ON d.objoid = p.oid
|
||||
LEFT JOIN LATERAL unnest(proconfig) config ON config like 'default_transaction_isolation%'
|
||||
WHERE t.oid <> 'trigger'::regtype AND COALESCE(a.callable, true)
|
||||
|] <> (if pgVer >= pgVersion110 then "AND prokind = 'f'" else "AND NOT (proisagg OR proiswindow)")
|
||||
|
||||
@@ -331,11 +430,27 @@ schemaDescription =
|
||||
where
|
||||
n.nspname = $1 |]
|
||||
|
||||
accessibleTables :: PgVersion -> Bool -> SQL.Statement [Schema] TablesMap
|
||||
accessibleTables :: PgVersion -> Bool -> SQL.Statement [Schema] AccessSet
|
||||
accessibleTables pgVer =
|
||||
SQL.Statement sql (arrayParam HE.text) decodeTables
|
||||
SQL.Statement sql (arrayParam HE.text) decodeAccessibleIdentifiers
|
||||
where
|
||||
sql = tablesSqlQuery False pgVer
|
||||
sql = [q|
|
||||
SELECT
|
||||
n.nspname AS table_schema,
|
||||
c.relname AS table_name
|
||||
FROM pg_class c
|
||||
JOIN pg_namespace n ON n.oid = c.relnamespace
|
||||
WHERE c.relkind IN ('v','r','m','f','p')
|
||||
AND n.nspname NOT IN ('pg_catalog', 'information_schema')
|
||||
AND n.nspname = ANY($1)
|
||||
AND (
|
||||
pg_has_role(c.relowner, 'USAGE')
|
||||
or has_table_privilege(c.oid, 'SELECT, INSERT, UPDATE, DELETE, TRUNCATE, REFERENCES, TRIGGER')
|
||||
or has_any_column_privilege(c.oid, 'SELECT, INSERT, UPDATE, REFERENCES')
|
||||
) |] <>
|
||||
relIsPartition <>
|
||||
"ORDER BY table_schema, table_name"
|
||||
relIsPartition = if pgVer >= pgVersion100 then " AND not c.relispartition " else mempty
|
||||
|
||||
{-
|
||||
Adds M2O and O2O relationships for views to tables, tables to views, and views to views. The example below is taken from the test fixtures, but the views names/colnames were modified.
|
||||
@@ -354,7 +469,7 @@ test | personnages_view | test | actors_view | personnage
|
||||
-}
|
||||
addViewM2OAndO2ORels :: [ViewKeyDependency] -> [Relationship] -> [Relationship]
|
||||
addViewM2OAndO2ORels keyDeps rels =
|
||||
rels ++ concat (viewRels <$> rels)
|
||||
rels ++ concatMap viewRels rels
|
||||
where
|
||||
isM2O card = case card of {M2O _ _ -> True; _ -> False;}
|
||||
isO2O card = case card of {O2O _ _ -> True; _ -> False;}
|
||||
@@ -370,19 +485,21 @@ addViewM2OAndO2ORels keyDeps rels =
|
||||
(keyDepView vwTbl)
|
||||
relForeignTable
|
||||
False
|
||||
((if isM2O card then M2O else O2O) cons $ zipWith (\(_, vCol) (_, fCol)-> (vCol, fCol)) (keyDepCols vwTbl) relCols)
|
||||
((if isM2O card then M2O else O2O) cons $ zipWith (\(_, vCol) (_, fCol)-> (vCol, fCol)) keyDepColsVwTbl relCols)
|
||||
True
|
||||
False
|
||||
| vwTbl <- viewTableRels ]
|
||||
| vwTbl <- viewTableRels
|
||||
, keyDepColsVwTbl <- expandKeyDepCols $ keyDepCols vwTbl ]
|
||||
++
|
||||
[ Relationship
|
||||
relTable
|
||||
(keyDepView tblVw)
|
||||
False
|
||||
((if isM2O card then M2O else O2O) cons $ zipWith (\(tCol, _) (_, vCol) -> (tCol, vCol)) relCols (keyDepCols tblVw))
|
||||
((if isM2O card then M2O else O2O) cons $ zipWith (\(tCol, _) (_, vCol) -> (tCol, vCol)) relCols keyDepColsTblVw)
|
||||
False
|
||||
True
|
||||
| tblVw <- tableViewRels ]
|
||||
| tblVw <- tableViewRels
|
||||
, keyDepColsTblVw <- expandKeyDepCols $ keyDepCols tblVw ]
|
||||
++
|
||||
[
|
||||
let
|
||||
@@ -393,13 +510,16 @@ addViewM2OAndO2ORels keyDeps rels =
|
||||
vw1
|
||||
vw2
|
||||
(vw1 == vw2)
|
||||
((if isM2O card then M2O else O2O) cons $ zipWith (\(_, vcol1) (_, vcol2) -> (vcol1, vcol2)) (keyDepCols vwTbl) (keyDepCols tblVw))
|
||||
((if isM2O card then M2O else O2O) cons $ zipWith (\(_, vcol1) (_, vcol2) -> (vcol1, vcol2)) keyDepColsVwTbl keyDepColsTblVw)
|
||||
True
|
||||
True
|
||||
| vwTbl <- viewTableRels
|
||||
, tblVw <- tableViewRels ]
|
||||
, keyDepColsVwTbl <- expandKeyDepCols $ keyDepCols vwTbl
|
||||
, tblVw <- tableViewRels
|
||||
, keyDepColsTblVw <- expandKeyDepCols $ keyDepCols tblVw ]
|
||||
else []
|
||||
viewRels _ = []
|
||||
expandKeyDepCols kdc = zip (fst <$> kdc) <$> traverse snd kdc
|
||||
|
||||
addInverseRels :: [Relationship] -> [Relationship]
|
||||
addInverseRels rels =
|
||||
@@ -428,21 +548,29 @@ addViewPrimaryKeys tabs keyDeps =
|
||||
else tbl) <$> tabs
|
||||
where
|
||||
findViewPKCols sch vw =
|
||||
maybe [] (\(ViewKeyDependency _ _ _ _ pkCols) -> snd <$> pkCols) $
|
||||
find (\(ViewKeyDependency _ viewQi _ dep _) -> dep == PKDep && viewQi == QualifiedIdentifier sch vw) keyDeps
|
||||
concatMap (\(ViewKeyDependency _ _ _ _ pkCols) -> takeFirstPK pkCols) $
|
||||
filter (\(ViewKeyDependency _ viewQi _ dep _) -> dep == PKDep && viewQi == QualifiedIdentifier sch vw) keyDeps
|
||||
-- In the case of multiple reference to the same PK (see comment for ViewKeyDependency) we take the first reference available.
|
||||
-- We assume this to be safe to do, because:
|
||||
-- * We don't have any logic that requires the client to name a PK column (compared to the column hints in embedding for FKs),
|
||||
-- so we don't need to know about the other references.
|
||||
-- * We need to choose a single reference for each column, otherwise we'd output too many columns in location headers etc.
|
||||
takeFirstPK = mapMaybe (head . snd)
|
||||
|
||||
allTables :: PgVersion -> Bool -> SQL.Statement [Schema] TablesMap
|
||||
allTables pgVer =
|
||||
SQL.Statement sql (arrayParam HE.text) decodeTables
|
||||
where
|
||||
sql = tablesSqlQuery True pgVer
|
||||
sql = tablesSqlQuery pgVer
|
||||
|
||||
-- | Gets tables with their PK cols
|
||||
tablesSqlQuery :: Bool -> PgVersion -> SqlQuery
|
||||
tablesSqlQuery getAll pgVer =
|
||||
tablesSqlQuery :: PgVersion -> SqlQuery
|
||||
tablesSqlQuery pgVer =
|
||||
-- the tbl_constraints/key_col_usage CTEs are based on the standard "information_schema.table_constraints"/"information_schema.key_column_usage" views,
|
||||
-- we cannot use those directly as they include the following privilege filter:
|
||||
-- (pg_has_role(ss.relowner, 'USAGE'::text) OR has_column_privilege(ss.roid, a.attnum, 'SELECT, INSERT, UPDATE, REFERENCES'::text));
|
||||
-- on the "columns" CTE, left joining on pg_depend and pg_class is used to obtain the sequence name as a column default in case there are GENERATED .. AS IDENTITY,
|
||||
-- generated columns are only available from pg >= 10 but the query is agnostic to versions. dep.deptype = 'i' is done because there are other 'a' dependencies on PKs
|
||||
[q|
|
||||
WITH
|
||||
columns AS (
|
||||
@@ -451,22 +579,21 @@ tablesSqlQuery getAll pgVer =
|
||||
c.relname::name AS table_name,
|
||||
a.attname::name AS column_name,
|
||||
d.description AS description,
|
||||
pg_get_expr(ad.adbin, ad.adrelid)::text AS column_default,
|
||||
|] <> columnDefault <> [q| AS column_default,
|
||||
not (a.attnotnull OR t.typtype = 'd' AND t.typnotnull) AS is_nullable,
|
||||
CASE
|
||||
WHEN t.typtype = 'd' THEN
|
||||
CASE
|
||||
WHEN t.typtype = 'd' THEN
|
||||
CASE
|
||||
WHEN bt.typelem <> 0::oid AND bt.typlen = (-1) THEN 'ARRAY'::text
|
||||
WHEN nbt.nspname = 'pg_catalog'::name THEN format_type(t.typbasetype, NULL::integer)
|
||||
ELSE format_type(a.atttypid, a.atttypmod)
|
||||
END
|
||||
ELSE
|
||||
CASE
|
||||
WHEN t.typelem <> 0::oid AND t.typlen = (-1) THEN 'ARRAY'::text
|
||||
WHEN nt.nspname = 'pg_catalog'::name THEN format_type(a.atttypid, NULL::integer)
|
||||
ELSE format_type(a.atttypid, a.atttypmod)
|
||||
END
|
||||
END::text AS data_type,
|
||||
WHEN nbt.nspname = 'pg_catalog'::name THEN format_type(t.typbasetype, NULL::integer)
|
||||
ELSE format_type(a.atttypid, a.atttypmod)
|
||||
END
|
||||
ELSE
|
||||
CASE
|
||||
WHEN nt.nspname = 'pg_catalog'::name THEN format_type(a.atttypid, NULL::integer)
|
||||
ELSE format_type(a.atttypid, a.atttypmod)
|
||||
END
|
||||
END::text AS data_type,
|
||||
format_type(a.atttypid, a.atttypmod)::text AS nominal_data_type,
|
||||
information_schema._pg_char_max_length(
|
||||
information_schema._pg_truetypid(a.*, t.*),
|
||||
information_schema._pg_truetypmod(a.*, t.*)
|
||||
@@ -486,6 +613,12 @@ tablesSqlQuery getAll pgVer =
|
||||
ON t.typtype = 'd' AND t.typbasetype = bt.oid
|
||||
LEFT JOIN (pg_collation co JOIN pg_namespace nco ON co.collnamespace = nco.oid)
|
||||
ON a.attcollation = co.oid AND (nco.nspname <> 'pg_catalog'::name OR co.collname <> 'default'::name)
|
||||
LEFT JOIN pg_depend dep
|
||||
ON dep.refobjid = a.attrelid and dep.refobjsubid = a.attnum and dep.deptype = 'i'
|
||||
LEFT JOIN pg_class seqclass
|
||||
ON seqclass.oid = dep.objid
|
||||
LEFT JOIN pg_namespace seqsch
|
||||
ON seqsch.oid = seqclass.relnamespace
|
||||
WHERE
|
||||
NOT pg_is_other_temp_schema(nc.oid)
|
||||
AND a.attnum > 0
|
||||
@@ -502,6 +635,7 @@ tablesSqlQuery getAll pgVer =
|
||||
info.description,
|
||||
info.is_nullable::boolean,
|
||||
info.data_type,
|
||||
info.nominal_data_type,
|
||||
info.character_maximum_length,
|
||||
info.column_default,
|
||||
coalesce(enum_info.vals, '{}')) order by info.position) as columns
|
||||
@@ -630,18 +764,28 @@ tablesSqlQuery getAll pgVer =
|
||||
WHERE c.relkind IN ('v','r','m','f','p')
|
||||
AND n.nspname NOT IN ('pg_catalog', 'information_schema') |] <>
|
||||
relIsPartition <>
|
||||
fltTables <>
|
||||
"ORDER BY table_schema, table_name"
|
||||
where
|
||||
fltTables = if getAll then mempty else [q|
|
||||
AND n.nspname = ANY($1)
|
||||
AND (
|
||||
pg_has_role(c.relowner, 'USAGE')
|
||||
or has_table_privilege(c.oid, 'SELECT, INSERT, UPDATE, DELETE, TRUNCATE, REFERENCES, TRIGGER')
|
||||
or has_any_column_privilege(c.oid, 'SELECT, INSERT, UPDATE, REFERENCES')
|
||||
)|]
|
||||
relIsPartition = if pgVer >= pgVersion100 then " AND not c.relispartition " else mempty
|
||||
|
||||
columnDefault -- typbasetype and typdefaultbin handles `CREATE DOMAIN .. DEFAULT val`, attidentity/attgenerated handles generated columns, pg_get_expr gets the default of a column
|
||||
| pgVer >= pgVersion120 = [q|
|
||||
CASE
|
||||
WHEN t.typbasetype != 0 THEN pg_get_expr(t.typdefaultbin, 0)
|
||||
WHEN a.attidentity = 'd' THEN format('nextval(%s)', quote_literal(seqsch.nspname || '.' || seqclass.relname))
|
||||
WHEN a.attgenerated = 's' THEN null
|
||||
ELSE pg_get_expr(ad.adbin, ad.adrelid)::text
|
||||
END|]
|
||||
| pgVer >= pgVersion100 = [q|
|
||||
CASE
|
||||
WHEN t.typbasetype != 0 THEN pg_get_expr(t.typdefaultbin, 0)
|
||||
WHEN a.attidentity = 'd' THEN format('nextval(%s)', quote_literal(seqsch.nspname || '.' || seqclass.relname))
|
||||
ELSE pg_get_expr(ad.adbin, ad.adrelid)::text
|
||||
END|]
|
||||
| otherwise = [q|
|
||||
CASE
|
||||
WHEN t.typbasetype != 0 THEN pg_get_expr(t.typdefaultbin, 0)
|
||||
ELSE pg_get_expr(ad.adbin, ad.adrelid)::text
|
||||
END|]
|
||||
|
||||
-- | Gets many-to-one relationships and one-to-one(O2O) relationships, which are a refinement of the many-to-one's
|
||||
allM2OandO2ORels :: PgVersion -> Bool -> SQL.Statement () [Relationship]
|
||||
@@ -679,9 +823,9 @@ allM2OandO2ORels pgVer =
|
||||
FROM pg_constraint traint
|
||||
JOIN LATERAL (
|
||||
SELECT
|
||||
array_agg(row(cols.attname, refs.attname) order by cols.attnum) AS cols_and_fcols,
|
||||
jsonb_agg(cols.attname order by cols.attnum) AS cols
|
||||
FROM ( SELECT unnest(traint.conkey) AS col, unnest(traint.confkey) AS ref) _
|
||||
array_agg(row(cols.attname, refs.attname) order by ord) AS cols_and_fcols,
|
||||
jsonb_agg(cols.attname order by ord) AS cols
|
||||
FROM unnest(traint.conkey, traint.confkey) WITH ORDINALITY AS _(col, ref, ord)
|
||||
JOIN pg_attribute cols ON cols.attrelid = traint.conrelid AND cols.attnum = col
|
||||
JOIN pg_attribute refs ON refs.attrelid = traint.confrelid AND refs.attnum = ref
|
||||
) AS column_info ON TRUE
|
||||
@@ -710,13 +854,13 @@ allComputedRels =
|
||||
),
|
||||
computed_rels as (
|
||||
select
|
||||
p.pronamespace::regnamespace::text as schema,
|
||||
p.proname::text as name,
|
||||
arg_schema.nspname::text as rel_table_schema,
|
||||
arg_name.typname::text as rel_table_name,
|
||||
ret_schema.nspname::text as rel_ftable_schema,
|
||||
ret_name.typname::text as rel_ftable_name,
|
||||
p.prorows = 1 as single_row
|
||||
(parse_ident(p.pronamespace::regnamespace::text))[1] as schema,
|
||||
p.proname::text as name,
|
||||
arg_schema.nspname::text as rel_table_schema,
|
||||
arg_name.typname::text as rel_table_name,
|
||||
ret_schema.nspname::text as rel_ftable_schema,
|
||||
ret_name.typname::text as rel_ftable_name,
|
||||
not p.proretset or p.prorows = 1 as single_row
|
||||
from pg_proc p
|
||||
join pg_type arg_name on arg_name.oid = p.proargtypes[0]
|
||||
join pg_namespace arg_schema on arg_schema.oid = arg_name.typnamespace
|
||||
@@ -738,6 +882,7 @@ allComputedRels =
|
||||
(QualifiedIdentifier <$> column HD.text <*> column HD.text) <*>
|
||||
(QualifiedIdentifier <$> column HD.text <*> column HD.text) <*>
|
||||
(QualifiedIdentifier <$> column HD.text <*> column HD.text) <*>
|
||||
pure (QualifiedIdentifier mempty mempty) <*>
|
||||
column HD.bool <*>
|
||||
column HD.bool
|
||||
|
||||
@@ -756,18 +901,24 @@ allViewsKeyDependencies =
|
||||
select
|
||||
contype::text as contype,
|
||||
conname,
|
||||
array_length(conkey, 1) as ncol,
|
||||
conrelid as resorigtbl,
|
||||
unnest(conkey) as resorigcol
|
||||
col as resorigcol,
|
||||
ord
|
||||
from pg_constraint
|
||||
left join lateral unnest(conkey) with ordinality as _(col, ord) on true
|
||||
where contype IN ('p', 'f')
|
||||
union
|
||||
-- fk referenced col
|
||||
select
|
||||
concat(contype, '_ref') as contype,
|
||||
conname,
|
||||
array_length(confkey, 1) as ncol,
|
||||
confrelid,
|
||||
unnest(confkey)
|
||||
col,
|
||||
ord
|
||||
from pg_constraint
|
||||
left join lateral unnest(confkey) with ordinality as _(col, ord) on true
|
||||
where contype='f'
|
||||
),
|
||||
views as (
|
||||
@@ -875,8 +1026,13 @@ allViewsKeyDependencies =
|
||||
(entry->>'resorigcol')::int as resorigcol
|
||||
from target_entries
|
||||
),
|
||||
recursion as(
|
||||
select r.*
|
||||
-- CYCLE detection according to PG docs: https://www.postgresql.org/docs/current/queries-with.html#QUERIES-WITH-CYCLE
|
||||
-- Can be replaced with CYCLE clause once PG v13 is EOL.
|
||||
recursion(view_id, view_schema, view_name, view_column, resorigtbl, resorigcol, is_cycle, path) as(
|
||||
select
|
||||
r.*,
|
||||
false,
|
||||
ARRAY[resorigtbl]
|
||||
from results r
|
||||
where view_schema = ANY ($1)
|
||||
union all
|
||||
@@ -886,25 +1042,46 @@ allViewsKeyDependencies =
|
||||
view.view_name,
|
||||
view.view_column,
|
||||
tab.resorigtbl,
|
||||
tab.resorigcol
|
||||
tab.resorigcol,
|
||||
tab.resorigtbl = ANY(path),
|
||||
path || tab.resorigtbl
|
||||
from recursion view
|
||||
join results tab on view.resorigtbl=tab.view_id and view.resorigcol=tab.view_column
|
||||
where not is_cycle
|
||||
),
|
||||
repeated_references as(
|
||||
select
|
||||
view_id,
|
||||
view_schema,
|
||||
view_name,
|
||||
resorigtbl,
|
||||
resorigcol,
|
||||
array_agg(attname) as view_columns
|
||||
from recursion
|
||||
join pg_attribute vcol on vcol.attrelid = view_id and vcol.attnum = view_column
|
||||
group by
|
||||
view_id,
|
||||
view_schema,
|
||||
view_name,
|
||||
resorigtbl,
|
||||
resorigcol
|
||||
)
|
||||
select
|
||||
sch.nspname as table_schema,
|
||||
tbl.relname as table_name,
|
||||
rec.view_schema,
|
||||
rec.view_name,
|
||||
rep.view_schema,
|
||||
rep.view_name,
|
||||
pks_fks.conname as constraint_name,
|
||||
pks_fks.contype as constraint_type,
|
||||
array_agg(row(col.attname, vcol.attname) order by col.attnum) as column_dependencies
|
||||
from recursion rec
|
||||
join pg_class tbl on tbl.oid = rec.resorigtbl
|
||||
join pg_attribute col on col.attrelid = tbl.oid and col.attnum = rec.resorigcol
|
||||
join pg_attribute vcol on vcol.attrelid = rec.view_id and vcol.attnum = rec.view_column
|
||||
join pg_namespace sch on sch.oid = tbl.relnamespace
|
||||
array_agg(row(col.attname, view_columns) order by pks_fks.ord) as column_dependencies
|
||||
from repeated_references rep
|
||||
join pks_fks using (resorigtbl, resorigcol)
|
||||
group by sch.nspname, tbl.relname, rec.view_schema, rec.view_name, pks_fks.conname, pks_fks.contype
|
||||
join pg_class tbl on tbl.oid = rep.resorigtbl
|
||||
join pg_attribute col on col.attrelid = tbl.oid and col.attnum = rep.resorigcol
|
||||
join pg_namespace sch on sch.oid = tbl.relnamespace
|
||||
group by sch.nspname, tbl.relname, rep.view_schema, rep.view_name, pks_fks.conname, pks_fks.contype, pks_fks.ncol
|
||||
-- make sure we only return key for which all columns are referenced in the view - no partial PKs or FKs
|
||||
having ncol = array_length(array_agg(row(col.attname, view_columns) order by pks_fks.ord), 1)
|
||||
|]
|
||||
|
||||
param :: HE.Value a -> HE.Params a
|
||||
@@ -1,16 +1,18 @@
|
||||
{-# LANGUAGE DeriveAnyClass #-}
|
||||
{-# LANGUAGE DeriveGeneric #-}
|
||||
|
||||
module PostgREST.DbStructure.Identifiers
|
||||
module PostgREST.SchemaCache.Identifiers
|
||||
( QualifiedIdentifier(..)
|
||||
, Schema
|
||||
, TableName
|
||||
, FieldName
|
||||
, AccessSet
|
||||
, dumpQi
|
||||
, toQi
|
||||
) where
|
||||
|
||||
import qualified Data.Aeson as JSON
|
||||
import qualified Data.Set as S
|
||||
import qualified Data.Text as T
|
||||
|
||||
import Protolude
|
||||
@@ -22,7 +24,7 @@ data QualifiedIdentifier = QualifiedIdentifier
|
||||
{ qiSchema :: Schema
|
||||
, qiName :: TableName
|
||||
}
|
||||
deriving (Eq, Ord, Generic, JSON.ToJSON, JSON.ToJSONKey)
|
||||
deriving (Eq, Show, Ord, Generic, JSON.ToJSON, JSON.ToJSONKey)
|
||||
|
||||
instance Hashable QualifiedIdentifier
|
||||
|
||||
@@ -40,3 +42,5 @@ toQi txt = case T.drop 1 <$> T.breakOn "." txt of
|
||||
type Schema = Text
|
||||
type TableName = Text
|
||||
type FieldName = Text
|
||||
|
||||
type AccessSet = S.Set QualifiedIdentifier
|
||||
+16
-7
@@ -1,17 +1,18 @@
|
||||
{-# LANGUAGE DeriveAnyClass #-}
|
||||
{-# LANGUAGE DeriveGeneric #-}
|
||||
|
||||
module PostgREST.DbStructure.Relationship
|
||||
module PostgREST.SchemaCache.Relationship
|
||||
( Cardinality(..)
|
||||
, Relationship(..)
|
||||
, Junction(..)
|
||||
, RelationshipsMap
|
||||
, relIsToOne
|
||||
) where
|
||||
|
||||
import qualified Data.Aeson as JSON
|
||||
import qualified Data.HashMap.Strict as HM
|
||||
|
||||
import PostgREST.DbStructure.Identifiers (FieldName,
|
||||
import PostgREST.SchemaCache.Identifiers (FieldName,
|
||||
QualifiedIdentifier, Schema)
|
||||
|
||||
import Protolude
|
||||
@@ -30,10 +31,11 @@ data Relationship = Relationship
|
||||
{ relFunction :: QualifiedIdentifier
|
||||
, relTable :: QualifiedIdentifier
|
||||
, relForeignTable :: QualifiedIdentifier
|
||||
, relTableAlias :: QualifiedIdentifier
|
||||
, relToOne :: Bool
|
||||
, relIsSelf :: Bool
|
||||
}
|
||||
deriving (Eq, Ord, Generic, JSON.ToJSON)
|
||||
deriving (Eq, Show, Ord, Generic, JSON.ToJSON)
|
||||
|
||||
-- | The relationship cardinality
|
||||
-- | https://en.wikipedia.org/wiki/Cardinality_(data_modeling)
|
||||
@@ -46,7 +48,7 @@ data Cardinality
|
||||
-- ^ 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)
|
||||
deriving (Eq, Show, Ord, Generic, JSON.ToJSON)
|
||||
|
||||
type FKConstraint = Text
|
||||
|
||||
@@ -55,10 +57,17 @@ data Junction = Junction
|
||||
{ junTable :: QualifiedIdentifier
|
||||
, junConstraint1 :: FKConstraint
|
||||
, junConstraint2 :: FKConstraint
|
||||
, junColumns1 :: [(FieldName, FieldName)]
|
||||
, junColumns2 :: [(FieldName, FieldName)]
|
||||
, junColsSource :: [(FieldName, FieldName)]
|
||||
, junColsTarget :: [(FieldName, FieldName)]
|
||||
}
|
||||
deriving (Eq, Ord, Generic, JSON.ToJSON)
|
||||
deriving (Eq, Show, Ord, Generic, JSON.ToJSON)
|
||||
|
||||
-- | Key based on the source table and the foreign table schema
|
||||
type RelationshipsMap = HM.HashMap (QualifiedIdentifier, Schema) [Relationship]
|
||||
|
||||
relIsToOne :: Relationship -> Bool
|
||||
relIsToOne rel = case rel of
|
||||
Relationship{relCardinality=M2O _ _} -> True
|
||||
Relationship{relCardinality=O2O _ _} -> True
|
||||
ComputedRelationship{relToOne=True} -> True
|
||||
_ -> False
|
||||
@@ -0,0 +1,29 @@
|
||||
{-# LANGUAGE DeriveAnyClass #-}
|
||||
{-# LANGUAGE DeriveGeneric #-}
|
||||
|
||||
module PostgREST.SchemaCache.Representations
|
||||
( DataRepresentation(..)
|
||||
, RepresentationsMap
|
||||
) where
|
||||
|
||||
import qualified Data.Aeson as JSON
|
||||
import qualified Data.HashMap.Strict as HM
|
||||
|
||||
|
||||
import Protolude
|
||||
|
||||
-- | Data representations allow user customisation of how to present and receive data through APIs, per field.
|
||||
-- This structure is used for the library of available transforms. It answers questions like:
|
||||
-- - What function, if any, should be used to present a certain field that's been selected for API output?
|
||||
-- - How do we parse incoming data for a certain field type when inserting or updating?
|
||||
-- - And similarly, how do we parse textual data in a query string to be used as a filter?
|
||||
--
|
||||
-- Support for outputting special formats like CSV and binary data would fit into the same system.
|
||||
data DataRepresentation = DataRepresentation
|
||||
{ drSourceType :: Text
|
||||
, drTargetType :: Text
|
||||
, drFunction :: Text
|
||||
} deriving (Eq, Show, Generic, JSON.ToJSON, JSON.FromJSON)
|
||||
|
||||
-- The representation map maps from (source type, target type) to a DR.
|
||||
type RepresentationsMap = HM.HashMap (Text, Text) DataRepresentation
|
||||
@@ -0,0 +1,132 @@
|
||||
{-# LANGUAGE DeriveAnyClass #-}
|
||||
{-# LANGUAGE DeriveGeneric #-}
|
||||
|
||||
module PostgREST.SchemaCache.Routine
|
||||
( PgType(..)
|
||||
, Routine(..)
|
||||
, RoutineParam(..)
|
||||
, FuncVolatility(..)
|
||||
, RoutineMap
|
||||
, RetType(..)
|
||||
, funcReturnsScalar
|
||||
, funcReturnsSetOfScalar
|
||||
, funcReturnsSingleComposite
|
||||
, funcReturnsVoid
|
||||
, funcTableName
|
||||
, funcReturnsCompositeAlias
|
||||
, ResultAggregate(..)
|
||||
) where
|
||||
|
||||
import Data.Aeson ((.=))
|
||||
import qualified Data.Aeson as JSON
|
||||
import qualified Data.HashMap.Strict as HM
|
||||
import qualified Hasql.Transaction.Sessions as SQL
|
||||
|
||||
import PostgREST.SchemaCache.Identifiers (FieldName,
|
||||
QualifiedIdentifier (..),
|
||||
Schema, TableName)
|
||||
|
||||
import Protolude
|
||||
|
||||
data PgType
|
||||
= Scalar QualifiedIdentifier
|
||||
| Composite QualifiedIdentifier Bool -- True if the composite is a domain alias(used to work around a bug in pg 11 and 12, see QueryBuilder.hs)
|
||||
deriving (Eq, Show, Ord, Generic, JSON.ToJSON)
|
||||
|
||||
data RetType
|
||||
= Single PgType
|
||||
| SetOf PgType
|
||||
deriving (Eq, Show, Ord, Generic, JSON.ToJSON)
|
||||
|
||||
data FuncVolatility
|
||||
= Volatile
|
||||
| Stable
|
||||
| Immutable
|
||||
deriving (Eq, Show, Ord, Generic, JSON.ToJSON)
|
||||
|
||||
data Routine = Function
|
||||
{ pdSchema :: Schema
|
||||
, pdName :: Text
|
||||
, pdDescription :: Maybe Text
|
||||
, pdParams :: [RoutineParam]
|
||||
, pdReturnType :: RetType
|
||||
, pdVolatility :: FuncVolatility
|
||||
, pdHasVariadic :: Bool
|
||||
, pdIsoLvl :: Maybe SQL.IsolationLevel
|
||||
}
|
||||
deriving (Eq, Show, Generic)
|
||||
-- need to define JSON manually bc SQL.IsolationLevel doesn't have a JSON instance(and we can't define one for that type without getting a compiler error)
|
||||
instance JSON.ToJSON Routine where
|
||||
toJSON (Function sch nam desc params ret vol hasVar _) = JSON.object
|
||||
[
|
||||
"pdSchema" .= sch
|
||||
, "pdName" .= nam
|
||||
, "pdDescription" .= desc
|
||||
, "pdParams" .= JSON.toJSON params
|
||||
, "pdReturnType" .= JSON.toJSON ret
|
||||
, "pdVolatility" .= JSON.toJSON vol
|
||||
, "pdHasVariadic" .= JSON.toJSON hasVar
|
||||
]
|
||||
|
||||
data RoutineParam = RoutineParam
|
||||
{ ppName :: Text
|
||||
, ppType :: Text
|
||||
, ppTypeMaxLength :: Text
|
||||
, ppReq :: Bool
|
||||
, ppVar :: Bool
|
||||
}
|
||||
deriving (Eq, Show, Ord, Generic, JSON.ToJSON)
|
||||
|
||||
-- Order by least number of params in the case of overloaded functions
|
||||
instance Ord Routine where
|
||||
Function schema1 name1 des1 prms1 rt1 vol1 hasVar1 iso1 `compare` Function schema2 name2 des2 prms2 rt2 vol2 hasVar2 iso2
|
||||
| schema1 == schema2 && name1 == name2 && length prms1 < length prms2 = LT
|
||||
| schema2 == schema2 && name1 == name2 && length prms1 > length prms2 = GT
|
||||
| otherwise = (schema1, name1, des1, prms1, rt1, vol1, hasVar1, iso1) `compare` (schema2, name2, des2, prms2, rt2, vol2, hasVar2, iso2)
|
||||
|
||||
-- | A map of all procs, all of which can be overloaded(one entry will have more than one Routine).
|
||||
-- | It uses a HashMap for a faster lookup.
|
||||
type RoutineMap = HM.HashMap QualifiedIdentifier [Routine]
|
||||
|
||||
data ResultAggregate
|
||||
= BuiltinAggJson
|
||||
| BuiltinAggSingleJson Bool
|
||||
| BuiltinAggArrayJsonStrip
|
||||
| BuiltinAggGeoJson
|
||||
| BuiltinAggCsv
|
||||
| BuiltinAggXml (Maybe FieldName)
|
||||
| BuiltinAggBinary (Maybe FieldName)
|
||||
| NoAgg
|
||||
deriving (Eq, Show)
|
||||
|
||||
funcReturnsScalar :: Routine -> Bool
|
||||
funcReturnsScalar proc = case proc of
|
||||
Function{pdReturnType = Single (Scalar{})} -> True
|
||||
_ -> False
|
||||
|
||||
funcReturnsSetOfScalar :: Routine -> Bool
|
||||
funcReturnsSetOfScalar proc = case proc of
|
||||
Function{pdReturnType = SetOf (Scalar{})} -> True
|
||||
_ -> False
|
||||
|
||||
funcReturnsCompositeAlias :: Routine -> Bool
|
||||
funcReturnsCompositeAlias proc = case proc of
|
||||
Function{pdReturnType = Single (Composite _ True)} -> True
|
||||
Function{pdReturnType = SetOf (Composite _ True)} -> True
|
||||
_ -> False
|
||||
|
||||
funcReturnsSingleComposite :: Routine -> Bool
|
||||
funcReturnsSingleComposite proc = case proc of
|
||||
Function{pdReturnType = Single (Composite _ _)} -> True
|
||||
_ -> False
|
||||
|
||||
funcReturnsVoid :: Routine -> Bool
|
||||
funcReturnsVoid proc = case proc of
|
||||
Function{pdReturnType = Single (Scalar (QualifiedIdentifier "pg_catalog" "void"))} -> True
|
||||
_ -> False
|
||||
|
||||
funcTableName :: Routine -> Maybe TableName
|
||||
funcTableName proc = case pdReturnType proc of
|
||||
SetOf (Composite qi _) -> Just $ qiName qi
|
||||
Single (Composite qi _) -> Just $ qiName qi
|
||||
_ -> Nothing
|
||||
@@ -1,16 +1,20 @@
|
||||
{-# LANGUAGE DeriveAnyClass #-}
|
||||
{-# LANGUAGE DeriveGeneric #-}
|
||||
{-# LANGUAGE DeriveAnyClass #-}
|
||||
{-# LANGUAGE DeriveGeneric #-}
|
||||
{-# LANGUAGE FlexibleInstances #-}
|
||||
|
||||
module PostgREST.DbStructure.Table
|
||||
module PostgREST.SchemaCache.Table
|
||||
( Column(..)
|
||||
, Table(..)
|
||||
, tableColumnsList
|
||||
, TablesMap
|
||||
, ColumnMap
|
||||
) where
|
||||
|
||||
import qualified Data.Aeson as JSON
|
||||
import qualified Data.HashMap.Strict as HM
|
||||
import qualified Data.Aeson as JSON
|
||||
import qualified Data.HashMap.Strict as HM
|
||||
import qualified Data.HashMap.Strict.InsOrd as HMI
|
||||
|
||||
import PostgREST.DbStructure.Identifiers (FieldName,
|
||||
import PostgREST.SchemaCache.Identifiers (FieldName,
|
||||
QualifiedIdentifier (..),
|
||||
Schema, TableName)
|
||||
|
||||
@@ -28,9 +32,12 @@ data Table = Table
|
||||
, tableUpdatable :: Bool
|
||||
, tableDeletable :: Bool
|
||||
, tablePKCols :: [FieldName]
|
||||
, tableColumns :: [Column]
|
||||
, tableColumns :: ColumnMap
|
||||
}
|
||||
deriving (Show, Ord, Generic, JSON.ToJSON)
|
||||
deriving (Show, Generic, JSON.ToJSON)
|
||||
|
||||
tableColumnsList :: Table -> [Column]
|
||||
tableColumnsList = HMI.elems . tableColumns
|
||||
|
||||
instance Eq Table where
|
||||
Table{tableSchema=s1,tableName=n1} == Table{tableSchema=s2,tableName=n2} = s1 == s2 && n1 == n2
|
||||
@@ -40,6 +47,7 @@ data Column = Column
|
||||
, colDescription :: Maybe Text
|
||||
, colNullable :: Bool
|
||||
, colType :: Text
|
||||
, colNominalType :: Text
|
||||
, colMaxLen :: Maybe Int32
|
||||
, colDefault :: Maybe Text
|
||||
, colEnum :: [Text]
|
||||
@@ -47,3 +55,4 @@ data Column = Column
|
||||
deriving (Eq, Show, Ord, Generic, JSON.ToJSON)
|
||||
|
||||
type TablesMap = HM.HashMap QualifiedIdentifier Table
|
||||
type ColumnMap = HMI.InsOrdHashMap FieldName Column
|
||||
@@ -14,7 +14,6 @@ import System.Posix.Files (setFileMode)
|
||||
import System.Posix.Types (FileMode)
|
||||
|
||||
import qualified PostgREST.AppState as AppState
|
||||
import qualified PostgREST.Workers as Workers
|
||||
|
||||
import Protolude
|
||||
|
||||
@@ -47,12 +46,12 @@ installSignalHandlers appState = do
|
||||
install Signals.sigINT interrupt
|
||||
install Signals.sigTERM interrupt
|
||||
|
||||
-- The SIGUSR1 signal updates the internal 'DbStructure' by running
|
||||
-- The SIGUSR1 signal updates the internal 'SchemaCache' by running
|
||||
-- 'connectionWorker' exactly as before.
|
||||
install Signals.sigUSR1 $ Workers.connectionWorker appState
|
||||
install Signals.sigUSR1 $ AppState.connectionWorker appState
|
||||
|
||||
-- Re-read the config on SIGUSR2
|
||||
install Signals.sigUSR2 $ Workers.reReadConfig False appState
|
||||
install Signals.sigUSR2 $ AppState.reReadConfig False appState
|
||||
where
|
||||
install signal handler =
|
||||
void $ Signals.installHandler signal (Signals.Catch handler) Nothing
|
||||
|
||||
@@ -1,265 +0,0 @@
|
||||
{-# LANGUAGE LambdaCase #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
|
||||
module PostgREST.Workers
|
||||
( connectionWorker
|
||||
, reReadConfig
|
||||
, listener
|
||||
) where
|
||||
|
||||
import qualified Data.Aeson as JSON
|
||||
import qualified Data.ByteString as BS
|
||||
import qualified Data.ByteString.Lazy as LBS
|
||||
import qualified Data.Text.Encoding as T
|
||||
import qualified Hasql.Notifications as SQL
|
||||
import qualified Hasql.Transaction.Sessions as SQL
|
||||
|
||||
import Control.Retry (RetryStatus, capDelay, exponentialBackoff,
|
||||
retrying, rsPreviousDelay)
|
||||
import Hasql.Connection (acquire)
|
||||
|
||||
import PostgREST.AppState (AppState)
|
||||
import PostgREST.Config (AppConfig (..), readAppConfig)
|
||||
import PostgREST.Config.Database (queryDbSettings, queryPgVersion)
|
||||
import PostgREST.Config.PgVersion (PgVersion (..), minimumPgVersion)
|
||||
import PostgREST.DbStructure (queryDbStructure)
|
||||
import PostgREST.Error (PgError (PgError), checkIsFatal,
|
||||
errorPayload)
|
||||
|
||||
import qualified PostgREST.AppState as AppState
|
||||
|
||||
import Protolude
|
||||
|
||||
|
||||
-- | Current database connection status data ConnectionStatus
|
||||
data ConnectionStatus
|
||||
= NotConnected
|
||||
| Connected PgVersion
|
||||
| FatalConnectionError Text
|
||||
deriving (Eq)
|
||||
|
||||
-- | Schema cache status
|
||||
data SCacheStatus
|
||||
= SCLoaded
|
||||
| SCOnRetry
|
||||
| SCFatalFail
|
||||
|
||||
-- | The purpose of this worker is to obtain a healthy connection to pg and an
|
||||
-- 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
|
||||
-- invocation has not terminated. In all cases this method does not halt the
|
||||
-- calling thread, the work is performed in a separate thread.
|
||||
--
|
||||
-- Background thread that does the following :
|
||||
-- 1. Tries to connect to pg server and will keep trying until success.
|
||||
-- 2. Checks if the pg version is supported and if it's not it kills the main
|
||||
-- program.
|
||||
-- 3. Obtains the dbStructure. If this fails, it goes back to 1.
|
||||
connectionWorker :: AppState -> IO ()
|
||||
connectionWorker appState = do
|
||||
runExclusively (AppState.getWorkerSem appState) work
|
||||
-- Prevents multiple workers to be running at the same time. Could happen on
|
||||
-- too many SIGUSR1s.
|
||||
where
|
||||
runExclusively mvar action = mask_ $ do
|
||||
success <- tryPutMVar mvar ()
|
||||
when success $ do
|
||||
void $ forkIO $ action `finally` takeMVar mvar
|
||||
work = do
|
||||
AppConfig{..} <- AppState.getConfig appState
|
||||
AppState.logWithZTime appState "Attempting to connect to the database..."
|
||||
connected <- connectionStatus appState
|
||||
case connected of
|
||||
FatalConnectionError reason ->
|
||||
-- Fatal error when connecting
|
||||
AppState.logWithZTime appState reason >> killThread (AppState.getMainThreadId appState)
|
||||
NotConnected ->
|
||||
-- Unreachable because connectionStatus will keep trying to connect
|
||||
return ()
|
||||
Connected actualPgVersion -> do
|
||||
-- Procede with initialization
|
||||
AppState.putPgVersion appState actualPgVersion
|
||||
when configDbChannelEnabled $
|
||||
AppState.signalListener appState
|
||||
AppState.logWithZTime appState "Connection successful"
|
||||
-- this could be fail because the connection drops, but the
|
||||
-- loadSchemaCache will pick the error and retry again
|
||||
when configDbConfig $ reReadConfig False appState
|
||||
scStatus <- loadSchemaCache appState
|
||||
case scStatus of
|
||||
SCLoaded ->
|
||||
-- do nothing and proceed if the load was successful
|
||||
return ()
|
||||
SCOnRetry ->
|
||||
-- retry reloading the schema cache
|
||||
work
|
||||
SCFatalFail ->
|
||||
-- die if our schema cache query has an error
|
||||
killThread $ AppState.getMainThreadId appState
|
||||
|
||||
-- | 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
|
||||
-- tried. Releasing the pool is key for rapid recovery. Otherwise, the pool
|
||||
-- timeout would have to be reached for new healthy connections to be acquired.
|
||||
-- Which might not happen if the server is busy with requests. No idle
|
||||
-- connection, no pool timeout.
|
||||
--
|
||||
-- The connection tries are capped, but if the connection times out no error is
|
||||
-- thrown, just 'False' is returned.
|
||||
connectionStatus :: AppState -> IO ConnectionStatus
|
||||
connectionStatus appState =
|
||||
retrying retrySettings shouldRetry $
|
||||
const $ AppState.releasePool appState >> getConnectionStatus
|
||||
where
|
||||
retrySettings = capDelay delayMicroseconds $ exponentialBackoff backoffMicroseconds
|
||||
delayMicroseconds = 32000000 -- 32 seconds
|
||||
backoffMicroseconds = 1000000 -- 1 second
|
||||
|
||||
getConnectionStatus :: IO ConnectionStatus
|
||||
getConnectionStatus = do
|
||||
pgVersion <- AppState.usePool appState queryPgVersion
|
||||
case pgVersion of
|
||||
Left e -> do
|
||||
let err = PgError False e
|
||||
AppState.logWithZTime appState . T.decodeUtf8 . LBS.toStrict $ errorPayload err
|
||||
case checkIsFatal err of
|
||||
Just reason ->
|
||||
return $ FatalConnectionError reason
|
||||
Nothing ->
|
||||
return NotConnected
|
||||
Right version ->
|
||||
if version < minimumPgVersion then
|
||||
return . FatalConnectionError $
|
||||
"Cannot run in this PostgreSQL version, PostgREST needs at least "
|
||||
<> pgvName minimumPgVersion
|
||||
else
|
||||
return . Connected $ version
|
||||
|
||||
shouldRetry :: RetryStatus -> ConnectionStatus -> IO Bool
|
||||
shouldRetry rs isConnSucc = do
|
||||
let
|
||||
delay = fromMaybe 0 (rsPreviousDelay rs) `div` backoffMicroseconds
|
||||
itShould = NotConnected == isConnSucc
|
||||
when itShould . AppState.logWithZTime appState $
|
||||
"Attempting to reconnect to the database in "
|
||||
<> (show delay::Text)
|
||||
<> " seconds..."
|
||||
when itShould $ AppState.putRetryNextIn appState delay
|
||||
return itShould
|
||||
|
||||
-- | Load the DbStructure by using a connection from the pool.
|
||||
loadSchemaCache :: AppState -> IO SCacheStatus
|
||||
loadSchemaCache appState = do
|
||||
AppConfig{..} <- AppState.getConfig appState
|
||||
result <-
|
||||
let transaction = if configDbPreparedStatements then SQL.transaction else SQL.unpreparedTransaction in
|
||||
AppState.usePool appState . transaction SQL.ReadCommitted SQL.Read $
|
||||
queryDbStructure (toList configDbSchemas) configDbExtraSearchPath configDbPreparedStatements
|
||||
case result of
|
||||
Left e -> do
|
||||
let
|
||||
err = PgError False e
|
||||
putErr = AppState.logWithZTime appState . T.decodeUtf8 . LBS.toStrict $ errorPayload err
|
||||
case checkIsFatal err of
|
||||
Just hint -> do
|
||||
AppState.logWithZTime appState "A fatal error ocurred when loading the schema cache"
|
||||
putErr
|
||||
AppState.logWithZTime appState hint
|
||||
return SCFatalFail
|
||||
Nothing -> do
|
||||
AppState.putDbStructure appState Nothing
|
||||
AppState.logWithZTime appState "An error ocurred when loading the schema cache"
|
||||
putErr
|
||||
return SCOnRetry
|
||||
|
||||
Right dbStructure -> do
|
||||
AppState.putDbStructure appState (Just dbStructure)
|
||||
when (isJust configDbRootSpec) .
|
||||
AppState.putJsonDbS appState . LBS.toStrict $ JSON.encode dbStructure
|
||||
AppState.logWithZTime appState "Schema cache loaded"
|
||||
return SCLoaded
|
||||
|
||||
-- | Starts a dedicated pg connection to LISTEN for notifications. When a
|
||||
-- NOTIFY <db-channel> - with an empty payload - is done, it refills the schema
|
||||
-- cache. It uses the connectionWorker in case the LISTEN connection dies.
|
||||
listener :: AppState -> IO ()
|
||||
listener appState = do
|
||||
AppConfig{..} <- AppState.getConfig appState
|
||||
let dbChannel = toS configDbChannel
|
||||
|
||||
-- The listener has to wait for a signal from the connectionWorker.
|
||||
-- This is because when the connection to the db is lost, the listener also
|
||||
-- tries to recover the connection, but not with the same pace as the connectionWorker.
|
||||
-- Not waiting makes stderr quickly fill with connection retries messages from the listener.
|
||||
AppState.waitListener appState
|
||||
|
||||
-- forkFinally allows to detect if the thread dies
|
||||
void . flip forkFinally (handleFinally dbChannel) $ do
|
||||
dbOrError <- acquire $ toUtf8 configDbUri
|
||||
case dbOrError of
|
||||
Right db -> do
|
||||
AppState.logWithZTime appState $ "Listening for notifications on the " <> dbChannel <> " channel"
|
||||
AppState.putIsListenerOn appState True
|
||||
SQL.listen db $ SQL.toPgIdentifier dbChannel
|
||||
SQL.waitForNotifications handleNotification db
|
||||
_ ->
|
||||
die $ "Could not listen for notifications on the " <> dbChannel <> " channel"
|
||||
where
|
||||
handleFinally dbChannel _ = do
|
||||
-- if the thread dies, we try to recover
|
||||
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
|
||||
connectionWorker appState
|
||||
-- retry the listener
|
||||
listener appState
|
||||
|
||||
handleNotification _ msg
|
||||
| BS.null msg = scLoader -- reload the schema cache
|
||||
| msg == "reload schema" = scLoader -- reload the schema cache
|
||||
| msg == "reload config" = reReadConfig False appState -- reload the config
|
||||
| otherwise = pure () -- Do nothing if anything else than an empty message is sent
|
||||
|
||||
scLoader =
|
||||
-- It's not necessary to check the loadSchemaCache success
|
||||
-- here. If the connection drops, the thread will die and
|
||||
-- proceed to recover.
|
||||
void $ loadSchemaCache appState
|
||||
|
||||
-- | Re-reads the config plus config options from the db
|
||||
reReadConfig :: Bool -> AppState -> IO ()
|
||||
reReadConfig startingUp appState = do
|
||||
AppConfig{..} <- AppState.getConfig appState
|
||||
dbSettings <-
|
||||
if configDbConfig then do
|
||||
qDbSettings <- AppState.usePool appState $ queryDbSettings configDbPreparedStatements
|
||||
case qDbSettings of
|
||||
Left e -> do
|
||||
let
|
||||
err = PgError False e
|
||||
putErr = AppState.logWithZTime appState . T.decodeUtf8 . LBS.toStrict $ errorPayload err
|
||||
AppState.logWithZTime appState
|
||||
"An error ocurred when trying to query database settings for the config parameters"
|
||||
case checkIsFatal err of
|
||||
Just hint -> do
|
||||
putErr
|
||||
AppState.logWithZTime appState hint
|
||||
killThread (AppState.getMainThreadId appState)
|
||||
Nothing -> do
|
||||
putErr
|
||||
pure []
|
||||
Right x -> pure x
|
||||
else
|
||||
pure mempty
|
||||
readAppConfig dbSettings configFilePath (Just configDbUri) >>= \case
|
||||
Left err ->
|
||||
if startingUp then
|
||||
panic err -- die on invalid config if the program is starting up
|
||||
else
|
||||
AppState.logWithZTime appState $ "Failed reloading config: " <> err
|
||||
Right newConf -> do
|
||||
AppState.putConfig appState newConf
|
||||
if startingUp then
|
||||
pass
|
||||
else
|
||||
AppState.logWithZTime appState "Config reloaded"
|
||||
+5
-10
@@ -1,4 +1,4 @@
|
||||
resolver: lts-19.14 # 2022-07-01, GHC 9.0.2
|
||||
resolver: lts-20.6 # 2023-01-09, GHC 9.2.5
|
||||
|
||||
nix:
|
||||
packages:
|
||||
@@ -10,12 +10,7 @@ nix:
|
||||
pure: false
|
||||
|
||||
extra-deps:
|
||||
- HTTP-4000.3.16@sha256:6042643c15a0b43e522a6693f1e322f05000d519543a84149cb80aeffee34f71,5947
|
||||
- configurator-pg-0.2.6@sha256:cd9b06a458428e493a4d6def725af7ab1ab0fef678fbd871f9586fc7f9aa70be,2849
|
||||
- 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
|
||||
- git: https://github.com/PostgREST/postgresql-libpq.git
|
||||
commit: 890a0a16cf57dd401420fdc6c7d576fb696003bc
|
||||
- hasql-notifications-0.2.0.6
|
||||
- hasql-pool-0.10
|
||||
|
||||
+20
-58
@@ -5,71 +5,33 @@
|
||||
|
||||
packages:
|
||||
- completed:
|
||||
hackage: HTTP-4000.3.16@sha256:6042643c15a0b43e522a6693f1e322f05000d519543a84149cb80aeffee34f71,5947
|
||||
commit: 890a0a16cf57dd401420fdc6c7d576fb696003bc
|
||||
git: https://github.com/PostgREST/postgresql-libpq.git
|
||||
name: postgresql-libpq
|
||||
pantry-tree:
|
||||
size: 1428
|
||||
sha256: b73a7f6d21cf20bbf819e19039409c9010efb5000d2b72cdd8fd67a9027c14e8
|
||||
sha256: 074668b9669b9c49f3c522c8af5c608799a1965e203c463b188b2632995beac2
|
||||
size: 1414
|
||||
version: 0.9.4.3
|
||||
original:
|
||||
hackage: HTTP-4000.3.16@sha256:6042643c15a0b43e522a6693f1e322f05000d519543a84149cb80aeffee34f71,5947
|
||||
commit: 890a0a16cf57dd401420fdc6c7d576fb696003bc
|
||||
git: https://github.com/PostgREST/postgresql-libpq.git
|
||||
- completed:
|
||||
hackage: configurator-pg-0.2.6@sha256:cd9b06a458428e493a4d6def725af7ab1ab0fef678fbd871f9586fc7f9aa70be,2849
|
||||
hackage: hasql-notifications-0.2.0.6@sha256:16d783f5cd1660fad924fd3769380889de5804e057f09b304dcdc3a3ff11eb3c,2028
|
||||
pantry-tree:
|
||||
size: 2463
|
||||
sha256: 97efe7a22afc93033bda5adcffdabc0f1c30dc32b2c3ba02114ce7cd74c942fd
|
||||
sha256: 2319743501bb3c0bef801014ce61308b8666cef86ae5a97a0a283c0c1ec12d4f
|
||||
size: 452
|
||||
original:
|
||||
hackage: configurator-pg-0.2.6@sha256:cd9b06a458428e493a4d6def725af7ab1ab0fef678fbd871f9586fc7f9aa70be,2849
|
||||
hackage: hasql-notifications-0.2.0.6
|
||||
- completed:
|
||||
hackage: hasql-dynamic-statements-0.3.1.1@sha256:2cfe6e75990e690f595a87cbe553f2e90fcd738610f6c66749c81cc4396b2cc4,2675
|
||||
hackage: hasql-pool-0.10@sha256:912197a328acb85505f98bb9700d61f366b87659ca45126c5c2d636687b801c3,2112
|
||||
pantry-tree:
|
||||
size: 595
|
||||
sha256: b84ae10a5c776f88f546df73bc957a35e61056400b7e805dad0b254612907e97
|
||||
sha256: b655c540a49764a8d16b62941137e295b936b96edc0785eb9250972f0f92dc47
|
||||
size: 346
|
||||
original:
|
||||
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
|
||||
hackage: hasql-pool-0.10
|
||||
snapshots:
|
||||
- completed:
|
||||
size: 618951
|
||||
url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/19/14.yaml
|
||||
sha256: 4c31d4ef975b0211078862566aedf3b82b6cea569fc2cde4c72a51e5a8d236ce
|
||||
original: lts-19.14
|
||||
sha256: 4905c93319aa94aa53da8f41d614d7bacdbfe6c63a8c6132d32e6e62f24a9af4
|
||||
size: 649315
|
||||
url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/20/6.yaml
|
||||
original: lts-20.6
|
||||
|
||||
+8
-2
@@ -11,8 +11,14 @@ main =
|
||||
[ "-XOverloadedStrings"
|
||||
, "-XNoImplicitPrelude"
|
||||
, "-XStandaloneDeriving"
|
||||
, "-XDuplicateRecordFields"
|
||||
, "-isrc"
|
||||
, "src/PostgREST/Query/SqlFragment.hs"
|
||||
, "src/PostgREST/Request/Preferences.hs"
|
||||
, "src/PostgREST/Request/QueryParams.hs"
|
||||
, "src/PostgREST/ApiRequest/Preferences.hs"
|
||||
, "src/PostgREST/ApiRequest/QueryParams.hs"
|
||||
, "src/PostgREST/Error.hs"
|
||||
, "src/PostgREST/MediaType.hs"
|
||||
, "src/PostgREST/Config.hs"
|
||||
, "src/PostgREST/Plan.hs"
|
||||
, "src/PostgREST/Response.hs"
|
||||
]
|
||||
|
||||
@@ -0,0 +1,55 @@
|
||||
import os
|
||||
import pathlib
|
||||
import shutil
|
||||
import signal
|
||||
|
||||
import pytest
|
||||
import yaml
|
||||
|
||||
|
||||
BASEDIR = pathlib.Path(os.path.realpath(__file__)).parent
|
||||
CONFIGSDIR = BASEDIR / "configs"
|
||||
FIXTURES = yaml.load((BASEDIR / "fixtures.yaml").read_text(), Loader=yaml.Loader)
|
||||
POSTGREST_BIN = shutil.which("postgrest")
|
||||
SECRET = "reallyreallyreallyreallyverysafe"
|
||||
|
||||
|
||||
@pytest.fixture
|
||||
def dburi():
|
||||
"Postgres database connection URI."
|
||||
dbname = os.environ["PGDATABASE"]
|
||||
host = os.environ["PGHOST"]
|
||||
user = os.environ["PGUSER"]
|
||||
return f"postgresql://?dbname={dbname}&host={host}&user={user}".encode()
|
||||
|
||||
|
||||
@pytest.fixture
|
||||
def baseenv():
|
||||
"Base environment to connect to PostgreSQL"
|
||||
return {
|
||||
"PGDATABASE": os.environ["PGDATABASE"],
|
||||
"PGHOST": os.environ["PGHOST"],
|
||||
"PGUSER": os.environ["PGUSER"],
|
||||
}
|
||||
|
||||
|
||||
@pytest.fixture
|
||||
def defaultenv(baseenv):
|
||||
"Default environment for PostgREST."
|
||||
return {
|
||||
**baseenv,
|
||||
"PGRST_DB_CONFIG": "true",
|
||||
"PGRST_LOG_LEVEL": "info",
|
||||
"PGRST_DB_POOL": "1",
|
||||
"PGRST_NOT_EXISTING": "should not break any tests",
|
||||
}
|
||||
|
||||
|
||||
def hpctixfile():
|
||||
"Returns an individual filename for each test, if the HPCTIXFILE environment variable is set."
|
||||
if "HPCTIXFILE" not in os.environ:
|
||||
return ""
|
||||
|
||||
tixfile = pathlib.Path(os.environ["HPCTIXFILE"])
|
||||
test = hash(os.environ["PYTEST_CURRENT_TEST"])
|
||||
return tixfile.with_suffix(f".{test}.tix")
|
||||
@@ -1,4 +1,5 @@
|
||||
db-schema = "provided_through_alias"
|
||||
db-pool-timeout = 5
|
||||
max-rows = 1000
|
||||
pre-request = "check_alias"
|
||||
role-claim-key = ".aliased"
|
||||
|
||||
@@ -1,2 +1,4 @@
|
||||
# Not the default, but only works with PG* variables, which are not set
|
||||
db-config = false
|
||||
# not existing config options should not break tests
|
||||
not-existing = "should succeed"
|
||||
|
||||
@@ -5,12 +5,15 @@ db-extra-search-path = "public"
|
||||
db-max-rows = 1000
|
||||
db-plan-enabled = false
|
||||
db-pool = 10
|
||||
db-pool-timeout = 3600
|
||||
db-pool-acquisition-timeout = 10
|
||||
db-pool-max-lifetime = 1800
|
||||
db-pool-max-idletime = 5
|
||||
db-pre-request = "check_alias"
|
||||
db-prepared-statements = true
|
||||
db-root-spec = "open_alias"
|
||||
db-schemas = "provided_through_alias"
|
||||
db-config = true
|
||||
db-pre-config = ""
|
||||
db-tx-end = "commit"
|
||||
db-uri = "postgresql://"
|
||||
db-use-legacy-gucs = true
|
||||
@@ -25,6 +28,7 @@ openapi-server-proxy-uri = ""
|
||||
raw-media-types = ""
|
||||
server-host = "!4"
|
||||
server-port = 3000
|
||||
server-trace-header = ""
|
||||
server-unix-socket = ""
|
||||
server-unix-socket-mode = "660"
|
||||
admin-server-port = ""
|
||||
|
||||
@@ -5,12 +5,15 @@ db-extra-search-path = "public"
|
||||
db-max-rows = ""
|
||||
db-plan-enabled = false
|
||||
db-pool = 10
|
||||
db-pool-timeout = 3600
|
||||
db-pool-acquisition-timeout = 10
|
||||
db-pool-max-lifetime = 1800
|
||||
db-pool-max-idletime = 30
|
||||
db-pre-request = ""
|
||||
db-prepared-statements = false
|
||||
db-root-spec = ""
|
||||
db-schemas = "public"
|
||||
db-config = true
|
||||
db-pre-config = ""
|
||||
db-tx-end = "commit"
|
||||
db-uri = "postgresql://"
|
||||
db-use-legacy-gucs = true
|
||||
@@ -25,6 +28,7 @@ openapi-server-proxy-uri = ""
|
||||
raw-media-types = ""
|
||||
server-host = "!4"
|
||||
server-port = 3000
|
||||
server-trace-header = ""
|
||||
server-unix-socket = ""
|
||||
server-unix-socket-mode = "660"
|
||||
admin-server-port = ""
|
||||
|
||||
@@ -5,12 +5,15 @@ db-extra-search-path = "public"
|
||||
db-max-rows = ""
|
||||
db-plan-enabled = false
|
||||
db-pool = 10
|
||||
db-pool-timeout = 3600
|
||||
db-pool-acquisition-timeout = 10
|
||||
db-pool-max-lifetime = 1800
|
||||
db-pool-max-idletime = 30
|
||||
db-pre-request = ""
|
||||
db-prepared-statements = false
|
||||
db-root-spec = ""
|
||||
db-schemas = "public"
|
||||
db-config = true
|
||||
db-pre-config = ""
|
||||
db-tx-end = "commit"
|
||||
db-uri = "postgresql://"
|
||||
db-use-legacy-gucs = true
|
||||
@@ -25,6 +28,7 @@ openapi-server-proxy-uri = ""
|
||||
raw-media-types = ""
|
||||
server-host = "!4"
|
||||
server-port = 3000
|
||||
server-trace-header = ""
|
||||
server-unix-socket = ""
|
||||
server-unix-socket-mode = "660"
|
||||
admin-server-port = ""
|
||||
|
||||
@@ -5,12 +5,15 @@ db-extra-search-path = "public"
|
||||
db-max-rows = ""
|
||||
db-plan-enabled = false
|
||||
db-pool = 10
|
||||
db-pool-timeout = 3600
|
||||
db-pool-acquisition-timeout = 10
|
||||
db-pool-max-lifetime = 1800
|
||||
db-pool-max-idletime = 30
|
||||
db-pre-request = ""
|
||||
db-prepared-statements = true
|
||||
db-root-spec = ""
|
||||
db-schemas = "public"
|
||||
db-config = false
|
||||
db-pre-config = ""
|
||||
db-tx-end = "commit"
|
||||
db-uri = "postgresql://"
|
||||
db-use-legacy-gucs = true
|
||||
@@ -25,6 +28,7 @@ openapi-server-proxy-uri = ""
|
||||
raw-media-types = ""
|
||||
server-host = "!4"
|
||||
server-port = 3000
|
||||
server-trace-header = ""
|
||||
server-unix-socket = ""
|
||||
server-unix-socket-mode = "660"
|
||||
admin-server-port = ""
|
||||
|
||||
@@ -1,21 +1,24 @@
|
||||
db-anon-role = "other"
|
||||
db-anon-role = "pre_config_role"
|
||||
db-channel = "postgrest"
|
||||
db-channel-enabled = false
|
||||
db-extra-search-path = "public,extensions,other"
|
||||
db-max-rows = 100
|
||||
db-plan-enabled = true
|
||||
db-pool = 1
|
||||
db-pool-timeout = 100
|
||||
db-pool-acquisition-timeout = 30
|
||||
db-pool-max-lifetime = 3600
|
||||
db-pool-max-idletime = 60
|
||||
db-pre-request = "test.other_custom_headers"
|
||||
db-prepared-statements = false
|
||||
db-root-spec = "other_root"
|
||||
db-schemas = "test,other_tenant1,other_tenant2"
|
||||
db-config = true
|
||||
db-pre-config = "postgrest.pre_config"
|
||||
db-tx-end = "rollback-allow-override"
|
||||
db-uri = "postgresql://"
|
||||
db-use-legacy-gucs = false
|
||||
jwt-aud = "https://otherexample.org"
|
||||
jwt-role-claim-key = ".\"other\".\"role\""
|
||||
jwt-role-claim-key = ".\"other\".\"pre_config_role\""
|
||||
jwt-secret = "ODERREALLYREALLYREALLYREALLYVERYSAFE"
|
||||
jwt-secret-is-base64 = true
|
||||
log-level = "info"
|
||||
@@ -25,6 +28,7 @@ openapi-server-proxy-uri = "https://otherexample.org/api"
|
||||
raw-media-types = "application/vnd.pgrst.other-db-config"
|
||||
server-host = "0.0.0.0"
|
||||
server-port = 80
|
||||
server-trace-header = "traceparent"
|
||||
server-unix-socket = "/tmp/pgrst_io_test.sock"
|
||||
server-unix-socket-mode = "777"
|
||||
admin-server-port = 3001
|
||||
|
||||
@@ -5,12 +5,15 @@ db-extra-search-path = "public,extensions,private"
|
||||
db-max-rows = 1000
|
||||
db-plan-enabled = true
|
||||
db-pool = 1
|
||||
db-pool-timeout = 100
|
||||
db-pool-acquisition-timeout = 30
|
||||
db-pool-max-lifetime = 3600
|
||||
db-pool-max-idletime = 60
|
||||
db-pre-request = "test.custom_headers"
|
||||
db-prepared-statements = false
|
||||
db-root-spec = "root"
|
||||
db-schemas = "test,tenant1,tenant2"
|
||||
db-config = true
|
||||
db-pre-config = "postgrest.preconf"
|
||||
db-tx-end = "commit-allow-override"
|
||||
db-uri = "postgresql://"
|
||||
db-use-legacy-gucs = false
|
||||
@@ -25,6 +28,7 @@ openapi-server-proxy-uri = "https://example.org/api"
|
||||
raw-media-types = "application/vnd.pgrst.db-config"
|
||||
server-host = "0.0.0.0"
|
||||
server-port = 80
|
||||
server-trace-header = "CF-Ray"
|
||||
server-unix-socket = "/tmp/pgrst_io_test.sock"
|
||||
server-unix-socket-mode = "777"
|
||||
admin-server-port = 3001
|
||||
|
||||
@@ -5,12 +5,15 @@ db-extra-search-path = "public,test"
|
||||
db-max-rows = 1000
|
||||
db-plan-enabled = true
|
||||
db-pool = 1
|
||||
db-pool-timeout = 100
|
||||
db-pool-acquisition-timeout = 30
|
||||
db-pool-max-lifetime = 3600
|
||||
db-pool-max-idletime = 60
|
||||
db-pre-request = "please_run_fast"
|
||||
db-prepared-statements = false
|
||||
db-root-spec = "openapi_v3"
|
||||
db-schemas = "multi,tenant,setup"
|
||||
db-config = false
|
||||
db-pre-config = "postgrest.pre_config"
|
||||
db-tx-end = "rollback-allow-override"
|
||||
db-uri = "tmp_db"
|
||||
db-use-legacy-gucs = false
|
||||
@@ -25,6 +28,7 @@ openapi-server-proxy-uri = "https://postgrest.org"
|
||||
raw-media-types = "application/vnd.pgrst.config"
|
||||
server-host = "0.0.0.0"
|
||||
server-port = 80
|
||||
server-trace-header = "X-Request-Id"
|
||||
server-unix-socket = "/tmp/pgrst_io_test.sock"
|
||||
server-unix-socket-mode = "777"
|
||||
admin-server-port = 3001
|
||||
|
||||
@@ -5,12 +5,15 @@ db-extra-search-path = "public"
|
||||
db-max-rows = ""
|
||||
db-plan-enabled = false
|
||||
db-pool = 10
|
||||
db-pool-timeout = 3600
|
||||
db-pool-acquisition-timeout = 10
|
||||
db-pool-max-lifetime = 1800
|
||||
db-pool-max-idletime = 30
|
||||
db-pre-request = ""
|
||||
db-prepared-statements = true
|
||||
db-root-spec = ""
|
||||
db-schemas = "public"
|
||||
db-config = true
|
||||
db-pre-config = ""
|
||||
db-tx-end = "commit"
|
||||
db-uri = "postgresql://"
|
||||
db-use-legacy-gucs = true
|
||||
@@ -25,6 +28,7 @@ openapi-server-proxy-uri = ""
|
||||
raw-media-types = ""
|
||||
server-host = "!4"
|
||||
server-port = 3000
|
||||
server-trace-header = ""
|
||||
server-unix-socket = ""
|
||||
server-unix-socket-mode = "660"
|
||||
admin-server-port = ""
|
||||
|
||||
@@ -7,15 +7,17 @@ PGRST_DB_EXTRA_SEARCH_PATH: public, test
|
||||
PGRST_DB_MAX_ROWS: 1000
|
||||
PGRST_DB_PLAN_ENABLED: true
|
||||
PGRST_DB_POOL: 1
|
||||
PGRST_DB_POOL_TIMEOUT: 100
|
||||
PGRST_DB_POOL_ACQUISITION_TIMEOUT: 30
|
||||
PGRST_DB_POOL_MAX_LIFETIME: 3600
|
||||
PGRST_DB_POOL_MAX_IDLETIME: 60
|
||||
PGRST_DB_PREPARED_STATEMENTS: false
|
||||
PGRST_DB_PRE_REQUEST: please_run_fast
|
||||
PGRST_DB_ROOT_SPEC: openapi_v3
|
||||
PGRST_DB_SCHEMAS: multi, tenant,setup
|
||||
PGRST_DB_CONFIG: false
|
||||
PGRST_DB_PRE_CONFIG: "postgrest.pre_config"
|
||||
PGRST_DB_TX_END: rollback-allow-override
|
||||
PGRST_DB_URI: tmp_db
|
||||
PGRST_DB_EMBED_DEFAULT_JOIN: inner
|
||||
PGRST_DB_USE_LEGACY_GUCS: false
|
||||
PGRST_JWT_AUD: 'https://postgrest.org'
|
||||
PGRST_JWT_ROLE_CLAIM_KEY: '.user[0]."real-role"'
|
||||
@@ -28,6 +30,7 @@ PGRST_OPENAPI_SERVER_PROXY_URI: 'https://postgrest.org'
|
||||
PGRST_RAW_MEDIA_TYPES: application/vnd.pgrst.config
|
||||
PGRST_SERVER_HOST: 0.0.0.0
|
||||
PGRST_SERVER_PORT: 80
|
||||
PGRST_SERVER_TRACE_HEADER: X-Request-Id
|
||||
PGRST_SERVER_UNIX_SOCKET: /tmp/pgrst_io_test.sock
|
||||
PGRST_SERVER_UNIX_SOCKET_MODE: 777
|
||||
PGRST_ADMIN_SERVER_PORT: 3001
|
||||
|
||||
@@ -5,12 +5,15 @@ db-extra-search-path = "public, test"
|
||||
db-max-rows = 1000
|
||||
db-plan-enabled = true
|
||||
db-pool = 1
|
||||
db-pool-timeout = 100
|
||||
db-pool-acquisition-timeout = 30
|
||||
db-pool-max-lifetime = 3600
|
||||
db-pool-max-idletime = 60
|
||||
db-pre-request = "please_run_fast"
|
||||
db-prepared-statements = false
|
||||
db-root-spec = "openapi_v3"
|
||||
db-schemas = "multi, tenant,setup"
|
||||
db-config = false
|
||||
db-pre-config = "postgrest.pre_config"
|
||||
db-tx-end = "rollback-allow-override"
|
||||
db-uri = "tmp_db"
|
||||
db-use-legacy-gucs = false
|
||||
@@ -25,6 +28,7 @@ openapi-server-proxy-uri = "https://postgrest.org"
|
||||
raw-media-types = "application/vnd.pgrst.config"
|
||||
server-host = "0.0.0.0"
|
||||
server-port = 80
|
||||
server-trace-header = "X-Request-Id"
|
||||
server-unix-socket = "/tmp/pgrst_io_test.sock"
|
||||
server-unix-socket-mode = "777"
|
||||
admin-server-port = 3001
|
||||
|
||||
+35
-4
@@ -9,6 +9,7 @@ ALTER ROLE db_config_authenticator SET pgrst.jwt_secret_is_base64 = 'false';
|
||||
ALTER ROLE db_config_authenticator SET pgrst.jwt_role_claim_key = '."a"."role"';
|
||||
ALTER ROLE db_config_authenticator SET pgrst.db_anon_role = 'anonymous';
|
||||
ALTER ROLE db_config_authenticator SET pgrst.db_tx_end = 'commit-allow-override';
|
||||
ALTER ROLE db_config_authenticator SET pgrst.db_pre_config = 'postgrest.preconf';
|
||||
ALTER ROLE db_config_authenticator SET pgrst.db_schemas = 'test, tenant1, tenant2';
|
||||
ALTER ROLE db_config_authenticator SET pgrst.db_root_spec = 'root';
|
||||
ALTER ROLE db_config_authenticator SET pgrst.db_plan_enabled = 'true';
|
||||
@@ -16,10 +17,13 @@ ALTER ROLE db_config_authenticator SET pgrst.db_prepared_statements = 'false';
|
||||
ALTER ROLE db_config_authenticator SET pgrst.db_pre_request = 'test.custom_headers';
|
||||
ALTER ROLE db_config_authenticator SET pgrst.db_max_rows = '1000';
|
||||
ALTER ROLE db_config_authenticator SET pgrst.db_extra_search_path = 'public, extensions';
|
||||
ALTER ROLE db_config_authenticator SET pgrst.not_existing = 'should be ignored';
|
||||
ALTER ROLE db_config_authenticator SET pgrst.server_trace_header = 'CF-Ray';
|
||||
|
||||
-- override with database specific setting
|
||||
ALTER ROLE db_config_authenticator IN DATABASE :DBNAME SET pgrst.jwt_secret = 'OVERRIDE=REALLY=REALLY=REALLY=REALLY=VERY=SAFE';
|
||||
ALTER ROLE db_config_authenticator IN DATABASE :DBNAME SET pgrst.db_extra_search_path = 'public, extensions, private';
|
||||
ALTER ROLE db_config_authenticator IN DATABASE :DBNAME SET pgrst.not_existing = 'should be ignored';
|
||||
|
||||
-- other database settings that should be ignored
|
||||
CREATE DATABASE other;
|
||||
@@ -37,7 +41,10 @@ ALTER ROLE db_config_authenticator SET pgrst.db_channel_enabled = 'ignored';
|
||||
ALTER ROLE db_config_authenticator SET pgrst.db_channel = 'ignored';
|
||||
ALTER ROLE db_config_authenticator SET pgrst.db_pool = 'ignored';
|
||||
ALTER ROLE db_config_authenticator SET pgrst.db_pool_timeout = 'ignored';
|
||||
ALTER ROLE db_config_authenticator SET pgrst.db_config = 'ignored';
|
||||
ALTER ROLE db_config_authenticator SET pgrst.db_pool_acquisition_timeout = 'ignored';
|
||||
ALTER ROLE db_config_authenticator SET pgrst.db_pool_max_lifetime = 'ignored';
|
||||
ALTER ROLE db_config_authenticator SET pgrst.db_pool_max_idletime = 'ignored';
|
||||
ALTER ROLE db_config_authenticator SET pgrst.db_config = 'true';
|
||||
|
||||
-- other authenticator reloadable config options
|
||||
CREATE ROLE other_authenticator LOGIN NOINHERIT;
|
||||
@@ -46,9 +53,6 @@ ALTER ROLE other_authenticator SET pgrst.openapi_server_proxy_uri = 'https://oth
|
||||
ALTER ROLE other_authenticator SET pgrst.raw_media_types = 'application/vnd.pgrst.other-db-config';
|
||||
ALTER ROLE other_authenticator SET pgrst.jwt_secret = 'ODERREALLYREALLYREALLYREALLYVERYSAFE';
|
||||
ALTER ROLE other_authenticator SET pgrst.jwt_secret_is_base64 = 'true';
|
||||
ALTER ROLE other_authenticator SET pgrst.jwt_role_claim_key = '."other"."role"';
|
||||
ALTER ROLE other_authenticator SET pgrst.db_anon_role = 'other';
|
||||
ALTER ROLE other_authenticator SET pgrst.db_tx_end = 'rollback-allow-override';
|
||||
ALTER ROLE other_authenticator SET pgrst.db_schemas = 'test, other_tenant1, other_tenant2';
|
||||
ALTER ROLE other_authenticator SET pgrst.db_root_spec = 'other_root';
|
||||
ALTER ROLE other_authenticator SET pgrst.db_plan_enabled = 'true';
|
||||
@@ -58,6 +62,33 @@ ALTER ROLE other_authenticator SET pgrst.db_max_rows = '100';
|
||||
ALTER ROLE other_authenticator SET pgrst.db_extra_search_path = 'public, extensions, other';
|
||||
ALTER ROLE other_authenticator SET pgrst.openapi_mode = 'disabled';
|
||||
ALTER ROLE other_authenticator SET pgrst.openapi_security_active = 'false';
|
||||
ALTER ROLE other_authenticator SET pgrst.server_trace_header = 'traceparent';
|
||||
ALTER ROLE other_authenticator SET pgrst.db_pre_config = 'postgrest.pre_config';
|
||||
|
||||
create schema postgrest;
|
||||
grant usage on schema postgrest to db_config_authenticator;
|
||||
grant usage on schema postgrest to other_authenticator;
|
||||
|
||||
-- pre-config hook
|
||||
create or replace function postgrest.pre_config()
|
||||
returns void as $$
|
||||
begin
|
||||
if current_user = 'other_authenticator' then
|
||||
perform
|
||||
set_config('pgrst.jwt_role_claim_key', '."other"."pre_config_role"', true)
|
||||
, set_config('pgrst.db_anon_role', 'pre_config_role', true)
|
||||
, set_config('pgrst.db_schemas', 'will be overriden with the above ALTER ROLE.. db_schemas', true)
|
||||
, set_config('pgrst.db_tx_end', 'rollback-allow-override', true);
|
||||
else
|
||||
null;
|
||||
end if;
|
||||
end $$ language plpgsql;
|
||||
|
||||
create or replace function postgrest.preconf()
|
||||
returns void as $$
|
||||
begin
|
||||
null;
|
||||
end $$ language plpgsql;
|
||||
|
||||
-- authenticator used for tests that manipulate statement timeout
|
||||
CREATE ROLE timeout_authenticator LOGIN NOINHERIT;
|
||||
|
||||
+93
-5
@@ -1,14 +1,27 @@
|
||||
\ir big_schema.sql
|
||||
-- \ir big_schema.sql big schema test currently skipped, see test_io.py
|
||||
\ir db_config.sql
|
||||
|
||||
set search_path to public;
|
||||
|
||||
CREATE ROLE postgrest_test_anonymous;
|
||||
ALTER ROLE :USER SET pgrst.db_anon_role = 'postgrest_test_anonymous';
|
||||
ALTER ROLE :PGUSER SET pgrst.db_anon_role = 'postgrest_test_anonymous';
|
||||
|
||||
CREATE ROLE postgrest_test_author;
|
||||
|
||||
GRANT postgrest_test_anonymous, postgrest_test_author TO :USER;
|
||||
CREATE ROLE postgrest_test_serializable;
|
||||
alter role postgrest_test_serializable set default_transaction_isolation = 'serializable';
|
||||
|
||||
CREATE ROLE postgrest_test_repeatable_read;
|
||||
alter role postgrest_test_repeatable_read set default_transaction_isolation = 'REPEATABLE READ';
|
||||
|
||||
CREATE ROLE postgrest_test_w_superuser_settings;
|
||||
alter role postgrest_test_w_superuser_settings set log_min_duration_statement = 1;
|
||||
alter role postgrest_test_w_superuser_settings set log_min_messages = 'fatal';
|
||||
|
||||
GRANT
|
||||
postgrest_test_anonymous, postgrest_test_author,
|
||||
postgrest_test_serializable, postgrest_test_repeatable_read,
|
||||
postgrest_test_w_superuser_settings TO :PGUSER;
|
||||
|
||||
CREATE SCHEMA v1;
|
||||
GRANT USAGE ON SCHEMA v1 TO postgrest_test_anonymous;
|
||||
@@ -17,7 +30,7 @@ CREATE TABLE authors_only ();
|
||||
GRANT SELECT ON authors_only TO postgrest_test_author;
|
||||
|
||||
CREATE TABLE projects AS SELECT FROM generate_series(1,5);
|
||||
GRANT SELECT ON projects TO postgrest_test_anonymous;
|
||||
GRANT SELECT ON projects TO postgrest_test_anonymous, postgrest_test_w_superuser_settings;
|
||||
|
||||
create function get_guc_value(name text) returns text as $$
|
||||
select nullif(current_setting(name), '')::text;
|
||||
@@ -84,5 +97,80 @@ create or replace function sleep(seconds double precision) returns void as $$
|
||||
$$ language sql;
|
||||
|
||||
create or replace function hello() returns text as $$
|
||||
select 'hello';
|
||||
select 'hello'::text;
|
||||
$$ language sql;
|
||||
|
||||
create table cats(id uuid primary key, name text);
|
||||
grant all on cats to postgrest_test_anonymous;
|
||||
|
||||
create function drop_change_cats() returns void
|
||||
language sql security definer
|
||||
as $$
|
||||
drop table cats;
|
||||
create table cats(id bigint primary key, name text);
|
||||
grant all on table cats to postgrest_test_anonymous;
|
||||
notify pgrst, 'reload schema';
|
||||
$$;
|
||||
|
||||
alter role postgrest_test_anonymous set statement_timeout to '2s';
|
||||
alter role postgrest_test_author set statement_timeout to '10s';
|
||||
|
||||
create function change_role_statement_timeout(timeout text) returns void as $_$
|
||||
begin
|
||||
execute format($$
|
||||
alter role current_user set statement_timeout = %L;
|
||||
$$, timeout);
|
||||
end $_$ volatile language plpgsql ;
|
||||
|
||||
create table items as select x as id from generate_series(1,5) x;
|
||||
|
||||
create view items_w_isolation_level as
|
||||
select
|
||||
id,
|
||||
current_setting('transaction_isolation', true) as isolation_level
|
||||
from items;
|
||||
|
||||
grant all on items_w_isolation_level to postgrest_test_anonymous, postgrest_test_repeatable_read, postgrest_test_serializable;
|
||||
|
||||
create function default_isolation_level()
|
||||
returns text as $$
|
||||
select current_setting('transaction_isolation', true);
|
||||
$$
|
||||
language sql;
|
||||
|
||||
create function serializable_isolation_level()
|
||||
returns text as $$
|
||||
select current_setting('transaction_isolation', true);
|
||||
$$
|
||||
language sql set default_transaction_isolation = 'serializable';
|
||||
|
||||
create function repeatable_read_isolation_level()
|
||||
returns text as $$
|
||||
select current_setting('transaction_isolation', true);
|
||||
$$
|
||||
language sql set default_transaction_isolation = 'REPEATABLE READ';
|
||||
|
||||
create or replace function create_function() returns void as $_$
|
||||
drop function if exists mult_them(int, int);
|
||||
create or replace function mult_them(a int, b int) returns int as $$
|
||||
select a*b;
|
||||
$$ language sql;
|
||||
notify pgrst, 'reload schema';
|
||||
$_$ language sql security definer;
|
||||
|
||||
create or replace function migrate_function() returns void as $_$
|
||||
drop function if exists mult_them(int, int);
|
||||
create or replace function mult_them(c int, d int) returns int as $$
|
||||
select c*d;
|
||||
$$ language sql;
|
||||
notify pgrst, 'reload schema';
|
||||
$_$ language sql security definer;
|
||||
|
||||
create or replace function get_pgrst_version() returns text
|
||||
language sql
|
||||
as $$
|
||||
select application_name
|
||||
from pg_stat_activity
|
||||
where application_name ilike 'postgrest%'
|
||||
limit 1;
|
||||
$$
|
||||
|
||||
Some files were not shown because too many files have changed in this diff Show More
Reference in New Issue
Block a user