Bump to version v6.0.2

* Add missing CHANGELOG entry for #1368

.circleci/config.yml

@@ -52,7 +52,7 @@ 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:
     docker:
       - image: circleci/buildpack-deps:trusty
         environment:
@@ -66,18 +66,33 @@ jobs:
       - 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
-            sudo mv /tmp/stack-1.1.2-linux-x86_64/stack /usr/bin
+            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 --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: 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: |
@@ -92,19 +107,8 @@ jobs:
           name: run linter
           command: git ls-files | grep '\.l\?hs$' | xargs stack exec -- hlint -X QuasiQuotes -X NoPatternSynonyms "$@"
       - run:
-          name: extra checks
-          command: |
-            stack exec -- cabal update
-            stack exec --no-ghc-package-path -- cabal install --only-d --dry-run
-            stack exec -- packdeps *.cabal || true
-            stack exec -- cabal check
-            stack haddock --no-haddock-deps
-            stack sdist
-      - save_cache:
-          paths:
-            - "~/.stack"
-            - ".stack-work"
-          key: v1-stack-dependencies-{{ checksum "postgrest.cabal" }}-{{ checksum "stack.yaml" }}
+          name: run styler
+          command: git ls-files | grep '\.l\?hs$' | xargs stack exec -- stylish-haskell -i && git diff-index --exit-code HEAD --
 
   build-test-9.6:
     docker:
@@ -123,8 +127,72 @@ jobs:
       - 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
-            sudo mv /tmp/stack-1.1.2-linux-x86_64/stack /usr/bin
+            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
+
+  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
+
+  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
@@ -156,12 +224,21 @@ jobs:
       - 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
-            sudo mv /tmp/stack-1.1.2-linux-x86_64/stack /usr/bin
+            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-prof-dependencies-{{ checksum "postgrest.cabal" }}-{{ checksum "stack.yaml" }}
       - run:
           name: build with profiling enabled
           command: |
@@ -174,16 +251,9 @@ jobs:
             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
-      - save_cache:
-          paths:
-            - "~/.stack"
-            - ".stack-work"
-          key: v1-stack-prof-dependencies-{{ checksum "postgrest.cabal" }}-{{ checksum "stack.yaml" }}
-
-  centos6:
-    <<: *build-distro-bin
 
   centos7:
     <<: *build-distro-bin
@@ -224,7 +294,7 @@ workflows:
   version: 2
   build-test-release:
     jobs:
-      - build-test:
+      - build-test-9.4:
           filters:
             tags:
               only: /v[0-9]+(\.[0-9]+)*/
@@ -232,24 +302,24 @@ workflows:
           filters:
             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]+)*/
-      - centos6:
-          requires:
-            - build-test
-            - build-test-9.6
-            - 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:
@@ -258,8 +328,10 @@ 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:
@@ -268,8 +340,10 @@ 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:
@@ -278,7 +352,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

.github/FUNDING.yml

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

.github/ISSUE_TEMPLATE.md

@@ -1,11 +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
 
-* Version of postgrest:
+* PostgreSQL version: (if using docker, specify the image)
+* PostgREST version: (if using docker, specify the image)
 * Operating system:
-* Running in docker:
-  * [ ] yes
-  * [ ] no
 
 ### Description of issue
 
