Bump to 0.4.4.0

Also trim trailing whitespace

.circleci/config.yml

@@ -0,0 +1,235 @@
+version: 2
+
+build-distro-bin: &build-distro-bin
+  machine: true
+  steps:
+    - checkout
+    # cannot interpolate env var and use as a cache key so just copy the Dockerfile to another filename
+    - run: cp docker/distro_release/Dockerfile.$CIRCLE_JOB docker/distro_release/Dockerfile
+    - restore_cache:
+        keys:
+        - v1-{{ .Environment.CIRCLE_JOB }}-image-{{ checksum "docker/distro_release/Dockerfile" }}
+    - restore_cache:
+        keys:
+        - v1-{{ .Environment.CIRCLE_JOB }}-dependencies-{{ checksum "postgrest.cabal" }}-{{ checksum "stack.yaml" }}
+    - run:
+        name: load or build docker image
+        command: |
+          if [[ -e ~/image.tar ]]; then
+            docker load -i ~/image.tar
+          else
+            docker build --rm=false -t $CIRCLE_JOB -f docker/distro_release/Dockerfile.$CIRCLE_JOB docker/distro_release/
+            docker save $CIRCLE_JOB > ~/image.tar
+          fi
+    - run:
+        name: build binary
+        command: |
+          docker run -it \
+            -v $HOME/.stack:/root/.stack \
+            -v $(pwd):/source \
+            -v $HOME/bin/:/root/.local/bin/ \
+            $CIRCLE_JOB build --allow-different-user --install-ghc --copy-bins
+          # volumes owned by root if chown is not done the save_cache step fails silently
+          sudo chown -R circleci:circleci ~/.stack .stack-work
+    - run:
+        name: compress binary
+        command: |
+          mkdir -p /tmp/workspace/bin
+          cd /tmp/workspace/bin
+          tar cvJf postgrest-$CIRCLE_TAG-$CIRCLE_JOB.tar.xz -C ~/bin postgrest
+    - persist_to_workspace:
+        root: /tmp/workspace
+        paths:
+          - bin/*
+    - save_cache:
+        paths:
+          - ~/image.tar
+        key: v1-{{ .Environment.CIRCLE_JOB }}-image-{{ checksum "docker/distro_release/Dockerfile" }}
+    - save_cache:
+        paths:
+          - "~/.stack"
+          - ".stack-work"
+        key: v1-{{ .Environment.CIRCLE_JOB }}-dependencies-{{ checksum "postgrest.cabal" }}-{{ checksum "stack.yaml" }}
+
+jobs:
+  build-test:
+    docker:
+      - image: circleci/buildpack-deps:trusty
+        environment:
+          - PGHOST=localhost
+      - image: circleci/postgres:9.4.14
+        environment:
+          - POSTGRES_USER=circleci
+          - POSTGRES_DB=circleci
+    steps:
+      - checkout
+      - restore_cache:
+          keys:
+          - v1-stack-dependencies-{{ checksum "postgrest.cabal" }}-{{ checksum "stack.yaml" }}
+      - run:
+          name: install 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
+            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
+      - 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
+            test/io-tests.sh
+      - run:
+          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" }}
+
+  build-test-9.6:
+    docker:
+      - image: circleci/buildpack-deps:trusty
+        environment:
+          - PGHOST=localhost
+      - image: circleci/postgres:9.6.2
+        environment:
+          - POSTGRES_USER=circleci
+          - POSTGRES_DB=circleci
+    steps:
+      - checkout
+      - restore_cache:
+          keys:
+          - v1-stack-dependencies-{{ checksum "postgrest.cabal" }}-{{ checksum "stack.yaml" }}
+      - run:
+          name: install stack & dependencies
+          command: |
+            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
+            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
+
+  centos6:
+    <<: *build-distro-bin
+
+  centos7:
+    <<: *build-distro-bin
+
+  ubuntu:
+    <<: *build-distro-bin
+
+  ubuntui386:
+    <<: *build-distro-bin
+
+  release:
+    docker:
+      - image: circleci/golang:1.8
+    steps:
+      - attach_workspace:
+          at: /tmp/workspace
+      - checkout
+      - run:
+          name: add body and tars to github release
+          command: |
+            go get -u github.com/tcnksm/ghr
+            START=$(echo $CIRCLE_TAG | cut -c2-)
+            END='## \['
+            BODY=$(sed -n "1,/$START/d;/$END/q;p" CHANGELOG.md)
+            ghr -t $GITHUB_TOKEN -u $CIRCLE_PROJECT_USERNAME -r $CIRCLE_PROJECT_REPONAME -b "$BODY" --replace $CIRCLE_TAG /tmp/workspace/bin
+      - setup_remote_docker
+      - run:
+          name: publish docker image
+          command: |
+            docker build --build-arg POSTGREST_VERSION=$CIRCLE_TAG -t postgrest ./docker/
+            docker login -u $DOCKER_USER -p $DOCKER_PASS
+            docker tag postgrest postgrest/postgrest:$CIRCLE_TAG
+            docker push postgrest/postgrest:$CIRCLE_TAG
+            docker tag postgrest postgrest/postgrest:latest
+            docker push postgrest/postgrest:latest
+
+workflows:
+  version: 2
+  build-test-release:
+    jobs:
+      - build-test:
+          filters:
+            tags:
+              only: /v[0-9]+(\.[0-9]+)*/
+      - build-test-9.6:
+          filters:
+            tags:
+              only: /v[0-9]+(\.[0-9]+)*/
+      - centos6:
+          requires:
+            - build-test
+            - build-test-9.6
+          filters:
+            tags:
+              only: /v[0-9]+(\.[0-9]+)*/
+            branches:
+              ignore: /.*/
+      - centos7:
+          requires:
+            - build-test
+            - build-test-9.6
+          filters:
+            tags:
+              only: /v[0-9]+(\.[0-9]+)*/
+            branches:
+              ignore: /.*/
+      - ubuntu:
+          requires:
+            - build-test
+            - build-test-9.6
+          filters:
+            tags:
+              only: /v[0-9]+(\.[0-9]+)*/
+            branches:
+              ignore: /.*/
+      - ubuntui386:
+          requires:
+            - build-test
+            - build-test-9.6
+          filters:
+            tags:
+              only: /v[0-9]+(\.[0-9]+)*/
+            branches:
+              ignore: /.*/
+      - release:
+          requires:
+            - centos6
+            - centos7
+            - ubuntu
+            - ubuntui386
+          filters:
+            tags:
+              only: /v[0-9]+(\.[0-9]+)*/

.gitattributes

@@ -0,0 +1 @@
+/CHANGELOG.md merge=union

.stylish-haskell.yaml

@@ -0,0 +1,190 @@
+# stylish-haskell configuration file
+# ==================================
+
+# The stylish-haskell tool is mainly configured by specifying steps. These steps
+# are a list, so they have an order, and one specific step may appear more than
+# once (if needed). Each file is processed by these steps in the given order.
+steps:
+  # Convert some ASCII sequences to their Unicode equivalents. This is disabled
+  # by default.
+  # - unicode_syntax:
+  #     # In order to make this work, we also need to insert the UnicodeSyntax
+  #     # language pragma. If this flag is set to true, we insert it when it's
+  #     # not already present. You may want to disable it if you configure
+  #     # language extensions using some other method than pragmas. Default:
+  #     # true.
+  #     add_language_pragma: true
+
+  # Align the right hand side of some elements.  This is quite conservative
+  # and only applies to statements where each element occupies a single
+  # line.
+  - simple_align:
+      cases: true
+      top_level_patterns: true
+      records: true
+
+  # Import cleanup
+  - imports:
+      # There are different ways we can align names and lists.
+      #
+      # - global: Align the import names and import list throughout the entire
+      #   file.
+      #
+      # - file: Like global, but don't add padding when there are no qualified
+      #   imports in the file.
+      #
+      # - group: Only align the imports per group (a group is formed by adjacent
+      #   import lines).
+      #
+      # - none: Do not perform any alignment.
+      #
+      # Default: global.
+      align: global
+
+      # Folowing options affect only import list alignment.
+      #
+      # List align has following options:
+      #
+      # - after_alias: Import list is aligned with end of import including
+      #   'as' and 'hiding' keywords.
+      #
+      #   > import qualified Data.List      as List (concat, foldl, foldr, head,
+      #   >                                          init, last, length)
+      #
+      # - with_alias: Import list is aligned with start of alias or hiding.
+      #
+      #   > import qualified Data.List      as List (concat, foldl, foldr, head,
+      #   >                                 init, last, length)
+      #
+      # - new_line: Import list starts always on new line.
+      #
+      #   > import qualified Data.List      as List
+      #   >     (concat, foldl, foldr, head, init, last, length)
+      #
+      # Default: after_alias
+      list_align: after_alias
+
+      # Long list align style takes effect when import is too long. This is
+      # determined by 'columns' setting.
+      #
+      # - inline: This option will put as much specs on same line as possible.
+      #
+      # - new_line: Import list will start on new line.
+      #
+      # - new_line_multiline: Import list will start on new line when it's
+      #   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.
+      #
+      #   > import qualified Data.Map as M
+      #   >     ( empty
+      #   >     , singleton
+      #   >     , ...
+      #   >     , delete
+      #   >     )
+      #
+      # Default: inline
+      long_list_align: inline
+
+      # Align empty list (importing instances)
+      #
+      # Empty list align has following options
+      #
+      # - inherit: inherit list_align setting
+      #
+      # - right_after: () is right after the module name:
+      #
+      #   > import Vector.Instances ()
+      #
+      # Default: inherit
+      empty_list_align: inherit
+
+      # List padding determines indentation of import list on lines after import.
+      # This option affects 'long_list_align'.
+      #
+      # - <integer>: constant value
+      #
+      # - module_name: align under start of module name.
+      #   Useful for 'file' and 'group' align settings.
+      list_padding: 4
+
+      # Separate lists option affects formating of import list for type
+      # or class. The only difference is single space between type and list
+      # of constructors, selectors and class functions.
+      #
+      # - true: There is single space between Foldable type and list of it's
+      #   functions.
+      #
+      #   > import Data.Foldable (Foldable (fold, foldl, foldMap))
+      #
+      # - false: There is no space between Foldable type and list of it's
+      #   functions.
+      #
+      #   > import Data.Foldable (Foldable(fold, foldl, foldMap))
+      #
+      # Default: true
+      separate_lists: true
+
+  # Language pragmas
+  - language_pragmas:
+      # We can generate different styles of language pragma lists.
+      #
+      # - vertical: Vertical-spaced language pragmas, one per line.
+      #
+      # - compact: A more compact style.
+      #
+      # - compact_line: Similar to compact, but wrap each line with
+      #   `{-#LANGUAGE #-}'.
+      #
+      # Default: vertical.
+      style: vertical
+
+      # Align affects alignment of closing pragma brackets.
+      #
+      # - true: Brackets are aligned in same collumn.
+      #
+      # - false: Brackets are not aligned together. There is only one space
+      #   between actual import and closing bracket.
+      #
+      # Default: true
+      align: true
+
+      # stylish-haskell can detect redundancy of some language pragmas. If this
+      # is set to true, it will remove those redundant pragmas. Default: true.
+      remove_redundant: true
+
+  # Replace tabs by spaces. This is disabled by default.
+  # - tabs:
+  #     # Number of spaces to use for each tab. Default: 8, as specified by the
+  #     # Haskell report.
+  #     spaces: 8
+
+  # Remove trailing whitespace
+  - trailing_whitespace: {}
+
+# A common setting is the number of columns (parts of) code will be wrapped
+# to. Different steps take this into account. Default: 80.
+columns: 70
+
+# By default, line endings are converted according to the OS. You can override
+# preferred format here.
+#
+# - native: Native newline format. CRLF on Windows, LF on other OSes.
+#
+# - lf: Convert to LF ("\n").
+#
+# - crlf: Convert to CRLF ("\r\n").
+#
+# Default: native.
+newline: native
+
+# Sometimes, language extensions are specified in a cabal file or from the
+# command line instead of using language pragmas in the file. stylish-haskell
+# needs to be aware of these, so it can parse the file correctly.
+#
+# No language extensions are enabled by default.
+language_extensions:
+  - TemplateHaskell
+  - QuasiQuotes
+  - CPP

.travis.yml

@@ -0,0 +1,64 @@
+language: generic
+
+sudo: false
+
+os:
+- osx
+
+cache:
+  timeout: 1000
+  directories:
+    - $HOME/.stack
+    - $HOME/.local/bin
+
+before_install:
+- mkdir -p "$HOME/.local/bin"
+- export PATH="$PATH:$HOME/.local/bin"
+
+install:
+- |
+  if test -f "$HOME/.local/bin/stack"
+    then
+      echo 'Stack is already installed.'
+    else
+      echo "Installing Stack..."
+      travis_retry curl -L https://www.stackage.org/stack/osx-x86_64 > stack.tar.gz
+      gunzip stack.tar.gz
+      tar -x -f stack.tar --strip-components 1
+      mv stack "$HOME/.local/bin/"
+      rm stack.tar
+  fi
+- |
+  if test -f "$HOME/.local/bin/ghr"
+  then
+    echo 'ghr is already installed.'
+  else
+    echo "Installing ghr..."
+    travis_retry curl -L https://github.com/tcnksm/ghr/releases/download/v0.5.4/ghr_v0.5.4_darwin_386.zip > ghr.zip
+    unzip ghr.zip -d "$HOME/.local/bin"
+    rm ghr.zip
+  fi
+
+script:
+- gtimeout 1800 stack build --no-terminal --only-snapshot --install-ghc || true
+- |
+  if test ! "$TRAVIS_TAG"
+  then
+    echo 'No tag pushed. Skipping build.'
+  else
+    stack build --no-terminal --copy-bins --local-bin-path .
+  fi
+- |
+  if test ! "$TRAVIS_TAG"
+  then
+    echo 'No tag pushed. Skipping release.'
+  else
+    OWNER="$(echo "$TRAVIS_REPO_SLUG" | cut -f1 -d/)"
+    REPO="$(echo "$TRAVIS_REPO_SLUG" | cut -f2 -d/)"
+    START=$(echo $TRAVIS_TAG | cut -c2-)
+    END='## \['
+    BODY=$(sed -n "1,/$START/d;/$END/q;p" CHANGELOG.md)
+    strip postgrest
+    tar cjf postgrest-$TRAVIS_TAG-osx.tar.xz postgrest
+    ghr -t $GITHUB_TOKEN -u $OWNER -r $REPO -b "$BODY"--replace $TRAVIS_TAG postgrest-$TRAVIS_TAG-osx.tar.xz
+  fi

CHANGELOG.md

@@ -9,6 +9,86 @@ This project adheres to [Semantic Versioning](http://semver.org/).
 
 ### Fixed
 
+## [0.4.4.0] - 2018-01-08
+
+### Added
+
+- #887, #601, #1007, Allow specifying dictionary and plain/phrase tsquery in full text search - @steve-chavez
+- #328, Allow doing GET on rpc - @steve-chavez
+- #917, Add ability to map RAISE errorcode/message to http status - @steve-chavez
+- #940, Add ability to map GUC to http response headers - @steve-chavez
+- #1022, Include git sha in version report - @begriffs
+- Faster queries using json_agg - @ruslantalpa
+
+### Fixed
+
+- #876, Read secret files as binary, discard final LF if any - @eric-brechemier
+- #968, Treat blank proxy uri as missing - @begriffs
+- #933, OpenAPI externals docs url to current version - @steve-chavez
+- #962, OpenAPI don't err on nonexistent schema - @steve-chavez
+- #954, make OpenAPI rpc output dependent on user privileges - @steve-chavez
+- #955, Support configurable aud claim - @statik
+- #996, Fix embedded column conflicts table name - @grotsev
+- #974, Fix RPC error when function has single OUT param - @steve-chavez
+- #1021, Reduce join size in allColumns for faster program start - @nextstopsun
+- #411, Remove the need for pk in &select for parent embed - @steve-chavez
+- #1016, Fix anonymous requests when configured with jwt-aud - @ruslantalpa
+
+## [0.4.3.0] - 2017-09-06
+
+### Added
+
+- #567, Support more JWT signing algorithms, including RSA - @begriffs
+- #889, Allow more than two conditions in a single and/or - @steve-chavez
+- #883, Binary output support for RPC - @steve-chavez
+- #885, Postgres COMMENTs on SCHEMA/TABLE/COLUMN are used for OpenAPI - @ldesgoui
+- #907, Ability to embed using a specific relation when there are multiple between tables - @ruslantalpa
+- #930, Split table comment on newline to get OpenAPI operation summary and description - @daurnimator
+- #938, Support for range operators - @russelldavies
+
+### Fixed
+
+- #877, Base64 secret read from a file ending with a newline - @eric-brechemier
+- #896, Boolean env var interpolation in config file - @begriffs
+- #885, OpenAPI repetition reduced by using more definitions- @ldesgoui
+- #924, Improve relations initialization time - @9too
+- #927, Treat blank pre-request as missing - @begriffs
+
+### Changed
+
+- #938, Deprecate symbol operators with mnemonic names. - @russelldavies
+
+## [0.4.2.0] - 2017-06-11
+
+### Added
+
+- #742, Add connection retrying on startup and SIGHUP - @steve-chavez
+- #652, Add and/or params for complex boolean logic - @steve-chavez
+- #808, Env var interpolation in config file (helps Docker) - @begriffs
+- #878 - CSV output support for RPC - @begriffs
+
+### Fixed
+
+- #822, Treat blank string JWT secret as no secret - @begriffs
+
+## [0.4.1.0] - 2017-04-25
+
+### Added
+- Allow requesting binary output on GET - @steve-chavez
+- Accept clients requesting `Content-Type: application/json` from / - @feynmanliang
+- #493, Updating with empty JSON object makes zero updates @koulakis
+- Make HTTP headers and cookies available as GUCs #800 - @ruslantalpa
+- #701, Ability to quote values on IN filters - @steve-chavez
+- #641, Allow IN filter to have no values - @steve-chavez
+
+### Fixed
+- #827, Avoid Warp reaper, extend socket timeout to 1 hour - @majorcode
+- #791, malformed nested JSON error - @diogob
+- Resource embedding in views referencing tables in public schema - @fab1an
+- #777, Empty body is allowed when calling a non-parameterized RPC - @koulakis
+- #831, Fix proc resource embedding issue with search_path - @steve-chavez
+- #547, Use read-only transaction for stable/immutable RPC - @begriffs
+
 ## [0.4.0.0] - 2017-01-19
 
 ### Added

CONTRIBUTING.md

@@ -48,7 +48,7 @@ your contributions.
   pull request.
 
 * For help building the Haskell code on your computer check out the [building from
-source](http://postgrest.com/install/server/#building-from-source)
+source](https://postgrest.com/en/stable/install.html#build-from-source)
 wiki page.
 
 ## Maintenance
@@ -61,3 +61,9 @@ my other obligations.  If you don't get a response right away
 don't worry, I will definitely get to it. Also you can join the
 Gitter [chat room](https://gitter.im/begriffs/postgrest) to
 discuss issues you are having.
+
+## Running Tests
+
+For instructions on running tests, see the official docs hosted here:
+
+https://postgrest.com/en/stable/install.html#postgrest-test-suite

Dockerfile

@@ -1,18 +0,0 @@
-FROM debian:jessie
-
-ENV POSTGREST_VERSION 0.4.0.0
-
-RUN apt-get update && \
-    apt-get install -y tar xz-utils wget libpq-dev && \
-    apt-get clean && rm -rf /var/lib/apt/lists/* /tmp/* /var/tmp/*
-
-RUN wget http://github.com/begriffs/postgrest/releases/download/v${POSTGREST_VERSION}/postgrest-${POSTGREST_VERSION}-ubuntu.tar.xz && \
-    tar --xz -xvf postgrest-${POSTGREST_VERSION}-ubuntu.tar.xz && \
-    mv postgrest /usr/local/bin/postgrest && \
-    rm postgrest-${POSTGREST_VERSION}-ubuntu.tar.xz
-
-# PostgREST reads /etc/postgrest.conf so map the configuration
-# file in when you run this container
-CMD exec postgrest
-
-EXPOSE 3000

README.md

@@ -5,23 +5,13 @@
   <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)](https://postgrest.com)
+[![Docs](https://img.shields.io/badge/docs-latest-brightgreen.svg?style=flat)](http://postgrest.com)
+[![Docker Stars](https://img.shields.io/docker/pulls/postgrest/postgrest.svg)](https://hub.docker.com/r/postgrest/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.
 
-Try making requests to the live [demo
-server](https://postgrest.herokuapp.com) with an HTTP client such
-as [postman](http://www.getpostman.com/). The structure of the demo
-database is defined by
-[begriffs/postgrest-example](https://github.com/begriffs/postgrest-example).
-You can use it as inspiration for test-driven server migrations in
-your own projects.
-
-Also try other tools in the PostgREST
-[ecosystem](http://postgrest.com/en/v0.4/intro.html#ecosystem).
-
 ### Usage
 
 1. Download the binary ([latest release](https://github.com/begriffs/postgrest/releases/latest))
@@ -66,7 +56,7 @@ Other optimizations are possible, and some are outlined in the
 ### Security
 
 PostgREST [handles
-authentication](http://postgrest.com/en/v0.4/auth.html) (via JSON Web
+authentication](http://postgrest.com/en/stable/auth.html) (via JSON Web
 Tokens) and delegates authorization to the role information defined in
 the database. This ensures there is a single declarative source of truth
 for security.  When dealing with the database the server assumes the
@@ -112,11 +102,11 @@ directly into your database. Hence no application can corrupt your
 data (including your API server).
 
 The PostgREST exposes HTTP interface with safeguards to prevent
-surprises, such as enforcing idempotent PUT requests, and
+surprises, such as enforcing idempotent PUT requests.
 
 See examples of [PostgreSQL
 constraints](http://www.tutorialspoint.com/postgresql/postgresql_constraints.htm)
-and the [API guide](http://postgrest.com/en/v0.4/api.html).
+and the [API guide](http://postgrest.com/en/stable/api.html).
 
 ### Thanks
 

app.json

@@ -10,47 +10,50 @@
     },
     "POSTGREST_VER": {
       "description": "Version of PostgREST to deploy",
-      "value": "0.4.0.0"
+      "value": "0.4.4.0"
     },
-    "DB_NAME": {
-      "description": "Database name",
+    "DB_URI": {
+      "description": "Database connection string",
       "required": true
     },
-    "AUTH_ROLE": {
-      "description": "Database role to use checking client authentication",
+    "DB_SCHEMA": {
+      "description": "The database schema to expose to REST clients. Tables, views and stored procedures in this schema will get API endpoints",
+      "required": true,
+      "value": "public"
+    },
+    "DB_ANON_ROLE": {
+      "description": "The database role to use when executing commands on behalf of unauthenticated clients",
       "required": true
     },
-    "AUTH_PASS": {
-      "description": "Authentication password",
-      "required": false
-    },
-    "ANONYMOUS_ROLE": {
-      "description": "Database role for non-authenticated requests",
-      "required": true
-    },
-    "DB_HOST": {
-      "description": "Database server hostname",
-      "required": true
-    },
-    "DB_PORT": {
-      "description": "Database server port",
-      "required": false,
-      "value": "5432"
-    },
     "DB_POOL": {
-      "description": "Maximum number of connections in database pool",
+      "description": "Number of connections to keep open in PostgREST’s database pool",
       "required": false,
       "value": "10"
     },
-    "JWT_SECRET": {
-      "description": "Secret used to encrypt JSON Web Tokens",
-      "required": false,
-      "value": "secret"
+    "SERVER_PROXY_URI": {
+      "description": "Overrides the base URL used within the OpenAPI self-documentation hosted at the API root path",
+      "required": false
     },
-    "SCHEMA": {
-      "description": "DB schema to be exported",
+    "JWT_SECRET": {
+      "description": "The secret used to decode JWT tokens clients provide for authentication",
+      "required": false
+    },
+    "SECRET_IS_BASE64": {
+      "description": "When this is set to true, the value derived from jwt-secret will be treated as a base64 encoded secret",
       "required": false,
-      "value": "1"
+      "value": "false"
+    },
+    "JWT_AUD": {
+      "description": "The audience that should be validated if the JWT token contains an aud claim",
+      "required": false
+    },
+    "MAX_ROWS": {
+      "description": "A hard limit to the number of rows PostgREST will fetch from a view, table, or stored procedure",
+      "required": false
+    },
+    "PRE_REQUEST": {
+      "description": "A schema-qualified stored procedure name to call right after switching roles for a client request",
+      "required": false
     }
   }
 }

appveyor.yml

@@ -0,0 +1,38 @@
+platform: x64
+
+cache:
+- "c:\\sr"
+- .stack-work
+
+environment:
+  global:
+    STACK_ROOT: "c:\\sr"
+    GOPATH: c:\gopath
+
+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
+- 7z x stack.zip stack.exe
+- set PATH=%GOPATH%\bin;c:\go\bin;%PATH%
+- go get -u github.com/tcnksm/ghr
+
+build_script:
+- stack setup --no-terminal > nul
+- stack build --copy-bins --local-bin-path .
+
+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"

circle.yml

@@ -1,25 +0,0 @@
-dependencies:
-  cache_directories:
-    - "~/.stack"
-    - ".stack-work"
-  pre:
-    - 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
-    - sudo apt-get update; sudo apt-get install --only-upgrade binutils
-  override:
-    - stack setup
-    - rm -fr $(stack path --dist-dir) $(stack path --local-install-root)
-    - stack install hlint packdeps cabal-install
-    - stack build --fast
-    - stack build --fast --test --no-run-tests
-
-test:
-  override:
-    - POSTGREST_TEST_CONNECTION=$(test/create_test_db "postgres://ubuntu@localhost" postgrest_test) stack test --test-arguments "--skip \"returns a valid openapi\""
-    - git ls-files | grep '\.l\?hs$' | xargs stack exec -- hlint -X QuasiQuotes -X NoPatternSynonyms "$@"
-    - 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

docker/Dockerfile

@@ -0,0 +1,44 @@
+FROM debian:jessie
+
+ARG POSTGREST_VERSION
+
+# Install libpq5
+RUN apt-get -qq update && \
+    apt-get -qq install -y --no-install-recommends libpq5 && \
+    apt-get -qq clean && \
+    rm -rf /var/lib/apt/lists/* /tmp/* /var/tmp/*
+
+# Install postgrest
+RUN BUILD_DEPS="curl ca-certificates xz-utils" && \
+    apt-get -qq update && \
+    apt-get -qq install -y --no-install-recommends $BUILD_DEPS && \
+    cd /tmp && \
+    curl -SLO https://github.com/begriffs/postgrest/releases/download/${POSTGREST_VERSION}/postgrest-${POSTGREST_VERSION}-ubuntu.tar.xz && \
+    tar -xJvf postgrest-${POSTGREST_VERSION}-ubuntu.tar.xz && \
+    mv postgrest /usr/local/bin/postgrest && \
+    cd / && \
+    apt-get -qq purge --auto-remove -y $BUILD_DEPS && \
+    apt-get -qq clean && \
+    rm -rf /var/lib/apt/lists/* /tmp/* /var/tmp/*
+
+COPY postgrest.conf /etc/postgrest.conf
+
+
+ENV PGRST_DB_URI= \
+    PGRST_DB_SCHEMA=public \
+    PGRST_DB_ANON_ROLE= \
+    PGRST_DB_POOL=100 \
+    PGRST_SERVER_HOST=*4 \
+    PGRST_SERVER_PORT=3000 \
+    PGRST_SERVER_PROXY_URI= \
+    PGRST_JWT_SECRET= \
+    PGRST_SECRET_IS_BASE64=false \
+    PGRST_JWT_AUD= \
+    PGRST_MAX_ROWS= \
+    PGRST_PRE_REQUEST=
+
+# PostgREST reads /etc/postgrest.conf so map the configuration
+# file in when you run this container
+CMD exec postgrest /etc/postgrest.conf
+
+EXPOSE 3000

docker/config.conf

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

docker/distro_release/Dockerfile.centos6

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

@@ -0,0 +1,18 @@
+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 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.ubuntu

@@ -0,0 +1,18 @@
+FROM ubuntu:16.04
+
+RUN BUILD_DEPS="curl ca-certificates build-essential" && \
+    apt-get -qq update && \
+    apt-get -qqy --no-install-recommends install \
+    $BUILD_DEPS \
+    libpq-dev && \
+    curl -sSL https://get.haskellstack.org/ | sh && \
+    apt-get -qq clean && \
+    rm -rf /var/lib/apt/lists/* /tmp/* /var/tmp/*
+
+# To disable warning when building
+ENV PATH $PATH:/root/.local/bin
+
+RUN mkdir /source
+WORKDIR /source
+
+ENTRYPOINT ["stack"]

docker/distro_release/Dockerfile.ubuntui386

@@ -0,0 +1,18 @@
+FROM 32bit/ubuntu:16.04
+
+RUN BUILD_DEPS="curl ca-certificates build-essential" && \
+    apt-get -qq update && \
+    apt-get -qqy --no-install-recommends install \
+    $BUILD_DEPS \
+    libpq-dev && \
+    curl -sSL https://get.haskellstack.org/ | sh && \
+    apt-get -qq clean && \
+    rm -rf /var/lib/apt/lists/* /tmp/* /var/tmp/*
+
+# To disable warning when building
+ENV PATH $PATH:/root/.local/bin
+
+RUN mkdir /source
+WORKDIR /source
+
+ENTRYPOINT ["stack"]

docker/docker-compose.yml

@@ -0,0 +1,19 @@
+stgrest:
+  image: pg_local
+  ports:
+    - "3000:3000"
+  links:
+    - postgres:postgres
+  environment:
+    PGRST_DB_URI: postgres://app_user:password@postgres:5432/app_db
+    PGRST_DB_SCHEMA: public
+    PGRST_DB_ANON_ROLE: app_user
+
+postgres:
+  image: postgres
+  ports:
+    - "5432:5432"
+  environment:
+    POSTGRES_DB: app_db
+    POSTGRES_USER: app_user
+    POSTGRES_PASSWORD: password

docker/postgrest.conf

@@ -0,0 +1,15 @@
+db-uri = "$(PGRST_DB_URI)"
+db-schema = "$(PGRST_DB_SCHEMA)"
+db-anon-role = "$(PGRST_DB_ANON_ROLE)"
+db-pool = "$(PGRST_DB_POOL)"
+
+server-host = "$(PGRST_SERVER_HOST)"
+server-port = "$(PGRST_SERVER_PORT)"
+
+server-proxy-uri = "$(PGRST_SERVER_PROXY_URI)"
+jwt-secret = "$(PGRST_JWT_SECRET)"
+secret-is-base64 = "$(PGRST_SECRET_IS_BASE64)"
+jwt-aud = "$(PGRST_JWT_AUD)"
+
+max-rows = "$(PGRST_MAX_ROWS)"
+pre-request = "$(PGRST_PRE_REQUEST)"

main/Main.hs

@@ -2,126 +2,266 @@
 
 module Main where
 
-import           Protolude
-import           PostgREST.App
-import           PostgREST.Config                     (AppConfig (..),
-                                                       PgVersion (..),
-                                                       minimumPgVersion,
-                                                       prettyVersion,
-                                                       readOptions)
-import           PostgREST.Error                      (prettyUsageError)
-import           PostgREST.OpenAPI                    (isMalformedProxyUri)
-import           PostgREST.DbStructure
 
-import           Control.AutoUpdate
-import           Data.ByteString.Base64               (decode)
-import           Data.String                          (IsString (..))
-import           Data.Text                            (stripPrefix, pack, replace)
-import           Data.Text.Encoding                   (encodeUtf8, decodeUtf8)
-import           Data.Text.IO                         (hPutStrLn, readFile)
-import           Data.Function                        (id)
-import           Data.Time.Clock.POSIX                (getPOSIXTime)
-import qualified Hasql.Query                          as H
-import qualified Hasql.Session                        as H
-import qualified Hasql.Decoders                       as HD
-import qualified Hasql.Encoders                       as HE
-import qualified Hasql.Pool                           as P
-import           Network.Wai.Handler.Warp
-import           System.IO                            (BufferMode (..),
-                                                       hSetBuffering)
-import           Data.IORef
+import           PostgREST.App            (postgrest)
+import           PostgREST.Config         (AppConfig (..),
+                                           minimumPgVersion,
+                                           prettyVersion, readOptions)
+import           PostgREST.DbStructure    (getDbStructure, getPgVersion)
+import           PostgREST.Error          (encodeError)
+import           PostgREST.OpenAPI        (isMalformedProxyUri)
+import           PostgREST.Types          (DbStructure, Schema, PgVersion(..))
+import           Protolude                hiding (hPutStrLn, replace)
+
+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 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
 #endif
 
-isServerVersionSupported :: H.Session Bool
-isServerVersionSupported = do
-  ver <- H.query () pgVersion
-  return $ ver >= pgvNum minimumPgVersion
- where
-  pgVersion =
-    H.statement "SELECT current_setting('server_version_num')::integer"
-      HE.unit (HD.singleRow $ HD.value HD.int4) False
+{-|
+  The purpose of this worker is to fill the refDbStructure created in 'main'
+  with the 'DbStructure' returned from calling 'getDbStructure'. This method
+  is meant to be called by multiple times by the same thread, but does nothing if
+  the previous invocation has not terminated. In all cases this method does not
+  halt the calling thread, the work is preformed in a separate thread.
 
+  Note: 'atomicWriteIORef' is essentially a lazy semaphore that prevents two
+  threads from running 'connectionWorker' at the same time.
+
+  Background thread that does the following :
+  1. Tries to connect to pg server and will keep trying until success.
+  2. Checks if the pg version is supported and if it's not it kills the main
+     program.
+  3. Obtains the dbStructure.
+  4. If 2 or 3 fail to give their result it means the connection is down so it
+     goes back to 1, otherwise it finishes his work successfully.
+-}
+connectionWorker
+  :: ThreadId -- ^ This thread is killed if pg version is unsupported
+  -> P.Pool   -- ^ The PostgreSQL connection pool
+  -> Schema   -- ^ Schema PostgREST is serving up
+  -> IORef (Maybe DbStructure) -- ^ mutable reference to 'DbStructure'
+  -> IORef Bool                -- ^ Used as a binary Semaphore
+  -> IO ()
+connectionWorker mainTid pool schema refDbStructure refIsWorkerOn = do
+  isWorkerOn <- readIORef refIsWorkerOn
+  unless isWorkerOn $ do
+    atomicWriteIORef refIsWorkerOn True
+    void $ forkIO work
+  where
+    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
+          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)
+
+{-|
+  Used by 'connectionWorker' to check if the provided db-uri lets
+  the application access the PostgreSQL database. This method is used
+  the first time the connection is tested, but only to test before
+  calling 'getDbStructure' inside the 'connectionWorker' method.
+
+  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 =
+  retrying (capDelay 32000000 $ exponentialBackoff 1000000)
+           shouldRetry
+           (const $ P.release pool >> isConnectionSuccessful)
+  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
+    shouldRetry rs isConnSucc = do
+      delay <- pure $ fromMaybe 0 (rsPreviousDelay rs) `div` 1000000
+      itShould <- pure $ not isConnSucc
+      when itShould $
+        putStrLn $ "Attempting to reconnect to the database in " <> (show delay::Text) <> " seconds..."
+      return itShould
+
+{-|
+  This is where everything starts.
+-}
 main :: IO ()
 main = do
+  --
+  -- LineBuffering: the entire output buffer is flushed whenever a newline is
+  -- output, the buffer overflows, a hFlush is issued or the handle is closed
+  --
+  -- NoBuffering: output is written immediately and never stored in the buffer
   hSetBuffering stdout LineBuffering
-  hSetBuffering stdin  LineBuffering
+  hSetBuffering stdin LineBuffering
   hSetBuffering stderr NoBuffering
-
+  --
+  -- readOptions builds the 'AppConfig' from the config file specified on the
+  -- command line
   conf <- loadSecretFile =<< readOptions
   let host = configHost conf
       port = configPort conf
       proxy = configProxyUri conf
-      pgSettings = toS (configDatabase conf)
-      appSettings = setHost ((fromString . toS) host)
-                  . setPort port
-                  . setServerName (toS $ "postgrest/" <> prettyVersion)
-                  $ defaultSettings
-
-  when (isMalformedProxyUri $ toS <$> proxy) $ panic
-    "Malformed proxy uri, a correct example: https://example.com:8443/basePath"
-
+      pgSettings = toS (configDatabase conf) -- is the db-uri
+      appSettings =
+        setHost ((fromString . toS) host) -- Warp settings
+        . setPort port
+        . setServerName (toS $ "postgrest/" <> prettyVersion)
+        . setTimeout 3600 $
+        defaultSettings
+  --
+  -- Checks that the provided proxy uri is formated correctly,
+  -- does not test if it works here.
+  when (isMalformedProxyUri $ toS <$> proxy) $
+    panic
+      "Malformed proxy uri, a correct example: https://example.com:8443/basePath"
   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)
-
-  result <- P.use pool $ do
-    supported <- isServerVersionSupported
-    unless supported $ panic (
-      "Cannot run in this PostgreSQL version, PostgREST needs at least "
-      <> pgvName minimumPgVersion)
-    getDbStructure (toS $ configSchema conf)
-
-  forM_ (lefts [result]) $ \e -> do
-    hPutStrLn stderr (prettyUsageError e)
-    exitFailure
-
-  refDbStructure <- newIORef $ either (panic . show) id result
-
+  --
+  -- To be filled in by connectionWorker
+  refDbStructure <- newIORef Nothing
+  --
+  -- Helper ref to make sure just one connectionWorker can run at a time
+  refIsWorkerOn <- newIORef False
+  --
+  -- This is passed to the connectionWorker method so it can kill the main
+  -- thread if the PostgreSQL's version is not supported.
+  mainTid <- myThreadId
+  --
+  -- Sets the refDbStructure
+  connectionWorker
+    mainTid
+    pool
+    (configSchema conf)
+    refDbStructure
+    refIsWorkerOn
+  --
+  -- Only for systems with signals:
+  --
+  -- releases the connection pool whenever the program is terminated,
+  -- see issue #268
+  --
+  -- Plus the SIGHUP signal updates the internal 'DbStructure' by running
+  -- 'connectionWorker' exactly as before.
 #ifndef mingw32_HOST_OS
-  tid <- myThreadId
   forM_ [sigINT, sigTERM] $ \sig ->
     void $ installHandler sig (Catch $ do
         P.release pool
-        throwTo tid UserInterrupt
+        throwTo mainTid UserInterrupt
       ) Nothing
 
   void $ installHandler sigHUP (
-      Catch . void . P.use pool $ do
-        s <- getDbStructure (toS $ configSchema conf)
-        liftIO $ atomicWriteIORef refDbStructure s
-   ) Nothing
+    Catch $ connectionWorker
+              mainTid
+              pool
+              (configSchema conf)
+              refDbStructure
+              refIsWorkerOn
+    ) Nothing
 #endif
 
-  -- ask for the OS time at most once per second
-  getTime <- mkAutoUpdate
-    defaultUpdateSettings { updateAction = getPOSIXTime }
+  --
+  -- run the postgrest application
+  runSettings appSettings $
+    postgrest
+      conf
+      refDbStructure
+      pool
+      (connectionWorker
+         mainTid
+         pool
+         (configSchema conf)
+         refDbStructure
+         refIsWorkerOn)
 
-  runSettings appSettings $ postgrest conf refDbStructure pool getTime
+{-|
+  The purpose of this function is to load the JWT secret from a file if
+  configJwtSecret is actually a filepath and replaces some characters if the JWT
+  is base64 encoded.
 
+  The reason some characters need to be replaced is because JWT is actually
+  base64url encoded which must be turned into just base64 before decoding.
+
+  To check if the JWT secret is provided is in fact a file path, it must be
+  decoded as 'Text' to be processed.
+
+  decodeUtf8: Decode a ByteString containing UTF-8 encoded text that is known to
+  be valid.
+-}
 loadSecretFile :: AppConfig -> IO AppConfig
 loadSecretFile conf = extractAndTransform mSecret
   where
-    mSecret   = decodeUtf8 <$> configJwtSecret conf
-    isB64     = configJwtSecretIsBase64 conf
-
+    mSecret = decodeUtf8 <$> configJwtSecret conf
+    isB64 = configJwtSecretIsBase64 conf
+    --
+    -- The Text (variable name secret) here is mSecret from above which is the JWT
+    -- decoded as Utf8
+    --
+    -- stripPrefix: Return the suffix of the second string if its prefix matches
+    -- the entire first string.
+    --
+    -- The configJwtSecret is a filepath instead of the JWT secret itself if the
+    -- secret has @ as its prefix.
     extractAndTransform :: Maybe Text -> IO AppConfig
-    extractAndTransform Nothing  = return conf
-    extractAndTransform (Just s) =
-      fmap setSecret $ transformString isB64 =<<
-        case stripPrefix "@" s of
-            Nothing       -> return s
-            Just filename -> readFile (toS filename)
-
-    transformString :: Bool -> Text -> IO ByteString
-    transformString False t = return . encodeUtf8 $ t
-    transformString True  t =
-      case decode (encodeUtf8 $ replaceUrlChars t) of
+    extractAndTransform Nothing = return conf
+    extractAndTransform (Just secret) =
+      fmap setSecret $
+      transformString isB64 =<<
+      case stripPrefix "@" secret of
+        Nothing       -> return . encodeUtf8 $ secret
+        Just filename -> chomp <$> BS.readFile (toS filename)
+      where
+        chomp bs = fromMaybe bs (BS.stripSuffix "\n" bs)
+    --
+    -- Turns the Base64url encoded JWT into Base64
+    transformString :: Bool -> ByteString -> IO ByteString
+    transformString False t = return t
+    transformString True t =
+      case B64.decode $ encodeUtf8 $ strip $ replaceUrlChars $ decodeUtf8 t of
         Left errMsg -> panic $ pack errMsg
         Right bs    -> return bs
-
-    setSecret bs = conf { configJwtSecret = Just bs }
-
-    replaceUrlChars = replace "_" "/" . replace "-" "+" . replace "." "="
-        
+    setSecret bs = conf {configJwtSecret = Just bs}
+    --
+    -- replace: Replace every occurrence of one substring with another
+    replaceUrlChars =
+      replace "_" "/" . replace "-" "+" . replace "." "="

postgrest.cabal

@@ -2,7 +2,7 @@ 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.4.0.0
+version:               0.4.4.0
 synopsis:              REST API for any Postgres database
 license:               MIT
 license-file:          LICENSE
@@ -29,17 +29,16 @@ executable postgrest
     -rtsopts
     "-with-rtsopts=-N -I2"
   default-language:    Haskell2010
-  build-depends:       auto-update
-                     , base
+  build-depends:       base
                      , hasql
                      , hasql-pool
                      , postgrest
                      , protolude
                      , text
-                     , time
                      , warp
                      , bytestring
                      , base64-bytestring
+                     , retry
   if !os(windows)
     build-depends:     unix
 
@@ -51,13 +50,15 @@ library
   build-depends:       aeson
                      , ansi-wl-pprint
                      , base >= 4.8 && < 6
+                     , base64-bytestring
                      , bytestring
                      , case-insensitive
                      , cassava
-                     , configurator
+                     , configurator-ng == 0.0.0.1
                      , containers
                      , contravariant
                      , either
+                     , gitrev
                      , hasql
                      , hasql-pool == 0.4.1
                      , hasql-transaction == 0.5
@@ -66,26 +67,26 @@ library
                      , http-types
                      , insert-ordered-containers
                      , interpolatedstring-perl6
-                     , jwt
+                     , jose >= 0.6
                      , lens
                      , lens-aeson
                      , network-uri
-                     , optparse-applicative >= 0.12.0.0 && < 0.13.0.0
+                     , optparse-applicative >= 0.13 && < 0.15
                      , parsec
-                     , protolude
+                     , 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
 
   Other-Modules:       Paths_postgrest
   Exposed-Modules:     PostgREST.ApiRequest
@@ -110,13 +111,16 @@ Test-Suite spec
   ghc-options:         -threaded -rtsopts -with-rtsopts=-N
   Hs-Source-Dirs:      test
   Main-Is:             Main.hs
-  Other-Modules:       Feature.AuthSpec
+  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
@@ -124,12 +128,14 @@ Test-Suite spec
                      , Feature.SingularSpec
                      , Feature.StructureSpec
                      , Feature.UnicodeSpec
+                     , Feature.AndOrParamsSpec
+                     , Feature.RpcSpec
+                     , Feature.NonexistentSchemaSpec
                      , SpecHelper
                      , TestTypes
   Build-Depends:       aeson
                      , aeson-qq
                      , async
-                     , auto-update
                      , base
                      , bytestring
                      , base64-bytestring
@@ -140,10 +146,9 @@ Test-Suite spec
                      , hasql
                      , hasql-pool
                      , heredoc
-                     , hjsonpointer
-                     , hjsonschema
+                     , hjsonschema == 1.5.0.1
                      , hspec
-                     , hspec-wai
+                     , hspec-wai >= 0.7.0
                      , hspec-wai-json
                      , http-types
                      , lens
@@ -153,7 +158,6 @@ Test-Suite spec
                      , process
                      , protolude
                      , regex-tdfa
-                     , time
                      , transformers-base
                      , wai
                      , wai-extra

src/PostgREST/ApiRequest.hs

@@ -3,25 +3,23 @@ Module      : PostgREST.ApiRequest
 Description : PostgREST functions to translate HTTP request to a domain type called ApiRequest.
 -}
 module PostgREST.ApiRequest ( ApiRequest(..)
-                            , ApiRequestError(..)
                             , ContentType(..)
                             , Action(..)
                             , Target(..)
                             , PreferRepresentation (..)
                             , mutuallyAgreeable
-                            , toHeader
                             , userApiRequest
-                            , toMime
                             ) where
 
 import           Protolude
 import qualified Data.Aeson                as JSON
+import           Data.Aeson.Types          (emptyObject)
 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)
+import           Data.List                 (lookup, last, partition)
 import qualified Data.HashMap.Strict       as M
 import qualified Data.Set                  as S
 import           Data.Maybe                (fromJust)
@@ -29,23 +27,30 @@ 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, hContentType, Header)
+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           (QualifiedIdentifier (..),
-                                            Schema,
-                                            PayloadJSON(..))
+import           PostgREST.Types           ( QualifiedIdentifier (..)
+                                           , Schema
+                                           , PayloadJSON(..)
+                                           , ContentType(..)
+                                           , ApiRequestError(..)
+                                           , toMime
+                                           , operators
+                                           , ftsOperators)
 import           Data.Ranged.Ranges        (Range(..), rangeIntersection, emptyRange)
+import qualified Data.CaseInsensitive      as CI
+import           Web.Cookie                (parseCookiesText)
 
 type RequestBody = BL.ByteString
 
 -- | Types of things a user wants to do to tables/views/procs
 data Action = ActionCreate | ActionRead
             | ActionUpdate | ActionDelete
-            | ActionInfo   | ActionInvoke
+            | ActionInfo   | ActionInvoke{isReadOnly :: Bool}
             | ActionInspect
             deriving Eq
 -- | The target db object of a user action
@@ -57,29 +62,6 @@ data Target = TargetIdent QualifiedIdentifier
 -- | How to return the inserted data
 data PreferRepresentation = Full | HeadersOnly | None deriving Eq
                           --
--- | Enumeration of currently supported response content types
-data ContentType = CTApplicationJSON | CTTextCSV | CTOpenAPI
-                 | CTSingularJSON
-                 | CTAny | CTOther BS.ByteString deriving Eq
-
-data ApiRequestError = ErrorActionInappropriate
-                     | ErrorInvalidBody ByteString
-                     | ErrorInvalidRange
-                     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 CTOpenAPI         = "application/openapi+json"
-toMime CTSingularJSON    = "application/vnd.pgrst.object+json"
-toMime CTAny             = "*/*"
-toMime (CTOther ct)      = ct
-
 {-|
   Describes what the user wants to do. This data type is a
   translation of the raw elements of an HTTP request into domain
@@ -106,6 +88,8 @@ data ApiRequest = ApiRequest {
   , iPreferCount :: Bool
   -- | Filters on the result ("id", "eq.10")
   , iFilters :: [(Text, Text)]
+  -- | &and and &or parameters used for complex boolean logic
+  , iLogic :: [(Text, Text)]
   -- | &select parameter used to shape the response
   , iSelect :: Text
   -- | &order parameters for each level
@@ -114,14 +98,20 @@ data ApiRequest = ApiRequest {
   , iCanonicalQS :: ByteString
   -- | JSON Web Token
   , iJWT :: Text
+  -- | HTTP request headers
+  , iHeaders :: [(Text, Text)]
+  -- | Request Cookies
+  , iCookies :: [(Text, Text)]
+  -- | Rpc query params e.g. /rpc/name?param1=val1, similar to filter but with no operator(eq, lt..)
+  , iRpcQParams :: [(Text, Text)]
   }
 
 -- | Examines HTTP request and translates it into user intent.
 userApiRequest :: Schema -> Request -> RequestBody -> Either ApiRequestError ApiRequest
 userApiRequest schema req reqBody
-  | isTargetingProc && method /= "POST" = Left ErrorActionInappropriate
-  | topLevelRange == emptyRange = Left ErrorInvalidRange
-  | shouldParsePayload && isLeft payload = either (Left . ErrorInvalidBody . toS) undefined payload
+  | isTargetingProc && method `notElem` ["GET", "POST"] = Left ActionInappropriate
+  | topLevelRange == emptyRange = Left InvalidRange
+  | shouldParsePayload && isLeft payload = either (Left . InvalidBody . toS) undefined payload
   | otherwise = Right ApiRequest {
       iAction = action
       , iTarget = target
@@ -132,7 +122,9 @@ userApiRequest schema req reqBody
       , iPreferRepresentation = representation
       , iPreferSingleObjectParameter = singleObject
       , iPreferCount = hasPrefer "count=exact"
-      , iFilters = [ (toS k, toS $ fromJust v) | (k,v) <- qParams, isJust v, k /= "select", not (endingIn ["order", "limit", "offset"] k) ]
+      , iFilters = filters
+      , iRpcQParams = rpcQParams
+      , iLogic = [(toS k, toS $ fromJust v) | (k,v) <- qParams, isJust v, endingIn ["and", "or"] k ]
       , iSelect = toS $ fromMaybe "*" $ fromMaybe (Just "*") $ lookup "select" qParams
       , iOrder = [(toS k, toS $ fromJust v) | (k,v) <- qParams, isJust v, endingIn ["order"] k ]
       , iCanonicalQS = toS $ urlEncodeVars
@@ -141,19 +133,30 @@ userApiRequest schema req reqBody
         . parseSimpleQuery
         $ rawQueryString req
       , iJWT = tokenStr
+      , iHeaders = [ (toS $ CI.foldedCase k, toS v) | (k,v) <- hdrs, k /= hAuthorization, k /= hCookie]
+      , iCookies = fromMaybe [] $ parseCookiesText <$> lookupHeader "Cookie"
       }
  where
+  (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) ]
+  hasOperator val = any (`T.isPrefixOf` val) $
+                      ((<> ".") <$> "not":M.keys operators) ++
+                      ((<> "(") <$> M.keys ftsOperators)
+  isEmbedPath = T.isInfixOf "."
   isTargetingProc = fromMaybe False $ (== "rpc") <$> listToMaybe path
   payload =
     case decodeContentType . fromMaybe "application/json" $ lookupHeader "content-type" of
       CTApplicationJSON ->
-          either Left (\val -> case ensureUniform (pluralize val) of
-            Nothing -> Left "All object keys must match"
-            Just json -> Right json) (JSON.eitherDecode reqBody)
+        note "All object keys must match" . ensureUniform . pluralize
+          =<< if BL.null reqBody && isTargetingProc
+               then Right emptyObject
+               else JSON.eitherDecode reqBody
       CTTextCSV ->
-          either Left (\val -> case ensureUniform (csvToJson val) of
-            Nothing -> Left "All lines must have same number of fields"
-            Just json -> Right json) (CSV.decodeByName reqBody)
+        note "All lines must have same number of fields" . ensureUniform . csvToJson
+          =<< CSV.decodeByName reqBody
       CTOther "application/x-www-form-urlencoded" ->
         Right . PayloadJSON . V.singleton . M.fromList
                     . map (toS *** JSON.String . toS) . parseSimpleQuery
@@ -161,17 +164,19 @@ userApiRequest schema req reqBody
       ct ->
         Left $ toS $ "Content-Type not acceptable: " <> toMime ct
   topLevelRange = fromMaybe allRange $ M.lookup "limit" ranges
-  action = case method of
-            "GET"     -> if target == TargetRoot
-                          then ActionInspect
-                          else ActionRead
-            "POST"    -> if isTargetingProc
-                          then ActionInvoke
-                          else ActionCreate
-            "PATCH"   -> ActionUpdate
-            "DELETE"  -> ActionDelete
-            "OPTIONS" -> ActionInfo
-            _         -> ActionInspect
+  action =
+    case method of
+      "GET"      | target == TargetRoot -> ActionInspect
+                 | isTargetingProc -> ActionInvoke{isReadOnly=True}
+                 | otherwise -> ActionRead
+
+      "POST"    -> if isTargetingProc
+                    then ActionInvoke{isReadOnly=False}
+                    else ActionCreate
+      "PATCH"   -> ActionUpdate
+      "DELETE"  -> ActionDelete
+      "OPTIONS" -> ActionInfo
+      _         -> ActionInspect
   target = case path of
               []            -> TargetRoot
               [table]       -> TargetIdent
@@ -179,10 +184,10 @@ userApiRequest schema req reqBody
               ["rpc", proc] -> TargetProc
                               $ QualifiedIdentifier schema proc
               other         -> TargetUnknown other
-  shouldParsePayload = action `elem` [ActionCreate, ActionUpdate, ActionInvoke]
-  relevantPayload = if shouldParsePayload
-                      then rightToMaybe payload
-                      else Nothing
+  shouldParsePayload = action `elem` [ActionCreate, ActionUpdate, ActionInvoke{isReadOnly=False}]
+  relevantPayload | action == ActionInvoke{isReadOnly=True} = Nothing
+                  | shouldParsePayload = rightToMaybe payload
+                  | otherwise = Nothing
   path            = pathInfo req
   method          = requestMethod req
   hdrs            = requestHeaders req
@@ -247,6 +252,7 @@ decodeContentType ct =
     "application/openapi+json"          -> CTOpenAPI
     "application/vnd.pgrst.object+json" -> CTSingularJSON
     "application/vnd.pgrst.object"      -> CTSingularJSON
+    "application/octet-stream"          -> CTOctetStream
     "*/*"                               -> CTAny
     ct'                                 -> CTOther ct'
 

src/PostgREST/App.hs

@@ -1,16 +1,16 @@
 {-# LANGUAGE FlexibleContexts    #-}
 {-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TupleSections #-}
---module PostgREST.App where
+
 module PostgREST.App (
   postgrest
 ) where
 
 import           Control.Applicative
+import           Data.Aeson                (toJSON, eitherDecode)
 import qualified Data.ByteString.Char8     as BS
+import           Data.Maybe
 import           Data.IORef                (IORef, readIORef)
 import           Data.Text                 (intercalate)
-import           Data.Time.Clock.POSIX     (POSIXTime)
 
 import qualified Hasql.Pool                 as P
 import qualified Hasql.Transaction          as HT
@@ -21,7 +21,6 @@ import           Network.HTTP.Types.Status
 import           Network.HTTP.Types.URI    (renderSimpleQuery)
 import           Network.Wai
 import           Network.Wai.Middleware.RequestLogger (logStdout)
-import           Web.JWT                   (binarySecret)
 
 import qualified Data.Vector               as V
 import qualified Hasql.Transaction         as H
@@ -32,15 +31,21 @@ import           PostgREST.ApiRequest   ( ApiRequest(..), ContentType(..)
                                         , Action(..), Target(..)
                                         , PreferRepresentation (..)
                                         , mutuallyAgreeable
-                                        , toHeader
                                         , userApiRequest
-                                        , toMime
                                         )
-import           PostgREST.Auth            (jwtClaims, containsRole)
+import           PostgREST.Auth            (jwtClaims, containsRole, parseJWK)
 import           PostgREST.Config          (AppConfig (..))
 import           PostgREST.DbStructure
-import           PostgREST.DbRequestBuilder(readRequest, mutateRequest)
-import           PostgREST.Error           (errResponse, pgErrResponse, apiRequestErrResponse, singularityError)
+import           PostgREST.DbRequestBuilder( readRequest
+                                           , mutateRequest
+                                           , readRpcRequest
+                                           , fieldNames
+                                           )
+import           PostgREST.Error           ( simpleError, pgError
+                                           , apiRequestError
+                                           , singularityError, binaryFieldError
+                                           , connectionLostError, gucHeadersError
+                                           )
 import           PostgREST.RangeQuery      (allRange, rangeOffset)
 import           PostgREST.Middleware
 import           PostgREST.QueryBuilder ( callProc
@@ -54,34 +59,52 @@ import           PostgREST.Types
 import           PostgREST.OpenAPI
 
 import           Data.Function (id)
-import           Protolude                hiding (intercalate, Proxy)
+import           Protolude              hiding (intercalate, Proxy)
+import           Safe                   (headMay)
 
-postgrest :: AppConfig -> IORef DbStructure -> P.Pool -> IO POSIXTime ->
-             Application
-postgrest conf refDbStructure pool getTime =
-  let middle = (if configQuiet conf then id else logStdout) . defaultMiddle in
+postgrest :: AppConfig -> IORef (Maybe DbStructure) -> P.Pool -> IO () -> Application
+postgrest conf refDbStructure pool worker =
+  let middle = (if configQuiet conf then id else logStdout) . defaultMiddle
+      jwtSecret = parseJWK <$> configJwtSecret conf in
 
   middle $ \ req respond -> do
-    time <- getTime
     body <- strictRequestBody req
-    dbStructure <- readIORef refDbStructure
+    maybeDbStructure <- readIORef refDbStructure
+    case maybeDbStructure of
+      Nothing -> respond 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)
 
-    response <- case userApiRequest (configSchema conf) req body of
-      Left err -> return $ apiRequestErrResponse err
-      Right apiRequest -> do
-        let jwtSecret = binarySecret <$> configJwtSecret conf
-            eClaims = jwtClaims jwtSecret (iJWT apiRequest) time
-            authed = containsRole eClaims
-            handleReq = runWithClaims conf eClaims (app dbStructure conf) apiRequest
-            txMode = transactionMode $ iAction apiRequest
-        response <- P.use pool $ HT.transaction HT.ReadCommitted txMode handleReq
-        return $ either (pgErrResponse authed) identity response
-    respond response
+            let authed = containsRole eClaims
+                handleReq = runWithClaims conf eClaims (app dbStructure conf) apiRequest
+                txMode = transactionMode dbStructure
+                  (iTarget apiRequest) (iAction apiRequest)
+            response <- P.use pool $ HT.transaction HT.ReadCommitted txMode handleReq
+            return $ either (pgError authed) identity response
+        when (responseStatus response == status503) worker
+        respond response
 
-transactionMode :: Action -> H.Mode
-transactionMode ActionRead = HT.Read
-transactionMode ActionInfo = HT.Read
-transactionMode _ = HT.Write
+transactionMode :: DbStructure -> Target -> Action -> H.Mode
+transactionMode structure target action =
+  case action of
+    ActionRead -> HT.Read
+    ActionInfo -> HT.Read
+    ActionInspect -> HT.Read
+    ActionInvoke{isReadOnly=False} ->
+      let proc =
+            case target of
+              (TargetProc qi) -> M.lookup (qiName qi) $
+                                   dbProcs structure
+              _               -> Nothing
+          v = fromMaybe Volatile $ pdVolatility <$> proc in
+      if v == Stable || v == Immutable
+         then HT.Read
+         else HT.Write
+    ActionInvoke{isReadOnly=True} -> HT.Read
+    _ -> HT.Write
 
 app :: DbStructure -> AppConfig -> ApiRequest -> H.Transaction Response
 app dbStructure conf apiRequest =
@@ -91,10 +114,13 @@ app dbStructure conf apiRequest =
       case (iAction apiRequest, iTarget apiRequest, iPayload apiRequest) of
 
         (ActionRead, TargetIdent qi, Nothing) ->
-          case readSqlParts of
+          let partsField = (,) <$> readSqlParts
+                <*> (binaryField contentType =<< fldNames) in
+          case partsField of
             Left errorResponse -> return errorResponse
-            Right (q, cq) -> do
-              let stm = createReadStatement q cq (contentType == CTSingularJSON) shouldCount (contentType == CTTextCSV)
+            Right ((q, cq), bField) -> do
+              let stm = createReadStatement q cq (contentType == CTSingularJSON) shouldCount
+                                            (contentType == CTTextCSV) bField
               row <- H.query () stm
               let (tableTotal, queryTotal, _ , body) = row
                   (status, contentRange) = rangeHeader queryTotal tableTotal
@@ -142,10 +168,12 @@ app dbStructure conf apiRequest =
                     if iPreferRepresentation apiRequest == Full
                       then toS body else ""
 
-        (ActionUpdate, TargetIdent _, Just payload) ->
-          case mutateSqlParts of
-            Left errorResponse -> return errorResponse
-            Right (sq, mq) -> do
+        (ActionUpdate, TargetIdent _, Just payload@(PayloadJSON rows)) ->
+          case (mutateSqlParts, null <$> rows V.!? 0, iPreferRepresentation apiRequest == Full) of
+            (Left errorResponse, _, _) -> return errorResponse
+            (_, Just True, True) -> return $ responseLBS status200 [contentRangeH 1 0 Nothing] "[]"
+            (_, Just True, False) -> return $ responseLBS status204 [contentRangeH 1 0 Nothing] ""
+            (Right (sq, mq), _, _) -> do
               let stm = createWriteStatement sq mq
                     (contentType == CTSingularJSON) False (contentType == CTTextCSV)
                     (iPreferRepresentation apiRequest) []
@@ -199,22 +227,41 @@ app dbStructure 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 payload)) ->
-          case readSqlParts of
+        (ActionInvoke _isReadOnly, TargetProc qi, payload) ->
+          let proc = M.lookup (qiName qi) allProcs
+              returnsScalar = case proc of
+                Just ProcDescription{pdReturnType = (Single (Scalar _))} -> True
+                _ -> False
+              rpcBinaryField = if returnsScalar
+                                 then Right Nothing
+                                 else binaryField contentType =<< fldNames
+              parts = (,,) <$> readSqlParts <*> rpcBinaryField <*> rpcQParams in
+          case parts of
             Left errorResponse -> return errorResponse
-            Right (q, cq) -> do
-              let p = V.head payload
+            Right ((q, cq), bField, params) -> do
+              let prms = case payload of
+                          Just (PayloadJSON pld) -> V.head pld
+                          Nothing -> M.fromList $ second toJSON <$> params -- toJSON is just for reusing the callProc function
                   singular = contentType == CTSingularJSON
                   paramsAsSingleObject = iPreferSingleObjectParameter apiRequest
-              row <- H.query () (callProc qi p q cq topLevelRange shouldCount singular paramsAsSingleObject)
-              let (tableTotal, queryTotal, body) =
-                    fromMaybe (Just 0, 0, "[]") row
+              row <- H.query () $
+                callProc qi prms returnsScalar q cq shouldCount
+                         singular paramsAsSingleObject
+                         (contentType == CTTextCSV)
+                         (contentType == CTOctetStream) _isReadOnly bField
+                         (pgVersion dbStructure)
+              let (tableTotal, queryTotal, body, jsonHeaders) =
+                    fromMaybe (Just 0, 0, "[]", "[]") row
                   (status, contentRange) = rangeHeader queryTotal tableTotal
-              if singular && queryTotal /= 1
-                then do
-                  HT.condemn
-                  return $ singularityError (toInteger queryTotal)
-                else return $ responseLBS status [jsonH, contentRange] (toS body)
+                  decodedHeaders = first toS $ eitherDecode $ toS jsonHeaders :: Either Text [GucHeader]
+              case decodedHeaders of
+                Left _ -> return gucHeadersError
+                Right hs ->
+                  if singular && queryTotal /= 1
+                    then do
+                      HT.condemn
+                      return $ singularityError (toInteger queryTotal)
+                    else return $ responseLBS status ([toHeader contentType, contentRange] ++ toHeaders hs) (toS body)
 
         (ActionInspect, TargetRoot, Nothing) -> do
           let host = configHost conf
@@ -223,8 +270,8 @@ app dbStructure conf apiRequest =
               uri Nothing = ("http", host, port, "/")
               uri (Just Proxy { proxyScheme = s, proxyHost = h, proxyPort = p, proxyPath = b }) = (s, h, p, b)
               uri' = uri proxy
-              encodeApi ti = encodeOpenAPI (map snd $ dbProcs dbStructure) ti uri'
-          body <- encodeApi . toTableInfo <$> H.query schema accessibleTables
+              encodeApi ti sd procs = encodeOpenAPI (M.elems procs) (toTableInfo ti) uri' sd (dbPrimaryKeys dbStructure)
+          body <- encodeApi <$> H.query schema accessibleTables <*> H.query schema schemaDescription <*> H.query schema accessibleProcs
           return $ responseLBS status200 [toHeader CTOpenAPI] $ toS body
 
         _ -> return notFound
@@ -241,10 +288,9 @@ app dbStructure conf apiRequest =
       filterPk sc table pk = sc == (tableSchema . pkTable) pk && table == (tableName . pkTable) pk
       filterCol :: Schema -> TableName -> Column -> Bool
       filterCol sc tb Column{colTable=Table{tableSchema=s, tableName=t}} = s==sc && t==tb
-      filterCol _ _ _ =  False
       allPrKeys = dbPrimaryKeys dbStructure
+      allProcs = dbProcs dbStructure
       allOrigins = ("Access-Control-Allow-Origin", "*") :: Header
-      jsonH = toHeader CTApplicationJSON
       shouldCount = iPreferCount apiRequest
       schema = toS $ configSchema conf
       topLevelRange = fromMaybe allRange $ M.lookup "limit" $ iRange apiRequest
@@ -255,10 +301,11 @@ app dbStructure conf apiRequest =
             status = rangeStatus lower upper (toInteger <$> tableTotal)
         in (status, contentRange)
 
-      mapSnd f (a, b) = (a, f b)
-      readReq = readRequest (configMaxRows conf) (dbRelations dbStructure) (map (mapSnd pdReturnType) $ dbProcs dbStructure) apiRequest
+      readReq = readRequest (configMaxRows conf) (dbRelations dbStructure) allProcs apiRequest
+      fldNames = fieldNames <$> readReq
       readDbRequest = DbRead <$> readReq
-      mutateDbRequest = DbMutate <$> (mutateRequest apiRequest =<< readReq)
+      mutateDbRequest = DbMutate <$> (mutateRequest apiRequest =<< fldNames)
+      rpcQParams = readRpcRequest apiRequest
       selectQuery = requestToQuery schema False <$> readDbRequest
       mutateQuery = requestToQuery schema False <$> mutateDbRequest
       countQuery = requestToCountQuery schema <$> readDbRequest
@@ -270,21 +317,30 @@ responseContentTypeOrError accepts action = serves contentTypesForRequest accept
   where
     contentTypesForRequest =
       case action of
-        ActionRead ->    [CTApplicationJSON, CTSingularJSON, CTTextCSV]
+        ActionRead ->    [CTApplicationJSON, CTSingularJSON, CTTextCSV, CTOctetStream]
         ActionCreate ->  [CTApplicationJSON, CTSingularJSON, CTTextCSV]
         ActionUpdate ->  [CTApplicationJSON, CTSingularJSON, CTTextCSV]
         ActionDelete ->  [CTApplicationJSON, CTSingularJSON, CTTextCSV]
-        ActionInvoke ->  [CTApplicationJSON, CTSingularJSON]
-        ActionInspect -> [CTOpenAPI]
+        ActionInvoke _ ->  [CTApplicationJSON, CTSingularJSON, CTTextCSV, CTOctetStream]
+        ActionInspect -> [CTOpenAPI, CTApplicationJSON]
         ActionInfo ->    [CTTextCSV]
     serves sProduces cAccepts =
       case mutuallyAgreeable sProduces cAccepts of
         Nothing -> do
           let failed = intercalate ", " $ map (toS . toMime) cAccepts
-          Left $ errResponse status415 $
+          Left $ simpleError status415 [] $
             "None of these Content-Types are available: " <> failed
         Just ct -> Right ct
 
+binaryField :: ContentType -> [FieldName] -> Either Response (Maybe FieldName)
+binaryField CTOctetStream fldNames =
+  if length fldNames == 1 && fieldName /= Just "*"
+    then Right fieldName
+    else Left binaryFieldError
+  where
+    fieldName = headMay fldNames
+binaryField _ _ = Right Nothing
+
 splitKeyValue :: BS.ByteString -> (BS.ByteString, BS.ByteString)
 splitKeyValue kv = (k, BS.tail v)
   where (k, v) = BS.break (== '=') kv

src/PostgREST/Auth.hs

@@ -12,86 +12,76 @@ In the test suite there is an example of simple login function that can be used
 very simple authentication system inside the PostgreSQL database.
 -}
 module PostgREST.Auth (
-    claimsToSQL
-  , containsRole
+    containsRole
   , jwtClaims
-  , tokenJWT
   , JWTAttempt(..)
+  , parseJWK
   ) where
 
+import           Control.Lens.Operators
+import           Data.Aeson             (Value (..), decode, toJSON)
+import qualified Data.HashMap.Strict    as M
 import           Protolude
-import           Control.Lens
-import           Data.Aeson              (Value (..), parseJSON, toJSON)
-import           Data.Aeson.Lens
-import           Data.Aeson.Types        (parseMaybe, emptyObject, emptyArray)
-import qualified Data.Vector             as V
-import qualified Data.HashMap.Strict     as M
-import           Data.Maybe              (fromJust)
-import           Data.Time.Clock         (NominalDiffTime)
-import           PostgREST.QueryBuilder  (pgFmtIdent, pgFmtLit, unquoted)
-import qualified Web.JWT                 as JWT
 
-{-|
-  Receives a map of JWT claims and returns a list of PostgreSQL
-  statements to set the claims as user defined GUCs.  Except if we
-  have a claim called role, this one is mapped to a SET ROLE
-  statement.
--}
-claimsToSQL :: M.HashMap Text Value -> [ByteString]
-claimsToSQL claims = roleStmts <> varStmts
- where
-  roleStmts = maybeToList $
-    (\r -> "set local role " <> r <> ";") . toS . valueToVariable <$> M.lookup "role" claims
-  varStmts = map setVar $ M.toList (M.delete "role" claims)
-  setVar (k, val) = "set local " <> toS (pgFmtIdent $ "request.jwt.claim." <> k)
-                    <> " = " <> toS (valueToVariable val) <> ";"
-  valueToVariable = pgFmtLit . unquoted
+import qualified Crypto.JOSE.Types      as JOSE.Types
+import           Crypto.JWT
 
 {-|
   Possible situations encountered with client JWTs
 -}
-data JWTAttempt = JWTExpired
-                | JWTInvalid
+data JWTAttempt = JWTInvalid JWTError
                 | JWTMissingSecret
                 | JWTClaims (M.HashMap Text Value)
-                deriving Eq
+                deriving (Eq, Show)
 
 {-|
-  Receives the JWT secret (from config) and a JWT and returns a map
+  Receives the JWT secret and audience (from config) and a JWT and returns a map
   of JWT claims.
 -}
-jwtClaims :: Maybe JWT.Secret -> Text -> NominalDiffTime -> JWTAttempt
-jwtClaims _ "" _ = JWTClaims M.empty
-jwtClaims secret jwt time =
+jwtClaims :: Maybe JWK -> Maybe StringOrURI -> LByteString  -> IO JWTAttempt
+jwtClaims _ _ "" = return $ JWTClaims M.empty
+jwtClaims secret audience payload =
   case secret of
-    Nothing -> JWTMissingSecret
-    Just s ->
-      let mClaims = toJSON . JWT.claims <$> JWT.decodeAndVerifySignature s jwt in
-      case isExpired <$> mClaims of
-        Just True -> JWTExpired
-        Nothing -> JWTInvalid
-        Just False -> JWTClaims $ value2map $ fromJust mClaims
- where
-  isExpired claims =
-    let mExp = claims ^? key "exp" . _Integer
-    in fromMaybe False $ (<= time) . fromInteger <$> mExp
-  value2map (Object o) = o
-  value2map _          = M.empty
-
-{-|
-  Receives the JWT secret (from config) and a JWT and a JSON value
-  and returns a signed JWT.
--}
-tokenJWT :: JWT.Secret -> Value -> Text
-tokenJWT secret (Array arr) =
-  let obj = if V.null arr then emptyObject else V.head arr
-      jcs = parseMaybe parseJSON obj :: Maybe JWT.JWTClaimsSet in
-  JWT.encodeSigned JWT.HS256 secret $ fromMaybe JWT.def jcs
-tokenJWT secret _ = tokenJWT secret emptyArray
+    Nothing -> return JWTMissingSecret
+    Just s -> do
+      let validation = defaultJWTValidationSettings (maybe (const True) (==) audience)
+      eJwt <- runExceptT $ do
+        jwt <- decodeCompact payload
+        verifyClaims validation s jwt
+      return $ case eJwt of
+        Left e    -> JWTInvalid e
+        Right jwt -> JWTClaims . claims2map $ jwt
 
 {-|
   Whether a response from jwtClaims contains a role claim
 -}
 containsRole :: JWTAttempt -> Bool
 containsRole (JWTClaims claims) = M.member "role" claims
-containsRole _ = False
+containsRole _                  = False
+
+{-|
+  Internal helper used to turn JWT ClaimSet into something
+  easier to work with
+-}
+claims2map :: ClaimsSet -> M.HashMap Text Value
+claims2map = val2map . toJSON
+ where
+  val2map (Object o) = o
+  val2map _          = M.empty
+
+parseJWK :: ByteString -> JWK
+parseJWK str =
+  fromMaybe (hs256jwk str) (decode (toS str) :: Maybe JWK)
+
+{-|
+  Internal helper to generate HMAC-SHA256. When the jwt key in the
+  config file is a simple string rather than a JWK object, we'll
+  apply this function to it.
+-}
+hs256jwk :: ByteString -> JWK
+hs256jwk key =
+  fromKeyMaterial km
+    & jwkUse .~ Just Sig
+    & jwkAlg .~ (Just $ JWSAlg HS256)
+ where
+  km = OctKeyMaterial (OctKeyParameters (JOSE.Types.Base64Octets key))

src/PostgREST/Config.hs

@@ -1,3 +1,5 @@
+{-# LANGUAGE LambdaCase, TemplateHaskell #-}
+{-# OPTIONS_GHC -fno-warn-type-defaults #-}
 {-|
 Module      : PostgREST.Config
 Description : Manages PostgREST configuration options.
@@ -13,35 +15,49 @@ turned in configurable behaviour if needed.
 Other hardcoded options such as the minimum version number also belong here.
 -}
 module PostgREST.Config ( prettyVersion
+                        , docsVersion
                         , readOptions
                         , corsPolicy
                         , minimumPgVersion
-                        , PgVersion (..)
+                        , pgVersion96
                         , AppConfig (..)
                         )
        where
 
-import           System.IO.Error             (IOError)
+import           PostgREST.Types             (PgVersion(..))
 import           Control.Applicative
-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.Types     as C
-import           Data.List                   (lookup)
-import           Data.Text                   (strip, intercalate, lines)
-import           Data.Text.Encoding          (encodeUtf8)
-import           Data.Text.IO                (hPutStrLn)
-import           Data.Version                (versionBranch)
+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           Network.Wai.Middleware.Cors  (CorsResourcePolicy (..))
+import           Options.Applicative          hiding (str)
+import           Paths_postgrest              (version)
+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           Protolude hiding            (intercalate
-                                             , (<>))
+import           Text.PrettyPrint.ANSI.Leijen hiding ((<$>), (<>))
+import qualified Text.PrettyPrint.ANSI.Leijen as L
 
 -- | Config file settings for the server
 data AppConfig = AppConfig {
@@ -54,6 +70,7 @@ data AppConfig = AppConfig {
 
   , configJwtSecret         :: Maybe B.ByteString
   , configJwtSecretIsBase64 :: Bool
+  , configJwtAudience       :: Maybe StringOrURI
 
   , configPool              :: Int
   , configMaxRows           :: Maybe Integer
@@ -86,7 +103,13 @@ corsPolicy req = case lookup "origin" headers of
 
 -- | User friendly version number
 prettyVersion :: Text
-prettyVersion = intercalate "." $ map show $ versionBranch version
+prettyVersion =
+  intercalate "." (map show $ versionBranch version)
+  <> " (" <> take 7 $(gitHash) <> ")"
+
+-- | Version number used in docs
+docsVersion :: Text
+docsVersion = "v" <> dropAround (== '.') (dropAround (/= '.') prettyVersion)
 
 -- | Function to read and parse options from the command line
 readOptions :: IO AppConfig
@@ -95,82 +118,97 @@ readOptions = do
   cfgPath <- customExecParser parserPrefs opts
   -- Now read the actual config file
   conf <- catch
-    (C.load [C.Required cfgPath])
+    (C.readConfig =<< C.load [C.Required cfgPath])
     configNotfoundHint
 
-  handle missingKeyHint $ do
-    -- db ----------------
-    cDbUri    <- C.require conf "db-uri"
-    cDbSchema <- C.require conf "db-schema"
-    cDbAnon   <- C.require conf "db-anon-role"
-    cPool     <- C.lookupDefault 10 conf "db-pool"
-    -- server ------------
-    cHost     <- C.lookupDefault "*4" conf "server-host"
-    cPort     <- C.lookupDefault 3000 conf "server-port"
-    cProxy    <- C.lookup conf "server-proxy-uri"
-    -- jwt ---------------
-    cJwtSec   <- C.lookup conf "jwt-secret"
-    cJwtB64   <- C.lookupDefault False conf "secret-is-base64"
-    -- safety ------------
-    cMaxRows  <- C.lookup conf "max-rows"
-    cReqCheck <- C.lookup conf "pre-request"
+  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
 
-    return $ AppConfig cDbUri cDbAnon cProxy cDbSchema cHost cPort
-          (encodeUtf8 <$> cJwtSec) cJwtB64 cPool cMaxRows cReqCheck False
+  case mAppConf of
+    Nothing -> do
+      forM_ errs $ hPrint stderr
+      exitFailure
+    Just appConf ->
+      return appConf
 
- where
-  opts = info (helper <*> pathParser) $
-           fullDesc
-           <> progDesc (
-               "PostgREST "
-               <> toS prettyVersion
-               <> " / create a REST API to an existing Postgres database"
-             )
-           <> footerDoc (Just $
-               text "Example Config File:"
-               <> nest 2 (hardline <> exampleCfg)
-             )
+  where
+    parseJwtAudience :: Name -> C.ConfigParserM (Maybe StringOrURI)
+    parseJwtAudience k =
+      C.key k >>= \case
+        Nothing -> pure Nothing -- no audience in config file
+        Just aud -> case preview stringOrUri (aud :: String) of
+          Nothing -> fail "Invalid Jwt audience. Check your configuration."
+          (Just "") -> pure Nothing
+          aud' -> pure aud'
 
-  parserPrefs = prefs showHelpOnError
+    coerceInt :: (Read i, Integral i) => Value -> Maybe i
+    coerceInt (Number x) = rightToMaybe $ floatingOrInteger x
+    coerceInt (String x) = readMaybe $ toS x
+    coerceInt _          = Nothing
 
-  configNotfoundHint :: IOError -> IO a
-  configNotfoundHint e = do
-    hPutStrLn stderr $
-      "Cannot open config file:\n\t" <> show e
-    exitFailure
+    coerceBool ::  Value -> Maybe Bool
+    coerceBool (Bool b)   = Just b
+    coerceBool (String x) = readMaybe $ toS x
+    coerceBool _          = Nothing
 
-  missingKeyHint :: C.KeyError -> IO a
-  missingKeyHint (C.KeyError n) = do
-    hPutStrLn stderr $
-      "Required config parameter \"" <> n <> "\" is missing or of wrong type.\n" <>
-      "Try the --example-config option to see how to configure PostgREST."
-    exitFailure
+    opts = info (helper <*> pathParser) $
+             fullDesc
+             <> progDesc (
+                 "PostgREST "
+                 <> toS prettyVersion
+                 <> " / create a REST API to an existing Postgres database"
+               )
+             <> footerDoc (Just $
+                 text "Example Config File:"
+                 L.<> nest 2 (hardline L.<> exampleCfg)
+               )
 
-  exampleCfg :: Doc
-  exampleCfg = vsep . map (text . toS) . lines $
-    [str|db-uri = "postgres://user:pass@localhost:5432/dbname"
-        |db-schema = "public"
-        |db-anon-role = "postgres"
-        |db-pool = 10
-        |
-        |server-host = "*4"
-        |server-port = 3000
-        |
-        |## base url for swagger output
-        |# server-proxy-uri = ""
-        |
-        |## choose a secret to enable JWT auth
-        |## (use "@filename" to load from separate file)
-        |# jwt-secret = "foo"
-        |# secret-is-base64 = false
-        |
-        |## limit rows in response
-        |# max-rows = 1000
-        |
-        |## stored proc to exec immediately after auth
-        |# pre-request = "stored_proc_name"
-        |]
+    parserPrefs = prefs showHelpOnError
 
+    configNotfoundHint :: IOError -> IO a
+    configNotfoundHint e = do
+      hPutStrLn stderr $
+        "Cannot open config file:\n\t" <> show e
+      exitFailure
+
+    exampleCfg :: Doc
+    exampleCfg = vsep . map (text . toS) . lines $
+      [str|db-uri = "postgres://user:pass@localhost:5432/dbname"
+          |db-schema = "public"
+          |db-anon-role = "postgres"
+          |db-pool = 10
+          |
+          |server-host = "*4"
+          |server-port = 3000
+          |
+          |## base url for swagger output
+          |# server-proxy-uri = ""
+          |
+          |## choose a secret to enable JWT auth
+          |## (use "@filename" to load from separate file)
+          |# jwt-secret = "foo"
+          |# secret-is-base64 = false
+          |# jwt-aud = "your_audience_claim"
+          |
+          |## limit rows in response
+          |# max-rows = 1000
+          |
+          |## stored proc to exec immediately after auth
+          |# pre-request = "stored_proc_name"
+          |]
 
 pathParser :: Parser FilePath
 pathParser =
@@ -178,11 +216,9 @@ pathParser =
     metavar "FILENAME" <>
     help "Path to configuration file"
 
-data PgVersion = PgVersion {
-  pgvNum  :: Int32
-, pgvName :: Text
-}
-
 -- | Tells the minimum PostgreSQL version required by this version of PostgREST
 minimumPgVersion :: PgVersion
 minimumPgVersion = PgVersion 90300 "9.3"
+
+pgVersion96 :: PgVersion
+pgVersion96 = PgVersion 90600 "9.6"

src/PostgREST/DbRequestBuilder.hs

@@ -1,66 +1,67 @@
 {-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE DuplicateRecordFields    #-}
 module PostgREST.DbRequestBuilder (
   readRequest
 , mutateRequest
+, readRpcRequest
+, 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, lookup)
+import           Data.List                 (delete)
 import           Data.Maybe                (fromJust)
-import           Data.Text                 (isInfixOf, dropWhile, drop)
+import           Data.Text                 (isInfixOf)
 import           Data.Tree
 import           Data.Either.Combinators   (mapLeft)
 
-import           Text.Parsec.Error
-
-import           Network.HTTP.Types.Status
 import           Network.Wai
 
 import           Data.Foldable (foldr1)
 import qualified Data.HashMap.Strict       as M
 
-import           PostgREST.ApiRequest   ( ApiRequest(..) 
+import           PostgREST.ApiRequest   ( ApiRequest(..)
+                                        , PreferRepresentation(..)
                                         , Action(..), Target(..)
                                         , PreferRepresentation (..)
                                         )
-import           PostgREST.Error           (errResponse, formatParserError)
+import           PostgREST.Error           (apiRequestError)
 import           PostgREST.Parsers
 import           PostgREST.RangeQuery      (NonnegRange, restrictRange)
-import           PostgREST.QueryBuilder (getJoinConditions, sourceCTEName)
 import           PostgREST.Types
 
 import           Protolude                hiding (from, dropWhile, drop)
 import           Text.Regex.TDFA         ((=~))
 import           Unsafe                  (unsafeHead)
 
-readRequest :: Maybe Integer -> [Relation] -> [(Text, Text)] -> ApiRequest -> Either Response ReadRequest
+readRequest :: Maybe Integer -> [Relation] -> M.HashMap Text ProcDescription -> ApiRequest -> Either Response ReadRequest
 readRequest maxRows allRels allProcs apiRequest  =
-  mapLeft (errResponse status400) $
+  mapLeft apiRequestError $
   treeRestrictRange maxRows =<<
   augumentRequestWithJoin schema relations =<<
-  first formatParserError parseReadRequest
+  parseReadRequest
   where
     (schema, rootTableName) = fromJust $ -- Make it safe
       let target = iTarget apiRequest in
       case target of
         (TargetIdent (QualifiedIdentifier s t) ) -> Just (s, t)
-        (TargetProc  (QualifiedIdentifier s p) ) -> Just (s, t)
+        (TargetProc  (QualifiedIdentifier s proc) ) -> Just (s, tName)
           where
-            returnType = fromMaybe "" $ lookup p allProcs
-            -- we are looking for results looking like "SETOF schema.tablename" and want to extract tablename
-            t = if "SETOF " `isInfixOf` returnType
-              then drop 1 $ dropWhile (/= '.') returnType
-              else p
+            retType = pdReturnType <$> M.lookup proc allProcs
+            tName = case retType of
+              Just (SetOf (Composite qi)) -> qiName qi
+              Just (Single (Composite qi)) -> qiName qi
+              _ -> proc
 
         _ -> Nothing
 
     action :: Action
     action = iAction apiRequest
 
-    parseReadRequest :: Either ParseError ReadRequest
+    parseReadRequest :: Either ApiRequestError ReadRequest
     parseReadRequest = addFiltersOrdersRanges apiRequest <*>
       pRequestSelect rootName selStr
       where
@@ -71,41 +72,39 @@ readRequest maxRows allRels allProcs apiRequest  =
 
     relations :: [Relation]
     relations = case action of
-      ActionCreate -> fakeSourceRelations ++ allRels
-      ActionUpdate -> fakeSourceRelations ++ allRels
-      ActionDelete -> fakeSourceRelations ++ allRels
-      ActionInvoke -> fakeSourceRelations ++ allRels
+      ActionCreate   -> fakeSourceRelations ++ allRels
+      ActionUpdate   -> fakeSourceRelations ++ allRels
+      ActionDelete   -> fakeSourceRelations ++ allRels
+      ActionInvoke _ -> fakeSourceRelations ++ allRels
       _       -> allRels
       where fakeSourceRelations = mapMaybe (toSourceRelation rootTableName) allRels -- see comment in toSourceRelation
 
-treeRestrictRange :: Maybe Integer -> ReadRequest -> Either Text ReadRequest
+treeRestrictRange :: Maybe Integer -> ReadRequest -> Either ApiRequestError ReadRequest
 treeRestrictRange maxRows_ request = pure $ nodeRestrictRange maxRows_ `fmap` request
   where
     nodeRestrictRange :: Maybe Integer -> ReadNode -> ReadNode
     nodeRestrictRange m (q@Select {range_=r}, i) = (q{range_=restrictRange m r }, i)
 
-augumentRequestWithJoin :: Schema ->  [Relation] ->  ReadRequest -> Either Text ReadRequest
+augumentRequestWithJoin :: Schema ->  [Relation] ->  ReadRequest -> Either ApiRequestError ReadRequest
 augumentRequestWithJoin schema allRels request =
-  (first formatRelationError . addRelations schema allRels Nothing) request
-  >>= addJoinConditions schema
-  where
-    formatRelationError = ("could not find foreign keys between these entities, " <>)
+  addRelations schema allRels Nothing request
+  >>= addJoinFilters schema
 
-addRelations :: Schema -> [Relation] -> Maybe ReadRequest -> ReadRequest -> Either Text ReadRequest
-addRelations schema allRelations parentNode (Node readNode@(query, (name, _, alias)) forest) =
+addRelations :: Schema -> [Relation] -> Maybe ReadRequest -> ReadRequest -> Either ApiRequestError ReadRequest
+addRelations schema allRelations parentNode (Node readNode@(query, (name, _, alias, relationDetail)) forest) =
   case parentNode of
-    (Just (Node (Select{from=[parentNodeTable]}, (_, _, _)) _)) ->
+    (Just (Node (Select{from=[parentNodeTable]}, (_, _, _, _)) _)) ->
       Node <$> readNode' <*> forest'
       where
         forest' = updateForest $ hush node'
         node' = Node <$> readNode' <*> pure forest
         readNode' = addRel readNode <$> rel
-        rel :: Either Text Relation
-        rel = note ("no relation between " <> parentNodeTable <> " and " <> name)
-            $ findRelation schema name parentNodeTable
-
+        rel :: Either ApiRequestError Relation
+        rel = note (NoRelationBetween parentNodeTable name)
+            $ findRelation schema name parentNodeTable relationDetail
             where
-              findRelation s nodeTableName parentNodeTableName =
+              
+              findRelation s nodeTableName parentNodeTableName Nothing =
                 find (\r ->
                   s == tableSchema (relTable r) && -- match schema for relation table
                   s == tableSchema (relFTable r) && -- match schema for relation foriegn table
@@ -142,79 +141,137 @@ addRelations schema allRelations parentNode (Node readNode@(query, (name, _, ali
                     -- addRelation will turn project_id to project so the above condition will match
                   )
                 ) allRelations
-                where n `colMatches` rc = (toS ("^" <> rc <> "_?(?:|[iI][dD]|[fF][kK])$") :: BS.ByteString) =~ (toS n :: BS.ByteString)
-        addRel :: (ReadQuery, (NodeName, Maybe Relation, Maybe Alias)) -> Relation -> (ReadQuery, (NodeName, Maybe Relation, Maybe Alias))
-        addRel (query', (n, _, a)) r = (query' {from=fromRelation}, (n, Just r, a))
+              
+              findRelation s nodeTableName parentNodeTableName (Just rd) = 
+                find (\r ->
+                  s == tableSchema (relTable r) && -- match schema for relation table
+                  s == tableSchema (relFTable r) && -- match schema for relation foriegn table
+                  (
+
+                    -- (request)        => clients { ..., project.client_id{...} }
+                    -- will match
+                    -- (relation type)  => parent
+                    -- (entity)         => clients  {id}
+                    -- (foriegn entity) => projects {client_id}
+                    (
+                      nodeTableName == tableName (relTable r) && -- match relation table name
+                      parentNodeTableName == tableName (relFTable r) && -- && -- match relation foreign table name
+                      length (relColumns r) == 1 &&
+                      rd == (colName . unsafeHead . relColumns) r
+                    ) 
+                    ||
+
+
+                    -- (request)        => tasks { ..., users.tasks_users{...} }
+                    -- will match
+                    -- (relation type)  => many
+                    -- (entity)         => users
+                    -- (foriegn entity) => tasks
+                    (
+                      relType r == Many &&
+                      nodeTableName == tableName (relTable r) && -- match relation table name
+                      parentNodeTableName == tableName (relFTable r) && -- match relation foreign table name
+                      rd == tableName (fromJust (relLTable r))
+                    ) 
+                  )
+                ) allRelations
+              n `colMatches` rc = (toS ("^" <> rc <> "_?(?:|[iI][dD]|[fF][kK])$") :: BS.ByteString) =~ (toS n :: BS.ByteString)
+        addRel :: (ReadQuery, (NodeName, Maybe Relation, Maybe Alias, Maybe RelationDetail)) -> Relation -> (ReadQuery, (NodeName, Maybe Relation, Maybe Alias, Maybe RelationDetail))
+        addRel (query', (n, _, a, _)) r = (query' {from=fromRelation}, (n, Just r, a, Nothing))
           where fromRelation = map (\t -> if t == n then tableName (relTable r) else t) (from query')
 
     _ -> n' <$> updateForest (Just (n' forest))
       where
-        n' = Node (query, (name, Just r, alias))
-        t = Table schema name True -- !!! TODO find another way to get the table from the query
+        n' = Node (query, (name, Just r, alias, Nothing))
+        t = Table schema name Nothing True -- !!! TODO find another way to get the table from the query
         r = Relation t [] t [] Root Nothing Nothing Nothing
   where
-    updateForest :: Maybe ReadRequest -> Either Text [ReadRequest]
+    updateForest :: Maybe ReadRequest -> Either ApiRequestError [ReadRequest]
     updateForest n = mapM (addRelations schema allRelations n) forest
 
-addJoinConditions :: Schema -> ReadRequest -> Either Text ReadRequest
-addJoinConditions schema (Node nn@(query, (n, r, a)) forest) =
-  case r of
-    Just Relation{relType=Root} -> Node nn  <$> updatedForest -- this is the root node
-    Just rel@Relation{relType=Child} -> Node (addCond query (getJoinConditions rel),(n,r,a)) <$> updatedForest
-    Just Relation{relType=Parent} -> Node nn <$> updatedForest
+addJoinFilters :: Schema -> ReadRequest -> Either ApiRequestError ReadRequest
+addJoinFilters schema (Node node@(query, nodeProps@(_, relation, _, _)) forest) =
+  case relation of
+    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, relLTable=(Just linkTable)} ->
-      Node (qq, (n, r, a)) <$> updatedForest
-      where
-         query' = addCond query (getJoinConditions rel)
-         qq = query'{from=tableName linkTable : from query'}
-    _ -> Left "unknown relation"
+      let rq = augmentQuery rel in
+      Node (rq{from=tableName linkTable:from rq}, nodeProps) <$> updatedForest
+    _ -> Left UnknownRelation
   where
-    updatedForest = mapM (addJoinConditions schema) forest
-    addCond query' con = query'{flt_=con ++ flt_ query'}
+    updatedForest = mapM (addJoinFilters schema) forest
+    augmentQuery rel = foldr addFilterToReadQuery query (getJoinFilters rel)
+    addFilterToReadQuery flt rq@Select{where_=lf} = rq{where_=addFilterToLogicForest flt lf}::ReadQuery
 
-addFiltersOrdersRanges :: ApiRequest -> Either ParseError (ReadRequest -> ReadRequest)
+getJoinFilters :: Relation -> [Filter]
+getJoinFilters (Relation t cols ft fcs typ lt lc1 lc2) =
+  case typ of
+    Child  -> zipWith (toFilter tN ftN) cols fcs
+    Parent -> zipWith (toFilter tN ftN) cols fcs
+    Many   -> zipWith (toFilter tN ltN) cols (fromMaybe [] lc1) ++ zipWith (toFilter ftN ltN) fcs (fromMaybe [] lc2)
+    Root   -> undefined --error "undefined getJoinFilters"
+  where
+    s = if typ == Parent then "" else tableSchema t
+    tN = tableName t
+    ftN = tableName ft
+    ltN = fromMaybe "" (tableName <$> lt)
+    toFilter :: Text -> Text -> Column -> Column -> Filter
+    toFilter tb ftb c fc = Filter (colName c, Nothing) (OpExpr False (Join (QualifiedIdentifier s tb) (ForeignKey fc{colTable=(colTable fc){tableName=ftb}})))
+
+addFiltersOrdersRanges :: ApiRequest -> Either ApiRequestError (ReadRequest -> ReadRequest)
 addFiltersOrdersRanges apiRequest = foldr1 (liftA2 (.)) [
     flip (foldr addFilter) <$> filters,
     flip (foldr addOrder) <$> orders,
-    flip (foldr addRange) <$> ranges
+    flip (foldr addRange) <$> ranges,
+    flip (foldr addLogicTree) <$> logicForest
   ]
   {-
   The esence of what is going on above is that we are composing tree functions
   of type (ReadRequest->ReadRequest) that are in (Either ParseError a) context
   -}
   where
-    filters :: Either ParseError [(Path, Filter)]
+    filters :: Either ApiRequestError [(EmbedPath, Filter)]
     filters = mapM pRequestFilter flts
-      where
-        action = iAction apiRequest
-        flts
-          | action == ActionRead = iFilters apiRequest
-          | action == ActionInvoke = iFilters apiRequest
-          | otherwise = filter (( "." `isInfixOf` ) . fst) $ iFilters apiRequest -- there can be no filters on the root table whre we are doing insert/update
-    orders :: Either ParseError [(Path, [OrderTerm])]
+    logicForest :: Either ApiRequestError [(EmbedPath, LogicTree)]
+    logicForest = mapM pRequestLogicTree logFrst
+    action = iAction apiRequest
+    -- there can be no filters on the root table when we are doing insert/update/delete
+    (flts, logFrst) =
+      case action of
+        ActionInvoke _ -> (iFilters apiRequest, iLogic apiRequest)
+        ActionRead     -> (iFilters apiRequest, iLogic apiRequest)
+        _              -> join (***) (filter (( "." `isInfixOf` ) . fst)) (iFilters apiRequest, iLogic apiRequest)
+    orders :: Either ApiRequestError [(EmbedPath, [OrderTerm])]
     orders = mapM pRequestOrder $ iOrder apiRequest
-    ranges :: Either ParseError [(Path, NonnegRange)]
+    ranges :: Either ApiRequestError [(EmbedPath, NonnegRange)]
     ranges = mapM pRequestRange $ M.toList $ iRange apiRequest
 
 addFilterToNode :: Filter -> ReadRequest -> ReadRequest
-addFilterToNode flt (Node (q@Select {flt_=flts}, i) f) = Node (q {flt_=flt:flts}, i) f
+addFilterToNode flt (Node (q@Select {where_=lf}, i) f) = Node (q{where_=addFilterToLogicForest flt lf}::ReadQuery, i) f
 
-addFilter :: (Path, Filter) -> ReadRequest -> ReadRequest
+addFilter :: (EmbedPath, Filter) -> ReadRequest -> ReadRequest
 addFilter = addProperty addFilterToNode
 
 addOrderToNode :: [OrderTerm] -> ReadRequest -> ReadRequest
 addOrderToNode o (Node (q,i) f) = Node (q{order=Just o}, i) f
 
-addOrder :: (Path, [OrderTerm]) -> ReadRequest -> ReadRequest
+addOrder :: (EmbedPath, [OrderTerm]) -> ReadRequest -> ReadRequest
 addOrder = addProperty addOrderToNode
 
 addRangeToNode :: NonnegRange -> ReadRequest -> ReadRequest
 addRangeToNode r (Node (q,i) f) = Node (q{range_=r}, i) f
 
-addRange :: (Path, NonnegRange) -> ReadRequest -> ReadRequest
+addRange :: (EmbedPath, NonnegRange) -> ReadRequest -> ReadRequest
 addRange = addProperty addRangeToNode
 
-addProperty :: (a -> ReadRequest -> ReadRequest) -> (Path, a) -> ReadRequest -> ReadRequest
+addLogicTreeToNode :: LogicTree -> ReadRequest -> ReadRequest
+addLogicTreeToNode t (Node (q@Select{where_=lf},i) f) = Node (q{where_=t:lf}::ReadQuery, i) f
+
+addLogicTree :: (EmbedPath, LogicTree) -> ReadRequest -> ReadRequest
+addLogicTree = addProperty addLogicTreeToNode
+
+addProperty :: (a -> ReadRequest -> ReadRequest) -> (EmbedPath, a) -> ReadRequest -> ReadRequest
 addProperty f ([], a) n = f a n
 addProperty f (path, a) (Node rn forest) =
   case targetNode of
@@ -233,7 +290,7 @@ addProperty f (path, a) (Node rn forest) =
         maybeNode = find fnd forst
           where
             fnd :: ReadRequest -> Bool
-            fnd (Node (_,(n,_,_)) _) = n == name
+            fnd (Node (_,(n,_,_,_)) _) = n == name
 
 -- in a relation where one of the tables mathces "TableName"
 -- replace the name to that table with pg_source
@@ -247,13 +304,13 @@ toSourceRelation mt r@(Relation t _ ft _ _ rt _ _)
   | Just mt == (tableName <$> rt) = Just $ r {relLTable=(\tbl -> tbl {tableName=sourceCTEName}) <$> rt}
   | otherwise = Nothing
 
-mutateRequest :: ApiRequest -> ReadRequest -> Either Response MutateRequest
-mutateRequest apiRequest readReq = mapLeft (errResponse status400) $
+mutateRequest :: ApiRequest -> [FieldName] -> Either Response MutateRequest
+mutateRequest apiRequest fldNames = mapLeft apiRequestError $
   case action of
     ActionCreate -> Right $ Insert rootTableName payload returnings
-    ActionUpdate -> Update rootTableName <$> pure payload <*> filters <*> pure returnings
-    ActionDelete -> Delete rootTableName <$> filters <*> pure returnings
-    _        -> Left "Unsupported HTTP verb"
+    ActionUpdate -> Update rootTableName <$> pure payload <*> combinedLogic <*> pure returnings
+    ActionDelete -> Delete rootTableName <$> combinedLogic <*> pure returnings
+    _        -> Left UnsupportedVerb
   where
     action = iAction apiRequest
     payload = fromJust $ iPayload apiRequest
@@ -262,14 +319,28 @@ mutateRequest apiRequest readReq = mapLeft (errResponse status400) $
       case target of
         (TargetIdent (QualifiedIdentifier _ t) ) -> t
         _ -> undefined
-    fieldNames :: ReadRequest -> PreferRepresentation -> [FieldName]
-    fieldNames _ None = []
-    fieldNames (Node (sel, _) forest) _ =
-      map (fst . view _1) (select sel) ++ map colName fks
-      where
-        fks = concatMap (fromMaybe [] . f) forest
-        f (Node (_, (_, Just Relation{relFColumns=cols, relType=Parent}, _)) _) = Just cols
-        f _ = Nothing
-    returnings = fieldNames readReq (iPreferRepresentation apiRequest) 
-    filters = first formatParserError $ map snd <$> mapM pRequestFilter mutateFilters
-      where mutateFilters = filter (not . ( "." `isInfixOf` ) . fst) $ iFilters apiRequest -- update/delete filters can be only on the root table
+    returnings = if iPreferRepresentation apiRequest == None then [] else fldNames
+    filters = map snd <$> mapM pRequestFilter mutateFilters
+    logic = map snd <$> mapM pRequestLogicTree logicFilters
+    combinedLogic = foldr addFilterToLogicForest <$> logic <*> filters
+    -- update/delete filters can be only on the root table
+    (mutateFilters, logicFilters) = join (***) onlyRoot (iFilters apiRequest, iLogic apiRequest)
+    onlyRoot = filter (not . ( "." `isInfixOf` ) . fst)
+
+readRpcRequest :: ApiRequest -> Either Response [RpcQParam]
+readRpcRequest apiRequest = mapLeft apiRequestError rpcQParams
+  where
+    rpcQParams = mapM pRequestRpcQParam $ iRpcQParams apiRequest
+
+fieldNames :: ReadRequest -> [FieldName]
+fieldNames (Node (sel, _) forest) =
+  map (fst . view _1) (select sel) ++ map colName fks
+  where
+    fks = concatMap (fromMaybe [] . f) forest
+    f (Node (_, (_, Just Relation{relFColumns=cols, relType=Parent}, _, _)) _) = Just cols
+    f _ = Nothing
+
+-- Traditional filters(e.g. id=eq.1) are added as root nodes of the LogicTree
+-- they are later concatenated with AND in the QueryBuilder
+addFilterToLogicForest :: Filter -> [LogicTree] -> [LogicTree]
+addFilterToLogicForest flt lf = Stmnt flt : lf

src/PostgREST/DbStructure.hs

@@ -6,6 +6,9 @@
 module PostgREST.DbStructure (
   getDbStructure
 , accessibleTables
+, accessibleProcs
+, schemaDescription
+, getPgVersion
 ) where
 
 import qualified Hasql.Decoders                as HD
@@ -13,10 +16,11 @@ import qualified Hasql.Encoders                as HE
 import qualified Hasql.Query                   as H
 
 import           Control.Applicative
+import qualified Data.HashMap.Strict           as M
 import           Data.List                     (elemIndex)
 import           Data.Maybe                    (fromJust)
 import           Data.Text                     (split, strip,
-                                                breakOn, dropAround)
+                                                breakOn, dropAround, splitOn)
 import qualified Data.Text                     as T
 import qualified Hasql.Session                 as H
 import           PostgREST.Types
@@ -26,14 +30,14 @@ import           GHC.Exts                      (groupWith)
 import           Protolude
 import           Unsafe (unsafeHead)
 
-getDbStructure :: Schema -> H.Session DbStructure
-getDbStructure schema = do
+getDbStructure :: Schema -> PgVersion -> H.Session DbStructure
+getDbStructure schema pgVer = do
   tabs <- H.query () allTables
-  cols <- H.query () $ allColumns tabs
+  cols <- H.query schema $ allColumns tabs
   syns <- H.query () $ allSynonyms cols
   rels <- H.query () $ allRelations tabs cols
   keys <- H.query () $ allPrimaryKeys tabs
-  procs <- H.query schema accessibleProcs
+  procs <- H.query schema allProcs
 
   let rels' = (addManyToManyRelations . raiseRelations schema syns . addParentRelations . addSynonymousRelations syns) rels
       cols' = addForeignKeys rels' cols
@@ -45,13 +49,16 @@ getDbStructure schema = do
     , dbRelations = rels'
     , dbPrimaryKeys = keys'
     , dbProcs = procs
+    , pgVersion = pgVer
     }
 
 decodeTables :: HD.Result [Table]
 decodeTables =
   HD.rowsList tblRow
  where
-  tblRow = Table <$> HD.value HD.text <*> HD.value HD.text
+  tblRow = Table <$> HD.value HD.text
+                 <*> HD.value HD.text
+                 <*> HD.nullableValue HD.text
                  <*> HD.value HD.bool
 
 decodeColumns :: [Table] -> HD.Result [Column]
@@ -59,11 +66,11 @@ decodeColumns tables =
   mapMaybe (columnFromRow tables) <$> HD.rowsList colRow
  where
   colRow =
-    (,,,,,,,,,,)
+    (,,,,,,,,,,,)
       <$> HD.value HD.text <*> HD.value HD.text
-      <*> HD.value HD.text <*> HD.value HD.int4
-      <*> HD.value HD.bool <*> HD.value HD.text
-      <*> HD.value HD.bool
+      <*> 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
@@ -96,36 +103,94 @@ decodeSynonyms cols =
     <*> HD.value HD.text <*> HD.value HD.text
     <*> HD.value HD.text <*> HD.value HD.text
 
-accessibleProcs :: H.Query Schema [(Text, ProcDescription)]
-accessibleProcs =
-  H.statement sql (HE.value HE.text)
-    (map addName <$> HD.rowsList (ProcDescription <$> HD.value HD.text
-                                <*> (parseArgs <$> HD.value HD.text)
-                                <*> HD.value HD.text)) True
- where
-  addName :: ProcDescription -> (Text, ProcDescription)
-  addName pd = (pdName pd, pd)
+decodeProcs :: HD.Result (M.HashMap Text ProcDescription)
+decodeProcs =
+  M.fromList . map addName <$> HD.rowsList tblRow
+  where
+    tblRow = ProcDescription
+              <$> HD.value HD.text
+              <*> HD.nullableValue HD.text
+              <*> (parseArgs <$> HD.value HD.text)
+              <*> (parseRetType
+                  <$> HD.value HD.text
+                  <*> HD.value HD.text
+                  <*> HD.value HD.bool
+                  <*> HD.value HD.char)
+              <*> (parseVolatility <$> HD.value HD.char)
 
-  parseArgs :: Text -> [PgArg]
-  parseArgs = mapMaybe (parseArg . strip) . split (==',')
+    addName :: ProcDescription -> (Text, ProcDescription)
+    addName pd = (pdName pd, pd)
 
-  parseArg :: Text -> Maybe PgArg
-  parseArg a =
-    let (body, def) = breakOn " DEFAULT " a
-        (name, typ) = breakOn " " body in
-    if T.null typ
-       then Nothing
-       else Just $
-         PgArg (dropAround (== '"') name) (strip typ) (T.null def)
+    parseArgs :: Text -> [PgArg]
+    parseArgs = mapMaybe parseArg . filter (not . isPrefixOf "OUT" . toS) . map strip . split (==',')
 
-  sql = [q|
-    SELECT p.proname as "proc_name",
-           pg_get_function_arguments(p.oid) as "args",
-           pg_get_function_result(p.oid) as "return_type"
-    FROM   pg_namespace n
-    JOIN   pg_proc p
-    ON     pronamespace = n.oid
-    WHERE  n.nspname = $1|]
+    parseArg :: Text -> Maybe PgArg
+    parseArg a =
+      let arg = lastDef "" $ splitOn "INOUT " a
+          (body, def) = breakOn " DEFAULT " arg
+          (name, typ) = breakOn " " body in
+      if T.null typ
+         then Nothing
+         else Just $
+           PgArg (dropAround (== '"') name) (strip typ) (T.null def)
+
+    parseRetType :: Text -> Text -> Bool -> Char -> RetType
+    parseRetType schema name isSetOf typ
+      | isSetOf   = SetOf pgType
+      | otherwise = Single pgType
+      where
+        qi = QualifiedIdentifier schema name
+        pgType = case typ of
+          'c' -> Composite qi
+          'p' -> if name == "record" -- Only pg pseudo type that is a row type is 'record'
+                   then Composite qi
+                   else Scalar qi
+          _   -> Scalar qi -- 'b'ase, 'd'omain, 'e'num, 'r'ange
+
+    parseVolatility :: Char -> ProcVolatility
+    parseVolatility v | v == 'i' = Immutable
+                      | 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
+
+accessibleProcs :: H.Query Schema (M.HashMap Text ProcDescription)
+accessibleProcs = H.statement (toS sql) (HE.value HE.text) decodeProcs True
+  where
+    sql = procsSqlQuery <> " AND has_function_privilege(p.oid, 'execute')"
+
+procsSqlQuery :: SqlQuery
+procsSqlQuery = [q|
+  SELECT p.proname as "proc_name",
+         d.description as "proc_description",
+         pg_get_function_arguments(p.oid) as "args",
+         tn.nspname as "rettype_schema",
+         coalesce(comp.relname, t.typname) as "rettype_name",
+         p.proretset as "rettype_is_setof",
+         t.typtype as "rettype_typ",
+         p.provolatile
+  FROM pg_proc p
+    JOIN pg_namespace pn ON pn.oid = p.pronamespace
+    JOIN pg_type t ON t.oid = p.prorettype
+    JOIN pg_namespace tn ON tn.oid = t.typnamespace
+    LEFT JOIN pg_class comp ON comp.oid = t.typrelid
+    LEFT JOIN pg_catalog.pg_description as d on d.objoid = p.oid
+  WHERE  pn.nspname = $1
+|]
+
+schemaDescription :: H.Query Schema (Maybe Text)
+schemaDescription =
+    H.statement sql (HE.value HE.text) (join <$> HD.maybeRow (HD.nullableValue HD.text)) True
+  where
+    sql = [q|
+      select
+        description
+      from
+        pg_catalog.pg_namespace n
+        left join pg_catalog.pg_description d on d.objoid = n.oid
+      where
+        n.nspname = $1 |]
 
 accessibleTables :: H.Query Schema [Table]
 accessibleTables =
@@ -135,6 +200,7 @@ accessibleTables =
     select
       n.nspname as table_schema,
       relname as table_name,
+      d.description as table_description,
       c.relkind = 'r' or (c.relkind IN ('v', 'f')) and (pg_relation_is_updatable(c.oid::regclass, false) & 8) = 8
       or (exists (
          select 1
@@ -144,6 +210,7 @@ accessibleTables =
     from
       pg_class c
       join pg_namespace n on n.oid = c.relnamespace
+      left join pg_catalog.pg_description as d on d.objoid = c.oid and d.objsubid = 0
     where
       c.relkind in ('v', 'r', 'm')
       and n.nspname = $1
@@ -196,7 +263,11 @@ addManyToManyRelations rels = rels ++ addMirrorRelation (mapMaybe link2Relation
     links = join $ map (combinations 2) $ filter (not . null) $ groupWith groupFn $ filter ( (==Child). relType) rels
     groupFn :: Relation -> Text
     groupFn Relation{relTable=Table{tableSchema=s, tableName=t}} = s<>"_"<>t
-    combinations k ns = filter ((k==).length) (subsequences ns)
+    -- Reference : https://wiki.haskell.org/99_questions/Solutions/26
+    combinations :: Int -> [a] -> [[a]]
+    combinations 0 _  = [ [] ]
+    combinations n xs = [ y:ys | y:xs' <- tails xs
+                               , ys <- combinations (n-1) xs']
     addMirrorRelation [] = []
     addMirrorRelation (rel@(Relation t c ft fc _ lt lc1 lc2):rels') = Relation ft fc t c Many lt lc2 lc1 : rel : addMirrorRelation rels'
     link2Relation [
@@ -235,6 +306,7 @@ allTables =
     SELECT
       n.nspname AS table_schema,
       c.relname AS table_name,
+      NULL AS table_description,
       c.relkind = 'r' OR (c.relkind IN ('v','f'))
       AND (pg_relation_is_updatable(c.oid::regclass, FALSE) & 8) = 8
       OR (EXISTS
@@ -249,15 +321,16 @@ allTables =
     GROUP BY table_schema, table_name, insertable
     ORDER BY table_schema, table_name |]
 
-allColumns :: [Table] -> H.Query () [Column]
+allColumns :: [Table] -> H.Query Schema [Column]
 allColumns tabs =
-  H.statement sql HE.unit (decodeColumns tabs) True
+  H.statement sql (HE.value HE.text) (decodeColumns tabs) True
  where
   sql = [q|
     SELECT DISTINCT
         info.table_schema AS schema,
         info.table_name AS table_name,
         info.column_name AS name,
+        info.description AS description,
         info.ordinal_position AS position,
         info.is_nullable::boolean AS nullable,
         info.data_type AS col_type,
@@ -268,13 +341,40 @@ allColumns tabs =
         array_to_string(enum_info.vals, ',') AS enum
     FROM (
         /*
-        -- CTE based on information_schema.columns to remove the owner filter
+        -- CTE based on pg_catalog to get only Primary and Foreign key columns outside api schema
         */
-        WITH columns AS (
+        WITH key_columns AS (
+             SELECT
+               r.oid AS r_oid,
+               c.oid AS c_oid,
+               n.nspname,
+               c.relname,
+               r.conname,
+               r.contype,
+               unnest(r.conkey) AS conkey
+             FROM
+               pg_catalog.pg_constraint r,
+               pg_catalog.pg_class c,
+               pg_catalog.pg_namespace n
+             WHERE
+               r.contype IN ('f', 'p')
+               AND c.relkind IN ('r', 'v', 'f', 'mv')
+               AND r.conrelid = c.oid
+               AND c.relnamespace = n.oid
+               AND n.nspname NOT IN ('pg_catalog', 'information_schema', $1)
+        ),
+        /*
+        -- CTE based on information_schema.columns
+        -- changed:
+        -- remove the owner filter
+        -- limit columns to the ones in the api schema or PK/FK columns
+        */
+        columns AS (
             SELECT current_database()::information_schema.sql_identifier AS table_catalog,
                 nc.nspname::information_schema.sql_identifier AS table_schema,
                 c.relname::information_schema.sql_identifier AS table_name,
                 a.attname::information_schema.sql_identifier AS column_name,
+                d.description::information_schema.sql_identifier AS description,
                 a.attnum::information_schema.cardinal_number AS ordinal_position,
                 pg_get_expr(ad.adbin, ad.adrelid)::information_schema.character_data AS column_default,
                     CASE
@@ -347,6 +447,8 @@ allColumns tabs =
                     ELSE 'NO'::text
                 END::information_schema.yes_or_no AS is_updatable
             FROM pg_attribute a
+               LEFT JOIN key_columns kc ON kc.conkey = a.attnum AND kc.c_oid = a.attrelid
+               LEFT JOIN pg_catalog.pg_description AS d ON d.objoid = a.attrelid and d.objsubid = a.attnum
                LEFT JOIN pg_attrdef ad ON a.attrelid = ad.adrelid AND a.attnum = ad.adnum
                JOIN (pg_class c
                JOIN pg_namespace nc ON c.relnamespace = nc.oid) ON a.attrelid = c.oid
@@ -356,13 +458,19 @@ allColumns tabs =
                JOIN pg_namespace nbt ON bt.typnamespace = nbt.oid) ON t.typtype = 'd'::"char" AND t.typbasetype = bt.oid
                LEFT JOIN (pg_collation co
                JOIN pg_namespace nco ON co.collnamespace = nco.oid) ON a.attcollation = co.oid AND (nco.nspname <> 'pg_catalog'::name OR co.collname <> 'default'::name)
-            WHERE NOT pg_is_other_temp_schema(nc.oid) AND a.attnum > 0 AND NOT a.attisdropped AND (c.relkind = ANY (ARRAY['r'::"char", 'v'::"char", 'f'::"char"]))
+            WHERE
+                NOT pg_is_other_temp_schema(nc.oid)
+                AND a.attnum > 0
+                AND NOT a.attisdropped
+                AND (c.relkind = ANY (ARRAY['r'::"char", 'v'::"char", 'f'::"char"]))
+                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))*/
         )
         SELECT
             table_schema,
             table_name,
             column_name,
+            description,
             ordinal_position,
             is_nullable,
             data_type,
@@ -388,14 +496,14 @@ allColumns tabs =
     ORDER BY schema, position |]
 
 columnFromRow :: [Table] ->
-                 (Text,       Text,        Text,
-                  Int32,      Bool,        Text,
-                  Bool,       Maybe Int32, Maybe Int32,
-                  Maybe Text, Maybe Text)
+                 (Text,        Text,        Text,
+                  Maybe Text,  Int32,       Bool,
+                  Text,        Bool,        Maybe Int32,
+                  Maybe Int32, Maybe Text,  Maybe Text)
                  -> Maybe Column
-columnFromRow tabs (s, t, n, pos, nul, typ, u, l, p, d, e) = buildColumn <$> table
+columnFromRow tabs (s, t, n, desc, pos, nul, typ, u, l, p, d, e) = buildColumn <$> table
   where
-    buildColumn tbl = Column tbl n pos nul typ u l p d (parseEnum e) Nothing
+    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
@@ -606,7 +714,7 @@ allSynonyms cols =
                 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)'),
+                    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
@@ -632,3 +740,9 @@ synonymFromRow allCols (s1,t1,c1,s2,t2,c2) = (,) <$> col1 <*> col2
     col1 = findCol s1 t1 c1
     col2 = findCol s2 t2 c2
     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
+  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

src/PostgREST/Error.hs

@@ -2,46 +2,62 @@
 {-# LANGUAGE FlexibleInstances    #-}
 {-# LANGUAGE TypeSynonymInstances #-}
 
-module PostgREST.Error (apiRequestErrResponse, pgErrResponse, errResponse, prettyUsageError, singularityError, formatGeneralError, formatParserError) where
+module PostgREST.Error (
+  apiRequestError
+, pgError
+, simpleError
+, singularityError
+, binaryFieldError
+, connectionLostError
+, encodeError
+, gucHeadersError
+) where
 
 import           Protolude
 import           Data.Aeson                ((.=))
 import qualified Data.Aeson                as JSON
-import           Data.Text                 (replace, strip, unwords)
+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.ApiRequest      (toHeader, toMime, ContentType(..), ApiRequestError(..))
-import           Text.Parsec.Error
+import           PostgREST.Types
+import           Text.Read                 (readMaybe)
 
-apiRequestErrResponse :: ApiRequestError -> Response
-apiRequestErrResponse err =
-  case err of
-    ErrorActionInappropriate -> errResponse HT.status405 "Bad Request"
-    ErrorInvalidBody errorMessage -> errResponse HT.status400 $ toS errorMessage
-    ErrorInvalidRange -> errResponse HT.status416 "HTTP Range error"
+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
 
-errResponse :: HT.Status -> Text -> Response
-errResponse status message = jsonErrResponse status $ JSON.object ["message" .= message]
+simpleError :: HT.Status -> [Header] -> Text -> Response
+simpleError status hdrs message =
+  errorResponse status (toHeader CTApplicationJSON : hdrs) $
+    JSON.object ["message" .= message]
 
-jsonErrResponse :: HT.Status -> JSON.Value -> Response
-jsonErrResponse status message = responseLBS status [toHeader CTApplicationJSON] $ JSON.encode message
+errorResponse :: JSON.ToJSON a => HT.Status -> [Header] -> a -> Response
+errorResponse status hdrs e =
+  responseLBS status hdrs $ encodeError e
 
-pgErrResponse :: Bool -> P.UsageError -> Response
-pgErrResponse authed 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 (JSON.encode e)
-
-prettyUsageError :: P.UsageError -> Text
-prettyUsageError (P.ConnectionError e) =
-  "Database connection error:\n" <> toS (fromMaybe "" e)
-prettyUsageError e = show $ JSON.encode e
+  responseLBS status hdrs (encodeError e)
 
 singularityError :: Integer -> Response
 singularityError numRows =
@@ -53,31 +69,64 @@ singularityError numRows =
         [ "Results contain", show numRows, "rows,"
         , toS (toMime CTSingularJSON), "requires 1 row"
         ]
-
-formatParserError :: ParseError -> Text
-formatParserError e = formatGeneralError message details
   where
-     message = show $ errorPos e
-     details = strip $ replace "\n" " " $ toS
-       $ showErrorMessages "or" "unknown parse error" "expecting" "unexpected" "end of input" (errorMessages e)
+    formatGeneralError :: Text -> Text -> Text
+    formatGeneralError message details = toS . JSON.encode $
+      JSON.object ["message" .= message, "details" .= details]
 
-formatGeneralError :: Text -> Text -> Text
-formatGeneralError message details = toS . JSON.encode $
-  JSON.object ["message" .= message, "details" .= details]
+
+binaryFieldError :: Response
+binaryFieldError =
+  simpleError HT.status406 [] (toS (toMime CTOctetStream) <>
+  " requested but a single column was not selected")
+
+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"
+
+connectionLostError :: Response
+connectionLostError =
+  simpleError HT.status503 [] "Database connection lost, retrying the connection."
+
+encodeError :: JSON.ToJSON a => a -> LByteString
+encodeError = JSON.encode
+
+instance JSON.ToJSON ApiRequestError where
+  toJSON (ParseRequestError message details) = JSON.object [
+    "message" .= message, "details" .= details]
+  toJSON ActionInappropriate = JSON.object [
+    "message" .= ("Bad Request" :: Text)]
+  toJSON (InvalidBody errorMessage) = JSON.object [
+    "message" .= (toS errorMessage :: Text)]
+  toJSON InvalidRange = JSON.object [
+    "message" .= ("HTTP Range error" :: Text)]
+  toJSON UnknownRelation = JSON.object [
+    "message" .= ("Unknown relation" :: Text)]
+  toJSON (NoRelationBetween parent child) = JSON.object [
+    "message" .= ("Could not find foreign keys between these entities, No relation found between " <> parent <> " and " <> child :: Text)]
+  toJSON UnsupportedVerb = JSON.object [
+    "message" .= ("Unsupported HTTP verb" :: Text)]
 
 instance JSON.ToJSON P.UsageError where
   toJSON (P.ConnectionError e) = JSON.object [
     "code" .= ("" :: Text),
-    "message" .= ("Connection error" :: 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
-  toJSON (H.ResultError (H.ServerError c m d h)) = 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.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)]
   toJSON (H.ResultError (H.UnexpectedResult m)) = JSON.object [
     "message" .= (m::Text)]
   toJSON (H.ResultError (H.RowError i H.EndOfInput)) = JSON.object [
@@ -101,8 +150,8 @@ instance JSON.ToJSON H.Error where
     "details" .= (fmap toS d::Maybe Text)]
 
 httpStatus :: Bool -> P.UsageError -> HT.Status
-httpStatus _ (P.ConnectionError _) = HT.status500
-httpStatus authed (P.SessionError (H.ResultError (H.ServerError c _ _ _))) =
+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
@@ -130,6 +179,7 @@ httpStatus authed (P.SessionError (H.ResultError (H.ServerError c _ _ _))) =
     "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

src/PostgREST/Middleware.hs

@@ -1,24 +1,25 @@
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE FlexibleContexts #-}
 
 module PostgREST.Middleware where
 
+import           Crypto.JWT
 import           Data.Aeson                    (Value (..))
 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,
-                                                responseLBS)
+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(..), ContentType(..),
-                                                toHeader)
-import           PostgREST.Auth                (claimsToSQL, JWTAttempt(..))
+import           PostgREST.ApiRequest          (ApiRequest(..))
+import           PostgREST.Auth                (JWTAttempt(..))
 import           PostgREST.Config              (AppConfig (..), corsPolicy)
-import           PostgREST.Error               (errResponse)
+import           PostgREST.Error               (simpleError)
+import           PostgREST.QueryBuilder        (pgFmtLit, unquoted, pgFmtEnvVar)
 
 import           Protolude                     hiding (concat, null)
 
@@ -27,26 +28,31 @@ runWithClaims :: AppConfig -> JWTAttempt ->
                  ApiRequest -> H.Transaction Response
 runWithClaims conf eClaims app req =
   case eClaims of
-    JWTExpired -> return $ unauthed "JWT expired"
-    JWTInvalid -> return $ unauthed "JWT invalid"
-    JWTMissingSecret -> return $ errResponse status500 "Server lacks JWT secret"
+    JWTInvalid JWTExpired -> return $ unauthed "JWT expired"
+    JWTInvalid e -> return $ unauthed $ show e
+    JWTMissingSecret -> return $ simpleError status500 [] "Server lacks JWT secret"
     JWTClaims claims -> do
-      -- role claim defaults to anon if not specified in jwt
-      let setClaims = claimsToSQL (M.union claims (M.singleton "role" anon))
-      H.sql $ mconcat setClaims
+      H.sql $ toS.mconcat $ setRoleSql ++ claimsSql ++ headersSql ++ cookiesSql
       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
+        -- role claim defaults to anon if not specified in jwt
+        claimsWithRole = M.union claims (M.singleton "role" anon)
+        anon = String . toS $ configAnonRole conf
+        customReqCheck = (\f -> "select " <> toS f <> "();") <$> configReqCheck conf
   where
-    anon = String . toS $ configAnonRole conf
-    customReqCheck = (\f -> "select " <> toS f <> "();") <$> configReqCheck conf
-    unauthed message = responseLBS unauthorized401
-      [ toHeader CTApplicationJSON
-      , ( "WWW-Authenticate"
+    unauthed message = simpleError
+      unauthorized401
+      [( "WWW-Authenticate"
         , "Bearer error=\"invalid_token\", " <>
-          "error_description=\"" <> message <> "\""
-        )
-      ]
-      (toS $ "{\"message\":\""<>message<>"\"}")
+          "error_description=" <> show message
+      )]
+      message
 
 defaultMiddle :: Application -> Application
 defaultMiddle =

src/PostgREST/OpenAPI.hs

@@ -6,25 +6,25 @@ module PostgREST.OpenAPI (
   , 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           Data.String                 (IsString (..))
-import           Data.Text                   (unpack, pack, concat, intercalate, init, tail, toLower)
 import qualified Data.Set                    as Set
+import           Data.String                 (IsString (..))
+import           Data.Text                   (unpack, pack, init, tail, toLower, intercalate, append, dropWhile, breakOn)
 import           Network.URI                 (parseURI, isAbsoluteURI,
                                               URI (..), URIAuth (..))
 
-import           Protolude hiding              (concat, (&), Proxy, get, intercalate)
+import           Protolude hiding              ((&), Proxy, get, intercalate, dropWhile)
 
 import           Data.Swagger
 
-import           PostgREST.ApiRequest        (ContentType(..), toMime)
-import           PostgREST.Config            (prettyVersion)
-import           PostgREST.QueryBuilder      (operators)
-import           PostgREST.Types             (Table(..), Column(..), PgArg(..),
-                                              Proxy(..), ProcDescription(..))
+import           PostgREST.ApiRequest        (ContentType(..))
+import           PostgREST.Config            (prettyVersion, docsVersion)
+import           PostgREST.Types             (Table(..), Column(..), PgArg(..), ForeignKey(..),
+                                              PrimaryKey(..), Proxy(..), ProcDescription(..), toMime)
 
 makeMimeList :: [ContentType] -> MimeList
 makeMimeList cs = MimeList $ map (fromString . toS . toMime) cs
@@ -36,30 +36,48 @@ toSwaggerType "boolean"   = SwaggerBoolean
 toSwaggerType "numeric"   = SwaggerNumber
 toSwaggerType _           = SwaggerString
 
-makeTableDef :: (Table, [Column], [Text]) -> (Text, Schema)
-makeTableDef (t, cs, _) =
+makeTableDef :: [PrimaryKey] -> (Table, [Column], [Text]) -> (Text, Schema)
+makeTableDef pks (t, cs, _) =
   let tn = tableName t in
       (tn, (mempty :: Schema)
+        & description .~ tableDescription t
         & type_ .~ SwaggerObject
-        & properties .~ fromList (map makeProperty cs))
+        & properties .~ fromList (map (makeProperty pks) cs))
 
-makeProperty :: Column -> (Text, Referenced Schema)
-makeProperty c = (colName c, Inline u)
+makeProperty :: [PrimaryKey] -> Column -> (Text, Referenced Schema)
+makeProperty pks c = (colName c, Inline s)
   where
-    r = mempty :: Schema
-    s = if null $ colEnum c
-           then r
-           else r & enum_ .~ decode (encode (colEnum c))
-    t = s & type_ .~ toSwaggerType (colType c)
-    u = t & format ?~ colType c
+    e = if null $ colEnum c then Nothing else decode $ encode $ colEnum c
+    fk ForeignKey{fkCol=Column{colTable=Table{tableName=a}, colName=b}} =
+      intercalate "" ["This is a Foreign Key to `", a, ".", b, "`.<fk table='", a, "' column='", b, "'/>"]
+    pk :: Bool
+    pk = any (\p -> pkTable p == colTable c && pkName p == colName c) pks
+    n = catMaybes
+      [ Just "Note:"
+      , if pk then Just "This is a Primary Key.<pk/>" else Nothing
+      , fk <$> colFK c
+      ]
+    d =
+      if length n > 1 then
+        Just $ append (fromMaybe "" ((`append` "\n\n") <$> colDescription c)) (intercalate "\n" n)
+      else
+        colDescription c
+    s =
+      (mempty :: Schema)
+        & default_ .~ (decode . toS =<< colDefault c)
+        & description .~ d
+        & enum_ .~ e
+        & format ?~ colType c
+        & maxLength .~ (fromIntegral <$> colMaxLen c)
+        & type_ .~ toSwaggerType (colType c)
 
-makeProcDef :: ProcDescription -> (Text, Schema)
-makeProcDef pd = ("(rpc) " <> pdName pd, s)
-  where
-    s = (mempty :: Schema)
-          & type_ .~ SwaggerObject
-          & properties .~ fromList (map makeProcProperty (pdArgs pd))
-          & required .~ map pgaName (filter pgaReq (pdArgs pd))
+makeProcSchema :: ProcDescription -> Schema
+makeProcSchema pd =
+  (mempty :: Schema)
+  & description .~ pdDescription pd
+  & type_ .~ SwaggerObject
+  & properties .~ fromList (map makeProcProperty (pdArgs pd))
+  & required .~ map pgaName (filter pgaReq (pdArgs pd))
 
 makeProcProperty :: PgArg -> (Text, Referenced Schema)
 makeProcProperty (PgArg n t _) = (n, Inline s)
@@ -68,68 +86,6 @@ makeProcProperty (PgArg n t _) = (n, Inline s)
           & type_ .~ toSwaggerType t
           & format ?~ t
 
-makeOperatorPattern :: Text
-makeOperatorPattern =
-  intercalate "|"
-  [ concat ["^", x, y, "[.]"] |
-    x <- ["not[.]", ""],
-    y <- map fst operators ]
-
-makeRowFilter :: Column -> Param
-makeRowFilter c =
-  (mempty :: Param)
-  & name .~ colName c
-  & required ?~ False
-  & schema .~ ParamOther ((mempty :: ParamOtherSchema)
-    & in_ .~ ParamQuery
-    & type_ .~ SwaggerString
-    & format ?~ colType c
-    & pattern ?~ makeOperatorPattern)
-
-makeRowFilters :: [Column] -> [Param]
-makeRowFilters = map makeRowFilter
-
-makeOrderItems :: [Column] -> [Text]
-makeOrderItems cs =
-  [ concat [x, y, z] |
-    x <- map colName cs,
-    y <- [".asc", ".desc", ""],
-    z <- [".nullsfirst", ".nulllast", ""]
-  ]
-
-makeRangeParams :: [Param]
-makeRangeParams =
-  [ (mempty :: Param)
-    & name        .~ "Range"
-    & description ?~ "Limiting and Pagination"
-    & required    ?~ False
-    & schema .~ ParamOther ((mempty :: ParamOtherSchema)
-      & in_ .~ ParamHeader
-      & type_ .~ SwaggerString)
-  , (mempty :: Param)
-    & name        .~ "Range-Unit"
-    & description ?~ "Limiting and Pagination"
-    & required    ?~ False
-    & schema .~ ParamOther ((mempty :: ParamOtherSchema)
-      & in_ .~ ParamHeader
-      & type_ .~ SwaggerString
-      & default_ .~ decode "\"items\"")
-  , (mempty :: Param)
-    & name        .~ "offset"
-    & description ?~ "Limiting and Pagination"
-    & required    ?~ False
-    & schema .~ ParamOther ((mempty :: ParamOtherSchema)
-      & in_ .~ ParamQuery
-      & type_ .~ SwaggerString)
-  , (mempty :: Param)
-    & name        .~ "limit"
-    & description ?~ "Limiting and Pagination"
-    & required    ?~ False
-    & schema .~ ParamOther ((mempty :: ParamOtherSchema)
-      & in_ .~ ParamQuery
-      & type_ .~ SwaggerString)
-  ]
-
 makePreferParam :: [Text] -> Param
 makePreferParam ts =
   (mempty :: Param)
@@ -141,92 +97,131 @@ makePreferParam ts =
     & type_ .~ SwaggerString
     & enum_ .~ decode (encode ts))
 
-makeSelectParam :: Param
-makeSelectParam =
-  (mempty :: Param)
-    & name        .~ "select"
-    & description ?~ "Filtering Columns"
-    & required    ?~ False
-    & schema .~ ParamOther ((mempty :: ParamOtherSchema)
-      & in_ .~ ParamQuery
-      & type_ .~ SwaggerString)
-
-makeGetParams :: [Column] -> [Param]
-makeGetParams [] =
-  makeRangeParams ++
-  [ makeSelectParam
-  , makePreferParam ["count=none"]
+makeProcParam :: ProcDescription -> [Referenced Param]
+makeProcParam pd =
+  [ Inline $ (mempty :: Param)
+    & name     .~ "args"
+    & required ?~ True
+    & schema   .~ (ParamBody $ Inline $ makeProcSchema pd)
+  , Ref $ Reference "preferParams"
   ]
-makeGetParams cs =
-  makeRangeParams ++
-  [ makeSelectParam
-  , (mempty :: Param)
-    & name        .~ "order"
-    & description ?~ "Ordering"
-    & required    ?~ False
+
+makeParamDefs :: [(Table, [Column], [Text])] -> [(Text, Param)]
+makeParamDefs ti =
+  [ ("preferParams", makePreferParam ["params=single-object"])
+  , ("preferReturn", makePreferParam ["return=representation", "return=minimal", "return=none"])
+  , ("preferCount", makePreferParam ["count=none"])
+  , ("select", (mempty :: Param)
+      & name        .~ "select"
+      & description ?~ "Filtering Columns"
+      & required    ?~ False
+      & schema .~ ParamOther ((mempty :: ParamOtherSchema)
+        & in_ .~ ParamQuery
+        & type_ .~ SwaggerString))
+  , ("order", (mempty :: Param)
+      & name        .~ "order"
+      & description ?~ "Ordering"
+      & required    ?~ False
+      & schema .~ ParamOther ((mempty :: ParamOtherSchema)
+        & in_ .~ ParamQuery
+        & type_ .~ SwaggerString))
+  , ("range", (mempty :: Param)
+      & name        .~ "Range"
+      & description ?~ "Limiting and Pagination"
+      & required    ?~ False
+      & schema .~ ParamOther ((mempty :: ParamOtherSchema)
+        & in_ .~ ParamHeader
+        & type_ .~ SwaggerString))
+  , ("rangeUnit", (mempty :: Param)
+      & name        .~ "Range-Unit"
+      & description ?~ "Limiting and Pagination"
+      & required    ?~ False
+      & schema .~ ParamOther ((mempty :: ParamOtherSchema)
+        & in_ .~ ParamHeader
+        & type_ .~ SwaggerString
+        & default_ .~ decode "\"items\""))
+  , ("offset", (mempty :: Param)
+      & name        .~ "offset"
+      & description ?~ "Limiting and Pagination"
+      & required    ?~ False
+      & schema .~ ParamOther ((mempty :: ParamOtherSchema)
+        & in_ .~ ParamQuery
+        & type_ .~ SwaggerString))
+  , ("limit", (mempty :: Param)
+      & name        .~ "limit"
+      & description ?~ "Limiting and Pagination"
+      & required    ?~ False
+      & schema .~ ParamOther ((mempty :: ParamOtherSchema)
+        & in_ .~ ParamQuery
+        & type_ .~ SwaggerString))
+  ]
+  <> concat [ makeObjectBody (tableName t) : makeRowFilters (tableName t) cs
+            | (t, cs, _) <- ti
+            ]
+
+makeObjectBody :: Text -> (Text, Param)
+makeObjectBody tn =
+  ("body." <> tn, (mempty :: Param)
+     & name .~ tn
+     & description ?~ tn
+     & required ?~ False
+     & schema .~ ParamBody (Ref (Reference tn)))
+
+makeRowFilter :: Text -> Column -> (Text, Param)
+makeRowFilter tn c =
+  (intercalate "." ["rowFilter", tn, colName c], (mempty :: Param)
+    & name .~ colName c
+    & description .~ colDescription c
+    & required ?~ False
     & schema .~ ParamOther ((mempty :: ParamOtherSchema)
       & in_ .~ ParamQuery
       & type_ .~ SwaggerString
-      & enum_ .~ decode (encode $ makeOrderItems cs))
-  , makePreferParam ["count=none"]
-  ]
+      & format ?~ colType c))
 
-makePostParams :: Text -> [Param]
-makePostParams tn =
-  [ makePreferParam ["return=representation",
-                     "return=minimal", "return=none"]
-  , (mempty :: Param)
-    & name        .~ "body"
-    & description ?~ tn
-    & required    ?~ False
-    & schema .~ ParamBody (Ref (Reference tn))
-  ]
-
-makeProcParam :: Text -> [Param]
-makeProcParam refName =
-  [ makePreferParam ["params=single-object"]
-  , (mempty :: Param)
-    & name     .~ "args"
-    & required ?~ True
-    & schema   .~ ParamBody (Ref (Reference refName))
-  ]
-
-makeDeleteParams :: [Param]
-makeDeleteParams =
-  [ makePreferParam ["return=representation", "return=minimal", "return=none"] ]
+makeRowFilters :: Text -> [Column] -> [(Text, Param)]
+makeRowFilters tn = map (makeRowFilter tn)
 
 makePathItem :: (Table, [Column], [Text]) -> (FilePath, PathItem)
 makePathItem (t, cs, _) = ("/" ++ unpack tn, p $ tableInsertable t)
   where
+    -- Use first line of table description as summary; rest as description (if present)
+    -- We strip leading newlines from description so that users can include a blank line between summary and description
+    (tSum, tDesc) = fmap fst &&& fmap (dropWhile (=='\n') . snd) $
+                    breakOn "\n" <$> tableDescription t
     tOp = (mempty :: Operation)
       & tags .~ Set.fromList [tn]
-      & produces ?~ makeMimeList [CTApplicationJSON, CTSingularJSON, CTTextCSV]
-      & at 200 ?~ "OK"
+      & summary .~ tSum
+      & description .~ mfilter (/="") tDesc
     getOp = tOp
-      & parameters .~ map Inline (makeGetParams cs ++ rs)
+      & parameters .~ map ref (rs <> ["select", "order", "range", "rangeUnit", "offset", "limit", "preferCount"])
       & at 206 ?~ "Partial Content"
+      & at 200 ?~ Inline ((mempty :: Response)
+        & description .~ "OK"
+        & schema ?~ (Ref $ Reference $ tableName t)
+        )
     postOp = tOp
-      & consumes ?~ makeMimeList [CTApplicationJSON, CTSingularJSON, CTTextCSV]
-      & parameters .~ map Inline (makePostParams tn)
+      & parameters .~ map ref ["body." <> tn, "preferReturn"]
       & at 201 ?~ "Created"
     patchOp = tOp
-      & consumes ?~ makeMimeList [CTApplicationJSON, CTSingularJSON, CTTextCSV]
-      & parameters .~ map Inline (makePostParams tn ++ rs)
+      & parameters .~ map ref (rs <> ["body." <> tn, "preferReturn"])
       & at 204 ?~ "No Content"
     deletOp = tOp
-      & parameters .~ map Inline (makeDeleteParams ++ rs)
+      & parameters .~ map ref (rs <> ["preferReturn"])
+      & at 204 ?~ "No Content"
     pr = (mempty :: PathItem) & get ?~ getOp
     pw = pr & post ?~ postOp & patch ?~ patchOp & delete ?~ deletOp
     p False = pr
     p True  = pw
-    rs = makeRowFilters cs
     tn = tableName t
+    rs = [ intercalate "." ["rowFilter", tn, colName c ] | c <- cs ]
+    ref = Ref . Reference
 
 makeProcPathItem :: ProcDescription -> (FilePath, PathItem)
 makeProcPathItem pd = ("/rpc/" ++ toS (pdName pd), pe)
   where
     postOp = (mempty :: Operation)
-      & parameters .~ map Inline (makeProcParam $ "(rpc) " <> pdName pd)
+      & description .~ pdDescription pd
+      & parameters .~ makeProcParam pd
       & tags .~ Set.fromList ["(rpc) " <> pdName pd]
       & produces ?~ makeMimeList [CTApplicationJSON, CTSingularJSON]
       & at 200 ?~ "OK"
@@ -236,8 +231,9 @@ makeRootPathItem :: (FilePath, PathItem)
 makeRootPathItem = ("/", p)
   where
     getOp = (mempty :: Operation)
-      & tags .~ Set.fromList ["/"]
-      & produces ?~ makeMimeList [CTOpenAPI]
+      & tags .~ Set.fromList ["Introspection"]
+      & summary ?~ "OpenAPI description (this document)"
+      & produces ?~ makeMimeList [CTOpenAPI, CTApplicationJSON]
       & at 200 ?~ "OK"
     pr = (mempty :: PathItem) & get ?~ getOp
     p = pr
@@ -254,23 +250,30 @@ escapeHostName "*6" = "0.0.0.0"
 escapeHostName "!6" = "0.0.0.0"
 escapeHostName h    = h
 
-postgrestSpec :: [ProcDescription] -> [(Table, [Column], [Text])] -> (Text, Text, Integer, Text) -> Swagger
-postgrestSpec pds ti (s, h, p, b) = (mempty :: Swagger)
+postgrestSpec :: [ProcDescription] -> [(Table, [Column], [Text])] -> (Text, Text, Integer, Text) -> Maybe Text -> [PrimaryKey] -> Swagger
+postgrestSpec pds ti (s, h, p, b) sd pks = (mempty :: Swagger)
   & basePath ?~ unpack b
   & schemes ?~ [s']
   & info .~ ((mempty :: Info)
       & version .~ prettyVersion
       & title .~ "PostgREST API"
-      & description ?~ "This is a dynamic API generated by PostgREST")
+      & description ?~ d)
+  & externalDocs ?~ ((mempty :: ExternalDocs)
+    & description ?~ "PostgREST Documentation"
+    & url .~ URL ("https://postgrest.com/en/" <> docsVersion <> "/api.html"))
   & host .~ h'
-  & definitions .~ fromList (map makeTableDef ti <> map makeProcDef pds)
+  & definitions .~ fromList (map (makeTableDef pks) ti)
+  & parameters .~ fromList (makeParamDefs ti)
   & paths .~ makePathItems pds ti
+  & produces .~ makeMimeList [CTApplicationJSON, CTSingularJSON, CTTextCSV]
+  & consumes .~ makeMimeList [CTApplicationJSON, CTSingularJSON, CTTextCSV]
     where
       s' = if s == "http" then Http else Https
       h' = Just $ Host (unpack $ escapeHostName h) (Just (fromInteger p))
+      d = fromMaybe "This is a dynamic API generated by PostgREST" sd
 
-encodeOpenAPI :: [ProcDescription] -> [(Table, [Column], [Text])] -> (Text, Text, Integer, Text) -> LByteString
-encodeOpenAPI pds ti uri = encode $ postgrestSpec pds ti uri
+encodeOpenAPI :: [ProcDescription] -> [(Table, [Column], [Text])] -> (Text, Text, Integer, Text) -> Maybe Text -> [PrimaryKey] ->  LByteString
+encodeOpenAPI pds ti uri sd pks = encode $ postgrestSpec pds ti uri sd pks
 
 {-|
   Test whether a proxy uri is malformed or not.

src/PostgREST/Parsers.hs

@@ -1,42 +1,58 @@
 module PostgREST.Parsers where
 
-import           Protolude                     hiding (try, intercalate)
-import           Control.Monad                ((>>))
-import           Data.Text                     (intercalate)
+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           PostgREST.QueryBuilder        (operators)
+import           Data.Either.Combinators       (mapLeft)
+import           PostgREST.RangeQuery          (NonnegRange,allRange)
 import           PostgREST.Types
 import           Text.ParserCombinators.Parsec hiding (many, (<|>))
-import           PostgREST.RangeQuery      (NonnegRange,allRange)
+import           Text.Parsec.Error
 
-pRequestSelect :: Text -> Text -> Either ParseError ReadRequest
-pRequestSelect rootName selStr = 
-  parse (pReadRequest rootName) ("failed to parse select parameter (" <> toS selStr <> ")") (toS selStr)
+pRequestSelect :: Text -> Text -> Either ApiRequestError ReadRequest
+pRequestSelect rootName selStr =
+  mapError $ parse (pReadRequest rootName) ("failed to parse select parameter (" <> toS selStr <> ")") (toS selStr)
 
-pRequestFilter :: (Text, Text) -> Either ParseError (Path, Filter)
-pRequestFilter (k, v) = (,) <$> path <*> (Filter <$> fld <*> op <*> val)
+pRequestFilter :: (Text, Text) -> Either ApiRequestError (EmbedPath, Filter)
+pRequestFilter (k, v) = mapError $ (,) <$> path <*> (Filter <$> fld <*> oper)
   where
     treePath = parse pTreePath ("failed to parser tree path (" ++ toS k ++ ")") $ toS k
-    opVal = parse pOpValueExp ("failed to parse filter (" ++ toS v ++ ")") $ toS v
+    oper = parse (pOpExpr pSingleVal pListVal) ("failed to parse filter (" ++ toS v ++ ")") $ toS v
     path = fst <$> treePath
     fld = snd <$> treePath
-    op = fst <$> opVal
-    val = snd <$> opVal
 
-pRequestOrder :: (Text, Text) -> Either ParseError (Path, [OrderTerm])
-pRequestOrder (k, v) = (,) <$> path <*> ord'
+pRequestOrder :: (Text, Text) -> Either ApiRequestError (EmbedPath, [OrderTerm])
+pRequestOrder (k, v) = mapError $ (,) <$> path <*> ord'
   where
     treePath = parse pTreePath ("failed to parser tree path (" ++ toS k ++ ")") $ toS k
     path = fst <$> treePath
     ord' = parse pOrder ("failed to parse order (" ++ toS v ++ ")") $ toS v
 
-pRequestRange :: (ByteString, NonnegRange) -> Either ParseError (Path, NonnegRange)
-pRequestRange (k, v) = (,) <$> path <*> pure v
+pRequestRange :: (ByteString, NonnegRange) -> Either ApiRequestError (EmbedPath, NonnegRange)
+pRequestRange (k, v) = mapError $ (,) <$> path <*> pure v
   where
     treePath = parse pTreePath ("failed to parser tree path (" ++ toS k ++ ")") $ toS k
     path = fst <$> treePath
 
+pRequestLogicTree :: (Text, Text) -> Either ApiRequestError (EmbedPath, LogicTree)
+pRequestLogicTree (k, v) = mapError $ (,) <$> embedPath <*> logicTree
+  where
+    path = parse pLogicPath ("failed to parser logic path (" ++ toS k ++ ")") $ toS k
+    embedPath = fst <$> path
+    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)
+
+pRequestRpcQParam :: (Text, Text) -> Either ApiRequestError RpcQParam
+pRequestRpcQParam (k, v) = mapError $ (,) <$> name <*> val
+  where
+    name = parse pFieldName ("failed to parse rpc arg name (" ++ toS k ++ ")") $ toS k
+    val = toS <$> parse (many anyChar) ("failed to parse rpc arg value (" ++ toS v ++ ")") v
+
 ws :: Parser Text
 ws = toS <$> many (oneOf " \t")
 
@@ -46,19 +62,19 @@ lexeme p = ws *> p <* ws
 pReadRequest :: Text -> Parser ReadRequest
 pReadRequest rootNodeName = do
   fieldTree <- pFieldForest
-  return $ foldr treeEntry (Node (readQuery, (rootNodeName, Nothing, Nothing)) []) fieldTree
+  return $ foldr treeEntry (Node (readQuery, (rootNodeName, Nothing, Nothing, Nothing)) []) fieldTree
   where
     readQuery = Select [] [rootNodeName] [] Nothing allRange
     treeEntry :: Tree SelectItem -> ReadRequest -> ReadRequest
-    treeEntry (Node fld@((fn, _),_,alias) fldForest) (Node (q, i) rForest) =
+    treeEntry (Node fld@((fn, _),_,alias,relationDetail) fldForest) (Node (q, i) rForest) =
       case fldForest of
         [] -> Node (q {select=fld:select q}, i) rForest
         _  -> Node (q, i) newForest
           where
             newForest =
-              foldr treeEntry (Node (Select [] [fn] [] Nothing allRange, (fn, Nothing, alias)) []) fldForest:rForest
+              foldr treeEntry (Node (Select [] [fn] [] Nothing allRange, (fn, Nothing, alias, relationDetail)) []) fldForest:rForest
 
-pTreePath :: Parser (Path,Field)
+pTreePath :: Parser (EmbedPath, Field)
 pTreePath = do
   p <- pFieldName `sepBy1` pDelimiter
   jp <- optionMaybe pJsonPath
@@ -68,8 +84,9 @@ pFieldForest :: Parser [Tree SelectItem]
 pFieldForest = pFieldTree `sepBy1` lexeme (char ',')
 
 pFieldTree :: Parser (Tree SelectItem)
-pFieldTree = try (Node <$> pSimpleSelect <*> between (char '{') (char '}') pFieldForest)
-          <|>     Node <$> pSelect <*> pure []
+pFieldTree =  try (Node <$> pRelationSelect <*> between (char '{') (char '}') pFieldForest) -- TODO: "{}" deprecated
+          <|> try (Node <$> pRelationSelect <*> between (char '(') (char ')') pFieldForest)
+          <|> Node <$> pFieldSelect <*> pure []
 
 pStar :: Parser Text
 pStar = toS <$> (string "*" *> pure ("*"::ByteString))
@@ -85,7 +102,6 @@ pFieldName = do
     dash :: Parser Char
     dash = isDash *> pure '-'
 
-
 pJsonPathStep :: Parser Text
 pJsonPathStep = toS <$> try (string "->" *> pFieldName)
 
@@ -98,42 +114,62 @@ pField = lexeme $ (,) <$> pFieldName <*> optionMaybe pJsonPath
 aliasSeparator :: Parser ()
 aliasSeparator = char ':' >> notFollowedBy (char ':')
 
-pSimpleSelect :: Parser SelectItem
-pSimpleSelect = lexeme $ try ( do
+pRelationSelect :: Parser SelectItem
+pRelationSelect = lexeme $ try ( do
     alias <- optionMaybe ( try(pFieldName <* aliasSeparator) )
     fld <- pField
-    return (fld, Nothing, alias)
+    relationDetail <- optionMaybe ( try( char '.' *> pFieldName ) )
+
+    return (fld, Nothing, alias, relationDetail)
   )
 
-pSelect :: Parser SelectItem
-pSelect = lexeme $
+pFieldSelect :: Parser SelectItem
+pFieldSelect = lexeme $
   try (
     do
       alias <- optionMaybe ( try(pFieldName <* aliasSeparator) )
       fld <- pField
       cast' <- optionMaybe (string "::" *> many letter)
-      return (fld, toS <$> cast', alias)
+      return (fld, toS <$> cast', alias, Nothing)
   )
   <|> do
     s <- pStar
-    return ((s, Nothing), Nothing, Nothing)
+    return ((s, Nothing), Nothing, Nothing, Nothing)
 
-pOperator :: Parser Operator
-pOperator = toS <$> (pOp <?> "operator (eq, gt, ...)")
-  where pOp = foldl (<|>) empty $ map (try . string . toS . fst) operators
+pOpExpr :: Parser SingleVal -> Parser ListVal -> Parser OpExpr
+pOpExpr pSVal pLVal = try ( string "not" *> pDelimiter *> (OpExpr True <$> pOperation)) <|> OpExpr False <$> pOperation
+  where
+    pOperation :: Parser Operation
+    pOperation =
+          Op . toS <$> foldl1 (<|>) (try . ((<* pDelimiter) . string) . toS <$> M.keys ops) <*> pSVal
+      <|> In <$> (string "in" *> pDelimiter *> pLVal)
+      <|> pFts
+      <?> "operator (eq, gt, ...)"
 
-pValue :: Parser FValue
-pValue = VText <$> (toS <$> many anyChar)
+    pFts = do
+      op   <- foldl1 (<|>) (try . string . toS <$> ftsOps)
+      lang <- optionMaybe $ try (between (char '(') (char ')') (many (letter <|> digit <|> oneOf "_")))
+      pDelimiter >> Fts (toS op) (toS <$> lang) <$> pSVal
+
+    ops = M.filterWithKey (const . flip notElem ("in":ftsOps)) operators
+    ftsOps = M.keys ftsOperators
+
+pSingleVal :: Parser SingleVal
+pSingleVal = toS <$> many anyChar
+
+pListVal :: Parser ListVal
+pListVal =    try (lexeme (char '(') *> pListElement `sepBy1` char ',' <* lexeme (char ')'))
+          <|> lexeme pListElement `sepBy1` char ',' -- TODO: "in.3,4,5" deprecated, parens e.g. "in.(3,4,5)" should be used
+
+pListElement :: Parser Text
+pListElement = try pQuotedValue <|> (toS <$> many (noneOf ",)"))
+
+pQuotedValue :: Parser Text
+pQuotedValue = toS <$> (char '"' *> many (noneOf "\"") <* char '"' <* notFollowedBy (noneOf ",)"))
 
 pDelimiter :: Parser Char
 pDelimiter = char '.' <?> "delimiter (.)"
 
-pOperatiorWithNegation :: Parser Operator
-pOperatiorWithNegation = try ( (<>) <$> ( toS <$> string "not." ) <*>  pOperator) <|> pOperator
-
-pOpValueExp :: Parser (Operator, FValue)
-pOpValueExp = (,) <$> pOperatiorWithNegation <*> (pDelimiter *> pValue)
-
 pOrder :: Parser [OrderTerm]
 pOrder = lexeme pOrderTerm `sepBy` char ','
 
@@ -152,3 +188,49 @@ pOrderTerm =
     return $ OrderTerm c d nls
   )
   <|> OrderTerm <$> pField <*> pure Nothing <*> pure Nothing
+
+pLogicTree :: Parser LogicTree
+pLogicTree = Stmnt <$> try pLogicFilter
+             <|> Expr <$> pNot <*> pLogicOp <*> (lexeme (char '(') *> pLogicTree `sepBy1` lexeme (char ',') <* lexeme (char ')'))
+  where
+    pLogicFilter :: Parser Filter
+    pLogicFilter = Filter <$> pField <* pDelimiter <*> pOpExpr pLogicSingleVal pLogicListVal
+    pNot :: Parser Bool
+    pNot = try (string "not" *> pDelimiter *> pure True)
+           <|> pure False
+           <?> "negation operator (not)"
+    pLogicOp :: Parser LogicOperator
+    pLogicOp = try (string "and"  *> pure And)
+               <|> string "or" *> pure Or
+               <?> "logic operator (and, or)"
+
+pLogicSingleVal :: Parser SingleVal
+pLogicSingleVal = try pQuotedValue <|> try pPgArray <|> (toS <$> many (noneOf ",)"))
+  where
+    -- TODO: "{}" deprecated, after removal pPgArray can be removed
+    pPgArray :: Parser Text
+    pPgArray =  do
+      a <- string "{"
+      b <- many (noneOf "{}")
+      c <- string "}"
+      toS <$> pure (a ++ b ++ c)
+
+pLogicListVal :: Parser ListVal
+pLogicListVal = lexeme (char '(') *> pListElement `sepBy1` char ',' <* lexeme (char ')')
+
+pLogicPath :: Parser (EmbedPath, Text)
+pLogicPath = do
+  path <- pFieldName `sepBy1` pDelimiter
+  let op = last path
+      notOp = "not." <> op
+  return (filter (/= "not") (init path), if "not" `elem` path then notOp else op)
+
+mapError :: Either ParseError a -> Either ApiRequestError a
+mapError = mapLeft translateError
+  where
+    translateError e =
+      ParseRequestError message details
+      where
+        message = show $ errorPos e
+        details = strip $ replace "\n" " " $ toS
+           $ showErrorMessages "or" "unknown parse error" "expecting" "unexpected" "end of input" (errorMessages e)

src/PostgREST/QueryBuilder.hs

@@ -1,5 +1,4 @@
 {-# LANGUAGE FlexibleInstances    #-}
-{-# LANGUAGE TupleSections        #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 {-|
 Module      : PostgREST.QueryBuilder
@@ -15,15 +14,13 @@ module PostgREST.QueryBuilder (
     callProc
   , createReadStatement
   , createWriteStatement
-  , getJoinConditions
-  , operators
   , pgFmtIdent
   , pgFmtLit
   , requestToQuery
   , requestToCountQuery
-  , sourceCTEName
   , unquoted
   , ResultsWithCount
+  , pgFmtEnvVar
   ) where
 
 import qualified Hasql.Query             as H
@@ -32,23 +29,24 @@ import qualified Hasql.Decoders          as HD
 
 import qualified Data.Aeson              as JSON
 
+import           PostgREST.Config        (pgVersion96)
 import           PostgREST.RangeQuery    (NonnegRange, rangeLimit, rangeOffset, allRange)
 import           Data.Functor.Contravariant (contramap)
 import qualified Data.HashMap.Strict     as HM
-import           Data.Text               (intercalate, unwords, replace, isInfixOf, toLower, split)
+import           Data.Maybe
+import           Data.Text               (intercalate, unwords, replace, isInfixOf, toLower)
 import qualified Data.Text as T          (map, takeWhile, null)
 import qualified Data.Text.Encoding as T
 import           Data.Tree               (Tree(..))
 import qualified Data.Vector as V
 import           PostgREST.Types
-import qualified Data.Map as M
 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)
+import           Protolude hiding        (from, intercalate, ord, cast, replace)
 import           PostgREST.ApiRequest    (PreferRepresentation (..))
 
 {-| The generic query result format used by API responses. The location header
@@ -86,9 +84,9 @@ encodeUniformObjs :: HE.Params PayloadJSON
 encodeUniformObjs =
   contramap (JSON.Array . V.map JSON.Object . unPayloadJSON) (HE.value HE.json)
 
-createReadStatement :: SqlQuery -> SqlQuery -> Bool -> Bool -> Bool ->
+createReadStatement :: SqlQuery -> SqlQuery -> Bool -> Bool -> Bool -> Maybe FieldName ->
                        H.Query () ResultsWithCount
-createReadStatement selectQuery countQuery isSingle countTotal asCsv =
+createReadStatement selectQuery countQuery isSingle countTotal asCsv binaryField =
   unicodeStatement sql HE.unit decodeStandard False
  where
   sql = [qc|
@@ -104,6 +102,7 @@ createReadStatement selectQuery countQuery isSingle countTotal asCsv =
   bodyF
     | asCsv = asCsvF
     | isSingle = asJsonSingleF
+    | isJust binaryField = asBinaryF $ fromJust binaryField
     | otherwise = asJsonF
 
 createWriteStatement :: SqlQuery -> SqlQuery -> Bool -> Bool -> Bool ->
@@ -142,62 +141,53 @@ createWriteStatement selectQuery mutateQuery wantSingle wantHdrs asCsv rep pKeys
     | wantSingle = asJsonSingleF
     | otherwise = asJsonF
 
-type ProcResults = (Maybe Int64, Int64, ByteString)
-callProc :: QualifiedIdentifier -> JSON.Object -> SqlQuery -> SqlQuery -> NonnegRange -> Bool -> Bool -> Bool -> H.Query () (Maybe ProcResults)
-callProc qi params selectQuery countQuery _ countTotal isSingle paramsAsJson =
+type ProcResults = (Maybe Int64, Int64, ByteString, ByteString)
+callProc :: QualifiedIdentifier -> JSON.Object -> Bool -> SqlQuery -> SqlQuery -> Bool ->
+  Bool -> Bool -> Bool -> Bool -> Bool -> Maybe FieldName -> PgVersion -> H.Query () (Maybe ProcResults)
+callProc qi params returnsScalar selectQuery countQuery countTotal isSingle paramsAsJson asCsv asBinary isReadOnly binaryField pgVer =
   unicodeStatement sql HE.unit decodeProc True
   where
-    sql = [qc|
-            WITH {sourceCTEName} AS ({_callSql})
-            SELECT
-              {countResultF} AS total_result_set,
-              pg_catalog.count(_postgrest_t) AS page_total,
-              case
-                when pg_catalog.count(*) > 1 then
-                  {bodyF}
-                else
-                  coalesce(((array_agg(row_to_json(_postgrest_t)))[1]->{_procName})::character varying, {bodyF})
+    sql =
+     if returnsScalar then [qc|
+       WITH {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 {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;|]
 
-              end as body
-            FROM ({selectQuery}) _postgrest_t;
-          |]
-          -- FROM (select * from {sourceCTEName} {limitF range}) t;
-    countResultF = if countTotal then "("<>countQuery<>")" else "null::bigint" :: Text
-    _args = if paramsAsJson
+    countResultF = if countTotal then "( "<> countQuery <> ")" else "null::bigint" :: Text
+    _args = if paramsAsJson && not isReadOnly
                 then insertableValueWithType "json" $ JSON.Object params
                 else intercalate "," $ map _assignment (HM.toList params)
-    _procName = pgFmtLit $ qiName qi
+    _procName = qiName qi
     _assignment (n,v) = pgFmtIdent n <> ":=" <> insertableValue v
-    _callSql = [qc|select * from {fromQi qi}({_args}) |] :: Text
-    _countExpr = if countTotal
-                   then [qc|(select pg_catalog.count(*) from {sourceCTEName})|]
-                   else "null::bigint" :: Text
+    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
+    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
 
-operators :: [(Text, SqlFragment)]
-operators = [
-  ("eq", "="),
-  ("gte", ">="), -- has to be before gt (parsers)
-  ("gt", ">"),
-  ("lte", "<="), -- has to be before lt (parsers)
-  ("lt", "<"),
-  ("neq", "<>"),
-  ("like", "like"),
-  ("ilike", "ilike"),
-  ("in", "in"),
-  ("notin", "not in"),
-  ("isnot", "is not"), -- has to be before is (parsers)
-  ("is", "is"),
-  ("@@", "@@"),
-  ("@>", "@>"),
-  ("<@", "<@")
-  ]
-
 pgFmtIdent :: SqlFragment -> SqlFragment
 pgFmtIdent x = "\"" <> replace "\"" "\"\"" (trimNullChars $ toS x) <> "\""
 
@@ -212,35 +202,33 @@ pgFmtLit x =
 
 requestToCountQuery :: Schema -> DbRequest -> SqlQuery
 requestToCountQuery _ (DbMutate _) = undefined
-requestToCountQuery schema (DbRead (Node (Select _ _ conditions _ _, (mainTbl, _, _)) _)) =
+requestToCountQuery schema (DbRead (Node (Select _ _ logicForest _ _, (mainTbl, _, _, _)) _)) =
  unwords [
    "SELECT pg_catalog.count(*)",
    "FROM ", fromQi qi,
-   ("WHERE " <> intercalate " AND " ( map (pgFmtCondition qi) localConditions )) `emptyOnNull` localConditions
+    ("WHERE " <> intercalate " AND " (map (pgFmtLogicTree qi) filteredLogic)) `emptyOnFalse` null filteredLogic
    ]
  where
-   qi = if mainTbl == sourceCTEName
-     then QualifiedIdentifier "" mainTbl
-     else QualifiedIdentifier schema mainTbl
-   fn Filter{value=VText _} = True
-   fn Filter{value=VForeignKey _ _} = False
-   localConditions = filter fn conditions
+   qi = removeSourceCTESchema schema mainTbl
+   -- all foreing key filters are root nodes(see addFilterToLogicForest), only those are filtered
+   nonFKRoot :: LogicTree -> Bool
+   nonFKRoot (Stmnt (Filter _ (OpExpr _ (Join _ _)))) = False
+   nonFKRoot (Stmnt _) = True
+   nonFKRoot Expr{} = True
+   filteredLogic = filter nonFKRoot logicForest
 
 requestToQuery :: Schema -> Bool -> DbRequest -> SqlQuery
-requestToQuery schema isParent (DbRead (Node (Select colSelects tbls conditions ord range, (nodeName, maybeRelation, _)) forest)) =
+requestToQuery schema isParent (DbRead (Node (Select colSelects tbls logicForest ord range, (nodeName, maybeRelation, _, _)) forest)) =
   query
   where
-    -- TODO! the following helper functions are just to remove the "schema" part when the table is "source" which is the name
-    -- of our WITH query part
     mainTbl = fromMaybe nodeName (tableName . relTable <$> maybeRelation)
-    tblSchema tbl = if tbl == sourceCTEName then "" else schema
-    qi = QualifiedIdentifier (tblSchema mainTbl) mainTbl
-    toQi t = QualifiedIdentifier (tblSchema t) t
+    qi = removeSourceCTESchema schema mainTbl
+    toQi = removeSourceCTESchema schema
     query = unwords [
       "SELECT ", intercalate ", " (map (pgFmtSelectItem qi) colSelects ++ selects),
       "FROM ", intercalate ", " (map (fromQi . toQi) tbls),
       unwords joins,
-      ("WHERE " <> intercalate " AND " ( map (pgFmtCondition qi ) conditions )) `emptyOnNull` conditions,
+      ("WHERE " <> intercalate " AND " (map (pgFmtLogicTree qi) logicForest)) `emptyOnFalse` null logicForest,
       orderF (fromMaybe [] ord),
       if isParent then "" else limitF range
       ]
@@ -258,27 +246,24 @@ requestToQuery schema isParent (DbRead (Node (Select colSelects tbls conditions
     (joins, selects) = foldr getQueryParts ([],[]) forest
 
     getQueryParts :: Tree ReadNode -> ([SqlFragment], [SqlFragment]) -> ([SqlFragment], [SqlFragment])
-    getQueryParts (Node n@(_, (name, Just Relation{relType=Child,relTable=Table{tableName=table}}, alias)) forst) (j,s) = (j,sel:s)
+    getQueryParts (Node n@(_, (name, Just Relation{relType=Child,relTable=Table{tableName=table}}, alias, _)) forst) (j,s) = (j,sel:s)
       where
         sel = "COALESCE(("
-           <> "SELECT array_to_json(array_agg(row_to_json("<>pgFmtIdent table<>"))) "
+           <> "SELECT json_agg(" <> pgFmtIdent table <> ".*) "
            <> "FROM (" <> subquery <> ") " <> pgFmtIdent table
            <> "), '[]') AS " <> pgFmtIdent (fromMaybe name alias)
            where subquery = requestToQuery schema False (DbRead (Node n forst))
-    getQueryParts (Node n@(_, (name, Just r@Relation{relType=Parent,relTable=Table{tableName=table}}, alias)) forst) (j,s) = (joi:j,sel:s)
+    getQueryParts (Node n@(_, (name, Just Relation{relType=Parent,relTable=Table{tableName=table}}, alias, _)) forst) (j,s) = (joi:j,sel:s)
       where
-        node_name = fromMaybe name alias
-        local_table_name = table <> "_" <> node_name
-        replaceTableName localTableName (Filter a b (VForeignKey (QualifiedIdentifier "" _) c)) = Filter a b (VForeignKey (QualifiedIdentifier "" localTableName) c)
-        replaceTableName _ x = x
-        sel = "row_to_json(" <> pgFmtIdent local_table_name <> ".*) AS " <> pgFmtIdent node_name
-        joi = " LEFT OUTER JOIN ( " <> subquery <> " ) AS " <> pgFmtIdent local_table_name  <>
-              " ON " <> intercalate " AND " ( map (pgFmtCondition qi . replaceTableName local_table_name) (getJoinConditions r) )
+        aliasOrName = fromMaybe name alias
+        localTableName = pgFmtIdent $ table <> "_" <> aliasOrName
+        sel = "row_to_json(" <> localTableName <> ".*) AS " <> pgFmtIdent aliasOrName
+        joi = " LEFT JOIN LATERAL( " <> subquery <> " ) AS " <> localTableName <> " ON TRUE "
           where subquery = requestToQuery schema True (DbRead (Node n forst))
-    getQueryParts (Node n@(_, (name, Just Relation{relType=Many,relTable=Table{tableName=table}}, alias)) forst) (j,s) = (j,sel:s)
+    getQueryParts (Node n@(_, (name, Just Relation{relType=Many,relTable=Table{tableName=table}}, alias, _)) forst) (j,s) = (j,sel:s)
       where
         sel = "COALESCE (("
-           <> "SELECT array_to_json(array_agg(row_to_json("<>pgFmtIdent table<>"))) "
+           <> "SELECT json_agg(" <> pgFmtIdent table <> ".*) "
            <> "FROM (" <> subquery <> ") " <> pgFmtIdent table
            <> "), '[]') AS " <> pgFmtIdent (fromMaybe name alias)
            where subquery = requestToQuery schema False (DbRead (Node n forst))
@@ -298,10 +283,10 @@ requestToQuery schema _ (DbMutate (Insert mainTbl (PayloadJSON rows) returnings)
           if T.null colsString
             then if V.null rows then ["SELECT null WHERE false"] else ["DEFAULT VALUES"]
             else ["SELECT", colsString, "FROM json_populate_recordset(null::" , fromQi qi, ", $1)"]
-        ret = if null returnings 
+        ret = if null returnings
                   then ""
                   else unwords [" RETURNING ", intercalate ", " (map (pgFmtColumn qi) returnings)]
-requestToQuery schema _ (DbMutate (Update mainTbl (PayloadJSON rows) conditions returnings)) =
+requestToQuery schema _ (DbMutate (Update mainTbl (PayloadJSON rows) logicForest returnings)) =
   case rows V.!? 0 of
     Just obj ->
       let assignments = map
@@ -309,24 +294,24 @@ requestToQuery schema _ (DbMutate (Update mainTbl (PayloadJSON rows) conditions
       unwords [
         "UPDATE ", fromQi qi,
         " SET " <> intercalate "," assignments <> " ",
-        ("WHERE " <> intercalate " AND " ( map (pgFmtCondition qi ) conditions )) `emptyOnNull` conditions,
-        ("RETURNING " <> intercalate ", " (map (pgFmtColumn qi) returnings)) `emptyOnNull` returnings
+        ("WHERE " <> intercalate " AND " (map (pgFmtLogicTree qi) logicForest)) `emptyOnFalse` null logicForest,
+        ("RETURNING " <> intercalate ", " (map (pgFmtColumn qi) returnings)) `emptyOnFalse` null returnings
         ]
     Nothing -> undefined
   where
     qi = QualifiedIdentifier schema mainTbl
-requestToQuery schema _ (DbMutate (Delete mainTbl conditions returnings)) =
+requestToQuery schema _ (DbMutate (Delete mainTbl logicForest returnings)) =
   query
   where
     qi = QualifiedIdentifier schema mainTbl
     query = unwords [
       "DELETE FROM ", fromQi qi,
-      ("WHERE " <> intercalate " AND " ( map (pgFmtCondition qi ) conditions )) `emptyOnNull` conditions,
-      ("RETURNING " <> intercalate ", " (map (pgFmtColumn qi) returnings)) `emptyOnNull` returnings
+      ("WHERE " <> intercalate " AND " (map (pgFmtLogicTree qi) logicForest)) `emptyOnFalse` null logicForest,
+      ("RETURNING " <> intercalate ", " (map (pgFmtColumn qi) returnings)) `emptyOnFalse` null returnings
       ]
 
-sourceCTEName :: SqlFragment
-sourceCTEName = "pg_source"
+removeSourceCTESchema :: Schema -> TableName -> QualifiedIdentifier
+removeSourceCTESchema schema tbl = QualifiedIdentifier (if tbl == sourceCTEName then "" else schema) tbl
 
 unquoted :: JSON.Value -> Text
 unquoted (JSON.String t) = t
@@ -351,11 +336,14 @@ asCsvF = asCsvHeaderF <> " || '\n' || " <> asCsvBodyF
     asCsvBodyF = "coalesce(string_agg(substring(_postgrest_t::text, 2, length(_postgrest_t::text) - 2), '\n'), '')"
 
 asJsonF :: SqlFragment
-asJsonF = "coalesce(array_to_json(array_agg(row_to_json(_postgrest_t))), '[]')::character varying"
+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 =
     "(" <>
@@ -382,26 +370,11 @@ fromQi t = (if s == "" then "" else pgFmtIdent s <> ".") <> pgFmtIdent n
     n = qiName t
     s = qiSchema t
 
-getJoinConditions :: Relation -> [Filter]
-getJoinConditions (Relation t cols ft fcs typ lt lc1 lc2) =
-  case typ of
-    Child  -> zipWith (toFilter tN ftN) cols fcs
-    Parent -> zipWith (toFilter tN ftN) cols fcs
-    Many   -> zipWith (toFilter tN ltN) cols (fromMaybe [] lc1) ++ zipWith (toFilter ftN ltN) fcs (fromMaybe [] lc2)
-    Root   -> undefined --error "undefined getJoinConditions"
-  where
-    s = if typ == Parent then "" else tableSchema t
-    tN = tableName t
-    ftN = tableName ft
-    ltN = fromMaybe "" (tableName <$> lt)
-    toFilter :: Text -> Text -> Column -> Column -> Filter
-    toFilter tb ftb c fc = Filter (colName c, Nothing) "=" (VForeignKey (QualifiedIdentifier s tb) (ForeignKey fc{colTable=(colTable fc){tableName=ftb}}))
-
 unicodeStatement :: Text -> HE.Params a -> HD.Result b -> Bool -> H.Query a b
 unicodeStatement = H.statement . T.encodeUtf8
 
-emptyOnNull :: Text -> [a] -> Text
-emptyOnNull val x = if null x then "" else val
+emptyOnFalse :: Text -> Bool -> Text
+emptyOnFalse val cond = if cond then "" else val
 
 insertableValue :: JSON.Value -> SqlFragment
 insertableValue JSON.Null = "null"
@@ -411,11 +384,6 @@ insertableValueWithType :: Text -> JSON.Value -> SqlFragment
 insertableValueWithType t v =
   pgFmtLit (unquoted v) <> "::" <> t
 
-whiteList :: Text -> SqlFragment
-whiteList val = fromMaybe
-  (toS (pgFmtLit val) <> "::unknown ")
-  (find ((==) . toLower $ val) ["null","true","false"])
-
 pgFmtColumn :: QualifiedIdentifier -> Text -> SqlFragment
 pgFmtColumn table "*" = fromQi table <> ".*"
 pgFmtColumn table c = fromQi table <> "." <> pgFmtIdent c
@@ -424,48 +392,48 @@ 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
+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
 
-pgFmtCondition :: QualifiedIdentifier -> Filter -> SqlFragment
-pgFmtCondition table (Filter (col,jp) ops val) =
-  notOp <> " " <> sqlCol  <> " " <> pgFmtOperator opCode <> " " <>
-    if opCode `elem` ["is","isnot"] then whiteList (getInner val) else sqlValue
-  where
-    headPredicate:rest = split (=='.') ops
-    hasNot caseTrue caseFalse = if headPredicate == "not" then caseTrue else caseFalse
-    opCode      = hasNot (headDef "eq" rest) headPredicate
-    notOp       = hasNot headPredicate ""
-    sqlCol = case val of
-      VText _ -> pgFmtColumn table col <> pgFmtJsonPath jp
-      VForeignKey qi _ -> pgFmtColumn qi col
-    sqlValue = valToStr val
-    getInner v = case v of
-      VText s -> s
-      _      -> ""
-    valToStr v = case v of
-      VText s -> pgFmtValue opCode s
-      VForeignKey (QualifiedIdentifier s _) (ForeignKey Column{colTable=Table{tableName=ft}, colName=fc}) -> pgFmtColumn qi fc
-        where qi = QualifiedIdentifier (if ft == sourceCTEName then "" else s) ft
-      _ -> ""
+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
 
-pgFmtValue :: Text -> Text -> SqlFragment
-pgFmtValue opCode val =
- case opCode of
-   "like" -> unknownLiteral $ T.map star val
-   "ilike" -> unknownLiteral $ T.map star val
-   "in" -> "(" <> intercalate ", " (map unknownLiteral $ split (==',') val) <> ") "
-   "notin" -> "(" <> intercalate ", " (map unknownLiteral $ split (==',') val) <> ") "
-   "@@" -> "to_tsquery(" <> unknownLiteral 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
+       <> ") "
+
+   Join fQi (ForeignKey Column{colTable=Table{tableName=fTableName}, colName=fColName}) ->
+     pgFmtField fQi fld <> " = " <> pgFmtColumn (removeSourceCTESchema (qiSchema fQi) fTableName) fColName
  where
+   pgFmtFieldOp op = pgFmtField table fld <> " " <> sqlOperator op
+   sqlOperator o = HM.lookupDefault "=" o operators
+   notOp = if hasNot then "NOT" else ""
    star c = if c == '*' then '%' else c
    unknownLiteral = (<> "::unknown ") . pgFmtLit
+   whiteList :: Text -> SqlFragment
+   whiteList v = fromMaybe
+     (toS (pgFmtLit v) <> "::unknown ")
+     (find ((==) . toLower $ v) ["null","true","false"])
 
-pgFmtOperator :: Text -> SqlFragment
-pgFmtOperator opCode = fromMaybe "=" $ M.lookup opCode operatorsMap
-  where
-    operatorsMap = M.fromList operators
+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
@@ -479,5 +447,9 @@ pgFmtAs (Just xx) Nothing = case lastMay xx of
   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/Types.hs

@@ -1,18 +1,37 @@
+{-# LANGUAGE DuplicateRecordFields    #-}
 module PostgREST.Types where
 import           Protolude
 import qualified GHC.Show
 import           Data.Aeson
 import qualified Data.ByteString.Lazy as BL
+import qualified Data.CaseInsensitive as CI
+import qualified Data.HashMap.Strict  as M
 import           Data.Tree
 import qualified Data.Vector          as V
 import           PostgREST.RangeQuery (NonnegRange)
+import           Network.HTTP.Types.Header (hContentType, Header)
+
+-- | Enumeration of currently supported response content types
+data ContentType = CTApplicationJSON | CTTextCSV | CTOpenAPI
+                 | CTSingularJSON | CTOctetStream
+                 | CTAny | CTOther ByteString deriving Eq
+
+data ApiRequestError = ActionInappropriate
+                     | InvalidBody ByteString
+                     | InvalidRange
+                     | ParseRequestError Text Text
+                     | UnknownRelation
+                     | NoRelationBetween Text Text
+                     | UnsupportedVerb
+                     deriving (Show, Eq)
 
 data DbStructure = DbStructure {
   dbTables      :: [Table]
 , dbColumns     :: [Column]
 , dbRelations   :: [Relation]
 , dbPrimaryKeys :: [PrimaryKey]
-, dbProcs       :: [(Text,ProcDescription)]
+, dbProcs       :: M.HashMap Text ProcDescription
+, pgVersion     :: PgVersion
 } deriving (Show, Eq)
 
 data PgArg = PgArg {
@@ -21,10 +40,19 @@ data PgArg = PgArg {
 , pgaReq  :: Bool
 } deriving (Show, Eq)
 
+data PgType = Scalar QualifiedIdentifier | Composite QualifiedIdentifier deriving (Eq, Show)
+
+data RetType = Single PgType | SetOf PgType deriving (Eq, Show)
+
+data ProcVolatility = Volatile | Stable | Immutable
+  deriving (Eq, Show)
+
 data ProcDescription = ProcDescription {
-  pdName       :: Text
-, pdArgs       :: [PgArg]
-, pdReturnType :: Text
+  pdName        :: Text
+, pdDescription :: Maybe Text
+, pdArgs        :: [PgArg]
+, pdReturnType  :: RetType
+, pdVolatility  :: ProcVolatility
 } deriving (Show, Eq)
 
 type Schema = Text
@@ -34,29 +62,29 @@ type SqlFragment = Text
 type RequestBody = BL.ByteString
 
 data Table = Table {
-  tableSchema     :: Schema
-, tableName       :: TableName
-, tableInsertable :: Bool
+  tableSchema      :: Schema
+, tableName        :: TableName
+, tableDescription :: Maybe Text
+, tableInsertable  :: Bool
 } deriving (Show, Ord)
 
-data ForeignKey = ForeignKey { fkCol :: Column } deriving (Show, Eq, Ord)
+newtype ForeignKey = ForeignKey { fkCol :: Column } deriving (Show, Eq, Ord)
 
 data Column =
     Column {
-      colTable     :: Table
-    , colName      :: Text
-    , colPosition  :: Int32
-    , colNullable  :: Bool
-    , colType      :: Text
-    , colUpdatable :: Bool
-    , colMaxLen    :: Maybe Int32
-    , colPrecision :: Maybe Int32
-    , colDefault   :: Maybe Text
-    , colEnum      :: [Text]
-    , colFK        :: Maybe ForeignKey
-    }
-  | Star { colTable :: Table }
-  deriving (Show, Ord)
+      colTable       :: Table
+    , colName        :: Text
+    , colDescription :: Maybe Text
+    , colPosition    :: Int32
+    , colNullable    :: Bool
+    , colType        :: Text
+    , colUpdatable   :: Bool
+    , colMaxLen      :: Maybe Int32
+    , colPrecision   :: Maybe Int32
+    , colDefault     :: Maybe Text
+    , colEnum        :: [Text]
+    , colFK          :: Maybe ForeignKey
+    } deriving (Show, Ord)
 
 type Synonym = (Column,Column)
 
@@ -88,6 +116,12 @@ data QualifiedIdentifier = QualifiedIdentifier {
 
 
 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.
+-}
 data Relation = Relation {
   relTable    :: Table
 , relColumns  :: [Column]
@@ -115,60 +149,134 @@ data Proxy = Proxy {
 } deriving (Show, Eq)
 
 type Operator = Text
-data FValue = VText Text | VForeignKey QualifiedIdentifier ForeignKey deriving (Show, Eq)
+operators :: M.HashMap Operator SqlFragment
+operators = M.union (M.fromList [
+  ("eq", "="),
+  ("gte", ">="),
+  ("gt", ">"),
+  ("lte", "<="),
+  ("lt", "<"),
+  ("neq", "<>"),
+  ("like", "LIKE"),
+  ("ilike", "ILIKE"),
+  ("in", "IN"),
+  ("is", "IS"),
+  ("cs", "@>"),
+  ("cd", "<@"),
+  ("ov", "&&"),
+  ("sl", "<<"),
+  ("sr", ">>"),
+  ("nxr", "&<"),
+  ("nxl", "&>"),
+  ("adj", "-|-"),
+  -- TODO: these are deprecated and should be removed in v0.5.0.0
+  ("@>", "@>"),
+  ("<@", "<@")]) ftsOperators
+
+ftsOperators :: M.HashMap Operator SqlFragment
+ftsOperators = M.fromList [
+  ("@@", "@@ to_tsquery"), -- TODO: '@@' deprecated
+  ("fts", "@@ to_tsquery"),
+  ("plfts", "@@ plainto_tsquery"),
+  ("phfts", "@@ phraseto_tsquery")
+  ]
+
+data OpExpr = OpExpr Bool Operation deriving (Eq, Show)
+data Operation = Op Operator SingleVal |
+                 In ListVal |
+                 Fts Operator (Maybe Language) SingleVal |
+                 Join QualifiedIdentifier ForeignKey deriving (Eq, Show)
+type Language = Text
+
+-- | Represents a single value in a filter, e.g. id=eq.singleval
+type SingleVal = Text
+-- | Represents a list value in a filter, e.g. id=in.(val1,val2,val3)
+type ListVal = [Text]
+
+data LogicOperator = And | Or deriving Eq
+instance Show LogicOperator where
+  show And  = "AND"
+  show Or = "OR"
+{-|
+  Boolean logic expression tree e.g. "and(name.eq.N,or(id.eq.1,id.eq.2))" is:
+
+            And
+           /   \
+  name.eq.N     Or
+               /  \
+         id.eq.1   id.eq.2
+-}
+data LogicTree = Expr Bool LogicOperator [LogicTree] | Stmnt Filter deriving (Show, Eq)
+
 type FieldName = Text
 type JsonPath = [Text]
 type Field = (FieldName, Maybe JsonPath)
 type Alias = Text
 type Cast = Text
 type NodeName = Text
-type SelectItem = (Field, Maybe Cast, Maybe Alias)
-type Path = [Text]
-data ReadQuery = Select { select::[SelectItem], from::[TableName], flt_::[Filter], order::Maybe [OrderTerm], range_::NonnegRange } deriving (Show, Eq)
+
+-- Rpc query param, only used for GET rpcs
+type RpcQParam = (Text, Text)
+
+{-|
+  Custom guc header, it's obtained by parsing the json in a:
+  `SET LOCAL "response.headers" = '[{"Set-Cookie": ".."}]'
+-}
+newtype GucHeader = GucHeader (Text, Text)
+
+instance FromJSON GucHeader where
+  parseJSON (Object o) = case headMay (M.toList o) of
+    Just (k, String s) | M.size o == 1 -> pure $ GucHeader (k, s)
+                       | otherwise     -> mzero
+    _ -> mzero
+  parseJSON _          = mzero
+
+toHeaders :: [GucHeader] -> [Header]
+toHeaders = map $ \(GucHeader (k, v)) -> (CI.mk $ toS k, toS v)
+
+{-|
+  This type will hold information about which particular 'Relation' between two tables to choose when there are multiple ones.
+  Specifically, it will contain the name of the foreign key or the join table in many to many relations.
+-}
+type RelationDetail = Text
+type SelectItem = (Field, Maybe Cast, Maybe Alias, Maybe 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 ReadQuery = Select { select::[SelectItem], from::[TableName], where_::[LogicTree], order::Maybe [OrderTerm], range_::NonnegRange } deriving (Show, Eq)
 data MutateQuery = Insert { in_::TableName, qPayload::PayloadJSON, returning::[FieldName] }
-                 | Delete { in_::TableName, where_::[Filter], returning::[FieldName] }
-                 | Update { in_::TableName, qPayload::PayloadJSON, where_::[Filter], returning::[FieldName] } deriving (Show, Eq)
-data Filter = Filter {field::Field, operator::Operator, value::FValue} deriving (Show, Eq)
-type ReadNode = (ReadQuery, (NodeName, Maybe Relation, Maybe Alias))
+                 | Delete { in_::TableName, where_::[LogicTree], returning::[FieldName] }
+                 | Update { in_::TableName, qPayload::PayloadJSON, where_::[LogicTree], returning::[FieldName] } deriving (Show, Eq)
+type ReadNode = (ReadQuery, (NodeName, Maybe Relation, Maybe Alias, Maybe RelationDetail))
 type ReadRequest = Tree ReadNode
 type MutateRequest = MutateQuery
 data DbRequest = DbRead ReadRequest | DbMutate MutateRequest
 
-
-instance ToJSON Column where
-  toJSON c = object [
-      "schema"    .= tableSchema t
-    , "name"      .= colName c
-    , "position"  .= colPosition c
-    , "nullable"  .= colNullable c
-    , "type"      .= colType c
-    , "updatable" .= colUpdatable c
-    , "maxLen"    .= colMaxLen c
-    , "precision" .= colPrecision c
-    , "references".= colFK c
-    , "default"   .= colDefault c
-    , "enum"      .= colEnum c ]
-    where
-      t = colTable c
-
-instance ToJSON ForeignKey where
-  toJSON fk = object [
-      "schema" .= tableSchema t
-    , "table"  .= tableName t
-    , "column" .= colName c ]
-    where
-      c = fkCol fk
-      t = colTable c
-
-instance ToJSON Table where
-  toJSON v = object [
-      "schema"     .= tableSchema v
-    , "name"       .= tableName v
-    , "insertable" .= tableInsertable v ]
-
 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
-  _ == _ = False
+
+-- | 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)
+
+sourceCTEName :: SqlFragment
+sourceCTEName = "pg_source"

stack.yaml

@@ -1,8 +1,11 @@
-resolver: lts-7.4
+resolver: lts-9.6
 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
-  - hasql-pool-0.4.1
-  - hasql-transaction-0.5
+  - protolude-0.2
 ghc-options:
   postgrest: -O2 -Werror -Wall -fwarn-identities -fno-warn-redundant-constraints
 nix:

test/Feature/AndOrParamsSpec.hs

@@ -0,0 +1,237 @@
+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 SpecHelper
+import Protolude hiding (get)
+
+
+spec :: SpecWith Application
+spec =
+  describe "and/or params used for complex boolean logic" $ do
+    context "used with GET" $ do
+      context "or param" $ do
+        it "can do simple logic" $
+          get "/entities?or=(id.eq.1,id.eq.2)&select=id" `shouldRespondWith`
+            [json|[{ "id": 1 }, { "id": 2 }]|] { matchHeaders = [matchContentTypeJson] }
+        it "can negate simple logic" $
+          get "/entities?not.or=(id.eq.1,id.eq.2)&select=id" `shouldRespondWith`
+            [json|[{ "id": 3 }, { "id": 4 }]|] { matchHeaders = [matchContentTypeJson] }
+        it "can be combined with traditional filters" $
+          get "/entities?or=(id.eq.1,id.eq.2)&name=eq.entity 1&select=id" `shouldRespondWith`
+            [json|[{ "id": 1 }]|] { matchHeaders = [matchContentTypeJson] }
+
+      context "embedded levels" $ do
+        it "can do logic on the second level" $
+          get "/entities?child_entities.or=(id.eq.1,name.eq.child entity 2)&select=id,child_entities{id}" `shouldRespondWith`
+            [json|[
+              {"id": 1, "child_entities": [ { "id": 1 }, { "id": 2 } ] }, { "id": 2, "child_entities": []},
+              {"id": 3, "child_entities": []}, {"id": 4, "child_entities": []}
+            ]|] { matchHeaders = [matchContentTypeJson] }
+        it "can do logic on the third level" $
+          get "/entities?child_entities.grandchild_entities.or=(id.eq.1,id.eq.2)&select=id,child_entities{id,grandchild_entities{id}}" `shouldRespondWith`
+            [json|[
+              {"id": 1, "child_entities": [ { "id": 1, "grandchild_entities": [ { "id": 1 }, { "id": 2 } ]}, { "id": 2, "grandchild_entities": []}]},
+              {"id": 2, "child_entities": [ { "id": 3, "grandchild_entities": []} ]},
+              {"id": 3, "child_entities": []}, {"id": 4, "child_entities": []}
+            ]|] { matchHeaders = [matchContentTypeJson] }
+
+      context "and/or params combined" $ do
+        it "can be nested inside the same expression" $
+          get "/entities?or=(and(name.eq.entity 2,id.eq.2),and(name.eq.entity 1,id.eq.1))&select=id" `shouldRespondWith`
+            [json|[{ "id": 1 }, { "id": 2 }]|] { matchHeaders = [matchContentTypeJson] }
+        it "can be negated while nested" $
+          get "/entities?or=(not.and(name.eq.entity 2,id.eq.2),not.and(name.eq.entity 1,id.eq.1))&select=id" `shouldRespondWith`
+            [json|[{ "id": 1 }, { "id": 2 }, { "id": 3 }, { "id": 4 }]|] { matchHeaders = [matchContentTypeJson] }
+        it "can be combined unnested" $
+          get "/entities?and=(id.eq.1,name.eq.entity 1)&or=(id.eq.1,id.eq.2)&select=id" `shouldRespondWith`
+            [json|[{ "id": 1 }]|] { matchHeaders = [matchContentTypeJson] }
+
+      context "operators inside and/or" $ do
+        it "can handle eq and neq" $
+          get "/entities?and=(id.eq.1,id.neq.2))&select=id" `shouldRespondWith`
+            [json|[{ "id": 1 }]|] { matchHeaders = [matchContentTypeJson] }
+        it "can handle lt and gt" $
+          get "/entities?or=(id.lt.2,id.gt.3)&select=id" `shouldRespondWith`
+            [json|[{ "id": 1 }, { "id": 4 }]|] { matchHeaders = [matchContentTypeJson] }
+        it "can handle lte and gte" $
+          get "/entities?or=(id.lte.2,id.gte.3)&select=id" `shouldRespondWith`
+            [json|[{ "id": 1 }, { "id": 2 }, { "id": 3 }, { "id": 4 }]|] { matchHeaders = [matchContentTypeJson] }
+        it "can handle like and ilike" $
+          get "/entities?or=(name.like.*1,name.ilike.*ENTITY 2)&select=id" `shouldRespondWith`
+            [json|[{ "id": 1 }, { "id": 2 }]|] { matchHeaders = [matchContentTypeJson] }
+        it "can handle in" $
+          get "/entities?or=(id.in.(1,2),id.in.(3,4))&select=id" `shouldRespondWith`
+            [json|[{ "id": 1 }, { "id": 2 }, { "id": 3 }, { "id": 4 }]|] { matchHeaders = [matchContentTypeJson] }
+        it "can handle is" $
+          get "/entities?and=(name.is.null,arr.is.null)&select=id" `shouldRespondWith`
+            [json|[{ "id": 4 }]|] { matchHeaders = [matchContentTypeJson] }
+        it "can handle fts" $ do
+          get "/entities?or=(text_search_vector.fts.bar,text_search_vector.fts.baz)&select=id" `shouldRespondWith`
+            [json|[{ "id": 1 }, { "id": 2 }]|] { matchHeaders = [matchContentTypeJson] }
+          get "/tsearch?or=(text_search_vector.plfts(german).Art%20Spass, text_search_vector.plfts(french).amusant%20impossible, text_search_vector.fts(english).impossible)" `shouldRespondWith`
+            [json|[
+              {"text_search_vector": "'fun':5 'imposs':9 'kind':3" },
+              {"text_search_vector": "'amus':5 'fair':7 'impossibl':9 'peu':4" },
+              {"text_search_vector": "'art':4 'spass':5 'unmog':7"}
+            ]|] { matchHeaders = [matchContentTypeJson] }
+          -- TODO: remove in 0.5.0 as deprecated
+          get "/entities?or=(text_search_vector.@@.bar,text_search_vector.@@.baz)&select=id" `shouldRespondWith`
+            [json|[{ "id": 1 }, { "id": 2 }]|] { matchHeaders = [matchContentTypeJson] }
+        it "can handle cs and cd" $ do
+          get "/entities?or=(arr.cs.{1,2,3},arr.cd.{1})&select=id" `shouldRespondWith`
+            [json|[{ "id": 1 },{ "id": 3 }]|] { matchHeaders = [matchContentTypeJson] }
+          -- TODO: remove in 0.5.0 as deprecated
+          get "/entities?or=(arr.@>.{1,2,3},arr.<@.{1})&select=id" `shouldRespondWith`
+            [json|[{ "id": 1 },{ "id": 3 }]|] { matchHeaders = [matchContentTypeJson] }
+
+        it "can handle range operators" $ do
+          get "/ranges?range=eq.[1,3]&select=id" `shouldRespondWith`
+            [json|[{ "id": 1 }]|] { matchHeaders = [matchContentTypeJson] }
+          get "/ranges?range=neq.[1,3]&select=id" `shouldRespondWith`
+            [json|[{ "id": 2 }, { "id": 3 }, { "id": 4 }]|] { matchHeaders = [matchContentTypeJson] }
+          get "/ranges?range=lt.[1,10]&select=id" `shouldRespondWith`
+            [json|[{ "id": 1 }]|] { matchHeaders = [matchContentTypeJson] }
+          get "/ranges?range=gt.[8,11]&select=id" `shouldRespondWith`
+            [json|[{ "id": 4 }]|] { matchHeaders = [matchContentTypeJson] }
+          get "/ranges?range=lte.[1,3]&select=id" `shouldRespondWith`
+            [json|[{ "id": 1 }]|] { matchHeaders = [matchContentTypeJson] }
+          get "/ranges?range=gte.[2,3]&select=id" `shouldRespondWith`
+            [json|[{ "id": 2 }, { "id": 3 }, { "id": 4 }]|] { matchHeaders = [matchContentTypeJson] }
+          get "/ranges?range=cs.[1,2]&select=id" `shouldRespondWith`
+            [json|[{ "id": 1 }]|] { matchHeaders = [matchContentTypeJson] }
+          get "/ranges?range=cd.[1,6]&select=id" `shouldRespondWith`
+            [json|[{ "id": 1 }, { "id": 2 }]|] { matchHeaders = [matchContentTypeJson] }
+          get "/ranges?range=ov.[0,4]&select=id" `shouldRespondWith`
+            [json|[{ "id": 1 }, { "id": 2 }]|] { matchHeaders = [matchContentTypeJson] }
+          get "/ranges?range=sl.[9,10]&select=id" `shouldRespondWith`
+            [json|[{ "id": 1 }, { "id": 2 }]|] { matchHeaders = [matchContentTypeJson] }
+          get "/ranges?range=sr.[3,4]&select=id" `shouldRespondWith`
+            [json|[{ "id": 3 }, { "id": 4 }]|] { matchHeaders = [matchContentTypeJson] }
+          get "/ranges?range=nxr.[4,7]&select=id" `shouldRespondWith`
+            [json|[{ "id": 1 }, { "id": 2 }]|] { matchHeaders = [matchContentTypeJson] }
+          get "/ranges?range=nxl.[4,7]&select=id" `shouldRespondWith`
+            [json|[{ "id": 3 }, { "id": 4 }]|] { matchHeaders = [matchContentTypeJson] }
+          get "/ranges?range=adj.(3,10]&select=id" `shouldRespondWith`
+            [json|[{ "id": 1 }]|] { matchHeaders = [matchContentTypeJson] }
+
+        context "operators with not" $ do
+          it "eq, cs, like can be negated" $ do
+            get "/entities?and=(arr.not.cs.{1,2,3},and(id.not.eq.2,name.not.like.*3))&select=id" `shouldRespondWith`
+              [json|[{ "id": 1}]|] { matchHeaders = [matchContentTypeJson] }
+            -- TODO: remove in 0.5.0 as deprecated
+            get "/entities?and=(arr.not.@>.{1,2,3},and(id.not.eq.2,name.not.like.*3))&select=id" `shouldRespondWith`
+              [json|[{ "id": 1}]|] { matchHeaders = [matchContentTypeJson] }
+          it "in, is, fts can be negated" $ do
+            get "/entities?and=(id.not.in.(1,3),and(name.not.is.null,text_search_vector.not.fts.foo))&select=id" `shouldRespondWith`
+              [json|[{ "id": 2}]|] { matchHeaders = [matchContentTypeJson] }
+            -- TODO: remove in 0.5.0 as deprecated
+            get "/entities?and=(id.not.in.(1,3),and(name.not.is.null,text_search_vector.not.@@.foo))&select=id" `shouldRespondWith`
+              [json|[{ "id": 2}]|] { matchHeaders = [matchContentTypeJson] }
+          it "lt, gte, cd can be negated" $ do
+            get "/entities?and=(arr.not.cd.{1},or(id.not.lt.1,id.not.gte.3))&select=id" `shouldRespondWith`
+              [json|[{"id": 2}, {"id": 3}]|] { matchHeaders = [matchContentTypeJson] }
+            -- TODO: remove in 0.5.0 as deprecated
+            get "/entities?and=(arr.not.<@.{1},or(id.not.lt.1,id.not.gte.3))&select=id" `shouldRespondWith`
+              [json|[{"id": 2}, {"id": 3}]|] { matchHeaders = [matchContentTypeJson] }
+          it "gt, lte, ilike can be negated" $
+            get "/entities?and=(name.not.ilike.*ITY2,or(id.not.gt.4,id.not.lte.1))&select=id" `shouldRespondWith`
+              [json|[{"id": 1}, {"id": 2}, {"id": 3}]|] { matchHeaders = [matchContentTypeJson] }
+
+      context "and/or params with quotes" $ do
+        it "eq can have quotes" $
+          get "/grandchild_entities?or=(name.eq.\"(grandchild,entity,4)\",name.eq.\"(grandchild,entity,5)\")&select=id" `shouldRespondWith`
+            [json|[{ "id": 4 }, { "id": 5 }]|] { matchHeaders = [matchContentTypeJson] }
+        it "like and ilike can have quotes" $
+          get "/grandchild_entities?or=(name.like.\"*ity,4*\",name.ilike.\"*ITY,5)\")&select=id" `shouldRespondWith`
+            [json|[{ "id": 4 }, { "id": 5 }]|] { matchHeaders = [matchContentTypeJson] }
+        it "in can have quotes" $
+          get "/grandchild_entities?or=(id.in.(\"1\",\"2\"),id.in.(\"3\",\"4\"))&select=id" `shouldRespondWith`
+            [json|[{ "id": 1 }, { "id": 2 }, { "id": 3 }, { "id": 4 }]|] { matchHeaders = [matchContentTypeJson] }
+
+      it "allows whitespace" $
+        get "/entities?and=( and ( id.in.( 1, 2, 3 ) , id.eq.3 ) , or ( id.eq.2 , id.eq.3 ) )&select=id" `shouldRespondWith`
+          [json|[{ "id": 3 }]|] { matchHeaders = [matchContentTypeJson] }
+
+      context "multiple and/or conditions" $ do
+        it "cannot have zero conditions" $
+          get "/entities?or=()" `shouldRespondWith`
+            [json|{
+              "details": "unexpected \")\" expecting field name (* or [a..z0..9_]), negation operator (not) or logic operator (and, or)",
+              "message": "\"failed to parse logic tree (())\" (line 1, column 4)"
+            }|] { matchStatus = 400, matchHeaders = [matchContentTypeJson] }
+        it "can have a single condition" $ do
+          get "/entities?or=(id.eq.1)&select=id" `shouldRespondWith`
+            [json|[{"id":1}]|] { matchHeaders = [matchContentTypeJson] }
+          get "/entities?and=(id.eq.1)&select=id" `shouldRespondWith`
+            [json|[{"id":1}]|] { matchHeaders = [matchContentTypeJson] }
+        it "can have three conditions" $ do
+          get "/grandchild_entities?or=(id.eq.1, id.eq.2, id.eq.3)&select=id" `shouldRespondWith`
+            [json|[{"id":1}, {"id":2}, {"id":3}]|] { matchHeaders = [matchContentTypeJson] }
+          get "/grandchild_entities?and=(id.in.(1,2), id.in.(3,1), id.in.(1,4))&select=id" `shouldRespondWith`
+            [json|[{"id":1}]|] { matchHeaders = [matchContentTypeJson] }
+        it "can have four conditions combining and/or" $ do
+          get "/grandchild_entities?or=( id.eq.1, id.eq.2, and(id.in.(1,3), id.in.(2,3)), id.eq.4 )&select=id" `shouldRespondWith`
+            [json|[{"id":1}, {"id":2}, {"id":3}, {"id":4}]|] { matchHeaders = [matchContentTypeJson] }
+          get "/grandchild_entities?and=( id.eq.1, not.or(id.eq.2, id.eq.3), id.in.(1,4), or(id.eq.1, id.eq.4) )&select=id" `shouldRespondWith`
+            [json|[{"id":1}]|] { matchHeaders = [matchContentTypeJson] }
+
+    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}"
+          [("Prefer", "return=representation")]
+          [json|[{"id":4,"name":"entity 4","parent_id":1},
+                 {"id":5,"name":"entity 5","parent_id":2},
+                 {"id":6,"name":"entity 6","parent_id":3}]|] `shouldRespondWith`
+          [json|[{"id": 4, "entities":null}, {"id": 5, "entities": {"id": 2}}, {"id": 6, "entities": {"id": 3}}]|]
+          { matchStatus = 201, matchHeaders = [matchContentTypeJson] }
+
+    context "used with PATCH" $
+      it "succeeds when using and/or params" $
+        request methodPatch "/grandchild_entities?or=(id.eq.1,id.eq.2)&select=id,name"
+          [("Prefer", "return=representation")]
+          [json|{ name : "updated grandchild entity"}|] `shouldRespondWith`
+          [json|[{ "id": 1, "name" : "updated grandchild entity"},{ "id": 2, "name" : "updated grandchild entity"}]|]
+          { matchHeaders = [matchContentTypeJson] }
+
+    context "used with DELETE" $
+      it "succeeds when using and/or params" $
+        request methodDelete "/grandchild_entities?or=(id.eq.1,id.eq.2)&select=id,name"
+          [("Prefer", "return=representation")] "" `shouldRespondWith`
+          [json|[{ "id": 1, "name" : "updated grandchild entity"},{ "id": 2, "name" : "updated grandchild entity"}]|]
+          { matchHeaders = [matchContentTypeJson] }
+
+    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|{
+          "details": "unexpected \"1\" expecting \"(\"",
+          "message": "\"failed to parse logic tree ((id.in.1,2,id.eq.3))\" (line 1, column 10)"
+        }|] { matchStatus = 400, matchHeaders = [matchContentTypeJson] }
+
+    it "fails on malformed query params and provides meaningful error message" $ do
+      get "/entities?or=)(" `shouldRespondWith`
+        [json|{
+          "details": "unexpected \")\" expecting \"(\"",
+          "message": "\"failed to parse logic tree ()()\" (line 1, column 3)"
+        }|] { matchStatus = 400, matchHeaders = [matchContentTypeJson] }
+      get "/entities?and=(ord(id.eq.1,id.eq.1),id.eq.2)" `shouldRespondWith`
+        [json|{
+          "details": "unexpected \"d\" expecting \"(\"",
+          "message": "\"failed to parse logic tree ((ord(id.eq.1,id.eq.1),id.eq.2))\" (line 1, column 7)"
+        }|] { matchStatus = 400, matchHeaders = [matchContentTypeJson] }
+      get "/entities?or=(id.eq.1,not.xor(id.eq.2,id.eq.3))" `shouldRespondWith`
+        [json|{
+          "details": "unexpected \"x\" expecting logic operator (and, or)",
+          "message": "\"failed to parse logic tree ((id.eq.1,not.xor(id.eq.2,id.eq.3)))\" (line 1, column 16)"
+        }|] { matchStatus = 400, matchHeaders = [matchContentTypeJson] }

test/Feature/AsymmetricJwtSpec.hs

@@ -0,0 +1,21 @@
+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)
+-- }}}
+
+spec :: SpecWith Application
+spec = describe "server started with asymmetric JWK" $
+
+  -- this test will stop working 9999999999s after the UNIX EPOCH
+  it "succeeds with jwt token signed with an asymmetric key" $ do
+    let auth = authHeaderJWT "eyJhbGciOiJSUzI1NiJ9.eyJyb2xlIjogInBvc3RncmVzdF90ZXN0X2F1dGhvciJ9Cg.CBOYWDvqgAR0YYnZnyDGTQi6AJLc2Pds6_eV3YuBG6I36mj_h05eLhkEKNEDA5ZteMzCiY83P60rC_xtxVd7B6vo3BeF5uoanPS3rrbuHzKPwzsrgrD_CqvEuJ4n7Q9epkQiLsNkcexneENZDRqFjbwZx3DrXiCWwlK3Ytr5NAIGxmy0od-0xNpb2U1nXQyO_Q3mumWFViRt4tmFn_3goDHNKG3Ha_AzImfUNvHnWL78kAc4rbn15vLtWXD8PwtSnZaB4lY4V6RfsaW937srQsmRetvytM1i_bHBnjkjQLAqGbXPyItjtlXPs0uGNBadE8-wgkLtfmSCC4v2DjUthw"
+    request methodGet "/authors_only" [auth] ""
+      `shouldRespondWith` 200

test/Feature/AudienceJwtSecretSpec.hs

@@ -0,0 +1,47 @@
+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)
+-- }}}
+
+spec :: SpecWith Application
+spec = describe "test handling of aud claims in JWT" $ do
+
+  -- this test will stop working 9999999999s after the UNIX EPOCH
+  it "succeeds with jwt token containing with an audience claim" $ do
+    {-  This is the decoded contents of authHeaderJWT
+
+        {
+          "exp": 9999999999,
+          "role": "postgrest_test_author",
+          "id": "jdoe",
+          "aud": "youraudience"
+        }
+
+    -}
+    let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJleHAiOjk5OTk5OTk5OTksInJvbGUiOiJwb3N0Z3Jlc3RfdGVzdF9hdXRob3IiLCJpZCI6Impkb2UiLCJhdWQiOiJ5b3VyYXVkaWVuY2UifQ.fJ4tLKSmolWGWehWN20qiU9dMO-WY0RI2VvacL7-ZGo"
+    request methodGet "/authors_only" [auth] ""
+      `shouldRespondWith` 200
+
+  it "succeeds with jwt token that does not contain an audience claim" $ do
+    {- This is the decoded contents of authHeaderJWT
+
+        {
+          "exp": 9999999999,
+          "role": "postgrest_test_author",
+          "id": "jdoe"
+        }
+    -}
+    let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJleHAiOjk5OTk5OTk5OTksInJvbGUiOiJwb3N0Z3Jlc3RfdGVzdF9hdXRob3IiLCJpZCI6Impkb2UifQ.Dpss-QoLYjec5OTsOaAc3FNVsSjA89wACoV-0ra3ClA"
+    request methodGet "/authors_only" [auth] ""
+      `shouldRespondWith` 200
+
+  it "requests without JWT token should work" $
+    get "/has_count_column" `shouldRespondWith` 200 

test/Feature/AuthSpec.hs

@@ -1,6 +1,5 @@
 module Feature.AuthSpec where
 
--- {{{ Imports
 import Text.Heredoc
 import Test.Hspec
 import Test.Hspec.Wai
@@ -11,80 +10,85 @@ import SpecHelper
 import Network.Wai (Application)
 
 import Protolude hiding (get)
--- }}}
 
 spec :: SpecWith Application
 spec = describe "authorization" $ do
   let single = ("Accept","application/vnd.pgrst.object+json")
 
   it "denies access to tables that anonymous does not own" $
-    get "/authors_only" `shouldRespondWith` ResponseMatcher {
-        matchBody = Just [json| {
+    get "/authors_only" `shouldRespondWith` [json| {
           "hint":null,
           "details":null,
           "code":"42501",
           "message":"permission denied for relation authors_only"} |]
-      , matchStatus = 401
+      { matchStatus = 401
       , matchHeaders = ["WWW-Authenticate" <:> "Bearer"]
       }
 
   it "denies access to tables that postgrest_test_author does not own" $
-    let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJyb2xlIjoicG9zdGdyZXN0X3Rlc3RfYXV0aG9yIiwiaWQiOiJqZG9lIn0.y4vZuu1dDdwAl0-S00MCRWRYMlJ5YAMSir6Es6WtWx0" in
+    let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJyb2xlIjoicG9zdGdyZXN0X3Rlc3RfYXV0aG9yIn0.Xod-F15qsGL0WhdOCr2j3DdKuTw9QJERVgoFD3vGaWA" in
     request methodGet "/private_table" [auth] ""
-      `shouldRespondWith` ResponseMatcher {
-        matchBody = Just [json| {
+      `shouldRespondWith` [json| {
           "hint":null,
           "details":null,
           "code":"42501",
           "message":"permission denied for relation private_table"} |]
-      , matchStatus = 403
+      { matchStatus = 403
       , matchHeaders = []
       }
 
+  it "denies execution on functions that anonymous does not own" $
+    post "/rpc/privileged_hello" [json|{"name": "anonymous"}|] `shouldRespondWith` 401
+
+  it "allows execution on a function that postgrest_test_author owns" $
+    let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJyb2xlIjoicG9zdGdyZXN0X3Rlc3RfYXV0aG9yIn0.Xod-F15qsGL0WhdOCr2j3DdKuTw9QJERVgoFD3vGaWA" in
+    request methodPost "/rpc/privileged_hello" [auth] [json|{"name": "jdoe"}|]
+      `shouldRespondWith` [json|"Privileged hello to jdoe"|]
+      { matchStatus = 200
+      , matchHeaders = [matchContentTypeJson]
+      }
+
   it "returns jwt functions as jwt tokens" $
     request methodPost "/rpc/login" [single]
       [json| { "id": "jdoe", "pass": "1234" } |]
-      `shouldRespondWith` ResponseMatcher {
-          matchBody = Just [json| {"token":"eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJyb2xuYW1lIjoicG9zdGdyZXN0X3Rlc3RfYXV0aG9yIiwiaWQiOiJqZG9lIn0.P2G9EVSVI22MWxXWFuhEYd9BZerLS1WDlqzdqplM15s"} |]
-        , matchStatus = 200
-        , matchHeaders = ["Content-Type" <:> "application/json; charset=utf-8"]
+      `shouldRespondWith` [json| {"token":"eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJyb2xuYW1lIjoicG9zdGdyZXN0X3Rlc3RfYXV0aG9yIiwiaWQiOiJqZG9lIn0.KO-0PGp_rU-utcDBP6qwdd-Th2Fk-ICVt01I7QtTDWs"} |]
+        { matchStatus = 200
+        , matchHeaders = [matchContentTypeSingular]
         }
 
   it "sql functions can encode custom and standard claims" $
     request methodPost  "/rpc/jwt_test" [single] "{}"
-      `shouldRespondWith` ResponseMatcher {
-          matchBody = Just [json| {"token":"eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJpc3MiOiJqb2UiLCJzdWIiOiJmdW4iLCJhdWQiOiJldmVyeW9uZSIsImV4cCI6MTMwMDgxOTM4MCwibmJmIjoxMzAwODE5MzgwLCJpYXQiOjEzMDA4MTkzODAsImp0aSI6ImZvbyIsInJvbGUiOiJwb3N0Z3Jlc3RfdGVzdCIsImh0dHA6Ly9wb3N0Z3Jlc3QuY29tL2ZvbyI6dHJ1ZX0.IHF16ZSU6XTbOnUWO8CCpUn2fJwt8P00rlYVyXQjpWc"} |]
-        , matchStatus = 200
-        , matchHeaders = ["Content-Type" <:> "application/json; charset=utf-8"]
+      `shouldRespondWith` [json| {"token":"eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJpc3MiOiJqb2UiLCJzdWIiOiJmdW4iLCJhdWQiOiJldmVyeW9uZSIsImV4cCI6MTMwMDgxOTM4MCwibmJmIjoxMzAwODE5MzgwLCJpYXQiOjEzMDA4MTkzODAsImp0aSI6ImZvbyIsInJvbGUiOiJwb3N0Z3Jlc3RfdGVzdCIsImh0dHA6Ly9wb3N0Z3Jlc3QuY29tL2ZvbyI6dHJ1ZX0.G2REtPnOQMUrVRDA9OnkPJTd8R0tf4wdYOlauh1E2Ek"} |]
+        { matchStatus = 200
+        , matchHeaders = [matchContentTypeSingular]
         }
 
   it "sql functions can read custom and standard claims variables" $ do
-    let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJzdWIiOiJmdW4iLCJqdGkiOiJmb28iLCJuYmYiOjEzMDA4MTkzODAsImV4cCI6OTk5OTk5OTk5OSwiaHR0cDovL3Bvc3RncmVzdC5jb20vZm9vIjp0cnVlLCJpc3MiOiJqb2UiLCJyb2xlIjoicG9zdGdyZXN0X3Rlc3RfYXV0aG9yIiwiaWF0IjoxMzAwODE5MzgwLCJhdWQiOiJldmVyeW9uZSJ9.AQmCA7CMScvfaDRMqRPeUY6eNf--69gpW-kxaWfq9X0"
+    let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJzdWIiOiJmdW4iLCJqdGkiOiJmb28iLCJuYmYiOjEzMDA4MTkzODAsImV4cCI6OTk5OTk5OTk5OSwiaHR0cDovL3Bvc3RncmVzdC5jb20vZm9vIjp0cnVlLCJpc3MiOiJqb2UiLCJyb2xlIjoicG9zdGdyZXN0X3Rlc3RfYXV0aG9yIiwiaWF0IjoxMzAwODE5MzgwfQ.V5fEpXfpb7feqwVqlcDleFdKu86bdwU2cBRT4fcMhXg"
     request methodPost "/rpc/reveal_big_jwt" [auth] "{}"
-      `shouldRespondWith` [str|[{"iss":"joe","sub":"fun","aud":"everyone","exp":9999999999,"nbf":1300819380,"iat":1300819380,"jti":"foo","http://postgrest.com/foo":true}]|]
+      `shouldRespondWith` [str|[{"iss":"joe","sub":"fun","exp":9999999999,"nbf":1300819380,"iat":1300819380,"jti":"foo","http://postgrest.com/foo":true}]|]
 
   it "allows users with permissions to see their tables" $ do
-    let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJyb2xlIjoicG9zdGdyZXN0X3Rlc3RfYXV0aG9yIiwiaWQiOiJqZG9lIn0.y4vZuu1dDdwAl0-S00MCRWRYMlJ5YAMSir6Es6WtWx0"
+    let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJyb2xlIjoicG9zdGdyZXN0X3Rlc3RfYXV0aG9yIiwiaWQiOiJqZG9lIn0.B-lReuGNDwAlU1GOC476MlO0vAt9JNoHIlxg2vwMaO0"
     request methodGet "/authors_only" [auth] ""
       `shouldRespondWith` 200
 
   it "works with tokens which have extra fields" $ do
-    let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJyb2xlIjoicG9zdGdyZXN0X3Rlc3RfYXV0aG9yIiwiaWQiOiJqZG9lIiwia2V5MSI6InZhbHVlMSIsImtleTIiOiJ2YWx1ZTIiLCJrZXkzIjoidmFsdWUzIiwiYSI6MSwiYiI6MiwiYyI6M30.GfydCh-F4wnM379xs0n1zUgalwJIsb6YoBapCo8HlFk"
+    let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJyb2xlIjoicG9zdGdyZXN0X3Rlc3RfYXV0aG9yIiwiaWQiOiJqZG9lIiwia2V5MSI6InZhbHVlMSIsImtleTIiOiJ2YWx1ZTIiLCJrZXkzIjoidmFsdWUzIiwiYSI6MSwiYiI6MiwiYyI6M30.b0eglDKYEmGi-hCvD-ddSqFl7vnDO5qkUaviaHXm3es"
     request methodGet "/authors_only" [auth] ""
       `shouldRespondWith` 200
 
   -- this test will stop working 9999999999s after the UNIX EPOCH
   it "succeeds with an unexpired token" $ do
-    let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJleHAiOjk5OTk5OTk5OTksInJvbGUiOiJwb3N0Z3Jlc3RfdGVzdF9hdXRob3IiLCJpZCI6Impkb2UifQ.QaPPLWTuyydMu_q7H4noMT7Lk6P4muet1OpJXF6ofhc"
+    let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJleHAiOjk5OTk5OTk5OTksInJvbGUiOiJwb3N0Z3Jlc3RfdGVzdF9hdXRob3IiLCJpZCI6Impkb2UifQ.Dpss-QoLYjec5OTsOaAc3FNVsSjA89wACoV-0ra3ClA"
     request methodGet "/authors_only" [auth] ""
       `shouldRespondWith` 200
 
   it "fails with an expired token" $ do
-    let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJleHAiOjE0NDY2NzgxNDksInJvbGUiOiJwb3N0Z3Jlc3RfdGVzdF9hdXRob3IiLCJpZCI6Impkb2UifQ.enk_qZ_u6gZsXY4R8bREKB_HNExRpM0lIWSLktk9JJQ"
+    let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJleHAiOjE0NDY2NzgxNDksInJvbGUiOiJwb3N0Z3Jlc3RfdGVzdF9hdXRob3IiLCJpZCI6Impkb2UifQ.f8__E6VQwYcDqwHmr9PG03uaZn8Zh1b0vbJ9DYS0AdM"
     request methodGet "/authors_only" [auth] ""
-      `shouldRespondWith` ResponseMatcher {
-          matchBody = Nothing
-        , matchStatus = 401
+      `shouldRespondWith` [json| {"message":"JWT expired"} |]
+        { matchStatus = 401
         , matchHeaders = [
             "WWW-Authenticate" <:>
             "Bearer error=\"invalid_token\", error_description=\"JWT expired\""
@@ -94,28 +98,27 @@ 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` ResponseMatcher {
-          matchBody = Nothing
-        , matchStatus = 401
+      `shouldRespondWith` [json| {"message":"JWSError (CompactDecodeError \"expected 3 parts, got 2\")"} |]
+        { matchStatus = 401
         , matchHeaders = [
             "WWW-Authenticate" <:>
-            "Bearer error=\"invalid_token\", error_description=\"JWT invalid\""
+            "Bearer error=\"invalid_token\", error_description=\"JWSError (CompactDecodeError \\\"expected 3 parts, got 2\\\")\""
           ]
         }
 
   it "should fail when jwt contains no claims" $ do
-    let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.e30.lu-rG8aSCiw-aOlN0IxpRGz5r7Jwq7K9r3tuMPUpytI"
+    let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.e30.CUIP5V9thWsGGFsFyGijSZf1fJMfarLHI9CEJL-TGNk"
     request methodGet "/authors_only" [auth] ""
       `shouldRespondWith` 401
 
   it "hides tables from users with JWT that contain no claims about role" $ do
-    let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJpZCI6Impkb2UifQ.Jneso9X519Vh0z7i9PbXIu7W1HEoq9RRw9BBbyQKFCQ"
+    let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJpZCI6Impkb2UifQ.RVlZDaSyKbFPvxUf3V_NQXybfRB4dlBIkAUQXVXLUAI"
     request methodGet "/authors_only" [auth] ""
       `shouldRespondWith` 401
 
   it "recovers after 401 error with logged in user" $ do
     _ <- post "/authors_only" [json| { "owner": "jdoe", "secret": "test content" } |]
-    let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJyb2xlIjoicG9zdGdyZXN0X3Rlc3RfYXV0aG9yIiwiaWQiOiJqZG9lIn0.y4vZuu1dDdwAl0-S00MCRWRYMlJ5YAMSir6Es6WtWx0"
+    let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJyb2xlIjoicG9zdGdyZXN0X3Rlc3RfYXV0aG9yIiwiaWQiOiJqZG9lIn0.B-lReuGNDwAlU1GOC476MlO0vAt9JNoHIlxg2vwMaO0"
     _ <- request methodPost "/rpc/problem" [auth] ""
     request methodGet "/authors_only" [auth] ""
       `shouldRespondWith` 200
@@ -123,31 +126,28 @@ spec = describe "authorization" $ do
   describe "custom pre-request proc acting on id claim" $ do
 
     it "able to switch to postgrest_test_author role (id=1)" $
-      let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJpZCI6MX0.mI2HNoOum6xM3sc4oHLxU4yLv-_WV5W1kqBfY_wEvLw" in
+      let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJpZCI6MX0.gKw7qI50i9hMrSJW8BlTpdMEVmMXJYxlAqueGqpa_mE" in
       request methodPost "/rpc/get_current_user" [auth]
         [json| {} |]
-         `shouldRespondWith` ResponseMatcher {
-            matchBody    = Just [str|"postgrest_test_author"|]
-          , matchStatus = 200
+         `shouldRespondWith` [str|"postgrest_test_author"|]
+          { matchStatus = 200
           , matchHeaders = []
           }
 
     it "able to switch to postgrest_test_default_role (id=2)" $
-      let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJpZCI6Mn0.W7jLsG-zswM91AJkCvZeIMHrnz7_6ceY2jnscVl3Yhk" in
+      let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJpZCI6Mn0.nwzjMI0YLvVGJQTeoCPEBsK983b__gxdpLXisBNaO2A" in
       request methodPost "/rpc/get_current_user" [auth]
         [json| {} |]
-         `shouldRespondWith` ResponseMatcher {
-            matchBody    = Just [str|"postgrest_test_default_role"|]
-          , matchStatus = 200
+         `shouldRespondWith` [str|"postgrest_test_default_role"|]
+          { matchStatus = 200
           , matchHeaders = []
           }
 
     it "raises error (id=3)" $
-      let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJpZCI6M30.15Gy8PezQhJIaHYDJVLa-Gmz9T3sJnW66EKAYIsXc7c" in
+      let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJpZCI6M30.OGxEJAf60NKZiTn-tIb2jy4rqKs_ZruLGWZ40TjrJsM" in
       request methodPost "/rpc/get_current_user" [auth]
         [json| {} |]
-         `shouldRespondWith` ResponseMatcher {
-            matchBody    = Just [str|{"hint":"Please contact administrator","details":null,"code":"P0001","message":"Disabled ID --> 3"}|]
-          , matchStatus = 400
+         `shouldRespondWith` [str|{"hint":"Please contact administrator","details":null,"code":"P0001","message":"Disabled ID --> 3"}|]
+          { matchStatus = 400
           , matchHeaders = []
           }

test/Feature/BinaryJwtSecretSpec.hs

@@ -16,6 +16,6 @@ spec = describe "server started with binary JWT secret" $
 
   -- this test will stop working 9999999999s after the UNIX EPOCH
   it "succeeds with jwt token encoded with a binary secret" $ do
-    let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJleHAiOjk5OTk5OTk5OTksInJvbGUiOiJwb3N0Z3Jlc3RfdGVzdF9hdXRob3IiLCJpZCI6Impkb2UifQ.l_EcSRWeNtL4OKUTIplrHyioNrff9Rd0MV7RXNCxCyk"
+    let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJleHAiOjk5OTk5OTk5OTksInJvbGUiOiJwb3N0Z3Jlc3RfdGVzdF9hdXRob3IiLCJpZCI6Impkb2UifQ.Dpss-QoLYjec5OTsOaAc3FNVsSjA89wACoV-0ra3ClA"
     request methodGet "/authors_only" [auth] ""
       `shouldRespondWith` 200

test/Feature/ConcurrentSpec.hs

@@ -24,14 +24,13 @@ spec =
     it "should not raise 'transaction in progress' error" $
       raceTest 10 $
         get "/fakefake"
-          `shouldRespondWith` ResponseMatcher {
-            matchBody    = Just [json|
+          `shouldRespondWith` [json|
               { "hint": null,
                 "details":null,
                 "code":"42P01",
                 "message":"relation \"test.fakefake\" does not exist"
               } |]
-          , matchStatus  = 404
+          { matchStatus  = 404
           , matchHeaders = []
           }
 

test/Feature/DeleteSpec.hs

@@ -15,24 +15,21 @@ spec =
     context "existing record" $ do
       it "succeeds with 204 and deletion count" $
         request methodDelete "/items?id=eq.1" [] ""
-          `shouldRespondWith` ResponseMatcher {
-            matchBody    = Nothing
-          , matchStatus  = 204
+          `shouldRespondWith` ""
+          { matchStatus  = 204
           , matchHeaders = ["Content-Range" <:> "*/*"]
           }
 
       it "returns the deleted item and count if requested" $
         request methodDelete "/items?id=eq.2" [("Prefer", "return=representation"), ("Prefer", "count=exact")] ""
-          `shouldRespondWith` ResponseMatcher {
-            matchBody    = Just [str|[{"id":2}]|]
-          , matchStatus  = 200
+          `shouldRespondWith` [str|[{"id":2}]|]
+          { matchStatus  = 200
           , matchHeaders = ["Content-Range" <:> "*/1"]
           }
       it "returns the deleted item and shapes the response" $
         request methodDelete "/complex_items?id=eq.2&select=id,name" [("Prefer", "return=representation")] ""
-          `shouldRespondWith` ResponseMatcher {
-            matchBody    = Just [str|[{"id":2,"name":"Two"}]|]
-          , matchStatus  = 200
+          `shouldRespondWith` [str|[{"id":2,"name":"Two"}]|]
+          { matchStatus  = 200
           , matchHeaders = ["Content-Range" <:> "*/*"]
           }
       it "can rename and cast the selected columns" $
@@ -40,18 +37,16 @@ spec =
           `shouldRespondWith` [str|[{"ciId":"3","ciName":"Three"}]|]
       it "can embed (parent) entities" $
         request methodDelete "/tasks?id=eq.8&select=id,name,project{id}" [("Prefer", "return=representation")] ""
-          `shouldRespondWith` ResponseMatcher {
-            matchBody    = Just [str|[{"id":8,"name":"Code OSX","project":{"id":4}}]|]
-          , matchStatus  = 200
+          `shouldRespondWith` [str|[{"id":8,"name":"Code OSX","project":{"id":4}}]|]
+          { matchStatus  = 200
           , matchHeaders = ["Content-Range" <:> "*/*"]
           }
 
       it "actually clears items ouf the db" $ do
         _ <- request methodDelete "/items?id=lt.15" [] ""
         get "/items"
-          `shouldRespondWith` ResponseMatcher {
-            matchBody    = Just [str|[{"id":15}]|]
-          , matchStatus  = 200
+          `shouldRespondWith` [str|[{"id":15}]|]
+          { matchStatus  = 200
           , matchHeaders = ["Content-Range" <:> "0-0/*"]
           }
 
@@ -59,9 +54,8 @@ spec =
       it "includes [] body if return=rep" $
         request methodDelete "/items?id=eq.101"
           [("Prefer", "return=representation")] ""
-          `shouldRespondWith` ResponseMatcher {
-            matchBody    = Just "[]"
-          , matchStatus  = 200
+          `shouldRespondWith` "[]"
+          { matchStatus  = 200
           , matchHeaders = ["Content-Range" <:> "*/*"]
           }
 

test/Feature/InsertSpec.hs

@@ -3,6 +3,7 @@ module Feature.InsertSpec where
 import Test.Hspec hiding (pendingWith)
 import Test.Hspec.Wai
 import Test.Hspec.Wai.JSON
+import Test.Hspec.Wai.Matcher (bodyEquals)
 import Network.Wai.Test (SResponse(simpleBody,simpleHeaders,simpleStatus))
 
 import SpecHelper
@@ -43,31 +44,29 @@ spec = do
             "integer": 14, "double": 3.14159, "varchar": "testing!"
           , "boolean": false, "date": "1900-01-01", "money": "$3.99"
           , "enum": "foo"
-          }] |] `shouldRespondWith` ResponseMatcher {
-            matchBody    = Just [str|[{"integer":14,"varchar":"testing!"}]|]
-          , matchStatus  = 201
-          , matchHeaders = ["Content-Type" <:> "application/json; charset=utf-8"]
+          }] |] `shouldRespondWith` [str|[{"integer":14,"varchar":"testing!"}]|]
+          { matchStatus  = 201
+          , matchHeaders = [matchContentTypeJson]
           }
 
     context "requesting full representation" $ do
       it "includes related data after insert" $
         request methodPost "/projects?select=id,name,clients{id,name}"
                 [("Prefer", "return=representation"), ("Prefer", "count=exact")]
-          [str|{"id":6,"name":"New Project","client_id":2}|] `shouldRespondWith` ResponseMatcher {
-            matchBody    = Just [str|[{"id":6,"name":"New Project","clients":{"id":2,"name":"Apple"}}]|]
-          , matchStatus  = 201
-          , matchHeaders = [ "Content-Type" <:> "application/json; charset=utf-8"
+          [str|{"id":6,"name":"New Project","client_id":2}|] `shouldRespondWith` [str|[{"id":6,"name":"New Project","clients":{"id":2,"name":"Apple"}}]|]
+          { matchStatus  = 201
+          , matchHeaders = [ matchContentTypeJson
                            , "Location" <:> "/projects?id=eq.6"
                            , "Content-Range" <:> "*/1" ]
           }
 
       it "can rename and cast the selected columns" $
         request methodPost "/projects?select=pId:id::text,pName:name,cId:client_id::text"
-                [("Prefer", "return=representation")] 
-          [str|{"id":7,"name":"New Project","client_id":2}|] `shouldRespondWith` ResponseMatcher {
-            matchBody    = Just [str|[{"pId":"7","pName":"New Project","cId":"2"}]|]
-          , matchStatus  = 201
-          , matchHeaders = [ "Content-Type" <:> "application/json; charset=utf-8"
+                [("Prefer", "return=representation")]
+          [str|{"id":7,"name":"New Project","client_id":2}|] `shouldRespondWith`
+          [str|[{"pId":"7","pName":"New Project","cId":"2"}]|]
+          { matchStatus  = 201
+          , matchHeaders = [ matchContentTypeJson
                            , "Location" <:> "/projects?id=eq.7"
                            , "Content-Range" <:> "*/*" ]
           }
@@ -201,9 +200,8 @@ spec = do
         request methodPost "/json"
                      [("Prefer", "return=representation")]
                      inserted
-          `shouldRespondWith` ResponseMatcher {
-            matchBody    = Just [str|[{"data":{"foo":"bar"}}]|]
-          , matchStatus  = 201
+          `shouldRespondWith` [str|[{"data":{"foo":"bar"}}]|]
+          { matchStatus  = 201
           , matchHeaders = ["Location" <:> location]
           }
 
@@ -213,39 +211,35 @@ spec = do
         request methodPost "/json"
                      [("Prefer", "return=representation")]
                      inserted
-          `shouldRespondWith` ResponseMatcher {
-            matchBody    = Just [str|[{"data":[1,2,3]}]|]
-          , matchStatus  = 201
+          `shouldRespondWith` [str|[{"data":[1,2,3]}]|]
+          { matchStatus  = 201
           , matchHeaders = ["Location" <:> location]
           }
 
     context "empty object" $
       it "successfully populates table with all-default columns" $
-        post "/items" "{}" `shouldRespondWith` ResponseMatcher {
-            matchBody    = Just ""
-          , matchStatus  = 201
+        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")]
-          [json| {"article_id": 2, "user_id": 1} |] `shouldRespondWith` ResponseMatcher {
-            matchBody    = Just [str|[{"article_id":2,"user_id":1}]|]
-          , matchStatus  = 201
+          [json| {"article_id": 2, "user_id": 1} |] `shouldRespondWith` [str|[{"article_id":2,"user_id":1}]|]
+          { matchStatus  = 201
           , matchHeaders = []
           }
       it "fails if more columns are selected" $
         request methodPost "/limited_article_stars?select=article_id,user_id,created_at" [("Prefer", "return=representation")]
-          [json| {"article_id": 2, "user_id": 2} |] `shouldRespondWith` ResponseMatcher {
-            matchBody    = Just [str|{"hint":null,"details":null,"code":"42501","message":"permission denied for relation limited_article_stars"}|]
-          , matchStatus  = 401
+          [json| {"article_id": 2, "user_id": 2} |] `shouldRespondWith`
+          [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` ResponseMatcher {
-            matchBody    = Just [str|{"hint":null,"details":null,"code":"42501","message":"permission denied for relation limited_article_stars"}|]
-          , matchStatus  = 401
+          [json| {"article_id": 3, "user_id": 1} |] `shouldRespondWith` [str|{"hint":null,"details":null,"code":"42501","message":"permission denied for relation limited_article_stars"}|]
+          { matchStatus  = 401
           , matchHeaders = []
           }
 
@@ -259,11 +253,10 @@ spec = do
             |12,0.1,a string,true,1929-10-01,12,bar
             |]
         request methodPost "/menagerie" [("Content-Type", "text/csv"), ("Accept", "text/csv"), ("Prefer", "return=representation")] inserted
-
-           `shouldRespondWith` ResponseMatcher {
-             matchBody    = Just inserted
-           , matchStatus  = 201
+           `shouldRespondWith` ResponseMatcher
+           { matchStatus  = 201
            , matchHeaders = ["Content-Type" <:> "text/csv; charset=utf-8"]
+           , matchBody = bodyEquals inserted
            }
 
     context "requesting full representation" $ do
@@ -271,9 +264,8 @@ spec = do
         request methodPost "/no_pk"
                      [("Content-Type", "text/csv"), ("Accept", "text/csv"),  ("Prefer", "return=representation")]
                      "a,b\nbar,baz"
-          `shouldRespondWith` ResponseMatcher {
-            matchBody    = Just "a,b\nbar,baz"
-          , matchStatus  = 201
+          `shouldRespondWith` "a,b\nbar,baz"
+          { matchStatus  = 201
           , matchHeaders = ["Content-Type" <:> "text/csv; charset=utf-8",
                             "Location" <:> "/no_pk?a=eq.bar&b=eq.baz"]
           }
@@ -282,9 +274,8 @@ spec = do
         request methodPost "/no_pk"
                      [("Content-Type", "text/csv"), ("Accept", "text/csv"), ("Prefer", "return=representation")]
                      "a,b\nNULL,foo"
-          `shouldRespondWith` ResponseMatcher {
-            matchBody    = Just "a,b\n,foo"
-          , matchStatus  = 201
+          `shouldRespondWith` "a,b\n,foo"
+          { matchStatus  = 201
           , matchHeaders = ["Content-Type" <:> "text/csv; charset=utf-8",
                             "Location" <:> "/no_pk?a=is.null&b=eq.foo"]
           }
@@ -293,9 +284,8 @@ spec = do
         request methodPost "/projects?select=id"
                      [("Content-Type", "text/csv"), ("Accept", "text/csv"), ("Prefer", "return=representation")]
                      "id,name,client_id\n8,Xenix,1\n9,Windows NT,1"
-          `shouldRespondWith` ResponseMatcher {
-            matchBody    = Just "id\n8\n9"
-          , matchStatus  = 201
+          `shouldRespondWith` "id\n8\n9"
+          { matchStatus  = 201
           , matchHeaders = ["Content-Type" <:> "text/csv; charset=utf-8",
                             "Content-Range" <:> "*/*"]
           }
@@ -334,9 +324,8 @@ spec = do
       it "indicates no records found to update" $
         request methodPatch "/empty_table" []
           [json| { "extra":20 } |]
-          `shouldRespondWith` ResponseMatcher {
-            matchBody    = Just "",
-            matchStatus  = 204,
+          `shouldRespondWith` ""
+          { matchStatus  = 204,
             matchHeaders = ["Content-Range" <:> "*/*"]
           }
 
@@ -346,9 +335,8 @@ spec = do
         liftIO $ simpleHeaders g
           `shouldSatisfy` matchHeader "Content-Range" "\\*/\\*"
         p <- request methodPatch "/items?id=eq.2" [] [json| { "id":42 } |]
-        pure p `shouldRespondWith` ResponseMatcher {
-            matchBody    = Nothing,
-            matchStatus  = 204,
+        pure p `shouldRespondWith` ""
+          { matchStatus  = 204,
             matchHeaders = ["Content-Range" <:> "0-0/*"]
           }
         liftIO $ lookup hContentType (simpleHeaders p) `shouldBe` Nothing
@@ -363,8 +351,8 @@ spec = do
       it "returns empty array when no rows updated and return=rep" $
         request methodPatch "/items?id=eq.999999"
           [("Prefer", "return=representation")] [json| { "id":999999 } |]
-          `shouldRespondWith` ResponseMatcher {
-            matchBody    = Just "[]",
+          `shouldRespondWith` "[]"
+          {
             matchStatus  = 200,
             matchHeaders = ["Content-Range" <:> "*/*"]
           }
@@ -372,9 +360,8 @@ spec = do
       it "returns updated object as array when return=rep" $
         request methodPatch "/items?id=eq.2"
           [("Prefer", "return=representation")] [json| { "id":2 } |]
-          `shouldRespondWith` ResponseMatcher {
-            matchBody    = Just [str|[{"id":2}]|],
-            matchStatus  = 200,
+          `shouldRespondWith` [str|[{"id":2}]|]
+          { matchStatus  = 200,
             matchHeaders = ["Content-Range" <:> "0-0/*"]
           }
 
@@ -395,15 +382,15 @@ spec = do
         _ <- request methodPatch "/no_pk?b=eq.nullme" [] [json| { b: null } |]
         get "/no_pk?a=eq.keepme" `shouldRespondWith`
           [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` ResponseMatcher {
-            matchBody    = Just [json| [{ "data": { "escaped":" \"bar" } }] |]
-          , matchStatus  = 200
+          `shouldRespondWith` [json| [{ "data": { "escaped":" \"bar" } }] |]
+          { matchStatus  = 200
           , matchHeaders = []
           }
 
@@ -412,9 +399,8 @@ spec = do
           "/items?always_true=eq.false"
           [("Prefer", "return=representation")]
           [json| { id: 100 } |]
-          `shouldRespondWith` ResponseMatcher {
-            matchBody    = Just "[]",
-            matchStatus  = 200,
+          `shouldRespondWith` "[]"
+          { matchStatus  = 200,
             matchHeaders = ["Content-Range" <:> "*/*"]
           }
 
@@ -426,7 +412,32 @@ spec = do
           [("Prefer", "return=representation")]
           [json| { id: 99 } |]
           `shouldRespondWith` [json| [{id:99}] |]
+          { matchHeaders = [matchContentTypeJson] }
+        -- put value back for other tests
+        void $ request methodPatch "/items?id=eq.99" [] [json| { "id":1 } |]
 
+      it "makes no updates and returns 204, when patching with an empty json object" $ do
+        request methodPatch "/items" [] [json| {} |]
+          `shouldRespondWith` ""
+          {
+            matchStatus  = 204,
+            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] }
+
+      it "makes no updates and and returns 200, when patching with an empty json object and return=rep" $ do
+        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" []
@@ -440,7 +451,7 @@ spec = do
 
   describe "Row level permission" $
     it "set user_id when inserting rows" $ do
-      let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJyb2xlIjoicG9zdGdyZXN0X3Rlc3RfYXV0aG9yIiwiaWQiOiJqZG9lIn0.y4vZuu1dDdwAl0-S00MCRWRYMlJ5YAMSir6Es6WtWx0"
+      let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJyb2xlIjoicG9zdGdyZXN0X3Rlc3RfYXV0aG9yIiwiaWQiOiJqZG9lIn0.B-lReuGNDwAlU1GOC476MlO0vAt9JNoHIlxg2vwMaO0"
       _ <- post "/postgrest/users" [json| { "id":"jdoe", "pass": "1234", "role": "postgrest_test_author" } |]
       _ <- post "/postgrest/users" [json| { "id":"jroe", "pass": "1234", "role": "postgrest_test_author" } |]
 
@@ -453,7 +464,7 @@ spec = do
 
       p2 <- request methodPost "/authors_only"
         -- jwt token for jroe
-        [ authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJyb2xlIjoicG9zdGdyZXN0X3Rlc3RfYXV0aG9yIiwiaWQiOiJqcm9lIn0.YuF_VfmyIxWyuceT7crnNKEprIYXsJAyXid3rjPjIow", ("Prefer", "return=representation") ]
+        [ authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJyb2xlIjoicG9zdGdyZXN0X3Rlc3RfYXV0aG9yIiwiaWQiOiJqcm9lIn0.2e7mx0U4uDcInlbJVOBGlrRufwqWLINDIEDC1vS0nw8", ("Prefer", "return=representation") ]
         [json| { "secret": "lolcat", "owner": "hacker" } |]
       liftIO $ do
         simpleBody p2 `shouldBe` [str|[{"owner":"jroe","secret":"lolcat"}]|]

test/Feature/NoJwtSpec.hs

@@ -16,7 +16,7 @@ spec = describe "server started without JWT secret" $ do
 
   -- this test will stop working 9999999999s after the UNIX EPOCH
   it "responds with error on attempted auth" $ do
-    let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJleHAiOjk5OTk5OTk5OTksInJvbGUiOiJwb3N0Z3Jlc3RfdGVzdF9hdXRob3IiLCJpZCI6Impkb2UifQ.QaPPLWTuyydMu_q7H4noMT7Lk6P4muet1OpJXF6ofhc"
+    let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJleHAiOjk5OTk5OTk5OTksInJvbGUiOiJwb3N0Z3Jlc3RfdGVzdF9hdXRob3IiLCJpZCI6Impkb2UifQ.Dpss-QoLYjec5OTsOaAc3FNVsSjA89wACoV-0ra3ClA"
     request methodGet "/authors_only" [auth] ""
       `shouldRespondWith` 500
 

test/Feature/NonexistentSchemaSpec.hs

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

test/Feature/PgVersion96Spec.hs

@@ -0,0 +1,81 @@
+module Feature.PgVersion96Spec where
+
+import Test.Hspec hiding (pendingWith)
+import Test.Hspec.Wai
+import Test.Hspec.Wai.JSON
+
+import SpecHelper
+import Network.Wai (Application)
+
+import Protolude hiding (get)
+
+spec :: SpecWith Application
+spec =
+  describe "features supported on PostgreSQL 9.6" $ do
+    context "GUC headers" $ do
+      it "succeeds setting the headers" $ do
+        get "/rpc/get_projects_and_guc_headers?id=eq.2&select=id"
+          `shouldRespondWith` [json|[{"id": 2}]|]
+          {matchHeaders = [
+              matchContentTypeJson,
+              "X-Test"   <:> "key1=val1; someValue; key2=val2",
+              "X-Test-2" <:> "key1=val1"]}
+        get "/rpc/get_int_and_guc_headers?num=1"
+          `shouldRespondWith` [json|1|]
+          {matchHeaders = [
+              matchContentTypeJson,
+              "X-Test"   <:> "key1=val1; someValue; key2=val2",
+              "X-Test-2" <:> "key1=val1"]}
+        post "/rpc/get_int_and_guc_headers" [json|{"num": 1}|]
+          `shouldRespondWith` [json|1|]
+          {matchHeaders = [
+              matchContentTypeJson,
+              "X-Test"   <:> "key1=val1; someValue; key2=val2",
+              "X-Test-2" <:> "key1=val1"]}
+
+      it "fails when setting headers with wrong json structure" $ do
+        get "/rpc/bad_guc_headers_1" `shouldRespondWith` 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
+
+      it "can set the same http header twice" $
+        get "/rpc/set_cookie_twice"
+          `shouldRespondWith` "null"
+          {matchHeaders = [
+              matchContentTypeJson,
+              "Set-Cookie" <:> "sessionid=38afes7a8; HttpOnly; Path=/",
+              "Set-Cookie" <:> "id=a3fWa; Expires=Wed, 21 Oct 2015 07:28:00 GMT; Secure; HttpOnly"]}
+
+    context "Use of the phraseto_tsquery function" $ do
+      it "finds matches" $
+        get "/tsearch?text_search_vector=phfts.The%20Fat%20Cats" `shouldRespondWith`
+          [json| [{"text_search_vector": "'ate':3 'cat':2 'fat':1 'rat':4" }] |]
+          { matchHeaders = [matchContentTypeJson] }
+
+      it "finds matches with different dictionaries" $
+        get "/tsearch?text_search_vector=phfts(german).Art%20Spass" `shouldRespondWith`
+          [json| [{"text_search_vector": "'art':4 'spass':5 'unmog':7" }] |]
+          { matchHeaders = [matchContentTypeJson] }
+
+      it "can be negated with not operator" $
+        get "/tsearch?text_search_vector=not.phfts(english).The%20Fat%20Cats" `shouldRespondWith`
+          [json| [
+            {"text_search_vector": "'fun':5 'imposs':9 'kind':3"},
+            {"text_search_vector": "'also':2 'fun':3 'possibl':8"},
+            {"text_search_vector": "'amus':5 'fair':7 'impossibl':9 'peu':4"},
+            {"text_search_vector": "'art':4 'spass':5 'unmog':7"}]|]
+          { matchHeaders = [matchContentTypeJson] }
+
+      it "can be used with or query param" $
+        get "/tsearch?or=(text_search_vector.phfts(german).Art%20Spass, text_search_vector.phfts(french).amusant, text_search_vector.fts(english).impossible)" `shouldRespondWith`
+          [json|[
+            {"text_search_vector": "'fun':5 'imposs':9 'kind':3" },
+            {"text_search_vector": "'amus':5 'fair':7 'impossibl':9 'peu':4" },
+            {"text_search_vector": "'art':4 'spass':5 'unmog':7"}
+          ]|] { matchHeaders = [matchContentTypeJson] }
+
+      it "should work when used with GET RPC" $
+        get "/rpc/get_tsearch?text_search_vector=phfts(english).impossible" `shouldRespondWith`
+          [json|[{"text_search_vector":"'fun':5 'imposs':9 'kind':3"}]|]
+          { matchHeaders = [matchContentTypeJson] }

test/Feature/QueryLimitedSpec.hs

@@ -5,7 +5,6 @@ import Test.Hspec.Wai
 import Test.Hspec.Wai.JSON
 import Network.HTTP.Types
 import Network.Wai.Test (SResponse(simpleHeaders, simpleStatus))
-import Text.Heredoc
 import SpecHelper
 import Network.Wai (Application)
 
@@ -16,9 +15,8 @@ spec =
   describe "Requesting many items with server limits enabled" $ do
     it "restricts results" $
       get "/items"
-        `shouldRespondWith` ResponseMatcher {
-          matchBody    = Just [json| [{"id":1},{"id":2}] |]
-        , matchStatus  = 200
+        `shouldRespondWith` [json| [{"id":1},{"id":2}] |]
+        { matchStatus  = 200
         , matchHeaders = ["Content-Range" <:> "0-1/*"]
         }
 
@@ -32,17 +30,14 @@ spec =
 
     it "limit works on all levels" $
       get "/users?select=id,tasks{id}&order=id.asc&tasks.order=id.asc"
-        `shouldRespondWith` ResponseMatcher {
-          matchBody    = Just [str|[{"id":1,"tasks":[{"id":1},{"id":2}]},{"id":2,"tasks":[{"id":5},{"id":6}]}]|]
-        , matchStatus  = 200
+        `shouldRespondWith` [json|[{"id":1,"tasks":[{"id":1},{"id":2}]},{"id":2,"tasks":[{"id":5},{"id":6}]}]|]
+        { matchStatus  = 200
         , matchHeaders = ["Content-Range" <:> "0-1/*"]
         }
 
     it "limit is not applied to parent embeds" $
       get "/tasks?select=id,project{id}&id=gt.5"
-        `shouldRespondWith` ResponseMatcher {
-          matchBody    = Just [str|[{"id":6,"project":{"id":3}},{"id":7,"project":{"id":4}}]|]
-        , matchStatus  = 200
+        `shouldRespondWith` [json|[{"id":6,"project":{"id":3}},{"id":7,"project":{"id":4}}]|]
+        { matchStatus  = 200
         , matchHeaders = ["Content-Range" <:> "0-1/*"]
         }
-

test/Feature/QuerySpec.hs

@@ -4,7 +4,7 @@ import Test.Hspec hiding (pendingWith)
 import Test.Hspec.Wai
 import Test.Hspec.Wai.JSON
 import Network.HTTP.Types
-import Network.Wai.Test (SResponse(simpleHeaders,simpleStatus,simpleBody))
+import Network.Wai.Test (SResponse(simpleHeaders))
 
 import SpecHelper
 import Text.Heredoc
@@ -30,68 +30,44 @@ spec = do
   describe "Filtering response" $ do
     it "matches with equality" $
       get "/items?id=eq.5"
-        `shouldRespondWith` ResponseMatcher {
-          matchBody    = Just [json| [{"id":5}] |]
-        , matchStatus  = 200
-        , matchHeaders = ["Content-Range" <:> "0-0/*"]
-        }
+        `shouldRespondWith` [json| [{"id":5}] |]
+        { matchHeaders = ["Content-Range" <:> "0-0/*"] }
 
     it "matches with equality using not operator" $
       get "/items?id=not.eq.5"
-        `shouldRespondWith` ResponseMatcher {
-          matchBody    = Just [json| [{"id":1},{"id":2},{"id":3},{"id":4},{"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-13/*"]
-        }
+        `shouldRespondWith` [json| [{"id":1},{"id":2},{"id":3},{"id":4},{"id":6},{"id":7},{"id":8},{"id":9},{"id":10},{"id":11},{"id":12},{"id":13},{"id":14},{"id":15}] |]
+        { matchHeaders = ["Content-Range" <:> "0-13/*"] }
 
     it "matches with more than one condition using not operator" $
       get "/simple_pk?k=like.*yx&extra=not.eq.u" `shouldRespondWith` "[]"
 
     it "matches with inequality using not operator" $ do
       get "/items?id=not.lt.14&order=id.asc"
-        `shouldRespondWith` ResponseMatcher {
-          matchBody    = Just [json| [{"id":14},{"id":15}] |]
-        , matchStatus  = 200
-        , matchHeaders = ["Content-Range" <:> "0-1/*"]
-        }
+        `shouldRespondWith` [json| [{"id":14},{"id":15}] |]
+        { matchHeaders = ["Content-Range" <:> "0-1/*"] }
       get "/items?id=not.gt.2&order=id.asc"
-        `shouldRespondWith` ResponseMatcher {
-          matchBody    = Just [json| [{"id":1},{"id":2}] |]
-        , matchStatus  = 200
-        , matchHeaders = ["Content-Range" <:> "0-1/*"]
-        }
+        `shouldRespondWith` [json| [{"id":1},{"id":2}] |]
+        { matchHeaders = ["Content-Range" <:> "0-1/*"] }
 
     it "matches items IN" $
       get "/items?id=in.1,3,5"
-        `shouldRespondWith` ResponseMatcher {
-          matchBody    = Just [json| [{"id":1},{"id":3},{"id":5}] |]
-        , matchStatus  = 200
-        , matchHeaders = ["Content-Range" <:> "0-2/*"]
-        }
-
-    it "matches items NOT IN" $
-      get "/items?id=notin.2,4,6,7,8,9,10,11,12,13,14,15"
-        `shouldRespondWith` ResponseMatcher {
-          matchBody    = Just [json| [{"id":1},{"id":3},{"id":5}] |]
-        , matchStatus  = 200
-        , matchHeaders = ["Content-Range" <:> "0-2/*"]
-        }
+        `shouldRespondWith` [json| [{"id":1},{"id":3},{"id":5}] |]
+        { matchHeaders = ["Content-Range" <:> "0-2/*"] }
 
     it "matches items NOT IN using not operator" $
       get "/items?id=not.in.2,4,6,7,8,9,10,11,12,13,14,15"
-        `shouldRespondWith` ResponseMatcher {
-          matchBody    = Just [json| [{"id":1},{"id":3},{"id":5}] |]
-        , matchStatus  = 200
-        , matchHeaders = ["Content-Range" <:> "0-2/*"]
-        }
+        `shouldRespondWith` [json| [{"id":1},{"id":3},{"id":5}] |]
+        { matchHeaders = ["Content-Range" <:> "0-2/*"] }
 
     it "matches nulls using not operator" $
       get "/no_pk?a=not.is.null" `shouldRespondWith`
         [json| [{"a":"1","b":"0"},{"a":"2","b":"0"}] |]
+        { matchHeaders = [matchContentTypeJson] }
 
     it "matches nulls in varchar and numeric fields alike" $ do
       get "/no_pk?a=is.null" `shouldRespondWith`
         [json| [{"a": null, "b": null}] |]
+        { matchHeaders = [matchContentTypeJson] }
 
       get "/nullable_integer?a=is.null" `shouldRespondWith` [str|[{"a":null}]|]
 
@@ -109,48 +85,121 @@ spec = do
 
     it "matches with ilike" $ do
       get "/simple_pk?k=ilike.xy*&order=extra.asc" `shouldRespondWith`
-        [str|[{"k":"xyyx","extra":"u"},{"k":"xYYx","extra":"v"}]|]
+        [json|[{"k":"xyyx","extra":"u"},{"k":"xYYx","extra":"v"}]|]
+        { matchHeaders = [matchContentTypeJson] }
       get "/simple_pk?k=ilike.*YY*&order=extra.asc" `shouldRespondWith`
-        [str|[{"k":"xyyx","extra":"u"},{"k":"xYYx","extra":"v"}]|]
+        [json|[{"k":"xyyx","extra":"u"},{"k":"xYYx","extra":"v"}]|]
+        { matchHeaders = [matchContentTypeJson] }
 
     it "matches with ilike using not operator" $
       get "/simple_pk?k=not.ilike.xy*&order=extra.asc" `shouldRespondWith` "[]"
 
-    it "matches with tsearch @@" $
-      get "/tsearch?text_search_vector=@@.foo" `shouldRespondWith`
-        [json| [{"text_search_vector":"'bar':2 'foo':1"}] |]
+    describe "Full text search operator" $ do
+      it "finds matches with to_tsquery" $
+        get "/tsearch?text_search_vector=fts.impossible" `shouldRespondWith`
+          [json| [{"text_search_vector": "'fun':5 'imposs':9 'kind':3" }] |]
+          { matchHeaders = [matchContentTypeJson] }
 
-    it "matches with tsearch @@ using not operator" $
-      get "/tsearch?text_search_vector=not.@@.foo" `shouldRespondWith`
-        [json| [{"text_search_vector":"'baz':1 'qux':2"}] |]
+      it "can use lexeme boolean operators(&=%26, |=%7C, !) in to_tsquery" $ do
+        get "/tsearch?text_search_vector=fts.fun%26possible" `shouldRespondWith`
+          [json| [ {"text_search_vector": "'also':2 'fun':3 'possibl':8"}] |]
+          { matchHeaders = [matchContentTypeJson] }
+        get "/tsearch?text_search_vector=fts.impossible%7Cpossible" `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=fts.fun%26!possible" `shouldRespondWith`
+          [json| [ {"text_search_vector": "'fun':5 'imposs':9 'kind':3"}] |]
+          { matchHeaders = [matchContentTypeJson] }
+
+      it "finds matches with plainto_tsquery" $
+        get "/tsearch?text_search_vector=plfts.The%20Fat%20Rats" `shouldRespondWith`
+          [json| [ {"text_search_vector": "'ate':3 'cat':2 'fat':1 'rat':4" }] |]
+          { 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" }] |]
+          { matchHeaders = [matchContentTypeJson] }
+        get "/tsearch?text_search_vector=plfts(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| [
+            {"text_search_vector": "'amus':5 'fair':7 'impossibl':9 'peu':4"},
+            {"text_search_vector": "'art':4 'spass':5 'unmog':7"}]|]
+          { matchHeaders = [matchContentTypeJson] }
+        get "/tsearch?text_search_vector=not.fts(english).impossible%7Cfat%7Cfun" `shouldRespondWith`
+          [json| [
+            {"text_search_vector": "'amus':5 'fair':7 'impossibl':9 'peu':4"},
+            {"text_search_vector": "'art':4 'spass':5 'unmog':7"}]|]
+          { matchHeaders = [matchContentTypeJson] }
+        get "/tsearch?text_search_vector=not.plfts.The%20Fat%20Rats" `shouldRespondWith`
+          [json| [
+            {"text_search_vector": "'fun':5 'imposs':9 'kind':3"},
+            {"text_search_vector": "'also':2 'fun':3 'possibl':8"},
+            {"text_search_vector": "'amus':5 'fair':7 'impossibl':9 'peu':4"},
+            {"text_search_vector": "'art':4 'spass':5 'unmog':7"}]|]
+          { matchHeaders = [matchContentTypeJson] }
+
+      -- TODO: remove in 0.5.0 as deprecated
+      it "Deprecated @@ operator, pending to remove" $ do
+        get "/tsearch?text_search_vector=@@.impossible" `shouldRespondWith`
+          [json| [{"text_search_vector": "'fun':5 'imposs':9 'kind':3" }] |]
+          { matchHeaders = [matchContentTypeJson] }
+        get "/tsearch?text_search_vector=not.@@.impossible%7Cfat%7Cfun" `shouldRespondWith`
+          [json| [
+            {"text_search_vector": "'amus':5 'fair':7 'impossibl':9 'peu':4"},
+            {"text_search_vector": "'art':4 'spass':5 'unmog':7"}]|]
+          { matchHeaders = [matchContentTypeJson] }
+        get "/tsearch?text_search_vector=not.@@(english).impossible%7Cfat%7Cfun" `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`
         [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}] |]
+        { matchHeaders = [matchContentTypeJson] }
 
     it "order by computed column" $
       get "/items?order=anti_id.desc" `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}] |]
+        { matchHeaders = [matchContentTypeJson] }
 
     it "matches filtering nested items 2" $
       get "/clients?select=id,projects{id,tasks2{id,name}}&projects.tasks.name=like.Design*"
-        `shouldRespondWith` ResponseMatcher {
-          matchBody    = Just [json| {"message":"could not find foreign keys between these entities, no relation between projects and tasks2"}|]
-        , matchStatus  = 400
-        , matchHeaders = []
+        `shouldRespondWith` [json| {"message":"Could not find foreign keys between these entities, No relation found between projects and tasks2"}|]
+        { matchStatus  = 400
+        , matchHeaders = [matchContentTypeJson]
         }
 
     it "matches filtering nested items" $
       get "/clients?select=id,projects{id,tasks{id,name}}&projects.tasks.name=like.Design*" `shouldRespondWith`
-        [str|[{"id":1,"projects":[{"id":1,"tasks":[{"id":1,"name":"Design w7"}]},{"id":2,"tasks":[{"id":3,"name":"Design w10"}]}]},{"id":2,"projects":[{"id":3,"tasks":[{"id":5,"name":"Design IOS"}]},{"id":4,"tasks":[{"id":7,"name":"Design OSX"}]}]}]|]
+        [json|[{"id":1,"projects":[{"id":1,"tasks":[{"id":1,"name":"Design w7"}]},{"id":2,"tasks":[{"id":3,"name":"Design w10"}]}]},{"id":2,"projects":[{"id":3,"tasks":[{"id":5,"name":"Design IOS"}]},{"id":4,"tasks":[{"id":7,"name":"Design OSX"}]}]}]|]
+        { matchHeaders = [matchContentTypeJson] }
 
-    it "matches with @> operator" $
+    it "matches with cs operator" $ do
+      get "/complex_items?select=id&arr_data=cs.{2}" `shouldRespondWith`
+        [json|[{"id":2},{"id":3}]|]
+        { matchHeaders = [matchContentTypeJson] }
+      -- TODO: remove in 0.5.0 as deprecated
       get "/complex_items?select=id&arr_data=@>.{2}" `shouldRespondWith`
-        [str|[{"id":2},{"id":3}]|]
+        [json|[{"id":2},{"id":3}]|]
+        { matchHeaders = [matchContentTypeJson] }
 
-    it "matches with <@ operator" $
+    it "matches with cd operator" $ do
+      get "/complex_items?select=id&arr_data=cd.{1,2,4}" `shouldRespondWith`
+        [json|[{"id":1},{"id":2}]|]
+        { matchHeaders = [matchContentTypeJson] }
+      -- TODO: remove in 0.5.0 as deprecated
       get "/complex_items?select=id&arr_data=<@.{1,2,4}" `shouldRespondWith`
-        [str|[{"id":1},{"id":2}]|]
+        [json|[{"id":1},{"id":2}]|]
+        { matchHeaders = [matchContentTypeJson] }
 
 
   describe "Shaping response with select parameter" $ do
@@ -166,45 +215,50 @@ spec = do
     it "one simple column" $
       get "/complex_items?select=id" `shouldRespondWith`
         [json| [{"id":1},{"id":2},{"id":3}] |]
+        { matchHeaders = [matchContentTypeJson] }
 
     it "rename simple column" $
       get "/complex_items?id=eq.1&select=myId:id" `shouldRespondWith`
         [json| [{"myId":1}] |]
+        { matchHeaders = [matchContentTypeJson] }
 
 
     it "one simple column with casting (text)" $
       get "/complex_items?select=id::text" `shouldRespondWith`
         [json| [{"id":"1"},{"id":"2"},{"id":"3"}] |]
+        { matchHeaders = [matchContentTypeJson] }
 
     it "rename simple column with casting" $
       get "/complex_items?id=eq.1&select=myId:id::text" `shouldRespondWith`
         [json| [{"myId":"1"}] |]
+        { matchHeaders = [matchContentTypeJson] }
 
     it "json column" $
       get "/complex_items?id=eq.1&select=settings" `shouldRespondWith`
         [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` ResponseMatcher {
-          matchBody    = Just [json| {"hint":null,"details":null,"code":"22P02","message":"invalid input syntax for integer: \"baz\""} |]
-        , matchStatus  = 400
+        `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` ResponseMatcher {
-          matchBody    = Just [json| {"hint":null,"details":null,"code":"42704","message":"type \"fakecolumntype\" does not exist"} |]
-        , matchStatus  = 400
+        `shouldRespondWith` [json| {"hint":null,"details":null,"code":"42704","message":"type \"fakecolumntype\" does not exist"} |]
+        { matchStatus  = 400
         , matchHeaders = []
         }
 
@@ -212,23 +266,61 @@ spec = do
     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`
-        [str|[{"id":1,"name":"Windows 7","clients":{"id":1,"name":"Microsoft"},"tasks":[{"id":1,"name":"Design w7"},{"id":2,"name":"Code w7"}]}]|]
+        [json|[{"id":1,"name":"Windows 7","clients":{"id":1,"name":"Microsoft"},"tasks":[{"id":1,"name":"Design w7"},{"id":2,"name":"Code w7"}]}]|]
+        { matchHeaders = [matchContentTypeJson] }
+
+    it "requesting parent without specifying primary key" $ do
+      get "/projects?select=name,client{name}" `shouldRespondWith`
+        [json|[
+          {"name":"Windows 7","client":{"name": "Microsoft"}},
+          {"name":"Windows 10","client":{"name": "Microsoft"}},
+          {"name":"IOS","client":{"name": "Apple"}},
+          {"name":"OSX","client":{"name": "Apple"}},
+          {"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`
+        [json|[
+          {"name":"Windows 7","client":{"name": "Microsoft", "clientId": 1}},
+          {"name":"Windows 10","client":{"name": "Microsoft", "clientId": 1}},
+          {"name":"IOS","client":{"name": "Apple", "clientId": 2}},
+          {"name":"OSX","client":{"name": "Apple", "clientId": 2}},
+          {"name":"Orphan","client":null}
+        ]|]
+        { matchHeaders = [matchContentTypeJson] }
+
+    it "requesting parent and specifying/renaming one key of the composite primary key" $ do
+      get "/comments?select=*,users_tasks{userId:user_id}" `shouldRespondWith`
+        [json|[{"id":1,"commenter_id":1,"user_id":2,"task_id":6,"content":"Needs to be delivered ASAP","users_tasks":{"userId": 2}}]|]
+        { matchHeaders = [matchContentTypeJson] }
+      get "/comments?select=*,users_tasks{taskId:task_id}" `shouldRespondWith`
+        [json|[{"id":1,"commenter_id":1,"user_id":2,"task_id":6,"content":"Needs to be delivered ASAP","users_tasks":{"taskId": 6}}]|]
+        { matchHeaders = [matchContentTypeJson] }
 
     it "embed data with two fk pointing to the same table" $
       get "/orders?id=eq.1&select=id, name, billing_address_id{id}, shipping_address_id{id}" `shouldRespondWith`
@@ -237,7 +329,8 @@ spec = do
 
     it "requesting parents and children while renaming them" $
       get "/projects?id=eq.1&select=myId:id, name, project_client:client_id{*}, project_tasks:tasks{id, name}" `shouldRespondWith`
-        [str|[{"myId":1,"name":"Windows 7","project_client":{"id":1,"name":"Microsoft"},"project_tasks":[{"id":1,"name":"Design w7"},{"id":2,"name":"Code w7"}]}]|]
+        [json|[{"myId":1,"name":"Windows 7","project_client":{"id":1,"name":"Microsoft"},"project_tasks":[{"id":1,"name":"Design w7"},{"id":2,"name":"Code w7"}]}]|]
+        { matchHeaders = [matchContentTypeJson] }
 
     it "requesting parents two levels up while using FK to specify the link" $
       get "/tasks?id=eq.1&select=id,name,project:project_id{id,name,client:client_id{id,name}}" `shouldRespondWith`
@@ -254,7 +347,8 @@ spec = do
 
     it "rows with missing parents are included" $
       get "/projects?id=in.1,5&select=id,clients{id}" `shouldRespondWith`
-        [str|[{"id":1,"clients":{"id":1}},{"id":5,"clients":null}]|]
+        [json|[{"id":1,"clients":{"id":1}},{"id":5,"clients":null}]|]
+        { matchHeaders = [matchContentTypeJson] }
 
     it "rows with no children return [] instead of null" $
       get "/projects?id=in.5&select=id,tasks{id}" `shouldRespondWith`
@@ -262,125 +356,153 @@ spec = do
 
     it "requesting children 2 levels" $
       get "/clients?id=eq.1&select=id,projects{id,tasks{id}}" `shouldRespondWith`
-        [str|[{"id":1,"projects":[{"id":1,"tasks":[{"id":1},{"id":2}]},{"id":2,"tasks":[{"id":3},{"id":4}]}]}]|]
+        [json|[{"id":1,"projects":[{"id":1,"tasks":[{"id":1},{"id":2}]},{"id":2,"tasks":[{"id":3},{"id":4}]}]}]|]
+        { matchHeaders = [matchContentTypeJson] }
+
+    it "requesting children 2 levels (with relation path fixed)" $
+      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 "requesting many<->many relation" $
       get "/tasks?select=id,users{id}" `shouldRespondWith`
-        [str|[{"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":[]}]|]
+        [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] }
+
+    it "requesting many<->many relation (with relation path fixed)" $
+      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] }
 
     it "requesting many<->many relation with rename" $
       get "/tasks?id=eq.1&select=id,theUsers:users{id}" `shouldRespondWith`
-        [str|[{"id":1,"theUsers":[{"id":1},{"id":3}]}]|]
+        [json|[{"id":1,"theUsers":[{"id":1},{"id":3}]}]|]
+        { matchHeaders = [matchContentTypeJson] }
 
 
     it "requesting many<->many relation reverse" $
       get "/users?select=id,tasks{id}" `shouldRespondWith`
-        [str|[{"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}]}]|]
+        [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`
-        [str|[{"id":1,"name":"Windows 7","clients":{"id":1,"name":"Microsoft"},"tasks":[{"id":1,"name":"Design w7"},{"id":2,"name":"Code w7"}]}]|]
+        [json|[{"id":1,"name":"Windows 7","clients":{"id":1,"name":"Microsoft"},"tasks":[{"id":1,"name":"Design w7"},{"id":2,"name":"Code w7"}]}]|]
+        { matchHeaders = [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`
-        [str|[{"t_id":1,"name":"Windows 7","clients":{"id":1,"name":"Microsoft"},"tasks":[{"id":1,"name":"Design w7"},{"id":2,"name":"Code w7"}]}]|]
+        [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 "requesting children with composite key" $
       get "/users_tasks?user_id=eq.2&task_id=eq.6&select=*, comments{content}" `shouldRespondWith`
-        [str|[{"user_id":2,"task_id":6,"comments":[{"content":"Needs to be delivered ASAP"}]}]|]
+        [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`
-        [str|[{"id":1,"articleStars":[{"users":{"id":1,"name":"Angela Martin"}},{"users":{"id":2,"name":"Michael Scott"}},{"users":{"id":3,"name":"Dwight Schrute"}}]}]|]
+        [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 select by column name" $
-      get "/projects?id=in.1,3&select=id,name,client_id,client_id{id,name}" `shouldRespondWith`
-        [str|[{"id":1,"name":"Windows 7","client_id":1,"client_id":{"id":1,"name":"Microsoft"}},{"id":3,"name":"IOS","client_id":2,"client_id":{"id":2,"name":"Apple"}}]|]
+    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"}}]|]
+        { matchHeaders = [matchContentTypeJson] }
+    
+    it "can embed by FK column name and select the FK value at the same time, if aliased" $
+      get "/projects?id=in.1,3&select=id,name,client_id,client:client_id{id,name}" `shouldRespondWith`
+        [json|[{"id":1,"name":"Windows 7","client_id":1,"client":{"id":1,"name":"Microsoft"}},{"id":3,"name":"IOS","client_id":2,"client":{"id":2,"name":"Apple"}}]|]
+        { matchHeaders = [matchContentTypeJson] }
 
     it "can select by column name sans id" $
       get "/projects?id=in.1,3&select=id,name,client_id,client{id,name}" `shouldRespondWith`
-        [str|[{"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"}}]|]
+        [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 "ordering response" $ do
     it "by a column asc" $
       get "/items?id=lte.2&order=id.asc"
-        `shouldRespondWith` ResponseMatcher {
-          matchBody    = Just [json| [{"id":1},{"id":2}] |]
-        , matchStatus  = 200
+        `shouldRespondWith` [json| [{"id":1},{"id":2}] |]
+        { matchStatus  = 200
         , matchHeaders = ["Content-Range" <:> "0-1/*"]
         }
     it "by a column desc" $
       get "/items?id=lte.2&order=id.desc"
-        `shouldRespondWith` ResponseMatcher {
-          matchBody    = Just [json| [{"id":2},{"id":1}] |]
-        , matchStatus  = 200
+        `shouldRespondWith` [json| [{"id":2},{"id":1}] |]
+        { matchStatus  = 200
         , matchHeaders = ["Content-Range" <:> "0-1/*"]
         }
 
     it "by a column with nulls first" $
       get "/no_pk?order=a.nullsfirst"
-        `shouldRespondWith` ResponseMatcher {
-          matchBody = Just [json| [{"a":null,"b":null},
+        `shouldRespondWith` [json| [{"a":null,"b":null},
                               {"a":"1","b":"0"},
                               {"a":"2","b":"0"}
                               ] |]
-        , matchStatus = 200
+        { matchStatus = 200
         , matchHeaders = ["Content-Range" <:> "0-2/*"]
         }
 
     it "by a column asc with nulls last" $
       get "/no_pk?order=a.asc.nullslast"
-        `shouldRespondWith` ResponseMatcher {
-          matchBody = Just [json| [{"a":"1","b":"0"},
+        `shouldRespondWith` [json| [{"a":"1","b":"0"},
                               {"a":"2","b":"0"},
                               {"a":null,"b":null}] |]
-        , matchStatus = 200
+        { matchStatus = 200
         , matchHeaders = ["Content-Range" <:> "0-2/*"]
         }
 
     it "by a column desc with nulls first" $
       get "/no_pk?order=a.desc.nullsfirst"
-        `shouldRespondWith` ResponseMatcher {
-          matchBody = Just [json| [{"a":null,"b":null},
+        `shouldRespondWith` [json| [{"a":null,"b":null},
                               {"a":"2","b":"0"},
                               {"a":"1","b":"0"}] |]
-        , matchStatus = 200
+        { matchStatus = 200
         , matchHeaders = ["Content-Range" <:> "0-2/*"]
         }
 
     it "by a column desc with nulls last" $
       get "/no_pk?order=a.desc.nullslast"
-        `shouldRespondWith` ResponseMatcher {
-          matchBody = Just [json| [{"a":"2","b":"0"},
+        `shouldRespondWith` [json| [{"a":"2","b":"0"},
                               {"a":"1","b":"0"},
                               {"a":null,"b":null}] |]
-        , matchStatus = 200
+        { matchStatus = 200
         , matchHeaders = ["Content-Range" <:> "0-2/*"]
         }
 
     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
 
     it "ordering embeded entities" $
       get "/projects?id=eq.1&select=id, name, tasks{id, name}&tasks.order=name.asc" `shouldRespondWith`
-        [str|[{"id":1,"name":"Windows 7","tasks":[{"id":2,"name":"Code w7"},{"id":1,"name":"Design w7"}]}]|]
+        [json|[{"id":1,"name":"Windows 7","tasks":[{"id":2,"name":"Code w7"},{"id":1,"name":"Design w7"}]}]|]
+        { matchHeaders = [matchContentTypeJson] }
 
     it "ordering embeded entities with alias" $
       get "/projects?id=eq.1&select=id, name, the_tasks:tasks{id, name}&tasks.order=name.asc" `shouldRespondWith`
-        [str|[{"id":1,"name":"Windows 7","the_tasks":[{"id":2,"name":"Code w7"},{"id":1,"name":"Design w7"}]}]|]
+        [json|[{"id":1,"name":"Windows 7","the_tasks":[{"id":2,"name":"Code w7"},{"id":1,"name":"Design w7"}]}]|]
+        { matchHeaders = [matchContentTypeJson] }
 
     it "ordering embeded entities, two levels" $
       get "/projects?id=eq.1&select=id, name, tasks{id, name, users{id, name}}&tasks.order=name.asc&tasks.users.order=name.desc" `shouldRespondWith`
-        [str|[{"id":1,"name":"Windows 7","tasks":[{"id":2,"name":"Code w7","users":[{"id":1,"name":"Angela Martin"}]},{"id":1,"name":"Design w7","users":[{"id":3,"name":"Dwight Schrute"},{"id":1,"name":"Angela Martin"}]}]}]|]
+        [json|[{"id":1,"name":"Windows 7","tasks":[{"id":2,"name":"Code w7","users":[{"id":1,"name":"Angela Martin"}]},{"id":1,"name":"Design w7","users":[{"id":3,"name":"Dwight Schrute"},{"id":1,"name":"Angela Martin"}]}]}]|]
+        { matchHeaders = [matchContentTypeJson] }
 
     it "ordering embeded parents does not break things" $
       get "/projects?id=eq.1&select=id, name, clients{id, name}&clients.order=name.asc" `shouldRespondWith`
@@ -432,18 +554,16 @@ spec = do
     it "should respond with CSV to 'text/csv' request" $
       request methodGet "/simple_pk"
               (acceptHdrs "text/csv; version=1") ""
-        `shouldRespondWith` ResponseMatcher {
-          matchBody    = Just "k,extra\nxyyx,u\nxYYx,v"
-        , matchStatus  = 200
+        `shouldRespondWith` "k,extra\nxyyx,u\nxYYx,v"
+        { matchStatus  = 200
         , matchHeaders = ["Content-Type" <:> "text/csv; charset=utf-8"]
         }
 
   describe "Canonical location" $ do
     it "Sets Content-Location with alphabetized params" $
       get "/no_pk?b=eq.1&a=eq.1"
-        `shouldRespondWith` ResponseMatcher {
-          matchBody    = Just "[]"
-        , matchStatus  = 200
+        `shouldRespondWith` "[]"
+        { matchStatus  = 200
         , matchHeaders = ["Content-Location" <:> "/no_pk?a=eq.1&b=eq.1"]
         }
 
@@ -458,149 +578,231 @@ spec = 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"}}}] |]
-
-  describe "remote procedure call" $ do
-    context "a proc that returns a set" $ do
-      it "returns paginated results" $
-        request methodPost "/rpc/getitemrange"
-                (rangeHdrs (ByteRangeFromTo 0 0))  [json| { "min": 2, "max": 4 } |]
-           `shouldRespondWith` ResponseMatcher {
-              matchBody    = Just [json| [{"id":3}] |]
-            , matchStatus = 200
-            , matchHeaders = ["Content-Range" <:> "0-0/*"]
-            }
-
-      it "includes total count if requested" $
-        request methodPost "/rpc/getitemrange"
-                (rangeHdrsWithCount (ByteRangeFromTo 0 0))
-                [json| { "min": 2, "max": 4 } |]
-           `shouldRespondWith` ResponseMatcher {
-              matchBody    = Just [json| [{"id":3}] |]
-            , matchStatus = 206 -- it now knows the response is partial
-            , matchHeaders = ["Content-Range" <:> "0-0/2"]
-            }
-
-
-      it "returns proper json" $
-        post "/rpc/getitemrange" [json| { "min": 2, "max": 4 } |] `shouldRespondWith`
-          [json| [ {"id": 3}, {"id":4} ] |]
-
-    context "unknown function" $
-      it "returns 404" $
-        post "/rpc/fakefunc" [json| {} |] `shouldRespondWith` 404
-
-    context "shaping the response returned by a proc" $ do
-      it "returns a project" $
-        post "/rpc/getproject" [json| { "id": 1} |] `shouldRespondWith`
-          [str|[{"id":1,"name":"Windows 7","client_id":1}]|]
-
-      it "can filter proc results" $
-        post "/rpc/getallprojects?id=gt.1&id=lt.5&select=id" [json| {} |] `shouldRespondWith`
-          [json|[{"id":2},{"id":3},{"id":4}]|]
-
-      it "can limit proc results" $
-        post "/rpc/getallprojects?id=gt.1&id=lt.5&select=id?limit=2&offset=1" [json| {} |]
-          `shouldRespondWith` ResponseMatcher {
-               matchBody    = Just [json|[{"id":3},{"id":4}]|]
-             , matchStatus = 200
-             , matchHeaders = ["Content-Range" <:> "1-2/*"]
-             }
-
-      it "select works on the first level" $
-        post "/rpc/getproject?select=id,name" [json| { "id": 1} |] `shouldRespondWith`
-          [str|[{"id":1,"name":"Windows 7"}]|]
-
-      it "can embed foreign entities to the items returned by a proc" $
-        post "/rpc/getproject?select=id,name,client{id},tasks{id}" [json| { "id": 1} |] `shouldRespondWith`
-          [str|[{"id":1,"name":"Windows 7","client":{"id":1},"tasks":[{"id":1},{"id":2}]}]|]
-
-    context "a proc that returns an empty rowset" $
-      it "returns empty json array" $
-        post "/rpc/test_empty_rowset" [json| {} |] `shouldRespondWith`
-          [json| [] |]
-
-    context "a proc that returns plain text" $ do
-      it "returns proper json" $
-        post "/rpc/sayhello" [json| { "name": "world" } |] `shouldRespondWith`
-          [json|"Hello, world"|]
-
-      it "can handle unicode" $
-        post "/rpc/sayhello" [json| { "name": "￥" } |] `shouldRespondWith`
-          [json|"Hello, ￥"|]
-
-    context "improper input" $ do
-      it "rejects unknown content type even if payload is good" $
-        request methodPost "/rpc/sayhello"
-          (acceptHdrs "audio/mpeg3") [json| { "name": "world" } |]
-            `shouldRespondWith` 415
-      it "rejects malformed json payload" $ do
-        p <- request methodPost "/rpc/sayhello"
-          (acceptHdrs "application/json") "sdfsdf"
-        liftIO $ do
-          simpleStatus p `shouldBe` badRequest400
-          isErrorFormat (simpleBody p) `shouldBe` True
-      it "treats simple plpgsql raise as invalid input" $ do
-        p <- post "/rpc/problem" "{}"
-        liftIO $ do
-          simpleStatus p `shouldBe` badRequest400
-          isErrorFormat (simpleBody p) `shouldBe` True
-
-    context "unsupported verbs" $ do
-      it "DELETE fails" $
-        request methodDelete "/rpc/sayhello" [] ""
-          `shouldRespondWith` 405
-      it "PATCH fails" $
-        request methodPatch "/rpc/sayhello" [] ""
-          `shouldRespondWith` 405
-      it "OPTIONS fails" $
-        -- TODO: should return info about the function
-        request methodOptions "/rpc/sayhello" [] ""
-          `shouldRespondWith` 405
-      it "GET fails with 405 on unknown procs" $
-        -- TODO: should this be 404?
-        get "/rpc/fake" `shouldRespondWith` 405
-      it "GET with 405 on known procs" $
-        get "/rpc/sayhello" `shouldRespondWith` 405
-
-    it "executes the proc exactly once per request" $ do
-      post "/rpc/callcounter" [json| {} |] `shouldRespondWith`
-        [json|1|]
-      post "/rpc/callcounter" [json| {} |] `shouldRespondWith`
-        [json|2|]
-
-    context "expects a single json object" $ do
-      it "does not expand posted json into parameters" $
-        request methodPost "/rpc/singlejsonparam"
-          [("Prefer","params=single-object")] [json| { "p1": 1, "p2": "text", "p3" : {"obj":"text"} } |] `shouldRespondWith`
-          [json| { "p1": 1, "p2": "text", "p3" : {"obj":"text"} } |]
-
-      it "accepts parameters from an html form" $
-        request methodPost "/rpc/singlejsonparam"
-          [("Prefer","params=single-object"),("Content-Type", "application/x-www-form-urlencoded")]
-          ("integer=7&double=2.71828&varchar=forms+are+fun&" <>
-           "boolean=false&date=1900-01-01&money=$3.99&enum=foo") `shouldRespondWith`
-          [json| { "integer": "7", "double": "2.71828", "varchar" : "forms are fun"
-                 , "boolean":"false", "date":"1900-01-01", "money":"$3.99", "enum":"foo" } |]
+        { matchHeaders = [matchContentTypeJson] }
 
   describe "weird requests" $ do
     it "can query as normal" $ do
       get "/Escap3e;" `shouldRespondWith`
         [json| [{"so6meIdColumn":1},{"so6meIdColumn":2},{"so6meIdColumn":3},{"so6meIdColumn":4},{"so6meIdColumn":5}] |]
+        { matchHeaders = [matchContentTypeJson] }
       get "/ghostBusters" `shouldRespondWith`
         [json| [{"escapeId":1},{"escapeId":3},{"escapeId":5}] |]
+        { matchHeaders = [matchContentTypeJson] }
+
+    it "fails if an operator is not given" $
+      get "/ghostBusters?id=0" `shouldRespondWith` [json| {"details":"unexpected \"0\" expecting \"not\" or operator (eq, gt, ...)","message":"\"failed to parse filter (0)\" (line 1, column 1)"} |]
+        { matchStatus  = 400
+        , matchHeaders = [matchContentTypeJson]
+        }
 
     it "will embed a collection" $
       get "/Escap3e;?select=ghostBusters{*}" `shouldRespondWith`
         [json| [{"ghostBusters":[{"escapeId":1}]},{"ghostBusters":[]},{"ghostBusters":[{"escapeId":3}]},{"ghostBusters":[]},{"ghostBusters":[{"escapeId":5}]}] |]
+        { matchHeaders = [matchContentTypeJson] }
 
     it "will embed using a column" $
       get "/ghostBusters?select=escapeId{*}" `shouldRespondWith`
         [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 "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 "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 "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"]
+            }
+
+      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` 406
+
+  describe "HTTP request env vars" $ do
+    it "custom header is set" $
+      request methodPost "/rpc/get_guc_value"
+                [("Custom-Header", "test")]
+          [json| { "name": "request.header.custom-header" } |]
+          `shouldRespondWith`
+          [str|"test"|]
+          { matchStatus  = 200
+          , matchHeaders = [ matchContentTypeJson ]
+          }
+    it "standard header is set" $
+      request methodPost "/rpc/get_guc_value"
+                [("Origin", "http://example.com")]
+          [json| { "name": "request.header.origin" } |]
+          `shouldRespondWith`
+          [str|"http://example.com"|]
+          { matchStatus  = 200
+          , matchHeaders = [ matchContentTypeJson ]
+          }
+    it "current role is available as GUC claim" $
+      request methodPost "/rpc/get_guc_value" []
+          [json| { "name": "request.jwt.claim.role" } |]
+          `shouldRespondWith`
+          [str|"postgrest_test_anonymous"|]
+          { matchStatus  = 200
+          , matchHeaders = [ matchContentTypeJson ]
+          }
+    it "single cookie ends up as claims" $
+      request methodPost "/rpc/get_guc_value" [("Cookie","acookie=cookievalue")]
+        [json| {"name":"request.cookie.acookie"} |]
+          `shouldRespondWith`
+          [str|"cookievalue"|]
+          { matchStatus = 200
+          , matchHeaders = []
+          }
+
+    it "multiple cookies ends up as claims" $
+      request methodPost "/rpc/get_guc_value" [("Cookie","acookie=cookievalue;secondcookie=anothervalue")]
+        [json| {"name":"request.cookie.secondcookie"} |]
+          `shouldRespondWith`
+          [str|"anothervalue"|]
+          { matchStatus = 200
+          , matchHeaders = []
+          }
+
+  describe "values with quotes in IN and NOT IN" $ do
+    it "succeeds when only quoted values are present" $ do
+      get "/w_or_wo_comma_names?name=in.\"Hebdon, John\"" `shouldRespondWith`
+        [json| [{"name":"Hebdon, John"}] |]
+        { matchHeaders = [matchContentTypeJson] }
+      get "/w_or_wo_comma_names?name=in.\"Hebdon, John\",\"Williams, Mary\",\"Smith, Joseph\"" `shouldRespondWith`
+        [json| [{"name":"Hebdon, John"},{"name":"Williams, Mary"},{"name":"Smith, Joseph"}] |]
+        { matchHeaders = [matchContentTypeJson] }
+      get "/w_or_wo_comma_names?name=not.in.\"Hebdon, John\",\"Williams, Mary\",\"Smith, Joseph\"" `shouldRespondWith`
+        [json| [{"name":"David White"},{"name":"Larry Thompson"}] |]
+        { matchHeaders = [matchContentTypeJson] }
+
+    it "succeeds w/ and w/o quoted values" $ do
+      get "/w_or_wo_comma_names?name=in.David White,\"Hebdon, John\"" `shouldRespondWith`
+        [json| [{"name":"Hebdon, John"},{"name":"David White"}] |]
+        { matchHeaders = [matchContentTypeJson] }
+      get "/w_or_wo_comma_names?name=not.in.\"Hebdon, John\",Larry Thompson,\"Smith, Joseph\"" `shouldRespondWith`
+        [json| [{"name":"Williams, Mary"},{"name":"David White"}] |]
+        { matchHeaders = [matchContentTypeJson] }
+
+    it "checks well formed quoted values" $ do
+      get "/w_or_wo_comma_names?name=in.\"\"Hebdon, John\"" `shouldRespondWith`
+        [json| [] |] { matchHeaders = [matchContentTypeJson] }
+      get "/w_or_wo_comma_names?name=in.\"\"Hebdon, John\"\"Mary" `shouldRespondWith`
+        [json| [] |] { matchHeaders = [matchContentTypeJson] }
+      get "/w_or_wo_comma_names?name=in.Williams\"Hebdon, John\"" `shouldRespondWith`
+        [json| [] |] { matchHeaders = [matchContentTypeJson] }
+
+  describe "IN and NOT IN empty set" $ do
+    context "returns an empty result for IN when no value is present" $ do
+      it "works for integer" $
+        get "/items_with_different_col_types?int_data=in." `shouldRespondWith`
+          [json| [] |] { matchHeaders = [matchContentTypeJson] }
+      it "works for text" $
+        get "/items_with_different_col_types?text_data=in." `shouldRespondWith`
+          [json| [] |] { matchHeaders = [matchContentTypeJson] }
+      it "works for bool" $
+        get "/items_with_different_col_types?bool_data=in." `shouldRespondWith`
+          [json| [] |] { matchHeaders = [matchContentTypeJson] }
+      it "works for bytea" $
+        get "/items_with_different_col_types?bin_data=in." `shouldRespondWith`
+          [json| [] |] { matchHeaders = [matchContentTypeJson] }
+      it "works for char" $
+        get "/items_with_different_col_types?char_data=in." `shouldRespondWith`
+          [json| [] |] { matchHeaders = [matchContentTypeJson] }
+      it "works for date" $
+        get "/items_with_different_col_types?date_data=in." `shouldRespondWith`
+          [json| [] |] { matchHeaders = [matchContentTypeJson] }
+      it "works for real" $
+        get "/items_with_different_col_types?real_data=in." `shouldRespondWith`
+          [json| [] |] { matchHeaders = [matchContentTypeJson] }
+      it "works for time" $
+        get "/items_with_different_col_types?time_data=in." `shouldRespondWith`
+          [json| [] |] { matchHeaders = [matchContentTypeJson] }
+
+    it "returns all results for not.in when no value is present" $
+      get "/items_with_different_col_types?int_data=not.in.&select=int_data" `shouldRespondWith`
+        [json| [{int_data: 1}] |] { matchHeaders = [matchContentTypeJson] }
+
+    it "returns an empty result ignoring spaces" $
+      get "/items_with_different_col_types?int_data=in.    " `shouldRespondWith`
+        [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
+
+    it "returns empty result when the in value is empty between parentheses" $
+      get "/items_with_different_col_types?int_data=in.()" `shouldRespondWith`
+        [json| [] |] { matchHeaders = [matchContentTypeJson] }
+
+    it "returns all results when the not.in value is empty between parentheses" $
+      get "/items_with_different_col_types?int_data=not.in.()&select=int_data" `shouldRespondWith`
+        [json| [{int_data: 1}] |] { matchHeaders = [matchContentTypeJson] }
+
+  describe "Transition to url safe characters" $ do
+    context "top level in operator" $ do
+      it "works with parentheses" $
+        get "/entities?id=in.(1,2,3)&select=id" `shouldRespondWith`
+          [json| [{"id": 1}, {"id": 2}, {"id": 3}] |] { matchHeaders = [matchContentTypeJson] }
+      it "works without parentheses" $
+        get "/entities?id=in.1,2,3&select=id" `shouldRespondWith`
+          [json| [{"id": 1}, {"id": 2}, {"id": 3}] |] { matchHeaders = [matchContentTypeJson] }
+
+    context "select query param" $ do
+      it "works with parentheses" $
+        get "/entities?id=eq.2&select=id,child_entities(id)" `shouldRespondWith`
+          [json| [{"id": 2, "child_entities": [{"id": 3}]}] |] { matchHeaders = [matchContentTypeJson] }
+      it "works with brackets" $
+        get "/entities?id=eq.2&select=id,child_entities{id}" `shouldRespondWith`
+          [json| [{"id": 2, "child_entities": [{"id": 3}]}] |] { matchHeaders = [matchContentTypeJson] }
+
+  context "Embedding when column name = table name" $ do
+    it "works with child embeds" $
+      get "/being?select=*,descendant(*)&limit=1" `shouldRespondWith`
+        [json|[{"being":1,"descendant":[{"descendant":1,"being":1},{"descendant":2,"being":1},{"descendant":3,"being":1}]}]|]
+        { matchHeaders = [matchContentTypeJson] }
+    it "works with many to many embeds" $
+      get "/being?select=*,part(*)&limit=1" `shouldRespondWith`
+        [json|[{"being":1,"part":[{"part":1}]}]|]
+        { matchHeaders = [matchContentTypeJson] }

test/Feature/RangeSpec.hs

@@ -9,7 +9,6 @@ import Network.Wai.Test (SResponse(simpleHeaders,simpleStatus))
 import qualified Data.ByteString.Lazy         as BL
 
 import SpecHelper
-import Text.Heredoc
 import Network.Wai (Application)
 
 import Protolude hiding (get)
@@ -31,19 +30,12 @@ spec = do
       context "when I don't want the count" $ do
         it "returns range Content-Range with */* for empty range" $
           request methodPost "/rpc/getitemrange" [] emptyRange
-            `shouldRespondWith` ResponseMatcher {
-              matchBody    = Just [json| [] |]
-            , matchStatus  = 200
-            , matchHeaders = ["Content-Range" <:> "*/*"]
-            }
+            `shouldRespondWith` [json| [] |] {matchHeaders = ["Content-Range" <:> "*/*"]}
 
         it "returns range Content-Range with range/*" $
           request methodPost "/rpc/getitemrange" [] defaultRange
-            `shouldRespondWith` ResponseMatcher {
-              matchBody    = Just [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/*"]
-            }
+            `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}] |]
+            { matchHeaders = ["Content-Range" <:> "0-14/*"] }
 
     context "with range headers" $ do
 
@@ -64,9 +56,8 @@ spec = do
         it "returns an empty body when there are no results" $
           request methodPost "/rpc/getitemrange"
                   (rangeHdrs $ ByteRangeFromTo 0 1) emptyRange
-            `shouldRespondWith` ResponseMatcher {
-              matchBody    = Just "[]"
-            , matchStatus  = 200
+            `shouldRespondWith` "[]"
+            { matchStatus  = 200
             , matchHeaders = ["Content-Range" <:> "*/*"]
             }
 
@@ -95,18 +86,16 @@ spec = do
         it "refuses a range with nonzero start when there are no items" $
           request methodPost "/rpc/getitemrange"
                   (rangeHdrsWithCount $ ByteRangeFromTo 1 2) emptyRange
-            `shouldRespondWith` ResponseMatcher {
-              matchBody    = Nothing
-            , matchStatus  = 416
+            `shouldRespondWith` "[]"
+            { matchStatus  = 416
             , matchHeaders = ["Content-Range" <:> "*/0"]
             }
 
         it "refuses a range requesting start past last item" $
           request methodPost "/rpc/getitemrange"
                   (rangeHdrsWithCount $ ByteRangeFromTo 100 199) defaultRange
-            `shouldRespondWith` ResponseMatcher {
-              matchBody    = Nothing
-            , matchStatus  = 416
+            `shouldRespondWith` "[]"
+            { matchStatus  = 416
             , matchHeaders = ["Content-Range" <:> "*/15"]
             }
 
@@ -120,68 +109,58 @@ spec = do
         it "returns range Content-Range with /*" $
           request methodGet "/menagerie"
                   [("Prefer", "count=none")] ""
-            `shouldRespondWith` ResponseMatcher {
-              matchBody    = Just "[]"
-            , matchStatus  = 200
+            `shouldRespondWith` "[]"
+            { matchStatus  = 200
             , matchHeaders = ["Content-Range" <:> "*/*"]
             }
 
         it "returns range Content-Range with range/*" $
           request methodGet "/items?order=id"
                   [("Prefer", "count=none")] ""
-            `shouldRespondWith` ResponseMatcher {
-              matchBody    = Just [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/*"]
-            }
+            `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}] |]
+            { matchHeaders = ["Content-Range" <:> "0-14/*"] }
 
         it "returns range Content-Range with range/* even using other filters" $
           request methodGet "/items?id=eq.1&order=id"
                   [("Prefer", "count=none")] ""
-            `shouldRespondWith` ResponseMatcher {
-              matchBody    = Just [json| [{"id":1}] |]
-            , matchStatus  = 200
-            , matchHeaders = ["Content-Range" <:> "0-0/*"]
-            }
+            `shouldRespondWith` [json| [{"id":1}] |]
+            { matchHeaders = ["Content-Range" <:> "0-0/*"] }
 
     context "with limit/offset parameters" $ do
       it "no parameters return everything" $
         get "/items?select=id&order=id.asc"
-          `shouldRespondWith` ResponseMatcher {
-            matchBody    = Just [str|[{"id":1},{"id":2},{"id":3},{"id":4},{"id":5},{"id":6},{"id":7},{"id":8},{"id":9},{"id":10},{"id":11},{"id":12},{"id":13},{"id":14},{"id":15}]|]
-          , matchStatus  = 200
+          `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 "top level limit with parameter" $
         get "/items?select=id&order=id.asc&limit=3"
-          `shouldRespondWith` ResponseMatcher {
-            matchBody    = Just [str|[{"id":1},{"id":2},{"id":3}]|]
-          , matchStatus  = 200
+          `shouldRespondWith` [json|[{"id":1},{"id":2},{"id":3}]|]
+          { matchStatus  = 200
           , matchHeaders = ["Content-Range" <:> "0-2/*"]
           }
       it "headers override get parameters" $
         request methodGet  "/items?select=id&order=id.asc&limit=3"
                      (rangeHdrs $ ByteRangeFromTo 0 1) ""
-          `shouldRespondWith` ResponseMatcher {
-            matchBody    = Just [str|[{"id":1},{"id":2}]|]
-          , matchStatus  = 200
+          `shouldRespondWith` [json|[{"id":1},{"id":2}]|]
+          { matchStatus  = 200
           , matchHeaders = ["Content-Range" <:> "0-1/*"]
           }
 
       it "limit works on all levels" $
         get "/clients?select=id,projects{id,tasks{id}}&order=id.asc&limit=1&projects.order=id.asc&projects.limit=2&projects.tasks.order=id.asc&projects.tasks.limit=1"
-          `shouldRespondWith` ResponseMatcher {
-            matchBody    = Just [str|[{"id":1,"projects":[{"id":1,"tasks":[{"id":1}]},{"id":2,"tasks":[{"id":3}]}]}]|]
-          , matchStatus  = 200
+          `shouldRespondWith`
+          [json|[{"id":1,"projects":[{"id":1,"tasks":[{"id":1}]},{"id":2,"tasks":[{"id":3}]}]}]|]
+          { matchStatus  = 200
           , matchHeaders = ["Content-Range" <:> "0-0/*"]
           }
 
 
       it "limit and offset works on first level" $
         get "/items?select=id&order=id.asc&limit=3&offset=2"
-          `shouldRespondWith` ResponseMatcher {
-            matchBody    = Just [str|[{"id":3},{"id":4},{"id":5}]|]
-          , matchStatus  = 200
+          `shouldRespondWith` [json|[{"id":3},{"id":4},{"id":5}]|]
+          { matchStatus  = 200
           , matchHeaders = ["Content-Range" <:> "2-4/*"]
           }
 
@@ -204,9 +183,8 @@ spec = do
         it "returns an empty body when there are no results" $
           request methodGet "/menagerie"
                   (rangeHdrs $ ByteRangeFromTo 0 1) ""
-            `shouldRespondWith` ResponseMatcher {
-              matchBody    = Just "[]"
-            , matchStatus  = 200
+            `shouldRespondWith` "[]"
+            { matchStatus  = 200
             , matchHeaders = ["Content-Range" <:> "*/*"]
             }
 
@@ -235,17 +213,15 @@ spec = do
         it "refuses a range with nonzero start when there are no items" $
           request methodGet "/menagerie"
                   (rangeHdrsWithCount $ ByteRangeFromTo 1 2) ""
-            `shouldRespondWith` ResponseMatcher {
-              matchBody    = Nothing
-            , matchStatus  = 416
+            `shouldRespondWith` "[]"
+            { matchStatus  = 416
             , matchHeaders = ["Content-Range" <:> "*/0"]
             }
 
         it "refuses a range requesting start past last item" $
           request methodGet "/items"
                   (rangeHdrsWithCount $ ByteRangeFromTo 100 199) ""
-            `shouldRespondWith` ResponseMatcher {
-              matchBody    = Nothing
-            , matchStatus  = 416
+            `shouldRespondWith` "[]"
+            { matchStatus  = 416
             , matchHeaders = ["Content-Range" <:> "*/15"]
             }

test/Feature/RpcSpec.hs

@@ -0,0 +1,345 @@
+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 Text.Heredoc
+import Network.Wai (Application)
+
+import Protolude hiding (get)
+
+spec :: SpecWith Application
+spec =
+  describe "remote procedure call" $ do
+    context "a proc that returns a set" $ do
+      it "returns paginated results" $ do
+        request methodPost "/rpc/getitemrange"
+                (rangeHdrs (ByteRangeFromTo 0 0))  [json| { "min": 2, "max": 4 } |]
+           `shouldRespondWith` [json| [{"id":3}] |]
+            { matchStatus = 200
+            , matchHeaders = ["Content-Range" <:> "0-0/*"]
+            }
+        request methodGet "/rpc/getitemrange?min=2&max=4"
+                (rangeHdrs (ByteRangeFromTo 0 0)) ""
+           `shouldRespondWith` [json| [{"id":3}] |]
+            { matchStatus = 200
+            , matchHeaders = ["Content-Range" <:> "0-0/*"]
+            }
+
+      it "includes total count if requested" $ do
+        request methodPost "/rpc/getitemrange"
+                (rangeHdrsWithCount (ByteRangeFromTo 0 0))
+                [json| { "min": 2, "max": 4 } |]
+           `shouldRespondWith` [json| [{"id":3}] |]
+            { matchStatus = 206 -- it now knows the response is partial
+            , matchHeaders = ["Content-Range" <:> "0-0/2"]
+            }
+        request methodGet "/rpc/getitemrange?min=2&max=4"
+                (rangeHdrsWithCount (ByteRangeFromTo 0 0)) ""
+           `shouldRespondWith` [json| [{"id":3}] |]
+            { matchStatus = 206
+            , matchHeaders = ["Content-Range" <:> "0-0/2"]
+            }
+
+      it "returns proper json" $ do
+        post "/rpc/getitemrange" [json| { "min": 2, "max": 4 } |] `shouldRespondWith`
+          [json| [ {"id": 3}, {"id":4} ] |]
+          { matchHeaders = [matchContentTypeJson] }
+        get "/rpc/getitemrange?min=2&max=4" `shouldRespondWith`
+          [json| [ {"id": 3}, {"id":4} ] |]
+          { matchHeaders = [matchContentTypeJson] }
+
+      it "returns CSV" $ do
+        request methodPost "/rpc/getitemrange"
+                (acceptHdrs "text/csv")
+                [json| { "min": 2, "max": 4 } |]
+           `shouldRespondWith` "id\n3\n4"
+            { matchStatus = 200
+            , matchHeaders = ["Content-Type" <:> "text/csv; charset=utf-8"]
+            }
+        request methodGet "/rpc/getitemrange?min=2&max=4"
+                (acceptHdrs "text/csv") ""
+           `shouldRespondWith` "id\n3\n4"
+            { matchStatus = 200
+            , matchHeaders = ["Content-Type" <:> "text/csv; charset=utf-8"]
+            }
+
+    context "unknown function" $ do
+      it "returns 404" $
+        post "/rpc/fakefunc" [json| {} |] `shouldRespondWith` 404
+      it "should fail with 404 on unknown proc name" $
+        get "/rpc/fake" `shouldRespondWith` 404
+      it "should fail with 404 on unknown proc args" $ do
+        get "/rpc/sayhello" `shouldRespondWith` 404
+        get "/rpc/sayhello?any_arg=value" `shouldRespondWith` 404
+
+    context "shaping the response returned by a proc" $ do
+      it "returns a project" $ do
+        post "/rpc/getproject" [json| { "id": 1} |] `shouldRespondWith`
+          [str|[{"id":1,"name":"Windows 7","client_id":1}]|]
+        get "/rpc/getproject?id=1" `shouldRespondWith`
+          [str|[{"id":1,"name":"Windows 7","client_id":1}]|]
+
+      it "can filter proc results" $ do
+        post "/rpc/getallprojects?id=gt.1&id=lt.5&select=id" [json| {} |] `shouldRespondWith`
+          [json|[{"id":2},{"id":3},{"id":4}]|]
+          { matchHeaders = [matchContentTypeJson] }
+        get "/rpc/getallprojects?id=gt.1&id=lt.5&select=id" `shouldRespondWith`
+          [json|[{"id":2},{"id":3},{"id":4}]|]
+          { matchHeaders = [matchContentTypeJson] }
+
+      it "can limit proc results" $ do
+        post "/rpc/getallprojects?id=gt.1&id=lt.5&select=id?limit=2&offset=1" [json| {} |]
+          `shouldRespondWith` [json|[{"id":3},{"id":4}]|]
+             { matchStatus = 200
+             , matchHeaders = ["Content-Range" <:> "1-2/*"] }
+        get "/rpc/getallprojects?id=gt.1&id=lt.5&select=id?limit=2&offset=1"
+          `shouldRespondWith` [json|[{"id":3},{"id":4}]|]
+             { matchStatus = 200
+             , matchHeaders = ["Content-Range" <:> "1-2/*"] }
+
+      it "select works on the first level" $ do
+        post "/rpc/getproject?select=id,name" [json| { "id": 1} |] `shouldRespondWith`
+          [str|[{"id":1,"name":"Windows 7"}]|]
+        get "/rpc/getproject?id=1&select=id,name" `shouldRespondWith`
+          [str|[{"id":1,"name":"Windows 7"}]|]
+
+    context "foreign entities embedding" $ do
+      it "can embed if related tables are in the exposed schema" $ do
+        post "/rpc/getproject?select=id,name,client{id},tasks{id}" [json| { "id": 1} |] `shouldRespondWith`
+          [json|[{"id":1,"name":"Windows 7","client":{"id":1},"tasks":[{"id":1},{"id":2}]}]|]
+          { matchHeaders = [matchContentTypeJson] }
+        get "/rpc/getproject?id=1&select=id,name,client{id},tasks{id}" `shouldRespondWith`
+          [json|[{"id":1,"name":"Windows 7","client":{"id":1},"tasks":[{"id":1},{"id":2}]}]|]
+          { matchHeaders = [matchContentTypeJson] }
+
+      it "cannot embed if the related table is not in the exposed schema" $ do
+        post "/rpc/single_article?select=*,article_stars{*}" [json|{ "id": 1}|]
+          `shouldRespondWith` 400
+        get "/rpc/single_article?id=1&select=*,article_stars{*}"
+          `shouldRespondWith` 400
+
+      it "can embed if the related tables are in a hidden schema but exposed as views" $ do
+        post "/rpc/single_article?select=id,articleStars{userId}" [json|{ "id": 2}|]
+          `shouldRespondWith` [json|[{"id": 2, "articleStars": [{"userId": 3}]}]|]
+          { matchHeaders = [matchContentTypeJson] }
+        get "/rpc/single_article?id=2&select=id,articleStars{userId}"
+          `shouldRespondWith` [json|[{"id": 2, "articleStars": [{"userId": 3}]}]|]
+          { matchHeaders = [matchContentTypeJson] }
+
+    context "a proc that returns an empty rowset" $
+      it "returns empty json array" $ do
+        post "/rpc/test_empty_rowset" [json| {} |] `shouldRespondWith`
+          [json| [] |]
+          { matchHeaders = [matchContentTypeJson] }
+        get "/rpc/test_empty_rowset" `shouldRespondWith`
+          [json| [] |]
+          { matchHeaders = [matchContentTypeJson] }
+
+    context "proc return types" $ do
+      context "returns text" $ do
+        it "returns proper json" $
+          post "/rpc/sayhello" [json| { "name": "world" } |] `shouldRespondWith`
+            [json|"Hello, world"|]
+            { matchHeaders = [matchContentTypeJson] }
+
+        it "can handle unicode" $
+          post "/rpc/sayhello" [json| { "name": "￥" } |] `shouldRespondWith`
+            [json|"Hello, ￥"|]
+            { matchHeaders = [matchContentTypeJson] }
+
+      it "returns array" $
+        post "/rpc/ret_array" [json|{}|] `shouldRespondWith`
+          [json|[1, 2, 3]|]
+          { matchHeaders = [matchContentTypeJson] }
+
+      it "returns setof integers" $
+        post "/rpc/ret_setof_integers" [json|{}|] `shouldRespondWith`
+          [json|[{ "ret_setof_integers": 1 },
+                 { "ret_setof_integers": 2 },
+                 { "ret_setof_integers": 3 }]|]
+          { matchHeaders = [matchContentTypeJson] }
+
+      it "returns enum value" $
+        post "/rpc/ret_enum" [json|{ "val": "foo" }|] `shouldRespondWith`
+          [json|"foo"|]
+          { matchHeaders = [matchContentTypeJson] }
+
+      it "returns domain value" $
+        post "/rpc/ret_domain" [json|{ "val": "8" }|] `shouldRespondWith`
+          [json|8|]
+          { matchHeaders = [matchContentTypeJson] }
+
+      it "returns range" $
+        post "/rpc/ret_range" [json|{ "low": 10, "up": 20 }|] `shouldRespondWith`
+          [json|"[10,20)"|]
+          { matchHeaders = [matchContentTypeJson] }
+
+      it "returns row of scalars" $
+        post "/rpc/ret_scalars" [json|{}|] `shouldRespondWith`
+          [json|[{"a":"scalars", "b":"foo", "c":1, "d":"[10,20)"}]|]
+          { matchHeaders = [matchContentTypeJson] }
+
+      it "returns composite type in exposed schema" $
+        post "/rpc/ret_point_2d" [json|{}|] `shouldRespondWith`
+          [json|[{"x": 10, "y": 5}]|]
+          { matchHeaders = [matchContentTypeJson] }
+
+      it "cannot return composite type in hidden schema" $
+        post "/rpc/ret_point_3d" [json|{}|] `shouldRespondWith` 401
+
+      it "returns single row from table" $
+        post "/rpc/single_article?select=id" [json|{"id": 2}|] `shouldRespondWith`
+          [json|[{"id": 2}]|]
+          { matchHeaders = [matchContentTypeJson] }
+
+      it "returns null for void" $
+        post "/rpc/ret_void" [json|{}|] `shouldRespondWith`
+          [json|null|]
+          { matchHeaders = [matchContentTypeJson] }
+
+    context "improper input" $ do
+      it "rejects unknown content type even if payload is good" $ do
+        request methodPost "/rpc/sayhello"
+          (acceptHdrs "audio/mpeg3") [json| { "name": "world" } |]
+            `shouldRespondWith` 415
+        request methodGet "/rpc/sayhello?name=world"
+          (acceptHdrs "audio/mpeg3") ""
+            `shouldRespondWith` 415
+      it "rejects malformed json payload" $ do
+        p <- request methodPost "/rpc/sayhello"
+          (acceptHdrs "application/json") "sdfsdf"
+        liftIO $ do
+          simpleStatus p `shouldBe` badRequest400
+          isErrorFormat (simpleBody p) `shouldBe` True
+      it "treats simple plpgsql raise as invalid input" $ do
+        p <- post "/rpc/problem" "{}"
+        liftIO $ do
+          simpleStatus p `shouldBe` badRequest400
+          isErrorFormat (simpleBody p) `shouldBe` True
+
+    context "unsupported verbs" $ do
+      it "DELETE fails" $
+        request methodDelete "/rpc/sayhello" [] ""
+          `shouldRespondWith` 405
+      it "PATCH fails" $
+        request methodPatch "/rpc/sayhello" [] ""
+          `shouldRespondWith` 405
+      it "OPTIONS fails" $
+        -- TODO: should return info about the function
+        request methodOptions "/rpc/sayhello" [] ""
+          `shouldRespondWith` 405
+
+    it "executes the proc exactly once per request" $ do
+      post "/rpc/callcounter" [json| {} |] `shouldRespondWith`
+        [json|1|]
+        { matchHeaders = [matchContentTypeJson] }
+      post "/rpc/callcounter" [json| {} |] `shouldRespondWith`
+        [json|2|]
+        { matchHeaders = [matchContentTypeJson] }
+
+    context "a proc that receives no parameters" $ do
+      it "interprets empty string as empty json object on a post request" $
+        post "/rpc/noparamsproc" BL.empty `shouldRespondWith`
+          [json| "Return value of no parameters procedure." |]
+          { matchHeaders = [matchContentTypeJson] }
+      it "interprets empty string as a function with no args on a get request" $
+        get "/rpc/noparamsproc" `shouldRespondWith`
+          [json| "Return value of no parameters procedure." |]
+          { matchHeaders = [matchContentTypeJson] }
+
+    it "returns proper output when having the same return col name as the proc name" $ do
+      post "/rpc/test" [json|{}|] `shouldRespondWith`
+        [json|[{"test":"hello","value":1}]|] { matchHeaders = [matchContentTypeJson] }
+      get "/rpc/test" `shouldRespondWith`
+        [json|[{"test":"hello","value":1}]|] { matchHeaders = [matchContentTypeJson] }
+
+    context "procs with OUT/INOUT params" $ do
+      it "returns a scalar result when there is a single OUT param" $ do
+        get "/rpc/single_out_param?num=5" `shouldRespondWith`
+          [json|6|] { matchHeaders = [matchContentTypeJson] }
+        get "/rpc/single_json_out_param?a=1&b=two" `shouldRespondWith`
+          [json|{"a": 1, "b": "two"}|] { matchHeaders = [matchContentTypeJson] }
+
+      it "returns a scalar result when there is a single INOUT param" $
+        get "/rpc/single_inout_param?num=2" `shouldRespondWith`
+          [json|3|] { matchHeaders = [matchContentTypeJson] }
+
+      it "returns a row result when there are many OUT params" $
+        get "/rpc/many_out_params" `shouldRespondWith`
+          [json|[{"my_json":{"a": 1, "b": "two"},"num":3,"str":"four"}]|] { matchHeaders = [matchContentTypeJson] }
+
+      it "returns a row result when there are many INOUT params" $
+        get "/rpc/many_inout_params?num=1&str=two" `shouldRespondWith`
+          [json| [{"num":1,"str":"two","b":true}]|] { matchHeaders = [matchContentTypeJson] }
+
+    it "can map a RAISE error code and message to a http status" $
+      get "/rpc/raise_pt402"
+        `shouldRespondWith` [json|{ "hint": "Upgrade your plan", "details": "Quota exceeded" }|]
+        { matchStatus  = 402
+        , matchHeaders = [matchContentTypeJson]
+        }
+
+    it "defaults to status 500 if RAISE code is PT not followed by a number" $
+      get "/rpc/raise_bad_pt" `shouldRespondWith` 500
+
+    context "only for POST rpc" $ do
+      context "expects a single json object" $ do
+        it "does not expand posted json into parameters" $
+          request methodPost "/rpc/singlejsonparam"
+            [("Prefer","params=single-object")] [json| { "p1": 1, "p2": "text", "p3" : {"obj":"text"} } |] `shouldRespondWith`
+            [json| { "p1": 1, "p2": "text", "p3" : {"obj":"text"} } |]
+            { matchHeaders = [matchContentTypeJson] }
+
+        it "accepts parameters from an html form" $
+          request methodPost "/rpc/singlejsonparam"
+            [("Prefer","params=single-object"),("Content-Type", "application/x-www-form-urlencoded")]
+            ("integer=7&double=2.71828&varchar=forms+are+fun&" <>
+             "boolean=false&date=1900-01-01&money=$3.99&enum=foo") `shouldRespondWith`
+            [json| { "integer": "7", "double": "2.71828", "varchar" : "forms are fun"
+                   , "boolean":"false", "date":"1900-01-01", "money":"$3.99", "enum":"foo" } |]
+                   { matchHeaders = [matchContentTypeJson] }
+
+      it "gives a parse filter error if GET style proc args are specified" $
+        post "/rpc/sayhello?name=John" [json|{}|] `shouldRespondWith` 400
+
+    context "only for GET rpc" $ do
+      it "should fail on mutating procs" $ do
+        get "/rpc/callcounter" `shouldRespondWith` 500
+        get "/rpc/setprojects?id_l=1&id_h=5&name=FreeBSD" `shouldRespondWith` 500
+
+      it "should filter a proc that has arg name = filter name" $
+        get "/rpc/get_projects_below?id=5&id=gt.2&select=id" `shouldRespondWith`
+          [json|[{ "id": 3 }, { "id": 4 }]|]
+          { matchHeaders = [matchContentTypeJson] }
+
+      it "should work with filters that have the not operator" $ do
+        get "/rpc/get_projects_below?id=5&id=not.gt.2&select=id" `shouldRespondWith`
+          [json|[{ "id": 1 }, { "id": 2 }]|]
+          { matchHeaders = [matchContentTypeJson] }
+        get "/rpc/get_projects_below?id=5&id=not.in.(1,3)&select=id" `shouldRespondWith`
+          [json|[{ "id": 2 }, { "id": 4 }]|]
+          { matchHeaders = [matchContentTypeJson] }
+
+      it "should work with filters that use the plain with language fts operator" $ do
+        get "/rpc/get_tsearch?text_search_vector=fts(english).impossible" `shouldRespondWith`
+          [json|[{"text_search_vector":"'fun':5 'imposs':9 'kind':3"}]|]
+          { matchHeaders = [matchContentTypeJson] }
+        get "/rpc/get_tsearch?text_search_vector=plfts.impossible" `shouldRespondWith`
+          [json|[{"text_search_vector":"'fun':5 'imposs':9 'kind':3"}]|]
+          { matchHeaders = [matchContentTypeJson] }
+        get "/rpc/get_tsearch?text_search_vector=not.fts(english).fun%7Crat" `shouldRespondWith`
+          [json|[{"text_search_vector":"'amus':5 'fair':7 'impossibl':9 'peu':4"},{"text_search_vector":"'art':4 'spass':5 'unmog':7"}]|]
+          { matchHeaders = [matchContentTypeJson] }
+        -- TODO: '@@' deprecated
+        get "/rpc/get_tsearch?text_search_vector=@@(english).impossible" `shouldRespondWith`
+          [json|[{"text_search_vector":"'fun':5 'imposs':9 'kind':3"}]|]
+          { matchHeaders = [matchContentTypeJson] }
+        get "/rpc/get_tsearch?text_search_vector=not.@@(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] }

test/Feature/SingularSpec.hs

@@ -39,7 +39,8 @@ spec =
       it "can shape plurality singular object routes" $
         request methodGet "/projects_view?id=eq.1&select=id,name,clients{*},tasks{id,name}" [singular] ""
           `shouldRespondWith`
-            [str|{"id":1,"name":"Windows 7","clients":{"id":1,"name":"Microsoft"},"tasks":[{"id":1,"name":"Design w7"},{"id":2,"name":"Code w7"}]}|]
+            [json|{"id":1,"name":"Windows 7","clients":{"id":1,"name":"Microsoft"},"tasks":[{"id":1,"name":"Design w7"},{"id":2,"name":"Code w7"}]}|]
+            { matchHeaders = ["Content-Type" <:> "application/vnd.pgrst.object+json; charset=utf-8"] }
 
     context "when updating rows" $ do
 
@@ -86,16 +87,14 @@ spec =
         request methodPost "/addresses"
           [("Prefer", "return=minimal"), singular]
           [json| [ { id: 101, address: "xxx" } ] |]
-          `shouldRespondWith` ResponseMatcher {
-            matchBody    = Just ""
-          , matchStatus  = 201
+          `shouldRespondWith` ""
+          { matchStatus  = 201
           , matchHeaders = ["Content-Range" <:> "*/*"]
           }
         -- and the element should exist
         get "/addresses?id=eq.101"
-          `shouldRespondWith` ResponseMatcher {
-            matchBody    = Just [str|[{"id":101,"address":"xxx"}]|]
-          , matchStatus  = 200
+          `shouldRespondWith` [str|[{"id":101,"address":"xxx"}]|]
+          { matchStatus  = 200
           , matchHeaders = []
           }
 
@@ -113,9 +112,8 @@ spec =
         request methodPost "/addresses"
           [("Prefer", "return=minimal"), singular]
           [json| [ { id: 200, address: "xxx" }, { id: 201, address: "yyy" } ] |]
-          `shouldRespondWith` ResponseMatcher {
-            matchBody    = Just ""
-          , matchStatus  = 201
+          `shouldRespondWith` ""
+          { matchStatus  = 201
           , matchHeaders = ["Content-Range" <:> "*/*"]
           }
 
@@ -142,11 +140,9 @@ spec =
           [("Prefer", "return=representation"), singular] ""
           `shouldRespondWith` 406
 
-        -- the rows should not exist, either
         get firstItems
-          `shouldRespondWith` ResponseMatcher {
-            matchBody    = Nothing
-          , matchStatus  = 200
+          `shouldRespondWith` [json| [{"id":1},{"id":2},{"id":3},{"id":4},{"id":5},{"id":6},{"id":7},{"id":8},{"id":9},{"id":10}] |]
+          { matchStatus  = 200
           , matchHeaders = ["Content-Range" <:> "0-9/*"]
           }
 

test/Feature/StructureSpec.hs

@@ -4,7 +4,9 @@ import Test.Hspec hiding (pendingWith)
 import Test.Hspec.Wai
 import Network.HTTP.Types
 
+import PostgREST.Config (docsVersion)
 import Control.Lens ((^?))
+import Data.Aeson.Types (Value (..))
 import Data.Aeson.Lens
 import Data.Aeson.QQ
 
@@ -27,18 +29,117 @@ spec = do
               (acceptHdrs "application/openapi+json") ""
         `shouldRespondWith` 415
 
-    describe "RPC" $
+    it "includes postgrest.com current version api docs" $ do
+      r <- simpleBody <$> get "/"
 
-      it "includes a representative function with parameters" $ do
+      let docsUrl = r ^? key "externalDocs" . key "url"
+
+      liftIO $ docsUrl `shouldBe` Just (String ("https://postgrest.com/en/" <> docsVersion <> "/api.html"))
+
+    describe "table" $ do
+
+      it "includes paths to tables" $ do
         r <- simpleBody <$> get "/"
-        let ref = r ^? key "paths" . key "/rpc/varied_arguments"
-                     . key "post"  . key "parameters"
-                     . nth 1       . key "schema"
-                     . key "$ref"  . _String
-            args = r ^? key "definitions" . key "(rpc) varied_arguments"
+
+        let method s = key "paths" . key "/child_entities" . key s
+            childGetSummary = r ^? method "get" . key "summary"
+            childGetDescription = r ^? method "get" . key "description"
+            getParameters = r ^? method "get" . 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"
+
+        let grandChildGet s = key "paths" . key "/grandchild_entities" . key "get" . key s
+            grandChildGetSummary = r ^? grandChildGet "summary"
+            grandChildGetDescription = r ^? grandChildGet "description"
 
         liftIO $ do
-          ref `shouldBe` Just "#/definitions/(rpc) varied_arguments"
+
+          childGetSummary `shouldBe` Just "child_entities comment"
+
+          childGetDescription `shouldBe` Nothing
+
+          grandChildGetSummary `shouldBe` Just "grandchild_entities summary"
+
+          grandChildGetDescription `shouldBe` Just "grandchild_entities description\nthat spans\nmultiple lines"
+
+          getParameters `shouldBe` Just
+            [aesonQQ|
+              [
+                { "$ref": "#/parameters/rowFilter.child_entities.id" },
+                { "$ref": "#/parameters/rowFilter.child_entities.name" },
+                { "$ref": "#/parameters/rowFilter.child_entities.parent_id" },
+                { "$ref": "#/parameters/select" },
+                { "$ref": "#/parameters/order" },
+                { "$ref": "#/parameters/range" },
+                { "$ref": "#/parameters/rangeUnit" },
+                { "$ref": "#/parameters/offset" },
+                { "$ref": "#/parameters/limit" },
+                { "$ref": "#/parameters/preferCount" }
+              ]
+            |]
+
+          postResponse `shouldBe` Just "Created"
+
+          patchResponse `shouldBe` Just "No Content"
+
+          deleteResponse `shouldBe` Just "No Content"
+
+      it "includes definitions to tables" $ do
+        r <- simpleBody <$> get "/"
+
+        let def = r ^? key "definitions" . key "child_entities"
+
+        liftIO $
+
+          def `shouldBe` Just
+            [aesonQQ|
+              {
+                "type": "object",
+                "description": "child_entities comment",
+                "properties": {
+                  "id": {
+                    "description": "child_entities id comment\n\nNote:\nThis is a Primary Key.<pk/>",
+                    "format": "integer",
+                    "type": "integer"
+                  },
+                  "name": {
+                    "description": "child_entities name comment",
+                    "format": "text",
+                    "type": "string"
+                  },
+                  "parent_id": {
+                    "description": "Note:\nThis is a Foreign Key to `entities.id`.<fk table='entities' column='id'/>",
+                    "format": "integer",
+                    "type": "integer"
+                  }
+                }
+              }
+            |]
+
+      it "doesn't include privileged table for anonymous" $ do
+        r <- simpleBody <$> get "/"
+        let tablePath = r ^? key "paths" . key "/authors_only"
+
+        liftIO $ tablePath `shouldBe` Nothing
+
+      it "includes table if user has permission" $ do
+        let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJyb2xlIjoicG9zdGdyZXN0X3Rlc3RfYXV0aG9yIn0.Xod-F15qsGL0WhdOCr2j3DdKuTw9QJERVgoFD3vGaWA"
+        r <- simpleBody <$> request methodGet "/" [auth] ""
+        let tableTag = r ^? key "paths" . key "/authors_only"
+                      . key "post"  . key "tags"
+                      . nth 0
+        liftIO $ tableTag `shouldBe` Just [aesonQQ|"authors_only"|]
+
+    describe "RPC" $ do
+
+      it "includes body schema for arguments" $ do
+        r <- simpleBody <$> get "/"
+        let args = r ^? key "paths" . key "/rpc/varied_arguments"
+                      . key "post"  . key "parameters"
+                      . nth 0       . key "schema"
+
+        liftIO $
           args `shouldBe` Just
             [aesonQQ|
               {
@@ -84,6 +185,37 @@ spec = do
               }
             |]
 
+      it "doesn't include privileged function for anonymous" $ do
+        r <- simpleBody <$> get "/"
+        let funcPath = r ^? key "paths" . key "/rpc/privileged_hello"
+
+        liftIO $ funcPath `shouldBe` Nothing
+
+      it "includes function if user has permission" $ do
+        let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJyb2xlIjoicG9zdGdyZXN0X3Rlc3RfYXV0aG9yIn0.Xod-F15qsGL0WhdOCr2j3DdKuTw9QJERVgoFD3vGaWA"
+        r <- simpleBody <$> request methodGet "/" [auth] ""
+        let funcTag = r ^? key "paths" . key "/rpc/privileged_hello"
+                      . key "post"  . key "tags"
+                      . nth 0
+
+        liftIO $ funcTag `shouldBe` Just [aesonQQ|"(rpc) privileged_hello"|]
+
+      it "doesn't include OUT params of function as required parameters" $ do
+        r <- simpleBody <$> get "/"
+        let params = r ^? key "paths" . key "/rpc/many_out_params"
+                        . key "post" . key "parameters" .  nth 0
+                        . key "schema". key "required"
+
+        liftIO $ params `shouldBe` Nothing
+
+      it "includes INOUT params(with no DEFAULT) of function as required parameters" $ do
+        r <- simpleBody <$> get "/"
+        let params = r ^? key "paths" . key "/rpc/many_inout_params"
+                        . key "post" . key "parameters" .  nth 0
+                        . key "schema". key "required"
+
+        liftIO $ params `shouldBe` Just [aesonQQ|["num", "str"]|]
+
   describe "Allow header" $ do
 
     it "includes read/write verbs for writeable table" $ do

test/Feature/UnicodeSpec.hs

@@ -6,6 +6,8 @@ import Test.Hspec.Wai.JSON
 import Network.Wai (Application)
 import Control.Monad (void)
 
+import SpecHelper
+
 import Protolude hiding (get)
 
 spec :: SpecWith Application
@@ -20,3 +22,4 @@ spec =
 
       get "/%D9%85%D9%88%D8%A7%D8%B1%D8%AF"
         `shouldRespondWith` [json| [{ "هویت": 1 }] |]
+        { matchHeaders = [matchContentTypeJson] }

test/Main.hs

@@ -5,15 +5,17 @@ import SpecHelper
 
 import qualified Hasql.Pool as P
 
-import PostgREST.DbStructure (getDbStructure)
 import PostgREST.App (postgrest)
-import Control.AutoUpdate
+import PostgREST.Config (pgVersion96)
+import PostgREST.DbStructure (getDbStructure, getPgVersion)
+import PostgREST.Types (DbStructure(..))
 import Data.Function (id)
 import Data.IORef
-import Data.Time.Clock.POSIX   (getPOSIXTime)
 
 import qualified Feature.AuthSpec
+import qualified Feature.AsymmetricJwtSpec
 import qualified Feature.BinaryJwtSecretSpec
+import qualified Feature.AudienceJwtSecretSpec
 import qualified Feature.ConcurrentSpec
 import qualified Feature.CorsSpec
 import qualified Feature.DeleteSpec
@@ -26,6 +28,10 @@ import qualified Feature.StructureSpec
 import qualified Feature.SingularSpec
 import qualified Feature.UnicodeSpec
 import qualified Feature.ProxySpec
+import qualified Feature.AndOrParamsSpec
+import qualified Feature.RpcSpec
+import qualified Feature.NonexistentSchemaSpec
+import qualified Feature.PgVersion96Spec
 
 import Protolude
 
@@ -35,21 +41,43 @@ main = do
   setupDb testDbConn
 
   pool <- P.acquire (3, 10, toS testDbConn)
-  -- ask for the OS time at most once per second
-  getTime <- mkAutoUpdate
-    defaultUpdateSettings { updateAction = getPOSIXTime }
 
+  result <- P.use pool $ getDbStructure "test" =<< getPgVersion
 
-  result <- P.use pool $ getDbStructure "test"
-  refDbStructure <- newIORef $ either (panic.show) id result
-  let withApp      = return $ postgrest (testCfg testDbConn)          refDbStructure pool getTime
-      ltdApp       = return $ postgrest (testLtdRowsCfg testDbConn)   refDbStructure pool getTime
-      unicodeApp   = return $ postgrest (testUnicodeCfg testDbConn)   refDbStructure pool getTime
-      proxyApp     = return $ postgrest (testProxyCfg testDbConn)     refDbStructure pool getTime
-      noJwtApp     = return $ postgrest (testCfgNoJWT testDbConn)     refDbStructure pool getTime
-      binaryJwtApp = return $ postgrest (testCfgBinaryJWT testDbConn) refDbStructure pool getTime
+  dbStructure <- pure $ either (panic.show) id result
+
+  refDbStructure <- newIORef $ Just dbStructure
+
+  let withApp              = return $ postgrest (testCfg testDbConn)            refDbStructure pool $ pure ()
+      ltdApp               = return $ postgrest (testLtdRowsCfg testDbConn)     refDbStructure pool $ pure ()
+      unicodeApp           = return $ postgrest (testUnicodeCfg testDbConn)     refDbStructure pool $ pure ()
+      proxyApp             = return $ postgrest (testProxyCfg testDbConn)       refDbStructure pool $ pure ()
+      noJwtApp             = return $ postgrest (testCfgNoJWT testDbConn)       refDbStructure pool $ pure ()
+      binaryJwtApp         = return $ postgrest (testCfgBinaryJWT testDbConn)   refDbStructure pool $ pure ()
+      audJwtApp            = return $ postgrest (testCfgAudienceJWT testDbConn) refDbStructure pool $ pure ()
+      asymJwkApp           = return $ postgrest (testCfgAsymJWK testDbConn)     refDbStructure pool $ pure ()
+      nonexistentSchemaApp = return $ postgrest (testNonexistentSchemaCfg testDbConn)   refDbStructure pool $ pure ()
 
   let reset = resetDb testDbConn
+      actualPgVersion = pgVersion dbStructure
+      pg96spec | actualPgVersion >= pgVersion96 = [("Feature.PgVersion96Spec"  , Feature.PgVersion96Spec.spec)]
+               | otherwise = []
+
+      specs = uncurry describe <$> [
+          ("Feature.AuthSpec"               , Feature.AuthSpec.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.RangeSpec"              , Feature.RangeSpec.spec)
+        , ("Feature.SingularSpec"           , Feature.SingularSpec.spec)
+        , ("Feature.StructureSpec"          , Feature.StructureSpec.spec)
+        , ("Feature.AndOrParamsSpec"        , Feature.AndOrParamsSpec.spec)
+        , ("Feature.NonexistentSchemaSpec"  , Feature.NonexistentSchemaSpec.spec)
+        ] ++ pg96spec
+
   hspec $ do
     mapM_ (beforeAll_ reset . before withApp) specs
 
@@ -73,15 +101,14 @@ main = do
     beforeAll_ reset . before binaryJwtApp $
       describe "Feature.BinaryJwtSecretSpec" Feature.BinaryJwtSecretSpec.spec
 
- where
-  specs = map (uncurry describe) [
-      ("Feature.AuthSpec"         , Feature.AuthSpec.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.RangeSpec"        , Feature.RangeSpec.spec)
-    , ("Feature.SingularSpec"     , Feature.SingularSpec.spec)
-    , ("Feature.StructureSpec"    , Feature.StructureSpec.spec)
-    ]
+    -- this test runs with a binary JWT secret and an audience claim
+    beforeAll_ reset . before audJwtApp $
+      describe "Feature.AudienceJwtSecretSpec" Feature.AudienceJwtSecretSpec.spec
+
+    -- this test runs with asymmetric JWK
+    beforeAll_ reset . before asymJwkApp $
+      describe "Feature.AsymmetricJwtSpec" Feature.AsymmetricJwtSpec.spec
+
+    -- this test runs with a nonexistent db-schema
+    beforeAll_ reset . before nonexistentSchemaApp $
+      describe "Feature.NonexistentSchemaSpec" Feature.NonexistentSchemaSpec.spec

test/SpecHelper.hs

@@ -13,7 +13,8 @@ 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           System.Process (readProcess)
+import           Text.Heredoc
 
 import PostgREST.Config (AppConfig(..))
 
@@ -25,10 +26,16 @@ import Network.Wai.Test (SResponse(simpleStatus, simpleHeaders, simpleBody))
 
 import Data.Maybe (fromJust)
 import Data.Aeson (decode, Value(..))
-import qualified Data.JsonSchema.Draft4 as D4
+import qualified JSONSchema.Draft4 as D4
 
 import Protolude
 
+matchContentTypeJson :: MatchHeader
+matchContentTypeJson = "Content-Type" <:> "application/json; charset=utf-8"
+
+matchContentTypeSingular :: MatchHeader
+matchContentTypeSingular = "Content-Type" <:> "application/vnd.pgrst.object+json; charset=utf-8"
+
 validateOpenApiResponse :: [Header] -> WaiSession ()
 validateOpenApiResponse headers = do
   r <- request methodGet "/" headers ""
@@ -61,7 +68,7 @@ _baseCfg :: AppConfig
 _baseCfg =  -- Connection Settings
   AppConfig mempty "postgrest_test_anonymous" Nothing "test" "localhost" 3000
             -- Jwt settings
-            (Just $ encodeUtf8 "safe") False
+            (Just $ encodeUtf8 "reallyreallyreallyreallyverysafe") False Nothing
             -- Connection Modifiers
             10 Nothing (Just "test.switch_role")
             -- Debug Settings
@@ -83,9 +90,26 @@ testProxyCfg :: Text -> AppConfig
 testProxyCfg testDbConn = (testCfg testDbConn) { configProxyUri = Just "https://postgrest.com/openapi.json" }
 
 testCfgBinaryJWT :: Text -> AppConfig
-testCfgBinaryJWT testDbConn = (testCfg testDbConn) { configJwtSecret = Just secretBs }
-  where secretBs = B64.decodeLenient "h2CGB1FoBd51aQooCS2g+UmRgYQfTPQ6v3+9ALbaqM4="
+testCfgBinaryJWT testDbConn = (testCfg testDbConn) {
+    configJwtSecret = Just . B64.decodeLenient $
+      "cmVhbGx5cmVhbGx5cmVhbGx5cmVhbGx5dmVyeXNhZmU="
+  }
 
+testCfgAudienceJWT :: Text -> AppConfig
+testCfgAudienceJWT testDbConn = (testCfg testDbConn) {
+    configJwtSecret = Just . B64.decodeLenient $
+      "cmVhbGx5cmVhbGx5cmVhbGx5cmVhbGx5dmVyeXNhZmU=",
+    configJwtAudience = Just "youraudience"
+  }
+
+testCfgAsymJWK :: Text -> AppConfig
+testCfgAsymJWK testDbConn = (testCfg testDbConn) {
+    configJwtSecret = Just $ encodeUtf8
+      [str|{"alg":"RS256","e":"AQAB","key_ops":["verify"],"kty":"RSA","n":"0etQ2Tg187jb04MWfpuogYGV75IFrQQBxQaGH75eq_FpbkyoLcEpRUEWSbECP2eeFya2yZ9vIO5ScD-lPmovePk4Aa4SzZ8jdjhmAbNykleRPCxMg0481kz6PQhnHRUv3nF5WP479CnObJKqTVdEagVL66oxnX9VhZG9IZA7k0Th5PfKQwrKGyUeTGczpOjaPqbxlunP73j9AfnAt4XCS8epa-n3WGz1j-wfpr_ys57Aq-zBCfqP67UYzNpeI1AoXsJhD9xSDOzvJgFRvc3vm2wjAW4LEMwi48rCplamOpZToIHEPIaPzpveYQwDnB1HFTR1ove9bpKJsHmi-e2uzQ","use":"sig"}|]
+  }
+
+testNonexistentSchemaCfg :: Text -> AppConfig
+testNonexistentSchemaCfg testDbConn = (testCfg testDbConn) { configSchema = "nonexistent" }
 
 setupDb :: Text -> IO ()
 setupDb dbConn = do

test/create_test_db

@@ -17,8 +17,7 @@ then
 fi
 
 BASEPATH=$( cd $(dirname $0) ; pwd -P )
-#Remove database path from the connection uri--prevents setting up the new database name with PGDATABASE
-URI=$(echo $1 | cut -d'/' -f1-3)
+URI="$1"
 #Extract host and port--we need this to form the new connection string
 HOST_PORT=$(echo $URI | cut -d'/' -f3 | cut -d'@' -f2 )
 DB=$2
@@ -43,10 +42,15 @@ WHERE pg_stat_activity.datname = '$DB'
 
 DROP DATABASE IF EXISTS $DB;
 DROP ROLE IF EXISTS $TEST_USER_NAME;
-CREATE USER $TEST_USER_NAME WITH LOGIN NOINHERIT PASSWORD '$TEST_USER_PASS' CREATEROLE;
+CREATE USER $TEST_USER_NAME WITH SUPERUSER LOGIN NOINHERIT PASSWORD '$TEST_USER_PASS' CREATEROLE;
 CREATE DATABASE $DB OWNER $TEST_USER_NAME;
+\\connect $DB
+ALTER SCHEMA public OWNER TO $TEST_USER_NAME;
 EOF
 
+#Remove database path from the connection uri--prevents setting up the new database name with PGDATABASE
+URI=$(echo $URI | cut -d'/' -f1-3)
+
 PGDATABASE=$DB PGOPTIONS='-c client_min_messages=WARNING' psql "$URI" --set=db=$DB -Xq <<EOF
   CREATE EXTENSION IF NOT EXISTS pgcrypto;
   ALTER DATABASE ${DB} SET request.jwt.claim.id = '-1';

test/destroy_test_db

@@ -17,8 +17,7 @@ then
 fi
 
 BASEPATH=$( cd $(dirname $0) ; pwd -P )
-#Remove database path from the connection uri
-URI=$(echo $1 | cut -d'/' -f1-3)
+URI="$1"
 DB=$2
 
 PGOPTIONS='-c client_min_messages=WARNING' psql "$URI" -Xq >/dev/null -c 'select rolcreatedb from pg_authid where rolname = current_user;' 2>/dev/null

test/fixtures/data.sql

@@ -246,9 +246,11 @@ INSERT INTO nullable_integer VALUES (NULL);
 --
 
 TRUNCATE TABLE tsearch CASCADE;
-INSERT INTO tsearch VALUES ('''bar'':2 ''foo'':1');
-INSERT INTO tsearch VALUES ('''baz'':1 ''qux'':2');
-
+INSERT INTO tsearch VALUES (to_tsvector('It''s kind of fun to do the impossible'));
+INSERT INTO tsearch VALUES (to_tsvector('But also fun to do what is possible'));
+INSERT INTO tsearch VALUES (to_tsvector('Fat cats ate rats'));
+INSERT INTO tsearch VALUES (to_tsvector('french', 'C''est un peu amusant de faire l''impossible'));
+INSERT INTO tsearch VALUES (to_tsvector('german', 'Es ist eine Art Spaß, das Unmögliche zu machen')); 
 
 --
 -- Data for Name: users_projects; Type: TABLE DATA; Schema: test; Owner: -
@@ -283,6 +285,55 @@ TRUNCATE TABLE orders CASCADE;
 INSERT INTO orders VALUES (1, 'order 1', 1, 2);
 INSERT INTO orders VALUES (2, 'order 2', 3, 4);
 
+TRUNCATE TABLE images CASCADE;
+INSERT INTO images(name, img) VALUES ('A.png', decode('iVBORw0KGgoAAAANSUhEUgAAAB4AAAAeAQMAAAAB/jzhAAAABlBMVEUAAAD/AAAb/40iAAAAP0lEQVQI12NgwAbYG2AE/wEYwQMiZB4ACQkQYZEAIgqAhAGIKLCAEQ8kgMT/P1CCEUwc4IMSzA3sUIIdCHECAGSQEkeOTUyCAAAAAElFTkSuQmCC', 'base64'));
+INSERT INTO images(name, img) VALUES ('B.png', decode('iVBORw0KGgoAAAANSUhEUgAAAB4AAAAeAQMAAAAB/jzhAAAABlBMVEX///8AAP94wDzzAAAAL0lEQVQIW2NgwAb+HwARH0DEDyDxwAZEyGAhLODqHmBRzAcn5GAS///A1IF14AAA5/Adbiiz/0gAAAAASUVORK5CYII=', 'base64'));
+
+TRUNCATE TABLE w_or_wo_comma_names CASCADE;
+INSERT INTO w_or_wo_comma_names VALUES ('Hebdon, John');
+INSERT INTO w_or_wo_comma_names VALUES ('Williams, Mary');
+INSERT INTO w_or_wo_comma_names VALUES ('Smith, Joseph');
+INSERT INTO w_or_wo_comma_names VALUES ('David White');
+INSERT INTO w_or_wo_comma_names VALUES ('Larry Thompson');
+
+TRUNCATE TABLE items_with_different_col_types CASCADE;
+INSERT INTO items_with_different_col_types VALUES (1, null, null, null, null, null, null, null);
+
+TRUNCATE TABLE entities CASCADE;
+INSERT INTO entities VALUES (1, 'entity 1', '{1}', '''bar'':2 ''foo'':1');
+INSERT INTO entities VALUES (2, 'entity 2', '{1,2}', '''baz'':1 ''qux'':2');
+INSERT INTO entities VALUES (3, 'entity 3', '{1,2,3}', null);
+INSERT INTO entities VALUES (4, null, null, null);
+
+TRUNCATE TABLE child_entities CASCADE;
+INSERT INTO child_entities VALUES (1, 'child entity 1', 1);
+INSERT INTO child_entities VALUES (2, 'child entity 2', 1);
+INSERT INTO child_entities VALUES (3, 'child entity 3', 2);
+
+TRUNCATE TABLE grandchild_entities CASCADE;
+INSERT INTO grandchild_entities VALUES (1, 'grandchild entity 1', 1, null, null, null);
+INSERT INTO grandchild_entities VALUES (2, 'grandchild entity 2', 1, null, null, null);
+INSERT INTO grandchild_entities VALUES (3, 'grandchild entity 3', 2, null, null, null);
+INSERT INTO grandchild_entities VALUES (4, '(grandchild,entity,4)', 2, null, null, '{"a": {"b":"foo"}}');
+INSERT INTO grandchild_entities VALUES (5, '(grandchild,entity,5)', 2, null, null, '{"b":"bar"}');
+
+TRUNCATE TABLE ranges CASCADE;
+INSERT INTO ranges VALUES (1, '[1,3]');
+INSERT INTO ranges VALUES (2, '[3,6]');
+INSERT INTO ranges VALUES (3, '[6,9]');
+INSERT INTO ranges VALUES (4, '[9,12]');
+
+TRUNCATE TABLE being CASCADE;
+INSERT INTO being VALUES (1), (2), (3), (4);
+
+TRUNCATE TABLE descendant CASCADE;
+INSERT INTO descendant VALUES (1,1), (2,1), (3,1), (4,2);
+
+TRUNCATE TABLE part CASCADE;
+INSERT INTO part VALUES (1), (2), (3), (4);
+
+TRUNCATE TABLE being_part CASCADE;
+INSERT INTO being_part VALUES (1,1), (2,1), (3,2), (4,3);
 --
 -- PostgreSQL database dump complete
 --

test/fixtures/database.sql

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

test/fixtures/privileges.sql

@@ -3,6 +3,7 @@ GRANT USAGE ON SCHEMA
       postgrest
     , test
     , jwt
+    , public
     , "تست"
 TO postgrest_test_anonymous;
 
@@ -44,6 +45,22 @@ GRANT ALL ON TABLE
     , "موارد"
     , addresses
     , orders
+    , public.public_consumers
+    , public.public_orders
+    , consumers_view
+    , orders_view
+    , images
+    , images_base64
+    , w_or_wo_comma_names
+    , items_with_different_col_types
+    , entities
+    , child_entities
+    , grandchild_entities
+    , ranges
+    , being
+    , descendant
+    , being_part
+    , part
 TO postgrest_test_anonymous;
 
 GRANT INSERT ON TABLE insertonly TO postgrest_test_anonymous;
@@ -61,3 +78,6 @@ GRANT ALL ON TABLE authors_only TO postgrest_test_author;
 GRANT SELECT (article_id, user_id) ON TABLE limited_article_stars TO postgrest_test_anonymous;
 GRANT INSERT (article_id, user_id) ON TABLE limited_article_stars TO postgrest_test_anonymous;
 GRANT UPDATE (article_id, user_id) ON TABLE limited_article_stars TO postgrest_test_anonymous;
+
+REVOKE EXECUTE ON FUNCTION privileged_hello(text) FROM PUBLIC; -- All functions are available to every role(PUBLIC) by default
+GRANT EXECUTE ON FUNCTION privileged_hello(text) TO postgrest_test_author;

test/fixtures/roles.sql

@@ -4,4 +4,4 @@ CREATE ROLE postgrest_test_anonymous;
 CREATE ROLE postgrest_test_default_role;
 CREATE ROLE postgrest_test_author;
 
-GRANT postgrest_test_anonymous, postgrest_test_default_role, postgrest_test_author TO :USER;
+GRANT postgrest_test_anonymous, postgrest_test_default_role, postgrest_test_author TO :USER;

test/fixtures/schema.sql

@@ -12,31 +12,10 @@ SET standard_conforming_strings = on;
 SET check_function_bodies = false;
 SET client_min_messages = warning;
 
---
--- Name: postgrest; Type: SCHEMA; Schema: -; Owner: -
---
-
+CREATE SCHEMA public;
 CREATE SCHEMA postgrest;
-
-
---
--- Name: private; Type: SCHEMA; Schema: -; Owner: -
---
-
 CREATE SCHEMA private;
-
-
---
--- Name: test; Type: SCHEMA; Schema: -; Owner: -
---
-
 CREATE SCHEMA test;
-
-
---
--- Name: تست; Type: SCHEMA; Schema: -; Owner: -
---
-
 CREATE SCHEMA تست;
 
 
@@ -48,11 +27,13 @@ CREATE EXTENSION IF NOT EXISTS plpgsql WITH SCHEMA pg_catalog;
 
 SET search_path = public, pg_catalog;
 
+CREATE EXTENSION IF NOT EXISTS pgcrypto;
+
 --
 -- Name: jwt_token; Type: TYPE; Schema: public; Owner: -
 --
 
-CREATE TYPE jwt_token AS (
+CREATE TYPE public.jwt_token AS (
 	token text
 );
 
@@ -142,6 +123,19 @@ CREATE FUNCTION always_true(test.items) RETURNS boolean
     AS $$ SELECT true $$;
 
 
+create table public_consumers (
+    id                  serial             not null unique,
+    name                text               not null check (name <> ''),
+    primary key (id)
+);
+
+create table public_orders (
+    id                  serial             not null unique,
+    consumer            integer            not null references public_consumers(id),
+    number              integer            not null,
+    primary key (id)
+);
+
 --
 -- Name: anti_id(test.items); Type: FUNCTION; Schema: public; Owner: -
 --
@@ -161,6 +155,14 @@ CREATE TABLE موارد (
 
 SET search_path = test, pg_catalog;
 
+
+create view orders_view as
+  select * from public.public_orders;
+
+create view consumers_view as
+  select * from public.public_consumers;
+
+
 --
 -- Name: getitemrange(bigint, bigint); Type: FUNCTION; Schema: test; Owner: -
 --
@@ -171,6 +173,15 @@ CREATE FUNCTION getitemrange(min bigint, max bigint) RETURNS SETOF items
     SELECT * FROM test.items WHERE id > $1 AND id <= $2;
 $_$;
 
+--
+-- Name: version(); Type: FUNCTION; Schema: test; Owner: -
+--
+
+CREATE FUNCTION noparamsproc() RETURNS text
+	LANGUAGE sql
+	AS $$
+		SELECT a FROM (VALUES ('Return value of no parameters procedure.')) s(a);
+	$$;
 
 --
 -- Name: insert_insertable_view_with_join(); Type: FUNCTION; Schema: test; Owner: -
@@ -194,7 +205,7 @@ CREATE FUNCTION login(id text, pass text) RETURNS public.jwt_token
     LANGUAGE sql SECURITY DEFINER
     AS $$
 SELECT jwt.sign(
-    row_to_json(r), 'safe'
+    row_to_json(r), 'reallyreallyreallyreallyverysafe'
   ) as token
   FROM (
     SELECT rolname::text, id::text
@@ -227,7 +238,7 @@ CREATE FUNCTION jwt_test() RETURNS public.jwt_token
     LANGUAGE sql SECURITY DEFINER
     AS $$
 SELECT jwt.sign(
-    row_to_json(r), 'safe'
+    row_to_json(r), 'reallyreallyreallyreallyverysafe'
   ) as token
   FROM (
     SELECT 'joe'::text as iss, 'fun'::text as sub, 'everyone'::text as aud,
@@ -268,14 +279,13 @@ $$;
 --
 
 CREATE FUNCTION reveal_big_jwt() RETURNS TABLE (
-      iss text, sub text, aud text, exp bigint,
+      iss text, sub text, exp bigint,
       nbf bigint, iat bigint, jti text, "http://postgrest.com/foo" boolean
     )
     LANGUAGE sql SECURITY DEFINER
     AS $$
 SELECT current_setting('request.jwt.claim.iss') as iss,
        current_setting('request.jwt.claim.sub') as sub,
-       current_setting('request.jwt.claim.aud') as aud,
        current_setting('request.jwt.claim.exp')::bigint as exp,
        current_setting('request.jwt.claim.nbf')::bigint as nbf,
        current_setting('request.jwt.claim.iat')::bigint as iat,
@@ -305,6 +315,7 @@ $$;
 
 CREATE FUNCTION sayhello(name text) RETURNS text
     LANGUAGE sql
+    IMMUTABLE
     AS $_$
     SELECT 'Hello, ' || $1;
 $_$;
@@ -1085,6 +1096,12 @@ CREATE FUNCTION getproject(id int) RETURNS SETOF projects
     SELECT * FROM test.projects WHERE id = $1;
 $_$;
 
+CREATE FUNCTION get_projects_below(id int) RETURNS SETOF projects
+    LANGUAGE sql
+    AS $_$
+    SELECT * FROM test.projects WHERE id < $1;
+$_$;
+
 CREATE FUNCTION getallprojects() RETURNS SETOF projects
     LANGUAGE sql
     AS $_$
@@ -1097,6 +1114,224 @@ CREATE FUNCTION setprojects(id_l int, id_h int, name text) RETURNS SETOF project
     update test.projects set name = $3 WHERE id >= $1 AND id <= $2 returning *;
 $_$;
 
+create table images (
+	name               text not null,
+	img                bytea not null
+);
+
+create view images_base64 as (
+  -- encoding in base64 puts a '\n' after every 76 character due to legacy reasons, this is isn't necessary here so it's removed
+  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 $$ 
+  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 $$ 
+  select '{1,2,3}'::integer[];
+$$ language sql;
+
+create function test.ret_domain(val integer) returns test.one_nine as $$ 
+  select val::test.one_nine;
+$$ language sql;
+
+create function test.ret_range(low integer, up integer) returns int4range as $$
+  select int4range(low, up);
+$$ language sql;
+
+create function test.ret_setof_integers() returns setof integer as $$
+  values (1), (2), (3);
+$$ 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), 
+              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 $$ 
+  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 $$ 
+  select row(7, -3, 4)::private.point_3d;
+$$ language sql;
+
+create function test.ret_void() returns void as '' language sql;
+
+create function test.ret_base64_bin() returns text as $$
+  select i.img from test.images_base64 i where i.name = 'A.png';
+$$ language sql;
+
+create function test.ret_rows_with_base64_bin() returns setof test.images_base64 as $$
+  select i.name, i.img from test.images_base64 i;
+$$ language sql;
+
+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 $$ 
+  select nullif(current_setting(name), '')::text;
+$$ language sql;
+
+create table w_or_wo_comma_names ( name text );
+
+create table items_with_different_col_types ( 
+  int_data integer,
+  text_data text,
+  bool_data bool,
+  bin_data bytea,
+  char_data character varying,
+  date_data date,
+  real_data real,
+  time_data time
+);
+
+-- Tables used for testing complex boolean logic with and/or query params
+
+create table entities ( 
+  id integer primary key,
+  name text,
+  arr integer[],
+  text_search_vector tsvector
+);
+
+create table child_entities ( 
+  id integer primary key,
+  name text,
+  parent_id integer references entities(id)
+);
+
+create table grandchild_entities ( 
+  id integer primary key,
+  name text,
+  parent_id integer references child_entities(id),
+  or_starting_col text,
+  and_starting_col text,
+  jsonb_col jsonb
+);
+
+-- Table used for testing range operators
+
+create table ranges (
+    id integer primary key,
+    range numrange
+);
+
+
+-- OpenAPI description tests
+
+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 table grandchild_entities is
+$$grandchild_entities summary
+
+grandchild_entities description
+that spans
+multiple lines$$;
+
+-- Used for testing that having the same return column name as the proc name
+-- doesn't conflict with the required output, details in #901
+create function test.test() returns table(test text, value int) as $$
+  values ('hello', 1);
+$$ language sql;
+
+create function test.privileged_hello(name text) returns text as $$
+  select 'Privileged hello to ' || $1;
+$$ language sql;
+
+create function test.get_tsearch() returns setof test.tsearch AS $$
+  SELECT * FROM test.tsearch;
+$$ language sql;
+
+create table test.being (
+  being int primary key not null
+);
+
+create table test.descendant (
+  descendant int primary key not null,
+  being int references test.being(being)
+);
+
+create table test.part (
+  part int primary key not null
+);
+
+create table test.being_part (
+  being int not null references test.being(being),
+  part int not null references test.part(part)
+);
+
+create function test.single_out_param(num int, OUT num_plus_one int) AS $$
+  select num + 1;
+$$ language sql;
+
+create function test.single_json_out_param(a int, b text, OUT my_json pg_catalog.json) AS $$
+  select json_build_object('a', a, 'b', b);
+$$ language sql;
+
+create function test.many_out_params(OUT my_json pg_catalog.json, OUT num int, OUT str text) AS $$
+  select '{"a": 1, "b": "two"}'::json, 3, 'four'::text;
+$$ language sql;
+
+create function test.single_inout_param(INOUT num int) AS $$
+  select num + 1;
+$$ language sql;
+
+create function test.many_inout_params(INOUT num int, INOUT str text, INOUT b bool DEFAULT true) AS $$
+  select num, str, b;
+$$ language sql;
+
+create or replace function test.raise_pt402() returns void as $$
+begin
+  raise sqlstate 'PT402' using message = 'Payment Required',
+                               detail = 'Quota exceeded',
+                               hint = 'Upgrade your plan';
+end;
+$$ language plpgsql;
+
+create or replace function test.raise_bad_pt() returns void as $$
+begin
+  raise sqlstate 'PT40A' using message = 'Wrong';
+end;
+$$ language plpgsql;
+
+create or replace function test.get_projects_and_guc_headers() returns setof test.projects as $$
+  set local "response.headers" = '[{"X-Test": "key1=val1; someValue; key2=val2"}, {"X-Test-2": "key1=val1"}]';
+  select * from test.projects;
+$$ language sql;
+
+create or replace function test.get_int_and_guc_headers(num int) returns integer as $$
+  set local "response.headers" = '[{"X-Test":"key1=val1; someValue; key2=val2"},{"X-Test-2":"key1=val1"}]';
+  select num;
+$$ language sql;
+
+create or replace function test.bad_guc_headers_1() returns void as $$
+  set local "response.headers" = '{"X-Test": "invalid structure for headers"}';
+$$ language sql;
+
+create or replace function test.bad_guc_headers_2() returns void as $$
+  set local "response.headers" = '["invalid", "structure", "for", "headers"]';
+$$ language sql;
+
+create or replace function test.bad_guc_headers_3() returns void as $$
+  set local "response.headers" = '{"X-Test": "invalid", "X-Test-2": "structure", "X-Test-3": "for headers"}';
+$$ language sql;
+
+create or replace function test.set_cookie_twice() returns void as $$
+  set local "response.headers" = '[{"Set-Cookie": "sessionid=38afes7a8; HttpOnly; Path=/"}, {"Set-Cookie": "id=a3fWa; Expires=Wed, 21 Oct 2015 07:28:00 GMT; Secure; HttpOnly"}]';
+$$ language sql;
 --
 -- PostgreSQL database dump complete
 --

test/io-tests.sh

@@ -0,0 +1,111 @@
+#!/bin/sh
+# Run unit tests for Input/Ouput of PostgREST seen as a black box
+# with test output in Test Anything Protocol format.
+#
+# References:
+#   [1] Test Anything Protocol
+#   https://testanything.org/
+#
+#   [2] TAP Specification
+#   https://testanything.org/tap-specification.html
+#
+#   [3] List of TCP and UDP port numbers
+#   https://en.wikipedia.org/wiki/List_of_TCP_and_UDP_port_numbers
+#
+cd "$(dirname "$0")"
+cd io-tests
+
+# Port for Test PostgREST Server (must match config)
+pgrPort=49421 # in range 49152–65535: for private or temporary use
+
+# TAP utilities
+currentTest=1
+failedTests=0
+bailOut(){ echo "Bail out! $1"; exit 1; }
+result(){ echo "$1 $currentTest $2"; currentTest=$(( $currentTest + 1 )); }
+todo(){ result 'ok' "# TODO: $*"; }
+skip(){ result 'ok' "# SKIP: $*"; }
+ok(){ result 'ok' "- $1"; }
+ko(){ result 'not ok' "- $1"; failedTests=$(( $failedTests + 1 )); }
+comment(){ echo "# $1"; }
+
+# Utilities to start/stop test PostgREST server running in the background
+pgrStart(){ stack exec -- postgrest "$1" >/dev/null & pgrPID="$!"; }
+pgrStartRead(){ stack exec -- postgrest "$1" >/dev/null < "$2" & pgrPID="$!"; }
+pgrStarted(){ kill -0 "$pgrPID" 2>/dev/null; }
+pgrStop(){ kill "$pgrPID" 2>/dev/null; }
+pgrStopAll(){ pkill -f "$(stack path --local-install-root)/bin/postgrest"; }
+
+# Utilities to send HTTP requests to the PostgREST server
+rootStatus(){
+  curl -s -o /dev/null -w '%{http_code}' "http://localhost:$pgrPort/"
+}
+authorsStatus(){
+  curl -s -o /dev/null -w '%{http_code}' \
+    -H "Authorization: Bearer $( cat "$1" )" \
+    "http://localhost:$pgrPort/authors_only"
+}
+
+# Start and End of Unit Tests
+setUp(){ pgrStopAll; }
+cleanUp(){ pgrStopAll; }
+
+# Unit Test Templates
+readSecretFromFile(){
+  case "$1" in
+    *.b64)
+      pgrConfig="base64-secret-from-file.config";;
+    *)
+      pgrConfig="secret-from-file.config";;
+  esac
+  pgrStartRead "./configs/$pgrConfig" "./secrets/$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
+    authorsJwt="./secrets/${1%.*}.jwt"
+    httpStatus="$( authorsStatus "$authorsJwt" )"
+    if test "$httpStatus" -eq 200
+    then
+      ok "authentication with $2 secret read from a file"
+    else
+      ko "failed to authenticate using JWT for $2 secret: $httpStatus"
+    fi
+  else
+    ko "failed to read $2 secret from a file"
+  fi
+  pgrStop
+}
+
+# PRE: curl must be available
+test -n "$(command -v curl)" || bailOut 'curl is not available'
+
+# PRE: postgres must be running
+psql -l 1>/dev/null 2>/dev/null || bailOut 'postgres is not running'
+
+setUp
+
+totalTests=12
+echo "1..$totalTests"
+
+readSecretFromFile word.noeol 'simple (no EOL)'
+readSecretFromFile word.txt 'simple'
+readSecretFromFile ascii.noeol 'ASCII (no EOL)'
+readSecretFromFile ascii.txt 'ASCII'
+readSecretFromFile utf8.noeol 'UTF-8 (no EOL)'
+readSecretFromFile utf8.txt 'UTF-8'
+readSecretFromFile binary.noeol 'binary'
+readSecretFromFile binary.eol 'binary (+EOL)'
+
+readSecretFromFile word.b64 'Base64 (simple)'
+readSecretFromFile ascii.b64 'Base64 (ASCII)'
+readSecretFromFile utf8.b64 'Base64 (UTF-8)'
+readSecretFromFile binary.b64 'Base64 (binary)'
+
+cleanUp
+
+exit $failedTests

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

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

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

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

test/io-tests/secrets/ascii.b64

@@ -0,0 +1 @@
+QUJDCkVhc3kgYXMKMTIzCk9yIHNpbXBsZSBhcwpEbyByZSBtaQ==

test/io-tests/secrets/ascii.jwt

@@ -0,0 +1 @@
+eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJyb2xlIjoicG9zdGdyZXN0X3Rlc3RfYXV0aG9yIn0.p__cvqgrtteKUhxrJwTwqxeuFmlEm3hEj1mk7yO15M4

test/io-tests/secrets/ascii.noeol

@@ -0,0 +1,5 @@
+ABC
+Easy as
+123
+Or simple as
+Do re mi

test/io-tests/secrets/ascii.txt

@@ -0,0 +1,5 @@
+ABC
+Easy as
+123
+Or simple as
+Do re mi

test/io-tests/secrets/binary.b64

@@ -0,0 +1 @@
+RTwSHLM0/PWM2YCOyBiyChMQQamZLTZGrXdzGk61o5A=

test/io-tests/secrets/binary.eol

@@ -0,0 +1,2 @@
+E<³4üõŒÙ€ŽÈ²
+A©™-6F­wsNµ£�

test/io-tests/secrets/binary.jwt

@@ -0,0 +1 @@
+eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJyb2xlIjoicG9zdGdyZXN0X3Rlc3RfYXV0aG9yIn0.zyXYJKXgVYaWqMYgUXMk4zqXSU5cwA_vK2z9_5lRlqA

test/io-tests/secrets/binary.noeol

@@ -0,0 +1,2 @@
+E<³4üõŒÙ€ŽÈ²
+A©™-6F­wsNµ£�

test/io-tests/secrets/utf8.b64

@@ -0,0 +1 @@
+4pqg77iPIOKaoO+4jiBVbmljb2RlIOKYoO+4jyDimKA=

test/io-tests/secrets/utf8.jwt

@@ -0,0 +1 @@
+eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJyb2xlIjoicG9zdGdyZXN0X3Rlc3RfYXV0aG9yIn0.VFfaoJohnDeJMA-awM6Y7blbOjXDNwmtx48Z-0bIKrE

test/io-tests/secrets/utf8.noeol

@@ -0,0 +1 @@
+⚠️ ⚠︎ Unicode ☠️ ☠

test/io-tests/secrets/utf8.txt

@@ -0,0 +1 @@
+⚠️ ⚠︎ Unicode ☠️ ☠

test/io-tests/secrets/word.b64

@@ -0,0 +1 @@
+QUJDRWFzeUFzT25lVHdvVGhyZWVPclNpbXBsZUFzRG9SZU1p

test/io-tests/secrets/word.jwt

@@ -0,0 +1 @@
+eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJyb2xlIjoicG9zdGdyZXN0X3Rlc3RfYXV0aG9yIn0.1oyYyosD3_z4YzBE1DB-Pxf7wC0SCuZ2u1zLzPYU_nQ

test/io-tests/secrets/word.noeol

@@ -0,0 +1 @@
+ABCEasyAsOneTwoThreeOrSimpleAsDoReMi

test/io-tests/secrets/word.txt

@@ -0,0 +1 @@
+ABCEasyAsOneTwoThreeOrSimpleAsDoReMi