bump minor version

Allow continued auth access after db errors

.gitignore

@@ -5,3 +5,5 @@ cabal.sandbox.config
 hscope.out
 codex.tags
 .anvil
+.stack-work
+tags

CHANGELOG.md

@@ -0,0 +1,70 @@
+# Change Log
+
+All notable changes to this project will be documented in this file.
+This project adheres to [Semantic Versioning](http://semver.org/).
+
+## [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,55 @@
+# 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.
+
+## 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,56 +1,175 @@
-## Serve a RESTful API from any Postgres database
+![Logo](static/logo.png "Logo")
 
-[![Build Status](https://circleci.com/gh/begriffs/postgrest.png?circle-token=f723c01686abf0364de1e2eaae5aff1f68bd3ff2)](https://circleci.com/gh/begriffs/postgrest/tree/master)
+[![Build Status](https://circleci.com/gh/begriffs/postgrest.png?style=shield&circle-token=f723c01686abf0364de1e2eaae5aff1f68bd3ff2)](https://circleci.com/gh/begriffs/postgrest/tree/master)
+<a href="https://heroku.com/deploy?template=https://github.com/begriffs/postgrest">
+  <img src="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) | Watch [Video](http://begriffs.com/posts/2014-12-30-intro-to-postgrest.html) | [GUI Demo](http://marmelab.com/ng-admin-postgrest)
+
+Try making requests to the live demo server with an HTTP client
+such as [postman](http://www.getpostman.com/). The structure of the
+demo database is defined by
+[begriffs/postgrest-example](https://github.com/begriffs/postgrest-example).
+You can use it as inspiration for test-driven server migrations in
+your own projects.
+
+### Usage
+
+Download the binary ([latest release](https://github.com/begriffs/postgrest/releases/latest)) and invoke like so:
+
+```bash
+postgrest  --db-host localhost  --db-port 5432     \
+           --db-name my_db      --db-user postgres \
+           --db-pass foobar     --db-pool 200      \
+           --anonymous postgres --port 3000        \
+           --v1schema public
 ```
 
-Example usage:
+In production include the `--secure` option which redirects all
+requests to HTTPS. Note that PostgREST does not handle the SSL
+internally and must be put behind another server that does (such
+as nginx or the Heroku load balancer).
 
-```sh
-cabal run -d [database] -U [auth-role] -a [anonymous-role]
-```
+### Performance
 
-This will connect to a postgres DB at the url
-`postgres://[auth-role]:@localhost:5432/[database]`.
+TLDR; subsecond response times for up to 2000 requests/sec on Heroku free tier. ([see the load test](https://github.com/begriffs/postgrest/wiki/Performance-and-Scaling))
 
-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 `postgrest` schema if you intend to support multi-user
-applications.
+If you're used to servers written in interpreted languages (or named
+after precious gems), prepare to be pleasantly surprised by PostgREST
+performance.
 
-The other role is for anonymous access (`anonymous-role` above).
-Immediately upon acceping any unauthenticated HTTP connection postgrest
-assumes this role in its queries to postgres. Give this role as
-much or little permissions as you would like.
+Three factors contribute to the speed. First the server is written
+in [Haskell](https://new-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
 
-### Running tests
+* Serializing JSON responses directly in SQL
+* Data validation
+* Authorization
+* Combined row counting and retrieval
+* Data post in single command (`returning *`)
 
-```sh
-createuser --superuser --no-password postgrest_test
-createdb -O postgrest_test -U postgres postgrest_test
+Finally it uses the database efficiently with the
+[Hasql](https://nikita-volkov.github.io/hasql-benchmarks/) library
+by
 
-cabal test --show-details=always --test-options="--color"
-```
+* Reusing prepared statements
+* Keeping a pool of db connections
+* Using the Postgres binary protocol
+* Being stateless to allow horizontal scaling
 
-### Distributing Heroku build
+Ultimately the server (when load balanced) is constrained by database
+performance. This may make it inappropriate for very large traffic
+load. To learn more about scaling with Heroku and Amazon RDS see
+the [performance guide](https://github.com/begriffs/postgrest/wiki/Performance-and-Scaling).
 
-```sh
-heroku create --stack=cedar --buildpack https://github.com/begriffs/heroku-buildpack-ghc.git
-git push heroku master
+Other optimizations are possible, and some are outlined in the
+[Future Features](#future-features).
 
-heroku config:set S3_ACCESS_KEY=abc
-heroku config:set S3_SECRET_KEY=123
-heroku config:set S3_BUCKET=s3://foo/bar
+### Security
 
-heroku run scripts/release_s3.sh
-```
+PostgREST handles authentication (HTTP Basic over SSL or [JSON Web
+Tokens](https://github.com/begriffs/postgrest/wiki/Security-and-Permissions#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.
 
-### Acknowledgements
+Postgres 9.5 will soon support true [row-level
+security](http://michael.otacoo.com/postgresql-2/postgres-9-5-feature-highlight-row-level-security/).
+In the meantime what isn't yet implemented can be simulated with
+triggers and security-barrier views. Because the possible queries
+to the database are limited to certain templates using
+[leakproof](http://blog.2ndquadrant.com/how-do-postgresql-security_barrier-views-work/)
+functions, the trigger workaround does not compromise row-level
+security.
 
-Thanks to [Adam Baker](https://github.com/adambaker) for code contributions and many fundamental design discussions. Also thanks to [Loop/Recur](https://looprecur.com) for open-source Fridays to advance the code, and for their courage to use this thing in real projects.
+For example security patterns see the [security
+guide](https://github.com/begriffs/postgrest/wiki/Security-and-Permissions).
+
+### Versioning
+
+A robust long-lived API needs the freedom to exist in multiple
+versions. PostgREST supports versioning through HTTP content
+negotiation. Requests for a certain version translate into switching
+which database schema to search for tables. PostgreSQL schema search
+paths allow tables from earlier versions to be reused verbatim in
+later versions.
+
+To learn more, see the [guide to versioning](https://github.com/begriffs/postgrest/wiki/API-Versioning).
+
+### Self-documention
+
+Rather than writing and maintaining separate docs yourself let the
+API explain its own affordances using HTTP. All PostgREST endpoints
+respond to the OPTIONS verb and explain what they support as well
+as the data format of their JSON payload.
+
+The number of rows returned by an endpoint is reported by - and
+limited with - range headers. More about
+[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 [Postgres
+constraints](http://www.tutorialspoint.com/postgresql/postgresql_constraints.htm)
+and the [guide to routing](https://github.com/begriffs/postgrest/wiki/Routing).
+
+### Future Features
+
+* Watching endpoint changes with sockets and Postgres pubsub
+* Specifying per-view HTTP caching
+* Inferring good default caching policies from the Postgres stats collector
+* Generating mock data for test clients
+* Maintaining separate connection pools per role to avoid "set/reset
+  role" performance penalty
+* Describe more relationships with Link headers
+* Depending on accept headers, render OPTIONS as [RAML](http://raml.org/) or a
+  relational diagram
+* Add two-legged auth with OAuth 1.0a(?)
+* ... the other [issues](https://github.com/begriffs/postgrest/issues)
+
+### Guides
+
+* [Routing](https://github.com/begriffs/postgrest/wiki/Routing)
+* [Versioning](https://github.com/begriffs/postgrest/wiki/API-Versioning)
+* [Performance](https://github.com/begriffs/postgrest/wiki/Performance-and-Scaling)
+* [Security](https://github.com/begriffs/postgrest/wiki/Security-and-Permissions)
+* [Tutorial](http://blog.jonharrington.org/postgrest-introduction/) (external)
+* [Heroku](https://github.com/begriffs/postgrest/wiki/Heroku)
+
+### Thanks
+
+* [Adam Baker](https://github.com/adambaker) for code
+  contributions and many fundamental design discussions
+* [Diogo Biazus](https://github.com/diogob) for many improvements
+  and deep postgresql knowledge
+* [Nikita Volkov](https://github.com/nikita-volkov) for writing the
+  wonderful [Hasql](https://github.com/nikita-volkov/hasql) library
+  and helping me use it
+* [Mikey Casalaina](https://github.com/casalaina) for the cool logo
+* [Jonathan Harrington](https://github.com/prio) for writing a [nice
+  tutorial](http://blog.jonharrington.org/postgrest-introduction/)
+* [Federico Rampazzo](https://github.com/framp) for suggesting and
+  implementing [JWT](http://jwt.io/) support

app.json

@@ -0,0 +1,46 @@
+{
+  "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.2.11.0"
+    },
+    "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"
+    }
+  }
+}

circle.yml

@@ -4,3 +4,13 @@ machine:
     - createdb -O postgrest_test -U ubuntu postgrest_test
   ghc:
     version: 7.8.3
+dependencies:
+  override:
+    - cabal update
+    - cabal sandbox init
+    - cabal install --upgrade-dependencies --constraint="template-haskell installed" --dependencies-only --enable-tests
+    - cabal configure --enable-tests -f ci
+test:
+  post:
+    - cabal exec hlint -- -X QuasiQuotes src/**/*.hs test/**/*.hs
+    - cabal exec packdeps postgrest.cabal

debian/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,23 @@
+# run service as
+#POSTGREST_USER=postgrest
+
+# log file
+#POSTGREST_LOG=/var/log/postgrest/postgrest.log
+
+# database host
+#POSTGREST_DBHOST=localhost
+
+# database to use
+#POSTGREST_DBNAME=
+
+# database user
+#POSTGREST_DBUSER=postgres
+
+# database password
+#POSTGREST_DBPASS=
+
+# database pool
+#POSTGREST_DBPOOL=10
+
+# additional options
+#POSTGREST_OPTS=

debian/postgrest.init.d

@@ -0,0 +1,78 @@
+#!/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
+POSTGREST_USER=${POSTGREST_USER:-postgrest}
+POSTGREST_DBNAME=${POSTGREST_DBNAME:-postgres}
+POSTGREST_DBUSER=${POSTGREST_DBUSER:-postgres}
+if [ -n "$POSTGREST_DBHOST" ]; then
+	POSTGREST_OPTS="$POSTGREST_OPTS --db-host $POSTGREST_DBHOST"
+fi
+if [ -n "$POSTGREST_DBNAME" ]; then
+	POSTGREST_OPTS="$POSTGREST_OPTS --db-name $POSTGREST_DBNAME"
+fi
+if [ -n "$POSTGREST_DBUSER" ]; then
+	POSTGREST_OPTS="$POSTGREST_OPTS --db-user $POSTGREST_DBUSER"
+	POSTGREST_OPTS="$POSTGREST_OPTS --anonymous $POSTGREST_DBUSER"
+fi
+if [ -n "$POSTGREST_DBPASS" ]; then
+	POSTGREST_OPTS="$POSTGREST_OPTS --db-pass $POSTGREST_DBPASS"
+fi
+if [ -n "$POSTGREST_DBPOOL" ]; then
+	POSTGREST_OPTS="$POSTGREST_OPTS --db-pool $POSTGREST_DBPOOL"
+fi
+POSTGREST_OPTS="$POSTGREST_OPTS --v1schema public"
+ 
+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 -- $POSTGREST_OPTS; 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

postgrest.cabal

@@ -1,89 +1,149 @@
 name:                  postgrest
-version:               0.2.4.7
-synopsis:              The database is your api
+description:           Reads the schema of a PostgreSQL database and creates RESTful routes
+                       for the tables and views, supporting all HTTP verbs that security
+                       permits.
+version:               0.2.11.0
+synopsis:              REST API for any Postgres database
 license:               MIT
 license-file:          LICENSE
 author:                Joe Nelson, Adam Baker
+homepage:              https://github.com/begriffs/postgrest
 maintainer:            cred+github@begriffs.com
 category:              Web
 build-type:            Simple
 cabal-version:         >=1.10
+source-repository head
+  type: git
+  location: git://github.com/begriffs/postgrest.git
+
+Flag CI
+  Description: No warnings allowed in continuous integration
+  Manual:      True
+  Default:     False
 
 executable postgrest
-  main-is:             Main.hs
-  ghc-options:         -Wall -W -Werror -O2
+  main-is:             PostgREST/Main.hs
+  default-extensions:  OverloadedStrings, ScopedTypeVariables, QuasiQuotes
   default-language:    Haskell2010
-  default-extensions:  OverloadedStrings
-  other-extensions:    QuasiQuotes
   build-depends:       base >=4.6 && <5
-                     , hasql == 0.4.*, hasql-backend
-                     , hasql-postgres == 0.8.*
+                     , postgrest
+                     , hasql >= 0.7.3 && < 0.8
+                     , hasql-backend >= 0.4.1 && < 0.5
+                     , hasql-postgres >= 0.10.4 && < 0.11
                      , warp >= 3.0.2, wai >= 3.0.1
                      , wai-extra, wai-cors
                      , wai-middleware-static >= 0.6.0
                      , HTTP, convertible, http-types
                      , case-insensitive
                      , scientific, time
-                     , aeson, network >= 2.6
+                     , aeson >= 0.8, network >= 2.6
                      , bytestring, text, split, string-conversions
-                     , stringsearch, parsec
+                     , stringsearch
                      , containers, unordered-containers
-                     , optparse-applicative >= 0.9.1 && < 0.10
+                     , optparse-applicative == 0.11.*
                      , regex-base, regex-tdfa
-                     , regex-tdfa-text
                      , Ranged-sets
-                     , transformers
-                     , bcrypt, base64-string
+                     , transformers, MissingH
+                     , bcrypt >= 0.0.6, base64-string
                      , network-uri >= 2.6
                      , resource-pool
                      , blaze-builder
                      , vector
                      , mtl
-  Other-Modules:       App
-                     , Auth
-                     , Config
-                     , PgStructure
-                     , PgQuery
-                     , PgError
-                     , RangeQuery
-                     , Middleware
+                     , cassava
+                     , jwt
+  hs-source-dirs:      src
+
+library
+  if flag(ci)
+    ghc-options:       -Wall -W -Werror
+  else
+    ghc-options:       -Wall -W -O2
+
+  default-language:    Haskell2010
+  default-extensions:  OverloadedStrings, ScopedTypeVariables, QuasiQuotes
+  build-depends:       base >=4.6 && <5
+                     , hasql, hasql-backend
+                     , hasql-postgres
+                     , warp, wai
+                     , wai-extra, wai-cors
+                     , wai-middleware-static
+                     , HTTP, convertible, http-types
+                     , case-insensitive
+                     , scientific, time
+                     , aeson, network
+                     , bytestring, text, split, string-conversions
+                     , stringsearch
+                     , containers, unordered-containers
+                     , optparse-applicative
+                     , regex-base, regex-tdfa
+                     , Ranged-sets
+                     , transformers, MissingH
+                     , bcrypt, base64-string
+                     , network-uri
+                     , resource-pool
+                     , blaze-builder
+                     , vector
+                     , mtl
+                     , cassava
+                     , jwt
+  Exposed-Modules:     PostgREST.App
+                     , PostgREST.Auth
+                     , PostgREST.Config
+                     , PostgREST.Error
+                     , PostgREST.Middleware
+                     , PostgREST.PgQuery
+                     , PostgREST.PgStructure
+                     , PostgREST.RangeQuery
   hs-source-dirs:      src
 
 Test-Suite spec
   Type:                exitcode-stdio-1.0
   Default-Language:    Haskell2010
-  default-extensions:  OverloadedStrings
-  other-extensions:    QuasiQuotes
+  default-extensions:  OverloadedStrings, ScopedTypeVariables, QuasiQuotes
   Hs-Source-Dirs:      test, src
-  ghc-options:         -Wall -W -Werror
-  Main-Is:             Spec.hs
-  Other-Modules:       App, Auth, Config, Spec, SpecHelper
-  Build-Depends:       base, hspec >= 2.0, QuickCheck
-                     , hspec-wai >= 0.5.0, hspec-wai-json
-                     , hasql == 0.4.*, hasql-backend
-                     , hasql-postgres == 0.8.*
-                     , warp >= 3.0.2, wai >= 3.0.1
+  if flag(ci)
+    ghc-options:       -Wall -W -Werror
+  else
+    ghc-options:       -Wall -W -O2
+  Main-Is:             Main.hs
+  Other-Modules:       PostgREST.App
+                     , PostgREST.Auth
+                     , PostgREST.Config
+                     , PostgREST.Error
+                     , PostgREST.Middleware
+                     , PostgREST.PgQuery
+                     , PostgREST.PgStructure
+                     , PostgREST.RangeQuery
+                     , Spec
+                     , SpecHelper
+  Build-Depends:       base, hspec == 2.1.*, QuickCheck
+                     , hspec-wai, hspec-wai-json
+                     , hasql, hasql-backend
+                     , hasql-postgres
+                     , warp, wai
+                     , packdeps, hlint
                      , HTTP, convertible
                      , case-insensitive
                      , wai-extra, wai-cors, containers
-                     , wai-middleware-static >= 0.6.0
+                     , wai-middleware-static
                      , http-types, scientific, time
-                     , bytestring, aeson, network >= 2.6
+                     , bytestring, aeson, network
                      , text, optparse-applicative
-                     , stringsearch, parsec
+                     , stringsearch
                      , unordered-containers
                      , regex-base
                      , string-conversions
                      , http-media, regex-tdfa
-                     , regex-tdfa-text
                      , Ranged-sets
-                     , transformers
-                     , bcrypt
-                     , base64-string
-                     , split
-                     , network-uri >= 2.6
+                     , transformers, MissingH, split
+                     , bcrypt, base64-string
+                     , network-uri
                      , resource-pool
                      , blaze-builder
                      , vector
                      , mtl
+                     , cassava
                      , process
+                     , heredoc
+                     , jwt

src/App.hs

@@ -1,252 +0,0 @@
-{-# LANGUAGE FlexibleContexts #-}
-module App (app, sqlError, isSqlError) where
-
-import Control.Monad (join)
-import Control.Arrow ((***))
-import Control.Applicative
-
-import Data.Text hiding (map)
-import Data.Maybe (fromMaybe)
-import Text.Regex.TDFA ((=~))
-import Data.Ord (comparing)
-import Data.Ranged.Ranges (emptyRange)
-import Data.HashMap.Strict (keys, elems, filterWithKey, toList)
-import Data.String.Conversions (cs)
-import Data.List (sortBy)
-import Data.Functor.Identity
-import qualified Data.Set as S
-import qualified Data.ByteString.Lazy as BL
-
-import Network.HTTP.Types.Status
-import Network.HTTP.Types.Header
-import Network.HTTP.Types.URI (parseSimpleQuery)
-import Network.HTTP.Base (urlEncodeVars)
-import Network.Wai
-
-import Data.Aeson
-import Data.Monoid
-import qualified Hasql as H
-import qualified Hasql.Postgres as H
-
-import Auth
-import PgQuery
-import RangeQuery
-import PgStructure
-import PgError
-import Text.Parsec hiding (Column)
-
-app :: BL.ByteString -> Request -> H.Tx H.Postgres s Response
-app reqBody req =
-  case (path, verb) of
-    ([], _) -> do
-      body <- encode <$> tables (cs schema)
-      return $ responseLBS status200 [jsonH] $ cs body
-
-    ([table], "OPTIONS") -> do
-      let t = QualifiedTable schema (cs table)
-      cols <- columns t
-      pkey <- map cs <$> primaryKeyColumns t
-      return $ responseLBS status200 [jsonH, allOrigins]
-        $ encode (TableOptions cols pkey)
-
-    ([table], "GET") ->
-      if range == Just emptyRange
-      then return $ responseLBS status416 [] "HTTP Range error"
-      else do
-        let qt = QualifiedTable schema (cs table)
-        let select = coerce $
-              ("select ",[],mempty) <>
-                  parentheticT (
-                    whereT qq $ countRows qt
-                  ) <> commaq <> (
-                  asJsonWithCount
-                  . limitT range
-                  . orderT (orderParse qq)
-                  . whereT qq
-                  $ selectStar qt
-                )
-        row <- H.single select
-        let (tableTotal, queryTotal, body) =
-              fromMaybe (0, 0, Just "" :: Maybe Text) row
-            from = fromMaybe 0 $ rangeOffset <$> range
-            to = from+queryTotal-1
-            contentRange = contentRangeH from to tableTotal
-            status = rangeStatus from to tableTotal
-            canonical = urlEncodeVars
-                          . sortBy (comparing fst)
-                          . map (join (***) cs)
-                          . parseSimpleQuery
-                          $ rawQueryString req
-        return $ responseLBS status
-          [jsonH, contentRange,
-            ("Content-Location",
-             "/" <> cs table <>
-                if Prelude.null canonical then "" else "?" <> cs canonical
-            )
-          ] (cs $ fromMaybe "[]" body)
-
-    (["postgrest", "users"], "POST") -> do
-      let user = decode reqBody :: Maybe AuthUser
-
-      case user of
-        Nothing -> return $ responseLBS status400 [jsonH] $
-          encode . object $ [("message", String "Failed to parse user.")]
-        Just u -> do
-          _ <- addUser (cs $ userId u)
-            (cs $ userPass u) (cs $ userRole u)
-          return $ responseLBS status201
-            [ jsonH
-            , (hLocation, "/postgrest/users?id=eq." <> cs (userId u))
-            ] ""
-
-    ([table], "POST") ->
-      handleJsonObj reqBody $ \obj -> do
-        let qt = QualifiedTable schema (cs table)
-            query = coerce $
-              insertInto qt (map cs $ keys obj) (elems obj)
-        row <- H.single query
-        let (Identity insertedJson) = fromMaybe (Identity "{}" :: Identity Text) row
-            Just inserted = decode (cs insertedJson) :: Maybe Object
-
-        primaryKeys <- map cs <$> primaryKeyColumns qt
-        let primaries = if Prelude.null primaryKeys
-            then inserted
-            else filterWithKey (const . (`elem` primaryKeys)) inserted
-        let params = urlEncodeVars
-              $ map (\t -> (cs $ fst t, "eq." <> cs (unquoted $ snd t)))
-              $ sortBy (comparing fst) $ toList primaries
-        return $ responseLBS status201
-          [ jsonH
-          , (hLocation, "/" <> cs table <> "?" <> cs params)
-          ] ""
-
-    ([table], "PUT") ->
-      handleJsonObj reqBody $ \obj -> do
-        let qt = QualifiedTable schema (cs table)
-        primaryKeys <- primaryKeyColumns qt
-        let specifiedKeys = map (cs . fst) qq
-        if S.fromList primaryKeys /= S.fromList specifiedKeys
-          then return $ responseLBS status405 []
-               "You must speficy all and only primary keys as params"
-          else do
-            tableCols <- map (cs . colName) <$> columns qt
-            let cols = map cs $ keys obj
-            if S.fromList tableCols == S.fromList cols
-              then do
-                let vals = elems obj
-                H.unit . coerce $ iffNotT
-                        (whereT qq $ update qt cols vals)
-                        (insertSelect qt cols vals)
-                return $ responseLBS status204 [ jsonH ] ""
-
-              else return $ if Prelude.null tableCols
-                then responseLBS status404 [] ""
-                else responseLBS status400 []
-                   "You must specify all columns in PUT request"
-
-    ([table], "PATCH") ->
-      handleJsonObj reqBody $ \obj -> do
-        let qt = QualifiedTable schema (cs table)
-        H.unit
-          $ coerce
-          $ whereT qq
-          $ update qt (map cs $ keys obj) (elems obj)
-        return $ responseLBS status204 [ jsonH ] ""
-
-    (_, _) ->
-      return $ responseLBS status404 [] ""
-
-  where
-    path   = pathInfo req
-    verb   = requestMethod req
-    qq     = queryString req
-    hdrs   = requestHeaders req
-    schema = requestedSchema hdrs
-    range  = rangeRequested hdrs
-    allOrigins = ("Access-Control-Allow-Origin", "*") :: Header
-    coerce (q, args, All b) = (q, args, b)
-
-
-isSqlError :: H.Error -> Maybe H.Error
-isSqlError = Just
-
-sqlError :: H.Error -> Response
-sqlError err =
-  let inside = case err of
-        H.CantConnect t -> t
-        H.ConnectionLost t -> t
-        H.ErroneousResult t -> t
-        H.UnexpectedResult t -> t
-        H.UnparsableTemplate t -> t
-        H.UnparsableRow t -> t
-        H.NotInTransaction -> "An operation which requires a"
-          <> "database transaction was executed without one"
-      p = parse message
-        "{\"message\": \"failed to parse exception\" }" inside in
-  either
-    (\nope ->
-      responseLBS status500
-      [(hContentType, "application/json")]
-      (cs . show $ nope))
-    (\msg ->
-      responseLBS (httpStatus msg)
-      [(hContentType, "application/json")]
-      (encode msg))
-    p
-
-
-rangeStatus :: Int -> Int -> Int -> Status
-rangeStatus from to total
-  | from > total            = status416
-  | (1 + to - from) < total = status206
-  | otherwise               = status200
-
-contentRangeH :: Int -> Int -> Int -> Header
-contentRangeH from to total =
-  ("Content-Range",
-    if total == 0 || from > total
-    then "*/" <> cs (show total)
-    else cs (show from)  <> "-"
-       <> cs (show to)    <> "/"
-       <> cs (show total)
-  )
-
-requestedSchema :: RequestHeaders -> Text
-requestedSchema hdrs =
-  case verStr of
-       Just [[_, ver]] -> ver
-       _ -> "1"
-
-  where verRegex = "version[ ]*=[ ]*([0-9]+)" :: String
-        accept = cs <$> lookup hAccept hdrs :: Maybe Text
-        verStr = (=~ verRegex) <$> accept :: Maybe [[Text]]
-
-jsonH :: Header
-jsonH = (hContentType, "application/json")
-
-handleJsonObj :: BL.ByteString -> (Object -> H.Tx H.Postgres s Response)
-              -> H.Tx H.Postgres s Response
-handleJsonObj reqBody handler = do
-  let p = eitherDecode reqBody
-  case p of
-    Left err ->
-      return $ responseLBS status400 [jsonH] jErr
-      where
-        jErr = encode . object $
-          [("message", String $ "Failed to parse JSON payload. " <> cs err)]
-    Right (Object o) -> handler o
-    Right _ ->
-      return $ responseLBS status400 [jsonH] jErr
-      where
-        jErr = encode . object $
-          [("message", String "Expecting a JSON object")]
-
-data TableOptions = TableOptions {
-  tblOptcolumns :: [Column]
-, tblOptpkey :: [Text]
-}
-
-instance ToJSON TableOptions where
-  toJSON t = object [
-      "columns" .= tblOptcolumns t
-    , "pkey"   .= tblOptpkey t ]

src/Auth.hs

@@ -1,69 +0,0 @@
-{-# LANGUAGE QuasiQuotes, ScopedTypeVariables, OverloadedStrings #-}
-module Auth where
-
-import Data.Aeson
-import Control.Monad (mzero)
-import Control.Applicative ( (<*>), (<$>) )
-import Crypto.BCrypt
-import Data.Text
-import Data.Monoid
-import qualified Hasql as H
-import qualified Hasql.Postgres as H
-import Data.String.Conversions (cs)
-import PgQuery (pgFmtLit)
-
-import System.IO.Unsafe
-
-data AuthUser = AuthUser {
-    userId :: String
-  , userPass :: String
-  , userRole :: String
-  } deriving (Show)
-
-instance FromJSON AuthUser where
-  parseJSON (Object v) = AuthUser <$>
-                         v .: "id" <*>
-                         v .: "pass" <*>
-                         v .: "role"
-  parseJSON _ = mzero
-
-instance ToJSON AuthUser where
-  toJSON u = object [
-      "id" .= userId u
-    , "pass" .= userPass u
-    , "role" .= userRole u ]
-
-type DbRole = Text
-
-data LoginAttempt =
-    NoCredentials
-  | MalformedAuth
-  | LoginFailed
-  | LoginSuccess DbRole
-  deriving (Eq, Show)
-
-checkPass :: Text -> Text -> Bool
-checkPass = (. cs) . validatePassword . cs
-
-setRole :: Text -> H.Tx H.Postgres s ()
-setRole role = H.unit ("set role " <> cs (pgFmtLit role), [], True)
-
-resetRole :: H.Tx H.Postgres s ()
-resetRole = H.unit [H.q|reset role|]
-
-addUser :: Text -> Text -> Text -> H.Tx H.Postgres s ()
-addUser identity pass role = do
-  let Just hashed = unsafePerformIO $ hashPasswordUsingPolicy fastBcryptHashingPolicy (cs pass)
-  H.unit $
-    [H.q|insert into postgrest.auth (id, pass, rolname) values (?, ?, ?)|]
-      identity (cs hashed :: Text) role
-
-signInRole :: Text -> Text -> H.Tx H.Postgres s LoginAttempt
-signInRole user pass = do
-  u <- H.single $ [H.q|select pass, rolname from postgrest.auth where id = ?|] user
-  return $ maybe LoginFailed (\r ->
-      let (hashed, role) = r in
-      if checkPass hashed pass
-         then LoginSuccess role
-         else LoginFailed
-    ) u

src/Config.hs

@@ -1,54 +0,0 @@
-module Config where
-
-import Network.Wai
-import Control.Applicative
-import Data.Text (strip)
-import qualified Data.CaseInsensitive as CI
-import qualified Data.ByteString.Char8 as BS
-import Data.String.Conversions (cs)
-import Options.Applicative hiding (columns)
-import Network.Wai.Middleware.Cors (CorsResourcePolicy(..))
-
-data AppConfig = AppConfig {
-    configDbName :: String
-  , configDbPort :: Int
-  , configDbUser :: String
-  , configDbPass :: String
-  , configDbHost :: String
-
-  , configPort  :: Int
-  , configAnonRole :: String
-  , configSecure :: Bool
-  , configPool :: Int
-  }
-
-argParser :: Parser AppConfig
-argParser = AppConfig
-  <$> strOption (long "db-name" <> short 'd'                     <> help "name of database")
-  <*> option    (long "db-port" <> short 'P' <> value 5432        <> help "postgres server port")
-  <*> strOption (long "db-user" <> short 'U'                     <> help "postgres authenticator role")
-  <*> strOption (long "db-pass"             <> value ""          <> help "password for authenticator role")
-  <*> strOption (long "db-host" <> short 'h' <> value "localhost" <> help "postgres server hostname")
-
-  <*> option    (long "port" <> short 'p' <> value 3000 <> help "port number on which to run HTTP server")
-  <*> strOption (long "anonymous" <> short 'a' <> help "postgres role to use for non-authenticated requests")
-  <*> switch    (long "secure" <> short 's' <> help "Redirect all requests to HTTPS")
-  <*> option    (long "db-pool" <> value 10 <> help "Max connections in database pool")
-
-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 -> []

src/Main.hs

@@ -1,63 +0,0 @@
-module Main where
-
-import Paths_postgrest (version)
-
-import App
-import Middleware
-
-import Control.Monad (unless)
-import Control.Monad.IO.Class (liftIO)
-import Control.Exception
-import Data.String.Conversions (cs)
-import Network.Wai (strictRequestBody)
-import Network.Wai.Middleware.Cors (cors)
-import Network.Wai.Handler.Warp hiding (Connection)
-import Network.Wai.Middleware.Gzip (gzip, def)
-import Network.Wai.Middleware.Static (staticPolicy, only)
-import Data.List (intercalate)
-import Data.Version (versionBranch)
-import qualified Hasql as H
-import qualified Hasql.Postgres as H
-import Options.Applicative hiding (columns)
-
-import Config (AppConfig(..), argParser, corsPolicy)
-
-main :: IO ()
-main = do
-  conf <- execParser (info (helper <*> argParser) describe)
-  let port = configPort conf
-
-  unless (configSecure conf) $
-    putStrLn "WARNING, running in insecure mode, auth will be in plaintext"
-  Prelude.putStrLn $ "Listening on port " ++
-    (show $ configPort conf :: String)
-
-  let pgSettings = H.ParamSettings (cs $ configDbHost conf)
-                     (fromIntegral $ configDbPort conf)
-                     (cs $ configDbUser conf)
-                     (cs $ configDbPass conf)
-                     (cs $ configDbName conf)
-
-  sessSettings <- maybe (fail "Improper session settings") return $
-                    H.sessionSettings (fromIntegral $ configPool conf) 30
-
-  let appSettings = setPort port
-                  . setServerName (cs $ "postgrest/" <> prettyVersion)
-                  $ defaultSettings
-      middle =
-        (if configSecure conf then redirectInsecure else id)
-        . gzip def . cors corsPolicy
-        . staticPolicy (only [("favicon.ico", "static/favicon.ico")])
-      anonRole = cs $ configAnonRole conf
-
-  H.session pgSettings sessSettings $ H.sessionUnlifter >>= \unlift ->
-    liftIO $ runSettings appSettings $ middle $ \req respond -> do
-      body <- strictRequestBody req
-      respond =<< catchJust isSqlError
-        (unlift $ H.tx Nothing
-                $ authenticated anonRole (app body) req)
-        (return . sqlError)
-
-  where
-    describe = progDesc "create a REST API to an existing Postgres database"
-    prettyVersion = intercalate "." $ map show $ versionBranch version

src/PgError.hs

@@ -1,86 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-
-module PgError (Message(..), message, httpStatus) where
-
-import Text.Parsec
-import Text.Parsec.Text
-import qualified Data.Map as M
-import Text.Regex.TDFA.Text ()
-import Data.Text hiding (drop, concat, head)
-import Data.Aeson
-import Data.Maybe
-import Control.Monad (void)
-
-import Data.String.Conversions (cs)
-import Data.CaseInsensitive (CI, mk)
-
-import Network.HTTP.Types.Status
-
-data Message = Message {
-    msgStatus :: Maybe Text
-  , msgCode   :: Text
-  , msgText   :: Maybe Text
-  , msgHint   :: Maybe Text
-} deriving (Show, Eq)
-
-message :: Parser Message
-message = do
-  ps <- sepBy valPair (char ';')
-  let m = M.fromList ps
-  return $ Message
-    (M.lookup "status" m)
-    (fromMaybe "" $ M.lookup "code" m)
-    (M.lookup "message" m)
-    (M.lookup "hint" m)
-
-valPair :: Parser (CI Text, Text)
-valPair = do
-  _ <- spaces
-  name <- many1 letter
-  _ <- char ':'
-  spaces
-  _ <- many $ char '"'
-  val <- manyTill anyChar $
-    try
-      (void $ many (char '"') >> (
-        (void . lookAhead $ (char ';'))
-        <|> ((optional $ char '.') >> eof)
-      ))
-  return (mk (cs name), cs val)
-
-
-instance ToJSON Message where
-  toJSON t = object [
-      "message" .= msgText t
-    , "code"    .= msgCode t
-    , "status"  .= msgStatus t
-    , "hint"    .= msgHint t
-    ]
-
-httpStatus :: Message -> Status
-httpStatus m =
-  let code = cs $ msgCode m :: String in
-  case code of
-    '0' : '8' : _ -> status503 -- pg connection err
-    '0' : '9' : _ -> status500 -- triggered action exception
-    '0' : 'L' : _ -> status403 -- invalid grantor
-    '0' : 'P' : _ -> status403 -- invalid role specification
-    '2' : '5' : _ -> status500 -- invalid tx state
-    '2' : '8' : _ -> status403 -- invalid auth specification
-    '2' : 'D' : _ -> status500 -- invalid tx termination
-    '3' : '8' : _ -> status500 -- external routine exception
-    '3' : '9' : _ -> status500 -- external routine invocation
-    '3' : 'B' : _ -> status500 -- savepoint exception
-    '4' : '0' : _ -> status500 -- tx rollback
-    '5' : '3' : _ -> status503 -- insufficient resources
-    '5' : '4' : _ -> status413 -- too complex
-    '5' : '5' : _ -> status500 -- obj not on prereq state
-    '5' : '7' : _ -> status500 -- operator intervention
-    '5' : '8' : _ -> status500 -- system error
-    'F' : '0' : _ -> status500 -- conf file error
-    'H' : 'V' : _ -> status500 -- foreign data wrapper error
-    'P' : '0' : _ -> status500 -- PL/pgSQL Error
-    'X' : 'X' : _ -> status500 -- internal Error
-    "42P01" -> status404 -- undefined table
-    "42501" -> status404 -- insufficient privilege
-    _ -> status400

src/PgQuery.hs

@@ -1,220 +0,0 @@
-{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-}
-module PgQuery where
-
-import RangeQuery
-
-import qualified Hasql.Postgres as H
-import qualified Hasql.Backend as H
-
-import Data.Text hiding (map)
-import Text.Regex.TDFA ( (=~) )
-import Text.Regex.TDFA.Text ()
-import qualified Network.HTTP.Types.URI as Net
-import qualified Data.ByteString.Char8 as BS
-import Data.Monoid
-import Data.Maybe (fromMaybe, mapMaybe)
-import Data.Functor ( (<$>) )
-import Control.Monad (join)
-import Data.String.Conversions (cs)
-import qualified Data.Aeson as JSON
-import qualified Data.List as L
-import Data.Scientific (isInteger, formatScientific, FPFormat(..))
-
-type DynamicSQL = (BS.ByteString, [H.StatementArgument H.Postgres], All)
-
-type StatementT = DynamicSQL -> DynamicSQL
-
-data QualifiedTable = QualifiedTable {
-  qtSchema :: Text
-, qtName   :: Text
-} deriving (Show)
-
-data OrderTerm = OrderTerm {
-  otTerm :: Text
-, otDirection :: BS.ByteString
-}
-
-limitT :: Maybe NonnegRange -> StatementT
-limitT r q =
-  q <> (" LIMIT " <> limit <> " OFFSET " <> offset <> " ", [], mempty)
-  where
-    limit  = maybe "ALL" (cs . show) $ join $ rangeLimit <$> r
-    offset = cs . show $ fromMaybe 0 $ rangeOffset <$> r
-
-whereT :: Net.Query -> StatementT
-whereT params q =
- if L.null params
-   then q
-   else q <> (" where ",[],mempty) <> conjunction
- where
-   cols = [ col | col <- params, fst col `notElem` ["order"] ]
-   conjunction = mconcat $ L.intersperse andq (map wherePred cols)
-
-orderT :: [OrderTerm] -> StatementT
-orderT ts q =
-  if L.null ts
-    then q
-    else q <> (" order by ",[],mempty) <> clause
-  where
-   clause = mconcat $ L.intersperse commaq (map queryTerm ts)
-   queryTerm :: OrderTerm -> DynamicSQL
-   queryTerm t = (" " <> cs (pgFmtIdent $ otTerm t) <> " "
-                      <> otDirection t              <> " "
-                  , [], mempty)
-
-parentheticT :: StatementT
-parentheticT (sql, params, pre) =
-  (" (" <> sql <> ") ", params, pre)
-
-iffNotT :: DynamicSQL -> StatementT
-iffNotT (aq, ap, apre) (bq, bp, bpre) =
-  ("WITH aaa AS (" <> aq <> " returning *) " <>
-    bq <> " WHERE NOT EXISTS (SELECT * FROM aaa)"
-  , ap ++ bp
-  , All $ getAll apre && getAll bpre
-  )
-
-countRows :: QualifiedTable -> DynamicSQL
-countRows t =
-  ("select count(1) from " <> fromQt t, [], mempty)
-
-asJsonWithCount :: StatementT
-asJsonWithCount (sql, params, pre) = (
-    "count(t), array_to_json(array_agg(row_to_json(t)))::character varying from (" <> sql <> ") t"
-  , params, pre
-  )
-
-asJsonRow :: StatementT
-asJsonRow (sql, params, pre) = (
-    "row_to_json(t) from (" <> sql <> ") t", params, pre
-  )
-
-selectStar :: QualifiedTable -> DynamicSQL
-selectStar t =
-  ("select * from " <> fromQt t, [], mempty)
-
-insertInto :: QualifiedTable -> [Text] -> [JSON.Value] -> DynamicSQL
-insertInto t [] _ =
-  ("insert into " <> fromQt t <> " default values returning *", [], mempty)
-insertInto t cols vals =
-  ("insert into " <> fromQt t <> " (" <>
-    cs (intercalate ", " (map pgFmtIdent cols)) <>
-    ") values (" <>
-    cs (
-      intercalate ", " (map
-        ((<> "::unknown") . pgFmtLit . unquoted)
-        vals)
-    ) <> ") returning row_to_json(" <> fromQt t <> ".*)"
-  , []
-  , mempty
-  )
-
-insertSelect :: QualifiedTable -> [Text] -> [JSON.Value] -> DynamicSQL
-insertSelect t [] _ =
-  ("insert into " <> fromQt t <> " default values returning *", [], mempty)
-insertSelect t cols vals =
-  ("insert into " <> fromQt t <> " (" <>
-    cs (intercalate ", " (map pgFmtIdent cols)) <>
-    ") select " <>
-    cs (
-      intercalate ", " (map
-        ((<> "::unknown") . pgFmtLit . unquoted)
-        vals)
-    )
-  , []
-  , mempty
-  )
-
-update :: QualifiedTable -> [Text] -> [JSON.Value] -> DynamicSQL
-update t cols vals =
-  ("update " <> fromQt t <> " set (" <>
-    cs (intercalate ", " (map pgFmtIdent cols)) <>
-    ") = (" <>
-    cs (
-      intercalate ", " (map
-        ((<> "::unknown") . pgFmtLit . unquoted)
-        vals)
-    ) <> ")"
-  , []
-  , mempty
-  )
-
-wherePred :: Net.QueryItem -> DynamicSQL
-wherePred (col, predicate) =
-  (" " <> cs (pgFmtIdent $ cs col) <> " " <> op <> " " <> cs (pgFmtLit value) <> "::unknown ", [], mempty)
-
-  where
-    opCode:rest = split (=='.') $ cs $ fromMaybe "." predicate
-    value = intercalate "." rest
-    op = case opCode of
-         "eq"  -> "="
-         "gt"  -> ">"
-         "lt"  -> "<"
-         "gte" -> ">="
-         "lte" -> "<="
-         "neq" -> "<>"
-         _     -> "="
-
-orderParse :: Net.Query -> [OrderTerm]
-orderParse q =
-  mapMaybe orderParseTerm . split (==',') $ cs order
-  where
-    order = fromMaybe "" $ join (lookup "order" q)
-
-orderParseTerm :: Text -> Maybe OrderTerm
-orderParseTerm s =
-  case split (=='.') s of
-       [d,c] ->
-         if d `elem` ["asc", "desc"]
-            then Just $ OrderTerm c $
-              if d == "asc" then "asc" else "desc"
-            else Nothing
-       _ -> Nothing
-
-commaq :: DynamicSQL
-commaq  = (", ", [], mempty)
-
-andq :: DynamicSQL
-andq = (" and ", [], mempty)
-
-pgFmtIdent :: Text -> Text
-pgFmtIdent x =
-  let escaped = replace "\"" "\"\"" (trimNullChars $ cs x) in
-  if escaped =~ danger
-    then "\"" <> escaped <> "\""
-    else escaped
-
-  where danger = "^$|^[^a-z_]|[^a-z_0-9]" :: Text
-
-pgFmtLit :: Text -> Text
-pgFmtLit x =
-  let trimmed = trimNullChars x
-      escaped = "'" <> replace "'" "''" trimmed <> "'"
-      slashed = replace "\\" "\\\\" escaped in
-  cs $ if escaped =~ ("\\\\" :: Text)
-    then "E" <> slashed
-    else slashed
-
-trimNullChars :: Text -> Text
-trimNullChars = Data.Text.takeWhile (/= '\x0')
-
-fromQt :: QualifiedTable -> BS.ByteString
-fromQt t = cs $ pgFmtIdent (qtSchema t) <> "." <> pgFmtIdent (qtName t)
-
-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 _ = ""
-
-pgParam :: JSON.Value -> H.StatementArgument H.Postgres
-pgParam (JSON.Number n) = H.renderValue
-  (cs $ formatScientific Fixed
-       (if isInteger n then Just 0 else Nothing) n :: Text)
-pgParam (JSON.String s) = H.renderValue s
-pgParam (JSON.Bool      b) = H.renderValue $
-  if b then "t" else "f" :: Text
-pgParam JSON.Null       = H.renderValue (Nothing :: Maybe Text)
-pgParam (JSON.Object o) = H.renderValue $ JSON.encode o
-pgParam (JSON.Array  a) = H.renderValue $ JSON.encode a

src/PgStructure.hs

@@ -1,188 +0,0 @@
-{-# LANGUAGE QuasiQuotes, OverloadedStrings, TypeSynonymInstances,
-             MultiParamTypeClasses, ScopedTypeVariables #-}
-module PgStructure where
-
-import PgQuery (QualifiedTable(..))
-import Data.Functor ( (<$>) )
-import Data.Text hiding (foldl, map, zipWith, concat)
-import Data.Aeson
-import Data.Functor.Identity
-import qualified Data.Vector as V
-import Data.String.Conversions (cs)
-
-import Control.Applicative ( (<*>) )
-
-import qualified Data.List as L
-import qualified Data.Map as Map
-
-import qualified Hasql as H
-import qualified Hasql.Backend as H
-import qualified Hasql.Postgres as H
-
-foreignKeys :: QualifiedTable -> H.Tx H.Postgres s (Map.Map Text ForeignKey)
-foreignKeys table = do
-  r :: [(Text, Text, Text)] <- H.list $ [H.q|
-      select kcu.column_name, ccu.table_name AS foreign_table_name,
-        ccu.column_name AS foreign_column_name
-      from information_schema.table_constraints AS tc
-        join information_schema.key_column_usage AS kcu
-          on tc.constraint_name = kcu.constraint_name
-        join information_schema.constraint_column_usage AS ccu
-          on ccu.constraint_name = tc.constraint_name
-      where constraint_type = 'FOREIGN KEY'
-        and tc.table_name=? and tc.table_schema = ?
-        order by kcu.column_name
-    |] (qtName table) (qtSchema table)
-
-  return $ foldl addKey Map.empty r
-  where
-    addKey m (col, ftab, fcol) = Map.insert col (ForeignKey (cs ftab) (cs fcol)) m
-
-
-tables :: Text -> H.Tx H.Postgres s [Table]
-tables schema =
-  H.list $ [H.q|
-      select table_schema, table_name,
-             is_insertable_into
-        from information_schema.tables
-       where table_schema = ?
-       order by table_name
-    |] schema
-
-
-columns :: QualifiedTable -> H.Tx H.Postgres s [Column]
-columns table = do
-  cols <- H.list $ [H.q|
-    select info.table_schema as schema, info.table_name as table_name,
-           info.column_name as name, info.ordinal_position as position,
-           info.is_nullable as nullable, info.data_type as col_type,
-           info.is_updatable as updatable,
-           info.character_maximum_length as max_len,
-           info.numeric_precision as precision,
-           info.column_default as default_value,
-           array_to_string(enum_info.vals, ',') as enum
-       from (
-         select table_schema, table_name, column_name, ordinal_position,
-                is_nullable, data_type, is_updatable,
-                character_maximum_length, numeric_precision,
-                column_default, udt_name
-           from information_schema.columns
-          where table_schema = ? and table_name = ?
-       ) as info
-       left outer join (
-         select n.nspname as s,
-                t.typname as n,
-                array_agg(e.enumlabel ORDER BY e.enumsortorder) as vals
-         from pg_type t
-            join pg_enum e on t.oid = e.enumtypid
-            join pg_catalog.pg_namespace n ON n.oid = t.typnamespace
-         group by s, n
-       ) as enum_info
-       on (info.udt_name = enum_info.n)
-    order by position |] (qtSchema table) (qtName table)
-
-  fks <- foreignKeys table
-  return $ map (\col -> col { colFK = Map.lookup (cs . colName $ col) fks }) cols
-
-
-primaryKeyColumns :: QualifiedTable -> H.Tx H.Postgres s [Text]
-primaryKeyColumns table = do
-  r :: [Identity Text] <- H.list $ [H.q|
-    select kc.column_name
-      from
-        information_schema.table_constraints tc,
-        information_schema.key_column_usage kc
-    where
-      tc.constraint_type = 'PRIMARY KEY'
-      and kc.table_name = tc.table_name and kc.table_schema = tc.table_schema
-      and kc.constraint_name = tc.constraint_name
-      and kc.table_schema = ?
-      and kc.table_name  = ? |] (qtSchema table) (qtName table)
-  return $ map runIdentity r
-
-
-vanishNull :: [a] -> Maybe [a]
-vanishNull xs = if L.null xs then Nothing else Just xs
-
-toBool :: Text -> Bool
-toBool = (== "YES")
-
-data Table = Table {
-  tableSchema :: Text
-, tableName :: Text
-, tableInsertable :: Bool
-} deriving (Show)
-
-data ForeignKey = ForeignKey {
-  fkTable::Text, fkCol::Text
-} deriving (Eq, Show)
-
-data Column = Column {
-  colSchema :: Text
-, colTable :: Text
-, colName :: Text
-, colPosition :: Int
-, colNullable :: Bool
-, colType :: Text
-, colUpdatable :: Bool
-, colMaxLen :: Maybe Int
-, colPrecision :: Maybe Int
-, colDefault :: Maybe Text
-, colEnum :: [Text]
-, colFK :: Maybe ForeignKey
-} deriving (Show)
-
-instance H.RowParser H.Postgres Column where
-  parseRow r =
-    let schema     = H.parseResult $ r V.! 0
-        table      = H.parseResult $ r V.! 1
-        name       = H.parseResult $ r V.! 2
-        position   = H.parseResult $ r V.! 3
-        nullable   = toBool <$> (H.parseResult $ r V.! 4 :: Either Text Text)
-        typ        = H.parseResult $ r V.! 5
-        updatable  = toBool <$> (H.parseResult $ r V.! 6 :: Either Text Text)
-        maxLen     = H.parseResult $ r V.! 7
-        precision  = H.parseResult $ r V.! 8
-        defValue   = H.parseResult $ r V.! 9
-        enum       = either (const $ Right []) (Right . split (==','))
-                       (H.parseResult $ r V.! 10 :: Either Text Text)
-      in
-    if V.length r /= 11
-       then Left "Wrong number of fields in Column"
-       else Column <$> schema <*> table <*> name <*> position <*> nullable
-                   <*> typ <*> updatable <*> maxLen <*> precision
-                   <*> defValue <*> enum
-                   <*> return Nothing
-
-
-instance H.RowParser H.Postgres Table where
-  parseRow r =
-    let schema     = H.parseResult $ r V.! 0
-        name       = H.parseResult $ r V.! 1
-        insertable = toBool <$> (H.parseResult $ r V.! 2 :: Either Text Text) in
-    if V.length r /= 3
-       then Left "Wrong number of fields in Table"
-       else Table <$> schema <*> name <*> insertable
-
-instance ToJSON Column where
-  toJSON c = object [
-      "schema"    .= colSchema c
-    , "name"      .= colName c
-    , "position"  .= colPosition c
-    , "nullable"  .= colNullable c
-    , "type"      .= colType c
-    , "updatable" .= colUpdatable c
-    , "maxLen"    .= colMaxLen c
-    , "precision" .= colPrecision c
-    , "references".= colFK c
-    , "default"   .= colDefault c
-    , "enum"      .= colEnum c ]
-
-instance ToJSON ForeignKey where
-  toJSON fk = object ["table".=fkTable fk, "column".=fkCol fk]
-
-instance ToJSON Table where
-  toJSON v = object [
-      "schema"     .= tableSchema v
-    , "name"       .= tableName v
-    , "insertable" .= tableInsertable v ]

src/PostgREST/App.hs

@@ -0,0 +1,360 @@
+{-# LANGUAGE FlexibleContexts #-}
+module PostgREST.App (app, sqlError, isSqlError, contentTypeForAccept) where
+
+import Control.Monad (join)
+import Control.Arrow ((***), second)
+import Control.Applicative
+
+import Data.Text hiding (map, find)
+import Data.Maybe (fromMaybe, mapMaybe, isJust, isNothing)
+import Text.Regex.TDFA ((=~))
+import Data.Ord (comparing)
+import Data.Ranged.Ranges (emptyRange)
+import qualified Data.HashMap.Strict as M
+import Data.String.Conversions (cs)
+import Data.CaseInsensitive (original)
+import Data.List (sortBy, find)
+import Data.Functor.Identity
+import qualified Data.Set as S
+import qualified Data.ByteString.Lazy as BL
+import qualified Data.ByteString.Char8 as BS
+import qualified Blaze.ByteString.Builder as BB
+import qualified Data.Csv as CSV
+
+import Network.HTTP.Types.Status
+import Network.HTTP.Types.Header
+import Network.HTTP.Types.URI (parseSimpleQuery)
+import Network.HTTP.Base (urlEncodeVars)
+import Network.Wai
+import Network.Wai.Parse (parseHttpAccept)
+import Network.Wai.Internal (Response(..))
+
+import Data.Aeson
+import Data.Monoid
+import qualified Data.Vector as V
+import qualified Hasql as H
+import qualified Hasql.Backend as B
+import qualified Hasql.Postgres as P
+
+import PostgREST.Config (AppConfig(..))
+import PostgREST.Auth
+import PostgREST.PgQuery
+import PostgREST.RangeQuery
+import PostgREST.PgStructure
+
+import Prelude
+
+app :: AppConfig -> BL.ByteString -> Request -> H.Tx P.Postgres s Response
+app conf reqBody req =
+  case (path, verb) of
+    ([], _) -> do
+      body <- encode <$> tables (cs schema)
+      return $ responseLBS status200 [jsonH] $ cs body
+
+    ([table], "OPTIONS") -> do
+      let qt = qualify table
+      cols <- columns qt
+      pkey <- map cs <$> primaryKeyColumns qt
+      return $ responseLBS status200 [jsonH, allOrigins]
+        $ encode (TableOptions cols pkey)
+
+    ([table], "GET") ->
+      if range == Just emptyRange
+      then return $ responseLBS status416 [] "HTTP Range error"
+      else do
+        let qt = qualify table
+            from = fromMaybe 0 $ rangeOffset <$> range
+            select = B.Stmt "select " V.empty True <>
+                  parentheticT (
+                    whereT qt qq $ countRows qt
+                  ) <> commaq <> (
+                  bodyForAccept contentType qt
+                  . limitT range
+                  . orderT (orderParse qq)
+                  . whereT qt qq
+                  $ selectStar qt
+                )
+        row <- H.maybeEx select
+        let (tableTotal, queryTotal, body) =
+              fromMaybe (0, 0, Just "" :: Maybe Text) row
+            to = from+queryTotal-1
+            contentRange = contentRangeH from to tableTotal
+            status = rangeStatus from to tableTotal
+            canonical = urlEncodeVars
+                          . sortBy (comparing fst)
+                          . map (join (***) cs)
+                          . parseSimpleQuery
+                          $ rawQueryString req
+        return $ responseLBS status
+          [contentTypeH, contentRange,
+            ("Content-Location",
+             "/" <> cs table <>
+                if Prelude.null canonical then "" else "?" <> cs canonical
+            )
+          ] (cs $ fromMaybe "[]" body)
+
+    (["postgrest", "users"], "POST") -> do
+      let user = decode reqBody :: Maybe AuthUser
+
+      case user of
+        Nothing -> return $ responseLBS status400 [jsonH] $
+          encode . object $ [("message", String "Failed to parse user.")]
+        Just u -> do
+          _ <- addUser (cs $ userId u)
+            (cs $ userPass u) (cs $ userRole u)
+          return $ responseLBS status201
+            [ jsonH
+            , (hLocation, "/postgrest/users?id=eq." <> cs (userId u))
+            ] ""
+
+    (["postgrest", "tokens"], "POST") ->
+      case jwtSecret of
+        "secret" -> return $ responseLBS status500 [jsonH] $
+          encode . object $ [("message", String "JWT Secret is set as \"secret\" which is an unsafe default.")]
+        _ -> do
+          let user = decode reqBody :: Maybe AuthUser
+
+          case user of
+            Nothing -> return $ responseLBS status400 [jsonH] $
+              encode . object $ [("message", String "Failed to parse user.")]
+            Just u -> do
+              setRole authenticator
+              login <- signInRole (cs $ userId u)
+                              (cs $ userPass u)
+              case login of
+                LoginSuccess role uid ->
+                  return $ responseLBS status201 [ jsonH ] $
+                    encode . object $ [("token", String $ tokenJWT jwtSecret uid role)]
+                _  -> return $ responseLBS status401 [jsonH] $
+                  encode . object $ [("message", String "Failed authentication.")]
+
+    ([table], "POST") -> do
+      let qt = qualify table
+          echoRequested = lookupHeader "Prefer" == Just "return=representation"
+          parsed :: Either String (V.Vector Text, V.Vector (V.Vector Value))
+          parsed = if lookupHeader "Content-Type" == Just csvMT
+                    then do
+                      rows <- CSV.decode CSV.NoHeader reqBody
+                      if V.null rows then Left "CSV requires header"
+                        else Right (V.head rows, (V.map $ V.map $ parseCsvCell . cs) (V.tail rows))
+                    else eitherDecode reqBody >>= \val ->
+                      case val of
+                        Object obj -> Right .  second V.singleton .  V.unzip .  V.fromList $
+                          M.toList obj
+                        _ -> Left "Expecting single JSON object or CSV rows"
+      case parsed of
+        Left err -> return $ responseLBS status400 [] $
+          encode . object $ [("message", String $ "Failed to parse JSON payload. " <> cs err)]
+        Right toBeInserted -> do
+          rows :: [Identity Text] <- H.listEx $ uncurry (insertInto qt) toBeInserted
+          let inserted :: [Object] = mapMaybe (decode . cs . runIdentity) rows
+          primaryKeys <- primaryKeyColumns qt
+          let responses = flip map inserted $ \obj -> do
+                let primaries =
+                      if Prelude.null primaryKeys
+                        then obj
+                        else M.filterWithKey (const . (`elem` primaryKeys)) obj
+                let params = urlEncodeVars
+                      $ map (\t -> (cs $ fst t, cs (paramFilter $ snd t)))
+                      $ sortBy (comparing fst) $ M.toList primaries
+                responseLBS status201
+                  [ jsonH
+                  , (hLocation, "/" <> cs table <> "?" <> cs params)
+                  ] $ if echoRequested then encode obj else ""
+          return $ multipart status201 responses
+
+    (["rpc", proc], "POST") -> do
+      let qi = QualifiedIdentifier schema (cs proc)
+      exists <- doesProcExist schema proc
+      if exists
+        then do
+          let call = B.Stmt "select " V.empty True <>
+                asJson (callProc qi $ fromMaybe M.empty (decode reqBody))
+          body :: Maybe (Identity Text) <- H.maybeEx call
+          return $ responseLBS status200 [jsonH]
+            (cs $ fromMaybe "[]" $ runIdentity <$> body)
+        else return $ responseLBS status404 [] ""
+
+      -- check that proc exists
+      -- check that arg names are all specified
+      -- select * from "1".proc(a := "foo"::undefined) where whereT limit limitT
+
+    ([table], "PUT") ->
+      handleJsonObj reqBody $ \obj -> do
+        let qt = qualify table
+        primaryKeys <- primaryKeyColumns qt
+        let specifiedKeys = map (cs . fst) qq
+        if S.fromList primaryKeys /= S.fromList specifiedKeys
+          then return $ responseLBS status405 []
+               "You must speficy all and only primary keys as params"
+          else do
+            tableCols <- map (cs . colName) <$> columns qt
+            let cols = map cs $ M.keys obj
+            if S.fromList tableCols == S.fromList cols
+              then do
+                let vals = M.elems obj
+                H.unitEx $ iffNotT
+                        (whereT qt qq $ update qt cols vals)
+                        (insertSelect qt cols vals)
+                return $ responseLBS status204 [ jsonH ] ""
+
+              else return $ if Prelude.null tableCols
+                then responseLBS status404 [] ""
+                else responseLBS status400 []
+                   "You must specify all columns in PUT request"
+
+    ([table], "PATCH") ->
+      handleJsonObj reqBody $ \obj -> do
+        let qt = qualify table
+            up = returningStarT
+               . whereT qt qq
+               $ update qt (map cs $ M.keys obj) (M.elems obj)
+            patch = withT up "t" $ B.Stmt
+              "select count(t), array_to_json(array_agg(row_to_json(t)))::character varying"
+              V.empty True
+
+        row <- H.maybeEx patch
+        let (queryTotal, body) =
+              fromMaybe (0 :: Int, Just "" :: Maybe Text) row
+            r = contentRangeH 0 (queryTotal-1) queryTotal
+            echoRequested = lookupHeader "Prefer" == Just "return=representation"
+            s = case () of _ | queryTotal == 0 -> status404
+                             | echoRequested -> status200
+                             | otherwise -> status204
+        return $ responseLBS s [ jsonH, r ] $ if echoRequested then cs $ fromMaybe "[]" body else ""
+
+    ([table], "DELETE") -> do
+      let qt = qualify table
+          del = countT
+            . returningStarT
+            . whereT qt qq
+            $ deleteFrom qt
+      row <- H.maybeEx del
+      let (Identity deletedCount) = fromMaybe (Identity 0 :: Identity Int) row
+      return $ if deletedCount == 0
+         then responseLBS status404 [] ""
+         else responseLBS status204 [("Content-Range", "*/"<> cs (show deletedCount))] ""
+
+    (_, _) ->
+      return $ responseLBS status404 [] ""
+
+  where
+    path          = pathInfo req
+    verb          = requestMethod req
+    qq            = queryString req
+    qualify       = QualifiedIdentifier schema
+    hdrs          = requestHeaders req
+    lookupHeader  = flip lookup hdrs
+    accept        = lookupHeader hAccept
+    schema        = requestedSchema (cs $ configV1Schema conf) accept
+    authenticator = cs $ configDbUser conf
+    jwtSecret     = cs $ configJwtSecret conf
+    range         = rangeRequested hdrs
+    allOrigins    = ("Access-Control-Allow-Origin", "*") :: Header
+    contentType   = fromMaybe "application/json" $ contentTypeForAccept accept
+    contentTypeH  = (hContentType, contentType)
+
+sqlError :: t
+sqlError = undefined
+
+isSqlError :: t
+isSqlError = undefined
+
+rangeStatus :: Int -> Int -> Int -> Status
+rangeStatus from to total
+  | from > total            = status416
+  | (1 + to - from) < total = status206
+  | otherwise               = status200
+
+contentRangeH :: Int -> Int -> Int -> Header
+contentRangeH from to total =
+  ("Content-Range",
+    if total == 0 || from > total
+    then "*/" <> cs (show total)
+    else cs (show from)  <> "-"
+       <> cs (show to)    <> "/"
+       <> cs (show total)
+  )
+
+requestedSchema :: Text -> Maybe BS.ByteString -> Text
+requestedSchema v1schema accept =
+  case verStr of
+       Just [[_, ver]] -> if ver == "1" then v1schema else cs ver
+       _ -> v1schema
+
+  where verRegex = "version[ ]*=[ ]*([0-9]+)" :: BS.ByteString
+        verStr = (=~ verRegex) <$> accept :: Maybe [[BS.ByteString]]
+
+
+jsonMT :: BS.ByteString
+jsonMT = "application/json"
+
+csvMT :: BS.ByteString
+csvMT = "text/csv"
+
+jsonH :: Header
+jsonH = (hContentType, jsonMT)
+
+contentTypeForAccept :: Maybe BS.ByteString -> Maybe BS.ByteString
+contentTypeForAccept accept
+  | isNothing accept || hasJson = Just jsonMT
+  | hasCsv = Just csvMT
+  | otherwise = Nothing
+  where
+    Just acceptH = accept
+    findInAccept = flip find $ parseHttpAccept acceptH
+    hasJson  = isJust $ findInAccept $ BS.isPrefixOf jsonMT
+    hasCsv   = isJust $ findInAccept $ BS.isPrefixOf csvMT
+
+bodyForAccept :: BS.ByteString -> QualifiedIdentifier  -> StatementT
+bodyForAccept contentType table
+  | contentType == csvMT = asCsvWithCount table
+  | otherwise = asJsonWithCount -- defaults to JSON
+
+handleJsonObj :: BL.ByteString -> (Object -> H.Tx P.Postgres s Response)
+              -> H.Tx P.Postgres s Response
+handleJsonObj reqBody handler = do
+  let p = eitherDecode reqBody
+  case p of
+    Left err ->
+      return $ responseLBS status400 [jsonH] jErr
+      where
+        jErr = encode . object $
+          [("message", String $ "Failed to parse JSON payload. " <> cs err)]
+    Right (Object o) -> handler o
+    Right _ ->
+      return $ responseLBS status400 [jsonH] jErr
+      where
+        jErr = encode . object $
+          [("message", String "Expecting a JSON object")]
+
+parseCsvCell :: BL.ByteString -> Value
+parseCsvCell s = if s == "NULL" then Null else String $ cs s
+
+multipart :: Status -> [Response] -> Response
+multipart _ [] = responseLBS status204 [] ""
+multipart _ [r] = r
+multipart s rs =
+  responseLBS s [(hContentType, "multipart/mixed; boundary=\"postgrest_boundary\"")] $
+    BL.intercalate "\n--postgrest_boundary\n" (map renderResponseBody rs)
+
+  where
+    renderHeader :: Header -> BL.ByteString
+    renderHeader (k, v) = cs (original k) <> ": " <> cs v
+
+    renderResponseBody :: Response -> BL.ByteString
+    renderResponseBody (ResponseBuilder _ headers b) =
+      BL.intercalate "\n" (map renderHeader headers)
+        <> "\n\n" <> BB.toLazyByteString b
+    renderResponseBody _ = error
+      "Unable to create multipart response from non-ResponseBuilder"
+
+data TableOptions = TableOptions {
+  tblOptcolumns :: [Column]
+, tblOptpkey :: [Text]
+}
+
+instance ToJSON TableOptions where
+  toJSON t = object [
+      "columns" .= tblOptcolumns t
+    , "pkey"   .= tblOptpkey t ]

src/PostgREST/Auth.hs

@@ -0,0 +1,101 @@
+{-# LANGUAGE QuasiQuotes, ScopedTypeVariables, OverloadedStrings #-}
+module PostgREST.Auth where
+
+import Data.Aeson
+import Control.Monad (mzero)
+import Control.Applicative
+import Crypto.BCrypt
+import Data.Text
+import Data.Monoid
+import Data.Map
+import qualified Data.Vector as V
+import qualified Hasql as H
+import qualified Hasql.Backend as B
+import qualified Hasql.Postgres as P
+import qualified Web.JWT as JWT
+import Data.String.Conversions (cs)
+import PostgREST.PgQuery (pgFmtLit)
+
+import Prelude
+
+import System.IO.Unsafe
+
+data AuthUser = AuthUser {
+    userId :: String
+  , userPass :: String
+  , userRole :: String
+  } deriving (Show)
+
+instance FromJSON AuthUser where
+  parseJSON (Object v) = AuthUser <$>
+                         v .: "id" <*>
+                         v .: "pass" <*>
+                         v .:? "role" .!= ""
+  parseJSON _ = mzero
+
+instance ToJSON AuthUser where
+  toJSON u = object [
+      "id" .= userId u
+    , "pass" .= userPass u
+    , "role" .= userRole u ]
+
+type DbRole = Text
+type UserId = Text
+
+data LoginAttempt =
+    NoCredentials
+  | MalformedAuth
+  | LoginFailed
+  | LoginSuccess DbRole UserId
+  deriving (Eq, Show)
+
+checkPass :: Text -> Text -> Bool
+checkPass = (. cs) . validatePassword . cs
+
+setRole :: Text -> H.Tx P.Postgres s ()
+setRole role = H.unitEx $ B.Stmt ("set local role " <> cs (pgFmtLit role)) V.empty True
+
+setUserId :: Text -> H.Tx P.Postgres s ()
+setUserId uid = if uid /= "" then
+  H.unitEx $ B.Stmt ("set local user_vars.user_id = " <> cs (pgFmtLit uid)) V.empty True
+else
+  resetUserId
+
+resetUserId :: H.Tx P.Postgres s ()
+resetUserId = H.unitEx [H.stmt|reset user_vars.user_id|]
+
+addUser :: Text -> Text -> Text -> H.Tx P.Postgres s ()
+addUser identity pass role = do
+  let Just hashed = unsafePerformIO $ hashPasswordUsingPolicy fastBcryptHashingPolicy (cs pass)
+  H.unitEx $
+    [H.stmt|insert into postgrest.auth (id, pass, rolname) values (?, ?, ?)|]
+      identity (cs hashed :: Text) role
+
+signInRole :: Text -> Text -> H.Tx P.Postgres s LoginAttempt
+signInRole user pass = do
+  u <- H.maybeEx $ [H.stmt|select id, pass, rolname from postgrest.auth where id = ?|] user
+  return $ maybe LoginFailed (\r ->
+      let (uid, hashed, role) = r in
+      if checkPass hashed pass
+         then LoginSuccess role uid
+         else LoginFailed
+    ) u
+
+signInWithJWT :: Text -> Text -> LoginAttempt
+signInWithJWT secret input = case maybeRole of
+    Just (Just (String role)) -> case maybeUserId of
+      Just (Just (String uid)) -> LoginSuccess (cs role) (cs uid)
+      _   -> LoginFailed
+    _   -> LoginFailed
+  where
+    maybeRole = (Data.Map.lookup "role" <$> claims) ::Maybe (Maybe Value)
+    maybeUserId = (Data.Map.lookup "id" <$> claims) ::Maybe (Maybe Value)
+    claims = JWT.unregisteredClaims <$> JWT.claims <$> decoded
+    decoded = JWT.decodeAndVerifySignature (JWT.secret secret) input
+
+tokenJWT :: Text -> Text -> Text -> Text
+tokenJWT secret uid role = JWT.encodeSigned JWT.HS256 (JWT.secret secret) claimsSet
+  where
+    claimsSet = JWT.def {
+      JWT.unregisteredClaims = Data.Map.fromList [("id", String uid), ("role", String role)]
+    }

src/PostgREST/Config.hs

@@ -0,0 +1,64 @@
+module PostgREST.Config where
+
+import Network.Wai
+import Control.Applicative
+import Data.Text (strip)
+import qualified Data.CaseInsensitive as CI
+import qualified Data.ByteString.Char8 as BS
+import Data.String.Conversions (cs)
+import Options.Applicative hiding (columns)
+import Network.Wai.Middleware.Cors (CorsResourcePolicy(..))
+import Prelude
+
+data AppConfig = AppConfig {
+    configDbName :: String
+  , configDbPort :: Int
+  , configDbUser :: String
+  , configDbPass :: String
+  , configDbHost :: String
+
+  , configPort  :: Int
+  , configAnonRole :: String
+  , configSecure :: Bool
+  , configPool :: Int
+  , configV1Schema :: String
+  
+  , configJwtSecret :: String
+  }
+
+argParser :: Parser AppConfig
+argParser = AppConfig
+  <$> strOption (long "db-name" <> short 'd' <> metavar "NAME" <> help "name of database")
+  <*> option auto (long "db-port" <> short 'P' <> metavar "PORT" <> value 5432 <> help "postgres server port" <> showDefault)
+  <*> strOption (long "db-user" <> short 'U' <> metavar "ROLE" <> help "postgres authenticator role")
+  <*> strOption (long "db-pass" <> metavar "PASS" <> value "" <> help "password for authenticator role")
+  <*> strOption (long "db-host" <> metavar "HOST" <> value "localhost" <> help "postgres server hostname" <> showDefault)
+
+  <*> option auto (long "port" <> short 'p' <> metavar "PORT" <> value 3000 <> help "port number on which to run HTTP server" <> showDefault)
+  <*> strOption (long "anonymous" <> short 'a' <> metavar "ROLE" <> help "postgres role to use for non-authenticated requests")
+  <*> switch (long "secure" <> short 's' <> help "Redirect all requests to HTTPS")
+  <*> option auto (long "db-pool" <> metavar "COUNT" <> value 10 <> help "Max connections in database pool" <> showDefault)
+  <*> strOption (long "v1schema" <> metavar "NAME" <> value "1" <> help "Schema to use for nonspecified version (or explicit v1)" <> showDefault)
+  <*> strOption (long "jwt-secret" <> metavar "SECRET" <> value "secret" <> help "Secret used to encrypt and decrypt JWT tokens)" <> showDefault)
+
+defaultCorsPolicy :: CorsResourcePolicy
+defaultCorsPolicy =  CorsResourcePolicy Nothing
+  ["GET", "POST", "PUT", "PATCH", "DELETE", "OPTIONS"] ["Authorization"] Nothing
+  (Just $ 60*60*24) False False True
+
+corsPolicy :: Request -> Maybe CorsResourcePolicy
+corsPolicy req = case lookup "origin" headers of
+  Just origin -> Just defaultCorsPolicy {
+      corsOrigins = Just ([origin], True)
+    , corsRequestHeaders = "Authentication":accHeaders
+    , corsExposedHeaders = Just [
+          "Content-Encoding", "Content-Location", "Content-Range", "Content-Type"
+        , "Date", "Location", "Server", "Transfer-Encoding", "Range-Unit"
+        ]
+    }
+  Nothing -> Nothing
+  where
+    headers = requestHeaders req
+    accHeaders = case lookup "access-control-request-headers" headers of
+      Just hdrs -> map (CI.mk . cs . strip . cs) $ BS.split ',' hdrs
+      Nothing -> []

src/PostgREST/Error.hs

@@ -0,0 +1,71 @@
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+{-# LANGUAGE FlexibleInstances, TypeSynonymInstances #-}
+
+module PostgREST.Error (PgError, errResponse) where
+
+import qualified Hasql as H
+import qualified Hasql.Postgres as P
+import qualified Network.HTTP.Types.Status as HT
+import qualified Data.Aeson as JSON
+import qualified Data.Text as T
+import Data.Aeson ((.=))
+import Data.String.Conversions (cs)
+import Data.String.Utils(replace)
+import Network.Wai(Response, responseLBS)
+import Network.HTTP.Types.Header
+
+type PgError = H.SessionError P.Postgres
+
+errResponse :: PgError -> Response
+errResponse e = responseLBS (httpStatus e)
+  [(hContentType, "application/json")] (JSON.encode e)
+
+instance JSON.ToJSON PgError where
+  toJSON (H.TxError (P.ErroneousResult c m d h)) = JSON.object [
+    "code" .= (cs c::T.Text),
+    "message" .= (cs m::T.Text),
+    "details" .= (fmap cs d::Maybe T.Text),
+    "hint" .= (fmap cs h::Maybe T.Text)]
+  toJSON (H.TxError (P.NoResult d)) = JSON.object [
+    "message" .= ("No response from server"::T.Text),
+    "details" .= (fmap cs d::Maybe T.Text)]
+  toJSON (H.TxError (P.UnexpectedResult m)) = JSON.object ["message" .= m]
+  toJSON (H.TxError P.NotInTransaction) = JSON.object [
+    "message" .= ("Not in transaction"::T.Text)]
+  toJSON (H.CxError (P.CantConnect d)) = JSON.object [
+    "message" .= ("Can't connect to the database"::T.Text),
+    "details" .= (fmap cs d::Maybe T.Text)]
+  toJSON (H.CxError (P.UnsupportedVersion v)) = JSON.object [
+    "message" .= ("Postgres version "++version++" is not supported") ]
+      where version = replace "0" "." (show v)
+  toJSON (H.ResultError m) = JSON.object ["message" .= m]
+
+httpStatus :: PgError -> HT.Status
+httpStatus (H.TxError (P.ErroneousResult codeBS _ _ _)) =
+  let code = cs codeBS in
+  case code of
+    '0':'8':_ -> HT.status503 -- pg connection err
+    '0':'9':_ -> HT.status500 -- triggered action exception
+    '0':'L':_ -> HT.status403 -- invalid grantor
+    '0':'P':_ -> HT.status403 -- invalid role specification
+    '2':'5':_ -> HT.status500 -- invalid tx state
+    '2':'8':_ -> HT.status403 -- invalid auth specification
+    '2':'D':_ -> HT.status500 -- invalid tx termination
+    '3':'8':_ -> HT.status500 -- external routine exception
+    '3':'9':_ -> HT.status500 -- external routine invocation
+    '3':'B':_ -> HT.status500 -- savepoint exception
+    '4':'0':_ -> HT.status500 -- tx rollback
+    '5':'3':_ -> HT.status503 -- insufficient resources
+    '5':'4':_ -> HT.status413 -- too complex
+    '5':'5':_ -> HT.status500 -- obj not on prereq state
+    '5':'7':_ -> HT.status500 -- operator intervention
+    '5':'8':_ -> HT.status500 -- system error
+    'F':'0':_ -> HT.status500 -- conf file error
+    'H':'V':_ -> HT.status500 -- foreign data wrapper error
+    'P':'0':_ -> HT.status500 -- PL/pgSQL Error
+    'X':'X':_ -> HT.status500 -- internal Error
+    "42P01" -> HT.status404 -- undefined table
+    "42501" -> HT.status404 -- insufficient privilege
+    _ -> HT.status400
+httpStatus (H.TxError (P.NoResult _)) = HT.status503
+httpStatus _ = HT.status500

src/PostgREST/Main.hs

@@ -0,0 +1,81 @@
+{-# LANGUAGE QuasiQuotes, ScopedTypeVariables #-}
+module Main where
+
+import Paths_postgrest (version)
+
+import PostgREST.App
+import PostgREST.Middleware
+import PostgREST.Error(errResponse)
+
+import Control.Monad (unless)
+import Control.Monad.IO.Class (liftIO)
+import Data.String.Conversions (cs)
+import Network.Wai (strictRequestBody)
+import Network.Wai.Handler.Warp hiding (Connection)
+import Network.Wai.Middleware.RequestLogger (logStdout)
+import Data.List (intercalate)
+import Data.Version (versionBranch)
+import Data.Functor.Identity
+import Data.Text(Text)
+import qualified Hasql as H
+import qualified Hasql.Postgres as P
+import Options.Applicative hiding (columns)
+
+import System.IO (stderr, stdin, stdout, hSetBuffering, BufferMode(..))
+
+import PostgREST.Config (AppConfig(..), argParser)
+
+isServerVersionSupported = do
+  Identity (row :: Text) <- H.tx Nothing $ H.singleEx $ [H.stmt|SHOW server_version_num|]
+  return $ read (cs row) >= 90200
+
+main :: IO ()
+main = do
+  hSetBuffering stdout LineBuffering
+  hSetBuffering stdin  LineBuffering
+  hSetBuffering stderr NoBuffering
+
+  let opts = info (helper <*> argParser) $
+                fullDesc
+                <> progDesc (
+                    "PostgREST "
+                    <> prettyVersion
+                    <> " / create a REST API to an existing Postgres database"
+                )
+      parserPrefs = prefs showHelpOnError
+  conf <- customExecParser parserPrefs opts
+  let port = configPort conf
+
+  unless (configSecure conf) $
+    putStrLn "WARNING, running in insecure mode, auth will be in plaintext"
+  unless ("secret" /= configJwtSecret conf) $
+    putStrLn "WARNING, running in insecure mode, JWT secret is the default value"
+  Prelude.putStrLn $ "Listening on port " ++
+    (show $ configPort conf :: String)
+
+  let pgSettings = P.ParamSettings (cs $ configDbHost conf)
+                     (fromIntegral $ configDbPort conf)
+                     (cs $ configDbUser conf)
+                     (cs $ configDbPass conf)
+                     (cs $ configDbName conf)
+      appSettings = setPort port
+                  . setServerName (cs $ "postgrest/" <> prettyVersion)
+                  $ defaultSettings
+      middle = logStdout . defaultMiddle (configSecure conf)
+
+  poolSettings <- maybe (fail "Improper session settings") return $
+                H.poolSettings (fromIntegral $ configPool conf) 30
+  pool :: H.Pool P.Postgres
+          <- H.acquirePool pgSettings poolSettings
+
+  resOrError <- H.session pool isServerVersionSupported
+  either (fail . show) (\supported -> unless supported $ fail "Cannot run in this PostgreSQL version, PostgREST needs at least 9.2.0") resOrError
+
+  runSettings appSettings $ middle $ \req respond -> do
+    body <- strictRequestBody req
+    resOrError <- liftIO $ H.session pool $ H.tx (Just (H.ReadCommitted, Just True)) $
+      authenticated conf (app conf body) req
+    either (respond . errResponse) respond resOrError
+
+  where
+    prettyVersion = intercalate "." $ map show $ versionBranch version

src/PostgREST/Middleware.hs

@@ -1,54 +1,52 @@
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 
-module Middleware where
+module PostgREST.Middleware where
 
-import Data.Maybe (fromMaybe)
-import Data.Monoid (mconcat)
+import Data.Maybe (fromMaybe, isNothing)
+import Data.Monoid
 import Data.Text
 -- import Data.Pool(withResource, Pool)
 
 import qualified Hasql as H
-import qualified Hasql.Postgres as H
+import qualified Hasql.Postgres as P
 import Data.String.Conversions(cs)
 
-import Network.HTTP.Types.Header (hLocation, hAuthorization)
+import Network.HTTP.Types.Header (hLocation, hAuthorization, hAccept)
 import Network.HTTP.Types (RequestHeaders)
-import Network.HTTP.Types.Status (status400, status401, status301)
+import Network.HTTP.Types.Status (status400, status401, status301, status415)
 import Network.Wai (Application, requestHeaders, responseLBS, rawPathInfo,
                    rawQueryString, isSecure, Request(..), Response)
+import Network.Wai.Middleware.Gzip (gzip, def)
+import Network.Wai.Middleware.Cors (cors)
+import Network.Wai.Middleware.Static (staticPolicy, only)
 import Network.URI (URI(..), parseURI)
 
-import Auth (LoginAttempt(..), signInRole, setRole, resetRole)
+import PostgREST.Config (AppConfig(..), corsPolicy)
+import PostgREST.Auth (LoginAttempt(..), signInRole, signInWithJWT, setRole, setUserId)
+import PostgREST.App (contentTypeForAccept)
 import Codec.Binary.Base64.String (decode)
 
--- data Environment = Test | Production deriving (Eq)
+import Prelude
 
--- safeAction :: Request -> Bool
--- safeAction = (`notElem` ["PATCH", "PUT"]) . requestMethod
-
--- withSavepoint :: Environment -> (Connection -> Application) ->
---                  Connection -> Application
--- withSavepoint env app conn req respond =
---   if env == Production && safeAction req
---     then go
---     else Database.PostgreSQL.Simple.withSavepoint conn go
---   where go = app conn req respond
-
-authenticated :: forall s. Text -> (Request -> H.Tx H.Postgres s Response) ->
-       Request -> H.Tx H.Postgres s Response
-authenticated anon app req = do
+authenticated :: forall s. AppConfig ->
+                 (Request -> H.Tx P.Postgres s Response) ->
+                 Request -> H.Tx P.Postgres s Response
+authenticated conf app req = do
   attempt <- httpRequesterRole (requestHeaders req)
   case attempt of
     MalformedAuth ->
       return $ responseLBS status400 [] "Malformed basic auth header"
     LoginFailed ->
       return $ responseLBS status401 [] "Invalid username or password"
-    LoginSuccess role -> runInRole role
-    NoCredentials -> runInRole anon
+    LoginSuccess role uid -> if role /= currentRole then runInRole role uid else app req
+    NoCredentials         -> if anon /= currentRole then runInRole anon "" else app req
 
  where
-   httpRequesterRole :: RequestHeaders -> H.Tx H.Postgres s LoginAttempt
+   jwtSecret = cs $ configJwtSecret conf
+   currentRole = cs $ configDbUser conf
+   anon = cs $ configAnonRole conf
+   httpRequesterRole :: RequestHeaders -> H.Tx P.Postgres s LoginAttempt
    httpRequesterRole hdrs = do
     let auth = fromMaybe "" $ lookup hAuthorization hdrs
     case split (==' ') (cs auth) of
@@ -56,14 +54,15 @@ authenticated anon app req = do
         case split (==':') (cs . decode . cs $ b64) of
           (u:p:_) -> signInRole u p
           _ -> return MalformedAuth
+      ("Bearer" : jwt : _) ->
+        return $ signInWithJWT jwtSecret jwt
       _ -> return NoCredentials
 
-   runInRole :: Text -> H.Tx H.Postgres s Response
-   runInRole r = do
+   runInRole :: Text -> Text -> H.Tx P.Postgres s Response
+   runInRole r uid = do
+     setUserId uid
      setRole r
-     res <- app req
-     resetRole
-     return res
+     app req
 
 
 redirectInsecure :: Application -> Application
@@ -86,3 +85,17 @@ redirectInsecure app req respond = do
               Nothing ->
                 respond $ responseLBS status400 [] "SSL is required"
     else app req respond
+
+unsupportedAccept :: Application -> Application
+unsupportedAccept app req respond = do
+  let
+    accept = lookup hAccept $ requestHeaders req
+  if isNothing $ contentTypeForAccept accept
+  then respond $ responseLBS status415 [] "Unsupported Accept header, try: application/json"
+  else app req respond
+
+defaultMiddle :: Bool -> Application -> Application
+defaultMiddle secure = (if secure then redirectInsecure else id)
+        . gzip def . cors corsPolicy
+        . staticPolicy (only [("favicon.ico", "static/favicon.ico")])
+        . unsupportedAccept

src/PostgREST/PgQuery.hs

@@ -0,0 +1,322 @@
+{-# LANGUAGE TypeSynonymInstances, FlexibleInstances, MultiWayIf #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+
+module PostgREST.PgQuery where
+
+import PostgREST.RangeQuery
+
+import qualified Hasql as H
+import qualified Hasql.Postgres as P
+import qualified Hasql.Backend as B
+
+import qualified Data.Text as T
+import qualified Data.HashMap.Strict as H
+import Text.Regex.TDFA ( (=~) )
+import qualified Network.HTTP.Types.URI as Net
+import qualified Data.ByteString.Char8 as BS
+import Data.Monoid
+import Data.Vector (empty)
+import Data.Maybe (fromMaybe, mapMaybe)
+import Data.Functor
+import Control.Monad (join)
+import Data.String.Conversions (cs)
+import qualified Data.Aeson as JSON
+import qualified Data.List as L
+import qualified Data.Vector as V
+import Data.Scientific (isInteger, formatScientific, FPFormat(..))
+
+import Prelude
+
+type PStmt = H.Stmt P.Postgres
+instance Monoid PStmt where
+  mappend (B.Stmt query params prep) (B.Stmt query' params' prep') =
+    B.Stmt (query <> query') (params <> params') (prep && prep')
+  mempty = B.Stmt "" empty True
+type StatementT = PStmt -> PStmt
+
+data QualifiedIdentifier = QualifiedIdentifier {
+  qiSchema :: T.Text
+, qiName   :: T.Text
+} deriving (Show)
+
+data OrderTerm = OrderTerm {
+  otTerm :: T.Text
+, otDirection :: BS.ByteString
+, otNullOrder :: Maybe BS.ByteString
+}
+
+limitT :: Maybe NonnegRange -> StatementT
+limitT r q =
+  q <> B.Stmt (" LIMIT " <> limit <> " OFFSET " <> offset <> " ") empty True
+  where
+    limit  = maybe "ALL" (cs . show) $ join $ rangeLimit <$> r
+    offset = cs . show $ fromMaybe 0 $ rangeOffset <$> r
+
+whereT :: QualifiedIdentifier -> Net.Query -> StatementT
+whereT table params q =
+ if L.null cols
+   then q
+   else q <> B.Stmt " where " empty True <> conjunction
+ where
+   cols = [ col | col <- params, fst col `notElem` ["order"] ]
+   wherePredTable = wherePred table
+   conjunction = mconcat $ L.intersperse andq (map wherePredTable cols)
+
+withT :: PStmt -> T.Text -> StatementT
+withT (B.Stmt eq ep epre) v (B.Stmt wq wp wpre) =
+  B.Stmt ("WITH " <> v <> " AS (" <> eq <> ") " <> wq <> " from " <> v)
+    (ep <> wp)
+    (epre && wpre)
+
+orderT :: [OrderTerm] -> StatementT
+orderT ts q =
+  if L.null ts
+    then q
+    else q <> B.Stmt " order by " empty True <> clause
+  where
+   clause = mconcat $ L.intersperse commaq (map queryTerm ts)
+   queryTerm :: OrderTerm -> PStmt
+   queryTerm t = B.Stmt
+                   (" " <> cs (pgFmtIdent $ otTerm t) <> " "
+                        <> cs (otDirection t)         <> " "
+                        <> maybe "" cs (otNullOrder t) <> " ")
+                   empty True
+
+parentheticT :: StatementT
+parentheticT s =
+  s { B.stmtTemplate = " (" <> B.stmtTemplate s <> ") " }
+
+iffNotT :: PStmt -> StatementT
+iffNotT (B.Stmt aq ap apre) (B.Stmt bq bp bpre) =
+  B.Stmt
+    ("WITH aaa AS (" <> aq <> " returning *) " <>
+      bq <> " WHERE NOT EXISTS (SELECT * FROM aaa)")
+    (ap <> bp)
+    (apre && bpre)
+
+countT :: StatementT
+countT s =
+  s { B.stmtTemplate = "WITH qqq AS (" <> B.stmtTemplate s <> ") SELECT pg_catalog.count(1) FROM qqq" }
+
+countRows :: QualifiedIdentifier  -> PStmt
+countRows t = B.Stmt ("select pg_catalog.count(1) from " <> fromQi t) empty True
+
+asCsvWithCount :: QualifiedIdentifier -> StatementT
+asCsvWithCount table = withCount . asCsv table
+
+asCsv :: QualifiedIdentifier -> StatementT
+asCsv table s = s { B.stmtTemplate =
+    "(select string_agg(quote_ident(column_name::text), ',') from "
+    <> "(select column_name from information_schema.columns where quote_ident(table_schema) || '.' || table_name = '"
+    <> fromQi table <> "' order by ordinal_position) h) || '\r' || "
+    <> "coalesce(string_agg(substring(t::text, 2, length(t::text) - 2), '\r'), '') from ("
+    <> B.stmtTemplate s <> ") t" }
+
+asJsonWithCount :: StatementT
+asJsonWithCount = withCount . asJson
+
+asJson :: StatementT
+asJson s = s { B.stmtTemplate =
+    "array_to_json(array_agg(row_to_json(t)))::character varying from ("
+    <> B.stmtTemplate s <> ") t" }
+
+withCount :: StatementT
+withCount s = s { B.stmtTemplate = "pg_catalog.count(t), " <> B.stmtTemplate s }
+
+asJsonRow :: StatementT
+asJsonRow s = s { B.stmtTemplate = "row_to_json(t) from (" <> B.stmtTemplate s <> ") t" }
+
+selectStar :: QualifiedIdentifier -> PStmt
+selectStar t = B.Stmt ("select * from " <> fromQi t) empty True
+
+returningStarT :: StatementT
+returningStarT s = s { B.stmtTemplate = B.stmtTemplate s <> " RETURNING *" }
+
+deleteFrom :: QualifiedIdentifier -> PStmt
+deleteFrom t = B.Stmt ("delete from " <> fromQi t) empty True
+
+insertInto :: QualifiedIdentifier
+              -> V.Vector T.Text
+              -> V.Vector (V.Vector JSON.Value)
+              -> PStmt
+insertInto t cols vals
+  | V.null cols = B.Stmt ("insert into " <> fromQi t <> " default values returning *") empty True
+  | otherwise   = B.Stmt
+    ("insert into " <> fromQi t <> " (" <>
+      T.intercalate ", " (V.toList $ V.map pgFmtIdent cols) <>
+      ") values "
+      <> T.intercalate ", "
+        (V.toList $ V.map (\v -> "("
+            <> T.intercalate ", " (V.toList $ V.map insertableValue v)
+            <> ")"
+          ) vals
+        )
+      <> " returning row_to_json(" <> fromQi t <> ".*)")
+    empty True
+
+insertSelect :: QualifiedIdentifier -> [T.Text] -> [JSON.Value] -> PStmt
+insertSelect t [] _ = B.Stmt
+  ("insert into " <> fromQi t <> " default values returning *") empty True
+insertSelect t cols vals = B.Stmt
+  ("insert into " <> fromQi t <> " ("
+    <> T.intercalate ", " (map pgFmtIdent cols)
+    <> ") select "
+    <> T.intercalate ", " (map insertableValue vals))
+  empty True
+
+update :: QualifiedIdentifier -> [T.Text] -> [JSON.Value] -> PStmt
+update t cols vals = B.Stmt
+  ("update " <> fromQi t <> " set ("
+    <> T.intercalate ", " (map pgFmtIdent cols)
+    <> ") = ("
+    <> T.intercalate ", " (map insertableValue vals)
+    <> ")")
+  empty True
+
+callProc :: QualifiedIdentifier -> JSON.Object -> PStmt
+callProc qi params = do
+  let args = T.intercalate "," $ map assignment (H.toList params)
+  B.Stmt ("select * from " <> fromQi qi <> "(" <> args <> ")") empty True
+  where
+    assignment (n,v) = pgFmtIdent n <> ":=" <> insertableValue v
+
+wherePred :: QualifiedIdentifier -> Net.QueryItem -> PStmt
+wherePred table (col, predicate) =
+  B.Stmt (notOp <> " " <> pgFmtJsonbPath table (cs col) <> " " <> op <> " " <>
+      if opCode `elem` ["is","isnot"] then whiteList value
+                                 else cs sqlValue)
+      empty True
+
+  where
+    headPredicate:rest = T.split (=='.') $ cs $ fromMaybe "." predicate
+    hasNot caseTrue caseFalse =  if headPredicate == "not" then caseTrue else caseFalse
+    opCode = hasNot (head rest) headPredicate
+    notOp  = hasNot headPredicate ""
+    value  = hasNot (T.intercalate "." $ tail rest) (T.intercalate "." rest)
+    whiteList val = fromMaybe (cs (pgFmtLit val) <> "::unknown ")
+                              (L.find ((==) . T.toLower $ val)
+                                      ["null","true","false"])
+    star c = if c == '*' then '%' else c
+    unknownLiteral = (<> "::unknown ") . pgFmtLit
+
+    sqlValue = case opCode of
+            "like" -> unknownLiteral $ T.map star value
+            "ilike" -> unknownLiteral $ T.map star value
+            "in" -> "(" <> T.intercalate ", " (map unknownLiteral $ T.split (==',') value) <> ") "
+            "notin" -> "(" <> T.intercalate ", " (map unknownLiteral $ T.split (==',') value) <> ") "
+            "@@" -> "to_tsquery(" <> unknownLiteral value <> ") "
+            _    -> unknownLiteral value
+
+    op = case opCode of
+         "eq"  -> "="
+         "gt"  -> ">"
+         "lt"  -> "<"
+         "gte" -> ">="
+         "lte" -> "<="
+         "neq" -> "<>"
+         "like"-> "like"
+         "ilike"-> "ilike"
+         "in"  -> "in"
+         "notin" -> "not in"
+         "is"    -> "is"
+         "isnot" -> "is not"
+         "@@" -> "@@"
+         _     -> "="
+
+orderParse :: Net.Query -> [OrderTerm]
+orderParse q =
+  mapMaybe orderParseTerm . T.split (==',') $ cs order
+  where
+    order = fromMaybe "" $ join (lookup "order" q)
+
+orderParseTerm :: T.Text -> Maybe OrderTerm
+orderParseTerm s =
+  case T.split (=='.') s of
+       (c:d:nls) ->
+         if d `elem` ["asc", "desc"]
+            then Just $ OrderTerm c
+              ( if d == "asc" then "asc" else "desc" )
+              ( case nls of
+                  [n] -> if | n == "nullsfirst" -> Just "nulls first"
+                            | n == "nullslast"  -> Just "nulls last"
+                            | otherwise -> Nothing
+                  _   -> Nothing
+              )
+            else Nothing
+       _ -> Nothing
+
+commaq :: PStmt
+commaq  = B.Stmt ", " empty True
+
+andq :: PStmt
+andq = B.Stmt " and " empty True
+
+data JsonbPath =
+    ColIdentifier T.Text
+  | KeyIdentifier T.Text
+  | SingleArrow JsonbPath JsonbPath
+  | DoubleArrow JsonbPath JsonbPath
+  deriving (Show)
+
+parseJsonbPath :: T.Text -> Maybe JsonbPath
+parseJsonbPath p =
+  case T.splitOn "->>" p of
+    [a,b] ->
+      let i:is = T.splitOn "->" a in
+      Just $ DoubleArrow
+        (foldl SingleArrow (ColIdentifier i) (map KeyIdentifier is))
+        (KeyIdentifier b)
+    _ -> Nothing
+
+pgFmtJsonbPath :: QualifiedIdentifier -> T.Text -> T.Text
+pgFmtJsonbPath table p =
+  pgFmtJsonbPath' $ fromMaybe (ColIdentifier p) (parseJsonbPath p)
+  where
+    pgFmtJsonbPath' (ColIdentifier i) = fromQi table <> "." <> pgFmtIdent i
+    pgFmtJsonbPath' (KeyIdentifier i) = pgFmtLit i
+    pgFmtJsonbPath' (SingleArrow a b) =
+      pgFmtJsonbPath' a <> "->" <> pgFmtJsonbPath' b
+    pgFmtJsonbPath' (DoubleArrow a b) =
+      pgFmtJsonbPath' a <> "->>" <> pgFmtJsonbPath' b
+
+pgFmtIdent :: T.Text -> T.Text
+pgFmtIdent x =
+  let escaped = T.replace "\"" "\"\"" (trimNullChars $ cs x) in
+  if (cs escaped :: BS.ByteString) =~ danger
+    then "\"" <> escaped <> "\""
+    else escaped
+
+  where danger = "^$|^[^a-z_]|[^a-z_0-9]" :: BS.ByteString
+
+pgFmtLit :: T.Text -> T.Text
+pgFmtLit x =
+  let trimmed = trimNullChars x
+      escaped = "'" <> T.replace "'" "''" trimmed <> "'"
+      slashed = T.replace "\\" "\\\\" escaped in
+  if T.isInfixOf "\\\\" escaped
+    then "E" <> slashed
+    else slashed
+
+trimNullChars :: T.Text -> T.Text
+trimNullChars = T.takeWhile (/= '\x0')
+
+fromQi :: QualifiedIdentifier -> T.Text
+fromQi t = pgFmtIdent (qiSchema t) <> "." <> pgFmtIdent (qiName t)
+
+unquoted :: JSON.Value -> T.Text
+unquoted (JSON.String t) = t
+unquoted (JSON.Number n) =
+  cs $ formatScientific Fixed (if isInteger n then Just 0 else Nothing) n
+unquoted (JSON.Bool b) = cs . show $ b
+unquoted v = cs $ JSON.encode v
+
+insertableText :: T.Text -> T.Text
+insertableText = (<> "::unknown") . pgFmtLit
+
+insertableValue :: JSON.Value -> T.Text
+insertableValue JSON.Null = "null"
+insertableValue v = insertableText $ unquoted v
+
+paramFilter :: JSON.Value -> T.Text
+paramFilter JSON.Null = "is.null"
+paramFilter v = "eq." <> unquoted v

src/PostgREST/PgStructure.hs

@@ -0,0 +1,198 @@
+{-# LANGUAGE QuasiQuotes, OverloadedStrings, TypeSynonymInstances,
+             MultiParamTypeClasses, ScopedTypeVariables,
+             FlexibleContexts #-}
+module PostgREST.PgStructure where
+
+import PostgREST.PgQuery (QualifiedIdentifier(..))
+import Data.Text hiding (foldl, map, zipWith, concat)
+import Data.Aeson
+import Data.Functor.Identity
+import Data.String.Conversions (cs)
+import Data.Maybe (fromMaybe, isJust)
+import Control.Applicative
+
+import qualified Data.Map as Map
+
+import qualified Hasql as H
+import qualified Hasql.Postgres as P
+
+import Prelude
+
+foreignKeys :: QualifiedIdentifier -> H.Tx P.Postgres s (Map.Map Text ForeignKey)
+foreignKeys table = do
+  r <- H.listEx $ [H.stmt|
+      select kcu.column_name, ccu.table_name AS foreign_table_name,
+        ccu.column_name AS foreign_column_name
+      from information_schema.table_constraints AS tc
+        join information_schema.key_column_usage AS kcu
+          on tc.constraint_name = kcu.constraint_name
+        join information_schema.constraint_column_usage AS ccu
+          on ccu.constraint_name = tc.constraint_name
+      where constraint_type = 'FOREIGN KEY'
+        and tc.table_name=? and tc.table_schema = ?
+        order by kcu.column_name
+    |] (qiName table) (qiSchema table)
+
+  return $ foldl addKey Map.empty r
+  where
+    addKey :: Map.Map Text ForeignKey -> (Text, Text, Text) -> Map.Map Text ForeignKey
+    addKey m (col, ftab, fcol) = Map.insert col (ForeignKey ftab fcol) m
+
+
+tables :: Text -> H.Tx P.Postgres s [Table]
+tables schema = do
+  rows <- H.listEx $
+    [H.stmt|
+      select 
+        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 = ?
+            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
+    |] schema
+  return $ map tableFromRow rows
+
+
+columns :: QualifiedIdentifier -> H.Tx P.Postgres s [Column]
+columns table = do
+  cols <- H.listEx $ [H.stmt|
+      select info.table_schema as schema, info.table_name as table_name,
+             info.column_name as name, info.ordinal_position as position,
+             info.is_nullable::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 (
+           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 |]
+    (qiSchema table) (qiName table)
+
+  fks <- foreignKeys table
+  return $ map (addFK fks . columnFromRow) cols
+
+  where
+    addFK fks col = col { colFK = Map.lookup (cs . colName $ col) fks }
+
+
+primaryKeyColumns :: QualifiedIdentifier -> H.Tx P.Postgres s [Text]
+primaryKeyColumns table = do
+  r <- H.listEx $ [H.stmt|
+    select kc.column_name
+      from
+        information_schema.table_constraints tc,
+        information_schema.key_column_usage kc
+    where
+      tc.constraint_type = 'PRIMARY KEY'
+      and kc.table_name = tc.table_name and kc.table_schema = tc.table_schema
+      and kc.constraint_name = tc.constraint_name
+      and kc.table_schema = ?
+      and kc.table_name  = ? |] (qiSchema table) (qiName table)
+  return $ map runIdentity r
+
+doesProcExist :: Text -> Text -> H.Tx P.Postgres s Bool
+doesProcExist schema proc = do
+  row :: Maybe (Identity Int) <- H.maybeEx $ [H.stmt|
+      SELECT 1
+      FROM   pg_catalog.pg_namespace n
+      JOIN   pg_catalog.pg_proc p
+      ON     pronamespace = n.oid
+      WHERE  nspname = ?
+      AND    proname = ?
+    |] schema proc
+  return $ isJust row
+
+data Table = Table {
+  tableSchema :: Text
+, tableName :: Text
+, tableInsertable :: Bool
+} deriving (Show)
+
+data ForeignKey = ForeignKey {
+  fkTable::Text, fkCol::Text
+} deriving (Eq, Show)
+
+data Column = Column {
+  colSchema :: Text
+, colTable :: Text
+, colName :: Text
+, colPosition :: Int
+, colNullable :: Bool
+, colType :: Text
+, colUpdatable :: Bool
+, colMaxLen :: Maybe Int
+, colPrecision :: Maybe Int
+, colDefault :: Maybe Text
+, colEnum :: [Text]
+, colFK :: Maybe ForeignKey
+} deriving (Show)
+
+tableFromRow :: (Text, Text, Bool) -> Table
+tableFromRow (s, n, i) = Table s n i
+
+columnFromRow :: (Text,       Text,      Text,
+                  Int,        Bool,      Text,
+                  Bool,       Maybe Int, Maybe Int,
+                  Maybe Text, Maybe Text)
+              -> Column
+columnFromRow (s, t, n, pos, nul, typ, u, l, p, d, e) =
+  Column s t n pos nul typ u l p d (parseEnum e) Nothing
+
+  where
+    parseEnum :: Maybe Text -> [Text]
+    parseEnum str = fromMaybe [] $ split (==',') <$> str
+
+
+instance ToJSON Column where
+  toJSON c = object [
+      "schema"    .= colSchema c
+    , "name"      .= colName c
+    , "position"  .= colPosition c
+    , "nullable"  .= colNullable c
+    , "type"      .= colType c
+    , "updatable" .= colUpdatable c
+    , "maxLen"    .= colMaxLen c
+    , "precision" .= colPrecision c
+    , "references".= colFK c
+    , "default"   .= colDefault c
+    , "enum"      .= colEnum c ]
+
+instance ToJSON ForeignKey where
+  toJSON fk = object ["table".=fkTable fk, "column".=fkCol fk]
+
+instance ToJSON Table where
+  toJSON v = object [
+      "schema"     .= tableSchema v
+    , "name"       .= tableName v
+    , "insertable" .= tableInsertable v ]

src/PostgREST/RangeQuery.hs

@@ -1,4 +1,4 @@
-module RangeQuery (
+module PostgREST.RangeQuery (
   rangeParse
 , rangeRequested
 , rangeLimit
@@ -20,6 +20,8 @@ import Text.Read (readMaybe)
 
 import Data.Maybe (fromMaybe, listToMaybe)
 
+import Prelude
+
 type NonnegRange = Range Int
 
 rangeParse :: BS.ByteString -> Maybe NonnegRange

src/Types.hs

@@ -1,57 +0,0 @@
-{-# OPTIONS_GHC -fno-warn-orphans #-}
-module Types where
-
-import qualified Data.Aeson as JSON
-import Data.Aeson.Types (Parser)
-
-import Data.Scientific (floatingOrInteger)
-import Data.HashMap.Strict (foldlWithKey')
-import Data.Text (Text)
-import Data.Text.Encoding (decodeUtf8)
-import Data.Time.Calendar (showGregorian)
-import Control.Monad (mzero)
-
-instance JSON.FromJSON SqlValue where
-  parseJSON (JSON.Number n)    = return $ either toSql iToSql (floatingOrInteger n :: Either Double Int)
-  parseJSON (JSON.String s)    = return $ toSql s
-  parseJSON (JSON.Bool   b)    = return $ toSql b
-  parseJSON JSON.Null          = return SqlNull
-  parseJSON (JSON.Object o)    = return . toSql $ JSON.encode o
-  parseJSON (JSON.Array  a)    = return . toSql $ JSON.encode a
-
-instance JSON.ToJSON SqlValue where
-  toJSON (SqlString s)         = JSON.toJSON s
-  toJSON (SqlByteString s)     = JSON.toJSON $ decodeUtf8 s
-  toJSON (SqlWord32 w)         = JSON.toJSON w
-  toJSON (SqlWord64 w)         = JSON.toJSON w
-  toJSON (SqlInt32 i)          = JSON.toJSON i
-  toJSON (SqlInt64 i)          = JSON.toJSON i
-  toJSON (SqlInteger i)        = JSON.toJSON i
-  toJSON (SqlChar c)           = JSON.toJSON c
-  toJSON (SqlBool b)           = JSON.toJSON b
-  toJSON (SqlDouble n)         = JSON.toJSON n
-  toJSON (SqlRational n)       = JSON.toJSON n
-  toJSON (SqlLocalDate d)      = JSON.toJSON $ showGregorian d
-  toJSON (SqlLocalTimeOfDay t) = JSON.toJSON $ show t
-  toJSON (SqlLocalTime t)      = JSON.toJSON $ show t
-  toJSON SqlNull               = JSON.Null
-  toJSON x                     = JSON.toJSON $ show x
-
-
-newtype SqlRow = SqlRow {getRow :: [(Text, SqlValue)] } deriving (Show)
-
-sqlRowColumns :: SqlRow -> [Text]
-sqlRowColumns = map fst . getRow
-
-sqlRowValues :: SqlRow -> [SqlValue]
-sqlRowValues = map snd . getRow
-
-instance JSON.FromJSON SqlRow where
-  parseJSON (JSON.Object m) = foldlWithKey' add (return $ SqlRow []) m
-    where
-      add :: Parser SqlRow -> Text -> JSON.Value -> Parser SqlRow
-      add parser k v = do
-        SqlRow l <- parser
-        sqlV <- JSON.parseJSON v
-        return . SqlRow $ (k, sqlV) : l
-  parseJSON _ = mzero

stack.yaml

@@ -0,0 +1,7 @@
+flags: {}
+packages:
+- '.'
+extra-deps: 
+  - Ranged-sets-0.3.0
+  - packdeps-0.4.1
+resolver: lts-3.1

test/Feature/AuthSpec.hs

@@ -1,4 +1,3 @@
-{-# LANGUAGE QuasiQuotes #-}
 module Feature.AuthSpec where
 
 -- {{{ Imports
@@ -11,16 +10,52 @@ import SpecHelper
 -- }}}
 
 spec :: Spec
-spec = before resetDb $ around withApp $
-  describe "authorization" $ do
-    it "hides tables that anonymous does not own" $
-      get "/authors_only" `shouldRespondWith` 404
-    it "indicates login failure" $ do
-      let auth = authHeader "postgrest_test_author" "fakefake"
-      request methodGet "/authors_only" [auth] ""
-        `shouldRespondWith` 401
-    it "allows users with permissions to see their tables" $ do
-      _ <- post "/postgrest/users" [json| { "id":"jdoe", "pass": "1234", "role": "postgrest_test_author" } |]
-      let auth = authHeader "jdoe" "1234"
-      request methodGet "/authors_only" [auth] ""
-        `shouldRespondWith` 200
+spec = beforeAll
+  (clearTable "postgrest.auth") . afterAll_ (clearTable "postgrest.auth")
+  $ around withApp
+  $ describe "authorization" $ do
+
+  it "hides tables that anonymous does not own" $
+    get "/authors_only" `shouldRespondWith` 404
+
+  it "indicates login failure (BasicAuth)" $ do
+    let auth = authHeaderBasic "postgrest_test_author" "fakefake"
+    request methodGet "/authors_only" [auth] ""
+      `shouldRespondWith` 401
+
+  it "allows users with permissions to see their tables (BasicAuth)" $ do
+    _ <- post "/postgrest/users" [json| { "id":"jdoe", "pass": "1234", "role": "postgrest_test_author" } |]
+    let auth = authHeaderBasic "jdoe" "1234"
+    request methodGet "/authors_only" [auth] ""
+      `shouldRespondWith` 200
+
+  it "recovers after 400 error with logged in user" $ do
+    _ <- post "/postgrest/users" [json| { "id":"jdoe", "pass": "1234", "role": "postgrest_test_author" } |]
+    let auth = authHeaderBasic "jdoe" "1234"
+    _ <- request methodPost "/rpc/problem" [auth] ""
+    request methodGet "/authors_only" [auth] ""
+      `shouldRespondWith` 200
+
+  it "allows users to login (JWT)" $ do
+    _ <- post "/postgrest/users" [json| { "id":"jdoe", "pass": "1234", "role": "postgrest_test_author" } |]
+    post "/postgrest/tokens" [json| { "id":"jdoe", "pass": "1234" } |]
+      `shouldRespondWith` ResponseMatcher {
+          matchBody = Just [json| {"token":"eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJyb2xlIjoicG9zdGdyZXN0X3Rlc3RfYXV0aG9yIiwiaWQiOiJqZG9lIn0.y4vZuu1dDdwAl0-S00MCRWRYMlJ5YAMSir6Es6WtWx0"} |]
+        , matchStatus = 201
+        , matchHeaders = ["Content-Type" <:> "application/json"]
+        }
+
+  it "indicates login failure (JWT)" $ do
+    _ <- post "/postgrest/users" [json| { "id":"jdoe", "pass": "1234", "role": "postgrest_test_author" } |]
+    post "/postgrest/tokens" [json| { "id":"jdoe", "pass": "NOPE" } |]
+      `shouldRespondWith` ResponseMatcher {
+          matchBody = Just [json| {"message":"Failed authentication."} |]
+        , matchStatus = 401
+        , matchHeaders = ["Content-Type" <:> "application/json"]
+        }
+
+  it "allows users with permissions to see their tables (JWT)" $ do
+    _ <- post "/postgrest/users" [json| { "id":"jdoe", "pass": "1234", "role": "postgrest_test_author" } |]
+    let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJyb2xlIjoicG9zdGdyZXN0X3Rlc3RfYXV0aG9yIiwiaWQiOiJqZG9lIn0.y4vZuu1dDdwAl0-S00MCRWRYMlJ5YAMSir6Es6WtWx0"
+    request methodGet "/authors_only" [auth] ""
+      `shouldRespondWith` 200

test/Feature/CorsSpec.hs

@@ -12,8 +12,7 @@ import Network.HTTP.Types
 -- }}}
 
 spec :: Spec
-spec = before resetDb $ around withApp $
-  describe "CORS" $ do
+spec = around withApp $ describe "CORS" $ do
     let preflightHeaders = [
           ("Accept", "*/*"),
           ("Origin", "http://example.com"),
@@ -23,7 +22,7 @@ spec = before resetDb $ around withApp $
           ("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/"),
@@ -54,6 +53,14 @@ spec = before resetDb $ around withApp $
         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,37 @@
+module Feature.DeleteSpec where
+
+import Test.Hspec
+import Test.Hspec.Wai
+import SpecHelper
+
+import Network.HTTP.Types
+
+spec :: Spec
+spec = beforeAll (clearTable "items" >> createItems 15) . afterAll_ (clearTable "items")
+  . around withApp $
+  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 "[{\"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,4 +1,3 @@
-{-# LANGUAGE QuasiQuotes #-}
 module Feature.InsertSpec where
 
 import Test.Hspec
@@ -10,18 +9,17 @@ import SpecHelper
 
 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 TestTypes(IncPK(..), CompoundPK(..))
 
---import Debug.Trace
-
 spec :: Spec
-spec = before resetDb $ around withApp $ do
+spec = afterAll_ resetDb $ around withApp $ do
   describe "Posting new record" $ do
-    it "accepts disparate json types" $ do
+    after_ (clearTable "menagerie") . it "accepts disparate json types" $ do
       p <- post "/menagerie"
         [json| {
           "integer": 13, "double": 3.14159, "varchar": "testing!"
@@ -33,7 +31,7 @@ spec = before resetDb $ around withApp $ do
         simpleStatus p `shouldBe` created201
 
     context "with no pk supplied" $ do
-      context "into a table with auto-incrementing pk" $
+      context "into a table with auto-incrementing pk" . after_ (clearTable "auto_incrementing_pk") $
         it "succeeds with 201 and link" $ do
           p <- post "/auto_incrementing_pk" [json| { "non_nullable_string":"not null"} |]
           liftIO $ do
@@ -52,7 +50,7 @@ spec = before resetDb $ around withApp $ do
           post "/simple_pk" [json| { "extra":"foo"} |]
             `shouldRespondWith` 400
 
-      context "into a table with no pk" $
+      context "into a table with no pk" . after_ (clearTable "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
@@ -60,7 +58,25 @@ spec = before resetDb $ around withApp $ do
             simpleHeaders p `shouldSatisfy` matchHeader hLocation "/no_pk\\?a=eq.foo&b=eq.bar"
             simpleStatus p `shouldBe` created201
 
-    context "with compound pk supplied" $
+        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 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" . after_ (clearTable "compound_pk") $
       it "builds response location header appropriately" $
         post "/compound_pk" [json| { "k1":12, "k2":42 } |]
           `shouldRespondWith` ResponseMatcher {
@@ -71,13 +87,68 @@ spec = before resetDb $ around withApp $ 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 "jsonb" . after_ (clearTable "json") $ do
+      it "serializes nested object" $ do
+        let inserted = [json| { "data": { "foo":"bar" } } |]
+        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] } |]
+        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
+
+    after_ (clearTable "menagerie") . context "disparate csv types" $
+      it "succeeds with multipart response" $ do
+        p <- request methodPost "/menagerie" [("Content-Type", "text/csv")]
+               [str|integer,double,varchar,boolean,date,money,enum
+                   |13,3.14159,testing!,false,1900-01-01,$3.99,foo
+                   |12,0.1,a string,true,1929-10-01,12,bar
+                   |]
+        liftIO $ do
+          simpleBody p `shouldBe` "Content-Type: application/json\nLocation: /menagerie?integer=eq.13\n\n\n--postgrest_boundary\nContent-Type: application/json\nLocation: /menagerie?integer=eq.12\n\n"
+          simpleStatus p `shouldBe` created201
+
+    after_ (clearTable "no_pk") . context "requesting full representation" $ do
+      it "returns full details of inserted record" $
+        request methodPost "/no_pk"
+                     [("Content-Type", "text/csv"), ("Prefer", "return=representation")]
+                     "a,b\nbar,baz"
           `shouldRespondWith` ResponseMatcher {
-            matchBody    = Just [json| {"message":"Failed to parse JSON payload. Failed reading: satisfy"} |]
-          , matchStatus  = 400
-          , matchHeaders = []
+            matchBody    = Just [json| { "a":"bar", "b":"baz" } |]
+          , matchStatus  = 201
+          , matchHeaders = ["Content-Type" <:> "application/json",
+                            "Location" <:> "/no_pk?a=eq.bar&b=eq.baz"]
           }
 
+      it "can post nulls" $
+        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"]
+          }
+
+    after_ (clearTable "no_pk") . context "with wrong number of columns" $ do
+      it "fails for too few" $ do
+        p <- request methodPost "/no_pk" [("Content-Type", "text/csv")] "a,b\nfoo,bar\nbaz"
+        liftIO $ simpleStatus p `shouldBe` badRequest400
+      it "fails for too many" $ do
+        p <- request methodPost "/no_pk" [("Content-Type", "text/csv")] "a,b\nfoo,bar\nbaz,bat,bad"
+        liftIO $ simpleStatus p `shouldBe` badRequest400
+
   describe "Putting record" $ do
 
     context "to unkonwn uri" $
@@ -101,7 +172,7 @@ spec = before resetDb $ around withApp $ do
               [json| { "k1":12, "k2":42 } |]
                 `shouldRespondWith` 400
 
-        context "specifying every column in the table" $ do
+        context "specifying every column in the table" . after_ (clearTable "compound_pk") $ do
           it "can create a new record" $ do
             p <- request methodPut "/compound_pk?k1=eq.12&k2=eq.42" []
                  [json| { "k1":12, "k2":42, "extra":3 } |]
@@ -131,7 +202,7 @@ spec = before resetDb $ around withApp $ do
               let record = head rows
               compoundExtra record `shouldBe` Just 5
 
-      context "with an auto-incrementing primary key" $
+      context "with an auto-incrementing primary key" . after_ (clearTable "auto_incrementing_pk") $
 
         it "succeeds with 204" $
           request methodPut "/auto_incrementing_pk?id=eq.1" []
@@ -156,19 +227,24 @@ spec = before resetDb $ around withApp $ do
             `shouldRespondWith` 404
 
     context "on an empty table" $
-      it "succeeds with no effect" $
+      it "indicates no records found to update" $
         request methodPatch "/simple_pk" []
           [json| { "extra":20 } |]
-            `shouldRespondWith` 204
+            `shouldRespondWith` 404
 
-    context "in a nonempty table" $ do
+    context "in a nonempty table" . before_ (clearTable "items" >> createItems 15) .
+      after_ (clearTable "items") $ do
       it "can update a single item" $ do
         g <- get "/items?id=eq.42"
         liftIO $ simpleHeaders g
           `shouldSatisfy` matchHeader "Content-Range" "\\*/0"
         request methodPatch "/items?id=eq.1" []
           [json| { "id":42 } |]
-            `shouldRespondWith` 204
+            `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"
@@ -184,3 +260,38 @@ spec = before resetDb $ around withApp $ do
         g <- get "/auto_incrementing_pk?non_nullable_string=eq.c"
         liftIO $ simpleHeaders g
           `shouldSatisfy` matchHeader "Content-Range" "0-9/10"
+
+      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}] |]
+
+  describe "Row level permission" $
+    it "set user_id when inserting rows" $ do
+      _ <- 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"
+        [ authHeaderBasic "jdoe" "1234", ("Prefer", "return=representation") ]
+        [json| { "secret": "nyancat" } |]
+      liftIO $ do
+          simpleBody p1 `shouldBe` [json| { "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` [json| { "owner":"jroe", "secret":"lolcat" } |]
+          simpleStatus p2 `shouldBe` created201

test/Feature/QuerySpec.hs

@@ -2,42 +2,202 @@ module Feature.QuerySpec where
 
 import Test.Hspec
 import Test.Hspec.Wai
+import Test.Hspec.Wai.JSON
+import Network.HTTP.Types
+import Network.Wai.Test (SResponse(simpleHeaders))
 
 import SpecHelper
 
 spec :: Spec
-spec = before resetDb $ around withApp $ do
+spec =
+  beforeAll (clearTable "items" >> createItems 15)
+   . beforeAll (clearTable "nullable_integer" >> createNullInteger)
+   . beforeAll (
+       clearTable "no_pk" >>
+       createNulls 2 >>
+       createLikableStrings >>
+       createJsonData)
+   . afterAll_ (clearTable "items" >> clearTable "no_pk" >> clearTable "simple_pk")
+   . around withApp $ do
+
+  describe "Querying a table with a column called count" $
+    it "should not confuse count column with pg_catalog.count aggregate" $
+      get "/has_count_column" `shouldRespondWith` 200
+
   describe "Querying a 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 the predicate" $
-        get "/items?id=eq.5"
-          `shouldRespondWith` ResponseMatcher {
-            matchBody    = Just "[{\"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` "[{\"a\":null}]"
+
+    it "matches with like" $ do
+      get "/simple_pk?k=like.*yx" `shouldRespondWith`
+        "[{\"k\":\"xyyx\",\"extra\":\"u\"}]"
+      get "/simple_pk?k=like.xy*" `shouldRespondWith`
+        "[{\"k\":\"xyyx\",\"extra\":\"u\"}]"
+      get "/simple_pk?k=like.*YY*" `shouldRespondWith`
+        "[{\"k\":\"xYYx\",\"extra\":\"v\"}]"
+
+    it "matches with like using not operator" $
+      get "/simple_pk?k=not.like.*yx" `shouldRespondWith`
+        "[{\"k\":\"xYYx\",\"extra\":\"v\"}]"
+
+    it "matches with ilike" $ do
+      get "/simple_pk?k=ilike.xy*&order=extra.asc" `shouldRespondWith`
+        "[{\"k\":\"xyyx\",\"extra\":\"u\"},{\"k\":\"xYYx\",\"extra\":\"v\"}]"
+      get "/simple_pk?k=ilike.*YY*&order=extra.asc" `shouldRespondWith`
+        "[{\"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" `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}] |]
 
   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=asc.id" `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 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\rxyyx,u\rxYYx,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"
@@ -47,10 +207,31 @@ spec = before resetDb $ around withApp $ 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": {"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| [] |]
+
+  describe "remote procedure call" $ do
+    context "a proc that returns a set" . before_ (clearTable "items" >> createItems 10) .
+      after_ (clearTable "items") $
+      it "returns proper json" $
+        post "/rpc/getitemrange" [json| { "min": 2, "max": 4 } |] `shouldRespondWith`
+          [json| [ {"id": 3}, {"id":4} ] |]
+
+    context "a proc that returns plain text" $
+      it "returns proper json" $
+        post "/rpc/sayhello" [json| { "name": "world" } |] `shouldRespondWith`
+          [json| [{"sayhello":"Hello, world"}] |]

test/Feature/RangeSpec.hs

@@ -8,7 +8,8 @@ import Network.Wai.Test (SResponse(simpleHeaders,simpleStatus))
 import SpecHelper
 
 spec :: Spec
-spec = before resetDb $ around withApp $
+spec = beforeAll (clearTable "items" >> createItems 15) . afterAll_ (clearTable "items")
+  . around withApp $
   describe "GET /items" $ do
 
     context "without range headers" $

test/Feature/StructureSpec.hs

@@ -1,4 +1,3 @@
-{-# LANGUAGE OverloadedStrings, QuasiQuotes #-}
 module Feature.StructureSpec where
 
 import Test.Hspec hiding (pendingWith)
@@ -10,24 +9,30 @@ import SpecHelper
 import Network.HTTP.Types
 
 spec :: Spec
-spec = before resetDb $ around withApp $ do
+spec = around withApp $ do
   describe "GET /" $ do
     it "lists views in schema" $
       request methodGet "/" [] ""
         `shouldRespondWith` [json| [
           {"schema":"1","name":"auto_incrementing_pk","insertable":true}
         , {"schema":"1","name":"compound_pk","insertable":true}
+        , {"schema":"1","name":"has_count_column","insertable":false}
         , {"schema":"1","name":"has_fk","insertable":true}
+        , {"schema":"1","name":"insertable_view_with_join","insertable":true}
         , {"schema":"1","name":"items","insertable":true}
+        , {"schema":"1","name":"json","insertable":true}
+        , {"schema":"1","name":"materialized_view","insertable":false}
         , {"schema":"1","name":"menagerie","insertable":true}
         , {"schema":"1","name":"no_pk","insertable":true}
+        , {"schema":"1","name":"nullable_integer","insertable":true}
         , {"schema":"1","name":"simple_pk","insertable":true}
+        , {"schema":"1","name":"tsearch","insertable":true}
         ] |]
         {matchStatus = 200}
 
     it "lists only views user has permission to see" $ do
       _ <- post "/postgrest/users" [json| { "id":"jdoe", "pass": "1234", "role": "postgrest_test_author" } |]
-      let auth = authHeader "jdoe" "1234"
+      let auth = authHeaderBasic "jdoe" "1234"
 
       request methodGet "/" [auth] ""
         `shouldRespondWith` [json| [

test/Main.hs

@@ -0,0 +1,8 @@
+module Main where
+
+import Test.Hspec
+import SpecHelper
+import Spec
+
+main :: IO ()
+main = resetDb >> hspec spec

test/Spec.hs

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

test/SpecHelper.hs

@@ -1,5 +1,3 @@
-{-# LANGUAGE QuasiQuotes, OverloadedStrings #-}
-
 module SpecHelper where
 
 import Network.Wai
@@ -7,63 +5,71 @@ import Test.Hspec
 import Test.Hspec.Wai
 
 import Hasql as H
-import Hasql.Postgres as H
+import Hasql.Backend as B
+import Hasql.Postgres as P
 
 import Data.String.Conversions (cs)
--- import Control.Exception.Base (bracket, finally)
+import Data.Monoid
+import Data.Text hiding (map)
+import qualified Data.Vector as V
 import Control.Monad (void)
-import Control.Exception
 
 import Network.HTTP.Types.Header (Header, ByteRange, renderByteRange,
-                                  hRange, hAuthorization)
+                                  hRange, hAuthorization, hAccept)
 import Codec.Binary.Base64.String (encode)
 import Data.CaseInsensitive (CI(..))
 import Data.Maybe (fromMaybe)
 import Text.Regex.TDFA ((=~))
 import qualified Data.ByteString.Char8 as BS
-import Network.Wai.Middleware.Cors (cors)
 import System.Process (readProcess)
 
-import App (app, sqlError, isSqlError)
-import Config (AppConfig(..), corsPolicy)
-import Middleware
--- import Auth (addUser)
+import qualified Data.Aeson.Types as J
+
+import PostgREST.App (app)
+import PostgREST.Config (AppConfig(..))
+import PostgREST.Middleware
+import PostgREST.Error(errResponse)
 
 isLeft :: Either a b -> Bool
 isLeft (Left _ ) = True
 isLeft _ = False
 
 cfg :: AppConfig
-cfg = AppConfig "postgrest_test" 5432 "postgrest_test" "" "localhost" 3000 "postgrest_anonymous" False 10
+cfg = AppConfig "postgrest_test" 5432 "postgrest_test" "" "localhost" 3000 "postgrest_anonymous" False 10 "1" "safe"
 
-testSettings :: SessionSettings
-testSettings = fromMaybe (error "bad settings") $ H.sessionSettings 1 30
+testPoolOpts :: PoolSettings
+testPoolOpts = fromMaybe (error "bad settings") $ H.poolSettings 1 30
 
-pgSettings :: Postgres
-pgSettings = H.ParamSettings "localhost" 5432 "postgrest_test" "" "postgrest_test"
+pgSettings :: P.Settings
+pgSettings = P.ParamSettings (cs $ configDbHost cfg)
+                             (fromIntegral $ configDbPort cfg)
+                             (cs $ configDbUser cfg)
+                             (cs $ configDbPass cfg)
+                             (cs $ configDbName cfg)
 
 withApp :: ActionWith Application -> IO ()
-withApp perform =
-  let anonRole = cs $ configAnonRole cfg in
-  perform $ middle $ \req resp ->
-    H.session pgSettings testSettings $ H.sessionUnlifter >>= \unlift ->
-      liftIO $ do
-        body <- strictRequestBody req
-        resp =<< catchJust isSqlError
-          (unlift $ H.tx Nothing
-                  $ authenticated anonRole (app body) req)
-          (return . sqlError)
+withApp perform = do
+  pool :: H.Pool P.Postgres
+    <- H.acquirePool pgSettings testPoolOpts
 
-  where middle = cors corsPolicy
+  perform $ middle $ \req resp -> do
+    body <- strictRequestBody req
+    result <- liftIO $ H.session pool $ H.tx (Just (H.ReadCommitted, Just True))
+      $ authenticated cfg (app cfg body) req
+    either (resp . errResponse) resp result
+
+  where middle = defaultMiddle False
 
 
 resetDb :: IO ()
 resetDb = do
-  H.session pgSettings testSettings $
+  pool :: H.Pool P.Postgres
+    <- H.acquirePool pgSettings testPoolOpts
+  void . liftIO $ H.session pool $
     H.tx Nothing $ do
-      H.unit [H.q| drop schema if exists "1" cascade |]
-      H.unit [H.q| drop schema if exists private cascade |]
-      H.unit [H.q| drop schema if exists postgrest cascade |]
+      H.unitEx [H.stmt| drop schema if exists "1" cascade |]
+      H.unitEx [H.stmt| drop schema if exists private cascade |]
+      H.unitEx [H.stmt| drop schema if exists postgrest cascade |]
 
   loadFixture "roles"
   loadFixture "schema"
@@ -77,6 +83,9 @@ loadFixture name =
 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")
 
@@ -84,14 +93,62 @@ matchHeader :: CI BS.ByteString -> String -> [Header] -> Bool
 matchHeader name valRegex headers =
   maybe False (=~ valRegex) $ lookup name headers
 
-authHeader :: String -> String -> Header
-authHeader u p =
+authHeaderBasic :: String -> String -> Header
+authHeaderBasic u p =
   (hAuthorization, cs $ "Basic " ++ encode (u ++ ":" ++ p))
 
--- for hspec-wai
-pending_ :: WaiSession ()
-pending_ = liftIO Test.Hspec.pending
+authHeaderJWT :: String -> Header
+authHeaderJWT token =
+  (hAuthorization, cs $ "Bearer " ++ token)
 
--- for hspec-wai
-pendingWith_ :: String -> WaiSession ()
-pendingWith_ = liftIO . Test.Hspec.pendingWith
+testPool :: IO(H.Pool P.Postgres)
+testPool = H.acquirePool pgSettings testPoolOpts
+
+clearTable :: Text -> IO ()
+clearTable table = do
+  pool <- testPool
+  void . liftIO $ H.session pool $ H.tx Nothing $
+    H.unitEx $ B.Stmt ("delete from \"1\"."<>table) V.empty True
+
+createItems :: Int -> IO ()
+createItems n = do
+  pool <- testPool
+  void . liftIO $ H.session pool $ H.tx Nothing txn
+  where
+    txn = mapM_ H.unitEx stmts
+    stmts = map [H.stmt|insert into "1".items (id) values (?)|] [1..n]
+
+createNulls :: Int -> IO ()
+createNulls n = do
+  pool <- testPool
+  void . liftIO $ H.session pool $ H.tx Nothing txn
+  where
+    txn = mapM_ H.unitEx (stmt':stmts)
+    stmt' = [H.stmt|insert into "1".no_pk (a,b) values (null,null)|]
+    stmts = map [H.stmt|insert into "1".no_pk (a,b) values (?,0)|] [1..n]
+
+createNullInteger :: IO ()
+createNullInteger = do
+  pool <- testPool
+  void . liftIO $ H.session pool $ H.tx Nothing $
+    H.unitEx $ [H.stmt| insert into "1".nullable_integer (a) values (null) |]
+
+createLikableStrings :: IO ()
+createLikableStrings = do
+  pool <- testPool
+  void . liftIO $ H.session pool $ H.tx Nothing $ do
+    H.unitEx $ insertSimplePk "xyyx" "u"
+    H.unitEx $ insertSimplePk "xYYx" "v"
+  where
+    insertSimplePk :: Text -> Text -> H.Stmt P.Postgres
+    insertSimplePk = [H.stmt|insert into "1".simple_pk (k, extra) values (?,?)|]
+
+createJsonData :: IO ()
+createJsonData = do
+  pool <- testPool
+  void . liftIO $ H.session pool $ H.tx Nothing $
+    H.unitEx $
+      [H.stmt|
+        insert into "1".json (data) values (?)
+      |]
+      (J.object [("foo", J.object [("bar", J.String "baz")])])

test/TestTypes.hs

@@ -8,9 +8,11 @@ module TestTypes (
 import qualified Data.Aeson as JSON
 import Data.Aeson ((.:))
 -- import Data.Maybe (fromJust)
-import Control.Applicative ((<$>), (<*>))
+import Control.Applicative
 import Control.Monad (mzero)
 
+import Prelude
+
 data IncPK = IncPK {
   incId :: Int
 , incNullableStr :: Maybe String

test/Unit/ErrorsSpec.hs

@@ -1,41 +0,0 @@
-module Unit.ErrorsSpec where
-
-import Test.Hspec
-
-import Text.Parsec
-import PgError
-import Data.Either (rights)
-
-spec :: Spec
-spec =
-  describe "Parsing Hasql errors" $ do
-    it "can handle status and code" $
-      let p = parse message "" "Status: \"foo\"; Code: \"abc\"." in
-      rights [p] `shouldBe` [
-          Message (Just "foo") "abc" Nothing Nothing
-        ]
-    it "can handle weird redundant quotes in status" $
-      let p = parse message "" "Status: \"\"foo\"\"; Code: \"abc\"." in
-      rights [p] `shouldBe` [
-          Message (Just "foo") "abc" Nothing Nothing
-        ]
-    it "can handle text and code" $
-      let p = parse message "" "Message: \"foo\"; Code: \"abc\"." in
-      rights [p] `shouldBe` [
-          Message Nothing "abc" (Just "foo") Nothing
-        ]
-    it "can handle status, text and code" $
-      let p = parse message "" "Status: \"hi\"; Message: \"foo\"; Code: \"abc\"." in
-      rights [p] `shouldBe` [
-          Message (Just "hi") "abc" (Just "foo") Nothing
-        ]
-    it "can handle unescaped quotes in message" $
-      let p = parse message "" "Status: \"hi\"; Message: \"unknown \"foo\"!\"; Code: \"abc\"." in
-      rights [p] `shouldBe` [
-          Message (Just "hi") "abc" (Just "unknown \"foo\"!") Nothing
-        ]
-    it "can handle periods in message" $
-      let p = parse message "" "Message: \"unknown \"foo\".bar\"; Code: \"42P01\"." in
-      rights [p] `shouldBe` [
-          Message Nothing "42P01" (Just "unknown \"foo\".bar") Nothing
-        ]

test/Unit/PgQuerySpec.hx

@@ -79,7 +79,7 @@ spec = around dbWithSchema $ do
     addUser user pass role conn
     return conn) $ do
     it "accepts correct credentials and return the role" $ \conn ->
-      signInRole user pass conn `shouldReturn` LoginSuccess role
+      signInRole user pass conn `shouldReturn` LoginSuccess role user
 
     it "returns nothing with bad creds" $ \conn -> do
       signInRole "not-a-user" pass conn `shouldReturn` LoginFailed

test/Unit/PgStructureSpec.hx

@@ -14,7 +14,7 @@ spec = around dbWithSchema $ beforeWith setRole $ do
     it "shows all the tables" $ \conn -> do
       ts <- tables "1" 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

test/fixtures/schema.sql

@@ -1,70 +1,37 @@
---
--- PostgreSQL database dump
---
-
--- Dumped from database version 9.3.5
--- Dumped by pg_dump version 9.3.5
--- Started on 2014-10-21 15:12:44 PDT
-
 SET statement_timeout = 0;
 SET client_encoding = 'UTF8';
 SET standard_conforming_strings = on;
 SET check_function_bodies = false;
 SET client_min_messages = warning;
 
---
--- TOC entry 20 (class 2615 OID 337536)
--- Name: 1; Type: SCHEMA; Schema: -; Owner: postgrest_test
---
 
 CREATE SCHEMA "1";
 
 
 ALTER SCHEMA "1" OWNER TO postgrest_test;
 
---
--- TOC entry 19 (class 2615 OID 337537)
--- Name: postgrest; Type: SCHEMA; Schema: -; Owner: postgrest_test
---
 
 CREATE SCHEMA postgrest;
 
 
 ALTER SCHEMA postgrest OWNER TO postgrest_test;
 
---
--- TOC entry 16 (class 2615 OID 337538)
--- Name: private; Type: SCHEMA; Schema: -; Owner: postgrest_test
---
 
 CREATE SCHEMA private;
 
 
 ALTER SCHEMA private OWNER TO postgrest_test;
 
---
--- TOC entry 205 (class 3079 OID 12018)
--- Name: plpgsql; Type: EXTENSION; Schema: -; Owner: 
---
 
 CREATE EXTENSION IF NOT EXISTS plpgsql WITH SCHEMA pg_catalog;
 
 
---
--- TOC entry 2321 (class 0 OID 0)
--- Dependencies: 205
--- Name: EXTENSION plpgsql; Type: COMMENT; Schema: -; Owner: 
---
 
 COMMENT ON EXTENSION plpgsql IS 'PL/pgSQL procedural language';
 
 
 SET search_path = "1", pg_catalog;
 
---
--- TOC entry 553 (class 1247 OID 337540)
--- Name: enum_menagerie_type; Type: TYPE; Schema: 1; Owner: postgrest_test
---
 
 CREATE TYPE enum_menagerie_type AS ENUM (
     'foo',
@@ -76,10 +43,6 @@ ALTER TYPE "1".enum_menagerie_type OWNER TO postgrest_test;
 
 SET search_path = postgrest, pg_catalog;
 
---
--- TOC entry 218 (class 1255 OID 337545)
--- Name: check_role_exists(); Type: FUNCTION; Schema: postgrest; Owner: postgrest_test
---
 
 CREATE FUNCTION check_role_exists() RETURNS trigger
     LANGUAGE plpgsql
@@ -96,10 +59,6 @@ $$;
 
 ALTER FUNCTION postgrest.check_role_exists() OWNER TO postgrest_test;
 
---
--- TOC entry 219 (class 1255 OID 337546)
--- Name: update_owner(); Type: FUNCTION; Schema: postgrest; Owner: postgrest_test
---
 
 CREATE FUNCTION update_owner() RETURNS trigger
     LANGUAGE plpgsql
@@ -113,28 +72,43 @@ $$;
 
 ALTER FUNCTION postgrest.update_owner() OWNER TO postgrest_test;
 
+CREATE FUNCTION set_authors_only_owner() RETURNS trigger
+    LANGUAGE plpgsql
+    AS $$
+begin 
+  NEW.owner = current_setting('user_vars.user_id'); 
+  RETURN NEW;
+end
+$$;
+
+ALTER FUNCTION postgrest.set_authors_only_owner() OWNER TO postgrest_test;
+
+CREATE FUNCTION "1".insert_insertable_view_with_join() RETURNS trigger
+    LANGUAGE plpgsql
+    AS $$
+begin
+  INSERT INTO "1".auto_incrementing_pk (nullable_string, non_nullable_string) VALUES (NEW.nullable_string, NEW.non_nullable_string);
+  RETURN NEW;
+end;
+$$;
+
+ALTER FUNCTION "1".insert_insertable_view_with_join() OWNER TO postgrest_test;
+
 SET search_path = "1", pg_catalog;
 
 SET default_tablespace = '';
 
 SET default_with_oids = false;
 
---
--- TOC entry 191 (class 1259 OID 337547)
--- Name: authors_only; Type: TABLE; Schema: 1; Owner: postgrest_test_author; Tablespace: 
---
 
 CREATE TABLE authors_only (
+    owner character varying NOT NULL,
     secret character varying NOT NULL
 );
 
 
 ALTER TABLE "1".authors_only OWNER TO postgrest_test_author;
 
---
--- TOC entry 192 (class 1259 OID 337553)
--- Name: auto_incrementing_pk; Type: TABLE; Schema: 1; Owner: postgrest_test; Tablespace: 
---
 
 CREATE TABLE auto_incrementing_pk (
     id integer NOT NULL,
@@ -146,10 +120,6 @@ CREATE TABLE auto_incrementing_pk (
 
 ALTER TABLE "1".auto_incrementing_pk OWNER TO postgrest_test;
 
---
--- TOC entry 193 (class 1259 OID 337560)
--- Name: auto_incrementing_pk_id_seq; Type: SEQUENCE; Schema: 1; Owner: postgrest_test
---
 
 CREATE SEQUENCE auto_incrementing_pk_id_seq
     START WITH 1
@@ -161,19 +131,10 @@ CREATE SEQUENCE auto_incrementing_pk_id_seq
 
 ALTER TABLE "1".auto_incrementing_pk_id_seq OWNER TO postgrest_test;
 
---
--- TOC entry 2324 (class 0 OID 0)
--- Dependencies: 193
--- Name: auto_incrementing_pk_id_seq; Type: SEQUENCE OWNED BY; Schema: 1; Owner: postgrest_test
---
 
 ALTER SEQUENCE auto_incrementing_pk_id_seq OWNED BY auto_incrementing_pk.id;
 
 
---
--- TOC entry 194 (class 1259 OID 337562)
--- Name: compound_pk; Type: TABLE; Schema: 1; Owner: postgrest_test; Tablespace: 
---
 
 CREATE TABLE compound_pk (
     k1 integer NOT NULL,
@@ -184,10 +145,6 @@ CREATE TABLE compound_pk (
 
 ALTER TABLE "1".compound_pk OWNER TO postgrest_test;
 
---
--- TOC entry 195 (class 1259 OID 337565)
--- Name: has_fk; Type: TABLE; Schema: 1; Owner: postgrest_test; Tablespace: 
---
 
 CREATE TABLE has_fk (
     id bigint NOT NULL,
@@ -198,10 +155,6 @@ CREATE TABLE has_fk (
 
 ALTER TABLE "1".has_fk OWNER TO postgrest_test;
 
---
--- TOC entry 196 (class 1259 OID 337568)
--- Name: has_fk_id_seq; Type: SEQUENCE; Schema: 1; Owner: postgrest_test
---
 
 CREATE SEQUENCE has_fk_id_seq
     START WITH 1
@@ -213,19 +166,33 @@ CREATE SEQUENCE has_fk_id_seq
 
 ALTER TABLE "1".has_fk_id_seq OWNER TO postgrest_test;
 
---
--- TOC entry 2327 (class 0 OID 0)
--- Dependencies: 196
--- Name: has_fk_id_seq; Type: SEQUENCE OWNED BY; Schema: 1; Owner: postgrest_test
---
 
 ALTER SEQUENCE has_fk_id_seq OWNED BY has_fk.id;
 
+CREATE MATERIALIZED VIEW "1".materialized_view AS
+ SELECT 
+    version();
+
+ALTER TABLE "1".materialized_view OWNER TO postgrest_test;
+
+CREATE VIEW "1".insertable_view_with_join AS
+ SELECT has_fk.id,
+    has_fk.auto_inc_fk,
+    has_fk.simple_fk,
+    auto_incrementing_pk.nullable_string,
+    auto_incrementing_pk.non_nullable_string,
+    auto_incrementing_pk.inserted_at
+   FROM (has_fk
+     JOIN auto_incrementing_pk USING (id));
+
+
+ALTER TABLE "1".insertable_view_with_join OWNER TO postgrest_test;
+
+CREATE VIEW "1".has_count_column AS
+ SELECT 1 AS count;
+
+ALTER TABLE "1".insertable_view_with_join OWNER TO postgrest_test;
 
---
--- TOC entry 197 (class 1259 OID 337570)
--- Name: items; Type: TABLE; Schema: 1; Owner: postgrest_test; Tablespace: 
---
 
 CREATE TABLE items (
     id bigint NOT NULL
@@ -234,10 +201,6 @@ CREATE TABLE items (
 
 ALTER TABLE "1".items OWNER TO postgrest_test;
 
---
--- TOC entry 198 (class 1259 OID 337573)
--- Name: items_id_seq; Type: SEQUENCE; Schema: 1; Owner: postgrest_test
---
 
 CREATE SEQUENCE items_id_seq
     START WITH 1
@@ -249,19 +212,29 @@ CREATE SEQUENCE items_id_seq
 
 ALTER TABLE "1".items_id_seq OWNER TO postgrest_test;
 
---
--- TOC entry 2329 (class 0 OID 0)
--- Dependencies: 198
--- Name: items_id_seq; Type: SEQUENCE OWNED BY; Schema: 1; Owner: postgrest_test
---
 
 ALTER SEQUENCE items_id_seq OWNED BY items.id;
 
 
---
--- TOC entry 199 (class 1259 OID 337575)
--- Name: menagerie; Type: TABLE; Schema: 1; Owner: postgrest_test; Tablespace: 
---
+
+CREATE FUNCTION "1".getitemrange(min bigint, max bigint) RETURNS SETOF "1".items AS $$
+    SELECT * FROM "1".items WHERE id > $1 AND id <= $2;
+$$ LANGUAGE SQL;
+
+
+
+CREATE FUNCTION "1".sayhello(name text) RETURNS text AS $$
+    SELECT 'Hello, ' || $1;
+$$ LANGUAGE SQL;
+
+
+CREATE FUNCTION "1".problem() RETURNS void LANGUAGE plpgsql AS
+$$
+BEGIN
+      RAISE 'bad thing';
+END;
+$$;
+
 
 CREATE TABLE menagerie (
     "integer" integer NOT NULL,
@@ -276,10 +249,6 @@ CREATE TABLE menagerie (
 
 ALTER TABLE "1".menagerie OWNER TO postgrest_test;
 
---
--- TOC entry 200 (class 1259 OID 337581)
--- Name: no_pk; Type: TABLE; Schema: 1; Owner: postgrest_test; Tablespace: 
---
 
 CREATE TABLE no_pk (
     a character varying,
@@ -289,10 +258,14 @@ CREATE TABLE no_pk (
 
 ALTER TABLE "1".no_pk OWNER TO postgrest_test;
 
---
--- TOC entry 201 (class 1259 OID 337587)
--- Name: simple_pk; Type: TABLE; Schema: 1; Owner: postgrest_test; Tablespace: 
---
+
+CREATE TABLE nullable_integer (
+    a integer
+);
+
+
+ALTER TABLE "1".nullable_integer OWNER TO postgrest_test;
+
 
 CREATE TABLE simple_pk (
     k character varying NOT NULL,
@@ -302,12 +275,24 @@ CREATE TABLE simple_pk (
 
 ALTER TABLE "1".simple_pk OWNER TO postgrest_test;
 
+
+CREATE TABLE json
+(
+  data json
+);
+
+
+ALTER TABLE "1".json OWNER TO postgrest_test;
+
+
+CREATE TABLE tsearch (
+    text_search_vector tsvector
+);
+
+ALTER TABLE "1".tsearch OWNER TO postgrest_test;
+
 SET search_path = postgrest, pg_catalog;
 
---
--- TOC entry 202 (class 1259 OID 337593)
--- Name: auth; Type: TABLE; Schema: postgrest; Owner: postgrest_test; Tablespace: 
---
 
 CREATE TABLE auth (
     id character varying NOT NULL,
@@ -320,10 +305,6 @@ ALTER TABLE postgrest.auth OWNER TO postgrest_test;
 
 SET search_path = private, pg_catalog;
 
---
--- TOC entry 203 (class 1259 OID 337599)
--- Name: articles; Type: TABLE; Schema: private; Owner: postgrest_test; Tablespace: 
---
 
 CREATE TABLE articles (
     body text,
@@ -334,10 +315,6 @@ CREATE TABLE articles (
 
 ALTER TABLE private.articles OWNER TO postgrest_test;
 
---
--- TOC entry 204 (class 1259 OID 337605)
--- Name: articles_id_seq; Type: SEQUENCE; Schema: private; Owner: postgrest_test
---
 
 CREATE SEQUENCE articles_id_seq
     START WITH 1
@@ -349,248 +326,118 @@ CREATE SEQUENCE articles_id_seq
 
 ALTER TABLE private.articles_id_seq OWNER TO postgrest_test;
 
---
--- TOC entry 2336 (class 0 OID 0)
--- Dependencies: 204
--- Name: articles_id_seq; Type: SEQUENCE OWNED BY; Schema: private; Owner: postgrest_test
---
 
 ALTER SEQUENCE articles_id_seq OWNED BY articles.id;
 
 
 SET search_path = "1", pg_catalog;
 
---
--- TOC entry 2165 (class 2604 OID 337607)
--- Name: id; Type: DEFAULT; Schema: 1; Owner: postgrest_test
---
 
 ALTER TABLE ONLY auto_incrementing_pk ALTER COLUMN id SET DEFAULT nextval('auto_incrementing_pk_id_seq'::regclass);
 
 
---
--- TOC entry 2166 (class 2604 OID 337608)
--- Name: id; Type: DEFAULT; Schema: 1; Owner: postgrest_test
---
 
 ALTER TABLE ONLY has_fk ALTER COLUMN id SET DEFAULT nextval('has_fk_id_seq'::regclass);
 
 
---
--- TOC entry 2167 (class 2604 OID 337609)
--- Name: id; Type: DEFAULT; Schema: 1; Owner: postgrest_test
---
 
 ALTER TABLE ONLY items ALTER COLUMN id SET DEFAULT nextval('items_id_seq'::regclass);
 
 
 SET search_path = private, pg_catalog;
 
---
--- TOC entry 2168 (class 2604 OID 337610)
--- Name: id; Type: DEFAULT; Schema: private; Owner: postgrest_test
---
 
 ALTER TABLE ONLY articles ALTER COLUMN id SET DEFAULT nextval('articles_id_seq'::regclass);
 
 
 SET search_path = "1", pg_catalog;
 
---
--- TOC entry 2298 (class 0 OID 337547)
--- Dependencies: 191
--- Data for Name: authors_only; Type: TABLE DATA; Schema: 1; Owner: postgrest_test_author
---
 
 
 
---
--- TOC entry 2299 (class 0 OID 337553)
--- Dependencies: 192
--- Data for Name: auto_incrementing_pk; Type: TABLE DATA; Schema: 1; Owner: postgrest_test
---
 
 
 
---
--- TOC entry 2337 (class 0 OID 0)
--- Dependencies: 193
--- Name: auto_incrementing_pk_id_seq; Type: SEQUENCE SET; Schema: 1; Owner: postgrest_test
---
 
-SELECT pg_catalog.setval('auto_incrementing_pk_id_seq', 54, true);
+SELECT pg_catalog.setval('auto_incrementing_pk_id_seq', 1, true);
 
 
---
--- TOC entry 2301 (class 0 OID 337562)
--- Dependencies: 194
--- Data for Name: compound_pk; Type: TABLE DATA; Schema: 1; Owner: postgrest_test
---
 
 
 
---
--- TOC entry 2302 (class 0 OID 337565)
--- Dependencies: 195
--- Data for Name: has_fk; Type: TABLE DATA; Schema: 1; Owner: postgrest_test
---
 
 
 
---
--- TOC entry 2338 (class 0 OID 0)
--- Dependencies: 196
--- Name: has_fk_id_seq; Type: SEQUENCE SET; Schema: 1; Owner: postgrest_test
---
 
 SELECT pg_catalog.setval('has_fk_id_seq', 1, false);
 
 
---
--- TOC entry 2304 (class 0 OID 337570)
--- Dependencies: 197
--- Data for Name: items; Type: TABLE DATA; Schema: 1; Owner: postgrest_test
---
 
 INSERT INTO items (id) VALUES (1);
-INSERT INTO items (id) VALUES (2);
-INSERT INTO items (id) VALUES (3);
-INSERT INTO items (id) VALUES (4);
-INSERT INTO items (id) VALUES (5);
-INSERT INTO items (id) VALUES (6);
-INSERT INTO items (id) VALUES (7);
-INSERT INTO items (id) VALUES (8);
-INSERT INTO items (id) VALUES (9);
-INSERT INTO items (id) VALUES (10);
-INSERT INTO items (id) VALUES (11);
-INSERT INTO items (id) VALUES (12);
-INSERT INTO items (id) VALUES (13);
-INSERT INTO items (id) VALUES (14);
-INSERT INTO items (id) VALUES (15);
 
-
---
--- TOC entry 2339 (class 0 OID 0)
--- Dependencies: 198
--- Name: items_id_seq; Type: SEQUENCE SET; Schema: 1; Owner: postgrest_test
---
-
-SELECT pg_catalog.setval('items_id_seq', 19, true);
-
-
---
--- TOC entry 2306 (class 0 OID 337575)
--- Dependencies: 199
--- Data for Name: menagerie; Type: TABLE DATA; Schema: 1; Owner: postgrest_test
---
-
-
-
---
--- TOC entry 2307 (class 0 OID 337581)
--- Dependencies: 200
--- Data for Name: no_pk; Type: TABLE DATA; Schema: 1; Owner: postgrest_test
---
-
-
-
---
--- TOC entry 2308 (class 0 OID 337587)
--- Dependencies: 201
--- Data for Name: simple_pk; Type: TABLE DATA; Schema: 1; Owner: postgrest_test
---
+SELECT pg_catalog.setval('items_id_seq', 1, true);
 
 
+INSERT INTO tsearch (text_search_vector) VALUES ('''bar'':2 ''foo'':1');
+INSERT INTO tsearch (text_search_vector) VALUES ('''baz'':1 ''qux'':2');
 
 SET search_path = postgrest, pg_catalog;
 
---
--- TOC entry 2309 (class 0 OID 337593)
--- Dependencies: 202
--- Data for Name: auth; Type: TABLE DATA; Schema: postgrest; Owner: postgrest_test
---
 
 
 
 SET search_path = private, pg_catalog;
 
---
--- TOC entry 2310 (class 0 OID 337599)
--- Dependencies: 203
--- Data for Name: articles; Type: TABLE DATA; Schema: private; Owner: postgrest_test
---
 
 
 
---
--- TOC entry 2340 (class 0 OID 0)
--- Dependencies: 204
--- Name: articles_id_seq; Type: SEQUENCE SET; Schema: private; Owner: postgrest_test
---
 
 SELECT pg_catalog.setval('articles_id_seq', 1, false);
 
 
 SET search_path = "1", pg_catalog;
 
---
--- TOC entry 2170 (class 2606 OID 337612)
--- Name: authors_only_pkey; Type: CONSTRAINT; Schema: 1; Owner: postgrest_test_author; Tablespace: 
---
+CREATE FUNCTION public.always_true("1".items) RETURNS boolean
+    LANGUAGE sql STABLE
+    AS $$ SELECT true $$;
+
+ALTER FUNCTION public.always_true("1".items) OWNER TO postgrest_test;
+
+
 
 ALTER TABLE ONLY authors_only
     ADD CONSTRAINT authors_only_pkey PRIMARY KEY (secret);
+    
+CREATE TRIGGER insert_insertable_view_with_join INSTEAD OF INSERT ON "1".insertable_view_with_join FOR EACH ROW EXECUTE PROCEDURE "1".insert_insertable_view_with_join();
 
 
---
--- TOC entry 2172 (class 2606 OID 337614)
--- Name: auto_incrementing_pk_pkey; Type: CONSTRAINT; Schema: 1; Owner: postgrest_test; Tablespace: 
---
+CREATE TRIGGER secrets_owner_track BEFORE INSERT OR UPDATE ON authors_only FOR EACH ROW EXECUTE PROCEDURE postgrest.set_authors_only_owner();
+
 
 ALTER TABLE ONLY auto_incrementing_pk
     ADD CONSTRAINT auto_incrementing_pk_pkey PRIMARY KEY (id);
 
 
---
--- TOC entry 2174 (class 2606 OID 337616)
--- Name: compound_pk_pkey; Type: CONSTRAINT; Schema: 1; Owner: postgrest_test; Tablespace: 
---
 
 ALTER TABLE ONLY compound_pk
     ADD CONSTRAINT compound_pk_pkey PRIMARY KEY (k1, k2);
 
 
---
--- TOC entry 2182 (class 2606 OID 337618)
--- Name: contacts_pkey; Type: CONSTRAINT; Schema: 1; Owner: postgrest_test; Tablespace: 
---
 
 ALTER TABLE ONLY simple_pk
     ADD CONSTRAINT contacts_pkey PRIMARY KEY (k);
 
 
---
--- TOC entry 2176 (class 2606 OID 337620)
--- Name: has_fk_pkey; Type: CONSTRAINT; Schema: 1; Owner: postgrest_test; Tablespace: 
---
 
 ALTER TABLE ONLY has_fk
     ADD CONSTRAINT has_fk_pkey PRIMARY KEY (id);
 
 
---
--- TOC entry 2178 (class 2606 OID 337622)
--- Name: items_pkey; Type: CONSTRAINT; Schema: 1; Owner: postgrest_test; Tablespace: 
---
 
 ALTER TABLE ONLY items
     ADD CONSTRAINT items_pkey PRIMARY KEY (id);
 
 
---
--- TOC entry 2180 (class 2606 OID 337624)
--- Name: menagerie_pkey; Type: CONSTRAINT; Schema: 1; Owner: postgrest_test; Tablespace: 
---
 
 ALTER TABLE ONLY menagerie
     ADD CONSTRAINT menagerie_pkey PRIMARY KEY ("integer");
@@ -598,10 +445,6 @@ ALTER TABLE ONLY menagerie
 
 SET search_path = postgrest, pg_catalog;
 
---
--- TOC entry 2184 (class 2606 OID 337626)
--- Name: auth_pkey; Type: CONSTRAINT; Schema: postgrest; Owner: postgrest_test; Tablespace: 
---
 
 ALTER TABLE ONLY auth
     ADD CONSTRAINT auth_pkey PRIMARY KEY (id);
@@ -609,10 +452,6 @@ ALTER TABLE ONLY auth
 
 SET search_path = private, pg_catalog;
 
---
--- TOC entry 2186 (class 2606 OID 337628)
--- Name: articles_pkey; Type: CONSTRAINT; Schema: private; Owner: postgrest_test; Tablespace: 
---
 
 ALTER TABLE ONLY articles
     ADD CONSTRAINT articles_pkey PRIMARY KEY (id);
@@ -620,49 +459,28 @@ ALTER TABLE ONLY articles
 
 SET search_path = postgrest, pg_catalog;
 
---
--- TOC entry 2189 (class 2620 OID 337630)
--- Name: ensure_auth_role_exists; Type: TRIGGER; Schema: postgrest; Owner: postgrest_test
---
 
 CREATE CONSTRAINT TRIGGER ensure_auth_role_exists AFTER INSERT OR UPDATE ON auth NOT DEFERRABLE INITIALLY IMMEDIATE FOR EACH ROW EXECUTE PROCEDURE check_role_exists();
 
 
 SET search_path = private, pg_catalog;
 
---
--- TOC entry 2190 (class 2620 OID 337631)
--- Name: articles_owner_track; Type: TRIGGER; Schema: private; Owner: postgrest_test
---
 
 CREATE TRIGGER articles_owner_track BEFORE INSERT OR UPDATE ON articles FOR EACH ROW EXECUTE PROCEDURE postgrest.update_owner();
 
 
 SET search_path = "1", pg_catalog;
 
---
--- TOC entry 2187 (class 2606 OID 337632)
--- Name: has_fk_fk_fkey; Type: FK CONSTRAINT; Schema: 1; Owner: postgrest_test
---
 
 ALTER TABLE ONLY has_fk
     ADD CONSTRAINT has_fk_fk_fkey FOREIGN KEY (auto_inc_fk) REFERENCES auto_incrementing_pk(id);
 
 
---
--- TOC entry 2188 (class 2606 OID 337637)
--- Name: has_fk_simple_fk_fkey; Type: FK CONSTRAINT; Schema: 1; Owner: postgrest_test
---
 
 ALTER TABLE ONLY has_fk
     ADD CONSTRAINT has_fk_simple_fk_fkey FOREIGN KEY (simple_fk) REFERENCES simple_pk(k);
 
 
---
--- TOC entry 2317 (class 0 OID 0)
--- Dependencies: 20
--- Name: 1; Type: ACL; Schema: -; Owner: postgrest_test
---
 
 REVOKE ALL ON SCHEMA "1" FROM PUBLIC;
 REVOKE ALL ON SCHEMA "1" FROM postgrest_test;
@@ -671,11 +489,6 @@ GRANT USAGE ON SCHEMA "1" TO postgrest_anonymous;
 GRANT USAGE ON SCHEMA "1" TO postgrest_test_author;
 
 
---
--- TOC entry 2318 (class 0 OID 0)
--- Dependencies: 19
--- Name: postgrest; Type: ACL; Schema: -; Owner: postgrest_test
---
 
 REVOKE ALL ON SCHEMA postgrest FROM PUBLIC;
 REVOKE ALL ON SCHEMA postgrest FROM postgrest_test;
@@ -683,33 +496,17 @@ GRANT ALL ON SCHEMA postgrest TO postgrest_test;
 GRANT USAGE ON SCHEMA postgrest TO postgrest_anonymous;
 
 
---
--- TOC entry 2320 (class 0 OID 0)
--- Dependencies: 21
--- Name: public; Type: ACL; Schema: -; Owner: postgres
---
 
 REVOKE ALL ON SCHEMA public FROM PUBLIC;
-GRANT ALL ON SCHEMA public TO postgres;
 GRANT ALL ON SCHEMA public TO PUBLIC;
 
 
---
--- TOC entry 2322 (class 0 OID 0)
--- Dependencies: 191
--- Name: authors_only; Type: ACL; Schema: 1; Owner: postgrest_test_author
---
 
 REVOKE ALL ON TABLE authors_only FROM PUBLIC;
 REVOKE ALL ON TABLE authors_only FROM postgrest_test_author;
 GRANT ALL ON TABLE authors_only TO postgrest_test_author;
 
 
---
--- TOC entry 2323 (class 0 OID 0)
--- Dependencies: 192
--- Name: auto_incrementing_pk; Type: ACL; Schema: 1; Owner: postgrest_test
---
 
 REVOKE ALL ON TABLE auto_incrementing_pk FROM PUBLIC;
 REVOKE ALL ON TABLE auto_incrementing_pk FROM postgrest_test;
@@ -717,11 +514,6 @@ GRANT ALL ON TABLE auto_incrementing_pk TO postgrest_test;
 GRANT ALL ON TABLE auto_incrementing_pk TO postgrest_anonymous;
 
 
---
--- TOC entry 2325 (class 0 OID 0)
--- Dependencies: 193
--- Name: auto_incrementing_pk_id_seq; Type: ACL; Schema: 1; Owner: postgrest_test
---
 
 REVOKE ALL ON SEQUENCE auto_incrementing_pk_id_seq FROM PUBLIC;
 REVOKE ALL ON SEQUENCE auto_incrementing_pk_id_seq FROM postgrest_test;
@@ -729,11 +521,6 @@ GRANT ALL ON SEQUENCE auto_incrementing_pk_id_seq TO postgrest_test;
 GRANT USAGE ON SEQUENCE auto_incrementing_pk_id_seq TO postgrest_anonymous;
 
 
---
--- TOC entry 2326 (class 0 OID 0)
--- Dependencies: 194
--- Name: compound_pk; Type: ACL; Schema: 1; Owner: postgrest_test
---
 
 REVOKE ALL ON TABLE compound_pk FROM PUBLIC;
 REVOKE ALL ON TABLE compound_pk FROM postgrest_test;
@@ -746,11 +533,6 @@ REVOKE ALL ON TABLE has_fk FROM postgrest_test;
 GRANT ALL ON TABLE has_fk TO postgrest_test;
 GRANT ALL ON TABLE has_fk TO postgrest_anonymous;
 
---
--- TOC entry 2328 (class 0 OID 0)
--- Dependencies: 197
--- Name: items; Type: ACL; Schema: 1; Owner: postgrest_test
---
 
 REVOKE ALL ON TABLE items FROM PUBLIC;
 REVOKE ALL ON TABLE items FROM postgrest_test;
@@ -758,11 +540,22 @@ GRANT ALL ON TABLE items TO postgrest_test;
 GRANT ALL ON TABLE items TO postgrest_anonymous;
 
 
---
--- TOC entry 2330 (class 0 OID 0)
--- Dependencies: 198
--- Name: items_id_seq; Type: ACL; Schema: 1; Owner: postgrest_test
---
+REVOKE ALL ON FUNCTION getitemrange(bigint, bigint) FROM PUBLIC;
+REVOKE ALL ON FUNCTION getitemrange(bigint, bigint) FROM postgrest_test;
+GRANT EXECUTE ON FUNCTION getitemrange(bigint, bigint) TO postgrest_test;
+GRANT EXECUTE ON FUNCTION getitemrange(bigint, bigint) TO postgrest_anonymous;
+
+
+REVOKE ALL ON FUNCTION sayhello(text) FROM PUBLIC;
+REVOKE ALL ON FUNCTION sayhello(text) FROM postgrest_test;
+GRANT EXECUTE ON FUNCTION sayhello(text) TO postgrest_test;
+GRANT EXECUTE ON FUNCTION sayhello(text) TO postgrest_anonymous;
+
+
+REVOKE ALL ON FUNCTION problem() FROM PUBLIC;
+REVOKE ALL ON FUNCTION problem() FROM postgrest_test_author;
+GRANT EXECUTE ON FUNCTION problem() TO postgrest_test_author;
+
 
 REVOKE ALL ON SEQUENCE items_id_seq FROM PUBLIC;
 REVOKE ALL ON SEQUENCE items_id_seq FROM postgrest_test;
@@ -770,11 +563,6 @@ GRANT ALL ON SEQUENCE items_id_seq TO postgrest_test;
 GRANT USAGE ON SEQUENCE items_id_seq TO postgrest_anonymous;
 
 
---
--- TOC entry 2331 (class 0 OID 0)
--- Dependencies: 199
--- Name: menagerie; Type: ACL; Schema: 1; Owner: postgrest_test
---
 
 REVOKE ALL ON TABLE menagerie FROM PUBLIC;
 REVOKE ALL ON TABLE menagerie FROM postgrest_test;
@@ -782,11 +570,6 @@ GRANT ALL ON TABLE menagerie TO postgrest_test;
 GRANT ALL ON TABLE menagerie TO postgrest_anonymous;
 
 
---
--- TOC entry 2332 (class 0 OID 0)
--- Dependencies: 200
--- Name: no_pk; Type: ACL; Schema: 1; Owner: postgrest_test
---
 
 REVOKE ALL ON TABLE no_pk FROM PUBLIC;
 REVOKE ALL ON TABLE no_pk FROM postgrest_test;
@@ -794,11 +577,13 @@ GRANT ALL ON TABLE no_pk TO postgrest_test;
 GRANT ALL ON TABLE no_pk TO postgrest_anonymous;
 
 
---
--- TOC entry 2333 (class 0 OID 0)
--- Dependencies: 201
--- Name: simple_pk; Type: ACL; Schema: 1; Owner: postgrest_test
---
+
+REVOKE ALL ON TABLE nullable_integer FROM PUBLIC;
+REVOKE ALL ON TABLE nullable_integer FROM postgrest_test;
+GRANT ALL ON TABLE nullable_integer TO postgrest_test;
+GRANT ALL ON TABLE nullable_integer TO postgrest_anonymous;
+
+
 
 REVOKE ALL ON TABLE simple_pk FROM PUBLIC;
 REVOKE ALL ON TABLE simple_pk FROM postgrest_test;
@@ -806,13 +591,42 @@ GRANT ALL ON TABLE simple_pk TO postgrest_test;
 GRANT ALL ON TABLE simple_pk TO postgrest_anonymous;
 
 
+
+REVOKE ALL ON TABLE json FROM PUBLIC;
+REVOKE ALL ON TABLE json FROM postgrest_test;
+GRANT ALL ON TABLE json TO postgrest_test;
+GRANT ALL ON TABLE json TO postgrest_anonymous;
+
+
+
+REVOKE ALL ON TABLE tsearch FROM PUBLIC;
+REVOKE ALL ON TABLE tsearch FROM postgrest_test;
+GRANT ALL ON TABLE tsearch TO postgrest_test;
+GRANT ALL ON TABLE tsearch TO postgrest_anonymous;
+
+REVOKE ALL ON TABLE materialized_view FROM PUBLIC;
+REVOKE ALL ON TABLE materialized_view FROM postgrest_test;
+GRANT ALL ON TABLE materialized_view TO postgrest_test;
+GRANT ALL ON TABLE materialized_view TO postgrest_anonymous;
+
+REVOKE ALL ON TABLE insertable_view_with_join FROM PUBLIC;
+REVOKE ALL ON TABLE insertable_view_with_join FROM postgrest_test;
+GRANT ALL ON TABLE insertable_view_with_join TO postgrest_test;
+GRANT ALL ON TABLE insertable_view_with_join TO postgrest_anonymous;
+
+REVOKE ALL ON TABLE has_count_column FROM PUBLIC;
+REVOKE ALL ON TABLE has_count_column FROM postgrest_test;
+GRANT ALL ON TABLE has_count_column TO postgrest_test;
+GRANT ALL ON TABLE has_count_column TO postgrest_anonymous;
+
+REVOKE ALL ON FUNCTION public.always_true("1".items) FROM PUBLIC;
+REVOKE ALL ON FUNCTION public.always_true("1".items) FROM postgrest_test;
+GRANT ALL ON FUNCTION public.always_true("1".items) TO postgrest_test;
+GRANT ALL ON FUNCTION public.always_true("1".items) TO postgrest_anonymous;
+
+
 SET search_path = postgrest, pg_catalog;
 
---
--- TOC entry 2334 (class 0 OID 0)
--- Dependencies: 202
--- Name: auth; Type: ACL; Schema: postgrest; Owner: postgrest_test
---
 
 REVOKE ALL ON TABLE auth FROM PUBLIC;
 REVOKE ALL ON TABLE auth FROM postgrest_test;
@@ -822,20 +636,7 @@ GRANT INSERT ON TABLE auth TO postgrest_anonymous;
 
 SET search_path = private, pg_catalog;
 
---
--- TOC entry 2335 (class 0 OID 0)
--- Dependencies: 203
--- Name: articles; Type: ACL; Schema: private; Owner: postgrest_test
---
 
 REVOKE ALL ON TABLE articles FROM PUBLIC;
 REVOKE ALL ON TABLE articles FROM postgrest_test;
 GRANT ALL ON TABLE articles TO postgrest_test;
-
-
--- Completed on 2014-10-21 15:12:44 PDT
-
---
--- PostgreSQL database dump complete
---
-