Bump to version v7.0.1

Prefer the linux static binary for x64

.circleci/config.yml

@@ -0,0 +1,446 @@
+version: 2
+
+jobs:
+  build-cache:
+    docker:
+      - image: circleci/buildpack-deps:trusty
+    steps:
+      - checkout
+      - restore_cache:
+          keys:
+          - v1-stack-dependencies-{{ checksum "postgrest.cabal" }}-{{ checksum "stack.yaml" }}
+      - run:
+          name: install stack & dependencies
+          command: |
+            curl -L https://github.com/commercialhaskell/stack/releases/download/v2.1.3/stack-2.1.3-linux-x86_64.tar.gz | tar zx -C /tmp
+            sudo mv /tmp/stack-2.1.3-linux-x86_64/stack /usr/bin
+            sudo apt-get update
+            sudo apt-get install -y libgmp-dev
+            sudo apt-get install -y --only-upgrade binutils
+            sudo apt-get install -y postgresql-client
+            stack setup
+      - run:
+          name: build src and tests dependencies
+          command: |
+            stack build --fast -j1 --only-dependencies
+            stack build --fast --test --no-run-tests --only-dependencies
+      - save_cache:
+          paths:
+            - "~/.stack"
+            - ".stack-work"
+          key: v1-stack-dependencies-{{ checksum "postgrest.cabal" }}-{{ checksum "stack.yaml" }}
+      - run:
+          name: build src and tests
+          command: |
+            stack build --fast -j1
+            stack build --fast --test --no-run-tests
+
+  style:
+    docker:
+      - image: nixos/nix:2.3
+    steps:
+      - checkout
+      - run:
+          name: Install linting and styling scripts
+          command: nix-env -f default.nix -iA lint style
+      - run:
+          name: Run linter
+          command: |
+            echo 'Note: For checking this locally, use `make lint`. Or, if using `nix`, run `nix-shell --run postgrest-lint`'
+            postgrest-lint
+      - run:
+          name: Run style check
+          command: |
+            echo 'Note: For checking this locally, use `make style`. Or, if using `nix`, run `nix-shell --run postgrest-style`'
+            postgrest-style-check
+
+  build-test-9.4:
+    docker:
+      - image: circleci/buildpack-deps:trusty
+        environment:
+          - PGHOST=localhost
+      - image: circleci/postgres:9.4.26
+        environment:
+          - POSTGRES_USER=circleci
+          - POSTGRES_DB=circleci
+          - POSTGRES_HOST_AUTH_METHOD=trust
+    steps:
+      - checkout
+      - restore_cache:
+          keys:
+          - v1-stack-dependencies-{{ checksum "postgrest.cabal" }}-{{ checksum "stack.yaml" }}
+      - run:
+          name: install ncat
+          command: |
+            # utility needed to test socket connection with curl <  7.40
+            sudo apt-get install nmap
+      - run:
+          name: install stack & dependencies
+          command: |
+            curl -L https://github.com/commercialhaskell/stack/releases/download/v2.1.3/stack-2.1.3-linux-x86_64.tar.gz | tar zx -C /tmp
+            sudo mv /tmp/stack-2.1.3-linux-x86_64/stack /usr/bin
+            sudo apt-get update
+            sudo apt-get install -y libgmp-dev
+            sudo apt-get install -y --only-upgrade binutils
+            sudo apt-get install -y postgresql-client
+            stack setup
+      - run:
+          name: build src and tests dependencies
+          command: |
+            stack build --fast -j1 --only-dependencies
+            stack build --fast --test --no-run-tests --only-dependencies
+      - 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
+
+  build-test-9.6:
+    docker:
+      - image: circleci/buildpack-deps:trusty
+        environment:
+          - PGHOST=localhost
+      - image: circleci/postgres:9.6.17
+        environment:
+          - POSTGRES_USER=circleci
+          - POSTGRES_DB=circleci
+          - POSTGRES_HOST_AUTH_METHOD=trust
+    steps:
+      - checkout
+      - restore_cache:
+          keys:
+          - v1-stack-dependencies-{{ checksum "postgrest.cabal" }}-{{ checksum "stack.yaml" }}
+      - run:
+          name: install stack & dependencies
+          command: |
+            curl -L https://github.com/commercialhaskell/stack/releases/download/v2.1.3/stack-2.1.3-linux-x86_64.tar.gz | tar zx -C /tmp
+            sudo mv /tmp/stack-2.1.3-linux-x86_64/stack /usr/bin
+            sudo apt-get update
+            sudo apt-get install -y libgmp-dev
+            sudo apt-get install -y postgresql-client
+            stack setup
+      - run:
+          name: build src and tests
+          command: |
+            stack build --fast -j1
+            stack build --fast --test --no-run-tests
+      - run:
+          name: run tests
+          command: POSTGREST_TEST_CONNECTION=$(test/create_test_db "postgres://circleci@localhost" postgrest_test) stack test postgrest:spec
+
+  build-test-10:
+    docker:
+      - image: circleci/buildpack-deps:trusty
+        environment:
+          - PGHOST=localhost
+      - image: circleci/postgres:10.12
+        environment:
+          - POSTGRES_USER=circleci
+          - POSTGRES_DB=circleci
+          - POSTGRES_HOST_AUTH_METHOD=trust
+    steps:
+      - checkout
+      - restore_cache:
+          keys:
+          - v1-stack-dependencies-{{ checksum "postgrest.cabal" }}-{{ checksum "stack.yaml" }}
+      - run:
+          name: install stack & dependencies
+          command: |
+            curl -L https://github.com/commercialhaskell/stack/releases/download/v2.1.3/stack-2.1.3-linux-x86_64.tar.gz | tar zx -C /tmp
+            sudo mv /tmp/stack-2.1.3-linux-x86_64/stack /usr/bin
+            sudo apt-get update
+            sudo apt-get install -y libgmp-dev
+            sudo apt-get install -y postgresql-client
+            stack setup
+      - run:
+          name: build src and tests
+          command: |
+            stack build --fast -j1
+            stack build --fast --test --no-run-tests
+      - run:
+          name: run tests
+          command: POSTGREST_TEST_CONNECTION=$(test/create_test_db "postgres://circleci@localhost" postgrest_test) stack test postgrest:spec
+
+  build-test-11:
+    docker:
+      - image: circleci/buildpack-deps:trusty
+        environment:
+          - PGHOST=localhost
+      - image: circleci/postgres:11.7
+        environment:
+          - POSTGRES_USER=circleci
+          - POSTGRES_DB=circleci
+          - POSTGRES_HOST_AUTH_METHOD=trust
+    steps:
+      - checkout
+      - restore_cache:
+          keys:
+          - v1-stack-dependencies-{{ checksum "postgrest.cabal" }}-{{ checksum "stack.yaml" }}
+      - run:
+          name: install stack & dependencies
+          command: |
+            curl -L https://github.com/commercialhaskell/stack/releases/download/v2.1.3/stack-2.1.3-linux-x86_64.tar.gz | tar zx -C /tmp
+            sudo mv /tmp/stack-2.1.3-linux-x86_64/stack /usr/bin
+            sudo apt-get update
+            sudo apt-get install -y libgmp-dev
+            sudo apt-get install -y postgresql-client
+            stack setup
+      - run:
+          name: build src and tests
+          command: |
+            stack build --fast -j1
+            stack build --fast --test --no-run-tests
+      - run:
+          name: run tests
+          command: POSTGREST_TEST_CONNECTION=$(test/create_test_db "postgres://circleci@localhost" postgrest_test) stack test postgrest:spec
+
+  build-test-12:
+    docker:
+      - image: circleci/buildpack-deps:trusty
+        environment:
+          - PGHOST=localhost
+      - image: circleci/postgres:12.2
+        environment:
+          - POSTGRES_USER=circleci
+          - POSTGRES_DB=circleci
+          - POSTGRES_HOST_AUTH_METHOD=trust
+    steps:
+      - checkout
+      - restore_cache:
+          keys:
+          - v1-stack-dependencies-{{ checksum "postgrest.cabal" }}-{{ checksum "stack.yaml" }}
+      - run:
+          name: install stack & dependencies
+          command: |
+            curl -L https://github.com/commercialhaskell/stack/releases/download/v2.1.3/stack-2.1.3-linux-x86_64.tar.gz | tar zx -C /tmp
+            sudo mv /tmp/stack-2.1.3-linux-x86_64/stack /usr/bin
+            sudo apt-get update
+            sudo apt-get install -y libgmp-dev
+            sudo apt-get install -y postgresql-client
+            stack setup
+      - run:
+          name: build src and tests
+          command: |
+            stack build --fast -j1
+            stack build --fast --test --no-run-tests
+      - run:
+          name: run tests
+          command: POSTGREST_TEST_CONNECTION=$(test/create_test_db "postgres://circleci@localhost" postgrest_test) stack test postgrest:spec
+
+  build-prof-test:
+    docker:
+      - image: circleci/buildpack-deps:trusty
+        environment:
+          - PGHOST=localhost
+          - TERM=xterm
+      - image: circleci/postgres:9.6.17
+        environment:
+          - POSTGRES_USER=circleci
+          - POSTGRES_DB=circleci
+          - POSTGRES_HOST_AUTH_METHOD=trust
+    steps:
+      - checkout
+      - restore_cache:
+          keys:
+          - v1-stack-prof-dependencies-{{ checksum "postgrest.cabal" }}-{{ checksum "stack.yaml" }}
+      - run:
+          name: install stack & dependencies
+          command: |
+            curl -L https://github.com/commercialhaskell/stack/releases/download/v2.1.3/stack-2.1.3-linux-x86_64.tar.gz | tar zx -C /tmp
+            sudo mv /tmp/stack-2.1.3-linux-x86_64/stack /usr/bin
+            sudo apt-get update
+            sudo apt-get install -y libgmp-dev
+            sudo apt-get install -y postgresql-client
+            stack setup
+      - run:
+          name: build dependencies with profiling enabled
+          command: |
+            stack build --profile -j1  --only-dependencies
+      - save_cache:
+          paths:
+            - "~/.stack"
+            - ".stack-work"
+          key: v1-stack-prof-dependencies-{{ checksum "postgrest.cabal" }}-{{ checksum "stack.yaml" }}
+      - 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
+            test/memory-tests.sh
+
+  release:
+    docker:
+      - image: circleci/golang:1.9
+    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
+
+  build-nix:
+    machine: true
+    steps:
+      - checkout
+      - run:
+          name: Install Nix
+          command: |
+            curl -L https://nixos.org/nix/install | sh
+            echo "source $HOME/.nix-profile/etc/profile.d/nix.sh" >> $BASH_ENV
+      - run:
+          name: Install and use the Cachix binary cache
+          command: |
+            nix-env -iA cachix -f https://cachix.org/api/v1/install
+            cachix use postgrest
+      - run:
+          name: Build the dynamic PostgREST executable
+          command: |
+            # We build the dynamic postgrest executable first in order to fail fast if anything
+            # should be wrong with the source code.
+            nix-build -A postgrest
+      - restore_cache:
+          keys:
+            - v1-cabal-nix-dependencies-{{ checksum "postgrest.cabal" }}
+      - run:
+          name: Run the spec tests against all supported PostgreSQL versions
+          command: |
+            # Our utility scripts use cabal to run the tests, which will pick up all the libraries that
+            # are built with Nix. So this should only ever build the PostgREST itself and be reasonably
+            # quick. We accelerate that part further by caching `~/.cabal` and `dist-newstyle`.
+            nix-shell --run postgrest-test-spec-all
+      - save_cache:
+          paths:
+            - "~/.cabal"
+            - "dist-newstyle"
+          key: v1-cabal-nix-dependencies-{{ checksum "postgrest.cabal" }}
+      - run:
+          name: Build all derivations from default.nix and push results to Cachix
+          command: |
+            # Only push to the cache when CircleCI makes the CACHIX_SIGNING_KEY available (e.g. not for
+            # pull requests).
+            if [ -n "${CACHIX_SIGNING_KEY:-""}" ]; then
+              echo "Building and caching all derivations..."
+              nix-build | cachix push postgrest
+            else
+              echo "Building all derivations (caching skipped for outside pull requests)..."
+              nix-build
+            fi
+
+  build-static-bin:
+    machine: true
+    steps:
+      - checkout
+      - run:
+          name: Install Nix
+          command: |
+            curl -L https://nixos.org/nix/install | sh
+            echo "source $HOME/.nix-profile/etc/profile.d/nix.sh" >> $BASH_ENV
+      - run:
+          name: Install and use the Cachix binary cache
+          command: |
+            nix-env -iA cachix -f https://cachix.org/api/v1/install
+            cachix use postgrest
+      - run:
+          name: Build the PostgREST statically linked binary
+          command: |
+            nix-build -A postgrestStatic
+      - run:
+          name: compress binary
+          command: |
+            mkdir -p /tmp/workspace/bin
+            cd /tmp/workspace/bin
+            tar cvJf postgrest-$CIRCLE_TAG-linux-x64-static.tar.xz -C ~/project/result/bin postgrest
+      - persist_to_workspace:
+          root: /tmp/workspace
+          paths:
+            - bin/*
+
+workflows:
+  version: 2
+  build-test-release:
+    jobs:
+      - build-cache:
+          filters:
+            tags:
+              only: /v[0-9]+(\.[0-9]+)*/
+      - style:
+          filters:
+            tags:
+              only: /v[0-9]+(\.[0-9]+)*/
+      - build-test-9.4:
+          filters:
+            tags:
+              only: /v[0-9]+(\.[0-9]+)*/
+          requires:
+            - build-cache
+      - build-test-9.6:
+          filters:
+            tags:
+              only: /v[0-9]+(\.[0-9]+)*/
+          requires:
+            - build-cache
+      - build-test-10:
+          filters:
+            tags:
+              only: /v[0-9]+(\.[0-9]+)*/
+          requires:
+            - build-cache
+      - build-test-11:
+          filters:
+            tags:
+              only: /v[0-9]+(\.[0-9]+)*/
+          requires:
+            - build-cache
+      - build-test-12:
+          filters:
+            tags:
+              only: /v[0-9]+(\.[0-9]+)*/
+          requires:
+            - build-cache
+      - build-prof-test:
+          filters:
+            tags:
+              only: /v[0-9]+(\.[0-9]+)*/
+      - build-static-bin:
+          requires:
+            - build-nix
+            - build-prof-test
+          filters:
+            tags:
+              only: /v[0-9]+(\.[0-9]+)*/
+            branches:
+              ignore: /.*/
+      - release:
+          requires:
+            - build-static-bin
+          filters:
+            tags:
+              only: /v[0-9]+(\.[0-9]+)*/
+      - build-nix:
+          filters:
+            tags:
+              only: /v[0-9]+(\.[0-9]+)*/

.cirrus.yml

@@ -0,0 +1,55 @@
+freebsd_instance:
+  image: freebsd-12-1-release-amd64
+
+build_task:
+  env:
+    ASSUME_ALWAYS_YES: YES
+  install_script:
+    ## TODO: Some of these workaround steps might be unneeded now
+    ## gmake required, otherwise bsd make is used and some cryptic "No operator" errors are shown
+    - pkg install -y gmake
+    ## gcc required, otherwise warning: macro expansion producing 'defined' has undefined behavior [-Wexpansion-to-defined]
+    - pkg install -y gcc
+    - pkg install -y libiconv
+    - pkg install -y gmp
+    - pkg install -y postgresql95-client
+    - pkg install -y pkgconf
+    - pkg install -y ghc
+    - pkg install -y hs-cabal-install
+  cabal_cache:
+    folder: ~/.cabal
+    fingerprint_script: cat postgrest.cabal
+  build_script:
+    - cabal v2-update
+    - cabal v2-build
+  binaries_artifacts:
+    path: "dist-newstyle/build/x86_64-freebsd/ghc-8.6.5/postgrest-7.0.1/x/postgrest/build/postgrest/*"
+  #binary_script:
+    #- mkdir bin
+    ## cabal v2-install --installdir=.
+    ## the installdir option is not working on this cabal version(form hs-cabal-install), so the binary must be extrated from the path
+    ## this is too brittle so for now we don't use it
+    #- ldd /tmp/cirrus-ci-build/dist-newstyle/build/x86_64-freebsd/ghc-8.6.5/postgrest-7.0.1/x/postgrest/build/postgrest/postgrest
+    #- mv /tmp/cirrus-ci-build/dist-newstyle/build/x86_64-freebsd/ghc-8.6.5/postgrest-7.0.1/x/postgrest/build/postgrest/postgrest bin/
+  ## https://cirrus-ci.org/guide/writing-tasks/#artifacts-instruction
+  #binaries_artifacts:
+    #path: bin/
+  cleanup_script:
+    - rm -rf ~/.cabal/logs
+    - rm  ~/.cabal/config
+
+#publish_task:
+  #skip: $CIRRUS_TAG == ""
+  #env:
+    #TOKEN: ENCRYPTED[c99babbf04e8a33962ffbbc75bf20d3abe408f9bede5ed5d8956cd24da6fdb34266c920984cc43f8106ef3423fba0e98]
+  #depends_on:
+    #- build
+  #script:
+    ## https://cirrus-ci.org/guide/writing-tasks/#artifacts-instruction
+    #- wget https://api.cirrus-ci.com/v1/artifact/github/$CIRRUS_REPO_FULL_NAME/build/binaries/bin/postgrest
+    #- tar cjf postgrest-$CIRRUS_TAG-freebsd.tar.xz postgrest
+    ### The CIRRUS_RELEASE env var is not the same as the tag. It's an id for the release.
+    #- curl -X POST --data-binary @$NAME \
+      #-H "Authorization:token ${TOKEN}" \
+      #-H "Content-Type:application/octet-stream" \
+      #"https://uploads.github.com/repos/$CIRRUS_REPO_FULL_NAME/releases/${CIRRUS_RELEASE}/assets?name=${NAME}"

.gitattributes

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

.github/CONTRIBUTING.md

@@ -27,6 +27,14 @@ your contributions.
 * Provide steps to reproduce the issue, including your OS version and
   the specific database schema that you are using.
 
