Bump to version v7.0.0

Group unix socket functionality into its own module

.circleci/config.yml

@@ -52,24 +52,51 @@ build-distro-bin: &build-distro-bin
         key: v1-{{ .Environment.CIRCLE_JOB }}-dependencies-{{ checksum "postgrest.cabal" }}-{{ checksum "stack.yaml" }}
 
 jobs:
-  build-test:
+  build-test-9.4:
-    machine: true
+    docker:
+      - image: circleci/buildpack-deps:trusty
+        environment:
+          - PGHOST=localhost
+      - image: circleci/postgres:9.4.14
+        environment:
+          - POSTGRES_USER=circleci
+          - POSTGRES_DB=circleci
     steps:
       - checkout
       - restore_cache:
           keys:
           - v1-stack-dependencies-{{ checksum "postgrest.cabal" }}-{{ checksum "stack.yaml" }}
+      - run:
+          name: install ncat
+          command: |
+            # utility needed to test socket connection with curl <  7.40
+            sudo apt-get install nmap
       - run:
           name: install stack & dependencies
           command: |
-            curl -L https://github.com/commercialhaskell/stack/releases/download/v1.1.2/stack-1.1.2-linux-x86_64.tar.gz | tar zx -C /tmp
+            curl -L https://github.com/commercialhaskell/stack/releases/download/v2.1.3/stack-2.1.3-linux-x86_64.tar.gz | tar zx -C /tmp
-            sudo mv /tmp/stack-1.1.2-linux-x86_64/stack /usr/bin
+            sudo mv /tmp/stack-2.1.3-linux-x86_64/stack /usr/bin
             sudo apt-get update
-            sudo apt-get install libgmp-dev
+            sudo apt-get install -y libgmp-dev
-            sudo apt-get install --only-upgrade binutils
+            sudo apt-get install -y --only-upgrade binutils
+            sudo apt-get install -y postgresql-client
             stack setup
             rm -rf $(stack path --dist-dir) $(stack path --local-install-root)
-            stack install hlint packdeps cabal-install
+            stack install hlint stylish-haskell
+      - run:
+          name: Add stack tools to $PATH
+          command: |
+            echo "export PATH=/home/circleci/.local/bin:$PATH" >> $BASH_ENV
+      - run:
+          name: build src and tests dependencies
+          command: |
+            stack build --fast -j1 --only-dependencies
+            stack build --fast --test --no-run-tests --only-dependencies
+      - save_cache:
+          paths:
+            - "~/.stack"
+            - ".stack-work"
+          key: v1-stack-dependencies-{{ checksum "postgrest.cabal" }}-{{ checksum "stack.yaml" }}
       - run:
           name: build src and tests
           command: |
@@ -78,29 +105,159 @@ jobs:
       - run:
           name: run tests
           command: |
-            sudo service postgresql start
             POSTGREST_TEST_CONNECTION=$(test/create_test_db "postgres://circleci@localhost" postgrest_test) stack test
             test/io-tests.sh
       - run:
           name: run linter
-          command: git ls-files | grep '\.l\?hs$' | xargs stack exec -- hlint -X QuasiQuotes -X NoPatternSynonyms "$@"
+          command: make lint
       - run:
-          name: extra checks
+          name: run styler
+          command: make style
+
+  build-test-9.6:
+    docker:
+      - image: circleci/buildpack-deps:trusty
+        environment:
+          - PGHOST=localhost
+      - image: circleci/postgres:9.6.2
+        environment:
+          - POSTGRES_USER=circleci
+          - POSTGRES_DB=circleci
+    steps:
+      - checkout
+      - restore_cache:
+          keys:
+          - v1-stack-dependencies-{{ checksum "postgrest.cabal" }}-{{ checksum "stack.yaml" }}
+      - run:
+          name: install stack & dependencies
           command: |
-            stack exec -- cabal update
+            curl -L https://github.com/commercialhaskell/stack/releases/download/v2.1.3/stack-2.1.3-linux-x86_64.tar.gz | tar zx -C /tmp
-            stack exec --no-ghc-package-path -- cabal install --only-d --dry-run
+            sudo mv /tmp/stack-2.1.3-linux-x86_64/stack /usr/bin
-            stack exec -- packdeps *.cabal || true
+            sudo apt-get update
-            stack exec -- cabal check
+            sudo apt-get install -y libgmp-dev
-            stack haddock --no-haddock-deps
+            sudo apt-get install -y postgresql-client
-            stack sdist
+            stack setup
+      - run:
+          name: build src and tests
+          command: |
+            stack build --fast -j1
+            stack build --fast --test --no-run-tests
+      - run:
+          name: run tests
+          command: POSTGREST_TEST_CONNECTION=$(test/create_test_db "postgres://circleci@localhost" postgrest_test) stack test postgrest:spec
+
+  build-test-10:
+    docker:
+      - image: circleci/buildpack-deps:trusty
+        environment:
+          - PGHOST=localhost
+      - image: circleci/postgres:10.5
+        environment:
+          - POSTGRES_USER=circleci
+          - POSTGRES_DB=circleci
+    steps:
+      - checkout
+      - restore_cache:
+          keys:
+          - v1-stack-dependencies-{{ checksum "postgrest.cabal" }}-{{ checksum "stack.yaml" }}
+      - run:
+          name: install stack & dependencies
+          command: |
+            curl -L https://github.com/commercialhaskell/stack/releases/download/v2.1.3/stack-2.1.3-linux-x86_64.tar.gz | tar zx -C /tmp
+            sudo mv /tmp/stack-2.1.3-linux-x86_64/stack /usr/bin
+            sudo apt-get update
+            sudo apt-get install -y libgmp-dev
+            sudo apt-get install -y postgresql-client
+            stack setup
+      - run:
+          name: build src and tests
+          command: |
+            stack build --fast -j1
+            stack build --fast --test --no-run-tests
+      - run:
+          name: run tests
+          command: POSTGREST_TEST_CONNECTION=$(test/create_test_db "postgres://circleci@localhost" postgrest_test) stack test postgrest:spec
+
+  build-test-11:
+    docker:
+      - image: circleci/buildpack-deps:trusty
+        environment:
+          - PGHOST=localhost
+      - image: circleci/postgres:11.4
+        environment:
+          - POSTGRES_USER=circleci
+          - POSTGRES_DB=circleci
+    steps:
+      - checkout
+      - restore_cache:
+          keys:
+          - v1-stack-dependencies-{{ checksum "postgrest.cabal" }}-{{ checksum "stack.yaml" }}
+      - run:
+          name: install stack & dependencies
+          command: |
+            curl -L https://github.com/commercialhaskell/stack/releases/download/v2.1.3/stack-2.1.3-linux-x86_64.tar.gz | tar zx -C /tmp
+            sudo mv /tmp/stack-2.1.3-linux-x86_64/stack /usr/bin
+            sudo apt-get update
+            sudo apt-get install -y libgmp-dev
+            sudo apt-get install -y postgresql-client
+            stack setup
+      - run:
+          name: build src and tests
+          command: |
+            stack build --fast -j1
+            stack build --fast --test --no-run-tests
+      - run:
+          name: run tests
+          command: POSTGREST_TEST_CONNECTION=$(test/create_test_db "postgres://circleci@localhost" postgrest_test) stack test postgrest:spec
+
+  build-prof-test:
+    docker:
+      - image: circleci/buildpack-deps:trusty
+        environment:
+          - PGHOST=localhost
+          - TERM=xterm
+      - image: circleci/postgres:9.6.2
+        environment:
+          - POSTGRES_USER=circleci
+          - POSTGRES_DB=circleci
+    steps:
+      - checkout
+      - restore_cache:
+          keys:
+          - v1-stack-prof-dependencies-{{ checksum "postgrest.cabal" }}-{{ checksum "stack.yaml" }}
+      - run:
+          name: install stack & dependencies
+          command: |
+            curl -L https://github.com/commercialhaskell/stack/releases/download/v2.1.3/stack-2.1.3-linux-x86_64.tar.gz | tar zx -C /tmp
+            sudo mv /tmp/stack-2.1.3-linux-x86_64/stack /usr/bin
+            sudo apt-get update
+            sudo apt-get install -y libgmp-dev
+            sudo apt-get install -y postgresql-client
+            stack setup
+      - run:
+          name: build dependencies with profiling enabled
+          command: |
+            stack build --profile -j1  --only-dependencies
       - save_cache:
           paths:
             - "~/.stack"
             - ".stack-work"
-          key: v1-stack-dependencies-{{ checksum "postgrest.cabal" }}-{{ checksum "stack.yaml" }}
+          key: v1-stack-prof-dependencies-{{ checksum "postgrest.cabal" }}-{{ checksum "stack.yaml" }}
-
+      - run:
-  centos6:
+          name: build with profiling enabled
-    <<: *build-distro-bin
+          command: |
+            stack build --profile -j1
+      - run:
+          name: run memory usage tests
+          command: |
+            test/create_test_db "postgres://circleci@localhost" postgrest_test
+            psql "postgres:///postgrest_test" -f test/fixtures/database.sql
+            psql "postgres:///postgrest_test" -f test/fixtures/roles.sql
+            psql "postgres:///postgrest_test" -f test/fixtures/schema.sql
+            psql "postgres:///postgrest_test" -f test/fixtures/jwt.sql
+            psql "postgres:///postgrest_test" -f test/fixtures/jsonschema.sql
+            psql "postgres:///postgrest_test" -f test/fixtures/privileges.sql
+            test/memory-tests.sh
 
   centos7:
     <<: *build-distro-bin
@@ -113,7 +270,7 @@ jobs:
 
   release:
     docker:
-      - image: circleci/golang:1.8
+      - image: circleci/golang:1.9
     steps:
       - attach_workspace:
           at: /tmp/workspace
@@ -141,21 +298,33 @@ workflows:
   version: 2
   build-test-release:
     jobs:
-      - build-test:
+      - build-test-9.4:
           filters:
             tags:
               only: /v[0-9]+(\.[0-9]+)*/
-      - centos6:
+      - build-test-9.6:
-          requires:
+          filters:
-            - build-test
+            tags:
+              only: /v[0-9]+(\.[0-9]+)*/
+      - build-test-10:
+          filters:
+            tags:
+              only: /v[0-9]+(\.[0-9]+)*/
+      - build-test-11:
+          filters:
+            tags:
+              only: /v[0-9]+(\.[0-9]+)*/
+      - build-prof-test:
           filters:
             tags:
               only: /v[0-9]+(\.[0-9]+)*/
-            branches:
-              ignore: /.*/
       - centos7:
           requires:
-            - build-test
+            - build-test-9.4
+            - build-test-9.6
+            - build-test-10
+            - build-test-11
+            - build-prof-test
           filters:
             tags:
               only: /v[0-9]+(\.[0-9]+)*/
@@ -163,7 +332,11 @@ workflows:
               ignore: /.*/
       - ubuntu:
           requires:
-            - build-test
+            - build-test-9.4
+            - build-test-9.6
+            - build-test-10
+            - build-test-11
+            - build-prof-test
           filters:
             tags:
               only: /v[0-9]+(\.[0-9]+)*/
@@ -171,7 +344,11 @@ workflows:
               ignore: /.*/
       - ubuntui386:
           requires:
-            - build-test
+            - build-test-9.4
+            - build-test-9.6
+            - build-test-10
+            - build-test-11
+            - build-prof-test
           filters:
             tags:
               only: /v[0-9]+(\.[0-9]+)*/
@@ -179,7 +356,6 @@ workflows:
               ignore: /.*/
       - release:
           requires:
-            - centos6
             - centos7
             - ubuntu
             - ubuntui386

.github/CONTRIBUTING.md

@@ -32,7 +32,7 @@ your contributions.
   then [find your logs](http://blog.endpoint.com/2014/11/dear-postgresql-where-are-my-logs.html).
 
 * If your database schema has changed while the PostgREST server is running,
-  send the server a `SIGHUP` signal or restart it to ensure the schema cache
+  [send the server a `SIGUSR1` signal](http://postgrest.org/en/v5.2/admin.html#schema-reloading) or restart it to ensure the schema cache
   is not stale. This sometimes fixes apparent bugs.
 
 ## Code
@@ -42,27 +42,15 @@ your contributions.
 * All contributions must pass the tests before being merged. When
   you create a pull request your code will automatically be tested.
 
-* All code must also pass [hlint](http://community.haskell.org/~ndm/hlint/)
+* All code must also pass [hlint](http://community.haskell.org/~ndm/hlint/) and [stylish-haskell](https://github.com/jaspervdj/stylish-haskell)
-  with no warnings. This helps enforce a uniform style for all
+  with no warnings. This helps enforce a uniform style for all committers. Continuous integration will check this as well on every
-  committers. Continuous integration will check this as well on every
+  pull request. There's a useful Makefile that helps with checking this locally. You can run `make commit-check` to do this manually but
-  pull request.
+  we recommend adding it to `.git/hooks/pre-commit` to automatically check this before doing a commit.
 
 * For help building the Haskell code on your computer check out the [building from
-source](https://postgrest.com/en/stable/install.html#build-from-source)
+  source](https://postgrest.com/en/stable/install.html#build-from-source) docs section.
-wiki page.
 
-## Maintenance
+### Running Tests
-
-### Schedule
-
-Currently I (@begriffs) am the sole maintainer, and while I am
-overjoyed to help resolve issues I also have to balance this with
-my other obligations.  If you don't get a response right away
-don't worry, I will definitely get to it. Also you can join the
-Gitter [chat room](https://gitter.im/begriffs/postgrest) to
-discuss issues you are having.
-
-## Running Tests
 
 For instructions on running tests, see the official docs hosted here:
 

.github/FUNDING.yml

@@ -0,0 +1,3 @@
+# These are supported funding model platforms
+
+patreon: postgrest

.github/ISSUE_TEMPLATE.md

@@ -0,0 +1,15 @@
+<!--
+Before reporting a bug:
+If your database schema has changed while the PostgREST server is running, send the server a SIGUSR1 signal or restart it(http://postgrest.org/en/v5.2/admin.html#schema-reloading) to ensure the schema cache is not stale. This sometimes fixes apparent bugs.
+-->
+### Environment
+
+* PostgreSQL version: (if using docker, specify the image)
+* PostgREST version: (if using docker, specify the image)
+* Operating system:
+
+### Description of issue
+
+(Expected behavior vs actual behavior)
+
+(Steps to reproduce: Include a minimal SQL definition plus how you make the request to PostgREST and the response body)

.stylish-haskell.yaml

@@ -39,9 +39,9 @@ steps:
       # - none: Do not perform any alignment.
       #
       # Default: global.
-      align: global
+      align: group
 
-      # Folowing options affect only import list alignment.
+      # The following options affect only import list alignment.
       #
       # List align has following options:
       #
@@ -64,6 +64,25 @@ steps:
       # Default: after_alias
       list_align: after_alias
 
+      # Right-pad the module names to align imports in a group:
+      #
+      # - true: a little more readable
+      #
+      #   > import qualified Data.List       as List (concat, foldl, foldr,
+      #   >                                           init, last, length)
+      #   > import qualified Data.List.Extra as List (concat, foldl, foldr,
+      #   >                                           init, last, length)
+      #
+      # - false: diff-safe
+      #
+      #   > import qualified Data.List as List (concat, foldl, foldr, init,
+      #   >                                     last, length)
+      #   > import qualified Data.List.Extra as List (concat, foldl, foldr,
+      #   >                                           init, last, length)
+      #
+      # Default: true
+      pad_module_names: true
+
       # Long list align style takes effect when import is too long. This is
       # determined by 'columns' setting.
       #
@@ -75,7 +94,7 @@ steps:
       #   short enough to fit to single line. Otherwise it'll be multiline.
       #
       # - multiline: One line per import list entry.
-      #   Type with contructor list acts like single import.
+      #   Type with constructor list acts like single import.
       #
       #   > import qualified Data.Map as M
       #   >     ( empty
@@ -109,7 +128,7 @@ steps:
       #   Useful for 'file' and 'group' align settings.
       list_padding: 4
 
-      # Separate lists option affects formating of import list for type
+      # Separate lists option affects formatting of import list for type
       # or class. The only difference is single space between type and list
       # of constructors, selectors and class functions.
       #
@@ -126,6 +145,22 @@ steps:
       # Default: true
       separate_lists: true
 
+      # Space surround option affects formatting of import lists on a single
+      # line. The only difference is single space after the initial
+      # parenthesis and a single space before the terminal parenthesis.
+      #
+      # - true: There is single space associated with the enclosing
+      #   parenthesis.
+      #
+      #   > import Data.Foo ( foo )
+      #
+      # - false: There is no space associated with the enclosing parenthesis
+      #
+      #   > import Data.Foo (foo)
+      #
+      # Default: false
+      space_surround: false
+
   # Language pragmas
   - language_pragmas:
       # We can generate different styles of language pragma lists.
@@ -142,7 +177,7 @@ steps:
 
       # Align affects alignment of closing pragma brackets.
       #
-      # - true: Brackets are aligned in same collumn.
+      # - true: Brackets are aligned in same column.
       #
       # - false: Brackets are not aligned together. There is only one space
       #   between actual import and closing bracket.

.travis.yml

@@ -1,3 +1,5 @@
+## Travis is only used for building an OSX binary ,
+## no tests are run here.
 language: generic
 
 sudo: false
@@ -40,11 +42,15 @@ install:
   fi
 
 script:
+## Building the whole project can take longer than 50 minutes. Since Travis has a global timeout of 50 minutes
+## we compile for 30 minutes tops(`gtimeout 1800`) and quit compiling with no error.
+## Since we CACHE the compile results we can continue compiling from where we left off
+## on the next commit.
 - gtimeout 1800 stack build --no-terminal --only-snapshot --install-ghc || true
 - |
   if test ! "$TRAVIS_TAG"
   then
-    echo 'No tag pushed. Skipping build.'
+    echo 'No tag pushed. Skip building binary.'
   else
     stack build --no-terminal --copy-bins --local-bin-path .
   fi
@@ -59,6 +65,6 @@ script:
     END='## \['
     BODY=$(sed -n "1,/$START/d;/$END/q;p" CHANGELOG.md)
     strip postgrest
-    tar cjf postgrest-$TRAVIS_TAG-osx.tar.xz postgrest
+    tar cJf postgrest-$TRAVIS_TAG-osx.tar.xz postgrest
     ghr -t $GITHUB_TOKEN -u $OWNER -r $REPO -b "$BODY"--replace $TRAVIS_TAG postgrest-$TRAVIS_TAG-osx.tar.xz
   fi

BACKERS.md

@@ -0,0 +1,61 @@
+# Sponsors & Backers
+
+PostgREST ongoing development is only possible thanks to our Sponsors and Backers, listed below. If you'd like to join them, you can do so by supporting the PostgREST organization on [Patreon](https://www.patreon.com/postgrest).
+
+## Sponsors
+
+<table>
+  <tbody>
+    <tr>
+      <td align="center" valign="middle">
+        <a href="https://www.cybertec-postgresql.com/en/" target="_blank">
+          <img width="222px" src="static/cybertec.png">
+        </a>
+      </td>
+      <td align="center" valign="middle">
+        <a href="https://www.2ndquadrant.com/en/?utm_campaign=External%20Websites&utm_source=PostgREST&utm_medium=Logo" target="_blank">
+          <img width="222px" src="static/2ndquadrant.png">
+        </a>
+      </td>
+      <td align="center" valign="middle">
+        <a href="https://tryretool.com/?utm_source=sponsor&utm_campaign=postgrest" target="_blank">
+          <img width="222px" src="static/retool.png">
+        </a>
+      </td>
+    </tr>
+  </tbody>
+</table>
+
+## Lead Backers
+
+- [Daniel Babiak](https://github.com/d-babiak)
+- Evans Fernandes
+
+## Backers
+
+- Tsingson Qin
+- Michel Pelletier
+- Jay Hannah
+- Robert Stolarz
+- Kofi Gumbs
+- Nicholas DiBiase
+- Christopher Reid
+- Nathan Bouscal
+- Daniel Rafaj
+- David Fenko
+
+## Former Backers
+
+<table>
+  <tbody>
+    <tr>
+      <td align="center" valign="middle">
+        <a href="https://www.timescale.com?utm_campaign=postgrest&utm_source=sponsor&utm_medium=referral&utm_content=github" target="_blank">
+          <img width="222px" src="static/timescaledb.png">
+        </a>
+      </td>
+    </tr>
+  </tbody>
+</table>
+
+- [Christiaan Westerbeek](https://devotis.nl)

CHANGELOG.md

@@ -9,6 +9,202 @@ This project adheres to [Semantic Versioning](http://semver.org/).
 
 ### Fixed
 
+## [7.0.0] - 2020-04-03
+
+### Added
+
+- #1417, `Accept: application/vnd.pgrst.object+json` behavior is now enforced for POST/PATCH/DELETE regardless of `Prefer: return=representation/minimal` - @dwagin
+- #1415, Add support for user defined socket permission via `server-unix-socket-mode` config option - @Dansvidania
+- #1383, Add support for HEAD request - @steve-chavez
+- #1378, Add support for `Prefer: count=planned` and `Prefer: count=estimated` on GET /table - @steve-chavez, @LorenzHenk
+- #1327, Add support for optional query parameter `on_conflict` to upsert with specified keys for POST - @ykst
+- #1430, Allow specifying the foreign key constraint name(`/source?select=fk_constraint(*)`) to disambiguate an embedding - @steve-chavez
+- #1168, Allow access to the `Authorization` header through the `request.header.authorization` GUC - @steve-chavez
+- #1435, Add `request.method` and `request.path` GUCs - @steve-chavez
+- #1088, Allow adding headers to GET/POST/PATCH/PUT/DELETE responses through the `response.headers` GUC - @steve-chavez
+- #1427, Allow overriding provided headers(Location, Content-Type, etc) through the `response.headers` GUC - @steve-chavez
+- #1450, Allow multiple schemas to be exposed in one instance. The schema to use can be selected through the headers `Accept-Profile` for GET/HEAD and `Content-Profile` for POST/PATCH/PUT/DELETE - @steve-chavez, @mahmoudkassem
+
+### Fixed
+
+- #1301, Fix self join resource embedding on PATCH - @herulume, @steve-chavez
+- #1389, Fix many to many resource embedding on RPC/PATCH - @steve-chavez
+- #1355, Allow PATCH/DELETE without `return=minimal` on tables with no select privileges - @steve-chavez
+- #1361, Fix embedding a VIEW when its source foreign key is UNIQUE - @bwbroersma
+
+### Changed
+
+- #1385, bulk RPC call now should be done by specifying a `Prefer: params=multiple-objects` header - @steve-chavez
+- #1401, resource embedding now outputs an error when multiple relationships between two tables are found - @steve-chavez
+- #1423, default Unix Socket file mode from 755 to 660 - @dwagin
+- #1430, Remove embedding with duck typed column names `GET /projects?select=client(*)`- @steve-chavez
+  + You can rename the foreign key to `client` to make this request work in the new version: `alter table projects rename constraint projects_client_id_fkey to client`
+- #1413, Change `server-proxy-uri` config option to `openapi-server-proxy-uri` - @steve-chavez
+
+## [6.0.2] - 2019-08-22
+
+### Fixed
+
+- #1369, Change `raw-media-types` to accept a string of comma separated MIME types - @Dansvidania
+- #1368, Fix long column descriptions being truncated at 63 characters in PostgreSQL 12 - @amedeedaboville
+- #1348, Go back to converting plus "+" to space " " in querystrings by default - @steve-chavez
+
+### Deprecated
+
+- #1348, Deprecate `.` symbol for disambiguating resource embedding(added in #918). The url-safe '!' should be used instead. We refrained from using `+` as part of our syntax because it conflicts with some http clients and proxies.
+
+## [6.0.1] - 2019-07-30
+
+### Added
+
+- #1349, Add user defined raw output media types via `raw-media-types` config option - @Dansvidania
+- #1243, Add websearch_to_tsquery support - @herulume
+
+### Fixed
+
+- #1336, Error when testing on Chrome/Firefox: text/html requested but a single column was not selected - @Dansvidania
+- #1334, Unable to compile v6.0.0 on windows - @steve-chavez
+
+## [6.0.0] - 2019-06-21
+
+### Added
+
+- #1186, Add support for user defined unix socket via `server-unix-socket` config option - @Dansvidania
+- #690, Add `?columns` query parameter for faster bulk inserts, also ignores unspecified json keys in a payload - @steve-chavez
+- #1239, Add support for resource embedding on materialized views - @vitorbaptista
+- #1264, Add support for bulk RPC call - @steve-chavez
+- #1278, Add db-pool-timeout config option - @qu4tro
+- #1285, Abort on wrong database password - @qu4tro
+- #790, Allow override of OpenAPI spec through `root-spec` config option - @steve-chavez
+- #1308, Accept `text/plain` and `text/html` for raw output - @steve-chavez
+
+
+### Fixed
+
+- #1223, Fix incorrect OpenAPI externalDocs url - @steve-chavez
+- #1221, Fix embedding other resources when having a self join - @steve-chavez
+- #1242, Fix embedding a view having a select in a where - @steve-chavez
+- #1238, Fix PostgreSQL to OpenAPI type mappings for numeric and character types - @fpusch
+- #1265, Fix query generated on bulk upsert with an empty array - @qu4tro
+- #1273, Fix RPC ignoring unknown arguments by default - @steve-chavez
+- #1257, Fix incorrect status when a PATCH request doesn't find rows to change - @qu4tro
+
+### Changed
+
+- #1288, Change server-host default of 127.0.0.1 to !4
+
+### Deprecated
+
+- #1288, Deprecate `.` symbol for disambiguating resource embedding(added in #918). '+' should be used instead. Though '+' is url safe, certain clients might need to encode it to '%2B'.
+
+### Removed
+
+- #1288, Removed support for schema reloading with SIGHUP, SIGUSR1 should be used instead - @steve-chavez
+
+## [5.2.0] - 2018-12-12
+
+### Added
+
+- #1205, Add support for parsing JSON Web Key Sets - @russelldavies
+- #1203, Add support for reading db-uri from a separate file - @zhoufeng1989
+- #1200, Add db-extra-search-path config for adding schemas to the search_path, solves issues related to extensions created on the public schema - @steve-chavez
+- #1219, Add ability to quote column names on filters - @steve-chavez
+
+### Fixed
+
+- #1182, Fix embedding on views with composite pks - @steve-chavez
+- #1180, Fix embedding on views with subselects in pg10 - @steve-chavez
+- #1197, Allow CORS for PUT - @bkylerussell
+- #1181, Correctly qualify function argument of custom type in public schema - @steve-chavez
+- #1008, Allow columns that contain spaces in filters - @steve-chavez
+
+## [5.1.0] - 2018-08-31
+
+### Added
+
+- #1099, Add support for getting json/jsonb by array index - @steve-chavez
+- #1145, Add materialized view columns to OpenAPI output - @steve-chavez
+- #709, Allow embedding on views with subselects/CTE - @steve-chavez
+- #1148, OpenAPI: add `required` section for the non-nullable columns - @laughedelic
+- #1158, Add summary to OpenAPI doc for RPC functions - @mdr1384
+
+### Fixed
+
+- #1113, Fix UPSERT failing when having a camel case PK column - @steve-chavez
+- #945, Fix slow start-up time on big schemas - @steve-chavez
+- #1129, Fix view embedding when table is capitalized - @steve-chavez
+- #1149, OpenAPI: Change `GET` response type to array - @laughedelic
+- #1152, Fix RPC failing when having arguments with reserved or uppercase keywords - @mdr1384
+- #905, Fix intermittent empty replies - @steve-chavez
+- #1139, Fix JWTIssuedAtFuture failure for valid iat claim - @steve-chavez
+- #1141, Fix app.settings resetting on pool timeout - @steve-chavez
+
+### Changed
+
+- #1099, Numbers in json path `?select=data->1->>key` now get treated as json array indexes instead of keys - @steve-chavez
+- #1128, Allow finishing a json path with a single arrow `->`. Now a json can be obtained without resorting to casting, Previously: `/json_arr?select=data->>2::json`, now: `/json_arr?select=data->2` - @steve-chavez
+- #724, Change server-host default of *4 to 127.0.0.1
+
+### Deprecated
+
+- #724, SIGHUP deprecated, SIGUSR1 should be used instead
+
+## [0.5.0.0] - 2018-05-14
+
+### Added
+
+- The configuration (e.g. `postgrest.conf`) now accepts arbitrary settings that will be passed through as session-local database settings. This can be used to pass in secret keys directly as strings, or via OS environment variables. For instance: `app.settings.jwt_secret = "$(MYAPP_JWT_SECRET)"` will take `MYAPP_JWT_SECRET` from the environment and make it available to postgresql functions as `current_setting('app.settings.jwt_secret')`. Only `app.settings.*` values in the configuration file are treated in this way. - @canadaduane
+- #256, Add support for bulk UPSERT with POST and single UPSERT with PUT - @steve-chavez
+- #1078, Add ability to specify source column in embed - @steve-chavez
+- #821, Allow embeds alias to be used in filters - @steve-chavez
+- #906, Add jspath configurable `role-claim-key` - @steve-chavez
+- #1061, Add foreign tables to OpenAPI output - @rhyamada
+
+### Fixed
+
+- #828, Fix computed column only working in public schema - @steve-chavez
+- #925, Fix RPC high memory usage by using parametrized query and avoiding json encoding - @steve-chavez
+- #987, Fix embedding with self-reference foreign key - @steve-chavez
+- #1044, Fix view parent embedding when having many views - @steve-chavez
+- #781, Fix accepting misspelled desc/asc ordering modificators - @onporat, @steve-chavez
+
+### Changed
+
+- #828, A `SET SCHEMA <db-schema>` is done on each request, this has the following implications:
+  - Computed columns now only work if they belong to the db-schema
+  - Stored procedures might require a `search_path` to work properly, for further details see https://postgrest.org/en/v5.0/api.html#explicit-qualification
+- To use RPC now the `json_to_record/json_to_recordset` functions are needed, these are available starting from PostgreSQL 9.4 - @steve-chavez
+- Overloaded functions now depend on the `dbStructure`, restart/sighup may be needed for their correct functioning - @steve-chavez
+- #1098, Removed support for:
+  + curly braces `{}` in embeds, i.e. `/clients?select=*,projects{*}` can no longer be used, from now on parens `()` should be used `/clients?select=*,projects(*)` - @steve-chavez
+  + "in" operator without parens, i.e. `/clients?id=in.1,2,3` no longer supported, `/clients?id=in.(1,2,3)` should be used - @steve-chavez
+  + "@@", "@>" and "<@" operators, from now on their mnemonic equivalents should be used "fts", "cs" and "cd" respectively - @steve-chavez
+
+## [0.4.4.0] - 2018-01-08
+
+### Added
+
+- #887, #601, #1007, Allow specifying dictionary and plain/phrase tsquery in full text search - @steve-chavez
+- #328, Allow doing GET on rpc - @steve-chavez
+- #917, Add ability to map RAISE errorcode/message to http status - @steve-chavez
+- #940, Add ability to map GUC to http response headers - @steve-chavez
+- #1022, Include git sha in version report - @begriffs
+- Faster queries using json_agg - @ruslantalpa
+
+### Fixed
+
+- #876, Read secret files as binary, discard final LF if any - @eric-brechemier
+- #968, Treat blank proxy uri as missing - @begriffs
+- #933, OpenAPI externals docs url to current version - @steve-chavez
+- #962, OpenAPI don't err on nonexistent schema - @steve-chavez
+- #954, make OpenAPI rpc output dependent on user privileges - @steve-chavez
+- #955, Support configurable aud claim - @statik
+- #996, Fix embedded column conflicts table name - @grotsev
+- #974, Fix RPC error when function has single OUT param - @steve-chavez
+- #1021, Reduce join size in allColumns for faster program start - @nextstopsun
+- #411, Remove the need for pk in &select for parent embed - @steve-chavez
+- #1016, Fix anonymous requests when configured with jwt-aud - @ruslantalpa
+
 ## [0.4.3.0] - 2017-09-06
 
 ### Added

LICENSE

@@ -1,4 +1,5 @@
 Copyright (c) 2014 Joe Nelson
+Copyright (c) 2019 Steve Chavez
 
 Permission is hereby granted, free of charge, to any person obtaining
 a copy of this software and associated documentation files (the

Makefile

@@ -0,0 +1,39 @@
+.PHONY: commit-check check clean lint style test test-watch coverage circleci circleci-prof-test check-dburi prompt-clean prompt-long-process
+
+commit-check: lint style
+
+check: lint style test
+
+clean: prompt-clean
+	stack clean --full
+
+lint:
+	git ls-files | grep '\.l\?hs$$' | xargs stack exec -- hlint -X QuasiQuotes -X NoPatternSynonyms "$$@"
+
+style:
+	git ls-files | grep '\.l\?hs$$' | xargs stack exec -- stylish-haskell -i && git diff-index --exit-code HEAD -- '*.hs' '*.lhs'
+
+test: check-dburi
+	stack test
+
+test-watch: check-dburi
+	stack build --file-watch --test --test-arguments '--rerun --failure-report=.TESTREPORT --rerun-all-on-success'
+
+coverage: check-dburi clean
+	stack build --coverage
+	stack test --coverage
+
+circleci: prompt-long-process
+	circleci local execute --job build-test-9.4
+
+circleci-prof-test: prompt-long-process
+	circleci local execute --job build-prof-test
+
+check-dburi:
+	test -n "$(POSTGREST_TEST_CONNECTION)" # Requires POSTGREST_TEST_CONNECTION environmental variable
+
+prompt-clean:
+	@echo -n 'Are you sure? You will have to rebuild. [y/N] ' && read ans && [ $${ans:-N} = y ]
+
+prompt-long-process:
+	@echo -n 'Are you sure? This might take a while. [y/N] ' && read ans && [ $${ans:-N} = y ]

README.md

@@ -1,32 +1,64 @@
-![Logo](static/logo.png "Logo")
+![Logo](static/bigger-logo.png "Logo")
 
-[![Build Status](https://circleci.com/gh/begriffs/postgrest.png?style=shield&circle-token=f723c01686abf0364de1e2eaae5aff1f68bd3ff2)](https://circleci.com/gh/begriffs/postgrest/tree/master)
+[![Donate](https://img.shields.io/badge/Donate-Patreon-orange.svg?colorB=F96854)](https://www.patreon.com/postgrest)
-<a href="https://heroku.com/deploy?template=https://github.com/begriffs/postgrest">
+[![Donate](https://img.shields.io/badge/Donate-PayPal-green.svg)](https://www.paypal.me/postgrest)
+<a href="https://heroku.com/deploy?template=https://github.com/PostgREST/postgrest">
   <img src="https://img.shields.io/badge/%E2%86%91_Deploy_to-Heroku-7056bf.svg" alt="Deploy">
 </a>
 [![Join the chat at https://gitter.im/begriffs/postgrest](https://img.shields.io/badge/gitter-join%20chat%20%E2%86%92-brightgreen.svg)](https://gitter.im/begriffs/postgrest)
-[![Docs](https://img.shields.io/badge/docs-latest-brightgreen.svg?style=flat)](http://postgrest.com)
+[![Docs](https://img.shields.io/badge/docs-latest-brightgreen.svg?style=flat)](http://postgrest.org)
+[![Docker Stars](https://img.shields.io/docker/pulls/postgrest/postgrest.svg)](https://hub.docker.com/r/postgrest/postgrest/)
+[![Build Status](https://circleci.com/gh/PostgREST/postgrest/tree/master.svg?style=shield)](https://circleci.com/gh/PostgREST/postgrest/tree/master)
+[![Hackage docs](https://img.shields.io/hackage/v/postgrest.svg?label=hackage)](http://hackage.haskell.org/package/postgrest)
 
 PostgREST serves a fully RESTful API from any existing PostgreSQL
 database. It provides a cleaner, more standards-compliant, faster
 API than you are likely to write from scratch.
 
-### Usage
+## Sponsors
 
-1. Download the binary ([latest release](https://github.com/begriffs/postgrest/releases/latest))
+<table>
+  <tbody>
+    <tr>
+      <td align="center" valign="middle">
+        <a href="https://www.cybertec-postgresql.com/en/" target="_blank">
+          <img width="222px" src="static/cybertec.png">
+        </a>
+      </td>
+      <td align="center" valign="middle">
+        <a href="https://www.2ndquadrant.com/en/?utm_campaign=External%20Websites&utm_source=PostgREST&utm_medium=Logo" target="_blank">
+          <img width="222px" src="static/2ndquadrant.png">
+        </a>
+      </td>
+      <td align="center" valign="middle">
+        <a href="https://tryretool.com/?utm_source=sponsor&utm_campaign=postgrest" target="_blank">
+          <img width="222px" src="static/retool.png">
+        </a>
+      </td>
+    </tr>
+  </tbody>
+</table>
+
+Big thanks to our sponsors! You can join them by supporting PostgREST on [Patreon](https://www.patreon.com/postgrest).
+
+## Usage
+
+1. Download the binary ([latest release](https://github.com/PostgREST/postgrest/releases/latest))
    for your platform.
 2. Invoke for help:
 
     ```bash
     postgrest --help
     ```
+## [Documentation](http://postgrest.org)
 
-### Performance
+Latest documentation is at [postgrest.org](http://postgrest.org). You can contribute to the docs in [PostgREST/postgrest-docs](https://github.com/PostgREST/postgrest-docs).
+
+## Performance
 
 TLDR; subsecond response times for up to 2000 requests/sec on Heroku
-free tier. If you're used to servers written in interpreted languages
+free tier. If you're used to servers written in interpreted languages, 
-(or named after precious gems), prepare to be pleasantly surprised by
+prepare to be pleasantly surprised by PostgREST performance.
-PostgREST performance.
 
 Three factors contribute to the speed. First the server is written
 in [Haskell](https://www.haskell.org/) using the
@@ -49,13 +81,10 @@ by
 * Using the PostgreSQL binary protocol
 * Being stateless to allow horizontal scaling
 
-Other optimizations are possible, and some are outlined in the
+## Security
-[Future Features](#future-features).
-
-### Security
 
 PostgREST [handles
-authentication](http://postgrest.com/en/stable/auth.html) (via JSON Web
+authentication](http://postgrest.org/en/stable/auth.html) (via JSON Web
 Tokens) and delegates authorization to the role information defined in
 the database. This ensures there is a single declarative source of truth
 for security.  When dealing with the database the server assumes the
@@ -73,7 +102,7 @@ are limited to certain templates using
 functions, the trigger workaround does not compromise row-level
 security.
 
-### Versioning
+## Versioning
 
 A robust long-lived API needs the freedom to exist in multiple
 versions. PostgREST does versioning through database schemas. This
@@ -81,7 +110,7 @@ allows you to expose tables and views without making the app brittle.
 Underlying tables can be superseded and hidden behind public facing
 views.
 
-### Self-documentation
+## Self-documentation
 
 PostgREST uses the [OpenAPI](https://openapis.org/) standard to
 generate up-to-date documentation for APIs. You can use a tool like
@@ -93,7 +122,7 @@ instance the number of rows returned by an endpoint is reported by -
 and limited with - range headers. More about
 [that](http://begriffs.com/posts/2014-03-06-beyond-http-header-links.html).
 
-### Data Integrity
+## Data Integrity
 
 Rather than relying on an Object Relational Mapper and custom
 imperative coding, this system requires you put declarative constraints
@@ -105,14 +134,24 @@ surprises, such as enforcing idempotent PUT requests.
 
 See examples of [PostgreSQL
 constraints](http://www.tutorialspoint.com/postgresql/postgresql_constraints.htm)
-and the [API guide](http://postgrest.com/en/stable/api.html).
+and the [API guide](http://postgrest.org/en/stable/api.html).
 
-### Thanks
+## Supporting development
 
-I'm grateful to the generous project
+You can help PostgREST ongoing maintenance and development by:
-[contributors](https://github.com/begriffs/postgrest/graphs/contributors)
+
-who have improved PostgREST immensely with their code and good
+- Making a regular donation through Patreon https://www.patreon.com/postgrest
-judgement.  See more details in the
+
-[changelog](https://github.com/begriffs/postgrest/blob/master/CHANGELOG.md).
+- Alternatively, you can make a one-time donation via Paypal https://www.paypal.me/postgrest
+
+Every donation will be spent on making PostgREST better for the whole community.
+
+## Thanks
+
+The PostgREST organization is grateful to:
+
+- The project [sponsors and backers](https://github.com/PostgREST/postgrest/blob/master/BACKERS.md) who support PostgREST's development.
+- The project [contributors](https://github.com/PostgREST/postgrest/graphs/contributors) who have improved PostgREST immensely with their code
+  and good judgement. See more details in the [changelog](https://github.com/PostgREST/postgrest/blob/master/CHANGELOG.md).
 
 The cool logo came from [Mikey Casalaina](https://github.com/casalaina).

app.json

@@ -1,19 +1,19 @@
 {
   "name": "PostgREST",
   "description": "RESTful API for any PostgreSQL database.",
-  "logo": "https://halcyon.sh/logo.svg",
+  "logo": "https://avatars2.githubusercontent.com/u/15115011",
-  "repository": "https://github.com/begriffs/postgrest",
+  "repository": "https://github.com/PostgREST/postgrest",
   "env": {
     "BUILDPACK_URL": {
       "description": "Heroku buildpack for deploying Haskell applications",
-      "value": "https://github.com/begriffs/postgrest-heroku"
+      "value": "https://github.com/PostgREST/postgrest-heroku"
     },
     "POSTGREST_VER": {
       "description": "Version of PostgREST to deploy",
-      "value": "0.4.3.0"
+      "value": "7.0.0"
     },
     "DB_URI": {
-      "description": "Database connection string",
+      "description": "Database connection string, e.g. postgres://user:pass@xxxxxxx.rds.amazonaws.com/mydb",
       "required": true
     },
     "DB_SCHEMA": {
@@ -43,6 +43,10 @@
       "required": false,
       "value": "false"
     },
+    "JWT_AUD": {
+      "description": "The audience that should be validated if the JWT token contains an aud claim",
+      "required": false
+    },
     "MAX_ROWS": {
       "description": "A hard limit to the number of rows PostgREST will fetch from a view, table, or stored procedure",
       "required": false

appveyor.yml

@@ -1,24 +1,19 @@
+## AppVeyor is only used for building a Windows binary, no tests are run here.
 platform: x64
 
 cache:
 - "c:\\sr"
 - .stack-work
+- "c:\\Users\\appveyor\\AppData\\Local\\Programs\\stack"
 
 environment:
   global:
     STACK_ROOT: "c:\\sr"
     GOPATH: c:\gopath
+    TMP: "c:\\tmp"
 
 test: off
 
-skip_non_tags: true
-
-skip_branch_with_pr: true
-
-branches:
-  only:
-    - master
-
 install:
 - set PATH=C:\Program Files\PostgreSQL\9.6\bin\;%PATH%
 - curl -sS -ostack.zip -L --insecure http://www.stackage.org/stack/windows-x86_64
@@ -28,11 +23,13 @@ install:
 
 build_script:
 - stack setup --no-terminal > nul
-- stack build --copy-bins --local-bin-path .
+# Appveyor has a timeout of 60 mins, building can take longer, limit the time and make sure this succeeds,
+# previous work will get cached and finish on next commit
+- bash -lc "timeout 2700 'C:\projects\postgrest\stack.exe' build -j1 --copy-bins --local-bin-path . || true"
 
 artifacts:
 - path: postgrest.exe
 
 deploy_script:
-- 7z a -tzip postgrest-%APPVEYOR_REPO_TAG_NAME%-windows-x64.zip postgrest.exe
+- IF DEFINED APPVEYOR_REPO_TAG_NAME 7z a -tzip postgrest-%APPVEYOR_REPO_TAG_NAME%-windows-x64.zip postgrest.exe
-- bash -lc "exec 0</dev/null && cd $APPVEYOR_BUILD_FOLDER && ghr -t $GITHUB_TOKEN -u $APPVEYOR_ACCOUNT_NAME -r $APPVEYOR_PROJECT_NAME -b \"$(sed -n \"1,/$(echo $APPVEYOR_REPO_TAG_NAME | cut -c2-)/d;/## \[/q;p\" CHANGELOG.md)\" --replace $APPVEYOR_REPO_TAG_NAME postgrest-$APPVEYOR_REPO_TAG_NAME-windows-x64.zip"
+- IF DEFINED APPVEYOR_REPO_TAG_NAME bash -lc " exec 0</dev/null && cd $APPVEYOR_BUILD_FOLDER && ghr -t $GITHUB_TOKEN -u $APPVEYOR_ACCOUNT_NAME -r $APPVEYOR_PROJECT_NAME -b \"$(sed -n \"1,/$(echo $APPVEYOR_REPO_TAG_NAME | cut -c2-)/d;/## \[/q;p\" CHANGELOG.md)\" --replace $APPVEYOR_REPO_TAG_NAME postgrest-$APPVEYOR_REPO_TAG_NAME-windows-x64.zip"

docker/Dockerfile

@@ -1,4 +1,7 @@
-FROM debian:jessie
+# To build use:
+# docker build --build-arg POSTGREST_VERSION=<v5.2.0 or another version> -t postgrest ./docker/
+
+FROM debian:buster-slim
 
 ARG POSTGREST_VERSION
 
@@ -13,7 +16,7 @@ RUN BUILD_DEPS="curl ca-certificates xz-utils" && \
     apt-get -qq update && \
     apt-get -qq install -y --no-install-recommends $BUILD_DEPS && \
     cd /tmp && \
-    curl -SLO https://github.com/begriffs/postgrest/releases/download/${POSTGREST_VERSION}/postgrest-${POSTGREST_VERSION}-ubuntu.tar.xz && \
+    curl -SLO https://github.com/PostgREST/postgrest/releases/download/${POSTGREST_VERSION}/postgrest-${POSTGREST_VERSION}-ubuntu.tar.xz && \
     tar -xJvf postgrest-${POSTGREST_VERSION}-ubuntu.tar.xz && \
     mv postgrest /usr/local/bin/postgrest && \
     cd / && \
@@ -28,13 +31,24 @@ ENV PGRST_DB_URI= \
     PGRST_DB_SCHEMA=public \
     PGRST_DB_ANON_ROLE= \
     PGRST_DB_POOL=100 \
+    PGRST_DB_EXTRA_SEARCH_PATH=public \
     PGRST_SERVER_HOST=*4 \
     PGRST_SERVER_PORT=3000 \
-    PGRST_SERVER_PROXY_URL= \
+    PGRST_OPENAPI_SERVER_PROXY_URI= \
     PGRST_JWT_SECRET= \
     PGRST_SECRET_IS_BASE64=false \
+    PGRST_JWT_AUD= \
     PGRST_MAX_ROWS= \
-    PGRST_PRE_REQUEST=
+    PGRST_PRE_REQUEST= \
+    PGRST_ROLE_CLAIM_KEY=".role" \
+    PGRST_ROOT_SPEC= \
+    PGRST_RAW_MEDIA_TYPES=
+
+RUN groupadd -g 1000 postgrest && \
+    useradd -r -u 1000 -g postgrest postgrest && \
+    chown postgrest:postgrest /etc/postgrest.conf
+
+USER 1000
 
 # PostgREST reads /etc/postgrest.conf so map the configuration
 # file in when you run this container

docker/config.conf

@@ -1,3 +0,0 @@
-db-uri = "postgres://app_user:password@postgres:5432/app_db"
-db-schema = "public"
-db-anon-role = "app_user"

docker/distro_release/Dockerfile.centos6

@@ -1,18 +0,0 @@
-FROM centos:centos6
-
-RUN yum -y update
-RUN yum -y install perl make automake gcc gmp-devel libffi zlib zlib-devel xz tar
-RUN yum -y install https://download.postgresql.org/pub/repos/yum/9.3/redhat/rhel-6-x86_64/pgdg-centos93-9.3-2.noarch.rpm
-RUN yum -y install postgresql93-devel
-RUN yum clean all
-RUN curl -sSL https://get.haskellstack.org/ | sh
-
-ENV PATH $PATH:/usr/pgsql-9.3/bin
-
-# To disable warning when building
-ENV PATH $PATH:/root/.local/bin
-
-RUN mkdir /source
-WORKDIR /source
-
-ENTRYPOINT ["stack"]

docker/distro_release/Dockerfile.centos7

@@ -2,12 +2,12 @@ FROM centos:centos7
 
 RUN yum -y update
 RUN yum -y install perl make automake gcc gmp-devel libffi zlib zlib-devel xz tar
-RUN yum -y install yum install https://download.postgresql.org/pub/repos/yum/9.3/redhat/rhel-7-x86_64/pgdg-centos93-9.3-2.noarch.rpm
+RUN yum -y install yum install https://download.postgresql.org/pub/repos/yum/10/redhat/rhel-7-x86_64/pgdg-centos10-10-2.noarch.rpm
-RUN yum -y install postgresql93-devel
+RUN yum -y install postgresql10-devel
 RUN yum clean all
 RUN curl -sSL https://get.haskellstack.org/ | sh
 
-ENV PATH $PATH:/usr/pgsql-9.3/bin
+ENV PATH $PATH:/usr/pgsql-10/bin
 
 # To disable warning when building
 ENV PATH $PATH:/root/.local/bin

docker/distro_release/Dockerfile.ubuntu

@@ -1,5 +1,7 @@
 FROM ubuntu:16.04
 
+## TODO pin the stack version
+#
 RUN BUILD_DEPS="curl ca-certificates build-essential" && \
     apt-get -qq update && \
     apt-get -qqy --no-install-recommends install \

docker/distro_release/Dockerfile.ubuntui386

@@ -1,4 +1,6 @@
-FROM 32bit/ubuntu:16.04
+FROM i386/ubuntu:16.04
+
+## TODO pin the stack version
 
 RUN BUILD_DEPS="curl ca-certificates build-essential" && \
     apt-get -qq update && \

docker/postgrest.conf

@@ -2,13 +2,18 @@ db-uri = "$(PGRST_DB_URI)"
 db-schema = "$(PGRST_DB_SCHEMA)"
 db-anon-role = "$(PGRST_DB_ANON_ROLE)"
 db-pool = "$(PGRST_DB_POOL)"
+db-extra-search-path = "$(PGRST_DB_EXTRA_SEARCH_PATH)"
 
 server-host = "$(PGRST_SERVER_HOST)"
 server-port = "$(PGRST_SERVER_PORT)"
 
-server-proxy-uri = "$(PGRST_SERVER_PROXY_URI)"
+openapi-server-proxy-uri = "$(PGRST_OPENAPI_SERVER_PROXY_URI)"
 jwt-secret = "$(PGRST_JWT_SECRET)"
 secret-is-base64 = "$(PGRST_SECRET_IS_BASE64)"
+jwt-aud = "$(PGRST_JWT_AUD)"
+role-claim-key = "$(PGRST_ROLE_CLAIM_KEY)"
 
 max-rows = "$(PGRST_MAX_ROWS)"
 pre-request = "$(PGRST_PRE_REQUEST)"
+root-spec = "$(PGRST_ROOT_SPEC)"
+raw-media-types = "$(PGRST_RAW_MEDIA_TYPES)"

main/Main.hs

@@ -2,54 +2,46 @@
 
 module Main where
 
-import           PostgREST.App            (postgrest)
+import qualified Data.ByteString            as BS
-import           PostgREST.Config         (AppConfig (..),
+import qualified Data.ByteString.Base64     as B64
-                                           PgVersion (..),
+import qualified Hasql.Pool                 as P
-                                           minimumPgVersion,
+import qualified Hasql.Transaction.Sessions as HT
-                                           prettyVersion, readOptions)
+
-import           PostgREST.DbStructure    (getDbStructure)
+import Control.AutoUpdate       (defaultUpdateSettings, mkAutoUpdate,
-import           PostgREST.Error          (encodeError)
+                                 updateAction)
-import           PostgREST.OpenAPI        (isMalformedProxyUri)
+import Control.Retry            (RetryStatus, capDelay,
-import           PostgREST.Types          (DbStructure, Schema)
+                                 exponentialBackoff, retrying,
-import           Protolude hiding         (replace, hPutStrLn)
+                                 rsPreviousDelay)
+import Data.Either.Combinators  (whenLeft)
+import Data.IORef               (IORef, atomicWriteIORef, newIORef,
+                                 readIORef)
+import Data.String              (IsString (..))
+import Data.Text                (pack, replace, strip, stripPrefix)
+import Data.Text.Encoding       (decodeUtf8, encodeUtf8)
+import Data.Text.IO             (hPutStrLn, readFile)
+import Data.Time.Clock          (getCurrentTime)
+import Network.Wai.Handler.Warp (defaultSettings, runSettings,
+                                 setHost, setPort, setServerName)
+import System.IO                (BufferMode (..), hSetBuffering)
+
+import PostgREST.App         (postgrest)
+import PostgREST.Config      (AppConfig (..), configPoolTimeout',
+                              prettyVersion, readOptions)
+import PostgREST.DbStructure (getDbStructure, getPgVersion)
+import PostgREST.Error       (PgError (PgError), checkIsFatal,
+                              errorPayload)
+import PostgREST.OpenAPI     (isMalformedProxyUri)
+import PostgREST.Types       (ConnectionStatus (..), DbStructure,
+                              PgVersion (..), Schema,
+                              minimumPgVersion)
+import Protolude             hiding (hPutStrLn, head, replace)
+
 
-import           Control.Retry            (RetryStatus, capDelay,
-                                           exponentialBackoff,
-                                           retrying, rsPreviousDelay)
-import           Data.ByteString.Base64   (decode)
-import           Data.IORef               (IORef, atomicWriteIORef,
-                                           newIORef, readIORef)
-import           Data.String              (IsString (..))
-import           Data.Text                (pack, replace, stripPrefix, strip)
-import           Data.Text.Encoding       (decodeUtf8, encodeUtf8)
-import           Data.Text.IO             (hPutStrLn, readFile)
-import qualified Hasql.Decoders           as HD
-import qualified Hasql.Encoders           as HE
-import qualified Hasql.Pool               as P
-import qualified Hasql.Query              as H
-import qualified Hasql.Session            as H
-import           Network.Wai.Handler.Warp (defaultSettings,
-                                           runSettings, setHost,
-                                           setPort, setServerName,
-                                           setTimeout)
-import           System.IO                (BufferMode (..),
-                                           hSetBuffering)
 #ifndef mingw32_HOST_OS
-import           System.Posix.Signals
+import System.Posix.Signals
+import UnixSocket
 #endif
 
-{-|
-	Used by connectionWorker to know if it should throw an error and kill the
-  main thread.
--}
-isServerVersionSupported :: H.Session Bool
-isServerVersionSupported = do
-  ver <- H.query () pgVersion
-  return $ ver >= pgvNum minimumPgVersion
- where
-  pgVersion =
-    H.statement "SELECT current_setting('server_version_num')::integer"
-      HE.unit (HD.singleRow $ HD.value HD.int4) False
 
 {-|
   The purpose of this worker is to fill the refDbStructure created in 'main'
@@ -70,13 +62,13 @@ isServerVersionSupported = do
      goes back to 1, otherwise it finishes his work successfully.
 -}
 connectionWorker
-  :: ThreadId -- ^ This thread is killed if 'isServerVersionSupported' returns false
+  :: ThreadId -- ^ This thread is killed if pg version is unsupported
   -> P.Pool   -- ^ The PostgreSQL connection pool
-  -> Schema   -- ^ Schema PostgREST is serving up
+  -> [Schema] -- ^ Schemas PostgREST is serving up
   -> IORef (Maybe DbStructure) -- ^ mutable reference to 'DbStructure'
   -> IORef Bool                -- ^ Used as a binary Semaphore
   -> IO ()
-connectionWorker mainTid pool schema refDbStructure refIsWorkerOn = do
+connectionWorker mainTid pool schemas refDbStructure refIsWorkerOn = do
   isWorkerOn <- readIORef refIsWorkerOn
   unless isWorkerOn $ do
     atomicWriteIORef refIsWorkerOn True
@@ -85,26 +77,24 @@ connectionWorker mainTid pool schema refDbStructure refIsWorkerOn = do
     work = do
       atomicWriteIORef refDbStructure Nothing
       putStrLn ("Attempting to connect to the database..." :: Text)
-      connected <- connectingSucceeded pool
+      connected <- connectionStatus pool
-      when connected $ do
+      case connected of
-        result <- P.use pool $ do
+        FatalConnectionError reason -> hPutStrLn stderr reason
-          supported <- isServerVersionSupported
+                                      >> killThread mainTid    -- Fatal error when connecting
-          unless supported $ liftIO $ do
+        NotConnected                -> return ()               -- Unreachable
-            hPutStrLn stderr
+        Connected actualPgVersion   -> do                      -- Procede with initialization
-              ("Cannot run in this PostgreSQL version, PostgREST needs at least "
+          result <- P.use pool $ do
-              <> pgvName minimumPgVersion)
+            dbStructure <- HT.transaction HT.ReadCommitted HT.Read $ getDbStructure schemas actualPgVersion
-            killThread mainTid
+            liftIO $ atomicWriteIORef refDbStructure $ Just dbStructure
-          dbStructure <- getDbStructure schema
+          case result of
-          liftIO $ atomicWriteIORef refDbStructure $ Just dbStructure
+            Left e -> do
-        case result of
+              putStrLn ("Failed to query the database. Retrying." :: Text)
-          Left e -> do
+              hPutStrLn stderr . toS . errorPayload $ PgError False e
-            putStrLn ("Failed to query the database. Retrying." :: Text)
+              work
-            hPutStrLn stderr (toS $ encodeError e)
-            work
-          Right _ -> do
-            atomicWriteIORef refIsWorkerOn False
-            putStrLn ("Connection successful" :: Text)
 
+            Right _ -> do
+              atomicWriteIORef refIsWorkerOn False
+              putStrLn ("Connection successful" :: Text)
 
 {-|
   Used by 'connectionWorker' to check if the provided db-uri lets
@@ -115,26 +105,37 @@ connectionWorker mainTid pool schema refDbStructure refIsWorkerOn = do
   The connection tries are capped, but if the connection times out no error is
   thrown, just 'False' is returned.
 -}
-connectingSucceeded :: P.Pool -> IO Bool
+connectionStatus :: P.Pool -> IO ConnectionStatus
-connectingSucceeded pool =
+connectionStatus pool =
   retrying (capDelay 32000000 $ exponentialBackoff 1000000)
            shouldRetry
-           (const $ P.release pool >> isConnectionSuccessful)
+           (const $ P.release pool >> getConnectionStatus)
   where
-    isConnectionSuccessful :: IO Bool
+    getConnectionStatus :: IO ConnectionStatus
-    isConnectionSuccessful = do
+    getConnectionStatus = do
-      testConn <- P.use pool $ H.sql "SELECT 1"
+      pgVersion <- P.use pool getPgVersion
-      case testConn of
+      case pgVersion of
-        Left e -> hPutStrLn stderr (toS $ encodeError e) >> pure False
+        Left e -> do
-        _ -> pure True
+          let err = PgError False e
-    shouldRetry :: RetryStatus -> Bool -> IO Bool
+          hPutStrLn stderr . toS $ errorPayload err
+          case checkIsFatal err of
+            Just reason -> return $ FatalConnectionError reason
+            Nothing     -> return NotConnected
+
+        Right version ->
+          if version < minimumPgVersion
+             then return . FatalConnectionError $ "Cannot run in this PostgreSQL version, PostgREST needs at least " <> pgvName minimumPgVersion
+             else return . Connected  $ version
+
+    shouldRetry :: RetryStatus -> ConnectionStatus -> IO Bool
     shouldRetry rs isConnSucc = do
-      delay <- pure $ fromMaybe 0 (rsPreviousDelay rs) `div` 1000000
+      let delay    = fromMaybe 0 (rsPreviousDelay rs) `div` 1000000
-      itShould <- pure $ not isConnSucc
+          itShould = NotConnected == isConnSucc
       when itShould $
         putStrLn $ "Attempting to reconnect to the database in " <> (show delay::Text) <> " seconds..."
       return itShould
 
+
 {-|
   This is where everything starts.
 -}
@@ -151,28 +152,36 @@ main = do
   --
   -- readOptions builds the 'AppConfig' from the config file specified on the
   -- command line
-  conf <- loadSecretFile =<< readOptions
+  conf <- loadDbUriFile =<< loadSecretFile =<< readOptions
-  let host = configHost conf
+  let schemas = toList $ configSchemas conf
+      host = configHost conf
       port = configPort conf
-      proxy = configProxyUri conf
+      proxy = configOpenAPIProxyUri conf
+      maybeSocketAddr = configSocket conf
+      socketFileMode = configSocketMode conf
       pgSettings = toS (configDatabase conf) -- is the db-uri
+      roleClaimKey = configRoleClaimKey conf
       appSettings =
         setHost ((fromString . toS) host) -- Warp settings
         . setPort port
-        . setServerName (toS $ "postgrest/" <> prettyVersion)
+        . setServerName (toS $ "postgrest/" <> prettyVersion) $
-        . setTimeout 3600 $
         defaultSettings
-  --
+
-  -- Checks that the provided proxy uri is formated correctly,
+
-  -- does not test if it works here.
+  whenLeft socketFileMode panic
+
+  -- Checks that the provided proxy uri is formated correctly
   when (isMalformedProxyUri $ toS <$> proxy) $
     panic
       "Malformed proxy uri, a correct example: https://example.com:8443/basePath"
-  putStrLn $ ("Listening on port " :: Text) <> show (configPort conf)
+
-  --
+  -- Checks that the provided jspath is valid
+  whenLeft roleClaimKey $
+    panic $ show roleClaimKey
+
   -- create connection pool with the provided settings, returns either
   -- a 'Connection' or a 'ConnectionError'. Does not throw.
-  pool <- P.acquire (configPool conf, 10, pgSettings)
+  pool <- P.acquire (configPool conf, configPoolTimeout' conf, pgSettings)
   --
   -- To be filled in by connectionWorker
   refDbStructure <- newIORef Nothing
@@ -188,7 +197,7 @@ main = do
   connectionWorker
     mainTid
     pool
-    (configSchema conf)
+    schemas
     refDbStructure
     refIsWorkerOn
   --
@@ -206,29 +215,43 @@ main = do
         throwTo mainTid UserInterrupt
       ) Nothing
 
-  void $ installHandler sigHUP (
+  void $ installHandler sigUSR1 (
     Catch $ connectionWorker
               mainTid
               pool
-              (configSchema conf)
+              schemas
               refDbStructure
               refIsWorkerOn
     ) Nothing
 #endif
 
-  --
+
+  -- ask for the OS time at most once per second
+  getTime <- mkAutoUpdate defaultUpdateSettings {updateAction = getCurrentTime}
+
+  let postgrestApplication =
+        postgrest
+          conf
+          refDbStructure
+          pool
+          getTime
+          (connectionWorker
+             mainTid
+             pool
+             schemas
+             refDbStructure
+             refIsWorkerOn)
+
+  -- run the postgrest application with user defined socket. Only for UNIX systems.
+#ifndef mingw32_HOST_OS
+  whenJust maybeSocketAddr $
+    runAppInSocket appSettings postgrestApplication socketFileMode
+#endif
+
   -- run the postgrest application
-  runSettings appSettings $
+  whenNothing maybeSocketAddr $ do
-    postgrest
+    putStrLn $ ("Listening on port " :: Text) <> show (configPort conf)
-      conf
+    runSettings appSettings postgrestApplication
-      refDbStructure
-      pool
-      (connectionWorker
-         mainTid
-         pool
-         (configSchema conf)
-         refDbStructure
-         refIsWorkerOn)
 
 {-|
   The purpose of this function is to load the JWT secret from a file if
@@ -264,14 +287,16 @@ loadSecretFile conf = extractAndTransform mSecret
       fmap setSecret $
       transformString isB64 =<<
       case stripPrefix "@" secret of
-        Nothing       -> return secret
+        Nothing       -> return . encodeUtf8 $ secret
-        Just filename -> readFile (toS filename)
+        Just filename -> chomp <$> BS.readFile (toS filename)
+      where
+        chomp bs = fromMaybe bs (BS.stripSuffix "\n" bs)
     --
     -- Turns the Base64url encoded JWT into Base64
-    transformString :: Bool -> Text -> IO ByteString
+    transformString :: Bool -> ByteString -> IO ByteString
-    transformString False t = return . encodeUtf8 $ t
+    transformString False t = return t
     transformString True t =
-      case decode (encodeUtf8 $ strip $ replaceUrlChars t) of
+      case B64.decode $ encodeUtf8 $ strip $ replaceUrlChars $ decodeUtf8 t of
         Left errMsg -> panic $ pack errMsg
         Right bs    -> return bs
     setSecret bs = conf {configJwtSecret = Just bs}
@@ -279,3 +304,27 @@ loadSecretFile conf = extractAndTransform mSecret
     -- replace: Replace every occurrence of one substring with another
     replaceUrlChars =
       replace "_" "/" . replace "-" "+" . replace "." "="
+
+{-
+  Load database uri from a separate file if `db-uri` is a filepath.
+-}
+loadDbUriFile :: AppConfig -> IO AppConfig
+loadDbUriFile conf = extractDbUri mDbUri
+  where
+    mDbUri = configDatabase conf
+    extractDbUri :: Text -> IO AppConfig
+    extractDbUri dbUri =
+      fmap setDbUri $
+      case stripPrefix "@" dbUri of
+        Nothing       -> return dbUri
+        Just filename -> strip <$> readFile (toS filename)
+    setDbUri dbUri = conf {configDatabase = dbUri}
+
+-- Utilitarian functions.
+whenJust :: Applicative f => Maybe a -> (a -> f ()) -> f ()
+whenJust (Just x) f = f x
+whenJust Nothing _  = pass
+
+whenNothing :: Applicative f => Maybe a -> f () -> f ()
+whenNothing Nothing f = f
+whenNothing _       _ = pass

main/UnixSocket.hs

@@ -0,0 +1,40 @@
+module UnixSocket (
+  runAppInSocket
+)where
+
+import Network.Socket           (Family (AF_UNIX),
+                                 SockAddr (SockAddrUnix), Socket,
+                                 SocketType (Stream), bind, close,
+                                 defaultProtocol, listen,
+                                 maxListenQueue, socket)
+import Network.Wai              (Application)
+import Network.Wai.Handler.Warp
+import System.Directory         (removeFile)
+import System.IO.Error          (isDoesNotExistError)
+import System.Posix.Files       (setFileMode)
+import System.Posix.Types       (FileMode)
+
+import Protolude
+
+createAndBindSocket :: FilePath -> Maybe FileMode -> IO Socket
+createAndBindSocket socketFilePath maybeSocketFileMode = do
+  deleteSocketFileIfExist socketFilePath
+  sock <- socket AF_UNIX Stream defaultProtocol
+  bind sock $ SockAddrUnix socketFilePath
+  mapM_ (setFileMode socketFilePath) maybeSocketFileMode
+  return sock
+  where
+    deleteSocketFileIfExist path = removeFile path `catch` handleDoesNotExist
+    handleDoesNotExist e
+      | isDoesNotExistError e = return ()
+      | otherwise = throwIO e
+
+-- run the postgrest application with user defined socket.
+runAppInSocket :: Settings -> Application -> Either Text FileMode -> FilePath -> IO ()
+runAppInSocket settings app socketFileMode sockPath = do
+  sock <- createAndBindSocket sockPath (rightToMaybe socketFileMode)
+  putStrLn $ ("Listening on unix socket " :: Text) <> show sockPath
+  listen sock maxListenQueue
+  runSettingsSocket settings sock app
+  -- clean socket up when done
+  close sock

postgrest.cabal

@@ -1,159 +1,231 @@
-name:                  postgrest
+name:               postgrest
-description:           Reads the schema of a PostgreSQL database and creates RESTful routes
+version:            7.0.0
-                       for the tables and views, supporting all HTTP verbs that security
+synopsis:           REST API for any Postgres database
-                       permits.
+description:        Reads the schema of a PostgreSQL database and creates RESTful routes
-version:               0.4.3.0
+                    for the tables and views, supporting all HTTP verbs that security
-synopsis:              REST API for any Postgres database
+                    permits.
-license:               MIT
+license:            MIT
-license-file:          LICENSE
+license-file:       LICENSE
-author:                Joe Nelson, Adam Baker
+author:             Joe Nelson, Adam Baker, Steve Chavez
-homepage:              https://github.com/begriffs/postgrest
+maintainer:         Steve Chavez <stevechavezast@gmail.com>
-maintainer:            cred+github@begriffs.com
+category:           Executable, PostgreSQL, Network APIs
-category:              Web
+homepage:           https://postgrest.org
-build-type:            Simple
+bug-reports:        https://github.com/PostgREST/postgrest/issues
-cabal-version:         >=1.10
+build-type:         Simple
+extra-source-files: CHANGELOG.md
+cabal-version:      >= 1.10
+
 source-repository head
-  type: git
+  type:     git
-  location: git://github.com/begriffs/postgrest.git
+  location: git://github.com/PostgREST/postgrest.git
 
-Flag CI
+flag ci
-  Description: No warnings allowed in continuous integration
+  default:     False
-  Manual:      True
+  manual:      True
-  Default:     False
+  description: No warnings allowed in continuous integration
-
-executable postgrest
-  main-is:             Main.hs
-  default-extensions:  OverloadedStrings, QuasiQuotes, NoImplicitPrelude
-  ghc-options:
-    -threaded
-    -rtsopts
-    "-with-rtsopts=-N -I2"
-  default-language:    Haskell2010
-  build-depends:       base
-                     , hasql
-                     , hasql-pool
-                     , postgrest
-                     , protolude
-                     , text
-                     , warp
-                     , bytestring
-                     , base64-bytestring
-                     , retry
-  if !os(windows)
-    build-depends:     unix
-
-  hs-source-dirs:      main
 
 library
-  default-language:    Haskell2010
+  exposed-modules:    PostgREST.ApiRequest
-  default-extensions:  OverloadedStrings, QuasiQuotes, NoImplicitPrelude
+                      PostgREST.App
-  build-depends:       aeson
+                      PostgREST.Auth
-                     , ansi-wl-pprint
+                      PostgREST.Config
-                     , base >= 4.8 && < 6
+                      PostgREST.DbRequestBuilder
-                     , base64-bytestring
+                      PostgREST.DbStructure
-                     , bytestring
+                      PostgREST.Error
-                     , case-insensitive
+                      PostgREST.Middleware
-                     , cassava
+                      PostgREST.OpenAPI
-                     , configurator-ng == 0.0.0.1
+                      PostgREST.Parsers
-                     , containers
+                      PostgREST.QueryBuilder
-                     , contravariant
+                      PostgREST.Statements
-                     , either
+                      PostgREST.RangeQuery
-                     , hasql
+                      PostgREST.Types
-                     , hasql-pool == 0.4.1
+  other-modules:      Paths_postgrest
-                     , hasql-transaction == 0.5
+                      PostgREST.Private.Common
-                     , heredoc
+                      PostgREST.Private.QueryFragment
-                     , HTTP
+  hs-source-dirs:     src
-                     , http-types
+  build-depends:      base                      >= 4.9 && < 4.14
-                     , insert-ordered-containers
+                    , HTTP                      >= 4000.3.7 && < 4000.4
-                     , interpolatedstring-perl6
+                    , Ranged-sets               >= 0.3 && < 0.5
-                     , jose
+                    , aeson                     >= 0.11.3 && < 1.5
-                     , lens
+                    , ansi-wl-pprint            >= 0.6.7 && < 0.7
-                     , lens-aeson
+                    , base64-bytestring         >= 1 && < 1.1
-                     , network-uri
+                    , bytestring                >= 0.10.8 && < 0.11
-                     , optparse-applicative >= 0.13 && < 0.15
+                    , case-insensitive          >= 1.2 && < 1.3
-                     , parsec
+                    , cassava                   >= 0.4.5 && < 0.6
-                     , protolude >= 0.2
+                    , configurator-pg           >= 0.2 && < 0.3
-                     , Ranged-sets == 0.3.0
+                    , containers                >= 0.5.7 && < 0.7
-                     , regex-tdfa
+                    , contravariant             >= 1.4 && < 1.6
-                     , safe
+                    , contravariant-extras      >= 0.3.3 && < 0.4
-                     , scientific
+                    , cookie                    >= 0.4.2 && < 0.5
-                     , swagger2
+                    , either                    >= 4.4.1 && < 5.1
-                     , text
+                    , gitrev                    >= 1.2 && < 1.4
-                     , unordered-containers
+                    , hasql                     >= 1.4 && < 1.5
-                     , vector
+                    , hasql-pool                >= 0.5 && < 0.6
-                     , wai
+                    , hasql-transaction         >= 0.7.2 && < 1.1
-                     , wai-cors
+                    , heredoc                   >= 0.2 && < 0.3
-                     , wai-extra
+                    , http-types                >= 0.12.2 && < 0.13
-                     , wai-middleware-static
+                    , insert-ordered-containers >= 0.2.2 && < 0.3
-                     , cookie
+                    , interpolatedstring-perl6  >= 1 && < 1.1
+                    , jose                      >= 0.8.1 && < 0.9
+                    , lens                      >= 4.14 && < 4.19
+                    , lens-aeson                >= 1.0.1 && < 1.2
+                    , network-uri               >= 2.6.1 && < 2.7
+                    , optparse-applicative      >= 0.13 && < 0.16
+                    , parsec                    >= 3.1.11 && < 3.2
+                    , protolude                 >= 0.2.2 && < 0.3
+                    , regex-tdfa                >= 1.2.2 && < 1.4
+                    , scientific                >= 0.3.4 && < 0.4
+                    , swagger2                  >= 2.4 && < 2.6
+                    , text                      >= 1.2.2 && < 1.3
+                    , time                      >= 1.6 && < 1.10
+                    , unordered-containers      >= 0.2.8 && < 0.3
+                    , vector                    >= 0.11 && < 0.13
+                    , wai                       >= 3.2.1 && < 3.3
+                    , wai-cors                  >= 0.2.5 && < 0.3
+                    , wai-extra                 >= 3.0.19 && < 3.1
+                    , wai-middleware-static     >= 0.8.1 && < 0.9
+  default-language:   Haskell2010
+  default-extensions: OverloadedStrings
+                      QuasiQuotes
+                      NoImplicitPrelude
 
-  Other-Modules:       Paths_postgrest
+executable postgrest
-  Exposed-Modules:     PostgREST.ApiRequest
+  main-is:            Main.hs
-                     , PostgREST.App
+  hs-source-dirs:     main
-                     , PostgREST.Auth
+  build-depends:      base              >= 4.9 && < 4.14
-                     , PostgREST.Config
+                    , auto-update       >= 0.1.4 && < 0.2
-                     , PostgREST.DbStructure
+                    , base64-bytestring >= 1 && < 1.1
-                     , PostgREST.DbRequestBuilder
+                    , bytestring        >= 0.10.8 && < 0.11
-                     , PostgREST.Error
+                    , directory         >= 1.2.6 && < 1.4
-                     , PostgREST.Middleware
+                    , either            >= 4.4.1 && < 5.1
-                     , PostgREST.OpenAPI
+                    , hasql             >= 1.4 && < 1.5
-                     , PostgREST.Parsers
+                    , hasql-pool        >= 0.5 && < 0.6
-                     , PostgREST.QueryBuilder
+                    , hasql-transaction >= 0.7.2 && < 1.1
-                     , PostgREST.RangeQuery
+                    , network           < 3.2
-                     , PostgREST.Types
+                    , postgrest
-  hs-source-dirs:      src
+                    , protolude         >= 0.2.2 && < 0.3
+                    , retry             >= 0.7.4 && < 0.9
+                    , text              >= 1.2.2 && < 1.3
+                    , time              >= 1.6 && < 1.10
+                    , wai               >= 3.2.1 && < 3.3
+                    , warp              >= 3.2.12 && < 3.4
+  default-language:   Haskell2010
+  default-extensions: OverloadedStrings
+                      QuasiQuotes
+                      NoImplicitPrelude
+  ghc-options:        -threaded -rtsopts "-with-rtsopts=-N -I2"
 
-Test-Suite spec
+  if !os(windows)
+    build-depends: unix
+    other-modules: UnixSocket
+
+test-suite spec
+  type:               exitcode-stdio-1.0
+  main-is:            Main.hs
+  other-modules:      Feature.AndOrParamsSpec
+                      Feature.AsymmetricJwtSpec
+                      Feature.AudienceJwtSecretSpec
+                      Feature.AuthSpec
+                      Feature.BinaryJwtSecretSpec
+                      Feature.ConcurrentSpec
+                      Feature.CorsSpec
+                      Feature.DeleteSpec
+                      Feature.EmbedDisambiguationSpec
+                      Feature.ExtraSearchPathSpec
+                      Feature.InsertSpec
+                      Feature.JsonOperatorSpec
+                      Feature.NoJwtSpec
+                      Feature.NonexistentSchemaSpec
+                      Feature.PgVersion95Spec
+                      Feature.PgVersion96Spec
+                      Feature.ProxySpec
+                      Feature.QueryLimitedSpec
+                      Feature.QuerySpec
+                      Feature.RangeSpec
+                      Feature.RootSpec
+                      Feature.RpcSpec
+                      Feature.SingularSpec
+                      Feature.StructureSpec
+                      Feature.UnicodeSpec
+                      Feature.UpsertSpec
+                      Feature.RawOutputTypesSpec
+                      Feature.HtmlRawOutputSpec
+                      Feature.MultipleSchemaSpec
+                      SpecHelper
+                      TestTypes
+  hs-source-dirs:     test
+  build-depends:      base              >= 4.9 && < 4.14
+                    , aeson             >= 0.11.3 && < 1.5
+                    , aeson-qq          >= 0.8.1 && < 0.9
+                    , async             >= 2.1.1 && < 2.3
+                    , auto-update       >= 0.1.4 && < 0.2
+                    , base64-bytestring >= 1 && < 1.1
+                    , bytestring        >= 0.10.8 && < 0.11
+                    , case-insensitive  >= 1.2 && < 1.3
+                    , cassava           >= 0.4.5 && < 0.6
+                    , containers        >= 0.5.7 && < 0.7
+                    , contravariant     >= 1.4 && < 1.6
+                    , hasql             >= 1.4 && < 1.5
+                    , hasql-pool        >= 0.5 && < 0.6
+                    , hasql-transaction >= 0.7.2 && < 1.1
+                    , heredoc           >= 0.2 && < 0.3
+                    , hspec             >= 2.3 && < 2.8
+                    , hspec-wai         >= 0.10 && < 0.11
+                    , hspec-wai-json    >= 0.10 && < 0.11
+                    , http-types        >= 0.12.3 && < 0.13
+                    , lens              >= 4.14 && < 4.19
+                    , lens-aeson        >= 1.0.1 && < 1.2
+                    , monad-control     >= 1.0.1 && < 1.1
+                    , postgrest
+                    , process           >= 1.4.2 && < 1.7
+                    , protolude         >= 0.2.2 && < 0.3
+                    , regex-tdfa        >= 1.2.2 && < 1.4
+                    , text              >= 1.2.2 && < 1.3
+                    , time              >= 1.6 && < 1.10
+                    , transformers-base >= 0.4.4 && < 0.5
+                    , wai               >= 3.2.1 && < 3.3
+                    , wai-extra         >= 3.0.19 && < 3.1
+  default-language:   Haskell2010
+  default-extensions: OverloadedStrings
+                      QuasiQuotes
+                      NoImplicitPrelude
+  ghc-options:        -threaded -rtsopts -with-rtsopts=-N
+
+Test-Suite spec-querycost
   Type:                exitcode-stdio-1.0
   Default-Language:    Haskell2010
   default-extensions:  OverloadedStrings, QuasiQuotes, NoImplicitPrelude
-  ghc-options:         -threaded -rtsopts -with-rtsopts=-N
   Hs-Source-Dirs:      test
-  Main-Is:             Main.hs
+  Main-Is:             QueryCost.hs
-  Other-Modules:       Feature.AuthSpec
+  Other-Modules:       SpecHelper
-                     , Feature.AsymmetricJwtSpec
+  Build-Depends:       base              >= 4.9 && < 4.14
-                     , Feature.BinaryJwtSecretSpec
+                     , aeson             >= 0.11.3 && < 1.5
-                     , Feature.ConcurrentSpec
+                     , aeson-qq          >= 0.8.1 && < 0.9
-                     , Feature.CorsSpec
+                     , async             >= 2.1.1 && < 2.3
-                     , Feature.DeleteSpec
+                     , auto-update       >= 0.1.4 && < 0.2
-                     , Feature.InsertSpec
+                     , base64-bytestring >= 1 && < 1.1
-                     , Feature.NoJwtSpec
+                     , bytestring        >= 0.10.8 && < 0.11
-                     , Feature.ProxySpec
+                     , case-insensitive  >= 1.2 && < 1.3
-                     , Feature.QueryLimitedSpec
+                     , cassava           >= 0.4.5 && < 0.6
-                     , Feature.QuerySpec
+                     , containers        >= 0.5.7 && < 0.7
-                     , Feature.RangeSpec
+                     , contravariant     >= 1.4 && < 1.6
-                     , Feature.SingularSpec
+                     , hasql             >= 1.4 && < 1.5
-                     , Feature.StructureSpec
+                     , hasql-pool        >= 0.5 && < 0.6
-                     , Feature.UnicodeSpec
+                     , hasql-transaction >= 0.7.2 && < 1.1
-                     , Feature.AndOrParamsSpec
+                     , heredoc           >= 0.2 && < 0.3
-                     , SpecHelper
+                     , hspec             >= 2.3 && < 2.8
-                     , TestTypes
+                     , hspec-wai         >= 0.10 && < 0.11
-  Build-Depends:       aeson
+                     , hspec-wai-json    >= 0.10 && < 0.11
-                     , aeson-qq
+                     , http-types        >= 0.12.3 && < 0.13
-                     , async
+                     , lens              >= 4.14 && < 4.19
-                     , base
+                     , lens-aeson        >= 1.0.1 && < 1.2
-                     , bytestring
+                     , monad-control     >= 1.0.1 && < 1.1
-                     , base64-bytestring
-                     , case-insensitive
-                     , cassava
-                     , containers
-                     , contravariant
-                     , hasql
-                     , hasql-pool
-                     , heredoc
-                     , hjsonpointer
-                     , hjsonschema == 1.5.0.1
-                     , hspec
-                     , hspec-wai >= 0.7.0
-                     , hspec-wai-json
-                     , http-types
-                     , lens
-                     , lens-aeson
-                     , monad-control
                      , postgrest
-                     , process
+                     , process           >= 1.4.2 && < 1.7
-                     , protolude
+                     , protolude         >= 0.2.2 && < 0.3
-                     , regex-tdfa
+                     , regex-tdfa        >= 1.2.2 && < 1.4
-                     , transformers-base
+                     , text              >= 1.2.2 && < 1.3
-                     , wai
+                     , time              >= 1.6 && < 1.10
-                     , wai-extra
+                     , transformers-base >= 0.4.4 && < 0.5
+                     , wai               >= 3.2.1 && < 3.3
+                     , wai-extra         >= 3.0.19 && < 3.1

scripts/release_s3.sh

@@ -1,10 +0,0 @@
-export POSTGREST_VER=`grep ^version /app/postgrest.cabal | sed -En 's/.*\s+([0-9\.]+)/\1/p'`
-
-curl -L http://sourceforge.net/projects/s3tools/files/s3cmd/1.5.0-alpha1/s3cmd-1.5.0-alpha1.tar.gz | tar zx
-
-cp /app/dist/build/postgrest/postgrest postgrest-${POSTGREST_VER}
-tar cJf postgrest-${POSTGREST_VER}.tar.xz postgrest-${POSTGREST_VER}
-
-touch ~/.s3cfg
-
-s3cmd-1.5.0-alpha1/s3cmd put --access_key=${S3_ACCESS_KEY} --secret_key=${S3_SECRET_KEY} -P -f postgrest-${POSTGREST_VER}.tar.xz $S3_BUCKET/postgrest-${POSTGREST_VER}.tar.xz

src/PostgREST/ApiRequest.hs

@@ -2,64 +2,71 @@
 Module      : PostgREST.ApiRequest
 Description : PostgREST functions to translate HTTP request to a domain type called ApiRequest.
 -}
-module PostgREST.ApiRequest ( ApiRequest(..)
+{-# LANGUAGE LambdaCase #-}
-                            , ContentType(..)
+{-# LANGUAGE MultiWayIf #-}
-                            , Action(..)
-                            , Target(..)
-                            , PreferRepresentation (..)
-                            , mutuallyAgreeable
-                            , userApiRequest
-                            ) where
 
-import           Protolude
+module PostgREST.ApiRequest (
-import qualified Data.Aeson                as JSON
+  ApiRequest(..)
-import           Data.Aeson.Types          (emptyObject)
+, InvokeMethod(..)
-import qualified Data.ByteString           as BS
+, ContentType(..)
-import qualified Data.ByteString.Internal  as BS (c2w)
+, Action(..)
-import qualified Data.ByteString.Lazy      as BL
+, Target(..)
-import qualified Data.Csv                  as CSV
+, mutuallyAgreeable
-import qualified Data.List                 as L
+, userApiRequest
-import           Data.List                 (lookup, last)
+) where
-import qualified Data.HashMap.Strict       as M
+
-import qualified Data.Set                  as S
+import qualified Data.Aeson           as JSON
-import           Data.Maybe                (fromJust)
+import qualified Data.ByteString      as BS
-import           Control.Arrow             ((***))
+import qualified Data.ByteString.Lazy as BL
-import qualified Data.Text                 as T
+import qualified Data.CaseInsensitive as CI
-import qualified Data.Vector               as V
+import qualified Data.Csv             as CSV
-import           Network.HTTP.Base         (urlEncodeVars)
+import qualified Data.HashMap.Strict  as M
-import           Network.HTTP.Types.Header (hAuthorization, hCookie)
+import qualified Data.List            as L
-import           Network.HTTP.Types.URI    (parseSimpleQuery)
+import qualified Data.Set             as S
-import           Network.Wai               (Request (..))
+import qualified Data.Text            as T
-import           Network.Wai.Parse         (parseHttpAccept)
+import qualified Data.Vector          as V
-import           PostgREST.RangeQuery      (NonnegRange, rangeRequested, restrictRange, rangeGeq, allRange, rangeLimit, rangeOffset)
+
-import           Data.Ranged.Boundaries
+import Control.Arrow             ((***))
-import           PostgREST.Types           ( QualifiedIdentifier (..)
+import Data.Aeson.Types          (emptyArray, emptyObject)
-                                           , Schema
+import Data.List                 (elem, last, lookup, partition)
-                                           , PayloadJSON(..)
+import Data.List.NonEmpty        (NonEmpty, head)
-                                           , ContentType(..)
+import Data.Maybe                (fromJust)
-                                           , ApiRequestError(..)
+import Data.Ranged.Ranges        (Range (..), emptyRange,
-                                           , toMime)
+                                  rangeIntersection)
-import           Data.Ranged.Ranges        (Range(..), rangeIntersection, emptyRange)
+import Network.HTTP.Base         (urlEncodeVars)
-import qualified Data.CaseInsensitive      as CI
+import Network.HTTP.Types.Header (hAuthorization, hCookie)
-import           Web.Cookie                (parseCookiesText)
+import Network.HTTP.Types.URI    (parseQueryReplacePlus,
+                                  parseSimpleQuery)
+import Network.Wai               (Request (..))
+import Network.Wai.Parse         (parseHttpAccept)
+import Web.Cookie                (parseCookiesText)
+
+
+import Data.Ranged.Boundaries
+
+import PostgREST.Error      (ApiRequestError (..))
+import PostgREST.RangeQuery (NonnegRange, allRange, rangeGeq,
+                             rangeLimit, rangeOffset, rangeRequested,
+                             restrictRange)
+import PostgREST.Types
+import Protolude            hiding (head)
 
 type RequestBody = BL.ByteString
 
+data InvokeMethod = InvHead | InvGet | InvPost deriving Eq
 -- | Types of things a user wants to do to tables/views/procs
-data Action = ActionCreate | ActionRead
+data Action = ActionCreate       | ActionRead{isHead :: Bool}
-            | ActionUpdate | ActionDelete
+            | ActionUpdate       | ActionDelete
-            | ActionInfo   | ActionInvoke
+            | ActionSingleUpsert | ActionInvoke InvokeMethod
-            | ActionInspect
+            | ActionInfo         | ActionInspect{isHead :: Bool}
             deriving Eq
 -- | The target db object of a user action
 data Target = TargetIdent QualifiedIdentifier
-            | TargetProc  QualifiedIdentifier
+            | TargetProc{tpQi :: QualifiedIdentifier, tpIsRootSpec :: Bool}
-            | TargetRoot
+            | TargetDefaultSpec{tdsSchema :: Schema} -- The default spec offered at root "/"
             | TargetUnknown [Text]
             deriving Eq
--- | How to return the inserted data
+
-data PreferRepresentation = Full | HeadersOnly | None deriving Eq
-                          --
 {-|
   Describes what the user wants to do. This data type is a
   translation of the raw elements of an HTTP request into domain
@@ -68,125 +75,191 @@ data PreferRepresentation = Full | HeadersOnly | None deriving Eq
   if it is an action we are able to perform.
 -}
 data ApiRequest = ApiRequest {
-  -- | Similar but not identical to HTTP verb, e.g. Create/Invoke both POST
+    iAction               :: Action                           -- ^ Similar but not identical to HTTP verb, e.g. Create/Invoke both POST
-    iAction :: Action
+  , iRange                :: M.HashMap ByteString NonnegRange -- ^ Requested range of rows within response
-  -- | Requested range of rows within response
+  , iTopLevelRange        :: NonnegRange                      -- ^ Requested range of rows from the top level
-  , iRange  :: M.HashMap ByteString NonnegRange
+  , iTarget               :: Target                           -- ^ The target, be it calling a proc or accessing a table
-  -- | The target, be it calling a proc or accessing a table
+  , iAccepts              :: [ContentType]                    -- ^ Content types the client will accept, [CTAny] if no Accept header
-  , iTarget :: Target
+  , iPayload              :: Maybe PayloadJSON                -- ^ Data sent by client and used for mutation actions
-  -- | Content types the client will accept, [CTAny] if no Accept header
+  , iPreferRepresentation :: PreferRepresentation             -- ^ If client wants created items echoed back
-  , iAccepts :: [ContentType]
+  , iPreferParameters     :: Maybe PreferParameters           -- ^ How to pass parameters to a stored procedure
-  -- | Data sent by client and used for mutation actions
+  , iPreferCount          :: Maybe PreferCount                -- ^ Whether the client wants a result count
-  , iPayload :: Maybe PayloadJSON
+  , iPreferResolution     :: Maybe PreferResolution           -- ^ Whether the client wants to UPSERT or ignore records on PK conflict
-  -- | If client wants created items echoed back
+  , iFilters              :: [(Text, Text)]                   -- ^ Filters on the result ("id", "eq.10")
-  , iPreferRepresentation :: PreferRepresentation
+  , iLogic                :: [(Text, Text)]                   -- ^ &and and &or parameters used for complex boolean logic
-  -- | Pass all parameters as a single json object to a stored procedure
+  , iSelect               :: Maybe Text                       -- ^ &select parameter used to shape the response
-  , iPreferSingleObjectParameter :: Bool
+  , iOnConflict           :: Maybe Text                       -- ^ &on_conflict parameter used to upsert on specific unique keys
-  -- | Whether the client wants a result count (slower)
+  , iColumns              :: Maybe Text                       -- ^ &columns parameter used to shape the payload
-  , iPreferCount :: Bool
+  , iOrder                :: [(Text, Text)]                   -- ^ &order parameters for each level
-  -- | Filters on the result ("id", "eq.10")
+  , iCanonicalQS          :: ByteString                       -- ^ Alphabetized (canonical) request query string for response URLs
-  , iFilters :: [(Text, Text)]
+  , iJWT                  :: Text                             -- ^ JSON Web Token
-  -- | &and and &or parameters used for complex boolean logic
+  , iHeaders              :: [(Text, Text)]                   -- ^ HTTP request headers
-  , iLogic :: [(Text, Text)]
+  , iCookies              :: [(Text, Text)]                   -- ^ Request Cookies
-  -- | &select parameter used to shape the response
+  , iPath                 :: ByteString                       -- ^ Raw request path
-  , iSelect :: Text
+  , iMethod               :: ByteString                       -- ^ Raw request method
-  -- | &order parameters for each level
+  , 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/.
-  , iOrder :: [(Text, Text)]
+  , iSchema               :: Schema                           -- ^ The request schema. Can vary depending on iProfile.
-  -- | Alphabetized (canonical) request query string for response URLs
-  , iCanonicalQS :: ByteString
-  -- | JSON Web Token
-  , iJWT :: Text
-  -- | HTTP request headers
-  , iHeaders :: [(Text, Text)]
-  -- | Request Cookies
-  , iCookies :: [(Text, Text)]
   }
 
 -- | Examines HTTP request and translates it into user intent.
-userApiRequest :: Schema -> Request -> RequestBody -> Either ApiRequestError ApiRequest
+userApiRequest :: NonEmpty Schema -> Maybe Text -> Request -> RequestBody -> Either ApiRequestError ApiRequest
-userApiRequest schema req reqBody
+userApiRequest confSchemas rootSpec req reqBody
-  | isTargetingProc && method /= "POST" = Left ActionInappropriate
+  | isJust profile && fromJust profile `notElem` confSchemas = Left $ UnacceptableSchema $ toList confSchemas
+  | isTargetingProc && method `notElem` ["HEAD", "GET", "POST"] = Left ActionInappropriate
   | topLevelRange == emptyRange = Left InvalidRange
-  | shouldParsePayload && isLeft payload = either (Left . InvalidBody . toS) undefined payload
+  | shouldParsePayload && isLeft payload = either (Left . InvalidBody . toS) witness payload
   | otherwise = Right ApiRequest {
       iAction = action
       , iTarget = target
       , iRange = ranges
-      , iAccepts = fromMaybe [CTAny] $
+      , iTopLevelRange = topLevelRange
-        map decodeContentType . parseHttpAccept <$> lookupHeader "accept"
+      , iAccepts = maybe [CTAny] (map decodeContentType . parseHttpAccept) $ lookupHeader "accept"
       , iPayload = relevantPayload
       , iPreferRepresentation = representation
-      , iPreferSingleObjectParameter = singleObject
+      , iPreferParameters = if | hasPrefer (show SingleObject)     -> Just SingleObject
-      , iPreferCount = hasPrefer "count=exact"
+                               | hasPrefer (show MultipleObjects)  -> Just MultipleObjects
-      , iFilters = [ (toS k, toS $ fromJust v) | (k,v) <- qParams, isJust v, k /= "select", not (endingIn ["order", "limit", "offset", "and", "or"] k) ]
+                               | otherwise                         -> Nothing
+      , iPreferCount      = if | hasPrefer (show ExactCount)     -> Just ExactCount
+                               | hasPrefer (show PlannedCount)   -> Just PlannedCount
+                               | hasPrefer (show EstimatedCount) -> Just EstimatedCount
+                               | otherwise                         -> Nothing
+      , iPreferResolution = if | hasPrefer (show MergeDuplicates)  -> Just MergeDuplicates
+                               | hasPrefer (show IgnoreDuplicates) -> Just IgnoreDuplicates
+                               | otherwise                         -> Nothing
+      , iFilters = filters
       , iLogic = [(toS k, toS $ fromJust v) | (k,v) <- qParams, isJust v, endingIn ["and", "or"] k ]
-      , iSelect = toS $ fromMaybe "*" $ fromMaybe (Just "*") $ lookup "select" qParams
+      , iSelect = toS <$> join (lookup "select" qParams)
+      , iOnConflict = toS <$> join (lookup "on_conflict" qParams)
+      , iColumns = columns
       , iOrder = [(toS k, toS $ fromJust v) | (k,v) <- qParams, isJust v, endingIn ["order"] k ]
       , iCanonicalQS = toS $ urlEncodeVars
-        . L.sortBy (comparing fst)
+        . L.sortOn fst
-        . map (join (***) toS)
+        . map (join (***) toS . second (fromMaybe BS.empty))
-        . parseSimpleQuery
+        $ qString
-        $ rawQueryString req
       , iJWT = tokenStr
-      , iHeaders = [ (toS $ CI.foldedCase k, toS v) | (k,v) <- hdrs, k /= hAuthorization, k /= hCookie]
+      , iHeaders = [ (toS $ CI.foldedCase k, toS v) | (k,v) <- hdrs, k /= hCookie]
-      , iCookies = fromMaybe [] $ parseCookiesText <$> lookupHeader "Cookie"
+      , iCookies = maybe [] parseCookiesText $ lookupHeader "Cookie"
+      , iPath = rawPathInfo req
+      , iMethod = method
+      , iProfile = profile
+      , iSchema = schema
       }
  where
-  isTargetingProc = fromMaybe False $ (== "rpc") <$> listToMaybe path
+  -- queryString with '+' converted to ' '(space)
+  qString = parseQueryReplacePlus True $ rawQueryString req
+  -- rpcQParams = Rpc query params e.g. /rpc/name?param1=val1, similar to filter but with no operator(eq, lt..)
+  (filters, rpcQParams) =
+    case action of
+      ActionInvoke InvGet  -> partitionFlts
+      ActionInvoke InvHead -> partitionFlts
+      _                    -> (flts, [])
+  partitionFlts = partition (liftM2 (||) (isEmbedPath . fst) (hasOperator . snd)) flts
+  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 target of
+    TargetProc _ _ -> True
+    _              -> False
+  isTargetingDefaultSpec = case target of
+    TargetDefaultSpec _ -> True
+    _                   -> False
+  contentType = decodeContentType . fromMaybe "application/json" $ lookupHeader "content-type"
+  columns
+    | action `elem` [ActionCreate, ActionUpdate, ActionInvoke InvPost] = toS <$> join (lookup "columns" qParams)
+    | otherwise = Nothing
   payload =
-    case decodeContentType . fromMaybe "application/json" $ lookupHeader "content-type" of
+    case (contentType, action) of
-      CTApplicationJSON ->
+      (_, ActionInvoke InvGet)  -> Right rpcPrmsToJson
-        note "All object keys must match" . ensureUniform . pluralize
+      (_, ActionInvoke InvHead) -> Right rpcPrmsToJson
-          =<< if BL.null reqBody && isTargetingProc
+      (CTApplicationJSON, _) ->
-               then Right emptyObject
+        if isJust columns
-               else JSON.eitherDecode reqBody
+          then Right $ RawJSON reqBody
-      CTTextCSV ->
+          else note "All object keys must match" . payloadAttributes reqBody
-        note "All lines must have same number of fields" . ensureUniform . csvToJson
+                 =<< if BL.null reqBody && isTargetingProc
-          =<< CSV.decodeByName reqBody
+                       then Right emptyObject
-      CTOther "application/x-www-form-urlencoded" ->
+                       else JSON.eitherDecode reqBody
-        Right . PayloadJSON . V.singleton . M.fromList
+      (CTTextCSV, _) -> do
-                    . map (toS *** JSON.String . toS) . parseSimpleQuery
+        json <- csvToJson <$> CSV.decodeByName reqBody
-                    $ toS reqBody
+        note "All lines must have same number of fields" $ payloadAttributes (JSON.encode json) json
-      ct ->
+      (CTOther "application/x-www-form-urlencoded", _) ->
+        let json = M.fromList . map (toS *** JSON.String . toS) . parseSimpleQuery $ toS reqBody
+            keys = S.fromList $ M.keys json in
+        Right $ ProcessedJSON (JSON.encode json) PJObject keys
+      (ct, _) ->
         Left $ toS $ "Content-Type not acceptable: " <> toMime ct
-  topLevelRange = fromMaybe allRange $ M.lookup "limit" ranges
+  rpcPrmsToJson = ProcessedJSON (JSON.encode $ M.fromList $ second JSON.toJSON <$> rpcQParams)
-  action = case method of
+                  PJObject (S.fromList $ fst <$> rpcQParams)
-            "GET"     -> if target == TargetRoot
+  topLevelRange = fromMaybe allRange $ M.lookup "limit" ranges -- if no limit is specified, get all the request rows
-                          then ActionInspect
+  action =
-                          else ActionRead
+    case method of
-            "POST"    -> if isTargetingProc
+      -- The HEAD method is identical to GET except that the server MUST NOT return a message-body in the response
-                          then ActionInvoke
+      -- From https://www.w3.org/Protocols/rfc2616/rfc2616-sec9.html#sec9.4
-                          else ActionCreate
+      "HEAD"     | isTargetingDefaultSpec -> ActionInspect{isHead=True}
-            "PATCH"   -> ActionUpdate
+                 | isTargetingProc        -> ActionInvoke InvHead
-            "DELETE"  -> ActionDelete
+                 | otherwise              -> ActionRead{isHead=True}
-            "OPTIONS" -> ActionInfo
+      "GET"      | isTargetingDefaultSpec -> ActionInspect{isHead=False}
-            _         -> ActionInspect
+                 | isTargetingProc        -> ActionInvoke InvGet
+                 | otherwise              -> ActionRead{isHead=False}
+      "POST"    -> if isTargetingProc
+                    then ActionInvoke InvPost
+                    else ActionCreate
+      "PATCH"   -> ActionUpdate
+      "PUT"     -> ActionSingleUpsert
+      "DELETE"  -> ActionDelete
+      "OPTIONS" -> ActionInfo
+      _         -> ActionInspect{isHead=False}
+
+  defaultSchema = head confSchemas
+  profile
+    | length confSchemas <= 1 -- only enable content negotiation by profile when there are multiple schemas specified in the config
+      = Nothing
+    | action `elem` [ActionCreate, ActionUpdate, ActionSingleUpsert, ActionDelete] -- POST/PATCH/PUT/DELETE don't use the same header as per the spec
+      = Just $ maybe defaultSchema toS $ lookupHeader "Content-Profile"
+    | action `elem` [ActionRead True, ActionRead False, ActionInvoke InvGet, ActionInvoke InvHead, ActionInvoke InvPost,
+                     ActionInspect False, ActionInspect True, ActionInfo]
+      = Just $ maybe defaultSchema toS $ lookupHeader "Accept-Profile"
+    | otherwise = Nothing
+  schema = fromMaybe defaultSchema profile
   target = case path of
-              []            -> TargetRoot
+    []            -> case rootSpec of
-              [table]       -> TargetIdent
+                       Just pName -> TargetProc (QualifiedIdentifier schema pName) True
-                              $ QualifiedIdentifier schema table
+                       Nothing    -> TargetDefaultSpec schema
-              ["rpc", proc] -> TargetProc
+    [table]       -> TargetIdent $ QualifiedIdentifier schema table
-                              $ QualifiedIdentifier schema proc
+    ["rpc", proc] -> TargetProc (QualifiedIdentifier schema proc) False
-              other         -> TargetUnknown other
+    other         -> TargetUnknown other
-  shouldParsePayload = action `elem` [ActionCreate, ActionUpdate, ActionInvoke]
+
-  relevantPayload = if shouldParsePayload
+  shouldParsePayload =
-                      then rightToMaybe payload
+    action `elem`
-                      else Nothing
+    [ActionCreate, ActionUpdate, ActionSingleUpsert,
+    ActionInvoke InvPost,
+    -- Though ActionInvoke{isGet=True}(a GET /rpc/..) 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,
+    ActionInvoke InvHead]
+  relevantPayload | shouldParsePayload = rightToMaybe payload
+                  | otherwise = Nothing
   path            = pathInfo req
   method          = requestMethod req
   hdrs            = requestHeaders req
-  qParams         = [(toS k, v)|(k,v) <- queryString req]
+  qParams         = [(toS k, v)|(k,v) <- qString]
   lookupHeader    = flip lookup hdrs
   hasPrefer :: Text -> Bool
   hasPrefer val   = any (\(h,v) -> h == "Prefer" && val `elem` split v) hdrs
     where
         split :: BS.ByteString -> [Text]
         split = map T.strip . T.split (==',') . toS
-  singleObject    = hasPrefer "params=single-object"
   representation
-    | hasPrefer "return=representation" = Full
+    | hasPrefer (show Full) = Full
-    | hasPrefer "return=minimal" = None
+    | hasPrefer (show None) = None
-    | otherwise = HeadersOnly
+    | otherwise             = if action == ActionCreate
+                                then HeadersOnly -- Assume the user wants the Location header(for POST) by default
+                                else None
   auth = fromMaybe "" $ lookupHeader hAuthorization
   tokenStr = case T.split (== ' ') (toS auth) of
     ("Bearer" : t : _) -> t
@@ -200,7 +273,7 @@ userApiRequest schema req reqBody
   limitParams :: M.HashMap ByteString NonnegRange
   limitParams  = M.fromList [(toS (replaceLast "limit" k), restrictRange (readMaybe =<< (toS <$> v)) allRange) | (k,v) <- qParams, isJust v, endingIn ["limit"] k]
   offsetParams :: M.HashMap ByteString NonnegRange
-  offsetParams = M.fromList [(toS (replaceLast "limit" k), fromMaybe allRange (rangeGeq <$> (readMaybe =<< (toS <$> v)))) | (k,v) <- qParams, isJust v, endingIn ["offset"] k]
+  offsetParams = M.fromList [(toS (replaceLast "limit" k), maybe allRange rangeGeq (readMaybe =<< (toS <$> v))) | (k,v) <- qParams, isJust v, endingIn ["offset"] k]
 
   urlRange = M.unionWith f limitParams offsetParams
     where
@@ -223,23 +296,6 @@ mutuallyAgreeable sProduces cAccepts =
      then listToMaybe sProduces
      else exact
 
--- PRIVATE ---------------------------------------------------------------
-
-{-|
-  Warning: discards MIME parameters
--}
-decodeContentType :: BS.ByteString -> ContentType
-decodeContentType ct =
-  case BS.takeWhile (/= BS.c2w ';') ct of
-    "application/json"                  -> CTApplicationJSON
-    "text/csv"                          -> CTTextCSV
-    "application/openapi+json"          -> CTOpenAPI
-    "application/vnd.pgrst.object+json" -> CTSingularJSON
-    "application/vnd.pgrst.object"      -> CTSingularJSON
-    "application/octet-stream"          -> CTOctetStream
-    "*/*"                               -> CTAny
-    ct'                                 -> CTOther ct'
-
 type CsvData = V.Vector (M.HashMap Text BL.ByteString)
 
 {-|
@@ -254,9 +310,9 @@ type CsvData = V.Vector (M.HashMap Text BL.ByteString)
   The reason for its odd signature is so that it can compose
   directly with CSV.decodeByName
 -}
-csvToJson :: (CSV.Header, CsvData) -> JSON.Array
+csvToJson :: (CSV.Header, CsvData) -> JSON.Value
 csvToJson (_, vals) =
-  V.map rowToJsonObj vals
+  JSON.Array $ V.map rowToJsonObj vals
  where
   rowToJsonObj = JSON.Object .
     M.map (\str ->
@@ -265,27 +321,26 @@ csvToJson (_, vals) =
           else JSON.String $ toS str
       )
 
--- | Convert {foo} to [{foo}], leave arrays unchanged
+payloadAttributes :: RequestBody -> JSON.Value -> Maybe PayloadJSON
--- and truncate everything else to an empty array.
+payloadAttributes raw json =
-pluralize :: JSON.Value -> JSON.Array
+  -- Test that Array contains only Objects having the same keys
-pluralize obj@(JSON.Object _) = V.singleton obj
+  case json of
-pluralize (JSON.Array arr)    = arr
+    JSON.Array arr ->
-pluralize _                   = V.empty
+      case arr V.!? 0 of
+        Just (JSON.Object o) ->
+          let canonicalKeys = S.fromList $ M.keys o
+              areKeysUniform = all (\case
+                JSON.Object x -> S.fromList (M.keys x) == canonicalKeys
+                _ -> False) arr in
+          if areKeysUniform
+            then Just $ ProcessedJSON raw (PJArray $ V.length arr) canonicalKeys
+            else Nothing
+        Just _ -> Nothing
+        Nothing -> Just emptyPJArray
 
--- | Test that Array contains only Objects having the same keys
+    JSON.Object o -> Just $ ProcessedJSON raw PJObject (S.fromList $ M.keys o)
--- and if so mark it as PayloadJSON
-ensureUniform :: JSON.Array -> Maybe PayloadJSON
-ensureUniform arr =
-  let objs :: V.Vector JSON.Object
-      objs = foldr -- filter non-objects, map to raw objects
-               (\val result -> case val of
-                  JSON.Object o -> V.cons o result
-                  _ -> result)
-               V.empty arr
-      keysPerObj = V.map (S.fromList . M.keys) objs
-      canonicalKeys = fromMaybe S.empty $ keysPerObj V.!? 0
-      areKeysUniform = all (==canonicalKeys) keysPerObj in
 
-  if (V.length objs == V.length arr) && areKeysUniform
+    -- truncate everything else to an empty array.
-    then Just (PayloadJSON objs)
+    _ -> Just emptyPJArray
-    else Nothing
+  where
+    emptyPJArray = ProcessedJSON (JSON.encode emptyArray) (PJArray 0) S.empty

src/PostgREST/App.hs

@@ -1,364 +1,423 @@
+{-|
+Module      : PostgREST.App
+Description : PostgREST main application
+
+This module is in charge of mapping HTTP requests to PostgreSQL queries.
+Some of its functionality includes:
+
+- Mapping HTTP request methods to proper SQL statements. For example, a GET request is translated to executing a SELECT query in a read-only TRANSACTION.
+- Producing HTTP Headers according to RFCs.
+- Content Negotiation
+-}
 {-# LANGUAGE FlexibleContexts    #-}
+{-# LANGUAGE MultiWayIf          #-}
+{-# LANGUAGE NamedFieldPuns      #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 
 module PostgREST.App (
   postgrest
 ) where
 
-import           Control.Applicative
+import qualified Data.ByteString.Char8      as BS
-import qualified Data.ByteString.Char8     as BS
+import qualified Data.HashMap.Strict        as M
-import           Data.Maybe
+import qualified Data.List                  as L (union)
-import           Data.IORef                (IORef, readIORef)
+import qualified Data.Set                   as S
-import           Data.Text                 (intercalate)
-
 import qualified Hasql.Pool                 as P
+import qualified Hasql.Transaction          as H
 import qualified Hasql.Transaction          as HT
 import qualified Hasql.Transaction.Sessions as HT
 
-import           Network.HTTP.Types.Header
+import Data.Function                        (id)
-import           Network.HTTP.Types.Status
+import Data.IORef                           (IORef, readIORef)
-import           Network.HTTP.Types.URI    (renderSimpleQuery)
+import Data.Time.Clock                      (UTCTime)
-import           Network.Wai
+import Network.HTTP.Types.URI               (renderSimpleQuery)
-import           Network.Wai.Middleware.RequestLogger (logStdout)
+import Network.Wai.Middleware.RequestLogger (logStdout)
 
-import qualified Data.Vector               as V
+import Control.Applicative
-import qualified Hasql.Transaction         as H
+import Data.Maybe
+import Network.HTTP.Types.Header
+import Network.HTTP.Types.Status
+import Network.Wai
 
-import qualified Data.HashMap.Strict       as M
+import PostgREST.ApiRequest       (Action (..), ApiRequest (..),
+                                   ContentType (..),
+                                   InvokeMethod (..), Target (..),
+                                   mutuallyAgreeable, userApiRequest)
+import PostgREST.Auth             (containsRole, jwtClaims,
+                                   parseSecret)
+import PostgREST.Config           (AppConfig (..))
+import PostgREST.DbRequestBuilder (mutateRequest, readRequest)
+import PostgREST.DbStructure
+import PostgREST.Error            (PgError (..), SimpleError (..),
+                                   errorResponseFor, singularityError)
+import PostgREST.Middleware
+import PostgREST.OpenAPI
+import PostgREST.Parsers          (pRequestColumns)
+import PostgREST.QueryBuilder     (limitedQuery, mutateRequestToQuery,
+                                   readRequestToCountQuery,
+                                   readRequestToQuery,
+                                   requestToCallProcQuery)
+import PostgREST.RangeQuery       (allRange, contentRangeH,
+                                   rangeStatusHeader)
+import PostgREST.Statements       (callProcStatement,
+                                   createExplainStatement,
+                                   createReadStatement,
+                                   createWriteStatement)
+import PostgREST.Types
+import Protolude                  hiding (Proxy, intercalate)
 
-import           PostgREST.ApiRequest   ( ApiRequest(..), ContentType(..)
+postgrest :: AppConfig -> IORef (Maybe DbStructure) -> P.Pool -> IO UTCTime -> IO () -> Application
-                                        , Action(..), Target(..)
+postgrest conf refDbStructure pool getTime worker =
-                                        , PreferRepresentation (..)
-                                        , mutuallyAgreeable
-                                        , userApiRequest
-                                        )
-import           PostgREST.Auth            (jwtClaims, containsRole, parseJWK)
-import           PostgREST.Config          (AppConfig (..))
-import           PostgREST.DbStructure
-import           PostgREST.DbRequestBuilder( readRequest
-                                           , mutateRequest
-                                           , fieldNames
-                                           )
-import           PostgREST.Error           ( simpleError, pgError
-                                           , apiRequestError
-                                           , singularityError, binaryFieldError
-                                           , connectionLostError
-                                           )
-import           PostgREST.RangeQuery      (allRange, rangeOffset)
-import           PostgREST.Middleware
-import           PostgREST.QueryBuilder ( callProc
-                                        , requestToQuery
-                                        , requestToCountQuery
-                                        , createReadStatement
-                                        , createWriteStatement
-                                        , ResultsWithCount
-                                        )
-import           PostgREST.Types
-import           PostgREST.OpenAPI
-
-import           Data.Function (id)
-import           Protolude              hiding (intercalate, Proxy)
-import           Safe                   (headMay)
-
-postgrest :: AppConfig -> IORef (Maybe DbStructure) -> P.Pool -> IO () -> Application
-postgrest conf refDbStructure pool worker =
   let middle = (if configQuiet conf then id else logStdout) . defaultMiddle
-      jwtSecret = parseJWK <$> configJwtSecret conf in
+      jwtSecret = parseSecret <$> configJwtSecret conf in
-
   middle $ \ req respond -> do
+    time <- getTime
     body <- strictRequestBody req
     maybeDbStructure <- readIORef refDbStructure
     case maybeDbStructure of
-      Nothing -> respond connectionLostError
+      Nothing -> respond . errorResponseFor $ ConnectionLostError
       Just dbStructure -> do
-        response <- case userApiRequest (configSchema conf) req body of
+        response <- do
-          Left err -> return $ apiRequestError err
+          -- Need to parse ?columns early because findProc needs it to solve overloaded functions.
-          Right apiRequest -> do
+          -- TODO: move this logic to the app function
-            eClaims <- jwtClaims jwtSecret (toS $ iJWT apiRequest)
+          let apiReq = userApiRequest (configSchemas conf) (configRootSpec conf) req body
-
+              apiReqCols = (,) <$> apiReq <*> (pRequestColumns =<< iColumns <$> apiReq)
-            let authed = containsRole eClaims
+          case apiReqCols of
-                handleReq = runWithClaims conf eClaims (app dbStructure conf) apiRequest
+            Left err -> return . errorResponseFor $ err
-                txMode = transactionMode dbStructure
+            Right (apiRequest, maybeCols) -> do
-                  (iTarget apiRequest) (iAction apiRequest)
+              eClaims <- jwtClaims jwtSecret (configJwtAudience conf) (toS $ iJWT apiRequest) time (rightToMaybe $ configRoleClaimKey conf)
-            response <- P.use pool $ HT.transaction HT.ReadCommitted txMode handleReq
+              let authed = containsRole eClaims
-            return $ either (pgError authed) identity response
+                  cols = case (iPayload apiRequest, maybeCols) of
-        when (isResponse503 response) worker
+                    (Just ProcessedJSON{pjKeys}, _) -> pjKeys
+                    (Just RawJSON{}, Just cls)      -> cls
+                    _                               -> S.empty
+                  proc = case iTarget apiRequest of
+                    TargetProc qi _ -> findProc qi cols (iPreferParameters apiRequest == Just SingleObject) $ dbProcs dbStructure
+                    _ -> Nothing
+                  handleReq = runWithClaims conf eClaims (app dbStructure proc cols conf) apiRequest
+                  txMode = transactionMode proc (iAction apiRequest)
+              response <- P.use pool $ HT.transaction HT.ReadCommitted txMode handleReq
+              return $ either (errorResponseFor . PgError authed) identity response
+        when (responseStatus response == status503) worker
         respond response
 
-isResponse503 :: Response -> Bool
+transactionMode :: Maybe ProcDescription -> Action -> HT.Mode
-isResponse503 resp = statusCode (responseStatus resp) == 503
+transactionMode proc action =
-
-transactionMode :: DbStructure -> Target -> Action -> H.Mode
-transactionMode structure target action =
   case action of
-    ActionRead -> HT.Read
+    ActionRead _         -> HT.Read
-    ActionInfo -> HT.Read
+    ActionInfo           -> HT.Read
-    ActionInspect -> HT.Read
+    ActionInspect _      -> HT.Read
-    ActionInvoke ->
+    ActionInvoke InvGet  -> HT.Read
-      let proc =
+    ActionInvoke InvHead -> HT.Read
-            case target of
+    ActionInvoke InvPost ->
-              (TargetProc qi) -> M.lookup (qiName qi) $
+      let v = maybe Volatile pdVolatility proc in
-                                   dbProcs structure
-              _               -> Nothing
-          v = fromMaybe Volatile $ pdVolatility <$> proc in
       if v == Stable || v == Immutable
          then HT.Read
          else HT.Write
     _ -> HT.Write
 
-app :: DbStructure -> AppConfig -> ApiRequest -> H.Transaction Response
+app :: DbStructure -> Maybe ProcDescription -> S.Set FieldName -> AppConfig -> ApiRequest -> H.Transaction Response
-app dbStructure conf apiRequest =
+app dbStructure proc cols conf apiRequest =
-  case responseContentTypeOrError (iAccepts apiRequest) (iAction apiRequest) of
+  let rawContentTypes = (decodeContentType <$> configRawMediaTypes conf) `L.union` [ CTOctetStream, CTTextPlain ] in
+  case responseContentTypeOrError (iAccepts apiRequest) rawContentTypes (iAction apiRequest) (iTarget apiRequest) of
     Left errorResponse -> return errorResponse
     Right contentType ->
       case (iAction apiRequest, iTarget apiRequest, iPayload apiRequest) of
 
-        (ActionRead, TargetIdent qi, Nothing) ->
+        (ActionRead headersOnly, TargetIdent (QualifiedIdentifier tSchema tName), Nothing) ->
-          let partsField = (,) <$> readSqlParts
+          case readSqlParts tSchema tName of
-                <*> (binaryField contentType =<< fldNames) in
-          case partsField of
             Left errorResponse -> return errorResponse
-            Right ((q, cq), bField) -> do
+            Right (q, cq, bField) -> do
-              let stm = createReadStatement q cq (contentType == CTSingularJSON) shouldCount
+              let cQuery = if estimatedCount
-                                            (contentType == CTTextCSV) bField
+                             then limitedQuery cq ((+ 1) <$> maxRows) -- LIMIT maxRows + 1 so we can determine below that maxRows was surpassed
-              row <- H.query () stm
+                             else cq
-              let (tableTotal, queryTotal, _ , body) = row
+                  stm = createReadStatement q cQuery (contentType == CTSingularJSON) shouldCount
-                  (status, contentRange) = rangeHeader queryTotal tableTotal
+                        (contentType == CTTextCSV) bField pgVer
-                  canonical = iCanonicalQS apiRequest
+                  explStm = createExplainStatement cq
-              return $
+              row <- H.statement () stm
-                if contentType == CTSingularJSON && queryTotal /= 1
+              let (tableTotal, queryTotal, _ , body, gucHeaders) = row
-                  then singularityError (toInteger queryTotal)
+              case gucHeaders of
-                  else responseLBS status
+                Left _ -> return . errorResponseFor $ GucHeadersError
-                    [toHeader contentType, contentRange,
+                Right ghdrs -> do
-                      ("Content-Location",
+                  total <- if | plannedCount   -> H.statement () explStm
-                        "/" <> toS (qiName qi) <>
+                              | estimatedCount -> if tableTotal > (fromIntegral <$> maxRows)
-                          if BS.null canonical then "" else "?" <> toS canonical
+                                                    then do estTotal <- H.statement () explStm
-                      )
+                                                            pure $ if estTotal > tableTotal then estTotal else tableTotal
-                    ] (toS body)
+                                                    else pure tableTotal
+                              | otherwise      -> pure tableTotal
+                  let (status, contentRange) = rangeStatusHeader topLevelRange queryTotal total
+                      headers = addHeadersIfNotIncluded (catMaybes [
+                                  Just $ toHeader contentType, Just contentRange,
+                                  Just $ contentLocationH tName (iCanonicalQS apiRequest), profileH])
+                                (unwrapGucHeader <$> ghdrs)
+                      rBody = if headersOnly then mempty else toS body
+                  return $
+                    if contentType == CTSingularJSON && queryTotal /= 1
+                      then errorResponseFor . singularityError $ queryTotal
+                      else responseLBS status headers rBody
 
-        (ActionCreate, TargetIdent (QualifiedIdentifier _ table), Just payload@(PayloadJSON rows)) ->
+        (ActionCreate, TargetIdent (QualifiedIdentifier tSchema tName), Just pJson) ->
-          case mutateSqlParts of
+          case mutateSqlParts tSchema tName of
             Left errorResponse -> return errorResponse
             Right (sq, mq) -> do
-              let isSingle = (==1) $ V.length rows
+              let pkCols = tablePKCols dbStructure tSchema tName
-              if contentType == CTSingularJSON
+                  stm = createWriteStatement sq mq
-                 && not isSingle
+                    (contentType == CTSingularJSON) True
-                 && iPreferRepresentation apiRequest == Full
+                    (contentType == CTTextCSV) (iPreferRepresentation apiRequest) pkCols pgVer
-                then return $ singularityError (toInteger $ V.length rows)
+              row <- H.statement (toS $ pjRaw pJson) stm
-                else do
+              let (_, queryTotal, fields, body, gucHeaders) = row
-                  let pKeys = map pkName $ filter (filterPk schema table) allPrKeys -- would it be ok to move primary key detection in the query itself?
+              case gucHeaders of
-                      stm = createWriteStatement sq mq
+                Left _ -> return . errorResponseFor $ GucHeadersError
-                        (contentType == CTSingularJSON) isSingle
+                Right ghdrs -> do
-                        (contentType == CTTextCSV) (iPreferRepresentation apiRequest)
+                  let
-                        pKeys
+                    (ctHeaders, rBody) = if iPreferRepresentation apiRequest == Full
-                  row <- H.query payload stm
+                                          then ([Just $ toHeader contentType, profileH], toS body)
-                  let (_, _, fs, body) = extractQueryResult row
+                                          else ([], mempty)
-                      headers = catMaybes [
+                    headers = addHeadersIfNotIncluded (catMaybes ([
-                          if null fs
+                          if null fields
                             then Nothing
-                            else Just (hLocation, "/" <> toS table <> renderLocationFields fs)
+                            else Just $ locationH tName fields
-                        , if iPreferRepresentation apiRequest == Full
+                        , Just $ contentRangeH 1 0 $ if shouldCount then Just queryTotal else Nothing
-                            then Just $ toHeader contentType
+                        , if null pkCols && isNothing (iOnConflict apiRequest)
-                            else Nothing
+                            then Nothing
-                        , Just . contentRangeH 1 0 $
+                            else (\x -> ("Preference-Applied", show x)) <$> iPreferResolution apiRequest
-                            toInteger <$> if shouldCount then Just (V.length rows) else Nothing
+                        ] ++ ctHeaders)) (unwrapGucHeader <$> ghdrs)
-                        ]
+                  if contentType == CTSingularJSON && queryTotal /= 1
+                    then do
+                      HT.condemn
+                      return . errorResponseFor . singularityError $ queryTotal
+                    else
+                      return $ responseLBS status201 headers rBody
 
-                  return . responseLBS status201 headers $
+        (ActionUpdate, TargetIdent (QualifiedIdentifier tSchema tName), Just pJson) ->
-                    if iPreferRepresentation apiRequest == Full
+          case mutateSqlParts tSchema tName of
-                      then toS body else ""
+            Left errorResponse -> return errorResponse
-
+            Right (sq, mq) -> do
-        (ActionUpdate, TargetIdent _, Just payload@(PayloadJSON rows)) ->
-          case (mutateSqlParts, null <$> rows V.!? 0, iPreferRepresentation apiRequest == Full) of
-            (Left errorResponse, _, _) -> return errorResponse
-            (_, Just True, True) -> return $ responseLBS status200 [contentRangeH 1 0 Nothing] "[]"
-            (_, Just True, False) -> return $ responseLBS status204 [contentRangeH 1 0 Nothing] ""
-            (Right (sq, mq), _, _) -> do
               let stm = createWriteStatement sq mq
                     (contentType == CTSingularJSON) False (contentType == CTTextCSV)
-                    (iPreferRepresentation apiRequest) []
+                    (iPreferRepresentation apiRequest) [] pgVer
-              row <- H.query payload stm
+              row <- H.statement (toS $ pjRaw pJson) stm
-              let (_, queryTotal, _, body) = extractQueryResult row
+              let (_, queryTotal, _, body, gucHeaders) = row
-              if contentType == CTSingularJSON
+              case gucHeaders of
-                 && queryTotal /= 1
+                Left _ -> return . errorResponseFor $ GucHeadersError
-                 && iPreferRepresentation apiRequest == Full
+                Right ghdrs -> do
-                then do
+                  let
-                  HT.condemn
+                    updateIsNoOp = S.null cols
-                  return $ singularityError (toInteger queryTotal)
+                    status | queryTotal == 0 && not updateIsNoOp      = status404
-                else do
+                           | iPreferRepresentation apiRequest == Full = status200
-                  let r = contentRangeH 0 (toInteger $ queryTotal-1)
+                           | otherwise                                = status204
-                            (toInteger <$> if shouldCount then Just queryTotal else Nothing)
+                    contentRangeHeader = contentRangeH 0 (queryTotal - 1) $ if shouldCount then Just queryTotal else Nothing
-                      s = if iPreferRepresentation apiRequest == Full
+                    (ctHeaders, rBody) = if iPreferRepresentation apiRequest == Full
-                            then status200
+                                          then ([Just $ toHeader contentType, profileH], toS body)
-                            else status204
+                                          else ([], mempty)
-                  return $ if iPreferRepresentation apiRequest == Full
+                    headers = addHeadersIfNotIncluded (catMaybes ctHeaders ++ [contentRangeHeader]) (unwrapGucHeader <$> ghdrs)
-                    then responseLBS s [toHeader contentType, r] (toS body)
+                  if contentType == CTSingularJSON && queryTotal /= 1
-                    else responseLBS s [r] ""
+                    then do
+                      HT.condemn
+                      return . errorResponseFor . singularityError $ queryTotal
+                    else
+                      return $ responseLBS status headers rBody
 
-        (ActionDelete, TargetIdent _, Nothing) ->
+        (ActionSingleUpsert, TargetIdent (QualifiedIdentifier tSchema tName), Just ProcessedJSON{pjRaw, pjType, pjKeys}) ->
-          case mutateSqlParts of
+          case mutateSqlParts tSchema tName of
             Left errorResponse -> return errorResponse
             Right (sq, mq) -> do
-              let emptyPayload = PayloadJSON V.empty
+              let isSingle = case pjType of
-                  stm = createWriteStatement sq mq
+                               PJArray len -> len == 1
+                               PJObject    -> True
+                  colNames = colName <$> tableCols dbStructure tSchema tName
+              if topLevelRange /= allRange
+                then return . errorResponseFor $ PutRangeNotAllowedError
+              else if not isSingle
+                then return . errorResponseFor $ PutSingletonError
+              else if S.fromList colNames /= pjKeys
+                then return . errorResponseFor $ PutPayloadIncompleteError
+              else do
+                row <- H.statement (toS pjRaw) $
+                       createWriteStatement sq mq (contentType == CTSingularJSON) False
+                                            (contentType == CTTextCSV) (iPreferRepresentation apiRequest) [] pgVer
+                let (_, queryTotal, _, body, gucHeaders) = row
+                case gucHeaders of
+                  Left _ -> return . errorResponseFor $ GucHeadersError
+                  Right ghdrs -> do
+                    let headers = addHeadersIfNotIncluded (catMaybes [Just $ toHeader contentType, profileH]) (unwrapGucHeader <$> ghdrs)
+                        (status, rBody) = if iPreferRepresentation apiRequest == Full then (status200, toS body) else (status204, mempty)
+                    -- 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
+                    if queryTotal /= 1
+                      then do
+                        HT.condemn
+                        return . errorResponseFor $ PutMatchingPkError
+                      else
+                        return $ responseLBS status headers rBody
+
+        (ActionDelete, TargetIdent (QualifiedIdentifier tSchema tName), Nothing) ->
+          case mutateSqlParts tSchema tName of
+            Left errorResponse -> return errorResponse
+            Right (sq, mq) -> do
+              let stm = createWriteStatement sq mq
                     (contentType == CTSingularJSON) False
                     (contentType == CTTextCSV)
-                    (iPreferRepresentation apiRequest) []
+                    (iPreferRepresentation apiRequest) [] pgVer
-              row <- H.query emptyPayload stm
+              row <- H.statement mempty stm
-              let (_, queryTotal, _, body) = extractQueryResult row
+              let (_, queryTotal, _, body, gucHeaders) = row
-                  r = contentRangeH 1 0 $
+              case gucHeaders of
-                        toInteger <$> if shouldCount then Just queryTotal else Nothing
+                Left _ -> return . errorResponseFor $ GucHeadersError
-              if contentType == CTSingularJSON
+                Right ghdrs -> do
-                 && queryTotal /= 1
+                  let
-                 && iPreferRepresentation apiRequest == Full
+                    status = if iPreferRepresentation apiRequest == Full then status200 else status204
-                then do
+                    contentRangeHeader = contentRangeH 1 0 $ if shouldCount then Just queryTotal else Nothing
-                  HT.condemn
+                    (ctHeaders, rBody) = if iPreferRepresentation apiRequest == Full
-                  return $ singularityError (toInteger queryTotal)
+                                          then ([Just $ toHeader contentType, profileH], toS body)
-                else
+                                          else ([], mempty)
-                  return $ if iPreferRepresentation apiRequest == Full
+                    headers = addHeadersIfNotIncluded (catMaybes ctHeaders ++ [contentRangeHeader]) (unwrapGucHeader <$> ghdrs)
-                    then responseLBS status200 [toHeader contentType, r] (toS body)
+                  if contentType == CTSingularJSON
-                    else responseLBS status204 [r] ""
+                     && queryTotal /= 1
+                    then do
+                      HT.condemn
+                      return . errorResponseFor . singularityError $ queryTotal
+                    else
+                      return $ responseLBS status headers rBody
 
         (ActionInfo, TargetIdent (QualifiedIdentifier tSchema tTable), Nothing) ->
           let mTable = find (\t -> tableName t == tTable && tableSchema t == tSchema) (dbTables dbStructure) in
           case mTable of
             Nothing -> return notFound
             Just table ->
-              let acceptH = (hAllow, if tableInsertable table then "GET,POST,PATCH,DELETE" else "GET") in
+              let allowH = (hAllow, if tableInsertable table then "GET,POST,PATCH,DELETE" else "GET")
-              return $ responseLBS status200 [allOrigins, acceptH] ""
+                  allOrigins = ("Access-Control-Allow-Origin", "*") :: Header in
+              return $ responseLBS status200 [allOrigins, allowH] mempty
 
-        (ActionInvoke, TargetProc qi, Just (PayloadJSON payload)) ->
+        (ActionInvoke invMethod, TargetProc qi@(QualifiedIdentifier tSchema pName) _, Just pJson) ->
-          let proc = M.lookup (qiName qi) allProcs
+          let tName = fromMaybe pName $ procTableName =<< proc in
-              returnsScalar = case proc of
+          case readSqlParts tSchema tName of
-                Just ProcDescription{pdReturnType = (Single (Scalar _))} -> True
-                _ -> False
-              rpcBinaryField = if returnsScalar
-                                 then Right Nothing
-                                 else binaryField contentType =<< fldNames
-              partsField = (,) <$> readSqlParts <*> rpcBinaryField in
-          case partsField of
             Left errorResponse -> return errorResponse
-            Right ((q, cq), bField) -> do
+            Right (q, cq, bField) -> do
-              let p = V.head payload
+              let
-                  singular = contentType == CTSingularJSON
+                preferParams = iPreferParameters apiRequest
-                  paramsAsSingleObject = iPreferSingleObjectParameter apiRequest
+                pq = requestToCallProcQuery qi (specifiedProcArgs cols proc) returnsScalar preferParams
-              row <- H.query () $
+                stm = callProcStatement returnsScalar pq q cq shouldCount (contentType == CTSingularJSON)
-                callProc qi p returnsScalar q cq topLevelRange shouldCount
+                        (contentType == CTTextCSV) (contentType `elem` rawContentTypes) (preferParams == Just MultipleObjects)
-                         singular paramsAsSingleObject
+                        bField pgVer
-                         (contentType == CTTextCSV)
+              row <- H.statement (toS $ pjRaw pJson) stm
-                         (contentType == CTOctetStream) bField
+              let (tableTotal, queryTotal, body, gucHeaders) = row
-              let (tableTotal, queryTotal, body) =
+              case gucHeaders of
-                    fromMaybe (Just 0, 0, "[]") row
+                Left _ -> return . errorResponseFor $ GucHeadersError
-                  (status, contentRange) = rangeHeader queryTotal tableTotal
+                Right ghdrs -> do
-              if singular && queryTotal /= 1
+                  let (status, contentRange) = rangeStatusHeader topLevelRange queryTotal tableTotal
-                then do
+                      headers = addHeadersIfNotIncluded
-                  HT.condemn
+                        (catMaybes [Just $ toHeader contentType, Just contentRange, profileH])
-                  return $ singularityError (toInteger queryTotal)
+                        (unwrapGucHeader <$> ghdrs)
-                else return $ responseLBS status [toHeader contentType, contentRange] (toS body)
+                      rBody = if invMethod == InvHead then mempty else toS body
+                  if contentType == CTSingularJSON && queryTotal /= 1
+                    then do
+                      HT.condemn
+                      return . errorResponseFor . singularityError $ queryTotal
+                    else
+                      return $ responseLBS status headers rBody
 
-        (ActionInspect, TargetRoot, Nothing) -> do
+        (ActionInspect headersOnly, TargetDefaultSpec tSchema, Nothing) -> do
           let host = configHost conf
               port = toInteger $ configPort conf
-              proxy = pickProxy $ toS <$> configProxyUri conf
+              proxy = pickProxy $ toS <$> configOpenAPIProxyUri conf
               uri Nothing = ("http", host, port, "/")
               uri (Just Proxy { proxyScheme = s, proxyHost = h, proxyPort = p, proxyPath = b }) = (s, h, p, b)
               uri' = uri proxy
-              encodeApi ti sd = encodeOpenAPI (M.elems allProcs) (toTableInfo ti) uri' sd (dbPrimaryKeys dbStructure)
+              toTableInfo :: [Table] -> [(Table, [Column], [Text])]
-          body <- encodeApi <$> H.query schema accessibleTables <*> H.query schema schemaDescription
+              toTableInfo = map (\t -> let (s, tn) = (tableSchema t, tableName t) in (t, tableCols dbStructure s tn, tablePKCols dbStructure s tn))
-          return $ responseLBS status200 [toHeader CTOpenAPI] $ toS body
+              encodeApi ti sd procs = encodeOpenAPI (concat $ M.elems procs) (toTableInfo ti) uri' sd $ dbPrimaryKeys dbStructure
+
+          body <- encodeApi <$>
+            H.statement tSchema accessibleTables <*>
+            H.statement tSchema schemaDescription <*>
+            H.statement tSchema accessibleProcs
+          return $ responseLBS status200 (catMaybes [Just $ toHeader CTOpenAPI, profileH]) (if headersOnly then mempty else toS body)
 
         _ -> return notFound
 
-    where
+      where
-      toTableInfo :: [Table] -> [(Table, [Column], [Text])]
+        notFound = responseLBS status404 [] ""
-      toTableInfo = map (\t ->
+        maxRows = configMaxRows conf
-        let tSchema = tableSchema t
+        exactCount = iPreferCount apiRequest == Just ExactCount
-            tTable = tableName t
+        estimatedCount = iPreferCount apiRequest == Just EstimatedCount
-            cols = filter (filterCol tSchema tTable) $ dbColumns dbStructure
+        plannedCount = iPreferCount apiRequest == Just PlannedCount
-            pkeys = map pkName $ filter (filterPk tSchema tTable) allPrKeys
+        shouldCount = exactCount || estimatedCount
-        in (t, cols, pkeys))
+        topLevelRange = iTopLevelRange apiRequest
-      notFound = responseLBS status404 [] ""
+        returnsScalar = maybe False procReturnsScalar proc
-      filterPk sc table pk = sc == (tableSchema . pkTable) pk && table == (tableName . pkTable) pk
+        pgVer = pgVersion dbStructure
-      filterCol :: Schema -> TableName -> Column -> Bool
+        profileH = contentProfileH <$> iProfile apiRequest
-      filterCol sc tb Column{colTable=Table{tableSchema=s, tableName=t}} = s==sc && t==tb
-      allPrKeys = dbPrimaryKeys dbStructure
-      allProcs = dbProcs dbStructure
-      allOrigins = ("Access-Control-Allow-Origin", "*") :: Header
-      shouldCount = iPreferCount apiRequest
-      schema = toS $ configSchema conf
-      topLevelRange = fromMaybe allRange $ M.lookup "limit" $ iRange apiRequest
-      rangeHeader queryTotal tableTotal =
-        let lower = rangeOffset topLevelRange
-            upper = lower + toInteger queryTotal - 1
-            contentRange = contentRangeH lower upper (toInteger <$> tableTotal)
-            status = rangeStatus lower upper (toInteger <$> tableTotal)
-        in (status, contentRange)
 
-      readReq = readRequest (configMaxRows conf) (dbRelations dbStructure) allProcs apiRequest
+        readSqlParts s t =
-      fldNames = fieldNames <$> readReq
+          let
-      readDbRequest = DbRead <$> readReq
+            readReq = readRequest s t maxRows (dbRelations dbStructure) apiRequest
-      mutateDbRequest = DbMutate <$> (mutateRequest apiRequest =<< fldNames)
+          in
-      selectQuery = requestToQuery schema False <$> readDbRequest
+          (,,) <$>
-      mutateQuery = requestToQuery schema False <$> mutateDbRequest
+          (readRequestToQuery <$> readReq) <*>
-      countQuery = requestToCountQuery schema <$> readDbRequest
+          (readRequestToCountQuery <$> readReq) <*>
-      readSqlParts = (,) <$> selectQuery <*> countQuery
+          (binaryField contentType rawContentTypes returnsScalar =<< readReq)
-      mutateSqlParts = (,) <$> selectQuery <*> mutateQuery
 
-responseContentTypeOrError :: [ContentType] -> Action -> Either Response ContentType
+        mutateSqlParts s t =
-responseContentTypeOrError accepts action = serves contentTypesForRequest accepts
+          let
+            readReq = readRequest s t maxRows (dbRelations dbStructure) apiRequest
+            mutReq = mutateRequest s t apiRequest cols (tablePKCols dbStructure s t) =<< readReq
+          in
+          (,) <$>
+          (readRequestToQuery <$> readReq) <*>
+          (mutateRequestToQuery <$> mutReq)
+
+responseContentTypeOrError :: [ContentType] -> [ContentType] -> Action -> Target -> Either Response ContentType
+responseContentTypeOrError accepts rawContentTypes action target = serves contentTypesForRequest accepts
   where
-    contentTypesForRequest =
+    contentTypesForRequest = case action of
-      case action of
+      ActionRead _       ->  [CTApplicationJSON, CTSingularJSON, CTTextCSV]
-        ActionRead ->    [CTApplicationJSON, CTSingularJSON, CTTextCSV, CTOctetStream]
+                             ++ rawContentTypes
-        ActionCreate ->  [CTApplicationJSON, CTSingularJSON, CTTextCSV]
+      ActionCreate       ->  [CTApplicationJSON, CTSingularJSON, CTTextCSV]
-        ActionUpdate ->  [CTApplicationJSON, CTSingularJSON, CTTextCSV]
+      ActionUpdate       ->  [CTApplicationJSON, CTSingularJSON, CTTextCSV]
-        ActionDelete ->  [CTApplicationJSON, CTSingularJSON, CTTextCSV]
+      ActionDelete       ->  [CTApplicationJSON, CTSingularJSON, CTTextCSV]
-        ActionInvoke ->  [CTApplicationJSON, CTSingularJSON, CTTextCSV, CTOctetStream]
+      ActionInvoke _     ->  [CTApplicationJSON, CTSingularJSON, CTTextCSV]
-        ActionInspect -> [CTOpenAPI, CTApplicationJSON]
+                             ++ rawContentTypes
-        ActionInfo ->    [CTTextCSV]
+                             ++ [CTOpenAPI | tpIsRootSpec target]
+      ActionInspect _    ->  [CTOpenAPI, CTApplicationJSON]
+      ActionInfo         ->  [CTTextCSV]
+      ActionSingleUpsert ->  [CTApplicationJSON, CTSingularJSON, CTTextCSV]
     serves sProduces cAccepts =
       case mutuallyAgreeable sProduces cAccepts of
-        Nothing -> do
+        Nothing -> Left . errorResponseFor . ContentTypeError . map toMime $ cAccepts
-          let failed = intercalate ", " $ map (toS . toMime) cAccepts
-          Left $ simpleError status415 [] $
-            "None of these Content-Types are available: " <> failed
         Just ct -> Right ct
 
-binaryField :: ContentType -> [FieldName] -> Either Response (Maybe FieldName)
+{-
-binaryField CTOctetStream fldNames =
+  | If raw(binary) output is requested, check that ContentType is one of the admitted rawContentTypes and that
-  if length fldNames == 1 && fieldName /= Just "*"
+  | `?select=...` contains only one field other than `*`
-    then Right fieldName
+-}
-    else Left binaryFieldError
+binaryField :: ContentType -> [ContentType] -> Bool -> ReadRequest -> Either Response (Maybe FieldName)
+binaryField ct rawContentTypes isScalarProc readReq
+  | isScalarProc = Right Nothing
+  | ct `elem` rawContentTypes =
+      let fieldName = headMay fldNames in
+      if length fldNames == 1 && fieldName /= Just "*"
+        then Right fieldName
+        else Left . errorResponseFor $ BinaryFieldError ct
+  | otherwise = Right Nothing
   where
-    fieldName = headMay fldNames
+    fldNames = fstFieldNames readReq
-binaryField _ _ = Right Nothing
 
-splitKeyValue :: BS.ByteString -> (BS.ByteString, BS.ByteString)
+locationH :: TableName -> [BS.ByteString] -> Header
-splitKeyValue kv = (k, BS.tail v)
+locationH tName fields =
-  where (k, v) = BS.break (== '=') kv
+  let
+    locationFields = renderSimpleQuery True $ splitKeyValue <$> fields
+  in
+    (hLocation, "/" <> toS tName <> locationFields)
+  where
+    splitKeyValue :: BS.ByteString -> (BS.ByteString, BS.ByteString)
+    splitKeyValue kv =
+      let (k, v) = BS.break (== '=') kv
+      in (k, BS.tail v)
 
-renderLocationFields :: [BS.ByteString] -> BS.ByteString
+contentLocationH :: TableName -> ByteString -> Header
-renderLocationFields fields =
+contentLocationH tName qString =
-  renderSimpleQuery True $ map splitKeyValue fields
+  ("Content-Location", "/" <> toS tName <> if BS.null qString then mempty else "?" <> toS qString)
 
-rangeStatus :: Integer -> Integer -> Maybe Integer -> Status
+contentProfileH :: Schema -> Header
-rangeStatus _ _ Nothing = status200
+contentProfileH schema =
-rangeStatus lower upper (Just total)
+   ("Content-Profile", toS schema)
-  | lower > total            = status416
-  | (1 + upper - lower) < total = status206
-  | otherwise               = status200
-
-contentRangeH :: Integer -> Integer -> Maybe Integer -> Header
-contentRangeH lower upper total =
-    ("Content-Range", headerValue)
-    where
-      headerValue   = rangeString <> "/" <> totalString
-      rangeString
-        | totalNotZero && fromInRange = show lower <> "-" <> show upper
-        | otherwise = "*"
-      totalString   = fromMaybe "*" (show <$> total)
-      totalNotZero  = fromMaybe True ((/=) 0 <$> total)
-      fromInRange   = lower <= upper
-
-extractQueryResult :: Maybe ResultsWithCount -> ResultsWithCount
-extractQueryResult = fromMaybe (Nothing, 0, [], "")

src/PostgREST/Auth.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE LambdaCase       #-}
 {-|
 Module      : PostgREST.Auth
 Description : PostgREST authorization functions.
@@ -15,78 +16,98 @@ module PostgREST.Auth (
     containsRole
   , jwtClaims
   , JWTAttempt(..)
-  , parseJWK
+  , parseSecret
   ) where
 
-import           Protolude        hiding ((&))
+import qualified Crypto.JOSE.Types   as JOSE.Types
-import           Control.Lens
+import qualified Data.Aeson          as JSON
-import           Data.Aeson              (Value (..), decode, toJSON)
+import qualified Data.HashMap.Strict as M
-import qualified Data.ByteString.Lazy    as BL
+import           Data.Vector         as V
-import qualified Data.HashMap.Strict     as M
 
-import           Crypto.JOSE.Compact
+import Control.Lens    (set)
-import           Crypto.JOSE.JWK
+import Data.Time.Clock (UTCTime)
-import           Crypto.JOSE.JWS
+
-import           Crypto.JOSE.Types
+import Control.Lens.Operators
-import           Crypto.JWT
+import Crypto.JWT
+
+import PostgREST.Types
+import Protolude
 
 {-|
   Possible situations encountered with client JWTs
 -}
 data JWTAttempt = JWTInvalid JWTError
                 | JWTMissingSecret
-                | JWTClaims (M.HashMap Text Value)
+                | JWTClaims (M.HashMap Text JSON.Value)
                 deriving (Eq, Show)
 
 {-|
-  Receives the JWT secret (from config) and a JWT and returns a map
+  Receives the JWT secret and audience (from config) and a JWT and returns a map
   of JWT claims.
 -}
-jwtClaims :: Maybe JWK -> BL.ByteString -> IO JWTAttempt
+jwtClaims :: Maybe JWKSet -> Maybe StringOrURI -> LByteString -> UTCTime -> Maybe JSPath -> IO JWTAttempt
-jwtClaims _ "" = return $ JWTClaims M.empty
+jwtClaims _ _ "" _ _ = return $ JWTClaims M.empty
-jwtClaims secret payload =
+jwtClaims secret audience payload time jspath =
   case secret of
     Nothing -> return JWTMissingSecret
-    Just jwk -> do
+    Just s -> do
-      let validation = defaultJWTValidationSettings
+      let validation = set allowedSkew 1 $ defaultJWTValidationSettings (maybe (const True) (==) audience)
       eJwt <- runExceptT $ do
         jwt <- decodeCompact payload
-        validateJWSJWT validation jwk jwt
+        verifyClaimsAt validation s time jwt
-        return jwt
       return $ case eJwt of
-        Left e -> JWTInvalid e
+        Left e    -> JWTInvalid e
-        Right jwt -> JWTClaims . claims2map . jwtClaimsSet $ jwt
+        Right jwt -> JWTClaims $ claims2map jwt jspath
+
+{-|
+  Turn JWT ClaimSet into something easier to work with,
+  also here the jspath is applied to put the "role" in the map
+-}
+claims2map :: ClaimsSet -> Maybe JSPath -> M.HashMap Text JSON.Value
+claims2map claims jspath = (\case
+    val@(JSON.Object o) ->
+      let role = maybe M.empty (M.singleton "role") $
+                 walkJSPath (Just val) =<< jspath in
+      M.delete "role" o `M.union` role -- mutating the map
+    _ -> M.empty
+  ) $ JSON.toJSON claims
+
+walkJSPath :: Maybe JSON.Value -> JSPath -> Maybe JSON.Value
+walkJSPath x                      []                = x
+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
 
 {-|
   Whether a response from jwtClaims contains a role claim
 -}
 containsRole :: JWTAttempt -> Bool
 containsRole (JWTClaims claims) = M.member "role" claims
-containsRole _ = False
+containsRole _                  = False
 
 {-|
-  Internal helper used to turn JWT ClaimSet into something
+  Parse `jwt-secret` configuration option and turn into a JWKSet.
-  easier to work with
+
+  There are three ways to specify `jwt-secret`: text secret, JSON Web Key
+  (JWK), or JSON Web Key Set (JWKS). The first two are converted into a JWKSet
+  with one key and the last is converted as is.
 -}
-claims2map :: ClaimsSet -> M.HashMap Text Value
+parseSecret :: ByteString -> JWKSet
-claims2map = val2map . toJSON
+parseSecret str =
+  fromMaybe (maybe secret (\jwk' -> JWKSet [jwk']) maybeJWK)
+    maybeJWKSet
  where
-  val2map (Object o) = o
+  maybeJWKSet = JSON.decode (toS str) :: Maybe JWKSet
-  val2map _ = M.empty
+  maybeJWK = JSON.decode (toS str) :: Maybe JWK
-
+  secret = JWKSet [jwkFromSecret str]
-parseJWK :: ByteString -> JWK
-parseJWK str =
-  fromMaybe (hs256jwk str) (decode (toS str) :: Maybe JWK)
 
 {-|
-  Internal helper to generate HMAC-SHA256. When the jwt key in the
+  Internal helper to generate a symmetric HMAC-SHA256 JWK from a text secret.
-  config file is a simple string rather than a JWK object, we'll
-  apply this function to it.
 -}
-hs256jwk :: ByteString -> JWK
+jwkFromSecret :: ByteString -> JWK
-hs256jwk key =
+jwkFromSecret key =
   fromKeyMaterial km
-    & jwkUse .~ Just Sig
+    & jwkUse ?~ Sig
-    & jwkAlg .~ (Just $ JWSAlg HS256)
+    & jwkAlg ?~ JWSAlg HS256
  where
-  km = OctKeyMaterial (OctKeyParameters Oct (Base64Octets key))
+  km = OctKeyMaterial (OctKeyParameters (JOSE.Types.Base64Octets key))

src/PostgREST/Config.hs

@@ -1,4 +1,3 @@
-{-# OPTIONS_GHC -fno-warn-type-defaults #-}
 {-|
 Module      : PostgREST.Config
 Description : Manages PostgREST configuration options.
@@ -13,61 +12,97 @@ turned in configurable behaviour if needed.
 
 Other hardcoded options such as the minimum version number also belong here.
 -}
+{-# LANGUAGE LambdaCase          #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TemplateHaskell     #-}
+{-# OPTIONS_GHC -fno-warn-type-defaults #-}
+
 module PostgREST.Config ( prettyVersion
+                        , docsVersion
                         , readOptions
                         , corsPolicy
-                        , minimumPgVersion
-                        , PgVersion (..)
                         , AppConfig (..)
+                        , configPoolTimeout'
                         )
        where
 
-import           System.IO.Error             (IOError)
+import qualified Data.ByteString              as B
-import           Control.Applicative
+import qualified Data.ByteString.Char8        as BS
-import qualified Data.ByteString             as B
+import qualified Data.CaseInsensitive         as CI
-import qualified Data.ByteString.Char8       as BS
+import qualified Data.Configurator            as C
-import qualified Data.CaseInsensitive        as CI
-import qualified Data.Configurator           as C
-import qualified Data.Configurator.Parser    as C
-import           Data.Configurator.Types     (Value(..))
-import           Data.List                   (lookup)
-import           Data.Monoid
-import           Data.Scientific             (floatingOrInteger)
-import           Data.Text                   (strip, intercalate, lines)
-import           Data.Text.Encoding          (encodeUtf8)
-import           Data.Text.IO                (hPutStrLn)
-import           Data.Version                (versionBranch)
-import           Network.Wai
-import           Network.Wai.Middleware.Cors (CorsResourcePolicy (..))
-import           Options.Applicative hiding  (str)
-import           Paths_postgrest             (version)
-import           System.IO                   (hPrint)
-import           Text.Heredoc
-import           Text.PrettyPrint.ANSI.Leijen hiding ((<>), (<$>))
 import qualified Text.PrettyPrint.ANSI.Leijen as L
-import           Protolude hiding            (intercalate, (<>), hPutStrLn)
+
+import Control.Exception           (Handler (..))
+import Control.Lens                (preview)
+import Control.Monad               (fail)
+import Crypto.JWT                  (StringOrURI, stringOrUri)
+import Data.List                   (lookup)
+import Data.List.NonEmpty          (NonEmpty, fromList)
+import Data.Scientific             (floatingOrInteger)
+import Data.Text                   (dropEnd, dropWhileEnd,
+                                    intercalate, lines, splitOn,
+                                    strip, take, unpack)
+import Data.Text.Encoding          (encodeUtf8)
+import Data.Text.IO                (hPutStrLn)
+import Data.Version                (versionBranch)
+import Development.GitRev          (gitHash)
+import Network.Wai.Middleware.Cors (CorsResourcePolicy (..))
+import Numeric                     (readOct)
+import Paths_postgrest             (version)
+import System.IO.Error             (IOError)
+import System.Posix.Types          (FileMode)
+
+import Control.Applicative
+import Data.Monoid
+import Network.Wai
+import Options.Applicative          hiding (str)
+import Text.Heredoc
+import Text.PrettyPrint.ANSI.Leijen hiding ((<$>), (<>))
+
+import PostgREST.Error   (ApiRequestError (..))
+import PostgREST.Parsers (pRoleClaimKey)
+import PostgREST.Types   (JSPath, JSPathExp (..))
+import Protolude         hiding (concat, hPutStrLn, intercalate, null,
+                          take, (<>))
+
+
 
 -- | Config file settings for the server
 data AppConfig = AppConfig {
     configDatabase          :: Text
   , configAnonRole          :: Text
-  , configProxyUri          :: Maybe Text
+  , configOpenAPIProxyUri   :: Maybe Text
-  , configSchema            :: Text
+  , configSchemas           :: NonEmpty Text
   , configHost              :: Text
   , configPort              :: Int
+  , configSocket            :: Maybe FilePath
+  , configSocketMode        :: Either Text FileMode
 
   , configJwtSecret         :: Maybe B.ByteString
   , configJwtSecretIsBase64 :: Bool
+  , configJwtAudience       :: Maybe StringOrURI
 
   , configPool              :: Int
+  , configPoolTimeout       :: Int
   , configMaxRows           :: Maybe Integer
   , configReqCheck          :: Maybe Text
   , configQuiet             :: Bool
+  , configSettings          :: [(Text, Text)]
+  , configRoleClaimKey      :: Either ApiRequestError JSPath
+  , configExtraSearchPath   :: [Text]
+
+  , configRootSpec          :: Maybe Text
+  , configRawMediaTypes     :: [B.ByteString]
   }
 
+configPoolTimeout' :: (Fractional a) => AppConfig -> a
+configPoolTimeout' =
+  fromRational . toRational . configPoolTimeout
+
+
 defaultCorsPolicy :: CorsResourcePolicy
 defaultCorsPolicy =  CorsResourcePolicy Nothing
-  ["GET", "POST", "PATCH", "DELETE", "OPTIONS"] ["Authorization"] Nothing
+  ["GET", "POST", "PATCH", "PUT", "DELETE", "OPTIONS"] ["Authorization"] Nothing
   (Just $ 60*60*24) False False True
 
 -- | CORS policy to be used in by Wai Cors middleware
@@ -90,7 +125,13 @@ corsPolicy req = case lookup "origin" headers of
 
 -- | User friendly version number
 prettyVersion :: Text
-prettyVersion = intercalate "." $ map show $ versionBranch version
+prettyVersion =
+  intercalate "." (map show $ versionBranch version)
+  <> " (" <> take 7 $(gitHash) <> ")"
+
+-- | Version number used in docs
+docsVersion :: Text
+docsVersion = "v" <> dropEnd 1 (dropWhileEnd (/= '.') prettyVersion)
 
 -- | Function to read and parse options from the command line
 readOptions :: IO AppConfig
@@ -98,99 +139,172 @@ readOptions = do
   -- First read the config file path from command line
   cfgPath <- customExecParser parserPrefs opts
   -- Now read the actual config file
-  conf <- catch
+  conf <- catches (C.load cfgPath)
-    (C.readConfig =<< C.load [C.Required cfgPath])
+    [ Handler (\(ex :: IOError)    -> exitErr $ "Cannot open config file:\n\t" <> show ex)
-    configNotfoundHint
+    , Handler (\(C.ParseError err) -> exitErr $ "Error parsing config file:\n" <> err)
+    ]
 
-  let (mAppConf, errs) = flip C.runParserA conf $
+  case C.runParser parseConfig conf of
-        AppConfig <$>
+    Left err ->
-            C.key "db-uri"
+      exitErr $ "Error parsing config file:\n\t" <> err
-          <*> C.key "db-anon-role"
+    Right appConf ->
-          <*> C.key "server-proxy-uri"
-          <*> C.key "db-schema"
-          <*> (fromMaybe "*4" . mfilter (/= "") <$> C.key "server-host")
-          <*> (fromMaybe 3000 . join . fmap coerceInt <$> C.key "server-port")
-          <*> (fmap encodeUtf8 . mfilter (/= "") <$> C.key "jwt-secret")
-          <*> (fromMaybe False . join . fmap coerceBool <$> C.key "secret-is-base64")
-          <*> (fromMaybe 10 . join . fmap coerceInt <$> C.key "db-pool")
-          <*> (join . fmap coerceInt <$> C.key "max-rows")
-          <*> (mfilter (/= "") <$> C.key "pre-request")
-          <*> pure False
-
-  case mAppConf of
-    Nothing -> do
-      forM_ errs $ hPrint stderr
-      exitFailure
-    Just appConf ->
       return appConf
 
- where
+  where
-  coerceInt :: (Read i, Integral i) => Value -> Maybe i
+    parseConfig =
-  coerceInt (Number x) = rightToMaybe $ floatingOrInteger x
+      AppConfig
-  coerceInt (String x) = readMaybe $ toS x
+        <$> reqString "db-uri"
-  coerceInt _ = Nothing
+        <*> reqString "db-anon-role"
+        <*> optString "server-proxy-uri"
+        <*> (fromList . splitOnCommas <$> reqValue "db-schema")
+        <*> (fromMaybe "!4" <$> optString "server-host")
+        <*> (fromMaybe 3000 <$> optInt "server-port")
+        <*> (fmap unpack <$> optString "server-unix-socket")
+        <*> parseSocketFileMode "server-unix-socket-mode"
+        <*> (fmap encodeUtf8 <$> optString "jwt-secret")
+        <*> (fromMaybe False <$> optBool "secret-is-base64")
+        <*> parseJwtAudience "jwt-aud"
+        <*> (fromMaybe 10 <$> optInt "db-pool")
+        <*> (fromMaybe 10 <$> optInt "db-pool-timeout")
+        <*> optInt "max-rows"
+        <*> optString "pre-request"
+        <*> pure False
+        <*> (fmap (fmap coerceText) <$> C.subassocs "app.settings" C.value)
+        <*> (maybe (Right [JSPKey "role"]) parseRoleClaimKey <$> optValue "role-claim-key")
+        <*> (maybe ["public"] splitOnCommas <$> optValue "db-extra-search-path")
+        <*> optString "root-spec"
+        <*> (maybe [] (fmap encodeUtf8 . splitOnCommas) <$> optValue "raw-media-types")
 
-  coerceBool ::  Value -> Maybe Bool
+    parseSocketFileMode :: C.Key -> C.Parser C.Config (Either Text FileMode)
-  coerceBool (Bool b) = Just b
+    parseSocketFileMode k =
-  coerceBool (String x) = readMaybe $ toS x
+      C.optional k C.string >>= \case
-  coerceBool _ = Nothing
+        Nothing -> pure $ Right 432 -- return default 660 mode if no value was provided
+        Just fileModeText ->
+          case (readOct . unpack) fileModeText of
+            []              ->
+              pure $ Left "Invalid server-unix-socket-mode: not an octal"
+            (fileMode, _):_ ->
+              if fileMode < 384 || fileMode > 511
+                then pure $ Left "Invalid server-unix-socket-mode: needs to be between 600 and 777"
+                else pure $ Right fileMode
 
-  opts = info (helper <*> pathParser) $
+    parseJwtAudience :: C.Key -> C.Parser C.Config (Maybe StringOrURI)
-           fullDesc
+    parseJwtAudience k =
-           <> progDesc (
+      C.optional k C.string >>= \case
-               "PostgREST "
+        Nothing -> pure Nothing -- no audience in config file
-               <> toS prettyVersion
+        Just aud -> case preview stringOrUri (unpack aud) of
-               <> " / create a REST API to an existing Postgres database"
+          Nothing -> fail "Invalid Jwt audience. Check your configuration."
-             )
+          (Just "") -> pure Nothing
-           <> footerDoc (Just $
+          aud' -> pure aud'
-               text "Example Config File:"
-               L.<> nest 2 (hardline L.<> exampleCfg)
-             )
 
-  parserPrefs = prefs showHelpOnError
+    reqString :: C.Key -> C.Parser C.Config Text
+    reqString k = C.required k C.string
 
-  configNotfoundHint :: IOError -> IO a
+    reqValue :: C.Key -> C.Parser C.Config C.Value
-  configNotfoundHint e = do
+    reqValue k = C.required k C.value
-    hPutStrLn stderr $
-      "Cannot open config file:\n\t" <> show e
-    exitFailure
 
-  exampleCfg :: Doc
+    optString :: C.Key -> C.Parser C.Config (Maybe Text)
-  exampleCfg = vsep . map (text . toS) . lines $
+    optString k = mfilter (/= "") <$> C.optional k C.string
-    [str|db-uri = "postgres://user:pass@localhost:5432/dbname"
+
-        |db-schema = "public"
+    optValue :: C.Key -> C.Parser C.Config (Maybe C.Value)
-        |db-anon-role = "postgres"
+    optValue k = C.optional k C.value
-        |db-pool = 10
+
-        |
+    optInt :: (Read i, Integral i) => C.Key -> C.Parser C.Config (Maybe i)
-        |server-host = "*4"
+    optInt k = join <$> C.optional k (coerceInt <$> C.value)
-        |server-port = 3000
+
-        |
+    optBool :: C.Key -> C.Parser C.Config (Maybe Bool)
-        |## base url for swagger output
+    optBool k = join <$> C.optional k (coerceBool <$> C.value)
-        |# server-proxy-uri = ""
+
-        |
+    coerceText :: C.Value -> Text
-        |## choose a secret to enable JWT auth
+    coerceText (C.String s) = s
-        |## (use "@filename" to load from separate file)
+    coerceText v            = show v
-        |# jwt-secret = "foo"
+
-        |# secret-is-base64 = false
+    coerceInt :: (Read i, Integral i) => C.Value -> Maybe i
-        |
+    coerceInt (C.Number x) = rightToMaybe $ floatingOrInteger x
-        |## limit rows in response
+    coerceInt (C.String x) = readMaybe $ toS x
-        |# max-rows = 1000
+    coerceInt _            = Nothing
-        |
+
-        |## stored proc to exec immediately after auth
+    coerceBool :: C.Value -> Maybe Bool
-        |# pre-request = "stored_proc_name"
+    coerceBool (C.Bool b)   = Just b
-        |]
+    coerceBool (C.String b) = readMaybe $ toS b
+    coerceBool _            = Nothing
+
+    parseRoleClaimKey :: C.Value -> Either ApiRequestError JSPath
+    parseRoleClaimKey (C.String s) = pRoleClaimKey s
+    parseRoleClaimKey v            = pRoleClaimKey $ show v
+
+    splitOnCommas :: C.Value -> [Text]
+    splitOnCommas (C.String s) = strip <$> splitOn "," s
+    splitOnCommas _            = []
+
+    opts = info (helper <*> pathParser) $
+             fullDesc
+             <> progDesc (
+                 "PostgREST "
+                 <> toS prettyVersion
+                 <> " / create a REST API to an existing Postgres database"
+               )
+             <> footerDoc (Just $
+                 text "Example Config File:"
+                 L.<> nest 2 (hardline L.<> exampleCfg)
+               )
+
+    parserPrefs = prefs showHelpOnError
+
+    exitErr :: Text -> IO a
+    exitErr err = do
+      hPutStrLn stderr err
+      exitFailure
+
+    exampleCfg :: Doc
+    exampleCfg = vsep . map (text . toS) . lines $
+      [str|db-uri = "postgres://user:pass@localhost:5432/dbname"
+          |db-schema = "public" # this schema gets added to the search_path of every request
+          |db-anon-role = "postgres"
+          |db-pool = 10
+          |db-pool-timeout = 10
+          |
+          |server-host = "!4"
+          |server-port = 3000
+          |
+          |## unix socket location
+          |## if specified it takes precedence over server-port
+          |# server-unix-socket = "/tmp/pgrst.sock"
+          |## unix socket file mode
+          |## when none is provided, 660 is applied by default
+          |# server-unix-socket-mode = "660"
+          |
+          |## base url for swagger 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"
+          |# secret-is-base64 = false
+          |# jwt-aud = "your_audience_claim"
+          |
+          |## limit rows in response
+          |# max-rows = 1000
+          |
+          |## stored proc to exec immediately after auth
+          |# pre-request = "stored_proc_name"
+          |
+          |## jspath to the role claim key
+          |# role-claim-key = ".role"
+          |
+          |## extra schemas to add to the search_path of every request
+          |# db-extra-search-path = "extensions, util"
+          |
+          |## stored proc that overrides the root "/" spec
+          |## it must be inside the db-schema
+          |# root-spec = "stored_proc_name"
+          |
+          |## content types to produce raw output
+          |# raw-media-types="image/png, image/jpg"
+          |]
 
 pathParser :: Parser FilePath
 pathParser =
   strArgument $
     metavar "FILENAME" <>
     help "Path to configuration file"
-
-data PgVersion = PgVersion {
-  pgvNum  :: Int32
-, pgvName :: Text
-}
-
--- | Tells the minimum PostgreSQL version required by this version of PostgREST
-minimumPgVersion :: PgVersion
-minimumPgVersion = PgVersion 90300 "9.3"

src/PostgREST/DbRequestBuilder.hs

@@ -1,208 +1,230 @@
-{-# LANGUAGE FlexibleContexts #-}
+{-|
-{-# LANGUAGE DuplicateRecordFields    #-}
+Module      : PostgREST.DbRequestBuilder
+Description : PostgREST database request builder
+
+This module is in charge of building an intermediate representation(ReadRequest, MutateRequest) between the HTTP request and the final resulting SQL query.
+
+A query tree is built in case of resource embedding. By inferring the relationship between tables, join conditions are added for every embedded resource.
+-}
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE FlexibleContexts      #-}
+{-# LANGUAGE LambdaCase            #-}
+{-# LANGUAGE NamedFieldPuns        #-}
+
 module PostgREST.DbRequestBuilder (
   readRequest
 , mutateRequest
-, fieldNames
 ) where
 
-import           Control.Applicative
+import qualified Data.HashMap.Strict as M
-import           Control.Arrow             ((***))
+import qualified Data.Set            as S
-import           Control.Lens.Getter       (view)
-import           Control.Lens.Tuple        (_1)
-import qualified Data.ByteString.Char8     as BS
-import           Data.List                 (delete)
-import           Data.Maybe                (fromJust)
-import           Data.Text                 (isInfixOf)
-import           Data.Tree
-import           Data.Either.Combinators   (mapLeft)
 
-import           Network.Wai
+import Control.Arrow           ((***))
+import Data.Either.Combinators (mapLeft)
+import Data.Foldable           (foldr1)
+import Data.List               (delete)
+import Data.Text               (isInfixOf)
 
-import           Data.Foldable (foldr1)
+import Control.Applicative
-import qualified Data.HashMap.Strict       as M
+import Data.Tree
+import Network.Wai
 
-import           PostgREST.ApiRequest   ( ApiRequest(..)
+import PostgREST.ApiRequest (Action (..), ApiRequest (..))
-                                        , PreferRepresentation(..)
+import PostgREST.Error      (ApiRequestError (..), errorResponseFor)
-                                        , Action(..), Target(..)
+import PostgREST.Parsers
-                                        , PreferRepresentation (..)
+import PostgREST.RangeQuery (NonnegRange, allRange, restrictRange)
-                                        )
+import PostgREST.Types
-import           PostgREST.Error           (apiRequestError)
+import Protolude            hiding (from)
-import           PostgREST.Parsers
-import           PostgREST.RangeQuery      (NonnegRange, restrictRange)
-import           PostgREST.QueryBuilder (getJoinFilters, sourceCTEName)
-import           PostgREST.Types
 
-import           Protolude                hiding (from, dropWhile, drop)
+readRequest :: Schema -> TableName -> Maybe Integer -> [Relation] -> ApiRequest -> Either Response ReadRequest
-import           Text.Regex.TDFA         ((=~))
+readRequest schema rootTableName maxRows allRels apiRequest  =
-import           Unsafe                  (unsafeHead)
+  mapLeft errorResponseFor $
-
-readRequest :: Maybe Integer -> [Relation] -> M.HashMap Text ProcDescription -> ApiRequest -> Either Response ReadRequest
-readRequest maxRows allRels allProcs apiRequest  =
-  mapLeft apiRequestError $
   treeRestrictRange maxRows =<<
-  augumentRequestWithJoin schema relations =<<
+  augumentRequestWithJoin schema rootRels =<<
-  parseReadRequest
+  addFiltersOrdersRanges apiRequest <*>
+  (initReadRequest rootName <$> pRequestSelect sel)
   where
-    (schema, rootTableName) = fromJust $ -- Make it safe
+    sel = fromMaybe "*" $ iSelect apiRequest -- default to all columns requested (SELECT *) for a non existent ?select querystring param
-      let target = iTarget apiRequest in
+    (rootName, rootRels) = rootWithRels schema rootTableName allRels (iAction apiRequest)
-      case target of
-        (TargetIdent (QualifiedIdentifier s t) ) -> Just (s, t)
-        (TargetProc  (QualifiedIdentifier s proc) ) -> Just (s, tName)
-          where
-            retType = pdReturnType <$> M.lookup proc allProcs
-            tName = case retType of
-              Just (SetOf (Composite qi)) -> qiName qi
-              Just (Single (Composite qi)) -> qiName qi
-              _ -> proc
 
-        _ -> Nothing
+-- Get the root table name with its relationships according to the Action type.
+-- 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 -> [Relation] -> Action -> (QualifiedIdentifier, [Relation])
+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
+    -- To enable embedding in the sourceCTEName cases we need to replace the foreign key tableName in the Relation
+    -- with {sourceCTEName}. This way findRel can find relationships with sourceCTEName.
+    toSourceRel :: Relation -> Maybe Relation
+    toSourceRel r@Relation{relTable=t}
+      | rootTableName == tableName t = Just $ r {relTable=t {tableName=sourceCTEName}}
+      | otherwise                    = Nothing
 
-    action :: Action
+-- Build the initial tree with a Depth attribute so when a self join occurs we can differentiate the parent and child tables by having
-    action = iAction apiRequest
+-- an alias like "table_depth", this is related to http://github.com/PostgREST/postgrest/issues/987.
-
+initReadRequest :: QualifiedIdentifier -> [Tree SelectItem] -> ReadRequest
-    parseReadRequest :: Either ApiRequestError ReadRequest
+initReadRequest rootQi =
-    parseReadRequest = addFiltersOrdersRanges apiRequest <*>
+  foldr (treeEntry rootDepth) initial
-      pRequestSelect rootName selStr
+  where
-      where
+    rootDepth = 0
-        selStr = iSelect apiRequest
+    rootSchema = qiSchema rootQi
-        rootName = if action == ActionRead
+    rootName = qiName rootQi
-          then rootTableName
+    initial = Node (Select [] rootQi Nothing [] [] [] [] allRange, (rootName, Nothing, Nothing, Nothing, rootDepth)) []
-          else sourceCTEName
+    treeEntry :: Depth -> Tree SelectItem -> ReadRequest -> ReadRequest
-
+    treeEntry depth (Node fld@((fn, _),_,alias, embedHint) fldForest) (Node (q, i) rForest) =
-    relations :: [Relation]
+      let nxtDepth = succ depth in
-    relations = case action of
+      case fldForest of
-      ActionCreate -> fakeSourceRelations ++ allRels
+        [] -> Node (q {select=fld:select q}, i) rForest
-      ActionUpdate -> fakeSourceRelations ++ allRels
+        _  -> Node (q, i) $
-      ActionDelete -> fakeSourceRelations ++ allRels
+              foldr (treeEntry nxtDepth)
-      ActionInvoke -> fakeSourceRelations ++ allRels
+              (Node (Select [] (QualifiedIdentifier rootSchema fn) Nothing [] [] [] [] allRange,
-      _       -> allRels
+                (fn, Nothing, alias, embedHint, nxtDepth)) [])
-      where fakeSourceRelations = mapMaybe (toSourceRelation rootTableName) allRels -- see comment in toSourceRelation
+              fldForest:rForest
 
 treeRestrictRange :: Maybe Integer -> ReadRequest -> Either ApiRequestError ReadRequest
-treeRestrictRange maxRows_ request = pure $ nodeRestrictRange maxRows_ `fmap` 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)
 
-augumentRequestWithJoin :: Schema ->  [Relation] ->  ReadRequest -> Either ApiRequestError ReadRequest
+augumentRequestWithJoin :: Schema -> [Relation] -> ReadRequest -> Either ApiRequestError ReadRequest
 augumentRequestWithJoin schema allRels request =
-  addRelations schema allRels Nothing request
+  addRels schema allRels Nothing request
-  >>= addJoinFilters schema
+  >>= addJoinConditions Nothing
 
-addRelations :: Schema -> [Relation] -> Maybe ReadRequest -> ReadRequest -> Either ApiRequestError ReadRequest
+addRels :: Schema -> [Relation] -> Maybe ReadRequest -> ReadRequest -> Either ApiRequestError ReadRequest
-addRelations schema allRelations parentNode (Node readNode@(query, (name, _, alias, relationDetail)) forest) =
+addRels schema allRels parentNode (Node (query@Select{from=tbl}, (nodeName, _, alias, hint, depth)) forest) =
   case parentNode of
-    (Just (Node (Select{from=[parentNodeTable]}, (_, _, _, _)) _)) ->
+    Just (Node (Select{from=parentNodeQi}, _) _) ->
-      Node <$> readNode' <*> forest'
+      let newFrom r = if qiName tbl == nodeName then tableQi (relFTable r) else tbl
-      where
+          newReadNode = (\r -> (query{from=newFrom r}, (nodeName, Just r, alias, Nothing, depth))) <$> rel
-        forest' = updateForest $ hush node'
+          rel = findRel schema allRels (qiName parentNodeQi) nodeName hint
-        node' = Node <$> readNode' <*> pure forest
+      in
-        readNode' = addRel readNode <$> rel
+      Node <$> newReadNode <*> (updateForest . hush $ Node <$> newReadNode <*> pure forest)
-        rel :: Either ApiRequestError Relation
+    _ ->
-        rel = note (NoRelationBetween parentNodeTable name)
+      let rn = (query, (nodeName, Nothing, alias, Nothing, depth)) in
-            $ findRelation schema name parentNodeTable relationDetail
+      Node rn <$> updateForest (Just $ Node rn forest)
-            where
-              
-              findRelation s nodeTableName parentNodeTableName Nothing =
-                find (\r ->
-                  s == tableSchema (relTable r) && -- match schema for relation table
-                  s == tableSchema (relFTable r) && -- match schema for relation foriegn table
-                  (
-
-                    -- (request)        => projects { ..., clients{...} }
-                    -- will match
-                    -- (relation type)  => parent
-                    -- (entity)         => clients  {id}
-                    -- (foriegn entity) => projects {client_id}
-                    (
-                      nodeTableName == tableName (relTable r) && -- match relation table name
-                      parentNodeTableName == tableName (relFTable r) -- match relation foreign table name
-                    ) ||
-
-
-                    -- (request)        => projects { ..., client_id{...} }
-                    -- will match
-                    -- (relation type)  => parent
-                    -- (entity)         => clients  {id}
-                    -- (foriegn entity) => projects {client_id}
-                    (
-                      parentNodeTableName == tableName (relFTable r) &&
-                      length (relFColumns r) == 1 &&
-                      nodeTableName `colMatches` (colName . unsafeHead . relFColumns) r
-                    )
-
-                    -- (request)        => project_id { ..., client_id{...} }
-                    -- will match
-                    -- (relation type)  => parent
-                    -- (entity)         => clients  {id}
-                    -- (foriegn entity) => projects {client_id}
-                    -- this case works becasue before reaching this place
-                    -- addRelation will turn project_id to project so the above condition will match
-                  )
-                ) allRelations
-              
-              findRelation s nodeTableName parentNodeTableName (Just rd) = 
-                find (\r ->
-                  s == tableSchema (relTable r) && -- match schema for relation table
-                  s == tableSchema (relFTable r) && -- match schema for relation foriegn table
-                  (
-
-                    -- (request)        => clients { ..., project.client_id{...} }
-                    -- will match
-                    -- (relation type)  => parent
-                    -- (entity)         => clients  {id}
-                    -- (foriegn entity) => projects {client_id}
-                    (
-                      nodeTableName == tableName (relTable r) && -- match relation table name
-                      parentNodeTableName == tableName (relFTable r) && -- && -- match relation foreign table name
-                      length (relColumns r) == 1 &&
-                      rd == (colName . unsafeHead . relColumns) r
-                    ) 
-                    ||
-
-
-                    -- (request)        => tasks { ..., users.tasks_users{...} }
-                    -- will match
-                    -- (relation type)  => many
-                    -- (entity)         => users
-                    -- (foriegn entity) => tasks
-                    (
-                      relType r == Many &&
-                      nodeTableName == tableName (relTable r) && -- match relation table name
-                      parentNodeTableName == tableName (relFTable r) && -- match relation foreign table name
-                      rd == tableName (fromJust (relLTable r))
-                    ) 
-                  )
-                ) allRelations
-              n `colMatches` rc = (toS ("^" <> rc <> "_?(?:|[iI][dD]|[fF][kK])$") :: BS.ByteString) =~ (toS n :: BS.ByteString)
-        addRel :: (ReadQuery, (NodeName, Maybe Relation, Maybe Alias, Maybe RelationDetail)) -> Relation -> (ReadQuery, (NodeName, Maybe Relation, Maybe Alias, Maybe RelationDetail))
-        addRel (query', (n, _, a, _)) r = (query' {from=fromRelation}, (n, Just r, a, Nothing))
-          where fromRelation = map (\t -> if t == n then tableName (relTable r) else t) (from query')
-
-    _ -> n' <$> updateForest (Just (n' forest))
-      where
-        n' = Node (query, (name, Just r, alias, Nothing))
-        t = Table schema name Nothing True -- !!! TODO find another way to get the table from the query
-        r = Relation t [] t [] Root Nothing Nothing Nothing
   where
     updateForest :: Maybe ReadRequest -> Either ApiRequestError [ReadRequest]
-    updateForest n = mapM (addRelations schema allRelations n) forest
+    updateForest rq = mapM (addRels schema allRels rq) forest
 
-addJoinFilters :: Schema -> ReadRequest -> Either ApiRequestError ReadRequest
+-- Finds a relationship between an origin and a target in the request: /origin?select=target(*)
-addJoinFilters schema (Node node@(query, nodeProps@(_, relation, _, _)) forest) =
+-- If more than one relationship is found then the request is ambiguous and we return an error.
-  case relation of
+-- In that case the request can be disambiguated by adding precision to the target or by using a hint: /origin?select=target!hint(*)
-    Just Relation{relType=Root} -> Node node  <$> updatedForest -- this is the root node
+-- The elements will be matched according to these rules:
-    Just Relation{relType=Parent} -> Node node <$> updatedForest
+-- origin = table / view
-    Just rel@Relation{relType=Child} -> Node (augmentQuery rel, nodeProps) <$> updatedForest
+-- target = table / view / constraint / column-from-origin
-    Just rel@Relation{relType=Many, relLTable=(Just linkTable)} ->
+-- hint   = table / view / constraint / column-from-origin / column-from-target
-      let rq = augmentQuery rel in
+-- (hint can take table / view values to aid in finding the junction in an m2m relationship)
-      Node (rq{from=tableName linkTable:from rq}, nodeProps) <$> updatedForest
+findRel :: Schema -> [Relation] -> NodeName -> NodeName -> Maybe EmbedHint -> Either ApiRequestError Relation
-    _ -> Left UnknownRelation
+findRel schema allRels origin target hint =
+  case rel of
+    []  -> Left $ NoRelBetween origin target
+    [r] -> Right r
+    rs  ->
+      -- Return error if more than one relationship is found, unless we're in a self reference case.
+      --
+      -- 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.
+      let [rel0, rel1] = take 2 rs in
+      if length rs == 2 && relConstraint rel0 == relConstraint rel1 && relTable rel0 == relTable rel1 && relFTable rel0 == relFTable rel1
+        then note (NoRelBetween origin target) (find (\r -> relType r == O2M) rs)
+        else Left $ AmbiguousRelBetween origin target rs
   where
-    updatedForest = mapM (addJoinFilters schema) forest
+    matchFKSingleCol hint_ cols = length cols == 1 && hint_ == (colName <$> head cols)
-    augmentQuery rel = foldr addFilterToReadQuery query (getJoinFilters rel)
+    rel = filter (
-    addFilterToReadQuery flt rq@Select{where_=lf} = rq{where_=addFilterToLogicForest flt lf}::ReadQuery
+      \Relation{relTable, relColumns, relConstraint, relFTable, relFColumns, relType, relJunction} ->
+        -- Both relationship ends need to be on the exposed schema
+        schema == tableSchema relTable && schema == tableSchema relFTable &&
+        (
+          -- /projects?select=clients(*)
+          origin == tableName relTable  &&  -- projects
+          target == tableName relFTable ||  -- clients
+
+          -- /projects?select=projects_client_id_fkey(*)
+          (
+            origin == tableName relTable && -- projects
+            Just target == relConstraint    -- projects_client_id_fkey
+          ) ||
+          -- /projects?select=client_id(*)
+          (
+            origin == tableName relTable &&           -- projects
+            matchFKSingleCol (Just target) relColumns -- client_id
+          )
+        ) && (
+          isNothing hint || -- hint is optional
+
+          -- /projects?select=clients!projects_client_id_fkey(*)
+          hint == relConstraint             || -- projects_client_id_fkey
+
+          -- /projects?select=clients!client_id(*) or /projects?select=clients!id(*)
+          matchFKSingleCol hint relColumns  || -- client_id
+          matchFKSingleCol hint relFColumns || -- id
+
+          -- /users?select=tasks!users_tasks(*)
+          (
+            relType == M2M &&                              -- many-to-many between users and tasks
+            hint == (tableName . junTable <$> relJunction) -- 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@Relation{relType=O2M} -> Node (augmentQuery r, nodeProps) <$> updatedForest
+    Just r@Relation{relType=M2O} -> Node (augmentQuery r, nodeProps) <$> updatedForest
+    Just r@Relation{relType=M2M, relJunction=junction} ->
+      case junction of
+        Just Junction{junTable} ->
+          let rq = augmentQuery r in
+          Node (rq{implicitJoins=tableQi junTable:implicitJoins rq}, nodeProps) <$> updatedForest
+        Nothing ->
+          Left UnknownRelation
+    Nothing -> Node node <$> updatedForest
+  where
+    newAlias = case isSelfReference <$> rel of
+      Just True
+        | depth /= 0 -> Just (qiName tbl <> "_" <> show depth) -- root node doesn't get aliased
+        | otherwise  -> Nothing
+      _              -> Nothing
+    augmentQuery r =
+      foldr
+        (\jc rq@Select{joinConditions=jcs} -> rq{joinConditions=jc:jcs})
+        query{fromAlias=newAlias}
+        (getJoinConditions previousAlias newAlias r)
+    updatedForest = mapM (addJoinConditions newAlias) forest
+
+-- previousAlias and newAlias are used in the case of self joins
+getJoinConditions :: Maybe Alias -> Maybe Alias -> Relation -> [JoinCondition]
+getJoinConditions previousAlias newAlias (Relation Table{tableSchema=tSchema, tableName=tN} cols _ Table{tableName=ftN} fCols typ jun) =
+  case typ of
+    O2M ->
+        zipWith (toJoinCondition tN ftN) cols fCols
+    M2O ->
+        zipWith (toJoinCondition tN ftN) cols fCols
+    M2M -> case jun of
+        Just (Junction jt _ jc1 _ jc2) ->
+          let jtn = tableName jt in
+          zipWith (toJoinCondition tN jtn) cols jc1 ++ zipWith (toJoinCondition ftN jtn) fCols jc2
+        Nothing -> []
+  where
+    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)
+
+    -- On mutation and calling proc cases we wrap the target table in a WITH {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 == sourceCTEName then mempty else schema) tbl
 
 addFiltersOrdersRanges :: ApiRequest -> Either ApiRequestError (ReadRequest -> ReadRequest)
 addFiltersOrdersRanges apiRequest = foldr1 (liftA2 (.)) [
@@ -213,7 +235,7 @@ addFiltersOrdersRanges apiRequest = foldr1 (liftA2 (.)) [
   ]
   {-
   The esence of what is going on above is that we are composing tree functions
-  of type (ReadRequest->ReadRequest) that are in (Either ParseError a) context
+  of type (ReadRequest->ReadRequest) that are in (Either ApiRequestError a) context
   -}
   where
     filters :: Either ApiRequestError [(EmbedPath, Filter)]
@@ -222,9 +244,11 @@ addFiltersOrdersRanges apiRequest = foldr1 (liftA2 (.)) [
     logicForest = mapM pRequestLogicTree logFrst
     action = iAction apiRequest
     -- there can be no filters on the root table when we are doing insert/update/delete
-    (flts, logFrst)
+    (flts, logFrst) =
-      | action == ActionRead || action == ActionInvoke = (iFilters apiRequest, iLogic apiRequest)
+      case action of
-      | otherwise = join (***) (filter (( "." `isInfixOf` ) . fst)) (iFilters apiRequest, iLogic apiRequest)
+        ActionInvoke _ -> (iFilters apiRequest, iLogic apiRequest)
+        ActionRead _   -> (iFilters apiRequest, iLogic apiRequest)
+        _              -> join (***) (filter (( "." `isInfixOf` ) . fst)) (iFilters apiRequest, iLogic apiRequest)
     orders :: Either ApiRequestError [(EmbedPath, [OrderTerm])]
     orders = mapM pRequestOrder $ iOrder apiRequest
     ranges :: Either ApiRequestError [(EmbedPath, NonnegRange)]
@@ -237,7 +261,7 @@ addFilter :: (EmbedPath, Filter) -> ReadRequest -> ReadRequest
 addFilter = addProperty addFilterToNode
 
 addOrderToNode :: [OrderTerm] -> ReadRequest -> ReadRequest
-addOrderToNode o (Node (q,i) f) = Node (q{order=Just o}, i) f
+addOrderToNode o (Node (q,i) f) = Node (q{order=o}, i) f
 
 addOrder :: (EmbedPath, [OrderTerm]) -> ReadRequest -> ReadRequest
 addOrder = addProperty addOrderToNode
@@ -255,54 +279,43 @@ addLogicTree :: (EmbedPath, LogicTree) -> ReadRequest -> ReadRequest
 addLogicTree = addProperty addLogicTreeToNode
 
 addProperty :: (a -> ReadRequest -> ReadRequest) -> (EmbedPath, a) -> ReadRequest -> ReadRequest
-addProperty f ([], a) n = f a n
+addProperty f ([], a) rr = f a rr
-addProperty f (path, a) (Node rn forest) =
+addProperty f (targetNodeName:remainingPath, a) (Node rn forest) =
-  case targetNode of
+  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:restForest)
+    Just tn -> Node rn (addProperty f (remainingPath, a) tn:delete tn forest)
   where
-    targetNodeName:remainingPath = path
+    pathNode = find (\(Node (_,(nodeName,_,alias,_,_)) _) -> nodeName == targetNodeName || alias == Just targetNodeName) forest
-    (targetNode,restForest) = splitForest targetNodeName forest
-    splitForest :: NodeName -> Forest ReadNode -> (Maybe ReadRequest, Forest ReadNode)
-    splitForest name forst =
-      case maybeNode of
-        Nothing -> (Nothing,forest)
-        Just node -> (Just node, delete node forest)
-      where
-        maybeNode :: Maybe ReadRequest
-        maybeNode = find fnd forst
-          where
-            fnd :: ReadRequest -> Bool
-            fnd (Node (_,(n,_,_,_)) _) = n == name
 
--- in a relation where one of the tables mathces "TableName"
+mutateRequest :: Schema -> TableName -> ApiRequest -> S.Set FieldName -> [FieldName] -> ReadRequest -> Either Response MutateRequest
--- replace the name to that table with pg_source
+mutateRequest schema tName apiRequest cols pkCols readReq = mapLeft errorResponseFor $
--- this "fake" relations is needed so that in a mutate query
--- we can look a the "returning *" part which is wrapped with a "with"
--- as just another table that has relations with other tables
-toSourceRelation :: TableName -> Relation -> Maybe Relation
-toSourceRelation mt r@(Relation t _ ft _ _ rt _ _)
-  | mt == tableName t = Just $ r {relTable=t {tableName=sourceCTEName}}
-  | mt == tableName ft = Just $ r {relFTable=t {tableName=sourceCTEName}}
-  | Just mt == (tableName <$> rt) = Just $ r {relLTable=(\tbl -> tbl {tableName=sourceCTEName}) <$> rt}
-  | otherwise = Nothing
-
-mutateRequest :: ApiRequest -> [FieldName] -> Either Response MutateRequest
-mutateRequest apiRequest fldNames = mapLeft apiRequestError $
   case action of
-    ActionCreate -> Right $ Insert rootTableName payload returnings
+    ActionCreate -> do
-    ActionUpdate -> Update rootTableName <$> pure payload <*> combinedLogic <*> pure returnings
+        confCols <- case iOnConflict apiRequest of
-    ActionDelete -> Delete rootTableName <$> combinedLogic <*> pure returnings
+            Nothing    -> pure pkCols
-    _        -> Left UnsupportedVerb
+            Just param -> pRequestOnConflict param
+        pure $ Insert qi cols ((,) <$> iPreferResolution apiRequest <*> Just confCols) [] returnings
+    ActionUpdate -> Update qi cols <$> combinedLogic <*> pure returnings
+    ActionSingleUpsert ->
+      (\flts ->
+        if null (iLogic apiRequest) &&
+           S.fromList (fst <$> iFilters apiRequest) == S.fromList pkCols &&
+           not (null (S.fromList pkCols)) &&
+           all (\case
+              Filter _ (OpExpr False (Op "eq" _)) -> True
+              _ -> False) flts
+          then Insert qi cols (Just (MergeDuplicates, pkCols)) <$> combinedLogic <*> pure returnings
+        else
+          Left InvalidFilters) =<< filters
+    ActionDelete -> Delete qi <$> combinedLogic <*> pure returnings
+    _            -> Left UnsupportedVerb
   where
+    qi = QualifiedIdentifier schema tName
     action = iAction apiRequest
-    payload = fromJust $ iPayload apiRequest
+    returnings =
-    rootTableName = -- TODO: Make it safe
+      if iPreferRepresentation apiRequest == None
-      let target = iTarget apiRequest in
+        then []
-      case target of
+        else returningCols readReq
-        (TargetIdent (QualifiedIdentifier _ t) ) -> t
-        _ -> undefined
-    returnings = if iPreferRepresentation apiRequest == None then [] else fldNames
     filters = map snd <$> mapM pRequestFilter mutateFilters
     logic = map snd <$> mapM pRequestLogicTree logicFilters
     combinedLogic = foldr addFilterToLogicForest <$> logic <*> filters
@@ -310,13 +323,26 @@ mutateRequest apiRequest fldNames = mapLeft apiRequestError $
     (mutateFilters, logicFilters) = join (***) onlyRoot (iFilters apiRequest, iLogic apiRequest)
     onlyRoot = filter (not . ( "." `isInfixOf` ) . fst)
 
-fieldNames :: ReadRequest -> [FieldName]
+returningCols :: ReadRequest -> [FieldName]
-fieldNames (Node (sel, _) forest) =
+returningCols rr@(Node _ forest) = returnings
-  map (fst . view _1) (select sel) ++ map colName fks
   where
-    fks = concatMap (fromMaybe [] . f) forest
+    fldNames = fstFieldNames rr
-    f (Node (_, (_, Just Relation{relFColumns=cols, relType=Parent}, _, _)) _) = Just cols
+    -- Without fkCols, when a mutateRequest to /projects?select=name,clients(name) occurs, the RETURNING SQL part would be
-    f _ = Nothing
+    -- `RETURNING name`(see QueryBuilder).
+    -- This would make the embedding fail because the following JOIN would need the "client_id" column from projects.
+    -- So this adds the foreign key columns to ensure the embedding succeeds, result would be `RETURNING name, client_id`.
+    -- This also works for the other relType's.
+    fkCols = concat $ mapMaybe (\case
+        Node (_, (_, Just Relation{relColumns=cols, relType=relTyp}, _, _, _)) _ -> case relTyp of
+          O2M -> Just cols
+          M2O -> Just cols
+          M2M -> Just cols
+        _ -> Nothing
+      ) forest
+    -- However if the "client_id" is present, e.g. mutateRequest to /projects?select=client_id,name,clients(name)
+    -- we would get `RETURNING client_id, name, client_id` and then we would produce the "column reference \"client_id\" is ambiguous"
+    -- error from PostgreSQL. So we deduplicate with Set:
+    returnings = S.toList . S.fromList $ fldNames ++ (colName <$> fkCols)
 
 -- 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/DbStructure.hs

@@ -1,177 +1,215 @@
+{-|
+Module      : PostgREST.DbStructure
+Description : PostgREST schema cache
+
+This module contains queries that target PostgreSQL system catalogs, these are used to build the schema cache(DbStructure).
+
+The schema cache is necessary for resource embedding, foreign keys are used for inferring the relationships between tables.
+
+These queries are executed once at startup or when PostgREST is reloaded.
+-}
 {-# LANGUAGE FlexibleContexts      #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE NamedFieldPuns        #-}
 {-# LANGUAGE QuasiQuotes           #-}
 {-# LANGUAGE ScopedTypeVariables   #-}
 {-# LANGUAGE TypeSynonymInstances  #-}
 module PostgREST.DbStructure (
   getDbStructure
 , accessibleTables
+, accessibleProcs
 , schemaDescription
+, getPgVersion
 ) where
 
-import qualified Hasql.Decoders                as HD
+import qualified Data.HashMap.Strict as M
-import qualified Hasql.Encoders                as HE
+import qualified Data.List           as L
-import qualified Hasql.Query                   as H
+import qualified Data.Text           as T
+import qualified Hasql.Decoders      as HD
+import qualified Hasql.Encoders      as HE
+import qualified Hasql.Session       as H
+import qualified Hasql.Statement     as H
+import qualified Hasql.Transaction   as HT
 
-import           Control.Applicative
+import Data.Set                      as S (fromList)
-import qualified Data.HashMap.Strict           as M
+import Data.Text                     (breakOn, dropAround, split,
-import           Data.List                     (elemIndex)
+                                      splitOn, strip)
-import           Data.Maybe                    (fromJust)
+import GHC.Exts                      (groupWith)
-import           Data.Text                     (split, strip,
+import Text.InterpolatedString.Perl6 (q, qc)
-                                                breakOn, dropAround)
+import Unsafe                        (unsafeHead)
-import qualified Data.Text                     as T
-import qualified Hasql.Session                 as H
-import           PostgREST.Types
-import           Text.InterpolatedString.Perl6 (q)
 
-import           GHC.Exts                      (groupWith)
+import Control.Applicative
-import           Protolude
-import           Unsafe (unsafeHead)
 
-getDbStructure :: Schema -> H.Session DbStructure
+import PostgREST.Private.Common
-getDbStructure schema = do
+import PostgREST.Types
-  tabs <- H.query () allTables
+import Protolude
-  cols <- H.query () $ allColumns tabs
-  syns <- H.query () $ allSynonyms cols
-  rels <- H.query () $ allRelations tabs cols
-  keys <- H.query () $ allPrimaryKeys tabs
-  procs <- H.query schema accessibleProcs
 
-  let rels' = (addManyToManyRelations . raiseRelations schema syns . addParentRelations . addSynonymousRelations syns) rels
+getDbStructure :: [Schema] -> PgVersion -> HT.Transaction DbStructure
-      cols' = addForeignKeys rels' cols
+getDbStructure schemas pgVer = do
-      keys' = synonymousPrimaryKeys syns keys
+  HT.sql "set local schema ''" -- This voids the search path. The following queries need this for getting the fully qualified name(schema.name) of every db object
+  tabs    <- HT.statement () allTables
+  cols    <- HT.statement schemas $ allColumns tabs
+  srcCols <- HT.statement schemas $ allSourceColumns cols pgVer
+  m2oRels <- HT.statement () $ allM2ORels tabs cols
+  keys    <- HT.statement () $ allPrimaryKeys tabs
+  procs   <- HT.statement schemas allProcs
+
+  let rels = addM2MRels . addO2MRels $ addViewM2ORels srcCols m2oRels
+      cols' = addForeignKeys rels cols
+      keys' = addViewPrimaryKeys srcCols keys
 
   return DbStructure {
       dbTables = tabs
     , dbColumns = cols'
-    , dbRelations = rels'
+    , dbRelations = rels
     , dbPrimaryKeys = keys'
     , dbProcs = procs
+    , pgVersion = pgVer
     }
 
 decodeTables :: HD.Result [Table]
 decodeTables =
-  HD.rowsList tblRow
+  HD.rowList tblRow
  where
-  tblRow = Table <$> HD.value HD.text
+  tblRow = Table <$> column HD.text
-                 <*> HD.value HD.text
+                 <*> column HD.text
-                 <*> HD.nullableValue HD.text
+                 <*> nullableColumn HD.text
-                 <*> HD.value HD.bool
+                 <*> column HD.bool
 
 decodeColumns :: [Table] -> HD.Result [Column]
 decodeColumns tables =
-  mapMaybe (columnFromRow tables) <$> HD.rowsList colRow
+  mapMaybe (columnFromRow tables) <$> HD.rowList colRow
  where
   colRow =
     (,,,,,,,,,,,)
-      <$> HD.value HD.text <*> HD.value HD.text
+      <$> column HD.text <*> column HD.text
-      <*> HD.value HD.text <*> HD.nullableValue HD.text
+      <*> column HD.text <*> nullableColumn HD.text
-      <*> HD.value HD.int4 <*> HD.value HD.bool
+      <*> column HD.int4 <*> column HD.bool
-      <*> HD.value HD.text <*> HD.value HD.bool
+      <*> column HD.text <*> column HD.bool
-      <*> HD.nullableValue HD.int4
+      <*> nullableColumn HD.int4
-      <*> HD.nullableValue HD.int4
+      <*> nullableColumn HD.int4
-      <*> HD.nullableValue HD.text
+      <*> nullableColumn HD.text
-      <*> HD.nullableValue HD.text
+      <*> nullableColumn HD.text
 
-decodeRelations :: [Table] -> [Column] -> HD.Result [Relation]
+decodeRels :: [Table] -> [Column] -> HD.Result [Relation]
-decodeRelations tables cols =
+decodeRels tables cols =
-  mapMaybe (relationFromRow tables cols) <$> HD.rowsList relRow
+  mapMaybe (relFromRow tables cols) <$> HD.rowList relRow
  where
-  relRow = (,,,,,)
+  relRow = (,,,,,,)
-    <$> HD.value HD.text
+    <$> column HD.text
-    <*> HD.value HD.text
+    <*> column HD.text
-    <*> HD.value (HD.array (HD.arrayDimension replicateM (HD.arrayValue HD.text)))
+    <*> column HD.text
-    <*> HD.value HD.text
+    <*> column (HD.array (HD.dimension replicateM (element HD.text)))
-    <*> HD.value HD.text
+    <*> column HD.text
-    <*> HD.value (HD.array (HD.arrayDimension replicateM (HD.arrayValue HD.text)))
+    <*> column HD.text
+    <*> column (HD.array (HD.dimension replicateM (element HD.text)))
 
 decodePks :: [Table] -> HD.Result [PrimaryKey]
 decodePks tables =
-  mapMaybe (pkFromRow tables) <$> HD.rowsList pkRow
+  mapMaybe (pkFromRow tables) <$> HD.rowList pkRow
  where
-  pkRow = (,,) <$> HD.value HD.text <*> HD.value HD.text <*> HD.value HD.text
+  pkRow = (,,) <$> column HD.text <*> column HD.text <*> column HD.text
 
-decodeSynonyms :: [Column] -> HD.Result [(Column,Column)]
+decodeSourceColumns :: [Column] -> HD.Result [SourceColumn]
-decodeSynonyms cols =
+decodeSourceColumns cols =
-  mapMaybe (synonymFromRow cols) <$> HD.rowsList synRow
+  mapMaybe (sourceColumnFromRow cols) <$> HD.rowList srcColRow
  where
-  synRow = (,,,,,)
+  srcColRow = (,,,,,)
-    <$> HD.value HD.text <*> HD.value HD.text
+    <$> column HD.text <*> column HD.text
-    <*> HD.value HD.text <*> HD.value HD.text
+    <*> column HD.text <*> column HD.text
-    <*> HD.value HD.text <*> HD.value HD.text
+    <*> column HD.text <*> column HD.text
 
-accessibleProcs :: H.Query Schema (M.HashMap Text ProcDescription)
+sourceColumnFromRow :: [Column] -> (Text,Text,Text,Text,Text,Text) -> Maybe SourceColumn
-accessibleProcs =
+sourceColumnFromRow allCols (s1,t1,c1,s2,t2,c2) = (,) <$> col1 <*> col2
-  H.statement sql (HE.value HE.text)
+  where
-    (M.fromList . map addName <$>
+    col1 = findCol s1 t1 c1
-      HD.rowsList (
+    col2 = findCol s2 t2 c2
-        ProcDescription <$> HD.value HD.text
+    findCol s t c = find (\col -> (tableSchema . colTable) col == s && (tableName . colTable) col == t && colName col == c) allCols
-                        <*> HD.nullableValue HD.text
-                        <*> (parseArgs <$> HD.value HD.text)
-                        <*> (parseRetType <$>
-                            HD.value HD.text <*>
-                            HD.value HD.text <*>
-                            HD.value HD.bool <*>
-                            HD.value HD.char)
-                        <*> (parseVolatility <$>
-                            HD.value HD.char)
-      )
-    ) True
- where
-  addName :: ProcDescription -> (Text, ProcDescription)
-  addName pd = (pdName pd, pd)
 
-  parseArgs :: Text -> [PgArg]
+decodeProcs :: HD.Result ProcsMap
-  parseArgs = mapMaybe (parseArg . strip) . split (==',')
+decodeProcs =
+  -- Duplicate rows for a function means they're overloaded, order these by least args according to ProcDescription Ord instance
+  map sort . M.fromListWith (++) . map ((\(x,y) -> (x, [y])) . addKey) <$> HD.rowList procRow
+  where
+    procRow = ProcDescription
+              <$> column HD.text
+              <*> column HD.text
+              <*> nullableColumn HD.text
+              <*> (parseArgs <$> column HD.text)
+              <*> (parseRetType
+                  <$> column HD.text
+                  <*> column HD.text
+                  <*> column HD.bool
+                  <*> column HD.char)
+              <*> (parseVolatility <$> column HD.char)
 
-  parseArg :: Text -> Maybe PgArg
+    addKey :: ProcDescription -> (QualifiedIdentifier, ProcDescription)
-  parseArg a =
+    addKey pd = (QualifiedIdentifier (pdSchema pd) (pdName pd), pd)
-    let (body, def) = breakOn " DEFAULT " a
-        (name, typ) = breakOn " " body in
-    if T.null typ
-       then Nothing
-       else Just $
-         PgArg (dropAround (== '"') name) (strip typ) (T.null def)
 
-  parseRetType :: Text -> Text -> Bool -> Char -> RetType
+    parseArgs :: Text -> [PgArg]
-  parseRetType schema name isSetOf typ
+    parseArgs = mapMaybe parseArg . filter (not . isPrefixOf "OUT" . toS) . map strip . split (==',')
-    | isSetOf   = SetOf pgType
-    | otherwise = Single pgType
-    where
-      qi = QualifiedIdentifier schema name
-      pgType = case typ of
-        'c' -> Composite qi
-        'p' -> if name == "record" -- Only pg pseudo type that is a row type is 'record'
-                 then Composite qi
-                 else Scalar qi
-        _   -> Scalar qi -- 'b'ase, 'd'omain, 'e'num, 'r'ange
 
-  parseVolatility :: Char -> ProcVolatility
+    parseArg :: Text -> Maybe PgArg
-  parseVolatility 'i' = Immutable
+    parseArg a =
-  parseVolatility 's' = Stable
+      let arg = lastDef "" $ splitOn "INOUT " a
-  parseVolatility 'v' = Volatile
+          (body, def) = breakOn " DEFAULT " arg
-  parseVolatility _   = Volatile -- should not happen, but be pessimistic
+          (name, typ) = breakOn " " body in
+      if T.null typ
+         then Nothing
+         else Just $
+           PgArg (dropAround (== '"') name) (strip typ) (T.null def)
 
-  sql = [q|
+    parseRetType :: Text -> Text -> Bool -> Char -> RetType
-  SELECT p.proname as "proc_name",
+    parseRetType schema name isSetOf typ
-         d.description as "proc_description",
+      | isSetOf   = SetOf pgType
-         pg_get_function_arguments(p.oid) as "args",
+      | otherwise = Single pgType
-         tn.nspname as "rettype_schema",
+      where
-         coalesce(comp.relname, t.typname) as "rettype_name",
+        qi = QualifiedIdentifier schema name
-         p.proretset as "rettype_is_setof",
+        pgType = case typ of
-         t.typtype as "rettype_typ",
+          'c' -> Composite qi
-         p.provolatile
+          'p' -> if name == "record" -- Only pg pseudo type that is a row type is 'record'
+                   then Composite qi
+                   else Scalar qi
+          _   -> Scalar qi -- 'b'ase, 'd'omain, 'e'num, 'r'ange
+
+    parseVolatility :: Char -> ProcVolatility
+    parseVolatility v | v == 'i' = Immutable
+                      | v == 's' = Stable
+                      | otherwise = Volatile -- only 'v' can happen here
+
+allProcs :: H.Statement [Schema] ProcsMap
+allProcs = H.Statement (toS sql) (arrayParam HE.text) decodeProcs True
+  where
+    sql = procsSqlQuery <> " WHERE pn.nspname = ANY($1)"
+
+accessibleProcs :: H.Statement Schema ProcsMap
+accessibleProcs = H.Statement (toS sql) (param HE.text) decodeProcs True
+  where
+    sql = procsSqlQuery <> " WHERE pn.nspname = $1 AND has_function_privilege(p.oid, 'execute')"
+
+procsSqlQuery :: SqlQuery
+procsSqlQuery = [q|
+  SELECT
+    pn.nspname as "proc_schema",
+    p.proname as "proc_name",
+    d.description as "proc_description",
+    pg_get_function_arguments(p.oid) as "args",
+    tn.nspname as "rettype_schema",
+    coalesce(comp.relname, t.typname) as "rettype_name",
+    p.proretset as "rettype_is_setof",
+    t.typtype as "rettype_typ",
+    p.provolatile
   FROM pg_proc p
     JOIN pg_namespace pn ON pn.oid = p.pronamespace
     JOIN pg_type t ON t.oid = p.prorettype
     JOIN pg_namespace tn ON tn.oid = t.typnamespace
     LEFT JOIN pg_class comp ON comp.oid = t.typrelid
     LEFT JOIN pg_catalog.pg_description as d on d.objoid = p.oid
-  WHERE  pn.nspname = $1|]
+|]
 
-schemaDescription :: H.Query Schema (Maybe Text)
+schemaDescription :: H.Statement Schema (Maybe Text)
 schemaDescription =
-    H.statement sql (HE.value HE.text) (HD.singleRow $ HD.nullableValue HD.text) True
+    H.Statement sql (param HE.text) (join <$> HD.rowMaybe (nullableColumn HD.text)) True
   where
     sql = [q|
       select
@@ -182,9 +220,9 @@ schemaDescription =
       where
         n.nspname = $1 |]
 
-accessibleTables :: H.Query Schema [Table]
+accessibleTables :: H.Statement Schema [Table]
 accessibleTables =
-  H.statement sql (HE.value HE.text) decodeTables True
+  H.Statement sql (param HE.text) decodeTables True
  where
   sql = [q|
     select
@@ -202,7 +240,7 @@ accessibleTables =
       join pg_namespace n on n.oid = c.relnamespace
       left join pg_catalog.pg_description as d on d.objoid = c.oid and d.objsubid = 0
     where
-      c.relkind in ('v', 'r', 'm')
+      c.relkind in ('v', 'r', 'm', 'f')
       and n.nspname = $1
       and (
         pg_has_role(c.relowner, 'USAGE'::text)
@@ -211,86 +249,125 @@ accessibleTables =
       )
     order by relname |]
 
-synonymousColumns :: [(Column,Column)] -> [Column] -> [[Column]]
-synonymousColumns allSyns cols = synCols'
-  where
-    syns = case headMay cols of
-            Just firstCol -> sort $ filter ((== colTable firstCol) . colTable . fst) allSyns
-            Nothing -> []
-    synCols  = transpose $ map (\c -> map snd $ filter ((== c) . fst) syns) cols
-    synCols' = (filter sameTable . filter matchLength) synCols
-    matchLength cs = length cols == length cs
-    sameTable (c:cs) = all (\cc -> colTable c == colTable cc) (c:cs)
-    sameTable [] = False
-
 addForeignKeys :: [Relation] -> [Column] -> [Column]
 addForeignKeys rels = map addFk
   where
     addFk col = col { colFK = fk col }
-    fk col = join $ relToFk col <$> find (lookupFn col) rels
+    fk col = find (lookupFn col) rels >>= relToFk col
     lookupFn :: Column -> Relation -> Bool
-    lookupFn c Relation{relColumns=cs, relType=rty} = c `elem` cs && rty==Child
+    lookupFn c Relation{relColumns=cs, relType=rty} = c `elem` cs && rty==M2O
     relToFk col Relation{relColumns=cols, relFColumns=colsF} = do
-      pos <- elemIndex col cols
+      pos <- L.elemIndex col cols
       colF <- atMay colsF pos
       return $ ForeignKey colF
 
-addSynonymousRelations :: [(Column,Column)] -> [Relation] -> [Relation]
+{-
-addSynonymousRelations _ [] = []
+Adds Views M2O Relations based on SourceColumns found, the logic is as follows:
-addSynonymousRelations syns (rel:rels) = rel : synRelsP ++ synRelsF ++ addSynonymousRelations syns rels
-  where
-    synRelsP = synRels (relColumns rel) (\t cs -> rel{relTable=t,relColumns=cs})
-    synRelsF = synRels (relFColumns rel) (\t cs -> rel{relFTable=t,relFColumns=cs})
-    synRels cols mapFn = map (\cs -> mapFn (colTable $ unsafeHead cs) cs) $ synonymousColumns syns cols
 
-addParentRelations :: [Relation] -> [Relation]
+Having a Relation{relTable=t1, relColumns=[c1], relFTable=t2, relFColumns=[c2], relType=M2O} represented by:
-addParentRelations [] = []
-addParentRelations (rel@(Relation t c ft fc _ _ _ _):rels) = Relation ft fc t c Parent Nothing Nothing Nothing : rel : addParentRelations rels
 
-addManyToManyRelations :: [Relation] -> [Relation]
+t1.c1------t2.c2
-addManyToManyRelations rels = rels ++ addMirrorRelation (mapMaybe link2Relation links)
+
+When only having a t1_view.c1 source column, we need to add a View-Table M2O Relation
+
+         t1.c1----t2.c2         t1.c1----------t2.c2
+                         ->            ________/
+                                      /
+      t1_view.c1             t1_view.c1
+
+
+When only having a t2_view.c2 source column, we need to add a Table-View M2O Relation
+
+         t1.c1----t2.c2               t1.c1----------t2.c2
+                               ->          \________
+                                                    \
+                    t2_view.c2                      t2_view.c1
+
+When having t1_view.c1 and a t2_view.c2 source columns, we need to add a View-View M2O Relation in addition to the prior
+
+         t1.c1----t2.c2               t1.c1----------t2.c2
+                               ->          \________/
+                                           /        \
+    t1_view.c1     t2_view.c2     t1_view.c1-------t2_view.c1
+
+The logic for composite pks is similar just need to make sure all the Relation columns have source columns.
+-}
+addViewM2ORels :: [SourceColumn] -> [Relation] -> [Relation]
+addViewM2ORels allSrcCols = concatMap (\rel ->
+  rel : case rel of
+    Relation{relType=M2O, relTable, relColumns, relConstraint, relFTable, relFColumns} ->
+
+      let srcColsGroupedByView :: [Column] -> [[SourceColumn]]
+          srcColsGroupedByView relCols = L.groupBy (\(_, viewCol1) (_, viewCol2) -> colTable viewCol1 == colTable viewCol2) $
+                                         filter (\(c, _) -> c `elem` relCols) allSrcCols
+          relSrcCols = srcColsGroupedByView relColumns
+          relFSrcCols = srcColsGroupedByView relFColumns
+          getView :: [SourceColumn] -> Table
+          getView = colTable . snd . unsafeHead
+          srcCols `allSrcColsOf` cols = S.fromList (fst <$> srcCols) == S.fromList cols
+          -- Relation is dependent on the order of relColumns and relFColumns to get the join conditions right in the generated query.
+          -- So we need to change the order of the SourceColumns to match the relColumns
+          -- TODO: This could be avoided if the Relation type is improved with a structure that maintains the association of relColumns and relFColumns
+          srcCols `sortAccordingTo` cols = sortOn (\(k, _) -> L.lookup k $ zip cols [0::Int ..]) srcCols
+
+          viewTableM2O =
+            [ Relation (getView srcCols) (snd <$> srcCols `sortAccordingTo` relColumns)
+                       relConstraint relFTable relFColumns
+                       M2O Nothing
+            | srcCols <- relSrcCols, srcCols `allSrcColsOf` relColumns ]
+
+          tableViewM2O =
+            [ Relation relTable relColumns
+                       relConstraint
+                       (getView fSrcCols) (snd <$> fSrcCols `sortAccordingTo` relFColumns)
+                       M2O Nothing
+            | fSrcCols <- relFSrcCols, fSrcCols `allSrcColsOf` relFColumns ]
+
+          viewViewM2O =
+            [ Relation (getView srcCols) (snd <$> srcCols `sortAccordingTo` relColumns)
+                       relConstraint
+                       (getView fSrcCols) (snd <$> fSrcCols `sortAccordingTo` relFColumns)
+                       M2O Nothing
+            | srcCols  <- relSrcCols, srcCols `allSrcColsOf` relColumns
+            , fSrcCols <- relFSrcCols, fSrcCols `allSrcColsOf` relFColumns ]
+
+      in viewTableM2O ++ tableViewM2O ++ viewViewM2O
+
+    _ -> [])
+
+addO2MRels :: [Relation] -> [Relation]
+addO2MRels = concatMap (\rel@(Relation t c cn ft fc _ _) -> [rel, Relation ft fc cn t c O2M Nothing])
+
+addM2MRels :: [Relation] -> [Relation]
+addM2MRels rels = rels ++ addMirrorRel (mapMaybe junction2Rel junctions)
   where
-    links = join $ map (combinations 2) $ filter (not . null) $ groupWith groupFn $ filter ( (==Child). relType) rels
+    junctions = join $ map (combinations 2) $ filter (not . null) $ groupWith groupFn $ filter ( (==M2O). relType) rels
     groupFn :: Relation -> Text
-    groupFn Relation{relTable=Table{tableSchema=s, tableName=t}} = s<>"_"<>t
+    groupFn Relation{relTable=Table{tableSchema=s, tableName=t}} = s <> "_" <> t
     -- Reference : https://wiki.haskell.org/99_questions/Solutions/26
     combinations :: Int -> [a] -> [[a]]
     combinations 0 _  = [ [] ]
     combinations n xs = [ y:ys | y:xs' <- tails xs
                                , ys <- combinations (n-1) xs']
-    addMirrorRelation [] = []
+    junction2Rel [
-    addMirrorRelation (rel@(Relation t c ft fc _ lt lc1 lc2):rels') = Relation ft fc t c Many lt lc2 lc1 : rel : addMirrorRelation rels'
+      Relation{relTable=jt, relColumns=jc1, relConstraint=const1, relFTable=t,  relFColumns=c},
-    link2Relation [
+      Relation{             relColumns=jc2, relConstraint=const2, relFTable=ft, relFColumns=fc}
-      Relation{relTable=lt, relColumns=lc1, relFTable=t,  relFColumns=c},
-      Relation{             relColumns=lc2, relFTable=ft, relFColumns=fc}
       ]
-      | lc1 /= lc2 && length lc1 == 1 && length lc2 == 1 = Just $ Relation t c ft fc Many (Just lt) (Just lc1) (Just lc2)
+      | jc1 /= jc2 && length jc1 == 1 && length jc2 == 1 = Just $ Relation t c Nothing ft fc M2M (Just $ Junction jt const1 jc1 const2 jc2)
       | otherwise = Nothing
-    link2Relation _ = Nothing
+    junction2Rel _ = Nothing
+    addMirrorRel = concatMap (\rel@(Relation t c _ ft fc _ (Just (Junction jt const1 jc1 const2 jc2))) ->
+      [rel, Relation ft fc Nothing t c M2M (Just (Junction jt const2 jc2 const1 jc1))])
 
-raiseRelations :: Schema -> [(Column,Column)] -> [Relation] -> [Relation]
+addViewPrimaryKeys :: [SourceColumn] -> [PrimaryKey] -> [PrimaryKey]
-raiseRelations schema syns = map raiseRel
+addViewPrimaryKeys srcCols = concatMap (\pk ->
-  where
+  let viewPks = (\(_, viewCol) -> PrimaryKey{pkTable=colTable viewCol, pkName=colName viewCol}) <$>
-    raiseRel rel
+                filter (\(col, _) -> colTable col == pkTable pk && colName col == pkName pk) srcCols in
-      | tableSchema table == schema = rel
+  pk : viewPks)
-      | isJust newCols = rel{relFTable=fromJust newTable,relFColumns=fromJust newCols}
-      | otherwise = rel
-      where
-        cols = relFColumns rel
-        table = relFTable rel
-        newCols = listToMaybe $ filter ((== schema) . tableSchema . colTable . unsafeHead) (synonymousColumns syns cols)
-        newTable = (colTable . unsafeHead) <$> newCols
 
-synonymousPrimaryKeys :: [(Column,Column)] -> [PrimaryKey] -> [PrimaryKey]
+allTables :: H.Statement () [Table]
-synonymousPrimaryKeys _ [] = []
-synonymousPrimaryKeys syns (key:keys) = key : newKeys ++ synonymousPrimaryKeys syns keys
-  where
-    keySyns = filter ((\c -> colTable c == pkTable key && colName c == pkName key) . fst) syns
-    newKeys = map ((\c -> PrimaryKey{pkTable=colTable c,pkName=colName c}) . snd) keySyns
-
-allTables :: H.Query () [Table]
 allTables =
-  H.statement sql HE.unit decodeTables True
+  H.Statement sql HE.noParams decodeTables True
  where
   sql = [q|
     SELECT
@@ -306,14 +383,14 @@ allTables =
           AND (pg_trigger.tgtype::integer & 69) = 69) ) AS insertable
     FROM pg_class c
     JOIN pg_namespace n ON n.oid = c.relnamespace
-    WHERE c.relkind IN ('v','r','m')
+    WHERE c.relkind IN ('v','r','m','f')
       AND n.nspname NOT IN ('pg_catalog', 'information_schema')
     GROUP BY table_schema, table_name, insertable
     ORDER BY table_schema, table_name |]
 
-allColumns :: [Table] -> H.Query () [Column]
+allColumns :: [Table] -> H.Statement [Schema] [Column]
 allColumns tabs =
-  H.statement sql HE.unit (decodeColumns tabs) True
+ H.Statement sql (arrayParam HE.text) (decodeColumns tabs) True
  where
   sql = [q|
     SELECT DISTINCT
@@ -331,14 +408,40 @@ allColumns tabs =
         array_to_string(enum_info.vals, ',') AS enum
     FROM (
         /*
-        -- CTE based on information_schema.columns to remove the owner filter
+        -- CTE based on pg_catalog to get PRIMARY/FOREIGN key and UNIQUE columns outside api schema
         */
-        WITH columns AS (
+        WITH key_columns AS (
+             SELECT
+               r.oid AS r_oid,
+               c.oid AS c_oid,
+               n.nspname,
+               c.relname,
+               r.conname,
+               r.contype,
+               unnest(r.conkey) AS conkey
+             FROM
+               pg_catalog.pg_constraint r,
+               pg_catalog.pg_class c,
+               pg_catalog.pg_namespace n
+             WHERE
+               r.contype IN ('f', 'p', 'u')
+               AND c.relkind IN ('r', 'v', 'f', 'm')
+               AND r.conrelid = c.oid
+               AND c.relnamespace = n.oid
+               AND n.nspname <> ANY (ARRAY['pg_catalog', 'information_schema'] || $1)
+        ),
+        /*
+        -- CTE based on information_schema.columns
+        -- changed:
+        -- remove the owner filter
+        -- limit columns to the ones in the api schema or PK/FK columns
+        */
+        columns AS (
             SELECT current_database()::information_schema.sql_identifier AS table_catalog,
                 nc.nspname::information_schema.sql_identifier AS table_schema,
                 c.relname::information_schema.sql_identifier AS table_name,
                 a.attname::information_schema.sql_identifier AS column_name,
-                d.description::information_schema.sql_identifier AS description,
+                d.description AS description,
                 a.attnum::information_schema.cardinal_number AS ordinal_position,
                 pg_get_expr(ad.adbin, ad.adrelid)::information_schema.character_data AS column_default,
                     CASE
@@ -411,6 +514,7 @@ allColumns tabs =
                     ELSE 'NO'::text
                 END::information_schema.yes_or_no AS is_updatable
             FROM pg_attribute a
+               LEFT JOIN key_columns kc ON kc.conkey = a.attnum AND kc.c_oid = a.attrelid
                LEFT JOIN pg_catalog.pg_description AS d ON d.objoid = a.attrelid and d.objsubid = a.attnum
                LEFT JOIN pg_attrdef ad ON a.attrelid = ad.adrelid AND a.attnum = ad.adnum
                JOIN (pg_class c
@@ -421,7 +525,12 @@ allColumns tabs =
                JOIN pg_namespace nbt ON bt.typnamespace = nbt.oid) ON t.typtype = 'd'::"char" AND t.typbasetype = bt.oid
                LEFT JOIN (pg_collation co
                JOIN pg_namespace nco ON co.collnamespace = nco.oid) ON a.attcollation = co.oid AND (nco.nspname <> 'pg_catalog'::name OR co.collname <> 'default'::name)
-            WHERE NOT pg_is_other_temp_schema(nc.oid) AND a.attnum > 0 AND NOT a.attisdropped AND (c.relkind = ANY (ARRAY['r'::"char", 'v'::"char", 'f'::"char"]))
+            WHERE
+                NOT pg_is_other_temp_schema(nc.oid)
+                AND a.attnum > 0
+                AND NOT a.attisdropped
+                AND (c.relkind = ANY (ARRAY['r'::"char", 'v'::"char", 'f'::"char", 'm'::"char"]))
+                AND (nc.nspname = ANY ($1) OR kc.r_oid IS NOT NULL) /*--filter only columns that are FK/PK or in the api schema */
               /*--AND (pg_has_role(c.relowner, 'USAGE'::text) OR has_column_privilege(c.oid, a.attnum, 'SELECT, INSERT, UPDATE, REFERENCES'::text))*/
         )
         SELECT
@@ -464,41 +573,38 @@ columnFromRow tabs (s, t, n, desc, pos, nul, typ, u, l, p, d, e) = buildColumn <
     buildColumn tbl = Column tbl n desc pos nul typ u l p d (parseEnum e) Nothing
     table = find (\tbl -> tableSchema tbl == s && tableName tbl == t) tabs
     parseEnum :: Maybe Text -> [Text]
-    parseEnum str = fromMaybe [] $ split (==',') <$> str
+    parseEnum = maybe [] (split (==','))
 
-allRelations :: [Table] -> [Column] -> H.Query () [Relation]
+allM2ORels :: [Table] -> [Column] -> H.Statement () [Relation]
-allRelations tabs cols =
+allM2ORels tabs cols =
-  H.statement sql HE.unit (decodeRelations tabs cols) True
+  H.Statement sql HE.noParams (decodeRels tabs cols) True
  where
   sql = [q|
     SELECT ns1.nspname AS table_schema,
            tab.relname AS table_name,
+           conname     AS constraint_name,
            column_info.cols AS columns,
            ns2.nspname AS foreign_table_schema,
            other.relname AS foreign_table_name,
            column_info.refs AS foreign_columns
     FROM pg_constraint,
-       LATERAL (SELECT array_agg(cols.attname) AS cols,
+    LATERAL (
-                       array_agg(cols.attnum)  AS nums,
+      SELECT array_agg(cols.attname) AS cols,
-                       array_agg(refs.attname) AS refs
+                    array_agg(cols.attnum)  AS nums,
-                  FROM ( SELECT unnest(conkey) AS col, unnest(confkey) AS ref) k,
+                    array_agg(refs.attname) AS refs
-                       LATERAL (SELECT * FROM pg_attribute
+      FROM ( SELECT unnest(conkey) AS col, unnest(confkey) AS ref) k,
-                                 WHERE attrelid = conrelid AND attnum = col)
+      LATERAL (SELECT * FROM pg_attribute WHERE attrelid = conrelid AND attnum = col) AS cols,
-                            AS cols,
+      LATERAL (SELECT * FROM pg_attribute WHERE attrelid = confrelid AND attnum = ref) AS refs) AS column_info,
-                       LATERAL (SELECT * FROM pg_attribute
+    LATERAL (SELECT * FROM pg_namespace WHERE pg_namespace.oid = connamespace) AS ns1,
-                                 WHERE attrelid = confrelid AND attnum = ref)
+    LATERAL (SELECT * FROM pg_class WHERE pg_class.oid = conrelid) AS tab,
-                            AS refs)
+    LATERAL (SELECT * FROM pg_class WHERE pg_class.oid = confrelid) AS other,
-            AS column_info,
+    LATERAL (SELECT * FROM pg_namespace WHERE pg_namespace.oid = other.relnamespace) AS ns2
-       LATERAL (SELECT * FROM pg_namespace WHERE pg_namespace.oid = connamespace) AS ns1,
-       LATERAL (SELECT * FROM pg_class WHERE pg_class.oid = conrelid) AS tab,
-       LATERAL (SELECT * FROM pg_class WHERE pg_class.oid = confrelid) AS other,
-       LATERAL (SELECT * FROM pg_namespace WHERE pg_namespace.oid = other.relnamespace) AS ns2
     WHERE confrelid != 0
     ORDER BY (conrelid, column_info.nums) |]
 
-relationFromRow :: [Table] -> [Column] -> (Text, Text, [Text], Text, Text, [Text]) -> Maybe Relation
+relFromRow :: [Table] -> [Column] -> (Text, Text, Text, [Text], Text, Text, [Text]) -> Maybe Relation
-relationFromRow allTabs allCols (rs, rt, rcs, frs, frt, frcs) =
+relFromRow allTabs allCols (rs, rt, cn, rcs, frs, frt, frcs) =
-  Relation <$> table <*> cols <*> tableF <*> colsF <*> pure Child <*> pure Nothing <*> pure Nothing <*> pure Nothing
+  Relation <$> table <*> cols <*> pure (Just cn) <*> tableF <*> colsF <*> pure M2O <*> pure Nothing
   where
     findTable s t = find (\tbl -> tableSchema tbl == s && tableName tbl == t) allTabs
     findCol s t c = find (\col -> tableSchema (colTable col) == s && tableName (colTable col) == t && colName col == c) allCols
@@ -507,9 +613,9 @@ relationFromRow allTabs allCols (rs, rt, rcs, frs, frt, frcs) =
     cols  = mapM (findCol rs rt) rcs
     colsF = mapM (findCol frs frt) frcs
 
-allPrimaryKeys :: [Table] -> H.Query () [PrimaryKey]
+allPrimaryKeys :: [Table] -> H.Statement () [PrimaryKey]
 allPrimaryKeys tabs =
-  H.statement sql HE.unit (decodePks tabs) True
+  H.Statement sql HE.noParams (decodePks tabs) True
  where
   sql = [q|
     /*
@@ -617,84 +723,77 @@ pkFromRow :: [Table] -> (Schema, Text, Text) -> Maybe PrimaryKey
 pkFromRow tabs (s, t, n) = PrimaryKey <$> table <*> pure n
   where table = find (\tbl -> tableSchema tbl == s && tableName tbl == t) tabs
 
-allSynonyms :: [Column] -> H.Query () [(Column,Column)]
+allSourceColumns :: [Column] -> PgVersion -> H.Statement [Schema] [SourceColumn]
-allSynonyms cols =
+allSourceColumns cols pgVer =
-  H.statement sql HE.unit (decodeSynonyms cols) True
+  H.Statement sql (arrayParam HE.text) (decodeSourceColumns cols) True
- where
+  -- query explanation at https://gist.github.com/steve-chavez/7ee0e6590cddafb532e5f00c46275569
-  -- query explanation at https://gist.github.com/ruslantalpa/2eab8c930a65e8043d8f
-  sql = [q|
-    with view_columns as (
-        select
-            c.oid as view_oid,
-            a.attname::information_schema.sql_identifier as column_name
-        from pg_attribute a
-        join pg_class c on a.attrelid = c.oid
-        join pg_namespace nc on c.relnamespace = nc.oid
-        where
-            not pg_is_other_temp_schema(nc.oid)
-            and a.attnum > 0
-            and not a.attisdropped
-            and (c.relkind = 'v'::"char")
-            and nc.nspname not in ('information_schema', 'pg_catalog')
-    ),
-    view_column_usage as (
-        select distinct
-            v.oid as view_oid,
-            nv.nspname::information_schema.sql_identifier as view_schema,
-            v.relname::information_schema.sql_identifier as view_name,
-            nt.nspname::information_schema.sql_identifier as table_schema,
-            t.relname::information_schema.sql_identifier as table_name,
-            a.attname::information_schema.sql_identifier as column_name,
-            pg_get_viewdef(v.oid)::information_schema.character_data as view_definition
-        from pg_namespace nv
-        join pg_class v on nv.oid = v.relnamespace
-        join pg_depend dv on v.oid = dv.refobjid
-        join pg_depend dt on dv.objid = dt.objid
-        join pg_class t on dt.refobjid = t.oid
-        join pg_namespace nt on t.relnamespace = nt.oid
-        join pg_attribute a on t.oid = a.attrelid and dt.refobjsubid = a.attnum
-
-        where
-            nv.nspname not in ('information_schema', 'pg_catalog')
-            and v.relkind = 'v'::"char"
-            and dv.refclassid = 'pg_class'::regclass::oid
-            and dv.classid = 'pg_rewrite'::regclass::oid
-            and dv.deptype = 'i'::"char"
-            and dv.refobjid <> dt.refobjid
-            and dt.classid = 'pg_rewrite'::regclass::oid
-            and dt.refclassid = 'pg_class'::regclass::oid
-            and (t.relkind = any (array['r'::"char", 'v'::"char", 'f'::"char"]))
-    ),
-    candidates as (
-        select
-            vcu.*,
-            (
-                select case when match is not null then coalesce(match[8], match[7], match[4]) end
-                from regexp_matches(
-                    CONCAT('SELECT ', SPLIT_PART(vcu.view_definition, 'SELECT', 2)),
-                    CONCAT('SELECT.*?((',vcu.table_name,')|(\w+))\.(', vcu.column_name, ')(\s+AS\s+("([^"]+)"|([^, \n\t]+)))?.*?FROM.*?(',vcu.table_schema,'\.|)(\2|',vcu.table_name,'\s+(as\s)?\3)'),
-                    'nsi'
-                ) match
-            ) as view_column_name
-        from view_column_usage as vcu
-    )
-    select
-        c.table_schema,
-        c.table_name,
-        c.column_name as table_column_name,
-        c.view_schema,
-        c.view_name,
-        c.view_column_name
-    from view_columns as vc, candidates as c
-    where
-        vc.view_oid = c.view_oid
-        and vc.column_name = c.view_column_name
-    order by c.view_schema, c.view_name, c.table_name, c.view_column_name
-    |]
-
-synonymFromRow :: [Column] -> (Text,Text,Text,Text,Text,Text) -> Maybe (Column,Column)
-synonymFromRow allCols (s1,t1,c1,s2,t2,c2) = (,) <$> col1 <*> col2
   where
-    col1 = findCol s1 t1 c1
+    subselectRegex :: Text
-    col2 = findCol s2 t2 c2
+    -- "result" appears when the subselect is used inside "case when", see `authors_have_book_in_decade` fixture
-    findCol s t c = find (\col -> (tableSchema . colTable) col == s && (tableName . colTable) col == t && colName col == c) allCols
+    -- "resno"  appears in every other case
+    -- when copying the query into pg make sure you omit one backslash from \\d+, it should be like `\d+` for the regex
+    subselectRegex | pgVer < pgVersion100 = ":subselect {.*?:constraintDeps <>} :location \\d+} :res(no|ult)"
+                   | otherwise = ":subselect {.*?:stmt_len 0} :location \\d+} :res(no|ult)"
+    sql = [qc|
+      with
+      views as (
+        select
+          n.nspname   as view_schema,
+          c.relname   as view_name,
+          r.ev_action as view_definition
+        from pg_class c
+        join pg_namespace n on n.oid = c.relnamespace
+        join pg_rewrite r on r.ev_class = c.oid
+        where (c.relkind in ('v', 'm')) and n.nspname = ANY ($1)
+      ),
+      removed_subselects as(
+        select
+          view_schema, view_name,
+          regexp_replace(view_definition, '{subselectRegex}', '', 'g') as x
+        from views
+      ),
+      target_lists as(
+        select
+          view_schema, view_name,
+          regexp_split_to_array(x, 'targetList') as x
+        from removed_subselects
+      ),
+      last_target_list_wo_tail as(
+        select
+          view_schema, view_name,
+          (regexp_split_to_array(x[array_upper(x, 1)], ':onConflict'))[1] as x
+        from target_lists
+      ),
+      target_entries as(
+        select
+          view_schema, view_name,
+          unnest(regexp_split_to_array(x, 'TARGETENTRY')) as entry
+        from last_target_list_wo_tail
+      ),
+      results as(
+        select
+          view_schema, view_name,
+          substring(entry from ':resname (.*?) :') as view_colum_name,
+          substring(entry from ':resorigtbl (.*?) :') as resorigtbl,
+          substring(entry from ':resorigcol (.*?) :') as resorigcol
+        from target_entries
+      )
+      select
+        sch.nspname as table_schema,
+        tbl.relname as table_name,
+        col.attname as table_column_name,
+        res.view_schema,
+        res.view_name,
+        res.view_colum_name
+      from results res
+      join pg_class tbl on tbl.oid::text = res.resorigtbl
+      join pg_attribute col on col.attrelid = tbl.oid and col.attnum::text = res.resorigcol
+      join pg_namespace sch on sch.oid = tbl.relnamespace
+      where resorigtbl <> '0'
+      order by view_schema, view_name, view_colum_name; |]
+
+getPgVersion :: H.Session PgVersion
+getPgVersion = H.statement () $ H.Statement sql HE.noParams versionRow False
+  where
+    sql = "SELECT current_setting('server_version_num')::integer, current_setting('server_version')"
+    versionRow = HD.singleRow $ PgVersion <$> column HD.int4 <*> column HD.text

src/PostgREST/Error.hs

@@ -1,89 +1,74 @@
+{-|
+Module      : PostgREST.Error
+Description : PostgREST error HTTP responses
+-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
-{-# LANGUAGE FlexibleInstances    #-}
+{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE TypeSynonymInstances #-}
 
 module PostgREST.Error (
-  apiRequestError
+  errorResponseFor
-, pgError
+, ApiRequestError(..)
-, simpleError
+, PgError(..)
+, SimpleError(..)
+, errorPayload
+, checkIsFatal
 , singularityError
-, binaryFieldError
-, connectionLostError
-, encodeError
 ) where
 
-import           Protolude
-import           Data.Aeson                ((.=))
 import qualified Data.Aeson                as JSON
-import           Data.Text                 (unwords)
+import qualified Data.Text                 as T
 import qualified Hasql.Pool                as P
 import qualified Hasql.Session             as H
-import           Network.HTTP.Types.Header
 import qualified Network.HTTP.Types.Status as HT
-import           Network.Wai               (Response, responseLBS)
-import           PostgREST.Types
 
-apiRequestError :: ApiRequestError -> Response
+import Data.Aeson  ((.=))
-apiRequestError err =
+import Network.Wai (Response, responseLBS)
-  errorResponse status
+import Text.Read   (readMaybe)
-    [toHeader CTApplicationJSON] err
-  where
-    status =
-      case err of
-        ActionInappropriate -> HT.status405
-        UnsupportedVerb -> HT.status405
-        InvalidBody _ -> HT.status400
-        ParseRequestError _ _ -> HT.status400
-        NoRelationBetween _ _ -> HT.status400
-        InvalidRange -> HT.status416
-        UnknownRelation -> HT.status404
 
-simpleError :: HT.Status -> [Header] -> Text -> Response
+import Network.HTTP.Types.Header
-simpleError status hdrs message =
-  errorResponse status (toHeader CTApplicationJSON : hdrs) $
-    JSON.object ["message" .= message]
 
-errorResponse :: JSON.ToJSON a => HT.Status -> [Header] -> a -> Response
+import PostgREST.Types
-errorResponse status hdrs e =
+import Protolude
-  responseLBS status hdrs $ encodeError e
-
-pgError :: Bool -> P.UsageError -> Response
-pgError authed e =
-  let status = httpStatus authed e
-      jsonType = toHeader CTApplicationJSON
-      wwwAuth = ("WWW-Authenticate", "Bearer")
-      hdrs = if status == HT.status401
-                then [jsonType, wwwAuth]
-                else [jsonType] in
-  responseLBS status hdrs (encodeError e)
-
-singularityError :: Integer -> Response
-singularityError numRows =
-  responseLBS HT.status406
-    [toHeader CTSingularJSON]
-    $ toS . formatGeneralError
-      "JSON object requested, multiple (or no) rows returned"
-      $ unwords
-        [ "Results contain", show numRows, "rows,"
-        , toS (toMime CTSingularJSON), "requires 1 row"
-        ]
-  where
-    formatGeneralError :: Text -> Text -> Text
-    formatGeneralError message details = toS . JSON.encode $
-      JSON.object ["message" .= message, "details" .= details]
 
 
-binaryFieldError :: Response
+class (JSON.ToJSON a) => PgrstError a where
-binaryFieldError =
+  status   :: a -> HT.Status
-  simpleError HT.status406 [] (toS (toMime CTOctetStream) <>
+  headers  :: a -> [Header]
-  " requested but a single column was not selected")
 
-connectionLostError :: Response
+  errorPayload :: a -> LByteString
-connectionLostError =
+  errorPayload = JSON.encode
-  simpleError HT.status503 [] "Database connection lost, retrying the connection."
 
-encodeError :: JSON.ToJSON a => a -> LByteString
+  errorResponseFor :: a -> Response
-encodeError = JSON.encode
+  errorResponseFor err = responseLBS (status err) (headers err) $ errorPayload err
+
+
+
+data ApiRequestError
+  = ActionInappropriate
+  | InvalidRange
+  | InvalidBody ByteString
+  | ParseRequestError Text Text
+  | NoRelBetween Text Text
+  | AmbiguousRelBetween Text Text [Relation]
+  | InvalidFilters
+  | UnacceptableSchema [Text]
+  | UnknownRelation                -- Unreachable?
+  | UnsupportedVerb                -- Unreachable?
+  deriving (Show, Eq)
+
+instance PgrstError ApiRequestError where
+  status InvalidRange            = HT.status416
+  status InvalidFilters          = HT.status405
+  status (InvalidBody _)         = HT.status400
+  status UnsupportedVerb         = HT.status405
+  status UnknownRelation         = HT.status404
+  status ActionInappropriate     = HT.status405
+  status (ParseRequestError _ _) = HT.status400
+  status (NoRelBetween _ _)      = HT.status400
+  status AmbiguousRelBetween{}   = HT.status300
+  status (UnacceptableSchema _)  = HT.status406
+
+  headers _ = [toHeader CTApplicationJSON]
 
 instance JSON.ToJSON ApiRequestError where
   toJSON (ParseRequestError message details) = JSON.object [
@@ -96,76 +81,206 @@ instance JSON.ToJSON ApiRequestError where
     "message" .= ("HTTP Range error" :: Text)]
   toJSON UnknownRelation = JSON.object [
     "message" .= ("Unknown relation" :: Text)]
-  toJSON (NoRelationBetween parent child) = JSON.object [
+  toJSON (NoRelBetween parent child) = JSON.object [
-    "message" .= ("Could not find foreign keys between these entities, No relation found between " <> parent <> " and " <> child :: Text)]
+    "message" .= ("Could not find foreign keys between these entities. No relationship found between " <> parent <> " and " <> child :: Text)]
+  toJSON (AmbiguousRelBetween parent child rels) = JSON.object [
+    "hint"    .= ("By following the 'details' key, disambiguate the request by changing the url to /origin?select=relationship(*) or /origin?select=target!relationship(*)" :: Text),
+    "message" .= ("More than one relationship was found for " <> parent <> " and " <> child :: Text),
+    "details" .= (compressedRel <$> rels) ]
   toJSON UnsupportedVerb = JSON.object [
     "message" .= ("Unsupported HTTP verb" :: Text)]
+  toJSON InvalidFilters = JSON.object [
+    "message" .= ("Filters must include all and only primary key columns with 'eq' operators" :: Text)]
+  toJSON (UnacceptableSchema schemas) = JSON.object [
+    "message" .= ("The schema must be one of the following: " <> T.intercalate ", " schemas)]
+
+compressedRel :: Relation -> JSON.Value
+compressedRel rel =
+  let
+    fmtTbl tbl = tableSchema tbl <> "." <> tableName tbl
+    fmtEls els = "[" <> T.intercalate ", " els <> "]"
+  in
+  JSON.object $ [
+    "origin"      .= fmtTbl (relTable rel)
+  , "target"      .= fmtTbl (relFTable rel)
+  , "cardinality" .= (show $ relType rel :: Text)
+  ] ++
+  case (relType rel, relJunction rel, relConstraint rel) of
+    (M2M, Just (Junction jt (Just const1) _ (Just const2) _), _) -> [
+      "relationship" .= (fmtTbl jt <> fmtEls [const1] <> fmtEls [const2])
+      ]
+    (_, _, Just relCon) -> [
+      "relationship" .= (relCon <> fmtEls (colName <$> relColumns rel) <> fmtEls (colName <$> relFColumns rel))
+      ]
+    (_, _, _) ->
+      mempty
+
+data PgError = PgError Authenticated P.UsageError
+type Authenticated = Bool
+
+instance PgrstError PgError where
+  status (PgError authed usageError) = pgErrorStatus authed usageError
+
+  headers err =
+    if status err == HT.status401
+       then [toHeader CTApplicationJSON, ("WWW-Authenticate", "Bearer") :: Header]
+       else [toHeader CTApplicationJSON]
+
+instance JSON.ToJSON PgError where
+  toJSON (PgError _ usageError) = JSON.toJSON usageError
 
 instance JSON.ToJSON P.UsageError where
   toJSON (P.ConnectionError e) = JSON.object [
-    "code" .= ("" :: Text),
+    "code"    .= ("" :: Text),
     "message" .= ("Database connection error" :: Text),
     "details" .= (toS $ fromMaybe "" e :: Text)]
   toJSON (P.SessionError e) = JSON.toJSON e -- H.Error
 
-instance JSON.ToJSON H.Error where
+instance JSON.ToJSON H.QueryError where
-  toJSON (H.ResultError (H.ServerError c m d h)) = JSON.object [
+  toJSON (H.QueryError _ _ e) = JSON.toJSON e
-    "code" .= (toS c::Text),
+
-    "message" .= (toS m::Text),
+instance JSON.ToJSON H.CommandError where
-    "details" .= (fmap toS d::Maybe Text),
+  toJSON (H.ResultError (H.ServerError c m d h)) = case toS c of
-    "hint" .= (fmap toS h::Maybe Text)]
+    'P':'T':_ -> JSON.object [
+        "details" .= (fmap toS d :: Maybe Text),
+        "hint"    .= (fmap toS h :: Maybe Text)]
+
+    _         -> JSON.object [
+        "code"    .= (toS c      :: Text),
+        "message" .= (toS m      :: Text),
+        "details" .= (fmap toS d :: Maybe Text),
+        "hint"    .= (fmap toS h :: Maybe Text)]
+
   toJSON (H.ResultError (H.UnexpectedResult m)) = JSON.object [
-    "message" .= (m::Text)]
+    "message" .= (m :: Text)]
   toJSON (H.ResultError (H.RowError i H.EndOfInput)) = JSON.object [
-    "message" .= ("Row error: end of input"::Text),
+    "message" .= ("Row error: end of input" :: Text),
-    "details" .=
+    "details" .= ("Attempt to parse more columns than there are in the result" :: Text),
-      ("Attempt to parse more columns than there are in the result"::Text),
+    "hint"    .= (("Row number " <> show i) :: Text)]
-    "details" .= (("Row number " <> show i)::Text)]
   toJSON (H.ResultError (H.RowError i H.UnexpectedNull)) = JSON.object [
-    "message" .= ("Row error: unexpected null"::Text),
+    "message" .= ("Row error: unexpected null" :: Text),
-    "details" .= ("Attempt to parse a NULL as some value."::Text),
+    "details" .= ("Attempt to parse a NULL as some value." :: Text),
-    "details" .= (("Row number " <> show i)::Text)]
+    "hint"    .= (("Row number " <> show i) :: Text)]
   toJSON (H.ResultError (H.RowError i (H.ValueError d))) = JSON.object [
-    "message" .= ("Row error: Wrong value parser used"::Text),
+    "message" .= ("Row error: Wrong value parser used" :: Text),
     "details" .= d,
-    "details" .= (("Row number " <> show i)::Text)]
+    "hint"    .= (("Row number " <> show i) :: Text)]
   toJSON (H.ResultError (H.UnexpectedAmountOfRows i)) = JSON.object [
-    "message" .= ("Unexpected amount of rows"::Text),
+    "message" .= ("Unexpected amount of rows" :: Text),
     "details" .= i]
   toJSON (H.ClientError d) = JSON.object [
-    "message" .= ("Database client error"::Text),
+    "message" .= ("Database client error" :: Text),
-    "details" .= (fmap toS d::Maybe Text)]
+    "details" .= (fmap toS d :: Maybe Text)]
 
-httpStatus :: Bool -> P.UsageError -> HT.Status
+pgErrorStatus :: Bool -> P.UsageError -> HT.Status
-httpStatus _ (P.ConnectionError _) = HT.status503
+pgErrorStatus _      (P.ConnectionError _)                                      = HT.status503
-httpStatus authed (P.SessionError (H.ResultError (H.ServerError c _ _ _))) =
+pgErrorStatus _      (P.SessionError (H.QueryError _ _ (H.ClientError _)))      = HT.status503
-  case toS c of
+pgErrorStatus authed (P.SessionError (H.QueryError _ _ (H.ResultError rError))) =
-    '0':'8':_ -> HT.status503 -- pg connection err
+  case rError of
-    '0':'9':_ -> HT.status500 -- triggered action exception
+    (H.ServerError c m _ _) ->
-    '0':'L':_ -> HT.status403 -- invalid grantor
+      case toS c of
-    '0':'P':_ -> HT.status403 -- invalid role specification
+        '0':'8':_ -> HT.status503 -- pg connection err
-    "23503"   -> HT.status409 -- foreign_key_violation
+        '0':'9':_ -> HT.status500 -- triggered action exception
-    "23505"   -> HT.status409 -- unique_violation
+        '0':'L':_ -> HT.status403 -- invalid grantor
-    '2':'5':_ -> HT.status500 -- invalid tx state
+        '0':'P':_ -> HT.status403 -- invalid role specification
-    '2':'8':_ -> HT.status403 -- invalid auth specification
+        "23503"   -> HT.status409 -- foreign_key_violation
-    '2':'D':_ -> HT.status500 -- invalid tx termination
+        "23505"   -> HT.status409 -- unique_violation
-    '3':'8':_ -> HT.status500 -- external routine exception
+        '2':'5':_ -> HT.status500 -- invalid tx state
-    '3':'9':_ -> HT.status500 -- external routine invocation
+        '2':'8':_ -> HT.status403 -- invalid auth specification
-    '3':'B':_ -> HT.status500 -- savepoint exception
+        '2':'D':_ -> HT.status500 -- invalid tx termination
-    '4':'0':_ -> HT.status500 -- tx rollback
+        '3':'8':_ -> HT.status500 -- external routine exception
-    '5':'3':_ -> HT.status503 -- insufficient resources
+        '3':'9':_ -> HT.status500 -- external routine invocation
-    '5':'4':_ -> HT.status413 -- too complex
+        '3':'B':_ -> HT.status500 -- savepoint exception
-    '5':'5':_ -> HT.status500 -- obj not on prereq state
+        '4':'0':_ -> HT.status500 -- tx rollback
-    '5':'7':_ -> HT.status500 -- operator intervention
+        '5':'3':_ -> HT.status503 -- insufficient resources
-    '5':'8':_ -> HT.status500 -- system error
+        '5':'4':_ -> HT.status413 -- too complex
-    'F':'0':_ -> HT.status500 -- conf file error
+        '5':'5':_ -> HT.status500 -- obj not on prereq state
-    'H':'V':_ -> HT.status500 -- foreign data wrapper error
+        '5':'7':_ -> HT.status500 -- operator intervention
-    "P0001"   -> HT.status400 -- default code for "raise"
+        '5':'8':_ -> HT.status500 -- system error
-    'P':'0':_ -> HT.status500 -- PL/pgSQL Error
+        'F':'0':_ -> HT.status500 -- conf file error
-    'X':'X':_ -> HT.status500 -- internal Error
+        'H':'V':_ -> HT.status500 -- foreign data wrapper error
-    "42883"   -> HT.status404 -- undefined function
+        "P0001"   -> HT.status400 -- default code for "raise"
-    "42P01"   -> HT.status404 -- undefined table
+        'P':'0':_ -> HT.status500 -- PL/pgSQL Error
-    "42501"   -> if authed then HT.status403 else HT.status401 -- insufficient privilege
+        'X':'X':_ -> HT.status500 -- internal Error
-    _         -> HT.status400
+        "42883"   -> HT.status404 -- undefined function
-httpStatus _ (P.SessionError (H.ResultError _)) = HT.status500
+        "42P01"   -> HT.status404 -- undefined table
-httpStatus _ (P.SessionError (H.ClientError _)) = HT.status503
+        "42501"   -> if authed then HT.status403 else HT.status401 -- insufficient privilege
+        'P':'T':n -> fromMaybe HT.status500 (HT.mkStatus <$> readMaybe n <*> pure m)
+        _         -> HT.status400
+
+    _                       -> HT.status500
+
+checkIsFatal :: PgError -> Maybe Text
+checkIsFatal (PgError _ (P.ConnectionError e))
+  | isAuthFailureMessage = Just $ toS failureMessage
+  | otherwise = Nothing
+  where isAuthFailureMessage = "FATAL:  password authentication failed" `isPrefixOf` toS failureMessage
+        failureMessage = fromMaybe "" e
+checkIsFatal _ = Nothing
+
+
+data SimpleError
+  = GucHeadersError
+  | BinaryFieldError ContentType
+  | ConnectionLostError
+  | PutSingletonError
+  | PutMatchingPkError
+  | PutRangeNotAllowedError
+  | PutPayloadIncompleteError
+  | JwtTokenMissing
+  | JwtTokenInvalid Text
+  | SingularityError Integer
+  | ContentTypeError [ByteString]
+  deriving (Show, Eq)
+
+instance PgrstError SimpleError where
+  status GucHeadersError           = HT.status500
+  status (BinaryFieldError _)      = HT.status406
+  status ConnectionLostError       = HT.status503
+  status PutSingletonError         = HT.status400
+  status PutMatchingPkError        = HT.status400
+  status PutRangeNotAllowedError   = HT.status400
+  status PutPayloadIncompleteError = HT.status400
+  status JwtTokenMissing           = HT.status500
+  status (JwtTokenInvalid _)       = HT.unauthorized401
+  status (SingularityError _)      = HT.status406
+  status (ContentTypeError _)      = HT.status415
+
+  headers (SingularityError _)     = [toHeader CTSingularJSON]
+  headers (JwtTokenInvalid m)      = [toHeader CTApplicationJSON, invalidTokenHeader m]
+  headers _                        = [toHeader CTApplicationJSON]
+
+instance JSON.ToJSON SimpleError where
+  toJSON GucHeadersError           = JSON.object [
+    "message" .= ("response.headers guc must be a JSON array composed of objects with a single key and a string value" :: Text)]
+  toJSON (BinaryFieldError ct)          = JSON.object [
+    "message" .= ((toS (toMime ct) <> " requested but more than one column was selected") :: Text)]
+  toJSON ConnectionLostError       = JSON.object [
+    "message" .= ("Database connection lost, retrying the connection." :: Text)]
+
+  toJSON PutSingletonError         = JSON.object [
+    "message" .= ("PUT payload must contain a single row" :: Text)]
+  toJSON PutRangeNotAllowedError   = JSON.object [
+    "message" .= ("Range header and limit/offset querystring parameters are not allowed for PUT" :: Text)]
+  toJSON PutPayloadIncompleteError = JSON.object [
+    "message" .= ("You must specify all columns in the payload when using PUT" :: Text)]
+  toJSON PutMatchingPkError        = JSON.object [
+    "message" .= ("Payload values do not match URL in primary key column(s)" :: Text)]
+
+  toJSON (ContentTypeError cts)    = JSON.object [
+    "message" .= ("None of these Content-Types are available: " <> (toS . intercalate ", " . map toS) cts :: Text)]
+  toJSON (SingularityError n)      = JSON.object [
+    "message" .= ("JSON object requested, multiple (or no) rows returned" :: Text),
+    "details" .= T.unwords ["Results contain", show n, "rows,", toS (toMime CTSingularJSON), "requires 1 row"]]
+
+  toJSON JwtTokenMissing           = JSON.object [
+    "message" .= ("Server lacks JWT secret" :: Text)]
+  toJSON (JwtTokenInvalid message) = JSON.object [
+    "message" .= (message :: Text)]
+
+invalidTokenHeader :: Text -> Header
+invalidTokenHeader m =
+  ("WWW-Authenticate", "Bearer error=\"invalid_token\", " <> "error_description=" <> show m)
+
+singularityError :: (Integral a) => a -> SimpleError
+singularityError = SingularityError . toInteger

src/PostgREST/Middleware.hs

@@ -1,61 +1,70 @@
+{-|
+Module      : PostgREST.Middleware
+Description : Sets the PostgreSQL GUCs, role, search_path and pre-request function. Validates JWT.
+-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
+{-# LANGUAGE FlexibleContexts    #-}
 {-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE FlexibleContexts #-}
 
 module PostgREST.Middleware where
 
-import           Crypto.JWT
+import qualified Data.Aeson          as JSON
-import           Data.Aeson                    (Value (..))
+import qualified Data.HashMap.Strict as M
-import qualified Data.HashMap.Strict           as M
+import           Data.Scientific     (FPFormat (..), formatScientific,
-import qualified Hasql.Transaction             as H
+                                      isInteger)
+import qualified Hasql.Transaction   as H
 
-import           Network.HTTP.Types.Status     (unauthorized401, status500)
+import Network.Wai                   (Application, Response)
-import           Network.Wai                   (Application, Response)
+import Network.Wai.Middleware.Cors   (cors)
-import           Network.Wai.Middleware.Cors   (cors)
+import Network.Wai.Middleware.Gzip   (def, gzip)
-import           Network.Wai.Middleware.Gzip   (def, gzip)
+import Network.Wai.Middleware.Static (only, staticPolicy)
-import           Network.Wai.Middleware.Static (only, staticPolicy)
 
-import           PostgREST.ApiRequest          (ApiRequest(..))
+import Crypto.JWT
-import           PostgREST.Auth                (JWTAttempt(..))
-import           PostgREST.Config              (AppConfig (..), corsPolicy)
-import           PostgREST.Error               (simpleError)
-import           PostgREST.QueryBuilder        (pgFmtLit, unquoted, pgFmtEnvVar)
 
-import           Protolude                     hiding (concat, null)
+import PostgREST.ApiRequest   (ApiRequest (..))
+import PostgREST.Auth         (JWTAttempt (..))
+import PostgREST.Config       (AppConfig (..), corsPolicy)
+import PostgREST.Error        (SimpleError (JwtTokenInvalid, JwtTokenMissing),
+                               errorResponseFor)
+import PostgREST.QueryBuilder (setLocalQuery, setLocalSearchPathQuery)
+import Protolude              hiding (head)
 
 runWithClaims :: AppConfig -> JWTAttempt ->
                  (ApiRequest -> H.Transaction Response) ->
                  ApiRequest -> H.Transaction Response
 runWithClaims conf eClaims app req =
   case eClaims of
-    JWTInvalid JWTExpired -> return $ unauthed "JWT expired"
+    JWTMissingSecret      -> return . errorResponseFor $ JwtTokenMissing
-    JWTInvalid e -> return $ unauthed $ show e
+    JWTInvalid JWTExpired -> return . errorResponseFor . JwtTokenInvalid $ "JWT expired"
-    JWTMissingSecret -> return $ simpleError status500 [] "Server lacks JWT secret"
+    JWTInvalid e          -> return . errorResponseFor . JwtTokenInvalid . show $ e
-    JWTClaims claims -> do
+    JWTClaims claims      -> do
-      H.sql $ toS.mconcat $ setRoleSql ++ claimsSql ++ headersSql ++ cookiesSql
+      H.sql $ toS . mconcat $ setSearchPathSql : setRoleSql ++ claimsSql ++ [methodSql, pathSql] ++ headersSql ++ cookiesSql ++ appSettingsSql
       mapM_ H.sql customReqCheck
       app req
       where
-        headersSql = map (pgFmtEnvVar "request.header.") $ iHeaders req
+        methodSql = setLocalQuery mempty ("request.method", toS $ iMethod req)
-        cookiesSql = map (pgFmtEnvVar "request.cookie.") $ iCookies req
+        pathSql = setLocalQuery mempty ("request.path", toS $ iPath req)
-        claimsSql = map (pgFmtEnvVar "request.jwt.claim.") [(c,unquoted v) | (c,v) <- M.toList claimsWithRole]
+        headersSql = setLocalQuery "request.header." <$> iHeaders req
-        setRoleSql = maybeToList $
+        cookiesSql = setLocalQuery "request.cookie." <$> iCookies req
-          (\r -> "set local role " <> r <> ";") . toS . pgFmtLit . unquoted <$> M.lookup "role" claimsWithRole
+        claimsSql = setLocalQuery "request.jwt.claim." <$> [(c,unquoted v) | (c,v) <- M.toList claimsWithRole]
+        appSettingsSql = setLocalQuery mempty <$> configSettings conf
+        setRoleSql = maybeToList $ (\x ->
+          setLocalQuery mempty ("role", unquoted x)) <$> M.lookup "role" claimsWithRole
+        setSearchPathSql = setLocalSearchPathQuery (iSchema req : configExtraSearchPath conf)
         -- role claim defaults to anon if not specified in jwt
         claimsWithRole = M.union claims (M.singleton "role" anon)
-        anon = String . toS $ configAnonRole conf
+        anon = JSON.String . toS $ configAnonRole conf
         customReqCheck = (\f -> "select " <> toS f <> "();") <$> configReqCheck conf
-  where
-    unauthed message = simpleError
-      unauthorized401
-      [( "WWW-Authenticate"
-        , "Bearer error=\"invalid_token\", " <>
-          "error_description=" <> show message
-      )]
-      message
 
 defaultMiddle :: Application -> Application
 defaultMiddle =
     gzip def
   . cors corsPolicy
   . staticPolicy (only [("favicon.ico", "static/favicon.ico")])
+
+unquoted :: JSON.Value -> Text
+unquoted (JSON.String t) = t
+unquoted (JSON.Number n) =
+  toS $ formatScientific Fixed (if isInteger n then Just 0 else Nothing) n
+unquoted (JSON.Bool b) = show b
+unquoted v = toS $ JSON.encode v

src/PostgREST/OpenAPI.hs

@@ -1,48 +1,63 @@
+{-|
+Module      : PostgREST.OpenAPI
+Description : Generates the OpenAPI output
+-}
 {-# LANGUAGE OverloadedStrings #-}
 
 module PostgREST.OpenAPI (
   encodeOpenAPI
-  , isMalformedProxyUri
+, isMalformedProxyUri
-  , pickProxy
+, pickProxy
-  ) where
+) where
 
-import           Control.Arrow               ((&&&))
+import qualified Data.HashSet.InsOrd as Set
-import           Control.Lens
-import           Data.Aeson                  (decode, encode)
-import           Data.HashMap.Strict.InsOrd  (InsOrdHashMap, fromList)
-import           Data.Maybe                  (fromJust)
-import qualified Data.Set                    as Set
-import           Data.String                 (IsString (..))
-import           Data.Text                   (unpack, pack, init, tail, toLower, intercalate, append, dropWhile, breakOn)
-import           Network.URI                 (parseURI, isAbsoluteURI,
-                                              URI (..), URIAuth (..))
 
-import           Protolude hiding              ((&), Proxy, get, intercalate, dropWhile)
+import Control.Arrow              ((&&&))
+import Data.Aeson                 (decode, encode)
+import Data.HashMap.Strict.InsOrd (InsOrdHashMap, fromList)
+import Data.Maybe                 (fromJust)
+import Data.String                (IsString (..))
+import Data.Text                  (append, breakOn, dropWhile, init,
+                                   intercalate, pack, tail, toLower,
+                                   unpack)
+import Network.URI                (URI (..), URIAuth (..),
+                                   isAbsoluteURI, parseURI)
 
-import           Data.Swagger
+import Control.Lens
+import Data.Swagger
 
-import           PostgREST.ApiRequest        (ContentType(..))
+import PostgREST.ApiRequest (ContentType (..))
-import           PostgREST.Config            (prettyVersion)
+import PostgREST.Config     (docsVersion, prettyVersion)
-import           PostgREST.Types             (Table(..), Column(..), PgArg(..), ForeignKey(..),
+import PostgREST.Types      (Column (..), ForeignKey (..), PgArg (..),
-                                              PrimaryKey(..), Proxy(..), ProcDescription(..), toMime)
+                             PrimaryKey (..), ProcDescription (..),
+                             Proxy (..), Table (..), toMime)
+import Protolude            hiding (Proxy, dropWhile, get,
+                             intercalate, (&))
 
 makeMimeList :: [ContentType] -> MimeList
 makeMimeList cs = MimeList $ map (fromString . toS . toMime) cs
 
 toSwaggerType :: Text -> SwaggerType t
-toSwaggerType "text"      = SwaggerString
+toSwaggerType "character varying" = SwaggerString
-toSwaggerType "integer"   = SwaggerInteger
+toSwaggerType "character"         = SwaggerString
-toSwaggerType "boolean"   = SwaggerBoolean
+toSwaggerType "text"              = SwaggerString
-toSwaggerType "numeric"   = SwaggerNumber
+toSwaggerType "boolean"           = SwaggerBoolean
-toSwaggerType _           = SwaggerString
+toSwaggerType "smallint"          = SwaggerInteger
+toSwaggerType "integer"           = SwaggerInteger
+toSwaggerType "bigint"            = SwaggerInteger
+toSwaggerType "numeric"           = SwaggerNumber
+toSwaggerType "real"              = SwaggerNumber
+toSwaggerType "double precision"  = SwaggerNumber
+toSwaggerType _                   = SwaggerString
 
 makeTableDef :: [PrimaryKey] -> (Table, [Column], [Text]) -> (Text, Schema)
 makeTableDef pks (t, cs, _) =
   let tn = tableName t in
       (tn, (mempty :: Schema)
         & description .~ tableDescription t
-        & type_ .~ SwaggerObject
+        & type_ ?~ SwaggerObject
-        & properties .~ fromList (map (makeProperty pks) cs))
+        & properties .~ fromList (map (makeProperty pks) cs)
+        & required .~ map colName (filter (not . colNullable) cs))
 
 makeProperty :: [PrimaryKey] -> Column -> (Text, Referenced Schema)
 makeProperty pks c = (colName c, Inline s)
@@ -59,7 +74,7 @@ makeProperty pks c = (colName c, Inline s)
       ]
     d =
       if length n > 1 then
-        Just $ append (fromMaybe "" ((`append` "\n\n") <$> colDescription c)) (intercalate "\n" n)
+        Just $ append (maybe "" (`append` "\n\n") $ colDescription c) (intercalate "\n" n)
       else
         colDescription c
     s =
@@ -69,13 +84,13 @@ makeProperty pks c = (colName c, Inline s)
         & enum_ .~ e
         & format ?~ colType c
         & maxLength .~ (fromIntegral <$> colMaxLen c)
-        & type_ .~ toSwaggerType (colType c)
+        & type_ ?~ toSwaggerType (colType c)
 
 makeProcSchema :: ProcDescription -> Schema
 makeProcSchema pd =
   (mempty :: Schema)
   & description .~ pdDescription pd
-  & type_ .~ SwaggerObject
+  & type_ ?~ SwaggerObject
   & properties .~ fromList (map makeProcProperty (pdArgs pd))
   & required .~ map pgaName (filter pgaReq (pdArgs pd))
 
@@ -83,7 +98,7 @@ makeProcProperty :: PgArg -> (Text, Referenced Schema)
 makeProcProperty (PgArg n t _) = (n, Inline s)
   where
     s = (mempty :: Schema)
-          & type_ .~ toSwaggerType t
+          & type_ ?~ toSwaggerType t
           & format ?~ t
 
 makePreferParam :: [Text] -> Param
@@ -94,7 +109,7 @@ makePreferParam ts =
   & required    ?~ False
   & schema .~ ParamOther ((mempty :: ParamOtherSchema)
     & in_ .~ ParamHeader
-    & type_ .~ SwaggerString
+    & type_ ?~ SwaggerString
     & enum_ .~ decode (encode ts))
 
 makeProcParam :: ProcDescription -> [Referenced Param]
@@ -117,28 +132,35 @@ makeParamDefs ti =
       & required    ?~ False
       & schema .~ ParamOther ((mempty :: ParamOtherSchema)
         & in_ .~ ParamQuery
-        & type_ .~ SwaggerString))
+        & type_ ?~ SwaggerString))
+  , ("on_conflict", (mempty :: Param)
+      & name        .~ "on_conflict"
+      & description ?~ "On Conflict"
+      & required    ?~ False
+      & schema .~ ParamOther ((mempty :: ParamOtherSchema)
+        & in_ .~ ParamQuery
+        & type_ ?~ SwaggerString))
   , ("order", (mempty :: Param)
       & name        .~ "order"
       & description ?~ "Ordering"
       & required    ?~ False
       & schema .~ ParamOther ((mempty :: ParamOtherSchema)
         & in_ .~ ParamQuery
-        & type_ .~ SwaggerString))
+        & type_ ?~ SwaggerString))
   , ("range", (mempty :: Param)
       & name        .~ "Range"
       & description ?~ "Limiting and Pagination"
       & required    ?~ False
       & schema .~ ParamOther ((mempty :: ParamOtherSchema)
         & in_ .~ ParamHeader
-        & type_ .~ SwaggerString))
+        & type_ ?~ SwaggerString))
   , ("rangeUnit", (mempty :: Param)
       & name        .~ "Range-Unit"
       & description ?~ "Limiting and Pagination"
       & required    ?~ False
       & schema .~ ParamOther ((mempty :: ParamOtherSchema)
         & in_ .~ ParamHeader
-        & type_ .~ SwaggerString
+        & type_ ?~ SwaggerString
         & default_ .~ decode "\"items\""))
   , ("offset", (mempty :: Param)
       & name        .~ "offset"
@@ -146,14 +168,14 @@ makeParamDefs ti =
       & required    ?~ False
       & schema .~ ParamOther ((mempty :: ParamOtherSchema)
         & in_ .~ ParamQuery
-        & type_ .~ SwaggerString))
+        & type_ ?~ SwaggerString))
   , ("limit", (mempty :: Param)
       & name        .~ "limit"
       & description ?~ "Limiting and Pagination"
       & required    ?~ False
       & schema .~ ParamOther ((mempty :: ParamOtherSchema)
         & in_ .~ ParamQuery
-        & type_ .~ SwaggerString))
+        & type_ ?~ SwaggerString))
   ]
   <> concat [ makeObjectBody (tableName t) : makeRowFilters (tableName t) cs
             | (t, cs, _) <- ti
@@ -175,7 +197,7 @@ makeRowFilter tn c =
     & required ?~ False
     & schema .~ ParamOther ((mempty :: ParamOtherSchema)
       & in_ .~ ParamQuery
-      & type_ .~ SwaggerString
+      & type_ ?~ SwaggerString
       & format ?~ colType c))
 
 makeRowFilters :: Text -> [Column] -> [(Text, Param)]
@@ -197,10 +219,13 @@ makePathItem (t, cs, _) = ("/" ++ unpack tn, p $ tableInsertable t)
       & at 206 ?~ "Partial Content"
       & at 200 ?~ Inline ((mempty :: Response)
         & description .~ "OK"
-        & schema ?~ (Ref $ Reference $ tableName t)
+        & schema ?~ Inline (mempty
+          & type_ ?~ SwaggerArray
+          & items ?~ (SwaggerItemsObject $ Ref $ Reference $ tableName t)
         )
+      )
     postOp = tOp
-      & parameters .~ map ref ["body." <> tn, "preferReturn"]
+      & parameters .~ map ref ["body." <> tn, "select", "preferReturn"]
       & at 201 ?~ "Created"
     patchOp = tOp
       & parameters .~ map ref (rs <> ["body." <> tn, "preferReturn"])
@@ -219,8 +244,13 @@ makePathItem (t, cs, _) = ("/" ++ unpack tn, p $ tableInsertable t)
 makeProcPathItem :: ProcDescription -> (FilePath, PathItem)
 makeProcPathItem pd = ("/rpc/" ++ toS (pdName pd), pe)
   where
+    -- Use first line of proc description as summary; rest as description (if present)
+    -- We strip leading newlines from description so that users can include a blank line between summary and description
+    (pSum, pDesc) = fmap fst &&& fmap (dropWhile (=='\n') . snd) $
+                    breakOn "\n" <$> pdDescription pd
     postOp = (mempty :: Operation)
-      & description .~ pdDescription pd
+      & summary .~ pSum
+      & description .~ mfilter (/="") pDesc
       & parameters .~ makeProcParam pd
       & tags .~ Set.fromList ["(rpc) " <> pdName pd]
       & produces ?~ makeMimeList [CTApplicationJSON, CTSingularJSON]
@@ -260,7 +290,7 @@ postgrestSpec pds ti (s, h, p, b) sd pks = (mempty :: Swagger)
       & description ?~ d)
   & externalDocs ?~ ((mempty :: ExternalDocs)
     & description ?~ "PostgREST Documentation"
-    & url .~ URL "https://postgrest.com/en/latest/api.html")
+    & url .~ URL ("https://postgrest.org/en/" <> docsVersion <> "/api.html"))
   & host .~ h'
   & definitions .~ fromList (map (makeTableDef pks) ti)
   & parameters .~ fromList (makeParamDefs ti)
@@ -310,7 +340,7 @@ pickProxy proxy
    uri = toURI $ fromJust proxy
    scheme = init $ toLower $ pack $ uriScheme uri
    path URI {uriPath = ""} =  "/"
-   path URI {uriPath = p} = p
+   path URI {uriPath = p}  = p
    path' = pack $ path uri
    authority = fromJust $ uriAuthority uri
    host' = pack $ uriRegName authority
@@ -318,15 +348,15 @@ pickProxy proxy
    readPort = fromMaybe 80 . readMaybe
    port'' :: Integer
    port'' = case (port', scheme) of
-             ("", "http") -> 80
+             ("", "http")  -> 80
              ("", "https") -> 443
-             _ -> readPort $ unpack $ tail $ pack port'
+             _             -> readPort $ unpack $ tail $ pack port'
 
 isUriValid:: URI -> Bool
 isUriValid = fAnd [isSchemeValid, isQueryValid, isAuthorityValid]
 
 fAnd :: [a -> Bool] -> a -> Bool
-fAnd fs x = all ($x) fs
+fAnd fs x = all ($ x) fs
 
 isSchemeValid :: URI -> Bool
 isSchemeValid URI {uriScheme = s}
@@ -336,7 +366,7 @@ isSchemeValid URI {uriScheme = s}
 
 isQueryValid :: URI -> Bool
 isQueryValid URI {uriQuery = ""} = True
-isQueryValid _ = False
+isQueryValid _                   = False
 
 isAuthorityValid :: URI -> Bool
 isAuthorityValid URI {uriAuthority = a}
@@ -345,16 +375,16 @@ isAuthorityValid URI {uriAuthority = a}
 
 isUserInfoValid :: URIAuth -> Bool
 isUserInfoValid URIAuth {uriUserInfo = ""} = True
-isUserInfoValid _ = False
+isUserInfoValid _                          = False
 
 isHostValid :: URIAuth -> Bool
 isHostValid URIAuth {uriRegName = ""} = False
-isHostValid _ = True
+isHostValid _                         = True
 
 isPortValid :: URIAuth -> Bool
 isPortValid URIAuth {uriPort = ""} = True
 isPortValid URIAuth {uriPort = (':':p)} =
   case readMaybe p of
-    Just i -> i > (0 :: Integer) && i < 65536
+    Just i  -> i > (0 :: Integer) && i < 65536
     Nothing -> False
 isPortValid _ = False

src/PostgREST/Parsers.hs

@@ -1,27 +1,44 @@
+{-|
+Module      : PostgREST.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.Parsers where
 
-import           Protolude                     hiding (try, intercalate, replace)
+import qualified Data.HashMap.Strict as M
-import           Control.Monad                 ((>>))
+import qualified Data.Set            as S
-import           Data.Foldable                 (foldl1)
-import qualified Data.HashMap.Strict           as M
-import           Data.Text                     (intercalate, replace, strip)
-import           Data.List                     (init, last)
-import           Data.Tree
-import           Data.Either.Combinators       (mapLeft)
-import           PostgREST.RangeQuery          (NonnegRange,allRange)
-import           PostgREST.Types
-import           Text.ParserCombinators.Parsec hiding (many, (<|>))
-import           Text.Parsec.Error
 
-pRequestSelect :: Text -> Text -> Either ApiRequestError ReadRequest
+import Control.Monad           ((>>))
-pRequestSelect rootName selStr =
+import Data.Either.Combinators (mapLeft)
-  mapError $ parse (pReadRequest rootName) ("failed to parse select parameter (" <> toS selStr <> ")") (toS selStr)
+import Data.Foldable           (foldl1)
+import Data.Functor            (($>))
+import Data.List               (init, last)
+import Data.Text               (intercalate, replace, strip)
+import Text.Read               (read)
+
+import Data.Tree
+import Text.Parsec.Error
+import Text.ParserCombinators.Parsec hiding (many, (<|>))
+
+import PostgREST.Error      (ApiRequestError (ParseRequestError))
+import PostgREST.RangeQuery (NonnegRange)
+import PostgREST.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 (pOperation pVText pVTextL) ("failed to parse filter (" ++ toS v ++ ")") $ toS v
+    oper = parse (pOpExpr pSingleVal) ("failed to parse filter (" ++ toS v ++ ")") $ toS v
     path = fst <$> treePath
     fld = snd <$> treePath
 
@@ -43,9 +60,18 @@ pRequestLogicTree (k, v) = mapError $ (,) <$> embedPath <*> logicTree
   where
     path = parse pLogicPath ("failed to parser logic path (" ++ toS k ++ ")") $ toS k
     embedPath = fst <$> path
-    op = snd <$> path
+    logicTree = do
-    -- Concat op and v to make pLogicTree argument regular, in the form of "op(.,.)"
+      op <- snd <$> path
-    logicTree = join $ parse pLogicTree ("failed to parse logic tree (" ++ toS v ++ ")") . toS <$> ((<>) <$> op <*> pure v)
+      -- 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")
@@ -53,58 +79,53 @@ ws = toS <$> many (oneOf " \t")
 lexeme :: Parser a -> Parser a
 lexeme p = ws *> p <* ws
 
-pReadRequest :: Text -> Parser ReadRequest
-pReadRequest rootNodeName = do
-  fieldTree <- pFieldForest
-  return $ foldr treeEntry (Node (readQuery, (rootNodeName, Nothing, Nothing, Nothing)) []) fieldTree
-  where
-    readQuery = Select [] [rootNodeName] [] Nothing allRange
-    treeEntry :: Tree SelectItem -> ReadRequest -> ReadRequest
-    treeEntry (Node fld@((fn, _),_,alias,relationDetail) fldForest) (Node (q, i) rForest) =
-      case fldForest of
-        [] -> Node (q {select=fld:select q}, i) rForest
-        _  -> Node (q, i) newForest
-          where
-            newForest =
-              foldr treeEntry (Node (Select [] [fn] [] Nothing allRange, (fn, Nothing, alias, relationDetail)) []) fldForest:rForest
-
 pTreePath :: Parser (EmbedPath, Field)
 pTreePath = do
   p <- pFieldName `sepBy1` pDelimiter
-  jp <- optionMaybe pJsonPath
+  jp <- option [] pJsonPath
   return (init p, (last p, jp))
 
 pFieldForest :: Parser [Tree SelectItem]
 pFieldForest = pFieldTree `sepBy1` lexeme (char ',')
-
+  where
-pFieldTree :: Parser (Tree SelectItem)
+    pFieldTree :: Parser (Tree SelectItem)
-pFieldTree =  try (Node <$> pRelationSelect <*> between (char '{') (char '}') pFieldForest)
+    pFieldTree =  try (Node <$> pRelationSelect <*> between (char '(') (char ')') pFieldForest) <|>
-          <|> try (Node <$> pRelationSelect <*> between (char '(') (char ')') pFieldForest)
+                  Node <$> pFieldSelect <*> pure []
-          <|> Node <$> pFieldSelect <*> pure []
 
 pStar :: Parser Text
-pStar = toS <$> (string "*" *> pure ("*"::ByteString))
+pStar = toS <$> (string "*" $> ("*"::ByteString))
-
 
 pFieldName :: Parser Text
-pFieldName = do
+pFieldName =
-  matches <- (many1 (letter <|> digit <|> oneOf "_") `sepBy1` dash) <?> "field name (* or [a..z0..9_])"
+  pQuotedValue <|>
-  return $ intercalate "-" $ map toS matches
+  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 *> pure '-'
+    dash = isDash $> '-'
 
+pJsonPath :: Parser JsonPath
+pJsonPath = many pJsonOperation
+  where
+    pJsonOperation :: Parser JsonOperation
+    pJsonOperation = pJsonArrow <*> pJsonOperand
 
-pJsonPathStep :: Parser Text
+    pJsonArrow   =
-pJsonPathStep = toS <$> try (string "->" *> pFieldName)
+      try (string "->>" $> J2Arrow) <|>
+      try (string "->" $> JArrow)
 
-pJsonPath :: Parser [Text]
+    pJsonOperand =
-pJsonPath = (<>) <$> many pJsonPathStep <*> ( (:[]) <$> (string "->>" *> pFieldName) )
+      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 <*> optionMaybe pJsonPath
+pField = lexeme $ (,) <$> pFieldName <*> option [] pJsonPath
 
 aliasSeparator :: Parser ()
 aliasSeparator = char ':' >> notFollowedBy (char ':')
@@ -113,9 +134,12 @@ pRelationSelect :: Parser SelectItem
 pRelationSelect = lexeme $ try ( do
     alias <- optionMaybe ( try(pFieldName <* aliasSeparator) )
     fld <- pField
-    relationDetail <- optionMaybe ( try( char '.' *> pFieldName ) )
+    hint <- optionMaybe (
-
+        try ( char '!' *> pFieldName) <|>
-    return (fld, Nothing, alias, relationDetail)
+        -- deprecated, remove in next major version
+        try ( char '.' *> pFieldName)
+      )
+    return (fld, Nothing, alias, hint)
   )
 
 pFieldSelect :: Parser SelectItem
@@ -129,71 +153,76 @@ pFieldSelect = lexeme $
   )
   <|> do
     s <- pStar
-    return ((s, Nothing), Nothing, Nothing, Nothing)
+    return ((s, []), Nothing, Nothing, Nothing)
 
-pOperation :: Parser Operand -> Parser Operand -> Parser Operation
+pOpExpr :: Parser SingleVal -> Parser OpExpr
-pOperation parserVText parserVTextL = try ( string "not" *> pDelimiter *> (Operation True <$> pExpr)) <|> Operation False <$> pExpr
+pOpExpr pSVal = try ( string "not" *> pDelimiter *> (OpExpr True <$> pOperation)) <|> OpExpr False <$> pOperation
   where
-    pExpr :: Parser (Operator, Operand)
+    pOperation :: Parser Operation
-    pExpr =
+    pOperation =
-          ((,) <$> (toS <$> foldl1 (<|>) (try . ((<* pDelimiter) . string) . toS <$> M.keys notInOps)) <*> parserVText)
+          Op . toS <$> foldl1 (<|>) (try . ((<* pDelimiter) . string) . toS <$> M.keys ops) <*> pSVal
-      <|> ((,) <$> (toS <$> foldl1 (<|>) (try . ((<* pDelimiter) . string) . toS <$> M.keys inOps)) <*> parserVTextL)
+      <|> In <$> (try (string "in" *> pDelimiter) *> pListVal)
+      <|> pFts
       <?> "operator (eq, gt, ...)"
-    inOps = M.filterWithKey (const . flip elem ["in", "notin"]) operators
-    notInOps = M.difference operators inOps
 
-pVText :: Parser Operand
+    pFts = do
-pVText = VText . toS <$> many anyChar
+      op   <- foldl1 (<|>) (try . string . toS <$> ftsOps)
+      lang <- optionMaybe $ try (between (char '(') (char ')') (many (letter <|> digit <|> oneOf "_")))
+      pDelimiter >> Fts (toS op) (toS <$> lang) <$> pSVal
 
-pVTextL :: Parser Operand
+    ops = M.filterWithKey (const . flip notElem ("in":ftsOps)) operators
-pVTextL =     VTextL <$> try (lexeme (char '(') *> pVTextLElement `sepBy1` char ',' <* lexeme (char ')'))
+    ftsOps = M.keys ftsOperators
-          <|> VTextL <$> lexeme pVTextLElement `sepBy1` char ','
 
-pVTextLElement :: Parser Text
+pSingleVal :: Parser SingleVal
-pVTextLElement = try pQuotedValue <|> (toS <$> many (noneOf ",)"))
+pSingleVal = toS <$> many anyChar
+
+pListVal :: Parser ListVal
+pListVal = lexeme (char '(') *> pListElement `sepBy1` char ',' <* lexeme (char ')')
+
+pListElement :: Parser Text
+pListElement = try (pQuotedValue <* notFollowedBy (noneOf ",)")) <|> (toS <$> many (noneOf ",)"))
 
 pQuotedValue :: Parser Text
-pQuotedValue = toS <$> (char '"' *> many (noneOf "\"") <* char '"' <* notFollowedBy (noneOf ",)"))
+pQuotedValue = toS <$> (char '"' *> many (noneOf "\"") <* char '"')
 
 pDelimiter :: Parser Char
 pDelimiter = char '.' <?> "delimiter (.)"
 
 pOrder :: Parser [OrderTerm]
-pOrder = lexeme pOrderTerm `sepBy` char ','
+pOrder = lexeme pOrderTerm `sepBy1` char ','
 
 pOrderTerm :: Parser OrderTerm
-pOrderTerm =
+pOrderTerm = do
-  try ( do
+  fld <- pField
-    c <- pField
+  dir <- optionMaybe $
-    d <- optionMaybe (try $ pDelimiter *> (
+         try (pDelimiter *> string "asc" $> OrderAsc) <|>
-               try(string "asc" *> pure OrderAsc)
+         try (pDelimiter *> string "desc" $> OrderDesc)
-           <|> try(string "desc" *> pure OrderDesc)
+  nls <- optionMaybe pNulls <* pEnd <|>
-         ))
+         pEnd $> Nothing
-    nls <- optionMaybe (pDelimiter *> (
+  return $ OrderTerm fld dir nls
-                 try(string "nullslast" *> pure OrderNullsLast)
+  where
-             <|> try(string "nullsfirst" *> pure OrderNullsFirst)
+    pNulls = try (pDelimiter *> string "nullsfirst" $> OrderNullsFirst) <|>
-           ))
+             try (pDelimiter *> string "nullslast"  $> OrderNullsLast)
-    return $ OrderTerm c d nls
+    pEnd = try (void $ lookAhead (char ',')) <|>
-  )
+           try eof
-  <|> OrderTerm <$> pField <*> pure Nothing <*> pure Nothing
 
 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 <*> pOperation pLogicVText pLogicVTextL
+    pLogicFilter = Filter <$> pField <* pDelimiter <*> pOpExpr pLogicSingleVal
     pNot :: Parser Bool
-    pNot = try (string "not" *> pDelimiter *> pure True)
+    pNot = try (string "not" *> pDelimiter $> True)
            <|> pure False
            <?> "negation operator (not)"
     pLogicOp :: Parser LogicOperator
-    pLogicOp = try (string "and"  *> pure And)
+    pLogicOp = try (string "and" $> And)
-               <|> string "or" *> pure Or
+               <|> string "or" $> Or
                <?> "logic operator (and, or)"
 
-pLogicVText :: Parser Operand
+pLogicSingleVal :: Parser SingleVal
-pLogicVText = VText <$> (try pQuotedValue <|> try pPgArray <|> (toS <$> many (noneOf ",)")))
+pLogicSingleVal = try (pQuotedValue <* notFollowedBy (noneOf ",)")) <|> try pPgArray <|> (toS <$> many (noneOf ",)"))
   where
     pPgArray :: Parser Text
     pPgArray =  do
@@ -202,9 +231,6 @@ pLogicVText = VText <$> (try pQuotedValue <|> try pPgArray <|> (toS <$> many (no
       c <- string "}"
       toS <$> pure (a ++ b ++ c)
 
-pLogicVTextL :: Parser Operand
-pLogicVTextL = VTextL <$> (lexeme (char '(') *> pVTextLElement `sepBy1` char ',' <* lexeme (char ')'))
-
 pLogicPath :: Parser (EmbedPath, Text)
 pLogicPath = do
   path <- pFieldName `sepBy1` pDelimiter
@@ -212,6 +238,9 @@ pLogicPath = do
       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
@@ -221,3 +250,23 @@ mapError = mapLeft translateError
         message = show $ errorPos e
         details = strip $ replace "\n" " " $ toS
            $ showErrorMessages "or" "unknown parse error" "expecting" "unexpected" "end of input" (errorMessages e)
+
+-- Used for the config value "role-claim-key"
+pRoleClaimKey :: Text -> Either ApiRequestError JSPath
+pRoleClaimKey selStr =
+  mapError $ parse pJSPath ("failed to parse role-claim-key value (" <> toS selStr <> ")") (toS selStr)
+
+pJSPath :: Parser JSPath
+pJSPath = toJSPath <$> (period *> pPath `sepBy` period <* eof)
+  where
+    toJSPath :: [(Text, Maybe Int)] -> JSPath
+    toJSPath = concatMap (\(key, idx) -> JSPKey key : maybeToList (JSPIdx <$> idx))
+    period = char '.' <?> "period (.)"
+    pPath :: Parser (Text, Maybe Int)
+    pPath = (,) <$> pJSPKey <*> optionMaybe pJSPIdx
+
+pJSPKey :: Parser Text
+pJSPKey = toS <$> many1 (alphaNum <|> oneOf "_$@") <|> pQuotedValue <?> "attribute name [a..z0..9_$@])"
+
+pJSPIdx :: Parser Int
+pJSPIdx = char '[' *> (read <$> many1 digit) <* char ']' <?> "array index [0..n]"

src/PostgREST/Private/Common.hs

@@ -0,0 +1,25 @@
+{-|
+Module      : PostgREST.Common
+Description : Common helper functions.
+-}
+module PostgREST.Private.Common where
+
+import           Data.Maybe
+import qualified Hasql.Decoders as HD
+import qualified Hasql.Encoders as HE
+import           Protolude
+
+column :: HD.Value a -> HD.Row a
+column = HD.column . HD.nonNullable
+
+nullableColumn :: HD.Value a -> HD.Row (Maybe a)
+nullableColumn = HD.column . HD.nullable
+
+element :: HD.Value a -> HD.Array a
+element = HD.element . HD.nonNullable
+
+param :: HE.Value a -> HE.Params a
+param = HE.param . HE.nonNullable
+
+arrayParam :: HE.Value a -> HE.Params [a]
+arrayParam = param . HE.array . HE.dimension foldl' . HE.element . HE.nonNullable

src/PostgREST/Private/QueryFragment.hs

@@ -0,0 +1,205 @@
+{-# LANGUAGE LambdaCase #-}
+{-|
+Module      : PostgREST.Private.QueryFragment
+Description : Helper functions for PostgREST.QueryBuilder.
+
+Any function that outputs a SqlFragment should be in this module.
+-}
+module PostgREST.Private.QueryFragment where
+
+import qualified Data.HashMap.Strict           as HM
+import           Data.Maybe
+import           Data.Text                     (intercalate,
+                                                isInfixOf, replace,
+                                                toLower, unwords)
+import qualified Data.Text                     as T (map, null,
+                                                     takeWhile)
+import           PostgREST.Types
+import           Protolude                     hiding (cast,
+                                                intercalate, replace)
+import           Text.InterpolatedString.Perl6 (qc)
+
+noLocationF :: SqlFragment
+noLocationF = "array[]::text[]"
+
+-- Due to the use of the `unknown` encoder we need to cast '$1' when the value is not used in the main query
+-- otherwise the query will err with a `could not determine data type of parameter $1`.
+-- This happens because `unknown` relies on the context to determine the value type.
+-- The error also happens on raw libpq used with C.
+ignoredBody :: SqlFragment
+ignoredBody = "pgrst_ignored_body AS (SELECT $1::text) "
+
+-- |
+-- These CTEs convert a json object into a json array, this way we can use json_populate_recordset for all json payloads
+-- Otherwise we'd have to use json_populate_record for json objects and json_populate_recordset for json arrays
+-- We do this in SQL to avoid processing the JSON in application code
+normalizedBody :: SqlFragment
+normalizedBody =
+  unwords [
+    "pgrst_payload AS (SELECT $1::json AS json_data),",
+    "pgrst_body AS (",
+      "SELECT",
+        "CASE WHEN json_typeof(json_data) = 'array'",
+          "THEN json_data",
+          "ELSE json_build_array(json_data)",
+        "END AS val",
+      "FROM pgrst_payload)"]
+
+selectBody :: SqlFragment
+selectBody = "(SELECT val FROM pgrst_body)"
+
+pgFmtLit :: SqlFragment -> SqlFragment
+pgFmtLit x =
+ let trimmed = trimNullChars x
+     escaped = "'" <> replace "'" "''" trimmed <> "'"
+     slashed = replace "\\" "\\\\" escaped in
+ if "\\" `isInfixOf` escaped
+   then "E" <> slashed
+   else slashed
+
+pgFmtIdent :: SqlFragment -> SqlFragment
+pgFmtIdent x = "\"" <> replace "\"" "\"\"" (trimNullChars $ toS x) <> "\""
+
+asCsvF :: SqlFragment
+asCsvF = asCsvHeaderF <> " || '\n' || " <> asCsvBodyF
+  where
+    asCsvHeaderF =
+      "(SELECT coalesce(string_agg(a.k, ','), '')" <>
+      "  FROM (" <>
+      "    SELECT json_object_keys(r)::TEXT as k" <>
+      "    FROM ( " <>
+      "      SELECT row_to_json(hh) as r from " <> sourceCTEName <> " as hh limit 1" <>
+      "    ) s" <>
+      "  ) a" <>
+      ")"
+    asCsvBodyF = "coalesce(string_agg(substring(_postgrest_t::text, 2, length(_postgrest_t::text) - 2), '\n'), '')"
+
+asJsonF :: SqlFragment
+asJsonF = "coalesce(json_agg(_postgrest_t), '[]')::character varying"
+
+asJsonSingleF :: SqlFragment --TODO! unsafe when the query actually returns multiple rows, used only on inserting and returning single element
+asJsonSingleF = "coalesce(string_agg(row_to_json(_postgrest_t)::text, ','), '')::character varying "
+
+asBinaryF :: FieldName -> SqlFragment
+asBinaryF fieldName = "coalesce(string_agg(_postgrest_t." <> pgFmtIdent fieldName <> ", ''), '')"
+
+locationF :: [Text] -> SqlFragment
+locationF pKeys = [qc|(
+  WITH data AS (SELECT row_to_json(_) AS row FROM {sourceCTEName} AS _ LIMIT 1)
+  SELECT array_agg(json_data.key || '=' || coalesce('eq.' || json_data.value, 'is.null'))
+  FROM data CROSS JOIN json_each_text(data.row) AS json_data
+  {("WHERE json_data.key IN ('" <> intercalate "','" pKeys <> "')") `emptyOnFalse` null pKeys}
+)|]
+
+fromQi :: QualifiedIdentifier -> SqlFragment
+fromQi t = (if s == "" then "" else pgFmtIdent s <> ".") <> pgFmtIdent n
+  where
+    n = qiName t
+    s = qiSchema t
+
+emptyOnFalse :: Text -> Bool -> Text
+emptyOnFalse val cond = if cond then "" else val
+
+pgFmtColumn :: QualifiedIdentifier -> Text -> SqlFragment
+pgFmtColumn table "*" = fromQi table <> ".*"
+pgFmtColumn table c   = fromQi table <> "." <> pgFmtIdent c
+
+pgFmtField :: QualifiedIdentifier -> Field -> SqlFragment
+pgFmtField table (c, jp) = pgFmtColumn table c <> pgFmtJsonPath jp
+
+pgFmtSelectItem :: QualifiedIdentifier -> SelectItem -> SqlFragment
+pgFmtSelectItem table (f@(fName, jp), Nothing, alias, _) = pgFmtField table f <> pgFmtAs fName jp alias
+pgFmtSelectItem table (f@(fName, jp), Just cast, alias, _) = "CAST (" <> pgFmtField table f <> " AS " <> cast <> " )" <> pgFmtAs fName jp alias
+
+pgFmtOrderTerm :: QualifiedIdentifier -> OrderTerm -> SqlFragment
+pgFmtOrderTerm qi ot = unwords [
+  toS . pgFmtField qi $ otTerm ot,
+  maybe "" show $ otDirection ot,
+  maybe "" show $ otNullOrder ot]
+
+pgFmtFilter :: QualifiedIdentifier -> Filter -> SqlFragment
+pgFmtFilter table (Filter fld (OpExpr hasNot oper)) = notOp <> " " <> case oper of
+   Op op val  -> pgFmtFieldOp op <> " " <> case op of
+     "like"  -> unknownLiteral (T.map star val)
+     "ilike" -> unknownLiteral (T.map star val)
+     "is"    -> whiteList val
+     _       -> unknownLiteral val
+
+   In vals -> pgFmtField table fld <> " " <>
+    let emptyValForIn = "= any('{}') " in -- Workaround because for postgresql "col IN ()" is invalid syntax, we instead do "col = any('{}')"
+    case (&&) (length vals == 1) . T.null <$> headMay vals of
+      Just False -> sqlOperator "in" <> "(" <> intercalate ", " (map unknownLiteral vals) <> ") "
+      Just True  -> emptyValForIn
+      Nothing    -> emptyValForIn
+
+   Fts op lang val ->
+     pgFmtFieldOp op
+       <> "("
+       <> maybe "" ((<> ", ") . pgFmtLit) lang
+       <> unknownLiteral val
+       <> ") "
+ where
+   pgFmtFieldOp op = pgFmtField table fld <> " " <> sqlOperator op
+   sqlOperator o = HM.lookupDefault "=" o operators
+   notOp = if hasNot then "NOT" else ""
+   star c = if c == '*' then '%' else c
+   unknownLiteral = (<> "::unknown ") . pgFmtLit
+   whiteList :: Text -> SqlFragment
+   whiteList v = fromMaybe
+     (toS (pgFmtLit v) <> "::unknown ")
+     (find ((==) . toLower $ v) ["null","true","false"])
+
+pgFmtJoinCondition :: JoinCondition -> SqlFragment
+pgFmtJoinCondition (JoinCondition (qi1, col1) (qi2, col2)) =
+  pgFmtColumn qi1 col1 <> " = " <> pgFmtColumn qi2 col2
+
+pgFmtLogicTree :: QualifiedIdentifier -> LogicTree -> SqlFragment
+pgFmtLogicTree qi (Expr hasNot op forest) = notOp <> " (" <> intercalate (" " <> show op <> " ") (pgFmtLogicTree qi <$> forest) <> ")"
+  where notOp =  if hasNot then "NOT" else ""
+pgFmtLogicTree qi (Stmnt flt) = pgFmtFilter qi flt
+
+pgFmtJsonPath :: JsonPath -> SqlFragment
+pgFmtJsonPath = \case
+  []             -> ""
+  (JArrow x:xs)  -> "->" <> pgFmtJsonOperand x <> pgFmtJsonPath xs
+  (J2Arrow x:xs) -> "->>" <> pgFmtJsonOperand x <> pgFmtJsonPath xs
+  where
+    pgFmtJsonOperand (JKey k) = pgFmtLit k
+    pgFmtJsonOperand (JIdx i) = pgFmtLit i <> "::int"
+
+pgFmtAs :: FieldName -> JsonPath -> Maybe Alias -> SqlFragment
+pgFmtAs _ [] Nothing = ""
+pgFmtAs fName jp Nothing = case jOp <$> lastMay jp of
+  Just (JKey key) -> " AS " <> pgFmtIdent key
+  Just (JIdx _)   -> " AS " <> pgFmtIdent (fromMaybe fName lastKey)
+    -- We get the lastKey because on:
+    -- `select=data->1->mycol->>2`, we need to show the result as [ {"mycol": ..}, {"mycol": ..} ]
+    -- `select=data->3`, we need to show the result as [ {"data": ..}, {"data": ..} ]
+    where lastKey = jVal <$> find (\case JKey{} -> True; _ -> False) (jOp <$> reverse jp)
+  Nothing -> ""
+pgFmtAs _ _ (Just alias) = " AS " <> pgFmtIdent alias
+
+trimNullChars :: Text -> Text
+trimNullChars = T.takeWhile (/= '\x0')
+
+countF :: SqlQuery -> Bool -> (SqlFragment, SqlFragment)
+countF countQuery shouldCount =
+  if shouldCount
+    then (
+        ", pg_source_count AS (" <> countQuery <> ")"
+      , "(SELECT pg_catalog.count(*) FROM pg_source_count)" )
+    else (
+        mempty
+      , "null::bigint")
+
+returningF :: QualifiedIdentifier -> [FieldName] -> SqlFragment
+returningF qi returnings =
+  if null returnings
+    then "RETURNING 1" -- For mutation cases where there's no ?select, we return 1 to know how many rows were modified
+    else "RETURNING " <> intercalate ", " (pgFmtColumn qi <$> returnings)
+
+responseHeadersF :: PgVersion -> SqlFragment
+responseHeadersF pgVer =
+  if pgVer >= pgVersion96
+    then "coalesce(nullif(current_setting('response.headers', true), ''), '[]')" :: Text -- nullif is used because of https://gist.github.com/steve-chavez/8d7033ea5655096903f3b52f8ed09a15
+    else "'[]'" :: Text

src/PostgREST/QueryBuilder.hs

@@ -1,472 +1,181 @@
-{-# LANGUAGE FlexibleInstances    #-}
+{-# LANGUAGE DuplicateRecordFields #-}
-{-# OPTIONS_GHC -fno-warn-orphans #-}
+{-# LANGUAGE FlexibleContexts      #-}
+{-# LANGUAGE FlexibleInstances     #-}
+{-# OPTIONS_GHC -fno-warn-orphans  #-}
 {-|
 Module      : PostgREST.QueryBuilder
-Description : PostgREST SQL generating functions.
+Description : PostgREST SQL queries generating functions.
 
 This module provides functions to consume data types that
-represent database objects (e.g. Relation, Schema, SqlQuery)
+represent database queries (e.g. ReadRequest, MutateRequest) and SqlFragment
-and produces SQL Statements.
+to produce SqlQuery type outputs.
-
-Any function that outputs a SQL fragment should be in this module.
 -}
 module PostgREST.QueryBuilder (
-    callProc
+    readRequestToQuery
-  , createReadStatement
+  , mutateRequestToQuery
-  , createWriteStatement
+  , readRequestToCountQuery
-  , getJoinFilters
+  , requestToCallProcQuery
-  , pgFmtIdent
+  , limitedQuery
-  , pgFmtLit
+  , setLocalQuery
-  , requestToQuery
+  , setLocalSearchPathQuery
-  , requestToCountQuery
-  , sourceCTEName
-  , unquoted
-  , ResultsWithCount
-  , pgFmtEnvVar
   ) where
 
-import qualified Hasql.Query             as H
+import qualified Data.Set as S
-import qualified Hasql.Encoders          as HE
-import qualified Hasql.Decoders          as HD
 
-import qualified Data.Aeson              as JSON
+import Data.Text (intercalate, unwords)
+import Data.Tree (Tree (..))
 
-import           PostgREST.RangeQuery    (NonnegRange, rangeLimit, rangeOffset, allRange)
+import Data.Maybe
-import           Data.Functor.Contravariant (contramap)
-import qualified Data.HashMap.Strict     as HM
-import           Data.Maybe
-import           Data.Text               (intercalate, unwords, replace, isInfixOf, toLower)
-import qualified Data.Text as T          (map, takeWhile, null)
-import qualified Data.Text.Encoding as T
-import           Data.Tree               (Tree(..))
-import qualified Data.Vector as V
-import           PostgREST.Types
-import           Text.InterpolatedString.Perl6 (qc)
-import qualified Data.ByteString.Char8   as BS
-import           Data.Scientific         ( FPFormat (..)
-                                         , formatScientific
-                                         , isInteger
-                                         )
-import           Protolude hiding        (from, intercalate, ord, cast, replace)
-import           PostgREST.ApiRequest    (PreferRepresentation (..))
 
-{-| The generic query result format used by API responses. The location header
+import PostgREST.Private.QueryFragment
-    is represented as a list of strings containing variable bindings like
+import PostgREST.RangeQuery            (allRange, rangeLimit,
-    @"k1=eq.42"@, or the empty list if there is no location header.
+                                        rangeOffset)
--}
+import PostgREST.Types
-type ResultsWithCount = (Maybe Int64, Int64, [BS.ByteString], BS.ByteString)
+import Protolude                       hiding (cast, intercalate,
+                                        replace)
 
-standardRow :: HD.Row ResultsWithCount
+readRequestToQuery :: ReadRequest -> SqlQuery
-standardRow = (,,,) <$> HD.nullableValue HD.int8 <*> HD.value HD.int8
+readRequestToQuery (Node (Select colSelects mainQi tblAlias implJoins logicForest joinConditions_ ordts range, _) forest) =
-                    <*> HD.value header <*> HD.value HD.bytea
+  unwords [
-  where
+    "SELECT " <> intercalate ", " (map (pgFmtSelectItem qi) colSelects ++ selects),
-    header = HD.array $ HD.arrayDimension replicateM $ HD.arrayValue HD.bytea
+    "FROM " <> intercalate ", " (tabl : implJs),
-
+    unwords joins,
-noLocationF :: Text
+    ("WHERE " <> intercalate " AND " (map (pgFmtLogicTree qi) logicForest ++ map pgFmtJoinCondition joinConditions_))
-noLocationF = "array[]::text[]"
+      `emptyOnFalse` (null logicForest && null joinConditions_),
-
+    ("ORDER BY " <> intercalate ", " (map (pgFmtOrderTerm qi) ordts)) `emptyOnFalse` null ordts,
-{-| Read and Write api requests use a similar response format which includes
+    ("LIMIT " <> maybe "ALL" show (rangeLimit range) <> " OFFSET " <> show (rangeOffset range)) `emptyOnFalse` (range == allRange)
-    various record counts and possible location header. This is the decoder
-    for that common type of query.
--}
-decodeStandard :: HD.Result ResultsWithCount
-decodeStandard =
-  HD.singleRow standardRow
-
-decodeStandardMay :: HD.Result (Maybe ResultsWithCount)
-decodeStandardMay =
-  HD.maybeRow standardRow
-
-{-| JSON and CSV payloads from the client are given to us as
-    PayloadJSON (objects who all have the same keys),
-    and we turn this into an old fasioned JSON array
--}
-encodeUniformObjs :: HE.Params PayloadJSON
-encodeUniformObjs =
-  contramap (JSON.Array . V.map JSON.Object . unPayloadJSON) (HE.value HE.json)
-
-createReadStatement :: SqlQuery -> SqlQuery -> Bool -> Bool -> Bool -> Maybe FieldName ->
-                       H.Query () ResultsWithCount
-createReadStatement selectQuery countQuery isSingle countTotal asCsv binaryField =
-  unicodeStatement sql HE.unit decodeStandard False
- where
-  sql = [qc|
-      WITH {sourceCTEName} AS ({selectQuery}) SELECT {cols}
-      FROM ( SELECT * FROM {sourceCTEName}) _postgrest_t |]
-  countResultF = if countTotal then "("<>countQuery<>")" else "null"
-  cols = intercalate ", " [
-      countResultF <> " AS total_result_set",
-      "pg_catalog.count(_postgrest_t) AS page_total",
-      noLocationF <> " AS header",
-      bodyF <> " AS body"
     ]
-  bodyF
+  where
-    | asCsv = asCsvF
+    implJs = fromQi <$> implJoins
-    | isSingle = asJsonSingleF
+    tabl = fromQi mainQi <> maybe mempty (\a -> " AS " <> pgFmtIdent a) tblAlias
-    | isJust binaryField = asBinaryF $ fromJust binaryField
+    qi = maybe mainQi (QualifiedIdentifier mempty) tblAlias
-    | otherwise = asJsonF
+    (joins, selects) = foldr getJoinsSelects ([],[]) forest
 
-createWriteStatement :: SqlQuery -> SqlQuery -> Bool -> Bool -> Bool ->
+getJoinsSelects :: ReadRequest -> ([SqlFragment], [SqlFragment]) -> ([SqlFragment], [SqlFragment])
-                        PreferRepresentation -> [Text] ->
+getJoinsSelects rr@(Node (_, (name, Just Relation{relType=relTyp,relTable=Table{tableName=table}}, alias, _, _)) _) (j,s) =
-                        H.Query PayloadJSON (Maybe ResultsWithCount)
+  let subquery = readRequestToQuery rr in
-createWriteStatement selectQuery mutateQuery wantSingle wantHdrs asCsv rep pKeys =
+  case relTyp of
-  unicodeStatement sql encodeUniformObjs decodeStandardMay True
+    M2O ->
+      let aliasOrName = fromMaybe name alias
+          localTableName = pgFmtIdent $ table <> "_" <> aliasOrName
+          sel = "row_to_json(" <> localTableName <> ".*) AS " <> pgFmtIdent aliasOrName
+          joi = " LEFT JOIN LATERAL( " <> subquery <> " ) AS " <> localTableName <> " ON TRUE " in
+      (joi:j,sel:s)
+    _ ->
+      let sel = "COALESCE (("
+             <> "SELECT json_agg(" <> pgFmtIdent table <> ".*) "
+             <> "FROM (" <> subquery <> ") " <> pgFmtIdent table
+             <> "), '[]') AS " <> pgFmtIdent (fromMaybe name alias) in
+      (j,sel:s)
+getJoinsSelects (Node (_, (_, Nothing, _, _, _)) _) _ = ([], [])
 
- where
+mutateRequestToQuery :: MutateRequest -> SqlQuery
-  sql = case rep of
+mutateRequestToQuery (Insert mainQi iCols onConflct putConditions returnings) =
-    None -> [qc|
+  unwords [
-      WITH {sourceCTEName} AS ({mutateQuery})
+    "WITH " <> normalizedBody,
-      SELECT '', 0, {noLocationF}, '' |]
+    "INSERT INTO ", fromQi mainQi, if S.null iCols then " " else "(" <> cols <> ")",
-    HeadersOnly -> [qc|
+    unwords [
-      WITH {sourceCTEName} AS ({mutateQuery})
+      "SELECT " <> cols <> " FROM",
-      SELECT {cols}
+      "json_populate_recordset", "(null::", fromQi mainQi, ", " <> selectBody <> ") _",
-      FROM (SELECT 1 FROM {sourceCTEName}) _postgrest_t |]
+      -- Only used for PUT
-    Full -> [qc|
+      ("WHERE " <> intercalate " AND " (pgFmtLogicTree (QualifiedIdentifier mempty "_") <$> putConditions)) `emptyOnFalse` null putConditions],
-      WITH {sourceCTEName} AS ({mutateQuery})
+    maybe "" (\(oncDo, oncCols) -> (
-      SELECT {cols}
+      "ON CONFLICT(" <> intercalate ", " (pgFmtIdent <$> oncCols) <> ") " <> case oncDo of
-      FROM ({selectQuery}) _postgrest_t |]
+      IgnoreDuplicates ->
-
+        "DO NOTHING"
-  cols = intercalate ", " [
+      MergeDuplicates  ->
-      "'' AS total_result_set", -- when updateing it does not make sense
+        if S.null iCols
-      "pg_catalog.count(_postgrest_t) AS page_total",
+           then "DO NOTHING"
-      if wantHdrs
+           else "DO UPDATE SET " <> intercalate ", " (pgFmtIdent <> const " = EXCLUDED." <> pgFmtIdent <$> S.toList iCols)
-         then locationF pKeys
+                                   ) `emptyOnFalse` null oncCols) onConflct,
-         else noLocationF <> " AS header",
+    returningF mainQi returnings
-      if rep == Full
-         then bodyF <> " AS body"
-         else "''"
     ]
-
-  bodyF
-    | asCsv = asCsvF
-    | wantSingle = asJsonSingleF
-    | otherwise = asJsonF
-
-type ProcResults = (Maybe Int64, Int64, ByteString)
-callProc :: QualifiedIdentifier -> JSON.Object -> Bool -> SqlQuery -> SqlQuery -> NonnegRange ->
-  Bool -> Bool -> Bool -> Bool -> Bool -> Maybe FieldName -> H.Query () (Maybe ProcResults)
-callProc qi params returnsScalar selectQuery countQuery _ countTotal isSingle paramsAsJson asCsv asBinary binaryField =
-  unicodeStatement sql HE.unit decodeProc True
   where
-    sql =
+    cols = intercalate ", " $ pgFmtIdent <$> S.toList iCols
-     if returnsScalar then [qc|
+mutateRequestToQuery (Update mainQi uCols logicForest returnings) =
-       WITH {sourceCTEName} AS ({_callSql})
+  if S.null uCols
-       SELECT
+    then "WITH " <> ignoredBody <> "SELECT null WHERE false" -- if there are no columns we cannot do UPDATE table SET {empty}, it'd be invalid syntax
-         {countResultF} AS total_result_set,
+    else
-         1 AS page_total,
-         {scalarBodyF} as body
-       FROM ({selectQuery}) _postgrest_t;|]
-     else [qc|
-       WITH {sourceCTEName} AS ({_callSql})
-       SELECT
-         {countResultF} AS total_result_set,
-         pg_catalog.count(_postgrest_t) AS page_total,
-         {bodyF} as body
-       FROM ({selectQuery}) _postgrest_t;|]
-
-    countResultF = if countTotal then "( "<> countQuery <> ")" else "null::bigint" :: Text
-    _args = if paramsAsJson
-                then insertableValueWithType "json" $ JSON.Object params
-                else intercalate "," $ map _assignment (HM.toList params)
-    _procName = qiName qi
-    _assignment (n,v) = pgFmtIdent n <> ":=" <> insertableValue v
-    _callSql = [qc|select * from {fromQi qi}({_args}) |] :: Text
-    decodeProc = HD.maybeRow procRow
-    procRow = (,,) <$> HD.nullableValue HD.int8 <*> HD.value HD.int8
-                   <*> HD.value HD.bytea
-    scalarBodyF
-     | asBinary = asBinaryF _procName
-     | otherwise = "(row_to_json(_postgrest_t)->" <> pgFmtLit _procName <> ")::character varying"
-
-    bodyF
-     | isSingle = asJsonSingleF
-     | asCsv = asCsvF
-     | isJust binaryField = asBinaryF $ fromJust binaryField
-     | otherwise = asJsonF
-
-pgFmtIdent :: SqlFragment -> SqlFragment
-pgFmtIdent x = "\"" <> replace "\"" "\"\"" (trimNullChars $ toS x) <> "\""
-
-pgFmtLit :: SqlFragment -> SqlFragment
-pgFmtLit x =
- let trimmed = trimNullChars x
-     escaped = "'" <> replace "'" "''" trimmed <> "'"
-     slashed = replace "\\" "\\\\" escaped in
- if "\\" `isInfixOf` escaped
-   then "E" <> slashed
-   else slashed
-
-requestToCountQuery :: Schema -> DbRequest -> SqlQuery
-requestToCountQuery _ (DbMutate _) = undefined
-requestToCountQuery schema (DbRead (Node (Select _ _ logicForest _ _, (mainTbl, _, _, _)) _)) =
- unwords [
-   "SELECT pg_catalog.count(*)",
-   "FROM ", fromQi qi,
-    ("WHERE " <> intercalate " AND " (map (pgFmtLogicTree qi) filteredLogic)) `emptyOnFalse` null filteredLogic
-   ]
- where
-   qi = removeSourceCTESchema schema mainTbl
-   -- all foreing key filters are root nodes(see addFilterToLogicForest), only those are filtered
-   nonFKRoot :: LogicTree -> Bool
-   nonFKRoot (Stmnt (Filter _ Operation{expr=(_, VForeignKey _ _)})) = False
-   nonFKRoot (Stmnt _) = True
-   nonFKRoot Expr{} = True
-   filteredLogic = filter nonFKRoot logicForest
-
-requestToQuery :: Schema -> Bool -> DbRequest -> SqlQuery
-requestToQuery schema isParent (DbRead (Node (Select colSelects tbls logicForest ord range, (nodeName, maybeRelation, _, _)) forest)) =
-  query
-  where
-    mainTbl = fromMaybe nodeName (tableName . relTable <$> maybeRelation)
-    qi = removeSourceCTESchema schema mainTbl
-    toQi = removeSourceCTESchema schema
-    query = unwords [
-      "SELECT ", intercalate ", " (map (pgFmtSelectItem qi) colSelects ++ selects),
-      "FROM ", intercalate ", " (map (fromQi . toQi) tbls),
-      unwords joins,
-      ("WHERE " <> intercalate " AND " (map (pgFmtLogicTree qi) logicForest)) `emptyOnFalse` null logicForest,
-      orderF (fromMaybe [] ord),
-      if isParent then "" else limitF range
-      ]
-    orderF ts =
-        if null ts
-            then ""
-            else "ORDER BY " <> clause
-        where
-            clause = intercalate "," (map queryTerm ts)
-            queryTerm :: OrderTerm -> Text
-            queryTerm t = " "
-                <> toS (pgFmtField qi $ otTerm t) <> " "
-                <> maybe "" show (otDirection t) <> " "
-                <> maybe "" show (otNullOrder t) <> " "
-    (joins, selects) = foldr getQueryParts ([],[]) forest
-
-    getQueryParts :: Tree ReadNode -> ([SqlFragment], [SqlFragment]) -> ([SqlFragment], [SqlFragment])
-    getQueryParts (Node n@(_, (name, Just Relation{relType=Child,relTable=Table{tableName=table}}, alias, _)) forst) (j,s) = (j,sel:s)
-      where
-        sel = "COALESCE(("
-           <> "SELECT array_to_json(array_agg(row_to_json("<>pgFmtIdent table<>"))) "
-           <> "FROM (" <> subquery <> ") " <> pgFmtIdent table
-           <> "), '[]') AS " <> pgFmtIdent (fromMaybe name alias)
-           where subquery = requestToQuery schema False (DbRead (Node n forst))
-    getQueryParts (Node n@(_, (name, Just r@Relation{relType=Parent,relTable=Table{tableName=table}}, alias, _)) forst) (j,s) = (joi:j,sel:s)
-      where
-        node_name = fromMaybe name alias
-        local_table_name = table <> "_" <> node_name
-        replaceTableName localTableName (Filter a (Operation b (c, VForeignKey (QualifiedIdentifier "" _) d))) = Filter a (Operation b (c, VForeignKey (QualifiedIdentifier "" localTableName) d))
-        replaceTableName _ x = x
-        sel = "row_to_json(" <> pgFmtIdent local_table_name <> ".*) AS " <> pgFmtIdent node_name
-        joi = " LEFT OUTER JOIN ( " <> subquery <> " ) AS " <> pgFmtIdent local_table_name  <>
-              " ON " <> intercalate " AND " ( map (pgFmtFilter qi . replaceTableName local_table_name) (getJoinFilters r) )
-          where subquery = requestToQuery schema True (DbRead (Node n forst))
-    getQueryParts (Node n@(_, (name, Just Relation{relType=Many,relTable=Table{tableName=table}}, alias, _)) forst) (j,s) = (j,sel:s)
-      where
-        sel = "COALESCE (("
-           <> "SELECT array_to_json(array_agg(row_to_json("<>pgFmtIdent table<>"))) "
-           <> "FROM (" <> subquery <> ") " <> pgFmtIdent table
-           <> "), '[]') AS " <> pgFmtIdent (fromMaybe name alias)
-           where subquery = requestToQuery schema False (DbRead (Node n forst))
-    --the following is just to remove the warning
-    --getQueryParts is not total but requestToQuery is called only after addJoinConditions which ensures the only
-    --posible relations are Child Parent Many
-    getQueryParts _ _ = undefined
-requestToQuery schema _ (DbMutate (Insert mainTbl (PayloadJSON rows) returnings)) =
-  insInto <> vals <> ret
-  where qi = QualifiedIdentifier schema mainTbl
-        cols = map pgFmtIdent $ fromMaybe [] (HM.keys <$> (rows V.!? 0))
-        colsString = intercalate ", " cols
-        insInto = unwords [ "INSERT INTO" , fromQi qi,
-            if T.null colsString then "" else "(" <> colsString <> ")"
-          ]
-        vals = unwords $
-          if T.null colsString
-            then if V.null rows then ["SELECT null WHERE false"] else ["DEFAULT VALUES"]
-            else ["SELECT", colsString, "FROM json_populate_recordset(null::" , fromQi qi, ", $1)"]
-        ret = if null returnings
-                  then ""
-                  else unwords [" RETURNING ", intercalate ", " (map (pgFmtColumn qi) returnings)]
-requestToQuery schema _ (DbMutate (Update mainTbl (PayloadJSON rows) logicForest returnings)) =
-  case rows V.!? 0 of
-    Just obj ->
-      let assignments = map
-            (\(k,v) -> pgFmtIdent k <> "=" <> insertableValue v) $ HM.toList obj in
       unwords [
-        "UPDATE ", fromQi qi,
+        "WITH " <> normalizedBody,
-        " SET " <> intercalate "," assignments <> " ",
+        "UPDATE " <> fromQi mainQi <> " SET " <> cols,
-        ("WHERE " <> intercalate " AND " (map (pgFmtLogicTree qi) logicForest)) `emptyOnFalse` null logicForest,
+        "FROM (SELECT * FROM json_populate_recordset", "(null::", fromQi mainQi, ", " <> selectBody <> ")) _ ",
-        ("RETURNING " <> intercalate ", " (map (pgFmtColumn qi) returnings)) `emptyOnFalse` null returnings
+        ("WHERE " <> intercalate " AND " (pgFmtLogicTree mainQi <$> logicForest)) `emptyOnFalse` null logicForest,
+        returningF mainQi returnings
         ]
-    Nothing -> undefined
   where
-    qi = QualifiedIdentifier schema mainTbl
+    cols = intercalate ", " (pgFmtIdent <> const " = _." <> pgFmtIdent <$> S.toList uCols)
-requestToQuery schema _ (DbMutate (Delete mainTbl logicForest returnings)) =
+mutateRequestToQuery (Delete mainQi logicForest returnings) =
-  query
+  unwords [
+    "WITH " <> ignoredBody,
+    "DELETE FROM ", fromQi mainQi,
+    ("WHERE " <> intercalate " AND " (map (pgFmtLogicTree mainQi) logicForest)) `emptyOnFalse` null logicForest,
+    returningF mainQi returnings
+    ]
+
+requestToCallProcQuery :: QualifiedIdentifier -> [PgArg] -> Bool -> Maybe PreferParameters -> SqlQuery
+requestToCallProcQuery qi pgArgs returnsScalar preferParams =
+  unwords [
+    "WITH",
+    argsCTE,
+    sourceBody ]
   where
-    qi = QualifiedIdentifier schema mainTbl
+    paramsAsSingleObject    = preferParams == Just SingleObject
-    query = unwords [
+    paramsAsMulitpleObjects = preferParams == Just MultipleObjects
-      "DELETE FROM ", fromQi qi,
-      ("WHERE " <> intercalate " AND " (map (pgFmtLogicTree qi) logicForest)) `emptyOnFalse` null logicForest,
-      ("RETURNING " <> intercalate ", " (map (pgFmtColumn qi) returnings)) `emptyOnFalse` null returnings
-      ]
 
-sourceCTEName :: SqlFragment
+    (argsCTE, args)
-sourceCTEName = "pg_source"
+      | null pgArgs = (ignoredBody, "")
+      | paramsAsSingleObject = ("pgrst_args AS (SELECT NULL)", "$1::json")
+      | otherwise = (
+          unwords [
+            normalizedBody <> ",",
+            "pgrst_args AS (",
+              "SELECT * FROM json_to_recordset(" <> selectBody <> ") AS _(" <> fmtArgs (\a -> " " <> pgaType a) <> ")",
+            ")"]
+         , if paramsAsMulitpleObjects
+             then fmtArgs (\a -> " := pgrst_args." <> pgFmtIdent (pgaName a))
+             else fmtArgs (\a -> " := (SELECT " <> pgFmtIdent (pgaName a) <> " FROM pgrst_args LIMIT 1)")
+        )
 
-removeSourceCTESchema :: Schema -> TableName -> QualifiedIdentifier
+    fmtArgs :: (PgArg -> SqlFragment) -> SqlFragment
-removeSourceCTESchema schema tbl = QualifiedIdentifier (if tbl == sourceCTEName then "" else schema) tbl
+    fmtArgs argFrag = intercalate ", " ((\a -> pgFmtIdent (pgaName a) <> argFrag a) <$> pgArgs)
 
-unquoted :: JSON.Value -> Text
+    sourceBody :: SqlFragment
-unquoted (JSON.String t) = t
+    sourceBody
-unquoted (JSON.Number n) =
+      | paramsAsMulitpleObjects =
-  toS $ formatScientific Fixed (if isInteger n then Just 0 else Nothing) n
+          if returnsScalar
-unquoted (JSON.Bool b) = show b
+            then "SELECT " <> callIt <> " AS pgrst_scalar FROM pgrst_args"
-unquoted v = toS $ JSON.encode v
+            else unwords [ "SELECT pgrst_lat_args.*"
+                         , "FROM pgrst_args,"
+                         , "LATERAL ( SELECT * FROM " <> callIt <> " ) pgrst_lat_args" ]
+      | otherwise =
+          if returnsScalar
+            then "SELECT " <> callIt <> " AS pgrst_scalar"
+            else "SELECT * FROM " <> callIt
 
--- private functions
+    callIt :: SqlFragment
-asCsvF :: SqlFragment
+    callIt = fromQi qi <> "(" <> args <> ")"
-asCsvF = asCsvHeaderF <> " || '\n' || " <> asCsvBodyF
-  where
-    asCsvHeaderF =
-      "(SELECT coalesce(string_agg(a.k, ','), '')" <>
-      "  FROM (" <>
-      "    SELECT json_object_keys(r)::TEXT as k" <>
-      "    FROM ( " <>
-      "      SELECT row_to_json(hh) as r from " <> sourceCTEName <> " as hh limit 1" <>
-      "    ) s" <>
-      "  ) a" <>
-      ")"
-    asCsvBodyF = "coalesce(string_agg(substring(_postgrest_t::text, 2, length(_postgrest_t::text) - 2), '\n'), '')"
 
-asJsonF :: SqlFragment
-asJsonF = "coalesce(array_to_json(array_agg(row_to_json(_postgrest_t))), '[]')::character varying"
 
-asJsonSingleF :: SqlFragment --TODO! unsafe when the query actually returns multiple rows, used only on inserting and returning single element
+-- | SQL query meant for COUNTing the root node of the Tree.
-asJsonSingleF = "coalesce(string_agg(row_to_json(_postgrest_t)::text, ','), '')::character varying "
+-- It only takes WHERE into account and doesn't include LIMIT/OFFSET because it would reduce the COUNT.
+-- SELECT 1 is done instead of SELECT * to prevent doing expensive operations(like functions based on the columns)
+-- inside the FROM target.
+readRequestToCountQuery :: ReadRequest -> SqlQuery
+readRequestToCountQuery (Node (Select{from=qi, where_=logicForest}, _) _) =
+ unwords [
+   "SELECT 1",
+   "FROM " <> fromQi qi,
+   ("WHERE " <> intercalate " AND " (map (pgFmtLogicTree qi) logicForest)) `emptyOnFalse` null logicForest
+   ]
 
-asBinaryF :: FieldName -> SqlFragment
+limitedQuery :: SqlQuery -> Maybe Integer -> SqlQuery
-asBinaryF fieldName = "coalesce(string_agg(_postgrest_t." <> pgFmtIdent fieldName <> ", ''), '')"
+limitedQuery query maxRows = query <> maybe mempty (\x -> " LIMIT " <> show x) maxRows
 
-locationF :: [Text] -> SqlFragment
+setLocalQuery :: Text -> (Text, Text) -> SqlQuery
-locationF pKeys =
+setLocalQuery prefix (k, v) =
-    "(" <>
+  "SET LOCAL " <> pgFmtIdent (prefix <> k) <> " = " <> pgFmtLit v <> ";"
-    " WITH s AS (SELECT row_to_json(ss) as r from " <> sourceCTEName <> " as ss  limit 1)" <>
-    " SELECT array_agg(json_data.key || '=' || coalesce('eq.' || json_data.value, 'is.null'))" <>
-    " FROM s, json_each_text(s.r) AS json_data" <>
-    (
-      if null pKeys
-      then ""
-      else " WHERE json_data.key IN ('" <> intercalate "','" pKeys <> "')"
-    ) <> ")"
 
-limitF :: NonnegRange -> SqlFragment
+setLocalSearchPathQuery :: [Text] -> SqlQuery
-limitF r  = if r == allRange
+setLocalSearchPathQuery vals =
-  then ""
+  "SET LOCAL search_path = " <> intercalate ", " (pgFmtLit <$> vals) <> ";"
-  else "LIMIT " <> limit <> " OFFSET " <> offset
-  where
-    limit  = maybe "ALL" show $ rangeLimit r
-    offset = show $ rangeOffset r
-
-fromQi :: QualifiedIdentifier -> SqlFragment
-fromQi t = (if s == "" then "" else pgFmtIdent s <> ".") <> pgFmtIdent n
-  where
-    n = qiName t
-    s = qiSchema t
-
-getJoinFilters :: Relation -> [Filter]
-getJoinFilters (Relation t cols ft fcs typ lt lc1 lc2) =
-  case typ of
-    Child  -> zipWith (toFilter tN ftN) cols fcs
-    Parent -> zipWith (toFilter tN ftN) cols fcs
-    Many   -> zipWith (toFilter tN ltN) cols (fromMaybe [] lc1) ++ zipWith (toFilter ftN ltN) fcs (fromMaybe [] lc2)
-    Root   -> undefined --error "undefined getJoinFilters"
-  where
-    s = if typ == Parent then "" else tableSchema t
-    tN = tableName t
-    ftN = tableName ft
-    ltN = fromMaybe "" (tableName <$> lt)
-    toFilter :: Text -> Text -> Column -> Column -> Filter
-    toFilter tb ftb c fc = Filter (colName c, Nothing) (Operation False ("=", VForeignKey (QualifiedIdentifier s tb) (ForeignKey fc{colTable=(colTable fc){tableName=ftb}})))
-
-unicodeStatement :: Text -> HE.Params a -> HD.Result b -> Bool -> H.Query a b
-unicodeStatement = H.statement . T.encodeUtf8
-
-emptyOnFalse :: Text -> Bool -> Text
-emptyOnFalse val cond = if cond then "" else val
-
-insertableValue :: JSON.Value -> SqlFragment
-insertableValue JSON.Null = "null"
-insertableValue v = (<> "::unknown") . pgFmtLit $ unquoted v
-
-insertableValueWithType :: Text -> JSON.Value -> SqlFragment
-insertableValueWithType t v =
-  pgFmtLit (unquoted v) <> "::" <> t
-
-pgFmtColumn :: QualifiedIdentifier -> Text -> SqlFragment
-pgFmtColumn table "*" = fromQi table <> ".*"
-pgFmtColumn table c = fromQi table <> "." <> pgFmtIdent c
-
-pgFmtField :: QualifiedIdentifier -> Field -> SqlFragment
-pgFmtField table (c, jp) = pgFmtColumn table c <> pgFmtJsonPath jp
-
-pgFmtSelectItem :: QualifiedIdentifier -> SelectItem -> SqlFragment
-pgFmtSelectItem table (f@(_, jp), Nothing, alias, _) = pgFmtField table f <> pgFmtAs jp alias
-pgFmtSelectItem table (f@(_, jp), Just cast, alias, _) = "CAST (" <> pgFmtField table f <> " AS " <> cast <> " )" <> pgFmtAs jp alias
-
-pgFmtFilter :: QualifiedIdentifier -> Filter -> SqlFragment
-pgFmtFilter table (Filter fld (Operation hasNot_ ex)) = notOp <> " " <> case ex of
-   (op, VText val) -> pgFmtFieldOp op <> " " <> case op of
-     "like"  -> unknownLiteral (T.map star val)
-     "ilike" -> unknownLiteral (T.map star val)
-     -- TODO: The '@@' was deprecated, remove in v0.5.0.0
-     "@@"    -> "to_tsquery(" <> unknownLiteral val <> ") "
-     "fts"   -> "to_tsquery(" <> unknownLiteral val <> ") "
-     "is"    -> whiteList val
-     "isnot" -> whiteList val
-     _       -> unknownLiteral val
-   (op, VTextL vals) -> pgFmtIn op vals -- in and notin
-   (op, VForeignKey fQi (ForeignKey Column{colTable=Table{tableName=fTableName}, colName=fColName})) ->
-     pgFmtField fQi fld <> " " <> sqlOperator op <> " " <> pgFmtColumn (removeSourceCTESchema (qiSchema fQi) fTableName) fColName
- where
-   pgFmtFieldOp op = pgFmtField table fld <> " " <> sqlOperator op
-   sqlOperator o = HM.lookupDefault "=" o operators
-   notOp = if hasNot_ then "NOT" else ""
-   star c = if c == '*' then '%' else c
-   unknownLiteral = (<> "::unknown ") . pgFmtLit
-   whiteList :: Text -> SqlFragment
-   whiteList v = fromMaybe
-     (toS (pgFmtLit v) <> "::unknown ")
-     (find ((==) . toLower $ v) ["null","true","false"])
-   pgFmtIn :: Operator -> [Text] -> SqlFragment
-   pgFmtIn op vals =
-    -- Workaround because for postgresql "col IN ()" is invalid syntax, we instead do "col = any('{}')"
-    let emptyValForIn o = (if "not" `isInfixOf` o then "NOT " else "") -- handle case of "notin" operator
-                          <> pgFmtField table fld <> " = any('{}') " in
-    case T.null <$> headMay vals of
-      Just isNull -> if isNull && length vals == 1
-                        then emptyValForIn op
-                        else pgFmtFieldOp op <> "(" <> intercalate ", " (map unknownLiteral vals) <> ") "
-      Nothing -> emptyValForIn op
-
-pgFmtLogicTree :: QualifiedIdentifier -> LogicTree -> SqlFragment
-pgFmtLogicTree qi (Expr hasNot_ op forest) = notOp <> " (" <> intercalate (" " <> show op <> " ") (pgFmtLogicTree qi <$> forest) <> ")"
-  where notOp =  if hasNot_ then "NOT" else ""
-pgFmtLogicTree qi (Stmnt flt) = pgFmtFilter qi flt
-
-pgFmtJsonPath :: Maybe JsonPath -> SqlFragment
-pgFmtJsonPath (Just [x]) = "->>" <> pgFmtLit x
-pgFmtJsonPath (Just (x:xs)) = "->" <> pgFmtLit x <> pgFmtJsonPath ( Just xs )
-pgFmtJsonPath _ = ""
-
-pgFmtAs :: Maybe JsonPath -> Maybe Alias -> SqlFragment
-pgFmtAs Nothing Nothing = ""
-pgFmtAs (Just xx) Nothing = case lastMay xx of
-  Just alias -> " AS " <> pgFmtIdent alias
-  Nothing -> ""
-pgFmtAs _ (Just alias) = " AS " <> pgFmtIdent alias
-
-pgFmtEnvVar :: Text -> (Text, Text) -> SqlFragment
-pgFmtEnvVar prefix (k, v) =
-  "set local " <> pgFmtIdent (prefix <> k) <> " = " <> pgFmtLit v <> ";"
-
-trimNullChars :: Text -> Text
-trimNullChars = T.takeWhile (/= '\x0')

src/PostgREST/RangeQuery.hs

@@ -1,3 +1,7 @@
+{-|
+Module      : PostgREST.RangeQuery
+Description : Logic regarding the `Range`/`Content-Range` headers and `limit`/`offset` querystring arguments.
+-}
 module PostgREST.RangeQuery (
   rangeParse
 , rangeRequested
@@ -7,21 +11,22 @@ module PostgREST.RangeQuery (
 , rangeGeq
 , allRange
 , NonnegRange
+, rangeStatusHeader
+, contentRangeH
 ) where
 
+import qualified Data.ByteString.Char8 as BS
 
-import           Control.Applicative
+import Data.List       (lookup)
-import           Network.HTTP.Types.Header
+import Text.Regex.TDFA ((=~))
 
-import qualified Data.ByteString.Char8     as BS
+import Control.Applicative
-import           Data.Ranged.Boundaries
+import Data.Ranged.Boundaries
-import           Data.Ranged.Ranges
+import Data.Ranged.Ranges
+import Network.HTTP.Types.Header
+import Network.HTTP.Types.Status
 
-import           Text.Regex.TDFA           ((=~))
+import Protolude
-
-import Data.List (lookup)
-
-import           Protolude
 
 type NonnegRange = Range Integer
 
@@ -32,14 +37,13 @@ rangeParse range = do
   case listToMaybe (range =~ rangeRegex :: [[BS.ByteString]]) of
     Just parsedRange ->
       let [_, mLower, mUpper] = readMaybe . toS <$> parsedRange
-          lower         = fromMaybe emptyRange   (rangeGeq <$> mLower)
+          lower         = maybe emptyRange rangeGeq mLower
-          upper         = fromMaybe allRange (rangeLeq <$> mUpper) in
+          upper         = maybe allRange rangeLeq mUpper in
       rangeIntersection lower upper
     Nothing -> allRange
 
 rangeRequested :: RequestHeaders -> NonnegRange
-rangeRequested headers = fromMaybe allRange $
+rangeRequested headers = maybe allRange rangeParse $ lookup hRange headers
-  rangeParse <$> lookup hRange headers
 
 restrictRange :: Maybe Integer -> NonnegRange -> NonnegRange
 restrictRange Nothing r = r
@@ -57,7 +61,7 @@ rangeOffset :: NonnegRange -> Integer
 rangeOffset range =
   case rangeLower range of
     BoundaryBelow lower -> lower
-    _ -> panic "range without lower bound" -- should never happen
+    _                   -> panic "range without lower bound" -- should never happen
 
 rangeGeq :: Integer -> NonnegRange
 rangeGeq n =
@@ -69,3 +73,30 @@ allRange = rangeGeq 0
 rangeLeq :: Integer -> NonnegRange
 rangeLeq n =
   Range BoundaryBelowAll (BoundaryAbove n)
+
+rangeStatusHeader :: NonnegRange -> Int64 -> Maybe Int64 -> (Status, Header)
+rangeStatusHeader topLevelRange queryTotal tableTotal =
+  let lower = rangeOffset topLevelRange
+      upper = lower + toInteger queryTotal - 1
+      contentRange = contentRangeH lower upper (toInteger <$> tableTotal)
+      status = rangeStatus lower upper (toInteger <$> tableTotal)
+  in (status, contentRange)
+  where
+    rangeStatus :: Integer -> Integer -> Maybe Integer -> Status
+    rangeStatus _ _ Nothing = status200
+    rangeStatus lower upper (Just total)
+      | lower > total               = status416 -- 416 Range Not Satisfiable
+      | (1 + upper - lower) < total = status206 -- 206 Partial Content
+      | otherwise                   = status200 -- 200 OK
+
+contentRangeH :: (Integral a, Show a) => a -> a -> Maybe a -> Header
+contentRangeH lower upper total =
+    ("Content-Range", headerValue)
+    where
+      headerValue   = rangeString <> "/" <> totalString
+      rangeString
+        | totalNotZero && fromInRange = show lower <> "-" <> show upper
+        | otherwise = "*"
+      totalString   = maybe "*" show total
+      totalNotZero  = maybe True (0 /=) total
+      fromInRange   = lower <= upper

src/PostgREST/Statements.hs

@@ -0,0 +1,179 @@
+{-|
+Module      : PostgREST.Statements
+Description : PostgREST single SQL statements.
+
+This module constructs single SQL statements that can be parametrized and prepared.
+
+- 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.Statements (
+    createWriteStatement
+  , createReadStatement
+  , callProcStatement
+  , createExplainStatement
+) where
+
+
+import           Control.Lens                    ((^?))
+import           Data.Aeson                      as JSON
+import qualified Data.Aeson.Lens                 as L
+import qualified Data.ByteString.Char8           as BS
+import           Data.Maybe
+import           Data.Text                       (unwords)
+import           Data.Text.Encoding              (encodeUtf8)
+import qualified Hasql.Decoders                  as HD
+import qualified Hasql.Encoders                  as HE
+import qualified Hasql.Statement                 as H
+import           PostgREST.Private.Common
+import           PostgREST.Private.QueryFragment
+import           PostgREST.Types
+import           Protolude                       hiding (cast,
+                                                  replace)
+import           Text.InterpolatedString.Perl6   (qc)
+
+{-| The generic query result format used by API responses. The location header
+    is represented as a list of strings containing variable bindings like
+    @"k1=eq.42"@, or the empty list if there is no location header.
+-}
+type ResultsWithCount = (Maybe Int64, Int64, [BS.ByteString], BS.ByteString, Either Text [GucHeader])
+
+createWriteStatement :: SqlQuery -> SqlQuery -> Bool -> Bool -> Bool ->
+                        PreferRepresentation -> [Text] -> PgVersion ->
+                        H.Statement ByteString ResultsWithCount
+createWriteStatement selectQuery mutateQuery wantSingle isInsert asCsv rep pKeys pgVer =
+  unicodeStatement sql (param HE.unknown) decodeStandard True
+ where
+  sql = [qc|
+      WITH
+      {sourceCTEName} AS ({mutateQuery})
+      SELECT
+        '' AS total_result_set,
+        pg_catalog.count(_postgrest_t) AS page_total,
+        {locF} AS header,
+        {bodyF} AS body,
+        {responseHeadersF pgVer} AS response_headers
+      FROM ({selectQuery}) _postgrest_t |]
+
+  locF =
+    if isInsert && rep `elem` [Full, HeadersOnly]
+      then unwords [
+        "CASE WHEN pg_catalog.count(_postgrest_t) = 1",
+          "THEN coalesce(" <> locationF pKeys <> ", " <> noLocationF <> ")",
+          "ELSE " <> noLocationF,
+        "END"]
+      else noLocationF
+
+  bodyF
+    | rep `elem` [None, HeadersOnly] = "''"
+    | asCsv = asCsvF
+    | wantSingle = asJsonSingleF
+    | otherwise = asJsonF
+
+  decodeStandard :: HD.Result ResultsWithCount
+  decodeStandard =
+   fromMaybe (Nothing, 0, [], mempty, Right []) <$> HD.rowMaybe standardRow
+
+createReadStatement :: SqlQuery -> SqlQuery -> Bool -> Bool -> Bool -> Maybe FieldName -> PgVersion ->
+                       H.Statement () ResultsWithCount
+createReadStatement selectQuery countQuery isSingle countTotal asCsv binaryField pgVer =
+  unicodeStatement sql HE.noParams decodeStandard False
+ where
+  sql = [qc|
+      WITH
+      {sourceCTEName} AS ({selectQuery})
+      {countCTEF}
+      SELECT
+        {countResultF} AS total_result_set,
+        pg_catalog.count(_postgrest_t) AS page_total,
+        {noLocationF} AS header,
+        {bodyF} AS body,
+        {responseHeadersF pgVer} AS response_headers
+      FROM ( SELECT * FROM {sourceCTEName}) _postgrest_t |]
+
+  (countCTEF, countResultF) = countF countQuery countTotal
+
+  bodyF
+    | asCsv = asCsvF
+    | isSingle = asJsonSingleF
+    | isJust binaryField = asBinaryF $ fromJust binaryField
+    | otherwise = asJsonF
+
+  decodeStandard :: HD.Result ResultsWithCount
+  decodeStandard =
+    HD.singleRow standardRow
+
+{-| Read and Write api requests use a similar response format which includes
+    various record counts and possible location header. This is the decoder
+    for that common type of query.
+-}
+standardRow :: HD.Row ResultsWithCount
+standardRow = (,,,,) <$> nullableColumn HD.int8 <*> column HD.int8
+                    <*> column header <*> column HD.bytea <*> column decodeGucHeaders
+  where
+    header = HD.array $ HD.dimension replicateM $ element HD.bytea
+
+type ProcResults = (Maybe Int64, Int64, ByteString, Either Text [GucHeader])
+
+callProcStatement :: Bool -> SqlQuery -> SqlQuery -> SqlQuery -> Bool ->
+                     Bool -> Bool -> Bool -> Bool -> Maybe FieldName -> PgVersion ->
+                     H.Statement ByteString ProcResults
+callProcStatement returnsScalar callProcQuery selectQuery countQuery countTotal isSingle asCsv asBinary multObjects binaryField pgVer =
+  unicodeStatement sql (param HE.unknown) decodeProc True
+  where
+    sql = [qc|
+      WITH {sourceCTEName} AS ({callProcQuery})
+      {countCTEF}
+      SELECT
+        {countResultF} AS total_result_set,
+        pg_catalog.count(_postgrest_t) AS page_total,
+        {bodyF} AS body,
+        {responseHeadersF pgVer} AS response_headers
+      FROM ({selectQuery}) _postgrest_t;|]
+
+    (countCTEF, countResultF) = countF countQuery countTotal
+
+    bodyF
+     | returnsScalar = scalarBodyF
+     | isSingle     = asJsonSingleF
+     | asCsv = asCsvF
+     | isJust binaryField = asBinaryF $ fromJust binaryField
+     | otherwise = asJsonF
+
+    scalarBodyF
+     | asBinary    = asBinaryF "pgrst_scalar"
+     | multObjects = "json_agg(_postgrest_t.pgrst_scalar)::character varying"
+     | otherwise   = "(json_agg(_postgrest_t.pgrst_scalar)->0)::character varying"
+
+    decodeProc :: HD.Result ProcResults
+    decodeProc =
+      fromMaybe (Just 0, 0, mempty, Right []) <$> HD.rowMaybe procRow
+      where
+        procRow = (,,,) <$> nullableColumn HD.int8 <*> column HD.int8
+                        <*> column HD.bytea <*> column decodeGucHeaders
+
+createExplainStatement :: SqlQuery -> H.Statement () (Maybe Int64)
+createExplainStatement countQuery =
+  unicodeStatement sql HE.noParams decodeExplain False
+  where
+    sql = [qc| EXPLAIN (FORMAT JSON) {countQuery} |]
+    -- |
+    -- 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
+
+unicodeStatement :: Text -> HE.Params a -> HD.Result b -> Bool -> H.Statement a b
+unicodeStatement = H.Statement . encodeUtf8
+
+decodeGucHeaders :: HD.Value (Either Text [GucHeader])
+decodeGucHeaders = first toS . JSON.eitherDecode . toS <$> HD.bytea

src/PostgREST/Types.hs

@@ -1,63 +1,198 @@
-{-# LANGUAGE DuplicateRecordFields    #-}
+{-|
+Module      : PostgREST.Types
+Description : PostgREST common types and functions used by the rest of the modules
+-}
+{-# LANGUAGE DeriveGeneric         #-}
+{-# LANGUAGE DuplicateRecordFields #-}
+
 module PostgREST.Types where
-import           Protolude
+
+import Control.Lens.Getter (view)
+import Control.Lens.Tuple  (_1)
+
+import qualified Data.Aeson               as JSON
+import qualified Data.ByteString          as BS
+import qualified Data.ByteString.Internal as BS (c2w)
+import qualified Data.ByteString.Lazy     as BL
+import qualified Data.CaseInsensitive     as CI
+import qualified Data.HashMap.Strict      as M
+import qualified Data.Set                 as S
 import qualified GHC.Show
-import           Data.Aeson
+
-import qualified Data.ByteString.Lazy as BL
+import Network.HTTP.Types.Header (Header, hContentType)
-import qualified Data.HashMap.Strict  as M
+
-import           Data.Tree
+import Data.Tree
-import qualified Data.Vector          as V
+
-import           PostgREST.RangeQuery (NonnegRange)
+import PostgREST.RangeQuery (NonnegRange)
-import           Network.HTTP.Types.Header (hContentType, Header)
+import Protolude
 
 -- | Enumeration of currently supported response content types
-data ContentType = CTApplicationJSON | CTTextCSV | CTOpenAPI
+data ContentType = CTApplicationJSON | CTSingularJSON
-                 | CTSingularJSON | CTOctetStream
+                 | CTTextCSV | CTTextPlain
-                 | CTAny | CTOther ByteString deriving Eq
+                 | CTOpenAPI | CTOctetStream
+                 | CTAny | CTOther ByteString deriving (Show, Eq)
 
-data ApiRequestError = ActionInappropriate
+-- | Convert from ContentType to a full HTTP Header
-                     | InvalidBody ByteString
+toHeader :: ContentType -> Header
-                     | InvalidRange
+toHeader ct = (hContentType, toMime ct <> "; charset=utf-8")
-                     | ParseRequestError Text Text
+
-                     | UnknownRelation
+-- | Convert from ContentType to a ByteString representing the mime type
-                     | NoRelationBetween Text Text
+toMime :: ContentType -> ByteString
-                     | UnsupportedVerb
+toMime CTApplicationJSON = "application/json"
-                     deriving (Show, Eq)
+toMime CTTextCSV         = "text/csv"
+toMime CTTextPlain       = "text/plain"
+toMime CTOpenAPI         = "application/openapi+json"
+toMime CTSingularJSON    = "application/vnd.pgrst.object+json"
+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/octet-stream"          -> CTOctetStream
+  "*/*"                               -> CTAny
+  ct'                                 -> CTOther ct'
+
+-- | A SQL query that can be executed independently
+type SqlQuery = Text
+
+-- | A part of a SQL query that cannot be executed independently
+type SqlFragment = Text
+
+data PreferResolution = MergeDuplicates | IgnoreDuplicates deriving Eq
+instance Show PreferResolution where
+  show MergeDuplicates  = "resolution=merge-duplicates"
+  show IgnoreDuplicates = "resolution=ignore-duplicates"
+
+-- | How to return the mutated data. From https://tools.ietf.org/html/rfc7240#section-4.2
+data PreferRepresentation = 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
+instance Show PreferRepresentation where
+  show Full        = "return=representation"
+  show None        = "return=minimal"
+  show HeadersOnly = mempty
+
+data PreferParameters
+  = SingleObject    -- ^ Pass all parameters as a single json object to a stored procedure
+  | MultipleObjects -- ^ Pass an array of json objects as params to a stored procedure
+  deriving Eq
+
+instance Show PreferParameters where
+  show SingleObject    = "params=single-object"
+  show MultipleObjects = "params=multiple-objects"
+
+data PreferCount
+  = ExactCount     -- ^ exact count(slower)
+  | PlannedCount   -- ^ PostgreSQL query planner rows count guess. Done by using EXPLAIN {query}.
+  | EstimatedCount -- ^ use the query planner rows if the count is superior to max-rows, otherwise get the exact count.
+  deriving Eq
+
+instance Show PreferCount where
+  show ExactCount     = "count=exact"
+  show PlannedCount   = "count=planned"
+  show EstimatedCount = "count=estimated"
 
 data DbStructure = DbStructure {
   dbTables      :: [Table]
 , dbColumns     :: [Column]
 , dbRelations   :: [Relation]
 , dbPrimaryKeys :: [PrimaryKey]
-, dbProcs       :: M.HashMap Text ProcDescription
+, dbProcs       :: ProcsMap
+, pgVersion     :: PgVersion
 } deriving (Show, Eq)
 
+-- TODO Table could hold references to all its Columns
+tableCols :: DbStructure -> Schema -> TableName -> [Column]
+tableCols dbs tSchema tName = filter (\Column{colTable=Table{tableSchema=s, tableName=t}} -> s==tSchema && t==tName) $ dbColumns dbs
+
+-- TODO Table could hold references to all its PrimaryKeys
+tablePKCols :: DbStructure -> Schema -> TableName -> [Text]
+tablePKCols dbs tSchema tName =  pkName <$> filter (\pk -> tSchema == (tableSchema . pkTable) pk && tName == (tableName . pkTable) pk) (dbPrimaryKeys dbs)
+
 data PgArg = PgArg {
   pgaName :: Text
 , pgaType :: Text
 , pgaReq  :: Bool
-} deriving (Show, Eq)
+} deriving (Show, Eq, Ord)
 
-data PgType = Scalar QualifiedIdentifier | Composite QualifiedIdentifier deriving (Eq, Show)
+data PgType = Scalar QualifiedIdentifier | Composite QualifiedIdentifier deriving (Eq, Show, Ord)
 
-data RetType = Single PgType | SetOf PgType deriving (Eq, Show)
+data RetType = Single PgType | SetOf PgType deriving (Eq, Show, Ord)
 
 data ProcVolatility = Volatile | Stable | Immutable
-  deriving (Eq, Show)
+  deriving (Eq, Show, Ord)
 
 data ProcDescription = ProcDescription {
-  pdName        :: Text
+  pdSchema      :: Schema
+, pdName        :: Text
 , pdDescription :: Maybe Text
 , pdArgs        :: [PgArg]
 , pdReturnType  :: RetType
 , pdVolatility  :: ProcVolatility
 } deriving (Show, Eq)
 
+-- Order by least number of args in the case of overloaded functions
+instance Ord ProcDescription where
+  ProcDescription schema1 name1 des1 args1 rt1 vol1 `compare` ProcDescription schema2 name2 des2 args2 rt2 vol2
+    | schema1 == schema2 && name1 == name2 && length args1 < length args2  = LT
+    | schema2 == schema2 && name1 == name2 && length args1 > length args2  = GT
+    | otherwise = (schema1, name1, des1, args1, rt1, vol1) `compare` (schema2, name2, des2, args2, rt2, vol2)
+
+-- | 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 = M.HashMap QualifiedIdentifier [ProcDescription]
+
+{-|
+  Search a pg procedure by its 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.
+  Ideally, handling overloaded functions should be left to pg itself. But we need to know certain proc attributes in advance.
+-}
+findProc :: QualifiedIdentifier -> S.Set Text -> Bool -> ProcsMap -> Maybe ProcDescription
+findProc qi payloadKeys paramsAsSingleObject allProcs =
+  case M.lookup qi allProcs of
+    Nothing     -> Nothing
+    Just [proc] -> Just proc           -- if it's not an overloaded function then immediately get the ProcDescription
+    Just procs  -> find matches procs  -- Handle overloaded functions case
+  where
+    matches proc =
+      if paramsAsSingleObject
+        -- if the arg is not of json type let the db give the err
+        then length (pdArgs proc) == 1
+        else payloadKeys `S.isSubsetOf` S.fromList (pgaName <$> pdArgs proc)
+
+{-|
+  Search the procedure parameters by matching them with the specified keys.
+  If the key doesn't match a parameter, a parameter with a default type "text" is assumed.
+-}
+specifiedProcArgs :: S.Set FieldName -> Maybe ProcDescription -> [PgArg]
+specifiedProcArgs keys proc =
+  let
+    args = maybe [] pdArgs proc
+  in
+  (\k -> fromMaybe (PgArg k "text" True) (find ((==) k . pgaName) args)) <$> S.toList keys
+
+procReturnsScalar :: ProcDescription -> Bool
+procReturnsScalar proc = case proc of
+  ProcDescription{pdReturnType = (Single (Scalar _))} -> True
+  _                                                   -> False
+
+procTableName :: ProcDescription -> Maybe TableName
+procTableName proc = case pdReturnType proc of
+  SetOf  (Composite qi) -> Just $ qiName qi
+  Single (Composite qi) -> Just $ qiName qi
+  _                     -> Nothing
+
 type Schema = Text
 type TableName = Text
-type SqlQuery = Text
-type SqlFragment = Text
-type RequestBody = BL.ByteString
 
 data Table = Table {
   tableSchema      :: Schema
@@ -66,12 +201,18 @@ data Table = Table {
 , tableInsertable  :: Bool
 } deriving (Show, Ord)
 
+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
+
 newtype ForeignKey = ForeignKey { fkCol :: Column } deriving (Show, Eq, Ord)
 
 data Column =
     Column {
       colTable       :: Table
-    , colName        :: Text
+    , colName        :: FieldName
     , colDescription :: Maybe Text
     , colPosition    :: Int32
     , colNullable    :: Bool
@@ -84,7 +225,12 @@ data Column =
     , colFK          :: Maybe ForeignKey
     } deriving (Show, Ord)
 
-type Synonym = (Column,Column)
+instance Eq Column where
+  Column{colTable=t1,colName=n1} == Column{colTable=t2,colName=n2} = t1 == t2 && n1 == n2
+
+-- | The source table column a view column refers to
+type SourceColumn = (Column, ViewColumn)
+type ViewColumn = Column
 
 data PrimaryKey = PrimaryKey {
     pkTable :: Table
@@ -93,13 +239,13 @@ data PrimaryKey = PrimaryKey {
 
 data OrderDirection = OrderAsc | OrderDesc deriving (Eq)
 instance Show OrderDirection where
-  show OrderAsc  = "asc"
+  show OrderAsc  = "ASC"
-  show OrderDesc = "desc"
+  show OrderDesc = "DESC"
 
 data OrderNulls = OrderNullsFirst | OrderNullsLast deriving (Eq)
 instance Show OrderNulls where
-  show OrderNullsFirst = "nulls first"
+  show OrderNullsFirst = "NULLS FIRST"
-  show OrderNullsLast  = "nulls last"
+  show OrderNullsLast  = "NULLS LAST"
 
 data OrderTerm = OrderTerm {
   otTerm      :: Field
@@ -107,48 +253,83 @@ data OrderTerm = OrderTerm {
 , otNullOrder :: Maybe OrderNulls
 } deriving (Show, Eq)
 
+{-|
+  Represents a pg identifier with a prepended schema name "schema.table"
+  When qiSchema is "", the schema is defined by the pg search_path
+-}
 data QualifiedIdentifier = QualifiedIdentifier {
   qiSchema :: Schema
 , qiName   :: TableName
-} deriving (Show, Eq)
+} deriving (Show, Eq, Ord, Generic)
+instance Hashable QualifiedIdentifier
 
+-- | The relationship [cardinality](https://en.wikipedia.org/wiki/Cardinality_(data_modeling)).
+-- | TODO: missing one-to-one
+data Cardinality = O2M -- ^ one-to-many,  previously known as Parent
+                 | M2O -- ^ many-to-one,  previously known as Child
+                 | M2M -- ^ many-to-many, previously known as Many
+                 deriving Eq
+instance Show Cardinality where
+  show O2M = "o2m"
+  show M2O = "m2o"
+  show M2M = "m2m"
 
-data RelationType = Child | Parent | Many | Root deriving (Show, Eq)
+type ConstraintName = Text
 
 {-|
-  The name 'Relation' here is used with the meaning
+  "Relation"ship between two tables.
-  "What is the relation between the current node and the parent node".
+  The order of the relColumns and relFColumns should be maintained to get the join conditions right.
-  It has nothing to do with PostgreSQL referring to tables/views as relations.
+  TODO merge relColumns and relFColumns to a tuple or Data.Bimap
 -}
 data Relation = Relation {
-  relTable    :: Table
+  relTable      :: Table
-, relColumns  :: [Column]
+, relColumns    :: [Column]
-, relFTable   :: Table
+, relConstraint :: Maybe ConstraintName -- ^ Just on O2M/M2O, Nothing on M2M
-, relFColumns :: [Column]
+, relFTable     :: Table
-, relType     :: RelationType
+, relFColumns   :: [Column]
-, relLTable   :: Maybe Table
+, relType       :: Cardinality
-, relLCols1   :: Maybe [Column]
+, relJunction   :: Maybe Junction -- ^ Junction for M2M Cardinality
-, relLCols2   :: Maybe [Column]
 } deriving (Show, Eq)
 
--- | An array of JSON objects that has been verified to have
+-- | Junction table on an M2M relationship
--- the same keys in every object
+data Junction = Junction {
-newtype PayloadJSON = PayloadJSON (V.Vector Object)
+  junTable       :: Table
-  deriving (Show, Eq)
+, junConstraint1 :: Maybe ConstraintName
+, junCols1       :: [Column]
+, junConstraint2 :: Maybe ConstraintName
+, junCols2       :: [Column]
+} deriving (Show, Eq)
 
-unPayloadJSON :: PayloadJSON -> V.Vector Object
+isSelfReference :: Relation -> Bool
-unPayloadJSON (PayloadJSON objs) = objs
+isSelfReference r = relTable r == relFTable r
+
+data PayloadJSON =
+  -- | Cached attributes of a JSON payload
+  ProcessedJSON {
+    -- | This is the raw ByteString that comes from the request body.
+    -- We cache this instead of an Aeson Value because it was detected that for large payloads the encoding
+    -- had high memory usage, see #1005 for more details
+    pjRaw  :: BL.ByteString
+  , pjType :: PJType
+    -- | Keys of the object or if it's an array these keys are guaranteed to be the same across all its objects
+  , pjKeys :: S.Set Text
+  }|
+  RawJSON {
+    pjRaw  :: BL.ByteString
+  } deriving (Show, Eq)
+
+data PJType = PJArray { pjaLength :: Int } | PJObject deriving (Show, Eq)
 
 data Proxy = Proxy {
-  proxyScheme     :: Text
+  proxyScheme :: Text
-, proxyHost       :: Text
+, proxyHost   :: Text
-, proxyPort       :: Integer
+, proxyPort   :: Integer
-, proxyPath       :: Text
+, proxyPath   :: Text
 } deriving (Show, Eq)
 
 type Operator = Text
 operators :: M.HashMap Operator SqlFragment
-operators = M.fromList [
+operators = M.union (M.fromList [
   ("eq", "="),
   ("gte", ">="),
   ("gt", ">"),
@@ -158,10 +339,7 @@ operators = M.fromList [
   ("like", "LIKE"),
   ("ilike", "ILIKE"),
   ("in", "IN"),
-  ("notin", "NOT IN"),
-  ("isnot", "IS NOT"),
   ("is", "IS"),
-  ("fts", "@@"),
   ("cs", "@>"),
   ("cd", "<@"),
   ("ov", "&&"),
@@ -169,18 +347,31 @@ operators = M.fromList [
   ("sr", ">>"),
   ("nxr", "&<"),
   ("nxl", "&>"),
-  ("adj", "-|-"),
+  ("adj", "-|-")]) ftsOperators
-  -- TODO: these are deprecated and should be removed in v0.5.0.0
+
-  ("@@", "@@"),
+ftsOperators :: M.HashMap Operator SqlFragment
-  ("@>", "@>"),
+ftsOperators = M.fromList [
-  ("<@", "<@")]
+  ("fts", "@@ to_tsquery"),
-data Operation = Operation{ hasNot::Bool, expr::(Operator, Operand) } deriving (Eq, Show)
+  ("plfts", "@@ plainto_tsquery"),
-data Operand = VText Text | VTextL [Text] | VForeignKey QualifiedIdentifier ForeignKey deriving (Show, Eq)
+  ("phfts", "@@ phraseto_tsquery"),
+  ("wfts", "@@ websearch_to_tsquery")
+  ]
+
+data OpExpr = OpExpr Bool Operation deriving (Eq, Show)
+data Operation = Op Operator SingleVal |
+                 In ListVal |
+                 Fts Operator (Maybe Language) SingleVal deriving (Eq, Show)
+type Language = Text
+
+-- | Represents a single value in a filter, e.g. id=eq.singleval
+type SingleVal = Text
+-- | Represents a list value in a filter, e.g. id=in.(val1,val2,val3)
+type ListVal = [Text]
 
 data LogicOperator = And | Or deriving Eq
 instance Show LogicOperator where
-  show And  = "AND"
+  show And = "AND"
-  show Or = "OR"
+  show Or  = "OR"
 {-|
   Boolean logic expression tree e.g. "and(name.eq.N,or(id.eq.1,id.eq.2))" is:
 
@@ -193,47 +384,154 @@ instance Show LogicOperator where
 data LogicTree = Expr Bool LogicOperator [LogicTree] | Stmnt Filter deriving (Show, Eq)
 
 type FieldName = Text
-type JsonPath = [Text]
+{-|
-type Field = (FieldName, Maybe JsonPath)
+  Json path operations as specified in https://www.postgresql.org/docs/9.4/static/functions-json.html
+-}
+type JsonPath = [JsonOperation]
+-- | Represents the single arrow `->` or double arrow `->>` operators
+data JsonOperation = JArrow{jOp :: JsonOperand} | J2Arrow{jOp :: JsonOperand} deriving (Show, Eq)
+-- | Represents the key(`->'key'`) or index(`->'1`::int`), the index is Text because we reuse our escaping functons and let pg do the casting with '1'::int
+data JsonOperand = JKey{jVal :: Text} | JIdx{jVal :: Text} deriving (Show, Eq)
+
+type Field = (FieldName, JsonPath)
 type Alias = Text
 type Cast = Text
 type NodeName = Text
 
+-- Rpc query param, only used for GET rpcs
+type RpcQParam = (Text, Text)
+
+{-|
+  Custom guc header, it's obtained by parsing the json in a:
+  `SET LOCAL "response.headers" = '[{"Set-Cookie": ".."}]'
+-}
+newtype GucHeader = GucHeader (CI.CI ByteString, ByteString)
+  deriving (Show, Eq)
+
+instance JSON.FromJSON GucHeader where
+  parseJSON (JSON.Object o) = case headMay (M.toList o) of
+    Just (k, JSON.String s) | M.size o == 1 -> pure $ GucHeader (CI.mk $ toS k, toS s)
+                            | otherwise     -> mzero
+    _ -> mzero
+  parseJSON _          = mzero
+
+unwrapGucHeader :: GucHeader -> Header
+unwrapGucHeader (GucHeader (k, v)) = (k, v)
+
+-- | Add headers not already included to allow the user to override them instead of duplicating them
+addHeadersIfNotIncluded :: [Header] -> [Header] -> [Header]
+addHeadersIfNotIncluded newHeaders initialHeaders =
+  filter (\(nk, _) -> isNothing $ find (\(ik, _) -> ik == nk) initialHeaders) newHeaders ++
+  initialHeaders
+
 {-|
   This type will hold information about which particular 'Relation' between two tables to choose when there are multiple ones.
   Specifically, it will contain the name of the foreign key or the join table in many to many relations.
 -}
-type RelationDetail = Text
+type SelectItem = (Field, Maybe Cast, Maybe Alias, Maybe EmbedHint)
-type SelectItem = (Field, Maybe Cast, Maybe Alias, Maybe RelationDetail)
+-- | Disambiguates an embedding operation when there's multiple relationships between two tables.
+-- | Can be the name of a foreign key constraint, column name or the junction in an m2m relationship.
+type EmbedHint = Text
 -- | Path of the embedded levels, e.g "clients.projects.name=eq.." gives Path ["clients", "projects"]
 type EmbedPath = [Text]
-data Filter = Filter { field::Field, operation::Operation } deriving (Show, Eq)
+data Filter = Filter { field::Field, opExpr::OpExpr } deriving (Show, Eq)
+data JoinCondition = JoinCondition (QualifiedIdentifier, FieldName)
+                                   (QualifiedIdentifier, FieldName) deriving (Show, Eq)
+
+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 (Show, Eq)
+
+data MutateQuery =
+  Insert {
+    in_        :: QualifiedIdentifier
+  , insCols    :: S.Set FieldName
+  , onConflict :: Maybe (PreferResolution, [FieldName])
+  , where_     :: [LogicTree]
+  , returning  :: [FieldName]
+  }|
+  Update {
+    in_       :: QualifiedIdentifier
+  , updCols   :: S.Set FieldName
+  , where_    :: [LogicTree]
+  , returning :: [FieldName]
+  }|
+  Delete {
+    in_       :: QualifiedIdentifier
+  , where_    :: [LogicTree]
+  , returning :: [FieldName]
+  } deriving (Show, Eq)
 
-data ReadQuery = Select { select::[SelectItem], from::[TableName], where_::[LogicTree], order::Maybe [OrderTerm], range_::NonnegRange } deriving (Show, Eq)
-data MutateQuery = Insert { in_::TableName, qPayload::PayloadJSON, returning::[FieldName] }
-                 | Delete { in_::TableName, where_::[LogicTree], returning::[FieldName] }
-                 | Update { in_::TableName, qPayload::PayloadJSON, where_::[LogicTree], returning::[FieldName] } deriving (Show, Eq)
-type ReadNode = (ReadQuery, (NodeName, Maybe Relation, Maybe Alias, Maybe RelationDetail))
 type ReadRequest = Tree ReadNode
 type MutateRequest = MutateQuery
-data DbRequest = DbRead ReadRequest | DbMutate MutateRequest
 
-instance Eq Table where
+type ReadNode = (ReadQuery, (NodeName, Maybe Relation, Maybe Alias, Maybe EmbedHint, Depth))
-  Table{tableSchema=s1,tableName=n1} == Table{tableSchema=s2,tableName=n2} = s1 == s2 && n1 == n2
+type Depth = Integer
 
-instance Eq Column where
+-- First level FieldNames(e.g get a,b from /table?select=a,b,other(c,d))
-  Column{colTable=t1,colName=n1} == Column{colTable=t2,colName=n2} = t1 == t2 && n1 == n2
+fstFieldNames :: ReadRequest -> [FieldName]
+fstFieldNames (Node (sel, _) _) =
+  fst . view _1 <$> select sel
 
--- | Convert from ContentType to a full HTTP Header
+data PgVersion = PgVersion {
-toHeader :: ContentType -> Header
+  pgvNum  :: Int32
-toHeader ct = (hContentType, toMime ct <> "; charset=utf-8")
+, pgvName :: Text
+} deriving (Eq, Show)
 
--- | Convert from ContentType to a ByteString representing the mime type
+instance Ord PgVersion where
-toMime :: ContentType -> ByteString
+  (PgVersion v1 _) `compare` (PgVersion v2 _) = v1 `compare` v2
-toMime CTApplicationJSON = "application/json"
+
-toMime CTTextCSV         = "text/csv"
+-- | Tells the minimum PostgreSQL version required by this version of PostgREST
-toMime CTOpenAPI         = "application/openapi+json"
+minimumPgVersion :: PgVersion
-toMime CTSingularJSON    = "application/vnd.pgrst.object+json"
+minimumPgVersion = pgVersion94
-toMime CTOctetStream     = "application/octet-stream"
+
-toMime CTAny             = "*/*"
+pgVersion94 :: PgVersion
-toMime (CTOther ct)      = ct
+pgVersion94 = PgVersion 90400 "9.4"
+
+pgVersion95 :: PgVersion
+pgVersion95 = PgVersion 90500 "9.5"
+
+pgVersion96 :: PgVersion
+pgVersion96 = PgVersion 90600 "9.6"
+
+pgVersion100 :: PgVersion
+pgVersion100 = PgVersion 100000 "10"
+
+pgVersion109 :: PgVersion
+pgVersion109 = PgVersion 100009 "10.9"
+
+pgVersion110 :: PgVersion
+pgVersion110 = PgVersion 110000 "11.0"
+
+pgVersion112 :: PgVersion
+pgVersion112 = PgVersion 110002 "11.2"
+
+pgVersion114 :: PgVersion
+pgVersion114 = PgVersion 110004 "11.4"
+
+pgVersion121 :: PgVersion
+pgVersion121 = PgVersion 120001 "12.1"
+
+sourceCTEName :: SqlFragment
+sourceCTEName = "pg_source"
+
+-- | full jspath, e.g. .property[0].attr.detail
+type JSPath = [JSPathExp]
+-- | jspath expression, e.g. .property, .property[0] or ."property-dash"
+data JSPathExp = JSPKey Text | JSPIdx Int deriving (Eq, Show)
+
+-- | Current database connection status data ConnectionStatus
+data ConnectionStatus
+  = NotConnected
+  | Connected PgVersion
+  | FatalConnectionError Text
+  deriving (Eq, Show)

stack.yaml

@@ -1,14 +1,20 @@
-resolver: lts-9.0
+# stack is used for circleci and appveyor CI builds
-extra-deps:
+resolver: lts-14.3
-  - configurator-ng-0.0.0.1
-  - critbit-0.2.0.0
-  - hasql-pool-0.4.1
-  - hjsonpointer-1.1.1
-  - hjsonschema-1.5.0.1
-  - jose-0.5.0.3
-  - Ranged-sets-0.3.0
-  - protolude-0.2
 ghc-options:
-  postgrest: -O2 -Werror -Wall -fwarn-identities -fno-warn-redundant-constraints
+  # -fno-spec-constr may help keep compile time memory use in check,
+  #   see https://gitlab.haskell.org/ghc/ghc/issues/16017#note_219304
+  # -optP-Wno-nonportable-include-path
+  #   prevents build failures on case-insensitive filesystems (macos),
+  #   see https://github.com/commercialhaskell/stack/issues/3918
+  postgrest: -O2 -Werror -Wall -fwarn-identities
+             -fno-spec-constr -optP-Wno-nonportable-include-path
 nix:
-  packages: [postgresql, zlib]
+  packages: [pcre, pkgconfig, postgresql, zlib]
+
+# needed by stylish haskell, this only runs on ci
+extra-deps:
+  - HsYAML-0.2.1.0@sha256:e4677daeba57f7a1e9a709a1f3022fe937336c91513e893166bd1f023f530d68,5311
+  - HsYAML-aeson-0.2.0.0@sha256:04796abfc01cffded83f37a10e6edba4f0c0a15d45bef44fc5bb4313d9c87757,1791
+  - configurator-pg-0.2.0@sha256:08dcfadbe31e9e505d0bed1ab034105e1735141499734ad52d1c5ac980cde4a6,2939
+  - hspec-wai-0.10.1@sha256:56dd9ec1d56f47ef1946f71f7cbf070e4c285f718cac1b158400ae5e7172ef47,2290
+  - hspec-wai-json-0.10.1@sha256:67b405c38f0a9e2771480c8d3ecd8aeb8d8776a35d3b2906cb1b76c9538617e4,1629

stack.yaml.lock

@@ -0,0 +1,47 @@
+# This file was autogenerated by Stack.
+# You should not edit this file by hand.
+# For more information, please see the documentation at:
+#   https://docs.haskellstack.org/en/stable/lock_files
+
+packages:
+- completed:
+    hackage: HsYAML-0.2.1.0@sha256:e4677daeba57f7a1e9a709a1f3022fe937336c91513e893166bd1f023f530d68,5311
+    pantry-tree:
+      size: 1340
+      sha256: 21f61bf9cad31674126b106071dd9b852e408796aeffc90eec1792f784107eff
+  original:
+    hackage: HsYAML-0.2.1.0@sha256:e4677daeba57f7a1e9a709a1f3022fe937336c91513e893166bd1f023f530d68,5311
+- completed:
+    hackage: HsYAML-aeson-0.2.0.0@sha256:04796abfc01cffded83f37a10e6edba4f0c0a15d45bef44fc5bb4313d9c87757,1791
+    pantry-tree:
+      size: 234
+      sha256: 67cc9ba17c79e71d3abdb465a3ee2825477856fff3b8b7d543cbbbefdae9a9d9
+  original:
+    hackage: HsYAML-aeson-0.2.0.0@sha256:04796abfc01cffded83f37a10e6edba4f0c0a15d45bef44fc5bb4313d9c87757,1791
+- completed:
+    hackage: configurator-pg-0.2.0@sha256:08dcfadbe31e9e505d0bed1ab034105e1735141499734ad52d1c5ac980cde4a6,2939
+    pantry-tree:
+      size: 1748
+      sha256: 760eb12ee3d81b95b68ee10d5d85171b117826f44242b2749d48791efad6c891
+  original:
+    hackage: configurator-pg-0.2.0@sha256:08dcfadbe31e9e505d0bed1ab034105e1735141499734ad52d1c5ac980cde4a6,2939
+- completed:
+    hackage: hspec-wai-0.10.1@sha256:56dd9ec1d56f47ef1946f71f7cbf070e4c285f718cac1b158400ae5e7172ef47,2290
+    pantry-tree:
+      size: 809
+      sha256: 17af1c2e709cd84bfda066b9ebb04cdde7f92660c51a1f7401a1e9f766524e93
+  original:
+    hackage: hspec-wai-0.10.1@sha256:56dd9ec1d56f47ef1946f71f7cbf070e4c285f718cac1b158400ae5e7172ef47,2290
+- completed:
+    hackage: hspec-wai-json-0.10.1@sha256:67b405c38f0a9e2771480c8d3ecd8aeb8d8776a35d3b2906cb1b76c9538617e4,1629
+    pantry-tree:
+      size: 349
+      sha256: fb9e89b79cde3276baa484c860c6b9eeebdbc1a5c43301293351a25bc4c08e87
+  original:
+    hackage: hspec-wai-json-0.10.1@sha256:67b405c38f0a9e2771480c8d3ecd8aeb8d8776a35d3b2906cb1b76c9538617e4,1629
+snapshots:
+- completed:
+    size: 523878
+    url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/14/3.yaml
+    sha256: 470c46c27746a48c7c50f829efc0cf00112787a7804ee4ac7a27754658f6d92c
+  original: lts-14.3

test/Dockerfile.test

@@ -4,7 +4,7 @@ ENV PATH /root/.local/bin:$PATH
 
 RUN apt-get update \
     && apt-get install -y wget libpq-dev pkg-config libpcre3 libpcre3-dev \
-       postgresql-client debconf locales \
+       postgresql-client debconf locales build-essential libffi-dev libgmp-dev git \
     && apt-get clean && rm -rf /var/lib/apt/lists/* /tmp/* /var/tmp/* \
     && echo 'en_US.UTF-8 UTF-8' > /etc/locale.gen \
     && locale-gen \

test/Feature/AndOrParamsSpec.hs

@@ -1,17 +1,18 @@
 module Feature.AndOrParamsSpec where
-import Test.Hspec
-import Test.Hspec.Wai
-import Test.Hspec.Wai.JSON
-import Network.HTTP.Types
 
 import Network.Wai (Application)
 
+import Network.HTTP.Types
+import Test.Hspec
+import Test.Hspec.Wai
+import Test.Hspec.Wai.JSON
+
+import PostgREST.Types (PgVersion, pgVersion112)
+import Protolude       hiding (get)
 import SpecHelper
-import Protolude hiding (get)
 
-
+spec :: PgVersion -> SpecWith ((), Application)
-spec :: SpecWith Application
+spec actualPgVersion =
-spec =
   describe "and/or params used for complex boolean logic" $ do
     context "used with GET" $ do
       context "or param" $ do
@@ -27,13 +28,13 @@ spec =
 
       context "embedded levels" $ do
         it "can do logic on the second level" $
-          get "/entities?child_entities.or=(id.eq.1,name.eq.child entity 2)&select=id,child_entities{id}" `shouldRespondWith`
+          get "/entities?child_entities.or=(id.eq.1,name.eq.child entity 2)&select=id,child_entities(id)" `shouldRespondWith`
             [json|[
               {"id": 1, "child_entities": [ { "id": 1 }, { "id": 2 } ] }, { "id": 2, "child_entities": []},
               {"id": 3, "child_entities": []}, {"id": 4, "child_entities": []}
             ]|] { matchHeaders = [matchContentTypeJson] }
         it "can do logic on the third level" $
-          get "/entities?child_entities.grandchild_entities.or=(id.eq.1,id.eq.2)&select=id,child_entities{id,grandchild_entities{id}}" `shouldRespondWith`
+          get "/entities?child_entities.grandchild_entities.or=(id.eq.1,id.eq.2)&select=id,child_entities(id,grandchild_entities(id))" `shouldRespondWith`
             [json|[
               {"id": 1, "child_entities": [ { "id": 1, "grandchild_entities": [ { "id": 1 }, { "id": 2 } ]}, { "id": 2, "grandchild_entities": []}]},
               {"id": 2, "child_entities": [ { "id": 3, "grandchild_entities": []} ]},
@@ -73,15 +74,28 @@ spec =
         it "can handle fts" $ do
           get "/entities?or=(text_search_vector.fts.bar,text_search_vector.fts.baz)&select=id" `shouldRespondWith`
             [json|[{ "id": 1 }, { "id": 2 }]|] { matchHeaders = [matchContentTypeJson] }
-          -- TODO: remove in 0.5.0 as deprecated
+          get "/tsearch?or=(text_search_vector.plfts(german).Art%20Spass, text_search_vector.plfts(french).amusant%20impossible, text_search_vector.fts(english).impossible)" `shouldRespondWith`
-          get "/entities?or=(text_search_vector.@@.bar,text_search_vector.@@.baz)&select=id" `shouldRespondWith`
+            [json|[
-            [json|[{ "id": 1 }, { "id": 2 }]|] { matchHeaders = [matchContentTypeJson] }
+              {"text_search_vector": "'fun':5 'imposs':9 'kind':3" },
-        it "can handle cs and cd" $ do
+              {"text_search_vector": "'amus':5 'fair':7 'impossibl':9 'peu':4" },
+              {"text_search_vector": "'art':4 'spass':5 'unmog':7"}
+            ]|] { matchHeaders = [matchContentTypeJson] }
+
+        when (actualPgVersion >= pgVersion112) $
+          it "can handle wfts (websearch_to_tsquery)" $
+            get "/tsearch?or=(text_search_vector.plfts(german).Art,text_search_vector.plfts(french).amusant,text_search_vector.not.wfts(english).impossible)"
+            `shouldRespondWith`
+              [json|[
+                     {"text_search_vector": "'also':2 'fun':3 'possibl':8" },
+                     {"text_search_vector": "'ate':3 'cat':2 'fat':1 'rat':4" },
+                     {"text_search_vector": "'amus':5 'fair':7 'impossibl':9 'peu':4" },
+                     {"text_search_vector": "'art':4 'spass':5 'unmog':7" }
+              ]|]
+              { matchHeaders = [matchContentTypeJson] }
+
+        it "can handle cs and cd" $
           get "/entities?or=(arr.cs.{1,2,3},arr.cd.{1})&select=id" `shouldRespondWith`
             [json|[{ "id": 1 },{ "id": 3 }]|] { matchHeaders = [matchContentTypeJson] }
-          -- TODO: remove in 0.5.0 as deprecated
-          get "/entities?or=(arr.@>.{1,2,3},arr.<@.{1})&select=id" `shouldRespondWith`
-            [json|[{ "id": 1 },{ "id": 3 }]|] { matchHeaders = [matchContentTypeJson] }
 
         it "can handle range operators" $ do
           get "/ranges?range=eq.[1,3]&select=id" `shouldRespondWith`
@@ -113,25 +127,44 @@ spec =
           get "/ranges?range=adj.(3,10]&select=id" `shouldRespondWith`
             [json|[{ "id": 1 }]|] { matchHeaders = [matchContentTypeJson] }
 
+        it "can handle array operators" $ do
+          get "/entities?arr=eq.{1,2,3}&select=id" `shouldRespondWith`
+            [json|[{ "id": 3 }]|] { matchHeaders = [matchContentTypeJson] }
+          get "/entities?arr=neq.{1,2}&select=id" `shouldRespondWith`
+            [json|[{ "id": 1 }, { "id": 3 }]|] { matchHeaders = [matchContentTypeJson] }
+          get "/entities?arr=lt.{2,3}&select=id" `shouldRespondWith`
+            [json|[{ "id": 1 }, { "id": 2 }, { "id": 3 }]|] { matchHeaders = [matchContentTypeJson] }
+          get "/entities?arr=lt.{2,0}&select=id" `shouldRespondWith`
+            [json|[{ "id": 1 }, { "id": 2 }, { "id": 3 }]|] { matchHeaders = [matchContentTypeJson] }
+          get "/entities?arr=gt.{1,1}&select=id" `shouldRespondWith`
+            [json|[{ "id": 2 }, { "id": 3 }]|] { matchHeaders = [matchContentTypeJson] }
+          get "/entities?arr=gt.{3}&select=id" `shouldRespondWith`
+            [json|[]|] { matchHeaders = [matchContentTypeJson] }
+          get "/entities?arr=lte.{2,1}&select=id" `shouldRespondWith`
+            [json|[{ "id": 1 }, { "id": 2 }, { "id": 3 }]|] { matchHeaders = [matchContentTypeJson] }
+          get "/entities?arr=lte.{1,2,3}&select=id" `shouldRespondWith`
+            [json|[{ "id": 1 }, { "id": 2 }, { "id": 3 }]|] { matchHeaders = [matchContentTypeJson] }
+          get "/entities?arr=lte.{1,2}&select=id" `shouldRespondWith`
+            [json|[{ "id": 1 }, { "id": 2 }]|] { matchHeaders = [matchContentTypeJson] }
+          get "/entities?arr=cs.{1,2}&select=id" `shouldRespondWith`
+            [json|[{ "id": 2 }, { "id": 3 }]|] { matchHeaders = [matchContentTypeJson] }
+          get "/entities?arr=cd.{1,2,6}&select=id" `shouldRespondWith`
+            [json|[{ "id": 1 }, { "id": 2 }]|] { matchHeaders = [matchContentTypeJson] }
+          get "/entities?arr=ov.{3}&select=id" `shouldRespondWith`
+            [json|[{ "id": 3 }]|] { matchHeaders = [matchContentTypeJson] }
+          get "/entities?arr=ov.{2,3}&select=id" `shouldRespondWith`
+            [json|[{ "id": 2 }, { "id": 3 }]|] { matchHeaders = [matchContentTypeJson] }
+
         context "operators with not" $ do
-          it "eq, cs, like can be negated" $ do
+          it "eq, cs, like can be negated" $
             get "/entities?and=(arr.not.cs.{1,2,3},and(id.not.eq.2,name.not.like.*3))&select=id" `shouldRespondWith`
               [json|[{ "id": 1}]|] { matchHeaders = [matchContentTypeJson] }
-            -- TODO: remove in 0.5.0 as deprecated
+          it "in, is, fts can be negated" $
-            get "/entities?and=(arr.not.@>.{1,2,3},and(id.not.eq.2,name.not.like.*3))&select=id" `shouldRespondWith`
-              [json|[{ "id": 1}]|] { matchHeaders = [matchContentTypeJson] }
-          it "in, is, fts can be negated" $ do
             get "/entities?and=(id.not.in.(1,3),and(name.not.is.null,text_search_vector.not.fts.foo))&select=id" `shouldRespondWith`
               [json|[{ "id": 2}]|] { matchHeaders = [matchContentTypeJson] }
-            -- TODO: remove in 0.5.0 as deprecated
+          it "lt, gte, cd can be negated" $
-            get "/entities?and=(id.not.in.(1,3),and(name.not.is.null,text_search_vector.not.@@.foo))&select=id" `shouldRespondWith`
-              [json|[{ "id": 2}]|] { matchHeaders = [matchContentTypeJson] }
-          it "lt, gte, cd can be negated" $ do
             get "/entities?and=(arr.not.cd.{1},or(id.not.lt.1,id.not.gte.3))&select=id" `shouldRespondWith`
               [json|[{"id": 2}, {"id": 3}]|] { matchHeaders = [matchContentTypeJson] }
-            -- TODO: remove in 0.5.0 as deprecated
-            get "/entities?and=(arr.not.<@.{1},or(id.not.lt.1,id.not.gte.3))&select=id" `shouldRespondWith`
-              [json|[{"id": 2}, {"id": 3}]|] { matchHeaders = [matchContentTypeJson] }
           it "gt, lte, ilike can be negated" $
             get "/entities?and=(name.not.ilike.*ITY2,or(id.not.gt.4,id.not.lte.1))&select=id" `shouldRespondWith`
               [json|[{"id": 1}, {"id": 2}, {"id": 3}]|] { matchHeaders = [matchContentTypeJson] }
@@ -176,7 +209,7 @@ spec =
 
     context "used with POST" $
       it "includes related data with filters" $
-        request methodPost "/child_entities?entities.or=(id.eq.2,id.eq.3)&select=id,entities{id}"
+        request methodPost "/child_entities?select=id,entities(id)&entities.or=(id.eq.2,id.eq.3)&entities.order=id"
           [("Prefer", "return=representation")]
           [json|[{"id":4,"name":"entity 4","parent_id":1},
                  {"id":5,"name":"entity 5","parent_id":2},
@@ -202,10 +235,6 @@ spec =
     it "can query columns that begin with and/or reserved words" $
       get "/grandchild_entities?or=(and_starting_col.eq.smth, or_starting_col.eq.smth)" `shouldRespondWith` 200
 
-    it "can query jsonb columns" $
-      get "/grandchild_entities?or=(jsonb_col->a->>b.eq.foo, jsonb_col->>b.eq.bar)&select=id" `shouldRespondWith`
-        [json|[{id: 4}, {id: 5}]|] { matchStatus = 200, matchHeaders = [matchContentTypeJson] }
-
     it "fails when using IN without () and provides meaningful error message" $
       get "/entities?or=(id.in.1,2,id.eq.3)" `shouldRespondWith`
         [json|{

test/Feature/AsymmetricJwtSpec.hs

@@ -1,17 +1,17 @@
 module Feature.AsymmetricJwtSpec where
 
 -- {{{ Imports
-import Test.Hspec
-import Test.Hspec.Wai
-import Network.HTTP.Types
-
-import SpecHelper
 import Network.Wai (Application)
 
-import Protolude hiding (get)
+import Network.HTTP.Types
+import Test.Hspec
+import Test.Hspec.Wai
+
+import Protolude
+import SpecHelper
 -- }}}
 
-spec :: SpecWith Application
+spec :: SpecWith ((), Application)
 spec = describe "server started with asymmetric JWK" $
 
   -- this test will stop working 9999999999s after the UNIX EPOCH

test/Feature/AudienceJwtSecretSpec.hs

@@ -0,0 +1,47 @@
+module Feature.AudienceJwtSecretSpec where
+
+-- {{{ Imports
+import Network.Wai (Application)
+
+import Network.HTTP.Types
+import Test.Hspec
+import Test.Hspec.Wai
+
+import Protolude  hiding (get)
+import SpecHelper
+-- }}}
+
+spec :: SpecWith ((), Application)
+spec = describe "test handling of aud claims in JWT" $ do
+
+  -- this test will stop working 9999999999s after the UNIX EPOCH
+  it "succeeds with jwt token containing with an audience claim" $ do
+    {-  This is the decoded contents of authHeaderJWT
+
+        {
+          "exp": 9999999999,
+          "role": "postgrest_test_author",
+          "id": "jdoe",
+          "aud": "youraudience"
+        }
+
+    -}
+    let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJleHAiOjk5OTk5OTk5OTksInJvbGUiOiJwb3N0Z3Jlc3RfdGVzdF9hdXRob3IiLCJpZCI6Impkb2UiLCJhdWQiOiJ5b3VyYXVkaWVuY2UifQ.fJ4tLKSmolWGWehWN20qiU9dMO-WY0RI2VvacL7-ZGo"
+    request methodGet "/authors_only" [auth] ""
+      `shouldRespondWith` 200
+
+  it "succeeds with jwt token that does not contain an audience claim" $ do
+    {- This is the decoded contents of authHeaderJWT
+
+        {
+          "exp": 9999999999,
+          "role": "postgrest_test_author",
+          "id": "jdoe"
+        }
+    -}
+    let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJleHAiOjk5OTk5OTk5OTksInJvbGUiOiJwb3N0Z3Jlc3RfdGVzdF9hdXRob3IiLCJpZCI6Impkb2UifQ.Dpss-QoLYjec5OTsOaAc3FNVsSjA89wACoV-0ra3ClA"
+    request methodGet "/authors_only" [auth] ""
+      `shouldRespondWith` 200
+
+  it "requests without JWT token should work" $
+    get "/has_count_column" `shouldRespondWith` 200

test/Feature/AuthSpec.hs

@@ -1,28 +1,36 @@
 module Feature.AuthSpec where
 
--- {{{ Imports
+import Network.Wai (Application)
-import Text.Heredoc
+
+import Network.HTTP.Types
 import Test.Hspec
 import Test.Hspec.Wai
 import Test.Hspec.Wai.JSON
-import Network.HTTP.Types
+import Text.Heredoc
 
+import PostgREST.Types (PgVersion, pgVersion112)
+import Protolude       hiding (get)
 import SpecHelper
-import Network.Wai (Application)
 
-import Protolude hiding (get)
+spec :: PgVersion -> SpecWith ((), Application)
--- }}}
+spec actualPgVersion = describe "authorization" $ do
-
-spec :: SpecWith Application
-spec = describe "authorization" $ do
   let single = ("Accept","application/vnd.pgrst.object+json")
 
   it "denies access to tables that anonymous does not own" $
-    get "/authors_only" `shouldRespondWith` [json| {
+    get "/authors_only" `shouldRespondWith` (
+        if actualPgVersion >= pgVersion112 then
+        [json| {
+          "hint":null,
+          "details":null,
+          "code":"42501",
+          "message":"permission denied for table authors_only"} |]
+           else
+        [json| {
           "hint":null,
           "details":null,
           "code":"42501",
           "message":"permission denied for relation authors_only"} |]
+                                            )
       { matchStatus = 401
       , matchHeaders = ["WWW-Authenticate" <:> "Bearer"]
       }
@@ -30,15 +38,35 @@ spec = describe "authorization" $ do
   it "denies access to tables that postgrest_test_author does not own" $
     let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJyb2xlIjoicG9zdGdyZXN0X3Rlc3RfYXV0aG9yIn0.Xod-F15qsGL0WhdOCr2j3DdKuTw9QJERVgoFD3vGaWA" in
     request methodGet "/private_table" [auth] ""
-      `shouldRespondWith` [json| {
+      `shouldRespondWith` (
+        if actualPgVersion >= pgVersion112 then
+        [json| {
+          "hint":null,
+          "details":null,
+          "code":"42501",
+          "message":"permission denied for table private_table"} |]
+           else
+        [json| {
           "hint":null,
           "details":null,
           "code":"42501",
           "message":"permission denied for relation private_table"} |]
+                          )
       { matchStatus = 403
       , matchHeaders = []
       }
 
+  it "denies execution on functions that anonymous does not own" $
+    post "/rpc/privileged_hello" [json|{"name": "anonymous"}|] `shouldRespondWith` 401
+
+  it "allows execution on a function that postgrest_test_author owns" $
+    let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJyb2xlIjoicG9zdGdyZXN0X3Rlc3RfYXV0aG9yIn0.Xod-F15qsGL0WhdOCr2j3DdKuTw9QJERVgoFD3vGaWA" in
+    request methodPost "/rpc/privileged_hello" [auth] [json|{"name": "jdoe"}|]
+      `shouldRespondWith` [json|"Privileged hello to jdoe"|]
+      { matchStatus = 200
+      , matchHeaders = [matchContentTypeJson]
+      }
+
   it "returns jwt functions as jwt tokens" $
     request methodPost "/rpc/login" [single]
       [json| { "id": "jdoe", "pass": "1234" } |]
@@ -89,11 +117,11 @@ spec = describe "authorization" $ do
   it "hides tables from users with invalid JWT" $ do
     let auth = authHeaderJWT "ey9zdGdyZXN0X3Rlc3RfYXV0aG9yIiwiaWQiOiJqZG9lIn0.y4vZuu1dDdwAl0-S00MCRWRYMlJ5YAMSir6Es6WtWx0"
     request methodGet "/authors_only" [auth] ""
-      `shouldRespondWith` [json| {"message":"JWSError (CompactDecodeError \"expected 3 parts, got 2\")"} |]
+      `shouldRespondWith` [json| {"message":"JWSError (CompactDecodeError Invalid number of parts: Expected 3 parts; got 2)"} |]
         { matchStatus = 401
         , matchHeaders = [
             "WWW-Authenticate" <:>
-            "Bearer error=\"invalid_token\", error_description=\"JWSError (CompactDecodeError \\\"expected 3 parts, got 2\\\")\""
+            "Bearer error=\"invalid_token\", error_description=\"JWSError (CompactDecodeError Invalid number of parts: Expected 3 parts; got 2)\""
           ]
         }
 

test/Feature/BinaryJwtSecretSpec.hs

@@ -1,17 +1,17 @@
 module Feature.BinaryJwtSecretSpec where
 
 -- {{{ Imports
-import Test.Hspec
-import Test.Hspec.Wai
-import Network.HTTP.Types
-
-import SpecHelper
 import Network.Wai (Application)
 
-import Protolude hiding (get)
+import Network.HTTP.Types
+import Test.Hspec
+import Test.Hspec.Wai
+
+import Protolude
+import SpecHelper
 -- }}}
 
-spec :: SpecWith Application
+spec :: SpecWith ((), Application)
 spec = describe "server started with binary JWT secret" $
 
   -- this test will stop working 9999999999s after the UNIX EPOCH

test/Feature/ConcurrentSpec.hs

@@ -1,26 +1,27 @@
-{-# LANGUAGE MultiParamTypeClasses, TypeFamilies, UndecidableInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE TypeFamilies          #-}
+{-# LANGUAGE UndecidableInstances  #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 module Feature.ConcurrentSpec where
 
-import Control.Monad (void)
-import Control.Monad.Base
-
-import Control.Monad.Trans.Control
 import Control.Concurrent.Async (mapConcurrently)
+import Control.Monad            (void)
+import Network.Wai              (Application)
 
-import Test.Hspec hiding (pendingWith)
+import Control.Monad.Base
-import Test.Hspec.Wai.Internal
+import Control.Monad.Trans.Control
+
+import Network.Wai.Test        (Session)
+import Test.Hspec
 import Test.Hspec.Wai
+import Test.Hspec.Wai.Internal
 import Test.Hspec.Wai.JSON
-import Network.Wai.Test (Session)
-
-import Network.Wai (Application)
 
 import Protolude hiding (get)
 
-spec :: SpecWith Application
+spec :: SpecWith ((), Application)
 spec =
-  describe "Queryiny in parallel" $
+  describe "Querying in parallel" $
     it "should not raise 'transaction in progress' error" $
       raceTest 10 $
         get "/fakefake"
@@ -34,13 +35,13 @@ spec =
           , matchHeaders = []
           }
 
-raceTest :: Int -> WaiExpectation -> WaiExpectation
+raceTest :: Int -> WaiExpectation st -> WaiExpectation st
 raceTest times = liftBaseDiscard go
  where
   go test = void $ mapConcurrently (const test) [1..times]
 
-instance MonadBaseControl IO WaiSession where
+instance MonadBaseControl IO (WaiSession st) where
-  type StM WaiSession a = StM Session a
+  type StM (WaiSession st) a = StM Session a
   liftBaseWith f = WaiSession $
     liftBaseWith $ \runInBase ->
       f $ \k -> runInBase (unWaiSession k)
@@ -48,5 +49,5 @@ instance MonadBaseControl IO WaiSession where
   {-# INLINE liftBaseWith #-}
   {-# INLINE restoreM #-}
 
-instance MonadBase IO WaiSession where
+instance MonadBase IO (WaiSession st) where
   liftBase = liftIO

test/Feature/CorsSpec.hs

@@ -1,20 +1,20 @@
 module Feature.CorsSpec where
 
 -- {{{ Imports
-import Test.Hspec
-import Test.Hspec.Wai
-import Network.Wai.Test (SResponse(simpleHeaders, simpleBody))
 import qualified Data.ByteString.Lazy as BL
 
-import SpecHelper
+import Network.Wai      (Application)
+import Network.Wai.Test (SResponse (simpleBody, simpleHeaders))
 
 import Network.HTTP.Types
-import Network.Wai (Application)
+import Test.Hspec
+import Test.Hspec.Wai
 
-import Protolude hiding (get)
+import Protolude
+import SpecHelper
 -- }}}
 
-spec :: SpecWith Application
+spec :: SpecWith ((), Application)
 spec =
   describe "CORS" $ do
     let preflightHeaders = [
@@ -45,7 +45,7 @@ spec =
             "true"
           respHeaders `shouldSatisfy` matchHeader
             "Access-Control-Allow-Methods"
-            "GET, POST, PATCH, DELETE, OPTIONS, HEAD"
+            "GET, POST, PATCH, PUT, DELETE, OPTIONS, HEAD"
           respHeaders `shouldSatisfy` matchHeader
             "Access-Control-Allow-Headers"
             "Authentication, Foo, Bar, Accept, Accept-Language, Content-Language"

test/Feature/DeleteSpec.hs

@@ -1,15 +1,16 @@
 module Feature.DeleteSpec where
 
-import Test.Hspec
+import Network.Wai (Application)
-import Test.Hspec.Wai
-import Text.Heredoc
 
 import Network.HTTP.Types
-import Network.Wai (Application)
+import Test.Hspec
+import Test.Hspec.Wai
+import Test.Hspec.Wai.JSON
+import Text.Heredoc
 
 import Protolude hiding (get)
 
-spec :: SpecWith Application
+spec :: SpecWith ((), Application)
 spec =
   describe "Deleting" $ do
     context "existing record" $ do
@@ -36,7 +37,7 @@ spec =
         request methodDelete "/complex_items?id=eq.3&select=ciId:id::text,ciName:name" [("Prefer", "return=representation")] ""
           `shouldRespondWith` [str|[{"ciId":"3","ciName":"Three"}]|]
       it "can embed (parent) entities" $
-        request methodDelete "/tasks?id=eq.8&select=id,name,project{id}" [("Prefer", "return=representation")] ""
+        request methodDelete "/tasks?id=eq.8&select=id,name,project:projects(id)" [("Prefer", "return=representation")] ""
           `shouldRespondWith` [str|[{"id":8,"name":"Code OSX","project":{"id":4}}]|]
           { matchStatus  = 200
           , matchHeaders = ["Content-Range" <:> "*/*"]
@@ -62,3 +63,24 @@ spec =
     context "totally unknown route" $
       it "fails with 404" $
         request methodDelete "/foozle?id=eq.101" [] "" `shouldRespondWith` 404
+
+    context "table with limited privileges" $ do
+      it "fails deleting the row when return=representation and selecting all the columns" $
+        request methodDelete "/app_users?id=eq.1" [("Prefer", "return=representation")] mempty
+            `shouldRespondWith` 401
+
+      it "succeeds deleting the row when return=representation and selecting only the privileged columns" $
+        request methodDelete "/app_users?id=eq.1&select=id,email" [("Prefer", "return=representation")]
+          [json| { "password": "passxyz" } |]
+            `shouldRespondWith` [json|[ { "id": 1, "email": "test@123.com" } ]|]
+            { matchStatus  = 200
+            , matchHeaders = ["Content-Range" <:> "*/*"]
+            }
+
+      it "suceeds deleting the row with no explicit select when using return=minimal" $
+        request methodDelete "/app_users?id=eq.2" [("Prefer", "return=minimal")] mempty
+            `shouldRespondWith` 204
+
+      it "suceeds deleting the row with no explicit select by default" $
+        request methodDelete "/app_users?id=eq.3" [] mempty
+            `shouldRespondWith` 204

test/Feature/EmbedDisambiguationSpec.hs

@@ -0,0 +1,434 @@
+module Feature.EmbedDisambiguationSpec where
+
+import Network.Wai (Application)
+
+import Test.Hspec          hiding (pendingWith)
+import Test.Hspec.Wai
+import Test.Hspec.Wai.JSON
+import Text.Heredoc
+
+import Protolude  hiding (get)
+import SpecHelper
+
+spec :: SpecWith ((), Application)
+spec =
+  describe "resource embedding disambiguation" $ do
+    context "ambiguous requests that give 300 Multiple Choices" $ do
+      it "errs when there's a table and view that point to the same fk" $
+        get "/message?select=id,body,sender(name,sent)" `shouldRespondWith`
+          [json|
+            {
+              "details": [
+                {
+                    "cardinality": "m2o",
+                    "relationship": "message_sender_fkey[sender][id]",
+                    "origin": "test.message",
+                    "target": "test.person"
+                },
+                {
+                    "cardinality": "m2o",
+                    "relationship": "message_sender_fkey[sender][id]",
+                    "origin": "test.message",
+                    "target": "test.person_detail"
+                }
+              ],
+              "hint": "By following the 'details' key, disambiguate the request by changing the url to /origin?select=relationship(*) or /origin?select=target!relationship(*)",
+              "message": "More than one relationship was found for message and sender"
+            }
+          |]
+          { matchStatus  = 300
+          , matchHeaders = [matchContentTypeJson]
+          }
+
+      it "errs when there are o2m and m2m cardinalities to the target table" $
+        get "/sites?select=*,big_projects(*)" `shouldRespondWith`
+          [json|
+            {
+              "details": [
+                {
+                  "cardinality": "m2o",
+                  "relationship": "main_project[main_project_id][big_project_id]",
+                  "origin": "test.sites",
+                  "target": "test.big_projects"
+                },
+                {
+                  "cardinality": "m2m",
+                  "relationship": "test.jobs[jobs_site_id_fkey][jobs_big_project_id_fkey]",
+                  "origin": "test.sites",
+                  "target": "test.big_projects"
+                },
+                {
+                  "cardinality": "m2m",
+                  "relationship": "test.main_jobs[jobs_site_id_fkey][jobs_big_project_id_fkey]",
+                  "origin": "test.sites",
+                  "target": "test.big_projects"
+                }
+              ],
+              "hint": "By following the 'details' key, disambiguate the request by changing the url to /origin?select=relationship(*) or /origin?select=target!relationship(*)",
+              "message": "More than one relationship was found for sites and big_projects"
+            }
+          |]
+          { matchStatus  = 300
+          , matchHeaders = [matchContentTypeJson]
+          }
+
+      it "errs on an ambiguous embed that has a circular reference" $
+        get "/agents?select=*,departments(*)" `shouldRespondWith`
+          [json|
+            {
+              "details": [
+                {
+                    "cardinality": "m2o",
+                    "relationship": "agents_department_id_fkey[department_id][id]",
+                    "origin": "test.agents",
+                    "target": "test.departments"
+                },
+                {
+                    "cardinality": "o2m",
+                    "relationship": "departments_head_id_fkey[id][head_id]",
+                    "origin": "test.agents",
+                    "target": "test.departments"
+                }
+              ],
+              "hint": "By following the 'details' key, disambiguate the request by changing the url to /origin?select=relationship(*) or /origin?select=target!relationship(*)",
+              "message": "More than one relationship was found for agents and departments"
+            }
+           |]
+          { matchStatus  = 300
+          , matchHeaders = [matchContentTypeJson]
+          }
+
+      it "errs when there are more than two fks on a junction table(currently impossible to disambiguate, only choice is to split the table)" $
+        -- We have 4 possibilities for doing the junction JOIN here.
+        -- This could be solved by specifying two additional fks, like whatev_projects!fk1!fk2(*)
+        -- If the need arises this capability can be added later without causing a breaking change
+        get "/whatev_sites?select=*,whatev_projects(*)" `shouldRespondWith`
+          [json|
+            {
+              "details": [
+                {
+                  "cardinality": "m2m",
+                  "relationship": "test.whatev_jobs[whatev_jobs_site_id_1_fkey][whatev_jobs_project_id_1_fkey]",
+                  "origin": "test.whatev_sites",
+                  "target": "test.whatev_projects"
+                },
+                {
+                  "cardinality": "m2m",
+                  "relationship": "test.whatev_jobs[whatev_jobs_site_id_1_fkey][whatev_jobs_project_id_2_fkey]",
+                  "origin": "test.whatev_sites",
+                  "target": "test.whatev_projects"
+                },
+                {
+                  "cardinality": "m2m",
+                  "relationship": "test.whatev_jobs[whatev_jobs_site_id_2_fkey][whatev_jobs_project_id_1_fkey]",
+                  "origin": "test.whatev_sites",
+                  "target": "test.whatev_projects"
+                },
+                {
+                  "cardinality": "m2m",
+                  "relationship": "test.whatev_jobs[whatev_jobs_site_id_2_fkey][whatev_jobs_project_id_2_fkey]",
+                  "origin": "test.whatev_sites",
+                  "target": "test.whatev_projects"
+                }
+              ],
+              "hint": "By following the 'details' key, disambiguate the request by changing the url to /origin?select=relationship(*) or /origin?select=target!relationship(*)",
+              "message": "More than one relationship was found for whatev_sites and whatev_projects"
+            }
+          |]
+          { matchStatus  = 300
+          , matchHeaders = [matchContentTypeJson]
+          }
+
+    context "disambiguating requests with embed hints" $ do
+
+      context "using FK to specify the relationship" $ do
+        it "can embed by FK name" $
+          get "/projects?id=in.(1,3)&select=id,name,client(id,name)" `shouldRespondWith`
+            [json|[{"id":1,"name":"Windows 7","client":{"id":1,"name":"Microsoft"}},{"id":3,"name":"IOS","client":{"id":2,"name":"Apple"}}]|]
+            { matchHeaders = [matchContentTypeJson] }
+
+        it "can embed by FK name and select the FK column at the same time" $
+          get "/projects?id=in.(1,3)&select=id,name,client_id,client(id,name)" `shouldRespondWith`
+            [json|[{"id":1,"name":"Windows 7","client_id":1,"client":{"id":1,"name":"Microsoft"}},{"id":3,"name":"IOS","client_id":2,"client":{"id":2,"name":"Apple"}}]|]
+            { matchHeaders = [matchContentTypeJson] }
+
+        it "can embed parent with view!fk and grandparent by using fk" $
+          get "/tasks?id=eq.1&select=id,name,projects_view!project(id,name,client(id,name))" `shouldRespondWith`
+            [str|[{"id":1,"name":"Design w7","projects_view":{"id":1,"name":"Windows 7","client":{"id":1,"name":"Microsoft"}}}]|]
+
+        it "can embed by using a composite FK name" $
+          get "/unit_workdays?select=unit_id,day,fst_shift(car_id,schedule(name)),snd_shift(camera_id,schedule(name))" `shouldRespondWith`
+            [json| [
+              {
+                "day": "2019-12-02",
+                "fst_shift": {
+                    "car_id": "CAR-349",
+                    "schedule": {
+                        "name": "morning"
+                    }
+                },
+                "snd_shift": {
+                    "camera_id": "CAM-123",
+                    "schedule": {
+                        "name": "night"
+                    }
+                },
+                "unit_id": 1
+              }
+            ] |]
+            { matchHeaders = [matchContentTypeJson] }
+
+        it "embeds by using two fks pointing to the same table" $
+          get "/orders?id=eq.1&select=id, name, billing(address), shipping(address)" `shouldRespondWith`
+            [json|[{"id":1,"name":"order 1","billing":{"address": "address 1"},"shipping":{"address": "address 2"}}]|]
+            { matchHeaders = [matchContentTypeJson] }
+
+        it "fails if the fk is not known" $
+          get "/message?select=id,sender:person!space(name)&id=lt.4" `shouldRespondWith`
+            [json|{"message":"Could not find foreign keys between these entities. No relationship found between message and person"}|]
+            { matchStatus = 400
+            , matchHeaders = [matchContentTypeJson] }
+
+        it "can request a parent with fk" $
+          get "/comments?select=content,user(name)" `shouldRespondWith`
+            [json|[ { "content": "Needs to be delivered ASAP", "user": { "name": "Angela Martin" } } ]|]
+            { matchHeaders = [matchContentTypeJson] }
+
+        it "can request two parents with fks" $
+          get "/articleStars?select=createdAt,article(owner),user(name)&limit=1" `shouldRespondWith`
+            [json|[{"createdAt":"2015-12-08T04:22:57.472738","article":{"owner": "postgrest_test_authenticator"},"user":{"name": "Angela Martin"}}]|]
+            { matchHeaders = [matchContentTypeJson] }
+
+        it "can specify a view!fk" $
+          get "/message?select=id,body,sender:person_detail!message_sender_fkey(name,sent),recipient:person_detail!message_recipient_fkey(name,received)&id=lt.4" `shouldRespondWith`
+            [json|
+              [{"id":1,"body":"Hello Jane","sender":{"name":"John","sent":2},"recipient":{"name":"Jane","received":2}},
+               {"id":2,"body":"Hi John","sender":{"name":"Jane","sent":1},"recipient":{"name":"John","received":1}},
+               {"id":3,"body":"How are you doing?","sender":{"name":"John","sent":2},"recipient":{"name":"Jane","received":2}}] |]
+            { matchHeaders = [matchContentTypeJson] }
+
+        it "can specify a table!fk hint and request children 2 levels" $
+          get "/clients?id=eq.1&select=id,projects:projects!client(id,tasks(id))" `shouldRespondWith`
+            [json|[{"id":1,"projects":[{"id":1,"tasks":[{"id":1},{"id":2}]},{"id":2,"tasks":[{"id":3},{"id":4}]}]}]|]
+            { matchHeaders = [matchContentTypeJson] }
+
+        it "can disambiguate with the fk in case of an o2m and m2m relationship to the same table" $
+          get "/sites?select=name,main_project(name)&site_id=eq.1" `shouldRespondWith`
+            [json| [ { "name": "site 1", "main_project": { "name": "big project 1" } } ] |]
+            { matchHeaders = [matchContentTypeJson] }
+
+      context "using the column name of the FK to specify the relationship" $ do
+        it "can embed by column" $
+          get "/projects?id=in.(1,3)&select=id,name,client_id(id,name)" `shouldRespondWith`
+            [json|[{"id":1,"name":"Windows 7","client_id":{"id":1,"name":"Microsoft"}},{"id":3,"name":"IOS","client_id":{"id":2,"name":"Apple"}}]|]
+            { matchHeaders = [matchContentTypeJson] }
+
+        it "can embed by column and select the column at the same time, if aliased" $
+          get "/projects?id=in.(1,3)&select=id,name,client_id,client:client_id(id,name)" `shouldRespondWith`
+            [json|[{"id":1,"name":"Windows 7","client_id":1,"client":{"id":1,"name":"Microsoft"}},{"id":3,"name":"IOS","client_id":2,"client":{"id":2,"name":"Apple"}}]|]
+            { matchHeaders = [matchContentTypeJson] }
+
+        it "can embed parent by using view!column and grandparent by using the column" $
+          get "/tasks?id=eq.1&select=id,name,project:projects_view!project_id(id,name,client:client_id(id,name))" `shouldRespondWith`
+            [str|[{"id":1,"name":"Design w7","project":{"id":1,"name":"Windows 7","client":{"id":1,"name":"Microsoft"}}}]|]
+
+        it "can specify table!column" $
+          get "/message?select=id,body,sender:person!sender(name),recipient:person!recipient(name)&id=lt.4" `shouldRespondWith`
+            [json|
+              [{"id":1,"body":"Hello Jane","sender":{"name":"John"},"recipient":{"name":"Jane"}},
+               {"id":2,"body":"Hi John","sender":{"name":"Jane"},"recipient":{"name":"John"}},
+               {"id":3,"body":"How are you doing?","sender":{"name":"John"},"recipient":{"name":"Jane"}}] |]
+            { matchHeaders = [matchContentTypeJson] }
+
+        it "will embed using a column that has uppercase chars" $
+          get "/ghostBusters?select=escapeId(*)" `shouldRespondWith`
+            [json| [{"escapeId":{"so6meIdColumn":1}},{"escapeId":{"so6meIdColumn":3}},{"escapeId":{"so6meIdColumn":5}}] |]
+            { matchHeaders = [matchContentTypeJson] }
+
+        it "embeds by using two columns pointing to the same table" $
+          get "/orders?id=eq.1&select=id, name, billing_address_id(id), shipping_address_id(id)" `shouldRespondWith`
+            [json|[{"id":1,"name":"order 1","billing_address_id":{"id":1},"shipping_address_id":{"id":2}}]|]
+            { matchHeaders = [matchContentTypeJson] }
+
+        it "can disambiguate with the column in case of an o2m and m2m relationship to the same table" $
+          get "/sites?select=name,main_project_id(name)&site_id=eq.1" `shouldRespondWith`
+            [json| [ { "name": "site 1", "main_project_id": { "name": "big project 1" } } ] |]
+            { matchHeaders = [matchContentTypeJson] }
+
+      context "using the junction to disambiguate the request" $
+        it "can specify the junction of an m2m relationship" $ do
+          get "/sites?select=*,big_projects!jobs(name)&site_id=in.(1,2)" `shouldRespondWith`
+            [json|
+              [
+                {
+                  "big_projects": [
+                    {
+                      "name": "big project 1"
+                    }
+                  ],
+                  "main_project_id": 1,
+                  "name": "site 1",
+                  "site_id": 1
+                },
+                {
+                  "big_projects": [
+                    {
+                      "name": "big project 1"
+                    },
+                    {
+                      "name": "big project 2"
+                    }
+                  ],
+                  "main_project_id": null,
+                  "name": "site 2",
+                  "site_id": 2
+                }
+              ]
+            |]
+          get "/sites?select=*,big_projects!main_jobs(name)&site_id=in.(1,2)" `shouldRespondWith`
+            [json|
+              [
+                {
+                  "big_projects": [
+                    {
+                      "name": "big project 1"
+                    }
+                  ],
+                  "main_project_id": 1,
+                  "name": "site 1",
+                  "site_id": 1
+                },
+                {
+                  "big_projects": [],
+                  "main_project_id": null,
+                  "name": "site 2",
+                  "site_id": 2
+                }
+              ]
+            |]
+            { matchHeaders = [matchContentTypeJson] }
+
+      context "using a FK column and a FK to specify the relationship" $
+        it "embeds by using a column and a fk pointing to the same table" $
+          get "/orders?id=eq.1&select=id, name, billing_address_id(id), shipping(id)" `shouldRespondWith`
+            [json|[{"id":1,"name":"order 1","billing_address_id":{"id":1},"shipping":{"id":2}}]|]
+            { matchHeaders = [matchContentTypeJson] }
+
+    context "tables with self reference foreign keys" $ do
+      context "one self reference foreign key" $ do
+        it "embeds parents recursively" $
+          get "/family_tree?id=in.(3,4)&select=id,parent(id,name,parent(*))" `shouldRespondWith`
+            [json|[
+              { "id": "3", "parent": { "id": "1", "name": "Parental Unit", "parent": null } },
+              { "id": "4", "parent": { "id": "2", "name": "Kid One", "parent": { "id": "1", "name": "Parental Unit", "parent": null } } }
+            ]|]
+            { matchHeaders = [matchContentTypeJson] }
+
+        it "embeds childs recursively" $
+          get "/family_tree?id=eq.1&select=id,name, childs:family_tree!parent(id,name,childs:family_tree!parent(id,name))" `shouldRespondWith`
+            [json|[{
+              "id": "1", "name": "Parental Unit", "childs": [
+                { "id": "2", "name": "Kid One", "childs": [ { "id": "4", "name": "Grandkid One" } ] },
+                { "id": "3", "name": "Kid Two", "childs": [ { "id": "5", "name": "Grandkid Two" } ] }
+              ]
+            }]|] { matchHeaders = [matchContentTypeJson] }
+
+        it "embeds parent and then embeds childs" $
+          get "/family_tree?id=eq.2&select=id,name,parent(id,name,childs:family_tree!parent(id,name))" `shouldRespondWith`
+            [json|[{
+              "id": "2", "name": "Kid One", "parent": {
+                "id": "1", "name": "Parental Unit", "childs": [ { "id": "2", "name": "Kid One" }, { "id": "3", "name": "Kid Two"} ]
+              }
+            }]|] { matchHeaders = [matchContentTypeJson] }
+
+      context "two self reference foreign keys" $ do
+        it "embeds parents" $
+          get "/organizations?select=id,name,referee(id,name),auditor(id,name)&id=eq.3" `shouldRespondWith`
+            [json|[{
+              "id": 3, "name": "Acme",
+              "referee": {
+                "id": 1,
+                "name": "Referee Org"
+              },
+              "auditor": {
+                "id": 2,
+                "name": "Auditor Org"
+              }
+            }]|] { matchHeaders = [matchContentTypeJson] }
+
+        it "embeds childs" $ do
+          get "/organizations?select=id,name,refereeds:organizations!referee(id,name)&id=eq.1" `shouldRespondWith`
+            [json|[{
+              "id": 1, "name": "Referee Org",
+              "refereeds": [
+                {
+                  "id": 3,
+                  "name": "Acme"
+                },
+                {
+                  "id": 4,
+                  "name": "Umbrella"
+                }
+              ]
+            }]|] { matchHeaders = [matchContentTypeJson] }
+          get "/organizations?select=id,name,auditees:organizations!auditor(id,name)&id=eq.2" `shouldRespondWith`
+            [json|[{
+              "id": 2, "name": "Auditor Org",
+              "auditees": [
+                {
+                  "id": 3,
+                  "name": "Acme"
+                },
+                {
+                  "id": 4,
+                  "name": "Umbrella"
+                }
+              ]
+            }]|] { matchHeaders = [matchContentTypeJson] }
+
+        it "embeds other relations(manager) besides the self reference" $ do
+          get "/organizations?select=name,manager(name),referee(name,manager(name),auditor(name,manager(name))),auditor(name,manager(name),referee(name,manager(name)))&id=eq.5" `shouldRespondWith`
+            [json|[{
+              "name":"Cyberdyne",
+              "manager":{"name":"Cyberdyne Manager"},
+              "referee":{
+                "name":"Acme",
+                "manager":{"name":"Acme Manager"},
+                "auditor":{
+                  "name":"Auditor Org",
+                  "manager":{"name":"Auditor Manager"}}},
+              "auditor":{
+                "name":"Umbrella",
+                "manager":{"name":"Umbrella Manager"},
+                "referee":{
+                  "name":"Referee Org",
+                  "manager":{"name":"Referee Manager"}}}
+            }]|] { matchHeaders = [matchContentTypeJson] }
+
+          get "/organizations?select=name,manager(name),auditees:organizations!auditor(name,manager(name),refereeds:organizations!referee(name,manager(name)))&id=eq.2" `shouldRespondWith`
+            [json|[{
+              "name":"Auditor Org",
+              "manager":{"name":"Auditor Manager"},
+              "auditees":[
+                {"name":"Acme",
+                 "manager":{"name":"Acme Manager"},
+                 "refereeds":[
+                   {"name":"Cyberdyne",
+                    "manager":{"name":"Cyberdyne Manager"}},
+                   {"name":"Oscorp",
+                    "manager":{"name":"Oscorp Manager"}}]},
+                {"name":"Umbrella",
+                 "manager":{"name":"Umbrella Manager"},
+                 "refereeds":[]}]
+            }]|] { matchHeaders = [matchContentTypeJson] }
+
+    -- TODO Remove in next major version
+    describe "old dot '.' symbol, deprecated" $
+      it "still works" $ do
+        get "/clients?id=eq.1&select=id,projects:projects.client_id(id,tasks(id))" `shouldRespondWith`
+          [json|[{"id":1,"projects":[{"id":1,"tasks":[{"id":1},{"id":2}]},{"id":2,"tasks":[{"id":3},{"id":4}]}]}]|]
+          { matchHeaders = [matchContentTypeJson] }
+        get "/tasks?select=id,users:users.users_tasks(id)" `shouldRespondWith`
+          [json|[{"id":1,"users":[{"id":1},{"id":3}]},{"id":2,"users":[{"id":1}]},{"id":3,"users":[{"id":1}]},{"id":4,"users":[{"id":1}]},{"id":5,"users":[{"id":2},{"id":3}]},{"id":6,"users":[{"id":2}]},{"id":7,"users":[{"id":2}]},{"id":8,"users":[]}]|]
+          { matchHeaders = [matchContentTypeJson] }
+

test/Feature/ExtraSearchPathSpec.hs

@@ -0,0 +1,36 @@
+module Feature.ExtraSearchPathSpec where
+
+import Network.HTTP.Types
+import Network.Wai         (Application)
+import Test.Hspec
+import Test.Hspec.Wai
+import Test.Hspec.Wai.JSON
+
+import Protolude
+import SpecHelper
+
+spec :: SpecWith ((), Application)
+spec = describe "extra search path" $ do
+
+  it "finds the ltree <@ operator on the public schema" $
+    request methodGet "/ltree_sample?path=cd.Top.Science.Astronomy" [] ""
+      `shouldRespondWith` [json|[
+        {"path":"Top.Science.Astronomy"},
+        {"path":"Top.Science.Astronomy.Astrophysics"},
+        {"path":"Top.Science.Astronomy.Cosmology"}]|]
+      { matchHeaders = [matchContentTypeJson] }
+
+  it "finds the ltree nlevel function on the public schema, used through a computed column" $
+    request methodGet "/ltree_sample?select=number_of_labels&path=eq.Top.Science" [] ""
+      `shouldRespondWith` [json|[{"number_of_labels":2}]|]
+      { matchHeaders = [matchContentTypeJson] }
+
+  it "finds the isn = operator on the extensions schema" $
+    request methodGet "/isn_sample?id=eq.978-0-393-04002-9&select=name" [] ""
+      `shouldRespondWith` [json|[{"name":"Mathematics: From the Birth of Numbers"}]|]
+      { matchHeaders = [matchContentTypeJson] }
+
+  it "finds the isn is_valid function on the extensions schema" $
+    request methodGet "/rpc/is_valid_isbn?input=978-0-393-04002-9" [] ""
+      `shouldRespondWith` [json|true|]
+      { matchHeaders = [matchContentTypeJson] }

test/Feature/HtmlRawOutputSpec.hs

@@ -0,0 +1,30 @@
+module Feature.HtmlRawOutputSpec where
+
+import Network.Wai (Application)
+
+import Network.HTTP.Types
+import Test.Hspec         hiding (pendingWith)
+import Test.Hspec.Wai
+import Text.Heredoc
+
+import Protolude  hiding (get)
+import SpecHelper (acceptHdrs)
+
+spec :: SpecWith ((), Application)
+spec = describe "When raw-media-types is set to \"text/html\"" $
+  it "can get raw output with Accept: text/html" $
+    request methodGet "/rpc/welcome.html" (acceptHdrs "text/html") ""
+      `shouldRespondWith`
+      [str|
+          |<html>
+          |  <head>
+          |    <title>PostgREST</title>
+          |  </head>
+          |  <body>
+          |    <h1>Welcome to PostgREST</h1>
+          |  </body>
+          |</html>
+          |]
+      { matchStatus = 200
+      , matchHeaders = ["Content-Type" <:> "text/html; charset=utf-8"]
+      }

test/Feature/InsertSpec.hs

@@ -1,28 +1,27 @@
 module Feature.InsertSpec where
 
-import Test.Hspec hiding (pendingWith)
+import qualified Data.Aeson as JSON
+
+import Control.Monad          (replicateM_, void)
+import Data.List              (lookup)
+import Data.Maybe             (fromJust)
+import Network.Wai            (Application)
+import Network.Wai.Test       (SResponse (simpleBody, simpleHeaders, simpleStatus))
+import Test.Hspec             hiding (pendingWith)
+import Test.Hspec.Wai.Matcher (bodyEquals)
+import TestTypes              (CompoundPK (..), IncPK (..))
+
+import Network.HTTP.Types
 import Test.Hspec.Wai
 import Test.Hspec.Wai.JSON
-import Test.Hspec.Wai.Matcher (bodyEquals)
+import Text.Heredoc
-import Network.Wai.Test (SResponse(simpleBody,simpleHeaders,simpleStatus))
 
+import PostgREST.Types (PgVersion, pgVersion112)
+import Protolude       hiding (get)
 import SpecHelper
 
-import qualified Data.Aeson as JSON
+spec :: PgVersion -> SpecWith ((), Application)
-import Data.List (lookup)
+spec actualPgVersion = do
-import Data.Maybe (fromJust)
-import Text.Heredoc
-import Network.HTTP.Types.Header
-import Network.HTTP.Types
-import Control.Monad (replicateM_, void)
-
-import TestTypes(IncPK(..), CompoundPK(..))
-import Network.Wai (Application)
-
-import Protolude hiding (get)
-
-spec :: SpecWith Application
-spec = do
   describe "Posting new record" $ do
     context "disparate json types" $ do
       it "accepts disparate json types" $ do
@@ -49,9 +48,28 @@ spec = do
           , matchHeaders = [matchContentTypeJson]
           }
 
+    context "non uniform json array" $ do
+      it "rejects json array that isn't exclusivily composed of objects" $
+        post "/articles"
+             [json| [{"id": 100, "body": "xxxxx"}, 123, "xxxx", {"id": 111, "body": "xxxx"}] |]
+        `shouldRespondWith`
+             [json| {"message":"All object keys must match"} |]
+             { matchStatus  = 400
+             , matchHeaders = [matchContentTypeJson]
+             }
+
+      it "rejects json array that has objects with different keys" $
+        post "/articles"
+             [json| [{"id": 100, "body": "xxxxx"}, {"id": 111, "body": "xxxx", "owner": "me"}] |]
+        `shouldRespondWith`
+             [json| {"message":"All object keys must match"} |]
+             { matchStatus  = 400
+             , matchHeaders = [matchContentTypeJson]
+             }
+
     context "requesting full representation" $ do
       it "includes related data after insert" $
-        request methodPost "/projects?select=id,name,clients{id,name}"
+        request methodPost "/projects?select=id,name,clients(id,name)"
                 [("Prefer", "return=representation"), ("Prefer", "count=exact")]
           [str|{"id":6,"name":"New Project","client_id":2}|] `shouldRespondWith` [str|[{"id":6,"name":"New Project","clients":{"id":2,"name":"Apple"}}]|]
           { matchStatus  = 201
@@ -97,11 +115,13 @@ spec = do
             incNullableStr record `shouldBe` Nothing
 
       context "into a table with simple pk" $
-        it "fails with 400 and error" $ do
+        it "fails with 400 and error" $
-          p <- post "/simple_pk" [json| { "extra":"foo"} |]
+          post "/simple_pk" [json| { "extra":"foo"} |]
-          liftIO $ do
+          `shouldRespondWith`
-            simpleStatus p `shouldBe` badRequest400
+          [json|{"hint":null,"details":"Failing row contains (null, foo).","code":"23502","message":"null value in column \"k\" violates not-null constraint"}|]
-            isErrorFormat (simpleBody p) `shouldBe` True
+          { matchStatus  = 400
+          , matchHeaders = [matchContentTypeJson]
+          }
 
       context "into a table with no pk" $ do
         it "succeeds with 201 and a link including all fields" $ do
@@ -128,15 +148,6 @@ spec = do
             simpleBody p `shouldBe` [json| [] |]
             simpleStatus p `shouldBe` created201
 
-        it "can insert in tables with no select privileges" $ do
-          p <- request methodPost "/insertonly"
-                       [("Prefer", "return=minimal")]
-                       [json| { "v":"some value" } |]
-          liftIO $ do
-            simpleBody p `shouldBe` ""
-            simpleStatus p `shouldBe` created201
-
-
         it "can post nulls" $ do
           p <- request methodPost "/no_pk"
                        [("Prefer", "return=representation")]
@@ -175,11 +186,13 @@ spec = do
           lookup hLocation (simpleHeaders p) `shouldBe` Nothing
 
     context "with invalid json payload" $
-      it "fails with 400 and error" $ do
+      it "fails with 400 and error" $
-        p <- post "/simple_pk" "}{ x = 2"
+        post "/simple_pk" "}{ x = 2"
-        liftIO $ do
+        `shouldRespondWith`
-          simpleStatus p `shouldBe` badRequest400
+        [json|{"message":"Error in $: Failed reading: not a valid json value"}|]
-          isErrorFormat (simpleBody p) `shouldBe` True
+        { matchStatus  = 400
+        , matchHeaders = [matchContentTypeJson]
+        }
 
     context "with valid json payload" $
       it "succeeds and returns 201 created" $
@@ -187,7 +200,12 @@ spec = do
 
     context "attempting to insert a row with the same primary key" $
       it "fails returning a 409 Conflict" $
-        post "/simple_pk" [json| { "k":"k1", "extra":"e1" } |] `shouldRespondWith` 409
+        post "/simple_pk" [json| { "k":"k1", "extra":"e1" } |]
+          `shouldRespondWith`
+          [json|{"hint":null,"details":"Key (k)=(k1) already exists.","code":"23505","message":"duplicate key value violates unique constraint \"contacts_pkey\""}|]
+          { matchStatus  = 409
+          , matchHeaders = [matchContentTypeJson]
+          }
 
     context "attempting to insert a row with conflicting unique constraint" $
       it "fails returning a 409 Conflict" $
@@ -216,35 +234,71 @@ spec = do
           , matchHeaders = ["Location" <:> location]
           }
 
-    context "empty object" $
+    context "empty objects" $ do
-      it "successfully populates table with all-default columns" $
+      it "successfully inserts a row with all-default columns" $ do
         post "/items" "{}" `shouldRespondWith` ""
           { matchStatus  = 201
           , matchHeaders = []
           }
-    context "table with limited privileges" $ do
+        post "/items" "[{}]" `shouldRespondWith` ""
-      it "succeeds if correct select is applied" $
-        request methodPost "/limited_article_stars?select=article_id,user_id" [("Prefer", "return=representation")]
-          [json| {"article_id": 2, "user_id": 1} |] `shouldRespondWith` [str|[{"article_id":2,"user_id":1}]|]
           { matchStatus  = 201
           , matchHeaders = []
           }
-      it "fails if more columns are selected" $
+
-        request methodPost "/limited_article_stars?select=article_id,user_id,created_at" [("Prefer", "return=representation")]
+      it "successfully inserts two rows with all-default columns" $
-          [json| {"article_id": 2, "user_id": 2} |] `shouldRespondWith`
+        post "/items" "[{}, {}]" `shouldRespondWith` ""
-          [str|{"hint":null,"details":null,"code":"42501","message":"permission denied for relation limited_article_stars"}|]
+          { matchStatus  = 201
-          { matchStatus  = 401
           , matchHeaders = []
           }
-      it "fails if select is not specified" $
+
-        request methodPost "/limited_article_stars" [("Prefer", "return=representation")]
+    context "POST with ?columns parameter" $ do
-          [json| {"article_id": 3, "user_id": 1} |] `shouldRespondWith` [str|{"hint":null,"details":null,"code":"42501","message":"permission denied for relation limited_article_stars"}|]
+      it "ignores json keys not included in ?columns" $ do
-          { matchStatus  = 401
+        request methodPost "/articles?columns=id,body" [("Prefer", "return=representation")]
+          [json| {"id": 200, "body": "xxx", "smth": "here", "other": "stuff", "fake_id": 13} |] `shouldRespondWith`
+          [json|[{"id": 200, "body": "xxx", "owner": "postgrest_test_anonymous"}]|]
+          { matchStatus  = 201
+          , matchHeaders = [] }
+        request methodPost "/articles?columns=id,body&select=id,body" [("Prefer", "return=representation")]
+          [json| [
+            {"id": 201, "body": "yyy", "smth": "here", "other": "stuff", "fake_id": 13},
+            {"id": 202, "body": "zzz", "garbage": "%%$&", "kkk": "jjj"},
+            {"id": 203, "body": "aaa", "hey": "ho"} ]|] `shouldRespondWith`
+          [json|[
+            {"id": 201, "body": "yyy"},
+            {"id": 202, "body": "zzz"},
+            {"id": 203, "body": "aaa"} ]|]
+          { matchStatus  = 201
+          , matchHeaders = [] }
+
+      -- TODO parse columns error message needs to be improved
+      it "disallows blank ?columns" $
+        post "/articles?columns="
+          [json|[
+            {"id": 204, "body": "yyy"},
+            {"id": 205, "body": "zzz"}]|]
+          `shouldRespondWith`
+          [json|  {"details":"unexpected end of input expecting field name (* or [a..z0..9_])","message":"\"failed to parse columns parameter ()\" (line 1, column 1)"} |]
+          { matchStatus  = 400
+          , matchHeaders = []
+          }
+
+      it "disallows array elements that are not json objects" $
+        post "/articles?columns=id,body"
+          [json|[
+            {"id": 204, "body": "yyy"},
+            333,
+            "asdf",
+            {"id": 205, "body": "zzz"}]|] `shouldRespondWith`
+          [json|{
+              "code": "22023",
+              "details": null,
+              "hint": null,
+              "message": "argument of json_populate_recordset must be an array of objects"}|]
+          { matchStatus  = 400
           , matchHeaders = []
           }
 
   describe "CSV insert" $ do
-
     context "disparate csv types" $
       it "succeeds with multipart response" $ do
         pendingWith "Decide on what to do with CSV insert"
@@ -291,11 +345,13 @@ spec = do
           }
 
     context "with wrong number of columns" $
-      it "fails for too few" $ do
+      it "fails for too few" $
-        p <- request methodPost "/no_pk" [("Content-Type", "text/csv")] "a,b\nfoo,bar\nbaz"
+        request methodPost "/no_pk" [("Content-Type", "text/csv")] "a,b\nfoo,bar\nbaz"
-        liftIO $ do
+        `shouldRespondWith`
-          simpleStatus p `shouldBe` badRequest400
+        [json|{"message":"All lines must have same number of fields"}|]
-          isErrorFormat (simpleBody p) `shouldBe` True
+        { matchStatus  = 400
+        , matchHeaders = [matchContentTypeJson]
+        }
 
     context "with unicode values" $
       it "succeeds and returns usable location header" $ do
@@ -311,22 +367,20 @@ spec = do
         r <- get location
         liftIO $ simpleBody r `shouldBe` "["<>payload<>"]"
 
-
   describe "Patching record" $ do
-
     context "to unknown uri" $
-      it "gives a 404" $
+      it "indicates no table found by returning 404" $
         request methodPatch "/fake" []
           [json| { "real": false } |]
             `shouldRespondWith` 404
 
     context "on an empty table" $
-      it "indicates no records found to update" $
+      it "indicates no records found to update by returning 404" $
         request methodPatch "/empty_table" []
           [json| { "extra":20 } |]
           `shouldRespondWith` ""
-          { matchStatus  = 204,
+          { matchStatus  = 404,
-            matchHeaders = ["Content-Range" <:> "*/*"]
+            matchHeaders = []
           }
 
     context "in a nonempty table" $ do
@@ -353,10 +407,15 @@ spec = do
           [("Prefer", "return=representation")] [json| { "id":999999 } |]
           `shouldRespondWith` "[]"
           {
-            matchStatus  = 200,
+            matchStatus  = 404,
-            matchHeaders = ["Content-Range" <:> "*/*"]
+            matchHeaders = []
           }
 
+      it "gives a 404 when no rows updated" $
+        request methodPatch "/items?id=eq.99999999" []
+          [json| { "id": 42 } |]
+            `shouldRespondWith` 404
+
       it "returns updated object as array when return=rep" $
         request methodPatch "/items?id=eq.2"
           [("Prefer", "return=representation")] [json| { "id":2 } |]
@@ -384,25 +443,26 @@ spec = do
           [json| [{ a: "keepme", b: null }] |]
           { matchHeaders = [matchContentTypeJson] }
 
-      it "can set a json column to escaped value" $ do
+      context "filtering by a computed column" $ do
-        _ <- post "/json" [json| { data: {"escaped":"bar"} } |]
+        it "is successful" $
-        request methodPatch "/json?data->>escaped=eq.bar"
+          request methodPatch
-                     [("Prefer", "return=representation")]
+            "/items?is_first=eq.true"
-                     [json| { "data": { "escaped":" \"bar" } } |]
+            [("Prefer", "return=representation")]
-          `shouldRespondWith` [json| [{ "data": { "escaped":" \"bar" } }] |]
+            [json| { id: 100 } |]
-          { matchStatus  = 200
+            `shouldRespondWith` [json| [{ id: 100 }] |]
-          , matchHeaders = []
+            { matchStatus  = 200,
-          }
+              matchHeaders = [matchContentTypeJson, "Content-Range" <:> "0-0/*"]
+            }
 
-      it "can update based on a computed column" $
+        it "indicates no records updated by returning 404" $
-        request methodPatch
+          request methodPatch
-          "/items?always_true=eq.false"
+            "/items?always_true=eq.false"
-          [("Prefer", "return=representation")]
+            [("Prefer", "return=representation")]
-          [json| { id: 100 } |]
+            [json| { id: 100 } |]
-          `shouldRespondWith` "[]"
+            `shouldRespondWith` "[]"
-          { matchStatus  = 200,
+            { matchStatus  = 404,
-            matchHeaders = ["Content-Range" <:> "*/*"]
+              matchHeaders = []
-          }
+            }
 
       it "can provide a representation" $ do
         _ <- post "/items"
@@ -416,7 +476,7 @@ spec = do
         -- put value back for other tests
         void $ request methodPatch "/items?id=eq.99" [] [json| { "id":1 } |]
 
-      it "makes no updates and returns 204, when patching with an empty json object" $ do
+      it "makes no updates and returns 204, when patching with an empty json object/array" $ do
         request methodPatch "/items" [] [json| {} |]
           `shouldRespondWith` ""
           {
@@ -424,10 +484,21 @@ spec = do
             matchHeaders = ["Content-Range" <:> "*/*"]
           }
 
-        g <- get "/items"
+        request methodPatch "/items" [] [json| [] |]
-        liftIO $ simpleBody g `shouldBe` [json| [{"id":3},{"id":4},{"id":5},{"id":6},{"id":7},{"id":8},{"id":9},{"id":10},{"id":11},{"id":12},{"id":13},{"id":14},{"id":15},{id:16},{"id":2},{"id":1}] |]
+          `shouldRespondWith` ""
+          {
+            matchStatus  = 204,
+            matchHeaders = ["Content-Range" <:> "*/*"]
+          }
 
-      it "makes no updates and and returns 200, when patching with an empty json object and return=rep" $ do
+        request methodPatch "/items" [] [json| [{}] |]
+          `shouldRespondWith` ""
+          {
+            matchStatus  = 204,
+            matchHeaders = ["Content-Range" <:> "*/*"]
+          }
+
+      it "makes no updates and returns 200, when patching with an empty json object and return=rep" $
         request methodPatch "/items" [("Prefer", "return=representation")] [json| {} |]
           `shouldRespondWith` "[]"
           {
@@ -435,9 +506,6 @@ spec = do
             matchHeaders = ["Content-Range" <:> "*/*"]
           }
 
-        g <- get "/items"
-        liftIO $ simpleBody g `shouldBe` [json| [{"id":3},{"id":4},{"id":5},{"id":6},{"id":7},{"id":8},{"id":9},{"id":10},{"id":11},{"id":12},{"id":13},{"id":14},{"id":15},{id:16},{"id":2},{"id":1}] |]
-
     context "with unicode values" $
       it "succeeds and returns values intact" $ do
         void $ request methodPost "/no_pk" []
@@ -449,6 +517,18 @@ spec = do
           simpleBody p `shouldBe` "["<>payload<>"]"
           simpleStatus p `shouldBe` ok200
 
+    context "PATCH with ?columns parameter" $ do
+      it "ignores json keys not included in ?columns" $
+        request methodPatch "/articles?id=eq.200&columns=body" [("Prefer", "return=representation")]
+          [json| {"body": "Some real content", "smth": "here", "other": "stuff", "fake_id": 13} |] `shouldRespondWith`
+          [json|[{"id": 200, "body": "Some real content", "owner": "postgrest_test_anonymous"}]|]
+          { matchStatus  = 200
+          , matchHeaders = [] }
+
+      it "ignores json keys and gives 404 if no record updated" $
+        request methodPatch "/articles?id=eq.2001&columns=body" [("Prefer", "return=representation")]
+          [json| {"body": "Some real content", "smth": "here", "other": "stuff", "fake_id": 13} |] `shouldRespondWith` 404
+
   describe "Row level permission" $
     it "set user_id when inserting rows" $ do
       let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJyb2xlIjoicG9zdGdyZXN0X3Rlc3RfYXV0aG9yIiwiaWQiOiJqZG9lIn0.B-lReuGNDwAlU1GOC476MlO0vAt9JNoHIlxg2vwMaO0"
@@ -469,3 +549,129 @@ spec = do
       liftIO $ do
         simpleBody p2 `shouldBe` [str|[{"owner":"jroe","secret":"lolcat"}]|]
         simpleStatus p2 `shouldBe` created201
+
+  context "tables with self reference foreign keys" $ do
+    it "embeds parent after insert" $
+      request methodPost "/web_content?select=id,name,parent_content:p_web_id(name)"
+              [("Prefer", "return=representation")]
+        [json|{"id":6, "name":"wot", "p_web_id":4}|]
+        `shouldRespondWith`
+        [json|[{"id":6,"name":"wot","parent_content":{"name":"wut"}}]|]
+        { matchStatus  = 201
+        , matchHeaders = [ matchContentTypeJson , "Location" <:> "/web_content?id=eq.6" ]
+        }
+
+    it "embeds childs after update" $
+      request methodPatch "/web_content?id=eq.0&select=id,name,web_content(name)"
+              [("Prefer", "return=representation")]
+        [json|{"name": "tardis-patched"}|]
+        `shouldRespondWith`
+        [json|
+          [ { "id": 0, "name": "tardis-patched", "web_content": [ { "name": "fezz" }, { "name": "foo" }, { "name": "bar" } ]} ]
+        |]
+        { matchStatus  = 200,
+          matchHeaders = [matchContentTypeJson]
+        }
+
+    it "embeds parent, childs and grandchilds after update" $
+      request methodPatch "/web_content?id=eq.0&select=id,name,web_content(name,web_content(name)),parent_content:p_web_id(name)"
+              [("Prefer", "return=representation")]
+        [json|{"name": "tardis-patched-2"}|]
+        `shouldRespondWith`
+        [json| [
+          {
+            "id": 0,
+            "name": "tardis-patched-2",
+            "parent_content": { "name": "wat" },
+            "web_content": [
+                { "name": "fezz", "web_content": [ { "name": "wut" } ] },
+                { "name": "foo",  "web_content": [] },
+                { "name": "bar",  "web_content": [] }
+            ]
+          }
+        ] |]
+        { matchStatus  = 200,
+          matchHeaders = [matchContentTypeJson]
+        }
+
+    it "embeds childs after update without explicitly including the id in the ?select" $
+      request methodPatch "/web_content?id=eq.0&select=name,web_content(name)"
+              [("Prefer", "return=representation")]
+        [json|{"name": "tardis-patched"}|]
+        `shouldRespondWith`
+        [json|
+          [ { "name": "tardis-patched", "web_content": [ { "name": "fezz" }, { "name": "foo" }, { "name": "bar" } ]} ]
+        |]
+        { matchStatus  = 200,
+          matchHeaders = [matchContentTypeJson]
+        }
+
+    it "embeds an M2M relationship plus parent after update" $
+      request methodPatch "/users?id=eq.1&select=name,tasks(name,project:projects(name))"
+              [("Prefer", "return=representation")]
+        [json|{"name": "Kevin Malone"}|]
+        `shouldRespondWith`
+        [json|[
+          {
+            "name": "Kevin Malone",
+            "tasks": [
+                { "name": "Design w7", "project": { "name": "Windows 7" } },
+                { "name": "Code w7", "project": { "name": "Windows 7" } },
+                { "name": "Design w10", "project": { "name": "Windows 10" } },
+                { "name": "Code w10", "project": { "name": "Windows 10" } }
+            ]
+          }
+        ]|]
+        { matchStatus  = 200,
+          matchHeaders = [matchContentTypeJson]
+        }
+
+  context "table with limited privileges" $ do
+    it "succeeds inserting if correct select is applied" $
+      request methodPost "/limited_article_stars?select=article_id,user_id" [("Prefer", "return=representation")]
+        [json| {"article_id": 2, "user_id": 1} |] `shouldRespondWith` [str|[{"article_id":2,"user_id":1}]|]
+        { matchStatus  = 201
+        , matchHeaders = []
+        }
+
+    it "fails inserting if more columns are selected" $
+      request methodPost "/limited_article_stars?select=article_id,user_id,created_at" [("Prefer", "return=representation")]
+        [json| {"article_id": 2, "user_id": 2} |] `shouldRespondWith` (
+      if actualPgVersion >= pgVersion112 then
+      [str|{"hint":null,"details":null,"code":"42501","message":"permission denied for view limited_article_stars"}|]
+         else
+      [str|{"hint":null,"details":null,"code":"42501","message":"permission denied for relation limited_article_stars"}|]
+                                                                      )
+        { matchStatus  = 401
+        , matchHeaders = []
+        }
+
+    it "fails inserting if select is not specified" $
+      request methodPost "/limited_article_stars" [("Prefer", "return=representation")]
+        [json| {"article_id": 3, "user_id": 1} |] `shouldRespondWith` (
+      if actualPgVersion >= pgVersion112 then
+      [str|{"hint":null,"details":null,"code":"42501","message":"permission denied for view limited_article_stars"}|]
+         else
+      [str|{"hint":null,"details":null,"code":"42501","message":"permission denied for relation limited_article_stars"}|]
+                                                                      )
+        { matchStatus  = 401
+        , matchHeaders = []
+        }
+
+    it "can insert in a table with no select and return=minimal" $ do
+      p <- request methodPost "/insertonly"
+                   [("Prefer", "return=minimal")]
+                   [json| { "v":"some value" } |]
+      liftIO $ do
+        simpleBody p `shouldBe` ""
+        simpleStatus p `shouldBe` created201
+
+    it "succeeds updating row and gives a 204 when using return=minimal" $
+      request methodPatch "/app_users?id=eq.1" [("Prefer", "return=minimal")]
+        [json| { "password": "passxyz" } |]
+          `shouldRespondWith` 204
+
+    it "can update without return=minimal and no explicit select" $
+      request methodPatch "/app_users?id=eq.1" []
+        [json| { "password": "passabc" } |]
+          `shouldRespondWith` 204

test/Feature/JsonOperatorSpec.hs

@@ -0,0 +1,209 @@
+module Feature.JsonOperatorSpec where
+
+import Network.Wai (Application)
+
+import Network.HTTP.Types
+import Test.Hspec
+import Test.Hspec.Wai
+import Test.Hspec.Wai.JSON
+
+import PostgREST.Types (PgVersion, pgVersion112, pgVersion121)
+import Protolude       hiding (get)
+import SpecHelper
+
+spec :: PgVersion -> SpecWith ((), Application)
+spec actualPgVersion = describe "json and jsonb operators" $ do
+  context "Shaping response with select parameter" $ do
+    it "obtains a json subfield one level with casting" $
+      get "/complex_items?id=eq.1&select=settings->>foo::json" `shouldRespondWith`
+        [json| [{"foo":{"int":1,"bar":"baz"}}] |] -- the value of foo here is of type "text"
+        { matchHeaders = [matchContentTypeJson] }
+
+    it "renames json subfield one level with casting" $
+      get "/complex_items?id=eq.1&select=myFoo:settings->>foo::json" `shouldRespondWith`
+        [json| [{"myFoo":{"int":1,"bar":"baz"}}] |] -- the value of foo here is of type "text"
+        { matchHeaders = [matchContentTypeJson] }
+
+    it "fails on bad casting (data of the wrong format)" $
+      get "/complex_items?select=settings->foo->>bar::integer"
+        `shouldRespondWith` (
+        if actualPgVersion >= pgVersion121 then
+        [json| {"hint":null,"details":null,"code":"22P02","message":"invalid input syntax for type integer: \"baz\""} |]
+        else
+        [json| {"hint":null,"details":null,"code":"22P02","message":"invalid input syntax for integer: \"baz\""} |]
+                            )
+        { matchStatus  = 400 , matchHeaders = [] }
+
+    it "obtains a json subfield two levels (string)" $
+      get "/complex_items?id=eq.1&select=settings->foo->>bar" `shouldRespondWith`
+        [json| [{"bar":"baz"}] |]
+        { matchHeaders = [matchContentTypeJson] }
+
+    it "renames json subfield two levels (string)" $
+      get "/complex_items?id=eq.1&select=myBar:settings->foo->>bar" `shouldRespondWith`
+        [json| [{"myBar":"baz"}] |]
+        { matchHeaders = [matchContentTypeJson] }
+
+    it "obtains a json subfield two levels with casting (int)" $
+      get "/complex_items?id=eq.1&select=settings->foo->>int::integer" `shouldRespondWith`
+        [json| [{"int":1}] |] -- the value in the db is an int, but here we expect a string for now
+        { matchHeaders = [matchContentTypeJson] }
+
+    it "renames json subfield two levels with casting (int)" $
+      get "/complex_items?id=eq.1&select=myInt:settings->foo->>int::integer" `shouldRespondWith`
+        [json| [{"myInt":1}] |] -- the value in the db is an int, but here we expect a string for now
+        { matchHeaders = [matchContentTypeJson] }
+
+    -- TODO the status code for the error is 404, this is because 42883 represents undefined function
+    -- this works fine for /rpc/unexistent requests, but for this case a 500 seems more appropriate
+    it "fails when a double arrow ->> is followed with a single arrow ->" $ do
+      get "/json_arr?select=data->>c->1"
+        `shouldRespondWith` (
+        if actualPgVersion >= pgVersion112 then
+        [json|
+          {"hint":"No operator matches the given name and argument types. You might need to add explicit type casts.",
+           "details":null,"code":"42883","message":"operator does not exist: text -> integer"} |]
+           else
+        [json|
+          {"hint":"No operator matches the given name and argument type(s). You might need to add explicit type casts.",
+           "details":null,"code":"42883","message":"operator does not exist: text -> integer"} |]
+                            )
+        { matchStatus  = 404 , matchHeaders = [] }
+      get "/json_arr?select=data->>c->b"
+        `shouldRespondWith` (
+        if actualPgVersion >= pgVersion112 then
+        [json|
+          {"hint":"No operator matches the given name and argument types. You might need to add explicit type casts.",
+           "details":null,"code":"42883","message":"operator does not exist: text -> unknown"} |]
+           else
+        [json|
+          {"hint":"No operator matches the given name and argument type(s). You might need to add explicit type casts.",
+           "details":null,"code":"42883","message":"operator does not exist: text -> unknown"} |]
+                            )
+        { matchStatus  = 404 , matchHeaders = [] }
+
+    context "with array index" $ do
+      it "can get array of ints and alias/cast it" $ do
+        get "/json_arr?select=data->>0::int&id=in.(1,2)" `shouldRespondWith`
+          [json| [{"data":1}, {"data":4}] |]
+          { matchHeaders = [matchContentTypeJson] }
+        get "/json_arr?select=idx0:data->>0::int,idx1:data->>1::int&id=in.(1,2)" `shouldRespondWith`
+          [json| [{"idx0":1,"idx1":2}, {"idx0":4,"idx1":5}] |]
+          { matchHeaders = [matchContentTypeJson] }
+
+      it "can get nested array of ints" $ do
+        get "/json_arr?select=data->0->>1::int&id=in.(3,4)" `shouldRespondWith`
+          [json| [{"data":8}, {"data":7}] |]
+          { matchHeaders = [matchContentTypeJson] }
+        get "/json_arr?select=data->0->0->>1::int&id=in.(3,4)" `shouldRespondWith`
+          [json| [{"data":null}, {"data":6}] |]
+          { matchHeaders = [matchContentTypeJson] }
+
+      it "can get array of objects" $ do
+        get "/json_arr?select=data->0->>a&id=in.(5,6)" `shouldRespondWith`
+          [json| [{"a":"A"}, {"a":"[1,2,3]"}] |]
+          { matchHeaders = [matchContentTypeJson] }
+        get "/json_arr?select=data->0->a->>2&id=in.(5,6)" `shouldRespondWith`
+          [json| [{"a":null}, {"a":"3"}] |]
+          { matchHeaders = [matchContentTypeJson] }
+
+      it "can get array in object keys" $ do
+        get "/json_arr?select=data->c->>0::json&id=in.(7,8)" `shouldRespondWith`
+          [json| [{"c":1}, {"c":{"d": [4,5,6,7,8]}}] |]
+          { matchHeaders = [matchContentTypeJson] }
+        get "/json_arr?select=data->c->0->d->>4::int&id=in.(7,8)" `shouldRespondWith`
+          [json| [{"d":null}, {"d":8}] |]
+          { matchHeaders = [matchContentTypeJson] }
+
+      it "only treats well formed numbers as indexes" $
+        get "/json_arr?select=data->0->0xy1->1->23-xy-45->1->xy-6->>0::int&id=eq.9" `shouldRespondWith`
+          [json| [{"xy-6":3}] |]
+          { matchHeaders = [matchContentTypeJson] }
+
+    context "finishing json path with single arrow ->" $ do
+      it "works when finishing with a key" $ do
+        get "/json_arr?select=data->c&id=in.(7,8)" `shouldRespondWith`
+          [json| [{"c":[1,2,3]}, {"c":[{"d": [4,5,6,7,8]}]}] |]
+          { matchHeaders = [matchContentTypeJson] }
+        get "/json_arr?select=data->0->a&id=in.(5,6)" `shouldRespondWith`
+          [json| [{"a":"A"}, {"a":[1,2,3]}] |]
+          { matchHeaders = [matchContentTypeJson] }
+
+      it "works when finishing with an index" $ do
+        get "/json_arr?select=data->0->a&id=in.(5,6)" `shouldRespondWith`
+          [json| [{"a":"A"}, {"a":[1,2,3]}] |]
+          { matchHeaders = [matchContentTypeJson] }
+        get "/json_arr?select=data->c->0->d&id=eq.8" `shouldRespondWith`
+          [json| [{"d":[4,5,6,7,8]}] |]
+          { matchHeaders = [matchContentTypeJson] }
+
+  context "filtering response" $ do
+    it "can filter by properties inside json column" $ do
+      get "/json?data->foo->>bar=eq.baz" `shouldRespondWith`
+        [json| [{"data": {"id": 1, "foo": {"bar": "baz"}}}] |]
+        { matchHeaders = [matchContentTypeJson] }
+      get "/json?data->foo->>bar=eq.fake" `shouldRespondWith`
+        [json| [] |]
+        { matchHeaders = [matchContentTypeJson] }
+
+    it "can filter by properties inside json column using not" $
+      get "/json?data->foo->>bar=not.eq.baz" `shouldRespondWith`
+        [json| [] |]
+        { matchHeaders = [matchContentTypeJson] }
+
+    it "can filter by properties inside json column using ->>" $
+      get "/json?data->>id=eq.1" `shouldRespondWith`
+        [json| [{"data": {"id": 1, "foo": {"bar": "baz"}}}] |]
+        { matchHeaders = [matchContentTypeJson] }
+
+    it "can be filtered with and/or" $
+      get "/grandchild_entities?or=(jsonb_col->a->>b.eq.foo, jsonb_col->>b.eq.bar)&select=id" `shouldRespondWith`
+        [json|[{id: 4}, {id: 5}]|] { matchStatus = 200, matchHeaders = [matchContentTypeJson] }
+
+    it "can filter by array indexes" $ do
+      get "/json_arr?select=data&data->>0=eq.1" `shouldRespondWith`
+        [json| [{"data":[1, 2, 3]}] |]
+        { matchHeaders = [matchContentTypeJson] }
+      get "/json_arr?select=data&data->1->>2=eq.13" `shouldRespondWith`
+        [json| [{"data":[[9, 8, 7], [11, 12, 13]]}] |]
+        { matchHeaders = [matchContentTypeJson] }
+      get "/json_arr?select=data&data->1->>b=eq.B" `shouldRespondWith`
+        [json| [{"data":[{"a": "A"}, {"b": "B"}]}] |]
+        { matchHeaders = [matchContentTypeJson] }
+      get "/json_arr?select=data&data->1->b->>1=eq.5" `shouldRespondWith`
+        [json| [{"data":[{"a": [1,2,3]}, {"b": [4,5]}]}] |]
+        { matchHeaders = [matchContentTypeJson] }
+
+    it "can filter jsonb" $ do
+      get "/jsonb_test?data=eq.{\"e\":1}" `shouldRespondWith`
+        [json| [{"id":4,"data":{"e": 1}}] |]
+        { matchHeaders = [matchContentTypeJson] }
+      get "/jsonb_test?data->a=eq.{\"b\":2}" `shouldRespondWith`
+        [json| [{"id":1,"data":{"a": {"b": 2}}}] |]
+        { matchHeaders = [matchContentTypeJson] }
+      get "/jsonb_test?data->c=eq.[1,2,3]" `shouldRespondWith`
+        [json| [{"id":2,"data":{"c": [1, 2, 3]}}] |]
+        { matchHeaders = [matchContentTypeJson] }
+      get "/jsonb_test?data->0=eq.{\"d\":\"test\"}" `shouldRespondWith`
+        [json| [{"id":3,"data":[{"d": "test"}]}] |]
+        { matchHeaders = [matchContentTypeJson] }
+
+  context "ordering response" $ do
+    it "orders by a json column property asc" $
+      get "/json?order=data->>id.asc" `shouldRespondWith`
+        [json| [{"data": {"id": 0}}, {"data": {"id": 1, "foo": {"bar": "baz"}}}, {"data": {"id": 3}}] |]
+        { matchHeaders = [matchContentTypeJson] }
+
+    it "orders by a json column with two level property nulls first" $
+      get "/json?order=data->foo->>bar.nullsfirst" `shouldRespondWith`
+        [json| [{"data": {"id": 3}}, {"data": {"id": 0}}, {"data": {"id": 1, "foo": {"bar": "baz"}}}] |]
+        { matchHeaders = [matchContentTypeJson] }
+
+  context "Patching record, in a nonempty table" $
+    it "can set a json column to escaped value" $ do
+      _ <- post "/json" [json| { data: {"escaped":"bar"} } |]
+      request methodPatch "/json?data->>escaped=eq.bar"
+                   [("Prefer", "return=representation")]
+                   [json| { "data": { "escaped":" \"bar" } } |]
+        `shouldRespondWith` [json| [{ "data": { "escaped":" \"bar" } }] |]
+        { matchStatus  = 200 , matchHeaders = [] }

test/Feature/MultipleSchemaSpec.hs

@@ -0,0 +1,324 @@
+module Feature.MultipleSchemaSpec where
+
+import Control.Lens    ((^?))
+import Data.Aeson.Lens
+import Data.Aeson.QQ
+
+import Network.HTTP.Types
+import Network.Wai        (Application)
+import Network.Wai.Test   (SResponse (simpleHeaders), simpleBody)
+
+import Test.Hspec
+import Test.Hspec.Wai
+import Test.Hspec.Wai.JSON
+
+import Protolude
+import SpecHelper
+
+import PostgREST.Types (PgVersion, pgVersion96)
+
+spec :: PgVersion -> SpecWith ((), Application)
+spec actualPgVersion =
+  describe "multiple schemas in single instance" $ do
+    context "Reading tables on different schemas" $ do
+      it "succeeds in reading table from default schema v1 if no schema is selected via header" $
+        request methodGet "/parents" [] "" `shouldRespondWith`
+          [json|[
+            {"id":1,"name":"parent v1-1"},
+            {"id":2,"name":"parent v1-2"}
+          ]|]
+          {
+            matchStatus = 200
+          , matchHeaders = [matchContentTypeJson, "Content-Profile" <:> "v1"]
+          }
+
+      it "succeeds in reading table from default schema v1 after explicitly passing it in the header" $
+        request methodGet "/parents" [("Accept-Profile", "v1")] "" `shouldRespondWith`
+          [json|[
+            {"id":1,"name":"parent v1-1"},
+            {"id":2,"name":"parent v1-2"}
+          ]|]
+          {
+            matchStatus = 200
+          , matchHeaders = [matchContentTypeJson, "Content-Profile" <:> "v1"]
+          }
+
+      it "succeeds in reading table from schema v2" $
+        request methodGet "/parents" [("Accept-Profile", "v2")] "" `shouldRespondWith`
+          [json|[
+            {"id":3,"name":"parent v2-3"},
+            {"id":4,"name":"parent v2-4"}
+          ]|]
+          {
+            matchStatus = 200
+          , matchHeaders = [matchContentTypeJson, "Content-Profile" <:> "v2"]
+          }
+
+      it "succeeds in reading another_table from schema v2" $
+        request methodGet "/another_table" [("Accept-Profile", "v2")] "" `shouldRespondWith`
+          [json|[
+            {"id":5,"another_value":"value 5"},
+            {"id":6,"another_value":"value 6"}
+          ]|]
+          {
+            matchStatus = 200
+          , matchHeaders = [matchContentTypeJson, "Content-Profile" <:> "v2"]
+          }
+
+      it "doesn't find another_table in schema v1" $
+        request methodGet "/another_table" [("Accept-Profile", "v1")] "" `shouldRespondWith` 404
+
+      it "fails trying to read table from unkown schema" $
+        request methodGet "/parents" [("Accept-Profile", "unkown")] "" `shouldRespondWith`
+          [json|{"message":"The schema must be one of the following: v1, v2"}|]
+          {
+            matchStatus = 406
+          }
+
+    context "Inserting tables on different schemas" $ do
+      it "succeeds inserting on default schema and returning it" $
+        request methodPost "/childs" [("Prefer", "return=representation")] [json|{"name": "child v1-1", "parent_id": 1}|]
+         `shouldRespondWith`
+         [json|[{"id":1, "name": "child v1-1", "parent_id": 1}]|]
+         {
+           matchStatus = 201
+         , matchHeaders = [matchContentTypeJson, "Content-Profile" <:> "v1"]
+         }
+
+      it "succeeds inserting on the v1 schema and returning its parent" $
+        request methodPost "/childs?select=id,parent(*)" [("Prefer", "return=representation"), ("Content-Profile", "v1")]
+          [json|{"name": "child v1-2", "parent_id": 2}|]
+          `shouldRespondWith`
+          [json|[{"id":2, "parent": {"id": 2, "name": "parent v1-2"}}]|]
+          {
+            matchStatus = 201
+          , matchHeaders = [matchContentTypeJson, "Content-Profile" <:> "v1"]
+          }
+
+      it "succeeds inserting on the v2 schema and returning its parent" $
+        request methodPost "/childs?select=id,parent(*)" [("Prefer", "return=representation"), ("Content-Profile", "v2")]
+          [json|{"name": "child v2-3", "parent_id": 3}|]
+          `shouldRespondWith`
+          [json|[{"id":1, "parent": {"id": 3, "name": "parent v2-3"}}]|]
+          {
+            matchStatus = 201
+          , matchHeaders = [matchContentTypeJson, "Content-Profile" <:> "v2"]
+          }
+
+      it "fails when inserting on an unknown schema" $
+        request methodPost "/childs" [("Content-Profile", "unknown")]
+          [json|{"name": "child 4", "parent_id": 4}|]
+          `shouldRespondWith`
+          [json|{"message":"The schema must be one of the following: v1, v2"}|]
+          {
+            matchStatus = 406
+          }
+
+    context "calling procs on different schemas" $ do
+      it "succeeds in calling the default schema proc" $
+        request methodGet "/rpc/get_parents_below?id=6" [] ""
+          `shouldRespondWith`
+          [json|[{"id":1,"name":"parent v1-1"}, {"id":2,"name":"parent v1-2"}]|]
+          {
+            matchStatus = 200
+          , matchHeaders = [matchContentTypeJson, "Content-Profile" <:> "v1"]
+          }
+
+      it "succeeds in calling the v1 schema proc and embedding" $
+        request methodGet "/rpc/get_parents_below?id=6&select=id,name,childs(id,name)" [("Accept-Profile", "v1")] ""
+          `shouldRespondWith`
+          [json| [
+            {"id":1,"name":"parent v1-1","childs":[{"id":1,"name":"child v1-1"}]},
+            {"id":2,"name":"parent v1-2","childs":[{"id":2,"name":"child v1-2"}]}] |]
+          {
+            matchStatus = 200
+          , matchHeaders = [matchContentTypeJson, "Content-Profile" <:> "v1"]
+          }
+
+      it "succeeds in calling the v2 schema proc and embedding" $
+        request methodGet "/rpc/get_parents_below?id=6&select=id,name,childs(id,name)" [("Accept-Profile", "v2")] ""
+          `shouldRespondWith`
+          [json| [
+            {"id":3,"name":"parent v2-3","childs":[{"id":1,"name":"child v2-3"}]},
+            {"id":4,"name":"parent v2-4","childs":[]}] |]
+          {
+            matchStatus = 200
+          , matchHeaders = [matchContentTypeJson, "Content-Profile" <:> "v2"]
+          }
+
+    context "Modifying tables on different schemas" $ do
+      it "succeeds in patching on the v1 schema and returning its parent" $
+        request methodPatch "/childs?select=name,parent(name)&id=eq.1" [("Content-Profile", "v1"), ("Prefer", "return=representation")]
+          [json|{"name": "child v1-1 updated"}|]
+          `shouldRespondWith`
+          [json|[{"name":"child v1-1 updated", "parent": {"name": "parent v1-1"}}]|]
+          {
+            matchStatus = 200
+          , matchHeaders = [matchContentTypeJson, "Content-Profile" <:> "v1"]
+          }
+
+      it "succeeds in patching on the v2 schema and returning its parent" $
+        request methodPatch "/childs?select=name,parent(name)&id=eq.1" [("Content-Profile", "v2"), ("Prefer", "return=representation")]
+          [json|{"name": "child v2-1 updated"}|]
+          `shouldRespondWith`
+          [json|[{"name":"child v2-1 updated", "parent": {"name": "parent v2-3"}}]|]
+          {
+            matchStatus = 200
+          , matchHeaders = [matchContentTypeJson, "Content-Profile" <:> "v2"]
+          }
+
+      it "succeeds on deleting on the v2 schema" $ do
+        request methodDelete "/childs?id=eq.1" [("Content-Profile", "v2"), ("Prefer", "return=representation")] ""
+          `shouldRespondWith` [json|[{"id": 1, "name": "child v2-1 updated", "parent_id": 3}]|]
+          {
+            matchStatus = 200
+          , matchHeaders = [matchContentTypeJson, "Content-Profile" <:> "v2"]
+          }
+        request methodGet "/childs?id=eq.1" [("Accept-Profile", "v2")] ""
+          `shouldRespondWith` "[]"
+          {
+            matchStatus = 200
+          , matchHeaders = [matchContentTypeJson, "Content-Profile" <:> "v2"]
+          }
+
+      when (actualPgVersion >= pgVersion96) $
+        it "succeeds on PUT on the v2 schema" $
+          request methodPut "/childs?id=eq.111" [("Content-Profile", "v2"), ("Prefer", "return=representation")]
+            [json| [ { "id": 111, "name": "child v2-111", "parent_id": null } ]|]
+            `shouldRespondWith`
+            [json|[{ "id": 111, "name": "child v2-111", "parent_id": null }]|]
+            {
+              matchStatus = 200
+            , matchHeaders = [matchContentTypeJson, "Content-Profile" <:> "v2"]
+            }
+
+    context "OpenAPI output" $ do
+      it "succeeds in reading table definition from default schema v1 if no schema is selected via header" $ do
+          req <- request methodGet "/" [] ""
+
+          liftIO $ do
+            simpleHeaders req `shouldSatisfy` matchHeader "Content-Profile" "v1"
+
+            let def = simpleBody req ^? key "definitions" . key "parents"
+
+            def `shouldBe` Just
+                [aesonQQ|
+                  {
+                    "type" : "object",
+                    "properties" : {
+                      "id" : {
+                        "description" : "Note:\nThis is a Primary Key.<pk/>",
+                        "format" : "integer",
+                        "type" : "integer"
+                      },
+                      "name" : {
+                        "format" : "text",
+                        "type" : "string"
+                      }
+                    },
+                    "required" : [
+                      "id"
+                    ]
+                  }
+                |]
+
+      it "succeeds in reading table definition from default schema v1 after explicitly passing it in the header" $ do
+          r <- request methodGet "/" [("Accept-Profile", "v1")] ""
+
+          liftIO $ do
+            simpleHeaders r `shouldSatisfy` matchHeader "Content-Profile" "v1"
+
+            let def = simpleBody r ^? key "definitions" . key "parents"
+
+            def `shouldBe` Just
+                [aesonQQ|
+                  {
+                    "type" : "object",
+                    "properties" : {
+                      "id" : {
+                        "description" : "Note:\nThis is a Primary Key.<pk/>",
+                        "format" : "integer",
+                        "type" : "integer"
+                      },
+                      "name" : {
+                        "format" : "text",
+                        "type" : "string"
+                      }
+                    },
+                    "required" : [
+                      "id"
+                    ]
+                  }
+                |]
+
+      it "succeeds in reading table definition from schema v2" $ do
+          r <- request methodGet "/" [("Accept-Profile", "v2")] ""
+
+          liftIO $ do
+            simpleHeaders r `shouldSatisfy` matchHeader "Content-Profile" "v2"
+
+            let def = simpleBody r ^? key "definitions" . key "parents"
+
+            def `shouldBe` Just
+                [aesonQQ|
+                  {
+                    "type" : "object",
+                    "properties" : {
+                      "id" : {
+                        "description" : "Note:\nThis is a Primary Key.<pk/>",
+                        "format" : "integer",
+                        "type" : "integer"
+                      },
+                      "name" : {
+                        "format" : "text",
+                        "type" : "string"
+                      }
+                    },
+                    "required" : [
+                      "id"
+                    ]
+                  }
+                |]
+
+      it "succeeds in reading another_table definition from schema v2" $ do
+          r <- request methodGet "/" [("Accept-Profile", "v2")] ""
+
+          liftIO $ do
+            simpleHeaders r `shouldSatisfy` matchHeader "Content-Profile" "v2"
+
+            let def = simpleBody r ^? key "definitions" . key "another_table"
+
+            def `shouldBe` Just
+                [aesonQQ|
+                  {
+                    "type" : "object",
+                    "properties" : {
+                      "id" : {
+                        "description" : "Note:\nThis is a Primary Key.<pk/>",
+                        "format" : "integer",
+                        "type" : "integer"
+                      },
+                      "another_value" : {
+                        "format" : "text",
+                        "type" : "string"
+                      }
+                    },
+                    "required" : [
+                      "id"
+                    ]
+                  }
+                |]
+
+      it "doesn't find another_table definition in schema v1" $ do
+        r <- request methodGet "/" [("Accept-Profile", "v1")] ""
+
+        liftIO $ do
+          let def = simpleBody r ^? key "definitions" . key "another_table"
+          def `shouldBe` Nothing
+
+      it "fails trying to read definitions from unkown schema" $
+        request methodGet "/" [("Accept-Profile", "unkown")] "" `shouldRespondWith`
+          [json|{"message":"The schema must be one of the following: v1, v2"}|]
+          {
+            matchStatus = 406
+          }

test/Feature/NoJwtSpec.hs

@@ -1,24 +1,30 @@
 module Feature.NoJwtSpec where
 
 -- {{{ Imports
-import Test.Hspec
-import Test.Hspec.Wai
-import Network.HTTP.Types
 
-import SpecHelper
 import Network.Wai (Application)
 
-import Protolude hiding (get)
+import Network.HTTP.Types
+import Test.Hspec
+import Test.Hspec.Wai
+import Test.Hspec.Wai.JSON
+
+import Protolude
+import SpecHelper
 -- }}}
 
-spec :: SpecWith Application
+spec :: SpecWith ((), Application)
 spec = describe "server started without JWT secret" $ do
 
   -- this test will stop working 9999999999s after the UNIX EPOCH
   it "responds with error on attempted auth" $ do
     let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJleHAiOjk5OTk5OTk5OTksInJvbGUiOiJwb3N0Z3Jlc3RfdGVzdF9hdXRob3IiLCJpZCI6Impkb2UifQ.Dpss-QoLYjec5OTsOaAc3FNVsSjA89wACoV-0ra3ClA"
     request methodGet "/authors_only" [auth] ""
-      `shouldRespondWith` 500
+      `shouldRespondWith`
+      [json|{"message":"Server lacks JWT secret"}|]
+      { matchStatus  = 500
+      , matchHeaders = [ matchContentTypeJson ]
+      }
 
   it "behaves normally when user does not attempt auth" $
     request methodGet "/items" [] ""

test/Feature/NonexistentSchemaSpec.hs

@@ -0,0 +1,17 @@
+module Feature.NonexistentSchemaSpec where
+
+import Network.Wai (Application)
+
+import Test.Hspec
+import Test.Hspec.Wai
+
+import Protolude hiding (get)
+
+spec :: SpecWith ((), Application)
+spec =
+  describe "Non existent api schema" $ do
+    it "succeeds when requesting root path" $
+      get "/" `shouldRespondWith` 200
+
+    it "gives 404 when requesting a nonexistent table in this nonexistent schema" $
+      get "/nonexistent_table" `shouldRespondWith` 404

test/Feature/PgVersion95Spec.hs

@@ -0,0 +1,55 @@
+module Feature.PgVersion95Spec where
+
+import Network.Wai (Application)
+
+import Test.Hspec
+import Test.Hspec.Wai
+import Test.Hspec.Wai.JSON
+
+import Protolude  hiding (get)
+import SpecHelper
+
+spec :: SpecWith ((), Application)
+spec = describe "features supported on PostgreSQL 9.5" $
+  context "json array negative index" $ do
+    it "can select with negative indexes" $ do
+      get "/json_arr?select=data->>-1::int&id=in.(1,2)" `shouldRespondWith`
+        [json| [{"data":3}, {"data":6}] |]
+        { matchHeaders = [matchContentTypeJson] }
+      get "/json_arr?select=data->0->>-2::int&id=in.(3,4)" `shouldRespondWith`
+        [json| [{"data":8}, {"data":7}] |]
+        { matchHeaders = [matchContentTypeJson] }
+      get "/json_arr?select=data->-2->>a&id=in.(5,6)" `shouldRespondWith`
+        [json| [{"a":"A"}, {"a":"[1,2,3]"}] |]
+        { matchHeaders = [matchContentTypeJson] }
+
+    it "can filter with negative indexes" $ do
+      get "/json_arr?select=data&data->>-3=eq.1" `shouldRespondWith`
+        [json| [{"data":[1, 2, 3]}] |]
+        { matchHeaders = [matchContentTypeJson] }
+      get "/json_arr?select=data&data->-1->>-3=eq.11" `shouldRespondWith`
+        [json| [{"data":[[9, 8, 7], [11, 12, 13]]}] |]
+        { matchHeaders = [matchContentTypeJson] }
+      get "/json_arr?select=data&data->-1->>b=eq.B" `shouldRespondWith`
+        [json| [{"data":[{"a": "A"}, {"b": "B"}]}] |]
+        { matchHeaders = [matchContentTypeJson] }
+      get "/json_arr?select=data&data->-1->b->>-1=eq.5" `shouldRespondWith`
+        [json| [{"data":[{"a": [1,2,3]}, {"b": [4,5]}]}] |]
+        { matchHeaders = [matchContentTypeJson] }
+
+    it "should fail on badly formed negatives" $ do
+      get "/json_arr?select=data->>-78xy" `shouldRespondWith`
+        [json|
+          {"details": "unexpected 'x' expecting digit, \"->\", \"::\" or end of input",
+           "message": "\"failed to parse select parameter (data->>-78xy)\" (line 1, column 11)"} |]
+        { matchStatus = 400, matchHeaders = [matchContentTypeJson] }
+      get "/json_arr?select=data->>--34" `shouldRespondWith`
+        [json|
+          {"details": "unexpected \"-\" expecting digit",
+           "message": "\"failed to parse select parameter (data->>--34)\" (line 1, column 9)"} |]
+        { matchStatus = 400, matchHeaders = [matchContentTypeJson] }
+      get "/json_arr?select=data->>-xy-4" `shouldRespondWith`
+        [json|
+          {"details":"unexpected \"x\" expecting digit",
+           "message":"\"failed to parse select parameter (data->>-xy-4)\" (line 1, column 9)"} |]
+        { matchStatus = 400, matchHeaders = [matchContentTypeJson] }

test/Feature/PgVersion96Spec.hs

@@ -0,0 +1,195 @@
+module Feature.PgVersion96Spec where
+
+import Network.HTTP.Types
+import Network.Wai        (Application)
+import Network.Wai.Test   (SResponse (simpleHeaders))
+
+import Test.Hspec
+import Test.Hspec.Wai
+import Test.Hspec.Wai.JSON
+
+import Protolude  hiding (get)
+import SpecHelper
+
+spec :: SpecWith ((), Application)
+spec =
+  describe "features supported on PostgreSQL 9.6" $ do
+    context "GUC headers on function calls" $ do
+      it "succeeds setting the headers" $ do
+        get "/rpc/get_projects_and_guc_headers?id=eq.2&select=id"
+          `shouldRespondWith` [json|[{"id": 2}]|]
+          {matchHeaders = [
+              matchContentTypeJson,
+              "X-Test"   <:> "key1=val1; someValue; key2=val2",
+              "X-Test-2" <:> "key1=val1"]}
+        get "/rpc/get_int_and_guc_headers?num=1"
+          `shouldRespondWith` [json|1|]
+          {matchHeaders = [
+              matchContentTypeJson,
+              "X-Test"   <:> "key1=val1; someValue; key2=val2",
+              "X-Test-2" <:> "key1=val1"]}
+        post "/rpc/get_int_and_guc_headers" [json|{"num": 1}|]
+          `shouldRespondWith` [json|1|]
+          {matchHeaders = [
+              matchContentTypeJson,
+              "X-Test"   <:> "key1=val1; someValue; key2=val2",
+              "X-Test-2" <:> "key1=val1"]}
+
+      it "fails when setting headers with wrong json structure" $ do
+        get "/rpc/bad_guc_headers_1"
+          `shouldRespondWith`
+          [json|{"message":"response.headers guc must be a JSON array composed of objects with a single key and a string value"}|]
+          { matchStatus  = 500
+          , matchHeaders = [ matchContentTypeJson ]
+          }
+        get "/rpc/bad_guc_headers_2"
+          `shouldRespondWith`
+          [json|{"message":"response.headers guc must be a JSON array composed of objects with a single key and a string value"}|]
+          { matchStatus  = 500
+          , matchHeaders = [ matchContentTypeJson ]
+          }
+        get "/rpc/bad_guc_headers_3"
+          `shouldRespondWith`
+          [json|{"message":"response.headers guc must be a JSON array composed of objects with a single key and a string value"}|]
+          { matchStatus  = 500
+          , matchHeaders = [ matchContentTypeJson ]
+          }
+        post "/rpc/bad_guc_headers_1" [json|{}|]
+          `shouldRespondWith`
+          [json|{"message":"response.headers guc must be a JSON array composed of objects with a single key and a string value"}|]
+          { matchStatus  = 500
+          , matchHeaders = [ matchContentTypeJson ]
+          }
+
+      it "can set the same http header twice" $
+        get "/rpc/set_cookie_twice"
+          `shouldRespondWith` "null"
+          {matchHeaders = [
+              matchContentTypeJson,
+              "Set-Cookie" <:> "sessionid=38afes7a8; HttpOnly; Path=/",
+              "Set-Cookie" <:> "id=a3fWa; Expires=Wed, 21 Oct 2015 07:28:00 GMT; Secure; HttpOnly"]}
+
+    context "GUC headers on all other methods via pre-request" $ do
+      it "succeeds setting the headers on GET and HEAD" $ do
+        request methodGet "/items?id=eq.1" [("User-Agent", "MSIE 6.0")] mempty
+          `shouldRespondWith` [json|[{"id": 1}]|]
+          {matchHeaders = [
+              matchContentTypeJson,
+              "Cache-Control" <:> "no-cache, no-store, must-revalidate"]}
+
+        request methodHead "/items?id=eq.1" [("User-Agent", "MSIE 7.0")] mempty
+          `shouldRespondWith` ""
+          {matchHeaders = ["Cache-Control" <:> "no-cache, no-store, must-revalidate"]}
+
+        request methodHead "/projects" [("Accept", "text/csv")] mempty
+          `shouldRespondWith` ""
+          {matchHeaders = ["Content-Disposition" <:> "attachment; filename=projects.csv"]}
+
+      it "succeeds setting the headers on POST" $
+        request methodPost "/items" [] [json|[{"id": 11111}]|]
+          `shouldRespondWith` ""
+          { matchStatus = 201
+          , matchHeaders = ["X-Custom-Header" <:> "mykey=myval"]
+          }
+
+      it "succeeds setting the headers on PATCH" $
+        request methodPatch "/items?id=eq.11111" [] [json|[{"id": 11111}]|]
+          `shouldRespondWith` ""
+          { matchStatus = 204
+          , matchHeaders = ["X-Custom-Header" <:> "mykey=myval"]
+          }
+
+      it "succeeds setting the headers on PUT" $
+        request methodPut "/items?id=eq.11111" [] [json|[{"id": 11111}]|]
+          `shouldRespondWith` ""
+          { matchStatus = 204
+          , matchHeaders = ["X-Custom-Header" <:> "mykey=myval"]
+          }
+
+      it "succeeds setting the headers on DELETE" $
+        request methodDelete "/items?id=eq.11111" [] mempty
+          `shouldRespondWith` ""
+          { matchStatus = 204
+          , matchHeaders = ["X-Custom-Header" <:> "mykey=myval"]
+          }
+
+    context "Override provided headers by using GUC headers" $ do
+      it "can override the Content-Type header" $ do
+        request methodHead "/clients?id=eq.1" [] mempty
+          `shouldRespondWith` ""
+          { matchStatus = 200
+          , matchHeaders = ["Content-Type" <:> "application/geo+json"]
+          }
+        request methodHead "/rpc/getallprojects" [] mempty
+          `shouldRespondWith` ""
+          { matchStatus = 200
+          , matchHeaders = ["Content-Type" <:> "application/geo+json"]
+          }
+
+      it "can override the Location header" $
+        request methodPost "/stuff" [] [json|[{"id": 1, "name": "stuff 1"}]|]
+          `shouldRespondWith` ""
+          { matchStatus = 201
+          , matchHeaders = ["Location" <:> "/stuff?id=eq.1&overriden=true"]
+          }
+
+    -- On https://github.com/PostgREST/postgrest/issues/1427#issuecomment-595907535
+    -- it was reported that blank headers ` : ` where added and that cause proxies to fail the requests.
+    -- These tests are to ensure no blank headers are added.
+    context "Blank headers bug" $ do
+      it "shouldn't add blank headers on POST" $ do
+        r <- request methodPost "/loc_test" [] [json|{"id": "1", "c": "c1"}|]
+        liftIO $ do
+          let respHeaders = simpleHeaders r
+          respHeaders `shouldSatisfy` noBlankHeader
+
+      it "shouldn't add blank headers on PATCH" $ do
+        r <- request methodPatch "/loc_test?id=eq.1" [] [json|{"c": "c2"}|]
+        liftIO $ do
+          let respHeaders = simpleHeaders r
+          respHeaders `shouldSatisfy` noBlankHeader
+
+      it "shouldn't add blank headers on GET" $ do
+        r <- request methodGet "/loc_test" [] ""
+        liftIO $ do
+          let respHeaders = simpleHeaders r
+          respHeaders `shouldSatisfy` noBlankHeader
+
+      it "shouldn't add blank headers on DELETE" $ do
+        r <- request methodDelete "/loc_test?id=eq.1" [] ""
+        liftIO $ do
+          let respHeaders = simpleHeaders r
+          respHeaders `shouldSatisfy` noBlankHeader
+
+    context "Use of the phraseto_tsquery function" $ do
+      it "finds matches" $
+        get "/tsearch?text_search_vector=phfts.The%20Fat%20Cats" `shouldRespondWith`
+          [json| [{"text_search_vector": "'ate':3 'cat':2 'fat':1 'rat':4" }] |]
+          { matchHeaders = [matchContentTypeJson] }
+
+      it "finds matches with different dictionaries" $
+        get "/tsearch?text_search_vector=phfts(german).Art%20Spass" `shouldRespondWith`
+          [json| [{"text_search_vector": "'art':4 'spass':5 'unmog':7" }] |]
+          { matchHeaders = [matchContentTypeJson] }
+
+      it "can be negated with not operator" $
+        get "/tsearch?text_search_vector=not.phfts(english).The%20Fat%20Cats" `shouldRespondWith`
+          [json| [
+            {"text_search_vector": "'fun':5 'imposs':9 'kind':3"},
+            {"text_search_vector": "'also':2 'fun':3 'possibl':8"},
+            {"text_search_vector": "'amus':5 'fair':7 'impossibl':9 'peu':4"},
+            {"text_search_vector": "'art':4 'spass':5 'unmog':7"}]|]
+          { matchHeaders = [matchContentTypeJson] }
+
+      it "can be used with or query param" $
+        get "/tsearch?or=(text_search_vector.phfts(german).Art%20Spass, text_search_vector.phfts(french).amusant, text_search_vector.fts(english).impossible)" `shouldRespondWith`
+          [json|[
+            {"text_search_vector": "'fun':5 'imposs':9 'kind':3" },
+            {"text_search_vector": "'amus':5 'fair':7 'impossibl':9 'peu':4" },
+            {"text_search_vector": "'art':4 'spass':5 'unmog':7"}
+          ]|] { matchHeaders = [matchContentTypeJson] }
+
+      it "should work when used with GET RPC" $
+        get "/rpc/get_tsearch?text_search_vector=phfts(english).impossible" `shouldRespondWith`
+          [json|[{"text_search_vector":"'fun':5 'imposs':9 'kind':3"}]|]
+          { matchHeaders = [matchContentTypeJson] }

test/Feature/ProxySpec.hs

@@ -1,14 +1,12 @@
 module Feature.ProxySpec where
 
-import Test.Hspec hiding (pendingWith)
+import Network.Wai (Application)
+import Test.Hspec  hiding (pendingWith)
 
+import Protolude
 import SpecHelper
 
-import Network.Wai (Application)
+spec :: SpecWith ((), Application)
-
-import Protolude hiding (get)
-
-spec :: SpecWith Application
 spec =
   describe "GET / with proxy" $
     it "returns a valid openapi spec with proxy" $

test/Feature/QueryLimitedSpec.hs

@@ -1,19 +1,19 @@
 module Feature.QueryLimitedSpec where
 
-import Test.Hspec hiding (pendingWith)
+import Network.Wai      (Application)
+import Network.Wai.Test (SResponse (simpleHeaders, simpleStatus))
+
+import Network.HTTP.Types
+import Test.Hspec
 import Test.Hspec.Wai
 import Test.Hspec.Wai.JSON
-import Network.HTTP.Types
+
-import Network.Wai.Test (SResponse(simpleHeaders, simpleStatus))
+import Protolude  hiding (get)
-import Text.Heredoc
 import SpecHelper
-import Network.Wai (Application)
 
-import Protolude hiding (get)
+spec :: SpecWith ((), Application)
-
-spec :: SpecWith Application
 spec =
-  describe "Requesting many items with server limits enabled" $ do
+  describe "Requesting many items with server limits(max-rows) enabled" $ do
     it "restricts results" $
       get "/items"
         `shouldRespondWith` [json| [{"id":1},{"id":2}] |]
@@ -29,16 +29,45 @@ spec =
           matchHeader "Content-Range" "0-0/*"
         simpleStatus r `shouldBe` ok200
 
-    it "limit works on all levels" $
+    it "works on all levels" $
-      get "/users?select=id,tasks{id}&order=id.asc&tasks.order=id.asc"
+      get "/users?select=id,tasks(id)&order=id.asc&tasks.order=id.asc"
-        `shouldRespondWith` [str|[{"id":1,"tasks":[{"id":1},{"id":2}]},{"id":2,"tasks":[{"id":5},{"id":6}]}]|]
+        `shouldRespondWith` [json|[{"id":1,"tasks":[{"id":1},{"id":2}]},{"id":2,"tasks":[{"id":5},{"id":6}]}]|]
         { matchStatus  = 200
         , matchHeaders = ["Content-Range" <:> "0-1/*"]
         }
 
-    it "limit is not applied to parent embeds" $
+    it "succeeds in getting parent embeds despite the limit, see #647" $
-      get "/tasks?select=id,project{id}&id=gt.5"
+      get "/tasks?select=id,project:projects(id)&id=gt.5"
-        `shouldRespondWith` [str|[{"id":6,"project":{"id":3}},{"id":7,"project":{"id":4}}]|]
+        `shouldRespondWith` [json|[{"id":6,"project":{"id":3}},{"id":7,"project":{"id":4}}]|]
         { matchStatus  = 200
         , matchHeaders = ["Content-Range" <:> "0-1/*"]
         }
+
+    it "can offset the parent embed, being consistent with the other embed types" $
+      get "/tasks?select=id,project:projects(id)&id=gt.5&project.offset=1"
+        `shouldRespondWith` [json|[{"id":6,"project":null}, {"id":7,"project":null}]|]
+        { matchStatus  = 200
+        , matchHeaders = ["Content-Range" <:> "0-1/*"]
+        }
+
+    context "count=estimated" $ do
+      it "uses the query planner guess when query rows > maxRows" $
+        request methodHead "/getallprojects_view" [("Prefer", "count=estimated")] ""
+          `shouldRespondWith` ""
+          { matchStatus  = 206
+          , matchHeaders = ["Content-Range" <:> "0-1/2019"]
+          }
+
+      it "gives exact count when query rows <= maxRows" $
+        request methodHead "/getallprojects_view?id=lt.3" [("Prefer", "count=estimated")] ""
+          `shouldRespondWith` ""
+          { matchStatus  = 200
+          , matchHeaders = ["Content-Range" <:> "0-1/2"]
+          }
+
+      it "only uses the query planner guess if it's indeed greater than the exact count" $
+        request methodHead "/get_projects_above_view" [("Prefer", "count=estimated")] ""
+          `shouldRespondWith` ""
+          { matchStatus  = 206
+          , matchHeaders = ["Content-Range" <:> "0-1/3"]
+          }

test/Feature/RangeSpec.hs

@@ -1,18 +1,17 @@
 module Feature.RangeSpec where
 
+import qualified Data.ByteString.Lazy as BL
+
+import Network.Wai      (Application)
+import Network.Wai.Test (SResponse (simpleHeaders, simpleStatus))
+
+import Network.HTTP.Types
 import Test.Hspec
 import Test.Hspec.Wai
 import Test.Hspec.Wai.JSON
-import Network.HTTP.Types
-import Network.Wai.Test (SResponse(simpleHeaders,simpleStatus))
-
-import qualified Data.ByteString.Lazy         as BL
 
+import Protolude  hiding (get)
 import SpecHelper
-import Text.Heredoc
-import Network.Wai (Application)
-
-import Protolude hiding (get)
 
 defaultRange :: BL.ByteString
 defaultRange = [json| { "min": 0, "max": 15 } |]
@@ -20,7 +19,7 @@ defaultRange = [json| { "min": 0, "max": 15 } |]
 emptyRange :: BL.ByteString
 emptyRange = [json| { "min": 2, "max": 2 } |]
 
-spec :: SpecWith Application
+spec :: SpecWith ((), Application)
 spec = do
   describe "POST /rpc/getitemrange" $ do
     context "without range headers" $ do
@@ -39,7 +38,6 @@ spec = do
             { matchHeaders = ["Content-Range" <:> "0-14/*"] }
 
     context "with range headers" $ do
-
       context "of acceptable range" $ do
         it "succeeds with partial content" $ do
           r <- request methodPost  "/rpc/getitemrange"
@@ -131,42 +129,134 @@ spec = do
       it "no parameters return everything" $
         get "/items?select=id&order=id.asc"
           `shouldRespondWith`
-          [str|[{"id":1},{"id":2},{"id":3},{"id":4},{"id":5},{"id":6},{"id":7},{"id":8},{"id":9},{"id":10},{"id":11},{"id":12},{"id":13},{"id":14},{"id":15}]|]
+          [json|[{"id":1},{"id":2},{"id":3},{"id":4},{"id":5},{"id":6},{"id":7},{"id":8},{"id":9},{"id":10},{"id":11},{"id":12},{"id":13},{"id":14},{"id":15}]|]
           { matchStatus  = 200
           , matchHeaders = ["Content-Range" <:> "0-14/*"]
           }
       it "top level limit with parameter" $
         get "/items?select=id&order=id.asc&limit=3"
-          `shouldRespondWith` [str|[{"id":1},{"id":2},{"id":3}]|]
+          `shouldRespondWith` [json|[{"id":1},{"id":2},{"id":3}]|]
           { matchStatus  = 200
           , matchHeaders = ["Content-Range" <:> "0-2/*"]
           }
       it "headers override get parameters" $
         request methodGet  "/items?select=id&order=id.asc&limit=3"
                      (rangeHdrs $ ByteRangeFromTo 0 1) ""
-          `shouldRespondWith` [str|[{"id":1},{"id":2}]|]
+          `shouldRespondWith` [json|[{"id":1},{"id":2}]|]
           { matchStatus  = 200
           , matchHeaders = ["Content-Range" <:> "0-1/*"]
           }
 
       it "limit works on all levels" $
-        get "/clients?select=id,projects{id,tasks{id}}&order=id.asc&limit=1&projects.order=id.asc&projects.limit=2&projects.tasks.order=id.asc&projects.tasks.limit=1"
+        get "/clients?select=id,projects(id,tasks(id))&order=id.asc&limit=1&projects.order=id.asc&projects.limit=2&projects.tasks.order=id.asc&projects.tasks.limit=1"
           `shouldRespondWith`
-          [str|[{"id":1,"projects":[{"id":1,"tasks":[{"id":1}]},{"id":2,"tasks":[{"id":3}]}]}]|]
+          [json|[{"id":1,"projects":[{"id":1,"tasks":[{"id":1}]},{"id":2,"tasks":[{"id":3}]}]}]|]
           { matchStatus  = 200
           , matchHeaders = ["Content-Range" <:> "0-0/*"]
           }
 
-
+      it "limit and offset works on first level" $ do
-      it "limit and offset works on first level" $
         get "/items?select=id&order=id.asc&limit=3&offset=2"
-          `shouldRespondWith` [str|[{"id":3},{"id":4},{"id":5}]|]
+          `shouldRespondWith` [json|[{"id":3},{"id":4},{"id":5}]|]
+          { matchStatus  = 200
+          , matchHeaders = ["Content-Range" <:> "2-4/*"]
+          }
+        request methodHead "/items?select=id&order=id.asc&limit=3&offset=2" [] mempty
+          `shouldRespondWith` ""
           { matchStatus  = 200
           , matchHeaders = ["Content-Range" <:> "2-4/*"]
           }
 
-    context "with range headers" $ do
+      it "succeeds if offset equals 0 as a no-op" $
+        get "/items?select=id&offset=0"
+          `shouldRespondWith`
+          [json|[{"id":1},{"id":2},{"id":3},{"id":4},{"id":5},{"id":6},{"id":7},{"id":8},{"id":9},{"id":10},{"id":11},{"id":12},{"id":13},{"id":14},{"id":15}]|]
+          { matchStatus  = 200
+          , matchHeaders = ["Content-Range" <:> "0-14/*"]
+          }
 
+      it "succeeds if offset is negative as a no-op" $
+        get "/items?select=id&offset=-4"
+          `shouldRespondWith`
+          [json|[{"id":1},{"id":2},{"id":3},{"id":4},{"id":5},{"id":6},{"id":7},{"id":8},{"id":9},{"id":10},{"id":11},{"id":12},{"id":13},{"id":14},{"id":15}]|]
+          { matchStatus  = 200
+          , matchHeaders = ["Content-Range" <:> "0-14/*"]
+          }
+
+      it "fails if limit equals 0" $
+        get "/items?select=id&limit=0"
+          `shouldRespondWith` [json|{"message":"HTTP Range error"}|]
+          { matchStatus  = 416
+          , matchHeaders = [matchContentTypeJson]
+          }
+
+      it "fails if limit is negative" $
+        get "/items?select=id&limit=-1"
+          `shouldRespondWith` [json|{"message":"HTTP Range error"}|]
+          { matchStatus  = 416
+          , matchHeaders = [matchContentTypeJson]
+          }
+
+    context "when count=planned" $ do
+      it "obtains a filtered range" $ do
+        request methodGet "/items?select=id&id=gt.8" [("Prefer", "count=planned")] ""
+          `shouldRespondWith` [json|[{"id":9}, {"id":10}, {"id":11}, {"id":12}, {"id":13}, {"id":14}, {"id":15}]|]
+          { matchStatus  = 206
+          , matchHeaders = ["Content-Range" <:> "0-6/8"]
+          }
+        request methodGet "/child_entities?select=id&id=gt.3" [("Prefer", "count=planned")] ""
+          `shouldRespondWith` [json|[{"id":4}, {"id":5}, {"id":6}]|]
+          { matchStatus  = 206
+          , matchHeaders = ["Content-Range" <:> "0-2/4"]
+          }
+        request methodGet "/getallprojects_view?select=id&id=lt.3" [("Prefer", "count=planned")] ""
+          `shouldRespondWith` [json|[{"id":1}, {"id":2}]|]
+          { matchStatus  = 206
+          , matchHeaders = ["Content-Range" <:> "0-1/673"]
+          }
+
+      it "obtains the full range" $ do
+        request methodHead "/items" [("Prefer", "count=planned")] ""
+          `shouldRespondWith` ""
+          { matchStatus  = 200
+          , matchHeaders = ["Content-Range" <:> "0-14/15"]
+          }
+        request methodHead "/child_entities" [("Prefer", "count=planned")] ""
+          `shouldRespondWith` ""
+          { matchStatus  = 200
+          , matchHeaders = ["Content-Range" <:> "0-5/6"]
+          }
+        request methodHead "/getallprojects_view" [("Prefer", "count=planned")] ""
+          `shouldRespondWith` ""
+          { matchStatus  = 206
+          , matchHeaders = ["Content-Range" <:> "0-4/2019"]
+          }
+
+      it "ignores limit/offset on the planned count" $ do
+        request methodHead "/items?limit=2&offset=3" [("Prefer", "count=planned")] ""
+          `shouldRespondWith` ""
+          { matchStatus  = 206
+          , matchHeaders = ["Content-Range" <:> "3-4/15"]
+          }
+        request methodHead "/child_entities?limit=2" [("Prefer", "count=planned")] ""
+          `shouldRespondWith` ""
+          { matchStatus  = 206
+          , matchHeaders = ["Content-Range" <:> "0-1/6"]
+          }
+        request methodHead "/getallprojects_view?limit=2" [("Prefer", "count=planned")] ""
+          `shouldRespondWith` ""
+          { matchStatus  = 206
+          , matchHeaders = ["Content-Range" <:> "0-1/2019"]
+          }
+
+      it "works with two levels" $
+        request methodHead "/child_entities?select=*,entities(*)" [("Prefer", "count=planned")] ""
+          `shouldRespondWith` ""
+          { matchStatus  = 200
+          , matchHeaders = ["Content-Range" <:> "0-5/6"]
+          }
+
+    context "with range headers" $ do
       context "of acceptable range" $ do
         it "succeeds with partial content" $ do
           r <- request methodGet  "/items"

test/Feature/RawOutputTypesSpec.hs

@@ -0,0 +1,33 @@
+module Feature.RawOutputTypesSpec where
+
+import Network.Wai (Application)
+
+import Network.HTTP.Types
+import Test.Hspec
+import Test.Hspec.Wai
+import Test.Hspec.Wai.JSON
+
+import Protolude
+import SpecHelper (acceptHdrs)
+
+spec :: SpecWith ((), Application)
+spec = describe "When raw-media-types config variable is missing or left empty" $ do
+  let firefoxAcceptHdrs = acceptHdrs "text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8"
+      chromeAcceptHdrs = acceptHdrs "text/html,application/xhtml+xml,application/xml;q=0.9,image/webp,image/apng,*/*;q=0.8,application/signed-exchange;v=b3"
+  it "responds json to a GET request with Firefox Accept headers" $
+    request methodGet "/items?id=eq.1" firefoxAcceptHdrs ""
+      `shouldRespondWith` [json| [{"id":1}] |]
+        { matchHeaders= ["Content-Type" <:> "application/json; charset=utf-8"] }
+  it "responds json to a GET request with Chrome Accept headers" $
+    request methodGet "/items?id=eq.1" chromeAcceptHdrs ""
+      `shouldRespondWith` [json| [{"id":1}] |]
+        { matchHeaders= ["Content-Type" <:> "application/json; charset=utf-8"] }
+
+  it "responds json to a GET request to RPC with Firefox Accept headers" $
+    request methodGet "/rpc/get_projects_below?id=3" chromeAcceptHdrs ""
+      `shouldRespondWith` [json|[{"id":1,"name":"Windows 7","client_id":1}, {"id":2,"name":"Windows 10","client_id":1}]|]
+        { matchHeaders= ["Content-Type" <:> "application/json; charset=utf-8"] }
+  it "responds json to a GET request to RPC with Chrome Accept headers" $
+    request methodGet "/rpc/get_projects_below?id=3" chromeAcceptHdrs ""
+      `shouldRespondWith` [json|[{"id":1,"name":"Windows 7","client_id":1}, {"id":2,"name":"Windows 10","client_id":1}]|]
+        { matchHeaders= ["Content-Type" <:> "application/json; charset=utf-8"] }

test/Feature/RootSpec.hs

@@ -0,0 +1,30 @@
+module Feature.RootSpec where
+
+import Network.HTTP.Types
+import Network.Wai        (Application)
+
+import Test.Hspec
+import Test.Hspec.Wai
+import Test.Hspec.Wai.JSON
+
+import Protolude hiding (get)
+
+import SpecHelper
+
+spec :: SpecWith ((), Application)
+spec =
+  describe "root spec function" $ do
+    it "accepts application/openapi+json" $
+      request methodGet "/"
+        [("Accept","application/openapi+json")] "" `shouldRespondWith`
+        [json|{
+           "swagger": "2.0",
+           "info": {"title": "PostgREST API", "description": "This is a dynamic API generated by PostgREST"}
+          }|]
+        { matchHeaders = ["Content-Type" <:> "application/openapi+json; charset=utf-8"] }
+
+    it "accepts application/json" $
+      request methodGet "/"
+        [("Accept", "application/json")] "" `shouldRespondWith`
+        [json| [{"table": "items"}, {"table": "subitems"}] |]
+        { matchHeaders = [matchContentTypeJson] }

test/Feature/RpcSpec.hs

@@ -0,0 +1,653 @@
+module Feature.RpcSpec where
+
+import qualified Data.ByteString.Lazy as BL (empty)
+
+import Network.Wai      (Application)
+import Network.Wai.Test (SResponse (simpleBody, simpleStatus))
+
+import Network.HTTP.Types
+import Test.Hspec          hiding (pendingWith)
+import Test.Hspec.Wai
+import Test.Hspec.Wai.JSON
+import Text.Heredoc
+
+import PostgREST.Types (PgVersion, pgVersion100, pgVersion109,
+                        pgVersion110, pgVersion112, pgVersion114,
+                        pgVersion95)
+import Protolude       hiding (get)
+import SpecHelper
+
+spec :: PgVersion -> SpecWith ((), Application)
+spec actualPgVersion =
+  describe "remote procedure call" $ do
+    context "a proc that returns a set" $ do
+      it "returns paginated results" $ do
+        request methodPost "/rpc/getitemrange"
+                (rangeHdrs (ByteRangeFromTo 0 0))  [json| { "min": 2, "max": 4 } |]
+           `shouldRespondWith` [json| [{"id":3}] |]
+            { matchStatus = 200
+            , matchHeaders = ["Content-Range" <:> "0-0/*"]
+            }
+        request methodGet "/rpc/getitemrange?min=2&max=4"
+                (rangeHdrs (ByteRangeFromTo 0 0)) ""
+           `shouldRespondWith` [json| [{"id":3}] |]
+            { matchStatus = 200
+            , matchHeaders = ["Content-Range" <:> "0-0/*"]
+            }
+        request methodHead "/rpc/getitemrange?min=2&max=4"
+                (rangeHdrs (ByteRangeFromTo 0 0)) ""
+           `shouldRespondWith` ""
+            { matchStatus = 200
+            , matchHeaders = ["Content-Range" <:> "0-0/*"]
+            }
+
+      it "includes total count if requested" $ do
+        request methodPost "/rpc/getitemrange"
+                (rangeHdrsWithCount (ByteRangeFromTo 0 0))
+                [json| { "min": 2, "max": 4 } |]
+           `shouldRespondWith` [json| [{"id":3}] |]
+            { matchStatus = 206 -- it now knows the response is partial
+            , matchHeaders = ["Content-Range" <:> "0-0/2"]
+            }
+        request methodGet "/rpc/getitemrange?min=2&max=4"
+                (rangeHdrsWithCount (ByteRangeFromTo 0 0)) ""
+           `shouldRespondWith` [json| [{"id":3}] |]
+            { matchStatus = 206
+            , matchHeaders = ["Content-Range" <:> "0-0/2"]
+            }
+        request methodHead "/rpc/getitemrange?min=2&max=4"
+                (rangeHdrsWithCount (ByteRangeFromTo 0 0)) ""
+           `shouldRespondWith` ""
+            { matchStatus = 206
+            , matchHeaders = ["Content-Range" <:> "0-0/2"]
+            }
+
+      it "returns proper json" $ do
+        post "/rpc/getitemrange" [json| { "min": 2, "max": 4 } |] `shouldRespondWith`
+          [json| [ {"id": 3}, {"id":4} ] |]
+          { matchHeaders = [matchContentTypeJson] }
+        get "/rpc/getitemrange?min=2&max=4" `shouldRespondWith`
+          [json| [ {"id": 3}, {"id":4} ] |]
+          { matchHeaders = [matchContentTypeJson] }
+
+      it "returns CSV" $ do
+        request methodPost "/rpc/getitemrange"
+                (acceptHdrs "text/csv")
+                [json| { "min": 2, "max": 4 } |]
+           `shouldRespondWith` "id\n3\n4"
+            { matchStatus = 200
+            , matchHeaders = ["Content-Type" <:> "text/csv; charset=utf-8"]
+            }
+        request methodGet "/rpc/getitemrange?min=2&max=4"
+                (acceptHdrs "text/csv") ""
+           `shouldRespondWith` "id\n3\n4"
+            { matchStatus = 200
+            , matchHeaders = ["Content-Type" <:> "text/csv; charset=utf-8"]
+            }
+        request methodHead "/rpc/getitemrange?min=2&max=4"
+                (acceptHdrs "text/csv") ""
+           `shouldRespondWith` ""
+            { matchStatus = 200
+            , matchHeaders = ["Content-Type" <:> "text/csv; charset=utf-8"]
+            }
+
+    context "unknown function" $ do
+      it "returns 404" $
+        post "/rpc/fakefunc" [json| {} |] `shouldRespondWith` 404
+      it "should fail with 404 on unknown proc name" $
+        get "/rpc/fake" `shouldRespondWith` 404
+      it "should fail with 404 on unknown proc args" $ do
+        get "/rpc/sayhello" `shouldRespondWith` 404
+        get "/rpc/sayhello?any_arg=value" `shouldRespondWith` 404
+      it "should not ignore unknown args and fail with 404" $
+        get "/rpc/add_them?a=1&b=2&smthelse=blabla" `shouldRespondWith`
+        let
+          message :: Text
+          message
+            | actualPgVersion < pgVersion95 = "function test.add_them(a := integer, b := integer, smthelse := text) does not exist"
+            | otherwise = "function test.add_them(a => integer, b => integer, smthelse => text) does not exist"
+        in [json| {
+          "code": "42883",
+          "details": null,
+          "hint": "No function matches the given name and argument types. You might need to add explicit type casts.",
+          "message": #{message} } |]
+        { matchStatus  = 404
+        , matchHeaders = [matchContentTypeJson]
+        }
+
+    it "works when having uppercase identifiers" $ do
+      get "/rpc/quotedFunction?user=mscott&fullName=Michael Scott&SSN=401-32-XXXX" `shouldRespondWith`
+        [json|{"user": "mscott", "fullName": "Michael Scott", "SSN": "401-32-XXXX"}|]
+        { matchHeaders = [matchContentTypeJson] }
+      post "/rpc/quotedFunction"
+        [json|{"user": "dschrute", "fullName": "Dwight Schrute", "SSN": "030-18-XXXX"}|]
+        `shouldRespondWith`
+        [json|{"user": "dschrute", "fullName": "Dwight Schrute", "SSN": "030-18-XXXX"}|]
+        { matchHeaders = [matchContentTypeJson] }
+
+    context "shaping the response returned by a proc" $ do
+      it "returns a project" $ do
+        post "/rpc/getproject" [json| { "id": 1} |] `shouldRespondWith`
+          [str|[{"id":1,"name":"Windows 7","client_id":1}]|]
+        get "/rpc/getproject?id=1" `shouldRespondWith`
+          [str|[{"id":1,"name":"Windows 7","client_id":1}]|]
+
+      it "can filter proc results" $ do
+        post "/rpc/getallprojects?id=gt.1&id=lt.5&select=id" [json| {} |] `shouldRespondWith`
+          [json|[{"id":2},{"id":3},{"id":4}]|]
+          { matchHeaders = [matchContentTypeJson] }
+        get "/rpc/getallprojects?id=gt.1&id=lt.5&select=id" `shouldRespondWith`
+          [json|[{"id":2},{"id":3},{"id":4}]|]
+          { matchHeaders = [matchContentTypeJson] }
+
+      it "can limit proc results" $ do
+        post "/rpc/getallprojects?id=gt.1&id=lt.5&select=id?limit=2&offset=1" [json| {} |]
+          `shouldRespondWith` [json|[{"id":3},{"id":4}]|]
+             { matchStatus = 200
+             , matchHeaders = ["Content-Range" <:> "1-2/*"] }
+        get "/rpc/getallprojects?id=gt.1&id=lt.5&select=id?limit=2&offset=1"
+          `shouldRespondWith` [json|[{"id":3},{"id":4}]|]
+             { matchStatus = 200
+             , matchHeaders = ["Content-Range" <:> "1-2/*"] }
+
+      it "select works on the first level" $ do
+        post "/rpc/getproject?select=id,name" [json| { "id": 1} |] `shouldRespondWith`
+          [str|[{"id":1,"name":"Windows 7"}]|]
+        get "/rpc/getproject?id=1&select=id,name" `shouldRespondWith`
+          [str|[{"id":1,"name":"Windows 7"}]|]
+
+    context "foreign entities embedding" $ do
+      it "can embed if related tables are in the exposed schema" $ do
+        post "/rpc/getproject?select=id,name,client:clients(id),tasks(id)" [json| { "id": 1} |] `shouldRespondWith`
+          [json|[{"id":1,"name":"Windows 7","client":{"id":1},"tasks":[{"id":1},{"id":2}]}]|]
+          { matchHeaders = [matchContentTypeJson] }
+        get "/rpc/getproject?id=1&select=id,name,client:clients(id),tasks(id)" `shouldRespondWith`
+          [json|[{"id":1,"name":"Windows 7","client":{"id":1},"tasks":[{"id":1},{"id":2}]}]|]
+          { matchHeaders = [matchContentTypeJson] }
+
+      it "cannot embed if the related table is not in the exposed schema" $ do
+        post "/rpc/single_article?select=*,article_stars(*)" [json|{ "id": 1}|]
+          `shouldRespondWith` 400
+        get "/rpc/single_article?id=1&select=*,article_stars(*)"
+          `shouldRespondWith` 400
+
+      it "can embed if the related tables are in a hidden schema but exposed as views" $ do
+        post "/rpc/single_article?select=id,articleStars(userId)" [json|{ "id": 2}|]
+          `shouldRespondWith` [json|[{"id": 2, "articleStars": [{"userId": 3}]}]|]
+          { matchHeaders = [matchContentTypeJson] }
+        get "/rpc/single_article?id=2&select=id,articleStars(userId)"
+          `shouldRespondWith` [json|[{"id": 2, "articleStars": [{"userId": 3}]}]|]
+          { matchHeaders = [matchContentTypeJson] }
+
+      it "can embed an M2M relationship table" $
+        get "/rpc/getallusers?select=name,tasks(name)&id=gt.1"
+          `shouldRespondWith` [json|[
+            {"name":"Michael Scott", "tasks":[{"name":"Design IOS"}, {"name":"Code IOS"}, {"name":"Design OSX"}]},
+            {"name":"Dwight Schrute","tasks":[{"name":"Design w7"}, {"name":"Design IOS"}]}
+          ]|]
+          { matchHeaders = [matchContentTypeJson] }
+
+      it "can embed an M2M relationship table that has a parent relationship table" $
+        get "/rpc/getallusers?select=name,tasks(name,project:projects(name))&id=gt.1"
+          `shouldRespondWith` [json|[
+            {"name":"Michael Scott","tasks":[
+              {"name":"Design IOS","project":{"name":"IOS"}},
+              {"name":"Code IOS","project":{"name":"IOS"}},
+              {"name":"Design OSX","project":{"name":"OSX"}}
+            ]},
+            {"name":"Dwight Schrute","tasks":[
+              {"name":"Design w7","project":{"name":"Windows 7"}},
+              {"name":"Design IOS","project":{"name":"IOS"}}
+            ]}
+          ]|]
+          { matchHeaders = [matchContentTypeJson] }
+
+    context "a proc that returns an empty rowset" $
+      it "returns empty json array" $ do
+        post "/rpc/test_empty_rowset" [json| {} |] `shouldRespondWith`
+          [json| [] |]
+          { matchHeaders = [matchContentTypeJson] }
+        get "/rpc/test_empty_rowset" `shouldRespondWith`
+          [json| [] |]
+          { matchHeaders = [matchContentTypeJson] }
+
+    context "proc return types" $ do
+      context "returns text" $ do
+        it "returns proper json" $
+          post "/rpc/sayhello" [json| { "name": "world" } |] `shouldRespondWith`
+            [json|"Hello, world"|]
+            { matchHeaders = [matchContentTypeJson] }
+
+        it "can handle unicode" $
+          post "/rpc/sayhello" [json| { "name": "￥" } |] `shouldRespondWith`
+            [json|"Hello, ￥"|]
+            { matchHeaders = [matchContentTypeJson] }
+
+      it "returns array" $
+        post "/rpc/ret_array" [json|{}|] `shouldRespondWith`
+          [json|[1, 2, 3]|]
+          { matchHeaders = [matchContentTypeJson] }
+
+      it "returns setof integers" $
+        post "/rpc/ret_setof_integers" [json|{}|] `shouldRespondWith`
+          [json|[{ "ret_setof_integers": 1 },
+                 { "ret_setof_integers": 2 },
+                 { "ret_setof_integers": 3 }]|]
+          { matchHeaders = [matchContentTypeJson] }
+
+      it "returns enum value" $
+        post "/rpc/ret_enum" [json|{ "val": "foo" }|] `shouldRespondWith`
+          [json|"foo"|]
+          { matchHeaders = [matchContentTypeJson] }
+
+      it "returns domain value" $
+        post "/rpc/ret_domain" [json|{ "val": "8" }|] `shouldRespondWith`
+          [json|8|]
+          { matchHeaders = [matchContentTypeJson] }
+
+      it "returns range" $
+        post "/rpc/ret_range" [json|{ "low": 10, "up": 20 }|] `shouldRespondWith`
+          [json|"[10,20)"|]
+          { matchHeaders = [matchContentTypeJson] }
+
+      it "returns row of scalars" $
+        post "/rpc/ret_scalars" [json|{}|] `shouldRespondWith`
+          [json|[{"a":"scalars", "b":"foo", "c":1, "d":"[10,20)"}]|]
+          { matchHeaders = [matchContentTypeJson] }
+
+      it "returns composite type in exposed schema" $
+        post "/rpc/ret_point_2d" [json|{}|] `shouldRespondWith`
+          [json|[{"x": 10, "y": 5}]|]
+          { matchHeaders = [matchContentTypeJson] }
+
+      it "cannot return composite type in hidden schema" $
+        post "/rpc/ret_point_3d" [json|{}|] `shouldRespondWith` 401
+
+      it "returns single row from table" $
+        post "/rpc/single_article?select=id" [json|{"id": 2}|] `shouldRespondWith`
+          [json|[{"id": 2}]|]
+          { matchHeaders = [matchContentTypeJson] }
+
+      it "returns null for void" $
+        post "/rpc/ret_void" [json|{}|] `shouldRespondWith`
+          [json|null|]
+          { matchHeaders = [matchContentTypeJson] }
+
+    context "proc argument types" $ do
+      it "accepts a variety of arguments" $
+        post "/rpc/varied_arguments"
+            [json| {
+              "double": 3.1,
+              "varchar": "hello",
+              "boolean": true,
+              "date": "20190101",
+              "money": 0,
+              "enum": "foo",
+              "integer": 43,
+              "json": {"some key": "some value"},
+              "jsonb": {"another key": [1, 2, "3"]}
+            } |]
+          `shouldRespondWith`
+            [json|"Hi"|]
+            { matchHeaders = [matchContentTypeJson] }
+
+      it "parses embedded JSON arguments as JSON" $
+        post "/rpc/json_argument"
+            [json| { "arg": { "key": 3 } } |]
+          `shouldRespondWith`
+            [json|"object"|]
+            { matchHeaders = [matchContentTypeJson] }
+
+      when (actualPgVersion < pgVersion100) $
+        it "parses quoted JSON arguments as JSON (Postgres < 10)" $
+          post "/rpc/json_argument"
+              [json| { "arg": "{ \"key\": 3 }" } |]
+            `shouldRespondWith`
+              [json|"object"|]
+              { matchHeaders = [matchContentTypeJson] }
+
+      when ((actualPgVersion >= pgVersion109 && actualPgVersion < pgVersion110)
+            || actualPgVersion >= pgVersion114) $
+        it "parses quoted JSON arguments as JSON string (from Postgres 10.9, 11.4)" $
+          post "/rpc/json_argument"
+              [json| { "arg": "{ \"key\": 3 }" } |]
+            `shouldRespondWith`
+              [json|"string"|]
+              { matchHeaders = [matchContentTypeJson] }
+
+    context "improper input" $ do
+      it "rejects unknown content type even if payload is good" $ do
+        request methodPost "/rpc/sayhello"
+          (acceptHdrs "audio/mpeg3") [json| { "name": "world" } |]
+            `shouldRespondWith` 415
+        request methodGet "/rpc/sayhello?name=world"
+          (acceptHdrs "audio/mpeg3") ""
+            `shouldRespondWith` 415
+      it "rejects malformed json payload" $ do
+        p <- request methodPost "/rpc/sayhello"
+          (acceptHdrs "application/json") "sdfsdf"
+        liftIO $ do
+          simpleStatus p `shouldBe` badRequest400
+          isErrorFormat (simpleBody p) `shouldBe` True
+      it "treats simple plpgsql raise as invalid input" $ do
+        p <- post "/rpc/problem" "{}"
+        liftIO $ do
+          simpleStatus p `shouldBe` badRequest400
+          isErrorFormat (simpleBody p) `shouldBe` True
+
+    context "unsupported verbs" $ do
+      it "DELETE fails" $
+        request methodDelete "/rpc/sayhello" [] ""
+          `shouldRespondWith`
+          [json|{"message":"Bad Request"}|]
+          { matchStatus  = 405
+          , matchHeaders = [matchContentTypeJson]
+          }
+      it "PATCH fails" $
+        request methodPatch "/rpc/sayhello" [] ""
+          `shouldRespondWith` 405
+      it "OPTIONS fails" $
+        -- TODO: should return info about the function
+        request methodOptions "/rpc/sayhello" [] ""
+          `shouldRespondWith` 405
+
+    it "executes the proc exactly once per request" $ do
+      post "/rpc/callcounter" [json| {} |] `shouldRespondWith`
+        [json|1|]
+        { matchHeaders = [matchContentTypeJson] }
+      post "/rpc/callcounter" [json| {} |] `shouldRespondWith`
+        [json|2|]
+        { matchHeaders = [matchContentTypeJson] }
+
+    context "a proc that receives no parameters" $ do
+      it "interprets empty string as empty json object on a post request" $
+        post "/rpc/noparamsproc" BL.empty `shouldRespondWith`
+          [json| "Return value of no parameters procedure." |]
+          { matchHeaders = [matchContentTypeJson] }
+      it "interprets empty string as a function with no args on a get request" $
+        get "/rpc/noparamsproc" `shouldRespondWith`
+          [json| "Return value of no parameters procedure." |]
+          { matchHeaders = [matchContentTypeJson] }
+
+    it "returns proper output when having the same return col name as the proc name" $ do
+      post "/rpc/test" [json|{}|] `shouldRespondWith`
+        [json|[{"test":"hello","value":1}]|] { matchHeaders = [matchContentTypeJson] }
+      get "/rpc/test" `shouldRespondWith`
+        [json|[{"test":"hello","value":1}]|] { matchHeaders = [matchContentTypeJson] }
+
+    context "procs with OUT/INOUT params" $ do
+      it "returns a scalar result when there is a single OUT param" $ do
+        get "/rpc/single_out_param?num=5" `shouldRespondWith`
+          [json|6|] { matchHeaders = [matchContentTypeJson] }
+        get "/rpc/single_json_out_param?a=1&b=two" `shouldRespondWith`
+          [json|{"a": 1, "b": "two"}|] { matchHeaders = [matchContentTypeJson] }
+
+      it "returns a scalar result when there is a single INOUT param" $
+        get "/rpc/single_inout_param?num=2" `shouldRespondWith`
+          [json|3|] { matchHeaders = [matchContentTypeJson] }
+
+      it "returns a row result when there are many OUT params" $
+        get "/rpc/many_out_params" `shouldRespondWith`
+          [json|[{"my_json":{"a": 1, "b": "two"},"num":3,"str":"four"}]|] { matchHeaders = [matchContentTypeJson] }
+
+      it "returns a row result when there are many INOUT params" $
+        get "/rpc/many_inout_params?num=1&str=two&b=false" `shouldRespondWith`
+          [json| [{"num":1,"str":"two","b":false}]|] { matchHeaders = [matchContentTypeJson] }
+
+    it "can handle procs with args that have a DEFAULT value" $ do
+      get "/rpc/many_inout_params?num=1&str=two" `shouldRespondWith`
+        [json| [{"num":1,"str":"two","b":true}]|] { matchHeaders = [matchContentTypeJson] }
+      get "/rpc/three_defaults?b=4" `shouldRespondWith`
+        [json|8|] { matchHeaders = [matchContentTypeJson] }
+
+    it "can map a RAISE error code and message to a http status" $
+      get "/rpc/raise_pt402"
+        `shouldRespondWith` [json|{ "hint": "Upgrade your plan", "details": "Quota exceeded" }|]
+        { matchStatus  = 402
+        , matchHeaders = [matchContentTypeJson]
+        }
+
+    it "defaults to status 500 if RAISE code is PT not followed by a number" $
+      get "/rpc/raise_bad_pt"
+        `shouldRespondWith`
+        [json|{"hint": null, "details": null}|]
+        { matchStatus  = 500
+        , matchHeaders = [ matchContentTypeJson ]
+        }
+
+    context "expects a single json object" $ do
+      it "does not expand posted json into parameters" $
+        request methodPost "/rpc/singlejsonparam"
+          [("prefer","params=single-object")] [json| { "p1": 1, "p2": "text", "p3" : {"obj":"text"} } |] `shouldRespondWith`
+          [json| { "p1": 1, "p2": "text", "p3" : {"obj":"text"} } |]
+          { matchHeaders = [matchContentTypeJson] }
+
+      it "accepts parameters from an html form" $
+        request methodPost "/rpc/singlejsonparam"
+          [("Prefer","params=single-object"),("Content-Type", "application/x-www-form-urlencoded")]
+          ("integer=7&double=2.71828&varchar=forms+are+fun&" <>
+           "boolean=false&date=1900-01-01&money=$3.99&enum=foo") `shouldRespondWith`
+          [json| { "integer": "7", "double": "2.71828", "varchar" : "forms are fun"
+                 , "boolean":"false", "date":"1900-01-01", "money":"$3.99", "enum":"foo" } |]
+                 { matchHeaders = [matchContentTypeJson] }
+
+      it "works with GET" $
+        request methodGet "/rpc/singlejsonparam?p1=1&p2=text" [("Prefer","params=single-object")] ""
+          `shouldRespondWith` [json|{ "p1": "1", "p2": "text"}|]
+          { matchHeaders = [matchContentTypeJson] }
+
+    it "should work with an overloaded function" $ do
+      get "/rpc/overloaded" `shouldRespondWith`
+        [json|[{ "overloaded": 1 },
+               { "overloaded": 2 },
+               { "overloaded": 3 }]|]
+        { matchHeaders = [matchContentTypeJson] }
+      request methodPost "/rpc/overloaded" [("Prefer","params=single-object")]
+        [json|[{"x": 1, "y": "first"}, {"x": 2, "y": "second"}]|]
+       `shouldRespondWith`
+        [json|[{"x": 1, "y": "first"}, {"x": 2, "y": "second"}]|]
+        { matchHeaders = [matchContentTypeJson] }
+      get "/rpc/overloaded?a=1&b=2" `shouldRespondWith` [str|3|]
+      get "/rpc/overloaded?a=1&b=2&c=3" `shouldRespondWith` [str|"123"|]
+
+    context "only for POST rpc" $ do
+      it "gives a parse filter error if GET style proc args are specified" $
+        post "/rpc/sayhello?name=John" [json|{}|] `shouldRespondWith` 400
+
+      it "ignores json keys not included in ?columns" $
+        post "/rpc/sayhello?columns=name"
+          [json|{"name": "John", "smth": "here", "other": "stuff", "fake_id": 13}|]
+          `shouldRespondWith`
+          [json|"Hello, John"|]
+          { matchHeaders = [matchContentTypeJson] }
+
+      it "only takes the first object in case of array of objects payload" $
+        post "/rpc/add_them"
+          [json|[
+            {"a": 1, "b": 2},
+            {"a": 4, "b": 6},
+            {"a": 100, "b": 200} ]|]
+          `shouldRespondWith` "3"
+          { matchHeaders = [matchContentTypeJson] }
+
+    context "bulk RPC with params=multiple-objects" $ do
+      it "works with a scalar function an returns a json array" $
+        request methodPost "/rpc/add_them" [("Prefer", "params=multiple-objects")]
+          [json|[
+            {"a": 1, "b": 2},
+            {"a": 4, "b": 6},
+            {"a": 100, "b": 200} ]|]
+          `shouldRespondWith`
+          [json|
+            [3, 10, 300]
+          |] { matchHeaders = [matchContentTypeJson] }
+
+      it "works with a scalar function an returns a json array when posting CSV" $
+        request methodPost "/rpc/add_them" [("Content-Type", "text/csv"), ("Prefer", "params=multiple-objects")]
+          "a,b\n1,2\n4,6\n100,200"
+          `shouldRespondWith`
+          [json|
+            [3, 10, 300]
+          |]
+          { matchStatus  = 200
+          , matchHeaders = [matchContentTypeJson]
+          }
+
+      it "works with a non-scalar result" $
+        request methodPost "/rpc/get_projects_below?select=id,name" [("Prefer", "params=multiple-objects")]
+          [json|[
+            {"id": 1},
+            {"id": 5} ]|]
+          `shouldRespondWith`
+          [json|
+            [{"id":1,"name":"Windows 7"},
+             {"id":2,"name":"Windows 10"},
+             {"id":3,"name":"IOS"},
+             {"id":4,"name":"OSX"}]
+          |] { matchHeaders = [matchContentTypeJson] }
+
+    context "HTTP request env vars" $ do
+      it "custom header is set" $
+        request methodPost "/rpc/get_guc_value"
+                  [("Custom-Header", "test")]
+            [json| { "name": "request.header.custom-header" } |]
+            `shouldRespondWith`
+            [str|"test"|]
+            { matchStatus  = 200
+            , matchHeaders = [ matchContentTypeJson ]
+            }
+      it "standard header is set" $
+        request methodPost "/rpc/get_guc_value"
+                  [("Origin", "http://example.com")]
+            [json| { "name": "request.header.origin" } |]
+            `shouldRespondWith`
+            [str|"http://example.com"|]
+            { matchStatus  = 200
+            , matchHeaders = [ matchContentTypeJson ]
+            }
+      it "current role is available as GUC claim" $
+        request methodPost "/rpc/get_guc_value" []
+            [json| { "name": "request.jwt.claim.role" } |]
+            `shouldRespondWith`
+            [str|"postgrest_test_anonymous"|]
+            { matchStatus  = 200
+            , matchHeaders = [ matchContentTypeJson ]
+            }
+      it "single cookie ends up as claims" $
+        request methodPost "/rpc/get_guc_value" [("Cookie","acookie=cookievalue")]
+          [json| {"name":"request.cookie.acookie"} |]
+            `shouldRespondWith`
+            [str|"cookievalue"|]
+            { matchStatus = 200
+            , matchHeaders = []
+            }
+      it "multiple cookies ends up as claims" $
+        request methodPost "/rpc/get_guc_value" [("Cookie","acookie=cookievalue;secondcookie=anothervalue")]
+          [json| {"name":"request.cookie.secondcookie"} |]
+            `shouldRespondWith`
+            [str|"anothervalue"|]
+            { matchStatus = 200
+            , matchHeaders = []
+            }
+      it "app settings available" $
+        request methodPost "/rpc/get_guc_value" []
+          [json| { "name": "app.settings.app_host" } |]
+            `shouldRespondWith`
+            [str|"localhost"|]
+            { matchStatus  = 200
+            , matchHeaders = [ matchContentTypeJson ]
+            }
+      it "gets the Authorization value" $
+        request methodPost "/rpc/get_guc_value" [authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJyb2xlIjoicG9zdGdyZXN0X3Rlc3RfYXV0aG9yIn0.Xod-F15qsGL0WhdOCr2j3DdKuTw9QJERVgoFD3vGaWA"]
+          [json| {"name":"request.header.authorization"} |]
+            `shouldRespondWith`
+            [str|"Bearer eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJyb2xlIjoicG9zdGdyZXN0X3Rlc3RfYXV0aG9yIn0.Xod-F15qsGL0WhdOCr2j3DdKuTw9QJERVgoFD3vGaWA"|]
+            { matchStatus = 200
+            , matchHeaders = []
+            }
+      it "gets the http method" $
+        request methodPost "/rpc/get_guc_value" []
+          [json| {"name":"request.method"} |]
+            `shouldRespondWith`
+            [str|"POST"|]
+            { matchStatus = 200
+            , matchHeaders = []
+            }
+      it "gets the http path" $
+        request methodPost "/rpc/get_guc_value" []
+          [json| {"name":"request.path"} |]
+            `shouldRespondWith`
+            [str|"/rpc/get_guc_value"|]
+            { matchStatus = 200
+            , matchHeaders = []
+            }
+
+    context "binary output" $ do
+      context "Proc that returns scalar" $ do
+        it "can query without selecting column" $
+          request methodPost "/rpc/ret_base64_bin" (acceptHdrs "application/octet-stream") ""
+            `shouldRespondWith` "iVBORw0KGgoAAAANSUhEUgAAAB4AAAAeAQMAAAAB/jzhAAAABlBMVEUAAAD/AAAb/40iAAAAP0lEQVQI12NgwAbYG2AE/wEYwQMiZB4ACQkQYZEAIgqAhAGIKLCAEQ8kgMT/P1CCEUwc4IMSzA3sUIIdCHECAGSQEkeOTUyCAAAAAElFTkSuQmCC"
+            { matchStatus = 200
+            , matchHeaders = ["Content-Type" <:> "application/octet-stream; charset=utf-8"]
+            }
+
+        it "can get raw output with Accept: text/plain" $
+          request methodGet "/rpc/welcome" (acceptHdrs "text/plain") ""
+            `shouldRespondWith` "Welcome to PostgREST"
+            { matchStatus = 200
+            , matchHeaders = ["Content-Type" <:> "text/plain; charset=utf-8"]
+            }
+
+      context "Proc that returns rows" $ do
+        it "can query if a single column is selected" $
+          request methodPost "/rpc/ret_rows_with_base64_bin?select=img" (acceptHdrs "application/octet-stream") ""
+            `shouldRespondWith` "iVBORw0KGgoAAAANSUhEUgAAAB4AAAAeAQMAAAAB/jzhAAAABlBMVEUAAAD/AAAb/40iAAAAP0lEQVQI12NgwAbYG2AE/wEYwQMiZB4ACQkQYZEAIgqAhAGIKLCAEQ8kgMT/P1CCEUwc4IMSzA3sUIIdCHECAGSQEkeOTUyCAAAAAElFTkSuQmCCiVBORw0KGgoAAAANSUhEUgAAAB4AAAAeAQMAAAAB/jzhAAAABlBMVEX///8AAP94wDzzAAAAL0lEQVQIW2NgwAb+HwARH0DEDyDxwAZEyGAhLODqHmBRzAcn5GAS///A1IF14AAA5/Adbiiz/0gAAAAASUVORK5CYII="
+            { matchStatus = 200
+            , matchHeaders = ["Content-Type" <:> "application/octet-stream; charset=utf-8"]
+            }
+
+        it "fails if a single column is not selected" $
+          request methodPost "/rpc/ret_rows_with_base64_bin" (acceptHdrs "application/octet-stream") ""
+            `shouldRespondWith`
+            [json| {"message":"application/octet-stream requested but more than one column was selected"} |]
+            { matchStatus = 406
+            , matchHeaders = [matchContentTypeJson]
+            }
+
+    context "only for GET rpc" $ do
+      it "should fail on mutating procs" $ do
+        get "/rpc/callcounter" `shouldRespondWith` 500
+        get "/rpc/setprojects?id_l=1&id_h=5&name=FreeBSD" `shouldRespondWith` 500
+
+      it "should filter a proc that has arg name = filter name" $
+        get "/rpc/get_projects_below?id=5&id=gt.2&select=id" `shouldRespondWith`
+          [json|[{ "id": 3 }, { "id": 4 }]|]
+          { matchHeaders = [matchContentTypeJson] }
+
+      it "should work with filters that have the not operator" $ do
+        get "/rpc/get_projects_below?id=5&id=not.gt.2&select=id" `shouldRespondWith`
+          [json|[{ "id": 1 }, { "id": 2 }]|]
+          { matchHeaders = [matchContentTypeJson] }
+        get "/rpc/get_projects_below?id=5&id=not.in.(1,3)&select=id" `shouldRespondWith`
+          [json|[{ "id": 2 }, { "id": 4 }]|]
+          { matchHeaders = [matchContentTypeJson] }
+
+      it "should work with filters that use the plain with language fts operator" $ do
+        get "/rpc/get_tsearch?text_search_vector=fts(english).impossible" `shouldRespondWith`
+          [json|[{"text_search_vector":"'fun':5 'imposs':9 'kind':3"}]|]
+          { matchHeaders = [matchContentTypeJson] }
+        get "/rpc/get_tsearch?text_search_vector=plfts.impossible" `shouldRespondWith`
+          [json|[{"text_search_vector":"'fun':5 'imposs':9 'kind':3"}]|]
+          { matchHeaders = [matchContentTypeJson] }
+        get "/rpc/get_tsearch?text_search_vector=not.fts(english).fun%7Crat" `shouldRespondWith`
+          [json|[{"text_search_vector":"'amus':5 'fair':7 'impossibl':9 'peu':4"},{"text_search_vector":"'art':4 'spass':5 'unmog':7"}]|]
+          { matchHeaders = [matchContentTypeJson] }
+        when (actualPgVersion >= pgVersion112) $
+            get "/rpc/get_tsearch?text_search_vector=wfts.impossible" `shouldRespondWith`
+                [json|[{"text_search_vector":"'fun':5 'imposs':9 'kind':3"}]|]
+                { matchHeaders = [matchContentTypeJson] }
+
+    it "should work with an argument of custom type in public schema" $
+        get "/rpc/test_arg?my_arg=something" `shouldRespondWith`
+          [json|"foobar"|]
+          { matchHeaders = [matchContentTypeJson] }

test/Feature/SingularSpec.hs

@@ -1,19 +1,19 @@
 module Feature.SingularSpec where
 
-import Text.Heredoc
+import Network.Wai      (Application)
+import Network.Wai.Test (SResponse (..))
+
+import Network.HTTP.Types
 import Test.Hspec
 import Test.Hspec.Wai
 import Test.Hspec.Wai.JSON
-import Network.HTTP.Types
+import Text.Heredoc
-import Network.Wai.Test (SResponse(..))
-
-import Network.Wai (Application)
 
+import Protolude  hiding (get)
 import SpecHelper
-import Protolude hiding (get)
 
 
-spec :: SpecWith Application
+spec :: SpecWith ((), Application)
 spec =
   describe "Requesting singular json object" $ do
     let pgrstObj = "application/vnd.pgrst.object+json"
@@ -37,12 +37,12 @@ spec =
           `shouldRespondWith` [str|{"id":5}|]
 
       it "can shape plurality singular object routes" $
-        request methodGet "/projects_view?id=eq.1&select=id,name,clients{*},tasks{id,name}" [singular] ""
+        request methodGet "/projects_view?id=eq.1&select=id,name,clients(*),tasks(id,name)" [singular] ""
           `shouldRespondWith`
-            [str|{"id":1,"name":"Windows 7","clients":{"id":1,"name":"Microsoft"},"tasks":[{"id":1,"name":"Design w7"},{"id":2,"name":"Code w7"}]}|]
+            [json|{"id":1,"name":"Windows 7","clients":{"id":1,"name":"Microsoft"},"tasks":[{"id":1,"name":"Design w7"},{"id":2,"name":"Code w7"}]}|]
+            { matchHeaders = ["Content-Type" <:> "application/vnd.pgrst.object+json; charset=utf-8"] }
 
     context "when updating rows" $ do
-
       it "works for one row" $ do
         _ <- post "/addresses" [json| { id: 97, address: "A Street" } |]
         request methodPatch
@@ -55,10 +55,9 @@ spec =
       it "raises an error for multiple rows" $ do
         _ <- post "/addresses" [json| { id: 98, address: "xxx" } |]
         _ <- post "/addresses" [json| { id: 99, address: "yyy" } |]
-        p <- request methodPatch
+        p <- request methodPatch "/addresses?id=gt.0"
-          "/addresses?id=gt.0"
+                [singular]
-          [("Prefer", "return=representation"), singular]
+                [json| { address: "zzz" } |]
-          [json| { address: "zzz" } |]
         liftIO $ do
           simpleStatus p `shouldBe` notAcceptable406
           isErrorFormat (simpleBody p) `shouldBe` True
@@ -66,33 +65,56 @@ spec =
         -- the rows should not be updated, either
         get "/addresses?id=eq.98" `shouldRespondWith` [str|[{"id":98,"address":"xxx"}]|]
 
-      it "raises an error for zero rows" $ do
+      it "raises an error for multiple rows with return=rep" $ do
-        p <- request methodPatch  "/items?id=gt.0&id=lt.0"
+        _ <- post "/addresses" [json| { id: 100, address: "xxx" } |]
-          [("Prefer", "return=representation"), singular] [json|{"id":1}|]
+        _ <- post "/addresses" [json| { id: 101, address: "yyy" } |]
+        p <- request methodPatch "/addresses?id=gt.0"
+                [("Prefer", "return=representation"), singular]
+                [json| { address: "zzz" } |]
         liftIO $ do
           simpleStatus p `shouldBe` notAcceptable406
           isErrorFormat (simpleBody p) `shouldBe` True
 
-    context "when creating rows" $ do
+        -- the rows should not be updated, either
+        get "/addresses?id=eq.100" `shouldRespondWith` [str|[{"id":100,"address":"xxx"}]|]
 
+      it "raises an error for zero rows" $
+        request methodPatch "/items?id=gt.0&id=lt.0"
+                [singular] [json|{"id":1}|]
+          `shouldRespondWith`
+                  [str|{"details":"Results contain 0 rows, application/vnd.pgrst.object+json requires 1 row","message":"JSON object requested, multiple (or no) rows returned"}|]
+                  { matchStatus  = 406
+                  , matchHeaders = ["Content-Type" <:> "application/vnd.pgrst.object+json; charset=utf-8"]
+                  }
+
+      it "raises an error for zero rows with return=rep" $
+        request methodPatch "/items?id=gt.0&id=lt.0"
+                [("Prefer", "return=representation"), singular] [json|{"id":1}|]
+          `shouldRespondWith`
+                  [str|{"details":"Results contain 0 rows, application/vnd.pgrst.object+json requires 1 row","message":"JSON object requested, multiple (or no) rows returned"}|]
+                  { matchStatus  = 406
+                  , matchHeaders = ["Content-Type" <:> "application/vnd.pgrst.object+json; charset=utf-8"]
+                  }
+
+    context "when creating rows" $ do
       it "works for one row" $ do
         p <- request methodPost
           "/addresses"
           [("Prefer", "return=representation"), singular]
-          [json| [ { id: 100, address: "xxx" } ] |]
+          [json| [ { id: 102, address: "xxx" } ] |]
-        liftIO $ simpleBody p `shouldBe` [str|{"id":100,"address":"xxx"}|]
+        liftIO $ simpleBody p `shouldBe` [str|{"id":102,"address":"xxx"}|]
 
       it "works for one row even with return=minimal" $ do
         request methodPost "/addresses"
           [("Prefer", "return=minimal"), singular]
-          [json| [ { id: 101, address: "xxx" } ] |]
+          [json| [ { id: 103, address: "xxx" } ] |]
           `shouldRespondWith` ""
           { matchStatus  = 201
           , matchHeaders = ["Content-Range" <:> "*/*"]
           }
         -- and the element should exist
-        get "/addresses?id=eq.101"
+        get "/addresses?id=eq.103"
-          `shouldRespondWith` [str|[{"id":101,"address":"xxx"}]|]
+          `shouldRespondWith` [str|[{"id":103,"address":"xxx"}]|]
           { matchStatus  = 200
           , matchHeaders = []
           }
@@ -100,33 +122,57 @@ spec =
       it "raises an error when attempting to create multiple entities" $ do
         p <- request methodPost
           "/addresses"
-          [("Prefer", "return=representation"), singular]
+          [singular]
           [json| [ { id: 200, address: "xxx" }, { id: 201, address: "yyy" } ] |]
         liftIO $ simpleStatus p `shouldBe` notAcceptable406
 
         -- the rows should not exist, either
         get "/addresses?id=eq.200" `shouldRespondWith` "[]"
 
-      it "return=minimal allows request to create multiple elements" $
+      it "raises an error when attempting to create multiple entities with return=rep" $ do
-        request methodPost "/addresses"
-          [("Prefer", "return=minimal"), singular]
-          [json| [ { id: 200, address: "xxx" }, { id: 201, address: "yyy" } ] |]
-          `shouldRespondWith` ""
-          { matchStatus  = 201
-          , matchHeaders = ["Content-Range" <:> "*/*"]
-          }
-
-      it "raises an error when creating zero entities" $ do
         p <- request methodPost
           "/addresses"
           [("Prefer", "return=representation"), singular]
-          [json| [ ] |]
+          [json| [ { id: 202, address: "xxx" }, { id: 203, address: "yyy" } ] |]
-        liftIO $ do
+        liftIO $ simpleStatus p `shouldBe` notAcceptable406
-          simpleStatus p `shouldBe` notAcceptable406
+
-          isErrorFormat (simpleBody p) `shouldBe` True
+        -- the rows should not exist, either
+        get "/addresses?id=eq.202" `shouldRespondWith` "[]"
+
+      it "raises an error regardless of return=minimal" $ do
+        request methodPost "/addresses"
+                [("Prefer", "return=minimal"), singular]
+                [json| [ { id: 204, address: "xxx" }, { id: 205, address: "yyy" } ] |]
+          `shouldRespondWith`
+                  [str|{"details":"Results contain 2 rows, application/vnd.pgrst.object+json requires 1 row","message":"JSON object requested, multiple (or no) rows returned"}|]
+                  { matchStatus  = 406
+                  , matchHeaders = ["Content-Type" <:> "application/vnd.pgrst.object+json; charset=utf-8"]
+                  }
+
+        -- the rows should not exist, either
+        get "/addresses?id=eq.204" `shouldRespondWith` "[]"
+
+      it "raises an error when creating zero entities" $
+        request methodPost "/addresses"
+                [singular]
+                [json| [ ] |]
+          `shouldRespondWith`
+                  [str|{"details":"Results contain 0 rows, application/vnd.pgrst.object+json requires 1 row","message":"JSON object requested, multiple (or no) rows returned"}|]
+                  { matchStatus  = 406
+                  , matchHeaders = ["Content-Type" <:> "application/vnd.pgrst.object+json; charset=utf-8"]
+                  }
+
+      it "raises an error when creating zero entities with return=rep" $
+        request methodPost "/addresses"
+                [("Prefer", "return=representation"), singular]
+                [json| [ ] |]
+          `shouldRespondWith`
+                  [str|{"details":"Results contain 0 rows, application/vnd.pgrst.object+json requires 1 row","message":"JSON object requested, multiple (or no) rows returned"}|]
+                  { matchStatus  = 406
+                  , matchHeaders = ["Content-Type" <:> "application/vnd.pgrst.object+json; charset=utf-8"]
+                  }
 
     context "when deleting rows" $ do
-
       it "works for one row" $ do
         p <- request methodDelete
           "/items?id=eq.11"
@@ -134,32 +180,56 @@ spec =
         liftIO $ simpleBody p `shouldBe` [str|{"id":11}|]
 
       it "raises an error when attempting to delete multiple entities" $ do
-        let firstItems = "/items?id=gt.0&id=lt.11"
+        let firstItems = "/items?id=gt.0&id=lt.6"
+        request methodDelete firstItems
+          [singular] ""
+          `shouldRespondWith` 406
+
+        get firstItems
+          `shouldRespondWith` [json| [{"id":1},{"id":2},{"id":3},{"id":4},{"id":5}] |]
+          { matchStatus  = 200
+          , matchHeaders = ["Content-Range" <:> "0-4/*"]
+          }
+
+      it "raises an error when attempting to delete multiple entities with return=rep" $ do
+        let firstItems = "/items?id=gt.5&id=lt.11"
         request methodDelete firstItems
           [("Prefer", "return=representation"), singular] ""
           `shouldRespondWith` 406
 
         get firstItems
-          `shouldRespondWith` [json| [{"id":1},{"id":2},{"id":3},{"id":4},{"id":5},{"id":6},{"id":7},{"id":8},{"id":9},{"id":10}] |]
+          `shouldRespondWith` [json| [{"id":6},{"id":7},{"id":8},{"id":9},{"id":10}] |]
           { matchStatus  = 200
-          , matchHeaders = ["Content-Range" <:> "0-9/*"]
+          , matchHeaders = ["Content-Range" <:> "0-4/*"]
           }
 
-      it "raises an error when deleting zero entities" $ do
+      it "raises an error when deleting zero entities" $
-        p <- request methodDelete "/items?id=lt.0"
+        request methodDelete "/items?id=lt.0"
-          [("Prefer", "return=representation"), singular] ""
+                [singular] ""
-        liftIO $ do
+          `shouldRespondWith`
-          simpleStatus p `shouldBe` notAcceptable406
+                [str|{"details":"Results contain 0 rows, application/vnd.pgrst.object+json requires 1 row","message":"JSON object requested, multiple (or no) rows returned"}|]
-          isErrorFormat (simpleBody p) `shouldBe` True
+                { matchStatus  = 406
+                , matchHeaders = ["Content-Type" <:> "application/vnd.pgrst.object+json; charset=utf-8"]
+                }
+
+      it "raises an error when deleting zero entities with return=rep" $
+        request methodDelete "/items?id=lt.0"
+                [("Prefer", "return=representation"), singular] ""
+          `shouldRespondWith`
+                [str|{"details":"Results contain 0 rows, application/vnd.pgrst.object+json requires 1 row","message":"JSON object requested, multiple (or no) rows returned"}|]
+                { matchStatus  = 406
+                , matchHeaders = ["Content-Type" <:> "application/vnd.pgrst.object+json; charset=utf-8"]
+                }
 
     context "when calling a stored proc" $ do
-
+      it "fails for zero rows" $
-      it "fails for zero rows" $ do
+        request methodPost "/rpc/getproject"
-        p <- request methodPost "/rpc/getproject"
+                [singular] [json|{ "id": 9999999}|]
-          [singular] [json|{ "id": 9999999}|]
+          `shouldRespondWith`
-        liftIO $ do
+                [str|{"details":"Results contain 0 rows, application/vnd.pgrst.object+json requires 1 row","message":"JSON object requested, multiple (or no) rows returned"}|]
-          simpleStatus p `shouldBe` notAcceptable406
+                { matchStatus  = 406
-          isErrorFormat (simpleBody p) `shouldBe` True
+                , matchHeaders = ["Content-Type" <:> "application/vnd.pgrst.object+json; charset=utf-8"]
+                }
 
       -- this one may be controversial, should vnd.pgrst.object include
       -- the likes of 2 and "hello?"
@@ -173,20 +243,26 @@ spec =
           [singular] [json|{ "id": 1}|] `shouldRespondWith`
           [str|{"id":1,"name":"Windows 7","client_id":1}|]
 
-      it "fails for multiple rows" $ do
+      it "fails for multiple rows" $
-        p <- request methodPost "/rpc/getallprojects" [singular] "{}"
+        request methodPost "/rpc/getallprojects"
-        liftIO $ do
+                [singular] "{}"
-          simpleStatus p `shouldBe` notAcceptable406
+          `shouldRespondWith`
-          isErrorFormat (simpleBody p) `shouldBe` True
+                [str|{"details":"Results contain 5 rows, application/vnd.pgrst.object+json requires 1 row","message":"JSON object requested, multiple (or no) rows returned"}|]
+                { matchStatus  = 406
+                , matchHeaders = ["Content-Type" <:> "application/vnd.pgrst.object+json; charset=utf-8"]
+                }
 
       it "executes the proc exactly once per request" $ do
         request methodPost "/rpc/getproject?select=id,name" [] [json| {"id": 1} |]
           `shouldRespondWith` [str|[{"id":1,"name":"Windows 7"}]|]
-        p <- request methodPost "/rpc/setprojects" [singular]
+
-          [json| {"id_l": 1, "id_h": 2, "name": "changed"} |]
+        request methodPost "/rpc/setprojects" [singular]
-        liftIO $ do
+                [json| {"id_l": 1, "id_h": 2, "name": "changed"} |]
-          simpleStatus p `shouldBe` notAcceptable406
+          `shouldRespondWith`
-          isErrorFormat (simpleBody p) `shouldBe` True
+                [str|{"details":"Results contain 2 rows, application/vnd.pgrst.object+json requires 1 row","message":"JSON object requested, multiple (or no) rows returned"}|]
+                { matchStatus  = 406
+                , matchHeaders = ["Content-Type" <:> "application/vnd.pgrst.object+json; charset=utf-8"]
+                }
 
         -- should not actually have executed the function
         request methodPost "/rpc/getproject?select=id,name" [] [json| {"id": 1} |]

test/Feature/StructureSpec.hs

@@ -1,33 +1,44 @@
 module Feature.StructureSpec where
 
-import Test.Hspec hiding (pendingWith)
+import Control.Lens     ((^?))
-import Test.Hspec.Wai
+import Data.Aeson.Types (Value (..))
-import Network.HTTP.Types
+import Network.Wai      (Application)
+import Network.Wai.Test (SResponse (..))
 
-import Control.Lens ((^?))
 import Data.Aeson.Lens
 import Data.Aeson.QQ
+import Network.HTTP.Types
+import Test.Hspec         hiding (pendingWith)
+import Test.Hspec.Wai
 
+
+
+import PostgREST.Config (docsVersion)
+import Protolude        hiding (get)
 import SpecHelper
 
-import Network.Wai (Application)
+spec :: SpecWith ((), Application)
-import Network.Wai.Test (SResponse(..))
-
-import Protolude hiding (get)
-
-spec :: SpecWith Application
 spec = do
 
   describe "OpenAPI" $ do
-    it "root path returns a valid openapi spec" $
+    it "root path returns a valid openapi spec" $ do
       validateOpenApiResponse [("Accept", "application/openapi+json")]
+      request methodHead "/" (acceptHdrs "application/openapi+json") ""
+        `shouldRespondWith` "" { matchStatus  = 200 }
 
     it "should respond to openapi request on none root path with 415" $
       request methodGet "/items"
               (acceptHdrs "application/openapi+json") ""
         `shouldRespondWith` 415
 
-    describe "table" $
+    it "includes postgrest.org current version api docs" $ do
+      r <- simpleBody <$> get "/"
+
+      let docsUrl = r ^? key "externalDocs" . key "url"
+
+      liftIO $ docsUrl `shouldBe` Just (String ("https://postgrest.org/en/" <> docsVersion <> "/api.html"))
+
+    describe "table" $ do
 
       it "includes paths to tables" $ do
         r <- simpleBody <$> get "/"
@@ -36,6 +47,7 @@ spec = do
             childGetSummary = r ^? method "get" . key "summary"
             childGetDescription = r ^? method "get" . key "description"
             getParameters = r ^? method "get" . key "parameters"
+            postParameters = r ^? method "post" . key "parameters"
             postResponse = r ^? method "post" . key "responses" . key "201" . key "description"
             patchResponse = r ^? method "patch" . key "responses" . key "204" . key "description"
             deleteResponse = r ^? method "delete" . key "responses" . key "204" . key "description"
@@ -70,13 +82,43 @@ spec = do
               ]
             |]
 
+          postParameters `shouldBe` Just
+            [aesonQQ|
+              [
+                { "$ref": "#/parameters/body.child_entities" },
+                { "$ref": "#/parameters/select" },
+                { "$ref": "#/parameters/preferReturn" }
+              ]
+            |]
+
           postResponse `shouldBe` Just "Created"
 
           patchResponse `shouldBe` Just "No Content"
 
           deleteResponse `shouldBe` Just "No Content"
 
-    it "includes definitions to tables" $ do
+      it "includes an array type for GET responses" $ do
+        r <- simpleBody <$> get "/"
+
+        let childGetSchema = r ^? key "paths"
+              . key "/child_entities"
+              . key "get"
+              . key "responses"
+              . key "200"
+              . key "schema"
+
+        liftIO $
+          childGetSchema `shouldBe` Just
+            [aesonQQ|
+              {
+                "items": {
+                  "$ref": "#/definitions/child_entities"
+                },
+                "type": "array"
+              }
+            |]
+
+      it "includes definitions to tables" $ do
         r <- simpleBody <$> get "/"
 
         let def = r ^? key "definitions" . key "child_entities"
@@ -95,7 +137,7 @@ spec = do
                     "type": "integer"
                   },
                   "name": {
-                    "description": "child_entities name comment",
+                    "description": "child_entities name comment. Can be longer than sixty-three characters long",
                     "format": "text",
                     "type": "string"
                   },
@@ -104,19 +146,276 @@ spec = do
                     "format": "integer",
                     "type": "integer"
                   }
-                }
+                },
+                "required": [
+                  "id"
+                ]
               }
             |]
 
-    describe "RPC" $
+      it "doesn't include privileged table for anonymous" $ do
-
-      it "includes body schema for arguments" $ do
         r <- simpleBody <$> get "/"
-        let args = r ^? key "paths" . key "/rpc/varied_arguments"
+        let tablePath = r ^? key "paths" . key "/authors_only"
-                      . key "post"  . key "parameters"
+
-                      . nth 0       . key "schema"
+        liftIO $ tablePath `shouldBe` Nothing
+
+      it "includes table if user has permission" $ do
+        let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJyb2xlIjoicG9zdGdyZXN0X3Rlc3RfYXV0aG9yIn0.Xod-F15qsGL0WhdOCr2j3DdKuTw9QJERVgoFD3vGaWA"
+        r <- simpleBody <$> request methodGet "/" [auth] ""
+        let tableTag = r ^? key "paths" . key "/authors_only"
+                      . key "post"  . key "tags"
+                      . nth 0
+        liftIO $ tableTag `shouldBe` Just [aesonQQ|"authors_only"|]
+
+    describe "Foreign table" $
+
+      it "includes foreign table properties" $ do
+        r <- simpleBody <$> get "/"
+
+        let method s = key "paths" . key "/projects_dump" . key s
+            getSummary = r ^? method "get" . key "summary"
+            getDescription = r ^? method "get" . key "description"
+            getParameters = r ^? method "get" . key "parameters"
+
+        liftIO $ do
+
+          getSummary `shouldBe` Just "A temporary projects dump"
+
+          getDescription `shouldBe` Just "Just a test for foreign tables"
+
+          getParameters `shouldBe` Just
+            [aesonQQ|
+              [
+                { "$ref": "#/parameters/rowFilter.projects_dump.id" },
+                { "$ref": "#/parameters/rowFilter.projects_dump.name" },
+                { "$ref": "#/parameters/rowFilter.projects_dump.client_id" },
+                { "$ref": "#/parameters/select" },
+                { "$ref": "#/parameters/order" },
+                { "$ref": "#/parameters/range" },
+                { "$ref": "#/parameters/rangeUnit" },
+                { "$ref": "#/parameters/offset" },
+                { "$ref": "#/parameters/limit" },
+                { "$ref": "#/parameters/preferCount" }
+              ]
+            |]
+
+    describe "Materialized view" $
+
+      it "includes materialized view properties" $ do
+        r <- simpleBody <$> get "/"
+
+        let method s = key "paths" . key "/materialized_projects" . key s
+            summary = r ^? method "get" . key "summary"
+            description = r ^? method "get" . key "description"
+            parameters = r ^? method "get" . key "parameters"
+
+        liftIO $ do
+
+          summary `shouldBe` Just "A materialized view for projects"
+
+          description `shouldBe` Just "Just a test for materialized views"
+
+          parameters `shouldBe` Just
+            [aesonQQ|
+              [
+                { "$ref": "#/parameters/rowFilter.materialized_projects.id" },
+                { "$ref": "#/parameters/rowFilter.materialized_projects.name" },
+                { "$ref": "#/parameters/rowFilter.materialized_projects.client_id" },
+                { "$ref": "#/parameters/select" },
+                { "$ref": "#/parameters/order" },
+                { "$ref": "#/parameters/range" },
+                { "$ref": "#/parameters/rangeUnit" },
+                { "$ref": "#/parameters/offset" },
+                { "$ref": "#/parameters/limit" },
+                { "$ref": "#/parameters/preferCount" }
+              ]
+            |]
+
+    describe "VIEW that has a source FK based on a UNIQUE key" $
+
+      it "includes fk description" $ do
+        r <- simpleBody <$> get "/"
+
+        let referralLink = r ^? key "definitions" . key "referrals" . key "properties" . key "link"
 
         liftIO $
+          referralLink `shouldBe` Just
+            [aesonQQ|
+              {
+                "format": "integer",
+                "type": "integer",
+                "description": "Note:\nThis is a Foreign Key to `pages.link`.<fk table='pages' column='link'/>"
+              }
+            |]
+
+    describe "PostgreSQL to Swagger Type Mapping" $ do
+
+      it "character varying to string" $ do
+        r <- simpleBody <$> get "/"
+
+        let types = r ^? key "definitions" . key "openapi_types" . key "properties" . key "a_character_varying"
+
+        liftIO $
+
+          types `shouldBe` Just
+            [aesonQQ|
+              {
+                "format": "character varying",
+                "type": "string"
+              }
+            |]
+      it "character(1) to string" $ do
+        r <- simpleBody <$> get "/"
+
+        let types = r ^? key "definitions" . key "openapi_types" . key "properties" . key "a_character"
+
+        liftIO $
+
+          types `shouldBe` Just
+            [aesonQQ|
+              {
+                "maxLength": 1,
+                "format": "character",
+                "type": "string"
+              }
+            |]
+
+      it "text to string" $ do
+        r <- simpleBody <$> get "/"
+
+        let types = r ^? key "definitions" . key "openapi_types" . key "properties" . key "a_text"
+
+        liftIO $
+
+          types `shouldBe` Just
+            [aesonQQ|
+              {
+                "format": "text",
+                "type": "string"
+              }
+            |]
+
+      it "boolean to boolean" $ do
+        r <- simpleBody <$> get "/"
+
+        let types = r ^? key "definitions" . key "openapi_types" . key "properties" . key "a_boolean"
+
+        liftIO $
+
+          types `shouldBe` Just
+            [aesonQQ|
+              {
+                "format": "boolean",
+                "type": "boolean"
+              }
+            |]
+
+      it "smallint to integer" $ do
+        r <- simpleBody <$> get "/"
+
+        let types = r ^? key "definitions" . key "openapi_types" . key "properties" . key "a_smallint"
+
+        liftIO $
+
+          types `shouldBe` Just
+            [aesonQQ|
+              {
+                "format": "smallint",
+                "type": "integer"
+              }
+            |]
+
+      it "integer to integer" $ do
+        r <- simpleBody <$> get "/"
+
+        let types = r ^? key "definitions" . key "openapi_types" . key "properties" . key "a_integer"
+
+        liftIO $
+
+          types `shouldBe` Just
+            [aesonQQ|
+              {
+                "format": "integer",
+                "type": "integer"
+              }
+            |]
+
+      it "bigint to integer" $ do
+        r <- simpleBody <$> get "/"
+
+        let types = r ^? key "definitions" . key "openapi_types" . key "properties" . key "a_bigint"
+
+        liftIO $
+
+          types `shouldBe` Just
+            [aesonQQ|
+              {
+                "format": "bigint",
+                "type": "integer"
+              }
+            |]
+
+      it "numeric to number" $ do
+        r <- simpleBody <$> get "/"
+
+        let types = r ^? key "definitions" . key "openapi_types" . key "properties" . key "a_numeric"
+
+        liftIO $
+
+          types `shouldBe` Just
+            [aesonQQ|
+              {
+                "format": "numeric",
+                "type": "number"
+              }
+            |]
+
+      it "real to number" $ do
+        r <- simpleBody <$> get "/"
+
+        let types = r ^? key "definitions" . key "openapi_types" . key "properties" . key "a_real"
+
+        liftIO $
+
+          types `shouldBe` Just
+            [aesonQQ|
+              {
+                "format": "real",
+                "type": "number"
+              }
+            |]
+
+      it "double_precision to number" $ do
+        r <- simpleBody <$> get "/"
+
+        let types = r ^? key "definitions" . key "openapi_types" . key "properties" . key "a_double_precision"
+
+        liftIO $
+
+          types `shouldBe` Just
+            [aesonQQ|
+              {
+                "format": "double precision",
+                "type": "number"
+              }
+            |]
+
+    describe "RPC" $ do
+
+      it "includes function summary/description and body schema for arguments" $ do
+        r <- simpleBody <$> get "/"
+
+        let method s = key "paths" . key "/rpc/varied_arguments" . key s
+            args = r ^? method "post" . key "parameters" . nth 0 . key "schema"
+            summary = r ^? method "post" . key "summary"
+            description = r ^? method "post" . key "description"
+
+        liftIO $ do
+
+          summary `shouldBe` Just "An RPC function"
+
+          description `shouldBe` Just "Just a test for RPC function arguments"
+
           args `shouldBe` Just
             [aesonQQ|
               {
@@ -131,7 +430,7 @@ spec = do
                 "properties": {
                   "double": {
                     "format": "double precision",
-                    "type": "string"
+                    "type": "number"
                   },
                   "varchar": {
                     "format": "character varying",
@@ -150,18 +449,58 @@ spec = do
                     "type": "string"
                   },
                   "enum": {
-                    "format": "test.enum_menagerie_type",
+                    "format": "enum_menagerie_type",
                     "type": "string"
                   },
                   "integer": {
                     "format": "integer",
                     "type": "integer"
+                  },
+                  "json": {
+                    "format": "json",
+                    "type": "string"
+                  },
+                  "jsonb": {
+                    "format": "jsonb",
+                    "type": "string"
                   }
                 },
-                "type": "object"
+                "type": "object",
+                "description": "An RPC function\n\nJust a test for RPC function arguments"
               }
             |]
 
+      it "doesn't include privileged function for anonymous" $ do
+        r <- simpleBody <$> get "/"
+        let funcPath = r ^? key "paths" . key "/rpc/privileged_hello"
+
+        liftIO $ funcPath `shouldBe` Nothing
+
+      it "includes function if user has permission" $ do
+        let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJyb2xlIjoicG9zdGdyZXN0X3Rlc3RfYXV0aG9yIn0.Xod-F15qsGL0WhdOCr2j3DdKuTw9QJERVgoFD3vGaWA"
+        r <- simpleBody <$> request methodGet "/" [auth] ""
+        let funcTag = r ^? key "paths" . key "/rpc/privileged_hello"
+                      . key "post"  . key "tags"
+                      . nth 0
+
+        liftIO $ funcTag `shouldBe` Just [aesonQQ|"(rpc) privileged_hello"|]
+
+      it "doesn't include OUT params of function as required parameters" $ do
+        r <- simpleBody <$> get "/"
+        let params = r ^? key "paths" . key "/rpc/many_out_params"
+                        . key "post" . key "parameters" .  nth 0
+                        . key "schema". key "required"
+
+        liftIO $ params `shouldBe` Nothing
+
+      it "includes INOUT params(with no DEFAULT) of function as required parameters" $ do
+        r <- simpleBody <$> get "/"
+        let params = r ^? key "paths" . key "/rpc/many_inout_params"
+                        . key "post" . key "parameters" .  nth 0
+                        . key "schema". key "required"
+
+        liftIO $ params `shouldBe` Just [aesonQQ|["num", "str"]|]
+
   describe "Allow header" $ do
 
     it "includes read/write verbs for writeable table" $ do

test/Feature/UnicodeSpec.hs

@@ -1,16 +1,16 @@
 module Feature.UnicodeSpec where
 
+import Control.Monad (void)
+import Network.Wai   (Application)
+
 import Test.Hspec
 import Test.Hspec.Wai
 import Test.Hspec.Wai.JSON
-import Network.Wai (Application)
-import Control.Monad (void)
 
+import Protolude  hiding (get)
 import SpecHelper
 
-import Protolude hiding (get)
+spec :: SpecWith ((), Application)
-
-spec :: SpecWith Application
 spec =
   describe "Reading and writing to unicode schema and table names" $
     it "Can read and write values" $ do

test/Feature/UpsertSpec.hs

@@ -0,0 +1,332 @@
+module Feature.UpsertSpec where
+
+import Network.Wai (Application)
+
+import Network.HTTP.Types
+import Test.Hspec
+import Test.Hspec.Wai
+import Test.Hspec.Wai.JSON
+import Text.Heredoc
+
+import Protolude  hiding (get, put)
+import SpecHelper
+
+spec :: SpecWith ((), Application)
+spec =
+  describe "UPSERT" $ do
+    context "with POST" $ do
+      context "when Prefer: resolution=merge-duplicates is specified" $ do
+        it "INSERTs and UPDATEs rows on pk conflict" $
+          request methodPost "/tiobe_pls" [("Prefer", "return=representation"), ("Prefer", "resolution=merge-duplicates")]
+            [json| [
+              { "name": "Javascript", "rank": 6 },
+              { "name": "Java", "rank": 2 },
+              { "name": "C", "rank": 1 }
+            ]|] `shouldRespondWith` [json| [
+              { "name": "Javascript", "rank": 6 },
+              { "name": "Java", "rank": 2 },
+              { "name": "C", "rank": 1 }
+            ]|]
+            { matchStatus = 201
+            , matchHeaders = ["Preference-Applied" <:> "resolution=merge-duplicates", matchContentTypeJson]
+            }
+
+        it "INSERTs and UPDATEs row on composite pk conflict" $
+          request methodPost "/employees" [("Prefer", "return=representation"), ("Prefer", "resolution=merge-duplicates")]
+            [json| [
+              { "first_name": "Frances M.", "last_name": "Roe", "salary": "30000" },
+              { "first_name": "Peter S.", "last_name": "Yang", "salary": 42000 }
+            ]|] `shouldRespondWith` [json| [
+              { "first_name": "Frances M.", "last_name": "Roe", "salary": "$30,000.00", "company": "One-Up Realty", "occupation": "Author" },
+              { "first_name": "Peter S.", "last_name": "Yang", "salary": "$42,000.00", "company": null, "occupation": null }
+            ]|]
+            { matchStatus = 201
+            , matchHeaders = ["Preference-Applied" <:> "resolution=merge-duplicates", matchContentTypeJson]
+            }
+
+        it "succeeds when the payload has no elements" $
+          request methodPost "/articles" [("Prefer", "return=representation"), ("Prefer", "resolution=merge-duplicates")]
+            [json|[]|] `shouldRespondWith`
+            [json|[]|] { matchStatus = 201 , matchHeaders = [matchContentTypeJson] }
+
+        it "INSERTs and UPDATEs rows on single unique key conflict" $
+          request methodPost "/single_unique?on_conflict=unique_key" [("Prefer", "return=representation"), ("Prefer", "resolution=merge-duplicates")]
+            [json| [
+              { "unique_key": 1, "value": "B" },
+              { "unique_key": 2, "value": "C" }
+            ]|] `shouldRespondWith` [json| [
+              { "unique_key": 1, "value": "B" },
+              { "unique_key": 2, "value": "C" }
+            ]|]
+            { matchStatus = 201
+            , matchHeaders = ["Preference-Applied" <:> "resolution=merge-duplicates", matchContentTypeJson]
+            }
+
+        it "INSERTs and UPDATEs rows on compound unique keys conflict" $
+          request methodPost "/compound_unique?on_conflict=key1,key2" [("Prefer", "return=representation"), ("Prefer", "resolution=merge-duplicates")]
+            [json| [
+              { "key1": 1, "key2": 1, "value": "B" },
+              { "key1": 1, "key2": 2, "value": "C" }
+            ]|] `shouldRespondWith` [json| [
+              { "key1": 1, "key2": 1, "value": "B" },
+              { "key1": 1, "key2": 2, "value": "C" }
+            ]|]
+            { matchStatus = 201
+            , matchHeaders = ["Preference-Applied" <:> "resolution=merge-duplicates", matchContentTypeJson]
+            }
+
+      context "when Prefer: resolution=ignore-duplicates is specified" $ do
+        it "INSERTs and ignores rows on pk conflict" $
+          request methodPost "/tiobe_pls" [("Prefer", "return=representation"), ("Prefer", "resolution=ignore-duplicates")]
+            [json|[
+              { "name": "PHP", "rank": 9 },
+              { "name": "Python", "rank": 10 }
+            ]|] `shouldRespondWith` [json|[
+              { "name": "PHP", "rank": 9 }
+            ]|]
+            { matchStatus = 201
+            , matchHeaders = ["Preference-Applied" <:> "resolution=ignore-duplicates", matchContentTypeJson]
+            }
+
+        it "INSERTs and ignores rows on composite pk conflict" $
+          request methodPost "/employees" [("Prefer", "return=representation"), ("Prefer", "resolution=ignore-duplicates")]
+            [json|[
+              { "first_name": "Daniel B.", "last_name": "Lyon", "salary": "72000", "company": null, "occupation": null },
+              { "first_name": "Sara M.", "last_name": "Torpey", "salary": 60000, "company": "Burstein-Applebee", "occupation": "Soil scientist" }
+            ]|] `shouldRespondWith` [json|[
+              { "first_name": "Sara M.", "last_name": "Torpey", "salary": "$60,000.00", "company": "Burstein-Applebee", "occupation": "Soil scientist" }
+            ]|]
+            { matchStatus = 201
+            , matchHeaders = ["Preference-Applied" <:> "resolution=ignore-duplicates", matchContentTypeJson]
+            }
+
+        it "INSERTs and ignores rows on single unique key conflict" $
+          request methodPost "/single_unique?on_conflict=unique_key" [("Prefer", "return=representation"), ("Prefer", "resolution=ignore-duplicates")]
+            [json| [
+              { "unique_key": 1, "value": "B" },
+              { "unique_key": 2, "value": "C" },
+              { "unique_key": 3, "value": "D" }
+            ]|] `shouldRespondWith` [json| [
+              { "unique_key": 3, "value": "D" }
+            ]|]
+            { matchStatus = 201
+            , matchHeaders = ["Preference-Applied" <:> "resolution=ignore-duplicates", matchContentTypeJson]
+            }
+
+        it "INSERTs and UPDATEs rows on compound unique keys conflict" $
+          request methodPost "/compound_unique?on_conflict=key1,key2" [("Prefer", "return=representation"), ("Prefer", "resolution=ignore-duplicates")]
+            [json| [
+              { "key1": 1, "key2": 1, "value": "B" },
+              { "key1": 1, "key2": 2, "value": "C" },
+              { "key1": 1, "key2": 3, "value": "D" }
+            ]|] `shouldRespondWith` [json| [
+              { "key1": 1, "key2": 3, "value": "D" }
+            ]|]
+            { matchStatus = 201
+            , matchHeaders = ["Preference-Applied" <:> "resolution=ignore-duplicates", matchContentTypeJson]
+            }
+
+      it "succeeds if the table has only PK cols and no other cols" $ do
+        request methodPost "/only_pk" [("Prefer", "return=representation"), ("Prefer", "resolution=ignore-duplicates")]
+          [json|[ { "id": 1 }, { "id": 2 }, { "id": 3} ]|]
+          `shouldRespondWith`
+          [json|[ { "id": 3} ]|]
+          { matchStatus = 201 ,
+            matchHeaders = ["Preference-Applied" <:> "resolution=ignore-duplicates",
+            matchContentTypeJson] }
+
+        request methodPost "/only_pk" [("Prefer", "return=representation"), ("Prefer", "resolution=merge-duplicates")]
+          [json|[ { "id": 1 }, { "id": 2 }, { "id": 4} ]|]
+          `shouldRespondWith`
+          [json|[ { "id": 1 }, { "id": 2 }, { "id": 4} ]|]
+          { matchStatus = 201 ,
+            matchHeaders = ["Preference-Applied" <:> "resolution=merge-duplicates",
+            matchContentTypeJson] }
+
+      it "succeeds and ignores the Prefer: resolution header(no Preference-Applied present) if the table has no PK" $
+        request methodPost "/no_pk" [("Prefer", "return=representation"), ("Prefer", "resolution=merge-duplicates")]
+          [json|[ { "a": "1", "b": "0" } ]|]
+          `shouldRespondWith`
+          [json|[ { "a": "1", "b": "0" } ]|] { matchStatus = 201 , matchHeaders = [matchContentTypeJson] }
+
+      it "succeeds if not a single resource is created" $ do
+        request methodPost "/tiobe_pls" [("Prefer", "return=representation"), ("Prefer", "resolution=ignore-duplicates")]
+          [json|[ { "name": "Java", "rank": 1 } ]|] `shouldRespondWith`
+          [json|[]|] { matchStatus = 201 , matchHeaders = [matchContentTypeJson] }
+        request methodPost "/tiobe_pls" [("Prefer", "return=representation"), ("Prefer", "resolution=ignore-duplicates")]
+          [json|[ { "name": "Java", "rank": 1 }, { "name": "C", "rank": 2 } ]|] `shouldRespondWith`
+          [json|[]|] { matchStatus = 201 , matchHeaders = [matchContentTypeJson] }
+
+    context "with PUT" $ do
+      context "Restrictions" $ do
+        it "fails if Range is specified" $
+          request methodPut "/tiobe_pls?name=eq.Javascript" [("Range", "0-5")]
+            [str| [ { "name": "Javascript", "rank": 1 } ]|]
+            `shouldRespondWith`
+            [json|{"message":"Range header and limit/offset querystring parameters are not allowed for PUT"}|]
+            { matchStatus = 400 , matchHeaders = [matchContentTypeJson] }
+
+        it "fails if limit is specified" $
+          put "/tiobe_pls?name=eq.Javascript&limit=1"
+            [str| [ { "name": "Javascript", "rank": 1 } ]|]
+            `shouldRespondWith`
+            [json|{"message":"Range header and limit/offset querystring parameters are not allowed for PUT"}|]
+            { matchStatus = 400 , matchHeaders = [matchContentTypeJson] }
+
+        it "fails if offset is specified" $
+          put "/tiobe_pls?name=eq.Javascript&offset=1"
+            [str| [ { "name": "Javascript", "rank": 1 } ]|]
+            `shouldRespondWith`
+            [json|{"message":"Range header and limit/offset querystring parameters are not allowed for PUT"}|]
+            { matchStatus = 400 , matchHeaders = [matchContentTypeJson] }
+
+        it "fails if the payload has more than one row" $
+          put "/tiobe_pls?name=eq.Go"
+            [str| [ { "name": "Go", "rank": 19 }, { "name": "Swift", "rank": 12 } ]|]
+            `shouldRespondWith`
+            [json|{"message":"PUT payload must contain a single row"}|]
+            { matchStatus = 400 , matchHeaders = [matchContentTypeJson] }
+
+        it "fails if not all columns are specified" $ do
+          put "/tiobe_pls?name=eq.Go"
+            [str| [ { "name": "Go" } ]|]
+            `shouldRespondWith`
+            [json|{"message":"You must specify all columns in the payload when using PUT"}|]
+            { matchStatus = 400 , matchHeaders = [matchContentTypeJson] }
+
+          put "/employees?first_name=eq.Susan&last_name=eq.Heidt"
+            [str| [ { "first_name": "Susan", "last_name": "Heidt", "salary": "48000" } ]|]
+            `shouldRespondWith`
+            [json|{"message":"You must specify all columns in the payload when using PUT"}|]
+            { matchStatus = 400 , matchHeaders = [matchContentTypeJson] }
+
+        it "rejects every other filter than pk cols eq's" $ do
+          put "/tiobe_pls?rank=eq.19"
+            [str| [ { "name": "Go", "rank": 19 } ]|]
+            `shouldRespondWith`
+            [json|{"message":"Filters must include all and only primary key columns with 'eq' operators"}|]
+            { matchStatus = 405 , matchHeaders = [matchContentTypeJson] }
+
+          put "/tiobe_pls?id=not.eq.Java"
+            [str| [ { "name": "Go", "rank": 19 } ]|]
+            `shouldRespondWith`
+            [json|{"message":"Filters must include all and only primary key columns with 'eq' operators"}|]
+            { matchStatus = 405 , matchHeaders = [matchContentTypeJson] }
+          put "/tiobe_pls?id=in.(Go)"
+            [str| [ { "name": "Go", "rank": 19 } ]|]
+            `shouldRespondWith`
+            [json|{"message":"Filters must include all and only primary key columns with 'eq' operators"}|]
+            { matchStatus = 405 , matchHeaders = [matchContentTypeJson] }
+          put "/tiobe_pls?and=(id.eq.Go)"
+            [str| [ { "name": "Go", "rank": 19 } ]|]
+            `shouldRespondWith`
+            [json|{"message":"Filters must include all and only primary key columns with 'eq' operators"}|]
+            { matchStatus = 405 , matchHeaders = [matchContentTypeJson] }
+
+        it "fails if not all composite key cols are specified as eq filters" $ do
+          put "/employees?first_name=eq.Susan"
+            [str| [ { "first_name": "Susan", "last_name": "Heidt", "salary": "48000", "company": "GEX", "occupation": "Railroad engineer" } ]|]
+            `shouldRespondWith`
+            [json|{"message":"Filters must include all and only primary key columns with 'eq' operators"}|]
+            { matchStatus = 405 , matchHeaders = [matchContentTypeJson] }
+          put "/employees?last_name=eq.Heidt"
+            [str| [ { "first_name": "Susan", "last_name": "Heidt", "salary": "48000", "company": "GEX", "occupation": "Railroad engineer" } ]|]
+            `shouldRespondWith`
+            [json|{"message":"Filters must include all and only primary key columns with 'eq' operators"}|]
+            { matchStatus = 405 , matchHeaders = [matchContentTypeJson] }
+
+      it "fails if the uri primary key doesn't match the payload primary key" $ do
+        put "/tiobe_pls?name=eq.MATLAB" [str| [ { "name": "Perl", "rank": 17 } ]|]
+          `shouldRespondWith`
+          [json|{"message":"Payload values do not match URL in primary key column(s)"}|]
+          { matchStatus = 400 , matchHeaders = [matchContentTypeJson] }
+        put "/employees?first_name=eq.Wendy&last_name=eq.Anderson"
+          [str| [ { "first_name": "Susan", "last_name": "Heidt", "salary": "48000", "company": "GEX", "occupation": "Railroad engineer" } ]|]
+          `shouldRespondWith`
+          [json|{"message":"Payload values do not match URL in primary key column(s)"}|]
+          { matchStatus = 400 , matchHeaders = [matchContentTypeJson] }
+
+      it "fails if the table has no PK" $
+        put "/no_pk?a=eq.one&b=eq.two" [str| [ { "a": "one", "b": "two" } ]|]
+          `shouldRespondWith`
+          [json|{"message":"Filters must include all and only primary key columns with 'eq' operators"}|]
+          { matchStatus = 405 , matchHeaders = [matchContentTypeJson] }
+
+      context "Inserting row" $ do
+        it "succeeds on table with single pk col" $ do
+          get "/tiobe_pls?name=eq.Go" `shouldRespondWith` "[]"
+          put "/tiobe_pls?name=eq.Go" [str| [ { "name": "Go", "rank": 19 } ]|] `shouldRespondWith` 204
+          get "/tiobe_pls?name=eq.Go" `shouldRespondWith` [json| [ { "name": "Go", "rank": 19 } ]|] { matchHeaders = [matchContentTypeJson] }
+
+        it "succeeds on table with composite pk" $ do
+          get "/employees?first_name=eq.Susan&last_name=eq.Heidt"
+            `shouldRespondWith` "[]"
+          put "/employees?first_name=eq.Susan&last_name=eq.Heidt"
+            [str| [ { "first_name": "Susan", "last_name": "Heidt", "salary": "48000", "company": "GEX", "occupation": "Railroad engineer" } ]|]
+            `shouldRespondWith` 204
+          get "/employees?first_name=eq.Susan&last_name=eq.Heidt"
+            `shouldRespondWith`
+            [json| [ { "first_name": "Susan", "last_name": "Heidt", "salary": "$48,000.00", "company": "GEX", "occupation": "Railroad engineer" } ]|]
+            { matchHeaders = [matchContentTypeJson] }
+
+        it "succeeds if the table has only PK cols and no other cols" $ do
+          get "/only_pk?id=eq.10" `shouldRespondWith` "[]"
+          put "/only_pk?id=eq.10" [str|[ { "id": 10 } ]|] `shouldRespondWith` 204
+          get "/only_pk?id=eq.10" `shouldRespondWith` [json|[ { "id": 10 } ]|] { matchHeaders = [matchContentTypeJson] }
+
+      context "Updating row" $ do
+        it "succeeds on table with single pk col" $ do
+          get "/tiobe_pls?name=eq.Go" `shouldRespondWith` [json|[ { "name": "Go", "rank": 19 } ]|] { matchHeaders = [matchContentTypeJson] }
+          put "/tiobe_pls?name=eq.Go" [str| [ { "name": "Go", "rank": 13 } ]|] `shouldRespondWith` 204
+          get "/tiobe_pls?name=eq.Go" `shouldRespondWith` [json| [ { "name": "Go", "rank": 13 } ]|] { matchHeaders = [matchContentTypeJson] }
+
+        it "succeeds on table with composite pk" $ do
+          get "/employees?first_name=eq.Susan&last_name=eq.Heidt"
+            `shouldRespondWith`
+            [json| [ { "first_name": "Susan", "last_name": "Heidt", "salary": "$48,000.00", "company": "GEX", "occupation": "Railroad engineer" } ]|]
+            { matchHeaders = [matchContentTypeJson] }
+          put "/employees?first_name=eq.Susan&last_name=eq.Heidt"
+            [str| [ { "first_name": "Susan", "last_name": "Heidt", "salary": "60000", "company": "Gamma Gas", "occupation": "Railroad engineer" } ]|]
+            `shouldRespondWith` 204
+          get "/employees?first_name=eq.Susan&last_name=eq.Heidt"
+            `shouldRespondWith`
+            [json| [ { "first_name": "Susan", "last_name": "Heidt", "salary": "$60,000.00", "company": "Gamma Gas", "occupation": "Railroad engineer" } ]|]
+            { matchHeaders = [matchContentTypeJson] }
+
+        it "succeeds if the table has only PK cols and no other cols" $ do
+          get "/only_pk?id=eq.10" `shouldRespondWith` [json|[ { "id": 10 } ]|] { matchHeaders = [matchContentTypeJson] }
+          put "/only_pk?id=eq.10" [str|[ { "id": 10 } ]|] `shouldRespondWith` 204
+          get "/only_pk?id=eq.10" `shouldRespondWith` [json|[ { "id": 10 } ]|] { matchHeaders = [matchContentTypeJson] }
+
+      it "works with return=representation and vnd.pgrst.object+json" $
+        request methodPut "/tiobe_pls?name=eq.Ruby"
+          [("Prefer", "return=representation"), ("Accept", "application/vnd.pgrst.object+json")]
+          [str| [ { "name": "Ruby", "rank": 11 } ]|]
+          `shouldRespondWith` [json|{ "name": "Ruby", "rank": 11 }|] { matchHeaders = [matchContentTypeSingular] }
+
+    context "with a camel case pk column" $ do
+      it "works with POST and merge-duplicates/ignore-duplicates headers" $ do
+        request methodPost "/UnitTest" [("Prefer", "return=representation"), ("Prefer", "resolution=merge-duplicates")]
+          [json| [
+            { "idUnitTest": 1, "nameUnitTest": "name of unittest 1" },
+            { "idUnitTest": 2, "nameUnitTest": "name of unittest 2" }
+          ]|] `shouldRespondWith` [json|[
+            { "idUnitTest": 1, "nameUnitTest": "name of unittest 1" },
+            { "idUnitTest": 2, "nameUnitTest": "name of unittest 2" }
+          ]|]
+          { matchStatus = 201
+          , matchHeaders = ["Preference-Applied" <:> "resolution=merge-duplicates", matchContentTypeJson]
+          }
+        request methodPost "/UnitTest" [("Prefer", "return=representation"), ("Prefer", "resolution=ignore-duplicates")]
+          [json| [
+            { "idUnitTest": 1, "nameUnitTest": "name of unittest 1" },
+            { "idUnitTest": 2, "nameUnitTest": "name of unittest 2" }
+          ]|] `shouldRespondWith` [json|[]|]
+          { matchStatus = 201
+          , matchHeaders = ["Preference-Applied" <:> "resolution=ignore-duplicates", matchContentTypeJson]
+          }
+
+      it "works with PUT" $ do
+        put "/UnitTest?idUnitTest=eq.1" [str| [ { "idUnitTest": 1, "nameUnitTest": "unit test 1" } ]|] `shouldRespondWith` 204
+        get "/UnitTest?idUnitTest=eq.1" `shouldRespondWith`
+          [json| [ { "idUnitTest": 1, "nameUnitTest": "unit test 1" } ]|] { matchHeaders = [matchContentTypeJson] }

test/Main.hs

@@ -1,89 +1,188 @@
 module Main where
 
+import qualified Hasql.Pool                 as P
+import qualified Hasql.Transaction.Sessions as HT
+
+import Control.AutoUpdate (defaultUpdateSettings, mkAutoUpdate,
+                           updateAction)
+import Data.Function      (id)
+import Data.List.NonEmpty (toList)
+import Data.Time.Clock    (getCurrentTime)
+
+import Data.IORef
 import Test.Hspec
+
+import PostgREST.App         (postgrest)
+import PostgREST.Config      (AppConfig (..))
+import PostgREST.DbStructure (getDbStructure, getPgVersion)
+import PostgREST.Types       (pgVersion95, pgVersion96)
+import Protolude             hiding (toList)
 import SpecHelper
 
-import qualified Hasql.Pool as P
+import qualified Feature.AndOrParamsSpec
-
-import PostgREST.DbStructure (getDbStructure)
-import PostgREST.App (postgrest)
-import Data.Function (id)
-import Data.IORef
-
-import qualified Feature.AuthSpec
 import qualified Feature.AsymmetricJwtSpec
+import qualified Feature.AudienceJwtSecretSpec
+import qualified Feature.AuthSpec
 import qualified Feature.BinaryJwtSecretSpec
 import qualified Feature.ConcurrentSpec
 import qualified Feature.CorsSpec
 import qualified Feature.DeleteSpec
+import qualified Feature.EmbedDisambiguationSpec
+import qualified Feature.ExtraSearchPathSpec
+import qualified Feature.HtmlRawOutputSpec
 import qualified Feature.InsertSpec
+import qualified Feature.JsonOperatorSpec
+import qualified Feature.MultipleSchemaSpec
 import qualified Feature.NoJwtSpec
+import qualified Feature.NonexistentSchemaSpec
+import qualified Feature.PgVersion95Spec
+import qualified Feature.PgVersion96Spec
+import qualified Feature.ProxySpec
 import qualified Feature.QueryLimitedSpec
 import qualified Feature.QuerySpec
 import qualified Feature.RangeSpec
-import qualified Feature.StructureSpec
+import qualified Feature.RawOutputTypesSpec
+import qualified Feature.RootSpec
+import qualified Feature.RpcSpec
 import qualified Feature.SingularSpec
+import qualified Feature.StructureSpec
 import qualified Feature.UnicodeSpec
-import qualified Feature.ProxySpec
+import qualified Feature.UpsertSpec
-import qualified Feature.AndOrParamsSpec
 
-import Protolude
 
 main :: IO ()
 main = do
+  getTime <- mkAutoUpdate defaultUpdateSettings { updateAction = getCurrentTime }
+
   testDbConn <- getEnvVarWithDefault "POSTGREST_TEST_CONNECTION" "postgres://postgrest_test@localhost/postgrest_test"
   setupDb testDbConn
 
   pool <- P.acquire (3, 10, toS testDbConn)
 
-  result <- P.use pool $ getDbStructure "test"
+  actualPgVersion <- either (panic.show) id <$> P.use pool getPgVersion
-  refDbStructure <- newIORef $ Just $ either (panic.show) id result
+
-  let withApp      = return $ postgrest (testCfg testDbConn)          refDbStructure pool $ pure ()
+  refDbStructure <- (newIORef . Just) =<< setupDbStructure pool (configSchemas $ testCfg testDbConn) actualPgVersion
-      ltdApp       = return $ postgrest (testLtdRowsCfg testDbConn)   refDbStructure pool $ pure ()
+
-      unicodeApp   = return $ postgrest (testUnicodeCfg testDbConn)   refDbStructure pool $ pure ()
+  let
-      proxyApp     = return $ postgrest (testProxyCfg testDbConn)     refDbStructure pool $ pure ()
+    -- For tests that run with the same refDbStructure
-      noJwtApp     = return $ postgrest (testCfgNoJWT testDbConn)     refDbStructure pool $ pure ()
+    app cfg = return ((), postgrest (cfg testDbConn) refDbStructure pool getTime $ pure ())
-      binaryJwtApp = return $ postgrest (testCfgBinaryJWT testDbConn) refDbStructure pool $ pure ()
+
-      asymJwkApp   = return $ postgrest (testCfgAsymJWK testDbConn)   refDbStructure pool $ pure ()
+    -- For tests that run with a different DbStructure(depends on configSchemas)
+    appDbs cfg = do
+      dbs <- (newIORef . Just) =<< setupDbStructure pool (configSchemas $ cfg testDbConn) actualPgVersion
+      return ((), postgrest (cfg testDbConn) dbs pool getTime $ pure ())
+
+  let withApp              = app testCfg
+      maxRowsApp           = app testMaxRowsCfg
+      proxyApp             = app testProxyCfg
+      noJwtApp             = app testCfgNoJWT
+      binaryJwtApp         = app testCfgBinaryJWT
+      audJwtApp            = app testCfgAudienceJWT
+      asymJwkApp           = app testCfgAsymJWK
+      asymJwkSetApp        = app testCfgAsymJWKSet
+      extraSearchPathApp   = app testCfgExtraSearchPath
+      rootSpecApp          = app testCfgRootSpec
+      htmlRawOutputApp     = app testCfgHtmlRawOutput
+      responseHeadersApp   = app testCfgResponseHeaders
+
+      unicodeApp           = appDbs testUnicodeCfg
+      nonexistentSchemaApp = appDbs testNonexistentSchemaCfg
+      multipleSchemaApp    = appDbs testMultipleSchemaCfg
+
+  let reset, analyze :: IO ()
+      reset = resetDb testDbConn
+      analyze = do
+        analyzeTable testDbConn "items"
+        analyzeTable testDbConn "child_entities"
+
+      extraSpecs =
+        [("Feature.UpsertSpec", Feature.UpsertSpec.spec) | actualPgVersion >= pgVersion95] ++
+        [("Feature.PgVersion95Spec", Feature.PgVersion95Spec.spec) | actualPgVersion >= pgVersion95]
+
+      specs = uncurry describe <$> [
+          ("Feature.AuthSpec"                , Feature.AuthSpec.spec actualPgVersion)
+        , ("Feature.RawOutputTypesSpec"      , Feature.RawOutputTypesSpec.spec)
+        , ("Feature.ConcurrentSpec"          , Feature.ConcurrentSpec.spec)
+        , ("Feature.CorsSpec"                , Feature.CorsSpec.spec)
+        , ("Feature.JsonOperatorSpec"        , Feature.JsonOperatorSpec.spec actualPgVersion)
+        , ("Feature.QuerySpec"               , Feature.QuerySpec.spec actualPgVersion)
+        , ("Feature.EmbedDisambiguationSpec" , Feature.EmbedDisambiguationSpec.spec)
+        , ("Feature.RpcSpec"                 , Feature.RpcSpec.spec actualPgVersion)
+        , ("Feature.StructureSpec"           , Feature.StructureSpec.spec)
+        , ("Feature.AndOrParamsSpec"         , Feature.AndOrParamsSpec.spec actualPgVersion)
+        ] ++ extraSpecs
+
+      mutSpecs = uncurry describe <$> [
+          ("Feature.DeleteSpec"             , Feature.DeleteSpec.spec)
+        , ("Feature.InsertSpec"             , Feature.InsertSpec.spec actualPgVersion)
+        , ("Feature.SingularSpec"           , Feature.SingularSpec.spec)
+        ]
 
-  let reset = resetDb testDbConn
   hspec $ do
-    mapM_ (beforeAll_ reset . before withApp) specs
+    -- Only certain Specs need a database reset, this should be used with care as it slows down the whole test suite.
+    mapM_ (afterAll_ reset . before withApp) mutSpecs
+
+    mapM_ (before withApp) specs
+
+    -- we analyze to get accurate results from EXPLAIN
+    beforeAll_ analyze . before withApp $
+      describe "Feature.RangeSpec" Feature.RangeSpec.spec
+
+    -- this test runs with a raw-output-media-types set to text/html
+    before htmlRawOutputApp $
+      describe "Feature.HtmlRawOutputSpec" Feature.HtmlRawOutputSpec.spec
 
     -- this test runs with a different server flag
-    beforeAll_ reset . before ltdApp $
+    before maxRowsApp $
       describe "Feature.QueryLimitedSpec" Feature.QueryLimitedSpec.spec
 
     -- this test runs with a different schema
-    beforeAll_ reset . before unicodeApp $
+    before unicodeApp $
       describe "Feature.UnicodeSpec" Feature.UnicodeSpec.spec
 
     -- this test runs with a proxy
-    beforeAll_ reset . before proxyApp $
+    before proxyApp $
       describe "Feature.ProxySpec" Feature.ProxySpec.spec
 
     -- this test runs without a JWT secret
-    beforeAll_ reset . before noJwtApp $
+    before noJwtApp $
       describe "Feature.NoJwtSpec" Feature.NoJwtSpec.spec
 
     -- this test runs with a binary JWT secret
-    beforeAll_ reset . before binaryJwtApp $
+    before binaryJwtApp $
       describe "Feature.BinaryJwtSecretSpec" Feature.BinaryJwtSecretSpec.spec
 
+    -- this test runs with a binary JWT secret and an audience claim
+    before audJwtApp $
+      describe "Feature.AudienceJwtSecretSpec" Feature.AudienceJwtSecretSpec.spec
+
     -- this test runs with asymmetric JWK
-    beforeAll_ reset . before asymJwkApp $
+    before asymJwkApp $
       describe "Feature.AsymmetricJwtSpec" Feature.AsymmetricJwtSpec.spec
 
- where
+    -- this test runs with asymmetric JWKSet
-  specs = map (uncurry describe) [
+    before asymJwkSetApp $
-      ("Feature.AuthSpec"         , Feature.AuthSpec.spec)
+      describe "Feature.AsymmetricJwtSpec" Feature.AsymmetricJwtSpec.spec
-    , ("Feature.ConcurrentSpec"   , Feature.ConcurrentSpec.spec)
+
-    , ("Feature.CorsSpec"         , Feature.CorsSpec.spec)
+    -- this test runs with a nonexistent db-schema
-    , ("Feature.DeleteSpec"       , Feature.DeleteSpec.spec)
+    before nonexistentSchemaApp $
-    , ("Feature.InsertSpec"       , Feature.InsertSpec.spec)
+      describe "Feature.NonexistentSchemaSpec" Feature.NonexistentSchemaSpec.spec
-    , ("Feature.QuerySpec"        , Feature.QuerySpec.spec)
+
-    , ("Feature.RangeSpec"        , Feature.RangeSpec.spec)
+    -- this test runs with an extra search path
-    , ("Feature.SingularSpec"     , Feature.SingularSpec.spec)
+    before extraSearchPathApp $
-    , ("Feature.StructureSpec"    , Feature.StructureSpec.spec)
+      describe "Feature.ExtraSearchPathSpec" Feature.ExtraSearchPathSpec.spec
-    , ("Feature.AndOrParamsSpec"  , Feature.AndOrParamsSpec.spec)
+
-    ]
+    -- this test runs with a root spec function override
+    when (actualPgVersion >= pgVersion96) $ do
+      before rootSpecApp $
+        describe "Feature.RootSpec" Feature.RootSpec.spec
+      before responseHeadersApp $
+        describe "Feature.PgVersion96Spec" Feature.PgVersion96Spec.spec
+
+    -- this test runs with multiple schemas
+    before multipleSchemaApp $
+      describe "Feature.MultipleSchemaSpec" $ Feature.MultipleSchemaSpec.spec actualPgVersion
+
+  where
+    setupDbStructure pool schemas ver =
+      either (panic.show) id <$> P.use pool (HT.transaction HT.ReadCommitted HT.Read $ getDbStructure (toList schemas) ver)

test/QueryCost.hs

@@ -0,0 +1,76 @@
+module Main where
+
+import           Control.Lens               ((^?))
+import qualified Data.Aeson.Lens            as L
+import qualified Hasql.Decoders             as HD
+import qualified Hasql.Encoders             as HE
+import qualified Hasql.Pool                 as P
+import qualified Hasql.Statement            as H
+import qualified Hasql.Transaction          as HT
+import qualified Hasql.Transaction.Sessions as HT
+import           Text.Heredoc
+
+import Protolude hiding (get)
+
+import PostgREST.QueryBuilder (requestToCallProcQuery)
+import PostgREST.Types
+
+import SpecHelper (getEnvVarWithDefault)
+
+import Test.Hspec
+
+main :: IO ()
+main = do
+  testDbConn <- getEnvVarWithDefault "POSTGREST_TEST_CONNECTION" "postgres://postgrest_test@localhost/postgrest_test"
+  -- To speed things up, assume setupDb has ben ran in the previous spec.
+  pool <- P.acquire (3, 10, toS testDbConn)
+
+  hspec $ describe "QueryCost" $
+    context "call proc query" $ do
+      it "should not exceed cost when calling setof composite proc" $ do
+        cost <- exec pool [str| {"id": 3} |] $
+          requestToCallProcQuery (QualifiedIdentifier "test" "get_projects_below") [PgArg "id" "int" True] False Nothing
+        liftIO $
+          cost `shouldSatisfy` (< Just 40)
+
+      it "should not exceed cost when calling setof composite proc with empty params" $ do
+        cost <- exec pool mempty $
+          requestToCallProcQuery (QualifiedIdentifier "test" "getallprojects") [] False Nothing
+        liftIO $
+          cost `shouldSatisfy` (< Just 30)
+
+      it "should not exceed cost when calling scalar proc" $ do
+        cost <- exec pool [str| {"a": 3, "b": 4} |] $
+          requestToCallProcQuery (QualifiedIdentifier "test" "add_them") [PgArg "a" "int" True, PgArg "b" "int" True] True Nothing
+        liftIO $
+          cost `shouldSatisfy` (< Just 10)
+
+      context "params=multiple-objects" $ do
+        it "should not exceed cost when calling setof composite proc" $ do
+          cost <- exec pool [str| [{"id": 1}, {"id": 4}] |] $
+            requestToCallProcQuery (QualifiedIdentifier "test" "get_projects_below") [PgArg "id" "int" True] False (Just MultipleObjects)
+          liftIO $ do
+            cost `shouldSatisfy` (> Just 2000)
+            cost `shouldSatisfy` (< Just 2100)
+
+        it "should not exceed cost when calling scalar proc" $ do
+          cost <- exec pool [str| [{"a": 3, "b": 4}, {"a": 1, "b": 2}, {"a": 8, "b": 7}] |] $
+            requestToCallProcQuery (QualifiedIdentifier "test" "add_them") [PgArg "a" "int" True, PgArg "b" "int" True] True Nothing
+          liftIO $
+            cost `shouldSatisfy` (< Just 10)
+
+
+exec :: P.Pool -> ByteString -> SqlQuery -> IO (Maybe Int64)
+exec pool input query =
+  join . rightToMaybe <$>
+  P.use pool (HT.transaction HT.ReadCommitted HT.Read $ HT.statement input $ explainCost query)
+
+explainCost :: SqlQuery -> H.Statement ByteString (Maybe Int64)
+explainCost query =
+  H.Statement (encodeUtf8 sql) (HE.param $ HE.nonNullable HE.unknown) decodeExplain False
+ where
+   sql = "EXPLAIN (FORMAT JSON) " <> query
+   decodeExplain :: HD.Result (Maybe Int64)
+   decodeExplain =
+     let row = HD.singleRow $ HD.column $ HD.nonNullable HD.bytea in
+     (^? L.nth 0 . L.key "Plan" .  L.key "Total Cost" . L._Integral) <$> row

test/SpecHelper.hs

@@ -1,33 +1,30 @@
 module SpecHelper where
 
-import Control.Monad (void)
+import qualified Data.ByteString.Base64 as B64 (decodeLenient, encode)
+import qualified Data.ByteString.Char8  as BS
+import qualified Data.ByteString.Lazy   as BL
+import qualified Data.Map.Strict        as M
+import qualified Data.Set               as S
+import qualified System.IO.Error        as E
 
-import qualified System.IO.Error as E
+import Control.Monad        (void)
-import System.Environment (getEnv)
+import Data.Aeson           (Value (..), decode, encode)
+import Data.CaseInsensitive (CI (..))
+import Data.List            (lookup)
+import Data.List.NonEmpty   (fromList)
+import Network.Wai.Test     (SResponse (simpleBody, simpleHeaders, simpleStatus))
+import System.Environment   (getEnv)
+import System.Process       (readProcess)
+import Text.Regex.TDFA      ((=~))
 
-import qualified Data.ByteString.Base64 as B64 (encode, decodeLenient)
-import Data.CaseInsensitive (CI(..))
-import qualified Data.Set as S
-import qualified Data.Map.Strict as M
-import Data.List (lookup)
-import Text.Regex.TDFA ((=~))
-import qualified Data.ByteString.Char8 as BS
-import qualified Data.ByteString.Lazy as BL
-import           System.Process (readProcess)
-import           Text.Heredoc
-
-import PostgREST.Config (AppConfig(..))
-
-import Test.Hspec hiding (pendingWith)
-import Test.Hspec.Wai
 
 import Network.HTTP.Types
-import Network.Wai.Test (SResponse(simpleStatus, simpleHeaders, simpleBody))
+import Test.Hspec
-
+import Test.Hspec.Wai
-import Data.Maybe (fromJust)
+import Text.Heredoc
-import Data.Aeson (decode, Value(..))
-import qualified JSONSchema.Draft4 as D4
 
+import PostgREST.Config (AppConfig (..))
+import PostgREST.Types  (JSPathExp (..))
 import Protolude
 
 matchContentTypeJson :: MatchHeader
@@ -36,7 +33,7 @@ matchContentTypeJson = "Content-Type" <:> "application/json; charset=utf-8"
 matchContentTypeSingular :: MatchHeader
 matchContentTypeSingular = "Content-Type" <:> "application/vnd.pgrst.object+json; charset=utf-8"
 
-validateOpenApiResponse :: [Header] -> WaiSession ()
+validateOpenApiResponse :: [Header] -> WaiSession () ()
 validateOpenApiResponse headers = do
   r <- request methodGet "/" headers ""
   liftIO $
@@ -47,32 +44,48 @@ validateOpenApiResponse headers = do
     let respHeaders = simpleHeaders r in
     respHeaders `shouldSatisfy`
       \hs -> ("Content-Type", "application/openapi+json; charset=utf-8") `elem` hs
-  liftIO $
+  let Just body = decode (simpleBody r)
-    let respBody = simpleBody r
+  Just schema <- liftIO $ decode <$> BL.readFile "test/fixtures/openapi.json"
-        schema :: D4.Schema
+  let args :: M.Map Text Value
-        schema = D4.emptySchema { D4._schemaRef = Just "openapi.json" }
+      args = M.fromList
-        schemaContext :: D4.SchemaWithURI D4.Schema
+        [ ( "schema", schema )
-        schemaContext = D4.SchemaWithURI
+        , ( "data", body ) ]
-          { D4._swSchema = schema
+      hdrs = acceptHdrs "application/json"
-          , D4._swURI    = Just "test/fixtures/openapi.json"
+  request methodPost "/rpc/validate_json_schema" hdrs (encode args)
-          }
+      `shouldRespondWith` "true"
-       in
+      { matchStatus = 200
-       D4.fetchFilesystemAndValidate schemaContext ((fromJust . decode) respBody) `shouldReturn` Right ()
+      , matchHeaders = []
+      }
+
 
 getEnvVarWithDefault :: Text -> Text -> IO Text
-getEnvVarWithDefault var def = do
+getEnvVarWithDefault var def = toS <$>
-  varValue <- getEnv (toS var) `E.catchIOError` const (return $ toS def)
+  getEnv (toS var) `E.catchIOError` const (return $ toS def)
-  return $ toS varValue
 
 _baseCfg :: AppConfig
 _baseCfg =  -- Connection Settings
-  AppConfig mempty "postgrest_test_anonymous" Nothing "test" "localhost" 3000
+  AppConfig mempty "postgrest_test_anonymous" Nothing (fromList ["test"]) "localhost" 3000
+            -- No user configured Unix Socket
+            Nothing
+            -- No user configured Unix Socket file mode (defaults to 660)
+            (Right 432)
             -- Jwt settings
-            (Just $ encodeUtf8 "reallyreallyreallyreallyverysafe") False
+            (Just $ encodeUtf8 "reallyreallyreallyreallyverysafe") False Nothing
             -- Connection Modifiers
-            10 Nothing (Just "test.switch_role")
+            10 10 Nothing (Just "test.switch_role")
             -- Debug Settings
             True
+            [ ("app.settings.app_host", "localhost")
+            , ("app.settings.external_api_secret", "0123456789abcdef")
+            ]
+            -- Default role claim key
+            (Right [JSPKey "role"])
+            -- Empty db-extra-search-path
+            []
+            -- No root spec override
+            Nothing
+            -- Raw output media types
+            []
 
 testCfg :: Text -> AppConfig
 testCfg testDbConn = _baseCfg { configDatabase = testDbConn }
@@ -81,13 +94,13 @@ testCfgNoJWT :: Text -> AppConfig
 testCfgNoJWT testDbConn = (testCfg testDbConn) { configJwtSecret = Nothing }
 
 testUnicodeCfg :: Text -> AppConfig
-testUnicodeCfg testDbConn = (testCfg testDbConn) { configSchema = "تست" }
+testUnicodeCfg testDbConn = (testCfg testDbConn) { configSchemas = fromList ["تست"] }
 
-testLtdRowsCfg :: Text -> AppConfig
+testMaxRowsCfg :: Text -> AppConfig
-testLtdRowsCfg testDbConn = (testCfg testDbConn) { configMaxRows = Just 2 }
+testMaxRowsCfg testDbConn = (testCfg testDbConn) { configMaxRows = Just 2 }
 
 testProxyCfg :: Text -> AppConfig
-testProxyCfg testDbConn = (testCfg testDbConn) { configProxyUri = Just "https://postgrest.com/openapi.json" }
+testProxyCfg testDbConn = (testCfg testDbConn) { configOpenAPIProxyUri = Just "https://postgrest.com/openapi.json" }
 
 testCfgBinaryJWT :: Text -> AppConfig
 testCfgBinaryJWT testDbConn = (testCfg testDbConn) {
@@ -95,27 +108,63 @@ testCfgBinaryJWT testDbConn = (testCfg testDbConn) {
       "cmVhbGx5cmVhbGx5cmVhbGx5cmVhbGx5dmVyeXNhZmU="
   }
 
+testCfgAudienceJWT :: Text -> AppConfig
+testCfgAudienceJWT testDbConn = (testCfg testDbConn) {
+    configJwtSecret = Just . B64.decodeLenient $
+      "cmVhbGx5cmVhbGx5cmVhbGx5cmVhbGx5dmVyeXNhZmU=",
+    configJwtAudience = Just "youraudience"
+  }
+
 testCfgAsymJWK :: Text -> AppConfig
 testCfgAsymJWK testDbConn = (testCfg testDbConn) {
     configJwtSecret = Just $ encodeUtf8
       [str|{"alg":"RS256","e":"AQAB","key_ops":["verify"],"kty":"RSA","n":"0etQ2Tg187jb04MWfpuogYGV75IFrQQBxQaGH75eq_FpbkyoLcEpRUEWSbECP2eeFya2yZ9vIO5ScD-lPmovePk4Aa4SzZ8jdjhmAbNykleRPCxMg0481kz6PQhnHRUv3nF5WP479CnObJKqTVdEagVL66oxnX9VhZG9IZA7k0Th5PfKQwrKGyUeTGczpOjaPqbxlunP73j9AfnAt4XCS8epa-n3WGz1j-wfpr_ys57Aq-zBCfqP67UYzNpeI1AoXsJhD9xSDOzvJgFRvc3vm2wjAW4LEMwi48rCplamOpZToIHEPIaPzpveYQwDnB1HFTR1ove9bpKJsHmi-e2uzQ","use":"sig"}|]
   }
 
+testCfgAsymJWKSet :: Text -> AppConfig
+testCfgAsymJWKSet testDbConn = (testCfg testDbConn) {
+    configJwtSecret = Just $ encodeUtf8
+      [str|{"keys": [{"alg":"RS256","e":"AQAB","key_ops":["verify"],"kty":"RSA","n":"0etQ2Tg187jb04MWfpuogYGV75IFrQQBxQaGH75eq_FpbkyoLcEpRUEWSbECP2eeFya2yZ9vIO5ScD-lPmovePk4Aa4SzZ8jdjhmAbNykleRPCxMg0481kz6PQhnHRUv3nF5WP479CnObJKqTVdEagVL66oxnX9VhZG9IZA7k0Th5PfKQwrKGyUeTGczpOjaPqbxlunP73j9AfnAt4XCS8epa-n3WGz1j-wfpr_ys57Aq-zBCfqP67UYzNpeI1AoXsJhD9xSDOzvJgFRvc3vm2wjAW4LEMwi48rCplamOpZToIHEPIaPzpveYQwDnB1HFTR1ove9bpKJsHmi-e2uzQ","use":"sig"}]}|]
+  }
+
+testNonexistentSchemaCfg :: Text -> AppConfig
+testNonexistentSchemaCfg testDbConn = (testCfg testDbConn) { configSchemas = fromList ["nonexistent"] }
+
+testCfgExtraSearchPath :: Text -> AppConfig
+testCfgExtraSearchPath testDbConn = (testCfg testDbConn) { configExtraSearchPath = ["public", "extensions"] }
+
+testCfgRootSpec :: Text -> AppConfig
+testCfgRootSpec testDbConn = (testCfg testDbConn) { configRootSpec = Just "root"}
+
+testCfgHtmlRawOutput :: Text -> AppConfig
+testCfgHtmlRawOutput testDbConn = (testCfg testDbConn) { configRawMediaTypes = ["text/html"] }
+
+testCfgResponseHeaders :: Text -> AppConfig
+testCfgResponseHeaders testDbConn = (testCfg testDbConn) { configReqCheck = Just "custom_headers" }
+
+testMultipleSchemaCfg :: Text -> AppConfig
+testMultipleSchemaCfg testDbConn = (testCfg testDbConn) { configSchemas = fromList ["v1", "v2"] }
+
 setupDb :: Text -> IO ()
 setupDb dbConn = do
   loadFixture dbConn "database"
   loadFixture dbConn "roles"
   loadFixture dbConn "schema"
   loadFixture dbConn "jwt"
+  loadFixture dbConn "jsonschema"
   loadFixture dbConn "privileges"
   resetDb dbConn
 
 resetDb :: Text -> IO ()
 resetDb dbConn = loadFixture dbConn "data"
 
+analyzeTable :: Text -> Text -> IO ()
+analyzeTable dbConn tableName =
+  void $ readProcess "psql" ["--set", "ON_ERROR_STOP=1", toS dbConn, "-a", "-c", toS $ "ANALYZE test.\"" <> tableName <> "\""] []
+
 loadFixture :: Text -> FilePath -> IO()
 loadFixture dbConn name =
-  void $ readProcess "psql" [toS dbConn, "-a", "-f", "test/fixtures/" ++ name ++ ".sql"] []
+  void $ readProcess "psql" ["--set", "ON_ERROR_STOP=1", toS dbConn, "-q", "-f", "test/fixtures/" ++ name ++ ".sql"] []
 
 rangeHdrs :: ByteRange -> [Header]
 rangeHdrs r = [rangeUnit, (hRange, renderByteRange r)]
@@ -133,6 +182,12 @@ matchHeader :: CI BS.ByteString -> BS.ByteString -> [Header] -> Bool
 matchHeader name valRegex headers =
   maybe False (=~ valRegex) $ lookup name headers
 
+noBlankHeader :: [Header] -> Bool
+noBlankHeader = notElem mempty
+
+noProfileHeader :: [Header] -> Bool
+noProfileHeader headers = isNothing $ find ((== "Content-Profile") . fst) headers
+
 authHeaderBasic :: BS.ByteString -> BS.ByteString -> Header
 authHeaderBasic u p =
   (hAuthorization, "Basic " <> (toS . B64.encode . toS $ u <> ":" <> p))
@@ -150,5 +205,5 @@ isErrorFormat s =
     S.null (S.difference keys validKeys)
  where
   obj = decode s :: Maybe (M.Map Text Value)
-  keys = fromMaybe S.empty (M.keysSet <$> obj)
+  keys = maybe S.empty M.keysSet obj
   validKeys = S.fromList ["message", "details", "hint", "code"]

test/TestTypes.hs

@@ -3,16 +3,16 @@ module TestTypes (
 , CompoundPK(..)
 ) where
 
+import           Data.Aeson ((.:))
 import qualified Data.Aeson as JSON
-import Data.Aeson ((.:))
 
 import Protolude
 
 data IncPK = IncPK {
-  incId :: Int
+  incId          :: Int
 , incNullableStr :: Maybe Text
-, incStr :: Text
+, incStr         :: Text
-, incInsert :: Text
+, incInsert      :: Text
 } deriving (Eq, Show)
 
 instance JSON.FromJSON IncPK where
@@ -24,8 +24,8 @@ instance JSON.FromJSON IncPK where
   parseJSON _ = mzero
 
 data CompoundPK = CompoundPK {
-  compoundK1 :: Int
+  compoundK1    :: Int
-, compoundK2 :: Text
+, compoundK2    :: Text
 , compoundExtra :: Maybe Int
 } deriving (Eq, Show)
 

test/Unit/DbStructureSpec.hx

@@ -1,37 +0,0 @@
-module Unit.DbStructureSpec where
-
-import Test.Hspec
-import DbStructure (Table(..), tables, Column(..), columns, ForeignKey(..),
-  foreignKeys)
-
-import Database.HDBC (quickQuery)
-import SpecHelper(dbWithSchema)
-import qualified Data.Map as M;
-
-spec :: Spec
-spec = around dbWithSchema $ beforeWith setRole $ do
-  describe "tables" $
-    it "shows all the tables" $ \conn -> do
-      ts <- tables "test" conn
-      map tableName ts `shouldBe` ["authors_only","auto_incrementing_pk",
-        "compound_pk","has_fk","insertable_view_with_join","items","menagerie","no_pk", "simple_pk"]
-
-  describe "columns" $ do
-    it "responds with each column for the table" $ \conn -> do
-      cs <- columns "test" "auto_incrementing_pk" conn
-      map colName cs `shouldBe` ["id","nullable_string","non_nullable_string",
-        "inserted_at"]
-
-    it "includes foreign key data" $ \conn -> do
-      cs <- columns "test" "has_fk" conn
-      map colFK cs `shouldBe` [Nothing,
-        Just $ ForeignKey "auto_incrementing_pk" "id",
-        Just $ ForeignKey "simple_pk" "k"]
-
-  describe "foreignKeys" $
-    it "has a description of the foreign key columns" $ \conn ->
-      foreignKeys "test" "has_fk" conn `shouldReturn` M.fromList [
-        ("auto_inc_fk", ForeignKey {fkTable="auto_incrementing_pk", fkCol="id"}),
-        ("simple_fk", ForeignKey { fkTable="simple_pk", fkCol="k"})]
-
-  where setRole conn = quickQuery conn "set role postgrest_test" [] >> return conn

test/Unit/PgQuerySpec.hx

@@ -1,99 +0,0 @@
-module Unit.PgQuerySpec where
-
-import Test.Hspec
-import Test.QuickCheck
-import Test.QuickCheck.Monadic
-
-import Database.HDBC (IConnection, SqlValue, toSql, prepare,
-  quickQuery, fromSql, execute, seState, fetchAllRowsAL)
-
-import PgQuery (LoginAttempt(..), insert, addUser, signInRole, checkPass
-              , pgFmtIdent, pgFmtLit)
-import Types (SqlRow(SqlRow))
-import TestTypes (incFromList, incStr, incNullableStr, incInsert, incId)
-import Data.Map (toList)
-import Data.String.Conversions (cs)
-import Data.Monoid ((<>))
-import Control.Arrow
-
-import SpecHelper(dbWithSchema)
-
-quickALQuery :: IConnection conn => conn ->
-                String ->
-                [SqlValue] ->
-                IO [[(String, SqlValue)]]
-quickALQuery conn q bind = do
-  sth <- prepare conn q
-  _ <- execute sth bind
-  fetchAllRowsAL sth
-
-spec :: Spec
-spec = around dbWithSchema $ do
-  describe "insert" $
-    describe "with an auto-increment key" $ do
-      it "inserts and responds with a full object description" $ \conn -> do
-        r <- insert "test" "auto_incrementing_pk" (SqlRow [
-            ("non_nullable_string", toSql ("a string"::String))]) conn
-        let returnRow = incFromList . toList $ r
-        incStr returnRow `shouldBe` "a string"
-        incNullableStr returnRow `shouldBe` Nothing
-        incInsert returnRow `shouldSatisfy` not . null
-        incId returnRow `shouldSatisfy` (>= 0)
-        tRows <- quickALQuery conn "select * from \"1\".auto_incrementing_pk" []
-        [returnRow] `shouldBe` map incFromList tRows
-
-      it "throws an exception if the PK is not unique" $ \conn -> do
-        r <- insert "test" "auto_incrementing_pk" (SqlRow [
-            ("non_nullable_string", toSql ("a string"::String))]) conn
-        let row = SqlRow .  map (Control.Arrow.first cs) . toList $ r
-        insert "test" "auto_incrementing_pk" row conn `shouldThrow` \e ->
-          seState e == "23505" -- uniqueness violation code
-
-      it "throws an exception if a required value is missing" $ \conn ->
-        insert "test" "auto_incrementing_pk" (SqlRow [
-          ("nullable_string", toSql ("a string"::String))]) conn
-          `shouldThrow` \e -> seState e == "23502"
-
-      it "generates a default values query if no data is provided" $ \c -> do
-        r <- insert "test" "items" (SqlRow []) c
-        let [row] = toList r
-        quickALQuery c "select * from \"1\".items where id = ?" [snd row]
-          `shouldReturn` [[row]]
-
-  let {user = "jdoe"; pass = "secret"; role = "postgrest_test_default_role"}
-  describe "addUser" $ do
-    it "adds a correct user to the right table" $ \conn -> do
-      addUser user pass role conn
-      [r] <- quickQuery conn "select * from postgrest.auth" []
-      let [newUser, newRole, encryptedPass] = map fromSql r :: [String]
-      cs newUser `shouldBe` user
-      cs newRole `shouldBe` role
-      checkPass (cs encryptedPass) pass `shouldBe` True
-
-    it "will not add a user with an unknown role" $ \conn ->
-      addUser user pass "not-a-real-role" conn `shouldThrow` \e ->
-        take 2 (seState e) == "23" --integrity constraint violation
-
-
-  describe "signInRole" $ beforeWith (\conn -> do
-    addUser user pass role conn
-    return conn) $ do
-    it "accepts correct credentials and return the role" $ \conn ->
-      signInRole user pass conn `shouldReturn` LoginSuccess role user
-
-    it "returns nothing with bad creds" $ \conn -> do
-      signInRole "not-a-user" pass conn `shouldReturn` LoginFailed
-      signInRole user (pass <> "crap") conn `shouldReturn` LoginFailed
-
-  describe "pgFmtIdent" $
-    it "Does what format %I would do" $ \conn -> property $ \fuzz ->
-      monadicIO $ do
-        [[row]] <- run $ quickALQuery conn "select format('%I', ? :: varchar)" [toSql (fuzz :: String)]
-        assert $ fromSql (snd row) == pgFmtIdent (cs fuzz)
-
-  describe "pgFmtLit" $
-    it "Does what format %L would do" $ \conn ->
-      property $ monadicIO $ do
-        fuzz <- pick arbitrary
-        [[row]] <- run $ quickALQuery conn "select format('%L', ? :: varchar)" [toSql (fuzz :: String)]
-        assert $ fromSql (snd row) == pgFmtLit (cs fuzz)

test/create_test_db

@@ -1,19 +1,23 @@
-#! /bin/bash
+#! /usr/bin/env bash
-if [ -z "$1" ]
+
-  then
+usage() {
-    echo "Please supply the connection uri for the user with create database privileges"
+  echo "$0 <db-uri> <test-database>"
-    exit -1
+  exit -1
+}
+
+if [ -z "$1" ]; then
+  echo "Please supply the connection uri for the user with create database privileges"
+  usage
 fi
 
-if [ -z "$2" ]
+if [ -z "$2" ]; then
-  then
+  echo "Please supply the test database name"
-    echo "Please supply the test database name"
+  usage
-    exit -1
 fi
-if [[ $1 != postgres://* ]]
+
-then
+if [[ $1 != postgres://* ]]; then
   echo "Please use a valid connection URI (https://www.postgresql.org/docs/current/static/libpq-connect.html#AEN45347)"
-  exit -1
+  usage
 fi
 
 BASEPATH=$( cd $(dirname $0) ; pwd -P )
@@ -43,9 +47,14 @@ WHERE pg_stat_activity.datname = '$DB'
 DROP DATABASE IF EXISTS $DB;
 DROP ROLE IF EXISTS $TEST_USER_NAME;
 CREATE USER $TEST_USER_NAME WITH SUPERUSER LOGIN NOINHERIT PASSWORD '$TEST_USER_PASS' CREATEROLE;
-CREATE DATABASE $DB OWNER $TEST_USER_NAME;
+ALTER ROLE postgrest_test_authenticator SET default_text_search_config TO english;
+CREATE DATABASE $DB OWNER $TEST_USER_NAME LC_COLLATE 'POSIX' LC_CTYPE 'POSIX' TEMPLATE template0;
 \\connect $DB
 ALTER SCHEMA public OWNER TO $TEST_USER_NAME;
+ALTER DATABASE $DB SET LC_MESSAGES = 'POSIX';
+ALTER DATABASE $DB SET LC_MONETARY = 'POSIX';
+ALTER DATABASE $DB SET LC_NUMERIC = 'POSIX';
+ALTER DATABASE $DB SET LC_TIME = 'POSIX';
 EOF
 
 #Remove database path from the connection uri--prevents setting up the new database name with PGDATABASE

test/destroy_test_db

@@ -1,4 +1,4 @@
-#! /bin/bash
+#! /usr/bin/env bash
 if [ -z "$1" ]
   then
     echo "Please supply the connection uri for the user with create database privileges"

test/docker-compose.yml

@@ -0,0 +1,30 @@
+version: "3.6"
+
+services:
+  test:
+    build:
+      context: .
+      dockerfile: Dockerfile.test
+    depends_on:
+      - postgres
+    working_dir: /root/postgrest
+    volumes:
+      - ../:/root/postgrest
+      - stack-linux:/root/.stack
+      - stack-work:/root/postgrest/.stack-work
+    command: bash -c "POSTGREST_TEST_CONNECTION=$$(test/create_test_db 'postgres://postgres:postgres@postgres' test_db) stack test"
+
+  postgres:
+    image: postgres:11
+    environment:
+      POSTGRES_PASSWORD: postgres
+    volumes:
+      - postgres:/var/lib/postgresql/data
+
+volumes:
+  postgres:
+    driver_opts:
+      type: tmpfs
+      device: tmpfs
+  stack-linux:
+  stack-work:

test/fixtures/data.sql

@@ -248,7 +248,9 @@ INSERT INTO nullable_integer VALUES (NULL);
 TRUNCATE TABLE tsearch CASCADE;
 INSERT INTO tsearch VALUES (to_tsvector('It''s kind of fun to do the impossible'));
 INSERT INTO tsearch VALUES (to_tsvector('But also fun to do what is possible'));
-
+INSERT INTO tsearch VALUES (to_tsvector('Fat cats ate rats'));
+INSERT INTO tsearch VALUES (to_tsvector('french', 'C''est un peu amusant de faire l''impossible'));
+INSERT INTO tsearch VALUES (to_tsvector('german', 'Es ist eine Art Spaß, das Unmögliche zu machen'));
 
 --
 -- Data for Name: users_projects; Type: TABLE DATA; Schema: test; Owner: -
@@ -321,6 +323,261 @@ INSERT INTO ranges VALUES (2, '[3,6]');
 INSERT INTO ranges VALUES (3, '[6,9]');
 INSERT INTO ranges VALUES (4, '[9,12]');
 
---
+TRUNCATE TABLE being CASCADE;
--- PostgreSQL database dump complete
+INSERT INTO being VALUES (1), (2), (3), (4);
---
+
+TRUNCATE TABLE descendant CASCADE;
+INSERT INTO descendant VALUES (1,1), (2,1), (3,1), (4,2);
+
+TRUNCATE TABLE part CASCADE;
+INSERT INTO part VALUES (1), (2), (3), (4);
+
+TRUNCATE TABLE being_part CASCADE;
+INSERT INTO being_part VALUES (1,1), (2,1), (3,2), (4,3);
+
+TRUNCATE TABLE employees CASCADE;
+INSERT INTO employees VALUES
+  ('Frances M.', 'Roe', '24000', 'One-Up Realty', 'Author'),
+  ('Daniel B.', 'Lyon', '36000', 'Dubrow''s Cafeteria', 'Packer'),
+  ('Edwin S.', 'Smith', '48000', 'Pro Garden Management', 'Marine biologist');
+
+TRUNCATE TABLE tiobe_pls CASCADE;
+INSERT INTO tiobe_pls VALUES ('Java', 1), ('C', 2), ('Python', 4);
+
+TRUNCATE TABLE single_unique CASCADE;
+INSERT INTO single_unique (unique_key, value) VALUES (1, 'A');
+
+TRUNCATE TABLE compound_unique CASCADE;
+INSERT INTO compound_unique (key1, key2, value) VALUES (1, 1, 'A');
+
+TRUNCATE TABLE only_pk CASCADE;
+INSERT INTO only_pk VALUES (1), (2);
+
+TRUNCATE TABLE family_tree CASCADE;
+INSERT INTO family_tree VALUES ('1', 'Parental Unit', NULL);
+INSERT INTO family_tree VALUES ('2', 'Kid One', '1');
+INSERT INTO family_tree VALUES ('3', 'Kid Two', '1');
+INSERT INTO family_tree VALUES ('4', 'Grandkid One', '2');
+INSERT INTO family_tree VALUES ('5', 'Grandkid Two', '3');
+
+TRUNCATE TABLE managers CASCADE;
+INSERT INTO managers VALUES (1, 'Referee Manager');
+INSERT INTO managers VALUES (2, 'Auditor Manager');
+INSERT INTO managers VALUES (3, 'Acme Manager');
+INSERT INTO managers VALUES (4, 'Umbrella Manager');
+INSERT INTO managers VALUES (5, 'Cyberdyne Manager');
+INSERT INTO managers VALUES (6, 'Oscorp Manager');
+
+TRUNCATE TABLE organizations CASCADE;
+INSERT INTO organizations VALUES (1, 'Referee Org', null, null, 1);
+INSERT INTO organizations VALUES (2, 'Auditor Org', null, null, 2);
+INSERT INTO organizations VALUES (3, 'Acme', 1, 2, 3);
+INSERT INTO organizations VALUES (4, 'Umbrella', 1, 2, 4);
+INSERT INTO organizations VALUES (5, 'Cyberdyne', 3, 4, 5);
+INSERT INTO organizations VALUES (6, 'Oscorp', 3, 4, 6);
+
+SET search_path = private, pg_catalog;
+
+TRUNCATE TABLE authors CASCADE;
+INSERT INTO authors VALUES (1, 'George Orwell');
+INSERT INTO authors VALUES (2, 'Anne Frank');
+INSERT INTO authors VALUES (3, 'Antoine de Saint-Exupéry');
+INSERT INTO authors VALUES (4, 'J.D. Salinger');
+INSERT INTO authors VALUES (5, 'Ray Bradbury');
+INSERT INTO authors VALUES (6, 'William Golding');
+INSERT INTO authors VALUES (7, 'Harper Lee');
+INSERT INTO authors VALUES (8, 'Kurt Vonnegut');
+INSERT INTO authors VALUES (9, 'Ken Kesey');
+
+TRUNCATE TABLE publishers CASCADE;
+INSERT INTO publishers VALUES (1, 'Secker & Warburg');
+INSERT INTO publishers VALUES (2, 'Contact Publishing');
+INSERT INTO publishers VALUES (3, 'Reynal & Hitchcock');
+INSERT INTO publishers VALUES (4, 'Little, Brown and Company');
+INSERT INTO publishers VALUES (5, 'Ballantine Books');
+INSERT INTO publishers VALUES (6, 'Faber and Faber');
+INSERT INTO publishers VALUES (7, 'J. B. Lippincott & Co.');
+INSERT INTO publishers VALUES (8, 'Delacorte');
+INSERT INTO publishers VALUES (9, 'Viking Press & Signet Books');
+
+TRUNCATE TABLE books CASCADE;
+INSERT INTO books VALUES (1, '1984', 1949, 1, 1);
+INSERT INTO books VALUES (2, 'The Diary of a Young Girl', 1947, 2, 2);
+INSERT INTO books VALUES (3, 'The Little Prince', 1947, 3, 3);
+INSERT INTO books VALUES (4, 'The Catcher in the Rye', 1951, 4, 4);
+INSERT INTO books VALUES (5, 'Farenheit 451', 1953, 5, 5);
+INSERT INTO books VALUES (6, 'Lord of the Flies', 1954, 6, 6);
+INSERT INTO books VALUES (7, 'To Kill a Mockingbird', 1960, 7, 7);
+INSERT INTO books VALUES (8, 'Slaughterhouse-Five', 1969, 8, 8);
+INSERT INTO books VALUES (9, 'One Flew Over the Cuckoo''s Nest', 1962, 9, 9);
+
+SET search_path = test, pg_catalog;
+
+TRUNCATE TABLE person CASCADE;
+
+INSERT INTO person VALUES (1, 'John');
+INSERT INTO person VALUES (2, 'Jane');
+INSERT INTO person VALUES (3, 'Jake');
+INSERT INTO person VALUES (4, 'Julie');
+
+TRUNCATE TABLE message CASCADE;
+INSERT INTO message VALUES (1, 'Hello Jane', 1, 2);
+INSERT INTO message VALUES (2, 'Hi John', 2, 1);
+INSERT INTO message VALUES (3, 'How are you doing?', 1, 2);
+INSERT INTO message VALUES (4, 'Hey Julie', 3, 4);
+INSERT INTO message VALUES (5, 'What''s up Jake', 4, 3);
+
+TRUNCATE TABLE space CASCADE;
+INSERT INTO space VALUES (1, 'space 1');
+
+TRUNCATE TABLE zone CASCADE;
+INSERT INTO zone VALUES (1, 'zone 1', 2, 1);
+INSERT INTO zone VALUES (2, 'zone 2', 2, 1);
+INSERT INTO zone VALUES (3, 'store 3', 3, 1);
+INSERT INTO zone VALUES (4, 'store 4', 3, 1);
+
+-- for foreign table projects_dump
+copy (select id, name, client_id from projects) to '/tmp/projects_dump.csv' with csv;
+
+TRUNCATE TABLE "UnitTest" CASCADE;
+INSERT INTO "UnitTest" VALUES (1, 'unit test 1');
+
+TRUNCATE TABLE json_arr CASCADE;
+INSERT INTO json_arr VALUES (1, '[1, 2, 3]');
+INSERT INTO json_arr VALUES (2, '[4, 5, 6]');
+INSERT INTO json_arr VALUES (3, '[[9, 8, 7], [11, 12, 13]]');
+INSERT INTO json_arr VALUES (4, '[[[5, 6], 7, 8]]');
+INSERT INTO json_arr VALUES (5, '[{"a": "A"}, {"b": "B"}]');
+INSERT INTO json_arr VALUES (6, '[{"a": [1,2,3]}, {"b": [4,5]}]');
+INSERT INTO json_arr VALUES (7, '{"c": [1,2,3], "d": [4,5]}');
+INSERT INTO json_arr VALUES (8, '{"c": [{"d": [4,5,6,7,8]}]}');
+INSERT INTO json_arr VALUES (9, '[{"0xy1": [1,{"23-xy-45": [2, {"xy-6": [3]}]}]}]');
+
+TRUNCATE TABLE jsonb_test CASCADE;
+INSERT INTO jsonb_test VALUES (1, '{ "a": {"b": 2} }');
+INSERT INTO jsonb_test VALUES (2, '{ "c": [1,2,3] }');
+INSERT INTO jsonb_test VALUES (3, '[{ "d": "test" }]');
+INSERT INTO jsonb_test VALUES (4, '{ "e": 1 }');
+
+TRUNCATE TABLE private.player CASCADE;
+INSERT into private.player
+SELECT
+  generate_series,
+  'first_name_' || generate_series,
+  'last_name_' || generate_series,
+  '2018-10-11'
+FROM generate_series(1, 12);
+
+TRUNCATE TABLE contract CASCADE;
+insert into contract
+select
+  'tournament_' || generate_series,
+  tsrange(now()::timestamp, null),
+  10*generate_series,
+  generate_series,
+  'first_name_' || generate_series,
+  'last_name_' || generate_series,
+  '2018-10-11'
+from generate_series(1, 6);
+
+TRUNCATE TABLE ltree_sample CASCADE;
+INSERT INTO ltree_sample VALUES ('Top');
+INSERT INTO ltree_sample VALUES ('Top.Science');
+INSERT INTO ltree_sample VALUES ('Top.Science.Astronomy');
+INSERT INTO ltree_sample VALUES ('Top.Science.Astronomy.Astrophysics');
+INSERT INTO ltree_sample VALUES ('Top.Science.Astronomy.Cosmology');
+
+TRUNCATE TABLE isn_sample CASCADE;
+INSERT INTO isn_sample VALUES ('978-0-393-04002-9', 'Mathematics: From the Birth of Numbers');
+
+TRUNCATE TABLE "Server Today" CASCADE;
+COPY "Server Today" ("cHostname", "Just A Server Model") FROM STDIN CSV DELIMITER '|';
+argnim1    | IBM,9113-550 (P5-550)
+argnim2    | IBM,9113-550 (P5-550)
+daaa2nim71 | IBM,9131-52A (P5-52A)
+daah3nim71 | IBM,8406-71Y (P7-PS701)
+hbnim1     | IBM,9133-55A (P5-55A)
+\.
+
+TRUNCATE TABLE pgrst_reserved_chars CASCADE;
+COPY pgrst_reserved_chars ("*id*", ":arr->ow::cast", "(inside,parens)", "a.dotted.column", "  col  w  space  ") FROM STDIN CSV DELIMITER '|';
+1 | arrow-1 | parens-1 | dotted-1 | space-1
+2 | arrow-2 | parens-2 | dotted-2 | space-2
+3 | arrow-3 | parens-3 | dotted-3 | space-3
+\.
+
+TRUNCATE TABLE web_content CASCADE;
+INSERT INTO web_content VALUES (5, 'wat', null);
+INSERT INTO web_content VALUES (0, 'tardis', 5);
+INSERT INTO web_content VALUES (1, 'fezz', 0);
+INSERT INTO web_content VALUES (2, 'foo', 0);
+INSERT INTO web_content VALUES (3, 'bar', 0);
+INSERT INTO web_content VALUES (4, 'wut', 1);
+
+TRUNCATE TABLE app_users CASCADE;
+INSERT INTO app_users (id, email, "password") VALUES (1, 'test@123.com','pass');
+INSERT INTO app_users (id, email, "password") VALUES (2, 'abc@123.com','pass');
+INSERT INTO app_users (id, email, "password") VALUES (3, 'def@123.com','pass');
+
+TRUNCATE TABLE private.pages CASCADE;
+INSERT INTO private.pages VALUES (1, 'http://postgrest.org/en/v6.0/api.html');
+INSERT INTO private.pages VALUES (2, 'http://postgrest.org/en/v6.0/admin.html');
+
+TRUNCATE TABLE private.referrals CASCADE;
+INSERT INTO private.referrals VALUES ('github.com', 1);
+INSERT INTO private.referrals VALUES ('hub.docker.com', 2);
+
+TRUNCATE TABLE big_projects CASCADE;
+INSERT INTO big_projects (big_project_id, name)
+VALUES (1, 'big project 1'),
+       (2, 'big project 2');
+
+TRUNCATE TABLE sites CASCADE;
+INSERT INTO sites (site_id, name, main_project_id)
+VALUES (1, 'site 1', 1),
+       (2, 'site 2', null),
+       (3, 'site 3', 2),
+       (4, 'site 4', null);
+
+TRUNCATE TABLE jobs CASCADE;
+INSERT INTO jobs (job_id, name, site_id, big_project_id)
+VALUES ('bc5d5362-b881-438f-b9f5-7417e08704ed', 'job 1-1', 1, 1),
+       ('3bd52697-033b-4edd-8a28-46a9c04b7c1e', 'job 2-1', 2, 1),
+       ('e6e67e4e-19b1-11e9-ab14-d663bd873d93', 'job 2-2', 2, 2);
+
+TRUNCATE TABLE departments CASCADE;
+TRUNCATE TABLE agents CASCADE;
+INSERT INTO agents (id, name)
+VALUES (1, 'agent 1'),
+       (2, 'agent 2'),
+       (3, 'agent 3'),
+       (4, 'agent 4');
+
+INSERT INTO departments (id, name, head_id)
+VALUES (1, 'dep 1', 1),
+       (2, 'dep 3', 3);
+
+UPDATE agents SET department_id = 1 WHERE id in (1, 2);
+UPDATE agents SET department_id = 2 WHERE id in (3, 4);
+
+TRUNCATE TABLE schedules CASCADE;
+INSERT INTO schedules VALUES(1, 'morning', '06:00:00', '11:59:00');
+INSERT INTO schedules VALUES(2, 'afternoon', '12:00:00', '17:59:00');
+INSERT INTO schedules VALUES(3, 'night', '18:00:00', '23:59:00');
+INSERT INTO schedules VALUES(4, 'early morning', '00:00:00', '05:59:00');
+
+TRUNCATE TABLE activities CASCADE;
+INSERT INTO activities(id, schedule_id, car_id)    VALUES(1, 1, 'CAR-349');
+INSERT INTO activities(id, schedule_id, camera_id) VALUES(2, 3, 'CAM-123');
+
+TRUNCATE TABLE unit_workdays CASCADE;
+INSERT INTO unit_workdays VALUES(1, '2019-12-02', 1, 1, 2, 3);
+
+TRUNCATE TABLE v1.parents CASCADE;
+INSERT INTO v1.parents VALUES(1, 'parent v1-1'), (2, 'parent v1-2');
+
+TRUNCATE TABLE v2.parents CASCADE;
+INSERT INTO v2.parents VALUES(3, 'parent v2-3'), (4, 'parent v2-4');
+
+TRUNCATE TABLE v2.another_table CASCADE;
+INSERT INTO v2.another_table VALUES(5, 'value 5'), (6, 'value 6');

test/fixtures/database.sql

@@ -1,3 +1,3 @@
 set client_min_messages to warning;
-DROP SCHEMA IF EXISTS test, private, postgrest, jwt, public, تست CASCADE;
+DROP SCHEMA IF EXISTS test, private, postgrest, jwt, public, تست, extensions, v1, v2 CASCADE;
 DROP TYPE IF EXISTS jwt_token CASCADE;

test/fixtures/jsonschema.sql

@@ -0,0 +1,280 @@
+-- from gavinwahl/postgres-json-schema commit 5a257e19a1569a77b82e9182b0b7d9fc8b6f6382
+
+/*
+Copyright (c) 2016, Gavin Wahl
+
+Permission to use, copy, modify, and distribute this software and its
+documentation for any purpose, without fee, and without a written agreement is
+hereby granted, provided that the above copyright notice and this paragraph and
+the following two paragraphs appear in all copies.
+
+IN NO EVENT SHALL GAVIN WAHL BE LIABLE TO ANY PARTY FOR DIRECT, INDIRECT,
+SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES, INCLUDING LOST PROFITS, ARISING
+OUT OF THE USE OF THIS SOFTWARE AND ITS DOCUMENTATION, EVEN IF GAVIN WAHL HAS
+BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+GAVIN WAHL SPECIFICALLY DISCLAIMS ANY WARRANTIES, INCLUDING, BUT NOT LIMITED
+TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
+PURPOSE. THE SOFTWARE PROVIDED HEREUNDER IS ON AN "AS IS" BASIS, AND GAVIN WAHL
+HAS NO OBLIGATIONS TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR
+MODIFICATIONS.
+*/
+
+CREATE OR REPLACE FUNCTION _validate_json_schema_type(type text, data jsonb) RETURNS boolean AS $f$
+BEGIN
+  IF type = 'integer' THEN
+    IF jsonb_typeof(data) != 'number' THEN
+      RETURN false;
+    END IF;
+    IF trunc(data::text::numeric) != data::text::numeric THEN
+      RETURN false;
+    END IF;
+  ELSE
+    IF type != jsonb_typeof(data) THEN
+      RETURN false;
+    END IF;
+  END IF;
+  RETURN true;
+END;
+$f$ LANGUAGE 'plpgsql' IMMUTABLE;
+
+CREATE OR REPLACE FUNCTION test.validate_json_schema(schema jsonb, data jsonb, root_schema jsonb DEFAULT NULL) RETURNS boolean AS $f$
+DECLARE
+  prop text;
+  item jsonb;
+  path text[];
+  types text[];
+  pattern text;
+  props text[];
+BEGIN
+  IF root_schema IS NULL THEN
+    root_schema = schema;
+  END IF;
+
+  IF schema ? 'type' THEN
+    IF jsonb_typeof(schema->'type') = 'array' THEN
+      types = ARRAY(SELECT jsonb_array_elements_text(schema->'type'));
+    ELSE
+      types = ARRAY[schema->>'type'];
+    END IF;
+    IF (SELECT NOT bool_or(public._validate_json_schema_type(type, data)) FROM unnest(types) type) THEN
+      RETURN false;
+    END IF;
+  END IF;
+
+  IF schema ? 'properties' THEN
+    FOR prop IN SELECT jsonb_object_keys(schema->'properties') LOOP
+      IF data ? prop AND NOT validate_json_schema(schema->'properties'->prop, data->prop, root_schema) THEN
+        RETURN false;
+      END IF;
+    END LOOP;
+  END IF;
+
+  IF schema ? 'required' AND jsonb_typeof(data) = 'object' THEN
+    IF NOT ARRAY(SELECT jsonb_object_keys(data)) @>
+           ARRAY(SELECT jsonb_array_elements_text(schema->'required')) THEN
+      RETURN false;
+    END IF;
+  END IF;
+
+  IF schema ? 'items' AND jsonb_typeof(data) = 'array' THEN
+    IF jsonb_typeof(schema->'items') = 'object' THEN
+      FOR item IN SELECT jsonb_array_elements(data) LOOP
+        IF NOT validate_json_schema(schema->'items', item, root_schema) THEN
+          RETURN false;
+        END IF;
+      END LOOP;
+    ELSE
+      IF NOT (
+        SELECT bool_and(i > jsonb_array_length(schema->'items') OR validate_json_schema(schema->'items'->(i::int - 1), elem, root_schema))
+        FROM jsonb_array_elements(data) WITH ORDINALITY AS t(elem, i)
+      ) THEN
+        RETURN false;
+      END IF;
+    END IF;
+  END IF;
+
+  IF jsonb_typeof(schema->'additionalItems') = 'boolean' and NOT (schema->'additionalItems')::text::boolean AND jsonb_typeof(schema->'items') = 'array' THEN
+    IF jsonb_array_length(data) > jsonb_array_length(schema->'items') THEN
+      RETURN false;
+    END IF;
+  END IF;
+
+  IF jsonb_typeof(schema->'additionalItems') = 'object' THEN
+    IF NOT (
+        SELECT bool_and(validate_json_schema(schema->'additionalItems', elem, root_schema))
+        FROM jsonb_array_elements(data) WITH ORDINALITY AS t(elem, i)
+        WHERE i > jsonb_array_length(schema->'items')
+      ) THEN
+      RETURN false;
+    END IF;
+  END IF;
+
+  IF schema ? 'minimum' AND jsonb_typeof(data) = 'number' THEN
+    IF data::text::numeric < (schema->>'minimum')::numeric THEN
+      RETURN false;
+    END IF;
+  END IF;
+
+  IF schema ? 'maximum' AND jsonb_typeof(data) = 'number' THEN
+    IF data::text::numeric > (schema->>'maximum')::numeric THEN
+      RETURN false;
+    END IF;
+  END IF;
+
+  IF COALESCE((schema->'exclusiveMinimum')::text::bool, FALSE) THEN
+    IF data::text::numeric = (schema->>'minimum')::numeric THEN
+      RETURN false;
+    END IF;
+  END IF;
+
+  IF COALESCE((schema->'exclusiveMaximum')::text::bool, FALSE) THEN
+    IF data::text::numeric = (schema->>'maximum')::numeric THEN
+      RETURN false;
+    END IF;
+  END IF;
+
+  IF schema ? 'anyOf' THEN
+    IF NOT (SELECT bool_or(validate_json_schema(sub_schema, data, root_schema)) FROM jsonb_array_elements(schema->'anyOf') sub_schema) THEN
+      RETURN false;
+    END IF;
+  END IF;
+
+  IF schema ? 'allOf' THEN
+    IF NOT (SELECT bool_and(validate_json_schema(sub_schema, data, root_schema)) FROM jsonb_array_elements(schema->'allOf') sub_schema) THEN
+      RETURN false;
+    END IF;
+  END IF;
+
+  IF schema ? 'oneOf' THEN
+    IF 1 != (SELECT COUNT(*) FROM jsonb_array_elements(schema->'oneOf') sub_schema WHERE validate_json_schema(sub_schema, data, root_schema)) THEN
+      RETURN false;
+    END IF;
+  END IF;
+
+  IF COALESCE((schema->'uniqueItems')::text::boolean, false) THEN
+    IF (SELECT COUNT(*) FROM jsonb_array_elements(data)) != (SELECT count(DISTINCT val) FROM jsonb_array_elements(data) val) THEN
+      RETURN false;
+    END IF;
+  END IF;
+
+  IF schema ? 'additionalProperties' AND jsonb_typeof(data) = 'object' THEN
+    props := ARRAY(
+      SELECT key
+      FROM jsonb_object_keys(data) key
+      WHERE key NOT IN (SELECT jsonb_object_keys(schema->'properties'))
+        AND NOT EXISTS (SELECT * FROM jsonb_object_keys(schema->'patternProperties') pat WHERE key ~ pat)
+    );
+    IF jsonb_typeof(schema->'additionalProperties') = 'boolean' THEN
+      IF NOT (schema->'additionalProperties')::text::boolean AND jsonb_typeof(data) = 'object' AND NOT props <@ ARRAY(SELECT jsonb_object_keys(schema->'properties')) THEN
+        RETURN false;
+      END IF;
+    ELSEIF NOT (
+      SELECT bool_and(validate_json_schema(schema->'additionalProperties', data->key, root_schema))
+      FROM unnest(props) key
+    ) THEN
+      RETURN false;
+    END IF;
+  END IF;
+
+  IF schema ? '$ref' THEN
+    path := ARRAY(
+      SELECT regexp_replace(regexp_replace(path_part, '~1', '/'), '~0', '~')
+      FROM UNNEST(regexp_split_to_array(schema->>'$ref', '/')) path_part
+    );
+    -- ASSERT path[1] = '#', 'only refs anchored at the root are supported';
+    IF NOT validate_json_schema(root_schema #> path[2:array_length(path, 1)], data, root_schema) THEN
+      RETURN false;
+    END IF;
+  END IF;
+
+  IF schema ? 'enum' THEN
+    IF NOT EXISTS (SELECT * FROM jsonb_array_elements(schema->'enum') val WHERE val = data) THEN
+      RETURN false;
+    END IF;
+  END IF;
+
+  IF schema ? 'minLength' AND jsonb_typeof(data) = 'string' THEN
+    IF char_length(data #>> '{}') < (schema->>'minLength')::numeric THEN
+      RETURN false;
+    END IF;
+  END IF;
+
+  IF schema ? 'maxLength' AND jsonb_typeof(data) = 'string' THEN
+    IF char_length(data #>> '{}') > (schema->>'maxLength')::numeric THEN
+      RETURN false;
+    END IF;
+  END IF;
+
+  IF schema ? 'not' THEN
+    IF validate_json_schema(schema->'not', data, root_schema) THEN
+      RETURN false;
+    END IF;
+  END IF;
+
+  IF schema ? 'maxProperties' AND jsonb_typeof(data) = 'object' THEN
+    IF (SELECT count(*) FROM jsonb_object_keys(data)) > (schema->>'maxProperties')::numeric THEN
+      RETURN false;
+    END IF;
+  END IF;
+
+  IF schema ? 'minProperties' AND jsonb_typeof(data) = 'object' THEN
+    IF (SELECT count(*) FROM jsonb_object_keys(data)) < (schema->>'minProperties')::numeric THEN
+      RETURN false;
+    END IF;
+  END IF;
+
+  IF schema ? 'maxItems' AND jsonb_typeof(data) = 'array' THEN
+    IF (SELECT count(*) FROM jsonb_array_elements(data)) > (schema->>'maxItems')::numeric THEN
+      RETURN false;
+    END IF;
+  END IF;
+
+  IF schema ? 'minItems' AND jsonb_typeof(data) = 'array' THEN
+    IF (SELECT count(*) FROM jsonb_array_elements(data)) < (schema->>'minItems')::numeric THEN
+      RETURN false;
+    END IF;
+  END IF;
+
+  IF schema ? 'dependencies' THEN
+    FOR prop IN SELECT jsonb_object_keys(schema->'dependencies') LOOP
+      IF data ? prop THEN
+        IF jsonb_typeof(schema->'dependencies'->prop) = 'array' THEN
+          IF NOT (SELECT bool_and(data ? dep) FROM jsonb_array_elements_text(schema->'dependencies'->prop) dep) THEN
+            RETURN false;
+          END IF;
+        ELSE
+          IF NOT validate_json_schema(schema->'dependencies'->prop, data, root_schema) THEN
+            RETURN false;
+          END IF;
+        END IF;
+      END IF;
+    END LOOP;
+  END IF;
+
+  IF schema ? 'pattern' AND jsonb_typeof(data) = 'string' THEN
+    IF (data #>> '{}') !~ (schema->>'pattern') THEN
+      RETURN false;
+    END IF;
+  END IF;
+
+  IF schema ? 'patternProperties' AND jsonb_typeof(data) = 'object' THEN
+    FOR prop IN SELECT jsonb_object_keys(data) LOOP
+      FOR pattern IN SELECT jsonb_object_keys(schema->'patternProperties') LOOP
+        RAISE NOTICE 'prop %s, pattern %, schema %', prop, pattern, schema->'patternProperties'->pattern;
+        IF prop ~ pattern AND NOT validate_json_schema(schema->'patternProperties'->pattern, data->prop, root_schema) THEN
+          RETURN false;
+        END IF;
+      END LOOP;
+    END LOOP;
+  END IF;
+
+  IF schema ? 'multipleOf' AND jsonb_typeof(data) = 'number' THEN
+    IF data::text::numeric % (schema->>'multipleOf')::numeric != 0 THEN
+      RETURN false;
+    END IF;
+  END IF;
+
+  RETURN true;
+END;
+$f$ LANGUAGE 'plpgsql' IMMUTABLE;

test/fixtures/jwt.sql

@@ -4,7 +4,6 @@ set client_min_messages to warning;
 DROP SCHEMA IF EXISTS jwt CASCADE;
 CREATE SCHEMA jwt;
 
-
 CREATE OR REPLACE FUNCTION jwt.url_encode(data bytea) RETURNS text LANGUAGE sql AS $$
     SELECT translate(encode(data, 'base64'), E'+/=\n', '-_');
 $$;
@@ -31,7 +30,7 @@ WITH
       WHEN algorithm = 'HS384' THEN 'sha384'
       WHEN algorithm = 'HS512' THEN 'sha512'
       ELSE '' END)  -- hmac throws error
-SELECT jwt.url_encode(hmac(signables, secret, (select * FROM alg)));
+SELECT jwt.url_encode(public.hmac(signables, secret, (select * FROM alg)));
 $$;
 
 

test/fixtures/privileges.sql

@@ -5,6 +5,9 @@ GRANT USAGE ON SCHEMA
     , jwt
     , public
     , "تست"
+    , extensions
+    , v1
+    , v2
 TO postgrest_test_anonymous;
 
 -- Schema test objects
@@ -57,6 +60,75 @@ GRANT ALL ON TABLE
     , child_entities
     , grandchild_entities
     , ranges
+    , being
+    , descendant
+    , being_part
+    , part
+    , leak
+    , perf_articles
+    , employees
+    , tiobe_pls
+    , single_unique
+    , compound_unique
+    , only_pk
+    , family_tree
+    , managers
+    , organizations
+    , authors
+    , books
+    , forties_books
+    , fifties_books
+    , sixties_books
+    , person
+    , message
+    , person_detail
+    , space
+    , zone
+    , projects_dump
+    , "UnitTest"
+    , json_arr
+    , jsonb_test
+    , authors_books_number
+    , authors_have_book_in_decade
+    , forties_and_fifties_books
+    , odd_years_publications
+    , foos
+    , bars
+    , materialized_projects
+    , contract
+    , player_view
+    , contract_view
+    , ltree_sample
+    , isn_sample
+    , projects_count_grouped_by
+    , "Server Today"
+    , pgrst_reserved_chars
+    , authors_w_entities
+    , openapi_types
+    , getallprojects_view
+    , get_projects_above_view
+    , web_content
+    , pages
+    , referrals
+    , big_projects
+    , sites
+    , jobs
+    , main_jobs
+    , whatev_projects
+    , whatev_sites
+    , whatev_jobs
+    , agents
+    , departments
+    , schedules
+    , activities
+    , unit_workdays
+    , stuff
+    , loc_test
+    , v1.parents
+    , v2.parents
+    , v2.another_table
+    , v1.childs
+    , v2.childs
 TO postgrest_test_anonymous;
 
 GRANT INSERT ON TABLE insertonly TO postgrest_test_anonymous;
@@ -65,6 +137,9 @@ GRANT USAGE ON SEQUENCE
       auto_incrementing_pk_id_seq
     , items_id_seq
     , callcounter_count
+    , leak_id_seq
+    , v1.childs_id_seq
+    , v2.childs_id_seq
 TO postgrest_test_anonymous;
 
 -- Privileges for non anonymous users
@@ -74,3 +149,12 @@ GRANT ALL ON TABLE authors_only TO postgrest_test_author;
 GRANT SELECT (article_id, user_id) ON TABLE limited_article_stars TO postgrest_test_anonymous;
 GRANT INSERT (article_id, user_id) ON TABLE limited_article_stars TO postgrest_test_anonymous;
 GRANT UPDATE (article_id, user_id) ON TABLE limited_article_stars TO postgrest_test_anonymous;
+
+GRANT SELECT(id, email) ON TABLE app_users TO postgrest_test_anonymous;
+GRANT INSERT, UPDATE    ON TABLE app_users TO postgrest_test_anonymous;
+GRANT DELETE            ON TABLE app_users TO postgrest_test_anonymous;
+
+REVOKE EXECUTE ON FUNCTION privileged_hello(text) FROM PUBLIC; -- All functions are available to every role(PUBLIC) by default
+GRANT EXECUTE ON FUNCTION privileged_hello(text) TO postgrest_test_author;
+
+GRANT USAGE ON SCHEMA test TO postgrest_test_default_role;

test/io-tests.sh

@@ -40,9 +40,10 @@ pgrStopAll(){ pkill -f "$(stack path --local-install-root)/bin/postgrest"; }
 rootStatus(){
   curl -s -o /dev/null -w '%{http_code}' "http://localhost:$pgrPort/"
 }
+
 authorsStatus(){
   curl -s -o /dev/null -w '%{http_code}' \
-    -H "Authorization: Bearer $( cat "$1" )" \
+    -H "Authorization: Bearer $1" \
     "http://localhost:$pgrPort/authors_only"
 }
 
@@ -68,12 +69,12 @@ readSecretFromFile(){
   if pgrStarted
   then
     authorsJwt="./secrets/${1%.*}.jwt"
-    httpStatus="$( authorsStatus "$authorsJwt" )"
+    httpStatus="$( authorsStatus $(cat "$authorsJwt") )"
     if test "$httpStatus" -eq 200
     then
       ok "authentication with $2 secret read from a file"
     else
-      ko "failed to authenticate using JWT for $2 secret: $httpStatus"
+      ko "authentication with $2 secret read from a file: $httpStatus"
     fi
   else
     ko "failed to read $2 secret from a file"
@@ -81,6 +82,129 @@ readSecretFromFile(){
   pgrStop
 }
 
+readDbUriFromFile(){
+  pgrConfig="dburi-from-file.config"
+  pgrStartRead "./configs/$pgrConfig" "./dburis/$1"
+  while pgrStarted && test "$( rootStatus )" -ne 200
+  do
+    # wait for the server to start
+    sleep 0.1 \
+    || sleep 1 # fallback: subsecond sleep is not standard and may fail
+  done
+  if pgrStarted
+  then
+    ok "connection with $2 dburi read from a file"
+  else
+    ko "connection with $2 dburi read from a file"
+  fi
+  pgrStop
+}
+
+reqWithRoleClaimKey(){
+  export ROLE_CLAIM_KEY=$1
+  pgrStart "./configs/role-claim-key.config"
+  while pgrStarted && test "$( rootStatus )" -ne 200
+  do
+    # wait for the server to start
+    sleep 0.1 \
+    || sleep 1 # fallback: subsecond sleep is not standard and may fail
+  done
+  authorsJwt=$(psql -qtAX postgrest_test -c "select jwt.sign('$2', 'reallyreallyreallyreallyverysafe');")
+  httpStatus="$( authorsStatus "$authorsJwt" )"
+  if test "$httpStatus" -eq $3
+  then
+    ok "request with \"$1\" role-claim-key for $2 jwt: $httpStatus"
+  else
+    ko "request with \"$1\" role-claim-key for $2 jwt: $httpStatus"
+  fi
+  pgrStop
+}
+
+invalidRoleClaimKey(){
+  export ROLE_CLAIM_KEY=$1
+  pgrStart "./configs/role-claim-key.config"
+  while pgrStarted && test "$( rootStatus )" -ne 200
+  do
+    # wait for the server to start
+    sleep 0.1 \
+    || sleep 1 # fallback: subsecond sleep is not standard and may fail
+  done
+  if pgrStarted
+  then
+    ko "invalid jspath \"$1\": accepted"
+  else
+    ok "invalid jspath \"$1\": rejected"
+  fi
+  pgrStop
+}
+
+# ensure iat claim is successful in the presence of pgrst time cache, see https://github.com/PostgREST/postgrest/issues/1139
+ensureIatClaimWorks(){
+  pgrStart "./configs/simple.config"
+  while pgrStarted && test "$( rootStatus )" -ne 200
+  do
+    # wait for the server to start
+    sleep 0.1 \
+    || sleep 1 # fallback: subsecond sleep is not standard and may fail
+  done
+  for i in {1..10}; do \
+    iatJwt=$(psql -qtAX postgrest_test -c "select jwt.sign(row_to_json(r), 'reallyreallyreallyreallyverysafe') from ( select 'postgrest_test_author' as role, extract(epoch from now()) as iat) r")
+    httpStatus="$( authorsStatus $iatJwt )"
+    if test "$httpStatus" -ne 200
+    then
+      ko "iat claim rejected: $httpStatus"
+      return
+    fi
+    sleep .5;\
+  done
+  ok "iat claim accepted"
+  pgrStop
+}
+
+# ensure app settings don't reset on pool timeout of 10 seconds, see https://github.com/PostgREST/postgrest/issues/1141
+ensureAppSettings(){
+  pgrStart "./configs/app-settings.config"
+  while pgrStarted && test "$( rootStatus )" -ne 200
+  do
+    # wait for the server to start
+    sleep 0.1 \
+    || sleep 1 # fallback: subsecond sleep is not standard and may fail
+  done
+  sleep 11
+  response=$(curl -s "http://localhost:$pgrPort/rpc/get_guc_value?name=app.settings.external_api_secret")
+  if test "$response" = "\"0123456789abcdef\""
+  then
+    ok "GET /rpc/get_guc_value: $response"
+  else
+    ko "GET /rpc/get_guc_value: $response"
+  fi
+  pgrStop
+}
+
+getSocketStatus() {
+  curl -sL -w "%{http_code}\\n" -o /dev/null localhost:54321
+}
+
+socketConnection(){
+  # map port 54321 traffic to unix socket as workaround for curl below 7.40
+  # not supporting --unix-socket flag
+  ncat -vlk 54321 -c 'ncat -U /tmp/postgrest.sock' &
+  pgrStart "./configs/unix-socket.config"
+  while pgrStarted && test "$( getSocketStatus )" -ne 200
+  do
+    # wait for the server to start
+    sleep 0.1 \
+    || sleep 1 # fallback: subsecond sleep is not standard and may fail
+  done
+  if test $( getSocketStatus ) -eq 200
+  then
+    ok "Succesfully connected through unix socket"
+  else
+    ko "Failed to connect through unix socket"
+  fi
+  pgrStop
+}
+
 # PRE: curl must be available
 test -n "$(command -v curl)" || bailOut 'curl is not available'
 
@@ -89,23 +213,44 @@ psql -l 1>/dev/null 2>/dev/null || bailOut 'postgres is not running'
 
 setUp
 
-totalTests=12
+echo "Running IO tests.."
-echo "1..$totalTests"
+
+socketConnection
 
 readSecretFromFile word.noeol 'simple (no EOL)'
-skip readSecretFromFile word.txt 'simple'
+readSecretFromFile word.txt 'simple'
 readSecretFromFile ascii.noeol 'ASCII (no EOL)'
-skip readSecretFromFile ascii.txt 'ASCII'
+readSecretFromFile ascii.txt 'ASCII'
 readSecretFromFile utf8.noeol 'UTF-8 (no EOL)'
-skip readSecretFromFile utf8.txt 'UTF-8'
+readSecretFromFile utf8.txt 'UTF-8'
-skip readSecretFromFile binary.noeol 'binary'
+readSecretFromFile binary.noeol 'binary'
-skip readSecretFromFile binary.eol 'binary (+EOL)'
+readSecretFromFile binary.eol 'binary (+EOL)'
 
 readSecretFromFile word.b64 'Base64 (simple)'
 readSecretFromFile ascii.b64 'Base64 (ASCII)'
 readSecretFromFile utf8.b64 'Base64 (UTF-8)'
 readSecretFromFile binary.b64 'Base64 (binary)'
 
+readDbUriFromFile uri.noeol "(no EOL)"
+readDbUriFromFile uri.txt "(EOL)"
+
+reqWithRoleClaimKey '.postgrest.a_role' '{"postgrest":{"a_role":"postgrest_test_author"}}' 200
+reqWithRoleClaimKey '.customObject.manyRoles[1]' '{"customObject":{"manyRoles": ["other", "postgrest_test_author"]}}' 200
+reqWithRoleClaimKey '."https://www.example.com/roles"[0].value' '{"https://www.example.com/roles":[{"value":"postgrest_test_author"}]}' 200
+reqWithRoleClaimKey '.myDomain[3]' '{"myDomain":["other","postgrest_test_author"]}' 401
+reqWithRoleClaimKey '.myRole' '{"role":"postgrest_test_author"}' 401
+
+invalidRoleClaimKey 'role.other'
+invalidRoleClaimKey '.role##'
+invalidRoleClaimKey '.my_role;;domain'
+invalidRoleClaimKey '.#$%&$%/'
+invalidRoleClaimKey ''
+invalidRoleClaimKey 1234
+
+ensureIatClaimWorks
+ensureAppSettings
+
+
 cleanUp
 
 exit $failedTests

test/io-tests/configs/app-settings.config

@@ -0,0 +1,8 @@
+db-uri = "postgres:///postgrest_test"
+db-schema = "test"
+db-anon-role = "postgrest_test_anonymous"
+db-pool = 1
+server-host = "127.0.0.1"
+server-port = 49421
+
+app.settings.external_api_secret = "0123456789abcdef"

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

@@ -2,7 +2,7 @@ db-uri = "postgres:///postgrest_test"
 db-schema = "test"
 db-anon-role = "postgrest_test_anonymous"
 db-pool = 1
-server-host = "*4"
+server-host = "127.0.0.1"
 server-port = 49421
 
 # Read secret from a file: /dev/stdin (alias for standard input)

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

@@ -0,0 +1,7 @@
+db-uri = "@/dev/stdin"
+db-schema = "test"
+db-anon-role = "postgrest_test_anonymous"
+db-pool = 1
+server-host = "127.0.0.1"
+server-port = 49421
+jwt-secret = "reallyreallyreallyreallyverysafe"

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

@@ -0,0 +1,8 @@
+db-uri = "postgres:///postgrest_test"
+db-schema = "test"
+db-anon-role = "postgrest_test_anonymous"
+db-pool = 1
+server-host = "127.0.0.1"
+server-port = 49421
+role-claim-key = "$(ROLE_CLAIM_KEY)"
+jwt-secret = "reallyreallyreallyreallyverysafe"

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

@@ -2,7 +2,7 @@ db-uri = "postgres:///postgrest_test"
 db-schema = "test"
 db-anon-role = "postgrest_test_anonymous"
 db-pool = 1
-server-host = "*4"
+server-host = "127.0.0.1"
 server-port = 49421
 
 # Read secret from a file: /dev/stdin (alias for standard input)