v0.3.0.4

Do not block threads on libpq ffi

.gitignore

@@ -1,3 +1,4 @@
+.DS_Store
 db
 dist
 .cabal-sandbox
@@ -5,3 +6,6 @@ cabal.sandbox.config
 hscope.out
 codex.tags
 .anvil
+.stack-work
+tags
+site

.travis.yml

@@ -1,22 +0,0 @@
-language: haskell
-ghc: 7.8
-addons:
-  postgresql: "9.3"
-notifications:
-  slack: looprecur:z2nPS2Cfx2D33LE2obyU2FyQ
-before_install:
-  - createuser --superuser --no-password dbapi_test
-  - createdb -O dbapi_test -U postgres dbapi_test
-  - travis_retry sudo add-apt-repository -y ppa:hvr/ghc
-  - travis_retry sudo apt-get update
-  - travis_retry sudo apt-get install --force-yes happy-1.19.3 alex-3.1.3
-  - export PATH=/opt/alex/3.1.3/bin:/opt/happy/1.19.3/bin:$PATH
-install:
-  - travis_retry curl http://bin.begriffs.com/dbapi/cabal-sandbox.tar.xz | tar xJ
-  - chmod a+x .cabal-sandbox/bin/*
-  - cabal sandbox init
-  - cabal install --enable-test --dependencies-only
-  - cabal install --enable-test
-script:
-  - cabal test --show-details=always --test-options="--color"
-  - .cabal-sandbox/bin/hlint src/*.hs test/**/*.hs

CHANGELOG.md