-(Expected behavior vs actual behavior.)
+(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

BACKERS.md

@@ -0,0 +1,59 @@
+# 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
+
+## 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,8 +9,114 @@ This project adheres to [Semantic Versioning](http://semver.org/).
 
 ### Fixed
 
+## [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
@@ -32,7 +138,9 @@ This project adheres to [Semantic Versioning](http://semver.org/).
 
 ### Changed
 
-- Computed columns now only work if they belong to the db-schema - @steve-chavez
+- #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:

Makefile

@@ -0,0 +1,40 @@
+.PHONY: check clean lint style test test-watch coverage circleci circleci-prof-test check-dburi prompt-clean prompt-long-process
+
+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
+
+
+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,19 +1,47 @@
-![Logo](static/logo.png "Logo")
+![Logo](static/bigger-logo.png "Logo")
 
-[![Build Status](https://circleci.com/gh/PostgREST/postgrest/tree/master.svg?style=shield)](https://circleci.com/gh/PostgREST/postgrest/tree/master)
+[![Donate](https://img.shields.io/badge/Donate-Patreon-orange.svg?colorB=F96854)](https://www.patreon.com/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.org)
 [![Docker Stars](https://img.shields.io/docker/pulls/postgrest/postgrest.svg)](https://hub.docker.com/r/postgrest/postgrest/)
-[![Donate](https://img.shields.io/badge/patreon-donate-orange.svg?colorB=F96854)](https://www.patreon.com/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
+
+<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.
@@ -22,13 +50,15 @@ API than you are likely to write from scratch.
     ```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
-(or named after precious gems), prepare to be pleasantly surprised by
-PostgREST performance.
+free tier. If you're used to servers written in interpreted languages, 
+prepare to be pleasantly surprised by PostgREST performance.
 
 Three factors contribute to the speed. First the server is written
 in [Haskell](https://www.haskell.org/) using the
@@ -51,7 +81,7 @@ by
 * Using the PostgreSQL binary protocol
 * Being stateless to allow horizontal scaling
 
-### Security
+## Security
 
 PostgREST [handles
 authentication](http://postgrest.org/en/stable/auth.html) (via JSON Web
@@ -72,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
@@ -80,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
@@ -92,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
@@ -106,12 +136,22 @@ See examples of [PostgreSQL
 constraints](http://www.tutorialspoint.com/postgresql/postgresql_constraints.htm)
 and the [API guide](http://postgrest.org/en/stable/api.html).
 
-### Thanks
+## Supporting development
 
-The PostgREST organization is grateful to the generous 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).
+You can help PostgREST ongoing maintenance and development by:
+
+- Making a regular donation through Patreon https://www.patreon.com/postgrest
+
+- 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,7 +1,7 @@
 {
   "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/PostgREST/postgrest",
   "env": {
     "BUILDPACK_URL": {
@@ -10,10 +10,10 @@
     },
     "POSTGREST_VER": {
       "description": "Version of PostgREST to deploy",
-      "value": "0.5.0.0"
+      "value": "6.0.2"
     },
     "DB_URI": {
-      "description": "Database connection string",
+      "description": "Database connection string, e.g. postgres://user:pass@xxxxxxx.rds.amazonaws.com/mydb",
       "required": true
     },
     "DB_SCHEMA": {

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 -j1 --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
-- 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 7z a -tzip postgrest-%APPVEYOR_REPO_TAG_NAME%-windows-x64.zip postgrest.exe
+- 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,4 @@
-FROM debian:jessie
+FROM debian:stretch-slim
 
 ARG POSTGREST_VERSION
 
@@ -28,6 +28,7 @@ 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_URI= \
@@ -35,7 +36,16 @@ ENV PGRST_DB_URI= \
     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 postgresql93-devel
+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 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,6 +2,7 @@ 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)"
@@ -10,6 +11,9 @@ server-proxy-uri = "$(PGRST_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,44 +2,51 @@
 
 module Main where
 
+import qualified Data.ByteString            as BS
+import qualified Data.ByteString.Base64     as B64
+import qualified Hasql.Pool                 as P
+import qualified Hasql.Transaction.Sessions as HT
 
-import           PostgREST.App            (postgrest)
-import           PostgREST.Config         (AppConfig (..),
-                                           minimumPgVersion,
-                                           prettyVersion, readOptions)
-import           PostgREST.DbStructure    (getDbStructure, getPgVersion,
-                                           fillSessionWithSettings)
-import           PostgREST.Error          (encodeError)
-import           PostgREST.OpenAPI        (isMalformedProxyUri)
-import           PostgREST.Types          (DbStructure, Schema, PgVersion(..))
-import           Protolude                hiding (hPutStrLn, replace)
+import Control.AutoUpdate       (defaultUpdateSettings, mkAutoUpdate,
+                                 updateAction)
+import Control.Retry            (RetryStatus, capDelay,
+                                 exponentialBackoff, retrying,
+                                 rsPreviousDelay)
+import Data.IORef               (IORef, atomicWriteIORef, newIORef,
+                                 readIORef)
+import Data.String              (IsString (..))
+import Data.Text                (pack, replace, strip, stripPrefix,
+                                 unpack)
+import Data.Text.Encoding       (decodeUtf8, encodeUtf8)
+import Data.Text.IO             (hPutStrLn, readFile)
+import Data.Time.Clock          (getCurrentTime)
+import Network.Socket           (Family (AF_UNIX),
+                                 SockAddr (SockAddrUnix), Socket,
+                                 SocketType (Stream), bind, close,
+                                 defaultProtocol, listen,
+                                 maxListenQueue, socket)
+import Network.Wai.Handler.Warp (defaultSettings, runSettings,
+                                 runSettingsSocket, setHost, setPort,
+                                 setServerName)
+import System.Directory         (removeFile)
+import System.IO                (BufferMode (..), hSetBuffering)
+import System.IO.Error          (isDoesNotExistError)
 
+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, replace)
 
-import           Control.AutoUpdate       (defaultUpdateSettings,
-                                           mkAutoUpdate, updateAction)
-import           Control.Retry            (RetryStatus, capDelay,
-                                           exponentialBackoff,
-                                           retrying, rsPreviousDelay)
-import qualified Data.ByteString          as BS
-import qualified Data.ByteString.Base64   as B64
-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)
-import           Data.Time.Clock          (getCurrentTime)
-import qualified Hasql.Pool               as P
-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
 #endif
 
 {-|
@@ -64,11 +71,10 @@ connectionWorker
   :: ThreadId -- ^ This thread is killed if pg version is unsupported
   -> P.Pool   -- ^ The PostgreSQL connection pool
   -> Schema   -- ^ Schema PostgREST is serving up
-  -> [(Text, Text)] -- ^ Settings or Environment passed in through the config
   -> IORef (Maybe DbStructure) -- ^ mutable reference to 'DbStructure'
   -> IORef Bool                -- ^ Used as a binary Semaphore
   -> IO ()
-connectionWorker mainTid pool schema settings refDbStructure refIsWorkerOn = do
+connectionWorker mainTid pool schema refDbStructure refIsWorkerOn = do
   isWorkerOn <- readIORef refIsWorkerOn
   unless isWorkerOn $ do
     atomicWriteIORef refIsWorkerOn True
@@ -77,26 +83,24 @@ connectionWorker mainTid pool schema settings refDbStructure refIsWorkerOn = do
     work = do
       atomicWriteIORef refDbStructure Nothing
       putStrLn ("Attempting to connect to the database..." :: Text)
-      connected <- connectingSucceeded pool
-      when connected $ do
-        result <- P.use pool $ do
-          actualPgVersion <- getPgVersion
-          unless (actualPgVersion >= minimumPgVersion) $ liftIO $ do
-            hPutStrLn stderr
-              ("Cannot run in this PostgreSQL version, PostgREST needs at least "
-              <> pgvName minimumPgVersion)
-            killThread mainTid
-          fillSessionWithSettings settings
-          dbStructure <- getDbStructure schema actualPgVersion
-          liftIO $ atomicWriteIORef refDbStructure $ Just dbStructure
-        case result of
-          Left e -> do
-            putStrLn ("Failed to query the database. Retrying." :: Text)
-            hPutStrLn stderr (toS $ encodeError e)
-            work
-          Right _ -> do
-            atomicWriteIORef refIsWorkerOn False
-            putStrLn ("Connection successful" :: Text)
+      connected <- connectionStatus pool
+      case connected of
+        FatalConnectionError reason -> hPutStrLn stderr reason
+                                      >> killThread mainTid    -- Fatal error when connecting
+        NotConnected                -> return ()               -- Unreachable
+        Connected actualPgVersion   -> do                      -- Procede with initialization
+          result <- P.use pool $ do
+            dbStructure <- HT.transaction HT.ReadCommitted HT.Read $ getDbStructure schema actualPgVersion
+            liftIO $ atomicWriteIORef refDbStructure $ Just dbStructure
+          case result of
+            Left e -> do
+              putStrLn ("Failed to query the database. Retrying." :: Text)
+              hPutStrLn stderr . toS . errorPayload $ PgError False e
+              work
+
+            Right _ -> do
+              atomicWriteIORef refIsWorkerOn False
+              putStrLn ("Connection successful" :: Text)
 
 {-|
   Used by 'connectionWorker' to check if the provided db-uri lets
@@ -107,26 +111,37 @@ connectionWorker mainTid pool schema settings 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
-connectingSucceeded pool =
+connectionStatus :: P.Pool -> IO ConnectionStatus
+connectionStatus pool =
   retrying (capDelay 32000000 $ exponentialBackoff 1000000)
            shouldRetry
-           (const $ P.release pool >> isConnectionSuccessful)
+           (const $ P.release pool >> getConnectionStatus)
   where
-    isConnectionSuccessful :: IO Bool
-    isConnectionSuccessful = do
-      testConn <- P.use pool $ H.sql "SELECT 1"
-      case testConn of
-        Left e -> hPutStrLn stderr (toS $ encodeError e) >> pure False
-        _ -> pure True
-    shouldRetry :: RetryStatus -> Bool -> IO Bool
+    getConnectionStatus :: IO ConnectionStatus
+    getConnectionStatus = do
+      pgVersion <- P.use pool getPgVersion
+      case pgVersion of
+        Left e -> do
+          let err = PgError False e
+          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
-      itShould <- pure $ not isConnSucc
+      let delay    = fromMaybe 0 (rsPreviousDelay rs) `div` 1000000
+          itShould = NotConnected == isConnSucc
       when itShould $
         putStrLn $ "Attempting to reconnect to the database in " <> (show delay::Text) <> " seconds..."
       return itShould
 
+
 {-|
   This is where everything starts.
 -}
@@ -143,17 +158,17 @@ 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
       port = configPort conf
       proxy = configProxyUri conf
+      maybeSocketAddr = configSocket 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)
-        . setTimeout 3600 $
+        . setServerName (toS $ "postgrest/" <> prettyVersion) $
         defaultSettings
 
   -- Checks that the provided proxy uri is formated correctly
@@ -165,11 +180,10 @@ main = do
   when (isLeft roleClaimKey) $
     panic $ show roleClaimKey
 
-  putStrLn $ ("Listening on port " :: Text) <> show (configPort conf)
   --
   -- 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
@@ -186,7 +200,6 @@ main = do
     mainTid
     pool
     (configSchema conf)
-    (configSettings conf)
     refDbStructure
     refIsWorkerOn
   --
@@ -204,12 +217,11 @@ main = do
         throwTo mainTid UserInterrupt
       ) Nothing
 
-  void $ installHandler sigHUP (
+  void $ installHandler sigUSR1 (
     Catch $ connectionWorker
               mainTid
               pool
               (configSchema conf)
-              (configSettings conf)
               refDbStructure
               refIsWorkerOn
     ) Nothing
@@ -219,20 +231,31 @@ main = do
   -- ask for the OS time at most once per second
   getTime <- mkAutoUpdate defaultUpdateSettings {updateAction = getCurrentTime}
 
-  -- run the postgrest application
-  runSettings appSettings $
-    postgrest
-      conf
-      refDbStructure
-      pool
-      getTime
-      (connectionWorker
-         mainTid
-         pool
-         (configSchema conf)
-         (configSettings conf)
-         refDbStructure
-         refIsWorkerOn)
+  let postgrestApplication =
+        postgrest
+          conf
+          refDbStructure
+          pool
+          getTime
+          (connectionWorker
+             mainTid
+             pool
+             (configSchema conf)
+             refDbStructure
+             refIsWorkerOn)
+    in case maybeSocketAddr of
+         Nothing -> do
+             -- run the postgrest application
+             putStrLn $ ("Listening on port " :: Text) <> show (configPort conf)
+             runSettings appSettings postgrestApplication
+         Just socketAddr -> do
+             -- run postgrest application with user defined socket
+             sock <- createAndBindSocket (unpack socketAddr)
+             listen sock maxListenQueue
+             putStrLn $ ("Listening on unix socket " :: Text) <> show socketAddr
+             runSettingsSocket appSettings sock postgrestApplication
+             -- clean socket up when done
+             close sock
 
 {-|
   The purpose of this function is to load the JWT secret from a file if
@@ -285,3 +308,30 @@ 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}
+
+createAndBindSocket :: FilePath -> IO Socket
+createAndBindSocket filePath = do
+  deleteSocketFileIfExist filePath
+  sock <- socket AF_UNIX Stream defaultProtocol
+  bind sock $ SockAddrUnix filePath
+  return sock
+  where
+    deleteSocketFileIfExist path = removeFile path `catch` handleDoesNotExist
+    handleDoesNotExist e
+      | isDoesNotExistError e = return ()
+      | otherwise = throwIO e

postgrest.cabal

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

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

@@ -1,43 +1,53 @@
-{-# LANGUAGE LambdaCase #-}
 {-|
 Module      : PostgREST.ApiRequest
 Description : PostgREST functions to translate HTTP request to a domain type called ApiRequest.
 -}
-module PostgREST.ApiRequest ( ApiRequest(..)
-                            , ContentType(..)
-                            , Action(..)
-                            , Target(..)
-                            , PreferRepresentation (..)
-                            , mutuallyAgreeable
-                            , userApiRequest
-                            ) where
+{-# LANGUAGE LambdaCase #-}
 
-import           Protolude
-import qualified Data.Aeson                as JSON
-import           Data.Aeson.Types          (emptyObject, emptyArray)
-import qualified Data.ByteString           as BS
-import qualified Data.ByteString.Internal  as BS (c2w)
-import qualified Data.ByteString.Lazy      as BL
-import qualified Data.Csv                  as CSV
-import qualified Data.List                 as L
-import           Data.List                 (lookup, last, partition)
-import qualified Data.HashMap.Strict       as M
-import qualified Data.Set                  as S
-import           Data.Maybe                (fromJust)
-import           Control.Arrow             ((***))
-import qualified Data.Text                 as T
-import qualified Data.Vector               as V
-import           Network.HTTP.Base         (urlEncodeVars)
-import           Network.HTTP.Types.Header (hAuthorization, hCookie)
-import           Network.HTTP.Types.URI    (parseSimpleQuery)
-import           Network.Wai               (Request (..))
-import           Network.Wai.Parse         (parseHttpAccept)
-import           PostgREST.RangeQuery      (NonnegRange, rangeRequested, restrictRange, rangeGeq, allRange, rangeLimit, rangeOffset)
-import           Data.Ranged.Boundaries
-import           PostgREST.Types
-import           Data.Ranged.Ranges        (Range(..), rangeIntersection, emptyRange)
-import qualified Data.CaseInsensitive      as CI
-import           Web.Cookie                (parseCookiesText)
+module PostgREST.ApiRequest (
+  ApiRequest(..)
+, ContentType(..)
+, Action(..)
+, Target(..)
+, PreferRepresentation (..)
+, mutuallyAgreeable
+, userApiRequest
+) where
+
+import qualified Data.Aeson           as JSON
+import qualified Data.ByteString      as BS
+import qualified Data.ByteString.Lazy as BL
+import qualified Data.CaseInsensitive as CI
+import qualified Data.Csv             as CSV
+import qualified Data.HashMap.Strict  as M
+import qualified Data.List            as L
+import qualified Data.Set             as S
+import qualified Data.Text            as T
+import qualified Data.Vector          as V
+
+import Control.Arrow             ((***))
+import Data.Aeson.Types          (emptyArray, emptyObject)
+import Data.List                 (last, lookup, partition)
+import Data.Maybe                (fromJust)
+import Data.Ranged.Ranges        (Range (..), emptyRange,
+                                  rangeIntersection)
+import Network.HTTP.Base         (urlEncodeVars)
+import Network.HTTP.Types.Header (hAuthorization, hCookie)
+import Network.HTTP.Types.URI    (parseQueryReplacePlus,
+                                  parseSimpleQuery)
+import Network.Wai               (Request (..))
+import Network.Wai.Parse         (parseHttpAccept)
+import Web.Cookie                (parseCookiesText)
+
+
+import Data.Ranged.Boundaries
+
+import PostgREST.Error      (ApiRequestError (..))
+import PostgREST.RangeQuery (NonnegRange, allRange, rangeGeq,
+                             rangeLimit, rangeOffset, rangeRequested,
+                             restrictRange)
+import PostgREST.Types
+import Protolude
 
 type RequestBody = BL.ByteString
 
@@ -49,8 +59,8 @@ data Action = ActionCreate  | ActionRead
             deriving Eq
 -- | The target db object of a user action
 data Target = TargetIdent QualifiedIdentifier
-            | TargetProc  QualifiedIdentifier
-            | TargetRoot
+            | TargetProc{tpQi :: QualifiedIdentifier, tpIsRootSpec :: Bool}
+            | TargetDefaultSpec -- The default spec offered at root "/"
             | TargetUnknown [Text]
             deriving Eq
 -- | How to return the inserted data
@@ -65,53 +75,54 @@ data PreferRepresentation = Full | HeadersOnly | None deriving Eq
 -}
 data ApiRequest = ApiRequest {
   -- | Similar but not identical to HTTP verb, e.g. Create/Invoke both POST
-    iAction :: Action
+    iAction                      :: Action
   -- | Requested range of rows within response
-  , iRange  :: M.HashMap ByteString NonnegRange
+  , iRange                       :: M.HashMap ByteString NonnegRange
   -- | The target, be it calling a proc or accessing a table
-  , iTarget :: Target
+  , iTarget                      :: Target
   -- | Content types the client will accept, [CTAny] if no Accept header
-  , iAccepts :: [ContentType]
+  , iAccepts                     :: [ContentType]
   -- | Data sent by client and used for mutation actions
-  , iPayload :: Maybe PayloadJSON
+  , iPayload                     :: Maybe PayloadJSON
   -- | If client wants created items echoed back
-  , iPreferRepresentation :: PreferRepresentation
+  , iPreferRepresentation        :: PreferRepresentation
   -- | Pass all parameters as a single json object to a stored procedure
   , iPreferSingleObjectParameter :: Bool
   -- | Whether the client wants a result count (slower)
-  , iPreferCount :: Bool
+  , iPreferCount                 :: Bool
   -- | Whether the client wants to UPSERT or ignore records on PK conflict
-  , iPreferResolution :: Maybe PreferResolution
+  , iPreferResolution            :: Maybe PreferResolution
   -- | Filters on the result ("id", "eq.10")
-  , iFilters :: [(Text, Text)]
+  , iFilters                     :: [(Text, Text)]
   -- | &and and &or parameters used for complex boolean logic
-  , iLogic :: [(Text, Text)]
+  , iLogic                       :: [(Text, Text)]
   -- | &select parameter used to shape the response
-  , iSelect :: Text
+  , iSelect                      :: Text
+  -- | &columns parameter used to shape the payload
+  , iColumns                     :: Maybe Text
   -- | &order parameters for each level
-  , iOrder :: [(Text, Text)]
+  , iOrder                       :: [(Text, Text)]
   -- | Alphabetized (canonical) request query string for response URLs
-  , iCanonicalQS :: ByteString
+  , iCanonicalQS                 :: ByteString
   -- | JSON Web Token
-  , iJWT :: Text
+  , iJWT                         :: Text
   -- | HTTP request headers
-  , iHeaders :: [(Text, Text)]
+  , iHeaders                     :: [(Text, Text)]
   -- | Request Cookies
-  , iCookies :: [(Text, Text)]
+  , iCookies                     :: [(Text, Text)]
   }
 
 -- | Examines HTTP request and translates it into user intent.
-userApiRequest :: Schema -> Request -> RequestBody -> Either ApiRequestError ApiRequest
-userApiRequest schema req reqBody
+userApiRequest :: Schema -> Maybe QualifiedIdentifier -> Request -> RequestBody -> Either ApiRequestError ApiRequest
+userApiRequest schema rootSpec req reqBody
   | isTargetingProc && method `notElem` ["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] $
-        map decodeContentType . parseHttpAccept <$> lookupHeader "accept"
+      , iAccepts = maybe [CTAny] (map decodeContentType . parseHttpAccept) $ lookupHeader "accept"
       , iPayload = relevantPayload
       , iPreferRepresentation = representation
       , iPreferSingleObjectParameter = singleObject
@@ -121,51 +132,64 @@ userApiRequest schema req reqBody
                             else 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 $ fromMaybe "*" $ join $ lookup "select" qParams
+      , iColumns = columns
       , iOrder = [(toS k, toS $ fromJust v) | (k,v) <- qParams, isJust v, endingIn ["order"] k ]
       , iCanonicalQS = toS $ urlEncodeVars
-        . L.sortBy (comparing fst)
-        . map (join (***) toS)
-        . parseSimpleQuery
-        $ rawQueryString req
+        . L.sortOn fst
+        . map (join (***) toS . second (fromMaybe BS.empty))
+        $ qString
       , iJWT = tokenStr
       , iHeaders = [ (toS $ CI.foldedCase k, toS v) | (k,v) <- hdrs, k /= hAuthorization, k /= hCookie]
-      , iCookies = fromMaybe [] $ parseCookiesText <$> lookupHeader "Cookie"
+      , iCookies = maybe [] parseCookiesText $ lookupHeader "Cookie"
       }
  where
+  -- 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{isReadOnly=True} -> partition (liftM2 (||) (isEmbedPath . fst) (hasOperator . snd)) flts
       _ -> (flts, [])
-  flts = [ (toS k, toS $ fromJust v) | (k,v) <- qParams, isJust v, k /= "select", not (endingIn ["order", "limit", "offset", "and", "or"] k) ]
+  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 = fromMaybe False $ (== "rpc") <$> listToMaybe path
+  isTargetingProc = case target of
+    TargetProc _ _ -> True
+    _              -> False
+  contentType = decodeContentType . fromMaybe "application/json" $ lookupHeader "content-type"
+  columns | action `elem` [ActionCreate, ActionUpdate, ActionInvoke{isReadOnly=False}] = toS <$> join (lookup "columns" qParams)
+          | otherwise = Nothing
   payload =
-    case (decodeContentType . fromMaybe "application/json" $ lookupHeader "content-type", action) of
+    case (contentType, action) of
       (_, ActionInvoke{isReadOnly=True}) ->
-        Right $ PayloadJSON (JSON.encode $ M.fromList $ second JSON.toJSON <$> rpcQParams) PJObject (S.fromList $ fst <$> rpcQParams)
+        Right $ ProcessedJSON (JSON.encode $ M.fromList $ second JSON.toJSON <$> rpcQParams) PJObject (S.fromList $ fst <$> rpcQParams)
       (CTApplicationJSON, _) ->
-        note "All object keys must match" . payloadAttributes reqBody
-          =<< if BL.null reqBody && isTargetingProc
-               then Right emptyObject
-               else JSON.eitherDecode reqBody
+        if isJust columns
+          then Right $ RawJSON reqBody
+          else note "All object keys must match" . payloadAttributes reqBody
+                 =<< if BL.null reqBody && isTargetingProc
+                       then Right emptyObject
+                       else JSON.eitherDecode reqBody
       (CTTextCSV, _) -> do
         json <- csvToJson <$> CSV.decodeByName reqBody
         note "All lines must have same number of fields" $ payloadAttributes (JSON.encode json) json
       (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 $ PayloadJSON (JSON.encode json) PJObject keys
+        Right $ ProcessedJSON (JSON.encode json) PJObject keys
       (ct, _) ->
         Left $ toS $ "Content-Type not acceptable: " <> toMime ct
   topLevelRange = fromMaybe allRange $ M.lookup "limit" ranges
   action =
     case method of
-      "GET"      | target == TargetRoot -> ActionInspect
+      "GET"      | target == TargetDefaultSpec -> ActionInspect
                  | isTargetingProc -> ActionInvoke{isReadOnly=True}
                  | otherwise -> ActionRead
 
@@ -178,19 +202,20 @@ userApiRequest schema req reqBody
       "OPTIONS" -> ActionInfo
       _         -> ActionInspect
   target = case path of
-              []            -> TargetRoot
-              [table]       -> TargetIdent
-                              $ QualifiedIdentifier schema table
-              ["rpc", proc] -> TargetProc
-                              $ QualifiedIdentifier schema proc
-              other         -> TargetUnknown other
+    []            -> case rootSpec of
+                       Just rsQi -> TargetProc rsQi True
+                       Nothing   -> TargetDefaultSpec
+    [table]       -> TargetIdent $ QualifiedIdentifier schema table
+    ["rpc", proc] -> TargetProc (QualifiedIdentifier schema proc) False
+    other         -> TargetUnknown other
+
   shouldParsePayload = action `elem` [ActionCreate, ActionUpdate, ActionSingleUpsert, ActionInvoke{isReadOnly=False}, ActionInvoke{isReadOnly=True}]
   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
@@ -215,7 +240,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
@@ -238,23 +263,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)
 
 {-|
@@ -292,14 +300,14 @@ payloadAttributes raw json =
                 JSON.Object x -> S.fromList (M.keys x) == canonicalKeys
                 _ -> False) arr in
           if areKeysUniform
-            then Just $ PayloadJSON raw (PJArray $ V.length arr) canonicalKeys
+            then Just $ ProcessedJSON raw (PJArray $ V.length arr) canonicalKeys
             else Nothing
         Just _ -> Nothing
         Nothing -> Just emptyPJArray
 
-    JSON.Object o -> Just $ PayloadJSON raw PJObject (S.fromList $ M.keys o)
+    JSON.Object o -> Just $ ProcessedJSON raw PJObject (S.fromList $ M.keys o)
 
     -- truncate everything else to an empty array.
     _ -> Just emptyPJArray
   where
-    emptyPJArray = PayloadJSON (JSON.encode emptyArray) (PJArray 0) S.empty
+    emptyPJArray = ProcessedJSON (JSON.encode emptyArray) (PJArray 0) S.empty

src/PostgREST/App.hs

@@ -1,144 +1,128 @@
 {-# LANGUAGE FlexibleContexts    #-}
+{-# LANGUAGE NamedFieldPuns      #-}
 {-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE NamedFieldPuns #-}
 
 module PostgREST.App (
   postgrest
 ) where
 
-import           Control.Applicative
-import           Data.Aeson                as JSON
-import qualified Data.ByteString.Char8     as BS
-import           Data.Maybe
-import           Data.IORef                (IORef, readIORef)
-import           Data.Text                 (intercalate)
-import           Data.Time.Clock           (UTCTime)
-import qualified Data.Set                  as S
-
+import qualified Data.ByteString.Char8      as BS
+import qualified Data.HashMap.Strict        as M
+import qualified Data.List                  as L (union)
+import qualified Data.Set                   as S
 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           Network.HTTP.Types.Status
-import           Network.HTTP.Types.URI    (renderSimpleQuery)
-import           Network.Wai
-import           Network.Wai.Middleware.RequestLogger (logStdout)
+import Data.Aeson                           as JSON
+import Data.Function                        (id)
+import Data.IORef                           (IORef, readIORef)
+import Data.Time.Clock                      (UTCTime)
+import Network.HTTP.Types.URI               (renderSimpleQuery)
+import Network.Wai.Middleware.RequestLogger (logStdout)
 
-import qualified Hasql.Transaction         as H
+import Control.Applicative
+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   ( ApiRequest(..), ContentType(..)
-                                        , Action(..), Target(..)
-                                        , 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, gucHeadersError
-                                           )
-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)
+import PostgREST.ApiRequest       (Action (..), ApiRequest (..),
+                                   ContentType (..),
+                                   PreferRepresentation (..),
+                                   Target (..), mutuallyAgreeable,
+                                   userApiRequest)
+import PostgREST.Auth             (containsRole, jwtClaims,
+                                   parseSecret)
+import PostgREST.Config           (AppConfig (..))
+import PostgREST.DbRequestBuilder (fieldNames, 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     (ResultsWithCount, callProc,
+                                   createReadStatement,
+                                   createWriteStatement,
+                                   requestToCountQuery,
+                                   requestToQuery)
+import PostgREST.RangeQuery       (allRange, rangeOffset)
+import PostgREST.Types
+import Protolude                  hiding (Proxy, intercalate)
 
 postgrest :: AppConfig -> IORef (Maybe DbStructure) -> P.Pool -> IO UTCTime -> IO () -> Application
 postgrest conf refDbStructure pool getTime 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
-          Left err -> return $ apiRequestError err
-          Right apiRequest -> do
-            eClaims <- jwtClaims jwtSecret (configJwtAudience conf) (toS $ iJWT apiRequest) time (rightToMaybe $ configRoleClaimKey conf)
-
-            let authed = containsRole eClaims
-                proc = case (iTarget apiRequest, iPayload apiRequest, iPreferSingleObjectParameter apiRequest) of
-                  (TargetProc qi, Just PayloadJSON{pjKeys}, s) -> findProc qi pjKeys s $ dbProcs dbStructure
-                  _ -> Nothing
-                handleReq = runWithClaims conf eClaims (app dbStructure proc conf) apiRequest
-                txMode = transactionMode proc (iAction apiRequest)
-            response <- P.use pool $ HT.transaction HT.ReadCommitted txMode handleReq
-            return $ either (pgError authed) identity response
+        response <- do
+          -- Need to parse ?columns early because findProc needs it to solve overloaded functions
+          let apiReq = userApiRequest (configSchema conf) (configRootSpec conf) req body
+              apiReqCols = (,) <$> apiReq <*> (pRequestColumns =<< iColumns <$> apiReq)
+          case apiReqCols of
+            Left err -> return . errorResponseFor $ err
+            Right (apiRequest, maybeCols) -> do
+              eClaims <- jwtClaims jwtSecret (configJwtAudience conf) (toS $ iJWT apiRequest) time (rightToMaybe $ configRoleClaimKey conf)
+              let authed = containsRole eClaims
+                  cols = case (iPayload apiRequest, maybeCols) of
+                    (Just ProcessedJSON{pjKeys}, _) -> pjKeys
+                    (Just RawJSON{}, Just cls)      -> cls
+                    _                               -> S.empty
+                  proc = case iTarget apiRequest of
+                    TargetProc qi _ -> findProc qi cols (iPreferSingleObjectParameter apiRequest) $ 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
 
-findProc :: QualifiedIdentifier -> S.Set Text -> Bool -> M.HashMap Text [ProcDescription] -> Maybe ProcDescription
-findProc qi payloadKeys paramsAsSingleObject allProcs =
-  let procs = M.lookup (qiName qi) allProcs in
- -- Handle overloaded functions case
-  join $ (case length <$> procs of
-    Just 1 -> headMay -- if it's not an overloaded function then immediatly get the ProcDescription
-    _ -> find (\x ->
-           if paramsAsSingleObject
-             then length (pdArgs x) == 1 -- if the arg is not of json type let the db give the err
-             else payloadKeys `S.isSubsetOf` S.fromList (pgaName <$> pdArgs x))
-  ) <$> procs
-
-transactionMode :: Maybe ProcDescription -> Action -> H.Mode
+transactionMode :: Maybe ProcDescription -> Action -> HT.Mode
 transactionMode proc action =
   case action of
     ActionRead -> HT.Read
     ActionInfo -> HT.Read
     ActionInspect -> HT.Read
     ActionInvoke{isReadOnly=False} ->
-      let v = fromMaybe Volatile $ pdVolatility <$> proc in
+      let v = maybe Volatile pdVolatility proc in
       if v == Stable || v == Immutable
          then HT.Read
          else HT.Write
     ActionInvoke{isReadOnly=True} -> HT.Read
     _ -> HT.Write
 
-app :: DbStructure -> Maybe ProcDescription -> AppConfig -> ApiRequest -> H.Transaction Response
-app dbStructure proc conf apiRequest =
-  case responseContentTypeOrError (iAccepts apiRequest) (iAction apiRequest) of
+app :: DbStructure -> Maybe ProcDescription -> S.Set FieldName -> AppConfig -> ApiRequest -> H.Transaction Response
+app dbStructure proc cols conf apiRequest =
+  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) ->
           let partsField = (,) <$> readSqlParts
-                <*> (binaryField contentType =<< fldNames) in
+                <*> (binaryField contentType rawContentTypes =<< fldNames) in
           case partsField of
             Left errorResponse -> return errorResponse
             Right ((q, cq), bField) -> do
               let stm = createReadStatement q cq (contentType == CTSingularJSON) shouldCount
                                             (contentType == CTTextCSV) bField
-              row <- H.query () stm
+              row <- H.statement () stm
               let (tableTotal, queryTotal, _ , body) = row
                   (status, contentRange) = rangeHeader queryTotal tableTotal
                   canonical = iCanonicalQS apiRequest
               return $
                 if contentType == CTSingularJSON && queryTotal /= 1
-                  then singularityError (toInteger queryTotal)
+                  then errorResponseFor . singularityError $ queryTotal
                   else responseLBS status
                     [toHeader contentType, contentRange,
                       ("Content-Location",
@@ -147,85 +131,88 @@ app dbStructure proc conf apiRequest =
                       )
                     ] (toS body)
 
-        (ActionCreate, TargetIdent (QualifiedIdentifier tSchema tName), Just PayloadJSON{pjRaw, pjType}) ->
+        (ActionCreate, TargetIdent (QualifiedIdentifier tSchema tName), Just pJson) ->
           case mutateSqlParts tSchema tName of
             Left errorResponse -> return errorResponse
             Right (sq, mq) -> do
-              let (isSingle, nRows) = case pjType of
-                                        PJArray len -> (len == 1, len)
-                                        PJObject -> (True, 1)
-              if contentType == CTSingularJSON
-                 && not isSingle
-                 && iPreferRepresentation apiRequest == Full
-                then return $ singularityError (toInteger nRows)
-                else do
-                  let pkCols = tablePKCols dbStructure tSchema tName
-                      stm = createWriteStatement sq mq
-                        (contentType == CTSingularJSON) isSingle
-                        (contentType == CTTextCSV) (iPreferRepresentation apiRequest) pkCols
-                  row <- H.query (toS pjRaw) stm
-                  let (_, _, fs, body) = extractQueryResult row
-                      headers = catMaybes [
-                          if null fs
-                            then Nothing
-                            else Just (hLocation, "/" <> toS tName <> renderLocationFields fs)
-                        , if iPreferRepresentation apiRequest == Full
-                            then Just $ toHeader contentType
-                            else Nothing
-                        , Just . contentRangeH 1 0 $
-                            toInteger <$> if shouldCount then Just nRows else Nothing
-                        , if null pkCols
-                            then Nothing
-                            else (\x -> ("Preference-Applied", show x)) <$> iPreferResolution apiRequest
-                        ]
-
-                  return . responseLBS status201 headers $
-                    if iPreferRepresentation apiRequest == Full
-                      then toS body else ""
-
-        (ActionUpdate, TargetIdent (QualifiedIdentifier tSchema tName), Just p@PayloadJSON{pjRaw}) ->
-          case (mutateSqlParts tSchema tName, pjIsEmpty p, iPreferRepresentation apiRequest == Full) of
-            (Left errorResponse, _, _) -> return errorResponse
-            (_, True, True) -> return $ responseLBS status200 [contentRangeH 1 0 Nothing] "[]"
-            (_, 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) []
-              row <- H.query (toS pjRaw) stm
-              let (_, queryTotal, _, body) = extractQueryResult row
+              let pkCols = tablePKCols dbStructure tSchema tName
+                  stm = createWriteStatement sq mq
+                    (contentType == CTSingularJSON) True
+                    (contentType == CTTextCSV) (iPreferRepresentation apiRequest) pkCols
+              row <- H.statement (toS $ pjRaw pJson) stm
+              let (_, queryTotal, fs, body) = extractQueryResult row
+                  headers = catMaybes [
+                      if null fs
+                        then Nothing
+                        else Just (hLocation, "/" <> toS tName <> renderLocationFields fs)
+                    , if iPreferRepresentation apiRequest == Full
+                        then Just $ toHeader contentType
+                        else Nothing
+                    , Just $ contentRangeH 1 0 $
+                        if shouldCount then Just queryTotal else Nothing
+                    , if null pkCols
+                        then Nothing
+                        else (\x -> ("Preference-Applied", show x)) <$> iPreferResolution apiRequest
+                    ]
               if contentType == CTSingularJSON
                  && queryTotal /= 1
                  && iPreferRepresentation apiRequest == Full
                 then do
                   HT.condemn
-                  return $ singularityError (toInteger queryTotal)
-                else do
-                  let r = contentRangeH 0 (toInteger $ queryTotal-1)
-                            (toInteger <$> if shouldCount then Just queryTotal else Nothing)
-                      s = if iPreferRepresentation apiRequest == Full
-                            then status200
-                            else status204
-                  return $ if iPreferRepresentation apiRequest == Full
-                    then responseLBS s [toHeader contentType, r] (toS body)
-                    else responseLBS s [r] ""
+                  return . errorResponseFor . singularityError $ queryTotal
+              else
+                return . responseLBS status201 headers $
+                  if iPreferRepresentation apiRequest == Full
+                    then toS body else ""
 
-        (ActionSingleUpsert, TargetIdent (QualifiedIdentifier tSchema tName), Just PayloadJSON{pjRaw, pjType, pjKeys}) ->
+        (ActionUpdate, TargetIdent (QualifiedIdentifier tSchema tName), Just pJson) ->
+          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) []
+              row <- H.statement (toS $ pjRaw pJson) stm
+              let (_, queryTotal, _, body) = extractQueryResult row
+
+                  updateIsNoOp       = S.null cols
+                  contentRangeHeader = contentRangeH 0 (queryTotal - 1) $
+                                          if shouldCount then Just queryTotal else Nothing
+                  minimalHeaders     = [contentRangeHeader]
+                  fullHeaders        = toHeader contentType : minimalHeaders
+
+                  status | queryTotal == 0 && not updateIsNoOp      = status404
+                         | iPreferRepresentation apiRequest == Full = status200
+                         | otherwise                                = status204
+
+              case (contentType, iPreferRepresentation apiRequest) of
+                (CTSingularJSON, Full)
+                      | queryTotal == 1 -> return $ responseLBS status fullHeaders (toS body)
+                      | otherwise       -> HT.condemn >> (return . errorResponseFor . singularityError) queryTotal
+
+                (_, Full) ->
+                  return $ responseLBS status fullHeaders (toS body)
+
+                (_, _) ->
+                  return $ responseLBS status minimalHeaders mempty
+
+
+        (ActionSingleUpsert, TargetIdent (QualifiedIdentifier tSchema tName), Just ProcessedJSON{pjRaw, pjType, pjKeys}) ->
           case mutateSqlParts tSchema tName of
             Left errorResponse -> return errorResponse
             Right (sq, mq) -> do
               let isSingle = case pjType of
                                PJArray len -> len == 1
-                               PJObject -> True
+                               PJObject    -> True
                   colNames = colName <$> tableCols dbStructure tSchema tName
               if topLevelRange /= allRange
-                then return $ simpleError status400 [] "Range header and limit/offset querystring parameters are not allowed for PUT"
+                then return . errorResponseFor $ PutRangeNotAllowedError
               else if not isSingle
-                then return $ simpleError status400 [] "PUT payload must contain a single row"
+                then return . errorResponseFor $ PutSingletonError
               else if S.fromList colNames /= pjKeys
-                then return $ simpleError status400 [] "You must specify all columns in the payload when using PUT"
+                then return . errorResponseFor $ PutPayloadIncompleteError
               else do
-                row <- H.query (toS pjRaw) $
+                row <- H.statement (toS pjRaw) $
                        createWriteStatement sq mq (contentType == CTSingularJSON) False
                                             (contentType == CTTextCSV) (iPreferRepresentation apiRequest) []
                 let (_, queryTotal, _, body) = extractQueryResult row
@@ -235,7 +222,7 @@ app dbStructure proc conf apiRequest =
                 if queryTotal /= 1
                   then do
                     HT.condemn
-                    return $ simpleError status400 [] "Payload values do not match URL in primary key column(s)"
+                    return . errorResponseFor $ PutMatchingPkError
                   else
                     return $ if iPreferRepresentation apiRequest == Full
                       then responseLBS status200 [toHeader contentType] (toS body)
@@ -249,16 +236,16 @@ app dbStructure proc conf apiRequest =
                     (contentType == CTSingularJSON) False
                     (contentType == CTTextCSV)
                     (iPreferRepresentation apiRequest) []
-              row <- H.query mempty stm
+              row <- H.statement mempty stm
               let (_, queryTotal, _, body) = extractQueryResult row
                   r = contentRangeH 1 0 $
-                        toInteger <$> if shouldCount then Just queryTotal else Nothing
+                        if shouldCount then Just queryTotal else Nothing
               if contentType == CTSingularJSON
                  && queryTotal /= 1
                  && iPreferRepresentation apiRequest == Full
                 then do
                   HT.condemn
-                  return $ singularityError (toInteger queryTotal)
+                  return . errorResponseFor . singularityError $ queryTotal
                 else
                   return $ if iPreferRepresentation apiRequest == Full
                     then responseLBS status200 [toHeader contentType, r] (toS body)
@@ -272,42 +259,38 @@ app dbStructure proc conf apiRequest =
               let acceptH = (hAllow, if tableInsertable table then "GET,POST,PATCH,DELETE" else "GET") in
               return $ responseLBS status200 [allOrigins, acceptH] ""
 
-        (ActionInvoke _, TargetProc qi, Just PayloadJSON{pjRaw, pjType, pjKeys}) ->
+        (ActionInvoke _, TargetProc qi _, Just pJson) ->
           let returnsScalar = case proc of
                 Just ProcDescription{pdReturnType = (Single (Scalar _))} -> True
                 _ -> False
               rpcBinaryField = if returnsScalar
                                  then Right Nothing
-                                 else binaryField contentType =<< fldNames
+                                 else binaryField contentType rawContentTypes =<< fldNames
               parts = (,) <$> readSqlParts <*> rpcBinaryField in
           case parts of
             Left errorResponse -> return errorResponse
             Right ((q, cq), bField) -> do
-              let isObject = case pjType of
-                                PJObject  -> True
-                                PJArray _ -> False
-                  singular = contentType == CTSingularJSON
-                  specifiedPgArgs = filter ((`S.member` pjKeys) . pgaName) $ fromMaybe [] (pdArgs <$> proc)
-              row <- H.query (toS pjRaw) $
-                callProc qi specifiedPgArgs returnsScalar q cq shouldCount
+              let singular = contentType == CTSingularJSON
+              row <- H.statement (toS $ pjRaw pJson) $
+                callProc qi (specifiedProcArgs cols proc) returnsScalar q cq shouldCount
                          singular (iPreferSingleObjectParameter apiRequest)
                          (contentType == CTTextCSV)
-                         (contentType == CTOctetStream) bField isObject
+                         (contentType `elem` rawContentTypes) bField
                          (pgVersion dbStructure)
               let (tableTotal, queryTotal, body, jsonHeaders) =
                     fromMaybe (Just 0, 0, "[]", "[]") row
                   (status, contentRange) = rangeHeader queryTotal tableTotal
                   decodedHeaders = first toS $ JSON.eitherDecode $ toS jsonHeaders :: Either Text [GucHeader]
               case decodedHeaders of
-                Left _ -> return gucHeadersError
+                Left _ -> return . errorResponseFor $ GucHeadersError
                 Right hs ->
                   if singular && queryTotal /= 1
                     then do
                       HT.condemn
-                      return $ singularityError (toInteger queryTotal)
+                      return . errorResponseFor . singularityError $ queryTotal
                     else return $ responseLBS status ([toHeader contentType, contentRange] ++ toHeaders hs) (toS body)
 
-        (ActionInspect, TargetRoot, Nothing) -> do
+        (ActionInspect, TargetDefaultSpec, Nothing) -> do
           let host = configHost conf
               port = toInteger $ configPort conf
               proxy = pickProxy $ toS <$> configProxyUri conf
@@ -317,7 +300,8 @@ app dbStructure proc conf apiRequest =
               toTableInfo :: [Table] -> [(Table, [Column], [Text])]
               toTableInfo = map (\t -> let (s, tn) = (tableSchema t, tableName t) in (t, tableCols dbStructure s tn, tablePKCols dbStructure s tn))
               encodeApi ti sd procs = encodeOpenAPI (concat $ M.elems procs) (toTableInfo ti) uri' sd $ dbPrimaryKeys dbStructure
-          body <- encodeApi <$> H.query schema accessibleTables <*> H.query schema schemaDescription <*> H.query schema accessibleProcs
+
+          body <- encodeApi <$> H.statement schema accessibleTables <*> H.statement schema schemaDescription <*> H.statement schema accessibleProcs
           return $ responseLBS status200 [toHeader CTOpenAPI] $ toS body
 
         _ -> return notFound
@@ -341,39 +325,46 @@ app dbStructure proc conf apiRequest =
       selectQuery = requestToQuery schema False <$> readDbRequest
       countQuery = requestToCountQuery schema <$> readDbRequest
       readSqlParts = (,) <$> selectQuery <*> countQuery
+      mutationDbRequest s t = mutateRequest apiRequest t cols (tablePKCols dbStructure s t) =<< fldNames
       mutateSqlParts s t =
         (,) <$> selectQuery
-            <*> (requestToQuery schema False . DbMutate <$> (mutateRequest apiRequest t (tablePKCols dbStructure s t) =<< fldNames))
+            <*> (requestToQuery schema False . DbMutate <$> mutationDbRequest s t)
+      rawContentTypes =
+        (decodeContentType <$> configRawMediaTypes conf) `L.union`
+        [ CTOctetStream, CTTextPlain ]
 
-responseContentTypeOrError :: [ContentType] -> Action -> Either Response ContentType
-responseContentTypeOrError accepts action = serves contentTypesForRequest accepts
+responseContentTypeOrError :: [ContentType] -> [ContentType] -> Action -> Target -> Either Response ContentType
+responseContentTypeOrError accepts rawContentTypes action target = serves contentTypesForRequest accepts
   where
-    contentTypesForRequest =
-      case action of
-        ActionRead ->    [CTApplicationJSON, CTSingularJSON, CTTextCSV, CTOctetStream]
-        ActionCreate ->  [CTApplicationJSON, CTSingularJSON, CTTextCSV]
-        ActionUpdate ->  [CTApplicationJSON, CTSingularJSON, CTTextCSV]
-        ActionDelete ->  [CTApplicationJSON, CTSingularJSON, CTTextCSV]
-        ActionInvoke _ ->  [CTApplicationJSON, CTSingularJSON, CTTextCSV, CTOctetStream]
-        ActionInspect -> [CTOpenAPI, CTApplicationJSON]
-        ActionInfo ->    [CTTextCSV]
-        ActionSingleUpsert ->  [CTApplicationJSON, CTSingularJSON, CTTextCSV]
+    contentTypesForRequest = case action of
+      ActionRead         ->  [CTApplicationJSON, CTSingularJSON, CTTextCSV]
+                             ++ rawContentTypes
+      ActionCreate       ->  [CTApplicationJSON, CTSingularJSON, CTTextCSV]
+      ActionUpdate       ->  [CTApplicationJSON, CTSingularJSON, CTTextCSV]
+      ActionDelete       ->  [CTApplicationJSON, CTSingularJSON, CTTextCSV]
+      ActionInvoke _     ->  [CTApplicationJSON, CTSingularJSON, CTTextCSV]
+                             ++ rawContentTypes
+                             ++ [CTOpenAPI | tpIsRootSpec target]
+      ActionInspect      ->  [CTOpenAPI, CTApplicationJSON]
+      ActionInfo         ->  [CTTextCSV]
+      ActionSingleUpsert ->  [CTApplicationJSON, CTSingularJSON, CTTextCSV]
     serves sProduces cAccepts =
       case mutuallyAgreeable sProduces cAccepts of
-        Nothing -> do
-          let failed = intercalate ", " $ map (toS . toMime) cAccepts
-          Left $ simpleError status415 [] $
-            "None of these Content-Types are available: " <> failed
+        Nothing -> Left . errorResponseFor . ContentTypeError . map toMime $ cAccepts
         Just ct -> Right ct
 
-binaryField :: ContentType -> [FieldName] -> Either Response (Maybe FieldName)
-binaryField CTOctetStream fldNames =
-  if length fldNames == 1 && fieldName /= Just "*"
-    then Right fieldName
-    else Left binaryFieldError
-  where
-    fieldName = headMay fldNames
-binaryField _ _ = Right Nothing
+{-
+  | If raw(binary) output is requested, check that ContentType is one of the admitted rawContentTypes and that
+  | `?select=...` contains only one field other than `*`
+-}
+binaryField :: ContentType -> [ContentType]-> [FieldName] -> Either Response (Maybe FieldName)
+binaryField ct rawContentTypes fldNames
+  | 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
 
 splitKeyValue :: BS.ByteString -> (BS.ByteString, BS.ByteString)
 splitKeyValue kv = (k, BS.tail v)
@@ -390,7 +381,7 @@ rangeStatus lower upper (Just total)
   | (1 + upper - lower) < total = status206
   | otherwise               = status200
 
-contentRangeH :: Integer -> Integer -> Maybe Integer -> Header
+contentRangeH :: (Integral a, Show a) => a -> a -> Maybe a -> Header
 contentRangeH lower upper total =
     ("Content-Range", headerValue)
     where
@@ -398,8 +389,8 @@ contentRangeH lower upper total =
       rangeString
         | totalNotZero && fromInRange = show lower <> "-" <> show upper
         | otherwise = "*"
-      totalString   = fromMaybe "*" (show <$> total)
-      totalNotZero  = fromMaybe True ((/=) 0 <$> total)
+      totalString   = maybe "*" show total
+      totalNotZero  = maybe True (0 /=) total
       fromInRange   = lower <= upper
 
 extractQueryResult :: Maybe ResultsWithCount -> ResultsWithCount

src/PostgREST/Auth.hs

@@ -1,5 +1,5 @@
 {-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE LambdaCase       #-}
 {-|
 Module      : PostgREST.Auth
 Description : PostgREST authorization functions.
@@ -16,19 +16,22 @@ module PostgREST.Auth (
     containsRole
   , jwtClaims
   , JWTAttempt(..)
-  , parseJWK
+  , parseSecret
   ) where
 
-import           Control.Lens.Operators
-import qualified Data.Aeson             as JSON
-import qualified Data.HashMap.Strict    as M
-import           Data.Time.Clock        (UTCTime)
-import           Data.Vector            as V
-import           PostgREST.Types
-import           Protolude
+import qualified Crypto.JOSE.Types   as JOSE.Types
+import qualified Data.Aeson          as JSON
+import qualified Data.HashMap.Strict as M
+import           Data.Vector         as V
 
-import qualified Crypto.JOSE.Types      as JOSE.Types
-import           Crypto.JWT
+import Control.Lens    (set)
+import Data.Time.Clock (UTCTime)
+
+import Control.Lens.Operators
+import Crypto.JWT
+
+import PostgREST.Types
+import Protolude
 
 {-|
   Possible situations encountered with client JWTs
@@ -42,13 +45,13 @@ data JWTAttempt = JWTInvalid JWTError
   Receives the JWT secret and audience (from config) and a JWT and returns a map
   of JWT claims.
 -}
-jwtClaims :: Maybe JWK -> Maybe StringOrURI -> LByteString -> UTCTime -> Maybe JSPath -> IO JWTAttempt
+jwtClaims :: Maybe JWKSet -> Maybe StringOrURI -> LByteString -> UTCTime -> Maybe JSPath -> IO JWTAttempt
 jwtClaims _ _ "" _ _ = return $ JWTClaims M.empty
 jwtClaims secret audience payload time jspath =
   case secret of
     Nothing -> return JWTMissingSecret
     Just s -> do
-      let validation = defaultJWTValidationSettings (maybe (const True) (==) audience)
+      let validation = set allowedSkew 1 $ defaultJWTValidationSettings (maybe (const True) (==) audience)
       eJwt <- runExceptT $ do
         jwt <- decodeCompact payload
         verifyClaimsAt validation s time jwt
@@ -82,19 +85,29 @@ containsRole :: JWTAttempt -> Bool
 containsRole (JWTClaims claims) = M.member "role" claims
 containsRole _                  = False
 
-parseJWK :: ByteString -> JWK
-parseJWK str =
-  fromMaybe (hs256jwk str) (JSON.decode (toS str) :: Maybe JWK)
+{-|
+  Parse `jwt-secret` configuration option and turn into a JWKSet.
+
+  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.
+-}
+parseSecret :: ByteString -> JWKSet
+parseSecret str =
+  fromMaybe (maybe secret (\jwk' -> JWKSet [jwk']) maybeJWK)
+    maybeJWKSet
+ where
+  maybeJWKSet = JSON.decode (toS str) :: Maybe JWKSet
+  maybeJWK = JSON.decode (toS str) :: Maybe JWK
+  secret = JWKSet [jwkFromSecret str]
 
 {-|
-  Internal helper to generate HMAC-SHA256. When the jwt key in the
-  config file is a simple string rather than a JWK object, we'll
-  apply this function to it.
+  Internal helper to generate a symmetric HMAC-SHA256 JWK from a text secret.
 -}
-hs256jwk :: ByteString -> JWK
-hs256jwk key =
+jwkFromSecret :: ByteString -> JWK
+jwkFromSecret key =
   fromKeyMaterial km
-    & jwkUse .~ Just Sig
-    & jwkAlg .~ (Just $ JWSAlg HS256)
+    & jwkUse ?~ Sig
+    & jwkAlg ?~ JWSAlg HS256
  where
   km = OctKeyMaterial (OctKeyParameters (JOSE.Types.Base64Octets key))

src/PostgREST/Config.hs

@@ -1,5 +1,3 @@
-{-# LANGUAGE LambdaCase, TemplateHaskell #-}
-{-# OPTIONS_GHC -fno-warn-type-defaults #-}
 {-|
 Module      : PostgREST.Config
 Description : Manages PostgREST configuration options.
@@ -14,54 +12,58 @@ 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
-                        , pgVersion95
-                        , pgVersion96
                         , AppConfig (..)
+                        , configPoolTimeout'
                         )
        where
 
-import           Control.Applicative
-import           Control.Monad                (fail)
-import           Control.Lens                 (preview)
-import           Crypto.JWT                   (StringOrURI,
-                                               stringOrUri)
 import qualified Data.ByteString              as B
 import qualified Data.ByteString.Char8        as BS
 import qualified Data.CaseInsensitive         as CI
 import qualified Data.Configurator            as C
-import qualified Data.Configurator.Parser     as C
-import           Data.Configurator.Types      as C
-import           Data.List                    (lookup)
-import           Data.Monoid
-import           Data.Scientific              (floatingOrInteger)
-import           Data.String                  (String)
-import           Data.Text                    (dropAround,
-                                               intercalate, lines,
-                                               strip, take)
-import           Data.Text.Encoding           (encodeUtf8)
-import           Data.Text.IO                 (hPutStrLn)
-import           Data.Version                 (versionBranch)
-import           Development.GitRev           (gitHash)
-import           Network.Wai
-import           Network.Wai.Middleware.Cors  (CorsResourcePolicy (..))
-import           Options.Applicative          hiding (str)
-import           Paths_postgrest              (version)
-import           PostgREST.Parsers            (pRoleClaimKey)
-import           PostgREST.Types              (PgVersion(..), ApiRequestError(..),
-                                               JSPath, JSPathExp(..))
-import           Protolude                    hiding (hPutStrLn, take,
-                                               intercalate, (<>))
-import           System.IO                    (hPrint)
-import           System.IO.Error              (IOError)
-import           Text.Heredoc
-import           Text.PrettyPrint.ANSI.Leijen hiding ((<$>), (<>))
 import qualified Text.PrettyPrint.ANSI.Leijen as L
 
+import Control.Exception           (Handler (..))
+import Control.Lens                (preview)
+import Control.Monad               (fail)
+import Crypto.JWT                  (StringOrURI, stringOrUri)
+import Data.List                   (lookup)
+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 Paths_postgrest             (version)
+import System.IO.Error             (IOError)
+
+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 (..),
+                          QualifiedIdentifier (..))
+import Protolude         hiding (concat, hPutStrLn, intercalate, null,
+                          take, (<>))
+
+
 -- | Config file settings for the server
 data AppConfig = AppConfig {
     configDatabase          :: Text
@@ -70,22 +72,33 @@ data AppConfig = AppConfig {
   , configSchema            :: Text
   , configHost              :: Text
   , configPort              :: Int
+  , configSocket            :: Maybe Text
 
   , 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 QualifiedIdentifier
+  , 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
@@ -114,7 +127,7 @@ prettyVersion =
 
 -- | Version number used in docs
 docsVersion :: Text
-docsVersion = "v" <> dropAround (== '.') (dropAround (/= '.') prettyVersion)
+docsVersion = "v" <> dropEnd 1 (dropWhileEnd (/= '.') prettyVersion)
 
 -- | Function to read and parse options from the command line
 readOptions :: IO AppConfig
@@ -122,65 +135,87 @@ readOptions = do
   -- First read the config file path from command line
   cfgPath <- customExecParser parserPrefs opts
   -- Now read the actual config file
-  conf <- catch
-    (C.readConfig =<< C.load [C.Required cfgPath])
-    configNotfoundHint
+  conf <- catches (C.load cfgPath)
+    [ Handler (\(ex :: IOError)    -> exitErr $ "Cannot open config file:\n\t" <> show ex)
+    , Handler (\(C.ParseError err) -> exitErr $ "Error parsing config file:\n\t" <> err)
+    ]
 
-  let (mAppConf, errs) = flip C.runParserM conf $
-        AppConfig
-          <$> C.key "db-uri"
-          <*> C.key "db-anon-role"
-          <*> (mfilter (/= "") <$> 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")
-          <*> parseJwtAudience "jwt-aud"
-          <*> (fromMaybe 10 . join . fmap coerceInt <$> C.key "db-pool")
-          <*> (join . fmap coerceInt <$> C.key "max-rows")
-          <*> (mfilter (/= "") <$> C.key "pre-request")
-          <*> pure False
-          <*> (fmap parsedPairToTextPair <$> C.subassocs "app.settings")
-          <*> (maybe (Right [JSPKey "role"]) parseRoleClaimKey <$> C.key "role-claim-key")
-
-  case mAppConf of
-    Nothing -> do
-      forM_ errs $ hPrint stderr
-      exitFailure
-    Just appConf ->
+  case C.runParser parseConfig conf of
+    Left err ->
+      exitErr $ "Error parsing config file:\n\t" <> err
+    Right appConf ->
       return appConf
 
   where
-    parsedPairToTextPair :: (Name, Value) -> (Text, Text)
-    parsedPairToTextPair (k, v) = (k, newValue)
-      where
-        newValue = case v of
-          String textVal -> textVal
-          _ -> show v
+    dbSchema = reqString "db-schema"
+    parseConfig =
+      AppConfig
+        <$> reqString "db-uri"
+        <*> reqString "db-anon-role"
+        <*> optString "server-proxy-uri"
+        <*> dbSchema
+        <*> (fromMaybe "!4" <$> optString "server-host")
+        <*> (fromMaybe 3000 <$> optInt "server-port")
+        <*> optString "server-unix-socket"
+        <*> (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")
+        <*> ((\x y -> QualifiedIdentifier x <$> y) <$> dbSchema <*> optString "root-spec")
+        <*> (maybe [] (fmap encodeUtf8 . splitOnCommas) <$> optValue "raw-media-types")
 
-    parseJwtAudience :: Name -> C.ConfigParserM (Maybe StringOrURI)
+    parseJwtAudience :: C.Key -> C.Parser C.Config (Maybe StringOrURI)
     parseJwtAudience k =
-      C.key k >>= \case
+      C.optional k C.string >>= \case
         Nothing -> pure Nothing -- no audience in config file
-        Just aud -> case preview stringOrUri (aud :: String) of
+        Just aud -> case preview stringOrUri (unpack aud) of
           Nothing -> fail "Invalid Jwt audience. Check your configuration."
           (Just "") -> pure Nothing
           aud' -> pure aud'
 
-    coerceInt :: (Read i, Integral i) => Value -> Maybe i
-    coerceInt (Number x) = rightToMaybe $ floatingOrInteger x
-    coerceInt (String x) = readMaybe $ toS x
-    coerceInt _          = Nothing
+    reqString :: C.Key -> C.Parser C.Config Text
+    reqString k = C.required k C.string
 
-    coerceBool :: Value -> Maybe Bool
-    coerceBool (Bool b)   = Just b
-    coerceBool (String b) = readMaybe $ toS b
-    coerceBool _          = Nothing
+    optString :: C.Key -> C.Parser C.Config (Maybe Text)
+    optString k = mfilter (/= "") <$> C.optional k C.string
 
-    parseRoleClaimKey :: Value -> Either ApiRequestError JSPath
-    parseRoleClaimKey (String s) = pRoleClaimKey s
-    parseRoleClaimKey v = pRoleClaimKey $ show v
+    optValue :: C.Key -> C.Parser C.Config (Maybe C.Value)
+    optValue k = C.optional k C.value
+
+    optInt :: (Read i, Integral i) => C.Key -> C.Parser C.Config (Maybe i)
+    optInt k = join <$> C.optional k (coerceInt <$> C.value)
+
+    optBool :: C.Key -> C.Parser C.Config (Maybe Bool)
+    optBool k = join <$> C.optional k (coerceBool <$> C.value)
+
+    coerceText :: C.Value -> Text
+    coerceText (C.String s) = s
+    coerceText v            = show v
+
+    coerceInt :: (Read i, Integral i) => C.Value -> Maybe i
+    coerceInt (C.Number x) = rightToMaybe $ floatingOrInteger x
+    coerceInt (C.String x) = readMaybe $ toS x
+    coerceInt _            = Nothing
+
+    coerceBool :: C.Value -> Maybe Bool
+    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
@@ -196,26 +231,30 @@ readOptions = do
 
     parserPrefs = prefs showHelpOnError
 
-    configNotfoundHint :: IOError -> IO a
-    configNotfoundHint e = do
-      hPutStrLn stderr $
-        "Cannot open config file:\n\t" <> show e
+    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"
+          |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-host = "!4"
           |server-port = 3000
           |
+          |## unix socket location
+          |## if specified it takes precedence over server-port
+          |# server-unix-socket = "/tmp/pgrst.sock"
+          |
           |## base url for swagger output
           |# server-proxy-uri = ""
           |
-          |## choose a secret to enable JWT auth
+          |## choose a secret, JSON Web Key (or set) to enable JWT auth
           |## (use "@filename" to load from separate file)
           |# jwt-secret = "foo"
           |# secret-is-base64 = false
@@ -229,6 +268,16 @@ readOptions = do
           |
           |## 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
@@ -236,13 +285,3 @@ pathParser =
   strArgument $
     metavar "FILENAME" <>
     help "Path to configuration file"
-
--- | Tells the minimum PostgreSQL version required by this version of PostgREST
-minimumPgVersion :: PgVersion
-minimumPgVersion = PgVersion 90400 "9.4"
-
-pgVersion96 :: PgVersion
-pgVersion96 = PgVersion 90600 "9.6"
-
-pgVersion95 :: PgVersion
-pgVersion95 = PgVersion 90500 "9.5"

src/PostgREST/DbRequestBuilder.hs

@@ -1,48 +1,53 @@
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE DuplicateRecordFields#-}
-{-# LANGUAGE LambdaCase #-}
-{-# LANGUAGE MultiWayIf #-}
-{-# LANGUAGE NamedFieldPuns #-}
+{-|
+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           Control.Arrow             ((***))
-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 qualified Data.Set                  as S
-import           Data.Text                 (isInfixOf)
-import           Data.Tree
-import           Data.Either.Combinators   (mapLeft)
+import qualified Data.ByteString.Char8 as BS
+import qualified Data.HashMap.Strict   as M
+import qualified Data.Set              as S
 
-import           Network.Wai
+import Control.Arrow           ((***))
+import Control.Lens.Getter     (view)
+import Control.Lens.Tuple      (_1)
+import Data.Either.Combinators (mapLeft)
+import Data.Foldable           (foldr1)
+import Data.List               (delete)
+import Data.Maybe              (fromJust)
+import Data.Text               (isInfixOf)
+import Text.Regex.TDFA         ((=~))
+import Unsafe                  (unsafeHead)
 
-import           Data.Foldable (foldr1)
-import qualified Data.HashMap.Strict       as M
+import Control.Applicative
+import Data.Tree
+import Network.Wai
 
-import           PostgREST.ApiRequest   ( ApiRequest(..)
-                                        , PreferRepresentation(..)
-                                        , Action(..), Target(..)
-                                        , PreferRepresentation (..)
-                                        )
-import           PostgREST.Error           (apiRequestError)
-import           PostgREST.Parsers
-import           PostgREST.RangeQuery      (NonnegRange, restrictRange, allRange)
-import           PostgREST.Types
-
-import           Protolude                hiding (from, dropWhile, drop)
-import           Text.Regex.TDFA         ((=~))
-import           Unsafe                  (unsafeHead)
+import PostgREST.ApiRequest (Action (..), ApiRequest (..),
+                             PreferRepresentation (..),
+                             PreferRepresentation (..), Target (..))
+import PostgREST.Error      (ApiRequestError (..), errorResponseFor)
+import PostgREST.Parsers
+import PostgREST.RangeQuery (NonnegRange, allRange, restrictRange)
+import PostgREST.Types
+import Protolude            hiding (from)
 
 readRequest :: Maybe Integer -> [Relation] -> Maybe ProcDescription -> ApiRequest -> Either Response ReadRequest
 readRequest maxRows allRels proc apiRequest  =
-  mapLeft apiRequestError $
+  mapLeft errorResponseFor $
   treeRestrictRange maxRows =<<
   augumentRequestWithJoin schema relations =<<
   addFiltersOrdersRanges apiRequest <*>
@@ -53,12 +58,12 @@ readRequest maxRows allRels proc apiRequest  =
       let target = iTarget apiRequest in
       case target of
         (TargetIdent (QualifiedIdentifier s t) ) -> Just (s, t)
-        (TargetProc  (QualifiedIdentifier s pName) ) -> Just (s, tName)
+        (TargetProc  (QualifiedIdentifier s pName) _ ) -> Just (s, tName)
           where
             tName = case pdReturnType <$> proc of
-              Just (SetOf (Composite qi)) -> qiName qi
+              Just (SetOf (Composite qi))  -> qiName qi
               Just (Single (Composite qi)) -> qiName qi
-              _ -> pName
+              _                            -> pName
 
         _ -> Nothing
 
@@ -68,7 +73,7 @@ readRequest maxRows allRels proc apiRequest  =
     buildReadRequest fieldTree =
       let rootDepth = 0
           rootNodeName = if action == ActionRead then rootTableName else sourceCTEName in
-      foldr (treeEntry rootDepth) (Node (Select [] [rootNodeName] [] [] [] allRange, (rootNodeName, Nothing, Nothing, Nothing, rootDepth)) []) fieldTree
+      foldr (treeEntry rootDepth) (Node (Select [] rootNodeName Nothing [] [] [] [] allRange, (rootNodeName, Nothing, Nothing, Nothing, rootDepth)) []) fieldTree
       where
         treeEntry :: Depth -> Tree SelectItem -> ReadRequest -> ReadRequest
         treeEntry depth (Node fld@((fn, _),_,alias,relationDetail) fldForest) (Node (q, i) rForest) =
@@ -76,7 +81,7 @@ readRequest maxRows allRels proc apiRequest  =
           case fldForest of
             [] -> Node (q {select=fld:select q}, i) rForest
             _  -> Node (q, i) $
-                  foldr (treeEntry nxtDepth) (Node (Select [] [fn] [] [] [] allRange, (fn, Nothing, alias, relationDetail, nxtDepth)) []) fldForest:rForest
+                  foldr (treeEntry nxtDepth) (Node (Select [] fn Nothing [] [] [] [] allRange, (fn, Nothing, alias, relationDetail, nxtDepth)) []) fldForest:rForest
 
     relations :: [Relation]
     relations = case action of
@@ -84,13 +89,13 @@ readRequest maxRows allRels proc apiRequest  =
       ActionUpdate   -> fakeSourceRelations ++ allRels
       ActionDelete   -> fakeSourceRelations ++ allRels
       ActionInvoke _ -> fakeSourceRelations ++ allRels
-      _       -> allRels
+      _              -> allRels
       where fakeSourceRelations = mapMaybe (toSourceRelation rootTableName) allRels
 
 -- in a relation where one of the tables matches "TableName"
 -- replace the name to that table with pg_source
 -- this "fake" relations is needed so that in a mutate query
--- we can look a the "returning *" part which is wrapped with a "with"
+-- we can look at 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 _ _)
@@ -108,13 +113,13 @@ treeRestrictRange maxRows_ request = pure $ nodeRestrictRange maxRows_ `fmap` re
 augumentRequestWithJoin :: Schema ->  [Relation] ->  ReadRequest -> Either ApiRequestError ReadRequest
 augumentRequestWithJoin schema allRels request =
   addRelations schema allRels Nothing request
-  >>= addJoinConditions schema
+  >>= addJoinConditions schema Nothing
 
 addRelations :: Schema -> [Relation] -> Maybe ReadRequest -> ReadRequest -> Either ApiRequestError ReadRequest
-addRelations schema allRelations parentNode (Node (query, (nodeName, _, alias, relationDetail, depth)) forest) =
+addRelations schema allRelations parentNode (Node (query@Select{from=tbl}, (nodeName, _, alias, relationDetail, depth)) forest) =
   case parentNode of
-    Just (Node (Select{from=[parentNodeTable]}, _) _) ->
-      let newFrom r = (\tName -> if tName == nodeName then tableName (relTable r) else tName) <$> from query
+    Just (Node (Select{from=parentNodeTable}, _) _) ->
+      let newFrom r = if tbl == nodeName then tableName (relTable r) else tbl
           newReadNode = (\r -> (query{from=newFrom r}, (nodeName, Just r, alias, Nothing, depth))) <$> rel
           rel :: Either ApiRequestError Relation
           rel = note (NoRelationBetween parentNodeTable nodeName) $
@@ -208,35 +213,49 @@ findRelation schema allRelations nodeTableName parentNodeTableName relationDetai
         )
   ) allRelations
 
-addJoinConditions :: Schema -> ReadRequest -> Either ApiRequestError ReadRequest
-addJoinConditions schema (Node node@(query, nodeProps@(_, relation, _, _, _)) forest) =
+-- previousAlias is only used for the case of self joins
+addJoinConditions :: Schema -> Maybe Alias -> ReadRequest -> Either ApiRequestError ReadRequest
+addJoinConditions schema previousAlias (Node node@(query@Select{from=tbl}, nodeProps@(_, relation, _, _, depth)) forest) =
   case relation of
-    Just Relation{relType=Root} -> Node node  <$> updatedForest -- this is the root node
+    Just Relation{relType=Root} -> Node node <$> updatedForest -- this is the root node
     Just rel@Relation{relType=Parent} -> Node (augmentQuery rel, nodeProps) <$> updatedForest
     Just rel@Relation{relType=Child} -> Node (augmentQuery rel, nodeProps) <$> updatedForest
     Just rel@Relation{relType=Many, relLinkTable=(Just linkTable)} ->
       let rq = augmentQuery rel in
-      Node (rq{from=tableName linkTable:from rq}, nodeProps) <$> updatedForest
+      Node (rq{implicitJoins=tableName linkTable:implicitJoins rq}, nodeProps) <$> updatedForest
     _ -> Left UnknownRelation
   where
-    updatedForest = mapM (addJoinConditions schema) forest
-    augmentQuery rel = foldr addJoinCond query (getJoinConditions rel)
-    addJoinCond :: JoinCondition -> ReadQuery -> ReadQuery
-    addJoinCond jc rq@Select{joinConditions=jcs} = rq{joinConditions=jc:jcs}
+    newAlias = case isSelfJoin <$> relation of
+      Just True
+        | depth /= 0 -> Just (tbl <> "_" <> show depth) -- root node doesn't get aliased
+        | otherwise  -> Nothing
+      _              -> Nothing
+    augmentQuery rel =
+      foldr
+        (\jc rq@Select{joinConditions=jcs} -> rq{joinConditions=jc:jcs})
+        query{fromAlias=newAlias}
+        (getJoinConditions previousAlias newAlias rel)
+    updatedForest = mapM (addJoinConditions schema newAlias) forest
 
-getJoinConditions :: Relation -> [JoinCondition]
-getJoinConditions (Relation Table{tableSchema=tSchema, tableName=tN} cols Table{tableName=ftN} fcs typ lt lc1 lc2) =
-  if | typ == Child || typ == Parent ->
-        zipWith (toJoinCondition tN ftN) cols fcs
-     | typ == Many ->
-        let ltN = fromMaybe "" (tableName <$> lt) in
-        zipWith (toJoinCondition tN ltN) cols (fromMaybe [] lc1) ++ zipWith (toJoinCondition ftN ltN) fcs (fromMaybe [] lc2)
-     | typ == Root -> undefined
+-- 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 lt lc1 lc2) =
+  case typ of
+    Child  ->
+        zipWith (toJoinCondition tN ftN) cols fCols
+    Parent ->
+        zipWith (toJoinCondition tN ftN) cols fCols
+    Many   ->
+        let ltN = maybe "" tableName lt in
+        zipWith (toJoinCondition tN ltN) cols (fromMaybe [] lc1) ++ zipWith (toJoinCondition ftN ltN) fCols (fromMaybe [] lc2)
+    Root   -> witness
   where
     toJoinCondition :: Text -> Text -> Column -> Column -> JoinCondition
     toJoinCondition tb ftb c fc =
-      JoinCondition (QualifiedIdentifier tSchema tb, Nothing, colName c)
-                    (QualifiedIdentifier tSchema ftb, Nothing, colName fc)
+      let qi1 = QualifiedIdentifier tSchema tb
+          qi2 = QualifiedIdentifier tSchema ftb in
+        JoinCondition (maybe qi1 (QualifiedIdentifier mempty) newAlias, colName c)
+                      (maybe qi2 (QualifiedIdentifier mempty) previousAlias, colName fc)
 
 addFiltersOrdersRanges :: ApiRequest -> Either ApiRequestError (ReadRequest -> ReadRequest)
 addFiltersOrdersRanges apiRequest = foldr1 (liftA2 (.)) [
@@ -299,11 +318,11 @@ addProperty f (targetNodeName:remainingPath, a) (Node rn forest) =
   where
     pathNode = find (\(Node (_,(nodeName,_,alias,_,_)) _) -> nodeName == targetNodeName || alias == Just targetNodeName) forest
 
-mutateRequest :: ApiRequest -> TableName -> [Text] -> [FieldName] -> Either Response MutateRequest
-mutateRequest apiRequest tName pkCols fldNames = mapLeft apiRequestError $
+mutateRequest :: ApiRequest -> TableName -> S.Set FieldName -> [FieldName] -> [FieldName] -> Either Response MutateRequest
+mutateRequest apiRequest tName cols pkCols fldNames = mapLeft errorResponseFor $
   case action of
-    ActionCreate -> Right $ Insert tName pkCols payload (iPreferResolution apiRequest) [] returnings
-    ActionUpdate -> Update tName payload <$> combinedLogic <*> pure returnings
+    ActionCreate -> Right $ Insert tName cols ((,) <$> iPreferResolution apiRequest <*> Just pkCols) [] returnings
+    ActionUpdate -> Update tName cols <$> combinedLogic <*> pure returnings
     ActionSingleUpsert ->
       (\flts ->
         if null (iLogic apiRequest) &&
@@ -312,14 +331,13 @@ mutateRequest apiRequest tName pkCols fldNames = mapLeft apiRequestError $
            all (\case
               Filter _ (OpExpr False (Op "eq" _)) -> True
               _ -> False) flts
-          then Insert tName pkCols payload (Just MergeDuplicates) <$> combinedLogic <*> pure returnings
+          then Insert tName cols (Just (MergeDuplicates, pkCols)) <$> combinedLogic <*> pure returnings
         else
           Left InvalidFilters) =<< filters
     ActionDelete -> Delete tName <$> combinedLogic <*> pure returnings
     _            -> Left UnsupportedVerb
   where
     action = iAction apiRequest
-    payload = fromJust $ iPayload apiRequest
     returnings = if iPreferRepresentation apiRequest == None then [] else fldNames
     filters = map snd <$> mapM pRequestFilter mutateFilters
     logic = map snd <$> mapM pRequestLogicTree logicFilters

src/PostgREST/DbStructure.hs

@@ -1,51 +1,71 @@
+{-|
+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  #-}
-{-# LANGUAGE NamedFieldPuns  #-}
 module PostgREST.DbStructure (
   getDbStructure
 , accessibleTables
 , accessibleProcs
 , schemaDescription
 , getPgVersion
-, fillSessionWithSettings
 ) where
 
-import qualified Hasql.Decoders                as HD
-import qualified Hasql.Encoders                as HE
-import qualified Hasql.Query                   as H
+import qualified Data.HashMap.Strict as M
+import qualified Data.List           as L
+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 qualified Data.HashMap.Strict           as M
-import qualified Data.List                     as L
-import           Data.Set                      as S (fromList)
-import           Data.Text                     (split, strip,
-                                                breakOn, dropAround,
-                                                splitOn)
-import qualified Data.Text                     as T
-import qualified Hasql.Session                 as H
-import           PostgREST.Types
-import           Text.InterpolatedString.Perl6 (q)
+import Data.Set                      as S (fromList)
+import Data.Text                     (breakOn, dropAround, split,
+                                      splitOn, strip)
+import GHC.Exts                      (groupWith)
+import Text.InterpolatedString.Perl6 (q, qc)
+import Unsafe                        (unsafeHead)
 
-import           GHC.Exts                      (groupWith)
-import           Protolude
-import           Unsafe (unsafeHead)
+import Control.Applicative
 
-import           Data.Functor.Contravariant    (contramap)
-import           Contravariant.Extras          (contrazip2)
+import PostgREST.Types
+import Protolude
 
-getDbStructure :: Schema -> PgVersion -> H.Session DbStructure
+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
+
+getDbStructure :: Schema -> PgVersion -> HT.Transaction DbStructure
 getDbStructure schema pgVer = do
-  tabs      <- H.query () allTables
-  cols      <- H.query schema $ allColumns tabs
-  syns      <- H.query () $ allSynonyms cols
-  childRels <- H.query () $ allChildRelations tabs cols
-  keys      <- H.query () $ allPrimaryKeys tabs
-  procs     <- H.query schema allProcs
+  HT.sql "set local schema ''" -- for getting the fully qualified name(schema.name) of every db object
+  tabs      <- HT.statement () allTables
+  cols      <- HT.statement schema $ allColumns tabs
+  syns      <- HT.statement schema $ allSynonyms cols pgVer
+  childRels <- HT.statement () $ allChildRelations tabs cols
+  keys      <- HT.statement () $ allPrimaryKeys tabs
+  procs     <- HT.statement schema allProcs
 
-  let rels = addManyToManyRelations . addParentRelations $ addViewRelations syns childRels
+  let rels = addManyToManyRelations . addParentRelations $ addViewChildRelations syns childRels
       cols' = addForeignKeys rels cols
       keys' = addViewPrimaryKeys syns keys
 
@@ -60,70 +80,70 @@ getDbStructure schema pgVer = do
 
 decodeTables :: HD.Result [Table]
 decodeTables =
-  HD.rowsList tblRow
+  HD.rowList tblRow
  where
-  tblRow = Table <$> HD.value HD.text
-                 <*> HD.value HD.text
-                 <*> HD.nullableValue HD.text
-                 <*> HD.value HD.bool
+  tblRow = Table <$> column HD.text
+                 <*> column HD.text
+                 <*> nullableColumn HD.text
+                 <*> 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
-      <*> HD.value HD.text <*> HD.nullableValue HD.text
-      <*> HD.value HD.int4 <*> HD.value HD.bool
-      <*> HD.value HD.text <*> HD.value HD.bool
-      <*> HD.nullableValue HD.int4
-      <*> HD.nullableValue HD.int4
-      <*> HD.nullableValue HD.text
-      <*> HD.nullableValue HD.text
+      <$> column HD.text <*> column HD.text
+      <*> column HD.text <*> nullableColumn HD.text
+      <*> column HD.int4 <*> column HD.bool
+      <*> column HD.text <*> column HD.bool
+      <*> nullableColumn HD.int4
+      <*> nullableColumn HD.int4
+      <*> nullableColumn HD.text
+      <*> nullableColumn HD.text
 
 decodeRelations :: [Table] -> [Column] -> HD.Result [Relation]
 decodeRelations tables cols =
-  mapMaybe (relationFromRow tables cols) <$> HD.rowsList relRow
+  mapMaybe (relationFromRow tables cols) <$> HD.rowList relRow
  where
   relRow = (,,,,,)
-    <$> HD.value HD.text
-    <*> HD.value HD.text
-    <*> HD.value (HD.array (HD.arrayDimension replicateM (HD.arrayValue HD.text)))
-    <*> HD.value HD.text
-    <*> HD.value HD.text
-    <*> HD.value (HD.array (HD.arrayDimension replicateM (HD.arrayValue HD.text)))
+    <$> column HD.text
+    <*> column HD.text
+    <*> column (HD.array (HD.dimension replicateM (element HD.text)))
+    <*> column 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 [Synonym]
 decodeSynonyms cols =
-  mapMaybe (synonymFromRow cols) <$> HD.rowsList synRow
+  mapMaybe (synonymFromRow cols) <$> HD.rowList synRow
  where
   synRow = (,,,,,)
-    <$> HD.value HD.text <*> HD.value HD.text
-    <*> HD.value HD.text <*> HD.value HD.text
-    <*> HD.value HD.text <*> HD.value HD.text
+    <$> column HD.text <*> column HD.text
+    <*> column HD.text <*> column HD.text
+    <*> column HD.text <*> column HD.text
 
 decodeProcs :: HD.Result (M.HashMap Text [ProcDescription])
 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])) . addName) <$> HD.rowsList tblRow
+  map sort . M.fromListWith (++) . map ((\(x,y) -> (x, [y])) . addName) <$> HD.rowList tblRow
   where
     tblRow = ProcDescription
-              <$> HD.value HD.text
-              <*> HD.nullableValue HD.text
-              <*> (parseArgs <$> HD.value HD.text)
+              <$> column HD.text
+              <*> nullableColumn HD.text
+              <*> (parseArgs <$> column HD.text)
               <*> (parseRetType
-                  <$> HD.value HD.text
-                  <*> HD.value HD.text
-                  <*> HD.value HD.bool
-                  <*> HD.value HD.char)
-              <*> (parseVolatility <$> HD.value HD.char)
+                  <$> column HD.text
+                  <*> column HD.text
+                  <*> column HD.bool
+                  <*> column HD.char)
+              <*> (parseVolatility <$> column HD.char)
 
     addName :: ProcDescription -> (Text, ProcDescription)
     addName pd = (pdName pd, pd)
@@ -159,11 +179,11 @@ decodeProcs =
                       | v == 's' = Stable
                       | otherwise = Volatile -- only 'v' can happen here
 
-allProcs :: H.Query Schema (M.HashMap Text [ProcDescription])
-allProcs = H.statement (toS procsSqlQuery) (HE.value HE.text) decodeProcs True
+allProcs :: H.Statement Schema (M.HashMap Text [ProcDescription])
+allProcs = H.Statement (toS procsSqlQuery) (param HE.text) decodeProcs True
 
-accessibleProcs :: H.Query Schema (M.HashMap Text [ProcDescription])
-accessibleProcs = H.statement (toS sql) (HE.value HE.text) decodeProcs True
+accessibleProcs :: H.Statement Schema (M.HashMap Text [ProcDescription])
+accessibleProcs = H.Statement (toS sql) (param HE.text) decodeProcs True
   where
     sql = procsSqlQuery <> " AND has_function_privilege(p.oid, 'execute')"
 
@@ -186,9 +206,9 @@ procsSqlQuery = [q|
   WHERE  pn.nspname = $1
 |]
 
-schemaDescription :: H.Query Schema (Maybe Text)
+schemaDescription :: H.Statement Schema (Maybe Text)
 schemaDescription =
-    H.statement sql (HE.value HE.text) (join <$> HD.maybeRow (HD.nullableValue HD.text)) True
+    H.Statement sql (param HE.text) (join <$> HD.rowMaybe (nullableColumn HD.text)) True
   where
     sql = [q|
       select
@@ -199,9 +219,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
@@ -232,7 +252,7 @@ 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
     relToFk col Relation{relColumns=cols, relFColumns=colsF} = do
@@ -247,32 +267,32 @@ Having a Relation{relTable=t1, relColumns=[c1], relFTable=t2, relFColumns=[c2],
 
 t1.c1------t2.c2
 
-When only having a t1_view.c1 synonym, we need to add a View to Table Relation
+When only having a t1_view.c1 synonym, we need to add a View to Table Child Relation
 
          t1.c1----t2.c2         t1.c1----------t2.c2
-                         ->            --------/
+                         ->            ________/
                                       /
       t1_view.c1             t1_view.c1
 
 
-When only having a t2_view.c2 synonym, we need to add a Table to View Relation
+When only having a t2_view.c2 synonym, we need to add a Table to View Child 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 synonyms, we need to add a View to View Relation in addition to the prior
+When having t1_view.c1 and a t2_view.c2 synonyms, we need to add a View to View Child 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 synonyms.
 -}
-addViewRelations :: [Synonym] -> [Relation] -> [Relation]
-addViewRelations allSyns = concatMap (\rel ->
+addViewChildRelations :: [Synonym] -> [Relation] -> [Relation]
+addViewChildRelations allSyns = concatMap (\rel ->
   rel : case rel of
     Relation{relType=Child, relTable, relColumns, relFTable, relFColumns} ->
 
@@ -283,19 +303,32 @@ addViewRelations allSyns = concatMap (\rel ->
           fColsSyns = colSynsGroupedByView relFColumns
           getView :: [Synonym] -> Table
           getView = colTable . snd . unsafeHead
-          syns `allSynsOf` cols = S.fromList (fst <$> syns) == S.fromList cols in
+          syns `allSynsOf` cols = S.fromList (fst <$> syns) == 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 synonyms to match the relColumns
+          -- This could be avoided if the Relation type is improved with a structure that maintains the association of relColumns and relFColumns
+          syns `sortAccordingTo` columns = sortOn (\(k, _) -> L.lookup k $ zip columns [0::Int ..]) syns
 
-      -- View Table Relations
-      [Relation (getView syns) (snd <$> syns) relFTable relFColumns Child Nothing Nothing Nothing
-        | syns <- colsSyns, syns `allSynsOf` relColumns] ++
+          viewTableChild =
+            [ Relation (getView syns) (snd <$> syns `sortAccordingTo` relColumns)
+                       relFTable relFColumns
+                       Child Nothing Nothing Nothing
+            | syns <- colsSyns, syns `allSynsOf` relColumns ]
 
-      -- Table View Relations
-      [Relation relTable relColumns (getView fSyns) (snd <$> fSyns) Child Nothing Nothing Nothing
-        | fSyns <- fColsSyns, fSyns `allSynsOf` relFColumns] ++
+          tableViewChild =
+            [ Relation relTable relColumns
+                       (getView fSyns) (snd <$> fSyns `sortAccordingTo` relFColumns)
+                       Child Nothing Nothing Nothing
+            | fSyns <- fColsSyns, fSyns `allSynsOf` relFColumns ]
 
-      -- View View Relations
-      [Relation (getView syns) (snd <$> syns) (getView fSyns) (snd <$> fSyns) Child Nothing Nothing Nothing
-        | syns <- colsSyns, fSyns <- fColsSyns, syns `allSynsOf` relColumns, fSyns `allSynsOf` relFColumns]
+          viewViewChild =
+            [ Relation (getView syns) (snd <$> syns `sortAccordingTo` relColumns)
+                       (getView fSyns) (snd <$> fSyns `sortAccordingTo` relFColumns)
+                       Child Nothing Nothing Nothing
+            | syns <- colsSyns, syns `allSynsOf` relColumns
+            , fSyns <- fColsSyns, fSyns `allSynsOf` relFColumns ]
+
+      in viewTableChild ++ tableViewChild ++ viewViewChild
 
     _ -> [])
 
@@ -328,9 +361,9 @@ addViewPrimaryKeys syns = concatMap (\pk ->
                 filter (\(col, _) -> colTable col == pkTable pk && colName col == pkName pk) syns in
   pk : viewPks)
 
-allTables :: H.Query () [Table]
+allTables :: H.Statement () [Table]
 allTables =
-  H.statement sql HE.unit decodeTables True
+  H.Statement sql HE.noParams decodeTables True
  where
   sql = [q|
     SELECT
@@ -351,9 +384,9 @@ allTables =
     GROUP BY table_schema, table_name, insertable
     ORDER BY table_schema, table_name |]
 
-allColumns :: [Table] -> H.Query Schema [Column]
+allColumns :: [Table] -> H.Statement Schema [Column]
 allColumns tabs =
-  H.statement sql (HE.value HE.text) (decodeColumns tabs) True
+  H.Statement sql (param HE.text) (decodeColumns tabs) True
  where
   sql = [q|
     SELECT DISTINCT
@@ -388,7 +421,7 @@ allColumns tabs =
                pg_catalog.pg_namespace n
              WHERE
                r.contype IN ('f', 'p')
-               AND c.relkind IN ('r', 'v', 'f', 'mv')
+               AND c.relkind IN ('r', 'v', 'f', 'm')
                AND r.conrelid = c.oid
                AND c.relnamespace = n.oid
                AND n.nspname NOT IN ('pg_catalog', 'information_schema', $1)
@@ -404,7 +437,7 @@ allColumns tabs =
                 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
@@ -492,7 +525,7 @@ allColumns tabs =
                 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"]))
+                AND (c.relkind = ANY (ARRAY['r'::"char", 'v'::"char", 'f'::"char", 'm'::"char"]))
                 AND (nc.nspname = $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))*/
         )
@@ -536,11 +569,11 @@ 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 (==','))
 
-allChildRelations :: [Table] -> [Column] -> H.Query () [Relation]
+allChildRelations :: [Table] -> [Column] -> H.Statement () [Relation]
 allChildRelations tabs cols =
-  H.statement sql HE.unit (decodeRelations tabs cols) True
+  H.Statement sql HE.noParams (decodeRelations tabs cols) True
  where
   sql = [q|
     SELECT ns1.nspname AS table_schema,
@@ -579,9 +612,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|
     /*
@@ -689,80 +722,74 @@ 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 () [Synonym]
-allSynonyms cols =
-  H.statement sql HE.unit (decodeSynonyms cols) True
- where
-  -- query explanation at https://gist.github.com/ruslantalpa/2eab8c930a65e8043d8f
-  sql = [q|
-    with view_columns as (
+allSynonyms :: [Column] -> PgVersion -> H.Statement Schema [Synonym]
+allSynonyms cols pgVer =
+  H.Statement sql (param HE.text) (decodeSynonyms cols) True
+  -- query explanation at https://gist.github.com/steve-chavez/7ee0e6590cddafb532e5f00c46275569
+  where
+    subselectRegex :: Text
+    -- "result" appears when the subselect is used inside "case when", see `authors_have_book_in_decade` fixture
+    -- "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
-            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 (
+          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 = $1
+      ),
+      removed_subselects 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
-    |]
+          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; |]
 
 synonymFromRow :: [Column] -> (Text,Text,Text,Text,Text,Text) -> Maybe Synonym
 synonymFromRow allCols (s1,t1,c1,s2,t2,c2) = (,) <$> col1 <*> col2
@@ -772,21 +799,7 @@ synonymFromRow allCols (s1,t1,c1,s2,t2,c2) = (,) <$> col1 <*> col2
     findCol s t c = find (\col -> (tableSchema . colTable) col == s && (tableName . colTable) col == t && colName col == c) allCols
 
 getPgVersion :: H.Session PgVersion
-getPgVersion = H.query () $ H.statement sql HE.unit versionRow False
+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 <$> HD.value HD.int4 <*> HD.value HD.text
-
-fillSessionWithSettings :: [(Text, Text)] -> H.Session ()
-fillSessionWithSettings settings =
-    -- Send all of the config settings to the set_config function, using pgsql's `unnest` to transform arrays of values
-    H.query settings $ H.statement "SELECT set_config(k, v, false) FROM unnest($1, $2) AS f1(k, v)" encoder HD.unit False
-
-  where
-    -- Take a list of (key, value) pairs and encode each as an array to later bind to the query
-    -- see Insert Many section at https://hackage.haskell.org/package/hasql-1.1.1/docs/Hasql-Encoders.html
-    encoder = contramap L.unzip $ contrazip2 (vector HE.text) (vector HE.text)
-      where
-        vector value =
-          HE.value $ HE.array $ HE.arrayDimension foldl' $ HE.arrayValue value
-
+    versionRow = HD.singleRow $ PgVersion <$> column HD.int4 <*> column HD.text

src/PostgREST/Error.hs

@@ -1,97 +1,70 @@
+{-|
+Module      : PostgREST.Error
+Description : PostgREST error HTTP responses
+-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
-{-# LANGUAGE FlexibleInstances    #-}
-{-# LANGUAGE TypeSynonymInstances #-}
+{-# LANGUAGE FlexibleInstances #-}
 
 module PostgREST.Error (
-  apiRequestError
-, pgError
-, simpleError
+  errorResponseFor
+, ApiRequestError(..)
+, PgError(..)
+, SimpleError(..)
+, errorPayload
+, checkIsFatal
 , singularityError
-, binaryFieldError
-, connectionLostError
-, encodeError
-, gucHeadersError
 ) where
 
-import           Protolude
-import           Data.Aeson                ((.=))
 import qualified Data.Aeson                as JSON
-import           Data.Text                 (unwords)
 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
-import           Text.Read                 (readMaybe)
 
-apiRequestError :: ApiRequestError -> Response
-apiRequestError err =
-  errorResponse status
-    [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
-        InvalidFilters -> HT.status405
+import Data.Aeson  ((.=))
+import Data.Text   (unwords)
+import Network.Wai (Response, responseLBS)
+import Text.Read   (readMaybe)
 
-simpleError :: HT.Status -> [Header] -> Text -> Response
-simpleError status hdrs message =
-  errorResponse status (toHeader CTApplicationJSON : hdrs) $
-    JSON.object ["message" .= message]
+import Network.HTTP.Types.Header
 
-errorResponse :: JSON.ToJSON a => HT.Status -> [Header] -> a -> Response
-errorResponse status hdrs e =
-  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]
+import PostgREST.Types
+import Protolude
 
 
-binaryFieldError :: Response
-binaryFieldError =
-  simpleError HT.status406 [] (toS (toMime CTOctetStream) <>
-  " requested but a single column was not selected")
+class (JSON.ToJSON a) => PgrstError a where
+  status   :: a -> HT.Status
+  headers  :: a -> [Header]
 
-gucHeadersError :: Response
-gucHeadersError =
- simpleError HT.status500 []
- "response.headers guc must be a JSON array composed of objects with a single key and a string value"
+  errorPayload :: a -> LByteString
+  errorPayload = JSON.encode
 
-connectionLostError :: Response
-connectionLostError =
-  simpleError HT.status503 [] "Database connection lost, retrying the connection."
+  errorResponseFor :: a -> Response
+  errorResponseFor err = responseLBS (status err) (headers err) $ errorPayload err
 
-encodeError :: JSON.ToJSON a => a -> LByteString
-encodeError = JSON.encode
+
+
+data ApiRequestError
+  = ActionInappropriate
+  | InvalidRange
+  | InvalidBody ByteString
+  | ParseRequestError Text Text
+  | NoRelationBetween Text Text
+  | InvalidFilters
+  | 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 (NoRelationBetween _ _) = HT.status400
+
+  headers _ = [toHeader CTApplicationJSON]
 
 instance JSON.ToJSON ApiRequestError where
   toJSON (ParseRequestError message details) = JSON.object [
@@ -111,78 +84,173 @@ instance JSON.ToJSON ApiRequestError where
   toJSON InvalidFilters = JSON.object [
     "message" .= ("Filters must include all and only primary key columns with 'eq' operators" :: Text)]
 
+
+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.QueryError _ _ e) = JSON.toJSON e
+
+instance JSON.ToJSON H.CommandError where
   toJSON (H.ResultError (H.ServerError c m d h)) = case toS c of
-    '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)]
+    '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),
-    "details" .=
-      ("Attempt to parse more columns than there are in the result"::Text),
-    "details" .= (("Row number " <> show i)::Text)]
+    "message" .= ("Row error: end of input" :: Text),
+    "details" .= ("Attempt to parse more columns than there are in the result" :: Text),
+    "hint"    .= (("Row number " <> show i) :: Text)]
   toJSON (H.ResultError (H.RowError i H.UnexpectedNull)) = JSON.object [
-    "message" .= ("Row error: unexpected null"::Text),
-    "details" .= ("Attempt to parse a NULL as some value."::Text),
-    "details" .= (("Row number " <> show i)::Text)]
+    "message" .= ("Row error: unexpected null" :: Text),
+    "details" .= ("Attempt to parse a NULL as some value." :: Text),
+    "hint"    .= (("Row number " <> show i) :: Text)]
   toJSON (H.ResultError (H.RowError i (H.ValueError d))) = JSON.object [
-    "message" .= ("Row error: Wrong value parser used"::Text),
+    "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),
-    "details" .= (fmap toS d::Maybe Text)]
+    "message" .= ("Database client error" :: Text),
+    "details" .= (fmap toS d :: Maybe Text)]
 
-httpStatus :: Bool -> P.UsageError -> HT.Status
-httpStatus _ (P.ConnectionError _) = HT.status503
-httpStatus authed (P.SessionError (H.ResultError (H.ServerError c m _ _))) =
-  case toS c of
-    '0':'8':_ -> HT.status503 -- pg connection err
-    '0':'9':_ -> HT.status500 -- triggered action exception
-    '0':'L':_ -> HT.status403 -- invalid grantor
-    '0':'P':_ -> HT.status403 -- invalid role specification
-    "23503"   -> HT.status409 -- foreign_key_violation
-    "23505"   -> HT.status409 -- unique_violation
-    '2':'5':_ -> HT.status500 -- invalid tx state
-    '2':'8':_ -> HT.status403 -- invalid auth specification
-    '2':'D':_ -> HT.status500 -- invalid tx termination
-    '3':'8':_ -> HT.status500 -- external routine exception
-    '3':'9':_ -> HT.status500 -- external routine invocation
-    '3':'B':_ -> HT.status500 -- savepoint exception
-    '4':'0':_ -> HT.status500 -- tx rollback
-    '5':'3':_ -> HT.status503 -- insufficient resources
-    '5':'4':_ -> HT.status413 -- too complex
-    '5':'5':_ -> HT.status500 -- obj not on prereq state
-    '5':'7':_ -> HT.status500 -- operator intervention
-    '5':'8':_ -> HT.status500 -- system error
-    'F':'0':_ -> HT.status500 -- conf file error
-    'H':'V':_ -> HT.status500 -- foreign data wrapper error
-    "P0001"   -> HT.status400 -- default code for "raise"
-    'P':'0':_ -> HT.status500 -- PL/pgSQL Error
-    'X':'X':_ -> HT.status500 -- internal Error
-    "42883"   -> HT.status404 -- undefined function
-    "42P01"   -> HT.status404 -- undefined table
-    "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
-httpStatus _ (P.SessionError (H.ResultError _)) = HT.status500
-httpStatus _ (P.SessionError (H.ClientError _)) = HT.status503
+pgErrorStatus :: Bool -> P.UsageError -> HT.Status
+pgErrorStatus _      (P.ConnectionError _)                                      = HT.status503
+pgErrorStatus _      (P.SessionError (H.QueryError _ _ (H.ClientError _)))      = HT.status503
+pgErrorStatus authed (P.SessionError (H.QueryError _ _ (H.ResultError rError))) =
+  case rError of
+    (H.ServerError c m _ _) ->
+      case toS c of
+        '0':'8':_ -> HT.status503 -- pg connection err
+        '0':'9':_ -> HT.status500 -- triggered action exception
+        '0':'L':_ -> HT.status403 -- invalid grantor
+        '0':'P':_ -> HT.status403 -- invalid role specification
+        "23503"   -> HT.status409 -- foreign_key_violation
+        "23505"   -> HT.status409 -- unique_violation
+        '2':'5':_ -> HT.status500 -- invalid tx state
+        '2':'8':_ -> HT.status403 -- invalid auth specification
+        '2':'D':_ -> HT.status500 -- invalid tx termination
+        '3':'8':_ -> HT.status500 -- external routine exception
+        '3':'9':_ -> HT.status500 -- external routine invocation
+        '3':'B':_ -> HT.status500 -- savepoint exception
+        '4':'0':_ -> HT.status500 -- tx rollback
+        '5':'3':_ -> HT.status503 -- insufficient resources
+        '5':'4':_ -> HT.status413 -- too complex
+        '5':'5':_ -> HT.status500 -- obj not on prereq state
+        '5':'7':_ -> HT.status500 -- operator intervention
+        '5':'8':_ -> HT.status500 -- system error
+        'F':'0':_ -> HT.status500 -- conf file error
+        'H':'V':_ -> HT.status500 -- foreign data wrapper error
+        "P0001"   -> HT.status400 -- default code for "raise"
+        'P':'0':_ -> HT.status500 -- PL/pgSQL Error
+        'X':'X':_ -> HT.status500 -- internal Error
+        "42883"   -> HT.status404 -- undefined function
+        "42P01"   -> HT.status404 -- undefined table
+        "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" .= 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,59 +1,57 @@
+{-|
+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 qualified Data.HashMap.Strict           as M
-import qualified Hasql.Transaction             as H
+import qualified Data.Aeson          as JSON
+import qualified Data.HashMap.Strict as M
+import qualified Hasql.Transaction   as H
 
-import           Network.HTTP.Types.Status     (unauthorized401, status500)
-import           Network.Wai                   (Application, Response)
-import           Network.Wai.Middleware.Cors   (cors)
-import           Network.Wai.Middleware.Gzip   (def, gzip)
-import           Network.Wai.Middleware.Static (only, staticPolicy)
+import Network.Wai                   (Application, Response)
+import Network.Wai.Middleware.Cors   (cors)
+import Network.Wai.Middleware.Gzip   (def, gzip)
+import Network.Wai.Middleware.Static (only, staticPolicy)
 
-import           PostgREST.ApiRequest          (ApiRequest(..))
-import           PostgREST.Auth                (JWTAttempt(..))
-import           PostgREST.Config              (AppConfig (..), corsPolicy)
-import           PostgREST.Error               (simpleError)
-import           PostgREST.QueryBuilder        (pgFmtLit, unquoted, pgFmtEnvVar)
+import Crypto.JWT
 
-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 (pgFmtSetLocal, pgFmtSetLocalSearchPath,
+                               unquoted)
+import Protolude
 
 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"
-    JWTInvalid e -> return $ unauthed $ show e
-    JWTMissingSecret -> return $ simpleError status500 [] "Server lacks JWT secret"
-    JWTClaims claims -> do
-      H.sql $ toS.mconcat $ setSchemaSql ++ setRoleSql ++ claimsSql ++ headersSql ++ cookiesSql
+    JWTMissingSecret      -> return . errorResponseFor $ JwtTokenMissing
+    JWTInvalid JWTExpired -> return . errorResponseFor . JwtTokenInvalid $ "JWT expired"
+    JWTInvalid e          -> return . errorResponseFor . JwtTokenInvalid . show $ e
+    JWTClaims claims      -> do
+      H.sql $ toS . mconcat $ setSearchPathSql : setRoleSql ++ claimsSql ++ headersSql ++ cookiesSql ++ appSettingsSql
       mapM_ H.sql customReqCheck
       app req
       where
-        headersSql = map (pgFmtEnvVar "request.header.") $ iHeaders req
-        cookiesSql = map (pgFmtEnvVar "request.cookie.") $ iCookies req
-        claimsSql = map (pgFmtEnvVar "request.jwt.claim.") [(c,unquoted v) | (c,v) <- M.toList claimsWithRole]
-        setRoleSql = maybeToList $
-          (\r -> "set local role " <> r <> ";") . toS . pgFmtLit . unquoted <$> M.lookup "role" claimsWithRole
-        setSchemaSql = ["set schema " <> pgFmtLit (configSchema conf) <> ";"] :: [Text]
+        headersSql = pgFmtSetLocal "request.header." <$> iHeaders req
+        cookiesSql = pgFmtSetLocal "request.cookie." <$> iCookies req
+        claimsSql = pgFmtSetLocal "request.jwt.claim." <$> [(c,unquoted v) | (c,v) <- M.toList claimsWithRole]
+        appSettingsSql = pgFmtSetLocal mempty <$> configSettings conf
+        setRoleSql = maybeToList $ (\x ->
+          pgFmtSetLocal mempty ("role", unquoted x)) <$> M.lookup "role" claimsWithRole
+        setSearchPathSql = pgFmtSetLocalSearchPath $ configSchema conf : configExtraSearchPath conf
         -- role claim defaults to anon if not specified in jwt
         claimsWithRole = M.union claims (M.singleton "role" anon)
         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 =

src/PostgREST/OpenAPI.hs

@@ -1,40 +1,54 @@
+{-|
+Module      : PostgREST.OpenAPI
+Description : Generates the OpenAPI output
+-}
 {-# LANGUAGE OverloadedStrings #-}
 
 module PostgREST.OpenAPI (
   encodeOpenAPI
-  , isMalformedProxyUri
-  , pickProxy
-  ) where
+, isMalformedProxyUri
+, pickProxy
+) where
 
-import           Control.Arrow               ((&&&))
-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 qualified Data.Set as Set
 
-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.Config            (prettyVersion, docsVersion)
-import           PostgREST.Types             (Table(..), Column(..), PgArg(..), ForeignKey(..),
-                                              PrimaryKey(..), Proxy(..), ProcDescription(..), toMime)
+import PostgREST.ApiRequest (ContentType (..))
+import PostgREST.Config     (docsVersion, prettyVersion)
+import PostgREST.Types      (Column (..), ForeignKey (..), PgArg (..),
+                             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 "integer"   = SwaggerInteger
-toSwaggerType "boolean"   = SwaggerBoolean
-toSwaggerType "numeric"   = SwaggerNumber
-toSwaggerType _           = SwaggerString
+toSwaggerType "character varying" = SwaggerString
+toSwaggerType "character"         = SwaggerString
+toSwaggerType "text"              = SwaggerString
+toSwaggerType "boolean"           = SwaggerBoolean
+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, _) =
@@ -42,7 +56,8 @@ makeTableDef pks (t, cs, _) =
       (tn, (mempty :: Schema)
         & description .~ tableDescription t
         & 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 =
@@ -197,10 +212,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 +237,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]
@@ -310,7 +333,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 +341,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 +359,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 +368,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,18 +1,30 @@
+{-|
+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, option)
-import           Control.Monad                 ((>>))
-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)
-import           PostgREST.Types
-import           Text.ParserCombinators.Parsec hiding (many, (<|>))
-import           Text.Parsec.Error
-import           Text.Read                     (read)
+import qualified Data.HashMap.Strict as M
+import qualified Data.Set            as S
+
+import Control.Monad           ((>>))
+import Data.Either.Combinators (mapLeft)
+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 =
@@ -44,9 +56,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
-    -- Concat op and v to make pLogicTree argument regular, in the form of "?and=and(.. , ..)" instead of "?and=(.. , ..)"
-    logicTree = join $ parse pLogicTree ("failed to parse logic tree (" ++ toS v ++ ")") . toS <$> ((<>) <$> op <*> pure v)
+    logicTree = do
+      op <- snd <$> path
+      -- Concat op and v to make pLogicTree argument regular,
+      -- in the form of "?and=and(.. , ..)" instead of "?and=(.. , ..)"
+      parse pLogicTree ("failed to parse logic tree (" ++ toS v ++ ")") $ toS (op <> v)
+
+pRequestColumns :: Maybe Text -> Either ApiRequestError (Maybe (S.Set FieldName))
+pRequestColumns colStr =
+  case colStr of
+    Just str ->
+      mapError $ Just . S.fromList <$> parse pColumns ("failed to parse columns parameter (" <> toS str <> ")") (toS str)
+    _ -> Right Nothing
 
 ws :: Parser Text
 ws = toS <$> many (oneOf " \t")
@@ -57,7 +78,7 @@ lexeme p = ws *> p <* ws
 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]
@@ -68,26 +89,39 @@ pFieldForest = pFieldTree `sepBy1` lexeme (char ',')
                   Node <$> pFieldSelect <*> pure []
 
 pStar :: Parser Text
-pStar = toS <$> (string "*" *> pure ("*"::ByteString))
+pStar = toS <$> (string "*" $> ("*"::ByteString))
 
 pFieldName :: Parser Text
-pFieldName = do
-  matches <- (many1 (letter <|> digit <|> oneOf "_") `sepBy1` dash) <?> "field name (* or [a..z0..9_])"
-  return $ intercalate "-" $ map toS matches
+pFieldName =
+  pQuotedValue <|>
+  intercalate "-" . map toS <$> (many1 (letter <|> digit <|> oneOf "_ ") `sepBy1` dash) <?>
+  "field name (* or [a..z0..9_])"
   where
     isDash :: GenParser Char st ()
     isDash = try ( char '-' >> notFollowedBy (char '>') )
     dash :: Parser Char
-    dash = isDash *> pure '-'
+    dash = isDash $> '-'
 
-pJsonPathStep :: Parser Text
-pJsonPathStep = toS <$> try (string "->" *> pFieldName)
+pJsonPath :: Parser JsonPath
+pJsonPath = many pJsonOperation
+  where
+    pJsonOperation :: Parser JsonOperation
+    pJsonOperation = pJsonArrow <*> pJsonOperand
 
-pJsonPath :: Parser [Text]
-pJsonPath = (<>) <$> many pJsonPathStep <*> ( (:[]) <$> (string "->>" *> pFieldName) )
+    pJsonArrow   =
+      try (string "->>" $> J2Arrow) <|>
+      try (string "->" $> JArrow)
+
+    pJsonOperand =
+      let pJKey = JKey . toS <$> pFieldName
+          pJIdx = JIdx . toS <$> ((:) <$> option '+' (char '-') <*> many1 digit) <* pEnd
+          pEnd = try (void $ lookAhead (string "->")) <|>
+                 try (void $ lookAhead (string "::")) <|>
+                 try eof in
+      try pJIdx <|> try pJKey
 
 pField :: Parser Field
-pField = lexeme $ (,) <$> pFieldName <*> optionMaybe pJsonPath
+pField = lexeme $ (,) <$> pFieldName <*> option [] pJsonPath
 
 aliasSeparator :: Parser ()
 aliasSeparator = char ':' >> notFollowedBy (char ':')
@@ -96,7 +130,10 @@ pRelationSelect :: Parser SelectItem
 pRelationSelect = lexeme $ try ( do
     alias <- optionMaybe ( try(pFieldName <* aliasSeparator) )
     fld <- pField
-    relationDetail <- optionMaybe ( try( char '.' *> pFieldName ) )
+    relationDetail <- optionMaybe (
+        try ( char '!' *> pFieldName ) <|>
+        try ( char '.' *> pFieldName ) -- TODO deprecated, remove in next major version
+      )
 
     return (fld, Nothing, alias, relationDetail)
   )
@@ -112,7 +149,7 @@ pFieldSelect = lexeme $
   )
   <|> do
     s <- pStar
-    return ((s, Nothing), Nothing, Nothing, Nothing)
+    return ((s, []), Nothing, Nothing, Nothing)
 
 pOpExpr :: Parser SingleVal -> Parser OpExpr
 pOpExpr pSVal = try ( string "not" *> pDelimiter *> (OpExpr True <$> pOperation)) <|> OpExpr False <$> pOperation
@@ -139,10 +176,10 @@ pListVal :: Parser ListVal
 pListVal = lexeme (char '(') *> pListElement `sepBy1` char ',' <* lexeme (char ')')
 
 pListElement :: Parser Text
-pListElement = try pQuotedValue <|> (toS <$> many (noneOf ",)"))
+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 (.)"
@@ -172,16 +209,16 @@ pLogicTree = Stmnt <$> try pLogicFilter
     pLogicFilter :: Parser Filter
     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)
-               <|> string "or" *> pure Or
+    pLogicOp = try (string "and" $> And)
+               <|> string "or" $> Or
                <?> "logic operator (and, or)"
 
 pLogicSingleVal :: Parser SingleVal
-pLogicSingleVal = try pQuotedValue <|> try pPgArray <|> (toS <$> many (noneOf ",)"))
+pLogicSingleVal = try (pQuotedValue <* notFollowedBy (noneOf ",)")) <|> try pPgArray <|> (toS <$> many (noneOf ",)"))
   where
     pPgArray :: Parser Text
     pPgArray =  do
@@ -197,6 +234,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
@@ -222,9 +262,7 @@ pJSPath = toJSPath <$> (period *> pPath `sepBy` period <* eof)
     pPath = (,) <$> pJSPKey <*> optionMaybe pJSPIdx
 
 pJSPKey :: Parser Text
-pJSPKey = toS <$> (many1 (alphaNum <|> oneOf "_$@") <|> pQuoted) <?> "attribute name [a..z0..9_$@])"
-  where
-    pQuoted = char '"' *> many (noneOf "\"") <* char '"'
+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/QueryBuilder.hs

@@ -1,7 +1,7 @@
-{-# LANGUAGE FlexibleInstances    #-}
-{-# LANGUAGE FlexibleContexts    #-}
-{-# LANGUAGE DuplicateRecordFields    #-}
-{-# OPTIONS_GHC -fno-warn-orphans #-}
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE FlexibleContexts      #-}
+{-# LANGUAGE FlexibleInstances     #-}
+{-# OPTIONS_GHC -fno-warn-orphans  #-}
 {-|
 Module      : PostgREST.QueryBuilder
 Description : PostgREST SQL generating functions.
@@ -16,198 +16,35 @@ module PostgREST.QueryBuilder (
     callProc
   , createReadStatement
   , createWriteStatement
-  , pgFmtIdent
-  , pgFmtLit
   , requestToQuery
   , requestToCountQuery
   , unquoted
   , ResultsWithCount
-  , pgFmtEnvVar
+  , pgFmtSetLocal
+  , pgFmtSetLocalSearchPath
   ) where
 
-import qualified Hasql.Query             as H
-import qualified Hasql.Encoders          as HE
-import qualified Hasql.Decoders          as HD
+import qualified Data.Aeson as JSON
+import qualified Data.Set   as S
 
-import qualified Data.Aeson              as JSON
+import Data.Scientific (FPFormat (..), formatScientific, isInteger)
+import Data.Text       (intercalate, unwords)
+import Data.Tree       (Tree (..))
 
-import           PostgREST.Config        (pgVersion96)
-import           PostgREST.RangeQuery    (rangeLimit, rangeOffset, allRange)
-import qualified Data.HashMap.Strict     as HM
-import           Data.Maybe
-import qualified Data.Set                as S
-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           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 (..))
+import Data.Maybe
 
-{-| 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)
-
-standardRow :: HD.Row ResultsWithCount
-standardRow = (,,,) <$> HD.nullableValue HD.int8 <*> HD.value HD.int8
-                    <*> HD.value header <*> HD.value HD.bytea
-  where
-    header = HD.array $ HD.arrayDimension replicateM $ HD.arrayValue HD.bytea
-
-noLocationF :: Text
-noLocationF = "array[]::text[]"
-
-{-| 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.
--}
-decodeStandard :: HD.Result ResultsWithCount
-decodeStandard =
-  HD.singleRow standardRow
-
-decodeStandardMay :: HD.Result (Maybe ResultsWithCount)
-decodeStandardMay =
-  HD.maybeRow standardRow
-
-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
-    | asCsv = asCsvF
-    | isSingle = asJsonSingleF
-    | isJust binaryField = asBinaryF $ fromJust binaryField
-    | otherwise = asJsonF
-
-
-createWriteStatement :: SqlQuery -> SqlQuery -> Bool -> Bool -> Bool ->
-                        PreferRepresentation -> [Text] ->
-                        H.Query ByteString (Maybe ResultsWithCount)
-createWriteStatement selectQuery mutateQuery wantSingle wantHdrs asCsv rep pKeys =
-  unicodeStatement sql (HE.value HE.unknown) decodeStandardMay True
-
- where
-  sql = case rep of
-    None -> [qc|
-      WITH {sourceCTEName} AS ({mutateQuery})
-      SELECT '', 0, {noLocationF}, '' |]
-    HeadersOnly -> [qc|
-      WITH {sourceCTEName} AS ({mutateQuery})
-      SELECT {cols}
-      FROM (SELECT 1 FROM {sourceCTEName}) _postgrest_t |]
-    Full -> [qc|
-      WITH {sourceCTEName} AS ({mutateQuery})
-      SELECT {cols}
-      FROM ({selectQuery}) _postgrest_t |]
-
-  cols = intercalate ", " [
-      "'' AS total_result_set", -- when updateing it does not make sense
-      "pg_catalog.count(_postgrest_t) AS page_total",
-      if wantHdrs
-         then "coalesce(" <> locationF pKeys <> ", " <> noLocationF <> ")"
-         else noLocationF <> " AS header",
-      if rep == Full
-         then bodyF <> " AS body"
-         else "''"
-    ]
-
-  bodyF
-    | asCsv = asCsvF
-    | wantSingle = asJsonSingleF
-    | otherwise = asJsonF
-
-type ProcResults = (Maybe Int64, Int64, ByteString, ByteString)
-callProc :: QualifiedIdentifier -> [PgArg] -> Bool -> SqlQuery -> SqlQuery -> Bool ->
-            Bool -> Bool -> Bool -> Bool -> Maybe FieldName -> Bool -> PgVersion ->
-            H.Query ByteString (Maybe ProcResults)
-callProc qi pgArgs returnsScalar selectQuery countQuery countTotal isSingle paramsAsSingleObject asCsv asBinary binaryField isObject pgVer =
-  unicodeStatement sql (HE.value HE.unknown) decodeProc True
-  where
-    sql =
-     if returnsScalar then [qc|
-       WITH {argsRecord},
-       {sourceCTEName} AS (
-         SELECT {fromQi qi}({args})
-       )
-       SELECT
-         {countResultF} AS total_result_set,
-         1 AS page_total,
-         {scalarBodyF} AS body,
-         {responseHeaders} AS response_headers
-       FROM ({selectQuery}) _postgrest_t;|]
-     else [qc|
-       WITH {argsRecord},
-       {sourceCTEName} AS (
-         SELECT * FROM {fromQi qi}({args})
-       )
-       SELECT
-         {countResultF} AS total_result_set,
-         pg_catalog.count(_postgrest_t) AS page_total,
-         {bodyF} AS body,
-         {responseHeaders} AS response_headers
-       FROM ({selectQuery}) _postgrest_t;|]
-
-    (argsRecord, args) | paramsAsSingleObject = ("_args_record AS (SELECT NULL)", "$1::json")
-                       | null pgArgs = (ignoredBody, "")
-                       | otherwise = (
-                           unwords [
-                           "_args_record AS (",
-                             "SELECT * FROM " <> (if isObject then "json_to_record" else "json_to_recordset") <> "($1)",
-                             "AS _(" <> intercalate ", " ((\a -> pgaName a <> " " <> pgaType a) <$> pgArgs) <> ")",
-                           ")"]
-                         , intercalate ", " ((\a -> pgaName a <> " := (SELECT " <> pgaName a <> " FROM _args_record)") <$> pgArgs))
-    countResultF = if countTotal then "( "<> countQuery <> ")" else "null::bigint" :: Text
-    _procName = qiName qi
-    responseHeaders =
-      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
-    decodeProc = HD.maybeRow procRow
-    procRow = (,,,) <$> HD.nullableValue HD.int8 <*> HD.value HD.int8
-                    <*> HD.value HD.bytea <*> 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
+import PostgREST.QueryBuilder.Private
+import PostgREST.QueryBuilder.Procedure
+import PostgREST.QueryBuilder.ReadStatement
+import PostgREST.QueryBuilder.WriteStatement
+import PostgREST.RangeQuery                  (allRange, rangeLimit,
+                                              rangeOffset)
+import PostgREST.Types
+import Protolude                             hiding (cast,
+                                              intercalate, replace)
 
 requestToCountQuery :: Schema -> DbRequest -> SqlQuery
-requestToCountQuery _ (DbMutate _) = undefined
+requestToCountQuery _ (DbMutate _) = witness
 requestToCountQuery schema (DbRead (Node (Select{where_=logicForest}, (mainTbl, _, _, _, _)) _)) =
  unwords [
    "SELECT pg_catalog.count(*)",
@@ -218,32 +55,21 @@ requestToCountQuery schema (DbRead (Node (Select{where_=logicForest}, (mainTbl,
    qi = removeSourceCTESchema schema mainTbl
 
 requestToQuery :: Schema -> Bool -> DbRequest -> SqlQuery
-requestToQuery schema isParent (DbRead (Node (Select colSelects tbls logicForest joinConditions_ ordts range, (nodeName, maybeRelation, _, _, depth)) forest)) =
+requestToQuery schema isParent (DbRead (Node (Select colSelects tbl tblAlias implJoins logicForest joinConditions_ ordts range, _) forest)) =
   unwords [
     "SELECT " <> intercalate ", " (map (pgFmtSelectItem qi) colSelects ++ selects),
-    "FROM " <> intercalate ", " tables,
+    "FROM " <> intercalate ", " (tabl : implJs),
     unwords joins,
-    ("WHERE " <> intercalate " AND " (map (pgFmtLogicTree qi) logicForest ++ map pgFmtJoinCondition joinConds))
-      `emptyOnFalse` (null logicForest && null joinConds),
+    ("WHERE " <> intercalate " AND " (map (pgFmtLogicTree qi) logicForest ++ map pgFmtJoinCondition joinConditions_))
+      `emptyOnFalse` (null logicForest && null joinConditions_),
     ("ORDER BY " <> intercalate ", " (map (pgFmtOrderTerm qi) ordts)) `emptyOnFalse` null ordts,
     ("LIMIT " <> maybe "ALL" show (rangeLimit range) <> " OFFSET " <> show (rangeOffset range)) `emptyOnFalse` (isParent || range == allRange) ]
 
   where
-    mainTbl = fromMaybe nodeName (tableName . relTable <$> maybeRelation)
-    isSelfJoin = maybe False (\r -> relType r /= Root && relTable r == relFTable r) maybeRelation
-    (qi, tables, joinConds) =
-      let depthAlias name dpth = if dpth /= 0  then name <> "_" <> show dpth else name in -- Root node doesn't get aliased
-      if isSelfJoin
-        then (
-          QualifiedIdentifier "" (depthAlias mainTbl depth),
-          (\t -> fromQi (removeSourceCTESchema schema t) <> " AS " <> pgFmtIdent (depthAlias t depth)) <$> tbls,
-          (\(JoinCondition (qi1, _, c1) (qi2, _, c2)) ->
-            JoinCondition (qi1, Just $ depthAlias (qiName qi1) depth, c1)
-                          (qi2, Just $ depthAlias (qiName qi2) (depth - 1), c2)) <$> joinConditions_)
-        else (
-          removeSourceCTESchema schema mainTbl,
-          fromQi . removeSourceCTESchema schema <$> tbls,
-          joinConditions_)
+    implJs = fromQi . QualifiedIdentifier schema <$> implJoins
+    mainQi = removeSourceCTESchema schema tbl
+    tabl = fromQi mainQi <> maybe mempty (\a -> " AS " <> pgFmtIdent a) tblAlias
+    qi = maybe mainQi (QualifiedIdentifier mempty) tblAlias
 
     (joins, selects) = foldr getQueryParts ([],[]) forest
 
@@ -272,49 +98,43 @@ requestToQuery schema isParent (DbRead (Node (Select colSelects tbls logicForest
     --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 pkCols p@(PayloadJSON _ pType pKeys) onConflct logicForest returnings)) =
+    getQueryParts _ _ = witness
+requestToQuery schema _ (DbMutate (Insert mainTbl iCols onConflct putConditions returnings)) =
   unwords [
-    ("WITH " <> ignoredBody) `emptyOnFalse` not payloadIsEmpty,
-    "INSERT INTO ", fromQi qi, if payloadIsEmpty then " " else "(" <> cols <> ")",
-    case (pType, payloadIsEmpty) of
-      (PJArray _, True) -> "SELECT null WHERE false"
-      (PJObject, True)  -> "DEFAULT VALUES"
-      _ -> unwords [
-        "SELECT " <> cols <> " FROM",
-        case pType of
-          PJObject  -> "json_populate_record"
-          PJArray _ -> "json_populate_recordset", "(null::", fromQi qi, ", $1) _",
-        -- Only used for PUT
-        ("WHERE " <> intercalate " AND " (pgFmtLogicTree (QualifiedIdentifier "" "_") <$> logicForest)) `emptyOnFalse` null logicForest],
-    maybe "" (\x -> (
-      "ON CONFLICT(" <> intercalate ", " pkCols <> ") " <> case x of
+    "WITH " <> normalizedBody,
+    "INSERT INTO ", fromQi qi, if S.null iCols then " " else "(" <> cols <> ")",
+    unwords [
+      "SELECT " <> cols <> " FROM",
+      "json_populate_recordset", "(null::", fromQi qi, ", " <> selectBody <> ") _",
+      -- Only used for PUT
+      ("WHERE " <> intercalate " AND " (pgFmtLogicTree (QualifiedIdentifier "" "_") <$> putConditions)) `emptyOnFalse` null putConditions],
+    maybe "" (\(oncDo, oncCols) -> (
+      "ON CONFLICT(" <> intercalate ", " (pgFmtIdent <$> oncCols) <> ") " <> case oncDo of
       IgnoreDuplicates ->
         "DO NOTHING"
       MergeDuplicates  ->
-        "DO UPDATE SET " <> intercalate ", " (pgFmtIdent <> const " = EXCLUDED." <> pgFmtIdent <$> S.toList pKeys)
-    ) `emptyOnFalse` null pkCols) onConflct,
+        if S.null iCols
+           then "DO NOTHING"
+           else "DO UPDATE SET " <> intercalate ", " (pgFmtIdent <> const " = EXCLUDED." <> pgFmtIdent <$> S.toList iCols)
+                                   ) `emptyOnFalse` null oncCols) onConflct,
     ("RETURNING " <> intercalate ", " (map (pgFmtColumn qi) returnings)) `emptyOnFalse` null returnings]
   where
     qi = QualifiedIdentifier schema mainTbl
-    cols = intercalate ", " $ pgFmtIdent <$> S.toList pKeys
-    payloadIsEmpty = pjIsEmpty p
-requestToQuery schema _ (DbMutate (Update mainTbl p@(PayloadJSON _ pType keys) logicForest returnings)) =
-  if pjIsEmpty p
-    then "WITH " <> ignoredBody <> "SELECT ''"
+    cols = intercalate ", " $ pgFmtIdent <$> S.toList iCols
+requestToQuery schema _ (DbMutate (Update mainTbl uCols logicForest returnings)) =
+  if S.null uCols
+    then "WITH " <> ignoredBody <> "SELECT null WHERE false" -- if there are no columns we cannot do UPDATE table SET {empty}, it'd be invalid syntax
     else
       unwords [
+        "WITH " <> normalizedBody,
         "UPDATE " <> fromQi qi <> " SET " <> cols,
-        "FROM (SELECT * FROM ",
-        case pType of
-           PJObject  -> " json_populate_record"
-           PJArray _ -> " json_populate_recordset", "(null::", fromQi qi, ", $1)) _ ",
-        ("WHERE " <> intercalate " AND " (map (pgFmtLogicTree qi) logicForest)) `emptyOnFalse` null logicForest,
-        ("RETURNING " <> intercalate ", " (map (pgFmtColumn qi) returnings)) `emptyOnFalse` null returnings
+        "FROM (SELECT * FROM json_populate_recordset", "(null::", fromQi qi, ", " <> selectBody <> ")) _ ",
+        ("WHERE " <> intercalate " AND " (pgFmtLogicTree qi <$> logicForest)) `emptyOnFalse` null logicForest,
+        ("RETURNING " <> intercalate ", " (pgFmtColumn qi <$> returnings)) `emptyOnFalse` null returnings
         ]
   where
     qi = QualifiedIdentifier schema mainTbl
-    cols = intercalate ", " (pgFmtIdent <> const " = _." <> pgFmtIdent <$> S.toList keys)
+    cols = intercalate ", " (pgFmtIdent <> const " = _." <> pgFmtIdent <$> S.toList uCols)
 requestToQuery schema _ (DbMutate (Delete mainTbl logicForest returnings)) =
   unwords [
     "WITH " <> ignoredBody,
@@ -325,143 +145,9 @@ requestToQuery schema _ (DbMutate (Delete mainTbl logicForest returnings)) =
   where
     qi = QualifiedIdentifier schema mainTbl
 
--- 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 = "ignored_body AS (SELECT $1::text) "
-
-removeSourceCTESchema :: Schema -> TableName -> QualifiedIdentifier
-removeSourceCTESchema schema tbl = QualifiedIdentifier (if tbl == sourceCTEName then "" else schema) tbl
-
 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
-
--- private functions
-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
-
-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
-
-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
-
-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 (qi, al1, col1) (QualifiedIdentifier schema fTable, al2, col2)) =
-  pgFmtColumn (fromMaybe qi $ aliasToQi al1) col1 <> " = " <>
-  pgFmtColumn (fromMaybe (removeSourceCTESchema schema fTable) $ aliasToQi al2) col2
-  where
-    aliasToQi al = QualifiedIdentifier "" <$> al
-
-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/QueryBuilder/Private.hs

@@ -0,0 +1,237 @@
+{-# LANGUAGE LambdaCase #-}
+{-|
+Module      : PostgREST.QueryBuilder.Private
+Description : Helper functions for PostgREST.QueryBuilder.
+-}
+module PostgREST.QueryBuilder.Private where
+
+import qualified Data.ByteString.Char8         as BS
+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 qualified Data.Text.Encoding            as T
+import qualified Hasql.Decoders                as HD
+import qualified Hasql.Encoders                as HE
+import qualified Hasql.Statement               as H
+import           PostgREST.Types
+import           Protolude                     hiding (cast,
+                                                intercalate, replace)
+import           Text.InterpolatedString.Perl6 (qc)
+
+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
+
+{-| 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)
+
+standardRow :: HD.Row ResultsWithCount
+standardRow = (,,,) <$> nullableColumn HD.int8 <*> column HD.int8
+                    <*> column header <*> column HD.bytea
+  where
+    header = HD.array $ HD.dimension replicateM $ element HD.bytea
+
+noLocationF :: Text
+noLocationF = "array[]::text[]"
+
+{-| 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.
+-}
+decodeStandard :: HD.Result ResultsWithCount
+decodeStandard =
+  HD.singleRow standardRow
+
+decodeStandardMay :: HD.Result (Maybe ResultsWithCount)
+decodeStandardMay =
+  HD.rowMaybe standardRow
+
+removeSourceCTESchema :: Schema -> TableName -> QualifiedIdentifier
+removeSourceCTESchema schema tbl = QualifiedIdentifier (if tbl == sourceCTEName then "" else schema) tbl
+
+-- 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 = "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
+
+unicodeStatement :: Text -> HE.Params a -> HD.Result b -> Bool -> H.Statement a b
+unicodeStatement = H.Statement . T.encodeUtf8
+
+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 (qi, col1) (QualifiedIdentifier schema fTable, col2)) =
+  pgFmtColumn qi col1 <> " = " <>
+  pgFmtColumn (removeSourceCTESchema schema fTable) 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
+
+pgFmtSetLocal :: Text -> (Text, Text) -> SqlFragment
+pgFmtSetLocal prefix (k, v) =
+  "SET LOCAL " <> pgFmtIdent (prefix <> k) <> " = " <> pgFmtLit v <> ";"
+
+pgFmtSetLocalSearchPath :: [Text] -> SqlFragment
+pgFmtSetLocalSearchPath vals =
+  "SET LOCAL search_path = " <> intercalate ", " (pgFmtLit <$> vals) <> ";"
+
+trimNullChars :: Text -> Text
+trimNullChars = T.takeWhile (/= '\x0')

src/PostgREST/QueryBuilder/Procedure.hs

@@ -0,0 +1,85 @@
+module PostgREST.QueryBuilder.Procedure where
+
+import           Data.Maybe
+import           Data.Text                      (intercalate, unwords)
+import qualified Hasql.Decoders                 as HD
+import qualified Hasql.Encoders                 as HE
+import qualified Hasql.Statement                as H
+import           PostgREST.QueryBuilder.Private
+import           PostgREST.Types
+import           Protolude                      hiding (cast,
+                                                 intercalate, replace)
+import           Text.InterpolatedString.Perl6  (qc)
+
+type ProcResults = (Maybe Int64, Int64, ByteString, ByteString)
+callProc :: QualifiedIdentifier -> [PgArg] -> Bool -> SqlQuery -> SqlQuery -> Bool ->
+            Bool -> Bool -> Bool -> Bool -> Maybe FieldName -> PgVersion ->
+            H.Statement ByteString (Maybe ProcResults)
+callProc qi pgArgs returnsScalar selectQuery countQuery countTotal isSingle paramsAsSingleObject asCsv asBinary binaryField pgVer =
+  unicodeStatement sql (param HE.unknown) decodeProc True
+  where
+    sql =[qc|
+      WITH
+      {argsRecord},
+      {sourceCTEName} AS (
+        {sourceBody}
+      )
+      SELECT
+        {countResultF} AS total_result_set,
+        pg_catalog.count(_postgrest_t) AS page_total,
+        {bodyF} AS body,
+        {responseHeaders} AS response_headers
+      FROM ({selectQuery}) _postgrest_t;|]
+
+    (argsRecord, args)
+      | paramsAsSingleObject = ("_args_record AS (SELECT NULL)", "$1::json")
+      | null pgArgs = (ignoredBody, "")
+      | otherwise = (
+          unwords [
+            normalizedBody <> ",",
+            "_args_record AS (",
+              "SELECT * FROM json_to_recordset(" <> selectBody <> ") AS _(" <>
+                intercalate ", " ((\a -> pgFmtIdent (pgaName a) <> " " <> pgaType a) <$> pgArgs) <> ")",
+            ")"]
+         , intercalate ", " ((\a -> pgFmtIdent (pgaName a) <> " := _args_record." <> pgFmtIdent (pgaName a)) <$> pgArgs))
+
+    sourceBody :: SqlFragment
+    sourceBody
+      | paramsAsSingleObject || null pgArgs =
+          if returnsScalar
+            then [qc| SELECT {fromQi qi}({args}) |]
+            else [qc| SELECT * FROM {fromQi qi}({args}) |]
+      | otherwise =
+          if returnsScalar
+            then [qc| SELECT {fromQi qi}({args}) FROM _args_record |]
+            else [qc| SELECT _.*
+                      FROM _args_record,
+                      LATERAL ( SELECT * FROM {fromQi qi}({args}) ) _ |]
+
+    bodyF
+     | returnsScalar = scalarBodyF
+     | isSingle = asJsonSingleF
+     | asCsv = asCsvF
+     | isJust binaryField = asBinaryF $ fromJust binaryField
+     | otherwise = asJsonF
+
+    scalarBodyF
+     | asBinary = asBinaryF _procName
+     | otherwise = unwords [
+        "CASE",
+          "WHEN pg_catalog.count(_postgrest_t) = 1",
+            "THEN (json_agg(_postgrest_t." <> pgFmtIdent _procName <> ")->0)::character varying",
+            "ELSE (json_agg(_postgrest_t." <> pgFmtIdent _procName <> "))::character varying",
+        "END"]
+
+    countResultF = if countTotal then "( "<> countQuery <> ")" else "null::bigint" :: Text
+    _procName = qiName qi
+    responseHeaders =
+      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
+
+    decodeProc = HD.rowMaybe procRow
+    procRow = (,,,) <$> nullableColumn HD.int8 <*> column HD.int8
+                    <*> column HD.bytea <*> column HD.bytea
+

src/PostgREST/QueryBuilder/ReadStatement.hs

@@ -0,0 +1,32 @@
+module PostgREST.QueryBuilder.ReadStatement where
+
+import           Data.Maybe
+import           Data.Text                      (intercalate)
+import qualified Hasql.Encoders                 as HE
+import qualified Hasql.Statement                as H
+import           PostgREST.QueryBuilder.Private
+import           PostgREST.Types
+import           Protolude                      hiding (cast,
+                                                 intercalate, replace)
+import           Text.InterpolatedString.Perl6  (qc)
+
+createReadStatement :: SqlQuery -> SqlQuery -> Bool -> Bool -> Bool -> Maybe FieldName ->
+                       H.Statement () ResultsWithCount
+createReadStatement selectQuery countQuery isSingle countTotal asCsv binaryField =
+  unicodeStatement sql HE.noParams 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
+    | asCsv = asCsvF
+    | isSingle = asJsonSingleF
+    | isJust binaryField = asBinaryF $ fromJust binaryField
+    | otherwise = asJsonF

src/PostgREST/QueryBuilder/WriteStatement.hs

@@ -0,0 +1,53 @@
+module PostgREST.QueryBuilder.WriteStatement where
+
+import           Data.Maybe
+import           Data.Text                      (intercalate, unwords)
+import qualified Hasql.Encoders                 as HE
+import qualified Hasql.Statement                as H
+import           PostgREST.ApiRequest           (PreferRepresentation (..))
+import           PostgREST.QueryBuilder.Private
+import           PostgREST.Types
+import           Protolude                      hiding (cast,
+                                                 intercalate, replace)
+import           Text.InterpolatedString.Perl6  (qc)
+
+createWriteStatement :: SqlQuery -> SqlQuery -> Bool -> Bool -> Bool ->
+                        PreferRepresentation -> [Text] ->
+                        H.Statement ByteString (Maybe ResultsWithCount)
+createWriteStatement selectQuery mutateQuery wantSingle isInsert asCsv rep pKeys =
+  unicodeStatement sql (param HE.unknown) decodeStandardMay True
+
+ where
+  sql = case rep of
+    None -> [qc|
+      WITH {sourceCTEName} AS ({mutateQuery})
+      SELECT '', 0, {noLocationF}, '' |]
+    HeadersOnly -> [qc|
+      WITH {sourceCTEName} AS ({mutateQuery})
+      SELECT {cols}
+      FROM (SELECT 1 FROM {sourceCTEName}) _postgrest_t |]
+    Full -> [qc|
+      WITH {sourceCTEName} AS ({mutateQuery})
+      SELECT {cols}
+      FROM ({selectQuery}) _postgrest_t |]
+
+  cols = intercalate ", " [
+      "'' AS total_result_set", -- when updateing it does not make sense
+      "pg_catalog.count(_postgrest_t) AS page_total",
+      if isInsert
+        then unwords [
+          "CASE",
+            "WHEN pg_catalog.count(_postgrest_t) = 1 THEN",
+              "coalesce(" <> locationF pKeys <> ", " <> noLocationF <> ")",
+            "ELSE " <> noLocationF,
+          "END AS header"]
+        else noLocationF <> "AS header",
+      if rep == Full
+         then bodyF <> " AS body"
+         else "''"
+    ]
+
+  bodyF
+    | asCsv = asCsvF
+    | wantSingle = asJsonSingleF
+    | otherwise = asJsonF

src/PostgREST/RangeQuery.hs

@@ -1,3 +1,7 @@
+{-|
+Module      : PostgREST.RangeQuery
+Description : Logic regarding the `Range` header and `limit`, `offset` querystring arguments.
+-}
 module PostgREST.RangeQuery (
   rangeParse
 , rangeRequested
@@ -9,19 +13,17 @@ module PostgREST.RangeQuery (
 , NonnegRange
 ) where
 
+import qualified Data.ByteString.Char8 as BS
 
-import           Control.Applicative
-import           Network.HTTP.Types.Header
+import Data.List       (lookup)
+import Text.Regex.TDFA ((=~))
 
-import qualified Data.ByteString.Char8     as BS
-import           Data.Ranged.Boundaries
-import           Data.Ranged.Ranges
+import Control.Applicative
+import Data.Ranged.Boundaries
+import Data.Ranged.Ranges
+import Network.HTTP.Types.Header
 
-import           Text.Regex.TDFA           ((=~))
-
-import Data.List (lookup)
-
-import           Protolude
+import Protolude
 
 type NonnegRange = Range Integer
 
@@ -32,14 +34,13 @@ rangeParse range = do
   case listToMaybe (range =~ rangeRegex :: [[BS.ByteString]]) of
     Just parsedRange ->
       let [_, mLower, mUpper] = readMaybe . toS <$> parsedRange
-          lower         = fromMaybe emptyRange   (rangeGeq <$> mLower)
-          upper         = fromMaybe allRange (rangeLeq <$> mUpper) in
+          lower         = maybe emptyRange rangeGeq mLower
+          upper         = maybe allRange rangeLeq mUpper in
       rangeIntersection lower upper
     Nothing -> allRange
 
 rangeRequested :: RequestHeaders -> NonnegRange
-rangeRequested headers = fromMaybe allRange $
-  rangeParse <$> lookup hRange headers
+rangeRequested headers = maybe allRange rangeParse $ lookup hRange headers
 
 restrictRange :: Maybe Integer -> NonnegRange -> NonnegRange
 restrictRange Nothing r = r
@@ -57,7 +58,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 =

src/PostgREST/Types.hs

@@ -1,30 +1,60 @@
-{-# LANGUAGE DuplicateRecordFields    #-}
+{-|
+Module      : PostgREST.Types
+Description : PostgREST common types and functions used by the rest of the modules
+-}
+{-# LANGUAGE DuplicateRecordFields #-}
+
 module PostgREST.Types where
-import           Protolude
+
+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 qualified Data.Aeson           as JSON
-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           Data.Tree
-import           PostgREST.RangeQuery (NonnegRange)
-import           Network.HTTP.Types.Header (hContentType, Header)
+
+import Network.HTTP.Types.Header (Header, hContentType)
+
+import Data.Tree
+
+import PostgREST.RangeQuery (NonnegRange)
+import Protolude
 
 -- | Enumeration of currently supported response content types
-data ContentType = CTApplicationJSON | CTTextCSV | CTOpenAPI
-                 | CTSingularJSON | CTOctetStream
-                 | CTAny | CTOther ByteString deriving Eq
+data ContentType = CTApplicationJSON | CTSingularJSON
+                 | CTTextCSV | CTTextPlain
+                 | CTOpenAPI | CTOctetStream
+                 | CTAny | CTOther ByteString deriving (Show, Eq)
 
-data ApiRequestError = ActionInappropriate
-                     | InvalidBody ByteString
-                     | InvalidRange
-                     | ParseRequestError Text Text
-                     | UnknownRelation
-                     | NoRelationBetween Text Text
-                     | UnsupportedVerb
-                     | InvalidFilters
-                     deriving (Show, Eq)
+-- | Convert from ContentType to a full HTTP Header
+toHeader :: ContentType -> Header
+toHeader ct = (hContentType, toMime ct <> "; charset=utf-8")
+
+-- | Convert from ContentType to a ByteString representing the mime type
+toMime :: ContentType -> ByteString
+toMime CTApplicationJSON = "application/json"
+toMime CTTextCSV         = "text/csv"
+toMime CTTextPlain       = "text/plain"
+toMime CTOpenAPI         = "application/openapi+json"
+toMime CTSingularJSON    = "application/vnd.pgrst.object+json"
+toMime 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'
 
 data PreferResolution = MergeDuplicates | IgnoreDuplicates deriving Eq
 instance Show PreferResolution where
@@ -77,6 +107,34 @@ instance Ord ProcDescription where
     | name1 == name2 && length args1 > length args2  = GT
     | otherwise = (name1, des1, args1, rt1, vol1) `compare` (name2, des2, args2, rt2, vol2)
 
+{-|
+  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.
+-}
+findProc :: QualifiedIdentifier -> S.Set Text -> Bool -> M.HashMap Text [ProcDescription] -> Maybe ProcDescription
+findProc qi payloadKeys paramsAsSingleObject allProcs =
+  case M.lookup (qiName 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
+
 type Schema = Text
 type TableName = Text
 type SqlQuery = Text
@@ -89,12 +147,15 @@ 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
+
 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
@@ -107,6 +168,9 @@ data Column =
     , colFK          :: Maybe ForeignKey
     } deriving (Show, Ord)
 
+instance Eq Column where
+  Column{colTable=t1,colName=n1} == Column{colTable=t2,colName=n2} = t1 == t2 && n1 == n2
+
 -- | A view column that refers to a table column
 type Synonym = (Column, ViewColumn)
 type ViewColumn = Column
@@ -132,6 +196,10 @@ 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
@@ -144,42 +212,47 @@ data RelationType = Child | Parent | Many | Root deriving (Show, Eq)
   The name 'Relation' here is used with the meaning
   "What is the relation between the current node and the parent node".
   It has nothing to do with PostgreSQL referring to tables/views as relations.
+  The order of the relColumns and relFColumns should be maintained to get
+  the join conditions right.
+  TODO merge relColumns and relFColumns to a tuple or Data.Bimap
 -}
 data Relation = Relation {
-  relTable    :: Table
-, relColumns  :: [Column]
-, relFTable   :: Table
-, relFColumns :: [Column]
-, relType     :: RelationType
+  relTable     :: Table
+, relColumns   :: [Column]
+, relFTable    :: Table
+, relFColumns  :: [Column]
+, relType      :: RelationType
 -- The Link attrs are used when RelationType == Many
-, relLinkTable   :: Maybe Table
-, relLinkCols1   :: Maybe [Column]
-, relLinkCols2   :: Maybe [Column]
+, relLinkTable :: Maybe Table
+, relLinkCols1 :: Maybe [Column]
+, relLinkCols2 :: Maybe [Column]
 } deriving (Show, Eq)
 
--- | Cached attributes of a JSON payload
-data PayloadJSON = PayloadJSON {
--- | 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
-} deriving (Show, Eq)
+isSelfJoin :: Relation -> Bool
+isSelfJoin r = relType r /= Root && 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)
 
--- | e.g. whether it is []/{} or not
-pjIsEmpty :: PayloadJSON -> Bool
-pjIsEmpty (PayloadJSON _ PJObject keys) = S.size keys == 0
-pjIsEmpty (PayloadJSON _ (PJArray l) _) = l == 0
-
 data Proxy = Proxy {
-  proxyScheme     :: Text
-, proxyHost       :: Text
-, proxyPort       :: Integer
-, proxyPath       :: Text
+  proxyScheme :: Text
+, proxyHost   :: Text
+, proxyPort   :: Integer
+, proxyPath   :: Text
 } deriving (Show, Eq)
 
 type Operator = Text
@@ -208,7 +281,8 @@ ftsOperators :: M.HashMap Operator SqlFragment
 ftsOperators = M.fromList [
   ("fts", "@@ to_tsquery"),
   ("plfts", "@@ plainto_tsquery"),
-  ("phfts", "@@ phraseto_tsquery")
+  ("phfts", "@@ phraseto_tsquery"),
+  ("wfts", "@@ websearch_to_tsquery")
   ]
 
 data OpExpr = OpExpr Bool Operation deriving (Eq, Show)
@@ -224,8 +298,8 @@ type ListVal = [Text]
 
 data LogicOperator = And | Or deriving Eq
 instance Show LogicOperator where
-  show And  = "AND"
-  show Or = "OR"
+  show And = "AND"
+  show Or  = "OR"
 {-|
   Boolean logic expression tree e.g. "and(name.eq.N,or(id.eq.1,id.eq.2))" is:
 
@@ -238,8 +312,16 @@ 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
@@ -272,44 +354,84 @@ type SelectItem = (Field, Maybe Cast, Maybe Alias, Maybe RelationDetail)
 -- | Path of the embedded levels, e.g "clients.projects.name=eq.." gives Path ["clients", "projects"]
 type EmbedPath = [Text]
 data Filter = Filter { field::Field, opExpr::OpExpr } deriving (Show, Eq)
-data JoinCondition = JoinCondition (QualifiedIdentifier, Maybe Alias, FieldName)
-                                   (QualifiedIdentifier, Maybe Alias, FieldName) deriving (Show, Eq)
+data JoinCondition = JoinCondition (QualifiedIdentifier, FieldName)
+                                   (QualifiedIdentifier, FieldName) deriving (Show, Eq)
 
-data ReadQuery = Select { select::[SelectItem], from::[TableName], where_::[LogicTree], joinConditions::[JoinCondition], order::[OrderTerm], range_::NonnegRange } deriving (Show, Eq)
-data MutateQuery = Insert { in_::TableName, insPkCols::[Text], qPayload::PayloadJSON, onConflict:: Maybe PreferResolution, where_::[LogicTree], 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, Depth))
+data ReadQuery = Select {
+    select         :: [SelectItem]
+  , from           :: TableName
+-- | 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  :: [TableName]
+  , where_         :: [LogicTree]
+  , joinConditions :: [JoinCondition]
+  , order          :: [OrderTerm]
+  , range_         :: NonnegRange
+} deriving (Show, Eq)
+
+data MutateQuery =
+  Insert {
+    in_        :: TableName
+  , insCols    :: S.Set FieldName
+  , onConflict :: Maybe (PreferResolution, [FieldName])
+  , where_     :: [LogicTree]
+  , returning  :: [FieldName]
+  }|
+  Update {
+    in_       :: TableName
+  , updCols   :: S.Set FieldName
+  , where_    :: [LogicTree]
+  , returning :: [FieldName]
+  }|
+  Delete {
+    in_       :: TableName
+  , where_    :: [LogicTree]
+  , returning :: [FieldName]
+  } deriving (Show, Eq)
+
+data DbRequest = DbRead ReadRequest | DbMutate MutateRequest
 type ReadRequest = Tree ReadNode
+type ReadNode = (ReadQuery, (NodeName, Maybe Relation, Maybe Alias, Maybe RelationDetail, Depth))
 -- Depth of the ReadRequest tree
 type Depth = Integer
 type MutateRequest = MutateQuery
-data DbRequest = DbRead ReadRequest | DbMutate MutateRequest
-
-instance Eq Table where
-  Table{tableSchema=s1,tableName=n1} == Table{tableSchema=s2,tableName=n2} = s1 == s2 && n1 == n2
-
-instance Eq Column where
-  Column{colTable=t1,colName=n1} == Column{colTable=t2,colName=n2} = t1 == t2 && n1 == n2
-
--- | Convert from ContentType to a full HTTP Header
-toHeader :: ContentType -> Header
-toHeader ct = (hContentType, toMime ct <> "; charset=utf-8")
-
--- | Convert from ContentType to a ByteString representing the mime type
-toMime :: ContentType -> ByteString
-toMime CTApplicationJSON = "application/json"
-toMime CTTextCSV         = "text/csv"
-toMime CTOpenAPI         = "application/openapi+json"
-toMime CTSingularJSON    = "application/vnd.pgrst.object+json"
-toMime CTOctetStream     = "application/octet-stream"
-toMime CTAny             = "*/*"
-toMime (CTOther ct)      = ct
 
 data PgVersion = PgVersion {
   pgvNum  :: Int32
 , pgvName :: Text
-} deriving (Eq, Ord, Show)
+} deriving (Eq, Show)
+
+instance Ord PgVersion where
+  (PgVersion v1 _) `compare` (PgVersion v2 _) = v1 `compare` v2
+
+-- | Tells the minimum PostgreSQL version required by this version of PostgREST
+minimumPgVersion :: PgVersion
+minimumPgVersion = pgVersion94
+
+pgVersion94 :: PgVersion
+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"
 
 sourceCTEName :: SqlFragment
 sourceCTEName = "pg_source"
@@ -318,3 +440,12 @@ sourceCTEName = "pg_source"
 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,16 +1,21 @@
-resolver: lts-9.6
+# stack.yaml is used for circle-ci tests. Profiling build fails on circleci
+# with GHC 8.6, so we build with 8.4 for now.
+
+resolver: lts-13.29
 extra-deps:
-  - configurator-ng-0.0.0.1
-  - critbit-0.2.0.0
-  - hjsonpointer-1.1.1
-  - hjsonschema-1.5.0.1
-  - Ranged-sets-0.3.0
-  - protolude-0.2
-  - hasql-1.1
-  - hasql-pool-0.4.3
-  - hasql-transaction-0.5.2
-  - jose-0.7.0.0
+- Ranged-sets-0.4.0
+- configurator-pg-0.1.0.3
+- http-types-0.12.3
+- hasql-1.4
+- hasql-pool-0.5.1
+- hasql-transaction-0.7.2
+- text-builder-0.6.5.1
+- deferred-folds-0.9.10.1
+- primitive-0.6.4.0
+- jose-0.8.1.0
+- text-printer-0.5.0.1
+- network-2.7.0.1
 ghc-options:
-  postgrest: -O2 -Werror -Wall -fwarn-identities -fno-warn-redundant-constraints
+  postgrest: -O2 -Werror -Wall -fwarn-identities -fno-warn-redundant-constraints -optP-Wno-nonportable-include-path
 nix:
-  packages: [postgresql, zlib]
+  packages: [pcre, pkgconfig, postgresql, zlib]

stack.yaml.lock

@@ -0,0 +1,96 @@
+# 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: Ranged-sets-0.4.0@sha256:04bb4ce482fbdc052c9ee3346ba210986b33002b8c3440b714d62750144f86b6,1373
+    pantry-tree:
+      size: 566
+      sha256: ae6809a20be4da39729ac3c6e10b5c311b80628c767184da95903ecff6efc095
+  original:
+    hackage: Ranged-sets-0.4.0
+- completed:
+    hackage: configurator-pg-0.1.0.3@sha256:ddccf34fef0a5c4f1364ec4c6fda459f089a592e18662b0263ed85ea943c9c70,2885
+    pantry-tree:
+      size: 1008
+      sha256: 5eb16e5536e8bfd921286fb4c97eaaf0c1cb9bdbdf9630a7ffdf1cc64942b79b
+  original:
+    hackage: configurator-pg-0.1.0.3
+- completed:
+    hackage: http-types-0.12.3@sha256:f35229edb1bc7b3ae27f961b2407dadb5bfa69d43a8f5337ab46cdc79ca4afe9,2035
+    pantry-tree:
+      size: 833
+      sha256: c9b77e1ba204fffbe4e1be80412bc48e47440a07e4b7db4cdc77d573a3e21b9a
+  original:
+    hackage: http-types-0.12.3
+- completed:
+    hackage: hasql-1.4@sha256:fcb1b0046c1e888b6c4cad53c972d23318dbc6ababa9ceb7d9cfd3b546732bcd,6515
+    pantry-tree:
+      size: 2567
+      sha256: 2e253e7f3052ae4f838d26191355eb0c0b9f344e265b7dec50e13b799ef32450
+  original:
+    hackage: hasql-1.4
+- completed:
+    hackage: hasql-pool-0.5.1@sha256:a98f2fc38f60eb037a8ac6c5e17591b090089e305f367219c4879812592aaafe,2436
+    pantry-tree:
+      size: 412
+      sha256: 22e4cea8c23ea0eaa871388236c1d3e10349d993fd1bbc602f40aeb4909d6100
+  original:
+    hackage: hasql-pool-0.5.1
+- completed:
+    hackage: hasql-transaction-0.7.2@sha256:d6d8ceb0b32be75686fe31c4b5bc15c569a71023fc60394893508ea733e8714b,2835
+    pantry-tree:
+      size: 1028
+      sha256: 9bd8c7bf3e30d033192ff53c97e5f1f5e9c08ebfe9a1b3364ab0f9e8f2c2872e
+  original:
+    hackage: hasql-transaction-0.7.2
+- completed:
+    hackage: text-builder-0.6.5.1@sha256:547f292707c7488c0fbee415adb5fa107d725b720f8697e966a3e3e00cac02cd,4210
+    pantry-tree:
+      size: 542
+      sha256: 5b2be8c9530d3460cadfe142429e0f82bb4b5c238737de473b6f9a25a33e232f
+  original:
+    hackage: text-builder-0.6.5.1
+- completed:
+    hackage: deferred-folds-0.9.10.1@sha256:eb2634488e2a836da7d5aed9afd15ad2bead38817249f60bb68e459cc32fb0b0,2928
+    pantry-tree:
+      size: 958
+      sha256: b9132db4ffe78f11254871ed88071c5abe1ff41eeffcbec30ce484f24db81c19
+  original:
+    hackage: deferred-folds-0.9.10.1
+- completed:
+    hackage: primitive-0.6.4.0@sha256:5b6a2c3cc70a35aabd4565fcb9bb1dd78fe2814a36e62428a9a1aae8c32441a1,2079
+    pantry-tree:
+      size: 1517
+      sha256: 5d5e591311664886e88ade3da6880c32adf0d1fe80c55f40a3c93bb91df8fdeb
+  original:
+    hackage: primitive-0.6.4.0
+- completed:
+    hackage: jose-0.8.1.0@sha256:904e64203f0e074c4601529be2b57c94eec9fd588b19e16165391f8f9e84a6a0,3353
+    pantry-tree:
+      size: 1935
+      sha256: 8d5f80f184b61e89fedbf61d4d7b54ce85326fe67d8ec888117387522c06504d
+  original:
+    hackage: jose-0.8.1.0
+- completed:
+    hackage: text-printer-0.5.0.1@sha256:9171204826a67c97bc3578968d8b3dcfbd81be08dfd18fef2af71eaf7b2737b1,1502
+    pantry-tree:
+      size: 461
+      sha256: 656053744f42551bc9cffd76746bfae77a249f54ca69497f6835e35312c7b5bb
+  original:
+    hackage: text-printer-0.5.0.1
+- completed:
+    hackage: network-2.7.0.1@sha256:e8ab30822597c44f0520875699e005c8b284d19000bdacfddbc980c7dfa00bec,2823
+    pantry-tree:
+      size: 2313
+      sha256: 5729e7f6993505243e13fde01833e768024303052becb72f915d8cff1c20e177
+  original:
+    hackage: network-2.7.0.1
+snapshots:
+- completed:
+    size: 500539
+    url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/13/29.yaml
+    sha256: 006398c5e92d1d64737b7e98ae4d63987c36808814504d1451f56ebd98093f75
+  original: lts-13.29

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 :: SpecWith Application
-spec =
+spec :: PgVersion -> SpecWith Application
+spec actualPgVersion =
   describe "and/or params used for complex boolean logic" $ do
     context "used with GET" $ do
       context "or param" $ do
@@ -79,6 +80,19 @@ spec =
               {"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] }
@@ -113,6 +127,34 @@ 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" $
             get "/entities?and=(arr.not.cs.{1,2,3},and(id.not.eq.2,name.not.like.*3))&select=id" `shouldRespondWith`
@@ -167,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},
@@ -193,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,14 +1,14 @@
 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

test/Feature/AudienceJwtSecretSpec.hs

@@ -1,14 +1,14 @@
 module Feature.AudienceJwtSecretSpec 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  hiding (get)
+import SpecHelper
 -- }}}
 
 spec :: SpecWith Application
@@ -44,4 +44,4 @@ spec = describe "test handling of aud claims in JWT" $ do
       `shouldRespondWith` 200
 
   it "requests without JWT token should work" $
-    get "/has_count_column" `shouldRespondWith` 200 
+    get "/has_count_column" `shouldRespondWith` 200

test/Feature/AuthSpec.hs

@@ -1,26 +1,36 @@
 module Feature.AuthSpec where
 
-import Text.Heredoc
+import Network.Wai (Application)
+
+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 :: SpecWith Application
-spec = describe "authorization" $ do
+spec :: PgVersion -> SpecWith Application
+spec actualPgVersion = 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"]
       }
@@ -28,11 +38,20 @@ 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 = []
       }
@@ -98,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,14 +1,14 @@
 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

test/Feature/ConcurrentSpec.hs

@@ -1,20 +1,21 @@
-{-# 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 Test.Hspec.Wai.Internal
+import Control.Monad.Base
+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)
 

test/Feature/CorsSpec.hs

@@ -1,17 +1,17 @@
 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
@@ -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,12 +1,12 @@
 module Feature.DeleteSpec where
 
+import Network.Wai (Application)
+
+import Network.HTTP.Types
 import Test.Hspec
 import Test.Hspec.Wai
 import Text.Heredoc
 
-import Network.HTTP.Types
-import Network.Wai (Application)
-
 import Protolude hiding (get)
 
 spec :: SpecWith Application

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 Network.Wai.Test (SResponse(simpleBody,simpleHeaders,simpleStatus))
+import Text.Heredoc
 
+import PostgREST.Types (PgVersion, pgVersion112)
+import Protolude       hiding (get)
 import SpecHelper
 
-import qualified Data.Aeson as JSON
-import Data.List (lookup)
-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
+spec :: PgVersion -> SpecWith Application
+spec actualPgVersion = do
   describe "Posting new record" $ do
     context "disparate json types" $ do
       it "accepts disparate json types" $ do
@@ -51,9 +50,22 @@ spec = do
 
     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` 400
+        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` 400
+        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" $
@@ -103,11 +115,13 @@ spec = do
             incNullableStr record `shouldBe` Nothing
 
       context "into a table with simple pk" $
-        it "fails with 400 and error" $ do
-          p <- post "/simple_pk" [json| { "extra":"foo"} |]
-          liftIO $ do
-            simpleStatus p `shouldBe` badRequest400
-            isErrorFormat (simpleBody p) `shouldBe` True
+        it "fails with 400 and error" $
+          post "/simple_pk" [json| { "extra":"foo"} |]
+          `shouldRespondWith`
+          [json|{"hint":null,"details":"Failing row contains (null, foo).","code":"23502","message":"null value in column \"k\" violates not-null constraint"}|]
+          { matchStatus  = 400
+          , matchHeaders = [matchContentTypeJson]
+          }
 
       context "into a table with no pk" $ do
         it "succeeds with 201 and a link including all fields" $ do
@@ -181,11 +195,13 @@ spec = do
           lookup hLocation (simpleHeaders p) `shouldBe` Nothing
 
     context "with invalid json payload" $
-      it "fails with 400 and error" $ do
-        p <- post "/simple_pk" "}{ x = 2"
-        liftIO $ do
-          simpleStatus p `shouldBe` badRequest400
-          isErrorFormat (simpleBody p) `shouldBe` True
+      it "fails with 400 and error" $
+        post "/simple_pk" "}{ x = 2"
+        `shouldRespondWith`
+        [json|{"message":"Error in $: Failed reading: not a valid json value"}|]
+        { matchStatus  = 400
+        , matchHeaders = [matchContentTypeJson]
+        }
 
     context "with valid json payload" $
       it "succeeds and returns 201 created" $
@@ -193,7 +209,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" $
@@ -222,12 +243,23 @@ spec = do
           , matchHeaders = ["Location" <:> location]
           }
 
-    context "empty object" $
-      it "successfully populates table with all-default columns" $
+    context "empty objects" $ do
+      it "successfully inserts a row with all-default columns" $ do
         post "/items" "{}" `shouldRespondWith` ""
           { matchStatus  = 201
           , matchHeaders = []
           }
+        post "/items" "[{}]" `shouldRespondWith` ""
+          { matchStatus  = 201
+          , matchHeaders = []
+          }
+
+      it "successfully inserts two rows with all-default columns" $
+        post "/items" "[{}, {}]" `shouldRespondWith` ""
+          { matchStatus  = 201
+          , matchHeaders = []
+          }
+
     context "table with limited privileges" $ do
       it "succeeds if correct select is applied" $
         request methodPost "/limited_article_stars?select=article_id,user_id" [("Prefer", "return=representation")]
@@ -237,20 +269,75 @@ spec = do
           }
       it "fails 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`
-          [str|{"hint":null,"details":null,"code":"42501","message":"permission denied for relation limited_article_stars"}|]
+          [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 if select is not specified" $
         request methodPost "/limited_article_stars" [("Prefer", "return=representation")]
-          [json| {"article_id": 3, "user_id": 1} |] `shouldRespondWith` [str|{"hint":null,"details":null,"code":"42501","message":"permission denied for relation limited_article_stars"}|]
+          [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 = []
           }
 
-  describe "CSV insert" $ do
+    context "POST with ?columns parameter" $ do
+      it "ignores json keys not included in ?columns" $ do
+        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"
@@ -297,11 +384,13 @@ spec = do
           }
 
     context "with wrong number of columns" $
-      it "fails for too few" $ do
-        p <- request methodPost "/no_pk" [("Content-Type", "text/csv")] "a,b\nfoo,bar\nbaz"
-        liftIO $ do
-          simpleStatus p `shouldBe` badRequest400
-          isErrorFormat (simpleBody p) `shouldBe` True
+      it "fails for too few" $
+        request methodPost "/no_pk" [("Content-Type", "text/csv")] "a,b\nfoo,bar\nbaz"
+        `shouldRespondWith`
+        [json|{"message":"All lines must have same number of fields"}|]
+        { matchStatus  = 400
+        , matchHeaders = [matchContentTypeJson]
+        }
 
     context "with unicode values" $
       it "succeeds and returns usable location header" $ do
@@ -317,22 +406,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,
-            matchHeaders = ["Content-Range" <:> "*/*"]
+          { matchStatus  = 404,
+            matchHeaders = []
           }
 
     context "in a nonempty table" $ do
@@ -359,10 +446,15 @@ spec = do
           [("Prefer", "return=representation")] [json| { "id":999999 } |]
           `shouldRespondWith` "[]"
           {
-            matchStatus  = 200,
-            matchHeaders = ["Content-Range" <:> "*/*"]
+            matchStatus  = 404,
+            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 } |]
@@ -390,25 +482,26 @@ spec = do
           [json| [{ a: "keepme", b: null }] |]
           { matchHeaders = [matchContentTypeJson] }
 
-      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 = []
-          }
+      context "filtering by a computed column" $ do
+        it "is successful" $
+          request methodPatch
+            "/items?is_first=eq.true"
+            [("Prefer", "return=representation")]
+            [json| { id: 100 } |]
+            `shouldRespondWith` [json| [{ id: 100 }] |]
+            { matchStatus  = 200,
+              matchHeaders = [matchContentTypeJson, "Content-Range" <:> "0-0/*"]
+            }
 
-      it "can update based on a computed column" $
-        request methodPatch
-          "/items?always_true=eq.false"
-          [("Prefer", "return=representation")]
-          [json| { id: 100 } |]
-          `shouldRespondWith` "[]"
-          { matchStatus  = 200,
-            matchHeaders = ["Content-Range" <:> "*/*"]
-          }
+        it "indicates no records updated by returning 404" $
+          request methodPatch
+            "/items?always_true=eq.false"
+            [("Prefer", "return=representation")]
+            [json| { id: 100 } |]
+            `shouldRespondWith` "[]"
+            { matchStatus  = 404,
+              matchHeaders = []
+            }
 
       it "can provide a representation" $ do
         _ <- post "/items"
@@ -437,21 +530,21 @@ spec = do
             matchHeaders = ["Content-Range" <:> "*/*"]
           }
 
-        get "/items" `shouldRespondWith`
-          [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}]|]
-          { matchHeaders = [matchContentTypeJson] }
+        request methodPatch "/items" [] [json| [{}] |]
+          `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
+      it "makes no updates and and returns 200, when patching with an empty json object and return=rep" $
         request methodPatch "/items" [("Prefer", "return=representation")] [json| {} |]
           `shouldRespondWith` "[]"
           {
             matchStatus  = 200,
             matchHeaders = ["Content-Range" <:> "*/*"]
           }
-        get "/items" `shouldRespondWith`
-          [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}] |]
-          { matchHeaders = [matchContentTypeJson] }
-  
+
     context "with unicode values" $
       it "succeeds and returns values intact" $ do
         void $ request methodPost "/no_pk" []
@@ -463,6 +556,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"

test/Feature/JsonOperatorSpec.hs

@@ -0,0 +1,204 @@
+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)
+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` [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/NoJwtSpec.hs

@@ -1,14 +1,16 @@
 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
@@ -18,7 +20,11 @@ spec = describe "server started without JWT secret" $ do
   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

@@ -1,10 +1,12 @@
 module Feature.NonexistentSchemaSpec where
 
 import Network.Wai (Application)
-import Protolude hiding (get)
+
 import Test.Hspec
 import Test.Hspec.Wai
 
+import Protolude hiding (get)
+
 spec :: SpecWith Application
 spec =
   describe "Non existent api schema" $ do

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

@@ -1,13 +1,13 @@
 module Feature.PgVersion96Spec where
 
-import Test.Hspec hiding (pendingWith)
+import Network.Wai (Application)
+
+import Test.Hspec
 import Test.Hspec.Wai
 import Test.Hspec.Wai.JSON
 
+import Protolude  hiding (get)
 import SpecHelper
-import Network.Wai (Application)
-
-import Protolude hiding (get)
 
 spec :: SpecWith Application
 spec =
@@ -34,10 +34,30 @@ spec =
               "X-Test-2" <:> "key1=val1"]}
 
       it "fails when setting headers with wrong json structure" $ do
-        get "/rpc/bad_guc_headers_1" `shouldRespondWith` 500
-        get "/rpc/bad_guc_headers_2" `shouldRespondWith` 500
-        get "/rpc/bad_guc_headers_3" `shouldRespondWith` 500
-        post "/rpc/bad_guc_headers_1" [json|{}|] `shouldRespondWith` 500
+        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"

test/Feature/ProxySpec.hs

@@ -1,12 +1,10 @@
 module Feature.ProxySpec where
 
-import Test.Hspec hiding (pendingWith)
-
-import SpecHelper
-
 import Network.Wai (Application)
+import Test.Hspec  hiding (pendingWith)
 
-import Protolude hiding (get)
+import Protolude
+import SpecHelper
 
 spec :: SpecWith Application
 spec =

test/Feature/QueryLimitedSpec.hs

@@ -1,14 +1,15 @@
 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 SpecHelper
-import Network.Wai (Application)
 
-import Protolude hiding (get)
+import Protolude  hiding (get)
+import SpecHelper
 
 spec :: SpecWith Application
 spec =

test/Feature/QuerySpec.hs

@@ -1,19 +1,21 @@
 module Feature.QuerySpec where
 
-import Test.Hspec hiding (pendingWith)
+import Network.Wai      (Application)
+import Network.Wai.Test (SResponse (simpleHeaders))
+
+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))
 
-import SpecHelper
 import Text.Heredoc
-import Network.Wai (Application)
 
-import Protolude hiding (get)
+import PostgREST.Types (PgVersion, pgVersion112)
+import Protolude       hiding (get)
+import SpecHelper
 
-spec :: SpecWith Application
-spec = do
+spec :: PgVersion -> SpecWith Application
+spec actualPgVersion = do
 
   describe "Querying a table with a column called count" $
     it "should not confuse count column with pg_catalog.count aggregate" $
@@ -118,6 +120,29 @@ spec = do
           [json| [ {"text_search_vector": "'ate':3 'cat':2 'fat':1 'rat':4" }] |]
           { matchHeaders = [matchContentTypeJson] }
 
+      when (actualPgVersion >= pgVersion112) $ do
+        it "finds matches with websearch_to_tsquery" $
+            get "/tsearch?text_search_vector=wfts.The%20Fat%20Rats" `shouldRespondWith`
+                [json| [ {"text_search_vector": "'ate':3 'cat':2 'fat':1 'rat':4" }] |]
+                { matchHeaders = [matchContentTypeJson] }
+
+        it "can use boolean operators(and, or, -) in websearch_to_tsquery" $ do
+          get "/tsearch?text_search_vector=wfts.fun%20and%20possible"
+            `shouldRespondWith`
+              [json| [ {"text_search_vector": "'also':2 'fun':3 'possibl':8"}] |]
+              { matchHeaders = [matchContentTypeJson] }
+          get "/tsearch?text_search_vector=wfts.impossible%20or%20possible"
+            `shouldRespondWith`
+              [json| [
+                {"text_search_vector": "'fun':5 'imposs':9 'kind':3"},
+                {"text_search_vector": "'also':2 'fun':3 'possibl':8"}]
+                  |]
+              { matchHeaders = [matchContentTypeJson] }
+          get "/tsearch?text_search_vector=wfts.fun%20and%20-possible"
+            `shouldRespondWith`
+              [json| [ {"text_search_vector": "'fun':5 'imposs':9 'kind':3"}] |]
+              { matchHeaders = [matchContentTypeJson] }
+
       it "finds matches with different dictionaries" $ do
         get "/tsearch?text_search_vector=fts(french).amusant" `shouldRespondWith`
           [json| [{"text_search_vector": "'amus':5 'fair':7 'impossibl':9 'peu':4" }] |]
@@ -126,6 +151,12 @@ spec = do
           [json| [{"text_search_vector": "'amus':5 'fair':7 'impossibl':9 'peu':4" }] |]
           { matchHeaders = [matchContentTypeJson] }
 
+        when (actualPgVersion >= pgVersion112) $
+            get "/tsearch?text_search_vector=wfts(french).amusant%20impossible"
+                `shouldRespondWith`
+                  [json| [{"text_search_vector": "'amus':5 'fair':7 'impossibl':9 'peu':4" }] |]
+                  { matchHeaders = [matchContentTypeJson] }
+
       it "can be negated with not operator" $ do
         get "/tsearch?text_search_vector=not.fts.impossible%7Cfat%7Cfun" `shouldRespondWith`
           [json| [
@@ -144,6 +175,13 @@ spec = 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) $
+            get "/tsearch?text_search_vector=not.wfts(english).impossible%20or%20fat%20or%20fun"
+                `shouldRespondWith`
+                  [json| [
+                    {"text_search_vector": "'amus':5 'fair':7 'impossibl':9 'peu':4"},
+                    {"text_search_vector": "'art':4 'spass':5 'unmog':7"}]|]
+                  { matchHeaders = [matchContentTypeJson] }
 
     it "matches with computed column" $
       get "/items?always_true=eq.true&order=id.asc" `shouldRespondWith`
@@ -181,7 +219,6 @@ spec = do
         { matchHeaders = [matchContentTypeJson] }
 
   describe "Shaping response with select parameter" $ do
-
     it "selectStar works in absense of parameter" $
       get "/complex_items?id=eq.3" `shouldRespondWith`
         [str|[{"id":3,"name":"Three","settings":{"foo":{"int":1,"bar":"baz"}},"arr_data":[1,2,3],"field-with_sep":1}]|]
@@ -216,23 +253,6 @@ spec = do
         [json| [{"settings":{"foo":{"int":1,"bar":"baz"}}}] |]
         { matchHeaders = [matchContentTypeJson] }
 
-    it "json subfield one level with casting (json)" $
-      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 "rename json subfield one level with casting (json)" $
-      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` [json| {"hint":null,"details":null,"code":"22P02","message":"invalid input syntax for integer: \"baz\""} |]
-        { matchStatus  = 400
-        , matchHeaders = []
-        }
-
     it "fails on bad casting (wrong cast type)" $
       get "/complex_items?select=id::fakecolumntype"
         `shouldRespondWith` [json| {"hint":null,"details":null,"code":"42704","message":"type \"fakecolumntype\" does not exist"} |]
@@ -240,34 +260,12 @@ spec = do
         , matchHeaders = []
         }
 
-
-    it "json subfield two levels (string)" $
-      get "/complex_items?id=eq.1&select=settings->foo->>bar" `shouldRespondWith`
-        [json| [{"bar":"baz"}] |]
-        { matchHeaders = [matchContentTypeJson] }
-
-    it "rename json subfield two levels (string)" $
-      get "/complex_items?id=eq.1&select=myBar:settings->foo->>bar" `shouldRespondWith`
-        [json| [{"myBar":"baz"}] |]
-        { matchHeaders = [matchContentTypeJson] }
-
-
-    it "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 "rename 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] }
-
     it "requesting parents and children" $
       get "/projects?id=eq.1&select=id, name, clients(*), tasks(id, name)" `shouldRespondWith`
         [json|[{"id":1,"name":"Windows 7","clients":{"id":1,"name":"Microsoft"},"tasks":[{"id":1,"name":"Design w7"},{"id":2,"name":"Code w7"}]}]|]
         { matchHeaders = [matchContentTypeJson] }
 
-    it "requesting parent without specifying primary key" $ do
+    it "requesting parent without specifying primary key" $
       get "/projects?select=name,client(name)" `shouldRespondWith`
         [json|[
           {"name":"Windows 7","client":{"name": "Microsoft"}},
@@ -277,9 +275,6 @@ spec = do
           {"name":"Orphan","client":null}
         ]|]
         { matchHeaders = [matchContentTypeJson] }
-      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 "requesting parent and renaming primary key" $
       get "/projects?select=name,client(clientId:id,name)" `shouldRespondWith`
@@ -351,40 +346,11 @@ spec = do
         [json|[{"id":1,"tasks":[{"id":1},{"id":2},{"id":3},{"id":4}]},{"id":2,"tasks":[{"id":5},{"id":6},{"id":7}]},{"id":3,"tasks":[{"id":1},{"id":5}]}]|]
         { matchHeaders = [matchContentTypeJson] }
 
-    it "requesting parents and children on views" $
-      get "/projects_view?id=eq.1&select=id, name, clients(*), tasks(id, name)" `shouldRespondWith`
-        [json|[{"id":1,"name":"Windows 7","clients":{"id":1,"name":"Microsoft"},"tasks":[{"id":1,"name":"Design w7"},{"id":2,"name":"Code w7"}]}]|]
-        { matchHeaders = [matchContentTypeJson] }
-
-    it "requesting parents and children on views with renamed keys" $
-      get "/projects_view_alt?t_id=eq.1&select=t_id, name, clients(*), tasks(id, name)" `shouldRespondWith`
-        [json|[{"t_id":1,"name":"Windows 7","clients":{"id":1,"name":"Microsoft"},"tasks":[{"id":1,"name":"Design w7"},{"id":2,"name":"Code w7"}]}]|]
-        { matchHeaders = [matchContentTypeJson] }
-
-    it "detects parent relations when having many views of a private table" $ do
-      get "/books?select=title,author(name)&id=eq.5" `shouldRespondWith`
-        [json|[ { "title": "Farenheit 451", "author": { "name": "Ray Bradbury" } } ]|]
-        { matchHeaders = [matchContentTypeJson] }
-      get "/forties_books?select=title,author(name)&limit=1" `shouldRespondWith`
-        [json|[ { "title": "1984", "author": { "name": "George Orwell" } } ]|]
-        { matchHeaders = [matchContentTypeJson] }
-      get "/fifties_books?select=title,author(name)&limit=1" `shouldRespondWith`
-        [json|[ { "title": "The Catcher in the Rye", "author": { "name": "J.D. Salinger" } } ]|]
-        { matchHeaders = [matchContentTypeJson] }
-      get "/sixties_books?select=title,author(name)&limit=1" `shouldRespondWith`
-        [json|[ { "title": "To Kill a Mockingbird", "author": { "name": "Harper Lee" } } ]|]
-        { matchHeaders = [matchContentTypeJson] }
-
     it "requesting children with composite key" $
       get "/users_tasks?user_id=eq.2&task_id=eq.6&select=*, comments(content)" `shouldRespondWith`
         [json|[{"user_id":2,"task_id":6,"comments":[{"content":"Needs to be delivered ASAP"}]}]|]
         { matchHeaders = [matchContentTypeJson] }
 
-    it "detect relations in views from exposed schema that are based on tables in private schema and have columns renames" $
-      get "/articles?id=eq.1&select=id,articleStars(users(*))" `shouldRespondWith`
-        [json|[{"id":1,"articleStars":[{"users":{"id":1,"name":"Angela Martin"}},{"users":{"id":2,"name":"Michael Scott"}},{"users":{"id":3,"name":"Dwight Schrute"}}]}]|]
-        { matchHeaders = [matchContentTypeJson] }
-
     it "can embed by FK column name" $
       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"}}]|]
@@ -400,34 +366,161 @@ spec = do
         [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 detect fk relations through views to tables in the public schema" $
-      get "/consumers_view?select=*,orders_view(*)" `shouldRespondWith` 200
+    describe "view embedding" $ do
+      it "can detect fk relations through views to tables in the public schema" $
+        get "/consumers_view?select=*,orders_view(*)" `shouldRespondWith` 200
+
+      it "can detect fk relations through materialized views to tables in the public schema" $
+        get "/materialized_projects?select=*,users(*)" `shouldRespondWith` 200
+
+      it "can request parent without specifying primary key" $
+        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 detect relations in views from exposed schema that are based on tables in private schema and have columns renames" $
+        get "/articles?id=eq.1&select=id,articleStars(users(*))" `shouldRespondWith`
+          [json|[{"id":1,"articleStars":[{"users":{"id":1,"name":"Angela Martin"}},{"users":{"id":2,"name":"Michael Scott"}},{"users":{"id":3,"name":"Dwight Schrute"}}]}]|]
+          { matchHeaders = [matchContentTypeJson] }
+
+      it "works when requesting parents and children on views" $
+        get "/projects_view?id=eq.1&select=id, name, clients(*), tasks(id, name)" `shouldRespondWith`
+          [json|[{"id":1,"name":"Windows 7","clients":{"id":1,"name":"Microsoft"},"tasks":[{"id":1,"name":"Design w7"},{"id":2,"name":"Code w7"}]}]|]
+          { matchHeaders = [matchContentTypeJson] }
+
+      it "works when requesting parents and children on views with renamed keys" $
+        get "/projects_view_alt?t_id=eq.1&select=t_id, name, clients(*), tasks(id, name)" `shouldRespondWith`
+          [json|[{"t_id":1,"name":"Windows 7","clients":{"id":1,"name":"Microsoft"},"tasks":[{"id":1,"name":"Design w7"},{"id":2,"name":"Code w7"}]}]|]
+          { matchHeaders = [matchContentTypeJson] }
+
+      it "detects parent relations when having many views of a private table" $ do
+        get "/books?select=title,author(name)&id=eq.5" `shouldRespondWith`
+          [json|[ { "title": "Farenheit 451", "author": { "name": "Ray Bradbury" } } ]|]
+          { matchHeaders = [matchContentTypeJson] }
+        get "/forties_books?select=title,author(name)&limit=1" `shouldRespondWith`
+          [json|[ { "title": "1984", "author": { "name": "George Orwell" } } ]|]
+          { matchHeaders = [matchContentTypeJson] }
+        get "/fifties_books?select=title,author(name)&limit=1" `shouldRespondWith`
+          [json|[ { "title": "The Catcher in the Rye", "author": { "name": "J.D. Salinger" } } ]|]
+          { matchHeaders = [matchContentTypeJson] }
+        get "/sixties_books?select=title,author(name)&limit=1" `shouldRespondWith`
+          [json|[ { "title": "To Kill a Mockingbird", "author": { "name": "Harper Lee" } } ]|]
+          { matchHeaders = [matchContentTypeJson] }
+
+      it "works with views that have subselects" $
+        get "/authors_books_number?select=*,books(title)&id=eq.1" `shouldRespondWith`
+          [json|[ {"id":1, "name":"George Orwell","num_in_forties":1,"num_in_fifties":0,"num_in_sixties":0,"num_in_all_decades":1,
+                   "books":[{"title":"1984"}]} ]|]
+          { matchHeaders = [matchContentTypeJson] }
+
+      it "works with views that have case subselects" $
+        get "/authors_have_book_in_decade?select=*,books(title)&id=eq.3" `shouldRespondWith`
+          [json|[ {"id":3,"name":"Antoine de Saint-Exupéry","has_book_in_forties":true,"has_book_in_fifties":false,"has_book_in_sixties":false,
+                   "books":[{"title":"The Little Prince"}]} ]|]
+          { matchHeaders = [matchContentTypeJson] }
+
+      it "works with views that have subselect in the FROM clause" $
+        get "/forties_and_fifties_books?select=title,first_publisher,author:authors(name)&id=eq.1" `shouldRespondWith`
+          [json|[{"title":"1984","first_publisher":"Secker & Warburg","author":{"name":"George Orwell"}}]|]
+          { matchHeaders = [matchContentTypeJson] }
+
+      it "works with views that have CTE" $
+        get "/odd_years_publications?select=title,publication_year,first_publisher,author:authors(name)&id=in.(1,2,3)" `shouldRespondWith`
+          [json|[
+            {"title":"1984","publication_year":1949,"first_publisher":"Secker & Warburg","author":{"name":"George Orwell"}},
+            {"title":"The Diary of a Young Girl","publication_year":1947,"first_publisher":"Contact Publishing","author":{"name":"Anne Frank"}},
+            {"title":"The Little Prince","publication_year":1947,"first_publisher":"Reynal & Hitchcock","author":{"name":"Antoine de Saint-Exupéry"}} ]|]
+          { matchHeaders = [matchContentTypeJson] }
+
+      it "works when having a capitalized table name and camelCase fk column" $
+        get "/foos?select=*,bars(*)" `shouldRespondWith` 200
+
+      it "works when embedding a view with a table that has a long compound pk" $ do
+        get "/player_view?select=id,contract(purchase_price)&id=in.(1,3,5,7)" `shouldRespondWith`
+          [json|
+            [{"id":1,"contract":[{"purchase_price":10}]},
+             {"id":3,"contract":[{"purchase_price":30}]},
+             {"id":5,"contract":[{"purchase_price":50}]},
+             {"id":7,"contract":[]}] |]
+          { matchHeaders = [matchContentTypeJson] }
+        get "/contract?select=tournament,player_view(first_name)&limit=3" `shouldRespondWith`
+          [json|
+            [{"tournament":"tournament_1","player_view":{"first_name":"first_name_1"}},
+             {"tournament":"tournament_2","player_view":{"first_name":"first_name_2"}},
+             {"tournament":"tournament_3","player_view":{"first_name":"first_name_3"}}] |]
+          { matchHeaders = [matchContentTypeJson] }
+
+      it "works when embedding a view with a view that referes to a table that has a long compound pk" $ do
+        get "/player_view?select=id,contract_view(purchase_price)&id=in.(1,3,5,7)" `shouldRespondWith`
+          [json|
+            [{"id":1,"contract_view":[{"purchase_price":10}]},
+             {"id":3,"contract_view":[{"purchase_price":30}]},
+             {"id":5,"contract_view":[{"purchase_price":50}]},
+             {"id":7,"contract_view":[]}] |]
+          { matchHeaders = [matchContentTypeJson] }
+        get "/contract_view?select=tournament,player_view(first_name)&limit=3" `shouldRespondWith`
+          [json|
+            [{"tournament":"tournament_1","player_view":{"first_name":"first_name_1"}},
+             {"tournament":"tournament_2","player_view":{"first_name":"first_name_2"}},
+             {"tournament":"tournament_3","player_view":{"first_name":"first_name_3"}}] |]
+          { matchHeaders = [matchContentTypeJson] }
+
+      it "can embed a view that has group by" $
+        get "/projects_count_grouped_by?select=number_of_projects,client(name)&order=number_of_projects" `shouldRespondWith`
+          [json|
+            [{"number_of_projects":1,"client":null},
+             {"number_of_projects":2,"client":{"name":"Microsoft"}},
+             {"number_of_projects":2,"client":{"name":"Apple"}}] |]
+          { matchHeaders = [matchContentTypeJson] }
+
+      it "can embed a view that has a subselect containing a select in a where" $
+        get "/authors_w_entities?select=name,entities,books(title)&id=eq.1" `shouldRespondWith`
+          [json| [{"name":"George Orwell","entities":[3, 4],"books":[{"title":"1984"}]}] |]
+          { matchHeaders = [matchContentTypeJson] }
 
     describe "path fixed" $ do
       it "works when requesting children 2 levels" $
-        get "/clients?id=eq.1&select=id,projects:projects.client_id(id,tasks(id))" `shouldRespondWith`
+        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] }
 
-      it "works with parent relation" $ do
-        get "/message?select=id,body,sender:person_detail.sender(name,sent),recipient:person_detail.recipient(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] }
-        get "/message?select=id,body,sender:person.sender(name),recipient:person.recipient(name)&id=lt.4" `shouldRespondWith`
+      it "works with parent relation" $
+        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 "fails with an unknown relation" $
+        get "/message?select=id,sender:person.space(name)&id=lt.4" `shouldRespondWith`
+          [json|{"message":"Could not find foreign keys between these entities, No relation found between message and person"}|]
+          { matchStatus = 400
+          , matchHeaders = [matchContentTypeJson] }
+
+      it "works with a parent view relation" $
+        get "/message?select=id,body,sender:person_detail!sender(name,sent),recipient:person_detail!recipient(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 "works with many<->many relation" $
-        get "/tasks?select=id,users:users.users_tasks(id)" `shouldRespondWith`
+        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] }
 
+      -- TODO Remove in next major version(7.0)
+      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] }
+
     describe "aliased embeds" $ do
       it "works with child relation" $
         get "/space?select=id,zones:zone(id,name),stores:zone(id,name)&zones.zone_type_id=eq.2&stores.zone_type_id=eq.3" `shouldRespondWith`
@@ -496,7 +589,7 @@ spec = do
             { 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`
+          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" } ] },
@@ -505,7 +598,7 @@ spec = do
             }]|] { 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`
+          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"} ]
@@ -528,7 +621,7 @@ spec = do
             }]|] { matchHeaders = [matchContentTypeJson] }
 
         it "embeds childs" $ do
-          get "/organizations?select=id,name,refereeds:organizations.referee(id,name)&id=eq.1" `shouldRespondWith`
+          get "/organizations?select=id,name,refereeds:organizations!referee(id,name)&id=eq.1" `shouldRespondWith`
             [json|[{
               "id": 1, "name": "Referee Org",
               "refereeds": [
@@ -542,7 +635,7 @@ spec = do
                 }
               ]
             }]|] { matchHeaders = [matchContentTypeJson] }
-          get "/organizations?select=id,name,auditees:organizations.auditor(id,name)&id=eq.2" `shouldRespondWith`
+          get "/organizations?select=id,name,auditees:organizations!auditor(id,name)&id=eq.2" `shouldRespondWith`
             [json|[{
               "id": 2, "name": "Auditor Org",
               "auditees": [
@@ -557,6 +650,42 @@ spec = do
               ]
             }]|] { 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] }
+
   describe "ordering response" $ do
     it "by a column asc" $
       get "/items?id=lte.2&order=id.asc"
@@ -630,16 +759,6 @@ spec = do
         , matchHeaders = ["Content-Range" <:> "0-1/*"]
         }
 
-    it "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 "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] }
-
     it "without other constraints" $
       get "/items?order=id.asc" `shouldRespondWith` 200
 
@@ -715,7 +834,11 @@ spec = do
     it "should respond an unknown accept type with 415" $
       request methodGet "/simple_pk"
               (acceptHdrs "text/unknowntype") ""
-        `shouldRespondWith` 415
+        `shouldRespondWith`
+        [json|{"message":"None of these Content-Types are available: text/unknowntype"}|]
+        { matchStatus  = 415
+        , matchHeaders = [matchContentTypeJson]
+        }
 
     it "should respond correctly to */* in accept header" $
       request methodGet "/simple_pk"
@@ -771,23 +894,6 @@ spec = do
         respHeaders `shouldSatisfy` matchHeader
           "Content-Location" "/simple_pk"
 
-  describe "jsonb" $ 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] }
-
   describe "weird requests" $ do
     it "can query as normal" $ do
       get "/Escap3e;" `shouldRespondWith`
@@ -813,50 +919,53 @@ spec = do
         [json| [{"escapeId":{"so6meIdColumn":1}},{"escapeId":{"so6meIdColumn":3}},{"escapeId":{"so6meIdColumn":5}}] |]
         { matchHeaders = [matchContentTypeJson] }
 
-  describe "binary output" $ do
-    context "on GET" $ do
-      it "can query if a single column is selected" $
-        request methodGet "/images_base64?select=img&name=eq.A.png" (acceptHdrs "application/octet-stream") ""
-          `shouldRespondWith` "iVBORw0KGgoAAAANSUhEUgAAAB4AAAAeAQMAAAAB/jzhAAAABlBMVEUAAAD/AAAb/40iAAAAP0lEQVQI12NgwAbYG2AE/wEYwQMiZB4ACQkQYZEAIgqAhAGIKLCAEQ8kgMT/P1CCEUwc4IMSzA3sUIIdCHECAGSQEkeOTUyCAAAAAElFTkSuQmCC"
-          { matchStatus = 200
-          , matchHeaders = ["Content-Type" <:> "application/octet-stream; charset=utf-8"]
-          }
+    it "will select and filter a column that has spaces" $
+      get "/Server%20Today?select=Just%20A%20Server%20Model&Just%20A%20Server%20Model=like.*91*" `shouldRespondWith`
+        [json|[
+          {"Just A Server Model":" IBM,9113-550 (P5-550)"},
+          {"Just A Server Model":" IBM,9113-550 (P5-550)"},
+          {"Just A Server Model":" IBM,9131-52A (P5-52A)"},
+          {"Just A Server Model":" IBM,9133-55A (P5-55A)"}]|]
+        { matchHeaders = [matchContentTypeJson] }
 
-      it "fails if a single column is not selected" $ do
-        request methodGet "/images?select=img,name&name=eq.A.png" (acceptHdrs "application/octet-stream") ""
-          `shouldRespondWith` 406
-        request methodGet "/images?select=*&name=eq.A.png" (acceptHdrs "application/octet-stream") ""
-          `shouldRespondWith` 406
-        request methodGet "/images?name=eq.A.png" (acceptHdrs "application/octet-stream") ""
-          `shouldRespondWith` 406
+    it "will select and filter a quoted column that has PostgREST reserved characters" $
+      get "/pgrst_reserved_chars?select=%22:arr-%3Eow::cast%22,%22(inside,parens)%22,%22a.dotted.column%22,%22%20%20col%20%20w%20%20space%20%20%22&%22*id*%22=eq.1" `shouldRespondWith`
+        [json|[{":arr->ow::cast":" arrow-1 ","(inside,parens)":" parens-1 ","a.dotted.column":" dotted-1 ","  col  w  space  ":" space-1"}]|]
+        { matchHeaders = [matchContentTypeJson] }
 
-      it "concatenates results if more than one row is returned" $
-        request methodGet "/images_base64?select=img&name=in.(A.png,B.png)" (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"]
-          }
+  context "binary output" $ do
+    it "can query if a single column is selected" $
+      request methodGet "/images_base64?select=img&name=eq.A.png" (acceptHdrs "application/octet-stream") ""
+        `shouldRespondWith` "iVBORw0KGgoAAAANSUhEUgAAAB4AAAAeAQMAAAAB/jzhAAAABlBMVEUAAAD/AAAb/40iAAAAP0lEQVQI12NgwAbYG2AE/wEYwQMiZB4ACQkQYZEAIgqAhAGIKLCAEQ8kgMT/P1CCEUwc4IMSzA3sUIIdCHECAGSQEkeOTUyCAAAAAElFTkSuQmCC"
+        { matchStatus = 200
+        , matchHeaders = ["Content-Type" <:> "application/octet-stream; charset=utf-8"]
+        }
 
-    context "on RPC" $ do
-      context "Proc that returns scalar" $
-        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 "/projects?select=name&id=eq.1" (acceptHdrs "text/plain") ""
+        `shouldRespondWith` "Windows 7"
+        { 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" $ do
+      request methodGet "/images?select=img,name&name=eq.A.png" (acceptHdrs "application/octet-stream") ""
+        `shouldRespondWith`
+        [json| {"message":"application/octet-stream requested but more than one column was selected"} |]
+        { matchStatus = 406
+        , matchHeaders = [matchContentTypeJson]
+        }
+      request methodGet "/images?select=*&name=eq.A.png" (acceptHdrs "application/octet-stream") ""
+        `shouldRespondWith` 406
+      request methodGet "/images?name=eq.A.png" (acceptHdrs "application/octet-stream") ""
+        `shouldRespondWith` 406
 
-        it "fails if a single column is not selected" $
-          request methodPost "/rpc/ret_rows_with_base64_bin" (acceptHdrs "application/octet-stream") ""
-            `shouldRespondWith` 406
+    it "concatenates results if more than one row is returned" $
+      request methodGet "/images_base64?select=img&name=in.(A.png,B.png)" (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"]
+        }
 
   describe "HTTP request env vars" $ do
     it "custom header is set" $
@@ -974,7 +1083,12 @@ spec = do
         [json| [] |] { matchHeaders = [matchContentTypeJson] }
 
     it "only returns an empty result set if the in value is empty" $
-      get "/items_with_different_col_types?int_data=in.( ,3,4)" `shouldRespondWith` 400
+      get "/items_with_different_col_types?int_data=in.( ,3,4)"
+        `shouldRespondWith`
+        [json| {"hint":null,"details":null,"code":"22P02","message":"invalid input syntax for integer: \"\""} |]
+        { matchStatus = 400
+        , matchHeaders = [matchContentTypeJson]
+        }
 
   describe "Embedding when column name = table name" $ do
     it "works with child embeds" $
@@ -995,3 +1109,6 @@ spec = do
       get "/projects_dump?select=id,name&order=id.desc&limit=3" `shouldRespondWith`
         [json| [{"id":5,"name":"Orphan"}, {"id":4,"name":"OSX"}, {"id":3,"name":"IOS"}] |]
         { matchHeaders = [matchContentTypeJson] }
+
+  it "cannot use ltree(in public schema) extension operators if no extra search path added" $
+    get "/ltree_sample?path=cd.Top.Science.Astronomy" `shouldRespondWith` 400

test/Feature/RangeSpec.hs

@@ -1,17 +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 Network.Wai (Application)
-
-import Protolude hiding (get)
 
 defaultRange :: BL.ByteString
 defaultRange = [json| { "min": 0, "max": 15 } |]
@@ -38,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"
@@ -156,7 +155,6 @@ spec = do
           , matchHeaders = ["Content-Range" <:> "0-0/*"]
           }
 
-
       it "limit and offset works on first level" $
         get "/items?select=id&order=id.asc&limit=3&offset=2"
           `shouldRespondWith` [json|[{"id":3},{"id":4},{"id":5}]|]
@@ -164,8 +162,37 @@ spec = do
           , 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 "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

@@ -1,20 +1,24 @@
 module Feature.RpcSpec where
 
-import Test.Hspec hiding (pendingWith)
-import Test.Hspec.Wai
-import Test.Hspec.Wai.JSON
-import Network.HTTP.Types
-import Network.Wai.Test (SResponse(simpleStatus, simpleBody))
 import qualified Data.ByteString.Lazy as BL (empty)
 
-import SpecHelper
+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 Network.Wai (Application)
 
-import Protolude hiding (get)
+import PostgREST.Types (PgVersion, pgVersion100, pgVersion109,
+                        pgVersion110, pgVersion112, pgVersion114,
+                        pgVersion95)
+import Protolude       hiding (get)
+import SpecHelper
 
-spec :: SpecWith Application
-spec =
+spec :: PgVersion -> SpecWith Application
+spec actualPgVersion =
   describe "remote procedure call" $ do
     context "a proc that returns a set" $ do
       it "returns paginated results" $ do
@@ -77,6 +81,31 @@ spec =
       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
@@ -203,6 +232,48 @@ spec =
           [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"
@@ -226,7 +297,11 @@ spec =
     context "unsupported verbs" $ do
       it "DELETE fails" $
         request methodDelete "/rpc/sayhello" [] ""
-          `shouldRespondWith` 405
+          `shouldRespondWith`
+          [json|{"message":"Bad Request"}|]
+          { matchStatus  = 405
+          , matchHeaders = [matchContentTypeJson]
+          }
       it "PATCH fails" $
         request methodPatch "/rpc/sayhello" [] ""
           `shouldRespondWith` 405
@@ -292,7 +367,12 @@ spec =
         }
 
     it "defaults to status 500 if RAISE code is PT not followed by a number" $
-      get "/rpc/raise_bad_pt" `shouldRespondWith` 500
+      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" $
@@ -329,10 +409,84 @@ spec =
       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" $
+    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] }
+
+    context "bulk RPC" $ do
+      it "works with a scalar function an returns a json array" $
+        post "/rpc/add_them"
+          [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")]
+          "a,b\n1,2\n4,6\n100,200"
+          `shouldRespondWith`
+          [json|
+            [3, 10, 300]
+          |]
+          { matchStatus  = 200
+          , matchHeaders = [matchContentTypeJson]
+          }
+
+      it "works with a non-scalar result" $
+        post "/rpc/get_projects_below?select=id,name"
+          [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 "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
@@ -361,3 +515,12 @@ spec =
         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,16 +1,16 @@
 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 Network.Wai.Test (SResponse(..))
-
-import Network.Wai (Application)
+import Text.Heredoc
 
+import Protolude  hiding (get)
 import SpecHelper
-import Protolude hiding (get)
 
 
 spec :: SpecWith Application
@@ -43,7 +43,6 @@ spec =
             { 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
@@ -56,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
-          "/addresses?id=gt.0"
-          [("Prefer", "return=representation"), singular]
-          [json| { address: "zzz" } |]
+        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
@@ -67,15 +65,16 @@ 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
-        p <- request methodPatch  "/items?id=gt.0&id=lt.0"
-          [("Prefer", "return=representation"), singular] [json|{"id":1}|]
-        liftIO $ do
-          simpleStatus p `shouldBe` notAcceptable406
-          isErrorFormat (simpleBody p) `shouldBe` True
+      it "raises an error for zero rows" $
+        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"
@@ -117,17 +116,17 @@ spec =
           , matchHeaders = ["Content-Range" <:> "*/*"]
           }
 
-      it "raises an error when creating zero entities" $ do
-        p <- request methodPost
-          "/addresses"
-          [("Prefer", "return=representation"), singular]
-          [json| [ ] |]
-        liftIO $ do
-          simpleStatus p `shouldBe` notAcceptable406
-          isErrorFormat (simpleBody p) `shouldBe` True
+      it "raises an error when creating zero entities" $
+        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"
@@ -146,21 +145,24 @@ spec =
           , matchHeaders = ["Content-Range" <:> "0-9/*"]
           }
 
-      it "raises an error when deleting zero entities" $ do
-        p <- request methodDelete "/items?id=lt.0"
-          [("Prefer", "return=representation"), singular] ""
-        liftIO $ do
-          simpleStatus p `shouldBe` notAcceptable406
-          isErrorFormat (simpleBody p) `shouldBe` True
+      it "raises an error when deleting zero entities" $
+        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" $ do
-        p <- request methodPost "/rpc/getproject"
-          [singular] [json|{ "id": 9999999}|]
-        liftIO $ do
-          simpleStatus p `shouldBe` notAcceptable406
-          isErrorFormat (simpleBody p) `shouldBe` True
+      it "fails for zero rows" $
+        request methodPost "/rpc/getproject"
+                [singular] [json|{ "id": 9999999}|]
+          `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"]
+                }
 
       -- this one may be controversial, should vnd.pgrst.object include
       -- the likes of 2 and "hello?"
