Bump to v5.1.0

Sometimes there's more memory usage when running the tests on CircleCI

.circleci/config.yml

@@ -0,0 +1,287 @@
+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
+
+  build-prof-test:
+    docker:
+      - image: circleci/buildpack-deps:trusty
+        environment:
+          - PGHOST=localhost
+          - TERM=xterm
+      - image: circleci/postgres:9.6.2
+        environment:
+          - POSTGRES_USER=circleci
+          - POSTGRES_DB=circleci
+    steps:
+      - checkout
+      - restore_cache:
+          keys:
+          - v1-stack-prof-dependencies-{{ checksum "postgrest.cabal" }}-{{ checksum "stack.yaml" }}
+      - run:
+          name: install stack & dependencies
+          command: |
+            curl -L https://github.com/commercialhaskell/stack/releases/download/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 with profiling enabled
+          command: |
+            stack build --profile -j1
+      - run:
+          name: run memory usage tests
+          command: |
+            test/create_test_db "postgres://circleci@localhost" postgrest_test
+            psql "postgres:///postgrest_test" -f test/fixtures/database.sql
+            psql "postgres:///postgrest_test" -f test/fixtures/roles.sql
+            psql "postgres:///postgrest_test" -f test/fixtures/schema.sql
+            psql "postgres:///postgrest_test" -f test/fixtures/jwt.sql
+            psql "postgres:///postgrest_test" -f test/fixtures/privileges.sql
+            test/memory-tests.sh
+      - save_cache:
+          paths:
+            - "~/.stack"
+            - ".stack-work"
+          key: v1-stack-prof-dependencies-{{ checksum "postgrest.cabal" }}-{{ checksum "stack.yaml" }}
+
+  centos6:
+    <<: *build-distro-bin
+
+  centos7:
+    <<: *build-distro-bin
+
+  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]+)*/
+      - build-prof-test:
+          filters:
+            tags:
+              only: /v[0-9]+(\.[0-9]+)*/
+      - centos6:
+          requires:
+            - build-test
+            - build-test-9.6
+            - build-prof-test
+          filters:
+            tags:
+              only: /v[0-9]+(\.[0-9]+)*/
+            branches:
+              ignore: /.*/
+      - centos7:
+          requires:
+            - build-test
+            - build-test-9.6
+            - build-prof-test
+          filters:
+            tags:
+              only: /v[0-9]+(\.[0-9]+)*/
+            branches:
+              ignore: /.*/
+      - ubuntu:
+          requires:
+            - build-test
+            - build-test-9.6
+            - build-prof-test
+          filters:
+            tags:
+              only: /v[0-9]+(\.[0-9]+)*/
+            branches:
+              ignore: /.*/
+      - ubuntui386:
+          requires:
+            - build-test
+            - build-test-9.6
+            - build-prof-test
+          filters:
+            tags:
+              only: /v[0-9]+(\.[0-9]+)*/
+            branches:
+              ignore: /.*/
+      - release:
+          requires:
+            - centos6
+            - centos7
+            - ubuntu
+            - ubuntui386
+          filters:
+            tags:
+              only: /v[0-9]+(\.[0-9]+)*/

.github/CONTRIBUTING.md

