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]+)*/

.gitattributes

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

.github/CONTRIBUTING.md

@@ -31,6 +31,10 @@ your contributions.
   [enable logging all statements](http://www.microhowto.info/howto/log_all_queries_to_a_postgresql_server.html),
   then [find your logs](http://blog.endpoint.com/2014/11/dear-postgresql-where-are-my-logs.html).
 
+* If your database schema has changed while the PostgREST server is running,
+  send the server a `SIGHUP` signal or restart it to ensure the schema cache
+  is not stale. This sometimes fixes apparent bugs.
+
 ## Code
 
 ### Haskell Conventions
@@ -44,16 +48,11 @@ your contributions.
   pull request.
 
 * For help building the Haskell code on your computer check out the [building from
-source](https://github.com/begriffs/postgrest/wiki/Building-from-source)
+source](https://postgrest.com/en/stable/install.html#build-from-source)
 wiki page.
 
-## Maintenance
+### Running Tests
 
-### Schedule
+For instructions on running tests, see the official docs hosted here:
 
-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.
+https://postgrest.com/en/stable/install.html#postgrest-test-suite

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

.gitignore

@@ -6,6 +6,9 @@ cabal.sandbox.config
 hscope.out
 codex.tags
 .anvil
-.stack-work
+.stack-work*
 tags
 site
+*~
+*#*
+.#*

.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,234 @@ 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
+
+- #742, Add connection retrying on startup and SIGHUP - @steve-chavez
+- #652, Add and/or params for complex boolean logic - @steve-chavez
+- #808, Env var interpolation in config file (helps Docker) - @begriffs
+- #878 - CSV output support for RPC - @begriffs
+
+### Fixed
+
+- #822, Treat blank string JWT secret as no secret - @begriffs
+
+## [0.4.1.0] - 2017-04-25
+
+### Added
+- Allow requesting binary output on GET - @steve-chavez
+- Accept clients requesting `Content-Type: application/json` from / - @feynmanliang
+- #493, Updating with empty JSON object makes zero updates @koulakis
+- Make HTTP headers and cookies available as GUCs #800 - @ruslantalpa
+- #701, Ability to quote values on IN filters - @steve-chavez
+- #641, Allow IN filter to have no values - @steve-chavez
+
+### Fixed
+- #827, Avoid Warp reaper, extend socket timeout to 1 hour - @majorcode
+- #791, malformed nested JSON error - @diogob
+- Resource embedding in views referencing tables in public schema - @fab1an
+- #777, Empty body is allowed when calling a non-parameterized RPC - @koulakis
+- #831, Fix proc resource embedding issue with search_path - @steve-chavez
+- #547, Use read-only transaction for stable/immutable RPC - @begriffs
+
+## [0.4.0.0] - 2017-01-19
+
+### Added
+- Allow test database to be on another host - @dsimunic
+- `Prefer: params=single-object` to treat payload as single json argument in RPC - @dsimunic
+- Ability to generate an OpenAPI spec - @mainx07, @hudayou, @ruslantalpa, @begriffs
+- Ability to generate an OpenAPI spec behind a proxy - @hudayou
+- Ability to set addresses to listen on - @hudayou
+- Filtering, shaping and embedding with &select for the /rpc path - @ruslantalpa
+- Output names of used-defined types (instead of 'USER-DEFINED') - @martingms
+- Implement support for singular representation responses for POST/PATCH requests - @ehamberg
+- Include RPC endpoints in OpenAPI output - @begriffs, @LogvinovLeon
+- Custom request validation with `--pre-request` argument - @begriffs
+- Ability to order by jsonb keys - @steve-chavez
+- Ability to specify offset for a deeper level - @ruslantalpa
+- Ability to use binary base64 encoded secrets - @TrevorBasinger
+
+### Fixed
+- Do not apply limit to parent items - @ruslantalpa
+- Fix bug in relation detection when selecting parents two levels up by using the name of the FK - @ruslantalpa
+- Customize content negotiation per route - @begriffs
+- Allow using nulls order without explicit order direction - @steve-chavez
+- Fatal error on postgres unsupported version, format supported version in error message - @steve-chavez
+- Prevent database memory cosumption by prepared statements caches - @ruslantalpa
+- Use specific columns in the RETURNING section - @ruslantalpa
+- Fix columns alias for RETURNING - @steve-chavez
+
+### Changed
+- Replace `Prefer: plurality=singular` with `Accept: application/vnd.pgrst.object` - @begriffs
+- Standardize arrays in responses for `Prefer: return=representation` - @begriffs
+- Calling unknown RPC gives 404, not 400 - @begriffs
+- Use HTTP 400 for raise\_exception - @begriffs
+- Remove non-OpenAPI schema description - @begriffs
+- Use comma rather than semicolon to separate Prefer header values - @begriffs
+- Omit total query count by default - @begriffs
+- No more reserved `jwt_claims` return type - @begriffs
+- HTTP 401 rather than 400 for expired JWT - @begriffs
+- Remove default JWT secret - @begriffs
+- Use GUC request.jwt.claim.foo rather than postgrest.claims.foo - @begriffs
+- Use config file rather than command line arguments - @begriffs
+
+## [0.3.2.0] - 2016-06-10
+
+### Added
+- Reload database schema on SIGHUP - @begriffs
+- Support "-" in column names - @ruslantalpa
+- Support column/node renaming `alias:column` - @ruslantalpa
+- Accept posts from HTML forms - @begriffs
+- Ability to order embedded entities - @ruslantalpa
+- Ability to paginate using &limit and &offset parameters - @ruslantalpa
+- Ability to apply limits to embedded entities and enforce --max-rows on all levels - @ruslantalpa, @begriffs
+- Add allow response header in OPTIONS - @begriffs
+
+### Fixed
+- Return 401 or 403 for access denied rather than 404 - @begriffs
+- Omit Content-Type header for empty body - @begriffs
+- Prevent role from being changed twice - @begriffs
+- Use read-only transaction for read requests - @ruslantalpa
+- Include entities from the same parent table using two different foreign keys - @ruslantalpa
+- Ensure that Location header in 201 response is URL-encoded - @league
+- Fix garbage collector CPU leak - @ruslantalpa et al.
+- Return deleted items when return=representation header is sent - @ruslantalpa
+- Use table default values for empty object inserts - @begriffs
+
+## [0.3.1.1] - 2016-03-28
+
+### Fixed
+- Preserve unicode values in insert,update,rpc (regression) - @begriffs
+- Prevent duplicate call to stored procs (regression) - @begriffs
+- Allow SQL functions to generate registered JWT claims - @begriffs
+- Terminate gracefully on SIGTERM (for use in Docker) - @recmo
+- Relation detection fix for views that depend on multiple tables - @ruslantalpa
+- Avoid count on plurality=singular and allow multiple Prefer values - @ruslantalpa
+
+## [0.3.1.0] - 2016-02-28
+
+### Fixed
+- Prevent query error from infecting later connection - @begriffs, @ruslantalpa, @nikita-volkov, @jwiegley
+
+### Added
+- Applies range headers to RPC calls - @diogob
+
 ## [0.3.0.4] - 2016-02-12
 
 ### Fixed

README.md

@@ -1,55 +1,35 @@
 ![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.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
 API than you are likely to write from scratch.
 
-### Demo [postgrest.herokuapp.com](https://postgrest.herokuapp.com) | Read [Docs](http://postgrest.com/) | Watch [Video](http://begriffs.com/posts/2014-12-30-intro-to-postgrest.html)
-
-
-Try making requests to the live demo server with an HTTP client
-such as [postman](http://www.getpostman.com/). The structure of the
-demo database is defined by
-[begriffs/postgrest-example](https://github.com/begriffs/postgrest-example).
-You can use it as inspiration for test-driven server migrations in
-your own projects.
-
-Also try other tools in the PostgREST
-[ecosystem](http://postgrest.com/install/ecosystem/) like the
-[ng-admin demo](http://marmelab.com/ng-admin-postgrest).
-
 ### 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 like so:
+2. Invoke for help:
 
     ```bash
-    postgrest postgres://postgres:foobar@localhost:5432/my_db \
-              --port 3000 \
-              --schema public \
-              --anonymous postgres \
-              --pool 200
+    postgrest --help
     ```
 
-For more information on valid connection strings see the
-[PostgreSQL docs](http://www.postgresql.org/docs/9.4/static/libpq-connect.html#LIBPQ-CONNSTRING).
-
 ### Performance
 
 TLDR; subsecond response times for up to 2000 requests/sec on Heroku
-free tier. ([see the load
-test](http://postgrest.com/admin/performance/#benchmarks))
-
-If you're used to servers written in interpreted languages (or named
-after precious gems), prepare to be pleasantly surprised by PostgREST
-performance.
+free tier. If you're used to servers written in interpreted languages
+(or named after precious gems), prepare to be pleasantly surprised by
+PostgREST performance.
 
 Three factors contribute to the speed. First the server is written
 in [Haskell](https://www.haskell.org/) using the
@@ -68,32 +48,21 @@ Finally it uses the database efficiently with the
 [Hasql](https://nikita-volkov.github.io/hasql-benchmarks/) library
 by
 
-* Reusing prepared statements
 * Keeping a pool of db connections
 * Using the PostgreSQL binary protocol
 * Being stateless to allow horizontal scaling
 
-Ultimately the server (when load balanced) is constrained by database
-performance. This may make it inappropriate for very large traffic
-load. To learn more about scaling with Heroku and Amazon RDS see
-the [performance guide](http://postgrest.com/admin/performance/).
-Alternatively [CitusDB](https://www.citusdata.com/products/what-is-citusdb)
-supports Postgres clustering for higher performance.
-
-Other optimizations are possible, and some are outlined in the
-[Future Features](#future-features).
-
 ### Security
 
-PostgREST handles authentication (via [JSON Web
-Tokens](http://postgrest.com/admin/security/#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 identity of the currently authenticated user, and for the
-duration of the connection cannot do anything the user themselves
-couldn't. Other forms of authentication can be built on top
-of the JWT primitive. See the docs for more information.
+PostgREST [handles
+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
+identity of the currently authenticated user, and for the duration of
+the connection cannot do anything the user themselves couldn't. Other
+forms of authentication can be built on top of the JWT primitive. See
+the docs for more information.
 
 PostgreSQL 9.5 supports true [row-level
 security](http://www.postgresql.org/docs/9.5/static/ddl-rowsecurity.html).
@@ -104,35 +73,26 @@ are limited to certain templates using
 functions, the trigger workaround does not compromise row-level
 security.
 
-For example security patterns see the [security
-guide](http://postgrest.com/admin/security/).
-
 ### Versioning
 
 A robust long-lived API needs the freedom to exist in multiple
 versions. PostgREST does versioning through database schemas. This
 allows you to expose tables and views without making the app brittle.
 Underlying tables can be superseded and hidden behind public facing
-views. You run an instance of PostgREST per schema and route requests
-among them with a reverse proxy such as [nginx](http://nginx.org).
-Learn more [here](http://postgrest.com/admin/versioning/).
+views.
 
 ### Self-documentation
 
-Rather than writing and maintaining separate docs yourself let the
-API explain its own affordances using HTTP. All PostgREST endpoints
-respond to the OPTIONS verb and explain what they support as well
-as the data format of their JSON payload. RAML support is an upcoming
-feature.
+PostgREST uses the [OpenAPI](https://openapis.org/) standard to
+generate up-to-date documentation for APIs. You can use a tool like
+[Swagger-UI](https://github.com/swagger-api/swagger-ui) to render
+interactive documentation for demo requests against the live API server.
 
-The project uses HTTP itself to communicate other metadata. For
+This project uses HTTP to communicate other metadata as well.  For
 instance the number of rows returned by an endpoint is reported by -
 and limited with - range headers. More about
 [that](http://begriffs.com/posts/2014-03-06-beyond-http-header-links.html).
 
-There are more opportunities for self-documentation listed in [Future
-Features](#future-features).
-
 ### Data Integrity
 
 Rather than relying on an Object Relational Mapper and custom
@@ -141,31 +101,18 @@ directly into your database. Hence no application can corrupt your
 data (including your API server).
 
 The PostgREST exposes HTTP interface with safeguards to prevent
-surprises, such as enforcing idempotent PUT requests, and
+surprises, such as enforcing idempotent PUT requests.
 
 See examples of [PostgreSQL
 constraints](http://www.tutorialspoint.com/postgresql/postgresql_constraints.htm)
-and the [guide to routing](http://postgrest.com/api/reading/).
-
-### Future Features
-
-* Watching endpoint changes with sockets and Postgres pubsub
-* Specifying per-view HTTP caching
-* Inferring good default caching policies from the Postgres stats collector
-* Generating mock data for test clients
-* Maintaining separate connection pools per role to avoid "set/reset
-  role" performance penalty
-* Describe more relationships with Link headers
-* Depending on accept headers, render OPTIONS as [RAML](http://raml.org/) or a
-  relational diagram
-* ... the other [issues](https://github.com/begriffs/postgrest/issues)
+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,56 +1,59 @@
 {
   "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.3.0.4"
+      "value": "5.1.0"
     },
-    "DB_NAME": {
-      "description": "Database name",
+    "DB_URI": {
+      "description": "Database connection string, e.g. postgres://user:pass@xxxxxxx.rds.amazonaws.com/mydb",
       "required": true
     },
-    "AUTH_ROLE": {
-      "description": "Database role to use checking client authentication",
+    "DB_SCHEMA": {
+      "description": "The database schema to expose to REST clients. Tables, views and stored procedures in this schema will get API endpoints",
+      "required": true,
+      "value": "public"
+    },
+    "DB_ANON_ROLE": {
+      "description": "The database role to use when executing commands on behalf of unauthenticated clients",
       "required": true
     },
-    "AUTH_PASS": {
-      "description": "Authentication password",
-      "required": false
-    },
-    "ANONYMOUS_ROLE": {
-      "description": "Database role for non-authenticated requests",
-      "required": true
-    },
-    "DB_HOST": {
-      "description": "Database server hostname",
-      "required": true
-    },
-    "DB_PORT": {
-      "description": "Database server port",
-      "required": false,
-      "value": "5432"
-    },
     "DB_POOL": {
-      "description": "Maximum number of connections in database pool",
+      "description": "Number of connections to keep open in PostgREST’s database pool",
       "required": false,
       "value": "10"
     },
-    "JWT_SECRET": {
-      "description": "Secret used to encrypt JSON Web Tokens",
-      "required": false,
-      "value": "secret"
+    "SERVER_PROXY_URI": {
+      "description": "Overrides the base URL used within the OpenAPI self-documentation hosted at the API root path",
+      "required": false
     },
-    "SCHEMA": {
-      "description": "DB schema to be exported",
+    "JWT_SECRET": {
+      "description": "The secret used to decode JWT tokens clients provide for authentication",
+      "required": false
+    },
+    "SECRET_IS_BASE64": {
+      "description": "When this is set to true, the value derived from jwt-secret will be treated as a base64 encoded secret",
       "required": false,
-      "value": "1"
+      "value": "false"
+    },
+    "JWT_AUD": {
+      "description": "The audience that should be validated if the JWT token contains an aud claim",
+      "required": false
+    },
+    "MAX_ROWS": {
+      "description": "A hard limit to the number of rows PostgREST will fetch from a view, table, or stored procedure",
+      "required": false
+    },
+    "PRE_REQUEST": {
+      "description": "A schema-qualified stored procedure name to call right after switching roles for a client request",
+      "required": false
     }
   }
 }

appveyor.yml

@@ -0,0 +1,38 @@
+platform: x64
+
+cache:
+- "c:\\sr"
+- .stack-work
+
+environment:
+  global:
+    STACK_ROOT: "c:\\sr"
+    GOPATH: c:\gopath
+
+test: off
+
+skip_non_tags: true
+
+skip_branch_with_pr: true
+
+branches:
+  only:
+    - master
+
+install:
+- set PATH=C:\Program Files\PostgreSQL\9.6\bin\;%PATH%
+- curl -sS -ostack.zip -L --insecure http://www.stackage.org/stack/windows-x86_64
+- 7z x stack.zip stack.exe
+- set PATH=%GOPATH%\bin;c:\go\bin;%PATH%
+- go get -u github.com/tcnksm/ghr
+
+build_script:
+- stack setup --no-terminal > nul
+- stack build -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,22 +0,0 @@
-dependencies:
-  cache_directories:
-    - "~/.stack"
-    - ".stack-work"
-  pre:
-    - curl -L https://github.com/commercialhaskell/stack/releases/download/v1.0.2/stack-1.0.2-linux-x86_64.tar.gz | tar zx -C /tmp
-    - sudo mv /tmp/stack-1.0.2-linux-x86_64/stack /usr/bin
-    - createuser --superuser --no-password postgrest_test
-    - createdb -O postgrest_test -U ubuntu postgrest_test
-  override:
-    - stack setup
-    - stack install hlint packdeps cabal-install
-    - stack build --test --no-run-tests
-
-test:
-  override:
-    - stack test
-    - git ls-files | grep '\.l\?hs$' | xargs stack exec -- hlint -X QuasiQuotes "$@"
-    - stack exec -- packdeps *.cabal || true
-    - stack exec -- cabal check
-    - stack haddock --no-haddock-deps
-    - stack sdist

debian/TODO-deps.md

@@ -1,52 +0,0 @@
-# TODO list to build debian "official" package
-
-  It feels for free to modify, fix or take some task or all. 
-  
-## debian/control
-
-* Fill description field
-* Add Vcs-Browser
-* Add Vcs-Git
-* Add Uploaders field
-
-## debian/copyright 
-
-* Add more contributers 
-
-## Dependencies packages
-
-Some libraries dependencies aren't Debian package. Below is the list was built by [cabal-debian](https://wiki.debian.org/Haskell/CollabMaint/GettingStarted). These libraries are necessary to build Postgrest the right way. 
-
-* libghc-base64-string-dev
-* libghc-base64-string-prof
-* libghc-bcrypt-dev
-* libghc-bcrypt-prof
-* libghc-hasql-dev
-* libghc-hasql-prof
-* libghc-hasql-backend-dev
-* libghc-hasql-backend-prof
-* libghc-hasql-postgres-dev
-* libghc-hasql-postgres-prof
-* libghc-string-conversions-dev
-* libghc-string-conversions-prof
-* libghc-wai-cors-dev
-* libghc-wai-cors-prof
-* libghc-wai-middleware-static-dev
-* libghc-wai-middleware-static-prof
-* libghc-hasql-dev
-* libghc-hasql-backend-dev
-* libghc-hasql-postgres-dev
-* libghc-heredoc-dev
-* libghc-hspec-wai-dev
-* libghc-hspec-wai-json-dev
-* libghc-http-media-dev
-* libghc-packdeps-dev
-* libghc-base64-string-doc
-* libghc-bcrypt-doc
-* libghc-hasql-doc
-* libghc-hasql-backend-doc
-* libghc-hasql-postgres-doc
-* libghc-string-conversions-doc
-* libghc-wai-cors-doc
-* libghc-wai-middleware-static-doc
-

debian/changelog

@@ -1,5 +0,0 @@
-haskell-postgrest (0.2.11.1-1) UNRELEASED; urgency=low
-
-  * Initial release
-
- -- Debian Haskell Group <pkg-haskell-maintainers@lists.alioth.debian.org>  Wed, 30 Sep 2015 18:52:46 +0000

debian/compat

@@ -1 +0,0 @@
-9

debian/control

@@ -1,196 +0,0 @@
-Source: haskell-postgrest
-Maintainer: Debian Haskell Group <pkg-haskell-maintainers@lists.alioth.debian.org>
-Priority: extra
-Section: haskell
-Build-Depends: debhelper (>= 9),
- haskell-devscripts (>= 0.8),
- cdbs,
- ghc,
- ghc-prof,
- libghc-http-dev,
- libghc-http-prof,
- libghc-missingh-dev,
- libghc-missingh-prof,
- libghc-ranged-sets-dev,
- libghc-ranged-sets-prof,
- libghc-aeson-dev,
- libghc-aeson-prof,
- libghc-base64-string-dev,
- libghc-base64-string-prof,
- libghc-bcrypt-dev,
- libghc-bcrypt-prof,
- libghc-blaze-builder-dev,
- libghc-blaze-builder-prof,
- libghc-case-insensitive-dev,
- libghc-case-insensitive-prof,
- libghc-cassava-dev,
- libghc-cassava-prof,
- libghc-convertible-dev,
- libghc-convertible-prof,
- libghc-hasql-dev,
- libghc-hasql-prof,
- libghc-hasql-backend-dev,
- libghc-hasql-backend-prof,
- libghc-hasql-postgres-dev,
- libghc-hasql-postgres-prof,
- libghc-http-types-dev,
- libghc-http-types-prof,
- libghc-jwt-dev,
- libghc-jwt-prof,
- libghc-mtl-dev,
- libghc-mtl-prof,
- libghc-network-dev,
- libghc-network-prof,
- libghc-network-uri-dev,
- libghc-network-uri-prof,
- libghc-optparse-applicative-dev,
- libghc-optparse-applicative-prof,
- libghc-regex-base-dev,
- libghc-regex-base-prof,
- libghc-regex-tdfa-dev,
- libghc-regex-tdfa-prof,
- libghc-resource-pool-dev,
- libghc-resource-pool-prof,
- libghc-scientific-dev,
- libghc-scientific-prof,
- libghc-split-dev,
- libghc-split-prof,
- libghc-string-conversions-dev,
- libghc-string-conversions-prof,
- libghc-stringsearch-dev,
- libghc-stringsearch-prof,
- libghc-text-dev,
- libghc-text-prof,
- libghc-unordered-containers-dev,
- libghc-unordered-containers-prof,
- libghc-vector-dev,
- libghc-vector-prof,
- libghc-wai-dev,
- libghc-wai-prof,
- libghc-wai-cors-dev,
- libghc-wai-cors-prof,
- libghc-wai-extra-dev,
- libghc-wai-extra-prof,
- libghc-wai-middleware-static-dev,
- libghc-wai-middleware-static-prof,
- libghc-warp-dev,
- libghc-warp-prof,
- libghc-aeson-dev (>= 0.8),
- libghc-bcrypt-dev (>= 0.0.6),
- libghc-hasql-dev (>= 0.7.3),
- libghc-hasql-dev (<< 0.8),
- libghc-hasql-backend-dev (>= 0.4.1),
- libghc-hasql-backend-dev (<< 0.5),
- libghc-hasql-postgres-dev (>= 0.10.4),
- libghc-hasql-postgres-dev (<< 0.11),
- libghc-network-dev (>= 2.6),
- libghc-network-uri-dev (>= 2.6),
- libghc-optparse-applicative-dev (>= 0.11),
- libghc-optparse-applicative-dev (<< 0.12),
- libghc-wai-dev (>= 3.0.1),
- libghc-wai-middleware-static-dev (>= 0.6.0),
- libghc-warp-dev (>= 3.0.2),
- libghc-quickcheck2-dev,
- libghc-heredoc-dev,
- libghc-hlint-dev,
- libghc-hspec-dev (>= 2.1),
- libghc-hspec-dev (<< 2.2),
- libghc-hspec-wai-dev,
- libghc-hspec-wai-json-dev,
- libghc-http-media-dev,
- libghc-packdeps-dev,
-Build-Depends-Indep: ghc-doc,
- libghc-http-doc,
- libghc-missingh-doc,
- libghc-ranged-sets-doc,
- libghc-aeson-doc,
- libghc-base64-string-doc,
- libghc-bcrypt-doc,
- libghc-blaze-builder-doc,
- libghc-case-insensitive-doc,
- libghc-cassava-doc,
- libghc-convertible-doc,
- libghc-hasql-doc,
- libghc-hasql-backend-doc,
- libghc-hasql-postgres-doc,
- libghc-http-types-doc,
- libghc-jwt-doc,
- libghc-mtl-doc,
- libghc-network-doc,
- libghc-network-uri-doc,
- libghc-optparse-applicative-doc,
- libghc-regex-base-doc,
- libghc-regex-tdfa-doc,
- libghc-resource-pool-doc,
- libghc-scientific-doc,
- libghc-split-doc,
- libghc-string-conversions-doc,
- libghc-stringsearch-doc,
- libghc-text-doc,
- libghc-unordered-containers-doc,
- libghc-vector-doc,
- libghc-wai-doc,
- libghc-wai-cors-doc,
- libghc-wai-extra-doc,
- libghc-wai-middleware-static-doc,
- libghc-warp-doc,
-Standards-Version: 3.9.6
-Homepage: https://github.com/begriffs/postgrest
-Description: REST API for any Postgres database
- Reads the schema of a PostgreSQL database and creates RESTful routes
- for the tables and views, supporting all HTTP verbs that security
- permits.
-
-Package: libghc-postgrest-dev
-Architecture: any
-Depends: ${haskell:Depends},
- ${misc:Depends},
- ${shlibs:Depends},
-Recommends: ${haskell:Recommends},
-Suggests: ${haskell:Suggests},
-Conflicts: ${haskell:Conflicts},
-Provides: ${haskell:Provides},
-Description: ${haskell:ShortDescription}${haskell:ShortBlurb}
- ${haskell:LongDescription}
- .
- ${haskell:Blurb}
-
-Package: libghc-postgrest-prof
-Architecture: any
-Depends: ${haskell:Depends},
- ${misc:Depends},
-Recommends: ${haskell:Recommends},
-Suggests: ${haskell:Suggests},
-Conflicts: ${haskell:Conflicts},
-Provides: ${haskell:Provides},
-Description: ${haskell:ShortDescription}${haskell:ShortBlurb}
- ${haskell:LongDescription}
- .
- ${haskell:Blurb}
-
-Package: libghc-postgrest-doc
-Architecture: all
-Section: doc
-Depends: ${haskell:Depends},
- ${misc:Depends},
-Recommends: ${haskell:Recommends},
-Suggests: ${haskell:Suggests},
-Conflicts: ${haskell:Conflicts},
-Description: ${haskell:ShortDescription}${haskell:ShortBlurb}
- ${haskell:LongDescription}
- .
- ${haskell:Blurb}
-
-Package: haskell-postgrest-utils
-Architecture: any
-Section: misc
-Depends: ${haskell:Depends},
- ${misc:Depends},
-Recommends: ${haskell:Recommends},
-Suggests: ${haskell:Suggests},
-Conflicts: ${haskell:Conflicts},
-Provides: ${haskell:Provides},
-Description: ${haskell:ShortDescription}${haskell:ShortBlurb}
- ${haskell:LongDescription}
- .
- ${haskell:Blurb}

debian/copyright

@@ -1,32 +0,0 @@
-Format: http://www.debian.org/doc/packaging-manuals/copyright-format/1.0/
-Upstream-Name: postgrest
-Upstream-Contact: Joe Nelson <joe@begriffs.com>
-Source: https://hackage.haskell.org/package/postgrest
-
-Files: *
-Copyright: 2014-2015 Joe Nelson <joe@begriffs.com>
-License: Expat
-
-Files: debian/*
-Copyright: 2015 Fernando Ike <fike@midstorm.org>
-License: Expat
-
-License: Expat
- Permission is hereby granted, free of charge, to any person obtaining
- a copy of this software and associated documentation files (the
- "Software"), to deal in the Software without restriction, including
- without limitation the rights to use, copy, modify, merge, publish,
- distribute, sublicense, and/or sell copies of the Software, and to
- permit persons to whom the Software is furnished to do so, subject to
- the following conditions:
- .
- The above copyright notice and this permission notice shall be included
- in all copies or substantial portions of the Software.
- .
- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
- EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
- IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
- CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
- TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
- SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.

debian/haskell-postgrest-utils.install

@@ -1 +0,0 @@
-dist-ghc/build/postgrest/postgrest usr/bin

debian/postgrest-wrapper

@@ -1,8 +0,0 @@
-#!/bin/sh
-d=$(dirname $0)
-if [ -f /etc/default/postgrest ]; then
-	. /etc/default/postgrest
-fi
-POSTGREST_LOG=${POSTGREST_LOG:-/var/log/postgrest/postgrest.log}
-
-exec $d/postgrest "$@" >>$POSTGREST_LOG 2>&1 &

debian/postgrest.default

@@ -1,29 +0,0 @@
-# run service as
-#POSTGREST_USER=postgrest
-
-# log file
-#POSTGREST_LOG=/var/log/postgrest/postgrest.log
-
-# database host
-#POSTGREST_DBHOST=localhost
-
-# database host
-#POSTGREST_DBPORT=5432
-
-# database to use
-#POSTGREST_DBNAME=app
-
-# database user
-#POSTGREST_DBUSER=authenticator
-
-# database password
-#POSTGREST_DBPASS=
-
-# database pool
-#POSTGREST_POOL=10
-
-# jwt secret
-#POSTGREST_JWT_SECRET=secret
-
-# default schema
-#POSTGREST_SCHEMA=public

debian/postgrest.init.d

@@ -1,99 +0,0 @@
-#!/bin/sh
-### BEGIN INIT INFO
-# Provides:          postgrest
-# Required-Start:    $local_fs $network postgresql
-# Required-Stop:     $local_fs $network
-# Default-Start:     2 3 4 5
-# Default-Stop:      0 1 6
-# Description:       PostgreSQL REST API daemon
-### END INIT INFO
-
-. /lib/lsb/init-functions
-if test -f /etc/default/postgrest; then
-    . /etc/default/postgrest
-fi
-POSTGREST=/usr/local/bin/postgrest
-CONNECTION_STRING="postgres://"
-POSTGREST_OPTS=""
-POSTGREST_USER=${POSTGREST_USER:-postgrest}
-POSTGREST_PORT=${POSTGREST_PORT:-3000}
-POSTGREST_DBUSER=${POSTGREST_DBUSER:-authenticator}
-#POSTGREST_DBPASS=${POSTGREST_DBPASS:-authenticator}
-POSTGREST_DBHOST=${POSTGREST_DBHOST:-localhost}
-POSTGREST_DBPORT=${POSTGREST_DBPORT:-5432}
-POSTGREST_DBNAME=${POSTGREST_DBNAME:-app}
-POSTGREST_DBPOOL=${POSTGREST_DBPOOL:-10}
-POSTGREST_ANON=${POSTGREST_ANON:-anonymous}
-POSTGREST_JWT_SECRET=${POSTGREST_JWT_SECRET:-secret}
-POSTGREST_SCHEMA=${POSTGREST_SCHEMA:-public}
-
-CONNECTION_STRING="$CONNECTION_STRING$POSTGREST_DBUSER"
-if [ -n "$POSTGREST_DBPASS" ]; then
-	CONNECTION_STRING="$CONNECTION_STRING:$POSTGREST_DBPASS"
-fi
-CONNECTION_STRING="$CONNECTION_STRING@$POSTGREST_DBHOST:$POSTGREST_DBPORT/$POSTGREST_DBNAME"
-
-if [ -n "$POSTGREST_PORT" ]; then
-	POSTGREST_OPTS="$POSTGREST_OPTS --port $POSTGREST_PORT"
-fi
-
-if [ -n "$POSTGREST_POOL" ]; then
-	POSTGREST_OPTS="$POSTGREST_OPTS --pool $POSTGREST_POOL"
-fi
-if [ -n "$POSTGREST_JWT_SECRET" ]; then
-	#export POSTGREST_JWT_SECRET="$POSTGREST_JWT_SECRET"
-	POSTGREST_OPTS="$POSTGREST_OPTS --jwt-secret $POSTGREST_JWT_SECRET"
-fi
-if [ -n "$POSTGREST_SCHEMA" ]; then
-	POSTGREST_OPTS="$POSTGREST_OPTS --schema $POSTGREST_SCHEMA"
-fi
-if [ -n "$POSTGREST_ANON" ]; then
-	POSTGREST_OPTS="$POSTGREST_OPTS --anonymous $POSTGREST_ANON"
-fi
-
-#export CONNECTION_STRING="$CONNECTION_STRING"
-
-START_PARAMS="$CONNECTION_STRING $POSTGREST_OPTS"
-
-start()
-{
-	log_daemon_msg "Starting PostgreSQL REST API daemon" "postgrest" || true
-	if start-stop-daemon --start --quiet --oknodo --chuid ${POSTGREST_USER} --startas /usr/local/bin/postgrest-wrapper --exec $POSTGREST -- $START_PARAMS; then
-		log_end_msg 0 || true
-	else
-		log_end_msg 1 || true
-	fi
-}
-
-stop()
-{
-	log_daemon_msg "Stopping PostgreSQL REST API daemon" "postgrest" || true
-	if start-stop-daemon --stop --quiet --oknodo --exec $POSTGREST; then
-		log_end_msg 0 || true
-	else
-		log_end_msg 1 || true
-	fi
-}
-
-status()
-{
-	status_of_proc $POSTGREST postgrest && exit 0 || exit $?
-}
-
-case "$1" in
-start)
-	start
-	;;
-stop)
-	stop
-	;;
-restart)
-	stop
-	start
-	;;
-status)
-	status
-	;;
-*)
-	echo "Usage: $0 {start|stop|restart|status}"
-esac

debian/rules

@@ -1,10 +0,0 @@
-#!/usr/bin/make -f
-
-DEB_ENABLE_TESTS = yes
-DEB_CABAL_PACKAGE = postgrest
-DEB_DEFAULT_COMPILER = ghc
-
-include /usr/share/cdbs/1/rules/debhelper.mk
-include /usr/share/cdbs/1/class/hlibrary.mk
-
-build/haskell-postgrest-utils:: build-ghc-stamp

debian/source/format

@@ -1 +0,0 @@
-3.0 (quilt)

debian/watch

@@ -1,2 +0,0 @@
-version=3
-http://hackage.haskell.org/package/postgrest/distro-monitor .*-([0-9\.]+)\.(?:zip|tgz|tbz|txz|(?:tar\.(?:gz|bz2|xz)))

docker/Dockerfile

@@ -0,0 +1,45 @@
+FROM debian:jessie
+
+ARG POSTGREST_VERSION
+
+# Install libpq5
+RUN apt-get -qq update && \
+    apt-get -qq install -y --no-install-recommends libpq5 && \
+    apt-get -qq clean && \
+    rm -rf /var/lib/apt/lists/* /tmp/* /var/tmp/*
+
+# Install postgrest
+RUN BUILD_DEPS="curl ca-certificates xz-utils" && \
+    apt-get -qq update && \
+    apt-get -qq install -y --no-install-recommends $BUILD_DEPS && \
+    cd /tmp && \
+    curl -SLO https://github.com/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 / && \
+    apt-get -qq purge --auto-remove -y $BUILD_DEPS && \
+    apt-get -qq clean && \
+    rm -rf /var/lib/apt/lists/* /tmp/* /var/tmp/*
+
+COPY postgrest.conf /etc/postgrest.conf
+
+
+ENV PGRST_DB_URI= \
+    PGRST_DB_SCHEMA=public \
+    PGRST_DB_ANON_ROLE= \
+    PGRST_DB_POOL=100 \
+    PGRST_SERVER_HOST=*4 \
+    PGRST_SERVER_PORT=3000 \
+    PGRST_SERVER_PROXY_URI= \
+    PGRST_JWT_SECRET= \
+    PGRST_SECRET_IS_BASE64=false \
+    PGRST_JWT_AUD= \
+    PGRST_MAX_ROWS= \
+    PGRST_PRE_REQUEST= \
+    PGRST_ROLE_CLAIM_KEY=".role"
+
+# PostgREST reads /etc/postgrest.conf so map the configuration
+# file in when you run this container
+CMD exec postgrest /etc/postgrest.conf
+
+EXPOSE 3000

docker/config.conf

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

docker/distro_release/Dockerfile.centos6

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

docker/distro_release/Dockerfile.centos7

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

docker/distro_release/Dockerfile.ubuntu

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

docker/distro_release/Dockerfile.ubuntui386

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

docker/docker-compose.yml

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

docker/postgrest.conf

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

docs/CNAME

@@ -1 +0,0 @@
-postgrest.com

docs/admin/deployment.md

@@ -1,9 +0,0 @@
-## Deployment
-
-### Heroku
-
-#### Getting Started
-
-#### Using Amazon RDS
-
-### Debian

docs/admin/migration.md

@@ -1,9 +0,0 @@
-## Data Migration
-
-### Sqitch
-
-### Test-Driven Migrations
-
-#### Structural Tests
-
-#### Value Tests with pgTAP

docs/admin/performance.md

@@ -1,9 +0,0 @@
-## Performance
-
-### Benchmarks
-
-### Caching
-
-### Quality of Service
-
-### Tips

docs/admin/security.md

@@ -1,82 +0,0 @@
-## Security
-
-PostgREST is designed to keep the database at the center of API
-security. All authorization happens through database roles and
-permissions. It is PostgREST's job to *authenticate* requests --
-i.e. verify that a client is who they say they are -- and then let
-the database *authorize* client actions.
-
-We use [JSON Web Tokens](http://jwt.io/) to authenticate API requests.
-As you'll recall a JWT contains a list of cryptographically signed
-claims. PostgREST cares specifically about a claim called `role`.
-When request contains a valid JWT with a role claim PostgREST will
-switch to the database role with that name for the duration of the
-HTTP request.  If the client included no (or an invalid) JWT then
-PostgREST selects the "anonymous role" which is specified by a
-command line arguments to the server on startup.
-
-```js
-{
-  "role": "jdoe123"
-}
-
-// Encoded as JWT with a secret of "secret" this becomes
-// eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJyb2xlIjoiamRvZTEyMyJ9.X_ZeWSS9qsKDCDczv8C-GE2fccrPQjOh_ALMZJa5jsU
-```
-
-Using JWT allows us to authenticate with external services. A login
-service needs merely to share a JWT encryption secret with the
-PostgREST server. The secret is also a server command line option.
-
-It is even possible to generate JWT from inside a stored procedure
-in your database. Any SQL stored procedure that returns a type whose
-name ends in `jwt_claims` will have its return value encoded into
-JWT.  See the [User Management](http://postgrest.com/examples/users/)
-example for details.
-
-### Database Roles
-
-Suppose you start the server like this:
-
-```bash
-postgrest postgres://foo@localhost:5432/mydb --anonymous anon
-```
-
-This means that `foo` is the so-called *authenticator role* and
-`anon` is the anonymous role. When a new HTTP request arrives at the
-server the latter is connected to the database as user `foo`. If
-no JWT is present, or if it is invalid, or if it does not contain
-the role claim then the server changes to the anonymous role with
-the query
-
-```sql
-SET LOCAL ROLE anon;
-```
-
-Otherwise it sets the role to that specified by JWT. For security
-your authenticator role should have access to nothing except the
-ability to become other users. Supposing you have three roles, one
-for anonymous users, one for authors, and another for the authenticator,
-you would set it up like this
-
-```sql
-CREATE ROLE authenticator NOINHERIT LOGIN;
-CREATE ROLE anon;
-CREATE ROLE author;
-
-GRANT anon, author TO authenticator;
-```
-
-### Row-Level Security
-
-#### Simulated - PostgreSQL <9.5
-
-#### Real - PostgreSQL >=9.5
-
-### Building Auth on top of JWT
-
-#### Basic Auth
-
-#### Github Sign-in
-
-### SSL

docs/admin/versioning.md

@@ -1,9 +0,0 @@
-## API Versioning
-
-### Schema Search Path
-
-### Changing a Resource
-
-### Removing a Resource
-
-### Avoiding DB and Client Coupling

docs/api/reading.md

@@ -1,344 +0,0 @@
-## Requesting Information
-
-### Tables and Views
-
-* ✅ Cacheable, prefetchable
-* ✅ Idempotent
-
-The list of accessible tables and views is provided at
-
-```HTTP
-GET /
-```
-
-Every view and table accessible by the active db role is exposed
-in a one-level deep route. For instance the full contents of a table
-`people` is returned at
-
-```HTTP
-GET /people
-```
-
-There are no `deeply/nested/routes`. Each route provides `OPTIONS`,
-`GET`, `POST`, `PATCH`, and `DELETE` verbs depending entirely
-on database permissions.
-
-<div class="admonition note">
-  <p class="admonition-title">Design Consideration</p>
-
-  <p>Why not provide nested routes? Many APIs allow nesting to
-  retrieve related information, such as <code>/films/1/director</code>.
-  We offer a more flexible mechanism (inspired by GraphQL) to embed
-  related information. It can handle one-to-many and many-to-many
-  relationships. This is covered in the section about Embedding.</p>
-</div>
-
-### Stored Procedures
-
-* ❌ Cannot necessarily be cached or prefetched
-* ❌ Not necessarily idempotent
-
-Every stored procedure is accessible under the `/rpc` prefix. The
-API endpoint supports only POST which executes the function.
-
-```HTTP
-POST /rpc/proc_name
-```
-
-PostgREST supports calling procedures with [named
-arguments](http://www.postgresql.org/docs/9.4/static/sql-syntax-calling-funcs.html#SQL-SYNTAX-CALLING-FUNCS-NAMED).
-Include a JSON object in the request payload and each
-key/value of the object will become an argument.
-
-<div class="admonition note">
-  <p class="admonition-title">Design Consideration</p>
-
-  <p>Why the /rpc prefix? One reason is to avoid name collisions
-  between views and procedures. It also helps emphasize to API
-  consumers that these functions are not normal restful things.
-  The functions can have arbitrary and surprising behavior, not
-  the standard "post creates a resource" thing that users expect
-  from the other routes.</p>
-
-  <p>We considered allowing GET requests for functions that are
-  marked non-volatile but could not reconcile how to pass in
-  parameters. Query string arguments are reserved for shaping/filtering
-  the output, not providing input.</p>
-</div>
-
-
-
-### Filtering
-
-#### Filtering Rows
-
-You can filter result rows by adding conditions on columns, each
-condition a query string parameter.  For instance, to return people
-aged under 13 years old:
-
-```HTTP
-GET /people?age=lt.13
-```
-
-Adding multiple parameters conjoins the conditions:
-
-```HTTP
-GET /people?age=gte.18&student=is.true
-```
-
-These operators are available:
-
-abbreviation | meaning
------------- | -------
-eq           | equals
-gt           | greater than
-lt           | less than
-gte          | greater than or equal
-lte          | less than or equal
-like         | LIKE operator (use * in place of %)
-ilike        | ILIKE operator (use * in place of %)
-@@           | full-text search using to_tsquery
-is           | checking for exact equality (null,true,false)
-in           | one of a list of values e.g. `?a=in.1,2,3`
-not          | negates another operator, see below
-
-To negate any operator, prefix it with `not` like `?a=not.eq.2`.
-
-For more complicated filters (such as those involving condition 1
-*OR* condition 2) you will have to create a new view in the database.
-
-Filters may be applied to [computed
-columns](http://www.postgresql.org/docs/current/interactive/xfunc-sql.html#XFUNC-SQL-COMPOSITE-FUNCTIONS)
-as well as actual table/view columns, even though the computed
-columns will not appear in the output.
-
-#### Filtering Columns
-
-You can customize which columns are returned by using the `select`
-parameter:
-
-```HTTP
-GET /people?select=age,height,weight
-```
-
-To cast the column types, add a double colon
-
-```HTTP
-GET /people?select=age::text,height,weight
-```
-
-Not all type coercions are possible, and you will get an error
-describing any problems from selection or type casting.
-
-The `select` keyword is reserved. You thus cannot filter rows based
-on a column named select. Then again it is a reserved SQL keyword
-too, hence an unlikely column name.
-
-#### Inside JSONB
-
-PostgreSQL >=9.4.2 supports native JSON columns and can even index
-them by internal keys using the `jsonb` column type. PostgREST
-allows you to filter results by internal JSON object values. Use
-the single- and double-arrows to path into and obtain values, e.g.
-
-```HTTP
-GET /stuff?json_col->a->>b=eq.2
-```
-
-This query finds rows in `stuff` where `json_col->'a'->>'b'` is
-equal to 2 (or "2" -- it coerces as needed). The final arrow must
-be the double kind, `->>`, or else PostgREST will not attempt to
-look inside the JSON.
-
-### Ordering
-
-The reserved word `order` reorders the response rows.  It uses a
-comma-separated list of columns and directions:
-
-```HTTP
-GET /people?order=age.desc,height.asc
-```
-
-If no direction is specified it defaults to ascending order:
-
-```HTTP
-GET /people?order=age
-```
-
-If you care where nulls are sorted, add `nullsfirst` or `nullslast`:
-
-```HTTP
-GET /people?order=age.nullsfirst
-GET /people?order=age.desc.nullslast
-```
-
-You can also use [computed
-columns](http://www.postgresql.org/docs/current/interactive/xfunc-sql.html#XFUNC-SQL-COMPOSITE-FUNCTIONS)
-to order the results, even though the computed
-columns will not appear in the output.
-
-### Limiting and Pagination
-
-#### Pagination by Limit-Offset
-
-PostgREST uses HTTP range headers for limiting and describing the
-size of results. Every response contains the current range and total
-results:
-
-```
-Range-Unit: items
-Content-Range → 0-14/15
-```
-
-This means items zero through fourteen are returned out of a total
-of fifteen -- i.e. all of them. This information is available in
-every response and can help you render pagination controls on the
-client. This is a RFC7233-compliant solution that keeps the response
-JSON cleaner.
-
-The client can set the limit and offset of a request by setting the
-`Range` header. Translate the limit and offset into a range. To
-request the first five elements, include these request headers:
-
-```
-Range-Unit: items
-Range: 0-4
-```
-
-You can also use open-ended ranges for an offset with no limit:
-`Range: 10-`.
-
-#### Suppressing Counts
-
-Sometimes knowing the total row count of a query is unnecessary and
-only adds extra cost to the database query. So you can skip the
-count total using a ```Prefer``` header as:
-
-```
-Prefer: count=none
-```
-
-With count suppressed the PostgREST response will look like:
-
-```
-Range-Unit: items
-Content-Range → 0-14/*
-```
-
-### Embedding Foreign Entities
-
-To help you make fewer requests, PostgREST allows the embedding of
-traditional SQL relationships into a response. Suppose you have a
-`projects` table which references `clients` through a foreign key
-called `client_id`. When listing projects through the API you can
-have it embed the client within each project response. For example,
-
-```HTTP
-GET /projects?id=eq.1&select=id, name, clients{*}
-```
-
-Notice this is the same `select` keyword which is used to choose
-which columns to include. When a column name is followed by parentheses
-that means to fetch the entire record and nest it. You include a
-list of columns inside the parens, or asterisk to request all
-columns.
-
-The embedding works for 1-N, N-1, and N-N relationships. That means
-you could also ask for a client and all their projects:
-
-```HTTP
-GET /clients?id=eq.42&select=id, name, projects{*}
-```
-
-In the examples above we asked for all columns in the embedded resource
-but the the select query is recursive. You could for instance specify
-
-
-```HTTP
-GET /foo?select=x, y, bar{z, w, baz{*}}
-```
-
-You can select not only using table names, but also column names!
-To embed the same foreign key row from our client example earlier
-you could do the following:
-
-```HTTP
-GET /projects?id=eq.1&select=id, name, client_id{*}
-```
-
-In the response there will be a `client_id` object containing all
-the data for that row.
-
-However, a `client_id` object doesn't make a lot of sense, so you
-could do one of two things. Create a view which renames `client_id`
-to just `client` (this is the hard way), or just try `client{*}`
-in the select parameter! PostgREST supports smart ducktype checking
-for common foreign key names, so if your column name ends with
-`_id`, `_fk`, or any variation of the two (including camelcase)
-you can embed a row with just the name's beginning.
-
-So for a complete example:
-
-```HTTP
-GET /projects?id=eq.1&select=id, name, client{*}
-```
-
-Would embed in the `client` key the row referenced with `client_id`.
-
-<div class="admonition note">
-    <p class="admonition-title">Design Consideration</p>
-    <p>In order for this feature to work as expected after a schema change, PostgREST currently requires to be restarted.</p>
-</div>
-
-### Response Format
-
-Query responses default to JSON but you can get them in CSV as well. Just make your request with the header
-
-```HTTP
-Accept: text/csv
-```
-
-### Singular vs Plural
-
-Many APIs distinguish plural and singular resources, e.g.`/stories`
-vs `/stories/1`. Why do we use `/stories?id=eq.1`? It is because a
-single resource is for us a row determined by a primary key, and
-primary keys can be *compound* (meaning defined across more than
-one column). The common urls come from a degenerate case of simple
-(and overwhelmingly numeric) primary keys often introduced automatically
-be Object Relational Mapping.
-
-For consistency's sake all these endpoints return a JSON array,
-`/stories`, `/stories?genre=eq.mystery`, `/stories?id=eq.1`. They
-are all filtering a bigger array. However you might want the
-last one to return a single JSON object, not an array with one
-element. To request a singular response send the header
-`Prefer: plurality=singular`.
-
-### Data Schema
-
-As well as issuing a `GET /` to obtain a list of the tables, views,
-and stored procedures available, you can get more information about
-any particular endpoint.
-
-```HTTP
-OPTIONS /my_view
-```
-
-This will include the row names, their types, primary key
-information, and foreign keys for the given table or view.
-
-<div class="admonition danger">
-    <p class="admonition-title">Deprecation Warning</p>
-
-    <p>Although we currently use the OPTIONS verb for this, some
-    people <a
-    href="https://www.mnot.net/blog/2012/10/29/NO_OPTIONS">argue</a> that
-    this is inappropriate. We are considering a <code>describedby</code>
-    header link instead.</p>
-</div>
-
-### CORS
-
-PostgREST sets highly permissive cross origin resource sharing.  It
-accepts Ajax requests from any domain.

docs/api/writing.md

@@ -1,210 +0,0 @@
-## Updating Data
-
-### Record Creation
-
-* ❌ Cannot be cached or prefetched
-* ❌ Not idempotent
-
-To create a row in a database table post a JSON object whose keys
-are the names of the columns you would like to create. Missing keys
-will be set to default values when applicable.
-
-```HTTP
-POST /table_name
-{ "col1": "value1", "col2": "value2" }
-```
-
-The response will include a `Location` header describing where to
-find the new object. If you would like to get the full object back
-in the response to your request, include the header `Prefer:
-return=representation`. That way you won't have to make another
-HTTP call to discover properties that may have been filled in on
-the server side.
-
-### Bulk Insertion
-
-* ❌ Cannot be cached or prefetched
-* ❌ Not idempotent
-
-You can POST a JSON array or CSV to insert multiple rows in a single
-HTTP request. Note that using CSV requires less parsing on the server
-and is **much faster**.
-
-Example of CSV bulk insert. Simply post to a table route with
-`Content-Type: text/csv` and include the names of the columns as
-the first row. For instance
-
-```HTTP
-POST /people
-name,age,height
-J Doe,62,70
-Jonas,10,55
-```
-
-An empty field (`,,`) is coerced to an empty string and the reserved
-word `NULL` is mapped to the SQL null value. Note that there should
-be no spaces between the column names and commas.
-
-Example of JSON bulk insert. Send an array:
-
-```HTTP
-POST /people
-[
-  { "name": "J Doe", "age": 62, "height": 70 },
-  { "name": "Janus", "age": 10, "height": 55 }
-]
-```
-
-If you would like to get the full object back in the response to
-your request, include the header `Prefer: return=representation`.
-Chances are you only want certain information back, though, like
-created ids. You can pass a `select` parameter to affect the shape
-of the response (further documented in the [reading](/api/reading/)
-page). For instance
-
-```HTTP
-POST /people?select=id
-[...]
-```
-returns something like
-```json
-[ { "id": 1 }, { "id": 2 } ]
-```
-
-### Multiple Tables Insertion or Update
-
-The cleanest way to insert or update data into multiple tables using only one POST/PATCH request
-is to create a view that will join all target tables and present a single endpoint.
-In our example let's assume one users table and one companies table.
-In this case, we want a signup endpoint to create the first user within a company.
-And for this endpoint we want to insert with one request both user and company.
-
-```SQL
-CREATE TABLE companies (
-    id serial primary key,
-    name text unique
-);
-
-CREATE TABLE users (
-    id serial primary key,
-    name text not null,
-    pass text,
-    company_id integer not null references companies
-);
-```
-
-Having both tables created we create a view that joins them to be used
-as a ```/signup``` endpoint.
-
-```SQL
-CREATE VIEW signup AS
-    SELECT
-        c.name AS company_name,
-        u.name AS user_name,
-        u.pass
-    FROM
-        public.users u
-        JOIN public.companies c ON c.id = u.company_id;
-
-```
-
-After the signup view creation, we can issue ```GET``` requests to read data
-from users and companies, but any atempt to ```POST``` or ```PATCH``` data will fail.
-PostgreSQL won't allow any data change on views that have a ```JOIN``` 
-clause in their ```FROM``` without a proper ```INSTEAD OF``` trigger.
-So in the example bellow we create a trigger to allow insertion of data in the signup view.
-The trigger is a simple PL/pgSQL function that first inserts into the companies table and
-uses the newly create company_id to create its first user.
-
-
-```SQL
-CREATE FUNCTION signup()
-RETURNS trigger
-LANGUAGE plpgsql
-AS $$
-DECLARE
-  vcompany_id int;
-BEGIN
-  INSERT INTO companies (name) VALUES (new.company_name) RETURNING id INTO vcompany_id;
-  INSERT INTO users (name, pass, company_id) VALUES (new.user_name, new.pass, vcompany_id);
-RETURN new;
-END;
-$$;
-
-CREATE TRIGGER signup
-INSTEAD OF INSERT ON signup
-FOR EACH ROW
-EXECUTE PROCEDURE signup();
-```
-
-After the trigger creation we can issue a normal ```POST``` request to our signup endpoint:
-
-```HTTP
-POST /signup
-{ "company_name": "foo", "user_name": "bar" }
-```
-
-For an endpoint such as signup its usually not desirable to have a ```PATCH``` route for updates,
-and we will skip this example for the sake of brevity. But it would be implemented in a very
-similar way to our ```POST``` example.
-
-<div class="admonition note">
-    <p class="admonition-title">Design Consideration</p>
-
-    <p>It's advisable to create a separate trigger for <code>UPDATE</code> and <code>INSERT</code>
-    avoiding conditionals that decide which is the trigger current operation.
-    This makes it easier to change code for (or even disable) one operation without intefering with others while
-    improving readability.
-    </p>
-</div>
-
-### Bulk Updates
-
-* ❌ Cannot be cached or prefetched
-* ❌ Not idempotent
-
-To change parts of a resource or resources use the `PATCH` verb.
-For instance, here is how to mark all young people as children.
-
-```HTTP
-PATCH /people?age=lt.13
-{
-  "person_type": "child"
-}
-```
-
-This affects any rows matched by the url param filters, overwrites
-any fields specified in in the payload JSON and leaves the other
-fields unaffected. Note that although the payload is not in the
-JSON patch format specified by
-[RFC6902](https://tools.ietf.org/html/rfc6902), HTTP does not specify
-which patch format to use. Our format is more pleasant, meant for
-basic field replacements, and not at all "incorrect."
-
-### Deletion
-
-* ❌ Cannot be cached or prefetched
-* ✅ Idempotent
-
-Simply use the `DELETE` verb. All recors that match your filter
-will be removed. For instance deleting inactive users:
-
-```HTTP
-DELETE /user?active=is.false
-```
-
-### Protecting Dangerous Actions
-
-Notice that it is very easy to delete or update many records at
-once. In fact forgetting a filter will affect an entire table!
-
-<div class="admonition warning">
-    <p class="admonition-title">Invitation to Contribute</p>
-
-    <p>We would like to investigate nginx rules to guard dangerous
-    actions, perhaps requiring a confirmation header or query param
-    to perform the action.</p>
-
-    <p>You're invited to research this option and contribute to
-    this documentation.</p>
-</div>

docs/examples/blog.md

@@ -1,150 +0,0 @@
-## Multi-Tenant Blog
-
-In our blog app there will be anonymous users and authors. Each
-author can create and edit their own posts, and read (but not edit)
-the posts of other authors. Anonymous users cannot edit anything
-but can sign up for author accounts. Authors can also post comments
-on articles.
-
-This example builds off the previous previous [User Management](users/)
-one. We had previously created a signup and login system on top of
-JWT. We'll use this auth system for the blog. **Run the SQL in the
-previous example** first, before continuing with this example.
-
-For your convenience, the complete sql for the blog demo is
-[here](https://github.com/begriffs/postgrest/blob/master/schema-templates/blog.sql).
-You can try it out in this [vagrant
-image](https://github.com/ruslantalpa/blogdemo) as well.
-
-### Adding Blog-Specific Tables
-
-Storing the posts and comments is this simple. The comments do not
-form a tree, they are linear under a post.
-
-```sql
-create table if not exists
-posts (
-  id         bigserial primary key,
-  title      text not null,
-  body       text not null,
-  author     text not null references basic_auth.users (email)
-               on delete restrict on update cascade
-               default basic_auth.current_email(),
-  created_at timestamptz not null default current_date
-);
-
-create table if not exists
-comments (
-  id         bigserial primary key,
-  body       text not null,
-  author     text not null references basic_auth.users (email)
-               on delete restrict on update cascade
-               default basic_auth.current_email(),
-  post       bigint not null references posts (id)
-               on delete cascade on update cascade,
-  created_at timestamptz not null default current_date
-);
-```
-
-### Permissions
-
-On top of the `authenticator` and `anon` access granted in the
-previous example, blogs have an `author` role with extra permissions.
-
-```sql
-create role author;
-grant author to authenticator;
-
-grant usage on schema public, basic_auth to author;
-
--- authors can edit comments/posts
-grant select, insert, update, delete
-  on basic_auth.tokens, basic_auth.users to author;
-grant select, insert, update, delete
-  on table users, posts, comments to author;
-grant usage, select on sequence posts_id_seq, comments_id_seq to author;
-```
-
-To ensure that authors cannot edit each others' posts and comments
-we'll use [row-level
-security](http://www.postgresql.org/docs/9.5/static/ddl-rowsecurity.html).
-Note that it requires PostgreSQL 9.5 or later.
-
-```sql
-ALTER TABLE posts ENABLE ROW LEVEL SECURITY;
-drop policy if exists authors_eigenedit on posts;
-create policy authors_eigenedit on posts
-  using (true)
-  with check (
-    author = basic_auth.current_email()
-  );
-
-ALTER TABLE comments ENABLE ROW LEVEL SECURITY;
-drop policy if exists authors_eigenedit on comments;
-create policy authors_eigenedit on comments
-  using (true)
-  with check (
-    author = basic_auth.current_email()
-  );
-```
-
-Finally we need to modify the `users` view from the previous example.
-This is because all authors share a single db role. We could have
-chosen to assign a new role for every author (all inheriting from
-`author`) but we choose to tell them apart by their email addresses.
-The addition below prevents authors from seeing each others' info
-in the `users` view.
-
-
-```diff
-  create or replace view users as
-  select actual.role as role,
-         '***'::text as pass,
-         actual.email as email,
-         actual.verified as verified
-  from basic_auth.users as actual,
-       (select rolname
-          from pg_authid
-         where pg_has_role(current_user, oid, 'member')
-       ) as member_of
-  where actual.role = member_of.rolname
-+   and (
-+     actual.role <> 'author'
-+     or email = basic_auth.current_email()
-+   );
-```
-
-### Example client queries
-
-* Top ten most recent posts
-
-```HTTP
-  GET /posts?order=created_at.desc
-  Range: 0-9
-```
-
-* Single post (randomly chose id=1) with its comments
-
-```HTTP
-  GET /posts?id=eq.1&select=*,comments{*}
-```
-
-* Add a new post
-
-```HTTP
-  POST /posts
-  Authorization: Bearer [JWT TOKEN]
-
-  {
-    "title": "My first post",
-    "body": "Meh, forgot what I wanted to say."
-  }
-```
-
-### Conclusion
-
-Voilà, a blog API. Most of the code ended up being for defining
-security. Once you have set up an authentication system, the code
-to do application specific things like blog posts and comments is
-short.  All the front-end routes and verbs are created automatically
-for you.

docs/examples/external_auth.md

@@ -1,193 +0,0 @@
-## External Authentication
-
-API clients authenticate with [JSON Web Tokens](http://jwt.io).
-PostgREST does not support any other authentication mechanism
-directly, but they can be built on top. In this demo we will build
-a system that works with an external authentication server
-and integrates with a PostgREST server by sharing the same JWT secret.
-
-For a better understanding of JWT and PostgREST authentication system you should read
-the [User Management](users/) example as well.
-
-I'll use a [Rails](http://rubyonrails.org) application using [Devise](https://github.com/plataformatec/devise)
-just to make the example more concrete, but this could be replicated for
-any other external authentication system using the same principles.
-In case Rails is not your cup of tea you can continue reading and
-just skip the Ruby code samples. I'll also assume
-the use of JQuery for some client-side code samples for the sake of simplicity.
-
-I won't delve into Devise authentication details, for this would require a tutorial on its own,
-so I'm assuming that the reader's authentication system is already working.
-
-### Sharing the JWT Secret
-
-Allowing a third party to generate valid JWTs for your PostgREST API
-is just a matter of sharing a secret. So you need to give your authenticator
-software the same secret that was used in your API server under the ```--jwt-secret```
-parameter.
-
-This could be done easly using environment variables. You set a ```JWT_SECRET``` variable
-in the environment where you run your rails app and it will be accessible in the global
-variable ```ENV['JWT_SECRET']```.
-
-### User Model
-
-We will map each user in this example to two database roles.
-So our application users are either ```admin``` or ```customer```.
-If they are just visitors (not logged in) to our website they will be ```anonymous```.
-One way of mapping users is to add a field in our users table indicating their database role.
-I'll add a text field called role to my users table:
-
-```sql
-ALTER TABLE users ADD role text NOT NULL DEFAULT 'customer';
-```
-
-Besides the main user that PostgREST uses to connect to PostgreSQL
-and the anonymous user, we will need two aditional roles for our example:
-
-* admin - to be used by users that access all the system rows.
-* customer - to be used when user has restricted access to database rows.
-
-Bellow we have the commands to create all roles that will be used:
-```sql
-CREATE USER authenticator NOINHERIT;
-CREATE ROLE anonymous;
-CREATE ROLE admin;
-CREATE ROLE customer;
-
-GRANT customer, admin, anonymous TO authenticator;
-```
-
-### Generating a JWT
-
-Several libraries are available to generate JWT, you will find a very handy list in [their website](http://jwt.io)
-under **Libraries**.
-To continue our Rails example I'll use the ruby library [json_web_token](https://github.com/garyf/json_web_token).
-
-In order to make the gem available in my Rails project I add the following line to my Gemfile:
-
-```
-gem 'json_web_token'
-```
-
-Then we create a Rails controller to serve JWTs for my authenticated users.
-For this I just open a file ```app/controllers/api_tokens_controller.rb``` with the content:
-
-```ruby
-class ApiTokensController < ApplicationController
-  TOKEN_TTL = 1.hour
-
-  def show
-    unless ENV['JWT_SECRET'].present?
-      return render json: {error: "you need to have JWT_SECRET configured to get an API token"}, status: 500
-    end
-
-    unless current_user.present?
-      return render json: {error: "only authenticated users can request the API token"}, status: 401
-    end
-
-    expires_in TOKEN_TTL, public: false
-    render json: {token: jwt}, status: 200
-  end
-
-  private
-  def jwt
-    JsonWebToken.sign(claims, key: ENV['JWT_SECRET'])
-  end
-
-  def claims
-    # This token will expire 1 hour after being issued
-    {
-      role: current_user.role,
-      user_id: current_user.id.to_s,
-      exp: (Time.now + TOKEN_TTL).to_i
-    }
-  end
-end
-```
-
-<div class="admonition note">
-    <p class="admonition-title">Token Time to Live</p>
-    <p>
-    In the code above we leverage the HTTP time based cache headers to expire the
-    endpoint cache at the same time as the token. In this example we have a token
-    that will be refresh one hour after its issuing time.
-    That's why both are based on the <code>TOKEN_TTL</code> constant.
-    </p>
-</div>
-
-We also need to create a route in the ```config/routes.rb``` file:
-
-```ruby
-resource :api_token, only: [:show]
-```
-
-Now, any authenticated user in our rails application can request an api_token making a GET
-request to ```/api_token```. This endpoint will return a json object with one property
-whose value is the token the API requests should use.
-
-### Orders Endpoint
-
-Here is how to create a view to generate an endpoint ```/orders``` filtered by
-the logged in user:
-
-```sql
-ALTER DATABASE mydb SET postgrest.claims.user_id TO '';
-
-CREATE OR REPLACE FUNCTION current_user_id()
-RETURNS integer
-STABLE
-LANGUAGE SQL
-AS $$
-    SELECT nullif(current_setting('postgrest.claims.user_id'), '')::integer;
-$$;
-
-CREATE SCHEMA private;
-
-CREATE TABLE private.orders (
-    id serial primary key,
-    user_id int references users,
-    created_at timestamp not null default current_timestamp,
-    updated_at timestamp not null default current_timestamp
-);
-
-CREATE VIEW orders AS
-SELECT
-    id, user_id, created_at, updated_at
-FROM
-    private.orders o
-WHERE
-    current_user = 'admin' OR o.user_id = current_user_id();
-```
-
-<div class="admonition note">
-    <p class="admonition-title">DRY priviledge checking conditions</p>
-    <p>
-    You can encapsulate conditions that will be commonly used to check for privileges while reading a database row.
-    We used a function <code>current_user_id()</code> but we could add more conditions to functions
-    as the system becomes more complex.<br/>
-    Remeber to mark your functions as <code>STABLE</code> so that PostgreSQL can inline then while planning the query.
-    </p>
-</div>
-
-### Using the JWT
-
-Now whenever you are authenticated in your Rails application you can use some Javascript
- code to get the token and use it:
-```javascript
-$.getJSON('/api_token').done(function(data){
-    $.ajax('/orders', {'Authorization': 'Bearer ' + data.token}).done(function(data){
-        console.log('Visible Orders: ', data);
-    })
-}).fail(function(){
-    console.log('Error fetching API token');
-})
-```
-We could also store the token to avoid having to fetch it again in the same page.
-
-### Conclusion
-
-This section explained the implementation details for building an
-external authentication system working with PostgREST.
-With the previous [User Management](users/) example this should give a clearer
-idea of how to set up authentication for your API.

docs/examples/python-requests-jwt.md

@@ -1,40 +0,0 @@
-## Python Client for PostgREST API
-
-### Setup PostgreSQL
-
-This code relies on setting up the PostgreSQL auth functions and grants correctly first. Follow [these instructions](http://postgrest.com/examples/users/).
-
-After completing the PostgreSQL configuration, be sure to create a user with email, password, role, and verified flag. We'll use that user to login in the code below.
-
-### Setup PostgREST
-
-Next, setup PostgREST according to the documentation [http://postgrest.com/install/server/](here).
-
-### Setup Python Client
-
-Finally, we'll install and configure the python client. Follow the instructions in the [README](https://github.com/davidthewatson/postgrest_python_requests_client/blob/master/README.md). Be sure to set the [credentials](https://github.com/davidthewatson/postgrest_python_requests_client/blob/master/config.in#L3-L5) and [urls](https://github.com/davidthewatson/postgrest_python_requests_client/blob/master/config.in#L7-L9) in config.py.
-
-### Python Client Functions
-
-There are four primary functions to the python client:
-
-* login
-* construct_jwt_auth
-* get_result_size
-* get_range
-
-The *login* and *construct_jwt_auth* functions will be required for any REST client using a PostgREST server, since a JWT auth instance is presumed.
-
-The *get_result_size* and *get_range* functions are designed specifically for result sets where pagination is required. You can certainly use them for a single page result set that does not require pagination, but that may be overkill.
-
-### Login
-The [login function](https://github.com/davidthewatson/postgrest_python_requests_client/blob/master/client.py#L12-L17) takes email and password strings (credentials.email and credentials.password, respectively from the config.py) and return the response.
-
-### Construct JWT Auth
-The [construct_jwt_auth](https://github.com/davidthewatson/postgrest_python_requests_client/blob/master/client.py#L20-L23) function takes the auth response returned by the login function, retrieves the token in the response, and returns a JWT auth instance to the caller. The JWT auth instance can then be used for successive calls to the same PostgREST service.
-
-### Get Result Size
-The [get_result_size](https://github.com/davidthewatson/postgrest_python_requests_client/blob/master/client.py#L26-L30) function takes a JWT auth instance calls the URL at urls.data, extracts the size of the result set from the response object and returns the size.
-
-### Get Range
-The [get_range](https://github.com/davidthewatson/postgrest_python_requests_client/blob/master/client.py#L26-L30) function takes a beginning range, ending range, page size, and JWT auth instance, gets only that range of the available result set and returns JSON for that result set.

docs/examples/start.md

@@ -1,509 +0,0 @@
-## Getting Started
-
-### Your First (simple) API
-
-Let's start with the simplest thing possible. We will expose some tables directly for reading and writing by anyone.
-
-Start by making a database
-
-```sh
-createdb demo1
-```
-
-We'll set it up with a film example (courtesy of [Jonathan Harrington](http://blog.jonharrington.org/postgrest-introduction/)). Copy the following into your clipboard:
-
-```sql
-BEGIN;
-
-CREATE TABLE director
-(
-  name text NOT NULL PRIMARY KEY
-);
-
-CREATE TABLE film
-(
-  id serial PRIMARY KEY,
-  title text NOT NULL,
-  year date NOT NULL,
-  director text REFERENCES director (name)
-    ON UPDATE CASCADE ON DELETE CASCADE,
-  rating real NOT NULL DEFAULT 0,
-  language text NOT NULL
-);
-
-CREATE TABLE festival
-(
-  name text NOT NULL PRIMARY KEY
-);
-
-CREATE TABLE competition
-(
-  id serial PRIMARY KEY,
-  name text NOT NULL,
-  festival text NOT NULL REFERENCES festival (name)
-    ON UPDATE CASCADE ON DELETE CASCADE,
-  year date NOT NULL
-);
-
-CREATE TABLE film_nomination
-(
-  id serial PRIMARY KEY,
-  competition integer NOT NULL REFERENCES competition (id)
-    ON UPDATE NO ACTION ON DELETE NO ACTION,
-  film integer NOT NULL REFERENCES film (id)
-    ON UPDATE CASCADE ON DELETE CASCADE,
-  won boolean NOT NULL DEFAULT true
-);
-
-COMMIT;
-```
-
-Apply it to your new database by running
-
-```sh
-# On OS X
-pbpaste | psql demo1
-
-# Or Linux
-# xclip -selection clipboard -o | psql demo1
-```
-
-Start the PostgREST server and point it at the new database. (See the [installation instructions](/install/server/).)
-
-```sh
-postgrest postgres://postgres:@localhost:5432/demo1 -a postgres --schema public
-```
-
-<div class="admonition note">
-    <p class="admonition-title">Note about database users</p>
-
-    <p>If you installed PostgreSQL with Homebrew on Mac then the
-    database username may be your own login rather than
-    <code>postgres</code>.</p>
-</div>
-
-### Populating Data
-
-Let's use PostgREST to populate the database. Install a REST client such as [Postman](https://chrome.google.com/webstore/detail/postman/fhbjgbiflinjbdggehcddcbncdddomop?hl=en). Now let's insert some data as a bulk post in CSV format:
-
-```HTTP
-POST http://localhost:3000/festival
-Content-Type: text/csv
-
-name
-Venice Film Festival
-Cannes Film Festival
-```
-
-In Postman it will look like this
-
-![Festival bulk insert in postman](/img/post-festivals.png)
-
-Notice that the post type is `raw` and that `Content-Type: text/csv` set in the Headers tab.
-
-The server returns HTTP 201 Created. Because we inserted more than one item at once there is no `Location` header in the response. However sometimes you want to learn more about items which you just inserted. To have the server include the full results, include the header `Prefer: return=representation`.
-
-At this point if you send a GET request to `/festival` it should return
-
-```json
-[
-  {
-    "name": "Venice Film Festival"
-  },
-  {
-    "name": "Cannes Film Festival"
-  }
-]
-```
-
-Now that you've seen how to do a bulk insert, let's do some more and fully populate the database.
-
-Post the following to `/competition`:
-
-```csv
-name,festival,year
-Golden Lion,Venice Film Festival,2014-01-01
-Palme d'Or,Cannes Film Festival,2014-01-01
-```
-
-Now `/director`:
-
-```csv
-name
-Bertrand Bonello
-Atom Egoyan
-David Gordon Green
-Andrey Konchalovskiy
-Mario Martone
-Mike Leigh
-Roy Andersson
-Saverio Costanzo
-Alix Delaporte
-Jean-Pierre Dardenne
-Xiaoshuai Wang
-Kaan Müjdeci
-Tommy Lee Jones
-Nuri Bilge Ceylan
-Michel Hazanavicius
-Xavier Dolan
-Ramin Bahrani
-Alice Rohrwacher
-Andrew Niccol
-Rakhshan Bani-Etemad
-David Oelhoffen
-Bennett Miller
-David Cronenberg
-Shin'ya Tsukamoto
-Joshua Oppenheimer
-Olivier Assayas
-Jean-Luc Godard
-Alejandro González Iñárritu
-Benoît Jacquot
-Fatih Akin
-Francesco Munzi
-Ken Loach
-Abel Ferrara
-Xavier Beauvois
-Naomi Kawase
-```
-
-And `/film`:
-
-```csv
-title,year,director,rating,language
-Chuang ru zhe,2014-01-01,Xiaoshuai Wang,6.19999981,english
-The Look of Silence,2014-01-01,Joshua Oppenheimer,8.30000019,Indonesian
-Fires on the Plain,2014-01-01,Shin'ya Tsukamoto,5.80000019,Japanese
-Far from Men,2014-01-01,David Oelhoffen,7.5,english
-Good Kill,2014-01-01,Andrew Niccol,6.0999999,english
-Leopardi,2014-01-01,Mario Martone,6.9000001,english
-Sivas,2014-01-01,Kaan Müjdeci,7.69999981,english
-Black Souls,2014-01-01,Francesco Munzi,7.0999999,english
-Three Hearts,2014-01-01,Benoît Jacquot,5.80000019,French
-Pasolini,2014-01-01,Abel Ferrara,5.80000019,english
-Le dernier coup de marteau,2014-01-01,Alix Delaporte,6.5,english
-Manglehorn,2014-01-01,David Gordon Green,7.0999999,english
-Hungry Hearts,2014-01-01,Saverio Costanzo,6.4000001,English
-Belye nochi pochtalona Alekseya Tryapitsyna,2014-01-01,Andrey Konchalovskiy,6.9000001,Russian
-99 Homes,2014-01-01,Ramin Bahrani,7.30000019,english
-The Cut,2014-01-01,Fatih Akin,6,Armenian
-Birdman: Or (The Unexpected Virtue of Ignorance),2014-01-01,Alejandro González Iñárritu,8,English
-La rançon de la gloire,2014-01-01,Xavier Beauvois,5.69999981,French
-A Pigeon Sat on a Branch Reflecting on Existence,2014-01-01,Roy Andersson,7.19999981,english
-Tales,2014-01-01,Rakhshan Bani-Etemad,6.80000019,english
-The Wonders,2014-01-01,Alice Rohrwacher,6.80000019,Italian
-Foxcatcher,2014-01-01,Bennett Miller,7.19999981,English
-Mr. Turner,2014-01-01,Mike Leigh,7,English
-Jimmy's Hall,2014-01-01,Ken Loach,6.69999981,English
-The Homesman,2014-01-01,Tommy Lee Jones,6.5999999,English
-The Captive,2014-01-01,Atom Egoyan,5.9000001,english
-Goodbye to Language,2014-01-01,Jean-Luc Godard,6.19999981,French
-The Search,2014-01-01,Michel Hazanavicius,6.9000001,French
-Still the Water,2014-01-01,Naomi Kawase,6.9000001,Japanese
-Mommy,2014-01-01,Xavier Dolan,8.30000019,French
-"Two Days, One Night",2014-01-01,Jean-Pierre Dardenne,7.4000001,French
-Maps to the Stars,2014-01-01,David Cronenberg,6.4000001,English
-Saint Laurent,2014-01-01,Bertrand Bonello,6.5,French
-Clouds of Sils Maria,2014-01-01,Olivier Assayas,6.9000001,english
-Winter Sleep,2014-01-01,Nuri Bilge Ceylan,8.5,Turkish
-```
-
-Finally `/film_nomination`:
-
-```csv
-competition,film,won
-1,1,f
-1,2,f
-1,3,f
-1,4,f
-1,5,f
-1,6,f
-1,7,f
-1,8,f
-1,9,f
-1,10,f
-1,11,f
-1,12,f
-1,13,f
-1,14,f
-1,15,f
-1,16,f
-1,17,f
-1,18,f
-1,19,f
-1,20,f
-2,21,f
-2,22,f
-2,23,f
-2,24,f
-2,25,f
-2,26,f
-2,27,f
-2,28,f
-2,29,f
-2,30,f
-2,31,f
-2,32,f
-2,33,f
-2,34,f
-2,35,f
-```
-
-### Getting and Embedding Data
-
-First let's review which films are stored in the database:
-```http
-GET http://localhost:3000/film
-```
-It gives us back a list of JSON objects. What if we care only about the film titles? Use `select` to shape the output:
-
-```http
-GET http://localhost:3000/film?select=title
-```
-```json
-[
-  {
-    "title": "Chuang ru zhe"
-  },
-  {
-    "title": "The Look of Silence"
-  },
-  {
-    "title": "Fires on the Plain"
-  },
-  ...
-]
-```
-
-Here is where it gets cool. PostgREST can embed objects in its response through foreign key relationships. Earlier we created a join table called `film_nomination`. It joins films and competitions. We can ask the server about the structure of this table:
-
-```
-OPTIONS http://localhost:3000/film_nomination
-```
-
-```json
-{
-  "pkey": [
-    "id"
-  ],
-  "columns": [
-    {
-      "references": null,
-      "default": "nextval('film_nomination_id_seq'::regclass)",
-      "precision": 32,
-      "updatable": true,
-      "schema": "public",
-      "name": "id",
-      "type": "integer",
-      "maxLen": null,
-      "enum": [],
-      "nullable": false,
-      "position": 1
-    },
-    {
-      "references": {
-        "schema": "public",
-        "column": "id",
-        "table": "competition"
-      },
-      "default": null,
-      "precision": 32,
-      "updatable": true,
-      "schema": "public",
-      "name": "competition",
-      "type": "integer",
-      "maxLen": null,
-      "enum": [],
-      "nullable": false,
-      "position": 2
-    },
-    {
-      "references": {
-        "schema": "public",
-        "column": "id",
-        "table": "film"
-      },
-      "default": null,
-      "precision": 32,
-      "updatable": true,
-      "schema": "public",
-      "name": "film",
-      "type": "integer",
-      "maxLen": null,
-      "enum": [],
-      "nullable": false,
-      "position": 3
-    },
-    {
-      "references": null,
-      "default": "true",
-      "precision": null,
-      "updatable": true,
-      "schema": "public",
-      "name": "won",
-      "type": "boolean",
-      "maxLen": null,
-      "enum": [],
-      "nullable": false,
-      "position": 4
-    }
-  ]
-}
-```
-
-From this you can see that the columns `film` and `competition` reference their eponymous tables. Let's ask the server for each film along with names of the competitions it entered. You don't have to do any custom coding. Send this query:
-
-```http
-GET http://localhost:3000/film?select=title,competition{name}
-```
-
-```json
-[
-  {
-    "title": "Chuang ru zhe",
-    "competition": [
-      {
-        "name": "Golden Lion"
-      }
-    ]
-  },
-  {
-    "title": "The Look of Silence",
-    "competition": [
-      {
-        "name": "Golden Lion"
-      }
-    ]
-  },
-  ...
-]
-```
-
-The relation flows both ways. Here is how to get the name of each competition's name and the movies shown at it.
-
-```http
-GET http://localhost:3000/competition?select=name,film{title}
-```
-
-```json
-[
-  {
-    "name": "Golden Lion",
-    "film": [
-      {
-        "title": "Chuang ru zhe"
-      },
-      {
-        "title": "The Look of Silence"
-      },
-      ...
-    ]
-  },
-  {
-    "name": "Palme d'Or",
-    "film": [
-      {
-        "title": "The Wonders"
-      },
-      {
-        "title": "Foxcatcher"
-      },
-      ...
-    ]
-  }
-]
-```
-
-Why not learn about the directors too? There is a many-to-one relation directly between films and directors. We can alter our previous query to include directors in its results.
-
-
-```http
-GET http://localhost:3000/competition?select=name,film{title,director{*}}
-```
-
-```json
-[
-  {
-    "name": "Golden Lion",
-    "film": [
-      {
-        "title": "Manglehorn",
-        "director": {
-          "name": "David Gordon Green"
-        }
-      },
-      {
-        "title": "Belye nochi pochtalona Alekseya Tryapitsyna",
-        "director": {
-          "name": "Andrey Konchalovskiy"
-        }
-      },
-      ...
-    ]
-  },
-  ...
-]
-```
-
-### Singular Responses
-
-How do we ask for a single film, for instance the second one we inserted?
-
-```http
-GET http://localhost:3000/film?id=eq.2
-```
-It returns
-```json
-[
-  {
-    "id": 2,
-    "title": "The Look of Silence",
-    "year": "2014-01-01",
-    "director": "Joshua Oppenheimer",
-    "rating": 8.3,
-    "language": "Indonesian"
-  }
-]
-```
-
-Like any query, it gives us a result *set*, in this case an array with one element. However you and I know that `id` is a primary key, it will never return more than one result. We might want it returned as a JSON object, not an array. To express this preference include the header `Prefer: plurality=singular`. It will respond with
-
-
-```json
-{
-  "id": 2,
-  "title": "The Look of Silence",
-  "year": "2014-01-01",
-  "director": "Joshua Oppenheimer",
-  "rating": 8.3,
-  "language": "Indonesian"
-}
-```
-
-<div class="admonition note">
-    <p class="admonition-title">Why this approach to singular responses?</p>
-
-    <p>
-    PostgREST knows which columns comprise a primary key for a
-    table, so why not automatically choose plurality=singular when
-    these column filters are present? The fact is it could come as a
-    shock to a client that by adding one more filter condition it can
-    change the entire response format.
-    </p>
-    <p>
-    Then why not expose another kind of route such as /film/2 to indicate
-    one particular film? Because this does not accommodate compound keys.
-    The convention complects a plurality preference with table key
-    assumptions. We should separate concerns.
-    </p>
-    <p>
-    It turns out you can still have routes like /film/2.  Use a
-    proxy such as Nginx. It can rewrite routes such as /films/2
-    into /films?id=eq.2 and add the Prefer header to make the results
-    singular.
-    </p>
-</div>
-
-### Conclusion
-
-This tutorial showed how to create a database with a basic schema, run PostgREST, and interact with the API. The next tutorial will show how to enable security for a multi-tenant blogging API.

docs/examples/users.md

@@ -1,504 +0,0 @@
-## User Management
-
-API clients authenticate with [JSON Web Tokens](http://jwt.io).
-PostgREST does not support any other authentication mechanism
-directly, but they can be built on top. In this demo we will build
-a username and password system on top of JWT using only plpgsql.
-
-Future examples such as the multi-tenant blogging platform will use
-the results from this example for their auth. We will build a system
-for users to sign up, log in, manage their accounts, and for admins
-to manange other people's accounts. We will also see how to trigger
-outside events like sending password reset emails.
-
-Before jumping into the code, a little more about how the tokens
-work. Every JWT contains cryptographically signed *claims*. PostgREST
-cares specificaly about a claim called `role`. When a client includes
-a `role` claim PostgREST executes their request using that database
-role.
-
-How would a client include a role claim, or claims in general?
-Without knowing the server JWT secret a client cannot create a
-claim. The only place to get a JWT is from the PostgREST server or
-from another service sharing the secret and acting on its behalf.
-We'll use a stored procedure returning type `jwt_claims` which is
-a special type causing the server to encrypt and sign the return
-value.
-
-### Storing Users and Passwords
-
-We create a database schema especially for auth information. We'll
-also need the postgres extension
-[pgcrypto](http://www.postgresql.org/docs/current/static/pgcrypto.html).
-
-```sql
-create extension if not exists pgcrypto;
-
--- We put things inside the basic_auth schema to hide
--- them from public view. Certain public procs/views will
--- refer to helpers and tables inside.
-create schema if not exists basic_auth;
-```
-
-Next a table to store the mapping from usernames and passwords to
-database roles. The code below includes triggers and functions to
-encrypt the password and ensure the role exists.
-
-```sql
-create table if not exists
-basic_auth.users (
-  email    text primary key check ( email ~* '^.+@.+\..+$' ),
-  pass     text not null check (length(pass) < 512),
-  role     name not null check (length(role) < 512),
-  verified boolean not null default false
-  -- If you like add more columns, or a json column
-);
-
-create or replace function
-basic_auth.check_role_exists() returns trigger
-  language plpgsql
-  as $$
-begin
-  if not exists (select 1 from pg_roles as r where r.rolname = new.role) then
-    raise foreign_key_violation using message =
-      'unknown database role: ' || new.role;
-    return null;
-  end if;
-  return new;
-end
-$$;
-
-drop trigger if exists ensure_user_role_exists on basic_auth.users;
-create constraint trigger ensure_user_role_exists
-  after insert or update on basic_auth.users
-  for each row
-  execute procedure basic_auth.check_role_exists();
-
-create or replace function
-basic_auth.encrypt_pass() returns trigger
-  language plpgsql
-  as $$
-begin
-  if tg_op = 'INSERT' or new.pass <> old.pass then
-    new.pass = crypt(new.pass, gen_salt('bf'));
-  end if;
-  return new;
-end
-$$;
-
-drop trigger if exists encrypt_pass on basic_auth.users;
-create trigger encrypt_pass
-  before insert or update on basic_auth.users
-  for each row
-  execute procedure basic_auth.encrypt_pass();
-```
-
-With the table in place we can make a helper to check passwords.
-It returns the database role for a user if the email and password
-are correct.
-
-```sql
-create or replace function
-basic_auth.user_role(email text, pass text) returns name
-  language plpgsql
-  as $$
-begin
-  return (
-  select role from basic_auth.users
-   where users.email = user_role.email
-     and users.pass = crypt(user_role.pass, users.pass)
-  );
-end;
-$$;
-```
-
-### Password Reset
-
-When a user requests a password reset or signs up we create a token
-they will use later to prove their identity. The tokens go in this
-table.
-
-```sql
-drop type if exists token_type_enum cascade;
-create type token_type_enum as enum ('validation', 'reset');
-
-create table if not exists
-basic_auth.tokens (
-  token       uuid primary key,
-  token_type  token_type_enum not null,
-  email       text not null references basic_auth.users (email)
-                on delete cascade on update cascade,
-  created_at  timestamptz not null default current_date
-);
-```
-
-In the main schema (as opposed to the `basic_auth` schema) we expose
-a password reset request function. HTTP clients will call it. The
-function takes the email address of the user.
-
-```sql
-create or replace function
-request_password_reset(email text) returns void
-  language plpgsql
-  as $$
-declare
-  tok uuid;
-begin
-  delete from basic_auth.tokens
-   where token_type = 'reset'
-     and tokens.email = request_password_reset.email;
-
-  select gen_random_uuid() into tok;
-  insert into basic_auth.tokens (token, token_type, email)
-         values (tok, 'reset', request_password_reset.email);
-  perform pg_notify('reset',
-    json_build_object(
-      'email', request_password_reset.email,
-      'token', tok,
-      'token_type', 'reset'
-    )::text
-  );
-end;
-$$;
-```
-
-This function does not send any emails. It sends a postgres
-[NOTIFY](http://www.postgresql.org/docs/current/static/sql-notify.html)
-command. External programs such as a mailer listen for this event
-and do the work. The most robust way to process these signals is
-by pushing them onto work queues. Here are two programs to do that:
-
-1. [aweber/pgsql-listen-exchange](https://github.com/aweber/pgsql-listen-exchange) for RabbitMQ
-2. [SpiderOak/skeeter](https://github.com/SpiderOak/skeeter) for ZeroMQ
-
-For experimentation you don't need that though. Here's a sample
-Node program that listens for the events and logs them to stdout.
-
-```js
-var PS = require('pg-pubsub');
-
-if(process.argv.length !== 3) {
-  console.log("USAGE: DB_URL");
-  process.exit(2);
-}
-var url  = process.argv[2],
-    ps   = new PS(url);
-
-// password reset request events
-ps.addChannel('reset', console.log);
-// email validation required event
-ps.addChannel('validate', console.log);
-
-// modify me to send emails
-```
-
-Once the user has a reset token they can use it as an argument to
-the password reset function, calling it through the PostgREST RPC
-interface.
-
-```sql
-create or replace function
-reset_password(email text, token uuid, pass text)
-  returns void
-  language plpgsql
-  as $$
-declare
-  tok uuid;
-begin
-  if exists(select 1 from basic_auth.tokens
-             where tokens.email = reset_password.email
-               and tokens.token = reset_password.token
-               and token_type = 'reset') then
-    update basic_auth.users set pass=reset_password.pass
-     where users.email = reset_password.email;
-
-    delete from basic_auth.tokens
-     where tokens.email = reset_password.email
-       and tokens.token = reset_password.token
-       and token_type = 'reset';
-  else
-    raise invalid_password using message =
-      'invalid user or token';
-  end if;
-  delete from basic_auth.tokens
-   where token_type = 'reset'
-     and tokens.email = reset_password.email;
-
-  select uuid_generate_v4() into tok;
-  insert into basic_auth.tokens (token, token_type, email)
-         values (tok, 'reset', reset_password.email);
-  perform pg_notify('reset',
-    json_build_object(
-      'email', reset_password.email,
-      'token', tok
-    )::text
-  );
-end;
-$$;
-```
-
-### Email Validation
-
-This is similar to password resets. Once again we generate a token.
-It differs in that there is a trigger to send validations when a
-new login is added to the users table.
-
-```sql
-create or replace function
-basic_auth.send_validation() returns trigger
-  language plpgsql
-  as $$
-declare
-  tok uuid;
-begin
-  select uuid_generate_v4() into tok;
-  insert into basic_auth.tokens (token, token_type, email)
-         values (tok, 'validation', new.email);
-  perform pg_notify('validate',
-    json_build_object(
-      'email', new.email,
-      'token', tok,
-      'token_type', 'validation'
-    )::text
-  );
-  return new;
-end
-$$;
-
-drop trigger if exists send_validation on basic_auth.users;
-create trigger send_validation
-  after insert on basic_auth.users
-  for each row
-  execute procedure basic_auth.send_validation();
-```
-
-### Editing Own User
-
-We'll construct a redacted view for users. It hides passwords and
-shows only those users whose roles the currently logged in user has
-db permission to access.
-
-```sql
-create or replace view users as
-select actual.role as role,
-       '***'::text as pass,
-       actual.email as email,
-       actual.verified as verified
-from basic_auth.users as actual,
-     (select rolname
-        from pg_authid
-       where pg_has_role(current_user, oid, 'member')
-     ) as member_of
-where actual.role = member_of.rolname;
-  -- can also add restriction that current_setting('postgrest.claims.email')
-  -- is equal to email so that user can only see themselves
-```
-
-Using this view clients can see themeslves and any other users with
-the right db roles. This view does not yet support inserts or updates
-because not all the columns refer directly to underlying columns.
-Nor do we want it to be auto-updatable because it would allow an escalation
-of privileges. Someone could update their own row and change their
-role to become more powerful.
-
-We'll handle updates with a trigger, but we'll need a helper function
-to prevent an escalation of privileges.
-
-```sql
-create or replace function
-basic_auth.clearance_for_role(u name) returns void as
-$$
-declare
-  ok boolean;
-begin
-  select exists (
-    select rolname
-      from pg_authid
-     where pg_has_role(current_user, oid, 'member')
-       and rolname = u
-  ) into ok;
-  if not ok then
-    raise invalid_password using message =
-      'current user not member of role ' || u;
-  end if;
-end
-$$ LANGUAGE plpgsql;
-```
-
-With the above function we can now make a safe trigger to allow
-user updates.
-
-```sql
-create or replace function
-update_users() returns trigger
-language plpgsql
-AS $$
-begin
-  if tg_op = 'INSERT' then
-    perform basic_auth.clearance_for_role(new.role);
-
-    insert into basic_auth.users
-      (role, pass, email, verified)
-    values
-      (new.role, new.pass, new.email,
-      coalesce(new.verified, false));
-    return new;
-  elsif tg_op = 'UPDATE' then
-    -- no need to check clearance for old.role because
-    -- an ineligible row would not have been available to update (http 404)
-    perform basic_auth.clearance_for_role(new.role);
-
-    update basic_auth.users set
-      email  = new.email,
-      role   = new.role,
-      pass   = new.pass,
-      verified = coalesce(new.verified, old.verified, false)
-      where email = old.email;
-    return new;
-  elsif tg_op = 'DELETE' then
-    -- no need to check clearance for old.role (see previous case)
-
-    delete from basic_auth.users
-     where basic_auth.email = old.email;
-    return null;
-  end if;
-end
-$$;
-
-drop trigger if exists update_users on users;
-create trigger update_users
-  instead of insert or update or delete on
-    users for each row execute procedure update_users();
-```
-
-Finally add a public function people can use to sign up. You can
-hard code a default db role in it. It alters the underlying
-`basic_auth.users` so you can set whatever role you want without
-restriction.
-
-```sql
-create or replace function
-signup(email text, pass text) returns void
-as $$
-  insert into basic_auth.users (email, pass, role) values
-    (signup.email, signup.pass, 'hardcoded-role-here');
-$$ language sql;
-```
-
-### Generating JWT
-
-As mentioned at the start, clients authenticate with JWT. PostgREST
-has a special convention to allow your sql functions to return JWT.
-Any function that returns a type whose name ends in `jwt_claims` will
-have its return value encoded. For instance, let's make a login function
-which consults our users table.
-
-First create a return type:
-
-```sql
-drop type if exists basic_auth.jwt_claims cascade;
-create type basic_auth.jwt_claims AS (role text, email text);
-```
-
-And now the function:
-
-```sql
-create or replace function
-login(email text, pass text) returns basic_auth.jwt_claims
-  language plpgsql
-  as $$
-declare
-  _role name;
-  result basic_auth.jwt_claims;
-begin
-  select basic_auth.user_role(email, pass) into _role;
-  if _role is null then
-    raise invalid_password using message = 'invalid user or password';
-  end if;
-  -- TODO; check verified flag if you care whether users
-  -- have validated their emails
-  select _role as role, login.email as email into result;
-  return result;
-end;
-$$;
-```
-
-An API request to login would look like this.
-
-```HTTP
-POST /rpc/login
-
-{ "email": "foo@bar.com", "pass": "foobar" }
-```
-
-Response
-```json
-{
-  "token": "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJlbWFpbCI6ImZvb0BiYXIuY29tIiwicm9sZSI6ImF1dGhvciJ9.KHwYdK9dAMAg-MGCQXuDiFuvbmW-y8FjfYIcMrETnto"
-}
-```
-
-Try decoding the token at [jwt.io](http://jwt.io/). (It was encoded
-with a secret of `secret` which is the default.) To use this token
-in a future API request include it in an `Authorization` request
-header.
-
-```HTTP
-Authorization: Bearer eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJlbWFpbCI6ImZvb0BiYXIuY29tIiwicm9sZSI6ImF1dGhvciJ9.KHwYdK9dAMAg-MGCQXuDiFuvbmW-y8FjfYIcMrETnto
-```
-
-### Same-Role Users
-
-You may not want a separate db role for every user. You can distinguish
-one user from another in SQL by examining the JWT claims which
-PostgREST makes available in the SQL variable `postgrest.claims`.
-Here's a function to get the email of the currently authenticated
-user.
-
-```sql
-create or replace function
-basic_auth.current_email() returns text
-  language plpgsql
-  as $$
-begin
-  return current_setting('postgrest.claims.email');
-exception
-  -- handle unrecognized configuration parameter error
-  when undefined_object then return '';
-end;
-$$;
-```
-
-Remember that the `login` function set the claims `email` and `role`.
-You can modify `login` to set other claims as well if they are
-useful for your other SQL functions to reference later.
-
-### Permissions
-
-Basic table-level permissions. We'll add an the `authenticator`
-role which can't do anything itself other than switch into other
-roles as directed by JWT.
-
-```sql
-create role anon;
-create role authenticator noinherit;
-grant anon to authenticator;
-
-grant usage on schema public, basic_auth to anon;
-
--- anon can create new logins
-grant insert on table basic_auth.users, basic_auth.tokens to anon;
-grant select on table pg_authid, basic_auth.users to anon;
-grant execute on function
-  login(text,text),
-  request_password_reset(text),
-  reset_password(text,uuid,text),
-  signup(text, text)
-  to anon;
-```
-
-### Conclusion
-
-This section explained the implementation details for building a
-password based authentication system in pure sql. The next example
-will put it to work in a multi-tenant blogging API.

docs/index.md

@@ -1,91 +0,0 @@
-<style>
-.videoWrapper {
-  position: relative;
-  padding-bottom: 56.25%; /* 16:9 */
-  padding-top: 25px;
-  height: 0;
-}
-.videoWrapper iframe {
-  position: absolute;
-  top: 0;
-  left: 0;
-  width: 100%;
-  height: 100%;
-}
-</style>
-![PostgREST logo](img/logo.png)
-
-## Introduction
-
-PostgREST is a standalone web server that turns your database directly into a RESTful API. The structural constraints and permissions in the database determine the API endpoints and operations.
-
-This guide explains how to install the software and provides practical examples of its use. You'll learn how to build a fast, versioned, secure API and how to deploy it to production.
-
-The project has a friendly and growing community. Here are some ways to get help or get involved:
-
-* The project [chat room](https://gitter.im/begriffs/postgrest)
-* Report or search [issues](https://github.com/begriffs/postgrest/issues)
-
-### Motivation
-
-Using PostgREST is an alternative to manual CRUD programming. Custom API servers suffer problems. Writing business logic often duplicates, ignores or hobbles database structure. Object-relational mapping is a leaky abstraction leading to slow imperative code. The PostgREST philosophy establishes a single declarative source of truth: the data itself.
-
-#### Declarative Programming
-
-It's easier to ask Postgres to join data for you and let its query planner figure out the details than to loop through rows yourself. It's easier to assign permissions to db objects than to add guards in controllers. (This is especially true for cascading permissions in data dependencies.) It's easier set constraints than to litter code with sanity checks.
-
-#### Leakproof Abstraction
-
-There is no ORM involved. Creating new views happens in SQL with known performance implications. A database administrator can now create an API from scratch with no custom programming. 
-
-#### Embracing the Relational Model
-
-In 1970 E. F. Codd criticized the then-dominant hierarchical model of databases in his article <a href="https://www.seas.upenn.edu/~zives/03f/cis550/codd.pdf">A Relational Model of Data for Large Shared Data Banks</a>. Reading the article reveals a striking similarity between hierarchical databases and nested http routes. With PostgREST we attempt to use flexible filtering and embedding rather than nested routes.
-
-#### One Thing Well
-
-PostgREST has a focused scope. It works well with other tools like Nginx. This forces you to cleanly separate the data-centric CRUD operations from other concerns. Use a collection of sharp tools rather than building a big ball of mud.
-
-#### Shared Improvements
-
-As with any open source project, we all gain from features and fixes in the tool. It's more beneficial than improvements locked inextricably within custom codebases.
-
-### Intro Video
-
-Some things have changed since this video was created but the basics are the same. Learn the big vision behind automating APIs.
-
-<div class="videoWrapper">
-<iframe src="https://player.vimeo.com/video/115668217" frameborder="0" webkitallowfullscreen mozallowfullscreen allowfullscreen></iframe>
-</div>
-
-### Myths
-
-#### You have to make tons of stored procs and triggers
-
-Modern PostgreSQL features like auto-updatable views and computed columns make this mostly unnecessary. Triggers do play a part, but generally not for irksome boilerplate. When they are required triggers are preferable to ad-hoc app code anyway, since the former work reliably for any codepath.
-
-#### Exposing the database destroys encapsulation
-
-PostgREST does versioning through database schemas. This allows you to expose tables and views without making the app brittle. Underlying tables can be superseded and hidden behind public facing views. The chapter about versioning shows how to do this.
-
-### Conventions
-
-This guide contains highlighted notes and tangential information interspersed with the text.
-
-<div class="admonition note">
-    <p class="admonition-title">Design Consideration</p>
-
-    <p>Contains history which informed the current design. Sometimes it discusses unavoidable tradeoffs or a point of theory.</p>
-</div>
-
-<div class="admonition warning">
-    <p class="admonition-title">Invitation to Contribute</p>
-
-    <p>Points out things we know we want to add or improve. They might give you ideas for ways to contribute to the project.</p>
-</div>
-
-<div class="admonition danger">
-    <p class="admonition-title">Deprecation Warning</p>
-
-    <p>Alerts you to features which will be removed in the next major (breaking) release.</p>
-</div>

docs/install/ecosystem.md

@@ -1,26 +0,0 @@
-## Ecosystem
-
-### Client-Side Libraries
-
-* [calebmer/postgrest-client](https://github.com/calebmer/postgrest-client) - Advanced JS client for the PostgREST API
-* [mithril.postgrest](https://github.com/catarse/mithril.postgrest) - Mithril plugin to create and authenticate requests
-* [lewisjared/postgrest-request](https://github.com/lewisjared/postgrest-request) - node interface to postgrest instances
-* [JarvusInnovations/jarvus-postgrest-apikit](https://github.com/JarvusInnovations/jarvus-postgrest-apikit) - Sencha framework package for binding models/stores/proxies to PostgREST tables
-* [davidthewatson/postgrest_python_requests_client](https://github.com/davidthewatson/postgrest_python_requests_client) - python client featuring JWT auth and pagination of result sets
-
-### Extensions
-
-* [srid/spas](https://github.com/srid/spas) - allow file uploads and basic auth
-
-### Example Apps
-
-* [ruslantalpa/blogdemo](https://github.com/ruslantalpa/blogdemo) - blog api demo in a vagrant image
-* [timwis/ext-postgrest-crud](https://github.com/timwis/ext-postgrest-crud) - browser-based spreadsheet
-* [srid/chronicle](https://github.com/srid/chronicle#deploying-to-heroku) - tracking a tree of personal memories
-* [begriffs/postgrest-example](https://github.com/begriffs/postgrest-example) - how to configure a db for use as an API
-* [marmelab/ng-admin-postgrest](https://github.com/marmelab/ng-admin-postgrest) - automatic database admin panel
-* [tyrchen/goodfilm](https://github.com/tyrchen/goodfilm) - example film api
-
-### In Production
-
-* [Catarse](https://www.catarse.me/)

docs/install/server.md

@@ -1,180 +0,0 @@
-## Installation
-
-### Installing from Pre-Built Release
-
-The [release page](https://github.com/begriffs/postgrest/releases/latest)
-has precompiled binaries for Mac OS X, Windows, and several Linux
-distros.  Extract the tarball and run the binary inside with no
-arguments to see usage instructions:
-
-```sh
-# Untar the release (available at https://github.com/begriffs/postgrest/releases/latest)
-
-$ tar zxf postgrest-[version]-[platform].tar.xz
-
-# Try running it
-$ ./postgrest
-
-# You should see a usage help message
-```
-
-<div class="admonition warning">
-    <p class="admonition-title">Invitation to Contribute</p>
-
-    <p>I currently build the binaries manually for each architecture.
-    It would be nice to set up an automated build matrix for various
-    architectures. It should support Mac, Windows and 32- and 64-bit
-    versions of
-
-    <ul><li>Scientific Linux 6</li><li>CentOS</li><li>RHEL 6</li></ul></p>
-</div>
-
-### Building from Source
-
-When a prebuilt binary does not exist for your system you can build
-the project from source. You'll also need to do this if you want
-to help with development.
-[Stack](https://github.com/commercialhaskell/stack) makes it easy.
-It will install any necessary Haskell dependencies on your system.
-
-* [Install Stack](http://docs.haskellstack.org/en/stable/README.html#how-to-install) for your platform
-```bash
-#ubuntu example
-#See the link above for other operating systems
-
-wget -q -O- https://s3.amazonaws.com/download.fpcomplete.com/ubuntu/fpco.key | sudo apt-key add -
-echo 'deb http://download.fpcomplete.com/ubuntu/trusty stable main'|sudo tee /etc/apt/sources.list.d/fpco.list
-sudo apt-get update && sudo apt-get install stack -y
-```
-* Install libpq-dev
-```
-sudo apt-get install -y libpq-dev
-```
-* Build & install in one step
-
-```bash
-git clone https://github.com/begriffs/postgrest.git
-cd postgrest
-sudo stack install --install-ghc --local-bin-path /usr/local/bin
-```
-
-* Run the server
-
-If you want to run the test suite, stack can do that too: `stack test`.
-
-### Running the Server
-
-```bash
-postgrest postgres://user:pass@host:port/db -a anon_user [other flags]
-```
-
-The user in the connection string is the "authenticator role," i.e.
-a role which is used temporarily to switch into other roles depending
-on the authentication request JWT. For simple API's you can use the
-same role for authenticator and anonymous.
-
-The complete list of options:
-
-<dl>
-<dt>-p, --port</dt>
-<dd>The port on which the server will listen for HTTP requests.
-    Defaults to 3000.</dd>
-
-<dt>-a, --anonymous (required)</dt>
-<dd>The database role used to execute commands for those requests
-    which provide no JWT authorization.</dd>
-
-<dt>-s, --schema</dt>
-<dd>The db schema which you want to expose as an API. For historical
-    reasons it defaults to <code>1</code>, but you're more likely
-    to want to choose a value of <code>public</code>.</dd>
-
-<dt>-j, --jwt-secret</dt>
-<dd>The secret passphrase used to encrypt JWT tokens. Defaults to
-    <code>secret</code> but do not use the default in production!
-    Load-balanced PostgREST servers should share the same secret.</dd>
-
-<dt>-p, --pool</dt>
-<dd>Max connections to use in db pool. Defaults to to 10, but you
-    should find an optimal value for your db by running the SQL
-    command <code>show max_connections;</code></dd>
-
-<dt>-m, --max-rows</dt>
-<dd>Max number of rows to return in a read request. The default is
-    no limit.</dd>
-</dl>
-
-<div class="admonition note">
-    <p class="admonition-title">Hiding Password from Process List</p>
-
-    <p>Passing the database password and JWT secret as naked
-    parameters might not be a good idea because the parameters are
-    visible in a <code>ps</code> listing. One solution is to set
-    environment variables such as PASS and use <code>$PASS</code>
-    in the connection string.  Another is to use a user-specific
-    <a
-    href="http://www.postgresql.org/docs/current/static/libpq-pgpass.html">.pgpass</a>
-    file.</p>
-</div>
-
-When running `postgrest` on the same machine as PostgreSQL, it is also
-possible to connect to the database using the [Unix socket]
-(https://en.wikipedia.org/wiki/Unix_domain_socket) and the
-[Peer Authentication method]
-(http://www.postgresql.org/docs/current/static/auth-methods.html#AUTH-PEER)
-as an alternative to TCP/IP communication and authentication with a password.
-
-The Peer Authentication grants access to the database to any Unix user
-who connects as a user of the same name in the database.
-Since the empty host resolves to the Unix socket]
-(http://www.postgresql.org/docs/current/static/libpq-connect.html#AEN42494)
-and the password can be omitted in this case,
-the command line is reduced to:
-
-```sh
-sudo -u user postgrest postgres://user@/db [flags]
-```
-
-where the `sudo -u user` command runs the following command as given `user`.
-
-If you create a Unix user `postgrest` and a database user `postgrest`
-for example, the command becomes:
-
-```sh
-sudo -u postgrest postgrest postgres://postgrest@/db [flags]
-```
-
-The first `postgrest` is the Unix user name, the second `postgrest`
-is the name of the executable, the third `postgrest` is the name
-of the database user.
-
-### Install via Homebrew (Mac OS X)
-
-You can use the Homebrew package manager to install PostgREST on Mac
-
-```bash
-# Ensure brew is up to date
-brew update
-
-# Check for any problems with brew's setup
-brew doctor
-
-# Install the postgrest package
-brew install postgrest
-```
-
-This will automatically install PostgreSQL as a dependency (see the [Installing PostgreSQL](#installing-postgresql) section for setup instructions). The process tends to take up to 15 minutes to install the package and its dependencies.
-
-After installation completes, the tool is added to your $PATH and can be used from anywhere with:
-
-```bash
-postgrest --help
-```
-
-### Installing PostgreSQL
-
-To use PostgREST you will need an underlying database (PostgreSQL version 9.3 or greater is required). You can use something like Amazon [RDS](https://aws.amazon.com/rds/) but installing your own locally is cheaper and more convenient for development.
-
-* [Instructions for OS X](http://exponential.io/blog/2015/02/21/install-postgresql-on-mac-os-x-via-brew/)
-* [Instructions for Ubuntu 14.04](https://www.digitalocean.com/community/tutorials/how-to-install-and-use-postgresql-on-ubuntu-14-04)
-* [Installer for Windows](http://www.enterprisedb.com/products-services-training/pgdownload#windows)

main/Main.hs

@@ -0,0 +1,280 @@
+{-# LANGUAGE CPP #-}
+
+module Main where
+
+
+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
+
+{-|
+  The purpose of this worker is to fill the refDbStructure created in 'main'
+  with the 'DbStructure' returned from calling 'getDbStructure'. This method
+  is meant to be called by multiple times by the same thread, but does nothing if
+  the previous invocation has not terminated. In all cases this method does not
+  halt the calling thread, the work is preformed in a separate thread.
+
+  Note: 'atomicWriteIORef' is essentially a lazy semaphore that prevents two
+  threads from running 'connectionWorker' at the same time.
+
+  Background thread that does the following :
+  1. Tries to connect to pg server and will keep trying until success.
+  2. Checks if the pg version is supported and if it's not it kills the main
+     program.
+  3. Obtains the dbStructure.
+  4. If 2 or 3 fail to give their result it means the connection is down so it
+     goes back to 1, otherwise it finishes his work successfully.
+-}
+connectionWorker
+  :: ThreadId -- ^ This thread is killed if pg version is unsupported
+  -> P.Pool   -- ^ The PostgreSQL connection pool
+  -> Schema   -- ^ Schema PostgREST is serving up
+  -> IORef (Maybe DbStructure) -- ^ mutable reference to 'DbStructure'
+  -> IORef Bool                -- ^ Used as a binary Semaphore
+  -> IO ()
+connectionWorker mainTid pool schema refDbStructure refIsWorkerOn = do
+  isWorkerOn <- readIORef refIsWorkerOn
+  unless isWorkerOn $ do
+    atomicWriteIORef refIsWorkerOn True
+    void $ forkIO work
+  where
+    work = do
+      atomicWriteIORef refDbStructure Nothing
+      putStrLn ("Attempting to connect to the database..." :: Text)
+      connected <- connectingSucceeded pool
+      when connected $ do
+        result <- P.use pool $ do
+          actualPgVersion <- getPgVersion
+          unless (actualPgVersion >= minimumPgVersion) $ liftIO $ do
+            hPutStrLn stderr
+              ("Cannot run in this PostgreSQL version, PostgREST needs at least "
+              <> pgvName minimumPgVersion)
+            killThread mainTid
+          dbStructure <- getDbStructure schema actualPgVersion
+          liftIO $ atomicWriteIORef refDbStructure $ Just dbStructure
+        case result of
+          Left e -> do
+            putStrLn ("Failed to query the database. Retrying." :: Text)
+            hPutStrLn stderr (toS $ encodeError e)
+            work
+          Right _ -> do
+            atomicWriteIORef refIsWorkerOn False
+            putStrLn ("Connection successful" :: Text)
+
+{-|
+  Used by 'connectionWorker' to check if the provided db-uri lets
+  the application access the PostgreSQL database. This method is used
+  the first time the connection is tested, but only to test before
+  calling 'getDbStructure' inside the 'connectionWorker' method.
+
+  The connection tries are capped, but if the connection times out no error is
+  thrown, just 'False' is returned.
+-}
+connectingSucceeded :: P.Pool -> IO Bool
+connectingSucceeded pool =
+  retrying (capDelay 32000000 $ exponentialBackoff 1000000)
+           shouldRetry
+           (const $ P.release pool >> isConnectionSuccessful)
+  where
+    isConnectionSuccessful :: IO Bool
+    isConnectionSuccessful = do
+      testConn <- P.use pool $ H.sql "SELECT 1"
+      case testConn of
+        Left e -> hPutStrLn stderr (toS $ encodeError e) >> pure False
+        _ -> pure True
+    shouldRetry :: RetryStatus -> Bool -> IO Bool
+    shouldRetry rs isConnSucc = do
+      delay <- pure $ fromMaybe 0 (rsPreviousDelay rs) `div` 1000000
+      itShould <- pure $ not isConnSucc
+      when itShould $
+        putStrLn $ "Attempting to reconnect to the database in " <> (show delay::Text) <> " seconds..."
+      return itShould
+
+{-|
+  This is where everything starts.
+-}
+main :: IO ()
+main = do
+  --
+  -- LineBuffering: the entire output buffer is flushed whenever a newline is
+  -- output, the buffer overflows, a hFlush is issued or the handle is closed
+  --
+  -- NoBuffering: output is written immediately and never stored in the buffer
+  hSetBuffering stdout LineBuffering
+  hSetBuffering stdin LineBuffering
+  hSetBuffering 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) -- is the db-uri
+      roleClaimKey = configRoleClaimKey conf
+      appSettings =
+        setHost ((fromString . toS) host) -- Warp settings
+        . setPort port
+        . setServerName (toS $ "postgrest/" <> prettyVersion) $
+        defaultSettings
+
+  -- 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
+  --
+  -- 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
+        P.release pool
+        throwTo mainTid UserInterrupt
+      ) 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 = getCurrentTime}
+
+  -- 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
+    --
+    -- 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 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}
+    --
+    -- replace: Replace every occurrence of one substring with another
+    replaceUrlChars =
+      replace "_" "/" . replace "-" "+" . replace "." "="

mkdocs.yml

@@ -1,28 +0,0 @@
-site_name: PostgREST
-site_url: http://postgrest.com
-site_description: Building declarative APIs
-site_author: Joe Nelson
-site_favicon: favicon.ico
-
-repo_url: https://github.com/begriffs/postgrest
-
-pages:
-- Home: index.md
-- Install:
-  - The Server: install/server.md
-  - Ecosystem: install/ecosystem.md
-- API:
-  - Reading: api/reading.md
-  - Writing: api/writing.md
-- Admin:
-  - Security: admin/security.md
-  - Versioning: admin/versioning.md
-  - Migration: admin/migration.md
-  - Deployment: admin/deployment.md
-  - Performance: admin/performance.md
-- Examples:
-  - Getting Started: examples/start.md
-  - User Management: examples/users.md
-  - Multi-Tenant Blog: examples/blog.md
-  - External Authentication: examples/external_auth.md
-  - Python Client:  examples/python-requests-jwt.md

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.3.0.4
+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
@@ -22,79 +24,65 @@ Flag CI
   Default:     False
 
 executable postgrest
-  main-is:             PostgREST/Main.hs
-  default-extensions:  OverloadedStrings, ScopedTypeVariables, QuasiQuotes, LambdaCase
-  ghc-options:         -threaded -rtsopts -with-rtsopts=-N
+  main-is:             Main.hs
+  default-extensions:  OverloadedStrings, QuasiQuotes, NoImplicitPrelude
+  ghc-options:
+    -threaded
+    -rtsopts
+    "-with-rtsopts=-N -I2"
   default-language:    Haskell2010
-  build-depends:       aeson >= 0.8 && < 0.10
-                     , base >= 4.8 && < 5
-                     , bytestring
-                     , case-insensitive
-                     , cassava
-                     , containers
-                     , contravariant
-                     , errors
-                     , hasql >= 0.19.3.3 && < 0.20
-                     , http-types
-                     , interpolatedstring-perl6
-                     , jwt
-                     , optparse-applicative >= 0.11 && < 0.13
-                     , parsec
+  build-depends:       auto-update
+                     , base >= 4.8 && < 4.10
+                     , hasql == 1.1
+                     , hasql-pool == 0.4.3
                      , postgrest
-                     , regex-tdfa
-                     , resource-pool
-                     , safe >= 0.3 && < 0.4
-                     , scientific
-                     , string-conversions
+                     , protolude == 0.2.2
                      , text
                      , time
-                     , unordered-containers
-                     , vector
-                     , wai >= 3.0.1
-                     , wai-cors
-                     , wai-extra
-                     , wai-middleware-static >= 0.6.0
-                     , warp >= 3.1.0
-                     , HTTP
-                     , Ranged-sets
+                     , warp
+                     , bytestring
+                     , base64-bytestring
+                     , retry
   if !os(windows)
-    build-depends:     unix >= 2.7 && < 3
+    build-depends:     unix
 
-  hs-source-dirs:      src
-  other-modules:       Paths_postgrest
-                     , PostgREST.App
-                     , PostgREST.Auth
-                     , PostgREST.Config
-                     , PostgREST.Error
-                     , PostgREST.Middleware
-                     , PostgREST.Parsers
-                     , PostgREST.DbStructure
-                     , PostgREST.QueryBuilder
-                     , PostgREST.RangeQuery
-                     , PostgREST.ApiRequest
-                     , PostgREST.Types
+  hs-source-dirs:      main
 
 library
   default-language:    Haskell2010
-  default-extensions:  OverloadedStrings, ScopedTypeVariables, QuasiQuotes
+  default-extensions:  OverloadedStrings, QuasiQuotes, NoImplicitPrelude
   build-depends:       aeson
-                     , base >=4.6 && <5
+                     , ansi-wl-pprint
+                     , base >= 4.8 && < 4.10
+                     , base64-bytestring
                      , bytestring
                      , case-insensitive
                      , cassava
+                     , configurator-ng == 0.0.0.1
                      , containers
                      , contravariant
-                     , errors
-                     , hasql
+                     , contravariant-extras
+                     , either
+                     , gitrev
+                     , hasql == 1.1
+                     , hasql-pool == 0.4.3
+                     , hasql-transaction == 0.5.2
+                     , heredoc
+                     , HTTP
                      , http-types
+                     , insert-ordered-containers
                      , interpolatedstring-perl6
-                     , jwt
-                     , optparse-applicative
+                     , jose == 0.7.0.0
+                     , lens
+                     , lens-aeson
+                     , network-uri
+                     , optparse-applicative >= 0.13 && < 0.15
                      , parsec
+                     , protolude == 0.2.2
+                     , Ranged-sets == 0.3.0
                      , regex-tdfa
-                     , safe
                      , scientific
-                     , string-conversions
+                     , swagger2
                      , text
                      , time
                      , unordered-containers
@@ -103,81 +91,83 @@ library
                      , wai-cors
                      , wai-extra
                      , wai-middleware-static
-                     , HTTP
-                     , Ranged-sets
+                     , cookie
 
   Other-Modules:       Paths_postgrest
-  Exposed-Modules:     PostgREST.App
+  Exposed-Modules:     PostgREST.ApiRequest
+                     , PostgREST.App
                      , PostgREST.Auth
                      , PostgREST.Config
+                     , PostgREST.DbStructure
+                     , PostgREST.DbRequestBuilder
                      , PostgREST.Error
                      , PostgREST.Middleware
+                     , PostgREST.OpenAPI
                      , PostgREST.Parsers
-                     , PostgREST.DbStructure
                      , PostgREST.QueryBuilder
                      , PostgREST.RangeQuery
-                     , PostgREST.ApiRequest
                      , PostgREST.Types
   hs-source-dirs:      src
 
 Test-Suite spec
   Type:                exitcode-stdio-1.0
   Default-Language:    Haskell2010
-  default-extensions:  OverloadedStrings, ScopedTypeVariables, QuasiQuotes, LambdaCase
-  Hs-Source-Dirs:      test, src
+  default-extensions:  OverloadedStrings, QuasiQuotes, NoImplicitPrelude
+  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
                      , Feature.RangeSpec
+                     , Feature.SingularSpec
                      , Feature.StructureSpec
-                     , Paths_postgrest
-                     , PostgREST.App
-                     , PostgREST.Auth
-                     , PostgREST.Config
-                     , PostgREST.Error
-                     , PostgREST.Middleware
-                     , PostgREST.Parsers
-                     , PostgREST.DbStructure
-                     , PostgREST.QueryBuilder
-                     , PostgREST.RangeQuery
-                     , PostgREST.ApiRequest
-                     , PostgREST.Types
+                     , Feature.UnicodeSpec
+                     , Feature.AndOrParamsSpec
+                     , Feature.RpcSpec
+                     , Feature.NonexistentSchemaSpec
+                     , Feature.UpsertSpec
                      , SpecHelper
                      , TestTypes
   Build-Depends:       aeson
-                     , base
-                     , base64-string
+                     , aeson-qq
+                     , async
+                     , auto-update
+                     , base >= 4.8 && < 4.10
                      , bytestring
+                     , base64-bytestring
                      , case-insensitive
                      , cassava
                      , containers
                      , contravariant
-                     , errors
-                     , hasql
+                     , hasql == 1.1
+                     , hasql-pool == 0.4.3
                      , heredoc
-                     , hspec == 2.2.*
-                     , hspec-wai
+                     , hjsonschema == 1.5.0.1
+                     , hspec
+                     , hspec-wai >= 0.7.0
                      , hspec-wai-json
                      , http-types
-                     , interpolatedstring-perl6
-                     , jwt
-                     , optparse-applicative
-                     , parsec
+                     , lens
+                     , lens-aeson
+                     , monad-control
+                     , postgrest
                      , process
+                     , protolude == 0.2.2
                      , regex-tdfa
-                     , safe
-                     , scientific
-                     , string-conversions
-                     , text
                      , time
-                     , unordered-containers
-                     , vector
+                     , transformers-base
                      , wai
-                     , wai-cors
                      , wai-extra
-                     , wai-middleware-static
-                     , HTTP
-                     , Ranged-sets

schema-templates/blog.sql

@@ -1,381 +0,0 @@
--------------------------------------------------------------------------------
--- Adapted from https://github.com/robconery/pg-auth
-
-begin;
-
--- comment out the role creation statements if
--- you want to run this script more than once
-create role anon;
-create role author;
-create role authenticator noinherit;
-grant anon, author to authenticator;
-
-create extension if not exists pgcrypto;
-create extension if not exists "uuid-ossp";
-
--- We put things inside the basic_auth schema to hide
--- them from public view. Certain public procs/views will
--- refer to helpers and tables inside.
-create schema if not exists basic_auth;
-
--------------------------------------------------------------------------------
--- Utility functions
-
-create or replace function
-basic_auth.clearance_for_role(u name) returns void as
-$$
-declare
-  ok boolean;
-begin
-  select exists (
-    select rolname
-      from pg_authid
-     where pg_has_role(current_user, oid, 'member')
-       and rolname = u
-  ) into ok;
-  if not ok then
-    raise invalid_password using message =
-      'current user not member of role ' || u;
-  end if;
-end
-$$ LANGUAGE plpgsql;
-
--------------------------------------------------------------------------------
--- Users storage and constraints
-
-create table if not exists
-basic_auth.users (
-  email    text primary key check ( email ~* '^.+@.+\..+$' ),
-  pass     text not null check (length(pass) < 512),
-  role     name not null check (length(role) < 512),
-  verified boolean not null default false
-  -- If you like add more columns, or a json column
-);
-
-create or replace function
-basic_auth.check_role_exists() returns trigger
-  language plpgsql
-  as $$
-begin
-  if not exists (select 1 from pg_roles as r where r.rolname = new.role) then
-    raise foreign_key_violation using message =
-      'unknown database role: ' || new.role;
-    return null;
-  end if;
-  return new;
-end
-$$;
-
-drop trigger if exists ensure_user_role_exists on basic_auth.users;
-create constraint trigger ensure_user_role_exists
-  after insert or update on basic_auth.users
-  for each row
-  execute procedure basic_auth.check_role_exists();
-
-create or replace function
-basic_auth.encrypt_pass() returns trigger
-  language plpgsql
-  as $$
-begin
-  if tg_op = 'INSERT' or new.pass <> old.pass then
-    new.pass = crypt(new.pass, gen_salt('bf'));
-  end if;
-  return new;
-end
-$$;
-
-drop trigger if exists encrypt_pass on basic_auth.users;
-create trigger encrypt_pass
-  before insert or update on basic_auth.users
-  for each row
-  execute procedure basic_auth.encrypt_pass();
-
-create or replace function
-basic_auth.send_validation() returns trigger
-  language plpgsql
-  as $$
-declare
-  tok uuid;
-begin
-  select uuid_generate_v4() into tok;
-  insert into basic_auth.tokens (token, token_type, email)
-         values (tok, 'validation', new.email);
-  perform pg_notify('validate',
-    json_build_object(
-      'email', new.email,
-      'token', tok,
-      'token_type', 'validation'
-    )::text
-  );
-  return new;
-end
-$$;
-
-drop trigger if exists send_validation on basic_auth.users;
-create trigger send_validation
-  after insert on basic_auth.users
-  for each row
-  execute procedure basic_auth.send_validation();
-
--------------------------------------------------------------------------------
--- Email Validation and Password Reset
-
-drop type if exists token_type_enum cascade;
-create type token_type_enum as enum ('validation', 'reset');
-
-create table if not exists
-basic_auth.tokens (
-  token       uuid primary key,
-  token_type  token_type_enum not null,
-  email       text not null references basic_auth.users (email)
-                on delete cascade on update cascade,
-  created_at  timestamptz not null default current_date
-);
-
--------------------------------------------------------------------------------
--- Login helper
-
-create or replace function
-basic_auth.user_role(email text, pass text) returns name
-  language plpgsql
-  as $$
-begin
-  return (
-  select role from basic_auth.users
-   where users.email = user_role.email
-     and users.pass = crypt(user_role.pass, users.pass)
-  );
-end;
-$$;
-
-create or replace function
-basic_auth.current_email() returns text
-  language plpgsql
-  as $$
-begin
-  return current_setting('postgrest.claims.email');
-exception
-  -- handle unrecognized configuration parameter error
-  when undefined_object then return '';
-end;
-$$;
-
-
--------------------------------------------------------------------------------
--- Public functions (in current schema, not basic_auth)
-
-create or replace function
-request_password_reset(email text) returns void
-  language plpgsql
-  as $$
-declare
-  tok uuid;
-begin
-  delete from basic_auth.tokens
-   where token_type = 'reset'
-     and tokens.email = request_password_reset.email;
-
-  select uuid_generate_v4() into tok;
-  insert into basic_auth.tokens (token, token_type, email)
-         values (tok, 'reset', request_password_reset.email);
-  perform pg_notify('reset',
-    json_build_object(
-      'email', request_password_reset.email,
-      'token', tok,
-      'token_type', 'reset'
-    )::text
-  );
-end;
-$$;
-
-create or replace function
-reset_password(email text, token uuid, pass text)
-  returns void
-  language plpgsql
-  as $$
-declare
-  tok uuid;
-begin
-  if exists(select 1 from basic_auth.tokens
-             where tokens.email = reset_password.email
-               and tokens.token = reset_password.token
-               and token_type = 'reset') then
-    update basic_auth.users set pass=reset_password.pass
-     where users.email = reset_password.email;
-
-    delete from basic_auth.tokens
-     where tokens.email = reset_password.email
-       and tokens.token = reset_password.token
-       and token_type = 'reset';
-  else
-    raise invalid_password using message =
-      'invalid user or token';
-  end if;
-  delete from basic_auth.tokens
-   where token_type = 'reset'
-     and tokens.email = reset_password.email;
-
-  select uuid_generate_v4() into tok;
-  insert into basic_auth.tokens (token, token_type, email)
-         values (tok, 'reset', reset_password.email);
-  perform pg_notify('reset',
-    json_build_object(
-      'email', reset_password.email,
-      'token', tok
-    )::text
-  );
-end;
-$$;
-
-drop type if exists basic_auth.jwt_claims cascade;
-create type
-basic_auth.jwt_claims AS (role text, email text);
-
-create or replace function
-login(email text, pass text) returns basic_auth.jwt_claims
-  language plpgsql
-  as $$
-declare
-  _role name;
-  result basic_auth.jwt_claims;
-begin
-  select basic_auth.user_role(email, pass) into _role;
-  if _role is null then
-    raise invalid_password using message = 'invalid user or password';
-  end if;
-  -- TODO; check verified flag if you care whether users
-  -- have validated their emails
-  select _role as role, login.email as email into result;
-  return result;
-end;
-$$;
-
-create or replace function
-signup(email text, pass text) returns void
-as $$
-  insert into basic_auth.users (email, pass, role) values
-    (signup.email, signup.pass, 'author');
-$$ language sql;
-
--------------------------------------------------------------------------------
--- User management
-
-create or replace view users as
-select actual.role as role,
-       '***'::text as pass,
-       actual.email as email,
-       actual.verified as verified
-from basic_auth.users as actual,
-     (select rolname
-        from pg_authid
-       where pg_has_role(current_user, oid, 'member')
-     ) as member_of
-where actual.role = member_of.rolname
-  and (
-    actual.role <> 'author'
-    or email = basic_auth.current_email()
-  );
-
-create or replace function
-update_users() returns trigger
-language plpgsql
-AS $$
-begin
-  if tg_op = 'INSERT' then
-    perform basic_auth.clearance_for_role(new.role);
-
-    insert into basic_auth.users
-      (role, pass, email, verified) values
-      (coalesce(new.role, 'author'), new.pass,
-        new.email, coalesce(new.verified, false));
-    return new;
-  elsif tg_op = 'UPDATE' then
-    -- no need to check clearance for old.role because
-    -- an ineligible row would not even available to update (http 404)
-    perform basic_auth.clearance_for_role(new.role);
-
-    update basic_auth.users set
-      email  = new.email,
-      role   = new.role,
-      pass   = new.pass,
-      verified = coalesce(new.verified, old.verified, false)
-      where email = old.email;
-    return new;
-  elsif tg_op = 'DELETE' then
-    -- no need to check clearance for old.role (see previous case)
-
-    delete from basic_auth.users
-     where basic_auth.email = old.email;
-    return null;
-  end if;
-end
-$$;
-
-drop trigger if exists update_users on users;
-create trigger update_users
-  instead of insert or update or delete on
-    users for each row execute procedure update_users();
-
--------------------------------------------------------------------------------
--- Blogging stuff!
-
-create table if not exists
-posts (
-  id         bigserial primary key,
-  title      text not null,
-  body       text not null,
-  author     text not null references basic_auth.users (email)
-               on delete restrict on update cascade
-               default basic_auth.current_email(),
-  created_at timestamptz not null default current_date
-);
-
-create table if not exists
-comments (
-  id         bigserial primary key,
-  body       text not null,
-  author     text not null references basic_auth.users (email)
-               on delete restrict on update cascade
-               default basic_auth.current_email(),
-  post       bigint not null references posts (id)
-               on delete cascade on update cascade,
-  created_at timestamptz not null default current_date
-);
-
--------------------------------------------------------------------------------
--- Permissions
-
-grant insert on table basic_auth.users, basic_auth.tokens to anon;
-grant select on table pg_authid, basic_auth.users, posts, comments to anon;
-grant execute on function
-  login(text,text),
-  request_password_reset(text),
-  reset_password(text,uuid,text),
-  signup(text, text)
-  to anon;
-
-grant select, insert, update, delete
-  on basic_auth.tokens, basic_auth.users to anon, author;
-grant select, insert, update, delete
-  on table users, posts, comments to author;
-grant usage, select on sequence posts_id_seq, comments_id_seq to author;
-
-grant usage on schema public, basic_auth to anon, author;
-
-ALTER TABLE posts ENABLE ROW LEVEL SECURITY;
-drop policy if exists authors_eigenedit on posts;
-create policy authors_eigenedit on posts
-  using (true)
-  with check (
-    author = basic_auth.current_email()
-  );
-
-ALTER TABLE comments ENABLE ROW LEVEL SECURITY;
-drop policy if exists authors_eigenedit on comments;
-create policy authors_eigenedit on comments
-  using (true)
-  with check (
-    author = basic_auth.current_email()
-  );
-
-commit;

src/PostgREST/ApiRequest.hs

@@ -1,48 +1,60 @@
-module PostgREST.ApiRequest where
+{-# LANGUAGE LambdaCase #-}
+{-|
+Module      : PostgREST.ApiRequest
+Description : PostgREST functions to translate HTTP request to a domain type called ApiRequest.
+-}
+module PostgREST.ApiRequest ( ApiRequest(..)
+                            , ContentType(..)
+                            , Action(..)
+                            , Target(..)
+                            , PreferRepresentation (..)
+                            , mutuallyAgreeable
+                            , userApiRequest
+                            ) where
 
-import qualified Data.Aeson              as JSON
-import qualified Data.ByteString         as BS
-import qualified Data.ByteString.Lazy    as BL
-import qualified Data.Csv                as CSV
-import           Data.List               (find)
-import qualified Data.HashMap.Strict     as M
-import qualified Data.Set                as S
-import           Data.Maybe              (fromMaybe, isJust, isNothing,
-                                          listToMaybe, fromJust)
-import           Control.Monad           (join)
-import           Data.Monoid             ((<>))
-import           Data.String.Conversions (cs)
-import qualified Data.Text               as T
-import qualified Data.Vector             as V
-import           Network.Wai             (Request (..))
-import           Network.Wai.Parse       (parseHttpAccept)
-import           PostgREST.RangeQuery    (NonnegRange, rangeRequested)
-import           PostgREST.Types         (QualifiedIdentifier (..),
-                                          Schema, Payload(..),
-                                          UniformObjects(..))
-import           Data.Ranged.Ranges      (singletonRange)
+import           Protolude
+import qualified Data.Aeson                as JSON
+import           Data.Aeson.Types          (emptyObject, emptyArray)
+import qualified Data.ByteString           as BS
+import qualified Data.ByteString.Internal  as BS (c2w)
+import qualified Data.ByteString.Lazy      as BL
+import qualified Data.Csv                  as CSV
+import qualified Data.List                 as L
+import           Data.List                 (lookup, last, partition)
+import qualified Data.HashMap.Strict       as M
+import qualified Data.Set                  as S
+import           Data.Maybe                (fromJust)
+import           Control.Arrow             ((***))
+import qualified Data.Text                 as T
+import qualified Data.Vector               as V
+import           Network.HTTP.Base         (urlEncodeVars)
+import           Network.HTTP.Types.Header (hAuthorization, hCookie)
+import           Network.HTTP.Types.URI    (parseSimpleQuery)
+import           Network.Wai               (Request (..))
+import           Network.Wai.Parse         (parseHttpAccept)
+import           PostgREST.RangeQuery      (NonnegRange, rangeRequested, restrictRange, rangeGeq, allRange, rangeLimit, rangeOffset)
+import           Data.Ranged.Boundaries
+import           PostgREST.Types
+import           Data.Ranged.Ranges        (Range(..), rangeIntersection, emptyRange)
+import qualified Data.CaseInsensitive      as CI
+import           Web.Cookie                (parseCookiesText)
 
 type RequestBody = BL.ByteString
 
 -- | Types of things a user wants to do to tables/views/procs
-data Action = ActionCreate | ActionRead
-            | ActionUpdate | ActionDelete
-            | ActionInfo   | ActionInvoke
-            | ActionInappropriate
+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
             | TargetProc  QualifiedIdentifier
             | TargetRoot
-            | TargetUnknown [T.Text]
+            | TargetUnknown [Text]
+            deriving Eq
 -- | How to return the inserted data
 data PreferRepresentation = Full | HeadersOnly | None deriving Eq
--- | Enumeration of currently supported content types for
--- route responses and upload payloads
-data ContentType = ApplicationJSON | TextCSV deriving Eq
-instance Show ContentType where
-  show ApplicationJSON = "application/json"
-  show TextCSV         = "text/csv"
 
 {-|
   Describes what the user wants to do. This data type is a
@@ -52,132 +64,198 @@ instance Show ContentType where
   if it is an action we are able to perform.
 -}
 data ApiRequest = ApiRequest {
-  -- | Set to Nothing for unknown HTTP verbs
+  -- | Similar but not identical to HTTP verb, e.g. Create/Invoke both POST
     iAction :: Action
-  -- | Set to Nothing for malformed range
-  , iRange  :: NonnegRange
-  -- | Set to Nothing for strangely nested urls
+  -- | Requested range of rows within response
+  , iRange  :: M.HashMap ByteString NonnegRange
+  -- | The target, be it calling a proc or accessing a table
   , iTarget :: Target
-  -- | The content type the client most desires (or JSON if undecided)
-  , iAccepts :: Either BS.ByteString ContentType
+  -- | Content types the client will accept, [CTAny] if no Accept header
+  , iAccepts :: [ContentType]
   -- | Data sent by client and used for mutation actions
-  , iPayload :: Maybe Payload
+  , iPayload :: Maybe PayloadJSON
   -- | If client wants created items echoed back
   , iPreferRepresentation :: PreferRepresentation
-  -- | If client wants first row as raw object
-  , iPreferSingular :: Bool
+  -- | Pass all parameters as a single json object to a stored procedure
+  , 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 :: [(String, String)]
+  , iFilters :: [(Text, Text)]
+  -- | &and and &or parameters used for complex boolean logic
+  , iLogic :: [(Text, Text)]
   -- | &select parameter used to shape the response
-  , iSelect :: String
-  -- | &order parameter
-  , iOrder :: Maybe String
+  , iSelect :: Text
+  -- | &order parameters for each level
+  , iOrder :: [(Text, Text)]
+  -- | Alphabetized (canonical) request query string for response URLs
+  , iCanonicalQS :: ByteString
+  -- | JSON Web Token
+  , iJWT :: Text
+  -- | HTTP request headers
+  , iHeaders :: [(Text, Text)]
+  -- | Request Cookies
+  , iCookies :: [(Text, Text)]
   }
 
 -- | Examines HTTP request and translates it into user intent.
-userApiRequest :: Schema -> Request -> RequestBody -> ApiRequest
-userApiRequest schema req reqBody =
-  let action =
-        if isTargetingProc
-          then
-            if method == "POST"
-               then ActionInvoke
-               else ActionInappropriate
-          else
-            case method of
-               "GET"     -> ActionRead
-               "POST"    -> ActionCreate
-               "PATCH"   -> ActionUpdate
-               "DELETE"  -> ActionDelete
-               "OPTIONS" -> ActionInfo
-               _         -> ActionInappropriate
-      target = case path of
-                 []            -> TargetRoot
-                 [table]       -> TargetIdent
-                                  $ QualifiedIdentifier schema table
-                 ["rpc", proc] -> TargetProc
-                                  $ QualifiedIdentifier schema proc
-                 other         -> TargetUnknown other
-      payload = case pickContentType (lookupHeader "content-type") of
-        Right ApplicationJSON ->
-          either (PayloadParseError . cs)
-            (\val -> case ensureUniform (pluralize val) of
-              Nothing -> PayloadParseError "All object keys must match"
-              Just json -> PayloadJSON json)
-            (JSON.eitherDecode reqBody)
-        Right TextCSV ->
-          either (PayloadParseError . cs)
-            (\val -> case ensureUniform (csvToJson val) of
-              Nothing -> PayloadParseError "All lines must have same number of fields"
-              Just json -> PayloadJSON json)
-            (CSV.decodeByName reqBody)
-        Left accept ->
-          PayloadParseError $
-            "Content-type not acceptable: " <> accept
-      relevantPayload = case action of
-        ActionCreate -> Just payload
-        ActionUpdate -> Just payload
-        ActionInvoke -> Just payload
-        _            -> Nothing in
-
-  ApiRequest {
-    iAction = action
-  , iRange  = if singular then singletonRange 0 else rangeRequested hdrs
-  , iTarget = target
-  , iAccepts = pickContentType $ lookupHeader "accept"
-  , iPayload = relevantPayload
-  , iPreferRepresentation = representation
-  , iPreferSingular = singular
-  , iPreferCount = not $ hasPrefer "count=none"
-  , iFilters = [ (k, fromJust v) | (k,v) <- qParams, k `notElem` ["select", "order"], isJust v ]
-  , iSelect = if method == "DELETE"
-              then "*"
-              else fromMaybe "*" $ fromMaybe (Just "*") $ lookup "select" qParams
-  , iOrder = join $ lookup "order" qParams
-  }
-
+userApiRequest :: Schema -> Request -> RequestBody -> Either ApiRequestError ApiRequest
+userApiRequest schema req reqBody
+  | isTargetingProc && method `notElem` ["GET", "POST"] = Left ActionInappropriate
+  | topLevelRange == emptyRange = Left InvalidRange
+  | shouldParsePayload && isLeft payload = either (Left . InvalidBody . toS) witness payload
+  | otherwise = Right ApiRequest {
+      iAction = action
+      , iTarget = target
+      , iRange = ranges
+      , iAccepts = fromMaybe [CTAny] $
+        map decodeContentType . parseHttpAccept <$> lookupHeader "accept"
+      , iPayload = relevantPayload
+      , iPreferRepresentation = representation
+      , iPreferSingleObjectParameter = singleObject
+      , iPreferCount = hasPrefer "count=exact"
+      , 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 ]
+      , iCanonicalQS = toS $ urlEncodeVars
+        . L.sortBy (comparing fst)
+        . map (join (***) toS)
+        . parseSimpleQuery
+        $ rawQueryString req
+      , iJWT = tokenStr
+      , iHeaders = [ (toS $ CI.foldedCase k, toS v) | (k,v) <- hdrs, k /= hAuthorization, k /= hCookie]
+      , iCookies = fromMaybe [] $ parseCookiesText <$> lookupHeader "Cookie"
+      }
  where
+  -- 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", 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, _) -> 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"      | 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
+                              $ QualifiedIdentifier schema table
+              ["rpc", proc] -> TargetProc
+                              $ QualifiedIdentifier schema proc
+              other         -> TargetUnknown other
+  shouldParsePayload = action `elem` [ActionCreate, ActionUpdate, ActionSingleUpsert, ActionInvoke{isReadOnly=False}, ActionInvoke{isReadOnly=True}]
+  relevantPayload | shouldParsePayload = rightToMaybe payload
+                  | otherwise = Nothing
   path            = pathInfo req
   method          = requestMethod req
-  isTargetingProc = fromMaybe False $ (== "rpc") <$> listToMaybe path
   hdrs            = requestHeaders req
-  qParams         = [(cs k, cs <$> v)|(k,v) <- queryString req]
+  qParams         = [(toS k, v)|(k,v) <- queryString req]
   lookupHeader    = flip lookup hdrs
-  hasPrefer val   = any (\(h,v) -> h == "Prefer" && v == val) hdrs
-  singular        = hasPrefer "plurality=singular"
+  hasPrefer :: Text -> Bool
+  hasPrefer val   = any (\(h,v) -> h == "Prefer" && val `elem` split v) hdrs
+    where
+        split :: BS.ByteString -> [Text]
+        split = map T.strip . T.split (==',') . toS
+  singleObject    = hasPrefer "params=single-object"
   representation
     | hasPrefer "return=representation" = Full
     | hasPrefer "return=minimal" = None
     | otherwise = HeadersOnly
+  auth = fromMaybe "" $ lookupHeader hAuthorization
+  tokenStr = case T.split (== ' ') (toS auth) of
+    ("Bearer" : t : _) -> t
+    _                  -> ""
+  endingIn:: [Text] -> Text -> Bool
+  endingIn xx key = lastWord `elem` xx
+    where lastWord = last $ T.split (=='.') key
+
+  headerRange = rangeRequested hdrs
+  replaceLast x s = T.intercalate "." $ L.init (T.split (=='.') s) ++ [x]
+  limitParams :: M.HashMap ByteString NonnegRange
+  limitParams  = M.fromList [(toS (replaceLast "limit" k), restrictRange (readMaybe =<< (toS <$> v)) allRange) | (k,v) <- qParams, isJust v, endingIn ["limit"] k]
+  offsetParams :: M.HashMap ByteString NonnegRange
+  offsetParams = M.fromList [(toS (replaceLast "limit" k), fromMaybe allRange (rangeGeq <$> (readMaybe =<< (toS <$> v)))) | (k,v) <- qParams, isJust v, endingIn ["offset"] k]
+
+  urlRange = M.unionWith f limitParams offsetParams
+    where
+      f rl ro = Range (BoundaryBelow o) (BoundaryAbove $ o + l - 1)
+        where
+          l = fromMaybe 0 $ rangeLimit rl
+          o = rangeOffset ro
+  ranges = M.insert "limit" (rangeIntersection headerRange (fromMaybe allRange (M.lookup "limit" urlRange))) urlRange
+
+{-|
+  Find the best match from a list of content types accepted by the
+  client in order of decreasing preference and a list of types
+  producible by the server.  If there is no match but the client
+  accepts */* then return the top server pick.
+-}
+mutuallyAgreeable :: [ContentType] -> [ContentType] -> Maybe ContentType
+mutuallyAgreeable sProduces cAccepts =
+  let exact = listToMaybe $ L.intersect cAccepts sProduces in
+  if isNothing exact && CTAny `elem` cAccepts
+     then listToMaybe sProduces
+     else exact
 
 -- PRIVATE ---------------------------------------------------------------
 
 {-|
-  Picks a preferred content type from an Accept header (or from
-  Content-Type as a degenerate case).
-
-  For example
-  text/csv -> TextCSV
-  */*      -> ApplicationJSON
-  text/csv, application/json -> TextCSV
-  application/json, text/csv -> ApplicationJSON
+  Warning: discards MIME parameters
 -}
-pickContentType :: Maybe BS.ByteString -> Either BS.ByteString ContentType
-pickContentType accept
-  | isNothing accept || has ctAll || has ctJson = Right ApplicationJSON
-  | has ctCsv = Right TextCSV
-  | otherwise = Left accept'
- where
-  ctAll  = "*/*"
-  ctCsv  = "text/csv"
-  ctJson = "application/json"
-  Just accept' = accept
-  findInAccept = flip find $ parseHttpAccept accept'
-  has          = isJust . findInAccept . BS.isPrefixOf
+decodeContentType :: BS.ByteString -> ContentType
+decodeContentType ct =
+  case BS.takeWhile (/= BS.c2w ';') ct of
+    "application/json"                  -> CTApplicationJSON
+    "text/csv"                          -> CTTextCSV
+    "application/openapi+json"          -> CTOpenAPI
+    "application/vnd.pgrst.object+json" -> CTSingularJSON
+    "application/vnd.pgrst.object"      -> CTSingularJSON
+    "application/octet-stream"          -> CTOctetStream
+    "*/*"                               -> CTAny
+    ct'                                 -> CTOther ct'
 
-type CsvData = V.Vector (M.HashMap T.Text BL.ByteString)
+type CsvData = V.Vector (M.HashMap Text BL.ByteString)
 
 {-|
   Converts CSV like
@@ -191,38 +269,37 @@ type CsvData = V.Vector (M.HashMap T.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 ->
         if str == "NULL"
           then JSON.Null
-          else JSON.String $ cs str
+          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 UniformObjects
-ensureUniform :: JSON.Array -> Maybe UniformObjects
-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 (UniformObjects 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,337 +1,405 @@
 {-# LANGUAGE FlexibleContexts    #-}
 {-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TupleSections #-}
---module PostgREST.App where
+{-# LANGUAGE NamedFieldPuns #-}
+
 module PostgREST.App (
-  app
+  postgrest
 ) where
 
 import           Control.Applicative
-import           Control.Arrow             ((***))
-import           Control.Monad             (join)
-import           Data.Bifunctor            (first)
-import           Data.List                 (find, sortBy, delete)
-import           Data.Maybe                (isJust, fromMaybe, fromJust, mapMaybe)
-import           Data.Ord                  (comparing)
-import           Data.Ranged.Ranges        (emptyRange)
-import           Data.String.Conversions   (cs)
-import           Data.Text                 (Text, replace, strip)
-import           Data.Tree
+import           Data.Aeson                as JSON
+import qualified Data.ByteString.Char8     as BS
+import           Data.Maybe
+import           Data.IORef                (IORef, readIORef)
+import           Data.Text                 (intercalate)
+import           Data.Time.Clock           (UTCTime)
+import qualified Data.Set                  as S
 
-import           Text.Parsec.Error
-import           Text.ParserCombinators.Parsec (parse)
+import qualified Hasql.Pool                 as P
+import qualified Hasql.Transaction          as HT
+import qualified Hasql.Transaction.Sessions as HT
 
-import           Network.HTTP.Base         (urlEncodeVars)
 import           Network.HTTP.Types.Header
 import           Network.HTTP.Types.Status
-import           Network.HTTP.Types.URI    (parseSimpleQuery)
+import           Network.HTTP.Types.URI    (renderSimpleQuery)
 import           Network.Wai
+import           Network.Wai.Middleware.RequestLogger (logStdout)
 
-import           Data.Aeson
-import           Data.Aeson.Types (emptyArray)
-import           Data.Monoid
-import qualified Data.Vector               as V
-import qualified Hasql.Session             as H
+import qualified Hasql.Transaction         as H
 
+import qualified Data.HashMap.Strict       as M
+
+import           PostgREST.ApiRequest   ( ApiRequest(..), ContentType(..)
+                                        , Action(..), Target(..)
+                                        , PreferRepresentation (..)
+                                        , mutuallyAgreeable
+                                        , userApiRequest
+                                        )
+import           PostgREST.Auth            (jwtClaims, containsRole, parseJWK)
 import           PostgREST.Config          (AppConfig (..))
-import           PostgREST.Parsers
 import           PostgREST.DbStructure
-import           PostgREST.RangeQuery
-import           PostgREST.ApiRequest   (ApiRequest(..), ContentType(..)
-                                            , Action(..), Target(..)
-                                            , PreferRepresentation (..)
-                                            , userApiRequest)
-import           PostgREST.Types
-import           PostgREST.Auth            (tokenJWT)
-import           PostgREST.Error           (errResponse)
-
+import           PostgREST.DbRequestBuilder( readRequest
+                                           , mutateRequest
+                                           , fieldNames
+                                           )
+import           PostgREST.Error           ( simpleError, pgError
+                                           , apiRequestError
+                                           , singularityError, binaryFieldError
+                                           , connectionLostError, gucHeadersError
+                                           )
+import           PostgREST.RangeQuery      (allRange, rangeOffset)
+import           PostgREST.Middleware
 import           PostgREST.QueryBuilder ( callProc
-                                        , addJoinConditions
-                                        , sourceCTEName
                                         , requestToQuery
                                         , requestToCountQuery
-                                        , addRelations
                                         , createReadStatement
                                         , createWriteStatement
                                         , ResultsWithCount
                                         )
+import           PostgREST.Types
+import           PostgREST.OpenAPI
 
-import           Prelude
+import           Data.Function (id)
+import           Protolude              hiding (intercalate, Proxy)
 
-app :: DbStructure -> AppConfig -> RequestBody -> Request -> H.Session Response
-app dbStructure conf reqBody req =
-  let
-      -- TODO: blow up for Left values (there is a middleware that checks the headers)
-      contentType = either (const ApplicationJSON) id (iAccepts apiRequest)
-      contentTypeH = (hContentType, cs $ show contentType) in
+postgrest :: AppConfig -> IORef (Maybe DbStructure) -> P.Pool -> IO UTCTime -> IO () -> Application
+postgrest conf refDbStructure pool getTime worker =
+  let middle = (if configQuiet conf then id else logStdout) . defaultMiddle
+      jwtSecret = parseJWK <$> configJwtSecret conf in
 
-  case (iAction apiRequest, iTarget apiRequest, iPayload apiRequest) of
+  middle $ \ req respond -> do
+    time <- getTime
+    body <- strictRequestBody req
+    maybeDbStructure <- readIORef refDbStructure
+    case maybeDbStructure of
+      Nothing -> respond connectionLostError
+      Just dbStructure -> do
+        response <- case userApiRequest (configSchema conf) req body of
+          Left err -> return $ apiRequestError err
+          Right apiRequest -> do
+            eClaims <- jwtClaims jwtSecret (configJwtAudience conf) (toS $ iJWT apiRequest) time (rightToMaybe $ configRoleClaimKey conf)
 
-    (ActionRead, TargetIdent qi, Nothing) ->
-      case readSqlParts of
-        Left e -> return $ responseLBS status400 [jsonH] $ cs e
-        Right (q, cq) -> do
-          let range = restrictRange (configMaxRows conf) $ iRange apiRequest
-              singular = iPreferSingular apiRequest
-              stm = createReadStatement q cq range singular
-                    (iPreferCount apiRequest) (contentType == TextCSV)
-          if range == emptyRange
-          then return $ errResponse status416 "HTTP Range error"
-          else do
-            row <- H.query () stm
-            let (tableTotal, queryTotal, _ , body) = row
-            if singular
-            then return $ if queryTotal <= 0
-              then responseLBS status404 [] ""
-              else responseLBS status200 [contentTypeH] (cs body)
-            else do
-              let frm = rangeOffset range
-                  to = frm + toInteger queryTotal - 1
-                  contentRange = contentRangeH frm to (toInteger <$> tableTotal)
-                  status = rangeStatus frm to (toInteger <$> tableTotal)
-                  canonical = urlEncodeVars -- should this be moved to the dbStructure (location)?
-                    . sortBy (comparing fst)
-                    . map (join (***) cs)
-                    . parseSimpleQuery
-                    $ rawQueryString req
-              return $ responseLBS status
-                [contentTypeH, contentRange,
-                  ("Content-Location",
-                    "/" <> cs (qiName qi) <>
-                      if Prelude.null canonical then "" else "?" <> cs canonical
-                  )
-                ] (cs body)
+            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 (responseStatus response == status503) worker
+        respond response
 
-    (ActionCreate, TargetIdent qi@(QualifiedIdentifier _ table),
-     Just payload@(PayloadJSON uniform@(UniformObjects rows))) ->
-      case mutateSqlParts of
-        Left e -> return $ responseLBS status400 [jsonH] $ cs e
-        Right (sq,mq) -> do
-          let isSingle = (==1) $ V.length rows
-          let pKeys = map pkName $ filter (filterPk schema table) allPrKeys -- would it be ok to move primary key detection in the query itself?
-          let stm = createWriteStatement qi sq mq isSingle (iPreferRepresentation apiRequest) pKeys (contentType == TextCSV) payload
-          row <- H.query uniform stm
-          let (_, _, location, body) = extractQueryResult row
-          return $ responseLBS status201
-            [
-              contentTypeH,
-              (hLocation, "/" <> cs table <> "?" <> cs location)
-            ]
-            $ if iPreferRepresentation apiRequest == Full then cs body else ""
+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
 
-    (ActionUpdate, TargetIdent qi, Just payload@(PayloadJSON uniform)) ->
-      case mutateSqlParts of
-        Left e -> return $ responseLBS status400 [jsonH] $ cs e
-        Right (sq,mq) -> do
-          let stm = createWriteStatement qi sq mq False (iPreferRepresentation apiRequest) [] (contentType == TextCSV) payload
-          row <- H.query uniform stm
-          let (_, queryTotal, _, body) = extractQueryResult row
-              r = contentRangeH 0 (toInteger $ queryTotal-1) (toInteger <$> Just queryTotal)
-              s = case () of _ | queryTotal == 0 -> status404
-                               | iPreferRepresentation apiRequest == Full -> status200
-                               | otherwise -> status204
-          return $ responseLBS s [contentTypeH, r]
-            $ if iPreferRepresentation apiRequest == Full then cs body else ""
+transactionMode :: Maybe ProcDescription -> Action -> H.Mode
+transactionMode proc action =
+  case action of
+    ActionRead -> HT.Read
+    ActionInfo -> HT.Read
+    ActionInspect -> HT.Read
+    ActionInvoke{isReadOnly=False} ->
+      let v = fromMaybe Volatile $ pdVolatility <$> proc in
+      if v == Stable || v == Immutable
+         then HT.Read
+         else HT.Write
+    ActionInvoke{isReadOnly=True} -> HT.Read
+    _ -> HT.Write
 
-    (ActionDelete, TargetIdent qi, Nothing) ->
-      case mutateSqlParts of
-        Left e -> return $ responseLBS status400 [jsonH] $ cs e
-        Right (sq,mq) -> do
-          let emptyUniform = UniformObjects V.empty
-          let fakeload = PayloadJSON emptyUniform
-          let stm = createWriteStatement qi sq mq False (iPreferRepresentation apiRequest) [] (contentType == TextCSV) fakeload
-          row <- H.query emptyUniform stm
-          let (_, queryTotal, _, _) = extractQueryResult row
-          return $ if queryTotal == 0
-            then notFound
-            else responseLBS status204 [("Content-Range", "*/"<> cs (show queryTotal))] ""
+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 ->
+      case (iAction apiRequest, iTarget apiRequest, iPayload apiRequest) of
 
-    (ActionInfo, TargetIdent (QualifiedIdentifier tSchema tTable), Nothing) ->
-      if isJust $ find (\t -> tableName t == tTable && tableSchema t == tSchema) (dbTables dbStructure)
-        then let cols = filter (filterCol tSchema tTable) $ dbColumns dbStructure
-                 pkeys = map pkName $ filter (filterPk tSchema tTable) allPrKeys
-                 body = encode (TableOptions cols pkeys)
-                 filterCol :: Schema -> TableName -> Column -> Bool
-                 filterCol sc tb Column{colTable=Table{tableSchema=s, tableName=t}} = s==sc && t==tb
-                 filterCol _ _ _ =  False in
-          return $ responseLBS status200 [jsonH, allOrigins] $ cs body
-        else
-          return notFound
+        (ActionRead, TargetIdent qi, Nothing) ->
+          let partsField = (,) <$> readSqlParts
+                <*> (binaryField contentType =<< fldNames) in
+          case partsField of
+            Left errorResponse -> return errorResponse
+            Right ((q, cq), bField) -> do
+              let stm = createReadStatement q cq (contentType == CTSingularJSON) shouldCount
+                                            (contentType == CTTextCSV) bField
+              row <- H.query () stm
+              let (tableTotal, queryTotal, _ , body) = row
+                  (status, contentRange) = rangeHeader queryTotal tableTotal
+                  canonical = iCanonicalQS apiRequest
+              return $
+                if contentType == CTSingularJSON && queryTotal /= 1
+                  then singularityError (toInteger queryTotal)
+                  else responseLBS status
+                    [toHeader contentType, contentRange,
+                      ("Content-Location",
+                        "/" <> toS (qiName qi) <>
+                          if BS.null canonical then "" else "?" <> toS canonical
+                      )
+                    ] (toS body)
 
-    (ActionInvoke, TargetProc qi,
-     Just (PayloadJSON (UniformObjects payload))) -> do
-      exists <- H.query qi doesProcExist
-      if exists
-        then do
-          let p = V.head payload
-              jwtSecret = configJwtSecret conf
+        (ActionCreate, TargetIdent (QualifiedIdentifier tSchema tName), Just PayloadJSON{pjRaw, pjType}) ->
+          case mutateSqlParts tSchema tName of
+            Left errorResponse -> return errorResponse
+            Right (sq, mq) -> do
+              let (isSingle, nRows) = case pjType of
+                                        PJArray len -> (len == 1, len)
+                                        PJObject -> (True, 1)
+              if contentType == CTSingularJSON
+                 && not isSingle
+                 && iPreferRepresentation apiRequest == Full
+                then return $ singularityError (toInteger nRows)
+                else do
+                  let pkCols = tablePKCols dbStructure tSchema tName
+                      stm = createWriteStatement sq mq
+                        (contentType == CTSingularJSON) isSingle
+                        (contentType == CTTextCSV) (iPreferRepresentation apiRequest) pkCols
+                  row <- H.query (toS pjRaw) stm
+                  let (_, _, fs, body) = extractQueryResult row
+                      headers = catMaybes [
+                          if null fs
+                            then Nothing
+                            else Just (hLocation, "/" <> toS tName <> renderLocationFields fs)
+                        , if iPreferRepresentation apiRequest == Full
+                            then Just $ toHeader contentType
+                            else Nothing
+                        , Just . contentRangeH 1 0 $
+                            toInteger <$> if shouldCount then Just nRows else Nothing
+                        , if null pkCols
+                            then Nothing
+                            else (\x -> ("Preference-Applied", show x)) <$> iPreferResolution apiRequest
+                        ]
 
-          bodyJson <- H.query () (callProc qi p)
-          returnJWT <- H.query qi doesProcReturnJWT
-          return $ responseLBS status200 [jsonH]
-                 (let body = fromMaybe emptyArray bodyJson in
-                    if returnJWT
-                    then "{\"token\":\"" <> cs (tokenJWT jwtSecret body) <> "\"}"
-                    else cs $ encode body)
-        else return notFound
+                  return . responseLBS status201 headers $
+                    if iPreferRepresentation apiRequest == Full
+                      then toS body else ""
 
-    (ActionRead, TargetRoot, Nothing) -> do
-      body <- encode <$> H.query schema accessibleTables
-      return $ responseLBS status200 [jsonH] $ cs body
+        (ActionUpdate, TargetIdent (QualifiedIdentifier tSchema tName), Just p@PayloadJSON{pjRaw}) ->
+          case (mutateSqlParts tSchema tName, pjIsEmpty p, iPreferRepresentation apiRequest == Full) of
+            (Left errorResponse, _, _) -> return errorResponse
+            (_, True, True) -> return $ responseLBS status200 [contentRangeH 1 0 Nothing] "[]"
+            (_, True, False) -> return $ responseLBS status204 [contentRangeH 1 0 Nothing] ""
+            (Right (sq, mq), _, _) -> do
+              let stm = createWriteStatement sq mq
+                    (contentType == CTSingularJSON) False (contentType == CTTextCSV)
+                    (iPreferRepresentation apiRequest) []
+              row <- H.query (toS pjRaw) stm
+              let (_, queryTotal, _, body) = extractQueryResult row
+              if contentType == CTSingularJSON
+                 && queryTotal /= 1
+                 && iPreferRepresentation apiRequest == Full
+                then do
+                  HT.condemn
+                  return $ singularityError (toInteger queryTotal)
+                else do
+                  let r = contentRangeH 0 (toInteger $ queryTotal-1)
+                            (toInteger <$> if shouldCount then Just queryTotal else Nothing)
+                      s = if iPreferRepresentation apiRequest == Full
+                            then status200
+                            else status204
+                  return $ if iPreferRepresentation apiRequest == Full
+                    then responseLBS s [toHeader contentType, r] (toS body)
+                    else responseLBS s [r] ""
 
-    (ActionInappropriate, _, _) -> return $ responseLBS status405 [] ""
+        (ActionSingleUpsert, TargetIdent (QualifiedIdentifier tSchema tName), Just PayloadJSON{pjRaw, pjType, pjKeys}) ->
+          case mutateSqlParts tSchema tName of
+            Left errorResponse -> return errorResponse
+            Right (sq, mq) -> do
+              let isSingle = case pjType of
+                               PJArray len -> len == 1
+                               PJObject -> True
+                  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 [] ""
 
-    (_, _, Just (PayloadParseError e)) ->
-      return $ responseLBS status400 [jsonH] $
-        cs (formatGeneralError "Cannot parse request payload" (cs e))
+        (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 mempty stm
+              let (_, queryTotal, _, body) = extractQueryResult row
+                  r = contentRangeH 1 0 $
+                        toInteger <$> if shouldCount then Just queryTotal else Nothing
+              if contentType == CTSingularJSON
+                 && queryTotal /= 1
+                 && iPreferRepresentation apiRequest == Full
+                then do
+                  HT.condemn
+                  return $ singularityError (toInteger queryTotal)
+                else
+                  return $ if iPreferRepresentation apiRequest == Full
+                    then responseLBS status200 [toHeader contentType, r] (toS body)
+                    else responseLBS status204 [r] ""
 
-    (_, TargetUnknown _, _) -> return notFound
+        (ActionInfo, TargetIdent (QualifiedIdentifier tSchema tTable), Nothing) ->
+          let mTable = find (\t -> tableName t == tTable && tableSchema t == tSchema) (dbTables dbStructure) in
+          case mTable of
+            Nothing -> return notFound
+            Just table ->
+              let acceptH = (hAllow, if tableInsertable table then "GET,POST,PATCH,DELETE" else "GET") in
+              return $ responseLBS status200 [allOrigins, acceptH] ""
 
-    (_, _, _) -> return notFound
+        (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), bField) -> do
+              let isObject = case pjType of
+                                PJObject  -> True
+                                PJArray _ -> False
+                  singular = contentType == CTSingularJSON
+                  specifiedPgArgs = filter ((`S.member` pjKeys) . pgaName) $ fromMaybe [] (pdArgs <$> proc)
+              row <- H.query (toS pjRaw) $
+                callProc qi specifiedPgArgs returnsScalar q cq shouldCount
+                         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
+                  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)
 
- where
-  notFound = responseLBS status404 [] ""
-  filterPk sc table pk = sc == (tableSchema . pkTable) pk && table == (tableName . pkTable) pk
-  allPrKeys = dbPrimaryKeys dbStructure
-  allOrigins = ("Access-Control-Allow-Origin", "*") :: Header
-  schema = cs $ configSchema conf
-  apiRequest = userApiRequest schema req reqBody
-  readDbRequest = DbRead <$> buildReadRequest (dbRelations dbStructure) apiRequest
-  mutateDbRequest = DbMutate <$> buildMutateRequest apiRequest
-  selectQuery = requestToQuery schema <$> readDbRequest
-  countQuery = requestToCountQuery schema <$> readDbRequest
-  mutateQuery = requestToQuery schema <$> mutateDbRequest
-  readSqlParts = (,) <$> selectQuery <*> countQuery
-  mutateSqlParts = (,) <$> selectQuery <*> mutateQuery
+        (ActionInspect, TargetRoot, Nothing) -> do
+          let host = configHost conf
+              port = toInteger $ configPort conf
+              proxy = pickProxy $ toS <$> configProxyUri conf
+              uri Nothing = ("http", host, port, "/")
+              uri (Just Proxy { proxyScheme = s, proxyHost = h, proxyPort = p, proxyPath = b }) = (s, h, p, b)
+              uri' = uri proxy
+              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
+      notFound = responseLBS status404 [] ""
+      allOrigins = ("Access-Control-Allow-Origin", "*") :: Header
+      shouldCount = iPreferCount apiRequest
+      schema = toS $ configSchema conf
+      topLevelRange = fromMaybe allRange $ M.lookup "limit" $ iRange apiRequest
+      rangeHeader queryTotal tableTotal =
+        let lower = rangeOffset topLevelRange
+            upper = lower + toInteger queryTotal - 1
+            contentRange = contentRangeH lower upper (toInteger <$> tableTotal)
+            status = rangeStatus lower upper (toInteger <$> tableTotal)
+        in (status, contentRange)
+
+      readReq = readRequest (configMaxRows conf) (dbRelations dbStructure) proc apiRequest
+      fldNames = fieldNames <$> readReq
+      readDbRequest = DbRead <$> readReq
+      selectQuery = requestToQuery schema False <$> readDbRequest
+      countQuery = requestToCountQuery schema <$> readDbRequest
+      readSqlParts = (,) <$> selectQuery <*> countQuery
+      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
+  where
+    contentTypesForRequest =
+      case action of
+        ActionRead ->    [CTApplicationJSON, CTSingularJSON, CTTextCSV, CTOctetStream]
+        ActionCreate ->  [CTApplicationJSON, CTSingularJSON, CTTextCSV]
+        ActionUpdate ->  [CTApplicationJSON, CTSingularJSON, CTTextCSV]
+        ActionDelete ->  [CTApplicationJSON, CTSingularJSON, CTTextCSV]
+        ActionInvoke _ ->  [CTApplicationJSON, CTSingularJSON, CTTextCSV, CTOctetStream]
+        ActionInspect -> [CTOpenAPI, CTApplicationJSON]
+        ActionInfo ->    [CTTextCSV]
+        ActionSingleUpsert ->  [CTApplicationJSON, CTSingularJSON, CTTextCSV]
+    serves sProduces cAccepts =
+      case mutuallyAgreeable sProduces cAccepts of
+        Nothing -> do
+          let failed = intercalate ", " $ map (toS . toMime) cAccepts
+          Left $ simpleError status415 [] $
+            "None of these Content-Types are available: " <> failed
+        Just ct -> Right ct
+
+binaryField :: ContentType -> [FieldName] -> Either Response (Maybe FieldName)
+binaryField CTOctetStream fldNames =
+  if length fldNames == 1 && fieldName /= Just "*"
+    then Right fieldName
+    else Left binaryFieldError
+  where
+    fieldName = headMay fldNames
+binaryField _ _ = Right Nothing
+
+splitKeyValue :: BS.ByteString -> (BS.ByteString, BS.ByteString)
+splitKeyValue kv = (k, BS.tail v)
+  where (k, v) = BS.break (== '=') kv
+
+renderLocationFields :: [BS.ByteString] -> BS.ByteString
+renderLocationFields fields =
+  renderSimpleQuery True $ map splitKeyValue fields
 
 rangeStatus :: Integer -> Integer -> Maybe Integer -> Status
 rangeStatus _ _ Nothing = status200
-rangeStatus frm to (Just total)
-  | frm > total            = status416
-  | (1 + to - frm) < total = status206
+rangeStatus lower upper (Just total)
+  | lower > total            = status416
+  | (1 + upper - lower) < total = status206
   | otherwise               = status200
 
 contentRangeH :: Integer -> Integer -> Maybe Integer -> Header
-contentRangeH frm to total =
-    ("Content-Range", cs headerValue)
+contentRangeH lower upper total =
+    ("Content-Range", headerValue)
     where
       headerValue   = rangeString <> "/" <> totalString
       rangeString
-        | totalNotZero && fromInRange = show frm <> "-" <> cs (show to)
+        | totalNotZero && fromInRange = show lower <> "-" <> show upper
         | otherwise = "*"
       totalString   = fromMaybe "*" (show <$> total)
       totalNotZero  = fromMaybe True ((/=) 0 <$> total)
-      fromInRange   = frm <= to
-
-jsonH :: Header
-jsonH = (hContentType, "application/json")
-
-formatRelationError :: Text -> Text
-formatRelationError = formatGeneralError
-  "could not find foreign keys between these entities"
-
-formatParserError :: ParseError -> Text
-formatParserError e = formatGeneralError message details
-  where
-     message = cs $ show (errorPos e)
-     details = strip $ replace "\n" " " $ cs
-       $ showErrorMessages "or" "unknown parse error" "expecting" "unexpected" "end of input" (errorMessages e)
-
-formatGeneralError :: Text -> Text -> Text
-formatGeneralError message details = cs $ encode $ object [
-  "message" .= message,
-  "details" .= details]
-
-augumentRequestWithJoin :: Schema ->  [Relation] ->  ReadRequest -> Either Text ReadRequest
-augumentRequestWithJoin schema allRels request =
-  (first formatRelationError . addRelations schema allRels Nothing) request
-  >>= addJoinConditions schema
-
-buildReadRequest :: [Relation] -> ApiRequest -> Either Text ReadRequest
-buildReadRequest allRels apiRequest  =
-  augumentRequestWithJoin schema rels =<< first formatParserError (foldr addFilter <$> (addOrder <$> readRequest <*> ord) <*> flts)
-  where
-    selStr = iSelect apiRequest
-    orderS = iOrder apiRequest
-    action = iAction apiRequest
-    target = iTarget apiRequest
-    (schema, rootTableName) = fromJust $ -- Make it safe
-      case target of
-        (TargetIdent (QualifiedIdentifier s t) ) -> Just (s, t)
-        _ -> Nothing
-
-    rootName = if action == ActionRead
-      then rootTableName
-      else sourceCTEName
-    filters = if action == ActionRead
-      then iFilters apiRequest
-      else filter (( '.' `elem` ) . fst) $ iFilters apiRequest -- there can be no filters on the root table whre we are doing insert/update
-    rels = case action of
-      ActionCreate -> fakeSourceRelations ++ allRels
-      ActionUpdate -> fakeSourceRelations ++ allRels
-      _       -> allRels
-      where fakeSourceRelations = mapMaybe (toSourceRelation rootTableName) allRels -- see comment in toSourceRelation
-    readRequest = parse (pRequestSelect rootName) ("failed to parse select parameter <<"++selStr++">>") selStr
-    addOrder (Node (q,i) f) o = Node (q{order=o}, i) f
-    flts = mapM pRequestFilter filters
-    ord = traverse (parse pOrder ("failed to parse order parameter <<"++fromMaybe "" orderS++">>")) orderS
-
-buildMutateRequest :: ApiRequest -> Either Text MutateRequest
-buildMutateRequest apiRequest =
-  mutateApiRequest
-  where
-    action = iAction apiRequest
-    target = iTarget apiRequest
-    payload = fromJust $ iPayload apiRequest
-    rootTableName = -- TODO: Make it safe
-      case target of
-        (TargetIdent (QualifiedIdentifier _ t) ) -> t
-        _ -> undefined
-    mutateApiRequest = case action of
-      ActionCreate -> Insert rootTableName <$> pure payload
-      ActionUpdate -> Update rootTableName <$> pure payload <*> cond
-      ActionDelete -> Delete rootTableName <$> cond
-      _        -> Left "Unsupported HTTP verb"
-    mutateFilters = filter (not . ( '.' `elem` ) . fst) $ iFilters apiRequest -- update/delete filters can be only on the root table
-    cond = first formatParserError $ map snd <$> mapM pRequestFilter mutateFilters
-
-addFilter :: (Path, Filter) -> ReadRequest -> ReadRequest
-addFilter ([], flt) (Node (q@Select {flt_=flts}, i) forest) = Node (q {flt_=flt:flts}, i) forest
-addFilter (path, flt) (Node rn forest) =
-  case targetNode of
-    Nothing -> Node rn forest -- the filter is silenty dropped in the Request does not contain the required path
-    Just tn -> Node rn (addFilter (remainingPath, flt) tn:restForest)
-  where
-    targetNodeName:remainingPath = path
-    (targetNode,restForest) = splitForest targetNodeName forest
-    splitForest name forst =
-      case maybeNode of
-        Nothing -> (Nothing,forest)
-        Just node -> (Just node, delete node forest)
-      where maybeNode = find ((name==).fst.snd.rootLabel) forst
-
--- 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
-
-data TableOptions = TableOptions {
-  tblOptcolumns :: [Column]
-, tblOptpkey    :: [Text]
-}
-
-instance ToJSON TableOptions where
-  toJSON t = object [
-      "columns" .= tblOptcolumns t
-    , "pkey"   .= tblOptpkey t ]
-
+      fromInRange   = lower <= upper
 
 extractQueryResult :: Maybe ResultsWithCount -> ResultsWithCount
-extractQueryResult = fromMaybe (Nothing, 0, "", "")
+extractQueryResult = fromMaybe (Nothing, 0, [], "")

src/PostgREST/Auth.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE LambdaCase #-}
 {-|
 Module      : PostgREST.Auth
 Description : PostgREST authorization functions.
@@ -12,74 +13,89 @@ In the test suite there is an example of simple login function that can be used
 very simple authentication system inside the PostgreSQL database.
 -}
 module PostgREST.Auth (
-    setRole
-  , claimsToSQL
+    containsRole
   , jwtClaims
-  , tokenJWT
+  , JWTAttempt(..)
+  , parseJWK
   ) where
 
-import           Control.Monad           (join)
-import           Data.Aeson              (Value (..), Object)
-import           Data.Aeson.Types        (emptyObject, emptyArray)
-import qualified Data.ByteString         as BS
-import           Data.Vector             as V (null, head)
-import           Data.Map                as M (fromList, toList)
-import           Data.Monoid             ((<>))
-import           Data.String.Conversions (cs)
-import           Data.Text               (Text)
-import           Data.Time.Clock         (NominalDiffTime)
-import           PostgREST.QueryBuilder  (pgFmtLit, pgFmtIdent, unquoted)
-import qualified Web.JWT                 as JWT
-import qualified Data.HashMap.Lazy       as H
+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 qualified Crypto.JOSE.Types      as JOSE.Types
+import           Crypto.JWT
 
 {-|
-  Receives a map of JWT claims and returns a list
-  of PostgreSQL statements to set the claims as user defined GUCs.
-  Except if we have a claim called role,
-  this one is mapped to a SET ROLE statement.
-  In case there is any problem decoding the JWT it returns Nothing.
+  Possible situations encountered with client JWTs
 -}
-claimsToSQL :: JWT.ClaimsMap -> [BS.ByteString]
-claimsToSQL = map setVar . toList
-  where
-    setVar ("role", String val) = setRole val
-    setVar (k, val) = "set local postgrest.claims." <> cs (pgFmtIdent k) <>
-                      " = " <> cs (valueToVariable val) <> ";"
-    valueToVariable = pgFmtLit . unquoted
+data JWTAttempt = JWTInvalid JWTError
+                | JWTMissingSecret
+                | JWTClaims (M.HashMap Text JSON.Value)
+                deriving (Eq, Show)
 
 {-|
-  Receives the JWT secret (from config) and a JWT and
-  returns a map of JWT claims
-  In case there is any problem decoding the JWT it returns Nothing.
+  Receives the JWT secret and audience (from config) and a JWT and returns a map
+  of JWT claims.
 -}
-jwtClaims :: JWT.Secret -> Text -> NominalDiffTime -> Maybe JWT.ClaimsMap
-jwtClaims secret input time =
-  case join $ claim JWT.exp of
-    Just expires ->
-      if JWT.secondsSinceEpoch expires > time
-        then customClaims
-        else Nothing
-    _ -> customClaims
-  where
-    decoded = JWT.decodeAndVerifySignature secret input
-    claim :: (JWT.JWTClaimsSet -> a) -> Maybe a
-    claim prop = prop . JWT.claims <$> decoded
-    customClaims = claim JWT.unregisteredClaims
-
-{-| Receives the name of a role and returns a SET ROLE statement -}
-setRole :: Text -> BS.ByteString
-setRole r = "set local role " <> cs (pgFmtLit r) <> ";"
-
+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 -> 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 a) = JWT.encodeSigned JWT.HS256 secret
-                               JWT.def { JWT.unregisteredClaims = fromHashMap o }
-                          where
-                            Object o = if V.null a then emptyObject else V.head a
-                            fromHashMap :: Object -> JWT.ClaimsMap
-                            fromHashMap = M.fromList . H.toList
-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
+
+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,60 +1,87 @@
+{-# LANGUAGE LambdaCase, TemplateHaskell #-}
+{-# OPTIONS_GHC -fno-warn-type-defaults #-}
 {-|
 Module      : PostgREST.Config
 Description : Manages PostgREST configuration options.
 
-This module provides a helper function to read the command line arguments using the optparse-applicative
-and the AppConfig type to store them.
-It also can be used to define other middleware configuration that may be delegated to some sort of
-external configuration.
+This module provides a helper function to read the command line
+arguments using the optparse-applicative and the AppConfig type to store
+them.  It also can be used to define other middleware configuration that
+may be delegated to some sort of external configuration.
 
-It currently includes a hardcoded CORS policy but this could easly be turned in configurable behaviour if needed.
+It currently includes a hardcoded CORS policy but this could easly be
+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
+                        , pgVersion95
+                        , pgVersion96
                         , AppConfig (..)
                         )
        where
 
 import           Control.Applicative
-import qualified Data.ByteString.Char8       as BS
-import qualified Data.CaseInsensitive        as CI
-import           Data.List                   (intercalate)
-import           Data.String.Conversions     (cs)
-import           Data.Text                   (strip)
-import           Data.Version                (versionBranch)
+import           Control.Monad                (fail)
+import           Control.Lens                 (preview)
+import           Crypto.JWT                   (StringOrURI,
+                                               stringOrUri)
+import qualified Data.ByteString              as B
+import qualified Data.ByteString.Char8        as BS
+import qualified Data.CaseInsensitive         as CI
+import qualified Data.Configurator            as C
+import qualified Data.Configurator.Parser     as C
+import           Data.Configurator.Types      as C
+import           Data.List                    (lookup)
+import           Data.Monoid
+import           Data.Scientific              (floatingOrInteger)
+import           Data.String                  (String)
+import           Data.Text                    (dropAround,
+                                               intercalate, lines,
+                                               strip, take)
+import           Data.Text.Encoding           (encodeUtf8)
+import           Data.Text.IO                 (hPutStrLn)
+import           Data.Version                 (versionBranch)
+import           Development.GitRev           (gitHash)
 import           Network.Wai
-import           Network.Wai.Middleware.Cors (CorsResourcePolicy (..))
-import           Options.Applicative
-import           Paths_postgrest             (version)
-import           Safe                        (readMay)
-import           Web.JWT                     (Secret, secret)
-import           Prelude
+import           Network.Wai.Middleware.Cors  (CorsResourcePolicy (..))
+import           Options.Applicative          hiding (str)
+import           Paths_postgrest              (version)
+import           PostgREST.Parsers            (pRoleClaimKey)
+import           PostgREST.Types              (PgVersion(..), ApiRequestError(..),
+                                               JSPath, JSPathExp(..))
+import           Protolude                    hiding (hPutStrLn, take,
+                                               intercalate, (<>))
+import           System.IO                    (hPrint)
+import           System.IO.Error              (IOError)
+import           Text.Heredoc
+import           Text.PrettyPrint.ANSI.Leijen hiding ((<$>), (<>))
+import qualified Text.PrettyPrint.ANSI.Leijen as L
 
--- | Data type to store all command line options
+-- | Config file settings for the server
 data AppConfig = AppConfig {
-    configDatabase  :: String
-  , configAnonRole  :: String
-  , configSchema    :: String
-  , configPort      :: Int
-  , configJwtSecret :: Secret
-  , configPool      :: Int
-  , configMaxRows   :: Maybe Integer
-  }
+    configDatabase          :: Text
+  , configAnonRole          :: Text
+  , configProxyUri          :: Maybe Text
+  , configSchema            :: Text
+  , configHost              :: Text
+  , configPort              :: Int
 
-argParser :: Parser AppConfig
-argParser = AppConfig
-  <$> argument str (help "(REQUIRED) database connection string, e.g. postgres://user:pass@host:port/db" <> metavar "DB_URL")
-  <*> strOption    (long "anonymous"  <> short 'a' <> help "(REQUIRED) postgres role to use for non-authenticated requests" <> metavar "ROLE")
-  <*> strOption    (long "schema"     <> short 's' <> help "schema to use for API routes" <> metavar "NAME" <> value "public" <> showDefault)
-  <*> option auto  (long "port"       <> short 'p' <> help "port number on which to run HTTP server" <> metavar "PORT" <> value 3000 <> showDefault)
-  <*> (secret . cs <$>
-      strOption    (long "jwt-secret" <> short 'j' <> help "secret used to encrypt and decrypt JWT tokens" <> metavar "SECRET" <> value "secret" <> showDefault))
-  <*> option auto  (long "pool"       <> short 'o' <> help "max connections in database pool" <> metavar "COUNT" <> value 10 <> showDefault)
-  <*> (readMay <$> strOption  (long "max-rows"   <> short 'm' <> help "max rows in response" <> metavar "COUNT" <> value "infinity" <> showDefault))
+  , 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
 defaultCorsPolicy =  CorsResourcePolicy Nothing
@@ -76,26 +103,143 @@ corsPolicy req = case lookup "origin" headers of
   where
     headers = requestHeaders req
     accHeaders = case lookup "access-control-request-headers" headers of
-      Just hdrs -> map (CI.mk . cs . strip . cs) $ BS.split ',' hdrs
+      Just hdrs -> map (CI.mk . toS . strip . toS) $ BS.split ',' hdrs
       Nothing -> []
 
 -- | User friendly version number
-prettyVersion :: String
-prettyVersion = intercalate "." $ map show $ versionBranch version
+prettyVersion :: Text
+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
-readOptions = customExecParser parserPrefs opts
+readOptions = do
+  -- First read the config file path from command line
+  cfgPath <- customExecParser parserPrefs opts
+  -- Now read the actual config file
+  conf <- catch
+    (C.readConfig =<< C.load [C.Required cfgPath])
+    configNotfoundHint
+
+  let (mAppConf, errs) = flip C.runParserM conf $
+        AppConfig
+          <$> C.key "db-uri"
+          <*> C.key "db-anon-role"
+          <*> (mfilter (/= "") <$> C.key "server-proxy-uri")
+          <*> C.key "db-schema"
+          <*> (fromMaybe "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 . join . fmap coerceBool <$> C.key "secret-is-base64")
+          <*> parseJwtAudience "jwt-aud"
+          <*> (fromMaybe 10 . join . fmap coerceInt <$> C.key "db-pool")
+          <*> (join . fmap coerceInt <$> C.key "max-rows")
+          <*> (mfilter (/= "") <$> C.key "pre-request")
+          <*> pure False
+          <*> (fmap (fmap coerceText) <$> C.subassocs "app.settings")
+          <*> (maybe (Right [JSPKey "role"]) parseRoleClaimKey <$> C.key "role-claim-key")
+
+  case mAppConf of
+    Nothing -> do
+      forM_ errs $ hPrint stderr
+      exitFailure
+    Just appConf ->
+      return appConf
+
   where
-    opts = info (helper <*> argParser) $
-                    fullDesc
-                    <> progDesc (
-                    "PostgREST "
-                    <> prettyVersion
-                    <> " / create a REST API to an existing Postgres database"
-                    )
+    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'
+
+    coerceText :: Value -> Text
+    coerceText (String s) = s
+    coerceText v = show v
+
+    coerceInt :: (Read i, Integral i) => Value -> Maybe i
+    coerceInt (Number x) = rightToMaybe $ floatingOrInteger x
+    coerceInt (String x) = readMaybe $ toS x
+    coerceInt _          = Nothing
+
+    coerceBool :: Value -> Maybe Bool
+    coerceBool (Bool b)   = Just b
+    coerceBool (String b) = readMaybe $ toS b
+    coerceBool _          = Nothing
+
+    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 =
+  strArgument $
+    metavar "FILENAME" <>
+    help "Path to configuration file"
+
 -- | Tells the minimum PostgreSQL version required by this version of PostgREST
-minimumPgVersion :: Integer
-minimumPgVersion = 90300
+minimumPgVersion :: PgVersion
+minimumPgVersion = PgVersion 90400 "9.4"
+
+pgVersion96 :: PgVersion
+pgVersion96 = PgVersion 90600 "9.6"
+
+pgVersion95 :: PgVersion
+pgVersion95 = PgVersion 90500 "9.5"

src/PostgREST/DbRequestBuilder.hs

@@ -0,0 +1,342 @@
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE DuplicateRecordFields#-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE MultiWayIf #-}
+{-# LANGUAGE NamedFieldPuns #-}
+module PostgREST.DbRequestBuilder (
+  readRequest
+, mutateRequest
+, fieldNames
+) where
+
+import           Control.Applicative
+import           Control.Arrow             ((***))
+import           Control.Lens.Getter       (view)
+import           Control.Lens.Tuple        (_1)
+import qualified Data.ByteString.Char8     as BS
+import           Data.List                 (delete)
+import           Data.Maybe                (fromJust)
+import qualified Data.Set                  as S
+import           Data.Text                 (isInfixOf)
+import           Data.Tree
+import           Data.Either.Combinators   (mapLeft)
+
+import           Network.Wai
+
+import           Data.Foldable (foldr1)
+import qualified Data.HashMap.Strict       as M
+
+import           PostgREST.ApiRequest   ( ApiRequest(..)
+                                        , PreferRepresentation(..)
+                                        , Action(..), Target(..)
+                                        , PreferRepresentation (..)
+                                        )
+import           PostgREST.Error           (apiRequestError)
+import           PostgREST.Parsers
+import           PostgREST.RangeQuery      (NonnegRange, restrictRange, allRange)
+import           PostgREST.Types
+
+import           Protolude                hiding (from, dropWhile, drop)
+import           Text.Regex.TDFA         ((=~))
+import           Unsafe                  (unsafeHead)
+
+readRequest :: Maybe Integer -> [Relation] -> Maybe ProcDescription -> ApiRequest -> Either Response ReadRequest
+readRequest maxRows allRels proc apiRequest  =
+  mapLeft apiRequestError $
+  treeRestrictRange maxRows =<<
+  augumentRequestWithJoin schema relations =<<
+  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 pName) ) -> Just (s, tName)
+          where
+            tName = case pdReturnType <$> proc of
+              Just (SetOf (Composite qi)) -> qiName qi
+              Just (Single (Composite qi)) -> qiName qi
+              _ -> pName
+
+        _ -> Nothing
+
+    -- 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
+        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
+      _       -> allRels
+      where fakeSourceRelations = mapMaybe (toSourceRelation rootTableName) allRels
+
+-- in a relation where one of the tables matches "TableName"
+-- replace the name to that table with pg_source
+-- this "fake" relations is needed so that in a mutate query
+-- we can look a the "returning *" part which is wrapped with a "with"
+-- 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
+  where
+    nodeRestrictRange :: Maybe Integer -> ReadNode -> ReadNode
+    nodeRestrictRange m (q@Select {range_=r}, i) = (q{range_=restrictRange m r }, i)
+
+augumentRequestWithJoin :: Schema ->  [Relation] ->  ReadRequest -> Either ApiRequestError ReadRequest
+augumentRequestWithJoin schema allRels request =
+  addRelations schema allRels Nothing request
+  >>= addJoinConditions schema
+
+addRelations :: Schema -> [Relation] -> Maybe ReadRequest -> ReadRequest -> Either ApiRequestError ReadRequest
+addRelations schema allRelations parentNode (Node (query, (nodeName, _, alias, relationDetail, depth)) forest) =
+  case parentNode of
+    Just (Node (Select{from=[parentNodeTable]}, _) _) ->
+      let newFrom r = (\tName -> if tName == nodeName then tableName (relTable r) else tName) <$> from query
+          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 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 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
+    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 (.)) [
+    flip (foldr addFilter) <$> filters,
+    flip (foldr addOrder) <$> orders,
+    flip (foldr addRange) <$> ranges,
+    flip (foldr addLogicTree) <$> logicForest
+  ]
+  {-
+  The esence of what is going on above is that we are composing tree functions
+  of type (ReadRequest->ReadRequest) that are in (Either ParseError a) context
+  -}
+  where
+    filters :: Either ApiRequestError [(EmbedPath, Filter)]
+    filters = mapM pRequestFilter flts
+    logicForest :: Either ApiRequestError [(EmbedPath, LogicTree)]
+    logicForest = mapM pRequestLogicTree logFrst
+    action = iAction apiRequest
+    -- there can be no filters on the root table when we are doing insert/update/delete
+    (flts, logFrst) =
+      case action of
+        ActionInvoke _ -> (iFilters apiRequest, iLogic apiRequest)
+        ActionRead     -> (iFilters apiRequest, iLogic apiRequest)
+        _              -> join (***) (filter (( "." `isInfixOf` ) . fst)) (iFilters apiRequest, iLogic apiRequest)
+    orders :: Either ApiRequestError [(EmbedPath, [OrderTerm])]
+    orders = mapM pRequestOrder $ iOrder apiRequest
+    ranges :: Either ApiRequestError [(EmbedPath, NonnegRange)]
+    ranges = mapM pRequestRange $ M.toList $ iRange apiRequest
+
+addFilterToNode :: Filter -> ReadRequest -> ReadRequest
+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=o}, i) f
+
+addOrder :: (EmbedPath, [OrderTerm]) -> ReadRequest -> ReadRequest
+addOrder = addProperty addOrderToNode
+
+addRangeToNode :: NonnegRange -> ReadRequest -> ReadRequest
+addRangeToNode r (Node (q,i) f) = Node (q{range_=r}, i) f
+
+addRange :: (EmbedPath, NonnegRange) -> ReadRequest -> ReadRequest
+addRange = addProperty addRangeToNode
+
+addLogicTreeToNode :: LogicTree -> ReadRequest -> ReadRequest
+addLogicTreeToNode t (Node (q@Select{where_=lf},i) f) = Node (q{where_=t:lf}::ReadQuery, i) f
+
+addLogicTree :: (EmbedPath, LogicTree) -> ReadRequest -> ReadRequest
+addLogicTree = addProperty addLogicTreeToNode
+
+addProperty :: (a -> ReadRequest -> ReadRequest) -> (EmbedPath, a) -> ReadRequest -> ReadRequest
+addProperty f ([], a) rr = f a rr
+addProperty f (targetNodeName:remainingPath, a) (Node rn forest) =
+  case pathNode of
+    Nothing -> Node rn forest -- the property is silenty dropped in the Request does not contain the required path
+    Just tn -> Node rn (addProperty f (remainingPath, a) tn:delete tn forest)
+  where
+    pathNode = find (\(Node (_,(nodeName,_,alias,_,_)) _) -> nodeName == targetNodeName || alias == Just targetNodeName) forest
+
+mutateRequest :: ApiRequest -> TableName -> [Text] -> [FieldName] -> Either Response MutateRequest
+mutateRequest apiRequest tName pkCols fldNames = mapLeft apiRequestError $
+  case action of
+    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
+    returnings = if iPreferRepresentation apiRequest == None then [] else fldNames
+    filters = map snd <$> mapM pRequestFilter mutateFilters
+    logic = map snd <$> mapM pRequestLogicTree logicFilters
+    combinedLogic = foldr addFilterToLogicForest <$> logic <*> filters
+    -- update/delete filters can be only on the root table
+    (mutateFilters, logicFilters) = join (***) onlyRoot (iFilters apiRequest, iLogic apiRequest)
+    onlyRoot = filter (not . ( "." `isInfixOf` ) . fst)
+
+fieldNames :: ReadRequest -> [FieldName]
+fieldNames (Node (sel, _) forest) =
+  map (fst . view _1) (select sel) ++ map colName fks
+  where
+    fks = concatMap (fromMaybe [] . f) forest
+    f (Node (_, (_, Just Relation{relFColumns=cols, relType=Parent}, _, _, _)) _) = Just cols
+    f _ = Nothing
+
+-- Traditional filters(e.g. id=eq.1) are added as root nodes of the LogicTree
+-- they are later concatenated with AND in the QueryBuilder
+addFilterToLogicForest :: Filter -> [LogicTree] -> [LogicTree]
+addFilterToLogicForest flt lf = Stmnt flt : lf

src/PostgREST/DbStructure.hs

@@ -3,61 +3,64 @@
 {-# LANGUAGE QuasiQuotes           #-}
 {-# LANGUAGE ScopedTypeVariables   #-}
 {-# LANGUAGE TypeSynonymInstances  #-}
+{-# LANGUAGE NamedFieldPuns  #-}
 module PostgREST.DbStructure (
   getDbStructure
 , accessibleTables
-, doesProcExist
-, doesProcReturnJWT
+, accessibleProcs
+, schemaDescription
+, getPgVersion
 ) where
 
-import qualified Hasql.Query             as H
-import qualified Hasql.Encoders          as HE
-import qualified Hasql.Decoders          as HD
+import qualified Hasql.Decoders                as HD
+import qualified Hasql.Encoders                as HE
+import qualified Hasql.Query                   as H
 
 import           Control.Applicative
-import           Control.Monad          (join, replicateM)
-import           Data.Functor.Contravariant (contramap)
-import           Text.InterpolatedString.Perl6 (q)
-import           Data.List              (elemIndex, find, subsequences, sort, transpose)
-import           Data.Maybe             (fromMaybe, fromJust, isJust, mapMaybe, listToMaybe)
-import           Data.Monoid
-import           Data.Text              (Text, split)
-import qualified Hasql.Session          as H
+import qualified Data.HashMap.Strict           as M
+import qualified Data.List                     as L
+import           Data.Set                      as S (fromList)
+import           Data.Text                     (split, strip,
+                                                breakOn, dropAround,
+                                                splitOn)
+import qualified Data.Text                     as T
+import qualified Hasql.Session                 as H
 import           PostgREST.Types
+import           Text.InterpolatedString.Perl6 (q)
 
-import           GHC.Exts               (groupWith)
-import           Data.Int               (Int32)
-import           Prelude
+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
+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
     }
 
-encodeQi :: HE.Params QualifiedIdentifier
-encodeQi =
-  contramap qiSchema (HE.value HE.text) <>
-  contramap qiName   (HE.value HE.text)
-
 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]
@@ -65,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
@@ -93,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
@@ -102,32 +105,95 @@ decodeSynonyms cols =
     <*> HD.value HD.text <*> HD.value HD.text
     <*> HD.value HD.text <*> HD.value HD.text
 
-doesProcExist :: H.Query QualifiedIdentifier Bool
-doesProcExist =
-  H.statement sql encodeQi (HD.singleRow (HD.value HD.bool)) True
- where
-  sql = [q| SELECT EXISTS (
-      SELECT 1
-      FROM   pg_catalog.pg_namespace n
-      JOIN   pg_catalog.pg_proc p
-      ON     pronamespace = n.oid
-      WHERE  nspname = $1
-      AND    proname = $2
-    ) |]
+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)
 
-doesProcReturnJWT :: H.Query QualifiedIdentifier Bool
-doesProcReturnJWT =
-  H.statement sql encodeQi (HD.singleRow (HD.value HD.bool)) True
- where
-  sql = [q| SELECT EXISTS (
-      SELECT 1
-      FROM   pg_catalog.pg_namespace n
-      JOIN   pg_catalog.pg_proc p
-      ON     pronamespace = n.oid
-      WHERE  nspname = $1
-      AND    proname = $2
-      AND    pg_catalog.pg_get_function_result(p.oid) like '%jwt_claims'
-    ) |]
+    addName :: ProcDescription -> (Text, ProcDescription)
+    addName pd = (pdName pd, pd)
+
+    parseArgs :: Text -> [PgArg]
+    parseArgs = mapMaybe parseArg . filter (not . isPrefixOf "OUT" . toS) . map strip . split (==',')
+
+    parseArg :: Text -> Maybe PgArg
+    parseArg a =
+      let arg = lastDef "" $ splitOn "INOUT " a
+          (body, def) = breakOn " DEFAULT " arg
+          (name, typ) = breakOn " " body in
+      if T.null typ
+         then Nothing
+         else Just $
+           PgArg (dropAround (== '"') name) (strip typ) (T.null def)
+
+    parseRetType :: Text -> Text -> Bool -> Char -> RetType
+    parseRetType schema name isSetOf typ
+      | isSetOf   = SetOf pgType
+      | otherwise = Single pgType
+      where
+        qi = QualifiedIdentifier schema name
+        pgType = case typ of
+          'c' -> Composite qi
+          'p' -> if name == "record" -- Only pg pseudo type that is a row type is 'record'
+                   then Composite qi
+                   else Scalar qi
+          _   -> Scalar qi -- 'b'ase, 'd'omain, 'e'num, 'r'ange
+
+    parseVolatility :: Char -> ProcVolatility
+    parseVolatility v | v == 'i' = Immutable
+                      | v == 's' = Stable
+                      | otherwise = Volatile -- only 'v' can happen here
+
+allProcs :: H.Query Schema (M.HashMap Text [ProcDescription])
+allProcs = H.statement (toS procsSqlQuery) (HE.value HE.text) decodeProcs True
+
+accessibleProcs :: H.Query Schema (M.HashMap Text [ProcDescription])
+accessibleProcs = H.statement (toS sql) (HE.value HE.text) decodeProcs True
+  where
+    sql = procsSqlQuery <> " AND has_function_privilege(p.oid, 'execute')"
+
+procsSqlQuery :: SqlQuery
+procsSqlQuery = [q|
+  SELECT p.proname as "proc_name",
+         d.description as "proc_description",
+         pg_get_function_arguments(p.oid) as "args",
+         tn.nspname as "rettype_schema",
+         coalesce(comp.relname, t.typname) as "rettype_name",
+         p.proretset as "rettype_is_setof",
+         t.typtype as "rettype_typ",
+         p.provolatile
+  FROM pg_proc p
+    JOIN pg_namespace pn ON pn.oid = p.pronamespace
+    JOIN pg_type t ON t.oid = p.prorettype
+    JOIN pg_namespace tn ON tn.oid = t.typnamespace
+    LEFT JOIN pg_class comp ON comp.oid = t.typrelid
+    LEFT JOIN pg_catalog.pg_description as d on d.objoid = p.oid
+  WHERE  pn.nspname = $1
+|]
+
+schemaDescription :: H.Query Schema (Maybe Text)
+schemaDescription =
+    H.statement sql (HE.value HE.text) (join <$> HD.maybeRow (HD.nullableValue HD.text)) True
+  where
+    sql = [q|
+      select
+        description
+      from
+        pg_catalog.pg_namespace n
+        left join pg_catalog.pg_description d on d.objoid = n.oid
+      where
+        n.nspname = $1 |]
 
 accessibleTables :: H.Query Schema [Table]
 accessibleTables =
@@ -137,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
@@ -146,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)
@@ -156,16 +224,6 @@ accessibleTables =
       )
     order by relname |]
 
-synonymousColumns :: [(Column,Column)] -> [Column] -> [[Column]]
-synonymousColumns allSyns cols = synCols'
-  where
-    syns = sort $ filter ((== colTable (head cols)) . colTable . fst) allSyns
-    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
@@ -173,33 +231,85 @@ addForeignKeys rels = map addFk
     fk col = join $ relToFk col <$> find (lookupFn col) rels
     lookupFn :: Column -> Relation -> Bool
     lookupFn c Relation{relColumns=cs, relType=rty} = c `elem` cs && rty==Child
-    -- lookupFn _ _ = False
-    relToFk col Relation{relColumns=cols, relFColumns=colsF} = ForeignKey <$> colF
-      where
-        pos = elemIndex col cols
-        colF = (colsF !!) <$> pos
+    relToFk col Relation{relColumns=cols, relFColumns=colsF} = do
+      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 $ head 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}
@@ -208,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 . head) (synonymousColumns syns cols)
-        newTable = (colTable . head) <$> 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 =
@@ -236,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
@@ -245,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,
@@ -269,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
@@ -287,13 +412,13 @@ allColumns tabs =
                         CASE
                             WHEN bt.typelem <> 0::oid AND bt.typlen = (-1) THEN 'ARRAY'::text
                             WHEN nbt.nspname = 'pg_catalog'::name THEN format_type(t.typbasetype, NULL::integer)
-                            ELSE 'USER-DEFINED'::text
+                            ELSE format_type(a.atttypid, a.atttypmod)
                         END
                         ELSE
                         CASE
                             WHEN t.typelem <> 0::oid AND t.typlen = (-1) THEN 'ARRAY'::text
                             WHEN nt.nspname = 'pg_catalog'::name THEN format_type(a.atttypid, NULL::integer)
-                            ELSE 'USER-DEFINED'::text
+                            ELSE format_type(a.atttypid, a.atttypmod)
                         END
                     END::information_schema.character_data AS data_type,
                 information_schema._pg_char_max_length(information_schema._pg_truetypid(a.*, t.*), information_schema._pg_truetypmod(a.*, t.*))::information_schema.cardinal_number AS character_maximum_length,
@@ -348,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
@@ -357,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,
@@ -389,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|
@@ -552,77 +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
-  sql = [q|
-    WITH synonyms AS (
-      /*
-      -- CTE to replace the view from information_schema because the information in it depended on the logged in role
-      -- notice the commented line
-      */
-      WITH view_column_usage AS (
-        SELECT DISTINCT
-               CAST(current_database() AS character varying) AS view_catalog,
-               CAST(nv.nspname AS character varying) AS view_schema,
-               CAST(v.relname AS character varying) AS view_name,
-               CAST(current_database() AS character varying) AS table_catalog,
-               CAST(nt.nspname AS character varying) AS table_schema,
-               CAST(t.relname AS character varying) AS table_name,
-               CAST(a.attname AS character varying) AS column_name
-        FROM pg_namespace nv, pg_class v, pg_depend dv,
-             pg_depend dt, pg_class t, pg_namespace nt,
-             pg_attribute a
-        WHERE nv.oid = v.relnamespace
-              AND v.relkind = 'v'
-              AND v.oid = dv.refobjid
-              AND dv.refclassid = 'pg_catalog.pg_class'::regclass
-              AND dv.classid = 'pg_catalog.pg_rewrite'::regclass
-              AND dv.deptype = 'i'
-              AND dv.objid = dt.objid
-              AND dv.refobjid <> dt.refobjid
-              AND dt.classid = 'pg_catalog.pg_rewrite'::regclass
-              AND dt.refclassid = 'pg_catalog.pg_class'::regclass
-              AND dt.refobjid = t.oid
-              AND t.relnamespace = nt.oid
-              AND t.relkind IN ('r', 'v', 'f')
-              AND t.oid = a.attrelid
-              AND dt.refobjsubid = a.attnum
-              /*--AND pg_has_role(t.relowner, 'USAGE')*/
-      )
-      SELECT
-        vcu.table_schema AS src_table_schema,
-        vcu.table_name AS src_table_name,
-        vcu.column_name AS src_column_name,
-        view.schemaname AS syn_table_schema,
-        view.viewname AS syn_table_name,
-        view.definition AS view_definition
-      FROM
-        pg_catalog.pg_views AS view,
-        view_column_usage AS vcu
-      WHERE
-        view.schemaname = vcu.view_schema AND
-        view.viewname = vcu.view_name AND
-        view.schemaname NOT IN ('pg_catalog', 'information_schema')
-        /*--AND (SELECT COUNT(*) FROM information_schema.view_table_usage WHERE view_schema = view.schemaname AND view_name = view.viewname) = 1*/
+  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
+    ),
+    removed_subselects as(
+      select
+        view_schema, view_name,
+        regexp_replace(view_definition, ':subselect {.*?:constraintDeps <>} :location', '', 'g') as x
+      from views
+    ),
+    target_lists as(
+      select
+        view_schema, view_name,
+        regexp_split_to_array(x, 'targetList') as x
+      from removed_subselects
+    ),
+    last_target_list_wo_tail as(
+      select
+        view_schema, view_name,
+        (regexp_split_to_array(x[array_upper(x, 1)], ':onConflict'))[1] as x
+      from target_lists
+    ),
+    target_entries as(
+      select
+        view_schema, view_name,
+        unnest(regexp_split_to_array(x, 'TARGETENTRY')) as entry
+      from last_target_list_wo_tail
+    ),
+    results as(
+      select
+        view_schema, view_name,
+        substring(entry from ':resname (.*?) :') as view_colum_name,
+        substring(entry from ':resorigtbl (.*?) :') as resorigtbl,
+        substring(entry from ':resorigcol (.*?) :') as resorigcol
+      from target_entries
     )
-    SELECT
-      src_table_schema, src_table_name, src_column_name,
-      syn_table_schema, syn_table_name,
-      (regexp_matches(view_definition, CONCAT('\.(', src_column_name, ')(?=,|$)'), 'gn'))[1] AS syn_column_name
-    FROM synonyms
-    UNION (
-      SELECT
-        src_table_schema, src_table_name, src_column_name,
-        syn_table_schema, syn_table_name,
-        (regexp_matches(view_definition, CONCAT('\.', src_column_name, '\sAS\s("?)(.+?)\1(,|$)'), 'gn'))[2] AS syn_column_name /* " <- for syntax highlighting */
-      FROM synonyms
-    ) |]
+    select
+      sch.nspname as table_schema,
+      tbl.relname as table_name,
+      col.attname as table_column_name,
+      res.view_schema,
+      res.view_name,
+      res.view_colum_name
+    from results res
+    join pg_class tbl on tbl.oid::text = res.resorigtbl
+    join pg_attribute col on col.attrelid = tbl.oid and col.attnum::text = res.resorigcol
+    join pg_namespace sch on sch.oid = tbl.relnamespace
+    where resorigtbl <> '0'
+    order by view_schema, view_name, view_colum_name;
+    |]
 
-synonymFromRow :: [Column] -> (Text,Text,Text,Text,Text,Text) -> Maybe (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

@@ -2,64 +2,166 @@
 {-# LANGUAGE FlexibleInstances    #-}
 {-# LANGUAGE TypeSynonymInstances #-}
 
-module PostgREST.Error (pgErrResponse, errResponse) where
-
+module PostgREST.Error (
+  apiRequestError
+, pgError
+, simpleError
+, singularityError
+, binaryFieldError
+, connectionLostError
+, encodeError
+, gucHeadersError
+) where
 
+import           Protolude
 import           Data.Aeson                ((.=))
 import qualified Data.Aeson                as JSON
-import           Data.Monoid               ((<>))
-import           Data.String.Conversions   (cs)
-import           Data.Text                 (Text)
-import qualified Data.Text                 as T
+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)
 
-errResponse :: HT.Status -> Text -> Response
-errResponse status message = responseLBS status [(hContentType, "application/json")] (cs $ T.concat ["{\"message\":\"",message,"\"}"])
+apiRequestError :: ApiRequestError -> Response
+apiRequestError err =
+  errorResponse status
+    [toHeader CTApplicationJSON] err
+  where
+    status =
+      case err of
+        ActionInappropriate -> HT.status405
+        UnsupportedVerb -> HT.status405
+        InvalidBody _ -> HT.status400
+        ParseRequestError _ _ -> HT.status400
+        NoRelationBetween _ _ -> HT.status400
+        InvalidRange -> HT.status416
+        UnknownRelation -> HT.status404
+        InvalidFilters -> HT.status405
 
-pgErrResponse :: H.Error -> Response
-pgErrResponse e = responseLBS (httpStatus e)
-  [(hContentType, "application/json")] (JSON.encode e)
+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 -> [Header] -> a -> Response
+errorResponse status hdrs e =
+  responseLBS status hdrs $ encodeError e
+
+pgError :: Bool -> P.UsageError -> Response
+pgError authed e =
+  let status = httpStatus authed e
+      jsonType = toHeader CTApplicationJSON
+      wwwAuth = ("WWW-Authenticate", "Bearer")
+      hdrs = if status == HT.status401
+                then [jsonType, wwwAuth]
+                else [jsonType] in
+  responseLBS status hdrs (encodeError e)
+
+singularityError :: Integer -> Response
+singularityError numRows =
+  responseLBS HT.status406
+    [toHeader CTSingularJSON]
+    $ toS . formatGeneralError
+      "JSON object requested, multiple (or no) rows returned"
+      $ unwords
+        [ "Results contain", show numRows, "rows,"
+        , toS (toMime CTSingularJSON), "requires 1 row"
+        ]
+  where
+    formatGeneralError :: Text -> Text -> Text
+    formatGeneralError message details = toS . JSON.encode $
+      JSON.object ["message" .= message, "details" .= details]
+
+
+binaryFieldError :: Response
+binaryFieldError =
+  simpleError HT.status406 [] (toS (toMime CTOctetStream) <>
+  " requested but a single column was not selected")
+
+gucHeadersError :: Response
+gucHeadersError =
+ simpleError HT.status500 []
+ "response.headers guc must be a JSON array composed of objects with a single key and a string value"
+
+connectionLostError :: Response
+connectionLostError =
+  simpleError HT.status503 [] "Database connection lost, retrying the connection."
+
+encodeError :: JSON.ToJSON a => a -> LByteString
+encodeError = JSON.encode
+
+instance JSON.ToJSON ApiRequestError where
+  toJSON (ParseRequestError message details) = JSON.object [
+    "message" .= message, "details" .= details]
+  toJSON ActionInappropriate = JSON.object [
+    "message" .= ("Bad Request" :: Text)]
+  toJSON (InvalidBody errorMessage) = JSON.object [
+    "message" .= (toS errorMessage :: Text)]
+  toJSON InvalidRange = JSON.object [
+    "message" .= ("HTTP Range error" :: Text)]
+  toJSON UnknownRelation = JSON.object [
+    "message" .= ("Unknown relation" :: Text)]
+  toJSON (NoRelationBetween parent child) = JSON.object [
+    "message" .= ("Could not find foreign keys between these entities, No relation found between " <> parent <> " and " <> child :: Text)]
+  toJSON UnsupportedVerb = JSON.object [
+    "message" .= ("Unsupported HTTP verb" :: Text)]
+  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 [
+    "code" .= ("" :: Text),
+    "message" .= ("Database connection error" :: Text),
+    "details" .= (toS $ fromMaybe "" e :: Text)]
+  toJSON (P.SessionError e) = JSON.toJSON e -- H.Error
 
 instance JSON.ToJSON H.Error where
-  toJSON (H.ResultError (H.ServerError c m d h)) = JSON.object [
-    "code" .= (cs c::T.Text),
-    "message" .= (cs m::T.Text),
-    "details" .= (fmap cs d::Maybe T.Text),
-    "hint" .= (fmap cs h::Maybe T.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" .= (cs m::T.Text)]
+    "message" .= (m::Text)]
   toJSON (H.ResultError (H.RowError i H.EndOfInput)) = JSON.object [
-    "message" .= ("Row error: end of input"::String),
+    "message" .= ("Row error: end of input"::Text),
     "details" .=
-      ("Attempt to parse more columns than there are in the result"::String),
-    "details" .= ("Row number " <> show i)]
+      ("Attempt to parse more columns than there are in the result"::Text),
+    "details" .= (("Row number " <> show i)::Text)]
   toJSON (H.ResultError (H.RowError i H.UnexpectedNull)) = JSON.object [
-    "message" .= ("Row error: unexpected null"::String),
-    "details" .= ("Attempt to parse a NULL as some value."::String),
-    "details" .= ("Row number " <> show i)]
+    "message" .= ("Row error: unexpected null"::Text),
+    "details" .= ("Attempt to parse a NULL as some value."::Text),
+    "details" .= (("Row number " <> show i)::Text)]
   toJSON (H.ResultError (H.RowError i (H.ValueError d))) = JSON.object [
-    "message" .= ("Row error: Wrong value parser used"::String),
+    "message" .= ("Row error: Wrong value parser used"::Text),
     "details" .= d,
-    "details" .= ("Row number " <> show i)]
+    "details" .= (("Row number " <> show i)::Text)]
   toJSON (H.ResultError (H.UnexpectedAmountOfRows i)) = JSON.object [
-    "message" .= ("Unexpected amount of rows"::String),
+    "message" .= ("Unexpected amount of rows"::Text),
     "details" .= i]
   toJSON (H.ClientError d) = JSON.object [
-    "message" .= ("Database client error"::String),
-    "details" .= (fmap cs d::Maybe T.Text)]
+    "message" .= ("Database client error"::Text),
+    "details" .= (fmap toS d::Maybe Text)]
 
-httpStatus :: H.Error -> HT.Status
-httpStatus (H.ResultError (H.ServerError c _ _ _)) =
-  case cs c of
+httpStatus :: Bool -> P.UsageError -> HT.Status
+httpStatus _ (P.ConnectionError _) = HT.status503
+httpStatus authed (P.SessionError (H.ResultError (H.ServerError c m _ _))) =
+  case toS c of
     '0':'8':_ -> HT.status503 -- pg connection err
     '0':'9':_ -> HT.status500 -- triggered action exception
     '0':'L':_ -> HT.status403 -- invalid grantor
     '0':'P':_ -> HT.status403 -- invalid role specification
-    "23503" -> HT.status409 -- foreign_key_violation
-    "23505" -> HT.status409 -- unique_violation
+    "23503"   -> HT.status409 -- foreign_key_violation
+    "23505"   -> HT.status409 -- unique_violation
     '2':'5':_ -> HT.status500 -- invalid tx state
     '2':'8':_ -> HT.status403 -- invalid auth specification
     '2':'D':_ -> HT.status500 -- invalid tx termination
@@ -74,10 +176,13 @@ httpStatus (H.ResultError (H.ServerError c _ _ _)) =
     '5':'8':_ -> HT.status500 -- system error
     'F':'0':_ -> HT.status500 -- conf file error
     'H':'V':_ -> HT.status500 -- foreign data wrapper error
+    "P0001"   -> HT.status400 -- default code for "raise"
     'P':'0':_ -> HT.status500 -- PL/pgSQL Error
     'X':'X':_ -> HT.status500 -- internal Error
-    "42P01" -> HT.status404 -- undefined table
-    "42501" -> HT.status404 -- insufficient privilege
-    _ -> HT.status400
-httpStatus (H.ResultError _) = HT.status500
-httpStatus (H.ClientError _) = HT.status503
+    "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/Main.hs

@@ -1,104 +0,0 @@
-{-# LANGUAGE CPP #-}
-
-module Main where
-
-
-import           PostgREST.App
-import           PostgREST.Config                     (AppConfig (..),
-                                                       minimumPgVersion,
-                                                       prettyVersion,
-                                                       readOptions)
-import           PostgREST.DbStructure
-import           PostgREST.Error                      (errResponse, pgErrResponse)
-import           PostgREST.Middleware
-import           PostgREST.QueryBuilder               (inTransaction, Isolation(..))
-
-import           Control.Monad                        (unless, void)
-import           Data.Monoid                          ((<>))
-import           Data.Pool
-import           Data.String.Conversions              (cs)
-import           Data.Time.Clock.POSIX                (getPOSIXTime)
-import qualified Hasql.Query                          as H
-import qualified Hasql.Connection                     as H
-import qualified Hasql.Session                        as H
-import qualified Hasql.Decoders                       as HD
-import qualified Hasql.Encoders                       as HE
-import qualified Network.HTTP.Types.Status            as HT
-import           Network.Wai
-import           Network.Wai.Handler.Warp
-import           Network.Wai.Middleware.RequestLogger (logStdout)
-import           System.IO                            (BufferMode (..),
-                                                       hSetBuffering, stderr,
-                                                       stdin, stdout)
-import           Web.JWT                              (secret)
-
-#ifndef mingw32_HOST_OS
-import           System.Posix.Signals
-import           Control.Concurrent                   (myThreadId)
-import           Control.Exception.Base               (throwTo, AsyncException(..))
-#endif
-
-isServerVersionSupported :: H.Session Bool
-isServerVersionSupported = do
-  ver <- H.query () pgVersion
-  return $ read (cs ver) >= minimumPgVersion
- where
-  pgVersion =
-    H.statement "SHOW server_version_num"
-      HE.unit (HD.singleRow $ HD.value HD.text) True
-
-main :: IO ()
-main = do
-  hSetBuffering stdout LineBuffering
-  hSetBuffering stdin  LineBuffering
-  hSetBuffering stderr NoBuffering
-
-  conf <- readOptions
-  let port = configPort conf
-
-  unless (secret "secret" /= configJwtSecret conf) $
-    putStrLn "WARNING, running in insecure mode, JWT secret is the default value"
-  Prelude.putStrLn $ "Listening on port " ++
-    (show $ configPort conf :: String)
-
-  let pgSettings = cs (configDatabase conf)
-      appSettings = setPort port
-                  . setServerName (cs $ "postgrest/" <> prettyVersion)
-                  $ defaultSettings
-      middle = logStdout . defaultMiddle
-
-  pool <- createPool (H.acquire pgSettings)
-            (either (const $ return ()) H.release) 1 1 (configPool conf)
-
-  dbStructure <- withResource pool $ \case
-    Left err -> error $ show err
-    Right c -> do
-      supported <- H.run isServerVersionSupported c
-      case supported of
-        Left e -> error $ show e
-        Right good -> unless good $
-          error (
-            "Cannot run in this PostgreSQL version, PostgREST needs at least "
-            <> show minimumPgVersion)
-
-      dbOrError <- H.run (getDbStructure (cs $ configSchema conf)) c
-      either (error . show) return dbOrError
-
-#ifndef mingw32_HOST_OS
-  tid <- myThreadId
-  void $ installHandler keyboardSignal (Catch $ do
-      destroyAllResources pool
-      throwTo tid UserInterrupt
-    ) Nothing
-#endif
-
-  runSettings appSettings $ middle $ \ req respond -> do
-    time <- getPOSIXTime
-    body <- strictRequestBody req
-    let handleReq = H.run $ inTransaction ReadCommitted
-          (runWithClaims conf time (app dbStructure conf body) req)
-    withResource pool $ \case
-      Left err -> respond $ errResponse HT.status500 (cs . show $ err)
-      Right c -> do
-        resOrError <- handleReq c
-        either (respond . pgErrResponse) respond resOrError

src/PostgREST/Middleware.hs

@@ -1,65 +1,63 @@
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE FlexibleContexts #-}
 
 module PostgREST.Middleware where
 
-import           Data.Maybe                    (fromMaybe)
-import           Data.Text
-import           Data.String.Conversions       (cs)
-import           Data.Time.Clock               (NominalDiffTime)
-import qualified Hasql.Session                 as H
+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.Header     (hAccept, hAuthorization)
-import           Network.HTTP.Types.Status     (status415, status400)
-import           Network.Wai                   (Application, Request (..), Response,
-                                                requestHeaders)
+import           Network.HTTP.Types.Status     (unauthorized401, status500)
+import           Network.Wai                   (Application, Response)
 import           Network.Wai.Middleware.Cors   (cors)
 import           Network.Wai.Middleware.Gzip   (def, gzip)
 import           Network.Wai.Middleware.Static (only, staticPolicy)
 
-import           PostgREST.ApiRequest       (pickContentType)
-import           PostgREST.Auth                (setRole, jwtClaims, claimsToSQL)
+import           PostgREST.ApiRequest          (ApiRequest(..))
+import           PostgREST.Auth                (JWTAttempt(..))
 import           PostgREST.Config              (AppConfig (..), corsPolicy)
-import           PostgREST.Error               (errResponse)
+import           PostgREST.Error               (simpleError)
+import           PostgREST.QueryBuilder        (pgFmtLit, unquoted, pgFmtSetLocal)
 
-import           Prelude hiding(concat)
+import           Protolude                     hiding (concat, null)
 
-import qualified Data.Map.Lazy           as M
-
-runWithClaims :: AppConfig -> NominalDiffTime ->
-                 (Request -> H.Session Response) ->
-                 Request -> H.Session Response
-runWithClaims conf time app req = do
-    H.sql setAnon
-    case split (== ' ') (cs auth) of
-      ("Bearer" : tokenStr : _) ->
-        case jwtClaims jwtSecret tokenStr time of
-          Just claims ->
-            if M.member "role" claims
-            then do
-              mapM_ H.sql $ claimsToSQL claims
-              app req
-            else invalidJWT
-          _ -> invalidJWT
-      _ -> app req
+runWithClaims :: AppConfig -> JWTAttempt ->
+                 (ApiRequest -> H.Transaction Response) ->
+                 ApiRequest -> H.Transaction Response
+runWithClaims conf eClaims app req =
+  case eClaims of
+    JWTInvalid JWTExpired -> return $ unauthed "JWT expired"
+    JWTInvalid e -> return $ unauthed $ show e
+    JWTMissingSecret -> return $ simpleError status500 [] "Server lacks JWT secret"
+    JWTClaims claims -> do
+      H.sql $ toS.mconcat $ setSchemaSql ++ setRoleSql ++ claimsSql ++ headersSql ++ cookiesSql ++ appSettingsSql
+      mapM_ H.sql customReqCheck
+      app req
+      where
+        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 = JSON.String . toS $ configAnonRole conf
+        customReqCheck = (\f -> "select " <> toS f <> "();") <$> configReqCheck conf
   where
-    hdrs = requestHeaders req
-    jwtSecret = configJwtSecret conf
-    auth = fromMaybe "" $ lookup hAuthorization hdrs
-    anon = cs $ configAnonRole conf
-    setAnon = setRole anon
-    invalidJWT = return $ errResponse status400 "Invalid JWT"
-
-unsupportedAccept :: Application -> Application
-unsupportedAccept app req respond =
-  case accept of
-    Left _ -> respond $ errResponse status415 "Unsupported Accept header, try: application/json"
-    Right _ -> app req respond
-  where accept = pickContentType $ lookup hAccept $ requestHeaders req
+    unauthed message = simpleError
+      unauthorized401
+      [( "WWW-Authenticate"
+        , "Bearer error=\"invalid_token\", " <>
+          "error_description=" <> show message
+      )]
+      message
 
 defaultMiddle :: Application -> Application
 defaultMiddle =
     gzip def
   . cors corsPolicy
   . staticPolicy (only [("favicon.ico", "static/favicon.ico")])
-  . unsupportedAccept

src/PostgREST/OpenAPI.hs

@@ -0,0 +1,369 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module PostgREST.OpenAPI (
+  encodeOpenAPI
+  , isMalformedProxyUri
+  , pickProxy
+  ) where
+
+import           Control.Arrow               ((&&&))
+import           Control.Lens
+import           Data.Aeson                  (decode, encode)
+import           Data.HashMap.Strict.InsOrd  (InsOrdHashMap, fromList)
+import           Data.Maybe                  (fromJust)
+import qualified Data.Set                    as Set
+import           Data.String                 (IsString (..))
+import           Data.Text                   (unpack, pack, init, tail, toLower, intercalate, append, dropWhile, breakOn)
+import           Network.URI                 (parseURI, isAbsoluteURI,
+                                              URI (..), URIAuth (..))
+
+import           Protolude hiding              ((&), Proxy, get, intercalate, dropWhile)
+
+import           Data.Swagger
+
+import           PostgREST.ApiRequest        (ContentType(..))
+import           PostgREST.Config            (prettyVersion, docsVersion)
+import           PostgREST.Types             (Table(..), Column(..), PgArg(..), ForeignKey(..),
+                                              PrimaryKey(..), Proxy(..), ProcDescription(..), toMime)
+
+makeMimeList :: [ContentType] -> MimeList
+makeMimeList cs = MimeList $ map (fromString . toS . toMime) cs
+
+toSwaggerType :: Text -> SwaggerType t
+toSwaggerType "text"      = SwaggerString
+toSwaggerType "integer"   = SwaggerInteger
+toSwaggerType "boolean"   = SwaggerBoolean
+toSwaggerType "numeric"   = SwaggerNumber
+toSwaggerType _           = SwaggerString
+
+makeTableDef :: [PrimaryKey] -> (Table, [Column], [Text]) -> (Text, Schema)
+makeTableDef pks (t, cs, _) =
+  let tn = tableName t in
+      (tn, (mempty :: Schema)
+        & description .~ tableDescription t
+        & type_ .~ SwaggerObject
+        & properties .~ fromList (map (makeProperty pks) cs)
+        & required .~ map colName (filter (not . colNullable) cs))
+
+makeProperty :: [PrimaryKey] -> Column -> (Text, Referenced Schema)
+makeProperty pks c = (colName c, Inline s)
+  where
+    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)
+
+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)
+  where
+    s = (mempty :: Schema)
+          & type_ .~ toSwaggerType t
+          & format ?~ t
+
+makePreferParam :: [Text] -> Param
+makePreferParam ts =
+  (mempty :: Param)
+  & name        .~ "Prefer"
+  & description ?~ "Preference"
+  & required    ?~ False
+  & schema .~ ParamOther ((mempty :: ParamOtherSchema)
+    & in_ .~ ParamHeader
+    & type_ .~ SwaggerString
+    & enum_ .~ decode (encode ts))
+
+makeProcParam :: ProcDescription -> [Referenced Param]
+makeProcParam pd =
+  [ Inline $ (mempty :: Param)
+    & name     .~ "args"
+    & required ?~ True
+    & schema   .~ (ParamBody $ Inline $ makeProcSchema pd)
+  , Ref $ Reference "preferParams"
+  ]
+
+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
+      & format ?~ colType c))
+
+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]
+      & summary .~ tSum
+      & description .~ mfilter (/="") tDesc
+    getOp = tOp
+      & 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
+      & parameters .~ map ref ["body." <> tn, "preferReturn"]
+      & at 201 ?~ "Created"
+    patchOp = tOp
+      & parameters .~ map ref (rs <> ["body." <> tn, "preferReturn"])
+      & at 204 ?~ "No Content"
+    deletOp = tOp
+      & 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
+    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)
+      & summary .~ pSum
+      & description .~ mfilter (/="") pDesc
+      & parameters .~ makeProcParam pd
+      & tags .~ Set.fromList ["(rpc) " <> pdName pd]
+      & produces ?~ makeMimeList [CTApplicationJSON, CTSingularJSON]
+      & at 200 ?~ "OK"
+    pe = (mempty :: PathItem) & post ?~ postOp
+
+makeRootPathItem :: (FilePath, PathItem)
+makeRootPathItem = ("/", p)
+  where
+    getOp = (mempty :: Operation)
+      & tags .~ Set.fromList ["Introspection"]
+      & summary ?~ "OpenAPI description (this document)"
+      & produces ?~ makeMimeList [CTOpenAPI, CTApplicationJSON]
+      & at 200 ?~ "OK"
+    pr = (mempty :: PathItem) & get ?~ getOp
+    p = pr
+
+makePathItems :: [ProcDescription] -> [(Table, [Column], [Text])] -> InsOrdHashMap FilePath PathItem
+makePathItems pds ti = fromList $ makeRootPathItem :
+  map makePathItem ti ++ map makeProcPathItem pds
+
+escapeHostName :: Text -> Text
+escapeHostName "*"  = "0.0.0.0"
+escapeHostName "*4" = "0.0.0.0"
+escapeHostName "!4" = "0.0.0.0"
+escapeHostName "*6" = "0.0.0.0"
+escapeHostName "!6" = "0.0.0.0"
+escapeHostName h    = h
+
+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 ?~ d)
+  & externalDocs ?~ ((mempty :: ExternalDocs)
+    & description ?~ "PostgREST Documentation"
+    & url .~ URL ("https://postgrest.org/en/" <> docsVersion <> "/api.html"))
+  & host .~ h'
+  & 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) -> 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.
+  A valid proxy uri should be an absolute uri without query and user info,
+  only http(s) schemes are valid, port number range is 1-65535.
+
+  For example
+  http://postgrest.com/openapi.json
+  https://postgrest.com:8080/openapi.json
+-}
+isMalformedProxyUri :: Maybe Text -> Bool
+isMalformedProxyUri Nothing =  False
+isMalformedProxyUri (Just uri)
+  | isAbsoluteURI (toS uri) = not $ isUriValid $ toURI uri
+  | otherwise = True
+
+toURI :: Text -> URI
+toURI uri = fromJust $ parseURI (toS uri)
+
+pickProxy :: Maybe Text -> Maybe Proxy
+pickProxy proxy
+  | isNothing proxy = Nothing
+  -- should never happen
+  -- since the request would have been rejected by the middleware if proxy uri
+  -- is malformed
+  | isMalformedProxyUri proxy = Nothing
+  | otherwise = Just Proxy {
+    proxyScheme = scheme
+  , proxyHost = host'
+  , proxyPort = port''
+  , proxyPath = path'
+  }
+ where
+   uri = toURI $ fromJust proxy
+   scheme = init $ toLower $ pack $ uriScheme uri
+   path URI {uriPath = ""} =  "/"
+   path URI {uriPath = p} = p
+   path' = pack $ path uri
+   authority = fromJust $ uriAuthority uri
+   host' = pack $ uriRegName authority
+   port' = uriPort authority
+   readPort = fromMaybe 80 . readMaybe
+   port'' :: Integer
+   port'' = case (port', scheme) of
+             ("", "http") -> 80
+             ("", "https") -> 443
+             _ -> readPort $ unpack $ tail $ pack port'
+
+isUriValid:: URI -> Bool
+isUriValid = fAnd [isSchemeValid, isQueryValid, isAuthorityValid]
+
+fAnd :: [a -> Bool] -> a -> Bool
+fAnd fs x = all ($x) fs
+
+isSchemeValid :: URI -> Bool
+isSchemeValid URI {uriScheme = s}
+  | toLower (pack s) == "https:" = True
+  | toLower (pack s) == "http:" = True
+  | otherwise = False
+
+isQueryValid :: URI -> Bool
+isQueryValid URI {uriQuery = ""} = True
+isQueryValid _ = False
+
+isAuthorityValid :: URI -> Bool
+isAuthorityValid URI {uriAuthority = a}
+  | isJust a = fAnd [isUserInfoValid, isHostValid, isPortValid] $ fromJust a
+  | otherwise = False
+
+isUserInfoValid :: URIAuth -> Bool
+isUserInfoValid URIAuth {uriUserInfo = ""} = True
+isUserInfoValid _ = False
+
+isHostValid :: URIAuth -> Bool
+isHostValid URIAuth {uriRegName = ""} = False
+isHostValid _ = True
+
+isPortValid :: URIAuth -> Bool
+isPortValid URIAuth {uriPort = ""} = True
+isPortValid URIAuth {uriPort = (':':p)} =
+  case readMaybe p of
+    Just i -> i > (0 :: Integer) && i < 65536
+    Nothing -> False
+isPortValid _ = False

src/PostgREST/Parsers.hs

@@ -1,112 +1,242 @@
-module PostgREST.Parsers
--- ( parseGetRequest
--- )
-where
+module PostgREST.Parsers where
 
-import           Control.Applicative hiding ((<$>))
-import           Data.Monoid
-import           Data.String.Conversions       (cs)
-import           Data.Text                     (Text)
+import           Protolude                     hiding (try, intercalate, replace, option)
+import           Control.Monad                 ((>>))
+import           Data.Foldable                 (foldl1)
+import qualified Data.HashMap.Strict           as M
+import           Data.Text                     (intercalate, replace, strip)
+import           Data.List                     (init, last)
 import           Data.Tree
+import           Data.Either.Combinators       (mapLeft)
+import           PostgREST.RangeQuery          (NonnegRange)
 import           PostgREST.Types
 import           Text.ParserCombinators.Parsec hiding (many, (<|>))
-import           PostgREST.QueryBuilder (operators)
+import           Text.Parsec.Error
+import           Text.Read                     (read)
 
-pRequestSelect :: Text -> Parser ReadRequest
-pRequestSelect rootNodeName = do
-  fieldTree <- pFieldForest
-  return $ foldr treeEntry (Node (Select [] [rootNodeName] [] Nothing, (rootNodeName, Nothing)) []) fieldTree
-  where
-    treeEntry :: Tree SelectItem -> ReadRequest -> ReadRequest
-    treeEntry (Node fld@((fn, _),_) fldForest) (Node (q, i) rForest) =
-      case fldForest of
-        [] -> Node (q {select=fld:select q}, i) rForest
-        _  -> Node (q, i) (foldr treeEntry (Node (Select [] [fn] [] Nothing, (fn, Nothing)) []) fldForest:rForest)
+pRequestSelect :: Text -> Either ApiRequestError [Tree SelectItem]
+pRequestSelect selStr =
+  mapError $ parse pFieldForest ("failed to parse select parameter (" <> toS selStr <> ")") (toS selStr)
 
-pRequestFilter :: (String, String) -> Either ParseError (Path, Filter)
-pRequestFilter (k, v) = (,) <$> path <*> (Filter <$> fld <*> op <*> val)
+pRequestFilter :: (Text, Text) -> Either ApiRequestError (EmbedPath, Filter)
+pRequestFilter (k, v) = mapError $ (,) <$> path <*> (Filter <$> fld <*> oper)
   where
-    treePath = parse pTreePath ("failed to parser tree path (" ++ k ++ ")") k
-    opVal = parse pOpValueExp ("failed to parse filter (" ++ v ++ ")") v
+    treePath = parse pTreePath ("failed to parser tree path (" ++ toS k ++ ")") $ toS k
+    oper = parse (pOpExpr pSingleVal) ("failed to parse filter (" ++ toS v ++ ")") $ toS v
     path = fst <$> treePath
     fld = snd <$> treePath
-    op = fst <$> opVal
-    val = snd <$> opVal
+
+pRequestOrder :: (Text, Text) -> Either ApiRequestError (EmbedPath, [OrderTerm])
+pRequestOrder (k, v) = mapError $ (,) <$> path <*> ord'
+  where
+    treePath = parse pTreePath ("failed to parser tree path (" ++ toS k ++ ")") $ toS k
+    path = fst <$> treePath
+    ord' = parse pOrder ("failed to parse order (" ++ toS v ++ ")") $ toS v
+
+pRequestRange :: (ByteString, NonnegRange) -> Either ApiRequestError (EmbedPath, NonnegRange)
+pRequestRange (k, v) = mapError $ (,) <$> path <*> pure v
+  where
+    treePath = parse pTreePath ("failed to parser tree path (" ++ toS k ++ ")") $ toS k
+    path = fst <$> treePath
+
+pRequestLogicTree :: (Text, Text) -> Either ApiRequestError (EmbedPath, LogicTree)
+pRequestLogicTree (k, v) = mapError $ (,) <$> embedPath <*> logicTree
+  where
+    path = parse pLogicPath ("failed to parser logic path (" ++ toS k ++ ")") $ toS k
+    embedPath = fst <$> path
+    op = snd <$> path
+    -- Concat op and v to make pLogicTree argument regular, in the form of "?and=and(.. , ..)" instead of "?and=(.. , ..)"
+    logicTree = join $ parse pLogicTree ("failed to parse logic tree (" ++ toS v ++ ")") . toS <$> ((<>) <$> op <*> pure v)
 
 ws :: Parser Text
-ws = cs <$> many (oneOf " \t")
+ws = toS <$> many (oneOf " \t")
 
 lexeme :: Parser a -> Parser a
 lexeme p = ws *> p <* ws
 
-pTreePath :: Parser (Path,Field)
+pTreePath :: Parser (EmbedPath, Field)
 pTreePath = do
   p <- pFieldName `sepBy1` pDelimiter
-  jp <- optionMaybe pJsonPath
-  let pp = map cs p
-      jpp = map cs <$> jp
-  return (init pp, (last pp, jpp))
+  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 <$> pSelect <*> 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 = cs <$> (string "*" *> pure ("*"::String))
+pStar = toS <$> (string "*" *> pure ("*"::ByteString))
 
 pFieldName :: Parser Text
-pFieldName =  cs <$> (many1 (letter <|> digit <|> oneOf "_")
-          <?> "field name (* or [a..z0..9_])")
+pFieldName = do
+  matches <- (many1 (letter <|> digit <|> oneOf "_") `sepBy1` dash) <?> "field name (* or [a..z0..9_])"
+  return $ intercalate "-" $ map toS matches
+  where
+    isDash :: GenParser Char st ()
+    isDash = try ( char '-' >> notFollowedBy (char '>') )
+    dash :: Parser Char
+    dash = isDash *> pure '-'
 
-pJsonPathStep :: Parser Text
-pJsonPathStep = cs <$> try (string "->" *> pFieldName)
+pJsonPath :: Parser JsonPath
+pJsonPath = many pJsonOperation
+  where
+    pJsonOperation :: Parser JsonOperation
+    pJsonOperation = pJsonArrow <*> pJsonOperand
 
-pJsonPath :: Parser [Text]
-pJsonPath = (++) <$> many pJsonPathStep <*> ( (:[]) <$> (string "->>" *> pFieldName) )
+    pJsonArrow   =
+      try (string "->>" $> J2Arrow) <|>
+      try (string "->" $> JArrow)
+
+    pJsonOperand =
+      let pJKey = JKey . toS <$> pFieldName
+          pJIdx = JIdx . toS <$> ((:) <$> option '+' (char '-') <*> many1 digit) <* pEnd
+          pEnd = try (void $ lookAhead (string "->")) <|>
+                 try (void $ lookAhead (string "::")) <|>
+                 try eof in
+      try pJIdx <|> try pJKey
 
 pField :: Parser Field
-pField = lexeme $ (,) <$> pFieldName <*> optionMaybe pJsonPath
+pField = lexeme $ (,) <$> pFieldName <*> option [] pJsonPath
 
-pSelect :: Parser SelectItem
-pSelect = lexeme $
-  try ((,) <$> pField <*>((cs <$>) <$> optionMaybe (string "::" *> many letter)) )
+aliasSeparator :: Parser ()
+aliasSeparator = char ':' >> notFollowedBy (char ':')
+
+pRelationSelect :: Parser SelectItem
+pRelationSelect = lexeme $ try ( do
+    alias <- optionMaybe ( try(pFieldName <* aliasSeparator) )
+    fld <- pField
+    relationDetail <- optionMaybe ( try( char '.' *> pFieldName ) )
+
+    return (fld, Nothing, alias, relationDetail)
+  )
+
+pFieldSelect :: Parser SelectItem
+pFieldSelect = lexeme $
+  try (
+    do
+      alias <- optionMaybe ( try(pFieldName <* aliasSeparator) )
+      fld <- pField
+      cast' <- optionMaybe (string "::" *> many letter)
+      return (fld, toS <$> cast', alias, Nothing)
+  )
   <|> do
     s <- pStar
-    return ((s, Nothing), Nothing)
+    return ((s, []), Nothing, Nothing, Nothing)
 
-pOperator :: Parser Operator
-pOperator = cs <$> (pOp <?> "operator (eq, gt, ...)")
-  where pOp = foldl (<|>) empty $ map (try . string . cs . fst) operators
+pOpExpr :: Parser SingleVal -> Parser OpExpr
+pOpExpr pSVal = try ( string "not" *> pDelimiter *> (OpExpr True <$> pOperation)) <|> OpExpr False <$> pOperation
+  where
+    pOperation :: Parser Operation
+    pOperation =
+          Op . toS <$> foldl1 (<|>) (try . ((<* pDelimiter) . string) . toS <$> M.keys ops) <*> pSVal
+      <|> In <$> (try (string "in" *> pDelimiter) *> pListVal)
+      <|> pFts
+      <?> "operator (eq, gt, ...)"
 
-pValue :: Parser FValue
-pValue = VText <$> (cs <$> many anyChar)
+    pFts = do
+      op   <- foldl1 (<|>) (try . string . toS <$> ftsOps)
+      lang <- optionMaybe $ try (between (char '(') (char ')') (many (letter <|> digit <|> oneOf "_")))
+      pDelimiter >> Fts (toS op) (toS <$> lang) <$> pSVal
+
+    ops = M.filterWithKey (const . flip notElem ("in":ftsOps)) operators
+    ftsOps = M.keys ftsOperators
+
+pSingleVal :: Parser SingleVal
+pSingleVal = toS <$> many anyChar
+
+pListVal :: Parser ListVal
+pListVal = 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 ",)"))
 
 pDelimiter :: Parser Char
 pDelimiter = char '.' <?> "delimiter (.)"
 
-pOperatiorWithNegation :: Parser Operator
-pOperatiorWithNegation = try ( (<>) <$> ( cs <$> string "not." ) <*>  pOperator) <|> pOperator
-
-pOpValueExp :: Parser (Operator, FValue)
-pOpValueExp = (,) <$> pOperatiorWithNegation <*> (pDelimiter *> pValue)
-
 pOrder :: Parser [OrderTerm]
-pOrder = lexeme pOrderTerm `sepBy` char ','
+pOrder = lexeme pOrderTerm `sepBy1` char ','
 
 pOrderTerm :: Parser OrderTerm
-pOrderTerm =
-  try ( do
-    c <- pFieldName
-    _ <- pDelimiter
-    d <- (string "asc" *> pure OrderAsc)
-         <|> (string "desc" *> pure OrderDesc)
-    nls <- optionMaybe (pDelimiter *> (
-                 try(string "nullslast" *> pure OrderNullsLast)
-             <|> try(string "nullsfirst" *> pure OrderNullsFirst)
-           ))
-    return $ OrderTerm c d nls
-  )
-  <|> OrderTerm <$> (cs <$> pFieldName) <*> pure OrderAsc <*> 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 `sepBy1` lexeme (char ',') <* lexeme (char ')'))
+  where
+    pLogicFilter :: Parser Filter
+    pLogicFilter = Filter <$> pField <* pDelimiter <*> pOpExpr pLogicSingleVal
+    pNot :: Parser Bool
+    pNot = try (string "not" *> pDelimiter *> pure True)
+           <|> pure False
+           <?> "negation operator (not)"
+    pLogicOp :: Parser LogicOperator
+    pLogicOp = try (string "and"  *> pure And)
+               <|> string "or" *> pure Or
+               <?> "logic operator (and, or)"
+
+pLogicSingleVal :: Parser SingleVal
+pLogicSingleVal = try pQuotedValue <|> try pPgArray <|> (toS <$> many (noneOf ",)"))
+  where
+    pPgArray :: Parser Text
+    pPgArray =  do
+      a <- string "{"
+      b <- many (noneOf "{}")
+      c <- string "}"
+      toS <$> pure (a ++ b ++ c)
+
+pLogicPath :: Parser (EmbedPath, Text)
+pLogicPath = do
+  path <- pFieldName `sepBy1` pDelimiter
+  let op = last path
+      notOp = "not." <> op
+  return (filter (/= "not") (init path), if "not" `elem` path then notOp else op)
+
+mapError :: Either ParseError a -> Either ApiRequestError a
+mapError = mapLeft translateError
+  where
+    translateError e =
+      ParseRequestError message details
+      where
+        message = show $ errorPos e
+        details = strip $ replace "\n" " " $ toS
+           $ showErrorMessages "or" "unknown parse error" "expecting" "unexpected" "end of input" (errorMessages e)
+
+-- 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,7 +1,8 @@
-{-# LANGUAGE FlexibleInstances    #-}
-{-# LANGUAGE FlexibleContexts     #-}
-{-# 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.
@@ -13,59 +14,57 @@ and produces SQL Statements.
 Any function that outputs a SQL fragment should be in this module.
 -}
 module PostgREST.QueryBuilder (
-    addRelations
-  , addJoinConditions
-  , callProc
+    callProc
   , createReadStatement
   , createWriteStatement
-  , inTransaction
-  , operators
   , pgFmtIdent
   , pgFmtLit
   , requestToQuery
   , requestToCountQuery
-  , sourceCTEName
   , unquoted
   , ResultsWithCount
-  , Isolation(..)
+  , pgFmtSetLocal
   ) where
 
 import qualified Hasql.Query             as H
-import qualified Hasql.Session           as H
 import qualified Hasql.Encoders          as HE
 import qualified Hasql.Decoders          as HD
 
 import qualified Data.Aeson              as JSON
-import           Data.Int                (Int64)
 
-import           PostgREST.RangeQuery    (NonnegRange, rangeLimit, rangeOffset)
-import           Control.Error           (note, fromMaybe, mapMaybe)
-import           Data.Functor.Contravariant (contramap)
+import           PostgREST.Config        (pgVersion96)
+import           PostgREST.RangeQuery    (rangeLimit, rangeOffset, allRange)
 import qualified Data.HashMap.Strict     as HM
-import           Data.List               (find, (\\))
-import           Data.Monoid             ((<>))
-import           Data.Text               (Text, intercalate, unwords, replace, isInfixOf, toLower, split)
-import qualified Data.Text as T          (map, takeWhile)
-import           Data.String.Conversions (cs)
-import           Control.Applicative     ((<|>))
-import           Control.Monad           (join)
+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 qualified Data.Map as M
 import           Text.InterpolatedString.Perl6 (qc)
-import           Text.Regex.TDFA         ((=~))
 import qualified Data.ByteString.Char8   as BS
 import           Data.Scientific         ( FPFormat (..)
                                          , formatScientific
                                          , isInteger
                                          )
-import           Prelude hiding          (unwords)
+import           Protolude hiding        (from, intercalate, ord, cast, replace)
 import           PostgREST.ApiRequest    (PreferRepresentation (..))
 
+{-| The generic query result format used by API responses. The location header
+    is represented as a list of strings containing variable bindings like
+    @"k1=eq.42"@, or the empty list if there is no location header.
+-}
+type ResultsWithCount = (Maybe Int64, Int64, [BS.ByteString], BS.ByteString)
 
-{-| The generic query result format used by API responses -}
-type ResultsWithCount = (Maybe Int64, Int64, BS.ByteString, BS.ByteString)
+standardRow :: HD.Row ResultsWithCount
+standardRow = (,,,) <$> HD.nullableValue HD.int8 <*> HD.value HD.int8
+                    <*> HD.value header <*> HD.value HD.bytea
+  where
+    header = HD.array $ HD.arrayDimension replicateM $ HD.arrayValue HD.bytea
+
+noLocationF :: Text
+noLocationF = "array[]::text[]"
 
 {-| Read and Write api requests use a similar response format which includes
     various record counts and possible location header. This is the decoder
@@ -74,172 +73,130 @@ type ResultsWithCount = (Maybe Int64, Int64, BS.ByteString, BS.ByteString)
 decodeStandard :: HD.Result ResultsWithCount
 decodeStandard =
   HD.singleRow standardRow
- where
-  standardRow = (,,,) <$> HD.nullableValue HD.int8 <*> HD.value HD.int8
-                      <*> HD.value HD.bytea <*> HD.value HD.bytea
 
 decodeStandardMay :: HD.Result (Maybe ResultsWithCount)
 decodeStandardMay =
   HD.maybeRow standardRow
- where
-  standardRow = (,,,) <$> HD.nullableValue HD.int8 <*> HD.value HD.int8
-                      <*> HD.value HD.bytea <*> HD.value HD.bytea
 
-{-| JSON and CSV payloads from the client are given to us as
-    UniformObjects (objects who all have the same keys),
-    and we turn this into an old fasioned JSON array
--}
-encodeUniformObjs :: HE.Params UniformObjects
-encodeUniformObjs =
-  contramap (JSON.Array . V.map JSON.Object . unUniformObjects) (HE.value HE.json)
-
-createReadStatement :: SqlQuery -> SqlQuery -> NonnegRange -> Bool -> Bool -> Bool ->
+createReadStatement :: SqlQuery -> SqlQuery -> Bool -> Bool -> Bool -> Maybe FieldName ->
                        H.Query () ResultsWithCount
-createReadStatement selectQuery countQuery range isSingle countTotal asCsv =
-  H.statement sql HE.unit decodeStandard True
+createReadStatement selectQuery countQuery isSingle countTotal asCsv binaryField =
+  unicodeStatement sql HE.unit decodeStandard False
  where
   sql = [qc|
       WITH {sourceCTEName} AS ({selectQuery}) SELECT {cols}
-      FROM ( SELECT * FROM {sourceCTEName} {limitF range}) t |]
+      FROM ( SELECT * FROM {sourceCTEName}) _postgrest_t |]
   countResultF = if countTotal then "("<>countQuery<>")" else "null"
   cols = intercalate ", " [
       countResultF <> " AS total_result_set",
-      "pg_catalog.count(t) AS page_total",
-      "'' AS header",
+      "pg_catalog.count(_postgrest_t) AS page_total",
+      noLocationF <> " AS header",
       bodyF <> " AS body"
     ]
   bodyF
     | asCsv = asCsvF
     | isSingle = asJsonSingleF
+    | isJust binaryField = asBinaryF $ fromJust binaryField
     | otherwise = asJsonF
 
-createWriteStatement :: QualifiedIdentifier -> SqlQuery -> SqlQuery -> Bool ->
-                        PreferRepresentation -> [Text] -> Bool -> Payload ->
-                        H.Query UniformObjects (Maybe ResultsWithCount)
-createWriteStatement _ _ _ _ _ _ _ (PayloadParseError _) = undefined
-createWriteStatement _ _ mutateQuery _ None
-                     _ _ (PayloadJSON (UniformObjects _)) =
-  H.statement sql encodeUniformObjs decodeStandardMay True
+
+createWriteStatement :: SqlQuery -> SqlQuery -> Bool -> Bool -> Bool ->
+                        PreferRepresentation -> [Text] ->
+                        H.Query ByteString (Maybe ResultsWithCount)
+createWriteStatement selectQuery mutateQuery wantSingle wantHdrs asCsv rep pKeys =
+  unicodeStatement sql (HE.value HE.unknown) decodeStandardMay True
+
  where
-  sql = [qc|
+  sql = case rep of
+    None -> [qc|
+      WITH {sourceCTEName} AS ({mutateQuery})
+      SELECT '', 0, {noLocationF}, '' |]
+    HeadersOnly -> [qc|
       WITH {sourceCTEName} AS ({mutateQuery})
-      SELECT '', 0, '', '' |]
-
-createWriteStatement qi _ mutateQuery isSingle HeadersOnly
-                     pKeys _ (PayloadJSON (UniformObjects _)) =
-  H.statement sql encodeUniformObjs decodeStandardMay True
- where
-  sql = [qc|
-      WITH {sourceCTEName} AS ({mutateQuery} RETURNING {fromQi qi}.*)
       SELECT {cols}
-      FROM (SELECT 1 FROM {sourceCTEName}) t |]
-  cols = intercalate ", " [
-      "'' AS total_result_set",
-      "pg_catalog.count(t) AS page_total",
-      if isSingle then locationF pKeys else "''",
-      "''"
-    ]
-
-createWriteStatement qi selectQuery mutateQuery isSingle Full
-                     pKeys asCsv (PayloadJSON (UniformObjects _)) =
-  H.statement sql encodeUniformObjs decodeStandardMay True
- where
-  sql = [qc|
-      WITH {sourceCTEName} AS ({mutateQuery} RETURNING {fromQi qi}.*)
+      FROM (SELECT 1 FROM {sourceCTEName}) _postgrest_t |]
+    Full -> [qc|
+      WITH {sourceCTEName} AS ({mutateQuery})
       SELECT {cols}
-      FROM ({selectQuery}) t |]
+      FROM ({selectQuery}) _postgrest_t |]
+
   cols = intercalate ", " [
       "'' AS total_result_set", -- when updateing it does not make sense
-      "pg_catalog.count(t) AS page_total",
-      if isSingle then locationF pKeys else "''" <> " AS header",
-      bodyF <> " AS body"
+      "pg_catalog.count(_postgrest_t) AS page_total",
+      if wantHdrs
+         then "coalesce(" <> locationF pKeys <> ", " <> noLocationF <> ")"
+         else noLocationF <> " AS header",
+      if rep == Full
+         then bodyF <> " AS body"
+         else "''"
     ]
+
   bodyF
     | asCsv = asCsvF
-    | isSingle = asJsonSingleF
+    | wantSingle = asJsonSingleF
     | otherwise = asJsonF
 
-addRelations :: Schema -> [Relation] -> Maybe ReadRequest -> ReadRequest -> Either Text ReadRequest
-addRelations schema allRelations parentNode node@(Node readNode@(query, (name, _)) forest) =
-  case parentNode of
-    (Just (Node (Select{from=[parentTable]}, (_, _)) _)) -> Node <$> (addRel readNode <$> rel) <*> updatedForest
-      where
-        rel = note ("no relation between " <> parentTable <> " and " <> name)
-            $  findRelationByTable schema name parentTable
-           <|> findRelationByColumn schema parentTable name
-        addRel :: (ReadQuery, (NodeName, Maybe Relation)) -> Relation -> (ReadQuery, (NodeName, Maybe Relation))
-        addRel (query', (n, _)) r = (query' {from=fromRelation}, (n, Just r))
-          where fromRelation = map (\t -> if t == n then tableName (relTable r) else t) (from query')
-
-    _ -> Node (query, (name, Nothing)) <$> updatedForest
+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
-    updatedForest = mapM (addRelations schema allRelations (Just node)) forest
-    -- Searches through all the relations and returns a match given the parameter conditions.
-    -- Will only find a relation where both schemas are in the PostgREST schema.
-    -- `findRelationByColumn` also does a ducktype check to see if the column name has any variation of `id` or `fk`. If so then the relation is returned as a match.
-    findRelationByTable s t1 t2 =
-      find (\r -> s == tableSchema (relTable r) && s == tableSchema (relFTable r) && t1 == tableName (relTable r) && t2 == tableName (relFTable r)) allRelations
-    findRelationByColumn s t c =
-      find (\r -> s == tableSchema (relTable r) && s == tableSchema (relFTable r) && t == tableName (relFTable r) && length (relFColumns r) == 1 && c `colMatches` (colName . head . relFColumns) r) allRelations
-      where n `colMatches` rc = (cs ("^" <> rc <> "_?(?:|[iI][dD]|[fF][kK])$") :: BS.ByteString) =~ (cs n :: BS.ByteString)
+    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;|]
 
-addJoinConditions :: Schema -> ReadRequest -> Either Text ReadRequest
-addJoinConditions schema (Node (query, (n, r)) forest) =
-  case r of
-    Nothing -> Node (updatedQuery, (n,r))  <$> updatedForest -- this is the root node
-    Just rel@Relation{relType=Child} -> Node (addCond updatedQuery (getJoinConditions rel),(n,r)) <$> updatedForest
-    Just Relation{relType=Parent} -> Node (updatedQuery, (n,r)) <$> updatedForest
-    Just rel@Relation{relType=Many, relLTable=(Just linkTable)} ->
-      Node (qq, (n, r)) <$> updatedForest
-      where
-         query' = addCond updatedQuery (getJoinConditions rel)
-         qq = query'{from=tableName linkTable : from query'}
-    _ -> Left "unknown relation"
-  where
-    -- add parentTable and parentJoinConditions to the query
-    updatedQuery = foldr (flip addCond) query parentJoinConditions
-      where
-        parentJoinConditions = map (getJoinConditions . snd) parents
-        parents = mapMaybe (getParents . rootLabel) forest
-        getParents (_, (tbl, Just rel@Relation{relType=Parent})) = Just (tbl, rel)
-        getParents _ = Nothing
-    updatedForest = mapM (addJoinConditions schema) forest
-    addCond query' con = query'{flt_=con ++ flt_ query'}
+    (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 <*> HD.value HD.bytea
+    scalarBodyF
+     | asBinary = asBinaryF _procName
+     | otherwise = "(row_to_json(_postgrest_t)->" <> pgFmtLit _procName <> ")::character varying"
 
-callProc :: QualifiedIdentifier -> JSON.Object -> H.Query () (Maybe JSON.Value)
-callProc qi params =
-  H.statement sql HE.unit decodeObj True
-  where
-    sql = [qc| SELECT array_to_json(
-                coalesce(array_agg(row_to_json(t)), '\{}')
-              )::character varying
-              from ({_callSql}) t |]
-    _args = intercalate "," $ map _assignment (HM.toList params)
-    _assignment (n,v) = pgFmtIdent n <> ":=" <> insertableValue v
-    _callSql = [qc| select * from {fromQi qi}({_args}) |] :: BS.ByteString
-    decodeObj = HD.maybeRow (HD.value HD.json)
-
-operators :: [(Text, SqlFragment)]
-operators = [
-  ("eq", "="),
-  ("gte", ">="), -- has to be before gt (parsers)
-  ("gt", ">"),
-  ("lte", "<="), -- has to be before lt (parsers)
-  ("lt", "<"),
-  ("neq", "<>"),
-  ("like", "like"),
-  ("ilike", "ilike"),
-  ("in", "in"),
-  ("notin", "not in"),
-  ("isnot", "is not"), -- has to be before is (parsers)
-  ("is", "is"),
-  ("@@", "@@"),
-  ("@>", "@>"),
-  ("<@", "<@")
-  ]
+    bodyF
+     | isSingle = asJsonSingleF
+     | asCsv = asCsvF
+     | isJust binaryField = asBinaryF $ fromJust binaryField
+     | otherwise = asJsonF
 
 pgFmtIdent :: SqlFragment -> SqlFragment
-pgFmtIdent x = "\"" <> replace "\"" "\"\"" (trimNullChars $ cs x) <> "\""
+pgFmtIdent x = "\"" <> replace "\"" "\"\"" (trimNullChars $ toS x) <> "\""
 
 pgFmtLit :: SqlFragment -> SqlFragment
 pgFmtLit x =
@@ -251,125 +208,140 @@ pgFmtLit x =
    else slashed
 
 requestToCountQuery :: Schema -> DbRequest -> SqlQuery
-requestToCountQuery _ (DbMutate _) = undefined
-requestToCountQuery schema (DbRead (Node (Select _ _ conditions _, (mainTbl, _)) _)) =
+requestToCountQuery _ (DbMutate _) = witness
+requestToCountQuery schema (DbRead (Node (Select{where_=logicForest}, (mainTbl, _, _, _, _)) _)) =
  unwords [
-   "SELECT pg_catalog.count(1)",
-   "FROM ", fromQi $ QualifiedIdentifier schema mainTbl,
-   ("WHERE " <> intercalate " AND " ( map (pgFmtCondition (QualifiedIdentifier schema mainTbl)) localConditions )) `emptyOnNull` localConditions
+   "SELECT pg_catalog.count(*)",
+   "FROM ", fromQi qi,
+    ("WHERE " <> intercalate " AND " (map (pgFmtLogicTree qi) logicForest)) `emptyOnFalse` null logicForest
    ]
  where
-   fn Filter{value=VText _} = True
-   fn Filter{value=VForeignKey _ _} = False
-   localConditions = filter fn conditions
+   qi = removeSourceCTESchema schema mainTbl
+
+requestToQuery :: Schema -> Bool -> DbRequest -> SqlQuery
+requestToQuery schema isParent (DbRead (Node (Select colSelects tbls logicForest joinConditions_ ordts range, (nodeName, maybeRelation, _, _, depth)) forest)) =
+  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) ]
 
-requestToQuery :: Schema -> DbRequest -> SqlQuery
-requestToQuery _ (DbMutate (Insert _ (PayloadParseError _))) = undefined
-requestToQuery _ (DbMutate (Update _ (PayloadParseError _) _)) = undefined
-requestToQuery schema (DbRead (Node (Select colSelects tbls conditions ord, (nodeName, maybeRelation)) forest)) =
-  query
   where
-    -- TODO! the folloing helper functions are just to remove the "schema" part when the table is "source" which is the name
-    -- of our WITH query part
     mainTbl = fromMaybe nodeName (tableName . relTable <$> maybeRelation)
-    tblSchema tbl = if tbl == sourceCTEName then "" else schema
-    qi = QualifiedIdentifier (tblSchema mainTbl) mainTbl
-    toQi t = QualifiedIdentifier (tblSchema t) t
-    query = unwords [
-      "SELECT ", intercalate ", " (map (pgFmtSelectItem qi) colSelects ++ selects),
-      "FROM ", intercalate ", " (map (fromQi . toQi) tbls),
-      unwords (map joinStr joins),
-      ("WHERE " <> intercalate " AND " ( map (pgFmtCondition qi ) localConditions )) `emptyOnNull` localConditions,
-      orderF (fromMaybe [] ord)
-      ]
-    orderF ts =
-        if null ts
-            then ""
-            else "ORDER BY " <> clause
-        where
-            clause = intercalate "," (map queryTerm ts)
-            queryTerm :: OrderTerm -> Text
-            queryTerm t = " "
-                <> cs (pgFmtColumn qi $ otTerm t) <> " "
-                <> (cs.show) (otDirection t) <> " "
-                <> maybe "" (cs.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
-    parentTables = map snd joins
-    parentConditions = join $ map (( `filter` conditions ) . filterParentConditions) parentTables
-    localConditions = conditions \\ parentConditions
-    joinStr :: (SqlFragment, TableName) -> SqlFragment
-    joinStr (sql, t) = "LEFT OUTER JOIN " <> sql <> " ON " <>
-      intercalate " AND " ( map (pgFmtCondition qi ) joinConditions )
-      where
-        joinConditions = filter (filterParentConditions t) conditions
-    filterParentConditions parentTable (Filter _ _ (VForeignKey (QualifiedIdentifier "" t) _)) = parentTable == t
-    filterParentConditions _ _ = False
-    getQueryParts :: Tree ReadNode -> ([(SqlFragment, TableName)], [SqlFragment]) -> ([(SqlFragment,TableName)], [SqlFragment])
-    getQueryParts (Node n@(_, (name, Just Relation{relType=Child,relTable=Table{tableName=table}})) forst) (j,s) = (j,sel:s)
+
+    getQueryParts :: Tree ReadNode -> ([SqlFragment], [SqlFragment]) -> ([SqlFragment], [SqlFragment])
+    getQueryParts (Node n@(_, (name, Just Relation{relType=Child,relTable=Table{tableName=table}}, alias, _, _)) forst) (j,s) = (j,sel:s)
       where
         sel = "COALESCE(("
-           <> "SELECT array_to_json(array_agg(row_to_json("<>pgFmtIdent table<>"))) "
+           <> "SELECT json_agg(" <> pgFmtIdent table <> ".*) "
            <> "FROM (" <> subquery <> ") " <> pgFmtIdent table
-           <> "), '[]') AS " <> pgFmtIdent name
-           where subquery = requestToQuery schema (DbRead (Node n forst))
-    getQueryParts (Node n@(_, (name, Just Relation{relType=Parent,relTable=Table{tableName=table}})) forst) (j,s) = (joi:j,sel:s)
+           <> "), '[]') AS " <> pgFmtIdent (fromMaybe name alias)
+           where subquery = requestToQuery schema False (DbRead (Node n forst))
+    getQueryParts (Node n@(_, (name, Just Relation{relType=Parent,relTable=Table{tableName=table}}, alias, _, _)) forst) (j,s) = (joi:j,sel:s)
       where
-        sel = "row_to_json(" <> pgFmtIdent table <> ".*) AS "<>pgFmtIdent name --TODO must be singular
-        joi = ("( " <> subquery <> " ) AS " <> pgFmtIdent table, table)
-          where subquery = requestToQuery schema (DbRead (Node n forst))
-    getQueryParts (Node n@(_, (name, Just Relation{relType=Many,relTable=Table{tableName=table}})) forst) (j,s) = (j,sel:s)
+        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)
       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 name
-           where subquery = requestToQuery schema (DbRead (Node n forst))
+           <> "), '[]') 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 (Node (_,(_,Nothing)) _) _ = undefined
-requestToQuery schema (DbMutate (Insert mainTbl (PayloadJSON (UniformObjects rows)))) =
-  let qi = QualifiedIdentifier schema mainTbl
-      cols = map pgFmtIdent $ fromMaybe [] (HM.keys <$> (rows V.!? 0))
-      colsString = intercalate ", " cols in
+    getQueryParts _ _ = witness
+requestToQuery schema _ (DbMutate (Insert mainTbl pkCols p@(PayloadJSON _ pType pKeys) onConflct logicForest returnings)) =
   unwords [
-    "INSERT INTO ", fromQi qi,
-    " (" <> colsString <> ")" <>
-    " SELECT " <> colsString <>
-    " FROM json_populate_recordset(null::" , fromQi qi, ", $1)"
-    ]
-requestToQuery schema (DbMutate (Update mainTbl (PayloadJSON (UniformObjects rows)) conditions)) =
-  case rows V.!? 0 of
-    Just obj ->
-      let assignments = map
-            (\(k,v) -> pgFmtIdent k <> "=" <> insertableValue v) $ HM.toList obj in
+    ("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 (pgFmtCondition qi ) conditions )) `emptyOnNull` conditions
+        "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
+    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
 
-requestToQuery schema (DbMutate (Delete mainTbl conditions)) =
-  query
-  where
-    qi = QualifiedIdentifier schema mainTbl
-    query = unwords [
-      "DELETE FROM ", fromQi qi,
-      ("WHERE " <> intercalate " AND " ( map (pgFmtCondition qi ) conditions )) `emptyOnNull` conditions
-      ]
+-- 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) "
 
-sourceCTEName :: SqlFragment
-sourceCTEName = "pg_source"
+removeSourceCTESchema :: Schema -> TableName -> QualifiedIdentifier
+removeSourceCTESchema schema tbl = QualifiedIdentifier (if tbl == sourceCTEName then "" else schema) tbl
 
 unquoted :: JSON.Value -> Text
 unquoted (JSON.String t) = t
 unquoted (JSON.Number n) =
-  cs $ formatScientific Fixed (if isInteger n then Just 0 else Nothing) n
-unquoted (JSON.Bool b) = cs . show $ b
-unquoted v = cs $ JSON.encode v
+  toS $ formatScientific Fixed (if isInteger n then Just 0 else Nothing) n
+unquoted (JSON.Bool b) = show b
+unquoted v = toS $ JSON.encode v
 
 -- private functions
 asCsvF :: SqlFragment
@@ -384,31 +356,24 @@ asCsvF = asCsvHeaderF <> " || '\n' || " <> asCsvBodyF
       "    ) s" <>
       "  ) a" <>
       ")"
-    asCsvBodyF = "coalesce(string_agg(substring(t::text, 2, length(t::text) - 2), '\n'), '')"
+    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(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(t)::text, ','), '')::character varying "
+asJsonSingleF = "coalesce(string_agg(row_to_json(_postgrest_t)::text, ','), '')::character varying "
+
+asBinaryF :: FieldName -> SqlFragment
+asBinaryF fieldName = "coalesce(string_agg(_postgrest_t." <> pgFmtIdent fieldName <> ", ''), '')"
 
 locationF :: [Text] -> SqlFragment
-locationF pKeys =
-    "(" <>
-    " WITH s AS (SELECT row_to_json(ss) as r from " <> sourceCTEName <> " as ss  limit 1)" <>
-    " SELECT string_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  = "LIMIT " <> limit <> " OFFSET " <> offset
-  where
-    limit  = maybe "ALL" (cs . show) $ rangeLimit r
-    offset = cs . 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
@@ -416,31 +381,11 @@ fromQi t = (if s == "" then "" else pgFmtIdent s <> ".") <> pgFmtIdent n
     n = qiName t
     s = qiSchema t
 
-getJoinConditions :: Relation -> [Filter]
-getJoinConditions (Relation t cols ft fcs typ lt lc1 lc2) =
-  case typ of
-    Child  -> zipWith (toFilter tN ftN) cols fcs
-    Parent -> zipWith (toFilter tN ftN) cols fcs
-    Many   -> zipWith (toFilter tN ltN) cols (fromMaybe [] lc1) ++ zipWith (toFilter ftN ltN) fcs (fromMaybe [] lc2)
-  where
-    s = if typ == Parent then "" else tableSchema t
-    tN = tableName t
-    ftN = tableName ft
-    ltN = fromMaybe "" (tableName <$> lt)
-    toFilter :: Text -> Text -> Column -> Column -> Filter
-    toFilter tb ftb c fc = Filter (colName c, Nothing) "=" (VForeignKey (QualifiedIdentifier s tb) (ForeignKey fc{colTable=(colTable fc){tableName=ftb}}))
+unicodeStatement :: Text -> HE.Params a -> HD.Result b -> Bool -> H.Query a b
+unicodeStatement = H.statement . T.encodeUtf8
 
-emptyOnNull :: Text -> [a] -> Text
-emptyOnNull val x = if null x then "" else val
-
-insertableValue :: JSON.Value -> SqlFragment
-insertableValue JSON.Null = "null"
-insertableValue v = (<> "::unknown") . pgFmtLit $ unquoted v
-
-whiteList :: Text -> SqlFragment
-whiteList val = fromMaybe
-  (cs (pgFmtLit val) <> "::unknown ")
-  (find ((==) . toLower $ val) ["null","true","false"])
+emptyOnFalse :: Text -> Bool -> Text
+emptyOnFalse val cond = if cond then "" else val
 
 pgFmtColumn :: QualifiedIdentifier -> Text -> SqlFragment
 pgFmtColumn table "*" = fromQi table <> ".*"
@@ -450,74 +395,83 @@ pgFmtField :: QualifiedIdentifier -> Field -> SqlFragment
 pgFmtField table (c, jp) = pgFmtColumn table c <> pgFmtJsonPath jp
 
 pgFmtSelectItem :: QualifiedIdentifier -> SelectItem -> SqlFragment
-pgFmtSelectItem table (f@(_, jp), Nothing) = pgFmtField table f <> pgFmtAsJsonPath jp
-pgFmtSelectItem table (f@(_, jp), Just cast ) = "CAST (" <> pgFmtField table f <> " AS " <> cast <> " )" <> pgFmtAsJsonPath jp
+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
 
-pgFmtCondition :: QualifiedIdentifier -> Filter -> SqlFragment
-pgFmtCondition table (Filter (col,jp) ops val) =
-  notOp <> " " <> sqlCol  <> " " <> pgFmtOperator opCode <> " " <>
-    if opCode `elem` ["is","isnot"] then whiteList (getInner val) else sqlValue
-  where
-    headPredicate:rest = split (=='.') ops
-    hasNot caseTrue caseFalse = if headPredicate == "not" then caseTrue else caseFalse
-    opCode      = hasNot (head rest) headPredicate
-    notOp       = hasNot headPredicate ""
-    sqlCol = case val of
-      VText _ -> pgFmtColumn table col <> pgFmtJsonPath jp
-      VForeignKey qi _ -> pgFmtColumn qi col
-    sqlValue = valToStr val
-    getInner v = case v of
-      VText s -> s
-      _      -> ""
-    valToStr v = case v of
-      VText s -> pgFmtValue opCode s
-      VForeignKey (QualifiedIdentifier s _) (ForeignKey Column{colTable=Table{tableName=ft}, colName=fc}) -> pgFmtColumn qi fc
-        where qi = QualifiedIdentifier (if ft == sourceCTEName then "" else s) ft
-      _ -> ""
+pgFmtOrderTerm :: QualifiedIdentifier -> OrderTerm -> SqlFragment
+pgFmtOrderTerm qi ot = unwords [
+  toS . pgFmtField qi $ otTerm ot,
+  maybe "" show $ otDirection ot,
+  maybe "" show $ otNullOrder ot]
 
-pgFmtValue :: Text -> Text -> SqlFragment
-pgFmtValue opCode val =
- case opCode of
-   "like" -> unknownLiteral $ T.map star val
-   "ilike" -> unknownLiteral $ T.map star val
-   "in" -> "(" <> intercalate ", " (map unknownLiteral $ split (==',') val) <> ") "
-   "notin" -> "(" <> intercalate ", " (map unknownLiteral $ split (==',') val) <> ") "
-   "@@" -> "to_tsquery(" <> unknownLiteral val <> ") "
-   _    -> unknownLiteral val
+pgFmtFilter :: QualifiedIdentifier -> Filter -> SqlFragment
+pgFmtFilter table (Filter fld (OpExpr hasNot oper)) = notOp <> " " <> case oper of
+   Op op val  -> pgFmtFieldOp op <> " " <> case op of
+     "like"   -> unknownLiteral (T.map star val)
+     "ilike"  -> unknownLiteral (T.map star val)
+     "is"     -> whiteList val
+     _        -> unknownLiteral val
+
+   In vals -> pgFmtField table fld <> " " <>
+    let emptyValForIn = "= any('{}') " in -- Workaround because for postgresql "col IN ()" is invalid syntax, we instead do "col = any('{}')"
+    case ((&&) (length vals == 1) . T.null) <$> headMay vals of
+      Just False -> sqlOperator "in" <> "(" <> intercalate ", " (map unknownLiteral vals) <> ") "
+      Just True  -> emptyValForIn
+      Nothing    -> emptyValForIn
+
+   Fts op lang val ->
+     pgFmtFieldOp op
+       <> "("
+       <> maybe "" ((<> ", ") . pgFmtLit) lang
+       <> unknownLiteral val
+       <> ") "
  where
+   pgFmtFieldOp op = pgFmtField table fld <> " " <> sqlOperator op
+   sqlOperator o = HM.lookupDefault "=" o operators
+   notOp = if hasNot then "NOT" else ""
    star c = if c == '*' then '%' else c
    unknownLiteral = (<> "::unknown ") . pgFmtLit
+   whiteList :: Text -> SqlFragment
+   whiteList v = fromMaybe
+     (toS (pgFmtLit v) <> "::unknown ")
+     (find ((==) . toLower $ v) ["null","true","false"])
 
-pgFmtOperator :: Text -> SqlFragment
-pgFmtOperator opCode = fromMaybe "=" $ M.lookup opCode operatorsMap
+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
-    operatorsMap = M.fromList operators
+    aliasToQi al = QualifiedIdentifier "" <$> al
 
-pgFmtJsonPath :: Maybe JsonPath -> SqlFragment
-pgFmtJsonPath (Just [x]) = "->>" <> pgFmtLit x
-pgFmtJsonPath (Just (x:xs)) = "->" <> pgFmtLit x <> pgFmtJsonPath ( Just xs )
-pgFmtJsonPath _ = ""
+pgFmtLogicTree :: QualifiedIdentifier -> LogicTree -> SqlFragment
+pgFmtLogicTree qi (Expr hasNot op forest) = notOp <> " (" <> intercalate (" " <> show op <> " ") (pgFmtLogicTree qi <$> forest) <> ")"
+  where notOp =  if hasNot then "NOT" else ""
+pgFmtLogicTree qi (Stmnt flt) = pgFmtFilter qi flt
 
-pgFmtAsJsonPath :: Maybe JsonPath -> SqlFragment
-pgFmtAsJsonPath Nothing = ""
-pgFmtAsJsonPath (Just xx) = " AS " <> last xx
+pgFmtJsonPath :: JsonPath -> SqlFragment
+pgFmtJsonPath = \case
+  []             -> ""
+  (JArrow x:xs)  -> "->" <> pgFmtJsonOperand x <> pgFmtJsonPath xs
+  (J2Arrow x:xs) -> "->>" <> pgFmtJsonOperand x <> pgFmtJsonPath xs
+  where
+    pgFmtJsonOperand (JKey k) = pgFmtLit k
+    pgFmtJsonOperand (JIdx i) = pgFmtLit i <> "::int"
+
+pgFmtAs :: FieldName -> JsonPath -> Maybe Alias -> SqlFragment
+pgFmtAs _ [] Nothing = ""
+pgFmtAs fName jp Nothing = case jOp <$> lastMay jp of
+  Just (JKey key) -> " AS " <> pgFmtIdent key
+  Just (JIdx _)   -> " AS " <> pgFmtIdent (fromMaybe fName lastKey)
+    -- We get the lastKey because on:
+    -- `select=data->1->mycol->>2`, we need to show the result as [ {"mycol": ..}, {"mycol": ..} ]
+    -- `select=data->3`, we need to show the result as [ {"data": ..}, {"data": ..} ]
+    where lastKey = jVal <$> find (\case JKey{} -> True; _ -> False) (jOp <$> reverse jp)
+  Nothing -> ""
+pgFmtAs _ _ (Just alias) = " AS " <> pgFmtIdent alias
+
+pgFmtSetLocal :: Text -> (Text, Text) -> SqlFragment
+pgFmtSetLocal prefix (k, v) =
+  "set local " <> pgFmtIdent (prefix <> k) <> " = " <> pgFmtLit v <> ";"
 
 trimNullChars :: Text -> Text
 trimNullChars = T.takeWhile (/= '\x0')
-
-data Isolation = ReadCommitted | RepeatableRead | Serializable
-
-{- |
-  Wrap a session in a transaction of desired isolation level
--}
-inTransaction :: Isolation -> H.Session a -> H.Session a
-inTransaction lvl f = do
-  H.sql $ "begin " <> isolate <> ";"
-  r <- f
-  H.sql "commit;"
-  return r
- where
-  isolate = case lvl of
-    ReadCommitted  -> "ISOLATION LEVEL READ COMMITTED"
-    RepeatableRead -> "ISOLATION LEVEL REPEATABLE READ"
-    Serializable   -> "ISOLATION LEVEL SERIALIZABLE"

src/PostgREST/RangeQuery.hs

@@ -4,25 +4,24 @@ module PostgREST.RangeQuery (
 , rangeLimit
 , rangeOffset
 , restrictRange
+, rangeGeq
+, allRange
 , NonnegRange
 ) where
 
 
 import           Control.Applicative
 import           Network.HTTP.Types.Header
-import           PostgREST.Types           ()
 
 import qualified Data.ByteString.Char8     as BS
 import           Data.Ranged.Boundaries
 import           Data.Ranged.Ranges
 
-import           Data.String.Conversions   (cs)
-import           Text.Read                 (readMaybe)
 import           Text.Regex.TDFA           ((=~))
 
-import           Data.Maybe                (fromMaybe, listToMaybe)
+import Data.List (lookup)
 
-import           Prelude
+import           Protolude
 
 type NonnegRange = Range Integer
 
@@ -32,37 +31,41 @@ rangeParse range = do
 
   case listToMaybe (range =~ rangeRegex :: [[BS.ByteString]]) of
     Just parsedRange ->
-      let [_, from, to] = readMaybe . cs <$> parsedRange
-          lower         = fromMaybe emptyRange   (rangeGeq <$> from)
-          upper         = fromMaybe (rangeGeq 0) (rangeLeq <$> to) in
+      let [_, mLower, mUpper] = readMaybe . toS <$> parsedRange
+          lower         = fromMaybe emptyRange   (rangeGeq <$> mLower)
+          upper         = fromMaybe allRange (rangeLeq <$> mUpper) in
       rangeIntersection lower upper
-    Nothing -> rangeGeq 0
+    Nothing -> allRange
 
 rangeRequested :: RequestHeaders -> NonnegRange
-rangeRequested = rangeParse . fromMaybe "" . lookup hRange
+rangeRequested headers = fromMaybe allRange $
+  rangeParse <$> lookup hRange headers
 
 restrictRange :: Maybe Integer -> NonnegRange -> NonnegRange
 restrictRange Nothing r = r
 restrictRange (Just limit) r =
-  rangeIntersection r $
-    Range BoundaryBelowAll (BoundaryAbove $ rangeOffset r + limit - 1)
+   rangeIntersection r $
+     Range BoundaryBelowAll (BoundaryAbove $ rangeOffset r + limit - 1)
 
 rangeLimit :: NonnegRange -> Maybe Integer
 rangeLimit range =
   case [rangeLower range, rangeUpper range] of
-    [BoundaryBelow from, BoundaryAbove to] -> Just (1 + to - from)
+    [BoundaryBelow lower, BoundaryAbove upper] -> Just (1 + upper - lower)
     _ -> Nothing
 
 rangeOffset :: NonnegRange -> Integer
 rangeOffset range =
   case rangeLower range of
-    BoundaryBelow from -> from
-    _ -> error "range without lower bound" -- should never happen
+    BoundaryBelow lower -> lower
+    _ -> panic "range without lower bound" -- should never happen
 
 rangeGeq :: Integer -> NonnegRange
 rangeGeq n =
   Range (BoundaryBelow n) BoundaryAboveAll
 
+allRange :: NonnegRange
+allRange = rangeGeq 0
+
 rangeLeq :: Integer -> NonnegRange
 rangeLeq n =
   Range BoundaryBelowAll (BoundaryAbove n)

src/PostgREST/Types.hs

@@ -1,51 +1,115 @@
+{-# LANGUAGE DuplicateRecordFields    #-}
 module PostgREST.Types where
-import Data.Text
-import Data.Tree
+import           Protolude
+import qualified GHC.Show
+import qualified Data.Aeson           as JSON
 import qualified Data.ByteString.Lazy as BL
-import qualified Data.ByteString      as BS
-import qualified Data.Vector          as V
-import Data.Aeson
-import Data.Int (Int32)
+import qualified Data.CaseInsensitive as CI
+import qualified Data.HashMap.Strict  as M
+import qualified Data.Set                  as S
+import           Data.Tree
+import           PostgREST.RangeQuery (NonnegRange)
+import           Network.HTTP.Types.Header (hContentType, Header)
+
+-- | Enumeration of currently supported response content types
+data ContentType = CTApplicationJSON | CTTextCSV | CTOpenAPI
+                 | CTSingularJSON | CTOctetStream
+                 | CTAny | CTOther ByteString deriving Eq
+
+data ApiRequestError = ActionInappropriate
+                     | InvalidBody ByteString
+                     | InvalidRange
+                     | ParseRequestError Text Text
+                     | UnknownRelation
+                     | NoRelationBetween Text Text
+                     | UnsupportedVerb
+                     | 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]
+  dbTables      :: [Table]
+, dbColumns     :: [Column]
+, dbRelations   :: [Relation]
 , dbPrimaryKeys :: [PrimaryKey]
+-- 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, Ord)
+
+data PgType = Scalar QualifiedIdentifier | Composite QualifiedIdentifier deriving (Eq, Show, Ord)
+
+data RetType = Single PgType | SetOf PgType deriving (Eq, Show, Ord)
+
+data ProcVolatility = Volatile | Stable | Immutable
+  deriving (Eq, Show, Ord)
+
+data ProcDescription = ProcDescription {
+  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)
 
-data ForeignKey = ForeignKey { fkCol :: Column } deriving (Show, Eq, Ord)
+newtype ForeignKey = ForeignKey { fkCol :: Column } deriving (Show, Eq, Ord)
 
 data Column =
     Column {
-      colTable     :: Table
-    , colName      :: Text
-    , colPosition  :: Int32
-    , colNullable  :: Bool
-    , colType      :: Text
-    , colUpdatable :: Bool
-    , colMaxLen    :: Maybe Int32
-    , colPrecision :: Maybe Int32
-    , colDefault   :: Maybe Text
-    , colEnum      :: [Text]
-    , colFK        :: Maybe ForeignKey
-    }
-  | Star { colTable :: Table }
-  deriving (Show, Ord)
+      colTable       :: Table
+    , colName        :: Text
+    , colDescription :: Maybe Text
+    , colPosition    :: Int32
+    , colNullable    :: Bool
+    , colType        :: Text
+    , colUpdatable   :: Bool
+    , colMaxLen      :: Maybe Int32
+    , colPrecision   :: Maybe Int32
+    , colDefault     :: Maybe Text
+    , colEnum        :: [Text]
+    , colFK          :: Maybe ForeignKey
+    } deriving (Show, Ord)
 
-type Synonym = (Column,Column)
+-- | A view column that refers to a table column
+type Synonym = (Column, ViewColumn)
+type ViewColumn = Column
 
 data PrimaryKey = PrimaryKey {
     pkTable :: Table
@@ -54,107 +118,211 @@ 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      :: Text
-, otDirection :: OrderDirection
+  otTerm      :: Field
+, otDirection :: Maybe OrderDirection
 , otNullOrder :: Maybe OrderNulls
 } deriving (Show, Eq)
 
 data QualifiedIdentifier = QualifiedIdentifier {
   qiSchema :: Schema
 , qiName   :: TableName
-} deriving (Show, Eq)
+} deriving (Show, Eq, Ord)
 
 
-data RelationType = Child | Parent | Many deriving (Show, Eq)
+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 UniformObjects = UniformObjects (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)
 
-unUniformObjects :: UniformObjects -> V.Vector Object
-unUniformObjects (UniformObjects objs) = objs
+data PJType = PJArray { pjaLength :: Int } | PJObject deriving (Show, Eq)
 
--- | When Hasql supports the COPY command then we can
--- have a special payload just for CSV, but until
--- then CSV is converted to a JSON array.
-data Payload = PayloadJSON UniformObjects
-             | PayloadParseError BS.ByteString
-             deriving (Show, Eq)
+-- | e.g. whether it is []/{} or not
+pjIsEmpty :: PayloadJSON -> Bool
+pjIsEmpty (PayloadJSON _ PJObject keys) = S.size keys == 0
+pjIsEmpty (PayloadJSON _ (PJArray l) _) = l == 0
+
+data Proxy = Proxy {
+  proxyScheme     :: Text
+, proxyHost       :: Text
+, proxyPort       :: Integer
+, proxyPath       :: Text
+} deriving (Show, Eq)
 
 type Operator = Text
-data FValue = VText Text | VForeignKey QualifiedIdentifier ForeignKey deriving (Show, Eq)
+operators :: M.HashMap Operator SqlFragment
+operators = M.union (M.fromList [
+  ("eq", "="),
+  ("gte", ">="),
+  ("gt", ">"),
+  ("lte", "<="),
+  ("lt", "<"),
+  ("neq", "<>"),
+  ("like", "LIKE"),
+  ("ilike", "ILIKE"),
+  ("in", "IN"),
+  ("is", "IS"),
+  ("cs", "@>"),
+  ("cd", "<@"),
+  ("ov", "&&"),
+  ("sl", "<<"),
+  ("sr", ">>"),
+  ("nxr", "&<"),
+  ("nxl", "&>"),
+  ("adj", "-|-")]) 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
+  show And  = "AND"
+  show Or = "OR"
+{-|
+  Boolean logic expression tree e.g. "and(name.eq.N,or(id.eq.1,id.eq.2))" is:
+
+            And
+           /   \
+  name.eq.N     Or
+               /  \
+         id.eq.1   id.eq.2
+-}
+data LogicTree = Expr Bool LogicOperator [LogicTree] | Stmnt Filter deriving (Show, Eq)
+
 type FieldName = Text
-type JsonPath = [Text]
-type Field = (FieldName, Maybe JsonPath)
+{-|
+  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)
-type Path = [Text]
-data ReadQuery = Select { select::[SelectItem], from::[TableName], flt_::[Filter], order::Maybe [OrderTerm] } deriving (Show, Eq)
-data MutateQuery = Insert { in_::TableName, qPayload::Payload }
-                 | Delete { in_::TableName, where_::[Filter] }
-                 | Update { in_::TableName, qPayload::Payload, where_::[Filter] } deriving (Show, Eq)
-data Filter = Filter {field::Field, operator::Operator, value::FValue} deriving (Show, Eq)
-type ReadNode = (ReadQuery, (NodeName, Maybe Relation))
+
+-- 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, 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], 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
 
 instance Eq Column where
   Column{colTable=t1,colName=n1} == Column{colTable=t2,colName=n2} = t1 == t2 && n1 == n2
-  _ == _ = False
+
+-- | Convert from ContentType to a full HTTP Header
+toHeader :: ContentType -> Header
+toHeader ct = (hContentType, toMime ct <> "; charset=utf-8")
+
+-- | Convert from ContentType to a ByteString representing the mime type
+toMime :: ContentType -> ByteString
+toMime CTApplicationJSON = "application/json"
+toMime CTTextCSV         = "text/csv"
+toMime CTOpenAPI         = "application/openapi+json"
+toMime CTSingularJSON    = "application/vnd.pgrst.object+json"
+toMime CTOctetStream     = "application/octet-stream"
+toMime CTAny             = "*/*"
+toMime (CTOther ct)      = ct
+
+data PgVersion = PgVersion {
+  pgvNum  :: Int32
+, pgvName :: Text
+} deriving (Eq, Ord, Show)
+
+sourceCTEName :: SqlFragment
+sourceCTEName = "pg_source"
+
+-- | 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,10 +1,17 @@
-resolver: lts-5.0
+resolver: lts-9.6
 extra-deps:
-  - hasql-0.19.3.3
+  - 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
-  - packdeps-0.4.2.1
+  - 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-monomorphism-restriction -fwarn-missing-exported-sigs -fwarn-identities
-
-packages:
-- '.'
+  postgrest: -O2 -Werror -Wall -fwarn-identities -fno-warn-redundant-constraints
+nix:
+  packages: [postgresql, zlib]

test/Dockerfile.test

@@ -0,0 +1,13 @@
+FROM debian:jessie
+
+ENV PATH /root/.local/bin:$PATH
+
+RUN apt-get update \
+    && apt-get install -y wget libpq-dev pkg-config libpcre3 libpcre3-dev \
+       postgresql-client debconf locales \
+    && apt-get clean && rm -rf /var/lib/apt/lists/* /tmp/* /var/tmp/* \
+    && echo 'en_US.UTF-8 UTF-8' > /etc/locale.gen \
+    && locale-gen \
+    && echo 'export LC_ALL=en_US.UTF-8' >> /etc/profile \
+    && wget -qO- https://get.haskellstack.org/ | sh
+

test/Feature/AndOrParamsSpec.hs

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

test/Feature/AsymmetricJwtSpec.hs

@@ -0,0 +1,21 @@
+module Feature.AsymmetricJwtSpec where
+
+-- {{{ Imports
+import Test.Hspec
+import Test.Hspec.Wai
+import Network.HTTP.Types
+
+import SpecHelper
+import Network.Wai (Application)
+
+import Protolude hiding (get)
+-- }}}
+
+spec :: SpecWith Application
+spec = describe "server started with asymmetric JWK" $
+
+  -- this test will stop working 9999999999s after the UNIX EPOCH
+  it "succeeds with jwt token signed with an asymmetric key" $ do
+    let auth = authHeaderJWT "eyJhbGciOiJSUzI1NiJ9.eyJyb2xlIjogInBvc3RncmVzdF90ZXN0X2F1dGhvciJ9Cg.CBOYWDvqgAR0YYnZnyDGTQi6AJLc2Pds6_eV3YuBG6I36mj_h05eLhkEKNEDA5ZteMzCiY83P60rC_xtxVd7B6vo3BeF5uoanPS3rrbuHzKPwzsrgrD_CqvEuJ4n7Q9epkQiLsNkcexneENZDRqFjbwZx3DrXiCWwlK3Ytr5NAIGxmy0od-0xNpb2U1nXQyO_Q3mumWFViRt4tmFn_3goDHNKG3Ha_AzImfUNvHnWL78kAc4rbn15vLtWXD8PwtSnZaB4lY4V6RfsaW937srQsmRetvytM1i_bHBnjkjQLAqGbXPyItjtlXPs0uGNBadE8-wgkLtfmSCC4v2DjUthw"
+    request methodGet "/authors_only" [auth] ""
+      `shouldRespondWith` 200

test/Feature/AudienceJwtSecretSpec.hs

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

test/Feature/AuthSpec.hs

@@ -1,70 +1,153 @@
 module Feature.AuthSpec where
 
--- {{{ Imports
+import Text.Heredoc
 import Test.Hspec
 import Test.Hspec.Wai
 import Test.Hspec.Wai.JSON
 import Network.HTTP.Types
-import qualified Hasql.Connection  as H
 
 import SpecHelper
-import PostgREST.Types (DbStructure(..))
--- }}}
+import Network.Wai (Application)
 
-spec :: DbStructure -> H.Connection -> Spec
-spec struct c = around (withApp cfgDefault struct c)
-  $ describe "authorization" $ do
+import Protolude hiding (get)
 
-  it "hides tables that anonymous does not own" $
-    get "/authors_only" `shouldRespondWith` 404
+spec :: SpecWith Application
+spec = describe "authorization" $ do
+  let single = ("Accept","application/vnd.pgrst.object+json")
+
+  it "denies access to tables that anonymous does not own" $
+    get "/authors_only" `shouldRespondWith` [json| {
+          "hint":null,
+          "details":null,
+          "code":"42501",
+          "message":"permission denied for relation authors_only"} |]
+      { matchStatus = 401
+      , matchHeaders = ["WWW-Authenticate" <:> "Bearer"]
+      }
+
+  it "denies access to tables that postgrest_test_author does not own" $
+    let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJyb2xlIjoicG9zdGdyZXN0X3Rlc3RfYXV0aG9yIn0.Xod-F15qsGL0WhdOCr2j3DdKuTw9QJERVgoFD3vGaWA" in
+    request methodGet "/private_table" [auth] ""
+      `shouldRespondWith` [json| {
+          "hint":null,
+          "details":null,
+          "code":"42501",
+          "message":"permission denied for relation private_table"} |]
+      { matchStatus = 403
+      , matchHeaders = []
+      }
+
+  it "denies execution on functions that anonymous does not own" $
+    post "/rpc/privileged_hello" [json|{"name": "anonymous"}|] `shouldRespondWith` 401
+
+  it "allows execution on a function that postgrest_test_author owns" $
+    let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJyb2xlIjoicG9zdGdyZXN0X3Rlc3RfYXV0aG9yIn0.Xod-F15qsGL0WhdOCr2j3DdKuTw9QJERVgoFD3vGaWA" in
+    request methodPost "/rpc/privileged_hello" [auth] [json|{"name": "jdoe"}|]
+      `shouldRespondWith` [json|"Privileged hello to jdoe"|]
+      { matchStatus = 200
+      , matchHeaders = [matchContentTypeJson]
+      }
 
   it "returns jwt functions as jwt tokens" $
-    post "/rpc/login" [json| { "id": "jdoe", "pass": "1234" } |]
-      `shouldRespondWith` ResponseMatcher {
-          matchBody = Just [json| {"token":"eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJyb2xlIjoicG9zdGdyZXN0X3Rlc3RfYXV0aG9yIiwiaWQiOiJqZG9lIn0.y4vZuu1dDdwAl0-S00MCRWRYMlJ5YAMSir6Es6WtWx0"} |]
-        , matchStatus = 200
-        , matchHeaders = ["Content-Type" <:> "application/json"]
+    request methodPost "/rpc/login" [single]
+      [json| { "id": "jdoe", "pass": "1234" } |]
+      `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.G2REtPnOQMUrVRDA9OnkPJTd8R0tf4wdYOlauh1E2Ek"} |]
+        { matchStatus = 200
+        , matchHeaders = [matchContentTypeSingular]
+        }
+
+  it "sql functions can read custom and standard claims variables" $ do
+    let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJzdWIiOiJmdW4iLCJqdGkiOiJmb28iLCJuYmYiOjEzMDA4MTkzODAsImV4cCI6OTk5OTk5OTk5OSwiaHR0cDovL3Bvc3RncmVzdC5jb20vZm9vIjp0cnVlLCJpc3MiOiJqb2UiLCJyb2xlIjoicG9zdGdyZXN0X3Rlc3RfYXV0aG9yIiwiaWF0IjoxMzAwODE5MzgwfQ.V5fEpXfpb7feqwVqlcDleFdKu86bdwU2cBRT4fcMhXg"
+    request methodPost "/rpc/reveal_big_jwt" [auth] "{}"
+      `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` 400
+      `shouldRespondWith` [json| {"message":"JWT expired"} |]
+        { matchStatus = 401
+        , matchHeaders = [
+            "WWW-Authenticate" <:>
+            "Bearer error=\"invalid_token\", error_description=\"JWT expired\""
+          ]
+        }
 
   it "hides tables from users with invalid JWT" $ do
     let auth = authHeaderJWT "ey9zdGdyZXN0X3Rlc3RfYXV0aG9yIiwiaWQiOiJqZG9lIn0.y4vZuu1dDdwAl0-S00MCRWRYMlJ5YAMSir6Es6WtWx0"
     request methodGet "/authors_only" [auth] ""
-      `shouldRespondWith` 400
+      `shouldRespondWith` [json| {"message":"JWSError (CompactDecodeError \"expected 3 parts, got 2\")"} |]
+        { matchStatus = 401
+        , matchHeaders = [
+            "WWW-Authenticate" <:>
+            "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.MKYc_lOECtB0LJOiykilAdlHodB-I0_id2qHKq35dmc"
+    let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.e30.CUIP5V9thWsGGFsFyGijSZf1fJMfarLHI9CEJL-TGNk"
     request methodGet "/authors_only" [auth] ""
-      `shouldRespondWith` 400
+      `shouldRespondWith` 401
 
   it "hides tables from users with JWT that contain no claims about role" $ do
-    let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJpZCI6Impkb2UifQ.zyohGMnrDy4_8eJTl6I2AUXO3MeCCiwR24aGWRkTE9o"
+    let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJpZCI6Impkb2UifQ.RVlZDaSyKbFPvxUf3V_NQXybfRB4dlBIkAUQXVXLUAI"
     request methodGet "/authors_only" [auth] ""
-      `shouldRespondWith` 400
+      `shouldRespondWith` 401
 
-  it "recovers after 400 error with logged in user" $ do
+  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
+
+  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.gKw7qI50i9hMrSJW8BlTpdMEVmMXJYxlAqueGqpa_mE" in
+      request methodPost "/rpc/get_current_user" [auth]
+        [json| {} |]
+         `shouldRespondWith` [str|"postgrest_test_author"|]
+          { matchStatus = 200
+          , matchHeaders = []
+          }
+
+    it "able to switch to postgrest_test_default_role (id=2)" $
+      let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJpZCI6Mn0.nwzjMI0YLvVGJQTeoCPEBsK983b__gxdpLXisBNaO2A" in
+      request methodPost "/rpc/get_current_user" [auth]
+        [json| {} |]
+         `shouldRespondWith` [str|"postgrest_test_default_role"|]
+          { matchStatus = 200
+          , matchHeaders = []
+          }
+
+    it "raises error (id=3)" $
+      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"}|]
+          { matchStatus = 400
+          , matchHeaders = []
+          }

test/Feature/BinaryJwtSecretSpec.hs

@@ -0,0 +1,21 @@
+module Feature.BinaryJwtSecretSpec where
+
+-- {{{ Imports
+import Test.Hspec
+import Test.Hspec.Wai
+import Network.HTTP.Types
+
+import SpecHelper
+import Network.Wai (Application)
+
+import Protolude hiding (get)
+-- }}}
+
+spec :: SpecWith Application
+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.Dpss-QoLYjec5OTsOaAc3FNVsSjA89wACoV-0ra3ClA"
+    request methodGet "/authors_only" [auth] ""
+      `shouldRespondWith` 200

test/Feature/ConcurrentSpec.hs

@@ -0,0 +1,52 @@
+{-# LANGUAGE MultiParamTypeClasses, TypeFamilies, UndecidableInstances #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+module Feature.ConcurrentSpec where
+
+import Control.Monad (void)
+import Control.Monad.Base
+
+import Control.Monad.Trans.Control
+import Control.Concurrent.Async (mapConcurrently)
+
+import Test.Hspec hiding (pendingWith)
+import Test.Hspec.Wai.Internal
+import Test.Hspec.Wai
+import Test.Hspec.Wai.JSON
+import Network.Wai.Test (Session)
+
+import Network.Wai (Application)
+
+import Protolude hiding (get)
+
+spec :: SpecWith Application
+spec =
+  describe "Queryiny in parallel" $
+    it "should not raise 'transaction in progress' error" $
+      raceTest 10 $
+        get "/fakefake"
+          `shouldRespondWith` [json|
+              { "hint": null,
+                "details":null,
+                "code":"42P01",
+                "message":"relation \"test.fakefake\" does not exist"
+              } |]
+          { matchStatus  = 404
+          , matchHeaders = []
+          }
+
+raceTest :: Int -> WaiExpectation -> WaiExpectation
+raceTest times = liftBaseDiscard go
+ where
+  go test = void $ mapConcurrently (const test) [1..times]
+
+instance MonadBaseControl IO WaiSession where
+  type StM WaiSession a = StM Session a
+  liftBaseWith f = WaiSession $
+    liftBaseWith $ \runInBase ->
+      f $ \k -> runInBase (unWaiSession k)
+  restoreM = WaiSession . restoreM
+  {-# INLINE liftBaseWith #-}
+  {-# INLINE restoreM #-}
+
+instance MonadBase IO WaiSession where
+  liftBase = liftIO

test/Feature/CorsSpec.hs

@@ -5,16 +5,18 @@ import Test.Hspec
 import Test.Hspec.Wai
 import Network.Wai.Test (SResponse(simpleHeaders, simpleBody))
 import qualified Data.ByteString.Lazy as BL
-import qualified Hasql.Connection  as H
 
 import SpecHelper
-import PostgREST.Types (DbStructure(..))
 
 import Network.HTTP.Types
+import Network.Wai (Application)
+
+import Protolude hiding (get)
 -- }}}
 
-spec :: DbStructure -> H.Connection -> Spec
-spec struct c = around (withApp cfgDefault struct c) $ describe "CORS" $ do
+spec :: SpecWith Application
+spec =
+  describe "CORS" $ do
     let preflightHeaders = [
           ("Accept", "*/*"),
           ("Origin", "http://example.com"),
@@ -69,4 +71,4 @@ spec struct c = around (withApp cfgDefault struct c) $ describe "CORS" $ do
         liftIO $ do
           simpleHeaders r `shouldSatisfy` matchHeader
             "Access-Control-Allow-Origin" "\\*"
-          simpleBody r `shouldSatisfy` not . BL.null
+          simpleBody r `shouldSatisfy` BL.null

test/Feature/DeleteSpec.hs

@@ -4,37 +4,60 @@ import Test.Hspec
 import Test.Hspec.Wai
 import Text.Heredoc
 
-import SpecHelper
-import PostgREST.Types (DbStructure(..))
-import qualified Hasql.Connection  as H
-
 import Network.HTTP.Types
+import Network.Wai (Application)
 
-spec :: DbStructure -> H.Connection -> Spec
-spec struct c = beforeAll resetDb
-  . around (withApp cfgDefault struct c) $
+import Protolude hiding (get)
+
+spec :: SpecWith Application
+spec =
   describe "Deleting" $ do
     context "existing record" $ do
       it "succeeds with 204 and deletion count" $
         request methodDelete "/items?id=eq.1" [] ""
-          `shouldRespondWith` ResponseMatcher {
-            matchBody    = Nothing
-          , matchStatus  = 204
+          `shouldRespondWith` ""
+          { matchStatus  = 204
+          , matchHeaders = ["Content-Range" <:> "*/*"]
+          }
+
+      it "returns the deleted item and count if requested" $
+        request methodDelete "/items?id=eq.2" [("Prefer", "return=representation"), ("Prefer", "count=exact")] ""
+          `shouldRespondWith` [str|[{"id":2}]|]
+          { matchStatus  = 200
           , matchHeaders = ["Content-Range" <:> "*/1"]
           }
+      it "returns the deleted item and shapes the response" $
+        request methodDelete "/complex_items?id=eq.2&select=id,name" [("Prefer", "return=representation")] ""
+          `shouldRespondWith` [str|[{"id":2,"name":"Two"}]|]
+          { matchStatus  = 200
+          , matchHeaders = ["Content-Range" <:> "*/*"]
+          }
+      it "can rename and cast the selected columns" $
+        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")] ""
+          `shouldRespondWith` [str|[{"id":8,"name":"Code OSX","project":{"id":4}}]|]
+          { matchStatus  = 200
+          , matchHeaders = ["Content-Range" <:> "*/*"]
+          }
 
       it "actually clears items ouf the db" $ do
         _ <- request methodDelete "/items?id=lt.15" [] ""
         get "/items"
-          `shouldRespondWith` ResponseMatcher {
-            matchBody    = Just [str|[{"id":15}]|]
-          , matchStatus  = 200
-          , matchHeaders = ["Content-Range" <:> "0-0/1"]
+          `shouldRespondWith` [str|[{"id":15}]|]
+          { matchStatus  = 200
+          , matchHeaders = ["Content-Range" <:> "0-0/*"]
           }
 
-    context "known route, unknown record" $
-      it "fails with 404" $
-        request methodDelete "/items?id=eq.101" [] "" `shouldRespondWith` 404
+    context "known route, no records matched" $
+      it "includes [] body if return=rep" $
+        request methodDelete "/items?id=eq.101"
+          [("Prefer", "return=representation")] ""
+          `shouldRespondWith` "[]"
+          { matchStatus  = 200
+          , matchHeaders = ["Content-Range" <:> "*/*"]
+          }
 
     context "totally unknown route" $
       it "fails with 404" $

test/Feature/InsertSpec.hs

@@ -3,23 +3,26 @@ module Feature.InsertSpec where
 import Test.Hspec hiding (pendingWith)
 import Test.Hspec.Wai
 import Test.Hspec.Wai.JSON
+import Test.Hspec.Wai.Matcher (bodyEquals)
 import Network.Wai.Test (SResponse(simpleBody,simpleHeaders,simpleStatus))
 
 import SpecHelper
-import PostgREST.Types (DbStructure(..))
 
 import qualified Data.Aeson as JSON
+import Data.List (lookup)
 import Data.Maybe (fromJust)
 import Text.Heredoc
 import Network.HTTP.Types.Header
 import Network.HTTP.Types
-import Control.Monad (replicateM_)
-import qualified Hasql.Connection  as H
+import Control.Monad (replicateM_, void)
 
 import TestTypes(IncPK(..), CompoundPK(..))
+import Network.Wai (Application)
 
-spec :: DbStructure -> H.Connection -> Spec
-spec struct c = beforeAll_ resetDb $ around (withApp cfgDefault struct c) $ do
+import Protolude hiding (get)
+
+spec :: SpecWith Application
+spec = do
   describe "Posting new record" $ do
     context "disparate json types" $ do
       it "accepts disparate json types" $ do
@@ -32,27 +35,57 @@ spec struct c = beforeAll_ resetDb $ around (withApp cfgDefault struct c) $ do
         liftIO $ do
           simpleBody p `shouldBe` ""
           simpleStatus p `shouldBe` created201
+          -- should not have content type set when body is empty
+          lookup hContentType (simpleHeaders p) `shouldBe` Nothing
 
       it "filters columns in result using &select" $
         request methodPost "/menagerie?select=integer,varchar" [("Prefer", "return=representation")]
-          [json| {
+          [json| [{
             "integer": 14, "double": 3.14159, "varchar": "testing!"
           , "boolean": false, "date": "1900-01-01", "money": "$3.99"
           , "enum": "foo"
-          } |] `shouldRespondWith` ResponseMatcher {
-            matchBody    = Just [str|{"integer":14,"varchar":"testing!"}|]
-          , matchStatus  = 201
-          , matchHeaders = ["Content-Type" <:> "application/json"]
+          }] |] `shouldRespondWith` [str|[{"integer":14,"varchar":"testing!"}]|]
+          { matchStatus  = 201
+          , 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}" [("Prefer", "return=representation")]
-          [str|{"id":6,"name":"New Project","client_id":2}|] `shouldRespondWith` ResponseMatcher {
-            matchBody    = Just [str|{"id":6,"name":"New Project","clients":{"id":2,"name":"Apple"}}|]
-          , matchStatus  = 201
-          , matchHeaders = ["Content-Type" <:> "application/json", "Location" <:> "/projects?id=eq.6"]
+        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
+          , matchHeaders = [ matchContentTypeJson
+                           , "Location" <:> "/projects?id=eq.6"
+                           , "Content-Range" <:> "*/1" ]
           }
 
+      it "can rename and cast the selected columns" $
+        request methodPost "/projects?select=pId:id::text,pName:name,cId:client_id::text"
+                [("Prefer", "return=representation")]
+          [str|{"id":7,"name":"New Project","client_id":2}|] `shouldRespondWith`
+          [str|[{"pId":"7","pName":"New Project","cId":"2"}]|]
+          { matchStatus  = 201
+          , matchHeaders = [ matchContentTypeJson
+                           , "Location" <:> "/projects?id=eq.7"
+                           , "Content-Range" <:> "*/*" ]
+          }
+
+    context "from an html form" $
+      it "accepts disparate json types" $ do
+        p <- request methodPost "/menagerie"
+               [("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")
+        liftIO $ do
+          simpleBody p `shouldBe` ""
+          simpleStatus p `shouldBe` created201
 
     context "with no pk supplied" $ do
       context "into a table with auto-incrementing pk" $
@@ -70,9 +103,11 @@ spec struct c = beforeAll_ resetDb $ around (withApp cfgDefault struct c) $ do
             incNullableStr record `shouldBe` Nothing
 
       context "into a table with simple pk" $
-        it "fails with 400 and error" $
-          post "/simple_pk" [json| { "extra":"foo"} |]
-            `shouldRespondWith` 400
+        it "fails with 400 and error" $ do
+          p <- post "/simple_pk" [json| { "extra":"foo"} |]
+          liftIO $ do
+            simpleStatus p `shouldBe` badRequest400
+            isErrorFormat (simpleBody p) `shouldBe` True
 
       context "into a table with no pk" $ do
         it "succeeds with 201 and a link including all fields" $ do
@@ -87,10 +122,18 @@ spec struct c = beforeAll_ resetDb $ around (withApp cfgDefault struct c) $ do
                        [("Prefer", "return=representation")]
                        [json| { "a":"bar", "b":"baz" } |]
           liftIO $ do
-            simpleBody p `shouldBe` [json| { "a":"bar", "b":"baz" } |]
+            simpleBody p `shouldBe` [json| [{ "a":"bar", "b":"baz" }] |]
             simpleHeaders p `shouldSatisfy` matchHeader hLocation "/no_pk\\?a=eq.bar&b=eq.baz"
             simpleStatus p `shouldBe` created201
 
+        it "returns empty array when no items inserted, and return=rep" $ do
+          p <- request methodPost "/no_pk"
+                       [("Prefer", "return=representation")]
+                       [json| [] |]
+          liftIO $ do
+            simpleBody p `shouldBe` [json| [] |]
+            simpleStatus p `shouldBe` created201
+
         it "can insert in tables with no select privileges" $ do
           p <- request methodPost "/insertonly"
                        [("Prefer", "return=minimal")]
@@ -105,22 +148,44 @@ spec struct c = beforeAll_ resetDb $ around (withApp cfgDefault struct c) $ do
                        [("Prefer", "return=representation")]
                        [json| { "a":null, "b":"foo" } |]
           liftIO $ do
-            simpleBody p `shouldBe` [json| { "a":null, "b":"foo" } |]
+            simpleBody p `shouldBe` [json| [{ "a":null, "b":"foo" }] |]
             simpleHeaders p `shouldSatisfy` matchHeader hLocation "/no_pk\\?a=is.null&b=eq.foo"
             simpleStatus p `shouldBe` created201
 
     context "with compound pk supplied" $
-      it "builds response location header appropriately" $
-        post "/compound_pk" [json| { "k1":12, "k2":42 } |]
-          `shouldRespondWith` ResponseMatcher {
-            matchBody    = Nothing,
-            matchStatus  = 201,
-            matchHeaders = ["Location" <:> "/compound_pk?k1=eq.12&k2=eq.42"]
-          }
+      it "builds response location header appropriately" $ do
+        let inserted    = [json| { "k1":12, "k2":"Rock & R+ll" } |]
+            expectedObj = CompoundPK 12 "Rock & R+ll" Nothing
+            expectedLoc = "/compound_pk?k1=eq.12&k2=eq.Rock%20%26%20R%2Bll"
+        p <- request methodPost "/compound_pk"
+                     [("Prefer", "return=representation")]
+                     inserted
+        liftIO $ do
+          JSON.decode (simpleBody p) `shouldBe` Just [expectedObj]
+          simpleStatus p `shouldBe` created201
+          lookup hLocation (simpleHeaders p) `shouldBe` Just expectedLoc
+
+        r <- get expectedLoc
+        liftIO $ do
+          JSON.decode (simpleBody r) `shouldBe` Just [expectedObj]
+          simpleStatus r `shouldBe` ok200
+
+    context "with bulk insert" $
+      it "returns 201 but no location header" $ do
+        let bulkData = [json| [ {"k1":21, "k2":"hello world"}
+                              , {"k1":22, "k2":"bye for now"}]
+                            |]
+        p <- request methodPost "/compound_pk" [] bulkData
+        liftIO $ do
+          simpleStatus p `shouldBe` created201
+          lookup hLocation (simpleHeaders p) `shouldBe` Nothing
 
     context "with invalid json payload" $
-      it "fails with 400 and error" $
-        post "/simple_pk" "}{ x = 2" `shouldRespondWith` 400
+      it "fails with 400 and error" $ do
+        p <- post "/simple_pk" "}{ x = 2"
+        liftIO $ do
+          simpleStatus p `shouldBe` badRequest400
+          isErrorFormat (simpleBody p) `shouldBe` True
 
     context "with valid json payload" $
       it "succeeds and returns 201 created" $
@@ -137,38 +202,52 @@ spec struct c = beforeAll_ resetDb $ around (withApp cfgDefault struct c) $ do
     context "jsonb" $ do
       it "serializes nested object" $ do
         let inserted = [json| { "data": { "foo":"bar" } } |]
+            location = "/json?data=eq.%7B%22foo%22%3A%22bar%22%7D"
         request methodPost "/json"
                      [("Prefer", "return=representation")]
                      inserted
-          `shouldRespondWith` ResponseMatcher {
-            matchBody    = Just inserted
-          , matchStatus  = 201
-          , matchHeaders = ["Location" <:> [str|/json?data=eq.{"foo":"bar"}|]]
+          `shouldRespondWith` [str|[{"data":{"foo":"bar"}}]|]
+          { matchStatus  = 201
+          , matchHeaders = ["Location" <:> location]
           }
 
-        -- TODO! the test above seems right, why was the one below working before and not now
-        -- p <- request methodPost "/json" [("Prefer", "return=representation")] inserted
-        -- liftIO $ do
-        --   simpleBody p `shouldBe` inserted
-        --   simpleHeaders p `shouldSatisfy` matchHeader hLocation "/json\\?data=eq\\.%7B%22foo%22%3A%22bar%22%7D"
-        --   simpleStatus p `shouldBe` created201
-
       it "serializes nested array" $ do
         let inserted = [json| { "data": [1,2,3] } |]
+            location = "/json?data=eq.%5B1%2C2%2C3%5D"
         request methodPost "/json"
                      [("Prefer", "return=representation")]
                      inserted
-          `shouldRespondWith` ResponseMatcher {
-            matchBody    = Just inserted
-          , matchStatus  = 201
-          , matchHeaders = ["Location" <:> [str|/json?data=eq.[1,2,3]|]]
+          `shouldRespondWith` [str|[{"data":[1,2,3]}]|]
+          { matchStatus  = 201
+          , matchHeaders = ["Location" <:> location]
+          }
+
+    context "empty object" $
+      it "successfully populates table with all-default columns" $
+        post "/items" "{}" `shouldRespondWith` ""
+          { matchStatus  = 201
+          , matchHeaders = []
+          }
+    context "table with limited privileges" $ do
+      it "succeeds if correct select is applied" $
+        request methodPost "/limited_article_stars?select=article_id,user_id" [("Prefer", "return=representation")]
+          [json| {"article_id": 2, "user_id": 1} |] `shouldRespondWith` [str|[{"article_id":2,"user_id":1}]|]
+          { matchStatus  = 201
+          , matchHeaders = []
+          }
+      it "fails if more columns are selected" $
+        request methodPost "/limited_article_stars?select=article_id,user_id,created_at" [("Prefer", "return=representation")]
+          [json| {"article_id": 2, "user_id": 2} |] `shouldRespondWith`
+          [str|{"hint":null,"details":null,"code":"42501","message":"permission denied for relation limited_article_stars"}|]
+          { matchStatus  = 401
+          , matchHeaders = []
+          }
+      it "fails if select is not specified" $
+        request methodPost "/limited_article_stars" [("Prefer", "return=representation")]
+          [json| {"article_id": 3, "user_id": 1} |] `shouldRespondWith` [str|{"hint":null,"details":null,"code":"42501","message":"permission denied for relation limited_article_stars"}|]
+          { matchStatus  = 401
+          , matchHeaders = []
           }
-        -- TODO! the test above seems right, why was the one below working before and not now
-        -- p <- request methodPost "/json" [("Prefer", "return=representation")] inserted
-        -- liftIO $ do
-        --   simpleBody p `shouldBe` inserted
-        --   simpleHeaders p `shouldSatisfy` matchHeader hLocation "/json\\?data=eq\\.%5B1%2C2%2C3%5D"
-        --   simpleStatus p `shouldBe` created201
 
   describe "CSV insert" $ do
 
@@ -180,139 +259,64 @@ spec struct c = beforeAll_ resetDb $ around (withApp cfgDefault struct c) $ do
             |12,0.1,a string,true,1929-10-01,12,bar
             |]
         request methodPost "/menagerie" [("Content-Type", "text/csv"), ("Accept", "text/csv"), ("Prefer", "return=representation")] inserted
-
-           `shouldRespondWith` ResponseMatcher {
-             matchBody    = Just inserted
-           , matchStatus  = 201
-           , matchHeaders = ["Content-Type" <:> "text/csv"]
+           `shouldRespondWith` ResponseMatcher
+           { matchStatus  = 201
+           , matchHeaders = ["Content-Type" <:> "text/csv; charset=utf-8"]
+           , matchBody = bodyEquals inserted
            }
-        -- p <- request methodPost "/menagerie" [("Content-Type", "text/csv")]
-        --        [str|integer,double,varchar,boolean,date,money,enum
-        --            |13,3.14159,testing!,false,1900-01-01,$3.99,foo
-        --            |12,0.1,a string,true,1929-10-01,12,bar
-        --            |]
-        -- liftIO $ do
-        --   simpleBody p `shouldBe` "Content-Type: application/json\nLocation: /menagerie?integer=eq.13\n\n\n--postgrest_boundary\nContent-Type: application/json\nLocation: /menagerie?integer=eq.12\n\n"
-        --   simpleStatus p `shouldBe` created201
 
     context "requesting full representation" $ do
       it "returns full details of inserted record" $
         request methodPost "/no_pk"
                      [("Content-Type", "text/csv"), ("Accept", "text/csv"),  ("Prefer", "return=representation")]
                      "a,b\nbar,baz"
-          `shouldRespondWith` ResponseMatcher {
-            matchBody    = Just "a,b\nbar,baz"
-          , matchStatus  = 201
-          , matchHeaders = ["Content-Type" <:> "text/csv",
+          `shouldRespondWith` "a,b\nbar,baz"
+          { matchStatus  = 201
+          , matchHeaders = ["Content-Type" <:> "text/csv; charset=utf-8",
                             "Location" <:> "/no_pk?a=eq.bar&b=eq.baz"]
           }
 
-      -- it "can post nulls (old way)" $ do
-      --   pendingWith "changed the response when in csv mode"
-      --   request methodPost "/no_pk"
-      --                [("Content-Type", "text/csv"), ("Prefer", "return=representation")]
-      --                "a,b\nNULL,foo"
-      --     `shouldRespondWith` ResponseMatcher {
-      --       matchBody    = Just [json| { "a":null, "b":"foo" } |]
-      --     , matchStatus  = 201
-      --     , matchHeaders = ["Content-Type" <:> "application/json",
-      --                       "Location" <:> "/no_pk?a=is.null&b=eq.foo"]
-      --     }
       it "can post nulls" $
         request methodPost "/no_pk"
                      [("Content-Type", "text/csv"), ("Accept", "text/csv"), ("Prefer", "return=representation")]
                      "a,b\nNULL,foo"
-          `shouldRespondWith` ResponseMatcher {
-            matchBody    = Just "a,b\n,foo"
-          , matchStatus  = 201
-          , matchHeaders = ["Content-Type" <:> "text/csv",
+          `shouldRespondWith` "a,b\n,foo"
+          { matchStatus  = 201
+          , matchHeaders = ["Content-Type" <:> "text/csv; charset=utf-8",
                             "Location" <:> "/no_pk?a=is.null&b=eq.foo"]
           }
 
+      it "only returns the requested column header with its associated data" $
+        request methodPost "/projects?select=id"
+                     [("Content-Type", "text/csv"), ("Accept", "text/csv"), ("Prefer", "return=representation")]
+                     "id,name,client_id\n8,Xenix,1\n9,Windows NT,1"
+          `shouldRespondWith` "id\n8\n9"
+          { matchStatus  = 201
+          , matchHeaders = ["Content-Type" <:> "text/csv; charset=utf-8",
+                            "Content-Range" <:> "*/*"]
+          }
 
     context "with wrong number of columns" $
       it "fails for too few" $ do
         p <- request methodPost "/no_pk" [("Content-Type", "text/csv")] "a,b\nfoo,bar\nbaz"
-        liftIO $ simpleStatus p `shouldBe` badRequest400
-      -- it does not fail because the extra columns are ignored
-      -- it "fails for too many" $ do
-      --   p <- request methodPost "/no_pk" [("Content-Type", "text/csv")] "a,b\nfoo,bar\nbaz,bat,bad"
-      --   liftIO $ simpleStatus p `shouldBe` badRequest400
+        liftIO $ do
+          simpleStatus p `shouldBe` badRequest400
+          isErrorFormat (simpleBody p) `shouldBe` True
 
-  describe "Putting record" $ do
+    context "with unicode values" $
+      it "succeeds and returns usable location header" $ do
+        let payload = [json| { "a":"圍棋", "b":"￥" } |]
+        p <- request methodPost "/no_pk"
+                     [("Prefer", "return=representation")]
+                     payload
+        liftIO $ do
+          simpleBody p `shouldBe` "["<>payload<>"]"
+          simpleStatus p `shouldBe` created201
 
-    context "to unknown uri" $
-      it "gives a 404" $ do
-        pendingWith "Decide on PUT usefullness"
-        request methodPut "/fake" []
-          [json| { "real": false } |]
-            `shouldRespondWith` 404
+        let Just location = lookup hLocation $ simpleHeaders p
+        r <- get location
+        liftIO $ simpleBody r `shouldBe` "["<>payload<>"]"
 
-    context "to a known uri" $ do
-      context "without a fully-specified primary key" $
-        it "is not an allowed operation" $ do
-          pendingWith "Decide on PUT usefullness"
-          request methodPut "/compound_pk?k1=eq.12" []
-            [json| { "k1":12, "k2":42 } |]
-              `shouldRespondWith` 405
-
-      context "with a fully-specified primary key" $ do
-
-        context "not specifying every column in the table" $
-          it "is rejected for lack of idempotence" $ do
-            pendingWith "Decide on PUT usefullness"
-            request methodPut "/compound_pk?k1=eq.12&k2=eq.42" []
-              [json| { "k1":12, "k2":42 } |]
-                `shouldRespondWith` 400
-
-        context "specifying every column in the table" $ do
-          it "can create a new record" $ do
-            pendingWith "Decide on PUT usefullness"
-            p <- request methodPut "/compound_pk?k1=eq.12&k2=eq.42" []
-                 [json| { "k1":12, "k2":42, "extra":3 } |]
-            liftIO $ do
-              simpleBody p `shouldBe` ""
-              simpleStatus p `shouldBe` status204
-
-            r <- get "/compound_pk?k1=eq.12&k2=eq.42"
-            let rows = fromJust (JSON.decode $ simpleBody r :: Maybe [CompoundPK])
-            liftIO $ do
-              length rows `shouldBe` 1
-              let record = head rows
-              compoundK1 record `shouldBe` 12
-              compoundK2 record `shouldBe` 42
-              compoundExtra record `shouldBe` Just 3
-
-          it "can update an existing record" $ do
-            pendingWith "Decide on PUT usefullness"
-            _ <- request methodPut "/compound_pk?k1=eq.12&k2=eq.42" []
-                 [json| { "k1":12, "k2":42, "extra":4 } |]
-            _ <- request methodPut "/compound_pk?k1=eq.12&k2=eq.42" []
-                 [json| { "k1":12, "k2":42, "extra":5 } |]
-
-            r <- get "/compound_pk?k1=eq.12&k2=eq.42"
-            let rows = fromJust (JSON.decode $ simpleBody r :: Maybe [CompoundPK])
-            liftIO $ do
-              length rows `shouldBe` 1
-              let record = head rows
-              compoundExtra record `shouldBe` Just 5
-
-      context "with an auto-incrementing primary key"$
-
-        it "succeeds with 204" $ do
-          pendingWith "Decide on PUT usefullness"
-          request methodPut "/auto_incrementing_pk?id=eq.1" []
-               [json| {
-                 "id":1,
-                 "nullable_string":"hi",
-                 "non_nullable_string":"bye",
-                 "inserted_at": "2020-11-11"
-               } |]
-            `shouldRespondWith` ResponseMatcher {
-              matchBody    = Nothing,
-              matchStatus  = 204,
-              matchHeaders = []
-            }
 
   describe "Patching record" $ do
 
@@ -326,23 +330,46 @@ spec struct c = beforeAll_ resetDb $ around (withApp cfgDefault struct c) $ do
       it "indicates no records found to update" $
         request methodPatch "/empty_table" []
           [json| { "extra":20 } |]
-            `shouldRespondWith` 404
+          `shouldRespondWith` ""
+          { matchStatus  = 204,
+            matchHeaders = ["Content-Range" <:> "*/*"]
+          }
 
     context "in a nonempty table" $ do
       it "can update a single item" $ do
         g <- get "/items?id=eq.42"
         liftIO $ simpleHeaders g
-          `shouldSatisfy` matchHeader "Content-Range" "\\*/0"
-        request methodPatch "/items?id=eq.2" []
-          [json| { "id":42 } |]
-            `shouldRespondWith` ResponseMatcher {
-              matchBody    = Nothing,
-              matchStatus  = 204,
-              matchHeaders = ["Content-Range" <:> "0-0/1"]
-            }
+          `shouldSatisfy` matchHeader "Content-Range" "\\*/\\*"
+        p <- request methodPatch "/items?id=eq.2" [] [json| { "id":42 } |]
+        pure p `shouldRespondWith` ""
+          { matchStatus  = 204,
+            matchHeaders = ["Content-Range" <:> "0-0/*"]
+          }
+        liftIO $ lookup hContentType (simpleHeaders p) `shouldBe` Nothing
+
+        -- check it really got updated
         g' <- get "/items?id=eq.42"
         liftIO $ simpleHeaders g'
-          `shouldSatisfy` matchHeader "Content-Range" "0-0/1"
+          `shouldSatisfy` matchHeader "Content-Range" "0-0/\\*"
+        -- put value back for other tests
+        void $ request methodPatch "/items?id=eq.42" [] [json| { "id":2 } |]
+
+      it "returns empty array when no rows updated and return=rep" $
+        request methodPatch "/items?id=eq.999999"
+          [("Prefer", "return=representation")] [json| { "id":999999 } |]
+          `shouldRespondWith` "[]"
+          {
+            matchStatus  = 200,
+            matchHeaders = ["Content-Range" <:> "*/*"]
+          }
+
+      it "returns updated object as array when return=rep" $
+        request methodPatch "/items?id=eq.2"
+          [("Prefer", "return=representation")] [json| { "id":2 } |]
+          `shouldRespondWith` [str|[{"id":2}]|]
+          { matchStatus  = 200,
+            matchHeaders = ["Content-Range" <:> "0-0/*"]
+          }
 
       it "can update multiple items" $ do
         replicateM_ 10 $ post "/auto_incrementing_pk"
@@ -354,20 +381,25 @@ spec struct c = beforeAll_ resetDb $ around (withApp cfgDefault struct c) $ do
           [json| { non_nullable_string: "c" } |]
         g <- get "/auto_incrementing_pk?non_nullable_string=eq.c"
         liftIO $ simpleHeaders g
-          `shouldSatisfy` matchHeader "Content-Range" "0-9/10"
+          `shouldSatisfy` matchHeader "Content-Range" "0-9/\\*"
 
       it "can set a column to NULL" $ do
         _ <- post "/no_pk" [json| { a: "keepme", b: "nullme" } |]
         _ <- request methodPatch "/no_pk?b=eq.nullme" [] [json| { b: null } |]
         get "/no_pk?a=eq.keepme" `shouldRespondWith`
           [json| [{ a: "keepme", b: null }] |]
+          { matchHeaders = [matchContentTypeJson] }
 
       it "can update based on a computed column" $
         request methodPatch
           "/items?always_true=eq.false"
           [("Prefer", "return=representation")]
           [json| { id: 100 } |]
-          `shouldRespondWith` 404
+          `shouldRespondWith` "[]"
+          { matchStatus  = 200,
+            matchHeaders = ["Content-Range" <:> "*/*"]
+          }
+
       it "can provide a representation" $ do
         _ <- post "/items"
           [json| { id: 1 } |]
@@ -376,21 +408,54 @@ spec struct c = beforeAll_ resetDb $ around (withApp cfgDefault struct c) $ do
           [("Prefer", "return=representation")]
           [json| { id: 99 } |]
           `shouldRespondWith` [json| [{id:99}] |]
+          { matchHeaders = [matchContentTypeJson] }
+        -- put value back for other tests
+        void $ request methodPatch "/items?id=eq.99" [] [json| { "id":1 } |]
 
-      it "can set a json column to escaped value" $ do
-        _ <- post "/json" [json| { data: {"escaped":"bar"} } |]
-        request methodPatch "/json?data->>escaped=eq.bar"
-                     [("Prefer", "return=representation")]
-                     [json| { "data": { "escaped":" \"bar" } } |]
-          `shouldRespondWith` ResponseMatcher {
-            matchBody    = Just [json| [{ "data": { "escaped":" \"bar" } }] |]
-          , matchStatus  = 200
-          , matchHeaders = []
+      it "makes no updates and returns 204, when patching with an empty json object/array" $ do
+        request methodPatch "/items" [] [json| {} |]
+          `shouldRespondWith` ""
+          {
+            matchStatus  = 204,
+            matchHeaders = ["Content-Range" <:> "*/*"]
           }
 
+        request methodPatch "/items" [] [json| [] |]
+          `shouldRespondWith` ""
+          {
+            matchStatus  = 204,
+            matchHeaders = ["Content-Range" <:> "*/*"]
+          }
+
+        get "/items" `shouldRespondWith`
+          [json|[{"id":3},{"id":4},{"id":5},{"id":6},{"id":7},{"id":8},{"id":9},{"id":10},{"id":11},{"id":12},{"id":13},{"id":14},{"id":15},{id:16},{"id":2},{"id":1}]|]
+          { matchHeaders = [matchContentTypeJson] }
+
+      it "makes no updates and and returns 200, when patching with an empty json object and return=rep" $ do
+        request methodPatch "/items" [("Prefer", "return=representation")] [json| {} |]
+          `shouldRespondWith` "[]"
+          {
+            matchStatus  = 200,
+            matchHeaders = ["Content-Range" <:> "*/*"]
+          }
+        get "/items" `shouldRespondWith`
+          [json| [{"id":3},{"id":4},{"id":5},{"id":6},{"id":7},{"id":8},{"id":9},{"id":10},{"id":11},{"id":12},{"id":13},{"id":14},{"id":15},{id:16},{"id":2},{"id":1}] |]
+          { matchHeaders = [matchContentTypeJson] }
+  
+    context "with unicode values" $
+      it "succeeds and returns values intact" $ do
+        void $ request methodPost "/no_pk" []
+          [json| { "a":"patchme", "b":"patchme" } |]
+        let payload = [json| { "a":"圍棋", "b":"￥" } |]
+        p <- request methodPatch "/no_pk?a=eq.patchme&b=eq.patchme"
+          [("Prefer", "return=representation")] payload
+        liftIO $ do
+          simpleBody p `shouldBe` "["<>payload<>"]"
+          simpleStatus p `shouldBe` ok200
+
   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" } |]
 
@@ -398,13 +463,13 @@ spec struct c = beforeAll_ resetDb $ around (withApp cfgDefault struct c) $ do
         [ auth, ("Prefer", "return=representation") ]
         [json| { "secret": "nyancat" } |]
       liftIO $ do
-          simpleBody p1 `shouldBe` [str|{"owner":"jdoe","secret":"nyancat"}|]
-          simpleStatus p1 `shouldBe` created201
+        simpleBody p1 `shouldBe` [str|[{"owner":"jdoe","secret":"nyancat"}]|]
+        simpleStatus p1 `shouldBe` created201
 
       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"}|]
-          simpleStatus p2 `shouldBe` created201
+        simpleBody p2 `shouldBe` [str|[{"owner":"jroe","secret":"lolcat"}]|]
+        simpleStatus p2 `shouldBe` created201

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

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

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

@@ -0,0 +1,15 @@
+module Feature.ProxySpec where
+
+import Test.Hspec hiding (pendingWith)
+
+import SpecHelper
+
+import Network.Wai (Application)
+
+import Protolude hiding (get)
+
+spec :: SpecWith Application
+spec =
+  describe "GET / with proxy" $
+    it "returns a valid openapi spec with proxy" $
+      validateOpenApiResponse [("Accept", "application/openapi+json")]

test/Feature/QueryLimitedSpec.hs

@@ -5,28 +5,39 @@ import Test.Hspec.Wai
 import Test.Hspec.Wai.JSON
 import Network.HTTP.Types
 import Network.Wai.Test (SResponse(simpleHeaders, simpleStatus))
-import qualified Hasql.Connection  as H
-
 import SpecHelper
-import PostgREST.Types (DbStructure(..))
+import Network.Wai (Application)
 
-spec :: DbStructure -> H.Connection -> Spec
-spec struct c =
-  beforeAll resetDb
-   . around (withApp (cfgLimitRows 3) struct c) $
+import Protolude hiding (get)
+
+spec :: SpecWith Application
+spec =
   describe "Requesting many items with server limits enabled" $ do
     it "restricts results" $
       get "/items"
-        `shouldRespondWith` ResponseMatcher {
-          matchBody    = Just [json| [{"id":1},{"id":2},{"id":3}] |]
-        , matchStatus  = 206
-        , matchHeaders = ["Content-Range" <:> "0-2/15"]
+        `shouldRespondWith` [json| [{"id":1},{"id":2}] |]
+        { matchStatus  = 200
+        , matchHeaders = ["Content-Range" <:> "0-1/*"]
         }
 
     it "respects additional client limiting" $ do
       r <- request methodGet  "/items"
-                   (rangeHdrs $ ByteRangeFromTo 0 1) ""
+                   (rangeHdrs $ ByteRangeFromTo 0 0) ""
       liftIO $ do
         simpleHeaders r `shouldSatisfy`
-          matchHeader "Content-Range" "0-1/15"
-        simpleStatus r `shouldBe` partialContent206
+          matchHeader "Content-Range" "0-0/*"
+        simpleStatus r `shouldBe` ok200
+
+    it "limit works on all levels" $
+      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` [json|[{"id":6,"project":{"id":3}},{"id":7,"project":{"id":4}}]|]
+        { matchStatus  = 200
+        , matchHeaders = ["Content-Range" <:> "0-1/*"]
+        }

test/Feature/RangeSpec.hs

@@ -5,16 +5,101 @@ import Test.Hspec.Wai
 import Test.Hspec.Wai.JSON
 import Network.HTTP.Types
 import Network.Wai.Test (SResponse(simpleHeaders,simpleStatus))
-import qualified Hasql.Connection  as H
+
+import qualified Data.ByteString.Lazy         as BL
 
 import SpecHelper
-import PostgREST.Types (DbStructure(..))
+import Network.Wai (Application)
+
+import Protolude hiding (get)
+
+defaultRange :: BL.ByteString
+defaultRange = [json| { "min": 0, "max": 15 } |]
+
+emptyRange :: BL.ByteString
+emptyRange = [json| { "min": 2, "max": 2 } |]
+
+spec :: SpecWith Application
+spec = do
+  describe "POST /rpc/getitemrange" $ do
+    context "without range headers" $ do
+      context "with response under server size limit" $
+        it "returns whole range with status 200" $
+           post "/rpc/getitemrange" defaultRange `shouldRespondWith` 200
+
+      context "when I don't want the count" $ do
+        it "returns range Content-Range with */* for empty range" $
+          request methodPost "/rpc/getitemrange" [] emptyRange
+            `shouldRespondWith` [json| [] |] {matchHeaders = ["Content-Range" <:> "*/*"]}
+
+        it "returns range Content-Range with range/*" $
+          request methodPost "/rpc/getitemrange" [] defaultRange
+            `shouldRespondWith` [json| [{"id":1},{"id":2},{"id":3},{"id":4},{"id":5},{"id":6},{"id":7},{"id":8},{"id":9},{"id":10},{"id":11},{"id":12},{"id":13},{"id":14},{"id":15}] |]
+            { matchHeaders = ["Content-Range" <:> "0-14/*"] }
+
+    context "with range headers" $ do
+
+      context "of acceptable range" $ do
+        it "succeeds with partial content" $ do
+          r <- request methodPost  "/rpc/getitemrange"
+                       (rangeHdrs $ ByteRangeFromTo 0 1) defaultRange
+          liftIO $ do
+            simpleHeaders r `shouldSatisfy`
+              matchHeader "Content-Range" "0-1/*"
+            simpleStatus r `shouldBe` ok200
+
+        it "understands open-ended ranges" $
+          request methodPost "/rpc/getitemrange"
+                  (rangeHdrs $ ByteRangeFrom 0) defaultRange
+            `shouldRespondWith` 200
+
+        it "returns an empty body when there are no results" $
+          request methodPost "/rpc/getitemrange"
+                  (rangeHdrs $ ByteRangeFromTo 0 1) emptyRange
+            `shouldRespondWith` "[]"
+            { matchStatus  = 200
+            , matchHeaders = ["Content-Range" <:> "*/*"]
+            }
+
+        it "allows one-item requests" $ do
+          r <- request methodPost  "/rpc/getitemrange"
+                       (rangeHdrs $ ByteRangeFromTo 0 0) defaultRange
+          liftIO $ do
+            simpleHeaders r `shouldSatisfy`
+              matchHeader "Content-Range" "0-0/*"
+            simpleStatus r `shouldBe` ok200
+
+        it "handles ranges beyond collection length via truncation" $ do
+          r <- request methodPost  "/rpc/getitemrange"
+                       (rangeHdrs $ ByteRangeFromTo 10 100) defaultRange
+          liftIO $ do
+            simpleHeaders r `shouldSatisfy`
+              matchHeader "Content-Range" "10-14/*"
+            simpleStatus r `shouldBe` ok200
+
+      context "of invalid range" $ do
+        it "fails with 416 for offside range" $
+          request methodPost  "/rpc/getitemrange"
+                  (rangeHdrs $ ByteRangeFromTo 1 0) emptyRange
+            `shouldRespondWith` 416
+
+        it "refuses a range with nonzero start when there are no items" $
+          request methodPost "/rpc/getitemrange"
+                  (rangeHdrsWithCount $ ByteRangeFromTo 1 2) emptyRange
+            `shouldRespondWith` "[]"
+            { matchStatus  = 416
+            , matchHeaders = ["Content-Range" <:> "*/0"]
+            }
+
+        it "refuses a range requesting start past last item" $
+          request methodPost "/rpc/getitemrange"
+                  (rangeHdrsWithCount $ ByteRangeFromTo 100 199) defaultRange
+            `shouldRespondWith` "[]"
+            { matchStatus  = 416
+            , matchHeaders = ["Content-Range" <:> "*/15"]
+            }
 
-spec :: DbStructure -> H.Connection -> Spec
-spec struct c = beforeAll resetDb
-  . around (withApp cfgDefault struct c) $
   describe "GET /items" $ do
-
     context "without range headers" $ do
       context "with response under server size limit" $
         it "returns whole range with status 200" $
@@ -24,29 +109,60 @@ spec struct c = beforeAll resetDb
         it "returns range Content-Range with /*" $
           request methodGet "/menagerie"
                   [("Prefer", "count=none")] ""
-            `shouldRespondWith` ResponseMatcher {
-              matchBody    = Just "[]"
-            , matchStatus  = 200
+            `shouldRespondWith` "[]"
+            { matchStatus  = 200
             , matchHeaders = ["Content-Range" <:> "*/*"]
             }
 
         it "returns range Content-Range with range/*" $
           request methodGet "/items?order=id"
                   [("Prefer", "count=none")] ""
-            `shouldRespondWith` ResponseMatcher {
-              matchBody    = Just [json| [{"id":1},{"id":2},{"id":3},{"id":4},{"id":5},{"id":6},{"id":7},{"id":8},{"id":9},{"id":10},{"id":11},{"id":12},{"id":13},{"id":14},{"id":15}] |]
-            , matchStatus  = 200
-            , matchHeaders = ["Content-Range" <:> "0-14/*"]
-            }
+            `shouldRespondWith` [json| [{"id":1},{"id":2},{"id":3},{"id":4},{"id":5},{"id":6},{"id":7},{"id":8},{"id":9},{"id":10},{"id":11},{"id":12},{"id":13},{"id":14},{"id":15}] |]
+            { matchHeaders = ["Content-Range" <:> "0-14/*"] }
 
         it "returns range Content-Range with range/* even using other filters" $
           request methodGet "/items?id=eq.1&order=id"
                   [("Prefer", "count=none")] ""
-            `shouldRespondWith` ResponseMatcher {
-              matchBody    = Just [json| [{"id":1}] |]
-            , matchStatus  = 200
-            , matchHeaders = ["Content-Range" <:> "0-0/*"]
-            }
+            `shouldRespondWith` [json| [{"id":1}] |]
+            { matchHeaders = ["Content-Range" <:> "0-0/*"] }
+
+    context "with limit/offset parameters" $ do
+      it "no parameters return everything" $
+        get "/items?select=id&order=id.asc"
+          `shouldRespondWith`
+          [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` [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` [json|[{"id":1},{"id":2}]|]
+          { matchStatus  = 200
+          , matchHeaders = ["Content-Range" <:> "0-1/*"]
+          }
+
+      it "limit works on all levels" $
+        get "/clients?select=id,projects(id,tasks(id))&order=id.asc&limit=1&projects.order=id.asc&projects.limit=2&projects.tasks.order=id.asc&projects.tasks.limit=1"
+          `shouldRespondWith`
+          [json|[{"id":1,"projects":[{"id":1,"tasks":[{"id":1}]},{"id":2,"tasks":[{"id":3}]}]}]|]
+          { matchStatus  = 200
+          , matchHeaders = ["Content-Range" <:> "0-0/*"]
+          }
+
+
+      it "limit and offset works on first level" $
+        get "/items?select=id&order=id.asc&limit=3&offset=2"
+          `shouldRespondWith` [json|[{"id":3},{"id":4},{"id":5}]|]
+          { matchStatus  = 200
+          , matchHeaders = ["Content-Range" <:> "2-4/*"]
+          }
 
     context "with range headers" $ do
 
@@ -56,8 +172,8 @@ spec struct c = beforeAll resetDb
                        (rangeHdrs $ ByteRangeFromTo 0 1) ""
           liftIO $ do
             simpleHeaders r `shouldSatisfy`
-              matchHeader "Content-Range" "0-1/15"
-            simpleStatus r `shouldBe` partialContent206
+              matchHeader "Content-Range" "0-1/*"
+            simpleStatus r `shouldBe` ok200
 
         it "understands open-ended ranges" $
           request methodGet "/items"
@@ -67,10 +183,9 @@ spec struct c = beforeAll resetDb
         it "returns an empty body when there are no results" $
           request methodGet "/menagerie"
                   (rangeHdrs $ ByteRangeFromTo 0 1) ""
-            `shouldRespondWith` ResponseMatcher {
-              matchBody    = Just "[]"
-            , matchStatus  = 200
-            , matchHeaders = ["Content-Range" <:> "*/0"]
+            `shouldRespondWith` "[]"
+            { matchStatus  = 200
+            , matchHeaders = ["Content-Range" <:> "*/*"]
             }
 
         it "allows one-item requests" $ do
@@ -78,16 +193,16 @@ spec struct c = beforeAll resetDb
                        (rangeHdrs $ ByteRangeFromTo 0 0) ""
           liftIO $ do
             simpleHeaders r `shouldSatisfy`
-              matchHeader "Content-Range" "0-0/15"
-            simpleStatus r `shouldBe` partialContent206
+              matchHeader "Content-Range" "0-0/*"
+            simpleStatus r `shouldBe` ok200
 
         it "handles ranges beyond collection length via truncation" $ do
           r <- request methodGet  "/items"
                        (rangeHdrs $ ByteRangeFromTo 10 100) ""
           liftIO $ do
             simpleHeaders r `shouldSatisfy`
-              matchHeader "Content-Range" "10-14/15"
-            simpleStatus r `shouldBe` partialContent206
+              matchHeader "Content-Range" "10-14/*"
+            simpleStatus r `shouldBe` ok200
 
       context "of invalid range" $ do
         it "fails with 416 for offside range" $
@@ -97,18 +212,16 @@ spec struct c = beforeAll resetDb
 
         it "refuses a range with nonzero start when there are no items" $
           request methodGet "/menagerie"
-                  (rangeHdrs $ ByteRangeFromTo 1 2) ""
-            `shouldRespondWith` ResponseMatcher {
-              matchBody    = Nothing
-            , matchStatus  = 416
+                  (rangeHdrsWithCount $ ByteRangeFromTo 1 2) ""
+            `shouldRespondWith` "[]"
+            { matchStatus  = 416
             , matchHeaders = ["Content-Range" <:> "*/0"]
             }
 
         it "refuses a range requesting start past last item" $
           request methodGet "/items"
-                  (rangeHdrs $ ByteRangeFromTo 100 199) ""
-            `shouldRespondWith` ResponseMatcher {
-              matchBody    = Nothing
-            , matchStatus  = 416
+                  (rangeHdrsWithCount $ ByteRangeFromTo 100 199) ""
+            `shouldRespondWith` "[]"
+            { matchStatus  = 416
             , matchHeaders = ["Content-Range" <:> "*/15"]
             }

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

@@ -0,0 +1,194 @@
+module Feature.SingularSpec where
+
+import Text.Heredoc
+import Test.Hspec
+import Test.Hspec.Wai
+import Test.Hspec.Wai.JSON
+import Network.HTTP.Types
+import Network.Wai.Test (SResponse(..))
+
+import Network.Wai (Application)
+
+import SpecHelper
+import Protolude hiding (get)
+
+
+spec :: SpecWith Application
+spec =
+  describe "Requesting singular json object" $ do
+    let pgrstObj = "application/vnd.pgrst.object+json"
+        singular = ("Accept", pgrstObj)
+
+    context "with GET request" $ do
+      it "fails for zero rows" $
+        request methodGet  "/items?id=gt.0&id=lt.0" [singular] ""
+          `shouldRespondWith` 406
+
+      it "will select an existing object" $ do
+        request methodGet "/items?id=eq.5" [singular] ""
+          `shouldRespondWith` [str|{"id":5}|]
+        -- also test without the +json suffix
+        request methodGet "/items?id=eq.5"
+          [("Accept", "application/vnd.pgrst.object")] ""
+          `shouldRespondWith` [str|{"id":5}|]
+
+      it "can combine multiple prefer values" $
+        request methodGet "/items?id=eq.5" [singular, ("Prefer","count=none")] ""
+          `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] ""
+          `shouldRespondWith`
+            [json|{"id":1,"name":"Windows 7","clients":{"id":1,"name":"Microsoft"},"tasks":[{"id":1,"name":"Design w7"},{"id":2,"name":"Code w7"}]}|]
+            { matchHeaders = ["Content-Type" <:> "application/vnd.pgrst.object+json; charset=utf-8"] }
+
+    context "when updating rows" $ do
+
+      it "works for one row" $ do
+        _ <- post "/addresses" [json| { id: 97, address: "A Street" } |]
+        request methodPatch
+          "/addresses?id=eq.97"
+          [("Prefer", "return=representation"), singular]
+          [json| { address: "B Street" } |]
+          `shouldRespondWith`
+            [str|{"id":97,"address":"B Street"}|]
+
+      it "raises an error for multiple rows" $ do
+        _ <- post "/addresses" [json| { id: 98, address: "xxx" } |]
+        _ <- post "/addresses" [json| { id: 99, address: "yyy" } |]
+        p <- request methodPatch
+          "/addresses?id=gt.0"
+          [("Prefer", "return=representation"), singular]
+          [json| { address: "zzz" } |]
+        liftIO $ do
+          simpleStatus p `shouldBe` notAcceptable406
+          isErrorFormat (simpleBody p) `shouldBe` True
+
+        -- the rows should not be updated, either
+        get "/addresses?id=eq.98" `shouldRespondWith` [str|[{"id":98,"address":"xxx"}]|]
+
+      it "raises an error for zero rows" $ do
+        p <- request methodPatch  "/items?id=gt.0&id=lt.0"
+          [("Prefer", "return=representation"), singular] [json|{"id":1}|]
+        liftIO $ do
+          simpleStatus p `shouldBe` notAcceptable406
+          isErrorFormat (simpleBody p) `shouldBe` True
+
+    context "when creating rows" $ do
+
+      it "works for one row" $ do
+        p <- request methodPost
+          "/addresses"
+          [("Prefer", "return=representation"), singular]
+          [json| [ { id: 100, address: "xxx" } ] |]
+        liftIO $ simpleBody p `shouldBe` [str|{"id":100,"address":"xxx"}|]
+
+      it "works for one row even with return=minimal" $ do
+        request methodPost "/addresses"
+          [("Prefer", "return=minimal"), singular]
+          [json| [ { id: 101, address: "xxx" } ] |]
+          `shouldRespondWith` ""
+          { matchStatus  = 201
+          , matchHeaders = ["Content-Range" <:> "*/*"]
+          }
+        -- and the element should exist
+        get "/addresses?id=eq.101"
+          `shouldRespondWith` [str|[{"id":101,"address":"xxx"}]|]
+          { matchStatus  = 200
+          , matchHeaders = []
+          }
+
+      it "raises an error when attempting to create multiple entities" $ do
+        p <- request methodPost
+          "/addresses"
+          [("Prefer", "return=representation"), singular]
+          [json| [ { id: 200, address: "xxx" }, { id: 201, address: "yyy" } ] |]
+        liftIO $ simpleStatus p `shouldBe` notAcceptable406
+
+        -- the rows should not exist, either
+        get "/addresses?id=eq.200" `shouldRespondWith` "[]"
+
+      it "return=minimal allows request to create multiple elements" $
+        request methodPost "/addresses"
+          [("Prefer", "return=minimal"), singular]
+          [json| [ { id: 200, address: "xxx" }, { id: 201, address: "yyy" } ] |]
+          `shouldRespondWith` ""
+          { matchStatus  = 201
+          , matchHeaders = ["Content-Range" <:> "*/*"]
+          }
+
+      it "raises an error when creating zero entities" $ do
+        p <- request methodPost
+          "/addresses"
+          [("Prefer", "return=representation"), singular]
+          [json| [ ] |]
+        liftIO $ do
+          simpleStatus p `shouldBe` notAcceptable406
+          isErrorFormat (simpleBody p) `shouldBe` True
+
+    context "when deleting rows" $ do
+
+      it "works for one row" $ do
+        p <- request methodDelete
+          "/items?id=eq.11"
+          [("Prefer", "return=representation"), singular] ""
+        liftIO $ simpleBody p `shouldBe` [str|{"id":11}|]
+
+      it "raises an error when attempting to delete multiple entities" $ do
+        let firstItems = "/items?id=gt.0&id=lt.11"
+        request methodDelete firstItems
+          [("Prefer", "return=representation"), singular] ""
+          `shouldRespondWith` 406
+
+        get firstItems
+          `shouldRespondWith` [json| [{"id":1},{"id":2},{"id":3},{"id":4},{"id":5},{"id":6},{"id":7},{"id":8},{"id":9},{"id":10}] |]
+          { matchStatus  = 200
+          , matchHeaders = ["Content-Range" <:> "0-9/*"]
+          }
+
+      it "raises an error when deleting zero entities" $ do
+        p <- request methodDelete "/items?id=lt.0"
+          [("Prefer", "return=representation"), singular] ""
+        liftIO $ do
+          simpleStatus p `shouldBe` notAcceptable406
+          isErrorFormat (simpleBody p) `shouldBe` True
+
+    context "when calling a stored proc" $ do
+
+      it "fails for zero rows" $ do
+        p <- request methodPost "/rpc/getproject"
+          [singular] [json|{ "id": 9999999}|]
+        liftIO $ do
+          simpleStatus p `shouldBe` notAcceptable406
+          isErrorFormat (simpleBody p) `shouldBe` True
+
+      -- this one may be controversial, should vnd.pgrst.object include
+      -- the likes of 2 and "hello?"
+      it "succeeds for scalar result" $
+        request methodPost "/rpc/sayhello"
+          [singular] [json|{ "name": "world"}|]
+          `shouldRespondWith` 200
+
+      it "returns a single object for json proc" $
+        request methodPost "/rpc/getproject"
+          [singular] [json|{ "id": 1}|] `shouldRespondWith`
+          [str|{"id":1,"name":"Windows 7","client_id":1}|]
+
+      it "fails for multiple rows" $ do
+        p <- request methodPost "/rpc/getallprojects" [singular] "{}"
+        liftIO $ do
+          simpleStatus p `shouldBe` notAcceptable406
+          isErrorFormat (simpleBody p) `shouldBe` True
+
+      it "executes the proc exactly once per request" $ do
+        request methodPost "/rpc/getproject?select=id,name" [] [json| {"id": 1} |]
+          `shouldRespondWith` [str|[{"id":1,"name":"Windows 7"}]|]
+        p <- request methodPost "/rpc/setprojects" [singular]
+          [json| {"id_l": 1, "id_h": 2, "name": "changed"} |]
+        liftIO $ do
+          simpleStatus p `shouldBe` notAcceptable406
+          isErrorFormat (simpleBody p) `shouldBe` True
+
+        -- should not actually have executed the function
+        request methodPost "/rpc/getproject?select=id,name" [] [json| {"id": 1} |]
+          `shouldRespondWith` [str|[{"id":1,"name":"Windows 7"}]|]

test/Feature/StructureSpec.hs

@@ -2,324 +2,326 @@ module Feature.StructureSpec where
 
 import Test.Hspec hiding (pendingWith)
 import Test.Hspec.Wai
-import Test.Hspec.Wai.JSON
-import qualified Hasql.Connection  as H
-
-import SpecHelper
-import PostgREST.Types (DbStructure(..))
-
 import Network.HTTP.Types
 
-spec :: DbStructure -> H.Connection -> Spec
-spec struct c = around (withApp cfgDefault struct c) $ do
-  describe "GET /" $ do
-    it "lists views in schema" $
-      request methodGet "/" [] ""
-        `shouldRespondWith` [json| [
-          {"schema":"test","name":"Escap3e;","insertable":true}
-        , {"schema":"test","name":"articleStars","insertable":true}
-        , {"schema":"test","name":"articles","insertable":true}
-        , {"schema":"test","name":"auto_incrementing_pk","insertable":true}
-        , {"schema":"test","name":"clients","insertable":true}
-        , {"schema":"test","name":"comments","insertable":true}
-        , {"schema":"test","name":"complex_items","insertable":true}
-        , {"schema":"test","name":"compound_pk","insertable":true}
-        , {"schema":"test","name":"ghostBusters","insertable":true}
-        , {"schema":"test","name":"has_count_column","insertable":false}
-        , {"schema":"test","name":"has_fk","insertable":true}
-        , {"schema":"test","name":"insertable_view_with_join","insertable":true}
-        , {"schema":"test","name":"insertonly","insertable":true}
-        , {"schema":"test","name":"items","insertable":true}
-        , {"schema":"test","name":"json","insertable":true}
-        , {"schema":"test","name":"materialized_view","insertable":false}
-        , {"schema":"test","name":"menagerie","insertable":true}
-        , {"schema":"test","name":"no_pk","insertable":true}
-        , {"schema":"test","name":"nullable_integer","insertable":true}
-        , {"schema":"test","name":"projects","insertable":true}
-        , {"schema":"test","name":"projects_view","insertable":true}
-        , {"schema":"test","name":"simple_pk","insertable":true}
-        , {"schema":"test","name":"tasks","insertable":true}
-        , {"schema":"test","name":"tsearch","insertable":true}
-        , {"schema":"test","name":"users","insertable":true}
-        , {"schema":"test","name":"users_projects","insertable":true}
-        , {"schema":"test","name":"users_tasks","insertable":true}
-        , {"schema":"test","name":"withUnique","insertable":true}
-        ] |]
-        {matchStatus = 200}
+import PostgREST.Config (docsVersion)
+import Control.Lens ((^?))
+import Data.Aeson.Types (Value (..))
+import Data.Aeson.Lens
+import Data.Aeson.QQ
 
-    it "lists only views user has permission to see" $ do
-      let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJyb2xlIjoicG9zdGdyZXN0X3Rlc3RfYXV0aG9yIiwiaWQiOiJqZG9lIn0.y4vZuu1dDdwAl0-S00MCRWRYMlJ5YAMSir6Es6WtWx0"
+import SpecHelper
 
-      request methodGet "/" [auth] ""
-        `shouldRespondWith` [json| [
-            {"schema":"test","name":"authors_only","insertable":true}
-        ] |]
-        {matchStatus = 200}
+import Network.Wai (Application)
+import Network.Wai.Test (SResponse(..))
 
-  describe "Table info" $ do
-    it "is available with OPTIONS verb" $
-      request methodOptions "/menagerie" [] "" `shouldRespondWith`
-      [json|
-      {
-        "pkey":["integer"],
-        "columns":[
-          {
-            "default": null,
-            "precision": 32,
-            "updatable": true,
-            "schema": "test",
-            "name": "integer",
-            "type": "integer",
-            "maxLen": null,
-            "enum": [],
-            "nullable": false,
-            "position": 1,
-            "references": null,
-            "default": null
-          }, {
-            "default": null,
-            "precision": 53,
-            "updatable": true,
-            "schema": "test",
-            "name": "double",
-            "type": "double precision",
-            "maxLen": null,
-            "enum": [],
-            "nullable": false,
-            "references": null,
-            "position": 2
-          }, {
-            "default": null,
-            "precision": null,
-            "updatable": true,
-            "schema": "test",
-            "name": "varchar",
-            "type": "character varying",
-            "maxLen": null,
-            "enum": [],
-            "nullable": false,
-            "position": 3,
-            "references": null,
-            "default": null
-          }, {
-            "default": null,
-            "precision": null,
-            "updatable": true,
-            "schema": "test",
-            "name": "boolean",
-            "type": "boolean",
-            "maxLen": null,
-            "enum": [],
-            "nullable": false,
-            "references": null,
-            "position": 4
-          }, {
-            "default": null,
-            "precision": null,
-            "updatable": true,
-            "schema": "test",
-            "name": "date",
-            "type": "date",
-            "maxLen": null,
-            "enum": [],
-            "nullable": false,
-            "references": null,
-            "position": 5
-          }, {
-            "default": null,
-            "precision": null,
-            "updatable": true,
-            "schema": "test",
-            "name": "money",
-            "type": "money",
-            "maxLen": null,
-            "enum": [],
-            "nullable": false,
-            "position": 6,
-            "references": null,
-            "default": null
-          }, {
-            "default": null,
-            "precision": null,
-            "updatable": true,
-            "schema": "test",
-            "name": "enum",
-            "type": "USER-DEFINED",
-            "maxLen": null,
-            "enum": [
-              "foo",
-              "bar"
-            ],
-            "nullable": false,
-            "position": 7,
-            "references": null,
-            "default": null
-          }
-        ]
-      }
-      |]
+import Protolude hiding (get)
 
-    it "it includes primary and foreign keys for views" $
-      request methodOptions "/projects_view" [] "" `shouldRespondWith`
-      [json|
-      {
-         "pkey":[
-            "id"
-         ],
-         "columns":[
-          {
-            "references":null,
-            "default":null,
-            "precision":32,
-            "updatable":true,
-            "schema":"test",
-            "name":"id",
-            "type":"integer",
-            "maxLen":null,
-            "enum":[],
-            "nullable":true,
-            "position":1
-          },
-          {
-            "references":null,
-            "default":null,
-            "precision":null,
-            "updatable":true,
-            "schema":"test",
-            "name":"name",
-            "type":"text",
-            "maxLen":null,
-            "enum":[],
-            "nullable":true,
-            "position":2
-          },
-          {
-            "references": {
-              "schema":"test",
-              "column":"id",
-              "table":"clients"
-            },
-            "default":null,
-            "precision":32,
-            "updatable":true,
-            "schema":"test",
-            "name":"client_id",
-            "type":"integer",
-            "maxLen":null,
-            "enum":[],
-            "nullable":true,
-            "position":3
-          }
-        ]
-      }
-      |]
+spec :: SpecWith Application
+spec = do
 
-    it "includes foreign key data" $
-      request methodOptions "/has_fk" [] ""
-        `shouldRespondWith` [json|
-      {
-        "pkey": ["id"],
-        "columns":[
-          {
-            "default": "nextval('test.has_fk_id_seq'::regclass)",
-            "precision": 64,
-            "updatable": true,
-            "schema": "test",
-            "name": "id",
-            "type": "bigint",
-            "maxLen": null,
-            "nullable": false,
-            "position": 1,
-            "enum": [],
-            "references": null
-          }, {
-            "default": null,
-            "precision": 32,
-            "updatable": true,
-            "schema": "test",
-            "name": "auto_inc_fk",
-            "type": "integer",
-            "maxLen": null,
-            "nullable": true,
-            "position": 2,
-            "enum": [],
-            "references": {"schema":"test", "table": "auto_incrementing_pk", "column": "id"}
-          }, {
-            "default": null,
-            "precision": null,
-            "updatable": true,
-            "schema": "test",
-            "name": "simple_fk",
-            "type": "character varying",
-            "maxLen": 255,
-            "nullable": true,
-            "position": 3,
-            "enum": [],
-            "references": {"schema":"test", "table": "simple_pk", "column": "k"}
-          }
-        ]
-      }
-      |]
+  describe "OpenAPI" $ do
+    it "root path returns a valid openapi spec" $
+      validateOpenApiResponse [("Accept", "application/openapi+json")]
 
-    it "includes all information on views for renamed columns, and raises relations to correct schema" $
-      request methodOptions "/articleStars" [] ""
-        `shouldRespondWith` [json|
-          {
-            "pkey": [
-              "articleId",
-              "userId"
-            ],
-            "columns": [
+    it "should respond to openapi request on none root path with 415" $
+      request methodGet "/items"
+              (acceptHdrs "application/openapi+json") ""
+        `shouldRespondWith` 415
+
+    it "includes postgrest.org current version api docs" $ do
+      r <- simpleBody <$> get "/"
+
+      let docsUrl = r ^? key "externalDocs" . key "url"
+
+      liftIO $ docsUrl `shouldBe` Just (String ("https://postgrest.org/en/" <> docsVersion <> "/api.html"))
+
+    describe "table" $ do
+
+      it "includes paths to tables" $ do
+        r <- simpleBody <$> get "/"
+
+        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
+
+          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|
               {
-                "references": {
-                  "schema": "test",
-                  "column": "id",
-                  "table": "articles"
+                "items": {
+                  "$ref": "#/definitions/child_entities"
                 },
-                "default": null,
-                "precision": 32,
-                "updatable": true,
-                "schema": "test",
-                "name": "articleId",
-                "type": "integer",
-                "maxLen": null,
-                "enum": [],
-                "nullable": true,
-                "position": 1
-              },
-              {
-                "references": {
-                  "schema": "test",
-                  "column": "id",
-                  "table": "users"
-                },
-                "default": null,
-                "precision": 32,
-                "updatable": true,
-                "schema": "test",
-                "name": "userId",
-                "type": "integer",
-                "maxLen": null,
-                "enum": [],
-                "nullable": true,
-                "position": 2
-              },
-              {
-                "references": null,
-                "default": null,
-                "precision": null,
-                "updatable": true,
-                "schema": "test",
-                "name": "createdAt",
-                "type": "timestamp without time zone",
-                "maxLen": null,
-                "enum": [],
-                "nullable": true,
-                "position": 3
+                "type": "array"
               }
-            ]
-          }
-        |]
+            |]
 
-    it "errors for non existant tables" $
-      request methodOptions "/dne" [] "" `shouldRespondWith` 404
+      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|
+              {
+                "required": [
+                  "double",
+                  "varchar",
+                  "boolean",
+                  "date",
+                  "money",
+                  "enum"
+                ],
+                "properties": {
+                  "double": {
+                    "format": "double precision",
+                    "type": "string"
+                  },
+                  "varchar": {
+                    "format": "character varying",
+                    "type": "string"
+                  },
+                  "boolean": {
+                    "format": "boolean",
+                    "type": "boolean"
+                  },
+                  "date": {
+                    "format": "date",
+                    "type": "string"
+                  },
+                  "money": {
+                    "format": "money",
+                    "type": "string"
+                  },
+                  "enum": {
+                    "format": "enum_menagerie_type",
+                    "type": "string"
+                  },
+                  "integer": {
+                    "format": "integer",
+                    "type": "integer"
+                  }
+                },
+                "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
+      r <- request methodOptions "/items" [] ""
+      liftIO $
+        simpleHeaders r `shouldSatisfy`
+          matchHeader "Allow" "GET,POST,PATCH,DELETE"
+
+    it "includes read verbs for read-only table" $ do
+      r <- request methodOptions "/has_count_column" [] ""
+      liftIO $
+        simpleHeaders r `shouldSatisfy`
+          matchHeader "Allow" "GET"

test/Feature/UnicodeSpec.hs

@@ -0,0 +1,25 @@
+module Feature.UnicodeSpec where
+
+import Test.Hspec
+import Test.Hspec.Wai
+import Test.Hspec.Wai.JSON
+import Network.Wai (Application)
+import Control.Monad (void)
+
+import SpecHelper
+
+import Protolude hiding (get)
+
+spec :: SpecWith Application
+spec =
+  describe "Reading and writing to unicode schema and table names" $
+    it "Can read and write values" $ do
+      get "/%D9%85%D9%88%D8%A7%D8%B1%D8%AF"
+        `shouldRespondWith` "[]"
+
+      void $ post "/%D9%85%D9%88%D8%A7%D8%B1%D8%AF"
+        [json| { "هویت": 1 } |]
+
+      get "/%D9%85%D9%88%D8%A7%D8%B1%D8%AF"
+        `shouldRespondWith` [json| [{ "هویت": 1 }] |]
+        { matchHeaders = [matchContentTypeJson] }

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

@@ -3,41 +3,124 @@ module Main where
 import Test.Hspec
 import SpecHelper
 
-import qualified Hasql.Session as H
-import qualified Hasql.Connection as H
+import qualified Hasql.Pool as P
 
-import PostgREST.DbStructure (getDbStructure)
-import Data.String.Conversions (cs)
+import PostgREST.App (postgrest)
+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 (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
 import qualified Feature.RangeSpec
 import qualified Feature.StructureSpec
+import qualified Feature.SingularSpec
+import qualified Feature.UnicodeSpec
+import qualified Feature.ProxySpec
+import qualified Feature.AndOrParamsSpec
+import qualified Feature.RpcSpec
+import qualified Feature.NonexistentSchemaSpec
+import qualified Feature.PgVersion95Spec
+import qualified Feature.PgVersion96Spec
+import qualified Feature.UpsertSpec
+
+import Protolude
 
 main :: IO ()
 main = do
-  setupDb
+  testDbConn <- getEnvVarWithDefault "POSTGREST_TEST_CONNECTION" "postgres://postgrest_test@localhost/postgrest_test"
+  setupDb testDbConn
 
-  H.acquire (cs dbString) >>= \case
-    Left err -> error $ show err
-    Right c -> do
-      dbOrErr <- H.run (getDbStructure "test") c
-      -- Not using hspec-discover because we want to precompute
-      -- the db structure and pass it to specs for speed
-      either (error.show) (hspec . specs c) dbOrErr
-      H.release c
+  pool <- P.acquire (3, 10, toS testDbConn)
 
- where
-  specs conn dbStructure = do
-    describe "Feature.AuthSpec" $ Feature.AuthSpec.spec dbStructure conn
-    describe "Feature.CorsSpec" $ Feature.CorsSpec.spec dbStructure conn
-    describe "Feature.DeleteSpec" $ Feature.DeleteSpec.spec dbStructure conn
-    describe "Feature.InsertSpec" $ Feature.InsertSpec.spec dbStructure conn
-    describe "Feature.QueryLimitedSpec" $ Feature.QueryLimitedSpec.spec dbStructure conn
-    describe "Feature.QuerySpec" $ Feature.QuerySpec.spec dbStructure conn
-    describe "Feature.RangeSpec" $ Feature.RangeSpec.spec dbStructure conn
-    describe "Feature.StructureSpec" $ Feature.StructureSpec.spec dbStructure conn
+  result <- P.use pool $ getDbStructure "test" =<< getPgVersion
+
+  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
+
+  hspec $ do
+    mapM_ (beforeAll_ reset . before withApp) specs
+
+    -- this test runs with a different server flag
+    beforeAll_ reset . before ltdApp $
+      describe "Feature.QueryLimitedSpec" Feature.QueryLimitedSpec.spec
+
+    -- this test runs with a different schema
+    beforeAll_ reset . before unicodeApp $
+      describe "Feature.UnicodeSpec" Feature.UnicodeSpec.spec
+
+    -- this test runs with a proxy
+    beforeAll_ reset . before proxyApp $
+      describe "Feature.ProxySpec" Feature.ProxySpec.spec
+
+    -- this test runs without a JWT secret
+    beforeAll_ reset . before noJwtApp $
+      describe "Feature.NoJwtSpec" Feature.NoJwtSpec.spec
+
+    -- this test runs with a binary JWT secret
+    beforeAll_ reset . before binaryJwtApp $
+      describe "Feature.BinaryJwtSecretSpec" Feature.BinaryJwtSecretSpec.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

@@ -1,90 +1,170 @@
 module SpecHelper where
 
-import Network.Wai
-import Test.Hspec
-
-import Data.String.Conversions (cs)
-import Data.Time.Clock.POSIX (getPOSIXTime)
 import Control.Monad (void)
 
-import Network.HTTP.Types.Header (Header, ByteRange, renderByteRange,
-                                  hRange, hAuthorization, hAccept)
-import Codec.Binary.Base64.String (encode)
+import qualified System.IO.Error as E
+import System.Environment (getEnv)
+
+import qualified Data.ByteString.Base64 as B64 (encode, decodeLenient)
 import Data.CaseInsensitive (CI(..))
+import qualified Data.Set as S
+import qualified Data.Map.Strict as M
+import Data.List (lookup)
 import Text.Regex.TDFA ((=~))
 import qualified Data.ByteString.Char8 as BS
-import System.Process (readProcess)
-import Web.JWT (secret)
+import qualified Data.ByteString.Lazy as BL
+import           System.Process (readProcess)
+import           Text.Heredoc
 
-import qualified Hasql.Connection  as H
-import qualified Hasql.Session     as H
-
-import PostgREST.App (app)
 import PostgREST.Config (AppConfig(..))
-import PostgREST.Middleware
-import PostgREST.Error(pgErrResponse)
-import PostgREST.Types
-import PostgREST.QueryBuilder (inTransaction, Isolation(..))
+import PostgREST.Types  (JSPathExp(..))
 
-dbString :: String
-dbString = "postgres://postgrest_test_authenticator@localhost:5432/postgrest_test"
+import Test.Hspec hiding (pendingWith)
+import Test.Hspec.Wai
 
-cfg :: String -> Maybe Integer -> AppConfig
-cfg conStr = AppConfig conStr "postgrest_test_anonymous" "test" 3000 (secret "safe") 10
+import Network.HTTP.Types
+import Network.Wai.Test (SResponse(simpleStatus, simpleHeaders, simpleBody))
 
-cfgDefault :: AppConfig
-cfgDefault = cfg dbString Nothing
+import Data.Maybe (fromJust)
+import Data.Aeson (decode, Value(..))
+import qualified JSONSchema.Draft4 as D4
 
-cfgLimitRows :: Integer -> AppConfig
-cfgLimitRows = cfg dbString . Just
+import Protolude
 
-withApp :: AppConfig -> DbStructure -> H.Connection
-        -> ActionWith Application -> IO ()
-withApp config dbStructure c perform =
-  perform $ defaultMiddle $ \req resp -> do
-    time <- getPOSIXTime
-    body <- strictRequestBody req
-    let handleReq = H.run $ inTransaction ReadCommitted
-          (runWithClaims config time (app dbStructure config body) req)
+matchContentTypeJson :: MatchHeader
+matchContentTypeJson = "Content-Type" <:> "application/json; charset=utf-8"
 
-    handleReq c >>= \case
-      Left err -> do
-        void $ H.run (H.sql "rollback;") c
-        resp $ pgErrResponse err
-      Right res -> resp res
+matchContentTypeSingular :: MatchHeader
+matchContentTypeSingular = "Content-Type" <:> "application/vnd.pgrst.object+json; charset=utf-8"
 
-setupDb :: IO ()
-setupDb = do
-  void $ readProcess "psql" ["-d", "postgres", "-a", "-f", "test/fixtures/database.sql"] []
-  loadFixture "roles"
-  loadFixture "schema"
-  loadFixture "privileges"
-  resetDb
+validateOpenApiResponse :: [Header] -> WaiSession ()
+validateOpenApiResponse headers = do
+  r <- request methodGet "/" headers ""
+  liftIO $
+    let respStatus = simpleStatus r in
+    respStatus `shouldSatisfy`
+      \s -> s == Status { statusCode = 200, statusMessage="OK" }
+  liftIO $
+    let respHeaders = simpleHeaders r in
+    respHeaders `shouldSatisfy`
+      \hs -> ("Content-Type", "application/openapi+json; charset=utf-8") `elem` hs
+  liftIO $
+    let respBody = simpleBody r
+        schema :: D4.Schema
+        schema = D4.emptySchema { D4._schemaRef = Just "openapi.json" }
+        schemaContext :: D4.SchemaWithURI D4.Schema
+        schemaContext = D4.SchemaWithURI
+          { D4._swSchema = schema
+          , D4._swURI    = Just "test/fixtures/openapi.json"
+          }
+       in
+       D4.fetchFilesystemAndValidate schemaContext ((fromJust . decode) respBody) `shouldReturn` Right ()
 
-resetDb :: IO ()
-resetDb = loadFixture "data"
+getEnvVarWithDefault :: Text -> Text -> IO Text
+getEnvVarWithDefault var def = do
+  varValue <- getEnv (toS var) `E.catchIOError` const (return $ toS def)
+  return $ toS varValue
 
-loadFixture :: FilePath -> IO()
-loadFixture name =
-  void $ readProcess "psql" ["-U", "postgrest_test", "-d", "postgrest_test", "-a", "-f", "test/fixtures/" ++ name ++ ".sql"] []
+_baseCfg :: AppConfig
+_baseCfg =  -- Connection Settings
+  AppConfig mempty "postgrest_test_anonymous" Nothing "test" "localhost" 3000
+            -- Jwt settings
+            (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 }
+
+testCfgNoJWT :: Text -> AppConfig
+testCfgNoJWT testDbConn = (testCfg testDbConn) { configJwtSecret = Nothing }
+
+testUnicodeCfg :: Text -> AppConfig
+testUnicodeCfg testDbConn = (testCfg testDbConn) { configSchema = "تست" }
+
+testLtdRowsCfg :: Text -> AppConfig
+testLtdRowsCfg testDbConn = (testCfg testDbConn) { configMaxRows = Just 2 }
+
+testProxyCfg :: Text -> AppConfig
+testProxyCfg testDbConn = (testCfg testDbConn) { configProxyUri = Just "https://postgrest.com/openapi.json" }
+
+testCfgBinaryJWT :: Text -> AppConfig
+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
+  loadFixture dbConn "database"
+  loadFixture dbConn "roles"
+  loadFixture dbConn "schema"
+  loadFixture dbConn "jwt"
+  loadFixture dbConn "privileges"
+  resetDb dbConn
+
+resetDb :: Text -> IO ()
+resetDb dbConn = loadFixture dbConn "data"
+
+loadFixture :: Text -> FilePath -> IO()
+loadFixture dbConn name =
+  void $ readProcess "psql" [toS dbConn, "-a", "-f", "test/fixtures/" ++ name ++ ".sql"] []
 
 rangeHdrs :: ByteRange -> [Header]
 rangeHdrs r = [rangeUnit, (hRange, renderByteRange r)]
 
+rangeHdrsWithCount :: ByteRange -> [Header]
+rangeHdrsWithCount r = ("Prefer", "count=exact") : rangeHdrs r
+
 acceptHdrs :: BS.ByteString -> [Header]
 acceptHdrs mime = [(hAccept, mime)]
 
 rangeUnit :: Header
 rangeUnit = ("Range-Unit" :: CI BS.ByteString, "items")
 
-matchHeader :: CI BS.ByteString -> String -> [Header] -> Bool
+matchHeader :: CI BS.ByteString -> BS.ByteString -> [Header] -> Bool
 matchHeader name valRegex headers =
   maybe False (=~ valRegex) $ lookup name headers
 
-authHeaderBasic :: String -> String -> Header
+authHeaderBasic :: BS.ByteString -> BS.ByteString -> Header
 authHeaderBasic u p =
-  (hAuthorization, cs $ "Basic " ++ encode (u ++ ":" ++ p))
+  (hAuthorization, "Basic " <> (toS . B64.encode . toS $ u <> ":" <> p))
 
-authHeaderJWT :: String -> Header
+authHeaderJWT :: BS.ByteString -> Header
 authHeaderJWT token =
-  (hAuthorization, cs $ "Bearer " ++ token)
+  (hAuthorization, "Bearer " <> token)
+
+-- | Tests whether the text can be parsed as a json object comtaining
+-- the key "message", and optional keys "details", "hint", "code",
+-- and no extraneous keys
+isErrorFormat :: BL.ByteString -> Bool
+isErrorFormat s =
+  "message" `S.member` keys &&
+    S.null (S.difference keys validKeys)
+ where
+  obj = decode s :: Maybe (M.Map Text Value)
+  keys = fromMaybe S.empty (M.keysSet <$> obj)
+  validKeys = S.fromList ["message", "details", "hint", "code"]

test/TestTypes.hs

@@ -1,23 +1,18 @@
 module TestTypes (
   IncPK(..)
 , CompoundPK(..)
--- , incFromList
--- , compoundFromList
 ) where
 
 import qualified Data.Aeson as JSON
 import Data.Aeson ((.:))
--- import Data.Maybe (fromJust)
-import Control.Applicative
-import Control.Monad (mzero)
 
-import Prelude
+import Protolude
 
 data IncPK = IncPK {
   incId :: Int
-, incNullableStr :: Maybe String
-, incStr :: String
-, incInsert :: String
+, incNullableStr :: Maybe Text
+, incStr :: Text
+, incInsert :: Text
 } deriving (Eq, Show)
 
 instance JSON.FromJSON IncPK where
@@ -28,18 +23,11 @@ instance JSON.FromJSON IncPK where
     r .: "inserted_at"
   parseJSON _ = mzero
 
--- incFromList :: [(String, SqlValue)] -> IncPK
--- incFromList row = IncPK
---   (fromSql . fromJust $ lookup "id" row)
---   (fromSql . fromJust $ lookup "nullable_string" row)
---   (fromSql . fromJust $ lookup "non_nullable_string" row)
---   (fromSql . fromJust $ lookup "inserted_at" row)
-
 data CompoundPK = CompoundPK {
   compoundK1 :: Int
-, compoundK2 :: Int
+, compoundK2 :: Text
 , compoundExtra :: Maybe Int
-}
+} deriving (Eq, Show)
 
 instance JSON.FromJSON CompoundPK where
   parseJSON (JSON.Object r) = CompoundPK <$>
@@ -47,9 +35,3 @@ instance JSON.FromJSON CompoundPK where
     r .: "k2" <*>
     r .: "extra"
   parseJSON _ = mzero
-
--- compoundFromList :: [(String, SqlValue)] -> CompoundPK
--- compoundFromList row = CompoundPK
---   (fromSql . fromJust $ lookup "k1" row)
---   (fromSql . fromJust $ lookup "k2" row)
---   (fromSql . fromJust $ lookup "extra" row)

test/create_test_db

@@ -0,0 +1,60 @@
+#! /usr/bin/env bash
+if [ -z "$1" ]
+  then
+    echo "Please supply the connection uri for the user with create database privileges"
+    exit -1
+fi
+
+if [ -z "$2" ]
+  then
+    echo "Please supply the test database name"
+    exit -1
+fi
+if [[ $1 != postgres://* ]]
+then
+  echo "Please use a valid connection URI (https://www.postgresql.org/docs/current/static/libpq-connect.html#AEN45347)"
+  exit -1
+fi
+
+BASEPATH=$( cd $(dirname $0) ; pwd -P )
+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
+# Specify the username of choice, or let the script create a random unique user by appending the database name
+TEST_USER_NAME=postgrest_test_authenticator
+# New password will get assigned only if the user does not already exist
+# Otherwise make sure to provide the correct password for the existing user
+TEST_USER_PASS=$(cat /dev/urandom | env LC_CTYPE=C tr -dc 'a-zA-Z0-9' | fold -w 16 | head -n 1)
+
+PGOPTIONS='-c client_min_messages=WARNING' psql "$URI" -Xq >/dev/null -c 'select rolcreatedb from pg_authid where rolname = current_user;' 2>/dev/null
+if [ $? -ne 0 ]; then
+  echo "ERROR: Please specify the user with 'Create DB' permissions, and ensure that the default database for the username exists."
+  exit 1
+fi
+
+# plpgsql does not like psql variables, easier to pull this part off with bash variables
+PGOPTIONS='-c client_min_messages=WARNING' psql "$URI" -Xq >/dev/null <<EOF
+SELECT pg_terminate_backend(pg_stat_activity.pid)
+FROM pg_stat_activity
+WHERE pg_stat_activity.datname = '$DB'
+  AND pid <> pg_backend_pid();
+
+DROP DATABASE IF EXISTS $DB;
+DROP ROLE IF EXISTS $TEST_USER_NAME;
+CREATE USER $TEST_USER_NAME WITH SUPERUSER LOGIN NOINHERIT PASSWORD '$TEST_USER_PASS' CREATEROLE;
+CREATE DATABASE $DB OWNER $TEST_USER_NAME;
+\\connect $DB
+ALTER SCHEMA public OWNER TO $TEST_USER_NAME;
+EOF
+
+#Remove database path from the connection uri--prevents setting up the new database name with PGDATABASE
+URI=$(echo $URI | cut -d'/' -f1-3)
+
+PGDATABASE=$DB PGOPTIONS='-c client_min_messages=WARNING' psql "$URI" --set=db=$DB -Xq <<EOF
+  CREATE EXTENSION IF NOT EXISTS pgcrypto;
+  ALTER DATABASE ${DB} SET request.jwt.claim.id = '-1';
+EOF
+
+# Create a new connection string to use with the test runner
+echo 'postgres://'${TEST_USER_NAME}':'$TEST_USER_PASS'@'$HOST_PORT'/'$DB

test/destroy_test_db

@@ -0,0 +1,65 @@
+#! /usr/bin/env bash
+if [ -z "$1" ]
+  then
+    echo "Please supply the connection uri for the user with create database privileges"
+    exit -1
+fi
+
+if [ -z "$2" ]
+  then
+    echo "Please supply the test database name"
+    exit -1
+fi
+if [[ $1 != postgres://* ]]
+then
+  echo "Please use a valid connection URI (https://www.postgresql.org/docs/current/static/libpq-connect.html#AEN45347)"
+  exit -1
+fi
+
+BASEPATH=$( cd $(dirname $0) ; pwd -P )
+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
+if [ $? -ne 0 ]; then
+  echo "ERROR: Please specify the user with 'Create DB' permissions, and ensure that the default database for the username exists."
+  exit 1
+fi
+
+# plpgsql does not like psql variables, easier to pull this part off with bash variables
+PGOPTIONS='-c client_min_messages=WARNING' psql "$URI" -Xq >/dev/null <<EOF
+SELECT pg_terminate_backend(pg_stat_activity.pid)
+FROM pg_stat_activity
+WHERE pg_stat_activity.datname = '$DB'
+  AND pid <> pg_backend_pid();
+
+drop database if exists "$DB";
+
+-- Find all test users that were members of role 'postgrest_test_author'--that way we don't have to know the 
+-- test user name (in case it was auto-generated).
+DO \$\$
+DECLARE
+    mem text;
+BEGIN
+    FOR mem IN 
+      SELECT pg_get_userbyid(member)
+      FROM pg_roles r 
+      JOIN pg_auth_members m
+      ON m.roleid = r.oid 
+      WHERE rolname = 'postgrest_test_author' 
+    LOOP
+      EXECUTE 'drop role '|| mem || ';';
+    END LOOP;
+END \$\$;
+
+DO \$\$
+DECLARE
+    r text;
+BEGIN
+    FOR r IN 
+      VALUES('postgrest_test_author'),('postgrest_test_anonymous'),('postgrest_test_default_role')
+    LOOP    
+      EXECUTE 'drop role if exists '|| r || ';';
+    END LOOP;
+END \$\$;
+EOF