Bump version

Move DbRequest building functions to new module (#787 )
Fix alias in select for mutate queries and small refactor (#779 )
2017-01-20 00:21:08 -08:00 · 2017-01-17 21:59:59 -08:00 · 2017-01-16 23:20:02 -08:00 · 2017-01-16 15:11:37 -08:00 · 2017-01-06 07:11:07 -08:00 · 2016-12-18 15:46:53 -08:00
65 changed files with 8962 additions and 2177 deletions
@@ -1,3 +1,4 @@
+.DS_Store
 db
 dist
 .cabal-sandbox
@@ -5,3 +6,9 @@ cabal.sandbox.config
 hscope.out
 codex.tags
 .anvil
+.stack-work*
+tags
+site
+*~
+*#*
+.#*
@@ -3,6 +3,214 @@
 All notable changes to this project will be documented in this file.
 This project adheres to [Semantic Versioning](http://semver.org/).

+## Unreleased
+
+### Added
+
+### Fixed
+
+## [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
+- Use reasonable amount of memory during bulk inserts - @begriffs
+
+### Added
+- Ensure JWT expires - @calebmer
+- Postgres connection string argument - @calebmer
+- Encode JWT for procs that return type `jwt_claims` - @diogob
+- Full text operators `@>`,`<@` - @ruslantalpa
+- Shaping of the response body (filter columns, embed relations) with &select parameter for POST/PATCH - @ruslantalpa
+- Detect relationships between public views and private tables - @calebmer
+- `Prefer: plurality=singular` for selecting single objects - @calebmer
+
+### Removed
+- API versioning feature - @calebmer
+- `--db-x` command line arguments - @calebmer
+- Secure flag - @calebmer
+- PUT request handling - @ruslantalpa
+
+### Changed
+- Embed foreign keys with {} rather than () - @begriffs
+- Remove version number from binary filename in release - @begriffs
+
+## [0.2.12.1] - 2015-11-12
+
+### Fixed
+- Correct order for -> and ->> in a json path - @ruslantalpa
+- Return empty array instead of 500 when a set returning function returns an empty result set - @diogob
+
+## [0.2.12.0] - 2015-10-25
+
+### Added
+- Embed associations, e.g. `/film?select=*,director(*)` - @ruslantalpa
+- Filter columns, e.g. `?select=col1,col2` - @ruslantalpa
+- Does not execute the count total if header "Prefer: count=none" - @diogob
+
+### Fixed
+- Tolerate a missing role in user creation - @calebmer
+- Avoid unnecessary text re-encoding - @ruslantalpa
+
+## [0.2.11.1] - 2015-09-01
+
+### Fixed
+- Accepts `*/*` in Accept header - @diogob
+
+## [0.2.11.0] - 2015-08-28
+### Added
+- Negate any filter in a uniform way, e.g. `?col=not.eq=foo` - @diogob
+- Call stored procedures
+- Filter NOT IN values, e.g. `?col=notin.1,2,3` - @rall
+- CSV responses to GET requests with `Accept: text/csv` - @diogob
+- Debian init scripts - @mkhon
+- Allow filters by computed columns - @diogob
+
+### Fixed
+- Reset user role on error
+- Compatible with Stack
+- Add materialized views to results in GET / - @diogob
+- Indicate insertable=true for views that are insertable through triggers - @diogob
+- Builds under GHC 7.10
+- Allow the use of columns named "count" in relations queried - @diogob
+
+## [0.2.10.0] - 2015-06-03
+### Added
+- Full text search, eg `/foo?text_vector=@@.bar`
+- Include auth id as well as db role to views (for row-level security)
+
+## [0.2.9.1] - 2015-05-20
+### Fixed
+- Put -Werror behind a cabal flag (for CI) so Hackage accepts package
+
+## [0.2.9.0] - 2015-05-20
+### Added
+- Return range headers in PATCH
+- Return PATCHed resources if header "Prefer: return=representation"
+- Allow nested objects and arrays in JSON post for jsonb columns
+- JSON Web Tokens - [Federico Rampazzo](https://github.com/framp)
+- Expose PostgREST as a Haskell package
+
+### Fixed
+- Return 404 if no records updated by PATCH
+
 ## [0.2.8.0] - 2015-04-17
 ### Added
 - Option to specify nulls first or last, eg `/people?order=age.desc.nullsfirst`
@@ -0,0 +1,63 @@
+# Contributing to PostgREST
+
+**First:** if you're unsure or afraid of _anything_, just ask or
+submit the issue or pull request anyways. You won't be yelled at
+for giving your best effort. The worst that can happen is that
+you'll be politely asked to change something. We appreciate any
+sort of contributions, and don't want a wall of rules to get in the
+way of that.
+
+However, for those individuals who want a bit more guidance on the
+best way to contribute to the project, read on. This document will
+cover what we're looking for. By addressing all the points we're
+looking for, it raises the chances we can quickly merge or address
+your contributions.
+
+## Issues
+
+### Reporting an Issue
+
+* Make sure you test against the latest released version. It is possible
+  we already fixed the bug you're experiencing.
+
+* Also check the `CHANGELOG.md` to see if any unreleased changes affect
+  the issue. The very newest changes can take a little while to be released
+  as a new official version.
+
+* 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 `SIGHUP` signal or restart it to ensure the schema cache
+  is not stale. This sometimes fixes apparent bugs.
+
+## Code
+
+### Haskell Conventions
+
+* 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.
+
+* For help building the Haskell code on your computer check out the [building from
+source](http://postgrest.com/install/server/#building-from-source)
+wiki page.
+
+## Maintenance
+
+### Schedule
+
+Currently I (@begriffs) am the sole maintainer, and while I am
+overjoyed to help resolve issues I also have to balance this with
+my other obligations.  If you don't get a response right away
+don't worry, I will definitely get to it. Also you can join the
+Gitter [chat room](https://gitter.im/begriffs/postgrest) to
+discuss issues you are having.
@@ -0,0 +1,18 @@
+FROM debian:jessie
+
+ENV POSTGREST_VERSION 0.4.0.0
+
+RUN apt-get update && \
+    apt-get install -y tar xz-utils wget libpq-dev && \
+    apt-get clean && rm -rf /var/lib/apt/lists/* /tmp/* /var/tmp/*
+
+RUN wget http://github.com/begriffs/postgrest/releases/download/v${POSTGREST_VERSION}/postgrest-${POSTGREST_VERSION}-ubuntu.tar.xz && \
+    tar --xz -xvf postgrest-${POSTGREST_VERSION}-ubuntu.tar.xz && \
+    mv postgrest /usr/local/bin/postgrest && \
+    rm postgrest-${POSTGREST_VERSION}-ubuntu.tar.xz
+
+# PostgREST reads /etc/postgrest.conf so map the configuration
+# file in when you run this container
+CMD exec postgrest
+
+EXPOSE 3000
@@ -1,50 +1,46 @@
 ![Logo](static/logo.png "Logo")

-[![Build Status](https://circleci.com/gh/begriffs/postgrest.png?circle-token=f723c01686abf0364de1e2eaae5aff1f68bd3ff2)](https://circleci.com/gh/begriffs/postgrest/tree/master)
+[![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">
-  <img src="static/heroku.png" alt="Deploy">
+  <img src="https://img.shields.io/badge/%E2%86%91_Deploy_to-Heroku-7056bf.svg" alt="Deploy">
 </a>
+[![Join the chat at https://gitter.im/begriffs/postgrest](https://img.shields.io/badge/gitter-join%20chat%20%E2%86%92-brightgreen.svg)](https://gitter.im/begriffs/postgrest)
+[![Docs](https://img.shields.io/badge/docs-latest-brightgreen.svg?style=flat)](https://postgrest.com)

 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) | Watch [Video](http://begriffs.com/posts/2014-12-30-intro-to-postgrest.html) | [GUI Demo](http://marmelab.com/ng-admin-postgrest)
-
-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
+Try making requests to the live [demo
+server](https://postgrest.herokuapp.com) with an HTTP client such
+as [postman](http://www.getpostman.com/). The structure of the demo
+database is defined by
 [begriffs/postgrest-example](https://github.com/begriffs/postgrest-example).
 You can use it as inspiration for test-driven server migrations in
 your own projects.

+Also try other tools in the PostgREST
+[ecosystem](http://postgrest.com/en/v0.4/intro.html#ecosystem).
+
 ### Usage

-Download the binary ([OS X](http://bin.begriffs.com/dbapi/osx/postgrest-0.2.8.0.tar.xz) / [Linux](http://bin.begriffs.com/dbapi/heroku/postgrest-0.2.8.0.tar.xz)) and invoke like so:
+1. Download the binary ([latest release](https://github.com/begriffs/postgrest/releases/latest))
+   for your platform.
+2. Invoke for help:

-```bash
-postgrest  --db-host localhost  --db-port 5432     \
-           --db-name my_db      --db-user postgres \
-           --db-pass foobar     --db-pool 200      \
-           --anonymous postgres --port 3000        \
-           --v1schema public
-```
-
-In production include the `--secure` option which redirects all
-requests to HTTPS. Note that PostgREST does not handle the SSL
-internally and must be put behind another server that does (such
-as nginx or the Heroku load balancer).
+    ```bash
+    postgrest --help
+    ```

 ### Performance

-TLDR; subsecond response times for up to 2000 requests/sec on Heroku free tier. ([see the load test](https://github.com/begriffs/postgrest/wiki/Performance-and-Scaling))
-
-If you're used to servers written in interpreted languages (or named
-after precious gems), prepare to be pleasantly surprised by PostgREST
-performance.
+TLDR; subsecond response times for up to 2000 requests/sec on Heroku
+free tier. If you're used to servers written in interpreted languages
+(or named after precious gems), prepare to be pleasantly surprised by
+PostgREST performance.

 Three factors contribute to the speed. First the server is written
-in [Haskell](https://new-www.haskell.org/) using the
+in [Haskell](https://www.haskell.org/) using the
 [Warp](http://www.yesodweb.com/blog/2011/03/preliminary-warp-cross-language-benchmarks)
 HTTP server (aka a compiled language with lightweight threads).
 Next it delegates as much calculation as possible to the database
@@ -60,65 +56,54 @@ 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 Postgres binary protocol
+* 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](https://github.com/begriffs/postgrest/wiki/Performance-and-Scaling).
-
 Other optimizations are possible, and some are outlined in the
 [Future Features](#future-features).

 ### Security

-PostgREST handles authentication (HTTP Basic over SSL) 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.
+PostgREST [handles
+authentication](http://postgrest.com/en/v0.4/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.

-Postgres 9.5 will soon support true [row-level
-security](http://michael.otacoo.com/postgresql-2/postgres-9-5-feature-highlight-row-level-security/).
-In the meantime what isn't yet implemented can be simulated with
-triggers and security-barrier views. Because the possible queries
-to the database are limited to certain templates using
+PostgreSQL 9.5 supports true [row-level
+security](http://www.postgresql.org/docs/9.5/static/ddl-rowsecurity.html).
+In previous versions it can be simulated with triggers and
+security-barrier views. Because the possible queries to the database
+are limited to certain templates using
 [leakproof](http://blog.2ndquadrant.com/how-do-postgresql-security_barrier-views-work/)
 functions, the trigger workaround does not compromise row-level
 security.

-For example security patterns see the [security
-guide](https://github.com/begriffs/postgrest/wiki/Security-and-Permissions).
-
 ### Versioning

 A robust long-lived API needs the freedom to exist in multiple
-versions. PostgREST supports versioning through HTTP content
-negotiation. Requests for a certain version translate into switching
-which database schema to search for tables. PostgreSQL schema search
-paths allow tables from earlier versions to be reused verbatim in
-later versions.
+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.

-To learn more, see the [guide to versioning](https://github.com/begriffs/postgrest/wiki/API-Versioning).
+### Self-documentation

-### Self-documention
+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.

-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.
-
-The number of rows returned by an endpoint is reported by - and
-limited with - range headers. More about
+This project uses HTTP to communicate other metadata as well.  For
+instance the number of rows returned by an endpoint is reported by -
+and limited with - range headers. More about
 [that](http://begriffs.com/posts/2014-03-06-beyond-http-header-links.html).

-There are more opportunities for self-documentation listed in [Future
-Features](#future-features).
-
 ### Data Integrity

 Rather than relying on an Object Relational Mapper and custom
@@ -129,38 +114,16 @@ data (including your API server).
 The PostgREST exposes HTTP interface with safeguards to prevent
 surprises, such as enforcing idempotent PUT requests, and

-See examples of [Postgres
+See examples of [PostgreSQL
 constraints](http://www.tutorialspoint.com/postgresql/postgresql_constraints.htm)
-and the [guide to routing](https://github.com/begriffs/postgrest/wiki/Routing).
-
-### Future Features
-
-* Watching endpoint changes with sockets and Postgres pubsub
-* Specifying per-view HTTP caching
-* Inferring good default caching policies from the Postgres stats collector
-* Generating mock data for test clients
-* Maintaining separate connection pools per role to avoid "set/reset
-  role" performance penalty
-* Describe more relationships with Link headers
-* Depending on accept headers, render OPTIONS as [RAML](http://raml.org/) or a
-  relational diagram
-* Add two-legged auth with OAuth 1.0a(?)
-* ... the other [issues](https://github.com/begriffs/postgrest/issues)
-
-### Guides
-
-* [Routing](https://github.com/begriffs/postgrest/wiki/Routing)
-* [Versioning](https://github.com/begriffs/postgrest/wiki/API-Versioning)
-* [Performance](https://github.com/begriffs/postgrest/wiki/Performance-and-Scaling)
-* [Security](https://github.com/begriffs/postgrest/wiki/Security-and-Permissions)
-* [Tutorial](http://blog.jonharrington.org/postgrest-introduction/) (external)
+and the [API guide](http://postgrest.com/en/v0.4/api.html).

 ### Thanks

-* [Adam Baker](https://github.com/adambaker) for code
-  contributions and many fundamental design discussions
-* [Nikita Volkov](https://github.com/nikita-volkov) for writing the
-  wonderful [Hasql](https://github.com/nikita-volkov/hasql) library
-  and helping me use it
-* [Mikey Casalaina](https://github.com/casalaina) for the cool logo
-* [Jonathan Harrington](https://github.com/prio) for writing a nice tutorial
+I'm grateful to the generous project
+[contributors](https://github.com/begriffs/postgrest/graphs/contributors)
+who have improved PostgREST immensely with their code and good
+judgement.  See more details in the
+[changelog](https://github.com/begriffs/postgrest/blob/master/CHANGELOG.md).
+
+The cool logo came from [Mikey Casalaina](https://github.com/casalaina).
@@ -10,7 +10,7 @@
    },
    "POSTGREST_VER": {
      "description": "Version of PostgREST to deploy",
-      "value": "0.2.8.0"
+      "value": "0.4.0.0"
    },
    "DB_NAME": {
      "description": "Database name",
@@ -41,6 +41,16 @@
      "description": "Maximum number of connections in database pool",
      "required": false,
      "value": "10"
+    },
+    "JWT_SECRET": {
+      "description": "Secret used to encrypt JSON Web Tokens",
+      "required": false,
+      "value": "secret"
+    },
+    "SCHEMA": {
+      "description": "DB schema to be exported",
+      "required": false,
+      "value": "1"
    }
  }
 }
@@ -1,10 +1,25 @@
-machine:
+dependencies:
+  cache_directories:
+    - "~/.stack"
+    - ".stack-work"
  pre:
-    - createuser --superuser --no-password postgrest_test
-    - createdb -O postgrest_test -U ubuntu postgrest_test
-  ghc:
-    version: 7.8.3
+    - curl -L https://github.com/commercialhaskell/stack/releases/download/v1.1.2/stack-1.1.2-linux-x86_64.tar.gz | tar zx -C /tmp
+    - sudo mv /tmp/stack-1.1.2-linux-x86_64/stack /usr/bin
+    - sudo apt-get update; sudo apt-get install --only-upgrade binutils
+  override:
+    - stack setup
+    - rm -fr $(stack path --dist-dir) $(stack path --local-install-root)
+    - stack install hlint packdeps cabal-install
+    - stack build --fast
+    - stack build --fast --test --no-run-tests
+
 test:
-  post:
-    - cabal exec hlint -- -X QuasiQuotes src/*.hs test/**/*.hs
-    - cabal exec packdeps postgrest.cabal
+  override:
+    - POSTGREST_TEST_CONNECTION=$(test/create_test_db "postgres://ubuntu@localhost" postgrest_test) stack test --test-arguments "--skip \"returns a valid openapi\""
+    - git ls-files | grep '\.l\?hs$' | xargs stack exec -- hlint -X QuasiQuotes -X NoPatternSynonyms "$@"
+    - stack exec -- cabal update
+    - stack exec --no-ghc-package-path -- cabal install --only-d --dry-run
+    - stack exec -- packdeps *.cabal || true
+    - stack exec -- cabal check
+    - stack haddock --no-haddock-deps
+    - stack sdist
@@ -0,0 +1,127 @@
+{-# LANGUAGE CPP #-}
+
+module Main where
+
+import           Protolude
+import           PostgREST.App
+import           PostgREST.Config                     (AppConfig (..),
+                                                       PgVersion (..),
+                                                       minimumPgVersion,
+                                                       prettyVersion,
+                                                       readOptions)
+import           PostgREST.Error                      (prettyUsageError)
+import           PostgREST.OpenAPI                    (isMalformedProxyUri)
+import           PostgREST.DbStructure
+
+import           Control.AutoUpdate
+import           Data.ByteString.Base64               (decode)
+import           Data.String                          (IsString (..))
+import           Data.Text                            (stripPrefix, pack, replace)
+import           Data.Text.Encoding                   (encodeUtf8, decodeUtf8)
+import           Data.Text.IO                         (hPutStrLn, readFile)
+import           Data.Function                        (id)
+import           Data.Time.Clock.POSIX                (getPOSIXTime)
+import qualified Hasql.Query                          as H
+import qualified Hasql.Session                        as H
+import qualified Hasql.Decoders                       as HD
+import qualified Hasql.Encoders                       as HE
+import qualified Hasql.Pool                           as P
+import           Network.Wai.Handler.Warp
+import           System.IO                            (BufferMode (..),
+                                                       hSetBuffering)
+import           Data.IORef
+#ifndef mingw32_HOST_OS
+import           System.Posix.Signals
+#endif
+
+isServerVersionSupported :: H.Session Bool
+isServerVersionSupported = do
+  ver <- H.query () pgVersion
+  return $ ver >= pgvNum minimumPgVersion
+ where
+  pgVersion =
+    H.statement "SELECT current_setting('server_version_num')::integer"
+      HE.unit (HD.singleRow $ HD.value HD.int4) False
+
+main :: IO ()
+main = do
+  hSetBuffering stdout LineBuffering
+  hSetBuffering stdin  LineBuffering
+  hSetBuffering stderr NoBuffering
+
+  conf <- loadSecretFile =<< readOptions
+  let host = configHost conf
+      port = configPort conf
+      proxy = configProxyUri conf
+      pgSettings = toS (configDatabase conf)
+      appSettings = setHost ((fromString . toS) host)
+                  . setPort port
+                  . setServerName (toS $ "postgrest/" <> prettyVersion)
+                  $ defaultSettings
+
+  when (isMalformedProxyUri $ toS <$> proxy) $ panic
+    "Malformed proxy uri, a correct example: https://example.com:8443/basePath"
+
+  putStrLn $ ("Listening on port " :: Text) <> show (configPort conf)
+
+  pool <- P.acquire (configPool conf, 10, pgSettings)
+
+  result <- P.use pool $ do
+    supported <- isServerVersionSupported
+    unless supported $ panic (
+      "Cannot run in this PostgreSQL version, PostgREST needs at least "
+      <> pgvName minimumPgVersion)
+    getDbStructure (toS $ configSchema conf)
+
+  forM_ (lefts [result]) $ \e -> do
+    hPutStrLn stderr (prettyUsageError e)
+    exitFailure
+
+  refDbStructure <- newIORef $ either (panic . show) id result
+
+#ifndef mingw32_HOST_OS
+  tid <- myThreadId
+  forM_ [sigINT, sigTERM] $ \sig ->
+    void $ installHandler sig (Catch $ do
+        P.release pool
+        throwTo tid UserInterrupt
+      ) Nothing
+
+  void $ installHandler sigHUP (
+      Catch . void . P.use pool $ do
+        s <- getDbStructure (toS $ configSchema conf)
+        liftIO $ atomicWriteIORef refDbStructure s
+   ) Nothing
+#endif
+
+  -- ask for the OS time at most once per second
+  getTime <- mkAutoUpdate
+    defaultUpdateSettings { updateAction = getPOSIXTime }
+
+  runSettings appSettings $ postgrest conf refDbStructure pool getTime
+
+loadSecretFile :: AppConfig -> IO AppConfig
+loadSecretFile conf = extractAndTransform mSecret
+  where
+    mSecret   = decodeUtf8 <$> configJwtSecret conf
+    isB64     = configJwtSecretIsBase64 conf
+
+    extractAndTransform :: Maybe Text -> IO AppConfig
+    extractAndTransform Nothing  = return conf
+    extractAndTransform (Just s) =
+      fmap setSecret $ transformString isB64 =<<
+        case stripPrefix "@" s of
+            Nothing       -> return s
+            Just filename -> readFile (toS filename)
+
+    transformString :: Bool -> Text -> IO ByteString
+    transformString False t = return . encodeUtf8 $ t
+    transformString True  t =
+      case decode (encodeUtf8 $ replaceUrlChars t) of
+        Left errMsg -> panic $ pack errMsg
+        Right bs    -> return bs
+
+    setSecret bs = conf { configJwtSecret = Just bs }
+
+    replaceUrlChars = replace "_" "/" . replace "-" "+" . replace "." "="
+        
@@ -2,7 +2,7 @@ name:                  postgrest
 description:           Reads the schema of a PostgreSQL database and creates RESTful routes
                       for the tables and views, supporting all HTTP verbs that security
                       permits.
-version:               0.2.8.0
+version:               0.4.0.0
 synopsis:              REST API for any Postgres database
 license:               MIT
 license-file:          LICENSE
@@ -12,93 +12,148 @@ maintainer:            cred+github@begriffs.com
 category:              Web
 build-type:            Simple
 cabal-version:         >=1.10
+source-repository head
+  type: git
+  location: git://github.com/begriffs/postgrest.git
+
+Flag CI
+  Description: No warnings allowed in continuous integration
+  Manual:      True
+  Default:     False

 executable postgrest
  main-is:             Main.hs
-  ghc-options:         -Wall -W -O2
+  default-extensions:  OverloadedStrings, QuasiQuotes, NoImplicitPrelude
+  ghc-options:
+    -threaded
+    -rtsopts
+    "-with-rtsopts=-N -I2"
  default-language:    Haskell2010
-  default-extensions:  OverloadedStrings, ScopedTypeVariables, QuasiQuotes
-  build-depends:       base >=4.6 && <5
-                     , hasql == 0.7.3, hasql-backend == 0.4.1
-                     , hasql-postgres == 0.10.3
-                     , warp >= 3.0.2, wai >= 3.0.1
-                     , wai-extra, wai-cors
-                     , wai-middleware-static >= 0.6.0
-                     , HTTP, convertible, http-types
+  build-depends:       auto-update
+                     , base
+                     , hasql
+                     , hasql-pool
+                     , postgrest
+                     , protolude
+                     , text
+                     , time
+                     , warp
+                     , bytestring
+                     , base64-bytestring
+  if !os(windows)
+    build-depends:     unix
+
+  hs-source-dirs:      main
+
+library
+  default-language:    Haskell2010
+  default-extensions:  OverloadedStrings, QuasiQuotes, NoImplicitPrelude
+  build-depends:       aeson
+                     , ansi-wl-pprint
+                     , base >= 4.8 && < 6
+                     , bytestring
                     , case-insensitive
-                     , scientific, time
-                     , aeson, network >= 2.6
-                     , bytestring, text, split, string-conversions
-                     , stringsearch
-                     , containers, unordered-containers
-                     , optparse-applicative == 0.11.*
-                     , regex-base, regex-tdfa
-                     , regex-tdfa-text
-                     , Ranged-sets
-                     , transformers, MissingH
-                     , bcrypt >= 0.0.6, base64-string
-                     , network-uri >= 2.6
-                     , resource-pool
-                     , blaze-builder
-                     , vector
-                     , mtl
                     , cassava
-  Other-Modules:       App
-                     , Auth
-                     , Config
-                     , Error
-                     , Middleware
-                     , PgQuery
-                     , PgStructure
-                     , RangeQuery
-                     , Types
+                     , configurator
+                     , containers
+                     , contravariant
+                     , either
+                     , hasql
+                     , hasql-pool == 0.4.1
+                     , hasql-transaction == 0.5
+                     , heredoc
+                     , HTTP
+                     , http-types
+                     , insert-ordered-containers
+                     , interpolatedstring-perl6
+                     , jwt
+                     , lens
+                     , lens-aeson
+                     , network-uri
+                     , optparse-applicative >= 0.12.0.0 && < 0.13.0.0
+                     , parsec
+                     , protolude
+                     , Ranged-sets == 0.3.0
+                     , regex-tdfa
+                     , safe
+                     , scientific
+                     , swagger2
+                     , text
+                     , time
+                     , unordered-containers
+                     , vector
+                     , wai
+                     , wai-cors
+                     , wai-extra
+                     , wai-middleware-static
+
+  Other-Modules:       Paths_postgrest
+  Exposed-Modules:     PostgREST.ApiRequest
+                     , PostgREST.App
+                     , PostgREST.Auth
+                     , PostgREST.Config
+                     , PostgREST.DbStructure
+                     , PostgREST.DbRequestBuilder
+                     , PostgREST.Error
+                     , PostgREST.Middleware
+                     , PostgREST.OpenAPI
+                     , PostgREST.Parsers
+                     , PostgREST.QueryBuilder
+                     , PostgREST.RangeQuery
+                     , PostgREST.Types
  hs-source-dirs:      src

 Test-Suite spec
  Type:                exitcode-stdio-1.0
  Default-Language:    Haskell2010
-  default-extensions:  OverloadedStrings, ScopedTypeVariables, QuasiQuotes
-  Hs-Source-Dirs:      test, src
-  ghc-options:         -Wall -W -Werror
+  default-extensions:  OverloadedStrings, QuasiQuotes, NoImplicitPrelude
+  ghc-options:         -threaded -rtsopts -with-rtsopts=-N
+  Hs-Source-Dirs:      test
  Main-Is:             Main.hs
-  Other-Modules:       App
-                     , Auth
-                     , Config
-                     , Error
-                     , Middleware
-                     , PgQuery
-                     , PgStructure
-                     , RangeQuery
-                     , Types
-                     , Spec
+  Other-Modules:       Feature.AuthSpec
+                     , Feature.BinaryJwtSecretSpec
+                     , Feature.ConcurrentSpec
+                     , Feature.CorsSpec
+                     , Feature.DeleteSpec
+                     , Feature.InsertSpec
+                     , Feature.NoJwtSpec
+                     , Feature.ProxySpec
+                     , Feature.QueryLimitedSpec
+                     , Feature.QuerySpec
+                     , Feature.RangeSpec
+                     , Feature.SingularSpec
+                     , Feature.StructureSpec
+                     , Feature.UnicodeSpec
                     , SpecHelper
-  Build-Depends:       base, hspec >= 2.1.2, QuickCheck
-                     , hspec-wai >= 0.5.0, hspec-wai-json
-                     , hasql == 0.7.3, hasql-backend == 0.4.1
-                     , hasql-postgres == 0.10.3
-                     , warp, wai
-                     , packdeps, hlint
-                     , HTTP, convertible
+                     , TestTypes
+  Build-Depends:       aeson
+                     , aeson-qq
+                     , async
+                     , auto-update
+                     , base
+                     , bytestring
+                     , base64-bytestring
                     , 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
-                     , regex-tdfa-text
-                     , Ranged-sets
-                     , transformers, MissingH, split
-                     , bcrypt, base64-string
-                     , network-uri
-                     , resource-pool
-                     , blaze-builder
-                     , vector
-                     , mtl
                     , cassava
-                     , process
+                     , containers
+                     , contravariant
+                     , hasql
+                     , hasql-pool
                     , heredoc
+                     , hjsonpointer
+                     , hjsonschema
+                     , hspec
+                     , hspec-wai
+                     , hspec-wai-json
+                     , http-types
+                     , lens
+                     , lens-aeson
+                     , monad-control
+                     , postgrest
+                     , process
+                     , protolude
+                     , regex-tdfa
+                     , time
+                     , transformers-base
+                     , wai
+                     , wai-extra
@@ -1,6 +1,6 @@
 export POSTGREST_VER=`grep ^version /app/postgrest.cabal | sed -En 's/.*\s+([0-9\.]+)/\1/p'`

-curl -L http://softlayer-ams.dl.sourceforge.net/project/s3tools/s3cmd/1.5.0-alpha1/s3cmd-1.5.0-alpha1.tar.gz | tar zx
+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}
@@ -1,277 +0,0 @@
-{-# LANGUAGE FlexibleContexts #-}
-module App (app, sqlError, isSqlError) where
-
-import Control.Monad (join)
-import Control.Arrow ((***), second)
-import Control.Applicative
-
-import Data.Text hiding (map)
-import Data.Maybe (fromMaybe, mapMaybe)
-import Text.Regex.TDFA ((=~))
-import Data.Ord (comparing)
-import Data.Ranged.Ranges (emptyRange)
-import qualified Data.HashMap.Strict as M
-import Data.String.Conversions (cs)
-import Data.CaseInsensitive (original)
-import Data.List (sortBy)
-import Data.Functor.Identity
-import qualified Data.Set as S
-import qualified Data.ByteString.Lazy as BL
-import qualified Blaze.ByteString.Builder as BB
-import qualified Data.Csv as CSV
-
-import Network.HTTP.Types.Status
-import Network.HTTP.Types.Header
-import Network.HTTP.Types.URI (parseSimpleQuery)
-import Network.HTTP.Base (urlEncodeVars)
-import Network.Wai
-import Network.Wai.Internal (Response(..))
-
-import Data.Aeson
-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 Auth
-import PgQuery
-import RangeQuery
-import PgStructure
-
-app :: Text -> BL.ByteString -> Request -> H.Tx P.Postgres s Response
-app v1schema reqBody req =
-  case (path, verb) of
-    ([], _) -> do
-      body <- encode <$> tables (cs schema)
-      return $ responseLBS status200 [jsonH] $ cs body
-
-    ([table], "OPTIONS") -> do
-      let t = QualifiedTable schema (cs table)
-      cols <- columns t
-      pkey <- map cs <$> primaryKeyColumns t
-      return $ responseLBS status200 [jsonH, allOrigins]
-        $ encode (TableOptions cols pkey)
-
-    ([table], "GET") ->
-      if range == Just emptyRange
-      then return $ responseLBS status416 [] "HTTP Range error"
-      else do
-        let qt = QualifiedTable schema (cs table)
-        let select = B.Stmt "select " V.empty True <>
-                  parentheticT (
-                    whereT qq $ countRows qt
-                  ) <> commaq <> (
-                  asJsonWithCount
-                  . limitT range
-                  . orderT (orderParse qq)
-                  . whereT qq
-                  $ selectStar qt
-                )
-        row <- H.maybeEx select
-        let (tableTotal, queryTotal, body) =
-              fromMaybe (0, 0, Just "" :: Maybe Text) row
-            from = fromMaybe 0 $ rangeOffset <$> range
-            to = from+queryTotal-1
-            contentRange = contentRangeH from to tableTotal
-            status = rangeStatus from to tableTotal
-            canonical = urlEncodeVars
-                          . sortBy (comparing fst)
-                          . map (join (***) cs)
-                          . parseSimpleQuery
-                          $ rawQueryString req
-        return $ responseLBS status
-          [jsonH, contentRange,
-            ("Content-Location",
-             "/" <> cs table <>
-                if Prelude.null canonical then "" else "?" <> cs canonical
-            )
-          ] (cs $ fromMaybe "[]" body)
-
-    (["postgrest", "users"], "POST") -> do
-      let user = decode reqBody :: Maybe AuthUser
-
-      case user of
-        Nothing -> return $ responseLBS status400 [jsonH] $
-          encode . object $ [("message", String "Failed to parse user.")]
-        Just u -> do
-          _ <- addUser (cs $ userId u)
-            (cs $ userPass u) (cs $ userRole u)
-          return $ responseLBS status201
-            [ jsonH
-            , (hLocation, "/postgrest/users?id=eq." <> cs (userId u))
-            ] ""
-
-    ([table], "POST") -> do
-      let qt = QualifiedTable schema (cs table)
-          echoRequested = lookup "Prefer" hdrs == Just "return=representation"
-          parsed :: Either String (V.Vector Text, V.Vector (V.Vector Value))
-          parsed = if lookup "Content-Type" hdrs == Just "text/csv"
-                    then do
-                      rows <- CSV.decode CSV.NoHeader reqBody
-                      if V.null rows then Left "CSV requires header"
-                        else Right (V.head rows, (V.map $ V.map $ parseCsvCell . cs) (V.tail rows))
-                    else eitherDecode reqBody >>= \val ->
-                      case val of
-                        Object obj -> Right .  second V.singleton .  V.unzip .  V.fromList $
-                          M.toList obj
-                        _ -> Left "Expecting single JSON object or CSV rows"
-      case parsed of
-        Left err -> return $ responseLBS status400 [] $
-          encode . object $ [("message", String $ "Failed to parse JSON payload. " <> cs err)]
-        Right toBeInserted -> do
-          rows :: [Identity Text] <- H.listEx $ uncurry (insertInto qt) toBeInserted
-          let inserted :: [Object] = mapMaybe (decode . cs . runIdentity) rows
-          primaryKeys <- primaryKeyColumns qt
-          let responses = flip map inserted $ \obj -> do
-                let primaries =
-                      if Prelude.null primaryKeys
-                        then obj
-                        else M.filterWithKey (const . (`elem` primaryKeys)) obj
-                let params = urlEncodeVars
-                      $ map (\t -> (cs $ fst t, cs (paramFilter $ snd t)))
-                      $ sortBy (comparing fst) $ M.toList primaries
-                responseLBS status201
-                  [ jsonH
-                  , (hLocation, "/" <> cs table <> "?" <> cs params)
-                  ] $ if echoRequested then encode obj else ""
-          return $ multipart status201 responses
-
-    ([table], "PUT") ->
-      handleJsonObj reqBody $ \obj -> do
-        let qt = QualifiedTable schema (cs table)
-        primaryKeys <- primaryKeyColumns qt
-        let specifiedKeys = map (cs . fst) qq
-        if S.fromList primaryKeys /= S.fromList specifiedKeys
-          then return $ responseLBS status405 []
-               "You must speficy all and only primary keys as params"
-          else do
-            tableCols <- map (cs . colName) <$> columns qt
-            let cols = map cs $ M.keys obj
-            if S.fromList tableCols == S.fromList cols
-              then do
-                let vals = M.elems obj
-                H.unitEx $ iffNotT
-                        (whereT qq $ update qt cols vals)
-                        (insertSelect qt cols vals)
-                return $ responseLBS status204 [ jsonH ] ""
-
-              else return $ if Prelude.null tableCols
-                then responseLBS status404 [] ""
-                else responseLBS status400 []
-                   "You must specify all columns in PUT request"
-
-    ([table], "PATCH") ->
-      handleJsonObj reqBody $ \obj -> do
-        let qt = QualifiedTable schema (cs table)
-        H.unitEx
-          $ whereT qq
-          $ update qt (map cs $ M.keys obj) (M.elems obj)
-        return $ responseLBS status204 [ jsonH ] ""
-
-    ([table], "DELETE") -> do
-      let qt = QualifiedTable schema (cs table)
-      let del = countT
-            . returningStarT
-            . whereT qq
-            $ deleteFrom qt
-      row <- H.maybeEx del
-      let (Identity deletedCount) = fromMaybe (Identity 0 :: Identity Int) row
-      return $ if deletedCount == 0
-         then responseLBS status404 [] ""
-         else responseLBS status204 [("Content-Range", "*/"<> cs (show deletedCount))] ""
-
-    (_, _) ->
-      return $ responseLBS status404 [] ""
-
-  where
-    path   = pathInfo req
-    verb   = requestMethod req
-    qq     = queryString req
-    hdrs   = requestHeaders req
-    schema = requestedSchema v1schema hdrs
-    range  = rangeRequested hdrs
-    allOrigins = ("Access-Control-Allow-Origin", "*") :: Header
-
-sqlError :: t
-sqlError = undefined
-
-isSqlError :: t
-isSqlError = undefined
-
-rangeStatus :: Int -> Int -> Int -> Status
-rangeStatus from to total
-  | from > total            = status416
-  | (1 + to - from) < total = status206
-  | otherwise               = status200
-
-contentRangeH :: Int -> Int -> Int -> Header
-contentRangeH from to total =
-  ("Content-Range",
-    if total == 0 || from > total
-    then "*/" <> cs (show total)
-    else cs (show from)  <> "-"
-       <> cs (show to)    <> "/"
-       <> cs (show total)
-  )
-
-requestedSchema :: Text -> RequestHeaders -> Text
-requestedSchema v1schema hdrs =
-  case verStr of
-       Just [[_, ver]] -> if ver == "1" then v1schema else ver
-       _ -> v1schema
-
-  where verRegex = "version[ ]*=[ ]*([0-9]+)" :: String
-        accept = cs <$> lookup hAccept hdrs :: Maybe Text
-        verStr = (=~ verRegex) <$> accept :: Maybe [[Text]]
-
-jsonH :: Header
-jsonH = (hContentType, "application/json")
-
-handleJsonObj :: BL.ByteString -> (Object -> H.Tx P.Postgres s Response)
-              -> H.Tx P.Postgres s Response
-handleJsonObj reqBody handler = do
-  let p = eitherDecode reqBody
-  case p of
-    Left err ->
-      return $ responseLBS status400 [jsonH] jErr
-      where
-        jErr = encode . object $
-          [("message", String $ "Failed to parse JSON payload. " <> cs err)]
-    Right (Object o) -> handler o
-    Right _ ->
-      return $ responseLBS status400 [jsonH] jErr
-      where
-        jErr = encode . object $
-          [("message", String "Expecting a JSON object")]
-
-parseCsvCell :: BL.ByteString -> Value
-parseCsvCell s = if s == "NULL" then Null else String $ cs s
-
-multipart :: Status -> [Response] -> Response
-multipart _ [] = responseLBS status204 [] ""
-multipart _ [r] = r
-multipart s rs =
-  responseLBS s [(hContentType, "multipart/mixed; boundary=\"postgrest_boundary\"")] $
-    BL.intercalate "\n--postgrest_boundary\n" (map renderResponseBody rs)
-
-  where
-    renderHeader :: Header -> BL.ByteString
-    renderHeader (k, v) = cs (original k) <> ": " <> cs v
-
-    renderResponseBody :: Response -> BL.ByteString
-    renderResponseBody (ResponseBuilder _ headers b) =
-      BL.intercalate "\n" (map renderHeader headers)
-        <> "\n\n" <> BB.toLazyByteString b
-    renderResponseBody _ = error
-      "Unable to create multipart response from non-ResponseBuilder"
-
-data TableOptions = TableOptions {
-  tblOptcolumns :: [Column]
-, tblOptpkey :: [Text]
-}
-
-instance ToJSON TableOptions where
-  toJSON t = object [
-      "columns" .= tblOptcolumns t
-    , "pkey"   .= tblOptpkey t ]
@@ -1,71 +0,0 @@
-{-# LANGUAGE QuasiQuotes, ScopedTypeVariables, OverloadedStrings #-}
-module Auth where
-
-import Data.Aeson
-import Control.Monad (mzero)
-import Control.Applicative ( (<*>), (<$>) )
-import Crypto.BCrypt
-import Data.Text
-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 Data.String.Conversions (cs)
-import PgQuery (pgFmtLit)
-
-import System.IO.Unsafe
-
-data AuthUser = AuthUser {
-    userId :: String
-  , userPass :: String
-  , userRole :: String
-  } deriving (Show)
-
-instance FromJSON AuthUser where
-  parseJSON (Object v) = AuthUser <$>
-                         v .: "id" <*>
-                         v .: "pass" <*>
-                         v .: "role"
-  parseJSON _ = mzero
-
-instance ToJSON AuthUser where
-  toJSON u = object [
-      "id" .= userId u
-    , "pass" .= userPass u
-    , "role" .= userRole u ]
-
-type DbRole = Text
-
-data LoginAttempt =
-    NoCredentials
-  | MalformedAuth
-  | LoginFailed
-  | LoginSuccess DbRole
-  deriving (Eq, Show)
-
-checkPass :: Text -> Text -> Bool
-checkPass = (. cs) . validatePassword . cs
-
-setRole :: Text -> H.Tx P.Postgres s ()
-setRole role = H.unitEx $ B.Stmt ("set role " <> cs (pgFmtLit role)) V.empty True
-
-resetRole :: H.Tx P.Postgres s ()
-resetRole = H.unitEx [H.stmt|reset role|]
-
-addUser :: Text -> Text -> Text -> H.Tx P.Postgres s ()
-addUser identity pass role = do
-  let Just hashed = unsafePerformIO $ hashPasswordUsingPolicy fastBcryptHashingPolicy (cs pass)
-  H.unitEx $
-    [H.stmt|insert into postgrest.auth (id, pass, rolname) values (?, ?, ?)|]
-      identity (cs hashed :: Text) role
-
-signInRole :: Text -> Text -> H.Tx P.Postgres s LoginAttempt
-signInRole user pass = do
-  u <- H.maybeEx $ [H.stmt|select pass, rolname from postgrest.auth where id = ?|] user
-  return $ maybe LoginFailed (\r ->
-      let (hashed, role) = r in
-      if checkPass hashed pass
-         then LoginSuccess role
-         else LoginFailed
-    ) u
@@ -1,60 +0,0 @@
-module Config where
-
-import Network.Wai
-import Control.Applicative
-import Data.Text (strip)
-import qualified Data.CaseInsensitive as CI
-import qualified Data.ByteString.Char8 as BS
-import Data.String.Conversions (cs)
-import Options.Applicative hiding (columns)
-import Network.Wai.Middleware.Cors (CorsResourcePolicy(..))
-
-data AppConfig = AppConfig {
-    configDbName :: String
-  , configDbPort :: Int
-  , configDbUser :: String
-  , configDbPass :: String
-  , configDbHost :: String
-
-  , configPort  :: Int
-  , configAnonRole :: String
-  , configSecure :: Bool
-  , configPool :: Int
-  , configV1Schema :: String
-  }
-
-argParser :: Parser AppConfig
-argParser = AppConfig
-  <$> strOption (long "db-name" <> short 'd' <> metavar "NAME" <> help "name of database")
-  <*> option auto (long "db-port" <> short 'P' <> metavar "PORT" <> value 5432 <> help "postgres server port" <> showDefault)
-  <*> strOption (long "db-user" <> short 'U' <> metavar "ROLE" <> help "postgres authenticator role")
-  <*> strOption (long "db-pass" <> metavar "PASS" <> value "" <> help "password for authenticator role")
-  <*> strOption (long "db-host" <> metavar "HOST" <> value "localhost" <> help "postgres server hostname" <> showDefault)
-
-  <*> option auto (long "port" <> short 'p' <> metavar "PORT" <> value 3000 <> help "port number on which to run HTTP server" <> showDefault)
-  <*> strOption (long "anonymous" <> short 'a' <> metavar "ROLE" <> help "postgres role to use for non-authenticated requests")
-  <*> switch (long "secure" <> short 's' <> help "Redirect all requests to HTTPS")
-  <*> option auto (long "db-pool" <> metavar "COUNT" <> value 10 <> help "Max connections in database pool" <> showDefault)
-  <*> strOption (long "v1schema" <> metavar "NAME" <> value "1" <> help "Schema to use for nonspecified version (or explicit v1)" <> showDefault)
-
-defaultCorsPolicy :: CorsResourcePolicy
-defaultCorsPolicy =  CorsResourcePolicy Nothing
-  ["GET", "POST", "PUT", "PATCH", "DELETE", "OPTIONS"] ["Authorization"] Nothing
-  (Just $ 60*60*24) False False True
-
-corsPolicy :: Request -> Maybe CorsResourcePolicy
-corsPolicy req = case lookup "origin" headers of
-  Just origin -> Just defaultCorsPolicy {
-      corsOrigins = Just ([origin], True)
-    , corsRequestHeaders = "Authentication":accHeaders
-    , corsExposedHeaders = Just [
-          "Content-Encoding", "Content-Location", "Content-Range", "Content-Type"
-        , "Date", "Location", "Server", "Transfer-Encoding", "Range-Unit"
-        ]
-    }
-  Nothing -> Nothing
-  where
-    headers = requestHeaders req
-    accHeaders = case lookup "access-control-request-headers" headers of
-      Just hdrs -> map (CI.mk . cs . strip . cs) $ BS.split ',' hdrs
-      Nothing -> []
@@ -1,71 +0,0 @@
-{-# OPTIONS_GHC -fno-warn-orphans #-}
-{-# LANGUAGE FlexibleInstances, TypeSynonymInstances #-}
-
-module Error (PgError, errResponse) where
-
-import qualified Hasql as H
-import qualified Hasql.Postgres as P
-import qualified Network.HTTP.Types.Status as HT
-import qualified Data.Aeson as JSON
-import qualified Data.Text as T
-import Data.Aeson ((.=))
-import Data.String.Conversions (cs)
-import Data.String.Utils(replace)
-import Network.Wai(Response, responseLBS)
-import Network.HTTP.Types.Header
-
-type PgError = H.SessionError P.Postgres
-
-errResponse :: PgError -> Response
-errResponse e = responseLBS (httpStatus e)
-  [(hContentType, "application/json")] (JSON.encode e)
-
-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]
-
-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
@@ -1,71 +0,0 @@
-module Main where
-
-import Paths_postgrest (version)
-
-import App
-import Middleware
-import Error(errResponse)
-
-import Control.Monad (unless)
-import Control.Monad.IO.Class (liftIO)
-import Data.String.Conversions (cs)
-import Network.Wai (strictRequestBody)
-import Network.Wai.Middleware.Cors (cors)
-import Network.Wai.Handler.Warp hiding (Connection)
-import Network.Wai.Middleware.Gzip (gzip, def)
-import Network.Wai.Middleware.Static (staticPolicy, only)
-import Network.Wai.Middleware.RequestLogger (logStdout)
-import Data.List (intercalate)
-import Data.Version (versionBranch)
-import qualified Hasql as H
-import qualified Hasql.Postgres as P
-import Options.Applicative hiding (columns)
-
-import Config (AppConfig(..), argParser, corsPolicy)
-
-main :: IO ()
-main = do
-  let opts = info (helper <*> argParser) $
-                fullDesc
-                <> progDesc (
-                    "PostgREST "
-                    <> prettyVersion
-                    <> " / create a REST API to an existing Postgres database"
-                )
-      parserPrefs = prefs showHelpOnError
-  conf <- customExecParser parserPrefs opts
-  let port = configPort conf
-
-  unless (configSecure conf) $
-    putStrLn "WARNING, running in insecure mode, auth will be in plaintext"
-  Prelude.putStrLn $ "Listening on port " ++
-    (show $ configPort conf :: String)
-
-  let pgSettings = P.ParamSettings (cs $ configDbHost conf)
-                     (fromIntegral $ configDbPort conf)
-                     (cs $ configDbUser conf)
-                     (cs $ configDbPass conf)
-                     (cs $ configDbName conf)
-      appSettings = setPort port
-                  . setServerName (cs $ "postgrest/" <> prettyVersion)
-                  $ defaultSettings
-      middle = logStdout
-        . (if configSecure conf then redirectInsecure else id)
-        . gzip def . cors corsPolicy
-        . staticPolicy (only [("favicon.ico", "static/favicon.ico")])
-      anonRole = cs $ configAnonRole conf
-      currRole = cs $ configDbUser conf
-
-  poolSettings <- maybe (fail "Improper session settings") return $
-                H.poolSettings (fromIntegral $ configPool conf) 30
-  pool :: H.Pool P.Postgres
-          <- H.acquirePool pgSettings poolSettings
-
-  runSettings appSettings $ middle $ \req respond -> do
-    body <- strictRequestBody req
-    resOrError <- liftIO $ H.session pool $ H.tx Nothing $
-      authenticated currRole anonRole (app (cs $ configV1Schema conf) body) req
-    either (respond . errResponse) respond resOrError
-
-  where
-    prettyVersion = intercalate "." $ map show $ versionBranch version
@@ -1,76 +0,0 @@
-{-# OPTIONS_GHC -fno-warn-orphans #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-
-module Middleware where
-
-import Data.Maybe (fromMaybe)
-import Data.Monoid (mconcat)
-import Data.Text
-- import Data.Pool(withResource, Pool)
-
-import qualified Hasql as H
-import qualified Hasql.Postgres as P
-import Data.String.Conversions(cs)
-
-import Network.HTTP.Types.Header (hLocation, hAuthorization)
-import Network.HTTP.Types (RequestHeaders)
-import Network.HTTP.Types.Status (status400, status401, status301)
-import Network.Wai (Application, requestHeaders, responseLBS, rawPathInfo,
-                   rawQueryString, isSecure, Request(..), Response)
-import Network.URI (URI(..), parseURI)
-
-import Auth (LoginAttempt(..), signInRole, setRole, resetRole)
-import Codec.Binary.Base64.String (decode)
-
-authenticated :: forall s. Text -> Text ->
-                 (Request -> H.Tx P.Postgres s Response) ->
-                 Request -> H.Tx P.Postgres s Response
-authenticated currentRole anon app req = do
-  attempt <- httpRequesterRole (requestHeaders req)
-  case attempt of
-    MalformedAuth ->
-      return $ responseLBS status400 [] "Malformed basic auth header"
-    LoginFailed ->
-      return $ responseLBS status401 [] "Invalid username or password"
-    LoginSuccess role -> if role /= currentRole then runInRole role else app req
-    NoCredentials ->     if anon /= currentRole then runInRole anon else app req
-
- where
-   httpRequesterRole :: RequestHeaders -> H.Tx P.Postgres s LoginAttempt
-   httpRequesterRole hdrs = do
-    let auth = fromMaybe "" $ lookup hAuthorization hdrs
-    case split (==' ') (cs auth) of
-      ("Basic" : b64 : _) ->
-        case split (==':') (cs . decode . cs $ b64) of
-          (u:p:_) -> signInRole u p
-          _ -> return MalformedAuth
-      _ -> return NoCredentials
-
-   runInRole :: Text -> H.Tx P.Postgres s Response
-   runInRole r = do
-     setRole r
-     res <- app req
-     resetRole
-     return res
-
-
-redirectInsecure :: Application -> Application
-redirectInsecure app req respond = do
-  let hdrs = requestHeaders req
-      host = lookup "host" hdrs
-      uriM = parseURI . cs =<< mconcat [
-        Just "https://",
-        host,
-        Just $ rawPathInfo req,
-        Just $ rawQueryString req]
-      isHerokuSecure = lookup "x-forwarded-proto" hdrs == Just "https"
-
-  if not (isSecure req || isHerokuSecure)
-    then case uriM of
-              Just uri ->
-                respond $ responseLBS status301 [
-                    (hLocation, cs . show $ uri { uriScheme = "https:" })
-                  ] ""
-              Nothing ->
-                respond $ responseLBS status400 [] "SSL is required"
-    else app req respond
@@ -1,282 +0,0 @@
-{-# LANGUAGE TypeSynonymInstances, FlexibleInstances, MultiWayIf #-}
-{-# OPTIONS_GHC -fno-warn-orphans #-}
-
-module PgQuery where
-
-import RangeQuery
-
-import qualified Hasql as H
-import qualified Hasql.Postgres as P
-import qualified Hasql.Backend as B
-
-import qualified Data.Text as T
-import Text.Regex.TDFA ( (=~) )
-import Text.Regex.TDFA.Text ()
-import qualified Network.HTTP.Types.URI as Net
-import qualified Data.ByteString.Char8 as BS
-import Data.Monoid
-import Data.Vector (empty)
-import Data.Maybe (fromMaybe, mapMaybe)
-import Data.Functor ( (<$>) )
-import Control.Monad (join)
-import Data.String.Conversions (cs)
-import qualified Data.Aeson as JSON
-import qualified Data.List as L
-import qualified Data.Vector as V
-import Data.Scientific (isInteger, formatScientific, FPFormat(..))
-
-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
-
-data QualifiedTable = QualifiedTable {
-  qtSchema :: T.Text
-, qtName   :: T.Text
-} deriving (Show)
-
-data OrderTerm = OrderTerm {
-  otTerm :: T.Text
-, otDirection :: BS.ByteString
-, otNullOrder :: Maybe BS.ByteString
-}
-
-limitT :: Maybe NonnegRange -> StatementT
-limitT r q =
-  q <> B.Stmt (" LIMIT " <> limit <> " OFFSET " <> offset <> " ") empty True
-  where
-    limit  = maybe "ALL" (cs . show) $ join $ rangeLimit <$> r
-    offset = cs . show $ fromMaybe 0 $ rangeOffset <$> r
-
-whereT :: Net.Query -> StatementT
-whereT params q =
- if L.null cols
-   then q
-   else q <> B.Stmt " where " empty True <> conjunction
- where
-   cols = [ col | col <- params, fst col `notElem` ["order"] ]
-   conjunction = mconcat $ L.intersperse andq (map wherePred cols)
-
-orderT :: [OrderTerm] -> StatementT
-orderT ts q =
-  if L.null ts
-    then q
-    else q <> B.Stmt " order by " empty True <> clause
-  where
-   clause = mconcat $ L.intersperse commaq (map queryTerm ts)
-   queryTerm :: OrderTerm -> PStmt
-   queryTerm t = B.Stmt
-                   (" " <> cs (pgFmtIdent $ otTerm t) <> " "
-                        <> cs (otDirection t)         <> " "
-                        <> maybe "" cs (otNullOrder t) <> " ")
-                   empty True
-
-parentheticT :: StatementT
-parentheticT s =
-  s { B.stmtTemplate = " (" <> B.stmtTemplate s <> ") " }
-
-iffNotT :: PStmt -> StatementT
-iffNotT (B.Stmt aq ap apre) (B.Stmt bq bp bpre) =
-  B.Stmt
-    ("WITH aaa AS (" <> aq <> " returning *) " <>
-      bq <> " WHERE NOT EXISTS (SELECT * FROM aaa)")
-    (ap <> bp)
-    (apre && bpre)
-
-countT :: StatementT
-countT s =
-  s { B.stmtTemplate = "WITH qqq AS (" <> B.stmtTemplate s <> ") SELECT count(1) FROM qqq" }
-
-countRows :: QualifiedTable -> PStmt
-countRows t = B.Stmt ("select count(1) from " <> fromQt t) empty True
-
-asJsonWithCount :: StatementT
-asJsonWithCount s = s { B.stmtTemplate =
-     "count(t), array_to_json(array_agg(row_to_json(t)))::character varying from ("
-  <> B.stmtTemplate s <> ") t" }
-
-asJsonRow :: StatementT
-asJsonRow s = s { B.stmtTemplate = "row_to_json(t) from (" <> B.stmtTemplate s <> ") t" }
-
-selectStar :: QualifiedTable -> PStmt
-selectStar t = B.Stmt ("select * from " <> fromQt t) empty True
-
-returningStarT :: StatementT
-returningStarT s = s { B.stmtTemplate = B.stmtTemplate s <> " RETURNING *" }
-
-deleteFrom :: QualifiedTable -> PStmt
-deleteFrom t = B.Stmt ("delete from " <> fromQt t) empty True
-
-insertInto :: QualifiedTable
-              -> V.Vector T.Text
-              -> V.Vector (V.Vector JSON.Value)
-              -> PStmt
-insertInto t cols vals
-  | V.null cols = B.Stmt ("insert into " <> fromQt t <> " default values returning *") empty True
-  | otherwise   = B.Stmt
-    ("insert into " <> fromQt t <> " (" <>
-      T.intercalate ", " (V.toList $ V.map pgFmtIdent cols) <>
-      ") values "
-      <> T.intercalate ", "
-        (V.toList $ V.map (\v -> "("
-            <> T.intercalate ", " (V.toList $ V.map insertableValue v)
-            <> ")"
-          ) vals
-        )
-      <> " returning row_to_json(" <> fromQt t <> ".*)")
-    empty True
-
-insertSelect :: QualifiedTable -> [T.Text] -> [JSON.Value] -> PStmt
-insertSelect t [] _ = B.Stmt
-  ("insert into " <> fromQt t <> " default values returning *") empty True
-insertSelect t cols vals = B.Stmt
-  ("insert into " <> fromQt t <> " ("
-    <> T.intercalate ", " (map pgFmtIdent cols)
-    <> ") select "
-    <> T.intercalate ", " (map insertableValue vals))
-  empty True
-
-update :: QualifiedTable -> [T.Text] -> [JSON.Value] -> PStmt
-update t cols vals = B.Stmt
-  ("update " <> fromQt t <> " set ("
-    <> T.intercalate ", " (map pgFmtIdent cols)
-    <> ") = ("
-    <> T.intercalate ", " (map insertableValue vals)
-    <> ")")
-  empty True
-
-wherePred :: Net.QueryItem -> PStmt
-wherePred (col, predicate) =
-  B.Stmt (" " <> pgFmtJsonbPath (cs col) <> " " <> op <> " " <>
-      if opCode `elem` ["is","isnot"] then whiteList value
-                                 else cs sqlValue)
-      empty True
-
-  where
-    opCode:rest = T.split (=='.') $ cs $ fromMaybe "." predicate
-    value = T.intercalate "." rest
-    whiteList val = fromMaybe (cs (pgFmtLit val) <> "::unknown ")
-                              (L.find ((==) . T.toLower $ val)
-                                      ["null","true","false"])
-    star c = if c == '*' then '%' else c
-    unknownLiteral = (<> "::unknown ") . pgFmtLit
-
-    sqlValue = case opCode of
-            "like" -> unknownLiteral $ T.map star value
-            "ilike" -> unknownLiteral $ T.map star value
-            "in" -> "(" <> T.intercalate ", " (map unknownLiteral $ T.split (==',') value) <> ") "
-            _    -> unknownLiteral value
-
-    op = case opCode of
-         "eq"  -> "="
-         "gt"  -> ">"
-         "lt"  -> "<"
-         "gte" -> ">="
-         "lte" -> "<="
-         "neq" -> "<>"
-         "like"-> "like"
-         "ilike"-> "ilike"
-         "in"  -> "in"
-         "is"    -> "is"
-         "isnot" -> "is not"
-         _     -> "="
-
-orderParse :: Net.Query -> [OrderTerm]
-orderParse q =
-  mapMaybe orderParseTerm . T.split (==',') $ cs order
-  where
-    order = fromMaybe "" $ join (lookup "order" q)
-
-orderParseTerm :: T.Text -> Maybe OrderTerm
-orderParseTerm s =
-  case T.split (=='.') s of
-       (c:d:nls) ->
-         if d `elem` ["asc", "desc"]
-            then Just $ OrderTerm c
-              ( if d == "asc" then "asc" else "desc" )
-              ( case nls of
-                  [n] -> if | n == "nullsfirst" -> Just "nulls first"
-                            | n == "nullslast"  -> Just "nulls last"
-                            | otherwise -> Nothing
-                  _   -> Nothing
-              )
-            else Nothing
-       _ -> Nothing
-
-commaq :: PStmt
-commaq  = B.Stmt ", " empty True
-
-andq :: PStmt
-andq = B.Stmt " and " empty True
-
-data JsonbPath =
-    ColIdentifier T.Text
-  | KeyIdentifier T.Text
-  | SingleArrow JsonbPath JsonbPath
-  | DoubleArrow JsonbPath JsonbPath
-  deriving (Show)
-
-parseJsonbPath :: T.Text -> Maybe JsonbPath
-parseJsonbPath p =
-  case T.splitOn "->>" p of
-    [a,b] ->
-      let i:is = T.splitOn "->" a in
-      Just $ DoubleArrow
-        (foldl SingleArrow (ColIdentifier i) (map KeyIdentifier is))
-        (KeyIdentifier b)
-    _ -> Nothing
-
-pgFmtJsonbPath :: T.Text -> T.Text
-pgFmtJsonbPath p =
-  pgFmtJsonbPath' $ fromMaybe (ColIdentifier p) (parseJsonbPath p)
-  where
-    pgFmtJsonbPath' (ColIdentifier i) = pgFmtIdent i
-    pgFmtJsonbPath' (KeyIdentifier i) = pgFmtLit i
-    pgFmtJsonbPath' (SingleArrow a b) =
-      pgFmtJsonbPath' a <> "->" <> pgFmtJsonbPath' b
-    pgFmtJsonbPath' (DoubleArrow a b) =
-      pgFmtJsonbPath' a <> "->>" <> pgFmtJsonbPath' b
-
-pgFmtIdent :: T.Text -> T.Text
-pgFmtIdent x =
-  let escaped = T.replace "\"" "\"\"" (trimNullChars $ cs x) in
-  if escaped =~ danger
-    then "\"" <> escaped <> "\""
-    else escaped
-
-  where danger = "^$|^[^a-z_]|[^a-z_0-9]" :: T.Text
-
-pgFmtLit :: T.Text -> T.Text
-pgFmtLit x =
-  let trimmed = trimNullChars x
-      escaped = "'" <> T.replace "'" "''" trimmed <> "'"
-      slashed = T.replace "\\" "\\\\" escaped in
-  cs $ if escaped =~ ("\\\\" :: T.Text)
-    then "E" <> slashed
-    else slashed
-
-trimNullChars :: T.Text -> T.Text
-trimNullChars = T.takeWhile (/= '\x0')
-
-fromQt :: QualifiedTable -> T.Text
-fromQt t = pgFmtIdent (qtSchema t) <> "." <> pgFmtIdent (qtName t)
-
-unquoted :: JSON.Value -> T.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 _ = ""
-
-insertableText :: T.Text -> T.Text
-insertableText = (<> "::unknown") . pgFmtLit
-
-insertableValue :: JSON.Value -> T.Text
-insertableValue JSON.Null = "null"
-insertableValue v = insertableText $ unquoted v
-
-paramFilter :: JSON.Value -> T.Text
-paramFilter JSON.Null = "is.null"
-paramFilter v = "eq." <> unquoted v
@@ -1,172 +0,0 @@
-{-# LANGUAGE QuasiQuotes, OverloadedStrings, TypeSynonymInstances,
-             MultiParamTypeClasses, ScopedTypeVariables #-}
-module PgStructure where
-
-import PgQuery (QualifiedTable(..))
-import Data.Text hiding (foldl, map, zipWith, concat)
-import Data.Aeson
-import Data.Functor.Identity
-import Data.String.Conversions (cs)
-import Data.Maybe (fromMaybe)
-import Control.Applicative ( (<$>) )
-
-import qualified Data.Map as Map
-
-import qualified Hasql as H
-import qualified Hasql.Postgres as P
-
-foreignKeys :: QualifiedTable -> H.Tx P.Postgres s (Map.Map Text ForeignKey)
-foreignKeys table = do
-  r <- H.listEx $ [H.stmt|
-      select kcu.column_name, ccu.table_name AS foreign_table_name,
-        ccu.column_name AS foreign_column_name
-      from information_schema.table_constraints AS tc
-        join information_schema.key_column_usage AS kcu
-          on tc.constraint_name = kcu.constraint_name
-        join information_schema.constraint_column_usage AS ccu
-          on ccu.constraint_name = tc.constraint_name
-      where constraint_type = 'FOREIGN KEY'
-        and tc.table_name=? and tc.table_schema = ?
-        order by kcu.column_name
-    |] (qtName table) (qtSchema table)
-
-  return $ foldl addKey Map.empty r
-  where
-    addKey :: Map.Map Text ForeignKey -> (Text, Text, Text) -> Map.Map Text ForeignKey
-    addKey m (col, ftab, fcol) = Map.insert col (ForeignKey ftab fcol) m
-
-
-tables :: Text -> H.Tx P.Postgres s [Table]
-tables schema = do
-  rows <- H.listEx $
-    [H.stmt|
-      select table_schema, table_name,
-             is_insertable_into
-        from information_schema.tables
-       where table_schema = ?
-       order by table_name
-    |] schema
-  return $ map tableFromRow rows
-
-
-columns :: QualifiedTable -> H.Tx P.Postgres s [Column]
-columns table = do
-  cols <- H.listEx $ [H.stmt|
-      select info.table_schema as schema, info.table_name as table_name,
-             info.column_name as name, info.ordinal_position as position,
-             info.is_nullable as nullable, info.data_type as col_type,
-             info.is_updatable as updatable,
-             info.character_maximum_length as max_len,
-             info.numeric_precision as precision,
-             info.column_default as default_value,
-             array_to_string(enum_info.vals, ',') as enum
-         from (
-           select table_schema, table_name, column_name, ordinal_position,
-                  is_nullable, data_type, is_updatable,
-                  character_maximum_length, numeric_precision,
-                  column_default, udt_name
-             from information_schema.columns
-            where table_schema = ? and table_name = ?
-         ) as info
-         left outer join (
-           select n.nspname as s,
-                  t.typname as n,
-                  array_agg(e.enumlabel ORDER BY e.enumsortorder) as vals
-           from pg_type t
-              join pg_enum e on t.oid = e.enumtypid
-              join pg_catalog.pg_namespace n ON n.oid = t.typnamespace
-           group by s, n
-         ) as enum_info
-         on (info.udt_name = enum_info.n)
-      order by position |]
-    (qtSchema table) (qtName table)
-
-  fks <- foreignKeys table
-  return $ map (addFK fks . columnFromRow) cols
-
-  where
-    addFK fks col = col { colFK = Map.lookup (cs . colName $ col) fks }
-
-
-primaryKeyColumns :: QualifiedTable -> H.Tx P.Postgres s [Text]
-primaryKeyColumns table = do
-  r <- H.listEx $ [H.stmt|
-    select kc.column_name
-      from
-        information_schema.table_constraints tc,
-        information_schema.key_column_usage kc
-    where
-      tc.constraint_type = 'PRIMARY KEY'
-      and kc.table_name = tc.table_name and kc.table_schema = tc.table_schema
-      and kc.constraint_name = tc.constraint_name
-      and kc.table_schema = ?
-      and kc.table_name  = ? |] (qtSchema table) (qtName table)
-  return $ map runIdentity r
-
-
-toBool :: Text -> Bool
-toBool = (== "YES")
-
-data Table = Table {
-  tableSchema :: Text
-, tableName :: Text
-, tableInsertable :: Bool
-} deriving (Show)
-
-data ForeignKey = ForeignKey {
-  fkTable::Text, fkCol::Text
-} deriving (Eq, Show)
-
-data Column = Column {
-  colSchema :: Text
-, colTable :: Text
-, colName :: Text
-, colPosition :: Int
-, colNullable :: Bool
-, colType :: Text
-, colUpdatable :: Bool
-, colMaxLen :: Maybe Int
-, colPrecision :: Maybe Int
-, colDefault :: Maybe Text
-, colEnum :: [Text]
-, colFK :: Maybe ForeignKey
-} deriving (Show)
-
-tableFromRow :: (Text, Text, Text) -> Table
-tableFromRow (s, n, i) = Table s n (toBool i)
-
-columnFromRow :: (Text,       Text,      Text,
-                  Int,        Text,      Text,
-                  Text,       Maybe Int, Maybe Int,
-                  Maybe Text, Maybe Text)
-              -> Column
-columnFromRow (s, t, n, pos, nul, typ, u, l, p, d, e) =
-  Column s t n pos (toBool nul) typ (toBool u) l p d (parseEnum e) Nothing
-
-  where
-    parseEnum :: Maybe Text -> [Text]
-    parseEnum str = fromMaybe [] $ split (==',') <$> str
-
-
-instance ToJSON Column where
-  toJSON c = object [
-      "schema"    .= colSchema c
-    , "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 ]
-
-instance ToJSON ForeignKey where
-  toJSON fk = object ["table".=fkTable fk, "column".=fkCol fk]
-
-instance ToJSON Table where
-  toJSON v = object [
-      "schema"     .= tableSchema v
-    , "name"       .= tableName v
-    , "insertable" .= tableInsertable v ]
@@ -0,0 +1,301 @@
+{-|
+Module      : PostgREST.ApiRequest
+Description : PostgREST functions to translate HTTP request to a domain type called ApiRequest.
+-}
+module PostgREST.ApiRequest ( ApiRequest(..)
+                            , ApiRequestError(..)
+                            , ContentType(..)
+                            , Action(..)
+                            , Target(..)
+                            , PreferRepresentation (..)
+                            , mutuallyAgreeable
+                            , toHeader
+                            , userApiRequest
+                            , toMime
+                            ) where
+
+import           Protolude
+import qualified Data.Aeson                as JSON
+import qualified Data.ByteString           as BS
+import qualified Data.ByteString.Internal  as BS (c2w)
+import qualified Data.ByteString.Lazy      as BL
+import qualified Data.Csv                  as CSV
+import qualified Data.List                 as L
+import           Data.List                 (lookup, last)
+import qualified Data.HashMap.Strict       as M
+import qualified Data.Set                  as S
+import           Data.Maybe                (fromJust)
+import           Control.Arrow             ((***))
+import qualified Data.Text                 as T
+import qualified Data.Vector               as V
+import           Network.HTTP.Base         (urlEncodeVars)
+import           Network.HTTP.Types.Header (hAuthorization, hContentType, Header)
+import           Network.HTTP.Types.URI    (parseSimpleQuery)
+import           Network.Wai               (Request (..))
+import           Network.Wai.Parse         (parseHttpAccept)
+import           PostgREST.RangeQuery      (NonnegRange, rangeRequested, restrictRange, rangeGeq, allRange, rangeLimit, rangeOffset)
+import           Data.Ranged.Boundaries
+import           PostgREST.Types           (QualifiedIdentifier (..),
+                                            Schema,
+                                            PayloadJSON(..))
+import           Data.Ranged.Ranges        (Range(..), rangeIntersection, emptyRange)
+
+type RequestBody = BL.ByteString
+
+-- | Types of things a user wants to do to tables/views/procs
+data Action = ActionCreate | ActionRead
+            | ActionUpdate | ActionDelete
+            | ActionInfo   | ActionInvoke
+            | ActionInspect
+            deriving Eq
+-- | The target db object of a user action
+data Target = TargetIdent QualifiedIdentifier
+            | TargetProc  QualifiedIdentifier
+            | TargetRoot
+            | TargetUnknown [Text]
+            deriving Eq
+-- | How to return the inserted data
+data PreferRepresentation = Full | HeadersOnly | None deriving Eq
+                          --
+-- | Enumeration of currently supported response content types
+data ContentType = CTApplicationJSON | CTTextCSV | CTOpenAPI
+                 | CTSingularJSON
+                 | CTAny | CTOther BS.ByteString deriving Eq
+
+data ApiRequestError = ErrorActionInappropriate
+                     | ErrorInvalidBody ByteString
+                     | ErrorInvalidRange
+                     deriving (Show, Eq)
+
+-- | Convert from ContentType to a full HTTP Header
+toHeader :: ContentType -> Header
+toHeader ct = (hContentType, toMime ct <> "; charset=utf-8")
+
+-- | Convert from ContentType to a ByteString representing the mime type
+toMime :: ContentType -> ByteString
+toMime CTApplicationJSON = "application/json"
+toMime CTTextCSV         = "text/csv"
+toMime CTOpenAPI         = "application/openapi+json"
+toMime CTSingularJSON    = "application/vnd.pgrst.object+json"
+toMime CTAny             = "*/*"
+toMime (CTOther ct)      = ct
+
+{-|
+  Describes what the user wants to do. This data type is a
+  translation of the raw elements of an HTTP request into domain
+  specific language.  There is no guarantee that the intent is
+  sensible, it is up to a later stage of processing to determine
+  if it is an action we are able to perform.
+-}
+data ApiRequest = ApiRequest {
+  -- | Similar but not identical to HTTP verb, e.g. Create/Invoke both POST
+    iAction :: Action
+  -- | Requested range of rows within response
+  , iRange  :: M.HashMap ByteString NonnegRange
+  -- | The target, be it calling a proc or accessing a table
+  , iTarget :: Target
+  -- | Content types the client will accept, [CTAny] if no Accept header
+  , iAccepts :: [ContentType]
+  -- | Data sent by client and used for mutation actions
+  , iPayload :: Maybe PayloadJSON
+  -- | If client wants created items echoed back
+  , iPreferRepresentation :: PreferRepresentation
+  -- | Pass all parameters as a single json object to a stored procedure
+  , iPreferSingleObjectParameter :: Bool
+  -- | Whether the client wants a result count (slower)
+  , iPreferCount :: Bool
+  -- | Filters on the result ("id", "eq.10")
+  , iFilters :: [(Text, Text)]
+  -- | &select parameter used to shape the response
+  , iSelect :: Text
+  -- | &order parameters for each level
+  , iOrder :: [(Text, Text)]
+  -- | Alphabetized (canonical) request query string for response URLs
+  , iCanonicalQS :: ByteString
+  -- | JSON Web Token
+  , iJWT :: Text
+  }
+
+-- | Examines HTTP request and translates it into user intent.
+userApiRequest :: Schema -> Request -> RequestBody -> Either ApiRequestError ApiRequest
+userApiRequest schema req reqBody
+  | isTargetingProc && method /= "POST" = Left ErrorActionInappropriate
+  | topLevelRange == emptyRange = Left ErrorInvalidRange
+  | shouldParsePayload && isLeft payload = either (Left . ErrorInvalidBody . toS) undefined payload
+  | otherwise = Right ApiRequest {
+      iAction = action
+      , iTarget = target
+      , iRange = ranges
+      , iAccepts = fromMaybe [CTAny] $
+        map decodeContentType . parseHttpAccept <$> lookupHeader "accept"
+      , iPayload = relevantPayload
+      , iPreferRepresentation = representation
+      , iPreferSingleObjectParameter = singleObject
+      , iPreferCount = hasPrefer "count=exact"
+      , iFilters = [ (toS k, toS $ fromJust v) | (k,v) <- qParams, isJust v, k /= "select", not (endingIn ["order", "limit", "offset"] k) ]
+      , iSelect = toS $ fromMaybe "*" $ fromMaybe (Just "*") $ lookup "select" qParams
+      , iOrder = [(toS k, toS $ fromJust v) | (k,v) <- qParams, isJust v, endingIn ["order"] k ]
+      , iCanonicalQS = toS $ urlEncodeVars
+        . L.sortBy (comparing fst)
+        . map (join (***) toS)
+        . parseSimpleQuery
+        $ rawQueryString req
+      , iJWT = tokenStr
+      }
+ where
+  isTargetingProc = fromMaybe False $ (== "rpc") <$> listToMaybe path
+  payload =
+    case decodeContentType . fromMaybe "application/json" $ lookupHeader "content-type" of
+      CTApplicationJSON ->
+          either Left (\val -> case ensureUniform (pluralize val) of
+            Nothing -> Left "All object keys must match"
+            Just json -> Right json) (JSON.eitherDecode reqBody)
+      CTTextCSV ->
+          either Left (\val -> case ensureUniform (csvToJson val) of
+            Nothing -> Left "All lines must have same number of fields"
+            Just json -> Right json) (CSV.decodeByName reqBody)
+      CTOther "application/x-www-form-urlencoded" ->
+        Right . PayloadJSON . V.singleton . M.fromList
+                    . map (toS *** JSON.String . toS) . parseSimpleQuery
+                    $ toS reqBody
+      ct ->
+        Left $ toS $ "Content-Type not acceptable: " <> toMime ct
+  topLevelRange = fromMaybe allRange $ M.lookup "limit" ranges
+  action = case method of
+            "GET"     -> if target == TargetRoot
+                          then ActionInspect
+                          else ActionRead
+            "POST"    -> if isTargetingProc
+                          then ActionInvoke
+                          else ActionCreate
+            "PATCH"   -> ActionUpdate
+            "DELETE"  -> ActionDelete
+            "OPTIONS" -> ActionInfo
+            _         -> ActionInspect
+  target = case path of
+              []            -> TargetRoot
+              [table]       -> TargetIdent
+                              $ QualifiedIdentifier schema table
+              ["rpc", proc] -> TargetProc
+                              $ QualifiedIdentifier schema proc
+              other         -> TargetUnknown other
+  shouldParsePayload = action `elem` [ActionCreate, ActionUpdate, ActionInvoke]
+  relevantPayload = if shouldParsePayload
+                      then rightToMaybe payload
+                      else Nothing
+  path            = pathInfo req
+  method          = requestMethod req
+  hdrs            = requestHeaders req
+  qParams         = [(toS k, v)|(k,v) <- queryString req]
+  lookupHeader    = flip lookup hdrs
+  hasPrefer :: Text -> Bool
+  hasPrefer val   = any (\(h,v) -> h == "Prefer" && val `elem` split v) hdrs
+    where
+        split :: BS.ByteString -> [Text]
+        split = map T.strip . T.split (==',') . toS
+  singleObject    = hasPrefer "params=single-object"
+  representation
+    | hasPrefer "return=representation" = Full
+    | hasPrefer "return=minimal" = None
+    | otherwise = HeadersOnly
+  auth = fromMaybe "" $ lookupHeader hAuthorization
+  tokenStr = case T.split (== ' ') (toS auth) of
+    ("Bearer" : t : _) -> t
+    _                  -> ""
+  endingIn:: [Text] -> Text -> Bool
+  endingIn xx key = lastWord `elem` xx
+    where lastWord = last $ T.split (=='.') key
+
+  headerRange = rangeRequested hdrs
+  replaceLast x s = T.intercalate "." $ L.init (T.split (=='.') s) ++ [x]
+  limitParams :: M.HashMap ByteString NonnegRange
+  limitParams  = M.fromList [(toS (replaceLast "limit" k), restrictRange (readMaybe =<< (toS <$> v)) allRange) | (k,v) <- qParams, isJust v, endingIn ["limit"] k]
+  offsetParams :: M.HashMap ByteString NonnegRange
+  offsetParams = M.fromList [(toS (replaceLast "limit" k), fromMaybe allRange (rangeGeq <$> (readMaybe =<< (toS <$> v)))) | (k,v) <- qParams, isJust v, endingIn ["offset"] k]
+
+  urlRange = M.unionWith f limitParams offsetParams
+    where
+      f rl ro = Range (BoundaryBelow o) (BoundaryAbove $ o + l - 1)
+        where
+          l = fromMaybe 0 $ rangeLimit rl
+          o = rangeOffset ro
+  ranges = M.insert "limit" (rangeIntersection headerRange (fromMaybe allRange (M.lookup "limit" urlRange))) urlRange
+
+{-|
+  Find the best match from a list of content types accepted by the
+  client in order of decreasing preference and a list of types
+  producible by the server.  If there is no match but the client
+  accepts */* then return the top server pick.
+-}
+mutuallyAgreeable :: [ContentType] -> [ContentType] -> Maybe ContentType
+mutuallyAgreeable sProduces cAccepts =
+  let exact = listToMaybe $ L.intersect cAccepts sProduces in
+  if isNothing exact && CTAny `elem` cAccepts
+     then listToMaybe sProduces
+     else exact
+
+-- PRIVATE ---------------------------------------------------------------
+
+{-|
+  Warning: discards MIME parameters
+-}
+decodeContentType :: BS.ByteString -> ContentType
+decodeContentType ct =
+  case BS.takeWhile (/= BS.c2w ';') ct of
+    "application/json"                  -> CTApplicationJSON
+    "text/csv"                          -> CTTextCSV
+    "application/openapi+json"          -> CTOpenAPI
+    "application/vnd.pgrst.object+json" -> CTSingularJSON
+    "application/vnd.pgrst.object"      -> CTSingularJSON
+    "*/*"                               -> CTAny
+    ct'                                 -> CTOther ct'
+
+type CsvData = V.Vector (M.HashMap Text BL.ByteString)
+
+{-|
+  Converts CSV like
+  a,b
+  1,hi
+  2,bye
+
+  into a JSON array like
+  [ {"a": "1", "b": "hi"}, {"a": 2, "b": "bye"} ]
+
+  The reason for its odd signature is so that it can compose
+  directly with CSV.decodeByName
+-}
+csvToJson :: (CSV.Header, CsvData) -> JSON.Array
+csvToJson (_, vals) =
+  V.map rowToJsonObj vals
+ where
+  rowToJsonObj = JSON.Object .
+    M.map (\str ->
+        if str == "NULL"
+          then JSON.Null
+          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
+
+-- | Test that Array contains only Objects having the same keys
+-- and if so mark it as PayloadJSON
+ensureUniform :: JSON.Array -> Maybe PayloadJSON
+ensureUniform arr =
+  let objs :: V.Vector JSON.Object
+      objs = foldr -- filter non-objects, map to raw objects
+               (\val result -> case val of
+                  JSON.Object o -> V.cons o result
+                  _ -> result)
+               V.empty arr
+      keysPerObj = V.map (S.fromList . M.keys) objs
+      canonicalKeys = fromMaybe S.empty $ keysPerObj V.!? 0
+      areKeysUniform = all (==canonicalKeys) keysPerObj in
+
+  if (V.length objs == V.length arr) && areKeysUniform
+    then Just (PayloadJSON objs)
+    else Nothing
@@ -0,0 +1,316 @@
+{-# LANGUAGE FlexibleContexts    #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TupleSections #-}
+--module PostgREST.App where
+module PostgREST.App (
+  postgrest
+) where
+
+import           Control.Applicative
+import qualified Data.ByteString.Char8     as BS
+import           Data.IORef                (IORef, readIORef)
+import           Data.Text                 (intercalate)
+import           Data.Time.Clock.POSIX     (POSIXTime)
+
+import qualified Hasql.Pool                 as P
+import qualified Hasql.Transaction          as HT
+import qualified Hasql.Transaction.Sessions as HT
+
+import           Network.HTTP.Types.Header
+import           Network.HTTP.Types.Status
+import           Network.HTTP.Types.URI    (renderSimpleQuery)
+import           Network.Wai
+import           Network.Wai.Middleware.RequestLogger (logStdout)
+import           Web.JWT                   (binarySecret)
+
+import qualified Data.Vector               as V
+import qualified Hasql.Transaction         as H
+
+import qualified Data.HashMap.Strict       as M
+
+import           PostgREST.ApiRequest   ( ApiRequest(..), ContentType(..)
+                                        , Action(..), Target(..)
+                                        , PreferRepresentation (..)
+                                        , mutuallyAgreeable
+                                        , toHeader
+                                        , userApiRequest
+                                        , toMime
+                                        )
+import           PostgREST.Auth            (jwtClaims, containsRole)
+import           PostgREST.Config          (AppConfig (..))
+import           PostgREST.DbStructure
+import           PostgREST.DbRequestBuilder(readRequest, mutateRequest)
+import           PostgREST.Error           (errResponse, pgErrResponse, apiRequestErrResponse, singularityError)
+import           PostgREST.RangeQuery      (allRange, rangeOffset)
+import           PostgREST.Middleware
+import           PostgREST.QueryBuilder ( callProc
+                                        , requestToQuery
+                                        , requestToCountQuery
+                                        , createReadStatement
+                                        , createWriteStatement
+                                        , ResultsWithCount
+                                        )
+import           PostgREST.Types
+import           PostgREST.OpenAPI
+
+import           Data.Function (id)
+import           Protolude                hiding (intercalate, Proxy)
+
+postgrest :: AppConfig -> IORef DbStructure -> P.Pool -> IO POSIXTime ->
+             Application
+postgrest conf refDbStructure pool getTime =
+  let middle = (if configQuiet conf then id else logStdout) . defaultMiddle in
+
+  middle $ \ req respond -> do
+    time <- getTime
+    body <- strictRequestBody req
+    dbStructure <- readIORef refDbStructure
+
+    response <- case userApiRequest (configSchema conf) req body of
+      Left err -> return $ apiRequestErrResponse err
+      Right apiRequest -> do
+        let jwtSecret = binarySecret <$> configJwtSecret conf
+            eClaims = jwtClaims jwtSecret (iJWT apiRequest) time
+            authed = containsRole eClaims
+            handleReq = runWithClaims conf eClaims (app dbStructure conf) apiRequest
+            txMode = transactionMode $ iAction apiRequest
+        response <- P.use pool $ HT.transaction HT.ReadCommitted txMode handleReq
+        return $ either (pgErrResponse authed) identity response
+    respond response
+
+transactionMode :: Action -> H.Mode
+transactionMode ActionRead = HT.Read
+transactionMode ActionInfo = HT.Read
+transactionMode _ = HT.Write
+
+app :: DbStructure -> AppConfig -> ApiRequest -> H.Transaction Response
+app dbStructure conf apiRequest =
+  case responseContentTypeOrError (iAccepts apiRequest) (iAction apiRequest) of
+    Left errorResponse -> return errorResponse
+    Right contentType ->
+      case (iAction apiRequest, iTarget apiRequest, iPayload apiRequest) of
+
+        (ActionRead, TargetIdent qi, Nothing) ->
+          case readSqlParts of
+            Left errorResponse -> return errorResponse
+            Right (q, cq) -> do
+              let stm = createReadStatement q cq (contentType == CTSingularJSON) shouldCount (contentType == CTTextCSV)
+              row <- H.query () stm
+              let (tableTotal, queryTotal, _ , body) = row
+                  (status, contentRange) = rangeHeader queryTotal tableTotal
+                  canonical = iCanonicalQS apiRequest
+              return $
+                if contentType == CTSingularJSON && queryTotal /= 1
+                  then singularityError (toInteger queryTotal)
+                  else responseLBS status
+                    [toHeader contentType, contentRange,
+                      ("Content-Location",
+                        "/" <> toS (qiName qi) <>
+                          if BS.null canonical then "" else "?" <> toS canonical
+                      )
+                    ] (toS body)
+
+        (ActionCreate, TargetIdent (QualifiedIdentifier _ table), Just payload@(PayloadJSON rows)) ->
+          case mutateSqlParts of
+            Left errorResponse -> return errorResponse
+            Right (sq, mq) -> do
+              let isSingle = (==1) $ V.length rows
+              if contentType == CTSingularJSON
+                 && not isSingle
+                 && iPreferRepresentation apiRequest == Full
+                then return $ singularityError (toInteger $ V.length rows)
+                else do
+                  let pKeys = map pkName $ filter (filterPk schema table) allPrKeys -- would it be ok to move primary key detection in the query itself?
+                      stm = createWriteStatement sq mq
+                        (contentType == CTSingularJSON) isSingle
+                        (contentType == CTTextCSV) (iPreferRepresentation apiRequest)
+                        pKeys
+                  row <- H.query payload stm
+                  let (_, _, fs, body) = extractQueryResult row
+                      headers = catMaybes [
+                          if null fs
+                            then Nothing
+                            else Just (hLocation, "/" <> toS table <> renderLocationFields fs)
+                        , if iPreferRepresentation apiRequest == Full
+                            then Just $ toHeader contentType
+                            else Nothing
+                        , Just . contentRangeH 1 0 $
+                            toInteger <$> if shouldCount then Just (V.length rows) else Nothing
+                        ]
+
+                  return . responseLBS status201 headers $
+                    if iPreferRepresentation apiRequest == Full
+                      then toS body else ""
+
+        (ActionUpdate, TargetIdent _, Just payload) ->
+          case mutateSqlParts of
+            Left errorResponse -> return errorResponse
+            Right (sq, mq) -> do
+              let stm = createWriteStatement sq mq
+                    (contentType == CTSingularJSON) False (contentType == CTTextCSV)
+                    (iPreferRepresentation apiRequest) []
+              row <- H.query payload stm
+              let (_, queryTotal, _, body) = extractQueryResult row
+              if contentType == CTSingularJSON
+                 && queryTotal /= 1
+                 && iPreferRepresentation apiRequest == Full
+                then do
+                  HT.condemn
+                  return $ singularityError (toInteger queryTotal)
+                else do
+                  let r = contentRangeH 0 (toInteger $ queryTotal-1)
+                            (toInteger <$> if shouldCount then Just queryTotal else Nothing)
+                      s = if iPreferRepresentation apiRequest == Full
+                            then status200
+                            else status204
+                  return $ if iPreferRepresentation apiRequest == Full
+                    then responseLBS s [toHeader contentType, r] (toS body)
+                    else responseLBS s [r] ""
+
+        (ActionDelete, TargetIdent _, Nothing) ->
+          case mutateSqlParts of
+            Left errorResponse -> return errorResponse
+            Right (sq, mq) -> do
+              let emptyPayload = PayloadJSON V.empty
+                  stm = createWriteStatement sq mq
+                    (contentType == CTSingularJSON) False
+                    (contentType == CTTextCSV)
+                    (iPreferRepresentation apiRequest) []
+              row <- H.query emptyPayload stm
+              let (_, queryTotal, _, body) = extractQueryResult row
+                  r = contentRangeH 1 0 $
+                        toInteger <$> if shouldCount then Just queryTotal else Nothing
+              if contentType == CTSingularJSON
+                 && queryTotal /= 1
+                 && iPreferRepresentation apiRequest == Full
+                then do
+                  HT.condemn
+                  return $ singularityError (toInteger queryTotal)
+                else
+                  return $ if iPreferRepresentation apiRequest == Full
+                    then responseLBS status200 [toHeader contentType, r] (toS body)
+                    else responseLBS status204 [r] ""
+
+        (ActionInfo, TargetIdent (QualifiedIdentifier tSchema tTable), Nothing) ->
+          let mTable = find (\t -> tableName t == tTable && tableSchema t == tSchema) (dbTables dbStructure) in
+          case mTable of
+            Nothing -> return notFound
+            Just table ->
+              let acceptH = (hAllow, if tableInsertable table then "GET,POST,PATCH,DELETE" else "GET") in
+              return $ responseLBS status200 [allOrigins, acceptH] ""
+
+        (ActionInvoke, TargetProc qi, Just (PayloadJSON payload)) ->
+          case readSqlParts of
+            Left errorResponse -> return errorResponse
+            Right (q, cq) -> do
+              let p = V.head payload
+                  singular = contentType == CTSingularJSON
+                  paramsAsSingleObject = iPreferSingleObjectParameter apiRequest
+              row <- H.query () (callProc qi p q cq topLevelRange shouldCount singular paramsAsSingleObject)
+              let (tableTotal, queryTotal, body) =
+                    fromMaybe (Just 0, 0, "[]") row
+                  (status, contentRange) = rangeHeader queryTotal tableTotal
+              if singular && queryTotal /= 1
+                then do
+                  HT.condemn
+                  return $ singularityError (toInteger queryTotal)
+                else return $ responseLBS status [jsonH, contentRange] (toS body)
+
+        (ActionInspect, TargetRoot, Nothing) -> do
+          let host = configHost conf
+              port = toInteger $ configPort conf
+              proxy = pickProxy $ toS <$> configProxyUri conf
+              uri Nothing = ("http", host, port, "/")
+              uri (Just Proxy { proxyScheme = s, proxyHost = h, proxyPort = p, proxyPath = b }) = (s, h, p, b)
+              uri' = uri proxy
+              encodeApi ti = encodeOpenAPI (map snd $ dbProcs dbStructure) ti uri'
+          body <- encodeApi . toTableInfo <$> H.query schema accessibleTables
+          return $ responseLBS status200 [toHeader CTOpenAPI] $ toS body
+
+        _ -> return notFound
+
+    where
+      toTableInfo :: [Table] -> [(Table, [Column], [Text])]
+      toTableInfo = map (\t ->
+        let tSchema = tableSchema t
+            tTable = tableName t
+            cols = filter (filterCol tSchema tTable) $ dbColumns dbStructure
+            pkeys = map pkName $ filter (filterPk tSchema tTable) allPrKeys
+        in (t, cols, pkeys))
+      notFound = responseLBS status404 [] ""
+      filterPk sc table pk = sc == (tableSchema . pkTable) pk && table == (tableName . pkTable) pk
+      filterCol :: Schema -> TableName -> Column -> Bool
+      filterCol sc tb Column{colTable=Table{tableSchema=s, tableName=t}} = s==sc && t==tb
+      filterCol _ _ _ =  False
+      allPrKeys = dbPrimaryKeys dbStructure
+      allOrigins = ("Access-Control-Allow-Origin", "*") :: Header
+      jsonH = toHeader CTApplicationJSON
+      shouldCount = iPreferCount apiRequest
+      schema = toS $ configSchema conf
+      topLevelRange = fromMaybe allRange $ M.lookup "limit" $ iRange apiRequest
+      rangeHeader queryTotal tableTotal =
+        let lower = rangeOffset topLevelRange
+            upper = lower + toInteger queryTotal - 1
+            contentRange = contentRangeH lower upper (toInteger <$> tableTotal)
+            status = rangeStatus lower upper (toInteger <$> tableTotal)
+        in (status, contentRange)
+
+      mapSnd f (a, b) = (a, f b)
+      readReq = readRequest (configMaxRows conf) (dbRelations dbStructure) (map (mapSnd pdReturnType) $ dbProcs dbStructure) apiRequest
+      readDbRequest = DbRead <$> readReq
+      mutateDbRequest = DbMutate <$> (mutateRequest apiRequest =<< readReq)
+      selectQuery = requestToQuery schema False <$> readDbRequest
+      mutateQuery = requestToQuery schema False <$> mutateDbRequest
+      countQuery = requestToCountQuery schema <$> readDbRequest
+      readSqlParts = (,) <$> selectQuery <*> countQuery
+      mutateSqlParts = (,) <$> selectQuery <*> mutateQuery
+
+responseContentTypeOrError :: [ContentType] -> Action -> Either Response ContentType
+responseContentTypeOrError accepts action = serves contentTypesForRequest accepts
+  where
+    contentTypesForRequest =
+      case action of
+        ActionRead ->    [CTApplicationJSON, CTSingularJSON, CTTextCSV]
+        ActionCreate ->  [CTApplicationJSON, CTSingularJSON, CTTextCSV]
+        ActionUpdate ->  [CTApplicationJSON, CTSingularJSON, CTTextCSV]
+        ActionDelete ->  [CTApplicationJSON, CTSingularJSON, CTTextCSV]
+        ActionInvoke ->  [CTApplicationJSON, CTSingularJSON]
+        ActionInspect -> [CTOpenAPI]
+        ActionInfo ->    [CTTextCSV]
+    serves sProduces cAccepts =
+      case mutuallyAgreeable sProduces cAccepts of
+        Nothing -> do
+          let failed = intercalate ", " $ map (toS . toMime) cAccepts
+          Left $ errResponse status415 $
+            "None of these Content-Types are available: " <> failed
+        Just ct -> Right ct
+
+splitKeyValue :: BS.ByteString -> (BS.ByteString, BS.ByteString)
+splitKeyValue kv = (k, BS.tail v)
+  where (k, v) = BS.break (== '=') kv
+
+renderLocationFields :: [BS.ByteString] -> BS.ByteString
+renderLocationFields fields =
+  renderSimpleQuery True $ map splitKeyValue fields
+
+rangeStatus :: Integer -> Integer -> Maybe Integer -> Status
+rangeStatus _ _ Nothing = status200
+rangeStatus lower upper (Just total)
+  | lower > total            = status416
+  | (1 + upper - lower) < total = status206
+  | otherwise               = status200
+
+contentRangeH :: Integer -> Integer -> Maybe Integer -> Header
+contentRangeH lower upper total =
+    ("Content-Range", headerValue)
+    where
+      headerValue   = rangeString <> "/" <> totalString
+      rangeString
+        | totalNotZero && fromInRange = show lower <> "-" <> show upper
+        | otherwise = "*"
+      totalString   = fromMaybe "*" (show <$> total)
+      totalNotZero  = fromMaybe True ((/=) 0 <$> total)
+      fromInRange   = lower <= upper
+
+extractQueryResult :: Maybe ResultsWithCount -> ResultsWithCount
+extractQueryResult = fromMaybe (Nothing, 0, [], "")
@@ -0,0 +1,97 @@
+{-# LANGUAGE FlexibleContexts #-}
+{-|
+Module      : PostgREST.Auth
+Description : PostgREST authorization functions.
+
+This module provides functions to deal with the JWT authorization (http://jwt.io).
+It also can be used to define other authorization functions,
+in the future Oauth, LDAP and similar integrations can be coded here.
+
+Authentication should always be implemented in an external service.
+In the test suite there is an example of simple login function that can be used for a
+very simple authentication system inside the PostgreSQL database.
+-}
+module PostgREST.Auth (
+    claimsToSQL
+  , containsRole
+  , jwtClaims
+  , tokenJWT
+  , JWTAttempt(..)
+  ) where
+
+import           Protolude
+import           Control.Lens
+import           Data.Aeson              (Value (..), parseJSON, toJSON)
+import           Data.Aeson.Lens
+import           Data.Aeson.Types        (parseMaybe, emptyObject, emptyArray)
+import qualified Data.Vector             as V
+import qualified Data.HashMap.Strict     as M
+import           Data.Maybe              (fromJust)
+import           Data.Time.Clock         (NominalDiffTime)
+import           PostgREST.QueryBuilder  (pgFmtIdent, pgFmtLit, unquoted)
+import qualified Web.JWT                 as JWT
+
+{-|
+  Receives a map of JWT claims and returns a list of PostgreSQL
+  statements to set the claims as user defined GUCs.  Except if we
+  have a claim called role, this one is mapped to a SET ROLE
+  statement.
+-}
+claimsToSQL :: M.HashMap Text Value -> [ByteString]
+claimsToSQL claims = roleStmts <> varStmts
+ where
+  roleStmts = maybeToList $
+    (\r -> "set local role " <> r <> ";") . toS . valueToVariable <$> M.lookup "role" claims
+  varStmts = map setVar $ M.toList (M.delete "role" claims)
+  setVar (k, val) = "set local " <> toS (pgFmtIdent $ "request.jwt.claim." <> k)
+                    <> " = " <> toS (valueToVariable val) <> ";"
+  valueToVariable = pgFmtLit . unquoted
+
+{-|
+  Possible situations encountered with client JWTs
+-}
+data JWTAttempt = JWTExpired
+                | JWTInvalid
+                | JWTMissingSecret
+                | JWTClaims (M.HashMap Text Value)
+                deriving Eq
+
+{-|
+  Receives the JWT secret (from config) and a JWT and returns a map
+  of JWT claims.
+-}
+jwtClaims :: Maybe JWT.Secret -> Text -> NominalDiffTime -> JWTAttempt
+jwtClaims _ "" _ = JWTClaims M.empty
+jwtClaims secret jwt time =
+  case secret of
+    Nothing -> JWTMissingSecret
+    Just s ->
+      let mClaims = toJSON . JWT.claims <$> JWT.decodeAndVerifySignature s jwt in
+      case isExpired <$> mClaims of
+        Just True -> JWTExpired
+        Nothing -> JWTInvalid
+        Just False -> JWTClaims $ value2map $ fromJust mClaims
+ where
+  isExpired claims =
+    let mExp = claims ^? key "exp" . _Integer
+    in fromMaybe False $ (<= time) . fromInteger <$> mExp
+  value2map (Object o) = o
+  value2map _          = M.empty
+
+{-|
+  Receives the JWT secret (from config) and a JWT and a JSON value
+  and returns a signed JWT.
+-}
+tokenJWT :: JWT.Secret -> Value -> Text
+tokenJWT secret (Array arr) =
+  let obj = if V.null arr then emptyObject else V.head arr
+      jcs = parseMaybe parseJSON obj :: Maybe JWT.JWTClaimsSet in
+  JWT.encodeSigned JWT.HS256 secret $ fromMaybe JWT.def jcs
+tokenJWT secret _ = tokenJWT secret emptyArray
+
+{-|
+  Whether a response from jwtClaims contains a role claim
+-}
+containsRole :: JWTAttempt -> Bool
+containsRole (JWTClaims claims) = M.member "role" claims
+containsRole _ = False
@@ -0,0 +1,188 @@
+{-|
+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.
+
+It currently includes a hardcoded CORS policy but this could easly be
+turned in configurable behaviour if needed.
+
+Other hardcoded options such as the minimum version number also belong here.
+-}
+module PostgREST.Config ( prettyVersion
+                        , readOptions
+                        , corsPolicy
+                        , minimumPgVersion
+                        , PgVersion (..)
+                        , AppConfig (..)
+                        )
+       where
+
+import           System.IO.Error             (IOError)
+import           Control.Applicative
+import qualified Data.ByteString             as B
+import qualified Data.ByteString.Char8       as BS
+import qualified Data.CaseInsensitive        as CI
+import qualified Data.Configurator           as C
+import qualified Data.Configurator.Types     as C
+import           Data.List                   (lookup)
+import           Data.Text                   (strip, intercalate, lines)
+import           Data.Text.Encoding          (encodeUtf8)
+import           Data.Text.IO                (hPutStrLn)
+import           Data.Version                (versionBranch)
+import           Network.Wai
+import           Network.Wai.Middleware.Cors (CorsResourcePolicy (..))
+import           Options.Applicative hiding  (str)
+import           Paths_postgrest             (version)
+import           Text.Heredoc
+import           Text.PrettyPrint.ANSI.Leijen hiding ((<>), (<$>))
+
+import           Protolude hiding            (intercalate
+                                             , (<>))
+
+-- | Config file settings for the server
+data AppConfig = AppConfig {
+    configDatabase          :: Text
+  , configAnonRole          :: Text
+  , configProxyUri          :: Maybe Text
+  , configSchema            :: Text
+  , configHost              :: Text
+  , configPort              :: Int
+
+  , configJwtSecret         :: Maybe B.ByteString
+  , configJwtSecretIsBase64 :: Bool
+
+  , configPool              :: Int
+  , configMaxRows           :: Maybe Integer
+  , configReqCheck          :: Maybe Text
+  , configQuiet             :: Bool
+  }
+
+defaultCorsPolicy :: CorsResourcePolicy
+defaultCorsPolicy =  CorsResourcePolicy Nothing
+  ["GET", "POST", "PATCH", "DELETE", "OPTIONS"] ["Authorization"] Nothing
+  (Just $ 60*60*24) False False True
+
+-- | CORS policy to be used in by Wai Cors middleware
+corsPolicy :: Request -> Maybe CorsResourcePolicy
+corsPolicy req = case lookup "origin" headers of
+  Just origin -> Just defaultCorsPolicy {
+      corsOrigins = Just ([origin], True)
+    , corsRequestHeaders = "Authentication":accHeaders
+    , corsExposedHeaders = Just [
+        "Content-Encoding", "Content-Location", "Content-Range", "Content-Type"
+      , "Date", "Location", "Server", "Transfer-Encoding", "Range-Unit"
+      ]
+    }
+  Nothing -> Nothing
+  where
+    headers = requestHeaders req
+    accHeaders = case lookup "access-control-request-headers" headers of
+      Just hdrs -> map (CI.mk . toS . strip . toS) $ BS.split ',' hdrs
+      Nothing -> []
+
+-- | User friendly version number
+prettyVersion :: Text
+prettyVersion = intercalate "." $ map show $ versionBranch version
+
+-- | Function to read and parse options from the command line
+readOptions :: IO AppConfig
+readOptions = do
+  -- First read the config file path from command line
+  cfgPath <- customExecParser parserPrefs opts
+  -- Now read the actual config file
+  conf <- catch
+    (C.load [C.Required cfgPath])
+    configNotfoundHint
+
+  handle missingKeyHint $ do
+    -- db ----------------
+    cDbUri    <- C.require conf "db-uri"
+    cDbSchema <- C.require conf "db-schema"
+    cDbAnon   <- C.require conf "db-anon-role"
+    cPool     <- C.lookupDefault 10 conf "db-pool"
+    -- server ------------
+    cHost     <- C.lookupDefault "*4" conf "server-host"
+    cPort     <- C.lookupDefault 3000 conf "server-port"
+    cProxy    <- C.lookup conf "server-proxy-uri"
+    -- jwt ---------------
+    cJwtSec   <- C.lookup conf "jwt-secret"
+    cJwtB64   <- C.lookupDefault False conf "secret-is-base64"
+    -- safety ------------
+    cMaxRows  <- C.lookup conf "max-rows"
+    cReqCheck <- C.lookup conf "pre-request"
+
+    return $ AppConfig cDbUri cDbAnon cProxy cDbSchema cHost cPort
+          (encodeUtf8 <$> cJwtSec) cJwtB64 cPool cMaxRows cReqCheck False
+
+ where
+  opts = info (helper <*> pathParser) $
+           fullDesc
+           <> progDesc (
+               "PostgREST "
+               <> toS prettyVersion
+               <> " / create a REST API to an existing Postgres database"
+             )
+           <> footerDoc (Just $
+               text "Example Config File:"
+               <> nest 2 (hardline <> exampleCfg)
+             )
+
+  parserPrefs = prefs showHelpOnError
+
+  configNotfoundHint :: IOError -> IO a
+  configNotfoundHint e = do
+    hPutStrLn stderr $
+      "Cannot open config file:\n\t" <> show e
+    exitFailure
+
+  missingKeyHint :: C.KeyError -> IO a
+  missingKeyHint (C.KeyError n) = do
+    hPutStrLn stderr $
+      "Required config parameter \"" <> n <> "\" is missing or of wrong type.\n" <>
+      "Try the --example-config option to see how to configure PostgREST."
+    exitFailure
+
+  exampleCfg :: Doc
+  exampleCfg = vsep . map (text . toS) . lines $
+    [str|db-uri = "postgres://user:pass@localhost:5432/dbname"
+        |db-schema = "public"
+        |db-anon-role = "postgres"
+        |db-pool = 10
+        |
+        |server-host = "*4"
+        |server-port = 3000
+        |
+        |## base url for swagger output
+        |# server-proxy-uri = ""
+        |
+        |## choose a secret to enable JWT auth
+        |## (use "@filename" to load from separate file)
+        |# jwt-secret = "foo"
+        |# secret-is-base64 = false
+        |
+        |## limit rows in response
+        |# max-rows = 1000
+        |
+        |## stored proc to exec immediately after auth
+        |# pre-request = "stored_proc_name"
+        |]
+
+
+pathParser :: Parser FilePath
+pathParser =
+  strArgument $
+    metavar "FILENAME" <>
+    help "Path to configuration file"
+
+data PgVersion = PgVersion {
+  pgvNum  :: Int32
+, pgvName :: Text
+}
+
+-- | Tells the minimum PostgreSQL version required by this version of PostgREST
+minimumPgVersion :: PgVersion
+minimumPgVersion = PgVersion 90300 "9.3"
@@ -0,0 +1,275 @@
+{-# LANGUAGE FlexibleContexts #-}
+module PostgREST.DbRequestBuilder (
+  readRequest
+, mutateRequest
+) where
+
+import           Control.Applicative
+import           Control.Lens.Getter       (view)
+import           Control.Lens.Tuple        (_1)
+import qualified Data.ByteString.Char8     as BS
+import           Data.List                 (delete, lookup)
+import           Data.Maybe                (fromJust)
+import           Data.Text                 (isInfixOf, dropWhile, drop)
+import           Data.Tree
+import           Data.Either.Combinators   (mapLeft)
+
+import           Text.Parsec.Error
+
+import           Network.HTTP.Types.Status
+import           Network.Wai
+
+import           Data.Foldable (foldr1)
+import qualified Data.HashMap.Strict       as M
+
+import           PostgREST.ApiRequest   ( ApiRequest(..) 
+                                        , Action(..), Target(..)
+                                        , PreferRepresentation (..)
+                                        )
+import           PostgREST.Error           (errResponse, formatParserError)
+import           PostgREST.Parsers
+import           PostgREST.RangeQuery      (NonnegRange, restrictRange)
+import           PostgREST.QueryBuilder (getJoinConditions, sourceCTEName)
+import           PostgREST.Types
+
+import           Protolude                hiding (from, dropWhile, drop)
+import           Text.Regex.TDFA         ((=~))
+import           Unsafe                  (unsafeHead)
+
+readRequest :: Maybe Integer -> [Relation] -> [(Text, Text)] -> ApiRequest -> Either Response ReadRequest
+readRequest maxRows allRels allProcs apiRequest  =
+  mapLeft (errResponse status400) $
+  treeRestrictRange maxRows =<<
+  augumentRequestWithJoin schema relations =<<
+  first formatParserError parseReadRequest
+  where
+    (schema, rootTableName) = fromJust $ -- Make it safe
+      let target = iTarget apiRequest in
+      case target of
+        (TargetIdent (QualifiedIdentifier s t) ) -> Just (s, t)
+        (TargetProc  (QualifiedIdentifier s p) ) -> Just (s, t)
+          where
+            returnType = fromMaybe "" $ lookup p allProcs
+            -- we are looking for results looking like "SETOF schema.tablename" and want to extract tablename
+            t = if "SETOF " `isInfixOf` returnType
+              then drop 1 $ dropWhile (/= '.') returnType
+              else p
+
+        _ -> Nothing
+
+    action :: Action
+    action = iAction apiRequest
+
+    parseReadRequest :: Either ParseError ReadRequest
+    parseReadRequest = addFiltersOrdersRanges apiRequest <*>
+      pRequestSelect rootName selStr
+      where
+        selStr = iSelect apiRequest
+        rootName = if action == ActionRead
+          then rootTableName
+          else sourceCTEName
+
+    relations :: [Relation]
+    relations = case action of
+      ActionCreate -> fakeSourceRelations ++ allRels
+      ActionUpdate -> fakeSourceRelations ++ allRels
+      ActionDelete -> fakeSourceRelations ++ allRels
+      ActionInvoke -> fakeSourceRelations ++ allRels
+      _       -> allRels
+      where fakeSourceRelations = mapMaybe (toSourceRelation rootTableName) allRels -- see comment in toSourceRelation
+
+treeRestrictRange :: Maybe Integer -> ReadRequest -> Either Text ReadRequest
+treeRestrictRange maxRows_ request = pure $ nodeRestrictRange maxRows_ `fmap` request
+  where
+    nodeRestrictRange :: Maybe Integer -> ReadNode -> ReadNode
+    nodeRestrictRange m (q@Select {range_=r}, i) = (q{range_=restrictRange m r }, i)
+
+augumentRequestWithJoin :: Schema ->  [Relation] ->  ReadRequest -> Either Text ReadRequest
+augumentRequestWithJoin schema allRels request =
+  (first formatRelationError . addRelations schema allRels Nothing) request
+  >>= addJoinConditions schema
+  where
+    formatRelationError = ("could not find foreign keys between these entities, " <>)
+
+addRelations :: Schema -> [Relation] -> Maybe ReadRequest -> ReadRequest -> Either Text ReadRequest
+addRelations schema allRelations parentNode (Node readNode@(query, (name, _, alias)) forest) =
+  case parentNode of
+    (Just (Node (Select{from=[parentNodeTable]}, (_, _, _)) _)) ->
+      Node <$> readNode' <*> forest'
+      where
+        forest' = updateForest $ hush node'
+        node' = Node <$> readNode' <*> pure forest
+        readNode' = addRel readNode <$> rel
+        rel :: Either Text Relation
+        rel = note ("no relation between " <> parentNodeTable <> " and " <> name)
+            $ findRelation schema name parentNodeTable
+
+            where
+              findRelation s nodeTableName parentNodeTableName =
+                find (\r ->
+                  s == tableSchema (relTable r) && -- match schema for relation table
+                  s == tableSchema (relFTable r) && -- match schema for relation foriegn table
+                  (
+
+                    -- (request)        => projects { ..., clients{...} }
+                    -- will match
+                    -- (relation type)  => parent
+                    -- (entity)         => clients  {id}
+                    -- (foriegn entity) => projects {client_id}
+                    (
+                      nodeTableName == tableName (relTable r) && -- match relation table name
+                      parentNodeTableName == tableName (relFTable r) -- match relation foreign table name
+                    ) ||
+
+
+                    -- (request)        => projects { ..., client_id{...} }
+                    -- will match
+                    -- (relation type)  => parent
+                    -- (entity)         => clients  {id}
+                    -- (foriegn entity) => projects {client_id}
+                    (
+                      parentNodeTableName == tableName (relFTable r) &&
+                      length (relFColumns r) == 1 &&
+                      nodeTableName `colMatches` (colName . unsafeHead . relFColumns) r
+                    )
+
+                    -- (request)        => project_id { ..., client_id{...} }
+                    -- will match
+                    -- (relation type)  => parent
+                    -- (entity)         => clients  {id}
+                    -- (foriegn entity) => projects {client_id}
+                    -- this case works becasue before reaching this place
+                    -- addRelation will turn project_id to project so the above condition will match
+                  )
+                ) allRelations
+                where n `colMatches` rc = (toS ("^" <> rc <> "_?(?:|[iI][dD]|[fF][kK])$") :: BS.ByteString) =~ (toS n :: BS.ByteString)
+        addRel :: (ReadQuery, (NodeName, Maybe Relation, Maybe Alias)) -> Relation -> (ReadQuery, (NodeName, Maybe Relation, Maybe Alias))
+        addRel (query', (n, _, a)) r = (query' {from=fromRelation}, (n, Just r, a))
+          where fromRelation = map (\t -> if t == n then tableName (relTable r) else t) (from query')
+
+    _ -> n' <$> updateForest (Just (n' forest))
+      where
+        n' = Node (query, (name, Just r, alias))
+        t = Table schema name True -- !!! TODO find another way to get the table from the query
+        r = Relation t [] t [] Root Nothing Nothing Nothing
+  where
+    updateForest :: Maybe ReadRequest -> Either Text [ReadRequest]
+    updateForest n = mapM (addRelations schema allRelations n) forest
+
+addJoinConditions :: Schema -> ReadRequest -> Either Text ReadRequest
+addJoinConditions schema (Node nn@(query, (n, r, a)) forest) =
+  case r of
+    Just Relation{relType=Root} -> Node nn  <$> updatedForest -- this is the root node
+    Just rel@Relation{relType=Child} -> Node (addCond query (getJoinConditions rel),(n,r,a)) <$> updatedForest
+    Just Relation{relType=Parent} -> Node nn <$> updatedForest
+    Just rel@Relation{relType=Many, relLTable=(Just linkTable)} ->
+      Node (qq, (n, r, a)) <$> updatedForest
+      where
+         query' = addCond query (getJoinConditions rel)
+         qq = query'{from=tableName linkTable : from query'}
+    _ -> Left "unknown relation"
+  where
+    updatedForest = mapM (addJoinConditions schema) forest
+    addCond query' con = query'{flt_=con ++ flt_ query'}
+
+addFiltersOrdersRanges :: ApiRequest -> Either ParseError (ReadRequest -> ReadRequest)
+addFiltersOrdersRanges apiRequest = foldr1 (liftA2 (.)) [
+    flip (foldr addFilter) <$> filters,
+    flip (foldr addOrder) <$> orders,
+    flip (foldr addRange) <$> ranges
+  ]
+  {-
+  The esence of what is going on above is that we are composing tree functions
+  of type (ReadRequest->ReadRequest) that are in (Either ParseError a) context
+  -}
+  where
+    filters :: Either ParseError [(Path, Filter)]
+    filters = mapM pRequestFilter flts
+      where
+        action = iAction apiRequest
+        flts
+          | action == ActionRead = iFilters apiRequest
+          | action == ActionInvoke = iFilters apiRequest
+          | otherwise = filter (( "." `isInfixOf` ) . fst) $ iFilters apiRequest -- there can be no filters on the root table whre we are doing insert/update
+    orders :: Either ParseError [(Path, [OrderTerm])]
+    orders = mapM pRequestOrder $ iOrder apiRequest
+    ranges :: Either ParseError [(Path, NonnegRange)]
+    ranges = mapM pRequestRange $ M.toList $ iRange apiRequest
+
+addFilterToNode :: Filter -> ReadRequest -> ReadRequest
+addFilterToNode flt (Node (q@Select {flt_=flts}, i) f) = Node (q {flt_=flt:flts}, i) f
+
+addFilter :: (Path, Filter) -> ReadRequest -> ReadRequest
+addFilter = addProperty addFilterToNode
+
+addOrderToNode :: [OrderTerm] -> ReadRequest -> ReadRequest
+addOrderToNode o (Node (q,i) f) = Node (q{order=Just o}, i) f
+
+addOrder :: (Path, [OrderTerm]) -> ReadRequest -> ReadRequest
+addOrder = addProperty addOrderToNode
+
+addRangeToNode :: NonnegRange -> ReadRequest -> ReadRequest
+addRangeToNode r (Node (q,i) f) = Node (q{range_=r}, i) f
+
+addRange :: (Path, NonnegRange) -> ReadRequest -> ReadRequest
+addRange = addProperty addRangeToNode
+
+addProperty :: (a -> ReadRequest -> ReadRequest) -> (Path, a) -> ReadRequest -> ReadRequest
+addProperty f ([], a) n = f a n
+addProperty f (path, a) (Node rn forest) =
+  case targetNode of
+    Nothing -> Node rn forest -- the property is silenty dropped in the Request does not contain the required path
+    Just tn -> Node rn (addProperty f (remainingPath, a) tn:restForest)
+  where
+    targetNodeName:remainingPath = path
+    (targetNode,restForest) = splitForest targetNodeName forest
+    splitForest :: NodeName -> Forest ReadNode -> (Maybe ReadRequest, Forest ReadNode)
+    splitForest name forst =
+      case maybeNode of
+        Nothing -> (Nothing,forest)
+        Just node -> (Just node, delete node forest)
+      where
+        maybeNode :: Maybe ReadRequest
+        maybeNode = find fnd forst
+          where
+            fnd :: ReadRequest -> Bool
+            fnd (Node (_,(n,_,_)) _) = n == name
+
+-- in a relation where one of the tables mathces "TableName"
+-- replace the name to that table with pg_source
+-- this "fake" relations is needed so that in a mutate query
+-- we can look a the "returning *" part which is wrapped with a "with"
+-- as just another table that has relations with other tables
+toSourceRelation :: TableName -> Relation -> Maybe Relation
+toSourceRelation mt r@(Relation t _ ft _ _ rt _ _)
+  | mt == tableName t = Just $ r {relTable=t {tableName=sourceCTEName}}
+  | mt == tableName ft = Just $ r {relFTable=t {tableName=sourceCTEName}}
+  | Just mt == (tableName <$> rt) = Just $ r {relLTable=(\tbl -> tbl {tableName=sourceCTEName}) <$> rt}
+  | otherwise = Nothing
+
+mutateRequest :: ApiRequest -> ReadRequest -> Either Response MutateRequest
+mutateRequest apiRequest readReq = mapLeft (errResponse status400) $
+  case action of
+    ActionCreate -> Right $ Insert rootTableName payload returnings
+    ActionUpdate -> Update rootTableName <$> pure payload <*> filters <*> pure returnings
+    ActionDelete -> Delete rootTableName <$> filters <*> pure returnings
+    _        -> Left "Unsupported HTTP verb"
+  where
+    action = iAction apiRequest
+    payload = fromJust $ iPayload apiRequest
+    rootTableName = -- TODO: Make it safe
+      let target = iTarget apiRequest in
+      case target of
+        (TargetIdent (QualifiedIdentifier _ t) ) -> t
+        _ -> undefined
+    fieldNames :: ReadRequest -> PreferRepresentation -> [FieldName]
+    fieldNames _ None = []
+    fieldNames (Node (sel, _) forest) _ =
+      map (fst . view _1) (select sel) ++ map colName fks
+      where
+        fks = concatMap (fromMaybe [] . f) forest
+        f (Node (_, (_, Just Relation{relFColumns=cols, relType=Parent}, _)) _) = Just cols
+        f _ = Nothing
+    returnings = fieldNames readReq (iPreferRepresentation apiRequest) 
+    filters = first formatParserError $ map snd <$> mapM pRequestFilter mutateFilters
+      where mutateFilters = filter (not . ( "." `isInfixOf` ) . fst) $ iFilters apiRequest -- update/delete filters can be only on the root table
@@ -0,0 +1,634 @@
+{-# LANGUAGE FlexibleContexts      #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE QuasiQuotes           #-}
+{-# LANGUAGE ScopedTypeVariables   #-}
+{-# LANGUAGE TypeSynonymInstances  #-}
+module PostgREST.DbStructure (
+  getDbStructure
+, accessibleTables
+) where
+
+import qualified Hasql.Decoders                as HD
+import qualified Hasql.Encoders                as HE
+import qualified Hasql.Query                   as H
+
+import           Control.Applicative
+import           Data.List                     (elemIndex)
+import           Data.Maybe                    (fromJust)
+import           Data.Text                     (split, strip,
+                                                breakOn, dropAround)
+import qualified Data.Text                     as T
+import qualified Hasql.Session                 as H
+import           PostgREST.Types
+import           Text.InterpolatedString.Perl6 (q)
+
+import           GHC.Exts                      (groupWith)
+import           Protolude
+import           Unsafe (unsafeHead)
+
+getDbStructure :: Schema -> H.Session DbStructure
+getDbStructure schema = do
+  tabs <- H.query () allTables
+  cols <- H.query () $ allColumns tabs
+  syns <- H.query () $ allSynonyms cols
+  rels <- H.query () $ allRelations tabs cols
+  keys <- H.query () $ allPrimaryKeys tabs
+  procs <- H.query schema accessibleProcs
+
+  let rels' = (addManyToManyRelations . raiseRelations schema syns . addParentRelations . addSynonymousRelations syns) rels
+      cols' = addForeignKeys rels' cols
+      keys' = synonymousPrimaryKeys syns keys
+
+  return DbStructure {
+      dbTables = tabs
+    , dbColumns = cols'
+    , dbRelations = rels'
+    , dbPrimaryKeys = keys'
+    , dbProcs = procs
+    }
+
+decodeTables :: HD.Result [Table]
+decodeTables =
+  HD.rowsList tblRow
+ where
+  tblRow = Table <$> HD.value HD.text <*> HD.value HD.text
+                 <*> HD.value HD.bool
+
+decodeColumns :: [Table] -> HD.Result [Column]
+decodeColumns tables =
+  mapMaybe (columnFromRow tables) <$> HD.rowsList colRow
+ where
+  colRow =
+    (,,,,,,,,,,)
+      <$> HD.value HD.text <*> HD.value HD.text
+      <*> HD.value HD.text <*> HD.value HD.int4
+      <*> HD.value HD.bool <*> HD.value HD.text
+      <*> HD.value HD.bool
+      <*> HD.nullableValue HD.int4
+      <*> HD.nullableValue HD.int4
+      <*> HD.nullableValue HD.text
+      <*> HD.nullableValue HD.text
+
+decodeRelations :: [Table] -> [Column] -> HD.Result [Relation]
+decodeRelations tables cols =
+  mapMaybe (relationFromRow tables cols) <$> HD.rowsList relRow
+ where
+  relRow = (,,,,,)
+    <$> HD.value HD.text
+    <*> HD.value HD.text
+    <*> HD.value (HD.array (HD.arrayDimension replicateM (HD.arrayValue HD.text)))
+    <*> HD.value HD.text
+    <*> HD.value HD.text
+    <*> HD.value (HD.array (HD.arrayDimension replicateM (HD.arrayValue HD.text)))
+
+decodePks :: [Table] -> HD.Result [PrimaryKey]
+decodePks tables =
+  mapMaybe (pkFromRow tables) <$> HD.rowsList pkRow
+ where
+  pkRow = (,,) <$> HD.value HD.text <*> HD.value HD.text <*> HD.value HD.text
+
+decodeSynonyms :: [Column] -> HD.Result [(Column,Column)]
+decodeSynonyms cols =
+  mapMaybe (synonymFromRow cols) <$> HD.rowsList synRow
+ where
+  synRow = (,,,,,)
+    <$> HD.value HD.text <*> HD.value HD.text
+    <*> HD.value HD.text <*> HD.value HD.text
+    <*> HD.value HD.text <*> HD.value HD.text
+
+accessibleProcs :: H.Query Schema [(Text, ProcDescription)]
+accessibleProcs =
+  H.statement sql (HE.value HE.text)
+    (map addName <$> HD.rowsList (ProcDescription <$> HD.value HD.text
+                                <*> (parseArgs <$> HD.value HD.text)
+                                <*> HD.value HD.text)) True
+ where
+  addName :: ProcDescription -> (Text, ProcDescription)
+  addName pd = (pdName pd, pd)
+
+  parseArgs :: Text -> [PgArg]
+  parseArgs = mapMaybe (parseArg . strip) . split (==',')
+
+  parseArg :: Text -> Maybe PgArg
+  parseArg a =
+    let (body, def) = breakOn " DEFAULT " a
+        (name, typ) = breakOn " " body in
+    if T.null typ
+       then Nothing
+       else Just $
+         PgArg (dropAround (== '"') name) (strip typ) (T.null def)
+
+  sql = [q|
+    SELECT p.proname as "proc_name",
+           pg_get_function_arguments(p.oid) as "args",
+           pg_get_function_result(p.oid) as "return_type"
+    FROM   pg_namespace n
+    JOIN   pg_proc p
+    ON     pronamespace = n.oid
+    WHERE  n.nspname = $1|]
+
+accessibleTables :: H.Query Schema [Table]
+accessibleTables =
+  H.statement sql (HE.value HE.text) decodeTables True
+ where
+  sql = [q|
+    select
+      n.nspname as table_schema,
+      relname as table_name,
+      c.relkind = 'r' or (c.relkind IN ('v', 'f')) and (pg_relation_is_updatable(c.oid::regclass, false) & 8) = 8
+      or (exists (
+         select 1
+         from pg_trigger
+         where pg_trigger.tgrelid = c.oid and (pg_trigger.tgtype::integer & 69) = 69)
+      ) as insertable
+    from
+      pg_class c
+      join pg_namespace n on n.oid = c.relnamespace
+    where
+      c.relkind in ('v', 'r', 'm')
+      and n.nspname = $1
+      and (
+        pg_has_role(c.relowner, 'USAGE'::text)
+        or has_table_privilege(c.oid, 'SELECT, INSERT, UPDATE, DELETE, TRUNCATE, REFERENCES, TRIGGER'::text)
+        or has_any_column_privilege(c.oid, 'SELECT, INSERT, UPDATE, REFERENCES'::text)
+      )
+    order by relname |]
+
+synonymousColumns :: [(Column,Column)] -> [Column] -> [[Column]]
+synonymousColumns allSyns cols = synCols'
+  where
+    syns = case headMay cols of
+            Just firstCol -> sort $ filter ((== colTable firstCol) . colTable . fst) allSyns
+            Nothing -> []
+    synCols  = transpose $ map (\c -> map snd $ filter ((== c) . fst) syns) cols
+    synCols' = (filter sameTable . filter matchLength) synCols
+    matchLength cs = length cols == length cs
+    sameTable (c:cs) = all (\cc -> colTable c == colTable cc) (c:cs)
+    sameTable [] = False
+
+addForeignKeys :: [Relation] -> [Column] -> [Column]
+addForeignKeys rels = map addFk
+  where
+    addFk col = col { colFK = fk col }
+    fk col = join $ relToFk col <$> find (lookupFn col) rels
+    lookupFn :: Column -> Relation -> Bool
+    lookupFn c Relation{relColumns=cs, relType=rty} = c `elem` cs && rty==Child
+    relToFk col Relation{relColumns=cols, relFColumns=colsF} = do
+      pos <- elemIndex col cols
+      colF <- atMay colsF pos
+      return $ ForeignKey colF
+
+addSynonymousRelations :: [(Column,Column)] -> [Relation] -> [Relation]
+addSynonymousRelations _ [] = []
+addSynonymousRelations syns (rel:rels) = rel : synRelsP ++ synRelsF ++ addSynonymousRelations syns rels
+  where
+    synRelsP = synRels (relColumns rel) (\t cs -> rel{relTable=t,relColumns=cs})
+    synRelsF = synRels (relFColumns rel) (\t cs -> rel{relFTable=t,relFColumns=cs})
+    synRels cols mapFn = map (\cs -> mapFn (colTable $ unsafeHead cs) cs) $ synonymousColumns syns cols
+
+addParentRelations :: [Relation] -> [Relation]
+addParentRelations [] = []
+addParentRelations (rel@(Relation t c ft fc _ _ _ _):rels) = Relation ft fc t c Parent Nothing Nothing Nothing : rel : addParentRelations rels
+
+addManyToManyRelations :: [Relation] -> [Relation]
+addManyToManyRelations rels = rels ++ addMirrorRelation (mapMaybe link2Relation links)
+  where
+    links = join $ map (combinations 2) $ filter (not . null) $ groupWith groupFn $ filter ( (==Child). relType) rels
+    groupFn :: Relation -> Text
+    groupFn Relation{relTable=Table{tableSchema=s, tableName=t}} = s<>"_"<>t
+    combinations k ns = filter ((k==).length) (subsequences ns)
+    addMirrorRelation [] = []
+    addMirrorRelation (rel@(Relation t c ft fc _ lt lc1 lc2):rels') = Relation ft fc t c Many lt lc2 lc1 : rel : addMirrorRelation rels'
+    link2Relation [
+      Relation{relTable=lt, relColumns=lc1, relFTable=t,  relFColumns=c},
+      Relation{             relColumns=lc2, relFTable=ft, relFColumns=fc}
+      ]
+      | lc1 /= lc2 && length lc1 == 1 && length lc2 == 1 = Just $ Relation t c ft fc Many (Just lt) (Just lc1) (Just lc2)
+      | otherwise = Nothing
+    link2Relation _ = Nothing
+
+raiseRelations :: Schema -> [(Column,Column)] -> [Relation] -> [Relation]
+raiseRelations schema syns = map raiseRel
+  where
+    raiseRel rel
+      | tableSchema table == schema = rel
+      | isJust newCols = rel{relFTable=fromJust newTable,relFColumns=fromJust newCols}
+      | otherwise = rel
+      where
+        cols = relFColumns rel
+        table = relFTable rel
+        newCols = listToMaybe $ filter ((== schema) . tableSchema . colTable . unsafeHead) (synonymousColumns syns cols)
+        newTable = (colTable . unsafeHead) <$> newCols
+
+synonymousPrimaryKeys :: [(Column,Column)] -> [PrimaryKey] -> [PrimaryKey]
+synonymousPrimaryKeys _ [] = []
+synonymousPrimaryKeys syns (key:keys) = key : newKeys ++ synonymousPrimaryKeys syns keys
+  where
+    keySyns = filter ((\c -> colTable c == pkTable key && colName c == pkName key) . fst) syns
+    newKeys = map ((\c -> PrimaryKey{pkTable=colTable c,pkName=colName c}) . snd) keySyns
+
+allTables :: H.Query () [Table]
+allTables =
+  H.statement sql HE.unit decodeTables True
+ where
+  sql = [q|
+    SELECT
+      n.nspname AS table_schema,
+      c.relname AS table_name,
+      c.relkind = 'r' OR (c.relkind IN ('v','f'))
+      AND (pg_relation_is_updatable(c.oid::regclass, FALSE) & 8) = 8
+      OR (EXISTS
+        ( SELECT 1
+          FROM pg_trigger
+          WHERE pg_trigger.tgrelid = c.oid
+          AND (pg_trigger.tgtype::integer & 69) = 69) ) AS insertable
+    FROM pg_class c
+    JOIN pg_namespace n ON n.oid = c.relnamespace
+    WHERE c.relkind IN ('v','r','m')
+      AND n.nspname NOT IN ('pg_catalog', 'information_schema')
+    GROUP BY table_schema, table_name, insertable
+    ORDER BY table_schema, table_name |]
+
+allColumns :: [Table] -> H.Query () [Column]
+allColumns tabs =
+  H.statement sql HE.unit (decodeColumns tabs) True
+ where
+  sql = [q|
+    SELECT DISTINCT
+        info.table_schema AS schema,
+        info.table_name AS table_name,
+        info.column_name AS name,
+        info.ordinal_position AS position,
+        info.is_nullable::boolean AS nullable,
+        info.data_type AS col_type,
+        info.is_updatable::boolean AS updatable,
+        info.character_maximum_length AS max_len,
+        info.numeric_precision AS precision,
+        info.column_default AS default_value,
+        array_to_string(enum_info.vals, ',') AS enum
+    FROM (
+        /*
+        -- CTE based on information_schema.columns to remove the owner filter
+        */
+        WITH columns AS (
+            SELECT current_database()::information_schema.sql_identifier AS table_catalog,
+                nc.nspname::information_schema.sql_identifier AS table_schema,
+                c.relname::information_schema.sql_identifier AS table_name,
+                a.attname::information_schema.sql_identifier AS column_name,
+                a.attnum::information_schema.cardinal_number AS ordinal_position,
+                pg_get_expr(ad.adbin, ad.adrelid)::information_schema.character_data AS column_default,
+                    CASE
+                        WHEN a.attnotnull OR t.typtype = 'd'::"char" AND t.typnotnull THEN 'NO'::text
+                        ELSE 'YES'::text
+                    END::information_schema.yes_or_no AS is_nullable,
+                    CASE
+                        WHEN t.typtype = 'd'::"char" THEN
+                        CASE
+                            WHEN bt.typelem <> 0::oid AND bt.typlen = (-1) THEN 'ARRAY'::text
+                            WHEN nbt.nspname = 'pg_catalog'::name THEN format_type(t.typbasetype, NULL::integer)
+                            ELSE format_type(a.atttypid, a.atttypmod)
+                        END
+                        ELSE
+                        CASE
+                            WHEN t.typelem <> 0::oid AND t.typlen = (-1) THEN 'ARRAY'::text
+                            WHEN nt.nspname = 'pg_catalog'::name THEN format_type(a.atttypid, NULL::integer)
+                            ELSE format_type(a.atttypid, a.atttypmod)
+                        END
+                    END::information_schema.character_data AS data_type,
+                information_schema._pg_char_max_length(information_schema._pg_truetypid(a.*, t.*), information_schema._pg_truetypmod(a.*, t.*))::information_schema.cardinal_number AS character_maximum_length,
+                information_schema._pg_char_octet_length(information_schema._pg_truetypid(a.*, t.*), information_schema._pg_truetypmod(a.*, t.*))::information_schema.cardinal_number AS character_octet_length,
+                information_schema._pg_numeric_precision(information_schema._pg_truetypid(a.*, t.*), information_schema._pg_truetypmod(a.*, t.*))::information_schema.cardinal_number AS numeric_precision,
+                information_schema._pg_numeric_precision_radix(information_schema._pg_truetypid(a.*, t.*), information_schema._pg_truetypmod(a.*, t.*))::information_schema.cardinal_number AS numeric_precision_radix,
+                information_schema._pg_numeric_scale(information_schema._pg_truetypid(a.*, t.*), information_schema._pg_truetypmod(a.*, t.*))::information_schema.cardinal_number AS numeric_scale,
+                information_schema._pg_datetime_precision(information_schema._pg_truetypid(a.*, t.*), information_schema._pg_truetypmod(a.*, t.*))::information_schema.cardinal_number AS datetime_precision,
+                information_schema._pg_interval_type(information_schema._pg_truetypid(a.*, t.*), information_schema._pg_truetypmod(a.*, t.*))::information_schema.character_data AS interval_type,
+                NULL::integer::information_schema.cardinal_number AS interval_precision,
+                NULL::character varying::information_schema.sql_identifier AS character_set_catalog,
+                NULL::character varying::information_schema.sql_identifier AS character_set_schema,
+                NULL::character varying::information_schema.sql_identifier AS character_set_name,
+                    CASE
+                        WHEN nco.nspname IS NOT NULL THEN current_database()
+                        ELSE NULL::name
+                    END::information_schema.sql_identifier AS collation_catalog,
+                nco.nspname::information_schema.sql_identifier AS collation_schema,
+                co.collname::information_schema.sql_identifier AS collation_name,
+                    CASE
+                        WHEN t.typtype = 'd'::"char" THEN current_database()
+                        ELSE NULL::name
+                    END::information_schema.sql_identifier AS domain_catalog,
+                    CASE
+                        WHEN t.typtype = 'd'::"char" THEN nt.nspname
+                        ELSE NULL::name
+                    END::information_schema.sql_identifier AS domain_schema,
+                    CASE
+                        WHEN t.typtype = 'd'::"char" THEN t.typname
+                        ELSE NULL::name
+                    END::information_schema.sql_identifier AS domain_name,
+                current_database()::information_schema.sql_identifier AS udt_catalog,
+                COALESCE(nbt.nspname, nt.nspname)::information_schema.sql_identifier AS udt_schema,
+                COALESCE(bt.typname, t.typname)::information_schema.sql_identifier AS udt_name,
+                NULL::character varying::information_schema.sql_identifier AS scope_catalog,
+                NULL::character varying::information_schema.sql_identifier AS scope_schema,
+                NULL::character varying::information_schema.sql_identifier AS scope_name,
+                NULL::integer::information_schema.cardinal_number AS maximum_cardinality,
+                a.attnum::information_schema.sql_identifier AS dtd_identifier,
+                'NO'::character varying::information_schema.yes_or_no AS is_self_referencing,
+                'NO'::character varying::information_schema.yes_or_no AS is_identity,
+                NULL::character varying::information_schema.character_data AS identity_generation,
+                NULL::character varying::information_schema.character_data AS identity_start,
+                NULL::character varying::information_schema.character_data AS identity_increment,
+                NULL::character varying::information_schema.character_data AS identity_maximum,
+                NULL::character varying::information_schema.character_data AS identity_minimum,
+                NULL::character varying::information_schema.yes_or_no AS identity_cycle,
+                'NEVER'::character varying::information_schema.character_data AS is_generated,
+                NULL::character varying::information_schema.character_data AS generation_expression,
+                CASE
+                    WHEN c.relkind = 'r'::"char" OR (c.relkind = ANY (ARRAY['v'::"char", 'f'::"char"])) AND pg_column_is_updatable(c.oid::regclass, a.attnum, false) THEN 'YES'::text
+                    ELSE 'NO'::text
+                END::information_schema.yes_or_no AS is_updatable
+            FROM pg_attribute a
+               LEFT JOIN pg_attrdef ad ON a.attrelid = ad.adrelid AND a.attnum = ad.adnum
+               JOIN (pg_class c
+               JOIN pg_namespace nc ON c.relnamespace = nc.oid) ON a.attrelid = c.oid
+               JOIN (pg_type t
+               JOIN pg_namespace nt ON t.typnamespace = nt.oid) ON a.atttypid = t.oid
+               LEFT JOIN (pg_type bt
+               JOIN pg_namespace nbt ON bt.typnamespace = nbt.oid) ON t.typtype = 'd'::"char" AND t.typbasetype = bt.oid
+               LEFT JOIN (pg_collation co
+               JOIN pg_namespace nco ON co.collnamespace = nco.oid) ON a.attcollation = co.oid AND (nco.nspname <> 'pg_catalog'::name OR co.collname <> 'default'::name)
+            WHERE NOT pg_is_other_temp_schema(nc.oid) AND a.attnum > 0 AND NOT a.attisdropped AND (c.relkind = ANY (ARRAY['r'::"char", 'v'::"char", 'f'::"char"]))
+              /*--AND (pg_has_role(c.relowner, 'USAGE'::text) OR has_column_privilege(c.oid, a.attnum, 'SELECT, INSERT, UPDATE, REFERENCES'::text))*/
+        )
+        SELECT
+            table_schema,
+            table_name,
+            column_name,
+            ordinal_position,
+            is_nullable,
+            data_type,
+            is_updatable,
+            character_maximum_length,
+            numeric_precision,
+            column_default,
+            udt_name
+        /*-- FROM information_schema.columns*/
+        FROM columns
+        WHERE table_schema NOT IN ('pg_catalog', 'information_schema')
+    ) AS info
+    LEFT OUTER JOIN (
+        SELECT
+            n.nspname AS s,
+            t.typname AS n,
+            array_agg(e.enumlabel ORDER BY e.enumsortorder) AS vals
+        FROM pg_type t
+        JOIN pg_enum e ON t.oid = e.enumtypid
+        JOIN pg_catalog.pg_namespace n ON n.oid = t.typnamespace
+        GROUP BY s,n
+    ) AS enum_info ON (info.udt_name = enum_info.n)
+    ORDER BY schema, position |]
+
+columnFromRow :: [Table] ->
+                 (Text,       Text,        Text,
+                  Int32,      Bool,        Text,
+                  Bool,       Maybe Int32, Maybe Int32,
+                  Maybe Text, Maybe Text)
+                 -> Maybe Column
+columnFromRow tabs (s, t, n, pos, nul, typ, u, l, p, d, e) = buildColumn <$> table
+  where
+    buildColumn tbl = Column tbl n pos nul typ u l p d (parseEnum e) Nothing
+    table = find (\tbl -> tableSchema tbl == s && tableName tbl == t) tabs
+    parseEnum :: Maybe Text -> [Text]
+    parseEnum str = fromMaybe [] $ split (==',') <$> str
+
+allRelations :: [Table] -> [Column] -> H.Query () [Relation]
+allRelations tabs cols =
+  H.statement sql HE.unit (decodeRelations tabs cols) True
+ where
+  sql = [q|
+    SELECT ns1.nspname AS table_schema,
+           tab.relname AS table_name,
+           column_info.cols AS columns,
+           ns2.nspname AS foreign_table_schema,
+           other.relname AS foreign_table_name,
+           column_info.refs AS foreign_columns
+    FROM pg_constraint,
+       LATERAL (SELECT array_agg(cols.attname) AS cols,
+                       array_agg(cols.attnum)  AS nums,
+                       array_agg(refs.attname) AS refs
+                  FROM ( SELECT unnest(conkey) AS col, unnest(confkey) AS ref) k,
+                       LATERAL (SELECT * FROM pg_attribute
+                                 WHERE attrelid = conrelid AND attnum = col)
+                            AS cols,
+                       LATERAL (SELECT * FROM pg_attribute
+                                 WHERE attrelid = confrelid AND attnum = ref)
+                            AS refs)
+            AS column_info,
+       LATERAL (SELECT * FROM pg_namespace WHERE pg_namespace.oid = connamespace) AS ns1,
+       LATERAL (SELECT * FROM pg_class WHERE pg_class.oid = conrelid) AS tab,
+       LATERAL (SELECT * FROM pg_class WHERE pg_class.oid = confrelid) AS other,
+       LATERAL (SELECT * FROM pg_namespace WHERE pg_namespace.oid = other.relnamespace) AS ns2
+    WHERE confrelid != 0
+    ORDER BY (conrelid, column_info.nums) |]
+
+relationFromRow :: [Table] -> [Column] -> (Text, Text, [Text], Text, Text, [Text]) -> Maybe Relation
+relationFromRow allTabs allCols (rs, rt, rcs, frs, frt, frcs) =
+  Relation <$> table <*> cols <*> tableF <*> colsF <*> pure Child <*> pure Nothing <*> pure Nothing <*> pure Nothing
+  where
+    findTable s t = find (\tbl -> tableSchema tbl == s && tableName tbl == t) allTabs
+    findCol s t c = find (\col -> tableSchema (colTable col) == s && tableName (colTable col) == t && colName col == c) allCols
+    table  = findTable rs rt
+    tableF = findTable frs frt
+    cols  = mapM (findCol rs rt) rcs
+    colsF = mapM (findCol frs frt) frcs
+
+allPrimaryKeys :: [Table] -> H.Query () [PrimaryKey]
+allPrimaryKeys tabs =
+  H.statement sql HE.unit (decodePks tabs) True
+ where
+  sql = [q|
+    /*
+    -- CTE to replace information_schema.table_constraints to remove owner limit
+    */
+    WITH tc AS (
+        SELECT current_database()::information_schema.sql_identifier AS constraint_catalog,
+            nc.nspname::information_schema.sql_identifier AS constraint_schema,
+            c.conname::information_schema.sql_identifier AS constraint_name,
+            current_database()::information_schema.sql_identifier AS table_catalog,
+            nr.nspname::information_schema.sql_identifier AS table_schema,
+            r.relname::information_schema.sql_identifier AS table_name,
+                CASE c.contype
+                    WHEN 'c'::"char" THEN 'CHECK'::text
+                    WHEN 'f'::"char" THEN 'FOREIGN KEY'::text
+                    WHEN 'p'::"char" THEN 'PRIMARY KEY'::text
+                    WHEN 'u'::"char" THEN 'UNIQUE'::text
+                    ELSE NULL::text
+                END::information_schema.character_data AS constraint_type,
+                CASE
+                    WHEN c.condeferrable THEN 'YES'::text
+                    ELSE 'NO'::text
+                END::information_schema.yes_or_no AS is_deferrable,
+                CASE
+                    WHEN c.condeferred THEN 'YES'::text
+                    ELSE 'NO'::text
+                END::information_schema.yes_or_no AS initially_deferred
+        FROM pg_namespace nc,
+            pg_namespace nr,
+            pg_constraint c,
+            pg_class r
+        WHERE nc.oid = c.connamespace AND nr.oid = r.relnamespace AND c.conrelid = r.oid AND (c.contype <> ALL (ARRAY['t'::"char", 'x'::"char"])) AND r.relkind = 'r'::"char" AND NOT pg_is_other_temp_schema(nr.oid)
+        /*--AND (pg_has_role(r.relowner, 'USAGE'::text) OR has_table_privilege(r.oid, 'INSERT, UPDATE, DELETE, TRUNCATE, REFERENCES, TRIGGER'::text) OR has_any_column_privilege(r.oid, 'INSERT, UPDATE, REFERENCES'::text))*/
+        UNION ALL
+        SELECT current_database()::information_schema.sql_identifier AS constraint_catalog,
+            nr.nspname::information_schema.sql_identifier AS constraint_schema,
+            (((((nr.oid::text || '_'::text) || r.oid::text) || '_'::text) || a.attnum::text) || '_not_null'::text)::information_schema.sql_identifier AS constraint_name,
+            current_database()::information_schema.sql_identifier AS table_catalog,
+            nr.nspname::information_schema.sql_identifier AS table_schema,
+            r.relname::information_schema.sql_identifier AS table_name,
+            'CHECK'::character varying::information_schema.character_data AS constraint_type,
+            'NO'::character varying::information_schema.yes_or_no AS is_deferrable,
+            'NO'::character varying::information_schema.yes_or_no AS initially_deferred
+        FROM pg_namespace nr,
+            pg_class r,
+            pg_attribute a
+        WHERE nr.oid = r.relnamespace AND r.oid = a.attrelid AND a.attnotnull AND a.attnum > 0 AND NOT a.attisdropped AND r.relkind = 'r'::"char" AND NOT pg_is_other_temp_schema(nr.oid)
+        /*--AND (pg_has_role(r.relowner, 'USAGE'::text) OR has_table_privilege(r.oid, 'INSERT, UPDATE, DELETE, TRUNCATE, REFERENCES, TRIGGER'::text) OR has_any_column_privilege(r.oid, 'INSERT, UPDATE, REFERENCES'::text))*/
+    ),
+    /*
+    -- CTE to replace information_schema.key_column_usage to remove owner limit
+    */
+    kc AS (
+        SELECT current_database()::information_schema.sql_identifier AS constraint_catalog,
+            ss.nc_nspname::information_schema.sql_identifier AS constraint_schema,
+            ss.conname::information_schema.sql_identifier AS constraint_name,
+            current_database()::information_schema.sql_identifier AS table_catalog,
+            ss.nr_nspname::information_schema.sql_identifier AS table_schema,
+            ss.relname::information_schema.sql_identifier AS table_name,
+            a.attname::information_schema.sql_identifier AS column_name,
+            (ss.x).n::information_schema.cardinal_number AS ordinal_position,
+                CASE
+                    WHEN ss.contype = 'f'::"char" THEN information_schema._pg_index_position(ss.conindid, ss.confkey[(ss.x).n])
+                    ELSE NULL::integer
+                END::information_schema.cardinal_number AS position_in_unique_constraint
+        FROM pg_attribute a,
+            ( SELECT r.oid AS roid,
+                r.relname,
+                r.relowner,
+                nc.nspname AS nc_nspname,
+                nr.nspname AS nr_nspname,
+                c.oid AS coid,
+                c.conname,
+                c.contype,
+                c.conindid,
+                c.confkey,
+                c.confrelid,
+                information_schema._pg_expandarray(c.conkey) AS x
+               FROM pg_namespace nr,
+                pg_class r,
+                pg_namespace nc,
+                pg_constraint c
+              WHERE nr.oid = r.relnamespace AND r.oid = c.conrelid AND nc.oid = c.connamespace AND (c.contype = ANY (ARRAY['p'::"char", 'u'::"char", 'f'::"char"])) AND r.relkind = 'r'::"char" AND NOT pg_is_other_temp_schema(nr.oid)) ss
+        WHERE ss.roid = a.attrelid AND a.attnum = (ss.x).x AND NOT a.attisdropped
+        /*--AND (pg_has_role(ss.relowner, 'USAGE'::text) OR has_column_privilege(ss.roid, a.attnum, 'SELECT, INSERT, UPDATE, REFERENCES'::text))*/
+    )
+    SELECT
+        kc.table_schema,
+        kc.table_name,
+        kc.column_name
+    FROM
+        /*
+        --information_schema.table_constraints tc,
+        --information_schema.key_column_usage kc
+        */
+        tc, kc
+    WHERE
+        tc.constraint_type = 'PRIMARY KEY' AND
+        kc.table_name = tc.table_name AND
+        kc.table_schema = tc.table_schema AND
+        kc.constraint_name = tc.constraint_name AND
+        kc.table_schema NOT IN ('pg_catalog', 'information_schema') |]
+
+pkFromRow :: [Table] -> (Schema, Text, Text) -> Maybe PrimaryKey
+pkFromRow tabs (s, t, n) = PrimaryKey <$> table <*> pure n
+  where table = find (\tbl -> tableSchema tbl == s && tableName tbl == t) tabs
+
+allSynonyms :: [Column] -> H.Query () [(Column,Column)]
+allSynonyms cols =
+  H.statement sql HE.unit (decodeSynonyms cols) True
+ where
+  -- query explanation at https://gist.github.com/ruslantalpa/2eab8c930a65e8043d8f
+  sql = [q|
+    with view_columns as (
+        select
+            c.oid as view_oid,
+            a.attname::information_schema.sql_identifier as column_name
+        from pg_attribute a
+        join pg_class c on a.attrelid = c.oid
+        join pg_namespace nc on c.relnamespace = nc.oid
+        where
+            not pg_is_other_temp_schema(nc.oid)
+            and a.attnum > 0
+            and not a.attisdropped
+            and (c.relkind = 'v'::"char")
+            and nc.nspname not in ('information_schema', 'pg_catalog')
+    ),
+    view_column_usage as (
+        select distinct
+            v.oid as view_oid,
+            nv.nspname::information_schema.sql_identifier as view_schema,
+            v.relname::information_schema.sql_identifier as view_name,
+            nt.nspname::information_schema.sql_identifier as table_schema,
+            t.relname::information_schema.sql_identifier as table_name,
+            a.attname::information_schema.sql_identifier as column_name,
+            pg_get_viewdef(v.oid)::information_schema.character_data as view_definition
+        from pg_namespace nv
+        join pg_class v on nv.oid = v.relnamespace
+        join pg_depend dv on v.oid = dv.refobjid
+        join pg_depend dt on dv.objid = dt.objid
+        join pg_class t on dt.refobjid = t.oid
+        join pg_namespace nt on t.relnamespace = nt.oid
+        join pg_attribute a on t.oid = a.attrelid and dt.refobjsubid = a.attnum
+
+        where
+            nv.nspname not in ('information_schema', 'pg_catalog')
+            and v.relkind = 'v'::"char"
+            and dv.refclassid = 'pg_class'::regclass::oid
+            and dv.classid = 'pg_rewrite'::regclass::oid
+            and dv.deptype = 'i'::"char"
+            and dv.refobjid <> dt.refobjid
+            and dt.classid = 'pg_rewrite'::regclass::oid
+            and dt.refclassid = 'pg_class'::regclass::oid
+            and (t.relkind = any (array['r'::"char", 'v'::"char", 'f'::"char"]))
+    ),
+    candidates as (
+        select
+            vcu.*,
+            (
+                select case when match is not null then coalesce(match[8], match[7], match[4]) end
+                from regexp_matches(
+                    CONCAT('SELECT ', SPLIT_PART(vcu.view_definition, 'SELECT', 2)),
+                    CONCAT('SELECT.*?((',vcu.table_name,')|(\w+))\.(', vcu.column_name, ')(\s+AS\s+("([^"]+)"|([^, \n\t]+)))?.*?FROM.*?',vcu.table_schema,'\.(\2|',vcu.table_name,'\s+(as\s)?\3)'),
+                    'nsi'
+                ) match
+            ) as view_column_name
+        from view_column_usage as vcu
+    )
+    select
+        c.table_schema,
+        c.table_name,
+        c.column_name as table_column_name,
+        c.view_schema,
+        c.view_name,
+        c.view_column_name
+    from view_columns as vc, candidates as c
+    where
+        vc.view_oid = c.view_oid
+        and vc.column_name = c.view_column_name
+    order by c.view_schema, c.view_name, c.table_name, c.view_column_name
+    |]
+
+synonymFromRow :: [Column] -> (Text,Text,Text,Text,Text,Text) -> Maybe (Column,Column)
+synonymFromRow allCols (s1,t1,c1,s2,t2,c2) = (,) <$> col1 <*> col2
+  where
+    col1 = findCol s1 t1 c1
+    col2 = findCol s2 t2 c2
+    findCol s t c = find (\col -> (tableSchema . colTable) col == s && (tableName . colTable) col == t && colName col == c) allCols
@@ -0,0 +1,135 @@
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+{-# LANGUAGE FlexibleInstances    #-}
+{-# LANGUAGE TypeSynonymInstances #-}
+
+module PostgREST.Error (apiRequestErrResponse, pgErrResponse, errResponse, prettyUsageError, singularityError, formatGeneralError, formatParserError) where
+
+import           Protolude
+import           Data.Aeson                ((.=))
+import qualified Data.Aeson                as JSON
+import           Data.Text                 (replace, strip, unwords)
+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)
+import           PostgREST.ApiRequest      (toHeader, toMime, ContentType(..), ApiRequestError(..))
+import           Text.Parsec.Error
+
+apiRequestErrResponse :: ApiRequestError -> Response
+apiRequestErrResponse err =
+  case err of
+    ErrorActionInappropriate -> errResponse HT.status405 "Bad Request"
+    ErrorInvalidBody errorMessage -> errResponse HT.status400 $ toS errorMessage
+    ErrorInvalidRange -> errResponse HT.status416 "HTTP Range error"
+
+errResponse :: HT.Status -> Text -> Response
+errResponse status message = jsonErrResponse status $ JSON.object ["message" .= message]
+
+jsonErrResponse :: HT.Status -> JSON.Value -> Response
+jsonErrResponse status message = responseLBS status [toHeader CTApplicationJSON] $ JSON.encode message
+
+pgErrResponse :: Bool -> P.UsageError -> Response
+pgErrResponse authed e =
+  let status = httpStatus authed e
+      jsonType = toHeader CTApplicationJSON
+      wwwAuth = ("WWW-Authenticate", "Bearer")
+      hdrs = if status == HT.status401
+                then [jsonType, wwwAuth]
+                else [jsonType] in
+  responseLBS status hdrs (JSON.encode e)
+
+prettyUsageError :: P.UsageError -> Text
+prettyUsageError (P.ConnectionError e) =
+  "Database connection error:\n" <> toS (fromMaybe "" e)
+prettyUsageError e = show $ JSON.encode e
+
+singularityError :: Integer -> Response
+singularityError numRows =
+  responseLBS HT.status406
+    [toHeader CTSingularJSON]
+    $ toS . formatGeneralError
+      "JSON object requested, multiple (or no) rows returned"
+      $ unwords
+        [ "Results contain", show numRows, "rows,"
+        , toS (toMime CTSingularJSON), "requires 1 row"
+        ]
+
+formatParserError :: ParseError -> Text
+formatParserError e = formatGeneralError message details
+  where
+     message = show $ errorPos e
+     details = strip $ replace "\n" " " $ toS
+       $ showErrorMessages "or" "unknown parse error" "expecting" "unexpected" "end of input" (errorMessages e)
+
+formatGeneralError :: Text -> Text -> Text
+formatGeneralError message details = toS . JSON.encode $
+  JSON.object ["message" .= message, "details" .= details]
+
+instance JSON.ToJSON P.UsageError where
+  toJSON (P.ConnectionError e) = JSON.object [
+    "code" .= ("" :: Text),
+    "message" .= ("Connection error" :: Text),
+    "details" .= (toS $ fromMaybe "" e :: Text)]
+  toJSON (P.SessionError e) = JSON.toJSON e -- H.Error
+
+instance JSON.ToJSON H.Error where
+  toJSON (H.ResultError (H.ServerError c m d h)) = JSON.object [
+    "code" .= (toS c::Text),
+    "message" .= (toS m::Text),
+    "details" .= (fmap toS d::Maybe Text),
+    "hint" .= (fmap toS h::Maybe Text)]
+  toJSON (H.ResultError (H.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),
+    "details" .= (("Row number " <> show i)::Text)]
+  toJSON (H.ResultError (H.RowError i H.UnexpectedNull)) = JSON.object [
+    "message" .= ("Row error: unexpected null"::Text),
+    "details" .= ("Attempt to parse a NULL as some value."::Text),
+    "details" .= (("Row number " <> show i)::Text)]
+  toJSON (H.ResultError (H.RowError i (H.ValueError d))) = JSON.object [
+    "message" .= ("Row error: Wrong value parser used"::Text),
+    "details" .= d,
+    "details" .= (("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)]
+
+httpStatus :: Bool -> P.UsageError -> HT.Status
+httpStatus _ (P.ConnectionError _) = HT.status500
+httpStatus authed (P.SessionError (H.ResultError (H.ServerError c _ _ _))) =
+  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
+    _         -> HT.status400
+httpStatus _ (P.SessionError (H.ResultError _)) = HT.status500
+httpStatus _ (P.SessionError (H.ClientError _)) = HT.status503
@@ -0,0 +1,55 @@
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
+module PostgREST.Middleware where
+
+import           Data.Aeson                    (Value (..))
+import qualified Data.HashMap.Strict           as M
+import qualified Hasql.Transaction             as H
+
+import           Network.HTTP.Types.Status     (unauthorized401, status500)
+import           Network.Wai                   (Application, Response,
+                                                responseLBS)
+import           Network.Wai.Middleware.Cors   (cors)
+import           Network.Wai.Middleware.Gzip   (def, gzip)
+import           Network.Wai.Middleware.Static (only, staticPolicy)
+
+import           PostgREST.ApiRequest          (ApiRequest(..), ContentType(..),
+                                                toHeader)
+import           PostgREST.Auth                (claimsToSQL, JWTAttempt(..))
+import           PostgREST.Config              (AppConfig (..), corsPolicy)
+import           PostgREST.Error               (errResponse)
+
+import           Protolude                     hiding (concat, null)
+
+runWithClaims :: AppConfig -> JWTAttempt ->
+                 (ApiRequest -> H.Transaction Response) ->
+                 ApiRequest -> H.Transaction Response
+runWithClaims conf eClaims app req =
+  case eClaims of
+    JWTExpired -> return $ unauthed "JWT expired"
+    JWTInvalid -> return $ unauthed "JWT invalid"
+    JWTMissingSecret -> return $ errResponse status500 "Server lacks JWT secret"
+    JWTClaims claims -> do
+      -- role claim defaults to anon if not specified in jwt
+      let setClaims = claimsToSQL (M.union claims (M.singleton "role" anon))
+      H.sql $ mconcat setClaims
+      mapM_ H.sql customReqCheck
+      app req
+  where
+    anon = String . toS $ configAnonRole conf
+    customReqCheck = (\f -> "select " <> toS f <> "();") <$> configReqCheck conf
+    unauthed message = responseLBS unauthorized401
+      [ toHeader CTApplicationJSON
+      , ( "WWW-Authenticate"
+        , "Bearer error=\"invalid_token\", " <>
+          "error_description=\"" <> message <> "\""
+        )
+      ]
+      (toS $ "{\"message\":\""<>message<>"\"}")
+
+defaultMiddle :: Application -> Application
+defaultMiddle =
+    gzip def
+  . cors corsPolicy
+  . staticPolicy (only [("favicon.ico", "static/favicon.ico")])
@@ -0,0 +1,357 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module PostgREST.OpenAPI (
+  encodeOpenAPI
+  , isMalformedProxyUri
+  , pickProxy
+  ) where
+
+import           Control.Lens
+import           Data.Aeson                  (decode, encode)
+import           Data.HashMap.Strict.InsOrd  (InsOrdHashMap, fromList)
+import           Data.Maybe                  (fromJust)
+import           Data.String                 (IsString (..))
+import           Data.Text                   (unpack, pack, concat, intercalate, init, tail, toLower)
+import qualified Data.Set                    as Set
+import           Network.URI                 (parseURI, isAbsoluteURI,
+                                              URI (..), URIAuth (..))
+
+import           Protolude hiding              (concat, (&), Proxy, get, intercalate)
+
+import           Data.Swagger
+
+import           PostgREST.ApiRequest        (ContentType(..), toMime)
+import           PostgREST.Config            (prettyVersion)
+import           PostgREST.QueryBuilder      (operators)
+import           PostgREST.Types             (Table(..), Column(..), PgArg(..),
+                                              Proxy(..), ProcDescription(..))
+
+makeMimeList :: [ContentType] -> MimeList
+makeMimeList cs = MimeList $ map (fromString . toS . toMime) cs
+
+toSwaggerType :: Text -> SwaggerType t
+toSwaggerType "text"      = SwaggerString
+toSwaggerType "integer"   = SwaggerInteger
+toSwaggerType "boolean"   = SwaggerBoolean
+toSwaggerType "numeric"   = SwaggerNumber
+toSwaggerType _           = SwaggerString
+
+makeTableDef :: (Table, [Column], [Text]) -> (Text, Schema)
+makeTableDef (t, cs, _) =
+  let tn = tableName t in
+      (tn, (mempty :: Schema)
+        & type_ .~ SwaggerObject
+        & properties .~ fromList (map makeProperty cs))
+
+makeProperty :: Column -> (Text, Referenced Schema)
+makeProperty c = (colName c, Inline u)
+  where
+    r = mempty :: Schema
+    s = if null $ colEnum c
+           then r
+           else r & enum_ .~ decode (encode (colEnum c))
+    t = s & type_ .~ toSwaggerType (colType c)
+    u = t & format ?~ colType c
+
+makeProcDef :: ProcDescription -> (Text, Schema)
+makeProcDef pd = ("(rpc) " <> pdName pd, s)
+  where
+    s = (mempty :: Schema)
+          & type_ .~ SwaggerObject
+          & properties .~ fromList (map makeProcProperty (pdArgs pd))
+          & required .~ map pgaName (filter pgaReq (pdArgs pd))
+
+makeProcProperty :: PgArg -> (Text, Referenced Schema)
+makeProcProperty (PgArg n t _) = (n, Inline s)
+  where
+    s = (mempty :: Schema)
+          & type_ .~ toSwaggerType t
+          & format ?~ t
+
+makeOperatorPattern :: Text
+makeOperatorPattern =
+  intercalate "|"
+  [ concat ["^", x, y, "[.]"] |
+    x <- ["not[.]", ""],
+    y <- map fst operators ]
+
+makeRowFilter :: Column -> Param
+makeRowFilter c =
+  (mempty :: Param)
+  & name .~ colName c
+  & required ?~ False
+  & schema .~ ParamOther ((mempty :: ParamOtherSchema)
+    & in_ .~ ParamQuery
+    & type_ .~ SwaggerString
+    & format ?~ colType c
+    & pattern ?~ makeOperatorPattern)
+
+makeRowFilters :: [Column] -> [Param]
+makeRowFilters = map makeRowFilter
+
+makeOrderItems :: [Column] -> [Text]
+makeOrderItems cs =
+  [ concat [x, y, z] |
+    x <- map colName cs,
+    y <- [".asc", ".desc", ""],
+    z <- [".nullsfirst", ".nulllast", ""]
+  ]
+
+makeRangeParams :: [Param]
+makeRangeParams =
+  [ (mempty :: Param)
+    & name        .~ "Range"
+    & description ?~ "Limiting and Pagination"
+    & required    ?~ False
+    & schema .~ ParamOther ((mempty :: ParamOtherSchema)
+      & in_ .~ ParamHeader
+      & type_ .~ SwaggerString)
+  , (mempty :: Param)
+    & name        .~ "Range-Unit"
+    & description ?~ "Limiting and Pagination"
+    & required    ?~ False
+    & schema .~ ParamOther ((mempty :: ParamOtherSchema)
+      & in_ .~ ParamHeader
+      & type_ .~ SwaggerString
+      & default_ .~ decode "\"items\"")
+  , (mempty :: Param)
+    & name        .~ "offset"
+    & description ?~ "Limiting and Pagination"
+    & required    ?~ False
+    & schema .~ ParamOther ((mempty :: ParamOtherSchema)
+      & in_ .~ ParamQuery
+      & type_ .~ SwaggerString)
+  , (mempty :: Param)
+    & name        .~ "limit"
+    & description ?~ "Limiting and Pagination"
+    & required    ?~ False
+    & schema .~ ParamOther ((mempty :: ParamOtherSchema)
+      & in_ .~ ParamQuery
+      & type_ .~ SwaggerString)
+  ]
+
+makePreferParam :: [Text] -> Param
+makePreferParam ts =
+  (mempty :: Param)
+  & name        .~ "Prefer"
+  & description ?~ "Preference"
+  & required    ?~ False
+  & schema .~ ParamOther ((mempty :: ParamOtherSchema)
+    & in_ .~ ParamHeader
+    & type_ .~ SwaggerString
+    & enum_ .~ decode (encode ts))
+
+makeSelectParam :: Param
+makeSelectParam =
+  (mempty :: Param)
+    & name        .~ "select"
+    & description ?~ "Filtering Columns"
+    & required    ?~ False
+    & schema .~ ParamOther ((mempty :: ParamOtherSchema)
+      & in_ .~ ParamQuery
+      & type_ .~ SwaggerString)
+
+makeGetParams :: [Column] -> [Param]
+makeGetParams [] =
+  makeRangeParams ++
+  [ makeSelectParam
+  , makePreferParam ["count=none"]
+  ]
+makeGetParams cs =
+  makeRangeParams ++
+  [ makeSelectParam
+  , (mempty :: Param)
+    & name        .~ "order"
+    & description ?~ "Ordering"
+    & required    ?~ False
+    & schema .~ ParamOther ((mempty :: ParamOtherSchema)
+      & in_ .~ ParamQuery
+      & type_ .~ SwaggerString
+      & enum_ .~ decode (encode $ makeOrderItems cs))
+  , makePreferParam ["count=none"]
+  ]
+
+makePostParams :: Text -> [Param]
+makePostParams tn =
+  [ makePreferParam ["return=representation",
+                     "return=minimal", "return=none"]
+  , (mempty :: Param)
+    & name        .~ "body"
+    & description ?~ tn
+    & required    ?~ False
+    & schema .~ ParamBody (Ref (Reference tn))
+  ]
+
+makeProcParam :: Text -> [Param]
+makeProcParam refName =
+  [ makePreferParam ["params=single-object"]
+  , (mempty :: Param)
+    & name     .~ "args"
+    & required ?~ True
+    & schema   .~ ParamBody (Ref (Reference refName))
+  ]
+
+makeDeleteParams :: [Param]
+makeDeleteParams =
+  [ makePreferParam ["return=representation", "return=minimal", "return=none"] ]
+
+makePathItem :: (Table, [Column], [Text]) -> (FilePath, PathItem)
+makePathItem (t, cs, _) = ("/" ++ unpack tn, p $ tableInsertable t)
+  where
+    tOp = (mempty :: Operation)
+      & tags .~ Set.fromList [tn]
+      & produces ?~ makeMimeList [CTApplicationJSON, CTSingularJSON, CTTextCSV]
+      & at 200 ?~ "OK"
+    getOp = tOp
+      & parameters .~ map Inline (makeGetParams cs ++ rs)
+      & at 206 ?~ "Partial Content"
+    postOp = tOp
+      & consumes ?~ makeMimeList [CTApplicationJSON, CTSingularJSON, CTTextCSV]
+      & parameters .~ map Inline (makePostParams tn)
+      & at 201 ?~ "Created"
+    patchOp = tOp
+      & consumes ?~ makeMimeList [CTApplicationJSON, CTSingularJSON, CTTextCSV]
+      & parameters .~ map Inline (makePostParams tn ++ rs)
+      & at 204 ?~ "No Content"
+    deletOp = tOp
+      & parameters .~ map Inline (makeDeleteParams ++ rs)
+    pr = (mempty :: PathItem) & get ?~ getOp
+    pw = pr & post ?~ postOp & patch ?~ patchOp & delete ?~ deletOp
+    p False = pr
+    p True  = pw
+    rs = makeRowFilters cs
+    tn = tableName t
+
+makeProcPathItem :: ProcDescription -> (FilePath, PathItem)
+makeProcPathItem pd = ("/rpc/" ++ toS (pdName pd), pe)
+  where
+    postOp = (mempty :: Operation)
+      & parameters .~ map Inline (makeProcParam $ "(rpc) " <> pdName 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 ["/"]
+      & produces ?~ makeMimeList [CTOpenAPI]
+      & 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) -> Swagger
+postgrestSpec pds ti (s, h, p, b) = (mempty :: Swagger)
+  & basePath ?~ unpack b
+  & schemes ?~ [s']
+  & info .~ ((mempty :: Info)
+      & version .~ prettyVersion
+      & title .~ "PostgREST API"
+      & description ?~ "This is a dynamic API generated by PostgREST")
+  & host .~ h'
+  & definitions .~ fromList (map makeTableDef ti <> map makeProcDef pds)
+  & paths .~ makePathItems pds ti
+    where
+      s' = if s == "http" then Http else Https
+      h' = Just $ Host (unpack $ escapeHostName h) (Just (fromInteger p))
+
+encodeOpenAPI :: [ProcDescription] -> [(Table, [Column], [Text])] -> (Text, Text, Integer, Text) -> LByteString
+encodeOpenAPI pds ti uri = encode $ postgrestSpec pds ti uri
+
+{-|
+  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
@@ -0,0 +1,154 @@
+module PostgREST.Parsers where
+
+import           Protolude                     hiding (try, intercalate)
+import           Control.Monad                ((>>))
+import           Data.Text                     (intercalate)
+import           Data.List                     (init, last)
+import           Data.Tree
+import           PostgREST.QueryBuilder        (operators)
+import           PostgREST.Types
+import           Text.ParserCombinators.Parsec hiding (many, (<|>))
+import           PostgREST.RangeQuery      (NonnegRange,allRange)
+
+pRequestSelect :: Text -> Text -> Either ParseError ReadRequest
+pRequestSelect rootName selStr = 
+  parse (pReadRequest rootName) ("failed to parse select parameter (" <> toS selStr <> ")") (toS selStr)
+
+pRequestFilter :: (Text, Text) -> Either ParseError (Path, Filter)
+pRequestFilter (k, v) = (,) <$> path <*> (Filter <$> fld <*> op <*> val)
+  where
+    treePath = parse pTreePath ("failed to parser tree path (" ++ toS k ++ ")") $ toS k
+    opVal = parse pOpValueExp ("failed to parse filter (" ++ toS v ++ ")") $ toS v
+    path = fst <$> treePath
+    fld = snd <$> treePath
+    op = fst <$> opVal
+    val = snd <$> opVal
+
+pRequestOrder :: (Text, Text) -> Either ParseError (Path, [OrderTerm])
+pRequestOrder (k, v) = (,) <$> path <*> ord'
+  where
+    treePath = parse pTreePath ("failed to parser tree path (" ++ toS k ++ ")") $ toS k
+    path = fst <$> treePath
+    ord' = parse pOrder ("failed to parse order (" ++ toS v ++ ")") $ toS v
+
+pRequestRange :: (ByteString, NonnegRange) -> Either ParseError (Path, NonnegRange)
+pRequestRange (k, v) = (,) <$> path <*> pure v
+  where
+    treePath = parse pTreePath ("failed to parser tree path (" ++ toS k ++ ")") $ toS k
+    path = fst <$> treePath
+
+ws :: Parser Text
+ws = toS <$> many (oneOf " \t")
+
+lexeme :: Parser a -> Parser a
+lexeme p = ws *> p <* ws
+
+pReadRequest :: Text -> Parser ReadRequest
+pReadRequest rootNodeName = do
+  fieldTree <- pFieldForest
+  return $ foldr treeEntry (Node (readQuery, (rootNodeName, Nothing, Nothing)) []) fieldTree
+  where
+    readQuery = Select [] [rootNodeName] [] Nothing allRange
+    treeEntry :: Tree SelectItem -> ReadRequest -> ReadRequest
+    treeEntry (Node fld@((fn, _),_,alias) fldForest) (Node (q, i) rForest) =
+      case fldForest of
+        [] -> Node (q {select=fld:select q}, i) rForest
+        _  -> Node (q, i) newForest
+          where
+            newForest =
+              foldr treeEntry (Node (Select [] [fn] [] Nothing allRange, (fn, Nothing, alias)) []) fldForest:rForest
+
+pTreePath :: Parser (Path,Field)
+pTreePath = do
+  p <- pFieldName `sepBy1` pDelimiter
+  jp <- optionMaybe pJsonPath
+  return (init p, (last p, jp))
+
+pFieldForest :: Parser [Tree SelectItem]
+pFieldForest = pFieldTree `sepBy1` lexeme (char ',')
+
+pFieldTree :: Parser (Tree SelectItem)
+pFieldTree = try (Node <$> pSimpleSelect <*> between (char '{') (char '}') pFieldForest)
+          <|>     Node <$> pSelect <*> pure []
+
+pStar :: Parser Text
+pStar = toS <$> (string "*" *> pure ("*"::ByteString))
+
+
+pFieldName :: Parser Text
+pFieldName = do
+  matches <- (many1 (letter <|> digit <|> oneOf "_") `sepBy1` dash) <?> "field name (* or [a..z0..9_])"
+  return $ intercalate "-" $ map toS matches
+  where
+    isDash :: GenParser Char st ()
+    isDash = try ( char '-' >> notFollowedBy (char '>') )
+    dash :: Parser Char
+    dash = isDash *> pure '-'
+
+
+pJsonPathStep :: Parser Text
+pJsonPathStep = toS <$> try (string "->" *> pFieldName)
+
+pJsonPath :: Parser [Text]
+pJsonPath = (<>) <$> many pJsonPathStep <*> ( (:[]) <$> (string "->>" *> pFieldName) )
+
+pField :: Parser Field
+pField = lexeme $ (,) <$> pFieldName <*> optionMaybe pJsonPath
+
+aliasSeparator :: Parser ()
+aliasSeparator = char ':' >> notFollowedBy (char ':')
+
+pSimpleSelect :: Parser SelectItem
+pSimpleSelect = lexeme $ try ( do
+    alias <- optionMaybe ( try(pFieldName <* aliasSeparator) )
+    fld <- pField
+    return (fld, Nothing, alias)
+  )
+
+pSelect :: Parser SelectItem
+pSelect = lexeme $
+  try (
+    do
+      alias <- optionMaybe ( try(pFieldName <* aliasSeparator) )
+      fld <- pField
+      cast' <- optionMaybe (string "::" *> many letter)
+      return (fld, toS <$> cast', alias)
+  )
+  <|> do
+    s <- pStar
+    return ((s, Nothing), Nothing, Nothing)
+
+pOperator :: Parser Operator
+pOperator = toS <$> (pOp <?> "operator (eq, gt, ...)")
+  where pOp = foldl (<|>) empty $ map (try . string . toS . fst) operators
+
+pValue :: Parser FValue
+pValue = VText <$> (toS <$> many anyChar)
+
+pDelimiter :: Parser Char
+pDelimiter = char '.' <?> "delimiter (.)"
+
+pOperatiorWithNegation :: Parser Operator
+pOperatiorWithNegation = try ( (<>) <$> ( toS <$> string "not." ) <*>  pOperator) <|> pOperator
+
+pOpValueExp :: Parser (Operator, FValue)
+pOpValueExp = (,) <$> pOperatiorWithNegation <*> (pDelimiter *> pValue)
+
+pOrder :: Parser [OrderTerm]
+pOrder = lexeme pOrderTerm `sepBy` char ','
+
+pOrderTerm :: Parser OrderTerm
+pOrderTerm =
+  try ( do
+    c <- pField
+    d <- optionMaybe (try $ pDelimiter *> (
+               try(string "asc" *> pure OrderAsc)
+           <|> try(string "desc" *> pure OrderDesc)
+         ))
+    nls <- optionMaybe (pDelimiter *> (
+                 try(string "nullslast" *> pure OrderNullsLast)
+             <|> try(string "nullsfirst" *> pure OrderNullsFirst)
+           ))
+    return $ OrderTerm c d nls
+  )
+  <|> OrderTerm <$> pField <*> pure Nothing <*> pure Nothing
@@ -0,0 +1,483 @@
+{-# LANGUAGE FlexibleInstances    #-}
+{-# LANGUAGE TupleSections        #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+{-|
+Module      : PostgREST.QueryBuilder
+Description : PostgREST SQL 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.
+-}
+module PostgREST.QueryBuilder (
+    callProc
+  , createReadStatement
+  , createWriteStatement
+  , getJoinConditions
+  , operators
+  , pgFmtIdent
+  , pgFmtLit
+  , requestToQuery
+  , requestToCountQuery
+  , sourceCTEName
+  , unquoted
+  , ResultsWithCount
+  ) where
+
+import qualified Hasql.Query             as H
+import qualified Hasql.Encoders          as HE
+import qualified Hasql.Decoders          as HD
+
+import qualified Data.Aeson              as JSON
+
+import           PostgREST.RangeQuery    (NonnegRange, rangeLimit, rangeOffset, allRange)
+import           Data.Functor.Contravariant (contramap)
+import qualified Data.HashMap.Strict     as HM
+import           Data.Text               (intercalate, unwords, replace, isInfixOf, toLower, split)
+import qualified Data.Text as T          (map, takeWhile, null)
+import qualified Data.Text.Encoding as T
+import           Data.Tree               (Tree(..))
+import qualified Data.Vector as V
+import           PostgREST.Types
+import qualified Data.Map as M
+import           Text.InterpolatedString.Perl6 (qc)
+import qualified Data.ByteString.Char8   as BS
+import           Data.Scientific         ( FPFormat (..)
+                                         , formatScientific
+                                         , isInteger
+                                         )
+import           Protolude hiding        (from, intercalate, ord, cast)
+import           PostgREST.ApiRequest    (PreferRepresentation (..))
+
+{-| The generic query result format used by API responses. The location header
+    is represented as a list of strings containing variable bindings like
+    @"k1=eq.42"@, or the empty list if there is no location header.
+-}
+type ResultsWithCount = (Maybe Int64, Int64, [BS.ByteString], BS.ByteString)
+
+standardRow :: HD.Row ResultsWithCount
+standardRow = (,,,) <$> HD.nullableValue HD.int8 <*> HD.value HD.int8
+                    <*> HD.value header <*> HD.value HD.bytea
+  where
+    header = HD.array $ HD.arrayDimension replicateM $ HD.arrayValue HD.bytea
+
+noLocationF :: Text
+noLocationF = "array[]::text[]"
+
+{-| Read and Write api requests use a similar response format which includes
+    various record counts and possible location header. This is the decoder
+    for that common type of query.
+-}
+decodeStandard :: HD.Result ResultsWithCount
+decodeStandard =
+  HD.singleRow standardRow
+
+decodeStandardMay :: HD.Result (Maybe ResultsWithCount)
+decodeStandardMay =
+  HD.maybeRow standardRow
+
+{-| JSON and CSV payloads from the client are given to us as
+    PayloadJSON (objects who all have the same keys),
+    and we turn this into an old fasioned JSON array
+-}
+encodeUniformObjs :: HE.Params PayloadJSON
+encodeUniformObjs =
+  contramap (JSON.Array . V.map JSON.Object . unPayloadJSON) (HE.value HE.json)
+
+createReadStatement :: SqlQuery -> SqlQuery -> Bool -> Bool -> Bool ->
+                       H.Query () ResultsWithCount
+createReadStatement selectQuery countQuery isSingle countTotal asCsv =
+  unicodeStatement sql HE.unit decodeStandard False
+ where
+  sql = [qc|
+      WITH {sourceCTEName} AS ({selectQuery}) SELECT {cols}
+      FROM ( SELECT * FROM {sourceCTEName}) _postgrest_t |]
+  countResultF = if countTotal then "("<>countQuery<>")" else "null"
+  cols = intercalate ", " [
+      countResultF <> " AS total_result_set",
+      "pg_catalog.count(_postgrest_t) AS page_total",
+      noLocationF <> " AS header",
+      bodyF <> " AS body"
+    ]
+  bodyF
+    | asCsv = asCsvF
+    | isSingle = asJsonSingleF
+    | otherwise = asJsonF
+
+createWriteStatement :: SqlQuery -> SqlQuery -> Bool -> Bool -> Bool ->
+                        PreferRepresentation -> [Text] ->
+                        H.Query PayloadJSON (Maybe ResultsWithCount)
+createWriteStatement selectQuery mutateQuery wantSingle wantHdrs asCsv rep pKeys =
+  unicodeStatement sql encodeUniformObjs decodeStandardMay True
+
+ where
+  sql = case rep of
+    None -> [qc|
+      WITH {sourceCTEName} AS ({mutateQuery})
+      SELECT '', 0, {noLocationF}, '' |]
+    HeadersOnly -> [qc|
+      WITH {sourceCTEName} AS ({mutateQuery})
+      SELECT {cols}
+      FROM (SELECT 1 FROM {sourceCTEName}) _postgrest_t |]
+    Full -> [qc|
+      WITH {sourceCTEName} AS ({mutateQuery})
+      SELECT {cols}
+      FROM ({selectQuery}) _postgrest_t |]
+
+  cols = intercalate ", " [
+      "'' AS total_result_set", -- when updateing it does not make sense
+      "pg_catalog.count(_postgrest_t) AS page_total",
+      if wantHdrs
+         then locationF pKeys
+         else noLocationF <> " AS header",
+      if rep == Full
+         then bodyF <> " AS body"
+         else "''"
+    ]
+
+  bodyF
+    | asCsv = asCsvF
+    | wantSingle = asJsonSingleF
+    | otherwise = asJsonF
+
+type ProcResults = (Maybe Int64, Int64, ByteString)
+callProc :: QualifiedIdentifier -> JSON.Object -> SqlQuery -> SqlQuery -> NonnegRange -> Bool -> Bool -> Bool -> H.Query () (Maybe ProcResults)
+callProc qi params selectQuery countQuery _ countTotal isSingle paramsAsJson =
+  unicodeStatement sql HE.unit decodeProc True
+  where
+    sql = [qc|
+            WITH {sourceCTEName} AS ({_callSql})
+            SELECT
+              {countResultF} AS total_result_set,
+              pg_catalog.count(_postgrest_t) AS page_total,
+              case
+                when pg_catalog.count(*) > 1 then
+                  {bodyF}
+                else
+                  coalesce(((array_agg(row_to_json(_postgrest_t)))[1]->{_procName})::character varying, {bodyF})
+
+              end as body
+            FROM ({selectQuery}) _postgrest_t;
+          |]
+          -- FROM (select * from {sourceCTEName} {limitF range}) t;
+    countResultF = if countTotal then "("<>countQuery<>")" else "null::bigint" :: Text
+    _args = if paramsAsJson
+                then insertableValueWithType "json" $ JSON.Object params
+                else intercalate "," $ map _assignment (HM.toList params)
+    _procName = pgFmtLit $ qiName qi
+    _assignment (n,v) = pgFmtIdent n <> ":=" <> insertableValue v
+    _callSql = [qc|select * from {fromQi qi}({_args}) |] :: Text
+    _countExpr = if countTotal
+                   then [qc|(select pg_catalog.count(*) from {sourceCTEName})|]
+                   else "null::bigint" :: Text
+    decodeProc = HD.maybeRow procRow
+    procRow = (,,) <$> HD.nullableValue HD.int8 <*> HD.value HD.int8
+                   <*> HD.value HD.bytea
+    bodyF
+     | isSingle = asJsonSingleF
+     | otherwise = asJsonF
+
+operators :: [(Text, SqlFragment)]
+operators = [
+  ("eq", "="),
+  ("gte", ">="), -- has to be before gt (parsers)
+  ("gt", ">"),
+  ("lte", "<="), -- has to be before lt (parsers)
+  ("lt", "<"),
+  ("neq", "<>"),
+  ("like", "like"),
+  ("ilike", "ilike"),
+  ("in", "in"),
+  ("notin", "not in"),
+  ("isnot", "is not"), -- has to be before is (parsers)
+  ("is", "is"),
+  ("@@", "@@"),
+  ("@>", "@>"),
+  ("<@", "<@")
+  ]
+
+pgFmtIdent :: SqlFragment -> SqlFragment
+pgFmtIdent x = "\"" <> replace "\"" "\"\"" (trimNullChars $ toS x) <> "\""
+
+pgFmtLit :: SqlFragment -> SqlFragment
+pgFmtLit x =
+ let trimmed = trimNullChars x
+     escaped = "'" <> replace "'" "''" trimmed <> "'"
+     slashed = replace "\\" "\\\\" escaped in
+ if "\\" `isInfixOf` escaped
+   then "E" <> slashed
+   else slashed
+
+requestToCountQuery :: Schema -> DbRequest -> SqlQuery
+requestToCountQuery _ (DbMutate _) = undefined
+requestToCountQuery schema (DbRead (Node (Select _ _ conditions _ _, (mainTbl, _, _)) _)) =
+ unwords [
+   "SELECT pg_catalog.count(*)",
+   "FROM ", fromQi qi,
+   ("WHERE " <> intercalate " AND " ( map (pgFmtCondition qi) localConditions )) `emptyOnNull` localConditions
+   ]
+ where
+   qi = if mainTbl == sourceCTEName
+     then QualifiedIdentifier "" mainTbl
+     else QualifiedIdentifier schema mainTbl
+   fn Filter{value=VText _} = True
+   fn Filter{value=VForeignKey _ _} = False
+   localConditions = filter fn conditions
+
+requestToQuery :: Schema -> Bool -> DbRequest -> SqlQuery
+requestToQuery schema isParent (DbRead (Node (Select colSelects tbls conditions ord range, (nodeName, maybeRelation, _)) forest)) =
+  query
+  where
+    -- TODO! the following helper functions are just to remove the "schema" part when the table is "source" which is the name
+    -- of our WITH query part
+    mainTbl = fromMaybe nodeName (tableName . relTable <$> maybeRelation)
+    tblSchema tbl = if tbl == sourceCTEName then "" else schema
+    qi = QualifiedIdentifier (tblSchema mainTbl) mainTbl
+    toQi t = QualifiedIdentifier (tblSchema t) t
+    query = unwords [
+      "SELECT ", intercalate ", " (map (pgFmtSelectItem qi) colSelects ++ selects),
+      "FROM ", intercalate ", " (map (fromQi . toQi) tbls),
+      unwords joins,
+      ("WHERE " <> intercalate " AND " ( map (pgFmtCondition qi ) conditions )) `emptyOnNull` conditions,
+      orderF (fromMaybe [] ord),
+      if isParent then "" else limitF range
+      ]
+    orderF ts =
+        if null ts
+            then ""
+            else "ORDER BY " <> clause
+        where
+            clause = intercalate "," (map queryTerm ts)
+            queryTerm :: OrderTerm -> Text
+            queryTerm t = " "
+                <> toS (pgFmtField qi $ otTerm t) <> " "
+                <> maybe "" show (otDirection t) <> " "
+                <> maybe "" show (otNullOrder t) <> " "
+    (joins, selects) = foldr getQueryParts ([],[]) forest
+
+    getQueryParts :: Tree ReadNode -> ([SqlFragment], [SqlFragment]) -> ([SqlFragment], [SqlFragment])
+    getQueryParts (Node n@(_, (name, Just Relation{relType=Child,relTable=Table{tableName=table}}, alias)) forst) (j,s) = (j,sel:s)
+      where
+        sel = "COALESCE(("
+           <> "SELECT array_to_json(array_agg(row_to_json("<>pgFmtIdent table<>"))) "
+           <> "FROM (" <> subquery <> ") " <> pgFmtIdent table
+           <> "), '[]') AS " <> pgFmtIdent (fromMaybe name alias)
+           where subquery = requestToQuery schema False (DbRead (Node n forst))
+    getQueryParts (Node n@(_, (name, Just r@Relation{relType=Parent,relTable=Table{tableName=table}}, alias)) forst) (j,s) = (joi:j,sel:s)
+      where
+        node_name = fromMaybe name alias
+        local_table_name = table <> "_" <> node_name
+        replaceTableName localTableName (Filter a b (VForeignKey (QualifiedIdentifier "" _) c)) = Filter a b (VForeignKey (QualifiedIdentifier "" localTableName) c)
+        replaceTableName _ x = x
+        sel = "row_to_json(" <> pgFmtIdent local_table_name <> ".*) AS " <> pgFmtIdent node_name
+        joi = " LEFT OUTER JOIN ( " <> subquery <> " ) AS " <> pgFmtIdent local_table_name  <>
+              " ON " <> intercalate " AND " ( map (pgFmtCondition qi . replaceTableName local_table_name) (getJoinConditions r) )
+          where subquery = requestToQuery schema True (DbRead (Node n forst))
+    getQueryParts (Node n@(_, (name, Just Relation{relType=Many,relTable=Table{tableName=table}}, alias)) forst) (j,s) = (j,sel:s)
+      where
+        sel = "COALESCE (("
+           <> "SELECT array_to_json(array_agg(row_to_json("<>pgFmtIdent table<>"))) "
+           <> "FROM (" <> subquery <> ") " <> pgFmtIdent table
+           <> "), '[]') AS " <> pgFmtIdent (fromMaybe name alias)
+           where subquery = requestToQuery schema False (DbRead (Node n forst))
+    --the following is just to remove the warning
+    --getQueryParts is not total but requestToQuery is called only after addJoinConditions which ensures the only
+    --posible relations are Child Parent Many
+    getQueryParts _ _ = undefined
+requestToQuery schema _ (DbMutate (Insert mainTbl (PayloadJSON rows) returnings)) =
+  insInto <> vals <> ret
+  where qi = QualifiedIdentifier schema mainTbl
+        cols = map pgFmtIdent $ fromMaybe [] (HM.keys <$> (rows V.!? 0))
+        colsString = intercalate ", " cols
+        insInto = unwords [ "INSERT INTO" , fromQi qi,
+            if T.null colsString then "" else "(" <> colsString <> ")"
+          ]
+        vals = unwords $
+          if T.null colsString
+            then if V.null rows then ["SELECT null WHERE false"] else ["DEFAULT VALUES"]
+            else ["SELECT", colsString, "FROM json_populate_recordset(null::" , fromQi qi, ", $1)"]
+        ret = if null returnings 
+                  then ""
+                  else unwords [" RETURNING ", intercalate ", " (map (pgFmtColumn qi) returnings)]
+requestToQuery schema _ (DbMutate (Update mainTbl (PayloadJSON rows) conditions returnings)) =
+  case rows V.!? 0 of
+    Just obj ->
+      let assignments = map
+            (\(k,v) -> pgFmtIdent k <> "=" <> insertableValue v) $ HM.toList obj in
+      unwords [
+        "UPDATE ", fromQi qi,
+        " SET " <> intercalate "," assignments <> " ",
+        ("WHERE " <> intercalate " AND " ( map (pgFmtCondition qi ) conditions )) `emptyOnNull` conditions,
+        ("RETURNING " <> intercalate ", " (map (pgFmtColumn qi) returnings)) `emptyOnNull` returnings
+        ]
+    Nothing -> undefined
+  where
+    qi = QualifiedIdentifier schema mainTbl
+requestToQuery schema _ (DbMutate (Delete mainTbl conditions returnings)) =
+  query
+  where
+    qi = QualifiedIdentifier schema mainTbl
+    query = unwords [
+      "DELETE FROM ", fromQi qi,
+      ("WHERE " <> intercalate " AND " ( map (pgFmtCondition qi ) conditions )) `emptyOnNull` conditions,
+      ("RETURNING " <> intercalate ", " (map (pgFmtColumn qi) returnings)) `emptyOnNull` returnings
+      ]
+
+sourceCTEName :: SqlFragment
+sourceCTEName = "pg_source"
+
+unquoted :: JSON.Value -> Text
+unquoted (JSON.String t) = t
+unquoted (JSON.Number n) =
+  toS $ formatScientific Fixed (if isInteger n then Just 0 else Nothing) n
+unquoted (JSON.Bool b) = show b
+unquoted v = toS $ JSON.encode v
+
+-- private functions
+asCsvF :: SqlFragment
+asCsvF = asCsvHeaderF <> " || '\n' || " <> asCsvBodyF
+  where
+    asCsvHeaderF =
+      "(SELECT coalesce(string_agg(a.k, ','), '')" <>
+      "  FROM (" <>
+      "    SELECT json_object_keys(r)::TEXT as k" <>
+      "    FROM ( " <>
+      "      SELECT row_to_json(hh) as r from " <> sourceCTEName <> " as hh limit 1" <>
+      "    ) s" <>
+      "  ) a" <>
+      ")"
+    asCsvBodyF = "coalesce(string_agg(substring(_postgrest_t::text, 2, length(_postgrest_t::text) - 2), '\n'), '')"
+
+asJsonF :: SqlFragment
+asJsonF = "coalesce(array_to_json(array_agg(row_to_json(_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 "
+
+locationF :: [Text] -> SqlFragment
+locationF pKeys =
+    "(" <>
+    " WITH s AS (SELECT row_to_json(ss) as r from " <> sourceCTEName <> " as ss  limit 1)" <>
+    " SELECT array_agg(json_data.key || '=' || coalesce('eq.' || json_data.value, 'is.null'))" <>
+    " FROM s, json_each_text(s.r) AS json_data" <>
+    (
+      if null pKeys
+      then ""
+      else " WHERE json_data.key IN ('" <> intercalate "','" pKeys <> "')"
+    ) <> ")"
+
+limitF :: NonnegRange -> SqlFragment
+limitF r  = if r == allRange
+  then ""
+  else "LIMIT " <> limit <> " OFFSET " <> offset
+  where
+    limit  = maybe "ALL" show $ rangeLimit r
+    offset = show $ rangeOffset r
+
+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)
+    Root   -> undefined --error "undefined getJoinConditions"
+  where
+    s = if typ == Parent then "" else tableSchema t
+    tN = tableName t
+    ftN = tableName ft
+    ltN = fromMaybe "" (tableName <$> lt)
+    toFilter :: Text -> Text -> Column -> Column -> Filter
+    toFilter tb ftb c fc = Filter (colName c, Nothing) "=" (VForeignKey (QualifiedIdentifier s tb) (ForeignKey fc{colTable=(colTable fc){tableName=ftb}}))
+
+unicodeStatement :: Text -> HE.Params a -> HD.Result b -> Bool -> H.Query a b
+unicodeStatement = H.statement . T.encodeUtf8
+
+emptyOnNull :: Text -> [a] -> Text
+emptyOnNull val x = if null x then "" else val
+
+insertableValue :: JSON.Value -> SqlFragment
+insertableValue JSON.Null = "null"
+insertableValue v = (<> "::unknown") . pgFmtLit $ unquoted v
+
+insertableValueWithType :: Text -> JSON.Value -> SqlFragment
+insertableValueWithType t v =
+  pgFmtLit (unquoted v) <> "::" <> t
+
+whiteList :: Text -> SqlFragment
+whiteList val = fromMaybe
+  (toS (pgFmtLit val) <> "::unknown ")
+  (find ((==) . toLower $ val) ["null","true","false"])
+
+pgFmtColumn :: QualifiedIdentifier -> Text -> SqlFragment
+pgFmtColumn table "*" = fromQi table <> ".*"
+pgFmtColumn table c = fromQi table <> "." <> pgFmtIdent c
+
+pgFmtField :: QualifiedIdentifier -> Field -> SqlFragment
+pgFmtField table (c, jp) = pgFmtColumn table c <> pgFmtJsonPath jp
+
+pgFmtSelectItem :: QualifiedIdentifier -> SelectItem -> SqlFragment
+pgFmtSelectItem table (f@(_, jp), Nothing, alias) = pgFmtField table f <> pgFmtAs jp alias
+pgFmtSelectItem table (f@(_, jp), Just cast, alias) = "CAST (" <> pgFmtField table f <> " AS " <> cast <> " )" <> pgFmtAs jp alias
+
+pgFmtCondition :: QualifiedIdentifier -> Filter -> SqlFragment
+pgFmtCondition table (Filter (col,jp) ops val) =
+  notOp <> " " <> sqlCol  <> " " <> pgFmtOperator opCode <> " " <>
+    if opCode `elem` ["is","isnot"] then whiteList (getInner val) else sqlValue
+  where
+    headPredicate:rest = split (=='.') ops
+    hasNot caseTrue caseFalse = if headPredicate == "not" then caseTrue else caseFalse
+    opCode      = hasNot (headDef "eq" rest) headPredicate
+    notOp       = hasNot headPredicate ""
+    sqlCol = case val of
+      VText _ -> pgFmtColumn table col <> pgFmtJsonPath jp
+      VForeignKey qi _ -> pgFmtColumn qi col
+    sqlValue = valToStr val
+    getInner v = case v of
+      VText s -> s
+      _      -> ""
+    valToStr v = case v of
+      VText s -> pgFmtValue opCode s
+      VForeignKey (QualifiedIdentifier s _) (ForeignKey Column{colTable=Table{tableName=ft}, colName=fc}) -> pgFmtColumn qi fc
+        where qi = QualifiedIdentifier (if ft == sourceCTEName then "" else s) ft
+      _ -> ""
+
+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 _ = ""
+
+pgFmtAs :: Maybe JsonPath -> Maybe Alias -> SqlFragment
+pgFmtAs Nothing Nothing = ""
+pgFmtAs (Just xx) Nothing = case lastMay xx of
+  Just alias -> " AS " <> pgFmtIdent alias
+  Nothing -> ""
+pgFmtAs _ (Just alias) = " AS " <> pgFmtIdent alias
+
+trimNullChars :: Text -> Text
+trimNullChars = T.takeWhile (/= '\x0')
@@ -0,0 +1,71 @@
+module PostgREST.RangeQuery (
+  rangeParse
+, rangeRequested
+, rangeLimit
+, rangeOffset
+, restrictRange
+, rangeGeq
+, allRange
+, NonnegRange
+) where
+
+
+import           Control.Applicative
+import           Network.HTTP.Types.Header
+
+import qualified Data.ByteString.Char8     as BS
+import           Data.Ranged.Boundaries
+import           Data.Ranged.Ranges
+
+import           Text.Regex.TDFA           ((=~))
+
+import Data.List (lookup)
+
+import           Protolude
+
+type NonnegRange = Range Integer
+
+rangeParse :: BS.ByteString -> NonnegRange
+rangeParse range = do
+  let rangeRegex = "^([0-9]+)-([0-9]*)$" :: BS.ByteString
+
+  case listToMaybe (range =~ rangeRegex :: [[BS.ByteString]]) of
+    Just parsedRange ->
+      let [_, mLower, mUpper] = readMaybe . toS <$> parsedRange
+          lower         = fromMaybe emptyRange   (rangeGeq <$> mLower)
+          upper         = fromMaybe allRange (rangeLeq <$> mUpper) in
+      rangeIntersection lower upper
+    Nothing -> allRange
+
+rangeRequested :: RequestHeaders -> NonnegRange
+rangeRequested headers = fromMaybe allRange $
+  rangeParse <$> lookup hRange headers
+
+restrictRange :: Maybe Integer -> NonnegRange -> NonnegRange
+restrictRange Nothing r = r
+restrictRange (Just limit) r =
+   rangeIntersection r $
+     Range BoundaryBelowAll (BoundaryAbove $ rangeOffset r + limit - 1)
+
+rangeLimit :: NonnegRange -> Maybe Integer
+rangeLimit range =
+  case [rangeLower range, rangeUpper range] of
+    [BoundaryBelow lower, BoundaryAbove upper] -> Just (1 + upper - lower)
+    _ -> Nothing
+
+rangeOffset :: NonnegRange -> Integer
+rangeOffset range =
+  case rangeLower range of
+    BoundaryBelow lower -> lower
+    _ -> panic "range without lower bound" -- should never happen
+
+rangeGeq :: Integer -> NonnegRange
+rangeGeq n =
+  Range (BoundaryBelow n) BoundaryAboveAll
+
+allRange :: NonnegRange
+allRange = rangeGeq 0
+
+rangeLeq :: Integer -> NonnegRange
+rangeLeq n =
+  Range BoundaryBelowAll (BoundaryAbove n)
@@ -0,0 +1,174 @@
+module PostgREST.Types where
+import           Protolude
+import qualified GHC.Show
+import           Data.Aeson
+import qualified Data.ByteString.Lazy as BL
+import           Data.Tree
+import qualified Data.Vector          as V
+import           PostgREST.RangeQuery (NonnegRange)
+
+data DbStructure = DbStructure {
+  dbTables      :: [Table]
+, dbColumns     :: [Column]
+, dbRelations   :: [Relation]
+, dbPrimaryKeys :: [PrimaryKey]
+, dbProcs       :: [(Text,ProcDescription)]
+} deriving (Show, Eq)
+
+data PgArg = PgArg {
+  pgaName :: Text
+, pgaType :: Text
+, pgaReq  :: Bool
+} deriving (Show, Eq)
+
+data ProcDescription = ProcDescription {
+  pdName       :: Text
+, pdArgs       :: [PgArg]
+, pdReturnType :: Text
+} deriving (Show, Eq)
+
+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
+} deriving (Show, Ord)
+
+data ForeignKey = ForeignKey { fkCol :: Column } deriving (Show, Eq, Ord)
+
+data Column =
+    Column {
+      colTable     :: Table
+    , colName      :: Text
+    , colPosition  :: Int32
+    , colNullable  :: Bool
+    , colType      :: Text
+    , colUpdatable :: Bool
+    , colMaxLen    :: Maybe Int32
+    , colPrecision :: Maybe Int32
+    , colDefault   :: Maybe Text
+    , colEnum      :: [Text]
+    , colFK        :: Maybe ForeignKey
+    }
+  | Star { colTable :: Table }
+  deriving (Show, Ord)
+
+type Synonym = (Column,Column)
+
+data PrimaryKey = PrimaryKey {
+    pkTable :: Table
+  , pkName  :: Text
+} deriving (Show, Eq)
+
+data OrderDirection = OrderAsc | OrderDesc deriving (Eq)
+instance Show OrderDirection where
+  show OrderAsc  = "asc"
+  show OrderDesc = "desc"
+
+data OrderNulls = OrderNullsFirst | OrderNullsLast deriving (Eq)
+instance Show OrderNulls where
+  show OrderNullsFirst = "nulls first"
+  show OrderNullsLast  = "nulls last"
+
+data OrderTerm = OrderTerm {
+  otTerm      :: Field
+, otDirection :: Maybe OrderDirection
+, otNullOrder :: Maybe OrderNulls
+} deriving (Show, Eq)
+
+data QualifiedIdentifier = QualifiedIdentifier {
+  qiSchema :: Schema
+, qiName   :: TableName
+} deriving (Show, Eq)
+
+
+data RelationType = Child | Parent | Many | Root deriving (Show, Eq)
+data Relation = Relation {
+  relTable    :: Table
+, relColumns  :: [Column]
+, relFTable   :: Table
+, relFColumns :: [Column]
+, relType     :: RelationType
+, relLTable   :: Maybe Table
+, relLCols1   :: Maybe [Column]
+, relLCols2   :: Maybe [Column]
+} deriving (Show, Eq)
+
+-- | An array of JSON objects that has been verified to have
+-- the same keys in every object
+newtype PayloadJSON = PayloadJSON (V.Vector Object)
+  deriving (Show, Eq)
+
+unPayloadJSON :: PayloadJSON -> V.Vector Object
+unPayloadJSON (PayloadJSON objs) = objs
+
+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)
+type FieldName = Text
+type JsonPath = [Text]
+type Field = (FieldName, Maybe JsonPath)
+type Alias = Text
+type Cast = Text
+type NodeName = Text
+type SelectItem = (Field, Maybe Cast, Maybe Alias)
+type Path = [Text]
+data ReadQuery = Select { select::[SelectItem], from::[TableName], flt_::[Filter], order::Maybe [OrderTerm], range_::NonnegRange } deriving (Show, Eq)
+data MutateQuery = Insert { in_::TableName, qPayload::PayloadJSON, returning::[FieldName] }
+                 | Delete { in_::TableName, where_::[Filter], returning::[FieldName] }
+                 | Update { in_::TableName, qPayload::PayloadJSON, where_::[Filter], returning::[FieldName] } deriving (Show, Eq)
+data Filter = Filter {field::Field, operator::Operator, value::FValue} deriving (Show, Eq)
+type ReadNode = (ReadQuery, (NodeName, Maybe Relation, Maybe Alias))
+type ReadRequest = Tree ReadNode
+type MutateRequest = MutateQuery
+data DbRequest = DbRead ReadRequest | DbMutate MutateRequest
+
+
+instance ToJSON Column where
+  toJSON c = object [
+      "schema"    .= tableSchema t
+    , "name"      .= colName c
+    , "position"  .= colPosition c
+    , "nullable"  .= colNullable c
+    , "type"      .= colType c
+    , "updatable" .= colUpdatable c
+    , "maxLen"    .= colMaxLen c
+    , "precision" .= colPrecision c
+    , "references".= colFK c
+    , "default"   .= colDefault c
+    , "enum"      .= colEnum c ]
+    where
+      t = colTable c
+
+instance ToJSON ForeignKey where
+  toJSON fk = object [
+      "schema" .= tableSchema t
+    , "table"  .= tableName t
+    , "column" .= colName c ]
+    where
+      c = fkCol fk
+      t = colTable c
+
+instance ToJSON Table where
+  toJSON v = object [
+      "schema"     .= tableSchema v
+    , "name"       .= tableName v
+    , "insertable" .= tableInsertable v ]
+
+instance Eq Table where
+  Table{tableSchema=s1,tableName=n1} == Table{tableSchema=s2,tableName=n2} = s1 == s2 && n1 == n2
+
+instance Eq Column where
+  Column{colTable=t1,colName=n1} == Column{colTable=t2,colName=n2} = t1 == t2 && n1 == n2
+  _ == _ = False
@@ -1,58 +0,0 @@
-module RangeQuery (
-  rangeParse
-, rangeRequested
-, rangeLimit
-, rangeOffset
-, NonnegRange
-) where
-
-import Control.Applicative
-import Network.HTTP.Types.Header
-
-import qualified Data.ByteString.Char8 as BS
-
-import Data.Ranged.Boundaries
-import Data.Ranged.Ranges
-
-import Data.String.Conversions (cs)
-import Text.Regex.TDFA ((=~))
-import Text.Read (readMaybe)
-
-import Data.Maybe (fromMaybe, listToMaybe)
-
-type NonnegRange = Range Int
-
-rangeParse :: BS.ByteString -> Maybe NonnegRange
-rangeParse range = do
-  let rangeRegex = "^([0-9]+)-([0-9]*)$" :: BS.ByteString
-
-  parsedRange <- listToMaybe (range =~ rangeRegex :: [[BS.ByteString]])
-
-  let [_, from, to] = readMaybe . cs <$> parsedRange
-  let lower = fromMaybe emptyRange   (rangeGeq <$> from)
-  let upper = fromMaybe (rangeGeq 0) (rangeLeq <$> to)
-
-  return $ rangeIntersection lower upper
-
-rangeRequested :: RequestHeaders -> Maybe NonnegRange
-rangeRequested = (rangeParse =<<) . lookup hRange
-
-rangeLimit :: NonnegRange -> Maybe Int
-rangeLimit range =
-  case [rangeLower range, rangeUpper range]
-    of [BoundaryBelow from, BoundaryAbove to] -> Just (1 + to - from)
-       _ -> Nothing
-
-rangeOffset :: NonnegRange -> Int
-rangeOffset range =
-  case rangeLower range
-    of BoundaryBelow from -> from
-       _ -> error "range without lower bound" -- should never happen
-
-rangeGeq :: Int -> NonnegRange
-rangeGeq n =
-  Range (BoundaryBelow n) BoundaryAboveAll
-
-rangeLeq :: Int -> NonnegRange
-rangeLeq n =
-  Range BoundaryBelowAll (BoundaryAbove n)
@@ -1,57 +0,0 @@
-{-# OPTIONS_GHC -fno-warn-orphans #-}
-module Types where
-
-import qualified Data.Aeson as JSON
-import Data.Aeson.Types (Parser)
-
-import Data.Scientific (floatingOrInteger)
-import Data.HashMap.Strict (foldlWithKey')
-import Data.Text (Text)
-import Data.Text.Encoding (decodeUtf8)
-import Data.Time.Calendar (showGregorian)
-import Control.Monad (mzero)
-
-instance JSON.FromJSON SqlValue where
-  parseJSON (JSON.Number n)    = return $ either toSql iToSql (floatingOrInteger n :: Either Double Int)
-  parseJSON (JSON.String s)    = return $ toSql s
-  parseJSON (JSON.Bool   b)    = return $ toSql b
-  parseJSON JSON.Null          = return SqlNull
-  parseJSON (JSON.Object o)    = return . toSql $ JSON.encode o
-  parseJSON (JSON.Array  a)    = return . toSql $ JSON.encode a
-
-instance JSON.ToJSON SqlValue where
-  toJSON (SqlString s)         = JSON.toJSON s
-  toJSON (SqlByteString s)     = JSON.toJSON $ decodeUtf8 s
-  toJSON (SqlWord32 w)         = JSON.toJSON w
-  toJSON (SqlWord64 w)         = JSON.toJSON w
-  toJSON (SqlInt32 i)          = JSON.toJSON i
-  toJSON (SqlInt64 i)          = JSON.toJSON i
-  toJSON (SqlInteger i)        = JSON.toJSON i
-  toJSON (SqlChar c)           = JSON.toJSON c
-  toJSON (SqlBool b)           = JSON.toJSON b
-  toJSON (SqlDouble n)         = JSON.toJSON n
-  toJSON (SqlRational n)       = JSON.toJSON n
-  toJSON (SqlLocalDate d)      = JSON.toJSON $ showGregorian d
-  toJSON (SqlLocalTimeOfDay t) = JSON.toJSON $ show t
-  toJSON (SqlLocalTime t)      = JSON.toJSON $ show t
-  toJSON SqlNull               = JSON.Null
-  toJSON x                     = JSON.toJSON $ show x
-
-
-newtype SqlRow = SqlRow {getRow :: [(Text, SqlValue)] } deriving (Show)
-
-sqlRowColumns :: SqlRow -> [Text]
-sqlRowColumns = map fst . getRow
-
-sqlRowValues :: SqlRow -> [SqlValue]
-sqlRowValues = map snd . getRow
-
-instance JSON.FromJSON SqlRow where
-  parseJSON (JSON.Object m) = foldlWithKey' add (return $ SqlRow []) m
-    where
-      add :: Parser SqlRow -> Text -> JSON.Value -> Parser SqlRow
-      add parser k v = do
-        SqlRow l <- parser
-        sqlV <- JSON.parseJSON v
-        return . SqlRow $ (k, sqlV) : l
-  parseJSON _ = mzero
@@ -0,0 +1,9 @@
+resolver: lts-7.4
+extra-deps:
+  - Ranged-sets-0.3.0
+  - hasql-pool-0.4.1
+  - hasql-transaction-0.5
+ghc-options:
+  postgrest: -O2 -Werror -Wall -fwarn-identities -fno-warn-redundant-constraints
+nix:
+  packages: [postgresql, zlib]
@@ -0,0 +1,13 @@
+FROM debian:jessie
+
+ENV PATH /root/.local/bin:$PATH
+
+RUN apt-get update \
+    && apt-get install -y wget libpq-dev pkg-config libpcre3 libpcre3-dev \
+       postgresql-client debconf locales \
+    && apt-get clean && rm -rf /var/lib/apt/lists/* /tmp/* /var/tmp/* \
+    && echo 'en_US.UTF-8 UTF-8' > /etc/locale.gen \
+    && locale-gen \
+    && echo 'export LC_ALL=en_US.UTF-8' >> /etc/profile \
+    && wget -qO- https://get.haskellstack.org/ | sh
+
@@ -1,30 +1,153 @@
 module Feature.AuthSpec where

 -- {{{ Imports
+import Text.Heredoc
 import Test.Hspec
 import Test.Hspec.Wai
 import Test.Hspec.Wai.JSON
 import Network.HTTP.Types

 import SpecHelper
+import Network.Wai (Application)
+
+import Protolude hiding (get)
 -- }}}

-spec :: Spec
-spec = beforeAll
-  (clearTable "postgrest.auth") . afterAll_ (clearTable "postgrest.auth")
-  $ around withApp
-  $ describe "authorization" $ do
+spec :: SpecWith Application
+spec = describe "authorization" $ do
+  let single = ("Accept","application/vnd.pgrst.object+json")

-  it "hides tables that anonymous does not own" $
-    get "/authors_only" `shouldRespondWith` 404
+  it "denies access to tables that anonymous does not own" $
+    get "/authors_only" `shouldRespondWith` ResponseMatcher {
+        matchBody = Just [json| {
+          "hint":null,
+          "details":null,
+          "code":"42501",
+          "message":"permission denied for relation authors_only"} |]
+      , matchStatus = 401
+      , matchHeaders = ["WWW-Authenticate" <:> "Bearer"]
+      }

-  it "indicates login failure" $ do
-    let auth = authHeader "postgrest_test_author" "fakefake"
+  it "denies access to tables that postgrest_test_author does not own" $
+    let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJyb2xlIjoicG9zdGdyZXN0X3Rlc3RfYXV0aG9yIiwiaWQiOiJqZG9lIn0.y4vZuu1dDdwAl0-S00MCRWRYMlJ5YAMSir6Es6WtWx0" in
+    request methodGet "/private_table" [auth] ""
+      `shouldRespondWith` ResponseMatcher {
+        matchBody = Just [json| {
+          "hint":null,
+          "details":null,
+          "code":"42501",
+          "message":"permission denied for relation private_table"} |]
+      , matchStatus = 403
+      , matchHeaders = []
+      }
+
+  it "returns jwt functions as jwt tokens" $
+    request methodPost "/rpc/login" [single]
+      [json| { "id": "jdoe", "pass": "1234" } |]
+      `shouldRespondWith` ResponseMatcher {
+          matchBody = Just [json| {"token":"eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJyb2xuYW1lIjoicG9zdGdyZXN0X3Rlc3RfYXV0aG9yIiwiaWQiOiJqZG9lIn0.P2G9EVSVI22MWxXWFuhEYd9BZerLS1WDlqzdqplM15s"} |]
+        , matchStatus = 200
+        , matchHeaders = ["Content-Type" <:> "application/json; charset=utf-8"]
+        }
+
+  it "sql functions can encode custom and standard claims" $
+    request methodPost  "/rpc/jwt_test" [single] "{}"
+      `shouldRespondWith` ResponseMatcher {
+          matchBody = Just [json| {"token":"eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJpc3MiOiJqb2UiLCJzdWIiOiJmdW4iLCJhdWQiOiJldmVyeW9uZSIsImV4cCI6MTMwMDgxOTM4MCwibmJmIjoxMzAwODE5MzgwLCJpYXQiOjEzMDA4MTkzODAsImp0aSI6ImZvbyIsInJvbGUiOiJwb3N0Z3Jlc3RfdGVzdCIsImh0dHA6Ly9wb3N0Z3Jlc3QuY29tL2ZvbyI6dHJ1ZX0.IHF16ZSU6XTbOnUWO8CCpUn2fJwt8P00rlYVyXQjpWc"} |]
+        , matchStatus = 200
+        , matchHeaders = ["Content-Type" <:> "application/json; charset=utf-8"]
+        }
+
+  it "sql functions can read custom and standard claims variables" $ do
+    let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJzdWIiOiJmdW4iLCJqdGkiOiJmb28iLCJuYmYiOjEzMDA4MTkzODAsImV4cCI6OTk5OTk5OTk5OSwiaHR0cDovL3Bvc3RncmVzdC5jb20vZm9vIjp0cnVlLCJpc3MiOiJqb2UiLCJyb2xlIjoicG9zdGdyZXN0X3Rlc3RfYXV0aG9yIiwiaWF0IjoxMzAwODE5MzgwLCJhdWQiOiJldmVyeW9uZSJ9.AQmCA7CMScvfaDRMqRPeUY6eNf--69gpW-kxaWfq9X0"
+    request methodPost "/rpc/reveal_big_jwt" [auth] "{}"
+      `shouldRespondWith` [str|[{"iss":"joe","sub":"fun","aud":"everyone","exp":9999999999,"nbf":1300819380,"iat":1300819380,"jti":"foo","http://postgrest.com/foo":true}]|]
+
+  it "allows users with permissions to see their tables" $ do
+    let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJyb2xlIjoicG9zdGdyZXN0X3Rlc3RfYXV0aG9yIiwiaWQiOiJqZG9lIn0.y4vZuu1dDdwAl0-S00MCRWRYMlJ5YAMSir6Es6WtWx0"
+    request methodGet "/authors_only" [auth] ""
+      `shouldRespondWith` 200
+
+  it "works with tokens which have extra fields" $ do
+    let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJyb2xlIjoicG9zdGdyZXN0X3Rlc3RfYXV0aG9yIiwiaWQiOiJqZG9lIiwia2V5MSI6InZhbHVlMSIsImtleTIiOiJ2YWx1ZTIiLCJrZXkzIjoidmFsdWUzIiwiYSI6MSwiYiI6MiwiYyI6M30.GfydCh-F4wnM379xs0n1zUgalwJIsb6YoBapCo8HlFk"
+    request methodGet "/authors_only" [auth] ""
+      `shouldRespondWith` 200
+
+  -- this test will stop working 9999999999s after the UNIX EPOCH
+  it "succeeds with an unexpired token" $ do
+    let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJleHAiOjk5OTk5OTk5OTksInJvbGUiOiJwb3N0Z3Jlc3RfdGVzdF9hdXRob3IiLCJpZCI6Impkb2UifQ.QaPPLWTuyydMu_q7H4noMT7Lk6P4muet1OpJXF6ofhc"
+    request methodGet "/authors_only" [auth] ""
+      `shouldRespondWith` 200
+
+  it "fails with an expired token" $ do
+    let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJleHAiOjE0NDY2NzgxNDksInJvbGUiOiJwb3N0Z3Jlc3RfdGVzdF9hdXRob3IiLCJpZCI6Impkb2UifQ.enk_qZ_u6gZsXY4R8bREKB_HNExRpM0lIWSLktk9JJQ"
+    request methodGet "/authors_only" [auth] ""
+      `shouldRespondWith` ResponseMatcher {
+          matchBody = Nothing
+        , matchStatus = 401
+        , matchHeaders = [
+            "WWW-Authenticate" <:>
+            "Bearer error=\"invalid_token\", error_description=\"JWT expired\""
+          ]
+        }
+
+  it "hides tables from users with invalid JWT" $ do
+    let auth = authHeaderJWT "ey9zdGdyZXN0X3Rlc3RfYXV0aG9yIiwiaWQiOiJqZG9lIn0.y4vZuu1dDdwAl0-S00MCRWRYMlJ5YAMSir6Es6WtWx0"
+    request methodGet "/authors_only" [auth] ""
+      `shouldRespondWith` ResponseMatcher {
+          matchBody = Nothing
+        , matchStatus = 401
+        , matchHeaders = [
+            "WWW-Authenticate" <:>
+            "Bearer error=\"invalid_token\", error_description=\"JWT invalid\""
+          ]
+        }
+
+  it "should fail when jwt contains no claims" $ do
+    let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.e30.lu-rG8aSCiw-aOlN0IxpRGz5r7Jwq7K9r3tuMPUpytI"
    request methodGet "/authors_only" [auth] ""
      `shouldRespondWith` 401

-  it "allows users with permissions to see their tables" $ do
-    _ <- post "/postgrest/users" [json| { "id":"jdoe", "pass": "1234", "role": "postgrest_test_author" } |]
-    let auth = authHeader "jdoe" "1234"
+  it "hides tables from users with JWT that contain no claims about role" $ do
+    let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJpZCI6Impkb2UifQ.Jneso9X519Vh0z7i9PbXIu7W1HEoq9RRw9BBbyQKFCQ"
+    request methodGet "/authors_only" [auth] ""
+      `shouldRespondWith` 401
+
+  it "recovers after 401 error with logged in user" $ do
+    _ <- post "/authors_only" [json| { "owner": "jdoe", "secret": "test content" } |]
+    let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJyb2xlIjoicG9zdGdyZXN0X3Rlc3RfYXV0aG9yIiwiaWQiOiJqZG9lIn0.y4vZuu1dDdwAl0-S00MCRWRYMlJ5YAMSir6Es6WtWx0"
+    _ <- request methodPost "/rpc/problem" [auth] ""
    request methodGet "/authors_only" [auth] ""
      `shouldRespondWith` 200
+
+  describe "custom pre-request proc acting on id claim" $ do
+
+    it "able to switch to postgrest_test_author role (id=1)" $
+      let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJpZCI6MX0.mI2HNoOum6xM3sc4oHLxU4yLv-_WV5W1kqBfY_wEvLw" in
+      request methodPost "/rpc/get_current_user" [auth]
+        [json| {} |]
+         `shouldRespondWith` ResponseMatcher {
+            matchBody    = Just [str|"postgrest_test_author"|]
+          , matchStatus = 200
+          , matchHeaders = []
+          }
+
+    it "able to switch to postgrest_test_default_role (id=2)" $
+      let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJpZCI6Mn0.W7jLsG-zswM91AJkCvZeIMHrnz7_6ceY2jnscVl3Yhk" in
+      request methodPost "/rpc/get_current_user" [auth]
+        [json| {} |]
+         `shouldRespondWith` ResponseMatcher {
+            matchBody    = Just [str|"postgrest_test_default_role"|]
+          , matchStatus = 200
+          , matchHeaders = []
+          }
+
+    it "raises error (id=3)" $
+      let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJpZCI6M30.15Gy8PezQhJIaHYDJVLa-Gmz9T3sJnW66EKAYIsXc7c" in
+      request methodPost "/rpc/get_current_user" [auth]
+        [json| {} |]
+         `shouldRespondWith` ResponseMatcher {
+            matchBody    = Just [str|{"hint":"Please contact administrator","details":null,"code":"P0001","message":"Disabled ID --> 3"}|]
+          , matchStatus = 400
+          , matchHeaders = []
+          }
@@ -0,0 +1,21 @@
+module Feature.BinaryJwtSecretSpec where
+
+-- {{{ Imports
+import Test.Hspec
+import Test.Hspec.Wai
+import Network.HTTP.Types
+
+import SpecHelper
+import Network.Wai (Application)
+
+import Protolude hiding (get)
+-- }}}
+
+spec :: SpecWith Application
+spec = describe "server started with binary JWT secret" $
+
+  -- this test will stop working 9999999999s after the UNIX EPOCH
+  it "succeeds with jwt token encoded with a binary secret" $ do
+    let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJleHAiOjk5OTk5OTk5OTksInJvbGUiOiJwb3N0Z3Jlc3RfdGVzdF9hdXRob3IiLCJpZCI6Impkb2UifQ.l_EcSRWeNtL4OKUTIplrHyioNrff9Rd0MV7RXNCxCyk"
+    request methodGet "/authors_only" [auth] ""
+      `shouldRespondWith` 200
@@ -0,0 +1,53 @@
+{-# LANGUAGE MultiParamTypeClasses, TypeFamilies, UndecidableInstances #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+module Feature.ConcurrentSpec where
+
+import Control.Monad (void)
+import Control.Monad.Base
+
+import Control.Monad.Trans.Control
+import Control.Concurrent.Async (mapConcurrently)
+
+import Test.Hspec hiding (pendingWith)
+import Test.Hspec.Wai.Internal
+import Test.Hspec.Wai
+import Test.Hspec.Wai.JSON
+import Network.Wai.Test (Session)
+
+import Network.Wai (Application)
+
+import Protolude hiding (get)
+
+spec :: SpecWith Application
+spec =
+  describe "Queryiny in parallel" $
+    it "should not raise 'transaction in progress' error" $
+      raceTest 10 $
+        get "/fakefake"
+          `shouldRespondWith` ResponseMatcher {
+            matchBody    = Just [json|
+              { "hint": null,
+                "details":null,
+                "code":"42P01",
+                "message":"relation \"test.fakefake\" does not exist"
+              } |]
+          , matchStatus  = 404
+          , matchHeaders = []
+          }
+
+raceTest :: Int -> WaiExpectation -> WaiExpectation
+raceTest times = liftBaseDiscard go
+ where
+  go test = void $ mapConcurrently (const test) [1..times]
+
+instance MonadBaseControl IO WaiSession where
+  type StM WaiSession a = StM Session a
+  liftBaseWith f = WaiSession $
+    liftBaseWith $ \runInBase ->
+      f $ \k -> runInBase (unWaiSession k)
+  restoreM = WaiSession . restoreM
+  {-# INLINE liftBaseWith #-}
+  {-# INLINE restoreM #-}
+
+instance MonadBase IO WaiSession where
+  liftBase = liftIO
@@ -9,10 +9,14 @@ import qualified Data.ByteString.Lazy as BL
 import SpecHelper

 import Network.HTTP.Types
+import Network.Wai (Application)
+
+import Protolude hiding (get)
 -- }}}

-spec :: Spec
-spec = around withApp $ describe "CORS" $ do
+spec :: SpecWith Application
+spec =
+  describe "CORS" $ do
    let preflightHeaders = [
          ("Accept", "*/*"),
          ("Origin", "http://example.com"),
@@ -22,7 +26,7 @@ spec = around withApp $ describe "CORS" $ do
          ("Host", "localhost:3000"),
          ("User-Agent", "Mozilla/5.0 (Macintosh; Intel Mac OS X 10.9; rv:32.0) Gecko/20100101 Firefox/32.0"),
          ("Origin", "http://localhost:8000"),
-          ("Accept", "text/plain, */*; q=0.01"),
+          ("Accept", "text/csv, */*; q=0.01"),
          ("Accept-Language", "en-US,en;q=0.5"),
          ("Accept-Encoding", "gzip, deflate"),
          ("Referer", "http://localhost:8000/"),
@@ -41,7 +45,7 @@ spec = around withApp $ describe "CORS" $ do
            "true"
          respHeaders `shouldSatisfy` matchHeader
            "Access-Control-Allow-Methods"
-            "GET, POST, PUT, PATCH, DELETE, OPTIONS, HEAD"
+            "GET, POST, PATCH, DELETE, OPTIONS, HEAD"
          respHeaders `shouldSatisfy` matchHeader
            "Access-Control-Allow-Headers"
            "Authentication, Foo, Bar, Accept, Accept-Language, Content-Language"
@@ -67,4 +71,4 @@ spec = around withApp $ describe "CORS" $ do
        liftIO $ do
          simpleHeaders r `shouldSatisfy` matchHeader
            "Access-Control-Allow-Origin" "\\*"
-          simpleBody r `shouldSatisfy` not . BL.null
+          simpleBody r `shouldSatisfy` BL.null
@@ -2,13 +2,15 @@ module Feature.DeleteSpec where

 import Test.Hspec
 import Test.Hspec.Wai
-import SpecHelper
+import Text.Heredoc

 import Network.HTTP.Types
+import Network.Wai (Application)

-spec :: Spec
-spec = beforeAll (clearTable "items" >> createItems 15) . afterAll_ (clearTable "items")
-  . around withApp $
+import Protolude hiding (get)
+
+spec :: SpecWith Application
+spec =
  describe "Deleting" $ do
    context "existing record" $ do
      it "succeeds with 204 and deletion count" $
@@ -16,21 +18,52 @@ spec = beforeAll (clearTable "items" >> createItems 15) . afterAll_ (clearTable
          `shouldRespondWith` ResponseMatcher {
            matchBody    = Nothing
          , matchStatus  = 204
+          , matchHeaders = ["Content-Range" <:> "*/*"]
+          }
+
+      it "returns the deleted item and count if requested" $
+        request methodDelete "/items?id=eq.2" [("Prefer", "return=representation"), ("Prefer", "count=exact")] ""
+          `shouldRespondWith` ResponseMatcher {
+            matchBody    = Just [str|[{"id":2}]|]
+          , matchStatus  = 200
          , matchHeaders = ["Content-Range" <:> "*/1"]
          }
+      it "returns the deleted item and shapes the response" $
+        request methodDelete "/complex_items?id=eq.2&select=id,name" [("Prefer", "return=representation")] ""
+          `shouldRespondWith` ResponseMatcher {
+            matchBody    = Just [str|[{"id":2,"name":"Two"}]|]
+          , matchStatus  = 200
+          , matchHeaders = ["Content-Range" <:> "*/*"]
+          }
+      it "can rename and cast the selected columns" $
+        request methodDelete "/complex_items?id=eq.3&select=ciId:id::text,ciName:name" [("Prefer", "return=representation")] ""
+          `shouldRespondWith` [str|[{"ciId":"3","ciName":"Three"}]|]
+      it "can embed (parent) entities" $
+        request methodDelete "/tasks?id=eq.8&select=id,name,project{id}" [("Prefer", "return=representation")] ""
+          `shouldRespondWith` ResponseMatcher {
+            matchBody    = Just [str|[{"id":8,"name":"Code OSX","project":{"id":4}}]|]
+          , matchStatus  = 200
+          , matchHeaders = ["Content-Range" <:> "*/*"]
+          }

      it "actually clears items ouf the db" $ do
        _ <- request methodDelete "/items?id=lt.15" [] ""
        get "/items"
          `shouldRespondWith` ResponseMatcher {
-            matchBody    = Just "[{\"id\":15}]"
+            matchBody    = Just [str|[{"id":15}]|]
          , matchStatus  = 200
-          , matchHeaders = ["Content-Range" <:> "0-0/1"]
+          , matchHeaders = ["Content-Range" <:> "0-0/*"]
          }

-    context "known route, unknown record" $
-      it "fails with 404" $
-        request methodDelete "/items?id=eq.101" [] "" `shouldRespondWith` 404
+    context "known route, no records matched" $
+      it "includes [] body if return=rep" $
+        request methodDelete "/items?id=eq.101"
+          [("Prefer", "return=representation")] ""
+          `shouldRespondWith` ResponseMatcher {
+            matchBody    = Just "[]"
+          , matchStatus  = 200
+          , matchHeaders = ["Content-Range" <:> "*/*"]
+          }

    context "totally unknown route" $
      it "fails with 404" $
@@ -1,6 +1,6 @@
 module Feature.InsertSpec where

-import Test.Hspec
+import Test.Hspec hiding (pendingWith)
 import Test.Hspec.Wai
 import Test.Hspec.Wai.JSON
 import Network.Wai.Test (SResponse(simpleBody,simpleHeaders,simpleStatus))
@@ -8,30 +8,82 @@ import Network.Wai.Test (SResponse(simpleBody,simpleHeaders,simpleStatus))
 import SpecHelper

 import qualified Data.Aeson as JSON
+import Data.List (lookup)
 import Data.Maybe (fromJust)
 import Text.Heredoc
 import Network.HTTP.Types.Header
 import Network.HTTP.Types
-import Control.Monad (replicateM_)
+import Control.Monad (replicateM_, void)

 import TestTypes(IncPK(..), CompoundPK(..))
+import Network.Wai (Application)

-spec :: Spec
-spec = afterAll_ resetDb $ around withApp $ do
+import Protolude hiding (get)
+
+spec :: SpecWith Application
+spec = do
  describe "Posting new record" $ do
-    after_ (clearTable "menagerie") . it "accepts disparate json types" $ do
-      p <- post "/menagerie"
-        [json| {
-          "integer": 13, "double": 3.14159, "varchar": "testing!"
-        , "boolean": false, "date": "1900-01-01", "money": "$3.99"
-        , "enum": "foo"
-        } |]
-      liftIO $ do
-        simpleBody p `shouldBe` ""
-        simpleStatus p `shouldBe` created201
+    context "disparate json types" $ do
+      it "accepts disparate json types" $ do
+        p <- post "/menagerie"
+          [json| {
+            "integer": 13, "double": 3.14159, "varchar": "testing!"
+          , "boolean": false, "date": "1900-01-01", "money": "$3.99"
+          , "enum": "foo"
+          } |]
+        liftIO $ do
+          simpleBody p `shouldBe` ""
+          simpleStatus p `shouldBe` created201
+          -- should not have content type set when body is empty
+          lookup hContentType (simpleHeaders p) `shouldBe` Nothing
+
+      it "filters columns in result using &select" $
+        request methodPost "/menagerie?select=integer,varchar" [("Prefer", "return=representation")]
+          [json| [{
+            "integer": 14, "double": 3.14159, "varchar": "testing!"
+          , "boolean": false, "date": "1900-01-01", "money": "$3.99"
+          , "enum": "foo"
+          }] |] `shouldRespondWith` ResponseMatcher {
+            matchBody    = Just [str|[{"integer":14,"varchar":"testing!"}]|]
+          , matchStatus  = 201
+          , matchHeaders = ["Content-Type" <:> "application/json; charset=utf-8"]
+          }
+
+    context "requesting full representation" $ do
+      it "includes related data after insert" $
+        request methodPost "/projects?select=id,name,clients{id,name}"
+                [("Prefer", "return=representation"), ("Prefer", "count=exact")]
+          [str|{"id":6,"name":"New Project","client_id":2}|] `shouldRespondWith` ResponseMatcher {
+            matchBody    = Just [str|[{"id":6,"name":"New Project","clients":{"id":2,"name":"Apple"}}]|]
+          , matchStatus  = 201
+          , matchHeaders = [ "Content-Type" <:> "application/json; charset=utf-8"
+                           , "Location" <:> "/projects?id=eq.6"
+                           , "Content-Range" <:> "*/1" ]
+          }
+
+      it "can rename and cast the selected columns" $
+        request methodPost "/projects?select=pId:id::text,pName:name,cId:client_id::text"
+                [("Prefer", "return=representation")] 
+          [str|{"id":7,"name":"New Project","client_id":2}|] `shouldRespondWith` ResponseMatcher {
+            matchBody    = Just [str|[{"pId":"7","pName":"New Project","cId":"2"}]|]
+          , matchStatus  = 201
+          , matchHeaders = [ "Content-Type" <:> "application/json; charset=utf-8"
+                           , "Location" <:> "/projects?id=eq.7"
+                           , "Content-Range" <:> "*/*" ]
+          }
+
+    context "from an html form" $
+      it "accepts disparate json types" $ do
+        p <- request methodPost "/menagerie"
+               [("Content-Type", "application/x-www-form-urlencoded")]
+               ("integer=7&double=2.71828&varchar=forms+are+fun&" <>
+                "boolean=false&date=1900-01-01&money=$3.99&enum=foo")
+        liftIO $ do
+          simpleBody p `shouldBe` ""
+          simpleStatus p `shouldBe` created201

    context "with no pk supplied" $ do
-      context "into a table with auto-incrementing pk" . after_ (clearTable "auto_incrementing_pk") $
+      context "into a table with auto-incrementing pk" $
        it "succeeds with 201 and link" $ do
          p <- post "/auto_incrementing_pk" [json| { "non_nullable_string":"not null"} |]
          liftIO $ do
@@ -46,11 +98,13 @@ spec = afterAll_ resetDb $ around withApp $ do
            incNullableStr record `shouldBe` Nothing

      context "into a table with simple pk" $
-        it "fails with 400 and error" $
-          post "/simple_pk" [json| { "extra":"foo"} |]
-            `shouldRespondWith` 400
+        it "fails with 400 and error" $ do
+          p <- post "/simple_pk" [json| { "extra":"foo"} |]
+          liftIO $ do
+            simpleStatus p `shouldBe` badRequest400
+            isErrorFormat (simpleBody p) `shouldBe` True

-      context "into a table with no pk" . after_ (clearTable "no_pk") $ do
+      context "into a table with no pk" $ do
        it "succeeds with 201 and a link including all fields" $ do
          p <- post "/no_pk" [json| { "a":"foo", "b":"bar" } |]
          liftIO $ do
@@ -63,176 +117,266 @@ spec = afterAll_ resetDb $ around withApp $ do
                       [("Prefer", "return=representation")]
                       [json| { "a":"bar", "b":"baz" } |]
          liftIO $ do
-            simpleBody p `shouldBe` [json| { "a":"bar", "b":"baz" } |]
+            simpleBody p `shouldBe` [json| [{ "a":"bar", "b":"baz" }] |]
            simpleHeaders p `shouldSatisfy` matchHeader hLocation "/no_pk\\?a=eq.bar&b=eq.baz"
            simpleStatus p `shouldBe` created201

+        it "returns empty array when no items inserted, and return=rep" $ do
+          p <- request methodPost "/no_pk"
+                       [("Prefer", "return=representation")]
+                       [json| [] |]
+          liftIO $ do
+            simpleBody p `shouldBe` [json| [] |]
+            simpleStatus p `shouldBe` created201
+
+        it "can insert in tables with no select privileges" $ do
+          p <- request methodPost "/insertonly"
+                       [("Prefer", "return=minimal")]
+                       [json| { "v":"some value" } |]
+          liftIO $ do
+            simpleBody p `shouldBe` ""
+            simpleStatus p `shouldBe` created201
+
+
        it "can post nulls" $ do
          p <- request methodPost "/no_pk"
                       [("Prefer", "return=representation")]
                       [json| { "a":null, "b":"foo" } |]
          liftIO $ do
-            simpleBody p `shouldBe` [json| { "a":null, "b":"foo" } |]
+            simpleBody p `shouldBe` [json| [{ "a":null, "b":"foo" }] |]
            simpleHeaders p `shouldSatisfy` matchHeader hLocation "/no_pk\\?a=is.null&b=eq.foo"
            simpleStatus p `shouldBe` created201

-    context "with compound pk supplied" . after_ (clearTable "compound_pk") $
-      it "builds response location header appropriately" $
-        post "/compound_pk" [json| { "k1":12, "k2":42 } |]
-          `shouldRespondWith` ResponseMatcher {
-            matchBody    = Nothing,
-            matchStatus  = 201,
-            matchHeaders = ["Location" <:> "/compound_pk?k1=eq.12&k2=eq.42"]
-          }
+    context "with compound pk supplied" $
+      it "builds response location header appropriately" $ do
+        let inserted    = [json| { "k1":12, "k2":"Rock & R+ll" } |]
+            expectedObj = CompoundPK 12 "Rock & R+ll" Nothing
+            expectedLoc = "/compound_pk?k1=eq.12&k2=eq.Rock%20%26%20R%2Bll"
+        p <- request methodPost "/compound_pk"
+                     [("Prefer", "return=representation")]
+                     inserted
+        liftIO $ do
+          JSON.decode (simpleBody p) `shouldBe` Just [expectedObj]
+          simpleStatus p `shouldBe` created201
+          lookup hLocation (simpleHeaders p) `shouldBe` Just expectedLoc
+
+        r <- get expectedLoc
+        liftIO $ do
+          JSON.decode (simpleBody r) `shouldBe` Just [expectedObj]
+          simpleStatus r `shouldBe` ok200
+
+    context "with bulk insert" $
+      it "returns 201 but no location header" $ do
+        let bulkData = [json| [ {"k1":21, "k2":"hello world"}
+                              , {"k1":22, "k2":"bye for now"}]
+                            |]
+        p <- request methodPost "/compound_pk" [] bulkData
+        liftIO $ do
+          simpleStatus p `shouldBe` created201
+          lookup hLocation (simpleHeaders p) `shouldBe` Nothing

    context "with invalid json payload" $
-      it "fails with 400 and error" $
-        post "/simple_pk" "}{ x = 2"
+      it "fails with 400 and error" $ do
+        p <- post "/simple_pk" "}{ x = 2"
+        liftIO $ do
+          simpleStatus p `shouldBe` badRequest400
+          isErrorFormat (simpleBody p) `shouldBe` True
+
+    context "with valid json payload" $
+      it "succeeds and returns 201 created" $
+        post "/simple_pk" [json| { "k":"k1", "extra":"e1" } |] `shouldRespondWith` 201
+
+    context "attempting to insert a row with the same primary key" $
+      it "fails returning a 409 Conflict" $
+        post "/simple_pk" [json| { "k":"k1", "extra":"e1" } |] `shouldRespondWith` 409
+
+    context "attempting to insert a row with conflicting unique constraint" $
+      it "fails returning a 409 Conflict" $
+        post "/withUnique"  [json| { "uni":"nodup", "extra":"e2" } |] `shouldRespondWith` 409
+
+    context "jsonb" $ do
+      it "serializes nested object" $ do
+        let inserted = [json| { "data": { "foo":"bar" } } |]
+            location = "/json?data=eq.%7B%22foo%22%3A%22bar%22%7D"
+        request methodPost "/json"
+                     [("Prefer", "return=representation")]
+                     inserted
          `shouldRespondWith` ResponseMatcher {
-            matchBody    = Just [json| {"message":"Failed to parse JSON payload. Failed reading: satisfy"} |]
-          , matchStatus  = 400
+            matchBody    = Just [str|[{"data":{"foo":"bar"}}]|]
+          , matchStatus  = 201
+          , matchHeaders = ["Location" <:> location]
+          }
+
+      it "serializes nested array" $ do
+        let inserted = [json| { "data": [1,2,3] } |]
+            location = "/json?data=eq.%5B1%2C2%2C3%5D"
+        request methodPost "/json"
+                     [("Prefer", "return=representation")]
+                     inserted
+          `shouldRespondWith` ResponseMatcher {
+            matchBody    = Just [str|[{"data":[1,2,3]}]|]
+          , matchStatus  = 201
+          , matchHeaders = ["Location" <:> location]
+          }
+
+    context "empty object" $
+      it "successfully populates table with all-default columns" $
+        post "/items" "{}" `shouldRespondWith` ResponseMatcher {
+            matchBody    = Just ""
+          , matchStatus  = 201
+          , matchHeaders = []
+          }
+    context "table with limited privileges" $ do
+      it "succeeds if correct select is applied" $
+        request methodPost "/limited_article_stars?select=article_id,user_id" [("Prefer", "return=representation")]
+          [json| {"article_id": 2, "user_id": 1} |] `shouldRespondWith` ResponseMatcher {
+            matchBody    = Just [str|[{"article_id":2,"user_id":1}]|]
+          , matchStatus  = 201
+          , matchHeaders = []
+          }
+      it "fails if more columns are selected" $
+        request methodPost "/limited_article_stars?select=article_id,user_id,created_at" [("Prefer", "return=representation")]
+          [json| {"article_id": 2, "user_id": 2} |] `shouldRespondWith` ResponseMatcher {
+            matchBody    = Just [str|{"hint":null,"details":null,"code":"42501","message":"permission denied for relation limited_article_stars"}|]
+          , matchStatus  = 401
+          , matchHeaders = []
+          }
+      it "fails if select is not specified" $
+        request methodPost "/limited_article_stars" [("Prefer", "return=representation")]
+          [json| {"article_id": 3, "user_id": 1} |] `shouldRespondWith` ResponseMatcher {
+            matchBody    = Just [str|{"hint":null,"details":null,"code":"42501","message":"permission denied for relation limited_article_stars"}|]
+          , matchStatus  = 401
          , matchHeaders = []
          }

  describe "CSV insert" $ do

-    after_ (clearTable "menagerie") . context "disparate csv types" $
+    context "disparate csv types" $
      it "succeeds with multipart response" $ do
-        p <- request methodPost "/menagerie" [("Content-Type", "text/csv")]
-               [str|integer,double,varchar,boolean,date,money,enum
-                   |13,3.14159,testing!,false,1900-01-01,$3.99,foo
-                   |12,0.1,a string,true,1929-10-01,12,bar
-                   |]
-        liftIO $ do
-          simpleBody p `shouldBe` "Content-Type: application/json\nLocation: /menagerie?integer=eq.13\n\n\n--postgrest_boundary\nContent-Type: application/json\nLocation: /menagerie?integer=eq.12\n\n"
-          simpleStatus p `shouldBe` created201
+        pendingWith "Decide on what to do with CSV insert"
+        let inserted = [str|integer,double,varchar,boolean,date,money,enum
+            |13,3.14159,testing!,false,1900-01-01,$3.99,foo
+            |12,0.1,a string,true,1929-10-01,12,bar
+            |]
+        request methodPost "/menagerie" [("Content-Type", "text/csv"), ("Accept", "text/csv"), ("Prefer", "return=representation")] inserted

-    after_ (clearTable "no_pk") . context "requesting full representation" $ do
+           `shouldRespondWith` ResponseMatcher {
+             matchBody    = Just inserted
+           , matchStatus  = 201
+           , matchHeaders = ["Content-Type" <:> "text/csv; charset=utf-8"]
+           }
+
+    context "requesting full representation" $ do
      it "returns full details of inserted record" $
        request methodPost "/no_pk"
-                     [("Content-Type", "text/csv"), ("Prefer", "return=representation")]
+                     [("Content-Type", "text/csv"), ("Accept", "text/csv"),  ("Prefer", "return=representation")]
                     "a,b\nbar,baz"
          `shouldRespondWith` ResponseMatcher {
-            matchBody    = Just [json| { "a":"bar", "b":"baz" } |]
+            matchBody    = Just "a,b\nbar,baz"
          , matchStatus  = 201
-          , matchHeaders = ["Content-Type" <:> "application/json",
+          , matchHeaders = ["Content-Type" <:> "text/csv; charset=utf-8",
                            "Location" <:> "/no_pk?a=eq.bar&b=eq.baz"]
          }

      it "can post nulls" $
        request methodPost "/no_pk"
-                     [("Content-Type", "text/csv"), ("Prefer", "return=representation")]
+                     [("Content-Type", "text/csv"), ("Accept", "text/csv"), ("Prefer", "return=representation")]
                     "a,b\nNULL,foo"
          `shouldRespondWith` ResponseMatcher {
-            matchBody    = Just [json| { "a":null, "b":"foo" } |]
+            matchBody    = Just "a,b\n,foo"
          , matchStatus  = 201
-          , matchHeaders = ["Content-Type" <:> "application/json",
+          , matchHeaders = ["Content-Type" <:> "text/csv; charset=utf-8",
                            "Location" <:> "/no_pk?a=is.null&b=eq.foo"]
          }

-    after_ (clearTable "no_pk") . context "with wrong number of columns" $ do
+      it "only returns the requested column header with its associated data" $
+        request methodPost "/projects?select=id"
+                     [("Content-Type", "text/csv"), ("Accept", "text/csv"), ("Prefer", "return=representation")]
+                     "id,name,client_id\n8,Xenix,1\n9,Windows NT,1"
+          `shouldRespondWith` ResponseMatcher {
+            matchBody    = Just "id\n8\n9"
+          , matchStatus  = 201
+          , matchHeaders = ["Content-Type" <:> "text/csv; charset=utf-8",
+                            "Content-Range" <:> "*/*"]
+          }
+
+    context "with wrong number of columns" $
      it "fails for too few" $ do
        p <- request methodPost "/no_pk" [("Content-Type", "text/csv")] "a,b\nfoo,bar\nbaz"
-        liftIO $ simpleStatus p `shouldBe` badRequest400
-      it "fails for too many" $ do
-        p <- request methodPost "/no_pk" [("Content-Type", "text/csv")] "a,b\nfoo,bar\nbaz,bat,bad"
-        liftIO $ simpleStatus p `shouldBe` badRequest400
+        liftIO $ do
+          simpleStatus p `shouldBe` badRequest400
+          isErrorFormat (simpleBody p) `shouldBe` True

-  describe "Putting record" $ do
+    context "with unicode values" $
+      it "succeeds and returns usable location header" $ do
+        let payload = [json| { "a":"圍棋", "b":"￥" } |]
+        p <- request methodPost "/no_pk"
+                     [("Prefer", "return=representation")]
+                     payload
+        liftIO $ do
+          simpleBody p `shouldBe` "["<>payload<>"]"
+          simpleStatus p `shouldBe` created201

-    context "to unkonwn uri" $
-      it "gives a 404" $
-        request methodPut "/fake" []
-          [json| { "real": false } |]
-            `shouldRespondWith` 404
+        let Just location = lookup hLocation $ simpleHeaders p
+        r <- get location
+        liftIO $ simpleBody r `shouldBe` "["<>payload<>"]"

-    context "to a known uri" $ do
-      context "without a fully-specified primary key" $
-        it "is not an allowed operation" $
-          request methodPut "/compound_pk?k1=eq.12" []
-            [json| { "k1":12, "k2":42 } |]
-              `shouldRespondWith` 405
-
-      context "with a fully-specified primary key" $ do
-
-        context "not specifying every column in the table" $
-          it "is rejected for lack of idempotence" $
-            request methodPut "/compound_pk?k1=eq.12&k2=eq.42" []
-              [json| { "k1":12, "k2":42 } |]
-                `shouldRespondWith` 400
-
-        context "specifying every column in the table" . after_ (clearTable "compound_pk") $ do
-          it "can create a new record" $ do
-            p <- request methodPut "/compound_pk?k1=eq.12&k2=eq.42" []
-                 [json| { "k1":12, "k2":42, "extra":3 } |]
-            liftIO $ do
-              simpleBody p `shouldBe` ""
-              simpleStatus p `shouldBe` status204
-
-            r <- get "/compound_pk?k1=eq.12&k2=eq.42"
-            let rows = fromJust (JSON.decode $ simpleBody r :: Maybe [CompoundPK])
-            liftIO $ do
-              length rows `shouldBe` 1
-              let record = head rows
-              compoundK1 record `shouldBe` 12
-              compoundK2 record `shouldBe` 42
-              compoundExtra record `shouldBe` Just 3
-
-          it "can update an existing record" $ do
-            _ <- request methodPut "/compound_pk?k1=eq.12&k2=eq.42" []
-                 [json| { "k1":12, "k2":42, "extra":4 } |]
-            _ <- request methodPut "/compound_pk?k1=eq.12&k2=eq.42" []
-                 [json| { "k1":12, "k2":42, "extra":5 } |]
-
-            r <- get "/compound_pk?k1=eq.12&k2=eq.42"
-            let rows = fromJust (JSON.decode $ simpleBody r :: Maybe [CompoundPK])
-            liftIO $ do
-              length rows `shouldBe` 1
-              let record = head rows
-              compoundExtra record `shouldBe` Just 5
-
-      context "with an auto-incrementing primary key" . after_ (clearTable "auto_incrementing_pk") $
-
-        it "succeeds with 204" $
-          request methodPut "/auto_incrementing_pk?id=eq.1" []
-               [json| {
-                 "id":1,
-                 "nullable_string":"hi",
-                 "non_nullable_string":"bye",
-                 "inserted_at": "2020-11-11"
-               } |]
-            `shouldRespondWith` ResponseMatcher {
-              matchBody    = Nothing,
-              matchStatus  = 204,
-              matchHeaders = []
-            }

  describe "Patching record" $ do

-    context "to unkonwn uri" $
+    context "to unknown uri" $
      it "gives a 404" $
        request methodPatch "/fake" []
          [json| { "real": false } |]
            `shouldRespondWith` 404

    context "on an empty table" $
-      it "succeeds with no effect" $
-        request methodPatch "/simple_pk" []
+      it "indicates no records found to update" $
+        request methodPatch "/empty_table" []
          [json| { "extra":20 } |]
-            `shouldRespondWith` 204
+          `shouldRespondWith` ResponseMatcher {
+            matchBody    = Just "",
+            matchStatus  = 204,
+            matchHeaders = ["Content-Range" <:> "*/*"]
+          }

-    context "in a nonempty table" . before_ (clearTable "items" >> createItems 15) .
-      after_ (clearTable "items") $ do
+    context "in a nonempty table" $ do
      it "can update a single item" $ do
        g <- get "/items?id=eq.42"
        liftIO $ simpleHeaders g
-          `shouldSatisfy` matchHeader "Content-Range" "\\*/0"
-        request methodPatch "/items?id=eq.1" []
-          [json| { "id":42 } |]
-            `shouldRespondWith` 204
+          `shouldSatisfy` matchHeader "Content-Range" "\\*/\\*"
+        p <- request methodPatch "/items?id=eq.2" [] [json| { "id":42 } |]
+        pure p `shouldRespondWith` ResponseMatcher {
+            matchBody    = Nothing,
+            matchStatus  = 204,
+            matchHeaders = ["Content-Range" <:> "0-0/*"]
+          }
+        liftIO $ lookup hContentType (simpleHeaders p) `shouldBe` Nothing
+
+        -- check it really got updated
        g' <- get "/items?id=eq.42"
        liftIO $ simpleHeaders g'
-          `shouldSatisfy` matchHeader "Content-Range" "0-0/1"
+          `shouldSatisfy` matchHeader "Content-Range" "0-0/\\*"
+        -- put value back for other tests
+        void $ request methodPatch "/items?id=eq.42" [] [json| { "id":2 } |]
+
+      it "returns empty array when no rows updated and return=rep" $
+        request methodPatch "/items?id=eq.999999"
+          [("Prefer", "return=representation")] [json| { "id":999999 } |]
+          `shouldRespondWith` ResponseMatcher {
+            matchBody    = Just "[]",
+            matchStatus  = 200,
+            matchHeaders = ["Content-Range" <:> "*/*"]
+          }
+
+      it "returns updated object as array when return=rep" $
+        request methodPatch "/items?id=eq.2"
+          [("Prefer", "return=representation")] [json| { "id":2 } |]
+          `shouldRespondWith` ResponseMatcher {
+            matchBody    = Just [str|[{"id":2}]|],
+            matchStatus  = 200,
+            matchHeaders = ["Content-Range" <:> "0-0/*"]
+          }

      it "can update multiple items" $ do
        replicateM_ 10 $ post "/auto_incrementing_pk"
@@ -244,4 +388,73 @@ spec = afterAll_ resetDb $ around withApp $ do
          [json| { non_nullable_string: "c" } |]
        g <- get "/auto_incrementing_pk?non_nullable_string=eq.c"
        liftIO $ simpleHeaders g
-          `shouldSatisfy` matchHeader "Content-Range" "0-9/10"
+          `shouldSatisfy` matchHeader "Content-Range" "0-9/\\*"
+
+      it "can set a column to NULL" $ do
+        _ <- post "/no_pk" [json| { a: "keepme", b: "nullme" } |]
+        _ <- request methodPatch "/no_pk?b=eq.nullme" [] [json| { b: null } |]
+        get "/no_pk?a=eq.keepme" `shouldRespondWith`
+          [json| [{ a: "keepme", b: null }] |]
+
+      it "can set a json column to escaped value" $ do
+        _ <- post "/json" [json| { data: {"escaped":"bar"} } |]
+        request methodPatch "/json?data->>escaped=eq.bar"
+                     [("Prefer", "return=representation")]
+                     [json| { "data": { "escaped":" \"bar" } } |]
+          `shouldRespondWith` ResponseMatcher {
+            matchBody    = Just [json| [{ "data": { "escaped":" \"bar" } }] |]
+          , matchStatus  = 200
+          , matchHeaders = []
+          }
+
+      it "can update based on a computed column" $
+        request methodPatch
+          "/items?always_true=eq.false"
+          [("Prefer", "return=representation")]
+          [json| { id: 100 } |]
+          `shouldRespondWith` ResponseMatcher {
+            matchBody    = Just "[]",
+            matchStatus  = 200,
+            matchHeaders = ["Content-Range" <:> "*/*"]
+          }
+
+      it "can provide a representation" $ do
+        _ <- post "/items"
+          [json| { id: 1 } |]
+        request methodPatch
+          "/items?id=eq.1"
+          [("Prefer", "return=representation")]
+          [json| { id: 99 } |]
+          `shouldRespondWith` [json| [{id:99}] |]
+
+    context "with unicode values" $
+      it "succeeds and returns values intact" $ do
+        void $ request methodPost "/no_pk" []
+          [json| { "a":"patchme", "b":"patchme" } |]
+        let payload = [json| { "a":"圍棋", "b":"￥" } |]
+        p <- request methodPatch "/no_pk?a=eq.patchme&b=eq.patchme"
+          [("Prefer", "return=representation")] payload
+        liftIO $ do
+          simpleBody p `shouldBe` "["<>payload<>"]"
+          simpleStatus p `shouldBe` ok200
+
+  describe "Row level permission" $
+    it "set user_id when inserting rows" $ do
+      let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJyb2xlIjoicG9zdGdyZXN0X3Rlc3RfYXV0aG9yIiwiaWQiOiJqZG9lIn0.y4vZuu1dDdwAl0-S00MCRWRYMlJ5YAMSir6Es6WtWx0"
+      _ <- post "/postgrest/users" [json| { "id":"jdoe", "pass": "1234", "role": "postgrest_test_author" } |]
+      _ <- post "/postgrest/users" [json| { "id":"jroe", "pass": "1234", "role": "postgrest_test_author" } |]
+
+      p1 <- request methodPost "/authors_only"
+        [ auth, ("Prefer", "return=representation") ]
+        [json| { "secret": "nyancat" } |]
+      liftIO $ do
+        simpleBody p1 `shouldBe` [str|[{"owner":"jdoe","secret":"nyancat"}]|]
+        simpleStatus p1 `shouldBe` created201
+
+      p2 <- request methodPost "/authors_only"
+        -- jwt token for jroe
+        [ authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJyb2xlIjoicG9zdGdyZXN0X3Rlc3RfYXV0aG9yIiwiaWQiOiJqcm9lIn0.YuF_VfmyIxWyuceT7crnNKEprIYXsJAyXid3rjPjIow", ("Prefer", "return=representation") ]
+        [json| { "secret": "lolcat", "owner": "hacker" } |]
+      liftIO $ do
+        simpleBody p2 `shouldBe` [str|[{"owner":"jroe","secret":"lolcat"}]|]
+        simpleStatus p2 `shouldBe` created201
@@ -0,0 +1,25 @@
+module Feature.NoJwtSpec where
+
+-- {{{ Imports
+import Test.Hspec
+import Test.Hspec.Wai
+import Network.HTTP.Types
+
+import SpecHelper
+import Network.Wai (Application)
+
+import Protolude hiding (get)
+-- }}}
+
+spec :: SpecWith Application
+spec = describe "server started without JWT secret" $ do
+
+  -- this test will stop working 9999999999s after the UNIX EPOCH
+  it "responds with error on attempted auth" $ do
+    let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJleHAiOjk5OTk5OTk5OTksInJvbGUiOiJwb3N0Z3Jlc3RfdGVzdF9hdXRob3IiLCJpZCI6Impkb2UifQ.QaPPLWTuyydMu_q7H4noMT7Lk6P4muet1OpJXF6ofhc"
+    request methodGet "/authors_only" [auth] ""
+      `shouldRespondWith` 500
+
+  it "behaves normally when user does not attempt auth" $
+    request methodGet "/items" [] ""
+      `shouldRespondWith` 200
@@ -0,0 +1,15 @@
+module Feature.ProxySpec where
+
+import Test.Hspec hiding (pendingWith)
+
+import SpecHelper
+
+import Network.Wai (Application)
+
+import Protolude hiding (get)
+
+spec :: SpecWith Application
+spec =
+  describe "GET / with proxy" $
+    it "returns a valid openapi spec with proxy" $
+      validateOpenApiResponse [("Accept", "application/openapi+json")]
@@ -0,0 +1,48 @@
+module Feature.QueryLimitedSpec where
+
+import Test.Hspec hiding (pendingWith)
+import Test.Hspec.Wai
+import Test.Hspec.Wai.JSON
+import Network.HTTP.Types
+import Network.Wai.Test (SResponse(simpleHeaders, simpleStatus))
+import Text.Heredoc
+import SpecHelper
+import Network.Wai (Application)
+
+import Protolude hiding (get)
+
+spec :: SpecWith Application
+spec =
+  describe "Requesting many items with server limits enabled" $ do
+    it "restricts results" $
+      get "/items"
+        `shouldRespondWith` ResponseMatcher {
+          matchBody    = Just [json| [{"id":1},{"id":2}] |]
+        , matchStatus  = 200
+        , matchHeaders = ["Content-Range" <:> "0-1/*"]
+        }
+
+    it "respects additional client limiting" $ do
+      r <- request methodGet  "/items"
+                   (rangeHdrs $ ByteRangeFromTo 0 0) ""
+      liftIO $ do
+        simpleHeaders r `shouldSatisfy`
+          matchHeader "Content-Range" "0-0/*"
+        simpleStatus r `shouldBe` ok200
+
+    it "limit works on all levels" $
+      get "/users?select=id,tasks{id}&order=id.asc&tasks.order=id.asc"
+        `shouldRespondWith` ResponseMatcher {
+          matchBody    = Just [str|[{"id":1,"tasks":[{"id":1},{"id":2}]},{"id":2,"tasks":[{"id":5},{"id":6}]}]|]
+        , matchStatus  = 200
+        , matchHeaders = ["Content-Range" <:> "0-1/*"]
+        }
+
+    it "limit is not applied to parent embeds" $
+      get "/tasks?select=id,project{id}&id=gt.5"
+        `shouldRespondWith` ResponseMatcher {
+          matchBody    = Just [str|[{"id":6,"project":{"id":3}},{"id":7,"project":{"id":4}}]|]
+        , matchStatus  = 200
+        , matchHeaders = ["Content-Range" <:> "0-1/*"]
+        }
+
@@ -1,22 +1,28 @@
 module Feature.QuerySpec where

-import Test.Hspec
+import Test.Hspec hiding (pendingWith)
 import Test.Hspec.Wai
 import Test.Hspec.Wai.JSON
-import Network.Wai.Test (SResponse(simpleHeaders))
+import Network.HTTP.Types
+import Network.Wai.Test (SResponse(simpleHeaders,simpleStatus,simpleBody))

 import SpecHelper
+import Text.Heredoc
+import Network.Wai (Application)
+
+import Protolude hiding (get)
+
+spec :: SpecWith Application
+spec = do
+
+  describe "Querying a table with a column called count" $
+    it "should not confuse count column with pg_catalog.count aggregate" $
+      get "/has_count_column" `shouldRespondWith` 200
+
+  describe "Querying a table with a column called t" $
+    it "should not conflict with internal postgrest table alias" $
+      get "/clashing_column?select=t" `shouldRespondWith` 200

-spec :: Spec
-spec =
-  beforeAll (clearTable "items" >> createItems 15)
-   . beforeAll (
-       clearTable "no_pk" >>
-       createNulls 2 >>
-       createLikableStrings >>
-       createJsonData)
-   . afterAll_ (clearTable "items" >> clearTable "no_pk" >> clearTable "simple_pk")
-   . around withApp $ do
  describe "Querying a nonexistent table" $
    it "causes a 404" $
      get "/faketable" `shouldRespondWith` 404
@@ -27,7 +33,32 @@ spec =
        `shouldRespondWith` ResponseMatcher {
          matchBody    = Just [json| [{"id":5}] |]
        , matchStatus  = 200
-        , matchHeaders = ["Content-Range" <:> "0-0/1"]
+        , matchHeaders = ["Content-Range" <:> "0-0/*"]
+        }
+
+    it "matches with equality using not operator" $
+      get "/items?id=not.eq.5"
+        `shouldRespondWith` ResponseMatcher {
+          matchBody    = Just [json| [{"id":1},{"id":2},{"id":3},{"id":4},{"id":6},{"id":7},{"id":8},{"id":9},{"id":10},{"id":11},{"id":12},{"id":13},{"id":14},{"id":15}] |]
+        , matchStatus  = 200
+        , matchHeaders = ["Content-Range" <:> "0-13/*"]
+        }
+
+    it "matches with more than one condition using not operator" $
+      get "/simple_pk?k=like.*yx&extra=not.eq.u" `shouldRespondWith` "[]"
+
+    it "matches with inequality using not operator" $ do
+      get "/items?id=not.lt.14&order=id.asc"
+        `shouldRespondWith` ResponseMatcher {
+          matchBody    = Just [json| [{"id":14},{"id":15}] |]
+        , matchStatus  = 200
+        , matchHeaders = ["Content-Range" <:> "0-1/*"]
+        }
+      get "/items?id=not.gt.2&order=id.asc"
+        `shouldRespondWith` ResponseMatcher {
+          matchBody    = Just [json| [{"id":1},{"id":2}] |]
+        , matchStatus  = 200
+        , matchHeaders = ["Content-Range" <:> "0-1/*"]
        }

    it "matches items IN" $
@@ -35,26 +66,241 @@ spec =
        `shouldRespondWith` ResponseMatcher {
          matchBody    = Just [json| [{"id":1},{"id":3},{"id":5}] |]
        , matchStatus  = 200
-        , matchHeaders = ["Content-Range" <:> "0-2/3"]
+        , matchHeaders = ["Content-Range" <:> "0-2/*"]
        }

-    it "matches nulls" $
+    it "matches items NOT IN" $
+      get "/items?id=notin.2,4,6,7,8,9,10,11,12,13,14,15"
+        `shouldRespondWith` ResponseMatcher {
+          matchBody    = Just [json| [{"id":1},{"id":3},{"id":5}] |]
+        , matchStatus  = 200
+        , matchHeaders = ["Content-Range" <:> "0-2/*"]
+        }
+
+    it "matches items NOT IN using not operator" $
+      get "/items?id=not.in.2,4,6,7,8,9,10,11,12,13,14,15"
+        `shouldRespondWith` ResponseMatcher {
+          matchBody    = Just [json| [{"id":1},{"id":3},{"id":5}] |]
+        , matchStatus  = 200
+        , matchHeaders = ["Content-Range" <:> "0-2/*"]
+        }
+
+    it "matches nulls using not operator" $
+      get "/no_pk?a=not.is.null" `shouldRespondWith`
+        [json| [{"a":"1","b":"0"},{"a":"2","b":"0"}] |]
+
+    it "matches nulls in varchar and numeric fields alike" $ do
      get "/no_pk?a=is.null" `shouldRespondWith`
        [json| [{"a": null, "b": null}] |]

+      get "/nullable_integer?a=is.null" `shouldRespondWith` [str|[{"a":null}]|]
+
    it "matches with like" $ do
      get "/simple_pk?k=like.*yx" `shouldRespondWith`
-        "[{\"k\":\"xyyx\",\"extra\":\"u\"}]"
+        [str|[{"k":"xyyx","extra":"u"}]|]
      get "/simple_pk?k=like.xy*" `shouldRespondWith`
-        "[{\"k\":\"xyyx\",\"extra\":\"u\"}]"
+        [str|[{"k":"xyyx","extra":"u"}]|]
      get "/simple_pk?k=like.*YY*" `shouldRespondWith`
-        "[{\"k\":\"xYYx\",\"extra\":\"v\"}]"
+        [str|[{"k":"xYYx","extra":"v"}]|]
+
+    it "matches with like using not operator" $
+      get "/simple_pk?k=not.like.*yx" `shouldRespondWith`
+        [str|[{"k":"xYYx","extra":"v"}]|]

    it "matches with ilike" $ do
      get "/simple_pk?k=ilike.xy*&order=extra.asc" `shouldRespondWith`
-        "[{\"k\":\"xyyx\",\"extra\":\"u\"},{\"k\":\"xYYx\",\"extra\":\"v\"}]"
+        [str|[{"k":"xyyx","extra":"u"},{"k":"xYYx","extra":"v"}]|]
      get "/simple_pk?k=ilike.*YY*&order=extra.asc" `shouldRespondWith`
-        "[{\"k\":\"xyyx\",\"extra\":\"u\"},{\"k\":\"xYYx\",\"extra\":\"v\"}]"
+        [str|[{"k":"xyyx","extra":"u"},{"k":"xYYx","extra":"v"}]|]
+
+    it "matches with ilike using not operator" $
+      get "/simple_pk?k=not.ilike.xy*&order=extra.asc" `shouldRespondWith` "[]"
+
+    it "matches with tsearch @@" $
+      get "/tsearch?text_search_vector=@@.foo" `shouldRespondWith`
+        [json| [{"text_search_vector":"'bar':2 'foo':1"}] |]
+
+    it "matches with tsearch @@ using not operator" $
+      get "/tsearch?text_search_vector=not.@@.foo" `shouldRespondWith`
+        [json| [{"text_search_vector":"'baz':1 'qux':2"}] |]
+
+    it "matches with computed column" $
+      get "/items?always_true=eq.true&order=id.asc" `shouldRespondWith`
+        [json| [{"id":1},{"id":2},{"id":3},{"id":4},{"id":5},{"id":6},{"id":7},{"id":8},{"id":9},{"id":10},{"id":11},{"id":12},{"id":13},{"id":14},{"id":15}] |]
+
+    it "order by computed column" $
+      get "/items?order=anti_id.desc" `shouldRespondWith`
+        [json| [{"id":1},{"id":2},{"id":3},{"id":4},{"id":5},{"id":6},{"id":7},{"id":8},{"id":9},{"id":10},{"id":11},{"id":12},{"id":13},{"id":14},{"id":15}] |]
+
+    it "matches filtering nested items 2" $
+      get "/clients?select=id,projects{id,tasks2{id,name}}&projects.tasks.name=like.Design*"
+        `shouldRespondWith` ResponseMatcher {
+          matchBody    = Just [json| {"message":"could not find foreign keys between these entities, no relation between projects and tasks2"}|]
+        , matchStatus  = 400
+        , matchHeaders = []
+        }
+
+    it "matches filtering nested items" $
+      get "/clients?select=id,projects{id,tasks{id,name}}&projects.tasks.name=like.Design*" `shouldRespondWith`
+        [str|[{"id":1,"projects":[{"id":1,"tasks":[{"id":1,"name":"Design w7"}]},{"id":2,"tasks":[{"id":3,"name":"Design w10"}]}]},{"id":2,"projects":[{"id":3,"tasks":[{"id":5,"name":"Design IOS"}]},{"id":4,"tasks":[{"id":7,"name":"Design OSX"}]}]}]|]
+
+    it "matches with @> operator" $
+      get "/complex_items?select=id&arr_data=@>.{2}" `shouldRespondWith`
+        [str|[{"id":2},{"id":3}]|]
+
+    it "matches with <@ operator" $
+      get "/complex_items?select=id&arr_data=<@.{1,2,4}" `shouldRespondWith`
+        [str|[{"id":1},{"id":2}]|]
+
+
+  describe "Shaping response with select parameter" $ do
+
+    it "selectStar works in absense of parameter" $
+      get "/complex_items?id=eq.3" `shouldRespondWith`
+        [str|[{"id":3,"name":"Three","settings":{"foo":{"int":1,"bar":"baz"}},"arr_data":[1,2,3],"field-with_sep":1}]|]
+
+    it "dash `-` in column names is accepted" $
+      get "/complex_items?id=eq.3&select=id,field-with_sep" `shouldRespondWith`
+        [str|[{"id":3,"field-with_sep":1}]|]
+
+    it "one simple column" $
+      get "/complex_items?select=id" `shouldRespondWith`
+        [json| [{"id":1},{"id":2},{"id":3}] |]
+
+    it "rename simple column" $
+      get "/complex_items?id=eq.1&select=myId:id" `shouldRespondWith`
+        [json| [{"myId":1}] |]
+
+
+    it "one simple column with casting (text)" $
+      get "/complex_items?select=id::text" `shouldRespondWith`
+        [json| [{"id":"1"},{"id":"2"},{"id":"3"}] |]
+
+    it "rename simple column with casting" $
+      get "/complex_items?id=eq.1&select=myId:id::text" `shouldRespondWith`
+        [json| [{"myId":"1"}] |]
+
+    it "json column" $
+      get "/complex_items?id=eq.1&select=settings" `shouldRespondWith`
+        [json| [{"settings":{"foo":{"int":1,"bar":"baz"}}}] |]
+
+    it "json subfield one level with casting (json)" $
+      get "/complex_items?id=eq.1&select=settings->>foo::json" `shouldRespondWith`
+        [json| [{"foo":{"int":1,"bar":"baz"}}] |] -- the value of foo here is of type "text"
+
+    it "rename json subfield one level with casting (json)" $
+      get "/complex_items?id=eq.1&select=myFoo:settings->>foo::json" `shouldRespondWith`
+        [json| [{"myFoo":{"int":1,"bar":"baz"}}] |] -- the value of foo here is of type "text"
+
+    it "fails on bad casting (data of the wrong format)" $
+      get "/complex_items?select=settings->foo->>bar::integer"
+        `shouldRespondWith` ResponseMatcher {
+          matchBody    = Just [json| {"hint":null,"details":null,"code":"22P02","message":"invalid input syntax for integer: \"baz\""} |]
+        , matchStatus  = 400
+        , matchHeaders = []
+        }
+
+    it "fails on bad casting (wrong cast type)" $
+      get "/complex_items?select=id::fakecolumntype"
+        `shouldRespondWith` ResponseMatcher {
+          matchBody    = Just [json| {"hint":null,"details":null,"code":"42704","message":"type \"fakecolumntype\" does not exist"} |]
+        , matchStatus  = 400
+        , matchHeaders = []
+        }
+
+
+    it "json subfield two levels (string)" $
+      get "/complex_items?id=eq.1&select=settings->foo->>bar" `shouldRespondWith`
+        [json| [{"bar":"baz"}] |]
+
+    it "rename json subfield two levels (string)" $
+      get "/complex_items?id=eq.1&select=myBar:settings->foo->>bar" `shouldRespondWith`
+        [json| [{"myBar":"baz"}] |]
+
+
+    it "json subfield two levels with casting (int)" $
+      get "/complex_items?id=eq.1&select=settings->foo->>int::integer" `shouldRespondWith`
+        [json| [{"int":1}] |] -- the value in the db is an int, but here we expect a string for now
+
+    it "rename json subfield two levels with casting (int)" $
+      get "/complex_items?id=eq.1&select=myInt:settings->foo->>int::integer" `shouldRespondWith`
+        [json| [{"myInt":1}] |] -- the value in the db is an int, but here we expect a string for now
+
+    it "requesting parents and children" $
+      get "/projects?id=eq.1&select=id, name, clients{*}, tasks{id, name}" `shouldRespondWith`
+        [str|[{"id":1,"name":"Windows 7","clients":{"id":1,"name":"Microsoft"},"tasks":[{"id":1,"name":"Design w7"},{"id":2,"name":"Code w7"}]}]|]
+
+    it "embed data with two fk pointing to the same table" $
+      get "/orders?id=eq.1&select=id, name, billing_address_id{id}, shipping_address_id{id}" `shouldRespondWith`
+        [str|[{"id":1,"name":"order 1","billing_address_id":{"id":1},"shipping_address_id":{"id":2}}]|]
+
+
+    it "requesting parents and children while renaming them" $
+      get "/projects?id=eq.1&select=myId:id, name, project_client:client_id{*}, project_tasks:tasks{id, name}" `shouldRespondWith`
+        [str|[{"myId":1,"name":"Windows 7","project_client":{"id":1,"name":"Microsoft"},"project_tasks":[{"id":1,"name":"Design w7"},{"id":2,"name":"Code w7"}]}]|]
+
+    it "requesting parents two levels up while using FK to specify the link" $
+      get "/tasks?id=eq.1&select=id,name,project:project_id{id,name,client:client_id{id,name}}" `shouldRespondWith`
+        [str|[{"id":1,"name":"Design w7","project":{"id":1,"name":"Windows 7","client":{"id":1,"name":"Microsoft"}}}]|]
+
+    it "requesting parents two levels up while using FK to specify the link (with rename)" $
+      get "/tasks?id=eq.1&select=id,name,project:project_id{id,name,client:client_id{id,name}}" `shouldRespondWith`
+        [str|[{"id":1,"name":"Design w7","project":{"id":1,"name":"Windows 7","client":{"id":1,"name":"Microsoft"}}}]|]
+
+
+    it "requesting parents and filtering parent columns" $
+      get "/projects?id=eq.1&select=id, name, clients{id}" `shouldRespondWith`
+        [str|[{"id":1,"name":"Windows 7","clients":{"id":1}}]|]
+
+    it "rows with missing parents are included" $
+      get "/projects?id=in.1,5&select=id,clients{id}" `shouldRespondWith`
+        [str|[{"id":1,"clients":{"id":1}},{"id":5,"clients":null}]|]
+
+    it "rows with no children return [] instead of null" $
+      get "/projects?id=in.5&select=id,tasks{id}" `shouldRespondWith`
+        [str|[{"id":5,"tasks":[]}]|]
+
+    it "requesting children 2 levels" $
+      get "/clients?id=eq.1&select=id,projects{id,tasks{id}}" `shouldRespondWith`
+        [str|[{"id":1,"projects":[{"id":1,"tasks":[{"id":1},{"id":2}]},{"id":2,"tasks":[{"id":3},{"id":4}]}]}]|]
+
+    it "requesting many<->many relation" $
+      get "/tasks?select=id,users{id}" `shouldRespondWith`
+        [str|[{"id":1,"users":[{"id":1},{"id":3}]},{"id":2,"users":[{"id":1}]},{"id":3,"users":[{"id":1}]},{"id":4,"users":[{"id":1}]},{"id":5,"users":[{"id":2},{"id":3}]},{"id":6,"users":[{"id":2}]},{"id":7,"users":[{"id":2}]},{"id":8,"users":[]}]|]
+
+    it "requesting many<->many relation with rename" $
+      get "/tasks?id=eq.1&select=id,theUsers:users{id}" `shouldRespondWith`
+        [str|[{"id":1,"theUsers":[{"id":1},{"id":3}]}]|]
+
+
+    it "requesting many<->many relation reverse" $
+      get "/users?select=id,tasks{id}" `shouldRespondWith`
+        [str|[{"id":1,"tasks":[{"id":1},{"id":2},{"id":3},{"id":4}]},{"id":2,"tasks":[{"id":5},{"id":6},{"id":7}]},{"id":3,"tasks":[{"id":1},{"id":5}]}]|]
+
+    it "requesting parents and children on views" $
+      get "/projects_view?id=eq.1&select=id, name, clients{*}, tasks{id, name}" `shouldRespondWith`
+        [str|[{"id":1,"name":"Windows 7","clients":{"id":1,"name":"Microsoft"},"tasks":[{"id":1,"name":"Design w7"},{"id":2,"name":"Code w7"}]}]|]
+
+    it "requesting parents and children on views with renamed keys" $
+      get "/projects_view_alt?t_id=eq.1&select=t_id, name, clients{*}, tasks{id, name}" `shouldRespondWith`
+        [str|[{"t_id":1,"name":"Windows 7","clients":{"id":1,"name":"Microsoft"},"tasks":[{"id":1,"name":"Design w7"},{"id":2,"name":"Code w7"}]}]|]
+
+
+    it "requesting children with composite key" $
+      get "/users_tasks?user_id=eq.2&task_id=eq.6&select=*, comments{content}" `shouldRespondWith`
+        [str|[{"user_id":2,"task_id":6,"comments":[{"content":"Needs to be delivered ASAP"}]}]|]
+
+    it "detect relations in views from exposed schema that are based on tables in private schema and have columns renames" $
+      get "/articles?id=eq.1&select=id,articleStars{users{*}}" `shouldRespondWith`
+        [str|[{"id":1,"articleStars":[{"users":{"id":1,"name":"Angela Martin"}},{"users":{"id":2,"name":"Michael Scott"}},{"users":{"id":3,"name":"Dwight Schrute"}}]}]|]
+
+    it "can select by column name" $
+      get "/projects?id=in.1,3&select=id,name,client_id,client_id{id,name}" `shouldRespondWith`
+        [str|[{"id":1,"name":"Windows 7","client_id":1,"client_id":{"id":1,"name":"Microsoft"}},{"id":3,"name":"IOS","client_id":2,"client_id":{"id":2,"name":"Apple"}}]|]
+
+    it "can select by column name sans id" $
+      get "/projects?id=in.1,3&select=id,name,client_id,client{id,name}" `shouldRespondWith`
+        [str|[{"id":1,"name":"Windows 7","client_id":1,"client":{"id":1,"name":"Microsoft"}},{"id":3,"name":"IOS","client_id":2,"client":{"id":2,"name":"Apple"}}]|]

  describe "ordering response" $ do
    it "by a column asc" $
@@ -62,14 +308,25 @@ spec =
        `shouldRespondWith` ResponseMatcher {
          matchBody    = Just [json| [{"id":1},{"id":2}] |]
        , matchStatus  = 200
-        , matchHeaders = ["Content-Range" <:> "0-1/2"]
+        , matchHeaders = ["Content-Range" <:> "0-1/*"]
        }
    it "by a column desc" $
      get "/items?id=lte.2&order=id.desc"
        `shouldRespondWith` ResponseMatcher {
          matchBody    = Just [json| [{"id":2},{"id":1}] |]
        , matchStatus  = 200
-        , matchHeaders = ["Content-Range" <:> "0-1/2"]
+        , matchHeaders = ["Content-Range" <:> "0-1/*"]
+        }
+
+    it "by a column with nulls first" $
+      get "/no_pk?order=a.nullsfirst"
+        `shouldRespondWith` ResponseMatcher {
+          matchBody = Just [json| [{"a":null,"b":null},
+                              {"a":"1","b":"0"},
+                              {"a":"2","b":"0"}
+                              ] |]
+        , matchStatus = 200
+        , matchHeaders = ["Content-Range" <:> "0-2/*"]
        }

    it "by a column asc with nulls last" $
@@ -79,7 +336,7 @@ spec =
                              {"a":"2","b":"0"},
                              {"a":null,"b":null}] |]
        , matchStatus = 200
-        , matchHeaders = ["Content-Range" <:> "0-2/3"]
+        , matchHeaders = ["Content-Range" <:> "0-2/*"]
        }

    it "by a column desc with nulls first" $
@@ -89,7 +346,7 @@ spec =
                              {"a":"2","b":"0"},
                              {"a":"1","b":"0"}] |]
        , matchStatus = 200
-        , matchHeaders = ["Content-Range" <:> "0-2/3"]
+        , matchHeaders = ["Content-Range" <:> "0-2/*"]
        }

    it "by a column desc with nulls last" $
@@ -99,11 +356,87 @@ spec =
                              {"a":"1","b":"0"},
                              {"a":null,"b":null}] |]
        , matchStatus = 200
-        , matchHeaders = ["Content-Range" <:> "0-2/3"]
+        , matchHeaders = ["Content-Range" <:> "0-2/*"]
        }

+    it "by a json column property asc" $
+      get "/json?order=data->>id.asc" `shouldRespondWith`
+        [json| [{"data": {"id": 0}}, {"data": {"id": 1, "foo": {"bar": "baz"}}}, {"data": {"id": 3}}] |]
+
+    it "by a json column with two level property nulls first" $
+      get "/json?order=data->foo->>bar.nullsfirst" `shouldRespondWith`
+        [json| [{"data": {"id": 3}}, {"data": {"id": 0}}, {"data": {"id": 1, "foo": {"bar": "baz"}}}] |]
+
    it "without other constraints" $
-      get "/items?order=asc.id" `shouldRespondWith` 200
+      get "/items?order=id.asc" `shouldRespondWith` 200
+
+    it "ordering embeded entities" $
+      get "/projects?id=eq.1&select=id, name, tasks{id, name}&tasks.order=name.asc" `shouldRespondWith`
+        [str|[{"id":1,"name":"Windows 7","tasks":[{"id":2,"name":"Code w7"},{"id":1,"name":"Design w7"}]}]|]
+
+    it "ordering embeded entities with alias" $
+      get "/projects?id=eq.1&select=id, name, the_tasks:tasks{id, name}&tasks.order=name.asc" `shouldRespondWith`
+        [str|[{"id":1,"name":"Windows 7","the_tasks":[{"id":2,"name":"Code w7"},{"id":1,"name":"Design w7"}]}]|]
+
+    it "ordering embeded entities, two levels" $
+      get "/projects?id=eq.1&select=id, name, tasks{id, name, users{id, name}}&tasks.order=name.asc&tasks.users.order=name.desc" `shouldRespondWith`
+        [str|[{"id":1,"name":"Windows 7","tasks":[{"id":2,"name":"Code w7","users":[{"id":1,"name":"Angela Martin"}]},{"id":1,"name":"Design w7","users":[{"id":3,"name":"Dwight Schrute"},{"id":1,"name":"Angela Martin"}]}]}]|]
+
+    it "ordering embeded parents does not break things" $
+      get "/projects?id=eq.1&select=id, name, clients{id, name}&clients.order=name.asc" `shouldRespondWith`
+        [str|[{"id":1,"name":"Windows 7","clients":{"id":1,"name":"Microsoft"}}]|]
+
+    it "ordering embeded parents does not break things when using ducktape names" $
+      get "/projects?id=eq.1&select=id, name, client{id, name}&client.order=name.asc" `shouldRespondWith`
+        [str|[{"id":1,"name":"Windows 7","client":{"id":1,"name":"Microsoft"}}]|]
+
+
+
+  describe "Accept headers" $ do
+    it "should respond an unknown accept type with 415" $
+      request methodGet "/simple_pk"
+              (acceptHdrs "text/unknowntype") ""
+        `shouldRespondWith` 415
+
+    it "should respond correctly to */* in accept header" $
+      request methodGet "/simple_pk"
+              (acceptHdrs "*/*") ""
+        `shouldRespondWith` 200
+
+    it "*/* should rescue an unknown type" $
+      request methodGet "/simple_pk"
+              (acceptHdrs "text/unknowntype, */*") ""
+        `shouldRespondWith` 200
+
+    it "specific available preference should override */*" $ do
+      r <- request methodGet "/simple_pk"
+              (acceptHdrs "text/csv, */*") ""
+      liftIO $ do
+        let respHeaders = simpleHeaders r
+        respHeaders `shouldSatisfy` matchHeader
+          "Content-Type" "text/csv; charset=utf-8"
+
+    it "honors client preference even when opposite of server preference" $ do
+      r <- request methodGet "/simple_pk"
+              (acceptHdrs "text/csv, application/json") ""
+      liftIO $ do
+        let respHeaders = simpleHeaders r
+        respHeaders `shouldSatisfy` matchHeader
+          "Content-Type" "text/csv; charset=utf-8"
+
+    it "should respond correctly to multiple types in accept header" $
+      request methodGet "/simple_pk"
+              (acceptHdrs "text/unknowntype, text/csv") ""
+        `shouldRespondWith` 200
+
+    it "should respond with CSV to 'text/csv' request" $
+      request methodGet "/simple_pk"
+              (acceptHdrs "text/csv; version=1") ""
+        `shouldRespondWith` ResponseMatcher {
+          matchBody    = Just "k,extra\nxyyx,u\nxYYx,v"
+        , matchStatus  = 200
+        , matchHeaders = ["Content-Type" <:> "text/csv; charset=utf-8"]
+        }

  describe "Canonical location" $ do
    it "Sets Content-Location with alphabetized params" $
@@ -121,9 +454,153 @@ spec =
        respHeaders `shouldSatisfy` matchHeader
          "Content-Location" "/simple_pk"

-  describe "jsonb" $
+  describe "jsonb" $ do
    it "can filter by properties inside json column" $ do
      get "/json?data->foo->>bar=eq.baz" `shouldRespondWith`
-        [json| [{"data": {"foo": {"bar": "baz"}}}] |]
+        [json| [{"data": {"id": 1, "foo": {"bar": "baz"}}}] |]
      get "/json?data->foo->>bar=eq.fake" `shouldRespondWith`
        [json| [] |]
+    it "can filter by properties inside json column using not" $
+      get "/json?data->foo->>bar=not.eq.baz" `shouldRespondWith`
+        [json| [] |]
+    it "can filter by properties inside json column using ->>" $
+      get "/json?data->>id=eq.1" `shouldRespondWith`
+        [json| [{"data": {"id": 1, "foo": {"bar": "baz"}}}] |]
+
+  describe "remote procedure call" $ do
+    context "a proc that returns a set" $ do
+      it "returns paginated results" $
+        request methodPost "/rpc/getitemrange"
+                (rangeHdrs (ByteRangeFromTo 0 0))  [json| { "min": 2, "max": 4 } |]
+           `shouldRespondWith` ResponseMatcher {
+              matchBody    = Just [json| [{"id":3}] |]
+            , matchStatus = 200
+            , matchHeaders = ["Content-Range" <:> "0-0/*"]
+            }
+
+      it "includes total count if requested" $
+        request methodPost "/rpc/getitemrange"
+                (rangeHdrsWithCount (ByteRangeFromTo 0 0))
+                [json| { "min": 2, "max": 4 } |]
+           `shouldRespondWith` ResponseMatcher {
+              matchBody    = Just [json| [{"id":3}] |]
+            , matchStatus = 206 -- it now knows the response is partial
+            , matchHeaders = ["Content-Range" <:> "0-0/2"]
+            }
+
+
+      it "returns proper json" $
+        post "/rpc/getitemrange" [json| { "min": 2, "max": 4 } |] `shouldRespondWith`
+          [json| [ {"id": 3}, {"id":4} ] |]
+
+    context "unknown function" $
+      it "returns 404" $
+        post "/rpc/fakefunc" [json| {} |] `shouldRespondWith` 404
+
+    context "shaping the response returned by a proc" $ do
+      it "returns a project" $
+        post "/rpc/getproject" [json| { "id": 1} |] `shouldRespondWith`
+          [str|[{"id":1,"name":"Windows 7","client_id":1}]|]
+
+      it "can filter proc results" $
+        post "/rpc/getallprojects?id=gt.1&id=lt.5&select=id" [json| {} |] `shouldRespondWith`
+          [json|[{"id":2},{"id":3},{"id":4}]|]
+
+      it "can limit proc results" $
+        post "/rpc/getallprojects?id=gt.1&id=lt.5&select=id?limit=2&offset=1" [json| {} |]
+          `shouldRespondWith` ResponseMatcher {
+               matchBody    = Just [json|[{"id":3},{"id":4}]|]
+             , matchStatus = 200
+             , matchHeaders = ["Content-Range" <:> "1-2/*"]
+             }
+
+      it "select works on the first level" $
+        post "/rpc/getproject?select=id,name" [json| { "id": 1} |] `shouldRespondWith`
+          [str|[{"id":1,"name":"Windows 7"}]|]
+
+      it "can embed foreign entities to the items returned by a proc" $
+        post "/rpc/getproject?select=id,name,client{id},tasks{id}" [json| { "id": 1} |] `shouldRespondWith`
+          [str|[{"id":1,"name":"Windows 7","client":{"id":1},"tasks":[{"id":1},{"id":2}]}]|]
+
+    context "a proc that returns an empty rowset" $
+      it "returns empty json array" $
+        post "/rpc/test_empty_rowset" [json| {} |] `shouldRespondWith`
+          [json| [] |]
+
+    context "a proc that returns plain text" $ do
+      it "returns proper json" $
+        post "/rpc/sayhello" [json| { "name": "world" } |] `shouldRespondWith`
+          [json|"Hello, world"|]
+
+      it "can handle unicode" $
+        post "/rpc/sayhello" [json| { "name": "￥" } |] `shouldRespondWith`
+          [json|"Hello, ￥"|]
+
+    context "improper input" $ do
+      it "rejects unknown content type even if payload is good" $
+        request methodPost "/rpc/sayhello"
+          (acceptHdrs "audio/mpeg3") [json| { "name": "world" } |]
+            `shouldRespondWith` 415
+      it "rejects malformed json payload" $ do
+        p <- request methodPost "/rpc/sayhello"
+          (acceptHdrs "application/json") "sdfsdf"
+        liftIO $ do
+          simpleStatus p `shouldBe` badRequest400
+          isErrorFormat (simpleBody p) `shouldBe` True
+      it "treats simple plpgsql raise as invalid input" $ do
+        p <- post "/rpc/problem" "{}"
+        liftIO $ do
+          simpleStatus p `shouldBe` badRequest400
+          isErrorFormat (simpleBody p) `shouldBe` True
+
+    context "unsupported verbs" $ do
+      it "DELETE fails" $
+        request methodDelete "/rpc/sayhello" [] ""
+          `shouldRespondWith` 405
+      it "PATCH fails" $
+        request methodPatch "/rpc/sayhello" [] ""
+          `shouldRespondWith` 405
+      it "OPTIONS fails" $
+        -- TODO: should return info about the function
+        request methodOptions "/rpc/sayhello" [] ""
+          `shouldRespondWith` 405
+      it "GET fails with 405 on unknown procs" $
+        -- TODO: should this be 404?
+        get "/rpc/fake" `shouldRespondWith` 405
+      it "GET with 405 on known procs" $
+        get "/rpc/sayhello" `shouldRespondWith` 405
+
+    it "executes the proc exactly once per request" $ do
+      post "/rpc/callcounter" [json| {} |] `shouldRespondWith`
+        [json|1|]
+      post "/rpc/callcounter" [json| {} |] `shouldRespondWith`
+        [json|2|]
+
+    context "expects a single json object" $ do
+      it "does not expand posted json into parameters" $
+        request methodPost "/rpc/singlejsonparam"
+          [("Prefer","params=single-object")] [json| { "p1": 1, "p2": "text", "p3" : {"obj":"text"} } |] `shouldRespondWith`
+          [json| { "p1": 1, "p2": "text", "p3" : {"obj":"text"} } |]
+
+      it "accepts parameters from an html form" $
+        request methodPost "/rpc/singlejsonparam"
+          [("Prefer","params=single-object"),("Content-Type", "application/x-www-form-urlencoded")]
+          ("integer=7&double=2.71828&varchar=forms+are+fun&" <>
+           "boolean=false&date=1900-01-01&money=$3.99&enum=foo") `shouldRespondWith`
+          [json| { "integer": "7", "double": "2.71828", "varchar" : "forms are fun"
+                 , "boolean":"false", "date":"1900-01-01", "money":"$3.99", "enum":"foo" } |]
+
+  describe "weird requests" $ do
+    it "can query as normal" $ do
+      get "/Escap3e;" `shouldRespondWith`
+        [json| [{"so6meIdColumn":1},{"so6meIdColumn":2},{"so6meIdColumn":3},{"so6meIdColumn":4},{"so6meIdColumn":5}] |]
+      get "/ghostBusters" `shouldRespondWith`
+        [json| [{"escapeId":1},{"escapeId":3},{"escapeId":5}] |]
+
+    it "will embed a collection" $
+      get "/Escap3e;?select=ghostBusters{*}" `shouldRespondWith`
+        [json| [{"ghostBusters":[{"escapeId":1}]},{"ghostBusters":[]},{"ghostBusters":[{"escapeId":3}]},{"ghostBusters":[]},{"ghostBusters":[{"escapeId":5}]}] |]
+
+    it "will embed using a column" $
+      get "/ghostBusters?select=escapeId{*}" `shouldRespondWith`
+        [json| [{"escapeId":{"so6meIdColumn":1}},{"escapeId":{"so6meIdColumn":3}},{"escapeId":{"so6meIdColumn":5}}] |]
@@ -2,21 +2,189 @@ module Feature.RangeSpec where

 import Test.Hspec
 import Test.Hspec.Wai
+import Test.Hspec.Wai.JSON
 import Network.HTTP.Types
 import Network.Wai.Test (SResponse(simpleHeaders,simpleStatus))

+import qualified Data.ByteString.Lazy         as BL
+
 import SpecHelper
+import Text.Heredoc
+import Network.Wai (Application)
+
+import Protolude hiding (get)
+
+defaultRange :: BL.ByteString
+defaultRange = [json| { "min": 0, "max": 15 } |]
+
+emptyRange :: BL.ByteString
+emptyRange = [json| { "min": 2, "max": 2 } |]
+
+spec :: SpecWith Application
+spec = do
+  describe "POST /rpc/getitemrange" $ do
+    context "without range headers" $ do
+      context "with response under server size limit" $
+        it "returns whole range with status 200" $
+           post "/rpc/getitemrange" defaultRange `shouldRespondWith` 200
+
+      context "when I don't want the count" $ do
+        it "returns range Content-Range with */* for empty range" $
+          request methodPost "/rpc/getitemrange" [] emptyRange
+            `shouldRespondWith` ResponseMatcher {
+              matchBody    = Just [json| [] |]
+            , matchStatus  = 200
+            , matchHeaders = ["Content-Range" <:> "*/*"]
+            }
+
+        it "returns range Content-Range with range/*" $
+          request methodPost "/rpc/getitemrange" [] defaultRange
+            `shouldRespondWith` ResponseMatcher {
+              matchBody    = Just [json| [{"id":1},{"id":2},{"id":3},{"id":4},{"id":5},{"id":6},{"id":7},{"id":8},{"id":9},{"id":10},{"id":11},{"id":12},{"id":13},{"id":14},{"id":15}] |]
+            , matchStatus  = 200
+            , matchHeaders = ["Content-Range" <:> "0-14/*"]
+            }
+
+    context "with range headers" $ do
+
+      context "of acceptable range" $ do
+        it "succeeds with partial content" $ do
+          r <- request methodPost  "/rpc/getitemrange"
+                       (rangeHdrs $ ByteRangeFromTo 0 1) defaultRange
+          liftIO $ do
+            simpleHeaders r `shouldSatisfy`
+              matchHeader "Content-Range" "0-1/*"
+            simpleStatus r `shouldBe` ok200
+
+        it "understands open-ended ranges" $
+          request methodPost "/rpc/getitemrange"
+                  (rangeHdrs $ ByteRangeFrom 0) defaultRange
+            `shouldRespondWith` 200
+
+        it "returns an empty body when there are no results" $
+          request methodPost "/rpc/getitemrange"
+                  (rangeHdrs $ ByteRangeFromTo 0 1) emptyRange
+            `shouldRespondWith` ResponseMatcher {
+              matchBody    = Just "[]"
+            , matchStatus  = 200
+            , matchHeaders = ["Content-Range" <:> "*/*"]
+            }
+
+        it "allows one-item requests" $ do
+          r <- request methodPost  "/rpc/getitemrange"
+                       (rangeHdrs $ ByteRangeFromTo 0 0) defaultRange
+          liftIO $ do
+            simpleHeaders r `shouldSatisfy`
+              matchHeader "Content-Range" "0-0/*"
+            simpleStatus r `shouldBe` ok200
+
+        it "handles ranges beyond collection length via truncation" $ do
+          r <- request methodPost  "/rpc/getitemrange"
+                       (rangeHdrs $ ByteRangeFromTo 10 100) defaultRange
+          liftIO $ do
+            simpleHeaders r `shouldSatisfy`
+              matchHeader "Content-Range" "10-14/*"
+            simpleStatus r `shouldBe` ok200
+
+      context "of invalid range" $ do
+        it "fails with 416 for offside range" $
+          request methodPost  "/rpc/getitemrange"
+                  (rangeHdrs $ ByteRangeFromTo 1 0) emptyRange
+            `shouldRespondWith` 416
+
+        it "refuses a range with nonzero start when there are no items" $
+          request methodPost "/rpc/getitemrange"
+                  (rangeHdrsWithCount $ ByteRangeFromTo 1 2) emptyRange
+            `shouldRespondWith` ResponseMatcher {
+              matchBody    = Nothing
+            , matchStatus  = 416
+            , matchHeaders = ["Content-Range" <:> "*/0"]
+            }
+
+        it "refuses a range requesting start past last item" $
+          request methodPost "/rpc/getitemrange"
+                  (rangeHdrsWithCount $ ByteRangeFromTo 100 199) defaultRange
+            `shouldRespondWith` ResponseMatcher {
+              matchBody    = Nothing
+            , matchStatus  = 416
+            , matchHeaders = ["Content-Range" <:> "*/15"]
+            }

-spec :: Spec
-spec = beforeAll (clearTable "items" >> createItems 15) . afterAll_ (clearTable "items")
-  . around withApp $
  describe "GET /items" $ do
-
-    context "without range headers" $
+    context "without range headers" $ do
      context "with response under server size limit" $
        it "returns whole range with status 200" $
          get "/items" `shouldRespondWith` 200

+      context "when I don't want the count" $ do
+        it "returns range Content-Range with /*" $
+          request methodGet "/menagerie"
+                  [("Prefer", "count=none")] ""
+            `shouldRespondWith` ResponseMatcher {
+              matchBody    = Just "[]"
+            , matchStatus  = 200
+            , matchHeaders = ["Content-Range" <:> "*/*"]
+            }
+
+        it "returns range Content-Range with range/*" $
+          request methodGet "/items?order=id"
+                  [("Prefer", "count=none")] ""
+            `shouldRespondWith` ResponseMatcher {
+              matchBody    = Just [json| [{"id":1},{"id":2},{"id":3},{"id":4},{"id":5},{"id":6},{"id":7},{"id":8},{"id":9},{"id":10},{"id":11},{"id":12},{"id":13},{"id":14},{"id":15}] |]
+            , matchStatus  = 200
+            , matchHeaders = ["Content-Range" <:> "0-14/*"]
+            }
+
+        it "returns range Content-Range with range/* even using other filters" $
+          request methodGet "/items?id=eq.1&order=id"
+                  [("Prefer", "count=none")] ""
+            `shouldRespondWith` ResponseMatcher {
+              matchBody    = Just [json| [{"id":1}] |]
+            , matchStatus  = 200
+            , matchHeaders = ["Content-Range" <:> "0-0/*"]
+            }
+
+    context "with limit/offset parameters" $ do
+      it "no parameters return everything" $
+        get "/items?select=id&order=id.asc"
+          `shouldRespondWith` ResponseMatcher {
+            matchBody    = Just [str|[{"id":1},{"id":2},{"id":3},{"id":4},{"id":5},{"id":6},{"id":7},{"id":8},{"id":9},{"id":10},{"id":11},{"id":12},{"id":13},{"id":14},{"id":15}]|]
+          , matchStatus  = 200
+          , matchHeaders = ["Content-Range" <:> "0-14/*"]
+          }
+      it "top level limit with parameter" $
+        get "/items?select=id&order=id.asc&limit=3"
+          `shouldRespondWith` ResponseMatcher {
+            matchBody    = Just [str|[{"id":1},{"id":2},{"id":3}]|]
+          , matchStatus  = 200
+          , matchHeaders = ["Content-Range" <:> "0-2/*"]
+          }
+      it "headers override get parameters" $
+        request methodGet  "/items?select=id&order=id.asc&limit=3"
+                     (rangeHdrs $ ByteRangeFromTo 0 1) ""
+          `shouldRespondWith` ResponseMatcher {
+            matchBody    = Just [str|[{"id":1},{"id":2}]|]
+          , matchStatus  = 200
+          , matchHeaders = ["Content-Range" <:> "0-1/*"]
+          }
+
+      it "limit works on all levels" $
+        get "/clients?select=id,projects{id,tasks{id}}&order=id.asc&limit=1&projects.order=id.asc&projects.limit=2&projects.tasks.order=id.asc&projects.tasks.limit=1"
+          `shouldRespondWith` ResponseMatcher {
+            matchBody    = Just [str|[{"id":1,"projects":[{"id":1,"tasks":[{"id":1}]},{"id":2,"tasks":[{"id":3}]}]}]|]
+          , matchStatus  = 200
+          , matchHeaders = ["Content-Range" <:> "0-0/*"]
+          }
+
+
+      it "limit and offset works on first level" $
+        get "/items?select=id&order=id.asc&limit=3&offset=2"
+          `shouldRespondWith` ResponseMatcher {
+            matchBody    = Just [str|[{"id":3},{"id":4},{"id":5}]|]
+          , matchStatus  = 200
+          , matchHeaders = ["Content-Range" <:> "2-4/*"]
+          }
+
    context "with range headers" $ do

      context "of acceptable range" $ do
@@ -25,8 +193,8 @@ spec = beforeAll (clearTable "items" >> createItems 15) . afterAll_ (clearTable
                       (rangeHdrs $ ByteRangeFromTo 0 1) ""
          liftIO $ do
            simpleHeaders r `shouldSatisfy`
-              matchHeader "Content-Range" "0-1/15"
-            simpleStatus r `shouldBe` partialContent206
+              matchHeader "Content-Range" "0-1/*"
+            simpleStatus r `shouldBe` ok200

        it "understands open-ended ranges" $
          request methodGet "/items"
@@ -39,7 +207,7 @@ spec = beforeAll (clearTable "items" >> createItems 15) . afterAll_ (clearTable
            `shouldRespondWith` ResponseMatcher {
              matchBody    = Just "[]"
            , matchStatus  = 200
-            , matchHeaders = ["Content-Range" <:> "*/0"]
+            , matchHeaders = ["Content-Range" <:> "*/*"]
            }

        it "allows one-item requests" $ do
@@ -47,16 +215,16 @@ spec = beforeAll (clearTable "items" >> createItems 15) . afterAll_ (clearTable
                       (rangeHdrs $ ByteRangeFromTo 0 0) ""
          liftIO $ do
            simpleHeaders r `shouldSatisfy`
-              matchHeader "Content-Range" "0-0/15"
-            simpleStatus r `shouldBe` partialContent206
+              matchHeader "Content-Range" "0-0/*"
+            simpleStatus r `shouldBe` ok200

        it "handles ranges beyond collection length via truncation" $ do
          r <- request methodGet  "/items"
                       (rangeHdrs $ ByteRangeFromTo 10 100) ""
          liftIO $ do
            simpleHeaders r `shouldSatisfy`
-              matchHeader "Content-Range" "10-14/15"
-            simpleStatus r `shouldBe` partialContent206
+              matchHeader "Content-Range" "10-14/*"
+            simpleStatus r `shouldBe` ok200

      context "of invalid range" $ do
        it "fails with 416 for offside range" $
@@ -66,7 +234,7 @@ spec = beforeAll (clearTable "items" >> createItems 15) . afterAll_ (clearTable

        it "refuses a range with nonzero start when there are no items" $
          request methodGet "/menagerie"
-                  (rangeHdrs $ ByteRangeFromTo 1 2) ""
+                  (rangeHdrsWithCount $ ByteRangeFromTo 1 2) ""
            `shouldRespondWith` ResponseMatcher {
              matchBody    = Nothing
            , matchStatus  = 416
@@ -75,7 +243,7 @@ spec = beforeAll (clearTable "items" >> createItems 15) . afterAll_ (clearTable

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

 import Test.Hspec hiding (pendingWith)
 import Test.Hspec.Wai
-import Test.Hspec.Wai.JSON
+import Network.HTTP.Types
+
+import Control.Lens ((^?))
+import Data.Aeson.Lens
+import Data.Aeson.QQ

 import SpecHelper

-import Network.HTTP.Types
+import Network.Wai (Application)
+import Network.Wai.Test (SResponse(..))

-spec :: Spec
-spec = around withApp $ do
-  describe "GET /" $ do
-    it "lists views in schema" $
-      request methodGet "/" [] ""
-        `shouldRespondWith` [json| [
-          {"schema":"1","name":"auto_incrementing_pk","insertable":true}
-        , {"schema":"1","name":"compound_pk","insertable":true}
-        , {"schema":"1","name":"has_fk","insertable":true}
-        , {"schema":"1","name":"items","insertable":true}
-        , {"schema":"1","name":"json","insertable":true}
-        , {"schema":"1","name":"menagerie","insertable":true}
-        , {"schema":"1","name":"no_pk","insertable":true}
-        , {"schema":"1","name":"simple_pk","insertable":true}
-        ] |]
-        {matchStatus = 200}
+import Protolude hiding (get)

-    it "lists only views user has permission to see" $ do
-      _ <- post "/postgrest/users" [json| { "id":"jdoe", "pass": "1234", "role": "postgrest_test_author" } |]
-      let auth = authHeader "jdoe" "1234"
+spec :: SpecWith Application
+spec = do

-      request methodGet "/" [auth] ""
-        `shouldRespondWith` [json| [
-            {"schema":"1","name":"authors_only","insertable":true}
-        ] |]
-        {matchStatus = 200}
+  describe "OpenAPI" $ do
+    it "root path returns a valid openapi spec" $
+      validateOpenApiResponse [("Accept", "application/openapi+json")]

+    it "should respond to openapi request on none root path with 415" $
+      request methodGet "/items"
+              (acceptHdrs "application/openapi+json") ""
+        `shouldRespondWith` 415

-  describe "Table info" $ do
-    it "is available with OPTIONS verb" $
-      request methodOptions "/menagerie" [] "" `shouldRespondWith`
-      [json|
-      {
-        "pkey":["integer"],
-        "columns":[
-          {
-            "default": null,
-            "precision": 32,
-            "updatable": true,
-            "schema": "1",
-            "name": "integer",
-            "type": "integer",
-            "maxLen": null,
-            "enum": [],
-            "nullable": false,
-            "position": 1,
-            "references": null,
-            "default": null
-          }, {
-            "default": null,
-            "precision": 53,
-            "updatable": true,
-            "schema": "1",
-            "name": "double",
-            "type": "double precision",
-            "maxLen": null,
-            "enum": [],
-            "nullable": false,
-            "references": null,
-            "position": 2
-          }, {
-            "default": null,
-            "precision": null,
-            "updatable": true,
-            "schema": "1",
-            "name": "varchar",
-            "type": "character varying",
-            "maxLen": null,
-            "enum": [],
-            "nullable": false,
-            "position": 3,
-            "references": null,
-            "default": null
-          }, {
-            "default": null,
-            "precision": null,
-            "updatable": true,
-            "schema": "1",
-            "name": "boolean",
-            "type": "boolean",
-            "maxLen": null,
-            "enum": [],
-            "nullable": false,
-            "references": null,
-            "position": 4
-          }, {
-            "default": null,
-            "precision": null,
-            "updatable": true,
-            "schema": "1",
-            "name": "date",
-            "type": "date",
-            "maxLen": null,
-            "enum": [],
-            "nullable": false,
-            "references": null,
-            "position": 5
-          }, {
-            "default": null,
-            "precision": null,
-            "updatable": true,
-            "schema": "1",
-            "name": "money",
-            "type": "money",
-            "maxLen": null,
-            "enum": [],
-            "nullable": false,
-            "position": 6,
-            "references": null,
-            "default": null
-          }, {
-            "default": null,
-            "precision": null,
-            "updatable": true,
-            "schema": "1",
-            "name": "enum",
-            "type": "USER-DEFINED",
-            "maxLen": null,
-            "enum": [
-              "foo",
-              "bar"
-            ],
-            "nullable": false,
-            "position": 7,
-            "references": null,
-            "default": null
-          }
-        ]
-      }
-      |]
+    describe "RPC" $

-    it "includes foreign key data" $ do
-      pendingWith "have to resolve issue #107"
+      it "includes a representative function with parameters" $ do
+        r <- simpleBody <$> get "/"
+        let ref = r ^? key "paths" . key "/rpc/varied_arguments"
+                     . key "post"  . key "parameters"
+                     . nth 1       . key "schema"
+                     . key "$ref"  . _String
+            args = r ^? key "definitions" . key "(rpc) varied_arguments"

-      request methodOptions "/has_fk" [] ""
-        `shouldRespondWith` [json|
-      {
-        "pkey": ["id"],
-        "columns":[
-          {
-            "default": "nextval('\"1\".has_fk_id_seq'::regclass)",
-            "precision": 64,
-            "updatable": true,
-            "schema": "1",
-            "name": "id",
-            "type": "bigint",
-            "maxLen": null,
-            "nullable": false,
-            "position": 1,
-            "enum": [],
-            "references": null
-          }, {
-            "default": null,
-            "precision": 32,
-            "updatable": true,
-            "schema": "1",
-            "name": "auto_inc_fk",
-            "type": "integer",
-            "maxLen": null,
-            "nullable": true,
-            "position": 2,
-            "enum": [],
-            "references": {"table": "auto_incrementing_pk", "column": "id"}
-          }, {
-            "default": null,
-            "precision": null,
-            "updatable": true,
-            "schema": "1",
-            "name": "simple_fk",
-            "type": "character varying",
-            "maxLen": 255,
-            "nullable": true,
-            "position": 3,
-            "enum": [],
-            "references": {"table": "simple_pk", "column": "k"}
-          }
-        ]
-      }
-      |]
+        liftIO $ do
+          ref `shouldBe` Just "#/definitions/(rpc) varied_arguments"
+          args `shouldBe` Just
+            [aesonQQ|
+              {
+                "required": [
+                  "double",
+                  "varchar",
+                  "boolean",
+                  "date",
+                  "money",
+                  "enum"
+                ],
+                "properties": {
+                  "double": {
+                    "format": "double precision",
+                    "type": "string"
+                  },
+                  "varchar": {
+                    "format": "character varying",
+                    "type": "string"
+                  },
+                  "boolean": {
+                    "format": "boolean",
+                    "type": "boolean"
+                  },
+                  "date": {
+                    "format": "date",
+                    "type": "string"
+                  },
+                  "money": {
+                    "format": "money",
+                    "type": "string"
+                  },
+                  "enum": {
+                    "format": "test.enum_menagerie_type",
+                    "type": "string"
+                  },
+                  "integer": {
+                    "format": "integer",
+                    "type": "integer"
+                  }
+                },
+                "type": "object"
+              }
+            |]
+
+  describe "Allow header" $ do
+
+    it "includes read/write verbs for writeable table" $ do
+      r <- request methodOptions "/items" [] ""
+      liftIO $
+        simpleHeaders r `shouldSatisfy`
+          matchHeader "Allow" "GET,POST,PATCH,DELETE"
+
+    it "includes read verbs for read-only table" $ do
+      r <- request methodOptions "/has_count_column" [] ""
+      liftIO $
+        simpleHeaders r `shouldSatisfy`
+          matchHeader "Allow" "GET"
@@ -0,0 +1,22 @@
+module Feature.UnicodeSpec where
+
+import Test.Hspec
+import Test.Hspec.Wai
+import Test.Hspec.Wai.JSON
+import Network.Wai (Application)
+import Control.Monad (void)
+
+import Protolude hiding (get)
+
+spec :: SpecWith Application
+spec =
+  describe "Reading and writing to unicode schema and table names" $
+    it "Can read and write values" $ do
+      get "/%D9%85%D9%88%D8%A7%D8%B1%D8%AF"
+        `shouldRespondWith` "[]"
+
+      void $ post "/%D9%85%D9%88%D8%A7%D8%B1%D8%AF"
+        [json| { "هویت": 1 } |]
+
+      get "/%D9%85%D9%88%D8%A7%D8%B1%D8%AF"
+        `shouldRespondWith` [json| [{ "هویت": 1 }] |]
@@ -2,7 +2,86 @@ module Main where

 import Test.Hspec
 import SpecHelper
-import Spec
+
+import qualified Hasql.Pool as P
+
+import PostgREST.DbStructure (getDbStructure)
+import PostgREST.App (postgrest)
+import Control.AutoUpdate
+import Data.Function (id)
+import Data.IORef
+import Data.Time.Clock.POSIX   (getPOSIXTime)
+
+import qualified Feature.AuthSpec
+import qualified Feature.BinaryJwtSecretSpec
+import qualified Feature.ConcurrentSpec
+import qualified Feature.CorsSpec
+import qualified Feature.DeleteSpec
+import qualified Feature.InsertSpec
+import qualified Feature.NoJwtSpec
+import qualified Feature.QueryLimitedSpec
+import qualified Feature.QuerySpec
+import qualified Feature.RangeSpec
+import qualified Feature.StructureSpec
+import qualified Feature.SingularSpec
+import qualified Feature.UnicodeSpec
+import qualified Feature.ProxySpec
+
+import Protolude

 main :: IO ()
-main = resetDb >> hspec spec
+main = do
+  testDbConn <- getEnvVarWithDefault "POSTGREST_TEST_CONNECTION" "postgres://postgrest_test@localhost/postgrest_test"
+  setupDb testDbConn
+
+  pool <- P.acquire (3, 10, toS testDbConn)
+  -- ask for the OS time at most once per second
+  getTime <- mkAutoUpdate
+    defaultUpdateSettings { updateAction = getPOSIXTime }
+
+
+  result <- P.use pool $ getDbStructure "test"
+  refDbStructure <- newIORef $ either (panic.show) id result
+  let withApp      = return $ postgrest (testCfg testDbConn)          refDbStructure pool getTime
+      ltdApp       = return $ postgrest (testLtdRowsCfg testDbConn)   refDbStructure pool getTime
+      unicodeApp   = return $ postgrest (testUnicodeCfg testDbConn)   refDbStructure pool getTime
+      proxyApp     = return $ postgrest (testProxyCfg testDbConn)     refDbStructure pool getTime
+      noJwtApp     = return $ postgrest (testCfgNoJWT testDbConn)     refDbStructure pool getTime
+      binaryJwtApp = return $ postgrest (testCfgBinaryJWT testDbConn) refDbStructure pool getTime
+
+  let reset = resetDb testDbConn
+  hspec $ do
+    mapM_ (beforeAll_ reset . before withApp) specs
+
+    -- this test runs with a different server flag
+    beforeAll_ reset . before ltdApp $
+      describe "Feature.QueryLimitedSpec" Feature.QueryLimitedSpec.spec
+
+    -- this test runs with a different schema
+    beforeAll_ reset . before unicodeApp $
+      describe "Feature.UnicodeSpec" Feature.UnicodeSpec.spec
+
+    -- this test runs with a proxy
+    beforeAll_ reset . before proxyApp $
+      describe "Feature.ProxySpec" Feature.ProxySpec.spec
+
+    -- this test runs without a JWT secret
+    beforeAll_ reset . before noJwtApp $
+      describe "Feature.NoJwtSpec" Feature.NoJwtSpec.spec
+
+    -- this test runs with a binary JWT secret
+    beforeAll_ reset . before binaryJwtApp $
+      describe "Feature.BinaryJwtSecretSpec" Feature.BinaryJwtSecretSpec.spec
+
+ where
+  specs = map (uncurry describe) [
+      ("Feature.AuthSpec"         , Feature.AuthSpec.spec)
+    , ("Feature.ConcurrentSpec"   , Feature.ConcurrentSpec.spec)
+    , ("Feature.CorsSpec"         , Feature.CorsSpec.spec)
+    , ("Feature.DeleteSpec"       , Feature.DeleteSpec.spec)
+    , ("Feature.InsertSpec"       , Feature.InsertSpec.spec)
+    , ("Feature.QuerySpec"        , Feature.QuerySpec.spec)
+    , ("Feature.RangeSpec"        , Feature.RangeSpec.spec)
+    , ("Feature.SingularSpec"     , Feature.SingularSpec.spec)
+    , ("Feature.StructureSpec"    , Feature.StructureSpec.spec)
+    ]
@@ -1 +0,0 @@
-{-# OPTIONS_GHC -F -pgmF hspec-discover -optF --no-main #-}
@@ -1,144 +1,140 @@
 module SpecHelper where

-import Network.Wai
-import Test.Hspec
-import Test.Hspec.Wai
-
-import Hasql as H
-import Hasql.Backend as B
-import Hasql.Postgres as P
-
-import Data.String.Conversions (cs)
-import Data.Monoid
-import Data.Text hiding (map)
-import qualified Data.Vector as V
 import Control.Monad (void)

-import Network.HTTP.Types.Header (Header, ByteRange, renderByteRange,
-                                  hRange, hAuthorization)
-import Codec.Binary.Base64.String (encode)
+import qualified System.IO.Error as E
+import System.Environment (getEnv)
+
+import qualified Data.ByteString.Base64 as B64 (encode, decodeLenient)
 import Data.CaseInsensitive (CI(..))
-import Data.Maybe (fromMaybe)
+import qualified Data.Set as S
+import qualified Data.Map.Strict as M
+import Data.List (lookup)
 import Text.Regex.TDFA ((=~))
 import qualified Data.ByteString.Char8 as BS
-import Network.Wai.Middleware.Cors (cors)
+import qualified Data.ByteString.Lazy as BL
 import System.Process (readProcess)

-import qualified Data.Aeson.Types as J
+import PostgREST.Config (AppConfig(..))

-import App (app)
-import Config (AppConfig(..), corsPolicy)
-import Middleware
-import Error(errResponse)
+import Test.Hspec hiding (pendingWith)
+import Test.Hspec.Wai

-isLeft :: Either a b -> Bool
-isLeft (Left _ ) = True
-isLeft _ = False
+import Network.HTTP.Types
+import Network.Wai.Test (SResponse(simpleStatus, simpleHeaders, simpleBody))

-cfg :: AppConfig
-cfg = AppConfig "postgrest_test" 5432 "postgrest_test" "" "localhost" 3000 "postgrest_anonymous" False 10 "1"
+import Data.Maybe (fromJust)
+import Data.Aeson (decode, Value(..))
+import qualified Data.JsonSchema.Draft4 as D4

-testPoolOpts :: PoolSettings
-testPoolOpts = fromMaybe (error "bad settings") $ H.poolSettings 1 30
+import Protolude

-pgSettings :: P.Settings
-pgSettings = P.ParamSettings (cs $ configDbHost cfg)
-                             (fromIntegral $ configDbPort cfg)
-                             (cs $ configDbUser cfg)
-                             (cs $ configDbPass cfg)
-                             (cs $ configDbName cfg)
+validateOpenApiResponse :: [Header] -> WaiSession ()
+validateOpenApiResponse headers = do
+  r <- request methodGet "/" headers ""
+  liftIO $
+    let respStatus = simpleStatus r in
+    respStatus `shouldSatisfy`
+      \s -> s == Status { statusCode = 200, statusMessage="OK" }
+  liftIO $
+    let respHeaders = simpleHeaders r in
+    respHeaders `shouldSatisfy`
+      \hs -> ("Content-Type", "application/openapi+json; charset=utf-8") `elem` hs
+  liftIO $
+    let respBody = simpleBody r
+        schema :: D4.Schema
+        schema = D4.emptySchema { D4._schemaRef = Just "openapi.json" }
+        schemaContext :: D4.SchemaWithURI D4.Schema
+        schemaContext = D4.SchemaWithURI
+          { D4._swSchema = schema
+          , D4._swURI    = Just "test/fixtures/openapi.json"
+          }
+       in
+       D4.fetchFilesystemAndValidate schemaContext ((fromJust . decode) respBody) `shouldReturn` Right ()

-withApp :: ActionWith Application -> IO ()
-withApp perform = do
-  let anonRole = cs $ configAnonRole cfg
-      currRole = cs $ configDbUser cfg
-  pool :: H.Pool P.Postgres
-    <- H.acquirePool pgSettings testPoolOpts
+getEnvVarWithDefault :: Text -> Text -> IO Text
+getEnvVarWithDefault var def = do
+  varValue <- getEnv (toS var) `E.catchIOError` const (return $ toS def)
+  return $ toS varValue

-  perform $ middle $ \req resp -> do
-    body <- strictRequestBody req
-    result <- liftIO $ H.session pool $ H.tx Nothing
-      $ authenticated currRole anonRole (app (cs $ configV1Schema cfg) body) req
-    either (resp . errResponse) resp result
+_baseCfg :: AppConfig
+_baseCfg =  -- Connection Settings
+  AppConfig mempty "postgrest_test_anonymous" Nothing "test" "localhost" 3000
+            -- Jwt settings
+            (Just $ encodeUtf8 "safe") False
+            -- Connection Modifiers
+            10 Nothing (Just "test.switch_role")
+            -- Debug Settings
+            True

-  where middle = cors corsPolicy
+testCfg :: Text -> AppConfig
+testCfg testDbConn = _baseCfg { configDatabase = testDbConn }
+
+testCfgNoJWT :: Text -> AppConfig
+testCfgNoJWT testDbConn = (testCfg testDbConn) { configJwtSecret = Nothing }
+
+testUnicodeCfg :: Text -> AppConfig
+testUnicodeCfg testDbConn = (testCfg testDbConn) { configSchema = "تست" }
+
+testLtdRowsCfg :: Text -> AppConfig
+testLtdRowsCfg testDbConn = (testCfg testDbConn) { configMaxRows = Just 2 }
+
+testProxyCfg :: Text -> AppConfig
+testProxyCfg testDbConn = (testCfg testDbConn) { configProxyUri = Just "https://postgrest.com/openapi.json" }
+
+testCfgBinaryJWT :: Text -> AppConfig
+testCfgBinaryJWT testDbConn = (testCfg testDbConn) { configJwtSecret = Just secretBs }
+  where secretBs = B64.decodeLenient "h2CGB1FoBd51aQooCS2g+UmRgYQfTPQ6v3+9ALbaqM4="


-resetDb :: IO ()
-resetDb = do
-  pool :: H.Pool P.Postgres
-    <- H.acquirePool pgSettings testPoolOpts
-  void . liftIO $ H.session pool $
-    H.tx Nothing $ do
-      H.unitEx [H.stmt| drop schema if exists "1" cascade |]
-      H.unitEx [H.stmt| drop schema if exists private cascade |]
-      H.unitEx [H.stmt| drop schema if exists postgrest cascade |]
+setupDb :: Text -> IO ()
+setupDb dbConn = do
+  loadFixture dbConn "database"
+  loadFixture dbConn "roles"
+  loadFixture dbConn "schema"
+  loadFixture dbConn "jwt"
+  loadFixture dbConn "privileges"
+  resetDb dbConn

-  loadFixture "roles"
-  loadFixture "schema"
-
-
-loadFixture :: FilePath -> IO()
-loadFixture name =
-  void $ readProcess "psql" ["-U", "postgrest_test", "-d", "postgrest_test", "-a", "-f", "test/fixtures/" ++ name ++ ".sql"] []
+resetDb :: Text -> IO ()
+resetDb dbConn = loadFixture dbConn "data"

+loadFixture :: Text -> FilePath -> IO()
+loadFixture dbConn name =
+  void $ readProcess "psql" [toS dbConn, "-a", "-f", "test/fixtures/" ++ name ++ ".sql"] []

 rangeHdrs :: ByteRange -> [Header]
 rangeHdrs r = [rangeUnit, (hRange, renderByteRange r)]

+rangeHdrsWithCount :: ByteRange -> [Header]
+rangeHdrsWithCount r = ("Prefer", "count=exact") : rangeHdrs r
+
+acceptHdrs :: BS.ByteString -> [Header]
+acceptHdrs mime = [(hAccept, mime)]
+
 rangeUnit :: Header
 rangeUnit = ("Range-Unit" :: CI BS.ByteString, "items")

-matchHeader :: CI BS.ByteString -> String -> [Header] -> Bool
+matchHeader :: CI BS.ByteString -> BS.ByteString -> [Header] -> Bool
 matchHeader name valRegex headers =
  maybe False (=~ valRegex) $ lookup name headers

-authHeader :: String -> String -> Header
-authHeader u p =
-  (hAuthorization, cs $ "Basic " ++ encode (u ++ ":" ++ p))
+authHeaderBasic :: BS.ByteString -> BS.ByteString -> Header
+authHeaderBasic u p =
+  (hAuthorization, "Basic " <> (toS . B64.encode . toS $ u <> ":" <> p))

-testPool :: IO(H.Pool P.Postgres)
-testPool = H.acquirePool pgSettings testPoolOpts
+authHeaderJWT :: BS.ByteString -> Header
+authHeaderJWT token =
+  (hAuthorization, "Bearer " <> token)

-clearTable :: Text -> IO ()
-clearTable table = do
-  pool <- testPool
-  void . liftIO $ H.session pool $ H.tx Nothing $
-    H.unitEx $ B.Stmt ("delete from \"1\"."<>table) V.empty True
-
-createItems :: Int -> IO ()
-createItems n = do
-  pool <- testPool
-  void . liftIO $ H.session pool $ H.tx Nothing txn
-  where
-    txn = mapM_ H.unitEx stmts
-    stmts = map [H.stmt|insert into "1".items (id) values (?)|] [1..n]
-
-createNulls :: Int -> IO ()
-createNulls n = do
-  pool <- testPool
-  void . liftIO $ H.session pool $ H.tx Nothing txn
-  where
-    txn = mapM_ H.unitEx (stmt':stmts)
-    stmt' = [H.stmt|insert into "1".no_pk (a,b) values (null,null)|]
-    stmts = map [H.stmt|insert into "1".no_pk (a,b) values (?,0)|] [1..n]
-
-createLikableStrings :: IO ()
-createLikableStrings = do
-  pool <- testPool
-  void . liftIO $ H.session pool $ H.tx Nothing $ do
-    H.unitEx $ insertSimplePk "xyyx" "u"
-    H.unitEx $ insertSimplePk "xYYx" "v"
-  where
-    insertSimplePk :: Text -> Text -> H.Stmt P.Postgres
-    insertSimplePk = [H.stmt|insert into "1".simple_pk (k, extra) values (?,?)|]
-
-createJsonData :: IO ()
-createJsonData = do
-  pool <- testPool
-  void . liftIO $ H.session pool $ H.tx Nothing $
-    H.unitEx $
-      [H.stmt|
-        insert into "1".json (data) values (?)
-      |]
-      (J.object [("foo", J.object [("bar", J.String "baz")])])
+-- | Tests whether the text can be parsed as a json object comtaining
+-- the key "message", and optional keys "details", "hint", "code",
+-- and no extraneous keys
+isErrorFormat :: BL.ByteString -> Bool
+isErrorFormat s =
+  "message" `S.member` keys &&
+    S.null (S.difference keys validKeys)
+ where
+  obj = decode s :: Maybe (M.Map Text Value)
+  keys = fromMaybe S.empty (M.keysSet <$> obj)
+  validKeys = S.fromList ["message", "details", "hint", "code"]
@@ -1,21 +1,18 @@
 module TestTypes (
  IncPK(..)
 , CompoundPK(..)
-- , incFromList
-- , compoundFromList
 ) where

 import qualified Data.Aeson as JSON
 import Data.Aeson ((.:))
-- import Data.Maybe (fromJust)
-import Control.Applicative ((<$>), (<*>))
-import Control.Monad (mzero)
+
+import Protolude

 data IncPK = IncPK {
  incId :: Int
-, incNullableStr :: Maybe String
-, incStr :: String
-, incInsert :: String
+, incNullableStr :: Maybe Text
+, incStr :: Text
+, incInsert :: Text
 } deriving (Eq, Show)

 instance JSON.FromJSON IncPK where
@@ -26,18 +23,11 @@ instance JSON.FromJSON IncPK where
    r .: "inserted_at"
  parseJSON _ = mzero

-- incFromList :: [(String, SqlValue)] -> IncPK
-- incFromList row = IncPK
--   (fromSql . fromJust $ lookup "id" row)
--   (fromSql . fromJust $ lookup "nullable_string" row)
--   (fromSql . fromJust $ lookup "non_nullable_string" row)
--   (fromSql . fromJust $ lookup "inserted_at" row)
-
 data CompoundPK = CompoundPK {
  compoundK1 :: Int
-, compoundK2 :: Int
+, compoundK2 :: Text
 , compoundExtra :: Maybe Int
-}
+} deriving (Eq, Show)

 instance JSON.FromJSON CompoundPK where
  parseJSON (JSON.Object r) = CompoundPK <$>
@@ -45,9 +35,3 @@ instance JSON.FromJSON CompoundPK where
    r .: "k2" <*>
    r .: "extra"
  parseJSON _ = mzero
-
-- compoundFromList :: [(String, SqlValue)] -> CompoundPK
-- compoundFromList row = CompoundPK
--   (fromSql . fromJust $ lookup "k1" row)
--   (fromSql . fromJust $ lookup "k2" row)
--   (fromSql . fromJust $ lookup "extra" row)
@@ -1,7 +1,7 @@
-module Unit.PgStructureSpec where
+module Unit.DbStructureSpec where

 import Test.Hspec
-import PgStructure (Table(..), tables, Column(..), columns, ForeignKey(..),
+import DbStructure (Table(..), tables, Column(..), columns, ForeignKey(..),
  foreignKeys)

 import Database.HDBC (quickQuery)
@@ -12,25 +12,25 @@ spec :: Spec
 spec = around dbWithSchema $ beforeWith setRole $ do
  describe "tables" $
    it "shows all the tables" $ \conn -> do
-      ts <- tables "1" conn
+      ts <- tables "test" conn
      map tableName ts `shouldBe` ["authors_only","auto_incrementing_pk",
-        "compound_pk","has_fk","items","menagerie","no_pk", "simple_pk"]
+        "compound_pk","has_fk","insertable_view_with_join","items","menagerie","no_pk", "simple_pk"]

  describe "columns" $ do
    it "responds with each column for the table" $ \conn -> do
-      cs <- columns "1" "auto_incrementing_pk" conn
+      cs <- columns "test" "auto_incrementing_pk" conn
      map colName cs `shouldBe` ["id","nullable_string","non_nullable_string",
        "inserted_at"]

    it "includes foreign key data" $ \conn -> do
-      cs <- columns "1" "has_fk" conn
+      cs <- columns "test" "has_fk" conn
      map colFK cs `shouldBe` [Nothing,
        Just $ ForeignKey "auto_incrementing_pk" "id",
        Just $ ForeignKey "simple_pk" "k"]

  describe "foreignKeys" $
    it "has a description of the foreign key columns" $ \conn ->
-      foreignKeys "1" "has_fk" conn `shouldReturn` M.fromList [
+      foreignKeys "test" "has_fk" conn `shouldReturn` M.fromList [
        ("auto_inc_fk", ForeignKey {fkTable="auto_incrementing_pk", fkCol="id"}),
        ("simple_fk", ForeignKey { fkTable="simple_pk", fkCol="k"})]

@@ -32,7 +32,7 @@ spec = around dbWithSchema $ do
  describe "insert" $
    describe "with an auto-increment key" $ do
      it "inserts and responds with a full object description" $ \conn -> do
-        r <- insert "1" "auto_incrementing_pk" (SqlRow [
+        r <- insert "test" "auto_incrementing_pk" (SqlRow [
            ("non_nullable_string", toSql ("a string"::String))]) conn
        let returnRow = incFromList . toList $ r
        incStr returnRow `shouldBe` "a string"
@@ -43,24 +43,24 @@ spec = around dbWithSchema $ do
        [returnRow] `shouldBe` map incFromList tRows

      it "throws an exception if the PK is not unique" $ \conn -> do
-        r <- insert "1" "auto_incrementing_pk" (SqlRow [
+        r <- insert "test" "auto_incrementing_pk" (SqlRow [
            ("non_nullable_string", toSql ("a string"::String))]) conn
        let row = SqlRow .  map (Control.Arrow.first cs) . toList $ r
-        insert "1" "auto_incrementing_pk" row conn `shouldThrow` \e ->
+        insert "test" "auto_incrementing_pk" row conn `shouldThrow` \e ->
          seState e == "23505" -- uniqueness violation code

      it "throws an exception if a required value is missing" $ \conn ->
-        insert "1" "auto_incrementing_pk" (SqlRow [
+        insert "test" "auto_incrementing_pk" (SqlRow [
          ("nullable_string", toSql ("a string"::String))]) conn
          `shouldThrow` \e -> seState e == "23502"

      it "generates a default values query if no data is provided" $ \c -> do
-        r <- insert "1" "items" (SqlRow []) c
+        r <- insert "test" "items" (SqlRow []) c
        let [row] = toList r
        quickALQuery c "select * from \"1\".items where id = ?" [snd row]
          `shouldReturn` [[row]]

-  let {user = "jdoe"; pass = "secret"; role = "test_default_role"}
+  let {user = "jdoe"; pass = "secret"; role = "postgrest_test_default_role"}
  describe "addUser" $ do
    it "adds a correct user to the right table" $ \conn -> do
      addUser user pass role conn
@@ -79,7 +79,7 @@ spec = around dbWithSchema $ do
    addUser user pass role conn
    return conn) $ do
    it "accepts correct credentials and return the role" $ \conn ->
-      signInRole user pass conn `shouldReturn` LoginSuccess role
+      signInRole user pass conn `shouldReturn` LoginSuccess role user

    it "returns nothing with bad creds" $ \conn -> do
      signInRole "not-a-user" pass conn `shouldReturn` LoginFailed
@@ -0,0 +1,56 @@
+#! /bin/bash
+if [ -z "$1" ]
+  then
+    echo "Please supply the connection uri for the user with create database privileges"
+    exit -1
+fi
+
+if [ -z "$2" ]
+  then
+    echo "Please supply the test database name"
+    exit -1
+fi
+if [[ $1 != postgres://* ]]
+then
+  echo "Please use a valid connection URI (https://www.postgresql.org/docs/current/static/libpq-connect.html#AEN45347)"
+  exit -1
+fi
+
+BASEPATH=$( cd $(dirname $0) ; pwd -P )
+#Remove database path from the connection uri--prevents setting up the new database name with PGDATABASE
+URI=$(echo $1 | cut -d'/' -f1-3)
+#Extract host and port--we need this to form the new connection string
+HOST_PORT=$(echo $URI | cut -d'/' -f3 | cut -d'@' -f2 )
+DB=$2
+# Specify the username of choice, or let the script create a random unique user by appending the database name
+TEST_USER_NAME=postgrest_test_authenticator
+# New password will get assigned only if the user does not already exist
+# Otherwise make sure to provide the correct password for the existing user
+TEST_USER_PASS=$(cat /dev/urandom | env LC_CTYPE=C tr -dc 'a-zA-Z0-9' | fold -w 16 | head -n 1)
+
+PGOPTIONS='-c client_min_messages=WARNING' psql "$URI" -Xq >/dev/null -c 'select rolcreatedb from pg_authid where rolname = current_user;' 2>/dev/null
+if [ $? -ne 0 ]; then
+  echo "ERROR: Please specify the user with 'Create DB' permissions, and ensure that the default database for the username exists."
+  exit 1
+fi
+
+# plpgsql does not like psql variables, easier to pull this part off with bash variables
+PGOPTIONS='-c client_min_messages=WARNING' psql "$URI" -Xq >/dev/null <<EOF
+SELECT pg_terminate_backend(pg_stat_activity.pid)
+FROM pg_stat_activity
+WHERE pg_stat_activity.datname = '$DB'
+  AND pid <> pg_backend_pid();
+
+DROP DATABASE IF EXISTS $DB;
+DROP ROLE IF EXISTS $TEST_USER_NAME;
+CREATE USER $TEST_USER_NAME WITH LOGIN NOINHERIT PASSWORD '$TEST_USER_PASS' CREATEROLE;
+CREATE DATABASE $DB OWNER $TEST_USER_NAME;
+EOF
+
+PGDATABASE=$DB PGOPTIONS='-c client_min_messages=WARNING' psql "$URI" --set=db=$DB -Xq <<EOF
+  CREATE EXTENSION IF NOT EXISTS pgcrypto;
+  ALTER DATABASE ${DB} SET request.jwt.claim.id = '-1';
+EOF
+
+# Create a new connection string to use with the test runner
+echo 'postgres://'${TEST_USER_NAME}':'$TEST_USER_PASS'@'$HOST_PORT'/'$DB
@@ -0,0 +1,66 @@
+#! /bin/bash
+if [ -z "$1" ]
+  then
+    echo "Please supply the connection uri for the user with create database privileges"
+    exit -1
+fi
+
+if [ -z "$2" ]
+  then
+    echo "Please supply the test database name"
+    exit -1
+fi
+if [[ $1 != postgres://* ]]
+then
+  echo "Please use a valid connection URI (https://www.postgresql.org/docs/current/static/libpq-connect.html#AEN45347)"
+  exit -1
+fi
+
+BASEPATH=$( cd $(dirname $0) ; pwd -P )
+#Remove database path from the connection uri
+URI=$(echo $1 | cut -d'/' -f1-3)
+DB=$2
+
+PGOPTIONS='-c client_min_messages=WARNING' psql "$URI" -Xq >/dev/null -c 'select rolcreatedb from pg_authid where rolname = current_user;' 2>/dev/null
+if [ $? -ne 0 ]; then
+  echo "ERROR: Please specify the user with 'Create DB' permissions, and ensure that the default database for the username exists."
+  exit 1
+fi
+
+# plpgsql does not like psql variables, easier to pull this part off with bash variables
+PGOPTIONS='-c client_min_messages=WARNING' psql "$URI" -Xq >/dev/null <<EOF
+SELECT pg_terminate_backend(pg_stat_activity.pid)
+FROM pg_stat_activity
+WHERE pg_stat_activity.datname = '$DB'
+  AND pid <> pg_backend_pid();
+
+drop database if exists "$DB";
+
+-- Find all test users that were members of role 'postgrest_test_author'--that way we don't have to know the 
+-- test user name (in case it was auto-generated).
+DO \$\$
+DECLARE
+    mem text;
+BEGIN
+    FOR mem IN 
+      SELECT pg_get_userbyid(member)
+      FROM pg_roles r 
+      JOIN pg_auth_members m
+      ON m.roleid = r.oid 
+      WHERE rolname = 'postgrest_test_author' 
+    LOOP
+      EXECUTE 'drop role '|| mem || ';';
+    END LOOP;
+END \$\$;
+
+DO \$\$
+DECLARE
+    r text;
+BEGIN
+    FOR r IN 
+      VALUES('postgrest_test_author'),('postgrest_test_anonymous'),('postgrest_test_default_role')
+    LOOP    
+      EXECUTE 'drop role if exists '|| r || ';';
+    END LOOP;
+END \$\$;
+EOF
@@ -0,0 +1,288 @@
+--
+-- PostgreSQL database dump
+--
+
+-- Dumped from database version 9.5beta1
+-- Dumped by pg_dump version 9.5beta1
+
+SET statement_timeout = 0;
+SET lock_timeout = 0;
+SET client_encoding = 'UTF8';
+SET standard_conforming_strings = on;
+SET check_function_bodies = false;
+SET client_min_messages = warning;
+
+SET search_path = postgrest, pg_catalog;
+
+--
+-- Data for Name: auth; Type: TABLE DATA; Schema: postgrest; Owner: -
+--
+
+TRUNCATE TABLE auth CASCADE;
+INSERT INTO auth VALUES ('jdoe', 'postgrest_test_author', '1234                                                        ');
+
+
+SET search_path = private, pg_catalog;
+
+--
+-- Data for Name: articles; Type: TABLE DATA; Schema: private; Owner: -
+--
+
+TRUNCATE TABLE articles CASCADE;
+INSERT INTO articles VALUES (1, 'No… It''s a thing; it''s like a plan, but with more greatness.', 'diogo');
+INSERT INTO articles VALUES (2, 'Stop talking, brain thinking. Hush.', 'diogo');
+INSERT INTO articles VALUES (3, 'It''s a fez. I wear a fez now. Fezes are cool.', 'diogo');
+
+
+SET search_path = test, pg_catalog;
+
+--
+-- Data for Name: users; Type: TABLE DATA; Schema: test; Owner: -
+--
+
+TRUNCATE TABLE users CASCADE;
+INSERT INTO users VALUES (1, 'Angela Martin');
+INSERT INTO users VALUES (2, 'Michael Scott');
+INSERT INTO users VALUES (3, 'Dwight Schrute');
+
+
+SET search_path = private, pg_catalog;
+
+--
+-- Data for Name: article_stars; Type: TABLE DATA; Schema: private; Owner: -
+--
+
+TRUNCATE TABLE article_stars CASCADE;
+INSERT INTO article_stars VALUES (1, 1, '2015-12-08 04:22:57.472738');
+INSERT INTO article_stars VALUES (1, 2, '2015-12-08 04:22:57.472738');
+INSERT INTO article_stars VALUES (2, 3, '2015-12-08 04:22:57.472738');
+INSERT INTO article_stars VALUES (3, 2, '2015-12-08 04:22:57.472738');
+INSERT INTO article_stars VALUES (1, 3, '2015-12-08 04:22:57.472738');
+
+
+SET search_path = test, pg_catalog;
+
+--
+-- Data for Name: authors_only; Type: TABLE DATA; Schema: test; Owner: -
+--
+TRUNCATE TABLE authors_only CASCADE;
+
+
+--
+-- Data for Name: auto_incrementing_pk; Type: TABLE DATA; Schema: test; Owner: -
+--
+TRUNCATE TABLE auto_incrementing_pk CASCADE;
+
+
+--
+-- Name: auto_incrementing_pk_id_seq; Type: SEQUENCE SET; Schema: test; Owner: -
+--
+
+SELECT pg_catalog.setval('auto_incrementing_pk_id_seq', 1, true);
+
+
+--
+-- Data for Name: clients; Type: TABLE DATA; Schema: test; Owner: -
+--
+
+TRUNCATE TABLE clients CASCADE;
+INSERT INTO clients VALUES (1, 'Microsoft');
+INSERT INTO clients VALUES (2, 'Apple');
+
+
+--
+-- Data for Name: projects; Type: TABLE DATA; Schema: test; Owner: -
+--
+
+TRUNCATE TABLE projects CASCADE;
+INSERT INTO projects VALUES (1, 'Windows 7', 1);
+INSERT INTO projects VALUES (2, 'Windows 10', 1);
+INSERT INTO projects VALUES (3, 'IOS', 2);
+INSERT INTO projects VALUES (4, 'OSX', 2);
+INSERT INTO projects VALUES (5, 'Orphan', NULL);
+
+
+--
+-- Data for Name: tasks; Type: TABLE DATA; Schema: test; Owner: -
+--
+
+TRUNCATE TABLE tasks CASCADE;
+INSERT INTO tasks VALUES (1, 'Design w7', 1);
+INSERT INTO tasks VALUES (2, 'Code w7', 1);
+INSERT INTO tasks VALUES (3, 'Design w10', 2);
+INSERT INTO tasks VALUES (4, 'Code w10', 2);
+INSERT INTO tasks VALUES (5, 'Design IOS', 3);
+INSERT INTO tasks VALUES (6, 'Code IOS', 3);
+INSERT INTO tasks VALUES (7, 'Design OSX', 4);
+INSERT INTO tasks VALUES (8, 'Code OSX', 4);
+
+
+--
+-- Data for Name: users_tasks; Type: TABLE DATA; Schema: test; Owner: -
+--
+
+TRUNCATE TABLE users_tasks CASCADE;
+INSERT INTO users_tasks VALUES (1, 1);
+INSERT INTO users_tasks VALUES (1, 2);
+INSERT INTO users_tasks VALUES (1, 3);
+INSERT INTO users_tasks VALUES (1, 4);
+INSERT INTO users_tasks VALUES (2, 5);
+INSERT INTO users_tasks VALUES (2, 6);
+INSERT INTO users_tasks VALUES (2, 7);
+INSERT INTO users_tasks VALUES (3, 1);
+INSERT INTO users_tasks VALUES (3, 5);
+
+
+--
+-- Data for Name: comments; Type: TABLE DATA; Schema: test; Owner: -
+--
+
+TRUNCATE TABLE comments CASCADE;
+INSERT INTO comments VALUES (1, 1, 2, 6, 'Needs to be delivered ASAP');
+
+
+--
+-- Data for Name: complex_items; Type: TABLE DATA; Schema: test; Owner: -
+--
+
+TRUNCATE TABLE complex_items CASCADE;
+INSERT INTO complex_items VALUES (1, 'One', '{"foo":{"int":1,"bar":"baz"}}', '{1}');
+INSERT INTO complex_items VALUES (2, 'Two', '{"foo":{"int":1,"bar":"baz"}}', '{1,2}');
+INSERT INTO complex_items VALUES (3, 'Three', '{"foo":{"int":1,"bar":"baz"}}', '{1,2,3}');
+
+
+--
+-- Data for Name: compound_pk; Type: TABLE DATA; Schema: test; Owner: -
+--
+TRUNCATE TABLE compound_pk CASCADE;
+
+
+--
+-- Data for Name: simple_pk; Type: TABLE DATA; Schema: test; Owner: -
+--
+
+TRUNCATE TABLE simple_pk CASCADE;
+INSERT INTO simple_pk VALUES ('xyyx', 'u');
+INSERT INTO simple_pk VALUES ('xYYx', 'v');
+
+--
+-- Data for Name: has_fk; Type: TABLE DATA; Schema: test; Owner: -
+--
+TRUNCATE TABLE has_fk CASCADE;
+
+
+--
+-- Name: has_fk_id_seq; Type: SEQUENCE SET; Schema: test; Owner: -
+--
+
+SELECT pg_catalog.setval('has_fk_id_seq', 1, false);
+
+
+--
+-- Data for Name: items; Type: TABLE DATA; Schema: test; Owner: -
+--
+
+TRUNCATE TABLE items CASCADE;
+INSERT INTO items VALUES (1);
+INSERT INTO items VALUES (2);
+INSERT INTO items VALUES (3);
+INSERT INTO items VALUES (4);
+INSERT INTO items VALUES (5);
+INSERT INTO items VALUES (6);
+INSERT INTO items VALUES (7);
+INSERT INTO items VALUES (8);
+INSERT INTO items VALUES (9);
+INSERT INTO items VALUES (10);
+INSERT INTO items VALUES (11);
+INSERT INTO items VALUES (12);
+INSERT INTO items VALUES (13);
+INSERT INTO items VALUES (14);
+INSERT INTO items VALUES (15);
+
+
+--
+-- Name: items_id_seq; Type: SEQUENCE SET; Schema: test; Owner: -
+--
+
+SELECT pg_catalog.setval('items_id_seq', 15, true);
+
+
+--
+-- Data for Name: json; Type: TABLE DATA; Schema: test; Owner: -
+--
+
+TRUNCATE TABLE json CASCADE;
+INSERT INTO json VALUES ('{"foo":{"bar":"baz"},"id":1}');
+INSERT INTO json VALUES ('{"id":3}');
+INSERT INTO json VALUES ('{"id":0}');
+
+
+--
+-- Data for Name: menagerie; Type: TABLE DATA; Schema: test; Owner: -
+--
+TRUNCATE TABLE menagerie CASCADE;
+
+
+--
+-- Data for Name: no_pk; Type: TABLE DATA; Schema: test; Owner: -
+--
+
+TRUNCATE TABLE no_pk CASCADE;
+INSERT INTO no_pk VALUES (NULL, NULL);
+INSERT INTO no_pk VALUES ('1', '0');
+INSERT INTO no_pk VALUES ('2', '0');
+
+
+--
+-- Data for Name: nullable_integer; Type: TABLE DATA; Schema: test; Owner: -
+--
+
+TRUNCATE TABLE nullable_integer CASCADE;
+INSERT INTO nullable_integer VALUES (NULL);
+
+
+--
+-- Data for Name: tsearch; Type: TABLE DATA; Schema: test; Owner: -
+--
+
+TRUNCATE TABLE tsearch CASCADE;
+INSERT INTO tsearch VALUES ('''bar'':2 ''foo'':1');
+INSERT INTO tsearch VALUES ('''baz'':1 ''qux'':2');
+
+
+--
+-- Data for Name: users_projects; Type: TABLE DATA; Schema: test; Owner: -
+--
+
+TRUNCATE TABLE users_projects CASCADE;
+INSERT INTO users_projects VALUES (1, 1);
+INSERT INTO users_projects VALUES (1, 2);
+INSERT INTO users_projects VALUES (2, 3);
+INSERT INTO users_projects VALUES (2, 4);
+INSERT INTO users_projects VALUES (3, 1);
+INSERT INTO users_projects VALUES (3, 3);
+
+TRUNCATE TABLE "Escap3e;" CASCADE;
+INSERT INTO "Escap3e;" VALUES (1), (2), (3), (4), (5);
+
+TRUNCATE TABLE "ghostBusters" CASCADE;
+INSERT INTO "ghostBusters" VALUES (1), (3), (5);
+
+TRUNCATE TABLE "withUnique" CASCADE;
+INSERT INTO "withUnique" VALUES ('nodup', 'blah');
+
+
+
+TRUNCATE TABLE addresses CASCADE;
+INSERT INTO addresses VALUES (1, 'address 1');
+INSERT INTO addresses VALUES (2, 'address 2');
+INSERT INTO addresses VALUES (3, 'address 3');
+INSERT INTO addresses VALUES (4, 'address 4');
+
+TRUNCATE TABLE orders CASCADE;
+INSERT INTO orders VALUES (1, 'order 1', 1, 2);
+INSERT INTO orders VALUES (2, 'order 2', 3, 4);
+
+--
+-- PostgreSQL database dump complete
+--
@@ -0,0 +1,3 @@
+set client_min_messages to warning;
+DROP SCHEMA IF EXISTS test, private, postgrest, jwt, تست CASCADE;
+DROP TYPE IF EXISTS jwt_token CASCADE;
@@ -0,0 +1,151 @@
+{
+    "id": "draft04.json",
+    "$schema": "draft04.json",
+    "description": "Core schema meta-schema",
+    "definitions": {
+        "schemaArray": {
+            "type": "array",
+            "minItems": 1,
+            "items": { "$ref": "#" }
+        },
+        "positiveInteger": {
+            "type": "integer",
+            "minimum": 0
+        },
+        "positiveIntegerDefault0": {
+            "allOf": [ { "$ref": "#/definitions/positiveInteger" }, { "default": 0 } ]
+        },
+        "simpleTypes": {
+            "enum": [ "array", "boolean", "integer", "null", "number", "object", "string" ]
+        },
+        "stringArray": {
+            "type": "array",
+            "items": { "type": "string" },
+            "minItems": 1,
+            "uniqueItems": true
+        }
+    },
+    "type": "object",
+    "properties": {
+        "id": {
+            "type": "string",
+            "format": "uri"
+        },
+        "$schema": {
+            "type": "string",
+            "format": "uri"
+        },
+        "title": {
+            "type": "string"
+        },
+        "description": {
+            "type": "string"
+        },
+        "default": {},
+        "multipleOf": {
+            "type": "number",
+            "minimum": 0,
+            "exclusiveMinimum": true
+        },
+        "maximum": {
+            "type": "number"
+        },
+        "exclusiveMaximum": {
+            "type": "boolean",
+            "default": false
+        },
+        "minimum": {
+            "type": "number"
+        },
+        "exclusiveMinimum": {
+            "type": "boolean",
+            "default": false
+        },
+        "maxLength": { "$ref": "#/definitions/positiveInteger" },
+        "minLength": { "$ref": "#/definitions/positiveIntegerDefault0" },
+        "pattern": {
+            "type": "string",
+            "format": "regex"
+        },
+        "additionalItems": {
+            "anyOf": [
+                { "type": "boolean" },
+                { "$ref": "#" }
+            ],
+            "default": {}
+        },
+        "items": {
+            "anyOf": [
+                { "$ref": "#" },
+                { "$ref": "#/definitions/schemaArray" }
+            ],
+            "default": {}
+        },
+        "maxItems": { "$ref": "#/definitions/positiveInteger" },
+        "minItems": { "$ref": "#/definitions/positiveIntegerDefault0" },
+        "uniqueItems": {
+            "type": "boolean",
+            "default": false
+        },
+        "maxProperties": { "$ref": "#/definitions/positiveInteger" },
+        "minProperties": { "$ref": "#/definitions/positiveIntegerDefault0" },
+        "required": { "$ref": "#/definitions/stringArray" },
+        "additionalProperties": {
+            "anyOf": [
+                { "type": "boolean" },
+                { "$ref": "#" }
+            ],
+            "default": {}
+        },
+        "definitions": {
+            "type": "object",
+            "additionalProperties": { "$ref": "#" },
+            "default": {}
+        },
+        "properties": {
+            "type": "object",
+            "additionalProperties": { "$ref": "#" },
+            "default": {}
+        },
+        "patternProperties": {
+            "type": "object",
+            "additionalProperties": { "$ref": "#" },
+            "default": {}
+        },
+        "dependencies": {
+            "type": "object",
+            "additionalProperties": {
+                "anyOf": [
+                    { "$ref": "#" },
+                    { "$ref": "#/definitions/stringArray" }
+                ]
+            }
+        },
+        "enum": {
+            "type": "array",
+            "minItems": 1,
+            "uniqueItems": true
+        },
+        "type": {
+            "anyOf": [
+                { "$ref": "#/definitions/simpleTypes" },
+                {
+                    "type": "array",
+                    "items": { "$ref": "#/definitions/simpleTypes" },
+                    "minItems": 1,
+                    "uniqueItems": true
+                }
+            ]
+        },
+        "format": { "type": "string" },
+        "allOf": { "$ref": "#/definitions/schemaArray" },
+        "anyOf": { "$ref": "#/definitions/schemaArray" },
+        "oneOf": { "$ref": "#/definitions/schemaArray" },
+        "not": { "$ref": "#" }
+    },
+    "dependencies": {
+        "exclusiveMaximum": [ "maximum" ],
+        "exclusiveMinimum": [ "minimum" ]
+    },
+    "default": {}
+}
@@ -0,0 +1,65 @@
+-- From michelp/pgjwt commit c02bbd3
+BEGIN;
+set client_min_messages to warning;
+DROP SCHEMA IF EXISTS jwt CASCADE;
+CREATE SCHEMA jwt;
+
+
+CREATE OR REPLACE FUNCTION jwt.url_encode(data bytea) RETURNS text LANGUAGE sql AS $$
+    SELECT translate(encode(data, 'base64'), E'+/=\n', '-_');
+$$;
+
+
+CREATE OR REPLACE FUNCTION jwt.url_decode(data text) RETURNS bytea LANGUAGE sql AS $$
+WITH t AS (SELECT translate(data, '-_', '+/')),
+     rem AS (SELECT length((SELECT * FROM t)) % 4) -- compute padding size
+    SELECT decode(
+        (SELECT * FROM t) ||
+        CASE WHEN (SELECT * FROM rem) > 0
+           THEN repeat('=', (4 - (SELECT * FROM rem)))
+           ELSE '' END,
+    'base64');
+$$;
+
+
+CREATE OR REPLACE FUNCTION jwt.algorithm_sign(signables text, secret text, algorithm text)
+RETURNS text LANGUAGE sql AS $$
+WITH
+  alg AS (
+    SELECT CASE
+      WHEN algorithm = 'HS256' THEN 'sha256'
+      WHEN algorithm = 'HS384' THEN 'sha384'
+      WHEN algorithm = 'HS512' THEN 'sha512'
+      ELSE '' END)  -- hmac throws error
+SELECT jwt.url_encode(hmac(signables, secret, (select * FROM alg)));
+$$;
+
+
+CREATE OR REPLACE FUNCTION jwt.sign(payload json, secret text, algorithm text DEFAULT 'HS256')
+RETURNS text LANGUAGE sql AS $$
+WITH
+  header AS (
+    SELECT jwt.url_encode(convert_to('{"alg":"' || algorithm || '","typ":"JWT"}', 'utf8'))
+    ),
+  payload AS (
+    SELECT jwt.url_encode(convert_to(payload::text, 'utf8'))
+    ),
+  signables AS (
+    SELECT (SELECT * FROM header) || '.' || (SELECT * FROM payload)
+    )
+SELECT
+    (SELECT * FROM signables)
+    || '.' ||
+    jwt.algorithm_sign((SELECT * FROM signables), secret, algorithm);
+$$;
+
+
+CREATE OR REPLACE FUNCTION jwt.verify(token text, secret text, algorithm text DEFAULT 'HS256')
+RETURNS table(header json, payload json, valid boolean) LANGUAGE sql AS $$
+  SELECT
+    convert_from(jwt.url_decode(r[1]), 'utf8')::json AS header,
+    convert_from(jwt.url_decode(r[2]), 'utf8')::json AS payload,
+    r[3] = jwt.algorithm_sign(r[1] || '.' || r[2], secret, algorithm) AS valid
+  FROM regexp_split_to_array(token, '\.') r;
+$$;
+COMMIT;
@@ -0,0 +1,63 @@
+-- Privileges for anonymous
+GRANT USAGE ON SCHEMA
+      postgrest
+    , test
+    , jwt
+    , "تست"
+TO postgrest_test_anonymous;
+
+-- Schema test objects
+SET search_path = test, "تست", pg_catalog;
+
+GRANT ALL ON TABLE
+    items
+    , "articleStars"
+    , articles
+    , auto_incrementing_pk
+    , clients
+    , comments
+    , complex_items
+    , compound_pk
+    , empty_table
+    , has_count_column
+    , has_fk
+    , insertable_view_with_join
+    , json
+    , materialized_view
+    , menagerie
+    , no_pk
+    , nullable_integer
+    , projects
+    , projects_view
+    , projects_view_alt
+    , simple_pk
+    , tasks
+    , filtered_tasks
+    , tsearch
+    , users
+    , users_projects
+    , users_tasks
+    , "Escap3e;"
+    , "ghostBusters"
+    , "withUnique"
+    , "clashing_column"
+    , "موارد"
+    , addresses
+    , orders
+TO postgrest_test_anonymous;
+
+GRANT INSERT ON TABLE insertonly TO postgrest_test_anonymous;
+
+GRANT USAGE ON SEQUENCE
+      auto_incrementing_pk_id_seq
+    , items_id_seq
+    , callcounter_count
+TO postgrest_test_anonymous;
+
+-- Privileges for non anonymous users
+GRANT USAGE ON SCHEMA test TO postgrest_test_author;
+GRANT ALL ON TABLE authors_only TO postgrest_test_author;
+
+GRANT SELECT (article_id, user_id) ON TABLE limited_article_stars TO postgrest_test_anonymous;
+GRANT INSERT (article_id, user_id) ON TABLE limited_article_stars TO postgrest_test_anonymous;
+GRANT UPDATE (article_id, user_id) ON TABLE limited_article_stars TO postgrest_test_anonymous;
@@ -1,16 +1,7 @@
-create function pg_temp.create_role_if_not_exists(rolename name, opts character varying) RETURNS text
-  LANGUAGE plpgsql
-  AS $$
-BEGIN
-  IF NOT EXISTS (SELECT * FROM pg_roles WHERE rolname = rolename) THEN
-    EXECUTE format('CREATE ROLE %I %s', rolename, opts);
-    RETURN 'CREATE ROLE';
-  ELSE
-    RETURN format('ROLE ''%I'' ALREADY EXISTS', rolename);
-  END IF;
-END;
-$$;
+\set AUTHENTICATOR current_user
+DROP ROLE IF EXISTS postgrest_test_anonymous, postgrest_test_default_role, postgrest_test_author;
+CREATE ROLE postgrest_test_anonymous;
+CREATE ROLE postgrest_test_default_role;
+CREATE ROLE postgrest_test_author;

-select pg_temp.create_role_if_not_exists('postgrest_anonymous', 'with nologin') as a
-     , pg_temp.create_role_if_not_exists('test_default_role', 'with nologin') as b
-     , pg_temp.create_role_if_not_exists('postgrest_test_author', 'with nologin') into temp shh;
+GRANT postgrest_test_anonymous, postgrest_test_default_role, postgrest_test_author TO :USER;
				`@@ -1 +0,0 @@`
				`{-# OPTIONS_GHC -F -pgmF hspec-discover -optF --no-main #-}`