@@ -174,20 +176,26 @@ spec =
           [singular] [json|{ "id": 1}|] `shouldRespondWith`
           [str|{"id":1,"name":"Windows 7","client_id":1}|]
 
-      it "fails for multiple rows" $ do
-        p <- request methodPost "/rpc/getallprojects" [singular] "{}"
-        liftIO $ do
-          simpleStatus p `shouldBe` notAcceptable406
-          isErrorFormat (simpleBody p) `shouldBe` True
+      it "fails for multiple rows" $
+        request methodPost "/rpc/getallprojects"
+                [singular] "{}"
+          `shouldRespondWith`
+                [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"} |]
-        liftIO $ do
-          simpleStatus p `shouldBe` notAcceptable406
-          isErrorFormat (simpleBody p) `shouldBe` True
+
+        request methodPost "/rpc/setprojects" [singular]
+                [json| {"id_l": 1, "id_h": 2, "name": "changed"} |]
+          `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"]
+                }
 
         -- should not actually have executed the function
         request methodPost "/rpc/getproject?select=id,name" [] [json| {"id": 1} |]

test/Feature/StructureSpec.hs

@@ -1,22 +1,22 @@
 module Feature.StructureSpec where
 
-import Test.Hspec hiding (pendingWith)
-import Test.Hspec.Wai
-import Network.HTTP.Types
-
-import PostgREST.Config (docsVersion)
-import Control.Lens ((^?))
+import Control.Lens     ((^?))
 import Data.Aeson.Types (Value (..))
+import Network.Wai      (Application)
+import Network.Wai.Test (SResponse (..))
+
 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)
-import Network.Wai.Test (SResponse(..))
-
-import Protolude hiding (get)
-
 spec :: SpecWith Application
 spec = do
 
@@ -45,6 +45,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"
@@ -79,12 +80,42 @@ 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 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 "/"
 
@@ -104,7 +135,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"
                   },
@@ -113,7 +144,10 @@ spec = do
                     "format": "integer",
                     "type": "integer"
                   }
-                }
+                },
+                "required": [
+                  "id"
+                ]
               }
             |]
 
@@ -163,15 +197,206 @@ spec = do
               ]
             |]
 
-    describe "RPC" $ do
+    describe "Materialized view" $
 
-      it "includes body schema for arguments" $ do
+      it "includes materialized view properties" $ do
         r <- simpleBody <$> get "/"
-        let args = r ^? key "paths" . key "/rpc/varied_arguments"
-                      . key "post"  . key "parameters"
-                      . nth 0       . key "schema"
+
+        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 "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|
               {
@@ -186,7 +411,7 @@ spec = do
                 "properties": {
                   "double": {
                     "format": "double precision",
-                    "type": "string"
+                    "type": "number"
                   },
                   "varchar": {
                     "format": "character varying",
@@ -211,9 +436,18 @@ spec = do
                   "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"
               }
             |]
 

test/Feature/UnicodeSpec.hs

@@ -1,15 +1,15 @@
 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 =
   describe "Reading and writing to unicode schema and table names" $

test/Feature/UpsertSpec.hs

@@ -1,16 +1,16 @@
 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 Network.HTTP.Types
-
-import SpecHelper
-import Network.Wai (Application)
-
-import Protolude hiding (get, put)
 import Text.Heredoc
 
+import Protolude  hiding (get, put)
+import SpecHelper
+
 spec :: SpecWith Application
 spec =
   describe "UPSERT" $ do
@@ -44,6 +44,12 @@ spec =
             , 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] }
+
+
       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")]
@@ -104,48 +110,96 @@ spec =
       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` 400
+            [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` 400
+            [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` 400
+            [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` 400
+            [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` 400
+            [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` 400
+            [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` 405
-          put "/tiobe_pls?id=not.eq.Java" [str| [ { "name": "Go", "rank": 19 } ]|] `shouldRespondWith` 405
-          put "/tiobe_pls?id=in.(Go)" [str| [ { "name": "Go", "rank": 19 } ]|] `shouldRespondWith` 405
-          put "/tiobe_pls?and=(id.eq.Go)" [str| [ { "name": "Go", "rank": 19 } ]|] `shouldRespondWith` 405
+          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` 405
+            `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` 405
+            `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` 400
+        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` 400
+          [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` 405
+        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
@@ -198,3 +252,30 @@ spec =
           [("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,42 +1,51 @@
 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.Time.Clock    (getCurrentTime)
+
+import Data.IORef
 import Test.Hspec
+
+import PostgREST.App         (postgrest)
+import PostgREST.DbStructure (getDbStructure, getPgVersion)
+import PostgREST.Types       (DbStructure (..), pgVersion95,
+                              pgVersion96)
+import Protolude
 import SpecHelper
 
-import qualified Hasql.Pool as P
-
-import PostgREST.App (postgrest)
-import PostgREST.Config (pgVersion95, pgVersion96, configSettings)
-import PostgREST.DbStructure (getDbStructure, getPgVersion, fillSessionWithSettings)
-import PostgREST.Types (DbStructure(..))
-import Control.AutoUpdate (defaultUpdateSettings, mkAutoUpdate, updateAction)
-import Data.Function (id)
-import Data.IORef
-import Data.Time.Clock (getCurrentTime)
-
-import qualified Feature.AuthSpec
+import qualified Feature.AndOrParamsSpec
 import qualified Feature.AsymmetricJwtSpec
-import qualified Feature.BinaryJwtSecretSpec
 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.ExtraSearchPathSpec
+import qualified Feature.HtmlRawOutputSpec
 import qualified Feature.InsertSpec
+import qualified Feature.JsonOperatorSpec
 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.SingularSpec
-import qualified Feature.UnicodeSpec
-import qualified Feature.ProxySpec
-import qualified Feature.AndOrParamsSpec
+import qualified Feature.RawOutputTypesSpec
+import qualified Feature.RootSpec
 import qualified Feature.RpcSpec
-import qualified Feature.NonexistentSchemaSpec
-import qualified Feature.PgVersion96Spec
+import qualified Feature.SingularSpec
+import qualified Feature.StructureSpec
+import qualified Feature.UnicodeSpec
 import qualified Feature.UpsertSpec
 
-import Protolude
 
 main :: IO ()
 main = do
@@ -45,50 +54,62 @@ main = do
 
   pool <- P.acquire (3, 10, toS testDbConn)
 
-  result <- P.use pool $ getDbStructure "test" =<< getPgVersion
+  result <- P.use pool $ do
+    ver <- getPgVersion
+    HT.transaction HT.ReadCommitted HT.Read $ getDbStructure "test" ver
 
-  dbStructure <- pure $ either (panic.show) id result
+  let dbStructure = either (panic.show) id result
 
   getTime <- mkAutoUpdate defaultUpdateSettings { updateAction = getCurrentTime }
 
   refDbStructure <- newIORef $ Just dbStructure
 
-  let withApp              = return $ postgrest (testCfg testDbConn)            refDbStructure pool getTime $ pure ()
-      ltdApp               = return $ postgrest (testLtdRowsCfg testDbConn)     refDbStructure pool getTime $ pure ()
-      unicodeApp           = return $ postgrest (testUnicodeCfg testDbConn)     refDbStructure pool getTime $ pure ()
-      proxyApp             = return $ postgrest (testProxyCfg testDbConn)       refDbStructure pool getTime $ pure ()
-      noJwtApp             = return $ postgrest (testCfgNoJWT testDbConn)       refDbStructure pool getTime $ pure ()
-      binaryJwtApp         = return $ postgrest (testCfgBinaryJWT testDbConn)   refDbStructure pool getTime $ pure ()
-      audJwtApp            = return $ postgrest (testCfgAudienceJWT testDbConn) refDbStructure pool getTime $ pure ()
-      asymJwkApp           = return $ postgrest (testCfgAsymJWK testDbConn)     refDbStructure pool getTime $ pure ()
-      nonexistentSchemaApp = return $ postgrest (testNonexistentSchemaCfg testDbConn)   refDbStructure pool getTime $ pure ()
+  let withApp              = return $ postgrest (testCfg testDbConn)                  refDbStructure pool getTime $ pure ()
+      ltdApp               = return $ postgrest (testLtdRowsCfg testDbConn)           refDbStructure pool getTime $ pure ()
+      unicodeApp           = return $ postgrest (testUnicodeCfg testDbConn)           refDbStructure pool getTime $ pure ()
+      proxyApp             = return $ postgrest (testProxyCfg testDbConn)             refDbStructure pool getTime $ pure ()
+      noJwtApp             = return $ postgrest (testCfgNoJWT testDbConn)             refDbStructure pool getTime $ pure ()
+      binaryJwtApp         = return $ postgrest (testCfgBinaryJWT testDbConn)         refDbStructure pool getTime $ pure ()
+      audJwtApp            = return $ postgrest (testCfgAudienceJWT testDbConn)       refDbStructure pool getTime $ pure ()
+      asymJwkApp           = return $ postgrest (testCfgAsymJWK testDbConn)           refDbStructure pool getTime $ pure ()
+      asymJwkSetApp        = return $ postgrest (testCfgAsymJWKSet testDbConn)        refDbStructure pool getTime $ pure ()
+      nonexistentSchemaApp = return $ postgrest (testNonexistentSchemaCfg testDbConn) refDbStructure pool getTime $ pure ()
+      extraSearchPathApp   = return $ postgrest (testCfgExtraSearchPath testDbConn)   refDbStructure pool getTime $ pure ()
+      rootSpecApp          = return $ postgrest (testCfgRootSpec testDbConn)          refDbStructure pool getTime $ pure ()
+      htmlRawOutputApp     = return $ postgrest (testCfgHtmlRawOutput testDbConn)     refDbStructure pool getTime $ pure ()
 
   let reset :: IO ()
-      reset = P.use pool (fillSessionWithSettings (configSettings $ testCfg testDbConn)) >> resetDb testDbConn
+      reset = resetDb testDbConn
 
       actualPgVersion = pgVersion dbStructure
       extraSpecs =
         [("Feature.UpsertSpec", Feature.UpsertSpec.spec) | actualPgVersion >= pgVersion95] ++
+        [("Feature.PgVersion95Spec", Feature.PgVersion95Spec.spec) | actualPgVersion >= pgVersion95] ++
         [("Feature.PgVersion96Spec", Feature.PgVersion96Spec.spec) | actualPgVersion >= pgVersion96]
 
       specs = uncurry describe <$> [
-          ("Feature.AuthSpec"               , Feature.AuthSpec.spec)
+          ("Feature.AuthSpec"               , Feature.AuthSpec.spec actualPgVersion)
+        , ("Feature.RawOutputTypesSpec"     , Feature.RawOutputTypesSpec.spec)
         , ("Feature.ConcurrentSpec"         , Feature.ConcurrentSpec.spec)
         , ("Feature.CorsSpec"               , Feature.CorsSpec.spec)
         , ("Feature.DeleteSpec"             , Feature.DeleteSpec.spec)
-        , ("Feature.InsertSpec"             , Feature.InsertSpec.spec)
-        , ("Feature.QuerySpec"              , Feature.QuerySpec.spec)
-        , ("Feature.RpcSpec"                , Feature.RpcSpec.spec)
+        , ("Feature.InsertSpec"             , Feature.InsertSpec.spec actualPgVersion)
+        , ("Feature.JsonOperatorSpec"       , Feature.JsonOperatorSpec.spec actualPgVersion)
+        , ("Feature.QuerySpec"              , Feature.QuerySpec.spec actualPgVersion)
+        , ("Feature.RpcSpec"                , Feature.RpcSpec.spec actualPgVersion)
         , ("Feature.RangeSpec"              , Feature.RangeSpec.spec)
         , ("Feature.SingularSpec"           , Feature.SingularSpec.spec)
         , ("Feature.StructureSpec"          , Feature.StructureSpec.spec)
-        , ("Feature.AndOrParamsSpec"        , Feature.AndOrParamsSpec.spec)
-        , ("Feature.NonexistentSchemaSpec"  , Feature.NonexistentSchemaSpec.spec)
+        , ("Feature.AndOrParamsSpec"        , Feature.AndOrParamsSpec.spec actualPgVersion)
         ] ++ extraSpecs
 
   hspec $ do
     mapM_ (beforeAll_ reset . before withApp) specs
 
+    -- this test runs with a raw-output-media-types set to text/html
+    beforeAll_ reset . before htmlRawOutputApp $
+      describe "Feature.HtmlRawOutputSpec" Feature.HtmlRawOutputSpec.spec
+
     -- this test runs with a different server flag
     beforeAll_ reset . before ltdApp $
       describe "Feature.QueryLimitedSpec" Feature.QueryLimitedSpec.spec
@@ -117,6 +138,19 @@ main = do
     beforeAll_ reset . before asymJwkApp $
       describe "Feature.AsymmetricJwtSpec" Feature.AsymmetricJwtSpec.spec
 
+    -- this test runs with asymmetric JWKSet
+    beforeAll_ reset . before asymJwkSetApp $
+      describe "Feature.AsymmetricJwtSpec" Feature.AsymmetricJwtSpec.spec
+
     -- this test runs with a nonexistent db-schema
     beforeAll_ reset . before nonexistentSchemaApp $
       describe "Feature.NonexistentSchemaSpec" Feature.NonexistentSchemaSpec.spec
+
+    -- this test runs with an extra search path
+    beforeAll_ reset . before extraSearchPathApp $
+      describe "Feature.ExtraSearchPathSpec" Feature.ExtraSearchPathSpec.spec
+
+    -- this test runs with a root spec function override
+    when (actualPgVersion >= pgVersion96) $
+      beforeAll_ reset . before rootSpecApp $
+        describe "Feature.RootSpec" Feature.RootSpec.spec

test/SpecHelper.hs

@@ -1,34 +1,29 @@
 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 System.Environment (getEnv)
+import Control.Monad        (void)
+import Data.Aeson           (Value (..), decode, encode)
+import Data.CaseInsensitive (CI (..))
+import Data.List            (lookup)
+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 PostgREST.Types  (JSPathExp(..))
-
-import Test.Hspec hiding (pendingWith)
-import Test.Hspec.Wai
 
 import Network.HTTP.Types
-import Network.Wai.Test (SResponse(simpleStatus, simpleHeaders, simpleBody))
-
-import Data.Maybe (fromJust)
-import Data.Aeson (decode, Value(..))
-import qualified JSONSchema.Draft4 as D4
+import Test.Hspec
+import Test.Hspec.Wai
+import Text.Heredoc
 
+import PostgREST.Config (AppConfig (..))
+import PostgREST.Types  (JSPathExp (..), QualifiedIdentifier (..))
 import Protolude
 
 matchContentTypeJson :: MatchHeader
@@ -48,30 +43,33 @@ validateOpenApiResponse headers = do
     let respHeaders = simpleHeaders r in
     respHeaders `shouldSatisfy`
       \hs -> ("Content-Type", "application/openapi+json; charset=utf-8") `elem` hs
-  liftIO $
-    let respBody = simpleBody r
-        schema :: D4.Schema
-        schema = D4.emptySchema { D4._schemaRef = Just "openapi.json" }
-        schemaContext :: D4.SchemaWithURI D4.Schema
-        schemaContext = D4.SchemaWithURI
-          { D4._swSchema = schema
-          , D4._swURI    = Just "test/fixtures/openapi.json"
-          }
-       in
-       D4.fetchFilesystemAndValidate schemaContext ((fromJust . decode) respBody) `shouldReturn` Right ()
+  let Just body = decode (simpleBody r)
+  Just schema <- liftIO $ decode <$> BL.readFile "test/fixtures/openapi.json"
+  let args :: M.Map Text Value
+      args = M.fromList
+        [ ( "schema", schema )
+        , ( "data", body ) ]
+      hdrs = acceptHdrs "application/json"
+  request methodPost "/rpc/validate_json_schema" hdrs (encode args)
+      `shouldRespondWith` "true"
+      { matchStatus = 200
+      , matchHeaders = []
+      }
+
 
 getEnvVarWithDefault :: Text -> Text -> IO Text
-getEnvVarWithDefault var def = do
-  varValue <- getEnv (toS var) `E.catchIOError` const (return $ toS def)
-  return $ toS varValue
+getEnvVarWithDefault var def = toS <$>
+  getEnv (toS var) `E.catchIOError` const (return $ toS def)
 
 _baseCfg :: AppConfig
 _baseCfg =  -- Connection Settings
   AppConfig mempty "postgrest_test_anonymous" Nothing "test" "localhost" 3000
+            -- No user configured Unix Socket
+            Nothing
             -- Jwt settings
             (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")
@@ -79,6 +77,12 @@ _baseCfg =  -- Connection Settings
             ]
             -- 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 }
@@ -114,15 +118,31 @@ testCfgAsymJWK testDbConn = (testCfg testDbConn) {
       [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) { configSchema = "nonexistent" }
 
+testCfgExtraSearchPath :: Text -> AppConfig
+testCfgExtraSearchPath testDbConn = (testCfg testDbConn) { configExtraSearchPath = ["public", "extensions"] }
+
+testCfgRootSpec :: Text -> AppConfig
+testCfgRootSpec testDbConn = (testCfg testDbConn) { configRootSpec = Just $ QualifiedIdentifier "test" "root"}
+
+testCfgHtmlRawOutput :: Text -> AppConfig
+testCfgHtmlRawOutput testDbConn = (testCfg testDbConn) { configRawMediaTypes = ["text/html"] }
+
 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
 
@@ -131,7 +151,7 @@ resetDb dbConn = loadFixture dbConn "data"
 
 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, "-a", "-f", "test/fixtures/" ++ name ++ ".sql"] []
 
 rangeHdrs :: ByteRange -> [Header]
 rangeHdrs r = [rangeUnit, (hRange, renderByteRange r)]
@@ -166,5 +186,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
-, incInsert :: Text
+, incStr         :: 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
-, compoundK2 :: Text
+  compoundK1    :: Int
+, 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
-if [ -z "$1" ]
-  then
-    echo "Please supply the connection uri for the user with create database privileges"
-    exit -1
+#! /usr/bin/env bash
+
+usage() {
+  echo "$0 <db-uri> <test-database>"
+  exit -1
+}
+
+if [ -z "$1" ]; then
+  echo "Please supply the connection uri for the user with create database privileges"
+  usage
 fi
 
-if [ -z "$2" ]
-  then
-    echo "Please supply the test database name"
-    exit -1
+if [ -z "$2" ]; then
+  echo "Please supply the test database name"
+  usage
 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/fixtures/data.sql

@@ -250,7 +250,7 @@ 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')); 
+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: -
@@ -354,11 +354,21 @@ 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);
-INSERT INTO organizations VALUES (2, 'Auditor Org', null, null);
-INSERT INTO organizations VALUES (3, 'Acme', 1, 2);
-INSERT INTO organizations VALUES (4, 'Umbrella', 1, 2);
+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;
 
@@ -373,16 +383,27 @@ 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);
-INSERT INTO books VALUES (2, 'The Diary of a Young Girl', 1947, 2);
-INSERT INTO books VALUES (3, 'The Little Prince', 1947, 3);
-INSERT INTO books VALUES (4, 'The Catcher in the Rye', 1951, 4);
-INSERT INTO books VALUES (5, 'Farenheit 451', 1953, 5);
-INSERT INTO books VALUES (6, 'Lord of the Flies', 1954, 6);
-INSERT INTO books VALUES (7, 'To Kill a Mockingbird', 1960, 7);
-INSERT INTO books VALUES (8, 'Slaughterhouse-Five', 1969, 8);
-INSERT INTO books VALUES (9, 'One Flew Over the Cuckoo''s Nest', 1962, 9);
+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;
 
@@ -411,3 +432,70 @@ 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
+\.

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 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/privileges.sql

@@ -5,6 +5,7 @@ GRANT USAGE ON SCHEMA
     , jwt
     , public
     , "تست"
+    , extensions
 TO postgrest_test_anonymous;
 
 -- Schema test objects
@@ -67,6 +68,7 @@ GRANT ALL ON TABLE
     , tiobe_pls
     , only_pk
     , family_tree
+    , managers
     , organizations
     , authors
     , books
@@ -79,6 +81,26 @@ GRANT ALL ON TABLE
     , 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
 TO postgrest_test_anonymous;
 
 GRANT INSERT ON TABLE insertonly TO postgrest_test_anonymous;

test/fixtures/schema.sql

@@ -17,7 +17,7 @@ CREATE SCHEMA postgrest;
 CREATE SCHEMA private;
 CREATE SCHEMA test;
 CREATE SCHEMA تست;
-
+CREATE SCHEMA extensions;
 
 --
 -- Name: plpgsql; Type: EXTENSION; Schema: -; Owner: -
@@ -116,6 +116,11 @@ CREATE FUNCTION always_true(test.items) RETURNS boolean
     LANGUAGE sql STABLE
     AS $$ SELECT true $$;
 
+CREATE FUNCTION is_first(test.items) RETURNS boolean
+    LANGUAGE sql STABLE
+    AS $$ SELECT $1.id = 1 $$;
+
+
 CREATE FUNCTION anti_id(test.items) RETURNS bigint
     LANGUAGE sql STABLE
     AS $_$ SELECT $1.id * -1 $_$;
@@ -176,20 +181,6 @@ CREATE FUNCTION noparamsproc() RETURNS text
 		SELECT a FROM (VALUES ('Return value of no parameters procedure.')) s(a);
 	$$;
 
---
--- Name: insert_insertable_view_with_join(); Type: FUNCTION; Schema: test; Owner: -
---
-
-CREATE FUNCTION insert_insertable_view_with_join() RETURNS trigger
-    LANGUAGE plpgsql
-    AS $$
-begin
-  INSERT INTO test.auto_incrementing_pk (nullable_string, non_nullable_string) VALUES (NEW.nullable_string, NEW.non_nullable_string);
-  RETURN NEW;
-end;
-$$;
-
-
 --
 -- Name: login(text, text); Type: FUNCTION; Schema: test; Owner: -
 --
@@ -215,13 +206,27 @@ CREATE FUNCTION varied_arguments(
   date date,
   money money,
   enum enum_menagerie_type,
-  "integer" integer default 42
+  "integer" integer default 42,
+  json json default '{}',
+  jsonb jsonb default '{}'
 ) RETURNS text
     LANGUAGE sql
 AS $_$
   SELECT 'Hi'::text;
 $_$;
 
+COMMENT ON FUNCTION varied_arguments(double precision, character varying, boolean, date, money, enum_menagerie_type, integer, json, jsonb) IS
+$_$An RPC function
+
+Just a test for RPC function arguments$_$;
+
+
+CREATE FUNCTION json_argument(arg json) RETURNS text
+
+LANGUAGE sql
+AS $_$
+  SELECT json_typeof(arg);
+$_$;
 
 --
 -- Name: jwt_test(); Type: FUNCTION; Schema: test; Owner: -
@@ -960,13 +965,6 @@ CREATE TRIGGER articles_owner_track BEFORE INSERT OR UPDATE ON articles FOR EACH
 
 SET search_path = test, pg_catalog;
 
---
--- Name: insert_insertable_view_with_join; Type: TRIGGER; Schema: test; Owner: -
---
-
-CREATE TRIGGER insert_insertable_view_with_join INSTEAD OF INSERT ON insertable_view_with_join FOR EACH ROW EXECUTE PROCEDURE insert_insertable_view_with_join();
-
-
 --
 -- Name: secrets_owner_track; Type: TRIGGER; Schema: test; Owner: -
 --
@@ -1111,8 +1109,8 @@ CREATE FUNCTION setprojects(id_l int, id_h int, name text) RETURNS SETOF project
 $_$;
 
 create table images (
-	name               text not null,
-	img                bytea not null
+	name text  not null,
+	img  bytea not null
 );
 
 create view images_base64 as (
@@ -1120,17 +1118,17 @@ create view images_base64 as (
   select name, replace(encode(img, 'base64'), E'\n', '') as img from images
 );
 
-create function test.ret_enum(val text) returns test.enum_menagerie_type as $$ 
+create function test.ret_enum(val text) returns test.enum_menagerie_type as $$
   select val::test.enum_menagerie_type;
 $$ language sql;
 
 create domain one_nine as integer check (value >= 1 and value <= 9);
 
-create function test.ret_array() returns integer[] as $$ 
+create function test.ret_array() returns integer[] as $$
   select '{1,2,3}'::integer[];
 $$ language sql;
 
-create function test.ret_domain(val integer) returns test.one_nine as $$ 
+create function test.ret_domain(val integer) returns test.one_nine as $$
   select val::test.one_nine;
 $$ language sql;
 
@@ -1144,20 +1142,20 @@ $$ language sql;
 
 create function test.ret_scalars() returns table(
   a text, b test.enum_menagerie_type, c test.one_nine, d int4range
-) as $$ 
-  select row('scalars'::text, enum_first(null::test.enum_menagerie_type), 
+) as $$
+  select row('scalars'::text, enum_first(null::test.enum_menagerie_type),
               1::test.one_nine, int4range(10, 20));
 $$ language sql;
 
 create type test.point_2d as (x integer, y integer);
 
-create function test.ret_point_2d() returns test.point_2d as $$ 
+create function test.ret_point_2d() returns test.point_2d as $$
   select row(10, 5)::test.point_2d;
 $$ language sql;
 
 create type private.point_3d as (x integer, y integer, z integer);
 
-create function test.ret_point_3d() returns private.point_3d as $$ 
+create function test.ret_point_3d() returns private.point_3d as $$
   select row(7, -3, 4)::private.point_3d;
 $$ language sql;
 
@@ -1171,17 +1169,17 @@ create function test.ret_rows_with_base64_bin() returns setof test.images_base64
   select i.name, i.img from test.images_base64 i;
 $$ language sql;
 
-create function test.single_article(id integer) returns test.articles as $$ 
+create function test.single_article(id integer) returns test.articles as $$
   select a.* from test.articles a where a.id = $1;
 $$ language sql;
 
-create function test.get_guc_value(name text) returns text as $$ 
+create function test.get_guc_value(name text) returns text as $$
   select nullif(current_setting(name), '')::text;
 $$ language sql;
 
 create table w_or_wo_comma_names ( name text );
 
-create table items_with_different_col_types ( 
+create table items_with_different_col_types (
   int_data integer,
   text_data text,
   bool_data bool,
@@ -1194,20 +1192,20 @@ create table items_with_different_col_types (
 
 -- Tables used for testing complex boolean logic with and/or query params
 
-create table entities ( 
+create table entities (
   id integer primary key,
   name text,
   arr integer[],
   text_search_vector tsvector
 );
 
-create table child_entities ( 
+create table child_entities (
   id integer primary key,
   name text,
   parent_id integer references entities(id)
 );
 
-create table grandchild_entities ( 
+create table grandchild_entities (
   id integer primary key,
   name text,
   parent_id integer references child_entities(id),
@@ -1228,7 +1226,7 @@ create table ranges (
 
 comment on table child_entities is 'child_entities comment';
 comment on column child_entities.id is 'child_entities id comment';
-comment on column child_entities.name is 'child_entities name comment';
+comment on column child_entities.name is 'child_entities name comment. Can be longer than sixty-three characters long';
 
 comment on table grandchild_entities is
 $$grandchild_entities summary
@@ -1382,11 +1380,17 @@ create table test.family_tree (
 );
 alter table only test.family_tree add constraint pptr foreign key (parent) references test.family_tree(id);
 
+create table test.managers (
+  id integer primary key,
+  name text
+);
+
 create table test.organizations (
   id integer primary key,
   name text,
   referee integer,
-  auditor integer
+  auditor integer,
+  manager_id integer references managers(id)
 );
 alter table only test.organizations add constraint pptr1 foreign key (referee) references test.organizations(id);
 alter table only test.organizations add constraint pptr2 foreign key (auditor) references test.organizations(id);
@@ -1396,11 +1400,17 @@ create table private.authors(
   name text
 );
 
+create table private.publishers(
+  id integer primary key,
+  name text
+);
+
 create table private.books(
   id integer primary key,
   title text,
   publication_year smallint,
-  author_id integer references private.authors(id)
+  author_id integer references private.authors(id),
+  first_publisher_id integer references private.publishers(id)
 );
 
 create view test.authors as select id, name from private.authors;
@@ -1451,3 +1461,272 @@ comment on foreign table projects_dump is
 $$A temporary projects dump
 
 Just a test for foreign tables$$;
+
+create table "UnitTest"(
+  "idUnitTest" integer primary key,
+  "nameUnitTest" text
+);
+
+create table json_arr(
+  id integer primary key,
+  data pg_catalog.json
+);
+
+create table jsonb_test(
+  id integer primary key,
+  data jsonb
+);
+
+create view test.authors_books_number as
+select
+  id,
+  name,
+  (
+    select
+      count(*)
+    from forties_books where author_id = authors.id
+  ) as num_in_forties,
+  (
+    select
+      count(*)
+    from fifties_books where author_id = authors.id
+  ) as num_in_fifties,
+  (
+    select
+      count(*)
+    from sixties_books where author_id = authors.id
+  ) as num_in_sixties,
+  (
+    select
+      count(*)
+    from (
+      select id
+      from forties_books where author_id = authors.id
+      union
+      select id
+      from fifties_books where author_id = authors.id
+      union
+      select id
+      from sixties_books where author_id = authors.id
+    ) _
+  ) as num_in_all_decades
+from private.authors;
+
+create view test.authors_have_book_in_decade as
+select
+  id,
+  name,
+  case
+    when (x.id in (select author_id from test.forties_books))
+    then true
+    else false
+  end as has_book_in_forties,
+  case
+    when (x.id in (select author_id from test.fifties_books))
+    then true
+    else false
+  end as has_book_in_fifties,
+  case
+    when (x.id in (select author_id from test.sixties_books))
+    then true
+    else false
+  end as has_book_in_sixties
+from private.authors x;
+
+create view test.forties_and_fifties_books as
+select x.id, x.title, x.publication_year, y.name as first_publisher, x.author_id
+from (
+  select id, title, publication_year, author_id, first_publisher_id from private.books
+  where publication_year >= 1940 and publication_year < 1960) x
+join private.publishers y on y.id = x.first_publisher_id;
+
+create view test.odd_years_publications as
+with
+odd_years_books as(
+  select id, title, publication_year, author_id, first_publisher_id
+  from private.books
+  where publication_year % 2 <> 0
+)
+select
+  x.id, x.title, x.publication_year,
+  y.name as first_publisher, x.author_id
+from odd_years_books x
+join private.publishers y on y.id = x.first_publisher_id;
+
+create view test.projects_count_grouped_by as
+select
+  client_id,
+  count(id) as number_of_projects
+from projects
+group by client_id;
+
+create view test.authors_w_entities as
+select
+  id,
+  name,
+  (
+    select json_agg(id)
+    from test.entities
+    where id not in (
+      select parent_id from test.child_entities
+    )
+  ) as entities
+from private.authors;
+
+CREATE TABLE test."Foo"(
+  id int primary key,
+  name text
+);
+
+CREATE TABLE test.bar(
+  id int primary key,
+  name text,
+  "fooId" int references "Foo"(id)
+);
+
+CREATE VIEW test.foos as select id,name from "Foo";
+CREATE VIEW test.bars as select id, "fooId", name from bar;
+
+create materialized view materialized_projects as
+select id, name, client_id from projects;
+
+comment on materialized view materialized_projects is
+$$A materialized view for projects
+
+Just a test for materialized views$$;
+
+create or replace function test."quotedFunction"("user" text, "fullName" text, "SSN" text)
+returns jsonb AS $$
+  select format('{"user": "%s", "fullName": "%s", "SSN": "%s"}', "user", "fullName", "SSN")::jsonb;
+$$ language sql;
+
+create table private.player (
+  id integer not null,
+  first_name text not null,
+  last_name text not null,
+  birth_date date,
+  primary key (last_name, id, first_name, birth_date) -- just for testing a long compound pk
+);
+
+create table test.contract (
+  tournament text not null,
+  time tsrange not null,
+  purchase_price int not null,
+  id integer not null,
+  first_name text not null,
+  last_name text not null,
+  birth_date date,
+  foreign key (last_name, id, first_name, birth_date) references private.player
+);
+
+create view test.player_view as select * from private.player;
+
+create view test.contract_view as select * from test.contract;
+
+create type public.my_type AS enum ('something');
+
+create function test.test_arg(my_arg public.my_type) returns text as $$
+  select 'foobar'::text;
+$$ language sql;
+
+create extension if not exists ltree with schema public;
+
+create table test.ltree_sample (
+  path public.ltree
+);
+
+CREATE FUNCTION test.number_of_labels(test.ltree_sample) RETURNS integer AS $$
+  SELECT nlevel($1.path)
+$$ language sql;
+
+create extension if not exists isn with schema extensions;
+
+create table test.isn_sample (
+  id extensions.isbn,
+  name text
+);
+
+create function test.is_valid_isbn(input text) returns boolean as $$
+  select is_valid(input::isbn);
+$$ language sql;
+
+create table "Server Today"(
+  "cHostname" text,
+  "Just A Server Model" text
+);
+
+create table test.pgrst_reserved_chars (
+  "*id*" integer,
+  ":arr->ow::cast" text,
+  "(inside,parens)" text,
+  "a.dotted.column" text,
+  "  col  w  space  " text
+);
+
+CREATE TABLE test.openapi_types(
+  "a_character_varying" character varying,
+  "a_character" character(1),
+  "a_text" text,
+  "a_boolean" boolean,
+  "a_smallint" smallint,
+  "a_integer" integer,
+  "a_bigint" bigint,
+  "a_numeric" numeric,
+  "a_real" real,
+  "a_double_precision" double precision
+);
+
+create function add_them(a integer, b integer)
+returns integer as $$
+  select a + b;
+$$ language sql;
+
+create function root() returns jsonb as $_$
+declare
+openapi jsonb = $$
+  {
+    "swagger": "2.0",
+    "info":{
+      "title":"PostgREST API",
+      "description":"This is a dynamic API generated by PostgREST"
+    }
+  }
+$$;
+simple jsonb = $$
+  [
+    {
+      "table":"items"
+    },
+    {
+      "table":"subitems"
+    }
+  ]
+$$;
+begin
+case current_setting('request.header.accept', true)
+  when 'application/openapi+json' then
+    return openapi;
+  when 'application/json' then
+    return simple;
+  else
+    return openapi;
+  end case;
+end
+$_$ language plpgsql;
+
+create or replace function welcome() returns text as $$
+select 'Welcome to PostgREST'::text;
+$$ language sql;
+
+create or replace function "welcome.html"() returns text as $_$
+select $$
+<html>
+  <head>
+    <title>PostgREST</title>
+  </head>
+  <body>
+    <h1>Welcome to PostgREST</h1>
+  </body>
+</html>
+$$::text;
+$_$ language sql;

test/io-tests.sh

@@ -74,7 +74,7 @@ readSecretFromFile(){
     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"
@@ -82,6 +82,24 @@ 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"
@@ -95,9 +113,9 @@ reqWithRoleClaimKey(){
   httpStatus="$( authorsStatus "$authorsJwt" )"
   if test "$httpStatus" -eq $3
   then
-    ok "request with \"$1\" role-claim-key for $2 jwt gave $3"
+    ok "request with \"$1\" role-claim-key for $2 jwt: $httpStatus"
   else
-    ko "request with \"$1\" role-claim-key for $2 jwt gave $httpStatus"
+    ko "request with \"$1\" role-claim-key for $2 jwt: $httpStatus"
   fi
   pgrStop
 }
@@ -113,9 +131,76 @@ invalidRoleClaimKey(){
   done
   if pgrStarted
   then
-    ko "invalid jspath \"$1\" accepted"
+    ko "invalid jspath \"$1\": accepted"
   else
-    ok "invalid jspath \"$1\" rejected"
+    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
 }
@@ -130,6 +215,8 @@ setUp
 
 echo "Running IO tests.."
 
+socketConnection
+
 readSecretFromFile word.noeol 'simple (no EOL)'
 readSecretFromFile word.txt 'simple'
 readSecretFromFile ascii.noeol 'ASCII (no EOL)'
@@ -144,6 +231,9 @@ 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
@@ -157,6 +247,10 @@ 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

@@ -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
 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)

test/io-tests/configs/simple.config

@@ -0,0 +1,7 @@
+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
+jwt-secret = "reallyreallyreallyreallyverysafe"

test/io-tests/configs/unix-socket.config

@@ -0,0 +1,7 @@
+db-uri = "postgres:///postgrest_test"
+db-schema = "test"
+db-anon-role = "postgrest_test_anonymous"
+db-pool = 1
+server-host = "127.0.0.1"
+server-unix-socket = "/tmp/postgrest.sock"
+jwt-secret = "reallyreallyreallyreallyverysafe"

test/io-tests/dburis/uri.noeol

@@ -0,0 +1 @@
+postgres:///postgrest_test

test/io-tests/dburis/uri.txt

@@ -0,0 +1 @@
+postgres:///postgrest_test

test/memory-tests.sh

@@ -1,4 +1,4 @@
-#!/bin/bash
+#! /usr/bin/env bash
 currentTest=1
 failedTests=0
 result(){ echo "$1 $currentTest $2"; currentTest=$(( $currentTest + 1 )); }
@@ -7,9 +7,9 @@ ko(){ result 'not ok' "- $1"; failedTests=$(( $failedTests + 1 )); }
 
 pgrPort=49421
 
-pgrStopAll(){ pkill -f "$(stack path --local-install-root)/bin/postgrest"; }
+pgrStopAll(){ pkill -f "$(stack path --profile --local-install-root)/bin/postgrest"; }
 
-pgrStart(){ stack exec -- postgrest test/memory-tests/config +RTS -p -h >/dev/null & pgrPID="$!"; }
+pgrStart(){ stack exec --profile -- postgrest test/memory-tests/config +RTS -p -h >/dev/null & pgrPID="$!"; }
 pgrStop(){ kill "$pgrPID" 2>/dev/null; }
 
 setUp(){ pgrStopAll; }
@@ -90,27 +90,25 @@ postJsonArrayTest(){
   fi
 }
 
-stack build --profile
-
 setUp
 
 echo "Running memory usage tests.."
 
-jsonKeyTest "1M" "POST" "/rpc/leak" "15M"
-jsonKeyTest "1M" "POST" "/leak" "15M"
-jsonKeyTest "1M" "PATCH" "/leak?id=eq.1" "15M"
+jsonKeyTest "1M" "POST" "/rpc/leak?columns=blob" "12M"
+jsonKeyTest "1M" "POST" "/leak?columns=blob" "12M"
+jsonKeyTest "1M" "PATCH" "/leak?id=eq.1&columns=blob" "12M"
 
-jsonKeyTest "10M" "POST" "/rpc/leak" "105M"
-jsonKeyTest "10M" "POST" "/leak" "105M"
-jsonKeyTest "10M" "PATCH" "/leak?id=eq.1" "105M"
+jsonKeyTest "10M" "POST" "/rpc/leak?columns=blob" "40M"
+jsonKeyTest "10M" "POST" "/leak?columns=blob" "40M"
+jsonKeyTest "10M" "PATCH" "/leak?id=eq.1&columns=blob" "40M"
 
-jsonKeyTest "100M" "POST" "/rpc/leak" "895M"
-jsonKeyTest "100M" "POST" "/leak" "895M"
-jsonKeyTest "100M" "PATCH" "/leak?id=eq.1" "895M"
+jsonKeyTest "50M" "POST" "/rpc/leak?columns=blob" "170M"
+jsonKeyTest "50M" "POST" "/leak?columns=blob" "170M"
+jsonKeyTest "50M" "PATCH" "/leak?id=eq.1&columns=blob" "170M"
 
-postJsonArrayTest "1000" "/perf_articles" "20M"
-postJsonArrayTest "10000" "/perf_articles" "120M"
-postJsonArrayTest "100000" "/perf_articles" "1.15G"
+postJsonArrayTest "1000" "/perf_articles?columns=id,body" "10M"
+postJsonArrayTest "10000" "/perf_articles?columns=id,body" "10M"
+postJsonArrayTest "100000" "/perf_articles?columns=id,body" "20M"
 
 cleanUp
 

test/memory-tests/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
 
 jwt-secret = "reallyreallyreallyreallyverysafe"