@@ -0,0 +1,157 @@
+# Change Log
+
+All notable changes to this project will be documented in this file.
+This project adheres to [Semantic Versioning](http://semver.org/).
+
+## Unreleased
+
+### Fixed
+
+## [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`
+- Filter nulls, `?col=is.null` and `?col=isnot.null`
+- Filter within jsonb, `?col->a->>b=eq.c`
+- Accept CSV in post body for bulk inserts
+
+### Fixed
+- Allow NULL values in posts
+- Show full command line usage on param errors
+
+## [0.2.7.0] - 2015-03-03
+### Added
+- Server response logging
+- Filter IN values, e.g. `?col=in.1,2,3`
+- Return POSTed resource if header "Prefer: return=representation"
+- Allow override of default (v1) schema
+
+## [0.2.6.0] - 2015-02-18
+### Added
+- A changelog
+- Filter by substring match, e.g. `?col=like.*hello*` (or ilike for
+  case insensitivity).
+- Access-Control-Expose-Headers for CORS
+
+### Fixed
+- Make filter position match docs, e.g. `?order=col.asc` rather
+  than `?order=asc.col`.

CONTRIBUTING.md

@@ -0,0 +1,59 @@
+# 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).
+
+## 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](https://github.com/begriffs/postgrest/wiki/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.

README.md

@@ -1,43 +1,171 @@
-## Serve a RESTful API from any Postgres database
+![Logo](static/logo.png "Logo")
 
-[![Build Status](https://travis-ci.org/begriffs/dbapi.svg?branch=master)](https://travis-ci.org/begriffs/dbapi)
+[![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="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)
 
-### Installation
+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.
 
-```sh
-brew install postgres
-cabal install -j --enable-tests
-```
+### Demo [postgrest.herokuapp.com](https://postgrest.herokuapp.com) | Read [Docs](http://postgrest.com/) | Watch [Video](http://begriffs.com/posts/2014-12-30-intro-to-postgrest.html)
 
-Example usage:
 
-```sh
-cabal run -p 3000 -d postgres://[auth-role]:@localhost:5432/[database] -a [anonymous-role]
-```
+Try making requests to the live demo server with an HTTP client
+such as [postman](http://www.getpostman.com/). The structure of the
+demo database is defined by
+[begriffs/postgrest-example](https://github.com/begriffs/postgrest-example).
+You can use it as inspiration for test-driven server migrations in
+your own projects.
 
-You will need to provide two database roles (which are allowed to
-be the same). One is called the authenticator role (`auth-role`
-above) which should have enough privileges to read the `auth` table
-in the `dbapi` schema if you intend to support multi-user applications.
+Also try other tools in the PostgREST
+[ecosystem](http://postgrest.com/install/ecosystem/) like the
+[ng-admin demo](http://marmelab.com/ng-admin-postgrest).
 
-The other role is for anonymous access (`anonymous-role` above).
-Immediately upon acceping any unauthenticated HTTP connection dbapi
-assumes this role in its queries to postgres. Give this role as
-much or little permissions as you would like.
+### Usage
 
-### Running tests
+1. Download the binary ([latest release](https://github.com/begriffs/postgrest/releases/latest))
+   for your platform.
+2. Invoke like so:
 
-```sh
-createuser --superuser --no-password dbapi_test
-createdb -O dbapi_test -U postgres dbapi_test
+    ```bash
+    postgrest postgres://postgres:foobar@localhost:5432/my_db \
+              --port 3000 \
+              --schema public \
+              --anonymous postgres \
+              --pool 200
+    ```
 
-cabal test --show-details=always --test-options="--color"
-```
+For more information on valid connection strings see the
+[PostgreSQL docs](http://www.postgresql.org/docs/9.4/static/libpq-connect.html#LIBPQ-CONNSTRING).
 
-### Accessing server on localhost
+### Performance
 
-Dbapi permits only secure https access. By default it uses a
-self-signed key which will cause Chrome and other rest clients to
-complain. You will need to configure your system to trust this key.
-On mac follow [these
-instructions](http://www.robpeck.com/2010/10/google-chrome-mac-os-x-and-self-signed-ssl-certificates/).
+TLDR; subsecond response times for up to 2000 requests/sec on Heroku
+free tier. ([see the load
+test](http://postgrest.com/admin/performance/#benchmarks))
+
+If you're used to servers written in interpreted languages (or named
+after precious gems), prepare to be pleasantly surprised by PostgREST
+performance.
+
+Three factors contribute to the speed. First the server is written
+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
+including
+
+* Serializing JSON responses directly in SQL
+* Data validation
+* Authorization
+* Combined row counting and retrieval
+* Data post in single command (`returning *`)
+
+Finally it uses the database efficiently with the
+[Hasql](https://nikita-volkov.github.io/hasql-benchmarks/) library
+by
+
+* Reusing prepared statements
+* Keeping a pool of db connections
+* Using the PostgreSQL binary protocol
+* Being stateless to allow horizontal scaling
+
+Ultimately the server (when load balanced) is constrained by database
+performance. This may make it inappropriate for very large traffic
+load. To learn more about scaling with Heroku and Amazon RDS see
+the [performance guide](http://postgrest.com/admin/performance/).
+Alternatively [CitusDB](https://www.citusdata.com/products/what-is-citusdb)
+supports Postgres clustering for higher performance.
+
+Other optimizations are possible, and some are outlined in the
+[Future Features](#future-features).
+
+### Security
+
+PostgREST handles authentication (via [JSON Web
+Tokens](http://postgrest.com/admin/security/#json-web-tokens))
+and delegates authorization to the role information defined in the
+database. This ensures there is a single declarative source of truth
+for security.  When dealing with the database the server assumes
+the identity of the currently authenticated user, and for the
+duration of the connection cannot do anything the user themselves
+couldn't. Other forms of authentication can be built on top
+of the JWT primitive. See the docs for more information.
+
+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](http://postgrest.com/admin/security/).
+
+### Versioning
+
+A robust long-lived API needs the freedom to exist in multiple
+versions. PostgREST does versioning through database schemas. This
+allows you to expose tables and views without making the app brittle.
+Underlying tables can be superseded and hidden behind public facing
+views. You run an instance of PostgREST per schema and route requests
+among them with a reverse proxy such as [nginx](http://nginx.org).
+Learn more [here](http://postgrest.com/admin/versioning/).
+
+### Self-documentation
+
+Rather than writing and maintaining separate docs yourself let the
+API explain its own affordances using HTTP. All PostgREST endpoints
+respond to the OPTIONS verb and explain what they support as well
+as the data format of their JSON payload. RAML support is an upcoming
+feature.
+
+The project uses HTTP itself to communicate other metadata. 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
+imperative coding, this system requires you put declarative constraints
+directly into your database. Hence no application can corrupt your
+data (including your API server).
+
+The PostgREST exposes HTTP interface with safeguards to prevent
+surprises, such as enforcing idempotent PUT requests, and
+
+See examples of [PostgreSQL
+constraints](http://www.tutorialspoint.com/postgresql/postgresql_constraints.htm)
+and the [guide to routing](http://postgrest.com/api/reading/).
+
+### Future Features
+
+* Watching endpoint changes with sockets and Postgres pubsub
+* Specifying per-view HTTP caching
+* Inferring good default caching policies from the Postgres stats collector
+* Generating mock data for test clients
+* Maintaining separate connection pools per role to avoid "set/reset
+  role" performance penalty
+* Describe more relationships with Link headers
+* Depending on accept headers, render OPTIONS as [RAML](http://raml.org/) or a
+  relational diagram
+* ... the other [issues](https://github.com/begriffs/postgrest/issues)
+
+### Thanks
+
+I'm grateful to the generous project
+[contributors](https://github.com/begriffs/postgrest/graphs/contributors)
+who have improved PostgREST immensely with their code and good
+judgement.  See more details in the
+[changelog](https://github.com/begriffs/postgrest/blob/master/CHANGELOG.md).
+
+The cool logo came from [Mikey Casalaina](https://github.com/casalaina).

app.json

@@ -0,0 +1,56 @@
+{
+  "name": "PostgREST",
+  "description": "RESTful API for any PostgreSQL database.",
+  "logo": "https://halcyon.sh/logo.svg",
+  "repository": "https://github.com/begriffs/postgrest",
+  "env": {
+    "BUILDPACK_URL": {
+      "description": "Heroku buildpack for deploying Haskell applications",
+      "value": "https://github.com/begriffs/postgrest-heroku"
+    },
+    "POSTGREST_VER": {
+      "description": "Version of PostgREST to deploy",
+      "value": "0.3.0.4"
+    },
+    "DB_NAME": {
+      "description": "Database name",
+      "required": true
+    },
+    "AUTH_ROLE": {
+      "description": "Database role to use checking client authentication",
+      "required": true
+    },
+    "AUTH_PASS": {
+      "description": "Authentication password",
+      "required": false
+    },
+    "ANONYMOUS_ROLE": {
+      "description": "Database role for non-authenticated requests",
+      "required": true
+    },
+    "DB_HOST": {
+      "description": "Database server hostname",
+      "required": true
+    },
+    "DB_PORT": {
+      "description": "Database server port",
+      "required": false,
+      "value": "5432"
+    },
+    "DB_POOL": {
+      "description": "Maximum number of connections in database pool",
+      "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"
+    }
+  }
+}

circle.yml

@@ -0,0 +1,22 @@
+dependencies:
+  cache_directories:
+    - "~/.stack"
+    - ".stack-work"
+  pre:
+    - curl -L https://github.com/commercialhaskell/stack/releases/download/v1.0.2/stack-1.0.2-linux-x86_64.tar.gz | tar zx -C /tmp
+    - sudo mv /tmp/stack-1.0.2-linux-x86_64/stack /usr/bin
+    - createuser --superuser --no-password postgrest_test
+    - createdb -O postgrest_test -U ubuntu postgrest_test
+  override:
+    - stack setup
+    - stack install hlint packdeps cabal-install
+    - stack build --test --no-run-tests
+
+test:
+  override:
+    - stack test
+    - git ls-files | grep '\.l\?hs$' | xargs stack exec -- hlint -X QuasiQuotes "$@"
+    - stack exec -- packdeps *.cabal || true
+    - stack exec -- cabal check
+    - stack haddock --no-haddock-deps
+    - stack sdist

dbapi.cabal

@@ -1,69 +0,0 @@
-name:                  dbapi
-version:               0.2.2.1
-synopsis:              The database is your api
-license:               MIT
-license-file:          LICENSE
-author:                Joe Nelson, Adam Baker
-maintainer:            cred+github@begriffs.com
-category:              Web
-build-type:            Simple
-cabal-version:         >=1.10
-
-executable dbapi
-  main-is:             Main.hs
-  ghc-options:         -Wall -W -Werror
-  default-language:    Haskell2010
-  build-depends:       base >=4.6 && <5
-                     , HDBC, HDBC-postgresql
-                     , warp, wai >= 3.0.1 && < 3.0.2
-                     , wai-extra, wai-cors
-                     , wai-middleware-static >= 0.6.0
-                     , HTTP, convertible, http-types
-                     , case-insensitive
-                     , scientific, time
-                     , aeson, network >= 2.6
-                     , bytestring, text, split, string-conversions
-                     , containers, unordered-containers
-                     , optparse-applicative >= 0.9.1 && < 0.10
-                     , regex-base, regex-tdfa
-                     , Ranged-sets
-                     , transformers
-                     , bcrypt, base64-string
-                     , network-uri >= 2.6
-                     , resource-pool, process
-  Other-Modules:       Dbapi
-                     , PgStructure
-                     , PgQuery
-                     , RangeQuery
-                     , Middleware
-  hs-source-dirs:      src
-
-Test-Suite spec
-  Type:                exitcode-stdio-1.0
-  Default-Language:    Haskell2010
-  Hs-Source-Dirs:      test, src
-  ghc-options:         -Wall -W -Werror
-  Main-Is:             Main.hs
-  Other-Modules:       Dbapi, Spec, SpecHelper
-  Build-Depends:       base, hspec2
-                     , hspec-wai >= 0.5.0, hspec-wai-json
-                     , HDBC, HDBC-postgresql
-                     , warp, wai >= 3.0.1 && < 3.0.2
-                     , HTTP, convertible
-                     , case-insensitive
-                     , wai-extra, wai-cors, containers
-                     , wai-middleware-static >= 0.6.0
-                     , http-types, scientific, time
-                     , bytestring, aeson, network >= 2.6
-                     , text, optparse-applicative
-                     , unordered-containers
-                     , regex-base
-                     , string-conversions
-                     , http-media, regex-tdfa
-                     , Ranged-sets
-                     , transformers
-                     , bcrypt
-                     , base64-string
-                     , split
-                     , network-uri >= 2.6
-                     , resource-pool

debian/TODO-deps.md

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

debian/changelog

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

debian/compat

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

debian/control

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

debian/copyright

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

debian/haskell-postgrest-utils.install

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

debian/postgrest-wrapper

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

debian/postgrest.default

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

debian/postgrest.init.d

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

debian/rules

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

debian/source/format

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

debian/watch

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

docs/CNAME

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

docs/admin/deployment.md

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

docs/admin/migration.md

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

docs/admin/performance.md

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

docs/admin/security.md

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

docs/admin/versioning.md

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

docs/api/reading.md

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

docs/api/writing.md

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

docs/examples/blog.md

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

docs/examples/external_auth.md

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

docs/examples/python-requests-jwt.md

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

docs/examples/start.md

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

docs/examples/users.md

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

docs/index.md

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

docs/install/ecosystem.md

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

docs/install/server.md

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

mkdocs.yml

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

postgrest.cabal

@@ -0,0 +1,183 @@
+name:                  postgrest
+description:           Reads the schema of a PostgreSQL database and creates RESTful routes
+                       for the tables and views, supporting all HTTP verbs that security
+                       permits.
+version:               0.3.0.4
+synopsis:              REST API for any Postgres database
+license:               MIT
+license-file:          LICENSE
+author:                Joe Nelson, Adam Baker
+homepage:              https://github.com/begriffs/postgrest
+maintainer:            cred+github@begriffs.com
+category:              Web
+build-type:            Simple
+cabal-version:         >=1.10
+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:             PostgREST/Main.hs
+  default-extensions:  OverloadedStrings, ScopedTypeVariables, QuasiQuotes, LambdaCase
+  ghc-options:         -threaded -rtsopts -with-rtsopts=-N
+  default-language:    Haskell2010
+  build-depends:       aeson >= 0.8 && < 0.10
+                     , base >= 4.8 && < 5
+                     , bytestring
+                     , case-insensitive
+                     , cassava
+                     , containers
+                     , contravariant
+                     , errors
+                     , hasql >= 0.19.3.3 && < 0.20
+                     , http-types
+                     , interpolatedstring-perl6
+                     , jwt
+                     , optparse-applicative >= 0.11 && < 0.13
+                     , parsec
+                     , postgrest
+                     , regex-tdfa
+                     , resource-pool
+                     , safe >= 0.3 && < 0.4
+                     , scientific
+                     , string-conversions
+                     , text
+                     , time
+                     , unordered-containers
+                     , vector
+                     , wai >= 3.0.1
+                     , wai-cors
+                     , wai-extra
+                     , wai-middleware-static >= 0.6.0
+                     , warp >= 3.1.0
+                     , HTTP
+                     , Ranged-sets
+  if !os(windows)
+    build-depends:     unix >= 2.7 && < 3
+
+  hs-source-dirs:      src
+  other-modules:       Paths_postgrest
+                     , PostgREST.App
+                     , PostgREST.Auth
+                     , PostgREST.Config
+                     , PostgREST.Error
+                     , PostgREST.Middleware
+                     , PostgREST.Parsers
+                     , PostgREST.DbStructure
+                     , PostgREST.QueryBuilder
+                     , PostgREST.RangeQuery
+                     , PostgREST.ApiRequest
+                     , PostgREST.Types
+
+library
+  default-language:    Haskell2010
+  default-extensions:  OverloadedStrings, ScopedTypeVariables, QuasiQuotes
+  build-depends:       aeson
+                     , base >=4.6 && <5
+                     , bytestring
+                     , case-insensitive
+                     , cassava
+                     , containers
+                     , contravariant
+                     , errors
+                     , hasql
+                     , http-types
+                     , interpolatedstring-perl6
+                     , jwt
+                     , optparse-applicative
+                     , parsec
+                     , regex-tdfa
+                     , safe
+                     , scientific
+                     , string-conversions
+                     , text
+                     , time
+                     , unordered-containers
+                     , vector
+                     , wai
+                     , wai-cors
+                     , wai-extra
+                     , wai-middleware-static
+                     , HTTP
+                     , Ranged-sets
+
+  Other-Modules:       Paths_postgrest
+  Exposed-Modules:     PostgREST.App
+                     , PostgREST.Auth
+                     , PostgREST.Config
+                     , PostgREST.Error
+                     , PostgREST.Middleware
+                     , PostgREST.Parsers
+                     , PostgREST.DbStructure
+                     , PostgREST.QueryBuilder
+                     , PostgREST.RangeQuery
+                     , PostgREST.ApiRequest
+                     , PostgREST.Types
+  hs-source-dirs:      src
+
+Test-Suite spec
+  Type:                exitcode-stdio-1.0
+  Default-Language:    Haskell2010
+  default-extensions:  OverloadedStrings, ScopedTypeVariables, QuasiQuotes, LambdaCase
+  Hs-Source-Dirs:      test, src
+  Main-Is:             Main.hs
+  Other-Modules:       Feature.AuthSpec
+                     , Feature.CorsSpec
+                     , Feature.DeleteSpec
+                     , Feature.InsertSpec
+                     , Feature.QuerySpec
+                     , Feature.RangeSpec
+                     , Feature.StructureSpec
+                     , Paths_postgrest
+                     , PostgREST.App
+                     , PostgREST.Auth
+                     , PostgREST.Config
+                     , PostgREST.Error
+                     , PostgREST.Middleware
+                     , PostgREST.Parsers
+                     , PostgREST.DbStructure
+                     , PostgREST.QueryBuilder
+                     , PostgREST.RangeQuery
+                     , PostgREST.ApiRequest
+                     , PostgREST.Types
+                     , SpecHelper
+                     , TestTypes
+  Build-Depends:       aeson
+                     , base
+                     , base64-string
+                     , bytestring
+                     , case-insensitive
+                     , cassava
+                     , containers
+                     , contravariant
+                     , errors
+                     , hasql
+                     , heredoc
+                     , hspec == 2.2.*
+                     , hspec-wai
+                     , hspec-wai-json
+                     , http-types
+                     , interpolatedstring-perl6
+                     , jwt
+                     , optparse-applicative
+                     , parsec
+                     , process
+                     , regex-tdfa
+                     , safe
+                     , scientific
+                     , string-conversions
+                     , text
+                     , time
+                     , unordered-containers
+                     , vector
+                     , wai
+                     , wai-cors
+                     , wai-extra
+                     , wai-middleware-static
+                     , HTTP
+                     , Ranged-sets

schema-templates/blog.sql

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

scripts/release_s3.sh

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

src/Dbapi.hs

@@ -1,204 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-
--- {{{ Imports
-module Dbapi where
-
-import Types (SqlRow, getRow)
-
-import Control.Monad (join)
-import Control.Arrow ((***))
-import Control.Applicative
-import Options.Applicative hiding (columns)
-
-import Data.Maybe (fromMaybe, isJust)
-import Text.Regex.TDFA ((=~))
-import Data.Map (intersection, fromList, toList, Map)
-import Data.List (sort)
-import qualified Data.Set as S
-import Data.Convertible.Base (convert)
-import Data.Text (strip)
-
-import Network.HTTP.Types.Status
-import Network.HTTP.Types.Header
-import Network.HTTP.Types.URI
-
-import Network.HTTP.Base (urlEncodeVars)
-
-import Network.Wai
-import Network.Wai.Internal
-import Network.Wai.Middleware.Cors (CorsResourcePolicy(..))
-
-import qualified Data.ByteString.Char8 as BS
-import Data.String.Conversions (cs)
-import qualified Data.CaseInsensitive as CI
-
-import Database.HDBC.PostgreSQL (Connection)
-import PgStructure (printTables, printColumns, primaryKeyColumns,
-                    columns, Column(colName))
-
-import qualified Data.Aeson as JSON
-
-import PgQuery
-import RangeQuery
-import Data.Ranged.Ranges (emptyRange)
-
--- }}}
-
-data AppConfig = AppConfig {
-    configDbUri :: String
-  , configPort  :: Int
-  , configAnonRole :: String
-  , configSecure :: Bool
-  }
-
-jsonContentType :: (HeaderName, BS.ByteString)
-jsonContentType = (hContentType, "application/json")
-
-jsonBodyAction :: Request -> (SqlRow -> IO Response) -> IO Response
-jsonBodyAction req handler = do
-  parse <- jsonBody req
-  case parse of
-    Left err -> return $ responseLBS status400 [jsonContentType] json
-      where json = JSON.encode . JSON.object $ [("error", JSON.String $ "Failed to parse JSON payload. " <> cs err) ]
-    Right body -> handler body
-
-jsonBody :: Request -> IO (Either String SqlRow)
-jsonBody = fmap JSON.eitherDecode . strictRequestBody
-
-filterByKeys :: Ord a => Map a b -> [a] -> Map a b
-filterByKeys m keys =
-  if null keys then m else
-    m `intersection` fromList (zip keys $ repeat undefined)
-
-app :: Connection -> Application
-app conn req respond =
-  respond =<< case (path, verb) of
-    ([], _) ->
-      responseLBS status200 [jsonContentType] <$> printTables ver conn
-
-    ([table], "OPTIONS") ->
-      responseLBS status200 [jsonContentType, allOrigins] <$>
-        printColumns ver (cs table) conn
-
-    ([table], "GET") ->
-      if range == Just emptyRange
-      then return $ responseLBS status416 [] "HTTP Range error"
-      else do
-        r <- respondWithRangedResult <$> getRows ver (cs table) qq range conn
-        let canonical = urlEncodeVars $ sort $
-                        map (join (***) cs) $
-                        parseSimpleQuery $
-                        rawQueryString req
-        return $ addHeaders [
-          ("Content-Location",
-           "/" <> cs table <> if null canonical then "" else "?" <> cs canonical
-          )] r
-
-    ([table], "POST") ->
-      jsonBodyAction req (\row -> do
-        allvals <- insert ver table row conn
-        keys <- primaryKeyColumns ver (cs table) conn
-        let params = urlEncodeVars $ map (\t -> (fst t, "eq." <> convert (snd t) :: String)) $ toList $ filterByKeys allvals keys
-        return $ responseLBS status201
-          [ jsonContentType
-          , (hLocation, "/" <> cs table <> "?" <> cs params)
-          ] ""
-      )
-
-    ([table], "PUT") ->
-      jsonBodyAction req (\row -> do
-        keys <- primaryKeyColumns ver (cs table) conn
-        let specifiedKeys = map (cs . fst) qq
-        if S.fromList keys /= S.fromList specifiedKeys
-          then return $ responseLBS status405 []
-               "You must speficy all and only primary keys as params"
-          else
-            if isJust cRange
-               then return $ responseLBS status400 []
-                    "Content-Range is not allowed in PUT request"
-            else do
-              cols <- columns ver (cs table) conn
-              let colNames = S.fromList $ map (cs . colName) cols
-              let specifiedCols = S.fromList $ map fst $ getRow row
-              return $ if colNames == specifiedCols then
-                responseLBS status200 [ jsonContentType ] ""
-
-                else if S.null colNames then responseLBS status404 [] ""
-                  else responseLBS status400 []
-                     "You must specify all columns in PUT request"
-      )
-
-    (_, _) ->
-      return $ responseLBS status404 [] ""
-
-  where
-    path   = pathInfo req
-    verb   = requestMethod req
-    qq     = queryString req
-    hdrs   = requestHeaders req
-    ver    = fromMaybe "1" $ requestedVersion hdrs
-    range  = requestedRange hdrs
-    cRange = requestedContentRange hdrs
-    allOrigins = ("Access-Control-Allow-Origin", "*") :: Header
-
-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
-    }
-  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 -> []
-
-
-respondWithRangedResult :: RangedResult -> Response
-respondWithRangedResult rr =
-  responseLBS status [
-    jsonContentType,
-    ("Content-Range",
-      if total == 0 || from > total
-      then "*/" <> cs (show total)
-      else cs (show from)  <> "-"
-         <> cs (show to)    <> "/"
-         <> cs (show total)
-    )
-  ] (rrBody rr)
-
-  where
-    from   = rrFrom rr
-    to     = rrTo   rr
-    total  = rrTotal rr
-    status
-      | from > total            = status416
-      | (1 + to - from) < total = status206
-      | otherwise               = status200
-
-requestedVersion :: RequestHeaders -> Maybe String
-requestedVersion hdrs =
-  case verStr of
-       Just [[_, ver]] -> Just ver
-       _ -> Nothing
-
-  where verRegex = "version[ ]*=[ ]*([0-9]+)" :: String
-        accept = cs <$> lookup hAccept hdrs :: Maybe String
-        verStr = (=~ verRegex) <$> accept :: Maybe [[String]]
-
-
-addHeaders :: ResponseHeaders -> Response -> Response
-addHeaders hdrs (ResponseFile    s headers fp m) =
-                 ResponseFile    s (headers ++ hdrs) fp m
-addHeaders hdrs (ResponseBuilder s headers b)    =
-                 ResponseBuilder s (headers ++ hdrs) b
-addHeaders hdrs (ResponseStream  s headers b)    =
-                 ResponseStream  s (headers ++ hdrs) b
-addHeaders hdrs (ResponseRaw     s resp)         =
-                 ResponseRaw     s (addHeaders hdrs resp)

src/Main.hs

@@ -1,47 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-
-module Main where
-import Dbapi
-import Middleware (inTransaction, authenticated, withSavepoint, clientErrors,
-  redirectInsecure, withDBConnection)
-import Network.Wai.Handler.Warp hiding (Connection)
-import Data.String.Conversions (cs)
-
-import Control.Monad (unless)
-import Control.Applicative
-import Options.Applicative hiding (columns)
-import Network.Wai.Middleware.Gzip (gzip, def)
-import Network.Wai.Middleware.Cors (cors)
-import Network.Wai.Middleware.Static (staticPolicy, only)
-import Database.HDBC (disconnect)
-import Database.HDBC.PostgreSQL(connectPostgreSQL')
-import Data.Pool(createPool)
-
-argParser :: Parser AppConfig
-argParser = AppConfig
-  <$> strOption (long "db" <> short 'd' <> metavar "URI"
-    <> help "database uri to expose, e.g. postgres://user:pass@host:port/database")
-  <*> option (long "port" <> short 'p' <> metavar "NUMBER" <> value 3000
-    <> help "port number on which to run HTTP server")
-  <*> 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" )
-
-main :: IO ()
-main = do
-  conf <- execParser (info (helper <*> argParser) describe)
-  pool <- createPool (connectPostgreSQL' (configDbUri conf)) disconnect 1 600 10
-  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)
-  run port $ (if configSecure conf then redirectInsecure else id)
-    . gzip def . cors corsPolicy . clientErrors
-    . staticPolicy (only [("favicon.ico", "static/favicon.ico")])
-    . withDBConnection pool . inTransaction
-    . authenticated (cs $ configAnonRole conf) . withSavepoint $ app
-  where
-    describe = progDesc "create a REST API to an existing Postgres database"

src/Middleware.hs

@@ -1,110 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-{-# OPTIONS_GHC -fno-warn-orphans #-}
-
-module Middleware where
-
-import Data.Aeson ((.=), toJSON, ToJSON, object, encode)
-import Data.Maybe (fromMaybe)
-import Data.Monoid (mconcat)
-import Data.Pool(withResource, Pool)
-
-import Database.HDBC (runRaw)
-import Database.HDBC.PostgreSQL (Connection)
-import Database.HDBC.Types (SqlError(..))
-
-import Data.String.Conversions(cs)
-import qualified Data.ByteString.Char8 as BS
-import Control.Exception (finally, throw, catchJust, catch, SomeException,
-    bracket_)
-
-import Network.HTTP.Types.Header (RequestHeaders, hContentType, hAuthorization,
-  hLocation)
-import Network.HTTP.Types.Status (status400, status401, status404, status301)
-import Network.Wai (Application, requestHeaders, responseLBS, rawPathInfo,
-                   rawQueryString, isSecure)
-import Network.URI (URI(..), parseURI)
-
-import PgQuery(LoginAttempt(..), signInRole, setRole, resetRole)
-import Codec.Binary.Base64.String (decode)
-
-
-withDBConnection :: Pool Connection -> (Connection -> Application) -> Application
-withDBConnection pool app req respond =
-  withResource pool (\c -> app c req respond)
-
-inTransaction :: (Connection -> Application) -> Connection -> Application
-inTransaction app conn req respond =
-  finally (runRaw conn "begin" >> app conn req respond) (runRaw conn "commit")
-
-withSavepoint :: (Connection -> Application) -> Connection -> Application
-withSavepoint app conn req respond = do
-  runRaw conn "savepoint req_sp"
-  catch (app conn req respond) (\e -> let _ = (e::SomeException) in
-    runRaw conn "rollback to savepoint req_sp" >> throw e)
-
-authenticated :: BS.ByteString -> (Connection -> Application) ->
-                 Connection -> Application
-authenticated anon app conn req respond = do
-  attempt <- httpRequesterRole (requestHeaders req)
-  case attempt of
-    MalformedAuth ->
-      respond $ responseLBS status400 [] "Malformed basic auth header"
-    LoginFailed ->
-      respond $ responseLBS status401 [] "Invalid username or password"
-    LoginSuccess role ->
-      bracket_ (setRole conn role) (resetRole conn) $ app conn req respond
-    NoCredentials ->
-      bracket_ (setRole conn anon) (resetRole conn) $ app conn req respond
-
- where
-   httpRequesterRole :: RequestHeaders -> IO LoginAttempt
-   httpRequesterRole hdrs = do
-    let auth = fromMaybe "" $ lookup hAuthorization hdrs
-    case BS.split ' ' (cs auth) of
-      ("Basic" : b64 : _) ->
-        case BS.split ':' $ cs (decode $ cs b64) of
-          (u:p:_) -> signInRole u p conn
-          _ -> return MalformedAuth
-      _ -> return NoCredentials
-
-instance ToJSON SqlError where
-  toJSON t = object [
-      "error" .= object [
-          "code"    .= seNativeError t
-        , "message" .= seErrorMsg t
-        , "state"   .= seState t
-      ]
-    ]
-
-clientErrors :: Application -> Application
-clientErrors app req respond =
-  catchJust isPgException (app req respond) $ \err ->
-    respond $ if seState err == "42P01"
-       then responseLBS status404 [] ""
-       else responseLBS status400 [(hContentType, "application/json")] (encode err)
-
-  where
-    isPgException :: SqlError -> Maybe SqlError
-    isPgException = Just
-
-
-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

src/PgQuery.hs

@@ -1,248 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-
--- {{{ Imports
-
-module PgQuery (
-  getRows
-, insert
-, upsert
-, addUser
-, signInRole
-, setRole
-, resetRole
-, checkPass
-, RangedResult(..)
-, LoginAttempt(..)
-, DbRole
-) where
-
-import Data.Text (Text)
-import Data.String.Conversions (cs)
-import Data.Functor ( (<$>) )
-import Data.Maybe (fromMaybe, mapMaybe)
-import Data.List (intersperse, intercalate)
-import Data.List.Split (splitOn)
-import Data.Monoid ((<>), mconcat)
-import qualified Data.Map as M
-
-import Control.Monad (join, void)
-
-import qualified RangeQuery as R
-import qualified Data.ByteString.Char8 as BS
-import qualified Data.ByteString.Lazy as BL
-
-import Database.HDBC hiding (colType, colNullable)
-import Database.HDBC.PostgreSQL
-
-import qualified Network.HTTP.Types.URI as Net
-
-import Types (SqlRow(..), getRow, sqlRowColumns, sqlRowValues)
-import Crypto.BCrypt (hashPasswordUsingPolicy, fastBcryptHashingPolicy, validatePassword)
-
--- }}}
-
-data RangedResult = RangedResult {
-  rrFrom  :: Int
-, rrTo    :: Int
-, rrTotal :: Int
-, rrBody  :: BL.ByteString
-} deriving (Show)
-
-type QuotedSql = (String, [SqlValue])
-type Schema = String
-type DbRole = BS.ByteString
-
-data LoginAttempt =
-    NoCredentials
-  | MalformedAuth
-  | LoginFailed
-  | LoginSuccess DbRole
-  deriving (Eq, Show)
-
-getRows :: Schema -> String -> Net.Query -> Maybe R.NonnegRange -> Connection -> IO RangedResult
-getRows schema table qq range conn = do
-  query <- populateSql conn
-    $ globalAndLimitedCounts schema table qq <>
-      jsonArrayRows
-      (selectStarClause schema table
-        <> whereClause qq
-        <> orderClause qq
-        <> limitClause range)
-  r <- quickQuery conn query []
-
-  return $ case r of
-           [[total, _, SqlNull]] -> RangedResult offset 0 (fromSql total) "[]"
-           [[total, limited_total, json]] ->
-            RangedResult offset (offset + fromSql limited_total - 1)
-                         (fromSql total) (fromSql json)
-           _ -> RangedResult 0 0 0 "[]"
-
-  where
-    offset = fromMaybe 0 $ R.offset <$> range
-
-
-whereClause :: Net.Query -> QuotedSql
-whereClause qs =
-  if null qs then ("", []) else (" where ", []) <> conjunction
-
-  where
-    cols = [ col | col <- qs, fst col `notElem` ["order"] ]
-    conjunction = mconcat $ intersperse (" and ", []) (map wherePred cols)
-
-
-orderClause :: Net.Query -> QuotedSql
-orderClause qs = do
-  let order = fromMaybe "" $ join $ lookup "order" qs
-      terms = mapMaybe parseOrderTerm $ splitOn "," $ cs order
-      termPred = mconcat $ intersperse (", ", []) (map orderTermSql terms)
-
-  if null terms
-     then ("", [])
-     else (" order by ", []) <> termPred
-
-  where
-    parseOrderTerm :: String -> Maybe OrderTerm
-    parseOrderTerm s =
-      case splitOn "." s of
-           [d,c] ->
-             if d `elem` ["asc", "desc"]
-                then Just $ OrderTerm d c
-                else Nothing
-           _ -> Nothing
-
-    orderTermSql :: OrderTerm -> QuotedSql
-    orderTermSql t =
-      ("%I " <> otDirection t, [toSql $ otColumn t])
-
-
-data OrderTerm = OrderTerm {
-  otDirection :: String
-, otColumn :: String
-}
-
-
-wherePred :: Net.QueryItem -> QuotedSql
-wherePred (column, predicate) =
-  ("%I " <> op <> "%L", map toSql [column, value])
-
-  where
-    opCode:rest = BS.split '.' $ fromMaybe "." predicate
-    value = BS.intercalate "." rest
-    op = case opCode of
-              "eq"  -> "="
-              "gt"  -> ">"
-              "lt"  -> "<"
-              "gte" -> ">="
-              "lte" -> "<="
-              "neq" -> "<>"
-              _     -> "="
-
-limitClause :: Maybe R.NonnegRange -> QuotedSql
-limitClause range =
-  (" LIMIT %s OFFSET %s ", [toSql limit, toSql offset])
-
-  where
-    limit  = fromMaybe "ALL" $ show <$> (R.limit =<< range)
-    offset = fromMaybe 0     $ R.offset <$> range
-
-globalAndLimitedCounts :: Schema -> String -> Net.Query -> QuotedSql
-globalAndLimitedCounts schema table qq =
-  (" select ", [])
-  <> ("(select count(1) from %I.%I ", map toSql [schema, table])
-  <> whereClause qq
-  <> ("), count(t), ", [])
-
-selectStarClause :: Schema -> String -> QuotedSql
-selectStarClause schema table =
-  (" select * from %I.%I ", map toSql [schema, table])
-
-jsonArrayRows :: QuotedSql -> QuotedSql
-jsonArrayRows q =
-  ("array_to_json(array_agg(row_to_json(t))) from (", []) <> q <> (") t", [])
-
-insert :: Schema -> Text -> SqlRow -> Connection -> IO (M.Map String SqlValue)
-insert schema table row conn = do
-  sql    <- populateSql conn $ insertClause schema table row
-  stmt   <- prepare conn sql
-  _      <- execute stmt $ sqlRowValues row
-  Just m <- fetchRowMap stmt
-  return m
-
-addUser :: BS.ByteString -> BS.ByteString -> BS.ByteString -> Connection -> IO ()
-addUser identity pass role conn = do
-  hashed <- hashPasswordUsingPolicy fastBcryptHashingPolicy $ cs pass
-  _ <- insert "dbapi" "auth" (SqlRow [
-      ("id", toSql identity), ("pass", toSql hashed), ("rolname", toSql role)
-    ]) conn
-  return ()
-
-signInRole :: BS.ByteString -> BS.ByteString -> Connection -> IO LoginAttempt
-signInRole user pass conn = do
-  u <- quickQuery conn "select pass, rolname from dbapi.auth where id = ?" [toSql user]
-  return $ case u of
-    [[hashed, role]] ->
-      if checkPass (fromSql hashed) (cs pass)
-         then LoginSuccess $ fromSql role
-         else LoginFailed
-    _ -> LoginFailed
-
-checkPass :: BS.ByteString -> BS.ByteString -> Bool
-checkPass = validatePassword
-
-upsert :: Schema -> Text -> SqlRow -> Net.Query -> Connection -> IO (M.Map String SqlValue)
-upsert schema table row qq conn = do
-  sql    <- populateSql conn $ upsertClause schema table row qq
-  stmt   <- prepare conn sql
-  _      <- execute stmt $ join $ replicate 2 $ sqlRowValues row
-  Just m <- fetchRowMap stmt
-  return m
-
-placeholders :: String -> SqlRow -> String
-placeholders symbol = intercalate ", " . map (const symbol) . getRow
-
-insertClause :: Schema -> Text -> SqlRow -> QuotedSql
-insertClause schema table (SqlRow []) =
-  ("insert into %I.%I default values returning *", [toSql schema, toSql table])
-insertClause schema table row =
-  ("insert into %I.%I (" ++ placeholders "%I" row ++ ")",
-  map toSql $ cs schema : table : sqlRowColumns row)
-  <> (" values (" ++ placeholders "?" row ++ ") returning *", sqlRowValues row)
-
-
-insertClauseViaSelect :: Schema -> Text -> SqlRow -> QuotedSql
-insertClauseViaSelect schema table row =
-    ("insert into %I.%I (" ++ placeholders "%I" row ++ ")",
-     map toSql $ cs schema : table : sqlRowColumns row)
-  <> (" select " ++ placeholders "?" row, sqlRowValues row)
-
-updateClause :: Schema -> Text -> SqlRow -> QuotedSql
-updateClause schema table row =
-    ("update %I.%I set (" ++ placeholders "%I" row ++ ")",
-     map toSql $ cs schema : table : sqlRowColumns row)
-  <> (" = (" ++ placeholders "?" row ++ ")", [])
-
-upsertClause :: Schema -> Text -> SqlRow -> Net.Query -> QuotedSql
-upsertClause schema table row qq =
-  ("with upsert as (", []) <> updateClause schema table row
-  <> whereClause qq
-  <> (" returning *) ", []) <> insertClauseViaSelect schema table row
-  <> (" where not exists (select * from upsert) returning *", [])
-
-populateSql :: Connection -> QuotedSql -> IO String
-populateSql conn sql = do
-  [[escaped]] <- quickQuery conn q (snd sql)
-  return $ fromSql escaped
-
-  where
-    q = concat [ "select format('", fst sql, "', ", ph (snd sql), ")" ]
-
-    ph :: [a] -> String
-    ph = intercalate ", " . map (const "?::varchar")
-
-setRole :: Connection -> DbRole -> IO ()
-setRole conn role = do
-  query <- populateSql conn ("set role %I", [toSql role])
-  void $ run conn query []
-
-resetRole :: Connection -> IO ()
-resetRole conn = void $ run conn "reset role" []

src/PgStructure.hs

@@ -1,193 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-
-module PgStructure where
-
-import Data.Functor ( (<$>) )
-import Data.Maybe (mapMaybe)
-
-import Control.Applicative ( (<*>) )
-
-import qualified Data.ByteString.Lazy as BL
-import Data.List.Split (splitOn)
-
-import qualified Data.Aeson as JSON
-import qualified Data.Map as Map
-
-import Database.HDBC hiding (colType, colNullable)
-import Database.HDBC.PostgreSQL
-
-import Data.Aeson ((.=))
-
-data Table = Table {
-  tableSchema :: String
-, tableName :: String
-, tableInsertable :: Bool
-} deriving (Show)
-
-instance JSON.ToJSON Table where
-  toJSON v = JSON.object [
-      "schema"     .= tableSchema v
-    , "name"       .= tableName v
-    , "insertable" .= tableInsertable v ]
-
-toBool :: String -> Bool
-toBool = (== "YES")
-
-data ForeignKey = ForeignKey {
-  fkTable::String, fkCol::String
-} deriving (Eq, Show)
-
-instance JSON.ToJSON ForeignKey where
-  toJSON fk = JSON.object ["table".=fkTable fk, "column".=fkCol fk]
-
-foreignKeys :: String -> String -> Connection -> IO (Map.Map String ForeignKey)
-foreignKeys schema table conn = do
-  r <- quickQuery conn
-    "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" (map toSql [table, schema])
-  return $ foldl addKey Map.empty $ map (map fromSql) r
-  where
-    addKey m [col, ftab, fcol] = Map.insert col (ForeignKey ftab fcol) m
-    addKey m _ = m --should never happen
-
-data Column = Column {
-  colSchema :: String
-, colTable :: String
-, colName :: String
-, colPosition :: Int
-, colNullable :: Bool
-, colType :: String
-, colUpdatable :: Bool
-, colMaxLen :: Maybe Int
-, colPrecision :: Maybe Int
-, colDefault :: Maybe String
-, colEnum :: Maybe [String]
-, colFK :: Maybe ForeignKey
-} deriving (Show)
-
-instance JSON.ToJSON Column where
-  toJSON c = JSON.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 ]
-
-data TableOptions = TableOptions {
-  tblOptcolumns :: [Column]
-, tblOptpkey :: [String]
-}
-
-instance JSON.ToJSON TableOptions where
-  toJSON t = JSON.object [
-      "columns" .= tblOptcolumns t
-    , "pkey"    .= tblOptpkey t ]
-
-tables :: String -> Connection -> IO [Table]
-tables s conn = do
-  r <- quickQuery conn
-        "select table_schema, table_name,\
-        \       is_insertable_into\
-        \  from information_schema.tables\
-        \ where table_schema = ?\
-        \ order by table_name" [toSql s]
-  return $ mapMaybe mkTable r
-
-  where
-    mkTable [schema, name, insertable] =
-      Just $ Table (fromSql schema)
-        (fromSql name)
-        (toBool (fromSql insertable))
-    mkTable _ = Nothing
-
-columns :: String -> String -> Connection -> IO [Column]
-columns s t conn = do
-  r <- quickQuery conn
-    "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" [toSql s, toSql t]
-  fks <- foreignKeys s t conn
-  let lookupFK (_:_:name:_) = Map.lookup (fromSql name) fks
-      lookupFK _ = Nothing
-  let cols = zipWith ($) (map mkColumn r) (map lookupFK r)
-  return cols
-
-  where
-    mkColumn [schema, table, name, pos, nullable, colT, updatable, maxlen, precision, defVal, enum] = Column (fromSql schema)
-        (fromSql table)
-        (fromSql name)
-        (fromSql pos)
-        (toBool (fromSql nullable))
-        (fromSql colT)
-        (toBool (fromSql updatable))
-        (fromSql maxlen)
-        (fromSql precision)
-        (fromSql defVal)
-        (splitOn "," <$> fromSql enum)
-    mkColumn _ =  error $ "Incomplete column data received for table " ++
-      t ++ " in schema " ++ s ++ "."
-
-printTables :: String -> Connection -> IO BL.ByteString
-printTables schema conn = JSON.encode <$> tables schema conn
-
-printColumns :: String -> String -> Connection -> IO BL.ByteString
-printColumns schema table conn =
-  JSON.encode <$> (TableOptions <$> cols <*> pkey)
-  where
-    cols :: IO [Column]
-    cols = columns schema table conn
-    pkey :: IO [String]
-    pkey = primaryKeyColumns schema table conn
-
-primaryKeyColumns :: String -> String -> Connection -> IO [String]
-primaryKeyColumns s t conn = do
-  r <- quickQuery conn
-        "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  = ?" [toSql s, toSql t]
-  return $ map fromSql (concat r)

src/PostgREST/ApiRequest.hs

@@ -0,0 +1,228 @@
+module PostgREST.ApiRequest where
+
+import qualified Data.Aeson              as JSON
+import qualified Data.ByteString         as BS
+import qualified Data.ByteString.Lazy    as BL
+import qualified Data.Csv                as CSV
+import           Data.List               (find)
+import qualified Data.HashMap.Strict     as M
+import qualified Data.Set                as S
+import           Data.Maybe              (fromMaybe, isJust, isNothing,
+                                          listToMaybe, fromJust)
+import           Control.Monad           (join)
+import           Data.Monoid             ((<>))
+import           Data.String.Conversions (cs)
+import qualified Data.Text               as T
+import qualified Data.Vector             as V
+import           Network.Wai             (Request (..))
+import           Network.Wai.Parse       (parseHttpAccept)
+import           PostgREST.RangeQuery    (NonnegRange, rangeRequested)
+import           PostgREST.Types         (QualifiedIdentifier (..),
+                                          Schema, Payload(..),
+                                          UniformObjects(..))
+import           Data.Ranged.Ranges      (singletonRange)
+
+type RequestBody = BL.ByteString
+
+-- | Types of things a user wants to do to tables/views/procs
+data Action = ActionCreate | ActionRead
+            | ActionUpdate | ActionDelete
+            | ActionInfo   | ActionInvoke
+            | ActionInappropriate
+            deriving Eq
+-- | The target db object of a user action
+data Target = TargetIdent QualifiedIdentifier
+            | TargetProc  QualifiedIdentifier
+            | TargetRoot
+            | TargetUnknown [T.Text]
+-- | How to return the inserted data
+data PreferRepresentation = Full | HeadersOnly | None deriving Eq
+-- | Enumeration of currently supported content types for
+-- route responses and upload payloads
+data ContentType = ApplicationJSON | TextCSV deriving Eq
+instance Show ContentType where
+  show ApplicationJSON = "application/json"
+  show TextCSV         = "text/csv"
+
+{-|
+  Describes what the user wants to do. This data type is a
+  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 {
+  -- | Set to Nothing for unknown HTTP verbs
+    iAction :: Action
+  -- | Set to Nothing for malformed range
+  , iRange  :: NonnegRange
+  -- | Set to Nothing for strangely nested urls
+  , iTarget :: Target
+  -- | The content type the client most desires (or JSON if undecided)
+  , iAccepts :: Either BS.ByteString ContentType
+  -- | Data sent by client and used for mutation actions
+  , iPayload :: Maybe Payload
+  -- | If client wants created items echoed back
+  , iPreferRepresentation :: PreferRepresentation
+  -- | If client wants first row as raw object
+  , iPreferSingular :: Bool
+  -- | Whether the client wants a result count (slower)
+  , iPreferCount :: Bool
+  -- | Filters on the result ("id", "eq.10")
+  , iFilters :: [(String, String)]
+  -- | &select parameter used to shape the response
+  , iSelect :: String
+  -- | &order parameter
+  , iOrder :: Maybe String
+  }
+
+-- | Examines HTTP request and translates it into user intent.
+userApiRequest :: Schema -> Request -> RequestBody -> ApiRequest
+userApiRequest schema req reqBody =
+  let action =
+        if isTargetingProc
+          then
+            if method == "POST"
+               then ActionInvoke
+               else ActionInappropriate
+          else
+            case method of
+               "GET"     -> ActionRead
+               "POST"    -> ActionCreate
+               "PATCH"   -> ActionUpdate
+               "DELETE"  -> ActionDelete
+               "OPTIONS" -> ActionInfo
+               _         -> ActionInappropriate
+      target = case path of
+                 []            -> TargetRoot
+                 [table]       -> TargetIdent
+                                  $ QualifiedIdentifier schema table
+                 ["rpc", proc] -> TargetProc
+                                  $ QualifiedIdentifier schema proc
+                 other         -> TargetUnknown other
+      payload = case pickContentType (lookupHeader "content-type") of
+        Right ApplicationJSON ->
+          either (PayloadParseError . cs)
+            (\val -> case ensureUniform (pluralize val) of
+              Nothing -> PayloadParseError "All object keys must match"
+              Just json -> PayloadJSON json)
+            (JSON.eitherDecode reqBody)
+        Right TextCSV ->
+          either (PayloadParseError . cs)
+            (\val -> case ensureUniform (csvToJson val) of
+              Nothing -> PayloadParseError "All lines must have same number of fields"
+              Just json -> PayloadJSON json)
+            (CSV.decodeByName reqBody)
+        Left accept ->
+          PayloadParseError $
+            "Content-type not acceptable: " <> accept
+      relevantPayload = case action of
+        ActionCreate -> Just payload
+        ActionUpdate -> Just payload
+        ActionInvoke -> Just payload
+        _            -> Nothing in
+
+  ApiRequest {
+    iAction = action
+  , iRange  = if singular then singletonRange 0 else rangeRequested hdrs
+  , iTarget = target
+  , iAccepts = pickContentType $ lookupHeader "accept"
+  , iPayload = relevantPayload
+  , iPreferRepresentation = representation
+  , iPreferSingular = singular
+  , iPreferCount = not $ hasPrefer "count=none"
+  , iFilters = [ (k, fromJust v) | (k,v) <- qParams, k `notElem` ["select", "order"], isJust v ]
+  , iSelect = if method == "DELETE"
+              then "*"
+              else fromMaybe "*" $ fromMaybe (Just "*") $ lookup "select" qParams
+  , iOrder = join $ lookup "order" qParams
+  }
+
+ where
+  path            = pathInfo req
+  method          = requestMethod req
+  isTargetingProc = fromMaybe False $ (== "rpc") <$> listToMaybe path
+  hdrs            = requestHeaders req
+  qParams         = [(cs k, cs <$> v)|(k,v) <- queryString req]
+  lookupHeader    = flip lookup hdrs
+  hasPrefer val   = any (\(h,v) -> h == "Prefer" && v == val) hdrs
+  singular        = hasPrefer "plurality=singular"
+  representation
+    | hasPrefer "return=representation" = Full
+    | hasPrefer "return=minimal" = None
+    | otherwise = HeadersOnly
+
+-- PRIVATE ---------------------------------------------------------------
+
+{-|
+  Picks a preferred content type from an Accept header (or from
+  Content-Type as a degenerate case).
+
+  For example
+  text/csv -> TextCSV
+  */*      -> ApplicationJSON
+  text/csv, application/json -> TextCSV
+  application/json, text/csv -> ApplicationJSON
+-}
+pickContentType :: Maybe BS.ByteString -> Either BS.ByteString ContentType
+pickContentType accept
+  | isNothing accept || has ctAll || has ctJson = Right ApplicationJSON
+  | has ctCsv = Right TextCSV
+  | otherwise = Left accept'
+ where
+  ctAll  = "*/*"
+  ctCsv  = "text/csv"
+  ctJson = "application/json"
+  Just accept' = accept
+  findInAccept = flip find $ parseHttpAccept accept'
+  has          = isJust . findInAccept . BS.isPrefixOf
+
+type CsvData = V.Vector (M.HashMap T.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 $ cs 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 UniformObjects
+ensureUniform :: JSON.Array -> Maybe UniformObjects
+ensureUniform arr =
+  let objs :: V.Vector JSON.Object
+      objs = foldr -- filter non-objects, map to raw objects
+               (\val result -> case val of
+                  JSON.Object o -> V.cons o result
+                  _ -> result)
+               V.empty arr
+      keysPerObj = V.map (S.fromList . M.keys) objs
+      canonicalKeys = fromMaybe S.empty $ keysPerObj V.!? 0
+      areKeysUniform = all (==canonicalKeys) keysPerObj in
+
+  if (V.length objs == V.length arr) && areKeysUniform
+    then Just (UniformObjects objs)
+    else Nothing

src/PostgREST/App.hs

@@ -0,0 +1,337 @@
+{-# LANGUAGE FlexibleContexts    #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TupleSections #-}
+--module PostgREST.App where
+module PostgREST.App (
+  app
+) where
+
+import           Control.Applicative
+import           Control.Arrow             ((***))
+import           Control.Monad             (join)
+import           Data.Bifunctor            (first)
+import           Data.List                 (find, sortBy, delete)
+import           Data.Maybe                (isJust, fromMaybe, fromJust, mapMaybe)
+import           Data.Ord                  (comparing)
+import           Data.Ranged.Ranges        (emptyRange)
+import           Data.String.Conversions   (cs)
+import           Data.Text                 (Text, replace, strip)
+import           Data.Tree
+
+import           Text.Parsec.Error
+import           Text.ParserCombinators.Parsec (parse)
+
+import           Network.HTTP.Base         (urlEncodeVars)
+import           Network.HTTP.Types.Header
+import           Network.HTTP.Types.Status
+import           Network.HTTP.Types.URI    (parseSimpleQuery)
+import           Network.Wai
+
+import           Data.Aeson
+import           Data.Aeson.Types (emptyArray)
+import           Data.Monoid
+import qualified Data.Vector               as V
+import qualified Hasql.Session             as H
+
+import           PostgREST.Config          (AppConfig (..))
+import           PostgREST.Parsers
+import           PostgREST.DbStructure
+import           PostgREST.RangeQuery
+import           PostgREST.ApiRequest   (ApiRequest(..), ContentType(..)
+                                            , Action(..), Target(..)
+                                            , PreferRepresentation (..)
+                                            , userApiRequest)
+import           PostgREST.Types
+import           PostgREST.Auth            (tokenJWT)
+import           PostgREST.Error           (errResponse)
+
+import           PostgREST.QueryBuilder ( callProc
+                                        , addJoinConditions
+                                        , sourceCTEName
+                                        , requestToQuery
+                                        , requestToCountQuery
+                                        , addRelations
+                                        , createReadStatement
+                                        , createWriteStatement
+                                        , ResultsWithCount
+                                        )
+
+import           Prelude
+
+app :: DbStructure -> AppConfig -> RequestBody -> Request -> H.Session Response
+app dbStructure conf reqBody req =
+  let
+      -- TODO: blow up for Left values (there is a middleware that checks the headers)
+      contentType = either (const ApplicationJSON) id (iAccepts apiRequest)
+      contentTypeH = (hContentType, cs $ show contentType) in
+
+  case (iAction apiRequest, iTarget apiRequest, iPayload apiRequest) of
+
+    (ActionRead, TargetIdent qi, Nothing) ->
+      case readSqlParts of
+        Left e -> return $ responseLBS status400 [jsonH] $ cs e
+        Right (q, cq) -> do
+          let range = restrictRange (configMaxRows conf) $ iRange apiRequest
+              singular = iPreferSingular apiRequest
+              stm = createReadStatement q cq range singular
+                    (iPreferCount apiRequest) (contentType == TextCSV)
+          if range == emptyRange
+          then return $ errResponse status416 "HTTP Range error"
+          else do
+            row <- H.query () stm
+            let (tableTotal, queryTotal, _ , body) = row
+            if singular
+            then return $ if queryTotal <= 0
+              then responseLBS status404 [] ""
+              else responseLBS status200 [contentTypeH] (cs body)
+            else do
+              let frm = rangeOffset range
+                  to = frm + toInteger queryTotal - 1
+                  contentRange = contentRangeH frm to (toInteger <$> tableTotal)
+                  status = rangeStatus frm to (toInteger <$> tableTotal)
+                  canonical = urlEncodeVars -- should this be moved to the dbStructure (location)?
+                    . sortBy (comparing fst)
+                    . map (join (***) cs)
+                    . parseSimpleQuery
+                    $ rawQueryString req
+              return $ responseLBS status
+                [contentTypeH, contentRange,
+                  ("Content-Location",
+                    "/" <> cs (qiName qi) <>
+                      if Prelude.null canonical then "" else "?" <> cs canonical
+                  )
+                ] (cs body)
+
+    (ActionCreate, TargetIdent qi@(QualifiedIdentifier _ table),
+     Just payload@(PayloadJSON uniform@(UniformObjects rows))) ->
+      case mutateSqlParts of
+        Left e -> return $ responseLBS status400 [jsonH] $ cs e
+        Right (sq,mq) -> do
+          let isSingle = (==1) $ V.length rows
+          let pKeys = map pkName $ filter (filterPk schema table) allPrKeys -- would it be ok to move primary key detection in the query itself?
+          let stm = createWriteStatement qi sq mq isSingle (iPreferRepresentation apiRequest) pKeys (contentType == TextCSV) payload
+          row <- H.query uniform stm
+          let (_, _, location, body) = extractQueryResult row
+          return $ responseLBS status201
+            [
+              contentTypeH,
+              (hLocation, "/" <> cs table <> "?" <> cs location)
+            ]
+            $ if iPreferRepresentation apiRequest == Full then cs body else ""
+
+    (ActionUpdate, TargetIdent qi, Just payload@(PayloadJSON uniform)) ->
+      case mutateSqlParts of
+        Left e -> return $ responseLBS status400 [jsonH] $ cs e
+        Right (sq,mq) -> do
+          let stm = createWriteStatement qi sq mq False (iPreferRepresentation apiRequest) [] (contentType == TextCSV) payload
+          row <- H.query uniform stm
+          let (_, queryTotal, _, body) = extractQueryResult row
+              r = contentRangeH 0 (toInteger $ queryTotal-1) (toInteger <$> Just queryTotal)
+              s = case () of _ | queryTotal == 0 -> status404
+                               | iPreferRepresentation apiRequest == Full -> status200
+                               | otherwise -> status204
+          return $ responseLBS s [contentTypeH, r]
+            $ if iPreferRepresentation apiRequest == Full then cs body else ""
+
+    (ActionDelete, TargetIdent qi, Nothing) ->
+      case mutateSqlParts of
+        Left e -> return $ responseLBS status400 [jsonH] $ cs e
+        Right (sq,mq) -> do
+          let emptyUniform = UniformObjects V.empty
+          let fakeload = PayloadJSON emptyUniform
+          let stm = createWriteStatement qi sq mq False (iPreferRepresentation apiRequest) [] (contentType == TextCSV) fakeload
+          row <- H.query emptyUniform stm
+          let (_, queryTotal, _, _) = extractQueryResult row
+          return $ if queryTotal == 0
+            then notFound
+            else responseLBS status204 [("Content-Range", "*/"<> cs (show queryTotal))] ""
+
+    (ActionInfo, TargetIdent (QualifiedIdentifier tSchema tTable), Nothing) ->
+      if isJust $ find (\t -> tableName t == tTable && tableSchema t == tSchema) (dbTables dbStructure)
+        then let cols = filter (filterCol tSchema tTable) $ dbColumns dbStructure
+                 pkeys = map pkName $ filter (filterPk tSchema tTable) allPrKeys
+                 body = encode (TableOptions cols pkeys)
+                 filterCol :: Schema -> TableName -> Column -> Bool
+                 filterCol sc tb Column{colTable=Table{tableSchema=s, tableName=t}} = s==sc && t==tb
+                 filterCol _ _ _ =  False in
+          return $ responseLBS status200 [jsonH, allOrigins] $ cs body
+        else
+          return notFound
+
+    (ActionInvoke, TargetProc qi,
+     Just (PayloadJSON (UniformObjects payload))) -> do
+      exists <- H.query qi doesProcExist
+      if exists
+        then do
+          let p = V.head payload
+              jwtSecret = configJwtSecret conf
+
+          bodyJson <- H.query () (callProc qi p)
+          returnJWT <- H.query qi doesProcReturnJWT
+          return $ responseLBS status200 [jsonH]
+                 (let body = fromMaybe emptyArray bodyJson in
+                    if returnJWT
+                    then "{\"token\":\"" <> cs (tokenJWT jwtSecret body) <> "\"}"
+                    else cs $ encode body)
+        else return notFound
+
+    (ActionRead, TargetRoot, Nothing) -> do
+      body <- encode <$> H.query schema accessibleTables
+      return $ responseLBS status200 [jsonH] $ cs body
+
+    (ActionInappropriate, _, _) -> return $ responseLBS status405 [] ""
+
+    (_, _, Just (PayloadParseError e)) ->
+      return $ responseLBS status400 [jsonH] $
+        cs (formatGeneralError "Cannot parse request payload" (cs e))
+
+    (_, TargetUnknown _, _) -> return notFound
+
+    (_, _, _) -> return notFound
+
+ where
+  notFound = responseLBS status404 [] ""
+  filterPk sc table pk = sc == (tableSchema . pkTable) pk && table == (tableName . pkTable) pk
+  allPrKeys = dbPrimaryKeys dbStructure
+  allOrigins = ("Access-Control-Allow-Origin", "*") :: Header
+  schema = cs $ configSchema conf
+  apiRequest = userApiRequest schema req reqBody
+  readDbRequest = DbRead <$> buildReadRequest (dbRelations dbStructure) apiRequest
+  mutateDbRequest = DbMutate <$> buildMutateRequest apiRequest
+  selectQuery = requestToQuery schema <$> readDbRequest
+  countQuery = requestToCountQuery schema <$> readDbRequest
+  mutateQuery = requestToQuery schema <$> mutateDbRequest
+  readSqlParts = (,) <$> selectQuery <*> countQuery
+  mutateSqlParts = (,) <$> selectQuery <*> mutateQuery
+
+rangeStatus :: Integer -> Integer -> Maybe Integer -> Status
+rangeStatus _ _ Nothing = status200
+rangeStatus frm to (Just total)
+  | frm > total            = status416
+  | (1 + to - frm) < total = status206
+  | otherwise               = status200
+
+contentRangeH :: Integer -> Integer -> Maybe Integer -> Header
+contentRangeH frm to total =
+    ("Content-Range", cs headerValue)
+    where
+      headerValue   = rangeString <> "/" <> totalString
+      rangeString
+        | totalNotZero && fromInRange = show frm <> "-" <> cs (show to)
+        | otherwise = "*"
+      totalString   = fromMaybe "*" (show <$> total)
+      totalNotZero  = fromMaybe True ((/=) 0 <$> total)
+      fromInRange   = frm <= to
+
+jsonH :: Header
+jsonH = (hContentType, "application/json")
+
+formatRelationError :: Text -> Text
+formatRelationError = formatGeneralError
+  "could not find foreign keys between these entities"
+
+formatParserError :: ParseError -> Text
+formatParserError e = formatGeneralError message details
+  where
+     message = cs $ show (errorPos e)
+     details = strip $ replace "\n" " " $ cs
+       $ showErrorMessages "or" "unknown parse error" "expecting" "unexpected" "end of input" (errorMessages e)
+
+formatGeneralError :: Text -> Text -> Text
+formatGeneralError message details = cs $ encode $ object [
+  "message" .= message,
+  "details" .= details]
+
+augumentRequestWithJoin :: Schema ->  [Relation] ->  ReadRequest -> Either Text ReadRequest
+augumentRequestWithJoin schema allRels request =
+  (first formatRelationError . addRelations schema allRels Nothing) request
+  >>= addJoinConditions schema
+
+buildReadRequest :: [Relation] -> ApiRequest -> Either Text ReadRequest
+buildReadRequest allRels apiRequest  =
+  augumentRequestWithJoin schema rels =<< first formatParserError (foldr addFilter <$> (addOrder <$> readRequest <*> ord) <*> flts)
+  where
+    selStr = iSelect apiRequest
+    orderS = iOrder apiRequest
+    action = iAction apiRequest
+    target = iTarget apiRequest
+    (schema, rootTableName) = fromJust $ -- Make it safe
+      case target of
+        (TargetIdent (QualifiedIdentifier s t) ) -> Just (s, t)
+        _ -> Nothing
+
+    rootName = if action == ActionRead
+      then rootTableName
+      else sourceCTEName
+    filters = if action == ActionRead
+      then iFilters apiRequest
+      else filter (( '.' `elem` ) . fst) $ iFilters apiRequest -- there can be no filters on the root table whre we are doing insert/update
+    rels = case action of
+      ActionCreate -> fakeSourceRelations ++ allRels
+      ActionUpdate -> fakeSourceRelations ++ allRels
+      _       -> allRels
+      where fakeSourceRelations = mapMaybe (toSourceRelation rootTableName) allRels -- see comment in toSourceRelation
+    readRequest = parse (pRequestSelect rootName) ("failed to parse select parameter <<"++selStr++">>") selStr
+    addOrder (Node (q,i) f) o = Node (q{order=o}, i) f
+    flts = mapM pRequestFilter filters
+    ord = traverse (parse pOrder ("failed to parse order parameter <<"++fromMaybe "" orderS++">>")) orderS
+
+buildMutateRequest :: ApiRequest -> Either Text MutateRequest
+buildMutateRequest apiRequest =
+  mutateApiRequest
+  where
+    action = iAction apiRequest
+    target = iTarget apiRequest
+    payload = fromJust $ iPayload apiRequest
+    rootTableName = -- TODO: Make it safe
+      case target of
+        (TargetIdent (QualifiedIdentifier _ t) ) -> t
+        _ -> undefined
+    mutateApiRequest = case action of
+      ActionCreate -> Insert rootTableName <$> pure payload
+      ActionUpdate -> Update rootTableName <$> pure payload <*> cond
+      ActionDelete -> Delete rootTableName <$> cond
+      _        -> Left "Unsupported HTTP verb"
+    mutateFilters = filter (not . ( '.' `elem` ) . fst) $ iFilters apiRequest -- update/delete filters can be only on the root table
+    cond = first formatParserError $ map snd <$> mapM pRequestFilter mutateFilters
+
+addFilter :: (Path, Filter) -> ReadRequest -> ReadRequest
+addFilter ([], flt) (Node (q@Select {flt_=flts}, i) forest) = Node (q {flt_=flt:flts}, i) forest
+addFilter (path, flt) (Node rn forest) =
+  case targetNode of
+    Nothing -> Node rn forest -- the filter is silenty dropped in the Request does not contain the required path
+    Just tn -> Node rn (addFilter (remainingPath, flt) tn:restForest)
+  where
+    targetNodeName:remainingPath = path
+    (targetNode,restForest) = splitForest targetNodeName forest
+    splitForest name forst =
+      case maybeNode of
+        Nothing -> (Nothing,forest)
+        Just node -> (Just node, delete node forest)
+      where maybeNode = find ((name==).fst.snd.rootLabel) forst
+
+-- in a relation where one of the tables mathces "TableName"
+-- replace the name to that table with pg_source
+-- this "fake" relations is needed so that in a mutate query
+-- we can look a the "returning *" part which is wrapped with a "with"
+-- as just another table that has relations with other tables
+toSourceRelation :: TableName -> Relation -> Maybe Relation
+toSourceRelation mt r@(Relation t _ ft _ _ rt _ _)
+  | mt == tableName t = Just $ r {relTable=t {tableName=sourceCTEName}}
+  | mt == tableName ft = Just $ r {relFTable=t {tableName=sourceCTEName}}
+  | Just mt == (tableName <$> rt) = Just $ r {relLTable=(\tbl -> tbl {tableName=sourceCTEName}) <$> rt}
+  | otherwise = Nothing
+
+data TableOptions = TableOptions {
+  tblOptcolumns :: [Column]
+, tblOptpkey    :: [Text]
+}
+
+instance ToJSON TableOptions where
+  toJSON t = object [
+      "columns" .= tblOptcolumns t
+    , "pkey"   .= tblOptpkey t ]
+
+
+extractQueryResult :: Maybe ResultsWithCount -> ResultsWithCount
+extractQueryResult = fromMaybe (Nothing, 0, "", "")

src/PostgREST/Auth.hs

@@ -0,0 +1,85 @@
+{-# 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 (
+    setRole
+  , claimsToSQL
+  , jwtClaims
+  , tokenJWT
+  ) where
+
+import           Control.Monad           (join)
+import           Data.Aeson              (Value (..), Object)
+import           Data.Aeson.Types        (emptyObject, emptyArray)
+import qualified Data.ByteString         as BS
+import           Data.Vector             as V (null, head)
+import           Data.Map                as M (fromList, toList)
+import           Data.Monoid             ((<>))
+import           Data.String.Conversions (cs)
+import           Data.Text               (Text)
+import           Data.Time.Clock         (NominalDiffTime)
+import           PostgREST.QueryBuilder  (pgFmtLit, pgFmtIdent, unquoted)
+import qualified Web.JWT                 as JWT
+import qualified Data.HashMap.Lazy       as H
+
+{-|
+  Receives a map of JWT claims and returns a list
+  of PostgreSQL statements to set the claims as user defined GUCs.
+  Except if we have a claim called role,
+  this one is mapped to a SET ROLE statement.
+  In case there is any problem decoding the JWT it returns Nothing.
+-}
+claimsToSQL :: JWT.ClaimsMap -> [BS.ByteString]
+claimsToSQL = map setVar . toList
+  where
+    setVar ("role", String val) = setRole val
+    setVar (k, val) = "set local postgrest.claims." <> cs (pgFmtIdent k) <>
+                      " = " <> cs (valueToVariable val) <> ";"
+    valueToVariable = pgFmtLit . unquoted
+
+{-|
+  Receives the JWT secret (from config) and a JWT and
+  returns a map of JWT claims
+  In case there is any problem decoding the JWT it returns Nothing.
+-}
+jwtClaims :: JWT.Secret -> Text -> NominalDiffTime -> Maybe JWT.ClaimsMap
+jwtClaims secret input time =
+  case join $ claim JWT.exp of
+    Just expires ->
+      if JWT.secondsSinceEpoch expires > time
+        then customClaims
+        else Nothing
+    _ -> customClaims
+  where
+    decoded = JWT.decodeAndVerifySignature secret input
+    claim :: (JWT.JWTClaimsSet -> a) -> Maybe a
+    claim prop = prop . JWT.claims <$> decoded
+    customClaims = claim JWT.unregisteredClaims
+
+{-| Receives the name of a role and returns a SET ROLE statement -}
+setRole :: Text -> BS.ByteString
+setRole r = "set local role " <> cs (pgFmtLit r) <> ";"
+
+
+{-|
+  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 a) = JWT.encodeSigned JWT.HS256 secret
+                               JWT.def { JWT.unregisteredClaims = fromHashMap o }
+                          where
+                            Object o = if V.null a then emptyObject else V.head a
+                            fromHashMap :: Object -> JWT.ClaimsMap
+                            fromHashMap = M.fromList . H.toList
+tokenJWT secret _          = tokenJWT secret emptyArray

src/PostgREST/Config.hs

@@ -0,0 +1,101 @@
+{-|
+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
+                        , AppConfig (..)
+                        )
+       where
+
+import           Control.Applicative
+import qualified Data.ByteString.Char8       as BS
+import qualified Data.CaseInsensitive        as CI
+import           Data.List                   (intercalate)
+import           Data.String.Conversions     (cs)
+import           Data.Text                   (strip)
+import           Data.Version                (versionBranch)
+import           Network.Wai
+import           Network.Wai.Middleware.Cors (CorsResourcePolicy (..))
+import           Options.Applicative
+import           Paths_postgrest             (version)
+import           Safe                        (readMay)
+import           Web.JWT                     (Secret, secret)
+import           Prelude
+
+-- | Data type to store all command line options
+data AppConfig = AppConfig {
+    configDatabase  :: String
+  , configAnonRole  :: String
+  , configSchema    :: String
+  , configPort      :: Int
+  , configJwtSecret :: Secret
+  , configPool      :: Int
+  , configMaxRows   :: Maybe Integer
+  }
+
+argParser :: Parser AppConfig
+argParser = AppConfig
+  <$> argument str (help "(REQUIRED) database connection string, e.g. postgres://user:pass@host:port/db" <> metavar "DB_URL")
+  <*> strOption    (long "anonymous"  <> short 'a' <> help "(REQUIRED) postgres role to use for non-authenticated requests" <> metavar "ROLE")
+  <*> strOption    (long "schema"     <> short 's' <> help "schema to use for API routes" <> metavar "NAME" <> value "public" <> showDefault)
+  <*> option auto  (long "port"       <> short 'p' <> help "port number on which to run HTTP server" <> metavar "PORT" <> value 3000 <> showDefault)
+  <*> (secret . cs <$>
+      strOption    (long "jwt-secret" <> short 'j' <> help "secret used to encrypt and decrypt JWT tokens" <> metavar "SECRET" <> value "secret" <> showDefault))
+  <*> option auto  (long "pool"       <> short 'o' <> help "max connections in database pool" <> metavar "COUNT" <> value 10 <> showDefault)
+  <*> (readMay <$> strOption  (long "max-rows"   <> short 'm' <> help "max rows in response" <> metavar "COUNT" <> value "infinity" <> showDefault))
+
+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 . cs . strip . cs) $ BS.split ',' hdrs
+      Nothing -> []
+
+-- | User friendly version number
+prettyVersion :: String
+prettyVersion = intercalate "." $ map show $ versionBranch version
+
+-- | Function to read and parse options from the command line
+readOptions :: IO AppConfig
+readOptions = customExecParser parserPrefs opts
+  where
+    opts = info (helper <*> argParser) $
+                    fullDesc
+                    <> progDesc (
+                    "PostgREST "
+                    <> prettyVersion
+                    <> " / create a REST API to an existing Postgres database"
+                    )
+    parserPrefs = prefs showHelpOnError
+
+-- | Tells the minimum PostgreSQL version required by this version of PostgREST
+minimumPgVersion :: Integer
+minimumPgVersion = 90300

src/PostgREST/DbStructure.hs

@@ -0,0 +1,628 @@
+{-# LANGUAGE FlexibleContexts      #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE QuasiQuotes           #-}
+{-# LANGUAGE ScopedTypeVariables   #-}
+{-# LANGUAGE TypeSynonymInstances  #-}
+module PostgREST.DbStructure (
+  getDbStructure
+, accessibleTables
+, doesProcExist
+, doesProcReturnJWT
+) where
+
+import qualified Hasql.Query             as H
+import qualified Hasql.Encoders          as HE
+import qualified Hasql.Decoders          as HD
+
+import           Control.Applicative
+import           Control.Monad          (join, replicateM)
+import           Data.Functor.Contravariant (contramap)
+import           Text.InterpolatedString.Perl6 (q)
+import           Data.List              (elemIndex, find, subsequences, sort, transpose)
+import           Data.Maybe             (fromMaybe, fromJust, isJust, mapMaybe, listToMaybe)
+import           Data.Monoid
+import           Data.Text              (Text, split)
+import qualified Hasql.Session          as H
+import           PostgREST.Types
+
+import           GHC.Exts               (groupWith)
+import           Data.Int               (Int32)
+import           Prelude
+
+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
+
+  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'
+    }
+
+encodeQi :: HE.Params QualifiedIdentifier
+encodeQi =
+  contramap qiSchema (HE.value HE.text) <>
+  contramap qiName   (HE.value HE.text)
+
+decodeTables :: HD.Result [Table]
+decodeTables =
+  HD.rowsList tblRow
+ where
+  tblRow = Table <$> HD.value HD.text <*> HD.value HD.text
+                 <*> 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
+
+doesProcExist :: H.Query QualifiedIdentifier Bool
+doesProcExist =
+  H.statement sql encodeQi (HD.singleRow (HD.value HD.bool)) True
+ where
+  sql = [q| SELECT EXISTS (
+      SELECT 1
+      FROM   pg_catalog.pg_namespace n
+      JOIN   pg_catalog.pg_proc p
+      ON     pronamespace = n.oid
+      WHERE  nspname = $1
+      AND    proname = $2
+    ) |]
+
+doesProcReturnJWT :: H.Query QualifiedIdentifier Bool
+doesProcReturnJWT =
+  H.statement sql encodeQi (HD.singleRow (HD.value HD.bool)) True
+ where
+  sql = [q| SELECT EXISTS (
+      SELECT 1
+      FROM   pg_catalog.pg_namespace n
+      JOIN   pg_catalog.pg_proc p
+      ON     pronamespace = n.oid
+      WHERE  nspname = $1
+      AND    proname = $2
+      AND    pg_catalog.pg_get_function_result(p.oid) like '%jwt_claims'
+    ) |]
+
+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 = sort $ filter ((== colTable (head cols)) . colTable . fst) allSyns
+    synCols  = transpose $ map (\c -> map snd $ filter ((== c) . fst) syns) cols
+    synCols' = (filter sameTable . filter matchLength) synCols
+    matchLength cs = length cols == length cs
+    sameTable (c:cs) = all (\cc -> colTable c == colTable cc) (c:cs)
+    sameTable [] = False
+
+addForeignKeys :: [Relation] -> [Column] -> [Column]
+addForeignKeys rels = map addFk
+  where
+    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
+    -- lookupFn _ _ = False
+    relToFk col Relation{relColumns=cols, relFColumns=colsF} = ForeignKey <$> colF
+      where
+        pos = elemIndex col cols
+        colF = (colsF !!) <$> pos
+
+addSynonymousRelations :: [(Column,Column)] -> [Relation] -> [Relation]
+addSynonymousRelations _ [] = []
+addSynonymousRelations syns (rel:rels) = rel : synRelsP ++ synRelsF ++ addSynonymousRelations syns rels
+  where
+    synRelsP = synRels (relColumns rel) (\t cs -> rel{relTable=t,relColumns=cs})
+    synRelsF = synRels (relFColumns rel) (\t cs -> rel{relFTable=t,relFColumns=cs})
+    synRels cols mapFn = map (\cs -> mapFn (colTable $ head cs) cs) $ synonymousColumns syns cols
+
+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 . head) (synonymousColumns syns cols)
+        newTable = (colTable . head) <$> newCols
+
+synonymousPrimaryKeys :: [(Column,Column)] -> [PrimaryKey] -> [PrimaryKey]
+synonymousPrimaryKeys _ [] = []
+synonymousPrimaryKeys syns (key:keys) = key : newKeys ++ synonymousPrimaryKeys syns keys
+  where
+    keySyns = filter ((\c -> colTable c == pkTable key && colName c == pkName key) . fst) syns
+    newKeys = map ((\c -> PrimaryKey{pkTable=colTable c,pkName=colName c}) . snd) keySyns
+
+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 'USER-DEFINED'::text
+                        END
+                        ELSE
+                        CASE
+                            WHEN t.typelem <> 0::oid AND t.typlen = (-1) THEN 'ARRAY'::text
+                            WHEN nt.nspname = 'pg_catalog'::name THEN format_type(a.atttypid, NULL::integer)
+                            ELSE 'USER-DEFINED'::text
+                        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
+  sql = [q|
+    WITH synonyms AS (
+      /*
+      -- CTE to replace the view from information_schema because the information in it depended on the logged in role
+      -- notice the commented line
+      */
+      WITH view_column_usage AS (
+        SELECT DISTINCT
+               CAST(current_database() AS character varying) AS view_catalog,
+               CAST(nv.nspname AS character varying) AS view_schema,
+               CAST(v.relname AS character varying) AS view_name,
+               CAST(current_database() AS character varying) AS table_catalog,
+               CAST(nt.nspname AS character varying) AS table_schema,
+               CAST(t.relname AS character varying) AS table_name,
+               CAST(a.attname AS character varying) AS column_name
+        FROM pg_namespace nv, pg_class v, pg_depend dv,
+             pg_depend dt, pg_class t, pg_namespace nt,
+             pg_attribute a
+        WHERE nv.oid = v.relnamespace
+              AND v.relkind = 'v'
+              AND v.oid = dv.refobjid
+              AND dv.refclassid = 'pg_catalog.pg_class'::regclass
+              AND dv.classid = 'pg_catalog.pg_rewrite'::regclass
+              AND dv.deptype = 'i'
+              AND dv.objid = dt.objid
+              AND dv.refobjid <> dt.refobjid
+              AND dt.classid = 'pg_catalog.pg_rewrite'::regclass
+              AND dt.refclassid = 'pg_catalog.pg_class'::regclass
+              AND dt.refobjid = t.oid
+              AND t.relnamespace = nt.oid
+              AND t.relkind IN ('r', 'v', 'f')
+              AND t.oid = a.attrelid
+              AND dt.refobjsubid = a.attnum
+              /*--AND pg_has_role(t.relowner, 'USAGE')*/
+      )
+      SELECT
+        vcu.table_schema AS src_table_schema,
+        vcu.table_name AS src_table_name,
+        vcu.column_name AS src_column_name,
+        view.schemaname AS syn_table_schema,
+        view.viewname AS syn_table_name,
+        view.definition AS view_definition
+      FROM
+        pg_catalog.pg_views AS view,
+        view_column_usage AS vcu
+      WHERE
+        view.schemaname = vcu.view_schema AND
+        view.viewname = vcu.view_name AND
+        view.schemaname NOT IN ('pg_catalog', 'information_schema')
+        /*--AND (SELECT COUNT(*) FROM information_schema.view_table_usage WHERE view_schema = view.schemaname AND view_name = view.viewname) = 1*/
+    )
+    SELECT
+      src_table_schema, src_table_name, src_column_name,
+      syn_table_schema, syn_table_name,
+      (regexp_matches(view_definition, CONCAT('\.(', src_column_name, ')(?=,|$)'), 'gn'))[1] AS syn_column_name
+    FROM synonyms
+    UNION (
+      SELECT
+        src_table_schema, src_table_name, src_column_name,
+        syn_table_schema, syn_table_name,
+        (regexp_matches(view_definition, CONCAT('\.', src_column_name, '\sAS\s("?)(.+?)\1(,|$)'), 'gn'))[2] AS syn_column_name /* " <- for syntax highlighting */
+      FROM synonyms
+    ) |]
+
+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

src/PostgREST/Error.hs

@@ -0,0 +1,83 @@
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+{-# LANGUAGE FlexibleInstances    #-}
+{-# LANGUAGE TypeSynonymInstances #-}
+
+module PostgREST.Error (pgErrResponse, errResponse) where
+
+
+import           Data.Aeson                ((.=))
+import qualified Data.Aeson                as JSON
+import           Data.Monoid               ((<>))
+import           Data.String.Conversions   (cs)
+import           Data.Text                 (Text)
+import qualified Data.Text                 as T
+import qualified Hasql.Session             as H
+import           Network.HTTP.Types.Header
+import qualified Network.HTTP.Types.Status as HT
+import           Network.Wai               (Response, responseLBS)
+
+errResponse :: HT.Status -> Text -> Response
+errResponse status message = responseLBS status [(hContentType, "application/json")] (cs $ T.concat ["{\"message\":\"",message,"\"}"])
+
+pgErrResponse :: H.Error -> Response
+pgErrResponse e = responseLBS (httpStatus e)
+  [(hContentType, "application/json")] (JSON.encode e)
+
+instance JSON.ToJSON H.Error where
+  toJSON (H.ResultError (H.ServerError c m d h)) = JSON.object [
+    "code" .= (cs c::T.Text),
+    "message" .= (cs m::T.Text),
+    "details" .= (fmap cs d::Maybe T.Text),
+    "hint" .= (fmap cs h::Maybe T.Text)]
+  toJSON (H.ResultError (H.UnexpectedResult m)) = JSON.object [
+    "message" .= (cs m::T.Text)]
+  toJSON (H.ResultError (H.RowError i H.EndOfInput)) = JSON.object [
+    "message" .= ("Row error: end of input"::String),
+    "details" .=
+      ("Attempt to parse more columns than there are in the result"::String),
+    "details" .= ("Row number " <> show i)]
+  toJSON (H.ResultError (H.RowError i H.UnexpectedNull)) = JSON.object [
+    "message" .= ("Row error: unexpected null"::String),
+    "details" .= ("Attempt to parse a NULL as some value."::String),
+    "details" .= ("Row number " <> show i)]
+  toJSON (H.ResultError (H.RowError i (H.ValueError d))) = JSON.object [
+    "message" .= ("Row error: Wrong value parser used"::String),
+    "details" .= d,
+    "details" .= ("Row number " <> show i)]
+  toJSON (H.ResultError (H.UnexpectedAmountOfRows i)) = JSON.object [
+    "message" .= ("Unexpected amount of rows"::String),
+    "details" .= i]
+  toJSON (H.ClientError d) = JSON.object [
+    "message" .= ("Database client error"::String),
+    "details" .= (fmap cs d::Maybe T.Text)]
+
+httpStatus :: H.Error -> HT.Status
+httpStatus (H.ResultError (H.ServerError c _ _ _)) =
+  case cs 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
+    'P':'0':_ -> HT.status500 -- PL/pgSQL Error
+    'X':'X':_ -> HT.status500 -- internal Error
+    "42P01" -> HT.status404 -- undefined table
+    "42501" -> HT.status404 -- insufficient privilege
+    _ -> HT.status400
+httpStatus (H.ResultError _) = HT.status500
+httpStatus (H.ClientError _) = HT.status503

src/PostgREST/Main.hs

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

src/PostgREST/Middleware.hs

@@ -0,0 +1,65 @@
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
+module PostgREST.Middleware where
+
+import           Data.Maybe                    (fromMaybe)
+import           Data.Text
+import           Data.String.Conversions       (cs)
+import           Data.Time.Clock               (NominalDiffTime)
+import qualified Hasql.Session                 as H
+
+import           Network.HTTP.Types.Header     (hAccept, hAuthorization)
+import           Network.HTTP.Types.Status     (status415, status400)
+import           Network.Wai                   (Application, Request (..), Response,
+                                                requestHeaders)
+import           Network.Wai.Middleware.Cors   (cors)
+import           Network.Wai.Middleware.Gzip   (def, gzip)
+import           Network.Wai.Middleware.Static (only, staticPolicy)
+
+import           PostgREST.ApiRequest       (pickContentType)
+import           PostgREST.Auth                (setRole, jwtClaims, claimsToSQL)
+import           PostgREST.Config              (AppConfig (..), corsPolicy)
+import           PostgREST.Error               (errResponse)
+
+import           Prelude hiding(concat)
+
+import qualified Data.Map.Lazy           as M
+
+runWithClaims :: AppConfig -> NominalDiffTime ->
+                 (Request -> H.Session Response) ->
+                 Request -> H.Session Response
+runWithClaims conf time app req = do
+    H.sql setAnon
+    case split (== ' ') (cs auth) of
+      ("Bearer" : tokenStr : _) ->
+        case jwtClaims jwtSecret tokenStr time of
+          Just claims ->
+            if M.member "role" claims
+            then do
+              mapM_ H.sql $ claimsToSQL claims
+              app req
+            else invalidJWT
+          _ -> invalidJWT
+      _ -> app req
+  where
+    hdrs = requestHeaders req
+    jwtSecret = configJwtSecret conf
+    auth = fromMaybe "" $ lookup hAuthorization hdrs
+    anon = cs $ configAnonRole conf
+    setAnon = setRole anon
+    invalidJWT = return $ errResponse status400 "Invalid JWT"
+
+unsupportedAccept :: Application -> Application
+unsupportedAccept app req respond =
+  case accept of
+    Left _ -> respond $ errResponse status415 "Unsupported Accept header, try: application/json"
+    Right _ -> app req respond
+  where accept = pickContentType $ lookup hAccept $ requestHeaders req
+
+defaultMiddle :: Application -> Application
+defaultMiddle =
+    gzip def
+  . cors corsPolicy
+  . staticPolicy (only [("favicon.ico", "static/favicon.ico")])
+  . unsupportedAccept

src/PostgREST/Parsers.hs

@@ -0,0 +1,112 @@
+module PostgREST.Parsers
+-- ( parseGetRequest
+-- )
+where
+
+import           Control.Applicative hiding ((<$>))
+import           Data.Monoid
+import           Data.String.Conversions       (cs)
+import           Data.Text                     (Text)
+import           Data.Tree
+import           PostgREST.Types
+import           Text.ParserCombinators.Parsec hiding (many, (<|>))
+import           PostgREST.QueryBuilder (operators)
+
+pRequestSelect :: Text -> Parser ReadRequest
+pRequestSelect rootNodeName = do
+  fieldTree <- pFieldForest
+  return $ foldr treeEntry (Node (Select [] [rootNodeName] [] Nothing, (rootNodeName, Nothing)) []) fieldTree
+  where
+    treeEntry :: Tree SelectItem -> ReadRequest -> ReadRequest
+    treeEntry (Node fld@((fn, _),_) fldForest) (Node (q, i) rForest) =
+      case fldForest of
+        [] -> Node (q {select=fld:select q}, i) rForest
+        _  -> Node (q, i) (foldr treeEntry (Node (Select [] [fn] [] Nothing, (fn, Nothing)) []) fldForest:rForest)
+
+pRequestFilter :: (String, String) -> Either ParseError (Path, Filter)
+pRequestFilter (k, v) = (,) <$> path <*> (Filter <$> fld <*> op <*> val)
+  where
+    treePath = parse pTreePath ("failed to parser tree path (" ++ k ++ ")") k
+    opVal = parse pOpValueExp ("failed to parse filter (" ++ v ++ ")") v
+    path = fst <$> treePath
+    fld = snd <$> treePath
+    op = fst <$> opVal
+    val = snd <$> opVal
+
+ws :: Parser Text
+ws = cs <$> many (oneOf " \t")
+
+lexeme :: Parser a -> Parser a
+lexeme p = ws *> p <* ws
+
+pTreePath :: Parser (Path,Field)
+pTreePath = do
+  p <- pFieldName `sepBy1` pDelimiter
+  jp <- optionMaybe pJsonPath
+  let pp = map cs p
+      jpp = map cs <$> jp
+  return (init pp, (last pp, jpp))
+
+pFieldForest :: Parser [Tree SelectItem]
+pFieldForest = pFieldTree `sepBy1` lexeme (char ',')
+
+pFieldTree :: Parser (Tree SelectItem)
+pFieldTree = try (Node <$> pSelect <*> between (char '{') (char '}') pFieldForest)
+          <|>     Node <$> pSelect <*> pure []
+
+pStar :: Parser Text
+pStar = cs <$> (string "*" *> pure ("*"::String))
+
+pFieldName :: Parser Text
+pFieldName =  cs <$> (many1 (letter <|> digit <|> oneOf "_")
+          <?> "field name (* or [a..z0..9_])")
+
+pJsonPathStep :: Parser Text
+pJsonPathStep = cs <$> try (string "->" *> pFieldName)
+
+pJsonPath :: Parser [Text]
+pJsonPath = (++) <$> many pJsonPathStep <*> ( (:[]) <$> (string "->>" *> pFieldName) )
+
+pField :: Parser Field
+pField = lexeme $ (,) <$> pFieldName <*> optionMaybe pJsonPath
+
+pSelect :: Parser SelectItem
+pSelect = lexeme $
+  try ((,) <$> pField <*>((cs <$>) <$> optionMaybe (string "::" *> many letter)) )
+  <|> do
+    s <- pStar
+    return ((s, Nothing), Nothing)
+
+pOperator :: Parser Operator
+pOperator = cs <$> (pOp <?> "operator (eq, gt, ...)")
+  where pOp = foldl (<|>) empty $ map (try . string . cs . fst) operators
+
+pValue :: Parser FValue
+pValue = VText <$> (cs <$> many anyChar)
+
+pDelimiter :: Parser Char
+pDelimiter = char '.' <?> "delimiter (.)"
+
+pOperatiorWithNegation :: Parser Operator
+pOperatiorWithNegation = try ( (<>) <$> ( cs <$> string "not." ) <*>  pOperator) <|> pOperator
+
+pOpValueExp :: Parser (Operator, FValue)
+pOpValueExp = (,) <$> pOperatiorWithNegation <*> (pDelimiter *> pValue)
+
+pOrder :: Parser [OrderTerm]
+pOrder = lexeme pOrderTerm `sepBy` char ','
+
+pOrderTerm :: Parser OrderTerm
+pOrderTerm =
+  try ( do
+    c <- pFieldName
+    _ <- pDelimiter
+    d <- (string "asc" *> pure OrderAsc)
+         <|> (string "desc" *> pure OrderDesc)
+    nls <- optionMaybe (pDelimiter *> (
+                 try(string "nullslast" *> pure OrderNullsLast)
+             <|> try(string "nullsfirst" *> pure OrderNullsFirst)
+           ))
+    return $ OrderTerm c d nls
+  )
+  <|> OrderTerm <$> (cs <$> pFieldName) <*> pure OrderAsc <*> pure Nothing

src/PostgREST/QueryBuilder.hs

@@ -0,0 +1,523 @@
+{-# LANGUAGE FlexibleInstances    #-}
+{-# LANGUAGE FlexibleContexts     #-}
+{-# 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 (
+    addRelations
+  , addJoinConditions
+  , callProc
+  , createReadStatement
+  , createWriteStatement
+  , inTransaction
+  , operators
+  , pgFmtIdent
+  , pgFmtLit
+  , requestToQuery
+  , requestToCountQuery
+  , sourceCTEName
+  , unquoted
+  , ResultsWithCount
+  , Isolation(..)
+  ) where
+
+import qualified Hasql.Query             as H
+import qualified Hasql.Session           as H
+import qualified Hasql.Encoders          as HE
+import qualified Hasql.Decoders          as HD
+
+import qualified Data.Aeson              as JSON
+import           Data.Int                (Int64)
+
+import           PostgREST.RangeQuery    (NonnegRange, rangeLimit, rangeOffset)
+import           Control.Error           (note, fromMaybe, mapMaybe)
+import           Data.Functor.Contravariant (contramap)
+import qualified Data.HashMap.Strict     as HM
+import           Data.List               (find, (\\))
+import           Data.Monoid             ((<>))
+import           Data.Text               (Text, intercalate, unwords, replace, isInfixOf, toLower, split)
+import qualified Data.Text as T          (map, takeWhile)
+import           Data.String.Conversions (cs)
+import           Control.Applicative     ((<|>))
+import           Control.Monad           (join)
+import           Data.Tree               (Tree(..))
+import qualified Data.Vector as V
+import           PostgREST.Types
+import qualified Data.Map as M
+import           Text.InterpolatedString.Perl6 (qc)
+import           Text.Regex.TDFA         ((=~))
+import qualified Data.ByteString.Char8   as BS
+import           Data.Scientific         ( FPFormat (..)
+                                         , formatScientific
+                                         , isInteger
+                                         )
+import           Prelude hiding          (unwords)
+import           PostgREST.ApiRequest    (PreferRepresentation (..))
+
+
+{-| The generic query result format used by API responses -}
+type ResultsWithCount = (Maybe Int64, Int64, BS.ByteString, BS.ByteString)
+
+{-| 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
+ where
+  standardRow = (,,,) <$> HD.nullableValue HD.int8 <*> HD.value HD.int8
+                      <*> HD.value HD.bytea <*> HD.value HD.bytea
+
+decodeStandardMay :: HD.Result (Maybe ResultsWithCount)
+decodeStandardMay =
+  HD.maybeRow standardRow
+ where
+  standardRow = (,,,) <$> HD.nullableValue HD.int8 <*> HD.value HD.int8
+                      <*> HD.value HD.bytea <*> HD.value HD.bytea
+
+{-| JSON and CSV payloads from the client are given to us as
+    UniformObjects (objects who all have the same keys),
+    and we turn this into an old fasioned JSON array
+-}
+encodeUniformObjs :: HE.Params UniformObjects
+encodeUniformObjs =
+  contramap (JSON.Array . V.map JSON.Object . unUniformObjects) (HE.value HE.json)
+
+createReadStatement :: SqlQuery -> SqlQuery -> NonnegRange -> Bool -> Bool -> Bool ->
+                       H.Query () ResultsWithCount
+createReadStatement selectQuery countQuery range isSingle countTotal asCsv =
+  H.statement sql HE.unit decodeStandard True
+ where
+  sql = [qc|
+      WITH {sourceCTEName} AS ({selectQuery}) SELECT {cols}
+      FROM ( SELECT * FROM {sourceCTEName} {limitF range}) t |]
+  countResultF = if countTotal then "("<>countQuery<>")" else "null"
+  cols = intercalate ", " [
+      countResultF <> " AS total_result_set",
+      "pg_catalog.count(t) AS page_total",
+      "'' AS header",
+      bodyF <> " AS body"
+    ]
+  bodyF
+    | asCsv = asCsvF
+    | isSingle = asJsonSingleF
+    | otherwise = asJsonF
+
+createWriteStatement :: QualifiedIdentifier -> SqlQuery -> SqlQuery -> Bool ->
+                        PreferRepresentation -> [Text] -> Bool -> Payload ->
+                        H.Query UniformObjects (Maybe ResultsWithCount)
+createWriteStatement _ _ _ _ _ _ _ (PayloadParseError _) = undefined
+createWriteStatement _ _ mutateQuery _ None
+                     _ _ (PayloadJSON (UniformObjects _)) =
+  H.statement sql encodeUniformObjs decodeStandardMay True
+ where
+  sql = [qc|
+      WITH {sourceCTEName} AS ({mutateQuery})
+      SELECT '', 0, '', '' |]
+
+createWriteStatement qi _ mutateQuery isSingle HeadersOnly
+                     pKeys _ (PayloadJSON (UniformObjects _)) =
+  H.statement sql encodeUniformObjs decodeStandardMay True
+ where
+  sql = [qc|
+      WITH {sourceCTEName} AS ({mutateQuery} RETURNING {fromQi qi}.*)
+      SELECT {cols}
+      FROM (SELECT 1 FROM {sourceCTEName}) t |]
+  cols = intercalate ", " [
+      "'' AS total_result_set",
+      "pg_catalog.count(t) AS page_total",
+      if isSingle then locationF pKeys else "''",
+      "''"
+    ]
+
+createWriteStatement qi selectQuery mutateQuery isSingle Full
+                     pKeys asCsv (PayloadJSON (UniformObjects _)) =
+  H.statement sql encodeUniformObjs decodeStandardMay True
+ where
+  sql = [qc|
+      WITH {sourceCTEName} AS ({mutateQuery} RETURNING {fromQi qi}.*)
+      SELECT {cols}
+      FROM ({selectQuery}) t |]
+  cols = intercalate ", " [
+      "'' AS total_result_set", -- when updateing it does not make sense
+      "pg_catalog.count(t) AS page_total",
+      if isSingle then locationF pKeys else "''" <> " AS header",
+      bodyF <> " AS body"
+    ]
+  bodyF
+    | asCsv = asCsvF
+    | isSingle = asJsonSingleF
+    | otherwise = asJsonF
+
+addRelations :: Schema -> [Relation] -> Maybe ReadRequest -> ReadRequest -> Either Text ReadRequest
+addRelations schema allRelations parentNode node@(Node readNode@(query, (name, _)) forest) =
+  case parentNode of
+    (Just (Node (Select{from=[parentTable]}, (_, _)) _)) -> Node <$> (addRel readNode <$> rel) <*> updatedForest
+      where
+        rel = note ("no relation between " <> parentTable <> " and " <> name)
+            $  findRelationByTable schema name parentTable
+           <|> findRelationByColumn schema parentTable name
+        addRel :: (ReadQuery, (NodeName, Maybe Relation)) -> Relation -> (ReadQuery, (NodeName, Maybe Relation))
+        addRel (query', (n, _)) r = (query' {from=fromRelation}, (n, Just r))
+          where fromRelation = map (\t -> if t == n then tableName (relTable r) else t) (from query')
+
+    _ -> Node (query, (name, Nothing)) <$> updatedForest
+  where
+    updatedForest = mapM (addRelations schema allRelations (Just node)) forest
+    -- Searches through all the relations and returns a match given the parameter conditions.
+    -- Will only find a relation where both schemas are in the PostgREST schema.
+    -- `findRelationByColumn` also does a ducktype check to see if the column name has any variation of `id` or `fk`. If so then the relation is returned as a match.
+    findRelationByTable s t1 t2 =
+      find (\r -> s == tableSchema (relTable r) && s == tableSchema (relFTable r) && t1 == tableName (relTable r) && t2 == tableName (relFTable r)) allRelations
+    findRelationByColumn s t c =
+      find (\r -> s == tableSchema (relTable r) && s == tableSchema (relFTable r) && t == tableName (relFTable r) && length (relFColumns r) == 1 && c `colMatches` (colName . head . relFColumns) r) allRelations
+      where n `colMatches` rc = (cs ("^" <> rc <> "_?(?:|[iI][dD]|[fF][kK])$") :: BS.ByteString) =~ (cs n :: BS.ByteString)
+
+addJoinConditions :: Schema -> ReadRequest -> Either Text ReadRequest
+addJoinConditions schema (Node (query, (n, r)) forest) =
+  case r of
+    Nothing -> Node (updatedQuery, (n,r))  <$> updatedForest -- this is the root node
+    Just rel@Relation{relType=Child} -> Node (addCond updatedQuery (getJoinConditions rel),(n,r)) <$> updatedForest
+    Just Relation{relType=Parent} -> Node (updatedQuery, (n,r)) <$> updatedForest
+    Just rel@Relation{relType=Many, relLTable=(Just linkTable)} ->
+      Node (qq, (n, r)) <$> updatedForest
+      where
+         query' = addCond updatedQuery (getJoinConditions rel)
+         qq = query'{from=tableName linkTable : from query'}
+    _ -> Left "unknown relation"
+  where
+    -- add parentTable and parentJoinConditions to the query
+    updatedQuery = foldr (flip addCond) query parentJoinConditions
+      where
+        parentJoinConditions = map (getJoinConditions . snd) parents
+        parents = mapMaybe (getParents . rootLabel) forest
+        getParents (_, (tbl, Just rel@Relation{relType=Parent})) = Just (tbl, rel)
+        getParents _ = Nothing
+    updatedForest = mapM (addJoinConditions schema) forest
+    addCond query' con = query'{flt_=con ++ flt_ query'}
+
+callProc :: QualifiedIdentifier -> JSON.Object -> H.Query () (Maybe JSON.Value)
+callProc qi params =
+  H.statement sql HE.unit decodeObj True
+  where
+    sql = [qc| SELECT array_to_json(
+                coalesce(array_agg(row_to_json(t)), '\{}')
+              )::character varying
+              from ({_callSql}) t |]
+    _args = intercalate "," $ map _assignment (HM.toList params)
+    _assignment (n,v) = pgFmtIdent n <> ":=" <> insertableValue v
+    _callSql = [qc| select * from {fromQi qi}({_args}) |] :: BS.ByteString
+    decodeObj = HD.maybeRow (HD.value HD.json)
+
+operators :: [(Text, SqlFragment)]
+operators = [
+  ("eq", "="),
+  ("gte", ">="), -- has to be before gt (parsers)
+  ("gt", ">"),
+  ("lte", "<="), -- has to be before lt (parsers)
+  ("lt", "<"),
+  ("neq", "<>"),
+  ("like", "like"),
+  ("ilike", "ilike"),
+  ("in", "in"),
+  ("notin", "not in"),
+  ("isnot", "is not"), -- has to be before is (parsers)
+  ("is", "is"),
+  ("@@", "@@"),
+  ("@>", "@>"),
+  ("<@", "<@")
+  ]
+
+pgFmtIdent :: SqlFragment -> SqlFragment
+pgFmtIdent x = "\"" <> replace "\"" "\"\"" (trimNullChars $ cs 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(1)",
+   "FROM ", fromQi $ QualifiedIdentifier schema mainTbl,
+   ("WHERE " <> intercalate " AND " ( map (pgFmtCondition (QualifiedIdentifier schema mainTbl)) localConditions )) `emptyOnNull` localConditions
+   ]
+ where
+   fn Filter{value=VText _} = True
+   fn Filter{value=VForeignKey _ _} = False
+   localConditions = filter fn conditions
+
+requestToQuery :: Schema -> DbRequest -> SqlQuery
+requestToQuery _ (DbMutate (Insert _ (PayloadParseError _))) = undefined
+requestToQuery _ (DbMutate (Update _ (PayloadParseError _) _)) = undefined
+requestToQuery schema (DbRead (Node (Select colSelects tbls conditions ord, (nodeName, maybeRelation)) forest)) =
+  query
+  where
+    -- TODO! the folloing helper functions are just to remove the "schema" part when the table is "source" which is the name
+    -- of our WITH query part
+    mainTbl = fromMaybe nodeName (tableName . relTable <$> maybeRelation)
+    tblSchema tbl = if tbl == sourceCTEName then "" else schema
+    qi = QualifiedIdentifier (tblSchema mainTbl) mainTbl
+    toQi t = QualifiedIdentifier (tblSchema t) t
+    query = unwords [
+      "SELECT ", intercalate ", " (map (pgFmtSelectItem qi) colSelects ++ selects),
+      "FROM ", intercalate ", " (map (fromQi . toQi) tbls),
+      unwords (map joinStr joins),
+      ("WHERE " <> intercalate " AND " ( map (pgFmtCondition qi ) localConditions )) `emptyOnNull` localConditions,
+      orderF (fromMaybe [] ord)
+      ]
+    orderF ts =
+        if null ts
+            then ""
+            else "ORDER BY " <> clause
+        where
+            clause = intercalate "," (map queryTerm ts)
+            queryTerm :: OrderTerm -> Text
+            queryTerm t = " "
+                <> cs (pgFmtColumn qi $ otTerm t) <> " "
+                <> (cs.show) (otDirection t) <> " "
+                <> maybe "" (cs.show) (otNullOrder t) <> " "
+    (joins, selects) = foldr getQueryParts ([],[]) forest
+    parentTables = map snd joins
+    parentConditions = join $ map (( `filter` conditions ) . filterParentConditions) parentTables
+    localConditions = conditions \\ parentConditions
+    joinStr :: (SqlFragment, TableName) -> SqlFragment
+    joinStr (sql, t) = "LEFT OUTER JOIN " <> sql <> " ON " <>
+      intercalate " AND " ( map (pgFmtCondition qi ) joinConditions )
+      where
+        joinConditions = filter (filterParentConditions t) conditions
+    filterParentConditions parentTable (Filter _ _ (VForeignKey (QualifiedIdentifier "" t) _)) = parentTable == t
+    filterParentConditions _ _ = False
+    getQueryParts :: Tree ReadNode -> ([(SqlFragment, TableName)], [SqlFragment]) -> ([(SqlFragment,TableName)], [SqlFragment])
+    getQueryParts (Node n@(_, (name, Just Relation{relType=Child,relTable=Table{tableName=table}})) forst) (j,s) = (j,sel:s)
+      where
+        sel = "COALESCE(("
+           <> "SELECT array_to_json(array_agg(row_to_json("<>pgFmtIdent table<>"))) "
+           <> "FROM (" <> subquery <> ") " <> pgFmtIdent table
+           <> "), '[]') AS " <> pgFmtIdent name
+           where subquery = requestToQuery schema (DbRead (Node n forst))
+    getQueryParts (Node n@(_, (name, Just Relation{relType=Parent,relTable=Table{tableName=table}})) forst) (j,s) = (joi:j,sel:s)
+      where
+        sel = "row_to_json(" <> pgFmtIdent table <> ".*) AS "<>pgFmtIdent name --TODO must be singular
+        joi = ("( " <> subquery <> " ) AS " <> pgFmtIdent table, table)
+          where subquery = requestToQuery schema (DbRead (Node n forst))
+    getQueryParts (Node n@(_, (name, Just Relation{relType=Many,relTable=Table{tableName=table}})) forst) (j,s) = (j,sel:s)
+      where
+        sel = "COALESCE (("
+           <> "SELECT array_to_json(array_agg(row_to_json("<>pgFmtIdent table<>"))) "
+           <> "FROM (" <> subquery <> ") " <> pgFmtIdent table
+           <> "), '[]') AS " <> pgFmtIdent name
+           where subquery = requestToQuery schema (DbRead (Node n forst))
+    --the following is just to remove the warning
+    --getQueryParts is not total but requestToQuery is called only after addJoinConditions which ensures the only
+    --posible relations are Child Parent Many
+    getQueryParts (Node (_,(_,Nothing)) _) _ = undefined
+requestToQuery schema (DbMutate (Insert mainTbl (PayloadJSON (UniformObjects rows)))) =
+  let qi = QualifiedIdentifier schema mainTbl
+      cols = map pgFmtIdent $ fromMaybe [] (HM.keys <$> (rows V.!? 0))
+      colsString = intercalate ", " cols in
+  unwords [
+    "INSERT INTO ", fromQi qi,
+    " (" <> colsString <> ")" <>
+    " SELECT " <> colsString <>
+    " FROM json_populate_recordset(null::" , fromQi qi, ", $1)"
+    ]
+requestToQuery schema (DbMutate (Update mainTbl (PayloadJSON (UniformObjects rows)) conditions)) =
+  case rows V.!? 0 of
+    Just obj ->
+      let assignments = map
+            (\(k,v) -> pgFmtIdent k <> "=" <> insertableValue v) $ HM.toList obj in
+      unwords [
+        "UPDATE ", fromQi qi,
+        " SET " <> intercalate "," assignments <> " ",
+        ("WHERE " <> intercalate " AND " ( map (pgFmtCondition qi ) conditions )) `emptyOnNull` conditions
+        ]
+    Nothing -> undefined
+  where
+    qi = QualifiedIdentifier schema mainTbl
+
+requestToQuery schema (DbMutate (Delete mainTbl conditions)) =
+  query
+  where
+    qi = QualifiedIdentifier schema mainTbl
+    query = unwords [
+      "DELETE FROM ", fromQi qi,
+      ("WHERE " <> intercalate " AND " ( map (pgFmtCondition qi ) conditions )) `emptyOnNull` conditions
+      ]
+
+sourceCTEName :: SqlFragment
+sourceCTEName = "pg_source"
+
+unquoted :: JSON.Value -> Text
+unquoted (JSON.String t) = t
+unquoted (JSON.Number n) =
+  cs $ formatScientific Fixed (if isInteger n then Just 0 else Nothing) n
+unquoted (JSON.Bool b) = cs . show $ b
+unquoted v = cs $ JSON.encode v
+
+-- 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(t::text, 2, length(t::text) - 2), '\n'), '')"
+
+asJsonF :: SqlFragment
+asJsonF = "coalesce(array_to_json(array_agg(row_to_json(t))), '[]')::character varying"
+
+asJsonSingleF :: SqlFragment --TODO! unsafe when the query actually returns multiple rows, used only on inserting and returning single element
+asJsonSingleF = "coalesce(string_agg(row_to_json(t)::text, ','), '')::character varying "
+
+locationF :: [Text] -> SqlFragment
+locationF pKeys =
+    "(" <>
+    " WITH s AS (SELECT row_to_json(ss) as r from " <> sourceCTEName <> " as ss  limit 1)" <>
+    " SELECT string_agg(json_data.key || '=' || coalesce( 'eq.' || json_data.value, 'is.null'), '&')" <>
+    " FROM s, json_each_text(s.r) AS json_data" <>
+    (
+      if null pKeys
+      then ""
+      else " WHERE json_data.key IN ('" <> intercalate "','" pKeys <> "')"
+    ) <> ")"
+
+limitF :: NonnegRange -> SqlFragment
+limitF r  = "LIMIT " <> limit <> " OFFSET " <> offset
+  where
+    limit  = maybe "ALL" (cs . show) $ rangeLimit r
+    offset = cs . show $ rangeOffset r
+
+fromQi :: QualifiedIdentifier -> SqlFragment
+fromQi t = (if s == "" then "" else pgFmtIdent s <> ".") <> pgFmtIdent n
+  where
+    n = qiName t
+    s = qiSchema t
+
+getJoinConditions :: Relation -> [Filter]
+getJoinConditions (Relation t cols ft fcs typ lt lc1 lc2) =
+  case typ of
+    Child  -> zipWith (toFilter tN ftN) cols fcs
+    Parent -> zipWith (toFilter tN ftN) cols fcs
+    Many   -> zipWith (toFilter tN ltN) cols (fromMaybe [] lc1) ++ zipWith (toFilter ftN ltN) fcs (fromMaybe [] lc2)
+  where
+    s = 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}}))
+
+emptyOnNull :: Text -> [a] -> Text
+emptyOnNull val x = if null x then "" else val
+
+insertableValue :: JSON.Value -> SqlFragment
+insertableValue JSON.Null = "null"
+insertableValue v = (<> "::unknown") . pgFmtLit $ unquoted v
+
+whiteList :: Text -> SqlFragment
+whiteList val = fromMaybe
+  (cs (pgFmtLit val) <> "::unknown ")
+  (find ((==) . toLower $ val) ["null","true","false"])
+
+pgFmtColumn :: QualifiedIdentifier -> Text -> SqlFragment
+pgFmtColumn table "*" = fromQi table <> ".*"
+pgFmtColumn table c = fromQi table <> "." <> pgFmtIdent c
+
+pgFmtField :: QualifiedIdentifier -> Field -> SqlFragment
+pgFmtField table (c, jp) = pgFmtColumn table c <> pgFmtJsonPath jp
+
+pgFmtSelectItem :: QualifiedIdentifier -> SelectItem -> SqlFragment
+pgFmtSelectItem table (f@(_, jp), Nothing) = pgFmtField table f <> pgFmtAsJsonPath jp
+pgFmtSelectItem table (f@(_, jp), Just cast ) = "CAST (" <> pgFmtField table f <> " AS " <> cast <> " )" <> pgFmtAsJsonPath jp
+
+pgFmtCondition :: QualifiedIdentifier -> Filter -> SqlFragment
+pgFmtCondition table (Filter (col,jp) ops val) =
+  notOp <> " " <> sqlCol  <> " " <> pgFmtOperator opCode <> " " <>
+    if opCode `elem` ["is","isnot"] then whiteList (getInner val) else sqlValue
+  where
+    headPredicate:rest = split (=='.') ops
+    hasNot caseTrue caseFalse = if headPredicate == "not" then caseTrue else caseFalse
+    opCode      = hasNot (head rest) headPredicate
+    notOp       = hasNot headPredicate ""
+    sqlCol = case val of
+      VText _ -> pgFmtColumn table col <> pgFmtJsonPath jp
+      VForeignKey qi _ -> pgFmtColumn qi col
+    sqlValue = valToStr val
+    getInner v = case v of
+      VText s -> s
+      _      -> ""
+    valToStr v = case v of
+      VText s -> pgFmtValue opCode s
+      VForeignKey (QualifiedIdentifier s _) (ForeignKey Column{colTable=Table{tableName=ft}, colName=fc}) -> pgFmtColumn qi fc
+        where qi = QualifiedIdentifier (if ft == 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 _ = ""
+
+pgFmtAsJsonPath :: Maybe JsonPath -> SqlFragment
+pgFmtAsJsonPath Nothing = ""
+pgFmtAsJsonPath (Just xx) = " AS " <> last xx
+
+trimNullChars :: Text -> Text
+trimNullChars = T.takeWhile (/= '\x0')
+
+data Isolation = ReadCommitted | RepeatableRead | Serializable
+
+{- |
+  Wrap a session in a transaction of desired isolation level
+-}
+inTransaction :: Isolation -> H.Session a -> H.Session a
+inTransaction lvl f = do
+  H.sql $ "begin " <> isolate <> ";"
+  r <- f
+  H.sql "commit;"
+  return r
+ where
+  isolate = case lvl of
+    ReadCommitted  -> "ISOLATION LEVEL READ COMMITTED"
+    RepeatableRead -> "ISOLATION LEVEL REPEATABLE READ"
+    Serializable   -> "ISOLATION LEVEL SERIALIZABLE"

src/PostgREST/RangeQuery.hs

@@ -0,0 +1,68 @@
+module PostgREST.RangeQuery (
+  rangeParse
+, rangeRequested
+, rangeLimit
+, rangeOffset
+, restrictRange
+, NonnegRange
+) where
+
+
+import           Control.Applicative
+import           Network.HTTP.Types.Header
+import           PostgREST.Types           ()
+
+import qualified Data.ByteString.Char8     as BS
+import           Data.Ranged.Boundaries
+import           Data.Ranged.Ranges
+
+import           Data.String.Conversions   (cs)
+import           Text.Read                 (readMaybe)
+import           Text.Regex.TDFA           ((=~))
+
+import           Data.Maybe                (fromMaybe, listToMaybe)
+
+import           Prelude
+
+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 [_, from, to] = readMaybe . cs <$> parsedRange
+          lower         = fromMaybe emptyRange   (rangeGeq <$> from)
+          upper         = fromMaybe (rangeGeq 0) (rangeLeq <$> to) in
+      rangeIntersection lower upper
+    Nothing -> rangeGeq 0
+
+rangeRequested :: RequestHeaders -> NonnegRange
+rangeRequested = rangeParse . fromMaybe "" . lookup hRange
+
+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 from, BoundaryAbove to] -> Just (1 + to - from)
+    _ -> Nothing
+
+rangeOffset :: NonnegRange -> Integer
+rangeOffset range =
+  case rangeLower range of
+    BoundaryBelow from -> from
+    _ -> error "range without lower bound" -- should never happen
+
+rangeGeq :: Integer -> NonnegRange
+rangeGeq n =
+  Range (BoundaryBelow n) BoundaryAboveAll
+
+rangeLeq :: Integer -> NonnegRange
+rangeLeq n =
+  Range BoundaryBelowAll (BoundaryAbove n)

src/PostgREST/Types.hs

@@ -0,0 +1,160 @@
+module PostgREST.Types where
+import Data.Text
+import Data.Tree
+import qualified Data.ByteString.Lazy as BL
+import qualified Data.ByteString      as BS
+import qualified Data.Vector          as V
+import Data.Aeson
+import Data.Int (Int32)
+
+data DbStructure = DbStructure {
+  dbTables :: [Table]
+, dbColumns :: [Column]
+, dbRelations :: [Relation]
+, dbPrimaryKeys :: [PrimaryKey]
+} 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      :: Text
+, otDirection :: OrderDirection
+, otNullOrder :: Maybe OrderNulls
+} deriving (Show, Eq)
+
+data QualifiedIdentifier = QualifiedIdentifier {
+  qiSchema :: Schema
+, qiName   :: TableName
+} deriving (Show, Eq)
+
+
+data RelationType = Child | Parent | Many 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 UniformObjects = UniformObjects (V.Vector Object)
+  deriving (Show, Eq)
+
+unUniformObjects :: UniformObjects -> V.Vector Object
+unUniformObjects (UniformObjects objs) = objs
+
+-- | When Hasql supports the COPY command then we can
+-- have a special payload just for CSV, but until
+-- then CSV is converted to a JSON array.
+data Payload = PayloadJSON UniformObjects
+             | PayloadParseError BS.ByteString
+             deriving (Show, Eq)
+
+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 Cast = Text
+type NodeName = Text
+type SelectItem = (Field, Maybe Cast)
+type Path = [Text]
+data ReadQuery = Select { select::[SelectItem], from::[TableName], flt_::[Filter], order::Maybe [OrderTerm] } deriving (Show, Eq)
+data MutateQuery = Insert { in_::TableName, qPayload::Payload }
+                 | Delete { in_::TableName, where_::[Filter] }
+                 | Update { in_::TableName, qPayload::Payload, where_::[Filter] } deriving (Show, Eq)
+data Filter = Filter {field::Field, operator::Operator, value::FValue} deriving (Show, Eq)
+type ReadNode = (ReadQuery, (NodeName, Maybe Relation))
+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

src/RangeQuery.hs

@@ -1,55 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-
-module RangeQuery where
-
-import Control.Applicative
-import Network.HTTP.Types.Header
-
-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
-
-rangeGeq :: Int -> NonnegRange
-rangeGeq n =
-  Range (BoundaryBelow n) BoundaryAboveAll
-
-rangeLeq :: Int -> NonnegRange
-rangeLeq n =
-  Range BoundaryBelowAll (BoundaryAbove n)
-
-parseRange :: String -> Maybe NonnegRange
-parseRange range = do
-  let rangeRegex = "^([0-9]+)-([0-9]*)$" :: String
-
-  parsedRange <- listToMaybe (range =~ rangeRegex :: [[String]])
-
-  let [_, from, to] = readMaybe <$> parsedRange
-  let lower = fromMaybe emptyRange   (rangeGeq <$> from)
-  let upper = fromMaybe (rangeGeq 0) (rangeLeq <$> to)
-
-  return $ rangeIntersection lower upper
-
-requestedRange :: RequestHeaders -> Maybe NonnegRange
-requestedRange hdrs = parseRange =<< cs <$> lookup hRange hdrs
-
-requestedContentRange :: RequestHeaders -> Maybe NonnegRange
-requestedContentRange hdrs = parseRange =<< cs <$> lookup "Content-Range" hdrs
-
-limit :: NonnegRange -> Maybe Int
-limit range =
-  case [rangeLower range, rangeUpper range]
-    of [BoundaryBelow from, BoundaryAbove to] -> Just (1 + to - from)
-       _ -> Nothing
-
-offset :: NonnegRange -> Int
-offset range =
-  case rangeLower range
-    of BoundaryBelow from -> from
-       _ -> error "range without lower bound" -- should never happen

src/Types.hs

@@ -1,61 +0,0 @@
-{-# OPTIONS_GHC -fno-warn-orphans #-}
-
-module Types where
-
-import Database.HDBC (toSql, iToSql, SqlValue(..))
-
-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

stack.yaml

@@ -0,0 +1,10 @@
+resolver: lts-5.0
+extra-deps:
+  - hasql-0.19.3.3
+  - Ranged-sets-0.3.0
+  - packdeps-0.4.2.1
+ghc-options:
+  postgrest: -O2 -Werror -Wall -fwarn-monomorphism-restriction -fwarn-missing-exported-sigs -fwarn-identities
+
+packages:
+- '.'

test/Feature/AuthSpec.hs

@@ -1,24 +1,70 @@
-{-# LANGUAGE OverloadedStrings #-}
 module Feature.AuthSpec where
 
 -- {{{ Imports
 import Test.Hspec
 import Test.Hspec.Wai
+import Test.Hspec.Wai.JSON
 import Network.HTTP.Types
+import qualified Hasql.Connection  as H
 
 import SpecHelper
+import PostgREST.Types (DbStructure(..))
 -- }}}
 
-spec :: Spec
-spec = around appWithFixture $
-  describe "authorization" $ do
-    it "hides tables that anonymous does not own" $
-      get "/authors_only" `shouldRespondWith` 400 -- TODO: should be 404
-    it "indicates login failure" $ do
-      let auth = authHeader "dbapi_test_author_a" "fakefake"
-      request methodGet "/authors_only" [auth] ""
-        `shouldRespondWith` 401
-    -- it "allows users with permissions to see their tables" $ do
-    --   let auth = authHeader "dbapi_test_author_a" ""
-    --   request methodGet "/authors_only" [auth] ""
-    --     `shouldRespondWith` 200
+spec :: DbStructure -> H.Connection -> Spec
+spec struct c = around (withApp cfgDefault struct c)
+  $ describe "authorization" $ do
+
+  it "hides tables that anonymous does not own" $
+    get "/authors_only" `shouldRespondWith` 404
+
+  it "returns jwt functions as jwt tokens" $
+    post "/rpc/login" [json| { "id": "jdoe", "pass": "1234" } |]
+      `shouldRespondWith` ResponseMatcher {
+          matchBody = Just [json| {"token":"eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJyb2xlIjoicG9zdGdyZXN0X3Rlc3RfYXV0aG9yIiwiaWQiOiJqZG9lIn0.y4vZuu1dDdwAl0-S00MCRWRYMlJ5YAMSir6Es6WtWx0"} |]
+        , matchStatus = 200
+        , matchHeaders = ["Content-Type" <:> "application/json"]
+        }
+
+  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` 400
+
+  it "hides tables from users with invalid JWT" $ do
+    let auth = authHeaderJWT "ey9zdGdyZXN0X3Rlc3RfYXV0aG9yIiwiaWQiOiJqZG9lIn0.y4vZuu1dDdwAl0-S00MCRWRYMlJ5YAMSir6Es6WtWx0"
+    request methodGet "/authors_only" [auth] ""
+      `shouldRespondWith` 400
+
+  it "should fail when jwt contains no claims" $ do
+    let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.e30.MKYc_lOECtB0LJOiykilAdlHodB-I0_id2qHKq35dmc"
+    request methodGet "/authors_only" [auth] ""
+      `shouldRespondWith` 400
+
+  it "hides tables from users with JWT that contain no claims about role" $ do
+    let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJpZCI6Impkb2UifQ.zyohGMnrDy4_8eJTl6I2AUXO3MeCCiwR24aGWRkTE9o"
+    request methodGet "/authors_only" [auth] ""
+      `shouldRespondWith` 400
+
+  it "recovers after 400 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

test/Feature/CorsSpec.hs

@@ -1,5 +1,3 @@
-{-# LANGUAGE OverloadedStrings #-}
-
 module Feature.CorsSpec where
 
 -- {{{ Imports
@@ -7,15 +5,16 @@ import Test.Hspec
 import Test.Hspec.Wai
 import Network.Wai.Test (SResponse(simpleHeaders, simpleBody))
 import qualified Data.ByteString.Lazy as BL
+import qualified Hasql.Connection  as H
 
 import SpecHelper
+import PostgREST.Types (DbStructure(..))
 
 import Network.HTTP.Types
 -- }}}
 
-spec :: Spec
-spec = around appWithFixture $
-  describe "CORS" $ do
+spec :: DbStructure -> H.Connection -> Spec
+spec struct c = around (withApp cfgDefault struct c) $ describe "CORS" $ do
     let preflightHeaders = [
           ("Accept", "*/*"),
           ("Origin", "http://example.com"),
@@ -25,7 +24,7 @@ spec = around appWithFixture $
           ("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/"),
@@ -44,7 +43,7 @@ spec = around appWithFixture $
             "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"
@@ -56,6 +55,14 @@ spec = around appWithFixture $
         r <- request methodOptions "/" preflightHeaders ""
         liftIO $ simpleBody r `shouldBe` ""
 
+    describe "regular request" $
+      it "exposes necesssary response headers" $ do
+        r <- request methodGet "/items" [("Origin", "http://example.com")] ""
+        liftIO $ simpleHeaders r `shouldSatisfy` matchHeader
+          "Access-Control-Expose-Headers"
+          "Content-Encoding, Content-Location, Content-Range, Content-Type, \
+            \Date, Location, Server, Transfer-Encoding, Range-Unit"
+
     describe "postflight request" $
       it "allows INFO body through even with CORS request headers present" $ do
         r <- request methodOptions "/items" normalCors ""

test/Feature/DeleteSpec.hs

@@ -0,0 +1,41 @@
+module Feature.DeleteSpec where
+
+import Test.Hspec
+import Test.Hspec.Wai
+import Text.Heredoc
+
+import SpecHelper
+import PostgREST.Types (DbStructure(..))
+import qualified Hasql.Connection  as H
+
+import Network.HTTP.Types
+
+spec :: DbStructure -> H.Connection -> Spec
+spec struct c = beforeAll resetDb
+  . around (withApp cfgDefault struct c) $
+  describe "Deleting" $ do
+    context "existing record" $ do
+      it "succeeds with 204 and deletion count" $
+        request methodDelete "/items?id=eq.1" [] ""
+          `shouldRespondWith` ResponseMatcher {
+            matchBody    = Nothing
+          , matchStatus  = 204
+          , matchHeaders = ["Content-Range" <:> "*/1"]
+          }
+
+      it "actually clears items ouf the db" $ do
+        _ <- request methodDelete "/items?id=lt.15" [] ""
+        get "/items"
+          `shouldRespondWith` ResponseMatcher {
+            matchBody    = Just [str|[{"id":15}]|]
+          , matchStatus  = 200
+          , matchHeaders = ["Content-Range" <:> "0-0/1"]
+          }
+
+    context "known route, unknown record" $
+      it "fails with 404" $
+        request methodDelete "/items?id=eq.101" [] "" `shouldRespondWith` 404
+
+    context "totally unknown route" $
+      it "fails with 404" $
+        request methodDelete "/foozle?id=eq.101" [] "" `shouldRespondWith` 404

test/Feature/InsertSpec.hs

@@ -1,35 +1,58 @@
-
-{-# LANGUAGE OverloadedStrings, QuasiQuotes #-}
 module Feature.InsertSpec where
 
--- {{{ Imports
-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))
 
 import SpecHelper
+import PostgREST.Types (DbStructure(..))
 
 import qualified Data.Aeson as JSON
 import Data.Maybe (fromJust)
+import Text.Heredoc
 import Network.HTTP.Types.Header
 import Network.HTTP.Types
+import Control.Monad (replicateM_)
+import qualified Hasql.Connection  as H
 
-import TestTypes(IncPK, incStr, incNullableStr)
+import TestTypes(IncPK(..), CompoundPK(..))
 
--- }}}
-
-spec :: Spec
-spec = around appWithFixture $ do
+spec :: DbStructure -> H.Connection -> Spec
+spec struct c = beforeAll_ resetDb $ around (withApp cfgDefault struct c) $ do
   describe "Posting new record" $ do
-    it "accepts disparate json types" $
-      post "/menagerie"
-        [json| {
-          "integer": 13, "double": 3.14159, "varchar": "testing!"
-        , "boolean": false, "date": "01/01/1900", "money": "$3.99"
-        , "enum": "foo"
-        } |]
-        `shouldRespondWith` 201
+    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
+
+      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"]
+          }
+
+      it "includes related data after insert" $
+        request methodPost "/projects?select=id,name,clients{id,name}" [("Prefer", "return=representation")]
+          [str|{"id":6,"name":"New Project","client_id":2}|] `shouldRespondWith` ResponseMatcher {
+            matchBody    = Just [str|{"id":6,"name":"New Project","clients":{"id":2,"name":"Apple"}}|]
+          , matchStatus  = 201
+          , matchHeaders = ["Content-Type" <:> "application/json", "Location" <:> "/projects?id=eq.6"]
+          }
+
 
     context "with no pk supplied" $ do
       context "into a table with auto-incrementing pk" $
@@ -51,7 +74,7 @@ spec = around appWithFixture $ do
           post "/simple_pk" [json| { "extra":"foo"} |]
             `shouldRespondWith` 400
 
-      context "into a table with no pk" $
+      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
@@ -59,6 +82,33 @@ spec = around appWithFixture $ do
             simpleHeaders p `shouldSatisfy` matchHeader hLocation "/no_pk\\?a=eq.foo&b=eq.bar"
             simpleStatus p `shouldBe` created201
 
+        it "returns full details of inserted record if asked" $ do
+          p <- request methodPost "/no_pk"
+                       [("Prefer", "return=representation")]
+                       [json| { "a":"bar", "b":"baz" } |]
+          liftIO $ do
+            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 "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" } |]
+            simpleHeaders p `shouldSatisfy` matchHeader hLocation "/no_pk\\?a=is.null&b=eq.foo"
+            simpleStatus p `shouldBe` created201
+
     context "with compound pk supplied" $
       it "builds response location header appropriately" $
         post "/compound_pk" [json| { "k1":12, "k2":42 } |]
@@ -70,63 +120,291 @@ spec = around appWithFixture $ do
 
     context "with invalid json payload" $
       it "fails with 400 and error" $
-        post "/simple_pk" "}{ x = 2"
+        post "/simple_pk" "}{ x = 2" `shouldRespondWith` 400
+
+    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" } } |]
+        request methodPost "/json"
+                     [("Prefer", "return=representation")]
+                     inserted
           `shouldRespondWith` ResponseMatcher {
-            matchBody    = Just [json| {"error":"Failed to parse JSON payload. Failed reading: satisfy"} |]
-          , matchStatus  = 400
-          , matchHeaders = []
+            matchBody    = Just inserted
+          , matchStatus  = 201
+          , matchHeaders = ["Location" <:> [str|/json?data=eq.{"foo":"bar"}|]]
           }
 
+        -- TODO! the test above seems right, why was the one below working before and not now
+        -- p <- request methodPost "/json" [("Prefer", "return=representation")] inserted
+        -- liftIO $ do
+        --   simpleBody p `shouldBe` inserted
+        --   simpleHeaders p `shouldSatisfy` matchHeader hLocation "/json\\?data=eq\\.%7B%22foo%22%3A%22bar%22%7D"
+        --   simpleStatus p `shouldBe` created201
+
+      it "serializes nested array" $ do
+        let inserted = [json| { "data": [1,2,3] } |]
+        request methodPost "/json"
+                     [("Prefer", "return=representation")]
+                     inserted
+          `shouldRespondWith` ResponseMatcher {
+            matchBody    = Just inserted
+          , matchStatus  = 201
+          , matchHeaders = ["Location" <:> [str|/json?data=eq.[1,2,3]|]]
+          }
+        -- TODO! the test above seems right, why was the one below working before and not now
+        -- p <- request methodPost "/json" [("Prefer", "return=representation")] inserted
+        -- liftIO $ do
+        --   simpleBody p `shouldBe` inserted
+        --   simpleHeaders p `shouldSatisfy` matchHeader hLocation "/json\\?data=eq\\.%5B1%2C2%2C3%5D"
+        --   simpleStatus p `shouldBe` created201
+
+  describe "CSV insert" $ do
+
+    context "disparate csv types" $
+      it "succeeds with multipart response" $ do
+        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
+
+           `shouldRespondWith` ResponseMatcher {
+             matchBody    = Just inserted
+           , matchStatus  = 201
+           , matchHeaders = ["Content-Type" <:> "text/csv"]
+           }
+        -- p <- request methodPost "/menagerie" [("Content-Type", "text/csv")]
+        --        [str|integer,double,varchar,boolean,date,money,enum
+        --            |13,3.14159,testing!,false,1900-01-01,$3.99,foo
+        --            |12,0.1,a string,true,1929-10-01,12,bar
+        --            |]
+        -- liftIO $ do
+        --   simpleBody p `shouldBe` "Content-Type: application/json\nLocation: /menagerie?integer=eq.13\n\n\n--postgrest_boundary\nContent-Type: application/json\nLocation: /menagerie?integer=eq.12\n\n"
+        --   simpleStatus p `shouldBe` created201
+
+    context "requesting full representation" $ do
+      it "returns full details of inserted record" $
+        request methodPost "/no_pk"
+                     [("Content-Type", "text/csv"), ("Accept", "text/csv"),  ("Prefer", "return=representation")]
+                     "a,b\nbar,baz"
+          `shouldRespondWith` ResponseMatcher {
+            matchBody    = Just "a,b\nbar,baz"
+          , matchStatus  = 201
+          , matchHeaders = ["Content-Type" <:> "text/csv",
+                            "Location" <:> "/no_pk?a=eq.bar&b=eq.baz"]
+          }
+
+      -- it "can post nulls (old way)" $ do
+      --   pendingWith "changed the response when in csv mode"
+      --   request methodPost "/no_pk"
+      --                [("Content-Type", "text/csv"), ("Prefer", "return=representation")]
+      --                "a,b\nNULL,foo"
+      --     `shouldRespondWith` ResponseMatcher {
+      --       matchBody    = Just [json| { "a":null, "b":"foo" } |]
+      --     , matchStatus  = 201
+      --     , matchHeaders = ["Content-Type" <:> "application/json",
+      --                       "Location" <:> "/no_pk?a=is.null&b=eq.foo"]
+      --     }
+      it "can post nulls" $
+        request methodPost "/no_pk"
+                     [("Content-Type", "text/csv"), ("Accept", "text/csv"), ("Prefer", "return=representation")]
+                     "a,b\nNULL,foo"
+          `shouldRespondWith` ResponseMatcher {
+            matchBody    = Just "a,b\n,foo"
+          , matchStatus  = 201
+          , matchHeaders = ["Content-Type" <:> "text/csv",
+                            "Location" <:> "/no_pk?a=is.null&b=eq.foo"]
+          }
+
+
+    context "with wrong number of columns" $
+      it "fails for too few" $ do
+        p <- request methodPost "/no_pk" [("Content-Type", "text/csv")] "a,b\nfoo,bar\nbaz"
+        liftIO $ simpleStatus p `shouldBe` badRequest400
+      -- it does not fail because the extra columns are ignored
+      -- it "fails for too many" $ do
+      --   p <- request methodPost "/no_pk" [("Content-Type", "text/csv")] "a,b\nfoo,bar\nbaz,bat,bad"
+      --   liftIO $ simpleStatus p `shouldBe` badRequest400
+
   describe "Putting record" $ do
 
-    context "to unkonwn uri" $
-      it "gives a 404" $
+    context "to unknown uri" $
+      it "gives a 404" $ do
+        pendingWith "Decide on PUT usefullness"
         request methodPut "/fake" []
           [json| { "real": false } |]
             `shouldRespondWith` 404
 
     context "to a known uri" $ do
       context "without a fully-specified primary key" $
-        it "is not an allowed operation" $
+        it "is not an allowed operation" $ do
+          pendingWith "Decide on PUT usefullness"
           request methodPut "/compound_pk?k1=eq.12" []
             [json| { "k1":12, "k2":42 } |]
               `shouldRespondWith` 405
 
       context "with a fully-specified primary key" $ do
 
-        context "with Content-Range header" $
-          it "fails as per RFC7231" $
-            request methodPut "/compound_pk?k1=eq.1&k2=eq.2"
-              [("Content-Range", "0-0")]
-              [json| { "k1":1, "k2":2, "extra":3 } |]
-                `shouldRespondWith` 400
-
         context "not specifying every column in the table" $
-          it "is rejected for lack of idempotence" $
+          it "is rejected for lack of idempotence" $ do
+            pendingWith "Decide on PUT usefullness"
             request methodPut "/compound_pk?k1=eq.12&k2=eq.42" []
               [json| { "k1":12, "k2":42 } |]
                 `shouldRespondWith` 400
 
-        context "specifying every column in the table" $
-          it "succeeds with 201 and link" $ do
+        context "specifying every column in the table" $ do
+          it "can create a new record" $ do
+            pendingWith "Decide on PUT usefullness"
             p <- request methodPut "/compound_pk?k1=eq.12&k2=eq.42" []
                  [json| { "k1":12, "k2":42, "extra":3 } |]
             liftIO $ do
               simpleBody p `shouldBe` ""
-              simpleStatus p `shouldBe` status200
+              simpleStatus p `shouldBe` status204
 
-      context "with an auto-incrementing primary key" $
+            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 "succeeds with 201 and link" $
+          it "can update an existing record" $ do
+            pendingWith "Decide on PUT usefullness"
+            _ <- request methodPut "/compound_pk?k1=eq.12&k2=eq.42" []
+                 [json| { "k1":12, "k2":42, "extra":4 } |]
+            _ <- request methodPut "/compound_pk?k1=eq.12&k2=eq.42" []
+                 [json| { "k1":12, "k2":42, "extra":5 } |]
+
+            r <- get "/compound_pk?k1=eq.12&k2=eq.42"
+            let rows = fromJust (JSON.decode $ simpleBody r :: Maybe [CompoundPK])
+            liftIO $ do
+              length rows `shouldBe` 1
+              let record = head rows
+              compoundExtra record `shouldBe` Just 5
+
+      context "with an auto-incrementing primary key"$
+
+        it "succeeds with 204" $ do
+          pendingWith "Decide on PUT usefullness"
           request methodPut "/auto_incrementing_pk?id=eq.1" []
                [json| {
                  "id":1,
                  "nullable_string":"hi",
                  "non_nullable_string":"bye",
-                 "inserted_at": "now()"
+                 "inserted_at": "2020-11-11"
                } |]
             `shouldRespondWith` ResponseMatcher {
               matchBody    = Nothing,
-              matchStatus  = 200,
+              matchStatus  = 204,
               matchHeaders = []
             }
+
+  describe "Patching record" $ do
+
+    context "to unknown uri" $
+      it "gives a 404" $
+        request methodPatch "/fake" []
+          [json| { "real": false } |]
+            `shouldRespondWith` 404
+
+    context "on an empty table" $
+      it "indicates no records found to update" $
+        request methodPatch "/empty_table" []
+          [json| { "extra":20 } |]
+            `shouldRespondWith` 404
+
+    context "in a nonempty table" $ do
+      it "can update a single item" $ do
+        g <- get "/items?id=eq.42"
+        liftIO $ simpleHeaders g
+          `shouldSatisfy` matchHeader "Content-Range" "\\*/0"
+        request methodPatch "/items?id=eq.2" []
+          [json| { "id":42 } |]
+            `shouldRespondWith` ResponseMatcher {
+              matchBody    = Nothing,
+              matchStatus  = 204,
+              matchHeaders = ["Content-Range" <:> "0-0/1"]
+            }
+        g' <- get "/items?id=eq.42"
+        liftIO $ simpleHeaders g'
+          `shouldSatisfy` matchHeader "Content-Range" "0-0/1"
+
+      it "can update multiple items" $ do
+        replicateM_ 10 $ post "/auto_incrementing_pk"
+          [json| { non_nullable_string: "a" } |]
+        replicateM_ 10 $ post "/auto_incrementing_pk"
+          [json| { non_nullable_string: "b" } |]
+        _ <- request methodPatch
+          "/auto_incrementing_pk?non_nullable_string=eq.a" []
+          [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"
+
+      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 update based on a computed column" $
+        request methodPatch
+          "/items?always_true=eq.false"
+          [("Prefer", "return=representation")]
+          [json| { id: 100 } |]
+          `shouldRespondWith` 404
+      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}] |]
+
+      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 = []
+          }
+
+  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

test/Feature/QueryLimitedSpec.hs

@@ -0,0 +1,32 @@
+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 qualified Hasql.Connection  as H
+
+import SpecHelper
+import PostgREST.Types (DbStructure(..))
+
+spec :: DbStructure -> H.Connection -> Spec
+spec struct c =
+  beforeAll resetDb
+   . around (withApp (cfgLimitRows 3) struct c) $
+  describe "Requesting many items with server limits enabled" $ do
+    it "restricts results" $
+      get "/items"
+        `shouldRespondWith` ResponseMatcher {
+          matchBody    = Just [json| [{"id":1},{"id":2},{"id":3}] |]
+        , matchStatus  = 206
+        , matchHeaders = ["Content-Range" <:> "0-2/15"]
+        }
+
+    it "respects additional client limiting" $ do
+      r <- request methodGet  "/items"
+                   (rangeHdrs $ ByteRangeFromTo 0 1) ""
+      liftIO $ do
+        simpleHeaders r `shouldSatisfy`
+          matchHeader "Content-Range" "0-1/15"
+        simpleStatus r `shouldBe` partialContent206

test/Feature/QuerySpec.hs

@@ -1,45 +1,346 @@
-
-{-# LANGUAGE OverloadedStrings #-}
 module Feature.QuerySpec where
 
-import Test.Hspec
+import Test.Hspec hiding (pendingWith)
 import Test.Hspec.Wai
+import Test.Hspec.Wai.JSON
+import Network.HTTP.Types
+import Network.Wai.Test (SResponse(simpleHeaders))
+import qualified Hasql.Connection  as H
 
 import SpecHelper
+import PostgREST.Types (DbStructure(..))
+import Text.Heredoc
+
+spec :: DbStructure -> H.Connection -> Spec
+spec struct c = around (withApp cfgDefault struct c) $ 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
 
-spec :: Spec
-spec = around appWithFixture $ do
   describe "Querying a nonexistent table" $
     it "causes a 404" $
       get "/faketable" `shouldRespondWith` 404
 
-  describe "Filtering response" $
-    context "column equality" $
+  describe "Filtering response" $ do
+    it "matches with equality" $
+      get "/items?id=eq.5"
+        `shouldRespondWith` ResponseMatcher {
+          matchBody    = Just [json| [{"id":5}] |]
+        , matchStatus  = 200
+        , matchHeaders = ["Content-Range" <:> "0-0/1"]
+        }
+
+    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/14"]
+        }
+
+    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/2"]
+        }
+      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/2"]
+        }
+
+    it "matches items IN" $
+      get "/items?id=in.1,3,5"
+        `shouldRespondWith` ResponseMatcher {
+          matchBody    = Just [json| [{"id":1},{"id":3},{"id":5}] |]
+        , matchStatus  = 200
+        , matchHeaders = ["Content-Range" <:> "0-2/3"]
+        }
+
+    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/3"]
+        }
+
+    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/3"]
+        }
+
+    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`
+        [str|[{"k":"xyyx","extra":"u"}]|]
+      get "/simple_pk?k=like.xy*" `shouldRespondWith`
+        [str|[{"k":"xyyx","extra":"u"}]|]
+      get "/simple_pk?k=like.*YY*" `shouldRespondWith`
+        [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`
+        [str|[{"k":"xyyx","extra":"u"},{"k":"xYYx","extra":"v"}]|]
+      get "/simple_pk?k=ilike.*YY*&order=extra.asc" `shouldRespondWith`
+        [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" $
+      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]}]|]
+
+    it "one simple column" $
+      get "/complex_items?select=id" `shouldRespondWith`
+        [json| [{"id":1},{"id":2},{"id":3}] |]
+
+    it "one simple column with casting (text)" $
+      get "/complex_items?select=id::text" `shouldRespondWith`
+        [json| [{"id":"1"},{"id":"2"},{"id":"3"}] |]
+
+    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 "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 "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 "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 "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 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 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 "Plurality singular" $ do
+    it "will select an existing object" $
+      request methodGet "/items?id=eq.5" [("Prefer","plurality=singular")] ""
+        `shouldRespondWith` ResponseMatcher {
+          matchBody    = Just [json| {"id":5} |]
+        , matchStatus  = 200
+        , matchHeaders = []
+        }
+
+    it "works in the presence of a range header" $
+      let headers = ("Prefer","plurality=singular") :
+            rangeHdrs (ByteRangeFromTo 0 9) in
+      request methodGet "/items" headers ""
+        `shouldRespondWith` ResponseMatcher {
+          matchBody    = Just [json| {"id":1} |]
+        , matchStatus  = 200
+        , matchHeaders = []
+        }
+
+    it "will respond with 404 when not found" $
+      request methodGet "/items?id=eq.9999" [("Prefer","plurality=singular")] ""
+        `shouldRespondWith` 404
+
+    it "can shape plurality singular object routes" $
+      request methodGet "/projects_view?id=eq.1&select=id,name,clients{*},tasks{id,name}" [("Prefer","plurality=singular")] ""
+        `shouldRespondWith`
+          [str|{"id":1,"name":"Windows 7","clients":{"id":1,"name":"Microsoft"},"tasks":[{"id":1,"name":"Design w7"},{"id":2,"name":"Code w7"}]}|]
 
-      it "matches the predicate" $
-        get "/items?id=eq.5"
-          `shouldRespondWith` ResponseMatcher {
-            matchBody    = Just "[{\"id\":5}]"
-          , matchStatus  = 200
-          , matchHeaders = ["Content-Range" <:> "0-0/1"]
-          }
 
   describe "ordering response" $ do
     it "by a column asc" $
-      get "/items?id=lte.2&order=asc.id"
+      get "/items?id=lte.2&order=id.asc"
         `shouldRespondWith` ResponseMatcher {
-          matchBody    = Just "[{\"id\":1},{\"id\":2}]"
+          matchBody    = Just [json| [{"id":1},{"id":2}] |]
         , matchStatus  = 200
         , matchHeaders = ["Content-Range" <:> "0-1/2"]
         }
     it "by a column desc" $
-      get "/items?id=lte.2&order=desc.id"
+      get "/items?id=lte.2&order=id.desc"
         `shouldRespondWith` ResponseMatcher {
-          matchBody    = Just "[{\"id\":2},{\"id\":1}]"
+          matchBody    = Just [json| [{"id":2},{"id":1}] |]
         , matchStatus  = 200
         , matchHeaders = ["Content-Range" <:> "0-1/2"]
         }
 
+    it "by a column asc with nulls last" $
+      get "/no_pk?order=a.asc.nullslast"
+        `shouldRespondWith` ResponseMatcher {
+          matchBody = Just [json| [{"a":"1","b":"0"},
+                              {"a":"2","b":"0"},
+                              {"a":null,"b":null}] |]
+        , matchStatus = 200
+        , matchHeaders = ["Content-Range" <:> "0-2/3"]
+        }
+
+    it "by a column desc with nulls first" $
+      get "/no_pk?order=a.desc.nullsfirst"
+        `shouldRespondWith` ResponseMatcher {
+          matchBody = Just [json| [{"a":null,"b":null},
+                              {"a":"2","b":"0"},
+                              {"a":"1","b":"0"}] |]
+        , matchStatus = 200
+        , matchHeaders = ["Content-Range" <:> "0-2/3"]
+        }
+
+    it "by a column desc with nulls last" $
+      get "/no_pk?order=a.desc.nullslast"
+        `shouldRespondWith` ResponseMatcher {
+          matchBody = Just [json| [{"a":"2","b":"0"},
+                              {"a":"1","b":"0"},
+                              {"a":null,"b":null}] |]
+        , matchStatus = 200
+        , matchHeaders = ["Content-Range" <:> "0-2/3"]
+        }
+
+    it "without other constraints" $
+      get "/items?order=id.asc" `shouldRespondWith` 200
+
+  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 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"]
+        }
+
   describe "Canonical location" $ do
     it "Sets Content-Location with alphabetized params" $
       get "/no_pk?b=eq.1&a=eq.1"
@@ -49,10 +350,80 @@ spec = around appWithFixture $ do
         , matchHeaders = ["Content-Location" <:> "/no_pk?a=eq.1&b=eq.1"]
         }
 
-    it "Omits question mark when there are no params" $
-      get "/no_pk"
-        `shouldRespondWith` ResponseMatcher {
-          matchBody    = Just "[]"
-        , matchStatus  = 200
-        , matchHeaders = ["Content-Location" <:> "/no_pk"]
-        }
+    it "Omits question mark when there are no params" $ do
+      r <- get "/simple_pk"
+      liftIO $ do
+        let respHeaders = simpleHeaders r
+        respHeaders `shouldSatisfy` matchHeader
+          "Content-Location" "/simple_pk"
+
+  describe "jsonb" $ do
+    it "can filter by properties inside json column" $ do
+      get "/json?data->foo->>bar=eq.baz" `shouldRespondWith`
+        [json| [{"data": {"id": 1, "foo": {"bar": "baz"}}}] |]
+      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" $
+      it "returns proper json" $
+        post "/rpc/getitemrange" [json| { "min": 2, "max": 4 } |] `shouldRespondWith`
+          [json| [ {"id": 3}, {"id":4} ] |]
+
+    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" $
+      it "returns proper json" $
+        post "/rpc/sayhello" [json| { "name": "world" } |] `shouldRespondWith`
+          [json| [{"sayhello":"Hello, world"}] |]
+
+    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" $
+        request methodPost "/rpc/sayhello"
+          (acceptHdrs "application/json") "sdfsdf"
+            `shouldRespondWith` 400
+
+    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
+
+  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}}] |]

test/Feature/RangeSpec.hs

@@ -1,22 +1,53 @@
-{-# LANGUAGE OverloadedStrings #-}
 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 Hasql.Connection  as H
 
 import SpecHelper
+import PostgREST.Types (DbStructure(..))
 
-spec :: Spec
-spec = around appWithFixture $
+spec :: DbStructure -> H.Connection -> Spec
+spec struct c = beforeAll resetDb
+  . around (withApp cfgDefault struct c) $
   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 range headers" $ do
 
       context "of acceptable range" $ do

test/Feature/StructureSpec.hs

@@ -1,35 +1,58 @@
-{-# LANGUAGE OverloadedStrings, QuasiQuotes #-}
 module Feature.StructureSpec where
 
-import Test.Hspec
+import Test.Hspec hiding (pendingWith)
 import Test.Hspec.Wai
 import Test.Hspec.Wai.JSON
+import qualified Hasql.Connection  as H
 
 import SpecHelper
+import PostgREST.Types (DbStructure(..))
 
 import Network.HTTP.Types
-import Codec.Binary.Base64.String (encode)
-import Data.Monoid ((<>))
-import Data.String.Conversions (cs)
 
-spec :: Spec
-spec = let {uName = "a user"; uPass = "nobody can ever know";
-uRole = "dbapi_test"} in
-  around withDatabaseConnection $
-  aroundWith (withUser uName uPass uRole) $ aroundWith withApp $ do
-  describe "GET /" $
+spec :: DbStructure -> H.Connection -> Spec
+spec struct c = around (withApp cfgDefault struct c) $ do
+  describe "GET /" $ do
     it "lists views in schema" $
-      request methodGet "/"
-        [("Authorization", "Basic "<>(cs.encode $ cs uName<>":"<>cs uPass))] ""
+      request methodGet "/" [] ""
         `shouldRespondWith` [json| [
-        {"schema":"1","name":"authors_only","insertable":true}
-        , {"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":"menagerie","insertable":true}
-        , {"schema":"1","name":"no_pk","insertable":true}
-        , {"schema":"1","name":"simple_pk","insertable":true}
+          {"schema":"test","name":"Escap3e;","insertable":true}
+        , {"schema":"test","name":"articleStars","insertable":true}
+        , {"schema":"test","name":"articles","insertable":true}
+        , {"schema":"test","name":"auto_incrementing_pk","insertable":true}
+        , {"schema":"test","name":"clients","insertable":true}
+        , {"schema":"test","name":"comments","insertable":true}
+        , {"schema":"test","name":"complex_items","insertable":true}
+        , {"schema":"test","name":"compound_pk","insertable":true}
+        , {"schema":"test","name":"ghostBusters","insertable":true}
+        , {"schema":"test","name":"has_count_column","insertable":false}
+        , {"schema":"test","name":"has_fk","insertable":true}
+        , {"schema":"test","name":"insertable_view_with_join","insertable":true}
+        , {"schema":"test","name":"insertonly","insertable":true}
+        , {"schema":"test","name":"items","insertable":true}
+        , {"schema":"test","name":"json","insertable":true}
+        , {"schema":"test","name":"materialized_view","insertable":false}
+        , {"schema":"test","name":"menagerie","insertable":true}
+        , {"schema":"test","name":"no_pk","insertable":true}
+        , {"schema":"test","name":"nullable_integer","insertable":true}
+        , {"schema":"test","name":"projects","insertable":true}
+        , {"schema":"test","name":"projects_view","insertable":true}
+        , {"schema":"test","name":"simple_pk","insertable":true}
+        , {"schema":"test","name":"tasks","insertable":true}
+        , {"schema":"test","name":"tsearch","insertable":true}
+        , {"schema":"test","name":"users","insertable":true}
+        , {"schema":"test","name":"users_projects","insertable":true}
+        , {"schema":"test","name":"users_tasks","insertable":true}
+        , {"schema":"test","name":"withUnique","insertable":true}
+        ] |]
+        {matchStatus = 200}
+
+    it "lists only views user has permission to see" $ do
+      let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJyb2xlIjoicG9zdGdyZXN0X3Rlc3RfYXV0aG9yIiwiaWQiOiJqZG9lIn0.y4vZuu1dDdwAl0-S00MCRWRYMlJ5YAMSir6Es6WtWx0"
+
+      request methodGet "/" [auth] ""
+        `shouldRespondWith` [json| [
+            {"schema":"test","name":"authors_only","insertable":true}
         ] |]
         {matchStatus = 200}
 
@@ -44,11 +67,11 @@ uRole = "dbapi_test"} in
             "default": null,
             "precision": 32,
             "updatable": true,
-            "schema": "1",
+            "schema": "test",
             "name": "integer",
             "type": "integer",
             "maxLen": null,
-            "enum": null,
+            "enum": [],
             "nullable": false,
             "position": 1,
             "references": null,
@@ -57,11 +80,11 @@ uRole = "dbapi_test"} in
             "default": null,
             "precision": 53,
             "updatable": true,
-            "schema": "1",
+            "schema": "test",
             "name": "double",
             "type": "double precision",
             "maxLen": null,
-            "enum": null,
+            "enum": [],
             "nullable": false,
             "references": null,
             "position": 2
@@ -69,11 +92,11 @@ uRole = "dbapi_test"} in
             "default": null,
             "precision": null,
             "updatable": true,
-            "schema": "1",
+            "schema": "test",
             "name": "varchar",
             "type": "character varying",
             "maxLen": null,
-            "enum": null,
+            "enum": [],
             "nullable": false,
             "position": 3,
             "references": null,
@@ -82,11 +105,11 @@ uRole = "dbapi_test"} in
             "default": null,
             "precision": null,
             "updatable": true,
-            "schema": "1",
+            "schema": "test",
             "name": "boolean",
             "type": "boolean",
             "maxLen": null,
-            "enum": null,
+            "enum": [],
             "nullable": false,
             "references": null,
             "position": 4
@@ -94,11 +117,11 @@ uRole = "dbapi_test"} in
             "default": null,
             "precision": null,
             "updatable": true,
-            "schema": "1",
+            "schema": "test",
             "name": "date",
             "type": "date",
             "maxLen": null,
-            "enum": null,
+            "enum": [],
             "nullable": false,
             "references": null,
             "position": 5
@@ -106,11 +129,11 @@ uRole = "dbapi_test"} in
             "default": null,
             "precision": null,
             "updatable": true,
-            "schema": "1",
+            "schema": "test",
             "name": "money",
             "type": "money",
             "maxLen": null,
-            "enum": null,
+            "enum": [],
             "nullable": false,
             "position": 6,
             "references": null,
@@ -119,7 +142,7 @@ uRole = "dbapi_test"} in
             "default": null,
             "precision": null,
             "updatable": true,
-            "schema": "1",
+            "schema": "test",
             "name": "enum",
             "type": "USER-DEFINED",
             "maxLen": null,
@@ -136,50 +159,167 @@ uRole = "dbapi_test"} in
       }
       |]
 
+    it "it includes primary and foreign keys for views" $
+      request methodOptions "/projects_view" [] "" `shouldRespondWith`
+      [json|
+      {
+         "pkey":[
+            "id"
+         ],
+         "columns":[
+          {
+            "references":null,
+            "default":null,
+            "precision":32,
+            "updatable":true,
+            "schema":"test",
+            "name":"id",
+            "type":"integer",
+            "maxLen":null,
+            "enum":[],
+            "nullable":true,
+            "position":1
+          },
+          {
+            "references":null,
+            "default":null,
+            "precision":null,
+            "updatable":true,
+            "schema":"test",
+            "name":"name",
+            "type":"text",
+            "maxLen":null,
+            "enum":[],
+            "nullable":true,
+            "position":2
+          },
+          {
+            "references": {
+              "schema":"test",
+              "column":"id",
+              "table":"clients"
+            },
+            "default":null,
+            "precision":32,
+            "updatable":true,
+            "schema":"test",
+            "name":"client_id",
+            "type":"integer",
+            "maxLen":null,
+            "enum":[],
+            "nullable":true,
+            "position":3
+          }
+        ]
+      }
+      |]
+
     it "includes foreign key data" $
-      request methodOptions "/has_fk"
-        [("Authorization", "Basic "<>(cs.encode $ cs uName<>":"<>cs uPass))] ""
+      request methodOptions "/has_fk" [] ""
         `shouldRespondWith` [json|
       {
         "pkey": ["id"],
         "columns":[
           {
-            "default": "nextval('\"1\".has_fk_id_seq'::regclass)",
+            "default": "nextval('test.has_fk_id_seq'::regclass)",
             "precision": 64,
             "updatable": true,
-            "schema": "1",
+            "schema": "test",
             "name": "id",
             "type": "bigint",
             "maxLen": null,
             "nullable": false,
             "position": 1,
-            "enum": null,
+            "enum": [],
             "references": null
           }, {
             "default": null,
             "precision": 32,
             "updatable": true,
-            "schema": "1",
+            "schema": "test",
             "name": "auto_inc_fk",
             "type": "integer",
             "maxLen": null,
             "nullable": true,
             "position": 2,
-            "enum": null,
-            "references": {"table": "auto_incrementing_pk", "column": "id"}
+            "enum": [],
+            "references": {"schema":"test", "table": "auto_incrementing_pk", "column": "id"}
           }, {
             "default": null,
             "precision": null,
             "updatable": true,
-            "schema": "1",
+            "schema": "test",
             "name": "simple_fk",
             "type": "character varying",
             "maxLen": 255,
             "nullable": true,
             "position": 3,
-            "enum": null,
-            "references": {"table": "simple_pk", "column": "k"}
+            "enum": [],
+            "references": {"schema":"test", "table": "simple_pk", "column": "k"}
           }
         ]
       }
       |]
+
+    it "includes all information on views for renamed columns, and raises relations to correct schema" $
+      request methodOptions "/articleStars" [] ""
+        `shouldRespondWith` [json|
+          {
+            "pkey": [
+              "articleId",
+              "userId"
+            ],
+            "columns": [
+              {
+                "references": {
+                  "schema": "test",
+                  "column": "id",
+                  "table": "articles"
+                },
+                "default": null,
+                "precision": 32,
+                "updatable": true,
+                "schema": "test",
+                "name": "articleId",
+                "type": "integer",
+                "maxLen": null,
+                "enum": [],
+                "nullable": true,
+                "position": 1
+              },
+              {
+                "references": {
+                  "schema": "test",
+                  "column": "id",
+                  "table": "users"
+                },
+                "default": null,
+                "precision": 32,
+                "updatable": true,
+                "schema": "test",
+                "name": "userId",
+                "type": "integer",
+                "maxLen": null,
+                "enum": [],
+                "nullable": true,
+                "position": 2
+              },
+              {
+                "references": null,
+                "default": null,
+                "precision": null,
+                "updatable": true,
+                "schema": "test",
+                "name": "createdAt",
+                "type": "timestamp without time zone",
+                "maxLen": null,
+                "enum": [],
+                "nullable": true,
+                "position": 3
+              }
+            ]
+          }
+        |]
+
+    it "errors for non existant tables" $
+      request methodOptions "/dne" [] "" `shouldRespondWith` 404

test/Main.hs

@@ -1,17 +1,43 @@
 module Main where
 
-import Database.HDBC (runRaw, disconnect)
 import Test.Hspec
-import Spec
-import SpecHelper (openConnection, loadFixture)
+import SpecHelper
+
+import qualified Hasql.Session as H
+import qualified Hasql.Connection as H
+
+import PostgREST.DbStructure (getDbStructure)
+import Data.String.Conversions (cs)
+
+import qualified Feature.AuthSpec
+import qualified Feature.CorsSpec
+import qualified Feature.DeleteSpec
+import qualified Feature.InsertSpec
+import qualified Feature.QueryLimitedSpec
+import qualified Feature.QuerySpec
+import qualified Feature.RangeSpec
+import qualified Feature.StructureSpec
 
 main :: IO ()
 main = do
-  c <-openConnection
-  runRaw c "drop schema if exists \"1\" cascade"
-  runRaw c "drop schema if exists private cascade"
-  runRaw c "drop schema if exists dbapi cascade"
-  loadFixture "roles" c
-  loadFixture "schema" c
-  disconnect c
-  hspec spec
+  setupDb
+
+  H.acquire (cs dbString) >>= \case
+    Left err -> error $ show err
+    Right c -> do
+      dbOrErr <- H.run (getDbStructure "test") c
+      -- Not using hspec-discover because we want to precompute
+      -- the db structure and pass it to specs for speed
+      either (error.show) (hspec . specs c) dbOrErr
+      H.release c
+
+ where
+  specs conn dbStructure = do
+    describe "Feature.AuthSpec" $ Feature.AuthSpec.spec dbStructure conn
+    describe "Feature.CorsSpec" $ Feature.CorsSpec.spec dbStructure conn
+    describe "Feature.DeleteSpec" $ Feature.DeleteSpec.spec dbStructure conn
+    describe "Feature.InsertSpec" $ Feature.InsertSpec.spec dbStructure conn
+    describe "Feature.QueryLimitedSpec" $ Feature.QueryLimitedSpec.spec dbStructure conn
+    describe "Feature.QuerySpec" $ Feature.QuerySpec.spec dbStructure conn
+    describe "Feature.RangeSpec" $ Feature.RangeSpec.spec dbStructure conn
+    describe "Feature.StructureSpec" $ Feature.StructureSpec.spec dbStructure conn

test/Spec.hs

@@ -1 +0,0 @@
-{-# OPTIONS_GHC -F -pgmF hspec-discover -optF --no-main #-}

test/SpecHelper.hs

@@ -1,77 +1,79 @@
-{-# LANGUAGE OverloadedStrings #-}
 module SpecHelper where
 
 import Network.Wai
 import Test.Hspec
-import Test.Hspec.Wai
-
-import Database.HDBC
-import Database.HDBC.PostgreSQL
 
 import Data.String.Conversions (cs)
-import Control.Exception.Base (bracket, finally)
+import Data.Time.Clock.POSIX (getPOSIXTime)
+import Control.Monad (void)
 
 import Network.HTTP.Types.Header (Header, ByteRange, renderByteRange,
-                                  hRange, hAuthorization)
+                                  hRange, hAuthorization, hAccept)
 import Codec.Binary.Base64.String (encode)
 import Data.CaseInsensitive (CI(..))
 import Text.Regex.TDFA ((=~))
 import qualified Data.ByteString.Char8 as BS
-import Network.Wai.Middleware.Cors (cors)
+import System.Process (readProcess)
+import Web.JWT (secret)
 
-import Middleware(clientErrors, withSavepoint, authenticated)
+import qualified Hasql.Connection  as H
+import qualified Hasql.Session     as H
 
-import Dbapi (app, corsPolicy, AppConfig(..))
-import PgQuery(addUser)
+import PostgREST.App (app)
+import PostgREST.Config (AppConfig(..))
+import PostgREST.Middleware
+import PostgREST.Error(pgErrResponse)
+import PostgREST.Types
+import PostgREST.QueryBuilder (inTransaction, Isolation(..))
 
-isLeft :: Either a b -> Bool
-isLeft (Left _ ) = True
-isLeft _ = False
+dbString :: String
+dbString = "postgres://postgrest_test_authenticator@localhost:5432/postgrest_test"
 
-cfg :: AppConfig
-cfg = AppConfig "postgres://dbapi_test:@localhost:5432/dbapi_test" 9000 "dbapi_anonymous" False
+cfg :: String -> Maybe Integer -> AppConfig
+cfg conStr = AppConfig conStr "postgrest_test_anonymous" "test" 3000 (secret "safe") 10
 
-openConnection :: IO Connection
-openConnection = connectPostgreSQL' $ configDbUri cfg
+cfgDefault :: AppConfig
+cfgDefault = cfg dbString Nothing
 
-withDatabaseConnection :: (Connection -> IO ()) -> IO ()
-withDatabaseConnection = bracket openConnection disconnect
+cfgLimitRows :: Integer -> AppConfig
+cfgLimitRows = cfg dbString . Just
 
-loadFixture :: String -> Connection -> IO ()
-loadFixture name conn = do
-  sql <- readFile $ "test/fixtures/" ++ name ++ ".sql"
-  runRaw conn sql
+withApp :: AppConfig -> DbStructure -> H.Connection
+        -> ActionWith Application -> IO ()
+withApp config dbStructure c perform =
+  perform $ defaultMiddle $ \req resp -> do
+    time <- getPOSIXTime
+    body <- strictRequestBody req
+    let handleReq = H.run $ inTransaction ReadCommitted
+          (runWithClaims config time (app dbStructure config body) req)
 
-dbWithSchema :: ActionWith Connection -> IO ()
-dbWithSchema action = withDatabaseConnection $ \c -> do
-  runRaw c "begin;"
-  action c
-  rollback c
+    handleReq c >>= \case
+      Left err -> do
+        void $ H.run (H.sql "rollback;") c
+        resp $ pgErrResponse err
+      Right res -> resp res
 
-withUser :: BS.ByteString -> BS.ByteString -> BS.ByteString ->
-            ActionWith Connection -> ActionWith Connection
-withUser name pass role action conn = do
-  addUser name pass role conn
-  finally (action conn) $ do
-    _ <- run conn "delete from dbapi.auth where id=?" [toSql name]
-    runRaw conn "commit"
+setupDb :: IO ()
+setupDb = do
+  void $ readProcess "psql" ["-d", "postgres", "-a", "-f", "test/fixtures/database.sql"] []
+  loadFixture "roles"
+  loadFixture "schema"
+  loadFixture "privileges"
+  resetDb
 
-withApp :: ActionWith Application -> ActionWith Connection
-withApp action conn = do
-  runRaw conn "begin;"
-  action $ cors corsPolicy $ authenticated "dbapi_anonymous" app conn
-  rollback conn
+resetDb :: IO ()
+resetDb = loadFixture "data"
 
-appWithFixture :: ActionWith Application -> IO ()
-appWithFixture action = withDatabaseConnection $ \c -> do
-  runRaw c "begin;"
-  action $ cors corsPolicy . clientErrors  $
-    (authenticated "dbapi_anonymous" . withSavepoint) app c
-  rollback c
+loadFixture :: FilePath -> IO()
+loadFixture name =
+  void $ readProcess "psql" ["-U", "postgrest_test", "-d", "postgrest_test", "-a", "-f", "test/fixtures/" ++ name ++ ".sql"] []
 
 rangeHdrs :: ByteRange -> [Header]
 rangeHdrs r = [rangeUnit, (hRange, renderByteRange r)]
 
+acceptHdrs :: BS.ByteString -> [Header]
+acceptHdrs mime = [(hAccept, mime)]
+
 rangeUnit :: Header
 rangeUnit = ("Range-Unit" :: CI BS.ByteString, "items")
 
@@ -79,14 +81,10 @@ matchHeader :: CI BS.ByteString -> String -> [Header] -> Bool
 matchHeader name valRegex headers =
   maybe False (=~ valRegex) $ lookup name headers
 
-authHeader :: String -> String -> Header
-authHeader user pass =
-  (hAuthorization, cs $ "Basic " ++ encode (user ++ ":" ++ pass))
+authHeaderBasic :: String -> String -> Header
+authHeaderBasic u p =
+  (hAuthorization, cs $ "Basic " ++ encode (u ++ ":" ++ p))
 
--- for hspec-wai
-pending_ :: WaiSession ()
-pending_ = liftIO Test.Hspec.pending
-
--- for hspec-wai
-pendingWith_ :: String -> WaiSession ()
-pendingWith_ = liftIO . Test.Hspec.pendingWith
+authHeaderJWT :: String -> Header
+authHeaderJWT token =
+  (hAuthorization, cs $ "Bearer " ++ token)

test/TestTypes.hs

@@ -1,16 +1,17 @@
-{-# LANGUAGE OverloadedStrings #-}
 module TestTypes (
-  IncPK(..),
-  fromList
+  IncPK(..)
+, CompoundPK(..)
+-- , incFromList
+-- , compoundFromList
 ) where
 
 import qualified Data.Aeson as JSON
 import Data.Aeson ((.:))
-import Data.Maybe (fromJust)
-import Control.Applicative ((<$>), (<*>))
+-- import Data.Maybe (fromJust)
+import Control.Applicative
 import Control.Monad (mzero)
 
-import Database.HDBC (SqlValue, fromSql)
+import Prelude
 
 data IncPK = IncPK {
   incId :: Int
@@ -27,9 +28,28 @@ instance JSON.FromJSON IncPK where
     r .: "inserted_at"
   parseJSON _ = mzero
 
-fromList :: [(String, SqlValue)] -> IncPK
-fromList 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)
+-- 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
+, compoundExtra :: Maybe Int
+}
+
+instance JSON.FromJSON CompoundPK where
+  parseJSON (JSON.Object r) = CompoundPK <$>
+    r .: "k1" <*>
+    r .: "k2" <*>
+    r .: "extra"
+  parseJSON _ = mzero
+
+-- compoundFromList :: [(String, SqlValue)] -> CompoundPK
+-- compoundFromList row = CompoundPK
+--   (fromSql . fromJust $ lookup "k1" row)
+--   (fromSql . fromJust $ lookup "k2" row)
+--   (fromSql . fromJust $ lookup "extra" row)

test/Unit/DbStructureSpec.hx

@@ -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,26 +12,26 @@ 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"})]
 
-  where setRole conn = quickQuery conn "set role dbapi_test" [] >> return conn
+  where setRole conn = quickQuery conn "set role postgrest_test" [] >> return conn

test/Unit/ErrorsSpec.hs

@@ -1,36 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-module Unit.ErrorsSpec where
-
-import Test.Hspec
-
-import Database.HDBC (runRaw, quickQuery, fromSql, SqlError)
-import SpecHelper (dbWithSchema)
-import Middleware (withSavepoint)
-import PgQuery (insert)
-import Types(SqlRow(..))
-import Control.Exception(catch)
-import Control.Monad(void)
-import Network.Wai (defaultRequest, responseLBS)
-import Network.HTTP.Types.Status (ok200)
-
-spec :: Spec
-spec = let
-  dbErrApp conn _ res = do
-    putStrLn "In fake app"
-    _ <- insert "1" "items" (SqlRow []) conn
-    runRaw conn "select 1/0"
-    _ <- insert "1" "items" (SqlRow []) conn
-    res $ responseLBS ok200 [("Content-Type", "application/json")] "{}"
-  in around dbWithSchema $
-
-    describe "withSavepoint" $
-      it "allows partial rollback of request" $ \c -> do
-        let app = withSavepoint dbErrApp c
-        [[beforeCount]] <- quickQuery c "select count(*) from \"1\".items" []
-        runRaw c "set role dbapi_anonymous"
-        _ <- insert "1" "items" (SqlRow []) c
-        catch (void $ app defaultRequest (const undefined) ) $
-          \e -> let _ = (e::SqlError) in do
-          _ <- insert "1" "items" (SqlRow []) c
-          [[afterCount]] <- quickQuery c "select count(*) from \"1\".items" []
-          fromSql afterCount `shouldBe` (fromSql beforeCount::Int) + 2

test/Unit/PgQuerySpec.hx

@@ -1,15 +1,16 @@
-{-# LANGUAGE OverloadedStrings #-}
-
 module Unit.PgQuerySpec where
 
 import Test.Hspec
+import Test.QuickCheck
+import Test.QuickCheck.Monadic
 
 import Database.HDBC (IConnection, SqlValue, toSql, prepare,
   quickQuery, fromSql, execute, seState, fetchAllRowsAL)
 
-import PgQuery (LoginAttempt(..), insert, addUser, signInRole, checkPass)
+import PgQuery (LoginAttempt(..), insert, addUser, signInRole, checkPass
+              , pgFmtIdent, pgFmtLit)
 import Types (SqlRow(SqlRow))
-import TestTypes (fromList, incStr, incNullableStr, incInsert, incId)
+import TestTypes (incFromList, incStr, incNullableStr, incInsert, incId)
 import Data.Map (toList)
 import Data.String.Conversions (cs)
 import Data.Monoid ((<>))
@@ -31,39 +32,39 @@ 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 = fromList . toList $ r
+        let returnRow = incFromList . toList $ r
         incStr returnRow `shouldBe` "a string"
         incNullableStr returnRow `shouldBe` Nothing
         incInsert returnRow `shouldSatisfy` not . null
         incId returnRow `shouldSatisfy` (>= 0)
         tRows <- quickALQuery conn "select * from \"1\".auto_incrementing_pk" []
-        [returnRow] `shouldBe` map fromList tRows
+        [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
-      [r] <- quickQuery conn "select * from dbapi.auth" []
+      [r] <- quickQuery conn "select * from postgrest.auth" []
       let [newUser, newRole, encryptedPass] = map fromSql r :: [String]
       cs newUser `shouldBe` user
       cs newRole `shouldBe` role
@@ -78,8 +79,21 @@ 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
       signInRole user (pass <> "crap") conn `shouldReturn` LoginFailed
+
+  describe "pgFmtIdent" $
+    it "Does what format %I would do" $ \conn -> property $ \fuzz ->
+      monadicIO $ do
+        [[row]] <- run $ quickALQuery conn "select format('%I', ? :: varchar)" [toSql (fuzz :: String)]
+        assert $ fromSql (snd row) == pgFmtIdent (cs fuzz)
+
+  describe "pgFmtLit" $
+    it "Does what format %L would do" $ \conn ->
+      property $ monadicIO $ do
+        fuzz <- pick arbitrary
+        [[row]] <- run $ quickALQuery conn "select format('%L', ? :: varchar)" [toSql (fuzz :: String)]
+        assert $ fromSql (snd row) == pgFmtLit (cs fuzz)

test/fixtures/data.sql

@@ -0,0 +1,273 @@
+--
+-- 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', 1, true);
+
+
+--
+-- Data for Name: json; Type: TABLE DATA; Schema: test; Owner: -
+--
+
+TRUNCATE TABLE json CASCADE;
+INSERT INTO json VALUES ('{"foo":{"bar":"baz"},"id":1}');
+
+
+--
+-- 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')
+--
+-- PostgreSQL database dump complete
+--

test/fixtures/database.sql

@@ -0,0 +1,4 @@
+DROP DATABASE IF EXISTS postgrest_test;
+DROP ROLE IF EXISTS postgrest_test;
+CREATE USER postgrest_test createdb createrole;
+CREATE DATABASE postgrest_test OWNER postgrest_test;

test/fixtures/dumpfixture.sh

@@ -1 +1 @@
-pg_dump --host localhost --port 5432 --username "postgres" --no-password  --format plain --column-inserts --verbose --file "./test/fixtures/schema.sql" "dbapi_test"
+pg_dump --host localhost --port 5432 --username "postgres" --no-password  --format plain --column-inserts --verbose --file "./test/fixtures/schema.sql" "postgrest_test"

test/fixtures/privileges.sql

@@ -0,0 +1,49 @@
+-- Privileges for anonymous
+GRANT USAGE ON SCHEMA
+      postgrest
+    , test
+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
+    , has_count_column
+    , has_fk
+    , insertable_view_with_join
+    , json
+    , materialized_view
+    , menagerie
+    , no_pk
+    , nullable_integer
+    , projects
+    , projects_view
+    , simple_pk
+    , tasks
+    , tsearch
+    , users
+    , users_projects
+    , users_tasks
+    , "Escap3e;"
+    , "ghostBusters"
+    , "withUnique"
+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
+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;

test/fixtures/roles.sql

@@ -1,19 +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;
-$$;
+DROP ROLE IF EXISTS postgrest_test_authenticator, postgrest_test_anonymous, postgrest_test_default_role, postgrest_test_author;
+CREATE ROLE postgrest_test_authenticator WITH login noinherit;
+CREATE ROLE postgrest_test_anonymous;
+CREATE ROLE postgrest_test_default_role;
+CREATE ROLE postgrest_test_author;
 
-select pg_temp.create_role_if_not_exists('dbapi_anonymous', 'with nologin');
-select pg_temp.create_role_if_not_exists('test_default_role', 'with nologin');
-
-select pg_temp.create_role_if_not_exists('dbapi_test_author', 'with nologin');
-select pg_temp.create_role_if_not_exists('dbapi_test_author_a', 'with nologin in role dbapi_test_author');
-select pg_temp.create_role_if_not_exists('dbapi_test_author_b', 'with nologin in role dbapi_test_author');
+GRANT postgrest_test_anonymous, postgrest_test_default_role, postgrest_test_author TO postgrest_test_authenticator;