bump version to 10.2.0

To 2.13.3

.github/actions/setup-nix/action.yaml

@@ -11,7 +11,7 @@ inputs:
 runs:
   using: composite
   steps:
-    - uses: cachix/install-nix-action@v22
+    - uses: cachix/install-nix-action@v18
       with:
         install_url: https://releases.nixos.org/nix/nix-2.13.3/install
     - uses: cachix/cachix-action@v12

.github/dependabot.yml

@@ -1,11 +1,6 @@
 version: 2
 updates:
-  - package-ecosystem: github-actions
+- package-ecosystem: github-actions
-    directory: /
+  directory: /
-    schedule:
+  schedule:
-      interval: weekly
+    interval: weekly
-
-  - package-ecosystem: github-actions
-    directory: /.github/actions/setup-nix
-    schedule:
-      interval: weekly

.github/get_cirrusci_freebsd

@@ -7,13 +7,12 @@ 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_auth_header" -H "$gh_accept_header"  "$gh_checks_list_url" \
+  curl --fail -H "$gh_accept_header"  "$gh_checks_list_url" \
     | jq -r '.check_suites[] | select(.app.slug == "cirrus-ci") | .check_runs_url'
 }
 
@@ -22,7 +21,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 -H "$gh_auth_header" "$gh_check_runs_url" | jq -r '.check_runs[] | .status')
+    status=$(curl --fail "$gh_check_runs_url" | jq -r '.check_runs[] | .status')
     if [ "$status" == "completed" ]; then
       break
     else
@@ -38,7 +37,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_auth_header" -H "$gh_accept_header" "$gh_check_runs_url" \
+  curl --fail -H "$gh_accept_header" "$gh_check_runs_url" \
     | jq -r '.check_runs[] | .external_id'
 }
 

.github/scripts/arm/build.sh

@@ -4,15 +4,11 @@
 
 [ -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
@@ -30,14 +26,13 @@ install_ghcup() {
 
 install_cabal() {
   ghcup upgrade
-  ghcup install cabal $CABAL_VERSION
+  ghcup install cabal 3.6.0.0
-  ghcup set cabal $CABAL_VERSION
+  ghcup set cabal 3.6.0.0
 }
 
 install_ghc() {
-  ghcup upgrade
+  ghcup install ghc 8.10.7
-  ghcup install ghc $GHC_VERSION
+  ghcup set ghc 8.10.7
-  ghcup set ghc $GHC_VERSION
 }
 
 install_packages
@@ -46,8 +41,8 @@ install_packages
 [ -f ~/.ghcup/env ] && source ~/.ghcup/env
 
 ghcup --version || install_ghcup
-ghcup set cabal $CABAL_VERSION || install_cabal
+cabal --version || install_cabal
-ghcup set ghc $GHC_VERSION || install_ghc
+ghc --version || install_ghc
 
 cd ~/$SCRIPT_DIR
 

.github/scripts/arm/docker-env/Dockerfile

@@ -13,6 +13,4 @@ EXPOSE 3000
 
 USER 1000
 
-# Use the array form to avoid running the command using bash, which does not handle `SIGTERM` properly. 
+CMD postgrest
-# See https://docs.docker.com/compose/faq/#why-do-my-services-take-10-seconds-to-recreate-or-stop 
-CMD ["postgrest"]

.github/workflows/cachix.yaml

@@ -1,78 +0,0 @@
-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@v3
-      - 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

.github/workflows/ci.yaml

@@ -46,7 +46,7 @@ jobs:
       - 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.4
+        uses: codecov/codecov-action@v3.1.1
         with:
           files: ./coverage/codecov.json
 
@@ -84,7 +84,7 @@ jobs:
 
       - name: Run IO tests
         if: always()
-        run: postgrest-with-postgresql-${{ matrix.pgVersion }} -f test/io/fixtures.sql postgrest-test-io -vv
+        run: postgrest-with-postgresql-${{ matrix.pgVersion }} -f test/io/fixtures.sql postgrest-test-io
 
 
   Test-Memory-Nix:
@@ -108,6 +108,7 @@ jobs:
       - name: Setup Nix Environment
         uses: ./.github/actions/setup-nix
         with:
+          authToken: '${{ secrets.CACHIX_AUTH_TOKEN }}'
           tools: tests
 
       - name: Build static executable
@@ -130,18 +131,12 @@ jobs:
           path: postgrest-docker.tar.gz
           if-no-files-found: error
 
-
+      - name: Build and push everything to Cachix (main branch only)
-  Build-Macos-Nix:
+        if: ${{ github.ref == 'refs/heads/main' }}
-    name: Build MacOS (Nix)
-    runs-on: macos-latest
-    steps:
-      - uses: actions/checkout@v3
-      - 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:
@@ -203,8 +198,7 @@ jobs:
       - 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
@@ -216,15 +210,12 @@ jobs:
   Build-Cabal:
     strategy:
       matrix:
-        ghc: ['9.0.2', '9.2.4']
+        ghc: ['8.10.7', '9.2.4']
       fail-fast: false
     name: Build Linux (Cabal, GHC ${{ matrix.ghc }})
     runs-on: ubuntu-latest
     steps:
       - uses: actions/checkout@v3
-      - 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 }}
@@ -247,18 +238,13 @@ jobs:
         run: cabal build --enable-tests --enable-benchmarks all
 
   Build-Cabal-Arm:
-    strategy:
+    name: Build aarch64 (Cabal)
-      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@v3
       - id: Remote-Dir
@@ -285,8 +271,8 @@ jobs:
           fingerprint: ${{ secrets.SSH_ARM_FINGERPRINT }}
           command_timeout: 120m
           script_stop: true
-          envs: GITHUB_COMMIT,REMOTE_DIR,GHC_VERSION
+          envs: GITHUB_COMMIT,REMOTE_DIR
-          script: bash ~/$REMOTE_DIR/build.sh "$GITHUB_COMMIT" "$REMOTE_DIR" "GHC_VERSION"
+          script: bash ~/$REMOTE_DIR/build.sh "$GITHUB_COMMIT" "$REMOTE_DIR"
       - name: Download binaries from remote server
         uses: nicklasfrahm/scp-action@main
         with:
@@ -300,7 +286,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@v3
+        uses: actions/upload-artifact@v2.3.1
         with:
           name: postgrest-ubuntu-aarch64
           path: result/postgrest
@@ -434,6 +420,7 @@ jobs:
     name: Release on Docker Hub
     runs-on: ubuntu-latest
     needs:
+      - Build-Cabal-Arm
       - Prepare-Release
     env:
       GITHUB_COMMIT: ${{ github.sha }}
@@ -468,6 +455,18 @@ 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
@@ -481,49 +480,17 @@ 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@v3
-      - 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-Arm
+      - Release-Docker
-    if: success() ||
+    if: ${{ always() && (github.ref == 'refs/heads/main' || startsWith(github.ref, 'refs/tags/v') || startsWith(github.ref, 'refs/heads/rel-')) }}
-      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@v3
+      - uses: actions/checkout@v2.4.0
       - name: Remove uploaded files from server
         uses: appleboy/ssh-action@master
         with:

.github/workflows/report.yaml

@@ -22,7 +22,7 @@ jobs:
           name: loadtest.md
           path: artifacts
       - name: Upload to GitHub Checks
-        uses: LouisBrunner/checks-action@v1.6.2
+        uses: LouisBrunner/checks-action@v1.5.0
         with:
           token: ${{ secrets.GITHUB_TOKEN }}
           sha: ${{ github.event.workflow_run.head_sha }}

ARCHITECTURE.md

@@ -55,6 +55,12 @@ It builds the OpenAPI response using the schema cache.
 
 This module provides functions to deal with JWT authorization.
 
+### Workers.hs
+
+This spawns threads which are used to execute concurrent jobs.
+
+Jobs include connection recovery, a listener for the PostgreSQL LISTEN command, and an admin server.
+
 ### SchemaCache.hs
 
 This queries the PostgreSQL system catalogs and caches the metadata into a SchemaCache type,
@@ -62,7 +68,3 @@ This queries the PostgreSQL system catalogs and caches the metadata into a Schem
 ### 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.

BACKERS.md

@@ -46,14 +46,12 @@ 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

CHANGELOG.md

@@ -3,134 +3,6 @@
 All notable changes to this project will be documented in this file.
 This project adheres to [Semantic Versioning](http://semver.org/).
 
-## Unreleased
-
-## [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
@@ -164,7 +36,6 @@ This project adheres to [Semantic Versioning](http://semver.org/).
 
  - #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
 

default.nix

@@ -41,7 +41,6 @@ let
       allOverlays.postgresql-legacy
       allOverlays.postgresql-future
       (allOverlays.haskell-packages { inherit compiler; })
-      allOverlays.slocat
     ];
 
   # Evaluated expression of the Nixpkgs repository.
@@ -66,17 +65,11 @@ let
   postgrest =
     pkgs.haskell.packages."${compiler}".callCabal2nix name src { };
 
-  # Functionality that derives a fully static Haskell package based on
+  # Function 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";
@@ -101,6 +94,10 @@ rec {
   postgrestPackage =
     lib.dontCheck postgrest;
 
+  # Static executable.
+  postgrestStatic =
+    lib.justStaticExecutables (lib.dontCheck (staticHaskellPackage name src));
+
   # Profiled dynamic executable.
   postgrestProfiled =
     lib.enableExecutableProfiling (
@@ -122,13 +119,14 @@ 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; };
@@ -157,12 +155,7 @@ 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;
 
-  # Docker images and loading script.
+  withTools =
-  docker =
+    pkgs.callPackage nix/tools/withTools.nix { inherit devCabalOptions postgresqlVersions postgrest; };
-    pkgs.callPackage nix/tools/docker { postgrest = postgrestStatic; };
 }

nix/README.md

@@ -5,14 +5,24 @@ for developing, testing and building PostgREST.
 
 ## Getting started with Nix
 
-You'll need to [get Nix](https://nixos.org/download.html). Follow the recommended installation for your operating system from the official download website.
+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.
 
 ## Building PostgREST
 
 To build PostgREST from your local checkout of the repository, run:
 
 ```bash
-$ nix-build --attr postgrestPackage
+nix-build --attr postgrestPackage
 
 ```
 
@@ -29,10 +39,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
 
 ```
 
@@ -46,7 +56,7 @@ following command will put you into a new shell that has GHC and Cabal on the
 PATH:
 
 ```bash
-$ nix-shell
+nix-shell
 
 ```
 
@@ -136,10 +146,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
-[nix-shell]$ cd src
+$ cd src
 # Even though the current directory is ./src, the config path must still start
 # from the repo root:
-[nix-shell]$ postgrest-run test/io/configs/simple.conf
+$ postgrest-run test/io/configs/simple.conf
 ```
 
 ## Testing
@@ -167,21 +177,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':
-[nix-shell]$ postgrest-test-io -k config
+postgrest-test-io -k config
 
 # Run tests in parallel using xdist, specifying the number of processes:
-[nix-shell]$ postgrest-test-io -n auto
+postgrest-test-io -n auto
-[nix-shell]$ postgrest-test-io -n 8
+postgrest-test-io -n 8
 ```
 
 The memory tests check that we don't surpass a memory threshold for big request bodies.
 
 ```bash
 # Build the dependencies needed for the memory test
-$ nix-shell --arg memory true
+nix-shell --arg memory true
 
 # Run the memory test
-[nix-shell]$ postgrest-test-memory
+postgrest-test-memory
 ```
 
 The loadtests ensure that performance doesn't drop on a change. Underlyingly they use
@@ -189,25 +199,19 @@ The loadtests ensure that performance doesn't drop on a change. Underlyingly the
 
 ```bash
 # Run the loadtests on the latest commit(HEAD)
-[nix-shell]$ postgrest-loadtest
+postgrest-loadtest
 
 # You can loadtest comparing to a different branch
-[nix-shell]$ postgrest-loadtest-against master
+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
-[nix-shell]$ postgrest-loadtest-report
+postgrest-loadtest-report
 ```
 
 doctests for some of our modules are also available:
 
 ```bash
-[nix-shell]$ postgrest-test-doctest
+postgrest-test-doctest
 ```
 
 ## Code coverage
@@ -216,11 +220,11 @@ Code coverage is available under the `postgrest-coverage` command. This will pro
 
 ```bash
 # Will run all the tests and produce a coverage dir
-[nix-shell]$ postgrest-coverage
+postgrest-coverage
 
 # Visualize the output
-[nix-shell]$ cd coverage
+cd coverage
-[nix-shell]$ python -mSimpleHTTPServer 8080
+python -mSimpleHTTPServer 8080
 ```
 
 ## Linting and styling code

nix/nixpkgs-version.nix

@@ -1,6 +1,6 @@
 # Pinned version of Nixpkgs, generated with postgrest-nixpkgs-upgrade.
 {
-  date = "2023-03-25";
+  date = "2023-01-12";
-  rev = "dbf5322e93bcc6cfc52268367a8ad21c09d76fea";
+  rev = "92f9580a4c369b4b51a7b6a5e77da43720134c9f";
-  tarballHash = "0lwk4v9dkvd28xpqch0b0jrac4xl9lwm6snrnzx8k5lby72kmkng";
+  tarballHash = "0w9bz4f2bmkj4a59n4z279zcgs9clyc40a4ny312rafyaknzghvw";
 }

nix/overlays/default.nix

@@ -7,5 +7,4 @@
   postgresql-default = import ./postgresql-default.nix;
   postgresql-legacy = import ./postgresql-legacy.nix;
   postgresql-future = import ./postgresql-future.nix;
-  slocat = import ./slocat.nix;
 }

nix/overlays/haskell-packages.nix

@@ -43,8 +43,8 @@ let
         (prev.callHackageDirect
           {
             pkg = "hasql-notifications";
-            ver = "0.2.0.5";
+            ver = "0.2.0.4";
-            sha256 = "sha256-KV36zs/RTgJh/oBBPZaNiQshusmakWnjYTcdoNa4JLA=";
+            sha256 = "sha256-fm1xiDyvDkb5WLOJ73/s8wrWEW23XFS7luAv2brfr8I=";
           }
           { });
 
@@ -52,8 +52,8 @@ let
         (prev.callHackageDirect
           {
             pkg = "hasql-pool";
-            ver = "0.10";
+            ver = "0.9";
-            sha256 = "sha256-kHzoqtNV9BFWnn1h560JRqMooQRwxokVKgDRBexamNI=";
+            sha256 = "sha256-5UshbbaBVY8eJ/9VagNVVxonRwMcd7UmGqDc35pJNFY=";
           }
           { });
     } // extraOverrides final prev;

nix/overlays/slocat.nix

@@ -1,13 +0,0 @@
-final: prev:
-{
-  slocat = prev.buildGoModule {
-    name = "slocat";
-    src = prev.fetchFromGitHub {
-      owner = "robx";
-      repo = "slocat";
-      rev = "52e7512c6029fd00483e41ccce260a3b4b9b3b64";
-      sha256 = "sha256-qn6luuh5wqREu3s8RfuMCP5PKdS2WdwPrujRYTpfzQ8=";
-    };
-    vendorSha256 = "sha256-pQpattmS9VmO3ZIQUFn66az8GSmB4IvYhTTCFn6SUmo=";
-  };
-}

nix/static-haskell-package.nix

@@ -59,7 +59,4 @@ let
   survey =
     import "${patched-static-haskell-nix}/survey" { inherit normalPkgs compiler defaultCabalPackageVersionComingWithGhc; };
 in
-{
+survey.haskellPackages."${name}"
-  inherit survey;
-  package = survey.haskellPackages."${name}";
-}

nix/tools/cabalTools.nix

@@ -37,22 +37,12 @@ let
     checkedShellScript
       {
         name = "postgrest-run";
-        docs = "Run PostgREST after building it interactively with cabal-install";
+        docs = "Run PostgREST after buidling it interactively with cabal-install";
-        args =
+        args = [ "ARG_LEFTOVERS([PostgREST arguments])" ];
-          [
-            "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[@]}"
       '';

nix/tools/devTools.nix

@@ -304,5 +304,4 @@ buildToolbox
     hsieGraphModules
     hsieGraphSymbols
   ];
-  extra = { inherit pushCachix; };
 }

nix/tools/loadtest.nix

@@ -56,14 +56,11 @@ 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} \
-        ${withTools.withSlowPgrst} \
+        sh -c "cd \"$_arg_testdir\" && ${runner} -targets targets.http -output \"$_arg_output\" \"''${_arg_leftovers[@]}\""
-        sh -c "cd \"$_arg_testdir\" && ${runner} -targets targets.http -output \"$abs_output\" \"''${_arg_leftovers[@]}\""
         ${vegeta}/bin/vegeta report -type=text "$_arg_output"
       '';
 

nix/tools/release/default.nix

@@ -72,15 +72,14 @@ let
         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_pre_minor" "$bump_patch" "$bump_minor" "$bump_major"; do
+        select new_version in "$bump_pre" "$bump_patch" "$bump_minor" "$bump_major"; do
           case "$REPLY" in
-            1|2|3|4|5)
+            1|2|3|4)
               echo "Selected $new_version"
               break
               ;;
@@ -96,7 +95,7 @@ let
         echo "Committing ..."
         git add postgrest.cabal > /dev/null
 
-        if [[ "$new_version" != "$bump_pre" && "$new_version" != "$bump_pre_minor" ]]; then
+        if [[ "$new_version" != "$bump_pre" ]]; 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

nix/tools/withTools.nix

@@ -1,7 +1,6 @@
 { bash-completion
 , buildToolbox
 , cabal-install
-, cabalTools
 , checkedShellScript
 , curl
 , devCabalOptions
@@ -9,20 +8,15 @@
 , lib
 , postgresqlVersions
 , postgrest
-, slocat
 , writeText
 }:
 let
   withTmpDb =
     { name, postgresql }:
-    let
-      commandName = "postgrest-with-${name}";
-      superuserRole = "postgres";
-    in
     checkedShellScript
       {
-        name = commandName;
+        name = "postgrest-with-${name}";
-        docs = "Run the given command in a temporary database with ${name}. If you wish to mutate the database, login with the '${superuserRole}' role.";
+        docs = "Run the given command in a temporary database with ${name}";
         args =
           [
             "ARG_OPTIONAL_SINGLE([fixtures], [f], [SQL file to load fixtures from], [test/spec/fixtures/load.sql])"
@@ -31,8 +25,6 @@ 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;
@@ -61,8 +53,6 @@ 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"
@@ -71,13 +61,12 @@ let
         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.
-        # initdb -U creates a superuser(man initdb)
+        PGTZ=UTC initdb --no-locale --encoding=UTF8 --nosync -U "$PGUSER" --auth=trust \
-        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=\"\" -c hba_file=$HBA_FILE -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
@@ -88,17 +77,10 @@ let
         }
         trap stop EXIT
 
-        log "Creating a minimally privileged $PGUSER connection role..."
+        log "Loading fixtures..."
-        createuser "$PGUSER" -U "${superuserRole}" --host="$tmpdir/socket" --no-createdb --no-inherit --no-superuser --no-createrole --no-replication --login
+        psql -v ON_ERROR_STOP=1 -f "$_arg_fixtures" >> "$setuplog"
-
-        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[@]}")
       '';
 
@@ -148,81 +130,6 @@ 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";
@@ -343,23 +250,16 @@ let
         export PGRST_SERVER_UNIX_SOCKET="$tmpdir"/postgrest.socket
 
         rm -f result
-        if [ -z "''${PGRST_BUILD_CABAL:-}" ]; then
+        echo -n "Building postgrest... "
-          echo -n "Building postgrest (nix)... "
+        nix-build -A postgrestPackage > "$tmpdir"/build.log 2>&1 || {
-          nix-build -A postgrestPackage > "$tmpdir"/build.log 2>&1 || {
+          echo "failed, output:"
-            echo "failed, output:"
+          cat "$tmpdir"/build.log
-            cat "$tmpdir"/build.log
+          exit 1
-            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... "
-        $PGRST_CMD ${legacyConfig} > "$tmpdir"/run.log 2>&1 &
+        ./result/bin/postgrest ${legacyConfig} > "$tmpdir"/run.log 2>&1 &
         pid=$!
         # shellcheck disable=SC2317
         cleanup() {
@@ -381,7 +281,7 @@ in
 buildToolbox
 {
   name = "postgrest-with";
-  tools = [ withPgAll withGit withPgrst withSlowPg withSlowPgrst ] ++ withPgVersions;
+  tools = [ withPgAll withGit withPgrst ] ++ withPgVersions;
   # make withTools available for other nix files
-  extra = { inherit withGit withPg withPgAll withPgrst withSlowPg withSlowPgrst; };
+  extra = { inherit withGit withPg withPgAll withPgrst; };
 }

postgrest.cabal

@@ -1,5 +1,5 @@
 name:               postgrest
-version:            11.2.0
+version:            10.2.0
 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,7 @@ library
   default-extensions: OverloadedStrings
                       NoImplicitPrelude
   hs-source-dirs:     src
-  exposed-modules:    PostgREST.Admin
+  exposed-modules:    PostgREST.App
-                      PostgREST.App
                       PostgREST.AppState
                       PostgREST.Auth
                       PostgREST.CLI
@@ -47,9 +46,8 @@ library
                       PostgREST.Cors
                       PostgREST.SchemaCache
                       PostgREST.SchemaCache.Identifiers
-                      PostgREST.SchemaCache.Routine
+                      PostgREST.SchemaCache.Proc
                       PostgREST.SchemaCache.Relationship
-                      PostgREST.SchemaCache.Representations
                       PostgREST.SchemaCache.Table
                       PostgREST.Error
                       PostgREST.Logger
@@ -62,7 +60,6 @@ library
                       PostgREST.Plan.CallPlan
                       PostgREST.Plan.MutatePlan
                       PostgREST.Plan.ReadPlan
-                      PostgREST.Plan.Types
                       PostgREST.RangeQuery
                       PostgREST.ApiRequest
                       PostgREST.ApiRequest.Preferences
@@ -72,6 +69,7 @@ library
                       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.5
@@ -87,13 +85,12 @@ 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.6.1.1 && < 1.7
                     , hasql-dynamic-statements  >= 0.3.1 && < 0.4
                     , hasql-notifications       >= 0.1 && < 0.3
-                    , hasql-pool                >= 0.10 && < 0.11
+                    , hasql-pool                >= 0.9 && < 0.10
                     , hasql-transaction         >= 1.0.1 && < 1.1
                     , heredoc                   >= 0.2 && < 0.3
                     , http-types                >= 0.12.2 && < 0.13
@@ -189,8 +186,6 @@ test-suite spec
                       Feature.CorsSpec
                       Feature.ExtraSearchPathSpec
                       Feature.LegacyGucsSpec
-                      Feature.NoSuperuserSpec
-                      Feature.ObservabilitySpec
                       Feature.OpenApi.DisabledOpenApiSpec
                       Feature.OpenApi.IgnorePrivOpenApiSpec
                       Feature.OpenApi.OpenApiSpec
@@ -215,17 +210,15 @@ 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.2
                     , aeson-qq          >= 0.8.1 && < 0.9
@@ -235,7 +228,7 @@ test-suite spec
                     , bytestring        >= 0.10.8 && < 0.12
                     , case-insensitive  >= 1.2 && < 1.3
                     , containers        >= 0.5.7 && < 0.7
-                    , hasql-pool        >= 0.10 && < 0.11
+                    , hasql-pool        >= 0.9 && < 0.10
                     , hasql-transaction >= 1.0.1 && < 1.1
                     , heredoc           >= 0.2 && < 0.3
                     , hspec             >= 2.3 && < 2.10

src/PostgREST/Admin.hs

@@ -1,87 +0,0 @@
-{-# LANGUAGE NamedFieldPuns  #-}
-{-# LANGUAGE RecordWildCards #-}
-
-module PostgREST.Admin
-  ( runAdmin
-  ) where
-
-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 PostgREST.AppState (AppState)
-import PostgREST.Config   (AppConfig (..))
-
-import qualified PostgREST.AppState as AppState
-
-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
-admin :: AppState.AppState -> AppConfig -> Wai.Application
-admin appState appConfig req respond  = do
-  isMainAppReachable  <- any isRight <$> reachMainApp appConfig
-  isSchemaCacheLoaded <- isJust <$> AppState.getSchemaCache appState
-  isConnectionUp      <-
-    if configDbChannelEnabled appConfig
-      then AppState.getIsListenerOn appState
-      else isRight <$> AppState.usePool appState (SQL.sql "SELECT 1")
-
-  case Wai.pathInfo req of
-    ["ready"] ->
-      respond $ Wai.responseLBS (if isMainAppReachable && isConnectionUp && isSchemaCacheLoaded then HTTP.status200 else HTTP.status503) [] mempty
-    ["live"] ->
-      respond $ Wai.responseLBS (if isMainAppReachable then HTTP.status200 else HTTP.status503) [] mempty
-    _ ->
-      respond $ Wai.responseLBS HTTP.status404 [] mempty
-
--- Try to connect to the main app socket
--- Note that it doesn't even send a valid HTTP request, we just want to check that the main app is accepting connections
--- The code for resolving the "*4", "!4", "*6", "!6", "*" special values is taken from
--- https://hackage.haskell.org/package/streaming-commons-0.2.2.4/docs/src/Data.Streaming.Network.html#bindPortGenEx
-reachMainApp :: AppConfig -> IO [Either IOException ()]
-reachMainApp AppConfig{..} =
-  case configServerUnixSocket of
-    Just path ->  do
-      sock <- socket AF_UNIX Stream 0
-      (:[]) <$> try (do
-        connect sock $ SockAddrUnix path
-        withSocketsDo $ bracket (pure sock) close sendEmpty)
-    Nothing -> do
-      let
-        host | configServerHost `elem` ["*4", "!4", "*6", "!6", "*"] = Nothing
-             | otherwise                                             = Just configServerHost
-        filterAddrs xs =
-          case configServerHost of
-              "*4" -> ipv4Addrs xs ++ ipv6Addrs xs
-              "!4" -> ipv4Addrs xs
-              "*6" -> ipv6Addrs xs ++ ipv4Addrs xs
-              "!6" -> ipv6Addrs xs
-              _    -> xs
-        ipv4Addrs = filter ((/=) AF_INET6 . addrFamily)
-        ipv6Addrs = filter ((==) AF_INET6 . addrFamily)
-
-      addrs <- getAddrInfo (Just $ defaultHints { addrSocketType = Stream }) (T.unpack <$> host) (Just . show $ configServerPort)
-      tryAddr `traverse` filterAddrs addrs
-  where
-    sendEmpty sock = void $ send sock mempty
-    tryAddr :: AddrInfo -> IO (Either IOException ())
-    tryAddr addr = do
-      sock <- socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr)
-      try $ do
-        connect sock $ addrAddress addr
-        withSocketsDo $ bracket (pure sock) close sendEmpty

src/PostgREST/ApiRequest.hs

@@ -3,7 +3,6 @@ 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 #-}
 
@@ -33,33 +32,43 @@ 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 Data.Tree                 (Tree (..))
 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.Preferences  (PreferCount (..),
+                                          PreferParameters (..),
+                                          PreferRepresentation (..),
+                                          PreferResolution (..),
+                                          PreferTransaction (..))
 import PostgREST.ApiRequest.QueryParams  (QueryParams (..))
 import PostgREST.ApiRequest.Types        (ApiRequestError (..),
-                                          RangeError (..))
+                                          RangeError (..),
+                                          SelectItem (..))
 import PostgREST.Config                  (AppConfig (..),
                                           OpenAPIMode (..))
-import PostgREST.MediaType               (MTPlanFormat (..),
+import PostgREST.MediaType               (MTPlanAttrs (..),
+                                          MTPlanFormat (..),
                                           MediaType (..))
 import PostgREST.RangeQuery              (NonnegRange, allRange,
                                           convertToLimitZeroRange,
                                           hasLimitZero,
                                           rangeRequested)
+import PostgREST.SchemaCache             (SchemaCache (..))
 import PostgREST.SchemaCache.Identifiers (FieldName,
                                           QualifiedIdentifier (..),
                                           Schema)
+import PostgREST.SchemaCache.Proc        (ProcDescription (..),
+                                          ProcParam (..), ProcsMap,
+                                          procReturnsScalar)
 
 import qualified PostgREST.ApiRequest.Preferences as Preferences
 import qualified PostgREST.ApiRequest.QueryParams as QueryParams
@@ -81,7 +90,6 @@ data Payload
       -- ^ 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 }
 
@@ -106,9 +114,41 @@ data PathInfo
       }
 -- | The target db object of a user action
 data Target = TargetIdent QualifiedIdentifier
-            | TargetProc{tProc :: QualifiedIdentifier, tpIsRootSpec :: Bool}
+            | 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
@@ -117,60 +157,37 @@ data Target = TargetIdent QualifiedIdentifier
   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
+    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
+  , iRange                :: HM.HashMap Text NonnegRange      -- ^ Requested range of rows within response
-  , iTopLevelRange       :: NonnegRange                      -- ^ Requested range of rows from the top level
+  , iTopLevelRange        :: NonnegRange                      -- ^ Requested range of rows from the top level
-  , iTarget              :: Target                           -- ^ The target, be it calling a proc or accessing a table
+  , iTarget               :: Target                           -- ^ The target, be it calling a proc or accessing a table
-  , iPayload             :: Maybe Payload                    -- ^ Data sent by client and used for mutation actions
+  , iPayload              :: Maybe Payload                    -- ^ Data sent by client and used for mutation actions
-  , iPreferences         :: Preferences.Preferences          -- ^ Prefer header values
+  , iPreferRepresentation :: PreferRepresentation             -- ^ If client wants created items echoed back
-  , iQueryParams         :: QueryParams.QueryParams
+  , iPreferParameters     :: Maybe PreferParameters           -- ^ How to pass parameters to a stored procedure
-  , iColumns             :: S.Set FieldName                  -- ^ parsed colums from &columns parameter and payload
+  , iPreferCount          :: Maybe PreferCount                -- ^ Whether the client wants a result count
-  , iHeaders             :: [(ByteString, ByteString)]       -- ^ HTTP request headers
+  , iPreferResolution     :: Maybe PreferResolution           -- ^ Whether the client wants to UPSERT or ignore records on PK conflict
-  , iCookies             :: [(ByteString, ByteString)]       -- ^ Request Cookies
+  , iPreferTransaction    :: Maybe PreferTransaction          -- ^ Whether the clients wants to commit or rollback the transaction
-  , iPath                :: ByteString                       -- ^ Raw request path
+  , iQueryParams          :: QueryParams.QueryParams
-  , iMethod              :: ByteString                       -- ^ Raw request method
+  , iColumns              :: S.Set FieldName                  -- ^ parsed colums from &columns parameter and payload
-  , iSchema              :: Schema                           -- ^ The request schema. Can vary depending on profile headers.
+  , iHeaders              :: [(ByteString, ByteString)]       -- ^ HTTP request headers
-  , iNegotiatedByProfile :: Bool                             -- ^ If schema was was chosen according to the profile spec https://www.w3.org/TR/dx-prof-conneg/
+  , iCookies              :: [(ByteString, ByteString)]       -- ^ Request Cookies
-  , iAcceptMediaType     :: MediaType                        -- ^ The media type in the Accept header
+  , iPath                 :: ByteString                       -- ^ Raw request path
-  , iContentMediaType    :: MediaType                        -- ^ The media type in the Content-Type header
+  , 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
+  , iBinaryField          :: Maybe FieldName                  -- ^ field used for raw output
   }
 
 -- | Examines HTTP request and translates it into user intent.
-userApiRequest :: AppConfig -> Request -> RequestBody -> Either ApiRequestError ApiRequest
+userApiRequest :: AppConfig -> SchemaCache -> Request -> RequestBody -> Either ApiRequestError ApiRequest
-userApiRequest conf req reqBody = do
+userApiRequest conf sCache req reqBody = do
-  pInfo@PathInfo{..} <- getPathInfo conf $ pathInfo req
+  qPrms <- first QueryParamError $ QueryParams.parse $ rawQueryString req
-  act <- getAction pInfo method
+  pInfo <- getPathInfo conf $ pathInfo req
-  qPrms <- first QueryParamError $ QueryParams.parse (pathIsProc && act `elem` [ActionInvoke InvGet, ActionInvoke InvHead]) $ rawQueryString req
+  act <- getAction pInfo $ requestMethod req
-  (acceptMediaType, contentMediaType) <- getMediaTypes conf hdrs act pInfo
+  mediaTypes <- getMediaTypes conf (requestHeaders req) act pInfo
-  (schema, negotiatedByProfile) <- getSchema conf hdrs method
+  negotiatedSchema <- getSchema conf (requestHeaders req) (requestMethod req)
-  (topLevelRange, ranges) <- getRanges method qPrms hdrs
+  apiRequest conf sCache req reqBody qPrms pInfo act mediaTypes negotiatedSchema
-  (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 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 =
@@ -206,7 +223,7 @@ getAction PathInfo{pathIsProc, pathIsDefSpec} method =
 
 getMediaTypes :: AppConfig -> RequestHeaders -> Action -> PathInfo -> Either ApiRequestError (MediaType, MediaType)
 getMediaTypes conf hdrs action path = do
-   acceptMediaType <- negotiateContent conf action path accepts
+   acceptMediaType <- findAcceptMediaType conf action path accepts
    pure (acceptMediaType, contentMediaType)
   where
     accepts = maybe [MTAny] (map MediaType.decodeMediaType . parseHttpAccept) $ lookupHeader "accept"
@@ -232,71 +249,127 @@ getSchema AppConfig{configDbSchemas} hdrs method = do
     acceptProfile = T.decodeUtf8 <$> lookupHeader "Accept-Profile"
     lookupHeader    = flip lookup hdrs
 
-getRanges :: ByteString -> QueryParams -> RequestHeaders -> Either ApiRequestError (NonnegRange, HM.HashMap Text NonnegRange)
+apiRequest :: AppConfig -> SchemaCache -> Request -> RequestBody -> QueryParams.QueryParams -> PathInfo -> Action -> (MediaType, MediaType) -> (Schema, Bool) -> Either ApiRequestError ApiRequest
-getRanges method QueryParams{qsOrder,qsRanges} hdrs
+apiRequest conf sCache req reqBody queryparams@QueryParams{..} PathInfo{pathName, pathIsProc, pathIsRootSpec, pathIsDefSpec} action (acceptMediaType, contentMediaType) (schema, negotiatedByProfile)
   | isInvalidRange = Left $ InvalidRange (if rangeIsEmpty headerRange then LowerGTUpper else NegativeLimit)
+  | 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 PutLimitNotAllowedError
+  | method == "PUT" && topLevelRange /= allRange = Left PutRangeNotAllowedError
-  | otherwise = Right (topLevelRange, ranges)
+  | otherwise = do
-  where
+     checkedTarget <- target
-    -- According to the RFC (https://www.rfc-editor.org/rfc/rfc9110.html#name-range),
+     bField <- binaryField conf acceptMediaType checkedTarget queryparams
-    -- the Range header must be ignored for all methods other than GET
+     return ApiRequest {
-    headerRange = if method == "GET" then rangeRequested hdrs else allRange
+      iAction = action
-    limitRange = fromMaybe allRange (HM.lookup "limit" qsRanges)
+      , iTarget = checkedTarget
-    headerAndLimitRange = rangeIntersection headerRange limitRange
+      , iRange = ranges
-    -- Bypass all the ranges and send only the limit zero range (0 <= x <= -1) if
+      , iTopLevelRange = topLevelRange
-    -- limit=0 is present in the query params (not allowed for the Range header)
+      , iPayload = relevantPayload
-    ranges = HM.insert "limit" (convertToLimitZeroRange limitRange headerAndLimitRange) qsRanges
+      , iPreferRepresentation = fromMaybe None preferRepresentation
-    -- The only emptyRange allowed is the limit zero range
+      , iPreferParameters = preferParameters
-    isInvalidRange = topLevelRange == emptyRange && not (hasLimitZero limitRange)
+      , iPreferCount = preferCount
-    topLevelRange = fromMaybe allRange $ HM.lookup "limit" ranges -- if no limit is specified, get all the request rows
+      , 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
+      , iSchema = schema
+      , iNegotiatedByProfile = negotiatedByProfile
+      , iAcceptMediaType = acceptMediaType
+      , iBinaryField = bField
+      }
+ where
+  expectParams = pathIsProc && method /= "POST"
 
-getPayload :: RequestBody -> MediaType -> QueryParams.QueryParams -> Action -> PathInfo -> Either ApiRequestError (Maybe Payload, S.Set FieldName)
+  columns = case action of
-getPayload reqBody contentMediaType QueryParams{qsColumns} action PathInfo{pathIsProc}= do
+    ActionMutate MutationCreate -> qsColumns
-  checkedPayload <- if shouldParsePayload then payload else Right Nothing
+    ActionMutate MutationUpdate -> qsColumns
-  let cols = case (checkedPayload, columns) of
+    ActionInvoke InvPost        -> qsColumns
-        (Just ProcessedJSON{payKeys}, _)       -> payKeys
+    _                           -> Nothing
-        (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
+  payloadColumns =
-      (ActionMutate MutationCreate, _)       -> True
+    case (contentMediaType, action) of
-      (ActionInvoke InvPost, _)              -> True
+      (_, ActionInvoke InvGet)  -> S.fromList $ fst <$> qsParams
-      (ActionMutate MutationSingleUpsert, _) -> True
+      (_, ActionInvoke InvHead) -> S.fromList $ fst <$> qsParams
-      (ActionMutate MutationUpdate, _)       -> True
+      (MTUrlEncoded, _)         -> S.fromList $ map (T.decodeUtf8 . fst) $ parseSimpleQuery $ LBS.toStrict reqBody
-      _                                      -> False
+      _ -> 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
 
-    columns = case action of
+  target
-      ActionMutate MutationCreate -> qsColumns
+    | pathIsProc    = (`TargetProc` pathIsRootSpec) <$> callFindProc schema pathName
-      ActionMutate MutationUpdate -> qsColumns
+    | pathIsDefSpec = Right $ TargetDefaultSpec schema
-      ActionInvoke InvPost        -> qsColumns
+    | otherwise     = Right $ TargetIdent $ QualifiedIdentifier schema pathName
-      _                           -> Nothing
+    where
+      callFindProc procSch procNam = findProc
+        (QualifiedIdentifier procSch procNam) payloadColumns (preferParameters == Just SingleObject) (dbProcs sCache)
+        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" (convertToLimitZeroRange limitRange 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)
 
@@ -347,33 +420,117 @@ payloadAttributes raw json =
   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
 
--- | Do content negotiation. i.e. choose a media type based on the intersection of accepted/produced media types.
+requestMediaTypes :: AppConfig -> Action -> PathInfo -> [MediaType]
-negotiateContent :: AppConfig -> Action -> PathInfo -> [MediaType] -> Either ApiRequestError MediaType
+requestMediaTypes conf action path =
-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
+    ActionInspect _ -> [MTOpenAPI, MTApplicationJSON]
-    ActionMutate _  -> defaultMediaTypes
+    ActionInfo      -> [MTTextCSV]
-    ActionInspect _ -> inspectMediaTypes
+    _               -> defaultMediaTypes
   where
-    inspectMediaTypes = [MTOpenAPI, MTApplicationJSON, MTArrayJSONStrip, MTAny]
     invokeMediaTypes =
       defaultMediaTypes
         ++ rawMediaTypes
         ++ [MTOpenAPI | pathIsRootSpec path]
     defaultMediaTypes =
-      [MTApplicationJSON, MTArrayJSONStrip, MTSingularJSON True, MTSingularJSON False, MTGeoJSON, MTTextCSV] ++
+      [MTApplicationJSON, MTSingularJSON, MTGeoJSON, MTTextCSV] ++
-      [MTPlan MTApplicationJSON PlanText mempty | configDbPlanEnabled conf] ++ [MTAny]
+      [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 (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 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)
+
+-- | 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 -> Target -> QueryParams -> Either ApiRequestError (Maybe FieldName)
+binaryField AppConfig{configRawMediaTypes} acceptMediaType target QueryParams{qsSelect}
+  | returnsScalar target && isRawMediaType =
+      Right $ Just "pgrst_scalar"
+  | isRawMediaType =
+      let
+        fieldName = fstFieldName qsSelect
+      in
+      case fieldName of
+        Just fld -> Right $ Just fld
+        Nothing  -> Left $ BinaryFieldError acceptMediaType
+  | otherwise =
+      Right Nothing
+  where
+    isRawMediaType = acceptMediaType `elem` configRawMediaTypes `union` [MTOctetStream, MTTextPlain, MTTextXML] || isRawPlan acceptMediaType
+    isRawPlan mt = case mt of
+      MTPlan (MTPlanAttrs (Just MTOctetStream) _ _) -> True
+      MTPlan (MTPlanAttrs (Just MTTextPlain) _ _)   -> True
+      MTPlan (MTPlanAttrs (Just MTTextXML) _ _)     -> True
+      _                                             -> False
+    returnsScalar :: Target -> Bool
+    returnsScalar (TargetProc proc _) = procReturnsScalar proc
+    returnsScalar _                   = False
+
+    fstFieldName :: [Tree SelectItem] -> Maybe FieldName
+    fstFieldName [Node SelectField{selField=("*", _)} []] = Nothing
+    fstFieldName [Node SelectField{selField=(fld, _)} []] = Just fld
+    fstFieldName _                                        = Nothing

src/PostgREST/ApiRequest/Preferences.hs

@@ -9,7 +9,6 @@
 module PostgREST.ApiRequest.Preferences
   ( Preferences(..)
   , PreferCount(..)
-  , PreferMissing(..)
   , PreferParameters(..)
   , PreferRepresentation(..)
   , PreferResolution(..)
@@ -34,7 +33,6 @@ 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.
@@ -45,7 +43,6 @@ data Preferences
     , preferParameters     :: Maybe PreferParameters
     , preferCount          :: Maybe PreferCount
     , preferTransaction    :: Maybe PreferTransaction
-    , preferMissing        :: Maybe PreferMissing
     }
 
 -- |
@@ -60,19 +57,17 @@ data Preferences
 --     , preferParameters = Nothing
 --     , preferCount = Just ExactCount
 --     , preferTransaction = Nothing
---     , preferMissing = Nothing
 --     }
 --
 -- Multiple headers can also be used:
 --
--- >>> pPrint $ fromHeaders [("Prefer", "resolution=ignore-duplicates"), ("Prefer", "count=exact"), ("Prefer", "missing=null")]
+-- >>> pPrint $ fromHeaders [("Prefer", "resolution=ignore-duplicates"), ("Prefer", "count=exact")]
 -- 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:
@@ -97,25 +92,23 @@ data Preferences
 --
 -- Preferences can be separated by arbitrary amounts of space, lower-case header is also recognized:
 --
--- >>> pPrint $ fromHeaders [("prefer", "count=exact,    tx=commit   ,return=representation , missing=default")]
+-- >>> pPrint $ fromHeaders [("prefer", "count=exact,    tx=commit   ,return=minimal")]
 -- Preferences
 --     { preferResolution = Nothing
---     , preferRepresentation = Just Full
+--     , preferRepresentation = Just None
 --     , preferParameters = Nothing
 --     , preferCount = Just ExactCount
 --     , preferTransaction = Just Commit
---     , preferMissing = Just ApplyDefaults
 --     }
 --
 fromHeaders :: [HTTP.Header] -> Preferences
 fromHeaders headers =
   Preferences
-    { preferResolution     = parsePrefs [MergeDuplicates, IgnoreDuplicates]
+    { preferResolution = parsePrefs [MergeDuplicates, IgnoreDuplicates]
     , preferRepresentation = parsePrefs [Full, None, HeadersOnly]
-    , preferParameters     = parsePrefs [SingleObject]
+    , preferParameters = parsePrefs [SingleObject, MultipleObjects]
-    , preferCount          = parsePrefs [ExactCount, PlannedCount, EstimatedCount]
+    , preferCount = parsePrefs [ExactCount, PlannedCount, EstimatedCount]
-    , preferTransaction    = parsePrefs [Commit, Rollback]
+    , preferTransaction = parsePrefs [Commit, Rollback]
-    , preferMissing        = parsePrefs [ApplyDefaults, ApplyNulls]
     }
   where
     prefHeaders = filter ((==) HTTP.hPrefer . fst) headers
@@ -168,8 +161,6 @@ data PreferRepresentation
   | None        -- ^ Return nothing from the mutated data.
   deriving Eq
 
-instance ToAppliedHeader PreferRepresentation
-
 instance ToHeaderValue PreferRepresentation where
   toHeaderValue Full        = "return=representation"
   toHeaderValue None        = "return=minimal"
@@ -178,10 +169,13 @@ 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
 
+-- TODO: Deprecate params=multiple-objects in next major version
 instance ToHeaderValue PreferParameters where
   toHeaderValue SingleObject    = "params=single-object"
+  toHeaderValue MultipleObjects = "params=multiple-objects"
 
 -- | How to determine the count of (expected) results
 data PreferCount
@@ -210,17 +204,3 @@ instance ToHeaderValue PreferTransaction where
   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"
-
-instance ToAppliedHeader PreferMissing

src/PostgREST/ApiRequest/QueryParams.hs

@@ -30,13 +30,14 @@ 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, sepBy, sepBy1,
+                                      optionMaybe, sepBy1, string,
-                                      string, try, (<?>))
+                                      try, (<?>))
 
 import PostgREST.RangeQuery              (NonnegRange, allRange,
                                           rangeGeq, rangeLimit,
@@ -45,21 +46,35 @@ import PostgREST.SchemaCache.Identifiers (FieldName)
 
 import PostgREST.ApiRequest.Types (EmbedParam (..), EmbedPath, Field,
                                    Filter (..), FtsOperator (..),
-                                   Hint, JoinType (..),
+                                   JoinType (..), JsonOperand (..),
-                                   JsonOperand (..),
                                    JsonOperation (..), JsonPath,
                                    ListVal, LogicOperator (..),
                                    LogicTree (..), OpExpr (..),
-                                   OpQuantifier (..), Operation (..),
+                                   Operation (..),
                                    OrderDirection (..),
                                    OrderNulls (..), OrderTerm (..),
-                                   QPError (..), QuantOperator (..),
+                                   QPError (..), SelectItem (..),
-                                   SelectItem (..),
                                    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
+-- >>> deriving instance Show SelectItem
+
 data QueryParams =
   QueryParams
     { qsCanonical      :: ByteString
@@ -93,45 +108,39 @@ data QueryParams =
 --
 -- The canonical representation of the query string has parameters sorted alphabetically:
 --
--- >>> qsCanonical <$> parse True "a=1&c=3&b=2&d"
+-- >>> 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 False "select=name,location"
+-- >>> qsSelect <$> parse "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"
+-- >>> qsFilters <$> parse "a.b=eq.0"
--- Right [(["a"],Filter {field = ("b",[]), opExpr = OpExpr False (OpQuant OpEqual Nothing "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 False "a.b=noop.0"
+-- >>> qsFilters <$> parse "a.b=noop.0"
--- Left (QPError "\"failed to parse filter (noop.0)\" (line 1, column 1)" "unexpected \"o\" expecting \"not\" or operator (eq, gt, ...)")
+-- Left (QPError "\"failed to parse filter (noop.0)\" (line 1, column 6)" "unknown single value operator noop")
-parse :: Bool -> ByteString -> Either QPError QueryParams
+parse :: ByteString -> Either QPError QueryParams
-parse isRpcGet qs = do
+parse qs =
-  rOrd                      <- pRequestOrder `traverse` order
+  QueryParams
-  rLogic                    <- pRequestLogicTree `traverse` logic
+    canonical
-  rCols                     <- pRequestColumns columns
+    params
-  rSel                      <- pRequestSelect select
+    ranges
-  (rFlts, params)           <- L.partition hasOp <$> pRequestFilter isRpcGet `traverse` filters
+    <$> pRequestOrder `traverse` order
-  (rFltsRoot, rFltsNotRoot) <- pure $ L.partition hasRootFilter rFlts
+    <*> pRequestLogicTree `traverse` logic
-  rOnConflict               <- pRequestOnConflict `traverse` onConflict
+    <*> pRequestColumns columns
-
+    <*> pRequestSelect select
-  let rFltsFields           = S.fromList (fst <$> filters)
+    <*> pRequestFilter `traverse` filters
-      params'               = mapMaybe (\case {(_, Filter (fld, _) (NoOpExpr v)) -> Just (fld,v); _ -> Nothing}) params
+    <*> (fmap snd <$> (pRequestFilter `traverse` filtersRoot))
-      rFltsRoot'            = snd <$> rFltsRoot
+    <*> pRequestFilter `traverse` filtersNotRoot
-
+    <*> pure (S.fromList (fst <$> filters))
-  return $ QueryParams canonical params' ranges rOrd rLogic rCols rSel rFlts rFltsRoot' rFltsNotRoot rFltsFields rOnConflict
+    <*> pRequestOnConflict `traverse` onConflict
   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"
@@ -158,11 +167,32 @@ parse isRpcGet qs = do
     endingIn xx key = lastWord `elem` xx
       where lastWord = L.last $ T.split (== '.') key
 
-    filters = filter (isFilter . fst) nonemptyParams
+    (filters, params) = L.partition isParam filtersAndParams
-    isFilter k = not (endingIn reservedEmbeddable k) && notElem k reserved
+    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)
@@ -179,31 +209,39 @@ parse isRpcGet qs = do
         offsetParams =
           HM.fromList [(k, maybe allRange rangeGeq (readMaybe v)) | (k,v) <- offsets]
 
-simpleOperator :: Parser SimpleOperator
+operator :: Text -> Maybe SimpleOperator
-simpleOperator =
+operator = \case
-  try (string "neq" $> OpNotEqual) <|>
+  "eq"     -> Just OpEqual
-  try (string "cs" $> OpContains) <|>
+  "gte"    -> Just OpGreaterThanEqual
-  try (string "cd" $> OpContained) <|>
+  "gt"     -> Just OpGreaterThan
-  try (string "ov" $> OpOverlap) <|>
+  "lte"    -> Just OpLessThanEqual
-  try (string "sl" $> OpStrictlyLeft) <|>
+  "lt"     -> Just OpLessThan
-  try (string "sr" $> OpStrictlyRight) <|>
+  "neq"    -> Just OpNotEqual
-  try (string "nxr" $> OpNotExtendsRight) <|>
+  "like"   -> Just OpLike
-  try (string "nxl" $> OpNotExtendsLeft) <|>
+  "ilike"  -> Just OpILike
-  try (string "adj" $> OpAdjacent) <?>
+  "cs"     -> Just OpContains
-  "unknown single value operator"
+  "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
 
-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 =
@@ -213,25 +251,11 @@ 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)
--- Parse `id=eq.1`(id, eq.1) into (EmbedPath, Filter)
+pRequestFilter (k, v) = mapError $ (,) <$> path <*> (Filter <$> fld <*> oper)
---
--- >>> 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
+    oper = P.parse (pOpExpr pSingleVal) ("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
 
@@ -290,28 +314,20 @@ pTreePath = do
 -- >>> 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
+-- 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 ',')
+pFieldForest = pFieldTree `sepBy1` lexeme (char ',')
   where
-    pFieldTree =  Node <$> try pSpreadRelationSelect <*> between (char '(') (char ')') pFieldForest <|>
+    pFieldTree :: Parser (Tree SelectItem)
-                  Node <$> try pRelationSelect       <*> between (char '(') (char ')') pFieldForest <|>
+    pFieldTree =  try (Node <$> pRelationSelect <*> between (char '(') (char ')') pFieldForest) <|>
                   Node <$> pFieldSelect <*> pure []
 
+pStar :: Parser Text
+pStar = string "*" $> "*"
+
 -- |
 -- Parse field names
 --
@@ -377,23 +393,6 @@ pFieldName =
 --
 -- >>> 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
@@ -449,12 +448,27 @@ aliasSeparator = char ':' >> notFollowedBy (char ':')
 -- Left (line 1, column 6):
 -- unexpected '>'
 pRelationSelect :: Parser SelectItem
-pRelationSelect = lexeme $ do
+pRelationSelect = lexeme $ try ( do
     alias <- optionMaybe ( try(pFieldName <* aliasSeparator) )
     name <- pFieldName
-    (hint, jType) <- pEmbedParams
+    prm1 <- optionMaybe pEmbedParam
+    prm2 <- optionMaybe pEmbedParam
     try (void $ lookAhead (string "("))
-    return $ SelectRelation name alias hint jType
+    return $ SelectRelation name 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
 
 -- |
 -- Parse regular fields in select
@@ -492,123 +506,43 @@ pRelationSelect = lexeme $ do
 -- unexpected end of input
 -- expecting letter or digit
 pFieldSelect :: Parser SelectItem
-pFieldSelect = lexeme $ try (do
+pFieldSelect = lexeme $
+  try (
+    do
+      alias <- optionMaybe ( try(pFieldName <* aliasSeparator) )
+      fld <- pField
+      cast' <- optionMaybe (string "::" *> pIdentifier)
+      pEnd
+      return $ SelectField fld (toS <$> cast') alias
+  )
+  <|> do
     s <- pStar
     pEnd
-    return $ SelectField (s, []) Nothing Nothing)
+    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):
+-- Left (line 1, column 7):
--- unexpected ")"
+-- unknown single value operator fts()
--- 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
+pOpExpr pSVal = try ( string "not" *> pDelimiter *> (OpExpr True <$> pOperation)) <|> OpExpr False <$> pOperation
-  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, ...)"
+    pOperation = pIn <|> pIs <|> try pFts <|> pOp <?> "operator (eq, gt, ...)"
 
     pIn = In <$> (try (string "in" *> pDelimiter) *> pListVal)
     pIs = Is <$> (try (string "is" *> pDelimiter) *> pTriVal)
 
-    pIsDist = IsDistinctFrom <$> (try (string "isdistinct" *> pDelimiter) *> pSVal)
+    pOp = do
-
+      opStr <- try (P.manyTill anyChar (try pDelimiter))
-    pSimpleOp = do
+      op <- parseMaybe ("unknown single value operator " <> opStr) . operator $ toS opStr
-      op <- simpleOperator
+      Op op <$> pSVal
-      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)
@@ -617,14 +551,15 @@ pOpExpr pSVal = do
           <?> "null or trilean value (unknown, true, false)"
 
     pFts = do
-      op <-  try (string "fts"   $> FilterFts)
+      opStr <- try (P.many (noneOf ".("))
-         <|> try (string "plfts" $> FilterFtsPlain)
+      op <- parseMaybe ("unknown fts operator " <> opStr) . ftsOperator $ toS opStr
-         <|> try (string "phfts" $> FilterFtsPhrase)
-         <|> try (string "wfts"  $> FilterFtsWebsearch)
-
       lang <- optionMaybe $ try (between (char '(') (char ')') pIdentifier)
       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)
@@ -648,119 +583,24 @@ pQuotedValue = toS <$> (char '"' *> many pCharsOrSlashed <* char '"')
 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 ','
+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
-    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)
+    pEnd = try (void $ lookAhead (char ',')) <|>
+           try eof
 
-    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 ')'))

src/PostgREST/ApiRequest/Types.hs

@@ -19,7 +19,6 @@ module PostgREST.ApiRequest.Types
   , NodeName
   , OpExpr(..)
   , Operation (..)
-  , OpQuantifier(..)
   , OrderDirection(..)
   , OrderNulls(..)
   , OrderTerm(..)
@@ -28,7 +27,6 @@ module PostgREST.ApiRequest.Types
   , SingleVal
   , TrileanVal(..)
   , SimpleOperator(..)
-  , QuantOperator(..)
   , FtsOperator(..)
   , SelectItem(..)
   ) where
@@ -36,37 +34,30 @@ module PostgREST.ApiRequest.Types
 import PostgREST.MediaType                (MediaType (..))
 import PostgREST.SchemaCache.Identifiers  (FieldName,
                                            QualifiedIdentifier)
+import PostgREST.SchemaCache.Proc         (ProcDescription (..))
 import PostgREST.SchemaCache.Relationship (Relationship,
                                            RelationshipsMap)
-import PostgREST.SchemaCache.Routine      (Routine (..))
 
 import Protolude
 
--- | The value in `/tbl?select=alias:field::cast`
+-- | The select 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(*)`
+  deriving (Eq)
-  | SpreadRelation
-    { selRelation :: FieldName
-    , selHint     :: Maybe Hint
-    , selJoinType :: Maybe JoinType
-    }
-  deriving (Eq, Show)
 
 data ApiRequestError
   = AmbiguousRelBetween Text Text [Relationship]
-  | AmbiguousRpc [Routine]
+  | AmbiguousRpc [ProcDescription]
   | BinaryFieldError MediaType
   | MediaTypeError [ByteString]
   | InvalidBody ByteString
@@ -76,52 +67,39 @@ data ApiRequestError
   | LimitNoOrderError
   | NotFound
   | NoRelBetween Text Text (Maybe Text) Text RelationshipsMap
-  | NoRpc Text Text [Text] Bool MediaType Bool [QualifiedIdentifier] [Routine]
+  | NoRpc Text Text [Text] Bool MediaType Bool [QualifiedIdentifier] [ProcDescription]
   | NotEmbedded Text
-  | PutLimitNotAllowedError
+  | ParseRequestError Text Text
+  | PutRangeNotAllowedError
   | QueryParamError QPError
-  | RelatedOrderNotToOne Text Text
-  | SpreadNotToOne Text Text
-  | UnacceptableFilter Text
   | UnacceptableSchema [Text]
   | UnsupportedMethod ByteString
-  | ColumnNotFound Text Text
-  deriving Show
 
 data QPError = QPError Text Text
-  deriving Show
 data RangeError
   = NegativeLimit
   | LowerGTUpper
   | OutOfBounds Text Text
-  deriving Show
 
 type NodeName = Text
 type Depth = Integer
 
-data OrderTerm
+data OrderTerm = OrderTerm
-  = OrderTerm
+  { otTerm      :: Field
-    { otTerm      :: Field
+  , otDirection :: Maybe OrderDirection
-    , otDirection :: Maybe OrderDirection
+  , otNullOrder :: Maybe OrderNulls
-    , otNullOrder :: Maybe OrderNulls
+  }
-    }
+  deriving (Eq)
-  | OrderRelationTerm
-    { otRelation  :: FieldName
-    , otRelTerm   :: Field
-    , otDirection :: Maybe OrderDirection
-    , otNullOrder :: Maybe OrderNulls
-    }
-  deriving (Eq, Show)
 
 data OrderDirection
   = OrderAsc
   | OrderDesc
-  deriving (Eq, Show)
+  deriving (Eq)
 
 data OrderNulls
   = OrderNullsFirst
   | OrderNullsLast
-  deriving (Eq, Show)
+  deriving (Eq)
 
 type Field = (FieldName, JsonPath)
 type Cast = Text
@@ -138,7 +116,7 @@ data EmbedParam
 data JoinType
   = JTInner
   | JTLeft
-  deriving (Eq, Show)
+  deriving Eq
 
 -- | Path of the embedded levels, e.g "clients.projects.name=eq.." gives Path
 -- ["clients", "projects"]
@@ -152,7 +130,7 @@ type JsonPath = [JsonOperation]
 data JsonOperation
   = JArrow { jOp :: JsonOperand }
   | J2Arrow { jOp :: JsonOperand }
-  deriving (Eq, Show, Ord)
+  deriving (Eq)
 
 -- | 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
@@ -160,7 +138,7 @@ data JsonOperation
 data JsonOperand
   = JKey { jVal :: Text }
   | JIdx { jVal :: Text }
-  deriving (Eq, Show, Ord)
+  deriving (Eq)
 
 -- | Boolean logic expression tree e.g. "and(name.eq.N,or(id.eq.1,id.eq.2))" is:
 --
@@ -172,36 +150,29 @@ data JsonOperand
 data LogicTree
   = Expr Bool LogicOperator [LogicTree]
   | Stmnt Filter
-  deriving (Eq, Show)
+  deriving (Eq)
 
 data LogicOperator
   = And
   | Or
-  deriving (Eq, Show)
+  deriving Eq
 
-data Filter
+data Filter = Filter
-  = Filter
   { field  :: Field
   , opExpr :: OpExpr
   }
-  deriving (Eq, Show)
+  deriving (Eq)
 
-data OpExpr
+data OpExpr =
-  = OpExpr Bool Operation
+  OpExpr Bool Operation
-  | NoOpExpr Text
+  deriving (Eq)
-  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, Show)
+  deriving (Eq)
 
 type Language = Text
 
@@ -217,23 +188,17 @@ data TrileanVal
   | TriFalse
   | TriNull
   | TriUnknown
-  deriving (Eq, Show)
+  deriving Eq
 
--- Operators that are quantifiable, i.e. they can be used with the any/all modifiers
+data SimpleOperator
-data QuantOperator
   = OpEqual
   | OpGreaterThanEqual
   | OpGreaterThan
   | OpLessThanEqual
   | OpLessThan
+  | OpNotEqual
   | OpLike
   | OpILike
-  | OpMatch
-  | OpIMatch
-  deriving (Eq, Show)
-
-data SimpleOperator
-  = OpNotEqual
   | OpContains
   | OpContained
   | OpOverlap
@@ -242,13 +207,14 @@ data SimpleOperator
   | OpNotExtendsRight
   | OpNotExtendsLeft
   | OpAdjacent
-  deriving (Eq, Show)
+  | OpMatch
+  | OpIMatch
+  deriving Eq
 
---
 -- | Operators for full text search operators
 data FtsOperator
   = FilterFts
   | FilterFtsPlain
   | FilterFtsPhrase
   | FilterFtsWebsearch
-  deriving (Eq, Show)
+  deriving Eq

src/PostgREST/App.hs

@@ -9,6 +9,7 @@ Some of its functionality includes:
 - Producing HTTP Headers according to RFCs.
 - Content Negotiation
 -}
+{-# LANGUAGE LambdaCase      #-}
 {-# LANGUAGE RecordWildCards #-}
 module PostgREST.App
   ( SignalHandlerInstaller
@@ -19,20 +20,18 @@ module PostgREST.App
 
 
 import Control.Monad.Except     (liftEither)
-import Data.Either.Combinators  (mapLeft)
+import Data.Either.Combinators  (mapLeft, whenLeft)
 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.HashMap.Strict        as HM
+import qualified Hasql.Pool                 as SQL
-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.ApiRequest       as ApiRequest
 import qualified PostgREST.ApiRequest.Types as ApiRequestTypes
 import qualified PostgREST.AppState         as AppState
@@ -43,18 +42,18 @@ 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 qualified PostgREST.Workers          as Workers
 
-import PostgREST.ApiRequest          (Action (..), ApiRequest (..),
+import PostgREST.ApiRequest       (Action (..), ApiRequest (..),
-                                      Mutation (..), Target (..))
+                                   Mutation (..), Target (..))
-import PostgREST.AppState            (AppState)
+import PostgREST.AppState         (AppState)
-import PostgREST.Auth                (AuthResult (..))
+import PostgREST.Auth             (AuthResult (..))
-import PostgREST.Config              (AppConfig (..))
+import PostgREST.Config           (AppConfig (..), LogLevel (..))
-import PostgREST.Config.PgVersion    (PgVersion (..))
+import PostgREST.Config.PgVersion (PgVersion (..))
-import PostgREST.Error               (Error)
+import PostgREST.Error            (Error)
-import PostgREST.Query               (DbHandler)
+import PostgREST.Query            (DbHandler)
-import PostgREST.SchemaCache         (SchemaCache (..))
+import PostgREST.SchemaCache      (SchemaCache (..))
-import PostgREST.SchemaCache.Routine (Routine (..))
+import PostgREST.Version          (prettyVersion)
-import PostgREST.Version             (docsVersion, prettyVersion)
 
 import Protolude hiding (Handler)
 
@@ -67,14 +66,14 @@ type SocketRunner = Warp.Settings -> Wai.Application -> FileMode -> FilePath ->
 run :: SignalHandlerInstaller -> Maybe SocketRunner -> AppState -> IO ()
 run installHandlers maybeRunWithSocket appState = do
   conf@AppConfig{..} <- AppState.getConfig appState
-  AppState.connectionWorker appState -- Loads the initial SchemaCache
+  Workers.connectionWorker appState -- Loads the initial SchemaCache
   installHandlers appState
   -- reload schema cache + config on NOTIFY
-  AppState.runListener conf appState
+  Workers.runListener conf appState
 
-  Admin.runAdmin conf appState $ serverSettings conf
+  Workers.runAdmin conf appState $ serverSettings conf
 
-  let app = postgrest conf appState (AppState.connectionWorker appState)
+  let app = postgrest configLogLevel appState (Workers.connectionWorker appState)
 
   case configServerUnixSocket of
     Just socket ->
@@ -98,25 +97,25 @@ serverSettings AppConfig{..} =
     & setServerName ("postgrest/" <> prettyVersion)
 
 -- | PostgREST application
-postgrest :: AppConfig -> AppState.AppState -> IO () -> Wai.Application
+postgrest :: LogLevel -> AppState.AppState -> IO () -> Wai.Application
-postgrest conf appState connWorker =
+postgrest logLevel appState connWorker =
-  Response.traceHeaderMiddleware conf .
   Cors.middleware .
   Auth.middleware appState .
-  Logger.middleware (configLogLevel conf) $
+  Logger.middleware logLevel $
     -- 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
-        appConf <- AppState.getConfig appState -- the config must be read again because it can reload
+        conf <- AppState.getConfig appState
         maybeSchemaCache <- AppState.getSchemaCache appState
         pgVer <- AppState.getPgVersion appState
+        jsonDbS <- AppState.getJsonDbS appState
 
         let
           eitherResponse :: IO (Either Error Wai.Response)
           eitherResponse =
-            runExceptT $ postgrestResponse appState appConf maybeSchemaCache pgVer authResult req
+            runExceptT $ postgrestResponse appState conf maybeSchemaCache jsonDbS pgVer authResult req
 
         response <- either Error.errorResponseFor identity <$> eitherResponse
         -- Launch the connWorker when the connection is down.  The postgrest
@@ -132,11 +131,12 @@ postgrestResponse
   :: AppState.AppState
   -> AppConfig
   -> Maybe SchemaCache
+  -> ByteString
   -> PgVersion
   -> AuthResult
   -> Wai.Request
   -> Handler IO Wai.Response
-postgrestResponse appState conf@AppConfig{..} maybeSchemaCache pgVer authResult@AuthResult{..} req = do
+postgrestResponse appState conf@AppConfig{..} maybeSchemaCache jsonDbS pgVer authResult@AuthResult{..} req = do
   sCache <-
     case maybeSchemaCache of
       Just sCache ->
@@ -148,16 +148,20 @@ postgrestResponse appState conf@AppConfig{..} maybeSchemaCache pgVer authResult@
 
   apiRequest <-
     liftEither . mapLeft Error.ApiRequestError $
-      ApiRequest.userApiRequest conf req body
+      ApiRequest.userApiRequest conf sCache req body
 
   Response.optionalRollback conf apiRequest $
-    handleRequest authResult conf appState (Just authRole /= configDbAnonRole) configDbPreparedStatements pgVer apiRequest sCache
+    handleRequest authResult conf appState (Query.txMode apiRequest) (Just authRole /= configDbAnonRole) configDbPreparedStatements jsonDbS pgVer apiRequest sCache
 
-runDbHandler :: AppState.AppState -> SQL.IsolationLevel -> SQL.Mode -> Bool -> Bool -> DbHandler b -> Handler IO b
+runDbHandler :: AppState.AppState -> SQL.Mode -> Bool -> Bool -> DbHandler b -> Handler IO b
-runDbHandler appState isoLvl mode authenticated prepared handler = do
+runDbHandler appState 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
+    res <- AppState.usePool appState . transaction SQL.ReadCommitted mode $ runExceptT handler
+    whenLeft res (\case
+      SQL.AcquisitionTimeoutUsageError -> AppState.debounceLogAcquisitionTimeout appState -- this can happen rapidly for many requests, so we debounce
+      _ -> pure ())
+    return res
 
   resp <-
     liftEither . mapLeft Error.PgErr $
@@ -165,62 +169,52 @@ runDbHandler appState isoLvl mode authenticated prepared handler = do
 
   liftEither resp
 
-handleRequest :: AuthResult -> AppConfig -> AppState.AppState -> Bool -> Bool -> PgVersion -> ApiRequest -> SchemaCache -> Handler IO Wai.Response
+handleRequest :: AuthResult -> AppConfig -> AppState.AppState -> SQL.Mode -> Bool -> Bool -> ByteString -> PgVersion -> ApiRequest -> SchemaCache -> Handler IO Wai.Response
-handleRequest AuthResult{..} conf appState authenticated prepared pgVer apiReq@ApiRequest{..} sCache =
+handleRequest AuthResult{..} conf appState mode authenticated prepared jsonDbS pgVer apiReq@ApiRequest{..} sCache =
   case (iAction, iTarget) of
     (ActionRead headersOnly, TargetIdent identifier) -> do
-      wrPlan <- liftEither $ Plan.wrappedReadPlan identifier conf sCache apiReq
+      rPlan <- liftEither $ Plan.readPlan identifier conf sCache apiReq
-      resultSet <- runQuery roleIsoLvl (Plan.wrTxMode wrPlan) $ Query.readQuery wrPlan conf apiReq
+      resultSet <- runQuery $ Query.readQuery rPlan 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
+      resultSet <- runQuery $ 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
+      resultSet <- runQuery $ 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
+      resultSet <- runQuery $ 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
+      resultSet <- runQuery $ Query.deleteQuery mrPlan apiReq conf
       return $ Response.deleteResponse apiReq resultSet
 
-    (ActionInvoke invMethod, TargetProc identifier _) -> do
+    (ActionInvoke invMethod, TargetProc proc _) -> do
-      cPlan <- liftEither $ Plan.callReadPlan identifier conf sCache apiReq invMethod
+      cPlan <- liftEither $ Plan.callReadPlan proc conf sCache apiReq
-      resultSet <- runQuery (fromMaybe roleIsoLvl $ pdIsoLvl (Plan.crProc cPlan))(Plan.crTxMode cPlan) $ Query.invokeQuery (Plan.crProc cPlan) cPlan apiReq conf pgVer
+      resultSet <- runQuery $ Query.invokeQuery proc cPlan apiReq conf
-      return $ Response.invokeResponse invMethod (Plan.crProc cPlan) apiReq resultSet
+      return $ Response.invokeResponse invMethod proc apiReq resultSet
 
     (ActionInspect headersOnly, TargetDefaultSpec tSchema) -> do
-      oaiResult <- runQuery roleIsoLvl Plan.inspectPlanTxMode $ Query.openApiQuery sCache pgVer conf tSchema
+      oaiResult <- runQuery $ Query.openApiQuery sCache pgVer conf tSchema
-      return $ Response.openApiResponse (T.decodeUtf8 prettyVersion, docsVersion) headersOnly oaiResult conf sCache iSchema iNegotiatedByProfile
+      return $ Response.openApiResponse headersOnly oaiResult conf sCache iSchema iNegotiatedByProfile
 
-    (ActionInfo, TargetIdent identifier) ->
+    (ActionInfo, _) ->
-      return $ Response.infoIdentResponse identifier sCache
+      return $ Response.infoResponse iTarget 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
   where
-    roleSettings = fromMaybe mempty (HM.lookup authRole $ configRoleSettings conf)
+    runQuery query =
-    roleIsoLvl = HM.findWithDefault SQL.ReadCommitted authRole $ configRoleIsoLvl conf
+      runDbHandler appState mode authenticated prepared $ do
-    runQuery isoLvl mode query =
+        Query.setPgLocals conf authClaims authRole apiReq jsonDbS pgVer
-      runDbHandler appState isoLvl mode authenticated prepared $ do
-        Query.setPgLocals conf authClaims authRole (HM.toList roleSettings) apiReq pgVer
-        Query.runPreReq conf
         query

src/PostgREST/AppState.hs

@@ -1,63 +1,52 @@
-{-# LANGUAGE LambdaCase      #-}
-{-# LANGUAGE NamedFieldPuns  #-}
 {-# LANGUAGE RecordWildCards #-}
 
 module PostgREST.AppState
   ( AppState
   , destroy
+  , flushPool
   , getConfig
   , getSchemaCache
   , getIsListenerOn
+  , getJsonDbS
   , getMainThreadId
   , getPgVersion
   , getRetryNextIn
   , getTime
+  , getWorkerSem
   , init
   , initWithPool
   , logWithZTime
+  , logPgrstError
+  , putConfig
   , putSchemaCache
+  , putIsListenerOn
+  , putJsonDbS
   , putPgVersion
+  , putRetryNextIn
+  , signalListener
   , usePool
-  , loadSchemaCache
+  , waitListener
-  , reReadConfig
+  , debounceLogAcquisitionTimeout
-  , connectionWorker
-  , runListener
   ) where
 
-import qualified Data.ByteString.Char8      as BS
+import qualified Data.ByteString.Lazy as LBS
-import qualified Data.ByteString.Lazy       as LBS
+import qualified Data.Text.Encoding   as T
-import           Data.Either.Combinators    (whenLeft)
+import qualified Hasql.Pool           as SQL
-import qualified Data.Text.Encoding         as T
+import qualified Hasql.Session        as SQL
-import           Hasql.Connection           (acquire)
+import qualified PostgREST.Error      as Error
-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           (AppConfig (..))
-                                          addFallbackAppName,
+import PostgREST.Config.PgVersion (PgVersion (..), minimumPgVersion)
-                                          readAppConfig)
+import PostgREST.SchemaCache      (SchemaCache)
-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
 
@@ -69,8 +58,10 @@ data AppState = AppState
   , statePgVersion                :: IORef PgVersion
   -- | No schema cache at the start. Will be filled in by the connectionWorker
   , stateSchemaCache              :: IORef (Maybe SchemaCache)
-  -- | starts the connection worker with a debounce
+  -- | Cached SchemaCache in json
-  , debouncedConnectionWorker     :: IO ()
+  , stateJsonDbS                  :: IORef ByteString
+  -- | Binary semaphore to make sure just one connectionWorker can run at a time
+  , stateWorkerSem                :: MVar ()
   -- | Binary semaphore used to sync the listener(NOTIFY reload) with the connectionWorker.
   , stateListener                 :: MVar ()
   -- | State of the LISTEN channel, used for the admin server checks
@@ -99,7 +90,8 @@ 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
-    <*> pure (pure ())
+    <*> newIORef mempty
+    <*> newEmptyMVar
     <*> newEmptyMVar
     <*> newIORef False
     <*> newIORef conf
@@ -109,8 +101,7 @@ initWithPool pool conf = do
     <*> newIORef 0
     <*> pure (pure ())
 
-
+  deb <-
-  debLogTimeout <-
     let oneSecond = 1000000 in
     mkDebounce defaultDebounceSettings
        { debounceAction = logPgrstError appState SQL.AcquisitionTimeoutUsageError
@@ -118,15 +109,7 @@ initWithPool pool conf = do
        , debounceEdge = leadingEdge -- logs at the start and the end
        }
 
-  debWorker <-
+  return appState { debounceLogAcquisitionTimeout = deb }
-    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 = destroyPool
@@ -137,17 +120,11 @@ initPool AppConfig{..} =
     configDbPoolSize
     (fromIntegral configDbPoolAcquisitionTimeout)
     (fromIntegral configDbPoolMaxLifetime)
-    (fromIntegral configDbPoolMaxIdletime)
+    (toUtf8 configDbUri)
-    (toUtf8 $ addFallbackAppName prettyVersion configDbUri)
 
 -- | Run an action with a database connection.
 usePool :: AppState -> SQL.Session a -> IO (Either SQL.UsageError a)
-usePool AppState{..} x = do
+usePool AppState{..} = SQL.use statePool
-  res <- SQL.use statePool x
-  whenLeft res (\case
-    SQL.AcquisitionTimeoutUsageError -> debounceLogAcquisitionTimeout -- this can happen rapidly for many requests, so we debounce
-    _                                -> pure ())
-  return res
 
 -- | Flush the connection pool so that any future use of the pool will
 -- use connections freshly established after this call.
@@ -170,8 +147,14 @@ getSchemaCache = readIORef . stateSchemaCache
 putSchemaCache :: AppState -> Maybe SchemaCache -> IO ()
 putSchemaCache appState = atomicWriteIORef (stateSchemaCache appState)
 
-connectionWorker :: AppState -> IO ()
+getJsonDbS :: AppState -> IO ByteString
-connectionWorker = debouncedConnectionWorker
+getJsonDbS = readIORef . stateJsonDbS
+
+putJsonDbS :: AppState -> ByteString -> IO ()
+putJsonDbS appState = atomicWriteIORef (stateJsonDbS appState)
+
+getWorkerSem :: AppState -> MVar ()
+getWorkerSem = stateWorkerSem
 
 getRetryNextIn :: AppState -> IO Int
 getRetryNextIn = readIORef . stateRetryNextIn
@@ -216,263 +199,3 @@ 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

src/PostgREST/Auth.hs

@@ -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   :: BS.ByteString
+  , authRole   :: Text
   }
 
 -- | 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 30
+      JWT.defaultJWTValidationSettings audienceCheck & set JWT.allowedSkew 1
 
     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 $ decodeUtf8 role)
+           { authClaims = mclaims & KM.insert "role" (JSON.toJSON 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 -> BS.ByteString
+    unquoted :: JSON.Value -> Text
-    unquoted (JSON.String t) = encodeUtf8 t
+    unquoted (JSON.String t) = t
-    unquoted v               = LBS.toStrict $ JSON.encode v
+    unquoted v = T.decodeUtf8 . LBS.toStrict $ JSON.encode v
 -- impossible case - just added to please -Wincomplete-patterns
 parseClaims _ _ = return AuthResult { authClaims = KM.empty, authRole = mempty }
 
@@ -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 BS.ByteString
+getRole :: Wai.Request -> Maybe Text
 getRole req = authRole <$> (rightToMaybe =<< getResult req)

src/PostgREST/CLI.hs

@@ -21,6 +21,7 @@ import PostgREST.AppState    (AppState)
 import PostgREST.Config      (AppConfig (..))
 import PostgREST.SchemaCache (querySchemaCache)
 import PostgREST.Version     (prettyVersion)
+import PostgREST.Workers     (reReadConfig)
 
 import qualified PostgREST.App      as App
 import qualified PostgREST.AppState as AppState
@@ -32,7 +33,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 mempty mempty
+    either panic identity <$> Config.readAppConfig mempty cliPath Nothing
 
   -- Per https://github.com/PostgREST/postgrest/issues/268, we want to
   -- explicitly close the connections to PostgreSQL on shutdown.
@@ -42,7 +43,7 @@ main installSignalHandlers runAppWithSocket CLI{cliCommand, cliPath} = do
     AppState.destroy
     (\appState -> case cliCommand of
       CmdDumpConfig -> do
-        when configDbConfig $ AppState.reReadConfig True appState
+        when configDbConfig $ reReadConfig True appState
         putStr . Config.toText =<< AppState.getConfig appState
       CmdDumpSchema -> putStrLn =<< dumpSchema appState
       CmdRun -> App.run installSignalHandlers runAppWithSocket appState)
@@ -50,12 +51,15 @@ main installSignalHandlers runAppWithSocket CLI{cliCommand, cliPath} = do
 -- | Dump SchemaCache schema to JSON
 dumpSchema :: AppState -> IO LBS.ByteString
 dumpSchema appState = do
-  conf@AppConfig{..} <- AppState.getConfig appState
+  AppConfig{..} <- AppState.getConfig appState
   result <-
     let transaction = if configDbPreparedStatements then SQL.transaction else SQL.unpreparedTransaction in
     AppState.usePool appState $
       transaction SQL.ReadCommitted SQL.Read $
-        querySchemaCache conf
+        querySchemaCache
+          (toList configDbSchemas)
+          configDbExtraSearchPath
+          configDbPreparedStatements
   case result of
     Left e -> do
       hPutStrLn stderr $ "An error ocurred when loading the schema cache:\n" <> show e
@@ -80,7 +84,7 @@ readCLIShowHelp =
   where
     prefs = O.prefs $ O.showHelpOnError <> O.showHelpOnEmpty
     opts = O.info parser $ O.fullDesc <> progDesc
-    parser = O.helper <*> versionFlag <*> exampleParser <*> cliParser
+    parser = O.helper <*> exampleParser <*> cliParser
 
     progDesc =
       O.progDesc $
@@ -88,12 +92,6 @@ 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"
@@ -138,9 +136,6 @@ 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"
       |
@@ -159,9 +154,6 @@ exampleConfigFile =
       |## 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"
       |

src/PostgREST/Config.hs

@@ -24,7 +24,6 @@ module PostgREST.Config
   , readPGRSTEnvironment
   , toURI
   , parseSecret
-  , addFallbackAppName
   ) where
 
 import qualified Crypto.JOSE.Types      as JOSE
@@ -33,7 +32,6 @@ 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
@@ -48,15 +46,10 @@ import Data.List               (lookup)
 import Data.List.NonEmpty      (fromList, toList)
 import Data.Maybe              (fromJust)
 import Data.Scientific         (floatingOrInteger)
-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 (..),
@@ -70,7 +63,7 @@ import Protolude hiding (Proxy, toList)
 
 data AppConfig = AppConfig
   { configAppSettings              :: [(Text, Text)]
-  , configDbAnonRole               :: Maybe BS.ByteString
+  , configDbAnonRole               :: Maybe Text
   , configDbChannel                :: Text
   , configDbChannelEnabled         :: Bool
   , configDbExtraSearchPath        :: [Text]
@@ -79,13 +72,11 @@ data AppConfig = AppConfig
   , 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
@@ -103,13 +94,9 @@ data AppConfig = AppConfig
   , 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
@@ -137,7 +124,7 @@ toText conf =
   where
     -- apply conf to all pgrst settings
     pgrstSettings = (\(k, v) -> (k, v conf)) <$>
-      [("db-anon-role",              q . T.decodeUtf8 . fromMaybe "" . configDbAnonRole)
+      [("db-anon-role",              q . fromMaybe "" . configDbAnonRole)
       ,("db-channel",                q . configDbChannel)
       ,("db-channel-enabled",            T.toLower . show . configDbChannelEnabled)
       ,("db-extra-search-path",      q . T.intercalate "," . configDbExtraSearchPath)
@@ -146,13 +133,11 @@ toText conf =
       ,("db-pool",                       show . configDbPoolSize)
       ,("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)
@@ -167,7 +152,6 @@ 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)
@@ -204,13 +188,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 -> RoleSettings -> RoleIsolationLvl -> IO (Either Text AppConfig)
+readAppConfig :: [(Text, Text)] -> Maybe FilePath -> Maybe Text -> IO (Either Text AppConfig)
-readAppConfig dbSettings optPath prevDbUri roleSettings roleIsolationLvl = do
+readAppConfig dbSettings optPath prevDbUri = 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 roleSettings roleIsolationLvl) =<< mapLeft show conf of
+  case C.runParser (parser optPath env dbSettings) =<< mapLeft show conf of
     Left err ->
       return . Left $ "Error in config " <> err
     Right parsedConfig ->
@@ -225,11 +209,11 @@ readAppConfig dbSettings optPath prevDbUri roleSettings roleIsolationLvl = do
       decodeJWKS <$>
         (decodeSecret =<< readSecretFile =<< readDbUriFile prevDbUri parsedConfig)
 
-parser :: Maybe FilePath -> Environment -> [(Text, Text)] -> RoleSettings -> RoleIsolationLvl -> C.Parser C.Config AppConfig
+parser :: Maybe FilePath -> Environment -> [(Text, Text)] -> C.Parser C.Config AppConfig
-parser optPath env dbSettings roleSettings roleIsolationLvl =
+parser optPath env dbSettings =
   AppConfig
     <$> parseAppSettings "app.settings"
-    <*> (fmap encodeUtf8 <$> optString "db-anon-role")
+    <*> optString "db-anon-role"
     <*> (fromMaybe "pgrst" <$> optString "db-channel")
     <*> (fromMaybe True <$> optBool "db-channel-enabled")
     <*> (maybe ["public"] splitOnCommas <$> optValue "db-extra-search-path")
@@ -239,8 +223,6 @@ parser optPath env dbSettings roleSettings roleIsolationLvl =
     <*> (fromMaybe 10 <$> optInt "db-pool")
     <*> (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")
@@ -249,7 +231,6 @@ parser optPath env dbSettings roleSettings roleIsolationLvl =
     <*> (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")
@@ -269,13 +250,9 @@ parser optPath env dbSettings roleSettings roleIsolationLvl =
     <*> (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
@@ -370,14 +347,21 @@ parser optPath env dbSettings roleSettings roleIsolationLvl =
                                (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 dbConf <|> M.lookup envVarName env of
+      case reloadableDbSetting <|> 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)
-        dbConf = lookup (T.pack $ dashToUnderscore <$> toS key) dbSettings
+        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_acquisition_timeout",
+            "db_pool_max_lifetime", "db_config"]
+          then lookup dbSettingName dbSettings
+          else Nothing
 
     coerceText :: C.Value -> Text
     coerceText (C.String s) = s
@@ -464,41 +448,3 @@ 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 "host=localhost port=5432 dbname=postgres"
--- "host=localhost port=5432 dbname=postgres fallback_application_name='PostgREST 11.1.0 (5a04ec7)'"
---
--- >>> addFallbackAppName ver "postgresql://"
--- "postgresql://?fallback_application_name=PostgREST%2011.1.0%20%285a04ec7%29"
---
--- >>> addFallbackAppName strangeVer "host=localhost port=5432 dbname=postgres"
--- "host=localhost port=5432 dbname=postgres fallback_application_name='PostgREST 11\\'1&0@#$%,.:\"[]{}?+^()=asdfqwer'"
---
--- >>> 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 :: ByteString -> Text -> Text
-addFallbackAppName version dbUri = dbUri <>
-  case uriQuery <$> parseURI (toS dbUri) of
-    Nothing  -> " " <> keyValFmt -- Assume key/value connection string if the uri is not valid
-    Just ""  -> "?" <> uriFmt
-    Just "?" -> uriFmt
-    _        -> "&" <> uriFmt
-  where
-    uriFmt = pKeyWord <> toS (escapeURIString isUnescapedInURIComponent $ toS pgrstVer)
-    keyValFmt = pKeyWord <> "'" <> T.replace "'" "\\'" pgrstVer <> "'"
-    pKeyWord = "fallback_application_name="
-    pgrstVer = "PostgREST " <> T.decodeUtf8 version

src/PostgREST/Config/Database.hs

@@ -3,19 +3,11 @@
 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)
@@ -23,174 +15,51 @@ import qualified Hasql.Statement            as SQL
 import qualified Hasql.Transaction          as SQL
 import qualified Hasql.Transaction.Sessions as SQL
 
-import Text.InterpolatedString.Perl6 (q, qc)
+import Text.InterpolatedString.Perl6 (q)
 
 import Protolude
 
-type RoleSettings     = (HM.HashMap ByteString (HM.HashMap ByteString ByteString))
+queryPgVersion :: Session PgVersion
-type RoleIsolationLvl = HM.HashMap ByteString SQL.IsolationLevel
+queryPgVersion = statement mempty pgVersionStatement
 
-toIsolationLevel :: (Eq a, IsString a) => a -> SQL.IsolationLevel
+pgVersionStatement :: SQL.Statement () PgVersion
-toIsolationLevel a = case a of
+pgVersionStatement = SQL.Statement sql HE.noParams versionRow False
-  "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
 
--- | Query the in-database configuration. The settings have the following priorities:
+queryDbSettings :: Bool -> Session [(Text, Text)]
---
+queryDbSettings prepared =
--- 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 dbSettingsNames $ SQL.Statement sql (arrayParam HE.text) decodeSettings prepared
+  transaction SQL.ReadCommitted SQL.Read $ SQL.statement mempty dbSettingsStatement
-  where
-    sql = [qc|
-      WITH
-      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 AS (
-        SELECT database,
-               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, '{prefix}', '') AS key,
-             v AS value
-      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)
+-- | Get db settings from the connection role. Global settings will be overridden by database specific settings.
-queryRoleSettings prepared =
+dbSettingsStatement :: SQL.Statement () [(Text, Text)]
-  let transaction = if prepared then SQL.transaction else SQL.unpreparedTransaction in
+dbSettingsStatement = SQL.Statement sql HE.noParams decodeSettings False
-  transaction SQL.ReadCommitted SQL.Read $ SQL.statement mempty $ SQL.Statement sql HE.noParams (processRows <$> rows) prepared
   where
     sql = [q|
-      with
+      WITH
-      role_setting as (
+      role_setting (database, setting) AS (
-        select r.rolname, unnest(r.rolconfig) as setting
+        SELECT setdatabase,
-        from pg_auth_members m
+               unnest(setconfig)
-        join pg_roles r on r.oid = m.roleid
+          FROM pg_catalog.pg_db_role_setting
-        where member = current_user::regrole::oid
+         WHERE setrole = CURRENT_USER::regrole::oid
+           AND setdatabase IN (0, (SELECT oid FROM pg_catalog.pg_database WHERE datname = CURRENT_CATALOG))
       ),
-      kv_settings AS (
+      kv_settings (database, k, v) AS (
-        SELECT
+        SELECT database,
-          rolname,
+               substr(setting, 1, strpos(setting, '=') - 1),
-          substr(setting, 1, strpos(setting, '=') - 1) as key,
+               substr(setting, strpos(setting, '=') + 1)
-          lower(substr(setting, strpos(setting, '=') + 1)) as value
+          FROM role_setting
-        FROM role_setting
+         WHERE setting LIKE 'pgrst.%'
-      ),
+      )
-      iso_setting AS (
+      SELECT DISTINCT ON (key)
-        SELECT rolname, value
+             replace(k, 'pgrst.', '') AS key,
+             v AS value
         FROM kv_settings
-        WHERE key = 'default_transaction_isolation'
+       ORDER BY key, database DESC;
-      )
-      select
-        kv.rolname,
-        i.value as iso_lvl,
-        array_agg(row(kv.key, kv.value)) filter (where key <> 'default_transation_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;
     |]
-
+    decodeSettings = HD.rowList $ (,) <$> column HD.text <*> column HD.text
-    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

src/PostgREST/Error.hs

@@ -11,6 +11,7 @@ module PostgREST.Error
   , PgError(..)
   , Error(..)
   , errorPayload
+  , checkIsFatal
   , singularityError
   ) where
 
@@ -38,12 +39,12 @@ import qualified PostgREST.MediaType        as MediaType
 
 import PostgREST.SchemaCache.Identifiers  (QualifiedIdentifier (..),
                                            Schema)
+import PostgREST.SchemaCache.Proc         (ProcDescription (..),
+                                           ProcParam (..))
 import PostgREST.SchemaCache.Relationship (Cardinality (..),
                                            Junction (..),
                                            Relationship (..),
                                            RelationshipsMap)
-import PostgREST.SchemaCache.Routine      (Routine (..),
-                                           RoutineParam (..))
 import Protolude
 
 
@@ -67,19 +68,15 @@ instance PgrstError ApiRequestError where
   status InvalidRpcMethod{}      = HTTP.status405
   status InvalidRange{}          = HTTP.status416
   status NotFound                = HTTP.status404
-
   status NoRelBetween{}          = HTTP.status400
   status NoRpc{}                 = HTTP.status404
   status NotEmbedded{}           = HTTP.status400
-  status PutLimitNotAllowedError = HTTP.status400
+  status ParseRequestError{}     = HTTP.status400
+  status PutRangeNotAllowedError = 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]
 
@@ -107,6 +104,11 @@ instance JSON.ToJSON ApiRequestError where
                    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 (ParseRequestError message details) = JSON.object [
+    "code"    .= ApiRequestErrorCode04,
+    "message" .= message,
+    "details" .= details,
+    "hint"    .= JSON.Null]
   toJSON InvalidFilters = JSON.object [
     "code"    .= ApiRequestErrorCode05,
     "message" .= ("Filters must include all and only primary key columns with 'eq' operators" :: Text),
@@ -125,7 +127,7 @@ instance JSON.ToJSON ApiRequestError where
   toJSON NotFound = JSON.object []
   toJSON (NotEmbedded resource) = JSON.object [
     "code"    .= ApiRequestErrorCode08,
-    "message" .= ("'" <> resource <> "' is not an embedded resource in this request" :: Text),
+    "message" .= ("Cannot apply filter because '" <> resource <> "' is not an embedded resource in this request" :: Text),
     "details" .= JSON.Null,
     "hint"    .= ("Verify that '" <> resource <> "' is included in the 'select' query parameter." :: Text)]
 
@@ -141,9 +143,9 @@ instance JSON.ToJSON ApiRequestError where
     "details" .= JSON.Null,
     "hint"    .= JSON.Null]
 
-  toJSON PutLimitNotAllowedError = JSON.object [
+  toJSON PutRangeNotAllowedError = JSON.object [
     "code"    .= ApiRequestErrorCode14,
-    "message" .= ("limit/offset querystring parameters are not allowed for PUT" :: Text),
+    "message" .= ("Range header and limit/offset querystring parameters are not allowed for PUT" :: Text),
     "details" .= JSON.Null,
     "hint"    .= JSON.Null]
 
@@ -153,24 +155,6 @@ instance JSON.ToJSON ApiRequestError where
     "details" .= JSON.Null,
     "hint"    .= JSON.Null]
 
-  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),
@@ -210,11 +194,6 @@ instance JSON.ToJSON ApiRequestError where
     "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:
@@ -282,7 +261,7 @@ noRelBetweenHint parent child schema allRels = ("Perhaps you meant '" <>) <$>
 -- 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"}]}]
+-- >>> let procsDesc = [ProcDescription {pdParams = [ProcParam {ppName="val"}, ProcParam {ppName="param"}, ProcParam {ppName="name"}]}, ProcDescription {pdParams = [ProcParam {ppName="id"}, ProcParam {ppName="attr"}]}]
 --
 -- >>> noRpcHint "api" "test" ["vall", "pqaram", "nam"] procs procsDesc
 -- Just "Perhaps you meant to call the function api.test(name, param, val)"
@@ -299,7 +278,7 @@ noRelBetweenHint parent child schema allRels = ("Perhaps you meant '" <>) <$>
 -- >>> noRpcHint "api" "test" ["noclosealternative"] procs procsDesc
 -- Nothing
 --
-noRpcHint :: Text -> Text -> [Text] -> [QualifiedIdentifier] -> [Routine] -> Maybe Text
+noRpcHint :: Text -> Text -> [Text] -> [QualifiedIdentifier] -> [ProcDescription] -> Maybe Text
 noRpcHint schema procName params allProcs overloadedProcs =
   fmap (("Perhaps you meant to call the function " <> schema <> ".") <>) possibleProcs
   where
@@ -375,7 +354,7 @@ instance JSON.ToJSON SQL.UsageError where
     "hint"    .= JSON.Null]
   toJSON (SQL.SessionUsageError e) = JSON.toJSON e -- SQL.Error
   toJSON SQL.AcquisitionTimeoutUsageError = JSON.object [
-    "code"    .= ConnectionErrorCode03,
+    "code"    .= ConnectionErrorCode00,
     "message" .= ("Timed out acquiring connection from connection pool." :: Text),
     "details" .= JSON.Null,
     "hint"    .= JSON.Null]
@@ -428,7 +407,6 @@ pgErrorStatus authed (SQL.SessionUsageError (SQL.QueryError _ _ (SQL.ResultError
         '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
@@ -446,6 +424,29 @@ pgErrorStatus authed (SQL.SessionUsageError (SQL.QueryError _ _ (SQL.ResultError
 
     _                       -> HTTP.status500
 
+checkIsFatal :: SQL.UsageError -> Maybe Text
+checkIsFatal (SQL.ConnectionUsageError e)
+  | isAuthFailureMessage = Just $ toS failureMessage
+  | otherwise = Nothing
+  where isAuthFailureMessage = "FATAL:  password authentication failed" `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
 
 
 data Error
@@ -478,7 +479,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 False)]
+  headers SingularityError{}     = [MediaType.toContentType MTSingularJSON]
   headers _                      = [MediaType.toContentType MTApplicationJSON]
 
 instance JSON.ToJSON Error where
@@ -530,7 +531,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 ["The result contains", show n, "rows"],
+    "details" .= T.unwords ["Results contain", show n, "rows,", T.decodeUtf8 (MediaType.toMime MTSingularJSON), "requires 1 row"],
     "hint"    .= JSON.Null]
 
   toJSON (PgErr err) = JSON.toJSON err
@@ -552,13 +553,12 @@ data ErrorCode
   = ConnectionErrorCode00
   | ConnectionErrorCode01
   | ConnectionErrorCode02
-  | ConnectionErrorCode03
   -- API Request errors
   | ApiRequestErrorCode00
   | ApiRequestErrorCode01
   | ApiRequestErrorCode02
   | ApiRequestErrorCode03
-  | ApiRequestErrorCode04 -- no longer used (used to be mapped to ParseRequestError)
+  | ApiRequestErrorCode04
   | ApiRequestErrorCode05
   | ApiRequestErrorCode06
   | ApiRequestErrorCode07
@@ -572,15 +572,11 @@ data ErrorCode
   | ApiRequestErrorCode15
   | ApiRequestErrorCode16
   | ApiRequestErrorCode17
-  | ApiRequestErrorCode18
-  | ApiRequestErrorCode19
-  | ApiRequestErrorCode20
   -- Schema Cache errors
   | SchemaCacheErrorCode00
   | SchemaCacheErrorCode01
   | SchemaCacheErrorCode02
   | SchemaCacheErrorCode03
-  | SchemaCacheErrorCode04
   -- JWT authentication errors
   | JWTErrorCode00
   | JWTErrorCode01
@@ -598,7 +594,6 @@ buildErrorCode code = "PGRST" <> case code of
   ConnectionErrorCode00  -> "000"
   ConnectionErrorCode01  -> "001"
   ConnectionErrorCode02  -> "002"
-  ConnectionErrorCode03  -> "003"
 
   ApiRequestErrorCode00  -> "100"
   ApiRequestErrorCode01  -> "101"
@@ -618,15 +613,11 @@ 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"

src/PostgREST/Logger.hs

@@ -26,5 +26,5 @@ middleware logLevel = case logLevel of
       { Wai.outputFormat = Wai.ApacheWithSettings $
           Wai.defaultApacheSettings
             & Wai.setApacheRequestFilter (\_ res -> filterStatus $ Wai.responseStatus res)
-            & Wai.setApacheUserGetter Auth.getRole
+            & Wai.setApacheUserGetter (fmap encodeUtf8 . Auth.getRole)
       }

src/PostgREST/MediaType.hs

@@ -4,13 +4,16 @@ 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)
 
@@ -19,8 +22,7 @@ import Protolude
 -- | Enumeration of currently supported media types
 data MediaType
   = MTApplicationJSON
-  | MTArrayJSONStrip
+  | MTSingularJSON
-  | MTSingularJSON Bool
   | MTGeoJSON
   | MTTextCSV
   | MTTextPlain
@@ -30,32 +32,18 @@ data MediaType
   | MTOctetStream
   | MTAny
   | MTOther ByteString
-  -- TODO MTPlan should only have its options as [Text]. Its ResultAggregate should have the typed attributes.
+  | MTPlan MTPlanAttrs
-  | MTPlan MediaType MTPlanFormat [MTPlanOption]
+  deriving Eq
-  deriving Show
+
-instance Eq MediaType where
+data MTPlanAttrs = MTPlanAttrs (Maybe MediaType) MTPlanFormat [MTPlanOption]
-  MTApplicationJSON    == MTApplicationJSON = True
+instance Eq MTPlanAttrs where
-  MTArrayJSONStrip     == MTArrayJSONStrip  = True
+  MTPlanAttrs {} == MTPlanAttrs {} = True -- we don't care about the attributes when comparing two MTPlan media types
-  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
@@ -68,22 +56,20 @@ toContentType ct = (hContentType, toMime ct <> charset)
 
 -- | Convert from MediaType to a ByteString representing the mime type
 toMime :: MediaType -> ByteString
-toMime MTApplicationJSON      = "application/json"
+toMime MTApplicationJSON = "application/json"
-toMime MTArrayJSONStrip       = "application/vnd.pgrst.array+json;nulls=stripped"
+toMime MTGeoJSON         = "application/geo+json"
-toMime MTGeoJSON              = "application/geo+json"
+toMime MTTextCSV         = "text/csv"
-toMime MTTextCSV              = "text/csv"
+toMime MTTextPlain       = "text/plain"
-toMime MTTextPlain            = "text/plain"
+toMime MTTextXML         = "text/xml"
-toMime MTTextXML              = "text/xml"
+toMime MTOpenAPI         = "application/openapi+json"
-toMime MTOpenAPI              = "application/openapi+json"
+toMime MTSingularJSON    = "application/vnd.pgrst.object+json"
-toMime (MTSingularJSON True)  = "application/vnd.pgrst.object+json;nulls=stripped"
+toMime MTUrlEncoded      = "application/x-www-form-urlencoded"
-toMime (MTSingularJSON False) = "application/vnd.pgrst.object+json"
+toMime MTOctetStream     = "application/octet-stream"
-toMime MTUrlEncoded           = "application/x-www-form-urlencoded"
+toMime MTAny             = "*/*"
-toMime MTOctetStream          = "application/octet-stream"
+toMime (MTOther ct)      = ct
-toMime MTAny                  = "*/*"
+toMime (MTPlan (MTPlanAttrs mt fmt opts)) =
-toMime (MTOther ct)           = ct
-toMime (MTPlan mt fmt opts)   =
   "application/vnd.pgrst.plan+" <> toMimePlanFormat fmt <>
-  ("; for=\"" <> toMime mt <> "\"") <>
+  (if isNothing mt then mempty else "; for=\"" <> toMime (fromJust mt) <> "\"") <>
   (if null opts then mempty else "; options=" <> BS.intercalate "|" (toMimePlanOption <$> opts))
 
 toMimePlanOption :: MTPlanOption -> ByteString
@@ -97,72 +83,42 @@ toMimePlanFormat :: MTPlanFormat -> ByteString
 toMimePlanFormat PlanJSON = "json"
 toMimePlanFormat PlanText = "text"
 
--- | Convert from ByteString to MediaType.
+-- | Convert from ByteString to MediaType. Warning: discards MIME parameters
---
--- >>> 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/json":_                   -> MTApplicationJSON
-    "application/geo+json":_                 -> MTGeoJSON
+    "application/geo+json":_               -> MTGeoJSON
-    "text/csv":_                             -> MTTextCSV
+    "text/csv":_                           -> MTTextCSV
-    "text/plain":_                           -> MTTextPlain
+    "text/plain":_                         -> MTTextPlain
-    "text/xml":_                             -> MTTextXML
+    "text/xml":_                           -> MTTextXML
-    "application/openapi+json":_             -> MTOpenAPI
+    "application/openapi+json":_           -> MTOpenAPI
-    "application/x-www-form-urlencoded":_    -> MTUrlEncoded
+    "application/vnd.pgrst.object+json":_  -> MTSingularJSON
-    "application/octet-stream":_             -> MTOctetStream
+    "application/vnd.pgrst.object":_       -> MTSingularJSON
-    "application/vnd.pgrst.plan":rest        -> getPlan PlanText rest
+    "application/x-www-form-urlencoded":_  -> MTUrlEncoded
-    "application/vnd.pgrst.plan+text":rest   -> getPlan PlanText rest
+    "application/octet-stream":_           -> MTOctetStream
-    "application/vnd.pgrst.plan+json":rest   -> getPlan PlanJSON rest
+    "application/vnd.pgrst.plan":rest      -> getPlan PlanText rest
-    "application/vnd.pgrst.object+json":rest -> checkSingularNullStrip rest
+    "application/vnd.pgrst.plan+text":rest -> getPlan PlanText rest
-    "application/vnd.pgrst.object":rest      -> checkSingularNullStrip rest
+    "application/vnd.pgrst.plan+json":rest -> getPlan PlanJSON rest
-    "application/vnd.pgrst.array+json":rest  -> checkArrayNullStrip rest
+    "*/*":_                                -> MTAny
-    "*/*":_                                  -> MTAny
+    other:_                                -> MTOther other
-    other:_                                  -> MTOther other
+    _                                      -> MTAny
-    _                                        -> MTAny
   where
-    checkArrayNullStrip ["nulls=stripped"] = MTArrayJSONStrip
-    checkArrayNullStrip  _                 = MTApplicationJSON
-
-    checkSingularNullStrip ["nulls=stripped"] = MTSingularJSON True
-    checkSingularNullStrip  _                 = MTSingularJSON False
-
     getPlan fmt rest =
-      let
+     let
-        opts         = BS.split (BS.c2w '|') $ fromMaybe mempty (BS.stripPrefix "options=" =<< find (BS.isPrefixOf "options=") rest)
+       opts         = BS.split (BS.c2w '|') $ fromMaybe mempty (BS.stripPrefix "options=" =<< find (BS.isPrefixOf "options=") rest)
-        inOpts str   = str `elem` opts
+       inOpts str   = str `elem` opts
-        dropAround p = BS.dropWhile p . BS.dropWhileEnd p
+       mtFor        = decodeMediaType . dropAround (== BS.c2w '"') <$> (BS.stripPrefix "for=" =<< find (BS.isPrefixOf "for=") rest)
-        mtFor        = fromMaybe MTApplicationJSON $ do
+       dropAround p = BS.dropWhile p . BS.dropWhileEnd p in
-          foundFor    <- find (BS.isPrefixOf "for=") rest
+     MTPlan $ MTPlanAttrs mtFor fmt $
-          strippedFor <- BS.stripPrefix "for=" foundFor
+      [PlanAnalyze  | inOpts "analyze" ] ++
-          pure . decodeMediaType $ dropAround (== BS.c2w '"') strippedFor
+      [PlanVerbose  | inOpts "verbose" ] ++
-      in
+      [PlanSettings | inOpts "settings"] ++
-      MTPlan mtFor fmt $
+      [PlanBuffers  | inOpts "buffers" ] ++
-        [PlanAnalyze  | inOpts "analyze" ] ++
+      [PlanWAL      | inOpts "wal"     ]
-        [PlanVerbose  | inOpts "verbose" ] ++
+
-        [PlanSettings | inOpts "settings"] ++
+getMediaType :: MediaType -> MediaType
-        [PlanBuffers  | inOpts "buffers" ] ++
+getMediaType mt = case mt of
-        [PlanWAL      | inOpts "wal"     ]
+  MTPlan (MTPlanAttrs (Just mType) _ _) -> mType
+  MTPlan (MTPlanAttrs Nothing _ _)      -> MTApplicationJSON
+  other                                 -> other

src/PostgREST/Plan.hs

@@ -16,350 +16,107 @@ resource.
 {-# LANGUAGE RecordWildCards       #-}
 
 module PostgREST.Plan
-  ( wrappedReadPlan
+  ( readPlan
   , 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           as HM
+import qualified Data.Set                   as S
-import qualified Data.HashMap.Strict.InsOrd    as HMI
+import qualified PostgREST.SchemaCache.Proc as Proc
-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.Either.Combinators (mapLeft)
 import Data.List               (delete)
 import Data.Tree               (Tree (..))
 
-import PostgREST.ApiRequest                  (Action (..),
+import PostgREST.ApiRequest               (Action (..),
-                                              ApiRequest (..),
+                                           ApiRequest (..),
-                                              InvokeMethod (..),
+                                           InvokeMethod (..),
-                                              Mutation (..),
+                                           Mutation (..),
-                                              Payload (..))
+                                           Payload (..))
-import PostgREST.Config                      (AppConfig (..))
+import PostgREST.Config                   (AppConfig (..))
-import PostgREST.Error                       (Error (..))
+import PostgREST.Error                    (Error (..))
-import PostgREST.MediaType                   (MediaType (..))
+import PostgREST.Query.SqlFragment        (sourceCTEName)
-import PostgREST.Query.SqlFragment           (sourceCTEName)
+import PostgREST.RangeQuery               (NonnegRange, allRange,
-import PostgREST.RangeQuery                  (NonnegRange, allRange,
+                                           convertToLimitZeroRange,
-                                              convertToLimitZeroRange,
+                                           restrictRange)
-                                              restrictRange)
+import PostgREST.SchemaCache              (SchemaCache (..))
-import PostgREST.SchemaCache                 (SchemaCache (..))
+import PostgREST.SchemaCache.Identifiers  (FieldName,
-import PostgREST.SchemaCache.Identifiers     (FieldName,
+                                           QualifiedIdentifier (..),
-                                              QualifiedIdentifier (..),
+                                           Schema)
-                                              Schema)
+import PostgREST.SchemaCache.Proc         (ProcDescription (..),
-import PostgREST.SchemaCache.Relationship    (Cardinality (..),
+                                           ProcParam (..),
-                                              Junction (..),
+                                           procReturnsScalar)
-                                              Relationship (..),
+import PostgREST.SchemaCache.Relationship (Cardinality (..),
-                                              RelationshipsMap,
+                                           Junction (..),
-                                              relIsToOne)
+                                           Relationship (..),
-import PostgREST.SchemaCache.Representations (DataRepresentation (..),
+                                           RelationshipsMap)
-                                              RepresentationsMap)
+import PostgREST.SchemaCache.Table        (tablePKCols)
-import PostgREST.SchemaCache.Routine         (ResultAggregate (..),
+
-                                              Routine (..),
+import PostgREST.Plan.CallPlan
-                                              RoutineMap,
+import PostgREST.Plan.MutatePlan
-                                              RoutineParam (..),
+import PostgREST.Plan.ReadPlan   as ReadPlan
-                                              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
+  return $ MutateReadPlan rPlan mPlan
 
-callReadPlan :: QualifiedIdentifier -> AppConfig -> SchemaCache -> ApiRequest -> InvokeMethod -> Either Error CallReadPlan
+callReadPlan :: ProcDescription -> AppConfig -> SchemaCache -> ApiRequest -> Either Error CallReadPlan
-callReadPlan identifier conf sCache apiRequest invMethod = do
+callReadPlan proc conf sCache apiRequest = do
-  let paramKeys = case invMethod of
+  let identifier = QualifiedIdentifier (pdSchema proc) (fromMaybe (pdName proc) $ Proc.procTableName proc)
-        InvGet  -> S.fromList $ fst <$> qsParams'
+  rPlan <- readPlan identifier conf sCache apiRequest
-        InvHead -> S.fromList $ fst <$> qsParams'
+  let cPlan = callPlan proc apiRequest rPlan
-        InvPost -> iColumns apiRequest
+  return $ CallReadPlan rPlan cPlan
-  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
-
-resolveTableField :: Table -> Field -> CoercibleField
-resolveTableField table (fieldName, []) = resolveTableFieldName table fieldName
-resolveTableField table (fieldName, jp) =
-  case resolveTableFieldName table fieldName 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}
-    cf@CoercibleField{cfIRType="jsonb"} -> cf{cfJsonPath=jp}
-    -- other types will get converted `to_jsonb(col)->attr`
-    cf                                  -> cf{cfJsonPath=jp, cfToJson=True}
-
--- | 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{..} field@(fn, jp) =
-  fromMaybe (unknownField fn jp) $ HM.lookup qi tables >>=
-    Just . flip resolveTableField field
-
--- | 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  =
+readPlan qi@QualifiedIdentifier{..} AppConfig{configDbMaxRows} SchemaCache{dbRelationships} apiRequest  =
-  let
+  mapLeft ApiRequestError $
-    -- JSON output format hardcoded for now. In the future we might want to support other output mappings such as CSV.
+  treeRestrictRange configDbMaxRows (iAction apiRequest) =<<
-    ctx = ResolverContext dbTables dbRepresentations qi "json"
+  addRels qiSchema (iAction apiRequest) dbRelationships Nothing =<<
-  in
+  addLogicTrees apiRequest =<<
-    mapLeft ApiRequestError $
+  addRanges apiRequest =<<
-    treeRestrictRange configDbMaxRows (iAction apiRequest) =<<
+  addOrders apiRequest =<<
-    addNullEmbedFilters =<<
+  addFilters apiRequest (initReadRequest qi $ QueryParams.qsSelect $ iQueryParams apiRequest)
-    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 :: QualifiedIdentifier -> [Tree SelectItem] -> ReadPlanTree
-initReadRequest ctx@ResolverContext{qi=QualifiedIdentifier{..}} =
+initReadRequest qi@QualifiedIdentifier{..} =
-  foldr (treeEntry rootDepth) $ Node defReadPlan{from=qi ctx, relName=qiName, depth=rootDepth} []
+  foldr (treeEntry rootDepth) $ Node defReadPlan{from=qi, relName=qiName, depth=rootDepth} []
   where
     rootDepth = 0
-    defReadPlan = ReadPlan [] (QualifiedIdentifier mempty mempty) Nothing [] [] allRange mempty Nothing [] Nothing mempty Nothing Nothing False rootDepth
+    defReadPlan = ReadPlan [] (QualifiedIdentifier mempty mempty) Nothing [] [] allRange mempty Nothing [] Nothing mempty Nothing Nothing rootDepth
     treeEntry :: Depth -> Tree SelectItem -> ReadPlanTree -> ReadPlanTree
-    treeEntry depth (Node si fldForest) (Node q rForest) =
+    treeEntry depth (Node SelectRelation{..} fldForest) (Node q rForest) =
       let nxtDepth = succ depth in
-      case si of
+        Node q $
-        SelectRelation{..} ->
+          foldr (treeEntry nxtDepth)
-          Node q $
+          (Node defReadPlan{from=QualifiedIdentifier qiSchema selRelation, relName=selRelation, relAlias=selAlias, relHint=selHint, relJoinType=selJoinType, depth=nxtDepth} [])
-            foldr (treeEntry nxtDepth)
+          fldForest:rForest
-            (Node defReadPlan{from=QualifiedIdentifier qiSchema selRelation, relName=selRelation, relAlias=selAlias, relHint=selHint, relJoinType=selJoinType, depth=nxtDepth} [])
+    treeEntry _ (Node SelectField{..} _) (Node q rForest) = Node q{select=(selField, selCast, selAlias):select q} rForest
-            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
@@ -395,7 +152,7 @@ addRels schema action allRels parentNode (Node rPlan@ReadPlan{relName,relHint,re
       Node <$> newReadPlan <*> (updateForest . hush $ Node <$> newReadPlan <*> pure forest)
     Nothing -> -- root case
       let
-        newFrom  = QualifiedIdentifier mempty sourceCTEName
+        newFrom  = QualifiedIdentifier mempty $ decodeUtf8 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,
@@ -485,9 +242,7 @@ findRel schema allRels origin target hint =
             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(*)
@@ -516,23 +271,25 @@ findRel schema allRels origin target hint =
             )
       ) $ fromMaybe mempty $ HM.lookup (QualifiedIdentifier schema origin, schema) allRels
 
-addFilters :: ResolverContext -> ApiRequest -> ReadPlanTree -> Either ApiRequestError ReadPlanTree
+addFilters :: ApiRequest -> ReadPlanTree -> Either ApiRequestError ReadPlanTree
-addFilters ctx ApiRequest{..} rReq =
+addFilters ApiRequest{..} rReq =
   foldr addFilterToNode (Right rReq) flts
   where
     QueryParams.QueryParams{..} = iQueryParams
     flts =
       case iAction of
-        ActionInvoke _ -> qsFilters
+        ActionInvoke InvGet  -> qsFilters
-        ActionRead _   -> qsFilters
+        ActionInvoke InvHead -> qsFilters
-        _              -> qsFiltersNotRoot
+        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)
+      updateNode (\flt (Node q@ReadPlan{where_=lf} f) -> Node q{ReadPlan.where_=addFilterToLogicForest flt lf}  f)
 
-addOrders :: ResolverContext -> ApiRequest -> ReadPlanTree -> Either ApiRequestError ReadPlanTree
+addOrders :: ApiRequest -> ReadPlanTree -> Either ApiRequestError ReadPlanTree
-addOrders ctx ApiRequest{..} rReq =
+addOrders ApiRequest{..} rReq =
   case iAction of
     ActionMutate _ -> Right rReq
     _              -> foldr addOrderToNode (Right rReq) qsOrder
@@ -540,115 +297,7 @@ addOrders ctx ApiRequest{..} rReq =
     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)
+    addOrderToNode = updateNode (\o (Node q f) -> Node q{order=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 =
@@ -662,30 +311,14 @@ addRanges ApiRequest{..} rReq =
     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 :: ApiRequest -> ReadPlanTree -> Either ApiRequestError ReadPlanTree
-addLogicTrees ctx ApiRequest{..} rReq =
+addLogicTrees 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)
+    addLogicTreeToNode = updateNode (\t (Node q@ReadPlan{where_=lf} f) -> Node q{ReadPlan.where_=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
@@ -702,65 +335,52 @@ updateNode f (targetNodeName:remainingPath, a) (Right (Node rootNode forest)) =
     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 $
+mutatePlan mutation qi ApiRequest{..} sCache readReq = mapLeft ApiRequestError $
   case mutation of
     MutationCreate ->
-      mapRight (\typedColumns -> Insert qi typedColumns body ((,) <$> preferResolution <*> Just confCols) [] returnings pkCols applyDefaults) typedColumnsOrError
+      Right $ Insert qi iColumns body ((,) <$> iPreferResolution <*> Just confCols) [] returnings pkCols
-    MutationUpdate ->
+    MutationUpdate -> Right $ Update qi iColumns body combinedLogic iTopLevelRange rootOrder returnings
-      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
+              Filter _ (OpExpr False (Op OpEqual _)) -> True
-              _                                                   -> False) qsFiltersRoot
+              _                                      -> False) qsFiltersRoot
-          then mapRight (\typedColumns -> Insert qi typedColumns body (Just (MergeDuplicates, pkCols)) combinedLogic returnings mempty False) typedColumnsOrError
+          then Right $ Insert qi iColumns body (Just (MergeDuplicates, pkCols)) combinedLogic returnings mempty
         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
+      if iPreferRepresentation == None
         then []
         else inferColsEmbedNeeds readReq pkCols
-    tbl = HM.lookup qi dbTables
+    pkCols = maybe mempty tablePKCols $ HM.lookup qi $ dbTables sCache
-    pkCols = maybe mempty tablePKCols tbl
+    logic = map snd qsLogic
-    logic = map (resolveLogicTree ctx . snd) qsLogic
+    rootOrder = maybe [] snd $ find (\(x, _) -> null x) qsOrder
-    rootOrder = resolveOrder ctx <$> maybe [] snd (find (\(x, _) -> null x) qsOrder)
+    combinedLogic = foldr addFilterToLogicForest logic qsFiltersRoot
-    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
+callPlan :: ProcDescription -> ApiRequest -> ReadPlanTree -> CallPlan
-resolveOrError _ Nothing _ = Left NotFound
+callPlan proc apiReq readReq = FunctionCall {
-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
+, funCArgs = payRaw <$> iPayload apiReq
-, funCScalar = funcReturnsScalar proc
+, funCScalar = procReturnsScalar proc
-, funCSetOfScalar = funcReturnsSetOfScalar proc
+, funCMultipleCall = iPreferParameters apiReq == Just MultipleObjects
-, funCRetCompositeAlias = funcReturnsCompositeAlias proc
 , funCReturning = inferColsEmbedNeeds readReq []
 }
   where
-    paramsAsSingleObject = preferParameters == Just SingleObject
+    paramsAsSingleObject = iPreferParameters apiReq == 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
+    specifiedParams = filter (\x -> ppName x `S.member` iColumns apiReq)
 
 -- | Infers the columns needed for an embed to be successful after a mutation or a function call.
 inferColsEmbedNeeds :: ReadPlanTree -> [FieldName] -> [FieldName]
@@ -770,7 +390,7 @@ inferColsEmbedNeeds (Node ReadPlan{select} forest) pkCols
   | "*" `elem` fldNames = ["*"]
   | otherwise           = returnings
   where
-    fldNames = cfName . (\(f, _, _) -> f) <$> select
+    fldNames = (\((fld, _), _, _) -> fld) <$> 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
@@ -809,67 +429,5 @@ inferColsEmbedNeeds (Node ReadPlan{select} forest) pkCols
 
 -- 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 :: Filter -> [LogicTree] -> [LogicTree]
-addFilterToLogicForest flt lf = CoercibleStmnt flt : lf
+addFilterToLogicForest flt lf = Stmnt 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

src/PostgREST/Plan/CallPlan.hs

@@ -1,57 +1,25 @@
-{-# 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 (..),
+import           PostgREST.SchemaCache.Proc        (ProcParam (..))
-                                                    RoutineParam (..))
 
 import Protolude
 
 data CallPlan = FunctionCall
-  { funCQi                :: QualifiedIdentifier
+  { funCQi           :: QualifiedIdentifier
-  , funCParams            :: CallParams
+  , funCParams       :: CallParams
-  , funCArgs              :: Maybe LBS.ByteString
+  , funCArgs         :: Maybe LBS.ByteString
-  , funCScalar            :: Bool
+  , funCScalar       :: Bool
-  , funCSetOfScalar       :: Bool
+  , funCMultipleCall :: Bool
-  , funCRetCompositeAlias :: Bool
+  , funCReturning    :: [FieldName]
-  , funCReturning         :: [FieldName]
   }
 
 data CallParams
-  = KeyParams [RoutineParam] -- ^ Call with key params: func(a := val1, b:= val2)
+  = KeyParams [ProcParam] -- ^ Call with key params: func(a := val1, b:= val2)
-  | OnePosParam RoutineParam -- ^ Call with positional params(only one supported): func(val)
+  | OnePosParam ProcParam -- ^ 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

src/PostgREST/Plan/MutatePlan.hs

@@ -4,43 +4,39 @@ module PostgREST.Plan.MutatePlan
 where
 
 import qualified Data.ByteString.Lazy as LBS
+import qualified Data.Set             as S
 
 import PostgREST.ApiRequest.Preferences  (PreferResolution)
-import PostgREST.Plan.Types              (CoercibleField,
+import PostgREST.ApiRequest.Types        (LogicTree, OrderTerm)
-                                          CoercibleLogicTree,
-                                          CoercibleOrderTerm)
 import PostgREST.RangeQuery              (NonnegRange)
 import PostgREST.SchemaCache.Identifiers (FieldName,
                                           QualifiedIdentifier)
 
-
 import Protolude
 
 data MutatePlan
   = Insert
       { in_        :: QualifiedIdentifier
-      , insCols    :: [CoercibleField]
+      , insCols    :: S.Set FieldName
       , insBody    :: Maybe LBS.ByteString
       , onConflict :: Maybe (PreferResolution, [FieldName])
-      , where_     :: [CoercibleLogicTree]
+      , where_     :: [LogicTree]
       , returning  :: [FieldName]
       , insPkCols  :: [FieldName]
-      , applyDefs  :: Bool
       }
   | Update
       { in_       :: QualifiedIdentifier
-      , updCols   :: [CoercibleField]
+      , updCols   :: S.Set FieldName
       , updBody   :: Maybe LBS.ByteString
-      , where_    :: [CoercibleLogicTree]
+      , where_    :: [LogicTree]
       , mutRange  :: NonnegRange
-      , mutOrder  :: [CoercibleOrderTerm]
+      , mutOrder  :: [OrderTerm]
       , returning :: [FieldName]
-      , applyDefs :: Bool
       }
   | Delete
       { in_       :: QualifiedIdentifier
-      , where_    :: [CoercibleLogicTree]
+      , where_    :: [LogicTree]
       , mutRange  :: NonnegRange
-      , mutOrder  :: [CoercibleOrderTerm]
+      , mutOrder  :: [OrderTerm]
       , returning :: [FieldName]
       }

src/PostgREST/Plan/ReadPlan.hs

@@ -6,11 +6,9 @@ module PostgREST.Plan.ReadPlan
 
 import Data.Tree (Tree (..))
 
-import PostgREST.ApiRequest.Types         (Alias, Cast, Depth, Hint,
+import PostgREST.ApiRequest.Types         (Alias, Cast, Depth, Field,
-                                           JoinType, NodeName)
+                                           Hint, JoinType, LogicTree,
-import PostgREST.Plan.Types               (CoercibleField (..),
+                                           NodeName, OrderTerm)
-                                           CoercibleLogicTree,
-                                           CoercibleOrderTerm)
 import PostgREST.RangeQuery               (NonnegRange)
 import PostgREST.SchemaCache.Identifiers  (FieldName,
                                            QualifiedIdentifier)
@@ -25,14 +23,14 @@ data JoinCondition =
   JoinCondition
     (QualifiedIdentifier, FieldName)
     (QualifiedIdentifier, FieldName)
-  deriving (Eq, Show)
+  deriving (Eq)
 
 data ReadPlan = ReadPlan
-  { select       :: [(CoercibleField, Maybe Cast, Maybe Alias)]
+  { select       :: [(Field, Maybe Cast, Maybe Alias)]
   , from         :: QualifiedIdentifier
   , fromAlias    :: Maybe Alias
-  , where_       :: [CoercibleLogicTree]
+  , where_       :: [LogicTree]
-  , order        :: [CoercibleOrderTerm]
+  , order        :: [OrderTerm]
   , range_       :: NonnegRange
   , relName      :: NodeName
   , relToParent  :: Maybe Relationship
@@ -41,8 +39,7 @@ data ReadPlan = ReadPlan
   , relAggAlias  :: Alias
   , relHint      :: Maybe Hint
   , relJoinType  :: Maybe JoinType
-  , relIsSpread  :: Bool
   , depth        :: Depth
   -- ^ used for aliasing
   }
-  deriving (Eq, Show)
+  deriving (Eq)

src/PostgREST/Plan/Types.hs

@@ -1,67 +0,0 @@
-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)

src/PostgREST/Query.hs

@@ -7,16 +7,15 @@ module PostgREST.Query
   , openApiQuery
   , readQuery
   , singleUpsertQuery
+  , txMode
   , 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
@@ -25,19 +24,24 @@ 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 Hasql.Transaction.Sessions        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 qualified PostgREST.SchemaCache.Proc   as Proc
 
 import Data.Scientific (FPFormat (..), formatScientific, isInteger)
 
-import PostgREST.ApiRequest              (ApiRequest (..))
+import PostgREST.ApiRequest              (Action (..),
+                                          ApiRequest (..),
+                                          InvokeMethod (..),
+                                          Target (..))
 import PostgREST.ApiRequest.Preferences  (PreferCount (..),
+                                          PreferParameters (..),
                                           PreferTransaction (..),
-                                          Preferences (..),
                                           shouldCount)
 import PostgREST.Config                  (AppConfig (..),
                                           OpenAPIMode (..))
@@ -46,40 +50,42 @@ import PostgREST.Config.PgVersion        (PgVersion (..),
 import PostgREST.Error                   (Error)
 import PostgREST.MediaType               (MediaType (..))
 import PostgREST.Plan                    (CallReadPlan (..),
-                                          MutateReadPlan (..),
+                                          MutateReadPlan (..))
-                                          WrappedReadPlan (..))
 import PostgREST.Plan.MutatePlan         (MutatePlan (..))
-import PostgREST.Query.SqlFragment       (escapeIdentList, fromQi,
+import PostgREST.Plan.ReadPlan           (ReadPlanTree)
-                                          intercalateSnippet,
+import PostgREST.Query.SqlFragment       (fromQi, intercalateSnippet,
+                                          pgFmtIdentList,
                                           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.Proc        (ProcDescription (..),
+                                          ProcVolatility (..),
+                                          ProcsMap)
 import PostgREST.SchemaCache.Table       (TablesMap)
 
 import Protolude hiding (Handler)
 
 type DbHandler = ExceptT Error SQL.Transaction
 
-readQuery :: WrappedReadPlan -> AppConfig -> ApiRequest -> DbHandler ResultSet
+readQuery :: ReadPlanTree -> AppConfig -> ApiRequest -> DbHandler ResultSet
-readQuery WrappedReadPlan{wrReadPlan, wrResAgg} conf@AppConfig{..} apiReq@ApiRequest{iPreferences=Preferences{..}, ..} = do
+readQuery req conf@AppConfig{..} apiReq@ApiRequest{..} = do
-  let countQuery = QueryBuilder.readPlanToCountQuery wrReadPlan
+  let countQuery = QueryBuilder.readPlanToCountQuery req
   resultSet <-
      lift . SQL.statement mempty $
       Statements.prepareRead
-        (QueryBuilder.readPlanToQuery wrReadPlan)
+        (QueryBuilder.readPlanToQuery req)
-        (if preferCount == Just EstimatedCount then
+        (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 preferCount)
+        (shouldCount iPreferCount)
         iAcceptMediaType
-        wrResAgg
+        iBinaryField
         configDbPreparedStatements
   failNotSingular iAcceptMediaType resultSet
   optionalRollback conf apiReq
@@ -87,8 +93,8 @@ readQuery WrappedReadPlan{wrReadPlan, wrResAgg} conf@AppConfig{..} apiReq@ApiReq
 
 resultSetWTotal :: AppConfig -> ApiRequest -> ResultSet -> SQL.Snippet -> DbHandler ResultSet
 resultSetWTotal _ _ rs@RSPlan{} _ = return rs
-resultSetWTotal AppConfig{..} ApiRequest{iPreferences=Preferences{..}} rs@RSStandard{rsTableTotal=tableTotal} countQuery =
+resultSetWTotal AppConfig{..} ApiRequest{..} rs@RSStandard{rsTableTotal=tableTotal} countQuery =
-  case preferCount of
+  case iPreferCount of
     Just PlannedCount -> do
       total <- explain
       return rs{rsTableTotal=total}
@@ -149,43 +155,63 @@ deleteQuery mrPlan apiReq@ApiRequest{..} conf = do
   optionalRollback conf apiReq
   pure resultSet
 
-invokeQuery :: Routine -> CallReadPlan -> ApiRequest -> AppConfig -> PgVersion -> DbHandler ResultSet
+invokeQuery :: ProcDescription -> CallReadPlan -> ApiRequest -> AppConfig -> DbHandler ResultSet
-invokeQuery rout CallReadPlan{crReadPlan, crCallPlan, crResAgg} apiReq@ApiRequest{iPreferences=Preferences{..}, ..} conf@AppConfig{..} pgVer = do
+invokeQuery proc CallReadPlan{crReadPlan, crCallPlan} apiReq@ApiRequest{..} conf@AppConfig{..} = do
   resultSet <-
     lift . SQL.statement mempty $
       Statements.prepareCall
-        rout
+        (Proc.procReturnsScalar proc)
-        (QueryBuilder.callPlanToQuery crCallPlan pgVer)
+        (Proc.procReturnsSingle proc)
+        (QueryBuilder.callPlanToQuery crCallPlan)
         (QueryBuilder.readPlanToQuery crReadPlan)
         (QueryBuilder.readPlanToCountQuery crReadPlan)
-        (shouldCount preferCount)
+        (shouldCount iPreferCount)
         iAcceptMediaType
-        crResAgg
+        (iPreferParameters == Just MultipleObjects)
+        iBinaryField
         configDbPreparedStatements
 
   optionalRollback conf apiReq
   failNotSingular iAcceptMediaType resultSet
   pure resultSet
 
-openApiQuery :: SchemaCache -> PgVersion -> AppConfig -> Schema -> DbHandler (Maybe (TablesMap, RoutineMap, Maybe Text))
+openApiQuery :: SchemaCache -> PgVersion -> AppConfig -> Schema -> DbHandler (Maybe (TablesMap, ProcsMap, 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.accessibleProcs 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)
+            (HM.filterWithKey (\(QualifiedIdentifier sch _) _ ->  sch == tSchema) $ SchemaCache.dbProcs sCache)
         <$> SQL.statement tSchema (SchemaCache.schemaDescription configDbPreparedStatements))
     OADisabled ->
       pure Nothing
 
+txMode :: ApiRequest -> SQL.Mode
+txMode ApiRequest{..} =
+  case (iAction, iTarget) of
+    (ActionRead _, _) ->
+      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 :: MutateReadPlan -> ApiRequest -> AppConfig  -> DbHandler ResultSet
-writeQuery MutateReadPlan{mrReadPlan, mrMutatePlan, mrResAgg} apiReq@ApiRequest{iPreferences=Preferences{..}} conf =
+writeQuery MutateReadPlan{mrReadPlan, mrMutatePlan} apiReq conf =
   let
     (isInsert, pkCols) = case mrMutatePlan of {Insert{insPkCols} -> (True, insPkCols); _ -> (False, mempty);}
   in
@@ -195,8 +221,7 @@ writeQuery MutateReadPlan{mrReadPlan, mrMutatePlan, mrResAgg} apiReq@ApiRequest{
       (QueryBuilder.mutatePlanToQuery mrMutatePlan)
       isInsert
       (iAcceptMediaType apiReq)
-      mrResAgg
+      (iPreferRepresentation apiReq)
-      preferRepresentation
       pkCols
       (configDbPreparedStatements conf)
 
@@ -206,7 +231,7 @@ writeQuery MutateReadPlan{mrReadPlan, mrMutatePlan, mrResAgg} apiReq@ApiRequest{
 failNotSingular :: MediaType -> ResultSet -> DbHandler ()
 failNotSingular _ RSPlan{} = pure ()
 failNotSingular mediaType RSStandard{rsQueryTotal=queryTotal} =
-  when (elem mediaType [MTSingularJSON True,MTSingularJSON False]  && queryTotal /= 1) $ do
+  when (mediaType == MTSingularJSON && queryTotal /= 1) $ do
     lift SQL.condemn
     throwError $ Error.singularityError queryTotal
 
@@ -220,23 +245,24 @@ failsChangesOffLimits (Just maxChanges) RSStandard{rsQueryTotal=queryTotal} =
 
 -- | Set a transaction to roll back if requested
 optionalRollback :: AppConfig -> ApiRequest -> DbHandler ()
-optionalRollback AppConfig{..} ApiRequest{iPreferences=Preferences{..}} = do
+optionalRollback AppConfig{..} ApiRequest{..} = do
   lift $ when (shouldRollback || (configDbTxRollbackAll && not shouldCommit)) $ do
     SQL.sql "SET CONSTRAINTS ALL IMMEDIATE"
     SQL.condemn
   where
     shouldCommit =
-      configDbTxAllowOverride && preferTransaction == Just Commit
+      configDbTxAllowOverride && iPreferTransaction == Just Commit
     shouldRollback =
-      configDbTxAllowOverride && preferTransaction == Just Rollback
+      configDbTxAllowOverride && iPreferTransaction == Just Rollback
 
--- | Runs local (transaction scoped) GUCs for every request.
+-- | Runs local(transaction scoped) GUCs for every request, plus the pre-request function
-setPgLocals :: AppConfig  -> KM.KeyMap JSON.Value -> BS.ByteString -> [(ByteString, ByteString)] ->
+setPgLocals :: AppConfig   -> KM.KeyMap JSON.Value -> Text ->
-               ApiRequest -> PgVersion -> DbHandler ()
+               ApiRequest  -> ByteString -> PgVersion -> DbHandler ()
-setPgLocals AppConfig{..} claims role roleSettings req actualPgVersion = lift $
+setPgLocals conf claims role req jsonDbS actualPgVersion = do
-  SQL.statement mempty $ SQL.dynamicallyParameterized
+  lift $ SQL.statement mempty $ SQL.dynamicallyParameterized
-    ("select " <> intercalateSnippet ", " (searchPathSql : roleSql ++ roleSettingsSql ++ claimsSql ++ [methodSql, pathSql] ++ headersSql ++ cookiesSql ++ appSettingsSql))
+    ("select " <> intercalateSnippet ", " (searchPathSql : roleSql ++ claimsSql ++ [methodSql, pathSql] ++ headersSql ++ cookiesSql ++ appSettingsSql ++ specSql))
-    HD.noResult configDbPreparedStatements
+    HD.noResult (configDbPreparedStatements conf)
+  lift $ traverse_ SQL.sql preReqSql
   where
     methodSql = setConfigLocal mempty ("request.method", iMethod req)
     pathSql = setConfigLocal mempty ("request.path", iPath req)
@@ -249,13 +275,16 @@ setPgLocals AppConfig{..} claims role roleSettings req actualPgVersion = lift $
     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)]
+    roleSql = [setConfigLocal mempty ("role", toUtf8 role)]
-    roleSettingsSql = setConfigLocal mempty <$> roleSettings
+    appSettingsSql = setConfigLocal mempty <$> (join bimap toUtf8 <$> configAppSettings conf)
-    appSettingsSql = setConfigLocal mempty <$> (join bimap toUtf8 <$> configAppSettings)
     searchPathSql =
-      let schemas = escapeIdentList (iSchema req : configDbExtraSearchPath) in
+      let schemas = pgFmtIdentList (iSchema req : configDbExtraSearchPath conf) in
       setConfigLocal mempty ("search_path", schemas)
-    usesLegacyGucs = configDbUseLegacyGucs && actualPgVersion < pgVersion140
+    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
@@ -263,12 +292,3 @@ setPgLocals AppConfig{..} claims role roleSettings req actualPgVersion = lift $
       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)

src/PostgREST/Query/QueryBuilder.hs

@@ -17,25 +17,22 @@ module PostgREST.Query.QueryBuilder
   ) 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.ApiRequest.Preferences   (PreferResolution (..))
-import PostgREST.Config.PgVersion         (PgVersion, pgVersion110,
-                                           pgVersion130)
 import PostgREST.SchemaCache.Identifiers  (QualifiedIdentifier (..))
+import PostgREST.SchemaCache.Proc         (ProcParam (..))
 import PostgREST.SchemaCache.Relationship (Cardinality (..),
                                            Junction (..),
-                                           Relationship (..),
+                                           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)
 
@@ -44,7 +41,7 @@ import Protolude
 readPlanToQuery :: ReadPlanTree -> SQL.Snippet
 readPlanToQuery (Node ReadPlan{select,from=mainQi,fromAlias,where_=logicForest,order, range_=readRange, relToParent, relJoinConds} forest) =
   "SELECT " <>
-  intercalateSnippet ", " ((pgFmtSelectItem qi <$> (if null select && null forest then defSelect else select)) ++ selects) <> " " <>
+  intercalateSnippet ", " ((pgFmtSelectItem qi <$> select) ++ selects) <> " " <>
   fromFrag <> " " <>
   intercalateSnippet " " joins <> " " <>
   (if null logicForest && null relJoinConds
@@ -55,138 +52,167 @@ readPlanToQuery (Node ReadPlan{select,from=mainQi,fromAlias,where_=logicForest,o
   where
     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 :: 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) =
+getSelectsJoins rr@(Node ReadPlan{relName, relToParent=Just rel, relAggAlias, relAlias, relJoinType=joinType} _) (selects,joins) =
   let
     subquery = readPlanToQuery rr
     aliasOrName = pgFmtIdent $ fromMaybe relName relAlias
     aggAlias = pgFmtIdent relAggAlias
     correlatedSubquery sub al cond =
-      (if relJoinType == Just JTInner then "INNER" else "LEFT") <> " JOIN LATERAL ( " <> sub <> " ) AS " <> al <> " ON " <> cond
+      (if joinType == Just JTInner then "INNER" else "LEFT") <> " JOIN LATERAL ( " <> sub <> " ) AS " <> SQL.sql al <> " ON " <> cond
-    (sel, joi) = if relIsToOne rel
+    isToOne = case rel of
+      Relationship{relCardinality=M2O _ _} -> True
+      Relationship{relCardinality=O2O _ _} -> True
+      ComputedRelationship{relToOne=True}  -> True
+      _                                    -> False
+    (sel, joi) = if isToOne
       then
-        ( if relIsSpread
+        ( SQL.sql ("row_to_json(" <> aggAlias <> ".*) AS " <> aliasOrName)
-            then aggAlias <> ".*"
-            else "row_to_json(" <> aggAlias <> ".*) AS " <> aliasOrName
         , correlatedSubquery subquery aggAlias "TRUE")
       else
-        ( "COALESCE( " <> aggAlias <> "." <> aggAlias <> ", '[]') AS " <> aliasOrName
+        ( SQL.sql $ "COALESCE( " <> aggAlias <> "." <> aggAlias <> ", '[]') AS " <> aliasOrName
         , correlatedSubquery (
-            "SELECT json_agg(" <> aggAlias <> ") AS " <> aggAlias <>
+            "SELECT json_agg(" <> SQL.sql aggAlias <> ") AS " <> SQL.sql aggAlias <>
-            "FROM (" <> subquery <> " ) AS " <> aggAlias
+            "FROM (" <> subquery <> " ) AS " <> SQL.sql aggAlias
-          ) aggAlias $ if relJoinType == Just JTInner then aggAlias <> " IS NOT NULL" else "TRUE")
+          ) aggAlias $ if joinType == Just JTInner then SQL.sql aggAlias <> " IS NOT NULL" else "TRUE")
   in
-  (if null select && null forest then selects else sel:selects, joi:joins)
+  (sel:selects, joi:joins)
 
 mutatePlanToQuery :: MutatePlan -> SQL.Snippet
-mutatePlanToQuery (Insert mainQi iCols body onConflct putConditions returnings _ applyDefaults) =
+mutatePlanToQuery (Insert mainQi iCols body onConflct putConditions returnings _) =
-  "INSERT INTO " <> fromQi mainQi <> (if null iCols then " " else "(" <> cols <> ") ") <>
+  "WITH " <> normalizedBody body <> " " <>
-  fromJsonBodyF body iCols True False applyDefaults <>
+  "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 <> ") _ ") <>
   -- Only used for PUT
-  (if null putConditions then mempty else "WHERE " <> intercalateSnippet " AND " (pgFmtLogicTree (QualifiedIdentifier mempty "pgrst_body") <$> putConditions)) <>
+  (if null putConditions then mempty else "WHERE " <> intercalateSnippet " AND " (pgFmtLogicTree (QualifiedIdentifier mempty "_") <$> putConditions)) <>
-  maybe mempty (\(oncDo, oncCols) ->
+  SQL.sql (BS.unwords [
-    if null oncCols then
+    maybe "" (\(oncDo, oncCols) ->
-      mempty
+      if null oncCols then
-    else
+        mempty
-      " ON CONFLICT(" <> intercalateSnippet ", " (pgFmtIdent <$> oncCols) <> ") " <> case oncDo of
+      else
-      IgnoreDuplicates ->
+        " ON CONFLICT(" <> BS.intercalate ", " (pgFmtIdent <$> oncCols) <> ") " <> case oncDo of
-        "DO NOTHING"
+        IgnoreDuplicates ->
-      MergeDuplicates  ->
+          "DO NOTHING"
-        if null iCols
+        MergeDuplicates  ->
-           then "DO NOTHING"
+          if S.null iCols
-           else "DO UPDATE SET " <> intercalateSnippet ", " ((pgFmtIdent . cfName) <> const " = EXCLUDED." <> (pgFmtIdent . cfName) <$> iCols)
+             then "DO NOTHING"
-    ) onConflct <> " " <>
+             else "DO UPDATE SET " <> BS.intercalate ", " (pgFmtIdent <> const " = EXCLUDED." <> pgFmtIdent <$> S.toList iCols)
-  returningF mainQi returnings
+      ) onConflct,
+    returningF mainQi returnings
+    ])
   where
-    cols = intercalateSnippet ", " $ pgFmtIdent . cfName <$> iCols
+    cols = BS.intercalate ", " $ pgFmtIdent <$> S.toList iCols
 
 -- An update without a limit is always filtered with a WHERE
-mutatePlanToQuery (Update mainQi uCols body logicForest range ordts returnings applyDefaults)
+mutatePlanToQuery (Update mainQi uCols body logicForest range ordts returnings)
-  | null uCols =
+  | S.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
-    "SELECT " <> emptyBodyReturnedColumns <> " FROM " <> fromQi mainQi <> " WHERE false"
+    SQL.sql $ "SELECT " <> emptyBodyReturnedColumns <> " FROM " <> fromQi mainQi <> " WHERE false"
 
   | range == allRange =
-    "UPDATE " <> mainTbl <> " SET " <> nonRangeCols <> " " <>
+    "WITH " <> normalizedBody body <> " " <>
-    fromJsonBodyF body uCols False False applyDefaults <>
+    "UPDATE " <> mainTbl <> " SET " <> SQL.sql nonRangeCols <> " " <>
+    "FROM (SELECT * FROM json_populate_recordset (null::" <> mainTbl <> " , " <> SQL.sql selectBody <> " )) _ " <>
     whereLogic <> " " <>
-    returningF mainQi returnings
+    SQL.sql (returningF mainQi returnings)
 
   | otherwise =
-    "WITH " <>
+    "WITH " <> normalizedBody body <> ", " <>
-    "pgrst_update_body AS (" <> fromJsonBodyF body uCols True True applyDefaults <> "), " <>
+    "pgrst_update_body AS (SELECT * FROM json_populate_recordset (null::" <> mainTbl <> " , " <> SQL.sql selectBody <> " ) LIMIT 1), " <>
     "pgrst_affected_rows AS (" <>
-      "SELECT " <> rangeIdF <> " FROM " <> mainTbl <>
+      "SELECT " <> SQL.sql rangeIdF <> " FROM " <> mainTbl <>
       whereLogic <> " " <>
       orderF mainQi ordts <> " " <>
       limitOffsetF range <>
     ") " <>
-    "UPDATE " <> mainTbl <> " SET " <> rangeCols <>
+    "UPDATE " <> mainTbl <> " SET " <> SQL.sql rangeCols <>
     "FROM pgrst_affected_rows " <>
-    "WHERE " <> whereRangeIdF <> " " <>
+    "WHERE " <> SQL.sql whereRangeIdF <> " " <>
-    returningF mainQi returnings
+    SQL.sql (returningF mainQi returnings)
 
   where
     whereLogic = if null logicForest then mempty else " WHERE " <> intercalateSnippet " AND " (pgFmtLogicTree mainQi <$> logicForest)
-    mainTbl = fromQi mainQi
+    mainTbl = SQL.sql (fromQi mainQi)
-    emptyBodyReturnedColumns = if null returnings then "NULL" else intercalateSnippet ", " (pgFmtColumn (QualifiedIdentifier mempty $ qiName mainQi) <$> returnings)
+    emptyBodyReturnedColumns = if null returnings then "NULL" else BS.intercalate ", " (pgFmtColumn (QualifiedIdentifier mempty $ qiName mainQi) <$> returnings)
-    nonRangeCols = intercalateSnippet ", " (pgFmtIdent . cfName <> const " = " <> pgFmtColumn (QualifiedIdentifier mempty "pgrst_body") . cfName <$> uCols)
+    nonRangeCols = BS.intercalate ", " (pgFmtIdent <> const " = _." <> pgFmtIdent <$> S.toList uCols)
-    rangeCols = intercalateSnippet ", " ((\col -> pgFmtIdent (cfName col) <> " = (SELECT " <> pgFmtIdent (cfName col) <> " FROM pgrst_update_body) ") <$> uCols)
+    rangeCols = BS.intercalate ", " ((\col -> pgFmtIdent col <> " = (SELECT " <> pgFmtIdent col <> " FROM pgrst_update_body) ") <$> S.toList uCols)
-    (whereRangeIdF, rangeIdF) = mutRangeF mainQi (cfName . coField <$> ordts)
+    (whereRangeIdF, rangeIdF) = mutRangeF mainQi (fst . otTerm <$> ordts)
 
 mutatePlanToQuery (Delete mainQi logicForest range ordts returnings)
   | range == allRange =
-    "DELETE FROM " <> fromQi mainQi <> " " <>
+    "DELETE FROM " <> SQL.sql (fromQi mainQi) <> " " <>
     whereLogic <> " " <>
-    returningF mainQi returnings
+    SQL.sql (returningF mainQi returnings)
 
   | otherwise =
     "WITH " <>
     "pgrst_affected_rows AS (" <>
-      "SELECT " <> rangeIdF <> " FROM " <> fromQi mainQi <>
+      "SELECT " <> SQL.sql rangeIdF <> " FROM " <> SQL.sql (fromQi mainQi) <>
        whereLogic <> " " <>
       orderF mainQi ordts <> " " <>
       limitOffsetF range <>
     ") " <>
-    "DELETE FROM " <> fromQi mainQi <> " " <>
+    "DELETE FROM " <> SQL.sql (fromQi mainQi) <> " " <>
     "USING pgrst_affected_rows " <>
-    "WHERE " <> whereRangeIdF <> " " <>
+    "WHERE " <> SQL.sql whereRangeIdF <> " " <>
-    returningF mainQi returnings
+    SQL.sql (returningF mainQi returnings)
 
   where
     whereLogic = if null logicForest then mempty else " WHERE " <> intercalateSnippet " AND " (pgFmtLogicTree mainQi <$> logicForest)
-    (whereRangeIdF, rangeIdF) = mutRangeF mainQi (cfName . coField <$> ordts)
+    (whereRangeIdF, rangeIdF) = mutRangeF mainQi (fst . otTerm <$> ordts)
 
-callPlanToQuery :: CallPlan -> PgVersion -> SQL.Snippet
+callPlanToQuery :: CallPlan -> SQL.Snippet
-callPlanToQuery (FunctionCall qi params args returnsScalar returnsSetOfScalar returnsCompositeAlias returnings) pgVer =
+callPlanToQuery (FunctionCall qi params args returnsScalar multipleCall returnings) =
-  "SELECT " <> (if returnsScalar || returnsSetOfScalar then "pgrst_call.pgrst_scalar" else returnedColumns) <> " " <>
+  prmsCTE <> argsBody
-  fromCall
   where
-    fromCall = case params of
+    (prmsCTE, argFrag) = case params of
-      OnePosParam prm -> "FROM " <> callIt (singleParameter args $ encodeUtf8 $ ppType prm)
+      OnePosParam prm -> ("WITH pgrst_args AS (SELECT NULL)", singleParameter args (encodeUtf8 $ ppType prm))
-      KeyParams []    -> "FROM " <> callIt mempty
+      KeyParams []    -> (mempty, mempty)
-      KeyParams prms  -> fromJsonBodyF args ((\p -> CoercibleField (ppName p) mempty False (ppTypeMaxLength p) Nothing Nothing) <$> prms) False True False <> ", " <>
+      KeyParams prms  -> (
-                         "LATERAL " <> callIt (fmtParams 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)")
+        )
 
-    callIt :: SQL.Snippet -> SQL.Snippet
+    fmtParams :: [ProcParam] -> (ProcParam -> SqlFragment) -> (ProcParam -> SqlFragment) -> SqlFragment
-    callIt argument | pgVer < pgVersion130 && pgVer >= pgVersion110 && returnsCompositeAlias = "(SELECT (" <> fromQi qi <> "(" <> argument <> ")).*) pgrst_call"
+    fmtParams prms prmFragPre prmFragSuf = BS.intercalate ", "
-                    | returnsScalar || returnsSetOfScalar                                    = "(SELECT " <> fromQi qi <> "(" <> argument <> ") pgrst_scalar) pgrst_call"
+      ((\a -> prmFragPre a <> pgFmtIdent (ppName a) <> prmFragSuf a) <$> prms)
-                    | otherwise                                                              = fromQi qi <> "(" <> argument <> ") pgrst_call"
 
-    fmtParams :: [RoutineParam] -> SQL.Snippet
+    varadicPrefix :: ProcParam -> SqlFragment
-    fmtParams prms = intercalateSnippet ", "
+    varadicPrefix a = if ppVar a then "VARIADIC " else mempty
-      ((\a -> (if ppVar a then "VARIADIC " else mempty) <> pgFmtIdent (ppName a) <> " := pgrst_body." <> pgFmtIdent (ppName a)) <$> prms)
+
+    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 <> ")"
 
     returnedColumns :: SQL.Snippet
     returnedColumns
       | null returnings = "*"
-      | otherwise       = intercalateSnippet ", " (pgFmtColumn (QualifiedIdentifier mempty "pgrst_call") <$> returnings)
+      | otherwise       = SQL.sql $ BS.intercalate ", " (pgFmtColumn (QualifiedIdentifier mempty $ qiName qi) <$> 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.
@@ -228,7 +254,7 @@ getQualifiedIdentifier rel mainQi tblAlias = case rel of
 
 -- FROM clause plus implicit joins
 fromF :: Maybe Relationship -> QualifiedIdentifier -> Maybe Alias -> SQL.Snippet
-fromF rel mainQi tblAlias = "FROM " <>
+fromF rel mainQi tblAlias = SQL.sql $ "FROM " <>
   (case rel of
     Just ComputedRelationship{relFunction,relTable} -> fromQi relFunction <> "(" <> pgFmtIdent (qiName relTable) <> ")"
     _                                               -> fromQi mainQi) <>

src/PostgREST/Query/SqlFragment.hs

@@ -4,36 +4,43 @@
 {-|
 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
-  , aggF
+  , SqlFragment
+  , asBinaryF
+  , asCsvF
+  , asGeoJsonF
+  , asJsonF
+  , asJsonSingleF
+  , asXmlF
   , countF
   , fromQi
   , limitOffsetF
   , locationF
   , mutRangeF
+  , normalizedBody
   , orderF
   , pgFmtColumn
   , 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
@@ -50,80 +57,87 @@ import Control.Arrow ((***))
 import Data.Foldable                 (foldr1)
 import Text.InterpolatedString.Perl6 (qc)
 
-import PostgREST.ApiRequest.Types        (Alias, Cast,
+import PostgREST.ApiRequest.Types        (Alias, Cast, Field,
+                                          Filter (..),
                                           FtsOperator (..),
                                           JsonOperand (..),
                                           JsonOperation (..),
                                           JsonPath,
                                           LogicOperator (..),
-                                          OpExpr (..),
+                                          LogicTree (..), OpExpr (..),
-                                          OpQuantifier (..),
                                           Operation (..),
                                           OrderDirection (..),
                                           OrderNulls (..),
-                                          QuantOperator (..),
+                                          OrderTerm (..),
                                           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)
 
-sourceCTEName :: Text
-sourceCTEName = "pgrst_source"
 
-sourceCTE :: SQL.Snippet
+-- | A part of a SQL query that cannot be executed independently
-sourceCTE = "pgrst_source"
+type SqlFragment = ByteString
 
-noLocationF :: SQL.Snippet
+noLocationF :: SqlFragment
 noLocationF = "array[]::text[]"
 
-simpleOperator :: SimpleOperator -> SQL.Snippet
+sourceCTEName :: SqlFragment
-simpleOperator = \case
+sourceCTEName = "pgrst_source"
-  OpNotEqual        -> "<>"
-  OpContains        -> "@>"
-  OpContained       -> "<@"
-  OpOverlap         -> "&&"
-  OpStrictlyLeft    -> "<<"
-  OpStrictlyRight   -> ">>"
-  OpNotExtendsRight -> "&<"
-  OpNotExtendsLeft  -> "&>"
-  OpAdjacent        -> "-|-"
 
-quantOperator :: QuantOperator -> SQL.Snippet
+singleValOperator :: SimpleOperator -> SqlFragment
-quantOperator = \case
+singleValOperator = \case
   OpEqual            -> "="
   OpGreaterThanEqual -> ">="
   OpGreaterThan      -> ">"
   OpLessThanEqual    -> "<="
   OpLessThan         -> "<"
+  OpNotEqual         -> "<>"
   OpLike             -> "like"
   OpILike            -> "ilike"
+  OpContains         -> "@>"
+  OpContained        -> "<@"
+  OpOverlap          -> "&&"
+  OpStrictlyLeft     -> "<<"
+  OpStrictlyRight    -> ">>"
+  OpNotExtendsRight  -> "&<"
+  OpNotExtendsLeft   -> "&>"
+  OpAdjacent         -> "-|-"
   OpMatch            -> "~"
   OpIMatch           -> "~*"
 
-ftsOperator :: FtsOperator -> SQL.Snippet
+ftsOperator :: FtsOperator -> SqlFragment
 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.jsonLazyBytes) body
+
 singleParameter :: Maybe LBS.ByteString -> ByteString -> SQL.Snippet
 singleParameter body typ =
   if typ == "bytea"
@@ -131,6 +145,9 @@ 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
@@ -145,21 +162,8 @@ pgBuildArrayLiteral vals =
  "{" <> T.intercalate "," (escaped <$> vals) <> "}"
 
 -- TODO: refactor by following https://github.com/PostgREST/postgrest/pull/1631#issuecomment-711070833
-pgFmtIdent :: Text -> SQL.Snippet
+pgFmtIdent :: Text -> SqlFragment
-pgFmtIdent x = SQL.sql $ escapeIdent x
+pgFmtIdent x = encodeUtf8 $ "\"" <> T.replace "\"" "\"\"" (trimNullChars 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')
@@ -167,12 +171,12 @@ trimNullChars = T.takeWhile (/= '\x0')
 -- |
 -- Format a list of identifiers and separate them by commas.
 --
--- >>> escapeIdentList ["schema_1", "schema_2", "SPECIAL \"@/\\#~_-"]
+-- >>> pgFmtIdentList ["schema_1", "schema_2", "SPECIAL \"@/\\#~_-"]
 -- "\"schema_1\", \"schema_2\", \"SPECIAL \"\"@/\\#~_-\""
-escapeIdentList :: [Text] -> ByteString
+pgFmtIdentList :: [Text] -> SqlFragment
-escapeIdentList schemas = BS.intercalate ", " $ escapeIdent <$> schemas
+pgFmtIdentList schemas = BS.intercalate ", " $ pgFmtIdent <$> schemas
 
-asCsvF :: SQL.Snippet
+asCsvF :: SqlFragment
 asCsvF = asCsvHeaderF <> " || '\n' || " <> asCsvBodyF
   where
     asCsvHeaderF =
@@ -180,49 +184,32 @@ asCsvF = asCsvHeaderF <> " || '\n' || " <> asCsvBodyF
       "  FROM (" <>
       "    SELECT json_object_keys(r)::text as k" <>
       "    FROM ( " <>
-      "      SELECT row_to_json(hh) as r from " <> sourceCTE <> " as hh limit 1" <>
+      "      SELECT row_to_json(hh) as r from " <> sourceCTEName <> " as hh limit 1" <>
       "    ) s" <>
       "  ) a" <>
       ")"
     asCsvBodyF = "coalesce(string_agg(substring(_postgrest_t::text, 2, length(_postgrest_t::text) - 2), '\n'), '')"
 
-addNullsToSnip :: Bool -> SQL.Snippet -> SQL.Snippet
+asJsonF :: Bool -> SqlFragment
-addNullsToSnip strip snip =
+asJsonF returnsScalar
-  if strip then "json_strip_nulls(" <> snip <> ")" else  snip
+  | returnsScalar = "coalesce(json_agg(_postgrest_t.pgrst_scalar), '[]')::character varying"
+  | otherwise     = "coalesce(json_agg(_postgrest_t), '[]')::character varying"
 
-asJsonSingleF :: Maybe Routine -> Bool -> SQL.Snippet
+asJsonSingleF :: Bool -> SqlFragment
-asJsonSingleF rout strip
+asJsonSingleF returnsScalar
-  | returnsScalar = "coalesce(" <> addNullsToSnip strip "json_agg(_postgrest_t.pgrst_scalar)->0"  <> ", 'null')"
+  | returnsScalar = "coalesce((json_agg(_postgrest_t.pgrst_scalar)->0)::text, 'null')"
-  | otherwise     = "coalesce(" <> addNullsToSnip strip "json_agg(_postgrest_t)->0"  <> ", 'null')"
+  | otherwise     = "coalesce((json_agg(_postgrest_t)->0)::text, 'null')"
-  where
-    returnsScalar = maybe False funcReturnsScalar rout
 
-asJsonF :: Maybe Routine -> Bool -> SQL.Snippet
+asXmlF :: FieldName -> SqlFragment
-asJsonF rout strip
+asXmlF fieldName = "coalesce(xmlagg(_postgrest_t." <> pgFmtIdent fieldName <> "), '')"
-  | 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 :: Maybe FieldName -> SQL.Snippet
+asBinaryF :: FieldName -> SqlFragment
-asBinaryF (Just fieldName) = "coalesce(string_agg(_postgrest_t." <> pgFmtIdent fieldName <> ", ''), '')"
+asBinaryF 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] -> SQL.Snippet
+locationF :: [Text] -> SqlFragment
 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'))
@@ -232,161 +219,88 @@ locationF pKeys = [qc|(
   where
     fmtPKeys = T.intercalate "','" pKeys
 
-fromQi :: QualifiedIdentifier -> SQL.Snippet
+fromQi :: QualifiedIdentifier -> SqlFragment
 fromQi t = (if T.null s then mempty else pgFmtIdent s <> ".") <> pgFmtIdent n
   where
     n = qiName t
     s = qiSchema t
 
-pgFmtColumn :: QualifiedIdentifier -> Text -> SQL.Snippet
+pgFmtColumn :: QualifiedIdentifier -> Text -> SqlFragment
 pgFmtColumn table "*" = fromQi table <> ".*"
 pgFmtColumn table c   = fromQi table <> "." <> pgFmtIdent c
 
-pgFmtCallUnary :: Text -> SQL.Snippet -> SQL.Snippet
+pgFmtField :: QualifiedIdentifier -> Field -> SQL.Snippet
-pgFmtCallUnary f x = SQL.sql (encodeUtf8 f) <> "(" <> x <> ")"
+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
 
-pgFmtField :: QualifiedIdentifier -> CoercibleField -> SQL.Snippet
+pgFmtSelectItem :: QualifiedIdentifier -> (Field, Maybe Cast, Maybe Alias) -> SQL.Snippet
-pgFmtField table CoercibleField{cfName=fn, cfJsonPath=[]}                                = pgFmtColumn table fn
+pgFmtSelectItem table (f@(fName, jp), Nothing, alias) = pgFmtField table f <> SQL.sql (pgFmtAs fName jp alias)
-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 (fld, Just cast, alias) = "CAST (" <> pgFmtTableCoerce table fld <> " AS " <> SQL.sql (encodeUtf8 cast) <> " )" <> pgFmtAs (cfName fld) (cfJsonPath fld) alias
+pgFmtSelectItem table (f@(fName, jp), Just cast, alias) = "CAST (" <> pgFmtField table f <> " AS " <> SQL.sql (encodeUtf8 cast) <> " )" <> SQL.sql (pgFmtAs fName jp alias)
 
--- TODO: At this stage there shouldn't be a Maybe since ApiRequest should ensure that an INSERT/UPDATE has a body
+pgFmtOrderTerm :: QualifiedIdentifier -> OrderTerm -> SQL.Snippet
-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 <> " " <>
+  pgFmtField qi (otTerm ot) <> " " <>
   SQL.sql (BS.unwords [
-    maybe mempty direction $ coDirection ot,
+    maybe mempty direction $ otDirection ot,
-    maybe mempty nullOrder $ coNullOrder ot])
+    maybe mempty nullOrder $ otNullOrder 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
 
--- | Array version of the above, used by ANY().
+pgFmtFilter :: QualifiedIdentifier -> Filter -> SQL.Snippet
-pgFmtArrayLiteralForField :: [Text] -> CoercibleField -> SQL.Snippet
+pgFmtFilter table (Filter fld (OpExpr hasNot oper)) = notOp <> " " <> case oper of
--- 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.
+   Op op val  -> pgFmtFieldOp op <> " " <> case op of
--- 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.
+     OpLike  -> unknownLiteral (T.map star val)
-pgFmtArrayLiteralForField values CoercibleField{cfTransform=(Just parserProc)} = SQL.sql "(SELECT " <> pgFmtCallUnary parserProc (SQL.sql "unnest(" <> unknownLiteral (pgBuildArrayLiteral values) <> "::text[])") <> ")"
+     OpILike -> unknownLiteral (T.map star val)
--- When no transformation is requested, we don't need a subquery.
+     _       -> unknownLiteral val
-pgFmtArrayLiteralForField values _ = unknownLiteral (pgBuildArrayLiteral values)
-
-
-pgFmtFilter :: QualifiedIdentifier -> CoercibleFilter -> SQL.Snippet
-pgFmtFilter _ (CoercibleFilterNullEmbed hasNot fld) = pgFmtIdent fld <> " IS " <> (if hasNot then "NOT" else mempty) <> " 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 -> " IS " <> case triVal of
+   Is triVal -> pgFmtField table fld <> " 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 -> " " <> case vals of
+   In vals -> pgFmtField table fld <> " " <> case vals of
       [""] -> "= ANY('{}') "
-      _    -> "= ANY (" <> pgFmtArrayLiteralForField vals fld <> ") "
+      _    -> "= ANY (" <> unknownLiteral (pgBuildArrayLiteral vals) <> ") "
 
-   Fts op lang val -> " " <> ftsOperator op <> "(" <> ftsLang lang <> unknownLiteral val <> ") "
+   Fts op lang val ->
+     pgFmtFieldFts 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)) =
-  pgFmtColumn qi1 col1 <> " = " <> pgFmtColumn qi2 col2
+  SQL.sql $ pgFmtColumn qi1 col1 <> " = " <> pgFmtColumn qi2 col2
 
-pgFmtLogicTree :: QualifiedIdentifier -> CoercibleLogicTree -> SQL.Snippet
+pgFmtLogicTree :: QualifiedIdentifier -> LogicTree -> SQL.Snippet
-pgFmtLogicTree qi (CoercibleExpr hasNot op forest) = SQL.sql notOp <> " (" <> intercalateSnippet (opSql op) (pgFmtLogicTree qi <$> forest) <> ")"
+pgFmtLogicTree qi (Expr hasNot op forest) = SQL.sql notOp <> " (" <> intercalateSnippet (opSql op) (pgFmtLogicTree qi <$> forest) <> ")"
   where
     notOp =  if hasNot then "NOT" else mempty
 
     opSql And = " AND "
     opSql Or  = " OR "
-pgFmtLogicTree qi (CoercibleStmnt flt) = pgFmtFilter qi flt
+pgFmtLogicTree qi (Stmnt flt) = pgFmtFilter qi flt
 
 pgFmtJsonPath :: JsonPath -> SQL.Snippet
 pgFmtJsonPath = \case
@@ -397,7 +311,7 @@ pgFmtJsonPath = \case
     pgFmtJsonOperand (JKey k) = unknownLiteral k
     pgFmtJsonOperand (JIdx i) = unknownLiteral i <> "::int"
 
-pgFmtAs :: FieldName -> JsonPath -> Maybe Alias -> SQL.Snippet
+pgFmtAs :: FieldName -> JsonPath -> Maybe Alias -> SqlFragment
 pgFmtAs _ [] Nothing = mempty
 pgFmtAs fName jp Nothing = case jOp <$> lastMay jp of
   Just (JKey key) -> " AS " <> pgFmtIdent key
@@ -409,7 +323,7 @@ pgFmtAs fName jp Nothing = case jOp <$> lastMay jp of
   Nothing -> mempty
 pgFmtAs _ _ (Just alias) = " AS " <> pgFmtIdent alias
 
-countF :: SQL.Snippet -> Bool -> (SQL.Snippet, SQL.Snippet)
+countF :: SQL.Snippet -> Bool -> (SQL.Snippet, SqlFragment)
 countF countQuery shouldCount =
   if shouldCount
     then (
@@ -419,11 +333,11 @@ countF countQuery shouldCount =
         mempty
       , "null::bigint")
 
-returningF :: QualifiedIdentifier -> [FieldName] -> SQL.Snippet
+returningF :: QualifiedIdentifier -> [FieldName] -> SqlFragment
 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 " <> intercalateSnippet ", " (pgFmtColumn qi <$> returnings)
+    else "RETURNING " <> BS.intercalate ", " (pgFmtColumn qi <$> returnings)
 
 limitOffsetF :: NonnegRange -> SQL.Snippet
 limitOffsetF range =
@@ -432,25 +346,25 @@ limitOffsetF range =
     limit = maybe "ALL" (\l -> unknownEncoder (BS.pack $ show l)) $ rangeLimit range
     offset = unknownEncoder (BS.pack . show $ rangeOffset range)
 
-responseHeadersF :: SQL.Snippet
+responseHeadersF :: SqlFragment
 responseHeadersF = currentSettingF "response.headers"
 
-responseStatusF :: SQL.Snippet
+responseStatusF :: SqlFragment
 responseStatusF = currentSettingF "response.status"
 
-currentSettingF :: SQL.Snippet -> SQL.Snippet
+currentSettingF :: SqlFragment -> SqlFragment
 currentSettingF setting =
   -- nullif is used because of https://gist.github.com/steve-chavez/8d7033ea5655096903f3b52f8ed09a15
   "nullif(current_setting('" <> setting <> "', true), '')"
 
-mutRangeF :: QualifiedIdentifier -> [FieldName] -> (SQL.Snippet, SQL.Snippet)
+mutRangeF :: QualifiedIdentifier -> [FieldName] -> (SqlFragment, SqlFragment)
 mutRangeF mainQi rangeId =
   (
-    intercalateSnippet " AND " $ (\col -> pgFmtColumn mainQi col <> " = " <> pgFmtColumn (QualifiedIdentifier mempty "pgrst_affected_rows") col) <$> rangeId
+    BS.intercalate " AND " $ (\col -> pgFmtColumn mainQi col <> " = " <> pgFmtColumn (QualifiedIdentifier mempty "pgrst_affected_rows") col) <$> rangeId
-  , intercalateSnippet ", " (pgFmtColumn mainQi <$> rangeId)
+  , BS.intercalate ", " (pgFmtColumn mainQi <$> rangeId)
   )
 
-orderF :: QualifiedIdentifier -> [CoercibleOrderTerm] -> SQL.Snippet
+orderF :: QualifiedIdentifier -> [OrderTerm] -> SQL.Snippet
 orderF _ []    = mempty
 orderF qi ordts = "ORDER BY " <> intercalateSnippet ", " (pgFmtOrderTerm qi <$> ordts)
 
@@ -478,8 +392,8 @@ explainF fmt opts snip =
     fmtPlanOpt PlanBuffers  = "BUFFERS"
     fmtPlanOpt PlanWAL      = "WAL"
 
-    fmtPlanFmt PlanText = "FORMAT TEXT"
     fmtPlanFmt PlanJSON = "FORMAT JSON"
+    fmtPlanFmt PlanText = "FORMAT TEXT"
 
 -- | Do a pg set_config(setting, value, true) call. This is equivalent to a SET LOCAL.
 setConfigLocal :: ByteString -> (ByteString, ByteString) -> SQL.Snippet
@@ -495,14 +409,3 @@ setConfigLocalJson prefix keyVals = [setConfigLocal mempty (prefix, gucJsonVal k
     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"

src/PostgREST/Query/Statements.hs

@@ -23,13 +23,15 @@ import qualified Hasql.DynamicStatements.Statement as SQL
 import qualified Hasql.Statement                   as SQL
 
 import Control.Lens ((^?))
+import Data.Maybe   (fromJust)
 
 import PostgREST.ApiRequest.Preferences
-import PostgREST.MediaType              (MTPlanFormat (..),
+import PostgREST.MediaType               (MTPlanAttrs (..),
-                                         MediaType (..))
+                                          MTPlanFormat (..),
+                                          MediaType (..),
+                                          getMediaType)
 import PostgREST.Query.SqlFragment
-import PostgREST.SchemaCache.Routine    (ResultAggregate (..),
+import PostgREST.SchemaCache.Identifiers (FieldName)
-                                         Routine)
 
 import Protolude
 
@@ -53,82 +55,110 @@ data ResultSet
   | RSPlan BS.ByteString -- ^ the plan of the query
 
 
-prepareWrite :: SQL.Snippet -> SQL.Snippet -> Bool -> MediaType -> ResultAggregate ->
+prepareWrite :: SQL.Snippet -> SQL.Snippet -> Bool -> MediaType ->
-                Maybe PreferRepresentation -> [Text] -> Bool -> SQL.Statement () ResultSet
+                PreferRepresentation -> [Text] -> Bool -> SQL.Statement () ResultSet
-prepareWrite selectQuery mutateQuery isInsert mt rAgg rep pKeys =
+prepareWrite selectQuery mutateQuery isInsert mt rep pKeys =
   SQL.dynamicallyParameterized (mtSnippet mt snippet) decodeIt
  where
   snippet =
-    "WITH " <> sourceCTE <> " AS (" <> mutateQuery <> ") " <>
+    "WITH " <> SQL.sql sourceCTEName <> " AS (" <> mutateQuery <> ") " <>
+    SQL.sql (
     "SELECT " <>
       "'' AS total_result_set, " <>
       "pg_catalog.count(_postgrest_t) AS page_total, " <>
       locF <> " AS header, " <>
-      aggF Nothing rAgg <> " AS body, " <>
+      bodyF <> " AS body, " <>
       responseHeadersF <> " AS response_headers, " <>
-      responseStatusF  <> " AS response_status " <>
+      responseStatusF  <> " AS response_status "
+    ) <>
     "FROM (" <> selectF <> ") _postgrest_t"
 
   locF =
-    if isInsert && rep == Just HeadersOnly
+    if isInsert && rep == HeadersOnly
-      then
+      then BS.unwords [
-        "CASE WHEN pg_catalog.count(_postgrest_t) = 1 " <>
+        "CASE WHEN pg_catalog.count(_postgrest_t) = 1",
-          "THEN coalesce(" <> locationF pKeys <> ", " <> noLocationF <> ") " <>
+          "THEN coalesce(" <> locationF pKeys <> ", " <> noLocationF <> ")",
-          "ELSE " <> noLocationF <> " " <>
+          "ELSE " <> noLocationF,
-        "END"
+        "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
-    | rAgg == NoAgg = "SELECT * FROM " <> sourceCTE
+    | rep /= Full = SQL.sql ("SELECT * FROM " <> sourceCTEName)
-    | otherwise     = selectQuery
+    | otherwise   = selectQuery
 
   decodeIt :: HD.Result ResultSet
   decodeIt = case mt of
     MTPlan{} -> planRow
     _        -> fromMaybe (RSStandard Nothing 0 mempty mempty Nothing Nothing) <$> HD.rowMaybe (standardRow False)
 
-prepareRead :: SQL.Snippet -> SQL.Snippet -> Bool -> MediaType -> ResultAggregate -> Bool -> SQL.Statement () ResultSet
+prepareRead :: SQL.Snippet -> SQL.Snippet -> Bool -> MediaType -> Maybe FieldName -> Bool -> SQL.Statement () ResultSet
-prepareRead selectQuery countQuery countTotal mt rAgg =
+prepareRead selectQuery countQuery countTotal mt binaryField =
   SQL.dynamicallyParameterized (mtSnippet mt snippet) decodeIt
  where
   snippet =
-    "WITH " <> sourceCTE <> " AS ( " <> selectQuery <> " ) " <>
+    "WITH " <>
+    SQL.sql sourceCTEName <> " AS ( " <> selectQuery <> " ) " <>
     countCTEF <> " " <>
-    "SELECT " <>
+    SQL.sql ("SELECT " <>
       countResultF <> " AS total_result_set, " <>
       "pg_catalog.count(_postgrest_t) AS page_total, " <>
-      aggF Nothing rAgg <> " AS body, " <>
+      bodyF <> " AS body, " <>
       responseHeadersF <> " AS response_headers, " <>
       responseStatusF <> " AS response_status " <>
-    "FROM ( SELECT * FROM " <> sourceCTE <> " ) _postgrest_t"
+    "FROM ( SELECT * FROM " <> sourceCTEName <> " ) _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 :: Routine -> SQL.Snippet -> SQL.Snippet -> SQL.Snippet -> Bool ->
+prepareCall :: Bool -> Bool -> SQL.Snippet -> SQL.Snippet -> SQL.Snippet -> Bool ->
-               MediaType -> ResultAggregate -> Bool ->
+               MediaType -> Bool -> Maybe FieldName -> Bool ->
                SQL.Statement () ResultSet
-prepareCall rout callProcQuery selectQuery countQuery countTotal mt rAgg =
+prepareCall returnsScalar returnsSingle callProcQuery selectQuery countQuery countTotal mt multObjects binaryField =
   SQL.dynamicallyParameterized (mtSnippet mt snippet) decodeIt
   where
     snippet =
-      "WITH " <> sourceCTE <> " AS (" <> callProcQuery <> ") " <>
+      "WITH " <> SQL.sql sourceCTEName <> " AS (" <> callProcQuery <> ") " <>
       countCTEF <>
+      SQL.sql (
       "SELECT " <>
         countResultF <> " AS total_result_set, " <>
         "pg_catalog.count(_postgrest_t) AS page_total, " <>
-        aggF (Just rout) rAgg <> " AS body, " <>
+        bodyF <> " 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
@@ -158,8 +188,8 @@ standardRow noLocation =
 
 mtSnippet :: MediaType -> SQL.Snippet -> SQL.Snippet
 mtSnippet mediaType snippet = case mediaType of
-  MTPlan _ fmt opts -> explainF fmt opts snippet
+  MTPlan (MTPlanAttrs _ fmt opts) -> explainF fmt opts snippet
-  _                 -> 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

src/PostgREST/Response.hs

@@ -1,15 +1,9 @@
-{- |
-   Module      : PostgREST.Response
-   Description : Generate HTTP Response
--}
 {-# LANGUAGE NamedFieldPuns  #-}
 {-# LANGUAGE RecordWildCards #-}
 module PostgREST.Response
   ( createResponse
   , deleteResponse
-  , infoIdentResponse
+  , infoResponse
-  , infoProcResponse
-  , infoRootResponse
   , invokeResponse
   , openApiResponse
   , readResponse
@@ -18,16 +12,12 @@ module PostgREST.Response
   , addRetryHint
   , isServiceUnavailable
   , optionalRollback
-  , concatPrefAppsHeaders
-  , addPrefToHeaders
-  , 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
@@ -40,10 +30,10 @@ import qualified PostgREST.RangeQuery       as RangeQuery
 import qualified PostgREST.Response.OpenAPI as OpenAPI
 
 import PostgREST.ApiRequest              (ApiRequest (..),
-                                          InvokeMethod (..))
+                                          InvokeMethod (..),
+                                          Target (..))
 import PostgREST.ApiRequest.Preferences  (PreferRepresentation (..),
                                           PreferTransaction (..),
-                                          Preferences (..),
                                           shouldCount,
                                           toAppliedHeader)
 import PostgREST.ApiRequest.QueryParams  (QueryParams (..))
@@ -56,17 +46,17 @@ import PostgREST.Response.GucHeader      (GucHeader, unwrapGucHeader)
 import PostgREST.SchemaCache             (SchemaCache (..))
 import PostgREST.SchemaCache.Identifiers (QualifiedIdentifier (..),
                                           Schema)
-import PostgREST.SchemaCache.Routine     (FuncVolatility (..),
+import PostgREST.SchemaCache.Proc        (ProcDescription (..),
-                                          Routine (..), RoutineMap)
+                                          ProcVolatility (..),
+                                          ProcsMap)
 import PostgREST.SchemaCache.Table       (Table (..), TablesMap)
 
-import qualified PostgREST.ApiRequest.Types    as ApiRequestTypes
+import qualified PostgREST.ApiRequest.Types as ApiRequestTypes
-import qualified PostgREST.SchemaCache.Routine as Routine
+import qualified PostgREST.SchemaCache.Proc as Proc
 
 import Protolude      hiding (Handler, toS)
 import Protolude.Conv (toS)
 
-
 readResponse :: Bool -> QualifiedIdentifier -> ApiRequest -> ResultSet -> Wai.Response
 readResponse headersOnly identifier ctxApiRequest@ApiRequest{..} resultSet = case resultSet of
   RSStandard{..} -> do
@@ -93,7 +83,7 @@ readResponse headersOnly identifier ctxApiRequest@ApiRequest{..} resultSet = cas
     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
+createResponse QualifiedIdentifier{..} MutateReadPlan{mrMutatePlan} ctxApiRequest@ApiRequest{..} resultSet = case resultSet of
   RSStandard{..} -> do
     let
       pkCols = case mrMutatePlan of { Insert{insPkCols} -> insPkCols; _ -> mempty;}
@@ -110,83 +100,89 @@ createResponse QualifiedIdentifier{..} MutateReadPlan{mrMutatePlan} ctxApiReques
                     <> HTTP.renderSimpleQuery True rsLocation
                 )
           , Just . RangeQuery.contentRangeH 1 0 $
-              if shouldCount preferCount then Just rsQueryTotal else Nothing
+              if shouldCount iPreferCount then Just rsQueryTotal else Nothing
           , if null pkCols && isNothing (qsOnConflict iQueryParams) then
               Nothing
             else
-              toAppliedHeader <$> preferResolution
+              toAppliedHeader <$> iPreferResolution
-          , toAppliedHeader <$> preferMissing
           ]
 
-    case preferRepresentation of
+    if iPreferRepresentation == Full then
-      Just Full -> response HTTP.status201 (addPrefToHeaders headers Full ++ contentTypeHeaders ctxApiRequest) (LBS.fromStrict rsBody)
+      response HTTP.status201 (headers ++ contentTypeHeaders ctxApiRequest) (LBS.fromStrict rsBody)
-      Just None -> response HTTP.status201 (addPrefToHeaders headers None) mempty
+    else
-      Just HeadersOnly -> response HTTP.status201 (addPrefToHeaders headers HeadersOnly) mempty
+      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
+updateResponse ctxApiRequest@ApiRequest{..} resultSet = case resultSet of
   RSStandard{..} -> do
     let
       response = gucResponse rsGucStatus rsGucHeaders
       contentRangeHeader =
-        Just . RangeQuery.contentRangeH 0 (rsQueryTotal - 1) $
+        RangeQuery.contentRangeH 0 (rsQueryTotal - 1) $
-          if shouldCount preferCount then Just rsQueryTotal else Nothing
+          if shouldCount iPreferCount then Just rsQueryTotal else Nothing
-      headers = catMaybes [contentRangeHeader, toAppliedHeader <$> preferMissing]
+      headers = [contentRangeHeader]
 
-    case preferRepresentation of
+    if iPreferRepresentation == Full then
-        Just Full -> response HTTP.status200 (addPrefToHeaders headers Full ++ contentTypeHeaders ctxApiRequest)
+        response HTTP.status200
+          (headers ++ contentTypeHeaders ctxApiRequest)
           (LBS.fromStrict rsBody)
-        Just None -> response HTTP.status204 (addPrefToHeaders headers None) mempty
+      else
-        _ -> 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
+singleUpsertResponse ctxApiRequest@ApiRequest{..} resultSet = case resultSet of
   RSStandard {..} -> do
     let
       response = gucResponse rsGucStatus rsGucHeaders
 
-    case preferRepresentation of
+    if iPreferRepresentation == Full then
-      Just Full -> response HTTP.status200 (contentTypeHeaders ctxApiRequest ++ [toAppliedHeader Full]) (LBS.fromStrict rsBody)
+      response HTTP.status200 (contentTypeHeaders ctxApiRequest) (LBS.fromStrict rsBody)
-      Just None -> response HTTP.status204 [toAppliedHeader None] mempty
+    else
-      _ -> response HTTP.status204 [] mempty
+      response HTTP.status204 [] 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
+deleteResponse ctxApiRequest@ApiRequest{..} resultSet = case resultSet of
   RSStandard {..} -> do
     let
       response = gucResponse rsGucStatus rsGucHeaders
       contentRangeHeader =
         RangeQuery.contentRangeH 1 0 $
-          if shouldCount preferCount then Just rsQueryTotal else Nothing
+          if shouldCount iPreferCount then Just rsQueryTotal else Nothing
       headers = [contentRangeHeader]
 
-    case preferRepresentation of
+    if iPreferRepresentation == Full then
-        Just Full -> response HTTP.status200 (addPrefToHeaders headers Full ++ contentTypeHeaders ctxApiRequest)
+        response HTTP.status200
+          (headers ++ contentTypeHeaders ctxApiRequest)
           (LBS.fromStrict rsBody)
-        Just None -> response HTTP.status204 (addPrefToHeaders headers None) mempty
+      else
-        _ -> 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
+infoResponse :: Target -> SchemaCache -> Wai.Response
-infoIdentResponse identifier sCache =
+infoResponse target sCache =
-  case HM.lookup identifier (dbTables sCache) of
+  case target of
-    Just tbl -> respondInfo $ allowH tbl
+    TargetIdent identifier ->
-    Nothing  -> Error.errorResponseFor $ Error.ApiRequestError ApiRequestTypes.NotFound
+      case HM.lookup identifier (dbTables sCache) of
+        Just tbl -> respondInfo $ allowH tbl
+        Nothing  -> Error.errorResponseFor $ Error.ApiRequestError ApiRequestTypes.NotFound
+    TargetProc pd _
+      | pdVolatility pd == Volatile -> respondInfo "OPTIONS,POST"
+      | otherwise                   -> respondInfo "OPTIONS,GET,HEAD,POST"
+    TargetDefaultSpec _             -> respondInfo "OPTIONS,GET,HEAD"
   where
+    respondInfo allowHeader = 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 "," $
@@ -196,19 +192,7 @@ infoIdentResponse identifier sCache =
           ["PATCH" | tableUpdatable table] ++
           ["DELETE" | tableDeletable table]
 
-infoProcResponse :: Routine -> Wai.Response
+invokeResponse :: InvokeMethod -> ProcDescription -> ApiRequest -> ResultSet -> 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{..} resultSet = case resultSet of
   RSStandard {..} -> do
     let
@@ -221,7 +205,7 @@ invokeResponse invMethod proc ctxApiRequest@ApiRequest{..} resultSet = case resu
         else LBS.fromStrict rsBody
       headers = [contentRange]
 
-    if Routine.funcReturnsVoid proc then
+    if Proc.procReturnsVoid proc then
         response HTTP.status204 headers mempty
       else
         response status
@@ -231,11 +215,11 @@ invokeResponse invMethod proc ctxApiRequest@ApiRequest{..} resultSet = case resu
   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 :: Bool -> Maybe (TablesMap, ProcsMap, Maybe Text) -> AppConfig -> SchemaCache -> Schema -> Bool -> Wai.Response
-openApiResponse versions headersOnly body conf sCache schema negotiatedByProfile =
+openApiResponse 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)
+    (maybe mempty (\(x, y, z) -> if headersOnly then mempty else OpenAPI.encode conf sCache x y z) body)
 
 -- | Response with headers and status overridden from GUCs.
 gucResponse
@@ -279,14 +263,14 @@ isServiceUnavailable :: Wai.Response -> Bool
 isServiceUnavailable response = Wai.responseStatus response == HTTP.status503
 
 optionalRollback :: AppConfig -> ApiRequest -> ExceptT Error.Error IO Wai.Response -> ExceptT Error.Error IO Wai.Response
-optionalRollback AppConfig{..} ApiRequest{iPreferences=Preferences{..}} resp = do
+optionalRollback AppConfig{..} ApiRequest{..} resp = do
   newRes <- catchError resp $ return . Error.errorResponseFor
   return $ Wai.mapResponseHeaders preferenceApplied newRes
   where
     shouldCommit =
-      configDbTxAllowOverride && preferTransaction == Just Commit
+      configDbTxAllowOverride && iPreferTransaction == Just Commit
     shouldRollback =
-      configDbTxAllowOverride && preferTransaction == Just Rollback
+      configDbTxAllowOverride && iPreferTransaction == Just Rollback
     preferenceApplied
       | shouldCommit =
           addHeadersIfNotIncluded
@@ -300,44 +284,5 @@ optionalRollback AppConfig{..} ApiRequest{iPreferences=Preferences{..}} resp = d
 -- | 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, nv) -> isNothing $ find (\(ik, iv) -> ik == nk && nv == iv) initialHeaders) newHeaders ++
+  filter (\(nk, _) -> isNothing $ find (\(ik, _) -> ik == nk) initialHeaders) newHeaders ++
   initialHeaders
-
--- |  Filters out multiple Preference-Applied Headers from the list and concatenate them into a single Preference-Applied header:
---
--- >>> :{
---  concatPrefAppsHeaders
---     [("Content-Type","application/json")
---     , ("Preference-Applied","tx=commit")
---     , ("Preference-Applied","return=minimal")]
--- :}
--- [("Content-Type","application/json"),("Preference-Applied","tx=commit, return=minimal")]
-
-concatPrefAppsHeaders :: [HTTP.Header] -> [HTTP.Header]
-concatPrefAppsHeaders headers = otherHeaders ++ [(HTTP.hPreferenceApplied, combinedPrefApps)]
-  where
-  (prefApps, otherHeaders) = L.partition (\(k, _) -> k == HTTP.hPreferenceApplied) headers
-  prefAppsValues = [ v | (_,v) <- prefApps]
-  combinedPrefApps = BS.intercalate ", " prefAppsValues
-
--- | Given response headers and a preferRepresentation value, add
---   preferRepresentation to Preference-Applied
---
--- >>> :{
---  addPrefToHeaders
---      [("Content-Type", "application/json")
---      , ("Preference-Applied", "tx=commit")]
---      None
--- :}
--- [("Content-Type","application/json"),("Preference-Applied","tx=commit, return=minimal")]
-
-addPrefToHeaders :: [HTTP.Header] -> PreferRepresentation -> [HTTP.Header]
-addPrefToHeaders headers pref = concatPrefAppsHeaders (headers ++ [toAppliedHeader pref])
-
-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)] ++))

src/PostgREST/Response/OpenAPI.hs

@@ -12,6 +12,7 @@ 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)
@@ -27,24 +28,23 @@ import PostgREST.Config                   (AppConfig (..), Proxy (..),
                                            isMalformedProxyUri, toURI)
 import PostgREST.SchemaCache              (SchemaCache (..))
 import PostgREST.SchemaCache.Identifiers  (QualifiedIdentifier (..))
+import PostgREST.SchemaCache.Proc         (ProcDescription (..),
+                                           ProcParam (..))
 import PostgREST.SchemaCache.Relationship (Cardinality (..),
                                            Relationship (..),
                                            RelationshipsMap)
-import PostgREST.SchemaCache.Routine      (Routine (..),
-                                           RoutineParam (..))
 import PostgREST.SchemaCache.Table        (Column (..), Table (..),
-                                           TablesMap,
+                                           TablesMap)
-                                           tableColumnsList)
+import PostgREST.Version                  (docsVersion, prettyVersion)
 
 import PostgREST.MediaType
 
 import Protolude hiding (Proxy, get)
 
-encode :: (Text, Text) -> AppConfig -> SchemaCache -> TablesMap -> HM.HashMap k [Routine] -> Maybe Text -> LBS.ByteString
+encode :: AppConfig -> SchemaCache -> TablesMap -> HM.HashMap k [ProcDescription] -> Maybe Text -> LBS.ByteString
-encode versions conf sCache tables procs schemaDescription =
+encode conf sCache tables procs schemaDescription =
   JSON.encode $
     postgrestSpec
-      versions
       (dbRelationships sCache)
       (concat $ HM.elems procs)
       (snd <$> HM.toList tables)
@@ -72,15 +72,9 @@ toSwaggerType colType             = case T.takeEnd 2 colType of
   "[]" -> Just SwaggerArray
   _    -> Just SwaggerString
 
-typeFromArray :: Text -> Text
+makeSwaggerItemType :: Maybe (SwaggerType t) -> Text -> Maybe (Referenced Schema)
-typeFromArray = T.dropEnd 2
+makeSwaggerItemType itemType colType = case itemType of
-
+  Just SwaggerArray -> Just $ Inline (mempty & type_ .~ toSwaggerType (T.dropEnd 2 colType))
-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
@@ -99,8 +93,8 @@ makeTableDef rels t =
       (tn, (mempty :: Schema)
         & description .~ tableDescription t
         & type_ ?~ SwaggerObject
-        & properties .~ fromList (makeProperty t rels <$> tableColumnsList t)
+        & properties .~ fromList (makeProperty t rels <$> tableColumns t)
-        & required .~ fmap colName (filter (not . colNullable) $ tableColumnsList t))
+        & required .~ fmap colName (filter (not . colNullable) $ tableColumns t))
 
 makeProperty :: Table -> RelationshipsMap -> Column -> (Text, Referenced Schema)
 makeProperty tbl rels col = (colName col, Inline s)
@@ -134,6 +128,7 @@ makeProperty tbl rels col = (colName col, Inline s)
         Just $ T.append (maybe "" (`T.append` "\n\n") $ colDescription col) (T.intercalate "\n" n)
       else
         colDescription col
+    pType = toSwaggerType (colType col)
     s =
       (mempty :: Schema)
         & default_ .~ (JSON.decode . toUtf8Lazy . parseDefault (colType col) =<< colDefault col)
@@ -141,10 +136,10 @@ makeProperty tbl rels col = (colName col, Inline s)
         & enum_ .~ e
         & format ?~ colType col
         & maxLength .~ (fromIntegral <$> colMaxLen col)
-        & type_ .~ toSwaggerType (colType col)
+        & type_ .~ pType
-        & items .~ (SwaggerItemsObject <$> makePropertyItems (colType col))
+        & items .~ (SwaggerItemsObject <$> makeSwaggerItemType pType (colType col))
 
-makeProcSchema :: Routine -> Schema
+makeProcSchema :: ProcDescription -> Schema
 makeProcSchema pd =
   (mempty :: Schema)
   & description .~ pdDescription pd
@@ -152,12 +147,12 @@ makeProcSchema pd =
   & properties .~ fromList (fmap makeProcProperty (pdParams pd))
   & required .~ fmap ppName (filter ppReq (pdParams pd))
 
-makeProcProperty :: RoutineParam -> (Text, Referenced Schema)
+makeProcProperty :: ProcParam -> (Text, Referenced Schema)
-makeProcProperty (RoutineParam n t _ _ _) = (n, Inline s)
+makeProcProperty (ProcParam n t _ _) = (n, Inline s)
   where
     s = (mempty :: Schema)
           & type_ .~ toSwaggerType t
-          & items .~ (SwaggerItemsObject <$> makePropertyItems t)
+          & items .~ (SwaggerItemsObject <$> makeSwaggerItemType (toSwaggerType t) t)
           & format ?~ t
 
 makePreferParam :: [Text] -> Param
@@ -179,37 +174,8 @@ makePreferParam ts =
       "resolution" -> ["resolution=ignore-duplicates", "resolution=merge-duplicates"]
       _            -> []
 
-makeProcGetParam :: RoutineParam -> Referenced Param
+makeProcParam :: ProcDescription -> [Referenced Param]
-makeProcGetParam (RoutineParam n t _ r v) =
+makeProcParam pd =
-  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
@@ -275,7 +241,7 @@ makeParamDefs ti =
         & in_ .~ ParamQuery
         & type_ ?~ SwaggerString))
   ]
-  <> concat [ makeObjectBody (tableName t) : makeRowFilters (tableName t) (tableColumnsList t)
+  <> concat [ makeObjectBody (tableName t) : makeRowFilters (tableName t) (tableColumns t)
             | t <- ti
             ]
 
@@ -336,29 +302,24 @@ 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 <- tableColumnsList t ]
+    rs = [ T.intercalate "." ["rowFilter", tn, colName c ] | c <- tableColumns t ]
     ref = Ref . Reference
 
-makeProcPathItem :: Routine -> (FilePath, PathItem)
+makeProcPathItem :: ProcDescription -> (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
-    procOp = (mempty :: Operation)
+    postOp = (mempty :: Operation)
       & summary .~ pSum
       & description .~ mfilter (/="") pDesc
+      & parameters .~ makeProcParam pd
       & tags .~ Set.fromList ["(rpc) " <> pdName pd]
-      & produces ?~ makeMimeList [MTApplicationJSON, MTSingularJSON True, MTSingularJSON False]
+      & produces ?~ makeMimeList [MTApplicationJSON, MTSingularJSON]
       & at 200 ?~ "OK"
-    getOp = procOp
+    pe = (mempty :: PathItem) & post ?~ postOp
-      & parameters .~ makeProcGetParams (pdParams pd)
-    postOp = procOp
-      & parameters .~ makeProcPostParams pd
-    pe = (mempty :: PathItem)
-      & get ?~ getOp
-      & post ?~ postOp
 
 makeRootPathItem :: (FilePath, PathItem)
 makeRootPathItem = ("/", p)
@@ -371,7 +332,7 @@ makeRootPathItem = ("/", p)
     pr = (mempty :: PathItem) & get ?~ getOp
     p = pr
 
-makePathItems :: [Routine] -> [Table] -> InsOrdHashMap FilePath PathItem
+makePathItems :: [ProcDescription] -> [Table] -> InsOrdHashMap FilePath PathItem
 makePathItems pds ti = fromList $ makeRootPathItem :
   fmap makePathItem ti ++ fmap makeProcPathItem pds
 
@@ -391,14 +352,14 @@ escapeHostName "*6" = "0.0.0.0"
 escapeHostName "!6" = "0.0.0.0"
 escapeHostName h    = h
 
-postgrestSpec :: (Text, Text) -> RelationshipsMap -> [Routine] -> [Table] -> (Text, Text, Integer, Text) -> Maybe Text -> Bool -> Swagger
+postgrestSpec :: RelationshipsMap -> [ProcDescription] -> [Table] -> (Text, Text, Integer, Text) -> Maybe Text -> Bool -> Swagger
-postgrestSpec (prettyVersion, docsVersion) rels pds ti (s, h, p, b) sd allowSecurityDef = (mempty :: Swagger)
+postgrestSpec rels pds ti (s, h, p, b) sd allowSecurityDef = (mempty :: Swagger)
   & basePath ?~ T.unpack b
   & schemes ?~ [s']
   & info .~ ((mempty :: Info)
-      & version .~ prettyVersion
+      & version .~ T.decodeUtf8 prettyVersion
-      & title .~ fromMaybe "PostgREST API" dTitle
+      & title .~ "PostgREST API"
-      & description ?~ fromMaybe "This is a dynamic API generated by PostgREST" dDesc)
+      & description ?~ d)
   & externalDocs ?~ ((mempty :: ExternalDocs)
     & description ?~ "PostgREST Documentation"
     & url .~ URL ("https://postgrest.org/en/" <> docsVersion <> "/api.html"))
@@ -406,16 +367,15 @@ postgrestSpec (prettyVersion, docsVersion) rels pds ti (s, h, p, b) sd allowSecu
   & definitions .~ fromList (makeTableDef rels <$> ti)
   & parameters .~ fromList (makeParamDefs ti)
   & paths .~ makePathItems pds ti
-  & produces .~ makeMimeList [MTApplicationJSON, MTSingularJSON True, MTSingularJSON False, MTTextCSV]
+  & produces .~ makeMimeList [MTApplicationJSON, MTSingularJSON, MTTextCSV]
-  & consumes .~ makeMimeList [MTApplicationJSON, MTSingularJSON True, MTSingularJSON False, MTTextCSV]
+  & consumes .~ makeMimeList [MTApplicationJSON, MTSingularJSON, 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

src/PostgREST/SchemaCache.hs

@@ -22,56 +22,46 @@ module PostgREST.SchemaCache
   ( SchemaCache(..)
   , querySchemaCache
   , accessibleTables
-  , accessibleFuncs
+  , accessibleProcs
   , schemaDescription
   ) where
 
-import Control.Monad.Extra (whenJust)
+import qualified Data.Aeson          as JSON
-
+import qualified Data.HashMap.Strict as HM
-import qualified Data.Aeson                 as JSON
+import qualified Data.Set            as S
-import qualified Data.HashMap.Strict        as HM
+import qualified Hasql.Decoders      as HD
-import qualified Data.HashMap.Strict.InsOrd as HMI
+import qualified Hasql.Encoders      as HE
-import qualified Data.Set                   as S
+import qualified Hasql.Statement     as SQL
-import qualified Hasql.Decoders             as HD
+import qualified Hasql.Transaction   as SQL
-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                      (AppConfig (..))
+import PostgREST.Config.Database          (pgVersionStatement)
-import PostgREST.Config.Database             (pgVersionStatement,
+import PostgREST.Config.PgVersion         (PgVersion, pgVersion100,
-                                              toIsolationLevel)
+                                           pgVersion110)
-import PostgREST.Config.PgVersion            (PgVersion, pgVersion100,
+import PostgREST.SchemaCache.Identifiers  (AccessSet, FieldName,
-                                              pgVersion110,
+                                           QualifiedIdentifier (..),
-                                              pgVersion120)
+                                           Schema)
-import PostgREST.SchemaCache.Identifiers     (AccessSet, FieldName,
+import PostgREST.SchemaCache.Proc         (PgType (..),
-                                              QualifiedIdentifier (..),
+                                           ProcDescription (..),
-                                              Schema)
+                                           ProcParam (..),
-import PostgREST.SchemaCache.Relationship    (Cardinality (..),
+                                           ProcVolatility (..),
-                                              Junction (..),
+                                           ProcsMap, RetType (..))
-                                              Relationship (..),
+import PostgREST.SchemaCache.Relationship (Cardinality (..),
-                                              RelationshipsMap)
+                                           Junction (..),
-import PostgREST.SchemaCache.Representations (DataRepresentation (..),
+                                           Relationship (..),
-                                              RepresentationsMap)
+                                           RelationshipsMap)
-import PostgREST.SchemaCache.Routine         (FuncVolatility (..),
+import PostgREST.SchemaCache.Table        (Column (..), Table (..),
-                                              PgType (..),
+                                           TablesMap)
-                                              RetType (..),
-                                              Routine (..),
-                                              RoutineMap,
-                                              RoutineParam (..))
-import PostgREST.SchemaCache.Table           (Column (..), ColumnMap,
-                                              Table (..), TablesMap)
 
 import Protolude
 
 
 data SchemaCache = SchemaCache
-  { dbTables          :: TablesMap
+  { dbTables        :: TablesMap
-  , dbRelationships   :: RelationshipsMap
+  , dbRelationships :: RelationshipsMap
-  , dbRoutines        :: RoutineMap
+  , dbProcs         :: ProcsMap
-  , dbRepresentations :: RepresentationsMap
   }
   deriving (Generic, JSON.ToJSON)
 
@@ -113,19 +103,15 @@ data KeyDep
 -- | A SQL query that can be executed independently
 type SqlQuery = ByteString
 
-querySchemaCache :: AppConfig -> SQL.Transaction SchemaCache
+querySchemaCache :: [Schema] -> [Schema] -> Bool -> SQL.Transaction SchemaCache
-querySchemaCache AppConfig{..} = do
+querySchemaCache schemas extraSearchPath prepared = 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 prepared
+  pgVer   <- SQL.statement mempty pgVersionStatement
   tabs    <- SQL.statement schemas $ allTables pgVer prepared
-  keyDeps <- SQL.statement (schemas, configDbExtraSearchPath) $ allViewsKeyDependencies prepared
+  keyDeps <- SQL.statement (schemas, extraSearchPath) $ allViewsKeyDependencies prepared
   m2oRels <- SQL.statement mempty $ allM2OandO2ORels pgVer prepared
-  funcs   <- SQL.statement schemas $ allFunctions pgVer prepared
+  procs   <- SQL.statement schemas $ allProcs 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
@@ -133,12 +119,8 @@ querySchemaCache AppConfig{..} = do
   return $ removeInternal schemas $ SchemaCache {
       dbTables = tabsWViewsPks
     , dbRelationships = getOverrideRelationshipsMap rels cRels
-    , dbRoutines = funcs
+    , dbProcs = procs
-    , dbRepresentations = reps
     }
-  where
-    schemas = toList configDbSchemas
-    prepared = configDbPreparedStatements
 
 -- | overrides detected relationships with the computed relationships and gets the RelationshipsMap
 getOverrideRelationshipsMap :: [Relationship] -> [Relationship] -> RelationshipsMap
@@ -164,11 +146,10 @@ getOverrideRelationshipsMap rels cRels =
 removeInternal :: [Schema] -> SchemaCache -> SchemaCache
 removeInternal schemas dbStruct =
   SchemaCache {
-      dbTables          = HM.filterWithKey (\(QualifiedIdentifier sch _) _ -> sch `elem` schemas) $ dbTables dbStruct
+      dbTables        = HM.filterWithKey (\(QualifiedIdentifier sch _) _ -> sch `elem` schemas) $ dbTables dbStruct
-    , dbRelationships   = filter (\r -> qiSchema (relForeignTable r) `elem` schemas && not (hasInternalJunction r)) <$>
+    , dbRelationships = filter (\r -> qiSchema (relForeignTable r) `elem` schemas && not (hasInternalJunction r)) <$>
-                          HM.filterWithKey (\(QualifiedIdentifier sch _, _) _ -> sch `elem` schemas ) (dbRelationships dbStruct)
+                        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.
+    , dbProcs         = dbProcs 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
@@ -197,20 +178,15 @@ decodeTables =
     <*> column HD.bool
     <*> column HD.bool
     <*> arrayColumn HD.text
-    <*> parseCols (compositeArrayColumn
+    <*> compositeArrayColumn
-      (Column
+        (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 =
@@ -246,20 +222,19 @@ viewKeyDepFromRow (s1,t1,s2,v2,cons,consType,sCols) = ViewKeyDependency (Qualifi
            | consType == "f" = FKDep
            | otherwise       = FKDepRef -- f_ref, we build this type in the query
 
-decodeFuncs :: HD.Result RoutineMap
+decodeProcs :: HD.Result ProcsMap
-decodeFuncs =
+decodeProcs =
-  -- Duplicate rows for a function means they're overloaded, order these by least args according to Routine Ord instance
+  -- 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 funcRow
+  map sort . HM.fromListWith (++) . map ((\(x,y) -> (x, [y])) . addKey) <$> HD.rowList procRow
   where
-    funcRow = Function
+    procRow = ProcDescription
               <$> column HD.text
               <*> column HD.text
               <*> nullableColumn HD.text
               <*> compositeArrayColumn
-                  (RoutineParam
+                  (ProcParam
                   <$> compositeField HD.text
                   <*> compositeField HD.text
-                  <*> compositeField HD.text
                   <*> compositeField HD.bool
                   <*> compositeField HD.bool)
               <*> (parseRetType
@@ -270,74 +245,38 @@ decodeFuncs =
                   <*> column HD.bool)
               <*> (parseVolatility <$> column HD.char)
               <*> column HD.bool
-              <*> nullableColumn (toIsolationLevel <$> HD.text)
 
-    addKey :: Routine -> (QualifiedIdentifier, Routine)
+    addKey :: ProcDescription -> (QualifiedIdentifier, ProcDescription)
     addKey pd = (QualifiedIdentifier (pdSchema pd) (pdName pd), pd)
 
-    parseRetType :: Text -> Text -> Bool -> Bool -> Bool -> RetType
+    parseRetType :: Text -> Text -> Bool -> Bool -> Bool -> Maybe RetType
-    parseRetType schema name isSetOf isComposite isCompositeAlias
+    parseRetType schema name isSetOf isComposite isVoid
-      | isSetOf   = SetOf pgType
+      | isVoid    = Nothing
-      | otherwise = Single pgType
+      | isSetOf   = Just (SetOf pgType)
+      | otherwise = Just (Single pgType)
       where
         qi = QualifiedIdentifier schema name
         pgType
-          | isComposite = Composite qi isCompositeAlias
+          | isComposite = Composite qi
-          | otherwise   = Scalar qi
+          | otherwise   = Scalar
 
-    parseVolatility :: Char -> FuncVolatility
+    parseVolatility :: Char -> ProcVolatility
     parseVolatility v | v == 'i' = Immutable
                       | v == 's' = Stable
                       | otherwise = Volatile -- only 'v' can happen here
 
-decodeRepresentations :: HD.Result RepresentationsMap
+allProcs :: PgVersion -> Bool -> SQL.Statement [Schema] ProcsMap
-decodeRepresentations =
+allProcs pgVer = SQL.Statement sql (arrayParam HE.text) decodeProcs
-  HM.fromList . map (\rep@DataRepresentation{drSourceType, drTargetType} -> ((drSourceType, drTargetType), rep)) <$> HD.rowList row
   where
-    row = DataRepresentation
+    sql = procsSqlQuery pgVer <> " AND pn.nspname = ANY($1)"
-      <$> column HD.text
-      <*> column HD.text
-      <*> column HD.text
 
--- Selects all potential data representation transformations. To qualify the cast must be
+accessibleProcs :: PgVersion -> Bool -> SQL.Statement Schema ProcsMap
--- 1. to or from a domain
+accessibleProcs pgVer = SQL.Statement sql (param HE.text) decodeProcs
--- 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 = [q|
+    sql = procsSqlQuery pgVer <> " AND pn.nspname = $1 AND has_function_privilege(p.oid, 'execute')"
-    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)))
-    |]
 
-allFunctions :: PgVersion -> Bool -> SQL.Statement [Schema] RoutineMap
+procsSqlQuery :: PgVersion -> SqlQuery
-allFunctions pgVer = SQL.Statement sql (arrayParam HE.text) decodeFuncs
+procsSqlQuery pgVer = [q|
-  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 (
@@ -368,13 +307,6 @@ funcsSqlQuery 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,
@@ -401,10 +333,9 @@ funcsSqlQuery 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,
-    bt.oid <> bt.base as rettype_is_composite_alias,
+    ('void'::regtype = t.oid) AS rettype_is_void,
     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
@@ -413,7 +344,6 @@ funcsSqlQuery 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)")
 
@@ -569,8 +499,6 @@ 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 (
@@ -579,21 +507,20 @@ tablesSqlQuery pgVer =
           c.relname::name AS table_name,
           a.attname::name AS column_name,
           d.description AS description,
-  |] <> columnDefault <> [q| AS column_default,
+          pg_get_expr(ad.adbin, ad.adrelid)::text AS column_default,
           not (a.attnotnull OR t.typtype = 'd' AND t.typnotnull) AS is_nullable,
-          CASE
-              WHEN t.typtype = 'd' THEN
               CASE
-                  WHEN nbt.nspname = 'pg_catalog'::name THEN format_type(t.typbasetype, NULL::integer)
+                  WHEN t.typtype = 'd' THEN
-                  ELSE format_type(a.atttypid, a.atttypmod)
+                  CASE
-              END
+                      WHEN nbt.nspname = 'pg_catalog'::name THEN format_type(t.typbasetype, NULL::integer)
-              ELSE
+                      ELSE format_type(a.atttypid, a.atttypmod)
-              CASE
+                  END
-                  WHEN nt.nspname = 'pg_catalog'::name THEN format_type(a.atttypid, NULL::integer)
+                  ELSE
-                  ELSE format_type(a.atttypid, a.atttypmod)
+                  CASE
-              END
+                      WHEN nt.nspname = 'pg_catalog'::name THEN format_type(a.atttypid, NULL::integer)
-          END::text AS data_type,
+                      ELSE format_type(a.atttypid, a.atttypmod)
-          format_type(a.atttypid, a.atttypmod)::text AS nominal_data_type,
+                  END
+              END::text AS data_type,
           information_schema._pg_char_max_length(
               information_schema._pg_truetypid(a.*, t.*),
               information_schema._pg_truetypmod(a.*, t.*)
@@ -613,12 +540,6 @@ tablesSqlQuery 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
@@ -635,7 +556,6 @@ tablesSqlQuery 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
@@ -767,25 +687,7 @@ tablesSqlQuery pgVer =
   "ORDER BY table_schema, table_name"
   where
     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]

src/PostgREST/SchemaCache/Identifiers.hs

@@ -24,7 +24,7 @@ data QualifiedIdentifier = QualifiedIdentifier
   { qiSchema :: Schema
   , qiName   :: TableName
   }
-  deriving (Eq, Show, Ord, Generic, JSON.ToJSON, JSON.ToJSONKey)
+  deriving (Eq, Ord, Generic, JSON.ToJSON, JSON.ToJSONKey)
 
 instance Hashable QualifiedIdentifier
 

src/PostgREST/SchemaCache/Proc.hs

@@ -0,0 +1,91 @@
+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DeriveGeneric  #-}
+
+module PostgREST.SchemaCache.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.SchemaCache.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

src/PostgREST/SchemaCache/Relationship.hs

@@ -6,7 +6,6 @@ module PostgREST.SchemaCache.Relationship
   , Relationship(..)
   , Junction(..)
   , RelationshipsMap
-  , relIsToOne
   ) where
 
 import qualified Data.Aeson          as JSON
@@ -34,7 +33,7 @@ data Relationship = Relationship
   , relToOne        :: Bool
   , relIsSelf       :: Bool
   }
-  deriving (Eq, Show, Ord, Generic, JSON.ToJSON)
+  deriving (Eq, Ord, Generic, JSON.ToJSON)
 
 -- | The relationship cardinality
 -- | https://en.wikipedia.org/wiki/Cardinality_(data_modeling)
@@ -47,7 +46,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, Show, Ord, Generic, JSON.ToJSON)
+  deriving (Eq, Ord, Generic, JSON.ToJSON)
 
 type FKConstraint = Text
 
@@ -59,14 +58,7 @@ data Junction = Junction
   , junColsSource  :: [(FieldName, FieldName)]
   , junColsTarget  :: [(FieldName, FieldName)]
   }
-  deriving (Eq, Show, Ord, Generic, JSON.ToJSON)
+  deriving (Eq, 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

src/PostgREST/SchemaCache/Representations.hs

@@ -1,29 +0,0 @@
-{-# 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

src/PostgREST/SchemaCache/Routine.hs

@@ -1,132 +0,0 @@
-{-# 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

src/PostgREST/SchemaCache/Table.hs

@@ -1,18 +1,14 @@
-{-# LANGUAGE DeriveAnyClass    #-}
+{-# LANGUAGE DeriveAnyClass #-}
-{-# LANGUAGE DeriveGeneric     #-}
+{-# LANGUAGE DeriveGeneric  #-}
-{-# LANGUAGE FlexibleInstances #-}
 
 module PostgREST.SchemaCache.Table
   ( Column(..)
   , Table(..)
-  , tableColumnsList
   , TablesMap
-  , ColumnMap
   ) where
 
-import qualified Data.Aeson                 as JSON
+import qualified Data.Aeson          as JSON
-import qualified Data.HashMap.Strict        as HM
+import qualified Data.HashMap.Strict as HM
-import qualified Data.HashMap.Strict.InsOrd as HMI
 
 import PostgREST.SchemaCache.Identifiers (FieldName,
                                           QualifiedIdentifier (..),
@@ -32,12 +28,9 @@ data Table = Table
   , tableUpdatable   :: Bool
   , tableDeletable   :: Bool
   , tablePKCols      :: [FieldName]
-  , tableColumns     :: ColumnMap
+  , tableColumns     :: [Column]
   }
-  deriving (Show, Generic, JSON.ToJSON)
+  deriving (Show, Ord, 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
@@ -47,7 +40,6 @@ data Column = Column
   , colDescription :: Maybe Text
   , colNullable    :: Bool
   , colType        :: Text
-  , colNominalType :: Text
   , colMaxLen      :: Maybe Int32
   , colDefault     :: Maybe Text
   , colEnum        :: [Text]
@@ -55,4 +47,3 @@ data Column = Column
   deriving (Eq, Show, Ord, Generic, JSON.ToJSON)
 
 type TablesMap = HM.HashMap QualifiedIdentifier Table
-type ColumnMap = HMI.InsOrdHashMap FieldName Column

src/PostgREST/Unix.hs

@@ -14,6 +14,7 @@ import System.Posix.Files (setFileMode)
 import System.Posix.Types (FileMode)
 
 import qualified PostgREST.AppState as AppState
+import qualified PostgREST.Workers  as Workers
 
 import Protolude
 
@@ -48,10 +49,10 @@ installSignalHandlers appState = do
 
   -- The SIGUSR1 signal updates the internal 'SchemaCache' by running
   -- 'connectionWorker' exactly as before.
-  install Signals.sigUSR1 $ AppState.connectionWorker appState
+  install Signals.sigUSR1 $ Workers.connectionWorker appState
 
   -- Re-read the config on SIGUSR2
-  install Signals.sigUSR2 $ AppState.reReadConfig False appState
+  install Signals.sigUSR2 $ Workers.reReadConfig False appState
   where
     install signal handler =
       void $ Signals.installHandler signal (Signals.Catch handler) Nothing

src/PostgREST/Workers.hs

@@ -0,0 +1,335 @@
+{-# LANGUAGE LambdaCase      #-}
+{-# LANGUAGE NamedFieldPuns  #-}
+{-# LANGUAGE RecordWildCards #-}
+
+module PostgREST.Workers
+  ( connectionWorker
+  , reReadConfig
+  , runListener
+  , runAdmin
+  ) where
+
+import qualified Data.Aeson                 as JSON
+import qualified Data.ByteString            as BS
+import qualified Data.ByteString.Lazy       as LBS
+import qualified Data.Text                  as T
+import qualified Hasql.Notifications        as SQL
+import qualified Hasql.Session              as SQL
+import qualified Hasql.Transaction.Sessions 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.Retry    (RetryStatus, capDelay, exponentialBackoff,
+                         retrying, rsPreviousDelay)
+import Hasql.Connection (acquire)
+
+import Network.Socket
+import Network.Socket.ByteString
+
+import PostgREST.AppState         (AppState)
+import PostgREST.Config           (AppConfig (..), readAppConfig)
+import PostgREST.Config.Database  (queryDbSettings, queryPgVersion)
+import PostgREST.Config.PgVersion (PgVersion (..), minimumPgVersion)
+import PostgREST.Error            (checkIsFatal)
+import PostgREST.SchemaCache      (querySchemaCache)
+
+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(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.
+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 <- establishConnection appState
+      case connected of
+        FatalConnectionError reason ->
+          -- Fatal error when connecting
+          AppState.logWithZTime appState reason >> killThread (AppState.getMainThreadId appState)
+        NotConnected ->
+          -- Unreachable because establishConnection 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
+
+-- | 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 $ AppState.flushPool 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
+          AppState.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 . AppState.logWithZTime appState $
+        "Attempting to reconnect to the database in "
+        <> (show delay::Text)
+        <> " seconds..."
+      when itShould $ AppState.putRetryNextIn appState delay
+      return itShould
+
+-- | Load the SchemaCache 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 $
+      querySchemaCache (toList configDbSchemas) configDbExtraSearchPath configDbPreparedStatements
+  case result of
+    Left e -> do
+      case checkIsFatal e of
+        Just hint -> do
+          AppState.logWithZTime appState "A fatal error ocurred when loading the schema cache"
+          AppState.logPgrstError appState e
+          AppState.logWithZTime appState hint
+          return SCFatalFail
+        Nothing -> do
+          AppState.putSchemaCache appState Nothing
+          AppState.logWithZTime appState "An error ocurred when loading the schema cache"
+          AppState.logPgrstError appState e
+          return SCOnRetry
+
+    Right sCache -> do
+      AppState.putSchemaCache appState (Just sCache)
+      when (isJust configDbRootSpec) .
+        AppState.putJsonDbS appState . LBS.toStrict $ JSON.encode sCache
+      AppState.logWithZTime appState "Schema cache loaded"
+      return SCLoaded
+
+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{..} <- 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            = 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
+
+-- | 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
+          AppState.logWithZTime appState
+            "An error ocurred when trying to query database settings for the config parameters"
+          case checkIsFatal e of
+            Just hint -> do
+              AppState.logPgrstError appState e
+              AppState.logWithZTime appState hint
+              killThread (AppState.getMainThreadId appState)
+            Nothing -> do
+              AppState.logPgrstError appState e
+          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"
+
+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
+    whenJust :: Applicative m => Maybe a -> (a -> m ()) -> m ()
+    whenJust mg f = maybe (pure ()) f mg
+    adminApp = admin appState conf
+
+-- | PostgREST admin application
+admin :: AppState.AppState -> AppConfig -> Wai.Application
+admin appState appConfig req respond  = do
+  isMainAppReachable  <- any isRight <$> reachMainApp appConfig
+  isSchemaCacheLoaded <- isJust <$> AppState.getSchemaCache appState
+  isConnectionUp      <-
+    if configDbChannelEnabled appConfig
+      then AppState.getIsListenerOn appState
+      else isRight <$> AppState.usePool appState (SQL.sql "SELECT 1")
+
+  case Wai.pathInfo req of
+    ["ready"] ->
+      respond $ Wai.responseLBS (if isMainAppReachable && isConnectionUp && isSchemaCacheLoaded then HTTP.status200 else HTTP.status503) [] mempty
+    ["live"] ->
+      respond $ Wai.responseLBS (if isMainAppReachable then HTTP.status200 else HTTP.status503) [] mempty
+    _ ->
+      respond $ Wai.responseLBS HTTP.status404 [] mempty
+
+-- Try to connect to the main app socket
+-- Note that it doesn't even send a valid HTTP request, we just want to check that the main app is accepting connections
+-- The code for resolving the "*4", "!4", "*6", "!6", "*" special values is taken from
+-- https://hackage.haskell.org/package/streaming-commons-0.2.2.4/docs/src/Data.Streaming.Network.html#bindPortGenEx
+reachMainApp :: AppConfig -> IO [Either IOException ()]
+reachMainApp AppConfig{..} =
+  case configServerUnixSocket of
+    Just path ->  do
+      sock <- socket AF_UNIX Stream 0
+      (:[]) <$> try (do
+        connect sock $ SockAddrUnix path
+        withSocketsDo $ bracket (pure sock) close sendEmpty)
+    Nothing -> do
+      let
+        host | configServerHost `elem` ["*4", "!4", "*6", "!6", "*"] = Nothing
+             | otherwise                                             = Just configServerHost
+        filterAddrs xs =
+          case configServerHost of
+              "*4" -> ipv4Addrs xs ++ ipv6Addrs xs
+              "!4" -> ipv4Addrs xs
+              "*6" -> ipv6Addrs xs ++ ipv4Addrs xs
+              "!6" -> ipv6Addrs xs
+              _    -> xs
+        ipv4Addrs = filter ((/=) AF_INET6 . addrFamily)
+        ipv6Addrs = filter ((==) AF_INET6 . addrFamily)
+
+      addrs <- getAddrInfo (Just $ defaultHints { addrSocketType = Stream }) (T.unpack <$> host) (Just . show $ configServerPort)
+      tryAddr `traverse` filterAddrs addrs
+  where
+    sendEmpty sock = void $ send sock mempty
+    tryAddr :: AddrInfo -> IO (Either IOException ())
+    tryAddr addr = do
+      sock <- socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr)
+      try $ do
+        connect sock $ addrAddress addr
+        withSocketsDo $ bracket (pure sock) close sendEmpty

stack.yaml

@@ -12,5 +12,5 @@ nix:
 extra-deps:
   - git: https://github.com/PostgREST/postgresql-libpq.git
     commit: 890a0a16cf57dd401420fdc6c7d576fb696003bc
-  - hasql-notifications-0.2.0.5
+  - hasql-notifications-0.2.0.4
-  - hasql-pool-0.10
+  - hasql-pool-0.9

stack.yaml.lock

@@ -16,19 +16,19 @@ packages:
     commit: 890a0a16cf57dd401420fdc6c7d576fb696003bc
     git: https://github.com/PostgREST/postgresql-libpq.git
 - completed:
-    hackage: hasql-notifications-0.2.0.5@sha256:6c67d2ee42e948162e89176a2f52a2c6bb562678b33688e96e048be9b3d74122,2028
+    hackage: hasql-notifications-0.2.0.4@sha256:9a09fa9b97feadd9492c8bd8bc6b9cffe0513510102f08374b0c45ecd479ed67,2028
     pantry-tree:
-      sha256: 8493755b0817a36b910a37d568769ca49ab715ef5dd935a0d09f0716aa39da51
+      sha256: 56f9e240728e7a65711dde45fa2e2075b914e32cd370424aaa4572392378a60e
       size: 452
   original:
-    hackage: hasql-notifications-0.2.0.5
+    hackage: hasql-notifications-0.2.0.4
 - completed:
-    hackage: hasql-pool-0.10@sha256:912197a328acb85505f98bb9700d61f366b87659ca45126c5c2d636687b801c3,2112
+    hackage: hasql-pool-0.9@sha256:db7a37f6b3a922c37adc3c7ced47a7c10786d1f171e47a735a6e812a587ba44c,2111
     pantry-tree:
-      sha256: b655c540a49764a8d16b62941137e295b936b96edc0785eb9250972f0f92dc47
+      sha256: 49b1181d28c6f5317e794671c2dae155754b834bdcfa30f7e5dbad28e4cf0249
       size: 346
   original:
-    hackage: hasql-pool-0.10
+    hackage: hasql-pool-0.9
 snapshots:
 - completed:
     sha256: 4905c93319aa94aa53da8f41d614d7bacdbfe6c63a8c6132d32e6e62f24a9af4

test/doc/Main.hs

@@ -11,14 +11,9 @@ main =
     [ "-XOverloadedStrings"
     , "-XNoImplicitPrelude"
     , "-XStandaloneDeriving"
-    , "-XDuplicateRecordFields"
     , "-isrc"
     , "src/PostgREST/Query/SqlFragment.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"
     ]

test/io/configs/aliases.config

@@ -1,5 +1,4 @@
 db-schema = "provided_through_alias"
-db-pool-timeout = 5
 max-rows = 1000
 pre-request = "check_alias"
 role-claim-key = ".aliased"

test/io/configs/expected/aliases.config

@@ -7,13 +7,11 @@ db-plan-enabled = false
 db-pool = 10
 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
@@ -28,7 +26,6 @@ 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 = ""

test/io/configs/expected/boolean-numeric.config

@@ -7,13 +7,11 @@ db-plan-enabled = false
 db-pool = 10
 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
@@ -28,7 +26,6 @@ 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 = ""

test/io/configs/expected/boolean-string.config

@@ -7,13 +7,11 @@ db-plan-enabled = false
 db-pool = 10
 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
@@ -28,7 +26,6 @@ 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 = ""

test/io/configs/expected/defaults.config

@@ -7,13 +7,11 @@ db-plan-enabled = false
 db-pool = 10
 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
@@ -28,7 +26,6 @@ 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 = ""

test/io/configs/expected/no-defaults-with-db-other-authenticator.config

@@ -1,4 +1,4 @@
-db-anon-role = "pre_config_role"
+db-anon-role = "other"
 db-channel = "postgrest"
 db-channel-enabled = false
 db-extra-search-path = "public,extensions,other"
@@ -7,18 +7,16 @@ db-plan-enabled = true
 db-pool = 1
 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\".\"pre_config_role\""
+jwt-role-claim-key = ".\"other\".\"role\""
 jwt-secret = "ODERREALLYREALLYREALLYREALLYVERYSAFE"
 jwt-secret-is-base64 = true
 log-level = "info"
@@ -28,7 +26,6 @@ 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

test/io/configs/expected/no-defaults-with-db.config

@@ -7,13 +7,11 @@ db-plan-enabled = true
 db-pool = 1
 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
@@ -28,7 +26,6 @@ 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

test/io/configs/expected/no-defaults.config

@@ -7,13 +7,11 @@ db-plan-enabled = true
 db-pool = 1
 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
@@ -28,7 +26,6 @@ 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

test/io/configs/expected/types.config

@@ -7,13 +7,11 @@ db-plan-enabled = false
 db-pool = 10
 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
@@ -28,7 +26,6 @@ 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 = ""

test/io/configs/no-defaults-env.yaml

@@ -9,15 +9,14 @@ PGRST_DB_PLAN_ENABLED: true
 PGRST_DB_POOL: 1
 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"'
@@ -30,7 +29,6 @@ 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

test/io/configs/no-defaults.config

@@ -7,13 +7,11 @@ db-plan-enabled = true
 db-pool = 1
 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
@@ -28,7 +26,6 @@ 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

test/io/db_config.sql

@@ -9,7 +9,6 @@ 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';
@@ -18,7 +17,6 @@ ALTER ROLE db_config_authenticator SET pgrst.db_pre_request = 'test.custom_heade
 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';
@@ -41,10 +39,7 @@ 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_pool_acquisition_timeout = 'ignored';
+ALTER ROLE db_config_authenticator SET pgrst.db_config = '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;
@@ -53,6 +48,9 @@ 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';
@@ -62,33 +60,6 @@ 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;

test/io/fixtures.sql

@@ -1,27 +1,14 @@
--- \ir big_schema.sql big schema test currently skipped, see test_io.py
+\ir big_schema.sql
 \ir db_config.sql
 
 set search_path to public;
 
 CREATE ROLE postgrest_test_anonymous;
-ALTER ROLE :PGUSER SET pgrst.db_anon_role = 'postgrest_test_anonymous';
+ALTER ROLE :USER SET pgrst.db_anon_role = 'postgrest_test_anonymous';
 
 CREATE ROLE postgrest_test_author;
 
-CREATE ROLE postgrest_test_serializable;
+GRANT postgrest_test_anonymous, postgrest_test_author TO :USER;
-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;
@@ -30,7 +17,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, postgrest_test_w_superuser_settings;
+GRANT SELECT ON projects TO postgrest_test_anonymous;
 
 create function get_guc_value(name text) returns text as $$
   select nullif(current_setting(name), '')::text;
@@ -97,7 +84,7 @@ create or replace function sleep(seconds double precision) returns void as $$
 $$ language sql;
 
 create or replace function hello() returns text as $$
-  select 'hello'::text;
+  select 'hello';
 $$ language sql;
 
 create table cats(id uuid primary key, name text);
@@ -111,66 +98,3 @@ as $$
   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;
-$$

test/io/fixtures.yaml

@@ -4,10 +4,6 @@ cli:
     args: ['--help']
   - name: help short
     args: ['-h']
-  - name: version long
-    args: ['--version']
-  - name: version short
-    args: ['-v']
   - name: example long
     args: ['--example']
   - name: example short

test/io/postgrest.py

@@ -42,18 +42,6 @@ class PostgrestProcess:
     process: object
     session: object
 
-    def read_stdout(self, nlines=1):
-        "Wait for line(s) on standard output."
-        output = []
-        for _ in range(10):
-            l = self.process.stdout.readline()
-            if l:
-                output.append(l.decode())
-                if len(output) >= nlines:
-                    break
-            time.sleep(0.1)
-        return output
-
 
 @contextlib.contextmanager
 def run(
@@ -64,7 +52,6 @@ def run(
     host=None,
     wait_for_readiness=True,
     no_pool_connection_available=False,
-    no_startup_stdout=True,
 ):
     "Run PostgREST and yield an endpoint that is ready for connections."
 
@@ -105,8 +92,7 @@ def run(
             if wait_for_readiness:
                 wait_until_ready(adminurl + "/ready")
 
-            if no_startup_stdout:
+            process.stdout.read()
-                process.stdout.read()
 
             if no_pool_connection_available:
                 sleep_pool_connection(baseurl, 10)
@@ -157,7 +143,7 @@ def wait_until_exit(postgrest):
     "Wait for PostgREST to exit, or times out"
     try:
         return postgrest.process.wait(timeout=1)
-    except subprocess.TimeoutExpired:
+    except (subprocess.TimeoutExpired):
         raise PostgrestTimedOut()
 
 

test/io/test_io.py

@@ -308,11 +308,13 @@ def test_db_schema_reload(tmp_path, defaultenv):
 
         # reload config
         postgrest.process.send_signal(signal.SIGUSR2)
-        time.sleep(0.1)
 
         # reload schema cache to verify that the config reload actually happened
         postgrest.process.send_signal(signal.SIGUSR1)
-        time.sleep(0.1)
+
+        # takes max 1 second to load the internal cache(big_schema.sql included now)
+        # TODO this could go back to time.sleep(0.1) if the big_schema is put in another test suite
+        time.sleep(1)
 
         response = postgrest.session.get("/rpc/get_guc_value?name=search_path")
         assert response.text == '"\\"v1\\", \\"public\\""'
@@ -414,8 +416,14 @@ def test_invalid_role_claim_key_notify_reload(defaultenv):
     with run(env=env) as postgrest:
         postgrest.session.post("/rpc/invalid_role_claim_key_reload")
 
-        output = postgrest.read_stdout()
+        output = None
-        assert "failed to parse role-claim-key value" in output[0]
+        for _ in range(10):
+            output = postgrest.process.stdout.readline()
+            if output:
+                break
+            time.sleep(0.1)
+
+        assert "failed to parse role-claim-key value" in output.decode()
 
         response = postgrest.session.post("/rpc/reset_invalid_role_claim_key")
         assert response.status_code == 204
@@ -527,6 +535,7 @@ def test_pool_size(defaultenv, metapostgrest):
     }
 
     with run(env=env) as postgrest:
+
         start = time.time()
         threads = []
         for i in range(4):
@@ -549,7 +558,7 @@ def test_pool_size(defaultenv, metapostgrest):
 
 
 def test_pool_acquisition_timeout(defaultenv, metapostgrest):
-    "Verify that PGRST_DB_POOL_ACQUISITION_TIMEOUT times out when the pool is empty"
+    "Verify that PGRST_DB_POOL_ACQUISITON_TIMEOUT times out when the pool is empty"
 
     env = {
         **defaultenv,
@@ -564,9 +573,14 @@ def test_pool_acquisition_timeout(defaultenv, metapostgrest):
         assert data["message"] == "Timed out acquiring connection from connection pool."
 
         # ensure the message appears on the logs as well
-        output = sorted(postgrest.read_stdout(nlines=2))
+        output = None
-        assert " 504 " in output[0]
+        for _ in range(10):
-        assert "Timed out acquiring connection from connection pool." in output[1]
+            output = postgrest.process.stdout.readline()
+            if output:
+                break
+            time.sleep(0.1)
+
+        assert "Timed out acquiring connection from connection pool." in output.decode()
 
 
 def test_change_statement_timeout_held_connection(defaultenv, metapostgrest):
@@ -658,6 +672,7 @@ def test_admin_ready_includes_schema_cache_state(defaultenv, metapostgrest):
     }
 
     with run(env=env) as postgrest:
+
         # make it impossible to load the schema cache, by setting statement timeout to 1ms
         set_statement_timeout(metapostgrest, role, 1)
 
@@ -713,6 +728,7 @@ def test_admin_works_with_host_special_values(specialhostvalue, defaultenv):
     "Should get a success from the admin live and ready endpoints when using special host values for the main app"
 
     with run(env=defaultenv, port=freeport(), host=specialhostvalue) as postgrest:
+
         response = postgrest.admin.get("/live")
         assert response.status_code == 200
 
@@ -768,6 +784,7 @@ def test_no_pool_connection_required_on_bad_http_logic(defaultenv):
     "no pool connection should be consumed for failing on invalid http logic"
 
     with run(env=defaultenv, no_pool_connection_available=True) as postgrest:
+
         # not found nested route shouldn't require opening a connection
         response = postgrest.session.head("/path/notfound")
         assert response.status_code == 404
@@ -783,6 +800,7 @@ def test_no_pool_connection_required_on_options(defaultenv):
     "no pool connection should be consumed for OPTIONS requests"
 
     with run(env=defaultenv, no_pool_connection_available=True) as postgrest:
+
         # OPTIONS on a table shouldn't require opening a connection
         response = postgrest.session.options("/projects")
         assert response.status_code == 200
@@ -802,6 +820,7 @@ def test_no_pool_connection_required_on_bad_jwt_claim(defaultenv):
     env = {**defaultenv, "PGRST_JWT_SECRET": SECRET}
 
     with run(env=env, no_pool_connection_available=True) as postgrest:
+
         # A JWT with an invalid signature shouldn't open a connection
         headers = jwtauthheader({"role": "postgrest_test_author"}, "Wrong Secret")
         response = postgrest.session.get("/projects", headers=headers)
@@ -812,6 +831,7 @@ def test_no_pool_connection_required_on_bad_embedding(defaultenv):
     "no pool connection should be consumed for failing to embed"
 
     with run(env=defaultenv, no_pool_connection_available=True) as postgrest:
+
         # OPTIONS on a table shouldn't require opening a connection
         response = postgrest.session.get("/projects?select=*,unexistent(*)")
         assert response.status_code == 400
@@ -821,6 +841,7 @@ def test_notify_reloading_catalog_cache(defaultenv):
     "notify should reload the connection catalog cache"
 
     with run(env=defaultenv) as postgrest:
+
         # first the id col is an uuid
         response = postgrest.session.get(
             "/cats?id=eq.dea27321-f988-4a57-93e4-8eeb38f3cf1e"
@@ -837,151 +858,6 @@ def test_notify_reloading_catalog_cache(defaultenv):
         assert response.status_code == 200
 
 
-def test_role_settings(defaultenv):
-    "statement_timeout should be set per role"
-
-    env = {
-        **defaultenv,
-        "PGRST_JWT_SECRET": SECRET,
-    }
-
-    with run(env=env) as postgrest:
-        # statement_timeout for postgrest_test_anonymous
-        response = postgrest.session.get("/rpc/get_guc_value?name=statement_timeout")
-        assert response.text == '"2s"'
-
-        # reload statement_timeout with NOTIFY
-        response = postgrest.session.post(
-            "/rpc/change_role_statement_timeout", data={"timeout": "5s"}
-        )
-        assert response.status_code == 204
-
-        response = postgrest.session.get("/rpc/reload_pgrst_config")
-        assert response.status_code == 204
-        time.sleep(0.1)
-
-        response = postgrest.session.get("/rpc/get_guc_value?name=statement_timeout")
-        assert response.text == '"5s"'
-
-        # statement_timeout for postgrest_test_author
-        headers = jwtauthheader({"role": "postgrest_test_author"}, SECRET)
-        response = postgrest.session.get(
-            "/rpc/get_guc_value?name=statement_timeout", headers=headers
-        )
-        assert response.text == '"10s"'
-
-
-def test_isolation_level(defaultenv):
-    "isolation_level should be set per role and per function"
-
-    env = {
-        **defaultenv,
-        "PGRST_JWT_SECRET": SECRET,
-    }
-
-    with run(env=env) as postgrest:
-        # default isolation level for postgrest_test_anonymous
-        response = postgrest.session.get(
-            "/items_w_isolation_level?select=isolation_level&limit=1"
-        )
-        assert response.text == '[{"isolation_level":"read committed"}]'
-
-        # isolation level for postgrest_test_repeatable_read on GET
-        headers = jwtauthheader({"role": "postgrest_test_repeatable_read"}, SECRET)
-        response = postgrest.session.get(
-            "/items_w_isolation_level?select=isolation_level&limit=1", headers=headers
-        )
-        assert response.text == '[{"isolation_level":"repeatable read"}]'
-
-        # isolation level for postgrest_test_serializable on POST
-        headers = jwtauthheader({"role": "postgrest_test_serializable"}, SECRET)
-        headers["Prefer"] = "return=representation"
-        response = postgrest.session.post(
-            "/items_w_isolation_level?select=isolation_level",
-            json={"id": "666"},
-            headers=headers,
-        )
-        assert response.text == '[{"isolation_level":"serializable"}]'
-
-        # isolation level for postgrest_test_serializable on PATCH
-        headers = jwtauthheader({"role": "postgrest_test_serializable"}, SECRET)
-        headers["Prefer"] = "return=representation"
-        response = postgrest.session.patch(
-            "/items_w_isolation_level?select=isolation_level&id=eq.666",
-            json={"id": "666"},
-            headers=headers,
-        )
-        assert response.text == '[{"isolation_level":"serializable"}]'
-
-        # isolation level for postgrest_test_serializable on DELETE
-        headers = jwtauthheader({"role": "postgrest_test_serializable"}, SECRET)
-        headers["Prefer"] = "return=representation"
-        response = postgrest.session.delete(
-            "/items_w_isolation_level?select=isolation_level&id=eq.666", headers=headers
-        )
-        assert response.text == '[{"isolation_level":"serializable"}]'
-
-        # default isolation level for function
-        response = postgrest.session.get("/rpc/default_isolation_level")
-        assert response.text == '"read committed"'
-
-        # changes with role isolation level
-        headers = jwtauthheader({"role": "postgrest_test_repeatable_read"}, SECRET)
-        response = postgrest.session.get(
-            "/rpc/default_isolation_level", headers=headers
-        )
-        assert response.text == '"repeatable read"'
-
-        # isolation level can be set per function
-        response = postgrest.session.get("/rpc/serializable_isolation_level")
-        assert response.text == '"serializable"'
-        response = postgrest.session.get("/rpc/repeatable_read_isolation_level")
-        assert response.text == '"repeatable read"'
-
-        # isolation level for a function overrides the role isolation level
-        headers = jwtauthheader({"role": "postgrest_test_repeatable_read"}, SECRET)
-        response = postgrest.session.get("/rpc/serializable_isolation_level")
-        assert response.text == '"serializable"'
-
-
-def test_schema_cache_reloading(defaultenv):
-    "schema cache should reload successfully"
-
-    # If DB_POOL=1, then the second request(/rpc/migrate_function) will just wait(PGRST_DB_POOL_ACQUISITION_TIMEOUT=10) for the schema cache reload to finish.
-    # This is bc the only pool connection will be busy with the PGRST_INTERNAL_SCHEMA_CACHE_SLEEP(does a pg_sleep)
-    # So this must be tested with a DB_POOL size of at least 2. That way the second request will pick the other pool connection and proceed.
-
-    env = {
-        **defaultenv,
-        "PGRST_INTERNAL_SCHEMA_CACHE_SLEEP": "1",
-        "PGRST_DB_CHANNEL_ENABLED": "true",
-        "PGRST_DB_POOL": "2",
-    }
-
-    internal_sleep = int(env["PGRST_INTERNAL_SCHEMA_CACHE_SLEEP"])
-
-    with run(env=env, wait_for_readiness=False) as postgrest:
-        time.sleep(2 * internal_sleep + 0.1)  # wait for readiness manually
-
-        response = postgrest.session.post("/rpc/create_function")
-        assert response.status_code == 204
-
-        time.sleep(
-            internal_sleep / 2
-        )  # wait to be inside the schema cache reload process
-
-        response = postgrest.session.post("/rpc/migrate_function")
-        assert response.status_code == 204
-
-        time.sleep(
-            2 * internal_sleep
-        )  # wait enough time to ensure the schema cache state remains
-
-        response = postgrest.session.get("/rpc/mult_them?c=3&d=4")
-        assert response.text == "12"
-        assert response.status_code == 200
-
-
 # TODO: This test fails now because of https://github.com/PostgREST/postgrest/pull/2122
 # The stack size of 1K(-with-rtsopts=-K1K) is not enough and this fails with "stack overflow"
 # A stack size of 200K seems to be enough for succeess
@@ -998,68 +874,3 @@ def test_openapi_in_big_schema(defaultenv):
     with run(env=env) as postgrest:
         response = postgrest.session.get("/")
         assert response.status_code == 200
-
-
-@pytest.mark.parametrize("dburi_type", ["no_params", "no_params_qmark", "with_params"])
-def test_get_pgrst_version_with_uri_connection_string(dburi_type, dburi, defaultenv):
-    "The fallback_application_name should be added to the db-uri if it has a URI format"
-    defaultenv_without_libpq = {
-        key: value
-        for key, value in defaultenv.items()
-        if key not in ["PGDATABASE", "PGHOST", "PGUSER"]
-    }
-
-    env = {
-        "no_params": {**defaultenv, "PGRST_DB_URI": "postgresql://"},
-        "no_params_qmark": {**defaultenv, "PGRST_DB_URI": "postgresql://?"},
-        "with_params": {**defaultenv_without_libpq, "PGRST_DB_URI": dburi.decode()},
-    }
-
-    with run(env=env[dburi_type]) as postgrest:
-        response = postgrest.session.post("/rpc/get_pgrst_version")
-        version = '"%s"' % response.headers["Server"].replace(
-            "postgrest/", "PostgREST "
-        )
-        assert response.text == version
-
-
-def test_get_pgrst_version_with_keyval_connection_string(defaultenv):
-    "The fallback_application_name should be added to the db-uri if it has a keyword/value format"
-    uri = f'dbname={defaultenv["PGDATABASE"]} host={defaultenv["PGHOST"]} user={defaultenv["PGUSER"]}'
-    defaultenv_without_libpq = {
-        key: value
-        for key, value in defaultenv.items()
-        if key not in ["PGDATABASE", "PGHOST", "PGUSER"]
-    }
-    env = {**defaultenv_without_libpq, "PGRST_DB_URI": uri}
-
-    with run(env=env) as postgrest:
-        response = postgrest.session.post("/rpc/get_pgrst_version")
-        version = '"%s"' % response.headers["Server"].replace(
-            "postgrest/", "PostgREST "
-        )
-        assert response.text == version
-
-
-def test_log_postgrest_version(defaultenv):
-    "Should show the PostgREST version in the logs"
-
-    with run(env=defaultenv, no_startup_stdout=False) as postgrest:
-        version = postgrest.session.head("/").headers["Server"].split("/")[1]
-
-        assert (
-            "Starting PostgREST %s..." % version
-            in postgrest.process.stdout.readline().decode()
-        )
-
-
-def test_succeed_w_role_having_superuser_settings(defaultenv):
-    "Should succeed when having superuser settings on the impersonated role"
-
-    env = {**defaultenv, "PGRST_DB_CONFIG": "true", "PGRST_JWT_SECRET": SECRET}
-
-    with run(stdin=SECRET.encode(), env=env) as postgrest:
-        headers = jwtauthheader({"role": "postgrest_test_w_superuser_settings"}, SECRET)
-        response = postgrest.session.get("/projects", headers=headers)
-        print(response.text)
-        assert response.status_code == 200

test/load/fixtures.sql

@@ -1,5 +1,5 @@
 CREATE ROLE postgrest_test_anonymous;
-GRANT postgrest_test_anonymous TO :PGUSER;
+GRANT postgrest_test_anonymous TO :USER;
 CREATE SCHEMA test;
 
 -- PUT+PATCH target needs one record and column to modify

test/pgbench/1567/new.sql

@@ -1,15 +0,0 @@
-INSERT INTO "test"."complex_items"("arr_data", "field-with_sep", "id", "name")
-SELECT pgrst_body."arr_data", pgrst_body."field-with_sep", pgrst_body."id", pgrst_body."name"
-FROM (
-  SELECT '[{"id": 4, "name": "Vier"}, {"id": 5, "name": "Funf", "arr_data": null}, {"id": 6, "name": "Sechs", "arr_data": [1, 2, 3], "field-with_sep": 6}]'::jsonb as json_data
-) pgrst_payload,
-LATERAL (
-  SELECT CASE WHEN jsonb_typeof(pgrst_payload.json_data) = 'array' THEN pgrst_payload.json_data ELSE jsonb_build_array(pgrst_payload.json_data) END AS val
-) pgrst_uniform_json,
-LATERAL (
-  SELECT jsonb_agg(jsonb_build_object('field-with_sep', 1) || elem) AS vals from jsonb_array_elements(pgrst_uniform_json.val) elem
-) pgrst_json_defs,
-LATERAL (
-  SELECT * FROM jsonb_to_recordset (pgrst_json_defs.vals) AS _ ("arr_data" integer[], "field-with_sep" integer, "id" bigint, "name" text)
-) pgrst_body
-RETURNING "test"."complex_items".*;

test/pgbench/1567/old.sql

@@ -1,12 +0,0 @@
-INSERT INTO "test"."complex_items"("arr_data", "field-with_sep", "id", "name")
-SELECT pgrst_body."arr_data", pgrst_body."field-with_sep", pgrst_body."id", pgrst_body."name"
-FROM (
-  SELECT '[{"id": 4, "name": "Vier"}, {"id": 5, "name": "Funf", "arr_data": null}, {"id": 6, "name": "Sechs", "arr_data": [1, 2, 3], "field-with_sep": 6}]'::jsonb as json_data
-) pgrst_payload,
-LATERAL (
-  SELECT CASE WHEN jsonb_typeof(pgrst_payload.json_data) = 'array' THEN pgrst_payload.json_data ELSE jsonb_build_array(pgrst_payload.json_data) END AS val
-) pgrst_uniform_json,
-LATERAL (
-  SELECT * FROM jsonb_to_recordset (pgrst_uniform_json.val) AS _ ("arr_data" integer[], "field-with_sep" integer, "id" bigint, "name" text)
-) pgrst_body
-RETURNING "test"."complex_items".*

test/pgbench/1652/new.sql

@@ -1,20 +0,0 @@
-WITH pgrst_source AS (
-  SELECT pgrst_call.*
-  FROM (
-    SELECT '{"id": 4}'::json as json_data
-  ) pgrst_payload,
-  LATERAL (
-    SELECT CASE WHEN json_typeof(pgrst_payload.json_data) = 'array' THEN pgrst_payload.json_data ELSE json_build_array(pgrst_payload.json_data) END AS val
-  ) pgrst_uniform_json,
-  LATERAL (
-    SELECT * FROM json_to_recordset(pgrst_uniform_json.val) AS _("id" integer) LIMIT 1
-  ) pgrst_body,
-  LATERAL "test"."get_projects_below"("id" := pgrst_body.id) pgrst_call
-)
-SELECT
-  null::bigint AS total_result_set,
-  pg_catalog.count(_postgrest_t) AS page_total,
-  coalesce(json_agg(_postgrest_t), '[]')::character varying AS body,
-  nullif(current_setting('response.headers', true), '') AS response_headers,
-  nullif(current_setting('response.status', true), '') AS response_status
-FROM (SELECT "projects".* FROM "pgrst_source" AS "projects") _postgrest_t;

test/pgbench/1652/old.sql

@@ -1,15 +0,0 @@
-WITH pgrst_source AS (
-  WITH
-  pgrst_payload AS (SELECT '{"id": 4}'::json AS json_data),
-  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),
-  pgrst_args AS ( SELECT * FROM json_to_recordset((SELECT val FROM pgrst_body)) AS _("id" integer) )
-  SELECT "get_projects_below".*
-  FROM "test"."get_projects_below"("id" := (SELECT "id" FROM pgrst_args LIMIT 1))
-)
-SELECT
-  null::bigint AS total_result_set,
-  pg_catalog.count(_postgrest_t) AS page_total,
-  coalesce(json_agg(_postgrest_t), '[]')::character varying AS body,
-  nullif(current_setting('response.headers', true), '') AS response_headers,
-  nullif(current_setting('response.status', true), '') AS response_status
-FROM (SELECT "projects".* FROM "pgrst_source" AS "projects") _postgrest_t;

test/pgbench/2677/new.sql

@@ -1,12 +0,0 @@
-INSERT INTO "test"."complex_items"("arr_data", "field-with_sep", "id", "name")
-SELECT pgrst_body."arr_data", pgrst_body."field-with_sep", pgrst_body."id", pgrst_body."name"
-FROM (
-  SELECT '[{"id": 4, "name": "Vier"}, {"id": 5, "name": "Funf", "arr_data": null}, {"id": 6, "name": "Sechs", "arr_data": [1, 2, 3], "field-with_sep": 6}]'::json as json_data
-) pgrst_payload,
-LATERAL (
-  SELECT CASE WHEN json_typeof(pgrst_payload.json_data) = 'array' THEN pgrst_payload.json_data ELSE json_build_array(pgrst_payload.json_data) END AS val
-) pgrst_uniform_json,
-LATERAL (
-  SELECT * FROM json_to_recordset (pgrst_uniform_json.val) AS _ ("arr_data" integer[], "field-with_sep" integer, "id" bigint, "name" text)
-) pgrst_body
-RETURNING "test"."complex_items".*

test/pgbench/2677/old.sql

@@ -1,7 +0,0 @@
-WITH
-pgrst_payload AS (SELECT '[{"id": 4, "name": "Vier"}, {"id": 5, "name": "Funf", "arr_data": null}, {"id": 6, "name": "Sechs", "arr_data": [1, 2, 3], "field-with_sep": 6}]'::json AS json_data),
-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)
-INSERT INTO "test"."complex_items"("arr_data", "field-with_sep", "id", "name")
-SELECT "arr_data", "field-with_sep", "id", "name"
-FROM json_to_recordset ((SELECT val FROM pgrst_body)) AS _ ("arr_data" integer[], "field-with_sep" integer, "id" bigint, "name" text)
-RETURNING "test"."complex_items".*

test/pgbench/README.md

@@ -1,13 +0,0 @@
-## pgbench tests
-
-Can be used as:
-
-```
-postgrest-with-postgresql-15 -f test/pgbench/fixtures.sql pgbench -n -T 10 -f test/pgbench/1567/old.sql
-
-postgrest-with-postgresql-15 -f test/pgbench/fixtures.sql pgbench -n -T 10 -f test/pgbench/1567/new.sql
-```
-
-## Directory structure
-
-The directory name is the issue number on github.

test/pgbench/fixtures.sql

@@ -1,7 +0,0 @@
-\ir ../spec/fixtures/load.sql
-
-ALTER TABLE test.complex_items
-    DROP CONSTRAINT complex_items_pkey;
-
-ALTER TABLE test.complex_items
-    ALTER COLUMN "field-with_sep" DROP NOT NULL;

test/spec/Feature/CorsSpec.hs

@@ -40,7 +40,7 @@ spec =
                              \Date, Location, Server, Transfer-Encoding, Range-Unit"]
           }
 
-    it "allows INFO body through even with CORS request headers present to postflight request" $ do
+    it "allows INFO body through even with CORS request headers present to postflight request" $
       request methodOptions "/items"
           [ ("Host", "localhost:3000")
           , ("User-Agent", "Mozilla/5.0 (Macintosh; Intel Mac OS X 10.9; rv:32.0) Gecko/20100101 Firefox/32.0")
@@ -54,17 +54,3 @@ spec =
         `shouldRespondWith`
           ""
           { matchHeaders = [ "Access-Control-Allow-Origin" <:> "*" ] }
-
-      request methodOptions "/items"
-          [ ("Accept", "application/json") ]
-          ""
-        `shouldRespondWith`
-          ""
-          { matchHeaders = [ "Access-Control-Allow-Origin" <:> "*" ] }
-
-      request methodOptions "/shops"
-          [ ("Accept", "application/geo+json") ]
-          ""
-        `shouldRespondWith`
-          ""
-          { matchHeaders = [ "Access-Control-Allow-Origin" <:> "*" ] }

test/spec/Feature/NoSuperuserSpec.hs

@@ -1,20 +0,0 @@
-module Feature.NoSuperuserSpec where
-
-import Network.Wai (Application)
-
-import Network.HTTP.Types
-import Test.Hspec
-import Test.Hspec.Wai
-
-import Protolude
-
-spec :: SpecWith ((), Application)
-spec =
-  describe "No Superuser" $ do
-    it "proves that the authenticator role is not a superuser" $ do
-      request methodGet "/rpc/is_superuser"
-          mempty
-          ""
-        `shouldRespondWith`
-          "false"
-          { matchStatus = 200 }

test/spec/Feature/ObservabilitySpec.hs

@@ -1,34 +0,0 @@
-module Feature.ObservabilitySpec where
-
-import Network.Wai (Application)
-
-import Network.HTTP.Types
-import Test.Hspec
-import Test.Hspec.Wai
-
-import Protolude
-
-spec :: SpecWith ((), Application)
-spec =
-  describe "Observability" $ do
-    it "includes the server trace header on the response" $ do
-      request methodHead "/"
-          [ ("X-Request-Id", "1") ]
-          ""
-        `shouldRespondWith`
-          ""
-          { matchHeaders = [ "X-Request-Id" <:> "1"] }
-
-      request methodHead "/projects"
-          [ ("X-Request-Id", "2") ]
-          ""
-        `shouldRespondWith`
-          ""
-          { matchHeaders = [ "X-Request-Id" <:> "2"] }
-
-      request methodHead "/rpc/add_them?a=2&b=4"
-          [ ("X-Request-Id", "3") ]
-          ""
-        `shouldRespondWith`
-          ""
-          { matchHeaders = [ "X-Request-Id" <:> "3"] }

test/spec/Feature/OpenApi/OpenApiSpec.hs

@@ -42,20 +42,6 @@ spec actualPgVersion = describe "OpenAPI" $ do
 
     liftIO $ docsUrl `shouldBe` Just (String ("https://postgrest.org/en/" <> docsVersion <> "/api.html"))
 
-  describe "schema" $ do
-
-    it "includes title and comments to schema" $ do
-      r <- simpleBody <$> get "/"
-
-      let childGetTitle = r ^? key "info" . key "title"
-      let childGetDescription = r ^? key "info" . key "description"
-
-      liftIO $ do
-
-        childGetTitle `shouldBe` Just "My API title"
-
-        childGetDescription `shouldBe` Just "My API description\nthat spans\nmultiple lines"
-
   describe "table" $ do
 
     it "includes paths to tables" $ do
@@ -708,153 +694,7 @@ spec actualPgVersion = describe "OpenAPI" $ do
 
   describe "RPC" $ do
 
-    it "includes function summary/description and query parameters for arguments in the get path item" $ do
+    it "includes function summary/description and body schema for arguments" $ do
-      r <- simpleBody <$> get "/"
-
-      let method s = key "paths" . key "/rpc/varied_arguments_openapi" . key s
-          args = r ^? method "get" . key "parameters"
-          summary = r ^? method "get" . key "summary"
-          description = r ^? method "get" . key "description"
-
-      liftIO $ do
-
-        summary `shouldBe` Just "An RPC function"
-
-        description `shouldBe` Just "Just a test for RPC function arguments"
-
-        args `shouldBe` Just
-          [aesonQQ|
-            [
-              {
-                "format": "double precision",
-                "in": "query",
-                "name": "double",
-                "required": true,
-                "type": "number"
-              },
-              {
-                "format": "character varying",
-                "in": "query",
-                "name": "varchar",
-                "required": true,
-                "type": "string"
-              },
-              {
-                "format": "boolean",
-                "in": "query",
-                "name": "boolean",
-                "required": true,
-                "type": "boolean"
-              },
-              {
-                "format": "date",
-                "in": "query",
-                "name": "date",
-                "required": true,
-                "type": "string"
-              },
-              {
-                "format": "money",
-                "in": "query",
-                "name": "money",
-                "required": true,
-                "type": "string"
-              },
-              {
-                "format": "enum_menagerie_type",
-                "in": "query",
-                "name": "enum",
-                "required": true,
-                "type": "string"
-              },
-              {
-                "format": "text[]",
-                "in": "query",
-                "name": "text_arr",
-                "required": true,
-                "type": "string"
-              },
-              {
-                "format": "integer[]",
-                "in": "query",
-                "name": "int_arr",
-                "required": true,
-                "type": "string"
-              },
-              {
-                "format": "boolean[]",
-                "in": "query",
-                "name": "bool_arr",
-                "required": true,
-                "type": "string"
-              },
-              {
-                "format": "character[]",
-                "in": "query",
-                "name": "char_arr",
-                "required": true,
-                "type": "string"
-              },
-              {
-                "format": "character varying[]",
-                "in": "query",
-                "name": "varchar_arr",
-                "required": true,
-                "type": "string"
-              },
-              {
-                "format": "bigint[]",
-                "in": "query",
-                "name": "bigint_arr",
-                "required": true,
-                "type": "string"
-              },
-              {
-                "format": "numeric[]",
-                "in": "query",
-                "name": "numeric_arr",
-                "required": true,
-                "type": "string"
-              },
-              {
-                "format": "json[]",
-                "in": "query",
-                "name": "json_arr",
-                "required": true,
-                "type": "string"
-              },
-              {
-                "format": "jsonb[]",
-                "in": "query",
-                "name": "jsonb_arr",
-                "required": true,
-                "type": "string"
-              },
-              {
-                "format": "integer",
-                "in": "query",
-                "name": "integer",
-                "required": false,
-                "type": "integer"
-              },
-              {
-                "format": "json",
-                "in": "query",
-                "name": "json",
-                "required": false,
-                "type": "string"
-              },
-              {
-                "format": "jsonb",
-                "in": "query",
-                "name": "jsonb",
-                "required": false,
-                "type": "string"
-              }
-            ]
-          |]
-
-    it "includes function summary/description and body schema for arguments in the post path item" $ do
       r <- simpleBody <$> get "/"
 
       let method s = key "paths" . key "/rpc/varied_arguments_openapi" . key s
@@ -1019,26 +859,6 @@ spec actualPgVersion = describe "OpenAPI" $ do
 
       liftIO $ params `shouldBe` Just [aesonQQ|["num", "str"]|]
 
-    it "uses a multi collection format when the function has a VARIADIC parameter" $ do
-      r <- simpleBody <$> get "/"
-      let param = r ^? key "paths" . key "/rpc/variadic_param"
-                     . key "get" . key "parameters" .  nth 0
-
-      liftIO $ param `shouldBe` Just
-        [aesonQQ|
-          {
-            "collectionFormat": "multi",
-            "in": "query",
-            "items": {
-              "format": "text",
-              "type": "string"
-            },
-            "name": "v",
-            "required": false,
-            "type": "array"
-          }
-        |]
-
   describe "Security" $
     it "does not include security or security definitions by default" $ do
       r <- simpleBody <$> get "/"

test/spec/Feature/OpenApi/RootSpec.hs

@@ -9,6 +9,8 @@ import Test.Hspec.Wai.JSON
 
 import Protolude hiding (get)
 
+import SpecHelper
+
 spec :: SpecWith ((), Application)
 spec =
   describe "root spec function" $ do
@@ -20,3 +22,9 @@ spec =
            "info": {"title": "PostgREST API", "description": "This is a dynamic API generated by PostgREST"}
           }|]
         { matchHeaders = ["Content-Type" <:> "application/openapi+json; charset=utf-8"] }
+
+    it "accepts application/json" $
+      request methodGet "/"
+        [("Accept", "application/json")] "" `shouldRespondWith`
+        200
+        { matchHeaders = [matchContentTypeJson] }

test/spec/Feature/Query/AndOrParamsSpec.hs

@@ -92,9 +92,6 @@ spec actualPgVersion =
               {"text_search_vector": "'amus':5 'fair':7 'impossibl':9 'peu':4" },
               {"text_search_vector": "'art':4 'spass':5 'unmog':7"}
             ]|] { matchHeaders = [matchContentTypeJson] }
-        it "can handle isdistinct" $
-          get "/entities?and=(id.gte.2,arr.isdistinct.{1,2})&select=id" `shouldRespondWith`
-            [json|[{ "id": 3 }, { "id": 4 }]|] { matchHeaders = [matchContentTypeJson] }
 
         when (actualPgVersion >= pgVersion112) $
           it "can handle wfts (websearch_to_tsquery)" $
@@ -141,8 +138,6 @@ spec actualPgVersion =
             [json|[{ "id": 3 }, { "id": 4 }]|] { matchHeaders = [matchContentTypeJson] }
           get "/ranges?range=adj.(3,10]&select=id" `shouldRespondWith`
             [json|[{ "id": 1 }]|] { matchHeaders = [matchContentTypeJson] }
-          get "/ranges?range=isdistinct.[1,3]&select=id" `shouldRespondWith`
-            [json|[{ "id": 2 }, { "id": 3 }, { "id": 4 }, {"id": 5}]|] { matchHeaders = [matchContentTypeJson] }
 
         it "can handle array operators" $ do
           get "/entities?arr=eq.{1,2,3}&select=id" `shouldRespondWith`
@@ -171,8 +166,6 @@ spec actualPgVersion =
             [json|[{ "id": 3 }]|] { matchHeaders = [matchContentTypeJson] }
           get "/entities?arr=ov.{2,3}&select=id" `shouldRespondWith`
             [json|[{ "id": 2 }, { "id": 3 }]|] { matchHeaders = [matchContentTypeJson] }
-          get "/entities?arr=isdistinct.{1,2}&select=id" `shouldRespondWith`
-            [json|[{ "id": 1 }, { "id": 3 }, { "id": 4 }]|] { matchHeaders = [matchContentTypeJson] }
 
         context "operators with not" $ do
           it "eq, cs, like can be negated" $
@@ -187,9 +180,6 @@ spec actualPgVersion =
           it "gt, lte, ilike can be negated" $
             get "/entities?and=(name.not.ilike.*ITY2,or(id.not.gt.4,id.not.lte.1))&select=id" `shouldRespondWith`
               [json|[{"id": 1}, {"id": 2}, {"id": 3}]|] { matchHeaders = [matchContentTypeJson] }
-          it "isdistinct can be negated" $
-            get "/entities?and=(id.not.eq.2,arr.not.isdistinct.{1,2,3})&select=id" `shouldRespondWith`
-              [json|[{"id": 3}]|] { matchHeaders = [matchContentTypeJson] }
 
       context "and/or params with quotes" $ do
         it "eq can have quotes" $
@@ -262,3 +252,35 @@ spec actualPgVersion =
 
     it "can query columns that begin with and/or reserved words" $
       get "/grandchild_entities?or=(and_starting_col.eq.smth, or_starting_col.eq.smth)" `shouldRespondWith` 200
+
+    it "fails when using IN without () and provides meaningful error message" $
+      get "/entities?or=(id.in.1,2,id.eq.3)" `shouldRespondWith`
+        [json|{
+          "details": "unexpected \"1\" expecting \"(\"",
+          "message": "\"failed to parse logic tree ((id.in.1,2,id.eq.3))\" (line 1, column 10)",
+          "code": "PGRST100",
+          "hint": null
+        }|] { matchStatus = 400, matchHeaders = [matchContentTypeJson] }
+
+    it "fails on malformed query params and provides meaningful error message" $ do
+      get "/entities?or=)(" `shouldRespondWith`
+        [json|{
+          "details": "unexpected \")\" expecting \"(\"",
+          "message": "\"failed to parse logic tree ()()\" (line 1, column 3)",
+          "code": "PGRST100",
+          "hint": null
+        }|] { matchStatus = 400, matchHeaders = [matchContentTypeJson] }
+      get "/entities?and=(ord(id.eq.1,id.eq.1),id.eq.2)" `shouldRespondWith`
+        [json|{
+          "details": "unexpected \"d\" expecting \"(\"",
+          "message": "\"failed to parse logic tree ((ord(id.eq.1,id.eq.1),id.eq.2))\" (line 1, column 7)",
+          "code": "PGRST100",
+          "hint": null
+        }|] { matchStatus = 400, matchHeaders = [matchContentTypeJson] }
+      get "/entities?or=(id.eq.1,not.xor(id.eq.2,id.eq.3))" `shouldRespondWith`
+        [json|{
+          "details": "unexpected \"x\" expecting logic operator (and, or)",
+          "message": "\"failed to parse logic tree ((id.eq.1,not.xor(id.eq.2,id.eq.3)))\" (line 1, column 16)",
+          "code": "PGRST100",
+          "hint": null
+        }|] { matchStatus = 400, matchHeaders = [matchContentTypeJson] }

test/spec/Feature/Query/ComputedRelsSpec.hs

@@ -104,47 +104,6 @@ spec = describe "computed relationships" $ do
         [json|[ {"name":"Final Fantasy I","designer":{"name":"Hironobu Sakaguchi"}} ]|]
         { matchStatus  = 200 }
 
-  it "applies data representations to response" $ do
-    -- A smoke test for data reps in the presence of computed relations.
-
-    -- The data rep here title cases the designer name before presentation. So here the lowercase version will be saved,
-    -- but the title case version returned. Pulling in a computed relation should not confuse this.
-    request methodPatch "/designers?select=name,videogames:computed_videogames(name)&id=eq.1"
-      [("Prefer", "return=representation"), ("Prefer", "tx=commit")]
-      [json| {"name": "sidney k. meier"} |]
-      `shouldRespondWith`
-      [json|[{"name":"Sidney K. Meier","videogames":[{"name":"Civilization I"}, {"name":"Civilization II"}]}]|]
-      { matchStatus = 200 }
-
-    -- Verify it was saved the way we requested (there's no text data rep for this column, so if we select with the wrong casing, it should fail.)
-    get "/designers?select=id&name=eq.Sidney%20K.%20Meier"
-      `shouldRespondWith`
-      [json|[]|]
-      { matchStatus = 200, matchHeaders = [matchContentTypeJson] }
-    -- But with the right casing it works.
-    get "/designers?select=id,name&name=eq.sidney%20k.%20meier"
-      `shouldRespondWith`
-      [json|[{"id": 1, "name":"Sidney K. Meier"}]|]
-      { matchStatus = 200, matchHeaders = [matchContentTypeJson] }
-
-    -- Most importantly, if you read it back even via a computed relation, the data rep should be applied.
-    get "/videogames?select=name,designer:computed_designers(*)&id=eq.1"
-      `shouldRespondWith`
-      [json|[
-        {"name":"Civilization I","designer":{"id": 1, "name":"Sidney K. Meier"}}
-      ]|] { matchHeaders = [matchContentTypeJson] }
-
-    -- reset the test fixture
-    request methodPatch "/designers?id=eq.1"
-      [("Prefer", "tx=commit")]
-      [json| {"name": "Sid Meier"} |]
-      `shouldRespondWith` 204
-    -- need to poke the second one too to prevent inherent ordering from changing
-    request methodPatch "/designers?id=eq.2"
-      [("Prefer", "tx=commit")]
-      [json| {"name": "Hironobu Sakaguchi"} |]
-      `shouldRespondWith` 204
-
   it "works with self joins" $
     get "/web_content?select=name,child_web_content(name),parent_web_content(name)&id=in.(0,1)"
     `shouldRespondWith`

test/spec/Feature/Query/DeleteSpec.hs

@@ -37,8 +37,7 @@ spec =
         request methodDelete "/items?id=eq.2" [("Prefer", "return=representation"), ("Prefer", "count=exact")] ""
           `shouldRespondWith` [json|[{"id":2}]|]
           { matchStatus  = 200
-          , matchHeaders = ["Content-Range" <:> "*/1"
+          , matchHeaders = ["Content-Range" <:> "*/1"]
-                           , "Preference-Applied" <:> "return=representation"]
           }
 
       it "ignores ?select= when return not set or return=minimal" $ do
@@ -58,8 +57,7 @@ spec =
             ""
             { matchStatus  = 204
             , matchHeaders = [ matchHeaderAbsent hContentType
-                             , "Content-Range" <:> "*/*"
+                             , "Content-Range" <:> "*/*" ]
-                             , "Preference-Applied" <:> "return=minimal"]
             }
 
       it "returns the deleted item and shapes the response" $
@@ -139,8 +137,7 @@ spec =
           `shouldRespondWith`
             ""
             { matchStatus = 204
-            , matchHeaders = [matchHeaderAbsent hContentType
+            , matchHeaders = [matchHeaderAbsent hContentType]
-                             , "Preference-Applied" <:> "return=minimal" ]
             }
 
       it "suceeds deleting the row with no explicit select by default" $
@@ -157,7 +154,7 @@ spec =
       it "works with the limit and offset query params" $
         baseTable "limited_delete_items" "id" tblDataBefore
         `mutatesWith`
-        requestMutation methodDelete "/limited_delete_items?order=id&limit=1&offset=1" mempty mempty
+        requestMutation methodDelete "/limited_delete_items?order=id&limit=1&offset=1" mempty
         `shouldMutateInto`
         [json|[
           { "id": 1, "name": "item-1" }
@@ -167,7 +164,7 @@ spec =
       it "works with the limit query param plus a filter" $
         baseTable "limited_delete_items" "id" tblDataBefore
         `mutatesWith`
-        requestMutation methodDelete "/limited_delete_items?order=id&limit=1&id=gt.1" mempty mempty
+        requestMutation methodDelete "/limited_delete_items?order=id&limit=1&id=gt.1" mempty
         `shouldMutateInto`
         [json|[
           { "id": 1, "name": "item-1" }
@@ -203,7 +200,7 @@ spec =
       it "works with views with an explicit order by unique col" $
         baseTable "limited_delete_items_view" "id" tblDataBefore
         `mutatesWith`
-        requestMutation methodDelete "/limited_delete_items_view?order=id&limit=1&offset=1" mempty mempty
+        requestMutation methodDelete "/limited_delete_items_view?order=id&limit=1&offset=1" mempty
         `shouldMutateInto`
         [json|[
           { "id": 1, "name": "item-1" }
@@ -213,7 +210,7 @@ spec =
       it "works with views with an explicit order by composite pk" $
         baseTable "limited_delete_items_cpk_view" "id" tblDataBefore
         `mutatesWith`
-        requestMutation methodDelete "/limited_delete_items_cpk_view?order=id,name&limit=1&offset=1" mempty mempty
+        requestMutation methodDelete "/limited_delete_items_cpk_view?order=id,name&limit=1&offset=1" mempty
         `shouldMutateInto`
         [json|[
           { "id": 1, "name": "item-1" }
@@ -223,53 +220,9 @@ spec =
       it "works on a table without a pk by ordering by 'ctid'" $
         baseTable "limited_delete_items_no_pk" "id" tblDataBefore
         `mutatesWith`
-        requestMutation methodDelete "/limited_delete_items_no_pk?order=ctid&limit=1&offset=1" mempty mempty
+        requestMutation methodDelete "/limited_delete_items_no_pk?order=ctid&limit=1&offset=1" mempty
         `shouldMutateInto`
         [json|[
           { "id": 1, "name": "item-1" }
         , { "id": 3, "name": "item-3" }
         ]|]
-
-      it "ignores the Range header" $ do
-        baseTable "limited_delete_items" "id" tblDataBefore
-         `mutatesWith`
-         requestMutation methodDelete "/limited_delete_items"
-          (rangeHdrs (ByteRangeFromTo 0 0)) mempty
-         `shouldMutateInto`
-         [json|[]|]
-
-        baseTable "limited_delete_items" "id" tblDataBefore
-         `mutatesWith`
-         requestMutation methodDelete "/limited_delete_items?id=gte.2"
-          (rangeHdrs (ByteRangeFromTo 0 0)) mempty
-         `shouldMutateInto`
-         [json|[ { "id": 1, "name": "item-1" } ]|]
-
-      it "ignores the Range header and does not do a limited delete" $
-        baseTable "limited_delete_items" "id" tblDataBefore
-         `mutatesWith`
-         requestMutation methodDelete "/limited_delete_items?order=id"
-          (rangeHdrs (ByteRangeFromTo 0 0)) mempty
-         `shouldMutateInto`
-         [json|[]|]
-
-      it "ignores the Range header and does not throw an invalid range error" $
-        baseTable "limited_delete_items" "id" tblDataBefore
-         `mutatesWith`
-         requestMutation methodDelete "/limited_delete_items?order=id&limit=1&offset=1"
-          (rangeHdrs (ByteRangeFromTo 0 0)) mempty
-         `shouldMutateInto`
-         [json|[
-           { "id": 1, "name": "item-1" }
-         , { "id": 3, "name": "item-3" }
-         ]|]
-
-      it "ignores the Range header but not the limit and offset params" $
-        baseTable "limited_delete_items" "id" tblDataBefore
-         `mutatesWith`
-         requestMutation methodDelete "/limited_delete_items?order=id&limit=2&offset=1"
-          (rangeHdrs (ByteRangeFromTo 1 1)) mempty
-         `shouldMutateInto`
-         [json|[
-           { "id": 1, "name": "item-1" }
-         ]|]

test/spec/Feature/Query/EmbedDisambiguationSpec.hs

@@ -68,8 +68,10 @@ spec =
           , matchHeaders = [matchContentTypeJson]
           }
 
-      it "errs when there are more than two fks on a junction table but it can be disambiguated with spread embeds" $ do
+      it "errs when there are more than two fks on a junction table(currently impossible to disambiguate, only choice is to split the table)" $
         -- We have 4 possibilities for doing the junction JOIN here.
+        -- This could be solved by specifying two additional fks, like whatev_projects!fk1!fk2(*)
+        -- If the need arises this capability can be added later without causing a breaking change
         get "/whatev_sites?select=*,whatev_projects(*)" `shouldRespondWith`
           [json|
             {
@@ -103,23 +105,6 @@ spec =
           { matchStatus  = 300
           , matchHeaders = [matchContentTypeJson]
           }
-        -- Each of those 4 possibilities can be done with spread embeds, by following the details in the error above
-        get "/whatev_sites?select=*,whatev_jobs!site_id_1(...whatev_projects!project_id_1(*))" `shouldRespondWith` [json|[]|]
-        get "/whatev_sites?select=*,whatev_jobs!site_id_1(...whatev_projects!project_id_2(*))" `shouldRespondWith` [json|[]|]
-        get "/whatev_sites?select=*,whatev_jobs!site_id_2(...whatev_projects!project_id_1(*))" `shouldRespondWith` [json|[]|]
-        get "/whatev_sites?select=*,whatev_jobs!site_id_2(...whatev_projects!project_id_2(*))" `shouldRespondWith` [json|[]|]
-
-      it "can disambiguate a recursive m2m with spread embeds" $ do
-        get "/posters?select=*,subscribers:subscriptions!subscribed(...posters!subscriber(*))&limit=1" `shouldRespondWith`
-          [json| [ {"id":1,"name":"Mark","subscribers":[{"id":3,"name":"Bill"}, {"id":4,"name":"Jeff"}]}]|]
-          { matchStatus  = 200
-          , matchHeaders = [matchContentTypeJson]
-          }
-        get "/posters?select=*,subscriptions!subscriber(...posters!subscribed(*))&limit=1" `shouldRespondWith`
-          [json| [{"id":1,"name":"Mark","subscriptions":[{"id":2,"name":"Elon"}]}]|]
-          { matchStatus  = 200
-          , matchHeaders = [matchContentTypeJson]
-          }
 
       it "errs on an ambiguous embed that has two one-to-one relationships" $
         get "/first?select=second(*)" `shouldRespondWith`

test/spec/Feature/Query/InsertSpec.hs

@@ -11,10 +11,8 @@ import Test.Hspec.Wai
 import Test.Hspec.Wai.JSON
 import Text.Heredoc
 
-import PostgREST.Config.PgVersion (PgVersion, pgVersion100,
+import PostgREST.Config.PgVersion (PgVersion, pgVersion110,
-                                   pgVersion110, pgVersion112,
+                                   pgVersion112, pgVersion130)
-                                   pgVersion120, pgVersion130,
-                                   pgVersion140)
 
 import Protolude  hiding (get)
 import SpecHelper
@@ -43,8 +41,7 @@ spec actualPgVersion = do
           , "enum": "foo"
           }] |] `shouldRespondWith` [json|[{"integer":14,"varchar":"testing!"}]|]
           { matchStatus  = 201
-          , matchHeaders = [matchContentTypeJson
+          , matchHeaders = [matchContentTypeJson]
-                           , "Preference-Applied" <:> "return=representation"]
           }
 
       it "ignores &select when return not set or using return=minimal" $ do
@@ -70,8 +67,7 @@ spec actualPgVersion = do
           `shouldRespondWith`
             ""
             { matchStatus  = 201
-            , matchHeaders = [matchHeaderAbsent hContentType
+            , matchHeaders = [matchHeaderAbsent hContentType]
-                             , "Preference-Applied" <:> "return=minimal"]
             }
 
     context "non uniform json array" $ do
@@ -101,8 +97,7 @@ spec actualPgVersion = do
           { matchStatus  = 201
           , matchHeaders = [ matchContentTypeJson
                            , matchHeaderAbsent hLocation
-                           , "Content-Range" <:> "*/1"
+                           , "Content-Range" <:> "*/1" ]
-                           , "Preference-Applied" <:> "return=representation"]
           }
 
       it "can rename and cast the selected columns" $
@@ -113,8 +108,7 @@ spec actualPgVersion = do
           { matchStatus  = 201
           , matchHeaders = [ matchContentTypeJson
                            , matchHeaderAbsent hLocation
-                           , "Content-Range" <:> "*/*"
+                           , "Content-Range" <:> "*/*" ]
-                           , "Preference-Applied" <:> "return=representation"]
           }
 
       it "should not throw and return location header when selecting without PK" $
@@ -124,8 +118,7 @@ spec actualPgVersion = do
           { matchStatus  = 201
           , matchHeaders = [ matchContentTypeJson
                            , matchHeaderAbsent hLocation
-                           , "Content-Range" <:> "*/*"
+                           , "Content-Range" <:> "*/*" ]
-                           , "Preference-Applied" <:> "return=representation"]
           }
 
     context "requesting headers only representation" $ do
@@ -138,8 +131,7 @@ spec actualPgVersion = do
             { matchStatus  = 201
             , matchHeaders = [ matchHeaderAbsent hContentType
                              , "Location" <:> "/projects?id=eq.11"
-                             , "Content-Range" <:> "*/*"
+                             , "Content-Range" <:> "*/*" ]
-                             , "Preference-Applied" <:> "return=headers-only"]
             }
 
       when (actualPgVersion >= pgVersion110) $
@@ -152,8 +144,7 @@ spec actualPgVersion = do
               { matchStatus  = 201
               , matchHeaders = [ matchHeaderAbsent hContentType
                                , "Location" <:> "/car_models?name=eq.Enzo&year=eq.2021"
-                               , "Content-Range" <:> "*/*"
+                               , "Content-Range" <:> "*/*" ]
-                               , "Preference-Applied" <:> "return=headers-only"]
               }
 
     context "requesting no representation" $
@@ -200,8 +191,7 @@ spec actualPgVersion = do
               ""
               { matchStatus  = 201
               , matchHeaders = [ matchHeaderAbsent hContentType
-                               , "Location" <:> "/auto_incrementing_pk?id=eq.2"
+                               , "Location" <:> "/auto_incrementing_pk?id=eq.2" ]
-                               , "Preference-Applied" <:> "return=headers-only"]
               }
 
       context "into a table with simple pk" $
@@ -235,8 +225,7 @@ spec actualPgVersion = do
             `shouldRespondWith`
               [json| [{ "a":"bar", "b":"baz" }] |]
               { matchStatus  = 201
-              , matchHeaders = [matchHeaderAbsent hLocation
+              , matchHeaders = [matchHeaderAbsent hLocation]
-                               , "Preference-Applied" <:> "return=representation"]
               }
 
         it "returns empty array when no items inserted, and return=rep" $ do
@@ -400,22 +389,6 @@ spec actualPgVersion = do
           `shouldRespondWith` [json|[{ id: 20 }]|]
             { matchStatus  = 201 }
 
-    -- https://github.com/PostgREST/postgrest/issues/2861
-    context "bit and char columns with length" $ do
-      it "should insert to a bit column with length" $
-        request methodPost "/bitchar_with_length?select=bit"
-            [("Prefer", "return=representation")]
-            [json|{"bit": "10101"}|]
-          `shouldRespondWith` [json|[{ "bit": "10101" }]|]
-            { matchStatus  = 201 }
-
-      it "should insert to a char column with length" $
-        request methodPost "/bitchar_with_length?select=char"
-            [("Prefer", "return=representation")]
-            [json|{"char": "abcde"}|]
-          `shouldRespondWith` [json|[{ "char": "abcde" }]|]
-            { matchStatus  = 201 }
-
     context "POST with ?columns parameter" $ do
       it "ignores json keys not included in ?columns" $ do
         request methodPost "/articles?columns=id,body" [("Prefer", "return=representation")]
@@ -447,134 +420,20 @@ spec actualPgVersion = do
           , matchHeaders = []
           }
 
-      it "disallows ?columns which don't exist" $
-        post "/articles?columns=helicopter"
-          [json|[
-            {"id": 204, "body": "yyy"},
-            {"id": 205, "body": "zzz"}]|]
-          `shouldRespondWith`
-          [json|{"code":"PGRST204","details":null,"hint":null,"message":"Column 'helicopter' of relation 'articles' does not exist"} |]
-          { matchStatus  = 400
-          , matchHeaders = []
-          }
-
-      it "returns missing table error even if also has invalid ?columns" $
-        post "/garlic?columns=helicopter"
-          [json|[
-            {"id": 204, "body": "yyy"},
-            {"id": 205, "body": "zzz"}]|]
-          `shouldRespondWith`
-          [json|{} |]
-          { matchStatus  = 404
-          , matchHeaders = []
-          }
-
       it "disallows array elements that are not json objects" $
         post "/articles?columns=id,body"
           [json|[
             {"id": 204, "body": "yyy"},
             333,
             "asdf",
-            {"id": 205, "body": "zzz"}]|] `shouldRespondWith` 400
+            {"id": 205, "body": "zzz"}]|] `shouldRespondWith`
-
+          [json|{
-      context "apply defaults on missing values" $ do
+              "code": "22023",
-        -- inserting the array fails on pg 9.6, but the feature should work normally
+              "details": null,
-        when (actualPgVersion >= pgVersion100) $
+              "hint": null,
-          it "inserts table default values(field-with_sep) when json keys are undefined" $
+              "message": "argument of json_populate_recordset must be an array of objects"}|]
-            request methodPost "/complex_items?columns=id,name,field-with_sep,arr_data" [("Prefer", "return=representation"), ("Prefer", "missing=default")]
+          { matchStatus  = 400
-                [json|[
+          , matchHeaders = []
-                  {"id": 4, "name": "Vier"},
-                  {"id": 5, "name": "Funf", "arr_data": null},
-                  {"id": 6, "name": "Sechs", "field-with_sep": 6, "arr_data": "{1,2,3}"}
-                ]|]
-              `shouldRespondWith`
-                [json|[
-                  {"id": 4, "name": "Vier", "field-with_sep": 1, "settings":null,"arr_data":null},
-                  {"id": 5, "name": "Funf", "field-with_sep": 1, "settings":null,"arr_data":null},
-                  {"id": 6, "name": "Sechs", "field-with_sep": 6, "settings":null,"arr_data":[1,2,3]}
-                ]|]
-                { matchStatus  = 201
-                , matchHeaders = ["Preference-Applied" <:> "missing=default, return=representation"]
-                }
-
-        it "inserts view default values(field-with_sep) when json keys are undefined" $
-          request methodPost "/complex_items_view?columns=id,name" [("Prefer", "return=representation"), ("Prefer", "missing=default")]
-              [json|[
-                {"id": 7, "name": "Sieben"},
-                {"id": 8}
-              ]|]
-            `shouldRespondWith`
-              [json|[
-                {"id": 7, "name": "Sieben", "field-with_sep": 1, "settings":null,"arr_data":null},
-                {"id": 8, "name": "Default", "field-with_sep": 1, "settings":null,"arr_data":null}
-              ]|]
-              { matchStatus  = 201
-              , matchHeaders = ["Preference-Applied" <:> "missing=default, return=representation"]
-              }
-
-        it "doesn't insert json duplicate keys(since it uses jsonb)" $
-          request methodPost "/tbl_w_json?columns=id,data" [("Prefer", "return=representation"), ("Prefer", "missing=default")]
-              [json| { "data": { "a": 1, "a": 2 }, "id": 3 } |]
-            `shouldRespondWith`
-              [json| [ { "data": { "a": 2 }, "id": 3 } ] |]
-              { matchStatus  = 201
-              , matchHeaders = ["Preference-Applied" <:> "missing=default, return=representation"]
-              }
-
-        when (actualPgVersion >= pgVersion100) $
-          it "inserts a default on a generated by default as identity column" $
-            request methodPost "/channels?columns=id,data,slug&select=data,slug" [("Prefer", "return=representation"), ("Prefer", "missing=default")]
-                [json| { "slug": "foo" } |]
-              `shouldRespondWith`
-                [json| [{"data":{"foo": "bar"},"slug":"foo"}] |] -- id 1 was inserted here, we don't get it for idempotence in the tests
-                { matchStatus  = 201
-                , matchHeaders = ["Preference-Applied" <:> "missing=default, return=representation"]
-                }
-
-        when (actualPgVersion >= pgVersion120) $
-          it "fails with a good error message on generated always columns" $
-            request methodPost "/foo?columns=a,b" [("Prefer", "return=representation"), ("Prefer", "missing=default")]
-                [json| [
-                  {"a": "val"},
-                  {"a": "val", "b": "val"}
-                ]|]
-              `shouldRespondWith`
-                (if actualPgVersion < pgVersion140
-                  then [json| {
-                    "code": "42601",
-                    "details": "Column \"b\" is a generated column.",
-                    "hint": null,
-                    "message": "cannot insert into column \"b\""
-                  }|]
-                  else [json| {
-                    "code": "428C9",
-                    "details": "Column \"b\" is a generated column.",
-                    "hint": null,
-                    "message": "cannot insert a non-DEFAULT value into column \"b\""
-                  }|])
-                { matchStatus  = 400 }
-
-        it "inserts a default on a DOMAIN with default" $
-          request methodPost "/evil_friends?columns=id,name" [("Prefer", "return=representation"), ("Prefer", "missing=default")]
-              [json| { "name": "Lu" } |]
-            `shouldRespondWith`
-              [json| [{"id": 666, "name": "Lu"}] |]
-              { matchStatus  = 201
-              , matchHeaders = ["Preference-Applied" <:> "missing=default, return=representation"]
-              }
-
-    it "inserts json that has duplicate keys" $ do
-      request methodPost "/tbl_w_json" [("Prefer", "return=representation")]
-          [json| { "data": { "a": 1, "a": 2 }, "id": 3 } |]
-        `shouldRespondWith`
-          [json| [ { "data": { "a": 1, "a": 2 }, "id": 3 } ] |]
-          { matchStatus  = 201
-          }
-      request methodPost "/tbl_w_json?columns=id,data" [("Prefer", "return=representation")]
-          [json| { "data": { "a": 1, "a": 2 }, "id": 3 } |]
-        `shouldRespondWith`
-          [json| [ { "data": { "a": 1, "a": 2 }, "id": 3 } ] |]
-          { matchStatus  = 201
           }
 
     context "with unicode values" $ do
@@ -728,8 +587,7 @@ spec actualPgVersion = do
         `shouldRespondWith`
           ""
           { matchStatus = 201
-          , matchHeaders = [matchHeaderAbsent hContentType
+          , matchHeaders = [matchHeaderAbsent hContentType]
-                           , "Preference-Applied" <:> "return=minimal"]
           }
 
   describe "Inserting into VIEWs" $ do
@@ -752,8 +610,7 @@ spec actualPgVersion = do
             { matchStatus  = 201
             , matchHeaders = [ matchHeaderAbsent hContentType
                              , "Location" <:> "/with_multiple_pks?pk1=eq.1&pk2=eq.2"
-                             , "Content-Range" <:> "*/*"
+                             , "Content-Range" <:> "*/*" ]
-                             , "Preference-Applied" <:> "return=headers-only"]
             }
 
     context "requesting header only representation" $ do
@@ -765,8 +622,7 @@ spec actualPgVersion = do
             { matchStatus  = 201
             , matchHeaders = [ matchHeaderAbsent hContentType
                              , "Location" <:> "/compound_pk_view?k1=eq.1&k2=eq.test"
-                             , "Content-Range" <:> "*/*"
+                             , "Content-Range" <:> "*/*" ]
-                             , "Preference-Applied" <:> "return=headers-only"]
             }
 
       it "should not throw and return location header when a PK is null" $
@@ -777,120 +633,5 @@ spec actualPgVersion = do
             { matchStatus  = 201
             , matchHeaders = [ matchHeaderAbsent hContentType
                              , "Location" <:> "/test_null_pk_competitors_sponsors?id=eq.1&sponsor_id=is.null"
-                             , "Content-Range" <:> "*/*"
+                             , "Content-Range" <:> "*/*" ]
-                             , "Preference-Applied" <:> "return=headers-only"]
             }
-
-
-  -- Data representations for payload parsing requires Postgres 10 or above.
-  when (actualPgVersion >= pgVersion100) $ do
-    describe "Data representations" $ do
-      context "on regular table" $ do
-        it "parses values in POST body" $
-          -- we don't check that the parsing is correct here, just that it's happening. If it doesn't happen we'll get a
-          -- an "invalid input syntax for type integer:" error.
-          request methodPost "/datarep_todos" [("Prefer", "return=headers-only")]
-            [json| {"id":5, "name": "party", "label_color": "#001100", "due_at": "2018-01-03T11:00:00+00"} |]
-            `shouldRespondWith`
-            ""
-              { matchStatus  = 201
-              , matchHeaders = [ matchHeaderAbsent hContentType
-                               , "Location" <:> "/datarep_todos?id=eq.5"
-                               , "Content-Range" <:> "*/*"
-                               , "Preference-Applied" <:> "return=headers-only"]
-              }
-
-        it "parses values in POST body and formats individually selected values in return=representation" $
-          request methodPost "/datarep_todos?select=id,label_color" [("Prefer", "return=representation")]
-            [json| {"id":5, "name": "party", "label_color": "#001100", "due_at": "2018-01-03T11:00:00+00"} |]
-            `shouldRespondWith`
-            [json| [{"id":5, "label_color": "#001100"}] |]
-              { matchStatus  = 201
-              , matchHeaders = ["Content-Type" <:> "application/json; charset=utf-8",
-                                "Content-Range" <:> "*/*"]
-              }
-
-        it "parses values in POST body and formats values in return=representation" $
-          request methodPost "/datarep_todos" [("Prefer", "return=representation")]
-            [json| {"id":5, "name": "party", "label_color": "#001100", "due_at": "2018-01-03T11:00:00+00", "icon_image": "3q2+7w", "created_at":-15, "budget": "-100000000000000.13"} |]
-            `shouldRespondWith`
-            [json| [{"id":5,"name": "party", "label_color": "#001100", "due_at":"2018-01-03T11:00:00Z", "icon_image": "3q2+7w==", "created_at":-15, "budget": "-100000000000000.13"}] |]
-              { matchStatus  = 201
-              , matchHeaders = ["Content-Type" <:> "application/json; charset=utf-8",
-                                "Content-Range" <:> "*/*"]
-              }
-
-      context "with ?columns parameter" $ do
-        it "ignores json keys not included in ?columns; parses only the ones specified" $
-          request methodPost "/datarep_todos?columns=id,label_color&select=id,name,label_color,due_at" [("Prefer", "return=representation")]
-            [json| {"id":5, "name": "party", "label_color": "#001100", "due_at": "invalid but should be ignored"} |]
-            `shouldRespondWith`
-            [json| [{"id":5, "name":null, "label_color": "#001100", "due_at": "2018-01-01T00:00:00Z"}] |]
-              { matchStatus  = 201
-              , matchHeaders = ["Content-Type" <:> "application/json; charset=utf-8",
-                                "Content-Range" <:> "*/*"]
-              }
-
-        it "fails without parsing anything if at least one specified column doesn't exist" $
-          request methodPost "/datarep_todos?columns=id,label_color,helicopters&select=id,name,label_color,due_at" [("Prefer", "return=representation")]
-            [json| {"due_at": "2019-01-03T11:00:00+00", "smth": "here", "label_color": "invalid", "fake_id": 13} |]
-            `shouldRespondWith`
-            [json| {"code":"PGRST204","message":"Column 'helicopters' of relation 'datarep_todos' does not exist","details":null,"hint":null} |]
-              { matchStatus  = 400
-              , matchHeaders = ["Content-Type" <:> "application/json; charset=utf-8"]
-              }
-
-      context "on updatable view" $ do
-        it "parses values in POST body" $
-          -- we don't check that the parsing is correct here, just that it's happening. If it doesn't happen we'll get a
-          -- an "invalid input syntax for type integer:" error.
-          request methodPost "/datarep_todos_computed" [("Prefer", "return=headers-only")]
-            [json| {"id":5, "name": "party", "label_color": "#001100", "due_at": "2018-01-03T11:00:00+00"} |]
-            `shouldRespondWith`
-            ""
-              { matchStatus  = 201
-              , matchHeaders = [ matchHeaderAbsent hContentType
-                               , "Location" <:> "/datarep_todos_computed?id=eq.5"
-                               , "Content-Range" <:> "*/*"
-                               , "Preference-Applied" <:> "return=headers-only"]
-              }
-
-        it "parses values in POST body and formats individually selected values in return=representation" $
-          request methodPost "/datarep_todos_computed?select=id,label_color" [("Prefer", "return=representation")]
-            [json| {"id":5, "name": "party", "label_color": "#001100", "due_at": "2018-01-03T11:00:00+00"} |]
-            `shouldRespondWith`
-            [json| [{"id":5, "label_color": "#001100"}] |]
-              { matchStatus  = 201
-              , matchHeaders = ["Content-Type" <:> "application/json; charset=utf-8",
-                                "Content-Range" <:> "*/*"]
-              }
-
-        it "parses values in POST body and formats values in return=representation" $
-          request methodPost "/datarep_todos_computed" [("Prefer", "return=representation")]
-            [json| {"id":5, "name": "party", "label_color": "#001100", "due_at": "2018-01-03T11:00:00+00"} |]
-            `shouldRespondWith`
-            [json| [{"id":5,"name": "party", "label_color": "#001100", "due_at":"2018-01-03T11:00:00Z", "dark_color":"#000880"}] |]
-              { matchStatus  = 201
-              , matchHeaders = ["Content-Type" <:> "application/json; charset=utf-8",
-                                "Content-Range" <:> "*/*"]
-              }
-
-      context "on updatable views with ?columns parameter" $ do
-        it "ignores json keys not included in ?columns; parses only the ones specified" $
-          request methodPost "/datarep_todos_computed?columns=id,label_color&select=id,name,label_color,due_at" [("Prefer", "return=representation")]
-            [json| {"id":5, "name": "party", "label_color": "#001100", "due_at": "invalid but should be ignored"} |]
-            `shouldRespondWith`
-            [json| [{"id":5, "name":null, "label_color": "#001100", "due_at": "2018-01-01T00:00:00Z"}] |]
-              { matchStatus  = 201
-              , matchHeaders = ["Content-Type" <:> "application/json; charset=utf-8",
-                                "Content-Range" <:> "*/*"]
-              }
-
-        it "fails without parsing anything if at least one specified column doesn't exist" $
-          request methodPost "/datarep_todos_computed?columns=id,label_color,helicopters&select=id,name,label_color,due_at" [("Prefer", "return=representation")]
-            [json| {"due_at": "2019-01-03T11:00:00+00", "smth": "here", "label_color": "invalid", "fake_id": 13} |]
-            `shouldRespondWith`
-            [json| {"code":"PGRST204","message":"Column 'helicopters' of relation 'datarep_todos_computed' does not exist","details":null,"hint":null} |]
-              { matchStatus  = 400
-              , matchHeaders = ["Content-Type" <:> "application/json; charset=utf-8"]
-              }

test/spec/Feature/Query/JsonOperatorSpec.hs

@@ -103,7 +103,7 @@ spec actualPgVersion = describe "json and jsonb operators" $ do
 
       it "can get array of objects" $ do
         get "/json_arr?select=data->0->>a&id=in.(5,6)" `shouldRespondWith`
-          [json|[{"a":"A"}, {"a":"[1,2,3]"}]|]
+          [json| [{"a":"A"}, {"a":"[1, 2, 3]"}] |]
           { matchHeaders = [matchContentTypeJson] }
         get "/json_arr?select=data->0->a->>2&id=in.(5,6)" `shouldRespondWith`
           [json| [{"a":null}, {"a":"3"}] |]
@@ -275,7 +275,7 @@ spec actualPgVersion = describe "json and jsonb operators" $ do
         [json| [{"data":8}, {"data":7}] |]
         { matchHeaders = [matchContentTypeJson] }
       get "/json_arr?select=data->-2->>a&id=in.(5,6)" `shouldRespondWith`
-        [json| [{"a":"A"}, {"a":"[1,2,3]"}] |]
+        [json| [{"a":"A"}, {"a":"[1, 2, 3]"}] |]
         { matchHeaders = [matchContentTypeJson] }
 
     it "can filter with negative indexes" $ do
@@ -292,11 +292,25 @@ spec actualPgVersion = describe "json and jsonb operators" $ do
         [json| [{"data":[{"a": [1,2,3]}, {"b": [4,5]}]}] |]
         { matchHeaders = [matchContentTypeJson] }
 
-  it "gives a meaningful error on bad syntax" $
+    it "should fail on badly formed negatives" $ do
-    get "/json_arr?select=data->>--34" `shouldRespondWith`
+      get "/json_arr?select=data->>-78xy" `shouldRespondWith`
-      [json|
+        [json|
-        {"details": "unexpected \"-\" expecting digit",
+          {"details": "unexpected 'x' expecting digit, \"->\", \"::\", \".\", \",\" or end of input",
-         "message": "\"failed to parse select parameter (data->>--34)\" (line 1, column 9)",
+           "message": "\"failed to parse select parameter (data->>-78xy)\" (line 1, column 11)",
-         "code": "PGRST100",
+           "code": "PGRST100",
-         "hint": null} |]
+           "hint": null} |]
-      { matchStatus = 400, matchHeaders = [matchContentTypeJson] }
+        { matchStatus = 400, matchHeaders = [matchContentTypeJson] }
+      get "/json_arr?select=data->>--34" `shouldRespondWith`
+        [json|
+          {"details": "unexpected \"-\" expecting digit",
+           "message": "\"failed to parse select parameter (data->>--34)\" (line 1, column 9)",
+           "code": "PGRST100",
+           "hint": null} |]
+        { matchStatus = 400, matchHeaders = [matchContentTypeJson] }
+      get "/json_arr?select=data->>-xy-4" `shouldRespondWith`
+        [json|
+          {"details":"unexpected \"x\" expecting digit",
+           "message":"\"failed to parse select parameter (data->>-xy-4)\" (line 1, column 9)",
+           "code": "PGRST100",
+           "hint": null} |]
+        { matchStatus = 400, matchHeaders = [matchContentTypeJson] }

test/spec/Feature/Query/NullsStrip.hs

@@ -1,116 +0,0 @@
-module Feature.Query.NullsStrip where
-
-import Network.Wai (Application)
-
-import Network.HTTP.Types
-import Test.Hspec
-import Test.Hspec.Wai
-import Test.Hspec.Wai.JSON
-
-import Protolude  hiding (get)
-import SpecHelper
-
-spec :: SpecWith ((), Application)
-spec =
-  describe "Stripping null values from JSON response" $ do
-    let arrayStrip = ("Accept", "application/vnd.pgrst.array+json;nulls=stripped")
-    let singularStrip = ("Accept", "application/vnd.pgrst.object+json;nulls=stripped")
-
-    context "strip nulls from response" $ do
-      it "strips nulls when Accept: application/vnd.pgrst.array+json;nulls=stripped" $ do
-        request methodGet  "/organizations?select=*"
-          [arrayStrip]
-          ""
-          `shouldRespondWith`
-          [json|[{"id":1,"name":"Referee Org","manager_id":1},{"id":2,"name":"Auditor Org","manager_id":2},{"id":3,"name":"Acme","referee":1,"auditor":2,"manager_id":3},{"id":4,"name":"Umbrella","referee":1,"auditor":2,"manager_id":4},{"id":5,"name":"Cyberdyne","referee":3,"auditor":4,"manager_id":5},{"id":6,"name":"Oscorp","referee":3,"auditor":4,"manager_id":6}]|]
-          { matchStatus  = 200
-          , matchHeaders = [matchCTArrayStrip]
-          }
-
-        request methodPost  "/organizations?select=*"
-          [arrayStrip,("Prefer","return=representation")]
-          [json|{"id":7,"name":"John","referee":null,"auditor":null,"manager_id":6}|]
-          `shouldRespondWith`
-          [json|[{"id":7,"name":"John","manager_id":6}]|]
-          { matchStatus  = 201
-          , matchHeaders = [matchCTArrayStrip]
-          }
-
-        request methodPatch  "/organizations?id=eq.3&select=*"
-          [arrayStrip, ("Prefer","return=representation")]
-          [json|{"name":"John","referee":null}|]
-          `shouldRespondWith`
-          [json|[{"id":3,"name":"John","auditor":2,"manager_id":3}]|]
-          { matchStatus  = 200
-          , matchHeaders = [matchCTArrayStrip]
-          }
-
-      it "strips nulls when Accept: application/vnd.pgrst.object+json;nulls=stripped" $
-        request methodGet  "/organizations?limit=1"
-          [singularStrip]
-          ""
-          `shouldRespondWith`
-          [json|{"id":1,"name":"Referee Org","manager_id":1}|]
-          { matchStatus  = 200
-          , matchHeaders = [matchCTSingularStrip]
-          }
-
-      it "throws error when Accept: application/vnd.pgrst.object+json;nulls=stripped and result not singular" $
-        request methodGet  "/organizations?select=*"
-          [singularStrip]
-          ""
-          `shouldRespondWith`
-          [json|{"details":"The result contains 6 rows","message":"JSON object requested, multiple (or no) rows returned","code":"PGRST116","hint":null}|]
-          { matchStatus  = 406
-          , matchHeaders = [matchContentTypeSingular]
-          }
-
-    context "strip nulls from response even if explicitly selected" $ do
-      it "strips nulls when Accept: application/vnd.pgrst.array+json;nulls=stripped" $ do
-        request methodGet  "/organizations?select=id,referee,auditor"
-          [arrayStrip]
-          ""
-          `shouldRespondWith`
-          [json|[{"id":1},{"id":2},{"id":3,"referee":1,"auditor":2},{"id":4,"referee":1,"auditor":2},{"id":5,"referee":3,"auditor":4},{"id":6,"referee":3,"auditor":4}]|]
-          { matchStatus  = 200
-          , matchHeaders = [matchCTArrayStrip]
-          }
-
-        request methodPost  "/organizations?select=id,referee,auditor"
-          [arrayStrip,("Prefer","return=representation")]
-          [json|{"id":7,"name":"John","referee":null,"auditor":null,"manager_id":6}|]
-          `shouldRespondWith`
-          [json|[{"id":7}]|]
-          { matchStatus  = 201
-          , matchHeaders = [matchCTArrayStrip]
-          }
-
-        request methodPatch  "/organizations?id=eq.3&select=id,name,referee,auditor"
-          [arrayStrip, ("Prefer","return=representation")]
-          [json|{"name":"John","referee":null}|]
-          `shouldRespondWith`
-          [json|[{"id":3,"name":"John","auditor":2}]|]
-          { matchStatus  = 200
-          , matchHeaders = [matchCTArrayStrip]
-          }
-
-      it "strips nulls when Accept: application/vnd.pgrst.object+json;nulls=stripped" $
-        request methodGet  "/organizations?select=id,referee,auditor&limit=1"
-          [singularStrip]
-          ""
-          `shouldRespondWith`
-          [json|{"id":1}|]
-          { matchStatus  = 200
-          , matchHeaders = [matchCTSingularStrip]
-          }
-
-    context "doesn't strip nulls" $ do
-      it "doesn't strips nulls when Accept: application/vnd.pgrst.array+json" $
-        request methodGet  "/organizations?select=id,referee,auditor"
-          [("Accept", "application/vnd.pgrst.array+json")]
-          ""
-          `shouldRespondWith`
-          [json|[{"id":1,"referee":null,"auditor":null},{"id":2,"referee":null,"auditor":null},{"id":3,"referee":1,"auditor":2},{"id":4,"referee":1,"auditor":2},{"id":5,"referee":3,"auditor":4},{"id":6,"referee":3,"auditor":4}]|]
-          { matchStatus  = 200
-          , matchHeaders = [matchContentTypeJson]
-          }

test/spec/Feature/Query/PgSafeUpdateSpec.hs

@@ -38,7 +38,7 @@ spec =
       it "allows full table update if a filter is present" $
         baseTable "safe_update_items" "id" tblDataBefore
         `mutatesWith`
-        requestMutation methodPatch "/safe_update_items?id=gt.0" mempty [json| {"name": "updated-item"} |]
+        requestMutation methodPatch "/safe_update_items?id=gt.0" [json| {"name": "updated-item"} |]
         `shouldMutateInto`
         [json|[
           { "id": 1, "name": "updated-item", "observation": null }
@@ -61,7 +61,7 @@ spec =
       it "allows full table delete if a filter is present" $
         baseTable "safe_delete_items" "id" tblDataBefore
         `mutatesWith`
-        requestMutation methodDelete "/safe_delete_items?id=gt.0" mempty mempty
+        requestMutation methodDelete "/safe_delete_items?id=gt.0" mempty
         `shouldMutateInto`
         [json|[]|]
 
@@ -72,7 +72,7 @@ disabledSpec =
       it "works if no condition is present" $
         baseTable "unsafe_update_items" "id" tblDataBefore
         `mutatesWith`
-        requestMutation methodPatch "/unsafe_update_items" mempty [json| {"name": "updated-item"} |]
+        requestMutation methodPatch "/unsafe_update_items" [json| {"name": "updated-item"} |]
         `shouldMutateInto`
         [json|[
           { "id": 1, "name": "updated-item", "observation": null }
@@ -84,6 +84,6 @@ disabledSpec =
       it "works if no condition is present" $
         baseTable "unsafe_delete_items" "id" tblDataBefore
         `mutatesWith`
-        requestMutation methodDelete "/unsafe_delete_items" mempty mempty
+        requestMutation methodDelete "/unsafe_delete_items" mempty
         `shouldMutateInto`
         [json|[]|]

test/spec/Feature/Query/PlanSpec.hs

@@ -9,11 +9,11 @@ import Network.Wai.Test (SResponse (..))
 import           Data.Aeson.Lens
 import           Data.Aeson.QQ
 import qualified Data.ByteString.Lazy as LBS
-import qualified Data.Text            as T
 import           Network.HTTP.Types
 import           Test.Hspec           hiding (pendingWith)
 import           Test.Hspec.Wai
 import           Test.Hspec.Wai.JSON
+import           Text.Heredoc
 
 import PostgREST.Config.PgVersion (PgVersion, pgVersion120,
                                    pgVersion130)
@@ -32,7 +32,7 @@ spec actualPgVersion = do
           resStatus  = simpleStatus r
 
       liftIO $ do
-        resHeaders `shouldSatisfy` elem ("Content-Type", "application/vnd.pgrst.plan+json; for=\"application/json\"; charset=utf-8")
+        resHeaders `shouldSatisfy` elem ("Content-Type", "application/vnd.pgrst.plan+json; charset=utf-8")
         resStatus `shouldBe` Status { statusCode = 200, statusMessage="OK" }
         totalCost `shouldBe`
           if actualPgVersion > pgVersion120
@@ -48,24 +48,38 @@ spec actualPgVersion = do
           resStatus  = simpleStatus r
 
       liftIO $ do
-        resHeaders `shouldSatisfy` elem ("Content-Type", "application/vnd.pgrst.plan+json; for=\"application/json\"; charset=utf-8")
+        resHeaders `shouldSatisfy` elem ("Content-Type", "application/vnd.pgrst.plan+json; charset=utf-8")
         resStatus `shouldBe` Status { statusCode = 200, statusMessage="OK" }
         totalCost `shouldBe`
           if actualPgVersion > pgVersion120
             then 24.28
-            else 32.27
+            else 32.28
 
     it "outputs blocks info when using the buffers option" $
       if actualPgVersion >= pgVersion130
         then do
           r <- request methodGet "/projects" (acceptHdrs "application/vnd.pgrst.plan+json; options=buffers") ""
 
-          let resBody  = simpleBody r
+          let blocks  = simpleBody r ^? nth 0 . key "Planning"
               resHeaders = simpleHeaders r
 
           liftIO $ do
-            resHeaders `shouldSatisfy` elem ("Content-Type", "application/vnd.pgrst.plan+json; for=\"application/json\"; options=buffers; charset=utf-8")
+            resHeaders `shouldSatisfy` elem ("Content-Type", "application/vnd.pgrst.plan+json; options=buffers; charset=utf-8")
-            resBody `shouldSatisfy` (\t -> T.isInfixOf "Shared Hit Blocks" (decodeUtf8 $ LBS.toStrict t))
+            blocks `shouldBe`
+              Just [aesonQQ|
+                {
+                  "Shared Hit Blocks": 0,
+                  "Shared Read Blocks": 0,
+                  "Shared Dirtied Blocks": 0,
+                  "Shared Written Blocks": 0,
+                  "Local Hit Blocks": 0,
+                  "Local Read Blocks": 0,
+                  "Local Dirtied Blocks": 0,
+                  "Local Written Blocks": 0,
+                  "Temp Read Blocks": 0,
+                  "Temp Written Blocks": 0
+                }
+              |]
         else do
           -- analyze is required for buffers on pg < 13
           r <- request methodGet "/projects" (acceptHdrs "application/vnd.pgrst.plan+json; options=analyze|buffers") ""
@@ -74,7 +88,7 @@ spec actualPgVersion = do
               resHeaders = simpleHeaders r
 
           liftIO $ do
-            resHeaders `shouldSatisfy` elem ("Content-Type", "application/vnd.pgrst.plan+json; for=\"application/json\"; options=analyze|buffers; charset=utf-8")
+            resHeaders `shouldSatisfy` elem ("Content-Type", "application/vnd.pgrst.plan+json; options=analyze|buffers; charset=utf-8")
             blocks `shouldBe` Just [aesonQQ| 1.0 |]
 
     when (actualPgVersion >= pgVersion120) $
@@ -85,7 +99,7 @@ spec actualPgVersion = do
             resHeaders = simpleHeaders r
 
         liftIO $ do
-          resHeaders `shouldSatisfy` elem ("Content-Type", "application/vnd.pgrst.plan+json; for=\"application/json\"; options=settings; charset=utf-8")
+          resHeaders `shouldSatisfy` elem ("Content-Type", "application/vnd.pgrst.plan+json; options=settings; charset=utf-8")
           searchPath `shouldBe`
             Just [aesonQQ|
               {
@@ -101,7 +115,7 @@ spec actualPgVersion = do
             resHeaders = simpleHeaders r
 
         liftIO $ do
-          resHeaders `shouldSatisfy` elem ("Content-Type", "application/vnd.pgrst.plan+json; for=\"application/json\"; options=analyze|wal; charset=utf-8")
+          resHeaders `shouldSatisfy` elem ("Content-Type", "application/vnd.pgrst.plan+json; options=analyze|wal; charset=utf-8")
           walRecords `shouldBe` Just [aesonQQ|0|]
 
     it "outputs columns info when using the verbose option" $ do
@@ -111,7 +125,7 @@ spec actualPgVersion = do
           resHeaders = simpleHeaders r
 
       liftIO $ do
-        resHeaders `shouldSatisfy` elem ("Content-Type", "application/vnd.pgrst.plan+json; for=\"application/json\"; options=verbose; charset=utf-8")
+        resHeaders `shouldSatisfy` elem ("Content-Type", "application/vnd.pgrst.plan+json; options=verbose; charset=utf-8")
         cols `shouldBe` Just [aesonQQ| ["projects.id", "projects.name", "projects.client_id"] |]
 
     it "outputs the plan for application/json " $ do
@@ -124,8 +138,8 @@ spec actualPgVersion = do
         resHeaders `shouldSatisfy` elem ("Content-Type", "application/vnd.pgrst.plan+json; for=\"application/json\"; options=verbose; charset=utf-8")
         aggCol `shouldBe`
           if actualPgVersion >= pgVersion120
-            then Just [aesonQQ| "COALESCE(json_agg(ROW(projects.id, projects.name, projects.client_id)), '[]'::json)" |]
+            then Just [aesonQQ| "(COALESCE(json_agg(ROW(projects.id, projects.name, projects.client_id)), '[]'::json))::character varying" |]
-            else Just [aesonQQ| "COALESCE(json_agg(ROW(pgrst_source.id, pgrst_source.name, pgrst_source.client_id)), '[]'::json)" |]
+            else Just [aesonQQ| "(COALESCE(json_agg(ROW(pgrst_source.id, pgrst_source.name, pgrst_source.client_id)), '[]'::json))::character varying" |]
 
     it "outputs the plan for application/vnd.pgrst.object " $ do
       r <- request methodGet "/projects_view" (acceptHdrs "application/vnd.pgrst.plan+json; for=\"application/vnd.pgrst.object\"; options=verbose") ""
@@ -137,8 +151,8 @@ spec actualPgVersion = do
         resHeaders `shouldSatisfy` elem ("Content-Type", "application/vnd.pgrst.plan+json; for=\"application/vnd.pgrst.object+json\"; options=verbose; charset=utf-8")
         aggCol `shouldBe`
           if actualPgVersion >= pgVersion120
-            then Just [aesonQQ| "COALESCE((json_agg(ROW(projects.id, projects.name, projects.client_id)) -> 0), 'null'::json)" |]
+            then Just [aesonQQ| "COALESCE(((json_agg(ROW(projects.id, projects.name, projects.client_id)) -> 0))::text, 'null'::text)" |]
-            else Just [aesonQQ| "COALESCE((json_agg(ROW(pgrst_source.id, pgrst_source.name, pgrst_source.client_id)) -> 0), 'null'::json)" |]
+            else Just [aesonQQ| "COALESCE(((json_agg(ROW(pgrst_source.id, pgrst_source.name, pgrst_source.client_id)) -> 0))::text, 'null'::text)" |]
 
   describe "writes plans" $ do
     it "outputs the total cost for an insert" $ do
@@ -150,9 +164,12 @@ spec actualPgVersion = do
           resStatus  = simpleStatus r
 
       liftIO $ do
-        resHeaders `shouldSatisfy` elem ("Content-Type", "application/vnd.pgrst.plan+json; for=\"application/json\"; charset=utf-8")
+        resHeaders `shouldSatisfy` elem ("Content-Type", "application/vnd.pgrst.plan+json; charset=utf-8")
         resStatus `shouldBe` Status { statusCode = 200, statusMessage="OK" }
-        totalCost `shouldBe` 3.27
+        totalCost `shouldBe`
+          if actualPgVersion > pgVersion120
+            then 3.28
+            else 3.33
 
     it "outputs the total cost for an update" $ do
       r <- request methodPatch "/projects?id=eq.3"
@@ -163,9 +180,12 @@ spec actualPgVersion = do
           resStatus  = simpleStatus r
 
       liftIO $ do
-        resHeaders `shouldSatisfy` elem ("Content-Type", "application/vnd.pgrst.plan+json; for=\"application/json\"; charset=utf-8")
+        resHeaders `shouldSatisfy` elem ("Content-Type", "application/vnd.pgrst.plan+json; charset=utf-8")
         resStatus `shouldBe` Status { statusCode = 200, statusMessage="OK" }
-        totalCost `shouldBe` 12.45
+        totalCost `shouldBe`
+          if actualPgVersion > pgVersion120
+            then 12.45
+            else 12.5
 
     it "outputs the total cost for a delete" $ do
       r <- request methodDelete "/projects?id=in.(1,2,3)"
@@ -176,7 +196,7 @@ spec actualPgVersion = do
           resStatus  = simpleStatus r
 
       liftIO $ do
-        resHeaders `shouldSatisfy` elem ("Content-Type", "application/vnd.pgrst.plan+json; for=\"application/json\"; charset=utf-8")
+        resHeaders `shouldSatisfy` elem ("Content-Type", "application/vnd.pgrst.plan+json; charset=utf-8")
         resStatus `shouldBe` Status { statusCode = 200, statusMessage="OK" }
         totalCost `shouldBe` 15.68
 
@@ -190,9 +210,12 @@ spec actualPgVersion = do
           resStatus  = simpleStatus r
 
       liftIO $ do
-        resHeaders `shouldSatisfy` elem ("Content-Type", "application/vnd.pgrst.plan+json; for=\"application/json\"; charset=utf-8")
+        resHeaders `shouldSatisfy` elem ("Content-Type", "application/vnd.pgrst.plan+json; charset=utf-8")
         resStatus `shouldBe` Status { statusCode = 200, statusMessage="OK" }
-        totalCost `shouldBe` 1.29
+        totalCost `shouldBe`
+          if actualPgVersion >= pgVersion120
+            then 1.3
+            else 1.35
 
     it "outputs the plan for application/vnd.pgrst.object" $ do
       r <- request methodDelete "/projects?id=eq.6"
@@ -203,7 +226,7 @@ spec actualPgVersion = do
 
       liftIO $ do
         resHeaders `shouldSatisfy` elem ("Content-Type", "application/vnd.pgrst.plan+json; for=\"application/vnd.pgrst.object+json\"; options=verbose; charset=utf-8")
-        aggCol `shouldBe` Just [aesonQQ| "COALESCE((json_agg(ROW(projects.id, projects.name, projects.client_id)) -> 0), 'null'::json)" |]
+        aggCol `shouldBe` Just [aesonQQ| "COALESCE(((json_agg(ROW(projects.id, projects.name, projects.client_id)) -> 0))::text, 'null'::text)" |]
 
   describe "function plan" $ do
     it "outputs the total cost for a function call" $ do
@@ -215,9 +238,9 @@ spec actualPgVersion = do
           resStatus  = simpleStatus r
 
       liftIO $ do
-        resHeaders `shouldSatisfy` elem ("Content-Type", "application/vnd.pgrst.plan+json; for=\"application/json\"; charset=utf-8")
+        resHeaders `shouldSatisfy` elem ("Content-Type", "application/vnd.pgrst.plan+json; charset=utf-8")
         resStatus `shouldBe` Status { statusCode = 200, statusMessage="OK" }
-        totalCost `shouldBe` 68.56
+        totalCost `shouldBe` 68.57
 
     it "outputs the plan for text/xml" $ do
       r <- request methodGet "/rpc/return_scalar_xml"
@@ -240,7 +263,7 @@ spec actualPgVersion = do
           resStatus  = simpleStatus r
 
       liftIO $ do
-        resHeaders `shouldSatisfy` elem ("Content-Type", "application/vnd.pgrst.plan+text; for=\"application/json\"; charset=utf-8")
+        resHeaders `shouldSatisfy` elem ("Content-Type", "application/vnd.pgrst.plan+text; charset=utf-8")
         resStatus `shouldBe` Status { statusCode = 200, statusMessage="OK" }
         resBody `shouldSatisfy` (\t -> LBS.take 9 t == "Aggregate")
 
@@ -253,7 +276,7 @@ spec actualPgVersion = do
           resStatus  = simpleStatus r
 
       liftIO $ do
-        resHeaders `shouldSatisfy` elem ("Content-Type", "application/vnd.pgrst.plan+text; for=\"application/json\"; charset=utf-8")
+        resHeaders `shouldSatisfy` elem ("Content-Type", "application/vnd.pgrst.plan+text; charset=utf-8")
         resStatus `shouldBe` Status { statusCode = 200, statusMessage="OK" }
         resBody `shouldSatisfy` (\t -> LBS.take 9 t == "Aggregate")
 
@@ -276,46 +299,13 @@ spec actualPgVersion = do
 
       liftIO $ planCost r `shouldSatisfy` (< 70.9)
 
-    context "!inner vs embed not null" $ do
-      it "on an o2m, an !inner has a similar cost to not.null" $ do
-        r1 <- request methodGet "/clients?select=*,projects!inner(*)&id=eq.1"
-               [planHdr] ""
-
-        liftIO $ planCost r1 `shouldSatisfy` (< 33.3)
-
-        r2 <- request methodGet "/clients?select=*,projects(*)&projects=not.is.null&id=eq.1"
-               [planHdr] ""
-
-        liftIO $ planCost r2 `shouldSatisfy` (< 33.3)
-
-      it "on an m2o, an !inner has a similar cost to not.null" $ do
-        r1 <- request methodGet "/projects?select=*,clients!inner(*)&id=eq.1"
-               [planHdr] ""
-
-        liftIO $ planCost r1 `shouldSatisfy` (< 16.42)
-
-        r2 <- request methodGet "/projects?select=*,clients(*)&clients=not.is.null&id=eq.1"
-               [planHdr] ""
-
-        liftIO $ planCost r2 `shouldSatisfy` (< 16.42)
-
-      it "on an m2m, an !inner has a similar cost to not.null" $ do
-        r1 <- request methodGet "/users?select=*,tasks!inner(*)&tasks.id=eq.1"
-               [planHdr] ""
-
-        liftIO $ planCost r1 `shouldSatisfy` (< 20876.14)
-
-        r2 <- request methodGet "/users?select=*,tasks(*)&tasks.id=eq.1&tasks=not.is.null"
-               [planHdr] ""
-
-        liftIO $ planCost r2 `shouldSatisfy` (< 20876.14)
 
   describe "function call costs" $ do
     it "should not exceed cost when calling setof composite proc" $ do
       r <- request methodGet "/rpc/get_projects_below?id=3"
              [planHdr] ""
 
-      liftIO $ planCost r `shouldSatisfy` (< 45.4)
+      liftIO $ planCost r `shouldSatisfy` (< 36.4)
 
     it "should not exceed cost when calling setof composite proc with empty params" $ do
       r <- request methodGet "/rpc/getallprojects"
@@ -329,61 +319,20 @@ spec actualPgVersion = do
 
       liftIO $ planCost r `shouldSatisfy` (< 1.18)
 
-    context "function inlining" $ do
+    context "params=multiple-objects" $ do
-      it "should inline a zero argument function(the function won't appear in the plan tree)" $ do
+      it "should not exceed cost when calling setof composite proc" $ do
-        r <- request methodGet "/rpc/getallusers?id=eq.1"
+        r <- request methodPost "/rpc/get_projects_below"
-               [(hAccept, "application/vnd.pgrst.plan")] ""
+               [planHdr, ("Prefer", "params=multiple-objects")]
+               [str| [{"id": 1}, {"id": 4}] |]
 
-        let resBody = simpleBody r
+        liftIO $ planCost r `shouldSatisfy` (< 4503.4)
 
-        liftIO $ do
+      it "should not exceed cost when calling scalar proc" $ do
-          resBody `shouldSatisfy` (\t -> not $ T.isInfixOf "getallusers" (decodeUtf8 $ LBS.toStrict t))
+        r <- request methodPost "/rpc/add_them"
+               [planHdr, ("Prefer", "params=multiple-objects")]
+               [str| [{"a": 3, "b": 4}, {"a": 1, "b": 2}, {"a": 8, "b": 7}] |]
 
-      it "should inline a function with arguments(the function won't appear in the plan tree)" $ do
+        liftIO $ planCost r `shouldSatisfy` (< 5.85)
-        r <- request methodGet "/rpc/getitemrange?min=10&max=15"
-               [(hAccept, "application/vnd.pgrst.plan")] ""
-
-        let resBody = simpleBody r
-
-        liftIO $ do
-          resBody `shouldSatisfy` (\t -> not $ T.isInfixOf "getitemrange" (decodeUtf8 $ LBS.toStrict t))
-
-    context "index usage" $ do
-      it "should use an index for a json arrow operator filter" $ do
-        r <- request methodGet "/bets?data_json->>contractId=eq.1"
-               [(hAccept, "application/vnd.pgrst.plan")] ""
-
-        let resBody = simpleBody r
-
-        liftIO $ do
-          resBody `shouldSatisfy` (\t -> T.isInfixOf "Index Cond" (decodeUtf8 $ LBS.toStrict t))
-
-      it "should use an index for a jsonb arrow operator filter" $ do
-        r <- request methodGet "/bets?data_jsonb->>contractId=eq.1"
-               [(hAccept, "application/vnd.pgrst.plan")] ""
-
-        let resBody = simpleBody r
-
-        liftIO $ do
-          resBody `shouldSatisfy` (\t -> T.isInfixOf "Index" (decodeUtf8 $ LBS.toStrict t))
-
-      it "should use an index for ordering on a json arrow operator" $ do
-        r <- request methodGet "/bets?order=data_json->>contractId"
-               [(hAccept, "application/vnd.pgrst.plan")] ""
-
-        let resBody = simpleBody r
-
-        liftIO $ do
-          resBody `shouldSatisfy` (\t -> T.isInfixOf "Index" (decodeUtf8 $ LBS.toStrict t))
-
-      it "should use an index for ordering on a jsonb arrow operator" $ do
-        r <- request methodGet "/bets?order=data_jsonb->>contractId"
-               [(hAccept, "application/vnd.pgrst.plan")] ""
-
-        let resBody = simpleBody r
-
-        liftIO $ do
-          resBody `shouldSatisfy` (\t -> T.isInfixOf "Index" (decodeUtf8 $ LBS.toStrict t))
 
 disabledSpec :: SpecWith ((), Application)
 disabledSpec =