v0.3.0.1

bugfix + Disambiguate range selection when plurality=singular

CHANGELOG.md

@@ -3,6 +3,41 @@
 All notable changes to this project will be documented in this file.
 This project adheres to [Semantic Versioning](http://semver.org/).
 
+## [0.3.0.1] - 2015-11-27
+
+### Fixed
+- Filter columns on embedded parent items - @ruslantalpa
+
+## [0.3.0.0] - 2015-11-24
+
+### Fixed
+- Use reasonable amount of memory during bulk inserts - @begriffs
+
+### Added
+- Ensure JWT expires - @calebmer
+- Postgres connection string argument - @calebmer
+- Encode JWT for procs that return type `jwt_claims` - @diogob
+- Full text operators `@>`,`<@` - @ruslantalpa
+- Shaping of the response body (filter columns, embed relations) with &select parameter for POST/PATCH - @ruslantalpa
+- Detect relationships between public views and private tables - @calebmer
+- `Prefer: plurality=singular` for selecting single objects - @calebmer
+
+### Removed
+- API versioning feature - @calebmer
+- `--db-x` command line arguments - @calebmer
+- Secure flag - @calebmer
+- PUT request handling - @ruslantalpa
+
+### Changed
+- Embed foreign keys with {} rather than () - @begriffs
+- Remove version number from binary filename in release - @begriffs
+
+## [0.2.12.1] - 2015-11-12
+
+### Fixed
+- Correct order for -> and ->> in a json path - @ruslantalpa
+- Return empty array instead of 500 when a set returning function returns an empty result set - @diogob
+
 ## [0.2.12.0] - 2015-10-25
 
 ### Added

README.md

@@ -10,7 +10,8 @@ PostgREST serves a fully RESTful API from any existing PostgreSQL
 database. It provides a cleaner, more standards-compliant, faster
 API than you are likely to write from scratch.
 
-### Demo [postgrest.herokuapp.com](https://postgrest.herokuapp.com) | Watch [Video](http://begriffs.com/posts/2014-12-30-intro-to-postgrest.html) | [GUI Demo](http://marmelab.com/ng-admin-postgrest)
+### Demo [postgrest.herokuapp.com](https://postgrest.herokuapp.com) | Read [Docs](http://postgrest.com/) | Watch [Video](http://begriffs.com/posts/2014-12-30-intro-to-postgrest.html)
+
 
 Try making requests to the live demo server with an HTTP client
 such as [postman](http://www.getpostman.com/). The structure of the
@@ -19,33 +20,39 @@ demo database is defined by
 You can use it as inspiration for test-driven server migrations in
 your own projects.
 
+Also try other tools in the PostgREST
+[ecosystem](http://postgrest.com/install/ecosystem/) like the
+[ng-admin demo](http://marmelab.com/ng-admin-postgrest).
+
 ### Usage
 
-Download the binary ([latest release](https://github.com/begriffs/postgrest/releases/latest)) and invoke like so:
+1. Download the binary ([latest release](https://github.com/begriffs/postgrest/releases/latest))
+   for your platform.
+2. Invoke like so:
 
-```bash
+    ```bash
-postgrest  --db-host localhost  --db-port 5432     \
+    postgrest postgres://postgres:foobar@localhost:5432/my_db \
-           --db-name my_db      --db-user postgres \
+              --port 3000 \
-           --db-pass foobar     --db-pool 200      \
+              --schema public \
-           --anonymous postgres --port 3000        \
+              --anonymous postgres \
-           --v1schema public
+              --pool 200
-```
+    ```
 
-In production include the `--secure` option which redirects all
+For more information on valid connection strings see the
-requests to HTTPS. Note that PostgREST does not handle the SSL
+[PostgreSQL docs](http://www.postgresql.org/docs/9.4/static/libpq-connect.html#LIBPQ-CONNSTRING).
-internally and must be put behind another server that does (such
-as nginx or the Heroku load balancer).
 
 ### Performance
 
-TLDR; subsecond response times for up to 2000 requests/sec on Heroku free tier. ([see the load test](https://github.com/begriffs/postgrest/wiki/Performance-and-Scaling))
+TLDR; subsecond response times for up to 2000 requests/sec on Heroku
+free tier. ([see the load
+test](http://postgrest.com/admin/performance/#benchmarks))
 
 If you're used to servers written in interpreted languages (or named
 after precious gems), prepare to be pleasantly surprised by PostgREST
 performance.
 
 Three factors contribute to the speed. First the server is written
-in [Haskell](https://new-www.haskell.org/) using the
+in [Haskell](https://www.haskell.org/) using the
 [Warp](http://www.yesodweb.com/blog/2011/03/preliminary-warp-cross-language-benchmarks)
 HTTP server (aka a compiled language with lightweight threads).
 Next it delegates as much calculation as possible to the database
@@ -63,60 +70,64 @@ by
 
 * Reusing prepared statements
 * Keeping a pool of db connections
-* Using the Postgres binary protocol
+* Using the PostgreSQL binary protocol
 * Being stateless to allow horizontal scaling
 
 Ultimately the server (when load balanced) is constrained by database
 performance. This may make it inappropriate for very large traffic
 load. To learn more about scaling with Heroku and Amazon RDS see
-the [performance guide](https://github.com/begriffs/postgrest/wiki/Performance-and-Scaling).
+the [performance guide](http://postgrest.com/admin/performance/).
+Alternatively [CitusDB](https://www.citusdata.com/products/what-is-citusdb)
+supports Postgres clustering for higher performance.
 
 Other optimizations are possible, and some are outlined in the
 [Future Features](#future-features).
 
 ### Security
 
-PostgREST handles authentication (HTTP Basic over SSL or [JSON Web
+PostgREST handles authentication (via [JSON Web
-Tokens](https://github.com/begriffs/postgrest/wiki/Security-and-Permissions#json-web-tokens))
+Tokens](http://postgrest.com/admin/security/#json-web-tokens))
 and delegates authorization to the role information defined in the
 database. This ensures there is a single declarative source of truth
 for security.  When dealing with the database the server assumes
 the identity of the currently authenticated user, and for the
 duration of the connection cannot do anything the user themselves
-couldn't.
+couldn't. Other forms of authentication can be built on top
+of the JWT primitive. See the docs for more information.
 
-Postgres 9.5 will soon support true [row-level
+PostgreSQL 9.5 supports true [row-level
-security](http://michael.otacoo.com/postgresql-2/postgres-9-5-feature-highlight-row-level-security/).
+security](http://www.postgresql.org/docs/9.5/static/ddl-rowsecurity.html).
-In the meantime what isn't yet implemented can be simulated with
+In previous versions it can be simulated with triggers and
-triggers and security-barrier views. Because the possible queries
+security-barrier views. Because the possible queries to the database
-to the database are limited to certain templates using
+are limited to certain templates using
 [leakproof](http://blog.2ndquadrant.com/how-do-postgresql-security_barrier-views-work/)
 functions, the trigger workaround does not compromise row-level
 security.
 
 For example security patterns see the [security
-guide](https://github.com/begriffs/postgrest/wiki/Security-and-Permissions).
+guide](http://postgrest.com/admin/security/).
 
 ### Versioning
 
 A robust long-lived API needs the freedom to exist in multiple
-versions. PostgREST supports versioning through HTTP content
+versions. PostgREST does versioning through database schemas. This
-negotiation. Requests for a certain version translate into switching
+allows you to expose tables and views without making the app brittle.
-which database schema to search for tables. PostgreSQL schema search
+Underlying tables can be superseded and hidden behind public facing
-paths allow tables from earlier versions to be reused verbatim in
+views. You run an instance of PostgREST per schema and route requests
-later versions.
+among them with a reverse proxy such as [nginx](http://nginx.org).
-
+Learn more [here](http://postgrest.com/admin/versioning/).
-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.
+as the data format of their JSON payload. RAML support is an upcoming
+feature.
 
-The number of rows returned by an endpoint is reported by - and
+The project uses HTTP itself to commicate other metadata. For
-limited with - range headers. More about
+instance the number of rows returned by an endpoint is reported by -
+and limited with - range headers. More about
 [that](http://begriffs.com/posts/2014-03-06-beyond-http-header-links.html).
 
 There are more opportunities for self-documentation listed in [Future
@@ -132,9 +143,9 @@ data (including your API server).
 The PostgREST exposes HTTP interface with safeguards to prevent
 surprises, such as enforcing idempotent PUT requests, and
 
-See examples of [Postgres
+See examples of [PostgreSQL
 constraints](http://www.tutorialspoint.com/postgresql/postgresql_constraints.htm)
-and the [guide to routing](https://github.com/begriffs/postgrest/wiki/Routing).
+and the [guide to routing](http://postgrest.com/api/reading/).
 
 ### Future Features
 
@@ -147,31 +158,14 @@ and the [guide to routing](https://github.com/begriffs/postgrest/wiki/Routing).
 * 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
 
-* [Ruslan Talpa](https://github.com/ruslantalpa) for rewriting the
+I'm grateful to the generous project
-  route parsing and query generation code to support resource embedding
+[contributors](https://github.com/begriffs/postgrest/graphs/contributors)
-* [Adam Baker](https://github.com/adambaker) for code
+who have improved PostgREST immensely with their code and good
-  contributions and many fundamental design discussions
+judgement.  See more details in the
-* [Diogo Biazus](https://github.com/diogob) for many improvements
+[changelog](https://github.com/begriffs/postgrest/blob/master/CHANGELOG.md).
-  and deep postgresql knowledge
+
-* [Nikita Volkov](https://github.com/nikita-volkov) for writing the
+The cool logo came from [Mikey Casalaina](https://github.com/casalaina).
-  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

@@ -10,7 +10,7 @@
     },
     "POSTGREST_VER": {
       "description": "Version of PostgREST to deploy",
-      "value": "0.2.12.0"
+      "value": "0.3.0.1"
     },
     "DB_NAME": {
       "description": "Database name",

circle.yml

@@ -3,7 +3,7 @@ machine:
     - createuser --superuser --no-password postgrest_test
     - createdb -O postgrest_test -U ubuntu postgrest_test
   ghc:
-    version: 7.8.3
+    version: 7.10.1
 dependencies:
   override:
     - cabal update

debian/postgrest.default

@@ -7,17 +7,23 @@
 # database host
 #POSTGREST_DBHOST=localhost
 
+# database host
+#POSTGREST_DBPORT=5432
+
 # database to use
-#POSTGREST_DBNAME=
+#POSTGREST_DBNAME=app
 
 # database user
-#POSTGREST_DBUSER=postgres
+#POSTGREST_DBUSER=authenticator
 
 # database password
 #POSTGREST_DBPASS=
 
 # database pool
-#POSTGREST_DBPOOL=10
+#POSTGREST_POOL=10
 
-# additional options
+# jwt secret
-#POSTGREST_OPTS=
+#POSTGREST_JWT_SECRET=secret
+
+# default schema
+#POSTGREST_SCHEMA=public

debian/postgrest.init.d

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

docs/install/server.md

@@ -7,7 +7,7 @@ The [release page](https://github.com/begriffs/postgrest/releases/latest) has pr
 ```sh
 # Untar the release (available at https://github.com/begriffs/postgrest/releases/latest)
 
-$ tar zxf postgrest-0.2.12.0-osx.tar.xz
+$ tar zxf postgrest-[version]-[platform].tar.xz
 
 # Try running it
 $ ./postgrest
@@ -22,13 +22,13 @@ $ ./postgrest
 
     <ul><li>Scientific Linux 6</li><li>CentOS</li><li>RHEL 6</li></ul>
 
-    Also it would be good to create packages for Homebrew, and apt.</p>
+    Also it would be good to create a package for apt.</p>
 </div>
 
 We'll learn the meaning of the command line flags later, but here is a minimal example of running the app. It does all operations as user `postgres`, including for unauthenticated requests.
 
 ```sh
-$ ./postgrest -d dbname -U postgres --a postgres --v1schema public
+$ ./postgrest -d dbname -U postgres -a postgres --v1schema public
 ```
 
 ### Building from Source
@@ -36,27 +36,54 @@ $ ./postgrest -d dbname -U postgres --a postgres --v1schema public
 When a prebuilt binary does not exist for your system you can build the project from source. You'll also need to do this if you want to help with development. [Stack](https://github.com/commercialhaskell/stack) makes it easy. It will install any necessary Haskell dependencies on your system.
 
 * [Install Stack](https://github.com/commercialhaskell/stack#how-to-install) for your platform
-* Build the project
+```bash
+#ubuntu example
+wget -q -O- https://s3.amazonaws.com/download.fpcomplete.com/ubuntu/fpco.key | sudo apt-key add -
+echo 'deb http://download.fpcomplete.com/ubuntu/trusty stable main'|sudo tee /etc/apt/sources.list.d/fpco.list
+sudo apt-get update && sudo apt-get install stack -y
+```
+* Build & install in one step
 
 ```bash
 git clone https://github.com/begriffs/postgrest.git
 cd postgrest
-stack build
+sudo stack install --install-ghc --local-bin-path /usr/local/bin
 ```
 
 * Run the server
 
 ```bash
-stack exec postgrest -- arg1 arg2
+postgrest dbconnectionstring arg1 arg2
-# ... your arguments after the double dashes
 ```
 
 If you want to run the test suite, stack can do that too: `stack test`.
 
+### Install via Homebrew (Mac OS X)
+
+You can use the Homebrew package manager to install PostgREST on Mac
+
+```bash
+# Ensure brew is up to date
+brew update
+
+# Check for any problems with brew's setup
+brew doctor
+
+# Install the postgrest package
+brew install postgrest
+```
+
+This will automatically install PostgreSQL as a dependency (see the [Installing PostgreSQL](#installing-postgresql) section for setup instructions). The process tends to take around 15 minutes to install the package and its dependencies.
+
+After installation completes, the tool is added to your $PATH and can be used from anywhere with:
+
+```bash
+postgrest --help
+```
+
 ### Installing PostgreSQL
 
 To use PostgREST you will need an underlying database. You can use something like Amazon [RDS](https://aws.amazon.com/rds/) but installing your own locally is cheaper and more convenient for development.
 
 * [Instructions for OS X](http://exponential.io/blog/2015/02/21/install-postgresql-on-mac-os-x-via-brew/)
 * [Instructions for Ubuntu 14.04](https://www.digitalocean.com/community/tutorials/how-to-install-and-use-postgresql-on-ubuntu-14-04)
-

postgrest.cabal

@@ -2,7 +2,7 @@ name:                  postgrest
 description:           Reads the schema of a PostgreSQL database and creates RESTful routes
                        for the tables and views, supporting all HTTP verbs that security
                        permits.
-version:               0.2.12.0
+version:               0.3.0.1
 synopsis:              REST API for any Postgres database
 license:               MIT
 license-file:          LICENSE
@@ -22,10 +22,15 @@ Flag CI
   Default:     False
 
 executable postgrest
+  if flag(ci)
+    ghc-options:       -Wall -W -Werror
+  else
+    ghc-options:       -Wall -W -O2
+
   main-is:             PostgREST/Main.hs
   default-extensions:  OverloadedStrings, ScopedTypeVariables, QuasiQuotes
   default-language:    Haskell2010
-  build-depends:       base >=4.6 && <5
+  build-depends:       base >= 4.8 && < 5
                      , postgrest
                      , hasql >= 0.7.3 && < 0.8
                      , hasql-backend >= 0.4.1 && < 0.5
@@ -37,6 +42,7 @@ executable postgrest
                      , case-insensitive
                      , scientific, time
                      , aeson >= 0.8, network >= 2.6
+                     , aeson-pretty >= 0.7 && < 0.8
                      , bytestring, text, split, string-conversions
                      , stringsearch
                      , containers, unordered-containers
@@ -56,6 +62,18 @@ executable postgrest
                      , errors
                      , bifunctors
   hs-source-dirs:      src
+  other-modules:       Paths_postgrest
+                     , PostgREST.App
+                     , PostgREST.Auth
+                     , PostgREST.Config
+                     , PostgREST.Error
+                     , PostgREST.Middleware
+                     , PostgREST.Parsers
+                     , PostgREST.DbStructure
+                     , PostgREST.QueryBuilder
+                     , PostgREST.RangeQuery
+                     , PostgREST.ApiRequest
+                     , PostgREST.Types
 
 library
   if flag(ci)
@@ -65,47 +83,61 @@ library
 
   default-language:    Haskell2010
   default-extensions:  OverloadedStrings, ScopedTypeVariables, QuasiQuotes
-  build-depends:       base >=4.6 && <5
+  build-depends:       HTTP
-                     , hasql, hasql-backend
+                     , MissingH
-                     , 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
+                     , aeson
-                     , bcrypt, base64-string
+                     , base >=4.6 && <5
-                     , network-uri
+                     , base64-string
-                     , resource-pool
+                     , bcrypt
-                     , blaze-builder
-                     , vector
-                     , mtl
-                     , cassava
-                     , jwt
-                     , parsec
-                     , errors
                      , bifunctors
+                     , blaze-builder
+                     , bytestring
+                     , case-insensitive
+                     , cassava
+                     , containers
+                     , convertible
+                     , errors
+                     , hasql
+                     , hasql-backend
+                     , hasql-postgres
+                     , http-types
+                     , jwt
+                     , mtl
+                     , network
+                     , network-uri
+                     , optparse-applicative
+                     , parsec
+                     , regex-base
+                     , regex-tdfa
+                     , resource-pool
+                     , scientific
+                     , split
+                     , string-conversions
+                     , stringsearch
+                     , text
+                     , time
+                     , transformers
+                     , unordered-containers
+                     , vector
+                     , wai
+                     , wai-cors
+                     , wai-extra
+                     , wai-middleware-static
+                     , warp
 
   Other-Modules:       Paths_postgrest
   Exposed-Modules:     PostgREST.App
-                     , PostgREST.Types
-                     , PostgREST.Parsers
-                     , PostgREST.QueryBuilder
                      , PostgREST.Auth
                      , PostgREST.Config
                      , PostgREST.Error
                      , PostgREST.Middleware
-                     , PostgREST.PgQuery
+                     , PostgREST.Parsers
-                     , PostgREST.PgStructure
+                     , PostgREST.DbStructure
+                     , PostgREST.QueryBuilder
                      , PostgREST.RangeQuery
+                     , PostgREST.ApiRequest
+                     , PostgREST.Types
   hs-source-dirs:      src
 
 Test-Suite spec
@@ -118,21 +150,29 @@ Test-Suite spec
   else
     ghc-options:       -Wall -W -O2
   Main-Is:             Main.hs
-  Other-Modules:       PostgREST.App
+  Other-Modules:       Feature.AuthSpec
-                     , PostgREST.Types
+                     , Feature.CorsSpec
-                     , PostgREST.Parsers
+                     , Feature.DeleteSpec
-                     , PostgREST.QueryBuilder
+                     , Feature.InsertSpec
+                     , Feature.QuerySpec
+                     , Feature.RangeSpec
+                     , Feature.StructureSpec
+                     , Paths_postgrest
+                     , PostgREST.App
                      , PostgREST.Auth
                      , PostgREST.Config
                      , PostgREST.Error
                      , PostgREST.Middleware
-                     , PostgREST.PgQuery
+                     , PostgREST.Parsers
-                     , PostgREST.PgStructure
+                     , PostgREST.DbStructure
+                     , PostgREST.QueryBuilder
                      , PostgREST.RangeQuery
+                     , PostgREST.ApiRequest
+                     , PostgREST.Types
                      , Spec
                      , SpecHelper
-                     , Paths_postgrest
+                     , TestTypes
-  Build-Depends:       base, hspec == 2.1.*, QuickCheck
+  Build-Depends:       base, hspec == 2.2.*, QuickCheck
                      , hspec-wai, hspec-wai-json
                      , hasql, hasql-backend
                      , hasql-postgres

schema-templates/blog.sql

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

src/PostgREST/ApiRequest.hs

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

src/PostgREST/App.hs

@@ -1,409 +1,322 @@
 {-# LANGUAGE FlexibleContexts    #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TupleSections #-}
+--module PostgREST.App where
 module PostgREST.App (
   app
-, sqlError
-, isSqlError
-, contentTypeForAccept
-, jsonH
-, requestedSchema
-, TableOptions(..)
 ) where
 
-import qualified Blaze.ByteString.Builder  as BB
 import           Control.Applicative
-import           Control.Arrow             (second, (***))
+import           Control.Arrow             ((***))
 import           Control.Monad             (join)
 import           Data.Bifunctor            (first)
-import qualified Data.ByteString.Char8     as BS
 import qualified Data.ByteString.Lazy      as BL
-import           Data.CaseInsensitive      (original)
-import qualified Data.Csv                  as CSV
 import           Data.Functor.Identity
-import qualified Data.HashMap.Strict       as M
+import           Data.List                 (find, sortBy, delete)
-import           Data.List                 (find, sortBy)
+import           Data.Maybe                (fromMaybe, fromJust, mapMaybe)
-import           Data.Maybe                (fromMaybe, isJust, isNothing,
-                                            mapMaybe)
 import           Data.Ord                  (comparing)
 import           Data.Ranged.Ranges        (emptyRange)
-import qualified Data.Set                  as S
 import           Data.String.Conversions   (cs)
 import           Data.Text                 (Text, replace, strip)
-import           Text.Regex.TDFA           ((=~))
+import           Data.Tree
 
 import           Text.Parsec.Error
+import           Text.ParserCombinators.Parsec (parse)
 
 import           Network.HTTP.Base         (urlEncodeVars)
 import           Network.HTTP.Types.Header
 import           Network.HTTP.Types.Status
 import           Network.HTTP.Types.URI    (parseSimpleQuery)
 import           Network.Wai
-import           Network.Wai.Internal      (Response (..))
-import           Network.Wai.Parse         (parseHttpAccept)
 
 import           Data.Aeson
+import           Data.Aeson.Types (emptyArray)
 import           Data.Monoid
 import qualified Data.Vector               as V
 import qualified Hasql                     as H
 import qualified Hasql.Backend             as B
 import qualified Hasql.Postgres            as P
 
-import           PostgREST.Auth
 import           PostgREST.Config          (AppConfig (..))
 import           PostgREST.Parsers
-import           PostgREST.PgQuery
+import           PostgREST.DbStructure
-import           PostgREST.PgStructure
-import           PostgREST.QueryBuilder
 import           PostgREST.RangeQuery
+import           PostgREST.ApiRequest   (ApiRequest(..), ContentType(..)
+                                            , Action(..), Target(..)
+                                            , userApiRequest)
 import           PostgREST.Types
+import           PostgREST.Auth            (tokenJWT)
+import           PostgREST.Error           (errResponse)
+
+import           PostgREST.QueryBuilder ( asJson
+                                        , callProc
+                                        , addJoinConditions
+                                        , sourceSubqueryName
+                                        , requestToQuery
+                                        , addRelations
+                                        , createReadStatement
+                                        , createWriteStatement
+                                        )
 
 import           Prelude
 
-app :: DbStructure -> AppConfig -> BL.ByteString -> DbRole -> Request -> H.Tx P.Postgres s Response
+app :: DbStructure -> AppConfig -> RequestBody -> Request -> H.Tx P.Postgres s Response
-app dbstructure conf reqBody dbrole req =
+app dbStructure conf reqBody req =
-  case (path, verb) of
+  let
+      -- TODO: blow up for Left values (there is a middleware that checks the headers)
+      contentType = either (const ApplicationJSON) id (iAccepts apiRequest)
+      contentTypeH = (hContentType, cs $ show contentType) in
 
-    ([], _) -> do
+  case (iAction apiRequest, iTarget apiRequest, iPayload apiRequest) of
-      let body = encode $ filter (filterTableAcl dbrole) $ filter ((cs schema==).tableSchema) allTabs
-      return $ responseLBS status200 [jsonH] $ cs body
 
-    ([table], "OPTIONS") -> do
+    (ActionRead, TargetIdent qi, Nothing) ->
-      let cols = filter (filterCol schema table) allCols
+      case selectQuery of
-          pkeys = map pkName $ filter (filterPk schema table) allPrKeys
+        Left e -> return $ responseLBS status400 [jsonH] $ cs e
+        Right q -> do
+          let range = iRange apiRequest
+              singular = iPreferSingular apiRequest
+              stm = createReadStatement q range singular
+                    (iPreferCount apiRequest) (contentType == TextCSV)
+          if range == Just emptyRange
+          then return $ errResponse status416 "HTTP Range error"
+          else do
+            row <- H.maybeEx stm
+            let (tableTotal, queryTotal, _ , body) = extractQueryResult row
+            if singular
+            then return $ if queryTotal <= 0
+              then responseLBS status404 [] ""
+              else responseLBS status200 [contentTypeH] (fromMaybe "{}" body)
+            else do
+              let frm = fromMaybe 0 $ rangeOffset <$> range
+                  to = frm+queryTotal-1
+                  contentRange = contentRangeH frm to tableTotal
+                  status = rangeStatus frm to tableTotal
+                  canonical = urlEncodeVars -- should this be moved to the dbStructure (location)?
+                    . sortBy (comparing fst)
+                    . map (join (***) cs)
+                    . parseSimpleQuery
+                    $ rawQueryString req
+              return $ responseLBS status
+                [contentTypeH, contentRange,
+                  ("Content-Location",
+                    "/" <> cs (qiName qi) <>
+                      if Prelude.null canonical then "" else "?" <> cs canonical
+                  )
+                ] (fromMaybe "[]" body)
+
+    (ActionCreate, TargetIdent (QualifiedIdentifier _ table),
+     Just payload@(PayloadJSON (UniformObjects rows))) ->
+      case queries of
+        Left e -> return $ responseLBS status400 [jsonH] $ cs e
+        Right (sq,mq) -> do
+          let isSingle = (==1) $ V.length rows
+          let pKeys = map pkName $ filter (filterPk schema table) allPrKeys -- would it be ok to move primary key detection in the query itself?
+          let stm = createWriteStatement sq mq isSingle (iPreferRepresentation apiRequest) pKeys (contentType == TextCSV) payload
+          row <- H.maybeEx stm
+          let (_, _, location, body) = extractQueryResult row
+          return $ responseLBS status201
+            [
+              contentTypeH,
+              (hLocation, "/" <> cs table <> "?" <> cs (fromMaybe "" location))
+            ]
+            $ if iPreferRepresentation apiRequest then fromMaybe "[]" body else ""
+
+    (ActionUpdate, TargetIdent _, Just payload@(PayloadJSON _)) ->
+      case queries of
+        Left e -> return $ responseLBS status400 [jsonH] $ cs e
+        Right (sq,mq) -> do
+          let stm = createWriteStatement sq mq False (iPreferRepresentation apiRequest) [] (contentType == TextCSV) payload
+          row <- H.maybeEx stm
+          let (_, queryTotal, _, body) = extractQueryResult row
+              r = contentRangeH 0 (queryTotal-1) (Just queryTotal)
+              s = case () of _ | queryTotal == 0 -> status404
+                               | iPreferRepresentation apiRequest -> status200
+                               | otherwise -> status204
+          return $ responseLBS s [contentTypeH, r]
+            $ if iPreferRepresentation apiRequest then fromMaybe "[]" body else ""
+
+    (ActionDelete, TargetIdent _, Nothing) ->
+      case queries of
+        Left e -> return $ responseLBS status400 [jsonH] $ cs e
+        Right (sq,mq) -> do
+          let fakeload = PayloadJSON $ UniformObjects V.empty
+          let stm = createWriteStatement sq mq False False [] (contentType == TextCSV) fakeload
+          row <- H.maybeEx stm
+          let (_, queryTotal, _, _) = extractQueryResult row
+          return $ if queryTotal == 0
+            then notFound
+            else responseLBS status204 [("Content-Range", "*/"<> cs (show queryTotal))] ""
+
+    (ActionInfo, TargetIdent (QualifiedIdentifier tSchema tTable), Nothing) -> do
+      let cols = filter (filterCol tSchema tTable) $ dbColumns dbStructure
+          pkeys = map pkName $ filter (filterPk tSchema tTable) allPrKeys
           body = encode (TableOptions cols pkeys)
+          filterCol :: Schema -> TableName -> Column -> Bool
+          filterCol sc tb (Column{colTable=Table{tableSchema=s, tableName=t}}) = s==sc && t==tb
+          filterCol _ _ _ =  False
       return $ responseLBS status200 [jsonH, allOrigins] $ cs body
 
-    ([table], "GET") ->
+    (ActionInvoke, TargetIdent qi,
-      if range == Just emptyRange
+     Just (PayloadJSON (UniformObjects payload))) -> do
-      then return $ responseLBS status416 [] "HTTP Range error"
+      exists <- doesProcExist qi
-      else
-        case queries of
-          Left e -> return $ responseLBS status400 [("Content-Type", "application/json")] $ cs e
-          Right (qs, cqs) -> do
-            let qt = qualify table
-                count = if hasPrefer "count=none"
-                      then countNone
-                      else cqs
-                q = B.Stmt "select " V.empty True <>
-                    parentheticT count
-                    <> commaq <> (
-                    bodyForAccept contentType qt -- TODO! when in csv mode, the first row (columns) is not correct when requesting sub tables
-                    . limitT range
-                    $ qs
-                  )
-            row <- H.maybeEx q
-            let (tableTotal, queryTotal, body) = fromMaybe (Just (0::Int), 0::Int, Just "" :: Maybe BL.ByteString) 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
-                )
-              ] (fromMaybe "[]" body)
-
-        where
-            from = fromMaybe 0 $ rangeOffset <$> range
-            apiRequest = first formatParserError (parseGetRequest req)
-                     >>= first formatRelationError . addRelations schema allRels Nothing
-                     >>= addJoinConditions schema allCols
-                     where
-                       formatRelationError :: Text -> Text
-                       formatRelationError e = cs $ encode $ object [
-                         "mesage" .= ("could not find foreign keys between these entities"::String),
-                         "details" .= e]
-                       formatParserError :: ParseError -> Text
-                       formatParserError e = cs $ encode $ object [
-                         "message" .= message,
-                         "details" .= details]
-                         where
-                           message = show (errorPos e)
-                           details = strip $ replace "\n" " " $ cs
-                             $ showErrorMessages "or" "unknown parse error" "expecting" "unexpected" "end of input" (errorMessages e)
-
-            query = requestToQuery schema <$> apiRequest
-            countQuery = requestToCountQuery schema <$> apiRequest
-            queries = (,) <$> query <*> countQuery
-
-
-    (["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 = hasPrefer "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
-              pKeys = map pkName $ filter (filterPk schema table) allPrKeys
-              responses = flip map inserted $ \obj -> do
-                let primaries =
-                      if Prelude.null pKeys
-                        then obj
-                        else M.filterWithKey (const . (`elem` pKeys)) 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 <>
+          let p = V.head payload
-                asJson (callProc qi $ fromMaybe M.empty (decode reqBody))
+              call = B.Stmt "select " V.empty True <>
-          body :: Maybe (Identity Text) <- H.maybeEx call
+                asJson (callProc qi p)
+              jwtSecret = configJwtSecret conf
+
+          bodyJson :: Maybe (Identity Value) <- H.maybeEx call
+          returnJWT <- doesProcReturnJWT qi
           return $ responseLBS status200 [jsonH]
-            (cs $ fromMaybe "[]" $ runIdentity <$> body)
+                 (let body = fromMaybe emptyArray $ runIdentity <$> bodyJson in
-        else return $ responseLBS status404 [] ""
+                    if returnJWT
+                    then "{\"token\":\"" <> cs (tokenJWT jwtSecret body) <> "\"}"
+                    else cs $ encode body)
+        else return notFound
 
-      -- check that proc exists
+    (ActionRead, TargetRoot, Nothing) -> do
-      -- check that arg names are all specified
+      body <- encode <$> accessibleTables (filter ((== cs schema) . tableSchema) (dbTables dbStructure))
-      -- select * from "1".proc(a := "foo"::undefined) where whereT limit limitT
+      return $ responseLBS status200 [jsonH] $ cs body
 
-    ([table], "PUT") ->
+    (ActionUnknown _, _, _) -> return notFound
-      handleJsonObj reqBody $ \obj -> do
-        let qt = qualify table
-            pKeys = map pkName $ filter (filterPk schema table) allPrKeys
-            specifiedKeys = map (cs . fst) qq
-        if S.fromList pKeys /= S.fromList specifiedKeys
-          then return $ responseLBS status405 []
-            "You must speficy all and only primary keys as params"
-          else do
-            let tableCols = map (cs . colName) $ filter (filterCol schema table) allCols
-                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
+    (_, TargetUnknown _, _) -> return notFound
-                then responseLBS status404 [] ""
-                else responseLBS status400 []
-                  "You must specify all columns in PUT request"
 
-    ([table], "PATCH") ->
+    (_, _, Just (PayloadParseError e)) ->
-      handleJsonObj reqBody $ \obj -> do
+      return $ responseLBS status400 [jsonH] $
-        let qt = qualify table
+        cs (formatGeneralError "Cannot parse request payload" (cs e))
-            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
+    (_, _, _) -> return notFound
-        let (queryTotal, body) =
-              fromMaybe (0 :: Int, Just "" :: Maybe Text) row
-            r = contentRangeH 0 (queryTotal-1) (Just queryTotal)
-            echoRequested = hasPrefer "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
+ where
-      let qt = qualify table
+  notFound = responseLBS status404 [] ""
-          del = countT
+  filterPk sc table pk = sc == (tableSchema . pkTable) pk && table == (tableName . pkTable) pk
-            . returningStarT
+  allPrKeys = dbPrimaryKeys dbStructure
-            . whereT qt qq
+  allOrigins = ("Access-Control-Allow-Origin", "*") :: Header
-            $ deleteFrom qt
+  schema = cs $ configSchema conf
-      row <- H.maybeEx del
+  apiRequest = userApiRequest schema req reqBody
-      let (Identity deletedCount) = fromMaybe (Identity 0 :: Identity Int) row
+  selectQuery = requestToQuery schema <$> (DbRead <$> buildReadRequest (dbRelations dbStructure) apiRequest)
-      return $ if deletedCount == 0
+  mutateQuery = requestToQuery schema <$> (DbMutate <$> buildMutateRequest apiRequest)
-        then responseLBS status404 [] ""
+  queries = (,) <$> selectQuery <*> mutateQuery
-        else responseLBS status204 [("Content-Range", "*/"<> cs (show deletedCount))] ""
-
-    (_, _) ->
-      return $ responseLBS status404 [] ""
-
-  where
-    allTabs = tables dbstructure
-    allRels = relations dbstructure
-    allCols = columns dbstructure
-    allPrKeys = primaryKeys dbstructure
-    filterCol sc table (Column{colSchema=s, colTable=t}) =  s==sc && table==t
-    filterCol _ _ _ =  False
-    filterPk sc table pk = sc == pkSchema pk && table == pkTable pk
-
-    filterTableAcl :: Text -> Table -> Bool
-    filterTableAcl r (Table{tableAcl=a}) = r `elem` a
-    path          = pathInfo req
-    verb          = requestMethod req
-    qq            = queryString req
-    qualify       = QualifiedIdentifier schema
-    hdrs          = requestHeaders req
-    lookupHeader  = flip lookup hdrs
-    hasPrefer val = any (\(h,v) -> h == "Prefer" && v == val) 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 -> Maybe Int -> Status
 rangeStatus _ _ Nothing = status200
-rangeStatus from to (Just total)
+rangeStatus frm to (Just total)
-  | from > total            = status416
+  | frm > total            = status416
-  | (1 + to - from) < total = status206
+  | (1 + to - frm) < total = status206
   | otherwise               = status200
 
 contentRangeH :: Int -> Int -> Maybe Int -> Header
-contentRangeH from to total =
+contentRangeH frm to total =
     ("Content-Range", cs headerValue)
     where
       headerValue   = rangeString <> "/" <> totalString
       rangeString
-        | totalNotZero && fromInRange = show from <> "-" <> cs (show to)
+        | totalNotZero && fromInRange = show frm <> "-" <> cs (show to)
         | otherwise = "*"
       totalString   = fromMaybe "*" (show <$> total)
       totalNotZero  = fromMaybe True ((/=) 0 <$> total)
-      fromInRange   = from <= to
+      fromInRange   = frm <= to
-
-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"
-
-allMT :: BS.ByteString
-allMT = "*/*"
 
 jsonH :: Header
-jsonH = (hContentType, jsonMT)
+jsonH = (hContentType, "application/json")
 
-contentTypeForAccept :: Maybe BS.ByteString -> Maybe BS.ByteString
+formatRelationError :: Text -> Text
-contentTypeForAccept accept
+formatRelationError = formatGeneralError
-  | isNothing accept || has allMT || has jsonMT = Just jsonMT
+  "could not find foreign keys between these entities"
-  | has csvMT = Just csvMT
+
+formatParserError :: ParseError -> Text
+formatParserError e = formatGeneralError message details
+  where
+     message = cs $ show (errorPos e)
+     details = strip $ replace "\n" " " $ cs
+       $ showErrorMessages "or" "unknown parse error" "expecting" "unexpected" "end of input" (errorMessages e)
+
+formatGeneralError :: Text -> Text -> Text
+formatGeneralError message details = cs $ encode $ object [
+  "message" .= message,
+  "details" .= details]
+
+augumentRequestWithJoin :: Schema ->  [Relation] ->  ReadRequest -> Either Text ReadRequest
+augumentRequestWithJoin schema allRels request =
+  (first formatRelationError . addRelations schema allRels Nothing) request
+  >>= addJoinConditions schema
+
+buildReadRequest :: [Relation] -> ApiRequest -> Either Text ReadRequest
+buildReadRequest allRels apiRequest  =
+  augumentRequestWithJoin schema rels =<< first formatParserError (foldr addFilter <$> (addOrder <$> readRequest <*> ord) <*> flts)
+  where
+    selStr = iSelect apiRequest
+    orderS = iOrder apiRequest
+    action = iAction apiRequest
+    target = iTarget apiRequest
+    (schema, rootTableName) = fromJust $ -- Make it safe
+      case target of
+        (TargetIdent (QualifiedIdentifier s t) ) -> Just (s, t)
+        _ -> Nothing
+
+    rootName = if action == ActionRead
+      then rootTableName
+      else sourceSubqueryName
+    filters = if action == ActionRead
+      then iFilters apiRequest
+      else filter (( '.' `elem` ) . fst) $ iFilters apiRequest -- there can be no filters on the root table whre we are doing insert/update
+    rels = case action of
+      ActionCreate -> fakeSourceRelations ++ allRels
+      ActionUpdate -> fakeSourceRelations ++ allRels
+      _       -> allRels
+      where fakeSourceRelations = mapMaybe (toSourceRelation rootTableName) allRels -- see comment in toSourceRelation
+    readRequest = parse (pRequestSelect rootName) ("failed to parse select parameter <<"++selStr++">>") selStr
+    addOrder (Node (q,i) f) o = Node (q{order=o}, i) f
+    flts = mapM pRequestFilter filters
+    ord = traverse (parse pOrder ("failed to parse order parameter <<"++fromMaybe "" orderS++">>")) orderS
+
+buildMutateRequest :: ApiRequest -> Either Text MutateRequest
+buildMutateRequest apiRequest =
+  mutateApiRequest
+  where
+    action = iAction apiRequest
+    target = iTarget apiRequest
+    payload = fromJust $ iPayload apiRequest
+    rootTableName = -- TODO: Make it safe
+      case target of
+        (TargetIdent (QualifiedIdentifier _ t) ) -> t
+        _ -> undefined
+    mutateApiRequest = case action of
+      ActionCreate -> Insert rootTableName <$> pure payload
+      ActionUpdate -> Update rootTableName <$> pure payload <*> cond
+      ActionDelete -> Delete rootTableName <$> cond
+      _        -> Left "Unsupported HTTP verb"
+    mutateFilters = filter (not . ( '.' `elem` ) . fst) $ iFilters apiRequest -- update/delete filters can be only on the root table
+    cond = first formatParserError $ map snd <$> mapM pRequestFilter mutateFilters
+
+addFilter :: (Path, Filter) -> ReadRequest -> ReadRequest
+addFilter ([], flt) (Node (q@(Select {flt_=flts}), i) forest) = Node (q {flt_=flt:flts}, i) forest
+addFilter (path, flt) (Node rn forest) =
+  case targetNode of
+    Nothing -> Node rn forest -- the filter is silenty dropped in the Request does not contain the required path
+    Just tn -> Node rn (addFilter (remainingPath, flt) tn:restForest)
+  where
+    targetNodeName:remainingPath = path
+    (targetNode,restForest) = splitForest targetNodeName forest
+    splitForest name forst =
+      case maybeNode of
+        Nothing -> (Nothing,forest)
+        Just node -> (Just node, delete node forest)
+      where maybeNode = find ((name==).fst.snd.rootLabel) forst
+
+-- in a relation where one of the tables mathces "TableName"
+-- replace the name to that table with pg_source
+-- this "fake" relations is needed so that in a mutate query
+-- we can look a the "returning *" part which is wrapped with a "with"
+-- as just another table that has relations with other tables
+toSourceRelation :: TableName -> Relation -> Maybe Relation
+toSourceRelation mt r@(Relation t _ ft _ _ rt _ _)
+  | mt == tableName t = Just $ r {relTable=t {tableName=sourceSubqueryName}}
+  | mt == tableName ft = Just $ r {relFTable=t {tableName=sourceSubqueryName}}
+  | Just mt == (tableName <$> rt) = Just $ r {relLTable=(\tbl -> tbl {tableName=sourceSubqueryName}) <$> rt}
   | otherwise = Nothing
-  where
-    Just acceptH = accept
-    findInAccept = flip find $ parseHttpAccept acceptH
-    has          = isJust . findInAccept . BS.isPrefixOf
-
-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]
@@ -414,3 +327,8 @@ instance ToJSON TableOptions where
   toJSON t = object [
       "columns" .= tblOptcolumns t
     , "pkey"   .= tblOptpkey t ]
+
+
+extractQueryResult :: Maybe (Maybe Int, Int, Maybe BL.ByteString, Maybe BL.ByteString)
+                         -> (Maybe Int, Int, Maybe BL.ByteString, Maybe BL.ByteString)
+extractQueryResult = fromMaybe (Just 0, 0, Just "", Just "")

src/PostgREST/Auth.hs

@@ -1,104 +1,84 @@
-module PostgREST.Auth where
+{-# LANGUAGE FlexibleContexts #-}
+{-|
+Module      : PostgREST.Auth
+Description : PostgREST authorization functions.
 
-import           Control.Applicative
+This module provides functions to deal with the JWT authorization (http://jwt.io).
-import           Control.Monad           (mzero)
+It also can be used to define other authorization functions,
-import           Crypto.BCrypt
+in the future Oauth, LDAP and similar integrations can be coded here.
-import           Data.Aeson
+
-import           Data.Map
+Authentication should always be implemented in an external service.
-import           Data.Monoid
+In the test suite there is an example of simple login function that can be used for a
+very simple authentication system inside the PostgreSQL database.
+-}
+module PostgREST.Auth (
+    setRole
+  , claimsToSQL
+  , jwtClaims
+  , tokenJWT
+  ) where
+
+import           Control.Monad           (join)
+import           Data.Aeson              (Value (..), Object)
+import           Data.Aeson.Types        (emptyObject, emptyArray)
+import           Data.Vector             as V (null, head)
+import           Data.Map                as M (fromList, toList)
+import           Data.Monoid             ((<>))
 import           Data.String.Conversions (cs)
-import           Data.Text
+import           Data.Text               (Text)
-import           Data.Maybe (isNothing)
+import           Data.Time.Clock         (NominalDiffTime)
-import qualified Data.Vector             as V
+import           PostgREST.QueryBuilder  (pgFmtLit, pgFmtIdent, unquoted)
-import qualified Hasql                   as H
-import qualified Hasql.Backend           as B
-import qualified Hasql.Postgres          as P
-import           PostgREST.PgQuery       (pgFmtLit)
-import           Prelude
 import qualified Web.JWT                 as JWT
+import qualified Data.HashMap.Lazy       as H
 
-import           System.IO.Unsafe
+{-|
-
+  Receives a map of JWT claims and returns a list
-data AuthUser = AuthUser {
+  of PostgreSQL statements to set the claims as user defined GUCs.
-    userId   :: String
+  Except if we have a claim called role,
-  , userPass :: String
+  this one is mapped to a SET ROLE statement.
-  , userRole :: Maybe String
+  In case there is any problem decoding the JWT it returns Nothing.
-  } deriving (Show)
+-}
-
+claimsToSQL :: JWT.ClaimsMap -> [Text]
-instance FromJSON AuthUser where
+claimsToSQL = map setVar . toList
-  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 -> Maybe Text -> H.Tx P.Postgres s ()
-addUser identity pass role =
-  H.unitEx $
-    if isNothing role
-      then [H.stmt|insert into postgrest.auth (id, pass) values (?, ?)|]
-        identity hashedText
-      else [H.stmt|insert into postgrest.auth (id, pass, rolname) values (?, ?, ?)|]
-        identity hashedText role
-  where Just hashed = unsafePerformIO $ hashPasswordUsingPolicy fastBcryptHashingPolicy (cs pass)
-        hashedText = cs hashed :: Text
-
-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)
+    setVar ("role", String val) = setRole val
-    maybeUserId = (Data.Map.lookup "id" <$> claims) ::Maybe (Maybe Value)
+    setVar (k, val) = "set local postgrest.claims." <> pgFmtIdent k <>
-    claims = JWT.unregisteredClaims <$> JWT.claims <$> decoded
+                      " = " <> valueToVariable val <> ";"
-    decoded = JWT.decodeAndVerifySignature (JWT.secret secret) input
+    valueToVariable = pgFmtLit . unquoted
 
-tokenJWT :: Text -> Text -> Text -> Text
+{-|
-tokenJWT secret uid role = JWT.encodeSigned JWT.HS256 (JWT.secret secret) claimsSet
+  Receives the JWT secret (from config) and a JWT and
+  returns a map of JWT claims
+  In case there is any problem decoding the JWT it returns Nothing.
+-}
+jwtClaims :: JWT.Secret -> Text -> NominalDiffTime -> Maybe JWT.ClaimsMap
+jwtClaims secret input time =
+  case join $ claim JWT.exp of
+    Just expires ->
+      if JWT.secondsSinceEpoch expires > time
+        then customClaims
+        else Nothing
+    _ -> customClaims
   where
-    claimsSet = JWT.def {
+    decoded = JWT.decodeAndVerifySignature secret input
-      JWT.unregisteredClaims = Data.Map.fromList [("id", String uid), ("role", String role)]
+    claim :: (JWT.JWTClaimsSet -> a) -> Maybe a
-    }
+    claim prop = prop . JWT.claims <$> decoded
+    customClaims = claim JWT.unregisteredClaims
+
+-- | Receives the name of a role and returns a SET ROLE statement
+setRole :: Text -> Text
+setRole role = "set local role " <> cs (pgFmtLit role) <> ";"
+
+
+{-|
+  Receives the JWT secret (from config) and a JWT and a JSON value
+  and returns a signed JWT.
+-}
+tokenJWT :: JWT.Secret -> Value -> Text
+tokenJWT secret (Array a) = JWT.encodeSigned JWT.HS256 secret
+                               JWT.def { JWT.unregisteredClaims = fromHashMap o }
+                          where
+                            Object o = if V.null a then emptyObject else V.head a
+                            fromHashMap :: Object -> JWT.ClaimsMap
+                            fromHashMap = M.fromList . H.toList
+tokenJWT secret _          = tokenJWT secret emptyArray

src/PostgREST/Config.hs

@@ -28,44 +28,35 @@ import           Data.Text                   (strip)
 import           Data.Version                (versionBranch)
 import           Network.Wai
 import           Network.Wai.Middleware.Cors (CorsResourcePolicy (..))
-import           Options.Applicative         hiding (columns)
+import           Options.Applicative
 import           Paths_postgrest             (version)
+import           Web.JWT                     (Secret, secret)
 import           Prelude
 
 -- | Data type to store all command line options
 data AppConfig = AppConfig {
-    configDbName    :: String
+    configDatabase  :: String
-  , configDbPort    :: Int
-  , configDbUser    :: String
-  , configDbPass    :: String
-  , configDbHost    :: String
-
   , configPort      :: Int
   , configAnonRole  :: String
-  , configSecure    :: Bool
+  , configSchema    :: String
+  , configJwtSecret :: Secret
   , configPool      :: Int
-  , configV1Schema  :: String
-  , configJwtSecret :: String
   }
 
 argParser :: Parser AppConfig
 argParser = AppConfig
-  <$> strOption (long "db-name" <> short 'd' <> metavar "NAME" <> help "name of database")
+  <$> argument str (help "database connection string" <> metavar "STRING")
-  <*> 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)
+  <*> option auto  (long "port"       <> short 'p' <> help "port number on which to run HTTP server" <> metavar "PORT" <> value 3000 <> showDefault)
-  <*> strOption (long "anonymous" <> short 'a' <> metavar "ROLE" <> help "postgres role to use for non-authenticated requests")
+  <*> strOption    (long "anonymous"  <> short 'a' <> help "postgres role to use for non-authenticated requests" <> metavar "ROLE")
-  <*> switch (long "secure" <> short 's' <> help "Redirect all requests to HTTPS")
+  <*> strOption    (long "schema"     <> short 's' <> help "schema to use for API routes" <> metavar "NAME" <> value "1" <> showDefault)
-  <*> option auto (long "db-pool" <> metavar "COUNT" <> value 10 <> help "Max connections in database pool" <> showDefault)
+  <*> (secret . cs <$>
-  <*> strOption (long "v1schema" <> metavar "NAME" <> value "1" <> help "Schema to use for nonspecified version (or explicit v1)" <> showDefault)
+      strOption    (long "jwt-secret" <> short 'j' <> help "secret used to encrypt and decrypt JWT tokens" <> metavar "SECRET" <> value "secret" <> showDefault))
-  <*> strOption (long "jwt-secret" <> metavar "SECRET" <> value "secret" <> help "Secret used to encrypt and decrypt JWT tokens)" <> showDefault)
+  <*> option auto  (long "pool"       <> short 'o' <> help "max connections in database pool" <> metavar "COUNT" <> value 10 <> showDefault)
 
 defaultCorsPolicy :: CorsResourcePolicy
 defaultCorsPolicy =  CorsResourcePolicy Nothing
-  ["GET", "POST", "PUT", "PATCH", "DELETE", "OPTIONS"] ["Authorization"] Nothing
+  ["GET", "POST", "PATCH", "DELETE", "OPTIONS"] ["Authorization"] Nothing
   (Just $ 60*60*24) False False True
 
 -- | CORS policy to be used in by Wai Cors middleware

src/PostgREST/DbStructure.hs

@@ -0,0 +1,353 @@
+{-# LANGUAGE FlexibleContexts      #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE QuasiQuotes           #-}
+{-# LANGUAGE ScopedTypeVariables   #-}
+{-# LANGUAGE TypeSynonymInstances  #-}
+module PostgREST.DbStructure (
+  getDbStructure
+, accessibleTables
+, doesProcExist
+, doesProcReturnJWT
+) where
+
+import           Control.Applicative
+import           Control.Monad          (join)
+import           Data.Functor.Identity
+import           Data.List              (elemIndex, find, subsequences, sort, transpose)
+import           Data.Maybe             (fromMaybe, fromJust, isJust, mapMaybe, listToMaybe)
+import           Data.Monoid
+import           Data.Text              (Text, split)
+import qualified Hasql                  as H
+import qualified Hasql.Postgres         as P
+import qualified Hasql.Backend          as B
+import           PostgREST.Types
+
+import           GHC.Exts               (groupWith)
+import           Prelude
+
+getDbStructure :: Schema -> H.Tx P.Postgres s DbStructure
+getDbStructure schema = do
+  tabs <- allTables
+  cols <- allColumns tabs
+  syns <- allSynonyms cols
+  rels <- allRelations tabs cols
+  keys <- allPrimaryKeys tabs
+
+  let rels' = (addManyToManyRelations . raiseRelations schema syns . addParentRelations . addSynonymousRelations syns) rels
+      cols' = addForeignKeys rels' cols
+      keys' = synonymousPrimaryKeys syns keys
+
+  return DbStructure {
+      dbTables = tabs
+    , dbColumns = cols'
+    , dbRelations = rels'
+    , dbPrimaryKeys = keys'
+    }
+
+doesProc :: forall c s. B.CxValue c Int =>
+            (Text -> Text -> B.Stmt c) -> QualifiedIdentifier -> H.Tx c s Bool
+doesProc stmt qi = do
+  row :: Maybe (Identity Int) <- H.maybeEx $ stmt (qiSchema qi) (qiName qi)
+  return $ isJust row
+
+doesProcExist :: QualifiedIdentifier -> H.Tx P.Postgres s Bool
+doesProcExist = doesProc [H.stmt|
+      SELECT 1
+      FROM   pg_catalog.pg_namespace n
+      JOIN   pg_catalog.pg_proc p
+      ON     pronamespace = n.oid
+      WHERE  nspname = ?
+      AND    proname = ?
+    |]
+
+doesProcReturnJWT :: QualifiedIdentifier -> H.Tx P.Postgres s Bool
+doesProcReturnJWT = doesProc [H.stmt|
+      SELECT 1
+      FROM   pg_catalog.pg_namespace n
+      JOIN   pg_catalog.pg_proc p
+      ON     pronamespace = n.oid
+      WHERE  nspname = ?
+      AND    proname = ?
+      AND    pg_catalog.pg_get_function_result(p.oid) like '%jwt_claims'
+    |]
+
+accessibleTables :: [Table] -> H.Tx P.Postgres s [Table]
+accessibleTables allTabs = do
+  accessible <- H.listEx $ [H.stmt|
+      SELECT
+        n.nspname AS table_schema,
+        c.relname AS table_name
+      FROM pg_class c
+      JOIN pg_namespace n ON n.oid = c.relnamespace
+      WHERE
+        c.relkind IN ('v','r','m') AND
+        n.nspname NOT IN ('pg_catalog', 'information_schema') 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 table_schema, table_name
+    |]
+  let isAccessible table = isJust $ find (\(s,n) -> tableSchema table == s && tableName table == n) accessible
+  return $ filter isAccessible allTabs
+
+synonymousColumns :: [(Column,Column)] -> [Column] -> [[Column]]
+synonymousColumns allSyns cols = synCols'
+  where
+    syns = sort $ filter ((== colTable (head cols)) . colTable . fst) allSyns
+    synCols  = transpose $ map (\c -> map snd $ filter ((== c) . fst) syns) cols
+    synCols' = (filter sameTable . filter matchLength) synCols
+    matchLength cs = length cols == length cs
+    sameTable (c:cs) = all (\cc -> colTable c == colTable cc) (c:cs)
+    sameTable [] = False
+
+addForeignKeys :: [Relation] -> [Column] -> [Column]
+addForeignKeys rels = map addFk
+  where
+    addFk col = col { colFK = fk col }
+    fk col = join $ relToFk col <$> find (lookupFn col) rels
+    lookupFn :: Column -> Relation -> Bool
+    lookupFn c (Relation{relColumns=cs, relType=rty}) = c `elem` cs && rty==Child
+    -- lookupFn _ _ = False
+    relToFk col (Relation{relColumns=cols, relFColumns=colsF}) = ForeignKey <$> colF
+      where
+        pos = elemIndex col cols
+        colF = (colsF !!) <$> pos
+
+addSynonymousRelations :: [(Column,Column)] -> [Relation] -> [Relation]
+addSynonymousRelations _ [] = []
+addSynonymousRelations syns (rel:rels) = rel : synRelsP ++ synRelsF ++ addSynonymousRelations syns rels
+  where
+    synRelsP = synRels (relColumns rel) (\t cs -> rel{relTable=t,relColumns=cs})
+    synRelsF = synRels (relFColumns rel) (\t cs -> rel{relFTable=t,relFColumns=cs})
+    synRels cols mapFn = map (\cs -> mapFn (colTable $ head cs) cs) $ synonymousColumns syns cols
+
+addParentRelations :: [Relation] -> [Relation]
+addParentRelations [] = []
+addParentRelations (rel@(Relation t c ft fc _ _ _ _):rels) = Relation ft fc t c Parent Nothing Nothing Nothing : rel : addParentRelations rels
+
+addManyToManyRelations :: [Relation] -> [Relation]
+addManyToManyRelations rels = rels ++ mapMaybe link2Relation links
+  where
+    links = join $ map (combinations 2) $ filter (not . null) $ groupWith groupFn $ filter ( (==Child). relType) rels
+    groupFn :: Relation -> Text
+    groupFn (Relation{relTable=Table{tableSchema=s, tableName=t}}) = s<>"_"<>t
+    combinations k ns = filter ((k==).length) (subsequences ns)
+    link2Relation [
+      Relation{relTable=lt, relColumns=lc1, relFTable=t,  relFColumns=c},
+      Relation{             relColumns=lc2, relFTable=ft, relFColumns=fc}
+      ]
+      | lc1 /= lc2 && length lc1 == 1 && length lc2 == 1 = Just $ Relation t c ft fc Many (Just lt) (Just lc1) (Just lc2)
+      | otherwise = Nothing
+    link2Relation _ = Nothing
+
+raiseRelations :: Schema -> [(Column,Column)] -> [Relation] -> [Relation]
+raiseRelations schema syns = map raiseRel
+  where
+    raiseRel rel
+      | tableSchema table == schema = rel
+      | isJust newCols = rel{relFTable=fromJust newTable,relFColumns=fromJust newCols}
+      | otherwise = rel
+      where
+        cols = relFColumns rel
+        table = relFTable rel
+        newCols = listToMaybe $ filter ((== schema) . tableSchema . colTable . head) (synonymousColumns syns cols)
+        newTable = (colTable . head) <$> newCols
+
+synonymousPrimaryKeys :: [(Column,Column)] -> [PrimaryKey] -> [PrimaryKey]
+synonymousPrimaryKeys _ [] = []
+synonymousPrimaryKeys syns (key:keys) = key : newKeys ++ synonymousPrimaryKeys syns keys
+  where
+    keySyns = filter ((\c -> colTable c == pkTable key && colName c == pkName key) . fst) syns
+    newKeys = map ((\c -> PrimaryKey{pkTable=colTable c,pkName=colName c}) . snd) keySyns
+
+allTables :: H.Tx P.Postgres s [Table]
+allTables = do
+    rows <- H.listEx $ [H.stmt|
+      SELECT
+        n.nspname AS table_schema,
+        c.relname AS table_name,
+        c.relkind = 'r' OR (c.relkind IN ('v','f'))
+        AND (pg_relation_is_updatable(c.oid::regclass, FALSE) & 8) = 8
+        OR (EXISTS
+          ( SELECT 1
+            FROM pg_trigger
+            WHERE pg_trigger.tgrelid = c.oid
+            AND (pg_trigger.tgtype::integer & 69) = 69) ) AS insertable
+      FROM pg_class c
+      JOIN pg_namespace n ON n.oid = c.relnamespace
+      WHERE c.relkind IN ('v','r','m')
+        AND n.nspname NOT IN ('pg_catalog', 'information_schema')
+      GROUP BY table_schema, table_name, insertable
+      ORDER BY table_schema, table_name
+    |]
+    return $ map tableFromRow rows
+
+tableFromRow :: (Text, Text, Bool) -> Table
+tableFromRow (s, n, i) = Table s n i
+
+allColumns :: [Table] -> H.Tx P.Postgres s [Column]
+allColumns tabs = do
+  cols <- H.listEx $ [H.stmt|
+      SELECT DISTINCT
+          info.table_schema AS schema,
+          info.table_name AS table_name,
+          info.column_name AS name,
+          info.ordinal_position AS position,
+          info.is_nullable::boolean AS nullable,
+          info.data_type AS col_type,
+          info.is_updatable::boolean AS updatable,
+          info.character_maximum_length AS max_len,
+          info.numeric_precision AS precision,
+          info.column_default AS default_value,
+          array_to_string(enum_info.vals, ',') AS enum
+      FROM (
+          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 NOT IN ('pg_catalog', 'information_schema')
+      ) AS info
+      LEFT OUTER JOIN (
+          SELECT
+              n.nspname AS s,
+              t.typname AS n,
+              array_agg(e.enumlabel ORDER BY e.enumsortorder) AS vals
+          FROM pg_type t
+          JOIN pg_enum e ON t.oid = e.enumtypid
+          JOIN pg_catalog.pg_namespace n ON n.oid = t.typnamespace
+          GROUP BY s,n
+      ) AS enum_info ON (info.udt_name = enum_info.n)
+      ORDER BY schema, position
+  |]
+  return $ mapMaybe (columnFromRow tabs) cols
+
+columnFromRow :: [Table] ->
+                 (Text,       Text,      Text,
+                  Int,        Bool,      Text,
+                  Bool,       Maybe Int, Maybe Int,
+                  Maybe Text, Maybe Text)
+                 -> Maybe Column
+columnFromRow tabs (s, t, n, pos, nul, typ, u, l, p, d, e) = buildColumn <$> table
+  where
+    buildColumn tbl = Column tbl n pos nul typ u l p d (parseEnum e) Nothing
+    table = find (\tbl -> tableSchema tbl == s && tableName tbl == t) tabs
+    parseEnum :: Maybe Text -> [Text]
+    parseEnum str = fromMaybe [] $ split (==',') <$> str
+
+allRelations :: [Table] -> [Column] -> H.Tx P.Postgres s [Relation]
+allRelations tabs cols = do
+  rels <- H.listEx $ [H.stmt|
+    SELECT ns1.nspname AS table_schema,
+           tab.relname AS table_name,
+           column_info.cols AS columns,
+           ns2.nspname AS foreign_table_schema,
+           other.relname AS foreign_table_name,
+           column_info.refs AS foreign_columns
+    FROM pg_constraint,
+       LATERAL (SELECT array_agg(cols.attname) AS cols,
+                       array_agg(cols.attnum)  AS nums,
+                       array_agg(refs.attname) AS refs
+                  FROM ( SELECT unnest(conkey) AS col, unnest(confkey) AS ref) k,
+                       LATERAL (SELECT * FROM pg_attribute
+                                 WHERE attrelid = conrelid AND attnum = col)
+                            AS cols,
+                       LATERAL (SELECT * FROM pg_attribute
+                                 WHERE attrelid = confrelid AND attnum = ref)
+                            AS refs)
+            AS column_info,
+       LATERAL (SELECT * FROM pg_namespace WHERE pg_namespace.oid = connamespace) AS ns1,
+       LATERAL (SELECT * FROM pg_class WHERE pg_class.oid = conrelid) AS tab,
+       LATERAL (SELECT * FROM pg_class WHERE pg_class.oid = confrelid) AS other,
+       LATERAL (SELECT * FROM pg_namespace WHERE pg_namespace.oid = other.relnamespace) AS ns2
+    WHERE confrelid != 0
+    ORDER BY (conrelid, column_info.nums)
+  |]
+  return $ mapMaybe (relationFromRow tabs cols) rels
+
+relationFromRow :: [Table] -> [Column] -> (Text, Text, [Text], Text, Text, [Text]) -> Maybe Relation
+relationFromRow allTabs allCols (rs, rt, rcs, frs, frt, frcs) =
+  if isJust table && isJust tableF && length cols == length rcs && length colsF == length frcs
+    then Just $ Relation (fromJust table) cols (fromJust tableF) colsF Child Nothing Nothing Nothing
+    else Nothing
+  where
+    findTable s t = find (\tbl -> tableSchema tbl == s && tableName tbl == t) allTabs
+    findCols s t cs = filter (\col -> tableSchema (colTable col) == s && tableName (colTable col) == t && colName col `elem` cs) allCols
+    table  = findTable rs rt
+    tableF = findTable frs frt
+    cols  = findCols rs rt rcs
+    colsF = findCols frs frt frcs
+
+allPrimaryKeys :: [Table] -> H.Tx P.Postgres s [PrimaryKey]
+allPrimaryKeys tabs = do
+  pks <- H.listEx $ [H.stmt|
+    SELECT
+        kc.table_schema,
+        kc.table_name,
+        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 NOT IN ('pg_catalog', 'information_schema')
+    |]
+  return $ mapMaybe (pkFromRow tabs) pks
+
+pkFromRow :: [Table] -> (Schema, Text, Text) -> Maybe PrimaryKey
+pkFromRow tabs (s, t, n) = PrimaryKey <$> table <*> pure n
+  where table = find (\tbl -> tableSchema tbl == s && tableName tbl == t) tabs
+
+allSynonyms :: [Column] -> H.Tx P.Postgres s [(Column,Column)]
+allSynonyms allCols = do
+  syns <- H.listEx $ [H.stmt|
+    WITH synonyms AS (
+      SELECT
+        vcu.table_schema AS src_table_schema,
+        vcu.table_name AS src_table_name,
+        vcu.column_name AS src_column_name,
+        view.table_schema AS syn_table_schema,
+        view.table_name AS syn_table_name,
+        view.view_definition AS view_definition
+      FROM
+        information_schema.views AS view,
+        information_schema.view_column_usage AS vcu
+      WHERE
+        view.table_schema = vcu.view_schema AND
+        view.table_name = vcu.view_name AND
+        view.table_schema NOT IN ('pg_catalog', 'information_schema') AND
+        (SELECT COUNT(*) FROM information_schema.view_table_usage WHERE view_schema = view.table_schema AND view_name = view.table_name) = 1
+    )
+    SELECT
+      src_table_schema, src_table_name, src_column_name,
+      syn_table_schema, syn_table_name,
+      (regexp_matches(view_definition, CONCAT('\.(', src_column_name, ')(?=,|$)'), 'gn'))[1]
+    FROM synonyms
+    UNION (
+      SELECT
+        src_table_schema, src_table_name, src_column_name,
+        syn_table_schema, syn_table_name,
+        (regexp_matches(view_definition, CONCAT('\.', src_column_name, '\sAS\s("?)(.+?)\1(,|$)'), 'gn'))[2] /* " <- for syntax highlighting */
+      FROM synonyms
+    )
+    |]
+  return $ mapMaybe (synonymFromRow allCols) syns
+
+synonymFromRow :: [Column] -> (Text,Text,Text,Text,Text,Text) -> Maybe (Column,Column)
+synonymFromRow allCols (s1,t1,c1,s2,t2,c2) = (,) <$> col1 <*> col2
+  where
+    col1 = findCol s1 t1 c1
+    col2 = findCol s2 t2 c2
+    findCol s t c = find (\col -> (tableSchema . colTable) col == s && (tableName . colTable) col == t && colName col == c) allCols

src/PostgREST/Error.hs

@@ -2,13 +2,14 @@
 {-# LANGUAGE FlexibleInstances    #-}
 {-# LANGUAGE TypeSynonymInstances #-}
 
-module PostgREST.Error (PgError, errResponse) where
+module PostgREST.Error (PgError, pgErrResponse, errResponse) where
 
 
 import           Data.Aeson                ((.=))
 import qualified Data.Aeson                as JSON
 import           Data.String.Conversions   (cs)
 import           Data.String.Utils         (replace)
+import           Data.Text                 (Text)
 import qualified Data.Text                 as T
 import qualified Hasql                     as H
 import qualified Hasql.Postgres            as P
@@ -18,8 +19,11 @@ import           Network.Wai               (Response, responseLBS)
 
 type PgError = H.SessionError P.Postgres
 
-errResponse :: PgError -> Response
+errResponse :: HT.Status -> Text -> Response
-errResponse e = responseLBS (httpStatus e)
+errResponse status message = responseLBS status [(hContentType, "application/json")] (cs $ T.concat ["{\"message\":\"",message,"\"}"])
+
+pgErrResponse :: PgError -> Response
+pgErrResponse e = responseLBS (httpStatus e)
   [(hContentType, "application/json")] (JSON.encode e)
 
 instance JSON.ToJSON PgError where

src/PostgREST/Main.hs

@@ -1,39 +1,40 @@
 module Main where
 
 
-import           PostgREST.PgStructure
-import           PostgREST.Types
-import           Network.Wai
-
 import           PostgREST.App
-import           PostgREST.Error                      (errResponse)
+import           PostgREST.Config                     (AppConfig (..),
+                                                       minimumPgVersion,
+                                                       prettyVersion,
+                                                       readOptions)
+import           PostgREST.Error                      (pgErrResponse, PgError)
 import           PostgREST.Middleware
+import           PostgREST.DbStructure
 
 import           Control.Monad                        (unless)
 import           Control.Monad.IO.Class               (liftIO)
+import           Data.Aeson                           (encode)
 import           Data.Functor.Identity
 import           Data.Monoid                          ((<>))
 import           Data.String.Conversions              (cs)
 import           Data.Text                            (Text)
 import qualified Hasql                                as H
 import qualified Hasql.Postgres                       as P
+import           Network.Wai
 import           Network.Wai.Handler.Warp             hiding (Connection)
 import           Network.Wai.Middleware.RequestLogger (logStdout)
-
 import           System.IO                            (BufferMode (..),
                                                        hSetBuffering, stderr,
                                                        stdin, stdout)
-
+import           Web.JWT                              (secret)
-import           PostgREST.Config                     (AppConfig (..),
-                                                       prettyVersion,
-                                                       readOptions,
-                                                       minimumPgVersion)
 
 isServerVersionSupported :: H.Session P.Postgres IO Bool
 isServerVersionSupported = do
-  Identity (row :: Text) <- H.tx Nothing $ H.singleEx $ [H.stmt|SHOW server_version_num|]
+  Identity (row :: Text) <- H.tx Nothing $ H.singleEx [H.stmt|SHOW server_version_num|]
   return $ read (cs row) >= minimumPgVersion
 
+hasqlError :: PgError -> IO a
+hasqlError = error . cs . encode
+
 main :: IO ()
 main = do
   hSetBuffering stdout LineBuffering
@@ -43,55 +44,36 @@ main = do
   conf <- readOptions
   let port = configPort conf
 
-  unless (configSecure conf) $
+  unless (secret "secret" /= configJwtSecret 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)
+  let pgSettings = P.StringSettings $ cs (configDatabase 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)
+      middle = logStdout . defaultMiddle
 
   poolSettings <- maybe (fail "Improper session settings") return $
     H.poolSettings (fromIntegral $ configPool conf) 30
   pool :: H.Pool P.Postgres <- H.acquirePool pgSettings poolSettings
 
   supportedOrError <- H.session pool isServerVersionSupported
-  either (fail . show)
+  either hasqlError
     (\supported ->
       unless supported $
-        fail "Cannot run in this PostgreSQL version, PostgREST needs at least 9.2.0"
+        error (
+          "Cannot run in this PostgreSQL version, PostgREST needs at least "
+          <> show minimumPgVersion)
     ) supportedOrError
 
   let txSettings = Just (H.ReadCommitted, Just True)
-  metadata <- H.session pool $ H.tx txSettings $ do
+  dbOrError <- H.session pool $ H.tx txSettings $ getDbStructure (cs $ configSchema conf)
-    tabs <- allTables
+  dbStructure <- either hasqlError return dbOrError
-    rels <- allRelations
-    cols <- allColumns rels
-    keys <- allPrimaryKeys
-    return (tabs, rels, cols, keys)
-
-  dbstructure <- case metadata of
-    Left e -> fail $ show e
-    Right (tabs, rels, cols, keys) ->
-      return DbStructure {
-          tables=tabs
-        , columns=cols
-        , relations=rels
-        , primaryKeys=keys
-        }
-
 
   runSettings appSettings $ middle $ \ req respond -> do
     body <- strictRequestBody req
     resOrError <- liftIO $ H.session pool $ H.tx txSettings $
-      authenticated conf (app dbstructure conf body) req
+      runWithClaims conf (app dbStructure conf body) req
-    either (respond . errResponse) respond resOrError
+    either (respond . pgErrResponse) respond resOrError

src/PostgREST/Middleware.hs

@@ -3,103 +3,70 @@
 
 module PostgREST.Middleware where
 
-import           Data.Maybe                    (fromMaybe, isNothing)
+import           Data.Maybe                    (fromMaybe)
-import           Data.Monoid
 import           Data.Text
 import           Data.String.Conversions       (cs)
+import           Data.Time.Clock.POSIX         (getPOSIXTime)
 import qualified Hasql                         as H
 import qualified Hasql.Postgres                as P
 
-import           Network.HTTP.Types            (RequestHeaders)
+import           Network.HTTP.Types.Header     (hAccept, hAuthorization)
-import           Network.HTTP.Types.Header     (hAccept, hAuthorization,
+import           Network.HTTP.Types.Status     (status415, status400)
-                                                hLocation)
+import           Network.Wai                   (Application, Request (..), Response,
-import           Network.HTTP.Types.Status     (status301, status400, status401,
+                                                requestHeaders)
-                                                status415)
-import           Network.URI                   (URI (..), parseURI)
-import           Network.Wai                   (Application, Request (..),
-                                                Response, isSecure, rawPathInfo,
-                                                rawQueryString, requestHeaders,
-                                                responseLBS)
 import           Network.Wai.Middleware.Cors   (cors)
 import           Network.Wai.Middleware.Gzip   (def, gzip)
 import           Network.Wai.Middleware.Static (only, staticPolicy)
 
-import           Codec.Binary.Base64.String    (decode)
+import           PostgREST.ApiRequest       (pickContentType)
-import           PostgREST.App                 (contentTypeForAccept)
+import           PostgREST.Auth                (setRole, jwtClaims, claimsToSQL)
-import           PostgREST.Auth                (DbRole, LoginAttempt (..),
-                                                setRole, setUserId, signInRole,
-                                                signInWithJWT)
 import           PostgREST.Config              (AppConfig (..), corsPolicy)
+import           PostgREST.Error               (errResponse)
 
-import           Prelude
+import           System.IO.Unsafe              (unsafePerformIO)
 
-authenticated :: forall s. AppConfig ->
+import           Prelude hiding(concat)
-                 (DbRole -> Request -> H.Tx P.Postgres s Response) ->
+
+import qualified Data.Vector             as V
+import qualified Hasql.Backend           as B
+import qualified Data.Map.Lazy           as M
+
+runWithClaims :: forall s. AppConfig ->
+                 (Request -> H.Tx P.Postgres s Response) ->
                  Request -> H.Tx P.Postgres s Response
-authenticated conf app req = do
+runWithClaims conf app req = do
-  attempt <- httpRequesterRole (requestHeaders req)
+    _ <- H.unitEx $ stmt setAnon
-  case attempt of
+    let time = unsafePerformIO getPOSIXTime
-    MalformedAuth ->
+    case split (== ' ') (cs auth) of
-      return $ responseLBS status400 [] "Malformed basic auth header"
+      ("Bearer" : tokenStr : _) ->
-    LoginFailed ->
+        case jwtClaims jwtSecret tokenStr time of
-      return $ responseLBS status401 [] "Invalid username or password"
+          Just claims ->
-    LoginSuccess role uid -> if role /= currentRole then runInRole role uid else app currentRole req
+            if M.member "role" claims
-    NoCredentials         -> if anon /= currentRole then runInRole anon "" else app currentRole req
+            then do
-
+              mapM_ H.unitEx $ stmt <$> claimsToSQL claims
- where
+              app req
-   jwtSecret = cs $ configJwtSecret conf
+            else invalidJWT
-   currentRole = cs $ configDbUser conf
+          _ -> invalidJWT
-   anon = cs $ configAnonRole conf
+      _ -> app req
-   httpRequesterRole :: RequestHeaders -> H.Tx P.Postgres s LoginAttempt
+  where
-   httpRequesterRole hdrs = do
+    stmt c = B.Stmt c V.empty True
-    let auth = fromMaybe "" $ lookup hAuthorization hdrs
+    hdrs = requestHeaders req
-    case split (==' ') (cs auth) of
+    jwtSecret = configJwtSecret conf
-      ("Basic" : b64 : _) ->
+    auth = fromMaybe "" $ lookup hAuthorization hdrs
-        case split (==':') (cs . decode . cs $ b64) of
+    anon = cs $ configAnonRole conf
-          (u:p:_) -> signInRole u p
+    setAnon = setRole anon
-          _ -> return MalformedAuth
+    invalidJWT = return $ errResponse status400 "Invalid JWT"
-      ("Bearer" : jwt : _) ->
-        return $ signInWithJWT jwtSecret jwt
-      _ -> return NoCredentials
-
-   runInRole :: Text -> Text -> H.Tx P.Postgres s Response
-   runInRole r uid = do
-     setUserId uid
-     setRole r
-     app r req
-
-
-redirectInsecure :: Application -> Application
-redirectInsecure app req respond = do
-  let hdrs = requestHeaders req
-      host = lookup "host" hdrs
-      uriM = parseURI . cs =<< mconcat [
-        Just "https://",
-        host,
-        Just $ rawPathInfo req,
-        Just $ rawQueryString req]
-      isHerokuSecure = lookup "x-forwarded-proto" hdrs == Just "https"
-
-  if not (isSecure req || isHerokuSecure)
-    then case uriM of
-      Just uri ->
-        respond $ responseLBS status301 [
-            (hLocation, cs . show $ uri { uriScheme = "https:" })
-          ] ""
-      Nothing ->
-        respond $ responseLBS status400 [] "SSL is required"
-    else app req respond
 
 unsupportedAccept :: Application -> Application
-unsupportedAccept app req respond = do
+unsupportedAccept app req respond =
-  let
+  case accept of
-    accept = lookup hAccept $ requestHeaders req
+    Left _ -> respond $ errResponse status415 "Unsupported Accept header, try: application/json"
-  if isNothing $ contentTypeForAccept accept
+    Right _ -> app req respond
-  then respond $ responseLBS status415 [] "Unsupported Accept header, try: application/json"
+  where accept = pickContentType $ lookup hAccept $ requestHeaders req
-  else app req respond
 
-defaultMiddle :: Bool -> Application -> Application
+defaultMiddle :: Application -> Application
-defaultMiddle secure = (if secure then redirectInsecure else id)
+defaultMiddle =
-  . gzip def . cors corsPolicy
+    gzip def
+  . cors corsPolicy
   . staticPolicy (only [("favicon.ico", "static/favicon.ico")])
   . unsupportedAccept

src/PostgREST/Parsers.hs

@@ -1,47 +1,27 @@
 module PostgREST.Parsers
-( parseGetRequest
+-- ( parseGetRequest
-)
+-- )
 where
 
 import           Control.Applicative hiding ((<$>))
---lines needed for ghc 7.8
-import           Data.Functor ((<$>))
-import           Data.Traversable (traverse)
-
-import           Control.Monad                 (join)
-import           Data.List                     (delete, find)
-import           Data.Maybe
 import           Data.Monoid
 import           Data.String.Conversions       (cs)
 import           Data.Text                     (Text)
 import           Data.Tree
-import           Network.Wai                   (Request, pathInfo, queryString)
 import           PostgREST.Types
 import           Text.ParserCombinators.Parsec hiding (many, (<|>))
-parseGetRequest :: Request -> Either ParseError ApiRequest
+import           PostgREST.QueryBuilder (operators)
-parseGetRequest httpRequest =
-  foldr addFilter <$> (addOrder <$> apiRequest <*> ord) <*> flts
-  where
-    apiRequest = parse (pRequestSelect rootTableName) ("failed to parse select parameter <<"++selectStr++">>") $ cs selectStr
-    addOrder (Node r f) o = Node r{order=o} f
-    flts = mapM pRequestFilter whereFilters
-    rootTableName = cs $ head $ pathInfo httpRequest -- TODO unsafe head
-    qString = [(cs k, cs <$> v)|(k,v) <- queryString httpRequest]
-    orderStr = join $ lookup "order" qString
-    ord = traverse (parse pOrder ("failed to parse order parameter <<"++fromMaybe "" orderStr++">>")) orderStr
-    selectStr = fromMaybe "*" $ fromMaybe (Just "*") $ lookup "select" qString --in case the parametre is missing or empty we default to *
-    whereFilters = [ (k, fromJust v) | (k,v) <- qString, k `notElem` ["select", "order"], isJust v ]
 
-pRequestSelect :: Text -> Parser ApiRequest
+pRequestSelect :: Text -> Parser ReadRequest
 pRequestSelect rootNodeName = do
   fieldTree <- pFieldForest
-  return $ foldr treeEntry (Node (Select rootNodeName [] [] [] Nothing Nothing) []) fieldTree
+  return $ foldr treeEntry (Node (Select [] [rootNodeName] [] Nothing, (rootNodeName, Nothing)) []) fieldTree
   where
-    treeEntry :: Tree SelectItem -> ApiRequest -> ApiRequest
+    treeEntry :: Tree SelectItem -> ReadRequest -> ReadRequest
-    treeEntry (Node fld@((fn, _),_) fldForest) (Node rNode rForest) =
+    treeEntry (Node fld@((fn, _),_) fldForest) (Node (q, i) rForest) =
       case fldForest of
-        [] -> Node (rNode {fields=fld:fields rNode}) rForest
+        [] -> Node (q {select=fld:select q}, i) rForest
-        _  -> Node rNode (foldr treeEntry (Node (Select fn [] [] [] Nothing Nothing) []) fldForest:rForest)
+        _  -> Node (q, i) (foldr treeEntry (Node (Select [] [fn] [] Nothing, (fn, Nothing)) []) fldForest:rForest)
 
 pRequestFilter :: (String, String) -> Either ParseError (Path, Filter)
 pRequestFilter (k, v) = (,) <$> path <*> (Filter <$> fld <*> op <*> val)
@@ -53,21 +33,6 @@ pRequestFilter (k, v) = (,) <$> path <*> (Filter <$> fld <*> op <*> val)
     op = fst <$> opVal
     val = snd <$> opVal
 
-addFilter :: (Path, Filter) -> ApiRequest -> ApiRequest
-addFilter ([], flt) (Node rn@(Select {filters=flts}) forest) = Node (rn {filters=flt:flts}) forest
-addFilter (path, flt) (Node rn forest) =
-  case targetNode of
-    Nothing -> Node rn forest -- the filter is silenty dropped in the Request does not contain the required path
-    Just tn -> Node rn (addFilter (remainingPath, flt) tn:restForest)
-  where
-    targetNodeName:remainingPath = path
-    (targetNode,restForest) = splitForest targetNodeName forest
-    splitForest name forst =
-      case maybeNode of
-        Nothing -> (Nothing,forest)
-        Just node -> (Just node, delete node forest)
-      where maybeNode = find ((name==).mainTable.rootLabel) forst
-
 ws :: Parser Text
 ws = cs <$> many (oneOf " \t")
 
@@ -77,35 +42,33 @@ lexeme p = ws *> p <* ws
 pTreePath :: Parser (Path,Field)
 pTreePath = do
   p <- pFieldName `sepBy1` pDelimiter
-  jp <- optionMaybe ( string "->" >>  pJsonPath)
+  jp <- optionMaybe pJsonPath
   let pp = map cs p
       jpp = map cs <$> jp
   return (init pp, (last pp, jpp))
-  where
-
 
 pFieldForest :: Parser [Tree SelectItem]
 pFieldForest = pFieldTree `sepBy1` lexeme (char ',')
 
 pFieldTree :: Parser (Tree SelectItem)
-pFieldTree = try (Node <$> pSelect <*> ( char '(' *> pFieldForest <* char ')'))
+pFieldTree = try (Node <$> pSelect <*> between (char '{') (char '}') pFieldForest)
-      <|>    Node <$> pSelect <*> pure []
+          <|>     Node <$> pSelect <*> pure []
 
 pStar :: Parser Text
 pStar = cs <$> (string "*" *> pure ("*"::String))
 
 pFieldName :: Parser Text
 pFieldName =  cs <$> (many1 (letter <|> digit <|> oneOf "_")
-      <?> "field name (* or [a..z0..9_])")
+          <?> "field name (* or [a..z0..9_])")
 
-pJsonPathDelimiter :: Parser Text
+pJsonPathStep :: Parser Text
-pJsonPathDelimiter = cs <$> (try (string "->>") <|> string "->")
+pJsonPathStep = cs <$> try (string "->" *> pFieldName)
 
 pJsonPath :: Parser [Text]
-pJsonPath = pFieldName `sepBy1` pJsonPathDelimiter
+pJsonPath = (++) <$> many pJsonPathStep <*> ( (:[]) <$> (string "->>" *> pFieldName) )
 
 pField :: Parser Field
-pField = lexeme $ (,) <$> pFieldName <*> optionMaybe ( pJsonPathDelimiter *>  pJsonPath)
+pField = lexeme $ (,) <$> pFieldName <*> optionMaybe pJsonPath
 
 pSelect :: Parser SelectItem
 pSelect = lexeme $
@@ -115,22 +78,8 @@ pSelect = lexeme $
     return ((s, Nothing), Nothing)
 
 pOperator :: Parser Operator
-pOperator = cs <$> ( try (string "lte") -- has to be before lt
+pOperator = cs <$> (pOp <?> "operator (eq, gt, ...)")
-     <|> try (string "lt")
+  where pOp = foldl (<|>) empty $ map (try . string . cs . fst) operators
-     <|> try (string "eq")
-     <|> try (string "gte") -- has to be before gh
-     <|> try (string "gt")
-     <|> try (string "lt")
-     <|> try (string "neq")
-     <|> try (string "like")
-     <|> try (string "ilike")
-     <|> try (string "in")
-     <|> try (string "notin")
-     <|> try (string "is" )
-     <|> try (string "isnot")
-     <|> try (string "@@")
-     <?> "operator (eq, gt, ...)"
-     )
 
 pValue :: Parser FValue
 pValue = VText <$> (cs <$> many anyChar)
@@ -152,8 +101,12 @@ pOrderTerm =
   try ( do
     c <- pFieldName
     _ <- pDelimiter
-    d <- string "asc" <|> string "desc"
+    d <- (string "asc" *> pure OrderAsc)
-    nls <- optionMaybe (pDelimiter *> ( try(string "nullslast" *> pure ("nulls last"::String)) <|> try(string "nullsfirst" *> pure ("nulls first"::String))))
+         <|> (string "desc" *> pure OrderDesc)
-    return $ OrderTerm (cs c) (cs d) (cs <$> nls)
+    nls <- optionMaybe (pDelimiter *> (
+                 try(string "nullslast" *> pure OrderNullsLast)
+             <|> try(string "nullsfirst" *> pure OrderNullsFirst)
+           ))
+    return $ OrderTerm c d nls
   )
-  <|> OrderTerm <$> (cs <$> pFieldName) <*> pure "asc" <*> pure Nothing
+  <|> OrderTerm <$> (cs <$> pFieldName) <*> pure OrderAsc <*> pure Nothing

src/PostgREST/PgQuery.hs

@@ -1,306 +0,0 @@
-{-# LANGUAGE FlexibleInstances    #-}
-{-# LANGUAGE MultiWayIf           #-}
-{-# LANGUAGE TypeSynonymInstances #-}
-{-# OPTIONS_GHC -fno-warn-orphans #-}
-
-module PostgREST.PgQuery where
-
-
-import qualified Hasql                   as H
-import qualified Hasql.Backend           as B
-import qualified Hasql.Postgres          as P
-import           PostgREST.RangeQuery
-import           PostgREST.Types         (OrderTerm (..), QualifiedIdentifier(..))
-
-import           Control.Monad           (join)
-import qualified Data.Aeson              as JSON
-import qualified Data.ByteString.Char8   as BS
-import           Data.Functor
-import qualified Data.HashMap.Strict     as H
-import qualified Data.List               as L
-import           Data.Maybe              (fromMaybe)
-import           Data.Monoid
-import           Data.Scientific         (FPFormat (..), formatScientific,
-                                          isInteger)
-import           Data.String.Conversions (cs)
-import qualified Data.Text               as T
-import           Data.Vector             (empty)
-import qualified Data.Vector             as V
-import qualified Network.HTTP.Types.URI  as Net
-import           Text.Regex.TDFA         ((=~))
-
-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
-
-
-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","select"] ]
-    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
-
-countNone :: PStmt
-countNone = B.Stmt "select null" 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" }
-
-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)
-    sqlValue = pgFmtValue opCode value
-    op = pgFmtOperator opCode
-
-
-whiteList :: T.Text -> T.Text
-whiteList val = fromMaybe
-  (cs (pgFmtLit val) <> "::unknown ")
-  (L.find ((==) . T.toLower $ val) ["null","true","false"])
-
-pgFmtValue :: T.Text -> T.Text -> T.Text
-pgFmtValue opCode value =
-  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
-  where
-    star c = if c == '*' then '%' else c
-    unknownLiteral = (<> "::unknown ") . pgFmtLit
-
-pgFmtOperator :: T.Text -> T.Text
-pgFmtOperator opCode =
-  case opCode of
-    "eq"  -> "="
-    "gt"  -> ">"
-    "lt"  -> "<"
-    "gte" -> ">="
-    "lte" -> "<="
-    "neq" -> "<>"
-    "like"-> "like"
-    "ilike"-> "ilike"
-    "in"  -> "in"
-    "notin" -> "not in"
-    "is"    -> "is"
-    "isnot" -> "is not"
-    "@@" -> "@@"
-    _     -> "="
-
-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

@@ -1,264 +0,0 @@
-{-# LANGUAGE FlexibleContexts      #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE QuasiQuotes           #-}
-{-# LANGUAGE ScopedTypeVariables   #-}
-{-# LANGUAGE TypeSynonymInstances  #-}
-module PostgREST.PgStructure where
-
-import           Control.Applicative
-import           Control.Monad         (join)
-import           Data.Functor.Identity
-import           Data.List             (elemIndex, find)
-import           Data.Maybe            (fromMaybe, isJust, mapMaybe)
-import           Data.Monoid
-import           Data.Text             (Text, split)
-import qualified Hasql                 as H
-import qualified Hasql.Postgres        as P
-import           PostgREST.PgQuery     ()
-import           PostgREST.Types
-
-import           GHC.Exts              (groupWith)
-import           Prelude
-
-
-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
-
-
-tableFromRow :: (Text, Text, Bool, Maybe Text) -> Table
-tableFromRow (s, n, i, a) = Table s n i (parseAcl a)
-  where
-    parseAcl :: Maybe Text -> [Text]
-    parseAcl str = fromMaybe [] $ split (==',') <$> str
-
-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
-
-
-relationFromRow :: (Text, Text, [Text], Text, [Text]) -> Relation
-relationFromRow (s, t, cs, ft, fcs) = Relation s t cs ft fcs Child Nothing Nothing Nothing
-
-pkFromRow :: (Text, Text, Text) -> PrimaryKey
-pkFromRow (s, t, n) = PrimaryKey s t n
-
-
-addParentRelation :: Relation -> [Relation] -> [Relation]
-addParentRelation rel@(Relation s t c ft fc _ _ _ _) rels = Relation s ft fc t c Parent Nothing Nothing Nothing:rel:rels
-
-allTables :: H.Tx P.Postgres s [Table]
-allTables = do
-    rows <- H.listEx $ [H.stmt|
-      SELECT
-        n.nspname AS table_schema,
-        c.relname AS table_name,
-        c.relkind = 'r' OR (c.relkind IN ('v','f'))
-        AND (pg_relation_is_updatable(c.oid::regclass, FALSE) & 8) = 8
-        OR (EXISTS
-          ( SELECT 1
-            FROM pg_trigger
-            WHERE pg_trigger.tgrelid = c.oid
-            AND (pg_trigger.tgtype::integer & 69) = 69) ) AS insertable,
-        array_to_string(array_agg(r.rolname), ',') AS acl
-      FROM pg_class c
-      CROSS JOIN pg_roles r
-      JOIN pg_namespace n ON n.oid = c.relnamespace
-      WHERE c.relkind IN ('v','r','m')
-        AND n.nspname NOT IN ('pg_catalog', 'information_schema')
-        AND (
-          pg_has_role(r.rolname, c.relowner, 'USAGE'::text) OR
-          has_table_privilege(r.rolname, c.oid, 'SELECT, INSERT, UPDATE, DELETE, TRUNCATE, REFERENCES, TRIGGER'::text) OR
-          has_any_column_privilege(r.rolname, c.oid, 'SELECT, INSERT, UPDATE, REFERENCES'::text) )
-
-      GROUP BY table_schema, table_name, insertable
-      ORDER BY table_schema, table_name
-    |]
-    return $ map tableFromRow rows
-
-allRelations :: H.Tx P.Postgres s [Relation]
-allRelations = do
-  rels <- H.listEx $ [H.stmt|
-    WITH table_fk AS (
-        SELECT ns.nspname AS table_schema,
-               tab.relname AS table_name,
-               column_info.cols AS columns,
-               other.relname AS foreign_table_name,
-               column_info.refs AS foreign_columns
-        FROM pg_constraint,
-           LATERAL (SELECT array_agg(cols.attname) AS cols,
-                           array_agg(cols.attnum)  AS nums,
-                           array_agg(refs.attname) AS refs
-                      FROM ( SELECT unnest(conkey) AS col, unnest(confkey) AS ref) k,
-                           LATERAL (SELECT * FROM pg_attribute
-                                     WHERE attrelid = conrelid AND attnum = col)
-                                AS cols,
-                           LATERAL (SELECT * FROM pg_attribute
-                                     WHERE attrelid = confrelid AND attnum = ref)
-                                AS refs)
-                AS column_info,
-           LATERAL (SELECT * FROM pg_namespace
-                            WHERE pg_namespace.oid = connamespace) AS ns,
-           LATERAL (SELECT * FROM pg_class WHERE pg_class.oid = conrelid) AS tab,
-           LATERAL (SELECT * FROM pg_class WHERE pg_class.oid = confrelid) AS other
-        WHERE confrelid != 0
-        ORDER BY (conrelid, column_info.nums)
-    )
-
-    SELECT * FROM table_fk
-    UNION
-    (
-        SELECT
-            vcu.table_schema,
-            vcu.view_name AS table_name,
-            array_agg(vcu.column_name::text) AS columns,
-            table_fk.foreign_table_name,
-            table_fk.foreign_columns
-        FROM information_schema.view_column_usage as vcu
-        JOIN table_fk ON
-            table_fk.table_schema = vcu.view_schema AND
-            table_fk.table_name = vcu.table_name AND
-            vcu.column_name = ANY (table_fk.columns)
-        WHERE vcu.view_schema NOT IN ('pg_catalog', 'information_schema')
-        AND columns = table_fk.columns
-        GROUP BY vcu.table_schema, vcu.view_name, table_fk.foreign_table_name, table_fk.foreign_columns
-    )
-    UNION
-    (
-        SELECT
-            vcu.view_schema as table_schema,
-            table_fk.table_name,
-            table_fk.columns,
-            vcu.view_name as foreign_table_name,
-            array_agg(vcu.column_name::text) as foreign_columns
-        FROM information_schema.view_column_usage as vcu
-        JOIN table_fk ON
-            table_fk.table_schema = vcu.view_schema AND
-            table_fk.foreign_table_name = vcu.table_name AND
-            vcu.column_name = ANY (table_fk.foreign_columns)
-        WHERE vcu.view_schema NOT IN ('pg_catalog', 'information_schema')
-            AND foreign_columns = table_fk.foreign_columns
-        GROUP BY vcu.view_schema, table_fk.table_name, vcu.view_name, table_fk.columns
-    )
-  |]
-  let simpleRelations = foldr (addParentRelation.relationFromRow) [] rels
-  let links = filter ((==2).length) $ groupWith groupFn $ filter ( (==Child). relType) simpleRelations
-  return $ simpleRelations ++ mapMaybe link2Relation links
-  where
-    groupFn :: Relation -> Text
-    groupFn (Relation{relSchema=s, relTable=t}) = s<>"_"<>t
-    link2Relation [
-      Relation{relSchema=sc, relTable=lt, relColumns=lc1, relFTable=t, relFColumns=c},
-      Relation{                           relColumns=lc2, relFTable=ft, relFColumns=fc}
-      ] = Just $ Relation sc t c ft fc Many (Just lt) (Just lc1) (Just lc2)
-    link2Relation _ = Nothing
-
-allColumns :: [Relation] -> H.Tx P.Postgres s [Column]
-allColumns rels = 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 NOT IN ('pg_catalog', 'information_schema')
-      ) AS info
-      LEFT OUTER JOIN (
-          SELECT
-              n.nspname AS s,
-              t.typname AS n,
-              array_agg(e.enumlabel ORDER BY e.enumsortorder) AS vals
-          FROM pg_type t
-          JOIN pg_enum e ON t.oid = e.enumtypid
-          JOIN pg_catalog.pg_namespace n ON n.oid = t.typnamespace
-          GROUP BY s,n
-      ) AS enum_info ON (info.udt_name = enum_info.n)
-      ORDER BY schema, position
-  |]
-  return $ map (addFK . columnFromRow) cols
-
-  where
-    addFK col = col { colFK = fk col }
-    fk col = join $ relToFk (colName col) <$> find (lookupFn col) rels
-    lookupFn :: Column -> Relation -> Bool
-    lookupFn (Column{colSchema=cs, colTable=ct, colName=cn})  (Relation{relSchema=rs, relTable=rt, relColumns=rc, relType=rty}) =
-      cs==rs && ct==rt && cn `elem` rc && rty==Child
-    lookupFn _ _ = False
-    relToFk cName (Relation{relFTable=t, relColumns=cs, relFColumns=fcs}) = ForeignKey t <$> c
-      where
-        pos = elemIndex cName cs
-        c = (fcs !!) <$> pos
-
-allPrimaryKeys :: H.Tx P.Postgres s [PrimaryKey]
-allPrimaryKeys = do
-  pks <- H.listEx $ [H.stmt|
-    WITH table_pk AS (
-        SELECT
-            kc.table_schema,
-            kc.table_name,
-            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 NOT IN ('pg_catalog', 'information_schema')
-    )
-    SELECT table_schema,
-           table_name,
-           column_name
-    FROM table_pk
-    UNION (
-        SELECT
-            vcu.view_schema,
-            vcu.view_name,
-            vcu.column_name
-         FROM information_schema.view_column_usage AS vcu
-         JOIN
-            table_pk ON table_pk.table_schema = vcu.view_schema AND
-            table_pk.table_name = vcu.table_name AND
-            table_pk.column_name = vcu.column_name
-         WHERE vcu.view_schema NOT IN ('pg_catalog','information_schema')
-    )
-    |]
-  return $ map pkFromRow pks

src/PostgREST/QueryBuilder.hs

@@ -1,130 +1,376 @@
-module PostgREST.QueryBuilder
+{-# LANGUAGE FlexibleInstances    #-}
-where
+{-# LANGUAGE TupleSections #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+{-|
+Module      : PostgREST.QueryBuilder
+Description : PostgREST SQL generating functions.
 
+This module provides functions to consume data types that
+represent database objects (e.g. Relation, Schema, SqlQuery)
+and produces SQL Statements.
 
-import           Control.Error
+Any function that outputs a SQL fragment should be in this module.
-import           Data.List         (find)
+-}
-import           Data.Monoid
+module PostgREST.QueryBuilder (
-import           Data.Text         hiding (filter, find, foldr, head, last, map,
+    addRelations
-                                    null, zipWith)
+  , addJoinConditions
-import           Control.Applicative
+  , asJson
-import           Data.Tree
+  , callProc
-import           PostgREST.PgQuery (PStmt, fromQi,
+  , createReadStatement
-                                    orderT, pgFmtIdent, pgFmtLit, pgFmtOperator,
+  , createWriteStatement
-                                    pgFmtValue, whiteList)
+  , operators
+  , pgFmtIdent
+  , pgFmtLit
+  , requestToQuery
+  , sourceSubqueryName
+  , unquoted
+  ) where
+
+import qualified Hasql                   as H
+import qualified Hasql.Backend           as B
+import qualified Hasql.Postgres          as P
+
+import qualified Data.Aeson              as JSON
+
+import           PostgREST.RangeQuery    (NonnegRange, rangeLimit, rangeOffset)
+import           Control.Error           (note, fromMaybe, mapMaybe)
+import           Control.Monad           (join)
+import qualified Data.HashMap.Strict     as HM
+import           Data.List               (find)
+import           Data.Monoid             ((<>))
+import           Data.Text               (Text, intercalate, unwords, replace, isInfixOf, toLower, split)
+import qualified Data.Text as T          (map, takeWhile)
+import           Data.String.Conversions (cs)
+import           Control.Applicative     (empty, (<|>))
+import           Data.Tree               (Tree(..))
+import qualified Data.Vector as V
 import           PostgREST.Types
-import qualified Data.Vector       as V (empty)
+import qualified Data.Map as M
-import qualified Hasql.Backend     as B
+import           Text.Regex.TDFA         ((=~))
+import qualified Data.ByteString.Char8   as BS
+import           Data.Scientific         ( FPFormat (..)
+                                         , formatScientific
+                                         , isInteger
+                                         )
+import           Prelude hiding          (unwords)
 
-findRelation :: [Relation] -> Text -> Text -> Text -> Maybe Relation
+type PStmt = H.Stmt P.Postgres
-findRelation allRelations s t1 t2 =
+instance Monoid PStmt where
-  find (\r -> s == relSchema r && t1 == relTable r && t2 == relFTable r) allRelations
+  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
 
-addRelations :: Text -> [Relation] -> Maybe ApiRequest -> ApiRequest -> Either Text ApiRequest
+createReadStatement :: SqlQuery -> Maybe NonnegRange -> Bool -> Bool -> Bool -> B.Stmt P.Postgres
-addRelations schema allRelations parentNode node@(Node query@(Select {mainTable=table}) forest) =
+createReadStatement selectQuery range isSingle countTable asCsv =
+  B.Stmt (
+    wrapQuery selectQuery [
+      if countTable then countAllF else countNoneF,
+      countF,
+      "null", -- location header can not be calucalted
+      if asCsv
+        then asCsvF
+        else if isSingle then asJsonSingleF else asJsonF
+    ] selectStarF range
+  ) V.empty True
+
+createWriteStatement :: SqlQuery -> SqlQuery -> Bool -> Bool ->
+                        [Text] -> Bool -> Payload -> B.Stmt P.Postgres
+createWriteStatement _ _ _ _ _ _ (PayloadParseError _) = undefined
+createWriteStatement selectQuery mutateQuery isSingle echoRequested
+                     pKeys asCsv (PayloadJSON (UniformObjects rows)) =
+  B.Stmt (
+    wrapQuery mutateQuery [
+      countNoneF, -- when updateing it does not make sense
+      countF,
+      if isSingle then locationF pKeys else "null",
+      if echoRequested
+      then
+        if asCsv
+        then asCsvF
+        else if isSingle then asJsonSingleF else asJsonF
+      else "null"
+
+    ] selectQuery Nothing
+  ) (V.singleton . B.encodeValue . JSON.Array . V.map JSON.Object $ rows) True
+
+addRelations :: Schema -> [Relation] -> Maybe ReadRequest -> ReadRequest -> Either Text ReadRequest
+addRelations schema allRelations parentNode node@(Node n@(query, (table, _)) forest) =
   case parentNode of
-    Nothing -> Node query{relation=Nothing} <$> updatedForest
+    Nothing -> Node (query, (table, Nothing)) <$> updatedForest
-    (Just (Node (Select{mainTable=parentTable}) _)) -> Node <$> (addRel query <$> rel) <*> updatedForest
+    (Just (Node (_, (parentTable, _)) _)) -> Node <$> (addRel n <$> rel) <*> updatedForest
       where
         rel = note ("no relation between " <> table <> " and " <> parentTable)
-            $  findRelation allRelations schema table parentTable
+            $  findRelation schema table parentTable
-           <|> findRelation allRelations schema parentTable table
+           <|> findRelation schema parentTable table
-        addRel :: Query -> Relation -> Query
+        addRel :: (ReadQuery, (NodeName, Maybe Relation)) -> Relation -> (ReadQuery, (NodeName, Maybe Relation))
-        addRel q r = q{relation = Just r}
+        addRel (q, (t, _)) r = (q, (t, Just r))
   where
     updatedForest = mapM (addRelations schema allRelations (Just node)) forest
+    findRelation s t1 t2 =
+      find (\r -> s == (tableSchema . relTable) r && t1 == (tableName . relTable) r && t2 == (tableName . relFTable) r) allRelations
 
-getJoinConditions :: Relation -> [Filter]
+addJoinConditions :: Schema -> ReadRequest -> Either Text ReadRequest
-getJoinConditions (Relation s t cs ft fcs typ lt lc1 lc2) =
+addJoinConditions schema (Node (query, (n, r)) forest) =
-  case typ of
-    Child  -> zipWith (toFilter t ft) cs fcs
-    Parent -> zipWith (toFilter t ft) cs fcs
-    Many   -> zipWith (toFilter t (fromMaybe "" lt)) cs (fromMaybe [] lc1) ++ zipWith (toFilter ft (fromMaybe "" lt)) fcs (fromMaybe [] lc2)
-  where
-    toFilter :: Text -> Text -> FieldName -> FieldName -> Filter
-    toFilter tb ftb c fc = Filter (c, Nothing) "=" (VForeignKey (QualifiedIdentifier s tb) (ForeignKey ftb fc))
-
-addJoinConditions :: Text -> [Column] -> ApiRequest -> Either Text ApiRequest
-addJoinConditions schema allColumns (Node query@(Select{relation=r}) forest) =
   case r of
-    Nothing -> Node updatedQuery  <$> updatedForest -- this is the root node
+    Nothing -> Node (updatedQuery, (n,r))  <$> updatedForest -- this is the root node
-    Just rel@(Relation{relType=Child}) -> Node (addCond updatedQuery (getJoinConditions rel)) <$> updatedForest
+    Just rel@(Relation{relType=Child}) -> Node (addCond updatedQuery (getJoinConditions rel),(n,r)) <$> updatedForest
-    Just (Relation{relType=Parent}) -> Node updatedQuery <$> updatedForest
+    Just (Relation{relType=Parent}) -> Node (updatedQuery, (n,r)) <$> updatedForest
     Just rel@(Relation{relType=Many, relLTable=(Just linkTable)}) ->
-      Node <$> pure qq <*> updatedForest
+      Node (qq, (n, r)) <$> updatedForest
       where
          q = addCond updatedQuery (getJoinConditions rel)
-         qq = q{joinTables=linkTable:joinTables q}
+         qq = q{from=tableName linkTable : from q}
-    _ -> Left "unknow relation"
+    _ -> Left "unknown relation"
   where
     -- add parentTable and parentJoinConditions to the query
-    updatedQuery = foldr (flip addCond) (query{joinTables = parentTables ++ joinTables query}) parentJoinConditions
+    updatedQuery = foldr (flip addCond) query parentJoinConditions
       where
-        parentJoinConditions = map (getJoinConditions.snd) parents
+        parentJoinConditions = map (getJoinConditions . snd) parents
-        parentTables = map fst parents
+        parents = mapMaybe (getParents . rootLabel) forest
-        parents = mapMaybe (getParents.rootLabel) forest
+        getParents (_, (tbl, Just rel@(Relation{relType=Parent}))) = Just (tbl, rel)
-        getParents qq@(Select{relation=(Just rel@(Relation{relType=Parent}))}) = Just (mainTable qq, rel)
         getParents _ = Nothing
-    updatedForest = mapM (addJoinConditions schema allColumns) forest
+    updatedForest = mapM (addJoinConditions schema) forest
-    addCond q con = q{filters=con ++ filters q}
+    addCond q con = q{flt_=con ++ flt_ q}
 
-requestToCountQuery :: Text -> ApiRequest -> PStmt
+asJson :: StatementT
-requestToCountQuery schema (Node (Select mainTbl _ _ conditions _ _) _) =
+asJson s = s {
-  B.Stmt query V.empty True
+  B.stmtTemplate =
-  where
+    "array_to_json(coalesce(array_agg(row_to_json(t)), '{}'))::character varying from ("
-    query = Data.Text.unwords [
+    <> B.stmtTemplate s <> ") t" }
-      "SELECT pg_catalog.count(1)",
-      "FROM ", fromQi $ QualifiedIdentifier schema mainTbl,
-      ("WHERE " <> intercalate " AND " ( map (pgFmtCondition (QualifiedIdentifier schema mainTbl)) localConditions )) `emptyOnNull` localConditions
-      ]
-    emptyOnNull val x = if null x then "" else val
-    localConditions = filter fn conditions
-      where
-        fn  (Filter{value=VText _}) = True
-        fn  (Filter{value=VForeignKey _ _}) = False
 
-requestToQuery :: Text -> ApiRequest -> PStmt
+callProc :: QualifiedIdentifier -> JSON.Object -> PStmt
-requestToQuery schema (Node (Select mainTbl colSelects tbls conditions ord _) forest) =
+callProc qi params = do
-  orderT (fromMaybe [] ord)  query
+  let args = intercalate "," $ map assignment (HM.toList params)
+  B.Stmt ("select * from " <> fromQi qi <> "(" <> args <> ")") empty True
   where
-    query = B.Stmt qStr V.empty True
+    assignment (n,v) = pgFmtIdent n <> ":=" <> insertableValue v
-    qStr = Data.Text.unwords [
+
-      ("WITH " <> intercalate ", " withs) `emptyOnNull` withs,
+operators :: [(Text, SqlFragment)]
-      "SELECT ", intercalate ", " (map (pgFmtSelectItem (QualifiedIdentifier schema mainTbl)) colSelects ++ selects),
+operators = [
-      "FROM ", intercalate ", " (map (fromQi . QualifiedIdentifier schema) (mainTbl:tbls)),
+  ("eq", "="),
-      ("WHERE " <> intercalate " AND " ( map (pgFmtCondition (QualifiedIdentifier schema mainTbl) ) conditions )) `emptyOnNull` conditions
+  ("gte", ">="), -- has to be before gt (parsers)
+  ("gt", ">"),
+  ("lte", "<="), -- has to be before lt (parsers)
+  ("lt", "<"),
+  ("neq", "<>"),
+  ("like", "like"),
+  ("ilike", "ilike"),
+  ("in", "in"),
+  ("notin", "not in"),
+  ("isnot", "is not"), -- has to be before is (parsers)
+  ("is", "is"),
+  ("@@", "@@"),
+  ("@>", "@>"),
+  ("<@", "<@")
+  ]
+
+pgFmtIdent :: SqlFragment -> SqlFragment
+pgFmtIdent x =
+ let escaped = replace "\"" "\"\"" (trimNullChars $ cs x) in
+ if (cs escaped :: BS.ByteString) =~ danger
+   then "\"" <> escaped <> "\""
+   else escaped
+ where danger = "^$|^[^a-z_]|[^a-z_0-9]" :: BS.ByteString
+
+pgFmtLit :: SqlFragment -> SqlFragment
+pgFmtLit x =
+ let trimmed = trimNullChars x
+     escaped = "'" <> replace "'" "''" trimmed <> "'"
+     slashed = replace "\\" "\\\\" escaped in
+ if "\\\\" `isInfixOf` escaped
+   then "E" <> slashed
+   else slashed
+
+requestToQuery :: Schema -> DbRequest -> SqlQuery
+requestToQuery _ (DbMutate (Insert _ (PayloadParseError _))) = undefined
+requestToQuery _ (DbMutate (Update _ (PayloadParseError _) _)) = undefined
+requestToQuery schema (DbRead (Node (Select colSelects tbls conditions ord, (mainTbl, _)) forest)) =
+  query
+  where
+    -- TODO! the folloing helper functions are just to remove the "schema" part when the table is "source" which is the name
+    -- of our WITH query part
+    tblSchema tbl = if tbl == sourceSubqueryName then "" else schema
+    qi = QualifiedIdentifier (tblSchema mainTbl) mainTbl
+    toQi t = QualifiedIdentifier (tblSchema t) t
+    query = unwords [
+      ("WITH " <> intercalate ", " (map fst withs)) `emptyOnNull` withs,
+      "SELECT ", intercalate ", " (map (pgFmtSelectItem qi) colSelects ++ selects),
+      "FROM ", intercalate ", " (map (fromQi . toQi) tbls ++ map snd withs),
+      ("WHERE " <> intercalate " AND " ( map (pgFmtCondition qi ) conditions )) `emptyOnNull` conditions,
+      orderF (fromMaybe [] ord)
       ]
-    emptyOnNull val x = if null x then "" else val
     (withs, selects) = foldr getQueryParts ([],[]) forest
-    getQueryParts :: Tree Query -> ([Text], [Text]) -> ([Text], [Text])
+    getQueryParts :: Tree ReadNode -> ([(SqlFragment, Text)], [SqlFragment]) -> ([(SqlFragment,Text)], [SqlFragment])
-    getQueryParts (Node q@(Select{mainTable=table, relation=(Just (Relation {relType=Child}))}) forst) (w,s) = (w,sel:s)
+    getQueryParts (Node n@(_, (table, Just (Relation {relType=Child}))) forst) (w,s) = (w,sel:s)
       where
         sel = "("
            <> "SELECT array_to_json(array_agg(row_to_json("<>table<>"))) "
            <> "FROM (" <> subquery <> ") " <> table
            <> ") AS " <> table
-           where (B.Stmt subquery _ _) = requestToQuery schema (Node q forst)
+           where subquery = requestToQuery schema (DbRead (Node n forst))
-
+    getQueryParts (Node n@(_, (table, Just (Relation {relType=Parent}))) forst) (w,s) = (wit:w,sel:s)
-    getQueryParts (Node q@(Select{mainTable=table, relation=(Just (Relation{relType=Parent}))}) forst) (w,s) = (wit:w,sel:s)
       where
         sel = "row_to_json(" <> table <> ".*) AS "<>table --TODO must be singular
-        wit = table <> " AS ( " <> subquery <> " )"
+        wit = (table <> " AS ( " <> subquery <> " )", table)
-          where (B.Stmt subquery _ _) = requestToQuery schema (Node q forst)
+          where subquery = requestToQuery schema (DbRead (Node n forst))
-
+    getQueryParts (Node n@(_, (table, Just (Relation {relType=Many}))) forst) (w,s) = (w,sel:s)
-    getQueryParts (Node q@(Select{mainTable=table, relation=(Just (Relation {relType=Many}))}) forst) (w,s) = (w,sel:s)
       where
         sel = "("
            <> "SELECT array_to_json(array_agg(row_to_json("<>table<>"))) "
            <> "FROM (" <> subquery <> ") " <> table
            <> ") AS " <> table
-           where (B.Stmt subquery _ _) = requestToQuery schema (Node q forst)
+           where subquery = requestToQuery schema (DbRead (Node n forst))
-
+    --the following is just to remove the warning
-    -- the following is just to remove the warning
     --getQueryParts is not total but requestToQuery is called only after addJoinConditions which ensures the only
     --posible relations are Child Parent Many
-    getQueryParts (Node (Select{relation=Nothing}) _) _ = undefined
+    getQueryParts (Node (_,(_,Nothing)) _) _ = undefined
+requestToQuery schema (DbMutate (Insert mainTbl (PayloadJSON (UniformObjects rows)))) =
+  let qi = QualifiedIdentifier schema mainTbl
+      cols = map pgFmtIdent $ fromMaybe [] (HM.keys <$> (rows V.!? 0))
+      colsString = intercalate ", " cols in
+  unwords [
+    "INSERT INTO ", fromQi qi,
+    " (" <> colsString <> ")" <>
+    " SELECT " <> colsString <>
+    " FROM json_populate_recordset(null::" , fromQi qi, ", ?)",
+    " RETURNING " <> fromQi qi <> ".*"
+    ]
+requestToQuery schema (DbMutate (Update mainTbl (PayloadJSON (UniformObjects rows)) conditions)) =
+  case rows V.!? 0 of
+    Just obj ->
+      let assignments = map
+            (\(k,v) -> pgFmtIdent k <> "=" <> insertableValue v) $ HM.toList obj in
+      unwords [
+        "UPDATE ", fromQi qi,
+        " SET " <> intercalate "," assignments <> " ",
+        ("WHERE " <> intercalate " AND " ( map (pgFmtCondition qi ) conditions )) `emptyOnNull` conditions,
+        "RETURNING " <> fromQi qi <> ".*"
+        ]
+    Nothing -> undefined
+  where
+    qi = QualifiedIdentifier schema mainTbl
 
-pgFmtCondition :: QualifiedIdentifier -> Filter -> Text
+requestToQuery schema (DbMutate (Delete mainTbl conditions)) =
+  query
+  where
+    qi = QualifiedIdentifier schema mainTbl
+    query = unwords [
+      "DELETE FROM ", fromQi qi,
+      ("WHERE " <> intercalate " AND " ( map (pgFmtCondition qi ) conditions )) `emptyOnNull` conditions,
+      "RETURNING " <> fromQi qi <> ".*"
+      ]
+
+sourceSubqueryName :: SqlFragment
+sourceSubqueryName = "pg_source"
+
+unquoted :: JSON.Value -> Text
+unquoted (JSON.String t) = t
+unquoted (JSON.Number n) =
+  cs $ formatScientific Fixed (if isInteger n then Just 0 else Nothing) n
+unquoted (JSON.Bool b) = cs . show $ b
+unquoted v = cs $ JSON.encode v
+
+-- private functions
+asCsvF :: SqlFragment
+asCsvF = asCsvHeaderF <> " || '\n' || " <> asCsvBodyF
+  where
+    asCsvHeaderF =
+      "(SELECT string_agg(a.k, ',')" <>
+      "  FROM (" <>
+      "    SELECT json_object_keys(r)::TEXT as k" <>
+      "    FROM ( " <>
+      "      SELECT row_to_json(hh) as r from " <> sourceSubqueryName <> " as hh limit 1" <>
+      "    ) s" <>
+      "  ) a" <>
+      ")"
+    asCsvBodyF = "coalesce(string_agg(substring(t::text, 2, length(t::text) - 2), '\n'), '')"
+
+asJsonF :: SqlFragment
+asJsonF = "array_to_json(array_agg(row_to_json(t)))::character varying"
+
+asJsonSingleF :: SqlFragment --TODO! unsafe when the query actually returns multiple rows, used only on inserting and returning single element
+asJsonSingleF = "string_agg(row_to_json(t)::text, ',')::character varying "
+
+countAllF :: SqlFragment
+countAllF = "(SELECT pg_catalog.count(1) FROM (SELECT * FROM " <> sourceSubqueryName <> ") a )"
+
+countF :: SqlFragment
+countF = "pg_catalog.count(t)"
+
+countNoneF :: SqlFragment
+countNoneF = "null"
+
+locationF :: [Text] -> SqlFragment
+locationF pKeys =
+    "(" <>
+    " WITH s AS (SELECT row_to_json(ss) as r from " <> sourceSubqueryName <> " as ss  limit 1)" <>
+    " SELECT string_agg(json_data.key || '=' || coalesce( 'eq.' || json_data.value, 'is.null'), '&')" <>
+    " FROM s, json_each_text(s.r) AS json_data" <>
+    (
+      if null pKeys
+      then ""
+      else " WHERE json_data.key IN ('" <> intercalate "','" pKeys <> "')"
+    ) <>
+    ")"
+
+fromQi :: QualifiedIdentifier -> SqlFragment
+fromQi t = (if s == "" then "" else pgFmtIdent s <> ".") <> pgFmtIdent n
+  where
+    n = qiName t
+    s = qiSchema t
+
+getJoinConditions :: Relation -> [Filter]
+getJoinConditions (Relation t cols ft fcs typ lt lc1 lc2) =
+  case typ of
+    Child  -> zipWith (toFilter tN ftN) cols fcs
+    Parent -> zipWith (toFilter tN ftN) cols fcs
+    Many   -> zipWith (toFilter tN ltN) cols (fromMaybe [] lc1) ++ zipWith (toFilter ftN ltN) fcs (fromMaybe [] lc2)
+  where
+    s = if typ == Parent then "" else tableSchema t
+    tN = tableName t
+    ftN = tableName ft
+    ltN = fromMaybe "" (tableName <$> lt)
+    toFilter :: Text -> Text -> Column -> Column -> Filter
+    toFilter tb ftb c fc = Filter (colName c, Nothing) "=" (VForeignKey (QualifiedIdentifier s tb) (ForeignKey fc{colTable=(colTable fc){tableName=ftb}}))
+
+emptyOnNull :: Text -> [a] -> Text
+emptyOnNull val x = if null x then "" else val
+
+orderF :: [OrderTerm] -> SqlFragment
+orderF ts =
+  if null ts
+    then ""
+    else "ORDER BY " <> clause
+  where
+    clause = intercalate "," (map queryTerm ts)
+    queryTerm :: OrderTerm -> Text
+    queryTerm t = " "
+           <> cs (pgFmtIdent $ otTerm t) <> " "
+           <> (cs.show) (otDirection t) <> " "
+           <> maybe "" (cs.show) (otNullOrder t) <> " "
+
+insertableValue :: JSON.Value -> SqlFragment
+insertableValue JSON.Null = "null"
+insertableValue v = (<> "::unknown") . pgFmtLit $ unquoted v
+
+whiteList :: Text -> SqlFragment
+whiteList val = fromMaybe
+  (cs (pgFmtLit val) <> "::unknown ")
+  (find ((==) . toLower $ val) ["null","true","false"])
+
+pgFmtColumn :: QualifiedIdentifier -> Text -> SqlFragment
+pgFmtColumn table "*" = fromQi table <> ".*"
+pgFmtColumn table c = fromQi table <> "." <> pgFmtIdent c
+
+pgFmtField :: QualifiedIdentifier -> Field -> SqlFragment
+pgFmtField table (c, jp) = pgFmtColumn table c <> pgFmtJsonPath jp
+
+pgFmtSelectItem :: QualifiedIdentifier -> SelectItem -> SqlFragment
+pgFmtSelectItem table (f@(_, jp), Nothing) = pgFmtField table f <> pgFmtAsJsonPath jp
+pgFmtSelectItem table (f@(_, jp), Just cast ) = "CAST (" <> pgFmtField table f <> " AS " <> cast <> " )" <> pgFmtAsJsonPath jp
+
+pgFmtCondition :: QualifiedIdentifier -> Filter -> SqlFragment
 pgFmtCondition table (Filter (col,jp) ops val) =
   notOp <> " " <> sqlCol  <> " " <> pgFmtOperator opCode <> " " <>
     if opCode `elem` ["is","isnot"] then whiteList (getInner val) else sqlValue
@@ -142,24 +388,59 @@ pgFmtCondition table (Filter (col,jp) ops val) =
       _      -> ""
     valToStr v = case v of
       VText s -> pgFmtValue opCode s
-      VForeignKey (QualifiedIdentifier s _) (ForeignKey ft fc) -> pgFmtColumn (QualifiedIdentifier s ft) fc
+      VForeignKey (QualifiedIdentifier s _) (ForeignKey Column{colTable=Table{tableName=ft}, colName=fc}) -> pgFmtColumn qi fc
+        where qi = QualifiedIdentifier (if ft == sourceSubqueryName then "" else s) ft
+      _ -> ""
 
-pgFmtColumn :: QualifiedIdentifier -> Text -> Text
+pgFmtValue :: Text -> Text -> SqlFragment
-pgFmtColumn table "*" = fromQi table <> ".*"
+pgFmtValue opCode val =
-pgFmtColumn table c = fromQi table <> "." <> pgFmtIdent c
+ case opCode of
+   "like" -> unknownLiteral $ T.map star val
+   "ilike" -> unknownLiteral $ T.map star val
+   "in" -> "(" <> intercalate ", " (map unknownLiteral $ split (==',') val) <> ") "
+   "notin" -> "(" <> intercalate ", " (map unknownLiteral $ split (==',') val) <> ") "
+   "@@" -> "to_tsquery(" <> unknownLiteral val <> ") "
+   _    -> unknownLiteral val
+ where
+   star c = if c == '*' then '%' else c
+   unknownLiteral = (<> "::unknown ") . pgFmtLit
 
-pgFmtJsonPath :: Maybe JsonPath -> Text
+pgFmtOperator :: Text -> SqlFragment
+pgFmtOperator opCode = fromMaybe "=" $ M.lookup opCode operatorsMap
+  where
+    operatorsMap = M.fromList operators
+
+pgFmtJsonPath :: Maybe JsonPath -> SqlFragment
 pgFmtJsonPath (Just [x]) = "->>" <> pgFmtLit x
 pgFmtJsonPath (Just (x:xs)) = "->" <> pgFmtLit x <> pgFmtJsonPath ( Just xs )
 pgFmtJsonPath _ = ""
 
-pgFmtTable :: Table -> Text
+pgFmtAsJsonPath :: Maybe JsonPath -> SqlFragment
-pgFmtTable Table{tableSchema=s, tableName=n} = fromQi $ QualifiedIdentifier s n
+pgFmtAsJsonPath Nothing = ""
+pgFmtAsJsonPath (Just xx) = " AS " <> last xx
 
-pgFmtSelectItem :: QualifiedIdentifier -> SelectItem -> Text
+trimNullChars :: Text -> Text
-pgFmtSelectItem table ((c, jp), Nothing) = pgFmtColumn table c <> pgFmtJsonPath jp <> asJsonPath jp
+trimNullChars = T.takeWhile (/= '\x0')
-pgFmtSelectItem table ((c, jp), Just cast ) = "CAST (" <> pgFmtColumn table c <> pgFmtJsonPath jp <> " AS " <> cast <> " )" <> asJsonPath jp
 
-asJsonPath :: Maybe JsonPath -> Text
+withSourceF :: SqlFragment -> SqlFragment
-asJsonPath Nothing = ""
+withSourceF s = "WITH " <> sourceSubqueryName <> " AS (" <> s <>")"
-asJsonPath (Just xx) = " AS " <> last xx
+
+fromF :: SqlFragment -> SqlFragment -> SqlFragment
+fromF sel limit = "FROM (" <> sel <> " " <> limit <> ") t"
+
+limitF :: Maybe NonnegRange -> SqlFragment
+limitF r  = "LIMIT " <> limit <> " OFFSET " <> offset
+  where
+    limit  = maybe "ALL" (cs . show) $ join $ rangeLimit <$> r
+    offset = cs . show $ fromMaybe 0 $ rangeOffset <$> r
+
+selectStarF :: SqlFragment
+selectStarF = "SELECT * FROM " <> sourceSubqueryName
+
+wrapQuery :: SqlQuery -> [Text] -> Text ->  Maybe NonnegRange -> SqlQuery
+wrapQuery source selectColumns returnSelect range =
+  withSourceF source <>
+  " SELECT " <>
+  intercalate ", " selectColumns <>
+  " " <>
+  fromF returnSelect ( limitF range )

src/PostgREST/Types.hs

@@ -1,73 +1,101 @@
 module PostgREST.Types where
 import Data.Text
 import Data.Tree
-import qualified Data.ByteString.Char8 as BS
+import qualified Data.ByteString.Lazy as BL
+import qualified Data.ByteString      as BS
+import qualified Data.Vector          as V
 import Data.Aeson
 
 data DbStructure = DbStructure {
-  tables :: [Table]
+  dbTables :: [Table]
-, columns :: [Column]
+, dbColumns :: [Column]
-, relations :: [Relation]
+, dbRelations :: [Relation]
-, primaryKeys :: [PrimaryKey]
+, dbPrimaryKeys :: [PrimaryKey]
-}
-
-
-data Table = Table {
-  tableSchema :: Text
-, tableName :: Text
-, tableInsertable :: Bool
-, tableAcl :: [Text]
-} deriving (Show)
-
-data ForeignKey = ForeignKey {
-  fkTable::Text, fkCol::Text
 } deriving (Show, Eq)
 
+type Schema = Text
+type TableName = Text
+type SqlQuery = Text
+type SqlFragment = Text
+type RequestBody = BL.ByteString
 
-data Column = Column {
+data Table = Table {
-  colSchema :: Text
+  tableSchema     :: Schema
-, colTable :: Text
+, tableName       :: TableName
-, colName :: Text
+, tableInsertable :: Bool
-, colPosition :: Int
+} deriving (Show, Ord)
-, colNullable :: Bool
+
-, colType :: Text
+data ForeignKey = ForeignKey { fkCol :: Column } deriving (Show, Eq, Ord)
-, colUpdatable :: Bool
+
-, colMaxLen :: Maybe Int
+data Column =
-, colPrecision :: Maybe Int
+    Column {
-, colDefault :: Maybe Text
+      colTable     :: Table
-, colEnum :: [Text]
+    , colName      :: Text
-, colFK :: Maybe ForeignKey
+    , colPosition  :: Int
-} | Star {colSchema :: Text, colTable :: Text } deriving (Show)
+    , colNullable  :: Bool
+    , colType      :: Text
+    , colUpdatable :: Bool
+    , colMaxLen    :: Maybe Int
+    , colPrecision :: Maybe Int
+    , colDefault   :: Maybe Text
+    , colEnum      :: [Text]
+    , colFK        :: Maybe ForeignKey
+    }
+  | Star { colTable :: Table }
+  deriving (Show, Ord)
+
+type Synonym = (Column,Column)
 
 data PrimaryKey = PrimaryKey {
-  pkSchema::Text, pkTable::Text, pkName::Text
+    pkTable :: Table
-}
+  , pkName  :: Text
+} deriving (Show, Eq)
+
+data OrderDirection = OrderAsc | OrderDesc deriving (Eq)
+instance Show OrderDirection where
+  show OrderAsc  = "asc"
+  show OrderDesc = "desc"
+
+data OrderNulls = OrderNullsFirst | OrderNullsLast deriving (Eq)
+instance Show OrderNulls where
+  show OrderNullsFirst = "nulls first"
+  show OrderNullsLast  = "nulls last"
 
 data OrderTerm = OrderTerm {
-  otTerm :: Text
+  otTerm      :: Text
-, otDirection :: BS.ByteString
+, otDirection :: OrderDirection
-, otNullOrder :: Maybe BS.ByteString
+, otNullOrder :: Maybe OrderNulls
 } deriving (Show, Eq)
 
 data QualifiedIdentifier = QualifiedIdentifier {
-  qiSchema :: Text
+  qiSchema :: Schema
-, qiName   :: Text
+, qiName   :: TableName
 } deriving (Show, Eq)
 
 
 data RelationType = Child | Parent | Many deriving (Show, Eq)
 data Relation = Relation {
-  relSchema  :: Text
+  relTable    :: Table
-, relTable   :: Text
+, relColumns  :: [Column]
-, relColumns  :: [Text]
+, relFTable   :: Table
-, relFTable  :: Text
+, relFColumns :: [Column]
-, relFColumns :: [Text]
+, relType     :: RelationType
-, relType    :: RelationType
+, relLTable   :: Maybe Table
-, relLTable  :: Maybe Text
+, relLCols1   :: Maybe [Column]
-, relLCols1   :: Maybe [Text]
+, relLCols2   :: Maybe [Column]
-, relLCols2   :: Maybe [Text]
 } deriving (Show, Eq)
 
+-- | An array of JSON objects that has been verified to have
+-- the same keys in every object
+newtype UniformObjects = UniformObjects (V.Vector Object)
+  deriving (Show, Eq)
+
+-- | When Hasql supports the COPY command then we can
+-- have a special payload just for CSV, but until
+-- then CSV is converted to a JSON array.
+data Payload = PayloadJSON UniformObjects
+             | PayloadParseError BS.ByteString
+             deriving (Show, Eq)
 
 type Operator = Text
 data FValue = VText Text | VForeignKey QualifiedIdentifier ForeignKey deriving (Show, Eq)
@@ -75,23 +103,23 @@ type FieldName = Text
 type JsonPath = [Text]
 type Field = (FieldName, Maybe JsonPath)
 type Cast = Text
+type NodeName = Text
 type SelectItem = (Field, Maybe Cast)
 type Path = [Text]
-data Query = Select {
+data ReadQuery = Select { select::[SelectItem], from::[Text], flt_::[Filter], order::Maybe [OrderTerm] }  deriving (Show, Eq)
-  mainTable::Text
+data MutateQuery = Insert { in_::Text, qPayload::Payload }
-, fields::[SelectItem]
+                 | Delete { in_::Text, where_::[Filter] }
-, joinTables::[Text]
+                 | Update { in_::Text, qPayload::Payload, where_::[Filter] } deriving (Show, Eq)
-, filters::[Filter]
-, order::Maybe [OrderTerm]
-, relation::Maybe Relation
-} deriving (Show, Eq)
 data Filter = Filter {field::Field, operator::Operator, value::FValue} deriving (Show, Eq)
-type ApiRequest = Tree Query
+type ReadNode = (ReadQuery, (NodeName, Maybe Relation))
+type ReadRequest = Tree ReadNode
+type MutateRequest = MutateQuery
+data DbRequest = DbRead ReadRequest | DbMutate MutateRequest
 
 
 instance ToJSON Column where
   toJSON c = object [
-      "schema"    .= colSchema c
+      "schema"    .= tableSchema t
     , "name"      .= colName c
     , "position"  .= colPosition c
     , "nullable"  .= colNullable c
@@ -102,12 +130,27 @@ instance ToJSON Column where
     , "references".= colFK c
     , "default"   .= colDefault c
     , "enum"      .= colEnum c ]
+    where
+      t = colTable c
 
 instance ToJSON ForeignKey where
-  toJSON fk = object ["table".=fkTable fk, "column".=fkCol fk]
+  toJSON fk = object [
+      "schema" .= tableSchema t
+    , "table"  .= tableName t
+    , "column" .= colName c ]
+    where
+      c = fkCol fk
+      t = colTable c
 
 instance ToJSON Table where
   toJSON v = object [
       "schema"     .= tableSchema v
     , "name"       .= tableName v
     , "insertable" .= tableInsertable v ]
+
+instance Eq Table where
+  Table{tableSchema=s1,tableName=n1} == Table{tableSchema=s2,tableName=n2} = s1 == s2 && n1 == n2
+
+instance Eq Column where
+  Column{colTable=t1,colName=n1} == Column{colTable=t2,colName=n2} = t1 == t2 && n1 == n2
+  _ == _ = False

stack.yaml

@@ -1,7 +1,7 @@
 flags: {}
 packages:
 - '.'
-extra-deps: 
+extra-deps:
   - Ranged-sets-0.3.0
   - packdeps-0.4.1
-resolver: lts-3.10
+resolver: nightly-2015-10-27

test/Feature/AuthSpec.hs

@@ -18,55 +18,53 @@ spec = beforeAll
   it "hides tables that anonymous does not own" $
     get "/authors_only" `shouldRespondWith` 404
 
-  it "indicates login failure (BasicAuth)" $ do
+  it "returns jwt functions as jwt tokens" $
-    let auth = authHeaderBasic "postgrest_test_author" "fakefake"
+    post "/rpc/login" [json| { "id": "jdoe", "pass": "1234" } |]
-    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 "respects database constraints for role" $
-    post "/postgrest/users" [json| { "id": "ssmith", "pass": "1234", "role": "SUPER_ADMIN_TRUNCATE_POWERS" } |]
-      `shouldRespondWith` 400
-
-  it "does not send a value when no role is provided" $ do
-    post "/postgrest/users" [json| { "id": "bdeey", "pass": "1234" } |]
-      `shouldRespondWith` 201
-    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
+        , matchStatus = 200
         , matchHeaders = ["Content-Type" <:> "application/json"]
         }
 
-  it "indicates login failure (JWT)" $ do
+  it "allows users with permissions to see their tables" $ 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
+
+  it "works with tokens which have extra fields" $ do
+    let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJyb2xlIjoicG9zdGdyZXN0X3Rlc3RfYXV0aG9yIiwiaWQiOiJqZG9lIiwia2V5MSI6InZhbHVlMSIsImtleTIiOiJ2YWx1ZTIiLCJrZXkzIjoidmFsdWUzIiwiYSI6MSwiYiI6MiwiYyI6M30.GfydCh-F4wnM379xs0n1zUgalwJIsb6YoBapCo8HlFk"
+    request methodGet "/authors_only" [auth] ""
+      `shouldRespondWith` 200
+
+  -- this test will stop working 9999999999s after the UNIX EPOCH
+  it "succeeds with an unexpired token" $ do
+    let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJleHAiOjk5OTk5OTk5OTksInJvbGUiOiJwb3N0Z3Jlc3RfdGVzdF9hdXRob3IiLCJpZCI6Impkb2UifQ.QaPPLWTuyydMu_q7H4noMT7Lk6P4muet1OpJXF6ofhc"
+    request methodGet "/authors_only" [auth] ""
+      `shouldRespondWith` 200
+
+  it "fails with an expired token" $ do
+    let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJleHAiOjE0NDY2NzgxNDksInJvbGUiOiJwb3N0Z3Jlc3RfdGVzdF9hdXRob3IiLCJpZCI6Impkb2UifQ.enk_qZ_u6gZsXY4R8bREKB_HNExRpM0lIWSLktk9JJQ"
+    request methodGet "/authors_only" [auth] ""
+      `shouldRespondWith` 400
+
+  it "hides tables from users with invalid JWT" $ do
+    let auth = authHeaderJWT "ey9zdGdyZXN0X3Rlc3RfYXV0aG9yIiwiaWQiOiJqZG9lIn0.y4vZuu1dDdwAl0-S00MCRWRYMlJ5YAMSir6Es6WtWx0"
+    request methodGet "/authors_only" [auth] ""
+      `shouldRespondWith` 400
+
+  it "should fail when jwt contains no claims" $ do
+    let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.e30.MKYc_lOECtB0LJOiykilAdlHodB-I0_id2qHKq35dmc"
+    request methodGet "/authors_only" [auth] ""
+      `shouldRespondWith` 400
+
+  it "hides tables from users with JWT that contain no claims about role" $ do
+    let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJpZCI6Impkb2UifQ.zyohGMnrDy4_8eJTl6I2AUXO3MeCCiwR24aGWRkTE9o"
+    request methodGet "/authors_only" [auth] ""
+      `shouldRespondWith` 400
+
+  it "recovers after 400 error with logged in user" $ do
+    _ <- post "/authors_only" [json| { "owner": "jdoe", "secret": "test content" } |]
+    let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJyb2xlIjoicG9zdGdyZXN0X3Rlc3RfYXV0aG9yIiwiaWQiOiJqZG9lIn0.y4vZuu1dDdwAl0-S00MCRWRYMlJ5YAMSir6Es6WtWx0"
+    _ <- request methodPost "/rpc/problem" [auth] ""
+    request methodGet "/authors_only" [auth] ""
+      `shouldRespondWith` 200

test/Feature/CorsSpec.hs

@@ -41,7 +41,7 @@ spec = around withApp $ describe "CORS" $ do
             "true"
           respHeaders `shouldSatisfy` matchHeader
             "Access-Control-Allow-Methods"
-            "GET, POST, PUT, PATCH, DELETE, OPTIONS, HEAD"
+            "GET, POST, PATCH, DELETE, OPTIONS, HEAD"
           respHeaders `shouldSatisfy` matchHeader
             "Access-Control-Allow-Headers"
             "Authentication, Foo, Bar, Accept, Accept-Language, Content-Language"

test/Feature/InsertSpec.hs

@@ -1,6 +1,6 @@
 module Feature.InsertSpec where
 
-import Test.Hspec
+import Test.Hspec hiding (pendingWith)
 import Test.Hspec.Wai
 import Test.Hspec.Wai.JSON
 import Network.Wai.Test (SResponse(simpleBody,simpleHeaders,simpleStatus))
@@ -19,16 +19,38 @@ import TestTypes(IncPK(..), CompoundPK(..))
 spec :: Spec
 spec = afterAll_ resetDb $ around withApp $ do
   describe "Posting new record" $ do
-    after_ (clearTable "menagerie") . it "accepts disparate json types" $ do
+    after_ (clearTable "menagerie") . context "disparate csv types" $ do
-      p <- post "/menagerie"
+      it "accepts disparate json types" $ do
-        [json| {
+        p <- post "/menagerie"
-          "integer": 13, "double": 3.14159, "varchar": "testing!"
+          [json| {
-        , "boolean": false, "date": "1900-01-01", "money": "$3.99"
+            "integer": 13, "double": 3.14159, "varchar": "testing!"
-        , "enum": "foo"
+          , "boolean": false, "date": "1900-01-01", "money": "$3.99"
-        } |]
+          , "enum": "foo"
-      liftIO $ do
+          } |]
-        simpleBody p `shouldBe` ""
+        liftIO $ do
-        simpleStatus p `shouldBe` created201
+          simpleBody p `shouldBe` ""
+          simpleStatus p `shouldBe` created201
+
+      it "filters columns in result using &select" $
+        request methodPost "/menagerie?select=integer,varchar" [("Prefer", "return=representation")]
+          [json| {
+            "integer": 14, "double": 3.14159, "varchar": "testing!"
+          , "boolean": false, "date": "1900-01-01", "money": "$3.99"
+          , "enum": "foo"
+          } |] `shouldRespondWith` ResponseMatcher {
+            matchBody    = Just [str|{"integer":14,"varchar":"testing!"}|]
+          , matchStatus  = 201
+          , matchHeaders = ["Content-Type" <:> "application/json"]
+          }
+
+      it "includes related data after insert" $
+        request methodPost "/projects?select=id,name,clients{id,name}" [("Prefer", "return=representation")]
+          [str|{"id":5,"name":"New Project","client_id":2}|] `shouldRespondWith` ResponseMatcher {
+            matchBody    = Just [str|{"id":5,"name":"New Project","clients":{"id":2,"name":"Apple"}}|]
+          , matchStatus  = 201
+          , matchHeaders = ["Content-Type" <:> "application/json", "Location" <:> "/projects?id=eq.5"]
+          }
+
 
     context "with no pk supplied" $ do
       context "into a table with auto-incrementing pk" . after_ (clearTable "auto_incrementing_pk") $
@@ -92,74 +114,121 @@ spec = afterAll_ resetDb $ around withApp $ do
     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
+        request methodPost "/json"
-        liftIO $ do
+                     [("Prefer", "return=representation")]
-          simpleBody p `shouldBe` inserted
+                     inserted
-          simpleHeaders p `shouldSatisfy` matchHeader hLocation "/json\\?data=eq\\.%7B%22foo%22%3A%22bar%22%7D"
+          `shouldRespondWith` ResponseMatcher {
-          simpleStatus p `shouldBe` created201
+            matchBody    = Just inserted
+          , matchStatus  = 201
+          , matchHeaders = ["Location" <:> [str|/json?data=eq.{"foo":"bar"}|]]
+          }
+
+        -- TODO! the test above seems right, why was the one below working before and not now
+        -- p <- request methodPost "/json" [("Prefer", "return=representation")] inserted
+        -- liftIO $ do
+        --   simpleBody p `shouldBe` inserted
+        --   simpleHeaders p `shouldSatisfy` matchHeader hLocation "/json\\?data=eq\\.%7B%22foo%22%3A%22bar%22%7D"
+        --   simpleStatus p `shouldBe` created201
+
       it "serializes nested array" $ do
         let inserted = [json| { "data": [1,2,3] } |]
-        p <- request methodPost "json" [("Prefer", "return=representation")] inserted
+        request methodPost "/json"
-        liftIO $ do
+                     [("Prefer", "return=representation")]
-          simpleBody p `shouldBe` inserted
+                     inserted
-          simpleHeaders p `shouldSatisfy` matchHeader hLocation "/json\\?data=eq\\.%5B1%2C2%2C3%5D"
+          `shouldRespondWith` ResponseMatcher {
-          simpleStatus p `shouldBe` created201
+            matchBody    = Just inserted
+          , matchStatus  = 201
+          , matchHeaders = ["Location" <:> [str|/json?data=eq.[1,2,3]|]]
+          }
+        -- TODO! the test above seems right, why was the one below working before and not now
+        -- p <- request methodPost "/json" [("Prefer", "return=representation")] inserted
+        -- liftIO $ do
+        --   simpleBody p `shouldBe` inserted
+        --   simpleHeaders p `shouldSatisfy` matchHeader hLocation "/json\\?data=eq\\.%5B1%2C2%2C3%5D"
+        --   simpleStatus p `shouldBe` created201
 
   describe "CSV insert" $ do
 
     after_ (clearTable "menagerie") . context "disparate csv types" $
       it "succeeds with multipart response" $ do
-        p <- request methodPost "/menagerie" [("Content-Type", "text/csv")]
+        pendingWith "Decide on what to do with CSV insert"
-               [str|integer,double,varchar,boolean,date,money,enum
+        let inserted = [str|integer,double,varchar,boolean,date,money,enum
-                   |13,3.14159,testing!,false,1900-01-01,$3.99,foo
+            |13,3.14159,testing!,false,1900-01-01,$3.99,foo
-                   |12,0.1,a string,true,1929-10-01,12,bar
+            |12,0.1,a string,true,1929-10-01,12,bar
-                   |]
+            |]
-        liftIO $ do
+        request methodPost "/menagerie" [("Content-Type", "text/csv"), ("Accept", "text/csv"), ("Prefer", "return=representation")] inserted
-          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
+           `shouldRespondWith` ResponseMatcher {
+             matchBody    = Just inserted
+           , matchStatus  = 201
+           , matchHeaders = ["Content-Type" <:> "text/csv"]
+           }
+        -- p <- request methodPost "/menagerie" [("Content-Type", "text/csv")]
+        --        [str|integer,double,varchar,boolean,date,money,enum
+        --            |13,3.14159,testing!,false,1900-01-01,$3.99,foo
+        --            |12,0.1,a string,true,1929-10-01,12,bar
+        --            |]
+        -- liftIO $ do
+        --   simpleBody p `shouldBe` "Content-Type: application/json\nLocation: /menagerie?integer=eq.13\n\n\n--postgrest_boundary\nContent-Type: application/json\nLocation: /menagerie?integer=eq.12\n\n"
+        --   simpleStatus p `shouldBe` created201
 
     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")]
+                     [("Content-Type", "text/csv"), ("Accept", "text/csv"),  ("Prefer", "return=representation")]
                      "a,b\nbar,baz"
           `shouldRespondWith` ResponseMatcher {
-            matchBody    = Just [json| { "a":"bar", "b":"baz" } |]
+            matchBody    = Just "a,b\nbar,baz"
           , matchStatus  = 201
-          , matchHeaders = ["Content-Type" <:> "application/json",
+          , matchHeaders = ["Content-Type" <:> "text/csv",
                             "Location" <:> "/no_pk?a=eq.bar&b=eq.baz"]
           }
 
+      -- it "can post nulls (old way)" $ do
+      --   pendingWith "changed the response when in csv mode"
+      --   request methodPost "/no_pk"
+      --                [("Content-Type", "text/csv"), ("Prefer", "return=representation")]
+      --                "a,b\nNULL,foo"
+      --     `shouldRespondWith` ResponseMatcher {
+      --       matchBody    = Just [json| { "a":null, "b":"foo" } |]
+      --     , matchStatus  = 201
+      --     , matchHeaders = ["Content-Type" <:> "application/json",
+      --                       "Location" <:> "/no_pk?a=is.null&b=eq.foo"]
+      --     }
       it "can post nulls" $
         request methodPost "/no_pk"
-                     [("Content-Type", "text/csv"), ("Prefer", "return=representation")]
+                     [("Content-Type", "text/csv"), ("Accept", "text/csv"), ("Prefer", "return=representation")]
                      "a,b\nNULL,foo"
           `shouldRespondWith` ResponseMatcher {
-            matchBody    = Just [json| { "a":null, "b":"foo" } |]
+            matchBody    = Just "a,b\n,foo"
           , matchStatus  = 201
-          , matchHeaders = ["Content-Type" <:> "application/json",
+          , matchHeaders = ["Content-Type" <:> "text/csv",
                             "Location" <:> "/no_pk?a=is.null&b=eq.foo"]
           }
 
-    after_ (clearTable "no_pk") . context "with wrong number of columns" $ do
+
+    after_ (clearTable "no_pk") . context "with wrong number of columns" $
       it "fails for too few" $ do
         p <- request methodPost "/no_pk" [("Content-Type", "text/csv")] "a,b\nfoo,bar\nbaz"
         liftIO $ simpleStatus p `shouldBe` badRequest400
-      it "fails for too many" $ do
+      -- it does not fail because the extra columns are ignored
-        p <- request methodPost "/no_pk" [("Content-Type", "text/csv")] "a,b\nfoo,bar\nbaz,bat,bad"
+      -- it "fails for too many" $ do
-        liftIO $ simpleStatus p `shouldBe` badRequest400
+      --   p <- request methodPost "/no_pk" [("Content-Type", "text/csv")] "a,b\nfoo,bar\nbaz,bat,bad"
+      --   liftIO $ simpleStatus p `shouldBe` badRequest400
 
   describe "Putting record" $ do
 
     context "to unkonwn uri" $
-      it "gives a 404" $
+      it "gives a 404" $ do
+        pendingWith "Decide on PUT usefullness"
         request methodPut "/fake" []
           [json| { "real": false } |]
             `shouldRespondWith` 404
 
     context "to a known uri" $ do
       context "without a fully-specified primary key" $
-        it "is not an allowed operation" $
+        it "is not an allowed operation" $ do
+          pendingWith "Decide on PUT usefullness"
           request methodPut "/compound_pk?k1=eq.12" []
             [json| { "k1":12, "k2":42 } |]
               `shouldRespondWith` 405
@@ -167,13 +236,15 @@ spec = afterAll_ resetDb $ around withApp $ do
       context "with a fully-specified primary key" $ do
 
         context "not specifying every column in the table" $
-          it "is rejected for lack of idempotence" $
+          it "is rejected for lack of idempotence" $ do
+            pendingWith "Decide on PUT usefullness"
             request methodPut "/compound_pk?k1=eq.12&k2=eq.42" []
               [json| { "k1":12, "k2":42 } |]
                 `shouldRespondWith` 400
 
         context "specifying every column in the table" . after_ (clearTable "compound_pk") $ do
           it "can create a new record" $ do
+            pendingWith "Decide on PUT usefullness"
             p <- request methodPut "/compound_pk?k1=eq.12&k2=eq.42" []
                  [json| { "k1":12, "k2":42, "extra":3 } |]
             liftIO $ do
@@ -190,6 +261,7 @@ spec = afterAll_ resetDb $ around withApp $ do
               compoundExtra record `shouldBe` Just 3
 
           it "can update an existing record" $ do
+            pendingWith "Decide on PUT usefullness"
             _ <- request methodPut "/compound_pk?k1=eq.12&k2=eq.42" []
                  [json| { "k1":12, "k2":42, "extra":4 } |]
             _ <- request methodPut "/compound_pk?k1=eq.12&k2=eq.42" []
@@ -204,7 +276,8 @@ spec = afterAll_ resetDb $ around withApp $ do
 
       context "with an auto-incrementing primary key" . after_ (clearTable "auto_incrementing_pk") $
 
-        it "succeeds with 204" $
+        it "succeeds with 204" $ do
+          pendingWith "Decide on PUT usefullness"
           request methodPut "/auto_incrementing_pk?id=eq.1" []
                [json| {
                  "id":1,
@@ -284,14 +357,15 @@ spec = afterAll_ resetDb $ around withApp $ do
 
   describe "Row level permission" $
     it "set user_id when inserting rows" $ do
+      let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJyb2xlIjoicG9zdGdyZXN0X3Rlc3RfYXV0aG9yIiwiaWQiOiJqZG9lIn0.y4vZuu1dDdwAl0-S00MCRWRYMlJ5YAMSir6Es6WtWx0"
       _ <- post "/postgrest/users" [json| { "id":"jdoe", "pass": "1234", "role": "postgrest_test_author" } |]
       _ <- post "/postgrest/users" [json| { "id":"jroe", "pass": "1234", "role": "postgrest_test_author" } |]
 
       p1 <- request methodPost "/authors_only"
-        [ authHeaderBasic "jdoe" "1234", ("Prefer", "return=representation") ]
+        [ auth, ("Prefer", "return=representation") ]
         [json| { "secret": "nyancat" } |]
       liftIO $ do
-          simpleBody p1 `shouldBe` [json| { "owner":"jdoe", "secret":"nyancat" } |]
+          simpleBody p1 `shouldBe` [str|{"owner":"jdoe","secret":"nyancat"}|]
           simpleStatus p1 `shouldBe` created201
 
       p2 <- request methodPost "/authors_only"
@@ -299,5 +373,5 @@ spec = afterAll_ resetDb $ around withApp $ do
         [ authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJyb2xlIjoicG9zdGdyZXN0X3Rlc3RfYXV0aG9yIiwiaWQiOiJqcm9lIn0.YuF_VfmyIxWyuceT7crnNKEprIYXsJAyXid3rjPjIow", ("Prefer", "return=representation") ]
         [json| { "secret": "lolcat", "owner": "hacker" } |]
       liftIO $ do
-          simpleBody p2 `shouldBe` [json| { "owner":"jroe", "secret":"lolcat" } |]
+          simpleBody p2 `shouldBe` [str|{"owner":"jroe","secret":"lolcat"}|]
           simpleStatus p2 `shouldBe` created201

test/Feature/QuerySpec.hs

@@ -7,10 +7,13 @@ import Network.HTTP.Types
 import Network.Wai.Test (SResponse(simpleHeaders))
 
 import SpecHelper
+import Text.Heredoc
+
 
 spec :: Spec
 spec =
   beforeAll (clearTable "items" >> createItems 15)
+   . beforeAll clearProjectsTable
    . beforeAll (clearTable "complex_items" >> createComplexItems)
    . beforeAll (clearTable "nullable_integer" >> createNullInteger)
    . beforeAll (
@@ -131,14 +134,23 @@ spec =
         [json| [{"id":1},{"id":2},{"id":3},{"id":4},{"id":5},{"id":6},{"id":7},{"id":8},{"id":9},{"id":10},{"id":11},{"id":12},{"id":13},{"id":14},{"id":15}] |]
 
     it "matches filtering nested items" $
-      get "/clients?select=id,projects(id,tasks(id,name))&projects.tasks.name=like.Design*" `shouldRespondWith`
+      get "/clients?select=id,projects{id,tasks{id,name}}&projects.tasks.name=like.Design*" `shouldRespondWith`
         "[{\"id\":1,\"projects\":[{\"id\":1,\"tasks\":[{\"id\":1,\"name\":\"Design w7\"}]},{\"id\":2,\"tasks\":[{\"id\":3,\"name\":\"Design w10\"}]}]},{\"id\":2,\"projects\":[{\"id\":3,\"tasks\":[{\"id\":5,\"name\":\"Design IOS\"}]},{\"id\":4,\"tasks\":[{\"id\":7,\"name\":\"Design OSX\"}]}]}]"
 
+    it "matches with @> operator" $
+      get "/complex_items?select=id&arr_data=@>.{2}" `shouldRespondWith`
+        [str|[{"id":2},{"id":3}]|]
+
+    it "matches with <@ operator" $
+      get "/complex_items?select=id&arr_data=<@.{1,2,4}" `shouldRespondWith`
+        [str|[{"id":1},{"id":2}]|]
+
+
   describe "Shaping response with select parameter" $ do
 
     it "selectStar works in absense of parameter" $
       get "/complex_items?id=eq.3" `shouldRespondWith`
-        "[{\"id\":3,\"name\":\"Three\",\"settings\":{\"foo\":{\"int\":1,\"bar\":\"baz\"}}}]"
+        [str|[{"id":3,"name":"Three","settings":{"foo":{"int":1,"bar":"baz"}},"arr_data":[1,2,3]}]|]
 
     it "one simple column" $
       get "/complex_items?select=id" `shouldRespondWith`
@@ -183,25 +195,57 @@ spec =
         [json| [{"int":1}] |] -- the value in the db is an int, but here we expect a string for now
 
     it "requesting parents and children" $
-      get "/projects?id=eq.1&select=id, name, clients(*), tasks(id, name)" `shouldRespondWith`
+      get "/projects?id=eq.1&select=id, name, clients{*}, tasks{id, name}" `shouldRespondWith`
         "[{\"id\":1,\"name\":\"Windows 7\",\"clients\":{\"id\":1,\"name\":\"Microsoft\"},\"tasks\":[{\"id\":1,\"name\":\"Design w7\"},{\"id\":2,\"name\":\"Code w7\"}]}]"
 
+    it "requesting parents and filtering parent columns" $
+      get "/projects?id=eq.1&select=id, name, clients{id}" `shouldRespondWith`
+        "[{\"id\":1,\"name\":\"Windows 7\",\"clients\":{\"id\":1}}]"
+
     it "requesting children 2 levels" $
-      get "/clients?id=eq.1&select=id,projects(id,tasks(id))" `shouldRespondWith`
+      get "/clients?id=eq.1&select=id,projects{id,tasks{id}}" `shouldRespondWith`
         "[{\"id\":1,\"projects\":[{\"id\":1,\"tasks\":[{\"id\":1},{\"id\":2}]},{\"id\":2,\"tasks\":[{\"id\":3},{\"id\":4}]}]}]"
 
     it "requesting many<->many relation" $
-      get "/tasks?select=id,users(id)" `shouldRespondWith`
+      get "/tasks?select=id,users{id}" `shouldRespondWith`
         "[{\"id\":1,\"users\":[{\"id\":1},{\"id\":3}]},{\"id\":2,\"users\":[{\"id\":1}]},{\"id\":3,\"users\":[{\"id\":1}]},{\"id\":4,\"users\":[{\"id\":1}]},{\"id\":5,\"users\":[{\"id\":2},{\"id\":3}]},{\"id\":6,\"users\":[{\"id\":2}]},{\"id\":7,\"users\":[{\"id\":2}]},{\"id\":8,\"users\":null}]"
 
     it "requesting parents and children on views" $
-      get "/projects_view?id=eq.1&select=id, name, clients(*), tasks(id, name)" `shouldRespondWith`
+      get "/projects_view?id=eq.1&select=id, name, clients{*}, tasks{id, name}" `shouldRespondWith`
         "[{\"id\":1,\"name\":\"Windows 7\",\"clients\":{\"id\":1,\"name\":\"Microsoft\"},\"tasks\":[{\"id\":1,\"name\":\"Design w7\"},{\"id\":2,\"name\":\"Code w7\"}]}]"
 
     it "requesting children with composite key" $
-      get "/users_tasks?user_id=eq.2&task_id=eq.6&select=*, comments(content)" `shouldRespondWith`
+      get "/users_tasks?user_id=eq.2&task_id=eq.6&select=*, comments{content}" `shouldRespondWith`
         "[{\"user_id\":2,\"task_id\":6,\"comments\":[{\"content\":\"Needs to be delivered ASAP\"}]}]"
 
+  describe "Plurality singular" $ do
+    it "will select an existing object" $
+      request methodGet "/items?id=eq.5" [("Prefer","plurality=singular")] ""
+        `shouldRespondWith` ResponseMatcher {
+          matchBody    = Just [json| {"id":5} |]
+        , matchStatus  = 200
+        , matchHeaders = []
+        }
+
+    it "works in the presence of a range header" $
+      let headers = ("Prefer","plurality=singular") :
+            rangeHdrs (ByteRangeFromTo 0 9) in
+      request methodGet "/items" headers ""
+        `shouldRespondWith` ResponseMatcher {
+          matchBody    = Just [json| {"id":1} |]
+        , matchStatus  = 200
+        , matchHeaders = []
+        }
+
+    it "will respond with 404 when not found" $
+      request methodGet "/items?id=eq.9999" [("Prefer","plurality=singular")] ""
+        `shouldRespondWith` 404
+
+    it "can shape plurality singular object routes" $
+      request methodGet "/projects_view?id=eq.1&select=id,name,clients{*},tasks{id,name}" [("Prefer","plurality=singular")] ""
+        `shouldRespondWith`
+          "{\"id\":1,\"name\":\"Windows 7\",\"clients\":{\"id\":1,\"name\":\"Microsoft\"},\"tasks\":[{\"id\":1,\"name\":\"Design w7\"},{\"id\":2,\"name\":\"Code w7\"}]}"
+
 
   describe "ordering response" $ do
     it "by a column asc" $
@@ -272,7 +316,7 @@ spec =
       request methodGet "/simple_pk"
               (acceptHdrs "text/csv; version=1") ""
         `shouldRespondWith` ResponseMatcher {
-          matchBody    = Just "k,extra\rxyyx,u\rxYYx,v"
+          matchBody    = Just "k,extra\nxyyx,u\nxYYx,v"
         , matchStatus  = 200
         , matchHeaders = ["Content-Type" <:> "text/csv"]
         }
@@ -296,12 +340,15 @@ spec =
   describe "jsonb" $ do
     it "can filter by properties inside json column" $ do
       get "/json?data->foo->>bar=eq.baz" `shouldRespondWith`
-        [json| [{"data": {"foo": {"bar": "baz"}}}] |]
+        [json| [{"data": {"id": 1, "foo": {"bar": "baz"}}}] |]
       get "/json?data->foo->>bar=eq.fake" `shouldRespondWith`
         [json| [] |]
     it "can filter by properties inside json column using not" $
       get "/json?data->foo->>bar=not.eq.baz" `shouldRespondWith`
         [json| [] |]
+    it "can filter by properties inside json column using ->>" $
+      get "/json?data->>id=eq.1" `shouldRespondWith`
+        [json| [{"data": {"id": 1, "foo": {"bar": "baz"}}}] |]
 
   describe "remote procedure call" $ do
     context "a proc that returns a set" . before_ (clearTable "items" >> createItems 10) .
@@ -310,6 +357,11 @@ spec =
         post "/rpc/getitemrange" [json| { "min": 2, "max": 4 } |] `shouldRespondWith`
           [json| [ {"id": 3}, {"id":4} ] |]
 
+    context "a proc that returns an empty rowset" $
+      it "returns empty json array" $
+        post "/rpc/test_empty_rowset" [json| {} |] `shouldRespondWith`
+          [json| [] |]
+
     context "a proc that returns plain text" $
       it "returns proper json" $
         post "/rpc/sayhello" [json| { "name": "world" } |] `shouldRespondWith`

test/Feature/StructureSpec.hs

@@ -14,42 +14,42 @@ spec = around withApp $ do
     it "lists views in schema" $
       request methodGet "/" [] ""
         `shouldRespondWith` [json| [
-          {"schema":"1","name":"auto_incrementing_pk","insertable":true}
+          {"schema":"test","name":"articleStars","insertable":true}
-        , {"schema":"1","name":"clients","insertable":true}
+        , {"schema":"test","name":"articles","insertable":true}
-        , {"schema":"1","name":"comments","insertable":true}
+        , {"schema":"test","name":"auto_incrementing_pk","insertable":true}
-        , {"schema":"1","name":"complex_items","insertable":true}
+        , {"schema":"test","name":"clients","insertable":true}
-        , {"schema":"1","name":"compound_pk","insertable":true}
+        , {"schema":"test","name":"comments","insertable":true}
-        , {"schema":"1","name":"has_count_column","insertable":false}
+        , {"schema":"test","name":"complex_items","insertable":true}
-        , {"schema":"1","name":"has_fk","insertable":true}
+        , {"schema":"test","name":"compound_pk","insertable":true}
-        , {"schema":"1","name":"insertable_view_with_join","insertable":true}
+        , {"schema":"test","name":"has_count_column","insertable":false}
-        , {"schema":"1","name":"items","insertable":true}
+        , {"schema":"test","name":"has_fk","insertable":true}
-        , {"schema":"1","name":"json","insertable":true}
+        , {"schema":"test","name":"insertable_view_with_join","insertable":true}
-        , {"schema":"1","name":"materialized_view","insertable":false}
+        , {"schema":"test","name":"items","insertable":true}
-        , {"schema":"1","name":"menagerie","insertable":true}
+        , {"schema":"test","name":"json","insertable":true}
-        , {"schema":"1","name":"no_pk","insertable":true}
+        , {"schema":"test","name":"materialized_view","insertable":false}
-        , {"schema":"1","name":"nullable_integer","insertable":true}
+        , {"schema":"test","name":"menagerie","insertable":true}
-        , {"schema":"1","name":"projects","insertable":true}
+        , {"schema":"test","name":"no_pk","insertable":true}
-        , {"schema":"1","name":"projects_view","insertable":true}
+        , {"schema":"test","name":"nullable_integer","insertable":true}
-        , {"schema":"1","name":"simple_pk","insertable":true}
+        , {"schema":"test","name":"projects","insertable":true}
-        , {"schema":"1","name":"tasks","insertable":true}
+        , {"schema":"test","name":"projects_view","insertable":true}
-        , {"schema":"1","name":"tsearch","insertable":true}
+        , {"schema":"test","name":"simple_pk","insertable":true}
-        , {"schema":"1","name":"users","insertable":true}
+        , {"schema":"test","name":"tasks","insertable":true}
-        , {"schema":"1","name":"users_projects","insertable":true}
+        , {"schema":"test","name":"tsearch","insertable":true}
-        , {"schema":"1","name":"users_tasks","insertable":true}
+        , {"schema":"test","name":"users","insertable":true}
+        , {"schema":"test","name":"users_projects","insertable":true}
+        , {"schema":"test","name":"users_tasks","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 = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJyb2xlIjoicG9zdGdyZXN0X3Rlc3RfYXV0aG9yIiwiaWQiOiJqZG9lIn0.y4vZuu1dDdwAl0-S00MCRWRYMlJ5YAMSir6Es6WtWx0"
-      let auth = authHeaderBasic "jdoe" "1234"
 
       request methodGet "/" [auth] ""
         `shouldRespondWith` [json| [
-            {"schema":"1","name":"authors_only","insertable":true}
+            {"schema":"test","name":"authors_only","insertable":true}
         ] |]
         {matchStatus = 200}
 
-
   describe "Table info" $ do
     it "is available with OPTIONS verb" $
       request methodOptions "/menagerie" [] "" `shouldRespondWith`
@@ -61,7 +61,7 @@ spec = around withApp $ do
             "default": null,
             "precision": 32,
             "updatable": true,
-            "schema": "1",
+            "schema": "test",
             "name": "integer",
             "type": "integer",
             "maxLen": null,
@@ -74,7 +74,7 @@ spec = around withApp $ do
             "default": null,
             "precision": 53,
             "updatable": true,
-            "schema": "1",
+            "schema": "test",
             "name": "double",
             "type": "double precision",
             "maxLen": null,
@@ -86,7 +86,7 @@ spec = around withApp $ do
             "default": null,
             "precision": null,
             "updatable": true,
-            "schema": "1",
+            "schema": "test",
             "name": "varchar",
             "type": "character varying",
             "maxLen": null,
@@ -99,7 +99,7 @@ spec = around withApp $ do
             "default": null,
             "precision": null,
             "updatable": true,
-            "schema": "1",
+            "schema": "test",
             "name": "boolean",
             "type": "boolean",
             "maxLen": null,
@@ -111,7 +111,7 @@ spec = around withApp $ do
             "default": null,
             "precision": null,
             "updatable": true,
-            "schema": "1",
+            "schema": "test",
             "name": "date",
             "type": "date",
             "maxLen": null,
@@ -123,7 +123,7 @@ spec = around withApp $ do
             "default": null,
             "precision": null,
             "updatable": true,
-            "schema": "1",
+            "schema": "test",
             "name": "money",
             "type": "money",
             "maxLen": null,
@@ -136,7 +136,7 @@ spec = around withApp $ do
             "default": null,
             "precision": null,
             "updatable": true,
-            "schema": "1",
+            "schema": "test",
             "name": "enum",
             "type": "USER-DEFINED",
             "maxLen": null,
@@ -154,98 +154,57 @@ spec = around withApp $ do
       |]
 
     it "it includes primary and foreign keys for views" $
-      request methodOptions "/insertable_view_with_join" [] "" `shouldRespondWith`
+      request methodOptions "/projects_view" [] "" `shouldRespondWith`
       [json|
       {
          "pkey":[
             "id"
          ],
          "columns":[
-            {
+          {
-               "references":null,
+            "references":null,
-               "default":null,
+            "default":null,
-               "precision":64,
+            "precision":32,
-               "updatable":false,
+            "updatable":true,
-               "schema":"1",
+            "schema":"test",
-               "name":"id",
+            "name":"id",
-               "type":"bigint",
+            "type":"integer",
-               "maxLen":null,
+            "maxLen":null,
-               "enum":[],
+            "enum":[],
-               "nullable":true,
+            "nullable":true,
-               "position":1
+            "position":1
+          },
+          {
+            "references":null,
+            "default":null,
+            "precision":null,
+            "updatable":true,
+            "schema":"test",
+            "name":"name",
+            "type":"text",
+            "maxLen":null,
+            "enum":[],
+            "nullable":true,
+            "position":2
+          },
+          {
+            "references": {
+              "schema":"test",
+              "column":"id",
+              "table":"clients"
             },
-            {
+            "default":null,
-               "references":{
+            "precision":32,
-                  "column":"id",
+            "updatable":true,
-                  "table":"auto_incrementing_pk"
+            "schema":"test",
-               },
+            "name":"client_id",
-               "default":null,
+            "type":"integer",
-               "precision":32,
+            "maxLen":null,
-               "updatable":false,
+            "enum":[],
-               "schema":"1",
+            "nullable":true,
-               "name":"auto_inc_fk",
+            "position":3
-               "type":"integer",
+          }
-               "maxLen":null,
+        ]
-               "enum":[],
-               "nullable":true,
-               "position":2
-            },
-            {
-               "references":{
-                  "column":"k",
-                  "table":"simple_pk"
-               },
-               "default":null,
-               "precision":null,
-               "updatable":false,
-               "schema":"1",
-               "name":"simple_fk",
-               "type":"character varying",
-               "maxLen":255,
-               "enum":[],
-               "nullable":true,
-               "position":3
-            },
-            {
-               "references":null,
-               "default":null,
-               "precision":null,
-               "updatable":false,
-               "schema":"1",
-               "name":"nullable_string",
-               "type":"character varying",
-               "maxLen":null,
-               "enum":[],
-               "nullable":true,
-               "position":4
-            },
-            {
-               "references":null,
-               "default":null,
-               "precision":null,
-               "updatable":false,
-               "schema":"1",
-               "name":"non_nullable_string",
-               "type":"character varying",
-               "maxLen":null,
-               "enum":[],
-               "nullable":true,
-               "position":5
-            },
-            {
-               "references":null,
-               "default":null,
-               "precision":null,
-               "updatable":false,
-               "schema":"1",
-               "name":"inserted_at",
-               "type":"timestamp with time zone",
-               "maxLen":null,
-               "enum":[],
-               "nullable":true,
-               "position":6
-            }
-         ]
       }
       |]
 
@@ -261,7 +220,7 @@ spec = around withApp $ do
             "default": "nextval('\"1\".has_fk_id_seq'::regclass)",
             "precision": 64,
             "updatable": true,
-            "schema": "1",
+            "schema": "test",
             "name": "id",
             "type": "bigint",
             "maxLen": null,
@@ -273,7 +232,7 @@ spec = around withApp $ do
             "default": null,
             "precision": 32,
             "updatable": true,
-            "schema": "1",
+            "schema": "test",
             "name": "auto_inc_fk",
             "type": "integer",
             "maxLen": null,
@@ -285,7 +244,7 @@ spec = around withApp $ do
             "default": null,
             "precision": null,
             "updatable": true,
-            "schema": "1",
+            "schema": "test",
             "name": "simple_fk",
             "type": "character varying",
             "maxLen": 255,
@@ -297,3 +256,63 @@ spec = around withApp $ do
         ]
       }
       |]
+
+    it "includes all information on views for renamed columns, and raises relations to correct schema" $
+      request methodOptions "/articleStars" [] ""
+        `shouldRespondWith` [json|
+          {
+            "pkey": [
+              "articleId",
+              "userId"
+            ],
+            "columns": [
+              {
+                "references": {
+                  "schema": "test",
+                  "column": "id",
+                  "table": "articles"
+                },
+                "default": null,
+                "precision": 32,
+                "updatable": true,
+                "schema": "test",
+                "name": "articleId",
+                "type": "integer",
+                "maxLen": null,
+                "enum": [],
+                "nullable": true,
+                "position": 1
+              },
+              {
+                "references": {
+                  "schema": "test",
+                  "column": "id",
+                  "table": "users"
+                },
+                "default": null,
+                "precision": 32,
+                "updatable": true,
+                "schema": "test",
+                "name": "userId",
+                "type": "integer",
+                "maxLen": null,
+                "enum": [],
+                "nullable": true,
+                "position": 2
+              },
+              {
+                "references": null,
+                "default": null,
+                "precision": null,
+                "updatable": true,
+                "schema": "test",
+                "name": "createdAt",
+                "type": "timestamp without time zone",
+                "maxLen": null,
+                "enum": [],
+                "nullable": true,
+                "position": 3
+              }
+            ]
+          }
+        |]

test/SpecHelper.hs

@@ -23,32 +23,31 @@ import Data.Maybe (fromMaybe)
 import Text.Regex.TDFA ((=~))
 import qualified Data.ByteString.Char8 as BS
 import System.Process (readProcess)
+import Web.JWT (secret)
 
 import qualified Data.Aeson.Types as J
 
 import PostgREST.App (app)
 import PostgREST.Config (AppConfig(..))
 import PostgREST.Middleware
-import PostgREST.Error(errResponse)
+import PostgREST.Error(pgErrResponse)
-import PostgREST.PgStructure
+import PostgREST.DbStructure
-import PostgREST.Types
+
+dbString :: String
+dbString = "postgres://postgrest_test@localhost:5432/postgrest_test"
 
 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 "1" "safe"
+cfg = AppConfig dbString 3000 "postgrest_anonymous" "test" (secret "safe") 10
 
 testPoolOpts :: PoolSettings
 testPoolOpts = fromMaybe (error "bad settings") $ H.poolSettings 1 30
 
 pgSettings :: P.Settings
-pgSettings = P.ParamSettings (cs $ configDbHost cfg)
+pgSettings = P.StringSettings $ cs dbString
-                             (fromIntegral $ configDbPort cfg)
-                             (cs $ configDbUser cfg)
-                             (cs $ configDbPass cfg)
-                             (cs $ configDbName cfg)
 
 withApp :: ActionWith Application -> IO ()
 withApp perform = do
@@ -56,30 +55,16 @@ withApp perform = do
     <- H.acquirePool pgSettings testPoolOpts
 
   let txSettings = Just (H.ReadCommitted, Just True)
-  metadata <- H.session pool $ H.tx txSettings $ do
+  dbOrError <- H.session pool $ H.tx txSettings $ getDbStructure (cs $ configSchema cfg)
-    tabs <- allTables
+  db <- either (fail . show) return dbOrError
-    rels <- allRelations
-    cols <- allColumns rels
-    keys <- allPrimaryKeys
-    return (tabs, rels, cols, keys)
-
-  dbstructure <- case metadata of
-    Left e -> fail $ show e
-    Right (tabs, rels, cols, keys) ->
-      return $ DbStructure {
-          tables=tabs
-        , columns=cols
-        , relations=rels
-        , primaryKeys=keys
-        }
 
   perform $ middle $ \req resp -> do
     body <- strictRequestBody req
     result <- liftIO $ H.session pool $ H.tx txSettings
-      $ authenticated cfg (app dbstructure cfg body) req
+      $ runWithClaims cfg (app db cfg body) req
-    either (resp . errResponse) resp result
+    either (resp . pgErrResponse) resp result
 
-  where middle = defaultMiddle False
+  where middle = defaultMiddle
 
 
 resetDb :: IO ()
@@ -88,7 +73,7 @@ resetDb = do
     <- H.acquirePool pgSettings testPoolOpts
   void . liftIO $ H.session pool $
     H.tx Nothing $ do
-      H.unitEx [H.stmt| drop schema if exists "1" cascade |]
+      H.unitEx [H.stmt| drop schema if exists test cascade |]
       H.unitEx [H.stmt| drop schema if exists private cascade |]
       H.unitEx [H.stmt| drop schema if exists postgrest cascade |]
 
@@ -129,7 +114,14 @@ 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
+    H.unitEx $ B.Stmt ("delete from test."<>table) V.empty True
+
+clearProjectsTable :: IO ()
+clearProjectsTable = do
+  pool <- testPool
+  void . liftIO $ H.session pool $ H.tx Nothing $
+    H.unitEx $ B.Stmt "delete from test.projects where id > 4" V.empty True
+
 
 createItems :: Int -> IO ()
 createItems n = do
@@ -137,7 +129,7 @@ createItems n = do
   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]
+    stmts = map [H.stmt|insert into test.items (id) values (?)|] [1..n]
 
 createComplexItems :: IO ()
 createComplexItems = do
@@ -145,11 +137,12 @@ createComplexItems = do
   void . liftIO $ H.session pool $ H.tx Nothing txn
   where
     txn = mapM_ H.unitEx stmts
-    stmts = getZipList $ [H.stmt|insert into "1".complex_items (id, name, settings) values (?,?,?)|]
+    stmts = getZipList $ [H.stmt|insert into test.complex_items (id, name, settings, arr_data) values (?,?,?,?)|]
         <$> ZipList ([1..3]::[Int])
         <*> ZipList (["One", "Two", "Three"]::[Text])
-        <*> ZipList ([jobj,jobj,jobj])
+        <*> ZipList [jobj,jobj,jobj]
-    jobj = (J.object [("foo", J.object [("int", J.Number 1),("bar", J.String "baz")])])
+        <*> ZipList ([[1], [1,2], [1,2,3]]::[[Int]])
+    jobj = J.object [("foo", J.object [("int", J.Number 1),("bar", J.String "baz")])]
 
 createNulls :: Int -> IO ()
 createNulls n = do
@@ -157,14 +150,14 @@ createNulls n = do
   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)|]
+    stmt' = [H.stmt|insert into test.no_pk (a,b) values (null,null)|]
-    stmts = map [H.stmt|insert into "1".no_pk (a,b) values (?,0)|] [1..n]
+    stmts = map [H.stmt|insert into test.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) |]
+    H.unitEx $ [H.stmt| insert into "test".nullable_integer (a) values (null) |]
 
 createLikableStrings :: IO ()
 createLikableStrings = do
@@ -174,7 +167,7 @@ createLikableStrings = do
     H.unitEx $ insertSimplePk "xYYx" "v"
   where
     insertSimplePk :: Text -> Text -> H.Stmt P.Postgres
-    insertSimplePk = [H.stmt|insert into "1".simple_pk (k, extra) values (?,?)|]
+    insertSimplePk = [H.stmt|insert into test.simple_pk (k, extra) values (?,?)|]
 
 createJsonData :: IO ()
 createJsonData = do
@@ -182,6 +175,8 @@ createJsonData = do
   void . liftIO $ H.session pool $ H.tx Nothing $
     H.unitEx $
       [H.stmt|
-        insert into "1".json (data) values (?)
+        insert into test.json (data) values (?)
       |]
-      (J.object [("foo", J.object [("bar", J.String "baz")])])
+      (J.object [("id", J.Number 1)
+                ,("foo", J.object [("bar", J.String "baz")])
+                ])

test/Unit/DbStructureSpec.hx

@@ -1,7 +1,7 @@
-module Unit.PgStructureSpec where
+module Unit.DbStructureSpec where
 
 import Test.Hspec
-import PgStructure (Table(..), tables, Column(..), columns, ForeignKey(..),
+import DbStructure (Table(..), tables, Column(..), columns, ForeignKey(..),
   foreignKeys)
 
 import Database.HDBC (quickQuery)
@@ -12,25 +12,25 @@ spec :: Spec
 spec = around dbWithSchema $ beforeWith setRole $ do
   describe "tables" $
     it "shows all the tables" $ \conn -> do
-      ts <- tables "1" conn
+      ts <- tables "test" conn
       map tableName ts `shouldBe` ["authors_only","auto_incrementing_pk",
         "compound_pk","has_fk","insertable_view_with_join","items","menagerie","no_pk", "simple_pk"]
 
   describe "columns" $ do
     it "responds with each column for the table" $ \conn -> do
-      cs <- columns "1" "auto_incrementing_pk" conn
+      cs <- columns "test" "auto_incrementing_pk" conn
       map colName cs `shouldBe` ["id","nullable_string","non_nullable_string",
         "inserted_at"]
 
     it "includes foreign key data" $ \conn -> do
-      cs <- columns "1" "has_fk" conn
+      cs <- columns "test" "has_fk" conn
       map colFK cs `shouldBe` [Nothing,
         Just $ ForeignKey "auto_incrementing_pk" "id",
         Just $ ForeignKey "simple_pk" "k"]
 
   describe "foreignKeys" $
     it "has a description of the foreign key columns" $ \conn ->
-      foreignKeys "1" "has_fk" conn `shouldReturn` M.fromList [
+      foreignKeys "test" "has_fk" conn `shouldReturn` M.fromList [
         ("auto_inc_fk", ForeignKey {fkTable="auto_incrementing_pk", fkCol="id"}),
         ("simple_fk", ForeignKey { fkTable="simple_pk", fkCol="k"})]
 

test/Unit/PgQuerySpec.hx

@@ -32,7 +32,7 @@ spec = around dbWithSchema $ do
   describe "insert" $
     describe "with an auto-increment key" $ do
       it "inserts and responds with a full object description" $ \conn -> do
-        r <- insert "1" "auto_incrementing_pk" (SqlRow [
+        r <- insert "test" "auto_incrementing_pk" (SqlRow [
             ("non_nullable_string", toSql ("a string"::String))]) conn
         let returnRow = incFromList . toList $ r
         incStr returnRow `shouldBe` "a string"
@@ -43,19 +43,19 @@ spec = around dbWithSchema $ do
         [returnRow] `shouldBe` map incFromList tRows
 
       it "throws an exception if the PK is not unique" $ \conn -> do
-        r <- insert "1" "auto_incrementing_pk" (SqlRow [
+        r <- insert "test" "auto_incrementing_pk" (SqlRow [
             ("non_nullable_string", toSql ("a string"::String))]) conn
         let row = SqlRow .  map (Control.Arrow.first cs) . toList $ r
-        insert "1" "auto_incrementing_pk" row conn `shouldThrow` \e ->
+        insert "test" "auto_incrementing_pk" row conn `shouldThrow` \e ->
           seState e == "23505" -- uniqueness violation code
 
       it "throws an exception if a required value is missing" $ \conn ->
-        insert "1" "auto_incrementing_pk" (SqlRow [
+        insert "test" "auto_incrementing_pk" (SqlRow [
           ("nullable_string", toSql ("a string"::String))]) conn
           `shouldThrow` \e -> seState e == "23502"
 
       it "generates a default values query if no data is provided" $ \c -> do
-        r <- insert "1" "items" (SqlRow []) c
+        r <- insert "test" "items" (SqlRow []) c
         let [row] = toList r
         quickALQuery c "select * from \"1\".items where id = ?" [snd row]
           `shouldReturn` [[row]]

test/fixtures/schema.sql

@@ -5,10 +5,10 @@ SET check_function_bodies = false;
 SET client_min_messages = warning;
 
 
-CREATE SCHEMA "1";
+CREATE SCHEMA test;
 
 
-ALTER SCHEMA "1" OWNER TO postgrest_test;
+ALTER SCHEMA test OWNER TO postgrest_test;
 
 
 CREATE SCHEMA postgrest;
@@ -30,7 +30,7 @@ CREATE EXTENSION IF NOT EXISTS plpgsql WITH SCHEMA pg_catalog;
 COMMENT ON EXTENSION plpgsql IS 'PL/pgSQL procedural language';
 
 
-SET search_path = "1", pg_catalog;
+SET search_path = test, pg_catalog;
 
 
 CREATE TYPE enum_menagerie_type AS ENUM (
@@ -39,7 +39,7 @@ CREATE TYPE enum_menagerie_type AS ENUM (
 );
 
 
-ALTER TYPE "1".enum_menagerie_type OWNER TO postgrest_test;
+ALTER TYPE test.enum_menagerie_type OWNER TO postgrest_test;
 
 SET search_path = postgrest, pg_catalog;
 
@@ -76,25 +76,25 @@ CREATE FUNCTION set_authors_only_owner() RETURNS trigger
     LANGUAGE plpgsql
     AS $$
 begin
-  NEW.owner = current_setting('user_vars.user_id');
+  NEW.owner = current_setting('postgrest.claims.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
+CREATE FUNCTION test.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);
+  INSERT INTO test.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;
+ALTER FUNCTION test.insert_insertable_view_with_join() OWNER TO postgrest_test;
 
-SET search_path = "1", pg_catalog;
+SET search_path = test, pg_catalog;
 
 SET default_tablespace = '';
 
@@ -107,7 +107,7 @@ CREATE TABLE authors_only (
 );
 
 
-ALTER TABLE "1".authors_only OWNER TO postgrest_test_author;
+ALTER TABLE test.authors_only OWNER TO postgrest_test_author;
 
 
 CREATE TABLE auto_incrementing_pk (
@@ -118,7 +118,7 @@ CREATE TABLE auto_incrementing_pk (
 );
 
 
-ALTER TABLE "1".auto_incrementing_pk OWNER TO postgrest_test;
+ALTER TABLE test.auto_incrementing_pk OWNER TO postgrest_test;
 
 
 CREATE SEQUENCE auto_incrementing_pk_id_seq
@@ -129,7 +129,7 @@ CREATE SEQUENCE auto_incrementing_pk_id_seq
     CACHE 1;
 
 
-ALTER TABLE "1".auto_incrementing_pk_id_seq OWNER TO postgrest_test;
+ALTER TABLE test.auto_incrementing_pk_id_seq OWNER TO postgrest_test;
 
 
 ALTER SEQUENCE auto_incrementing_pk_id_seq OWNED BY auto_incrementing_pk.id;
@@ -143,7 +143,7 @@ CREATE TABLE compound_pk (
 );
 
 
-ALTER TABLE "1".compound_pk OWNER TO postgrest_test;
+ALTER TABLE test.compound_pk OWNER TO postgrest_test;
 
 
 CREATE TABLE has_fk (
@@ -153,7 +153,7 @@ CREATE TABLE has_fk (
 );
 
 
-ALTER TABLE "1".has_fk OWNER TO postgrest_test;
+ALTER TABLE test.has_fk OWNER TO postgrest_test;
 
 
 CREATE SEQUENCE has_fk_id_seq
@@ -164,18 +164,18 @@ CREATE SEQUENCE has_fk_id_seq
     CACHE 1;
 
 
-ALTER TABLE "1".has_fk_id_seq OWNER TO postgrest_test;
+ALTER TABLE test.has_fk_id_seq OWNER TO postgrest_test;
 
 
 ALTER SEQUENCE has_fk_id_seq OWNED BY has_fk.id;
 
-CREATE MATERIALIZED VIEW "1".materialized_view AS
+CREATE MATERIALIZED VIEW test.materialized_view AS
  SELECT
     version();
 
-ALTER TABLE "1".materialized_view OWNER TO postgrest_test;
+ALTER TABLE test.materialized_view OWNER TO postgrest_test;
 
-CREATE VIEW "1".insertable_view_with_join AS
+CREATE VIEW test.insertable_view_with_join AS
  SELECT has_fk.id,
     has_fk.auto_inc_fk,
     has_fk.simple_fk,
@@ -186,12 +186,12 @@ CREATE VIEW "1".insertable_view_with_join AS
      JOIN auto_incrementing_pk USING (id));
 
 
-ALTER TABLE "1".insertable_view_with_join OWNER TO postgrest_test;
+ALTER TABLE test.insertable_view_with_join OWNER TO postgrest_test;
 
-CREATE VIEW "1".has_count_column AS
+CREATE VIEW test.has_count_column AS
  SELECT 1 AS count;
 
-ALTER TABLE "1".insertable_view_with_join OWNER TO postgrest_test;
+ALTER TABLE test.insertable_view_with_join OWNER TO postgrest_test;
 
 
 CREATE TABLE items (
@@ -199,50 +199,51 @@ CREATE TABLE items (
 );
 
 
-ALTER TABLE "1".items OWNER TO postgrest_test;
+ALTER TABLE test.items OWNER TO postgrest_test;
 
 CREATE TABLE complex_items (
     id bigint NOT NULL,
     name text,
-    settings json
+    settings json,
+    arr_data INTEGER[]
 );
 
 
-ALTER TABLE "1".complex_items OWNER TO postgrest_test;
+ALTER TABLE test.complex_items OWNER TO postgrest_test;
 
 --- Structure for testing table relations
 CREATE TABLE clients(
     id INT PRIMARY KEY     NOT NULL,
     name           TEXT    NOT NULL
 );
-ALTER TABLE "1".clients OWNER TO postgrest_test;
+ALTER TABLE test.clients OWNER TO postgrest_test;
 
 CREATE TABLE projects(
     id INT PRIMARY KEY     NOT NULL,
     name           TEXT    NOT NULL,
     client_id      INT     REFERENCES clients(id)
 );
-ALTER TABLE "1".projects OWNER TO postgrest_test;
+ALTER TABLE test.projects OWNER TO postgrest_test;
 
 CREATE TABLE tasks(
     id INT PRIMARY KEY     NOT NULL,
     name           TEXT    NOT NULL,
     project_id      INT     REFERENCES projects(id)
 );
-ALTER TABLE "1".tasks OWNER TO postgrest_test;
+ALTER TABLE test.tasks OWNER TO postgrest_test;
 
 CREATE TABLE users(
     id INT PRIMARY KEY     NOT NULL,
     name           TEXT    NOT NULL
 );
-ALTER TABLE "1".users OWNER TO postgrest_test;
+ALTER TABLE test.users OWNER TO postgrest_test;
 
 CREATE TABLE users_tasks(
     user_id      INT     REFERENCES users(id),
     task_id      INT     REFERENCES tasks(id),
     CONSTRAINT task_user PRIMARY KEY (task_id,user_id)
 );
-ALTER TABLE "1".users_tasks OWNER TO postgrest_test;
+ALTER TABLE test.users_tasks OWNER TO postgrest_test;
 
 CREATE TABLE comments(
 id INT PRIMARY KEY   NOT NULL,
@@ -252,31 +253,22 @@ task_id      INT     NOT NULL,
 content      TEXT    NOT NULL,
 FOREIGN KEY (task_id,user_id) REFERENCES users_tasks (task_id,user_id)
 );
-ALTER TABLE "1".comments OWNER TO postgrest_test;
+ALTER TABLE test.comments OWNER TO postgrest_test;
 
 CREATE TABLE users_projects(
     user_id         INT     REFERENCES users(id),
     project_id      INT     REFERENCES projects(id),
     CONSTRAINT project_user PRIMARY KEY (project_id, user_id)
 );
-ALTER TABLE "1".users_projects OWNER TO postgrest_test;
+ALTER TABLE test.users_projects OWNER TO postgrest_test;
 
-CREATE VIEW "1".projects_view AS
+CREATE VIEW test.projects_view AS
   SELECT
       projects.id,
       projects.name,
       projects.client_id
   FROM projects;
-ALTER TABLE "1".projects_view OWNER TO postgrest_test;
+ALTER TABLE test.projects_view OWNER TO postgrest_test;
-------- SAMPLE DATA -----
-INSERT INTO clients VALUES (1, 'Microsoft'),(2, 'Apple');
-INSERT INTO projects VALUES (1,'Windows 7', 1),(2,'Windows 10', 1),(3,'IOS', 2),(4,'OSX', 2);
-INSERT INTO tasks VALUES (1,'Design w7',1),(2,'Code w7',1),(3,'Design w10',2),(4,'Code w10',2),(5,'Design IOS',3),(6,'Code IOS',3),(7,'Design OSX',4),(8,'Code OSX',4);
-INSERT INTO users VALUES (1, 'Angela Martin'),(2, 'Michael Scott'),(3, 'Dwight Schrute');
-INSERT INTO users_projects VALUES(1,1),(1,2),(2,3),(2,4),(3,1),(3,3);
-INSERT INTO users_tasks VALUES(1,1),(1,2),(1,3),(1,4),(2,5),(2,6),(2,7),(3,1),(3,5);
-INSERT INTO comments VALUES (1, 1, 2, 6, 'Needs to be delivered ASAP');
-----------------
 
 CREATE SEQUENCE items_id_seq
     START WITH 1
@@ -286,25 +278,36 @@ CREATE SEQUENCE items_id_seq
     CACHE 1;
 
 
-ALTER TABLE "1".items_id_seq OWNER TO postgrest_test;
+ALTER TABLE test.items_id_seq OWNER TO postgrest_test;
 
 
 ALTER SEQUENCE items_id_seq OWNED BY items.id;
 
 
 
-CREATE FUNCTION "1".getitemrange(min bigint, max bigint) RETURNS SETOF "1".items AS $$
+CREATE FUNCTION test.getitemrange(min bigint, max bigint) RETURNS SETOF test.items AS $$
-    SELECT * FROM "1".items WHERE id > $1 AND id <= $2;
+    SELECT * FROM test.items WHERE id > $1 AND id <= $2;
 $$ LANGUAGE SQL;
 
+CREATE FUNCTION test_empty_rowset() RETURNS SETOF int AS $$
+    SELECT null::int FROM (SELECT 1) a WHERE false;
+$$ LANGUAGE SQL;
 
+CREATE TYPE public.jwt_claims AS (role text, id text);
 
-CREATE FUNCTION "1".sayhello(name text) RETURNS text AS $$
+CREATE FUNCTION test.login(id text, pass text)
+RETURNS public.jwt_claims
+SECURITY DEFINER
+AS $$
+SELECT rolname::text, id::text FROM postgrest.auth WHERE id = id AND pass = pass;
+$$ LANGUAGE SQL;
+
+CREATE FUNCTION test.sayhello(name text) RETURNS text AS $$
     SELECT 'Hello, ' || $1;
 $$ LANGUAGE SQL;
 
 
-CREATE FUNCTION "1".problem() RETURNS void LANGUAGE plpgsql AS
+CREATE FUNCTION test.problem() RETURNS void LANGUAGE plpgsql AS
 $$
 BEGIN
       RAISE 'bad thing';
@@ -323,7 +326,7 @@ CREATE TABLE menagerie (
 );
 
 
-ALTER TABLE "1".menagerie OWNER TO postgrest_test;
+ALTER TABLE test.menagerie OWNER TO postgrest_test;
 
 
 CREATE TABLE no_pk (
@@ -332,7 +335,7 @@ CREATE TABLE no_pk (
 );
 
 
-ALTER TABLE "1".no_pk OWNER TO postgrest_test;
+ALTER TABLE test.no_pk OWNER TO postgrest_test;
 
 
 CREATE TABLE nullable_integer (
@@ -340,7 +343,7 @@ CREATE TABLE nullable_integer (
 );
 
 
-ALTER TABLE "1".nullable_integer OWNER TO postgrest_test;
+ALTER TABLE test.nullable_integer OWNER TO postgrest_test;
 
 
 CREATE TABLE simple_pk (
@@ -349,7 +352,7 @@ CREATE TABLE simple_pk (
 );
 
 
-ALTER TABLE "1".simple_pk OWNER TO postgrest_test;
+ALTER TABLE test.simple_pk OWNER TO postgrest_test;
 
 
 CREATE TABLE json
@@ -358,14 +361,14 @@ CREATE TABLE json
 );
 
 
-ALTER TABLE "1".json OWNER TO postgrest_test;
+ALTER TABLE test.json OWNER TO postgrest_test;
 
 
 CREATE TABLE tsearch (
     text_search_vector tsvector
 );
 
-ALTER TABLE "1".tsearch OWNER TO postgrest_test;
+ALTER TABLE test.tsearch OWNER TO postgrest_test;
 
 SET search_path = postgrest, pg_catalog;
 
@@ -383,8 +386,8 @@ SET search_path = private, pg_catalog;
 
 
 CREATE TABLE articles (
+    id integer PRIMARY KEY NOT NULL,
     body text,
-    id integer NOT NULL,
     owner name NOT NULL
 );
 
@@ -392,22 +395,32 @@ CREATE TABLE articles (
 ALTER TABLE private.articles OWNER TO postgrest_test;
 
 
-CREATE SEQUENCE articles_id_seq
+CREATE TABLE article_stars (
-    START WITH 1
+  article_id int REFERENCES articles(id),
-    INCREMENT BY 1
+  user_id int REFERENCES test.users(id),
-    NO MINVALUE
+  created_at timestamp NOT NULL DEFAULT now(),
-    NO MAXVALUE
+  CONSTRAINT user_article PRIMARY KEY (article_id, user_id)
-    CACHE 1;
+);
+
+ALTER TABLE private.article_stars OWNER TO postgrest_test;
 
 
-ALTER TABLE private.articles_id_seq OWNER TO postgrest_test;
+
+SET search_path = test, pg_catalog;
 
 
-ALTER SEQUENCE articles_id_seq OWNED BY articles.id;
 
+CREATE VIEW "articleStars" AS
+  SELECT article_id AS "articleId", user_id AS "userId", created_at AS "createdAt"
+  FROM private.article_stars;
 
-SET search_path = "1", pg_catalog;
+ALTER TABLE test."articleStars" OWNER TO postgrest_test;
 
+CREATE VIEW articles AS
+  SELECT *
+  FROM private.articles;
+
+ALTER TABLE test.articles OWNER TO postgrest_test;
 
 ALTER TABLE ONLY auto_incrementing_pk ALTER COLUMN id SET DEFAULT nextval('auto_incrementing_pk_id_seq'::regclass);
 
@@ -415,36 +428,10 @@ ALTER TABLE ONLY auto_incrementing_pk ALTER COLUMN id SET DEFAULT nextval('auto_
 
 ALTER TABLE ONLY has_fk ALTER COLUMN id SET DEFAULT nextval('has_fk_id_seq'::regclass);
 
-
-
 ALTER TABLE ONLY items ALTER COLUMN id SET DEFAULT nextval('items_id_seq'::regclass);
 
-
-SET search_path = private, pg_catalog;
-
-
-ALTER TABLE ONLY articles ALTER COLUMN id SET DEFAULT nextval('articles_id_seq'::regclass);
-
-
-SET search_path = "1", pg_catalog;
-
-
-
-
-
-
-
-
 SELECT pg_catalog.setval('auto_incrementing_pk_id_seq', 1, true);
 
-
-
-
-
-
-
-
-
 SELECT pg_catalog.setval('has_fk_id_seq', 1, false);
 
 
@@ -467,24 +454,20 @@ SET search_path = private, pg_catalog;
 
 
 
+SET search_path = test, pg_catalog;
 
-SELECT pg_catalog.setval('articles_id_seq', 1, false);
+CREATE FUNCTION public.always_true(test.items) RETURNS boolean
-
-
-SET search_path = "1", pg_catalog;
-
-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 FUNCTION public.always_true(test.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();
+CREATE TRIGGER insert_insertable_view_with_join INSTEAD OF INSERT ON test.insertable_view_with_join FOR EACH ROW EXECUTE PROCEDURE test.insert_insertable_view_with_join();
 
 
 CREATE TRIGGER secrets_owner_track BEFORE INSERT OR UPDATE ON authors_only FOR EACH ROW EXECUTE PROCEDURE postgrest.set_authors_only_owner();
@@ -531,10 +514,6 @@ ALTER TABLE ONLY auth
 SET search_path = private, pg_catalog;
 
 
-ALTER TABLE ONLY articles
-    ADD CONSTRAINT articles_pkey PRIMARY KEY (id);
-
-
 SET search_path = postgrest, pg_catalog;
 
 
@@ -547,7 +526,7 @@ SET search_path = private, pg_catalog;
 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;
+SET search_path = test, pg_catalog;
 
 
 ALTER TABLE ONLY has_fk
@@ -560,11 +539,11 @@ ALTER TABLE ONLY has_fk
 
 
 
-REVOKE ALL ON SCHEMA "1" FROM PUBLIC;
+REVOKE ALL ON SCHEMA test FROM PUBLIC;
-REVOKE ALL ON SCHEMA "1" FROM postgrest_test;
+REVOKE ALL ON SCHEMA test FROM postgrest_test;
-GRANT ALL ON SCHEMA "1" TO postgrest_test;
+GRANT ALL ON SCHEMA test TO postgrest_test;
-GRANT USAGE ON SCHEMA "1" TO postgrest_anonymous;
+GRANT USAGE ON SCHEMA test TO postgrest_anonymous;
-GRANT USAGE ON SCHEMA "1" TO postgrest_test_author;
+GRANT USAGE ON SCHEMA test TO postgrest_test_author;
 
 
 
@@ -655,6 +634,14 @@ REVOKE ALL ON TABLE projects_view FROM PUBLIC;
 REVOKE ALL ON TABLE projects_view FROM postgrest_test;
 GRANT ALL ON TABLE projects_view TO postgrest_test;
 GRANT ALL ON TABLE projects_view TO postgrest_anonymous;
+REVOKE ALL ON TABLE articles FROM PUBLIC;
+REVOKE ALL ON TABLE articles FROM postgrest_test;
+GRANT ALL ON TABLE  articles TO postgrest_test;
+GRANT ALL ON TABLE  articles TO postgrest_anonymous;
+REVOKE ALL ON TABLE "articleStars" FROM PUBLIC;
+REVOKE ALL ON TABLE "articleStars" FROM postgrest_test;
+GRANT ALL ON TABLE  "articleStars" TO postgrest_test;
+GRANT ALL ON TABLE  "articleStars" TO postgrest_anonymous;
 ---------
 
 
@@ -663,6 +650,15 @@ 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 test_empty_rowset() FROM PUBLIC;
+REVOKE ALL ON FUNCTION test_empty_rowset() FROM postgrest_test;
+GRANT EXECUTE ON FUNCTION test_empty_rowset() TO postgrest_test;
+GRANT EXECUTE ON FUNCTION test_empty_rowset() TO postgrest_anonymous;
+
+REVOKE ALL ON FUNCTION login(text, text) FROM PUBLIC;
+REVOKE ALL ON FUNCTION login(text, text) FROM postgrest_test;
+GRANT EXECUTE ON FUNCTION login(text, text) TO postgrest_test;
+GRANT EXECUTE ON FUNCTION login(text, text) TO postgrest_anonymous;
 
 REVOKE ALL ON FUNCTION sayhello(text) FROM PUBLIC;
 REVOKE ALL ON FUNCTION sayhello(text) FROM postgrest_test;
@@ -737,10 +733,10 @@ 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(test.items) FROM PUBLIC;
-REVOKE ALL ON FUNCTION public.always_true("1".items) FROM postgrest_test;
+REVOKE ALL ON FUNCTION public.always_true(test.items) FROM postgrest_test;
-GRANT ALL ON FUNCTION public.always_true("1".items) TO postgrest_test;
+GRANT ALL ON FUNCTION public.always_true(test.items) TO postgrest_test;
-GRANT ALL ON FUNCTION public.always_true("1".items) TO postgrest_anonymous;
+GRANT ALL ON FUNCTION public.always_true(test.items) TO postgrest_anonymous;
 
 
 SET search_path = postgrest, pg_catalog;
@@ -758,3 +754,18 @@ SET search_path = private, pg_catalog;
 REVOKE ALL ON TABLE articles FROM PUBLIC;
 REVOKE ALL ON TABLE articles FROM postgrest_test;
 GRANT ALL ON TABLE articles TO postgrest_test;
+
+SET search_path = test, private, postgrest, public, pg_catalog;
+
+------- SAMPLE DATA -----
+INSERT INTO clients VALUES (1, 'Microsoft'),(2, 'Apple');
+INSERT INTO projects VALUES (1,'Windows 7', 1),(2,'Windows 10', 1),(3,'IOS', 2),(4,'OSX', 2);
+INSERT INTO tasks VALUES (1,'Design w7',1),(2,'Code w7',1),(3,'Design w10',2),(4,'Code w10',2),(5,'Design IOS',3),(6,'Code IOS',3),(7,'Design OSX',4),(8,'Code OSX',4);
+INSERT INTO users VALUES (1, 'Angela Martin'),(2, 'Michael Scott'),(3, 'Dwight Schrute');
+INSERT INTO users_projects VALUES(1,1),(1,2),(2,3),(2,4),(3,1),(3,3);
+INSERT INTO users_tasks VALUES(1,1),(1,2),(1,3),(1,4),(2,5),(2,6),(2,7),(3,1),(3,5);
+INSERT INTO comments VALUES (1, 1, 2, 6, 'Needs to be delivered ASAP');
+INSERT INTO postgrest.auth (id, pass, rolname) VALUES ('jdoe', '1234', 'postgrest_test_author');
+INSERT INTO private.articles (id, body, owner) VALUES (1, 'No… It''s a thing; it''s like a plan, but with more greatness.', 2), (2, 'Stop talking, brain thinking. Hush.', 3), (3, 'It''s a fez. I wear a fez now. Fezes are cool.', 1);
+INSERT INTO private.article_stars (article_id, user_id) VALUES (1,1), (1,2), (2,3), (3,2), (1,3);
+----------------