+* Please include SQL logs for issues involving runtime problems. To obtain logs first
+  [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 `SIGUSR1` signal](http://postgrest.org/en/v5.2/admin.html#schema-reloading) or restart it to ensure the schema cache
+  is not stale. This sometimes fixes apparent bugs.
+
 ## Code
 
 ### Haskell Conventions
@@ -34,22 +42,16 @@ your contributions.
 * All contributions must pass the tests before being merged. When
   you create a pull request your code will automatically be tested.
 
-* All code must also pass [hlint](http://community.haskell.org/~ndm/hlint/)
-  with no warnings. This helps enforce a uniform style for all
-  committers. Continuous integration will check this as well on every
-  pull request.
+* All code must also pass [hlint](http://community.haskell.org/~ndm/hlint/) and [stylish-haskell](https://github.com/jaspervdj/stylish-haskell)
+  with no warnings. This helps enforce a uniform style for all committers. Continuous integration will check this as well on every
+  pull request. There's a useful Makefile that helps with checking this locally. You can run `make commit-check` to do this manually but
+  we recommend adding it to `.git/hooks/pre-commit` to automatically check this before doing a commit.
 
 * For help building the Haskell code on your computer check out the [building from
-source](https://github.com/begriffs/postgrest/wiki/Building-from-source)
-wiki page.
+  source](https://postgrest.com/en/stable/install.html#build-from-source) docs section.
 
-## 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/FUNDING.yml

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

.github/ISSUE_TEMPLATE.md

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

.gitignore

@@ -6,6 +6,12 @@ cabal.sandbox.config
 hscope.out
 codex.tags
 .anvil
-.stack-work
+.stack-work*
 tags
 site
+*~
+*#*
+.#*
+*.swp
+result*
+dist-newstyle

.stylish-haskell.yaml

@@ -0,0 +1,225 @@
+# 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: group
+
+      # The following 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
+
+      # Right-pad the module names to align imports in a group:
+      #
+      # - true: a little more readable
+      #
+      #   > import qualified Data.List       as List (concat, foldl, foldr,
+      #   >                                           init, last, length)
+      #   > import qualified Data.List.Extra as List (concat, foldl, foldr,
+      #   >                                           init, last, length)
+      #
+      # - false: diff-safe
+      #
+      #   > import qualified Data.List as List (concat, foldl, foldr, init,
+      #   >                                     last, length)
+      #   > import qualified Data.List.Extra as List (concat, foldl, foldr,
+      #   >                                           init, last, length)
+      #
+      # Default: true
+      pad_module_names: true
+
+      # Long list align style takes effect when import is too long. This is
+      # determined by 'columns' setting.
+      #
+      # - 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 constructor 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 formatting 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
+
+      # Space surround option affects formatting of import lists on a single
+      # line. The only difference is single space after the initial
+      # parenthesis and a single space before the terminal parenthesis.
+      #
+      # - true: There is single space associated with the enclosing
+      #   parenthesis.
+      #
+      #   > import Data.Foo ( foo )
+      #
+      # - false: There is no space associated with the enclosing parenthesis
+      #
+      #   > import Data.Foo (foo)
+      #
+      # Default: false
+      space_surround: false
+
+  # Language pragmas
+  - language_pragmas:
+      # We can generate different styles of language pragma lists.
+      #
+      # - 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 column.
+      #
+      # - 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,70 @@
+## Travis is only used for building an OSX binary ,
+## no tests are run here.
+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:
+## Building the whole project can take longer than 50 minutes. Since Travis has a global timeout of 50 minutes
+## we compile for 30 minutes tops(`gtimeout 1800`) and quit compiling with no error.
+## Since we CACHE the compile results we can continue compiling from where we left off
+## on the next commit.
+- gtimeout 1800 stack build --no-terminal --only-snapshot --install-ghc || true
+- |
+  if test ! "$TRAVIS_TAG"
+  then
+    echo 'No tag pushed. Skip building binary.'
+  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,63 @@
+# Sponsors & Backers
+
+PostgREST ongoing development is only possible thanks to our Sponsors and Backers, listed below. If you'd like to join them, you can do so by supporting the PostgREST organization on [Patreon](https://www.patreon.com/postgrest).
+
+## Sponsors
+
+<table>
+  <tbody>
+    <tr>
+      <td align="center" valign="middle">
+        <a href="https://www.cybertec-postgresql.com/en/" target="_blank">
+          <img width="222px" src="static/cybertec.png">
+        </a>
+      </td>
+      <td align="center" valign="middle">
+        <a href="https://www.2ndquadrant.com/en/?utm_campaign=External%20Websites&utm_source=PostgREST&utm_medium=Logo" target="_blank">
+          <img width="222px" src="static/2ndquadrant.png">
+        </a>
+      </td>
+      <td align="center" valign="middle">
+        <a href="https://tryretool.com/?utm_source=sponsor&utm_campaign=postgrest" target="_blank">
+          <img width="222px" src="static/retool.png">
+        </a>
+      </td>
+    </tr>
+  </tbody>
+</table>
+
+## Lead Backers
+
+- [Daniel Babiak](https://github.com/d-babiak)
+- Evans Fernandes
+- [Jan Sommer](https://github.com/nerfpops)
+
+## Backers
+
+- Tsingson Qin
+- Michel Pelletier
+- Jay Hannah
+- Robert Stolarz
+- Kofi Gumbs
+- Nicholas DiBiase
+- Christopher Reid
+- Nathan Bouscal
+- Daniel Rafaj
+- David Fenko
+- Remo Rechkemmer
+
+## Former Backers
+
+<table>
+  <tbody>
+    <tr>
+      <td align="center" valign="middle">
+        <a href="https://www.timescale.com?utm_campaign=postgrest&utm_source=sponsor&utm_medium=referral&utm_content=github" target="_blank">
+          <img width="222px" src="static/timescaledb.png">
+        </a>
+      </td>
+    </tr>
+  </tbody>
+</table>
+
+- [Christiaan Westerbeek](https://devotis.nl)

CHANGELOG.md

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

LICENSE

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

Makefile

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

README.md

@@ -1,55 +1,64 @@
-![Logo](static/logo.png "Logo")
+![Logo](static/bigger-logo.png "Logo")
 
-[![Build Status](https://circleci.com/gh/begriffs/postgrest.png?style=shield&circle-token=f723c01686abf0364de1e2eaae5aff1f68bd3ff2)](https://circleci.com/gh/begriffs/postgrest/tree/master)
-<a href="https://heroku.com/deploy?template=https://github.com/begriffs/postgrest">
+[![Donate](https://img.shields.io/badge/Donate-Patreon-orange.svg?colorB=F96854)](https://www.patreon.com/postgrest)
+[![Donate](https://img.shields.io/badge/Donate-PayPal-green.svg)](https://www.paypal.me/postgrest)
+<a href="https://heroku.com/deploy?template=https://github.com/PostgREST/postgrest">
   <img src="https://img.shields.io/badge/%E2%86%91_Deploy_to-Heroku-7056bf.svg" alt="Deploy">
 </a>
 [![Join the chat at https://gitter.im/begriffs/postgrest](https://img.shields.io/badge/gitter-join%20chat%20%E2%86%92-brightgreen.svg)](https://gitter.im/begriffs/postgrest)
+[![Docs](https://img.shields.io/badge/docs-latest-brightgreen.svg?style=flat)](http://postgrest.org)
+[![Docker Stars](https://img.shields.io/docker/pulls/postgrest/postgrest.svg)](https://hub.docker.com/r/postgrest/postgrest/)
+[![Build Status](https://circleci.com/gh/PostgREST/postgrest/tree/master.svg?style=shield)](https://circleci.com/gh/PostgREST/postgrest/tree/master)
+[![Hackage docs](https://img.shields.io/hackage/v/postgrest.svg?label=hackage)](http://hackage.haskell.org/package/postgrest)
 
 PostgREST serves a fully RESTful API from any existing PostgreSQL
 database. It provides a cleaner, more standards-compliant, faster
 API than you are likely to write from scratch.
 
-### 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)
+## Sponsors
 
+<table>
+  <tbody>
+    <tr>
+      <td align="center" valign="middle">
+        <a href="https://www.cybertec-postgresql.com/en/" target="_blank">
+          <img width="222px" src="static/cybertec.png">
+        </a>
+      </td>
+      <td align="center" valign="middle">
+        <a href="https://www.2ndquadrant.com/en/?utm_campaign=External%20Websites&utm_source=PostgREST&utm_medium=Logo" target="_blank">
+          <img width="222px" src="static/2ndquadrant.png">
+        </a>
+      </td>
+      <td align="center" valign="middle">
+        <a href="https://tryretool.com/?utm_source=sponsor&utm_campaign=postgrest" target="_blank">
+          <img width="222px" src="static/retool.png">
+        </a>
+      </td>
+    </tr>
+  </tbody>
+</table>
 
-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.
+Big thanks to our sponsors! You can join them by supporting PostgREST on [Patreon](https://www.patreon.com/postgrest).
 
-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
 
-### 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
     ```
+## [Documentation](http://postgrest.org)
 
-For more information on valid connection strings see the
-[PostgreSQL docs](http://www.postgresql.org/docs/9.4/static/libpq-connect.html#LIBPQ-CONNSTRING).
+Latest documentation is at [postgrest.org](http://postgrest.org). You can contribute to the docs in [PostgREST/postgrest-docs](https://github.com/PostgREST/postgrest-docs).
 
-### Performance
+## 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, 
+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 +77,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.
+## Security
 
-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,36 +102,27 @@ 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
+## 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-documention
+## 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 commicate 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
+## Data Integrity
 
 Rather than relying on an Object Relational Mapper and custom
 imperative coding, this system requires you put declarative constraints
@@ -141,31 +130,28 @@ 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/).
+and the [API guide](http://postgrest.org/en/stable/api.html).
 
-### Future Features
+## Supporting development
 
-* 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)
+You can help PostgREST ongoing maintenance and development by:
 
-### Thanks
+- Making a regular donation through Patreon https://www.patreon.com/postgrest
 
-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).
+- Alternatively, you can make a one-time donation via Paypal https://www.paypal.me/postgrest
+
+Every donation will be spent on making PostgREST better for the whole community.
+
+## Thanks
+
+The PostgREST organization is grateful to:
+
+- The project [sponsors and backers](https://github.com/PostgREST/postgrest/blob/master/BACKERS.md) who support PostgREST's development.
+- The project [contributors](https://github.com/PostgREST/postgrest/graphs/contributors) who have improved PostgREST immensely with their code
+  and good judgement. See more details in the [changelog](https://github.com/PostgREST/postgrest/blob/master/CHANGELOG.md).
 
 The cool logo came from [Mikey Casalaina](https://github.com/casalaina).

app.json

@@ -1,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.0"
+      "value": "7.0.1"
     },
-    "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
     },
-    "V1SCHEMA": {
-      "description": "DB schema selected whe no version (or version 1) requested",
+    "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,36 @@
+## AppVeyor is only used for building a Windows binary, no tests are run here.
+platform: x64
+image: Visual Studio 2015
+
+cache:
+- "c:\\sr"
+- .stack-work
+- "c:\\Users\\appveyor\\AppData\\Local\\Programs\\stack"
+
+environment:
+  global:
+    STACK_ROOT: "c:\\sr"
+    GOPATH: c:\gopath
+    TMP: "c:\\tmp"
+
+test: off
+
+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
+# Appveyor has a timeout of 60 mins, building can take longer, limit the time and make sure this succeeds,
+# previous work will get cached and finish on next commit
+- bash -lc "timeout 2700 'C:\projects\postgrest\stack.exe' build -j1 --copy-bins --local-bin-path . || true"
+
+artifacts:
+- path: postgrest.exe
+
+deploy_script:
+- IF DEFINED APPVEYOR_REPO_TAG_NAME 7z a -tzip postgrest-%APPVEYOR_REPO_TAG_NAME%-windows-x64.zip postgrest.exe
+- IF DEFINED APPVEYOR_REPO_TAG_NAME bash -lc " exec 0</dev/null && cd $APPVEYOR_BUILD_FOLDER && ghr -t $GITHUB_TOKEN -u $APPVEYOR_ACCOUNT_NAME -r $APPVEYOR_PROJECT_NAME -b \"$(sed -n \"1,/$(echo $APPVEYOR_REPO_TAG_NAME | cut -c2-)/d;/## \[/q;p\" CHANGELOG.md)\" --replace $APPVEYOR_REPO_TAG_NAME postgrest-$APPVEYOR_REPO_TAG_NAME-windows-x64.zip"

circle.yml

@@ -1,16 +0,0 @@
-machine:
-  pre:
-    - createuser --superuser --no-password postgrest_test
-    - createdb -O postgrest_test -U ubuntu postgrest_test
-  ghc:
-    version: 7.10.1
-dependencies:
-  override:
-    - cabal update
-    - cabal sandbox init
-    - cabal install --upgrade-dependencies --constraint="template-haskell installed" --dependencies-only --enable-tests
-    - cabal configure --enable-tests -f ci
-test:
-  post:
-    - cabal exec hlint -- -X QuasiQuotes src/**/*.hs test/**/*.hs
-    - cabal exec packdeps postgrest.cabal

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

default.nix

@@ -0,0 +1,109 @@
+let
+  name =
+    "postgrest";
+
+  compiler =
+    "ghc883";
+
+  # PostgREST source files, filtered based on the rules in the .gitignore files
+  # and file extensions. We want to include as litte as possible, as the files
+  # added here will increase the space used in the Nix store and trigger the
+  # build of new Nix derivations when changed.
+  src =
+    pkgs.lib.sourceFilesBySuffices
+      (pkgs.gitignoreSource ./.)
+      [ ".cabal" ".hs" ".lhs" "LICENSE" ];
+
+  # Commit of the Nixpkgs repository that we want to use.
+  nixpkgsVersion =
+    import nix/nixpkgs-version.nix;
+
+  # Nix files that describe the Nixpkgs repository. We evaluate the expression
+  # using `import` below.
+  nixpkgs =
+    builtins.fetchTarball {
+      url = "https://github.com/nixos/nixpkgs/archive/${nixpkgsVersion.rev}.tar.gz";
+      sha256 = nixpkgsVersion.tarballHash;
+    };
+
+  overlays =
+    [
+      (import nix/overlays/postgresql-legacy.nix)
+      (import nix/overlays/gitignore.nix)
+      (import nix/overlays/haskell-packages)
+    ];
+
+  # Evaluated expression of the Nixpkgs repository.
+  pkgs =
+    import nixpkgs { inherit overlays; };
+
+  postgresqlVersions =
+    [
+      pkgs.postgresql_12
+      pkgs.postgresql_11
+      pkgs.postgresql_10
+      pkgs.postgresql_9_6
+      pkgs.postgresql_9_5
+      pkgs.postgresql_9_4
+    ];
+
+  patches =
+    pkgs.callPackage nix/patches {};
+
+  # Base dynamic derivation for the PostgREST package.
+  drv =
+    pkgs.haskellPackages.callCabal2nix name src {};
+
+  # Static derivation for the PostgREST executable.
+  drvStatic =
+    import nix/static { inherit nixpkgs name src compiler patches; };
+
+  lib =
+    pkgs.haskell.lib;
+in
+rec {
+  inherit nixpkgs pkgs;
+
+  # Derivation for the PostgREST Haskell package, including the executable,
+  # libraries and documentation. We disable running the test suite on Nix
+  # builds, as they require a database to be set up.
+  postgrestWithLib =
+    lib.dontCheck drv;
+
+  # Derivation for just the PostgREST binary, where we strip all dynamic
+  # libraries and documentation, leaving only the executable. Note that the
+  # executable is static with regards to Haskell libraries, but not system
+  # libraries like glibc and libpq.
+  postgrest =
+    lib.justStaticExecutables postgrestWithLib;
+
+  # Static executable.
+  postgrestStatic =
+    lib.justStaticExecutables (lib.dontCheck drvStatic);
+
+  # Docker image and loading script.
+  docker =
+    pkgs.callPackage nix/docker { postgrest = postgrestStatic; };
+
+  # Environment in which PostgREST can be built with cabal, useful e.g. for
+  # defining a shell for nix-shell.
+  env =
+    drv.env;
+
+  # Utility for updating the pinned version of Nixpkgs.
+  nixpkgsUpgrade =
+    pkgs.callPackage nix/nixpkgs-upgrade.nix {};
+
+  tests =
+    pkgs.callPackage nix/tests.nix
+      {
+        inherit postgresqlVersions;
+        postgrestBuildEnv = env;
+      };
+
+  style =
+    pkgs.callPackage nix/style.nix {};
+
+  lint =
+    pkgs.callPackage nix/lint.nix {};
+}

docker/Dockerfile

@@ -0,0 +1,57 @@
+# To build use:
+# docker build --build-arg POSTGREST_VERSION=<v5.2.0 or another version> -t postgrest ./docker/
+
+FROM debian:buster-slim
+
+ARG POSTGREST_VERSION
+
+# 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_DB_EXTRA_SEARCH_PATH=public \
+    PGRST_SERVER_HOST=*4 \
+    PGRST_SERVER_PORT=3000 \
+    PGRST_OPENAPI_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" \
+    PGRST_ROOT_SPEC= \
+    PGRST_RAW_MEDIA_TYPES=
+
+RUN groupadd -g 1000 postgrest && \
+    useradd -r -u 1000 -g postgrest postgrest && \
+    chown postgrest:postgrest /etc/postgrest.conf
+
+USER 1000
+
+# PostgREST reads /etc/postgrest.conf so map the configuration
+# file in when you run this container
+CMD exec postgrest /etc/postgrest.conf
+
+EXPOSE 3000

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/10/redhat/rhel-7-x86_64/pgdg-centos10-10-2.noarch.rpm
+RUN yum -y install postgresql10-devel
+RUN yum clean all
+RUN curl -sSL https://get.haskellstack.org/ | sh
+
+ENV PATH $PATH:/usr/pgsql-10/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,20 @@
+FROM ubuntu:16.04
+
+## TODO pin the stack version
+#
+RUN BUILD_DEPS="curl ca-certificates build-essential" && \
+    apt-get -qq update && \
+    apt-get -qqy --no-install-recommends install \
+    $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,20 @@
+FROM i386/ubuntu:16.04
+
+## TODO pin the stack version
+
+RUN BUILD_DEPS="curl ca-certificates build-essential" && \
+    apt-get -qq update && \
+    apt-get -qqy --no-install-recommends install \
+    $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,19 @@
+db-uri = "$(PGRST_DB_URI)"
+db-schema = "$(PGRST_DB_SCHEMA)"
+db-anon-role = "$(PGRST_DB_ANON_ROLE)"
+db-pool = "$(PGRST_DB_POOL)"
+db-extra-search-path = "$(PGRST_DB_EXTRA_SEARCH_PATH)"
+
+server-host = "$(PGRST_SERVER_HOST)"
+server-port = "$(PGRST_SERVER_PORT)"
+
+openapi-server-proxy-uri = "$(PGRST_OPENAPI_SERVER_PROXY_URI)"
+jwt-secret = "$(PGRST_JWT_SECRET)"
+secret-is-base64 = "$(PGRST_SECRET_IS_BASE64)"
+jwt-aud = "$(PGRST_JWT_AUD)"
+role-claim-key = "$(PGRST_ROLE_CLAIM_KEY)"
+
+max-rows = "$(PGRST_MAX_ROWS)"
+pre-request = "$(PGRST_PRE_REQUEST)"
+root-spec = "$(PGRST_ROOT_SPEC)"
+raw-media-types = "$(PGRST_RAW_MEDIA_TYPES)"

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,21 +0,0 @@
-## Security
-
-### SSL
-
-### Database Roles
-
-### JSON Web Tokens
-
-#### Issuing via sql procedures
-
-### Row-Level Security
-
-#### Simulated - PostgreSQL <9.5
-
-#### Real - PostgreSQL >=9.5
-
-### Building Auth on top of JWT
-
-#### Basic Auth
-
-#### Github Sign-in

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,296 +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`, `PUT`, `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 instead to embed related
-  information, including 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).
-To do so 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 descending order:
-
-```HTTP
-GET /people?order=age
-```
-
-If you care where nulls are sorted, add `nullsfirst` or `nullslast`:
-
-```HTTP
-GET /people?order=age.nullsfirst
-```
-
-### 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
-```
-
-So the PostgREST response will be something like:
-
-```
-Range-Unit: items
-Content-Range → 0-14/*
-```
-
-### Embedding Foreign Entities
-
-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(*)
-```
-
-### 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. There is currently an open issue to enable this.
-
-### 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,131 +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
-
-While regular insertion uses JSON to encode the value, bulk insertion
-uses CSV. 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.
-
-The server sends a multipart response for bulk insertions. Each part
-contains a Location header with URL of each created resource.
-
-```HTTP
-Content-Type: application/json
-Location: /festival?name=eq.Venice%20Film%20Festival
-
-
---postgrest_boundary
-Content-Type: application/json
-Location: /festival?name=eq.Cannes%20Film%20Festival
-```
-
-### Upsertion
-
-* ❌ Cannot be cached or prefetched
-* ✅ Idempotent
-
-To insert or update a single row use the `PUT` verb on a properly
-filtered table url:
-
-```HTTP
-PUT /table_name?primary_key=eq.foo
-{ "col1": "value1", "col2": "value2" }
-```
-
-The request must satisfy two things. First all columns must be
-specified (because a default value might be a changing value which
-would violate idempotence). Second the URL must match the URL you
-would use to get the value of the resource. This means that all
-primary key columns must be included in the filter (there are more
-than one when the primary key is compound).
-
-If you would like to get the full object back in the response to
-your request, include the header `Prefer: return=representation`.
-It will of match exactly the object you sent though.
-
-### 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=eq.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/start.md

@@ -1,346 +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,
-  rating real NOT NULL DEFAULT 0,
-  language text NOT NULL,
-  CONSTRAINT film_director_fkey FOREIGN KEY (director)
-      REFERENCES director (name) MATCH SIMPLE
-      ON UPDATE CASCADE ON DELETE CASCADE
-);
-
-CREATE TABLE festival
-(
-  name text NOT NULL PRIMARY KEY
-);
-
-CREATE TABLE competition
-(
-  id serial PRIMARY KEY,
-  name text NOT NULL,
-  festival text NOT NULL,
-  year date NOT NULL,
-
-  CONSTRAINT comp_festival_fkey FOREIGN KEY (festival)
-      REFERENCES festival (name) MATCH SIMPLE
-      ON UPDATE CASCADE ON DELETE CASCADE
-);
-
-CREATE TABLE film_nomination
-(
-  id serial PRIMARY KEY,
-  competition integer NOT NULL,
-  film integer NOT NULL,
-  won boolean NOT NULL DEFAULT true,
-
-  CONSTRAINT nomination_competition_fkey FOREIGN KEY (competition)
-     REFERENCES competition (id) MATCH SIMPLE
-     ON UPDATE NO ACTION ON DELETE NO ACTION,
-  CONSTRAINT nomination_film_fkey FOREIGN KEY (film)
-     REFERENCES film (id) MATCH SIMPLE
-     ON UPDATE CASCADE ON DELETE CASCADE
-);
-
-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.
-
-```sh
-postgrest -d demo1 -U postgres -a postgres --v1schema 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>
-
-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. 
-
-Note that the server returns a multipart response with URL of each created resource.
-
-```HTTP
-Content-Type: application/json
-Location: /festival?name=eq.Venice%20Film%20Festival
-
-
---postgrest_boundary
-Content-Type: application/json
-Location: /festival?name=eq.Cannes%20Film%20Festival
-```
-
-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
-```
-
-At this point nominations are fully specified but it's not a convenient interface for a rest client. Let's make a view they can use. Paste this into `psql demo1`.
-
-```sql
-create or replace view nomination as
-select comp.festival,  
-       comp.name as competition,
-       comp.year,
-       film.title,
-       film.director,
-       film.rating
- from film_nomination as nom
- left join film on nom.film = film.id
- left join competition as comp on nom.competition = comp.id
- order by comp.year desc, comp.festival, competition;
-```
-
-Time to try it out. Let's get the contents of the new view, ordered by film rating
-
-```
-GET http://localhost:3000/nomination?order=rating.desc
-```
-
-If you find it more human readable, add an `Accept: text/csv` header.
-
-### Releasing a New Version
-
-Suppose we want this endpoint to cater to those moviegoers with attention deficit disorder. In today's busy world we don't have time to read an extra couple words or compare nuanced reviews. In API version two we will truncate the names and round the ratings!
-
-Each version lives in a numbered schema, so let's make a schema for version two.
-
-```sql
-CREATE SCHEMA "2";
-GRANT USAGE ON SCHEMA "2" TO PUBLIC;
-ALTER DATABASE demo1 SET search_path = "2", "public";
-```
-
-To override the `films` endpoint create a view in the "2" schema with that name:
-
-```sql
-create or replace view "2".film as
-select id, substring(f.title from 1 for 10) as title,
-       year, director, round(f.rating) as rating, language
-from "public".film as f;
-```
-
-We select the desired version as part of content negotiation. Try this get request:
-
-```HTTP
-GET http://localhost:3000/film
-Accept: text/csv; version=2
-```
-
-Then try toggling the version string in the Accept header and watch the results change. Pretty good, now how about writing values? PostgreSQL's nice feature called auto-updatable views allows writes to pass through views. Sadly this view is not eligible because truncation and rounding cannot be uniquely reversed. If we attempt to post a new result it complains:
-
-```json
-{
-  "hint": null,
-  "details": "View columns that are not columns of their base relation are not updatable.",
-  "code": "0A000",
-  "message": "cannot insert into column \"title\" of view \"film\""
-}
-```
-
-This is a case where we need explicit triggers
-
-```sql
--- TODO - FIX THIS
-
--- CREATE OR REPLACE RULE insert_v2_films AS
---   ON INSERT TO "2".film
---   DO INSTEAD
---      INSERT INTO public.film (id, title, year, director, rating, language)
---      VALUES (NEW.id,     NEW.title,
---              NEW.year,   NEW.director,
---              NEW.rating, NEW.language)
---      RETURNING public.film.*;
-```

docs/index.md

@@ -1,68 +0,0 @@
-![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.
-
-### 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,23 +0,0 @@
-## Ecosystem
-
-### Client-Side Libraries
-
-* [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
-
-### Extensions
-
-* [srid/spas](https://github.com/srid/spas) - allow file uploads and basic auth
-
-### Example Apps
-
-* [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,89 +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 and 64-bit Ubuntu. Next 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 version. We need to set up an automated build matrix for various architectures. It should support 32- and 64-bit versions of
-
-    <ul><li>Scientific Linux 6</li><li>CentOS</li><li>RHEL 6</li></ul>
-
-    Also it would be good to create a package for apt.</p>
-</div>
-
-We'll learn the meaning of the command line flags later, but here is a minimal example of running the app. It does all operations as user `postgres`, including for unauthenticated requests.
-
-```sh
-$ ./postgrest -d dbname -U postgres -a postgres --v1schema public
-```
-
-### 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](https://github.com/commercialhaskell/stack#how-to-install) for your platform
-```bash
-#ubuntu example
-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
-```
-* 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
-
-```bash
-postgrest dbconnectionstring arg1 arg2
-```
-
-If you want to run the test suite, stack can do that too: `stack test`.
-
-### 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 around 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. 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)

main/Main.hs

@@ -0,0 +1,330 @@
+{-# LANGUAGE CPP #-}
+
+module Main where
+
+import qualified Data.ByteString            as BS
+import qualified Data.ByteString.Base64     as B64
+import qualified Hasql.Pool                 as P
+import qualified Hasql.Transaction.Sessions as HT
+
+import Control.AutoUpdate       (defaultUpdateSettings, mkAutoUpdate,
+                                 updateAction)
+import Control.Retry            (RetryStatus, capDelay,
+                                 exponentialBackoff, retrying,
+                                 rsPreviousDelay)
+import Data.Either.Combinators  (whenLeft)
+import Data.IORef               (IORef, atomicWriteIORef, newIORef,
+                                 readIORef)
+import Data.String              (IsString (..))
+import Data.Text                (pack, replace, strip, stripPrefix)
+import Data.Text.IO             (hPutStrLn)
+import Data.Time.Clock          (getCurrentTime)
+import Network.Wai.Handler.Warp (defaultSettings, runSettings,
+                                 setHost, setPort, setServerName)
+import System.IO                (BufferMode (..), hSetBuffering)
+
+import PostgREST.App         (postgrest)
+import PostgREST.Config      (AppConfig (..), configPoolTimeout',
+                              prettyVersion, readOptions)
+import PostgREST.DbStructure (getDbStructure, getPgVersion)
+import PostgREST.Error       (PgError (PgError), checkIsFatal,
+                              errorPayload)
+import PostgREST.OpenAPI     (isMalformedProxyUri)
+import PostgREST.Types       (ConnectionStatus (..), DbStructure,
+                              PgVersion (..), Schema,
+                              minimumPgVersion)
+import Protolude             hiding (hPutStrLn, head, replace, toS)
+import Protolude.Conv        (toS)
+
+
+#ifndef mingw32_HOST_OS
+import System.Posix.Signals
+import UnixSocket
+#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] -- ^ Schemas PostgREST is serving up
+  -> IORef (Maybe DbStructure) -- ^ mutable reference to 'DbStructure'
+  -> IORef Bool                -- ^ Used as a binary Semaphore
+  -> IO ()
+connectionWorker mainTid pool schemas 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 <- connectionStatus pool
+      case connected of
+        FatalConnectionError reason -> hPutStrLn stderr reason
+                                      >> killThread mainTid    -- Fatal error when connecting
+        NotConnected                -> return ()               -- Unreachable
+        Connected actualPgVersion   -> do                      -- Procede with initialization
+          result <- P.use pool $ do
+            dbStructure <- HT.transaction HT.ReadCommitted HT.Read $ getDbStructure schemas actualPgVersion
+            liftIO $ atomicWriteIORef refDbStructure $ Just dbStructure
+          case result of
+            Left e -> do
+              putStrLn ("Failed to query the database. Retrying." :: Text)
+              hPutStrLn stderr . toS . errorPayload $ PgError False e
+              work
+
+            Right _ -> do
+              atomicWriteIORef refIsWorkerOn False
+              putStrLn ("Connection successful" :: Text)
+
+{-|
+  Used by 'connectionWorker' to check if the provided db-uri lets
+  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.
+-}
+connectionStatus :: P.Pool -> IO ConnectionStatus
+connectionStatus pool =
+  retrying (capDelay 32000000 $ exponentialBackoff 1000000)
+           shouldRetry
+           (const $ P.release pool >> getConnectionStatus)
+  where
+    getConnectionStatus :: IO ConnectionStatus
+    getConnectionStatus = do
+      pgVersion <- P.use pool getPgVersion
+      case pgVersion of
+        Left e -> do
+          let err = PgError False e
+          hPutStrLn stderr . toS $ errorPayload err
+          case checkIsFatal err of
+            Just reason -> return $ FatalConnectionError reason
+            Nothing     -> return NotConnected
+
+        Right version ->
+          if version < minimumPgVersion
+             then return . FatalConnectionError $ "Cannot run in this PostgreSQL version, PostgREST needs at least " <> pgvName minimumPgVersion
+             else return . Connected  $ version
+
+    shouldRetry :: RetryStatus -> ConnectionStatus -> IO Bool
+    shouldRetry rs isConnSucc = do
+      let delay    = fromMaybe 0 (rsPreviousDelay rs) `div` 1000000
+          itShould = NotConnected == isConnSucc
+      when itShould $
+        putStrLn $ "Attempting to reconnect to the database in " <> (show delay::Text) <> " seconds..."
+      return itShould
+
+
+{-|
+  This is where everything starts.
+-}
+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 <- loadDbUriFile =<< loadSecretFile =<< readOptions
+  let schemas = toList $ configSchemas conf
+      host = configHost conf
+      port = configPort conf
+      proxy = configOpenAPIProxyUri conf
+      maybeSocketAddr = configSocket conf
+      socketFileMode = configSocketMode conf
+      pgSettings = toS (configDatabase conf) -- is the db-uri
+      roleClaimKey = configRoleClaimKey conf
+      appSettings =
+        setHost ((fromString . toS) host) -- Warp settings
+        . setPort port
+        . setServerName (toS $ "postgrest/" <> prettyVersion) $
+        defaultSettings
+
+
+  whenLeft socketFileMode panic
+
+  -- Checks that the provided proxy uri is formated correctly
+  when (isMalformedProxyUri $ toS <$> proxy) $
+    panic
+      "Malformed proxy uri, a correct example: https://example.com:8443/basePath"
+
+  -- Checks that the provided jspath is valid
+  whenLeft roleClaimKey $
+    panic $ show roleClaimKey
+
+  -- create connection pool with the provided settings, returns either
+  -- a 'Connection' or a 'ConnectionError'. Does not throw.
+  pool <- P.acquire (configPool conf, configPoolTimeout' conf, 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
+    schemas
+    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
+
+  void $ installHandler sigUSR1 (
+    Catch $ connectionWorker
+              mainTid
+              pool
+              schemas
+              refDbStructure
+              refIsWorkerOn
+    ) Nothing
+#endif
+
+
+  -- ask for the OS time at most once per second
+  getTime <- mkAutoUpdate defaultUpdateSettings {updateAction = getCurrentTime}
+
+  let postgrestApplication =
+        postgrest
+          conf
+          refDbStructure
+          pool
+          getTime
+          (connectionWorker
+             mainTid
+             pool
+             schemas
+             refDbStructure
+             refIsWorkerOn)
+
+  -- run the postgrest application with user defined socket. Only for UNIX systems.
+#ifndef mingw32_HOST_OS
+  whenJust maybeSocketAddr $
+    runAppInSocket appSettings postgrestApplication socketFileMode
+#endif
+
+  -- run the postgrest application
+  whenNothing maybeSocketAddr $ do
+    putStrLn $ ("Listening on port " :: Text) <> show (configPort conf)
+    runSettings appSettings postgrestApplication
+
+{-|
+  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 "." "="
+
+{-
+  Load database uri from a separate file if `db-uri` is a filepath.
+-}
+loadDbUriFile :: AppConfig -> IO AppConfig
+loadDbUriFile conf = extractDbUri mDbUri
+  where
+    mDbUri = configDatabase conf
+    extractDbUri :: Text -> IO AppConfig
+    extractDbUri dbUri =
+      fmap setDbUri $
+      case stripPrefix "@" dbUri of
+        Nothing       -> return dbUri
+        Just filename -> strip <$> readFile (toS filename)
+    setDbUri dbUri = conf {configDatabase = dbUri}
+
+-- Utilitarian functions.
+whenJust :: Applicative f => Maybe a -> (a -> f ()) -> f ()
+whenJust (Just x) f = f x
+whenJust Nothing _  = pass
+
+whenNothing :: Applicative f => Maybe a -> f () -> f ()
+whenNothing Nothing f = f
+whenNothing _       _ = pass

main/UnixSocket.hs

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

mkdocs.yml

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

nix/README.md

@@ -0,0 +1,163 @@
+# Nix development and build environment
+
+With Nix it's possible to quickly and reliably recreate the full environments
+for developing, testing and building PostgREST.
+
+## Getting started with Nix
+
+You'll need to [get Nix](https://nixos.org/download.html). The installer will
+create your Nix store in the `/nix/` directory, where all build artifacts and
+their dependencies will be stored. It will also link the Nix executables like
+`nix-env`, `nix-build` and `nix-shell` into your PATH. Nix will manage all
+other PostgREST dependencies from here on out. To clean up older build
+artifacts from the `/nix/store`, you can run `nix-collect-garbage`.
+
+## Building PostgREST
+
+To build PostgREST from your local checkout of the repository, run:
+
+```bash
+nix-build --attr postgrest
+
+```
+
+This will create a `result` directory that contains the PostgREST binary at
+`result/bin/postgrest`. The `--attr` parameter (or short: `-A`) tells Nix to
+build the `postgrest` attribute from the Nix expression it finds in our
+`default.nix` (see below for details). Nix will take care of getting the right
+GHC version and all the build dependencies.
+
+## Developing
+
+A development environment for PostgREST is available with `nix-shell`. The
+following command will put you into a new shell that has GHC and Cabal on the
+PATH:
+
+```bash
+nix-shell
+
+```
+
+Within `nix-shell`, you can run Cabal commands as usual. You can also run
+stack with the `--nix` option, which causes stack to pick up the non-Haskell
+dependencies from the same pinned Nixpkgs version that the Nix builds use.
+
+## Aside: Working with `nix-shell` and the PostgREST utility scripts
+
+The PostgREST utilities available in `nix-shell` all have names that begin
+with `postgrest-`, so you can use tab completion (`postgrest-<tab>`) in 
+`nix-shell` to see all that are available:
+
+```
+# Note: The utilities listed here might not be up to date.
+[nix-shell:~/Projects/postgrest]$ postgrest-
+postgrest-lint                         postgrest-test-spec-postgresql-10.12
+postgrest-style                        postgrest-test-spec-postgresql-11.7
+postgrest-style-check                  postgrest-test-spec-postgresql-12.2
+postgrest-test-all                     postgrest-test-spec-postgresql-9.4.24
+postgrest-test-spec                    postgrest-test-spec-postgresql-9.5.21
+postgrest-test-spec-all                postgrest-test-spec-postgresql-9.6.17
+
+[nix-shell:~/Projects/postgrest]$
+
+```
+
+To run one-off commands, you can also use `nix-shell --run <command>`, which
+will lauch the Nix shell, run that one command and exit. Note that the tab
+completion will not work with `nix-shell --run`, as Nix has yet to evaluate
+our Nix expressions to see which utilities are available.
+
+```
+$ nix-shell --run postgrest-style
+
+# Note that you need to quote any arguments that you would like to pass to
+# the command to be run in nix-shell:
+$ nix-shell --run "postgrest-foo --bar"
+
+```
+
+A third option is to install utilities that you use very often locally:
+
+```
+$ nix-env -f default.nix -iA style
+
+# `postgrest-style` can now be run directly:
+$ postgrest-style
+
+```
+
+Note that this does not yet work for all utilities (e.g. `postgrest-test-spec` currently
+needs to be run within the Nix shell environment).
+
+If you use `nix-shell` very often, you might like to use https://github.com/xzfc/cached-nix-shell,
+which skips evaluating all our Nix expressions if nothing changed, reducing startup time for the
+shell considerably.
+
+## Testing
+
+In nix-shell, you'll find utility scripts that make it very easy to run the
+Haskell test suite, including setting up all required dependencies and
+temporary test databases:
+
+```bash
+# Run the tests against the most recent version of PostgreSQL:
+$ nix-shell --run postgrest-test-spec
+
+# Run the tests against all supported versions of PostgreSQL:
+$ nix-shell --run postgrest-test-spec-all
+
+# Run the tests against a specific version of PostgreSQL (use tab-completion in
+# nix-shell to see all available versions):
+$ nix-shell --run postgrest-test-spec-postgresql-9.5.21
+
+```
+
+## Linting and styling code
+
+The nix-shell also contains scripts for linting and styling the PostgREST
+source code:
+
+```bash
+# Linting
+$ nix-shell --run postgrest-lint
+
+# Styling / auto-formatting code
+$ nix-shell --run postgrest-style
+
+```
+
+## Tour
+
+The following is not required for working on PostgREST with Nix, but it will
+give you some more background and details on how it works.
+
+### `default.nix`
+
+[`default.nix`](../default.nix) is our 'respository expression' that pulls all
+the pieces that we define with Nix together. It returns a set (like a dict in
+other programming languages), where each attribute is a derivation that Nix
+knows how to build, like the `postgrest` attribute from earlier.
+
+Internally, our `default.nix` uses the `pkgs.callPackage` function to import
+the modules that we defined in the `nix` directory. It automatically passes the
+arguments those modules require if they are available in `pkgs` (this means
+that `pkgs` is defined in terms of itself, better not to think too much about
+that).
+
+We also use `default.nix` to load our pinned version of the `nixpkgs`
+repository. This set of packages will always be the same, independently from
+where or when you use it. The pinned version can be upgraded with the small
+`nixpkgs-upgrade` utility. Running `nixpkgs-upgrade > nix/nixpkgs-version.nix`
+in `nix-shell` will upgrade the pinned version to the latest `nixpkgs-unstable`
+version.
+
+### `shell.nix`
+
+[`shell.nix`](../shell.nix) defines an environment in which PostgREST can be
+built and developed. It extends the build enviroment from our `postgrest`
+attribute with useful utilities that will be put on the PATH in `nix-shell`.
+
+### `nix/overlays`
+
+Our overlays to the Nix package set are defined here. They allow us to tweak our
+`pkgs` in `default.nix` by adding new packages or overriding existing ones.

nix/docker/default.nix

@@ -0,0 +1,63 @@
+{ postgrest, dockerTools, writeShellScriptBin }:
+let
+  image =
+    tag:
+      dockerTools.buildImage {
+        inherit tag;
+
+        name = "postgrest/postgrest";
+        contents = postgrest;
+
+        # Set the current time as the image creation date. This makes the build
+        # non-reproducible, but that should not be an issue for us.
+        created = "now";
+
+        extraCommands =
+          ''
+            mkdir etc
+            cp ${./postgrest.conf} etc/postgrest.conf
+          '';
+
+        config = {
+          Cmd = [ "/bin/postgrest" "/etc/postgrest.conf" ];
+          Env = [
+            "PGRST_DB_URI=postgresql://?user=postgres"
+            "PGRST_DB_SCHEMA=public"
+            "PGRST_DB_ANON_ROLE="
+            "PGRST_DB_POOL=100"
+            "PGRST_DB_EXTRA_SEARCH_PATH=public"
+            "PGRST_SERVER_HOST=*4"
+            "PGRST_SERVER_PORT=3000"
+            "PGRST_OPENAPI_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"
+            "PGRST_ROOT_SPEC="
+            "PGRST_RAW_MEDIA_TYPES="
+          ];
+          User = "1000";
+          ExposedPorts = {
+            "3000/tcp" = {};
+          };
+        };
+      };
+in
+rec {
+  imageLatest =
+    image "latest";
+
+  imageWithVersion =
+    image "v${postgrest.version}";
+
+  load =
+    writeShellScriptBin "postgrest-docker-load"
+      ''
+        set -euo pipefail
+
+        docker load -i ${imageLatest}
+        docker load -i ${imageWithVersion}
+      '';
+}

nix/docker/postgrest.conf

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

nix/lint.nix

@@ -0,0 +1,12 @@
+{ writeShellScriptBin, git, silver-searcher, hlint }:
+
+writeShellScriptBin "postgrest-lint"
+  ''
+    set -euo pipefail
+
+    rootdir="$(${git}/bin/git rev-parse --show-toplevel)"
+
+    # Lint Haskell files
+    ${silver-searcher}/bin/ag -l -g '\.l?hs$' "$rootdir" \
+      | xargs ${hlint}/bin/hlint -X QuasiQuotes -X NoPatternSynonyms
+  ''

nix/nixpkgs-upgrade.nix

@@ -0,0 +1,41 @@
+{ curl
+, jq
+, writeShellScriptBin
+, nix
+}:
+# Utility script for pinning the latest unstable version of Nixpkgs.
+
+# Instead of pinning Nixpkgs based on the huge Git repository, we reference a
+# specific tarball that only contains the source of the revision that we want
+# to pin.
+let
+  name =
+    "nixpkgs-upgrade";
+
+  refUrl =
+    https://api.github.com/repos/nixos/nixpkgs/git/ref/heads/nixpkgs-unstable;
+
+  githubV3Header =
+    "Accept: application/vnd.github.v3+json";
+
+  tarballUrlBase =
+    https://github.com/nixos/nixpkgs/archive/;
+in
+writeShellScriptBin name
+  ''
+    set -euo pipefail
+
+    commitHash="$(${curl}/bin/curl "${refUrl}" -H "${githubV3Header}" | ${jq}/bin/jq -r .object.sha)"
+    tarballUrl="${tarballUrlBase}$commitHash.tar.gz"
+    tarballHash="$(${nix}/bin/nix-prefetch-url --unpack "$tarballUrl")"
+    currentDate="$(date --iso)"
+
+    cat << EOF
+    # Pinned version of Nixpkgs, generated with ${name}.
+    {
+      date = "$currentDate";
+      rev = "$commitHash";
+      tarballHash = "$tarballHash";
+    }
+    EOF
+  ''

nix/nixpkgs-version.nix

@@ -0,0 +1,6 @@
+# Pinned version of Nixpkgs, generated with nixpkgs-upgrade.
+{
+  date = "2020-04-19";
+  rev = "10100a97c8964e82b30f180fda41ade8e6f69e41";
+  tarballHash = "011f36kr3c1ria7rag7px26bh73d1b0xpqadd149bysf4hg17rln";
+}

nix/overlays/gitignore.nix

@@ -0,0 +1,19 @@
+self: super:
+# Overlay that adds the `gitignoreSource` function from Hercules-CI.
+# This function is useful for filtering which files are added to the Nix store.
+# See: https://github.com/hercules-ci/gitignore.nix
+
+# To update to a newer revision, the simplest way is to add a new commit hash
+# from GitHub under `rev` and to then add the hash that Nix suggests on first
+# use.
+{
+  gitignoreSource =
+    let
+      gitignoreSrc = super.fetchFromGitHub {
+        owner = "hercules-ci";
+        repo = "gitignore";
+        rev = "2ced4519f865341adcb143c5d668f955a2cb997f";
+        sha256 = "sha256:0fc5bgv9syfcblp23y05kkfnpgh3gssz6vn24frs8dzw39algk2z";
+      };
+    in (super.callPackage gitignoreSrc {}).gitignoreSource;
+}

nix/overlays/haskell-packages/README.md

@@ -0,0 +1,10 @@
+The `.nix` files in this directory pin specific versions of Haskell packages
+from Hackage. They were generated with `cabal2nix`, e.g.:
+
+```bash
+cabal2nix cabal://protolude > protolude.nix
+
+```
+
+Those overrides might become obsolete as the pinned versions are adopted into
+our pinned version of nixpkgs.

nix/overlays/haskell-packages/default.nix

@@ -0,0 +1,11 @@
+self: super:
+
+{
+  haskellPackages =
+    super.haskellPackages.override {
+      overrides =
+        final: prev: rec {
+          protolude = prev.callPackage ./protolude.nix {};
+        };
+    };
+}

nix/overlays/haskell-packages/protolude.nix

@@ -0,0 +1,43 @@
+{ mkDerivation
+, array
+, async
+, base
+, bytestring
+, containers
+, deepseq
+, ghc-prim
+, hashable
+, mtl
+, mtl-compat
+, stdenv
+, stm
+, text
+, transformers
+, transformers-compat
+}:
+mkDerivation {
+  pname = "protolude";
+  version = "0.3.0";
+  sha256 = "4083385a9e03fab9201f63ce198b9ced3fbc1c50d6d42574db5e36c757bedcac";
+  isLibrary = true;
+  isExecutable = true;
+  libraryHaskellDepends = [
+    array
+    async
+    base
+    bytestring
+    containers
+    deepseq
+    ghc-prim
+    hashable
+    mtl
+    mtl-compat
+    stm
+    text
+    transformers
+    transformers-compat
+  ];
+  homepage = "https://github.com/sdiehl/protolude";
+  description = "A small prelude";
+  license = stdenv.lib.licenses.mit;
+}

nix/overlays/postgresql-legacy.nix

@@ -0,0 +1,20 @@
+self: super:
+# Overlay that adds legacy versions of PostgreSQL that are supported by
+# PostgREST.
+{
+  # PostgreSQL 9.4 was removed from Nixpkgs with
+  # https://github.com/NixOS/nixpkgs/commit/8e2fc57a80d761c46702c3250e61c1bffe021e25
+  # We pin its parent commit 3b5b9a7 to get the last version that was available.
+  postgresql_9_4 =
+    let
+      rev = "3b5b9a73f59ff93d50156e250203410bdd07f4e0";
+      tarballHash = "0kr25xqbv1ldp72jbmml21pc5hl7xcfqhclv5qxa5f860jddjznk";
+
+      pinnedPkgs =
+        builtins.fetchTarball {
+          url = "https://github.com/nixos/nixpkgs/archive/${rev}.tar.gz";
+          sha256 = tarballHash;
+        };
+    in
+      (import pinnedPkgs {}).pkgs.postgresql_9_4;
+}

nix/patches/default.nix

@@ -0,0 +1,25 @@
+{ runCommand }:
+
+{
+  # Apply patches to a directory.
+  applyPatches =
+    name: path: patches:
+      runCommand name { inherit patches; }
+        ''
+          set -eou pipefail
+
+          cp -r ${path} $out
+          chmod -R u+w $out
+
+          for patch in $patches; do
+            echo "Applying patch $patch"
+            patch -d "$out" -p1 < "$patch"
+          done
+        '';
+
+  static-haskell-nix-postgrest-libpq =
+    ./static-haskell-nix-postgrest-libpq.patch;
+
+  nixpkgs-revert-ghc-bootstrap =
+    ./nixpkgs-revert-ghc-bootstrap.patch;
+}

nix/patches/nixpkgs-revert-ghc-bootstrap.patch

@@ -0,0 +1,125 @@
+From 93cc144b215654ca9cb0d2bcb58bb8922895ccab Mon Sep 17 00:00:00 2001
+From: Remo <remo>
+Date: Sat, 25 Apr 2020 17:31:55 +0200
+Subject: [PATCH] Revert "ghc: 8.6.3-binary -> 8.6.5-binary"
+
+This reverts commit 3c7ef6bcd85e3e133ac6f2ab5e238934d56d902e.
+---
+ .../{8.6.5-binary.nix => 8.6.3-binary.nix}    | 13 ++++++------
+ pkgs/top-level/haskell-packages.nix           | 20 +++++++++----------
+ 2 files changed, 16 insertions(+), 17 deletions(-)
+ rename pkgs/development/compilers/ghc/{8.6.5-binary.nix => 8.6.3-binary.nix} (95%)
+
+diff --git a/pkgs/development/compilers/ghc/8.6.5-binary.nix b/pkgs/development/compilers/ghc/8.6.3-binary.nix
+similarity index 95%
+rename from pkgs/development/compilers/ghc/8.6.5-binary.nix
+rename to pkgs/development/compilers/ghc/8.6.3-binary.nix
+index 97793d912895..9e0fd12b96cf 100644
+--- a/pkgs/development/compilers/ghc/8.6.5-binary.nix
++++ b/pkgs/development/compilers/ghc/8.6.3-binary.nix
+@@ -27,19 +27,18 @@ let
+ in
+ 
+ stdenv.mkDerivation rec {
+-  version = "8.6.5";
++  version = "8.6.3";
+ 
+   name = "ghc-${version}-binary";
+ 
+-  # https://downloads.haskell.org/~ghc/8.6.5/
+   src = fetchurl ({
+     i686-linux = {
+-      url = "http://haskell.org/ghc/dist/${version}/ghc-${version}-i386-deb9-linux.tar.xz";
+-      sha256 = "1p2h29qghql19ajk755xa0yxkn85slbds8m9n5196ris743vkp8w";
++      url = "http://haskell.org/ghc/dist/${version}/ghc-${version}-i386-deb8-linux.tar.xz";
++      sha256 = "0bw8a7fxcbskf93rb4m542ff66vrmx5i5kj77qx37cbhijx70w5m";
+     };
+     x86_64-linux = {
+-      url = "http://haskell.org/ghc/dist/${version}/ghc-${version}-x86_64-deb9-linux.tar.xz";
+-      sha256 = "1pqlx6rdjs2110g0y1i9f8x18lmdizibjqd15f5xahcz39hgaxdw";
++      url = "http://haskell.org/ghc/dist/${version}/ghc-${version}-x86_64-deb8-linux.tar.xz";
++      sha256 = "1m9gaga2pzi2cx5gvasg0rx1dlvr68gmi20l67652kag6xjsa719";
+     };
+     aarch64-linux = {
+       url = "http://haskell.org/ghc/dist/${version}/ghc-${version}-aarch64-ubuntu18.04-linux.tar.xz";
+@@ -47,7 +46,7 @@ stdenv.mkDerivation rec {
+     };
+     x86_64-darwin = {
+       url = "http://haskell.org/ghc/dist/${version}/ghc-${version}-x86_64-apple-darwin.tar.xz";
+-      sha256 = "0s9188vhhgf23q3rjarwhbr524z6h2qga5xaaa2pma03sfqvvhfz";
++      sha256 = "1hbzk57v45176kxcx848p5jn5p1xbp2129ramkbzsk6plyhnkl3r";
+     };
+   }.${stdenv.hostPlatform.system}
+     or (throw "cannot bootstrap GHC on this platform"));
+diff --git a/pkgs/top-level/haskell-packages.nix b/pkgs/top-level/haskell-packages.nix
+index aa7ef02a3886..712a98e147e0 100644
+--- a/pkgs/top-level/haskell-packages.nix
++++ b/pkgs/top-level/haskell-packages.nix
+@@ -4,7 +4,7 @@ let
+   # These are attributes in compiler and packages that don't support integer-simple.
+   integerSimpleExcludes = [
+     "ghc822Binary"
+-    "ghc865Binary"
++    "ghc863Binary"
+     "ghc844"
+     "ghcjs"
+     "ghcjs86"
+@@ -42,7 +42,7 @@ in {
+ 
+     ghc822Binary = callPackage ../development/compilers/ghc/8.2.2-binary.nix { };
+ 
+-    ghc865Binary = callPackage ../development/compilers/ghc/8.6.5-binary.nix { };
++    ghc863Binary = callPackage ../development/compilers/ghc/8.6.3-binary.nix { };
+ 
+     ghc844 = callPackage ../development/compilers/ghc/8.4.4.nix {
+       bootPkgs = packages.ghc822Binary;
+@@ -57,31 +57,31 @@ in {
+       llvmPackages = pkgs.llvmPackages_6;
+     };
+     ghc881 = callPackage ../development/compilers/ghc/8.8.1.nix {
+-      bootPkgs = packages.ghc865Binary;
++      bootPkgs = packages.ghc863Binary;
+       inherit (buildPackages.python3Packages) sphinx;
+       buildLlvmPackages = buildPackages.llvmPackages_7;
+       llvmPackages = pkgs.llvmPackages_7;
+     };
+     ghc882 = callPackage ../development/compilers/ghc/8.8.2.nix {
+-      bootPkgs = packages.ghc865Binary;
++      bootPkgs = packages.ghc863Binary;
+       inherit (buildPackages.python3Packages) sphinx;
+       buildLlvmPackages = buildPackages.llvmPackages_7;
+       llvmPackages = pkgs.llvmPackages_7;
+     };
+     ghc883 = callPackage ../development/compilers/ghc/8.8.3.nix {
+-      bootPkgs = packages.ghc865Binary;
++      bootPkgs = packages.ghc863Binary;
+       inherit (buildPackages.python3Packages) sphinx;
+       buildLlvmPackages = buildPackages.llvmPackages_7;
+       llvmPackages = pkgs.llvmPackages_7;
+     };
+     ghc8101 = callPackage ../development/compilers/ghc/8.10.1.nix {
+-      bootPkgs = packages.ghc865Binary;
++      bootPkgs = packages.ghc863Binary;
+       inherit (buildPackages.python3Packages) sphinx;
+       buildLlvmPackages = buildPackages.llvmPackages_9;
+       llvmPackages = pkgs.llvmPackages_9;
+     };
+     ghcHEAD = callPackage ../development/compilers/ghc/head.nix {
+-      bootPkgs = packages.ghc883; # no binary yet
++      bootPkgs = packages.ghc863Binary;
+       inherit (buildPackages.python3Packages) sphinx;
+       buildLlvmPackages = buildPackages.llvmPackages_9;
+       llvmPackages = pkgs.llvmPackages_9;
+@@ -118,9 +118,9 @@ in {
+       compilerConfig = callPackage ../development/haskell-modules/configuration-ghc-8.2.x.nix { };
+       packageSetConfig = bootstrapPackageSet;
+     };
+-    ghc865Binary = callPackage ../development/haskell-modules {
+-      buildHaskellPackages = bh.packages.ghc865Binary;
+-      ghc = bh.compiler.ghc865Binary;
++    ghc863Binary = callPackage ../development/haskell-modules {
++      buildHaskellPackages = bh.packages.ghc863Binary;
++      ghc = bh.compiler.ghc863Binary;
+       compilerConfig = callPackage ../development/haskell-modules/configuration-ghc-8.6.x.nix { };
+       packageSetConfig = bootstrapPackageSet;
+     };

nix/patches/static-haskell-nix-postgrest-libpq.patch

@@ -0,0 +1,25 @@
+From bb4c1e27e391eff01591fe60830ff68a9ada41ef Mon Sep 17 00:00:00 2001
+From: Remo <remo>
+Date: Wed, 22 Apr 2020 11:58:07 +0200
+Subject: [PATCH] Add postgrest libpq linking fix
+
+---
+ survey/default.nix | 5 +++++
+ 1 file changed, 5 insertions(+)
+
+diff --git a/survey/default.nix b/survey/default.nix
+index b28606c..fd7cde7 100644
+--- a/survey/default.nix
++++ b/survey/default.nix
+@@ -1052,6 +1052,11 @@ let
+                   super.squeal-postgresql
+                   [ final.openssl ]
+                   "--libs openssl";
++              postgrest =
++                addStaticLinkerFlagsWithPkgconfig
++                  super.postgrest
++                  [ final.openssl ]
++                  "--libs openssl";
+ 
+               xml-to-json =
+                 addStaticLinkerFlagsWithPkgconfig

nix/static/Cabal.nix

@@ -0,0 +1,90 @@
+{ mkDerivation
+, array
+, base
+, base-compat
+, base-orphans
+, binary
+, bytestring
+, containers
+, deepseq
+, Diff
+, directory
+, filepath
+, integer-logarithms
+, mtl
+, optparse-applicative
+, parsec
+, pretty
+, process
+, QuickCheck
+, stdenv
+, stm
+, tagged
+, tar
+, tasty
+, tasty-golden
+, tasty-hunit
+, tasty-quickcheck
+, temporary
+, text
+, time
+, transformers
+, tree-diff
+, unix
+}:
+mkDerivation {
+  pname = "Cabal";
+  version = "3.0.0.0";
+  sha256 = "5143ec26d740c1a508c93a8860e64407e7546c29b9817db20ff1595c1968d287";
+  setupHaskellDepends = [ mtl parsec ];
+  libraryHaskellDepends = [
+    array
+    base
+    binary
+    bytestring
+    containers
+    deepseq
+    directory
+    filepath
+    mtl
+    parsec
+    pretty
+    process
+    text
+    time
+    transformers
+    unix
+  ];
+  testHaskellDepends = [
+    array
+    base
+    base-compat
+    base-orphans
+    binary
+    bytestring
+    containers
+    deepseq
+    Diff
+    directory
+    filepath
+    integer-logarithms
+    optparse-applicative
+    pretty
+    process
+    QuickCheck
+    stm
+    tagged
+    tar
+    tasty
+    tasty-golden
+    tasty-hunit
+    tasty-quickcheck
+    temporary
+    text
+    tree-diff
+  ];
+  doCheck = false;
+  homepage = "http://www.haskell.org/cabal/";
+  description = "A framework for packaging Haskell software";
+  license = stdenv.lib.licenses.bsd3;
+}

nix/static/default.nix

@@ -0,0 +1,89 @@
+# Turn a Haskell source package (given its name and source) into a derivation
+# for a fully static executable.
+{ nixpkgs, compiler, name, src, patches }:
+let
+  # The nh2/static-haskell-nix project does all the hard work for us for
+  # building static Haskell executables. We apply a patch for PostgREST below
+  # until the respective pull request is merged. See:
+  # https://github.com/nh2/static-haskell-nix/pull/91
+  # statix-haskell-nix builds everything based on Musl instead of glibc, so
+  # there will be a _lot_ to rebuild if you don't use a binary cache.
+  static-haskell-nix =
+    let
+      rev = "749707fc90b781c3e653e67917a7d571fe82ae7b";
+    in
+      builtins.fetchTarball {
+        url = "https://github.com/nh2/static-haskell-nix/archive/${rev}.tar.gz";
+        sha256 = "155spda2lww378bhx68w6dxwqd5y6s9kin3qbgl2m23r3vmk3m3w";
+      };
+
+  patched-static-haskell-nix =
+    patches.applyPatches "patched-static-haskell-nix" static-haskell-nix
+      [
+        patches.static-haskell-nix-postgrest-libpq
+      ];
+
+  haskellPackagesOverrides =
+    lib: final: prev:
+      {
+        # Add our source package.
+        "${name}" = prev.callCabal2nix name src {};
+
+        # cabal2nix depends on Cabal 3.0.*, while our pinned version of Nixpkgs
+        # only provides 2.4 or 3.2. So we pinned 3.0.0.0 in ./Cabal.nix
+        cabal2nix =
+          prev.cabal2nix.overrideScope
+            (self: super: { Cabal = self.callPackage ./Cabal.nix {}; });
+
+        # Pinned version of protolude.
+        protolude =
+          prev.callPackage ../overlays/haskell-packages/protolude.nix {};
+
+        # The tests for the packages below took a long time on static
+        # builds, so we disable them for now - to be investigated.
+        happy = lib.dontCheck prev.happy;
+      };
+
+  # This overlay adds our source package and applies adjustments to the
+  # derivation of other packages that it depends on. The overlay applies to
+  # Haskell packages for the given compiler, which we will later use
+  # with the static-haskell-nix survey.
+  overlay =
+    self: super:
+    # Override the set of Haskell packages at
+    # pkgs.haskell.packages."${compiler}".
+      {
+        haskell = super.haskell // {
+          packages = super.haskell.packages // {
+            "${compiler}" =
+              super.haskell.packages."${compiler}".override
+                { overrides = haskellPackagesOverrides self.haskell.lib; };
+          };
+        };
+      };
+
+  patchedNixpkgs =
+    patches.applyPatches "patched-nixpkgs" nixpkgs
+      [
+        patches.nixpkgs-revert-ghc-bootstrap
+      ];
+
+  # Apply our overlay to the given pkgs.
+  normalPkgs =
+    (import patchedNixpkgs {}).appendOverlays [ overlay ];
+
+  # Each version of GHC needs a specific version of Cabal.
+  defaultCabalPackageVersionComingWithGhc =
+    {
+      ghc883 = "Cabal_3_2_0_0";
+    }."${compiler}";
+
+  # Let the static-haskell-nix project do the hard work of deriving a set of
+  # fully static Haskell executables, including one for the our source package
+  # that we added through the overlay.
+  survey =
+    import "${patched-static-haskell-nix}/survey"
+      { inherit normalPkgs compiler defaultCabalPackageVersionComingWithGhc; };
+in
+  # Return the fully static derivation of our source package.
+survey.haskellPackages."${name}"

nix/style.nix

@@ -0,0 +1,37 @@
+{ writeShellScriptBin
+, git
+, nixpkgs-fmt
+, silver-searcher
+, stylish-haskell
+, buildEnv
+}:
+let
+  style =
+    writeShellScriptBin "postgrest-style"
+      ''
+        set -euo pipefail
+
+        rootdir="$(${git}/bin/git rev-parse --show-toplevel)"
+
+        # Format Nix files
+        ${nixpkgs-fmt}/bin/nixpkgs-fmt "$rootdir" > /dev/null 2> /dev/null
+
+        # Format Haskell files
+        ${silver-searcher}/bin/ag -l -g '\.l?hs$' "$rootdir" \
+          | xargs ${stylish-haskell}/bin/stylish-haskell -i
+      '';
+
+  check =
+    writeShellScriptBin "postgrest-style-check"
+      ''
+        set -euo pipefail
+
+        ${style}/bin/${style.name}
+
+        ${git}/bin/git diff-index --exit-code HEAD -- '*.hs' '*.lhs' '*.nix'
+      '';
+in
+buildEnv {
+  name = "postgrest-style";
+  paths = [ style check ];
+}

nix/tests.nix

@@ -0,0 +1,90 @@
+# Utilities for running the PostgREST test suite
+
+{ buildEnv
+, cabal-install
+, git
+, lib
+, postgrestBuildEnv
+, postgresqlVersions
+, runtimeShell
+, writeShellScript
+, writeShellScriptBin
+}:
+let
+  # Wrap the `test/with_tmp_db` script with the required dependencies from Nix.
+  withTmpDb =
+    postgresql:
+      writeShellScript "postgrest-test-${postgresql.name}"
+        ''
+          set -euo pipefail
+
+          export PATH=${postgresql}/bin:${git}/bin:${runtimeShell}/bin:"$PATH"
+
+          exec ${../test/with_tmp_db} "$@"
+        '';
+
+  # Script to run the Haskell test suite against a specific version of
+  # PostgreSQL.
+  testSpec =
+    name: postgresql:
+      writeShellScriptBin name
+        ''
+          set -euo pipefail
+
+          cat << EOF
+
+          Running spec against ${postgresql.name}...
+
+          EOF
+
+          # TODO: Make this work outside nix-shell when installed with nix-env.
+          # Probably using postgrestBuildEnv somehow?
+          ${withTmpDb postgresql} ${cabal-install}/bin/cabal v2-test \
+            --test-show-detail=direct
+
+          cat << EOF
+
+          Done running spec against ${postgresql.name}.
+
+          EOF
+        '';
+
+  # The PostgreSQL version that we run the tests against by default.
+  defaultPostgresql =
+    builtins.head postgresqlVersions;
+
+  defaultTestSpec =
+    testSpec "postgrest-test-spec" defaultPostgresql;
+
+  # Create a `testSpec` for each PostgreSQL version that we want to test
+  # against.
+  testSpecVersions =
+    map
+      (postgresql: testSpec "postgrest-test-spec-${postgresql.name}" postgresql)
+      postgresqlVersions;
+
+  # Helper script for running the tests against all PostgreSQL versions.
+  testSpecAllVersions =
+    let
+      testRunners =
+        map (test: "${test}/bin/${test.name}") testSpecVersions;
+    in
+      writeShellScriptBin "postgrest-test-spec-all"
+        ''
+          set -euo pipefail
+
+          ${lib.concatStringsSep "\n" testRunners}
+        '';
+in
+  # Create an environment that contains all the utility scripts for running tests
+  # that we defined above.
+buildEnv {
+  name =
+    "postgrest-tests";
+
+  paths =
+    [
+      defaultTestSpec
+      testSpecAllVersions
+    ] ++ testSpecVersions;
+}

postgrest.cabal

@@ -1,207 +1,240 @@
-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.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
-build-type:            Simple
-cabal-version:         >=1.10
+name:               postgrest
+version:            7.0.1
+synopsis:           REST API for any Postgres database
+description:        Reads the schema of a PostgreSQL database and creates RESTful routes
+                    for the tables and views, supporting all HTTP verbs that security
+                    permits.
+license:            MIT
+license-file:       LICENSE
+author:             Joe Nelson, Adam Baker, Steve Chavez
+maintainer:         Steve Chavez <stevechavezast@gmail.com>
+category:           Executable, PostgreSQL, Network APIs
+homepage:           https://postgrest.org
+bug-reports:        https://github.com/PostgREST/postgrest/issues
+build-type:         Simple
+extra-source-files: CHANGELOG.md
+cabal-version:      >= 1.10
+
 source-repository head
-  type: git
-  location: git://github.com/begriffs/postgrest.git
+  type:     git
+  location: git://github.com/PostgREST/postgrest.git
 
-Flag CI
-  Description: No warnings allowed in continuous integration
-  Manual:      True
-  Default:     False
-
-executable postgrest
-  if flag(ci)
-    ghc-options:       -Wall -W -Werror
-  else
-    ghc-options:       -Wall -W -O2
-
-  main-is:             PostgREST/Main.hs
-  default-extensions:  OverloadedStrings, ScopedTypeVariables, QuasiQuotes
-  default-language:    Haskell2010
-  build-depends:       base >= 4.8 && < 5
-                     , postgrest
-                     , hasql >= 0.7.3 && < 0.8
-                     , hasql-backend >= 0.4.1 && < 0.5
-                     , hasql-postgres >= 0.10.4 && < 0.11
-                     , warp >= 3.0.2, wai >= 3.0.1
-                     , wai-extra, wai-cors
-                     , wai-middleware-static >= 0.6.0
-                     , HTTP, convertible, http-types
-                     , case-insensitive
-                     , scientific, time
-                     , aeson >= 0.8, network >= 2.6
-                     , aeson-pretty >= 0.7 && < 0.8
-                     , bytestring, text, split, string-conversions
-                     , stringsearch
-                     , containers, unordered-containers
-                     , optparse-applicative >= 0.11 && < 0.13
-                     , regex-base, regex-tdfa
-                     , Ranged-sets
-                     , transformers, MissingH
-                     , bcrypt >= 0.0.6, base64-string
-                     , network-uri >= 2.6
-                     , resource-pool
-                     , blaze-builder
-                     , vector
-                     , mtl
-                     , cassava
-                     , jwt
-                     , parsec
-                     , errors
-                     , bifunctors
-  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
+flag ci
+  default:     False
+  manual:      True
+  description: No warnings allowed in continuous integration
 
 library
-  if flag(ci)
-    ghc-options:       -Wall -W -Werror
-  else
-    ghc-options:       -Wall -W -O2
+  exposed-modules:    PostgREST.ApiRequest
+                      PostgREST.App
+                      PostgREST.Auth
+                      PostgREST.Config
+                      PostgREST.DbRequestBuilder
+                      PostgREST.DbStructure
+                      PostgREST.Error
+                      PostgREST.Middleware
+                      PostgREST.OpenAPI
+                      PostgREST.Parsers
+                      PostgREST.QueryBuilder
+                      PostgREST.Statements
+                      PostgREST.RangeQuery
+                      PostgREST.Types
+  other-modules:      Paths_postgrest
+                      PostgREST.Private.Common
+                      PostgREST.Private.QueryFragment
+  hs-source-dirs:     src
+  build-depends:      base                      >= 4.9 && < 4.15
+                    , HTTP                      >= 4000.3.7 && < 4000.4
+                    , Ranged-sets               >= 0.3 && < 0.5
+                    , aeson                     >= 1.4.7 && < 1.5
+                    , ansi-wl-pprint            >= 0.6.7 && < 0.7
+                    , base64-bytestring         >= 1 && < 1.2
+                    , bytestring                >= 0.10.8 && < 0.11
+                    , case-insensitive          >= 1.2 && < 1.3
+                    , cassava                   >= 0.4.5 && < 0.6
+                    , configurator-pg           >= 0.2 && < 0.3
+                    , containers                >= 0.5.7 && < 0.7
+                    , contravariant             >= 1.4 && < 1.6
+                    , contravariant-extras      >= 0.3.3 && < 0.4
+                    , cookie                    >= 0.4.2 && < 0.5
+                    , either                    >= 4.4.1 && < 5.1
+                    , gitrev                    >= 1.2 && < 1.4
+                    , hasql                     >= 1.4 && < 1.5
+                    , hasql-pool                >= 0.5 && < 0.6
+                    , hasql-transaction         >= 0.7.2 && < 1.1
+                    , heredoc                   >= 0.2 && < 0.3
+                    , http-types                >= 0.12.2 && < 0.13
+                    , insert-ordered-containers >= 0.2.2 && < 0.3
+                    , interpolatedstring-perl6  >= 1 && < 1.1
+                    , jose                      >= 0.8.1 && < 0.9
+                    , lens                      >= 4.14 && < 4.20
+                    , lens-aeson                >= 1.0.1 && < 1.2
+                    , network-uri               >= 2.6.1 && < 2.8
+                    , optparse-applicative      >= 0.13 && < 0.16
+                    , parsec                    >= 3.1.11 && < 3.2
+                    , protolude                 >= 0.3 && < 0.4
+                    , regex-tdfa                >= 1.2.2 && < 1.4
+                    , scientific                >= 0.3.4 && < 0.4
+                    , swagger2                  >= 2.4 && < 2.7
+                    , text                      >= 1.2.2 && < 1.3
+                    , time                      >= 1.6 && < 1.11
+                    , unordered-containers      >= 0.2.8 && < 0.3
+                    , vector                    >= 0.11 && < 0.13
+                    , wai                       >= 3.2.1 && < 3.3
+                    , wai-cors                  >= 0.2.5 && < 0.3
+                    , wai-extra                 >= 3.0.19 && < 3.1
+                    , wai-middleware-static     >= 0.8.1 && < 0.9
+  default-language:   Haskell2010
+  default-extensions: OverloadedStrings
+                      QuasiQuotes
+                      NoImplicitPrelude
+  ghc-options:        -O2 -Werror -Wall -fwarn-identities
+                      -fno-spec-constr -optP-Wno-nonportable-include-path
+          -- -fno-spec-constr may help keep compile time memory use in check,
+          --   see https://gitlab.haskell.org/ghc/ghc/issues/16017#note_219304
+          -- -optP-Wno-nonportable-include-path
+          --   prevents build failures on case-insensitive filesystems (macos),
+          --   see https://github.com/commercialhaskell/stack/issues/3918
 
-  default-language:    Haskell2010
-  default-extensions:  OverloadedStrings, ScopedTypeVariables, QuasiQuotes
-  build-depends:       HTTP
-                     , MissingH
-                     , Ranged-sets
-                     , aeson
-                     , base >=4.6 && <5
-                     , base64-string
-                     , bcrypt
-                     , bifunctors
-                     , blaze-builder
-                     , bytestring
-                     , case-insensitive
-                     , cassava
-                     , containers
-                     , convertible
-                     , errors
-                     , hasql
-                     , hasql-backend
-                     , hasql-postgres
-                     , http-types
-                     , jwt
-                     , mtl
-                     , network
-                     , network-uri
-                     , optparse-applicative
-                     , parsec
-                     , regex-base
-                     , regex-tdfa
-                     , resource-pool
-                     , scientific
-                     , split
-                     , string-conversions
-                     , stringsearch
-                     , text
-                     , time
-                     , transformers
-                     , unordered-containers
-                     , vector
-                     , wai
-                     , wai-cors
-                     , wai-extra
-                     , wai-middleware-static
-                     , warp
+executable postgrest
+  main-is:            Main.hs
+  hs-source-dirs:     main
+  build-depends:      base              >= 4.9 && < 4.15
+                    , auto-update       >= 0.1.4 && < 0.2
+                    , base64-bytestring >= 1 && < 1.2
+                    , bytestring        >= 0.10.8 && < 0.11
+                    , directory         >= 1.2.6 && < 1.4
+                    , either            >= 4.4.1 && < 5.1
+                    , hasql             >= 1.4 && < 1.5
+                    , hasql-pool        >= 0.5 && < 0.6
+                    , hasql-transaction >= 0.7.2 && < 1.1
+                    , network           < 3.2
+                    , postgrest
+                    , protolude         >= 0.3 && < 0.4
+                    , retry             >= 0.7.4 && < 0.9
+                    , text              >= 1.2.2 && < 1.3
+                    , time              >= 1.6 && < 1.11
+                    , wai               >= 3.2.1 && < 3.3
+                    , warp              >= 3.2.12 && < 3.4
+  default-language:   Haskell2010
+  default-extensions: OverloadedStrings
+                      QuasiQuotes
+                      NoImplicitPrelude
+  ghc-options:        -threaded -rtsopts "-with-rtsopts=-N -I2"
+                      -O2 -Werror -Wall -fwarn-identities
+                      -fno-spec-constr -optP-Wno-nonportable-include-path
 
-  Other-Modules:       Paths_postgrest
-  Exposed-Modules:     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:      src
+  if !os(windows)
+    build-depends: unix
+    other-modules: UnixSocket
 
-Test-Suite spec
+test-suite spec
+  type:               exitcode-stdio-1.0
+  main-is:            Main.hs
+  other-modules:      Feature.AndOrParamsSpec
+                      Feature.AsymmetricJwtSpec
+                      Feature.AudienceJwtSecretSpec
+                      Feature.AuthSpec
+                      Feature.BinaryJwtSecretSpec
+                      Feature.ConcurrentSpec
+                      Feature.CorsSpec
+                      Feature.DeleteSpec
+                      Feature.EmbedDisambiguationSpec
+                      Feature.ExtraSearchPathSpec
+                      Feature.InsertSpec
+                      Feature.JsonOperatorSpec
+                      Feature.NoJwtSpec
+                      Feature.NonexistentSchemaSpec
+                      Feature.PgVersion95Spec
+                      Feature.PgVersion96Spec
+                      Feature.ProxySpec
+                      Feature.QueryLimitedSpec
+                      Feature.QuerySpec
+                      Feature.RangeSpec
+                      Feature.RootSpec
+                      Feature.RpcSpec
+                      Feature.SingularSpec
+                      Feature.StructureSpec
+                      Feature.UnicodeSpec
+                      Feature.UpsertSpec
+                      Feature.RawOutputTypesSpec
+                      Feature.HtmlRawOutputSpec
+                      Feature.MultipleSchemaSpec
+                      SpecHelper
+                      TestTypes
+  hs-source-dirs:     test
+  build-depends:      base              >= 4.9 && < 4.15
+                    , aeson             >= 1.4.7 && < 1.5
+                    , aeson-qq          >= 0.8.1 && < 0.9
+                    , async             >= 2.1.1 && < 2.3
+                    , auto-update       >= 0.1.4 && < 0.2
+                    , base64-bytestring >= 1 && < 1.2
+                    , bytestring        >= 0.10.8 && < 0.11
+                    , case-insensitive  >= 1.2 && < 1.3
+                    , cassava           >= 0.4.5 && < 0.6
+                    , containers        >= 0.5.7 && < 0.7
+                    , contravariant     >= 1.4 && < 1.6
+                    , hasql             >= 1.4 && < 1.5
+                    , hasql-pool        >= 0.5 && < 0.6
+                    , hasql-transaction >= 0.7.2 && < 1.1
+                    , heredoc           >= 0.2 && < 0.3
+                    , hspec             >= 2.3 && < 2.8
+                    , hspec-wai         >= 0.10 && < 0.11
+                    , hspec-wai-json    >= 0.10 && < 0.11
+                    , http-types        >= 0.12.3 && < 0.13
+                    , lens              >= 4.14 && < 4.20
+                    , lens-aeson        >= 1.0.1 && < 1.2
+                    , monad-control     >= 1.0.1 && < 1.1
+                    , postgrest
+                    , process           >= 1.4.2 && < 1.7
+                    , protolude         >= 0.3 && < 0.4
+                    , regex-tdfa        >= 1.2.2 && < 1.4
+                    , text              >= 1.2.2 && < 1.3
+                    , time              >= 1.6 && < 1.11
+                    , transformers-base >= 0.4.4 && < 0.5
+                    , wai               >= 3.2.1 && < 3.3
+                    , wai-extra         >= 3.0.19 && < 3.1
+  default-language:   Haskell2010
+  default-extensions: OverloadedStrings
+                      QuasiQuotes
+                      NoImplicitPrelude
+  ghc-options:        -threaded -rtsopts -with-rtsopts=-N
+
+Test-Suite spec-querycost
   Type:                exitcode-stdio-1.0
   Default-Language:    Haskell2010
-  default-extensions:  OverloadedStrings, ScopedTypeVariables, QuasiQuotes
-  Hs-Source-Dirs:      test, src
-  if flag(ci)
-    ghc-options:       -Wall -W -Werror
-  else
-    ghc-options:       -Wall -W -O2
-  Main-Is:             Main.hs
-  Other-Modules:       Feature.AuthSpec
-                     , Feature.CorsSpec
-                     , Feature.DeleteSpec
-                     , Feature.InsertSpec
-                     , Feature.QuerySpec
-                     , Feature.RangeSpec
-                     , 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
-                     , Spec
-                     , SpecHelper
-                     , TestTypes
-  Build-Depends:       base, hspec == 2.2.*, QuickCheck
-                     , hspec-wai, hspec-wai-json
-                     , hasql, hasql-backend
-                     , hasql-postgres
-                     , warp, wai
-                     , packdeps, hlint
-                     , HTTP, convertible
-                     , case-insensitive
-                     , wai-extra, wai-cors, containers
-                     , wai-middleware-static
-                     , http-types, scientific, time
-                     , bytestring, aeson, network
-                     , text, optparse-applicative
-                     , stringsearch
-                     , unordered-containers
-                     , regex-base
-                     , string-conversions
-                     , http-media, regex-tdfa
-                     , Ranged-sets
-                     , transformers, MissingH, split
-                     , bcrypt, base64-string
-                     , network-uri
-                     , resource-pool
-                     , blaze-builder
-                     , vector
-                     , mtl
-                     , cassava
-                     , process
-                     , heredoc
-                     , jwt
-                     , parsec
-                     , errors
-                     , bifunctors
+  default-extensions:  OverloadedStrings, QuasiQuotes, NoImplicitPrelude
+  Hs-Source-Dirs:      test
+  Main-Is:             QueryCost.hs
+  Other-Modules:       SpecHelper
+  Build-Depends:       base              >= 4.9 && < 4.15
+                     , aeson             >= 1.4.7 && < 1.5
+                     , aeson-qq          >= 0.8.1 && < 0.9
+                     , async             >= 2.1.1 && < 2.3
+                     , auto-update       >= 0.1.4 && < 0.2
+                     , base64-bytestring >= 1 && < 1.2
+                     , bytestring        >= 0.10.8 && < 0.11
+                     , case-insensitive  >= 1.2 && < 1.3
+                     , cassava           >= 0.4.5 && < 0.6
+                     , containers        >= 0.5.7 && < 0.7
+                     , contravariant     >= 1.4 && < 1.6
+                     , hasql             >= 1.4 && < 1.5
+                     , hasql-pool        >= 0.5 && < 0.6
+                     , hasql-transaction >= 0.7.2 && < 1.1
+                     , heredoc           >= 0.2 && < 0.3
+                     , hspec             >= 2.3 && < 2.8
+                     , hspec-wai         >= 0.10 && < 0.11
+                     , hspec-wai-json    >= 0.10 && < 0.11
+                     , http-types        >= 0.12.3 && < 0.13
+                     , lens              >= 4.14 && < 4.20
+                     , lens-aeson        >= 1.0.1 && < 1.2
+                     , monad-control     >= 1.0.1 && < 1.1
+                     , postgrest
+                     , process           >= 1.4.2 && < 1.7
+                     , protolude         >= 0.3 && < 0.4
+                     , regex-tdfa        >= 1.2.2 && < 1.4
+                     , text              >= 1.2.2 && < 1.3
+                     , time              >= 1.6 && < 1.11
+                     , transformers-base >= 0.4.4 && < 0.5
+                     , wai               >= 3.2.1 && < 3.3
+                     , wai-extra         >= 3.0.19 && < 3.1

schema-templates/blog.sql

@@ -1,378 +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 noinherit;
-create role author;
-
-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,
-  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,
-  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 author 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;

scripts/release_s3.sh

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

shell.nix

@@ -0,0 +1,23 @@
+with (import ./default.nix);
+pkgs.lib.overrideDerivation env (
+  base: {
+    buildInputs =
+      base.buildInputs ++ [
+        pkgs.cabal-install
+        pkgs.stack
+        pkgs.cabal2nix
+        pkgs.postgresql
+        nixpkgsUpgrade
+        tests
+        style
+        lint
+      ];
+
+    shellHook =
+      ''
+        # Set our pinned version of Nixpkgs in the NIX_PATH so that
+        # `stack --nix` also uses that version.
+        NIX_PATH="nixpkgs=${nixpkgs}"
+      '';
+  }
+)

src/PostgREST/ApiRequest.hs

@@ -1,43 +1,72 @@
-module PostgREST.ApiRequest where
+{-|
+Module      : PostgREST.ApiRequest
+Description : PostgREST functions to translate HTTP request to a domain type called ApiRequest.
+-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE MultiWayIf #-}
 
-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(..))
+module PostgREST.ApiRequest (
+  ApiRequest(..)
+, InvokeMethod(..)
+, ContentType(..)
+, Action(..)
+, Target(..)
+, mutuallyAgreeable
+, userApiRequest
+) where
+
+import qualified Data.Aeson           as JSON
+import qualified Data.ByteString      as BS
+import qualified Data.ByteString.Lazy as BL
+import qualified Data.CaseInsensitive as CI
+import qualified Data.Csv             as CSV
+import qualified Data.HashMap.Strict  as M
+import qualified Data.List            as L
+import qualified Data.Set             as S
+import qualified Data.Text            as T
+import qualified Data.Vector          as V
+
+import Control.Arrow             ((***))
+import Data.Aeson.Types          (emptyArray, emptyObject)
+import Data.List                 (last, lookup, partition)
+import Data.List.NonEmpty        (head)
+import Data.Maybe                (fromJust)
+import Data.Ranged.Ranges        (Range (..), emptyRange,
+                                  rangeIntersection)
+import Network.HTTP.Base         (urlEncodeVars)
+import Network.HTTP.Types.Header (hAuthorization, hCookie)
+import Network.HTTP.Types.URI    (parseQueryReplacePlus,
+                                  parseSimpleQuery)
+import Network.Wai               (Request (..))
+import Network.Wai.Parse         (parseHttpAccept)
+import Web.Cookie                (parseCookiesText)
+
+
+import Data.Ranged.Boundaries
+
+import PostgREST.Error      (ApiRequestError (..))
+import PostgREST.RangeQuery (NonnegRange, allRange, rangeGeq,
+                             rangeLimit, rangeOffset, rangeRequested,
+                             restrictRange)
+import PostgREST.Types
+import Protolude            hiding (head, toS)
+import Protolude.Conv       (toS)
 
 type RequestBody = BL.ByteString
 
+data InvokeMethod = InvHead | InvGet | InvPost deriving Eq
 -- | Types of things a user wants to do to tables/views/procs
-data Action = ActionCreate | ActionRead
-            | ActionUpdate | ActionDelete
-            | ActionInfo   | ActionInvoke
-            | ActionUnknown BS.ByteString deriving Eq
+data Action = ActionCreate       | ActionRead{isHead :: Bool}
+            | ActionUpdate       | ActionDelete
+            | ActionSingleUpsert | ActionInvoke InvokeMethod
+            | ActionInfo         | ActionInspect{isHead :: Bool}
+            deriving Eq
 -- | The target db object of a user action
 data Target = TargetIdent QualifiedIdentifier
-            | TargetRoot
-            | TargetUnknown [T.Text]
--- | 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"
+            | TargetProc{tpQi :: QualifiedIdentifier, tpIsRootSpec :: Bool}
+            | TargetDefaultSpec{tdsSchema :: Schema} -- The default spec offered at root "/"
+            | TargetUnknown [Text]
+            deriving Eq
 
 {-|
   Describes what the user wants to do. This data type is a
@@ -47,125 +76,227 @@ instance Show ContentType where
   if it is an action we are able to perform.
 -}
 data ApiRequest = ApiRequest {
-  -- | Set to Nothing for unknown HTTP verbs
-    iAction :: Action
-  -- | Set to Nothing for malformed range
-  , iRange  :: Maybe NonnegRange
-  -- | Set to Nothing for strangely nested urls
-  , iTarget :: Target
-  -- | The content type the client most desires (or JSON if undecided)
-  , iAccepts :: Either BS.ByteString ContentType
-  -- | Data sent by client and used for mutation actions
-  , iPayload :: Maybe Payload
-  -- | If client wants created items echoed back
-  , iPreferRepresentation :: Bool
-  -- | If client wants first row as raw object
-  , iPreferSingular :: Bool
-  -- | Whether the client wants a result count (slower)
-  , iPreferCount :: Bool
-  -- | Filters on the result ("id", "eq.10")
-  , iFilters :: [(String, String)]
-  -- | &select parameter used to shape the response
-  , iSelect :: String
-  -- | &order parameter
-  , iOrder :: Maybe String
+    iAction               :: Action                           -- ^ Similar but not identical to HTTP verb, e.g. Create/Invoke both POST
+  , iRange                :: M.HashMap ByteString NonnegRange -- ^ Requested range of rows within response
+  , iTopLevelRange        :: NonnegRange                      -- ^ Requested range of rows from the top level
+  , iTarget               :: Target                           -- ^ The target, be it calling a proc or accessing a table
+  , iAccepts              :: [ContentType]                    -- ^ Content types the client will accept, [CTAny] if no Accept header
+  , iPayload              :: Maybe PayloadJSON                -- ^ Data sent by client and used for mutation actions
+  , iPreferRepresentation :: PreferRepresentation             -- ^ If client wants created items echoed back
+  , iPreferParameters     :: Maybe PreferParameters           -- ^ How to pass parameters to a stored procedure
+  , iPreferCount          :: Maybe PreferCount                -- ^ Whether the client wants a result count
+  , iPreferResolution     :: Maybe PreferResolution           -- ^ Whether the client wants to UPSERT or ignore records on PK conflict
+  , iFilters              :: [(Text, Text)]                   -- ^ Filters on the result ("id", "eq.10")
+  , iLogic                :: [(Text, Text)]                   -- ^ &and and &or parameters used for complex boolean logic
+  , iSelect               :: Maybe Text                       -- ^ &select parameter used to shape the response
+  , iOnConflict           :: Maybe Text                       -- ^ &on_conflict parameter used to upsert on specific unique keys
+  , iColumns              :: Maybe Text                       -- ^ &columns parameter used to shape the payload
+  , iOrder                :: [(Text, Text)]                   -- ^ &order parameters for each level
+  , iCanonicalQS          :: ByteString                       -- ^ Alphabetized (canonical) request query string for response URLs
+  , iJWT                  :: Text                             -- ^ JSON Web Token
+  , iHeaders              :: [(Text, Text)]                   -- ^ HTTP request headers
+  , iCookies              :: [(Text, Text)]                   -- ^ Request Cookies
+  , iPath                 :: ByteString                       -- ^ Raw request path
+  , iMethod               :: ByteString                       -- ^ Raw request method
+  , iProfile              :: Maybe Schema                     -- ^ The request profile for enabling use of multiple schemas. Follows the spec in hhttps://www.w3.org/TR/dx-prof-conneg/ttps://www.w3.org/TR/dx-prof-conneg/.
+  , iSchema               :: Schema                           -- ^ The request schema. Can vary depending on iProfile.
   }
 
 -- | Examines HTTP request and translates it into user intent.
-userApiRequest :: Schema -> Request -> RequestBody -> ApiRequest
-userApiRequest schema req reqBody =
-  let action = case method of
-                 "GET"     -> ActionRead
-                 "POST"    -> if isTargetingProc
-                                then ActionInvoke
-                                else ActionCreate
-                 "PATCH"   -> ActionUpdate
-                 "DELETE"  -> ActionDelete
-                 "OPTIONS" -> ActionInfo
-                 other     -> ActionUnknown other
-      target = case path of
-                 []            -> TargetRoot
-                 [table]       -> TargetIdent
-                                  $ QualifiedIdentifier schema table
-                 ["rpc", proc] -> TargetIdent
-                                  $ 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 Nothing else rangeRequested hdrs
-  , iTarget = target
-  , iAccepts = pickContentType $ lookupHeader "accept"
-  , iPayload = relevantPayload
-  , iPreferRepresentation = hasPrefer "return=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 :: NonEmpty Schema -> Maybe Text -> Request -> RequestBody -> Either ApiRequestError ApiRequest
+userApiRequest confSchemas rootSpec req reqBody
+  | isJust profile && fromJust profile `notElem` confSchemas = Left $ UnacceptableSchema $ toList confSchemas
+  | isTargetingProc && method `notElem` ["HEAD", "GET", "POST"] = Left ActionInappropriate
+  | topLevelRange == emptyRange = Left InvalidRange
+  | shouldParsePayload && isLeft payload = either (Left . InvalidBody . toS) witness payload
+  | otherwise = Right ApiRequest {
+      iAction = action
+      , iTarget = target
+      , iRange = ranges
+      , iTopLevelRange = topLevelRange
+      , iAccepts = maybe [CTAny] (map decodeContentType . parseHttpAccept) $ lookupHeader "accept"
+      , iPayload = relevantPayload
+      , iPreferRepresentation = representation
+      , iPreferParameters = if | hasPrefer (show SingleObject)     -> Just SingleObject
+                               | hasPrefer (show MultipleObjects)  -> Just MultipleObjects
+                               | otherwise                         -> Nothing
+      , iPreferCount      = if | hasPrefer (show ExactCount)     -> Just ExactCount
+                               | hasPrefer (show PlannedCount)   -> Just PlannedCount
+                               | hasPrefer (show EstimatedCount) -> Just EstimatedCount
+                               | otherwise                         -> Nothing
+      , iPreferResolution = if | hasPrefer (show MergeDuplicates)  -> Just MergeDuplicates
+                               | hasPrefer (show IgnoreDuplicates) -> Just IgnoreDuplicates
+                               | otherwise                         -> Nothing
+      , iFilters = filters
+      , iLogic = [(toS k, toS $ fromJust v) | (k,v) <- qParams, isJust v, endingIn ["and", "or"] k ]
+      , iSelect = toS <$> join (lookup "select" qParams)
+      , iOnConflict = toS <$> join (lookup "on_conflict" qParams)
+      , iColumns = columns
+      , iOrder = [(toS k, toS $ fromJust v) | (k,v) <- qParams, isJust v, endingIn ["order"] k ]
+      , iCanonicalQS = toS $ urlEncodeVars
+        . L.sortOn fst
+        . map (join (***) toS . second (fromMaybe BS.empty))
+        $ qString
+      , iJWT = tokenStr
+      , iHeaders = [ (toS $ CI.foldedCase k, toS v) | (k,v) <- hdrs, k /= hCookie]
+      , iCookies = maybe [] parseCookiesText $ lookupHeader "Cookie"
+      , iPath = rawPathInfo req
+      , iMethod = method
+      , iProfile = profile
+      , iSchema = schema
+      }
  where
+  -- queryString with '+' converted to ' '(space)
+  qString = parseQueryReplacePlus True $ rawQueryString req
+  -- rpcQParams = Rpc query params e.g. /rpc/name?param1=val1, similar to filter but with no operator(eq, lt..)
+  (filters, rpcQParams) =
+    case action of
+      ActionInvoke InvGet  -> partitionFlts
+      ActionInvoke InvHead -> partitionFlts
+      _                    -> (flts, [])
+  partitionFlts = partition (liftM2 (||) (isEmbedPath . fst) (hasOperator . snd)) flts
+  flts =
+    [ (toS k, toS $ fromJust v) |
+      (k,v) <- qParams, isJust v,
+      k `notElem` ["select", "columns"],
+      not (endingIn ["order", "limit", "offset", "and", "or"] k) ]
+  hasOperator val = any (`T.isPrefixOf` val) $
+                      ((<> ".") <$> "not":M.keys operators) ++
+                      ((<> "(") <$> M.keys ftsOperators)
+  isEmbedPath = T.isInfixOf "."
+  isTargetingProc = case target of
+    TargetProc _ _ -> True
+    _              -> False
+  isTargetingDefaultSpec = case target of
+    TargetDefaultSpec _ -> True
+    _                   -> False
+  contentType = decodeContentType . fromMaybe "application/json" $ lookupHeader "content-type"
+  columns
+    | action `elem` [ActionCreate, ActionUpdate, ActionInvoke InvPost] = toS <$> join (lookup "columns" qParams)
+    | otherwise = Nothing
+  payload =
+    case (contentType, action) of
+      (_, ActionInvoke InvGet)  -> Right rpcPrmsToJson
+      (_, ActionInvoke InvHead) -> Right rpcPrmsToJson
+      (CTApplicationJSON, _) ->
+        if isJust columns
+          then Right $ RawJSON reqBody
+          else note "All object keys must match" . payloadAttributes reqBody
+                 =<< if BL.null reqBody && isTargetingProc
+                       then Right emptyObject
+                       else JSON.eitherDecode reqBody
+      (CTTextCSV, _) -> do
+        json <- csvToJson <$> CSV.decodeByName reqBody
+        note "All lines must have same number of fields" $ payloadAttributes (JSON.encode json) json
+      (CTOther "application/x-www-form-urlencoded", _) ->
+        let json = M.fromList . map (toS *** JSON.String . toS) . parseSimpleQuery $ toS reqBody
+            keys = S.fromList $ M.keys json in
+        Right $ ProcessedJSON (JSON.encode json) keys
+      (ct, _) ->
+        Left $ toS $ "Content-Type not acceptable: " <> toMime ct
+  rpcPrmsToJson = ProcessedJSON (JSON.encode $ M.fromList $ second JSON.toJSON <$> rpcQParams) (S.fromList $ fst <$> rpcQParams)
+  topLevelRange = fromMaybe allRange $ M.lookup "limit" ranges -- if no limit is specified, get all the request rows
+  action =
+    case method of
+      -- The HEAD method is identical to GET except that the server MUST NOT return a message-body in the response
+      -- From https://www.w3.org/Protocols/rfc2616/rfc2616-sec9.html#sec9.4
+      "HEAD"     | isTargetingDefaultSpec -> ActionInspect{isHead=True}
+                 | isTargetingProc        -> ActionInvoke InvHead
+                 | otherwise              -> ActionRead{isHead=True}
+      "GET"      | isTargetingDefaultSpec -> ActionInspect{isHead=False}
+                 | isTargetingProc        -> ActionInvoke InvGet
+                 | otherwise              -> ActionRead{isHead=False}
+      "POST"    -> if isTargetingProc
+                    then ActionInvoke InvPost
+                    else ActionCreate
+      "PATCH"   -> ActionUpdate
+      "PUT"     -> ActionSingleUpsert
+      "DELETE"  -> ActionDelete
+      "OPTIONS" -> ActionInfo
+      _         -> ActionInspect{isHead=False}
+
+  defaultSchema = head confSchemas
+  profile
+    | length confSchemas <= 1 -- only enable content negotiation by profile when there are multiple schemas specified in the config
+      = Nothing
+    | action `elem` [ActionCreate, ActionUpdate, ActionSingleUpsert, ActionDelete, ActionInvoke InvPost] -- POST/PATCH/PUT/DELETE don't use the same header as per the spec
+      = Just $ maybe defaultSchema toS $ lookupHeader "Content-Profile"
+    | action `elem` [ActionRead True, ActionRead False, ActionInvoke InvGet, ActionInvoke InvHead,
+                     ActionInspect False, ActionInspect True, ActionInfo]
+      = Just $ maybe defaultSchema toS $ lookupHeader "Accept-Profile"
+    | otherwise = Nothing
+  schema = fromMaybe defaultSchema profile
+  target = case path of
+    []            -> case rootSpec of
+                       Just pName -> TargetProc (QualifiedIdentifier schema pName) True
+                       Nothing    -> TargetDefaultSpec schema
+    [table]       -> TargetIdent $ QualifiedIdentifier schema table
+    ["rpc", proc] -> TargetProc (QualifiedIdentifier schema proc) False
+    other         -> TargetUnknown other
+
+  shouldParsePayload =
+    action `elem`
+    [ActionCreate, ActionUpdate, ActionSingleUpsert,
+    ActionInvoke InvPost,
+    -- Though ActionInvoke{isGet=True}(a GET /rpc/..) doesn't really have a payload, we use the payload variable as a way
+    -- to store the query string arguments to the function.
+    ActionInvoke InvGet,
+    ActionInvoke InvHead]
+  relevantPayload | shouldParsePayload = rightToMaybe payload
+                  | otherwise = Nothing
   path            = pathInfo req
   method          = requestMethod req
-  isTargetingProc = fromMaybe False $ (== "rpc") <$> listToMaybe path
   hdrs            = requestHeaders req
-  qParams         = [(cs k, cs <$> v)|(k,v) <- queryString req]
+  qParams         = [(toS k, v)|(k,v) <- qString]
   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
+  representation
+    | hasPrefer (show Full) = Full
+    | hasPrefer (show None) = None
+    | otherwise             = if action == ActionCreate
+                                then HeadersOnly -- Assume the user wants the Location header(for POST) by default
+                                else None
+  auth = fromMaybe "" $ lookupHeader hAuthorization
+  tokenStr = case T.split (== ' ') (toS auth) of
+    ("Bearer" : t : _) -> t
+    _                  -> ""
+  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), maybe allRange rangeGeq (readMaybe =<< (toS <$> v))) | (k,v) <- qParams, isJust v, endingIn ["offset"] k]
 
-
--- PRIVATE ---------------------------------------------------------------
+  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
 
 {-|
-  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
+  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.
 -}
-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
+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
 
-type CsvData = V.Vector (M.HashMap T.Text BL.ByteString)
+type CsvData = V.Vector (M.HashMap Text BL.ByteString)
 
 {-|
   Converts CSV like
@@ -179,38 +310,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 $ ProcessedJSON raw 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 $ ProcessedJSON raw (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 = ProcessedJSON (JSON.encode emptyArray) S.empty

src/PostgREST/App.hs

@@ -1,334 +1,419 @@
+{-|
+Module      : PostgREST.App
+Description : PostgREST main application
+
+This module is in charge of mapping HTTP requests to PostgreSQL queries.
+Some of its functionality includes:
+
+- Mapping HTTP request methods to proper SQL statements. For example, a GET request is translated to executing a SELECT query in a read-only TRANSACTION.
+- Producing HTTP Headers according to RFCs.
+- Content Negotiation
+-}
 {-# LANGUAGE FlexibleContexts    #-}
+{-# LANGUAGE MultiWayIf          #-}
+{-# LANGUAGE NamedFieldPuns      #-}
 {-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TupleSections #-}
---module PostgREST.App where
+
 module PostgREST.App (
-  app
+  postgrest
 ) where
 
-import           Control.Applicative
-import           Control.Arrow             ((***))
-import           Control.Monad             (join)
-import           Data.Bifunctor            (first)
-import qualified Data.ByteString.Lazy      as BL
-import           Data.Functor.Identity
-import           Data.List                 (find, sortBy, delete)
-import           Data.Maybe                (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 qualified Data.ByteString.Char8      as BS
+import qualified Data.HashMap.Strict        as M
+import qualified Data.List                  as L (union)
+import qualified Data.Set                   as S
+import qualified Hasql.Pool                 as P
+import qualified Hasql.Transaction          as H
+import qualified Hasql.Transaction          as HT
+import qualified Hasql.Transaction.Sessions as HT
 
-import           Text.Parsec.Error
-import           Text.ParserCombinators.Parsec (parse)
+import Data.Function                        (id)
+import Data.IORef                           (IORef, readIORef)
+import Data.Time.Clock                      (UTCTime)
+import Network.HTTP.Types.URI               (renderSimpleQuery)
+import Network.Wai.Middleware.RequestLogger (logStdout)
 
-import           Network.HTTP.Base         (urlEncodeVars)
-import           Network.HTTP.Types.Header
-import           Network.HTTP.Types.Status
-import           Network.HTTP.Types.URI    (parseSimpleQuery)
-import           Network.Wai
+import Control.Applicative
+import Data.Maybe
+import Network.HTTP.Types.Header
+import Network.HTTP.Types.Status
+import Network.Wai
 
-import           Data.Aeson
-import           Data.Aeson.Types (emptyArray)
-import           Data.Monoid
-import qualified Data.Vector               as V
-import qualified Hasql                     as H
-import qualified Hasql.Backend             as B
-import qualified Hasql.Postgres            as P
+import PostgREST.ApiRequest       (Action (..), ApiRequest (..),
+                                   InvokeMethod (..), Target (..),
+                                   mutuallyAgreeable, userApiRequest)
+import PostgREST.Auth             (containsRole, jwtClaims,
+                                   parseSecret)
+import PostgREST.Config           (AppConfig (..))
+import PostgREST.DbRequestBuilder (mutateRequest, readRequest,
+                                   returningCols)
+import PostgREST.DbStructure
+import PostgREST.Error            (PgError (..), SimpleError (..),
+                                   errorResponseFor, singularityError)
+import PostgREST.Middleware
+import PostgREST.OpenAPI
+import PostgREST.Parsers          (pRequestColumns)
+import PostgREST.QueryBuilder     (limitedQuery, mutateRequestToQuery,
+                                   readRequestToCountQuery,
+                                   readRequestToQuery,
+                                   requestToCallProcQuery)
+import PostgREST.RangeQuery       (allRange, contentRangeH,
+                                   rangeStatusHeader)
+import PostgREST.Statements       (callProcStatement,
+                                   createExplainStatement,
+                                   createReadStatement,
+                                   createWriteStatement)
+import PostgREST.Types
+import Protolude                  hiding (Proxy, intercalate, toS)
+import Protolude.Conv             (toS)
 
-import           PostgREST.Config          (AppConfig (..))
-import           PostgREST.Parsers
-import           PostgREST.DbStructure
-import           PostgREST.RangeQuery
-import           PostgREST.ApiRequest   (ApiRequest(..), ContentType(..)
-                                            , Action(..), Target(..)
-                                            , userApiRequest)
-import           PostgREST.Types
-import           PostgREST.Auth            (tokenJWT)
-import           PostgREST.Error           (errResponse)
+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 = parseSecret <$> configJwtSecret conf in
+  middle $ \ req respond -> do
+    time <- getTime
+    body <- strictRequestBody req
+    maybeDbStructure <- readIORef refDbStructure
+    case maybeDbStructure of
+      Nothing -> respond . errorResponseFor $ ConnectionLostError
+      Just dbStructure -> do
+        response <- do
+          -- Need to parse ?columns early because findProc needs it to solve overloaded functions.
+          -- TODO: move this logic to the app function
+          let apiReq = userApiRequest (configSchemas conf) (configRootSpec conf) req body
+              apiReqCols = (,) <$> apiReq <*> (pRequestColumns =<< iColumns <$> apiReq)
+          case apiReqCols of
+            Left err -> return . errorResponseFor $ err
+            Right (apiRequest, maybeCols) -> do
+              eClaims <- jwtClaims jwtSecret (configJwtAudience conf) (toS $ iJWT apiRequest) time (rightToMaybe $ configRoleClaimKey conf)
+              let authed = containsRole eClaims
+                  cols = case (iPayload apiRequest, maybeCols) of
+                    (Just ProcessedJSON{pjKeys}, _) -> pjKeys
+                    (Just RawJSON{}, Just cls)      -> cls
+                    _                               -> S.empty
+                  proc = case iTarget apiRequest of
+                    TargetProc qi _ -> findProc qi cols (iPreferParameters apiRequest == Just SingleObject) $ dbProcs dbStructure
+                    _ -> Nothing
+                  handleReq = runWithClaims conf eClaims (app dbStructure proc cols conf) apiRequest
+                  txMode = transactionMode proc (iAction apiRequest)
+              response <- P.use pool $ HT.transaction HT.ReadCommitted txMode handleReq
+              return $ either (errorResponseFor . PgError authed) identity response
+        when (responseStatus response == status503) worker
+        respond response
 
-import           PostgREST.QueryBuilder ( asJson
-                                        , callProc
-                                        , addJoinConditions
-                                        , sourceSubqueryName
-                                        , requestToQuery
-                                        , addRelations
-                                        , createReadStatement
-                                        , createWriteStatement
-                                        )
+transactionMode :: Maybe ProcDescription -> Action -> HT.Mode
+transactionMode proc action =
+  case action of
+    ActionRead _         -> HT.Read
+    ActionInfo           -> HT.Read
+    ActionInspect _      -> HT.Read
+    ActionInvoke InvGet  -> HT.Read
+    ActionInvoke InvHead -> HT.Read
+    ActionInvoke InvPost ->
+      let v = maybe Volatile pdVolatility proc in
+      if v == Stable || v == Immutable
+         then HT.Read
+         else HT.Write
+    _ -> HT.Write
 
-import           Prelude
+app :: DbStructure -> Maybe ProcDescription -> S.Set FieldName -> AppConfig -> ApiRequest -> H.Transaction Response
+app dbStructure proc cols conf apiRequest =
+  let rawContentTypes = (decodeContentType <$> configRawMediaTypes conf) `L.union` [ CTOctetStream, CTTextPlain ] in
+  case responseContentTypeOrError (iAccepts apiRequest) rawContentTypes (iAction apiRequest) (iTarget apiRequest) of
+    Left errorResponse -> return errorResponse
+    Right contentType ->
+      case (iAction apiRequest, iTarget apiRequest, iPayload apiRequest) of
 
-app :: DbStructure -> AppConfig -> RequestBody -> Request -> H.Tx P.Postgres s Response
-app dbStructure conf reqBody req =
+        (ActionRead headersOnly, TargetIdent (QualifiedIdentifier tSchema tName), Nothing) ->
+          case readSqlParts tSchema tName of
+            Left errorResponse -> return errorResponse
+            Right (q, cq, bField, _) -> do
+              let cQuery = if estimatedCount
+                             then limitedQuery cq ((+ 1) <$> maxRows) -- LIMIT maxRows + 1 so we can determine below that maxRows was surpassed
+                             else cq
+                  stm = createReadStatement q cQuery (contentType == CTSingularJSON) shouldCount
+                        (contentType == CTTextCSV) bField pgVer
+                  explStm = createExplainStatement cq
+              row <- H.statement () stm
+              let (tableTotal, queryTotal, _ , body, gucHeaders) = row
+              case gucHeaders of
+                Left _ -> return . errorResponseFor $ GucHeadersError
+                Right ghdrs -> do
+                  total <- if | plannedCount   -> H.statement () explStm
+                              | estimatedCount -> if tableTotal > (fromIntegral <$> maxRows)
+                                                    then do estTotal <- H.statement () explStm
+                                                            pure $ if estTotal > tableTotal then estTotal else tableTotal
+                                                    else pure tableTotal
+                              | otherwise      -> pure tableTotal
+                  let (status, contentRange) = rangeStatusHeader topLevelRange queryTotal total
+                      headers = addHeadersIfNotIncluded (catMaybes [
+                                  Just $ toHeader contentType, Just contentRange,
+                                  Just $ contentLocationH tName (iCanonicalQS apiRequest), profileH])
+                                (unwrapGucHeader <$> ghdrs)
+                      rBody = if headersOnly then mempty else toS body
+                  return $
+                    if contentType == CTSingularJSON && queryTotal /= 1
+                      then errorResponseFor . singularityError $ queryTotal
+                      else responseLBS status headers rBody
+
+        (ActionCreate, TargetIdent (QualifiedIdentifier tSchema tName), Just pJson) ->
+          case mutateSqlParts tSchema tName of
+            Left errorResponse -> return errorResponse
+            Right (sq, mq) -> do
+              let pkCols = tablePKCols dbStructure tSchema tName
+                  stm = createWriteStatement sq mq
+                    (contentType == CTSingularJSON) True
+                    (contentType == CTTextCSV) (iPreferRepresentation apiRequest) pkCols pgVer
+              row <- H.statement (toS $ pjRaw pJson) stm
+              let (_, queryTotal, fields, body, gucHeaders) = row
+              case gucHeaders of
+                Left _ -> return . errorResponseFor $ GucHeadersError
+                Right ghdrs -> do
+                  let
+                    (ctHeaders, rBody) = if iPreferRepresentation apiRequest == Full
+                                          then ([Just $ toHeader contentType, profileH], toS body)
+                                          else ([], mempty)
+                    headers = addHeadersIfNotIncluded (catMaybes ([
+                          if null fields
+                            then Nothing
+                            else Just $ locationH tName fields
+                        , Just $ contentRangeH 1 0 $ if shouldCount then Just queryTotal else Nothing
+                        , if null pkCols && isNothing (iOnConflict apiRequest)
+                            then Nothing
+                            else (\x -> ("Preference-Applied", encodeUtf8 (show x))) <$> iPreferResolution apiRequest
+                        ] ++ ctHeaders)) (unwrapGucHeader <$> ghdrs)
+                  if contentType == CTSingularJSON && queryTotal /= 1
+                    then do
+                      HT.condemn
+                      return . errorResponseFor . singularityError $ queryTotal
+                    else
+                      return $ responseLBS status201 headers rBody
+
+        (ActionUpdate, TargetIdent (QualifiedIdentifier tSchema tName), Just pJson) ->
+          case mutateSqlParts tSchema tName of
+            Left errorResponse -> return errorResponse
+            Right (sq, mq) -> do
+              let stm = createWriteStatement sq mq
+                    (contentType == CTSingularJSON) False (contentType == CTTextCSV)
+                    (iPreferRepresentation apiRequest) [] pgVer
+              row <- H.statement (toS $ pjRaw pJson) stm
+              let (_, queryTotal, _, body, gucHeaders) = row
+              case gucHeaders of
+                Left _ -> return . errorResponseFor $ GucHeadersError
+                Right ghdrs -> do
+                  let
+                    updateIsNoOp = S.null cols
+                    status | queryTotal == 0 && not updateIsNoOp      = status404
+                           | iPreferRepresentation apiRequest == Full = status200
+                           | otherwise                                = status204
+                    contentRangeHeader = contentRangeH 0 (queryTotal - 1) $ if shouldCount then Just queryTotal else Nothing
+                    (ctHeaders, rBody) = if iPreferRepresentation apiRequest == Full
+                                          then ([Just $ toHeader contentType, profileH], toS body)
+                                          else ([], mempty)
+                    headers = addHeadersIfNotIncluded (catMaybes ctHeaders ++ [contentRangeHeader]) (unwrapGucHeader <$> ghdrs)
+                  if contentType == CTSingularJSON && queryTotal /= 1
+                    then do
+                      HT.condemn
+                      return . errorResponseFor . singularityError $ queryTotal
+                    else
+                      return $ responseLBS status headers rBody
+
+        (ActionSingleUpsert, TargetIdent (QualifiedIdentifier tSchema tName), Just pJson) ->
+          case mutateSqlParts tSchema tName of
+            Left errorResponse -> return errorResponse
+            Right (sq, mq) ->
+              if topLevelRange /= allRange
+                then return . errorResponseFor $ PutRangeNotAllowedError
+              else do
+                row <- H.statement (toS $ pjRaw pJson) $
+                       createWriteStatement sq mq (contentType == CTSingularJSON) False
+                                            (contentType == CTTextCSV) (iPreferRepresentation apiRequest) [] pgVer
+                let (_, queryTotal, _, body, gucHeaders) = row
+                case gucHeaders of
+                  Left _ -> return . errorResponseFor $ GucHeadersError
+                  Right ghdrs -> do
+                    let headers = addHeadersIfNotIncluded (catMaybes [Just $ toHeader contentType, profileH]) (unwrapGucHeader <$> ghdrs)
+                        (status, rBody) = if iPreferRepresentation apiRequest == Full then (status200, toS body) else (status204, mempty)
+                    -- Makes sure the querystring pk matches the payload pk
+                    -- e.g. PUT /items?id=eq.1 { "id" : 1, .. } is accepted, PUT /items?id=eq.14 { "id" : 2, .. } is rejected
+                    -- If this condition is not satisfied then nothing is inserted, check the WHERE for INSERT in QueryBuilder.hs to see how it's done
+                    if queryTotal /= 1
+                      then do
+                        HT.condemn
+                        return . errorResponseFor $ PutMatchingPkError
+                      else
+                        return $ responseLBS status headers rBody
+
+        (ActionDelete, TargetIdent (QualifiedIdentifier tSchema tName), Nothing) ->
+          case mutateSqlParts tSchema tName of
+            Left errorResponse -> return errorResponse
+            Right (sq, mq) -> do
+              let stm = createWriteStatement sq mq
+                    (contentType == CTSingularJSON) False
+                    (contentType == CTTextCSV)
+                    (iPreferRepresentation apiRequest) [] pgVer
+              row <- H.statement mempty stm
+              let (_, queryTotal, _, body, gucHeaders) = row
+              case gucHeaders of
+                Left _ -> return . errorResponseFor $ GucHeadersError
+                Right ghdrs -> do
+                  let
+                    status = if iPreferRepresentation apiRequest == Full then status200 else status204
+                    contentRangeHeader = contentRangeH 1 0 $ if shouldCount then Just queryTotal else Nothing
+                    (ctHeaders, rBody) = if iPreferRepresentation apiRequest == Full
+                                          then ([Just $ toHeader contentType, profileH], toS body)
+                                          else ([], mempty)
+                    headers = addHeadersIfNotIncluded (catMaybes ctHeaders ++ [contentRangeHeader]) (unwrapGucHeader <$> ghdrs)
+                  if contentType == CTSingularJSON
+                     && queryTotal /= 1
+                    then do
+                      HT.condemn
+                      return . errorResponseFor . singularityError $ queryTotal
+                    else
+                      return $ responseLBS status headers rBody
+
+        (ActionInfo, TargetIdent (QualifiedIdentifier tSchema tTable), Nothing) ->
+          let mTable = find (\t -> tableName t == tTable && tableSchema t == tSchema) (dbTables dbStructure) in
+          case mTable of
+            Nothing -> return notFound
+            Just table ->
+              let allowH = (hAllow, if tableInsertable table then "GET,POST,PATCH,DELETE" else "GET")
+                  allOrigins = ("Access-Control-Allow-Origin", "*") :: Header in
+              return $ responseLBS status200 [allOrigins, allowH] mempty
+
+        (ActionInvoke invMethod, TargetProc qi@(QualifiedIdentifier tSchema pName) _, Just pJson) ->
+          let tName = fromMaybe pName $ procTableName =<< proc in
+          case readSqlParts tSchema tName of
+            Left errorResponse -> return errorResponse
+            Right (q, cq, bField, returning) -> do
+              let
+                preferParams = iPreferParameters apiRequest
+                pq = requestToCallProcQuery qi (specifiedProcArgs cols proc) returnsScalar preferParams returning
+                stm = callProcStatement returnsScalar pq q cq shouldCount (contentType == CTSingularJSON)
+                        (contentType == CTTextCSV) (contentType `elem` rawContentTypes) (preferParams == Just MultipleObjects)
+                        bField pgVer
+              row <- H.statement (toS $ pjRaw pJson) stm
+              let (tableTotal, queryTotal, body, gucHeaders) = row
+              case gucHeaders of
+                Left _ -> return . errorResponseFor $ GucHeadersError
+                Right ghdrs -> do
+                  let (status, contentRange) = rangeStatusHeader topLevelRange queryTotal tableTotal
+                      headers = addHeadersIfNotIncluded
+                        (catMaybes [Just $ toHeader contentType, Just contentRange, profileH])
+                        (unwrapGucHeader <$> ghdrs)
+                      rBody = if invMethod == InvHead then mempty else toS body
+                  if contentType == CTSingularJSON && queryTotal /= 1
+                    then do
+                      HT.condemn
+                      return . errorResponseFor . singularityError $ queryTotal
+                    else
+                      return $ responseLBS status headers rBody
+
+        (ActionInspect headersOnly, TargetDefaultSpec tSchema, Nothing) -> do
+          let host = configHost conf
+              port = toInteger $ configPort conf
+              proxy = pickProxy $ toS <$> configOpenAPIProxyUri conf
+              uri Nothing = ("http", host, port, "/")
+              uri (Just Proxy { proxyScheme = s, proxyHost = h, proxyPort = p, proxyPath = b }) = (s, h, p, b)
+              uri' = uri proxy
+              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.statement tSchema accessibleTables <*>
+            H.statement tSchema schemaDescription <*>
+            H.statement tSchema accessibleProcs
+          return $ responseLBS status200 (catMaybes [Just $ toHeader CTOpenAPI, profileH]) (if headersOnly then mempty else toS body)
+
+        _ -> return notFound
+
+      where
+        notFound = responseLBS status404 [] ""
+        maxRows = configMaxRows conf
+        exactCount = iPreferCount apiRequest == Just ExactCount
+        estimatedCount = iPreferCount apiRequest == Just EstimatedCount
+        plannedCount = iPreferCount apiRequest == Just PlannedCount
+        shouldCount = exactCount || estimatedCount
+        topLevelRange = iTopLevelRange apiRequest
+        returnsScalar = maybe False procReturnsScalar proc
+        pgVer = pgVersion dbStructure
+        profileH = contentProfileH <$> iProfile apiRequest
+
+        readSqlParts s t =
+          let
+            readReq = readRequest s t maxRows (dbRelations dbStructure) apiRequest
+            returnings :: ReadRequest -> Either Response [FieldName]
+            returnings rr = Right (returningCols rr)
+          in
+          (,,,) <$>
+          (readRequestToQuery <$> readReq) <*>
+          (readRequestToCountQuery <$> readReq) <*>
+          (binaryField contentType rawContentTypes returnsScalar =<< readReq) <*>
+          (returnings =<< readReq)
+
+        mutateSqlParts s t =
+          let
+            readReq = readRequest s t maxRows (dbRelations dbStructure) apiRequest
+            mutReq = mutateRequest s t apiRequest cols (tablePKCols dbStructure s t) =<< readReq
+          in
+          (,) <$>
+          (readRequestToQuery <$> readReq) <*>
+          (mutateRequestToQuery <$> mutReq)
+
+responseContentTypeOrError :: [ContentType] -> [ContentType] -> Action -> Target -> Either Response ContentType
+responseContentTypeOrError accepts rawContentTypes action target = serves contentTypesForRequest accepts
+  where
+    contentTypesForRequest = case action of
+      ActionRead _       ->  [CTApplicationJSON, CTSingularJSON, CTTextCSV]
+                             ++ rawContentTypes
+      ActionCreate       ->  [CTApplicationJSON, CTSingularJSON, CTTextCSV]
+      ActionUpdate       ->  [CTApplicationJSON, CTSingularJSON, CTTextCSV]
+      ActionDelete       ->  [CTApplicationJSON, CTSingularJSON, CTTextCSV]
+      ActionInvoke _     ->  [CTApplicationJSON, CTSingularJSON, CTTextCSV]
+                             ++ rawContentTypes
+                             ++ [CTOpenAPI | tpIsRootSpec target]
+      ActionInspect _    ->  [CTOpenAPI, CTApplicationJSON]
+      ActionInfo         ->  [CTTextCSV]
+      ActionSingleUpsert ->  [CTApplicationJSON, CTSingularJSON, CTTextCSV]
+    serves sProduces cAccepts =
+      case mutuallyAgreeable sProduces cAccepts of
+        Nothing -> Left . errorResponseFor . ContentTypeError . map toMime $ cAccepts
+        Just ct -> Right ct
+
+{-
+  | If raw(binary) output is requested, check that ContentType is one of the admitted rawContentTypes and that
+  | `?select=...` contains only one field other than `*`
+-}
+binaryField :: ContentType -> [ContentType] -> Bool -> ReadRequest -> Either Response (Maybe FieldName)
+binaryField ct rawContentTypes isScalarProc readReq
+  | isScalarProc = Right Nothing
+  | ct `elem` rawContentTypes =
+      let fieldName = headMay fldNames in
+      if length fldNames == 1 && fieldName /= Just "*"
+        then Right fieldName
+        else Left . errorResponseFor $ BinaryFieldError ct
+  | otherwise = Right Nothing
+  where
+    fldNames = fstFieldNames readReq
+
+locationH :: TableName -> [BS.ByteString] -> Header
+locationH tName fields =
   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
-
-  case (iAction apiRequest, iTarget apiRequest, iPayload apiRequest) of
-
-    (ActionRead, TargetIdent qi, Nothing) ->
-      case selectQuery of
-        Left e -> return $ responseLBS status400 [jsonH] $ cs e
-        Right q -> do
-          let range = iRange apiRequest
-              singular = iPreferSingular apiRequest
-              stm = createReadStatement q range singular
-                    (iPreferCount apiRequest) (contentType == TextCSV)
-          if range == Just emptyRange
-          then return $ errResponse status416 "HTTP Range error"
-          else do
-            row <- H.maybeEx stm
-            let (tableTotal, queryTotal, _ , body) = extractQueryResult row
-            if singular
-            then return $ if queryTotal <= 0
-              then responseLBS status404 [] ""
-              else responseLBS status200 [contentTypeH] (fromMaybe "{}" body)
-            else do
-              let frm = fromMaybe 0 $ rangeOffset <$> range
-                  to = frm+queryTotal-1
-                  contentRange = contentRangeH frm to tableTotal
-                  status = rangeStatus frm to 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
-                  )
-                ] (fromMaybe "[]" body)
-
-    (ActionCreate, TargetIdent (QualifiedIdentifier _ table),
-     Just payload@(PayloadJSON (UniformObjects rows))) ->
-      case queries 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 sq mq isSingle (iPreferRepresentation apiRequest) pKeys (contentType == TextCSV) payload
-          row <- H.maybeEx stm
-          let (_, _, location, body) = extractQueryResult row
-          return $ responseLBS status201
-            [
-              contentTypeH,
-              (hLocation, "/" <> cs table <> "?" <> cs (fromMaybe "" location))
-            ]
-            $ if iPreferRepresentation apiRequest then fromMaybe "[]" body else ""
-
-    (ActionUpdate, TargetIdent _, Just payload@(PayloadJSON _)) ->
-      case queries of
-        Left e -> return $ responseLBS status400 [jsonH] $ cs e
-        Right (sq,mq) -> do
-          let stm = createWriteStatement sq mq False (iPreferRepresentation apiRequest) [] (contentType == TextCSV) payload
-          row <- H.maybeEx stm
-          let (_, queryTotal, _, body) = extractQueryResult row
-              r = contentRangeH 0 (queryTotal-1) (Just queryTotal)
-              s = case () of _ | queryTotal == 0 -> status404
-                               | iPreferRepresentation apiRequest -> status200
-                               | otherwise -> status204
-          return $ responseLBS s [contentTypeH, r]
-            $ if iPreferRepresentation apiRequest then fromMaybe "[]" body else ""
-
-    (ActionDelete, TargetIdent _, Nothing) ->
-      case queries of
-        Left e -> return $ responseLBS status400 [jsonH] $ cs e
-        Right (sq,mq) -> do
-          let fakeload = PayloadJSON $ UniformObjects V.empty
-          let stm = createWriteStatement sq mq False False [] (contentType == TextCSV) fakeload
-          row <- H.maybeEx stm
-          let (_, queryTotal, _, _) = extractQueryResult row
-          return $ if queryTotal == 0
-            then notFound
-            else responseLBS status204 [("Content-Range", "*/"<> cs (show queryTotal))] ""
-
-    (ActionInfo, TargetIdent (QualifiedIdentifier tSchema tTable), Nothing) -> do
-      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
-      return $ responseLBS status200 [jsonH, allOrigins] $ cs body
-
-    (ActionInvoke, TargetIdent qi,
-     Just (PayloadJSON (UniformObjects payload))) -> do
-      exists <- doesProcExist qi
-      if exists
-        then do
-          let p = V.head payload
-              call = B.Stmt "select " V.empty True <>
-                asJson (callProc qi p)
-              jwtSecret = configJwtSecret conf
-
-          bodyJson :: Maybe (Identity Value) <- H.maybeEx call
-          returnJWT <- doesProcReturnJWT qi
-          return $ responseLBS status200 [jsonH]
-                 (let body = fromMaybe emptyArray $ runIdentity <$> bodyJson in
-                    if returnJWT
-                    then "{\"token\":\"" <> cs (tokenJWT jwtSecret body) <> "\"}"
-                    else cs $ encode body)
-        else return notFound
-
-    (ActionRead, TargetRoot, Nothing) -> do
-      body <- encode <$> accessibleTables (filter ((== cs schema) . tableSchema) (dbTables dbStructure))
-      return $ responseLBS status200 [jsonH] $ cs body
-
-    (ActionUnknown _, _, _) -> return notFound
-
-    (_, TargetUnknown _, _) -> return notFound
-
-    (_, _, Just (PayloadParseError e)) ->
-      return $ responseLBS status400 [jsonH] $
-        cs (formatGeneralError "Cannot parse request payload" (cs e))
-
-    (_, _, _) -> return notFound
-
- 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
-  selectQuery = requestToQuery schema <$> (DbRead <$> buildReadRequest (dbRelations dbStructure) apiRequest)
-  mutateQuery = requestToQuery schema <$> (DbMutate <$> buildMutateRequest apiRequest)
-  queries = (,) <$> selectQuery <*> mutateQuery
-
-rangeStatus :: Int -> Int -> Maybe Int -> Status
-rangeStatus _ _ Nothing = status200
-rangeStatus frm to (Just total)
-  | frm > total            = status416
-  | (1 + to - frm) < total = status206
-  | otherwise               = status200
-
-contentRangeH :: Int -> Int -> Maybe Int -> Header
-contentRangeH frm to total =
-    ("Content-Range", cs headerValue)
-    where
-      headerValue   = rangeString <> "/" <> totalString
-      rangeString
-        | totalNotZero && fromInRange = show frm <> "-" <> cs (show to)
-        | 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
+    locationFields = renderSimpleQuery True $ splitKeyValue <$> fields
+  in
+    (hLocation, "/" <> toS tName <> locationFields)
   where
-     message = cs $ show (errorPos e)
-     details = strip $ replace "\n" " " $ cs
-       $ showErrorMessages "or" "unknown parse error" "expecting" "unexpected" "end of input" (errorMessages e)
+    splitKeyValue :: BS.ByteString -> (BS.ByteString, BS.ByteString)
+    splitKeyValue kv =
+      let (k, v) = BS.break (== '=') kv
+      in (k, BS.tail v)
 
-formatGeneralError :: Text -> Text -> Text
-formatGeneralError message details = cs $ encode $ object [
-  "message" .= message,
-  "details" .= details]
+contentLocationH :: TableName -> ByteString -> Header
+contentLocationH tName qString =
+  ("Content-Location", "/" <> toS tName <> if BS.null qString then mempty else "?" <> toS qString)
 
-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 sourceSubqueryName
-    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=sourceSubqueryName}}
-  | mt == tableName ft = Just $ r {relFTable=t {tableName=sourceSubqueryName}}
-  | Just mt == (tableName <$> rt) = Just $ r {relLTable=(\tbl -> tbl {tableName=sourceSubqueryName}) <$> rt}
-  | otherwise = Nothing
-
-data TableOptions = TableOptions {
-  tblOptcolumns :: [Column]
-, tblOptpkey    :: [Text]
-}
-
-instance ToJSON TableOptions where
-  toJSON t = object [
-      "columns" .= tblOptcolumns t
-    , "pkey"   .= tblOptpkey t ]
-
-
-extractQueryResult :: Maybe (Maybe Int, Int, Maybe BL.ByteString, Maybe BL.ByteString)
-                         -> (Maybe Int, Int, Maybe BL.ByteString, Maybe BL.ByteString)
-extractQueryResult = fromMaybe (Just 0, 0, Just "", Just "")
+contentProfileH :: Schema -> Header
+contentProfileH schema =
+   ("Content-Profile", toS schema)

src/PostgREST/Auth.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE LambdaCase       #-}
 {-|
 Module      : PostgREST.Auth
 Description : PostgREST authorization functions.
@@ -12,73 +13,102 @@ 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(..)
+  , parseSecret
   ) where
 
-import           Control.Monad           (join)
-import           Data.Aeson              (Value (..), Object)
-import           Data.Aeson.Types        (emptyObject, emptyArray)
-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 qualified Crypto.JOSE.Types   as JOSE.Types
+import qualified Data.Aeson          as JSON
+import qualified Data.HashMap.Strict as M
+import           Data.Vector         as V
+
+import Control.Lens    (set)
+import Data.Time.Clock (UTCTime)
+
+import Control.Lens.Operators
+import Crypto.JWT
+
+import PostgREST.Types
+import Protolude       hiding (toS)
+import Protolude.Conv  (toS)
 
 {-|
-  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 -> [Text]
-claimsToSQL = map setVar . toList
-  where
-    setVar ("role", String val) = setRole val
-    setVar (k, val) = "set local postgrest.claims." <> pgFmtIdent k <>
-                      " = " <> 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 -> Text
-setRole role = "set local role " <> cs (pgFmtLit role) <> ";"
-
+jwtClaims :: Maybe JWKSet -> Maybe StringOrURI -> LByteString -> UTCTime -> Maybe JSPath -> IO JWTAttempt
+jwtClaims _ _ "" _ _ = return $ JWTClaims M.empty
+jwtClaims secret audience payload time jspath =
+  case secret of
+    Nothing -> return JWTMissingSecret
+    Just s -> do
+      let validation = 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
+
+{-|
+  Parse `jwt-secret` configuration option and turn into a JWKSet.
+
+  There are three ways to specify `jwt-secret`: text secret, JSON Web Key
+  (JWK), or JSON Web Key Set (JWKS). The first two are converted into a JWKSet
+  with one key and the last is converted as is.
+-}
+parseSecret :: ByteString -> JWKSet
+parseSecret str =
+  fromMaybe (maybe secret (\jwk' -> JWKSet [jwk']) maybeJWK)
+    maybeJWKSet
+ where
+  maybeJWKSet = JSON.decode (toS str) :: Maybe JWKSet
+  maybeJWK = JSON.decode (toS str) :: Maybe JWK
+  secret = JWKSet [jwkFromSecret str]
+
+{-|
+  Internal helper to generate a symmetric HMAC-SHA256 JWK from a text secret.
+-}
+jwkFromSecret :: ByteString -> JWK
+jwkFromSecret key =
+  fromKeyMaterial km
+    & jwkUse ?~ Sig
+    & jwkAlg ?~ JWSAlg HS256
+ where
+  km = OctKeyMaterial (OctKeyParameters (JOSE.Types.Base64Octets key))

src/PostgREST/Config.hs

@@ -2,61 +2,105 @@
 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.
 -}
+{-# LANGUAGE LambdaCase          #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TemplateHaskell     #-}
+{-# OPTIONS_GHC -fno-warn-type-defaults #-}
+
 module PostgREST.Config ( prettyVersion
+                        , docsVersion
                         , readOptions
                         , corsPolicy
-                        , minimumPgVersion
                         , AppConfig (..)
+                        , configPoolTimeout'
                         )
        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           Network.Wai
-import           Network.Wai.Middleware.Cors (CorsResourcePolicy (..))
-import           Options.Applicative
-import           Paths_postgrest             (version)
-import           Web.JWT                     (Secret, secret)
-import           Prelude
+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 Text.PrettyPrint.ANSI.Leijen as L
 
--- | Data type to store all command line options
+import Control.Lens                (preview)
+import Control.Monad               (fail)
+import Crypto.JWT                  (StringOrURI, stringOrUri)
+import Data.List                   (lookup)
+import Data.List.NonEmpty          (fromList)
+import Data.Scientific             (floatingOrInteger)
+import Data.Text                   (dropEnd, dropWhileEnd,
+                                    intercalate, splitOn, strip, take,
+                                    unpack)
+import Data.Text.IO                (hPutStrLn)
+import Data.Version                (versionBranch)
+import Development.GitRev          (gitHash)
+import Network.Wai.Middleware.Cors (CorsResourcePolicy (..))
+import Numeric                     (readOct)
+import Paths_postgrest             (version)
+import System.IO.Error             (IOError)
+import System.Posix.Types          (FileMode)
+
+import Control.Applicative
+import Data.Monoid
+import Network.Wai
+import Options.Applicative          hiding (str)
+import Text.Heredoc
+import Text.PrettyPrint.ANSI.Leijen hiding ((<$>), (<>))
+
+import PostgREST.Error   (ApiRequestError (..))
+import PostgREST.Parsers (pRoleClaimKey)
+import PostgREST.Types   (JSPath, JSPathExp (..))
+import Protolude         hiding (concat, hPutStrLn, intercalate, null,
+                          take, toS, (<>))
+import Protolude.Conv    (toS)
+
+
+-- | Config file settings for the server
 data AppConfig = AppConfig {
-    configDatabase  :: String
-  , configPort      :: Int
-  , configAnonRole  :: String
-  , configSchema    :: String
-  , configJwtSecret :: Secret
-  , configPool      :: Int
+    configDatabase          :: Text
+  , configAnonRole          :: Text
+  , configOpenAPIProxyUri   :: Maybe Text
+  , configSchemas           :: NonEmpty Text
+  , configHost              :: Text
+  , configPort              :: Int
+  , configSocket            :: Maybe FilePath
+  , configSocketMode        :: Either Text FileMode
+
+  , configJwtSecret         :: Maybe B.ByteString
+  , configJwtSecretIsBase64 :: Bool
+  , configJwtAudience       :: Maybe StringOrURI
+
+  , configPool              :: Int
+  , configPoolTimeout       :: Int
+  , configMaxRows           :: Maybe Integer
+  , configReqCheck          :: Maybe Text
+  , configQuiet             :: Bool
+  , configSettings          :: [(Text, Text)]
+  , configRoleClaimKey      :: Either ApiRequestError JSPath
+  , configExtraSearchPath   :: [Text]
+
+  , configRootSpec          :: Maybe Text
+  , configRawMediaTypes     :: [B.ByteString]
   }
 
-argParser :: Parser AppConfig
-argParser = AppConfig
-  <$> argument str (help "database connection string" <> metavar "STRING")
+configPoolTimeout' :: (Fractional a) => AppConfig -> a
+configPoolTimeout' =
+  fromRational . toRational . configPoolTimeout
 
-  <*> option auto  (long "port"       <> short 'p' <> help "port number on which to run HTTP server" <> metavar "PORT" <> value 3000 <> showDefault)
-  <*> strOption    (long "anonymous"  <> short 'a' <> help "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 "1" <> 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)
 
 defaultCorsPolicy :: CorsResourcePolicy
 defaultCorsPolicy =  CorsResourcePolicy Nothing
-  ["GET", "POST", "PATCH", "DELETE", "OPTIONS"] ["Authorization"] Nothing
+  ["GET", "POST", "PATCH", "PUT", "DELETE", "OPTIONS"] ["Authorization"] Nothing
   (Just $ 60*60*24) False False True
 
 -- | CORS policy to be used in by Wai Cors middleware
@@ -74,26 +118,191 @@ 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" <> dropEnd 1 (dropWhileEnd (/= '.') 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 <- catches (C.load cfgPath)
+    [ Handler (\(ex :: IOError)    -> exitErr $ "Cannot open config file:\n\t" <> show ex)
+    , Handler (\(C.ParseError err) -> exitErr $ "Error parsing config file:\n" <> err)
+    ]
+
+  case C.runParser parseConfig conf of
+    Left err ->
+      exitErr $ "Error parsing config file:\n\t" <> err
+    Right appConf ->
+      return appConf
+
   where
-    opts = info (helper <*> argParser) $
-                    fullDesc
-                    <> progDesc (
-                    "PostgREST "
-                    <> prettyVersion
-                    <> " / create a REST API to an existing Postgres database"
-                    )
+    parseConfig =
+      AppConfig
+        <$> reqString "db-uri"
+        <*> reqString "db-anon-role"
+        <*> optString "openapi-server-proxy-uri"
+        <*> (fromList . splitOnCommas <$> reqValue "db-schema")
+        <*> (fromMaybe "!4" <$> optString "server-host")
+        <*> (fromMaybe 3000 <$> optInt "server-port")
+        <*> (fmap unpack <$> optString "server-unix-socket")
+        <*> parseSocketFileMode "server-unix-socket-mode"
+        <*> (fmap encodeUtf8 <$> optString "jwt-secret")
+        <*> (fromMaybe False <$> optBool "secret-is-base64")
+        <*> parseJwtAudience "jwt-aud"
+        <*> (fromMaybe 10 <$> optInt "db-pool")
+        <*> (fromMaybe 10 <$> optInt "db-pool-timeout")
+        <*> optInt "max-rows"
+        <*> optString "pre-request"
+        <*> pure False
+        <*> (fmap (fmap coerceText) <$> C.subassocs "app.settings" C.value)
+        <*> (maybe (Right [JSPKey "role"]) parseRoleClaimKey <$> optValue "role-claim-key")
+        <*> (maybe ["public"] splitOnCommas <$> optValue "db-extra-search-path")
+        <*> optString "root-spec"
+        <*> (maybe [] (fmap encodeUtf8 . splitOnCommas) <$> optValue "raw-media-types")
+
+    parseSocketFileMode :: C.Key -> C.Parser C.Config (Either Text FileMode)
+    parseSocketFileMode k =
+      C.optional k C.string >>= \case
+        Nothing -> pure $ Right 432 -- return default 660 mode if no value was provided
+        Just fileModeText ->
+          case (readOct . unpack) fileModeText of
+            []              ->
+              pure $ Left "Invalid server-unix-socket-mode: not an octal"
+            (fileMode, _):_ ->
+              if fileMode < 384 || fileMode > 511
+                then pure $ Left "Invalid server-unix-socket-mode: needs to be between 600 and 777"
+                else pure $ Right fileMode
+
+    parseJwtAudience :: C.Key -> C.Parser C.Config (Maybe StringOrURI)
+    parseJwtAudience k =
+      C.optional k C.string >>= \case
+        Nothing -> pure Nothing -- no audience in config file
+        Just aud -> case preview stringOrUri (unpack aud) of
+          Nothing -> fail "Invalid Jwt audience. Check your configuration."
+          (Just "") -> pure Nothing
+          aud' -> pure aud'
+
+    reqString :: C.Key -> C.Parser C.Config Text
+    reqString k = C.required k C.string
+
+    reqValue :: C.Key -> C.Parser C.Config C.Value
+    reqValue k = C.required k C.value
+
+    optString :: C.Key -> C.Parser C.Config (Maybe Text)
+    optString k = mfilter (/= "") <$> C.optional k C.string
+
+    optValue :: C.Key -> C.Parser C.Config (Maybe C.Value)
+    optValue k = C.optional k C.value
+
+    optInt :: (Read i, Integral i) => C.Key -> C.Parser C.Config (Maybe i)
+    optInt k = join <$> C.optional k (coerceInt <$> C.value)
+
+    optBool :: C.Key -> C.Parser C.Config (Maybe Bool)
+    optBool k = join <$> C.optional k (coerceBool <$> C.value)
+
+    coerceText :: C.Value -> Text
+    coerceText (C.String s) = s
+    coerceText v            = show v
+
+    coerceInt :: (Read i, Integral i) => C.Value -> Maybe i
+    coerceInt (C.Number x) = rightToMaybe $ floatingOrInteger x
+    coerceInt (C.String x) = readMaybe $ toS x
+    coerceInt _            = Nothing
+
+    coerceBool :: C.Value -> Maybe Bool
+    coerceBool (C.Bool b)   = Just b
+    coerceBool (C.String b) = readMaybe $ toS b
+    coerceBool _            = Nothing
+
+    parseRoleClaimKey :: C.Value -> Either ApiRequestError JSPath
+    parseRoleClaimKey (C.String s) = pRoleClaimKey s
+    parseRoleClaimKey v            = pRoleClaimKey $ show v
+
+    splitOnCommas :: C.Value -> [Text]
+    splitOnCommas (C.String s) = strip <$> splitOn "," s
+    splitOnCommas _            = []
+
+    opts = info (helper <*> pathParser) $
+             fullDesc
+             <> 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
 
--- | Tells the minimum PostgreSQL version required by this version of PostgREST
-minimumPgVersion :: Integer
-minimumPgVersion = 90300
+    exitErr :: Text -> IO a
+    exitErr err = do
+      hPutStrLn stderr err
+      exitFailure
+
+    exampleCfg :: Doc
+    exampleCfg = vsep . map (text . toS) . lines $
+      [str|db-uri = "postgres://user:pass@localhost:5432/dbname"
+          |db-schema = "public" # this schema gets added to the search_path of every request
+          |db-anon-role = "postgres"
+          |db-pool = 10
+          |db-pool-timeout = 10
+          |
+          |server-host = "!4"
+          |server-port = 3000
+          |
+          |## unix socket location
+          |## if specified it takes precedence over server-port
+          |# server-unix-socket = "/tmp/pgrst.sock"
+          |## unix socket file mode
+          |## when none is provided, 660 is applied by default
+          |# server-unix-socket-mode = "660"
+          |
+          |## base url for swagger output
+          |# openapi-server-proxy-uri = ""
+          |
+          |## choose a secret, JSON Web Key (or set) to enable JWT auth
+          |## (use "@filename" to load from separate file)
+          |# jwt-secret = "secret_with_at_least_32_characters"
+          |# secret-is-base64 = false
+          |# jwt-aud = "your_audience_claim"
+          |
+          |## limit rows in response
+          |# max-rows = 1000
+          |
+          |## stored proc to exec immediately after auth
+          |# pre-request = "stored_proc_name"
+          |
+          |## jspath to the role claim key
+          |# role-claim-key = ".role"
+          |
+          |## extra schemas to add to the search_path of every request
+          |# db-extra-search-path = "extensions, util"
+          |
+          |## stored proc that overrides the root "/" spec
+          |## it must be inside the db-schema
+          |# root-spec = "stored_proc_name"
+          |
+          |## content types to produce raw output
+          |# raw-media-types="image/png, image/jpg"
+          |]
+
+pathParser :: Parser FilePath
+pathParser =
+  strArgument $
+    metavar "FILENAME" <>
+    help "Path to configuration file"

src/PostgREST/DbRequestBuilder.hs

@@ -0,0 +1,351 @@
+{-|
+Module      : PostgREST.DbRequestBuilder
+Description : PostgREST database request builder
+
+This module is in charge of building an intermediate representation(ReadRequest, MutateRequest) between the HTTP request and the final resulting SQL query.
+
+A query tree is built in case of resource embedding. By inferring the relationship between tables, join conditions are added for every embedded resource.
+-}
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE FlexibleContexts      #-}
+{-# LANGUAGE LambdaCase            #-}
+{-# LANGUAGE NamedFieldPuns        #-}
+
+module PostgREST.DbRequestBuilder (
+  readRequest
+, mutateRequest
+, returningCols
+) where
+
+import qualified Data.HashMap.Strict as M
+import qualified Data.Set            as S
+
+import Control.Arrow           ((***))
+import Data.Either.Combinators (mapLeft)
+import Data.Foldable           (foldr1)
+import Data.List               (delete)
+import Data.Text               (isInfixOf)
+
+import Control.Applicative
+import Data.Tree
+import Network.Wai
+
+import PostgREST.ApiRequest (Action (..), ApiRequest (..))
+import PostgREST.Error      (ApiRequestError (..), errorResponseFor)
+import PostgREST.Parsers
+import PostgREST.RangeQuery (NonnegRange, allRange, restrictRange)
+import PostgREST.Types
+import Protolude            hiding (from)
+
+readRequest :: Schema -> TableName -> Maybe Integer -> [Relation] -> ApiRequest -> Either Response ReadRequest
+readRequest schema rootTableName maxRows allRels apiRequest  =
+  mapLeft errorResponseFor $
+  treeRestrictRange maxRows =<<
+  augmentRequestWithJoin schema rootRels =<<
+  addFiltersOrdersRanges apiRequest <*>
+  (initReadRequest rootName <$> pRequestSelect sel)
+  where
+    sel = fromMaybe "*" $ iSelect apiRequest -- default to all columns requested (SELECT *) for a non existent ?select querystring param
+    (rootName, rootRels) = rootWithRels schema rootTableName allRels (iAction apiRequest)
+
+-- Get the root table name with its relationships according to the Action type.
+-- This is done because of the shape of the final SQL Query. The mutation cases are wrapped in a WITH {sourceCTEName}(see Statements.hs).
+-- So we need a FROM {sourceCTEName} instead of FROM {tableName}.
+rootWithRels :: Schema -> TableName -> [Relation] -> Action -> (QualifiedIdentifier, [Relation])
+rootWithRels schema rootTableName allRels action = case action of
+  ActionRead _ -> (QualifiedIdentifier schema rootTableName, allRels) -- normal read case
+  _            -> (QualifiedIdentifier mempty sourceCTEName, mapMaybe toSourceRel allRels ++ allRels) -- mutation cases and calling proc
+  where
+    -- To enable embedding in the sourceCTEName cases we need to replace the foreign key tableName in the Relation
+    -- with {sourceCTEName}. This way findRel can find relationships with sourceCTEName.
+    toSourceRel :: Relation -> Maybe Relation
+    toSourceRel r@Relation{relTable=t}
+      | rootTableName == tableName t = Just $ r {relTable=t {tableName=sourceCTEName}}
+      | otherwise                    = Nothing
+
+-- Build the initial 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 http://github.com/PostgREST/postgrest/issues/987.
+initReadRequest :: QualifiedIdentifier -> [Tree SelectItem] -> ReadRequest
+initReadRequest rootQi =
+  foldr (treeEntry rootDepth) initial
+  where
+    rootDepth = 0
+    rootSchema = qiSchema rootQi
+    rootName = qiName rootQi
+    initial = Node (Select [] rootQi Nothing [] [] [] [] allRange, (rootName, Nothing, Nothing, Nothing, rootDepth)) []
+    treeEntry :: Depth -> Tree SelectItem -> ReadRequest -> ReadRequest
+    treeEntry depth (Node fld@((fn, _),_,alias, embedHint) 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 [] (QualifiedIdentifier rootSchema fn) Nothing [] [] [] [] allRange,
+                (fn, Nothing, alias, embedHint, nxtDepth)) [])
+              fldForest:rForest
+
+treeRestrictRange :: Maybe Integer -> ReadRequest -> Either ApiRequestError ReadRequest
+treeRestrictRange maxRows request = pure $ nodeRestrictRange maxRows <$> request
+  where
+    nodeRestrictRange :: Maybe Integer -> ReadNode -> ReadNode
+    nodeRestrictRange m (q@Select {range_=r}, i) = (q{range_=restrictRange m r }, i)
+
+augmentRequestWithJoin :: Schema -> [Relation] -> ReadRequest -> Either ApiRequestError ReadRequest
+augmentRequestWithJoin schema allRels request =
+  addRels schema allRels Nothing request
+  >>= addJoinConditions Nothing
+
+addRels :: Schema -> [Relation] -> Maybe ReadRequest -> ReadRequest -> Either ApiRequestError ReadRequest
+addRels schema allRels parentNode (Node (query@Select{from=tbl}, (nodeName, _, alias, hint, depth)) forest) =
+  case parentNode of
+    Just (Node (Select{from=parentNodeQi}, _) _) ->
+      let newFrom r = if qiName tbl == nodeName then tableQi (relFTable r) else tbl
+          newReadNode = (\r -> (query{from=newFrom r}, (nodeName, Just r, alias, Nothing, depth))) <$> rel
+          rel = findRel schema allRels (qiName parentNodeQi) nodeName hint
+      in
+      Node <$> newReadNode <*> (updateForest . hush $ Node <$> newReadNode <*> pure forest)
+    _ ->
+      let rn = (query, (nodeName, Nothing, alias, Nothing, depth)) in
+      Node rn <$> updateForest (Just $ Node rn forest)
+  where
+    updateForest :: Maybe ReadRequest -> Either ApiRequestError [ReadRequest]
+    updateForest rq = mapM (addRels schema allRels rq) forest
+
+-- Finds a relationship between an origin and a target in the request: /origin?select=target(*)
+-- If more than one relationship is found then the request is ambiguous and we return an error.
+-- In that case the request can be disambiguated by adding precision to the target or by using a hint: /origin?select=target!hint(*)
+-- The elements will be matched according to these rules:
+-- origin = table / view
+-- target = table / view / constraint / column-from-origin
+-- hint   = table / view / constraint / column-from-origin / column-from-target
+-- (hint can take table / view values to aid in finding the junction in an m2m relationship)
+findRel :: Schema -> [Relation] -> NodeName -> NodeName -> Maybe EmbedHint -> Either ApiRequestError Relation
+findRel schema allRels origin target hint =
+  case rel of
+    []  -> Left $ NoRelBetween origin target
+    [r] -> Right r
+    rs  ->
+      -- Return error if more than one relationship is found, unless we're in a self reference case.
+      --
+      -- Here we handle a self reference relationship to not cause a breaking change:
+      -- In a self reference we get two relationships with the same foreign key and relTable/relFtable but with different cardinalities(m2o/o2m)
+      -- We output the O2M rel, the M2O rel can be obtained by using the origin column as an embed hint.
+      let [rel0, rel1] = take 2 rs in
+      if length rs == 2 && relConstraint rel0 == relConstraint rel1 && relTable rel0 == relTable rel1 && relFTable rel0 == relFTable rel1
+        then note (NoRelBetween origin target) (find (\r -> relType r == O2M) rs)
+        else Left $ AmbiguousRelBetween origin target rs
+  where
+    matchFKSingleCol hint_ cols = length cols == 1 && hint_ == (colName <$> head cols)
+    rel = filter (
+      \Relation{relTable, relColumns, relConstraint, relFTable, relFColumns, relType, relJunction} ->
+        -- Both relationship ends need to be on the exposed schema
+        schema == tableSchema relTable && schema == tableSchema relFTable &&
+        (
+          -- /projects?select=clients(*)
+          origin == tableName relTable  &&  -- projects
+          target == tableName relFTable ||  -- clients
+
+          -- /projects?select=projects_client_id_fkey(*)
+          (
+            origin == tableName relTable && -- projects
+            Just target == relConstraint    -- projects_client_id_fkey
+          ) ||
+          -- /projects?select=client_id(*)
+          (
+            origin == tableName relTable &&           -- projects
+            matchFKSingleCol (Just target) relColumns -- client_id
+          )
+        ) && (
+          isNothing hint || -- hint is optional
+
+          -- /projects?select=clients!projects_client_id_fkey(*)
+          hint == relConstraint             || -- projects_client_id_fkey
+
+          -- /projects?select=clients!client_id(*) or /projects?select=clients!id(*)
+          matchFKSingleCol hint relColumns  || -- client_id
+          matchFKSingleCol hint relFColumns || -- id
+
+          -- /users?select=tasks!users_tasks(*)
+          (
+            relType == M2M &&                              -- many-to-many between users and tasks
+            hint == (tableName . junTable <$> relJunction) -- users_tasks
+          )
+        )
+      ) allRels
+
+-- previousAlias is only used for the case of self joins
+addJoinConditions :: Maybe Alias -> ReadRequest -> Either ApiRequestError ReadRequest
+addJoinConditions previousAlias (Node node@(query@Select{from=tbl}, nodeProps@(_, rel, _, _, depth)) forest) =
+  case rel of
+    Just r@Relation{relType=O2M} -> Node (augmentQuery r, nodeProps) <$> updatedForest
+    Just r@Relation{relType=M2O} -> Node (augmentQuery r, nodeProps) <$> updatedForest
+    Just r@Relation{relType=M2M, relJunction=junction} ->
+      case junction of
+        Just Junction{junTable} ->
+          let rq = augmentQuery r in
+          Node (rq{implicitJoins=tableQi junTable:implicitJoins rq}, nodeProps) <$> updatedForest
+        Nothing ->
+          Left UnknownRelation
+    Nothing -> Node node <$> updatedForest
+  where
+    newAlias = case isSelfReference <$> rel of
+      Just True
+        | depth /= 0 -> Just (qiName tbl <> "_" <> show depth) -- root node doesn't get aliased
+        | otherwise  -> Nothing
+      _              -> Nothing
+    augmentQuery r =
+      foldr
+        (\jc rq@Select{joinConditions=jcs} -> rq{joinConditions=jc:jcs})
+        query{fromAlias=newAlias}
+        (getJoinConditions previousAlias newAlias r)
+    updatedForest = mapM (addJoinConditions newAlias) forest
+
+-- previousAlias and newAlias are used in the case of self joins
+getJoinConditions :: Maybe Alias -> Maybe Alias -> Relation -> [JoinCondition]
+getJoinConditions previousAlias newAlias (Relation Table{tableSchema=tSchema, tableName=tN} cols _ Table{tableName=ftN} fCols typ jun) =
+  case typ of
+    O2M ->
+        zipWith (toJoinCondition tN ftN) cols fCols
+    M2O ->
+        zipWith (toJoinCondition tN ftN) cols fCols
+    M2M -> case jun of
+        Just (Junction jt _ jc1 _ jc2) ->
+          let jtn = tableName jt in
+          zipWith (toJoinCondition tN jtn) cols jc1 ++ zipWith (toJoinCondition ftN jtn) fCols jc2
+        Nothing -> []
+  where
+    toJoinCondition :: Text -> Text -> Column -> Column -> JoinCondition
+    toJoinCondition tb ftb c fc =
+      let qi1 = removeSourceCTESchema tSchema tb
+          qi2 = removeSourceCTESchema tSchema ftb in
+        JoinCondition (maybe qi1 (QualifiedIdentifier mempty) previousAlias, colName c)
+                      (maybe qi2 (QualifiedIdentifier mempty) newAlias, colName fc)
+
+    -- On mutation and calling proc cases we wrap the target table in a WITH {sourceCTEName}
+    -- if this happens remove the schema `FROM "schema"."{sourceCTEName}"` and use only the
+    -- `FROM "{sourceCTEName}"`. If the schema remains the FROM would be invalid.
+    removeSourceCTESchema :: Schema -> TableName -> QualifiedIdentifier
+    removeSourceCTESchema schema tbl = QualifiedIdentifier (if tbl == sourceCTEName then mempty else schema) tbl
+
+addFiltersOrdersRanges :: ApiRequest -> Either ApiRequestError (ReadRequest -> ReadRequest)
+addFiltersOrdersRanges apiRequest = foldr1 (liftA2 (.)) [
+    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 ApiRequestError 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 :: Schema -> TableName -> ApiRequest -> S.Set FieldName -> [FieldName] -> ReadRequest -> Either Response MutateRequest
+mutateRequest schema tName apiRequest cols pkCols readReq = mapLeft errorResponseFor $
+  case action of
+    ActionCreate -> do
+        confCols <- case iOnConflict apiRequest of
+            Nothing    -> pure pkCols
+            Just param -> pRequestOnConflict param
+        pure $ Insert qi cols ((,) <$> iPreferResolution apiRequest <*> Just confCols) [] returnings
+    ActionUpdate -> Update qi cols <$> combinedLogic <*> pure returnings
+    ActionSingleUpsert ->
+      (\flts ->
+        if null (iLogic apiRequest) &&
+           S.fromList (fst <$> iFilters apiRequest) == S.fromList pkCols &&
+           not (null (S.fromList pkCols)) &&
+           all (\case
+              Filter _ (OpExpr False (Op "eq" _)) -> True
+              _ -> False) flts
+          then Insert qi cols (Just (MergeDuplicates, pkCols)) <$> combinedLogic <*> pure returnings
+        else
+          Left InvalidFilters) =<< filters
+    ActionDelete -> Delete qi <$> combinedLogic <*> pure returnings
+    _            -> Left UnsupportedVerb
+  where
+    qi = QualifiedIdentifier schema tName
+    action = iAction apiRequest
+    returnings =
+      if iPreferRepresentation apiRequest == None
+        then []
+        else returningCols readReq
+    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)
+
+returningCols :: ReadRequest -> [FieldName]
+returningCols rr@(Node _ forest) = returnings
+  where
+    fldNames = fstFieldNames rr
+    -- Without fkCols, when a mutateRequest to /projects?select=name,clients(name) occurs, the RETURNING SQL part would be
+    -- `RETURNING name`(see QueryBuilder).
+    -- This would make the embedding fail because the following JOIN would need the "client_id" column from projects.
+    -- So this adds the foreign key columns to ensure the embedding succeeds, result would be `RETURNING name, client_id`.
+    -- This also works for the other relType's.
+    fkCols = concat $ mapMaybe (\case
+        Node (_, (_, Just Relation{relColumns=cols, relType=relTyp}, _, _, _)) _ -> case relTyp of
+          O2M -> Just cols
+          M2O -> Just cols
+          M2M -> Just cols
+        _ -> Nothing
+      ) forest
+    -- However if the "client_id" is present, e.g. mutateRequest to /projects?select=client_id,name,clients(name)
+    -- we would get `RETURNING client_id, name, client_id` and then we would produce the "column reference \"client_id\" is ambiguous"
+    -- error from PostgreSQL. So we deduplicate with Set:
+    returnings = S.toList . S.fromList $ fldNames ++ (colName <$> fkCols)
+
+-- Traditional filters(e.g. id=eq.1) are added as root nodes of the LogicTree
+-- they are later concatenated with AND in the QueryBuilder
+addFilterToLogicForest :: Filter -> [LogicTree] -> [LogicTree]
+addFilterToLogicForest flt lf = Stmnt flt : lf

src/PostgREST/Error.hs

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

src/PostgREST/Main.hs

@@ -1,79 +0,0 @@
-module Main where
-
-
-import           PostgREST.App
-import           PostgREST.Config                     (AppConfig (..),
-                                                       minimumPgVersion,
-                                                       prettyVersion,
-                                                       readOptions)
-import           PostgREST.Error                      (pgErrResponse, PgError)
-import           PostgREST.Middleware
-import           PostgREST.DbStructure
-
-import           Control.Monad                        (unless)
-import           Control.Monad.IO.Class               (liftIO)
-import           Data.Aeson                           (encode)
-import           Data.Functor.Identity
-import           Data.Monoid                          ((<>))
-import           Data.String.Conversions              (cs)
-import           Data.Text                            (Text)
-import qualified Hasql                                as H
-import qualified Hasql.Postgres                       as P
-import           Network.Wai
-import           Network.Wai.Handler.Warp             hiding (Connection)
-import           Network.Wai.Middleware.RequestLogger (logStdout)
-import           System.IO                            (BufferMode (..),
-                                                       hSetBuffering, stderr,
-                                                       stdin, stdout)
-import           Web.JWT                              (secret)
-
-isServerVersionSupported :: H.Session P.Postgres IO Bool
-isServerVersionSupported = do
-  Identity (row :: Text) <- H.tx Nothing $ H.singleEx [H.stmt|SHOW server_version_num|]
-  return $ read (cs row) >= minimumPgVersion
-
-hasqlError :: PgError -> IO a
-hasqlError = error . cs . encode
-
-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 = P.StringSettings $ cs (configDatabase conf)
-      appSettings = setPort port
-                  . setServerName (cs $ "postgrest/" <> prettyVersion)
-                  $ defaultSettings
-      middle = logStdout . defaultMiddle
-
-  poolSettings <- maybe (fail "Improper session settings") return $
-    H.poolSettings (fromIntegral $ configPool conf) 30
-  pool :: H.Pool P.Postgres <- H.acquirePool pgSettings poolSettings
-
-  supportedOrError <- H.session pool isServerVersionSupported
-  either hasqlError
-    (\supported ->
-      unless supported $
-        error (
-          "Cannot run in this PostgreSQL version, PostgREST needs at least "
-          <> show minimumPgVersion)
-    ) supportedOrError
-
-  let txSettings = Just (H.ReadCommitted, Just True)
-  dbOrError <- H.session pool $ H.tx txSettings $ getDbStructure (cs $ configSchema conf)
-  dbStructure <- either hasqlError return dbOrError
-
-  runSettings appSettings $ middle $ \ req respond -> do
-    body <- strictRequestBody req
-    resOrError <- liftIO $ H.session pool $ H.tx txSettings $
-      runWithClaims conf (app dbStructure conf body) req
-    either (respond . pgErrResponse) respond resOrError

src/PostgREST/Middleware.hs

@@ -1,72 +1,71 @@
+{-|
+Module      : PostgREST.Middleware
+Description : Sets the PostgreSQL GUCs, role, search_path and pre-request function. Validates JWT.
+-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
+{-# LANGUAGE FlexibleContexts    #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 
 module PostgREST.Middleware where
 
-import           Data.Maybe                    (fromMaybe)
-import           Data.Text
-import           Data.String.Conversions       (cs)
-import           Data.Time.Clock.POSIX         (getPOSIXTime)
-import qualified Hasql                         as H
-import qualified Hasql.Postgres                as P
+import qualified Data.Aeson          as JSON
+import qualified Data.HashMap.Strict as M
+import           Data.Scientific     (FPFormat (..), formatScientific,
+                                      isInteger)
+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.Wai.Middleware.Cors   (cors)
-import           Network.Wai.Middleware.Gzip   (def, gzip)
-import           Network.Wai.Middleware.Static (only, staticPolicy)
+import Network.Wai                   (Application, Response)
+import Network.Wai.Middleware.Cors   (cors)
+import Network.Wai.Middleware.Gzip   (def, gzip)
+import Network.Wai.Middleware.Static (only, staticPolicy)
 
-import           PostgREST.ApiRequest       (pickContentType)
-import           PostgREST.Auth                (setRole, jwtClaims, claimsToSQL)
-import           PostgREST.Config              (AppConfig (..), corsPolicy)
-import           PostgREST.Error               (errResponse)
+import Crypto.JWT
 
-import           System.IO.Unsafe              (unsafePerformIO)
+import PostgREST.ApiRequest   (ApiRequest (..))
+import PostgREST.Auth         (JWTAttempt (..))
+import PostgREST.Config       (AppConfig (..), corsPolicy)
+import PostgREST.Error        (SimpleError (JwtTokenInvalid, JwtTokenMissing),
+                               errorResponseFor)
+import PostgREST.QueryBuilder (setLocalQuery, setLocalSearchPathQuery)
+import Protolude              hiding (head, toS)
+import Protolude.Conv         (toS)
 
-import           Prelude hiding(concat)
-
-import qualified Data.Vector             as V
-import qualified Hasql.Backend           as B
-import qualified Data.Map.Lazy           as M
-
-runWithClaims :: forall s. AppConfig ->
-                 (Request -> H.Tx P.Postgres s Response) ->
-                 Request -> H.Tx P.Postgres s Response
-runWithClaims conf app req = do
-    _ <- H.unitEx $ stmt setAnon
-    let time = unsafePerformIO getPOSIXTime
-    case split (== ' ') (cs auth) of
-      ("Bearer" : tokenStr : _) ->
-        case jwtClaims jwtSecret tokenStr time of
-          Just claims ->
-            if M.member "role" claims
-            then do
-              mapM_ H.unitEx $ stmt <$> claimsToSQL claims
-              app req
-            else invalidJWT
-          _ -> invalidJWT
-      _ -> app req
-  where
-    stmt c = B.Stmt c V.empty True
-    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
+runWithClaims :: AppConfig -> JWTAttempt ->
+                 (ApiRequest -> H.Transaction Response) ->
+                 ApiRequest -> H.Transaction Response
+runWithClaims conf eClaims app req =
+  case eClaims of
+    JWTMissingSecret      -> return . errorResponseFor $ JwtTokenMissing
+    JWTInvalid JWTExpired -> return . errorResponseFor . JwtTokenInvalid $ "JWT expired"
+    JWTInvalid e          -> return . errorResponseFor . JwtTokenInvalid . show $ e
+    JWTClaims claims      -> do
+      H.sql $ toS . mconcat $ setSearchPathSql : setRoleSql ++ claimsSql ++ [methodSql, pathSql] ++ headersSql ++ cookiesSql ++ appSettingsSql
+      mapM_ H.sql customReqCheck
+      app req
+      where
+        methodSql = setLocalQuery mempty ("request.method", toS $ iMethod req)
+        pathSql = setLocalQuery mempty ("request.path", toS $ iPath req)
+        headersSql = setLocalQuery "request.header." <$> iHeaders req
+        cookiesSql = setLocalQuery "request.cookie." <$> iCookies req
+        claimsSql = setLocalQuery "request.jwt.claim." <$> [(c,unquoted v) | (c,v) <- M.toList claimsWithRole]
+        appSettingsSql = setLocalQuery mempty <$> configSettings conf
+        setRoleSql = maybeToList $ (\x ->
+          setLocalQuery mempty ("role", unquoted x)) <$> M.lookup "role" claimsWithRole
+        setSearchPathSql = setLocalSearchPathQuery (iSchema req : configExtraSearchPath conf)
+        -- role claim defaults to anon if not specified in jwt
+        claimsWithRole = M.union claims (M.singleton "role" anon)
+        anon = JSON.String . toS $ configAnonRole conf
+        customReqCheck = (\f -> "select " <> toS f <> "();") <$> configReqCheck conf
 
 defaultMiddle :: Application -> Application
 defaultMiddle =
     gzip def
   . cors corsPolicy
   . staticPolicy (only [("favicon.ico", "static/favicon.ico")])
-  . unsupportedAccept
+
+unquoted :: JSON.Value -> Text
+unquoted (JSON.String t) = t
+unquoted (JSON.Number n) =
+  toS $ formatScientific Fixed (if isInteger n then Just 0 else Nothing) n
+unquoted (JSON.Bool b) = show b
+unquoted v = toS $ JSON.encode v

src/PostgREST/OpenAPI.hs

@@ -0,0 +1,391 @@
+{-|
+Module      : PostgREST.OpenAPI
+Description : Generates the OpenAPI output
+-}
+{-# LANGUAGE OverloadedStrings #-}
+
+module PostgREST.OpenAPI (
+  encodeOpenAPI
+, isMalformedProxyUri
+, pickProxy
+) where
+
+import qualified Data.HashSet.InsOrd as Set
+
+import Control.Arrow              ((&&&))
+import Data.Aeson                 (decode, encode)
+import Data.HashMap.Strict.InsOrd (InsOrdHashMap, fromList)
+import Data.Maybe                 (fromJust)
+import Data.String                (IsString (..))
+import Data.Text                  (append, breakOn, dropWhile, init,
+                                   intercalate, pack, tail, toLower,
+                                   unpack)
+import Network.URI                (URI (..), URIAuth (..),
+                                   isAbsoluteURI, parseURI)
+
+import Control.Lens
+import Data.Swagger
+
+import PostgREST.ApiRequest (ContentType (..))
+import PostgREST.Config     (docsVersion, prettyVersion)
+import PostgREST.Types      (Column (..), ForeignKey (..), PgArg (..),
+                             PrimaryKey (..), ProcDescription (..),
+                             Proxy (..), Table (..), toMime)
+import Protolude            hiding (Proxy, dropWhile, get,
+                             intercalate, toLower, toS, (&))
+import Protolude.Conv       (toS)
+
+makeMimeList :: [ContentType] -> MimeList
+makeMimeList cs = MimeList $ map (fromString . toS . toMime) cs
+
+toSwaggerType :: Text -> SwaggerType t
+toSwaggerType "character varying" = SwaggerString
+toSwaggerType "character"         = SwaggerString
+toSwaggerType "text"              = SwaggerString
+toSwaggerType "boolean"           = SwaggerBoolean
+toSwaggerType "smallint"          = SwaggerInteger
+toSwaggerType "integer"           = SwaggerInteger
+toSwaggerType "bigint"            = SwaggerInteger
+toSwaggerType "numeric"           = SwaggerNumber
+toSwaggerType "real"              = SwaggerNumber
+toSwaggerType "double precision"  = SwaggerNumber
+toSwaggerType _                   = SwaggerString
+
+makeTableDef :: [PrimaryKey] -> (Table, [Column], [Text]) -> (Text, Schema)
+makeTableDef pks (t, cs, _) =
+  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 (maybe "" (`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))
+  , ("on_conflict", (mempty :: Param)
+      & name        .~ "on_conflict"
+      & description ?~ "On Conflict"
+      & required    ?~ False
+      & schema .~ ParamOther ((mempty :: ParamOtherSchema)
+        & in_ .~ ParamQuery
+        & type_ ?~ SwaggerString))
+  , ("order", (mempty :: Param)
+      & name        .~ "order"
+      & description ?~ "Ordering"
+      & required    ?~ False
+      & schema .~ ParamOther ((mempty :: ParamOtherSchema)
+        & in_ .~ ParamQuery
+        & type_ ?~ SwaggerString))
+  , ("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, "select", "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,272 @@
-module PostgREST.Parsers
--- ( parseGetRequest
--- )
-where
+{-|
+Module      : PostgREST.Parsers
+Description : PostgREST parser combinators
 
-import           Control.Applicative hiding ((<$>))
-import           Data.Monoid
-import           Data.String.Conversions       (cs)
-import           Data.Text                     (Text)
-import           Data.Tree
-import           PostgREST.Types
-import           Text.ParserCombinators.Parsec hiding (many, (<|>))
-import           PostgREST.QueryBuilder (operators)
+This module is in charge of parsing all the querystring values in an url, e.g. the select, id, order in `/projects?select=id,name&id=eq.1&order=id,name.desc`.
+-}
+module PostgREST.Parsers where
 
-pRequestSelect :: Text -> Parser ReadRequest
-pRequestSelect rootNodeName = do
-  fieldTree <- pFieldForest
-  return $ foldr treeEntry (Node (Select [] [rootNodeName] [] Nothing, (rootNodeName, Nothing)) []) fieldTree
+import qualified Data.HashMap.Strict as M
+import qualified Data.Set            as S
+
+import Data.Either.Combinators (mapLeft)
+import Data.Foldable           (foldl1)
+import Data.List               (init, last)
+import Data.Text               (intercalate, replace, strip)
+import Text.Read               (read)
+
+import Data.Tree
+import Text.Parsec.Error
+import Text.ParserCombinators.Parsec hiding (many, (<|>))
+
+import PostgREST.Error      (ApiRequestError (ParseRequestError))
+import PostgREST.RangeQuery (NonnegRange)
+import PostgREST.Types
+import Protolude            hiding (intercalate, option, replace, toS,
+                             try)
+import Protolude.Conv       (toS)
+
+pRequestSelect :: Text -> Either ApiRequestError [Tree SelectItem]
+pRequestSelect selStr =
+  mapError $ parse pFieldForest ("failed to parse select parameter (" <> toS selStr <> ")") (toS selStr)
+
+pRequestOnConflict :: Text -> Either ApiRequestError  [FieldName]
+pRequestOnConflict oncStr =
+  mapError $ parse pColumns ("failed to parse on_conflict parameter (" <> toS oncStr <> ")") (toS oncStr)
+
+pRequestFilter :: (Text, Text) -> Either ApiRequestError (EmbedPath, Filter)
+pRequestFilter (k, v) = mapError $ (,) <$> path <*> (Filter <$> fld <*> oper)
   where
-    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)
-
-pRequestFilter :: (String, String) -> Either ParseError (Path, Filter)
-pRequestFilter (k, v) = (,) <$> path <*> (Filter <$> fld <*> op <*> val)
-  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
+    logicTree = do
+      op <- snd <$> path
+      -- Concat op and v to make pLogicTree argument regular,
+      -- in the form of "?and=and(.. , ..)" instead of "?and=(.. , ..)"
+      parse pLogicTree ("failed to parse logic tree (" ++ toS v ++ ")") $ toS (op <> v)
+
+pRequestColumns :: Maybe Text -> Either ApiRequestError (Maybe (S.Set FieldName))
+pRequestColumns colStr =
+  case colStr of
+    Just str ->
+      mapError $ Just . S.fromList <$> parse pColumns ("failed to parse columns parameter (" <> toS str <> ")") (toS str)
+    _ -> Right Nothing
 
 ws :: Parser Text
-ws = 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 "*" $> ("*"::ByteString))
 
 pFieldName :: Parser Text
-pFieldName =  cs <$> (many1 (letter <|> digit <|> oneOf "_")
-          <?> "field name (* or [a..z0..9_])")
+pFieldName =
+  pQuotedValue <|>
+  intercalate "-" . map toS <$> (many1 (letter <|> digit <|> oneOf "_ ") `sepBy1` dash) <?>
+  "field name (* or [a..z0..9_])"
+  where
+    isDash :: GenParser Char st ()
+    isDash = try ( char '-' >> notFollowedBy (char '>') )
+    dash :: Parser Char
+    dash = isDash $> '-'
 
-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
+    hint <- optionMaybe (
+        try ( char '!' *> pFieldName) <|>
+        -- deprecated, remove in next major version
+        try ( char '.' *> pFieldName)
+      )
+    return (fld, Nothing, alias, hint)
+  )
+
+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 <* notFollowedBy (noneOf ",)")) <|> (toS <$> many (noneOf ",)"))
+
+pQuotedValue :: Parser Text
+pQuotedValue = toS <$> (char '"' *> many (noneOf "\"") <* char '"')
 
 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 $> True)
+           <|> pure False
+           <?> "negation operator (not)"
+    pLogicOp :: Parser LogicOperator
+    pLogicOp = try (string "and" $> And)
+               <|> string "or" $> Or
+               <?> "logic operator (and, or)"
+
+pLogicSingleVal :: Parser SingleVal
+pLogicSingleVal = try (pQuotedValue <* notFollowedBy (noneOf ",)")) <|> 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)
+
+pColumns :: Parser [FieldName]
+pColumns = pFieldName `sepBy1` lexeme (char ',')
+
+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 "_$@") <|> pQuotedValue <?> "attribute name [a..z0..9_$@])"
+
+pJSPIdx :: Parser Int
+pJSPIdx = char '[' *> (read <$> many1 digit) <* char ']' <?> "array index [0..n]"

src/PostgREST/Private/Common.hs

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

src/PostgREST/Private/QueryFragment.hs

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

src/PostgREST/QueryBuilder.hs

@@ -1,450 +1,193 @@
-{-# LANGUAGE FlexibleInstances    #-}
-{-# LANGUAGE TupleSections #-}
-{-# OPTIONS_GHC -fno-warn-orphans #-}
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE FlexibleContexts      #-}
+{-# LANGUAGE FlexibleInstances     #-}
+{-# OPTIONS_GHC -fno-warn-orphans  #-}
 {-|
 Module      : PostgREST.QueryBuilder
-Description : PostgREST SQL generating functions.
+Description : PostgREST SQL queries generating functions.
 
 This module provides functions to consume data types that
-represent database objects (e.g. Relation, Schema, SqlQuery)
-and produces SQL Statements.
-
-Any function that outputs a SQL fragment should be in this module.
+represent database queries (e.g. ReadRequest, MutateRequest) and SqlFragment
+to produce SqlQuery type outputs.
 -}
 module PostgREST.QueryBuilder (
-    addRelations
-  , addJoinConditions
-  , asJson
-  , callProc
-  , createReadStatement
-  , createWriteStatement
-  , operators
-  , pgFmtIdent
-  , pgFmtLit
-  , requestToQuery
-  , sourceSubqueryName
-  , unquoted
+    readRequestToQuery
+  , mutateRequestToQuery
+  , readRequestToCountQuery
+  , requestToCallProcQuery
+  , limitedQuery
+  , setLocalQuery
+  , setLocalSearchPathQuery
   ) where
 
-import qualified Hasql                   as H
-import qualified Hasql.Backend           as B
-import qualified Hasql.Postgres          as P
+import qualified Data.Set as S
 
-import qualified Data.Aeson              as JSON
+import Data.Text (intercalate)
+import Data.Tree (Tree (..))
 
-import           PostgREST.RangeQuery    (NonnegRange, rangeLimit, rangeOffset)
-import           Control.Error           (note, fromMaybe, mapMaybe)
-import           Data.Maybe              (isNothing)
-import           Control.Monad           (join)
-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     (empty, (<|>))
-import           Data.Tree               (Tree(..))
-import qualified Data.Vector as V
-import           PostgREST.Types
-import qualified Data.Map as M
-import           Text.Regex.TDFA         ((=~))
-import qualified Data.ByteString.Char8   as BS
-import           Data.Scientific         ( FPFormat (..)
-                                         , formatScientific
-                                         , isInteger
-                                         )
-import           Prelude hiding          (unwords)
+import Data.Maybe
 
-import           Data.Ranged.Ranges      (singletonRange)
+import PostgREST.Private.QueryFragment
+import PostgREST.RangeQuery            (allRange, rangeLimit,
+                                        rangeOffset)
+import PostgREST.Types
+import Protolude                       hiding (cast, intercalate,
+                                        replace)
 
-type PStmt = H.Stmt P.Postgres
-instance Monoid PStmt where
-  mappend (B.Stmt query params prep) (B.Stmt query' params' prep') =
-    B.Stmt (query <> query') (params <> params') (prep && prep')
-  mempty = B.Stmt "" empty True
-type StatementT = PStmt -> PStmt
-
-createReadStatement :: SqlQuery -> Maybe NonnegRange -> Bool -> Bool -> Bool -> B.Stmt P.Postgres
-createReadStatement selectQuery range isSingle countTable asCsv =
-  B.Stmt (
-    wrapQuery selectQuery [
-      if countTable then countAllF else countNoneF,
-      countF,
-      "null", -- location header can not be calucalted
-      if asCsv
-        then asCsvF
-        else if isSingle then asJsonSingleF else asJsonF
-    ] selectStarF (if isNothing range && isSingle then Just $ singletonRange 0 else range)
-  ) V.empty True
-
-createWriteStatement :: SqlQuery -> SqlQuery -> Bool -> Bool ->
-                        [Text] -> Bool -> Payload -> B.Stmt P.Postgres
-createWriteStatement _ _ _ _ _ _ (PayloadParseError _) = undefined
-createWriteStatement selectQuery mutateQuery isSingle echoRequested
-                     pKeys asCsv (PayloadJSON (UniformObjects rows)) =
-  B.Stmt (
-    wrapQuery mutateQuery [
-      countNoneF, -- when updateing it does not make sense
-      countF,
-      if isSingle then locationF pKeys else "null",
-      if echoRequested
-      then
-        if asCsv
-        then asCsvF
-        else if isSingle then asJsonSingleF else asJsonF
-      else "null"
-
-    ] selectQuery Nothing
-  ) (V.singleton . B.encodeValue . JSON.Array . V.map JSON.Object $ rows) True
-
-addRelations :: Schema -> [Relation] -> Maybe ReadRequest -> ReadRequest -> Either Text ReadRequest
-addRelations schema allRelations parentNode node@(Node n@(query, (table, _)) forest) =
-  case parentNode of
-    Nothing -> Node (query, (table, Nothing)) <$> updatedForest
-    (Just (Node (_, (parentTable, _)) _)) -> Node <$> (addRel n <$> rel) <*> updatedForest
-      where
-        rel = note ("no relation between " <> table <> " and " <> parentTable)
-            $  findRelation schema table parentTable
-           <|> findRelation schema parentTable table
-        addRel :: (ReadQuery, (NodeName, Maybe Relation)) -> Relation -> (ReadQuery, (NodeName, Maybe Relation))
-        addRel (q, (t, _)) r = (q, (t, Just r))
-  where
-    updatedForest = mapM (addRelations schema allRelations (Just node)) forest
-    findRelation s t1 t2 =
-      find (\r -> s == (tableSchema . relTable) r && t1 == (tableName . relTable) r && t2 == (tableName . relFTable) r) allRelations
-
-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
-         q = addCond updatedQuery (getJoinConditions rel)
-         qq = q{from=tableName linkTable : from q}
-    _ -> Left "unknown relation"
-  where
-    -- add parentTable and parentJoinConditions to the query
-    updatedQuery = foldr (flip addCond) (query{from = parentTables ++ from query}) parentJoinConditions
-      where
-        parentJoinConditions = map (getJoinConditions . snd) parents
-        parentTables = map fst parents
-        parents = mapMaybe (getParents . rootLabel) forest
-        getParents (_, (tbl, Just rel@(Relation{relType=Parent}))) = Just (tbl, rel)
-        getParents _ = Nothing
-    updatedForest = mapM (addJoinConditions schema) forest
-    addCond q con = q{flt_=con ++ flt_ q}
-
-asJson :: StatementT
-asJson s = s {
-  B.stmtTemplate =
-    "array_to_json(coalesce(array_agg(row_to_json(t)), '{}'))::character varying from ("
-    <> B.stmtTemplate s <> ") t" }
-
-callProc :: QualifiedIdentifier -> JSON.Object -> PStmt
-callProc qi params = do
-  let args = intercalate "," $ map assignment (HM.toList params)
-  B.Stmt ("select * from " <> fromQi qi <> "(" <> args <> ")") empty True
-  where
-    assignment (n,v) = pgFmtIdent n <> ":=" <> insertableValue v
-
-operators :: [(Text, SqlFragment)]
-operators = [
-  ("eq", "="),
-  ("gte", ">="), -- has to be before gt (parsers)
-  ("gt", ">"),
-  ("lte", "<="), -- has to be before lt (parsers)
-  ("lt", "<"),
-  ("neq", "<>"),
-  ("like", "like"),
-  ("ilike", "ilike"),
-  ("in", "in"),
-  ("notin", "not in"),
-  ("isnot", "is not"), -- has to be before is (parsers)
-  ("is", "is"),
-  ("@@", "@@"),
-  ("@>", "@>"),
-  ("<@", "<@")
-  ]
-
-pgFmtIdent :: SqlFragment -> SqlFragment
-pgFmtIdent x =
- let escaped = replace "\"" "\"\"" (trimNullChars $ cs x) in
- if (cs escaped :: BS.ByteString) =~ danger
-   then "\"" <> escaped <> "\""
-   else escaped
- where danger = "^$|^[^a-z_]|[^a-z_0-9]" :: BS.ByteString
-
-pgFmtLit :: SqlFragment -> SqlFragment
-pgFmtLit x =
- let trimmed = trimNullChars x
-     escaped = "'" <> replace "'" "''" trimmed <> "'"
-     slashed = replace "\\" "\\\\" escaped in
- if "\\\\" `isInfixOf` escaped
-   then "E" <> slashed
-   else slashed
-
-requestToQuery :: Schema -> DbRequest -> SqlQuery
-requestToQuery _ (DbMutate (Insert _ (PayloadParseError _))) = undefined
-requestToQuery _ (DbMutate (Update _ (PayloadParseError _) _)) = undefined
-requestToQuery schema (DbRead (Node (Select colSelects tbls conditions ord, (mainTbl, _)) 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
-    tblSchema tbl = if tbl == sourceSubqueryName then "" else schema
-    qi = QualifiedIdentifier (tblSchema mainTbl) mainTbl
-    toQi t = QualifiedIdentifier (tblSchema t) t
-    query = unwords [
-      ("WITH " <> intercalate ", " withs) `emptyOnNull` withs,
-      "SELECT ", intercalate ", " (map (pgFmtSelectItem qi) colSelects ++ selects),
-      "FROM ", intercalate ", " (map (fromQi . toQi) tbls),
-      ("WHERE " <> intercalate " AND " ( map (pgFmtCondition qi ) conditions )) `emptyOnNull` conditions,
-      orderF (fromMaybe [] ord)
-      ]
-    (withs, selects) = foldr getQueryParts ([],[]) forest
-    getQueryParts :: Tree ReadNode -> ([SqlFragment], [SqlFragment]) -> ([SqlFragment], [SqlFragment])
-    getQueryParts (Node n@(_, (table, Just (Relation {relType=Child}))) forst) (w,s) = (w,sel:s)
-      where
-        sel = "("
-           <> "SELECT array_to_json(array_agg(row_to_json("<>table<>"))) "
-           <> "FROM (" <> subquery <> ") " <> table
-           <> ") AS " <> table
-           where subquery = requestToQuery schema (DbRead (Node n forst))
-    getQueryParts (Node n@(_, (table, Just (Relation {relType=Parent}))) forst) (w,s) = (wit:w,sel:s)
-      where
-        sel = "row_to_json(" <> table <> ".*) AS "<>table --TODO must be singular
-        wit = table <> " AS ( " <> subquery <> " )"
-          where subquery = requestToQuery schema (DbRead (Node n forst))
-    getQueryParts (Node n@(_, (table, Just (Relation {relType=Many}))) forst) (w,s) = (w,sel:s)
-      where
-        sel = "("
-           <> "SELECT array_to_json(array_agg(row_to_json("<>table<>"))) "
-           <> "FROM (" <> subquery <> ") " <> table
-           <> ") AS " <> table
-           where subquery = requestToQuery schema (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
+readRequestToQuery :: ReadRequest -> SqlQuery
+readRequestToQuery (Node (Select colSelects mainQi tblAlias implJoins logicForest joinConditions_ ordts range, _) forest) =
   unwords [
-    "INSERT INTO ", fromQi qi,
-    " (" <> colsString <> ")" <>
-    " SELECT " <> colsString <>
-    " FROM json_populate_recordset(null::" , fromQi qi, ", ?)",
-    " RETURNING " <> fromQi qi <> ".*"
+    "SELECT " <> intercalate ", " (map (pgFmtSelectItem qi) colSelects ++ selects),
+    "FROM " <> intercalate ", " (tabl : implJs),
+    unwords joins,
+    ("WHERE " <> intercalate " AND " (map (pgFmtLogicTree qi) logicForest ++ map pgFmtJoinCondition joinConditions_))
+      `emptyOnFalse` (null logicForest && null joinConditions_),
+    ("ORDER BY " <> intercalate ", " (map (pgFmtOrderTerm qi) ordts)) `emptyOnFalse` null ordts,
+    ("LIMIT " <> maybe "ALL" show (rangeLimit range) <> " OFFSET " <> show (rangeOffset range)) `emptyOnFalse` (range == allRange)
     ]
-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
+  where
+    implJs = fromQi <$> implJoins
+    tabl = fromQi mainQi <> maybe mempty (\a -> " AS " <> pgFmtIdent a) tblAlias
+    qi = maybe mainQi (QualifiedIdentifier mempty) tblAlias
+    (joins, selects) = foldr getJoinsSelects ([],[]) forest
+
+getJoinsSelects :: ReadRequest -> ([SqlFragment], [SqlFragment]) -> ([SqlFragment], [SqlFragment])
+getJoinsSelects rr@(Node (_, (name, Just Relation{relType=relTyp,relTable=Table{tableName=table}}, alias, _, _)) _) (j,s) =
+  let subquery = readRequestToQuery rr in
+  case relTyp of
+    M2O ->
+      let aliasOrName = fromMaybe name alias
+          localTableName = pgFmtIdent $ table <> "_" <> aliasOrName
+          sel = "row_to_json(" <> localTableName <> ".*) AS " <> pgFmtIdent aliasOrName
+          joi = " LEFT JOIN LATERAL( " <> subquery <> " ) AS " <> localTableName <> " ON TRUE " in
+      (joi:j,sel:s)
+    _ ->
+      let sel = "COALESCE (("
+             <> "SELECT json_agg(" <> pgFmtIdent table <> ".*) "
+             <> "FROM (" <> subquery <> ") " <> pgFmtIdent table
+             <> "), '[]') AS " <> pgFmtIdent (fromMaybe name alias) in
+      (j,sel:s)
+getJoinsSelects (Node (_, (_, Nothing, _, _, _)) _) _ = ([], [])
+
+mutateRequestToQuery :: MutateRequest -> SqlQuery
+mutateRequestToQuery (Insert mainQi iCols onConflct putConditions returnings) =
+  unwords [
+    "WITH " <> normalizedBody,
+    "INSERT INTO ", fromQi mainQi, if S.null iCols then " " else "(" <> cols <> ")",
+    unwords [
+      "SELECT " <> cols <> " FROM",
+      "json_populate_recordset", "(null::", fromQi mainQi, ", " <> selectBody <> ") _",
+      -- Only used for PUT
+      ("WHERE " <> intercalate " AND " (pgFmtLogicTree (QualifiedIdentifier mempty "_") <$> putConditions)) `emptyOnFalse` null putConditions],
+    maybe "" (\(oncDo, oncCols) -> (
+      "ON CONFLICT(" <> intercalate ", " (pgFmtIdent <$> oncCols) <> ") " <> case oncDo of
+      IgnoreDuplicates ->
+        "DO NOTHING"
+      MergeDuplicates  ->
+        if S.null iCols
+           then "DO NOTHING"
+           else "DO UPDATE SET " <> intercalate ", " (pgFmtIdent <> const " = EXCLUDED." <> pgFmtIdent <$> S.toList iCols)
+                                   ) `emptyOnFalse` null oncCols) onConflct,
+    returningF mainQi returnings
+    ]
+  where
+    cols = intercalate ", " $ pgFmtIdent <$> S.toList iCols
+mutateRequestToQuery (Update mainQi uCols logicForest returnings) =
+  if S.null uCols
+    -- if there are no columns we cannot do UPDATE table SET {empty}, it'd be invalid syntax
+    -- selecting an empty resultset from mainQi gives us the column names to prevent errors when using &select=
+    -- the select has to be based on "returnings" to make computed overloaded functions not throw
+    then "WITH " <> ignoredBody <> "SELECT " <> empty_body_returned_columns <> " FROM " <> fromQi mainQi <> " WHERE false"
+    else
       unwords [
-        "UPDATE ", fromQi qi,
-        " SET " <> intercalate "," assignments <> " ",
-        ("WHERE " <> intercalate " AND " ( map (pgFmtCondition qi ) conditions )) `emptyOnNull` conditions,
-        "RETURNING " <> fromQi qi <> ".*"
+        "WITH " <> normalizedBody,
+        "UPDATE " <> fromQi mainQi <> " SET " <> cols,
+        "FROM (SELECT * FROM json_populate_recordset", "(null::", fromQi mainQi, ", " <> selectBody <> ")) _ ",
+        ("WHERE " <> intercalate " AND " (pgFmtLogicTree mainQi <$> logicForest)) `emptyOnFalse` null logicForest,
+        returningF mainQi returnings
         ]
-    Nothing -> undefined
   where
-    qi = QualifiedIdentifier schema mainTbl
+    cols = intercalate ", " (pgFmtIdent <> const " = _." <> pgFmtIdent <$> S.toList uCols)
+    empty_body_returned_columns :: SqlFragment
+    empty_body_returned_columns
+      | null returnings = "NULL"
+      | otherwise       = intercalate ", " (pgFmtColumn (QualifiedIdentifier mempty $ qiName mainQi) <$> returnings)
+mutateRequestToQuery (Delete mainQi logicForest returnings) =
+  unwords [
+    "WITH " <> ignoredBody,
+    "DELETE FROM ", fromQi mainQi,
+    ("WHERE " <> intercalate " AND " (map (pgFmtLogicTree mainQi) logicForest)) `emptyOnFalse` null logicForest,
+    returningF mainQi returnings
+    ]
 
-requestToQuery schema (DbMutate (Delete mainTbl conditions)) =
-  query
+requestToCallProcQuery :: QualifiedIdentifier -> [PgArg] -> Bool -> Maybe PreferParameters -> [FieldName] -> SqlQuery
+requestToCallProcQuery qi pgArgs returnsScalar preferParams returnings =
+  unwords [
+    "WITH",
+    argsCTE,
+    sourceBody ]
   where
-    qi = QualifiedIdentifier schema mainTbl
-    query = unwords [
-      "DELETE FROM ", fromQi qi,
-      ("WHERE " <> intercalate " AND " ( map (pgFmtCondition qi ) conditions )) `emptyOnNull` conditions,
-      "RETURNING " <> fromQi qi <> ".*"
-      ]
+    paramsAsSingleObject    = preferParams == Just SingleObject
+    paramsAsMultipleObjects = preferParams == Just MultipleObjects
 
-sourceSubqueryName :: SqlFragment
-sourceSubqueryName = "pg_source"
+    (argsCTE, args)
+      | null pgArgs = (ignoredBody, "")
+      | paramsAsSingleObject = ("pgrst_args AS (SELECT NULL)", "$1::json")
+      | otherwise = (
+          unwords [
+            normalizedBody <> ",",
+            "pgrst_args AS (",
+              "SELECT * FROM json_to_recordset(" <> selectBody <> ") AS _(" <> fmtArgs (\a -> " " <> pgaType a) <> ")",
+            ")"]
+         , if paramsAsMultipleObjects
+             then fmtArgs (\a -> " := pgrst_args." <> pgFmtIdent (pgaName a))
+             else fmtArgs (\a -> " := (SELECT " <> pgFmtIdent (pgaName a) <> " FROM pgrst_args LIMIT 1)")
+        )
 
-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
+    fmtArgs :: (PgArg -> SqlFragment) -> SqlFragment
+    fmtArgs argFrag = intercalate ", " ((\a -> pgFmtIdent (pgaName a) <> argFrag a) <$> pgArgs)
 
--- private functions
-asCsvF :: SqlFragment
-asCsvF = asCsvHeaderF <> " || '\n' || " <> asCsvBodyF
-  where
-    asCsvHeaderF =
-      "(SELECT string_agg(a.k, ',')" <>
-      "  FROM (" <>
-      "    SELECT json_object_keys(r)::TEXT as k" <>
-      "    FROM ( " <>
-      "      SELECT row_to_json(hh) as r from " <> sourceSubqueryName <> " as hh limit 1" <>
-      "    ) s" <>
-      "  ) a" <>
-      ")"
-    asCsvBodyF = "coalesce(string_agg(substring(t::text, 2, length(t::text) - 2), '\n'), '')"
+    sourceBody :: SqlFragment
+    sourceBody
+      | paramsAsMultipleObjects =
+          if returnsScalar
+            then "SELECT " <> callIt <> " AS pgrst_scalar FROM pgrst_args"
+            else unwords [ "SELECT pgrst_lat_args.*"
+                         , "FROM pgrst_args,"
+                         , "LATERAL ( SELECT " <> returned_columns <> " FROM " <> callIt <> " ) pgrst_lat_args" ]
+      | otherwise =
+          if returnsScalar
+            then "SELECT " <> callIt <> " AS pgrst_scalar"
+            else "SELECT " <> returned_columns <> " FROM " <> callIt
 
-asJsonF :: SqlFragment
-asJsonF = "array_to_json(array_agg(row_to_json(t)))::character varying"
+    callIt :: SqlFragment
+    callIt = fromQi qi <> "(" <> args <> ")"
 
-asJsonSingleF :: SqlFragment --TODO! unsafe when the query actually returns multiple rows, used only on inserting and returning single element
-asJsonSingleF = "string_agg(row_to_json(t)::text, ',')::character varying "
+    returned_columns :: SqlFragment
+    returned_columns
+      | null returnings = "*"
+      | otherwise       = intercalate ", " (pgFmtColumn (QualifiedIdentifier mempty $ qiName qi) <$> returnings)
 
-countAllF :: SqlFragment
-countAllF = "(SELECT pg_catalog.count(1) FROM (SELECT * FROM " <> sourceSubqueryName <> ") a )"
 
-countF :: SqlFragment
-countF = "pg_catalog.count(t)"
+-- | SQL query meant for COUNTing the root node of the Tree.
+-- It only takes WHERE into account and doesn't include LIMIT/OFFSET because it would reduce the COUNT.
+-- SELECT 1 is done instead of SELECT * to prevent doing expensive operations(like functions based on the columns)
+-- inside the FROM target.
+readRequestToCountQuery :: ReadRequest -> SqlQuery
+readRequestToCountQuery (Node (Select{from=qi, where_=logicForest}, _) _) =
+ unwords [
+   "SELECT 1",
+   "FROM " <> fromQi qi,
+   ("WHERE " <> intercalate " AND " (map (pgFmtLogicTree qi) logicForest)) `emptyOnFalse` null logicForest
+   ]
 
-countNoneF :: SqlFragment
-countNoneF = "null"
+limitedQuery :: SqlQuery -> Maybe Integer -> SqlQuery
+limitedQuery query maxRows = query <> maybe mempty (\x -> " LIMIT " <> show x) maxRows
 
-locationF :: [Text] -> SqlFragment
-locationF pKeys =
-    "(" <>
-    " WITH s AS (SELECT row_to_json(ss) as r from " <> sourceSubqueryName <> " 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 <> "')"
-    ) <>
-    ")"
+setLocalQuery :: Text -> (Text, Text) -> SqlQuery
+setLocalQuery prefix (k, v) =
+  "SET LOCAL " <> pgFmtIdent (prefix <> k) <> " = " <> pgFmtLit v <> ";"
 
-fromQi :: QualifiedIdentifier -> SqlFragment
-fromQi t = (if s == "" then "" else pgFmtIdent s <> ".") <> pgFmtIdent n
-  where
-    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 = 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}}))
-
-emptyOnNull :: Text -> [a] -> Text
-emptyOnNull val x = if null x then "" else val
-
-orderF :: [OrderTerm] -> SqlFragment
-orderF ts =
-  if null ts
-    then ""
-    else "ORDER BY " <> clause
-  where
-    clause = intercalate "," (map queryTerm ts)
-    queryTerm :: OrderTerm -> Text
-    queryTerm t = " "
-           <> cs (pgFmtIdent $ otTerm t) <> " "
-           <> (cs.show) (otDirection t) <> " "
-           <> maybe "" (cs.show) (otNullOrder t) <> " "
-
-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"])
-
-pgFmtColumn :: QualifiedIdentifier -> Text -> SqlFragment
-pgFmtColumn table "*" = fromQi table <> ".*"
-pgFmtColumn table c = fromQi table <> "." <> pgFmtIdent c
-
-pgFmtField :: QualifiedIdentifier -> Field -> SqlFragment
-pgFmtField table (c, jp) = pgFmtColumn table c <> pgFmtJsonPath jp
-
-pgFmtSelectItem :: QualifiedIdentifier -> SelectItem -> SqlFragment
-pgFmtSelectItem table (f@(_, jp), Nothing) = pgFmtField table f <> pgFmtAsJsonPath jp
-pgFmtSelectItem table (f@(_, jp), Just cast ) = "CAST (" <> pgFmtField table f <> " AS " <> cast <> " )" <> pgFmtAsJsonPath jp
-
-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 == sourceSubqueryName then "" else s) ft
-      _ -> ""
-
-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
- where
-   star c = if c == '*' then '%' else c
-   unknownLiteral = (<> "::unknown ") . pgFmtLit
-
-pgFmtOperator :: Text -> SqlFragment
-pgFmtOperator opCode = fromMaybe "=" $ M.lookup opCode operatorsMap
-  where
-    operatorsMap = M.fromList operators
-
-pgFmtJsonPath :: Maybe JsonPath -> SqlFragment
-pgFmtJsonPath (Just [x]) = "->>" <> pgFmtLit x
-pgFmtJsonPath (Just (x:xs)) = "->" <> pgFmtLit x <> pgFmtJsonPath ( Just xs )
-pgFmtJsonPath _ = ""
-
-pgFmtAsJsonPath :: Maybe JsonPath -> SqlFragment
-pgFmtAsJsonPath Nothing = ""
-pgFmtAsJsonPath (Just xx) = " AS " <> last xx
-
-trimNullChars :: Text -> Text
-trimNullChars = T.takeWhile (/= '\x0')
-
-withSourceF :: SqlFragment -> SqlFragment
-withSourceF s = "WITH " <> sourceSubqueryName <> " AS (" <> s <>")"
-
-fromF :: SqlFragment -> SqlFragment -> SqlFragment
-fromF sel limit = "FROM (" <> sel <> " " <> limit <> ") t"
-
-limitF :: Maybe NonnegRange -> SqlFragment
-limitF r  = "LIMIT " <> limit <> " OFFSET " <> offset
-  where
-    limit  = maybe "ALL" (cs . show) $ join $ rangeLimit <$> r
-    offset = cs . show $ fromMaybe 0 $ rangeOffset <$> r
-
-selectStarF :: SqlFragment
-selectStarF = "SELECT * FROM " <> sourceSubqueryName
-
-wrapQuery :: SqlQuery -> [Text] -> Text ->  Maybe NonnegRange -> SqlQuery
-wrapQuery source selectColumns returnSelect range =
-  withSourceF source <>
-  " SELECT " <>
-  intercalate ", " selectColumns <>
-  " " <>
-  fromF returnSelect ( limitF range )
+setLocalSearchPathQuery :: [Text] -> SqlQuery
+setLocalSearchPathQuery vals =
+  "SET LOCAL search_path = " <> intercalate ", " (pgFmtLit <$> vals) <> ";"

src/PostgREST/RangeQuery.hs

@@ -1,61 +1,103 @@
+{-|
+Module      : PostgREST.RangeQuery
+Description : Logic regarding the `Range`/`Content-Range` headers and `limit`/`offset` querystring arguments.
+-}
 module PostgREST.RangeQuery (
   rangeParse
 , rangeRequested
 , rangeLimit
 , rangeOffset
+, restrictRange
+, rangeGeq
+, allRange
 , NonnegRange
+, rangeStatusHeader
+, contentRangeH
 ) where
 
+import qualified Data.ByteString.Char8 as BS
 
-import           Control.Applicative
-import           Network.HTTP.Types.Header
-import           PostgREST.Types           ()
+import Data.List       (lookup)
+import Text.Regex.TDFA ((=~))
 
-import qualified Data.ByteString.Char8     as BS
-import           Data.Ranged.Boundaries
-import           Data.Ranged.Ranges
+import Control.Applicative
+import Data.Ranged.Boundaries
+import Data.Ranged.Ranges
+import Network.HTTP.Types.Header
+import Network.HTTP.Types.Status
 
-import           Data.String.Conversions   (cs)
-import           Text.Read                 (readMaybe)
-import           Text.Regex.TDFA           ((=~))
+import Protolude      hiding (toS)
+import Protolude.Conv (toS)
 
-import           Data.Maybe                (fromMaybe, listToMaybe)
+type NonnegRange = Range Integer
 
-import           Prelude
-
-type NonnegRange = Range Int
-
-rangeParse :: BS.ByteString -> Maybe NonnegRange
+rangeParse :: BS.ByteString -> NonnegRange
 rangeParse range = do
   let rangeRegex = "^([0-9]+)-([0-9]*)$" :: BS.ByteString
 
-  parsedRange <- listToMaybe (range =~ rangeRegex :: [[BS.ByteString]])
+  case listToMaybe (range =~ rangeRegex :: [[BS.ByteString]]) of
+    Just parsedRange ->
+      let [_, mLower, mUpper] = readMaybe . toS <$> parsedRange
+          lower         = maybe emptyRange rangeGeq mLower
+          upper         = maybe allRange rangeLeq mUpper in
+      rangeIntersection lower upper
+    Nothing -> allRange
 
-  let [_, from, to] = readMaybe . cs <$> parsedRange
-  let lower = fromMaybe emptyRange   (rangeGeq <$> from)
-  let upper = fromMaybe (rangeGeq 0) (rangeLeq <$> to)
+rangeRequested :: RequestHeaders -> NonnegRange
+rangeRequested headers = maybe allRange rangeParse $ lookup hRange headers
 
-  return $ rangeIntersection lower upper
+restrictRange :: Maybe Integer -> NonnegRange -> NonnegRange
+restrictRange Nothing r = r
+restrictRange (Just limit) r =
+   rangeIntersection r $
+     Range BoundaryBelowAll (BoundaryAbove $ rangeOffset r + limit - 1)
 
-rangeRequested :: RequestHeaders -> Maybe NonnegRange
-rangeRequested = (rangeParse =<<) . lookup hRange
-
-rangeLimit :: NonnegRange -> Maybe Int
+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 -> Int
+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 :: Int -> NonnegRange
+rangeGeq :: Integer -> NonnegRange
 rangeGeq n =
   Range (BoundaryBelow n) BoundaryAboveAll
 
-rangeLeq :: Int -> NonnegRange
+allRange :: NonnegRange
+allRange = rangeGeq 0
+
+rangeLeq :: Integer -> NonnegRange
 rangeLeq n =
   Range BoundaryBelowAll (BoundaryAbove n)
+
+rangeStatusHeader :: NonnegRange -> Int64 -> Maybe Int64 -> (Status, Header)
+rangeStatusHeader topLevelRange queryTotal tableTotal =
+  let lower = rangeOffset topLevelRange
+      upper = lower + toInteger queryTotal - 1
+      contentRange = contentRangeH lower upper (toInteger <$> tableTotal)
+      status = rangeStatus lower upper (toInteger <$> tableTotal)
+  in (status, contentRange)
+  where
+    rangeStatus :: Integer -> Integer -> Maybe Integer -> Status
+    rangeStatus _ _ Nothing = status200
+    rangeStatus lower upper (Just total)
+      | lower > total               = status416 -- 416 Range Not Satisfiable
+      | (1 + upper - lower) < total = status206 -- 206 Partial Content
+      | otherwise                   = status200 -- 200 OK
+
+contentRangeH :: (Integral a, Show a) => a -> a -> Maybe a -> Header
+contentRangeH lower upper total =
+    ("Content-Range", toUtf8 headerValue)
+    where
+      headerValue   = rangeString <> "/" <> totalString :: Text
+      rangeString
+        | totalNotZero && fromInRange = show lower <> "-" <> show upper
+        | otherwise = "*"
+      totalString   = maybe "*" show total
+      totalNotZero  = maybe True (0 /=) total
+      fromInRange   = lower <= upper

src/PostgREST/Statements.hs

@@ -0,0 +1,183 @@
+{-|
+Module      : PostgREST.Statements
+Description : PostgREST single SQL statements.
+
+This module constructs single SQL statements that can be parametrized and prepared.
+
+- It consumes the SqlQuery types generated by the QueryBuilder module.
+- It generates the body format and some headers of the final HTTP response.
+
+TODO: Currently, createReadStatement is not using prepared statements. See https://github.com/PostgREST/postgrest/issues/718.
+-}
+module PostgREST.Statements (
+    createWriteStatement
+  , createReadStatement
+  , callProcStatement
+  , createExplainStatement
+) where
+
+
+import           Control.Lens                    ((^?))
+import           Data.Aeson                      as JSON
+import qualified Data.Aeson.Lens                 as L
+import qualified Data.ByteString.Char8           as BS
+import           Data.Maybe
+import qualified Hasql.Decoders                  as HD
+import qualified Hasql.Encoders                  as HE
+import qualified Hasql.Statement                 as H
+import           PostgREST.Private.Common
+import           PostgREST.Private.QueryFragment
+import           PostgREST.Types
+import           Protolude                       hiding (cast,
+                                                  replace, toS)
+import           Protolude.Conv                  (toS)
+import           Text.InterpolatedString.Perl6   (qc)
+
+{-| The generic query result format used by API responses. The location header
+    is represented as a list of strings containing variable bindings like
+    @"k1=eq.42"@, or the empty list if there is no location header.
+-}
+type ResultsWithCount = (Maybe Int64, Int64, [BS.ByteString], BS.ByteString, Either Text [GucHeader])
+
+createWriteStatement :: SqlQuery -> SqlQuery -> Bool -> Bool -> Bool ->
+                        PreferRepresentation -> [Text] -> PgVersion ->
+                        H.Statement ByteString ResultsWithCount
+createWriteStatement selectQuery mutateQuery wantSingle isInsert asCsv rep pKeys pgVer =
+  unicodeStatement sql (param HE.unknown) decodeStandard True
+ where
+  sql = [qc|
+      WITH
+      {sourceCTEName} AS ({mutateQuery})
+      SELECT
+        '' AS total_result_set,
+        pg_catalog.count(_postgrest_t) AS page_total,
+        {locF} AS header,
+        {bodyF} AS body,
+        {responseHeadersF pgVer} AS response_headers
+      FROM ({selectF}) _postgrest_t |]
+
+  locF =
+    if isInsert && rep `elem` [Full, HeadersOnly]
+      then unwords [
+        "CASE WHEN pg_catalog.count(_postgrest_t) = 1",
+          "THEN coalesce(" <> locationF pKeys <> ", " <> noLocationF <> ")",
+          "ELSE " <> noLocationF,
+        "END"]
+      else noLocationF
+
+  bodyF
+    | rep `elem` [None, HeadersOnly] = "''"
+    | asCsv = asCsvF
+    | wantSingle = asJsonSingleF
+    | otherwise = asJsonF
+
+  selectF
+    -- prevent using any of the column names in ?select= when no response is returned from the CTE
+    | rep `elem` [None, HeadersOnly] = "SELECT * FROM " <> sourceCTEName
+    | otherwise                      = selectQuery
+
+  decodeStandard :: HD.Result ResultsWithCount
+  decodeStandard =
+   fromMaybe (Nothing, 0, [], mempty, Right []) <$> HD.rowMaybe standardRow
+
+createReadStatement :: SqlQuery -> SqlQuery -> Bool -> Bool -> Bool -> Maybe FieldName -> PgVersion ->
+                       H.Statement () ResultsWithCount
+createReadStatement selectQuery countQuery isSingle countTotal asCsv binaryField pgVer =
+  unicodeStatement sql HE.noParams decodeStandard False
+ where
+  sql = [qc|
+      WITH
+      {sourceCTEName} AS ({selectQuery})
+      {countCTEF}
+      SELECT
+        {countResultF} AS total_result_set,
+        pg_catalog.count(_postgrest_t) AS page_total,
+        {noLocationF} AS header,
+        {bodyF} AS body,
+        {responseHeadersF pgVer} AS response_headers
+      FROM ( SELECT * FROM {sourceCTEName}) _postgrest_t |]
+
+  (countCTEF, countResultF) = countF countQuery countTotal
+
+  bodyF
+    | asCsv = asCsvF
+    | isSingle = asJsonSingleF
+    | isJust binaryField = asBinaryF $ fromJust binaryField
+    | otherwise = asJsonF
+
+  decodeStandard :: HD.Result ResultsWithCount
+  decodeStandard =
+    HD.singleRow standardRow
+
+{-| Read and Write api requests use a similar response format which includes
+    various record counts and possible location header. This is the decoder
+    for that common type of query.
+-}
+standardRow :: HD.Row ResultsWithCount
+standardRow = (,,,,) <$> nullableColumn HD.int8 <*> column HD.int8
+                    <*> column header <*> column HD.bytea <*> column decodeGucHeaders
+  where
+    header = HD.array $ HD.dimension replicateM $ element HD.bytea
+
+type ProcResults = (Maybe Int64, Int64, ByteString, Either Text [GucHeader])
+
+callProcStatement :: Bool -> SqlQuery -> SqlQuery -> SqlQuery -> Bool ->
+                     Bool -> Bool -> Bool -> Bool -> Maybe FieldName -> PgVersion ->
+                     H.Statement ByteString ProcResults
+callProcStatement returnsScalar callProcQuery selectQuery countQuery countTotal isSingle asCsv asBinary multObjects binaryField pgVer =
+  unicodeStatement sql (param HE.unknown) decodeProc True
+  where
+    sql = [qc|
+      WITH {sourceCTEName} AS ({callProcQuery})
+      {countCTEF}
+      SELECT
+        {countResultF} AS total_result_set,
+        pg_catalog.count(_postgrest_t) AS page_total,
+        {bodyF} AS body,
+        {responseHeadersF pgVer} AS response_headers
+      FROM ({selectQuery}) _postgrest_t;|]
+
+    (countCTEF, countResultF) = countF countQuery countTotal
+
+    bodyF
+     | returnsScalar = scalarBodyF
+     | isSingle     = asJsonSingleF
+     | asCsv = asCsvF
+     | isJust binaryField = asBinaryF $ fromJust binaryField
+     | otherwise = asJsonF
+
+    scalarBodyF
+     | asBinary    = asBinaryF "pgrst_scalar"
+     | multObjects = "json_agg(_postgrest_t.pgrst_scalar)::character varying"
+     | otherwise   = "(json_agg(_postgrest_t.pgrst_scalar)->0)::character varying"
+
+    decodeProc :: HD.Result ProcResults
+    decodeProc =
+      fromMaybe (Just 0, 0, mempty, Right []) <$> HD.rowMaybe procRow
+      where
+        procRow = (,,,) <$> nullableColumn HD.int8 <*> column HD.int8
+                        <*> column HD.bytea <*> column decodeGucHeaders
+
+createExplainStatement :: SqlQuery -> H.Statement () (Maybe Int64)
+createExplainStatement countQuery =
+  unicodeStatement sql HE.noParams decodeExplain False
+  where
+    sql = [qc| EXPLAIN (FORMAT JSON) {countQuery} |]
+    -- |
+    -- An `EXPLAIN (FORMAT JSON) select * from items;` output looks like this:
+    -- [{
+    --   "Plan": {
+    --     "Node Type": "Seq Scan", "Parallel Aware": false, "Relation Name": "items",
+    --     "Alias": "items", "Startup Cost": 0.00, "Total Cost": 32.60,
+    --     "Plan Rows": 2260,"Plan Width": 8} }]
+    -- We only obtain the Plan Rows here.
+    decodeExplain :: HD.Result (Maybe Int64)
+    decodeExplain =
+      let row = HD.singleRow $ column HD.bytea in
+      (^? L.nth 0 . L.key "Plan" .  L.key "Plan Rows" . L._Integral) <$> row
+
+unicodeStatement :: Text -> HE.Params a -> HD.Result b -> Bool -> H.Statement a b
+unicodeStatement = H.Statement . encodeUtf8
+
+decodeGucHeaders :: HD.Value (Either Text [GucHeader])
+decodeGucHeaders = first toS . JSON.eitherDecode . toS <$> HD.bytea

src/PostgREST/Types.hs

@@ -1,50 +1,237 @@
+{-|
+Module      : PostgREST.Types
+Description : PostgREST common types and functions used by the rest of the modules
+-}
+{-# LANGUAGE DeriveGeneric         #-}
+{-# LANGUAGE DuplicateRecordFields #-}
+
 module PostgREST.Types where
-import Data.Text
+
+import Control.Lens.Getter (view)
+import Control.Lens.Tuple  (_1)
+
+import qualified Data.Aeson               as JSON
+import qualified Data.ByteString          as BS
+import qualified Data.ByteString.Internal as BS (c2w)
+import qualified Data.ByteString.Lazy     as BL
+import qualified Data.CaseInsensitive     as CI
+import qualified Data.HashMap.Strict      as M
+import qualified Data.Set                 as S
+import qualified GHC.Show
+
+import Network.HTTP.Types.Header (Header, hContentType)
+
 import Data.Tree
-import qualified Data.ByteString.Lazy as BL
-import qualified Data.ByteString      as BS
-import qualified Data.Vector          as V
-import Data.Aeson
+
+import PostgREST.RangeQuery (NonnegRange)
+import Protolude            hiding (toS)
+import Protolude.Conv       (toS)
+
+-- | Enumeration of currently supported response content types
+data ContentType = CTApplicationJSON | CTSingularJSON
+                 | CTTextCSV | CTTextPlain
+                 | CTOpenAPI | CTOctetStream
+                 | CTAny | CTOther ByteString deriving (Show, Eq)
+
+-- | Convert from ContentType to a full HTTP Header
+toHeader :: ContentType -> Header
+toHeader ct = (hContentType, toMime ct <> "; charset=utf-8")
+
+-- | Convert from ContentType to a ByteString representing the mime type
+toMime :: ContentType -> ByteString
+toMime CTApplicationJSON = "application/json"
+toMime CTTextCSV         = "text/csv"
+toMime CTTextPlain       = "text/plain"
+toMime CTOpenAPI         = "application/openapi+json"
+toMime CTSingularJSON    = "application/vnd.pgrst.object+json"
+toMime CTOctetStream     = "application/octet-stream"
+toMime CTAny             = "*/*"
+toMime (CTOther ct)      = ct
+
+-- | Convert from ByteString to ContentType. Warning: discards MIME parameters
+decodeContentType :: BS.ByteString -> ContentType
+decodeContentType ct = case BS.takeWhile (/= BS.c2w ';') ct of
+  "application/json"                  -> CTApplicationJSON
+  "text/csv"                          -> CTTextCSV
+  "text/plain"                        -> CTTextPlain
+  "application/openapi+json"          -> CTOpenAPI
+  "application/vnd.pgrst.object+json" -> CTSingularJSON
+  "application/vnd.pgrst.object"      -> CTSingularJSON
+  "application/octet-stream"          -> CTOctetStream
+  "*/*"                               -> CTAny
+  ct'                                 -> CTOther ct'
+
+-- | A SQL query that can be executed independently
+type SqlQuery = Text
+
+-- | A part of a SQL query that cannot be executed independently
+type SqlFragment = Text
+
+data PreferResolution = MergeDuplicates | IgnoreDuplicates deriving Eq
+instance Show PreferResolution where
+  show MergeDuplicates  = "resolution=merge-duplicates"
+  show IgnoreDuplicates = "resolution=ignore-duplicates"
+
+-- | How to return the mutated data. From https://tools.ietf.org/html/rfc7240#section-4.2
+data PreferRepresentation = Full        -- ^ Return the body plus the Location header(in case of POST).
+                          | HeadersOnly -- ^ Return the Location header(in case of POST). This needs a SELECT privilege on the pk.
+                          | None        -- ^ Return nothing from the mutated data.
+                          deriving Eq
+instance Show PreferRepresentation where
+  show Full        = "return=representation"
+  show None        = "return=minimal"
+  show HeadersOnly = mempty
+
+data PreferParameters
+  = SingleObject    -- ^ Pass all parameters as a single json object to a stored procedure
+  | MultipleObjects -- ^ Pass an array of json objects as params to a stored procedure
+  deriving Eq
+
+instance Show PreferParameters where
+  show SingleObject    = "params=single-object"
+  show MultipleObjects = "params=multiple-objects"
+
+data PreferCount
+  = ExactCount     -- ^ exact count(slower)
+  | PlannedCount   -- ^ PostgreSQL query planner rows count guess. Done by using EXPLAIN {query}.
+  | EstimatedCount -- ^ use the query planner rows if the count is superior to max-rows, otherwise get the exact count.
+  deriving Eq
+
+instance Show PreferCount where
+  show ExactCount     = "count=exact"
+  show PlannedCount   = "count=planned"
+  show EstimatedCount = "count=estimated"
 
 data DbStructure = DbStructure {
-  dbTables :: [Table]
-, dbColumns :: [Column]
-, dbRelations :: [Relation]
+  dbTables      :: [Table]
+, dbColumns     :: [Column]
+, dbRelations   :: [Relation]
 , dbPrimaryKeys :: [PrimaryKey]
+, dbProcs       :: ProcsMap
+, pgVersion     :: PgVersion
 } deriving (Show, Eq)
 
+-- TODO Table could hold references to all its Columns
+tableCols :: DbStructure -> Schema -> TableName -> [Column]
+tableCols dbs tSchema tName = filter (\Column{colTable=Table{tableSchema=s, tableName=t}} -> s==tSchema && t==tName) $ dbColumns dbs
+
+-- TODO Table could hold references to all its PrimaryKeys
+tablePKCols :: DbStructure -> Schema -> TableName -> [Text]
+tablePKCols dbs tSchema tName =  pkName <$> filter (\pk -> tSchema == (tableSchema . pkTable) pk && tName == (tableName . pkTable) pk) (dbPrimaryKeys dbs)
+
+data PgArg = PgArg {
+  pgaName :: Text
+, pgaType :: Text
+, pgaReq  :: Bool
+} deriving (Show, Eq, 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 {
+  pdSchema      :: Schema
+, pdName        :: Text
+, pdDescription :: Maybe Text
+, pdArgs        :: [PgArg]
+, pdReturnType  :: RetType
+, pdVolatility  :: ProcVolatility
+} deriving (Show, Eq)
+
+-- Order by least number of args in the case of overloaded functions
+instance Ord ProcDescription where
+  ProcDescription schema1 name1 des1 args1 rt1 vol1 `compare` ProcDescription schema2 name2 des2 args2 rt2 vol2
+    | schema1 == schema2 && name1 == name2 && length args1 < length args2  = LT
+    | schema2 == schema2 && name1 == name2 && length args1 > length args2  = GT
+    | otherwise = (schema1, name1, des1, args1, rt1, vol1) `compare` (schema2, name2, des2, args2, rt2, vol2)
+
+-- | A map of all procs, all of which can be overloaded(one entry will have more than one ProcDescription).
+-- | It uses a HashMap for a faster lookup.
+type ProcsMap = M.HashMap QualifiedIdentifier [ProcDescription]
+
+{-|
+  Search a pg procedure by its parameters. Since a function can be overloaded, the name is not enough to find it.
+  An overloaded function can have a different volatility or even a different return type.
+  Ideally, handling overloaded functions should be left to pg itself. But we need to know certain proc attributes in advance.
+-}
+findProc :: QualifiedIdentifier -> S.Set Text -> Bool -> ProcsMap -> Maybe ProcDescription
+findProc qi payloadKeys paramsAsSingleObject allProcs =
+  case M.lookup qi allProcs of
+    Nothing     -> Nothing
+    Just [proc] -> Just proc           -- if it's not an overloaded function then immediately get the ProcDescription
+    Just procs  -> find matches procs  -- Handle overloaded functions case
+  where
+    matches proc =
+      if paramsAsSingleObject
+        -- if the arg is not of json type let the db give the err
+        then length (pdArgs proc) == 1
+        else payloadKeys `S.isSubsetOf` S.fromList (pgaName <$> pdArgs proc)
+
+{-|
+  Search the procedure parameters by matching them with the specified keys.
+  If the key doesn't match a parameter, a parameter with a default type "text" is assumed.
+-}
+specifiedProcArgs :: S.Set FieldName -> Maybe ProcDescription -> [PgArg]
+specifiedProcArgs keys proc =
+  let
+    args = maybe [] pdArgs proc
+  in
+  (\k -> fromMaybe (PgArg k "text" True) (find ((==) k . pgaName) args)) <$> S.toList keys
+
+procReturnsScalar :: ProcDescription -> Bool
+procReturnsScalar proc = case proc of
+  ProcDescription{pdReturnType = (Single (Scalar _))} -> True
+  _                                                   -> False
+
+procTableName :: ProcDescription -> Maybe TableName
+procTableName proc = case pdReturnType proc of
+  SetOf  (Composite qi) -> Just $ qiName qi
+  Single (Composite qi) -> Just $ qiName qi
+  _                     -> Nothing
+
 type Schema = Text
 type TableName = Text
-type SqlQuery = Text
-type SqlFragment = Text
-type RequestBody = BL.ByteString
 
 data Table = Table {
-  tableSchema     :: Schema
-, 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)
+instance Eq Table where
+  Table{tableSchema=s1,tableName=n1} == Table{tableSchema=s2,tableName=n2} = s1 == s2 && n1 == n2
+
+tableQi :: Table -> QualifiedIdentifier
+tableQi Table{tableSchema=s, tableName=n} = QualifiedIdentifier s n
+
+newtype ForeignKey = ForeignKey { fkCol :: Column } deriving (Show, Eq, Ord)
 
 data Column =
     Column {
-      colTable     :: Table
-    , colName      :: Text
-    , colPosition  :: Int
-    , colNullable  :: Bool
-    , colType      :: Text
-    , colUpdatable :: Bool
-    , colMaxLen    :: Maybe Int
-    , colPrecision :: Maybe Int
-    , colDefault   :: Maybe Text
-    , colEnum      :: [Text]
-    , colFK        :: Maybe ForeignKey
-    }
-  | Star { colTable :: Table }
-  deriving (Show, Ord)
+      colTable       :: Table
+    , colName        :: FieldName
+    , 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)
+instance Eq Column where
+  Column{colTable=t1,colName=n1} == Column{colTable=t2,colName=n2} = t1 == t2 && n1 == n2
+
+-- | The source table column a view column refers to
+type SourceColumn = (Column, ViewColumn)
+type ViewColumn = Column
 
 data PrimaryKey = PrimaryKey {
     pkTable :: Table
@@ -53,104 +240,298 @@ 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)
 
+{-|
+  Represents a pg identifier with a prepended schema name "schema.table"
+  When qiSchema is "", the schema is defined by the pg search_path
+-}
 data QualifiedIdentifier = QualifiedIdentifier {
   qiSchema :: Schema
 , qiName   :: TableName
-} deriving (Show, Eq)
+} deriving (Show, Eq, Ord, Generic)
+instance Hashable QualifiedIdentifier
 
+-- | The relationship [cardinality](https://en.wikipedia.org/wiki/Cardinality_(data_modeling)).
+-- | TODO: missing one-to-one
+data Cardinality = O2M -- ^ one-to-many,  previously known as Parent
+                 | M2O -- ^ many-to-one,  previously known as Child
+                 | M2M -- ^ many-to-many, previously known as Many
+                 deriving Eq
+instance Show Cardinality where
+  show O2M = "o2m"
+  show M2O = "m2o"
+  show M2M = "m2m"
 
-data RelationType = Child | Parent | Many deriving (Show, Eq)
+type ConstraintName = Text
+
+{-|
+  "Relation"ship between two tables.
+  The order of the relColumns and relFColumns should be maintained to get the join conditions right.
+  TODO merge relColumns and relFColumns to a tuple or Data.Bimap
+-}
 data Relation = Relation {
-  relTable    :: Table
-, relColumns  :: [Column]
-, relFTable   :: Table
-, relFColumns :: [Column]
-, relType     :: RelationType
-, relLTable   :: Maybe Table
-, relLCols1   :: Maybe [Column]
-, relLCols2   :: Maybe [Column]
+  relTable      :: Table
+, relColumns    :: [Column]
+, relConstraint :: Maybe ConstraintName -- ^ Just on O2M/M2O, Nothing on M2M
+, relFTable     :: Table
+, relFColumns   :: [Column]
+, relType       :: Cardinality
+, relJunction   :: Maybe Junction -- ^ Junction for M2M Cardinality
 } 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)
+-- | Junction table on an M2M relationship
+data Junction = Junction {
+  junTable       :: Table
+, junConstraint1 :: Maybe ConstraintName
+, junCols1       :: [Column]
+, junConstraint2 :: Maybe ConstraintName
+, junCols2       :: [Column]
+} 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)
+isSelfReference :: Relation -> Bool
+isSelfReference r = relTable r == relFTable r
+
+data PayloadJSON =
+  -- | Cached attributes of a JSON payload
+  ProcessedJSON {
+    -- | This is the raw ByteString that comes from the request body.
+    -- We cache this instead of an Aeson Value because it was detected that for large payloads the encoding
+    -- had high memory usage, see https://github.com/PostgREST/postgrest/pull/1005 for more details
+    pjRaw  :: BL.ByteString
+    -- | Keys of the object or if it's an array these keys are guaranteed to be the same across all its objects
+  , pjKeys :: S.Set Text
+  }|
+  RawJSON {
+    pjRaw  :: BL.ByteString
+  } deriving (Show, Eq)
+
+data PJType = PJArray { pjaLength :: Int } | PJObject deriving (Show, Eq)
+
+data Proxy = Proxy {
+  proxyScheme :: Text
+, 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"),
+  ("wfts", "@@ websearch_to_tsquery")
+  ]
+
+data OpExpr = OpExpr Bool Operation deriving (Eq, Show)
+data Operation = Op Operator SingleVal |
+                 In ListVal |
+                 Fts Operator (Maybe Language) SingleVal deriving (Eq, Show)
+type Language = Text
+
+-- | Represents a single value in a filter, e.g. id=eq.singleval
+type SingleVal = Text
+-- | Represents a list value in a filter, e.g. id=in.(val1,val2,val3)
+type ListVal = [Text]
+
+data LogicOperator = And | Or deriving Eq
+instance Show LogicOperator where
+  show And = "AND"
+  show 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::[Text], flt_::[Filter], order::Maybe [OrderTerm] }  deriving (Show, Eq)
-data MutateQuery = Insert { in_::Text, qPayload::Payload }
-                 | Delete { in_::Text, where_::[Filter] }
-                 | Update { in_::Text, 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 (CI.CI ByteString, ByteString)
+  deriving (Show, Eq)
+
+instance JSON.FromJSON GucHeader where
+  parseJSON (JSON.Object o) = case headMay (M.toList o) of
+    Just (k, JSON.String s) | M.size o == 1 -> pure $ GucHeader (CI.mk $ toS k, toS s)
+                            | otherwise     -> mzero
+    _ -> mzero
+  parseJSON _          = mzero
+
+unwrapGucHeader :: GucHeader -> Header
+unwrapGucHeader (GucHeader (k, v)) = (k, v)
+
+-- | Add headers not already included to allow the user to override them instead of duplicating them
+addHeadersIfNotIncluded :: [Header] -> [Header] -> [Header]
+addHeadersIfNotIncluded newHeaders initialHeaders =
+  filter (\(nk, _) -> isNothing $ find (\(ik, _) -> ik == nk) initialHeaders) newHeaders ++
+  initialHeaders
+
+{-|
+  This type will hold information about which particular 'Relation' between two tables to choose when there are multiple ones.
+  Specifically, it will contain the name of the foreign key or the join table in many to many relations.
+-}
+type SelectItem = (Field, Maybe Cast, Maybe Alias, Maybe EmbedHint)
+-- | Disambiguates an embedding operation when there's multiple relationships between two tables.
+-- | Can be the name of a foreign key constraint, column name or the junction in an m2m relationship.
+type EmbedHint = Text
+-- | Path of the embedded levels, e.g "clients.projects.name=eq.." gives Path ["clients", "projects"]
+type EmbedPath = [Text]
+data Filter = Filter { field::Field, opExpr::OpExpr } deriving (Show, Eq)
+data JoinCondition = JoinCondition (QualifiedIdentifier, FieldName)
+                                   (QualifiedIdentifier, FieldName) deriving (Show, Eq)
+
+data ReadQuery = Select {
+    select         :: [SelectItem]
+  , from           :: QualifiedIdentifier
+-- | A table alias is used in case of self joins
+  , fromAlias      :: Maybe Alias
+-- | Only used for Many to Many joins. Parent and Child joins use explicit joins.
+  , implicitJoins  :: [QualifiedIdentifier]
+  , where_         :: [LogicTree]
+  , joinConditions :: [JoinCondition]
+  , order          :: [OrderTerm]
+  , range_         :: NonnegRange
+} deriving (Show, Eq)
+
+data MutateQuery =
+  Insert {
+    in_        :: QualifiedIdentifier
+  , insCols    :: S.Set FieldName
+  , onConflict :: Maybe (PreferResolution, [FieldName])
+  , where_     :: [LogicTree]
+  , returning  :: [FieldName]
+  }|
+  Update {
+    in_       :: QualifiedIdentifier
+  , updCols   :: S.Set FieldName
+  , where_    :: [LogicTree]
+  , returning :: [FieldName]
+  }|
+  Delete {
+    in_       :: QualifiedIdentifier
+  , where_    :: [LogicTree]
+  , returning :: [FieldName]
+  } deriving (Show, Eq)
+
 type ReadRequest = Tree ReadNode
 type MutateRequest = MutateQuery
-data DbRequest = DbRead ReadRequest | DbMutate MutateRequest
 
+type ReadNode = (ReadQuery, (NodeName, Maybe Relation, Maybe Alias, Maybe EmbedHint, Depth))
+type Depth = Integer
 
-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
+-- First level FieldNames(e.g get a,b from /table?select=a,b,other(c,d))
+fstFieldNames :: ReadRequest -> [FieldName]
+fstFieldNames (Node (sel, _) _) =
+  fst . view _1 <$> select sel
 
-instance ToJSON ForeignKey where
-  toJSON fk = object [
-      "schema" .= tableSchema t
-    , "table"  .= tableName t
-    , "column" .= colName c ]
-    where
-      c = fkCol fk
-      t = colTable c
+data PgVersion = PgVersion {
+  pgvNum  :: Int32
+, pgvName :: Text
+} deriving (Eq, Show)
 
-instance ToJSON Table where
-  toJSON v = object [
-      "schema"     .= tableSchema v
-    , "name"       .= tableName v
-    , "insertable" .= tableInsertable v ]
+instance Ord PgVersion where
+  (PgVersion v1 _) `compare` (PgVersion v2 _) = v1 `compare` v2
 
-instance Eq Table where
-  Table{tableSchema=s1,tableName=n1} == Table{tableSchema=s2,tableName=n2} = s1 == s2 && n1 == n2
+-- | Tells the minimum PostgreSQL version required by this version of PostgREST
+minimumPgVersion :: PgVersion
+minimumPgVersion = pgVersion94
 
-instance Eq Column where
-  Column{colTable=t1,colName=n1} == Column{colTable=t2,colName=n2} = t1 == t2 && n1 == n2
-  _ == _ = False
+pgVersion94 :: PgVersion
+pgVersion94 = PgVersion 90400 "9.4"
+
+pgVersion95 :: PgVersion
+pgVersion95 = PgVersion 90500 "9.5"
+
+pgVersion96 :: PgVersion
+pgVersion96 = PgVersion 90600 "9.6"
+
+pgVersion100 :: PgVersion
+pgVersion100 = PgVersion 100000 "10"
+
+pgVersion109 :: PgVersion
+pgVersion109 = PgVersion 100009 "10.9"
+
+pgVersion110 :: PgVersion
+pgVersion110 = PgVersion 110000 "11.0"
+
+pgVersion112 :: PgVersion
+pgVersion112 = PgVersion 110002 "11.2"
+
+pgVersion114 :: PgVersion
+pgVersion114 = PgVersion 110004 "11.4"
+
+pgVersion121 :: PgVersion
+pgVersion121 = PgVersion 120001 "12.1"
+
+sourceCTEName :: SqlFragment
+sourceCTEName = "pgrst_source"
+
+-- | full jspath, e.g. .property[0].attr.detail
+type JSPath = [JSPathExp]
+-- | jspath expression, e.g. .property, .property[0] or ."property-dash"
+data JSPathExp = JSPKey Text | JSPIdx Int deriving (Eq, Show)
+
+-- | Current database connection status data ConnectionStatus
+data ConnectionStatus
+  = NotConnected
+  | Connected PgVersion
+  | FatalConnectionError Text
+  deriving (Eq, Show)

stack.yaml

@@ -1,7 +1,11 @@
-flags: {}
-packages:
-- '.'
+# stack is used for circleci and appveyor CI builds
+resolver: lts-15.8
+nix:
+  packages: [pcre, pkgconfig, postgresql, zlib]
+  # disable pure by default so that the test enviroment can be passed 
+  pure: false
 extra-deps:
-  - Ranged-sets-0.3.0
-  - packdeps-0.4.1
-resolver: nightly-2015-10-27
+- configurator-pg-0.2.2@sha256:8f3f7c66dd4a53852283c70806ebc101a7219f8b01c3e80c5130e9749c998dc8,2987
+- hspec-wai-json-0.10.1@sha256:67b405c38f0a9e2771480c8d3ecd8aeb8d8776a35d3b2906cb1b76c9538617e4,1629
+- interpolatedstring-perl6-1.0.2@sha256:7ce49c8a69a2a1b89c001ed79db2aab656ffd0faf2a7a701a553b6deb5c8ba7f,1073
+- protolude-0.3.0@sha256:8361b811b420585b122a7ba715aa5923834db6e8c36309bf267df2dbf66b95ef,2693

stack.yaml.lock

@@ -0,0 +1,40 @@
+# This file was autogenerated by Stack.
+# You should not edit this file by hand.
+# For more information, please see the documentation at:
+#   https://docs.haskellstack.org/en/stable/lock_files
+
+packages:
+- completed:
+    hackage: configurator-pg-0.2.2@sha256:8f3f7c66dd4a53852283c70806ebc101a7219f8b01c3e80c5130e9749c998dc8,2987
+    pantry-tree:
+      size: 2462
+      sha256: a669366632e19f396dfe52599d54414b9c92d5664ea4391c2c797be271f9aa0e
+  original:
+    hackage: configurator-pg-0.2.2@sha256:8f3f7c66dd4a53852283c70806ebc101a7219f8b01c3e80c5130e9749c998dc8,2987
+- completed:
+    hackage: hspec-wai-json-0.10.1@sha256:67b405c38f0a9e2771480c8d3ecd8aeb8d8776a35d3b2906cb1b76c9538617e4,1629
+    pantry-tree:
+      size: 349
+      sha256: fb9e89b79cde3276baa484c860c6b9eeebdbc1a5c43301293351a25bc4c08e87
+  original:
+    hackage: hspec-wai-json-0.10.1@sha256:67b405c38f0a9e2771480c8d3ecd8aeb8d8776a35d3b2906cb1b76c9538617e4,1629
+- completed:
+    hackage: interpolatedstring-perl6-1.0.2@sha256:7ce49c8a69a2a1b89c001ed79db2aab656ffd0faf2a7a701a553b6deb5c8ba7f,1073
+    pantry-tree:
+      size: 300
+      sha256: f7f0b06c58db814d1f12ed6f4f4cb67ff8c72e51da61c04db12c2aedb896542e
+  original:
+    hackage: interpolatedstring-perl6-1.0.2@sha256:7ce49c8a69a2a1b89c001ed79db2aab656ffd0faf2a7a701a553b6deb5c8ba7f,1073
+- completed:
+    hackage: protolude-0.3.0@sha256:8361b811b420585b122a7ba715aa5923834db6e8c36309bf267df2dbf66b95ef,2693
+    pantry-tree:
+      size: 1644
+      sha256: babf32b414f25f790b7a4ce6bae5c960bc51a11a289e7c47335b222e6762560c
+  original:
+    hackage: protolude-0.3.0
+snapshots:
+- completed:
+    size: 492015
+    url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/15/8.yaml
+    sha256: 926bc3d70249dd0ba05277ff00943c0addb35b627cb641752669e7cf771310d0
+  original: lts-15.8