Upgrade protolude to 0.3.1 (#2306)

* Format CHANGELOG

.cirrus.yml

@@ -1,5 +1,5 @@
 freebsd_instance:
-  image_family: freebsd-13-1
+  image_family: freebsd-13-0
 
 build_task:
   name: Build FreeBSD (Stack)

.github/workflows/ci.yaml

@@ -113,12 +113,9 @@ jobs:
         uses: ./.github/actions/setup-nix
         with:
           authToken: '${{ secrets.CACHIX_AUTH_TOKEN }}'
-          tools: tests
 
       - name: Build static executable
         run: nix-build -A postgrestStatic
-      - name: Check static executable
-        run: postgrest-check-static result/bin/postgrest
       - name: Save built executable as artifact
         uses: actions/upload-artifact@v3
         with:
@@ -153,6 +150,8 @@ jobs:
             cache: |
               ~/.stack
               .stack-work
+            test: true
+            pgdir: /usr/lib/postgresql
             artifact: postgrest-ubuntu-x64
 
           - name: MacOS & test
@@ -160,6 +159,8 @@ jobs:
             cache: |
               ~/.stack
               .stack-work
+            test: true
+            pgdir: /usr/local/Cellar/postgresql
             artifact: postgrest-macos-x64
 
           - name: Windows
@@ -169,6 +170,8 @@ jobs:
               ~\AppData\Local\Programs\stack
               .stack-work
             deps: Add-Content $env:GITHUB_PATH $env:PGBIN
+            # We'd need to make test/with_tmp_db run on Windows first
+            # test: true
             artifact: postgrest-windows-x64
 
     name: Build ${{ matrix.name }} (Stack)
@@ -185,6 +188,12 @@ jobs:
         run: ${{ matrix.deps }}
       - name: Build with Stack
         run: stack build --local-bin-path result --copy-bins
+      - name: Run Spec tests with Stack
+        if: ${{ matrix.test }}
+        run: |
+          postgresql_bin="$(find ${{ matrix.pgdir }} -maxdepth 2 -type d -name bin | head -n 1)"
+          echo "Using PostgreSQL binaries at $postgresql_bin ..."
+          PATH="$postgresql_bin:$PATH" test/with_tmp_db stack test
       - name: Save built executable as artifact
         uses: actions/upload-artifact@v3
         with:

.gitignore

@@ -22,4 +22,3 @@ __pycache__
 coverage
 .hpc
 loadtest
-.history

CHANGELOG.md

@@ -3,110 +3,25 @@
 All notable changes to this project will be documented in this file.
 This project adheres to [Semantic Versioning](http://semver.org/).
 
-## Unreleased
-
-## [10.0.0] - 2022-08-18
-
-### Added
-
- - #1933, #2109, Add a minimal health check endpoint - @steve-chavez
-   + For enabling this, the `admin-server-port` config must be set explictly
-   + A `<host>:<admin_server_port>/live` endpoint is available for checking if postgrest is running on its port/socket. 200 OK = alive, 503 = dead.
-   + A `<host>:<admin_server_port>/ready` endpoint is available for checking a correct internal state(the database connection plus the schema cache). 200 OK = ready, 503 = not ready.
- - #1988, Add the current user to the request log on stdout - @DavidLindbom, @wolfgangwalther
- - #1823, Add the ability to run postgrest without any configuration. - @wolfgangwalther
-   + #1991, Add the ability to run without `db-uri` using libpq's PG environment variables to connect. - @wolfgangwalther
-   + #1769, Add the ability to run without `db-schemas`, defaulting to `db-schemas=public`. - @wolfgangwalther
-   + #1689, Add the ability to run without `db-anon-role` disabling anonymous access. - @wolfgangwalther
- - #1543, Allow access to fields of composite types in select=, order= and filters through JSON operators -> and ->>. - @wolfgangwalther
- - #2075, Allow access to array items in ?select=, ?order= and filters through JSON operators -> and ->>. - @wolfgangwalther
- - #2156, #2211, Allow applying `limit/offset` to UPDATE/DELETE to only affect a subset of rows - @steve-chavez
-   + It requires an explicit `order` on a unique column(s)
- - #1917, Add error codes with the `"PGRST"` prefix to the error response body to differentiate PostgREST errors from PostgreSQL errors - @laurenceisla
- - #1917, Normalize the error response body by always having the `detail` and `hint` error fields with a `null` value if they are empty - @laurenceisla
- - #2176, Errors raised with `SQLSTATE` now include the message and the code in the response body - @laurenceisla
- - #2236, Support POSIX regular expression operators for row filtering - @enote-kane
- - #2202, Allow returning XML from RPCs - @fjf2002
- - #2268, Allow returning XML from single-column queries - @fjf2002
- - #2300, RPC POST for function w/single unnamed XML param #2300 - @fjf2002
- - #1564, Allow geojson output by specifying the `Accept: application/geo+json` media type - @steve-chavez
-   + Requires postgis >= 3.0
-   + Works for GET, RPC, POST/PATCH/DELETE with `Prefer: return=representation`.
-   + Resource embedding works and the embedded rows will go into the `properties` key
-   + In case of multiple geometries in the same table, you can choose which one will go into the `geometry` key with the usual `?select` query parameter.
- - #1082, Add security definitions to the OpenAPI output - @laurenceisla
- - #2378, Support http OPTIONS method on RPC and root path - @steve-chavez
- - #2354, Allow getting the EXPLAIN plan of a request by using the `Accept: application/vnd.pgrst.plan` header - @steve-chavez
-   + Only allowed if the `db-plan-enabled` config is set to true
-   + Can generate the plan for different media types using the `for` parameter: `Accept: application/vnd.pgrst.plan; for="application/vnd.pgrst.object"`
-   + Different options for the plan can be used with the `options` parameter: `Accept: application/vnd.pgrst.plan; options=analyze|verbose|settings|buffers|wal`
-   + The plan can be obtained in text or json by using different media type suffixes: `Accept: application/vnd.pgrst.plan+text` and `Accept: application/vnd.pgrst.plan+json`.
- - #2144, Support computed relationships which allow extending and overriding relationships for resource embedding - @steve-chavez, @wolfgangwalther
- - #1984, Detect one-to-one relationships for resource embedding - @steve-chavez
-   + Detected when there's a foreign key with a unique constraint or when a foreign key is also a primary key
-
-### Fixed
-
- - #2058, Return 204 No Content without Content-Type for PUT - @wolfgangwalther
- - #2107, Clarify error for failed schema cache load. - @steve-chavez
-   + From `Database connection lost. Retrying the connection` to `Could not query the database for the schema cache. Retrying.`
- - #1771, Fix silently ignoring filter on a non-existent embedded resource - @steve-chavez
- - #2152, Remove functions, which are uncallable because of unnamend arguments from schema cache and OpenAPI output. - @wolfgangwalther
- - #2145, Fix accessing json array fields with -> and ->> in ?select= and ?order=. - @wolfgangwalther
- - #2155, Ignore `max-rows` on POST, PATCH, PUT and DELETE - @steve-chavez
- - #2254, Fix inferring a foreign key column as a primary key column on views - @steve-chavez
- - #2070, Restrict generated many-to-many relationships - @steve-chavez
-   + Only adds many-to-many relationships when: a table has FKs to two other tables and these FK columns are part of the table's PK columns.
- - #2278, Allow casting to types with underscores and numbers(e.g. `select=oid_array::_int4`) - @steve-chavez
- - #2277, #2238, #1643, Prevent views from breaking one-to-many/many-to-one embeds when using column or FK as target - @steve-chavez
-    + When using a column or FK as target for embedding(`/tbl?select=*,col-or-fk(*)`), only tables are now detected and views are not.
-    + You can still use a column or an inferred FK on a view to embed a table(`/view?select=*,col-or-fk(*)`)
- - #2317, Increase the `db-pool-timeout` to 1 hour to prevent frequent high connection latency - @steve-chavez
- - #2341, The search path now correctly identifies schemas with uppercase and special characters in their names (regression) - @laurenceisla
- - #2364, "404 Not Found" on nested routes and "405 Method Not Allowed" errors no longer start an empty database transaction - @steve-chavez
- - #2342, Fix inaccurate result count when an inner embed was selected after a normal embed in the query string - @laurenceisla
- - #2376, OPTIONS requests no longer start an empty database transaction - @steve-chavez
- - #2395, Allow using columns with dollar sign($) without double quoting in filters and `select` - @steve-chavez
- - #2410, Fix loop crash error on startup in Postgres 15 beta 3. Log: "UNION types \"char\" and text cannot be matched". - @yevon
- - #2397, Fix race conditions managing database connection helper - @robx
- - #2269, Allow `limit=0` in the request query to return an empty array - @gautam1168, @laurenceisla
-
-### Changed
-
- - #2001, Return 204 No Content without Content-Type for RPCs returning VOID - @wolfgangwalther
-   + Previously, those RPCs would return "null" as a body with Content-Type: application/json.
- - #2156, `limit/offset` now limits the affected rows on UPDATE/DELETE  - @steve-chavez
-   + Previously, `limit/offset` only limited the returned rows but not the actual updated rows
- - #2155, `max-rows` is no longer applied on POST/PATCH/PUT/DELETE returned rows - @steve-chavez
-   + This was misleading because the affected rows were not really affected by `max-rows`, only the returned rows were limited
- - #2070, Restrict generated many-to-many relationships - @steve-chavez
-   + A primary key that contains the foreign key columns is now needed for generating many-to-many relationships.
- - #2277, Views now are not detected when embedding using the column or FK as target (`/view?select=*,column(*)`) - @steve-chavez
-   + This embedding form was easily made ambiguous whenever a new view was added.
-   + You can use computed relationships to keep this embedding form working
- - #2312, Using `Prefer: return=representation` no longer returns a `Location` header - @laurenceisla
- - #1984, For the cases where one to one relationships are detected, json objects will be returned instead of json arrays of length 1
-   + If you wish to override this behavior, you can use computed relationships to return arrays again
-
 ## [9.0.1] - 2022-06-03
 
 ### Fixed
 
-- #2165, Fix json/jsonb columns should not have type in OpenAPI spec - @clrnd
+ - #2165, Fix json/jsonb columns should not have type in OpenAPI spec - @clrnd
-- #2020, Execute deferred constraint triggers when using `Prefer: tx=rollback` - @wolfgangwalther
+ - #2020, Execute deferred constraint triggers when using `Prefer: tx=rollback` - @wolfgangwalther
-- #2077, Fix `is` not working with upper or mixed case values like `NULL, TrUe, FaLsE` - @steve-chavez
+ - #2077, Fix `is` not working with upper or mixed case values like `NULL, TrUe, FaLsE` - @steve-chavez
-- #2024, Fix schema cache loading when views with XMLTABLE and DEFAULT are present - @wolfgangwalther
+ - #2024, Fix schema cache loading when views with XMLTABLE and DEFAULT are present - @wolfgangwalther
-- #1724, Fix wrong CORS header Authentication -> Authorization - @wolfgangwalther
+ - #1724, Fix wrong CORS header Authentication -> Authorization - @wolfgangwalther
-- #2120, Fix reading database configuration properly when `=` is present in value - @wolfgangwalther
+ - #2120, Fix reading database configuration properly when `=` is present in value - @wolfgangwalther
-- #2135, Remove trigger functions from schema cache and OpenAPI output, because they can't be called directly anyway. - @wolfgangwalther
+ - #2135, Remove trigger functions from schema cache and OpenAPI output, because they can't be called directly anyway. - @wolfgangwalther
-- #2101, Remove aggregates, procedures and window functions from the schema cache and OpenAPI output. - @wolfgangwalther
+ - #2101, Remove aggregates, procedures and window functions from the schema cache and OpenAPI output. - @wolfgangwalther
-- #2153, Fix --dump-schema running with a wrong PG version. - @wolfgangwalther
+ - #2153, Fix --dump-schema running with a wrong PG version. - @wolfgangwalther
-- #2042, Keep working when EMFILE(Too many open files) is reached. - @steve-chavez
+ - #2042, Keep working when EMFILE(Too many open files) is reached. - @steve-chavez
-- #2147, Ignore `Content-Type` headers for `GET` requests when calling RPCs. - @laurenceisla
+ - #2147, Ignore `Content-Type` headers for `GET` requests when calling RPCs. - @laurenceisla
-    + Previously, `GET` without parameters, but with `Content-Type: text/plain` or `Content-Type: application/octet-stream` would fail with `404 Not Found`, even if a function without arguments was available.
+   + Previously, `GET` without parameters, but with `Content-Type: text/plain` or `Content-Type: application/octet-stream` would fail with `404 Not Found`, even if a function without arguments was available.
-- #2239, Fix misleading disambiguation error where the content of the `relationship` key looks like valid syntax - @laurenceisla
+ - #2239, Fix misleading disambiguation error where the content of the `relationship` key looks like valid syntax - @laurenceisla
-- #2294, Disable parallel GC for better performance on higher core CPUs - @steve-chavez
+ - #2294, Disable parallel GC for better performance on higher core CPUs - @steve-chavez
-- #1076, Fix using CPU while idle - @steve-chavez
+ - #1076, Fix using CPU while idle - @steve-chavez
 
 ## [9.0.0] - 2021-11-25
 

default.nix

@@ -1,11 +1,9 @@
-{ system ? builtins.currentSystem }:
-
 let
   name =
     "postgrest";
 
   compiler =
-    "ghc924";
+    "ghc8107";
 
   # PostgREST source files, filtered based on the rules in the .gitignore files
   # and file extensions. We want to include as litte as possible, as the files
@@ -44,16 +42,16 @@ let
 
   # Evaluated expression of the Nixpkgs repository.
   pkgs =
-    import nixpkgs { inherit overlays system; };
+    import nixpkgs { inherit overlays; };
 
   postgresqlVersions =
     [
-      { name = "postgresql-14"; postgresql = pkgs.postgresql_14.withPackages (p: [ p.postgis p.pg_safeupdate ]); }
+      { name = "postgresql-14"; postgresql = pkgs.postgresql_14; }
-      { name = "postgresql-13"; postgresql = pkgs.postgresql_13.withPackages (p: [ p.postgis p.pg_safeupdate ]); }
+      { name = "postgresql-13"; postgresql = pkgs.postgresql_13; }
-      { name = "postgresql-12"; postgresql = pkgs.postgresql_12.withPackages (p: [ p.postgis p.pg_safeupdate ]); }
+      { name = "postgresql-12"; postgresql = pkgs.postgresql_12; }
-      { name = "postgresql-11"; postgresql = pkgs.postgresql_11.withPackages (p: [ p.postgis p.pg_safeupdate ]); }
+      { name = "postgresql-11"; postgresql = pkgs.postgresql_11; }
-      { name = "postgresql-10"; postgresql = pkgs.postgresql_10.withPackages (p: [ p.postgis p.pg_safeupdate ]); }
+      { name = "postgresql-10"; postgresql = pkgs.postgresql_10; }
-      { name = "postgresql-9.6"; postgresql = pkgs.postgresql_9_6.withPackages (p: [ p.postgis p.pg_safeupdate ]); }
+      { name = "postgresql-9.6"; postgresql = pkgs.postgresql_9_6; }
     ];
 
   patches =
@@ -66,7 +64,7 @@ let
   # 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; };
+    import nix/static-haskell-package.nix { inherit nixpkgs compiler patches allOverlays; };
 
   # Options passed to cabal in dev tools and tests
   devCabalOptions =
@@ -151,7 +149,6 @@ rec {
       inherit postgrest devCabalOptions withTools;
       ghc = pkgs.haskell.compiler."${compiler}";
       inherit (pkgs.haskell.packages."${compiler}") hpc-codecov;
-      inherit (pkgs.haskell.packages."${compiler}") weeder;
     };
 
   withTools =

main/Main.hs

@@ -2,11 +2,15 @@
 
 module Main (main) where
 
+import qualified Data.Map.Strict as M
+
 import System.IO (BufferMode (..), hSetBuffering)
 
 import qualified PostgREST.App as App
 import qualified PostgREST.CLI as CLI
 
+import PostgREST.Config (readPGRSTEnvironment)
+
 import Protolude
 
 #ifndef mingw32_HOST_OS
@@ -16,7 +20,8 @@ import qualified PostgREST.Unix as Unix
 main :: IO ()
 main = do
   setBuffering
-  opts <- CLI.readCLIShowHelp
+  hasPGRSTEnv <- not . M.null <$> readPGRSTEnvironment
+  opts <- CLI.readCLIShowHelp hasPGRSTEnv
   CLI.main installSignalHandlers runAppInSocket opts
 
 installSignalHandlers :: App.SignalHandlerInstaller

nix/README.md

@@ -154,8 +154,8 @@ $ postgrest-run test/io/configs/simple.conf
 
 ## Testing
 
-In nix-shell, you'll find utility scripts that make it very easy to run our
+In nix-shell, you'll find utility scripts that make it very easy to run the
-test suite, including setting up all required dependencies and
+Haskell test suite, including setting up all required dependencies and
 temporary test databases:
 
 ```bash
@@ -182,55 +182,7 @@ postgrest-test-io -k config
 # Run tests in parallel using xdist, specifying the number of processes:
 postgrest-test-io -n auto
 postgrest-test-io -n 8
-```
 
-The memory tests check that we don't surpass a memory threshold for big request bodies.
-
-```bash
-# Build the dependencies needed for the memory test
-nix-shell --arg memory true
-
-# Run the memory test
-postgrest-test-memory
-```
-
-The loadtests ensure that performance doesn't drop on a change. Underlyingly they use
-[vegeta](https://github.com/tsenart/vegeta).
-
-```bash
-# Run the loadtests on the latest commit(HEAD)
-postgrest-loadtest
-
-# You can loadtest comparing to a different branch
-postgrest-loadtest-against master
-
-# Produce a markdown report to be used on CI
-postgrest-loadtest-report
-```
-
-Our query cost tests ensure that our generated queries don't surpass a threshold EXPLAIN cost.
-
-```bash
-postgrest-test-querycost
-```
-
-doctests for some of our modules are also available:
-
-```bash
-postgrest-test-doctest
-```
-
-## Code coverage
-
-Code coverage is available under the `postgrest-coverage` command. This will produce a `./coverage` directory that can be visualized with a simple http server.
-
-```bash
-# Will run all the tests and produce a coverage dir
-postgrest-coverage
-
-# Visualize the output
-cd coverage
-python -mSimpleHTTPServer 8080
 ```
 
 ## Linting and styling code

nix/hsie/Main.hs

@@ -24,22 +24,21 @@ import qualified Data.Text                               as T
 import qualified Data.Text.IO                            as T
 import qualified Dot
 import qualified GHC
-import qualified GHC.Paths
 import qualified Language.Haskell.GHC.ExactPrint.Parsers as ExactPrint
 import qualified Options.Applicative                     as O
 import qualified System.FilePath                         as FP
 
+import Bag                        (bagToList)
 import Data.Aeson.Encode.Pretty   (encodePretty)
 import Data.Function              ((&))
 import Data.List                  (intercalate)
 import Data.Maybe                 (catMaybes, mapMaybe)
 import Data.Text                  (Text)
-import GHC.Data.Bag               (bagToList)
 import GHC.Generics               (Generic)
 import GHC.Hs.Extension           (GhcPs)
-import GHC.Types.Name.Occurrence  (occNameString)
+import Module                     (moduleNameString)
-import GHC.Types.Name.Reader      (rdrNameOcc)
+import OccName                    (occNameString)
-import GHC.Unit.Module.Name       (moduleNameString)
+import RdrName                    (rdrNameOcc)
 import System.Directory.Recursive (getFilesRecursive)
 import System.Exit                (exitFailure)
 
@@ -198,11 +197,11 @@ sourceSymbols source = do
       return $ concatMap (importSymbols source filepath . GHC.unLoc) hsmodImports
 
 -- | Parse a Haskell module
-parseModule :: FilePath -> IO GHC.HsModule
+parseModule :: String -> IO (GHC.HsModule GhcPs)
 parseModule filepath = do
-  result <- ExactPrint.parseModule GHC.Paths.libdir filepath
+  result <- ExactPrint.parseModule filepath
   case result of
-    Right hsmod ->
+    Right (_, hsmod) ->
       return $ GHC.unLoc hsmod
     Left errs ->
       fail $ "Errors with " <> show filepath <> ":\n    "
@@ -213,6 +212,7 @@ parseModule filepath = do
 -- If the import is a wildcard, i.e. no symbols are selected for import, then
 -- only one item is returned.
 importSymbols :: FilePath -> FilePath -> GHC.ImportDecl GhcPs -> [ImportedSymbol]
+importSymbols _ _  (GHC.XImportDecl _) = mempty
 importSymbols source filepath GHC.ImportDecl{..} =
   case ideclHiding of
     Just (hiding, syms) ->

nix/hsie/default.nix

@@ -16,20 +16,15 @@ let
   ghc = ghcWithPackages modules;
   hsie =
     runCommand "haskellimports" { inherit name src; }
-      ''
+      "${ghc}/bin/ghc -O -Werror -Wall -package ghc $src -o $out";
-        cd $TMP
-        cp $src $TMP/Main.hs
-        ${ghc}/bin/ghc -O -Werror -Wall -package ghc Main.hs -o Main
-        cp Main $out
-      '';
   bin =
     runCommand name { inherit hsie name; }
       ''
         mkdir -p $out/bin
         ln -s $hsie $out/bin/$name
       '';
-  bash-completion =
+  bashCompletion =
     runCommand "${name}-bash-completion" { inherit bin name; }
       "$bin/bin/$name --bash-completion-script $bin/bin/$name > $out";
 in
-hsie // { inherit bash-completion bin; }
+hsie // { inherit bashCompletion bin; }

nix/nixpkgs-version.nix

@@ -1,6 +1,6 @@
 # Pinned version of Nixpkgs, generated with postgrest-nixpkgs-upgrade.
 {
-  date = "2022-08-09";
+  date = "2021-11-02";
-  rev = "9f15d6c3a74d2778c6e1af67947c95f100dc6fd2";
+  rev = "7053541084bf5ce2921ef307e5585d39d7ba8b3f";
-  tarballHash = "14axdmi3kb6rlib39ik42yq907bm66x6vzswm5w1rsnw9vzgm31a";
+  tarballHash = "1flhh5d4zy43x6060hvzjb5hi5cmc51ivc0nwmija9n8d35kcc4x";
 }

nix/overlays/build-toolbox/build-toolbox.nix

@@ -1,11 +1,11 @@
-# Creates an environment that exposes bash-completion arguments from all checkedShellScripts
+# Creates an environment that exposes bashCompletion arguments from all checkedShellScripts
 { buildEnv }:
 { name
 , tools
 , extra ? { }
 }:
 let
-  bash-completion = builtins.map (tool: tool.bash-completion) tools;
+  bashCompletion = builtins.map (tool: tool.bashCompletion) tools;
 
   env = buildEnv {
     inherit name;
@@ -13,4 +13,4 @@ let
   };
 
 in
-env // { inherit bash-completion; } // extra
+env // { inherit bashCompletion; } // extra

nix/overlays/checked-shell-script/checked-shell-script.nix

@@ -58,7 +58,7 @@ let
         sed '/_positionals_count + 1/a\\t\t\t\tset -- "''${@:1:1}" "--" "''${@:2}"' -i $out
       '';
 
-  bash-completion =
+  bashCompletion =
     runCommand "${name}-completion" { } (
       ''
         ${argbash}/bin/argbash --type completion --strip all ${argsTemplate}/${name}.m4 > $out
@@ -138,4 +138,4 @@ let
   script =
     runCommand name { inherit bin name; } "ln -s $bin/bin/$name $out";
 in
-script // { inherit bin bash-completion; }
+script // { inherit bin bashCompletion; }

nix/overlays/gitignore.nix

@@ -12,8 +12,8 @@ self: super:
       gitignoreSrc = super.fetchFromGitHub {
         owner = "hercules-ci";
         repo = "gitignore";
-        rev = "a20de23b925fd8264fd7fad6454652e142fd7f73";
+        rev = "211907489e9f198594c0eb0ca9256a1949c9d412";
-        sha256 = "sha256-8DFJjXG8zqoONA1vXtgeKXy68KdJL5UaXR8NtVMUbx8=";
+        sha256 = "06j7wpvj54khw0z10fjyi31kpafkr6hi1k0di13k1xp8kywvfyx8";
       };
     in
     (super.callPackage gitignoreSrc { }).gitignoreSource;

nix/overlays/haskell-packages.nix

@@ -31,6 +31,51 @@ let
       #
       # To get the sha256:
       #   nix-prefetch-url --unpack https://github.com/<owner>/<repo>/archive/<commit>.tar.gz
+
+      protolude =
+        prev.callHackageDirect
+          {
+            pkg = "protolude";
+            ver = "0.3.1";
+            sha256 = "0gf0mn1ycllr69kdq1p07qf7935s10jz0nnhynwqy3d6nmycxr5j";
+          }
+          { };
+
+      wai-extra =
+        prev.callHackageDirect
+          {
+            pkg = "wai-extra";
+            ver = "3.1.8";
+            sha256 = "1ha8sxc2ii7k7xs5nm06wfwqmf4f1p2acp4ya0jnx6yn6551qps4";
+          }
+          { };
+
+      wai-logger =
+        prev.callHackageDirect
+          {
+            pkg = "wai-logger";
+            ver = "2.3.7";
+            sha256 = "1d23fdbwbahr3y1vdyn57m1qhljy22pm5cpgb20dy6mlxzdb30xd";
+          }
+          { };
+
+      warp =
+        lib.dontCheck (prev.callHackageDirect
+          {
+            pkg = "warp";
+            ver = "3.3.19";
+            sha256 = "0y3jj4bhviss6ff9lwxki0zbdcl1rb398bk4s80zvfpnpy7p94cx";
+          }
+          { });
+
+      hasql-dynamic-statements =
+        lib.dontCheck (lib.unmarkBroken prev.hasql-dynamic-statements);
+
+      hasql-implicits =
+        lib.dontCheck (lib.unmarkBroken prev.hasql-implicits);
+
+      ptr =
+        lib.dontCheck (lib.unmarkBroken prev.ptr);
     } // extraOverrides final prev;
 in
 {

nix/overlays/postgresql-legacy.nix

@@ -2,18 +2,19 @@ self: super:
 # Overlay that adds legacy versions of PostgreSQL that are supported by
 # PostgREST.
 {
-  # PostgreSQL 9.6 was removed from Nixpkgs with
+  # PostgreSQL 9.5 was removed from Nixpkgs with
-  # https://github.com/NixOS/nixpkgs/commit/757dd008b2f2926fc0f7688fa8189f930ea47521
+  # https://github.com/NixOS/nixpkgs/commit/72ab382fb6b729b0d654f2c03f5eb25b39f11fbb
   # We pin its parent commit to get the last version that was available.
-  postgresql_9_6 =
+  # postgresql_9_5 =
-    let
+  #  let
-      rev = "571cbf3d1db477058303cef8754fb85a14e90eb7";
+  #    rev = "55ac7d4580c9ab67848c98cb9519317a1cc399c8";
-      tarballHash = "0q74wn418i1bn5sssacmw8ykpmqvzr0s93sj6pbs3rf6bf134fkz";
+  #    tarballHash = "02ffj9f8s1hwhmxj85nx04sv64qb6jm7w0122a1dz9n32fymgklj";
-      pinnedPkgs =
+  #
-        builtins.fetchTarball {
+  #    pinnedPkgs =
-          url = "https://github.com/nixos/nixpkgs/archive/${rev}.tar.gz";
+  #      builtins.fetchTarball {
-          sha256 = tarballHash;
+  #        url = "https://github.com/nixos/nixpkgs/archive/${rev}.tar.gz";
-        };
+  #        sha256 = tarballHash;
-    in
+  #      };
-    (import pinnedPkgs { }).pkgs.postgresql_9_6;
+  #  in
+  #  (import pinnedPkgs { }).pkgs.postgresql_9_5;
 }

nix/patches/default.nix

@@ -18,8 +18,7 @@
         done
       '';
 
-  static-haskell-nix-ncurses =
+  # See: https://github.com/NixOS/nixpkgs/pull/87879
-    ./static-haskell-nix-ncurses.patch;
+  nixpkgs-openssl-split-runtime-dependencies-of-static-builds =
-  static-haskell-nix-ghc-bignum =
+    ./nixpkgs-openssl-split-runtime-dependencies-of-static-builds.patch;
-    ./static-haskell-nix-ghc-bignum.patch;
 }

nix/patches/nixpkgs-openssl-split-runtime-dependencies-of-static-builds.patch

@@ -0,0 +1,76 @@
+diff --git a/pkgs/development/libraries/openssl/default.nix b/pkgs/development/libraries/openssl/default.nix
+index d4be8cc2428..3979698711f 100644
+--- a/pkgs/development/libraries/openssl/default.nix
++++ b/pkgs/development/libraries/openssl/default.nix
+@@ -50,9 +50,21 @@ let
+       substituteInPlace crypto/async/arch/async_posix.h \
+         --replace '!defined(__ANDROID__) && !defined(__OpenBSD__)' \
+                   '!defined(__ANDROID__) && !defined(__OpenBSD__) && 0'
++    '' + optionalString static
++    # On static builds, the ENGINESDIR will be empty, but its path will be
++    # compiled into the library. In order to minimize the runtime dependencies
++    # of packages that statically link openssl, we move it into the OPENSSLDIR,
++    # which will be separated into the 'etc' output.
++    ''
++      substituteInPlace Configurations/unix-Makefile.tmpl \
++        --replace 'ENGINESDIR=$(libdir)/engines-{- $sover_dirname -}' \
++                  'ENGINESDIR=$(OPENSSLDIR)/engines-{- $sover_dirname -}'
+     '';
+ 
+-    outputs = [ "bin" "dev" "out" "man" ] ++ optional withDocs "doc";
++    outputs = [ "bin" "dev" "out" "man" ]
++      ++ optional withDocs "doc"
++      # Separate output for the runtime dependencies of the static build.
++      ++ optional static "etc";
+     setOutputFlags = false;
+     separateDebugInfo =
+       !stdenv.hostPlatform.isDarwin &&
+@@ -101,7 +113,17 @@ let
+     configureFlags = [
+       "shared" # "shared" builds both shared and static libraries
+       "--libdir=lib"
+-      "--openssldir=etc/ssl"
++      (if !static then
++         "--openssldir=etc/ssl"
++       else
++         # Separate the OPENSSLDIR into its own output, as its path will be
++         # compiled into 'libcrypto.a'. This makes it a runtime dependency of
++         # any package that statically links openssl, so we want to keep that
++         # output minimal. We need to prepend '/.' to the path in order to make
++         # it appear absolute before variable expansion, the 'prefix' would be
++         # prepended to it otherwise.
++         "--openssldir=/.$(etc)/etc/ssl"
++      )
+     ] ++ lib.optionals withCryptodev [
+       "-DHAVE_CRYPTODEV"
+       "-DUSE_CRYPTODEV_DIGESTS"
+@@ -131,6 +153,9 @@ let
+       if [ -n "$(echo $out/lib/*.so $out/lib/*.dylib $out/lib/*.dll)" ]; then
+           rm "$out/lib/"*.a
+       fi
++
++      # 'etc' is a separate output on static builds only.
++      etc=$out
+     '' + lib.optionalString (!stdenv.hostPlatform.isWindows)
+       # Fix bin/c_rehash's perl interpreter line
+       #
+@@ -152,14 +177,15 @@ let
+       mv $out/include $dev/
+ 
+       # remove dependency on Perl at runtime
+-      rm -r $out/etc/ssl/misc
++      rm -r $etc/etc/ssl/misc
+ 
+-      rmdir $out/etc/ssl/{certs,private}
++      rmdir $etc/etc/ssl/{certs,private}
+     '';
+ 
+     postFixup = lib.optionalString (!stdenv.hostPlatform.isWindows) ''
+-      # Check to make sure the main output doesn't depend on perl
+-      if grep -r '${buildPackages.perl}' $out; then
++      # Check to make sure the main output and the static runtime dependencies
++      # don't depend on perl
++      if grep -r '${buildPackages.perl}' $out $etc; then
+         echo "Found an erroneous dependency on perl ^^^" >&2
+         exit 1
+       fi

nix/patches/static-haskell-nix-ghc-bignum.patch

@@ -1,12 +0,0 @@
-diff --git a/survey/default.nix b/survey/default.nix
-index 70afbbc..28cb0e9 100644
---- a/survey/default.nix
-+++ b/survey/default.nix
-@@ -81,6 +81,7 @@ let
-   # `.override` and the likes).
-   isProperHaskellPackage = val:
-     lib.isDerivation val && # must pass lib.isDerivation
-+    val.pname != "ghc-bignum" &&
-     val ? env; # must have an .env key
- 
-   # Function that tells us if a given Haskell package has an executable.

nix/patches/static-haskell-nix-ncurses.patch

@@ -1,13 +0,0 @@
-diff --git a/survey/default.nix b/survey/default.nix
-index 46d8066..a47f214 100644
---- a/survey/default.nix
-+++ b/survey/default.nix
-@@ -1519,7 +1519,7 @@ let
-                   [
-                     "--enable-executable-static" # requires `useFixedCabal`
-                     # `enableShared` seems to be required to avoid `recompile with -fPIC` errors on some packages.
--                    "--extra-lib-dirs=${final.ncurses.override { enableStatic = true; enableShared = true; }}/lib"
-+                    "--extra-lib-dirs=${final.ncurses.override { enableStatic = true; }}/lib"
-                   ]
-                   # TODO Figure out why this and the below libffi are necessary.
-                   #      `working` and `workingStackageExecutables` don't seem to need that,

nix/static-haskell-package.nix

@@ -1,5 +1,5 @@
 # Derive a fully static Haskell package based on musl instead of glibc.
-{ nixpkgs, system, compiler, patches, allOverlays }:
+{ nixpkgs, compiler, patches, allOverlays }:
 
 name: src:
 let
@@ -17,8 +17,14 @@ let
     patches.applyPatches "patched-static-haskell-nix"
       static-haskell-nix
       [
-        patches.static-haskell-nix-ncurses
+        # No patches currently required.
-        patches.static-haskell-nix-ghc-bignum
+      ];
+
+  patchedNixpkgs =
+    patches.applyPatches "patched-nixpkgs"
+      nixpkgs
+      [
+        patches.nixpkgs-openssl-split-runtime-dependencies-of-static-builds
       ];
 
   extraOverrides =
@@ -44,13 +50,13 @@ let
       )
     ];
 
-  # Apply our overlay to nixpkgs.
+  # Apply our overlay to the given pkgs.
   normalPkgs =
-    import nixpkgs { inherit overlays system; };
+    import patchedNixpkgs { inherit overlays; };
 
   defaultCabalPackageVersionComingWithGhc =
     {
-      ghc924 = "Cabal_3_6_3_0";
+      ghc8107 = "Cabal_3_2_1_0";
     }."${compiler}";
 
   # The static-haskell-nix 'survey' derives a full static set of Haskell

nix/tools/cabalTools.nix

@@ -28,8 +28,6 @@ let
       ''
         # clean old coverage data, too
         rm -rf .hpc coverage
-        # clean old hie files
-        find . -name "*.hie" -type f -delete
         exec ${cabal-install}/bin/cabal v2-clean
       '';
 

nix/tools/devTools.nix

@@ -138,7 +138,7 @@ let
           # to the hook file.
           sed -i -e '/postgrest-git-hooks/d' .git/hooks/pre-{commit,push} 2> /dev/null || true
 
-          if [ disable != "$_arg_operation" ]; then
+          if [ disabled != "$_arg_mode" ]; then
             # The nix-shell && + nix-shell || pattern makes sure we can run the hook
             # in a pure nix-shell, where nix-shell itself is not available, too.
 
@@ -165,17 +165,6 @@ let
           # The following unsets all GIT_ variables.
           unset "''${!GIT_@}"
 
-          function restore () {
-            ref="$(git stash list --format=format:%gD --grep "$1" -n1)"
-            # this will avoid merge conflicts when applying the stash
-            ${git}/bin/git restore --source="$ref" .
-            # restore untracked files, too. could fail with no files
-            if [ "$(git show --numstat --format=oneline "$ref^3" | wc -l)" -gt 1 ]; then
-              ${git}/bin/git restore --overlay --source="$ref^3" .
-            fi
-            ${git}/bin/git stash drop "$ref"
-          }
-
           case "$_arg_mode" in
             basic)
               case "$_arg_hook" in
@@ -190,7 +179,7 @@ let
                   if [ "$(git stash list --grep $stash)" ]; then
                     # Only create the stash pop trap, if we actually created a stash.
                     # Otherwise stash pop will cause havoc.
-                    trap 'restore "$stash"' EXIT
+                    trap '${git}/bin/git stash pop $(git stash list --format=format:%gD --grep "$stash" -n1)' EXIT
                   fi
 
                   ${style}/bin/postgrest-style
@@ -215,7 +204,7 @@ let
                   if [ "$(git stash list --grep $stash)" ]; then
                     # Only create the stash pop trap, if we actually created a stash.
                     # Otherwise stash pop will cause havoc.
-                    trap 'restore "$stash"' EXIT
+                    trap '${git}/bin/git stash pop $(git stash list --format=format:%gD --grep "$stash" -n1)' EXIT
                   fi
 
                   ${style}/bin/postgrest-style

nix/tools/loadtest.nix

@@ -45,11 +45,6 @@ let
         inRootDir = true;
       }
       ''
-        # previously required settings to make this work with older branches
-        export PGRST_DB_ANON_ROLE="postgrest_test_anonymous"
-        export PGRST_DB_URI="postgresql://"
-        export PGRST_DB_SCHEMAS="test"
-
         export PGRST_DB_CONFIG="false"
         export PGRST_DB_POOL="1"
         export PGRST_DB_TX_END="rollback-allow-override"
@@ -60,8 +55,9 @@ let
         # shellcheck disable=SC2145
         ${withTools.withPg} --fixtures "$_arg_testdir"/fixtures.sql \
         ${withTools.withPgrst} \
-        sh -c "cd \"$_arg_testdir\" && ${runner} -targets targets.http -output \"$_arg_output\" \"''${_arg_leftovers[@]}\""
+        sh -c "cd \"$_arg_testdir\" && ${runner} -targets targets.http \"''${_arg_leftovers[@]}\"" \
-        ${vegeta}/bin/vegeta report -type=text "$_arg_output"
+          | tee "$_arg_output" \
+          | ${vegeta}/bin/vegeta report -type=text
       '';
 
   loadtestAgainst =

nix/tools/release/default.nix

@@ -46,82 +46,9 @@ let
           --data-urlencode description@${description} \
           --data-urlencode full_description@${fullDescription}
       '';
-
-  release =
-    checkedShellScript
-      {
-        name = "postgrest-release";
-        docs = "Patch postgrest.cabal, tag and push all in one go.";
-        args = [ "ARG_POSITIONAL_SINGLE([version], [Version to release], [pre])" ];
-        inRootDir = true;
-      }
-      ''
-        trap "echo You need to be on the main branch to proceed. Exiting ..." ERR
-        [ "$(git rev-parse --abbrev-ref HEAD)" == "main" ]
-        trap "" ERR
-
-        trap "echo You have uncommitted changes in postgrest.cabal. Exiting ..." ERR
-        git diff --exit-code HEAD postgrest.cabal > /dev/null
-        trap "" ERR
-
-        current_version="$(grep -oP '^version:\s*\K.*' postgrest.cabal)"
-        # shellcheck disable=SC2034
-        IFS=. read -r major minor patch pre <<< "$current_version"
-        echo "Current version is $current_version"
-
-        bump_pre="$major.$minor.$patch.$(date '+%Y%m%d')"
-        bump_patch="$major.$minor.$((patch+1))"
-        bump_minor="$major.$((minor+1)).0"
-        bump_major="$((major+1)).0.0"
-
-        PS3="Please select the new version: "
-        select new_version in "$bump_pre" "$bump_patch" "$bump_minor" "$bump_major"; do
-          case "$REPLY" in
-            1|2|3|4)
-              echo "Selected $new_version"
-              break
-              ;;
-            *)
-            echo "Invalid option $REPLY"
-            ;;
-          esac
-        done
-
-        echo "Updating postgrest.cabal ..."
-        sed -i -E "s/^(version:\s+).*$/\1$new_version/" postgrest.cabal > /dev/null
-
-        echo "Committing ..."
-        git add postgrest.cabal > /dev/null
-        git commit -m "bump version to $new_version" > /dev/null
-
-        echo "Tagging ..."
-        git tag "v$new_version" > /dev/null
-
-        trap "Couldn't find remote. Please push manually ..." ERR
-        remote="$(git remote -v | grep PostgREST/postgrest | grep push | cut -f1)"
-        trap "" ERR
-
-        push="git push --atomic $remote main v$new_version"
-
-        echo "To push both the branch and the new tag, the following will be run:"
-        echo
-        echo "$push"
-        echo
-        
-        read -r -p 'Proceed? (y/N) ' REPLY
-        case "$REPLY" in 
-          y|Y)
-            $push
-            ;;
-          *)
-            echo "Aborting ..."
-            ;;
-        esac
-      '';
-
 in
 buildToolbox
 {
   name = "postgrest-release";
-  tools = [ dockerHubDescription release ];
+  tools = [ dockerHubDescription ];
 }

nix/tools/release/docker-hub-full-description.md

@@ -55,7 +55,7 @@ write from scratch.
 # Usage
 
 To learn how to use this container, see the [PostgREST Docker
-documentation](https://postgrest.org/en/stable/install.html#docker).
+documentation](https://postgrest.com/en/stable/install.html#docker).
 
 You can configure the PostgREST image by setting
 [enviroment variables](https://postgrest.org/en/stable/configuration.html).
@@ -66,5 +66,5 @@ The image is built from scratch using
 [Nix](https://nixos.org/nixpkgs/manual/#sec-pkgs-dockerTools) instead of a
 `Dockerfile`, which yields a higly secure and optimized image. This is also why
 no commands are listed in the image history. See the [PostgREST
-respository](https://github.com/PostgREST/postgrest/tree/main/nix/tools/docker) for
+respository](https://github.com/PostgREST/postgrest/tree/main/nix/docker) for
 details on the build process and how to inspect the image.

nix/tools/style.nix

@@ -46,7 +46,7 @@ let
 
         trap "echo postgrest-style-check failed. Run postgrest-style to fix issues automatically." ERR
 
-        ${git}/bin/git diff-index --exit-code HEAD -- '*.hs' '*.lhs' '*.nix' '*.py'
+        ${git}/bin/git diff-index --exit-code HEAD -- '*.hs' '*.lhs' '*.nix'
       '';
 
   lint =
@@ -69,7 +69,8 @@ let
         echo "Linting bash scripts..."
         ${shellcheck}/bin/shellcheck \
           .github/get_cirrusci_freebsd \
-          .github/release
+          .github/release \
+          test/with_tmp_db
 
         echo "Linting workflows..."
         ${actionlint}/bin/actionlint

nix/tools/tests.nix

@@ -3,17 +3,14 @@
 , checkedShellScript
 , devCabalOptions
 , ghc
-, glibcLocales ? null
+, glibcLocales
 , gnugrep
+, haskellPackages
 , hpc-codecov
-, hostPlatform
 , jq
-, lib
 , postgrest
 , python3
 , runtimeShell
-, stdenv
-, weeder
 , withTools
 , yq
 }:
@@ -22,14 +19,12 @@ let
     checkedShellScript
       {
         name = "postgrest-test-spec";
-        docs = "Run the Haskell test suite. Use --match PATTERN for running individual specs";
+        docs = "Run the Haskell test suite";
-        args = [ "ARG_LEFTOVERS([hspec arguments])" ];
         inRootDir = true;
         withEnv = postgrest.env;
       }
       ''
-        ${withTools.withPg} ${cabal-install}/bin/cabal v2-run ${devCabalOptions} \
+        ${withTools.withPg} ${cabal-install}/bin/cabal v2-run ${devCabalOptions} test:spec
-          test:spec -- "''${_arg_leftovers[@]}"
       '';
 
   testQuerycost =
@@ -90,7 +85,7 @@ let
     checkedShellScript
       {
         name = "postgrest-test-io";
-        docs = "Run the pytest-based IO tests. Add -k to run tests that match a given expression.";
+        docs = "Run the pytest-based IO tests.";
         args = [ "ARG_LEFTOVERS([pytest arguments])" ];
         inRootDir = true;
         withEnv = postgrest.env;
@@ -128,72 +123,64 @@ let
         withEnv = postgrest.env;
         withTmpDir = true;
       }
-      (
+      ''
-        # required for `hpc markup` in CI; glibcLocales is not available e.g. on Darwin
+        export LOCALE_ARCHIVE="${glibcLocales}/lib/locale/locale-archive"
-        lib.optionalString (stdenv.isLinux && hostPlatform.libc == "glibc") ''
-          export LOCALE_ARCHIVE="${glibcLocales}/lib/locale/locale-archive"
-        '' +
 
-        ''
+        # clean up previous coverage reports
-          # clean up previous coverage reports
+        mkdir -p coverage
-          mkdir -p coverage
+        rm -rf coverage/*
-          rm -rf coverage/*
 
-          # build once before running all the tests
+        # build once before running all the tests
-          ${cabal-install}/bin/cabal v2-build ${devCabalOptions} exe:postgrest lib:postgrest test:spec test:querycost
+        ${cabal-install}/bin/cabal v2-build ${devCabalOptions} exe:postgrest lib:postgrest test:spec test:querycost
 
-          (
+        ${haskellPackages.weeder}/bin/weeder --config=./test/weeder.dhall || echo Found dead code: Check file list above.
-            trap 'echo Found dead code: Check file list above.' ERR ;
-            ${weeder}/bin/weeder --config=./test/weeder.dhall
-          )
 
-          # collect all tests
+        # collect all tests
-          HPCTIXFILE="$tmpdir"/io.tix \
+        HPCTIXFILE="$tmpdir"/io.tix \
-            ${withTools.withPg} -f test/io/fixtures.sql ${cabal-install}/bin/cabal v2-exec ${devCabalOptions} -- \
+          ${withTools.withPg} -f test/io/fixtures.sql ${cabal-install}/bin/cabal v2-exec ${devCabalOptions} -- \
-            ${ioTestPython}/bin/pytest -v test/io
+          ${ioTestPython}/bin/pytest -v test/io
+          
+        HPCTIXFILE="$tmpdir"/spec.tix \
+          ${withTools.withPg} ${cabal-install}/bin/cabal v2-run ${devCabalOptions} test:spec
 
-          HPCTIXFILE="$tmpdir"/spec.tix \
+        HPCTIXFILE="$tmpdir"/querycost.tix \
-            ${withTools.withPg} ${cabal-install}/bin/cabal v2-run ${devCabalOptions} test:spec
+          ${withTools.withPg} ${cabal-install}/bin/cabal v2-run ${devCabalOptions} test:querycost
 
-          HPCTIXFILE="$tmpdir"/querycost.tix \
+        # Note: No coverage for doctests, as doctests leverage GHCi and GHCi does not support hpc
-            ${withTools.withPg} ${cabal-install}/bin/cabal v2-run ${devCabalOptions} test:querycost
 
-          # Note: No coverage for doctests, as doctests leverage GHCi and GHCi does not support hpc
+        # collect all the tix files
+        ${ghc}/bin/hpc sum  --union --exclude=Paths_postgrest --output="$tmpdir"/tests.tix \
+          "$tmpdir"/io*.tix "$tmpdir"/spec.tix "$tmpdir"/querycost.tix
 
-          # collect all the tix files
+        # prepare the overlay
-          ${ghc}/bin/hpc sum  --union --exclude=Paths_postgrest --output="$tmpdir"/tests.tix \
+        ${ghc}/bin/hpc overlay --output="$tmpdir"/overlay.tix test/coverage.overlay
-            "$tmpdir"/io*.tix "$tmpdir"/spec.tix "$tmpdir"/querycost.tix
+        ${ghc}/bin/hpc sum --union --output="$tmpdir"/tests-overlay.tix "$tmpdir"/tests.tix "$tmpdir"/overlay.tix
 
-          # prepare the overlay
+        # check nothing in the overlay is actually tested
-          ${ghc}/bin/hpc overlay --output="$tmpdir"/overlay.tix test/coverage.overlay
+        ${ghc}/bin/hpc map --function=inv --output="$tmpdir"/inverted.tix "$tmpdir"/tests.tix
-          ${ghc}/bin/hpc sum --union --output="$tmpdir"/tests-overlay.tix "$tmpdir"/tests.tix "$tmpdir"/overlay.tix
+        ${ghc}/bin/hpc combine --function=sub \
+          --output="$tmpdir"/check.tix "$tmpdir"/overlay.tix "$tmpdir"/inverted.tix
+        # returns zero exit code if any count="<non-zero>" lines are found, i.e.
+        # something is covered by both the overlay and the tests
+        if ${ghc}/bin/hpc report --xml "$tmpdir"/check.tix | ${gnugrep}/bin/grep -qP 'count="[^0]'
+        then
+          ${ghc}/bin/hpc markup --highlight-covered --destdir=coverage/overlay "$tmpdir"/overlay.tix || true
+          ${ghc}/bin/hpc markup --highlight-covered --destdir=coverage/check "$tmpdir"/check.tix || true
+          echo "ERROR: Something is covered by both the tests and the overlay:"
+          echo "file://$(pwd)/coverage/check/hpc_index.html"
+          exit 1
+        else
+          # copy the result .tix file to the coverage/ dir to make it available to postgrest-coverage-draft-overlay, too
+          cp "$tmpdir"/tests-overlay.tix coverage/postgrest.tix
+          # prepare codecov json report
+          ${hpc-codecov}/bin/hpc-codecov --mix=.hpc --out=coverage/codecov.json coverage/postgrest.tix
 
-          # check nothing in the overlay is actually tested
+          # create html and stdout reports
-          ${ghc}/bin/hpc map --function=inv --output="$tmpdir"/inverted.tix "$tmpdir"/tests.tix
+          ${ghc}/bin/hpc markup --destdir=coverage coverage/postgrest.tix
-          ${ghc}/bin/hpc combine --function=sub \
+          echo "file://$(pwd)/coverage/hpc_index.html"
-            --output="$tmpdir"/check.tix "$tmpdir"/overlay.tix "$tmpdir"/inverted.tix
+          ${ghc}/bin/hpc report coverage/postgrest.tix "''${_arg_leftovers[@]}"
-          # returns zero exit code if any count="<non-zero>" lines are found, i.e.
+        fi
-          # something is covered by both the overlay and the tests
+      '';
-          if ${ghc}/bin/hpc report --xml "$tmpdir"/check.tix | ${gnugrep}/bin/grep -qP 'count="[^0]'
-          then
-            ${ghc}/bin/hpc markup --highlight-covered --destdir=coverage/overlay "$tmpdir"/overlay.tix || true
-            ${ghc}/bin/hpc markup --highlight-covered --destdir=coverage/check "$tmpdir"/check.tix || true
-            echo "ERROR: Something is covered by both the tests and the overlay:"
-            echo "file://$(pwd)/coverage/check/hpc_index.html"
-            exit 1
-          else
-            # copy the result .tix file to the coverage/ dir to make it available to postgrest-coverage-draft-overlay, too
-            cp "$tmpdir"/tests-overlay.tix coverage/postgrest.tix
-            # prepare codecov json report
-            ${hpc-codecov}/bin/hpc-codecov --mix=.hpc --out=coverage/codecov.json coverage/postgrest.tix
-
-            # create html and stdout reports
-            ${ghc}/bin/hpc markup --destdir=coverage coverage/postgrest.tix
-            echo "file://$(pwd)/coverage/hpc_index.html"
-            ${ghc}/bin/hpc report coverage/postgrest.tix "''${_arg_leftovers[@]}"
-          fi
-        ''
-      );
 
   coverageDraftOverlay =
     checkedShellScript
@@ -207,26 +194,6 @@ let
         sed -i 's|^module \(.*\):|module \1/|g' test/coverage.overlay
       '';
 
-  checkStatic =
-    checkedShellScript
-      {
-        name = "postgrest-check-static";
-        docs = "Verify that the argument is a static executable.";
-        args = [ "ARG_POSITIONAL_SINGLE([executable], [Executable])" ];
-        inRootDir = true;
-        withEnv = postgrest.env;
-      }
-      ''
-        exe="$_arg_executable"
-        ldd_output=$(ldd "$exe" 2>&1 || true)
-        if ! grep -q "not a dynamic executable" <<< "$ldd_output"; then
-          echo "not a static executable, ldd output:"
-          echo "$ldd_output"
-          exit 1
-        fi
-        "$exe" --help
-      '';
-
 in
 buildToolbox
 {
@@ -241,6 +208,5 @@ buildToolbox
       dumpSchema
       coverage
       coverageDraftOverlay
-      checkStatic
     ];
 }

nix/tools/withTools.nix

@@ -1,4 +1,4 @@
-{ bash-completion
+{ bashCompletion
 , buildToolbox
 , cabal-install
 , checkedShellScript
@@ -25,6 +25,7 @@ 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([PGRST_DB_ANON_ROLE], [postgrest_test_anonymous], [Anonymous PG role])"
           ];
         positionalCompletion = "_command";
         inRootDir = true;
@@ -34,7 +35,7 @@ let
       }
       ''
         # avoid starting multiple layers of withTmpDb
-        if test -v PGHOST; then
+        if test -v PGRST_DB_URI; then
           exec "$_arg_command" "''${_arg_leftovers[@]}"
         fi
 
@@ -52,7 +53,9 @@ let
         export PGHOST="$tmpdir/socket"
         export PGUSER
         export PGDATABASE
+        export PGRST_DB_URI="postgresql:///$PGDATABASE?host=$PGHOST&user=$PGUSER"
         export PGRST_DB_SCHEMAS
+        export PGRST_DB_ANON_ROLE
 
         log "Initializing database cluster..."
         # We try to make the database cluster as independent as possible from the host
@@ -62,7 +65,7 @@ let
 
         log "Starting the database cluster..."
         # Instead of listening on a local port, we will listen on a unix domain socket.
-        pg_ctl -l "$tmpdir/db.log" -w start -o "-F -c listen_addresses=\"\" -k $PGHOST -c log_statement=\"all\"" \
+        pg_ctl -l "$tmpdir/db.log" -w start -o "-F -c listen_addresses=\"\" -k $PGHOST" \
           >> "$setuplog"
 
         stop () {
@@ -244,29 +247,19 @@ let
       ''
         export PGRST_SERVER_UNIX_SOCKET="$tmpdir"/postgrest.socket
 
-        rm -f result
+        ${cabal-install}/bin/cabal v2-build ${devCabalOptions} > "$tmpdir"/build.log 2>&1
-        echo -n "Building postgrest... "
+        ${cabal-install}/bin/cabal v2-run ${devCabalOptions} --verbose=0 -- \
-        nix-build -A postgrestPackage > "$tmpdir"/build.log 2>&1 || {
+          postgrest ${legacyConfig} > "$tmpdir"/run.log 2>&1 &
-          echo "failed, output:"
-          cat "$tmpdir"/build.log
-          exit 1
-        }
-        echo "done."
 
-        echo -n "Starting postgrest... "
+        # to get the pid of the postgrest process, we need to jump through some hoops
-        ./result/bin/postgrest ${legacyConfig} > "$tmpdir"/run.log 2>&1 &
+        # $! will return the pid of cabal - but killing this, will not propagate to postgrest
-        pid=$!
+        pid=$(timeout -s TERM 1 ${waitForPgrstPid})
         cleanup() {
           kill "$pid" || true
         }
         trap cleanup EXIT
 
-        timeout -s TERM 5 ${waitForPgrstReady} || {
+        timeout -s TERM 5 ${waitForPgrstReady}
-          echo "timed out, output:"
-          cat "$tmpdir"/run.log
-          exit 1
-        }
-        echo "done."
 
         ("$_arg_command" "''${_arg_leftovers[@]}")
       '';

postgrest.cabal

@@ -1,8 +1,8 @@
 name:               postgrest
-version:            10.0.0
+version:            9.0.1
 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
+                    for tables, views, and functions, supporting all HTTP verbs that security
                     permits.
 license:            MIT
 license-file:       LICENSE
@@ -35,7 +35,6 @@ library
                       NoImplicitPrelude
   hs-source-dirs:     src
   exposed-modules:    PostgREST.App
-                      PostgREST.Admin
                       PostgREST.AppState
                       PostgREST.Auth
                       PostgREST.CLI
@@ -44,6 +43,7 @@ library
                       PostgREST.Config.JSPath
                       PostgREST.Config.PgVersion
                       PostgREST.Config.Proxy
+                      PostgREST.ContentType
                       PostgREST.Cors
                       PostgREST.DbStructure
                       PostgREST.DbStructure.Identifiers
@@ -54,7 +54,6 @@ library
                       PostgREST.GucHeader
                       PostgREST.Logger
                       PostgREST.Middleware
-                      PostgREST.MediaType
                       PostgREST.OpenAPI
                       PostgREST.Query.QueryBuilder
                       PostgREST.Query.SqlFragment
@@ -62,21 +61,19 @@ library
                       PostgREST.RangeQuery
                       PostgREST.Request.ApiRequest
                       PostgREST.Request.DbRequestBuilder
-                      PostgREST.Request.MutateQuery
+                      PostgREST.Request.Parsers
                       PostgREST.Request.Preferences
-                      PostgREST.Request.QueryParams
-                      PostgREST.Request.ReadQuery
                       PostgREST.Request.Types
                       PostgREST.Version
                       PostgREST.Workers
   other-modules:      Paths_postgrest
-  build-depends:      base                      >= 4.9 && < 4.17
+  build-depends:      base                      >= 4.9 && < 4.16
                     , HTTP                      >= 4000.3.7 && < 4000.4
                     , Ranged-sets               >= 0.3 && < 0.5
-                    , aeson                     >= 2.0.3 && < 2.1
+                    , aeson                     >= 1.4.7 && < 1.6
                     , auto-update               >= 0.1.4 && < 0.2
                     , base64-bytestring         >= 1 && < 1.3
-                    , bytestring                >= 0.10.8 && < 0.12
+                    , bytestring                >= 0.10.8 && < 0.11
                     , case-insensitive          >= 1.2 && < 1.3
                     , cassava                   >= 0.4.5 && < 0.6
                     , configurator-pg           >= 0.2 && < 0.3
@@ -85,8 +82,8 @@ library
                     , cookie                    >= 0.4.2 && < 0.5
                     , either                    >= 4.4.1 && < 5.1
                     , gitrev                    >= 1.2 && < 1.4
-                    , hasql                     >= 1.4 && < 1.6
+                    , hasql                     >= 1.4 && < 1.5
-                    , hasql-dynamic-statements  >= 0.3.1 && < 0.4
+                    , hasql-dynamic-statements  == 0.3.1
                     , hasql-notifications       >= 0.1 && < 0.3
                     , hasql-pool                >= 0.5 && < 0.6
                     , hasql-transaction         >= 1.0.1 && < 1.1
@@ -94,11 +91,10 @@ library
                     , http-types                >= 0.12.2 && < 0.13
                     , insert-ordered-containers >= 0.2.2 && < 0.3
                     , interpolatedstring-perl6  >= 1 && < 1.1
-                    , jose                      >= 0.8.5.1 && < 0.10
+                    , jose                      >= 0.8.1 && < 0.9
-                    , lens                      >= 4.14 && < 5.2
+                    , lens                      >= 4.14 && < 5.1
                     , lens-aeson                >= 1.0.1 && < 1.2
                     , mtl                       >= 2.2.2 && < 2.3
-                    , network                   >= 2.6 && < 3.2
                     , network-uri               >= 2.6.1 && < 2.8
                     , optparse-applicative      >= 0.13 && < 0.17
                     , parsec                    >= 3.1.11 && < 3.2
@@ -106,20 +102,14 @@ library
                     , regex-tdfa                >= 1.2.2 && < 1.4
                     , retry                     >= 0.7.4 && < 0.10
                     , scientific                >= 0.3.4 && < 0.4
-                    , swagger2                  >= 2.4 && < 2.9
+                    , swagger2                  >= 2.4 && < 2.7
                     , text                      >= 1.2.2 && < 1.3
-                    , time                      >= 1.6 && < 1.12
+                    , time                      >= 1.6 && < 1.11
                     , unordered-containers      >= 0.2.8 && < 0.3
-                    , vault                     >= 0.3.1.5 && < 0.4
                     , vector                    >= 0.11 && < 0.13
                     , wai                       >= 3.2.1 && < 3.3
                     , wai-cors                  >= 0.2.5 && < 0.3
                     , wai-extra                 >= 3.1.8 && < 3.2
-                    -- We already depend on wai-logger >= 2.3.7 indirectly via wai-extra,
-                    -- but we want to depend on 2.4.0 which fixes 'unknownSocket' log output
-                    -- for unix sockets; this is tested in test/io/test_io.py. See
-                    -- https://github.com/kazu-yamamoto/logger/commit/3a71ca70afdbb93d4ecf0083eeba1fbbbcab3fc3
-                    , wai-logger                >= 2.4.0
                     , warp                      >= 3.3.19 && < 3.4
                       -- -fno-spec-constr may help keep compile time memory use in check,
                       --   see https://gitlab.haskell.org/ghc/ghc/issues/16017#note_219304
@@ -140,6 +130,7 @@ library
     build-depends:
       unix
       , directory >= 1.2.6 && < 1.4
+      , network   >= 2.6 && < 3.2
     exposed-modules:
       PostgREST.Unix
 
@@ -149,7 +140,7 @@ executable postgrest
                       NoImplicitPrelude
   hs-source-dirs:     main
   main-is:            Main.hs
-  build-depends:      base                >= 4.9 && < 4.17
+  build-depends:      base                >= 4.9 && < 4.16
                     , containers          >= 0.5.7 && < 0.7
                     , postgrest
                     , protolude           >= 0.3.1 && < 0.4
@@ -174,56 +165,50 @@ test-suite spec
                       NoImplicitPrelude
   hs-source-dirs:     test/spec
   main-is:            Main.hs
-  other-modules:      Feature.Auth.AsymmetricJwtSpec
+  other-modules:      Feature.AndOrParamsSpec
-                      Feature.Auth.AudienceJwtSecretSpec
+                      Feature.AsymmetricJwtSpec
-                      Feature.Auth.AuthSpec
+                      Feature.AudienceJwtSecretSpec
-                      Feature.Auth.BinaryJwtSecretSpec
+                      Feature.AuthSpec
-                      Feature.Auth.NoAnonSpec
+                      Feature.BinaryJwtSecretSpec
-                      Feature.Auth.NoJwtSpec
                       Feature.ConcurrentSpec
                       Feature.CorsSpec
+                      Feature.DeleteSpec
+                      Feature.DisabledOpenApiSpec
+                      Feature.EmbedDisambiguationSpec
+                      Feature.EmbedInnerJoinSpec
                       Feature.ExtraSearchPathSpec
+                      Feature.HtmlRawOutputSpec
+                      Feature.InsertSpec
+                      Feature.IgnorePrivOpenApiSpec
+                      Feature.JsonOperatorSpec
                       Feature.LegacyGucsSpec
-                      Feature.OpenApi.DisabledOpenApiSpec
+                      Feature.MultipleSchemaSpec
-                      Feature.OpenApi.IgnorePrivOpenApiSpec
+                      Feature.NoJwtSpec
-                      Feature.OpenApi.OpenApiSpec
+                      Feature.NonexistentSchemaSpec
-                      Feature.OpenApi.ProxySpec
+                      Feature.OpenApiSpec
-                      Feature.OpenApi.RootSpec
-                      Feature.OpenApi.SecurityOpenApiSpec
                       Feature.OptionsSpec
-                      Feature.Query.AndOrParamsSpec
+                      Feature.ProxySpec
-                      Feature.Query.ComputedRelsSpec
+                      Feature.QueryLimitedSpec
-                      Feature.Query.DeleteSpec
+                      Feature.QuerySpec
-                      Feature.Query.EmbedDisambiguationSpec
+                      Feature.RangeSpec
-                      Feature.Query.EmbedInnerJoinSpec
+                      Feature.RawOutputTypesSpec
-                      Feature.Query.PlanSpec
-                      Feature.Query.HtmlRawOutputSpec
-                      Feature.Query.InsertSpec
-                      Feature.Query.JsonOperatorSpec
-                      Feature.Query.MultipleSchemaSpec
-                      Feature.Query.ErrorSpec
-                      Feature.Query.PgSafeUpdateSpec
-                      Feature.Query.PostGISSpec
-                      Feature.Query.QueryLimitedSpec
-                      Feature.Query.QuerySpec
-                      Feature.Query.RangeSpec
-                      Feature.Query.RawOutputTypesSpec
-                      Feature.Query.RpcSpec
-                      Feature.Query.SingularSpec
-                      Feature.Query.UnicodeSpec
-                      Feature.Query.UpdateSpec
-                      Feature.Query.UpsertSpec
                       Feature.RollbackSpec
+                      Feature.RootSpec
                       Feature.RpcPreRequestGucsSpec
+                      Feature.RpcSpec
+                      Feature.SingularSpec
+                      Feature.UnicodeSpec
+                      Feature.UpdateSpec
+                      Feature.UpsertSpec
                       SpecHelper
                       TestTypes
-  build-depends:      base              >= 4.9 && < 4.17
+  build-depends:      base              >= 4.9 && < 4.16
-                    , aeson             >= 2.0.3 && < 2.1
+                    , aeson             >= 1.4.7 && < 1.6
                     , aeson-qq          >= 0.8.1 && < 0.9
                     , async             >= 2.1.1 && < 2.3
                     , auto-update       >= 0.1.4 && < 0.2
                     , base64-bytestring >= 1 && < 1.3
-                    , bytestring        >= 0.10.8 && < 0.12
+                    , bytestring        >= 0.10.8 && < 0.11
                     , case-insensitive  >= 1.2 && < 1.3
                     , containers        >= 0.5.7 && < 0.7
                     , hasql-pool        >= 0.5 && < 0.6
@@ -233,7 +218,7 @@ test-suite spec
                     , hspec-wai         >= 0.10 && < 0.12
                     , hspec-wai-json    >= 0.10 && < 0.12
                     , http-types        >= 0.12.3 && < 0.13
-                    , lens              >= 4.14 && < 5.2
+                    , lens              >= 4.14 && < 5.1
                     , lens-aeson        >= 1.0.1 && < 1.2
                     , monad-control     >= 1.0.1 && < 1.1
                     , postgrest
@@ -260,23 +245,22 @@ test-suite querycost
   hs-source-dirs:     test/spec
   main-is:            QueryCost.hs
   other-modules:      SpecHelper
-  build-depends:      base              >= 4.9 && < 4.17
+  build-depends:      base              >= 4.9 && < 4.16
-                    , aeson             >= 2.0.3 && < 2.1
+                    , aeson             >= 1.4.7 && < 1.6
                     , base64-bytestring >= 1 && < 1.3
-                    , bytestring        >= 0.10.8 && < 0.12
+                    , bytestring        >= 0.10.8 && < 0.11
                     , case-insensitive  >= 1.2 && < 1.3
                     , containers        >= 0.5.7 && < 0.7
                     , contravariant     >= 1.4 && < 1.6
-                    , hasql             >= 1.4 && < 1.6
+                    , hasql             >= 1.4 && < 1.5
-                    , hasql-dynamic-statements >= 0.3.1 && < 0.4
+                    , hasql-dynamic-statements  == 0.3.1
                     , hasql-pool        >= 0.5 && < 0.6
                     , hasql-transaction >= 1.0.1 && < 1.1
                     , heredoc           >= 0.2 && < 0.3
                     , hspec             >= 2.3 && < 2.9
                     , hspec-wai         >= 0.10 && < 0.12
-                    , hspec-wai-json    >= 0.10 && < 0.12
                     , http-types        >= 0.12.3 && < 0.13
-                    , lens              >= 4.14 && < 5.2
+                    , lens              >= 4.14 && < 5.1
                     , lens-aeson        >= 1.0.1 && < 1.2
                     , postgrest
                     , process           >= 1.4.2 && < 1.7
@@ -296,7 +280,7 @@ test-suite doctests
                       NoImplicitPrelude
   hs-source-dirs:     test/doc
   main-is:            Main.hs
-  build-depends:      base              >= 4.9 && < 4.17
+  build-depends:      base              >= 4.9 && < 4.16
                     , doctest           >= 0.8
                     , postgrest
                     , pretty-simple

shell.nix

@@ -11,7 +11,7 @@
 }:
 let
   postgrest =
-    import ./default.nix { };
+    import ./default.nix;
 
   inherit (postgrest) pkgs;
 
@@ -46,16 +46,14 @@ lib.overrideDerivation postgrest.env (
 
     shellHook =
       ''
-        export HISTFILE=.history
+        source ${pkgs.bashCompletion}/etc/profile.d/bash_completion.sh
-
-        source ${pkgs.bash-completion}/etc/profile.d/bash_completion.sh
         source ${pkgs.git}/share/git/contrib/completion/git-completion.bash
-        source ${postgrest.hsie.bash-completion}
+        source ${postgrest.hsie.bashCompletion}
 
       ''
       + builtins.concatStringsSep "\n" (
-        builtins.map (bash-completion: "source ${bash-completion}") (
+        builtins.map (bashCompletion: "source ${bashCompletion}") (
-          builtins.concatLists (builtins.map (toolbox: toolbox.bash-completion) toolboxes)
+          builtins.concatLists (builtins.map (toolbox: toolbox.bashCompletion) toolboxes)
         )
       );
   }

src/PostgREST/Admin.hs

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

src/PostgREST/App.hs

@@ -20,17 +20,18 @@ module PostgREST.App
 import Control.Monad.Except     (liftEither)
 import Data.Either.Combinators  (mapLeft)
 import Data.List                (union)
-import Data.Maybe               (fromJust)
 import Data.String              (IsString (..))
+import Data.Time.Clock          (UTCTime)
 import Network.Wai.Handler.Warp (defaultSettings, setHost, setPort,
                                  setServerName)
 import System.Posix.Types       (FileMode)
 
 import qualified Data.ByteString.Char8           as BS
 import qualified Data.ByteString.Lazy            as LBS
-import qualified Data.HashMap.Strict             as HM
+import qualified Data.HashMap.Strict             as M
 import qualified Data.Set                        as S
-import qualified Hasql.DynamicStatements.Snippet as SQL (Snippet)
+import qualified Hasql.DynamicStatements.Snippet as SQL
+import qualified Hasql.Pool                      as SQL
 import qualified Hasql.Transaction               as SQL
 import qualified Hasql.Transaction.Sessions      as SQL
 import qualified Network.HTTP.Types.Header       as HTTP
@@ -39,7 +40,6 @@ import qualified Network.HTTP.Types.URI          as HTTP
 import qualified Network.Wai                     as Wai
 import qualified Network.Wai.Handler.Warp        as Warp
 
-import qualified PostgREST.Admin                    as Admin
 import qualified PostgREST.AppState                 as AppState
 import qualified PostgREST.Auth                     as Auth
 import qualified PostgREST.Cors                     as Cors
@@ -53,15 +53,15 @@ import qualified PostgREST.Query.Statements         as Statements
 import qualified PostgREST.RangeQuery               as RangeQuery
 import qualified PostgREST.Request.ApiRequest       as ApiRequest
 import qualified PostgREST.Request.DbRequestBuilder as ReqBuilder
-import qualified PostgREST.Request.Types            as ApiRequestTypes
 
 import PostgREST.AppState                (AppState)
-import PostgREST.Auth                    (AuthResult (..))
 import PostgREST.Config                  (AppConfig (..),
                                           LogLevel (..),
                                           OpenAPIMode (..))
 import PostgREST.Config.PgVersion        (PgVersion (..))
-import PostgREST.DbStructure             (DbStructure (..))
+import PostgREST.ContentType             (ContentType (..))
+import PostgREST.DbStructure             (DbStructure (..),
+                                          tablePKCols)
 import PostgREST.DbStructure.Identifiers (FieldName,
                                           QualifiedIdentifier (..),
                                           Schema)
@@ -72,27 +72,24 @@ import PostgREST.Error                   (Error)
 import PostgREST.GucHeader               (GucHeader,
                                           addHeadersIfNotIncluded,
                                           unwrapGucHeader)
-import PostgREST.MediaType               (MTPlanAttrs (..),
-                                          MediaType (..))
-import PostgREST.Query.Statements        (ResultSet (..))
 import PostgREST.Request.ApiRequest      (Action (..),
                                           ApiRequest (..),
                                           InvokeMethod (..),
-                                          Mutation (..), Target (..))
+                                          Target (..))
 import PostgREST.Request.Preferences     (PreferCount (..),
                                           PreferParameters (..),
                                           PreferRepresentation (..),
                                           toAppliedHeader)
-import PostgREST.Request.QueryParams     (QueryParams (..))
+import PostgREST.Request.Types           (ReadRequest, fstFieldNames)
-import PostgREST.Request.ReadQuery       (ReadRequest, fstFieldNames)
 import PostgREST.Version                 (prettyVersion)
 import PostgREST.Workers                 (connectionWorker, listener)
 
+import qualified PostgREST.ContentType      as ContentType
 import qualified PostgREST.DbStructure.Proc as Proc
-import qualified PostgREST.MediaType        as MediaType
 
 import Protolude hiding (Handler)
 
+
 data RequestContext = RequestContext
   { ctxConfig      :: AppConfig
   , ctxDbStructure :: DbStructure
@@ -118,11 +115,6 @@ run installHandlers maybeRunWithSocket appState = do
   when configDbChannelEnabled $ listener appState
 
   let app = postgrest configLogLevel appState (connectionWorker appState)
-      adminApp = Admin.postgrestAdmin appState conf
-
-  whenJust configAdminServerPort $ \adminPort -> do
-    AppState.logWithZTime appState $ "Admin server listening on port " <> show adminPort
-    void . forkIO $ Warp.runSettings (serverSettings conf & setPort adminPort) adminApp
 
   case configServerUnixSocket of
     Just socket ->
@@ -132,14 +124,11 @@ run installHandlers maybeRunWithSocket appState = do
           AppState.logWithZTime appState $ "Listening on unix socket " <> show socket
           runWithSocket (serverSettings conf) app configServerUnixSocketMode socket
         Nothing ->
-          panic "Cannot run with unix socket on non-unix platforms."
+          panic "Cannot run with socket on non-unix plattforms."
     Nothing ->
       do
         AppState.logWithZTime appState $ "Listening on port " <> show configServerPort
         Warp.runSettings (serverSettings conf) app
-  where
-    whenJust :: Applicative m => Maybe a -> (a -> m ()) -> m ()
-    whenJust mg f = maybe (pure ()) f mg
 
 serverSettings :: AppConfig -> Warp.Settings
 serverSettings AppConfig{..} =
@@ -151,32 +140,28 @@ serverSettings AppConfig{..} =
 -- | PostgREST application
 postgrest :: LogLevel -> AppState.AppState -> IO () -> Wai.Application
 postgrest logLevel appState connWorker =
-  Cors.middleware .
+  Logger.middleware logLevel .
-  Auth.middleware appState .
+  Cors.middleware $
-  Logger.middleware logLevel $
+    \req respond -> do
-    -- fromJust can be used, because the auth middleware will **always** add
+      time <- AppState.getTime appState
-    -- some AuthResult to the vault.
+      conf <- AppState.getConfig appState
-    \req respond -> case fromJust $ Auth.getResult req of
+      maybeDbStructure <- AppState.getDbStructure appState
-      Left err -> respond $ Error.errorResponseFor err
+      pgVer <- AppState.getPgVersion appState
-      Right authResult -> do
+      jsonDbS <- AppState.getJsonDbS appState
-        conf <- AppState.getConfig appState
-        maybeDbStructure <- AppState.getDbStructure appState
-        pgVer <- AppState.getPgVersion appState
-        jsonDbS <- AppState.getJsonDbS appState
 
-        let
+      let
-          eitherResponse :: IO (Either Error Wai.Response)
+        eitherResponse :: IO (Either Error Wai.Response)
-          eitherResponse =
+        eitherResponse =
-            runExceptT $ postgrestResponse appState conf maybeDbStructure jsonDbS pgVer authResult req
+          runExceptT $ postgrestResponse conf maybeDbStructure jsonDbS pgVer (AppState.getPool appState) time req
 
-        response <- either Error.errorResponseFor identity <$> eitherResponse
+      response <- either Error.errorResponseFor identity <$> eitherResponse
-        -- Launch the connWorker when the connection is down.  The postgrest
+      -- Launch the connWorker when the connection is down.  The postgrest
-        -- function can respond successfully (with a stale schema cache) before
+      -- function can respond successfully (with a stale schema cache) before
-        -- the connWorker is done.
+      -- the connWorker is done.
-        let isPGAway = Wai.responseStatus response == HTTP.status503
+      let isPGAway = Wai.responseStatus response == HTTP.status503
-        when isPGAway connWorker
+      when isPGAway connWorker
-        resp <- addRetryHint isPGAway appState response
+      resp <- addRetryHint isPGAway appState response
-        respond resp
+      respond resp
 
 addRetryHint :: Bool -> AppState -> Wai.Response -> IO Wai.Response
 addRetryHint shouldAdd appState response = do
@@ -185,15 +170,15 @@ addRetryHint shouldAdd appState response = do
   return $ Wai.mapResponseHeaders (\hs -> if shouldAdd then h:hs else hs) response
 
 postgrestResponse
-  :: AppState.AppState
+  :: AppConfig
-  -> AppConfig
   -> Maybe DbStructure
   -> ByteString
   -> PgVersion
-  -> AuthResult
+  -> SQL.Pool
+  -> UTCTime
   -> Wai.Request
   -> Handler IO Wai.Response
-postgrestResponse appState conf@AppConfig{..} maybeDbStructure jsonDbS pgVer AuthResult{..} req = do
+postgrestResponse conf maybeDbStructure jsonDbS pgVer pool time req = do
   body <- lift $ Wai.strictRequestBody req
 
   dbStructure <-
@@ -201,30 +186,32 @@ postgrestResponse appState conf@AppConfig{..} maybeDbStructure jsonDbS pgVer Aut
       Just dbStructure ->
         return dbStructure
       Nothing ->
-        throwError Error.NoSchemaCacheError
+        throwError Error.ConnectionLostError
 
-  apiRequest <-
+  apiRequest@ApiRequest{..} <-
     liftEither . mapLeft Error.ApiRequestError $
       ApiRequest.userApiRequest conf dbStructure req body
 
-  let ctx apiReq = RequestContext conf dbStructure apiReq pgVer
+  -- The JWT must be checked before touching the db
+  jwtClaims <- Auth.jwtClaims conf (toUtf8Lazy iJWT) time
 
-  if iAction apiRequest == ActionInfo then
+  let
-    handleInfo (iTarget apiRequest) (ctx apiRequest)
+    handleReq apiReq =
-  else
+      handleRequest $ RequestContext conf dbStructure apiReq pgVer
-    runDbHandler appState (txMode apiRequest) (Just authRole /= configDbAnonRole) configDbPreparedStatements .
-      Middleware.optionalRollback conf apiRequest $
-        Middleware.runPgLocals conf authClaims authRole (handleRequest . ctx) apiRequest jsonDbS pgVer
 
-runDbHandler :: AppState.AppState -> SQL.Mode -> Bool -> Bool -> DbHandler b -> Handler IO b
+  runDbHandler pool (txMode apiRequest) jwtClaims (configDbPreparedStatements conf) .
-runDbHandler appState mode authenticated prepared handler = do
+    Middleware.optionalRollback conf apiRequest $
+      Middleware.runPgLocals conf jwtClaims handleReq apiRequest jsonDbS pgVer
+
+runDbHandler :: SQL.Pool -> SQL.Mode -> Auth.JWTClaims -> Bool -> DbHandler a -> Handler IO a
+runDbHandler pool mode jwtClaims prepared handler = do
   dbResp <-
     let transaction = if prepared then SQL.transaction else SQL.unpreparedTransaction in
-    lift . AppState.usePool appState . transaction SQL.ReadCommitted mode $ runExceptT handler
+    lift . SQL.use pool . transaction SQL.ReadCommitted mode $ runExceptT handler
 
   resp <-
     liftEither . mapLeft Error.PgErr $
-      mapLeft (Error.PgError authenticated) dbResp
+      mapLeft (Error.PgError $ Auth.containsRole jwtClaims) dbResp
 
   liftEither resp
 
@@ -233,22 +220,22 @@ handleRequest context@(RequestContext _ _ ApiRequest{..} _) =
   case (iAction, iTarget) of
     (ActionRead headersOnly, TargetIdent identifier) ->
       handleRead headersOnly identifier context
-    (ActionMutate MutationCreate, TargetIdent identifier) ->
+    (ActionCreate, TargetIdent identifier) ->
       handleCreate identifier context
-    (ActionMutate MutationUpdate, TargetIdent identifier) ->
+    (ActionUpdate, TargetIdent identifier) ->
       handleUpdate identifier context
-    (ActionMutate MutationSingleUpsert, TargetIdent identifier) ->
+    (ActionSingleUpsert, TargetIdent identifier) ->
       handleSingleUpsert identifier context
-    (ActionMutate MutationDelete, TargetIdent identifier) ->
+    (ActionDelete, TargetIdent identifier) ->
       handleDelete identifier context
+    (ActionInfo, TargetIdent identifier) ->
+      handleInfo identifier context
     (ActionInvoke invMethod, TargetProc proc _) ->
       handleInvoke invMethod proc context
     (ActionInspect headersOnly, TargetDefaultSpec tSchema) ->
       handleOpenApi headersOnly tSchema context
     _ ->
-      -- This is unreachable as the ApiRequest.hs rejects it before
+      throwError Error.NotFound
-      -- TODO Refactor the Action/Target types to remove this line
-      throwError $ Error.ApiRequestError ApiRequestTypes.NotFound
 
 handleRead :: Bool -> QualifiedIdentifier -> RequestContext -> DbHandler Wai.Response
 handleRead headersOnly identifier context@RequestContext{..} = do
@@ -260,9 +247,9 @@ handleRead headersOnly identifier context@RequestContext{..} = do
     AppConfig{..} = ctxConfig
     countQuery = QueryBuilder.readRequestToCountQuery req
 
-  resultSet <-
+  (tableTotal, queryTotal, _ , body, gucHeaders, gucStatus) <-
-     lift . SQL.statement mempty $
+    lift . SQL.statement mempty $
-      Statements.prepareRead
+      Statements.createReadStatement
         (QueryBuilder.readRequestToQuery req)
         (if iPreferCount == Just EstimatedCount then
            -- LIMIT maxRows + 1 so we can determine below that maxRows was surpassed
@@ -270,33 +257,29 @@ handleRead headersOnly identifier context@RequestContext{..} = do
          else
            countQuery
         )
+        (iAcceptContentType == CTSingularJSON)
         (shouldCount iPreferCount)
-        iAcceptMediaType
+        (iAcceptContentType == CTTextCSV)
         bField
         configDbPreparedStatements
 
-  case resultSet of
+  total <- readTotal ctxConfig ctxApiRequest tableTotal countQuery
-    RSStandard{..} -> do
+  response <- liftEither $ gucResponse <$> gucStatus <*> gucHeaders
-      total <- readTotal ctxConfig ctxApiRequest rsTableTotal countQuery
-      response <- liftEither $ gucResponse <$> rsGucStatus <*> rsGucHeaders
 
-      let
+  let
-        (status, contentRange) = RangeQuery.rangeStatusHeader iTopLevelRange rsQueryTotal total
+    (status, contentRange) = RangeQuery.rangeStatusHeader iTopLevelRange queryTotal total
-        headers =
+    headers =
-          [ contentRange
+      [ contentRange
-          , ( "Content-Location"
+      , ( "Content-Location"
-            , "/"
+        , "/"
-                <> toUtf8 (qiName identifier)
+            <> toUtf8 (qiName identifier)
-                <> if BS.null (qsCanonical iQueryParams) then mempty else "?" <> qsCanonical iQueryParams
+            <> if BS.null iCanonicalQS then mempty else "?" <> iCanonicalQS
-            )
+        )
-          ]
+      ]
-          ++ contentTypeHeaders context
+      ++ contentTypeHeaders context
 
-      failNotSingular iAcceptMediaType rsQueryTotal . response status headers $
+  failNotSingular iAcceptContentType queryTotal . response status headers $
-        if headersOnly then mempty else LBS.fromStrict rsBody
+    if headersOnly then mempty else LBS.fromStrict body
-
-    RSPlan plan ->
-      pure $ Wai.responseLBS HTTP.status200 (contentTypeHeaders context) $ LBS.fromStrict plan
 
 readTotal :: AppConfig -> ApiRequest -> Maybe Int64 -> SQL.Snippet -> DbHandler (Maybe Int64)
 readTotal AppConfig{..} ApiRequest{..} tableTotal countQuery =
@@ -312,159 +295,131 @@ readTotal AppConfig{..} ApiRequest{..} tableTotal countQuery =
       return tableTotal
   where
     explain =
-      lift . SQL.statement mempty . Statements.preparePlanRows countQuery $
+      lift . SQL.statement mempty . Statements.createExplainStatement countQuery $
         configDbPreparedStatements
 
 handleCreate :: QualifiedIdentifier -> RequestContext -> DbHandler Wai.Response
 handleCreate identifier@QualifiedIdentifier{..} context@RequestContext{..} = do
   let
     ApiRequest{..} = ctxApiRequest
-    pkCols = if iPreferRepresentation /= None || isJust iPreferResolution
+    pkCols = tablePKCols ctxDbStructure qiSchema qiName
-      then maybe mempty tablePKCols $ HM.lookup identifier $ dbTables ctxDbStructure
-      else mempty
 
-  resultSet <- writeQuery MutationCreate identifier True pkCols context
+  WriteQueryResult{..} <- writeQuery identifier True pkCols context
 
-  case resultSet of
+  let
-    RSStandard{..} -> do
+    response = gucResponse resGucStatus resGucHeaders
+    headers =
+      catMaybes
+        [ if null resFields then
+            Nothing
+          else
+            Just
+              ( HTTP.hLocation
+              , "/"
+                  <> toUtf8 qiName
+                  <> HTTP.renderSimpleQuery True (splitKeyValue <$> resFields)
+              )
+        , Just . RangeQuery.contentRangeH 1 0 $
+            if shouldCount iPreferCount then Just resQueryTotal else Nothing
+        , if null pkCols && isNothing iOnConflict then
+            Nothing
+          else
+            toAppliedHeader <$> iPreferResolution
+        ]
 
-      response <- liftEither $ gucResponse <$> rsGucStatus <*> rsGucHeaders
+  failNotSingular iAcceptContentType resQueryTotal $
-
+    if iPreferRepresentation == Full then
-      let
+      response HTTP.status201 (headers ++ contentTypeHeaders context) (LBS.fromStrict resBody)
-        headers =
+    else
-          catMaybes
+      response HTTP.status201 headers mempty
-            [ if null rsLocation then
-                Nothing
-              else
-                Just
-                  ( HTTP.hLocation
-                  , "/"
-                      <> toUtf8 qiName
-                      <> HTTP.renderSimpleQuery True rsLocation
-                  )
-            , Just . RangeQuery.contentRangeH 1 0 $
-                if shouldCount iPreferCount then Just rsQueryTotal else Nothing
-            , if null pkCols && isNothing (qsOnConflict iQueryParams) then
-                Nothing
-              else
-                toAppliedHeader <$> iPreferResolution
-            ]
-
-      failNotSingular iAcceptMediaType rsQueryTotal $
-        if iPreferRepresentation == Full then
-          response HTTP.status201 (headers ++ contentTypeHeaders context) (LBS.fromStrict rsBody)
-        else
-          response HTTP.status201 headers mempty
-
-    RSPlan plan ->
-      pure $ Wai.responseLBS HTTP.status200 (contentTypeHeaders context) $ LBS.fromStrict plan
 
 handleUpdate :: QualifiedIdentifier -> RequestContext -> DbHandler Wai.Response
 handleUpdate identifier context@(RequestContext _ _ ApiRequest{..} _) = do
-  resultSet <- writeQuery MutationUpdate identifier False mempty context
+  WriteQueryResult{..} <- writeQuery identifier False mempty context
 
-  case resultSet of
+  let
-    RSStandard{..} -> do
+    response = gucResponse resGucStatus resGucHeaders
-      response <- liftEither $ gucResponse <$> rsGucStatus <*> rsGucHeaders
+    fullRepr = iPreferRepresentation == Full
+    updateIsNoOp = S.null iColumns
+    status
+      | resQueryTotal == 0 && not updateIsNoOp = HTTP.status404
+      | fullRepr = HTTP.status200
+      | otherwise = HTTP.status204
+    contentRangeHeader =
+      RangeQuery.contentRangeH 0 (resQueryTotal - 1) $
+        if shouldCount iPreferCount then Just resQueryTotal else Nothing
 
-      let
+  failNotSingular iAcceptContentType resQueryTotal $
-        fullRepr = iPreferRepresentation == Full
+    if fullRepr then
-        updateIsNoOp = S.null iColumns
+      response status (contentTypeHeaders context ++ [contentRangeHeader]) (LBS.fromStrict resBody)
-        status
+    else
-          | rsQueryTotal == 0 && not updateIsNoOp = HTTP.status404
+      response status [contentRangeHeader] mempty
-          | fullRepr = HTTP.status200
-          | otherwise = HTTP.status204
-        contentRangeHeader =
-          RangeQuery.contentRangeH 0 (rsQueryTotal - 1) $
-            if shouldCount iPreferCount then Just rsQueryTotal else Nothing
-
-      failChangesOffLimits (RangeQuery.rangeLimit iTopLevelRange) rsQueryTotal =<<
-        failNotSingular iAcceptMediaType rsQueryTotal (
-          if fullRepr then
-            response status (contentTypeHeaders context ++ [contentRangeHeader]) (LBS.fromStrict rsBody)
-          else
-            response status [contentRangeHeader] mempty)
-
-    RSPlan plan ->
-      pure $ Wai.responseLBS HTTP.status200 (contentTypeHeaders context) $ LBS.fromStrict plan
 
 handleSingleUpsert :: QualifiedIdentifier -> RequestContext-> DbHandler Wai.Response
-handleSingleUpsert identifier context@(RequestContext _ ctxDbStructure ApiRequest{..} _) = do
+handleSingleUpsert identifier context@(RequestContext _ _ ApiRequest{..} _) = do
-  let pkCols = maybe mempty tablePKCols $ HM.lookup identifier $ dbTables ctxDbStructure
+  when (iTopLevelRange /= RangeQuery.allRange) $
+    throwError Error.PutRangeNotAllowedError
 
-  resultSet <- writeQuery MutationSingleUpsert identifier False pkCols context
+  WriteQueryResult{..} <- writeQuery identifier False mempty context
 
-  case resultSet of
+  let response = gucResponse resGucStatus resGucHeaders
-    RSStandard {..} -> do
 
-      response <- liftEither $ gucResponse <$> rsGucStatus <*> rsGucHeaders
+  -- Makes sure the querystring pk matches the payload pk
+  -- e.g. PUT /items?id=eq.1 { "id" : 1, .. } is accepted,
+  -- PUT /items?id=eq.14 { "id" : 2, .. } is rejected.
+  -- If this condition is not satisfied then nothing is inserted,
+  -- check the WHERE for INSERT in QueryBuilder.hs to see how it's done
+  when (resQueryTotal /= 1) $ do
+    lift SQL.condemn
+    throwError Error.PutMatchingPkError
 
-      -- Makes sure the querystring pk matches the payload pk
+  return $
-      -- e.g. PUT /items?id=eq.1 { "id" : 1, .. } is accepted,
+    if iPreferRepresentation == Full then
-      -- PUT /items?id=eq.14 { "id" : 2, .. } is rejected.
+      response HTTP.status200 (contentTypeHeaders context) (LBS.fromStrict resBody)
-      -- If this condition is not satisfied then nothing is inserted,
+    else
-      -- check the WHERE for INSERT in QueryBuilder.hs to see how it's done
+      response HTTP.status204 (contentTypeHeaders context) mempty
-      when (rsQueryTotal /= 1) $ do
-        lift SQL.condemn
-        throwError Error.PutMatchingPkError
-
-      return $
-        if iPreferRepresentation == Full then
-          response HTTP.status200 (contentTypeHeaders context) (LBS.fromStrict rsBody)
-        else
-          response HTTP.status204 [] mempty
-
-    RSPlan plan ->
-      pure $ Wai.responseLBS HTTP.status200 (contentTypeHeaders context) $ LBS.fromStrict plan
 
 handleDelete :: QualifiedIdentifier -> RequestContext -> DbHandler Wai.Response
 handleDelete identifier context@(RequestContext _ _ ApiRequest{..} _) = do
-  resultSet <- writeQuery MutationDelete identifier False mempty context
+  WriteQueryResult{..} <- writeQuery identifier False mempty context
 
-  case resultSet of
+  let
-    RSStandard {..} -> do
+    response = gucResponse resGucStatus resGucHeaders
+    contentRangeHeader =
+      RangeQuery.contentRangeH 1 0 $
+        if shouldCount iPreferCount then Just resQueryTotal else Nothing
 
-      response <- liftEither $ gucResponse <$> rsGucStatus <*> rsGucHeaders
+  failNotSingular iAcceptContentType resQueryTotal $
+    if iPreferRepresentation == Full then
+      response HTTP.status200
+        (contentTypeHeaders context ++ [contentRangeHeader])
+        (LBS.fromStrict resBody)
+    else
+      response HTTP.status204 [contentRangeHeader] mempty
 
-      let
+handleInfo :: Monad m => QualifiedIdentifier -> RequestContext -> Handler m Wai.Response
-        contentRangeHeader =
+handleInfo identifier RequestContext{..} =
-          RangeQuery.contentRangeH 1 0 $
+  case find tableMatches $ dbTables ctxDbStructure of
-            if shouldCount iPreferCount then Just rsQueryTotal else Nothing
+    Just table ->
-
+      return $ Wai.responseLBS HTTP.status200 [allOrigins, allowH table] mempty
-      failChangesOffLimits (RangeQuery.rangeLimit iTopLevelRange) rsQueryTotal =<<
+    Nothing ->
-        failNotSingular iAcceptMediaType rsQueryTotal (
+      throwError Error.NotFound
-          if iPreferRepresentation == Full then
-            response HTTP.status200
-              (contentTypeHeaders context ++ [contentRangeHeader])
-              (LBS.fromStrict rsBody)
-          else
-            response HTTP.status204 [contentRangeHeader] mempty)
-
-    RSPlan plan ->
-      pure $ Wai.responseLBS HTTP.status200 (contentTypeHeaders context) $ LBS.fromStrict plan
-
-handleInfo :: Monad m => Target -> RequestContext -> Handler m Wai.Response
-handleInfo target RequestContext{..} =
-  case target of
-    TargetIdent identifier ->
-      case HM.lookup identifier (dbTables ctxDbStructure) of
-        Just tbl -> infoResponse $ allowH tbl
-        Nothing  -> throwError $ Error.ApiRequestError ApiRequestTypes.NotFound
-    TargetProc pd _
-      | pdVolatility pd == Volatile -> infoResponse "OPTIONS,POST"
-      | otherwise                   -> infoResponse "OPTIONS,GET,HEAD,POST"
-    TargetDefaultSpec _             -> infoResponse "OPTIONS,GET,HEAD"
   where
-    infoResponse allowHeader = return $ Wai.responseLBS HTTP.status200 [allOrigins, (HTTP.hAllow, allowHeader)] mempty
     allOrigins = ("Access-Control-Allow-Origin", "*")
     allowH table =
-      let hasPK = not . null $ tablePKCols table in
+      ( HTTP.hAllow
-      BS.intercalate "," $
+      , BS.intercalate "," $
-          ["OPTIONS,GET,HEAD"] ++
+          ["OPTIONS,GET,HEAD"]
-          ["POST" | tableInsertable table] ++
+          ++ ["POST" | tableInsertable table]
-          ["PUT" | tableInsertable table && tableUpdatable table && hasPK] ++
+          ++ ["PUT" | tableInsertable table && tableUpdatable table && hasPK]
-          ["PATCH" | tableUpdatable table] ++
+          ++ ["PATCH" | tableUpdatable table]
-          ["DELETE" | tableDeletable table]
+          ++ ["DELETE" | tableDeletable table]
+      )
+    tableMatches table =
+      tableName table == qiName identifier
+      && tableSchema table == qiSchema identifier
+    hasPK =
+      not $ null $ tablePKCols ctxDbStructure (qiSchema identifier) (qiName identifier)
 
 handleInvoke :: InvokeMethod -> ProcDescription -> RequestContext -> DbHandler Wai.Response
 handleInvoke invMethod proc context@RequestContext{..} = do
@@ -481,37 +436,31 @@ handleInvoke invMethod proc context@RequestContext{..} = do
 
   let callReq = ReqBuilder.callRequest proc ctxApiRequest req
 
-  resultSet <-
+  (tableTotal, queryTotal, body, gucHeaders, gucStatus) <-
     lift . SQL.statement mempty $
-      Statements.prepareCall
+      Statements.callProcStatement
         (Proc.procReturnsScalar proc)
         (Proc.procReturnsSingle proc)
         (QueryBuilder.requestToCallProcQuery callReq)
         (QueryBuilder.readRequestToQuery req)
         (QueryBuilder.readRequestToCountQuery req)
         (shouldCount iPreferCount)
-        iAcceptMediaType
+        (iAcceptContentType == CTSingularJSON)
+        (iAcceptContentType == CTTextCSV)
         (iPreferParameters == Just MultipleObjects)
         bField
         (configDbPreparedStatements ctxConfig)
 
-  case resultSet of
+  response <- liftEither $ gucResponse <$> gucStatus <*> gucHeaders
-    RSStandard {..} -> do
-      response <- liftEither $ gucResponse <$> rsGucStatus <*> rsGucHeaders
-      let
-        (status, contentRange) =
-          RangeQuery.rangeStatusHeader iTopLevelRange rsQueryTotal rsTableTotal
 
-      failNotSingular iAcceptMediaType rsQueryTotal $
+  let
-        if Proc.procReturnsVoid proc then
+    (status, contentRange) =
-          response HTTP.status204 [contentRange] mempty
+      RangeQuery.rangeStatusHeader iTopLevelRange queryTotal tableTotal
-        else
-          response status
-            (contentTypeHeaders context ++ [contentRange])
-            (if invMethod == InvHead then mempty else LBS.fromStrict rsBody)
 
-    RSPlan plan ->
+  failNotSingular iAcceptContentType queryTotal $
-      pure $ Wai.responseLBS HTTP.status200 (contentTypeHeaders context) $ LBS.fromStrict plan
+    response status
+      (contentTypeHeaders context ++ [contentRange])
+      (if invMethod == InvHead then mempty else LBS.fromStrict body)
 
 handleOpenApi :: Bool -> Schema -> RequestContext -> DbHandler Wai.Response
 handleOpenApi headersOnly tSchema (RequestContext conf@AppConfig{..} dbStructure apiRequest ctxPgVersion) = do
@@ -519,20 +468,20 @@ handleOpenApi headersOnly tSchema (RequestContext conf@AppConfig{..} dbStructure
     lift $ case configOpenApiMode of
       OAFollowPriv ->
         OpenAPI.encode conf dbStructure
-           <$> SQL.statement [tSchema] (DbStructure.accessibleTables ctxPgVersion configDbPreparedStatements)
+           <$> SQL.statement tSchema (DbStructure.accessibleTables ctxPgVersion configDbPreparedStatements)
            <*> SQL.statement tSchema (DbStructure.accessibleProcs ctxPgVersion configDbPreparedStatements)
            <*> SQL.statement tSchema (DbStructure.schemaDescription configDbPreparedStatements)
       OAIgnorePriv ->
         OpenAPI.encode conf dbStructure
-              (HM.filterWithKey (\(QualifiedIdentifier sch _) _ ->  sch == tSchema) $ DbStructure.dbTables dbStructure)
+              (filter (\x -> tableSchema x == tSchema) $ DbStructure.dbTables dbStructure)
-              (HM.filterWithKey (\(QualifiedIdentifier sch _) _ ->  sch == tSchema) $ DbStructure.dbProcs dbStructure)
+              (M.filterWithKey (\(QualifiedIdentifier sch _) _ ->  sch == tSchema) $ DbStructure.dbProcs dbStructure)
           <$> SQL.statement tSchema (DbStructure.schemaDescription configDbPreparedStatements)
       OADisabled ->
         pure mempty
 
   return $
     Wai.responseLBS HTTP.status200
-      (MediaType.toContentType MTOpenAPI : maybeToList (profileHeader apiRequest))
+      (ContentType.toHeader CTOpenAPI : maybeToList (profileHeader apiRequest))
       (if headersOnly then mempty else body)
 
 txMode :: ApiRequest -> SQL.Mode
@@ -555,25 +504,38 @@ txMode ApiRequest{..} =
     _ ->
       SQL.Write
 
-writeQuery :: Mutation -> QualifiedIdentifier -> Bool -> [Text] -> RequestContext -> DbHandler ResultSet
+-- | Result from executing a write query on the database
-writeQuery mutation identifier@QualifiedIdentifier{..} isInsert pkCols context@RequestContext{..} = do
+data WriteQueryResult = WriteQueryResult
+  { resQueryTotal :: Int64
+  , resFields     :: [ByteString]
+  , resBody       :: ByteString
+  , resGucStatus  :: Maybe HTTP.Status
+  , resGucHeaders :: [GucHeader]
+  }
+
+writeQuery :: QualifiedIdentifier -> Bool -> [Text] -> RequestContext -> DbHandler WriteQueryResult
+writeQuery identifier@QualifiedIdentifier{..} isInsert pkCols context@RequestContext{..} = do
   readReq <- readRequest identifier context
 
   mutateReq <-
     liftEither $
-      ReqBuilder.mutateRequest mutation qiSchema qiName ctxApiRequest
+      ReqBuilder.mutateRequest qiSchema qiName ctxApiRequest
-        pkCols
+        (tablePKCols ctxDbStructure qiSchema qiName)
         readReq
 
-  lift . SQL.statement mempty $
+  (_, queryTotal, fields, body, gucHeaders, gucStatus) <-
-    Statements.prepareWrite
+    lift . SQL.statement mempty $
-      (QueryBuilder.readRequestToQuery readReq)
+      Statements.createWriteStatement
-      (QueryBuilder.mutateRequestToQuery mutateReq)
+        (QueryBuilder.readRequestToQuery readReq)
-      isInsert
+        (QueryBuilder.mutateRequestToQuery mutateReq)
-      (iAcceptMediaType ctxApiRequest)
+        (iAcceptContentType ctxApiRequest == CTSingularJSON)
-      (iPreferRepresentation ctxApiRequest)
+        isInsert
-      pkCols
+        (iAcceptContentType ctxApiRequest == CTTextCSV)
-      (configDbPreparedStatements ctxConfig)
+        (iPreferRepresentation ctxApiRequest)
+        pkCols
+        (configDbPreparedStatements ctxConfig)
+
+  liftEither $ WriteQueryResult queryTotal fields body <$> gucStatus <*> gucHeaders
 
 -- | Response with headers and status overridden from GUCs.
 gucResponse
@@ -590,25 +552,15 @@ gucResponse gucStatus gucHeaders status headers =
 -- |
 -- Fail a response if a single JSON object was requested and not exactly one
 -- was found.
-failNotSingular :: MediaType -> Int64 -> Wai.Response -> DbHandler Wai.Response
+failNotSingular :: ContentType -> Int64 -> Wai.Response -> DbHandler Wai.Response
-failNotSingular mediaType queryTotal response =
+failNotSingular contentType queryTotal response =
-  if mediaType == MTSingularJSON && queryTotal /= 1 then
+  if contentType == CTSingularJSON && queryTotal /= 1 then
     do
       lift SQL.condemn
       throwError $ Error.singularityError queryTotal
   else
     return response
 
-failChangesOffLimits :: Maybe Integer -> Int64 -> Wai.Response -> DbHandler Wai.Response
-failChangesOffLimits (Just maxChanges) queryTotal response =
-  if queryTotal > fromIntegral maxChanges
-  then do
-      lift SQL.condemn
-      throwError $ Error.OffLimitsChangesError queryTotal maxChanges
-  else
-    return response
-failChangesOffLimits _ _ response = return response
-
 shouldCount :: Maybe PreferCount -> Bool
 shouldCount preferCount =
   preferCount == Just ExactCount || preferCount == Just EstimatedCount
@@ -626,16 +578,16 @@ readRequest QualifiedIdentifier{..} (RequestContext AppConfig{..} dbStructure ap
 
 contentTypeHeaders :: RequestContext -> [HTTP.Header]
 contentTypeHeaders RequestContext{..} =
-  MediaType.toContentType (iAcceptMediaType ctxApiRequest) : maybeToList (profileHeader ctxApiRequest)
+  ContentType.toHeader (iAcceptContentType ctxApiRequest) : maybeToList (profileHeader ctxApiRequest)
 
--- | If raw(binary) output is requested, check that MediaType is one of the
+-- | If raw(binary) output is requested, check that ContentType is one of the
--- admitted rawMediaTypes and that`?select=...` contains only one field other
+-- admitted rawContentTypes and that`?select=...` contains only one field other
 -- than `*`
 binaryField :: Monad m => RequestContext -> ReadRequest -> Handler m (Maybe FieldName)
 binaryField RequestContext{..} readReq
-  | returnsScalar (iTarget ctxApiRequest) && isRawMediaType =
+  | returnsScalar (iTarget ctxApiRequest) && iAcceptContentType ctxApiRequest `elem` rawContentTypes ctxConfig =
       return $ Just "pgrst_scalar"
-  | isRawMediaType =
+  | iAcceptContentType ctxApiRequest `elem` rawContentTypes ctxConfig =
       let
         fldNames = fstFieldNames readReq
         fieldName = headMay fldNames
@@ -643,18 +595,20 @@ binaryField RequestContext{..} readReq
       if length fldNames == 1 && fieldName /= Just "*" then
         return fieldName
       else
-        throwError $ Error.BinaryFieldError mediaType
+        throwError $ Error.BinaryFieldError (iAcceptContentType ctxApiRequest)
   | otherwise =
       return Nothing
-  where
+
-    mediaType = iAcceptMediaType ctxApiRequest
+rawContentTypes :: AppConfig -> [ContentType]
-    isRawMediaType = mediaType `elem` configRawMediaTypes ctxConfig `union` [MTOctetStream, MTTextPlain, MTTextXML] || isRawPlan mediaType
+rawContentTypes AppConfig{..} =
-    isRawPlan mt = case mt of
+  (ContentType.decodeContentType <$> configRawMediaTypes) `union` [CTOctetStream, CTTextPlain]
-      MTPlan (MTPlanAttrs (Just MTOctetStream) _ _) -> True
-      MTPlan (MTPlanAttrs (Just MTTextPlain) _ _)   -> True
-      MTPlan (MTPlanAttrs (Just MTTextXML) _ _)     -> True
-      _                                             -> False
 
 profileHeader :: ApiRequest -> Maybe HTTP.Header
 profileHeader ApiRequest{..} =
   (,) "Content-Profile" <$> (toUtf8 <$> iProfile)
+
+splitKeyValue :: ByteString -> (ByteString, ByteString)
+splitKeyValue kv =
+  (k, BS.tail v)
+  where
+    (k, v) = BS.break (== '=') kv

src/PostgREST/AppState.hs

@@ -2,33 +2,30 @@
 
 module PostgREST.AppState
   ( AppState
-  , destroy
   , getConfig
   , getDbStructure
-  , getIsListenerOn
+  , getIsWorkerOn
   , getJsonDbS
   , getMainThreadId
   , getPgVersion
-  , getRetryNextIn
+  , getPool
   , getTime
-  , getWorkerSem
+  , getRetryNextIn
   , init
   , initWithPool
   , logWithZTime
   , putConfig
   , putDbStructure
-  , putIsListenerOn
+  , putIsWorkerOn
   , putJsonDbS
   , putPgVersion
   , putRetryNextIn
   , releasePool
   , signalListener
-  , usePool
   , waitListener
   ) where
 
-import qualified Hasql.Pool    as SQL
+import qualified Hasql.Pool as SQL
-import qualified Hasql.Session as SQL
 
 import Control.AutoUpdate (defaultUpdateSettings, mkAutoUpdate,
                            updateAction)
@@ -52,12 +49,10 @@ data AppState = AppState
   , stateDbStructure  :: IORef (Maybe DbStructure)
   -- | Cached DbStructure in json
   , stateJsonDbS      :: IORef ByteString
-  -- | Binary semaphore to make sure just one connectionWorker can run at a time
+  -- | Helper ref to make sure just one connectionWorker can run at a time
-  , stateWorkerSem    :: MVar ()
+  , stateIsWorkerOn   :: IORef Bool
   -- | 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
-  , stateIsListenerOn :: IORef Bool
   -- | Config that can change at runtime
   , stateConf         :: IORef AppConfig
   -- | Time used for verifying JWT expiration
@@ -81,27 +76,23 @@ initWithPool newPool conf =
     <$> newIORef minimumPgVersion -- assume we're in a supported version when starting, this will be corrected on a later step
     <*> newIORef Nothing
     <*> newIORef mempty
-    <*> newEmptyMVar
-    <*> newEmptyMVar
     <*> newIORef False
+    <*> newEmptyMVar
     <*> newIORef conf
     <*> mkAutoUpdate defaultUpdateSettings { updateAction = getCurrentTime }
     <*> mkAutoUpdate defaultUpdateSettings { updateAction = getZonedTime }
     <*> myThreadId
     <*> newIORef 0
 
-destroy :: AppState -> IO ()
-destroy = releasePool
-
 initPool :: AppConfig -> IO SQL.Pool
 initPool AppConfig{..} =
   SQL.acquire (configDbPoolSize, configDbPoolTimeout, toUtf8 configDbUri)
 
-usePool :: AppState -> SQL.Session a -> IO (Either SQL.UsageError a)
+getPool :: AppState -> SQL.Pool
-usePool AppState{..} = SQL.use statePool
+getPool = statePool
 
 releasePool :: AppState -> IO ()
-releasePool AppState{..} = SQL.release statePool
+releasePool AppState{..} = SQL.release statePool >> throwTo stateMainThreadId UserInterrupt
 
 getPgVersion :: AppState -> IO PgVersion
 getPgVersion = readIORef . statePgVersion
@@ -112,8 +103,9 @@ putPgVersion = atomicWriteIORef . statePgVersion
 getDbStructure :: AppState -> IO (Maybe DbStructure)
 getDbStructure = readIORef . stateDbStructure
 
-putDbStructure :: AppState -> Maybe DbStructure -> IO ()
+putDbStructure :: AppState -> DbStructure -> IO ()
-putDbStructure appState = atomicWriteIORef (stateDbStructure appState)
+putDbStructure appState structure =
+  atomicWriteIORef (stateDbStructure appState) $ Just structure
 
 getJsonDbS :: AppState -> IO ByteString
 getJsonDbS = readIORef . stateJsonDbS
@@ -121,8 +113,11 @@ getJsonDbS = readIORef . stateJsonDbS
 putJsonDbS :: AppState -> ByteString -> IO ()
 putJsonDbS appState = atomicWriteIORef (stateJsonDbS appState)
 
-getWorkerSem :: AppState -> MVar ()
+getIsWorkerOn :: AppState -> IO Bool
-getWorkerSem = stateWorkerSem
+getIsWorkerOn = readIORef . stateIsWorkerOn
+
+putIsWorkerOn :: AppState -> Bool -> IO ()
+putIsWorkerOn = atomicWriteIORef . stateIsWorkerOn
 
 getRetryNextIn :: AppState -> IO Int
 getRetryNextIn = readIORef . stateRetryNextIn
@@ -158,9 +153,3 @@ waitListener = takeMVar . stateListener
 -- the connectionWorker is the only mvar producer.
 signalListener :: AppState -> IO ()
 signalListener appState = void $ tryPutMVar (stateListener appState) ()
-
-getIsListenerOn :: AppState -> IO Bool
-getIsListenerOn = readIORef . stateIsListenerOn
-
-putIsListenerOn :: AppState -> Bool -> IO ()
-putIsListenerOn = atomicWriteIORef . stateIsListenerOn

src/PostgREST/Auth.hs

@@ -12,55 +12,40 @@ very simple authentication system inside the PostgreSQL database.
 -}
 {-# LANGUAGE RecordWildCards #-}
 module PostgREST.Auth
-  ( AuthResult (..)
+  ( containsRole
-  , getResult
+  , jwtClaims
-  , getRole
+  , JWTClaims
-  , middleware
   ) where
 
-import qualified Crypto.JWT                      as JWT
+import qualified Crypto.JWT          as JWT
-import qualified Data.Aeson                      as JSON
+import qualified Data.Aeson          as JSON
-import qualified Data.Aeson.Key                  as K
+import qualified Data.HashMap.Strict as M
-import qualified Data.Aeson.KeyMap               as KM
+import qualified Data.Vector         as V
-import qualified Data.Aeson.Types                as JSON
-import qualified Data.ByteString.Lazy.Char8      as LBS
-import qualified Data.Text.Encoding              as T
-import qualified Data.Vault.Lazy                 as Vault
-import qualified Data.Vector                     as V
-import qualified Network.HTTP.Types.Header       as HTTP
-import qualified Network.Wai                     as Wai
-import qualified Network.Wai.Middleware.HttpAuth as Wai
 
 import Control.Lens            (set)
 import Control.Monad.Except    (liftEither)
 import Data.Either.Combinators (mapLeft)
-import Data.List               (lookup)
 import Data.Time.Clock         (UTCTime)
-import System.IO.Unsafe        (unsafePerformIO)
 
-import PostgREST.AppState (AppState, getConfig, getTime)
+import PostgREST.Config (AppConfig (..), JSPath, JSPathExp (..))
-import PostgREST.Config   (AppConfig (..), JSPath, JSPathExp (..))
+import PostgREST.Error  (Error (..))
-import PostgREST.Error    (Error (..))
 
 import Protolude
 
 
-data AuthResult = AuthResult
+type JWTClaims = M.HashMap Text JSON.Value
-  { authClaims :: KM.KeyMap JSON.Value
-  , authRole   :: Text
-  }
 
 -- | Receives the JWT secret and audience (from config) and a JWT and returns a
--- JSON object of JWT claims.
+-- map of JWT claims.
-parseToken :: Monad m =>
+jwtClaims :: Monad m =>
-  AppConfig -> LByteString -> UTCTime -> ExceptT Error m JSON.Value
+  AppConfig -> LByteString -> UTCTime -> ExceptT Error m JWTClaims
-parseToken _ "" _ = return JSON.emptyObject
+jwtClaims _ "" _ = return M.empty
-parseToken AppConfig{..} token time = do
+jwtClaims AppConfig{..} payload time = do
   secret <- liftEither . maybeToRight JwtTokenMissing $ configJWKS
   eitherClaims <-
     lift . runExceptT $
-      JWT.verifyClaimsAt validation secret time =<< JWT.decodeCompact token
+      JWT.verifyClaimsAt validation secret time =<< JWT.decodeCompact payload
-  liftEither . mapLeft jwtClaimsError $ JSON.toJSON <$> eitherClaims
+  liftEither . mapLeft jwtClaimsError $ claimsMap configJwtRoleClaimKey <$> eitherClaims
   where
     validation =
       JWT.defaultJWTValidationSettings audienceCheck & set JWT.allowedSkew 1
@@ -72,50 +57,26 @@ parseToken AppConfig{..} token time = do
     jwtClaimsError JWT.JWTExpired = JwtTokenInvalid "JWT expired"
     jwtClaimsError e              = JwtTokenInvalid $ show e
 
-parseClaims :: Monad m =>
+-- | Turn JWT ClaimSet into something easier to work with.
-  AppConfig -> JSON.Value -> ExceptT Error m AuthResult
+--
-parseClaims AppConfig{..} jclaims@(JSON.Object mclaims) = do
+-- Also, here the jspath is applied to put the "role" in the map.
-  -- role defaults to anon if not specified in jwt
+claimsMap :: JSPath -> JWT.ClaimsSet -> JWTClaims
-  role <- liftEither . maybeToRight JwtTokenRequired $
+claimsMap jspath claims =
-    unquoted <$> walkJSPath (Just jclaims) configJwtRoleClaimKey <|> configDbAnonRole
+  case JSON.toJSON claims of
-  return AuthResult
+    val@(JSON.Object o) ->
-           { authClaims = mclaims & KM.insert "role" (JSON.toJSON role)
+      M.delete "role" o `M.union` role val
-           , authRole = role
+    _ ->
-           }
+      M.empty
   where
+    role value =
+      maybe M.empty (M.singleton "role") $ walkJSPath (Just value) jspath
+
     walkJSPath :: Maybe JSON.Value -> JSPath -> Maybe JSON.Value
     walkJSPath x                      []                = x
-    walkJSPath (Just (JSON.Object o)) (JSPKey key:rest) = walkJSPath (KM.lookup (K.fromText key) o) rest
+    walkJSPath (Just (JSON.Object o)) (JSPKey key:rest) = walkJSPath (M.lookup key o) rest
     walkJSPath (Just (JSON.Array ar)) (JSPIdx idx:rest) = walkJSPath (ar V.!? idx) rest
     walkJSPath _                      _                 = Nothing
 
-    unquoted :: JSON.Value -> Text
+-- | Whether a response from jwtClaims contains a role claim
-    unquoted (JSON.String t) = t
+containsRole :: JWTClaims -> Bool
-    unquoted v = T.decodeUtf8 . LBS.toStrict $ JSON.encode v
+containsRole = M.member "role"
--- impossible case - just added to please -Wincomplete-patterns
-parseClaims _ _ = return AuthResult { authClaims = KM.empty, authRole = mempty }
-
--- | Validate authorization header.
---   Parse and store JWT claims for future use in the request.
-middleware :: AppState -> Wai.Middleware
-middleware appState app req respond = do
-  conf <- getConfig appState
-  time <- getTime appState
-
-  let token = fromMaybe "" $ Wai.extractBearerAuth =<< lookup HTTP.hAuthorization (Wai.requestHeaders req)
-  authResult <- runExceptT $
-    parseToken conf (LBS.fromStrict token) time >>=
-    parseClaims conf
-
-  let req' = req { Wai.vault = Wai.vault req & Vault.insert authResultKey authResult }
-  app req' respond
-
-authResultKey :: Vault.Key (Either Error AuthResult)
-authResultKey = unsafePerformIO Vault.newKey
-{-# NOINLINE authResultKey #-}
-
-getResult :: Wai.Request -> Maybe (Either Error AuthResult)
-getResult = Vault.lookup authResultKey . Wai.vault
-
-getRole :: Wai.Request -> Maybe Text
-getRole req = authRole <$> (rightToMaybe =<< getResult req)

src/PostgREST/CLI.hs

@@ -11,6 +11,7 @@ module PostgREST.CLI
 import qualified Data.Aeson                 as JSON
 import qualified Data.ByteString.Char8      as BS
 import qualified Data.ByteString.Lazy       as LBS
+import qualified Hasql.Pool                 as SQL
 import qualified Hasql.Transaction.Sessions as SQL
 import qualified Options.Applicative        as O
 
@@ -34,19 +35,19 @@ 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
+  appState <- AppState.init conf
 
-  -- Per https://github.com/PostgREST/postgrest/issues/268, we want to
+  -- Override the config with config options from the db
-  -- explicitly close the connections to PostgreSQL on shutdown.
+  -- TODO: the same operation is repeated on connectionWorker, ideally this
-  -- 'AppState.destroy' takes care of that.
+  -- would be done only once, but dump CmdDumpConfig needs it for tests.
-  bracket
+  when configDbConfig $ reReadConfig True appState
-    (AppState.init conf)
+
-    AppState.destroy
+  exec cliCommand appState
-    (\appState -> case cliCommand of
+  where
-      CmdDumpConfig -> do
+    exec :: Command -> AppState -> IO ()
-        when configDbConfig $ reReadConfig True appState
+    exec CmdDumpConfig appState = putStr . Config.toText =<< AppState.getConfig appState
-        putStr . Config.toText =<< AppState.getConfig appState
+    exec CmdDumpSchema appState = putStrLn =<< dumpSchema appState
-      CmdDumpSchema -> putStrLn =<< dumpSchema appState
+    exec CmdRun appState = App.run installSignalHandlers runAppWithSocket appState
-      CmdRun -> App.run installSignalHandlers runAppWithSocket appState)
 
 -- | Dump DbStructure schema to JSON
 dumpSchema :: AppState -> IO LBS.ByteString
@@ -54,12 +55,13 @@ dumpSchema appState = do
   AppConfig{..} <- AppState.getConfig appState
   result <-
     let transaction = if configDbPreparedStatements then SQL.transaction else SQL.unpreparedTransaction in
-    AppState.usePool appState $
+    SQL.use (AppState.getPool appState) $
       transaction SQL.ReadCommitted SQL.Read $
         queryDbStructure
           (toList configDbSchemas)
           configDbExtraSearchPath
           configDbPreparedStatements
+  SQL.release $ AppState.getPool appState
   case result of
     Left e -> do
       hPutStrLn stderr $ "An error ocurred when loading the schema cache:\n" <> show e
@@ -78,12 +80,12 @@ data Command
   | CmdDumpSchema
 
 -- | Read command line interface options. Also prints help.
-readCLIShowHelp :: IO CLI
+readCLIShowHelp :: Bool -> IO CLI
-readCLIShowHelp =
+readCLIShowHelp hasEnvironment =
   O.customExecParser prefs opts
   where
     prefs = O.prefs $ O.showHelpOnError <> O.showHelpOnEmpty
-    opts = O.info parser $ O.fullDesc <> progDesc
+    opts = O.info parser $ O.fullDesc <> progDesc <> footer
     parser = O.helper <*> exampleParser <*> cliParser
 
     progDesc =
@@ -92,6 +94,11 @@ readCLIShowHelp =
         <> BS.unpack prettyVersion
         <> " / create a REST API to an existing Postgres database"
 
+    footer =
+      O.footer $
+        "To run PostgREST, please pass the FILENAME argument"
+        <> " or set PGRST_ environment variables."
+
     exampleParser =
       O.infoOption exampleConfigFile $
         O.long "example"
@@ -102,12 +109,12 @@ readCLIShowHelp =
     cliParser =
       CLI
         <$> (dumpConfigFlag <|> dumpSchemaFlag)
-        <*> O.optional configFileOption
+        <*> optionalIf hasEnvironment configFileOption
 
     configFileOption =
       O.strArgument $
         O.metavar "FILENAME"
-        <> O.help "Path to configuration file"
+        <> O.help "Path to configuration file (optional with PGRST_ environment variables)"
 
     dumpConfigFlag =
       O.flag CmdRun CmdDumpConfig $
@@ -119,13 +126,36 @@ readCLIShowHelp =
         O.long "dump-schema"
         <> O.help "Dump loaded schema as JSON and exit (for debugging, output structure is unstable)"
 
+    optionalIf :: Alternative f => Bool -> f a -> f (Maybe a)
+    optionalIf True  = O.optional
+    optionalIf False = fmap Just
+
 exampleConfigFile :: [Char]
 exampleConfigFile =
-  [str|## Admin server used for checks. It's disabled by default unless a port is specified.
+  [str|### REQUIRED:
-      |# admin-server-port = 3001
+      |db-uri = "postgres://user:pass@localhost:5432/dbname"
+      |db-schema = "public"
+      |db-anon-role = "postgres"
       |
-      |## The database role to use when no client authentication is provided
+      |### OPTIONAL:
-      |# db-anon-role = "anon"
+      |## number of open connections in the pool
+      |db-pool = 10
+      |
+      |## Time to live, in seconds, for an idle database pool connection.
+      |db-pool-timeout = 10
+      |
+      |## extra schemas to add to the search_path of every request
+      |db-extra-search-path = "public"
+      |
+      |## limit rows in response
+      |# db-max-rows = 1000
+      |
+      |## stored proc to exec immediately after auth
+      |# db-pre-request = "stored_proc_name"
+      |
+      |## stored proc that overrides the root "/" spec
+      |## it must be inside the db-schema
+      |# db-root-spec = "stored_proc_name"
       |
       |## Notification channel for reloading the schema cache
       |db-channel = "pgrst"
@@ -136,82 +166,56 @@ exampleConfigFile =
       |## Enable in-database configuration
       |db-config = true
       |
-      |## Extra schemas to add to the search_path of every request
-      |db-extra-search-path = "public"
-      |
-      |## Limit rows in response
-      |# db-max-rows = 1000
-      |
-      |## Allow getting the EXPLAIN plan through the `Accept: application/vnd.pgrst.plan` header
-      |# db-plan-enabled = false
-      |
-      |## Number of open connections in the pool
-      |db-pool = 10
-      |
-      |## Time to live, in seconds, for an idle database pool connection
-      |db-pool-timeout = 3600
-      |
-      |## Stored proc to exec immediately after auth
-      |# db-pre-request = "stored_proc_name"
-      |
-      |## Enable or disable prepared statements. disabling is only necessary when behind a connection pooler.
-      |## When disabled, statements will be parametrized but won't be prepared.
-      |db-prepared-statements = true
-      |
-      |## The name of which database schema to expose to REST clients
-      |db-schemas = "public"
-      |
-      |## How to terminate database transactions
-      |## Possible values are:
-      |## commit (default)
-      |##   Transaction is always committed, this can not be overriden
-      |## commit-allow-override
-      |##   Transaction is committed, but can be overriden with Prefer tx=rollback header
-      |## rollback
-      |##   Transaction is always rolled back, this can not be overriden
-      |## rollback-allow-override
-      |##   Transaction is rolled back, but can be overriden with Prefer tx=commit header
-      |db-tx-end = "commit"
-      |
-      |## The standard connection URI format, documented at
-      |## https://www.postgresql.org/docs/current/libpq-connect.html#LIBPQ-CONNSTRING
-      |db-uri = "postgresql://"
-      |
       |## Determine if GUC request settings for headers, cookies and jwt claims use the legacy names (string with dashes, invalid starting from PostgreSQL v14) with text values instead of the new names (string without dashes, valid on all PostgreSQL versions) with json values.
       |## For PostgreSQL v14 and up, this setting will be ignored.
       |db-use-legacy-gucs = true
       |
-      |# jwt-aud = "your_audience_claim"
+      |## how to terminate database transactions
+      |## possible values are:
+      |## commit (default)
+      |##   transaction is always committed, this can not be overriden
+      |## commit-allow-override
+      |##   transaction is committed, but can be overriden with Prefer tx=rollback header
+      |## rollback
+      |##   transaction is always rolled back, this can not be overriden
+      |## rollback-allow-override
+      |##   transaction is rolled back, but can be overriden with Prefer tx=commit header
+      |db-tx-end = "commit"
       |
-      |## Jspath to the role claim key
+      |## enable or disable prepared statements. disabling is only necessary when behind a connection pooler.
-      |jwt-role-claim-key = ".role"
+      |## when disabled, statements will be parametrized but won't be prepared.
-      |
+      |db-prepared-statements = true
-      |## Choose a secret, JSON Web Key (or set) to enable JWT auth
-      |## (use "@filename" to load from separate file)
-      |# jwt-secret = "secret_with_at_least_32_characters"
-      |jwt-secret-is-base64 = false
-      |
-      |## Logging level, the admitted values are: crit, error, warn and info.
-      |log-level = "error"
-      |
-      |## Determine if the OpenAPI output should follow or ignore role privileges or be disabled entirely.
-      |## Admitted values: follow-privileges, ignore-privileges, disabled
-      |openapi-mode = "follow-privileges"
-      |
-      |## Base url for the OpenAPI output
-      |openapi-server-proxy-uri = ""
-      |
-      |## Content types to produce raw output
-      |# raw-media-types="image/png, image/jpg"
       |
       |server-host = "!4"
       |server-port = 3000
       |
-      |## Unix socket location
+      |## unix socket location
       |## if specified it takes precedence over server-port
       |# server-unix-socket = "/tmp/pgrst.sock"
       |
-      |## Unix socket file mode
+      |## unix socket file mode
-      |## When none is provided, 660 is applied by default
+      |## when none is provided, 660 is applied by default
       |# server-unix-socket-mode = "660"
+      |
+      |## determine if the OpenAPI output should follow or ignore role privileges or be disabled entirely
+      |## admitted values: follow-privileges, ignore-privileges, disabled
+      |openapi-mode = "follow-privileges"
+      |
+      |## base url for the OpenAPI output
+      |openapi-server-proxy-uri = ""
+      |
+      |## choose a secret, JSON Web Key (or set) to enable JWT auth
+      |## (use "@filename" to load from separate file)
+      |# jwt-secret = "secret_with_at_least_32_characters"
+      |# jwt-aud = "your_audience_claim"
+      |jwt-secret-is-base64 = false
+      |
+      |## jspath to the role claim key
+      |jwt-role-claim-key = ".role"
+      |
+      |## content types to produce raw output
+      |# raw-media-types="image/png, image/jpg"
+      |
+      |## logging level, the admitted values are: crit, error, warn and info.
+      |log-level = "error"
       |]

src/PostgREST/Config.hs

@@ -57,19 +57,17 @@ import PostgREST.Config.Proxy            (Proxy (..),
                                           isMalformedProxyUri, toURI)
 import PostgREST.DbStructure.Identifiers (QualifiedIdentifier, dumpQi,
                                           toQi)
-import PostgREST.MediaType               (MediaType (..), toMime)
 
 import Protolude hiding (Proxy, toList)
 
 
 data AppConfig = AppConfig
   { configAppSettings           :: [(Text, Text)]
-  , configDbAnonRole            :: Maybe Text
+  , configDbAnonRole            :: Text
   , configDbChannel             :: Text
   , configDbChannelEnabled      :: Bool
   , configDbExtraSearchPath     :: [Text]
   , configDbMaxRows             :: Maybe Integer
-  , configDbPlanEnabled         :: Bool
   , configDbPoolSize            :: Int
   , configDbPoolTimeout         :: NominalDiffTime
   , configDbPreRequest          :: Maybe QualifiedIdentifier
@@ -89,14 +87,12 @@ data AppConfig = AppConfig
   , configJwtSecretIsBase64     :: Bool
   , configLogLevel              :: LogLevel
   , configOpenApiMode           :: OpenAPIMode
-  , configOpenApiSecurityActive :: Bool
   , configOpenApiServerProxyUri :: Maybe Text
-  , configRawMediaTypes         :: [MediaType]
+  , configRawMediaTypes         :: [BS.ByteString]
   , configServerHost            :: Text
   , configServerPort            :: Int
   , configServerUnixSocket      :: Maybe FilePath
   , configServerUnixSocketMode  :: FileMode
-  , configAdminServerPort       :: Maybe Int
   }
 
 data LogLevel = LogCrit | LogError | LogWarn | LogInfo
@@ -124,12 +120,11 @@ toText conf =
   where
     -- apply conf to all pgrst settings
     pgrstSettings = (\(k, v) -> (k, v conf)) <$>
-      [("db-anon-role",              q . fromMaybe "" . configDbAnonRole)
+      [("db-anon-role",              q . configDbAnonRole)
       ,("db-channel",                q . configDbChannel)
       ,("db-channel-enabled",            T.toLower . show . configDbChannelEnabled)
       ,("db-extra-search-path",      q . T.intercalate "," . configDbExtraSearchPath)
       ,("db-max-rows",                   maybe "\"\"" show . configDbMaxRows)
-      ,("db-plan-enabled",               T.toLower . show . configDbPlanEnabled)
       ,("db-pool",                       show . configDbPoolSize)
       ,("db-pool-timeout",               show . floor . configDbPoolTimeout)
       ,("db-pre-request",            q . maybe mempty dumpQi . configDbPreRequest)
@@ -146,14 +141,12 @@ toText conf =
       ,("jwt-secret-is-base64",          T.toLower . show . configJwtSecretIsBase64)
       ,("log-level",                 q . dumpLogLevel . configLogLevel)
       ,("openapi-mode",              q . dumpOpenApiMode . configOpenApiMode)
-      ,("openapi-security-active",       T.toLower . show . configOpenApiSecurityActive)
       ,("openapi-server-proxy-uri",  q . fromMaybe mempty . configOpenApiServerProxyUri)
-      ,("raw-media-types",           q . T.decodeUtf8 . BS.intercalate "," . fmap toMime . configRawMediaTypes)
+      ,("raw-media-types",           q . T.decodeUtf8 . BS.intercalate "," . configRawMediaTypes)
       ,("server-host",               q . configServerHost)
       ,("server-port",                   show . configServerPort)
       ,("server-unix-socket",        q . maybe mempty T.pack . configServerUnixSocket)
       ,("server-unix-socket-mode",   q . T.pack . showSocketMode)
-      ,("admin-server-port",             maybe "\"\"" show . configAdminServerPort)
       ]
 
     -- quote all app.settings
@@ -180,10 +173,10 @@ class JustIfMaybe a b where
   justIfMaybe :: a -> b
 
 instance JustIfMaybe a a where
-  justIfMaybe = identity
+  justIfMaybe a = a
 
 instance JustIfMaybe a (Maybe a) where
-  justIfMaybe = Just
+  justIfMaybe a = Just a
 
 -- | Reads and parses the config and overrides its parameters from env vars,
 -- files or db settings.
@@ -212,26 +205,26 @@ parser :: Maybe FilePath -> Environment -> [(Text, Text)] -> C.Parser C.Config A
 parser optPath env dbSettings =
   AppConfig
     <$> parseAppSettings "app.settings"
-    <*> optString "db-anon-role"
+    <*> reqString "db-anon-role"
     <*> (fromMaybe "pgrst" <$> optString "db-channel")
     <*> (fromMaybe True <$> optBool "db-channel-enabled")
     <*> (maybe ["public"] splitOnCommas <$> optValue "db-extra-search-path")
     <*> optWithAlias (optInt "db-max-rows")
                      (optInt "max-rows")
-    <*> (fromMaybe False <$> optBool "db-plan-enabled")
     <*> (fromMaybe 10 <$> optInt "db-pool")
-    <*> (fromIntegral . fromMaybe 3600 <$> optInt "db-pool-timeout")
+    <*> (fromIntegral . fromMaybe 10 <$> optInt "db-pool-timeout")
     <*> (fmap toQi <$> optWithAlias (optString "db-pre-request")
                                     (optString "pre-request"))
     <*> (fromMaybe True <$> optBool "db-prepared-statements")
     <*> (fmap toQi <$> optWithAlias (optString "db-root-spec")
                                     (optString "root-spec"))
-    <*> (fromList . maybe ["public"] splitOnCommas <$> optWithAlias (optValue "db-schemas")
+    <*> (fromList . splitOnCommas <$> reqWithAlias (optValue "db-schemas")
-                                                                    (optValue "db-schema"))
+                                                   (optValue "db-schema")
+                                                   "missing key: either db-schemas or db-schema must be set")
     <*> (fromMaybe True <$> optBool "db-config")
     <*> parseTxEnd "db-tx-end" snd
     <*> parseTxEnd "db-tx-end" fst
-    <*> (fromMaybe "postgresql://" <$> optString "db-uri")
+    <*> reqString "db-uri"
     <*> (fromMaybe True <$> optBool "db-use-legacy-gucs")
     <*> pure optPath
     <*> pure Nothing
@@ -243,14 +236,12 @@ parser optPath env dbSettings =
           (optBool "secret-is-base64"))
     <*> parseLogLevel "log-level"
     <*> parseOpenAPIMode "openapi-mode"
-    <*> (fromMaybe False <$> optBool "openapi-security-active")
     <*> parseOpenAPIServerProxyURI "openapi-server-proxy-uri"
-    <*> (maybe [] (fmap (MTOther . encodeUtf8) . splitOnCommas) <$> optValue "raw-media-types")
+    <*> (maybe [] (fmap encodeUtf8 . splitOnCommas) <$> optValue "raw-media-types")
     <*> (fromMaybe "!4" <$> optString "server-host")
     <*> (fromMaybe 3000 <$> optInt "server-port")
     <*> (fmap T.unpack <$> optString "server-unix-socket")
     <*> parseSocketFileMode "server-unix-socket-mode"
-    <*> optInt "admin-server-port"
   where
     parseAppSettings :: C.Key -> C.Parser C.Config [(Text, Text)]
     parseAppSettings key = addFromEnv . fmap (fmap coerceText) <$> C.subassocs key C.value
@@ -323,12 +314,24 @@ parser optPath env dbSettings =
         Nothing  -> pure [JSPKey "role"]
         Just rck -> either (fail . show) pure $ pRoleClaimKey rck
 
+    reqWithAlias :: C.Parser C.Config (Maybe a) -> C.Parser C.Config (Maybe a) -> [Char] -> C.Parser C.Config a
+    reqWithAlias orig alias err =
+      orig >>= \case
+        Just v  -> pure v
+        Nothing ->
+          alias >>= \case
+            Just v  -> pure v
+            Nothing -> fail err
+
     optWithAlias :: C.Parser C.Config (Maybe a) -> C.Parser C.Config (Maybe a) -> C.Parser C.Config (Maybe a)
     optWithAlias orig alias =
       orig >>= \case
         Just v  -> pure $ Just v
         Nothing -> alias
 
+    reqString :: C.Key -> C.Parser C.Config Text
+    reqString k = overrideFromDbOrEnvironment C.required k coerceText
+
     optString :: C.Key -> C.Parser C.Config (Maybe Text)
     optString k = mfilter (/= "") <$> overrideFromDbOrEnvironment C.optional k coerceText
 
@@ -355,8 +358,8 @@ parser optPath env 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",
+            "server_host", "server_port", "server_unix_socket", "server_unix_socket_mode", "log_level",
-            "db_uri", "db_channel_enabled", "db_channel", "db_pool", "db_pool_timeout", "db_config"]
+            "db_anon_role", "db_uri", "db_channel_enabled", "db_channel", "db_pool", "db_pool_timeout", "db_config"]
           then lookup dbSettingName dbSettings
           else Nothing
 

src/PostgREST/Config/Database.hs

@@ -10,6 +10,7 @@ import PostgREST.Config.PgVersion (PgVersion (..))
 
 import qualified Hasql.Decoders             as HD
 import qualified Hasql.Encoders             as HE
+import qualified Hasql.Pool                 as SQL
 import           Hasql.Session              (Session, statement)
 import qualified Hasql.Statement            as SQL
 import qualified Hasql.Transaction          as SQL
@@ -28,10 +29,11 @@ pgVersionStatement = SQL.Statement sql HE.noParams versionRow False
     sql = "SELECT current_setting('server_version_num')::integer, current_setting('server_version')"
     versionRow = HD.singleRow $ PgVersion <$> column HD.int4 <*> column HD.text
 
-queryDbSettings :: Bool -> Session [(Text, Text)]
+queryDbSettings :: SQL.Pool -> Bool -> IO (Either SQL.UsageError [(Text, Text)])
-queryDbSettings prepared =
+queryDbSettings pool prepared =
   let transaction = if prepared then SQL.transaction else SQL.unpreparedTransaction in
-  transaction SQL.ReadCommitted SQL.Read $ SQL.statement mempty dbSettingsStatement
+  SQL.use pool . transaction SQL.ReadCommitted SQL.Read $
+    SQL.statement mempty dbSettingsStatement
 
 -- | Get db settings from the connection role. Global settings will be overridden by database specific settings.
 dbSettingsStatement :: SQL.Statement () [(Text, Text)]

src/PostgREST/Config/PgVersion.hs

@@ -9,7 +9,6 @@ module PostgREST.Config.PgVersion
   , pgVersion110
   , pgVersion112
   , pgVersion114
-  , pgVersion120
   , pgVersion121
   , pgVersion130
   , pgVersion140
@@ -51,9 +50,6 @@ pgVersion112 = PgVersion 110002 "11.2"
 pgVersion114 :: PgVersion
 pgVersion114 = PgVersion 110004 "11.4"
 
-pgVersion120 :: PgVersion
-pgVersion120 = PgVersion 120000 "12.0"
-
 pgVersion121 :: PgVersion
 pgVersion121 = PgVersion 120001 "12.1"
 

src/PostgREST/ContentType.hs

@@ -0,0 +1,64 @@
+{-# LANGUAGE DuplicateRecordFields #-}
+
+module PostgREST.ContentType
+  ( ContentType(..)
+  , toHeader
+  , toMime
+  , decodeContentType
+  ) where
+
+import qualified Data.ByteString          as BS
+import qualified Data.ByteString.Internal as BS (c2w)
+
+import Network.HTTP.Types.Header (Header, hContentType)
+
+import Protolude
+
+-- | Enumeration of currently supported response content types
+data ContentType
+  = CTApplicationJSON
+  | CTSingularJSON
+  | CTTextCSV
+  | CTTextPlain
+  | CTOpenAPI
+  | CTUrlEncoded
+  | CTOctetStream
+  | CTAny
+  | CTOther ByteString
+  deriving (Eq)
+
+-- | Convert from ContentType to a full HTTP Header
+toHeader :: ContentType -> Header
+toHeader ct = (hContentType, toMime ct <> charset)
+  where
+    charset = case ct of
+      CTOctetStream -> mempty
+      CTOther _     -> mempty
+      _             -> "; charset=utf-8"
+
+-- | Convert from ContentType to a ByteString representing the mime type
+toMime :: ContentType -> ByteString
+toMime CTApplicationJSON = "application/json"
+toMime CTTextCSV         = "text/csv"
+toMime CTTextPlain       = "text/plain"
+toMime CTOpenAPI         = "application/openapi+json"
+toMime CTSingularJSON    = "application/vnd.pgrst.object+json"
+toMime CTUrlEncoded      = "application/x-www-form-urlencoded"
+toMime CTOctetStream     = "application/octet-stream"
+toMime CTAny             = "*/*"
+toMime (CTOther ct)      = ct
+
+-- | Convert from ByteString to ContentType. Warning: discards MIME parameters
+decodeContentType :: BS.ByteString -> ContentType
+decodeContentType ct =
+  case BS.takeWhile (/= BS.c2w ';') ct of
+    "application/json"                  -> CTApplicationJSON
+    "text/csv"                          -> CTTextCSV
+    "text/plain"                        -> CTTextPlain
+    "application/openapi+json"          -> CTOpenAPI
+    "application/vnd.pgrst.object+json" -> CTSingularJSON
+    "application/vnd.pgrst.object"      -> CTSingularJSON
+    "application/x-www-form-urlencoded" -> CTUrlEncoded
+    "application/octet-stream"          -> CTOctetStream
+    "*/*"                               -> CTAny
+    ct'                                 -> CTOther ct'

src/PostgREST/DbStructure/Proc.hs

@@ -10,12 +10,11 @@ module PostgREST.DbStructure.Proc
   , RetType(..)
   , procReturnsScalar
   , procReturnsSingle
-  , procReturnsVoid
   , procTableName
   ) where
 
 import qualified Data.Aeson          as JSON
-import qualified Data.HashMap.Strict as HM
+import qualified Data.HashMap.Strict as M
 
 import PostgREST.DbStructure.Identifiers (QualifiedIdentifier (..),
                                           Schema, TableName)
@@ -43,7 +42,7 @@ data ProcDescription = ProcDescription
   , pdName        :: Text
   , pdDescription :: Maybe Text
   , pdParams      :: [ProcParam]
-  , pdReturnType  :: Maybe RetType
+  , pdReturnType  :: RetType
   , pdVolatility  :: ProcVolatility
   , pdHasVariadic :: Bool
   }
@@ -66,26 +65,21 @@ instance Ord ProcDescription where
 
 -- | 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]
+type ProcsMap = M.HashMap QualifiedIdentifier [ProcDescription]
 
 procReturnsScalar :: ProcDescription -> Bool
 procReturnsScalar proc = case proc of
-  ProcDescription{pdReturnType = Just (Single Scalar)} -> True
+  ProcDescription{pdReturnType = (Single Scalar)} -> True
-  ProcDescription{pdReturnType = Just (SetOf Scalar)}  -> True
+  ProcDescription{pdReturnType = (SetOf Scalar)}  -> True
-  _                                                    -> False
+  _                                               -> False
 
 procReturnsSingle :: ProcDescription -> Bool
 procReturnsSingle proc = case proc of
-  ProcDescription{pdReturnType = Just (Single _)} -> True
+  ProcDescription{pdReturnType = (Single _)} -> True
-  _                                               -> False
+  _                                          -> 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
+  SetOf  (Composite qi) -> Just $ qiName qi
-  Just (Single (Composite qi)) -> Just $ qiName qi
+  Single (Composite qi) -> Just $ qiName qi
-  _                            -> Nothing
+  _                     -> Nothing

src/PostgREST/DbStructure/Relationship.hs

@@ -3,62 +3,60 @@
 
 module PostgREST.DbStructure.Relationship
   ( Cardinality(..)
+  , PrimaryKey(..)
   , Relationship(..)
   , Junction(..)
-  , RelationshipsMap
+  , isSelfReference
   ) where
 
-import qualified Data.Aeson          as JSON
+import qualified Data.Aeson as JSON
-import qualified Data.HashMap.Strict as HM
 
-import PostgREST.DbStructure.Identifiers (FieldName,
+import PostgREST.DbStructure.Table (Column (..), Table (..))
-                                          QualifiedIdentifier, Schema)
 
 import Protolude
 
 
 -- | Relationship between two tables.
+--
+-- The order of the relColumns and relForeignColumns should be maintained to get the
+-- join conditions right.
+--
+-- TODO merge relColumns and relForeignColumns to a tuple or Data.Bimap
 data Relationship = Relationship
-  { relTable        :: QualifiedIdentifier
+  { relTable          :: Table
-  , relForeignTable :: QualifiedIdentifier
+  , relColumns        :: [Column]
-  , relIsSelf       :: Bool -- ^ Whether is a self relationship
+  , relForeignTable   :: Table
-  , relCardinality  :: Cardinality
+  , relForeignColumns :: [Column]
-  , relTableIsView  :: Bool
+  , relCardinality    :: Cardinality
-  , relFTableIsView :: Bool
   }
-  | ComputedRelationship
+  deriving (Eq, Generic, JSON.ToJSON)
-  { relFunction     :: QualifiedIdentifier
-  , relTable        :: QualifiedIdentifier
-  , relForeignTable :: QualifiedIdentifier
-  , relToOne        :: Bool
-  , relIsSelf       :: Bool
-  }
-  deriving (Eq, Ord, Generic, JSON.ToJSON)
 
 -- | The relationship cardinality
 -- | https://en.wikipedia.org/wiki/Cardinality_(data_modeling)
+-- TODO: missing one-to-one
 data Cardinality
-  = O2M {relCons :: FKConstraint, relColumns :: [(FieldName, FieldName)]}
+  = O2M FKConstraint -- ^ one-to-many cardinality
-  -- ^ one-to-many
+  | M2O FKConstraint -- ^ many-to-one cardinality
-  | M2O {relCons :: FKConstraint, relColumns :: [(FieldName, FieldName)]}
+  | M2M Junction     -- ^ many-to-many cardinality
-  -- ^ many-to-one
+  deriving (Eq, Generic, JSON.ToJSON)
-  | O2O {relCons :: FKConstraint, relColumns :: [(FieldName, FieldName)]}
-  -- ^ one-to-one, this is a refinement over M2O so operating on it is pretty much the same as M2O
-  | M2M Junction
-  -- ^ many-to-many
-  deriving (Eq, Ord, Generic, JSON.ToJSON)
 
 type FKConstraint = Text
 
 -- | Junction table on an M2M relationship
 data Junction = Junction
-  { junTable       :: QualifiedIdentifier
+  { junTable       :: Table
   , junConstraint1 :: FKConstraint
+  , junColumns1    :: [Column]
   , junConstraint2 :: FKConstraint
-  , junColumns1    :: [(FieldName, FieldName)]
+  , junColumns2    :: [Column]
-  , junColumns2    :: [(FieldName, FieldName)]
   }
-  deriving (Eq, Ord, Generic, JSON.ToJSON)
+  deriving (Eq, Generic, JSON.ToJSON)
 
--- | Key based on the source table and the foreign table schema
+isSelfReference :: Relationship -> Bool
-type RelationshipsMap = HM.HashMap (QualifiedIdentifier, Schema)  [Relationship]
+isSelfReference r = relTable r == relForeignTable r
+
+data PrimaryKey = PrimaryKey
+  { pkTable :: Table
+  , pkName  :: Text
+  }
+  deriving (Generic, JSON.ToJSON)

src/PostgREST/DbStructure/Table.hs

@@ -4,11 +4,10 @@
 module PostgREST.DbStructure.Table
   ( Column(..)
   , Table(..)
-  , TablesMap
+  , tableQi
   ) where
 
-import qualified Data.Aeson          as JSON
+import qualified Data.Aeson as JSON
-import qualified Data.HashMap.Strict as HM
 
 import PostgREST.DbStructure.Identifiers (FieldName,
                                           QualifiedIdentifier (..),
@@ -21,22 +20,22 @@ data Table = Table
   { tableSchema      :: Schema
   , tableName        :: TableName
   , tableDescription :: Maybe Text
-     -- TODO Find a better way to separate tables and views
-   , tableIsView     :: Bool
     -- The following fields identify what can be done on the table/view, they're not related to the privileges granted to it
   , tableInsertable  :: Bool
   , tableUpdatable   :: Bool
   , tableDeletable   :: Bool
-  , tablePKCols      :: [FieldName]
-  , tableColumns     :: [Column]
   }
   deriving (Show, Ord, Generic, JSON.ToJSON)
 
 instance Eq Table where
   Table{tableSchema=s1,tableName=n1} == Table{tableSchema=s2,tableName=n2} = s1 == s2 && n1 == n2
 
+tableQi :: Table -> QualifiedIdentifier
+tableQi Table{tableSchema=s, tableName=n} = QualifiedIdentifier s n
+
 data Column = Column
-  { colName        :: FieldName
+  { colTable       :: Table
+  , colName        :: FieldName
   , colDescription :: Maybe Text
   , colNullable    :: Bool
   , colType        :: Text
@@ -44,6 +43,13 @@ data Column = Column
   , colDefault     :: Maybe Text
   , colEnum        :: [Text]
   }
-  deriving (Eq, Show, Ord, Generic, JSON.ToJSON)
+  deriving (Ord, Generic, JSON.ToJSON)
 
-type TablesMap = HM.HashMap QualifiedIdentifier Table
+instance Eq Column where
+  Column{colTable=t1,colName=n1} == Column{colTable=t2,colName=n2} = t1 == t2 && n1 == n2
+
+data PrimaryKey = PrimaryKey
+  { pkTable :: Table
+  , pkName  :: Text
+  }
+  deriving (Generic, JSON.ToJSON)

src/PostgREST/Error.hs

@@ -29,17 +29,16 @@ import Network.Wai (Response, responseLBS)
 
 import Network.HTTP.Types.Header (Header)
 
-import           PostgREST.MediaType     (MediaType (..))
+import           PostgREST.ContentType (ContentType (..))
-import qualified PostgREST.MediaType     as MediaType
+import qualified PostgREST.ContentType as ContentType
-import           PostgREST.Request.Types (ApiRequestError (..),
-                                          QPError (..))
 
-import PostgREST.DbStructure.Identifiers  (QualifiedIdentifier (..))
 import PostgREST.DbStructure.Proc         (ProcDescription (..),
                                            ProcParam (..))
 import PostgREST.DbStructure.Relationship (Cardinality (..),
                                            Junction (..),
                                            Relationship (..))
+import PostgREST.DbStructure.Table        (Column (..), Table (..))
+
 import Protolude
 
 
@@ -53,162 +52,107 @@ class (JSON.ToJSON a) => PgrstError a where
   errorResponseFor :: a -> Response
   errorResponseFor err = responseLBS (status err) (headers err) $ errorPayload err
 
-instance PgrstError ApiRequestError where
-  status AmbiguousRelBetween{}   = HTTP.status300
-  status AmbiguousRpc{}          = HTTP.status300
-  status MediaTypeError{}        = HTTP.status415
-  status InvalidBody{}           = HTTP.status400
-  status InvalidFilters          = HTTP.status405
-  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 ParseRequestError{}     = HTTP.status400
-  status PutRangeNotAllowedError = HTTP.status400
-  status QueryParamError{}       = HTTP.status400
-  status UnacceptableSchema{}    = HTTP.status406
-  status UnsupportedMethod{}     = HTTP.status405
-  status LimitNoOrderError       = HTTP.status400
 
-  headers _ = [MediaType.toContentType MTApplicationJSON]
+
+data ApiRequestError
+  = ActionInappropriate
+  | InvalidRange
+  | InvalidBody ByteString
+  | ParseRequestError Text Text
+  | NoRelBetween Text Text
+  | AmbiguousRelBetween Text Text [Relationship]
+  | AmbiguousRpc [ProcDescription]
+  | NoRpc Text Text [Text] Bool ContentType Bool
+  | InvalidFilters
+  | UnacceptableSchema [Text]
+  | ContentTypeError [ByteString]
+  | UnsupportedVerb                -- Unreachable?
+
+instance PgrstError ApiRequestError where
+  status InvalidRange            = HTTP.status416
+  status InvalidFilters          = HTTP.status405
+  status (InvalidBody _)         = HTTP.status400
+  status UnsupportedVerb         = HTTP.status405
+  status ActionInappropriate     = HTTP.status405
+  status (ParseRequestError _ _) = HTTP.status400
+  status (NoRelBetween _ _)      = HTTP.status400
+  status AmbiguousRelBetween{}   = HTTP.status300
+  status (AmbiguousRpc _)        = HTTP.status300
+  status NoRpc{}                 = HTTP.status404
+  status (UnacceptableSchema _)  = HTTP.status406
+  status (ContentTypeError _)    = HTTP.status415
+
+  headers _ = [ContentType.toHeader CTApplicationJSON]
 
 instance JSON.ToJSON ApiRequestError where
-  toJSON (QueryParamError (QPError message details)) = JSON.object [
-    "code"    .= ApiRequestErrorCode00,
-    "message" .= message,
-    "details" .= details,
-    "hint"    .= JSON.Null]
-  toJSON (InvalidRpcMethod method) = JSON.object [
-    "code"    .= ApiRequestErrorCode01,
-    "message" .= ("Cannot use the " <> T.decodeUtf8 method <> " method on RPC"),
-    "details" .= JSON.Null,
-    "hint"    .= JSON.Null]
-  toJSON (InvalidBody errorMessage) = JSON.object [
-    "code"    .= ApiRequestErrorCode02,
-    "message" .= T.decodeUtf8 errorMessage,
-    "details" .= JSON.Null,
-    "hint"    .= JSON.Null]
-  toJSON InvalidRange = JSON.object [
-    "code"    .= ApiRequestErrorCode03,
-    "message" .= ("HTTP Range error" :: Text),
-    "details" .= JSON.Null,
-    "hint"    .= JSON.Null]
   toJSON (ParseRequestError message details) = JSON.object [
-    "code"    .= ApiRequestErrorCode04,
+    "message" .= message, "details" .= details]
-    "message" .= message,
+  toJSON ActionInappropriate = JSON.object [
-    "details" .= details,
+    "message" .= ("Bad Request" :: Text)]
-    "hint"    .= JSON.Null]
+  toJSON (InvalidBody errorMessage) = JSON.object [
-  toJSON InvalidFilters = JSON.object [
+    "message" .= T.decodeUtf8 errorMessage]
-    "code"    .= ApiRequestErrorCode05,
+  toJSON InvalidRange = JSON.object [
-    "message" .= ("Filters must include all and only primary key columns with 'eq' operators" :: Text),
+    "message" .= ("HTTP Range error" :: Text)]
-    "details" .= JSON.Null,
+  toJSON (NoRelBetween parent child) = JSON.object [
-    "hint"    .= JSON.Null]
+    "hint"    .= ("If a new foreign key between these entities was created in the database, try reloading the schema cache." :: Text),
-  toJSON (UnacceptableSchema schemas) = JSON.object [
+    "message" .= ("Could not find a relationship between " <> parent <> " and " <> child <> " in the schema cache" :: Text)]
-    "code"    .= ApiRequestErrorCode06,
-    "message" .= ("The schema must be one of the following: " <> T.intercalate ", " schemas),
-    "details" .= JSON.Null,
-    "hint"    .= JSON.Null]
-  toJSON (MediaTypeError cts)    = JSON.object [
-    "code"    .= ApiRequestErrorCode07,
-    "message" .= ("None of these media types are available: " <> T.intercalate ", " (map T.decodeUtf8 cts)),
-    "details" .= JSON.Null,
-    "hint"    .= JSON.Null]
-  toJSON NotFound = JSON.object []
-  toJSON (NotEmbedded resource) = JSON.object [
-    "code"    .= ApiRequestErrorCode08,
-    "message" .= ("Cannot apply filter because '" <> resource <> "' is not an embedded resource in this request" :: Text),
-    "details" .= JSON.Null,
-    "hint"    .= ("Verify that '" <> resource <> "' is included in the 'select' query parameter." :: Text)]
-
-  toJSON LimitNoOrderError = JSON.object [
-    "code"    .= ApiRequestErrorCode09,
-    "message" .= ("A 'limit' was applied without an explicit 'order'":: Text),
-    "details" .= JSON.Null,
-    "hint"    .= ("Apply an 'order' using unique column(s)" :: Text)]
-
-  toJSON PutRangeNotAllowedError = JSON.object [
-    "code"    .= ApiRequestErrorCode14,
-    "message" .= ("Range header and limit/offset querystring parameters are not allowed for PUT" :: Text),
-    "details" .= JSON.Null,
-    "hint"    .= JSON.Null]
-
-  toJSON (UnsupportedMethod method) = JSON.object [
-    "code"    .= ApiRequestErrorCode17,
-    "message" .= ("Unsupported HTTP method: " <> T.decodeUtf8 method),
-    "details" .= JSON.Null,
-    "hint"    .= JSON.Null]
-
-  toJSON (NoRelBetween parent child schema) = JSON.object [
-    "code"    .= SchemaCacheErrorCode00,
-    "message" .= ("Could not find a relationship between '" <> parent <> "' and '" <> child <> "' in the schema cache" :: Text),
-    "details" .= JSON.Null,
-    "hint"    .= ("Verify that '" <> parent <> "' and '" <> child <> "' exist in the schema '" <> schema <> "' and that there is a foreign key relationship between them. If a new relationship was created, try reloading the schema cache." :: Text)]
   toJSON (AmbiguousRelBetween parent child rels) = JSON.object [
-    "code"    .= SchemaCacheErrorCode01,
+    "hint"    .= ("Try changing '" <> child <> "' to one of the following: " <> relHint rels <> ". Find the desired relationship in the 'details' key." :: Text),
     "message" .= ("Could not embed because more than one relationship was found for '" <> parent <> "' and '" <> child <> "'" :: Text),
-    "details" .= (compressedRel <$> rels),
+    "details" .= (compressedRel <$> rels) ]
-    "hint"    .= ("Try changing '" <> child <> "' to one of the following: " <> relHint rels <> ". Find the desired relationship in the 'details' key." :: Text)]
+  toJSON (AmbiguousRpc procs)  = JSON.object [
+    "hint"    .= ("Try renaming the parameters or the function itself in the database so function overloading can be resolved" :: Text),
+    "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])]
   toJSON (NoRpc schema procName argumentKeys hasPreferSingleObject contentType isInvPost)  =
     let prms = "(" <> T.intercalate ", " argumentKeys <> ")" in JSON.object [
-    "code"    .= SchemaCacheErrorCode02,
+    "hint"    .= ("If a new function was created in the database with this name and parameters, try reloading the schema cache." :: Text),
     "message" .= ("Could not find the " <> schema <> "." <> procName <>
       (case (hasPreferSingleObject, isInvPost, contentType) of
         (True, _, _)                 -> " function with a single json or jsonb parameter"
-        (_, True, MTTextPlain)       -> " function with a single unnamed text parameter"
+        (_, True, CTTextPlain)       -> " function with a single unnamed text parameter"
-        (_, True, MTTextXML)         -> " function with a single unnamed xml parameter"
+        (_, True, CTOctetStream)     -> " function with a single unnamed bytea parameter"
-        (_, True, MTOctetStream)     -> " function with a single unnamed bytea parameter"
+        (_, True, CTApplicationJSON) -> prms <> " function or the " <> schema <> "." <> procName <>" function with a single unnamed json or jsonb parameter"
-        (_, True, MTApplicationJSON) -> prms <> " function or the " <> schema <> "." <> procName <>" function with a single unnamed json or jsonb parameter"
         _                            -> prms <> " function") <>
-      " in the schema cache"),
+      " in the schema cache")]
-    "details" .= JSON.Null,
+  toJSON UnsupportedVerb = JSON.object [
-    "hint"    .= ("If a new function was created in the database with this name and parameters, try reloading the schema cache." :: Text)]
+    "message" .= ("Unsupported HTTP verb" :: Text)]
-  toJSON (AmbiguousRpc procs)  = JSON.object [
+  toJSON InvalidFilters = JSON.object [
-    "code"    .= SchemaCacheErrorCode03,
+    "message" .= ("Filters must include all and only primary key columns with 'eq' operators" :: Text)]
-    "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]),
+  toJSON (UnacceptableSchema schemas) = JSON.object [
-    "details" .= JSON.Null,
+    "message" .= ("The schema must be one of the following: " <> T.intercalate ", " schemas)]
-    "hint"    .= ("Try renaming the parameters or the function itself in the database so function overloading can be resolved" :: Text)]
+  toJSON (ContentTypeError cts)    = JSON.object [
+    "message" .= ("None of these Content-Types are available: " <> T.intercalate ", " (map T.decodeUtf8 cts))]
 
 compressedRel :: Relationship -> JSON.Value
--- An ambiguousness error cannot happen for computed relationships TODO refactor so this mempty is not needed
-compressedRel ComputedRelationship{} = JSON.object mempty
 compressedRel Relationship{..} =
   let
     fmtEls els = "(" <> T.intercalate ", " els <> ")"
   in
   JSON.object $
-    ("embedding" .= (qiName relTable <> " with " <> qiName relForeignTable :: Text))
+    ("embedding" .= (tableName relTable <> " with " <> tableName relForeignTable :: Text))
     : case relCardinality of
         M2M Junction{..} -> [
             "cardinality" .= ("many-to-many" :: Text)
-          , "relationship" .= (qiName junTable <> " using " <> junConstraint1 <> fmtEls (snd <$> junColumns1) <> " and " <> junConstraint2 <> fmtEls (snd <$> junColumns2))
+          , "relationship" .= (tableName junTable <> " using " <> junConstraint1 <> fmtEls (colName <$> junColumns1) <> " and " <> junConstraint2 <> fmtEls (colName <$> junColumns2))
           ]
-        M2O cons relColumns -> [
+        M2O cons -> [
             "cardinality" .= ("many-to-one" :: Text)
-          , "relationship" .= (cons <> " using " <> qiName relTable <> fmtEls (fst <$> relColumns) <> " and " <> qiName relForeignTable <> fmtEls (snd <$> relColumns))
+          , "relationship" .= (cons <> " using " <> tableName relTable <> fmtEls (colName <$> relColumns) <> " and " <> tableName relForeignTable <> fmtEls (colName <$> relForeignColumns))
           ]
-        O2O cons relColumns -> [
+        O2M cons -> [
-            "cardinality" .= ("one-to-one" :: Text)
-          , "relationship" .= (cons <> " using " <> qiName relTable <> fmtEls (fst <$> relColumns) <> " and " <> qiName relForeignTable <> fmtEls (snd <$> relColumns))
-          ]
-        O2M cons relColumns -> [
             "cardinality" .= ("one-to-many" :: Text)
-          , "relationship" .= (cons <> " using " <> qiName relTable <> fmtEls (fst <$> relColumns) <> " and " <> qiName relForeignTable <> fmtEls (snd <$> relColumns))
+          , "relationship" .= (cons <> " using " <> tableName relTable <> fmtEls (colName <$> relColumns) <> " and " <> tableName relForeignTable <> fmtEls (colName <$> relForeignColumns))
           ]
 
 relHint :: [Relationship] -> Text
 relHint rels = T.intercalate ", " (hintList <$> rels)
   where
     hintList Relationship{..} =
-      let buildHint rel = "'" <> qiName relForeignTable <> "!" <> rel <> "'" in
+      let buildHint rel = "'" <> tableName relForeignTable <> "!" <> rel <> "'" in
       case relCardinality of
-        M2M Junction{..} -> buildHint (qiName junTable)
+        M2M Junction{..} -> buildHint (tableName junTable)
-        M2O cons _       -> buildHint cons
+        M2O cons         -> buildHint cons
-        O2O cons _       -> buildHint cons
+        O2M cons         -> buildHint cons
-        O2M cons _       -> buildHint cons
-    -- An ambiguousness error cannot happen for computed relationships TODO refactor so this mempty is not needed
-    hintList ComputedRelationship{} = mempty
 
 data PgError = PgError Authenticated SQL.UsageError
 type Authenticated = Bool
@@ -218,41 +162,54 @@ instance PgrstError PgError where
 
   headers err =
     if status err == HTTP.status401
-       then [MediaType.toContentType MTApplicationJSON, ("WWW-Authenticate", "Bearer") :: Header]
+       then [ContentType.toHeader CTApplicationJSON, ("WWW-Authenticate", "Bearer") :: Header]
-       else [MediaType.toContentType MTApplicationJSON]
+       else [ContentType.toHeader CTApplicationJSON]
 
 instance JSON.ToJSON PgError where
   toJSON (PgError _ usageError) = JSON.toJSON usageError
 
 instance JSON.ToJSON SQL.UsageError where
   toJSON (SQL.ConnectionError e) = JSON.object [
-    "code"    .= ConnectionErrorCode00,
+    "code"    .= ("" :: Text),
     "message" .= ("Database connection error. Retrying the connection." :: Text),
-    "details" .= (T.decodeUtf8With T.lenientDecode $ fromMaybe "" e :: Text),
+    "details" .= (T.decodeUtf8With T.lenientDecode $ fromMaybe "" e :: Text)]
-    "hint"    .= JSON.Null]
   toJSON (SQL.SessionError e) = JSON.toJSON e -- SQL.Error
 
 instance JSON.ToJSON SQL.QueryError where
   toJSON (SQL.QueryError _ _ e) = JSON.toJSON e
 
 instance JSON.ToJSON SQL.CommandError where
-  toJSON (SQL.ResultError (SQL.ServerError c m d h)) = JSON.object [
+  toJSON (SQL.ResultError (SQL.ServerError c m d h)) = case BS.unpack c of
-    "code"    .= (T.decodeUtf8 c      :: Text),
+    'P':'T':_ -> JSON.object [
-    "message" .= (T.decodeUtf8 m      :: Text),
+        "details" .= fmap T.decodeUtf8 d,
-    "details" .= (fmap T.decodeUtf8 d :: Maybe Text),
+        "hint"    .= fmap T.decodeUtf8 h]
-    "hint"    .= (fmap T.decodeUtf8 h :: Maybe Text)]
 
-  toJSON (SQL.ResultError resultError) = JSON.object [
+    _         -> JSON.object [
-    "code"    .= InternalErrorCode00,
+        "code"    .= (T.decodeUtf8 c      :: Text),
-    "message" .= (show resultError :: Text),
+        "message" .= (T.decodeUtf8 m      :: Text),
-    "details" .= JSON.Null,
+        "details" .= (fmap T.decodeUtf8 d :: Maybe Text),
-    "hint"    .= JSON.Null]
+        "hint"    .= (fmap T.decodeUtf8 h :: Maybe Text)]
 
+  toJSON (SQL.ResultError (SQL.UnexpectedResult m)) = JSON.object [
+    "message" .= (m :: Text)]
+  toJSON (SQL.ResultError (SQL.RowError i SQL.EndOfInput)) = JSON.object [
+    "message" .= ("Row error: end of input" :: Text),
+    "details" .= ("Attempt to parse more columns than there are in the result" :: Text),
+    "hint"    .= (("Row number " <> show i) :: Text)]
+  toJSON (SQL.ResultError (SQL.RowError i SQL.UnexpectedNull)) = JSON.object [
+    "message" .= ("Row error: unexpected null" :: Text),
+    "details" .= ("Attempt to parse a NULL as some value." :: Text),
+    "hint"    .= (("Row number " <> show i) :: Text)]
+  toJSON (SQL.ResultError (SQL.RowError i (SQL.ValueError d))) = JSON.object [
+    "message" .= ("Row error: Wrong value parser used" :: Text),
+    "details" .= d,
+    "hint"    .= (("Row number " <> show i) :: Text)]
+  toJSON (SQL.ResultError (SQL.UnexpectedAmountOfRows i)) = JSON.object [
+    "message" .= ("Unexpected amount of rows" :: Text),
+    "details" .= i]
   toJSON (SQL.ClientError d) = JSON.object [
-    "code"    .= ConnectionErrorCode01,
     "message" .= ("Database client error. Retrying the connection." :: Text),
-    "details" .= (fmap T.decodeUtf8 d :: Maybe Text),
+    "details" .= (fmap T.decodeUtf8 d :: Maybe Text)]
-    "hint"    .= JSON.Null]
 
 pgErrorStatus :: Bool -> SQL.UsageError -> HTTP.Status
 pgErrorStatus _      (SQL.ConnectionError _)                                      = HTTP.status503
@@ -285,9 +242,7 @@ pgErrorStatus authed (SQL.SessionError (SQL.QueryError _ _ (SQL.ResultError rErr
         "P0001"   -> HTTP.status400 -- default code for "raise"
         'P':'0':_ -> HTTP.status500 -- PL/pgSQL Error
         'X':'X':_ -> HTTP.status500 -- internal Error
-        "42883"-> if BS.isPrefixOf "function xmlagg(" m
+        "42883"   -> HTTP.status404 -- undefined function
-          then HTTP.status406
-          else HTTP.status404 -- undefined function
         "42P01"   -> HTTP.status404 -- undefined table
         "42501"   -> if authed then HTTP.status403 else HTTP.status401 -- insufficient privilege
         'P':'T':n -> fromMaybe HTTP.status500 (HTTP.mkStatus <$> readMaybe n <*> pure m)
@@ -321,97 +276,63 @@ checkIsFatal _ = Nothing
 
 
 data Error
-  = ApiRequestError ApiRequestError
+  = GucHeadersError
-  | BinaryFieldError MediaType
-  | GucHeadersError
   | GucStatusError
-  | JwtTokenInvalid Text
+  | BinaryFieldError ContentType
-  | JwtTokenMissing
+  | ConnectionLostError
-  | JwtTokenRequired
-  | NoSchemaCacheError
-  | OffLimitsChangesError Int64 Integer
-  | PgErr PgError
   | PutMatchingPkError
+  | PutRangeNotAllowedError
+  | JwtTokenMissing
+  | JwtTokenInvalid Text
   | SingularityError Integer
+  | NotFound
+  | ApiRequestError ApiRequestError
+  | PgErr PgError
 
 instance PgrstError Error where
-  status (ApiRequestError err)   = status err
-  status BinaryFieldError{}      = HTTP.status406
   status GucHeadersError         = HTTP.status500
   status GucStatusError          = HTTP.status500
-  status JwtTokenInvalid{}       = HTTP.unauthorized401
+  status (BinaryFieldError _)    = HTTP.status406
-  status JwtTokenMissing         = HTTP.status500
+  status ConnectionLostError     = HTTP.status503
-  status JwtTokenRequired        = HTTP.unauthorized401
-  status NoSchemaCacheError      = HTTP.status503
-  status OffLimitsChangesError{} = HTTP.status400
-  status (PgErr err)             = status err
   status PutMatchingPkError      = HTTP.status400
-  status SingularityError{}      = HTTP.status406
+  status PutRangeNotAllowedError = HTTP.status400
+  status JwtTokenMissing         = HTTP.status500
+  status (JwtTokenInvalid _)     = HTTP.unauthorized401
+  status (SingularityError _)    = HTTP.status406
+  status NotFound                = HTTP.status404
+  status (PgErr err)             = status err
+  status (ApiRequestError err)   = status err
 
-  headers (ApiRequestError err)  = headers err
+  headers (SingularityError _)     = [ContentType.toHeader CTSingularJSON]
-  headers (JwtTokenInvalid m)    = [MediaType.toContentType MTApplicationJSON, invalidTokenHeader m]
+  headers (JwtTokenInvalid m)      = [ContentType.toHeader CTApplicationJSON, invalidTokenHeader m]
-  headers JwtTokenRequired       = [MediaType.toContentType MTApplicationJSON, requiredTokenHeader]
+  headers (PgErr err)              = headers err
-  headers (PgErr err)            = headers err
+  headers (ApiRequestError err)    = headers err
-  headers SingularityError{}     = [MediaType.toContentType MTSingularJSON]
+  headers _                        = [ContentType.toHeader CTApplicationJSON]
-  headers _                      = [MediaType.toContentType MTApplicationJSON]
 
 instance JSON.ToJSON Error where
-  toJSON NoSchemaCacheError = JSON.object [
+  toJSON GucHeadersError           = JSON.object [
-      "code"    .= ConnectionErrorCode02,
+    "message" .= ("response.headers guc must be a JSON array composed of objects with a single key and a string value" :: Text)]
-      "message" .= ("Could not query the database for the schema cache. Retrying." :: Text),
+  toJSON GucStatusError           = JSON.object [
-      "details" .= JSON.Null,
+    "message" .= ("response.status guc must be a valid status code" :: Text)]
-      "hint"    .= JSON.Null]
+  toJSON (BinaryFieldError ct)          = JSON.object [
+    "message" .= ((T.decodeUtf8 (ContentType.toMime ct) <> " requested but more than one column was selected") :: Text)]
+  toJSON ConnectionLostError       = JSON.object [
+    "message" .= ("Database connection lost. Retrying the connection." :: Text)]
 
-  toJSON JwtTokenMissing = JSON.object [
+  toJSON PutRangeNotAllowedError   = JSON.object [
-      "code"    .= JWTErrorCode00,
+    "message" .= ("Range header and limit/offset querystring parameters are not allowed for PUT" :: Text)]
-      "message" .= ("Server lacks JWT secret" :: Text),
+  toJSON PutMatchingPkError        = JSON.object [
-      "details" .= JSON.Null,
+    "message" .= ("Payload values do not match URL in primary key column(s)" :: Text)]
-      "hint"    .= JSON.Null]
-  toJSON (JwtTokenInvalid message) = JSON.object [
-      "code"    .= JWTErrorCode01,
-      "message" .= (message :: Text),
-      "details" .= JSON.Null,
-      "hint"    .= JSON.Null]
-  toJSON JwtTokenRequired = JSON.object [
-      "code"    .= JWTErrorCode02,
-      "message" .= ("Anonymous access is disabled" :: Text),
-      "details" .= JSON.Null,
-      "hint"    .= JSON.Null]
 
-  toJSON (OffLimitsChangesError n maxs) = JSON.object [
+  toJSON (SingularityError n)      = JSON.object [
-      "code"    .= ApiRequestErrorCode10,
-      "message" .= ("The maximum number of rows allowed to change was surpassed" :: Text),
-      "details" .= T.unwords ["Results contain", show n, "rows changed but the maximum number allowed is", show maxs],
-      "hint"    .= JSON.Null]
-
-  toJSON GucHeadersError = JSON.object [
-    "code"    .= ApiRequestErrorCode11,
-    "message" .= ("response.headers guc must be a JSON array composed of objects with a single key and a string value" :: Text),
-    "details" .= JSON.Null,
-    "hint"    .= JSON.Null]
-  toJSON GucStatusError = JSON.object [
-    "code"    .= ApiRequestErrorCode12,
-    "message" .= ("response.status guc must be a valid status code" :: Text),
-    "details" .= JSON.Null,
-    "hint"    .= JSON.Null]
-  toJSON (BinaryFieldError ct) = JSON.object [
-    "code"    .= ApiRequestErrorCode13,
-    "message" .= ((T.decodeUtf8 (MediaType.toMime ct) <> " requested but more than one column was selected") :: Text),
-    "details" .= JSON.Null,
-    "hint"    .= JSON.Null]
-
-  toJSON PutMatchingPkError = JSON.object [
-    "code"    .= ApiRequestErrorCode15,
-    "message" .= ("Payload values do not match URL in primary key column(s)" :: Text),
-    "details" .= JSON.Null,
-    "hint"    .= JSON.Null]
-
-  toJSON (SingularityError n) = JSON.object [
-    "code"    .= ApiRequestErrorCode16,
     "message" .= ("JSON object requested, multiple (or no) rows returned" :: Text),
-    "details" .= T.unwords ["Results contain", show n, "rows,", T.decodeUtf8 (MediaType.toMime MTSingularJSON), "requires 1 row"],
+    "details" .= T.unwords ["Results contain", show n, "rows,", T.decodeUtf8 (ContentType.toMime CTSingularJSON), "requires 1 row"]]
-    "hint"    .= JSON.Null]
 
+  toJSON JwtTokenMissing           = JSON.object [
+    "message" .= ("Server lacks JWT secret" :: Text)]
+  toJSON (JwtTokenInvalid message) = JSON.object [
+    "message" .= (message :: Text)]
+  toJSON NotFound = JSON.object []
   toJSON (PgErr err) = JSON.toJSON err
   toJSON (ApiRequestError err) = JSON.toJSON err
 
@@ -419,86 +340,5 @@ invalidTokenHeader :: Text -> Header
 invalidTokenHeader m =
   ("WWW-Authenticate", "Bearer error=\"invalid_token\", " <> "error_description=" <> encodeUtf8 (show m))
 
-requiredTokenHeader :: Header
-requiredTokenHeader = ("WWW-Authenticate", "Bearer")
-
 singularityError :: (Integral a) => a -> Error
 singularityError = SingularityError . toInteger
-
--- Error codes are grouped by common modules or characteristics
-data ErrorCode
-  -- PostgreSQL connection errors
-  = ConnectionErrorCode00
-  | ConnectionErrorCode01
-  | ConnectionErrorCode02
-  -- API Request errors
-  | ApiRequestErrorCode00
-  | ApiRequestErrorCode01
-  | ApiRequestErrorCode02
-  | ApiRequestErrorCode03
-  | ApiRequestErrorCode04
-  | ApiRequestErrorCode05
-  | ApiRequestErrorCode06
-  | ApiRequestErrorCode07
-  | ApiRequestErrorCode08
-  | ApiRequestErrorCode09
-  | ApiRequestErrorCode10
-  | ApiRequestErrorCode11
-  | ApiRequestErrorCode12
-  | ApiRequestErrorCode13
-  | ApiRequestErrorCode14
-  | ApiRequestErrorCode15
-  | ApiRequestErrorCode16
-  | ApiRequestErrorCode17
-  -- Schema Cache errors
-  | SchemaCacheErrorCode00
-  | SchemaCacheErrorCode01
-  | SchemaCacheErrorCode02
-  | SchemaCacheErrorCode03
-  -- JWT authentication errors
-  | JWTErrorCode00
-  | JWTErrorCode01
-  | JWTErrorCode02
-  -- Internal errors related to the Hasql library
-  | InternalErrorCode00
-
-instance JSON.ToJSON ErrorCode where
-  toJSON e = JSON.toJSON (buildErrorCode e)
-
--- New group of errors will be added at the end of all the groups and will have the next prefix in the sequence
--- New errors are added at the end of the group they belong to and will have the next code in the sequence
-buildErrorCode :: ErrorCode -> Text
-buildErrorCode code = "PGRST" <> case code of
-  ConnectionErrorCode00  -> "000"
-  ConnectionErrorCode01  -> "001"
-  ConnectionErrorCode02  -> "002"
-
-  ApiRequestErrorCode00  -> "100"
-  ApiRequestErrorCode01  -> "101"
-  ApiRequestErrorCode02  -> "102"
-  ApiRequestErrorCode03  -> "103"
-  ApiRequestErrorCode04  -> "104"
-  ApiRequestErrorCode05  -> "105"
-  ApiRequestErrorCode06  -> "106"
-  ApiRequestErrorCode07  -> "107"
-  ApiRequestErrorCode08  -> "108"
-  ApiRequestErrorCode09  -> "109"
-  ApiRequestErrorCode10  -> "110"
-  ApiRequestErrorCode11  -> "111"
-  ApiRequestErrorCode12  -> "112"
-  ApiRequestErrorCode13  -> "113"
-  ApiRequestErrorCode14  -> "114"
-  ApiRequestErrorCode15  -> "115"
-  ApiRequestErrorCode16  -> "116"
-  ApiRequestErrorCode17  -> "117"
-
-  SchemaCacheErrorCode00 -> "200"
-  SchemaCacheErrorCode01 -> "201"
-  SchemaCacheErrorCode02 -> "202"
-  SchemaCacheErrorCode03 -> "203"
-
-  JWTErrorCode00         -> "300"
-  JWTErrorCode01         -> "301"
-  JWTErrorCode02         -> "302"
-
-  InternalErrorCode00    -> "X00"

src/PostgREST/GucHeader.hs

@@ -5,9 +5,8 @@ module PostgREST.GucHeader
   ) where
 
 import qualified Data.Aeson           as JSON
-import qualified Data.Aeson.Key       as K
-import qualified Data.Aeson.KeyMap    as KM
 import qualified Data.CaseInsensitive as CI
+import qualified Data.HashMap.Strict  as M
 
 import Network.HTTP.Types.Header (Header)
 
@@ -22,8 +21,8 @@ newtype GucHeader = GucHeader (CI.CI ByteString, ByteString)
 
 instance JSON.FromJSON GucHeader where
   parseJSON (JSON.Object o) =
-    case KM.toList o of
+    case M.toList o of
-      [(k, JSON.String s)] -> pure $ GucHeader (CI.mk $ toUtf8 $ K.toText k, toUtf8 s)
+      [(k, JSON.String s)] -> pure $ GucHeader (CI.mk $ toUtf8 k, toUtf8 s)
       _ -> mzero
   parseJSON _ = mzero
 

src/PostgREST/Logger.hs

@@ -10,8 +10,7 @@ import qualified Network.Wai.Middleware.RequestLogger as Wai
 import Network.HTTP.Types.Status (status400, status500)
 import System.IO.Unsafe          (unsafePerformIO)
 
-import qualified PostgREST.Auth   as Auth
+import PostgREST.Config (LogLevel (..))
-import           PostgREST.Config (LogLevel (..))
 
 import Protolude
 
@@ -26,5 +25,4 @@ middleware logLevel = case logLevel of
       { Wai.outputFormat = Wai.ApacheWithSettings $
           Wai.defaultApacheSettings
             & Wai.setApacheRequestFilter (\_ res -> filterStatus $ Wai.responseStatus res)
-            & Wai.setApacheUserGetter (fmap encodeUtf8 . Auth.getRole)
       }

src/PostgREST/MediaType.hs

@@ -1,124 +0,0 @@
-{-# LANGUAGE DuplicateRecordFields #-}
-
-module PostgREST.MediaType
-  ( MediaType(..)
-  , MTPlanOption (..)
-  , MTPlanFormat (..)
-  , MTPlanAttrs(..)
-  , toContentType
-  , toMime
-  , decodeMediaType
-  , getMediaType
-  ) where
-
-import qualified Data.ByteString          as BS
-import qualified Data.ByteString.Internal as BS (c2w)
-import           Data.Maybe               (fromJust)
-
-import Network.HTTP.Types.Header (Header, hContentType)
-
-import Protolude
-
--- | Enumeration of currently supported media types
-data MediaType
-  = MTApplicationJSON
-  | MTSingularJSON
-  | MTGeoJSON
-  | MTTextCSV
-  | MTTextPlain
-  | MTTextXML
-  | MTOpenAPI
-  | MTUrlEncoded
-  | MTOctetStream
-  | MTAny
-  | MTOther ByteString
-  | MTPlan MTPlanAttrs
-  deriving Eq
-
-data MTPlanAttrs = MTPlanAttrs (Maybe MediaType) MTPlanFormat [MTPlanOption]
-instance Eq MTPlanAttrs where
-  MTPlanAttrs {} == MTPlanAttrs {} = True -- we don't care about the attributes when comparing two MTPlan media types
-
-data MTPlanOption
-  = PlanAnalyze | PlanVerbose | PlanSettings | PlanBuffers | PlanWAL
-
-data MTPlanFormat
-  = PlanJSON | PlanText
-
--- | Convert MediaType to a Content-Type HTTP Header
-toContentType :: MediaType -> Header
-toContentType ct = (hContentType, toMime ct <> charset)
-  where
-    charset = case ct of
-      MTOctetStream -> mempty
-      MTOther _     -> mempty
-      _             -> "; charset=utf-8"
-
--- | Convert from MediaType to a ByteString representing the mime type
-toMime :: MediaType -> ByteString
-toMime MTApplicationJSON = "application/json"
-toMime MTGeoJSON         = "application/geo+json"
-toMime MTTextCSV         = "text/csv"
-toMime MTTextPlain       = "text/plain"
-toMime MTTextXML         = "text/xml"
-toMime MTOpenAPI         = "application/openapi+json"
-toMime MTSingularJSON    = "application/vnd.pgrst.object+json"
-toMime MTUrlEncoded      = "application/x-www-form-urlencoded"
-toMime MTOctetStream     = "application/octet-stream"
-toMime MTAny             = "*/*"
-toMime (MTOther ct)      = ct
-toMime (MTPlan (MTPlanAttrs mt fmt opts)) =
-  "application/vnd.pgrst.plan+" <> toMimePlanFormat fmt <>
-  (if isNothing mt then mempty else "; for=\"" <> toMime (fromJust mt) <> "\"") <>
-  (if null opts then mempty else "; options=" <> BS.intercalate "|" (toMimePlanOption <$> opts))
-
-toMimePlanOption :: MTPlanOption -> ByteString
-toMimePlanOption PlanAnalyze  = "analyze"
-toMimePlanOption PlanVerbose  = "verbose"
-toMimePlanOption PlanSettings = "settings"
-toMimePlanOption PlanBuffers  = "buffers"
-toMimePlanOption PlanWAL      = "wal"
-
-toMimePlanFormat :: MTPlanFormat -> ByteString
-toMimePlanFormat PlanJSON = "json"
-toMimePlanFormat PlanText = "text"
-
--- | Convert from ByteString to MediaType. Warning: discards MIME parameters
-decodeMediaType :: BS.ByteString -> MediaType
-decodeMediaType mt =
-  case BS.split (BS.c2w ';') mt of
-    "application/json":_                   -> MTApplicationJSON
-    "application/geo+json":_               -> MTGeoJSON
-    "text/csv":_                           -> MTTextCSV
-    "text/plain":_                         -> MTTextPlain
-    "text/xml":_                           -> MTTextXML
-    "application/openapi+json":_           -> MTOpenAPI
-    "application/vnd.pgrst.object+json":_  -> MTSingularJSON
-    "application/vnd.pgrst.object":_       -> MTSingularJSON
-    "application/x-www-form-urlencoded":_  -> MTUrlEncoded
-    "application/octet-stream":_           -> MTOctetStream
-    "application/vnd.pgrst.plan":rest      -> getPlan PlanText rest
-    "application/vnd.pgrst.plan+text":rest -> getPlan PlanText rest
-    "application/vnd.pgrst.plan+json":rest -> getPlan PlanJSON rest
-    "*/*":_                                -> MTAny
-    other:_                                -> MTOther other
-    _                                      -> MTAny
-  where
-    getPlan fmt rest =
-     let
-       opts         = BS.split (BS.c2w '|') $ fromMaybe mempty (BS.stripPrefix "options=" =<< find (BS.isPrefixOf "options=") rest)
-       inOpts str   = str `elem` opts
-       mtFor        = decodeMediaType . dropAround (== BS.c2w '"') <$> (BS.stripPrefix "for=" =<< find (BS.isPrefixOf "for=") rest)
-       dropAround p = BS.dropWhile p . BS.dropWhileEnd p in
-     MTPlan $ MTPlanAttrs mtFor fmt $
-      [PlanAnalyze  | inOpts "analyze" ] ++
-      [PlanVerbose  | inOpts "verbose" ] ++
-      [PlanSettings | inOpts "settings"] ++
-      [PlanBuffers  | inOpts "buffers" ] ++
-      [PlanWAL      | inOpts "wal"     ]
-
-getMediaType :: MediaType -> MediaType
-getMediaType mt = case mt of
-  MTPlan (MTPlanAttrs (Just mType) _ _) -> mType
-  MTPlan (MTPlanAttrs Nothing _ _)      -> MTApplicationJSON
-  other                                 -> other

src/PostgREST/Middleware.hs

@@ -10,10 +10,9 @@ module PostgREST.Middleware
   ) where
 
 import qualified Data.Aeson                        as JSON
-import qualified Data.Aeson.Key                    as K
-import qualified Data.Aeson.KeyMap                 as KM
 import qualified Data.ByteString.Lazy.Char8        as LBS
-import qualified Data.HashMap.Strict               as HM
+import qualified Data.HashMap.Strict               as M
+import qualified Data.Text                         as T
 import qualified Data.Text.Encoding                as T
 import qualified Hasql.Decoders                    as HD
 import qualified Hasql.DynamicStatements.Snippet   as SQL hiding (sql)
@@ -21,7 +20,6 @@ import qualified Hasql.DynamicStatements.Statement as SQL
 import qualified Hasql.Transaction                 as SQL
 import qualified Network.Wai                       as Wai
 
-
 import Control.Arrow ((***))
 
 import Data.Scientific (FPFormat (..), formatScientific, isInteger)
@@ -31,7 +29,7 @@ import PostgREST.Config.PgVersion   (PgVersion (..), pgVersion140)
 import PostgREST.Error              (Error, errorResponseFor)
 import PostgREST.GucHeader          (addHeadersIfNotIncluded)
 import PostgREST.Query.SqlFragment  (fromQi, intercalateSnippet,
-                                     pgFmtIdentList, unknownEncoder)
+                                     unknownEncoder)
 import PostgREST.Request.ApiRequest (ApiRequest (..), Target (..))
 
 import PostgREST.Request.Preferences
@@ -39,10 +37,10 @@ import PostgREST.Request.Preferences
 import Protolude
 
 -- | Runs local(transaction scoped) GUCs for every request, plus the pre-request function
-runPgLocals :: AppConfig   -> KM.KeyMap JSON.Value -> Text ->
+runPgLocals :: AppConfig   -> M.HashMap Text JSON.Value ->
                (ApiRequest -> ExceptT Error SQL.Transaction Wai.Response) ->
                ApiRequest  -> ByteString -> PgVersion -> ExceptT Error SQL.Transaction Wai.Response
-runPgLocals conf claims role app req jsonDbS actualPgVersion = do
+runPgLocals conf claims app req jsonDbS actualPgVersion = do
   lift $ SQL.statement mempty $ SQL.dynamicallyParameterized
     ("select " <> intercalateSnippet ", " (searchPathSql : roleSql ++ claimsSql ++ [methodSql, pathSql] ++ headersSql ++ cookiesSql ++ appSettingsSql ++ specSql))
     HD.noResult (configDbPreparedStatements conf)
@@ -57,14 +55,17 @@ runPgLocals conf claims role app req jsonDbS actualPgVersion = do
     cookiesSql = if usesLegacyGucs
                    then setConfigLocal "request.cookie." <$> iCookies req
                    else setConfigLocalJson "request.cookies" (iCookies req)
+    claimsWithRole =
+      let anon = JSON.String . toS $ configDbAnonRole conf in -- role claim defaults to anon if not specified in jwt
+      M.union claims (M.singleton "role" anon)
     claimsSql = if usesLegacyGucs
-                  then setConfigLocal "request.jwt.claim." <$> [(toUtf8 $ K.toText c, toUtf8 $ unquoted v) | (c,v) <- KM.toList claims]
+                  then setConfigLocal "request.jwt.claim." <$> [(toUtf8 c, toUtf8 $ unquoted v) | (c,v) <- M.toList claimsWithRole]
-                  else [setConfigLocal mempty ("request.jwt.claims", LBS.toStrict $ JSON.encode claims)]
+                  else [setConfigLocal mempty ("request.jwt.claims", LBS.toStrict $ JSON.encode claimsWithRole)]
-    roleSql = [setConfigLocal mempty ("role", toUtf8 role)]
+    roleSql = maybeToList $ (\x -> setConfigLocal mempty ("role", toUtf8 $ unquoted x)) <$> M.lookup "role" claimsWithRole
     appSettingsSql = setConfigLocal mempty <$> (join bimap toUtf8 <$> configAppSettings conf)
     searchPathSql =
-      let schemas = pgFmtIdentList (iSchema req : configDbExtraSearchPath conf) in
+      let schemas = T.intercalate ", " (iSchema req : configDbExtraSearchPath conf) in
-      setConfigLocal mempty ("search_path", schemas)
+      setConfigLocal mempty ("search_path", toUtf8 schemas)
     preReqSql = (\f -> "select " <> fromQi f <> "();") <$> configDbPreRequest conf
     specSql = case iTarget req of
       TargetProc{tpIsRootSpec=True} -> [setConfigLocal mempty ("request.spec", jsonDbS)]
@@ -117,6 +118,6 @@ setConfigLocalJson :: ByteString -> [(ByteString, ByteString)] -> [SQL.Snippet]
 setConfigLocalJson prefix keyVals = [setConfigLocal mempty (prefix, gucJsonVal keyVals)]
   where
     gucJsonVal :: [(ByteString, ByteString)] -> ByteString
-    gucJsonVal = LBS.toStrict . JSON.encode . HM.fromList . arrayByteStringToText
+    gucJsonVal = LBS.toStrict . JSON.encode . M.fromList . arrayByteStringToText
     arrayByteStringToText :: [(ByteString, ByteString)] -> [(Text,Text)]
     arrayByteStringToText keyVal = (T.decodeUtf8 *** T.decodeUtf8) <$> keyVal

src/PostgREST/OpenAPI.hs

@@ -3,13 +3,14 @@ Module      : PostgREST.OpenAPI
 Description : Generates the OpenAPI output
 -}
 {-# LANGUAGE LambdaCase      #-}
+{-# LANGUAGE NamedFieldPuns  #-}
 {-# LANGUAGE RecordWildCards #-}
 module PostgREST.OpenAPI (encode) 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.HashMap.Strict   as M
 import qualified Data.HashSet.InsOrd   as Set
 import qualified Data.Text             as T
 import qualified Data.Text.Encoding    as T
@@ -26,33 +27,32 @@ import Data.Swagger
 
 import PostgREST.Config                   (AppConfig (..), Proxy (..),
                                            isMalformedProxyUri, toURI)
-import PostgREST.DbStructure              (DbStructure (..))
+import PostgREST.DbStructure              (DbStructure (..),
-import PostgREST.DbStructure.Identifiers  (QualifiedIdentifier (..))
+                                           tableCols, tablePKCols)
 import PostgREST.DbStructure.Proc         (ProcDescription (..),
                                            ProcParam (..))
 import PostgREST.DbStructure.Relationship (Cardinality (..),
-                                           Relationship (..),
+                                           PrimaryKey (..),
-                                           RelationshipsMap)
+                                           Relationship (..))
-import PostgREST.DbStructure.Table        (Column (..), Table (..),
+import PostgREST.DbStructure.Table        (Column (..), Table (..))
-                                           TablesMap)
 import PostgREST.Version                  (docsVersion, prettyVersion)
 
-import PostgREST.MediaType
+import PostgREST.ContentType
 
 import Protolude hiding (Proxy, get)
 
-encode :: AppConfig -> DbStructure -> TablesMap -> HM.HashMap k [ProcDescription] -> Maybe Text -> LBS.ByteString
+encode :: AppConfig -> DbStructure -> [Table] -> M.HashMap k [ProcDescription] -> Maybe Text -> LBS.ByteString
 encode conf dbStructure tables procs schemaDescription =
   JSON.encode $
     postgrestSpec
       (dbRelationships dbStructure)
-      (concat $ HM.elems procs)
+      (concat $ M.elems procs)
-      (snd <$> HM.toList tables)
+      (openApiTableInfo dbStructure <$> tables)
       (proxyUri conf)
       schemaDescription
-      (configOpenApiSecurityActive conf)
+      (dbPrimaryKeys dbStructure)
 
-makeMimeList :: [MediaType] -> MimeList
+makeMimeList :: [ContentType] -> MimeList
 makeMimeList cs = MimeList $ fmap (fromString . BS.unpack . toMime) cs
 
 toSwaggerType :: Text -> Maybe (SwaggerType t)
@@ -81,34 +81,34 @@ parseDefault colType colDefault =
   where
     wrapInQuotations text = "\"" <> text <> "\""
 
-makeTableDef :: RelationshipsMap -> Table -> (Text, Schema)
+makeTableDef :: [Relationship] -> [PrimaryKey] -> (Table, [Column], [Text]) -> (Text, Schema)
-makeTableDef rels t =
+makeTableDef rels pks (t, cs, _) =
   let tn = tableName t in
       (tn, (mempty :: Schema)
         & description .~ tableDescription t
         & type_ ?~ SwaggerObject
-        & properties .~ fromList (makeProperty t rels <$> tableColumns t)
+        & properties .~ fromList (fmap (makeProperty rels pks) cs)
-        & required .~ fmap colName (filter (not . colNullable) $ tableColumns t))
+        & required .~ fmap colName (filter (not . colNullable) cs))
 
-makeProperty :: Table -> RelationshipsMap -> Column -> (Text, Referenced Schema)
+makeProperty :: [Relationship] -> [PrimaryKey] -> Column -> (Text, Referenced Schema)
-makeProperty tbl rels col = (colName col, Inline s)
+makeProperty rels pks c = (colName c, Inline s)
   where
-    e = if null $ colEnum col then Nothing else JSON.decode $ JSON.encode $ colEnum col
+    e = if null $ colEnum c then Nothing else JSON.decode $ JSON.encode $ colEnum c
     fk :: Maybe Text
     fk =
       let
         -- Finds the relationship that has a single column foreign key
         rel = find (\case
-          Relationship{relCardinality=(M2O _ relColumns)} -> [colName col] == (fst <$> relColumns)
+          Relationship{relColumns, relCardinality=M2O _} -> [c] == relColumns
-          _                                               -> False
+          _                                                 -> False
-          ) $ fromMaybe mempty $ HM.lookup (QualifiedIdentifier (tableSchema tbl) (tableName tbl), tableSchema tbl) rels
+          ) rels
-        fCol = (headMay . (\r -> snd <$> relColumns (relCardinality r)) =<< rel)
+        fCol = colName <$> (headMay . relForeignColumns =<< rel)
-        fTbl = qiName . relForeignTable <$> rel
+        fTbl = tableName . relForeignTable <$> rel
         fTblCol = (,) <$> fTbl <*> fCol
       in
         (\(a, b) -> T.intercalate "" ["This is a Foreign Key to `", a, ".", b, "`.<fk table='", a, "' column='", b, "'/>"]) <$> fTblCol
     pk :: Bool
-    pk = colName col `elem` tablePKCols tbl
+    pk = any (\p -> pkTable p == colTable c && pkName p == colName c) pks
     n = catMaybes
       [ Just "Note:"
       , if pk then Just "This is a Primary Key.<pk/>" else Nothing
@@ -116,17 +116,17 @@ makeProperty tbl rels col = (colName col, Inline s)
       ]
     d =
       if length n > 1 then
-        Just $ T.append (maybe "" (`T.append` "\n\n") $ colDescription col) (T.intercalate "\n" n)
+        Just $ T.append (maybe "" (`T.append` "\n\n") $ colDescription c) (T.intercalate "\n" n)
       else
-        colDescription col
+        colDescription c
     s =
       (mempty :: Schema)
-        & default_ .~ (JSON.decode . toUtf8Lazy . parseDefault (colType col) =<< colDefault col)
+        & default_ .~ (JSON.decode . toUtf8Lazy . parseDefault (colType c) =<< colDefault c)
         & description .~ d
         & enum_ .~ e
-        & format ?~ colType col
+        & format ?~ colType c
-        & maxLength .~ (fromIntegral <$> colMaxLen col)
+        & maxLength .~ (fromIntegral <$> colMaxLen c)
-        & type_ .~ toSwaggerType (colType col)
+        & type_ .~ toSwaggerType (colType c)
 
 makeProcSchema :: ProcDescription -> Schema
 makeProcSchema pd =
@@ -163,7 +163,7 @@ makeProcParam pd =
   , Ref $ Reference "preferParams"
   ]
 
-makeParamDefs :: [Table] -> [(Text, Param)]
+makeParamDefs :: [(Table, [Column], [Text])] -> [(Text, Param)]
 makeParamDefs ti =
   [ ("preferParams", makePreferParam ["params=single-object"])
   , ("preferReturn", makePreferParam ["return=representation", "return=minimal", "return=none"])
@@ -219,8 +219,8 @@ makeParamDefs ti =
         & in_ .~ ParamQuery
         & type_ ?~ SwaggerString))
   ]
-  <> concat [ makeObjectBody (tableName t) : makeRowFilters (tableName t) (tableColumns t)
+  <> concat [ makeObjectBody (tableName t) : makeRowFilters (tableName t) cs
-            | t <- ti
+            | (t, cs, _) <- ti
             ]
 
 makeObjectBody :: Text -> (Text, Param)
@@ -245,8 +245,8 @@ makeRowFilter tn c =
 makeRowFilters :: Text -> [Column] -> [(Text, Param)]
 makeRowFilters tn = fmap (makeRowFilter tn)
 
-makePathItem :: Table -> (FilePath, PathItem)
+makePathItem :: (Table, [Column], [Text]) -> (FilePath, PathItem)
-makePathItem t = ("/" ++ T.unpack tn, p $ tableInsertable t || tableUpdatable t || tableDeletable t)
+makePathItem (t, cs, _) = ("/" ++ T.unpack tn, p $ tableInsertable t || tableUpdatable t || tableDeletable t)
   where
     -- Use first line of table description as summary; rest as description (if present)
     -- We strip leading newlines from description so that users can include a blank line between summary and description
@@ -280,7 +280,7 @@ makePathItem t = ("/" ++ T.unpack tn, p $ tableInsertable t || tableUpdatable t
     p False = pr
     p True  = pw
     tn = tableName t
-    rs = [ T.intercalate "." ["rowFilter", tn, colName c ] | c <- tableColumns t ]
+    rs = [ T.intercalate "." ["rowFilter", tn, colName c ] | c <- cs ]
     ref = Ref . Reference
 
 makeProcPathItem :: ProcDescription -> (FilePath, PathItem)
@@ -295,7 +295,7 @@ makeProcPathItem pd = ("/rpc/" ++ toS (pdName pd), pe)
       & description .~ mfilter (/="") pDesc
       & parameters .~ makeProcParam pd
       & tags .~ Set.fromList ["(rpc) " <> pdName pd]
-      & produces ?~ makeMimeList [MTApplicationJSON, MTSingularJSON]
+      & produces ?~ makeMimeList [CTApplicationJSON, CTSingularJSON]
       & at 200 ?~ "OK"
     pe = (mempty :: PathItem) & post ?~ postOp
 
@@ -305,23 +305,15 @@ makeRootPathItem = ("/", p)
     getOp = (mempty :: Operation)
       & tags .~ Set.fromList ["Introspection"]
       & summary ?~ "OpenAPI description (this document)"
-      & produces ?~ makeMimeList [MTOpenAPI, MTApplicationJSON]
+      & produces ?~ makeMimeList [CTOpenAPI, CTApplicationJSON]
       & at 200 ?~ "OK"
     pr = (mempty :: PathItem) & get ?~ getOp
     p = pr
 
-makePathItems :: [ProcDescription] -> [Table] -> InsOrdHashMap FilePath PathItem
+makePathItems :: [ProcDescription] -> [(Table, [Column], [Text])] -> InsOrdHashMap FilePath PathItem
 makePathItems pds ti = fromList $ makeRootPathItem :
   fmap makePathItem ti ++ fmap makeProcPathItem pds
 
-makeSecurityDefinitions :: Text -> Bool -> SecurityDefinitions
-makeSecurityDefinitions secName allow
-  | allow = SecurityDefinitions (fromList [(secName, SecurityScheme secSchType secSchDescription)])
-  | otherwise    = mempty
-  where
-    secSchType = SecuritySchemeApiKey (ApiKeyParams "Authorization" ApiKeyHeader)
-    secSchDescription = Just "Add the token prepending \"Bearer \" (without quotes) to it"
-
 escapeHostName :: Text -> Text
 escapeHostName "*"  = "0.0.0.0"
 escapeHostName "*4" = "0.0.0.0"
@@ -330,8 +322,8 @@ escapeHostName "*6" = "0.0.0.0"
 escapeHostName "!6" = "0.0.0.0"
 escapeHostName h    = h
 
-postgrestSpec :: RelationshipsMap -> [ProcDescription] -> [Table] -> (Text, Text, Integer, Text) -> Maybe Text -> Bool -> Swagger
+postgrestSpec :: [Relationship] -> [ProcDescription] -> [(Table, [Column], [Text])] -> (Text, Text, Integer, Text) -> Maybe Text -> [PrimaryKey] -> Swagger
-postgrestSpec rels pds ti (s, h, p, b) sd allowSecurityDef = (mempty :: Swagger)
+postgrestSpec rels pds ti (s, h, p, b) sd pks = (mempty :: Swagger)
   & basePath ?~ T.unpack b
   & schemes ?~ [s']
   & info .~ ((mempty :: Info)
@@ -342,18 +334,15 @@ postgrestSpec rels pds ti (s, h, p, b) sd allowSecurityDef = (mempty :: Swagger)
     & description ?~ "PostgREST Documentation"
     & url .~ URL ("https://postgrest.org/en/" <> docsVersion <> "/api.html"))
   & host .~ h'
-  & definitions .~ fromList (makeTableDef rels <$> ti)
+  & definitions .~ fromList (makeTableDef rels pks <$> ti)
   & parameters .~ fromList (makeParamDefs ti)
   & paths .~ makePathItems pds ti
-  & produces .~ makeMimeList [MTApplicationJSON, MTSingularJSON, MTTextCSV]
+  & produces .~ makeMimeList [CTApplicationJSON, CTSingularJSON, CTTextCSV]
-  & consumes .~ makeMimeList [MTApplicationJSON, MTSingularJSON, MTTextCSV]
+  & consumes .~ makeMimeList [CTApplicationJSON, CTSingularJSON, CTTextCSV]
-  & 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"
 
 pickProxy :: Maybe Text -> Maybe Proxy
 pickProxy proxy
@@ -391,3 +380,10 @@ proxyUri AppConfig{..} =
       (proxyScheme, proxyHost, proxyPort, proxyPath)
     Nothing ->
       ("http", configServerHost, toInteger configServerPort, "/")
+
+openApiTableInfo :: DbStructure -> Table -> (Table, [Column], [Text])
+openApiTableInfo dbStructure table =
+  ( table
+  , tableCols dbStructure (tableSchema table) (tableName table)
+  , tablePKCols dbStructure (tableSchema table) (tableName table)
+  )

src/PostgREST/Query/QueryBuilder.hs

@@ -1,5 +1,4 @@
 {-# LANGUAGE DuplicateRecordFields #-}
-{-# LANGUAGE NamedFieldPuns        #-}
 {-|
 Module      : PostgREST.Query.QueryBuilder
 Description : PostgREST SQL queries generating functions.
@@ -25,62 +24,61 @@ import Data.Tree (Tree (..))
 import PostgREST.DbStructure.Identifiers  (QualifiedIdentifier (..))
 import PostgREST.DbStructure.Proc         (ProcParam (..))
 import PostgREST.DbStructure.Relationship (Cardinality (..),
-                                           Junction (..),
                                            Relationship (..))
+import PostgREST.DbStructure.Table        (Table (..))
 import PostgREST.Request.Preferences      (PreferResolution (..))
 
 import PostgREST.Query.SqlFragment
-import PostgREST.RangeQuery          (allRange)
-import PostgREST.Request.MutateQuery
-import PostgREST.Request.ReadQuery
 import PostgREST.Request.Types
 
 import Protolude
 
 readRequestToQuery :: ReadRequest -> SQL.Snippet
-readRequestToQuery (Node (Select colSelects mainQi tblAlias logicForest joinConditions_ ordts range, (_, rel, _, _, _, _)) forest) =
+readRequestToQuery (Node (Select colSelects mainQi tblAlias implJoins logicForest joinConditions_ ordts range, _) forest) =
   "SELECT " <>
-  intercalateSnippet ", " ((pgFmtSelectItem qi <$> colSelects) ++ selects) <> " " <>
+  intercalateSnippet ", " ((pgFmtSelectItem qi <$> colSelects) ++ selects) <>
-  fromFrag <> " " <>
+  "FROM " <> SQL.sql (BS.intercalate ", " (tabl : implJs)) <> " " <>
   intercalateSnippet " " joins <> " " <>
-  (if null logicForest && null joinConditions_
+  (if null logicForest && null joinConditions_ then mempty else "WHERE " <> intercalateSnippet " AND " (map (pgFmtLogicTree qi) logicForest ++ map pgFmtJoinCondition joinConditions_))
-    then mempty
+  <> " " <>
-    else "WHERE " <> intercalateSnippet " AND " (map (pgFmtLogicTree qi) logicForest ++ map pgFmtJoinCondition joinConditions_)) <> " " <>
+  (if null ordts then mempty else "ORDER BY " <> intercalateSnippet ", " (map (pgFmtOrderTerm qi) ordts)) <> " " <>
-  orderF qi ordts <> " " <>
   limitOffsetF range
   where
-    fromFrag = fromF rel mainQi tblAlias
+    implJs = fromQi <$> implJoins
-    qi = getQualifiedIdentifier rel mainQi tblAlias
+    tabl = fromQi mainQi <> maybe mempty (\a -> " AS " <> pgFmtIdent a) tblAlias
-    (selects, joins) = foldr getSelectsJoins ([],[]) forest
+    qi = maybe mainQi (QualifiedIdentifier mempty) tblAlias
+    (joins, selects) = foldr getJoinsSelects ([],[]) forest
 
-getSelectsJoins :: ReadRequest -> ([SQL.Snippet], [SQL.Snippet]) -> ([SQL.Snippet], [SQL.Snippet])
+getJoinsSelects :: ReadRequest -> ([SQL.Snippet], [SQL.Snippet]) -> ([SQL.Snippet], [SQL.Snippet])
-getSelectsJoins (Node (_, (_, Nothing, _, _, _, _)) _) _ = ([], [])
+getJoinsSelects rr@(Node (_, (name, Just Relationship{relCardinality=card,relTable=Table{tableName=table}}, alias, _, joinType, _)) _) (joins,selects) =
-getSelectsJoins rr@(Node (_, (name, Just rel, alias, _, joinType, _)) _) (selects,joins) =
+  let subquery = readRequestToQuery rr in
-  let
+  case card of
-    subquery = readRequestToQuery rr
+    M2O _ ->
-    aliasOrName = fromMaybe name alias
+      let aliasOrName = fromMaybe name alias
-    locTblName = qiName (relTable rel) <> "_" <> aliasOrName
+          localTableName = pgFmtIdent $ table <> "_" <> aliasOrName
-    localTableName = pgFmtIdent locTblName
+          sel = SQL.sql ("row_to_json(" <> localTableName <> ".*) AS " <> pgFmtIdent aliasOrName)
-    internalTableName = pgFmtIdent $ "_" <> locTblName
+          joi = (if joinType == Just JTInner then " INNER" else " LEFT")
-    correlatedSubquery sub al cond =
+            <> " JOIN LATERAL( " <> subquery <> " ) AS " <> SQL.sql localTableName <> " ON TRUE " in
-      (if joinType == Just JTInner then "INNER" else "LEFT") <> " JOIN LATERAL ( " <> sub <> " ) AS " <> SQL.sql al <> " ON " <> cond
+      (joi:joins,sel:selects)
-    isToOne = case rel of
+    _ -> case joinType of
-      Relationship{relCardinality=M2O _ _} -> True
+      Just JTInner ->
-      Relationship{relCardinality=O2O _ _} -> True
+        let aliasOrName = fromMaybe name alias
-      ComputedRelationship{relToOne=True}  -> True
+            locTblName = table <> "_" <> aliasOrName
-      _                                    -> False
+            localTableName = pgFmtIdent locTblName
-    (sel, joi) = if isToOne
+            internalTableName = pgFmtIdent $ "_" <> locTblName
-      then
+            sel = SQL.sql $ localTableName <> "." <> internalTableName <> " AS " <> pgFmtIdent aliasOrName
-        ( SQL.sql ("row_to_json(" <> localTableName <> ".*) AS " <> pgFmtIdent aliasOrName)
+            joi = "INNER JOIN LATERAL(" <>
-        , correlatedSubquery subquery localTableName "TRUE")
+                    "SELECT json_agg(" <> SQL.sql internalTableName <> ") AS " <> SQL.sql internalTableName <>
-      else
+                    "FROM (" <> subquery <> " ) AS " <> SQL.sql internalTableName <>
-        ( SQL.sql $ "COALESCE( " <> localTableName <> "." <> internalTableName <> ", '[]') AS " <> pgFmtIdent aliasOrName
+                  ") AS " <> SQL.sql localTableName <> " ON " <> SQL.sql localTableName <> "IS NOT NULL" in
-        , correlatedSubquery (
+        (joi:joins,sel:selects)
-            "SELECT json_agg(" <> SQL.sql internalTableName <> ") AS " <> SQL.sql internalTableName <>
+      _ ->
-            "FROM (" <> subquery <> " ) AS " <> SQL.sql internalTableName
+        let sel = "COALESCE (("
-          ) localTableName $ if joinType == Just JTInner then SQL.sql localTableName <> " IS NOT NULL" else "TRUE")
+               <> "SELECT json_agg(" <> SQL.sql (pgFmtIdent table) <> ".*) "
-  in
+               <> "FROM (" <> subquery <> ") " <> SQL.sql (pgFmtIdent table) <> " "
-  (sel:selects, joi:joins)
+               <> "), '[]') AS " <> SQL.sql (pgFmtIdent (fromMaybe name alias)) in
+        (joins,sel:selects)
+getJoinsSelects (Node (_, (_, Nothing, _, _, _, _)) _) _ = ([], [])
 
 mutateRequestToQuery :: MutateRequest -> SQL.Snippet
 mutateRequestToQuery (Insert mainQi iCols body onConflct putConditions returnings) =
@@ -107,66 +105,28 @@ mutateRequestToQuery (Insert mainQi iCols body onConflct putConditions returning
     ])
   where
     cols = BS.intercalate ", " $ pgFmtIdent <$> S.toList iCols
-
+mutateRequestToQuery (Update mainQi uCols body logicForest returnings) =
--- An update without a limit is always filtered with a WHERE
+  if S.null uCols
-mutateRequestToQuery (Update mainQi uCols body logicForest range ordts returnings)
-  | S.null uCols =
     -- if there are no columns we cannot do UPDATE table SET {empty}, it'd be invalid syntax
     -- selecting an empty resultset from mainQi gives us the column names to prevent errors when using &select=
     -- the select has to be based on "returnings" to make computed overloaded functions not throw
-    SQL.sql $ "SELECT " <> emptyBodyReturnedColumns <> " FROM " <> fromQi mainQi <> " WHERE false"
+    then SQL.sql ("SELECT " <> emptyBodyReturnedColumns <> " FROM " <> fromQi mainQi <> " WHERE false")
-
+    else
-  | range == allRange =
+      "WITH " <> normalizedBody body <> " " <>
-    "WITH " <> normalizedBody body <> " " <>
+      "UPDATE " <> SQL.sql (fromQi mainQi) <> " SET " <> SQL.sql cols <> " " <>
-    "UPDATE " <> mainTbl <> " SET " <> SQL.sql nonRangeCols <> " " <>
+      "FROM (SELECT * FROM json_populate_recordset (null::" <> SQL.sql (fromQi mainQi) <> " , " <> SQL.sql selectBody <> " )) _ " <>
-    "FROM (SELECT * FROM json_populate_recordset (null::" <> mainTbl <> " , " <> SQL.sql selectBody <> " )) _ " <>
+      (if null logicForest then mempty else "WHERE " <> intercalateSnippet " AND " (pgFmtLogicTree mainQi <$> logicForest)) <> " " <>
-    whereLogic <> " " <>
+      SQL.sql (returningF mainQi returnings)
-    SQL.sql (returningF mainQi returnings)
-
-  | otherwise =
-    "WITH " <> normalizedBody body <> ", " <>
-    "pgrst_update_body AS (SELECT * FROM json_populate_recordset (null::" <> mainTbl <> " , " <> SQL.sql selectBody <> " ) LIMIT 1), " <>
-    "pgrst_affected_rows AS (" <>
-      "SELECT " <> SQL.sql rangeIdF <> " FROM " <> mainTbl <>
-      whereLogic <> " " <>
-      orderF mainQi ordts <> " " <>
-      limitOffsetF range <>
-    ") " <>
-    "UPDATE " <> mainTbl <> " SET " <> SQL.sql rangeCols <>
-    "FROM pgrst_affected_rows " <>
-    "WHERE " <> SQL.sql whereRangeIdF <> " " <>
-    SQL.sql (returningF mainQi returnings)
-
   where
-    whereLogic = if null logicForest then mempty else " WHERE " <> intercalateSnippet " AND " (pgFmtLogicTree mainQi <$> logicForest)
+    cols = BS.intercalate ", " (pgFmtIdent <> const " = _." <> pgFmtIdent <$> S.toList uCols)
-    mainTbl = SQL.sql (fromQi mainQi)
+    emptyBodyReturnedColumns :: SqlFragment
-    emptyBodyReturnedColumns = if null returnings then "NULL" else BS.intercalate ", " (pgFmtColumn (QualifiedIdentifier mempty $ qiName mainQi) <$> returnings)
+    emptyBodyReturnedColumns
-    nonRangeCols = BS.intercalate ", " (pgFmtIdent <> const " = _." <> pgFmtIdent <$> S.toList uCols)
+      | null returnings = "NULL"
-    rangeCols = BS.intercalate ", " ((\col -> pgFmtIdent col <> " = (SELECT " <> pgFmtIdent col <> " FROM pgrst_update_body) ") <$> S.toList uCols)
+      | otherwise       = BS.intercalate ", " (pgFmtColumn (QualifiedIdentifier mempty $ qiName mainQi) <$> returnings)
-    (whereRangeIdF, rangeIdF) = mutRangeF mainQi (fst . otTerm <$> ordts)
+mutateRequestToQuery (Delete mainQi logicForest returnings) =
-
+  "DELETE FROM " <> SQL.sql (fromQi mainQi) <> " " <>
-mutateRequestToQuery (Delete mainQi logicForest range ordts returnings)
+  (if null logicForest then mempty else "WHERE " <> intercalateSnippet " AND " (map (pgFmtLogicTree mainQi) logicForest)) <> " " <>
-  | range == allRange =
+  SQL.sql (returningF mainQi returnings)
-    "DELETE FROM " <> SQL.sql (fromQi mainQi) <> " " <>
-    whereLogic <> " " <>
-    SQL.sql (returningF mainQi returnings)
-
-  | otherwise =
-    "WITH " <>
-    "pgrst_affected_rows AS (" <>
-      "SELECT " <> SQL.sql rangeIdF <> " FROM " <> SQL.sql (fromQi mainQi) <>
-       whereLogic <> " " <>
-      orderF mainQi ordts <> " " <>
-      limitOffsetF range <>
-    ") " <>
-    "DELETE FROM " <> SQL.sql (fromQi mainQi) <> " " <>
-    "USING pgrst_affected_rows " <>
-    "WHERE " <> SQL.sql whereRangeIdF <> " " <>
-    SQL.sql (returningF mainQi returnings)
-
-  where
-    whereLogic = if null logicForest then mempty else " WHERE " <> intercalateSnippet " AND " (pgFmtLogicTree mainQi <$> logicForest)
-    (whereRangeIdF, rangeIdF) = mutRangeF mainQi (fst . otTerm <$> ordts)
 
 requestToCallProcQuery :: CallRequest -> SQL.Snippet
 requestToCallProcQuery (FunctionCall qi params args returnsScalar multipleCall returnings) =
@@ -224,8 +184,8 @@ requestToCallProcQuery (FunctionCall qi params args returnsScalar multipleCall r
 -- See https://github.com/PostgREST/postgrest/issues/2009#issuecomment-977473031
 -- Only for the nodes that have an INNER JOIN linked to the root level.
 readRequestToCountQuery :: ReadRequest -> SQL.Snippet
-readRequestToCountQuery (Node (Select{from=mainQi, fromAlias=tblAlias, where_=logicForest, joinConditions=joinConditions_}, (_, rel, _, _, _, _)) forest) =
+readRequestToCountQuery (Node (Select{from=qi, implicitJoins=implJoins, where_=logicForest, joinConditions=joinConditions_}, _) forest) =
-  "SELECT 1 " <> fromFrag <>
+  "SELECT 1 FROM " <> SQL.sql (BS.intercalate ", " (fromQi qi:(fromQi <$> implJoins))) <>
   (if null logicForest && null joinConditions_ && null subQueries
     then mempty
     else " WHERE " ) <>
@@ -235,31 +195,12 @@ readRequestToCountQuery (Node (Select{from=mainQi, fromAlias=tblAlias, where_=lo
     subQueries
   )
   where
-    qi = getQualifiedIdentifier rel mainQi tblAlias
-    fromFrag = fromF rel mainQi tblAlias
     subQueries = foldr existsSubquery [] forest
     existsSubquery :: ReadRequest -> [SQL.Snippet] -> [SQL.Snippet]
     existsSubquery readReq@(Node (_, (_, _, _, _, joinType, _)) _) rest =
       if joinType == Just JTInner
         then ("EXISTS (" <> readRequestToCountQuery readReq <> " )"):rest
-        else rest
+        else mempty
 
 limitedQuery :: SQL.Snippet -> Maybe Integer -> SQL.Snippet
 limitedQuery query maxRows = query <> SQL.sql (maybe mempty (\x -> " LIMIT " <> BS.pack (show x)) maxRows)
-
--- TODO refactor so this function is uneeded and ComputedRelationship QualifiedIdentifier comes from the ReadQuery type
-getQualifiedIdentifier :: Maybe Relationship -> QualifiedIdentifier -> Maybe Alias -> QualifiedIdentifier
-getQualifiedIdentifier rel mainQi tblAlias = case rel of
-  Just ComputedRelationship{relFunction} -> QualifiedIdentifier mempty $ fromMaybe (qiName relFunction) tblAlias
-  _                                      -> maybe mainQi (QualifiedIdentifier mempty) tblAlias
-
--- FROM clause plus implicit joins
-fromF :: Maybe Relationship -> QualifiedIdentifier -> Maybe Alias -> SQL.Snippet
-fromF rel mainQi tblAlias = SQL.sql $ "FROM " <>
-  (case rel of
-    Just ComputedRelationship{relFunction,relTable} -> fromQi relFunction <> "(" <> pgFmtIdent (qiName relTable) <> ")"
-    _                                               -> fromQi mainQi) <>
-  maybe mempty (\a -> " AS " <> pgFmtIdent a) tblAlias <>
-  (case rel of
-    Just Relationship{relCardinality=M2M Junction{junTable=jt}} -> ", " <> fromQi jt
-    _                                                           -> mempty)

src/PostgREST/Query/SqlFragment.hs

@@ -11,20 +11,17 @@ module PostgREST.Query.SqlFragment
   , SqlFragment
   , asBinaryF
   , asCsvF
-  , asGeoJsonF
   , asJsonF
   , asJsonSingleF
-  , asXmlF
   , countF
   , fromQi
+  , ftsOperators
   , limitOffsetF
   , locationF
-  , mutRangeF
   , normalizedBody
-  , orderF
+  , operators
   , pgFmtColumn
   , pgFmtIdent
-  , pgFmtIdentList
   , pgFmtJoinCondition
   , pgFmtLogicTree
   , pgFmtOrderTerm
@@ -37,11 +34,11 @@ module PostgREST.Query.SqlFragment
   , sourceCTEName
   , unknownEncoder
   , intercalateSnippet
-  , explainF
   ) where
 
 import qualified Data.ByteString.Char8           as BS
 import qualified Data.ByteString.Lazy            as LBS
+import qualified Data.HashMap.Strict             as M
 import qualified Data.Text                       as T
 import qualified Hasql.DynamicStatements.Snippet as SQL
 import qualified Hasql.Encoders                  as HE
@@ -51,13 +48,9 @@ import Text.InterpolatedString.Perl6 (qc)
 
 import PostgREST.DbStructure.Identifiers (FieldName,
                                           QualifiedIdentifier (..))
-import PostgREST.MediaType               (MTPlanFormat (..),
-                                          MTPlanOption (..))
 import PostgREST.RangeQuery              (NonnegRange, allRange,
                                           rangeLimit, rangeOffset)
-import PostgREST.Request.ReadQuery       (SelectItem)
 import PostgREST.Request.Types           (Alias, Field, Filter (..),
-                                          FtsOperator (..),
                                           JoinCondition (..),
                                           JsonOperand (..),
                                           JsonOperation (..),
@@ -67,8 +60,7 @@ import PostgREST.Request.Types           (Alias, Field, Filter (..),
                                           Operation (..),
                                           OrderDirection (..),
                                           OrderNulls (..),
-                                          OrderTerm (..),
+                                          OrderTerm (..), SelectItem,
-                                          SimpleOperator (..),
                                           TrileanVal (..))
 
 import Protolude hiding (cast)
@@ -83,33 +75,34 @@ noLocationF = "array[]::text[]"
 sourceCTEName :: SqlFragment
 sourceCTEName = "pgrst_source"
 
-singleValOperator :: SimpleOperator -> SqlFragment
+operators :: M.HashMap Text SqlFragment
-singleValOperator = \case
+operators = M.union (M.fromList [
-  OpEqual            -> "="
+  ("eq", "="),
-  OpGreaterThanEqual -> ">="
+  ("gte", ">="),
-  OpGreaterThan      -> ">"
+  ("gt", ">"),
-  OpLessThanEqual    -> "<="
+  ("lte", "<="),
-  OpLessThan         -> "<"
+  ("lt", "<"),
-  OpNotEqual         -> "<>"
+  ("neq", "<>"),
-  OpLike             -> "like"
+  ("like", "LIKE"),
-  OpILike            -> "ilike"
+  ("ilike", "ILIKE"),
-  OpContains         -> "@>"
+  ("in", "IN"),
-  OpContained        -> "<@"
+  ("is", "IS"),
-  OpOverlap          -> "&&"
+  ("cs", "@>"),
-  OpStrictlyLeft     -> "<<"
+  ("cd", "<@"),
-  OpStrictlyRight    -> ">>"
+  ("ov", "&&"),
-  OpNotExtendsRight  -> "&<"
+  ("sl", "<<"),
-  OpNotExtendsLeft   -> "&>"
+  ("sr", ">>"),
-  OpAdjacent         -> "-|-"
+  ("nxr", "&<"),
-  OpMatch            -> "~"
+  ("nxl", "&>"),
-  OpIMatch           -> "~*"
+  ("adj", "-|-")]) ftsOperators
 
-ftsOperator :: FtsOperator -> SqlFragment
+ftsOperators :: M.HashMap Text SqlFragment
-ftsOperator = \case
+ftsOperators = M.fromList [
-  FilterFts          -> "@@ to_tsquery"
+  ("fts", "@@ to_tsquery"),
-  FilterFtsPlain     -> "@@ plainto_tsquery"
+  ("plfts", "@@ plainto_tsquery"),
-  FilterFtsPhrase    -> "@@ phraseto_tsquery"
+  ("phfts", "@@ phraseto_tsquery"),
-  FilterFtsWebsearch -> "@@ websearch_to_tsquery"
+  ("wfts", "@@ 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
@@ -160,14 +153,6 @@ pgFmtIdent x = encodeUtf8 $ "\"" <> T.replace "\"" "\"\"" (trimNullChars x) <> "
 trimNullChars :: Text -> Text
 trimNullChars = T.takeWhile (/= '\x0')
 
--- |
--- Format a list of identifiers and separate them by commas.
---
--- >>> pgFmtIdentList ["schema_1", "schema_2", "SPECIAL \"@/\\#~_-"]
--- "\"schema_1\", \"schema_2\", \"SPECIAL \"\"@/\\#~_-\""
-pgFmtIdentList :: [Text] -> SqlFragment
-pgFmtIdentList schemas = BS.intercalate ", " $ pgFmtIdent <$> schemas
-
 asCsvF :: SqlFragment
 asCsvF = asCsvHeaderF <> " || '\n' || " <> asCsvBodyF
   where
@@ -192,12 +177,6 @@ asJsonSingleF returnsScalar
   | returnsScalar = "coalesce((json_agg(_postgrest_t.pgrst_scalar)->0)::text, 'null')"
   | otherwise     = "coalesce((json_agg(_postgrest_t)->0)::text, 'null')"
 
-asXmlF :: FieldName -> SqlFragment
-asXmlF fieldName = "coalesce(xmlagg(_postgrest_t." <> pgFmtIdent fieldName <> "), '')"
-
-asGeoJsonF ::  SqlFragment
-asGeoJsonF = "json_build_object('type', 'FeatureCollection', 'features', coalesce(json_agg(ST_AsGeoJSON(_postgrest_t)::json), '[]'))"
-
 asBinaryF :: FieldName -> SqlFragment
 asBinaryF fieldName = "coalesce(string_agg(_postgrest_t." <> pgFmtIdent fieldName <> ", ''), '')"
 
@@ -222,10 +201,7 @@ pgFmtColumn table "*" = fromQi table <> ".*"
 pgFmtColumn table c   = fromQi table <> "." <> pgFmtIdent c
 
 pgFmtField :: QualifiedIdentifier -> Field -> SQL.Snippet
-pgFmtField table (c, []) = SQL.sql (pgFmtColumn table c)
+pgFmtField table (c, jp) = SQL.sql (pgFmtColumn table c) <> pgFmtJsonPath jp
--- Using to_jsonb instead of to_json to avoid missing operator errors when filtering:
--- "operator does not exist: json = unknown"
-pgFmtField table (c, jp) = SQL.sql ("to_jsonb(" <> pgFmtColumn table c <> ")") <> pgFmtJsonPath jp
 
 pgFmtSelectItem :: QualifiedIdentifier -> SelectItem -> SQL.Snippet
 pgFmtSelectItem table (f@(fName, jp), Nothing, alias, _, _) = pgFmtField table f <> SQL.sql (pgFmtAs fName jp alias)
@@ -251,8 +227,8 @@ pgFmtOrderTerm qi ot =
 pgFmtFilter :: QualifiedIdentifier -> Filter -> SQL.Snippet
 pgFmtFilter table (Filter fld (OpExpr hasNot oper)) = notOp <> " " <> case oper of
    Op op val  -> pgFmtFieldOp op <> " " <> case op of
-     OpLike  -> unknownLiteral (T.map star val)
+     "like"  -> unknownLiteral (T.map star val)
-     OpILike -> unknownLiteral (T.map star val)
+     "ilike" -> unknownLiteral (T.map star val)
      _       -> unknownLiteral val
 
    -- IS cannot be prepared. `PREPARE boolplan AS SELECT * FROM projects where id IS $1` will give a syntax error.
@@ -273,11 +249,11 @@ pgFmtFilter table (Filter fld (OpExpr hasNot oper)) = notOp <> " " <> case oper
       _    -> "= ANY (" <> unknownLiteral (pgBuildArrayLiteral vals) <> ") "
 
    Fts op lang val ->
-     pgFmtFieldFts op <> "(" <> ftsLang lang <> unknownLiteral val <> ") "
+     pgFmtFieldOp op <> "(" <> ftsLang lang <> unknownLiteral val <> ") "
  where
    ftsLang = maybe mempty (\l -> unknownLiteral l <> ", ")
-   pgFmtFieldOp op = pgFmtField table fld <> " " <> SQL.sql (singleValOperator op)
+   pgFmtFieldOp op = pgFmtField table fld <> " " <> sqlOperator op
-   pgFmtFieldFts op = pgFmtField table fld <> " " <> SQL.sql (ftsOperator op)
+   sqlOperator o = SQL.sql $ M.lookupDefault "=" o operators
    notOp = if hasNot then "NOT" else mempty
    star c = if c == '*' then '%' else c
 
@@ -349,17 +325,6 @@ currentSettingF setting =
   -- nullif is used because of https://gist.github.com/steve-chavez/8d7033ea5655096903f3b52f8ed09a15
   "nullif(current_setting('" <> setting <> "', true), '')"
 
-mutRangeF :: QualifiedIdentifier -> [FieldName] -> (SqlFragment, SqlFragment)
-mutRangeF mainQi rangeId =
-  (
-    BS.intercalate " AND " $ (\col -> pgFmtColumn mainQi col <> " = " <> pgFmtColumn (QualifiedIdentifier mempty "pgrst_affected_rows") col) <$> rangeId
-  , BS.intercalate ", " (pgFmtColumn mainQi <$> rangeId)
-  )
-
-orderF :: QualifiedIdentifier -> [OrderTerm] -> SQL.Snippet
-orderF _ []    = mempty
-orderF qi ordts = "ORDER BY " <> intercalateSnippet ", " (pgFmtOrderTerm qi <$> ordts)
-
 -- Hasql Snippet utilities
 unknownEncoder :: ByteString -> SQL.Snippet
 unknownEncoder = SQL.encoderAndParam (HE.nonNullable HE.unknown)
@@ -370,19 +335,3 @@ unknownLiteral = unknownEncoder . encodeUtf8
 intercalateSnippet :: ByteString -> [SQL.Snippet] -> SQL.Snippet
 intercalateSnippet _ [] = mempty
 intercalateSnippet frag snippets = foldr1 (\a b -> a <> SQL.sql frag <> b) snippets
-
-explainF :: MTPlanFormat -> [MTPlanOption] -> SQL.Snippet -> SQL.Snippet
-explainF fmt opts snip =
-  "EXPLAIN (" <>
-    SQL.sql (BS.intercalate ", " (fmtPlanFmt fmt : (fmtPlanOpt <$> opts))) <>
-  ") " <> snip
-  where
-    fmtPlanOpt :: MTPlanOption -> BS.ByteString
-    fmtPlanOpt PlanAnalyze  = "ANALYZE"
-    fmtPlanOpt PlanVerbose  = "VERBOSE"
-    fmtPlanOpt PlanSettings = "SETTINGS"
-    fmtPlanOpt PlanBuffers  = "BUFFERS"
-    fmtPlanOpt PlanWAL      = "WAL"
-
-    fmtPlanFmt PlanJSON = "FORMAT JSON"
-    fmtPlanFmt PlanText = "FORMAT TEXT"

src/PostgREST/Query/Statements.hs

@@ -6,13 +6,14 @@ This module constructs single SQL statements that can be parametrized and prepar
 
 - It consumes the SqlQuery types generated by the QueryBuilder module.
 - It generates the body format and some headers of the final HTTP response.
+
+TODO: Currently, createReadStatement is not using prepared statements. See https://github.com/PostgREST/postgrest/issues/718.
 -}
 module PostgREST.Query.Statements
-  ( prepareWrite
+  ( createWriteStatement
-  , prepareRead
+  , createReadStatement
-  , prepareCall
+  , callProcStatement
-  , preparePlanRows
+  , createExplainStatement
-  , ResultSet (..)
   ) where
 
 import qualified Data.Aeson                        as JSON
@@ -33,39 +34,22 @@ import PostgREST.Error     (Error (..))
 import PostgREST.GucHeader (GucHeader)
 
 import PostgREST.DbStructure.Identifiers (FieldName)
-import PostgREST.MediaType               (MTPlanAttrs (..),
-                                          MTPlanFormat (..),
-                                          MediaType (..),
-                                          getMediaType)
 import PostgREST.Query.SqlFragment
 import PostgREST.Request.Preferences
 
 import Protolude
 
--- | Standard result set format used for all queries
+{-| The generic query result format used by API responses. The location header
-data ResultSet
+    is represented as a list of strings containing variable bindings like
-  = RSStandard
+    @"k1=eq.42"@, or the empty list if there is no location header.
-  { rsTableTotal :: Maybe Int64
+-}
-  -- ^ count of all the table rows
+type ResultsWithCount = (Maybe Int64, Int64, [BS.ByteString], BS.ByteString, Either Error [GucHeader], Either Error (Maybe Status))
-  , rsQueryTotal :: Int64
-  -- ^ count of the query rows
-  , rsLocation   :: [(BS.ByteString, BS.ByteString)]
-  -- ^ The Location header(only used for inserts) is represented as a list of strings containing
-  -- variable bindings like @"k1=eq.42"@, or the empty list if there is no location header.
-  , rsBody       :: BS.ByteString
-  -- ^ the aggregated body of the query
-  , rsGucHeaders :: Either Error [GucHeader]
-  -- ^ the HTTP headers to be added to the response
-  , rsGucStatus  :: Either Error (Maybe Status)
-  -- ^ the HTTP status to be added to the response
-  }
-  | RSPlan BS.ByteString -- ^ the plan of the query
 
-
+createWriteStatement :: SQL.Snippet -> SQL.Snippet -> Bool -> Bool -> Bool ->
-prepareWrite :: SQL.Snippet -> SQL.Snippet -> Bool -> MediaType ->
+                        PreferRepresentation -> [Text] -> Bool ->
-                PreferRepresentation -> [Text] -> Bool -> SQL.Statement () ResultSet
+                        SQL.Statement () ResultsWithCount
-prepareWrite selectQuery mutateQuery isInsert mt rep pKeys =
+createWriteStatement selectQuery mutateQuery wantSingle isInsert asCsv rep pKeys =
-  SQL.dynamicallyParameterized (mtSnippet mt snippet) decodeIt
+  SQL.dynamicallyParameterized snippet decodeStandard
  where
   snippet =
     "WITH " <> SQL.sql sourceCTEName <> " AS (" <> mutateQuery <> ") " <>
@@ -81,7 +65,7 @@ prepareWrite selectQuery mutateQuery isInsert mt rep pKeys =
     "FROM (" <> selectF <> ") _postgrest_t"
 
   locF =
-    if isInsert && rep == HeadersOnly
+    if isInsert && rep `elem` [Full, HeadersOnly]
       then BS.unwords [
         "CASE WHEN pg_catalog.count(_postgrest_t) = 1",
           "THEN coalesce(" <> locationF pKeys <> ", " <> noLocationF <> ")",
@@ -90,25 +74,24 @@ prepareWrite selectQuery mutateQuery isInsert mt rep pKeys =
       else noLocationF
 
   bodyF
-    | rep /= Full                       = "''"
+    | rep `elem` [None, HeadersOnly] = "''"
-    | getMediaType mt == MTTextCSV      = asCsvF
+    | asCsv = asCsvF
-    | getMediaType mt == MTGeoJSON      = asGeoJsonF
+    | wantSingle = asJsonSingleF False
-    | getMediaType mt == MTSingularJSON = asJsonSingleF False
+    | otherwise = asJsonF False
-    | otherwise                         = asJsonF False
 
   selectF
     -- prevent using any of the column names in ?select= when no response is returned from the CTE
-    | rep /= Full = SQL.sql ("SELECT * FROM " <> sourceCTEName)
+    | rep `elem` [None, HeadersOnly] = SQL.sql ("SELECT * FROM " <> sourceCTEName)
-    | otherwise   = selectQuery
+    | otherwise                      = selectQuery
 
-  decodeIt :: HD.Result ResultSet
+  decodeStandard :: HD.Result ResultsWithCount
-  decodeIt = case mt of
+  decodeStandard =
-    MTPlan{} -> planRow
+   fromMaybe (Nothing, 0, [], mempty, Right [], Right Nothing) <$> HD.rowMaybe standardRow
-    _        -> fromMaybe (RSStandard Nothing 0 mempty mempty (Right []) (Right Nothing)) <$> HD.rowMaybe (standardRow False)
 
-prepareRead :: SQL.Snippet -> SQL.Snippet -> Bool -> MediaType -> Maybe FieldName -> Bool -> SQL.Statement () ResultSet
+createReadStatement :: SQL.Snippet -> SQL.Snippet -> Bool -> Bool -> Bool -> Maybe FieldName -> Bool ->
-prepareRead selectQuery countQuery countTotal mt binaryField =
+                       SQL.Statement () ResultsWithCount
-  SQL.dynamicallyParameterized (mtSnippet mt snippet) decodeIt
+createReadStatement selectQuery countQuery isSingle countTotal asCsv binaryField =
+  SQL.dynamicallyParameterized snippet decodeStandard
  where
   snippet =
     "WITH " <>
@@ -117,6 +100,7 @@ prepareRead selectQuery countQuery countTotal mt binaryField =
     SQL.sql ("SELECT " <>
       countResultF <> " AS total_result_set, " <>
       "pg_catalog.count(_postgrest_t) AS page_total, " <>
+      noLocationF <> " AS header, " <>
       bodyF <> " AS body, " <>
       responseHeadersF <> " AS response_headers, " <>
       responseStatusF <> " AS response_status " <>
@@ -125,23 +109,32 @@ prepareRead selectQuery countQuery countTotal mt binaryField =
   (countCTEF, countResultF) = countF countQuery countTotal
 
   bodyF
-    | getMediaType mt == MTTextCSV                       = asCsvF
+    | asCsv = asCsvF
-    | getMediaType mt == MTSingularJSON                  = asJsonSingleF False
+    | isSingle = asJsonSingleF False
-    | getMediaType mt == MTGeoJSON                       = asGeoJsonF
+    | isJust binaryField = asBinaryF $ fromJust binaryField
-    | isJust binaryField && getMediaType mt == MTTextXML = asXmlF $ fromJust binaryField
+    | otherwise = asJsonF False
-    | isJust binaryField                                 = asBinaryF $ fromJust binaryField
-    | otherwise                                          = asJsonF False
 
-  decodeIt :: HD.Result ResultSet
+  decodeStandard :: HD.Result ResultsWithCount
-  decodeIt = case mt of
+  decodeStandard =
-    MTPlan{} -> planRow
+    HD.singleRow standardRow
-    _        -> HD.singleRow $ standardRow True
 
-prepareCall :: Bool -> Bool -> SQL.Snippet -> SQL.Snippet -> SQL.Snippet -> Bool ->
+{-| Read and Write api requests use a similar response format which includes
-               MediaType -> Bool -> Maybe FieldName -> Bool ->
+    various record counts and possible location header. This is the decoder
-               SQL.Statement () ResultSet
+    for that common type of query.
-prepareCall returnsScalar returnsSingle callProcQuery selectQuery countQuery countTotal mt multObjects binaryField =
+-}
-  SQL.dynamicallyParameterized (mtSnippet mt snippet) decodeIt
+standardRow :: HD.Row ResultsWithCount
+standardRow = (,,,,,) <$> nullableColumn HD.int8 <*> column HD.int8
+                      <*> arrayColumn HD.bytea <*> column HD.bytea
+                      <*> (fromMaybe (Right []) <$> nullableColumn decodeGucHeaders)
+                      <*> (fromMaybe (Right Nothing) <$> nullableColumn decodeGucStatus)
+
+type ProcResults = (Maybe Int64, Int64, ByteString, Either Error [GucHeader], Either Error (Maybe Status))
+
+callProcStatement :: Bool -> Bool -> SQL.Snippet -> SQL.Snippet -> SQL.Snippet -> Bool ->
+                     Bool -> Bool -> Bool -> Maybe FieldName -> Bool ->
+                     SQL.Statement () ProcResults
+callProcStatement returnsScalar returnsSingle callProcQuery selectQuery countQuery countTotal asSingle asCsv multObjects binaryField =
+  SQL.dynamicallyParameterized snippet decodeProc
   where
     snippet =
       "WITH " <> SQL.sql sourceCTEName <> " AS (" <> callProcQuery <> ") " <>
@@ -158,50 +151,42 @@ prepareCall returnsScalar returnsSingle callProcQuery selectQuery countQuery cou
     (countCTEF, countResultF) = countF countQuery countTotal
 
     bodyF
-     | getMediaType mt == MTSingularJSON                  = asJsonSingleF returnsScalar
+     | asSingle           = asJsonSingleF returnsScalar
-     | getMediaType mt == MTTextCSV                       = asCsvF
+     | asCsv              = asCsvF
-     | getMediaType mt == MTGeoJSON                       = asGeoJsonF
+     | isJust binaryField = asBinaryF $ fromJust binaryField
-     | isJust binaryField && getMediaType mt == MTTextXML = asXmlF $ fromJust binaryField
+     | returnsSingle
-     | isJust binaryField                                 = asBinaryF $ fromJust binaryField
+       && not multObjects = asJsonSingleF returnsScalar
-     | returnsSingle && not multObjects                   = asJsonSingleF returnsScalar
+     | otherwise          = asJsonF returnsScalar
-     | otherwise                                          = asJsonF returnsScalar
 
-    decodeIt :: HD.Result ResultSet
+    decodeProc :: HD.Result ProcResults
-    decodeIt = case mt of
+    decodeProc =
-      MTPlan{} -> planRow
+      fromMaybe (Just 0, 0, mempty, defGucHeaders, defGucStatus) <$> HD.rowMaybe procRow
-      _        -> fromMaybe (RSStandard (Just 0) 0 mempty mempty (Right []) (Right Nothing)) <$> HD.rowMaybe (standardRow True)
+      where
+        defGucHeaders = Right []
+        defGucStatus  = Right Nothing
+        procRow = (,,,,) <$> nullableColumn HD.int8 <*> column HD.int8
+                         <*> column HD.bytea
+                         <*> (fromMaybe defGucHeaders <$> nullableColumn decodeGucHeaders)
+                         <*> (fromMaybe defGucStatus <$> nullableColumn decodeGucStatus)
 
-preparePlanRows :: SQL.Snippet -> Bool -> SQL.Statement () (Maybe Int64)
+createExplainStatement :: SQL.Snippet -> Bool -> SQL.Statement () (Maybe Int64)
-preparePlanRows countQuery =
+createExplainStatement countQuery =
-  SQL.dynamicallyParameterized snippet decodeIt
+  SQL.dynamicallyParameterized snippet decodeExplain
   where
-    snippet = explainF PlanJSON mempty countQuery
+    snippet = "EXPLAIN (FORMAT JSON) " <> countQuery
-    decodeIt :: HD.Result (Maybe Int64)
+    -- |
-    decodeIt =
+    -- An `EXPLAIN (FORMAT JSON) select * from items;` output looks like this:
+    -- [{
+    --   "Plan": {
+    --     "Node Type": "Seq Scan", "Parallel Aware": false, "Relation Name": "items",
+    --     "Alias": "items", "Startup Cost": 0.00, "Total Cost": 32.60,
+    --     "Plan Rows": 2260,"Plan Width": 8} }]
+    -- We only obtain the Plan Rows here.
+    decodeExplain :: HD.Result (Maybe Int64)
+    decodeExplain =
       let row = HD.singleRow $ column HD.bytea in
       (^? L.nth 0 . L.key "Plan" .  L.key "Plan Rows" . L._Integral) <$> row
 
-standardRow :: Bool -> HD.Row ResultSet
-standardRow noLocation =
-  RSStandard <$> nullableColumn HD.int8 <*> column HD.int8
-             <*> (if noLocation then pure mempty else fmap splitKeyValue <$> arrayColumn HD.bytea) <*> column HD.bytea
-             <*> (fromMaybe (Right []) <$> nullableColumn decodeGucHeaders)
-             <*> (fromMaybe (Right Nothing) <$> nullableColumn decodeGucStatus)
-  where
-    splitKeyValue :: ByteString -> (ByteString, ByteString)
-    splitKeyValue kv =
-      let (k, v) = BS.break (== '=') kv in
-      (k, BS.tail v)
-
-mtSnippet :: MediaType -> SQL.Snippet -> SQL.Snippet
-mtSnippet mediaType snippet = case mediaType of
-  MTPlan (MTPlanAttrs _ fmt opts) -> explainF fmt opts snippet
-  _                               -> snippet
-
--- | We use rowList because when doing EXPLAIN (FORMAT TEXT), the result comes as many rows. FORMAT JSON comes as one.
-planRow :: HD.Result ResultSet
-planRow = RSPlan . BS.unlines <$> HD.rowList (column HD.bytea)
-
 decodeGucHeaders :: HD.Value (Either Error [GucHeader])
 decodeGucHeaders = first (const GucHeadersError) . JSON.eitherDecode . LBS.fromStrict <$> HD.bytea
 

src/PostgREST/RangeQuery.hs

@@ -10,8 +10,6 @@ module PostgREST.RangeQuery (
 , restrictRange
 , rangeGeq
 , allRange
-, limitZeroRange
-, hasLimitZero
 , NonnegRange
 , rangeStatusHeader
 , contentRangeH
@@ -36,14 +34,13 @@ rangeParse :: BS.ByteString -> NonnegRange
 rangeParse range = do
   let rangeRegex = "^([0-9]+)-([0-9]*)$" :: BS.ByteString
 
-  case range =~ rangeRegex :: [[BS.ByteString]] of
+  case listToMaybe (range =~ rangeRegex :: [[BS.ByteString]]) of
-    [[_, l, u]] ->
+    Just parsedRange ->
-      let lower  = maybe emptyRange rangeGeq (readInteger l)
+      let [_, mLower, mUpper] = readMaybe . BS.unpack <$> parsedRange
-          upper  = maybe allRange rangeLeq (readInteger u) in
+          lower         = maybe emptyRange rangeGeq mLower
+          upper         = maybe allRange rangeLeq mUpper in
       rangeIntersection lower upper
-    _ -> allRange
+    Nothing -> allRange
-  where
-    readInteger = readMaybe . BS.unpack
 
 rangeRequested :: RequestHeaders -> NonnegRange
 rangeRequested headers = maybe allRange rangeParse $ lookup hRange headers
@@ -77,15 +74,6 @@ rangeLeq :: Integer -> NonnegRange
 rangeLeq n =
   Range BoundaryBelowAll (BoundaryAbove n)
 
--- Special case to allow limit 0 queries
--- https://github.com/PostgREST/postgrest/issues/1121
--- 0 <= x <= -1
-limitZeroRange :: Range Integer
-limitZeroRange = Range (BoundaryBelow 0) (BoundaryAbove (-1))
-
-hasLimitZero :: Range Integer -> Bool
-hasLimitZero r = rangeUpper r == rangeUpper limitZeroRange
-
 rangeStatusHeader :: NonnegRange -> Int64 -> Maybe Int64 -> (Status, Header)
 rangeStatusHeader topLevelRange queryTotal tableTotal =
   let lower = rangeOffset topLevelRange

src/PostgREST/Request/ApiRequest.hs

@@ -9,8 +9,7 @@ Description : PostgREST functions to translate HTTP request to a domain type cal
 module PostgREST.Request.ApiRequest
   ( ApiRequest(..)
   , InvokeMethod(..)
-  , Mutation(..)
+  , ContentType(..)
-  , MediaType(..)
   , Action(..)
   , Target(..)
   , Payload(..)
@@ -18,57 +17,57 @@ module PostgREST.Request.ApiRequest
   ) where
 
 import qualified Data.Aeson            as JSON
-import qualified Data.Aeson.Key        as K
-import qualified Data.Aeson.KeyMap     as KM
 import qualified Data.ByteString.Char8 as BS
 import qualified Data.ByteString.Lazy  as LBS
 import qualified Data.CaseInsensitive  as CI
 import qualified Data.Csv              as CSV
-import qualified Data.HashMap.Strict   as HM
+import qualified Data.HashMap.Strict   as M
 import qualified Data.List             as L
 import qualified Data.List.NonEmpty    as NonEmptyList
-import qualified Data.Map.Strict       as M
 import qualified Data.Set              as S
+import qualified Data.Text             as T
 import qualified Data.Text.Encoding    as T
 import qualified Data.Vector           as V
 
 import Control.Arrow             ((***))
 import Data.Aeson.Types          (emptyArray, emptyObject)
-import Data.List                 (lookup, union)
+import Data.List                 (last, lookup, partition, union)
 import Data.Maybe                (fromJust)
-import Data.Ranged.Ranges        (emptyRange, rangeIntersection)
+import Data.Ranged.Boundaries    (Boundary (..))
-import Network.HTTP.Types.Header (hCookie)
+import Data.Ranged.Ranges        (Range (..), emptyRange,
-import Network.HTTP.Types.URI    (parseSimpleQuery)
+                                  rangeIntersection)
+import Network.HTTP.Base         (urlEncodeVars)
+import Network.HTTP.Types.Header (hAuthorization, hCookie)
+import Network.HTTP.Types.URI    (parseQueryReplacePlus,
+                                  parseSimpleQuery)
 import Network.Wai               (Request (..))
 import Network.Wai.Parse         (parseHttpAccept)
 import Web.Cookie                (parseCookies)
 
 import PostgREST.Config                  (AppConfig (..),
                                           OpenAPIMode (..))
+import PostgREST.ContentType             (ContentType (..))
 import PostgREST.DbStructure             (DbStructure (..))
 import PostgREST.DbStructure.Identifiers (FieldName,
                                           QualifiedIdentifier (..),
                                           Schema)
 import PostgREST.DbStructure.Proc        (ProcDescription (..),
                                           ProcParam (..), ProcsMap)
-import PostgREST.MediaType               (MTPlanAttrs (..),
+import PostgREST.Error                   (ApiRequestError (..))
-                                          MTPlanFormat (..),
+import PostgREST.Query.SqlFragment       (ftsOperators, operators)
-                                          MediaType (..))
 import PostgREST.RangeQuery              (NonnegRange, allRange,
-                                          hasLimitZero,
+                                          rangeGeq, rangeLimit,
-                                          limitZeroRange,
+                                          rangeOffset, rangeRequested,
-                                          rangeRequested)
+                                          restrictRange)
+import PostgREST.Request.Parsers         (pRequestColumns)
 import PostgREST.Request.Preferences     (PreferCount (..),
                                           PreferParameters (..),
                                           PreferRepresentation (..),
                                           PreferResolution (..),
                                           PreferTransaction (..))
-import PostgREST.Request.QueryParams     (QueryParams (..))
-import PostgREST.Request.Types           (ApiRequestError (..))
 
-import qualified PostgREST.MediaType           as MediaType
+import qualified PostgREST.ContentType         as ContentType
 import qualified PostgREST.Request.Preferences as Preferences
-import qualified PostgREST.Request.QueryParams as QueryParams
 
 import Protolude
 
@@ -90,28 +89,27 @@ data Payload
   | RawPay  { payRaw  :: LBS.ByteString }
 
 data InvokeMethod = InvHead | InvGet | InvPost deriving Eq
-data Mutation = MutationCreate | MutationDelete | MutationSingleUpsert | MutationUpdate deriving Eq
-
 -- | Types of things a user wants to do to tables/views/procs
-data Action
+data Action = ActionCreate       | ActionRead{isHead :: Bool}
-  = ActionMutate Mutation
+            | ActionUpdate       | ActionDelete
-  | ActionRead {isHead :: Bool}
+            | ActionSingleUpsert | ActionInvoke InvokeMethod
-  | ActionInvoke InvokeMethod
+            | ActionInfo         | ActionInspect{isHead :: Bool}
-  | ActionInfo
+            deriving Eq
-  | ActionInspect {isHead :: Bool}
-  deriving Eq
 -- | The path info that will be mapped to a target (used to handle validations and errors before defining the Target)
-data PathInfo
+data Path
   = PathInfo
-      { pathName       :: Text
+      { pSchema        :: Schema,
-      , pathIsProc     :: Bool
+        pName          :: Text,
-      , pathIsDefSpec  :: Bool
+        pHasRpc        :: Bool,
-      , pathIsRootSpec :: Bool
+        pIsDefaultSpec :: Bool,
+        pIsRootSpec    :: Bool
       }
+  | PathUnknown
 -- | The target db object of a user action
 data Target = TargetIdent QualifiedIdentifier
             | TargetProc{tProc :: ProcDescription, tpIsRootSpec :: Bool}
             | TargetDefaultSpec{tdsSchema :: Schema} -- The default spec offered at root "/"
+            | TargetUnknown
 
 -- | 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.
@@ -130,10 +128,10 @@ toRpcParamValue proc (k, v) | prmIsVariadic k = (k, Variadic [v])
 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)
+    ProcessedJSON (JSON.encode $ M.fromList $ second JSON.toJSON <$> prms) (S.fromList $ fst <$> prms)
   else
-    let paramsMap = HM.fromListWith mergeParams $ toRpcParamValue proc <$> prms in
+    let paramsMap = M.fromListWith mergeParams $ toRpcParamValue proc <$> prms in
-    ProcessedJSON (JSON.encode paramsMap) (S.fromList $ HM.keys paramsMap)
+    ProcessedJSON (JSON.encode paramsMap) (S.fromList $ M.keys paramsMap)
   where
     mergeParams :: RpcParamValue -> RpcParamValue -> RpcParamValue
     mergeParams (Variadic a) (Variadic b) = Variadic $ b ++ a
@@ -153,8 +151,8 @@ targetToJsonRpcParams target params =
   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 verb, e.g. Create/Invoke both POST
-  , iRange                :: HM.HashMap Text NonnegRange      -- ^ Requested range of rows within response
+  , iRange                :: M.HashMap Text NonnegRange -- ^ Requested range of rows within response
   , iTopLevelRange        :: NonnegRange                      -- ^ Requested range of rows from the top level
   , iTarget               :: Target                           -- ^ The target, be it calling a proc or accessing a table
   , iPayload              :: Maybe Payload                    -- ^ Data sent by client and used for mutation actions
@@ -163,67 +161,33 @@ data ApiRequest = ApiRequest {
   , iPreferCount          :: Maybe PreferCount                -- ^ Whether the client wants a result count
   , iPreferResolution     :: Maybe PreferResolution           -- ^ Whether the client wants to UPSERT or ignore records on PK conflict
   , iPreferTransaction    :: Maybe PreferTransaction          -- ^ Whether the clients wants to commit or rollback the transaction
-  , iQueryParams          :: QueryParams.QueryParams
+  , iFilters              :: [(Text, Text)]                   -- ^ Filters on the result ("id", "eq.10")
+  , iLogic                :: [(Text, Text)]                   -- ^ &and and &or parameters used for complex boolean logic
+  , iSelect               :: Maybe Text                       -- ^ &select parameter used to shape the response
+  , iOnConflict           :: Maybe Text                       -- ^ &on_conflict parameter used to upsert on specific unique keys
   , iColumns              :: S.Set FieldName                  -- ^ parsed colums from &columns parameter and payload
+  , iOrder                :: [(Text, Text)]                   -- ^ &order parameters for each level
+  , iCanonicalQS          :: ByteString                       -- ^ Alphabetized (canonical) request query string for response URLs
+  , iJWT                  :: Text                             -- ^ JSON Web Token
   , iHeaders              :: [(ByteString, ByteString)]       -- ^ HTTP request headers
   , iCookies              :: [(ByteString, ByteString)]       -- ^ Request Cookies
   , iPath                 :: ByteString                       -- ^ Raw request path
   , iMethod               :: ByteString                       -- ^ Raw request method
   , iProfile              :: Maybe Schema                     -- ^ The request profile for enabling use of multiple schemas. Follows the spec in hhttps://www.w3.org/TR/dx-prof-conneg/ttps://www.w3.org/TR/dx-prof-conneg/.
   , iSchema               :: Schema                           -- ^ The request schema. Can vary depending on iProfile.
-  , iAcceptMediaType      :: MediaType
+  , iAcceptContentType    :: ContentType
   }
 
 -- | Examines HTTP request and translates it into user intent.
 userApiRequest :: AppConfig -> DbStructure -> Request -> RequestBody -> Either ApiRequestError ApiRequest
-userApiRequest conf dbStructure req reqBody = do
+userApiRequest conf@AppConfig{..} dbStructure req reqBody
-  qPrms <- first QueryParamError $ QueryParams.parse $ rawQueryString req
-  pInfo <- getPathInfo conf $ pathInfo req
-  act <- getAction pInfo $ requestMethod req
-  apiRequest conf dbStructure req reqBody qPrms pInfo act
-
-getPathInfo :: AppConfig -> [Text] -> Either ApiRequestError PathInfo
-getPathInfo AppConfig{configOpenApiMode, configDbRootSpec} path =
-  case path of
-    []             -> case configDbRootSpec of
-                        Just (QualifiedIdentifier _ pathName)     -> Right $ PathInfo pathName True False True
-                        Nothing | configOpenApiMode == OADisabled -> Left NotFound
-                                | otherwise                       -> Right $ PathInfo mempty False True False
-    [table]        -> Right $ PathInfo table False False False
-    ["rpc", pName] -> Right $ PathInfo pName True False False
-    _              -> Left NotFound
-
-getAction :: PathInfo -> ByteString -> Either ApiRequestError Action
-getAction PathInfo{pathIsProc, pathIsDefSpec} method =
-  if pathIsProc && method `notElem` ["HEAD", "GET", "POST", "OPTIONS"]
-    then Left $ InvalidRpcMethod method
-    else case method of
-      -- The HEAD method is identical to GET except that the server MUST NOT return a message-body in the response
-      -- From https://www.w3.org/Protocols/rfc2616/rfc2616-sec9.html#sec9.4
-      "HEAD"     | pathIsDefSpec -> Right $ ActionInspect{isHead=True}
-                 | pathIsProc    -> Right $ ActionInvoke InvHead
-                 | otherwise     -> Right $ ActionRead{isHead=True}
-      "GET"      | pathIsDefSpec -> Right $ ActionInspect{isHead=False}
-                 | pathIsProc    -> Right $ ActionInvoke InvGet
-                 | otherwise     -> Right $ ActionRead{isHead=False}
-      "POST"     | pathIsProc    -> Right $ ActionInvoke InvPost
-                 | otherwise     -> Right $ ActionMutate MutationCreate
-      "PATCH"                    -> Right $ ActionMutate MutationUpdate
-      "PUT"                      -> Right $ ActionMutate MutationSingleUpsert
-      "DELETE"                   -> Right $ ActionMutate MutationDelete
-      "OPTIONS"                  -> Right ActionInfo
-      _                          -> Left $ UnsupportedMethod method
-
-apiRequest :: AppConfig -> DbStructure -> Request -> RequestBody -> QueryParams.QueryParams -> PathInfo -> Action -> Either ApiRequestError ApiRequest
-apiRequest conf@AppConfig{..} dbStructure req reqBody queryparams@QueryParams{..} path@PathInfo{pathName, pathIsProc, pathIsRootSpec, pathIsDefSpec} action
   | isJust profile && fromJust profile `notElem` configDbSchemas = Left $ UnacceptableSchema $ toList configDbSchemas
-  | isInvalidRange = Left InvalidRange
+  | isTargetingProc && method `notElem` ["HEAD", "GET", "POST"] = Left ActionInappropriate
+  | topLevelRange == emptyRange = Left InvalidRange
   | shouldParsePayload && isLeft payload = either (Left . InvalidBody) witness payload
-  | not expectParams && not (L.null qsParams) = Left $ ParseRequestError "Unexpected param or filter missing operator" ("Failed to parse " <> show qsParams)
+  | isLeft parsedColumns = either Left witness parsedColumns
-  | method `elem` ["PATCH", "DELETE"] && not (null qsRanges) && null qsOrder = Left LimitNoOrderError
-  | method == "PUT" && topLevelRange /= allRange = Left PutRangeNotAllowedError
   | otherwise = do
-     acceptMediaType <- findAcceptMediaType conf action path accepts
+     acceptContentType <- findAcceptContentType conf action path accepts
      checkedTarget <- target
      return ApiRequest {
       iAction = action
@@ -236,128 +200,196 @@ apiRequest conf@AppConfig{..} dbStructure req reqBody queryparams@QueryParams{..
       , iPreferCount = preferCount
       , iPreferResolution = preferResolution
       , iPreferTransaction = preferTransaction
-      , iQueryParams = queryparams
+      , iFilters = filters
+      , iLogic = [(toS k, toS $ fromJust v) | (k,v) <- qParams, isJust v, endingIn ["and", "or"] k ]
+      , iSelect = toS <$> join (lookup "select" qParams)
+      , iOnConflict = toS <$> join (lookup "on_conflict" qParams)
       , iColumns = payloadColumns
+      , iOrder = [(toS k, toS $ fromJust v) | (k,v) <- qParams, isJust v, endingIn ["order"] k ]
+      , iCanonicalQS = BS.pack $ urlEncodeVars
+        . L.sortOn fst
+        . map (join (***) BS.unpack . second (fromMaybe mempty))
+        $ qString
+      , iJWT = tokenStr
       , iHeaders = [ (CI.foldedCase k, v) | (k,v) <- hdrs, k /= hCookie]
       , iCookies = maybe [] parseCookies $ lookupHeader "Cookie"
       , iPath = rawPathInfo req
       , iMethod = method
       , iProfile = profile
       , iSchema = schema
-      , iAcceptMediaType = acceptMediaType
+      , iAcceptContentType = acceptContentType
       }
  where
-  accepts = maybe [MTAny] (map MediaType.decodeMediaType . parseHttpAccept) $ lookupHeader "accept"
+  accepts = maybe [CTAny] (map ContentType.decodeContentType . parseHttpAccept) $ lookupHeader "accept"
-
+  -- queryString with '+' converted to ' '(space)
-  expectParams = pathIsProc && method /= "POST"
+  qString = parseQueryReplacePlus True $ rawQueryString req
-
+  -- rpcQParams = Rpc query params e.g. /rpc/name?param1=val1, similar to filter but with no operator(eq, lt..)
-  contentMediaType = maybe MTApplicationJSON MediaType.decodeMediaType $ lookupHeader "content-type"
+  (filters, rpcQParams) =
-
+    case action of
-  columns = case action of
+      ActionInvoke InvGet  -> partitionFlts
-    ActionMutate MutationCreate -> qsColumns
+      ActionInvoke InvHead -> partitionFlts
-    ActionMutate MutationUpdate -> qsColumns
+      _                    -> (flts, [])
-    ActionInvoke InvPost        -> qsColumns
+  partitionFlts = partition (liftM2 (||) (isEmbedPath . fst) (hasOperator . snd)) flts
-    _                           -> Nothing
+  flts =
-
+    [ (toS k, toS $ fromJust v) |
+      (k,v) <- qParams, isJust v,
+      k `notElem` ["select", "columns"],
+      not (endingIn ["order", "limit", "offset", "and", "or"] k) ]
+  hasOperator val = any (`T.isPrefixOf` val) $
+                      ((<> ".") <$> "not":M.keys operators) ++
+                      ((<> "(") <$> M.keys ftsOperators)
+  isEmbedPath = T.isInfixOf "."
+  isTargetingProc = case path of
+    PathInfo{pHasRpc, pIsRootSpec} -> pHasRpc || pIsRootSpec
+    _                              -> False
+  isTargetingDefaultSpec = case path of
+    PathInfo{pIsDefaultSpec=True} -> True
+    _                             -> False
+  contentType = maybe CTApplicationJSON ContentType.decodeContentType $ lookupHeader "content-type"
+  columns
+    | action `elem` [ActionCreate, ActionUpdate, ActionInvoke InvPost] = toS <$> join (lookup "columns" qParams)
+    | otherwise = Nothing
+  parsedColumns = pRequestColumns columns
   payloadColumns =
-    case (contentMediaType, action) of
+    case (contentType, action) of
-      (_, ActionInvoke InvGet)  -> S.fromList $ fst <$> qsParams
+      (_, ActionInvoke InvGet)  -> S.fromList $ fst <$> rpcQParams
-      (_, ActionInvoke InvHead) -> S.fromList $ fst <$> qsParams
+      (_, ActionInvoke InvHead) -> S.fromList $ fst <$> rpcQParams
-      (MTUrlEncoded, _)         -> S.fromList $ map (T.decodeUtf8 . fst) $ parseSimpleQuery $ LBS.toStrict reqBody
+      (CTUrlEncoded, _)         -> S.fromList $ map (T.decodeUtf8 . fst) $ parseSimpleQuery $ LBS.toStrict reqBody
-      _ -> case (relevantPayload, columns) of
+      _ -> case (relevantPayload, fromRight Nothing parsedColumns) of
         (Just ProcessedJSON{payKeys}, _) -> payKeys
         (Just RawJSON{}, Just cls)       -> cls
         _                                -> S.empty
   payload :: Either ByteString Payload
-  payload = case (contentMediaType, pathIsProc) of
+  payload = case contentType of
-    (MTApplicationJSON, _) ->
+    CTApplicationJSON ->
       if isJust columns
         then Right $ RawJSON reqBody
         else note "All object keys must match" . payloadAttributes reqBody
-               =<< if LBS.null reqBody && pathIsProc
+               =<< if LBS.null reqBody && isTargetingProc
                      then Right emptyObject
                      else first BS.pack $ JSON.eitherDecode reqBody
-    (MTTextCSV, _) -> do
+    CTTextCSV -> do
       json <- csvToJson <$> first BS.pack (CSV.decodeByName reqBody)
       note "All lines must have same number of fields" $ payloadAttributes (JSON.encode json) json
-    (MTUrlEncoded, _) ->
+    CTUrlEncoded ->
-      let paramsMap = HM.fromList $ (T.decodeUtf8 *** JSON.String . T.decodeUtf8) <$> parseSimpleQuery (LBS.toStrict reqBody) in
+      let paramsMap = M.fromList $ (T.decodeUtf8 *** JSON.String . T.decodeUtf8) <$> parseSimpleQuery (LBS.toStrict reqBody) in
-      Right $ ProcessedJSON (JSON.encode paramsMap) $ S.fromList (HM.keys paramsMap)
+      Right $ ProcessedJSON (JSON.encode paramsMap) $ S.fromList (M.keys paramsMap)
-    (MTTextPlain, True) -> Right $ RawPay reqBody
+    ct ->
-    (MTTextXML, True) -> Right $ RawPay reqBody
+      if isTargetingProc && ct `elem` [CTTextPlain, CTOctetStream]
-    (MTOctetStream, True) -> Right $ RawPay reqBody
+        then Right $ RawPay reqBody
-    (ct, _) -> Left $ "Content-Type not acceptable: " <> MediaType.toMime ct
+        else Left $ "Content-Type not acceptable: " <> ContentType.toMime ct
-  topLevelRange = fromMaybe allRange $ HM.lookup "limit" ranges -- if no limit is specified, get all the request rows
+  topLevelRange = fromMaybe allRange $ M.lookup "limit" ranges -- if no limit is specified, get all the request rows
+  action =
+    case method of
+      -- The HEAD method is identical to GET except that the server MUST NOT return a message-body in the response
+      -- From https://www.w3.org/Protocols/rfc2616/rfc2616-sec9.html#sec9.4
+      "HEAD"     | isTargetingDefaultSpec -> ActionInspect{isHead=True}
+                 | isTargetingProc        -> ActionInvoke InvHead
+                 | otherwise              -> ActionRead{isHead=True}
+      "GET"      | isTargetingDefaultSpec -> ActionInspect{isHead=False}
+                 | isTargetingProc        -> ActionInvoke InvGet
+                 | otherwise              -> ActionRead{isHead=False}
+      "POST"    -> if isTargetingProc
+                    then ActionInvoke InvPost
+                    else ActionCreate
+      "PATCH"   -> ActionUpdate
+      "PUT"     -> ActionSingleUpsert
+      "DELETE"  -> ActionDelete
+      "OPTIONS" -> ActionInfo
+      _         -> ActionInspect{isHead=False}
 
   defaultSchema = NonEmptyList.head configDbSchemas
   profile
     | length configDbSchemas <= 1 -- only enable content negotiation by profile when there are multiple schemas specified in the config
       = Nothing
-    | otherwise = case method of
+    | otherwise = case action of
         -- POST/PATCH/PUT/DELETE don't use the same header as per the spec
-        "DELETE" -> contentProfile
+        ActionCreate         -> contentProfile
-        "PATCH"  -> contentProfile
+        ActionUpdate         -> contentProfile
-        "POST"   -> contentProfile
+        ActionSingleUpsert   -> contentProfile
-        "PUT"    -> contentProfile
+        ActionDelete         -> contentProfile
-        _        -> acceptProfile
+        ActionInvoke InvPost -> contentProfile
+        _                    -> acceptProfile
     where
       contentProfile = Just $ maybe defaultSchema T.decodeUtf8 $ lookupHeader "Content-Profile"
       acceptProfile = Just $ maybe defaultSchema T.decodeUtf8 $ lookupHeader "Accept-Profile"
-
   schema = fromMaybe defaultSchema profile
-
+  target =
-  target
+    let
-    | pathIsProc    = (`TargetProc` pathIsRootSpec) <$> callFindProc schema pathName
-    | pathIsDefSpec = Right $ TargetDefaultSpec schema
-    | otherwise     = Right $ TargetIdent $ QualifiedIdentifier schema pathName
-    where
       callFindProc procSch procNam = findProc
         (QualifiedIdentifier procSch procNam) payloadColumns (preferParameters == Just SingleObject) (dbProcs dbStructure)
-        contentMediaType (action == ActionInvoke InvPost)
+        contentType (action == ActionInvoke InvPost)
+    in
+    case path of
+      PathInfo{pSchema, pName, pHasRpc, pIsRootSpec, pIsDefaultSpec}
+        | pHasRpc || pIsRootSpec -> (`TargetProc` pIsRootSpec) <$> callFindProc pSchema pName
+        | pIsDefaultSpec         -> Right $ TargetDefaultSpec pSchema
+        | otherwise              -> Right $ TargetIdent $ QualifiedIdentifier pSchema pName
+      PathUnknown -> Right TargetUnknown
 
-  shouldParsePayload = case (action, contentMediaType) of
+  shouldParsePayload = case (contentType, action) of
-    (ActionMutate MutationCreate, _)       -> True
+    (CTUrlEncoded, ActionInvoke InvPost) -> False
-    (ActionInvoke InvPost, MTUrlEncoded)   -> False
+    (_, act)                             -> act `elem` [ActionCreate, ActionUpdate, ActionSingleUpsert, ActionInvoke InvPost]
-    (ActionInvoke InvPost, _)              -> True
+  relevantPayload = case (contentType, action) of
-    (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 InvGet)             -> targetToJsonRpcParams (rightToMaybe target) rpcQParams
-    (_, ActionInvoke InvHead)            -> targetToJsonRpcParams (rightToMaybe target) qsParams
+    (_, ActionInvoke InvHead)            -> targetToJsonRpcParams (rightToMaybe target) rpcQParams
-    (MTUrlEncoded, ActionInvoke InvPost) -> targetToJsonRpcParams (rightToMaybe target) $ (T.decodeUtf8 *** T.decodeUtf8) <$> parseSimpleQuery (LBS.toStrict reqBody)
+    (CTUrlEncoded, ActionInvoke InvPost) -> targetToJsonRpcParams (rightToMaybe target) $ (T.decodeUtf8 *** T.decodeUtf8) <$> parseSimpleQuery (LBS.toStrict reqBody)
     _ | shouldParsePayload               -> rightToMaybe payload
       | otherwise                        -> Nothing
+  path =
+    case pathInfo req of
+      []             -> case configDbRootSpec of
+                          Just (QualifiedIdentifier pSch pName)     -> PathInfo (if pSch == mempty then schema else pSch) pName False False True
+                          Nothing | configOpenApiMode == OADisabled -> PathUnknown
+                                  | otherwise                       -> PathInfo schema "" False True False
+      [table]        -> PathInfo schema table False False False
+      ["rpc", pName] -> PathInfo schema pName True False False
+      _              -> PathUnknown
   method          = requestMethod req
   hdrs            = requestHeaders req
+  qParams         = [(T.decodeUtf8 k, T.decodeUtf8 <$> v)|(k,v) <- qString]
   lookupHeader    = flip lookup hdrs
   Preferences.Preferences{..} = Preferences.fromHeaders hdrs
-  headerRange = rangeRequested hdrs
+  auth = fromMaybe "" $ lookupHeader hAuthorization
-  limitRange = fromMaybe allRange (HM.lookup "limit" qsRanges)
+  tokenStr = case T.split (== ' ') (T.decodeUtf8 auth) of
-  headerAndLimitRange = rangeIntersection headerRange limitRange
+    ("Bearer" : t : _) -> t
+    ("bearer" : t : _) -> t
+    _                  -> ""
+  endingIn:: [Text] -> Text -> Bool
+  endingIn xx key = lastWord `elem` xx
+    where lastWord = last $ T.split (=='.') key
 
-  -- Bypass all the ranges and send only the limit zero range (0 <= x <= -1) if
+  headerRange = rangeRequested hdrs
-  -- limit=0 is present in the query params (not allowed for the Range header)
+  replaceLast x s = T.intercalate "." $ L.init (T.split (=='.') s) ++ [x]
-  ranges = HM.insert "limit" (if hasLimitZero limitRange then limitZeroRange else headerAndLimitRange) qsRanges
+  limitParams :: M.HashMap Text NonnegRange
-  -- The only emptyRange allowed is the limit zero range
+  limitParams  = M.fromList [(toS (replaceLast "limit" k), restrictRange (readMaybe =<< v) allRange) | (k,v) <- qParams, isJust v, endingIn ["limit"] k]
-  isInvalidRange = topLevelRange == emptyRange && not (hasLimitZero limitRange)
+  offsetParams :: M.HashMap Text NonnegRange
+  offsetParams = M.fromList [(toS (replaceLast "limit" k), maybe allRange rangeGeq (readMaybe =<< v)) | (k,v) <- qParams, isJust v, endingIn ["offset"] k]
+
+  urlRange = M.unionWith f limitParams offsetParams
+    where
+      f rl ro = Range (BoundaryBelow o) (BoundaryAbove $ o + l - 1)
+        where
+          l = fromMaybe 0 $ rangeLimit rl
+          o = rangeOffset ro
+  ranges = M.insert "limit" (rangeIntersection headerRange (fromMaybe allRange (M.lookup "limit" urlRange))) urlRange
 
 {-|
-  Find the best match from a list of media types accepted by the
+  Find the best match from a list of content 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 :: [ContentType] -> [ContentType] -> Maybe ContentType
 mutuallyAgreeable sProduces cAccepts =
   let exact = listToMaybe $ L.intersect cAccepts sProduces in
-  if isNothing exact && MTAny `elem` cAccepts
+  if isNothing exact && CTAny `elem` cAccepts
      then listToMaybe sProduces
      else exact
 
-type CsvData = V.Vector (M.Map Text LBS.ByteString)
+type CsvData = V.Vector (M.HashMap Text LBS.ByteString)
 
 {-|
   Converts CSV like
@@ -375,7 +407,7 @@ csvToJson :: (CSV.Header, CsvData) -> JSON.Value
 csvToJson (_, vals) =
   JSON.Array $ V.map rowToJsonObj vals
  where
-  rowToJsonObj = JSON.Object . KM.fromMapText .
+  rowToJsonObj = JSON.Object .
     M.map (\str ->
         if str == "NULL"
           then JSON.Null
@@ -389,9 +421,9 @@ payloadAttributes raw json =
     JSON.Array arr ->
       case arr V.!? 0 of
         Just (JSON.Object o) ->
-          let canonicalKeys = S.fromList $ K.toText <$> KM.keys o
+          let canonicalKeys = S.fromList $ M.keys o
               areKeysUniform = all (\case
-                JSON.Object x -> S.fromList (K.toText <$> KM.keys x) == canonicalKeys
+                JSON.Object x -> S.fromList (M.keys x) == canonicalKeys
                 _ -> False) arr in
           if areKeysUniform
             then Just $ ProcessedJSON raw canonicalKeys
@@ -399,47 +431,49 @@ payloadAttributes raw json =
         Just _ -> Nothing
         Nothing -> Just emptyPJArray
 
-    JSON.Object o -> Just $ ProcessedJSON raw (S.fromList $ K.toText <$> KM.keys o)
+    JSON.Object o -> Just $ ProcessedJSON raw (S.fromList $ M.keys o)
 
     -- truncate everything else to an empty array.
     _ -> Just emptyPJArray
   where
     emptyPJArray = ProcessedJSON (JSON.encode emptyArray) S.empty
 
-findAcceptMediaType :: AppConfig -> Action -> PathInfo -> [MediaType] -> Either ApiRequestError MediaType
+findAcceptContentType :: AppConfig -> Action -> Path -> [ContentType] -> Either ApiRequestError ContentType
-findAcceptMediaType conf action path accepts =
+findAcceptContentType conf action path accepts =
-  case mutuallyAgreeable (requestMediaTypes conf action path) accepts of
+  case mutuallyAgreeable (requestContentTypes conf action path) accepts of
     Just ct ->
       Right ct
     Nothing ->
-      Left . MediaTypeError $ map MediaType.toMime accepts
+      Left . ContentTypeError $ map ContentType.toMime accepts
 
-requestMediaTypes :: AppConfig -> Action -> PathInfo -> [MediaType]
+requestContentTypes :: AppConfig -> Action -> Path -> [ContentType]
-requestMediaTypes conf action path =
+requestContentTypes conf action path =
   case action of
-    ActionRead _    -> defaultMediaTypes ++ rawMediaTypes
+    ActionRead _    -> defaultContentTypes ++ rawContentTypes conf
-    ActionInvoke _  -> invokeMediaTypes
+    ActionInvoke _  -> invokeContentTypes
-    ActionInspect _ -> [MTOpenAPI, MTApplicationJSON]
+    ActionInspect _ -> [CTOpenAPI, CTApplicationJSON]
-    ActionInfo      -> [MTTextCSV]
+    ActionInfo      -> [CTTextCSV]
-    _               -> defaultMediaTypes
+    _               -> defaultContentTypes
   where
-    invokeMediaTypes =
+    invokeContentTypes =
-      defaultMediaTypes
+      defaultContentTypes
-        ++ rawMediaTypes
+        ++ rawContentTypes conf
-        ++ [MTOpenAPI | pathIsRootSpec path]
+        ++ [CTOpenAPI | pIsRootSpec path]
-    defaultMediaTypes =
+    defaultContentTypes =
-      [MTApplicationJSON, MTSingularJSON, MTGeoJSON, MTTextCSV] ++
+      [CTApplicationJSON, CTSingularJSON, CTTextCSV]
-      [MTPlan $ MTPlanAttrs Nothing PlanJSON mempty | configDbPlanEnabled conf]
+
-    rawMediaTypes = configRawMediaTypes conf `union` [MTOctetStream, MTTextPlain, MTTextXML]
+rawContentTypes :: AppConfig -> [ContentType]
+rawContentTypes AppConfig{..} =
+  (ContentType.decodeContentType <$> configRawMediaTypes) `union` [CTOctetStream, CTTextPlain]
 
 {-|
   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 :: QualifiedIdentifier -> S.Set Text -> Bool -> ProcsMap -> ContentType -> Bool -> Either ApiRequestError ProcDescription
-findProc qi argumentsKeys paramsAsSingleObject allProcs contentMediaType isInvPost =
+findProc qi argumentsKeys paramsAsSingleObject allProcs contentType isInvPost =
   case matchProc of
-    ([], [])     -> Left $ NoRpc (qiSchema qi) (qiName qi) (S.toList argumentsKeys) paramsAsSingleObject contentMediaType isInvPost
+    ([], [])     -> Left $ NoRpc (qiSchema qi) (qiName qi) (S.toList argumentsKeys) paramsAsSingleObject contentType isInvPost
     -- If there are no functions with named arguments, fallback to the single unnamed argument function
     ([], [proc]) -> Right proc
     ([], procs)  -> Left $ AmbiguousRpc (toList procs)
@@ -447,35 +481,31 @@ findProc qi argumentsKeys paramsAsSingleObject allProcs contentMediaType isInvPo
     ([proc], _)  -> Right proc
     (procs, _)   -> Left $ AmbiguousRpc (toList procs)
   where
-    matchProc = overloadedProcPartition $ HM.lookupDefault mempty qi allProcs -- first find the proc by name
+    matchProc = overloadedProcPartition $ M.lookupDefault mempty qi allProcs -- first find the proc by name
     -- The partition obtained has the form (overloadedProcs,fallbackProcs)
     -- where fallbackProcs are functions with a single unnamed parameter
-    overloadedProcPartition = foldr select ([],[])
+    overloadedProcPartition procs = foldr select ([],[]) procs
     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
+    hasSingleUnnamedParam proc = isInvPost && case pdParams proc of
-      (MTApplicationJSON, "json")  -> True
+      [ProcParam "" ppType _ _]
-      (MTApplicationJSON, "jsonb") -> True
+        | contentType == CTApplicationJSON -> ppType `elem` ["json", "jsonb"]
-      (MTTextPlain, "text")        -> True
+        | contentType == CTTextPlain       -> ppType == "text"
-      (MTTextXML, "xml")           -> True
+        | contentType == CTOctetStream     -> ppType == "bytea"
-      (MTOctetStream, "bytea")     -> True
+        | otherwise                        -> False
-      _                            -> False
+      _ -> False
-    hasSingleUnnamedParam _ = False
     matchesParams proc =
-      let
+      let params = pdParams proc in
-        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")
+        then length params == 1 && (ppType <$> headMay params) `elem` [Just "json", 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])
+        then null argumentsKeys && not (isInvPost && contentType `elem` [CTTextPlain, CTOctetStream])
       -- 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

src/PostgREST/Request/DbRequestBuilder.hs

@@ -21,11 +21,13 @@ module PostgREST.Request.DbRequestBuilder
   , callRequest
   ) where
 
-import qualified Data.HashMap.Strict as HM
+import qualified Data.HashMap.Strict as M
 import qualified Data.Set            as S
 
+import Control.Arrow           ((***))
 import Data.Either.Combinators (mapLeft)
 import Data.List               (delete)
+import Data.Text               (isInfixOf)
 import Data.Tree               (Tree (..))
 
 import PostgREST.DbStructure.Identifiers  (FieldName,
@@ -36,58 +38,69 @@ import PostgREST.DbStructure.Proc         (ProcDescription (..),
                                            procReturnsScalar)
 import PostgREST.DbStructure.Relationship (Cardinality (..),
                                            Junction (..),
-                                           Relationship (..),
+                                           Relationship (..))
-                                           RelationshipsMap)
+import PostgREST.DbStructure.Table        (Column (..), Table (..),
-import PostgREST.Error                    (Error (..))
+                                           tableQi)
+import PostgREST.Error                    (ApiRequestError (..),
+                                           Error (..))
 import PostgREST.Query.SqlFragment        (sourceCTEName)
 import PostgREST.RangeQuery               (NonnegRange, allRange,
                                            restrictRange)
 import PostgREST.Request.ApiRequest       (Action (..),
                                            ApiRequest (..),
-                                           InvokeMethod (..),
-                                           Mutation (..),
                                            Payload (..))
 
-import PostgREST.Request.MutateQuery
+import PostgREST.Request.Parsers
 import PostgREST.Request.Preferences
-import PostgREST.Request.ReadQuery   as ReadQuery
 import PostgREST.Request.Types
 
-import qualified PostgREST.Request.QueryParams as QueryParams
+import qualified PostgREST.DbStructure.Relationship as Relationship
 
-import Protolude hiding (from)
+import Protolude hiding (from, isInfixOf)
 
 -- | Builds the ReadRequest tree on a number of stages.
 -- | Adds filters, order, limits on its respective nodes.
 -- | Adds joins conditions obtained from resource embedding.
-readRequest :: Schema -> TableName -> Maybe Integer -> RelationshipsMap -> ApiRequest -> Either Error ReadRequest
+readRequest :: Schema -> TableName -> Maybe Integer -> [Relationship] -> ApiRequest -> Either Error ReadRequest
 readRequest schema rootTableName maxRows allRels apiRequest  =
   mapLeft ApiRequestError $
-  treeRestrictRange maxRows (iAction apiRequest) =<<
+  treeRestrictRange maxRows =<<
-  augmentRequestWithJoin schema allRels =<<
+  augmentRequestWithJoin schema rootRels =<<
-  addLogicTrees apiRequest =<<
+  (addFiltersOrdersRanges apiRequest . initReadRequest rootName =<< pRequestSelect sel)
-  addRanges apiRequest =<<
-  addOrders apiRequest =<<
-  addFilters apiRequest (initReadRequest rootName rootAlias qsSelect)
   where
-    QueryParams.QueryParams{..} = iQueryParams apiRequest
+    sel = fromMaybe "*" $ iSelect apiRequest -- default to all columns requested (SELECT *) for a non existent ?select querystring param
-    (rootName, rootAlias) = case iAction apiRequest of
+    (rootName, rootRels) = rootWithRels schema rootTableName allRels (iAction apiRequest)
-      ActionRead _ -> (QualifiedIdentifier schema rootTableName, Nothing)
+
-      -- the CTE we use for non-read cases has a sourceCTEName(see Statements.hs) as the WITH name so we use the table name as an alias so findRel can find the right relationship
+-- Get the root table name with its relationships according to the Action type.
-      _ -> (QualifiedIdentifier mempty $ decodeUtf8 sourceCTEName, Just rootTableName)
+-- This is done because of the shape of the final SQL Query. The mutation cases
+-- are wrapped in a WITH {sourceCTEName}(see Statements.hs).  So we need a FROM
+-- {sourceCTEName} instead of FROM {tableName}.
+rootWithRels :: Schema -> TableName -> [Relationship] -> Action -> (QualifiedIdentifier, [Relationship])
+rootWithRels schema rootTableName allRels action = case action of
+  ActionRead _ -> (QualifiedIdentifier schema rootTableName, allRels) -- normal read case
+  _            -> (QualifiedIdentifier mempty _sourceCTEName, mapMaybe toSourceRel allRels ++ allRels) -- mutation cases and calling proc
+  where
+    _sourceCTEName = decodeUtf8 sourceCTEName
+    -- To enable embedding in the sourceCTEName cases we need to replace the
+    -- foreign key tableName in the Relationship with {sourceCTEName}. This way
+    -- findRel can find relationships with sourceCTEName.
+    toSourceRel :: Relationship -> Maybe Relationship
+    toSourceRel r@Relationship{relTable=t}
+      | rootTableName == tableName t = Just $ r {relTable=t {tableName=_sourceCTEName}}
+      | otherwise                    = Nothing
 
 -- Build the initial tree with a Depth attribute so when a self join occurs we
 -- can differentiate the parent and child tables by having an alias like
 -- "table_depth", this is related to
 -- http://github.com/PostgREST/postgrest/issues/987.
-initReadRequest :: QualifiedIdentifier -> Maybe Alias -> [Tree SelectItem] -> ReadRequest
+initReadRequest :: QualifiedIdentifier -> [Tree SelectItem] -> ReadRequest
-initReadRequest rootQi rootAlias =
+initReadRequest rootQi =
   foldr (treeEntry rootDepth) initial
   where
     rootDepth = 0
     rootSchema = qiSchema rootQi
     rootName = qiName rootQi
-    initial = Node (Select [] rootQi rootAlias [] [] [] allRange, (rootName, Nothing, Nothing, Nothing, Nothing, rootDepth)) []
+    initial = Node (Select [] rootQi Nothing [] [] [] [] allRange, (rootName, Nothing, Nothing, Nothing, Nothing, rootDepth)) []
     treeEntry :: Depth -> Tree SelectItem -> ReadRequest -> ReadRequest
     treeEntry depth (Node fld@((fn, _),_,alias, hint, joinType) fldForest) (Node (q, i) rForest) =
       let nxtDepth = succ depth in
@@ -95,36 +108,29 @@ initReadRequest rootQi rootAlias =
         [] -> Node (q {select=fld:select q}, i) rForest
         _  -> Node (q, i) $
               foldr (treeEntry nxtDepth)
-              (Node (Select [] (QualifiedIdentifier rootSchema fn) Nothing [] [] [] allRange,
+              (Node (Select [] (QualifiedIdentifier rootSchema fn) Nothing [] [] [] [] allRange,
                 (fn, Nothing, alias, hint, joinType, nxtDepth)) [])
               fldForest:rForest
 
 -- | Enforces the `max-rows` config on the result
-treeRestrictRange :: Maybe Integer -> Action -> ReadRequest -> Either ApiRequestError ReadRequest
+treeRestrictRange :: Maybe Integer -> ReadRequest -> Either ApiRequestError ReadRequest
-treeRestrictRange _ (ActionMutate _) request = Right request
+treeRestrictRange maxRows request = pure $ nodeRestrictRange maxRows <$> request
-treeRestrictRange maxRows _ request = pure $ nodeRestrictRange maxRows <$> request
   where
     nodeRestrictRange :: Maybe Integer -> ReadNode -> ReadNode
     nodeRestrictRange m (q@Select {range_=r}, i) = (q{range_=restrictRange m r }, i)
 
-augmentRequestWithJoin :: Schema -> RelationshipsMap -> ReadRequest -> Either ApiRequestError ReadRequest
+augmentRequestWithJoin :: Schema -> [Relationship] -> ReadRequest -> Either ApiRequestError ReadRequest
 augmentRequestWithJoin schema allRels request =
- addJoinConditions Nothing <$> addRels schema allRels Nothing request
+  addRels schema allRels Nothing request
+  >>= addJoinConditions Nothing
 
-addRels :: Schema -> RelationshipsMap -> Maybe ReadRequest -> ReadRequest -> Either ApiRequestError ReadRequest
+addRels :: Schema -> [Relationship] -> Maybe ReadRequest -> ReadRequest -> Either ApiRequestError ReadRequest
 addRels schema allRels parentNode (Node (query@Select{from=tbl}, (nodeName, _, alias, hint, joinType, depth)) forest) =
   case parentNode of
-    Just (Node (Select{from=parentNodeQi, fromAlias=aliasQi}, _) _) ->
+    Just (Node (Select{from=parentNodeQi}, _) _) ->
-      let newFrom r = if qiName tbl == nodeName then relForeignTable r else tbl
+      let newFrom r = if qiName tbl == nodeName then tableQi (relForeignTable r) else tbl
-          newReadNode = (\r ->
+          newReadNode = (\r -> (query{from=newFrom r}, (nodeName, Just r, alias, hint, joinType, depth))) <$> rel
-            if not $ relIsSelf r -- add alias if self rel TODO consolidate aliasing in another function
+          rel = findRel schema allRels (qiName parentNodeQi) nodeName hint
-              then (query{from=newFrom r}, (nodeName, Just r, alias, hint, joinType, depth))
-              else (query{from=newFrom r, fromAlias=Just (qiName (newFrom r) <> "_" <> show depth)}, (nodeName, Just r, alias, hint, joinType, depth))
-            ) <$> rel
-          origin = if depth == 1 -- Only on depth 1 we check if the root(depth 0) has an alias so the sourceCTEName alias can be found as a relationship
-            then fromMaybe (qiName parentNodeQi) aliasQi
-            else qiName parentNodeQi
-          rel = findRel schema allRels origin nodeName hint
       in
       Node <$> newReadNode <*> (updateForest . hush $ Node <$> newReadNode <*> pure forest)
     _ ->
@@ -134,205 +140,211 @@ addRels schema allRels parentNode (Node (query@Select{from=tbl}, (nodeName, _, a
     updateForest :: Maybe ReadRequest -> Either ApiRequestError [ReadRequest]
     updateForest rq = addRels schema allRels rq `traverse` forest
 
--- applies aliasing to join conditions TODO refactor, this should go into the querybuilder module
-addJoinConditions :: Maybe Alias -> ReadRequest -> ReadRequest
-addJoinConditions _ (Node node@(Select{fromAlias=tblAlias}, (_, Nothing, _, _, _, _)) forest) = Node node (addJoinConditions tblAlias <$> forest)
-addJoinConditions _ (Node node@(Select{fromAlias=tblAlias}, (_, Just ComputedRelationship{}, _, _, _, _)) forest) = Node node (addJoinConditions tblAlias <$> forest)
-addJoinConditions previousAlias (Node (query@Select{fromAlias=tblAlias}, nodeProps@(_, Just (Relationship QualifiedIdentifier{qiSchema=tSchema, qiName=tN} QualifiedIdentifier{qiName=ftN} _ card _ _), _, _, _, _)) forest) =
-  Node (query{joinConditions=joinConds}, nodeProps) (addJoinConditions tblAlias <$> forest)
-  where
-    joinConds =
-      case card of
-        M2M (Junction QualifiedIdentifier{qiName=jtn} _ _ jcols1 jcols2) ->
-           (toJoinCondition Nothing Nothing ftN jtn <$> jcols2) ++ (toJoinCondition previousAlias tblAlias tN jtn <$> jcols1)
-        O2M _ cols ->
-          toJoinCondition previousAlias tblAlias tN ftN <$> cols
-        M2O _ cols ->
-          toJoinCondition previousAlias tblAlias tN ftN <$> cols
-        O2O _ cols ->
-          toJoinCondition previousAlias tblAlias tN ftN <$> cols
-    toJoinCondition :: Maybe Alias -> Maybe Alias -> Text -> Text -> (FieldName, FieldName) -> JoinCondition
-    toJoinCondition prAl newAl tb ftb (c, fc) =
-      let qi1 = QualifiedIdentifier tSchema ftb
-          qi2 = QualifiedIdentifier tSchema tb in
-        JoinCondition (maybe qi1 (QualifiedIdentifier mempty) newAl, fc)
-                      (maybe qi2 (QualifiedIdentifier mempty) prAl, c)
-
 -- Finds a relationship between an origin and a target in the request:
 -- /origin?select=target(*) If more than one relationship is found then the
 -- request is ambiguous and we return an error.  In that case the request can
 -- be disambiguated by adding precision to the target or by using a hint:
--- /origin?select=target!hint(*). The origin can be a table or view.
+-- /origin?select=target!hint(*) The elements will be matched according to
-findRel :: Schema -> RelationshipsMap -> NodeName -> NodeName -> Maybe Hint -> Either ApiRequestError Relationship
+-- these rules:
+-- origin = table / view
+-- target = table / view / constraint / column-from-origin
+-- hint   = table / view / constraint / column-from-origin / column-from-target
+-- (hint can take table / view values to aid in finding the junction in an m2m relationship)
+findRel :: Schema -> [Relationship] -> NodeName -> NodeName -> Maybe Hint -> Either ApiRequestError Relationship
 findRel schema allRels origin target hint =
-  case rels of
+  case rel of
-    []  -> Left $ NoRelBetween origin target schema
+    []  -> Left $ NoRelBetween origin target
     [r] -> Right r
-    rs  -> Left $ AmbiguousRelBetween origin target rs
+    -- Here we handle a self reference relationship to not cause a breaking
+    -- change: In a self reference we get two relationships with the same
+    -- foreign key and relTable/relFtable but with different
+    -- cardinalities(m2o/o2m) We output the O2M rel, the M2O rel can be
+    -- obtained by using the origin column as an embed hint.
+    rs@[rel0, rel1]  -> case (relCardinality rel0, relCardinality rel1, relTable rel0 == relTable rel1 && relForeignTable rel0 == relForeignTable rel1) of
+      (O2M cons1, M2O cons2, True) -> if cons1 == cons2 then Right rel0 else Left $ AmbiguousRelBetween origin target rs
+      (M2O cons1, O2M cons2, True) -> if cons1 == cons2 then Right rel1 else Left $ AmbiguousRelBetween origin target rs
+      _                            -> Left $ AmbiguousRelBetween origin target rs
+    rs -> Left $ AmbiguousRelBetween origin target rs
   where
-    matchFKSingleCol hint_ card = case card of
+    matchFKSingleCol hint_ cols = length cols == 1 && hint_ == (colName <$> head cols)
-      O2M _ [(col, _)] -> hint_ == col
-      M2O _ [(col, _)] -> hint_ == col
-      O2O _ [(col, _)] -> hint_ == col
-      _                -> False
-    matchFKRefSingleCol hint_ card  = case card of
-      O2M _ [(_, fCol)] -> hint_ == fCol
-      M2O _ [(_, fCol)] -> hint_ == fCol
-      O2O _ [(_, fCol)] -> hint_ == fCol
-      _                 -> False
     matchConstraint tar card = case card of
-      O2M cons _ -> tar == cons
+      O2M cons -> tar == Just cons
-      M2O cons _ -> tar == cons
+      M2O cons -> tar == Just cons
-      O2O cons _ -> tar == cons
+      _        -> False
-      _          -> False
     matchJunction hint_ card = case card of
-      M2M Junction{junTable} -> hint_ == qiName junTable
+      M2M Junction{junTable} -> hint_ == Just (tableName junTable)
       _                      -> False
-    isM2O card = case card of
+    rel = filter (
-      M2O _ _ -> True
+      \Relationship{..} ->
-      _       -> False
+        -- Both relationship ends need to be on the exposed schema
-    isO2M card = case card of
+        schema == tableSchema relTable && schema == tableSchema relForeignTable &&
-      O2M _ _ -> True
+        (
-      _       -> False
+          -- /projects?select=clients(*)
-    rels = filter (\case
+          origin == tableName relTable  &&  -- projects
-      ComputedRelationship{relFunction} -> target == qiName relFunction
+          target == tableName relForeignTable ||  -- clients
-      Relationship{..} ->
-        -- In a self-relationship we have a single foreign key but two relationships with different cardinalities: M2O/O2M. For disambiguation, we use the convention of getting:
-        -- TODO: handle one-to-one and many-to-many self-relationships
-        if relIsSelf
-        then case hint of
-          Nothing ->
-            -- The O2M by using the table name in the target
-            target == qiName relForeignTable && isO2M relCardinality -- /family_tree?select=children:family_tree(*)
-            ||
-            -- The M2O by using the column name in the target
-            matchFKSingleCol target relCardinality && isM2O relCardinality -- /family_tree?select=parent(*)
-          Just hnt ->
-            -- /organizations?select=auditees:organizations!auditor(*)
-            target == qiName relForeignTable && isO2M relCardinality
-            && matchFKRefSingleCol hnt relCardinality -- auditor
-        else case hint of
-          -- target = table / view / constraint / column-from-origin (constraint/column-from-origin can only come from tables https://github.com/PostgREST/postgrest/issues/2277)
-          -- hint   = table / view / constraint / column-from-origin / column-from-target (hint can take table / view values to aid in finding the junction in an m2m relationship)
-          Nothing ->
-              -- /projects?select=clients(*)
-              target == qiName relForeignTable -- clients
-              ||
-              -- /projects?select=projects_client_id_fkey(*)
-              matchConstraint target relCardinality -- projects_client_id_fkey
-              && not relFTableIsView
-              ||
-              -- /projects?select=client_id(*)
-              matchFKSingleCol target relCardinality -- client_id
-              && not relFTableIsView
-          Just hnt ->
-            -- /projects?select=clients(*)
-            target == qiName relForeignTable -- clients
-            && (
-              -- /projects?select=clients!projects_client_id_fkey(*)
-              matchConstraint hnt relCardinality || -- projects_client_id_fkey
 
-              -- /projects?select=clients!client_id(*) or /projects?select=clients!id(*)
+          -- /projects?select=projects_client_id_fkey(*)
-              matchFKSingleCol hnt relCardinality      || -- client_id
+          (
-              matchFKRefSingleCol hnt relCardinality   || -- id
+            origin == tableName relTable &&              -- projects
+            matchConstraint (Just target) relCardinality -- projects_client_id_fkey
+          ) ||
+          -- /projects?select=client_id(*)
+          (
+            origin == tableName relTable &&           -- projects
+            matchFKSingleCol (Just target) relColumns -- client_id
+          )
+        ) && (
+          isNothing hint || -- hint is optional
 
-              -- /users?select=tasks!users_tasks(*) many-to-many between users and tasks
+          -- /projects?select=clients!projects_client_id_fkey(*)
-              matchJunction hnt relCardinality -- users_tasks
+          matchConstraint hint relCardinality || -- projects_client_id_fkey
-            )
-      ) $ fromMaybe mempty $ HM.lookup (QualifiedIdentifier schema origin, schema) allRels
 
-addFilters :: ApiRequest -> ReadRequest -> Either ApiRequestError ReadRequest
+          -- /projects?select=clients!client_id(*) or /projects?select=clients!id(*)
-addFilters ApiRequest{..} rReq =
+          matchFKSingleCol hint relColumns  || -- client_id
-  foldr addFilterToNode (Right rReq) flts
+          matchFKSingleCol hint relForeignColumns || -- id
+
+          -- /users?select=tasks!users_tasks(*) many-to-many between users and tasks
+          matchJunction hint relCardinality -- users_tasks
+        )
+      ) allRels
+
+-- previousAlias is only used for the case of self joins
+addJoinConditions :: Maybe Alias -> ReadRequest -> Either ApiRequestError ReadRequest
+addJoinConditions previousAlias (Node node@(query@Select{from=tbl}, nodeProps@(_, rel, _, _, _, depth)) forest) =
+  case rel of
+    Just r@Relationship{relCardinality=M2M Junction{junTable}} ->
+      let rq = augmentQuery r in
+      Node (rq{implicitJoins=tableQi junTable:implicitJoins rq}, nodeProps) <$> updatedForest
+    Just r -> Node (augmentQuery r, nodeProps) <$> updatedForest
+    Nothing -> Node node <$> updatedForest
   where
-    QueryParams.QueryParams{..} = iQueryParams
+    newAlias = case Relationship.isSelfReference <$> rel of
-    flts =
+      Just True
-      case iAction of
+        | depth /= 0 -> Just (qiName tbl <> "_" <> show depth) -- root node doesn't get aliased
-        ActionInvoke InvGet  -> qsFilters
+        | otherwise  -> Nothing
-        ActionInvoke InvHead -> qsFilters
+      _              -> Nothing
-        ActionInvoke _       -> qsFilters
+    augmentQuery r =
-        ActionRead _         -> qsFilters
+      foldr
-        _                    -> qsFiltersNotRoot
+        (\jc rq@Select{joinConditions=jcs} -> rq{joinConditions=jc:jcs})
+        query{fromAlias=newAlias}
+        (getJoinConditions previousAlias newAlias r)
+    updatedForest = addJoinConditions newAlias `traverse` forest
 
-    addFilterToNode :: (EmbedPath, Filter) -> Either ApiRequestError ReadRequest ->  Either ApiRequestError ReadRequest
+-- previousAlias and newAlias are used in the case of self joins
-    addFilterToNode =
+getJoinConditions :: Maybe Alias -> Maybe Alias -> Relationship -> [JoinCondition]
-      updateNode (\flt (Node (q@Select {where_=lf}, i) f) -> Node (q{ReadQuery.where_=addFilterToLogicForest flt lf}, i) f)
+getJoinConditions previousAlias newAlias (Relationship Table{tableSchema=tSchema, tableName=tN} cols Table{tableName=ftN} fCols card) =
-
+  case card of
-addOrders :: ApiRequest -> ReadRequest -> Either ApiRequestError ReadRequest
+    M2M (Junction Table{tableName=jtn} _ jc1 _ jc2) ->
-addOrders ApiRequest{..} rReq =
+      zipWith (toJoinCondition tN jtn) cols jc1 ++ zipWith (toJoinCondition ftN jtn) fCols jc2
-  case iAction of
+    _ ->
-    ActionMutate _ -> Right rReq
+      zipWith (toJoinCondition tN ftN) cols fCols
-    _              -> foldr addOrderToNode (Right rReq) qsOrder
   where
-    QueryParams.QueryParams{..} = iQueryParams
+    toJoinCondition :: Text -> Text -> Column -> Column -> JoinCondition
+    toJoinCondition tb ftb c fc =
+      let qi1 = removeSourceCTESchema tSchema tb
+          qi2 = removeSourceCTESchema tSchema ftb in
+        JoinCondition (maybe qi1 (QualifiedIdentifier mempty) previousAlias, colName c)
+                      (maybe qi2 (QualifiedIdentifier mempty) newAlias, colName fc)
 
-    addOrderToNode :: (EmbedPath, [OrderTerm]) -> Either ApiRequestError ReadRequest -> Either ApiRequestError ReadRequest
+    -- On mutation and calling proc cases we wrap the target table in a WITH
-    addOrderToNode = updateNode (\o (Node (q,i) f) -> Node (q{order=o}, i) f)
+    -- {sourceCTEName} if this happens remove the schema `FROM
+    -- "schema"."{sourceCTEName}"` and use only the `FROM "{sourceCTEName}"`.
+    -- If the schema remains the FROM would be invalid.
+    removeSourceCTESchema :: Schema -> TableName -> QualifiedIdentifier
+    removeSourceCTESchema schema tbl = QualifiedIdentifier (if tbl == decodeUtf8 sourceCTEName then mempty else schema) tbl
 
-addRanges :: ApiRequest -> ReadRequest -> Either ApiRequestError ReadRequest
+addFiltersOrdersRanges :: ApiRequest -> ReadRequest -> Either ApiRequestError ReadRequest
-addRanges ApiRequest{..} rReq =
+addFiltersOrdersRanges apiRequest rReq = do
-  case iAction of
+  rFlts <- foldr addFilter rReq <$> filters
-    ActionMutate _ -> Right rReq
+  rOrds <- foldr addOrder rFlts <$> orders
-    _              -> foldr addRangeToNode (Right rReq) =<< ranges
+  rRngs <- foldr addRange rOrds <$> ranges
+  foldr addLogicTree rRngs      <$> logicForest
   where
+    filters :: Either ApiRequestError [(EmbedPath, Filter)]
+    filters = pRequestFilter `traverse` flts
+    orders :: Either ApiRequestError [(EmbedPath, [OrderTerm])]
+    orders = pRequestOrder `traverse` iOrder apiRequest
     ranges :: Either ApiRequestError [(EmbedPath, NonnegRange)]
-    ranges = first QueryParamError $ QueryParams.pRequestRange `traverse` HM.toList iRange
+    ranges = pRequestRange `traverse` M.toList (iRange apiRequest)
+    logicForest :: Either ApiRequestError [(EmbedPath, LogicTree)]
+    logicForest = pRequestLogicTree `traverse` logFrst
+    action = iAction apiRequest
+    -- there can be no filters on the root table when we are doing insert/update/delete
+    (flts, logFrst) =
+      case action of
+        ActionInvoke _ -> (iFilters apiRequest, iLogic apiRequest)
+        ActionRead _   -> (iFilters apiRequest, iLogic apiRequest)
+        _              -> join (***) (filter (( "." `isInfixOf` ) . fst)) (iFilters apiRequest, iLogic apiRequest)
 
-    addRangeToNode :: (EmbedPath, NonnegRange) -> Either ApiRequestError ReadRequest -> Either ApiRequestError ReadRequest
+addFilterToNode :: Filter -> ReadRequest -> ReadRequest
-    addRangeToNode = updateNode (\r (Node (q,i) f) -> Node (q{range_=r}, i) f)
+addFilterToNode flt (Node (q@Select {where_=lf}, i) f) = Node (q{where_=addFilterToLogicForest flt lf}::ReadQuery, i) f
 
-addLogicTrees :: ApiRequest -> ReadRequest -> Either ApiRequestError ReadRequest
+addFilter :: (EmbedPath, Filter) -> ReadRequest -> ReadRequest
-addLogicTrees ApiRequest{..} rReq =
+addFilter = addProperty addFilterToNode
-  foldr addLogicTreeToNode (Right rReq) qsLogic
+
+addOrderToNode :: [OrderTerm] -> ReadRequest -> ReadRequest
+addOrderToNode o (Node (q,i) f) = Node (q{order=o}, i) f
+
+addOrder :: (EmbedPath, [OrderTerm]) -> ReadRequest -> ReadRequest
+addOrder = addProperty addOrderToNode
+
+addRangeToNode :: NonnegRange -> ReadRequest -> ReadRequest
+addRangeToNode r (Node (q,i) f) = Node (q{range_=r}, i) f
+
+addRange :: (EmbedPath, NonnegRange) -> ReadRequest -> ReadRequest
+addRange = addProperty addRangeToNode
+
+addLogicTreeToNode :: LogicTree -> ReadRequest -> ReadRequest
+addLogicTreeToNode t (Node (q@Select{where_=lf},i) f) = Node (q{where_=t:lf}::ReadQuery, i) f
+
+addLogicTree :: (EmbedPath, LogicTree) -> ReadRequest -> ReadRequest
+addLogicTree = addProperty addLogicTreeToNode
+
+addProperty :: (a -> ReadRequest -> ReadRequest) -> (EmbedPath, a) -> ReadRequest -> ReadRequest
+addProperty f ([], a) rr = f a rr
+addProperty f (targetNodeName:remainingPath, a) (Node rn forest) =
+  case pathNode of
+    Nothing -> Node rn forest -- the property is silenty dropped in the Request does not contain the required path
+    Just tn -> Node rn (addProperty f (remainingPath, a) tn:delete tn forest)
   where
-    QueryParams.QueryParams{..} = iQueryParams
+    pathNode = find (\(Node (_,(nodeName,_,alias,_,_, _)) _) -> nodeName == targetNodeName || alias == Just targetNodeName) forest
 
-    addLogicTreeToNode :: (EmbedPath, LogicTree) -> Either ApiRequestError ReadRequest -> Either ApiRequestError ReadRequest
+mutateRequest :: Schema -> TableName -> ApiRequest -> [FieldName] -> ReadRequest -> Either Error MutateRequest
-    addLogicTreeToNode = updateNode (\t (Node (q@Select{where_=lf},i) f) -> Node (q{ReadQuery.where_=t:lf}, i) f)
+mutateRequest schema tName apiRequest pkCols readReq = mapLeft ApiRequestError $
-
+  case action of
--- Find a Node of the Tree and apply a function to it
+    ActionCreate -> do
-updateNode :: (a -> ReadRequest -> ReadRequest) -> (EmbedPath, a) -> Either ApiRequestError ReadRequest -> Either ApiRequestError ReadRequest
+        confCols <- case iOnConflict apiRequest of
-updateNode f ([], a) rr = f a <$> rr
+            Nothing    -> pure pkCols
-updateNode _ _ (Left e) = Left e
+            Just param -> pRequestOnConflict param
-updateNode f (targetNodeName:remainingPath, a) (Right (Node rootNode forest)) =
+        pure $ Insert qi (iColumns apiRequest) body ((,) <$> iPreferResolution apiRequest <*> Just confCols) [] returnings
-  case findNode of
+    ActionUpdate -> Update qi (iColumns apiRequest) body  <$> combinedLogic <*> pure returnings
-    Nothing -> Left $ NotEmbedded targetNodeName
+    ActionSingleUpsert ->
-    Just target ->
+      (\flts ->
-      (\node -> Node rootNode $ node : delete target forest) <$>
+        if null (iLogic apiRequest) &&
-      updateNode f (remainingPath, a) (Right target)
+           S.fromList (fst <$> iFilters apiRequest) == S.fromList pkCols &&
-  where
-    findNode :: Maybe ReadRequest
-    findNode = find (\(Node (_,(nodeName,_,alias,_,_, _)) _) -> nodeName == targetNodeName || alias == Just targetNodeName) forest
-
-mutateRequest :: Mutation -> Schema -> TableName -> ApiRequest -> [FieldName] -> ReadRequest -> Either Error MutateRequest
-mutateRequest mutation schema tName ApiRequest{..} pkCols readReq = mapLeft ApiRequestError $
-  case mutation of
-    MutationCreate ->
-      Right $ Insert qi iColumns body ((,) <$> iPreferResolution <*> Just confCols) [] returnings
-    MutationUpdate -> Right $ Update qi iColumns body combinedLogic iTopLevelRange rootOrder returnings
-    MutationSingleUpsert ->
-        if null qsLogic &&
-           qsFilterFields == S.fromList pkCols &&
            not (null (S.fromList pkCols)) &&
            all (\case
-              Filter _ (OpExpr False (Op OpEqual _)) -> True
+              Filter _ (OpExpr False (Op "eq" _)) -> True
-              _                                      -> False) qsFiltersRoot
+              _                                   -> False) flts
-          then Right $ Insert qi iColumns body (Just (MergeDuplicates, pkCols)) combinedLogic returnings
+          then Insert qi (iColumns apiRequest) body (Just (MergeDuplicates, pkCols)) <$> combinedLogic <*> pure returnings
         else
-          Left InvalidFilters
+          Left InvalidFilters) =<< filters
-    MutationDelete -> Right $ Delete qi combinedLogic iTopLevelRange rootOrder returnings
+    ActionDelete -> Delete qi <$> combinedLogic <*> pure returnings
+    _            -> Left UnsupportedVerb
   where
-    confCols = fromMaybe pkCols qsOnConflict
-    QueryParams.QueryParams{..} = iQueryParams
     qi = QualifiedIdentifier schema tName
+    action = iAction apiRequest
     returnings =
-      if iPreferRepresentation == None
+      if iPreferRepresentation apiRequest == None
         then []
         else returningCols readReq pkCols
-    logic = map snd qsLogic
+    filters = map snd <$> pRequestFilter `traverse` mutateFilters
-    rootOrder = maybe [] snd $ find (\(x, _) -> null x) qsOrder
+    logic = map snd <$> pRequestLogicTree `traverse` logicFilters
-    combinedLogic = foldr addFilterToLogicForest logic qsFiltersRoot
+    combinedLogic = foldr addFilterToLogicForest <$> logic <*> filters
-    body = payRaw <$> iPayload -- the body is assumed to be json at this stage(ApiRequest validates)
+    -- update/delete filters can be only on the root table
+    (mutateFilters, logicFilters) = join (***) onlyRoot (iFilters apiRequest, iLogic apiRequest)
+    onlyRoot = filter (not . ( "." `isInfixOf` ) . fst)
+    body = payRaw <$> iPayload apiRequest -- the body is assumed to be json at this stage(ApiRequest validates)
 
 callRequest :: ProcDescription -> ApiRequest -> ReadRequest -> CallRequest
 callRequest proc apiReq readReq = FunctionCall {
@@ -350,7 +362,7 @@ callRequest proc apiReq readReq = FunctionCall {
             | ppName prm == mempty -> OnePosParam prm
             | otherwise            -> KeyParams $ specifiedParams [prm]
       prms  -> KeyParams $ specifiedParams prms
-    specifiedParams = filter (\x -> ppName x `S.member` iColumns apiReq)
+    specifiedParams params = filter (\x -> ppName x `S.member` iColumns apiReq) params
 
 returningCols :: ReadRequest -> [FieldName] -> [FieldName]
 returningCols rr@(Node _ forest) pkCols
@@ -367,16 +379,9 @@ returningCols rr@(Node _ forest) pkCols
     -- projects.  So this adds the foreign key columns to ensure the embedding
     -- succeeds, result would be `RETURNING name, client_id`.
     fkCols = concat $ mapMaybe (\case
-        Node (_, (_, Just Relationship{relCardinality=O2M _ cols}, _, _, _, _)) _ -> Just $ fst <$> cols
+        Node (_, (_, Just Relationship{relColumns=cols}, _, _, _, _)) _ -> Just cols
-        Node (_, (_, Just Relationship{relCardinality=M2O _ cols}, _, _, _, _)) _ -> Just $ fst <$> cols
-        Node (_, (_, Just Relationship{relCardinality=O2O _ cols}, _, _, _, _)) _ -> Just $ fst <$> cols
-        Node (_, (_, Just Relationship{relCardinality=M2M Junction{junColumns1, junColumns2}}, _, _, _, _)) _ -> Just $ (fst <$> junColumns1) ++ (fst <$> junColumns2)
         _                                                        -> Nothing
       ) forest
-    hasComputedRel = isJust $ find (\case
-      Node (_, (_, Just ComputedRelationship{}, _, _, _, _)) _ -> True
-      _ -> False
-      ) forest
     -- However if the "client_id" is present, e.g. mutateRequest to
     -- /projects?select=client_id,name,clients(name) we would get `RETURNING
     -- client_id, name, client_id` and then we would produce the "column
@@ -384,10 +389,7 @@ returningCols rr@(Node _ forest) pkCols
     -- deduplicate with Set: We are adding the primary key columns as well to
     -- make sure, that a proper location header can always be built for
     -- INSERT/POST
-    returnings =
+    returnings = S.toList . S.fromList $ fldNames ++ (colName <$> fkCols) ++ pkCols
-      if not hasComputedRel
-        then S.toList . S.fromList $ fldNames ++ fkCols ++ pkCols
-        else ["*"] -- on computed relationships we cannot know the required columns for an embedding to succeed, so we just return all
 
 -- Traditional filters(e.g. id=eq.1) are added as root nodes of the LogicTree
 -- they are later concatenated with AND in the QueryBuilder

src/PostgREST/Request/MutateQuery.hs

@@ -1,44 +0,0 @@
-module PostgREST.Request.MutateQuery
-  ( MutateQuery(..)
-  , MutateRequest
-  )
-where
-
-import qualified Data.ByteString.Lazy as LBS
-import qualified Data.Set             as S
-
-import PostgREST.DbStructure.Identifiers (FieldName,
-                                          QualifiedIdentifier)
-import PostgREST.RangeQuery              (NonnegRange)
-import PostgREST.Request.Preferences     (PreferResolution)
-import PostgREST.Request.Types           (LogicTree, OrderTerm)
-
-import Protolude
-
-type MutateRequest = MutateQuery
-
-data MutateQuery
-  = Insert
-      { in_        :: QualifiedIdentifier
-      , insCols    :: S.Set FieldName
-      , insBody    :: Maybe LBS.ByteString
-      , onConflict :: Maybe (PreferResolution, [FieldName])
-      , where_     :: [LogicTree]
-      , returning  :: [FieldName]
-      }
-  | Update
-      { in_       :: QualifiedIdentifier
-      , updCols   :: S.Set FieldName
-      , updBody   :: Maybe LBS.ByteString
-      , where_    :: [LogicTree]
-      , mutRange  :: NonnegRange
-      , mutOrder  :: [OrderTerm]
-      , returning :: [FieldName]
-      }
-  | Delete
-      { in_       :: QualifiedIdentifier
-      , where_    :: [LogicTree]
-      , mutRange  :: NonnegRange
-      , mutOrder  :: [OrderTerm]
-      , returning :: [FieldName]
-      }

src/PostgREST/Request/Parsers.hs

@@ -0,0 +1,300 @@
+{-|
+Module      : PostgREST.Request.Parsers
+Description : PostgREST parser combinators
+
+This module is in charge of parsing all the querystring values in an url, e.g. the select, id, order in `/projects?select=id,name&id=eq.1&order=id,name.desc`.
+-}
+module PostgREST.Request.Parsers
+  ( pColumns
+  , pLogicPath
+  , pLogicSingleVal
+  , pLogicTree
+  , pOrder
+  , pOrderTerm
+  , pRequestColumns
+  , pRequestFilter
+  , pRequestLogicTree
+  , pRequestOnConflict
+  , pRequestOrder
+  , pRequestRange
+  , pRequestSelect
+  , pSingleVal
+  , pTreePath
+  ) where
+
+import qualified Data.HashMap.Strict as M
+import qualified Data.Set            as S
+
+import Data.Either.Combinators       (mapLeft)
+import Data.Foldable                 (foldl1)
+import Data.List                     (init, last)
+import Data.Text                     (intercalate, replace, strip)
+import Data.Tree                     (Tree (..))
+import Text.Parsec.Error             (errorMessages,
+                                      showErrorMessages)
+import Text.ParserCombinators.Parsec (GenParser, ParseError, Parser,
+                                      anyChar, between, char, digit,
+                                      eof, errorPos, letter,
+                                      lookAhead, many1, noneOf,
+                                      notFollowedBy, oneOf, option,
+                                      optionMaybe, parse, sepBy1,
+                                      string, try, (<?>))
+
+import PostgREST.DbStructure.Identifiers (FieldName)
+import PostgREST.Error                   (ApiRequestError (ParseRequestError))
+import PostgREST.Query.SqlFragment       (ftsOperators, operators)
+import PostgREST.RangeQuery              (NonnegRange)
+
+import PostgREST.Request.Types
+
+import Protolude hiding (intercalate, option, replace, try)
+
+pRequestSelect :: Text -> Either ApiRequestError [Tree SelectItem]
+pRequestSelect selStr =
+  mapError $ parse pFieldForest ("failed to parse select parameter (" <> toS selStr <> ")") (toS selStr)
+
+pRequestOnConflict :: Text -> Either ApiRequestError  [FieldName]
+pRequestOnConflict oncStr =
+  mapError $ parse pColumns ("failed to parse on_conflict parameter (" <> toS oncStr <> ")") (toS oncStr)
+
+pRequestFilter :: (Text, Text) -> Either ApiRequestError (EmbedPath, Filter)
+pRequestFilter (k, v) = mapError $ (,) <$> path <*> (Filter <$> fld <*> oper)
+  where
+    treePath = parse pTreePath ("failed to parser tree path (" ++ toS k ++ ")") $ toS k
+    oper = parse (pOpExpr pSingleVal) ("failed to parse filter (" ++ toS v ++ ")") $ toS v
+    path = fst <$> treePath
+    fld = snd <$> treePath
+
+pRequestOrder :: (Text, Text) -> Either ApiRequestError (EmbedPath, [OrderTerm])
+pRequestOrder (k, v) = mapError $ (,) <$> path <*> ord'
+  where
+    treePath = parse pTreePath ("failed to parser tree path (" ++ toS k ++ ")") $ toS k
+    path = fst <$> treePath
+    ord' = parse pOrder ("failed to parse order (" ++ toS v ++ ")") $ toS v
+
+pRequestRange :: (Text, NonnegRange) -> Either ApiRequestError (EmbedPath, NonnegRange)
+pRequestRange (k, v) = mapError $ (,) <$> path <*> pure v
+  where
+    treePath = parse pTreePath ("failed to parser tree path (" ++ toS k ++ ")") $ toS k
+    path = fst <$> treePath
+
+pRequestLogicTree :: (Text, Text) -> Either ApiRequestError (EmbedPath, LogicTree)
+pRequestLogicTree (k, v) = mapError $ (,) <$> embedPath <*> logicTree
+  where
+    path = parse pLogicPath ("failed to parser logic path (" ++ toS k ++ ")") $ toS k
+    embedPath = fst <$> path
+    logicTree = do
+      op <- snd <$> path
+      -- Concat op and v to make pLogicTree argument regular,
+      -- in the form of "?and=and(.. , ..)" instead of "?and=(.. , ..)"
+      parse pLogicTree ("failed to parse logic tree (" ++ toS v ++ ")") $ toS (op <> v)
+
+pRequestColumns :: Maybe Text -> Either ApiRequestError (Maybe (S.Set FieldName))
+pRequestColumns colStr =
+  case colStr of
+    Just str ->
+      mapError $ Just . S.fromList <$> parse pColumns ("failed to parse columns parameter (" <> toS str <> ")") (toS str)
+    _ -> Right Nothing
+
+ws :: Parser Text
+ws = toS <$> many (oneOf " \t")
+
+lexeme :: Parser a -> Parser a
+lexeme p = ws *> p <* ws
+
+pTreePath :: Parser (EmbedPath, Field)
+pTreePath = do
+  p <- pFieldName `sepBy1` pDelimiter
+  jp <- option [] pJsonPath
+  return (init p, (last p, jp))
+
+pFieldForest :: Parser [Tree SelectItem]
+pFieldForest = pFieldTree `sepBy1` lexeme (char ',')
+  where
+    pFieldTree :: Parser (Tree SelectItem)
+    pFieldTree =  try (Node <$> pRelationSelect <*> between (char '(') (char ')') pFieldForest) <|>
+                  Node <$> pFieldSelect <*> pure []
+
+pStar :: Parser Text
+pStar = string "*" $> "*"
+
+pFieldName :: Parser Text
+pFieldName =
+  pQuotedValue <|>
+  intercalate "-" . map toS <$> (many1 (letter <|> digit <|> oneOf "_ ") `sepBy1` dash) <?>
+  "field name (* or [a..z0..9_])"
+  where
+    isDash :: GenParser Char st ()
+    isDash = try ( char '-' >> notFollowedBy (char '>') )
+    dash :: Parser Char
+    dash = isDash $> '-'
+
+pJsonPath :: Parser JsonPath
+pJsonPath = many pJsonOperation
+  where
+    pJsonOperation :: Parser JsonOperation
+    pJsonOperation = pJsonArrow <*> pJsonOperand
+
+    pJsonArrow   =
+      try (string "->>" $> J2Arrow) <|>
+      try (string "->" $> JArrow)
+
+    pJsonOperand =
+      let pJKey = JKey . toS <$> pFieldName
+          pJIdx = JIdx . toS <$> ((:) <$> option '+' (char '-') <*> many1 digit) <* pEnd
+          pEnd = try (void $ lookAhead (string "->")) <|>
+                 try (void $ lookAhead (string "::")) <|>
+                 try eof in
+      try pJIdx <|> try pJKey
+
+pField :: Parser Field
+pField = lexeme $ (,) <$> pFieldName <*> option [] pJsonPath
+
+aliasSeparator :: Parser ()
+aliasSeparator = char ':' >> notFollowedBy (char ':')
+
+pRelationSelect :: Parser SelectItem
+pRelationSelect = lexeme $ try ( do
+    alias <- optionMaybe ( try(pFieldName <* aliasSeparator) )
+    fld <- pField
+    prm1 <- optionMaybe pEmbedParam
+    prm2 <- optionMaybe pEmbedParam
+    return (fld, Nothing, alias, embedParamHint prm1 <|> embedParamHint prm2, embedParamJoin prm1 <|> embedParamJoin prm2)
+  )
+  where
+    pEmbedParam :: Parser EmbedParam
+    pEmbedParam =
+      char '!' *> (
+        try (string "left"  $> EPJoinType JTLeft)  <|>
+        try (string "inner" $> EPJoinType JTInner) <|>
+        try (EPHint <$> pFieldName))
+    embedParamHint prm = case prm of
+      Just (EPHint hint) -> Just hint
+      _                  -> Nothing
+    embedParamJoin prm = case prm of
+      Just (EPJoinType jt) -> Just jt
+      _                    -> Nothing
+
+pFieldSelect :: Parser SelectItem
+pFieldSelect = lexeme $
+  try (
+    do
+      alias <- optionMaybe ( try(pFieldName <* aliasSeparator) )
+      fld <- pField
+      cast' <- optionMaybe (string "::" *> many letter)
+      return (fld, toS <$> cast', alias, Nothing, Nothing)
+  )
+  <|> do
+    s <- pStar
+    return ((s, []), Nothing, Nothing, Nothing, Nothing)
+
+pOpExpr :: Parser SingleVal -> Parser OpExpr
+pOpExpr pSVal = try ( string "not" *> pDelimiter *> (OpExpr True <$> pOperation)) <|> OpExpr False <$> pOperation
+  where
+    pOperation :: Parser Operation
+    pOperation =
+          Op . toS <$> foldl1 (<|>) (try . ((<* pDelimiter) . string) . toS <$> M.keys ops) <*> pSVal
+      <|> In <$> (try (string "in" *> pDelimiter) *> pListVal)
+      <|> Is <$> (try (string "is" *> pDelimiter) *> pTriVal)
+      <|> pFts
+      <?> "operator (eq, gt, ...)"
+
+    pTriVal = try (ciString "null"    $> TriNull)
+          <|> try (ciString "unknown" $> TriUnknown)
+          <|> try (ciString "true"    $> TriTrue)
+          <|> try (ciString "false"   $> TriFalse)
+          <?> "null or trilean value (unknown, true, false)"
+
+    pFts = do
+      op   <- foldl1 (<|>) (try . string . toS <$> ftsOps)
+      lang <- optionMaybe $ try (between (char '(') (char ')') (many (letter <|> digit <|> oneOf "_")))
+      pDelimiter >> Fts (toS op) (toS <$> lang) <$> pSVal
+
+    ops = M.filterWithKey (const . flip notElem ("in":"is":ftsOps)) operators
+    ftsOps = M.keys ftsOperators
+
+    -- case insensitive char and string
+    ciChar :: Char -> GenParser Char state Char
+    ciChar c = char c <|> char (toUpper c)
+    ciString :: [Char] -> GenParser Char state [Char]
+    ciString = traverse ciChar
+
+pSingleVal :: Parser SingleVal
+pSingleVal = toS <$> many anyChar
+
+pListVal :: Parser ListVal
+pListVal = lexeme (char '(') *> pListElement `sepBy1` char ',' <* lexeme (char ')')
+
+pListElement :: Parser Text
+pListElement = try (pQuotedValue <* notFollowedBy (noneOf ",)")) <|> (toS <$> many (noneOf ",)"))
+
+pQuotedValue :: Parser Text
+pQuotedValue = toS <$> (char '"' *> many pCharsOrSlashed <* char '"')
+  where
+    pCharsOrSlashed = noneOf "\\\"" <|> (char '\\' *> anyChar)
+
+pDelimiter :: Parser Char
+pDelimiter = char '.' <?> "delimiter (.)"
+
+pOrder :: Parser [OrderTerm]
+pOrder = lexeme pOrderTerm `sepBy1` char ','
+
+pOrderTerm :: Parser OrderTerm
+pOrderTerm = do
+  fld <- pField
+  dir <- optionMaybe $
+         try (pDelimiter *> string "asc" $> OrderAsc) <|>
+         try (pDelimiter *> string "desc" $> OrderDesc)
+  nls <- optionMaybe pNulls <* pEnd <|>
+         pEnd $> Nothing
+  return $ OrderTerm fld dir nls
+  where
+    pNulls = try (pDelimiter *> string "nullsfirst" $> OrderNullsFirst) <|>
+             try (pDelimiter *> string "nullslast"  $> OrderNullsLast)
+    pEnd = try (void $ lookAhead (char ',')) <|>
+           try eof
+
+pLogicTree :: Parser LogicTree
+pLogicTree = Stmnt <$> try pLogicFilter
+             <|> Expr <$> pNot <*> pLogicOp <*> (lexeme (char '(') *> pLogicTree `sepBy1` lexeme (char ',') <* lexeme (char ')'))
+  where
+    pLogicFilter :: Parser Filter
+    pLogicFilter = Filter <$> pField <* pDelimiter <*> pOpExpr pLogicSingleVal
+    pNot :: Parser Bool
+    pNot = try (string "not" *> pDelimiter $> True)
+           <|> pure False
+           <?> "negation operator (not)"
+    pLogicOp :: Parser LogicOperator
+    pLogicOp = try (string "and" $> And)
+               <|> string "or" $> Or
+               <?> "logic operator (and, or)"
+
+pLogicSingleVal :: Parser SingleVal
+pLogicSingleVal = try (pQuotedValue <* notFollowedBy (noneOf ",)")) <|> try pPgArray <|> (toS <$> many (noneOf ",)"))
+  where
+    pPgArray :: Parser Text
+    pPgArray =  do
+      a <- string "{"
+      b <- many (noneOf "{}")
+      c <- string "}"
+      pure (toS $ a ++ b ++ c)
+
+pLogicPath :: Parser (EmbedPath, Text)
+pLogicPath = do
+  path <- pFieldName `sepBy1` pDelimiter
+  let op = last path
+      notOp = "not." <> op
+  return (filter (/= "not") (init path), if "not" `elem` path then notOp else op)
+
+pColumns :: Parser [FieldName]
+pColumns = pFieldName `sepBy1` lexeme (char ',')
+
+mapError :: Either ParseError a -> Either ApiRequestError a
+mapError = mapLeft translateError
+  where
+    translateError e =
+      ParseRequestError message details
+      where
+        message = show $ errorPos e
+        details = strip $ replace "\n" " " $ toS
+           $ showErrorMessages "or" "unknown parse error" "expecting" "unexpected" "end of input" (errorMessages e)

src/PostgREST/Request/Preferences.hs

@@ -155,7 +155,7 @@ instance ToAppliedHeader PreferResolution
 --
 -- From https://tools.ietf.org/html/rfc7240#section-4.2
 data PreferRepresentation
-  = Full        -- ^ Return the body.
+  = Full        -- ^ Return the body plus the Location header(in case of POST).
   | HeadersOnly -- ^ Return the Location header(in case of POST). This needs a SELECT privilege on the pk.
   | None        -- ^ Return nothing from the mutated data.
   deriving Eq

src/PostgREST/Request/QueryParams.hs

@@ -1,523 +0,0 @@
--- |
--- Module      : PostgREST.Request.QueryParams
--- Description : Parser for PostgREST Query paramters
---
--- This module is in charge of parsing all the querystring values in an url, e.g.
--- the select, id, order in `/projects?select=id,name&id=eq.1&order=id,name.desc`.
-{-# LANGUAGE LambdaCase    #-}
-{-# LANGUAGE TupleSections #-}
-module PostgREST.Request.QueryParams
-  ( parse
-  , QueryParams(..)
-  , pRequestRange
-  ) where
-
-import qualified Data.ByteString.Char8         as BS
-import qualified Data.HashMap.Strict           as HM
-import qualified Data.List                     as L
-import qualified Data.Set                      as S
-import qualified Data.Text                     as T
-import qualified Data.Text.Encoding            as T
-import qualified Network.HTTP.Base             as HTTP
-import qualified Network.HTTP.Types.URI        as HTTP
-import qualified Text.ParserCombinators.Parsec as P
-
-import Control.Arrow                 ((***))
-import Data.Either.Combinators       (mapLeft)
-import Data.List                     (init, last)
-import Data.Ranged.Boundaries        (Boundary (..))
-import Data.Ranged.Ranges            (Range (..))
-import Data.Tree                     (Tree (..))
-import Text.Parsec.Error             (errorMessages,
-                                      showErrorMessages)
-import Text.Parsec.Prim              (parserFail)
-import Text.ParserCombinators.Parsec (GenParser, ParseError, Parser,
-                                      anyChar, between, char, digit,
-                                      eof, errorPos, letter,
-                                      lookAhead, many1, noneOf,
-                                      notFollowedBy, oneOf,
-                                      optionMaybe, sepBy1, string,
-                                      try, (<?>))
-
-import PostgREST.DbStructure.Identifiers (FieldName)
-import PostgREST.RangeQuery              (NonnegRange, allRange,
-                                          rangeGeq, rangeLimit,
-                                          rangeOffset, restrictRange)
-
-import PostgREST.Request.ReadQuery (SelectItem)
-import PostgREST.Request.Types     (EmbedParam (..), EmbedPath, Field,
-                                    Filter (..), FtsOperator (..),
-                                    JoinType (..), JsonOperand (..),
-                                    JsonOperation (..), JsonPath,
-                                    ListVal, LogicOperator (..),
-                                    LogicTree (..), OpExpr (..),
-                                    Operation (..),
-                                    OrderDirection (..),
-                                    OrderNulls (..), OrderTerm (..),
-                                    QPError (..), SimpleOperator (..),
-                                    SingleVal, TrileanVal (..))
-
-import Protolude hiding (try)
-
-
--- $setup
--- Setup for doctests
--- >>> import Text.Pretty.Simple (pPrint)
--- >>> deriving instance Show QPError
--- >>> deriving instance Show TrileanVal
--- >>> deriving instance Show FtsOperator
--- >>> deriving instance Show SimpleOperator
--- >>> deriving instance Show Operation
--- >>> deriving instance Show OpExpr
--- >>> deriving instance Show JsonOperand
--- >>> deriving instance Show JsonOperation
--- >>> deriving instance Show Filter
--- >>> deriving instance Show JoinType
-
-data QueryParams =
-  QueryParams
-    { qsCanonical      :: ByteString
-    -- ^ Canonical representation of the query params, sorted alphabetically
-    , qsParams         :: [(Text, Text)]
-    -- ^ Parameters for RPC calls
-    , qsRanges         :: HM.HashMap Text (Range Integer)
-    -- ^ Ranges derived from &limit and &offset params
-    , qsOrder          :: [(EmbedPath, [OrderTerm])]
-    -- ^ &order parameters for each level
-    , qsLogic          :: [(EmbedPath, LogicTree)]
-    -- ^ &and and &or parameters used for complex boolean logic
-    , qsColumns        :: Maybe (S.Set FieldName)
-    -- ^ &columns parameter and payload
-    , qsSelect         :: [Tree SelectItem]
-    -- ^ &select parameter used to shape the response
-    , qsFilters        :: [(EmbedPath, Filter)]
-    -- ^ Filters on the result from e.g. &id=e.10
-    , qsFiltersRoot    :: [Filter]
-    -- ^ Subset of the filters that apply on the root table. These are used on UPDATE/DELETE.
-    , qsFiltersNotRoot :: [(EmbedPath, Filter)]
-    -- ^ Subset of the filters that do not apply on the root table
-    , qsFilterFields   :: S.Set FieldName
-    -- ^ Set of fields that filters apply to
-    , qsOnConflict     :: Maybe [FieldName]
-    -- ^ &on_conflict parameter used to upsert on specific unique keys
-    }
-
--- |
--- Parse query parameters from a query string like "id=eq.1&select=name".
---
--- The canonical representation of the query string has paramters sorted alphabetically:
---
--- >>> qsCanonical <$> parse "a=1&c=3&b=2&d"
--- Right "a=1&b=2&c=3&d="
---
--- 'select' is a reserved parameter that selects the fields to be returned:
---
--- >>> qsSelect <$> parse "select=name,location"
--- Right [Node {rootLabel = (("name",[]),Nothing,Nothing,Nothing,Nothing), subForest = []},Node {rootLabel = (("location",[]),Nothing,Nothing,Nothing,Nothing), subForest = []}]
---
--- Filters are parameters whose value contains an operator, separated by a '.' from its value:
---
--- >>> qsFilters <$> parse "a.b=eq.0"
--- Right [(["a"],Filter {field = ("b",[]), opExpr = OpExpr False (Op OpEqual "0")})]
---
--- If the operator specified in a filter does not exist, parsing the query string fails:
---
--- >>> qsFilters <$> parse "a.b=noop.0"
--- Left (QPError "\"failed to parse filter (noop.0)\" (line 1, column 6)" "unknown single value operator noop")
-parse :: ByteString -> Either QPError QueryParams
-parse qs =
-  QueryParams
-    canonical
-    params
-    ranges
-    <$> pRequestOrder `traverse` order
-    <*> pRequestLogicTree `traverse` logic
-    <*> pRequestColumns columns
-    <*> pRequestSelect select
-    <*> pRequestFilter `traverse` filters
-    <*> (fmap snd <$> (pRequestFilter `traverse` filtersRoot))
-    <*> pRequestFilter `traverse` filtersNotRoot
-    <*> pure (S.fromList (fst <$> filters))
-    <*> sequenceA (pRequestOnConflict <$> onConflict)
-  where
-    logic = filter (endingIn ["and", "or"] . fst) nonemptyParams
-    select = fromMaybe "*" $ lookupParam "select"
-    onConflict = lookupParam "on_conflict"
-    columns = lookupParam "columns"
-    order = filter (endingIn ["order"] . fst) nonemptyParams
-    limits = filter (endingIn ["limit"] . fst) nonemptyParams
-    -- Replace .offset ending with .limit to be able to match those params later in a map
-    offsets = first (replaceLast "limit") <$> filter (endingIn ["offset"] . fst) nonemptyParams
-    lookupParam :: Text -> Maybe Text
-    lookupParam needle = toS <$> join (L.lookup needle qParams)
-    nonemptyParams = mapMaybe (\(k, v) -> (k,) <$> v) qParams
-
-    qString = HTTP.parseQueryReplacePlus True qs
-
-    qParams = [(T.decodeUtf8 k, T.decodeUtf8 <$> v)|(k,v) <- qString]
-
-    canonical =
-      BS.pack $ HTTP.urlEncodeVars
-        . L.sortOn fst
-        . map (join (***) BS.unpack . second (fromMaybe mempty))
-        $ qString
-
-    endingIn:: [Text] -> Text -> Bool
-    endingIn xx key = lastWord `elem` xx
-      where lastWord = L.last $ T.split (== '.') key
-
-    (filters, params) = L.partition isParam filtersAndParams
-    isParam (k, v) = isEmbedPath k || hasOperator v || hasFtsOperator v
-
-    filtersAndParams = filter (isFilterOrParam . fst)  nonemptyParams
-    isFilterOrParam k = not (endingIn reservedEmbeddable k) && notElem k reserved
-    reserved = ["select", "columns", "on_conflict"]
-    reservedEmbeddable = ["order", "limit", "offset", "and", "or"]
-
-    (filtersNotRoot, filtersRoot) = L.partition isNotRoot filters
-    isNotRoot = flip T.isInfixOf "." . fst
-
-    -- TODO: These checks are redundant to the parsers, should use parsers to differentiate params
-    hasOperator val =
-      case T.splitOn "." val of
-        "not" : _ : _ -> True
-        "is" : _      -> True
-        "in" : _      -> True
-        x : _         -> isJust (operator x) || isJust (ftsOperator x)
-        _             -> False
-
-    hasFtsOperator val =
-      case T.splitOn "(" val of
-        x : _ : _ -> isJust $ ftsOperator x
-        _         -> False
-
-    isEmbedPath = T.isInfixOf "."
-    replaceLast x s = T.intercalate "." $ L.init (T.split (=='.') s) <> [x]
-
-    ranges :: HM.HashMap Text (Range Integer)
-    ranges = HM.unionWith f limitParams offsetParams
-      where
-        f rl ro = Range (BoundaryBelow o) (BoundaryAbove $ o + l - 1)
-          where
-            l = fromMaybe 0 $ rangeLimit rl
-            o = rangeOffset ro
-
-        limitParams =
-          HM.fromList [(k, restrictRange (readMaybe v) allRange) | (k,v) <- limits]
-
-        offsetParams =
-          HM.fromList [(k, maybe allRange rangeGeq (readMaybe v)) | (k,v) <- offsets]
-
-operator :: Text -> Maybe SimpleOperator
-operator = \case
-  "eq"     -> Just OpEqual
-  "gte"    -> Just OpGreaterThanEqual
-  "gt"     -> Just OpGreaterThan
-  "lte"    -> Just OpLessThanEqual
-  "lt"     -> Just OpLessThan
-  "neq"    -> Just OpNotEqual
-  "like"   -> Just OpLike
-  "ilike"  -> Just OpILike
-  "cs"     -> Just OpContains
-  "cd"     -> Just OpContained
-  "ov"     -> Just OpOverlap
-  "sl"     -> Just OpStrictlyLeft
-  "sr"     -> Just OpStrictlyRight
-  "nxr"    -> Just OpNotExtendsRight
-  "nxl"    -> Just OpNotExtendsLeft
-  "adj"    -> Just OpAdjacent
-  "match"  -> Just OpMatch
-  "imatch" -> Just OpIMatch
-  _        -> Nothing
-
-ftsOperator :: Text -> Maybe FtsOperator
-ftsOperator = \case
-  "fts"   -> Just FilterFts
-  "plfts" -> Just FilterFtsPlain
-  "phfts" -> Just FilterFtsPhrase
-  "wfts"  -> Just FilterFtsWebsearch
-  _       -> Nothing
-
-
--- PARSERS
-
-
-pRequestSelect :: Text -> Either QPError [Tree SelectItem]
-pRequestSelect selStr =
-  mapError $ P.parse pFieldForest ("failed to parse select parameter (" <> toS selStr <> ")") (toS selStr)
-
-pRequestOnConflict :: Text -> Either QPError [FieldName]
-pRequestOnConflict oncStr =
-  mapError $ P.parse pColumns ("failed to parse on_conflict parameter (" <> toS oncStr <> ")") (toS oncStr)
-
-pRequestFilter :: (Text, Text) -> Either QPError (EmbedPath, Filter)
-pRequestFilter (k, v) = mapError $ (,) <$> path <*> (Filter <$> fld <*> oper)
-  where
-    treePath = P.parse pTreePath ("failed to parse tree path (" ++ toS k ++ ")") $ toS k
-    oper = P.parse (pOpExpr pSingleVal) ("failed to parse filter (" ++ toS v ++ ")") $ toS v
-    path = fst <$> treePath
-    fld = snd <$> treePath
-
-pRequestOrder :: (Text, Text) -> Either QPError (EmbedPath, [OrderTerm])
-pRequestOrder (k, v) = mapError $ (,) <$> path <*> ord'
-  where
-    treePath = P.parse pTreePath ("failed to parse tree path (" ++ toS k ++ ")") $ toS k
-    path = fst <$> treePath
-    ord' = P.parse pOrder ("failed to parse order (" ++ toS v ++ ")") $ toS v
-
-pRequestRange :: (Text, NonnegRange) -> Either QPError (EmbedPath, NonnegRange)
-pRequestRange (k, v) = mapError $ (,) <$> path <*> pure v
-  where
-    treePath = P.parse pTreePath ("failed to parse tree path (" ++ toS k ++ ")") $ toS k
-    path = fst <$> treePath
-
-pRequestLogicTree :: (Text, Text) -> Either QPError (EmbedPath, LogicTree)
-pRequestLogicTree (k, v) = mapError $ (,) <$> embedPath <*> logicTree
-  where
-    path = P.parse pLogicPath ("failed to parse logic path (" ++ toS k ++ ")") $ toS k
-    embedPath = fst <$> path
-    logicTree = do
-      op <- snd <$> path
-      -- Concat op and v to make pLogicTree argument regular,
-      -- in the form of "?and=and(.. , ..)" instead of "?and=(.. , ..)"
-      P.parse pLogicTree ("failed to parse logic tree (" ++ toS v ++ ")") $ toS (op <> v)
-
-pRequestColumns :: Maybe Text -> Either QPError (Maybe (S.Set FieldName))
-pRequestColumns colStr =
-  case colStr of
-    Just str ->
-      mapError $ Just . S.fromList <$> P.parse pColumns ("failed to parse columns parameter (" <> toS str <> ")") (toS str)
-    _ -> Right Nothing
-
-ws :: Parser Text
-ws = toS <$> many (oneOf " \t")
-
-lexeme :: Parser a -> Parser a
-lexeme p = ws *> p <* ws
-
-pTreePath :: Parser (EmbedPath, Field)
-pTreePath = do
-  p <- pFieldName `sepBy1` pDelimiter
-  jp <- P.option [] pJsonPath
-  return (init p, (last p, jp))
-
-pFieldForest :: Parser [Tree SelectItem]
-pFieldForest = pFieldTree `sepBy1` lexeme (char ',')
-  where
-    pFieldTree :: Parser (Tree SelectItem)
-    pFieldTree =  try (Node <$> pRelationSelect <*> between (char '(') (char ')') pFieldForest) <|>
-                  Node <$> pFieldSelect <*> pure []
-
-pStar :: Parser Text
-pStar = string "*" $> "*"
-
-pFieldName :: Parser Text
-pFieldName =
-  pQuotedValue <|>
-  T.intercalate "-" . map toS <$> (many1 pIdentifierChar `sepBy1` dash) <?>
-  "field name (* or [a..z0..9_])"
-  where
-    isDash :: GenParser Char st ()
-    isDash = try ( char '-' >> notFollowedBy (char '>') )
-    dash :: Parser Char
-    dash = isDash $> '-'
-
--- |
--- Parse json operators in select, order and filters
---
--- >>> P.parse pJsonPath "" "->text"
--- Right [JArrow {jOp = JKey {jVal = "text"}}]
---
--- >>> P.parse pJsonPath "" "->1"
--- Right [JArrow {jOp = JIdx {jVal = "+1"}}]
---
--- >>> P.parse pJsonPath "" "->>text"
--- Right [J2Arrow {jOp = JKey {jVal = "text"}}]
---
--- >>> P.parse pJsonPath "" "->>1"
--- Right [J2Arrow {jOp = JIdx {jVal = "+1"}}]
---
--- >>> P.parse pJsonPath "" "->0,other"
--- Right [JArrow {jOp = JIdx {jVal = "+0"}}]
---
--- >>> P.parse pJsonPath "" "->0.desc"
--- Right [JArrow {jOp = JIdx {jVal = "+0"}}]
-pJsonPath :: Parser JsonPath
-pJsonPath = many pJsonOperation
-  where
-    pJsonOperation :: Parser JsonOperation
-    pJsonOperation = pJsonArrow <*> pJsonOperand
-
-    pJsonArrow   =
-      try (string "->>" $> J2Arrow) <|>
-      try (string "->" $> JArrow)
-
-    pJsonOperand =
-      let pJKey = JKey . toS <$> pFieldName
-          pJIdx = JIdx . toS <$> ((:) <$> P.option '+' (char '-') <*> many1 digit) <* pEnd
-          pEnd = try (void $ lookAhead (string "->")) <|>
-                 try (void $ lookAhead (string "::")) <|>
-                 try (void $ lookAhead (string ".")) <|>
-                 try (void $ lookAhead (string ",")) <|>
-                 try eof in
-      try pJIdx <|> try pJKey
-
-pField :: Parser Field
-pField = lexeme $ (,) <$> pFieldName <*> P.option [] pJsonPath
-
-aliasSeparator :: Parser ()
-aliasSeparator = char ':' >> notFollowedBy (char ':')
-
-pRelationSelect :: Parser SelectItem
-pRelationSelect = lexeme $ try ( do
-    alias <- optionMaybe ( try(pFieldName <* aliasSeparator) )
-    fld <- pField
-    prm1 <- optionMaybe pEmbedParam
-    prm2 <- optionMaybe pEmbedParam
-    return (fld, Nothing, alias, embedParamHint prm1 <|> embedParamHint prm2, embedParamJoin prm1 <|> embedParamJoin prm2)
-  )
-  where
-    pEmbedParam :: Parser EmbedParam
-    pEmbedParam =
-      char '!' *> (
-        try (string "left"  $> EPJoinType JTLeft)  <|>
-        try (string "inner" $> EPJoinType JTInner) <|>
-        try (EPHint <$> pFieldName))
-    embedParamHint prm = case prm of
-      Just (EPHint hint) -> Just hint
-      _                  -> Nothing
-    embedParamJoin prm = case prm of
-      Just (EPJoinType jt) -> Just jt
-      _                    -> Nothing
-
-pFieldSelect :: Parser SelectItem
-pFieldSelect = lexeme $
-  try (
-    do
-      alias <- optionMaybe ( try(pFieldName <* aliasSeparator) )
-      fld <- pField
-      cast' <- optionMaybe (string "::" *> many pIdentifierChar)
-      return (fld, toS <$> cast', alias, Nothing, Nothing)
-  )
-  <|> do
-    s <- pStar
-    return ((s, []), Nothing, Nothing, Nothing, Nothing)
-
-pOpExpr :: Parser SingleVal -> Parser OpExpr
-pOpExpr pSVal = try ( string "not" *> pDelimiter *> (OpExpr True <$> pOperation)) <|> OpExpr False <$> pOperation
-  where
-    pOperation :: Parser Operation
-    pOperation = pIn <|> pIs <|> try pFts <|> pOp <?> "operator (eq, gt, ...)"
-
-    pIn = In <$> (try (string "in" *> pDelimiter) *> pListVal)
-    pIs = Is <$> (try (string "is" *> pDelimiter) *> pTriVal)
-
-    pOp = do
-      opStr <- try (P.manyTill anyChar (try pDelimiter))
-      op <- parseMaybe ("unknown single value operator " <> opStr) . operator $ toS opStr
-      Op op <$> pSVal
-
-    pTriVal = try (ciString "null"    $> TriNull)
-          <|> try (ciString "unknown" $> TriUnknown)
-          <|> try (ciString "true"    $> TriTrue)
-          <|> try (ciString "false"   $> TriFalse)
-          <?> "null or trilean value (unknown, true, false)"
-
-    pFts = do
-      opStr <- try (P.many (noneOf ".("))
-      op <- parseMaybe ("unknown fts operator " <> opStr) . ftsOperator $ toS opStr
-      lang <- optionMaybe $ try (between (char '(') (char ')') $ many pIdentifierChar)
-      pDelimiter >> Fts op (toS <$> lang) <$> pSVal
-
-    parseMaybe :: [Char] -> Maybe a -> Parser a
-    parseMaybe err Nothing = parserFail err
-    parseMaybe _ (Just x)  = pure x
-
-    -- case insensitive char and string
-    ciChar :: Char -> GenParser Char state Char
-    ciChar c = char c <|> char (toUpper c)
-    ciString :: [Char] -> GenParser Char state [Char]
-    ciString = traverse ciChar
-
-pSingleVal :: Parser SingleVal
-pSingleVal = toS <$> many anyChar
-
-pListVal :: Parser ListVal
-pListVal = lexeme (char '(') *> pListElement `sepBy1` char ',' <* lexeme (char ')')
-
-pListElement :: Parser Text
-pListElement = try (pQuotedValue <* notFollowedBy (noneOf ",)")) <|> (toS <$> many (noneOf ",)"))
-
-pQuotedValue :: Parser Text
-pQuotedValue = toS <$> (char '"' *> many pCharsOrSlashed <* char '"')
-  where
-    pCharsOrSlashed = noneOf "\\\"" <|> (char '\\' *> anyChar)
-
-pDelimiter :: Parser Char
-pDelimiter = char '.' <?> "delimiter (.)"
-
-pOrder :: Parser [OrderTerm]
-pOrder = lexeme pOrderTerm `sepBy1` char ','
-
-pOrderTerm :: Parser OrderTerm
-pOrderTerm = do
-  fld <- pField
-  dir <- optionMaybe $
-         try (pDelimiter *> string "asc" $> OrderAsc) <|>
-         try (pDelimiter *> string "desc" $> OrderDesc)
-  nls <- optionMaybe pNulls <* pEnd <|>
-         pEnd $> Nothing
-  return $ OrderTerm fld dir nls
-  where
-    pNulls = try (pDelimiter *> string "nullsfirst" $> OrderNullsFirst) <|>
-             try (pDelimiter *> string "nullslast"  $> OrderNullsLast)
-    pEnd = try (void $ lookAhead (char ',')) <|>
-           try eof
-
-pLogicTree :: Parser LogicTree
-pLogicTree = Stmnt <$> try pLogicFilter
-             <|> Expr <$> pNot <*> pLogicOp <*> (lexeme (char '(') *> pLogicTree `sepBy1` lexeme (char ',') <* lexeme (char ')'))
-  where
-    pLogicFilter :: Parser Filter
-    pLogicFilter = Filter <$> pField <* pDelimiter <*> pOpExpr pLogicSingleVal
-    pNot :: Parser Bool
-    pNot = try (string "not" *> pDelimiter $> True)
-           <|> pure False
-           <?> "negation operator (not)"
-    pLogicOp :: Parser LogicOperator
-    pLogicOp = try (string "and" $> And)
-               <|> string "or" $> Or
-               <?> "logic operator (and, or)"
-
-pLogicSingleVal :: Parser SingleVal
-pLogicSingleVal = try (pQuotedValue <* notFollowedBy (noneOf ",)")) <|> try pPgArray <|> (toS <$> many (noneOf ",)"))
-  where
-    pPgArray :: Parser Text
-    pPgArray =  do
-      a <- string "{"
-      b <- many (noneOf "{}")
-      c <- string "}"
-      pure (toS $ a ++ b ++ c)
-
-pLogicPath :: Parser (EmbedPath, Text)
-pLogicPath = do
-  path <- pFieldName `sepBy1` pDelimiter
-  let op = last path
-      notOp = "not." <> op
-  return (filter (/= "not") (init path), if "not" `elem` path then notOp else op)
-
-pColumns :: Parser [FieldName]
-pColumns = pFieldName `sepBy1` lexeme (char ',')
-
-pIdentifierChar :: Parser Char
-pIdentifierChar = letter <|> digit <|> oneOf "_ $"
-
-mapError :: Either ParseError a -> Either QPError a
-mapError = mapLeft translateError
-  where
-    translateError e =
-      QPError message details
-      where
-        message = show $ errorPos e
-        details = T.strip $ T.replace "\n" " " $ toS
-           $ showErrorMessages "or" "unknown parse error" "expecting" "unexpected" "end of input" (errorMessages e)

src/PostgREST/Request/ReadQuery.hs

@@ -1,46 +0,0 @@
-module PostgREST.Request.ReadQuery
-  ( ReadNode
-  , ReadQuery(..)
-  , ReadRequest
-  , SelectItem
-  , fstFieldNames
-  ) where
-
-import Data.Tree (Tree (..))
-
-import PostgREST.DbStructure.Identifiers  (FieldName,
-                                           QualifiedIdentifier)
-import PostgREST.DbStructure.Relationship (Relationship)
-import PostgREST.RangeQuery               (NonnegRange)
-import PostgREST.Request.Types            (Alias, Cast, Depth, Field,
-                                           Hint, JoinCondition,
-                                           JoinType, LogicTree,
-                                           NodeName, OrderTerm)
-
-
-import Protolude
-
-type ReadRequest = Tree ReadNode
-
-type ReadNode =
-  (ReadQuery, (NodeName, Maybe Relationship, Maybe Alias, Maybe Hint, Maybe JoinType, Depth))
-
--- | The select value in `/tbl?select=alias:field::cast`
-type SelectItem = (Field, Maybe Cast, Maybe Alias, Maybe Hint, Maybe JoinType)
-
-data ReadQuery = Select
-  { select         :: [SelectItem]
-  , from           :: QualifiedIdentifier
-  , fromAlias      :: Maybe Alias
-  -- ^ A table alias is used in case of self joins
-  , where_         :: [LogicTree]
-  , joinConditions :: [JoinCondition]
-  , order          :: [OrderTerm]
-  , range_         :: NonnegRange
-  }
-  deriving (Eq)
-
--- First level FieldNames(e.g get a,b from /table?select=a,b,other(c,d))
-fstFieldNames :: ReadRequest -> [FieldName]
-fstFieldNames (Node (sel, _) _) =
-  fst . (\(f, _, _, _, _) -> f) <$> select sel

src/PostgREST/Request/Types.hs

@@ -1,10 +1,8 @@
 {-# LANGUAGE DuplicateRecordFields #-}
 module PostgREST.Request.Types
   ( Alias
-  , Cast
   , Depth
   , EmbedParam(..)
-  , ApiRequestError(..)
   , EmbedPath
   , Field
   , Filter(..)
@@ -20,58 +18,62 @@ module PostgREST.Request.Types
   , ListVal
   , LogicOperator(..)
   , LogicTree(..)
+  , MutateQuery(..)
+  , MutateRequest
   , NodeName
   , OpExpr(..)
   , Operation (..)
   , OrderDirection(..)
   , OrderNulls(..)
   , OrderTerm(..)
-  , QPError(..)
+  , ReadNode
+  , ReadQuery(..)
+  , ReadRequest
+  , SelectItem
   , SingleVal
   , TrileanVal(..)
-  , SimpleOperator(..)
+  , fstFieldNames
-  , FtsOperator(..)
   ) where
 
 import qualified Data.ByteString.Lazy as LBS
+import qualified Data.Set             as S
+
+import Data.Tree (Tree (..))
 
 import PostgREST.DbStructure.Identifiers  (FieldName,
                                            QualifiedIdentifier)
-import PostgREST.DbStructure.Proc         (ProcDescription (..),
+import PostgREST.DbStructure.Proc         (ProcParam (..))
-                                           ProcParam (..))
 import PostgREST.DbStructure.Relationship (Relationship)
-import PostgREST.MediaType                (MediaType (..))
+import PostgREST.RangeQuery               (NonnegRange)
+import PostgREST.Request.Preferences      (PreferResolution)
 
 import Protolude
 
 
-
+type ReadRequest = Tree ReadNode
-data ApiRequestError
+type MutateRequest = MutateQuery
-  = AmbiguousRelBetween Text Text [Relationship]
-  | AmbiguousRpc [ProcDescription]
-  | MediaTypeError [ByteString]
-  | InvalidBody ByteString
-  | InvalidFilters
-  | InvalidRange
-  | InvalidRpcMethod ByteString
-  | LimitNoOrderError
-  | NotFound
-  | NoRelBetween Text Text Text
-  | NoRpc Text Text [Text] Bool MediaType Bool
-  | NotEmbedded Text
-  | ParseRequestError Text Text
-  | PutRangeNotAllowedError
-  | QueryParamError QPError
-  | UnacceptableSchema [Text]
-  | UnsupportedMethod ByteString
-
-data QPError = QPError Text Text
-
 type CallRequest = CallQuery
 
+type ReadNode =
+  (ReadQuery, (NodeName, Maybe Relationship, Maybe Alias, Maybe Hint, Maybe JoinType, Depth))
+
 type NodeName = Text
 type Depth = Integer
 
+data ReadQuery = Select
+  { select         :: [SelectItem]
+  , from           :: QualifiedIdentifier
+  -- ^ A table alias is used in case of self joins
+  , fromAlias      :: Maybe Alias
+  -- ^ Only used for Many to Many joins. Parent and Child joins use explicit joins.
+  , implicitJoins  :: [QualifiedIdentifier]
+  , where_         :: [LogicTree]
+  , joinConditions :: [JoinCondition]
+  , order          :: [OrderTerm]
+  , range_         :: NonnegRange
+  }
+  deriving (Eq)
+
 data JoinCondition =
   JoinCondition
     (QualifiedIdentifier, FieldName)
@@ -95,6 +97,28 @@ data OrderNulls
   | OrderNullsLast
   deriving (Eq)
 
+data MutateQuery
+  = Insert
+      { in_        :: QualifiedIdentifier
+      , insCols    :: S.Set FieldName
+      , insBody    :: Maybe LBS.ByteString
+      , onConflict :: Maybe (PreferResolution, [FieldName])
+      , where_     :: [LogicTree]
+      , returning  :: [FieldName]
+      }
+  | Update
+      { in_       :: QualifiedIdentifier
+      , updCols   :: S.Set FieldName
+      , updBody   :: Maybe LBS.ByteString
+      , where_    :: [LogicTree]
+      , returning :: [FieldName]
+      }
+  | Delete
+      { in_       :: QualifiedIdentifier
+      , where_    :: [LogicTree]
+      , returning :: [FieldName]
+      }
+
 data CallQuery = FunctionCall
   { funCQi           :: QualifiedIdentifier
   , funCParams       :: CallParams
@@ -108,6 +132,9 @@ data CallParams
   = KeyParams [ProcParam] -- ^ Call with key params: func(a := val1, b:= val2)
   | OnePosParam ProcParam -- ^ Call with positional params(only one supported): func(val)
 
+-- | The select value in `/tbl?select=alias:field::cast`
+type SelectItem = (Field, Maybe Cast, Maybe Alias, Maybe Hint, Maybe JoinType)
+
 type Field = (FieldName, JsonPath)
 type Cast = Text
 type Alias = Text
@@ -147,6 +174,12 @@ data JsonOperand
   | JIdx { jVal :: Text }
   deriving (Eq)
 
+-- First level FieldNames(e.g get a,b from /table?select=a,b,other(c,d))
+fstFieldNames :: ReadRequest -> [FieldName]
+fstFieldNames (Node (sel, _) _) =
+  fst . (\(f, _, _, _, _) -> f) <$> select sel
+
+
 -- | Boolean logic expression tree e.g. "and(name.eq.N,or(id.eq.1,id.eq.2))" is:
 --
 --            And
@@ -175,12 +208,13 @@ data OpExpr =
   deriving (Eq)
 
 data Operation
-  = Op SimpleOperator SingleVal
+  = Op Operator SingleVal
   | In ListVal
   | Is TrileanVal
-  | Fts FtsOperator (Maybe Language) SingleVal
+  | Fts Operator (Maybe Language) SingleVal
   deriving (Eq)
 
+type Operator = Text
 type Language = Text
 
 -- | Represents a single value in a filter, e.g. id=eq.singleval
@@ -196,32 +230,3 @@ data TrileanVal
   | TriNull
   | TriUnknown
   deriving Eq
-
-data SimpleOperator
-  = OpEqual
-  | OpGreaterThanEqual
-  | OpGreaterThan
-  | OpLessThanEqual
-  | OpLessThan
-  | OpNotEqual
-  | OpLike
-  | OpILike
-  | OpContains
-  | OpContained
-  | OpOverlap
-  | OpStrictlyLeft
-  | OpStrictlyRight
-  | OpNotExtendsRight
-  | OpNotExtendsLeft
-  | OpAdjacent
-  | OpMatch
-  | OpIMatch
-  deriving Eq
-
--- | Operators for full text search operators
-data FtsOperator
-  = FilterFts
-  | FilterFtsPlain
-  | FilterFtsPhrase
-  | FilterFtsWebsearch
-  deriving Eq

src/PostgREST/Unix.hs

@@ -43,9 +43,10 @@ runAppWithSocket settings app socketFileMode socketFilePath =
 -- | Set signal handlers, only for systems with signals
 installSignalHandlers :: AppState.AppState -> IO ()
 installSignalHandlers appState = do
-  let interrupt = throwTo (AppState.getMainThreadId appState) UserInterrupt
+  -- Releases the connection pool whenever the program is terminated,
-  install Signals.sigINT interrupt
+  -- see https://github.com/PostgREST/postgrest/issues/268
-  install Signals.sigTERM interrupt
+  install Signals.sigINT $ AppState.releasePool appState
+  install Signals.sigTERM $ AppState.releasePool appState
 
   -- The SIGUSR1 signal updates the internal 'DbStructure' by running
   -- 'connectionWorker' exactly as before.

src/PostgREST/Workers.hs

@@ -12,6 +12,7 @@ import qualified Data.ByteString            as BS
 import qualified Data.ByteString.Lazy       as LBS
 import qualified Data.Text.Encoding         as T
 import qualified Hasql.Notifications        as SQL
+import qualified Hasql.Pool                 as SQL
 import qualified Hasql.Transaction.Sessions as SQL
 
 import Control.Retry    (RetryStatus, capDelay, exponentialBackoff,
@@ -48,7 +49,7 @@ data SCacheStatus
 -- up-to-date schema cache(DbStructure).  This method is meant to be called
 -- multiple times by the same thread, but does nothing if the previous
 -- invocation has not terminated. In all cases this method does not halt the
--- calling thread, the work is performed in a separate thread.
+-- calling thread, the work is preformed in a separate thread.
 --
 -- Background thread that does the following :
 --  1. Tries to connect to pg server and will keep trying until success.
@@ -57,14 +58,13 @@ data SCacheStatus
 --  3. Obtains the dbStructure. If this fails, it goes back to 1.
 connectionWorker :: AppState -> IO ()
 connectionWorker appState = do
-  runExclusively (AppState.getWorkerSem appState) work
+  isWorkerOn <- AppState.getIsWorkerOn appState
   -- Prevents multiple workers to be running at the same time. Could happen on
   -- too many SIGUSR1s.
+  unless isWorkerOn $ do
+    AppState.putIsWorkerOn appState True
+    void $ forkIO work
   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..."
@@ -91,11 +91,11 @@ connectionWorker appState = do
               -- 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
+          AppState.putIsWorkerOn appState False
 
 -- | Check if a connection from the pool allows access to the PostgreSQL
 -- database.  If not, the pool connections are released and a new connection is
@@ -109,15 +109,16 @@ connectionWorker appState = do
 connectionStatus :: AppState -> IO ConnectionStatus
 connectionStatus appState =
   retrying retrySettings shouldRetry $
-    const $ AppState.releasePool appState >> getConnectionStatus
+    const $ SQL.release pool >> getConnectionStatus
   where
+    pool = AppState.getPool appState
     retrySettings = capDelay delayMicroseconds $ exponentialBackoff backoffMicroseconds
     delayMicroseconds = 32000000 -- 32 seconds
     backoffMicroseconds = 1000000 -- 1 second
 
     getConnectionStatus :: IO ConnectionStatus
     getConnectionStatus = do
-      pgVersion <- AppState.usePool appState queryPgVersion
+      pgVersion <- SQL.use pool queryPgVersion
       case pgVersion of
         Left e -> do
           let err = PgError False e
@@ -153,7 +154,7 @@ 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 $
+    SQL.use (AppState.getPool appState) . transaction SQL.ReadCommitted SQL.Read $
       queryDbStructure (toList configDbSchemas) configDbExtraSearchPath configDbPreparedStatements
   case result of
     Left e -> do
@@ -167,13 +168,12 @@ loadSchemaCache appState = do
           AppState.logWithZTime appState hint
           return SCFatalFail
         Nothing -> do
-          AppState.putDbStructure appState Nothing
           AppState.logWithZTime appState "An error ocurred when loading the schema cache"
           putErr
           return SCOnRetry
 
     Right dbStructure -> do
-      AppState.putDbStructure appState (Just dbStructure)
+      AppState.putDbStructure appState dbStructure
       when (isJust configDbRootSpec) .
         AppState.putJsonDbS appState . LBS.toStrict $ JSON.encode dbStructure
       AppState.logWithZTime appState "Schema cache loaded"
@@ -199,7 +199,6 @@ listener appState = do
     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
       _ ->
@@ -208,7 +207,6 @@ listener appState = do
     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
@@ -232,7 +230,7 @@ reReadConfig startingUp appState = do
   AppConfig{..} <- AppState.getConfig appState
   dbSettings <-
     if configDbConfig then do
-      qDbSettings <- AppState.usePool appState $ queryDbSettings configDbPreparedStatements
+      qDbSettings <- queryDbSettings (AppState.getPool appState) configDbPreparedStatements
       case qDbSettings of
         Left e -> do
           let
@@ -246,7 +244,7 @@ reReadConfig startingUp appState = do
               AppState.logWithZTime appState hint
               killThread (AppState.getMainThreadId appState)
             Nothing -> do
-              putErr
+              AppState.logWithZTime appState $ show e
           pure []
         Right x -> pure x
     else
@@ -256,10 +254,10 @@ reReadConfig startingUp appState = do
       if startingUp then
         panic err -- die on invalid config if the program is starting up
       else
-        AppState.logWithZTime appState $ "Failed reloading config: " <> err
+        AppState.logWithZTime appState $ "Failed re-loading config: " <> err
     Right newConf -> do
       AppState.putConfig appState newConf
       if startingUp then
         pass
       else
-        AppState.logWithZTime appState "Config reloaded"
+        AppState.logWithZTime appState "Config re-loaded"

stack.yaml

@@ -1,4 +1,4 @@
-resolver: lts-19.14 # 2022-07-01, GHC 9.0.2
+resolver: lts-18.14 # 2021-10-24, GHC 8.10.7
 
 nix:
   packages:
@@ -10,12 +10,10 @@ nix:
   pure: false
 
 extra-deps:
-  - HTTP-4000.3.16@sha256:6042643c15a0b43e522a6693f1e322f05000d519543a84149cb80aeffee34f71,5947
+  - hasql-dynamic-statements-0.3.1@sha256:c3a2c89c4a8b3711368dbd33f0ccfe46a493faa7efc2c85d3e354c56a01dfc48,2673
-  - configurator-pg-0.2.6@sha256:cd9b06a458428e493a4d6def725af7ab1ab0fef678fbd871f9586fc7f9aa70be,2849
+  - hasql-implicits-0.1.0.2@sha256:5d54e09cb779a209681b139fb3cc726bae75134557932156340cc0a56dd834a8,1361
-  - hasql-dynamic-statements-0.3.1.1@sha256:2cfe6e75990e690f595a87cbe553f2e90fcd738610f6c66749c81cc4396b2cc4,2675
+  - protolude-0.3.1@sha256:1cc9e5a5c26c33a43c52b554443dd9779fef13974eaa0beec7ca6d2551b400da,2647
-  - hasql-implicits-0.1.0.4@sha256:0848d3cbc9d94e1e539948fa0be4d0326b26335034161bf8076785293444ca6f,1361
+  - ptr-0.16.8.1@sha256:525219ec5f5da5c699725f7efcef91b00a7d44120fc019878b85c09440bf51d6,2686
-  - hasql-pool-0.5.2.2@sha256:b56d4dea112d97a2ef4b2749508c0ca646828cb2d77b827e8dc433d249bb2062,2438
+  - wai-extra-3.1.8@sha256:bf3dbe8f4c707b502b2a88262ed71c807220651597b76b56983f864af6197890,7280
-  - lens-aeson-1.1.3@sha256:52c8eaecd2d1c2a969c0762277c4a8ee72c339a686727d5785932e72ef9c3050,1764
+  - wai-logger-2.3.7@sha256:19a0dc5122e22d274776d80786fb9501956f5e75b8f82464bbdad5604d154d82,1671
-  - optparse-applicative-0.16.1.0@sha256:418c22ed6a19124d457d96bc66bd22c93ac22fad0c7100fe4972bbb4ac989731,4982
+  - warp-3.3.19@sha256:c6a47029537d42844386170d732cdfe6d85b2f4279bbaefdd9b50caff6faeebb,10910
-  - protolude-0.3.2@sha256:2a38b3dad40d238ab644e234b692c8911423f9d3ed0e36b62287c4a698d92cd1,2240
-  - ptr-0.16.8.2@sha256:708ebb95117f2872d2c5a554eb6804cf1126e86abe793b2673f913f14e5eb1ac,3959

stack.yaml.lock

@@ -5,71 +5,57 @@
 
 packages:
 - completed:
-    hackage: HTTP-4000.3.16@sha256:6042643c15a0b43e522a6693f1e322f05000d519543a84149cb80aeffee34f71,5947
     pantry-tree:
-      size: 1428
+      sha256: b1b9a6a26ec765e5fe29f9a670a5c9ec7067ea00dee8491f0819284ff0201b6f
-      sha256: b73a7f6d21cf20bbf819e19039409c9010efb5000d2b72cdd8fd67a9027c14e8
+      size: 641
+    hackage: hasql-dynamic-statements-0.3.1@sha256:c3a2c89c4a8b3711368dbd33f0ccfe46a493faa7efc2c85d3e354c56a01dfc48,2673
   original:
-    hackage: HTTP-4000.3.16@sha256:6042643c15a0b43e522a6693f1e322f05000d519543a84149cb80aeffee34f71,5947
+    hackage: hasql-dynamic-statements-0.3.1@sha256:c3a2c89c4a8b3711368dbd33f0ccfe46a493faa7efc2c85d3e354c56a01dfc48,2673
 - completed:
-    hackage: configurator-pg-0.2.6@sha256:cd9b06a458428e493a4d6def725af7ab1ab0fef678fbd871f9586fc7f9aa70be,2849
     pantry-tree:
-      size: 2463
+      sha256: 2f00d1467d0e226b966c2cd7bac433c8948e2f7bbdf8a44936029f66fc20b5f3
-      sha256: 97efe7a22afc93033bda5adcffdabc0f1c30dc32b2c3ba02114ce7cd74c942fd
+      size: 310
+    hackage: hasql-implicits-0.1.0.2@sha256:5d54e09cb779a209681b139fb3cc726bae75134557932156340cc0a56dd834a8,1361
   original:
-    hackage: configurator-pg-0.2.6@sha256:cd9b06a458428e493a4d6def725af7ab1ab0fef678fbd871f9586fc7f9aa70be,2849
+    hackage: hasql-implicits-0.1.0.2@sha256:5d54e09cb779a209681b139fb3cc726bae75134557932156340cc0a56dd834a8,1361
 - completed:
-    hackage: hasql-dynamic-statements-0.3.1.1@sha256:2cfe6e75990e690f595a87cbe553f2e90fcd738610f6c66749c81cc4396b2cc4,2675
     pantry-tree:
-      size: 595
+      sha256: 6452a6ca8d395f7d810139779bb0fd16fc1dbb00f1862630bc08ef5a100430f9
-      sha256: b84ae10a5c776f88f546df73bc957a35e61056400b7e805dad0b254612907e97
+      size: 1645
+    hackage: protolude-0.3.1@sha256:1cc9e5a5c26c33a43c52b554443dd9779fef13974eaa0beec7ca6d2551b400da,2647
   original:
-    hackage: hasql-dynamic-statements-0.3.1.1@sha256:2cfe6e75990e690f595a87cbe553f2e90fcd738610f6c66749c81cc4396b2cc4,2675
+    hackage: protolude-0.3.1@sha256:1cc9e5a5c26c33a43c52b554443dd9779fef13974eaa0beec7ca6d2551b400da,2647
 - completed:
-    hackage: hasql-implicits-0.1.0.4@sha256:0848d3cbc9d94e1e539948fa0be4d0326b26335034161bf8076785293444ca6f,1361
     pantry-tree:
-      size: 264
+      sha256: d2b8440a738719ef8430ec38fe33b129e3940e4ccf2c016a727a1110a43656bb
-      sha256: d49af8f8749ab7039fa668af4b78f997f7fa2928b4aded6798f573a3d08e76a0
+      size: 1089
+    hackage: ptr-0.16.8.1@sha256:525219ec5f5da5c699725f7efcef91b00a7d44120fc019878b85c09440bf51d6,2686
   original:
-    hackage: hasql-implicits-0.1.0.4@sha256:0848d3cbc9d94e1e539948fa0be4d0326b26335034161bf8076785293444ca6f,1361
+    hackage: ptr-0.16.8.1@sha256:525219ec5f5da5c699725f7efcef91b00a7d44120fc019878b85c09440bf51d6,2686
 - completed:
-    hackage: hasql-pool-0.5.2.2@sha256:b56d4dea112d97a2ef4b2749508c0ca646828cb2d77b827e8dc433d249bb2062,2438
     pantry-tree:
-      size: 412
+      sha256: a544ea95288d188e893322a8e6d68f2b1f844f772dbea1f26e5c0c1a74694f56
-      sha256: 2741a33f947d28b4076c798c20c1f646beecd21f5eaf522c8256cbeb34d4d6d0
+      size: 4053
+    hackage: wai-extra-3.1.8@sha256:bf3dbe8f4c707b502b2a88262ed71c807220651597b76b56983f864af6197890,7280
   original:
-    hackage: hasql-pool-0.5.2.2@sha256:b56d4dea112d97a2ef4b2749508c0ca646828cb2d77b827e8dc433d249bb2062,2438
+    hackage: wai-extra-3.1.8@sha256:bf3dbe8f4c707b502b2a88262ed71c807220651597b76b56983f864af6197890,7280
 - completed:
-    hackage: lens-aeson-1.1.3@sha256:52c8eaecd2d1c2a969c0762277c4a8ee72c339a686727d5785932e72ef9c3050,1764
     pantry-tree:
-      size: 541
+      sha256: 52b5abf5c4c09bcfbc06e01f761a75c32cbd3e6ba23c8843981933fcc31ed53c
-      sha256: b31392b78f2a03111c805f4400007778eb93b49f998ab41dfbebaaf9b5526bad
+      size: 474
+    hackage: wai-logger-2.3.7@sha256:19a0dc5122e22d274776d80786fb9501956f5e75b8f82464bbdad5604d154d82,1671
   original:
-    hackage: lens-aeson-1.1.3@sha256:52c8eaecd2d1c2a969c0762277c4a8ee72c339a686727d5785932e72ef9c3050,1764
+    hackage: wai-logger-2.3.7@sha256:19a0dc5122e22d274776d80786fb9501956f5e75b8f82464bbdad5604d154d82,1671
 - completed:
-    hackage: optparse-applicative-0.16.1.0@sha256:418c22ed6a19124d457d96bc66bd22c93ac22fad0c7100fe4972bbb4ac989731,4982
     pantry-tree:
-      size: 2979
+      sha256: 99ff839445ba2c9e29a294b45904e3f4575336c7d2b4504ce310d611661c761d
-      sha256: dd092d843091c08691485d68a1908517079b1bc6f3d73928f37635a19dc27fc1
+      size: 3973
+    hackage: warp-3.3.19@sha256:c6a47029537d42844386170d732cdfe6d85b2f4279bbaefdd9b50caff6faeebb,10910
   original:
-    hackage: optparse-applicative-0.16.1.0@sha256:418c22ed6a19124d457d96bc66bd22c93ac22fad0c7100fe4972bbb4ac989731,4982
+    hackage: warp-3.3.19@sha256:c6a47029537d42844386170d732cdfe6d85b2f4279bbaefdd9b50caff6faeebb,10910
-- completed:
-    hackage: protolude-0.3.2@sha256:2a38b3dad40d238ab644e234b692c8911423f9d3ed0e36b62287c4a698d92cd1,2240
-    pantry-tree:
-      size: 1594
-      sha256: a36d2912ac552d950ba4476de7d950b56b82dd28e48b9f4d0efee938f10bc525
-  original:
-    hackage: protolude-0.3.2@sha256:2a38b3dad40d238ab644e234b692c8911423f9d3ed0e36b62287c4a698d92cd1,2240
-- completed:
-    hackage: ptr-0.16.8.2@sha256:708ebb95117f2872d2c5a554eb6804cf1126e86abe793b2673f913f14e5eb1ac,3959
-    pantry-tree:
-      size: 1303
-      sha256: 557c438345de19f82bf01d676100da2a191ef06f624e7a4b90b09ac17cbb52a5
-  original:
-    hackage: ptr-0.16.8.2@sha256:708ebb95117f2872d2c5a554eb6804cf1126e86abe793b2673f913f14e5eb1ac,3959
 snapshots:
 - completed:
-    size: 618951
+    sha256: 87842ecbaa8ca9cee59a7e6be52369dbed82ed075cb4e0d152614a627e8fd488
-    url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/19/14.yaml
+    size: 586069
-    sha256: 4c31d4ef975b0211078862566aedf3b82b6cea569fc2cde4c72a51e5a8d236ce
+    url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/18/14.yaml
-  original: lts-19.14
+  original: lts-18.14

test/doc/Main.hs

@@ -8,11 +8,10 @@ import Protolude
 main :: IO ()
 main =
   doctest
-    [ "-XOverloadedStrings"
+    [ "--verbose"
+    , "-XOverloadedStrings"
     , "-XNoImplicitPrelude"
     , "-XStandaloneDeriving"
     , "-isrc"
-    , "src/PostgREST/Query/SqlFragment.hs"
     , "src/PostgREST/Request/Preferences.hs"
-    , "src/PostgREST/Request/QueryParams.hs"
     ]

test/io/configs/aliases.config

@@ -1,6 +1,10 @@
+db-anon-role = "required"
+db-uri = "required"
+
 db-schema = "provided_through_alias"
 max-rows = 1000
 pre-request = "check_alias"
 role-claim-key = ".aliased"
 root-spec = "open_alias"
 secret-is-base64 = true
+db-config = false

test/io/configs/app-settings.config

@@ -0,0 +1,2 @@
+app.settings.external_api_secret = "0123456789abcdef"
+db-config = false

test/io/configs/base64-secret-from-file.config

@@ -0,0 +1,4 @@
+# Read secret from a file: /dev/stdin (alias for standard input)
+jwt-secret = "@/dev/stdin"
+jwt-secret-is-base64 = true
+db-config = false

test/io/configs/boolean-numeric.config

@@ -1,3 +1,8 @@
+db-uri = "required"
+db-schemas = "required"
+db-anon-role = "required"
+
 db-channel-enabled = "1"
 db-prepared-statements = "0"
 jwt-secret-is-base64 = "2"
+db-config = false

test/io/configs/boolean-string.config

@@ -1,3 +1,8 @@
+db-uri = "required"
+db-schemas = "required"
+db-anon-role = "required"
+
 db-channel-enabled = "true"
 db-prepared-statements = "FALSE"
 jwt-secret-is-base64 = "\"true\""
+db-config = false

test/io/configs/dburi-from-file.config

@@ -0,0 +1,3 @@
+db-uri = "@/dev/stdin"
+jwt-secret = "reallyreallyreallyreallyverysafe"
+db-config = false

test/io/configs/defaults.config

@@ -1,2 +1,5 @@
-# Not the default, but only works with PG* variables, which are not set
+db-uri = "required"
+db-schemas = "required"
+db-anon-role = "required"
+# Not the default, but only works with proper db-uri
 db-config = false

test/io/configs/expected/aliases.config

@@ -1,18 +1,17 @@
-db-anon-role = ""
+db-anon-role = "required"
 db-channel = "pgrst"
 db-channel-enabled = true
 db-extra-search-path = "public"
 db-max-rows = 1000
-db-plan-enabled = false
 db-pool = 10
-db-pool-timeout = 3600
+db-pool-timeout = 10
 db-pre-request = "check_alias"
 db-prepared-statements = true
 db-root-spec = "open_alias"
 db-schemas = "provided_through_alias"
-db-config = true
+db-config = false
 db-tx-end = "commit"
-db-uri = "postgresql://"
+db-uri = "required"
 db-use-legacy-gucs = true
 jwt-aud = ""
 jwt-role-claim-key = ".\"aliased\""
@@ -20,11 +19,9 @@ jwt-secret = ""
 jwt-secret-is-base64 = true
 log-level = "error"
 openapi-mode = "follow-privileges"
-openapi-security-active = false
 openapi-server-proxy-uri = ""
 raw-media-types = ""
 server-host = "!4"
 server-port = 3000
 server-unix-socket = ""
 server-unix-socket-mode = "660"
-admin-server-port = ""

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

@@ -1,18 +1,17 @@
-db-anon-role = ""
+db-anon-role = "required"
 db-channel = "pgrst"
 db-channel-enabled = true
 db-extra-search-path = "public"
 db-max-rows = ""
-db-plan-enabled = false
 db-pool = 10
-db-pool-timeout = 3600
+db-pool-timeout = 10
 db-pre-request = ""
 db-prepared-statements = false
 db-root-spec = ""
-db-schemas = "public"
+db-schemas = "required"
-db-config = true
+db-config = false
 db-tx-end = "commit"
-db-uri = "postgresql://"
+db-uri = "required"
 db-use-legacy-gucs = true
 jwt-aud = ""
 jwt-role-claim-key = ".\"role\""
@@ -20,11 +19,9 @@ jwt-secret = ""
 jwt-secret-is-base64 = true
 log-level = "error"
 openapi-mode = "follow-privileges"
-openapi-security-active = false
 openapi-server-proxy-uri = ""
 raw-media-types = ""
 server-host = "!4"
 server-port = 3000
 server-unix-socket = ""
 server-unix-socket-mode = "660"
-admin-server-port = ""

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

@@ -1,18 +1,17 @@
-db-anon-role = ""
+db-anon-role = "required"
 db-channel = "pgrst"
 db-channel-enabled = true
 db-extra-search-path = "public"
 db-max-rows = ""
-db-plan-enabled = false
 db-pool = 10
-db-pool-timeout = 3600
+db-pool-timeout = 10
 db-pre-request = ""
 db-prepared-statements = false
 db-root-spec = ""
-db-schemas = "public"
+db-schemas = "required"
-db-config = true
+db-config = false
 db-tx-end = "commit"
-db-uri = "postgresql://"
+db-uri = "required"
 db-use-legacy-gucs = true
 jwt-aud = ""
 jwt-role-claim-key = ".\"role\""
@@ -20,11 +19,9 @@ jwt-secret = ""
 jwt-secret-is-base64 = true
 log-level = "error"
 openapi-mode = "follow-privileges"
-openapi-security-active = false
 openapi-server-proxy-uri = ""
 raw-media-types = ""
 server-host = "!4"
 server-port = 3000
 server-unix-socket = ""
 server-unix-socket-mode = "660"
-admin-server-port = ""

test/io/configs/expected/defaults.config

@@ -1,18 +1,17 @@
-db-anon-role = ""
+db-anon-role = "required"
 db-channel = "pgrst"
 db-channel-enabled = true
 db-extra-search-path = "public"
 db-max-rows = ""
-db-plan-enabled = false
 db-pool = 10
-db-pool-timeout = 3600
+db-pool-timeout = 10
 db-pre-request = ""
 db-prepared-statements = true
 db-root-spec = ""
-db-schemas = "public"
+db-schemas = "required"
 db-config = false
 db-tx-end = "commit"
-db-uri = "postgresql://"
+db-uri = "required"
 db-use-legacy-gucs = true
 jwt-aud = ""
 jwt-role-claim-key = ".\"role\""
@@ -20,11 +19,9 @@ jwt-secret = ""
 jwt-secret-is-base64 = false
 log-level = "error"
 openapi-mode = "follow-privileges"
-openapi-security-active = false
 openapi-server-proxy-uri = ""
 raw-media-types = ""
 server-host = "!4"
 server-port = 3000
 server-unix-socket = ""
 server-unix-socket-mode = "660"
-admin-server-port = ""

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

@@ -1,9 +1,8 @@
-db-anon-role = "other"
+db-anon-role = "postgrest_test_anonymous"
 db-channel = "postgrest"
 db-channel-enabled = false
 db-extra-search-path = "public,extensions,other"
 db-max-rows = 100
-db-plan-enabled = true
 db-pool = 1
 db-pool-timeout = 100
 db-pre-request = "test.other_custom_headers"
@@ -12,7 +11,7 @@ db-root-spec = "other_root"
 db-schemas = "test,other_tenant1,other_tenant2"
 db-config = true
 db-tx-end = "rollback-allow-override"
-db-uri = "postgresql://"
+db-uri = "<REPLACED_WITH_DB_URI>"
 db-use-legacy-gucs = false
 jwt-aud = "https://otherexample.org"
 jwt-role-claim-key = ".\"other\".\"role\""
@@ -20,13 +19,11 @@ jwt-secret = "ODERREALLYREALLYREALLYREALLYVERYSAFE"
 jwt-secret-is-base64 = true
 log-level = "info"
 openapi-mode = "disabled"
-openapi-security-active = false
 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-unix-socket = "/tmp/pgrst_io_test.sock"
 server-unix-socket-mode = "777"
-admin-server-port = 3001
 app.settings.test = "test"
 app.settings.test2 = "test"

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

@@ -1,9 +1,8 @@
-db-anon-role = "anonymous"
+db-anon-role = "postgrest_test_anonymous"
 db-channel = "postgrest"
 db-channel-enabled = false
 db-extra-search-path = "public,extensions,private"
 db-max-rows = 1000
-db-plan-enabled = true
 db-pool = 1
 db-pool-timeout = 100
 db-pre-request = "test.custom_headers"
@@ -12,7 +11,7 @@ db-root-spec = "root"
 db-schemas = "test,tenant1,tenant2"
 db-config = true
 db-tx-end = "commit-allow-override"
-db-uri = "postgresql://"
+db-uri = "<REPLACED_WITH_DB_URI>"
 db-use-legacy-gucs = false
 jwt-aud = "https://example.org"
 jwt-role-claim-key = ".\"a\".\"role\""
@@ -20,13 +19,11 @@ jwt-secret = "OVERRIDE=REALLY=REALLY=REALLY=REALLY=VERY=SAFE"
 jwt-secret-is-base64 = false
 log-level = "info"
 openapi-mode = "ignore-privileges"
-openapi-security-active = true
 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-unix-socket = "/tmp/pgrst_io_test.sock"
 server-unix-socket-mode = "777"
-admin-server-port = 3001
 app.settings.test = "test"
 app.settings.test2 = "test"

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

@@ -3,7 +3,6 @@ db-channel = "postgrest"
 db-channel-enabled = false
 db-extra-search-path = "public,test"
 db-max-rows = 1000
-db-plan-enabled = true
 db-pool = 1
 db-pool-timeout = 100
 db-pre-request = "please_run_fast"
@@ -20,13 +19,11 @@ jwt-secret = "c2VjdXJpdHl0aHJvdWdob2JzY3VyaXR5"
 jwt-secret-is-base64 = true
 log-level = "info"
 openapi-mode = "ignore-privileges"
-openapi-security-active = true
 openapi-server-proxy-uri = "https://postgrest.org"
 raw-media-types = "application/vnd.pgrst.config"
 server-host = "0.0.0.0"
 server-port = 80
 server-unix-socket = "/tmp/pgrst_io_test.sock"
 server-unix-socket-mode = "777"
-admin-server-port = 3001
 app.settings.test = "test"
 app.settings.test2 = "test"

test/io/configs/expected/types.config

@@ -1,18 +1,17 @@
-db-anon-role = ""
+db-anon-role = "required"
 db-channel = "pgrst"
 db-channel-enabled = true
 db-extra-search-path = "public"
 db-max-rows = ""
-db-plan-enabled = false
 db-pool = 10
-db-pool-timeout = 3600
+db-pool-timeout = 10
 db-pre-request = ""
 db-prepared-statements = true
 db-root-spec = ""
-db-schemas = "public"
+db-schemas = "required"
 db-config = true
 db-tx-end = "commit"
-db-uri = "postgresql://"
+db-uri = "required"
 db-use-legacy-gucs = true
 jwt-aud = ""
 jwt-role-claim-key = ".\"role\""
@@ -20,12 +19,10 @@ jwt-secret = ""
 jwt-secret-is-base64 = false
 log-level = "error"
 openapi-mode = "follow-privileges"
-openapi-security-active = false
 openapi-server-proxy-uri = ""
 raw-media-types = ""
 server-host = "!4"
 server-port = 3000
 server-unix-socket = ""
 server-unix-socket-mode = "660"
-admin-server-port = ""
 app.settings.test = "Bool False"

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

@@ -5,7 +5,6 @@ PGRST_DB_CHANNEL: postgrest
 PGRST_DB_CHANNEL_ENABLED: false
 PGRST_DB_EXTRA_SEARCH_PATH: public, test
 PGRST_DB_MAX_ROWS: 1000
-PGRST_DB_PLAN_ENABLED: true
 PGRST_DB_POOL: 1
 PGRST_DB_POOL_TIMEOUT: 100
 PGRST_DB_PREPARED_STATEMENTS: false
@@ -23,11 +22,9 @@ PGRST_JWT_SECRET: c2VjdXJpdHl0aHJvdWdob2JzY3VyaXR5
 PGRST_JWT_SECRET_IS_BASE64: true
 PGRST_LOG_LEVEL: info
 PGRST_OPENAPI_MODE: 'ignore-privileges'
-PGRST_OPENAPI_SECURITY_ACTIVE: true
 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_UNIX_SOCKET: /tmp/pgrst_io_test.sock
 PGRST_SERVER_UNIX_SOCKET_MODE: 777
-PGRST_ADMIN_SERVER_PORT: 3001

test/io/configs/no-defaults.config

@@ -3,7 +3,6 @@ db-channel = "postgrest"
 db-channel-enabled = false
 db-extra-search-path = "public, test"
 db-max-rows = 1000
-db-plan-enabled = true
 db-pool = 1
 db-pool-timeout = 100
 db-pre-request = "please_run_fast"
@@ -20,13 +19,11 @@ jwt-secret = "c2VjdXJpdHl0aHJvdWdob2JzY3VyaXR5"
 jwt-secret-is-base64 = true
 log-level = "info"
 openapi-mode = "ignore-privileges"
-openapi-security-active = true
 openapi-server-proxy-uri = "https://postgrest.org"
 raw-media-types = "application/vnd.pgrst.config"
 server-host = "0.0.0.0"
 server-port = 80
 server-unix-socket = "/tmp/pgrst_io_test.sock"
 server-unix-socket-mode = "777"
-admin-server-port = 3001
 app.settings.test = "test"
 app.settings.test2 = "test"

test/io/configs/role-claim-key.config

@@ -0,0 +1,3 @@
+jwt-role-claim-key = "$(ROLE_CLAIM_KEY)"
+jwt-secret = "reallyreallyreallyreallyverysafe"
+db-config = false

test/io/configs/secret-from-file.config

@@ -0,0 +1,4 @@
+# Read secret from a file: /dev/stdin (alias for standard input)
+jwt-secret = "@/dev/stdin"
+jwt-secret-is-base64 = false
+db-config = false

test/io/configs/sigusr2-settings-external-secret.config

@@ -0,0 +1,3 @@
+jwt-secret = "$(JWT_SECRET_FILE)"
+jwt-secret-is-base64 = false
+db-config = false

test/io/configs/sigusr2-settings.config

@@ -1,5 +1,5 @@
-# will be replaced in test
 db-schemas = "public"
 
 app.settings.name_var = "John"
 jwt-secret = "invalidinvalidinvalidinvalidinvalid"
+db-config = false

test/io/configs/simple.config

@@ -0,0 +1,2 @@
+jwt-secret = "reallyreallyreallyreallyverysafe"
+db-config = false

test/io/configs/types.config

@@ -1,4 +1,7 @@
 # tests how config options fall back with invalid types
+db-anon-role = "required"
+db-schemas = "required"
+db-uri = "required"
 
 # expects string
 app.settings.test = false

test/io/db_config.sql

@@ -7,11 +7,9 @@ ALTER ROLE db_config_authenticator SET pgrst.raw_media_types = 'application/vnd.
 ALTER ROLE db_config_authenticator SET pgrst.jwt_secret = 'REALLY=REALLY=REALLY=REALLY=VERY=SAFE';
 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_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';
 ALTER ROLE db_config_authenticator SET pgrst.db_prepared_statements = 'false';
 ALTER ROLE db_config_authenticator SET pgrst.db_pre_request = 'test.custom_headers';
 ALTER ROLE db_config_authenticator SET pgrst.db_max_rows = '1000';
@@ -30,8 +28,8 @@ ALTER ROLE db_config_authenticator SET pgrst.server_host = 'ignored';
 ALTER ROLE db_config_authenticator SET pgrst.server_port = 'ignored';
 ALTER ROLE db_config_authenticator SET pgrst.server_unix_socket = 'ignored';
 ALTER ROLE db_config_authenticator SET pgrst.server_unix_socket_mode = 'ignored';
-ALTER ROLE db_config_authenticator SET pgrst.admin_server_port = 'ignored';
 ALTER ROLE db_config_authenticator SET pgrst.log_level = 'ignored';
+ALTER ROLE db_config_authenticator SET pgrst.db_anon_role = 'ignored';
 ALTER ROLE db_config_authenticator SET pgrst.db_uri = 'postgresql://ignored';
 ALTER ROLE db_config_authenticator SET pgrst.db_channel_enabled = 'ignored';
 ALTER ROLE db_config_authenticator SET pgrst.db_channel = 'ignored';
@@ -47,27 +45,11 @@ ALTER ROLE other_authenticator SET pgrst.raw_media_types = 'application/vnd.pgrs
 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';
 ALTER ROLE other_authenticator SET pgrst.db_prepared_statements = 'false';
 ALTER ROLE other_authenticator SET pgrst.db_pre_request = 'test.other_custom_headers';
 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';
-
--- authenticator used for tests that manipulate statement timeout
-CREATE ROLE timeout_authenticator LOGIN NOINHERIT;
-
-create function set_statement_timeout(role text, milliseconds int) returns void as $_$
-begin
-  execute format($$
-    alter role %I set statement_timeout to %L;
-  $$, role, milliseconds);
-end $_$ volatile security definer language plpgsql;
-
--- authenticator used for test-independent database manipulation
-CREATE ROLE meta_authenticator LOGIN NOINHERIT;

test/io/fixtures.sql

@@ -1,11 +1,6 @@
-\ir big_schema.sql
 \ir db_config.sql
 
-set search_path to public;
-
 CREATE ROLE postgrest_test_anonymous;
-ALTER ROLE :USER SET pgrst.db_anon_role = 'postgrest_test_anonymous';
-
 CREATE ROLE postgrest_test_author;
 
 GRANT postgrest_test_anonymous, postgrest_test_author TO :USER;
@@ -79,10 +74,8 @@ begin
   perform pg_notify('pgrst', 'reload config');
 end $_$ language plpgsql ;
 
-create or replace function sleep(seconds double precision) returns void as $$
+create or replace function raise_bad_pt() returns void as $$
-  select pg_sleep(seconds);
+begin
-$$ language sql;
+  raise sqlstate 'PT40A' using message = 'Wrong';
-
+end;
-create or replace function hello() returns text as $$
+$$ language plpgsql;
-  select 'hello';
-$$ language sql;

test/io/fixtures.yaml

@@ -10,17 +10,35 @@ cli:
     args: ['-e']
   - name: dump config
     args: ['--dump-config']
+    use_defaultenv: true
   - name: dump schema
     args: ['--dump-schema']
     use_defaultenv: true
-  - name: no config
 # failures: config files
+  - name: no config
+    expect: error
   - name: non-existant config file
     expect: error
     args: ['does_not_exist.conf']
   - name: invalid config file
     expect: error
     args: ['test/io-tests/configs/invalid.yaml']
+# failures: required config options
+  - name: missing db-anon-role
+    expect: error
+    env:
+      PGRST_DB_URI: required
+      PGRST_DB_SCHEMAS: required
+  - name: missing db-schemas
+    expect: error
+    env:
+      PGRST_DB_ANON_ROLE: required
+      PGRST_DB_URI: required
+  - name: missing db-uri
+    expect: error
+    env:
+      PGRST_DB_ANON_ROLE: required
+      PGRST_DB_SCHEMAS: required
 # failures: wrong config values
   - name: invalid server-unix-socket-mode not octal
     expect: error
@@ -171,10 +189,3 @@ invalidjointypes:
   - 'left!'
   - 'right'
   - '.#$$%&$%/'
-
-specialhostvalues:
-  - '*4'
-  - '!4'
-  - '*6'
-  - '!6'
-  - '*'

test/io/test_io.py

@@ -13,7 +13,6 @@ import signal
 import socket
 import subprocess
 import tempfile
-import threading
 import time
 import urllib.parse
 
@@ -47,25 +46,6 @@ def itemgetter(*items):
     return g
 
 
-class Thread(threading.Thread):
-    "Variant of threading.Thread that re-raises any exceptions when joining the thread"
-
-    def __init__(self, *args, **kwargs):
-        self._exception = None
-        super(Thread, self).__init__(*args, **kwargs)
-
-    def run(self):
-        try:
-            super(Thread, self).run()
-        except Exception as e:
-            self._exception = e
-
-    def join(self):
-        super(Thread, self).join()
-        if self._exception is not None:
-            raise self._exception
-
-
 class PostgrestTimedOut(Exception):
     "Connecting to PostgREST endpoint timed out."
 
@@ -90,8 +70,7 @@ class PostgrestSession(requests_unixsocket.Session):
 
 @dataclasses.dataclass
 class PostgrestProcess:
-    "Running PostgREST process and its corresponding main and admin endpoints."
+    "Running PostgREST process and its corresponding endpoint."
-    admin: object
     process: object
     session: object
 
@@ -99,52 +78,21 @@ class PostgrestProcess:
 @pytest.fixture
 def dburi():
     "Postgres database connection URI."
-    dbname = os.environ["PGDATABASE"]
+    return os.getenv("PGRST_DB_URI").encode()
-    host = os.environ["PGHOST"]
-    user = os.environ["PGUSER"]
-    return f"postgresql://?dbname={dbname}&host={host}&user={user}".encode()
 
 
 @pytest.fixture
-def baseenv():
+def defaultenv():
-    "Base environment to connect to PostgreSQL"
-    return {
-        "PGDATABASE": os.environ["PGDATABASE"],
-        "PGHOST": os.environ["PGHOST"],
-        "PGUSER": os.environ["PGUSER"],
-    }
-
-
-@pytest.fixture
-def defaultenv(baseenv):
     "Default environment for PostgREST."
     return {
-        **baseenv,
+        "PGRST_DB_URI": os.environ["PGRST_DB_URI"],
-        "PGRST_DB_CONFIG": "true",
+        "PGRST_DB_SCHEMAS": "public",
+        "PGRST_DB_ANON_ROLE": os.environ["PGRST_DB_ANON_ROLE"],
+        "PGRST_DB_CONFIG": "false",
         "PGRST_LOG_LEVEL": "info",
-        "PGRST_DB_POOL": "1",
-        "PGRST_DB_POOL_TIMEOUT": "1",
     }
 
 
-@pytest.fixture(scope="module")
-def metapostgrest():
-    "A shared postgrest instance to use for interacting with the database independently of the instance under test"
-    role = "meta_authenticator"
-    env = {
-        "PGDATABASE": os.environ["PGDATABASE"],
-        "PGHOST": os.environ["PGHOST"],
-        "PGUSER": role,
-        "PGRST_DB_ANON_ROLE": role,
-        "PGRST_DB_CONFIG": "true",
-        "PGRST_LOG_LEVEL": "info",
-        "PGRST_DB_POOL": "1",
-        "PGRST_DB_POOL_TIMEOUT": "1",
-    }
-    with run(env=env) as postgrest:
-        yield postgrest
-
-
 def hpctixfile():
     "Returns an individual filename for each test, if the HPCTIXFILE environment variable is set."
     if "HPCTIXFILE" not in os.environ:
@@ -188,30 +136,22 @@ def dumpconfig(configpath=None, env=None, stdin=None):
 
 
 @contextlib.contextmanager
-def run(
+def run(configpath=None, stdin=None, env=None, port=None):
-    configpath=None,
-    stdin=None,
-    env=None,
-    port=None,
-    host=None,
-    no_pool_connection_available=False,
-):
     "Run PostgREST and yield an endpoint that is ready for connections."
+    env = env or {}
+    env["PGRST_DB_POOL"] = "1"
+    env["PGRST_DB_POOL_TIMEOUT"] = "1"
 
     with tempfile.TemporaryDirectory() as tmpdir:
         if port:
             env["PGRST_SERVER_PORT"] = str(port)
-            env["PGRST_SERVER_HOST"] = host or "localhost"
+            env["PGRST_SERVER_HOST"] = "localhost"
             baseurl = f"http://localhost:{port}"
         else:
             socketfile = pathlib.Path(tmpdir) / "postgrest.sock"
             env["PGRST_SERVER_UNIX_SOCKET"] = str(socketfile)
             baseurl = "http+unix://" + urllib.parse.quote_plus(str(socketfile))
 
-        adminport = freeport()
-        env["PGRST_ADMIN_SERVER_PORT"] = str(adminport)
-        adminurl = f"http://localhost:{adminport}"
-
         command = [POSTGREST_BIN]
         env["HPCTIXFILE"] = hpctixfile()
 
@@ -232,19 +172,12 @@ def run(
             process.stdin.write(stdin or b"")
             process.stdin.close()
 
-            wait_until_ready(adminurl + "/ready")
+            wait_until_ready(baseurl)
 
             process.stdout.read()
 
-            yield PostgrestProcess(
+            yield PostgrestProcess(process=process, session=PostgrestSession(baseurl))
-                process=process,
-                session=PostgrestSession(baseurl),
-                admin=PostgrestSession(adminurl),
-            )
         finally:
-            if no_pool_connection_available:
-                sleep_pool_connection(baseurl, 10)
-
             remaining_output = process.stdout.read()
             if remaining_output:
                 print(remaining_output.decode())
@@ -285,18 +218,6 @@ def wait_until_ready(url):
         raise PostgrestTimedOut()
 
 
-def sleep_pool_connection(url, seconds):
-    "Sleep a pool connection by calling an RPC that uses pg_sleep"
-    session = requests_unixsocket.Session()
-
-    # The try/except is a hack for not waiting for the response,
-    # taken from https://stackoverflow.com/a/45601591/4692662
-    try:
-        session.get(url + f"/rpc/sleep?seconds={seconds}", timeout=0.1)
-    except requests.exceptions.ReadTimeout:
-        pass
-
-
 def authheader(token):
     "Bearer token HTTP authorization header."
     return {"Authorization": f"Bearer {token}"}
@@ -374,19 +295,25 @@ def test_expected_config_from_environment():
         ("other_authenticator", "no-defaults-with-db-other-authenticator.config"),
     ],
 )
-def test_expected_config_from_db_settings(baseenv, role, expectedconfig):
+def test_expected_config_from_db_settings(defaultenv, role, expectedconfig):
     "Config should be overriden from database settings"
 
     config = CONFIGSDIR / "no-defaults.config"
 
+    db_uri = defaultenv["PGRST_DB_URI"].replace(
+        "user=postgrest_test_authenticator", f"user={role}"
+    )
     env = {
-        **baseenv,
+        **defaultenv,
-        "PGUSER": role,
+        "PGRST_DB_URI": db_uri,
-        "PGRST_DB_URI": "postgresql://",
         "PGRST_DB_CONFIG": "true",
     }
+    expected = (
+        (CONFIGSDIR / "expected" / expectedconfig)
+        .read_text()
+        .replace("<REPLACED_WITH_DB_URI>", env["PGRST_DB_URI"])
+    )
 
-    expected = (CONFIGSDIR / "expected" / expectedconfig).read_text()
     assert dumpconfig(configpath=config, env=env) == expected
 
 
@@ -439,85 +366,32 @@ def test_port_connection(defaultenv):
 )
 def test_read_secret_from_file(secretpath, defaultenv):
     "Authorization should succeed when the secret is read from a file."
-
-    env = {**defaultenv, "PGRST_JWT_SECRET": f"@{secretpath}"}
-
     if secretpath.suffix == ".b64":
-        env["PGRST_JWT_SECRET_IS_BASE64"] = "true"
+        configfile = CONFIGSDIR / "base64-secret-from-file.config"
+    else:
+        configfile = CONFIGSDIR / "secret-from-file.config"
 
     secret = secretpath.read_bytes()
     headers = authheader(secretpath.with_suffix(".jwt").read_text())
 
-    with run(stdin=secret, env=env) as postgrest:
+    with run(configfile, stdin=secret, env=defaultenv) as postgrest:
         response = postgrest.session.get("/authors_only", headers=headers)
-        print(response.text)
         assert response.status_code == 200
 
 
-def test_read_secret_from_stdin(defaultenv):
+def test_read_dburi_from_file_without_eol(dburi, defaultenv):
-    "Authorization should succeed when the secret is read from stdin."
+    "Reading the dburi from a file with a single line should work."
-
+    config = CONFIGSDIR / "dburi-from-file.config"
-    env = {**defaultenv, "PGRST_DB_CONFIG": "false", "PGRST_JWT_SECRET": "@/dev/stdin"}
+    env = {key: value for key, value in defaultenv.items() if key != "PGRST_DB_URI"}
-
+    with run(config, env=env, stdin=dburi):
-    headers = jwtauthheader({"role": "postgrest_test_author"}, SECRET)
-
-    with run(stdin=SECRET.encode(), env=env) as postgrest:
-        response = postgrest.session.get("/authors_only", headers=headers)
-        print(response.text)
-        assert response.status_code == 200
-
-
-# TODO: This test would fail right now, because of
-# https://github.com/PostgREST/postgrest/issues/2126
-@pytest.mark.skip
-def test_read_secret_from_stdin_dbconfig(defaultenv):
-    "Authorization should succeed when the secret is read from stdin with db-config=true."
-
-    env = {**defaultenv, "PGRST_DB_CONFIG": "true", "PGRST_JWT_SECRET": "@/dev/stdin"}
-
-    headers = jwtauthheader({"role": "postgrest_test_author"}, SECRET)
-
-    with run(stdin=SECRET.encode(), env=env) as postgrest:
-        response = postgrest.session.get("/authors_only", headers=headers)
-        print(response.text)
-        assert response.status_code == 200
-
-
-def test_connect_with_dburi(dburi, defaultenv):
-    "Connecting with db-uri instead of LIPQ* environment variables should work."
-    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": dburi.decode()}
-    with run(env=env):
         pass
 
 
-def test_read_dburi_from_stdin_without_eol(dburi, defaultenv):
+def test_read_dburi_from_file_with_eol(dburi, defaultenv):
-    "Reading the dburi from stdin with a single line should work."
+    "Reading the dburi from a file containing a newline should work."
-    defaultenv_without_libpq = {
+    config = CONFIGSDIR / "dburi-from-file.config"
-        key: value
+    env = {key: value for key, value in defaultenv.items() if key != "PGRST_DB_URI"}
-        for key, value in defaultenv.items()
+    with run(config, env=env, stdin=dburi + b"\n"):
-        if key not in ["PGDATABASE", "PGHOST", "PGUSER"]
-    }
-    env = {**defaultenv_without_libpq, "PGRST_DB_URI": "@/dev/stdin"}
-
-    with run(env=env, stdin=dburi):
-        pass
-
-
-def test_read_dburi_from_stdin_with_eol(dburi, defaultenv):
-    "Reading the dburi from stdin containing a newline should work."
-    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": "@/dev/stdin"}
-
-    with run(env=env, stdin=dburi + b"\n"):
         pass
 
 
@@ -528,12 +402,11 @@ def test_role_claim_key(roleclaim, defaultenv):
     "Authorization should depend on a correct role-claim-key and JWT claim."
     env = {
         **defaultenv,
-        "PGRST_JWT_ROLE_CLAIM_KEY": roleclaim["key"],
+        "ROLE_CLAIM_KEY": roleclaim["key"],
-        "PGRST_JWT_SECRET": SECRET,
     }
     headers = jwtauthheader(roleclaim["data"], SECRET)
 
-    with run(env=env) as postgrest:
+    with run(CONFIGSDIR / "role-claim-key.config", env=env) as postgrest:
         response = postgrest.session.get("/authors_only", headers=headers)
         assert response.status_code == roleclaim["expected_status"]
 
@@ -543,11 +416,11 @@ def test_invalid_role_claim_key(invalidroleclaimkey, defaultenv):
     "Given an invalid role-claim-key, Postgrest should exit with a non-zero exit code."
     env = {
         **defaultenv,
-        "PGRST_JWT_ROLE_CLAIM_KEY": invalidroleclaimkey,
+        "ROLE_CLAIM_KEY": invalidroleclaimkey,
     }
 
     with pytest.raises(PostgrestError):
-        dump = dumpconfig(env=env)
+        dump = dumpconfig(CONFIGSDIR / "role-claim-key.config", env=env)
         for line in dump.split("\n"):
             if line.startswith("jwt-role-claim-key"):
                 print(line)
@@ -576,13 +449,10 @@ def test_iat_claim(defaultenv):
     https://github.com/PostgREST/postgrest/issues/1139
 
     """
-
-    env = {**defaultenv, "PGRST_JWT_SECRET": SECRET}
-
     claim = {"role": "postgrest_test_author", "iat": datetime.utcnow()}
     headers = jwtauthheader(claim, SECRET)
 
-    with run(env=env) as postgrest:
+    with run(CONFIGSDIR / "simple.config", env=defaultenv) as postgrest:
         for _ in range(10):
             response = postgrest.session.get("/authors_only", headers=headers)
             assert response.status_code == 200
@@ -597,10 +467,7 @@ def test_app_settings(defaultenv):
     See: https://github.com/PostgREST/postgrest/issues/1141
 
     """
-
+    with run(CONFIGSDIR / "app-settings.config", env=defaultenv) as postgrest:
-    env = {**defaultenv, "PGRST_APP_SETTINGS_EXTERNAL_API_SECRET": "0123456789abcdef"}
-
-    with run(env=env) as postgrest:
         # Wait for the db pool to time out, set to 1s in config
         time.sleep(2)
 
@@ -611,7 +478,7 @@ def test_app_settings(defaultenv):
 
 
 def test_app_settings_reload(tmp_path, defaultenv):
-    "App settings should be reloaded from file when PostgREST is sent SIGUSR2."
+    "App settings should be reloaded when PostgREST is sent SIGUSR2."
     config = (CONFIGSDIR / "sigusr2-settings.config").read_text()
     configfile = tmp_path / "test.config"
     configfile.write_text(config)
@@ -633,7 +500,7 @@ def test_app_settings_reload(tmp_path, defaultenv):
 
 
 def test_jwt_secret_reload(tmp_path, defaultenv):
-    "JWT secret should be reloaded from file when PostgREST is sent SIGUSR2."
+    "JWT secret should be reloaded when PostgREST is sent SIGUSR2."
     config = (CONFIGSDIR / "sigusr2-settings.config").read_text()
     configfile = tmp_path / "test.config"
     configfile.write_text(config)
@@ -658,6 +525,8 @@ def test_jwt_secret_reload(tmp_path, defaultenv):
 
 def test_jwt_secret_external_file_reload(tmp_path, defaultenv):
     "JWT secret external file should be reloaded when PostgREST is sent a SIGUSR2 or a NOTIFY."
+    config = CONFIGSDIR / "sigusr2-settings-external-secret.config"
+
     headers = jwtauthheader({"role": "postgrest_test_author"}, SECRET)
 
     external_secret_file = tmp_path / "jwt-secret-config"
@@ -665,20 +534,18 @@ def test_jwt_secret_external_file_reload(tmp_path, defaultenv):
 
     env = {
         **defaultenv,
-        "PGRST_JWT_SECRET": f"@{external_secret_file}",
+        "JWT_SECRET_FILE": f"@{external_secret_file}",
         "PGRST_DB_CHANNEL_ENABLED": "true",
-        "PGRST_DB_CONFIG": "false",
-        "PGRST_DB_ANON_ROLE": "postgrest_test_anonymous",  # required for NOTIFY
     }
 
-    with run(env=env) as postgrest:
+    with run(config, env=env) as postgrest:
         response = postgrest.session.get("/authors_only", headers=headers)
         assert response.status_code == 401
 
         # change external file
         external_secret_file.write_text(SECRET)
 
-        # SIGUSR1 doesn't reload external files, at least when db-config=false
+        # SIGUSR1 doesn't reload external files
         postgrest.process.send_signal(signal.SIGUSR1)
         time.sleep(0.1)
 
@@ -696,8 +563,7 @@ def test_jwt_secret_external_file_reload(tmp_path, defaultenv):
         external_secret_file.write_text("invalid" * 5)
 
         # reload config and external file with NOTIFY
-        response = postgrest.session.post("/rpc/reload_pgrst_config")
+        postgrest.session.post("/rpc/reload_pgrst_config")
-        assert response.status_code == 204
         time.sleep(0.1)
 
         response = postgrest.session.get("/authors_only", headers=headers)
@@ -705,14 +571,16 @@ def test_jwt_secret_external_file_reload(tmp_path, defaultenv):
 
 
 def test_db_schema_reload(tmp_path, defaultenv):
-    "DB schema should be reloaded from file when PostgREST is sent SIGUSR2."
+    "DB schema should be reloaded when PostgREST is sent SIGUSR2."
     config = (CONFIGSDIR / "sigusr2-settings.config").read_text()
     configfile = tmp_path / "test.config"
     configfile.write_text(config)
 
-    with run(configfile, env=defaultenv) as postgrest:
+    env = {key: value for key, value in defaultenv.items() if key != "PGRST_DB_SCHEMAS"}
+
+    with run(configfile, env=env) as postgrest:
         response = postgrest.session.get("/rpc/get_guc_value?name=search_path")
-        assert response.text == '"\\"public\\", \\"public\\""'
+        assert response.text == '"public, public"'
 
         # change setting
         configfile.write_text(
@@ -725,12 +593,10 @@ def test_db_schema_reload(tmp_path, defaultenv):
         # reload schema cache to verify that the config reload actually happened
         postgrest.process.send_signal(signal.SIGUSR1)
 
-        # takes max 1 second to load the internal cache(big_schema.sql included now)
+        time.sleep(0.1)
-        # 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\\""'
+        assert response.text == '"v1, public"'
 
 
 def test_db_schema_notify_reload(defaultenv):
@@ -740,7 +606,7 @@ def test_db_schema_notify_reload(defaultenv):
 
     with run(env=env) as postgrest:
         response = postgrest.session.get("/rpc/get_guc_value?name=search_path")
-        assert response.text == '"\\"public\\", \\"public\\""'
+        assert response.text == '"public, public"'
 
         # change db-schemas config on the db and reload config and cache with notify
         postgrest.session.post(
@@ -750,21 +616,23 @@ def test_db_schema_notify_reload(defaultenv):
         time.sleep(0.1)
 
         response = postgrest.session.get("/rpc/get_guc_value?name=search_path")
-        assert response.text == '"\\"v1\\", \\"public\\""'
+        assert response.text == '"v1, public"'
 
         # reset db-schemas config on the db
         response = postgrest.session.post("/rpc/reset_db_schema_config")
-        assert response.status_code == 204
+        assert response.status_code == 200
 
 
 def test_max_rows_reload(defaultenv):
     "max-rows should be reloaded from role settings when PostgREST receives a SIGUSR2."
+    config = CONFIGSDIR / "sigusr2-settings.config"
+
     env = {
         **defaultenv,
         "PGRST_DB_CONFIG": "true",
     }
 
-    with run(env=env) as postgrest:
+    with run(config, env=env) as postgrest:
         response = postgrest.session.head("/projects")
         assert response.status_code == 200
         assert response.headers["Content-Range"] == "0-4/*"
@@ -783,7 +651,7 @@ def test_max_rows_reload(defaultenv):
 
         # reset max-rows config on the db
         response = postgrest.session.post("/rpc/reset_max_rows_config")
-        assert response.status_code == 204
+        assert response.status_code == 200
 
 
 def test_max_rows_notify_reload(defaultenv):
@@ -813,7 +681,7 @@ def test_max_rows_notify_reload(defaultenv):
 
         # reset max-rows config on the db
         response = postgrest.session.post("/rpc/reset_max_rows_config")
-        assert response.status_code == 204
+        assert response.status_code == 200
 
 
 def test_invalid_role_claim_key_notify_reload(defaultenv):
@@ -839,7 +707,7 @@ def test_invalid_role_claim_key_notify_reload(defaultenv):
         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
+        assert response.status_code == 200
 
 
 def test_db_prepared_statements_enable(defaultenv):
@@ -863,267 +731,6 @@ def test_db_prepared_statements_disable(defaultenv):
         assert response.text == "false"
 
 
-def set_statement_timeout(postgrest, role, milliseconds):
-    """Set the statement timeout for the given role.
-    For this to work reliably with low previous timeout settings,
-    use a postgrest instance that doesn't use the affected role."""
-
-    response = postgrest.session.post(
-        "/rpc/set_statement_timeout", data={"role": role, "milliseconds": milliseconds}
-    )
-    assert response.status_code == 204
-
-
-def reset_statement_timeout(postgrest, role):
-    "Reset the statement timeout for the given role to the default 0 (no timeout)"
-    set_statement_timeout(postgrest, role, 0)
-
-
-def test_statement_timeout(defaultenv, metapostgrest):
-    "Statement timeout times out slow statements"
-
-    role = "timeout_authenticator"
-    set_statement_timeout(metapostgrest, role, 1000)  # 1 second
-
-    env = {
-        **defaultenv,
-        "PGUSER": role,
-        "PGRST_DB_ANON_ROLE": role,
-    }
-
-    with run(env=env) as postgrest:
-        response = postgrest.session.get("/rpc/sleep?seconds=0.5")
-        assert response.status_code == 204
-
-        response = postgrest.session.get("/rpc/sleep?seconds=2")
-        assert response.status_code == 500
-        data = response.json()
-        assert data["message"] == "canceling statement due to statement timeout"
-
-
-def test_change_statement_timeout(defaultenv, metapostgrest):
-    "Statement timeout changes take effect immediately"
-
-    role = "timeout_authenticator"
-    reset_statement_timeout(metapostgrest, role)
-
-    env = {
-        **defaultenv,
-        "PGUSER": role,
-        "PGRST_DB_ANON_ROLE": role,
-    }
-
-    with run(env=env) as postgrest:
-        # no limit initially
-        response = postgrest.session.get("/rpc/sleep?seconds=1")
-        assert response.status_code == 204
-
-        set_statement_timeout(metapostgrest, role, 500)  # 0.5s
-
-        # trigger schema refresh
-        postgrest.process.send_signal(signal.SIGUSR1)
-        time.sleep(0.1)
-
-        response = postgrest.session.get("/rpc/sleep?seconds=1")
-        assert response.status_code == 500
-        data = response.json()
-        assert data["message"] == "canceling statement due to statement timeout"
-
-        set_statement_timeout(metapostgrest, role, 2000)  # 2s
-
-        # trigger role setting refresh
-        postgrest.process.send_signal(signal.SIGUSR1)
-        time.sleep(0.1)
-
-        response = postgrest.session.get("/rpc/sleep?seconds=1")
-        assert response.status_code == 204
-
-
-def test_pool_size(defaultenv, metapostgrest):
-    "Verify that PGRST_DB_POOL setting allows the correct number of parallel requests"
-
-    env = {
-        **defaultenv,
-        "PGRST_DB_POOL": "2",
-    }
-
-    with run(env=env) as postgrest:
-
-        start = time.time()
-        threads = []
-        for i in range(4):
-
-            def sleep(i=i):
-                response = postgrest.session.get("/rpc/sleep?seconds=0.5")
-                assert response.status_code == 204, "thread {}".format(i)
-
-            t = Thread(target=sleep)
-            t.start()
-            threads.append(t)
-        for t in threads:
-            t.join()
-        end = time.time()
-        delta = end - start
-
-        # sleep 4 times for 0.5s each, with 2 requests in parallel
-        # => total time roughly 1s
-        assert delta > 1 and delta < 1.5
-
-
-@pytest.mark.xfail(reason="issue #2401")
-def test_change_statement_timeout_held_connection(defaultenv, metapostgrest):
-    "Statement timeout changes take effect immediately, even with a request outliving the reconfiguration"
-
-    role = "timeout_authenticator"
-    reset_statement_timeout(metapostgrest, role)
-
-    env = {
-        **defaultenv,
-        "PGUSER": role,
-        "PGRST_DB_ANON_ROLE": role,
-        "PGRST_DB_POOL": "2",
-    }
-
-    with run(env=env) as postgrest:
-        # start a slow request that holds a pool connection
-        def hold_connection():
-            response = postgrest.session.get("/rpc/sleep?seconds=1")
-            assert response.status_code == 204
-
-        hold = Thread(target=hold_connection)
-        hold.start()
-        # give the request time to start before SIGUSR1 flushes the pool
-        time.sleep(0.1)
-
-        set_statement_timeout(metapostgrest, role, 500)  # 0.5s
-        # trigger schema refresh; flushes pool and establishes a new connection
-        postgrest.process.send_signal(signal.SIGUSR1)
-
-        # wait for the slow request's connection to be returned to the pool
-        hold.join()
-
-        # subsequent requests should fail due to the lowered timeout; run several in parallel
-        # to ensure we use the full pool
-        threads = []
-        for i in range(2):
-
-            def sleep(i=i):
-                response = postgrest.session.get("/rpc/sleep?seconds=1")
-                assert response.status_code == 500, "thread {}".format(i)
-                data = response.json()
-                assert data["message"] == "canceling statement due to statement timeout"
-
-            thread = Thread(target=sleep)
-            thread.start()
-            threads.append(thread)
-
-        for t in threads:
-            t.join()
-
-
-def test_admin_ready_w_channel(defaultenv):
-    "Should get a success response from the admin server ready endpoint when the LISTEN channel is enabled"
-
-    env = {
-        **defaultenv,
-        "PGRST_DB_CHANNEL_ENABLED": "true",
-    }
-
-    with run(env=env) as postgrest:
-        response = postgrest.admin.get("/ready")
-        assert response.status_code == 200
-
-
-def test_admin_ready_wo_channel(defaultenv):
-    "Should get a success response from the admin server ready endpoint when the LISTEN channel is disabled"
-
-    env = {
-        **defaultenv,
-        "PGRST_DB_CHANNEL_ENABLED": "false",
-    }
-
-    with run(env=env) as postgrest:
-        response = postgrest.admin.get("/ready")
-        assert response.status_code == 200
-
-
-def test_admin_ready_includes_schema_cache_state(defaultenv, metapostgrest):
-    "Should get a failed response from the admin server ready endpoint when the schema cache is not loaded"
-
-    role = "timeout_authenticator"
-    reset_statement_timeout(metapostgrest, role)
-
-    env = {
-        **defaultenv,
-        "PGUSER": role,
-        "PGRST_DB_ANON_ROLE": role,
-    }
-
-    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)
-
-        # force a reconnection so the new role setting is picked up
-        postgrest.process.send_signal(signal.SIGUSR1)
-        time.sleep(0.1)
-
-        response = postgrest.admin.get("/ready")
-        assert response.status_code == 503
-
-        response = postgrest.session.get("/projects")
-        assert response.status_code == 503
-
-
-def test_admin_not_found(defaultenv):
-    "Should get a not found from a undefined endpoint on the admin server"
-
-    with run(env=defaultenv) as postgrest:
-        response = postgrest.admin.get("/notfound")
-        assert response.status_code == 404
-
-
-def test_admin_ready_dependent_on_main_app(defaultenv):
-    "Should get a failure from the admin ready endpoint if the main app also fails"
-
-    with run(env=defaultenv) as postgrest:
-        # delete the unix socket to make the main app fail
-        os.remove(defaultenv["PGRST_SERVER_UNIX_SOCKET"])
-        response = postgrest.admin.get("/ready")
-        assert response.status_code == 503
-
-
-def test_admin_live_good(defaultenv):
-    "Should get a success from the admin live endpoint if the main app is running"
-
-    with run(env=defaultenv, port=freeport()) as postgrest:
-        response = postgrest.admin.get("/live")
-        assert response.status_code == 200
-
-
-def test_admin_live_dependent_on_main_app(defaultenv):
-    "Should get a failure from the admin live endpoint if the main app also fails"
-
-    with run(env=defaultenv) as postgrest:
-        # delete the unix socket to make the main app fail
-        os.remove(defaultenv["PGRST_SERVER_UNIX_SOCKET"])
-        response = postgrest.admin.get("/live")
-        assert response.status_code == 503
-
-
-@pytest.mark.parametrize("specialhostvalue", FIXTURES["specialhostvalues"])
-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
-
-        response = postgrest.admin.get("/ready")
-        assert response.status_code == 200
-
-
 @pytest.mark.parametrize(
     "level, has_output",
     [
@@ -1138,16 +745,12 @@ def test_log_level(level, has_output, defaultenv):
 
     env = {**defaultenv, "PGRST_LOG_LEVEL": level}
 
-    # expired token to test 500 response for "JWT expired"
-    claim = {"role": "postgrest_test_author", "exp": 0}
-    headers = jwtauthheader(claim, SECRET)
-
     with run(env=env) as postgrest:
         response = postgrest.session.get("/")
         assert response.status_code == 200
         if has_output[0]:
             assert re.match(
-                r'- - postgrest_test_anonymous \[.+\] "GET / HTTP/1.1" 200 - "" "python-requests/.+"',
+                r'unknownSocket - - \[.+\] "GET / HTTP/1.1" 200 - "" "python-requests/.+"',
                 postgrest.process.stdout.readline().decode(),
             )
 
@@ -1155,79 +758,14 @@ def test_log_level(level, has_output, defaultenv):
         assert response.status_code == 404
         if has_output[1]:
             assert re.match(
-                r'- - postgrest_test_anonymous \[.+\] "GET /unknown HTTP/1.1" 404 - "" "python-requests/.+"',
+                r'unknownSocket - - \[.+\] "GET /unknown HTTP/1.1" 404 - "" "python-requests/.+"',
                 postgrest.process.stdout.readline().decode(),
             )
 
-        response = postgrest.session.get("/", headers=headers)
+        response = postgrest.session.get("/rpc/raise_bad_pt")
         assert response.status_code == 500
         if has_output[2]:
             assert re.match(
-                r'- - - \[.+\] "GET / HTTP/1.1" 500 - "" "python-requests/.+"',
+                r'unknownSocket - - \[.+\] "GET /rpc/raise_bad_pt HTTP/1.1" 500 - "" "python-requests/.+"',
                 postgrest.process.stdout.readline().decode(),
             )
-
-
-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
-
-        # an invalid http method on a resource shouldn't require opening a connection
-        response = postgrest.session.request("TRACE", "/projects")
-        assert response.status_code == 405
-        response = postgrest.session.patch("/rpc/hello")
-        assert response.status_code == 405
-
-
-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
-
-        # OPTIONS on RPC shouldn't require opening a connection
-        response = postgrest.session.options("/rpc/hello")
-        assert response.status_code == 200
-
-        # OPTIONS on root shouldn't require opening a connection
-        response = postgrest.session.options("/")
-        assert response.status_code == 200
-
-
-def test_no_pool_connection_required_on_bad_jwt_claim(defaultenv):
-    "no pool connection should be consumed for failing on invalid jwt"
-
-    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)
-        assert response.status_code == 401
-
-
-# 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
-@pytest.mark.skip
-def test_openapi_in_big_schema(defaultenv):
-    "Should get a successful response from openapi on a big schema"
-
-    env = {
-        **defaultenv,
-        "PGRST_DB_SCHEMAS": "apflora",
-        "PGRST_OPENAPI_MODE": "ignore-privileges",
-    }
-
-    with run(env=env) as postgrest:
-        response = postgrest.session.get("/")
-        assert response.status_code == 200

test/load/fixtures.sql

@@ -13,15 +13,9 @@ INSERT INTO test.actors VALUES (1, 'John Doe');
 
 -- POST target needs generated PK
 CREATE TABLE test.films (
-  id  INT PRIMARY KEY,
+  PRIMARY KEY (film),
-  title TEXT,
+  film  INT GENERATED BY DEFAULT AS IDENTITY,
-  year TEXT,
+  title TEXT
-  runtime TEXT,
-  genres TEXT[],
-  director TEXT,
-  actors TEXT,
-  plot TEXT,
-  "posterUrl" TEXT
 );
 
 -- DELETE target remains empty

test/load/post.json

@@ -1,4 +1,3 @@
 {
-  "id": 0,
   "title": "Workers Leaving The Lumière Factory In Lyon"
 }

test/load/targets.http

@@ -11,11 +11,6 @@ POST http://postgrest/films?columns=title
 Prefer: tx=rollback
 @post.json
 
-POST http://postgrest/films?columns=id,title,year,runtime,genres,director,actors,plot,posterUrl
-Prefer: tx=rollback
-# this bulk.json was obtained from https://github.com/erik-sytnyk/movies-list/blob/master/db.json
-@bulk.json
-
 PUT http://postgrest/actors?actor=eq.1&columns=name
 Prefer: tx=rollback
 @put.json

test/memory/memory-tests.sh

@@ -1,13 +1,13 @@
-#!/usr/bin/env bash
+#! /usr/bin/env bash
 
 # This test script expects that a `postgrest` executable with profiling enabled
 # is on the PATH.
 
-set -Eeuo pipefail
+set -eu
 
 pgrPort=49421
 
-export PGRST_DB_ANON_ROLE="postgrest_test_anonymous"
+# PGRST_DB_URI, PGRST_DB_ANON_ROLE and PGRST_DB_SCHEMAS are expected to be set by with_tmp_db
 export PGRST_DB_POOL="1"
 export PGRST_SERVER_HOST="127.0.0.1"
 export PGRST_SERVER_PORT="$pgrPort"
@@ -22,7 +22,7 @@ result(){ echo "$1 $currentTest $2"; currentTest=$(( currentTest + 1 )); }
 ok(){ result 'ok' "- $1"; }
 ko(){ result 'not ok' "- $1"; failedTests=$(( failedTests + 1 )); }
 
-pgrStart(){ postgrest +RTS -p -h > /dev/null 2>&1 & pgrPID="$!"; }
+pgrStart(){ postgrest +RTS -p -h > /dev/null & pgrPID="$!"; }
 pgrStop(){ kill "$pgrPID" 2>/dev/null; }
 
 checkPgrStarted(){
@@ -102,21 +102,21 @@ postJsonArrayTest(){
 
 echo "Running memory usage tests.."
 
-jsonKeyTest "1M" "POST" "/rpc/leak?columns=blob" "16M"
+jsonKeyTest "1M" "POST" "/rpc/leak?columns=blob" "13M"
-jsonKeyTest "1M" "POST" "/leak?columns=blob" "16M"
+jsonKeyTest "1M" "POST" "/leak?columns=blob" "13M"
-jsonKeyTest "1M" "PATCH" "/leak?id=eq.1&columns=blob" "16M"
+jsonKeyTest "1M" "PATCH" "/leak?id=eq.1&columns=blob" "13M"
 
-jsonKeyTest "10M" "POST" "/rpc/leak?columns=blob" "44M"
+jsonKeyTest "10M" "POST" "/rpc/leak?columns=blob" "41M"
-jsonKeyTest "10M" "POST" "/leak?columns=blob" "44M"
+jsonKeyTest "10M" "POST" "/leak?columns=blob" "41M"
-jsonKeyTest "10M" "PATCH" "/leak?id=eq.1&columns=blob" "44M"
+jsonKeyTest "10M" "PATCH" "/leak?id=eq.1&columns=blob" "41M"
 
-jsonKeyTest "50M" "POST" "/rpc/leak?columns=blob" "172M"
+jsonKeyTest "50M" "POST" "/rpc/leak?columns=blob" "171M"
-jsonKeyTest "50M" "POST" "/leak?columns=blob" "172M"
+jsonKeyTest "50M" "POST" "/leak?columns=blob" "171M"
-jsonKeyTest "50M" "PATCH" "/leak?id=eq.1&columns=blob" "172M"
+jsonKeyTest "50M" "PATCH" "/leak?id=eq.1&columns=blob" "171M"
 
-postJsonArrayTest "1000" "/perf_articles?columns=id,body" "14M"
+postJsonArrayTest "1000" "/perf_articles?columns=id,body" "11M"
-postJsonArrayTest "10000" "/perf_articles?columns=id,body" "14M"
+postJsonArrayTest "10000" "/perf_articles?columns=id,body" "11M"
-postJsonArrayTest "100000" "/perf_articles?columns=id,body" "24M"
+postJsonArrayTest "100000" "/perf_articles?columns=id,body" "21M"
 
 trap - int term exit
 

test/spec/Feature/AndOrParamsSpec.hs

@@ -1,4 +1,4 @@
-module Feature.Query.AndOrParamsSpec where
+module Feature.AndOrParamsSpec where
 
 import Network.Wai (Application)
 
@@ -201,9 +201,7 @@ spec actualPgVersion =
           get "/entities?or=()" `shouldRespondWith`
             [json|{
               "details": "unexpected \")\" expecting field name (* or [a..z0..9_]), negation operator (not) or logic operator (and, or)",
-              "message": "\"failed to parse logic tree (())\" (line 1, column 4)",
+              "message": "\"failed to parse logic tree (())\" (line 1, column 4)"
-              "code": "PGRST100",
-              "hint": null
             }|] { matchStatus = 400, matchHeaders = [matchContentTypeJson] }
         it "can have a single condition" $ do
           get "/entities?or=(id.eq.1)&select=id" `shouldRespondWith`
@@ -257,30 +255,22 @@ spec actualPgVersion =
       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)",
+          "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)",
+          "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)",
+          "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)",
+          "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] }