@@ -51,18 +51,7 @@ your contributions.
 source](https://postgrest.com/en/stable/install.html#build-from-source)
 wiki page.
 
-## Maintenance
-
-### Schedule
-
-Currently I (@begriffs) am the sole maintainer, and while I am
-overjoyed to help resolve issues I also have to balance this with
-my other obligations.  If you don't get a response right away
-don't worry, I will definitely get to it. Also you can join the
-Gitter [chat room](https://gitter.im/begriffs/postgrest) to
-discuss issues you are having.
-
-## Running Tests
+### Running Tests
 
 For instructions on running tests, see the official docs hosted here:
 

.github/ISSUE_TEMPLATE.md

@@ -0,0 +1,11 @@
+### Environment
+
+* PostgreSQL version: (if using docker, specify the image)
+* PostgREST version: (if using docker, specify the image)
+* Operating system:
+
+### Description of issue
+
+(Expected behavior vs actual behavior)
+
+(Steps to reproduce: Include a minimal SQL definition plus how you make the request to PostgREST and the response body)

.stylish-haskell.yaml

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

BACKERS.md

@@ -0,0 +1,14 @@
+# Sponsors & Backers
+
+PostgREST ongoing development is only possible thanks to our Sponsors and Backers, listed below. If you'd like to join them, you can do so by supporting the PostgREST organization on [Patreon](https://www.patreon.com/postgrest).
+
+## Lead Backers
+
+- [Christiaan Westerbeek](https://devotis.nl)
+- [Daniel Babiak](https://github.com/d-babiak)
+- [Michel Pelletier](https://github.com/michelp/)
+
+## Backers
+
+- Tsingson Qin
+- Jay Hannah

CHANGELOG.md

@@ -5,8 +5,121 @@ This project adheres to [Semantic Versioning](http://semver.org/).
 
 ## Unreleased
 
+### Added
+
 ### Fixed
 
+## [5.1.0] - 2018-08-31
+
+### Added
+
+- #1099, Add support for getting json/jsonb by array index - @steve-chavez
+- #1145, Add materialized view columns to OpenAPI output - @steve-chavez
+- #709, Allow embedding on views with subselects/CTE - @steve-chavez
+- #1148, OpenAPI: add `required` section for the non-nullable columns - @laughedelic
+- #1158, Add summary to OpenAPI doc for RPC functions - @mdr1384
+
+### Fixed
+
+- #1113, Fix UPSERT failing when having a camel case PK column - @steve-chavez
+- #945, Fix slow start-up time on big schemas - @steve-chavez
+- #1129, Fix view embedding when table is capitalized - @steve-chavez
+- #1149, OpenAPI: Change `GET` response type to array - @laughedelic
+- #1152, Fix RPC failing when having arguments with reserved or uppercase keywords - @mdr1384
+- #905, Fix intermittent empty replies - @steve-chavez
+- #1139, Fix JWTIssuedAtFuture failure for valid iat claim - @steve-chavez
+- #1141, Fix app.settings resetting on pool timeout - @steve-chavez
+
+### Changed
+
+- #1099, Numbers in json path `?select=data->1->>key` now get treated as json array indexes instead of keys - @steve-chavez
+- #1128, Allow finishing a json path with a single arrow `->`. Now a json can be obtained without resorting to casting, Previously: `/json_arr?select=data->>2::json`, now: `/json_arr?select=data->2` - @steve-chavez
+- #724, Change server-host default of *4 to 127.0.0.1
+
+### Deprecated
+
+- #724, SIGHUP deprecated, SIGUSR1 should be used instead
+
+## [0.5.0.0] - 2018-05-14
+
+### Added
+
+- The configuration (e.g. `postgrest.conf`) now accepts arbitrary settings that will be passed through as session-local database settings. This can be used to pass in secret keys directly as strings, or via OS environment variables. For instance: `app.settings.jwt_secret = "$(MYAPP_JWT_SECRET)"` will take `MYAPP_JWT_SECRET` from the environment and make it available to postgresql functions as `current_setting('app.settings.jwt_secret')`. Only `app.settings.*` values in the configuration file are treated in this way. - @canadaduane
+- #256, Add support for bulk UPSERT with POST and single UPSERT with PUT - @steve-chavez
+- #1078, Add ability to specify source column in embed - @steve-chavez
+- #821, Allow embeds alias to be used in filters - @steve-chavez
+- #906, Add jspath configurable `role-claim-key` - @steve-chavez
+- #1061, Add foreign tables to OpenAPI output - @rhyamada
+
+### Fixed
+
+- #828, Fix computed column only working in public schema - @steve-chavez
+- #925, Fix RPC high memory usage by using parametrized query and avoiding json encoding - @steve-chavez
+- #987, Fix embedding with self-reference foreign key - @steve-chavez
+- #1044, Fix view parent embedding when having many views - @steve-chavez
+- #781, Fix accepting misspelled desc/asc ordering modificators - @onporat, @steve-chavez
+
+### Changed
+
+- #828, A `SET SCHEMA <db-schema>` is done on each request, this has the following implications:
+  - Computed columns now only work if they belong to the db-schema
+  - Stored procedures might require a `search_path` to work properly, for further details see https://postgrest.org/en/v5.0/api.html#explicit-qualification
+- To use RPC now the `json_to_record/json_to_recordset` functions are needed, these are available starting from PostgreSQL 9.4 - @steve-chavez
+- Overloaded functions now depend on the `dbStructure`, restart/sighup may be needed for their correct functioning - @steve-chavez
+- #1098, Removed support for:
+  + curly braces `{}` in embeds, i.e. `/clients?select=*,projects{*}` can no longer be used, from now on parens `()` should be used `/clients?select=*,projects(*)` - @steve-chavez
+  + "in" operator without parens, i.e. `/clients?id=in.1,2,3` no longer supported, `/clients?id=in.(1,2,3)` should be used - @steve-chavez
+  + "@@", "@>" and "<@" operators, from now on their mnemonic equivalents should be used "fts", "cs" and "cd" respectively - @steve-chavez
+
+## [0.4.4.0] - 2018-01-08
+
+### Added
+
+- #887, #601, #1007, Allow specifying dictionary and plain/phrase tsquery in full text search - @steve-chavez
+- #328, Allow doing GET on rpc - @steve-chavez
+- #917, Add ability to map RAISE errorcode/message to http status - @steve-chavez
+- #940, Add ability to map GUC to http response headers - @steve-chavez
+- #1022, Include git sha in version report - @begriffs
+- Faster queries using json_agg - @ruslantalpa
+
+### Fixed
+
+- #876, Read secret files as binary, discard final LF if any - @eric-brechemier
+- #968, Treat blank proxy uri as missing - @begriffs
+- #933, OpenAPI externals docs url to current version - @steve-chavez
+- #962, OpenAPI don't err on nonexistent schema - @steve-chavez
+- #954, make OpenAPI rpc output dependent on user privileges - @steve-chavez
+- #955, Support configurable aud claim - @statik
+- #996, Fix embedded column conflicts table name - @grotsev
+- #974, Fix RPC error when function has single OUT param - @steve-chavez
+- #1021, Reduce join size in allColumns for faster program start - @nextstopsun
+- #411, Remove the need for pk in &select for parent embed - @steve-chavez
+- #1016, Fix anonymous requests when configured with jwt-aud - @ruslantalpa
+
+## [0.4.3.0] - 2017-09-06
+
+### Added
+
+- #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

README.md

@@ -1,11 +1,14 @@
 ![Logo](static/logo.png "Logo")
 
-[![Build Status](https://circleci.com/gh/begriffs/postgrest.png?style=shield&circle-token=f723c01686abf0364de1e2eaae5aff1f68bd3ff2)](https://circleci.com/gh/begriffs/postgrest/tree/master)
-<a href="https://heroku.com/deploy?template=https://github.com/begriffs/postgrest">
+[![Build Status](https://circleci.com/gh/PostgREST/postgrest/tree/master.svg?style=shield)](https://circleci.com/gh/PostgREST/postgrest/tree/master)
+<a href="https://heroku.com/deploy?template=https://github.com/PostgREST/postgrest">
   <img src="https://img.shields.io/badge/%E2%86%91_Deploy_to-Heroku-7056bf.svg" alt="Deploy">
 </a>
 [![Join the chat at https://gitter.im/begriffs/postgrest](https://img.shields.io/badge/gitter-join%20chat%20%E2%86%92-brightgreen.svg)](https://gitter.im/begriffs/postgrest)
-[![Docs](https://img.shields.io/badge/docs-latest-brightgreen.svg?style=flat)](http://postgrest.com)
+[![Docs](https://img.shields.io/badge/docs-latest-brightgreen.svg?style=flat)](http://postgrest.org)
+[![Hackage docs](https://img.shields.io/hackage/v/postgrest.svg?label=hackage)](http://hackage.haskell.org/package/postgrest)
+[![Docker Stars](https://img.shields.io/docker/pulls/postgrest/postgrest.svg)](https://hub.docker.com/r/postgrest/postgrest/)
+[![Donate](https://img.shields.io/badge/patreon-donate-orange.svg?colorB=F96854)](https://www.patreon.com/postgrest)
 
 PostgREST serves a fully RESTful API from any existing PostgreSQL
 database. It provides a cleaner, more standards-compliant, faster
@@ -13,7 +16,7 @@ API than you are likely to write from scratch.
 
 ### Usage
 
-1. Download the binary ([latest release](https://github.com/begriffs/postgrest/releases/latest))
+1. Download the binary ([latest release](https://github.com/PostgREST/postgrest/releases/latest))
    for your platform.
 2. Invoke for help:
 
@@ -49,13 +52,10 @@ by
 * Using the PostgreSQL binary protocol
 * Being stateless to allow horizontal scaling
 
-Other optimizations are possible, and some are outlined in the
-[Future Features](#future-features).
-
 ### Security
 
 PostgREST [handles
-authentication](http://postgrest.com/en/stable/auth.html) (via JSON Web
+authentication](http://postgrest.org/en/stable/auth.html) (via JSON Web
 Tokens) and delegates authorization to the role information defined in
 the database. This ensures there is a single declarative source of truth
 for security.  When dealing with the database the server assumes the
@@ -105,14 +105,14 @@ surprises, such as enforcing idempotent PUT requests.
 
 See examples of [PostgreSQL
 constraints](http://www.tutorialspoint.com/postgresql/postgresql_constraints.htm)
-and the [API guide](http://postgrest.com/en/stable/api.html).
+and the [API guide](http://postgrest.org/en/stable/api.html).
 
 ### Thanks
 
-I'm grateful to the generous project
-[contributors](https://github.com/begriffs/postgrest/graphs/contributors)
-who have improved PostgREST immensely with their code and good
-judgement.  See more details in the
-[changelog](https://github.com/begriffs/postgrest/blob/master/CHANGELOG.md).
+The PostgREST organization is grateful to:
+
+- The project [sponsors and backers](https://github.com/PostgREST/postgrest/blob/master/BACKERS.md) who support PostgREST's development.
+- The project [contributors](https://github.com/PostgREST/postgrest/graphs/contributors) who have improved PostgREST immensely with their code
+  and good judgement. See more details in the [changelog](https://github.com/PostgREST/postgrest/blob/master/CHANGELOG.md).
 
 The cool logo came from [Mikey Casalaina](https://github.com/casalaina).

app.json

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

appveyor.yml

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

@@ -1,5 +1,7 @@
 FROM debian:jessie
 
+ARG POSTGREST_VERSION
+
 # Install libpq5
 RUN apt-get -qq update && \
     apt-get -qq install -y --no-install-recommends libpq5 && \
@@ -7,12 +9,11 @@ RUN apt-get -qq update && \
     rm -rf /var/lib/apt/lists/* /tmp/* /var/tmp/*
 
 # Install postgrest
-RUN POSTGREST_VERSION="0.4.2.0" \
-    BUILD_DEPS="curl ca-certificates xz-utils" && \
+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/v${POSTGREST_VERSION}/postgrest-${POSTGREST_VERSION}-ubuntu.tar.xz && \
+    curl -SLO https://github.com/PostgREST/postgrest/releases/download/${POSTGREST_VERSION}/postgrest-${POSTGREST_VERSION}-ubuntu.tar.xz && \
     tar -xJvf postgrest-${POSTGREST_VERSION}-ubuntu.tar.xz && \
     mv postgrest /usr/local/bin/postgrest && \
     cd / && \
@@ -29,11 +30,13 @@ ENV PGRST_DB_URI= \
     PGRST_DB_POOL=100 \
     PGRST_SERVER_HOST=*4 \
     PGRST_SERVER_PORT=3000 \
-    PGRST_SERVER_PROXY_URL= \
+    PGRST_SERVER_PROXY_URI= \
     PGRST_JWT_SECRET= \
     PGRST_SECRET_IS_BASE64=false \
+    PGRST_JWT_AUD= \
     PGRST_MAX_ROWS= \
-    PGRST_PRE_REQUEST=
+    PGRST_PRE_REQUEST= \
+    PGRST_ROLE_CLAIM_KEY=".role"
 
 # PostgREST reads /etc/postgrest.conf so map the configuration
 # file in when you run this container

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/postgrest.conf

@@ -6,9 +6,11 @@ db-pool = "$(PGRST_DB_POOL)"
 server-host = "$(PGRST_SERVER_HOST)"
 server-port = "$(PGRST_SERVER_PORT)"
 
-server-proxy-url = "$(PGRST_SERVER_PROXY_URL)"
+server-proxy-uri = "$(PGRST_SERVER_PROXY_URI)"
 jwt-secret = "$(PGRST_JWT_SECRET)"
 secret-is-base64 = "$(PGRST_SECRET_IS_BASE64)"
+jwt-aud = "$(PGRST_JWT_AUD)"
+role-claim-key = "$(PGRST_ROLE_CLAIM_KEY)"
 
 max-rows = "$(PGRST_MAX_ROWS)"
 pre-request = "$(PGRST_PRE_REQUEST)"

main/Main.hs

@@ -2,57 +2,69 @@
 
 module Main where
 
-import           Protolude
-import           PostgREST.App
-import           PostgREST.Config                     (AppConfig (..),
-                                                       PgVersion (..),
-                                                       minimumPgVersion,
-                                                       prettyVersion,
-                                                       readOptions)
-import           PostgREST.Error                      (encodeError)
-import           PostgREST.OpenAPI                    (isMalformedProxyUri)
-import           PostgREST.DbStructure
-import           PostgREST.Types                      (DbStructure, Schema)
 
-import           Control.AutoUpdate
-import           Control.Retry
-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.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.AutoUpdate       (defaultUpdateSettings,
+                                           mkAutoUpdate, updateAction)
+import           Control.Retry            (RetryStatus, capDelay,
+                                           exponentialBackoff,
+                                           retrying, rsPreviousDelay)
+import qualified Data.ByteString          as BS
+import qualified Data.ByteString.Base64   as B64
+import           Data.IORef               (IORef, atomicWriteIORef,
+                                           newIORef, readIORef)
+import           Data.String              (IsString (..))
+import           Data.Text                (pack, replace, stripPrefix, strip)
+import           Data.Text.Encoding       (decodeUtf8, encodeUtf8)
+import           Data.Text.IO             (hPutStrLn)
+import           Data.Time.Clock          (getCurrentTime)
+import qualified Hasql.Pool               as P
+import qualified Hasql.Session            as H
+import           Network.Wai.Handler.Warp (defaultSettings,
+                                           runSettings, setHost,
+                                           setPort, setServerName)
+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.
+  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.
+  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 -> P.Pool -> Schema -> IORef (Maybe DbStructure) -> IORef Bool -> IO ()
+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
@@ -65,13 +77,13 @@ connectionWorker mainTid pool schema refDbStructure refIsWorkerOn = do
       connected <- connectingSucceeded pool
       when connected $ do
         result <- P.use pool $ do
-          supported <- isServerVersionSupported
-          unless supported $ liftIO $ 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
+          dbStructure <- getDbStructure schema actualPgVersion
           liftIO $ atomicWriteIORef refDbStructure $ Just dbStructure
         case result of
           Left e -> do
@@ -82,7 +94,15 @@ connectionWorker mainTid pool schema refDbStructure refIsWorkerOn = do
             atomicWriteIORef refIsWorkerOn False
             putStrLn ("Connection successful" :: Text)
 
--- | Connect to pg server if it fails retry with capped exponential backoff until success
+{-|
+  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)
@@ -103,39 +123,74 @@ connectingSucceeded pool =
         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)
-                  . setTimeout 3600
-                  $ defaultSettings
+      pgSettings = toS (configDatabase conf) -- is the db-uri
+      roleClaimKey = configRoleClaimKey conf
+      appSettings =
+        setHost ((fromString . toS) host) -- Warp settings
+        . setPort port
+        . setServerName (toS $ "postgrest/" <> prettyVersion) $
+        defaultSettings
 
-  when (isMalformedProxyUri $ toS <$> proxy) $ panic
-    "Malformed proxy uri, a correct example: https://example.com:8443/basePath"
+  -- Checks that the provided proxy uri is formated correctly
+  when (isMalformedProxyUri $ toS <$> proxy) $
+    panic
+      "Malformed proxy uri, a correct example: https://example.com:8443/basePath"
+
+  -- Checks that the provided jspath is valid
+  when (isLeft roleClaimKey) $
+    panic $ show roleClaimKey
 
   putStrLn $ ("Listening on port " :: Text) <> show (configPort conf)
-
+  --
+  -- create connection pool with the provided settings, returns either
+  -- a 'Connection' or a 'ConnectionError'. Does not throw.
   pool <- P.acquire (configPool conf, 10, pgSettings)
-
+  --
+  -- 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
-
-  connectionWorker mainTid pool (configSchema conf) refDbStructure refIsWorkerOn
-
+  --
+  -- 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
   forM_ [sigINT, sigTERM] $ \sig ->
     void $ installHandler sig (Catch $ do
@@ -143,39 +198,83 @@ main = do
         throwTo mainTid UserInterrupt
       ) Nothing
 
-  void $ installHandler sigHUP (
-      Catch $ connectionWorker mainTid pool (configSchema conf) refDbStructure refIsWorkerOn
-   ) Nothing
+  forM_ [sigHUP, sigUSR1] $ \sig ->
+    void $ installHandler sig (
+      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 }
+  getTime <- mkAutoUpdate defaultUpdateSettings {updateAction = getCurrentTime}
 
-  runSettings appSettings $ postgrest conf refDbStructure pool getTime
-    (connectionWorker mainTid pool (configSchema conf) refDbStructure refIsWorkerOn)
+  -- run the postgrest application
+  runSettings appSettings $
+    postgrest
+      conf
+      refDbStructure
+      pool
+      getTime
+      (connectionWorker
+         mainTid
+         pool
+         (configSchema conf)
+         refDbStructure
+         refIsWorkerOn)
 
+{-|
+  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,19 +2,21 @@ 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.2.0
+version:               5.1.0
 synopsis:              REST API for any Postgres database
 license:               MIT
 license-file:          LICENSE
 author:                Joe Nelson, Adam Baker
-homepage:              https://github.com/begriffs/postgrest
-maintainer:            cred+github@begriffs.com
-category:              Web
+homepage:              https://postgrest.org
+maintainer:            Steve Chávez <stevechavezast@gmail.com>
+bug-reports:           https://github.com/PostgREST/postgrest/issues
+category:              Executable, PostgreSQL, Network APIs
+extra-source-files:    CHANGELOG.md
 build-type:            Simple
 cabal-version:         >=1.10
 source-repository head
   type: git
-  location: git://github.com/begriffs/postgrest.git
+  location: git://github.com/PostgREST/postgrest.git
 
 Flag CI
   Description: No warnings allowed in continuous integration
@@ -30,11 +32,11 @@ executable postgrest
     "-with-rtsopts=-N -I2"
   default-language:    Haskell2010
   build-depends:       auto-update
-                     , base
-                     , hasql
-                     , hasql-pool
+                     , base >= 4.8 && < 4.10
+                     , hasql == 1.1
+                     , hasql-pool == 0.4.3
                      , postgrest
-                     , protolude
+                     , protolude == 0.2.2
                      , text
                      , time
                      , warp
@@ -51,32 +53,34 @@ library
   default-extensions:  OverloadedStrings, QuasiQuotes, NoImplicitPrelude
   build-depends:       aeson
                      , ansi-wl-pprint
-                     , base >= 4.8 && < 6
+                     , base >= 4.8 && < 4.10
+                     , base64-bytestring
                      , bytestring
                      , case-insensitive
                      , cassava
                      , configurator-ng == 0.0.0.1
                      , containers
                      , contravariant
+                     , contravariant-extras
                      , either
-                     , hasql
-                     , hasql-pool == 0.4.1
-                     , hasql-transaction == 0.5
+                     , gitrev
+                     , hasql == 1.1
+                     , hasql-pool == 0.4.3
+                     , hasql-transaction == 0.5.2
                      , heredoc
                      , HTTP
                      , http-types
                      , insert-ordered-containers
                      , interpolatedstring-perl6
-                     , jwt
+                     , jose == 0.7.0.0
                      , lens
                      , lens-aeson
                      , network-uri
-                     , optparse-applicative >= 0.13 && < 0.14
+                     , optparse-applicative >= 0.13 && < 0.15
                      , parsec
-                     , protolude
+                     , protolude == 0.2.2
                      , Ranged-sets == 0.3.0
                      , regex-tdfa
-                     , safe
                      , scientific
                      , swagger2
                      , text
@@ -112,13 +116,18 @@ 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.JsonOperatorSpec
                      , Feature.NoJwtSpec
+                     , Feature.PgVersion95Spec
+                     , Feature.PgVersion96Spec
                      , Feature.ProxySpec
                      , Feature.QueryLimitedSpec
                      , Feature.QuerySpec
@@ -127,24 +136,26 @@ Test-Suite spec
                      , Feature.StructureSpec
                      , Feature.UnicodeSpec
                      , Feature.AndOrParamsSpec
+                     , Feature.RpcSpec
+                     , Feature.NonexistentSchemaSpec
+                     , Feature.UpsertSpec
                      , SpecHelper
                      , TestTypes
   Build-Depends:       aeson
                      , aeson-qq
                      , async
                      , auto-update
-                     , base
+                     , base >= 4.8 && < 4.10
                      , bytestring
                      , base64-bytestring
                      , case-insensitive
                      , cassava
                      , containers
                      , contravariant
-                     , hasql
-                     , hasql-pool
+                     , hasql == 1.1
+                     , hasql-pool == 0.4.3
                      , heredoc
-                     , hjsonpointer
-                     , hjsonschema
+                     , hjsonschema == 1.5.0.1
                      , hspec
                      , hspec-wai >= 0.7.0
                      , hspec-wai-json
@@ -154,7 +165,7 @@ Test-Suite spec
                      , monad-control
                      , postgrest
                      , process
-                     , protolude
+                     , protolude == 0.2.2
                      , regex-tdfa
                      , time
                      , transformers-base

src/PostgREST/ApiRequest.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE LambdaCase #-}
 {-|
 Module      : PostgREST.ApiRequest
 Description : PostgREST functions to translate HTTP request to a domain type called ApiRequest.
@@ -13,13 +14,13 @@ module PostgREST.ApiRequest ( ApiRequest(..)
 
 import           Protolude
 import qualified Data.Aeson                as JSON
-import           Data.Aeson.Types          (emptyObject)
+import           Data.Aeson.Types          (emptyObject, emptyArray)
 import qualified Data.ByteString           as BS
 import qualified Data.ByteString.Internal  as BS (c2w)
 import qualified Data.ByteString.Lazy      as BL
 import qualified Data.Csv                  as CSV
 import qualified Data.List                 as L
-import           Data.List                 (lookup, last)
+import           Data.List                 (lookup, last, partition)
 import qualified Data.HashMap.Strict       as M
 import qualified Data.Set                  as S
 import           Data.Maybe                (fromJust)
@@ -33,12 +34,7 @@ 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(..)
-                                           , ContentType(..)
-                                           , ApiRequestError(..)
-                                           , toMime)
+import           PostgREST.Types
 import           Data.Ranged.Ranges        (Range(..), rangeIntersection, emptyRange)
 import qualified Data.CaseInsensitive      as CI
 import           Web.Cookie                (parseCookiesText)
@@ -46,10 +42,10 @@ 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
-            | ActionInspect
+data Action = ActionCreate  | ActionRead
+            | ActionUpdate  | ActionDelete
+            | ActionInfo    | ActionInvoke{isReadOnly :: Bool}
+            | ActionInspect | ActionSingleUpsert
             deriving Eq
 -- | The target db object of a user action
 data Target = TargetIdent QualifiedIdentifier
@@ -59,7 +55,7 @@ data Target = TargetIdent QualifiedIdentifier
             deriving Eq
 -- | How to return the inserted data
 data PreferRepresentation = Full | HeadersOnly | None deriving Eq
-                          --
+
 {-|
   Describes what the user wants to do. This data type is a
   translation of the raw elements of an HTTP request into domain
@@ -84,6 +80,8 @@ data ApiRequest = ApiRequest {
   , iPreferSingleObjectParameter :: Bool
   -- | Whether the client wants a result count (slower)
   , iPreferCount :: Bool
+  -- | Whether the client wants to UPSERT or ignore records on PK conflict
+  , iPreferResolution :: Maybe PreferResolution
   -- | Filters on the result ("id", "eq.10")
   , iFilters :: [(Text, Text)]
   -- | &and and &or parameters used for complex boolean logic
@@ -105,9 +103,9 @@ data ApiRequest = ApiRequest {
 -- | Examines HTTP request and translates it into user intent.
 userApiRequest :: Schema -> Request -> RequestBody -> Either ApiRequestError ApiRequest
 userApiRequest schema req reqBody
-  | isTargetingProc && method /= "POST" = Left ActionInappropriate
+  | isTargetingProc && method `notElem` ["GET", "POST"] = Left ActionInappropriate
   | topLevelRange == emptyRange = Left InvalidRange
-  | shouldParsePayload && isLeft payload = either (Left . InvalidBody . toS) undefined payload
+  | shouldParsePayload && isLeft payload = either (Left . InvalidBody . toS) witness payload
   | otherwise = Right ApiRequest {
       iAction = action
       , iTarget = target
@@ -118,7 +116,10 @@ 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", "and", "or"] k) ]
+      , iPreferResolution = if hasPrefer (show MergeDuplicates) then Just MergeDuplicates
+                            else if hasPrefer (show IgnoreDuplicates) then Just IgnoreDuplicates
+                            else Nothing
+      , iFilters = filters
       , iLogic = [(toS k, toS $ fromJust v) | (k,v) <- qParams, isJust v, endingIn ["and", "or"] k ]
       , iSelect = toS $ fromMaybe "*" $ fromMaybe (Just "*") $ lookup "select" qParams
       , iOrder = [(toS k, toS $ fromJust v) | (k,v) <- qParams, isJust v, endingIn ["order"] k ]
@@ -132,35 +133,50 @@ userApiRequest schema req reqBody
       , iCookies = fromMaybe [] $ parseCookiesText <$> lookupHeader "Cookie"
       }
  where
+  -- rpcQParams = Rpc query params e.g. /rpc/name?param1=val1, similar to filter but with no operator(eq, lt..)
+  (filters, rpcQParams) =
+    case action of
+      ActionInvoke{isReadOnly=True} -> partition (liftM2 (||) (isEmbedPath . fst) (hasOperator . snd)) flts
+      _ -> (flts, [])
+  flts = [ (toS k, toS $ fromJust v) | (k,v) <- qParams, isJust v, k /= "select", not (endingIn ["order", "limit", "offset", "and", "or"] k) ]
+  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 ->
-        note "All object keys must match" . ensureUniform . pluralize
+    case (decodeContentType . fromMaybe "application/json" $ lookupHeader "content-type", action) of
+      (_, ActionInvoke{isReadOnly=True}) ->
+        Right $ PayloadJSON (JSON.encode $ M.fromList $ second JSON.toJSON <$> rpcQParams) PJObject (S.fromList $ fst <$> rpcQParams)
+      (CTApplicationJSON, _) ->
+        note "All object keys must match" . payloadAttributes reqBody
           =<< if BL.null reqBody && isTargetingProc
                then Right emptyObject
                else JSON.eitherDecode reqBody
-      CTTextCSV ->
-        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
-                    $ toS reqBody
-      ct ->
+      (CTTextCSV, _) -> do
+        json <- csvToJson <$> CSV.decodeByName reqBody
+        note "All lines must have same number of fields" $ payloadAttributes (JSON.encode json) json
+      (CTOther "application/x-www-form-urlencoded", _) ->
+        let json = M.fromList . map (toS *** JSON.String . toS) . parseSimpleQuery $ toS reqBody
+            keys = S.fromList $ M.keys json in
+        Right $ PayloadJSON (JSON.encode json) PJObject keys
+      (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
+      "PUT"     -> ActionSingleUpsert
+      "DELETE"  -> ActionDelete
+      "OPTIONS" -> ActionInfo
+      _         -> ActionInspect
   target = case path of
               []            -> TargetRoot
               [table]       -> TargetIdent
@@ -168,10 +184,9 @@ 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, ActionSingleUpsert, ActionInvoke{isReadOnly=False}, ActionInvoke{isReadOnly=True}]
+  relevantPayload | shouldParsePayload = rightToMaybe payload
+                  | otherwise = Nothing
   path            = pathInfo req
   method          = requestMethod req
   hdrs            = requestHeaders req
@@ -254,9 +269,9 @@ type CsvData = V.Vector (M.HashMap Text BL.ByteString)
   The reason for its odd signature is so that it can compose
   directly with CSV.decodeByName
 -}
-csvToJson :: (CSV.Header, CsvData) -> JSON.Array
+csvToJson :: (CSV.Header, CsvData) -> JSON.Value
 csvToJson (_, vals) =
-  V.map rowToJsonObj vals
+  JSON.Array $ V.map rowToJsonObj vals
  where
   rowToJsonObj = JSON.Object .
     M.map (\str ->
@@ -265,27 +280,26 @@ csvToJson (_, vals) =
           else JSON.String $ toS str
       )
 
--- | Convert {foo} to [{foo}], leave arrays unchanged
--- and truncate everything else to an empty array.
-pluralize :: JSON.Value -> JSON.Array
-pluralize obj@(JSON.Object _) = V.singleton obj
-pluralize (JSON.Array arr)    = arr
-pluralize _                   = V.empty
+payloadAttributes :: RequestBody -> JSON.Value -> Maybe PayloadJSON
+payloadAttributes raw json =
+  -- Test that Array contains only Objects having the same keys
+  case json of
+    JSON.Array arr ->
+      case arr V.!? 0 of
+        Just (JSON.Object o) ->
+          let canonicalKeys = S.fromList $ M.keys o
+              areKeysUniform = all (\case
+                JSON.Object x -> S.fromList (M.keys x) == canonicalKeys
+                _ -> False) arr in
+          if areKeysUniform
+            then Just $ PayloadJSON raw (PJArray $ V.length arr) canonicalKeys
+            else Nothing
+        Just _ -> Nothing
+        Nothing -> Just emptyPJArray
 
--- | Test that Array contains only Objects having the same keys
--- and if so mark it as PayloadJSON
-ensureUniform :: JSON.Array -> Maybe PayloadJSON
-ensureUniform arr =
-  let objs :: V.Vector JSON.Object
-      objs = foldr -- filter non-objects, map to raw objects
-               (\val result -> case val of
-                  JSON.Object o -> V.cons o result
-                  _ -> result)
-               V.empty arr
-      keysPerObj = V.map (S.fromList . M.keys) objs
-      canonicalKeys = fromMaybe S.empty $ keysPerObj V.!? 0
-      areKeysUniform = all (==canonicalKeys) keysPerObj in
+    JSON.Object o -> Just $ PayloadJSON raw PJObject (S.fromList $ M.keys o)
 
-  if (V.length objs == V.length arr) && areKeysUniform
-    then Just (PayloadJSON objs)
-    else Nothing
+    -- truncate everything else to an empty array.
+    _ -> Just emptyPJArray
+  where
+    emptyPJArray = PayloadJSON (JSON.encode emptyArray) (PJArray 0) S.empty

src/PostgREST/App.hs

@@ -1,17 +1,19 @@
 {-# LANGUAGE FlexibleContexts    #-}
 {-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TupleSections #-}
---module PostgREST.App where
+{-# LANGUAGE NamedFieldPuns #-}
+
 module PostgREST.App (
   postgrest
 ) where
 
 import           Control.Applicative
+import           Data.Aeson                as JSON
 import qualified Data.ByteString.Char8     as BS
 import           Data.Maybe
 import           Data.IORef                (IORef, readIORef)
 import           Data.Text                 (intercalate)
-import           Data.Time.Clock.POSIX     (POSIXTime)
+import           Data.Time.Clock           (UTCTime)
+import qualified Data.Set                  as S
 
 import qualified Hasql.Pool                 as P
 import qualified Hasql.Transaction          as HT
@@ -22,9 +24,7 @@ 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
 
 import qualified Data.HashMap.Strict       as M
@@ -35,7 +35,7 @@ import           PostgREST.ApiRequest   ( ApiRequest(..), ContentType(..)
                                         , mutuallyAgreeable
                                         , userApiRequest
                                         )
-import           PostgREST.Auth            (jwtClaims, containsRole)
+import           PostgREST.Auth            (jwtClaims, containsRole, parseJWK)
 import           PostgREST.Config          (AppConfig (..))
 import           PostgREST.DbStructure
 import           PostgREST.DbRequestBuilder( readRequest
@@ -45,7 +45,7 @@ import           PostgREST.DbRequestBuilder( readRequest
 import           PostgREST.Error           ( simpleError, pgError
                                            , apiRequestError
                                            , singularityError, binaryFieldError
-                                           , connectionLostError
+                                           , connectionLostError, gucHeadersError
                                            )
 import           PostgREST.RangeQuery      (allRange, rangeOffset)
 import           PostgREST.Middleware
@@ -61,12 +61,11 @@ import           PostgREST.OpenAPI
 
 import           Data.Function (id)
 import           Protolude              hiding (intercalate, Proxy)
-import           Safe                   (headMay)
 
-postgrest :: AppConfig -> IORef (Maybe DbStructure) -> P.Pool -> IO POSIXTime ->
-             IO () -> Application
+postgrest :: AppConfig -> IORef (Maybe DbStructure) -> P.Pool -> IO UTCTime -> IO () -> Application
 postgrest conf refDbStructure pool getTime worker =
-  let middle = (if configQuiet conf then id else logStdout) . defaultMiddle in
+  let middle = (if configQuiet conf then id else logStdout) . defaultMiddle
+      jwtSecret = parseJWK <$> configJwtSecret conf in
 
   middle $ \ req respond -> do
     time <- getTime
@@ -78,40 +77,47 @@ postgrest conf refDbStructure pool getTime worker =
         response <- case userApiRequest (configSchema conf) req body of
           Left err -> return $ apiRequestError 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 dbStructure
-                  (iTarget apiRequest) (iAction apiRequest)
+            eClaims <- jwtClaims jwtSecret (configJwtAudience conf) (toS $ iJWT apiRequest) time (rightToMaybe $ configRoleClaimKey conf)
+
+            let authed = containsRole eClaims
+                proc = case (iTarget apiRequest, iPayload apiRequest, iPreferSingleObjectParameter apiRequest) of
+                  (TargetProc qi, Just PayloadJSON{pjKeys}, s) -> findProc qi pjKeys s $ dbProcs dbStructure
+                  _ -> Nothing
+                handleReq = runWithClaims conf eClaims (app dbStructure proc conf) apiRequest
+                txMode = transactionMode proc (iAction apiRequest)
             response <- P.use pool $ HT.transaction HT.ReadCommitted txMode handleReq
             return $ either (pgError authed) identity response
-        when (isResponse503 response) worker
+        when (responseStatus response == status503) worker
         respond response
 
-isResponse503 :: Response -> Bool
-isResponse503 resp = statusCode (responseStatus resp) == 503
+findProc :: QualifiedIdentifier -> S.Set Text -> Bool -> M.HashMap Text [ProcDescription] -> Maybe ProcDescription
+findProc qi payloadKeys paramsAsSingleObject allProcs =
+  let procs = M.lookup (qiName qi) allProcs in
+ -- Handle overloaded functions case
+  join $ (case length <$> procs of
+    Just 1 -> headMay -- if it's not an overloaded function then immediatly get the ProcDescription
+    _ -> find (\x ->
+           if paramsAsSingleObject
+             then length (pdArgs x) == 1 -- if the arg is not of json type let the db give the err
+             else payloadKeys `S.isSubsetOf` S.fromList (pgaName <$> pdArgs x))
+  ) <$> procs
 
-transactionMode :: DbStructure -> Target -> Action -> H.Mode
-transactionMode structure target action =
+transactionMode :: Maybe ProcDescription -> Action -> H.Mode
+transactionMode proc action =
   case action of
     ActionRead -> HT.Read
     ActionInfo -> HT.Read
     ActionInspect -> HT.Read
-    ActionInvoke ->
-      let proc =
-            case target of
-              (TargetProc qi) -> M.lookup (qiName qi) $
-                                   dbProcs structure
-              _               -> Nothing
-          v = fromMaybe Volatile $ pdVolatility <$> proc in
+    ActionInvoke{isReadOnly=False} ->
+      let 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 =
+app :: DbStructure -> Maybe ProcDescription -> AppConfig -> ApiRequest -> H.Transaction Response
+app dbStructure proc conf apiRequest =
   case responseContentTypeOrError (iAccepts apiRequest) (iAction apiRequest) of
     Left errorResponse -> return errorResponse
     Right contentType ->
@@ -140,48 +146,52 @@ app dbStructure conf apiRequest =
                       )
                     ] (toS body)
 
-        (ActionCreate, TargetIdent (QualifiedIdentifier _ table), Just payload@(PayloadJSON rows)) ->
-          case mutateSqlParts of
+        (ActionCreate, TargetIdent (QualifiedIdentifier tSchema tName), Just PayloadJSON{pjRaw, pjType}) ->
+          case mutateSqlParts tSchema tName of
             Left errorResponse -> return errorResponse
             Right (sq, mq) -> do
-              let isSingle = (==1) $ V.length rows
+              let (isSingle, nRows) = case pjType of
+                                        PJArray len -> (len == 1, len)
+                                        PJObject -> (True, 1)
               if contentType == CTSingularJSON
                  && not isSingle
                  && iPreferRepresentation apiRequest == Full
-                then return $ singularityError (toInteger $ V.length rows)
+                then return $ singularityError (toInteger nRows)
                 else do
-                  let pKeys = map pkName $ filter (filterPk schema table) allPrKeys -- would it be ok to move primary key detection in the query itself?
+                  let pkCols = tablePKCols dbStructure tSchema tName
                       stm = createWriteStatement sq mq
                         (contentType == CTSingularJSON) isSingle
-                        (contentType == CTTextCSV) (iPreferRepresentation apiRequest)
-                        pKeys
-                  row <- H.query payload stm
+                        (contentType == CTTextCSV) (iPreferRepresentation apiRequest) pkCols
+                  row <- H.query (toS pjRaw) stm
                   let (_, _, fs, body) = extractQueryResult row
                       headers = catMaybes [
                           if null fs
                             then Nothing
-                            else Just (hLocation, "/" <> toS table <> renderLocationFields fs)
+                            else Just (hLocation, "/" <> toS tName <> renderLocationFields fs)
                         , if iPreferRepresentation apiRequest == Full
                             then Just $ toHeader contentType
                             else Nothing
                         , Just . contentRangeH 1 0 $
-                            toInteger <$> if shouldCount then Just (V.length rows) else Nothing
+                            toInteger <$> if shouldCount then Just nRows else Nothing
+                        , if null pkCols
+                            then Nothing
+                            else (\x -> ("Preference-Applied", show x)) <$> iPreferResolution apiRequest
                         ]
 
                   return . responseLBS status201 headers $
                     if iPreferRepresentation apiRequest == Full
                       then toS body else ""
 
-        (ActionUpdate, TargetIdent _, Just payload@(PayloadJSON rows)) ->
-          case (mutateSqlParts, null <$> rows V.!? 0, iPreferRepresentation apiRequest == Full) of
+        (ActionUpdate, TargetIdent (QualifiedIdentifier tSchema tName), Just p@PayloadJSON{pjRaw}) ->
+          case (mutateSqlParts tSchema tName, pjIsEmpty p, 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] ""
+            (_, True, True) -> return $ responseLBS status200 [contentRangeH 1 0 Nothing] "[]"
+            (_, True, False) -> return $ responseLBS status204 [contentRangeH 1 0 Nothing] ""
             (Right (sq, mq), _, _) -> do
               let stm = createWriteStatement sq mq
                     (contentType == CTSingularJSON) False (contentType == CTTextCSV)
                     (iPreferRepresentation apiRequest) []
-              row <- H.query payload stm
+              row <- H.query (toS pjRaw) stm
               let (_, queryTotal, _, body) = extractQueryResult row
               if contentType == CTSingularJSON
                  && queryTotal /= 1
@@ -199,16 +209,46 @@ app dbStructure conf apiRequest =
                     then responseLBS s [toHeader contentType, r] (toS body)
                     else responseLBS s [r] ""
 
-        (ActionDelete, TargetIdent _, Nothing) ->
-          case mutateSqlParts of
+        (ActionSingleUpsert, TargetIdent (QualifiedIdentifier tSchema tName), Just PayloadJSON{pjRaw, pjType, pjKeys}) ->
+          case mutateSqlParts tSchema tName of
             Left errorResponse -> return errorResponse
             Right (sq, mq) -> do
-              let emptyPayload = PayloadJSON V.empty
-                  stm = createWriteStatement sq mq
+              let isSingle = case pjType of
+                               PJArray len -> len == 1
+                               PJObject -> True
+                  colNames = colName <$> tableCols dbStructure tSchema tName
+              if topLevelRange /= allRange
+                then return $ simpleError status400 [] "Range header and limit/offset querystring parameters are not allowed for PUT"
+              else if not isSingle
+                then return $ simpleError status400 [] "PUT payload must contain a single row"
+              else if S.fromList colNames /= pjKeys
+                then return $ simpleError status400 [] "You must specify all columns in the payload when using PUT"
+              else do
+                row <- H.query (toS pjRaw) $
+                       createWriteStatement sq mq (contentType == CTSingularJSON) False
+                                            (contentType == CTTextCSV) (iPreferRepresentation apiRequest) []
+                let (_, queryTotal, _, body) = extractQueryResult row
+                -- Makes sure the querystring pk matches the payload pk
+                -- e.g. PUT /items?id=eq.1 { "id" : 1, .. } is accepted, PUT /items?id=eq.14 { "id" : 2, .. } is rejected
+                -- If this condition is not satisfied then nothing is inserted, check the WHERE for INSERT in QueryBuilder.hs to see how it's done
+                if queryTotal /= 1
+                  then do
+                    HT.condemn
+                    return $ simpleError status400 [] "Payload values do not match URL in primary key column(s)"
+                  else
+                    return $ if iPreferRepresentation apiRequest == Full
+                      then responseLBS status200 [toHeader contentType] (toS body)
+                      else responseLBS status204 [] ""
+
+        (ActionDelete, TargetIdent (QualifiedIdentifier tSchema tName), Nothing) ->
+          case mutateSqlParts tSchema tName of
+            Left errorResponse -> return errorResponse
+            Right (sq, mq) -> do
+              let stm = createWriteStatement sq mq
                     (contentType == CTSingularJSON) False
                     (contentType == CTTextCSV)
                     (iPreferRepresentation apiRequest) []
-              row <- H.query emptyPayload stm
+              row <- H.query mempty stm
               let (_, queryTotal, _, body) = extractQueryResult row
                   r = contentRangeH 1 0 $
                         toInteger <$> if shouldCount then Just queryTotal else Nothing
@@ -231,24 +271,40 @@ 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 _, TargetProc qi, Just PayloadJSON{pjRaw, pjType, pjKeys}) ->
+          let returnsScalar = case proc of
+                Just ProcDescription{pdReturnType = (Single (Scalar _))} -> True
+                _ -> False
+              rpcBinaryField = if returnsScalar
+                                 then Right Nothing
+                                 else binaryField contentType =<< fldNames
+              parts = (,) <$> readSqlParts <*> rpcBinaryField in
+          case parts of
             Left errorResponse -> return errorResponse
-            Right (q, cq) -> do
-              let p = V.head payload
+            Right ((q, cq), bField) -> do
+              let isObject = case pjType of
+                                PJObject  -> True
+                                PJArray _ -> False
                   singular = contentType == CTSingularJSON
-                  paramsAsSingleObject = iPreferSingleObjectParameter apiRequest
-              row <- H.query () $
-                callProc qi p q cq topLevelRange shouldCount singular
-                         paramsAsSingleObject (contentType == CTTextCSV)
-              let (tableTotal, queryTotal, body) =
-                    fromMaybe (Just 0, 0, "[]") row
+                  specifiedPgArgs = filter ((`S.member` pjKeys) . pgaName) $ fromMaybe [] (pdArgs <$> proc)
+              row <- H.query (toS pjRaw) $
+                callProc qi specifiedPgArgs returnsScalar q cq shouldCount
+                         singular (iPreferSingleObjectParameter apiRequest)
+                         (contentType == CTTextCSV)
+                         (contentType == CTOctetStream) bField isObject
+                         (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 [toHeader contentType, contentRange] (toS body)
+                  decodedHeaders = first toS $ JSON.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
@@ -257,25 +313,16 @@ 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 (M.elems $ dbProcs dbStructure) ti uri'
-          body <- encodeApi . toTableInfo <$> H.query schema accessibleTables
+              toTableInfo :: [Table] -> [(Table, [Column], [Text])]
+              toTableInfo = map (\t -> let (s, tn) = (tableSchema t, tableName t) in (t, tableCols dbStructure s tn, tablePKCols dbStructure s tn))
+              encodeApi ti sd procs = encodeOpenAPI (concat $ M.elems procs) (toTableInfo ti) uri' sd $ dbPrimaryKeys dbStructure
+          body <- encodeApi <$> H.query schema accessibleTables <*> H.query schema schemaDescription <*> H.query schema accessibleProcs
           return $ responseLBS status200 [toHeader CTOpenAPI] $ toS body
 
         _ -> return notFound
 
     where
-      toTableInfo :: [Table] -> [(Table, [Column], [Text])]
-      toTableInfo = map (\t ->
-        let tSchema = tableSchema t
-            tTable = tableName t
-            cols = filter (filterCol tSchema tTable) $ dbColumns dbStructure
-            pkeys = map pkName $ filter (filterPk tSchema tTable) allPrKeys
-        in (t, cols, pkeys))
       notFound = responseLBS status404 [] ""
-      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
-      allPrKeys = dbPrimaryKeys dbStructure
       allOrigins = ("Access-Control-Allow-Origin", "*") :: Header
       shouldCount = iPreferCount apiRequest
       schema = toS $ configSchema conf
@@ -287,15 +334,15 @@ app dbStructure conf apiRequest =
             status = rangeStatus lower upper (toInteger <$> tableTotal)
         in (status, contentRange)
 
-      readReq = readRequest (configMaxRows conf) (dbRelations dbStructure) (dbProcs dbStructure) apiRequest
+      readReq = readRequest (configMaxRows conf) (dbRelations dbStructure) proc apiRequest
       fldNames = fieldNames <$> readReq
       readDbRequest = DbRead <$> readReq
-      mutateDbRequest = DbMutate <$> (mutateRequest apiRequest =<< fldNames)
       selectQuery = requestToQuery schema False <$> readDbRequest
-      mutateQuery = requestToQuery schema False <$> mutateDbRequest
       countQuery = requestToCountQuery schema <$> readDbRequest
       readSqlParts = (,) <$> selectQuery <*> countQuery
-      mutateSqlParts = (,) <$> selectQuery <*> mutateQuery
+      mutateSqlParts s t =
+        (,) <$> selectQuery
+            <*> (requestToQuery schema False . DbMutate <$> (mutateRequest apiRequest t (tablePKCols dbStructure s t) =<< fldNames))
 
 responseContentTypeOrError :: [ContentType] -> Action -> Either Response ContentType
 responseContentTypeOrError accepts action = serves contentTypesForRequest accepts
@@ -306,14 +353,15 @@ responseContentTypeOrError accepts action = serves contentTypesForRequest accept
         ActionCreate ->  [CTApplicationJSON, CTSingularJSON, CTTextCSV]
         ActionUpdate ->  [CTApplicationJSON, CTSingularJSON, CTTextCSV]
         ActionDelete ->  [CTApplicationJSON, CTSingularJSON, CTTextCSV]
-        ActionInvoke ->  [CTApplicationJSON, CTSingularJSON, CTTextCSV]
+        ActionInvoke _ ->  [CTApplicationJSON, CTSingularJSON, CTTextCSV, CTOctetStream]
         ActionInspect -> [CTOpenAPI, CTApplicationJSON]
         ActionInfo ->    [CTTextCSV]
+        ActionSingleUpsert ->  [CTApplicationJSON, CTSingularJSON, CTTextCSV]
     serves sProduces cAccepts =
       case mutuallyAgreeable sProduces cAccepts of
         Nothing -> do
           let failed = intercalate ", " $ map (toS . toMime) cAccepts
-          Left $ simpleError status415 $
+          Left $ simpleError status415 [] $
             "None of these Content-Types are available: " <> failed
         Just ct -> Right ct
 

src/PostgREST/Auth.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE LambdaCase #-}
 {-|
 Module      : PostgREST.Auth
 Description : PostgREST authorization functions.
@@ -14,67 +15,87 @@ very simple authentication system inside the PostgreSQL database.
 module PostgREST.Auth (
     containsRole
   , jwtClaims
-  , tokenJWT
   , JWTAttempt(..)
+  , parseJWK
   ) where
 
+import           Control.Lens.Operators
+import           Control.Lens           (set)
+import qualified Data.Aeson             as JSON
+import qualified Data.HashMap.Strict    as M
+import           Data.Time.Clock        (UTCTime)
+import           Data.Vector            as V
+import           PostgREST.Types
 import           Protolude
-import           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 qualified Web.JWT                 as JWT
 
+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
+                | JWTClaims (M.HashMap Text JSON.Value)
+                deriving (Eq, Show)
 
 {-|
-  Receives the JWT secret (from config) and a JWT and returns a map
+  Receives the JWT secret and audience (from config) and a JWT and returns a map
   of JWT claims.
 -}
-jwtClaims :: Maybe JWT.Secret -> Text -> NominalDiffTime -> JWTAttempt
-jwtClaims _ "" _ = JWTClaims M.empty
-jwtClaims secret jwt time =
+jwtClaims :: Maybe JWK -> Maybe StringOrURI -> LByteString -> UTCTime -> Maybe JSPath -> IO JWTAttempt
+jwtClaims _ _ "" _ _ = return $ JWTClaims M.empty
+jwtClaims secret audience payload time jspath =
   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
+    Nothing -> return JWTMissingSecret
+    Just s -> do
+      let validation = set allowedSkew 1 $ defaultJWTValidationSettings (maybe (const True) (==) audience)
+      eJwt <- runExceptT $ do
+        jwt <- decodeCompact payload
+        verifyClaimsAt validation s time jwt
+      return $ case eJwt of
+        Left e    -> JWTInvalid e
+        Right jwt -> JWTClaims $ claims2map jwt jspath
 
 {-|
-  Receives the JWT secret (from config) and a JWT and a JSON value
-  and returns a signed JWT.
+  Turn JWT ClaimSet into something easier to work with,
+  also here the jspath is applied to put the "role" in the map
 -}
-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
+claims2map :: ClaimsSet -> Maybe JSPath -> M.HashMap Text JSON.Value
+claims2map claims jspath = (\case
+    val@(JSON.Object o) ->
+      let role = maybe M.empty (M.singleton "role") $
+                 walkJSPath (Just val) =<< jspath in
+      M.delete "role" o `M.union` role -- mutating the map
+    _ -> M.empty
+  ) $ JSON.toJSON claims
+
+walkJSPath :: Maybe JSON.Value -> JSPath -> Maybe JSON.Value
+walkJSPath x                      []                = x
+walkJSPath (Just (JSON.Object o)) (JSPKey key:rest) = walkJSPath (M.lookup key o) rest
+walkJSPath (Just (JSON.Array ar)) (JSPIdx idx:rest) = walkJSPath (ar V.!? idx) rest
+walkJSPath _                      _                 = Nothing
 
 {-|
   Whether a response from jwtClaims contains a role claim
 -}
 containsRole :: JWTAttempt -> Bool
 containsRole (JWTClaims claims) = M.member "role" claims
-containsRole _ = False
+containsRole _                  = False
+
+parseJWK :: ByteString -> JWK
+parseJWK str =
+  fromMaybe (hs256jwk str) (JSON.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,4 @@
+{-# LANGUAGE LambdaCase, TemplateHaskell #-}
 {-# OPTIONS_GHC -fno-warn-type-defaults #-}
 {-|
 Module      : PostgREST.Config
@@ -14,38 +15,52 @@ 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 (..)
+                        , pgVersion95
+                        , pgVersion96
                         , AppConfig (..)
                         )
        where
 
-import           System.IO.Error             (IOError)
 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.Parser    as C
-import           Data.Configurator.Types     (Value(..))
-import           Data.List                   (lookup)
+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.Text                   (strip, intercalate, lines)
-import           Data.Text.Encoding          (encodeUtf8)
-import           Data.Text.IO                (hPutStrLn)
-import           Data.Version                (versionBranch)
+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           System.IO                   (hPrint)
+import           Network.Wai.Middleware.Cors  (CorsResourcePolicy (..))
+import           Options.Applicative          hiding (str)
+import           Paths_postgrest              (version)
+import           PostgREST.Parsers            (pRoleClaimKey)
+import           PostgREST.Types              (PgVersion(..), ApiRequestError(..),
+                                               JSPath, JSPathExp(..))
+import           Protolude                    hiding (hPutStrLn, take,
+                                               intercalate, (<>))
+import           System.IO                    (hPrint)
+import           System.IO.Error              (IOError)
 import           Text.Heredoc
-import           Text.PrettyPrint.ANSI.Leijen hiding ((<>), (<$>))
+import           Text.PrettyPrint.ANSI.Leijen hiding ((<$>), (<>))
 import qualified Text.PrettyPrint.ANSI.Leijen as L
-import           Protolude hiding            (intercalate, (<>))
 
 -- | Config file settings for the server
 data AppConfig = AppConfig {
@@ -58,11 +73,14 @@ data AppConfig = AppConfig {
 
   , configJwtSecret         :: Maybe B.ByteString
   , configJwtSecretIsBase64 :: Bool
+  , configJwtAudience       :: Maybe StringOrURI
 
   , configPool              :: Int
   , configMaxRows           :: Maybe Integer
   , configReqCheck          :: Maybe Text
   , configQuiet             :: Bool
+  , configSettings          :: [(Text, Text)]
+  , configRoleClaimKey      :: Either ApiRequestError JSPath
   }
 
 defaultCorsPolicy :: CorsResourcePolicy
@@ -90,7 +108,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
@@ -102,20 +126,23 @@ readOptions = do
     (C.readConfig =<< C.load [C.Required cfgPath])
     configNotfoundHint
 
-  let (mAppConf, errs) = flip C.runParserA conf $
-        AppConfig <$>
-            C.key "db-uri"
+  let (mAppConf, errs) = flip C.runParserM conf $
+        AppConfig
+          <$> C.key "db-uri"
           <*> C.key "db-anon-role"
-          <*> C.key "server-proxy-uri"
+          <*> (mfilter (/= "") <$> C.key "server-proxy-uri")
           <*> C.key "db-schema"
-          <*> (fromMaybe "*4" <$> C.key "server-host")
+          <*> (fromMaybe "127.0.0.1" . mfilter (/= "") <$> C.key "server-host")
           <*> (fromMaybe 3000 . join . fmap coerceInt <$> C.key "server-port")
           <*> (fmap encodeUtf8 . mfilter (/= "") <$> C.key "jwt-secret")
-          <*> (fromMaybe False <$> C.key "secret-is-base64")
+          <*> (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")
-          <*> C.key "pre-request"
+          <*> (mfilter (/= "") <$> C.key "pre-request")
           <*> pure False
+          <*> (fmap (fmap coerceText) <$> C.subassocs "app.settings")
+          <*> (maybe (Right [JSPKey "role"]) parseRoleClaimKey <$> C.key "role-claim-key")
 
   case mAppConf of
     Nothing -> do
@@ -124,56 +151,82 @@ readOptions = do
     Just appConf ->
       return appConf
 
- where
-  coerceInt :: (Read i, Integral i) => Value -> Maybe i
-  coerceInt (Number x) = rightToMaybe $ floatingOrInteger x
-  coerceInt (String x) = readMaybe $ toS x
-  coerceInt _ = Nothing
+  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'
 
-  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)
-             )
+    coerceText :: Value -> Text
+    coerceText (String s) = s
+    coerceText v = show v
 
-  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 b) = readMaybe $ toS b
+    coerceBool _          = Nothing
 
-  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"
-        |]
+    parseRoleClaimKey :: Value -> Either ApiRequestError JSPath
+    parseRoleClaimKey (String s) = pRoleClaimKey s
+    parseRoleClaimKey v = pRoleClaimKey $ show v
+
+    opts = info (helper <*> pathParser) $
+             fullDesc
+             <> progDesc (
+                 "PostgREST "
+                 <> toS prettyVersion
+                 <> " / create a REST API to an existing Postgres database"
+               )
+             <> footerDoc (Just $
+                 text "Example Config File:"
+                 L.<> nest 2 (hardline L.<> exampleCfg)
+               )
+
+    parserPrefs = prefs showHelpOnError
+
+    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 = "127.0.0.1"
+          |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"
+          |
+          |## jspath to the role claim key
+          |# role-claim-key = ".role"
+          |]
 
 pathParser :: Parser FilePath
 pathParser =
@@ -181,11 +234,12 @@ 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"
+minimumPgVersion = PgVersion 90400 "9.4"
+
+pgVersion96 :: PgVersion
+pgVersion96 = PgVersion 90600 "9.6"
+
+pgVersion95 :: PgVersion
+pgVersion95 = PgVersion 90500 "9.5"

src/PostgREST/DbRequestBuilder.hs

@@ -1,5 +1,8 @@
 {-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE DuplicateRecordFields    #-}
+{-# LANGUAGE DuplicateRecordFields#-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE MultiWayIf #-}
+{-# LANGUAGE NamedFieldPuns #-}
 module PostgREST.DbRequestBuilder (
   readRequest
 , mutateRequest
@@ -13,6 +16,7 @@ import           Control.Lens.Tuple        (_1)
 import qualified Data.ByteString.Char8     as BS
 import           Data.List                 (delete)
 import           Data.Maybe                (fromJust)
+import qualified Data.Set                  as S
 import           Data.Text                 (isInfixOf)
 import           Data.Tree
 import           Data.Either.Combinators   (mapLeft)
@@ -29,55 +33,71 @@ import           PostgREST.ApiRequest   ( ApiRequest(..)
                                         )
 import           PostgREST.Error           (apiRequestError)
 import           PostgREST.Parsers
-import           PostgREST.RangeQuery      (NonnegRange, restrictRange)
-import           PostgREST.QueryBuilder (getJoinConditions, sourceCTEName)
+import           PostgREST.RangeQuery      (NonnegRange, restrictRange, allRange)
 import           PostgREST.Types
 
 import           Protolude                hiding (from, dropWhile, drop)
 import           Text.Regex.TDFA         ((=~))
 import           Unsafe                  (unsafeHead)
 
-readRequest :: Maybe Integer -> [Relation] -> M.HashMap Text ProcDescription -> ApiRequest -> Either Response ReadRequest
-readRequest maxRows allRels allProcs apiRequest  =
+readRequest :: Maybe Integer -> [Relation] -> Maybe ProcDescription -> ApiRequest -> Either Response ReadRequest
+readRequest maxRows allRels proc apiRequest  =
   mapLeft apiRequestError $
   treeRestrictRange maxRows =<<
   augumentRequestWithJoin schema relations =<<
-  parseReadRequest
+  addFiltersOrdersRanges apiRequest <*>
+  (buildReadRequest <$> pRequestSelect (iSelect apiRequest))
   where
+    action = iAction apiRequest
     (schema, rootTableName) = fromJust $ -- Make it safe
       let target = iTarget apiRequest in
       case target of
         (TargetIdent (QualifiedIdentifier s t) ) -> Just (s, t)
-        (TargetProc  (QualifiedIdentifier s proc) ) -> Just (s, tName)
+        (TargetProc  (QualifiedIdentifier s pName) ) -> Just (s, tName)
           where
-            retType = pdReturnType <$> M.lookup proc allProcs
-            tName = case retType of
+            tName = case pdReturnType <$> proc of
               Just (SetOf (Composite qi)) -> qiName qi
               Just (Single (Composite qi)) -> qiName qi
-              _ -> proc
+              _ -> pName
 
         _ -> Nothing
 
-    action :: Action
-    action = iAction apiRequest
-
-    parseReadRequest :: Either ApiRequestError ReadRequest
-    parseReadRequest = addFiltersOrdersRanges apiRequest <*>
-      pRequestSelect rootName selStr
+    -- Build tree with a Depth attribute so when a self join occurs we can differentiate the parent and child tables by having
+    -- an alias like "table_depth", this is related to issue #987.
+    buildReadRequest :: [Tree SelectItem] -> ReadRequest
+    buildReadRequest fieldTree =
+      let rootDepth = 0
+          rootNodeName = if action == ActionRead then rootTableName else sourceCTEName in
+      foldr (treeEntry rootDepth) (Node (Select [] [rootNodeName] [] [] [] allRange, (rootNodeName, Nothing, Nothing, Nothing, rootDepth)) []) fieldTree
       where
-        selStr = iSelect apiRequest
-        rootName = if action == ActionRead
-          then rootTableName
-          else sourceCTEName
+        treeEntry :: Depth -> Tree SelectItem -> ReadRequest -> ReadRequest
+        treeEntry depth (Node fld@((fn, _),_,alias,relationDetail) fldForest) (Node (q, i) rForest) =
+          let nxtDepth = succ depth in
+          case fldForest of
+            [] -> Node (q {select=fld:select q}, i) rForest
+            _  -> Node (q, i) $
+                  foldr (treeEntry nxtDepth) (Node (Select [] [fn] [] [] [] allRange, (fn, Nothing, alias, relationDetail, nxtDepth)) []) fldForest:rForest
 
     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
+      where fakeSourceRelations = mapMaybe (toSourceRelation rootTableName) allRels
+
+-- in a relation where one of the tables matches "TableName"
+-- replace the name to that table with pg_source
+-- this "fake" relations is needed so that in a mutate query
+-- we can look a the "returning *" part which is wrapped with a "with"
+-- as just another table that has relations with other tables
+toSourceRelation :: TableName -> Relation -> Maybe Relation
+toSourceRelation mt r@(Relation t _ ft _ _ rt _ _)
+  | mt == tableName t = Just $ r {relTable=t {tableName=sourceCTEName}}
+  | mt == tableName ft = Just $ r {relFTable=t {tableName=sourceCTEName}}
+  | Just mt == (tableName <$> rt) = Just $ r {relLinkTable=(\tbl -> tbl {tableName=sourceCTEName}) <$> rt}
+  | otherwise = Nothing
 
 treeRestrictRange :: Maybe Integer -> ReadRequest -> Either ApiRequestError ReadRequest
 treeRestrictRange maxRows_ request = pure $ nodeRestrictRange maxRows_ `fmap` request
@@ -91,85 +111,132 @@ augumentRequestWithJoin schema allRels request =
   >>= addJoinConditions schema
 
 addRelations :: Schema -> [Relation] -> Maybe ReadRequest -> ReadRequest -> Either ApiRequestError ReadRequest
-addRelations schema allRelations parentNode (Node readNode@(query, (name, _, alias)) forest) =
+addRelations schema allRelations parentNode (Node (query, (nodeName, _, alias, relationDetail, depth)) forest) =
   case parentNode of
-    (Just (Node (Select{from=[parentNodeTable]}, (_, _, _)) _)) ->
-      Node <$> readNode' <*> forest'
-      where
-        forest' = updateForest $ hush node'
-        node' = Node <$> readNode' <*> pure forest
-        readNode' = addRel readNode <$> rel
-        rel :: Either ApiRequestError Relation
-        rel = note (NoRelationBetween parentNodeTable name)
-            $ findRelation schema name parentNodeTable
-
-            where
-              findRelation s nodeTableName parentNodeTableName =
-                find (\r ->
-                  s == tableSchema (relTable r) && -- match schema for relation table
-                  s == tableSchema (relFTable r) && -- match schema for relation foriegn table
-                  (
-
-                    -- (request)        => projects { ..., clients{...} }
-                    -- will match
-                    -- (relation type)  => parent
-                    -- (entity)         => clients  {id}
-                    -- (foriegn entity) => projects {client_id}
-                    (
-                      nodeTableName == tableName (relTable r) && -- match relation table name
-                      parentNodeTableName == tableName (relFTable r) -- match relation foreign table name
-                    ) ||
-
-
-                    -- (request)        => projects { ..., client_id{...} }
-                    -- will match
-                    -- (relation type)  => parent
-                    -- (entity)         => clients  {id}
-                    -- (foriegn entity) => projects {client_id}
-                    (
-                      parentNodeTableName == tableName (relFTable r) &&
-                      length (relFColumns r) == 1 &&
-                      nodeTableName `colMatches` (colName . unsafeHead . relFColumns) r
-                    )
-
-                    -- (request)        => project_id { ..., client_id{...} }
-                    -- will match
-                    -- (relation type)  => parent
-                    -- (entity)         => clients  {id}
-                    -- (foriegn entity) => projects {client_id}
-                    -- this case works becasue before reaching this place
-                    -- addRelation will turn project_id to project so the above condition will match
-                  )
-                ) allRelations
-                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))
-          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
-        r = Relation t [] t [] Root Nothing Nothing Nothing
+    Just (Node (Select{from=[parentNodeTable]}, _) _) ->
+      let newFrom r = (\tName -> if tName == nodeName then tableName (relTable r) else tName) <$> from query
+          newReadNode = (\r -> (query{from=newFrom r}, (nodeName, Just r, alias, Nothing, depth))) <$> rel
+          rel :: Either ApiRequestError Relation
+          rel = note (NoRelationBetween parentNodeTable nodeName) $
+                findRelation schema allRelations nodeName parentNodeTable relationDetail in
+      Node <$> newReadNode <*> (updateForest . hush $ Node <$> newReadNode <*> pure forest)
+    _ ->
+      let rn = (query, (nodeName, Just r, alias, Nothing, depth))
+          r = Relation t [] t [] Root Nothing Nothing Nothing
+          t = Table schema nodeName Nothing True in -- !!! TODO find another way to get the table from the query
+      Node rn <$> updateForest (Just $ Node rn forest)
   where
     updateForest :: Maybe ReadRequest -> Either ApiRequestError [ReadRequest]
-    updateForest n = mapM (addRelations schema allRelations n) forest
+    updateForest rq = mapM (addRelations schema allRelations rq) forest
+
+findRelation :: Schema -> [Relation] -> NodeName -> TableName -> Maybe RelationDetail -> Maybe Relation
+findRelation schema allRelations nodeTableName parentNodeTableName relationDetail =
+  find (\Relation{relTable, relColumns, relFTable, relFColumns, relType, relLinkTable} ->
+    -- Both relation ends need to be on the exposed schema
+    schema == tableSchema relTable && schema == tableSchema relFTable &&
+    case relationDetail of
+      Nothing ->
+
+        -- (request)        => projects { ..., clients{...} }
+        -- will match
+        -- (relation type)  => parent
+        -- (entity)         => clients  {id}
+        -- (foriegn entity) => projects {client_id}
+        (
+          nodeTableName == tableName relTable && -- match relation table name
+          parentNodeTableName == tableName relFTable -- match relation foreign table name
+        ) ||
+
+        -- (request)        => projects { ..., client_id{...} }
+        -- will match
+        -- (relation type)  => parent
+        -- (entity)         => clients  {id}
+        -- (foriegn entity) => projects {client_id}
+        (
+          parentNodeTableName == tableName relFTable &&
+          length relFColumns == 1 &&
+          -- match common foreign key names(table_name_id, table_name_fk) to table_name
+          (toS ("^" <> colName (unsafeHead relFColumns) <> "_?(?:|[iI][dD]|[fF][kK])$") :: BS.ByteString) =~ (toS nodeTableName :: BS.ByteString)
+        )
+
+        -- (request)        => project_id { ..., client_id{...} }
+        -- will match
+        -- (relation type)  => parent
+        -- (entity)         => clients  {id}
+        -- (foriegn entity) => projects {client_id}
+        -- this case works becasue before reaching this place
+        -- addRelation will turn project_id to project so the above condition will match
+
+      Just rd ->
+
+        -- (request)        => clients { ..., projects.client_id{...} }
+        -- will match
+        -- (relation type)  => child
+        -- (entity)         => clients  {id}
+        -- (foriegn entity) => projects {client_id}
+        (
+          relType == Child &&
+          nodeTableName == tableName relTable && -- match relation table name
+          parentNodeTableName == tableName relFTable && -- match relation foreign table name
+          length relColumns == 1 &&
+          rd == colName (unsafeHead relColumns)
+        ) ||
+
+        -- (request)        => message { ..., person_detail.sender{...} }
+        -- will match
+        -- (relation type)  => parent
+        -- (entity)         => message  {sender}
+        -- (foriegn entity) => person_detail {id}
+        (
+          relType == Parent &&
+          nodeTableName == tableName relTable && -- match relation table name
+          parentNodeTableName == tableName relFTable && -- match relation foreign table name
+          length relFColumns == 1 &&
+          rd == colName (unsafeHead relFColumns)
+        ) ||
+
+        -- (request)        => tasks { ..., users.tasks_users{...} }
+        -- will match
+        -- (relation type)  => many
+        -- (entity)         => users
+        -- (foriegn entity) => tasks
+        (
+          relType == Many &&
+          nodeTableName == tableName relTable && -- match relation table name
+          parentNodeTableName == tableName relFTable && -- match relation foreign table name
+          rd == tableName (fromJust relLinkTable)
+        )
+  ) allRelations
 
 addJoinConditions :: Schema -> ReadRequest -> Either ApiRequestError 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
-    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'}
+addJoinConditions 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, relLinkTable=(Just linkTable)} ->
+      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'}
+    augmentQuery rel = foldr addJoinCond query (getJoinConditions rel)
+    addJoinCond :: JoinCondition -> ReadQuery -> ReadQuery
+    addJoinCond jc rq@Select{joinConditions=jcs} = rq{joinConditions=jc:jcs}
+
+getJoinConditions :: Relation -> [JoinCondition]
+getJoinConditions (Relation Table{tableSchema=tSchema, tableName=tN} cols Table{tableName=ftN} fcs typ lt lc1 lc2) =
+  if | typ == Child || typ == Parent ->
+        zipWith (toJoinCondition tN ftN) cols fcs
+     | typ == Many ->
+        let ltN = fromMaybe "" (tableName <$> lt) in
+        zipWith (toJoinCondition tN ltN) cols (fromMaybe [] lc1) ++ zipWith (toJoinCondition ftN ltN) fcs (fromMaybe [] lc2)
+     | typ == Root -> witness
+  where
+    toJoinCondition :: Text -> Text -> Column -> Column -> JoinCondition
+    toJoinCondition tb ftb c fc =
+      JoinCondition (QualifiedIdentifier tSchema tb, Nothing, colName c)
+                    (QualifiedIdentifier tSchema ftb, Nothing, colName fc)
 
 addFiltersOrdersRanges :: ApiRequest -> Either ApiRequestError (ReadRequest -> ReadRequest)
 addFiltersOrdersRanges apiRequest = foldr1 (liftA2 (.)) [
@@ -189,22 +256,24 @@ addFiltersOrdersRanges apiRequest = foldr1 (liftA2 (.)) [
     logicForest = mapM pRequestLogicTree logFrst
     action = iAction apiRequest
     -- there can be no filters on the root table when we are doing insert/update/delete
-    (flts, logFrst)
-      | action == ActionRead || action == ActionInvoke = (iFilters apiRequest, iLogic apiRequest)
-      | otherwise = join (***) (filter (( "." `isInfixOf` ) . fst)) (iFilters apiRequest, iLogic apiRequest)
+    (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 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 :: (EmbedPath, Filter) -> ReadRequest -> ReadRequest
 addFilter = addProperty addFilterToNode
 
 addOrderToNode :: [OrderTerm] -> ReadRequest -> ReadRequest
-addOrderToNode o (Node (q,i) f) = Node (q{order=Just o}, i) f
+addOrderToNode o (Node (q,i) f) = Node (q{order=o}, i) f
 
 addOrder :: (EmbedPath, [OrderTerm]) -> ReadRequest -> ReadRequest
 addOrder = addProperty addOrderToNode
@@ -216,65 +285,47 @@ addRange :: (EmbedPath, NonnegRange) -> ReadRequest -> ReadRequest
 addRange = addProperty addRangeToNode
 
 addLogicTreeToNode :: LogicTree -> ReadRequest -> ReadRequest
-addLogicTreeToNode t (Node (q@Select{logic=l},i) f) = Node (q{logic=t:l}::ReadQuery, i) f
+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
+addProperty f ([], a) rr = f a rr
+addProperty f (targetNodeName:remainingPath, a) (Node rn forest) =
+  case pathNode of
     Nothing -> Node rn forest -- the property is silenty dropped in the Request does not contain the required path
-    Just tn -> Node rn (addProperty f (remainingPath, a) tn:restForest)
+    Just tn -> Node rn (addProperty f (remainingPath, a) tn:delete tn forest)
   where
-    targetNodeName:remainingPath = path
-    (targetNode,restForest) = splitForest targetNodeName forest
-    splitForest :: NodeName -> Forest ReadNode -> (Maybe ReadRequest, Forest ReadNode)
-    splitForest name forst =
-      case maybeNode of
-        Nothing -> (Nothing,forest)
-        Just node -> (Just node, delete node forest)
-      where
-        maybeNode :: Maybe ReadRequest
-        maybeNode = find fnd forst
-          where
-            fnd :: ReadRequest -> Bool
-            fnd (Node (_,(n,_,_)) _) = n == name
+    pathNode = find (\(Node (_,(nodeName,_,alias,_,_)) _) -> nodeName == targetNodeName || alias == Just targetNodeName) forest
 
--- in a relation where one of the tables mathces "TableName"
--- replace the name to that table with pg_source
--- this "fake" relations is needed so that in a mutate query
--- we can look a the "returning *" part which is wrapped with a "with"
--- as just another table that has relations with other tables
-toSourceRelation :: TableName -> Relation -> Maybe Relation
-toSourceRelation mt r@(Relation t _ ft _ _ rt _ _)
-  | mt == tableName t = Just $ r {relTable=t {tableName=sourceCTEName}}
-  | mt == tableName ft = Just $ r {relFTable=t {tableName=sourceCTEName}}
-  | Just mt == (tableName <$> rt) = Just $ r {relLTable=(\tbl -> tbl {tableName=sourceCTEName}) <$> rt}
-  | otherwise = Nothing
-
-mutateRequest :: ApiRequest -> [FieldName] -> Either Response MutateRequest
-mutateRequest apiRequest fldNames = mapLeft apiRequestError $
+mutateRequest :: ApiRequest -> TableName -> [Text] -> [FieldName] -> Either Response MutateRequest
+mutateRequest apiRequest tName pkCols fldNames = mapLeft apiRequestError $
   case action of
-    ActionCreate -> Right $ Insert rootTableName payload returnings
-    ActionUpdate -> Update rootTableName <$> pure payload <*> filters <*> logic_ <*> pure returnings
-    ActionDelete -> Delete rootTableName <$> filters <*> logic_ <*> pure returnings
-    _        -> Left UnsupportedVerb
+    ActionCreate -> Right $ Insert tName pkCols payload (iPreferResolution apiRequest) [] returnings
+    ActionUpdate -> Update tName payload <$> combinedLogic <*> pure returnings
+    ActionSingleUpsert ->
+      (\flts ->
+        if null (iLogic apiRequest) &&
+           S.fromList (fst <$> iFilters apiRequest) == S.fromList pkCols &&
+           not (null (S.fromList pkCols)) &&
+           all (\case
+              Filter _ (OpExpr False (Op "eq" _)) -> True
+              _ -> False) flts
+          then Insert tName pkCols payload (Just MergeDuplicates) <$> combinedLogic <*> pure returnings
+        else
+          Left InvalidFilters) =<< filters
+    ActionDelete -> Delete tName <$> combinedLogic <*> pure returnings
+    _            -> Left UnsupportedVerb
   where
     action = iAction apiRequest
     payload = fromJust $ iPayload apiRequest
-    rootTableName = -- TODO: Make it safe
-      let target = iTarget apiRequest in
-      case target of
-        (TargetIdent (QualifiedIdentifier _ t) ) -> t
-        _ -> undefined
     returnings = if iPreferRepresentation apiRequest == None then [] else fldNames
     filters = map snd <$> mapM pRequestFilter mutateFilters
-    logic_ = map snd <$> mapM pRequestLogicTree logicFilters
+    logic = map snd <$> mapM pRequestLogicTree logicFilters
+    combinedLogic = foldr addFilterToLogicForest <$> logic <*> filters
     -- update/delete filters can be only on the root table
-    mutateFilters = onlyRoot $ iFilters apiRequest
-    logicFilters = onlyRoot $ iLogic apiRequest
+    (mutateFilters, logicFilters) = join (***) onlyRoot (iFilters apiRequest, iLogic apiRequest)
     onlyRoot = filter (not . ( "." `isInfixOf` ) . fst)
 
 fieldNames :: ReadRequest -> [FieldName]
@@ -282,5 +333,10 @@ 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 (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

@@ -3,9 +3,13 @@
 {-# LANGUAGE QuasiQuotes           #-}
 {-# LANGUAGE ScopedTypeVariables   #-}
 {-# LANGUAGE TypeSynonymInstances  #-}
+{-# LANGUAGE NamedFieldPuns  #-}
 module PostgREST.DbStructure (
   getDbStructure
 , accessibleTables
+, accessibleProcs
+, schemaDescription
+, getPgVersion
 ) where
 
 import qualified Hasql.Decoders                as HD
@@ -14,10 +18,11 @@ 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 qualified Data.List                     as L
+import           Data.Set                      as S (fromList)
 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
@@ -27,32 +32,35 @@ import           GHC.Exts                      (groupWith)
 import           Protolude
 import           Unsafe (unsafeHead)
 
-getDbStructure :: Schema -> H.Session DbStructure
-getDbStructure schema = do
-  tabs <- H.query () allTables
-  cols <- H.query () $ allColumns tabs
-  syns <- H.query () $ allSynonyms cols
-  rels <- H.query () $ allRelations tabs cols
-  keys <- H.query () $ allPrimaryKeys tabs
-  procs <- H.query schema accessibleProcs
+getDbStructure :: Schema -> PgVersion -> H.Session DbStructure
+getDbStructure schema pgVer = do
+  tabs      <- H.query () allTables
+  cols      <- H.query schema $ allColumns tabs
+  syns      <- H.query schema $ allSynonyms cols
+  childRels <- H.query () $ allChildRelations tabs cols
+  keys      <- H.query () $ allPrimaryKeys tabs
+  procs     <- H.query schema allProcs
 
-  let rels' = (addManyToManyRelations . raiseRelations schema syns . addParentRelations . addSynonymousRelations syns) rels
-      cols' = addForeignKeys rels' cols
-      keys' = synonymousPrimaryKeys syns keys
+  let rels = addManyToManyRelations . addParentRelations $ addViewRelations syns childRels
+      cols' = addForeignKeys rels cols
+      keys' = addViewPrimaryKeys syns keys
 
   return DbStructure {
       dbTables = tabs
     , dbColumns = cols'
-    , dbRelations = rels'
+    , dbRelations = rels
     , dbPrimaryKeys = keys'
     , dbProcs = procs
+    , pgVersion = pgVer
     }
 
 decodeTables :: HD.Result [Table]
 decodeTables =
   HD.rowsList tblRow
  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]
@@ -60,11 +68,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
@@ -88,7 +96,7 @@ decodePks tables =
  where
   pkRow = (,,) <$> HD.value HD.text <*> HD.value HD.text <*> HD.value HD.text
 
-decodeSynonyms :: [Column] -> HD.Result [(Column,Column)]
+decodeSynonyms :: [Column] -> HD.Result [Synonym]
 decodeSynonyms cols =
   mapMaybe (synonymFromRow cols) <$> HD.rowsList synRow
  where
@@ -97,57 +105,68 @@ decodeSynonyms cols =
     <*> HD.value HD.text <*> HD.value HD.text
     <*> HD.value HD.text <*> HD.value HD.text
 
-accessibleProcs :: H.Query Schema (M.HashMap Text ProcDescription)
-accessibleProcs =
-  H.statement sql (HE.value HE.text)
-    (M.fromList . map addName <$>
-      HD.rowsList (
-        ProcDescription <$> HD.value HD.text
-                        <*> (parseArgs <$> HD.value HD.text)
-                        <*> (parseRetType <$>
-                            HD.value HD.text <*>
-                            HD.value HD.text <*>
-                            HD.value HD.bool <*>
-                            HD.value HD.char)
-                        <*> (parseVolatility <$>
-                            HD.value HD.char)
-      )
-    ) True
- where
-  addName :: ProcDescription -> (Text, ProcDescription)
-  addName pd = (pdName pd, pd)
+decodeProcs :: HD.Result (M.HashMap Text [ProcDescription])
+decodeProcs =
+  -- Duplicate rows for a function means they're overloaded, order these by least args according to ProcDescription Ord instance
+  map sort . M.fromListWith (++) . map ((\(x,y) -> (x, [y])) . addName) <$> HD.rowsList tblRow
+  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 (==',')
 
-  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' -> Pseudo name
-        _   -> Scalar qi -- 'b'ase, 'd'omain, 'e'num, 'r'ange
+    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)
 
-  parseVolatility :: Char -> ProcVolatility
-  parseVolatility 'i' = Immutable
-  parseVolatility 's' = Stable
-  parseVolatility 'v' = Volatile
-  parseVolatility _   = Volatile -- should not happen, but be pessimistic
+    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
 
-  sql = [q|
+    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",
@@ -159,7 +178,22 @@ accessibleProcs =
     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
-  WHERE  pn.nspname = $1|]
+    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 =
@@ -169,6 +203,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
@@ -178,8 +213,9 @@ 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')
+      c.relkind in ('v', 'r', 'm', 'f')
       and n.nspname = $1
       and (
         pg_has_role(c.relowner, 'USAGE'::text)
@@ -188,18 +224,6 @@ accessibleTables =
       )
     order by relname |]
 
-synonymousColumns :: [(Column,Column)] -> [Column] -> [[Column]]
-synonymousColumns allSyns cols = synCols'
-  where
-    syns = case headMay cols of
-            Just firstCol -> sort $ filter ((== colTable firstCol) . colTable . fst) allSyns
-            Nothing -> []
-    synCols  = transpose $ map (\c -> map snd $ filter ((== c) . fst) syns) cols
-    synCols' = (filter sameTable . filter matchLength) synCols
-    matchLength cs = length cols == length cs
-    sameTable (c:cs) = all (\cc -> colTable c == colTable cc) (c:cs)
-    sameTable [] = False
-
 addForeignKeys :: [Relation] -> [Column] -> [Column]
 addForeignKeys rels = map addFk
   where
@@ -208,31 +232,84 @@ addForeignKeys rels = map addFk
     lookupFn :: Column -> Relation -> Bool
     lookupFn c Relation{relColumns=cs, relType=rty} = c `elem` cs && rty==Child
     relToFk col Relation{relColumns=cols, relFColumns=colsF} = do
-      pos <- elemIndex col cols
+      pos <- L.elemIndex col cols
       colF <- atMay colsF pos
       return $ ForeignKey colF
 
-addSynonymousRelations :: [(Column,Column)] -> [Relation] -> [Relation]
-addSynonymousRelations _ [] = []
-addSynonymousRelations syns (rel:rels) = rel : synRelsP ++ synRelsF ++ addSynonymousRelations syns rels
-  where
-    synRelsP = synRels (relColumns rel) (\t cs -> rel{relTable=t,relColumns=cs})
-    synRelsF = synRels (relFColumns rel) (\t cs -> rel{relFTable=t,relFColumns=cs})
-    synRels cols mapFn = map (\cs -> mapFn (colTable $ unsafeHead cs) cs) $ synonymousColumns syns cols
+{-
+Adds Views Child Relations based on Synonyms found, the logic is as follows:
+
+Having a Relation{relTable=t1, relColumns=[c1], relFTable=t2, relFColumns=[c2], relType=Child} represented by:
+
+t1.c1------t2.c2
+
+When only having a t1_view.c1 synonym, we need to add a View to Table Relation
+
+         t1.c1----t2.c2         t1.c1----------t2.c2
+                         ->            --------/
+                                      /
+      t1_view.c1             t1_view.c1
+
+
+When only having a t2_view.c2 synonym, we need to add a Table to View Relation
+
+         t1.c1----t2.c2               t1.c1----------t2.c2
+                               ->          \--------
+                                                    \
+                    t2_view.c2                      t2_view.c1
+
+When having t1_view.c1 and a t2_view.c2 synonyms, we need to add a View to View Relation in addition to the prior
+
+         t1.c1----t2.c2               t1.c1----------t2.c2
+                               ->          \--------/
+                                           /        \
+    t1_view.c1     t2_view.c2     t1_view.c1-------t2_view.c1
+
+The logic for composite pks is similar just need to make sure all the Relation columns have synonyms.
+-}
+addViewRelations :: [Synonym] -> [Relation] -> [Relation]
+addViewRelations allSyns = concatMap (\rel ->
+  rel : case rel of
+    Relation{relType=Child, relTable, relColumns, relFTable, relFColumns} ->
+
+      let colSynsGroupedByView :: [Column] -> [[Synonym]]
+          colSynsGroupedByView relCols = L.groupBy (\(_, viewCol1) (_, viewCol2) -> colTable viewCol1 == colTable viewCol2) $
+                                         filter (\(c, _) -> c `elem` relCols) allSyns
+          colsSyns = colSynsGroupedByView relColumns
+          fColsSyns = colSynsGroupedByView relFColumns
+          getView :: [Synonym] -> Table
+          getView = colTable . snd . unsafeHead
+          syns `allSynsOf` cols = S.fromList (fst <$> syns) == S.fromList cols in
+
+      -- View Table Relations
+      [Relation (getView syns) (snd <$> syns) relFTable relFColumns Child Nothing Nothing Nothing
+        | syns <- colsSyns, syns `allSynsOf` relColumns] ++
+
+      -- Table View Relations
+      [Relation relTable relColumns (getView fSyns) (snd <$> fSyns) Child Nothing Nothing Nothing
+        | fSyns <- fColsSyns, fSyns `allSynsOf` relFColumns] ++
+
+      -- View View Relations
+      [Relation (getView syns) (snd <$> syns) (getView fSyns) (snd <$> fSyns) Child Nothing Nothing Nothing
+        | syns <- colsSyns, fSyns <- fColsSyns, syns `allSynsOf` relColumns, fSyns `allSynsOf` relFColumns]
+
+    _ -> [])
 
 addParentRelations :: [Relation] -> [Relation]
-addParentRelations [] = []
-addParentRelations (rel@(Relation t c ft fc _ _ _ _):rels) = Relation ft fc t c Parent Nothing Nothing Nothing : rel : addParentRelations rels
+addParentRelations = concatMap (\rel@(Relation t c ft fc _ _ _ _) -> [rel, Relation ft fc t c Parent Nothing Nothing Nothing])
 
 addManyToManyRelations :: [Relation] -> [Relation]
 addManyToManyRelations rels = rels ++ addMirrorRelation (mapMaybe link2Relation links)
   where
     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)
-    addMirrorRelation [] = []
-    addMirrorRelation (rel@(Relation t c ft fc _ lt lc1 lc2):rels') = Relation ft fc t c Many lt lc2 lc1 : rel : addMirrorRelation rels'
+    groupFn Relation{relTable=Table{tableSchema=s, tableName=t}} = s <> "_" <> t
+    -- Reference : https://wiki.haskell.org/99_questions/Solutions/26
+    combinations :: Int -> [a] -> [[a]]
+    combinations 0 _  = [ [] ]
+    combinations n xs = [ y:ys | y:xs' <- tails xs
+                               , ys <- combinations (n-1) xs']
+    addMirrorRelation = concatMap (\rel@(Relation t c ft fc _ lt lc1 lc2) -> [rel, Relation ft fc t c Many lt lc2 lc1])
     link2Relation [
       Relation{relTable=lt, relColumns=lc1, relFTable=t,  relFColumns=c},
       Relation{             relColumns=lc2, relFTable=ft, relFColumns=fc}
@@ -241,25 +318,11 @@ addManyToManyRelations rels = rels ++ addMirrorRelation (mapMaybe link2Relation
       | otherwise = Nothing
     link2Relation _ = Nothing
 
-raiseRelations :: Schema -> [(Column,Column)] -> [Relation] -> [Relation]
-raiseRelations schema syns = map raiseRel
-  where
-    raiseRel rel
-      | tableSchema table == schema = rel
-      | isJust newCols = rel{relFTable=fromJust newTable,relFColumns=fromJust newCols}
-      | otherwise = rel
-      where
-        cols = relFColumns rel
-        table = relFTable rel
-        newCols = listToMaybe $ filter ((== schema) . tableSchema . colTable . unsafeHead) (synonymousColumns syns cols)
-        newTable = (colTable . unsafeHead) <$> newCols
-
-synonymousPrimaryKeys :: [(Column,Column)] -> [PrimaryKey] -> [PrimaryKey]
-synonymousPrimaryKeys _ [] = []
-synonymousPrimaryKeys syns (key:keys) = key : newKeys ++ synonymousPrimaryKeys syns keys
-  where
-    keySyns = filter ((\c -> colTable c == pkTable key && colName c == pkName key) . fst) syns
-    newKeys = map ((\c -> PrimaryKey{pkTable=colTable c,pkName=colName c}) . snd) keySyns
+addViewPrimaryKeys :: [Synonym] -> [PrimaryKey] -> [PrimaryKey]
+addViewPrimaryKeys syns = concatMap (\pk ->
+  let viewPks = (\(_, viewCol) -> PrimaryKey{pkTable=colTable viewCol, pkName=colName viewCol}) <$>
+                filter (\(col, _) -> colTable col == pkTable pk && colName col == pkName pk) syns in
+  pk : viewPks)
 
 allTables :: H.Query () [Table]
 allTables =
@@ -269,6 +332,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
@@ -278,20 +342,21 @@ allTables =
           AND (pg_trigger.tgtype::integer & 69) = 69) ) AS insertable
     FROM pg_class c
     JOIN pg_namespace n ON n.oid = c.relnamespace
-    WHERE c.relkind IN ('v','r','m')
+    WHERE c.relkind IN ('v','r','m','f')
       AND n.nspname NOT IN ('pg_catalog', 'information_schema')
     GROUP BY table_schema, table_name, insertable
     ORDER BY table_schema, table_name |]
 
-allColumns :: [Table] -> H.Query () [Column]
+allColumns :: [Table] -> H.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,
@@ -302,13 +367,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', 'm')
+               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
@@ -381,6 +473,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
@@ -390,13 +484,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", 'm'::"char"]))
+                AND (nc.nspname = $1 OR kc.r_oid IS NOT NULL) /*--filter only columns that are FK/PK or in the api schema */
               /*--AND (pg_has_role(c.relowner, 'USAGE'::text) OR has_column_privilege(c.oid, a.attnum, 'SELECT, INSERT, UPDATE, REFERENCES'::text))*/
         )
         SELECT
             table_schema,
             table_name,
             column_name,
+            description,
             ordinal_position,
             is_nullable,
             data_type,
@@ -422,20 +522,20 @@ 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
 
-allRelations :: [Table] -> [Column] -> H.Query () [Relation]
-allRelations tabs cols =
+allChildRelations :: [Table] -> [Column] -> H.Query () [Relation]
+allChildRelations tabs cols =
   H.statement sql HE.unit (decodeRelations tabs cols) True
  where
   sql = [q|
@@ -585,84 +685,78 @@ pkFromRow :: [Table] -> (Schema, Text, Text) -> Maybe PrimaryKey
 pkFromRow tabs (s, t, n) = PrimaryKey <$> table <*> pure n
   where table = find (\tbl -> tableSchema tbl == s && tableName tbl == t) tabs
 
-allSynonyms :: [Column] -> H.Query () [(Column,Column)]
+allSynonyms :: [Column] -> H.Query Schema [Synonym]
 allSynonyms cols =
-  H.statement sql HE.unit (decodeSynonyms cols) True
- where
-  -- query explanation at https://gist.github.com/ruslantalpa/2eab8c930a65e8043d8f
-  sql = [q|
-    with view_columns as (
-        select
-            c.oid as view_oid,
-            a.attname::information_schema.sql_identifier as column_name
-        from pg_attribute a
-        join pg_class c on a.attrelid = c.oid
-        join pg_namespace nc on c.relnamespace = nc.oid
-        where
-            not pg_is_other_temp_schema(nc.oid)
-            and a.attnum > 0
-            and not a.attisdropped
-            and (c.relkind = 'v'::"char")
-            and nc.nspname not in ('information_schema', 'pg_catalog')
+  H.statement sql (HE.value HE.text) (decodeSynonyms cols) True
+  -- query explanation at https://gist.github.com/steve-chavez/7ee0e6590cddafb532e5f00c46275569
+  where sql = [q|
+    with
+    views as (
+      select
+        n.nspname   as view_schema,
+        c.relname   as view_name,
+        r.ev_action as view_definition
+      from pg_class c
+      join pg_namespace n on n.oid = c.relnamespace
+      join pg_rewrite r on r.ev_class = c.oid
+      where (c.relkind = 'v'::char) and n.nspname = $1
     ),
-    view_column_usage as (
-        select distinct
-            v.oid as view_oid,
-            nv.nspname::information_schema.sql_identifier as view_schema,
-            v.relname::information_schema.sql_identifier as view_name,
-            nt.nspname::information_schema.sql_identifier as table_schema,
-            t.relname::information_schema.sql_identifier as table_name,
-            a.attname::information_schema.sql_identifier as column_name,
-            pg_get_viewdef(v.oid)::information_schema.character_data as view_definition
-        from pg_namespace nv
-        join pg_class v on nv.oid = v.relnamespace
-        join pg_depend dv on v.oid = dv.refobjid
-        join pg_depend dt on dv.objid = dt.objid
-        join pg_class t on dt.refobjid = t.oid
-        join pg_namespace nt on t.relnamespace = nt.oid
-        join pg_attribute a on t.oid = a.attrelid and dt.refobjsubid = a.attnum
-
-        where
-            nv.nspname not in ('information_schema', 'pg_catalog')
-            and v.relkind = 'v'::"char"
-            and dv.refclassid = 'pg_class'::regclass::oid
-            and dv.classid = 'pg_rewrite'::regclass::oid
-            and dv.deptype = 'i'::"char"
-            and dv.refobjid <> dt.refobjid
-            and dt.classid = 'pg_rewrite'::regclass::oid
-            and dt.refclassid = 'pg_class'::regclass::oid
-            and (t.relkind = any (array['r'::"char", 'v'::"char", 'f'::"char"]))
+    removed_subselects as(
+      select
+        view_schema, view_name,
+        regexp_replace(view_definition, ':subselect {.*?:constraintDeps <>} :location', '', 'g') as x
+      from views
     ),
-    candidates as (
-        select
-            vcu.*,
-            (
-                select case when match is not null then coalesce(match[8], match[7], match[4]) end
-                from regexp_matches(
-                    CONCAT('SELECT ', SPLIT_PART(vcu.view_definition, 'SELECT', 2)),
-                    CONCAT('SELECT.*?((',vcu.table_name,')|(\w+))\.(', vcu.column_name, ')(\s+AS\s+("([^"]+)"|([^, \n\t]+)))?.*?FROM.*?(',vcu.table_schema,'\.|)(\2|',vcu.table_name,'\s+(as\s)?\3)'),
-                    'nsi'
-                ) match
-            ) as view_column_name
-        from view_column_usage as vcu
+    target_lists as(
+      select
+        view_schema, view_name,
+        regexp_split_to_array(x, 'targetList') as x
+      from removed_subselects
+    ),
+    last_target_list_wo_tail as(
+      select
+        view_schema, view_name,
+        (regexp_split_to_array(x[array_upper(x, 1)], ':onConflict'))[1] as x
+      from target_lists
+    ),
+    target_entries as(
+      select
+        view_schema, view_name,
+        unnest(regexp_split_to_array(x, 'TARGETENTRY')) as entry
+      from last_target_list_wo_tail
+    ),
+    results as(
+      select
+        view_schema, view_name,
+        substring(entry from ':resname (.*?) :') as view_colum_name,
+        substring(entry from ':resorigtbl (.*?) :') as resorigtbl,
+        substring(entry from ':resorigcol (.*?) :') as resorigcol
+      from target_entries
     )
     select
-        c.table_schema,
-        c.table_name,
-        c.column_name as table_column_name,
-        c.view_schema,
-        c.view_name,
-        c.view_column_name
-    from view_columns as vc, candidates as c
-    where
-        vc.view_oid = c.view_oid
-        and vc.column_name = c.view_column_name
-    order by c.view_schema, c.view_name, c.table_name, c.view_column_name
+      sch.nspname as table_schema,
+      tbl.relname as table_name,
+      col.attname as table_column_name,
+      res.view_schema,
+      res.view_name,
+      res.view_colum_name
+    from results res
+    join pg_class tbl on tbl.oid::text = res.resorigtbl
+    join pg_attribute col on col.attrelid = tbl.oid and col.attnum::text = res.resorigcol
+    join pg_namespace sch on sch.oid = tbl.relnamespace
+    where resorigtbl <> '0'
+    order by view_schema, view_name, view_colum_name;
     |]
 
-synonymFromRow :: [Column] -> (Text,Text,Text,Text,Text,Text) -> Maybe (Column,Column)
+synonymFromRow :: [Column] -> (Text,Text,Text,Text,Text,Text) -> Maybe Synonym
 synonymFromRow allCols (s1,t1,c1,s2,t2,c2) = (,) <$> col1 <*> col2
   where
     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

@@ -10,6 +10,7 @@ module PostgREST.Error (
 , binaryFieldError
 , connectionLostError
 , encodeError
+, gucHeadersError
 ) where
 
 import           Protolude
@@ -18,12 +19,16 @@ import qualified Data.Aeson                as JSON
 import           Data.Text                 (unwords)
 import qualified Hasql.Pool                as P
 import qualified Hasql.Session             as H
+import           Network.HTTP.Types.Header
 import qualified Network.HTTP.Types.Status as HT
 import           Network.Wai               (Response, responseLBS)
 import           PostgREST.Types
+import           Text.Read                 (readMaybe)
 
 apiRequestError :: ApiRequestError -> Response
-apiRequestError err = errorResponse status err
+apiRequestError err =
+  errorResponse status
+    [toHeader CTApplicationJSON] err
   where
     status =
       case err of
@@ -34,14 +39,16 @@ apiRequestError err = errorResponse status err
         NoRelationBetween _ _ -> HT.status400
         InvalidRange -> HT.status416
         UnknownRelation -> HT.status404
+        InvalidFilters -> HT.status405
 
-simpleError :: HT.Status -> Text -> Response
-simpleError status message =
-  errorResponse status $ JSON.object ["message" .= message]
+simpleError :: HT.Status -> [Header] -> Text -> Response
+simpleError status hdrs message =
+  errorResponse status (toHeader CTApplicationJSON : hdrs) $
+    JSON.object ["message" .= message]
 
-errorResponse :: JSON.ToJSON a => HT.Status -> a -> Response
-errorResponse status e =
-  responseLBS status [toHeader CTApplicationJSON] $ encodeError e
+errorResponse :: JSON.ToJSON a => HT.Status -> [Header] -> a -> Response
+errorResponse status hdrs e =
+  responseLBS status hdrs $ encodeError e
 
 pgError :: Bool -> P.UsageError -> Response
 pgError authed e =
@@ -71,12 +78,17 @@ singularityError numRows =
 
 binaryFieldError :: Response
 binaryFieldError =
-  simpleError HT.status406 (toS (toMime CTOctetStream) <>
+  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."
+  simpleError HT.status503 [] "Database connection lost, retrying the connection."
 
 encodeError :: JSON.ToJSON a => a -> LByteString
 encodeError = JSON.encode
@@ -96,6 +108,8 @@ instance JSON.ToJSON ApiRequestError where
     "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)]
+  toJSON InvalidFilters = JSON.object [
+    "message" .= ("Filters must include all and only primary key columns with 'eq' operators" :: Text)]
 
 instance JSON.ToJSON P.UsageError where
   toJSON (P.ConnectionError e) = JSON.object [
@@ -105,11 +119,17 @@ instance JSON.ToJSON P.UsageError where
   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 [
@@ -134,7 +154,7 @@ instance JSON.ToJSON H.Error where
 
 httpStatus :: Bool -> P.UsageError -> HT.Status
 httpStatus _ (P.ConnectionError _) = HT.status503
-httpStatus authed (P.SessionError (H.ResultError (H.ServerError c _ _ _))) =
+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
@@ -162,6 +182,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

@@ -4,13 +4,13 @@
 
 module PostgREST.Middleware where
 
-import           Data.Aeson                    (Value (..))
+import           Crypto.JWT
+import qualified Data.Aeson                    as JSON
 import qualified Data.HashMap.Strict           as M
 import qualified Hasql.Transaction             as H
 
 import           Network.HTTP.Types.Status     (unauthorized401, status500)
-import           Network.Wai                   (Application, Response,
-                                                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)
@@ -19,8 +19,7 @@ import           PostgREST.ApiRequest          (ApiRequest(..))
 import           PostgREST.Auth                (JWTAttempt(..))
 import           PostgREST.Config              (AppConfig (..), corsPolicy)
 import           PostgREST.Error               (simpleError)
-import           PostgREST.Types               (ContentType (..), toHeader)
-import           PostgREST.QueryBuilder        (pgFmtLit, unquoted, pgFmtEnvVar)
+import           PostgREST.QueryBuilder        (pgFmtLit, unquoted, pgFmtSetLocal)
 
 import           Protolude                     hiding (concat, null)
 
@@ -29,32 +28,33 @@ 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 $ simpleError 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
-      H.sql $ toS.mconcat $ setRoleSql ++ claimsSql ++ headersSql ++ cookiesSql
+      H.sql $ toS.mconcat $ setSchemaSql ++ setRoleSql ++ claimsSql ++ headersSql ++ cookiesSql ++ appSettingsSql
       mapM_ H.sql customReqCheck
       app req
       where
-        headersSql = map (pgFmtEnvVar "request.header.") $ iHeaders req
-        cookiesSql = map (pgFmtEnvVar "request.cookie.") $ iCookies req
-        claimsSql = map (pgFmtEnvVar "request.jwt.claim.") [(c,unquoted v) | (c,v) <- M.toList claimsWithRole]
+        headersSql = pgFmtSetLocal "request.header." <$> iHeaders req
+        cookiesSql = pgFmtSetLocal "request.cookie." <$> iCookies req
+        claimsSql = pgFmtSetLocal "request.jwt.claim." <$> [(c,unquoted v) | (c,v) <- M.toList claimsWithRole]
+        appSettingsSql = pgFmtSetLocal mempty <$> configSettings conf
         setRoleSql = maybeToList $
           (\r -> "set local role " <> r <> ";") . toS . pgFmtLit . unquoted <$> M.lookup "role" claimsWithRole
+        setSchemaSql = ["set schema " <> pgFmtLit (configSchema conf) <> ";"] :: [Text]
         -- role claim defaults to anon if not specified in jwt
         claimsWithRole = M.union claims (M.singleton "role" anon)
-        anon = String . toS $ configAnonRole conf
+        anon = JSON.String . toS $ configAnonRole conf
         customReqCheck = (\f -> "select " <> toS f <> "();") <$> configReqCheck conf
   where
-    unauthed message = 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 qualified Data.HashMap.Strict         as M
 import           Data.HashMap.Strict.InsOrd  (InsOrdHashMap, fromList)
 import           Data.Maybe                  (fromJust)
 import qualified Data.Set                    as Set
 import           Data.String                 (IsString (..))
-import           Data.Text                   (unpack, pack, concat, intercalate, init, tail, toLower)
+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(..))
-import           PostgREST.Config            (prettyVersion)
-import           PostgREST.Types             (Table(..), Column(..), PgArg(..),
-                                              Proxy(..), ProcDescription(..), toMime, operators)
+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,49 @@ 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)
+        & required .~ map colName (filter (not . colNullable) 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 +87,6 @@ makeProcProperty (PgArg n t _) = (n, Inline s)
           & type_ .~ toSwaggerType t
           & format ?~ t
 
-makeOperatorPattern :: Text
-makeOperatorPattern =
-  intercalate "|"
-  [ concat ["^", x, y, "[.]"] |
-    x <- ["not[.]", ""],
-    y <- M.keys 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 +98,139 @@ 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 ?~ Inline (mempty
+          & type_ .~ SwaggerArray
+          & items ?~ (SwaggerItemsObject $ 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
+    -- Use first line of proc description as summary; rest as description (if present)
+    -- We strip leading newlines from description so that users can include a blank line between summary and description
+    (pSum, pDesc) = fmap fst &&& fmap (dropWhile (=='\n') . snd) $
+                    breakOn "\n" <$> pdDescription pd
     postOp = (mempty :: Operation)
-      & parameters .~ map Inline (makeProcParam $ "(rpc) " <> pdName pd)
+      & summary .~ pSum
+      & description .~ mfilter (/="") pDesc
+      & parameters .~ makeProcParam pd
       & tags .~ Set.fromList ["(rpc) " <> pdName pd]
       & produces ?~ makeMimeList [CTApplicationJSON, CTSingularJSON]
       & at 200 ?~ "OK"
@@ -236,7 +240,8 @@ makeRootPathItem :: (FilePath, PathItem)
 makeRootPathItem = ("/", p)
   where
     getOp = (mempty :: Operation)
-      & tags .~ Set.fromList ["/"]
+      & tags .~ Set.fromList ["Introspection"]
+      & summary ?~ "OpenAPI description (this document)"
       & produces ?~ makeMimeList [CTOpenAPI, CTApplicationJSON]
       & at 200 ?~ "OK"
     pr = (mempty :: PathItem) & get ?~ getOp
@@ -254,23 +259,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.org/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,6 +1,6 @@
 module PostgREST.Parsers where
 
-import           Protolude                     hiding (try, intercalate)
+import           Protolude                     hiding (try, intercalate, replace, option)
 import           Control.Monad                 ((>>))
 import           Data.Foldable                 (foldl1)
 import qualified Data.HashMap.Strict           as M
@@ -8,20 +8,21 @@ import           Data.Text                     (intercalate, replace, strip)
 import           Data.List                     (init, last)
 import           Data.Tree
 import           Data.Either.Combinators       (mapLeft)
-import           PostgREST.RangeQuery          (NonnegRange,allRange)
+import           PostgREST.RangeQuery          (NonnegRange)
 import           PostgREST.Types
 import           Text.ParserCombinators.Parsec hiding (many, (<|>))
 import           Text.Parsec.Error
+import           Text.Read                     (read)
 
-pRequestSelect :: Text -> Text -> Either ApiRequestError ReadRequest
-pRequestSelect rootName selStr =
-  mapError $ parse (pReadRequest rootName) ("failed to parse select parameter (" <> toS selStr <> ")") (toS selStr)
+pRequestSelect :: Text -> Either ApiRequestError [Tree SelectItem]
+pRequestSelect selStr =
+  mapError $ parse pFieldForest ("failed to parse select parameter (" <> toS selStr <> ")") (toS selStr)
 
 pRequestFilter :: (Text, Text) -> Either ApiRequestError (EmbedPath, Filter)
 pRequestFilter (k, v) = mapError $ (,) <$> path <*> (Filter <$> fld <*> oper)
   where
     treePath = parse pTreePath ("failed to parser tree path (" ++ toS k ++ ")") $ toS k
-    oper = parse (pOperation pVText pVTextL) ("failed to parse filter (" ++ toS v ++ ")") $ toS v
+    oper = parse (pOpExpr pSingleVal) ("failed to parse filter (" ++ toS v ++ ")") $ toS v
     path = fst <$> treePath
     fld = snd <$> treePath
 
@@ -44,7 +45,7 @@ pRequestLogicTree (k, v) = mapError $ (,) <$> embedPath <*> logicTree
     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 "op(.,.)"
+    -- 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)
 
 ws :: Parser Text
@@ -53,39 +54,22 @@ ws = toS <$> many (oneOf " \t")
 lexeme :: Parser a -> Parser a
 lexeme p = ws *> p <* ws
 
-pReadRequest :: Text -> Parser ReadRequest
-pReadRequest rootNodeName = do
-  fieldTree <- pFieldForest
-  return $ foldr treeEntry (Node (readQuery, (rootNodeName, Nothing, Nothing)) []) fieldTree
-  where
-    readQuery = Select [] [rootNodeName] [] [] Nothing allRange
-    treeEntry :: Tree SelectItem -> ReadRequest -> ReadRequest
-    treeEntry (Node fld@((fn, _),_,alias) 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
-
 pTreePath :: Parser (EmbedPath, Field)
 pTreePath = do
   p <- pFieldName `sepBy1` pDelimiter
-  jp <- optionMaybe pJsonPath
+  jp <- option [] pJsonPath
   return (init p, (last p, jp))
 
 pFieldForest :: Parser [Tree SelectItem]
 pFieldForest = pFieldTree `sepBy1` lexeme (char ',')
-
-pFieldTree :: Parser (Tree SelectItem)
-pFieldTree =  try (Node <$> pSimpleSelect <*> between (char '{') (char '}') pFieldForest)
-          <|> try (Node <$> pSimpleSelect <*> between (char '(') (char ')') pFieldForest)
-          <|> Node <$> pSelect <*> pure []
+  where
+    pFieldTree :: Parser (Tree SelectItem)
+    pFieldTree =  try (Node <$> pRelationSelect <*> between (char '(') (char ')') pFieldForest) <|>
+                  Node <$> pFieldSelect <*> pure []
 
 pStar :: Parser Text
 pStar = toS <$> (string "*" *> pure ("*"::ByteString))
 
-
 pFieldName :: Parser Text
 pFieldName = do
   matches <- (many1 (letter <|> digit <|> oneOf "_") `sepBy1` dash) <?> "field name (* or [a..z0..9_])"
@@ -96,59 +80,78 @@ pFieldName = do
     dash :: Parser Char
     dash = isDash *> pure '-'
 
+pJsonPath :: Parser JsonPath
+pJsonPath = many pJsonOperation
+  where
+    pJsonOperation :: Parser JsonOperation
+    pJsonOperation = pJsonArrow <*> pJsonOperand
 
-pJsonPathStep :: Parser Text
-pJsonPathStep = toS <$> try (string "->" *> pFieldName)
+    pJsonArrow   =
+      try (string "->>" $> J2Arrow) <|>
+      try (string "->" $> JArrow)
 
-pJsonPath :: Parser [Text]
-pJsonPath = (<>) <$> many pJsonPathStep <*> ( (:[]) <$> (string "->>" *> pFieldName) )
+    pJsonOperand =
+      let pJKey = JKey . toS <$> pFieldName
+          pJIdx = JIdx . toS <$> ((:) <$> option '+' (char '-') <*> many1 digit) <* pEnd
+          pEnd = try (void $ lookAhead (string "->")) <|>
+                 try (void $ lookAhead (string "::")) <|>
+                 try eof in
+      try pJIdx <|> try pJKey
 
 pField :: Parser Field
-pField = lexeme $ (,) <$> pFieldName <*> optionMaybe pJsonPath
+pField = lexeme $ (,) <$> pFieldName <*> option [] pJsonPath
 
 aliasSeparator :: Parser ()
 aliasSeparator = char ':' >> notFollowedBy (char ':')
 
-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)
 
-pOperation :: Parser Operand -> Parser Operand -> Parser Operation
-pOperation parserVText parserVTextL = try ( string "not" *> pDelimiter *> (Operation True <$> pExpr)) <|> Operation False <$> pExpr
+pOpExpr :: Parser SingleVal -> Parser OpExpr
+pOpExpr pSVal = try ( string "not" *> pDelimiter *> (OpExpr True <$> pOperation)) <|> OpExpr False <$> pOperation
   where
-    pExpr :: Parser (Operator, Operand)
-    pExpr =
-          ((,) <$> (toS <$> foldl1 (<|>) (try . ((<* pDelimiter) . string) . toS <$> M.keys notInOps)) <*> parserVText)
-      <|> ((,) <$> (toS <$> foldl1 (<|>) (try . ((<* pDelimiter) . string) . toS <$> M.keys inOps)) <*> parserVTextL)
+    pOperation :: Parser Operation
+    pOperation =
+          Op . toS <$> foldl1 (<|>) (try . ((<* pDelimiter) . string) . toS <$> M.keys ops) <*> pSVal
+      <|> In <$> (try (string "in" *> pDelimiter) *> pListVal)
+      <|> pFts
       <?> "operator (eq, gt, ...)"
-    inOps = M.filterWithKey (const . flip elem ["in", "notin"]) operators
-    notInOps = M.difference operators inOps
 
-pVText :: Parser Operand
-pVText = 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
 
-pVTextL :: Parser Operand
-pVTextL =     VTextL <$> try (lexeme (char '(') *> pVTextLElement `sepBy1` char ',' <* lexeme (char ')'))
-          <|> VTextL <$> lexeme pVTextLElement `sepBy1` char ','
+    ops = M.filterWithKey (const . flip notElem ("in":ftsOps)) operators
+    ftsOps = M.keys ftsOperators
 
-pVTextLElement :: Parser Text
-pVTextLElement = try pQuotedValue <|> (toS <$> many (noneOf ",)"))
+pSingleVal :: Parser SingleVal
+pSingleVal = toS <$> many anyChar
+
+pListVal :: Parser ListVal
+pListVal = lexeme (char '(') *> pListElement `sepBy1` char ',' <* lexeme (char ')')
+
+pListElement :: Parser Text
+pListElement = try pQuotedValue <|> (toS <$> many (noneOf ",)"))
 
 pQuotedValue :: Parser Text
 pQuotedValue = toS <$> (char '"' *> many (noneOf "\"") <* char '"' <* notFollowedBy (noneOf ",)"))
@@ -157,32 +160,31 @@ pDelimiter :: Parser Char
 pDelimiter = char '.' <?> "delimiter (.)"
 
 pOrder :: Parser [OrderTerm]
-pOrder = lexeme pOrderTerm `sepBy` char ','
+pOrder = lexeme pOrderTerm `sepBy1` char ','
 
 pOrderTerm :: Parser OrderTerm
-pOrderTerm =
-  try ( do
-    c <- pField
-    d <- optionMaybe (try $ pDelimiter *> (
-               try(string "asc" *> pure OrderAsc)
-           <|> try(string "desc" *> pure OrderDesc)
-         ))
-    nls <- optionMaybe (pDelimiter *> (
-                 try(string "nullslast" *> pure OrderNullsLast)
-             <|> try(string "nullsfirst" *> pure OrderNullsFirst)
-           ))
-    return $ OrderTerm c d nls
-  )
-  <|> OrderTerm <$> pField <*> pure Nothing <*> pure Nothing
+pOrderTerm = do
+  fld <- pField
+  dir <- optionMaybe $
+         try (pDelimiter *> string "asc" $> OrderAsc) <|>
+         try (pDelimiter *> string "desc" $> OrderDesc)
+  nls <- optionMaybe pNulls <* pEnd <|>
+         pEnd $> Nothing
+  return $ OrderTerm fld dir nls
+  where
+    pNulls = try (pDelimiter *> string "nullsfirst" $> OrderNullsFirst) <|>
+             try (pDelimiter *> string "nullslast"  $> OrderNullsLast)
+    pEnd = try (void $ lookAhead (char ',')) <|>
+           try eof
 
 pLogicTree :: Parser LogicTree
 pLogicTree = Stmnt <$> try pLogicFilter
-             <|> Expr <$> pNot <*> pLogicOp <*> (lexeme (char '(') *> pLogicTree) <*> (lexeme (char ',') *> pLogicTree <* lexeme (char ')'))
+             <|> Expr <$> pNot <*> pLogicOp <*> (lexeme (char '(') *> pLogicTree `sepBy1` lexeme (char ',') <* lexeme (char ')'))
   where
     pLogicFilter :: Parser Filter
-    pLogicFilter = Filter <$> pField <* pDelimiter <*> pOperation pLogicVText pLogicVTextL
+    pLogicFilter = Filter <$> pField <* pDelimiter <*> pOpExpr pLogicSingleVal
     pNot :: Parser Bool
-    pNot = try (string "not" *> pDelimiter *> pure True) 
+    pNot = try (string "not" *> pDelimiter *> pure True)
            <|> pure False
            <?> "negation operator (not)"
     pLogicOp :: Parser LogicOperator
@@ -190,8 +192,8 @@ pLogicTree = Stmnt <$> try pLogicFilter
                <|> string "or" *> pure Or
                <?> "logic operator (and, or)"
 
-pLogicVText :: Parser Operand
-pLogicVText = VText <$> (try pQuotedValue <|> try pPgArray <|> (toS <$> many (noneOf ",)")))
+pLogicSingleVal :: Parser SingleVal
+pLogicSingleVal = try pQuotedValue <|> try pPgArray <|> (toS <$> many (noneOf ",)"))
   where
     pPgArray :: Parser Text
     pPgArray =  do
@@ -200,9 +202,6 @@ pLogicVText = VText <$> (try pQuotedValue <|> try pPgArray <|> (toS <$> many (no
       c <- string "}"
       toS <$> pure (a ++ b ++ c)
 
-pLogicVTextL :: Parser Operand
-pLogicVTextL = VTextL <$> (lexeme (char '(') *> pVTextLElement `sepBy1` char ',' <* lexeme (char ')'))
-
 pLogicPath :: Parser (EmbedPath, Text)
 pLogicPath = do
   path <- pFieldName `sepBy1` pDelimiter
@@ -219,3 +218,25 @@ mapError = mapLeft translateError
         message = show $ errorPos e
         details = strip $ replace "\n" " " $ toS
            $ showErrorMessages "or" "unknown parse error" "expecting" "unexpected" "end of input" (errorMessages e)
+
+-- Used for the config value "role-claim-key"
+pRoleClaimKey :: Text -> Either ApiRequestError JSPath
+pRoleClaimKey selStr =
+  mapError $ parse pJSPath ("failed to parse role-claim-key value (" <> toS selStr <> ")") (toS selStr)
+
+pJSPath :: Parser JSPath
+pJSPath = toJSPath <$> (period *> pPath `sepBy` period <* eof)
+  where
+    toJSPath :: [(Text, Maybe Int)] -> JSPath
+    toJSPath = concatMap (\(key, idx) -> JSPKey key : maybeToList (JSPIdx <$> idx))
+    period = char '.' <?> "period (.)"
+    pPath :: Parser (Text, Maybe Int)
+    pPath = (,) <$> pJSPKey <*> optionMaybe pJSPIdx
+
+pJSPKey :: Parser Text
+pJSPKey = toS <$> (many1 (alphaNum <|> oneOf "_$@") <|> pQuoted) <?> "attribute name [a..z0..9_$@])"
+  where
+    pQuoted = char '"' *> many (noneOf "\"") <* char '"'
+
+pJSPIdx :: Parser Int
+pJSPIdx = char '[' *> (read <$> many1 digit) <* char ']' <?> "array index [0..n]"

src/PostgREST/QueryBuilder.hs

@@ -1,6 +1,8 @@
-{-# LANGUAGE FlexibleInstances    #-}
-{-# LANGUAGE TupleSections        #-}
-{-# OPTIONS_GHC -fno-warn-orphans #-}
+{-# LANGUAGE FlexibleInstances     #-}
+{-# LANGUAGE FlexibleContexts      #-}
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE LambdaCase            #-}
+{-# OPTIONS_GHC -fno-warn-orphans  #-}
 {-|
 Module      : PostgREST.QueryBuilder
 Description : PostgREST SQL generating functions.
@@ -15,15 +17,13 @@ module PostgREST.QueryBuilder (
     callProc
   , createReadStatement
   , createWriteStatement
-  , getJoinConditions
   , pgFmtIdent
   , pgFmtLit
   , requestToQuery
   , requestToCountQuery
-  , sourceCTEName
   , unquoted
   , ResultsWithCount
-  , pgFmtEnvVar
+  , pgFmtSetLocal
   ) where
 
 import qualified Hasql.Query             as H
@@ -32,15 +32,15 @@ import qualified Hasql.Decoders          as HD
 
 import qualified Data.Aeson              as JSON
 
-import           PostgREST.RangeQuery    (NonnegRange, rangeLimit, rangeOffset, allRange)
-import           Data.Functor.Contravariant (contramap)
+import           PostgREST.Config        (pgVersion96)
+import           PostgREST.RangeQuery    (rangeLimit, rangeOffset, allRange)
 import qualified Data.HashMap.Strict     as HM
 import           Data.Maybe
+import qualified Data.Set                as S
 import           Data.Text               (intercalate, unwords, replace, isInfixOf, toLower)
 import qualified Data.Text as T          (map, takeWhile, null)
 import qualified Data.Text.Encoding as T
 import           Data.Tree               (Tree(..))
-import qualified Data.Vector as V
 import           PostgREST.Types
 import           Text.InterpolatedString.Perl6 (qc)
 import qualified Data.ByteString.Char8   as BS
@@ -48,7 +48,7 @@ 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
@@ -78,14 +78,6 @@ decodeStandardMay :: HD.Result (Maybe ResultsWithCount)
 decodeStandardMay =
   HD.maybeRow standardRow
 
-{-| JSON and CSV payloads from the client are given to us as
-    PayloadJSON (objects who all have the same keys),
-    and we turn this into an old fasioned JSON array
--}
-encodeUniformObjs :: HE.Params PayloadJSON
-encodeUniformObjs =
-  contramap (JSON.Array . V.map JSON.Object . unPayloadJSON) (HE.value HE.json)
-
 createReadStatement :: SqlQuery -> SqlQuery -> Bool -> Bool -> Bool -> Maybe FieldName ->
                        H.Query () ResultsWithCount
 createReadStatement selectQuery countQuery isSingle countTotal asCsv binaryField =
@@ -107,11 +99,12 @@ createReadStatement selectQuery countQuery isSingle countTotal asCsv binaryField
     | isJust binaryField = asBinaryF $ fromJust binaryField
     | otherwise = asJsonF
 
+
 createWriteStatement :: SqlQuery -> SqlQuery -> Bool -> Bool -> Bool ->
                         PreferRepresentation -> [Text] ->
-                        H.Query PayloadJSON (Maybe ResultsWithCount)
+                        H.Query ByteString (Maybe ResultsWithCount)
 createWriteStatement selectQuery mutateQuery wantSingle wantHdrs asCsv rep pKeys =
-  unicodeStatement sql encodeUniformObjs decodeStandardMay True
+  unicodeStatement sql (HE.value HE.unknown) decodeStandardMay True
 
  where
   sql = case rep of
@@ -131,7 +124,7 @@ createWriteStatement selectQuery mutateQuery wantSingle wantHdrs asCsv rep pKeys
       "'' AS total_result_set", -- when updateing it does not make sense
       "pg_catalog.count(_postgrest_t) AS page_total",
       if wantHdrs
-         then locationF pKeys
+         then "coalesce(" <> locationF pKeys <> ", " <> noLocationF <> ")"
          else noLocationF <> " AS header",
       if rep == Full
          then bodyF <> " AS body"
@@ -143,43 +136,63 @@ 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 -> Bool -> H.Query () (Maybe ProcResults)
-callProc qi params selectQuery countQuery _ countTotal isSingle paramsAsJson asCsv =
-  unicodeStatement sql HE.unit decodeProc True
+type ProcResults = (Maybe Int64, Int64, ByteString, ByteString)
+callProc :: QualifiedIdentifier -> [PgArg] -> Bool -> SqlQuery -> SqlQuery -> Bool ->
+            Bool -> Bool -> Bool -> Bool -> Maybe FieldName -> Bool -> PgVersion ->
+            H.Query ByteString (Maybe ProcResults)
+callProc qi pgArgs returnsScalar selectQuery countQuery countTotal isSingle paramsAsSingleObject asCsv asBinary binaryField isObject pgVer =
+  unicodeStatement sql (HE.value HE.unknown) decodeProc True
   where
-    sql = [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 {argsRecord},
+       {sourceCTEName} AS (
+         SELECT {fromQi qi}({args})
+       )
+       SELECT
+         {countResultF} AS total_result_set,
+         1 AS page_total,
+         {scalarBodyF} AS body,
+         {responseHeaders} AS response_headers
+       FROM ({selectQuery}) _postgrest_t;|]
+     else [qc|
+       WITH {argsRecord},
+       {sourceCTEName} AS (
+         SELECT * FROM {fromQi qi}({args})
+       )
+       SELECT
+         {countResultF} AS total_result_set,
+         pg_catalog.count(_postgrest_t) AS page_total,
+         {bodyF} AS body,
+         {responseHeaders} AS response_headers
+       FROM ({selectQuery}) _postgrest_t;|]
 
-              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
-                then insertableValueWithType "json" $ JSON.Object params
-                else intercalate "," $ map _assignment (HM.toList params)
-    _procName = pgFmtLit $ 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
+    (argsRecord, args) | paramsAsSingleObject = ("_args_record AS (SELECT NULL)", "$1::json")
+                       | null pgArgs = (ignoredBody, "")
+                       | otherwise = (
+                           unwords [
+                           "_args_record AS (",
+                             "SELECT * FROM " <> (if isObject then "json_to_record" else "json_to_recordset") <> "($1)",
+                             "AS _(" <> intercalate ", " ((\a -> pgFmtIdent (pgaName a) <> " " <> pgaType a) <$> pgArgs) <> ")",
+                           ")"]
+                         , intercalate ", " ((\a -> pgFmtIdent (pgaName a) <> " := (SELECT " <> pgFmtIdent (pgaName a) <> " FROM _args_record)") <$> pgArgs))
+    countResultF = if countTotal then "( "<> countQuery <> ")" else "null::bigint" :: Text
+    _procName = qiName qi
+    responseHeaders =
+      if pgVer >= pgVersion96
+        then "coalesce(nullif(current_setting('response.headers', true), ''), '[]')" :: Text -- nullif is used because of https://gist.github.com/steve-chavez/8d7033ea5655096903f3b52f8ed09a15
+        else "'[]'" :: Text
     decodeProc = HD.maybeRow procRow
-    procRow = (,,) <$> HD.nullableValue HD.int8 <*> HD.value HD.int8
-                   <*> HD.value HD.bytea
+    procRow = (,,,) <$> HD.nullableValue HD.int8 <*> HD.value HD.int8
+                    <*> HD.value HD.bytea <*> HD.value HD.bytea
+    scalarBodyF
+     | asBinary = asBinaryF _procName
+     | otherwise = "(row_to_json(_postgrest_t)->" <> pgFmtLit _procName <> ")::character varying"
+
     bodyF
      | isSingle = asJsonSingleF
      | asCsv = asCsvF
+     | isJust binaryField = asBinaryF $ fromJust binaryField
      | otherwise = asJsonF
 
 pgFmtIdent :: SqlFragment -> SqlFragment
@@ -195,125 +208,130 @@ pgFmtLit x =
    else slashed
 
 requestToCountQuery :: Schema -> DbRequest -> SqlQuery
-requestToCountQuery _ (DbMutate _) = undefined
-requestToCountQuery schema (DbRead (Node (Select _ _ conditions logic_ _ _, (mainTbl, _, _)) _)) =
+requestToCountQuery _ (DbMutate _) = witness
+requestToCountQuery schema (DbRead (Node (Select{where_=logicForest}, (mainTbl, _, _, _, _)) _)) =
  unwords [
    "SELECT pg_catalog.count(*)",
    "FROM ", fromQi qi,
-    -- logic_ doesn't not need localFilter filtering because it doesn't have VForeignKey vals
-    ("WHERE " <> intercalate " AND " (map (pgFmtFilter qi) localConditions ++ map (pgFmtLogicTree qi) logic_))
-      `emptyOnFalse` (null conditions && null logic_)
+    ("WHERE " <> intercalate " AND " (map (pgFmtLogicTree qi) logicForest)) `emptyOnFalse` null logicForest
    ]
  where
    qi = removeSourceCTESchema schema mainTbl
-   localFilter :: Filter -> Bool
-   localFilter Filter{operation=Operation{expr=(_, val)}} = case val of
-    VText _ -> True
-    VTextL _ -> True
-    VForeignKey _ _ -> False
-   localConditions = filter localFilter conditions
 
 requestToQuery :: Schema -> Bool -> DbRequest -> SqlQuery
-requestToQuery schema isParent (DbRead (Node (Select colSelects tbls conditions logic_ ord range, (nodeName, maybeRelation, _)) forest)) =
-  query
+requestToQuery schema isParent (DbRead (Node (Select colSelects tbls logicForest joinConditions_ ordts range, (nodeName, maybeRelation, _, _, depth)) forest)) =
+  unwords [
+    "SELECT " <> intercalate ", " (map (pgFmtSelectItem qi) colSelects ++ selects),
+    "FROM " <> intercalate ", " tables,
+    unwords joins,
+    ("WHERE " <> intercalate " AND " (map (pgFmtLogicTree qi) logicForest ++ map pgFmtJoinCondition joinConds))
+      `emptyOnFalse` (null logicForest && null joinConds),
+    ("ORDER BY " <> intercalate ", " (map (pgFmtOrderTerm qi) ordts)) `emptyOnFalse` null ordts,
+    ("LIMIT " <> maybe "ALL" show (rangeLimit range) <> " OFFSET " <> show (rangeOffset range)) `emptyOnFalse` (isParent || range == allRange) ]
+
   where
     mainTbl = fromMaybe nodeName (tableName . relTable <$> maybeRelation)
-    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 (pgFmtFilter qi) conditions ++ map (pgFmtLogicTree qi) logic_))
-        `emptyOnFalse` (null conditions && null logic_),
-      orderF (fromMaybe [] ord),
-      if isParent then "" else limitF range
-      ]
-    orderF ts =
-        if null ts
-            then ""
-            else "ORDER BY " <> clause
-        where
-            clause = intercalate "," (map queryTerm ts)
-            queryTerm :: OrderTerm -> Text
-            queryTerm t = " "
-                <> toS (pgFmtField qi $ otTerm t) <> " "
-                <> maybe "" show (otDirection t) <> " "
-                <> maybe "" show (otNullOrder t) <> " "
+    isSelfJoin = maybe False (\r -> relType r /= Root && relTable r == relFTable r) maybeRelation
+    (qi, tables, joinConds) =
+      let depthAlias name dpth = if dpth /= 0  then name <> "_" <> show dpth else name in -- Root node doesn't get aliased
+      if isSelfJoin
+        then (
+          QualifiedIdentifier "" (depthAlias mainTbl depth),
+          (\t -> fromQi (removeSourceCTESchema schema t) <> " AS " <> pgFmtIdent (depthAlias t depth)) <$> tbls,
+          (\(JoinCondition (qi1, _, c1) (qi2, _, c2)) ->
+            JoinCondition (qi1, Just $ depthAlias (qiName qi1) depth, c1)
+                          (qi2, Just $ depthAlias (qiName qi2) (depth - 1), c2)) <$> joinConditions_)
+        else (
+          removeSourceCTESchema schema mainTbl,
+          fromQi . removeSourceCTESchema schema <$> tbls,
+          joinConditions_)
+
     (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 (Operation b (c, VForeignKey (QualifiedIdentifier "" _) d))) = Filter a (Operation b (c, VForeignKey (QualifiedIdentifier "" localTableName) d))
-        replaceTableName _ x = x
-        sel = "row_to_json(" <> pgFmtIdent local_table_name <> ".*) AS " <> pgFmtIdent node_name
-        joi = " LEFT OUTER JOIN ( " <> subquery <> " ) AS " <> pgFmtIdent local_table_name  <>
-              " ON " <> intercalate " AND " ( map (pgFmtFilter qi . replaceTableName local_table_name) (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))
     --the following is just to remove the warning
     --getQueryParts is not total but requestToQuery is called only after addJoinConditions which ensures the only
     --posible relations are Child Parent Many
-    getQueryParts _ _ = undefined
-requestToQuery schema _ (DbMutate (Insert mainTbl (PayloadJSON rows) returnings)) =
-  insInto <> vals <> ret
-  where qi = QualifiedIdentifier schema mainTbl
-        cols = map pgFmtIdent $ fromMaybe [] (HM.keys <$> (rows V.!? 0))
-        colsString = intercalate ", " cols
-        insInto = unwords [ "INSERT INTO" , fromQi qi,
-            if T.null colsString then "" else "(" <> colsString <> ")"
-          ]
-        vals = unwords $
-          if T.null colsString
-            then if V.null rows then ["SELECT null WHERE false"] else ["DEFAULT VALUES"]
-            else ["SELECT", colsString, "FROM json_populate_recordset(null::" , fromQi qi, ", $1)"]
-        ret = if null returnings
-                  then ""
-                  else unwords [" RETURNING ", intercalate ", " (map (pgFmtColumn qi) returnings)]
-requestToQuery schema _ (DbMutate (Update mainTbl (PayloadJSON rows) conditions logic_ returnings)) =
-  case rows V.!? 0 of
-    Just obj ->
-      let assignments = map
-            (\(k,v) -> pgFmtIdent k <> "=" <> insertableValue v) $ HM.toList obj in
+    getQueryParts _ _ = witness
+requestToQuery schema _ (DbMutate (Insert mainTbl pkCols p@(PayloadJSON _ pType pKeys) onConflct logicForest returnings)) =
+  unwords [
+    ("WITH " <> ignoredBody) `emptyOnFalse` not payloadIsEmpty,
+    "INSERT INTO ", fromQi qi, if payloadIsEmpty then " " else "(" <> cols <> ")",
+    case (pType, payloadIsEmpty) of
+      (PJArray _, True) -> "SELECT null WHERE false"
+      (PJObject, True)  -> "DEFAULT VALUES"
+      _ -> unwords [
+        "SELECT " <> cols <> " FROM",
+        case pType of
+          PJObject  -> "json_populate_record"
+          PJArray _ -> "json_populate_recordset", "(null::", fromQi qi, ", $1) _",
+        -- Only used for PUT
+        ("WHERE " <> intercalate " AND " (pgFmtLogicTree (QualifiedIdentifier "" "_") <$> logicForest)) `emptyOnFalse` null logicForest],
+    maybe "" (\x -> (
+      "ON CONFLICT(" <> intercalate ", " (pgFmtIdent <$> pkCols) <> ") " <> case x of
+      IgnoreDuplicates ->
+        "DO NOTHING"
+      MergeDuplicates  ->
+        "DO UPDATE SET " <> intercalate ", " (pgFmtIdent <> const " = EXCLUDED." <> pgFmtIdent <$> S.toList pKeys)
+    ) `emptyOnFalse` null pkCols) onConflct,
+    ("RETURNING " <> intercalate ", " (map (pgFmtColumn qi) returnings)) `emptyOnFalse` null returnings]
+  where
+    qi = QualifiedIdentifier schema mainTbl
+    cols = intercalate ", " $ pgFmtIdent <$> S.toList pKeys
+    payloadIsEmpty = pjIsEmpty p
+requestToQuery schema _ (DbMutate (Update mainTbl p@(PayloadJSON _ pType keys) logicForest returnings)) =
+  if pjIsEmpty p
+    then "WITH " <> ignoredBody <> "SELECT ''"
+    else
       unwords [
-        "UPDATE ", fromQi qi,
-        " SET " <> intercalate "," assignments <> " ",
-        ("WHERE " <> intercalate " AND " (map (pgFmtFilter qi) conditions ++ map (pgFmtLogicTree qi) logic_))
-          `emptyOnFalse` (null conditions && null logic_),
+        "UPDATE " <> fromQi qi <> " SET " <> cols,
+        "FROM (SELECT * FROM ",
+        case pType of
+           PJObject  -> " json_populate_record"
+           PJArray _ -> " json_populate_recordset", "(null::", fromQi qi, ", $1)) _ ",
+        ("WHERE " <> intercalate " AND " (map (pgFmtLogicTree qi) logicForest)) `emptyOnFalse` null logicForest,
         ("RETURNING " <> intercalate ", " (map (pgFmtColumn qi) returnings)) `emptyOnFalse` null returnings
         ]
-    Nothing -> undefined
   where
     qi = QualifiedIdentifier schema mainTbl
-requestToQuery schema _ (DbMutate (Delete mainTbl conditions logic_ returnings)) =
-  query
+    cols = intercalate ", " (pgFmtIdent <> const " = _." <> pgFmtIdent <$> S.toList keys)
+requestToQuery schema _ (DbMutate (Delete mainTbl logicForest returnings)) =
+  unwords [
+    "WITH " <> ignoredBody,
+    "DELETE FROM ", fromQi qi,
+    ("WHERE " <> intercalate " AND " (map (pgFmtLogicTree qi) logicForest)) `emptyOnFalse` null logicForest,
+    ("RETURNING " <> intercalate ", " (map (pgFmtColumn qi) returnings)) `emptyOnFalse` null returnings
+    ]
   where
     qi = QualifiedIdentifier schema mainTbl
-    query = unwords [
-      "DELETE FROM ", fromQi qi,
-      ("WHERE " <> intercalate " AND " (map (pgFmtFilter qi) conditions ++ map (pgFmtLogicTree qi) logic_))
-        `emptyOnFalse` (null conditions && null logic_),
-      ("RETURNING " <> intercalate ", " (map (pgFmtColumn qi) returnings)) `emptyOnFalse` null returnings
-      ]
 
-sourceCTEName :: SqlFragment
-sourceCTEName = "pg_source"
+-- Due to the use of the `unknown` encoder we need to cast '$1' when the value is not used in the main query
+-- otherwise the query will err with a `could not determine data type of parameter $1`.
+-- This happens because `unknown` relies on the context to determine the value type.
+-- The error also happens on raw libpq used with C.
+ignoredBody :: SqlFragment
+ignoredBody = "ignored_body AS (SELECT $1::text) "
 
 removeSourceCTESchema :: Schema -> TableName -> QualifiedIdentifier
 removeSourceCTESchema schema tbl = QualifiedIdentifier (if tbl == sourceCTEName then "" else schema) tbl
@@ -341,7 +359,7 @@ 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 "
@@ -350,24 +368,12 @@ asBinaryF :: FieldName -> SqlFragment
 asBinaryF fieldName = "coalesce(string_agg(_postgrest_t." <> pgFmtIdent fieldName <> ", ''), '')"
 
 locationF :: [Text] -> SqlFragment
-locationF pKeys =
-    "(" <>
-    " WITH s AS (SELECT row_to_json(ss) as r from " <> sourceCTEName <> " as ss  limit 1)" <>
-    " SELECT array_agg(json_data.key || '=' || coalesce('eq.' || json_data.value, 'is.null'))" <>
-    " FROM s, json_each_text(s.r) AS json_data" <>
-    (
-      if null pKeys
-      then ""
-      else " WHERE json_data.key IN ('" <> intercalate "','" pKeys <> "')"
-    ) <> ")"
-
-limitF :: NonnegRange -> SqlFragment
-limitF r  = if r == allRange
-  then ""
-  else "LIMIT " <> limit <> " OFFSET " <> offset
-  where
-    limit  = maybe "ALL" show $ rangeLimit r
-    offset = show $ rangeOffset r
+locationF pKeys = [qc|(
+  WITH data AS (SELECT row_to_json(_) AS row FROM {sourceCTEName} AS _ LIMIT 1)
+  SELECT array_agg(json_data.key || '=' || coalesce('eq.' || json_data.value, 'is.null'))
+  FROM data CROSS JOIN json_each_text(data.row) AS json_data
+  {("WHERE json_data.key IN ('" <> intercalate "','" pKeys <> "')") `emptyOnFalse` null pKeys}
+)|]
 
 fromQi :: QualifiedIdentifier -> SqlFragment
 fromQi t = (if s == "" then "" else pgFmtIdent s <> ".") <> pgFmtIdent n
@@ -375,35 +381,12 @@ 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) (Operation False ("=", VForeignKey (QualifiedIdentifier s tb) (ForeignKey fc{colTable=(colTable fc){tableName=ftb}})))
-
 unicodeStatement :: Text -> HE.Params a -> HD.Result b -> Bool -> H.Query a b
 unicodeStatement = H.statement . T.encodeUtf8
 
 emptyOnFalse :: Text -> Bool -> Text
 emptyOnFalse val cond = if cond then "" else val
 
-insertableValue :: JSON.Value -> SqlFragment
-insertableValue JSON.Null = "null"
-insertableValue v = (<> "::unknown") . pgFmtLit $ unquoted v
-
-insertableValueWithType :: Text -> JSON.Value -> SqlFragment
-insertableValueWithType t v =
-  pgFmtLit (unquoted v) <> "::" <> t
-
 pgFmtColumn :: QualifiedIdentifier -> Text -> SqlFragment
 pgFmtColumn table "*" = fromQi table <> ".*"
 pgFmtColumn table c = fromQi table <> "." <> pgFmtIdent c
@@ -412,61 +395,82 @@ 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@(fName, jp), Nothing, alias, _) = pgFmtField table f <> pgFmtAs fName jp alias
+pgFmtSelectItem table (f@(fName, jp), Just cast, alias, _) = "CAST (" <> pgFmtField table f <> " AS " <> cast <> " )" <> pgFmtAs fName jp alias
+
+pgFmtOrderTerm :: QualifiedIdentifier -> OrderTerm -> SqlFragment
+pgFmtOrderTerm qi ot = unwords [
+  toS . pgFmtField qi $ otTerm ot,
+  maybe "" show $ otDirection ot,
+  maybe "" show $ otNullOrder ot]
 
 pgFmtFilter :: QualifiedIdentifier -> Filter -> SqlFragment
-pgFmtFilter table (Filter fld (Operation hasNot_ ex)) = notOp <> " " <> case ex of
-   (op, VText val) -> pgFmtFieldOp op <> " " <> case op of
-     "like"  -> unknownLiteral (T.map star val)
-     "ilike" -> unknownLiteral (T.map star val)
-     "@@"    -> "to_tsquery(" <> unknownLiteral val <> ") "
-     "is"    -> whiteList val
-     "isnot" -> whiteList val
-     _       -> unknownLiteral val
-   (op, VTextL vals) -> pgFmtIn op vals -- in and notin
-   (op, VForeignKey fQi (ForeignKey Column{colTable=Table{tableName=fTableName}, colName=fColName})) ->
-     pgFmtField fQi fld <> " " <> sqlOperator op <> " " <> pgFmtColumn (removeSourceCTESchema (qiSchema fQi) fTableName) fColName
+pgFmtFilter table (Filter fld (OpExpr hasNot oper)) = notOp <> " " <> case oper of
+   Op op val  -> pgFmtFieldOp op <> " " <> case op of
+     "like"   -> unknownLiteral (T.map star val)
+     "ilike"  -> unknownLiteral (T.map star val)
+     "is"     -> whiteList val
+     _        -> unknownLiteral val
+
+   In vals -> pgFmtField table fld <> " " <>
+    let emptyValForIn = "= any('{}') " in -- Workaround because for postgresql "col IN ()" is invalid syntax, we instead do "col = any('{}')"
+    case ((&&) (length vals == 1) . T.null) <$> headMay vals of
+      Just False -> sqlOperator "in" <> "(" <> intercalate ", " (map unknownLiteral vals) <> ") "
+      Just True  -> emptyValForIn
+      Nothing    -> emptyValForIn
+
+   Fts op lang val ->
+     pgFmtFieldOp op
+       <> "("
+       <> maybe "" ((<> ", ") . pgFmtLit) lang
+       <> unknownLiteral val
+       <> ") "
  where
    pgFmtFieldOp op = pgFmtField table fld <> " " <> sqlOperator op
    sqlOperator o = HM.lookupDefault "=" o operators
-   notOp = if hasNot_ then "NOT" else ""
+   notOp = if hasNot then "NOT" else ""
    star c = if c == '*' then '%' else c
    unknownLiteral = (<> "::unknown ") . pgFmtLit
    whiteList :: Text -> SqlFragment
    whiteList v = fromMaybe
      (toS (pgFmtLit v) <> "::unknown ")
      (find ((==) . toLower $ v) ["null","true","false"])
-   pgFmtIn :: Operator -> [Text] -> SqlFragment
-   pgFmtIn op vals =
-    -- Workaround because for postgresql "col IN ()" is invalid syntax, we instead do "col = any('{}')"
-    let emptyValForIn o = (if "not" `isInfixOf` o then "NOT " else "") -- handle case of "notin" operator
-                          <> pgFmtField table fld <> " = any('{}') " in
-    case T.null <$> headMay vals of
-      Just isNull -> if isNull && length vals == 1
-                        then emptyValForIn op
-                        else pgFmtFieldOp op <> "(" <> intercalate ", " (map unknownLiteral vals) <> ") "
-      Nothing -> emptyValForIn op
+
+pgFmtJoinCondition :: JoinCondition -> SqlFragment
+pgFmtJoinCondition (JoinCondition (qi, al1, col1) (QualifiedIdentifier schema fTable, al2, col2)) =
+  pgFmtColumn (fromMaybe qi $ aliasToQi al1) col1 <> " = " <>
+  pgFmtColumn (fromMaybe (removeSourceCTESchema schema fTable) $ aliasToQi al2) col2
+  where
+    aliasToQi al = QualifiedIdentifier "" <$> al
 
 pgFmtLogicTree :: QualifiedIdentifier -> LogicTree -> SqlFragment
-pgFmtLogicTree qi (Expr hasNot_ op lt rt) = notOp <> " (" <> pgFmtLogicTree qi lt <> " " <> show op <> " " <> pgFmtLogicTree qi rt <> ")"
-  where notOp =  if hasNot_ then "NOT" else ""
+pgFmtLogicTree qi (Expr hasNot op forest) = notOp <> " (" <> intercalate (" " <> show op <> " ") (pgFmtLogicTree qi <$> forest) <> ")"
+  where notOp =  if hasNot then "NOT" else ""
 pgFmtLogicTree qi (Stmnt flt) = pgFmtFilter qi flt
 
-pgFmtJsonPath :: Maybe JsonPath -> SqlFragment
-pgFmtJsonPath (Just [x]) = "->>" <> pgFmtLit x
-pgFmtJsonPath (Just (x:xs)) = "->" <> pgFmtLit x <> pgFmtJsonPath ( Just xs )
-pgFmtJsonPath _ = ""
+pgFmtJsonPath :: JsonPath -> SqlFragment
+pgFmtJsonPath = \case
+  []             -> ""
+  (JArrow x:xs)  -> "->" <> pgFmtJsonOperand x <> pgFmtJsonPath xs
+  (J2Arrow x:xs) -> "->>" <> pgFmtJsonOperand x <> pgFmtJsonPath xs
+  where
+    pgFmtJsonOperand (JKey k) = pgFmtLit k
+    pgFmtJsonOperand (JIdx i) = pgFmtLit i <> "::int"
 
-pgFmtAs :: Maybe JsonPath -> Maybe Alias -> SqlFragment
-pgFmtAs Nothing Nothing = ""
-pgFmtAs (Just xx) Nothing = case lastMay xx of
-  Just alias -> " AS " <> pgFmtIdent alias
+pgFmtAs :: FieldName -> JsonPath -> Maybe Alias -> SqlFragment
+pgFmtAs _ [] Nothing = ""
+pgFmtAs fName jp Nothing = case jOp <$> lastMay jp of
+  Just (JKey key) -> " AS " <> pgFmtIdent key
+  Just (JIdx _)   -> " AS " <> pgFmtIdent (fromMaybe fName lastKey)
+    -- We get the lastKey because on:
+    -- `select=data->1->mycol->>2`, we need to show the result as [ {"mycol": ..}, {"mycol": ..} ]
+    -- `select=data->3`, we need to show the result as [ {"data": ..}, {"data": ..} ]
+    where lastKey = jVal <$> find (\case JKey{} -> True; _ -> False) (jOp <$> reverse jp)
   Nothing -> ""
-pgFmtAs _ (Just alias) = " AS " <> pgFmtIdent alias
+pgFmtAs _ _ (Just alias) = " AS " <> pgFmtIdent alias
 
-pgFmtEnvVar :: Text -> (Text, Text) -> SqlFragment
-pgFmtEnvVar prefix (k, v) =
+pgFmtSetLocal :: Text -> (Text, Text) -> SqlFragment
+pgFmtSetLocal prefix (k, v) =
   "set local " <> pgFmtIdent (prefix <> k) <> " = " <> pgFmtLit v <> ";"
 
 trimNullChars :: Text -> Text

src/PostgREST/Types.hs

@@ -2,11 +2,12 @@
 module PostgREST.Types where
 import           Protolude
 import qualified GHC.Show
-import           Data.Aeson
+import qualified Data.Aeson           as JSON
 import qualified Data.ByteString.Lazy as BL
+import qualified Data.CaseInsensitive as CI
 import qualified Data.HashMap.Strict  as M
+import qualified Data.Set                  as S
 import           Data.Tree
-import qualified Data.Vector          as V
 import           PostgREST.RangeQuery (NonnegRange)
 import           Network.HTTP.Types.Header (hContentType, Header)
 
@@ -22,66 +23,93 @@ data ApiRequestError = ActionInappropriate
                      | UnknownRelation
                      | NoRelationBetween Text Text
                      | UnsupportedVerb
+                     | InvalidFilters
                      deriving (Show, Eq)
 
+data PreferResolution = MergeDuplicates | IgnoreDuplicates deriving Eq
+instance Show PreferResolution where
+  show MergeDuplicates  = "resolution=merge-duplicates"
+  show IgnoreDuplicates = "resolution=ignore-duplicates"
+
 data DbStructure = DbStructure {
   dbTables      :: [Table]
 , dbColumns     :: [Column]
 , dbRelations   :: [Relation]
 , dbPrimaryKeys :: [PrimaryKey]
-, dbProcs       :: M.HashMap Text ProcDescription
+-- ProcDescription is a list because a function can be overloaded
+, dbProcs       :: M.HashMap Text [ProcDescription]
+, pgVersion     :: PgVersion
 } deriving (Show, Eq)
 
+-- TODO Table could hold references to all its Columns
+tableCols :: DbStructure -> Schema -> TableName -> [Column]
+tableCols dbs tSchema tName = filter (\Column{colTable=Table{tableSchema=s, tableName=t}} -> s==tSchema && t==tName) $ dbColumns dbs
+
+-- TODO Table could hold references to all its PrimaryKeys
+tablePKCols :: DbStructure -> Schema -> TableName -> [Text]
+tablePKCols dbs tSchema tName =  pkName <$> filter (\pk -> tSchema == (tableSchema . pkTable) pk && tName == (tableName . pkTable) pk) (dbPrimaryKeys dbs)
+
 data PgArg = PgArg {
   pgaName :: Text
 , pgaType :: Text
 , pgaReq  :: Bool
-} deriving (Show, Eq)
+} deriving (Show, Eq, Ord)
 
-data PgType = Scalar QualifiedIdentifier | Composite QualifiedIdentifier | Pseudo Text deriving (Eq, Show)
+data PgType = Scalar QualifiedIdentifier | Composite QualifiedIdentifier deriving (Eq, Show, Ord)
 
-data RetType = Single PgType | SetOf PgType deriving (Eq, Show)
+data RetType = Single PgType | SetOf PgType deriving (Eq, Show, Ord)
 
 data ProcVolatility = Volatile | Stable | Immutable
-  deriving (Eq, Show)
+  deriving (Eq, Show, Ord)
 
 data ProcDescription = ProcDescription {
-  pdName       :: Text
-, pdArgs       :: [PgArg]
-, pdReturnType :: RetType
-, pdVolatility :: ProcVolatility
+  pdName        :: Text
+, pdDescription :: Maybe Text
+, pdArgs        :: [PgArg]
+, pdReturnType  :: RetType
+, pdVolatility  :: ProcVolatility
 } deriving (Show, Eq)
 
+-- Order by least number of args in the case of overloaded functions
+instance Ord ProcDescription where
+  ProcDescription name1 des1 args1 rt1 vol1 `compare` ProcDescription name2 des2 args2 rt2 vol2
+    | name1 == name2 && length args1 < length args2  = LT
+    | name1 == name2 && length args1 > length args2  = GT
+    | otherwise = (name1, des1, args1, rt1, vol1) `compare` (name2, des2, args2, rt2, vol2)
+
 type Schema = Text
 type TableName = Text
 type SqlQuery = Text
 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)
 
 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
+      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)
+-- | A view column that refers to a table column
+type Synonym = (Column, ViewColumn)
+type ViewColumn = Column
 
 data PrimaryKey = PrimaryKey {
     pkTable :: Table
@@ -90,13 +118,13 @@ data PrimaryKey = PrimaryKey {
 
 data OrderDirection = OrderAsc | OrderDesc deriving (Eq)
 instance Show OrderDirection where
-  show OrderAsc  = "asc"
-  show OrderDesc = "desc"
+  show OrderAsc  = "ASC"
+  show OrderDesc = "DESC"
 
 data OrderNulls = OrderNullsFirst | OrderNullsLast deriving (Eq)
 instance Show OrderNulls where
-  show OrderNullsFirst = "nulls first"
-  show OrderNullsLast  = "nulls last"
+  show OrderNullsFirst = "NULLS FIRST"
+  show OrderNullsLast  = "NULLS LAST"
 
 data OrderTerm = OrderTerm {
   otTerm      :: Field
@@ -107,28 +135,45 @@ data OrderTerm = OrderTerm {
 data QualifiedIdentifier = QualifiedIdentifier {
   qiSchema :: Schema
 , qiName   :: TableName
-} deriving (Show, Eq)
+} deriving (Show, Eq, Ord)
 
 
 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]
 , relFTable   :: Table
 , relFColumns :: [Column]
 , relType     :: RelationType
-, relLTable   :: Maybe Table
-, relLCols1   :: Maybe [Column]
-, relLCols2   :: Maybe [Column]
+-- The Link attrs are used when RelationType == Many
+, relLinkTable   :: Maybe Table
+, relLinkCols1   :: Maybe [Column]
+, relLinkCols2   :: Maybe [Column]
 } deriving (Show, Eq)
 
--- | An array of JSON objects that has been verified to have
--- the same keys in every object
-newtype PayloadJSON = PayloadJSON (V.Vector Object)
-  deriving (Show, Eq)
+-- | Cached attributes of a JSON payload
+data PayloadJSON = PayloadJSON {
+-- | This is the raw ByteString that comes from the request body.
+-- We cache this instead of an Aeson Value because it was detected that for large payloads the encoding
+-- had high memory usage, see #1005 for more details
+  pjRaw     :: BL.ByteString
+, pjType    :: PJType
+-- | Keys of the object or if it's an array these keys are guaranteed to be the same across all its objects
+, pjKeys    :: S.Set Text
+} deriving (Show, Eq)
 
-unPayloadJSON :: PayloadJSON -> V.Vector Object
-unPayloadJSON (PayloadJSON objs) = objs
+data PJType = PJArray { pjaLength :: Int } | PJObject deriving (Show, Eq)
+
+-- | e.g. whether it is []/{} or not
+pjIsEmpty :: PayloadJSON -> Bool
+pjIsEmpty (PayloadJSON _ PJObject keys) = S.size keys == 0
+pjIsEmpty (PayloadJSON _ (PJArray l) _) = l == 0
 
 data Proxy = Proxy {
   proxyScheme     :: Text
@@ -139,7 +184,7 @@ data Proxy = Proxy {
 
 type Operator = Text
 operators :: M.HashMap Operator SqlFragment
-operators = M.fromList [
+operators = M.union (M.fromList [
   ("eq", "="),
   ("gte", ">="),
   ("gt", ">"),
@@ -149,14 +194,33 @@ operators = M.fromList [
   ("like", "LIKE"),
   ("ilike", "ILIKE"),
   ("in", "IN"),
-  ("notin", "NOT IN"),
-  ("isnot", "IS NOT"),
   ("is", "IS"),
-  ("@@", "@@"),
-  ("@>", "@>"),
-  ("<@", "<@")]
-data Operation = Operation{ hasNot::Bool, expr::(Operator, Operand) } deriving (Eq, Show)
-data Operand = VText Text | VTextL [Text] | VForeignKey QualifiedIdentifier ForeignKey deriving (Show, Eq)
+  ("cs", "@>"),
+  ("cd", "<@"),
+  ("ov", "&&"),
+  ("sl", "<<"),
+  ("sr", ">>"),
+  ("nxr", "&<"),
+  ("nxl", "&>"),
+  ("adj", "-|-")]) ftsOperators
+
+ftsOperators :: M.HashMap Operator SqlFragment
+ftsOperators = M.fromList [
+  ("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 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
@@ -171,59 +235,65 @@ instance Show LogicOperator where
                /  \
          id.eq.1   id.eq.2
 -}
-data LogicTree = Expr Bool LogicOperator LogicTree LogicTree | Stmnt Filter deriving (Show, Eq)
+data LogicTree = Expr Bool LogicOperator [LogicTree] | Stmnt Filter deriving (Show, Eq)
 
 type FieldName = Text
-type JsonPath = [Text]
-type Field = (FieldName, Maybe JsonPath)
+{-|
+  Json path operations as specified in https://www.postgresql.org/docs/9.4/static/functions-json.html
+-}
+type JsonPath = [JsonOperation]
+-- | Represents the single arrow `->` or double arrow `->>` operators
+data JsonOperation = JArrow{jOp :: JsonOperand} | J2Arrow{jOp :: JsonOperand} deriving (Show, Eq)
+-- | Represents the key(`->'key'`) or index(`->'1`::int`), the index is Text because we reuse our escaping functons and let pg do the casting with '1'::int
+data JsonOperand = JKey{jVal :: Text} | JIdx{jVal :: Text} deriving (Show, Eq)
+
+type Field = (FieldName, JsonPath)
 type Alias = Text
 type Cast = Text
 type NodeName = Text
-type SelectItem = (Field, Maybe Cast, Maybe Alias)
+
+-- 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 JSON.FromJSON GucHeader where
+  parseJSON (JSON.Object o) = case headMay (M.toList o) of
+    Just (k, JSON.String s) | M.size o == 1 -> pure $ GucHeader (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, operation::Operation } deriving (Show, Eq)
+data Filter = Filter { field::Field, opExpr::OpExpr } deriving (Show, Eq)
+data JoinCondition = JoinCondition (QualifiedIdentifier, Maybe Alias, FieldName)
+                                   (QualifiedIdentifier, Maybe Alias, FieldName) deriving (Show, Eq)
 
-data ReadQuery = Select { select::[SelectItem], from::[TableName], flt_::[Filter], logic::[LogicTree], order::Maybe [OrderTerm], range_::NonnegRange } deriving (Show, Eq)
-data MutateQuery = Insert { in_::TableName, qPayload::PayloadJSON, returning::[FieldName] }
-                 | Delete { in_::TableName, where_::[Filter], logic::[LogicTree], returning::[FieldName] }
-                 | Update { in_::TableName, qPayload::PayloadJSON, where_::[Filter], logic::[LogicTree], returning::[FieldName] } deriving (Show, Eq)
-type ReadNode = (ReadQuery, (NodeName, Maybe Relation, Maybe Alias))
+data ReadQuery = Select { select::[SelectItem], from::[TableName], where_::[LogicTree], joinConditions::[JoinCondition], order::[OrderTerm], range_::NonnegRange } deriving (Show, Eq)
+data MutateQuery = Insert { in_::TableName, insPkCols::[Text], qPayload::PayloadJSON, onConflict:: Maybe PreferResolution, where_::[LogicTree], returning::[FieldName] }
+                 | Delete { in_::TableName, where_::[LogicTree], returning::[FieldName] }
+                 | Update { in_::TableName, qPayload::PayloadJSON, where_::[LogicTree], returning::[FieldName] } deriving (Show, Eq)
+type ReadNode = (ReadQuery, (NodeName, Maybe Relation, Maybe Alias, Maybe RelationDetail, Depth))
 type ReadRequest = Tree ReadNode
+-- Depth of the ReadRequest tree
+type Depth = Integer
 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
 
@@ -243,3 +313,16 @@ 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"
+
+-- | full jspath, e.g. .property[0].attr.detail
+type JSPath = [JSPathExp]
+-- | jspath expression, e.g. .property, .property[0] or ."property-dash"
+data JSPathExp = JSPKey Text | JSPIdx Int deriving (Eq, Show)

stack.yaml

@@ -1,9 +1,16 @@
-resolver: lts-8.5
+resolver: lts-9.6
 extra-deps:
-  - Ranged-sets-0.3.0
-  - hasql-pool-0.4.1
   - configurator-ng-0.0.0.1
   - critbit-0.2.0.0
+  - hjsonpointer-1.1.1
+  - hjsonschema-1.5.0.1
+  - Ranged-sets-0.3.0
+  - protolude-0.2.2
+  - hasql-1.1
+  - hasql-pool-0.4.3
+  - hasql-transaction-0.5.2
+  - jose-0.7.0.0
+  - postgresql-libpq-0.9.4.1
 ghc-options:
   postgrest: -O2 -Werror -Wall -fwarn-identities -fno-warn-redundant-constraints
 nix:

test/Feature/AndOrParamsSpec.hs

@@ -27,13 +27,13 @@ spec =
 
       context "embedded levels" $ do
         it "can do logic on the second level" $
-          get "/entities?child_entities.or=(id.eq.1,name.eq.child entity 2)&select=id,child_entities{id}" `shouldRespondWith`
+          get "/entities?child_entities.or=(id.eq.1,name.eq.child entity 2)&select=id,child_entities(id)" `shouldRespondWith`
             [json|[
               {"id": 1, "child_entities": [ { "id": 1 }, { "id": 2 } ] }, { "id": 2, "child_entities": []},
               {"id": 3, "child_entities": []}, {"id": 4, "child_entities": []}
             ]|] { matchHeaders = [matchContentTypeJson] }
         it "can do logic on the third level" $
-          get "/entities?child_entities.grandchild_entities.or=(id.eq.1,id.eq.2)&select=id,child_entities{id,grandchild_entities{id}}" `shouldRespondWith`
+          get "/entities?child_entities.grandchild_entities.or=(id.eq.1,id.eq.2)&select=id,child_entities(id,grandchild_entities(id))" `shouldRespondWith`
             [json|[
               {"id": 1, "child_entities": [ { "id": 1, "grandchild_entities": [ { "id": 1 }, { "id": 2 } ]}, { "id": 2, "grandchild_entities": []}]},
               {"id": 2, "child_entities": [ { "id": 3, "grandchild_entities": []} ]},
@@ -70,21 +70,58 @@ spec =
         it "can handle is" $
           get "/entities?and=(name.is.null,arr.is.null)&select=id" `shouldRespondWith`
             [json|[{ "id": 4 }]|] { matchHeaders = [matchContentTypeJson] }
-        it "can handle @@" $
-          get "/entities?or=(text_search_vector.@@.bar,text_search_vector.@@.baz)&select=id" `shouldRespondWith`
+        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] }
-        it "can handle @> and <@" $
-          get "/entities?or=(arr.@>.{1,2,3},arr.<@.{1})&select=id" `shouldRespondWith`
+          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] }
+        it "can handle cs and cd" $
+          get "/entities?or=(arr.cs.{1,2,3},arr.cd.{1})&select=id" `shouldRespondWith`
             [json|[{ "id": 1 },{ "id": 3 }]|] { matchHeaders = [matchContentTypeJson] }
+
+        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, @>, like can be negated" $
-            get "/entities?and=(arr.not.@>.{1,2,3},and(id.not.eq.2,name.not.like.*3))&select=id" `shouldRespondWith`
+          it "eq, cs, like can be negated" $
+            get "/entities?and=(arr.not.cs.{1,2,3},and(id.not.eq.2,name.not.like.*3))&select=id" `shouldRespondWith`
               [json|[{ "id": 1}]|] { matchHeaders = [matchContentTypeJson] }
-          it "in, is, @@ can be negated" $
-            get "/entities?and=(id.not.in.(1,3),and(name.not.is.null,text_search_vector.not.@@.foo))&select=id" `shouldRespondWith`
+          it "in, is, fts can be negated" $
+            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] }
-          it "lt, gte, <@ can be negated" $
-            get "/entities?and=(arr.not.<@.{1},or(id.not.lt.1,id.not.gte.3))&select=id" `shouldRespondWith`
+          it "lt, gte, cd can be negated" $
+            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] }
           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`
@@ -105,9 +142,32 @@ spec =
         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}"
+        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},
@@ -133,10 +193,6 @@ spec =
     it "can query columns that begin with and/or reserved words" $
       get "/grandchild_entities?or=(and_starting_col.eq.smth, or_starting_col.eq.smth)" `shouldRespondWith` 200
 
-    it "can query jsonb columns" $
-      get "/grandchild_entities?or=(jsonb_col->a->>b.eq.foo, jsonb_col->>b.eq.bar)&select=id" `shouldRespondWith`
-        [json|[{id: 4}, {id: 5}]|] { matchStatus = 200, matchHeaders = [matchContentTypeJson] }
-
     it "fails when using IN without () and provides meaningful error message" $
       get "/entities?or=(id.in.1,2,id.eq.3)" `shouldRespondWith`
         [json|{
@@ -145,21 +201,11 @@ spec =
         }|] { matchStatus = 400, matchHeaders = [matchContentTypeJson] }
 
     it "fails on malformed query params and provides meaningful error message" $ do
-      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] }
       get "/entities?or=)(" `shouldRespondWith`
         [json|{
           "details": "unexpected \")\" expecting \"(\"",
           "message": "\"failed to parse logic tree ()()\" (line 1, column 3)"
         }|] { matchStatus = 400, matchHeaders = [matchContentTypeJson] }
-      get "/entities?or=(id.eq.1)" `shouldRespondWith`
-        [json|{
-          "details": "unexpected \")\" expecting \",\"",
-          "message": "\"failed to parse logic tree ((id.eq.1))\" (line 1, column 11)"
-        }|] { matchStatus = 400, matchHeaders = [matchContentTypeJson] }
       get "/entities?and=(ord(id.eq.1,id.eq.1),id.eq.2)" `shouldRespondWith`
         [json|{
           "details": "unexpected \"d\" expecting \"(\"",

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,7 +10,6 @@ import SpecHelper
 import Network.Wai (Application)
 
 import Protolude hiding (get)
--- }}}
 
 spec :: SpecWith Application
 spec = describe "authorization" $ do
@@ -28,7 +26,7 @@ spec = describe "authorization" $ do
       }
 
   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` [json| {
           "hint":null,
@@ -39,44 +37,55 @@ spec = describe "authorization" $ do
       , 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` [json| {"token":"eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJyb2xuYW1lIjoicG9zdGdyZXN0X3Rlc3RfYXV0aG9yIiwiaWQiOiJqZG9lIn0.P2G9EVSVI22MWxXWFuhEYd9BZerLS1WDlqzdqplM15s"} |]
+      `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` [json| {"token":"eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJpc3MiOiJqb2UiLCJzdWIiOiJmdW4iLCJhdWQiOiJldmVyeW9uZSIsImV4cCI6MTMwMDgxOTM4MCwibmJmIjoxMzAwODE5MzgwLCJpYXQiOjEzMDA4MTkzODAsImp0aSI6ImZvbyIsInJvbGUiOiJwb3N0Z3Jlc3RfdGVzdCIsImh0dHA6Ly9wb3N0Z3Jlc3QuY29tL2ZvbyI6dHJ1ZX0.IHF16ZSU6XTbOnUWO8CCpUn2fJwt8P00rlYVyXQjpWc"} |]
+      `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` [json| {"message":"JWT expired"} |]
         { matchStatus = 401
@@ -89,27 +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` [json| {"message":"JWT invalid"} |]
+      `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
@@ -117,7 +126,7 @@ 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` [str|"postgrest_test_author"|]
@@ -126,7 +135,7 @@ spec = describe "authorization" $ do
           }
 
     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` [str|"postgrest_test_default_role"|]
@@ -135,7 +144,7 @@ spec = describe "authorization" $ do
           }
 
     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` [str|{"hint":"Please contact administrator","details":null,"code":"P0001","message":"Disabled ID --> 3"}|]

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/DeleteSpec.hs

@@ -36,7 +36,7 @@ spec =
         request methodDelete "/complex_items?id=eq.3&select=ciId:id::text,ciName:name" [("Prefer", "return=representation")] ""
           `shouldRespondWith` [str|[{"ciId":"3","ciName":"Three"}]|]
       it "can embed (parent) entities" $
-        request methodDelete "/tasks?id=eq.8&select=id,name,project{id}" [("Prefer", "return=representation")] ""
+        request methodDelete "/tasks?id=eq.8&select=id,name,project(id)" [("Prefer", "return=representation")] ""
           `shouldRespondWith` [str|[{"id":8,"name":"Code OSX","project":{"id":4}}]|]
           { matchStatus  = 200
           , matchHeaders = ["Content-Range" <:> "*/*"]

test/Feature/InsertSpec.hs

@@ -49,9 +49,15 @@ spec = do
           , matchHeaders = [matchContentTypeJson]
           }
 
+    context "non uniform json array" $ do
+      it "rejects json array that isn't exclusivily composed of objects" $
+        post "/articles" [json| [{"id": 100, "body": "xxxxx"}, 123, "xxxx", {"id": 111, "body": "xxxx"}] |] `shouldRespondWith` 400
+      it "rejects json array that has objects with different keys" $
+        post "/articles" [json| [{"id": 100, "body": "xxxxx"}, {"id": 111, "body": "xxxx", "owner": "me"}] |] `shouldRespondWith` 400
+
     context "requesting full representation" $ do
       it "includes related data after insert" $
-        request methodPost "/projects?select=id,name,clients{id,name}"
+        request methodPost "/projects?select=id,name,clients(id,name)"
                 [("Prefer", "return=representation"), ("Prefer", "count=exact")]
           [str|{"id":6,"name":"New Project","client_id":2}|] `shouldRespondWith` [str|[{"id":6,"name":"New Project","clients":{"id":2,"name":"Apple"}}]|]
           { matchStatus  = 201
@@ -384,16 +390,6 @@ spec = do
           [json| [{ a: "keepme", b: null }] |]
           { matchHeaders = [matchContentTypeJson] }
 
-      it "can set a json column to escaped value" $ do
-        _ <- post "/json" [json| { data: {"escaped":"bar"} } |]
-        request methodPatch "/json?data->>escaped=eq.bar"
-                     [("Prefer", "return=representation")]
-                     [json| { "data": { "escaped":" \"bar" } } |]
-          `shouldRespondWith` [json| [{ "data": { "escaped":" \"bar" } }] |]
-          { matchStatus  = 200
-          , matchHeaders = []
-          }
-
       it "can update based on a computed column" $
         request methodPatch
           "/items?always_true=eq.false"
@@ -416,7 +412,7 @@ spec = do
         -- put value back for other tests
         void $ request methodPatch "/items?id=eq.99" [] [json| { "id":1 } |]
 
-      it "makes no updates and returns 204, when patching with an empty json object" $ do
+      it "makes no updates and returns 204, when patching with an empty json object/array" $ do
         request methodPatch "/items" [] [json| {} |]
           `shouldRespondWith` ""
           {
@@ -424,8 +420,16 @@ spec = do
             matchHeaders = ["Content-Range" <:> "*/*"]
           }
 
-        g <- get "/items"
-        liftIO $ simpleBody g `shouldBe` [json| [{"id":3},{"id":4},{"id":5},{"id":6},{"id":7},{"id":8},{"id":9},{"id":10},{"id":11},{"id":12},{"id":13},{"id":14},{"id":15},{id:16},{"id":2},{"id":1}] |]
+        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| {} |]
@@ -434,10 +438,10 @@ spec = do
             matchStatus  = 200,
             matchHeaders = ["Content-Range" <:> "*/*"]
           }
-
-        g <- get "/items"
-        liftIO $ simpleBody g `shouldBe` [json| [{"id":3},{"id":4},{"id":5},{"id":6},{"id":7},{"id":8},{"id":9},{"id":10},{"id":11},{"id":12},{"id":13},{"id":14},{"id":15},{id:16},{"id":2},{"id":1}] |]
-
+        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" []
@@ -451,7 +455,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" } |]
 
@@ -464,7 +468,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/JsonOperatorSpec.hs

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

test/Feature/NoJwtSpec.hs

@@ -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/PgVersion95Spec.hs

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

test/Feature/PgVersion96Spec.hs

@@ -0,0 +1,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)
 
@@ -30,15 +29,15 @@ spec =
         simpleStatus r `shouldBe` ok200
 
     it "limit works on all levels" $
-      get "/users?select=id,tasks{id}&order=id.asc&tasks.order=id.asc"
-        `shouldRespondWith` [str|[{"id":1,"tasks":[{"id":1},{"id":2}]},{"id":2,"tasks":[{"id":5},{"id":6}]}]|]
+      get "/users?select=id,tasks(id)&order=id.asc&tasks.order=id.asc"
+        `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` [str|[{"id":6,"project":{"id":3}},{"id":7,"project":{"id":4}}]|]
+      get "/tasks?select=id,project(id)&id=gt.5"
+        `shouldRespondWith` [json|[{"id":6,"project":{"id":3}},{"id":7,"project":{"id":4}}]|]
         { matchStatus  = 200
         , matchHeaders = ["Content-Range" <:> "0-1/*"]
         }

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)
@@ -131,28 +130,28 @@ spec = do
       it "no parameters return everything" $
         get "/items?select=id&order=id.asc"
           `shouldRespondWith`
-          [str|[{"id":1},{"id":2},{"id":3},{"id":4},{"id":5},{"id":6},{"id":7},{"id":8},{"id":9},{"id":10},{"id":11},{"id":12},{"id":13},{"id":14},{"id":15}]|]
+          [json|[{"id":1},{"id":2},{"id":3},{"id":4},{"id":5},{"id":6},{"id":7},{"id":8},{"id":9},{"id":10},{"id":11},{"id":12},{"id":13},{"id":14},{"id":15}]|]
           { matchStatus  = 200
           , matchHeaders = ["Content-Range" <:> "0-14/*"]
           }
       it "top level limit with parameter" $
         get "/items?select=id&order=id.asc&limit=3"
-          `shouldRespondWith` [str|[{"id":1},{"id":2},{"id":3}]|]
+          `shouldRespondWith` [json|[{"id":1},{"id":2},{"id":3}]|]
           { matchStatus  = 200
           , matchHeaders = ["Content-Range" <:> "0-2/*"]
           }
       it "headers override get parameters" $
         request methodGet  "/items?select=id&order=id.asc&limit=3"
                      (rangeHdrs $ ByteRangeFromTo 0 1) ""
-          `shouldRespondWith` [str|[{"id":1},{"id":2}]|]
+          `shouldRespondWith` [json|[{"id":1},{"id":2}]|]
           { matchStatus  = 200
           , matchHeaders = ["Content-Range" <:> "0-1/*"]
           }
 
       it "limit works on all levels" $
-        get "/clients?select=id,projects{id,tasks{id}}&order=id.asc&limit=1&projects.order=id.asc&projects.limit=2&projects.tasks.order=id.asc&projects.tasks.limit=1"
+        get "/clients?select=id,projects(id,tasks(id))&order=id.asc&limit=1&projects.order=id.asc&projects.limit=2&projects.tasks.order=id.asc&projects.tasks.limit=1"
           `shouldRespondWith`
-          [str|[{"id":1,"projects":[{"id":1,"tasks":[{"id":1}]},{"id":2,"tasks":[{"id":3}]}]}]|]
+          [json|[{"id":1,"projects":[{"id":1,"tasks":[{"id":1}]},{"id":2,"tasks":[{"id":3}]}]}]|]
           { matchStatus  = 200
           , matchHeaders = ["Content-Range" <:> "0-0/*"]
           }
@@ -160,7 +159,7 @@ spec = do
 
       it "limit and offset works on first level" $
         get "/items?select=id&order=id.asc&limit=3&offset=2"
-          `shouldRespondWith` [str|[{"id":3},{"id":4},{"id":5}]|]
+          `shouldRespondWith` [json|[{"id":3},{"id":4},{"id":5}]|]
           { matchStatus  = 200
           , matchHeaders = ["Content-Range" <:> "2-4/*"]
           }

test/Feature/RpcSpec.hs

@@ -0,0 +1,373 @@
+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
+
+    it "works when having uppercase identifiers" $ do
+      get "/rpc/quotedFunction?user=mscott&fullName=Michael Scott&SSN=401-32-XXXX" `shouldRespondWith`
+        [json|{"user": "mscott", "fullName": "Michael Scott", "SSN": "401-32-XXXX"}|]
+        { matchHeaders = [matchContentTypeJson] }
+      post "/rpc/quotedFunction"
+        [json|{"user": "dschrute", "fullName": "Dwight Schrute", "SSN": "030-18-XXXX"}|]
+        `shouldRespondWith`
+        [json|{"user": "dschrute", "fullName": "Dwight Schrute", "SSN": "030-18-XXXX"}|]
+        { matchHeaders = [matchContentTypeJson] }
+
+    context "shaping the response returned by a proc" $ do
+      it "returns a project" $ do
+        post "/rpc/getproject" [json| { "id": 1} |] `shouldRespondWith`
+          [str|[{"id":1,"name":"Windows 7","client_id":1}]|]
+        get "/rpc/getproject?id=1" `shouldRespondWith`
+          [str|[{"id":1,"name":"Windows 7","client_id":1}]|]
+
+      it "can filter proc results" $ do
+        post "/rpc/getallprojects?id=gt.1&id=lt.5&select=id" [json| {} |] `shouldRespondWith`
+          [json|[{"id":2},{"id":3},{"id":4}]|]
+          { matchHeaders = [matchContentTypeJson] }
+        get "/rpc/getallprojects?id=gt.1&id=lt.5&select=id" `shouldRespondWith`
+          [json|[{"id":2},{"id":3},{"id":4}]|]
+          { matchHeaders = [matchContentTypeJson] }
+
+      it "can limit proc results" $ do
+        post "/rpc/getallprojects?id=gt.1&id=lt.5&select=id?limit=2&offset=1" [json| {} |]
+          `shouldRespondWith` [json|[{"id":3},{"id":4}]|]
+             { matchStatus = 200
+             , matchHeaders = ["Content-Range" <:> "1-2/*"] }
+        get "/rpc/getallprojects?id=gt.1&id=lt.5&select=id?limit=2&offset=1"
+          `shouldRespondWith` [json|[{"id":3},{"id":4}]|]
+             { matchStatus = 200
+             , matchHeaders = ["Content-Range" <:> "1-2/*"] }
+
+      it "select works on the first level" $ do
+        post "/rpc/getproject?select=id,name" [json| { "id": 1} |] `shouldRespondWith`
+          [str|[{"id":1,"name":"Windows 7"}]|]
+        get "/rpc/getproject?id=1&select=id,name" `shouldRespondWith`
+          [str|[{"id":1,"name":"Windows 7"}]|]
+
+    context "foreign entities embedding" $ do
+      it "can embed if related tables are in the exposed schema" $ do
+        post "/rpc/getproject?select=id,name,client(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&b=false" `shouldRespondWith`
+          [json| [{"num":1,"str":"two","b":false}]|] { matchHeaders = [matchContentTypeJson] }
+
+    it "can handle procs with args that have a DEFAULT value" $ do
+      get "/rpc/many_inout_params?num=1&str=two" `shouldRespondWith`
+        [json| [{"num":1,"str":"two","b":true}]|] { matchHeaders = [matchContentTypeJson] }
+      get "/rpc/three_defaults?b=4" `shouldRespondWith`
+        [json|8|] { matchHeaders = [matchContentTypeJson] }
+
+    it "can map a RAISE error code and message to a http status" $
+      get "/rpc/raise_pt402"
+        `shouldRespondWith` [json|{ "hint": "Upgrade your plan", "details": "Quota exceeded" }|]
+        { matchStatus  = 402
+        , matchHeaders = [matchContentTypeJson]
+        }
+
+    it "defaults to status 500 if RAISE code is PT not followed by a number" $
+      get "/rpc/raise_bad_pt" `shouldRespondWith` 500
+
+    context "expects a single json object" $ do
+      it "does not expand posted json into parameters" $
+        request methodPost "/rpc/singlejsonparam"
+          [("prefer","params=single-object")] [json| { "p1": 1, "p2": "text", "p3" : {"obj":"text"} } |] `shouldRespondWith`
+          [json| { "p1": 1, "p2": "text", "p3" : {"obj":"text"} } |]
+          { matchHeaders = [matchContentTypeJson] }
+
+      it "accepts parameters from an html form" $
+        request methodPost "/rpc/singlejsonparam"
+          [("Prefer","params=single-object"),("Content-Type", "application/x-www-form-urlencoded")]
+          ("integer=7&double=2.71828&varchar=forms+are+fun&" <>
+           "boolean=false&date=1900-01-01&money=$3.99&enum=foo") `shouldRespondWith`
+          [json| { "integer": "7", "double": "2.71828", "varchar" : "forms are fun"
+                 , "boolean":"false", "date":"1900-01-01", "money":"$3.99", "enum":"foo" } |]
+                 { matchHeaders = [matchContentTypeJson] }
+
+      it "works with GET" $
+        request methodGet "/rpc/singlejsonparam?p1=1&p2=text" [("Prefer","params=single-object")] ""
+          `shouldRespondWith` [json|{ "p1": "1", "p2": "text"}|]
+          { matchHeaders = [matchContentTypeJson] }
+
+    it "should work with an overloaded function" $ do
+      get "/rpc/overloaded" `shouldRespondWith`
+        [json|[{ "overloaded": 1 },
+               { "overloaded": 2 },
+               { "overloaded": 3 }]|]
+        { matchHeaders = [matchContentTypeJson] }
+      request methodPost "/rpc/overloaded" [("Prefer","params=single-object")]
+        [json|[{"x": 1, "y": "first"}, {"x": 2, "y": "second"}]|]
+       `shouldRespondWith`
+        [json|[{"x": 1, "y": "first"}, {"x": 2, "y": "second"}]|]
+        { matchHeaders = [matchContentTypeJson] }
+      get "/rpc/overloaded?a=1&b=2" `shouldRespondWith` [str|3|]
+      get "/rpc/overloaded?a=1&b=2&c=3" `shouldRespondWith` [str|"123"|]
+
+    context "only for POST rpc" $
+      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] }

test/Feature/SingularSpec.hs

@@ -37,9 +37,10 @@ spec =
           `shouldRespondWith` [str|{"id":5}|]
 
       it "can shape plurality singular object routes" $
-        request methodGet "/projects_view?id=eq.1&select=id,name,clients{*},tasks{id,name}" [singular] ""
+        request methodGet "/projects_view?id=eq.1&select=id,name,clients(*),tasks(id,name)" [singular] ""
           `shouldRespondWith`
-            [str|{"id":1,"name":"Windows 7","clients":{"id":1,"name":"Microsoft"},"tasks":[{"id":1,"name":"Design w7"},{"id":2,"name":"Code w7"}]}|]
+            [json|{"id":1,"name":"Windows 7","clients":{"id":1,"name":"Microsoft"},"tasks":[{"id":1,"name":"Design w7"},{"id":2,"name":"Code w7"}]}|]
+            { matchHeaders = ["Content-Type" <:> "application/vnd.pgrst.object+json; charset=utf-8"] }
 
     context "when updating rows" $ do
 

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,212 @@ spec = do
               (acceptHdrs "application/openapi+json") ""
         `shouldRespondWith` 415
 
-    describe "RPC" $
+    it "includes postgrest.org 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.org/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 an array type for GET responses" $ do
+        r <- simpleBody <$> get "/"
+
+        let childGetSchema = r ^? key "paths"
+              . key "/child_entities"
+              . key "get"
+              . key "responses"
+              . key "200"
+              . key "schema"
+
+        liftIO $
+          childGetSchema `shouldBe` Just
+            [aesonQQ|
+              {
+                "items": {
+                  "$ref": "#/definitions/child_entities"
+                },
+                "type": "array"
+              }
+            |]
+
+      it "includes definitions to tables" $ do
+        r <- simpleBody <$> get "/"
+
+        let def = r ^? key "definitions" . key "child_entities"
+
+        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"
+                  }
+                },
+                "required": [
+                  "id"
+                ]
+              }
+            |]
+
+      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 "Foreign table" $
+
+      it "includes foreign table properties" $ do
+        r <- simpleBody <$> get "/"
+
+        let method s = key "paths" . key "/projects_dump" . key s
+            getSummary = r ^? method "get" . key "summary"
+            getDescription = r ^? method "get" . key "description"
+            getParameters = r ^? method "get" . key "parameters"
+
+        liftIO $ do
+
+          getSummary `shouldBe` Just "A temporary projects dump"
+
+          getDescription `shouldBe` Just "Just a test for foreign tables"
+
+          getParameters `shouldBe` Just
+            [aesonQQ|
+              [
+                { "$ref": "#/parameters/rowFilter.projects_dump.id" },
+                { "$ref": "#/parameters/rowFilter.projects_dump.name" },
+                { "$ref": "#/parameters/rowFilter.projects_dump.client_id" },
+                { "$ref": "#/parameters/select" },
+                { "$ref": "#/parameters/order" },
+                { "$ref": "#/parameters/range" },
+                { "$ref": "#/parameters/rangeUnit" },
+                { "$ref": "#/parameters/offset" },
+                { "$ref": "#/parameters/limit" },
+                { "$ref": "#/parameters/preferCount" }
+              ]
+            |]
+
+    describe "Materialized view" $
+
+      it "includes materialized view properties" $ do
+        r <- simpleBody <$> get "/"
+
+        let method s = key "paths" . key "/materialized_projects" . key s
+            summary = r ^? method "get" . key "summary"
+            description = r ^? method "get" . key "description"
+            parameters = r ^? method "get" . key "parameters"
+
+        liftIO $ do
+
+          summary `shouldBe` Just "A materialized view for projects"
+
+          description `shouldBe` Just "Just a test for materialized views"
+
+          parameters `shouldBe` Just
+            [aesonQQ|
+              [
+                { "$ref": "#/parameters/rowFilter.materialized_projects.id" },
+                { "$ref": "#/parameters/rowFilter.materialized_projects.name" },
+                { "$ref": "#/parameters/rowFilter.materialized_projects.client_id" },
+                { "$ref": "#/parameters/select" },
+                { "$ref": "#/parameters/order" },
+                { "$ref": "#/parameters/range" },
+                { "$ref": "#/parameters/rangeUnit" },
+                { "$ref": "#/parameters/offset" },
+                { "$ref": "#/parameters/limit" },
+                { "$ref": "#/parameters/preferCount" }
+              ]
+            |]
+
+    describe "RPC" $ do
+
+      it "includes function summary/description and body schema for arguments" $ do
+        r <- simpleBody <$> get "/"
+
+        let method s = key "paths" . key "/rpc/varied_arguments" . key s
+            args = r ^? method "post" . key "parameters" . nth 0 . key "schema"
+            summary = r ^? method "post" . key "summary"
+            description = r ^? method "post" . key "description"
+
+        liftIO $ do
+
+          summary `shouldBe` Just "An RPC function"
+
+          description `shouldBe` Just "Just a test for RPC function arguments"
+
           args `shouldBe` Just
             [aesonQQ|
               {
@@ -72,7 +268,7 @@ spec = do
                     "type": "string"
                   },
                   "enum": {
-                    "format": "test.enum_menagerie_type",
+                    "format": "enum_menagerie_type",
                     "type": "string"
                   },
                   "integer": {
@@ -80,10 +276,42 @@ spec = do
                     "type": "integer"
                   }
                 },
-                "type": "object"
+                "type": "object",
+                "description": "An RPC function\n\nJust a test for RPC function arguments"
               }
             |]
 
+      it "doesn't include privileged function for anonymous" $ do
+        r <- simpleBody <$> get "/"
+        let funcPath = r ^? key "paths" . key "/rpc/privileged_hello"
+
+        liftIO $ funcPath `shouldBe` Nothing
+
+      it "includes function if user has permission" $ do
+        let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJyb2xlIjoicG9zdGdyZXN0X3Rlc3RfYXV0aG9yIn0.Xod-F15qsGL0WhdOCr2j3DdKuTw9QJERVgoFD3vGaWA"
+        r <- simpleBody <$> request methodGet "/" [auth] ""
+        let funcTag = r ^? key "paths" . key "/rpc/privileged_hello"
+                      . key "post"  . key "tags"
+                      . nth 0
+
+        liftIO $ funcTag `shouldBe` Just [aesonQQ|"(rpc) privileged_hello"|]
+
+      it "doesn't include OUT params of function as required parameters" $ do
+        r <- simpleBody <$> get "/"
+        let params = r ^? key "paths" . key "/rpc/many_out_params"
+                        . key "post" . key "parameters" .  nth 0
+                        . key "schema". key "required"
+
+        liftIO $ params `shouldBe` Nothing
+
+      it "includes INOUT params(with no DEFAULT) of function as required parameters" $ do
+        r <- simpleBody <$> get "/"
+        let params = r ^? key "paths" . key "/rpc/many_inout_params"
+                        . key "post" . key "parameters" .  nth 0
+                        . key "schema". key "required"
+
+        liftIO $ params `shouldBe` Just [aesonQQ|["num", "str"]|]
+
   describe "Allow header" $ do
 
     it "includes read/write verbs for writeable table" $ do

test/Feature/UpsertSpec.hs

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

test/Main.hs

@@ -5,19 +5,24 @@ import SpecHelper
 
 import qualified Hasql.Pool as P
 
-import PostgREST.DbStructure (getDbStructure)
 import PostgREST.App (postgrest)
-import Control.AutoUpdate
+import PostgREST.Config (pgVersion95, pgVersion96)
+import PostgREST.DbStructure (getDbStructure, getPgVersion)
+import PostgREST.Types (DbStructure(..))
+import Control.AutoUpdate (defaultUpdateSettings, mkAutoUpdate, updateAction)
 import Data.Function (id)
 import Data.IORef
-import Data.Time.Clock.POSIX   (getPOSIXTime)
+import Data.Time.Clock (getCurrentTime)
 
 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
 import qualified Feature.InsertSpec
+import qualified Feature.JsonOperatorSpec
 import qualified Feature.NoJwtSpec
 import qualified Feature.QueryLimitedSpec
 import qualified Feature.QuerySpec
@@ -27,6 +32,11 @@ 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.PgVersion95Spec
+import qualified Feature.PgVersion96Spec
+import qualified Feature.UpsertSpec
 
 import Protolude
 
@@ -36,21 +46,50 @@ 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 $ Just $ either (panic.show) id result
-  let withApp      = return $ postgrest (testCfg testDbConn)          refDbStructure pool getTime $ pure ()
-      ltdApp       = return $ postgrest (testLtdRowsCfg testDbConn)   refDbStructure pool getTime $ pure ()
-      unicodeApp   = return $ postgrest (testUnicodeCfg testDbConn)   refDbStructure pool getTime $ pure ()
-      proxyApp     = return $ postgrest (testProxyCfg testDbConn)     refDbStructure pool getTime $ pure ()
-      noJwtApp     = return $ postgrest (testCfgNoJWT testDbConn)     refDbStructure pool getTime $ pure ()
-      binaryJwtApp = return $ postgrest (testCfgBinaryJWT testDbConn) refDbStructure pool getTime $ pure ()
+  dbStructure <- pure $ either (panic.show) id result
+
+  getTime <- mkAutoUpdate defaultUpdateSettings { updateAction = getCurrentTime }
+
+  refDbStructure <- newIORef $ Just dbStructure
+
+  let withApp              = return $ postgrest (testCfg testDbConn)            refDbStructure pool getTime $ pure ()
+      ltdApp               = return $ postgrest (testLtdRowsCfg testDbConn)     refDbStructure pool getTime $ pure ()
+      unicodeApp           = return $ postgrest (testUnicodeCfg testDbConn)     refDbStructure pool getTime $ pure ()
+      proxyApp             = return $ postgrest (testProxyCfg testDbConn)       refDbStructure pool getTime $ pure ()
+      noJwtApp             = return $ postgrest (testCfgNoJWT testDbConn)       refDbStructure pool getTime $ pure ()
+      binaryJwtApp         = return $ postgrest (testCfgBinaryJWT testDbConn)   refDbStructure pool getTime $ pure ()
+      audJwtApp            = return $ postgrest (testCfgAudienceJWT testDbConn) refDbStructure pool getTime $ pure ()
+      asymJwkApp           = return $ postgrest (testCfgAsymJWK testDbConn)     refDbStructure pool getTime $ pure ()
+      nonexistentSchemaApp = return $ postgrest (testNonexistentSchemaCfg testDbConn)   refDbStructure pool getTime $ pure ()
+
+  let reset :: IO ()
+      reset = resetDb testDbConn
+
+      actualPgVersion = pgVersion dbStructure
+      extraSpecs =
+        [("Feature.UpsertSpec", Feature.UpsertSpec.spec) | actualPgVersion >= pgVersion95] ++
+        [("Feature.PgVersion95Spec", Feature.PgVersion95Spec.spec) | actualPgVersion >= pgVersion95] ++
+        [("Feature.PgVersion96Spec", Feature.PgVersion96Spec.spec) | actualPgVersion >= pgVersion96]
+
+      specs = uncurry describe <$> [
+          ("Feature.AuthSpec"               , Feature.AuthSpec.spec)
+        , ("Feature.ConcurrentSpec"         , Feature.ConcurrentSpec.spec)
+        , ("Feature.CorsSpec"               , Feature.CorsSpec.spec)
+        , ("Feature.DeleteSpec"             , Feature.DeleteSpec.spec)
+        , ("Feature.InsertSpec"             , Feature.InsertSpec.spec)
+        , ("Feature.JsonOperatorSpec"       , Feature.JsonOperatorSpec.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)
+        ] ++ extraSpecs
 
-  let reset = resetDb testDbConn
   hspec $ do
     mapM_ (beforeAll_ reset . before withApp) specs
 
@@ -74,16 +113,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)
-    , ("Feature.AndOrParamsSpec"  , Feature.AndOrParamsSpec.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,9 +13,11 @@ 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(..))
+import PostgREST.Types  (JSPathExp(..))
 
 import Test.Hspec hiding (pendingWith)
 import Test.Hspec.Wai
@@ -67,11 +69,16 @@ _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
             True
+            [ ("app.settings.app_host", "localhost")
+            , ("app.settings.external_api_secret", "0123456789abcdef")
+            ]
+            -- Default role claim key
+            (Right [JSPKey "role"])
 
 testCfg :: Text -> AppConfig
 testCfg testDbConn = _baseCfg { configDatabase = testDbConn }
@@ -89,9 +96,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

@@ -1,4 +1,4 @@
-#! /bin/bash
+#! /usr/bin/env bash
 if [ -z "$1" ]
   then
     echo "Please supply the connection uri for the user with create database privileges"
@@ -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
@@ -49,6 +48,9 @@ CREATE DATABASE $DB OWNER $TEST_USER_NAME;
 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

@@ -1,4 +1,4 @@
-#! /bin/bash
+#! /usr/bin/env bash
 if [ -z "$1" ]
   then
     echo "Please supply the connection uri for the user with create database privileges"
@@ -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: -
@@ -315,6 +317,128 @@ INSERT INTO grandchild_entities VALUES (3, 'grandchild entity 3', 2, 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"}');
 
---
--- PostgreSQL database dump complete
---
+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);
+
+TRUNCATE TABLE employees CASCADE;
+INSERT INTO employees VALUES
+  ('Frances M.', 'Roe', '24000', 'One-Up Realty', 'Author'),
+  ('Daniel B.', 'Lyon', '36000', 'Dubrow''s Cafeteria', 'Packer'),
+  ('Edwin S.', 'Smith', '48000', 'Pro Garden Management', 'Marine biologist');
+
+TRUNCATE TABLE tiobe_pls CASCADE;
+INSERT INTO tiobe_pls VALUES ('Java', 1), ('C', 2), ('Python', 4);
+
+TRUNCATE TABLE only_pk CASCADE;
+INSERT INTO only_pk VALUES (1), (2);
+
+TRUNCATE TABLE family_tree CASCADE;
+INSERT INTO family_tree VALUES ('1', 'Parental Unit', NULL);
+INSERT INTO family_tree VALUES ('2', 'Kid One', '1');
+INSERT INTO family_tree VALUES ('3', 'Kid Two', '1');
+INSERT INTO family_tree VALUES ('4', 'Grandkid One', '2');
+INSERT INTO family_tree VALUES ('5', 'Grandkid Two', '3');
+
+TRUNCATE TABLE organizations CASCADE;
+INSERT INTO organizations VALUES (1, 'Referee Org', null, null);
+INSERT INTO organizations VALUES (2, 'Auditor Org', null, null);
+INSERT INTO organizations VALUES (3, 'Acme', 1, 2);
+INSERT INTO organizations VALUES (4, 'Umbrella', 1, 2);
+
+SET search_path = private, pg_catalog;
+
+TRUNCATE TABLE authors CASCADE;
+INSERT INTO authors VALUES (1, 'George Orwell');
+INSERT INTO authors VALUES (2, 'Anne Frank');
+INSERT INTO authors VALUES (3, 'Antoine de Saint-Exupéry');
+INSERT INTO authors VALUES (4, 'J.D. Salinger');
+INSERT INTO authors VALUES (5, 'Ray Bradbury');
+INSERT INTO authors VALUES (6, 'William Golding');
+INSERT INTO authors VALUES (7, 'Harper Lee');
+INSERT INTO authors VALUES (8, 'Kurt Vonnegut');
+INSERT INTO authors VALUES (9, 'Ken Kesey');
+
+TRUNCATE TABLE publishers CASCADE;
+INSERT INTO publishers VALUES (1, 'Secker & Warburg');
+INSERT INTO publishers VALUES (2, 'Contact Publishing');
+INSERT INTO publishers VALUES (3, 'Reynal & Hitchcock');
+INSERT INTO publishers VALUES (4, 'Little, Brown and Company');
+INSERT INTO publishers VALUES (5, 'Ballantine Books');
+INSERT INTO publishers VALUES (6, 'Faber and Faber');
+INSERT INTO publishers VALUES (7, 'J. B. Lippincott & Co.');
+INSERT INTO publishers VALUES (8, 'Delacorte');
+INSERT INTO publishers VALUES (9, 'Viking Press & Signet Books');
+
+TRUNCATE TABLE books CASCADE;
+INSERT INTO books VALUES (1, '1984', 1949, 1, 1);
+INSERT INTO books VALUES (2, 'The Diary of a Young Girl', 1947, 2, 2);
+INSERT INTO books VALUES (3, 'The Little Prince', 1947, 3, 3);
+INSERT INTO books VALUES (4, 'The Catcher in the Rye', 1951, 4, 4);
+INSERT INTO books VALUES (5, 'Farenheit 451', 1953, 5, 5);
+INSERT INTO books VALUES (6, 'Lord of the Flies', 1954, 6, 6);
+INSERT INTO books VALUES (7, 'To Kill a Mockingbird', 1960, 7, 7);
+INSERT INTO books VALUES (8, 'Slaughterhouse-Five', 1969, 8, 8);
+INSERT INTO books VALUES (9, 'One Flew Over the Cuckoo''s Nest', 1962, 9, 9);
+
+SET search_path = test, pg_catalog;
+
+TRUNCATE TABLE person CASCADE;
+
+INSERT INTO person VALUES (1, 'John');
+INSERT INTO person VALUES (2, 'Jane');
+INSERT INTO person VALUES (3, 'Jake');
+INSERT INTO person VALUES (4, 'Julie');
+
+TRUNCATE TABLE message CASCADE;
+INSERT INTO message VALUES (1, 'Hello Jane', 1, 2);
+INSERT INTO message VALUES (2, 'Hi John', 2, 1);
+INSERT INTO message VALUES (3, 'How are you doing?', 1, 2);
+INSERT INTO message VALUES (4, 'Hey Julie', 3, 4);
+INSERT INTO message VALUES (5, 'What''s up Jake', 4, 3);
+
+TRUNCATE TABLE space CASCADE;
+INSERT INTO space VALUES (1, 'space 1');
+
+TRUNCATE TABLE zone CASCADE;
+INSERT INTO zone VALUES (1, 'zone 1', 2, 1);
+INSERT INTO zone VALUES (2, 'zone 2', 2, 1);
+INSERT INTO zone VALUES (3, 'store 3', 3, 1);
+INSERT INTO zone VALUES (4, 'store 4', 3, 1);
+
+-- for foreign table projects_dump
+copy (select id, name, client_id from projects) to '/tmp/projects_dump.csv' with csv;
+
+TRUNCATE TABLE "UnitTest" CASCADE;
+INSERT INTO "UnitTest" VALUES (1, 'unit test 1');
+
+TRUNCATE TABLE json_arr CASCADE;
+INSERT INTO json_arr VALUES (1, '[1, 2, 3]');
+INSERT INTO json_arr VALUES (2, '[4, 5, 6]');
+INSERT INTO json_arr VALUES (3, '[[9, 8, 7], [11, 12, 13]]');
+INSERT INTO json_arr VALUES (4, '[[[5, 6], 7, 8]]');
+INSERT INTO json_arr VALUES (5, '[{"a": "A"}, {"b": "B"}]');
+INSERT INTO json_arr VALUES (6, '[{"a": [1,2,3]}, {"b": [4,5]}]');
+INSERT INTO json_arr VALUES (7, '{"c": [1,2,3], "d": [4,5]}');
+INSERT INTO json_arr VALUES (8, '{"c": [{"d": [4,5,6,7,8]}]}');
+INSERT INTO json_arr VALUES (9, '[{"0xy1": [1,{"23-xy-45": [2, {"xy-6": [3]}]}]}]');
+
+TRUNCATE TABLE jsonb_test CASCADE;
+INSERT INTO jsonb_test VALUES (1, '{ "a": {"b": 2} }');
+INSERT INTO jsonb_test VALUES (2, '{ "c": [1,2,3] }');
+INSERT INTO jsonb_test VALUES (3, '[{ "d": "test" }]');
+INSERT INTO jsonb_test VALUES (4, '{ "e": 1 }');

test/fixtures/jwt.sql

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

test/fixtures/privileges.sql

@@ -56,6 +56,39 @@ GRANT ALL ON TABLE
     , entities
     , child_entities
     , grandchild_entities
+    , ranges
+    , being
+    , descendant
+    , being_part
+    , part
+    , leak
+    , perf_articles
+    , employees
+    , tiobe_pls
+    , only_pk
+    , family_tree
+    , organizations
+    , authors
+    , books
+    , forties_books
+    , fifties_books
+    , sixties_books
+    , person
+    , message
+    , person_detail
+    , space
+    , zone
+    , projects_dump
+    , "UnitTest"
+    , json_arr
+    , jsonb_test
+    , authors_books_number
+    , authors_have_book_in_decade
+    , forties_and_fifties_books
+    , odd_years_publications
+    , foos
+    , bars
+    , materialized_projects
 TO postgrest_test_anonymous;
 
 GRANT INSERT ON TABLE insertonly TO postgrest_test_anonymous;
@@ -64,6 +97,7 @@ GRANT USAGE ON SEQUENCE
       auto_incrementing_pk_id_seq
     , items_id_seq
     , callcounter_count
+    , leak_id_seq
 TO postgrest_test_anonymous;
 
 -- Privileges for non anonymous users
@@ -73,3 +107,8 @@ 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;
+
+GRANT USAGE ON SCHEMA test TO postgrest_test_default_role;

test/fixtures/schema.sql

@@ -112,16 +112,19 @@ CREATE TABLE items (
 );
 
 
-SET search_path = public, pg_catalog;
-
---
--- Name: always_true(test.items); Type: FUNCTION; Schema: public; Owner: -
---
-
 CREATE FUNCTION always_true(test.items) RETURNS boolean
     LANGUAGE sql STABLE
     AS $$ SELECT true $$;
 
+CREATE FUNCTION anti_id(test.items) RETURNS bigint
+    LANGUAGE sql STABLE
+    AS $_$ SELECT $1.id * -1 $_$;
+
+SET search_path = public, pg_catalog;
+
+CREATE FUNCTION always_false(test.items) RETURNS boolean
+    LANGUAGE sql STABLE
+    AS $$ SELECT false $$;
 
 create table public_consumers (
     id                  serial             not null unique,
@@ -136,16 +139,6 @@ create table public_orders (
     primary key (id)
 );
 
---
--- Name: anti_id(test.items); Type: FUNCTION; Schema: public; Owner: -
---
-
-CREATE FUNCTION anti_id(test.items) RETURNS bigint
-    LANGUAGE sql STABLE
-    AS $_$ SELECT $1.id * -1 $_$;
-
-
-
 SET search_path = تست, pg_catalog;
 
 CREATE TABLE موارد (
@@ -205,7 +198,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
@@ -229,6 +222,10 @@ AS $_$
   SELECT 'Hi'::text;
 $_$;
 
+COMMENT ON FUNCTION varied_arguments(double precision, character varying, boolean, date, money, enum_menagerie_type, integer) IS
+$_$An RPC function
+
+Just a test for RPC function arguments$_$;
 
 --
 -- Name: jwt_test(); Type: FUNCTION; Schema: test; Owner: -
@@ -238,7 +235,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,
@@ -279,14 +276,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,
@@ -639,6 +635,9 @@ CREATE TABLE no_pk (
     b character varying
 );
 
+CREATE TABLE only_pk (
+    id integer primary key
+);
 
 --
 -- Name: nullable_integer; Type: TABLE; Schema: test; Owner: -
@@ -1097,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 $_$
@@ -1115,16 +1120,21 @@ create table images (
 );
 
 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 $$ 
+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_domain(val integer) returns test.one_nine as $$ 
+create function test.ret_array() returns integer[] as $$
+  select '{1,2,3}'::integer[];
+$$ language sql;
+
+create function test.ret_domain(val integer) returns test.one_nine as $$
   select val::test.one_nine;
 $$ language sql;
 
@@ -1132,38 +1142,50 @@ 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), 
+) as $$
+  select row('scalars'::text, enum_first(null::test.enum_menagerie_type),
               1::test.one_nine, int4range(10, 20));
 $$ language sql;
 
 create type test.point_2d as (x integer, y integer);
 
-create function test.ret_point_2d() returns test.point_2d as $$ 
+create function test.ret_point_2d() returns test.point_2d as $$
   select row(10, 5)::test.point_2d;
 $$ language sql;
 
 create type private.point_3d as (x integer, y integer, z integer);
 
-create function test.ret_point_3d() returns private.point_3d as $$ 
+create function test.ret_point_3d() returns private.point_3d as $$
   select row(7, -3, 4)::private.point_3d;
 $$ language sql;
 
 create function test.ret_void() returns void as '' language sql;
 
-create function test.single_article(id integer) returns test.articles as $$ 
+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 $$ 
+create function test.get_guc_value(name text) returns text as $$
   select nullif(current_setting(name), '')::text;
 $$ language sql;
 
 create table w_or_wo_comma_names ( name text );
 
-create table items_with_different_col_types ( 
+create table items_with_different_col_types (
   int_data integer,
   text_data text,
   bool_data bool,
@@ -1176,20 +1198,20 @@ create table items_with_different_col_types (
 
 -- Tables used for testing complex boolean logic with and/or query params
 
-create table entities ( 
+create table entities (
   id integer primary key,
   name text,
   arr integer[],
   text_search_vector tsvector
 );
 
-create table child_entities ( 
+create table child_entities (
   id integer primary key,
   name text,
   parent_id integer references entities(id)
 );
 
-create table grandchild_entities ( 
+create table grandchild_entities (
   id integer primary key,
   name text,
   parent_id integer references child_entities(id),
@@ -1198,6 +1220,362 @@ create table grandchild_entities (
   jsonb_col jsonb
 );
 
---
--- PostgreSQL database dump complete
---
+-- 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;
+
+create or replace function test.three_defaults(a int default 1, b int default 2, c int default 3) returns int as $$
+select a + b + c
+$$ language sql;
+
+create or replace function test.overloaded() returns setof int as $$
+  values (1), (2), (3);
+$$ language sql;
+
+create or replace function test.overloaded(pg_catalog.json) returns table(x int, y text) as $$
+  select * from json_to_recordset($1) as r(x int, y text);
+$$ language sql;
+
+create or replace function test.overloaded(a int, b int) returns int as $$
+  select a + b
+$$ language sql;
+
+create or replace function test.overloaded(a text, b text, c text) returns text as $$
+  select a || b || c
+$$ language sql;
+
+create table test.leak(
+  id serial primary key,
+  blob bytea
+);
+
+create function test.leak(blob bytea) returns void as $$ begin end; $$ language plpgsql;
+
+create table test.perf_articles(
+  id integer not null,
+  body text not null
+);
+
+create table test.employees(
+  first_name text,
+  last_name text,
+  salary money,
+  company text,
+  occupation text,
+  primary key(first_name, last_name)
+);
+
+create table test.tiobe_pls(
+  name text primary key,
+  rank smallint
+);
+
+create table test.family_tree (
+  id text not null primary key,
+  name text not null,
+  parent text
+);
+alter table only test.family_tree add constraint pptr foreign key (parent) references test.family_tree(id);
+
+create table test.organizations (
+  id integer primary key,
+  name text,
+  referee integer,
+  auditor integer
+);
+alter table only test.organizations add constraint pptr1 foreign key (referee) references test.organizations(id);
+alter table only test.organizations add constraint pptr2 foreign key (auditor) references test.organizations(id);
+
+create table private.authors(
+  id integer primary key,
+  name text
+);
+
+create table private.publishers(
+  id integer primary key,
+  name text
+);
+
+create table private.books(
+  id integer primary key,
+  title text,
+  publication_year smallint,
+  author_id integer references private.authors(id),
+  first_publisher_id integer references private.publishers(id)
+);
+
+create view test.authors as select id, name from private.authors;
+
+create view test.books as select id, title, publication_year, author_id from private.books;
+create view test.forties_books as select id, title, publication_year, author_id from private.books where publication_year >= 1940 and publication_year < 1950;
+create view test.fifties_books as select id, title, publication_year, author_id from private.books where publication_year >= 1950 and publication_year < 1960;
+create view test.sixties_books as select id, title, publication_year, author_id from private.books where publication_year >= 1960 and publication_year < 1970;
+
+create table person (
+  id integer primary key,
+  name character varying not null);
+
+create table message (
+  id integer primary key,
+  body text not null default '',
+  sender bigint not null references person(id),
+  recipient bigint not null references person(id));
+
+create view person_detail as
+  select p.id, p.name, s.count as sent, r.count as received
+  from person p
+  join lateral (select message.sender, count(message.id) as count from message group by message.sender) s on s.sender = p.id
+  join lateral (select message.recipient, count(message.id) as count from message group by message.recipient) r on r.recipient = p.id;
+
+create table space(
+  id integer primary key,
+  name text);
+
+create table zone(
+  id integer primary key,
+  name text,
+  zone_type_id integer,
+  space_id integer references space(id));
+
+-- foreign table tests
+create extension file_fdw;
+
+create server import_csv foreign data wrapper file_fdw;
+
+create foreign table projects_dump (
+  id integer,
+  name text,
+  client_id integer
+) server import_csv options ( filename '/tmp/projects_dump.csv', format 'csv');
+
+comment on foreign table projects_dump is
+$$A temporary projects dump
+
+Just a test for foreign tables$$;
+
+create table "UnitTest"(
+  "idUnitTest" integer primary key,
+  "nameUnitTest" text
+);
+
+create table json_arr(
+  id integer primary key,
+  data pg_catalog.json
+);
+
+create table jsonb_test(
+  id integer primary key,
+  data jsonb
+);
+
+create view test.authors_books_number as
+select
+  id,
+  name,
+  (
+    select
+      count(*)
+    from forties_books where author_id = authors.id
+  ) as num_in_forties,
+  (
+    select
+      count(*)
+    from fifties_books where author_id = authors.id
+  ) as num_in_fifties,
+  (
+    select
+      count(*)
+    from sixties_books where author_id = authors.id
+  ) as num_in_sixties,
+  (
+    select
+      count(*)
+    from (
+      select id
+      from forties_books where author_id = authors.id
+      union
+      select id
+      from fifties_books where author_id = authors.id
+      union
+      select id
+      from sixties_books where author_id = authors.id
+    ) _
+  ) as num_in_all_decades
+from private.authors;
+
+create view test.authors_have_book_in_decade as
+select
+  id,
+  name,
+  case
+    when (x.id in (select author_id from test.forties_books))
+    then true
+    else false
+  end as has_book_in_forties,
+  case
+    when (x.id in (select author_id from test.fifties_books))
+    then true
+    else false
+  end as has_book_in_fifties,
+  case
+    when (x.id in (select author_id from test.sixties_books))
+    then true
+    else false
+  end as has_book_in_sixties
+from private.authors x;
+
+create view test.forties_and_fifties_books as
+select x.id, x.title, x.publication_year, y.name as first_publisher, x.author_id
+from (
+  select id, title, publication_year, author_id, first_publisher_id from private.books
+  where publication_year >= 1940 and publication_year < 1960) x
+join private.publishers y on y.id = x.first_publisher_id;
+
+create view test.odd_years_publications as
+with
+odd_years_books as(
+  select id, title, publication_year, author_id, first_publisher_id
+  from private.books
+  where publication_year % 2 <> 0
+)
+select
+  x.id, x.title, x.publication_year,
+  y.name as first_publisher, x.author_id
+from odd_years_books x
+join private.publishers y on y.id = x.first_publisher_id;
+
+CREATE TABLE test."Foo"(
+  id int primary key,
+  name text
+);
+
+CREATE TABLE test.bar(
+  id int primary key,
+  name text,
+  "fooId" int references "Foo"(id)
+);
+
+CREATE VIEW test.foos as select id,name from "Foo";
+CREATE VIEW test.bars as select id, "fooId", name from bar;
+
+create materialized view materialized_projects as
+select id, name, client_id from projects;
+
+comment on materialized view materialized_projects is
+$$A materialized view for projects
+
+Just a test for materialized views$$;
+
+create or replace function test."quotedFunction"("user" text, "fullName" text, "SSN" text)
+returns jsonb AS $$
+  select format('{"user": "%s", "fullName": "%s", "SSN": "%s"}', "user", "fullName", "SSN")::jsonb;
+$$ language sql;

test/io-tests.sh

@@ -0,0 +1,208 @@
+#!/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 $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 $(cat "$authorsJwt") )"
+    if test "$httpStatus" -eq 200
+    then
+      ok "authentication with $2 secret read from a file"
+    else
+      ko "failed to authenticate using JWT for $2 secret: $httpStatus"
+    fi
+  else
+    ko "failed to read $2 secret from a file"
+  fi
+  pgrStop
+}
+
+reqWithRoleClaimKey(){
+  export ROLE_CLAIM_KEY=$1
+  pgrStart "./configs/role-claim-key.config"
+  while pgrStarted && test "$( rootStatus )" -ne 200
+  do
+    # wait for the server to start
+    sleep 0.1 \
+    || sleep 1 # fallback: subsecond sleep is not standard and may fail
+  done
+  authorsJwt=$(psql -qtAX postgrest_test -c "select jwt.sign('$2', 'reallyreallyreallyreallyverysafe');")
+  httpStatus="$( authorsStatus "$authorsJwt" )"
+  if test "$httpStatus" -eq $3
+  then
+    ok "request with \"$1\" role-claim-key for $2 jwt gave $3"
+  else
+    ko "request with \"$1\" role-claim-key for $2 jwt gave $httpStatus"
+  fi
+  pgrStop
+}
+
+invalidRoleClaimKey(){
+  export ROLE_CLAIM_KEY=$1
+  pgrStart "./configs/role-claim-key.config"
+  while pgrStarted && test "$( rootStatus )" -ne 200
+  do
+    # wait for the server to start
+    sleep 0.1 \
+    || sleep 1 # fallback: subsecond sleep is not standard and may fail
+  done
+  if pgrStarted
+  then
+    ko "invalid jspath \"$1\" accepted"
+  else
+    ok "invalid jspath \"$1\" rejected"
+  fi
+  pgrStop
+}
+
+# ensure iat claim is successful in the presence of pgrst time cache, see https://github.com/PostgREST/postgrest/issues/1139
+ensureIatClaimWorks(){
+  pgrStart "./configs/simple.config"
+  while pgrStarted && test "$( rootStatus )" -ne 200
+  do
+    # wait for the server to start
+    sleep 0.1 \
+    || sleep 1 # fallback: subsecond sleep is not standard and may fail
+  done
+  for i in {1..10}; do \
+    iatJwt=$(psql -qtAX postgrest_test -c "select jwt.sign(row_to_json(r), 'reallyreallyreallyreallyverysafe') from ( select 'postgrest_test_author' as role, extract(epoch from now()) as iat) r")
+    httpStatus="$( authorsStatus $iatJwt )"
+    if test "$httpStatus" -ne 200
+    then
+      ko "iat claim rejected with $httpStatus"
+      return
+    fi
+    sleep .5;\
+  done
+  ok "accepted iat claim"
+  pgrStop
+}
+
+# ensure app settings don't reset on pool timeout of 10 seconds, see https://github.com/PostgREST/postgrest/issues/1141
+ensureAppSettings(){
+  pgrStart "./configs/app-settings.config"
+  while pgrStarted && test "$( rootStatus )" -ne 200
+  do
+    # wait for the server to start
+    sleep 0.1 \
+    || sleep 1 # fallback: subsecond sleep is not standard and may fail
+  done
+  sleep 11
+  response=$(curl -s "http://localhost:$pgrPort/rpc/get_guc_value?name=app.settings.external_api_secret")
+  if test "$response" = "\"0123456789abcdef\""
+  then
+    ok "GET /rpc/get_guc_value response is $response"
+  else
+    ko "GET /rpc/get_guc_value response was $response"
+  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
+
+echo "Running IO tests.."
+
+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)'
+
+reqWithRoleClaimKey '.postgrest.a_role' '{"postgrest":{"a_role":"postgrest_test_author"}}' 200
+reqWithRoleClaimKey '.customObject.manyRoles[1]' '{"customObject":{"manyRoles": ["other", "postgrest_test_author"]}}' 200
+reqWithRoleClaimKey '."https://www.example.com/roles"[0].value' '{"https://www.example.com/roles":[{"value":"postgrest_test_author"}]}' 200
+reqWithRoleClaimKey '.myDomain[3]' '{"myDomain":["other","postgrest_test_author"]}' 401
+reqWithRoleClaimKey '.myRole' '{"role":"postgrest_test_author"}' 401
+
+invalidRoleClaimKey 'role.other'
+invalidRoleClaimKey '.role##'
+invalidRoleClaimKey '.my_role;;domain'
+invalidRoleClaimKey '.#$%&$%/'
+invalidRoleClaimKey ''
+invalidRoleClaimKey 1234
+
+ensureIatClaimWorks
+ensureAppSettings
+
+cleanUp
+
+exit $failedTests

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

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

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

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

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

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

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

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

test/io-tests/configs/simple.config

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

test/io-tests/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

test/memory-tests.sh

@@ -0,0 +1,117 @@
+#! /usr/bin/env bash
+currentTest=1
+failedTests=0
+result(){ echo "$1 $currentTest $2"; currentTest=$(( $currentTest + 1 )); }
+ok(){ result 'ok' "- $1"; }
+ko(){ result 'not ok' "- $1"; failedTests=$(( $failedTests + 1 )); }
+
+pgrPort=49421
+
+pgrStopAll(){ pkill -f "$(stack path --local-install-root)/bin/postgrest"; }
+
+pgrStart(){ stack exec -- postgrest test/memory-tests/config +RTS -p -h >/dev/null & pgrPID="$!"; }
+pgrStop(){ kill "$pgrPID" 2>/dev/null; }
+
+setUp(){ pgrStopAll; }
+cleanUp(){ pgrStopAll; }
+
+checkPgrStarted(){
+  while pgrStarted && test $(rootStatus) -ne 200
+  do
+    sleep 1
+  done
+}
+pgrStarted(){ kill -0 "$pgrPID" 2>/dev/null; }
+rootStatus(){
+  curl -s -o /dev/null -I -w '%{http_code}' "http://localhost:$pgrPort/"
+}
+
+jsonKeyTest(){
+  pgrStart
+  checkPgrStarted
+  factor=$(( 3*$(numfmt --from=si $1)/4 )) # 3/4 on $1 is need to maintain the specified size because of base64
+  payload="{\"blob\" : \"$(dd if=/dev/zero bs=$factor count=1 status=none | base64)\"}"
+  httpStatus=$(echo $payload | curl -s -H "Content-Type: application/json" --request $2 -d @- -w '%{http_code}' http://localhost:$pgrPort$3 | tr -d '"')
+  if test "$httpStatus" -ge 200 && test "$httpStatus" -lt 210
+  then
+    pgrStop
+    while [ ! -s postgrest.prof ]
+    do
+      sleep 1
+    done
+    BYTES_FMT=$(cat postgrest.prof | grep -o -P '(?<=alloc =).*(?=bytes)' | tr -d ' ')
+    BYTES=$(echo $BYTES_FMT | tr -d ',')
+    MAX_BYTES=$(numfmt --from=si $4)
+    if test $BYTES -le $MAX_BYTES
+    then
+      ok "$2 $3: with a json key of $1 the memory usage($BYTES_FMT bytes) is less than $4"
+    else
+      ko "$2 $3: with a json key of $1 the memory usage($BYTES_FMT bytes) is more than $4"
+    fi
+  else
+    pgrStop
+    ko "$2 $3: request failed with http $httpStatus"
+  fi
+}
+
+postJsonArrayTest(){
+  pgrStart
+  checkPgrStarted
+  arr=()
+  arr+=('[')
+  for i in $(seq 1 $(expr $1 - 1))
+  do
+    arr+=("{\"id\": $i, \"body\": \"xxxxxxx\"},")
+  done
+  arr+=("{\"id\": $1, \"body\": \"xxxxxxx\"}")
+  arr+=(']')
+  payload=$(echo ${arr[*]})
+  httpStatus=$(echo $payload | curl -s -H "Content-Type: application/json" -d @- -w '%{http_code}' http://localhost:$pgrPort$2 | tr -d '"')
+  if test "$httpStatus" -ge 200 && test "$httpStatus" -lt 210
+  then
+    pgrStop
+    while [ ! -s postgrest.prof ]
+    do
+      sleep 1
+    done
+    BYTES_FMT=$(cat postgrest.prof | grep -o -P '(?<=alloc =).*(?=bytes)' | tr -d ' ')
+    BYTES=$(echo $BYTES_FMT | tr -d ',')
+    MAX_BYTES=$(numfmt --from=si $3)
+    PAYLOAD_SIZE=$(echo $payload | wc -c | numfmt --to=si)
+    if test $BYTES -le $MAX_BYTES
+    then
+      ok "POST $2: with a json payload of $PAYLOAD_SIZE that has $1 array values the memory usage($BYTES_FMT bytes) is less than $3"
+    else
+      ko "POST $2: with a json payload of $PAYLOAD_SIZE that has $1 array values the memory usage($BYTES_FMT bytes) is more than $3"
+    fi
+  else
+    pgrStop
+    ko "POST $2: request failed with http $httpStatus"
+  fi
+}
+
+stack build --profile
+
+setUp
+
+echo "Running memory usage tests.."
+
+jsonKeyTest "1M" "POST" "/rpc/leak" "20M"
+jsonKeyTest "1M" "POST" "/leak" "20M"
+jsonKeyTest "1M" "PATCH" "/leak?id=eq.1" "20M"
+
+jsonKeyTest "10M" "POST" "/rpc/leak" "105M"
+jsonKeyTest "10M" "POST" "/leak" "105M"
+jsonKeyTest "10M" "PATCH" "/leak?id=eq.1" "105M"
+
+jsonKeyTest "50M" "POST" "/rpc/leak" "500M"
+jsonKeyTest "50M" "POST" "/leak" "500M"
+jsonKeyTest "50M" "PATCH" "/leak?id=eq.1" "500M"
+
+postJsonArrayTest "1000" "/perf_articles" "20M"
+postJsonArrayTest "10000" "/perf_articles" "150M"
+postJsonArrayTest "100000" "/perf_articles" "1.15G"
+
+cleanUp
+
+exit $failedTests

test/memory-tests/config

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