v0.3.2.0

Update operator documentation

CHANGELOG.md

@@ -3,6 +3,67 @@
 All notable changes to this project will be documented in this file.
 This project adheres to [Semantic Versioning](http://semver.org/).
 
+## Unreleased
+
+### Added
+
+### Fixed
+
+## [0.3.2.0] - 2016-06-10
+
+### Added
+- Reload database schema on SIGHUP - @begriffs
+- Support "-" in column names - @ruslantalpa
+- Support column/node renaming `alias:column` - @ruslantalpa
+- Accept posts from HTML forms - @begriffs
+- Ability to order embedded entities - @ruslantalpa
+- Ability to paginate using &limit and &offset parameters - @ruslantalpa
+- Ability to apply limits to embedded entities and enforce --max-rows on all levels - @ruslantalpa, @begriffs
+- Add allow response header in OPTIONS - @begriffs
+
+### Fixed
+- Return 401 or 403 for access denied rather than 404 - @begriffs
+- Omit Content-Type header for empty body - @begriffs
+- Prevent role from being changed twice - @begriffs
+- Use read-only transaction for read requests - @ruslantalpa
+- Include entities from the same parent table using two different foreign keys - @ruslantalpa
+- Ensure that Location header in 201 response is URL-encoded - @league
+- Fix garbage collector CPU leak - @ruslantalpa et al.
+- Return deleted items when return=representation header is sent - @ruslantalpa
+- Use table default values for empty object inserts - @begriffs
+
+## [0.3.1.1] - 2016-03-28
+
+### Fixed
+- Preserve unicode values in insert,update,rpc (regression) - @begriffs
+- Prevent duplicate call to stored procs (regression) - @begriffs
+- Allow SQL functions to generate registered JWT claims - @begriffs
+- Terminate gracefully on SIGTERM (for use in Docker) - @recmo
+- Relation detection fix for views that depend on multiple tables - @ruslantalpa
+- Avoid count on plurality=singular and allow multiple Prefer values - @ruslantalpa
+
+## [0.3.1.0] - 2016-02-28
+
+### Fixed
+- Prevent query error from infecting later connection - @begriffs, @ruslantalpa, @nikita-volkov, @jwiegley
+
+### Added
+- Applies range headers to RPC calls - @diogob
+
+## [0.3.0.4] - 2016-02-12
+
+### Fixed
+- Improved usage screen - @begriffs
+- Reject non-POSTs to rpc endpoints - @begriffs
+- Throw an error for OPTIONS on nonexistent tables - @calebmer
+- Remove deadlock on simultaneous contentious updates - @ruslantalpa, @begriffs
+
+## [0.3.0.3] - 2016-01-08
+
+### Fixed
+- Fix bug in many-many relation detection - @ruslantalpa
+- Inconsistent escaping of table names in read queries - @calebmer
+
 ## [0.3.0.2] - 2015-12-16
 
 ### Fixed
@@ -13,7 +74,7 @@ This project adheres to [Semantic Versioning](http://semver.org/).
 - Fix #396 include records with missing parents - @ruslantalpa
 - `pgFmtIdent` always quotes #388 - @calebmer
 - Default schema, changed from `"1"` to `public` - @calebmer
-- #414 revert to separate count query
+- #414 revert to separate count query - @ruslantalpa
 - Fix #399, allow inserting in tables with no select privileges using "Prefer: representation=minimal" - @ruslantalpa
 
 ### Added

Dockerfile

@@ -0,0 +1,27 @@
+FROM debian:jessie
+
+ENV POSTGREST_VERSION 0.3.2.0
+ENV POSTGREST_SCHEMA public
+ENV POSTGREST_ANONYMOUS postgres
+ENV POSTGREST_JWT_SECRET thisisnotarealsecret
+ENV POSTGREST_MAX_ROWS 1000000
+ENV POSTGREST_POOL 200
+
+RUN apt-get update && \
+    apt-get install -y tar xz-utils wget libpq-dev && \
+    apt-get clean && rm -rf /var/lib/apt/lists/* /tmp/* /var/tmp/*
+
+RUN wget http://github.com/begriffs/postgrest/releases/download/v${POSTGREST_VERSION}/postgrest-${POSTGREST_VERSION}-ubuntu.tar.xz && \
+    tar --xz -xvf postgrest-${POSTGREST_VERSION}-ubuntu.tar.xz && \
+    mv postgrest /usr/local/bin/postgrest && \
+    rm postgrest-${POSTGREST_VERSION}-ubuntu.tar.xz
+
+CMD exec postgrest postgres://${PG_ENV_POSTGRES_USER}:${PG_ENV_POSTGRES_PASSWORD}@${PG_PORT_5432_TCP_ADDR}:${PG_PORT_5432_TCP_PORT}/${PG_ENV_POSTGRES_DB} \
+              --port 3000 \
+              --schema ${POSTGREST_SCHEMA} \
+              --anonymous ${POSTGREST_ANONYMOUS} \
+              --pool ${POSTGREST_POOL} \
+              --jwt-secret ${POSTGREST_JWT_SECRET} \
+              --max-rows ${POSTGREST_MAX_ROWS}
+
+EXPOSE 3000

README.md

@@ -5,6 +5,7 @@
   <img src="https://img.shields.io/badge/%E2%86%91_Deploy_to-Heroku-7056bf.svg" alt="Deploy">
 </a>
 [![Join the chat at https://gitter.im/begriffs/postgrest](https://img.shields.io/badge/gitter-join%20chat%20%E2%86%92-brightgreen.svg)](https://gitter.im/begriffs/postgrest)
+[![Docker Hub](https://img.shields.io/badge/Docker%20Hub-%E2%86%92-blue.svg)](https://hub.docker.com/r/begriffs/postgrest/)
 
 PostgREST serves a fully RESTful API from any existing PostgreSQL
 database. It provides a cleaner, more standards-compliant, faster
@@ -117,7 +118,7 @@ views. You run an instance of PostgREST per schema and route requests
 among them with a reverse proxy such as [nginx](http://nginx.org).
 Learn more [here](http://postgrest.com/admin/versioning/).
 
-### Self-documention
+### Self-documentation
 
 Rather than writing and maintaining separate docs yourself let the
 API explain its own affordances using HTTP. All PostgREST endpoints
@@ -125,7 +126,7 @@ respond to the OPTIONS verb and explain what they support as well
 as the data format of their JSON payload. RAML support is an upcoming
 feature.
 
-The project uses HTTP itself to commicate other metadata. For
+The project uses HTTP itself to communicate other metadata. For
 instance the number of rows returned by an endpoint is reported by -
 and limited with - range headers. More about
 [that](http://begriffs.com/posts/2014-03-06-beyond-http-header-links.html).

app.json

@@ -10,7 +10,7 @@
     },
     "POSTGREST_VER": {
       "description": "Version of PostgREST to deploy",
-      "value": "0.3.0.2"
+      "value": "0.3.2.0"
     },
     "DB_NAME": {
       "description": "Database name",
@@ -47,8 +47,8 @@
       "required": false,
       "value": "secret"
     },
-    "V1SCHEMA": {
-      "description": "DB schema selected whe no version (or version 1) requested",
+    "SCHEMA": {
+      "description": "DB schema to be exported",
       "required": false,
       "value": "1"
     }

circle.yml

@@ -1,16 +1,27 @@
-machine:
+dependencies:
+  cache_directories:
+    - "~/.stack"
+    - ".stack-work"
   pre:
+    - curl -L https://github.com/commercialhaskell/stack/releases/download/v1.1.2/stack-1.1.2-linux-x86_64.tar.gz | tar zx -C /tmp
+    - sudo mv /tmp/stack-1.1.2-linux-x86_64/stack /usr/bin
+    - sudo apt-get update; sudo apt-get install --only-upgrade binutils
     - createuser --superuser --no-password postgrest_test
     - createdb -O postgrest_test -U ubuntu postgrest_test
-  ghc:
-    version: 7.10.1
-dependencies:
   override:
-    - cabal update
-    - cabal sandbox init
-    - cabal install --upgrade-dependencies --constraint="template-haskell installed" --dependencies-only --enable-tests
-    - cabal configure --enable-tests -f ci
+    - stack setup
+    - rm -fr $(stack path --dist-dir) $(stack path --local-install-root)
+    - stack install hlint packdeps cabal-install
+    - stack build
+    - stack build --test --no-run-tests
+
 test:
-  post:
-    - cabal exec hlint -- -X QuasiQuotes src/**/*.hs test/**/*.hs
-    - cabal exec packdeps postgrest.cabal || true
+  override:
+    - stack test
+    - git ls-files | grep '\.l\?hs$' | xargs stack exec -- hlint -X QuasiQuotes "$@"
+    - stack exec -- cabal update
+    - stack exec --no-ghc-package-path -- cabal install --only-d --dry-run
+    - stack exec -- packdeps *.cabal || true
+    - stack exec -- cabal check
+    - stack haddock --no-haddock-deps
+    - stack sdist

docs/admin/security.md

@@ -60,7 +60,7 @@ for anonymous users, one for authors, and another for the authenticator,
 you would set it up like this
 
 ```sql
-CREATE ROLE authenticator NOINHERIT;
+CREATE ROLE authenticator NOINHERIT LOGIN;
 CREATE ROLE anon;
 CREATE ROLE author;
 

docs/api/reading.md

@@ -91,15 +91,20 @@ These operators are available:
 abbreviation | meaning
 ------------ | -------
 eq           | equals
-gt           | greater than
-lt           | less than
 gte          | greater than or equal
+gt           | greater than
 lte          | less than or equal
+lt           | less than
+neq          | not equal
 like         | LIKE operator (use * in place of %)
 ilike        | ILIKE operator (use * in place of %)
-@@           | full-text search using to_tsquery
-is           | checking for exact equality (null,true,false)
 in           | one of a list of values e.g. `?a=in.1,2,3`
+notin        | not one of a list of values e.g. `?a=notin.1,2,3`
+is           | checking for exact equality (null,true,false)
+isnot        | checking for exact inequality (null,true,false)
+@@           | full-text search using to_tsquery
+@>           | contains e.g. `?tags=@>.{example, new}`
+<@           | contained in e.g. `values=<@{1,2,3}`
 not          | negates another operator, see below
 
 To negate any operator, prefix it with `not` like `?a=not.eq.2`.
@@ -159,7 +164,7 @@ comma-separated list of columns and directions:
 GET /people?order=age.desc,height.asc
 ```
 
-If no direction is specified it defaults to descending order:
+If no direction is specified it defaults to ascending order:
 
 ```HTTP
 GET /people?order=age
@@ -172,6 +177,12 @@ GET /people?order=age.nullsfirst
 GET /people?order=age.desc.nullslast
 ```
 
+To order the embedded items, you need to specify the tree path for the order param like so.
+```HTTP
+GET /projects?select=id,name,tasks{id,name}&order=id.asc&tasks.order=name.asc
+```
+
+
 You can also use [computed
 columns](http://www.postgresql.org/docs/current/interactive/xfunc-sql.html#XFUNC-SQL-COMPOSITE-FUNCTIONS)
 to order the results, even though the computed
@@ -208,6 +219,15 @@ Range: 0-4
 You can also use open-ended ranges for an offset with no limit:
 `Range: 10-`.
 
+In addition to the `Range` header, you can use `&limit` and `&offset` parameters
+to achieve the same result.
+
+You can also set a limit (but not offset) for the embedded items like so
+```HTTP
+/posts?select=id,title,body,comments{id,email,body}&limit=10&comments.limit=3
+```
+The above request will return the first 10 posts and for each of the posts, 3 comments at most
+
 #### Suppressing Counts
 
 Sometimes knowing the total row count of a query is unnecessary and
@@ -258,7 +278,8 @@ but the the select query is recursive. You could for instance specify
 GET /foo?select=x, y, bar{z, w, baz{*}}
 ```
 
-You can select not only using table names, but also column names!
+You can select not only using table names, but also foreign key column names!
+This is especially needed when you have a table with two foreign keys pointing to the same table, for example billing_address_id and shipping_address_id.
 To embed the same foreign key row from our client example earlier
 you could do the following:
 
@@ -270,8 +291,7 @@ In the response there will be a `client_id` object containing all
 the data for that row.
 
 However, a `client_id` object doesn't make a lot of sense, so you
-could do one of two things. Create a view which renames `client_id`
-to just `client` (this is the hard way), or just try `client{*}`
+could do one of two things. Tell PostgREST that you want the key renamed by using the `alias` feature like so `client:client_id{*}`, or just try `client{*}`
 in the select parameter! PostgREST supports smart ducktype checking
 for common foreign key names, so if your column name ends with
 `_id`, `_fk`, or any variation of the two (including camelcase)
@@ -285,6 +305,37 @@ GET /projects?id=eq.1&select=id, name, client{*}
 
 Would embed in the `client` key the row referenced with `client_id`.
 
+The `alias` feature works for embedded entities and also for regular columns. This is useful in situations where for example you use different naming conventions in the database and frontend.
+
+The following request will produce the output below:
+```HTTP
+GET /orders?id=eq.1&select=orderId:id, customer:customer_id{customerId:id, customerName:name}
+```
+
+```json
+[
+  {
+    "orderId": 1,
+    "customer": {
+      "customerId": 1,
+      "customerName": "John Smith"
+    }
+  }
+]
+```
+
+If you want to apply filters to the embedded items, you can do that like so:
+```HTTP
+GET /clients?id=eq.42&select=id,name,projects{id,name,is_active}&projects.is_active=eq.true
+```
+The above request will return the client with id=42 and all the projects for that client that are still active
+
+
+<div class="admonition note">
+    <p class="admonition-title">Design Consideration</p>
+    <p>In order for this feature to work as expected after a schema change, PostgREST currently requires to be restarted.</p>
+</div>
+
 ### Response Format
 
 Query responses default to JSON but you can get them in CSV as well. Just make your request with the header
@@ -323,14 +374,14 @@ OPTIONS /my_view
 This will include the row names, their types, primary key
 information, and foreign keys for the given table or view.
 
-<div class="admonition danger">
-    <p class="admonition-title">Deprecation Warning</p>
+<div class="admonition warning">
+    <p class="admonition-title">Schema Changes</p>
 
-    <p>Although we currently use the OPTIONS verb for this, some
-    people <a
-    href="https://www.mnot.net/blog/2012/10/29/NO_OPTIONS">argue</a> that
-    this is inappropriate. We are considering a <code>describedby</code>
-    header link instead.</p>
+    <p>Note that when the schema of your database changes PostgREST will not reflect
+    the change. You have to either restart PostgREST or send its running process
+    a HUP signal:
+
+    <pre><code>killall -HUP postgrest</code></pre>
 </div>
 
 ### CORS

docs/api/writing.md

@@ -71,6 +71,93 @@ returns something like
 [ { "id": 1 }, { "id": 2 } ]
 ```
 
+### Multiple Tables Insertion or Update
+
+The cleanest way to insert or update data into multiple tables using only one POST/PATCH request
+is to create a view that will join all target tables and present a single endpoint.
+In our example let's assume one users table and one companies table.
+In this case, we want a signup endpoint to create the first user within a company.
+And for this endpoint we want to insert with one request both user and company.
+
+```SQL
+CREATE TABLE companies (
+    id serial primary key,
+    name text unique
+);
+
+CREATE TABLE users (
+    id serial primary key,
+    name text not null,
+    pass text,
+    company_id integer not null references companies
+);
+```
+
+Having both tables created we create a view that joins them to be used
+as a ```/signup``` endpoint.
+
+```SQL
+CREATE VIEW signup AS
+    SELECT
+        c.name AS company_name,
+        u.name AS user_name,
+        u.pass
+    FROM
+        public.users u
+        JOIN public.companies c ON c.id = u.company_id;
+
+```
+
+After the signup view creation, we can issue ```GET``` requests to read data
+from users and companies, but any atempt to ```POST``` or ```PATCH``` data will fail.
+PostgreSQL won't allow any data change on views that have a ```JOIN``` 
+clause in their ```FROM``` without a proper ```INSTEAD OF``` trigger.
+So in the example bellow we create a trigger to allow insertion of data in the signup view.
+The trigger is a simple PL/pgSQL function that first inserts into the companies table and
+uses the newly create company_id to create its first user.
+
+
+```SQL
+CREATE FUNCTION signup()
+RETURNS trigger
+LANGUAGE plpgsql
+AS $$
+DECLARE
+  vcompany_id int;
+BEGIN
+  INSERT INTO companies (name) VALUES (new.company_name) RETURNING id INTO vcompany_id;
+  INSERT INTO users (name, pass, company_id) VALUES (new.user_name, new.pass, vcompany_id);
+RETURN new;
+END;
+$$;
+
+CREATE TRIGGER signup
+INSTEAD OF INSERT ON signup
+FOR EACH ROW
+EXECUTE PROCEDURE signup();
+```
+
+After the trigger creation we can issue a normal ```POST``` request to our signup endpoint:
+
+```HTTP
+POST /signup
+{ "company_name": "foo", "user_name": "bar" }
+```
+
+For an endpoint such as signup its usually not desirable to have a ```PATCH``` route for updates,
+and we will skip this example for the sake of brevity. But it would be implemented in a very
+similar way to our ```POST``` example.
+
+<div class="admonition note">
+    <p class="admonition-title">Design Consideration</p>
+
+    <p>It's advisable to create a separate trigger for <code>UPDATE</code> and <code>INSERT</code>
+    avoiding conditionals that decide which is the trigger current operation.
+    This makes it easier to change code for (or even disable) one operation without interfering with others while
+    improving readability.
+    </p>
+</div>
+
 ### Bulk Updates
 
 * ❌ Cannot be cached or prefetched
@@ -99,7 +186,7 @@ basic field replacements, and not at all "incorrect."
 * ❌ Cannot be cached or prefetched
 * ✅ Idempotent
 
-Simply use the `DELETE` verb. All recors that match your filter
+Simply use the `DELETE` verb. All records that match your filter
 will be removed. For instance deleting inactive users:
 
 ```HTTP

docs/examples/blog.md

@@ -6,10 +6,10 @@ the posts of other authors. Anonymous users cannot edit anything
 but can sign up for author accounts. Authors can also post comments
 on articles.
 
-This example builds off the previous one. We had previously created
-a signup and login system on top of JWT. We'll use this auth system
-for the blog. **Run the SQL in the previous example** first, before
-continuing with this example.
+This example builds off the previous previous [User Management](users/)
+one. We had previously created a signup and login system on top of
+JWT. We'll use this auth system for the blog. **Run the SQL in the
+previous example** first, before continuing with this example.
 
 For your convenience, the complete sql for the blog demo is
 [here](https://github.com/begriffs/postgrest/blob/master/schema-templates/blog.sql).
@@ -48,31 +48,18 @@ comments (
 
 ### Permissions
 
-Basic table-level permissions. We'll add an the `authenticator`
-role which can't do anything itself other than switch into other
-roles as directed by JWT.
+On top of the `authenticator` and `anon` access granted in the
+previous example, blogs have an `author` role with extra permissions.
 
 ```sql
-create role anon;
 create role author;
-create role authenticator noinherit;
-grant anon, author to authenticator;
+grant author to authenticator;
 
-grant usage on schema public, basic_auth to anon, author;
-
--- anon can create new logins and can read comments/posts
-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 usage on schema public, basic_auth to author;
 
 -- authors can edit comments/posts
 grant select, insert, update, delete
-  on basic_auth.tokens, basic_auth.users to anon, author;
+  on basic_auth.tokens, basic_auth.users to author;
 grant select, insert, update, delete
   on table users, posts, comments to author;
 grant usage, select on sequence posts_id_seq, comments_id_seq to author;
@@ -84,21 +71,52 @@ security](http://www.postgresql.org/docs/9.5/static/ddl-rowsecurity.html).
 Note that it requires PostgreSQL 9.5 or later.
 
 ```sql
+grant select on posts, comments to anon;
+
 ALTER TABLE posts ENABLE ROW LEVEL SECURITY;
-drop policy if exists authors_eigenedit on posts;
-create policy authors_eigenedit on posts
-  using (true)
+ALTER TABLE comments ENABLE ROW LEVEL SECURITY;
+
+drop policy if exists posts_select_unsecure on posts;
+create policy posts_select_unsecure on posts for select
+  using (true);
+
+drop policy if exists comments_select_unsecure on comments;
+create policy comments_select_unsecure on comments for select
+  using (true);
+
+drop policy if exists authors_eigencreate on posts;
+create policy authors_eigencreate on posts for insert
   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)
+drop policy if exists authors_eigencreate on comments;
+create policy authors_eigencreate on comments for insert
+  with check (
+      author = basic_auth.current_email()
+  );
+
+drop policy if exists authors_eigenedit on posts;
+create policy authors_eigenedit on posts for update
+  using (author = basic_auth.current_email())
   with check (
     author = basic_auth.current_email()
   );
+
+drop policy if exists authors_eigenedit on comments;
+create policy authors_eigenedit on comments for update
+  using (author = basic_auth.current_email())
+  with check (
+    author = basic_auth.current_email()
+  );
+
+drop policy if exists authors_eigendelete on posts;
+create policy authors_eigendelete on posts for delete
+  using (author = basic_auth.current_email());
+
+drop policy if exists authors_eigendelete on comments;
+create policy authors_eigendelete on comments for delete
+  using (author = basic_auth.current_email());
 ```
 
 Finally we need to modify the `users` view from the previous example.

docs/examples/external_auth.md

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

docs/examples/python-requests-jwt.md

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

docs/examples/start.md

@@ -101,7 +101,7 @@ In Postman it will look like this
 
 Notice that the post type is `raw` and that `Content-Type: text/csv` set in the Headers tab.
 
-The server returns HTTP 201 Created. Because we inserted more than one item at once there is no `Location` header in the response. However sometimes you want to learn more about items which you just inserted. To have the server include the full restuls include the header `Prefer: return=representation`.
+The server returns HTTP 201 Created. Because we inserted more than one item at once there is no `Location` header in the response. However sometimes you want to learn more about items which you just inserted. To have the server include the full results, include the header `Prefer: return=representation`.
 
 At this point if you send a GET request to `/festival` it should return
 

docs/examples/users.md

@@ -8,12 +8,12 @@ a username and password system on top of JWT using only plpgsql.
 Future examples such as the multi-tenant blogging platform will use
 the results from this example for their auth. We will build a system
 for users to sign up, log in, manage their accounts, and for admins
-to manange other people's accounts. We will also see how to trigger
+to manage other people's accounts. We will also see how to trigger
 outside events like sending password reset emails.
 
 Before jumping into the code, a little more about how the tokens
 work. Every JWT contains cryptographically signed *claims*. PostgREST
-cares specificaly about a claim called `role`. When a client includes
+cares specifically about a claim called `role`. When a client includes
 a `role` claim PostgREST executes their request using that database
 role.
 
@@ -28,13 +28,11 @@ value.
 ### Storing Users and Passwords
 
 We create a database schema especially for auth information. We'll
-also need the postgres extensions
-[pgcrypto](http://www.postgresql.org/docs/current/static/pgcrypto.html) and
-[uuid-ossp](http://www.postgresql.org/docs/current/static/uuid-ossp.html).
+also need the postgres extension
+[pgcrypto](http://www.postgresql.org/docs/current/static/pgcrypto.html).
 
 ```sql
 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
@@ -150,7 +148,7 @@ begin
    where token_type = 'reset'
      and tokens.email = request_password_reset.email;
 
-  select uuid_generate_v4() into tok;
+  select gen_random_uuid() into tok;
   insert into basic_auth.tokens (token, token_type, email)
          values (tok, 'reset', request_password_reset.email);
   perform pg_notify('reset',
@@ -226,7 +224,7 @@ begin
    where token_type = 'reset'
      and tokens.email = reset_password.email;
 
-  select uuid_generate_v4() into tok;
+  select gen_random_uuid() into tok;
   insert into basic_auth.tokens (token, token_type, email)
          values (tok, 'reset', reset_password.email);
   perform pg_notify('reset',
@@ -253,7 +251,7 @@ basic_auth.send_validation() returns trigger
 declare
   tok uuid;
 begin
-  select uuid_generate_v4() into tok;
+  select gen_random_uuid() into tok;
   insert into basic_auth.tokens (token, token_type, email)
          values (tok, 'validation', new.email);
   perform pg_notify('validate',
@@ -296,7 +294,7 @@ where actual.role = member_of.rolname;
   -- is equal to email so that user can only see themselves
 ```
 
-Using this view clients can see themeslves and any other users with
+Using this view clients can see themselves and any other users with
 the right db roles. This view does not yet support inserts or updates
 because not all the columns refer directly to underlying columns.
 Nor do we want it to be auto-updatable because it would allow an escalation
@@ -411,14 +409,22 @@ login(email text, pass text) returns basic_auth.jwt_claims
   as $$
 declare
   _role name;
+  _verified boolean;
+  _email text;
   result basic_auth.jwt_claims;
 begin
+  -- check email and password
   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
+  -- check verified flag whether users
   -- have validated their emails
+  _email := email;
+  select verified from basic_auth.users as u where u.email=_email limit 1 into _verified;
+  if not _verified then
+    raise invalid_authorization_specification using message = 'user is not verified';
+  end if;
   select _role as role, login.email as email into result;
   return result;
 end;
@@ -458,15 +464,16 @@ Here's a function to get the email of the currently authenticated
 user.
 
 ```sql
+-- Prevent current_setting('postgrest.claims.email') from raising
+-- an exception if the setting is not present. Default it to ''.
+ALTER DATABASE your_db_name SET postgrest.claims.email TO '';
+
 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;
 $$;
 ```
@@ -475,6 +482,30 @@ Remember that the `login` function set the claims `email` and `role`.
 You can modify `login` to set other claims as well if they are
 useful for your other SQL functions to reference later.
 
+### Permissions
+
+Basic table-level permissions. We'll add an the `authenticator`
+role which can't do anything itself other than switch into other
+roles as directed by JWT.
+
+```sql
+create role anon;
+create role authenticator noinherit;
+grant anon to authenticator;
+
+grant usage on schema public, basic_auth to anon;
+
+-- anon can create new logins
+grant insert on table basic_auth.users, basic_auth.tokens to anon;
+grant select on table pg_authid, basic_auth.users to anon;
+grant execute on function
+  login(text,text),
+  request_password_reset(text),
+  reset_password(text,uuid,text),
+  signup(text, text)
+  to anon;
+```
+
 ### Conclusion
 
 This section explained the implementation details for building a

docs/install/ecosystem.md

@@ -2,9 +2,11 @@
 
 ### Client-Side Libraries
 
+* [calebmer/postgrest-client](https://github.com/calebmer/postgrest-client) - Advanced JS client for the PostgREST API
 * [mithril.postgrest](https://github.com/catarse/mithril.postgrest) - Mithril plugin to create and authenticate requests
 * [lewisjared/postgrest-request](https://github.com/lewisjared/postgrest-request) - node interface to postgrest instances
 * [JarvusInnovations/jarvus-postgrest-apikit](https://github.com/JarvusInnovations/jarvus-postgrest-apikit) - Sencha framework package for binding models/stores/proxies to PostgREST tables
+* [davidthewatson/postgrest_python_requests_client](https://github.com/davidthewatson/postgrest_python_requests_client) - python client featuring JWT auth and pagination of result sets
 
 ### Extensions
 

docs/install/server.md

@@ -46,12 +46,17 @@ wget -q -O- https://s3.amazonaws.com/download.fpcomplete.com/ubuntu/fpco.key | s
 echo 'deb http://download.fpcomplete.com/ubuntu/trusty stable main'|sudo tee /etc/apt/sources.list.d/fpco.list
 sudo apt-get update && sudo apt-get install stack -y
 ```
+* Install libpq-dev
+```
+sudo apt-get install -y libpq-dev
+```
 * Build & install in one step
 
 ```bash
 git clone https://github.com/begriffs/postgrest.git
 cd postgrest
-sudo stack install --install-ghc --local-bin-path /usr/local/bin
+stack build --install-ghc
+sudo stack install --allow-different-user --local-bin-path /usr/local/bin
 ```
 
 * Run the server
@@ -61,7 +66,7 @@ If you want to run the test suite, stack can do that too: `stack test`.
 ### Running the Server
 
 ```bash
-postgrest postgres://user:pass@host:port/db [flags]
+postgrest postgres://user:pass@host:port/db -a anon_user [other flags]
 ```
 
 The user in the connection string is the "authenticator role," i.e.
@@ -69,14 +74,14 @@ a role which is used temporarily to switch into other roles depending
 on the authentication request JWT. For simple API's you can use the
 same role for authenticator and anonymous.
 
-The possible flags are:
+The complete list of options:
 
 <dl>
 <dt>-p, --port</dt>
 <dd>The port on which the server will listen for HTTP requests.
     Defaults to 3000.</dd>
 
-<dt>-a, --anonymous</dt>
+<dt>-a, --anonymous (required)</dt>
 <dd>The database role used to execute commands for those requests
     which provide no JWT authorization.</dd>
 
@@ -90,7 +95,7 @@ The possible flags are:
     <code>secret</code> but do not use the default in production!
     Load-balanced PostgREST servers should share the same secret.</dd>
 
-<dt>-p, --pool</dt>
+<dt>-o, --pool</dt>
 <dd>Max connections to use in db pool. Defaults to to 10, but you
     should find an optimal value for your db by running the SQL
     command <code>show max_connections;</code></dd>
@@ -113,6 +118,37 @@ The possible flags are:
     file.</p>
 </div>
 
+When running `postgrest` on the same machine as PostgreSQL, it is also
+possible to connect to the database using the [Unix socket]
+(https://en.wikipedia.org/wiki/Unix_domain_socket) and the
+[Peer Authentication method]
+(http://www.postgresql.org/docs/current/static/auth-methods.html#AUTH-PEER)
+as an alternative to TCP/IP communication and authentication with a password.
+
+The Peer Authentication grants access to the database to any Unix user
+who connects as a user of the same name in the database.
+Since the empty host resolves to the Unix socket]
+(http://www.postgresql.org/docs/current/static/libpq-connect.html#AEN42494)
+and the password can be omitted in this case,
+the command line is reduced to:
+
+```sh
+sudo -u user postgrest postgres://user@/db [flags]
+```
+
+where the `sudo -u user` command runs the following command as given `user`.
+
+If you create a Unix user `postgrest` and a database user `postgrest`
+for example, the command becomes:
+
+```sh
+sudo -u postgrest postgrest postgres://postgrest@/db [flags]
+```
+
+The first `postgrest` is the Unix user name, the second `postgrest`
+is the name of the executable, the third `postgrest` is the name
+of the database user.
+
 ### Install via Homebrew (Mac OS X)
 
 You can use the Homebrew package manager to install PostgREST on Mac

main/Main.hs

@@ -0,0 +1,87 @@
+{-# LANGUAGE CPP #-}
+
+module Main where
+
+
+import           PostgREST.App
+import           PostgREST.Config                     (AppConfig (..),
+                                                       minimumPgVersion,
+                                                       prettyVersion,
+                                                       readOptions)
+import           PostgREST.DbStructure
+
+import           Control.Monad
+import           Data.Monoid                          ((<>))
+import           Data.String.Conversions              (cs)
+import qualified Hasql.Query                          as H
+import qualified Hasql.Session                        as H
+import qualified Hasql.Decoders                       as HD
+import qualified Hasql.Encoders                       as HE
+import qualified Hasql.Pool                           as P
+import           Network.Wai.Handler.Warp
+import           System.IO                            (BufferMode (..),
+                                                       hSetBuffering, stderr,
+                                                       stdin, stdout)
+import           Web.JWT                              (secret)
+import           Data.IORef
+#ifndef mingw32_HOST_OS
+import           Control.Monad.IO.Class               (liftIO)
+import           System.Posix.Signals
+import           Control.Concurrent                   (myThreadId)
+import           Control.Exception.Base               (throwTo, AsyncException(..))
+#endif
+
+isServerVersionSupported :: H.Session Bool
+isServerVersionSupported = do
+  ver <- H.query () pgVersion
+  return $ read (cs ver) >= minimumPgVersion
+ where
+  pgVersion =
+    H.statement "SHOW server_version_num"
+      HE.unit (HD.singleRow $ HD.value HD.text) True
+
+main :: IO ()
+main = do
+  hSetBuffering stdout LineBuffering
+  hSetBuffering stdin  LineBuffering
+  hSetBuffering stderr NoBuffering
+
+  conf <- readOptions
+  let port = configPort conf
+      pgSettings = cs (configDatabase conf)
+      appSettings = setPort port
+                  . setServerName (cs $ "postgrest/" <> prettyVersion)
+                  $ defaultSettings
+
+  unless (secret "secret" /= configJwtSecret conf) $
+    putStrLn "WARNING, running in insecure mode, JWT secret is the default value"
+  Prelude.putStrLn $ "Listening on port " ++
+    (show $ configPort conf :: String)
+
+  pool <- P.acquire (configPool conf, 10, pgSettings)
+
+  result <- P.use pool $ do
+    supported <- isServerVersionSupported
+    unless supported $ error (
+      "Cannot run in this PostgreSQL version, PostgREST needs at least "
+      <> show minimumPgVersion)
+    getDbStructure (cs $ configSchema conf)
+
+  refDbStructure <- newIORef $ either (error.show) id result
+
+#ifndef mingw32_HOST_OS
+  tid <- myThreadId
+  forM_ [sigINT, sigTERM] $ \sig ->
+    void $ installHandler sig (Catch $ do
+        P.release pool
+        throwTo tid UserInterrupt
+      ) Nothing
+
+  void $ installHandler sigHUP (
+      Catch . void . P.use pool $ do
+        s <- getDbStructure (cs $ configSchema conf)
+        liftIO $ atomicWriteIORef refDbStructure s
+   ) Nothing
+#endif
+
+  runSettings appSettings $ postgrest conf refDbStructure pool

mkdocs.yml

@@ -24,3 +24,5 @@ pages:
   - Getting Started: examples/start.md
   - User Management: examples/users.md
   - Multi-Tenant Blog: examples/blog.md
+  - External Authentication: examples/external_auth.md
+  - Python Client:  examples/python-requests-jwt.md

postgrest.cabal

@@ -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.3.0.2
+version:               0.3.2.0
 synopsis:              REST API for any Postgres database
 license:               MIT
 license-file:          LICENSE
@@ -22,27 +22,34 @@ 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
+  main-is:             Main.hs
   default-extensions:  OverloadedStrings, ScopedTypeVariables, QuasiQuotes
+  ghc-options:
+    -threaded
+    -rtsopts
+    "-with-rtsopts=-N -I2"
   default-language:    Haskell2010
-  build-depends:       aeson >= 0.8
-                     , base >= 4.8 && < 5
+  build-depends:       aeson (>= 0.8 && < 0.10) || (>= 0.11 && < 0.12)
+                     , base >= 4.8 && < 6
                      , bytestring
+                     , bytestring-tree-builder == 0.2.7
                      , case-insensitive
                      , cassava
                      , containers
+                     , contravariant
                      , errors
-                     , hasql >= 0.7.3 && < 0.8
-                     , hasql-backend >= 0.4.1 && < 0.5
-                     , hasql-postgres >= 0.10.4 && < 0.11
+                     , hasql == 0.19.12
+                     , hasql-pool == 0.4.1
+                     , hasql-transaction == 0.4.5
+                     , http-types
+                     , interpolatedstring-perl6
                      , jwt
+                     , microlens >= 0.4.2 && < 0.5
+                     , microlens-aeson >= 2.1.1 && < 2.2
+                     , mtl
                      , optparse-applicative >= 0.11 && < 0.13
                      , parsec
+                     , postgresql-binary == 0.9.0.1
                      , postgrest
                      , regex-tdfa
                      , safe >= 0.3 && < 0.4
@@ -57,47 +64,34 @@ executable postgrest
                      , wai-cors
                      , wai-extra
                      , wai-middleware-static >= 0.6.0
-                     , warp >= 3.0.2
-                     , HTTP, http-types
-                     , MissingH
+                     , warp >= 3.1.0
+                     , HTTP
                      , Ranged-sets
   if !os(windows)
     build-depends:     unix >= 2.7 && < 3
 
-  hs-source-dirs:      src
-  other-modules:       Paths_postgrest
-                     , PostgREST.App
-                     , PostgREST.Auth
-                     , PostgREST.Config
-                     , PostgREST.Error
-                     , PostgREST.Middleware
-                     , PostgREST.Parsers
-                     , PostgREST.DbStructure
-                     , PostgREST.QueryBuilder
-                     , PostgREST.RangeQuery
-                     , PostgREST.ApiRequest
-                     , PostgREST.Types
+  hs-source-dirs:      main
 
 library
-  if flag(ci)
-    ghc-options:       -Wall -W -Werror
-  else
-    ghc-options:       -Wall -W -O2
-
   default-language:    Haskell2010
   default-extensions:  OverloadedStrings, ScopedTypeVariables, QuasiQuotes
   build-depends:       aeson
-                     , base >=4.6 && <5
+                     , base
                      , bytestring
                      , case-insensitive
                      , cassava
                      , containers
+                     , contravariant
                      , errors
                      , hasql
-                     , hasql-backend
-                     , hasql-postgres
+                     , hasql-transaction
+                     , hasql-pool
                      , http-types
+                     , interpolatedstring-perl6
                      , jwt
+                     , microlens
+                     , microlens-aeson
+                     , mtl
                      , optparse-applicative
                      , parsec
                      , regex-tdfa
@@ -108,13 +102,13 @@ library
                      , time
                      , unordered-containers
                      , vector
-                     , wai
+                     , HTTP
+                     , Ranged-sets
+                     , wai >= 3.0.1
                      , wai-cors
                      , wai-extra
-                     , wai-middleware-static
-                     , HTTP
-                     , MissingH
-                     , Ranged-sets
+                     , wai-middleware-static >= 0.6.0
+                     , warp >= 3.1.0
 
   Other-Modules:       Paths_postgrest
   Exposed-Modules:     PostgREST.App
@@ -134,54 +128,48 @@ Test-Suite spec
   Type:                exitcode-stdio-1.0
   Default-Language:    Haskell2010
   default-extensions:  OverloadedStrings, ScopedTypeVariables, QuasiQuotes
-  Hs-Source-Dirs:      test, src
-  if flag(ci)
-    ghc-options:       -Wall -W -Werror
-  else
-    ghc-options:       -Wall -W -O2
+  ghc-options:         -threaded -rtsopts -with-rtsopts=-N
+  Hs-Source-Dirs:      test
   Main-Is:             Main.hs
   Other-Modules:       Feature.AuthSpec
+                     , Feature.ConcurrentSpec
                      , Feature.CorsSpec
                      , Feature.DeleteSpec
                      , Feature.InsertSpec
                      , Feature.QuerySpec
+                     , Feature.QueryLimitedSpec
                      , Feature.RangeSpec
                      , Feature.StructureSpec
-                     , Paths_postgrest
-                     , PostgREST.App
-                     , PostgREST.Auth
-                     , PostgREST.Config
-                     , PostgREST.Error
-                     , PostgREST.Middleware
-                     , PostgREST.Parsers
-                     , PostgREST.DbStructure
-                     , PostgREST.QueryBuilder
-                     , PostgREST.RangeQuery
-                     , PostgREST.ApiRequest
-                     , PostgREST.Types
+                     , Feature.UnicodeSpec
                      , SpecHelper
                      , TestTypes
   Build-Depends:       aeson
+                     , async
                      , base
                      , base64-string
                      , bytestring
                      , case-insensitive
                      , cassava
                      , containers
+                     , contravariant
                      , errors
                      , hasql
-                     , hasql-backend
-                     , hasql-postgres
+                     , hasql-pool
+                     , hasql-transaction
                      , heredoc
-                     , hlint
-                     , hspec == 2.2.*
+                     , hspec
                      , hspec-wai
                      , hspec-wai-json
                      , http-types
+                     , interpolatedstring-perl6
                      , jwt
+                     , microlens
+                     , microlens-aeson
+                     , monad-control
+                     , mtl
                      , optparse-applicative
-                     , packdeps
                      , parsec
+                     , postgrest
                      , process
                      , regex-tdfa
                      , safe
@@ -189,12 +177,14 @@ Test-Suite spec
                      , string-conversions
                      , text
                      , time
+                     , transformers
+                     , transformers-base
                      , unordered-containers
                      , vector
                      , wai
                      , wai-cors
                      , wai-extra
                      , wai-middleware-static
+                     , warp
                      , HTTP
-                     , MissingH
                      , Ranged-sets

schema-templates/blog.sql

@@ -11,7 +11,6 @@ create role authenticator noinherit;
 grant anon, author to authenticator;
 
 create extension if not exists pgcrypto;
-create extension if not exists "uuid-ossp";
 
 -- We put things inside the basic_auth schema to hide
 -- them from public view. Certain public procs/views will
@@ -97,7 +96,7 @@ basic_auth.send_validation() returns trigger
 declare
   tok uuid;
 begin
-  select uuid_generate_v4() into tok;
+  select gen_random_uuid() into tok;
   insert into basic_auth.tokens (token, token_type, email)
          values (tok, 'validation', new.email);
   perform pg_notify('validate',
@@ -175,7 +174,7 @@ begin
    where token_type = 'reset'
      and tokens.email = request_password_reset.email;
 
-  select uuid_generate_v4() into tok;
+  select gen_random_uuid() into tok;
   insert into basic_auth.tokens (token, token_type, email)
          values (tok, 'reset', request_password_reset.email);
   perform pg_notify('reset',
@@ -215,7 +214,7 @@ begin
    where token_type = 'reset'
      and tokens.email = reset_password.email;
 
-  select uuid_generate_v4() into tok;
+  select gen_random_uuid() into tok;
   insert into basic_auth.tokens (token, token_type, email)
          values (tok, 'reset', reset_password.email);
   perform pg_notify('reset',

src/PostgREST/ApiRequest.hs

@@ -1,26 +1,32 @@
 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)
+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, sortBy)
+import qualified Data.HashMap.Strict       as M
+import qualified Data.Set                  as S
+import           Data.Maybe                (fromMaybe, isJust, isNothing,
+                                            listToMaybe, fromJust)
+import           Control.Arrow             ((***))
+import           Control.Monad             (join)
+import           Data.Monoid               ((<>))
+import           Data.Ord                  (comparing)
+import           Data.String.Conversions   (cs)
+import qualified Data.Text                 as T
+import           Text.Read                 (readMaybe)
+import qualified Data.Vector               as V
+import           Network.HTTP.Base         (urlEncodeVars)
+import           Network.HTTP.Types.Header (hAuthorization)
+import           Network.HTTP.Types.URI    (parseSimpleQuery)
+import           Network.Wai               (Request (..))
+import           Network.Wai.Parse         (parseHttpAccept)
+import           PostgREST.RangeQuery      (NonnegRange, rangeRequested, restrictRange, rangeGeq, allRange)
+import           PostgREST.Types           (QualifiedIdentifier (..),
+                                            Schema, Payload(..),
+                                            UniformObjects(..))
+import           Data.Ranged.Ranges        (singletonRange, rangeIntersection)
 
 type RequestBody = BL.ByteString
 
@@ -28,9 +34,11 @@ type RequestBody = BL.ByteString
 data Action = ActionCreate | ActionRead
             | ActionUpdate | ActionDelete
             | ActionInfo   | ActionInvoke
-            | ActionUnknown BS.ByteString deriving Eq
+            | ActionInappropriate
+            deriving Eq
 -- | The target db object of a user action
 data Target = TargetIdent QualifiedIdentifier
+            | TargetProc  QualifiedIdentifier
             | TargetRoot
             | TargetUnknown [T.Text]
 -- | How to return the inserted data
@@ -39,8 +47,8 @@ data PreferRepresentation = Full | HeadersOnly | None deriving Eq
 -- route responses and upload payloads
 data ContentType = ApplicationJSON | TextCSV deriving Eq
 instance Show ContentType where
-  show ApplicationJSON = "application/json"
-  show TextCSV         = "text/csv"
+  show ApplicationJSON = "application/json; charset=utf-8"
+  show TextCSV         = "text/csv; charset=utf-8"
 
 {-|
   Describes what the user wants to do. This data type is a
@@ -50,11 +58,11 @@ instance Show ContentType where
   if it is an action we are able to perform.
 -}
 data ApiRequest = ApiRequest {
-  -- | Set to Nothing for unknown HTTP verbs
+  -- | Similar but not identical to HTTP verb, e.g. Create/Invoke both POST
     iAction :: Action
-  -- | Set to Nothing for malformed range
-  , iRange  :: NonnegRange
-  -- | Set to Nothing for strangely nested urls
+  -- | Requested range of rows within response
+  , iRange  :: M.HashMap String NonnegRange
+  -- | The target, be it calling a proc or accessing a table
   , iTarget :: Target
   -- | The content type the client most desires (or JSON if undecided)
   , iAccepts :: Either BS.ByteString ContentType
@@ -70,27 +78,36 @@ data ApiRequest = ApiRequest {
   , iFilters :: [(String, String)]
   -- | &select parameter used to shape the response
   , iSelect :: String
-  -- | &order parameter
-  , iOrder :: Maybe String
+  -- | &order parameters for each level
+  , iOrder :: [(String,String)]
+  -- | Alphabetized (canonical) request query string for response URLs
+  , iCanonicalQS :: String
+  -- | JSON Web Token
+  , iJWT :: T.Text
   }
 
 -- | 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
+  let action =
+        if isTargetingProc
+          then
+            if method == "POST"
+               then ActionInvoke
+               else ActionInappropriate
+          else
+            case method of
+               "GET"     -> ActionRead
+               "POST"    -> ActionCreate
+               "PATCH"   -> ActionUpdate
+               "DELETE"  -> ActionDelete
+               "OPTIONS" -> ActionInfo
+               _         -> ActionInappropriate
       target = case path of
                  []            -> TargetRoot
                  [table]       -> TargetIdent
                                   $ QualifiedIdentifier schema table
-                 ["rpc", proc] -> TargetIdent
+                 ["rpc", proc] -> TargetProc
                                   $ QualifiedIdentifier schema proc
                  other         -> TargetUnknown other
       payload = case pickContentType (lookupHeader "content-type") of
@@ -106,6 +123,13 @@ userApiRequest schema req reqBody =
               Nothing -> PayloadParseError "All lines must have same number of fields"
               Just json -> PayloadJSON json)
             (CSV.decodeByName reqBody)
+        -- This is a Left value because form-urlencoded is not a content
+        -- type which we ever use for responses, only something we handle
+        -- just this once for requests
+        Left "application/x-www-form-urlencoded" ->
+          PayloadJSON . UniformObjects . V.singleton . M.fromList
+                      . map (cs *** JSON.String . cs) . parseSimpleQuery
+                      $ cs reqBody
         Left accept ->
           PayloadParseError $
             "Content-type not acceptable: " <> accept
@@ -117,18 +141,23 @@ userApiRequest schema req reqBody =
 
   ApiRequest {
     iAction = action
-  , iRange  = if singular then singletonRange 0 else rangeRequested hdrs
   , iTarget = target
+  , iRange = M.insert "limit" (rangeIntersection headerRange urlRange) $
+      M.fromList [ (cs k, restrictRange (readMaybe =<< v) allRange) | (k,v) <- qParams, isJust v, endingIn ["limit"] k ]
   , iAccepts = pickContentType $ lookupHeader "accept"
   , iPayload = relevantPayload
   , iPreferRepresentation = representation
   , iPreferSingular = singular
-  , iPreferCount = not $ hasPrefer "count=none"
-  , iFilters = [ (k, fromJust v) | (k,v) <- qParams, k `notElem` ["select", "order"], isJust v ]
-  , iSelect = if method == "DELETE"
-              then "*"
-              else fromMaybe "*" $ fromMaybe (Just "*") $ lookup "select" qParams
-  , iOrder = join $ lookup "order" qParams
+  , iPreferCount = not $ singular || hasPrefer "count=none"
+  , iFilters = [ (cs k, fromJust v) | (k,v) <- qParams, isJust v, k /= "select", k /= "offset", not (endingIn ["order", "limit"] k) ]
+  , iSelect = fromMaybe "*" $ fromMaybe (Just "*") $ lookup "select" qParams
+  , iOrder = [(cs k, fromJust v) | (k,v) <- qParams, isJust v, endingIn ["order"] k ]
+  , iCanonicalQS = urlEncodeVars
+     . sortBy (comparing fst)
+     . map (join (***) cs)
+     . parseSimpleQuery
+     $ rawQueryString req
+  , iJWT = tokenStr
   }
 
  where
@@ -138,12 +167,30 @@ userApiRequest schema req reqBody =
   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
+  hasPrefer :: T.Text -> Bool
+  hasPrefer val   = any (\(h,v) -> h == "Prefer" && val `elem` split v) hdrs
+    where
+        split :: BS.ByteString -> [T.Text]
+        split = map T.strip . T.split (==';') . cs
   singular        = hasPrefer "plurality=singular"
   representation
     | hasPrefer "return=representation" = Full
     | hasPrefer "return=minimal" = None
     | otherwise = HeadersOnly
+  auth = fromMaybe "" $ lookupHeader hAuthorization
+  tokenStr = case T.split (== ' ') (cs auth) of
+    ("Bearer" : t : _) -> t
+    _                  -> ""
+  endingIn:: [T.Text] -> T.Text -> Bool
+  endingIn xx key = lastWord `elem` xx
+    where lastWord = last $ T.split (=='.') key
+
+  headerRange = if singular then singletonRange 0 else rangeRequested hdrs
+  urlOffsetRange = rangeGeq . fromMaybe (0::Integer) $
+    readMaybe =<< join (lookup "offset" qParams)
+  urlRange = restrictRange
+    (readMaybe =<< join (lookup "limit" qParams))
+    urlOffsetRange
 
 -- PRIVATE ---------------------------------------------------------------
 

src/PostgREST/App.hs

@@ -3,54 +3,53 @@
 {-# LANGUAGE TupleSections #-}
 --module PostgREST.App where
 module PostgREST.App (
-  app
+  postgrest
 ) where
 
 import           Control.Applicative
-import           Control.Arrow             ((***))
-import           Control.Monad             (join)
 import           Data.Bifunctor            (first)
-import qualified Data.ByteString.Lazy      as BL
-import           Data.Functor.Identity
-import           Data.List                 (find, sortBy, delete)
+import qualified Data.ByteString.Char8   as BS
+import           Data.IORef                (IORef, readIORef)
+import           Data.List                 (find, delete)
 import           Data.Maybe                (fromMaybe, fromJust, mapMaybe)
-import           Data.Ord                  (comparing)
 import           Data.Ranged.Ranges        (emptyRange)
 import           Data.String.Conversions   (cs)
 import           Data.Text                 (Text, replace, strip)
 import           Data.Tree
 
+import qualified Hasql.Pool                as P
+import qualified Hasql.Transaction         as HT
+
 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.HTTP.Types.URI (renderSimpleQuery)
 import           Network.Wai
+import           Network.Wai.Middleware.RequestLogger (logStdout)
 
 import           Data.Aeson
 import           Data.Aeson.Types (emptyArray)
 import           Data.Monoid
+import           Data.Time.Clock.POSIX     (getPOSIXTime)
 import qualified Data.Vector               as V
-import qualified Hasql                     as H
-import qualified Hasql.Backend             as B
-import qualified Hasql.Postgres            as P
+import qualified Hasql.Transaction         as H
+
+import qualified Data.HashMap.Strict       as M
 
-import           PostgREST.Config          (AppConfig (..))
-import           PostgREST.Parsers
-import           PostgREST.DbStructure
-import           PostgREST.RangeQuery
 import           PostgREST.ApiRequest   (ApiRequest(..), ContentType(..)
                                             , Action(..), Target(..)
                                             , PreferRepresentation (..)
                                             , userApiRequest)
-import           PostgREST.Types
-import           PostgREST.Auth            (tokenJWT)
-import           PostgREST.Error           (errResponse)
-
-import           PostgREST.QueryBuilder ( asJson
-                                        , callProc
+import           PostgREST.Auth            (tokenJWT, jwtClaims, containsRole)
+import           PostgREST.Config          (AppConfig (..))
+import           PostgREST.DbStructure
+import           PostgREST.Error           (errResponse, pgErrResponse)
+import           PostgREST.Parsers
+import           PostgREST.RangeQuery      (NonnegRange, allRange, rangeOffset, restrictRange)
+import           PostgREST.Middleware
+import           PostgREST.QueryBuilder ( callProc
                                         , addJoinConditions
                                         , sourceCTEName
                                         , requestToQuery
@@ -58,12 +57,40 @@ import           PostgREST.QueryBuilder ( asJson
                                         , addRelations
                                         , createReadStatement
                                         , createWriteStatement
+                                        , ResultsWithCount
                                         )
+import           PostgREST.Types
 
 import           Prelude
 
-app :: DbStructure -> AppConfig -> RequestBody -> Request -> H.Tx P.Postgres s Response
-app dbStructure conf reqBody req =
+
+postgrest :: AppConfig -> IORef DbStructure -> P.Pool -> Application
+postgrest conf refDbStructure pool =
+  let middle = (if configQuiet conf then id else logStdout) . defaultMiddle in
+
+  middle $ \ req respond -> do
+    time <- getPOSIXTime
+    body <- strictRequestBody req
+    dbStructure <- readIORef refDbStructure
+
+    let schema = cs $ configSchema conf
+        apiRequest = userApiRequest schema req body
+        eClaims = jwtClaims (configJwtSecret conf) (iJWT apiRequest) time
+        authed = containsRole eClaims
+        handleReq = runWithClaims conf eClaims (app dbStructure conf) apiRequest
+        txMode = transactionMode $ iAction apiRequest
+
+    resp <- either (pgErrResponse authed) id <$> P.use pool
+      (HT.run handleReq HT.ReadCommitted txMode)
+    respond resp
+
+transactionMode :: Action -> H.Mode
+transactionMode ActionRead = HT.Read
+transactionMode ActionInfo = HT.Read
+transactionMode _ = HT.Write
+
+app :: DbStructure -> AppConfig -> ApiRequest -> H.Transaction Response
+app dbStructure conf apiRequest =
   let
       -- TODO: blow up for Left values (there is a middleware that checks the headers)
       contentType = either (const ApplicationJSON) id (iAccepts apiRequest)
@@ -75,120 +102,121 @@ app dbStructure conf reqBody req =
       case readSqlParts of
         Left e -> return $ responseLBS status400 [jsonH] $ cs e
         Right (q, cq) -> do
-          let range = restrictRange (configMaxRows conf) $ iRange apiRequest
-              singular = iPreferSingular apiRequest
-              stm = createReadStatement q cq range singular
-                    (iPreferCount apiRequest) (contentType == TextCSV)
-          if range == emptyRange
-          then return $ errResponse status416 "HTTP Range error"
-          else do
-            row <- H.maybeEx stm
-            let (tableTotal, queryTotal, _ , body) = extractQueryResult row
+          let singular = iPreferSingular apiRequest
+              stm = createReadStatement q cq singular
+                    shouldCount (contentType == TextCSV)
+          respondToRange $ do
+            row <- H.query () stm
+            let (tableTotal, queryTotal, _ , body) = row
             if singular
             then return $ if queryTotal <= 0
               then responseLBS status404 [] ""
-              else responseLBS status200 [contentTypeH] (fromMaybe "{}" body)
+              else responseLBS status200 [contentTypeH] (cs body)
             else do
-              let frm = 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
+              let (status, contentRange) = rangeHeader queryTotal tableTotal
+                  canonical = iCanonicalQS apiRequest
               return $ responseLBS status
                 [contentTypeH, contentRange,
                   ("Content-Location",
                     "/" <> cs (qiName qi) <>
                       if Prelude.null canonical then "" else "?" <> cs canonical
                   )
-                ] (fromMaybe "[]" body)
+                ] (cs body)
 
     (ActionCreate, TargetIdent qi@(QualifiedIdentifier _ table),
-     Just payload@(PayloadJSON (UniformObjects rows))) ->
+     Just payload@(PayloadJSON uniform@(UniformObjects rows))) ->
       case mutateSqlParts of
         Left e -> return $ responseLBS status400 [jsonH] $ cs e
         Right (sq,mq) -> do
           let isSingle = (==1) $ V.length rows
           let pKeys = map pkName $ filter (filterPk schema table) allPrKeys -- would it be ok to move primary key detection in the query itself?
           let stm = createWriteStatement qi sq mq isSingle (iPreferRepresentation apiRequest) pKeys (contentType == TextCSV) payload
-          row <- H.maybeEx stm
-          let (_, _, location, body) = extractQueryResult row
-          return $ responseLBS status201
-            [
-              contentTypeH,
-              (hLocation, "/" <> cs table <> "?" <> cs (fromMaybe "" location))
-            ]
-            $ if iPreferRepresentation apiRequest == Full then fromMaybe "[]" body else ""
+          row <- H.query uniform stm
+          let (_, _, fs, body) = extractQueryResult row
+              header =
+                if null fs then []
+                else [(hLocation, "/" <> cs table <> renderLocationFields fs)]
 
-    (ActionUpdate, TargetIdent qi, Just payload@(PayloadJSON _)) ->
+          return $ if iPreferRepresentation apiRequest == Full
+            then responseLBS status201 (contentTypeH : header) (cs body)
+            else responseLBS status201 header ""
+
+    (ActionUpdate, TargetIdent qi, Just payload@(PayloadJSON uniform)) ->
       case mutateSqlParts of
         Left e -> return $ responseLBS status400 [jsonH] $ cs e
         Right (sq,mq) -> do
           let stm = createWriteStatement qi sq mq False (iPreferRepresentation apiRequest) [] (contentType == TextCSV) payload
-          row <- H.maybeEx stm
+          row <- H.query uniform stm
           let (_, queryTotal, _, body) = extractQueryResult row
-              r = contentRangeH 0 (queryTotal-1) (Just queryTotal)
+              r = contentRangeH 0 (toInteger $ queryTotal-1) (toInteger <$> Just queryTotal)
               s = case () of _ | queryTotal == 0 -> status404
                                | iPreferRepresentation apiRequest == Full -> status200
                                | otherwise -> status204
-          return $ responseLBS s [contentTypeH, r]
-            $ if iPreferRepresentation apiRequest == Full then fromMaybe "[]" body else ""
+          return $ if iPreferRepresentation apiRequest == Full
+            then responseLBS s [contentTypeH, r] (cs body)
+            else responseLBS s [r] ""
 
     (ActionDelete, TargetIdent qi, Nothing) ->
       case mutateSqlParts of
         Left e -> return $ responseLBS status400 [jsonH] $ cs e
         Right (sq,mq) -> do
-          let fakeload = PayloadJSON $ UniformObjects V.empty
-          let stm = createWriteStatement qi sq mq False (iPreferRepresentation apiRequest) [] (contentType == TextCSV) fakeload
-          row <- H.maybeEx stm
-          let (_, queryTotal, _, _) = extractQueryResult row
+          let emptyUniform = UniformObjects V.empty
+              fakeload = PayloadJSON emptyUniform
+              stm = createWriteStatement qi sq mq False (iPreferRepresentation apiRequest) [] (contentType == TextCSV) fakeload
+          row <- H.query emptyUniform stm
+          let (_, queryTotal, _, body) = extractQueryResult row
+              r = contentRangeH 1 0 (toInteger <$> Just queryTotal)
           return $ if queryTotal == 0
             then notFound
-            else responseLBS status204 [("Content-Range", "*/"<> cs (show queryTotal))] ""
+            else if iPreferRepresentation apiRequest == Full
+              then responseLBS status200 [contentTypeH, r] (cs body)
+              else responseLBS status204 [r] ""
 
-    (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
+    (ActionInfo, TargetIdent (QualifiedIdentifier tSchema tTable), Nothing) ->
+      let mTable = find (\t -> tableName t == tTable && tableSchema t == tSchema) (dbTables dbStructure) in
+      case mTable of
+        Nothing -> return notFound
+        Just table ->
+          let 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
+              acceptH = (hAllow, if tableInsertable table then "GET,POST,PATCH,DELETE" else "GET") in
+          return $ responseLBS status200 [jsonH, allOrigins, acceptH] $ cs body
 
-    (ActionInvoke, TargetIdent qi,
+    (ActionInvoke, TargetProc qi,
      Just (PayloadJSON (UniformObjects payload))) -> do
-      exists <- doesProcExist qi
+      exists <- H.query qi doesProcExist
       if exists
         then do
           let p = V.head payload
-              call = B.Stmt "select " V.empty True <>
-                asJson (callProc qi p)
               jwtSecret = configJwtSecret conf
-
-          bodyJson :: Maybe (Identity Value) <- H.maybeEx call
-          returnJWT <- doesProcReturnJWT qi
-          return $ responseLBS status200 [jsonH]
-                 (let body = fromMaybe emptyArray $ runIdentity <$> bodyJson in
-                    if returnJWT
-                    then "{\"token\":\"" <> cs (tokenJWT jwtSecret body) <> "\"}"
-                    else cs $ encode body)
+          respondToRange $ do
+            row <- H.query () (callProc qi p topLevelRange shouldCount)
+            returnJWT <- H.query qi doesProcReturnJWT
+            let (tableTotal, queryTotal, body) = fromMaybe (Just 0, 0, emptyArray) row
+                (status, contentRange) = rangeHeader queryTotal tableTotal
+              in
+              return $ responseLBS status [jsonH, contentRange]
+                      (if returnJWT
+                      then "{\"token\":\"" <> cs (tokenJWT jwtSecret body) <> "\"}"
+                      else cs $ encode body)
         else return notFound
 
     (ActionRead, TargetRoot, Nothing) -> do
-      body <- encode <$> accessibleTables (filter ((== cs schema) . tableSchema) (dbTables dbStructure))
+      body <- encode <$> H.query schema accessibleTables
       return $ responseLBS status200 [jsonH] $ cs body
 
-    (ActionUnknown _, _, _) -> return notFound
-
-    (_, TargetUnknown _, _) -> return notFound
+    (ActionInappropriate, _, _) -> return $ responseLBS status405 [] ""
 
     (_, _, Just (PayloadParseError e)) ->
       return $ responseLBS status400 [jsonH] $
         cs (formatGeneralError "Cannot parse request payload" (cs e))
 
+    (_, TargetUnknown _, _) -> return notFound
+
     (_, _, _) -> return notFound
 
  where
@@ -197,23 +225,40 @@ app dbStructure conf reqBody req =
   allPrKeys = dbPrimaryKeys dbStructure
   allOrigins = ("Access-Control-Allow-Origin", "*") :: Header
   schema = cs $ configSchema conf
-  apiRequest = userApiRequest schema req reqBody
-  readDbRequest = DbRead <$> buildReadRequest (dbRelations dbStructure) apiRequest
+  shouldCount = iPreferCount apiRequest
+  topLevelRange = fromMaybe allRange $ M.lookup "limit" $ iRange apiRequest
+  readDbRequest = DbRead <$> buildReadRequest (configMaxRows conf) (dbRelations dbStructure) apiRequest
   mutateDbRequest = DbMutate <$> buildMutateRequest apiRequest
   selectQuery = requestToQuery schema <$> readDbRequest
   countQuery = requestToCountQuery schema <$> readDbRequest
   mutateQuery = requestToQuery schema <$> mutateDbRequest
   readSqlParts = (,) <$> selectQuery <*> countQuery
   mutateSqlParts = (,) <$> selectQuery <*> mutateQuery
+  respondToRange response = if topLevelRange == emptyRange
+                            then return $ errResponse status416 "HTTP Range error"
+                            else response
+  rangeHeader queryTotal tableTotal = let frm = rangeOffset topLevelRange
+                                          to = frm + toInteger queryTotal - 1
+                                          contentRange = contentRangeH frm to (toInteger <$> tableTotal)
+                                          status = rangeStatus frm to (toInteger <$> tableTotal)
+                                      in (status, contentRange)
 
-rangeStatus :: Int -> Int -> Maybe Int -> Status
+splitKeyValue :: BS.ByteString -> (BS.ByteString, BS.ByteString)
+splitKeyValue kv = (k, BS.tail v)
+  where (k, v) = BS.break (== '=') kv
+
+renderLocationFields :: [BS.ByteString] -> BS.ByteString
+renderLocationFields fields =
+  renderSimpleQuery True $ map splitKeyValue fields
+
+rangeStatus :: Integer -> Integer -> Maybe Integer -> Status
 rangeStatus _ _ Nothing = status200
 rangeStatus frm to (Just total)
   | frm > total            = status416
   | (1 + to - frm) < total = status206
   | otherwise               = status200
 
-contentRangeH :: Int -> Int -> Maybe Int -> Header
+contentRangeH :: Integer -> Integer -> Maybe Integer -> Header
 contentRangeH frm to total =
     ("Content-Range", cs headerValue)
     where
@@ -226,7 +271,7 @@ contentRangeH frm to total =
       fromInRange   = frm <= to
 
 jsonH :: Header
-jsonH = (hContentType, "application/json")
+jsonH = (hContentType, "application/json; charset=utf-8")
 
 formatRelationError :: Text -> Text
 formatRelationError = formatGeneralError
@@ -249,68 +294,122 @@ 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)
+addFiltersOrdersRanges :: ApiRequest -> Either ParseError (ReadRequest -> ReadRequest)
+addFiltersOrdersRanges apiRequest = foldr1 (liftA2 (.)) [
+    flip (foldr addFilter) <$> filters,
+    flip (foldr addOrder) <$> orders,
+    flip (foldr addRange) <$> ranges
+  ]
+  {-
+  The esence of what is going on above is that we are composing tree functions
+  of type (ReadRequest->ReadRequest) that are in (Either ParseError a) context
+  -}
+  where
+    filters :: Either ParseError [(Path, Filter)]
+    filters = mapM pRequestFilter flts
+      where
+        action = iAction apiRequest
+        flts = 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
+    orders :: Either ParseError [(Path, [OrderTerm])]
+    orders = mapM pRequestOrder $ iOrder apiRequest
+    ranges :: Either ParseError [(Path, NonnegRange)]
+    ranges = mapM pRequestRange $ M.toList $ iRange apiRequest
+
+treeRestrictRange :: Maybe Integer -> ReadRequest -> Either Text ReadRequest
+treeRestrictRange maxRows_ request = pure $ nodeRestrictRange maxRows_ `fmap` request
+  where
+    nodeRestrictRange :: Maybe Integer -> ReadNode -> ReadNode
+    nodeRestrictRange m (q@Select {range_=r}, i) = (q{range_=restrictRange m r }, i)
+
+buildReadRequest :: Maybe Integer -> [Relation] -> ApiRequest -> Either Text ReadRequest
+buildReadRequest maxRows allRels apiRequest  =
+  treeRestrictRange maxRows =<<
+  augumentRequestWithJoin schema relations =<<
+  first formatParserError readRequest
   where
-    selStr = iSelect apiRequest
-    orderS = iOrder apiRequest
-    action = iAction apiRequest
-    target = iTarget apiRequest
     (schema, rootTableName) = fromJust $ -- Make it safe
+      let target = iTarget apiRequest in
       case target of
         (TargetIdent (QualifiedIdentifier s t) ) -> Just (s, t)
         _ -> Nothing
 
-    rootName = if action == ActionRead
-      then rootTableName
-      else sourceCTEName
-    filters = if action == ActionRead
-      then iFilters apiRequest
-      else filter (( '.' `elem` ) . fst) $ iFilters apiRequest -- there can be no filters on the root table whre we are doing insert/update
-    rels = case action of
+    action :: Action
+    action = iAction apiRequest
+
+    readRequest :: Either ParseError ReadRequest
+    readRequest = addFiltersOrdersRanges apiRequest <*>
+      parse (pRequestSelect rootName) ("failed to parse select parameter <<"++selStr++">>") selStr
+      where
+        selStr = iSelect apiRequest
+        rootName = if action == ActionRead
+          then rootTableName
+          else sourceCTEName
+
+    relations :: [Relation]
+    relations = case action of
       ActionCreate -> fakeSourceRelations ++ allRels
       ActionUpdate -> fakeSourceRelations ++ allRels
+      ActionDelete -> fakeSourceRelations ++ allRels
       _       -> 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
+buildMutateRequest apiRequest = case action of
+  ActionCreate -> Insert rootTableName <$> pure payload
+  ActionUpdate -> Update rootTableName <$> pure payload <*> filters
+  ActionDelete -> Delete rootTableName <$> filters
+  _        -> Left "Unsupported HTTP verb"
   where
     action = iAction apiRequest
-    target = iTarget apiRequest
     payload = fromJust $ iPayload apiRequest
     rootTableName = -- TODO: Make it safe
+      let target = iTarget apiRequest in
       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
+    filters = first formatParserError $ map snd <$> mapM pRequestFilter mutateFilters
+      where mutateFilters = filter (not . ( '.' `elem` ) . fst) $ iFilters apiRequest -- update/delete filters can be only on the root table
+
+addFilterToNode :: Filter -> ReadRequest -> ReadRequest
+addFilterToNode flt (Node (q@Select {flt_=flts}, i) f) = Node (q {flt_=flt:flts}, i) f
 
 addFilter :: (Path, Filter) -> ReadRequest -> ReadRequest
-addFilter ([], flt) (Node (q@(Select {flt_=flts}), i) forest) = Node (q {flt_=flt:flts}, i) forest
-addFilter (path, flt) (Node rn forest) =
+addFilter = addProperty addFilterToNode
+
+addOrderToNode :: [OrderTerm] -> ReadRequest -> ReadRequest
+addOrderToNode o (Node (q,i) f) = Node (q{order=Just o}, i) f
+
+addOrder :: (Path, [OrderTerm]) -> ReadRequest -> ReadRequest
+addOrder = addProperty addOrderToNode
+
+addRangeToNode :: NonnegRange -> ReadRequest -> ReadRequest
+addRangeToNode r (Node (q,i) f) = Node (q{range_=r}, i) f
+
+addRange :: (Path, NonnegRange) -> ReadRequest -> ReadRequest
+addRange = addProperty addRangeToNode
+
+addProperty :: (a -> ReadRequest -> ReadRequest) -> (Path, a) -> ReadRequest -> ReadRequest
+addProperty f ([], a) n = f a n
+addProperty f (path, a) (Node rn forest) =
   case targetNode of
-    Nothing -> Node rn forest -- the filter is silenty dropped in the Request does not contain the required path
-    Just tn -> Node rn (addFilter (remainingPath, flt) tn:restForest)
+    Nothing -> Node rn forest -- the property is silenty dropped in the Request does not contain the required path
+    Just tn -> Node rn (addProperty f (remainingPath, a) tn:restForest)
   where
     targetNodeName:remainingPath = path
     (targetNode,restForest) = splitForest targetNodeName forest
+    splitForest :: NodeName -> Forest ReadNode -> (Maybe ReadRequest, Forest ReadNode)
     splitForest name forst =
       case maybeNode of
         Nothing -> (Nothing,forest)
         Just node -> (Just node, delete node forest)
-      where maybeNode = find ((name==).fst.snd.rootLabel) forst
+      where
+        maybeNode :: Maybe ReadRequest
+        maybeNode = find fnd forst
+          where
+            fnd :: ReadRequest -> Bool
+            fnd (Node (_,(n,_,_)) _) = n == name
 
 -- in a relation where one of the tables mathces "TableName"
 -- replace the name to that table with pg_source
@@ -335,6 +434,5 @@ instance ToJSON TableOptions where
     , "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 "")
+extractQueryResult :: Maybe ResultsWithCount -> ResultsWithCount
+extractQueryResult = fromMaybe (Nothing, 0, [], "")

src/PostgREST/Auth.hs

@@ -12,73 +12,77 @@ In the test suite there is an example of simple login function that can be used
 very simple authentication system inside the PostgreSQL database.
 -}
 module PostgREST.Auth (
-    setRole
-  , claimsToSQL
+    claimsToSQL
+  , containsRole
   , 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           Lens.Micro
+import           Lens.Micro.Aeson
+import           Data.Aeson              (Value (..), parseJSON, toJSON)
+import           Data.Aeson.Types        (parseMaybe, emptyObject, emptyArray)
+import qualified Data.ByteString         as BS
+import qualified Data.Vector             as V
+import qualified Data.HashMap.Strict     as M
+import           Data.Maybe              (fromMaybe, maybeToList, fromJust)
 import           Data.Monoid             ((<>))
 import           Data.String.Conversions (cs)
 import           Data.Text               (Text)
 import           Data.Time.Clock         (NominalDiffTime)
-import           PostgREST.QueryBuilder  (pgFmtLit, pgFmtIdent, unquoted)
+import           PostgREST.QueryBuilder  (pgFmtIdent, pgFmtLit, unquoted)
 import qualified Web.JWT                 as JWT
-import qualified Data.HashMap.Lazy       as H
 
 {-|
-  Receives a map of JWT claims and returns a list
-  of PostgreSQL statements to set the claims as user defined GUCs.
-  Except if we have a claim called role,
-  this one is mapped to a SET ROLE statement.
-  In case there is any problem decoding the JWT it returns Nothing.
+  Receives a map of JWT claims and returns a list of PostgreSQL
+  statements to set the claims as user defined GUCs.  Except if we
+  have a claim called role, this one is mapped to a SET ROLE
+  statement.
 -}
-claimsToSQL :: JWT.ClaimsMap -> [Text]
-claimsToSQL = map setVar . toList
-  where
-    setVar ("role", String val) = setRole val
-    setVar (k, val) = "set local postgrest.claims." <> pgFmtIdent k <>
-                      " = " <> valueToVariable val <> ";"
-    valueToVariable = pgFmtLit . unquoted
+claimsToSQL :: M.HashMap Text Value -> [BS.ByteString]
+claimsToSQL claims = roleStmts <> varStmts
+ where
+  roleStmts = maybeToList $
+    (\r -> "set local role " <> r <> ";") . cs . valueToVariable <$> M.lookup "role" claims
+  varStmts = map setVar $ M.toList (M.delete "role" claims)
+  setVar (k, val) = "set local " <> cs (pgFmtIdent $ "postgrest.claims." <> k)
+                    <> " = " <> cs (valueToVariable val) <> ";"
+  valueToVariable = pgFmtLit . unquoted
 
 {-|
   Receives the JWT secret (from config) and a JWT and
   returns a map of JWT claims
-  In case there is any problem decoding the JWT it returns Nothing.
+  In case there is any problem decoding the JWT it returns an error Text
 -}
-jwtClaims :: JWT.Secret -> Text -> NominalDiffTime -> Maybe JWT.ClaimsMap
-jwtClaims secret input time =
-  case join $ claim JWT.exp of
-    Just expires ->
-      if JWT.secondsSinceEpoch expires > time
-        then customClaims
-        else Nothing
-    _ -> customClaims
-  where
-    decoded = JWT.decodeAndVerifySignature secret input
-    claim :: (JWT.JWTClaimsSet -> a) -> Maybe a
-    claim prop = prop . JWT.claims <$> decoded
-    customClaims = claim JWT.unregisteredClaims
-
--- | Receives the name of a role and returns a SET ROLE statement
-setRole :: Text -> Text
-setRole role = "set local role " <> cs (pgFmtLit role) <> ";"
-
+jwtClaims :: JWT.Secret -> Text -> NominalDiffTime -> Either Text (M.HashMap Text Value)
+jwtClaims _ "" _ = Right M.empty
+jwtClaims secret jwt time =
+  case isExpired <$> mClaims of
+    Just True -> Left "JWT expired"
+    Nothing -> Left "Invalid JWT"
+    Just False -> Right $ value2map $ fromJust mClaims
+ where
+  isExpired claims =
+    let mExp = claims ^? key "exp" . _Integer
+    in fromMaybe False $ (<= time) . fromInteger <$> mExp
+  mClaims = toJSON . JWT.claims <$> JWT.decodeAndVerifySignature secret jwt
+  value2map (Object o) = o
+  value2map _          = M.empty
 
 {-|
   Receives the JWT secret (from config) and a JWT and a JSON value
   and returns a signed JWT.
 -}
 tokenJWT :: JWT.Secret -> Value -> Text
-tokenJWT secret (Array 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
+tokenJWT secret (Array arr) =
+  let obj = if V.null arr then emptyObject else V.head arr
+      jcs = parseMaybe parseJSON obj :: Maybe JWT.JWTClaimsSet in
+  JWT.encodeSigned JWT.HS256 secret $ fromMaybe JWT.def jcs
+tokenJWT secret _ = tokenJWT secret emptyArray
+
+{-|
+  Whether a response from jwtClaims contains a role claim
+-}
+containsRole :: Either Text (M.HashMap Text Value) -> Bool
+containsRole (Left _) = False
+containsRole (Right claims) = M.member "role" claims

src/PostgREST/Config.hs

@@ -30,32 +30,33 @@ import           Network.Wai
 import           Network.Wai.Middleware.Cors (CorsResourcePolicy (..))
 import           Options.Applicative
 import           Paths_postgrest             (version)
+import           Prelude
 import           Safe                        (readMay)
 import           Web.JWT                     (Secret, secret)
-import           Prelude
 
 -- | Data type to store all command line options
 data AppConfig = AppConfig {
     configDatabase  :: String
-  , configPort      :: Int
   , configAnonRole  :: String
   , configSchema    :: String
+  , configPort      :: Int
   , configJwtSecret :: Secret
   , configPool      :: Int
-  , configMaxRows   :: Maybe Int
+  , configMaxRows   :: Maybe Integer
+  , configQuiet     :: Bool
   }
 
 argParser :: Parser AppConfig
 argParser = AppConfig
-  <$> argument str (help "database connection string" <> metavar "STRING")
-
-  <*> option auto  (long "port"       <> short 'p' <> help "port number on which to run HTTP server" <> metavar "PORT" <> value 3000 <> showDefault)
-  <*> strOption    (long "anonymous"  <> short 'a' <> help "postgres role to use for non-authenticated requests" <> metavar "ROLE")
+  <$> argument str (help "(REQUIRED) database connection string, e.g. postgres://user:pass@host:port/db" <> metavar "DB_URL")
+  <*> strOption    (long "anonymous"  <> short 'a' <> help "(REQUIRED) postgres role to use for non-authenticated requests" <> metavar "ROLE")
   <*> strOption    (long "schema"     <> short 's' <> help "schema to use for API routes" <> metavar "NAME" <> value "public" <> showDefault)
+  <*> option auto  (long "port"       <> short 'p' <> help "port number on which to run HTTP server" <> metavar "PORT" <> value 3000 <> showDefault)
   <*> (secret . cs <$>
       strOption    (long "jwt-secret" <> short 'j' <> help "secret used to encrypt and decrypt JWT tokens" <> metavar "SECRET" <> value "secret" <> showDefault))
   <*> option auto  (long "pool"       <> short 'o' <> help "max connections in database pool" <> metavar "COUNT" <> value 10 <> showDefault)
   <*> (readMay <$> strOption  (long "max-rows"   <> short 'm' <> help "max rows in response" <> metavar "COUNT" <> value "infinity" <> showDefault))
+  <*> pure False
 
 defaultCorsPolicy :: CorsResourcePolicy
 defaultCorsPolicy =  CorsResourcePolicy Nothing

src/PostgREST/DbStructure.hs

@@ -10,28 +10,34 @@ module PostgREST.DbStructure (
 , 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 qualified Hasql.Decoders                as HD
+import qualified Hasql.Encoders                as HE
+import qualified Hasql.Query                   as H
 
-import           GHC.Exts               (groupWith)
+import           Control.Applicative
+import           Control.Monad                 (join, replicateM)
+import           Data.Functor.Contravariant    (contramap)
+import           Data.List                     (elemIndex, find, sort,
+                                                subsequences, transpose)
+import           Data.Maybe                    (fromJust, fromMaybe, isJust,
+                                                listToMaybe, mapMaybe)
+import           Data.Monoid
+import           Data.Text                     (Text, split)
+import qualified Hasql.Session                 as H
+import           PostgREST.Types
+import           Text.InterpolatedString.Perl6 (q)
+
+import           Data.Int                      (Int32)
+import           GHC.Exts                      (groupWith)
 import           Prelude
 
-getDbStructure :: Schema -> H.Tx P.Postgres s DbStructure
+getDbStructure :: Schema -> H.Session DbStructure
 getDbStructure schema = do
-  tabs <- allTables
-  cols <- allColumns tabs
-  syns <- allSynonyms cols
-  rels <- allRelations tabs cols
-  keys <- allPrimaryKeys tabs
+  tabs <- H.query () allTables
+  cols <- H.query () $ allColumns tabs
+  syns <- H.query () $ allSynonyms cols
+  rels <- H.query () $ allRelations tabs cols
+  keys <- H.query () $ allPrimaryKeys tabs
 
   let rels' = (addManyToManyRelations . raiseRelations schema syns . addParentRelations . addSynonymousRelations syns) rels
       cols' = addForeignKeys rels' cols
@@ -44,52 +50,113 @@ getDbStructure schema = do
     , 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
+encodeQi :: HE.Params QualifiedIdentifier
+encodeQi =
+  contramap qiSchema (HE.value HE.text) <>
+  contramap qiName   (HE.value HE.text)
 
-doesProcExist :: QualifiedIdentifier -> H.Tx P.Postgres s Bool
-doesProcExist = doesProc [H.stmt|
+decodeTables :: HD.Result [Table]
+decodeTables =
+  HD.rowsList tblRow
+ where
+  tblRow = Table <$> HD.value HD.text <*> HD.value HD.text
+                 <*> HD.value HD.bool
+
+decodeColumns :: [Table] -> HD.Result [Column]
+decodeColumns tables =
+  mapMaybe (columnFromRow tables) <$> HD.rowsList colRow
+ where
+  colRow =
+    (,,,,,,,,,,)
+      <$> HD.value HD.text <*> HD.value HD.text
+      <*> HD.value HD.text <*> HD.value HD.int4
+      <*> HD.value HD.bool <*> HD.value HD.text
+      <*> HD.value HD.bool
+      <*> HD.nullableValue HD.int4
+      <*> HD.nullableValue HD.int4
+      <*> HD.nullableValue HD.text
+      <*> HD.nullableValue HD.text
+
+decodeRelations :: [Table] -> [Column] -> HD.Result [Relation]
+decodeRelations tables cols =
+  mapMaybe (relationFromRow tables cols) <$> HD.rowsList relRow
+ where
+  relRow = (,,,,,)
+    <$> HD.value HD.text
+    <*> HD.value HD.text
+    <*> HD.value (HD.array (HD.arrayDimension replicateM (HD.arrayValue HD.text)))
+    <*> HD.value HD.text
+    <*> HD.value HD.text
+    <*> HD.value (HD.array (HD.arrayDimension replicateM (HD.arrayValue HD.text)))
+
+decodePks :: [Table] -> HD.Result [PrimaryKey]
+decodePks tables =
+  mapMaybe (pkFromRow tables) <$> HD.rowsList pkRow
+ where
+  pkRow = (,,) <$> HD.value HD.text <*> HD.value HD.text <*> HD.value HD.text
+
+decodeSynonyms :: [Column] -> HD.Result [(Column,Column)]
+decodeSynonyms cols =
+  mapMaybe (synonymFromRow cols) <$> HD.rowsList synRow
+ where
+  synRow = (,,,,,)
+    <$> HD.value HD.text <*> HD.value HD.text
+    <*> HD.value HD.text <*> HD.value HD.text
+    <*> HD.value HD.text <*> HD.value HD.text
+
+doesProcExist :: H.Query QualifiedIdentifier Bool
+doesProcExist =
+  H.statement sql encodeQi (HD.singleRow (HD.value HD.bool)) True
+ where
+  sql = [q| SELECT EXISTS (
       SELECT 1
       FROM   pg_catalog.pg_namespace n
       JOIN   pg_catalog.pg_proc p
       ON     pronamespace = n.oid
-      WHERE  nspname = ?
-      AND    proname = ?
-    |]
+      WHERE  nspname = $1
+      AND    proname = $2
+    ) |]
 
-doesProcReturnJWT :: QualifiedIdentifier -> H.Tx P.Postgres s Bool
-doesProcReturnJWT = doesProc [H.stmt|
+doesProcReturnJWT :: H.Query QualifiedIdentifier Bool
+doesProcReturnJWT =
+  H.statement sql encodeQi (HD.singleRow (HD.value HD.bool)) True
+ where
+  sql = [q| SELECT EXISTS (
       SELECT 1
       FROM   pg_catalog.pg_namespace n
       JOIN   pg_catalog.pg_proc p
       ON     pronamespace = n.oid
-      WHERE  nspname = ?
-      AND    proname = ?
+      WHERE  nspname = $1
+      AND    proname = $2
       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
+accessibleTables :: H.Query Schema [Table]
+accessibleTables =
+  H.statement sql (HE.value HE.text) decodeTables True
+ where
+  sql = [q|
+    select
+      n.nspname as table_schema,
+      relname as table_name,
+      c.relkind = 'r' or (c.relkind IN ('v', 'f')) and (pg_relation_is_updatable(c.oid::regclass, false) & 8) = 8
+      or (exists (
+         select 1
+         from pg_trigger
+         where pg_trigger.tgrelid = c.oid and (pg_trigger.tgtype::integer & 69) = 69)
+      ) as insertable
+    from
+      pg_class c
+      join pg_namespace n on n.oid = c.relnamespace
+    where
+      c.relkind in ('v', 'r', 'm')
+      and n.nspname = $1
+      and (
+        pg_has_role(c.relowner, 'USAGE'::text)
+        or has_table_privilege(c.oid, 'SELECT, INSERT, UPDATE, DELETE, TRUNCATE, REFERENCES, TRIGGER'::text)
+        or has_any_column_privilege(c.oid, 'SELECT, INSERT, UPDATE, REFERENCES'::text)
+      )
+    order by relname |]
 
 synonymousColumns :: [(Column,Column)] -> [Column] -> [[Column]]
 synonymousColumns allSyns cols = synCols'
@@ -107,9 +174,9 @@ addForeignKeys rels = map addFk
     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 c Relation{relColumns=cs, relType=rty} = c `elem` cs && rty==Child
     -- lookupFn _ _ = False
-    relToFk col (Relation{relColumns=cols, relFColumns=colsF}) = ForeignKey <$> colF
+    relToFk col Relation{relColumns=cols, relFColumns=colsF} = ForeignKey <$> colF
       where
         pos = elemIndex col cols
         colF = (colsF !!) <$> pos
@@ -127,12 +194,14 @@ 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
+addManyToManyRelations rels = rels ++ addMirrorRelation (mapMaybe link2Relation links)
   where
     links = join $ map (combinations 2) $ filter (not . null) $ groupWith groupFn $ filter ( (==Child). relType) rels
     groupFn :: Relation -> Text
-    groupFn (Relation{relTable=Table{tableSchema=s, tableName=t}}) = s<>"_"<>t
+    groupFn Relation{relTable=Table{tableSchema=s, tableName=t}} = s<>"_"<>t
     combinations k ns = filter ((k==).length) (subsequences ns)
+    addMirrorRelation [] = []
+    addMirrorRelation (rel@(Relation t c ft fc _ lt lc1 lc2):rels') = Relation ft fc t c Many lt lc2 lc1 : rel : addMirrorRelation rels'
     link2Relation [
       Relation{relTable=lt, relColumns=lc1, relFTable=t,  relFColumns=c},
       Relation{             relColumns=lc2, relFTable=ft, relFColumns=fc}
@@ -161,173 +230,170 @@ synonymousPrimaryKeys syns (key:keys) = key : newKeys ++ synonymousPrimaryKeys s
     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
+allTables :: H.Query () [Table]
+allTables =
+  H.statement sql HE.unit decodeTables True
+ where
+  sql = [q|
+    SELECT
+      n.nspname AS table_schema,
+      c.relname AS table_name,
+      c.relkind = 'r' OR (c.relkind IN ('v','f'))
+      AND (pg_relation_is_updatable(c.oid::regclass, FALSE) & 8) = 8
+      OR (EXISTS
+        ( SELECT 1
+          FROM pg_trigger
+          WHERE pg_trigger.tgrelid = c.oid
+          AND (pg_trigger.tgtype::integer & 69) = 69) ) AS insertable
+    FROM pg_class c
+    JOIN pg_namespace n ON n.oid = c.relnamespace
+    WHERE c.relkind IN ('v','r','m')
+      AND n.nspname NOT IN ('pg_catalog', 'information_schema')
+    GROUP BY table_schema, table_name, insertable
+    ORDER BY table_schema, table_name |]
 
-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 (
-          /*
-          -- CTE based on information_schema.columns to remove the owner filter
-          */
-          WITH columns AS (
-              SELECT current_database()::information_schema.sql_identifier AS table_catalog,
-                  nc.nspname::information_schema.sql_identifier AS table_schema,
-                  c.relname::information_schema.sql_identifier AS table_name,
-                  a.attname::information_schema.sql_identifier AS column_name,
-                  a.attnum::information_schema.cardinal_number AS ordinal_position,
-                  pg_get_expr(ad.adbin, ad.adrelid)::information_schema.character_data AS column_default,
-                      CASE
-                          WHEN a.attnotnull OR t.typtype = 'd'::"char" AND t.typnotnull THEN 'NO'::text
-                          ELSE 'YES'::text
-                      END::information_schema.yes_or_no AS is_nullable,
-                      CASE
-                          WHEN t.typtype = 'd'::"char" THEN
-                          CASE
-                              WHEN bt.typelem <> 0::oid AND bt.typlen = (-1) THEN 'ARRAY'::text
-                              WHEN nbt.nspname = 'pg_catalog'::name THEN format_type(t.typbasetype, NULL::integer)
-                              ELSE 'USER-DEFINED'::text
-                          END
-                          ELSE
-                          CASE
-                              WHEN t.typelem <> 0::oid AND t.typlen = (-1) THEN 'ARRAY'::text
-                              WHEN nt.nspname = 'pg_catalog'::name THEN format_type(a.atttypid, NULL::integer)
-                              ELSE 'USER-DEFINED'::text
-                          END
-                      END::information_schema.character_data AS data_type,
-                  information_schema._pg_char_max_length(information_schema._pg_truetypid(a.*, t.*), information_schema._pg_truetypmod(a.*, t.*))::information_schema.cardinal_number AS character_maximum_length,
-                  information_schema._pg_char_octet_length(information_schema._pg_truetypid(a.*, t.*), information_schema._pg_truetypmod(a.*, t.*))::information_schema.cardinal_number AS character_octet_length,
-                  information_schema._pg_numeric_precision(information_schema._pg_truetypid(a.*, t.*), information_schema._pg_truetypmod(a.*, t.*))::information_schema.cardinal_number AS numeric_precision,
-                  information_schema._pg_numeric_precision_radix(information_schema._pg_truetypid(a.*, t.*), information_schema._pg_truetypmod(a.*, t.*))::information_schema.cardinal_number AS numeric_precision_radix,
-                  information_schema._pg_numeric_scale(information_schema._pg_truetypid(a.*, t.*), information_schema._pg_truetypmod(a.*, t.*))::information_schema.cardinal_number AS numeric_scale,
-                  information_schema._pg_datetime_precision(information_schema._pg_truetypid(a.*, t.*), information_schema._pg_truetypmod(a.*, t.*))::information_schema.cardinal_number AS datetime_precision,
-                  information_schema._pg_interval_type(information_schema._pg_truetypid(a.*, t.*), information_schema._pg_truetypmod(a.*, t.*))::information_schema.character_data AS interval_type,
-                  NULL::integer::information_schema.cardinal_number AS interval_precision,
-                  NULL::character varying::information_schema.sql_identifier AS character_set_catalog,
-                  NULL::character varying::information_schema.sql_identifier AS character_set_schema,
-                  NULL::character varying::information_schema.sql_identifier AS character_set_name,
-                      CASE
-                          WHEN nco.nspname IS NOT NULL THEN current_database()
-                          ELSE NULL::name
-                      END::information_schema.sql_identifier AS collation_catalog,
-                  nco.nspname::information_schema.sql_identifier AS collation_schema,
-                  co.collname::information_schema.sql_identifier AS collation_name,
-                      CASE
-                          WHEN t.typtype = 'd'::"char" THEN current_database()
-                          ELSE NULL::name
-                      END::information_schema.sql_identifier AS domain_catalog,
-                      CASE
-                          WHEN t.typtype = 'd'::"char" THEN nt.nspname
-                          ELSE NULL::name
-                      END::information_schema.sql_identifier AS domain_schema,
-                      CASE
-                          WHEN t.typtype = 'd'::"char" THEN t.typname
-                          ELSE NULL::name
-                      END::information_schema.sql_identifier AS domain_name,
-                  current_database()::information_schema.sql_identifier AS udt_catalog,
-                  COALESCE(nbt.nspname, nt.nspname)::information_schema.sql_identifier AS udt_schema,
-                  COALESCE(bt.typname, t.typname)::information_schema.sql_identifier AS udt_name,
-                  NULL::character varying::information_schema.sql_identifier AS scope_catalog,
-                  NULL::character varying::information_schema.sql_identifier AS scope_schema,
-                  NULL::character varying::information_schema.sql_identifier AS scope_name,
-                  NULL::integer::information_schema.cardinal_number AS maximum_cardinality,
-                  a.attnum::information_schema.sql_identifier AS dtd_identifier,
-                  'NO'::character varying::information_schema.yes_or_no AS is_self_referencing,
-                  'NO'::character varying::information_schema.yes_or_no AS is_identity,
-                  NULL::character varying::information_schema.character_data AS identity_generation,
-                  NULL::character varying::information_schema.character_data AS identity_start,
-                  NULL::character varying::information_schema.character_data AS identity_increment,
-                  NULL::character varying::information_schema.character_data AS identity_maximum,
-                  NULL::character varying::information_schema.character_data AS identity_minimum,
-                  NULL::character varying::information_schema.yes_or_no AS identity_cycle,
-                  'NEVER'::character varying::information_schema.character_data AS is_generated,
-                  NULL::character varying::information_schema.character_data AS generation_expression,
-                  CASE
-                      WHEN c.relkind = 'r'::"char" OR (c.relkind = ANY (ARRAY['v'::"char", 'f'::"char"])) AND pg_column_is_updatable(c.oid::regclass, a.attnum, false) THEN 'YES'::text
-                      ELSE 'NO'::text
-                  END::information_schema.yes_or_no AS is_updatable
-              FROM pg_attribute a
-                 LEFT JOIN pg_attrdef ad ON a.attrelid = ad.adrelid AND a.attnum = ad.adnum
-                 JOIN (pg_class c
-                 JOIN pg_namespace nc ON c.relnamespace = nc.oid) ON a.attrelid = c.oid
-                 JOIN (pg_type t
-                 JOIN pg_namespace nt ON t.typnamespace = nt.oid) ON a.atttypid = t.oid
-                 LEFT JOIN (pg_type bt
-                 JOIN pg_namespace nbt ON bt.typnamespace = nbt.oid) ON t.typtype = 'd'::"char" AND t.typbasetype = bt.oid
-                 LEFT JOIN (pg_collation co
-                 JOIN pg_namespace nco ON co.collnamespace = nco.oid) ON a.attcollation = co.oid AND (nco.nspname <> 'pg_catalog'::name OR co.collname <> 'default'::name)
-              WHERE NOT pg_is_other_temp_schema(nc.oid) AND a.attnum > 0 AND NOT a.attisdropped AND (c.relkind = ANY (ARRAY['r'::"char", 'v'::"char", 'f'::"char"]))
-                /*--AND (pg_has_role(c.relowner, 'USAGE'::text) OR has_column_privilege(c.oid, a.attnum, 'SELECT, INSERT, UPDATE, REFERENCES'::text))*/
-          )
-          SELECT
-              table_schema,
-              table_name,
-              column_name,
-              ordinal_position,
-              is_nullable,
-              data_type,
-              is_updatable,
-              character_maximum_length,
-              numeric_precision,
-              column_default,
-              udt_name
-          /*-- FROM information_schema.columns*/
-          FROM columns
-          WHERE table_schema NOT IN ('pg_catalog', 'information_schema')
-      ) AS info
-      LEFT OUTER JOIN (
-          SELECT
-              n.nspname AS s,
-              t.typname AS n,
-              array_agg(e.enumlabel ORDER BY e.enumsortorder) AS vals
-          FROM pg_type t
-          JOIN pg_enum e ON t.oid = e.enumtypid
-          JOIN pg_catalog.pg_namespace n ON n.oid = t.typnamespace
-          GROUP BY s,n
-      ) AS enum_info ON (info.udt_name = enum_info.n)
-      ORDER BY schema, position
-  |]
-  return $ mapMaybe (columnFromRow tabs) cols
+allColumns :: [Table] -> H.Query () [Column]
+allColumns tabs =
+  H.statement sql HE.unit (decodeColumns tabs) True
+ where
+  sql = [q|
+    SELECT DISTINCT
+        info.table_schema AS schema,
+        info.table_name AS table_name,
+        info.column_name AS name,
+        info.ordinal_position AS position,
+        info.is_nullable::boolean AS nullable,
+        info.data_type AS col_type,
+        info.is_updatable::boolean AS updatable,
+        info.character_maximum_length AS max_len,
+        info.numeric_precision AS precision,
+        info.column_default AS default_value,
+        array_to_string(enum_info.vals, ',') AS enum
+    FROM (
+        /*
+        -- CTE based on information_schema.columns to remove the owner filter
+        */
+        WITH columns AS (
+            SELECT current_database()::information_schema.sql_identifier AS table_catalog,
+                nc.nspname::information_schema.sql_identifier AS table_schema,
+                c.relname::information_schema.sql_identifier AS table_name,
+                a.attname::information_schema.sql_identifier AS column_name,
+                a.attnum::information_schema.cardinal_number AS ordinal_position,
+                pg_get_expr(ad.adbin, ad.adrelid)::information_schema.character_data AS column_default,
+                    CASE
+                        WHEN a.attnotnull OR t.typtype = 'd'::"char" AND t.typnotnull THEN 'NO'::text
+                        ELSE 'YES'::text
+                    END::information_schema.yes_or_no AS is_nullable,
+                    CASE
+                        WHEN t.typtype = 'd'::"char" THEN
+                        CASE
+                            WHEN bt.typelem <> 0::oid AND bt.typlen = (-1) THEN 'ARRAY'::text
+                            WHEN nbt.nspname = 'pg_catalog'::name THEN format_type(t.typbasetype, NULL::integer)
+                            ELSE 'USER-DEFINED'::text
+                        END
+                        ELSE
+                        CASE
+                            WHEN t.typelem <> 0::oid AND t.typlen = (-1) THEN 'ARRAY'::text
+                            WHEN nt.nspname = 'pg_catalog'::name THEN format_type(a.atttypid, NULL::integer)
+                            ELSE 'USER-DEFINED'::text
+                        END
+                    END::information_schema.character_data AS data_type,
+                information_schema._pg_char_max_length(information_schema._pg_truetypid(a.*, t.*), information_schema._pg_truetypmod(a.*, t.*))::information_schema.cardinal_number AS character_maximum_length,
+                information_schema._pg_char_octet_length(information_schema._pg_truetypid(a.*, t.*), information_schema._pg_truetypmod(a.*, t.*))::information_schema.cardinal_number AS character_octet_length,
+                information_schema._pg_numeric_precision(information_schema._pg_truetypid(a.*, t.*), information_schema._pg_truetypmod(a.*, t.*))::information_schema.cardinal_number AS numeric_precision,
+                information_schema._pg_numeric_precision_radix(information_schema._pg_truetypid(a.*, t.*), information_schema._pg_truetypmod(a.*, t.*))::information_schema.cardinal_number AS numeric_precision_radix,
+                information_schema._pg_numeric_scale(information_schema._pg_truetypid(a.*, t.*), information_schema._pg_truetypmod(a.*, t.*))::information_schema.cardinal_number AS numeric_scale,
+                information_schema._pg_datetime_precision(information_schema._pg_truetypid(a.*, t.*), information_schema._pg_truetypmod(a.*, t.*))::information_schema.cardinal_number AS datetime_precision,
+                information_schema._pg_interval_type(information_schema._pg_truetypid(a.*, t.*), information_schema._pg_truetypmod(a.*, t.*))::information_schema.character_data AS interval_type,
+                NULL::integer::information_schema.cardinal_number AS interval_precision,
+                NULL::character varying::information_schema.sql_identifier AS character_set_catalog,
+                NULL::character varying::information_schema.sql_identifier AS character_set_schema,
+                NULL::character varying::information_schema.sql_identifier AS character_set_name,
+                    CASE
+                        WHEN nco.nspname IS NOT NULL THEN current_database()
+                        ELSE NULL::name
+                    END::information_schema.sql_identifier AS collation_catalog,
+                nco.nspname::information_schema.sql_identifier AS collation_schema,
+                co.collname::information_schema.sql_identifier AS collation_name,
+                    CASE
+                        WHEN t.typtype = 'd'::"char" THEN current_database()
+                        ELSE NULL::name
+                    END::information_schema.sql_identifier AS domain_catalog,
+                    CASE
+                        WHEN t.typtype = 'd'::"char" THEN nt.nspname
+                        ELSE NULL::name
+                    END::information_schema.sql_identifier AS domain_schema,
+                    CASE
+                        WHEN t.typtype = 'd'::"char" THEN t.typname
+                        ELSE NULL::name
+                    END::information_schema.sql_identifier AS domain_name,
+                current_database()::information_schema.sql_identifier AS udt_catalog,
+                COALESCE(nbt.nspname, nt.nspname)::information_schema.sql_identifier AS udt_schema,
+                COALESCE(bt.typname, t.typname)::information_schema.sql_identifier AS udt_name,
+                NULL::character varying::information_schema.sql_identifier AS scope_catalog,
+                NULL::character varying::information_schema.sql_identifier AS scope_schema,
+                NULL::character varying::information_schema.sql_identifier AS scope_name,
+                NULL::integer::information_schema.cardinal_number AS maximum_cardinality,
+                a.attnum::information_schema.sql_identifier AS dtd_identifier,
+                'NO'::character varying::information_schema.yes_or_no AS is_self_referencing,
+                'NO'::character varying::information_schema.yes_or_no AS is_identity,
+                NULL::character varying::information_schema.character_data AS identity_generation,
+                NULL::character varying::information_schema.character_data AS identity_start,
+                NULL::character varying::information_schema.character_data AS identity_increment,
+                NULL::character varying::information_schema.character_data AS identity_maximum,
+                NULL::character varying::information_schema.character_data AS identity_minimum,
+                NULL::character varying::information_schema.yes_or_no AS identity_cycle,
+                'NEVER'::character varying::information_schema.character_data AS is_generated,
+                NULL::character varying::information_schema.character_data AS generation_expression,
+                CASE
+                    WHEN c.relkind = 'r'::"char" OR (c.relkind = ANY (ARRAY['v'::"char", 'f'::"char"])) AND pg_column_is_updatable(c.oid::regclass, a.attnum, false) THEN 'YES'::text
+                    ELSE 'NO'::text
+                END::information_schema.yes_or_no AS is_updatable
+            FROM pg_attribute a
+               LEFT JOIN pg_attrdef ad ON a.attrelid = ad.adrelid AND a.attnum = ad.adnum
+               JOIN (pg_class c
+               JOIN pg_namespace nc ON c.relnamespace = nc.oid) ON a.attrelid = c.oid
+               JOIN (pg_type t
+               JOIN pg_namespace nt ON t.typnamespace = nt.oid) ON a.atttypid = t.oid
+               LEFT JOIN (pg_type bt
+               JOIN pg_namespace nbt ON bt.typnamespace = nbt.oid) ON t.typtype = 'd'::"char" AND t.typbasetype = bt.oid
+               LEFT JOIN (pg_collation co
+               JOIN pg_namespace nco ON co.collnamespace = nco.oid) ON a.attcollation = co.oid AND (nco.nspname <> 'pg_catalog'::name OR co.collname <> 'default'::name)
+            WHERE NOT pg_is_other_temp_schema(nc.oid) AND a.attnum > 0 AND NOT a.attisdropped AND (c.relkind = ANY (ARRAY['r'::"char", 'v'::"char", 'f'::"char"]))
+              /*--AND (pg_has_role(c.relowner, 'USAGE'::text) OR has_column_privilege(c.oid, a.attnum, 'SELECT, INSERT, UPDATE, REFERENCES'::text))*/
+        )
+        SELECT
+            table_schema,
+            table_name,
+            column_name,
+            ordinal_position,
+            is_nullable,
+            data_type,
+            is_updatable,
+            character_maximum_length,
+            numeric_precision,
+            column_default,
+            udt_name
+        /*-- FROM information_schema.columns*/
+        FROM columns
+        WHERE table_schema NOT IN ('pg_catalog', 'information_schema')
+    ) AS info
+    LEFT OUTER JOIN (
+        SELECT
+            n.nspname AS s,
+            t.typname AS n,
+            array_agg(e.enumlabel ORDER BY e.enumsortorder) AS vals
+        FROM pg_type t
+        JOIN pg_enum e ON t.oid = e.enumtypid
+        JOIN pg_catalog.pg_namespace n ON n.oid = t.typnamespace
+        GROUP BY s,n
+    ) AS enum_info ON (info.udt_name = enum_info.n)
+    ORDER BY schema, position |]
 
 columnFromRow :: [Table] ->
-                 (Text,       Text,      Text,
-                  Int,        Bool,      Text,
-                  Bool,       Maybe Int, Maybe Int,
+                 (Text,       Text,        Text,
+                  Int32,      Bool,        Text,
+                  Bool,       Maybe Int32, Maybe Int32,
                   Maybe Text, Maybe Text)
                  -> Maybe Column
 columnFromRow tabs (s, t, n, pos, nul, typ, u, l, p, d, e) = buildColumn <$> table
@@ -337,9 +403,11 @@ columnFromRow tabs (s, t, n, pos, nul, typ, u, l, p, d, e) = buildColumn <$> tab
     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|
+allRelations :: [Table] -> [Column] -> H.Query () [Relation]
+allRelations tabs cols =
+  H.statement sql HE.unit (decodeRelations tabs cols) True
+ where
+  sql = [q|
     SELECT ns1.nspname AS table_schema,
            tab.relname AS table_name,
            column_info.cols AS columns,
@@ -363,9 +431,7 @@ allRelations tabs cols = do
        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
+    ORDER BY (conrelid, column_info.nums) |]
 
 relationFromRow :: [Table] -> [Column] -> (Text, Text, [Text], Text, Text, [Text]) -> Maybe Relation
 relationFromRow allTabs allCols (rs, rt, rcs, frs, frt, frcs) =
@@ -378,183 +444,190 @@ relationFromRow allTabs allCols (rs, rt, rcs, frs, frt, frcs) =
     cols  = mapM (findCol rs rt) rcs
     colsF = mapM (findCol frs frt) frcs
 
-allPrimaryKeys :: [Table] -> H.Tx P.Postgres s [PrimaryKey]
-allPrimaryKeys tabs = do
-  pks <- H.listEx $ [H.stmt|
-      /*
-      -- CTE to replace information_schema.table_constraints to remove owner limit
-      */
-      WITH tc AS (
-          SELECT current_database()::information_schema.sql_identifier AS constraint_catalog,
-              nc.nspname::information_schema.sql_identifier AS constraint_schema,
-              c.conname::information_schema.sql_identifier AS constraint_name,
-              current_database()::information_schema.sql_identifier AS table_catalog,
-              nr.nspname::information_schema.sql_identifier AS table_schema,
-              r.relname::information_schema.sql_identifier AS table_name,
-                  CASE c.contype
-                      WHEN 'c'::"char" THEN 'CHECK'::text
-                      WHEN 'f'::"char" THEN 'FOREIGN KEY'::text
-                      WHEN 'p'::"char" THEN 'PRIMARY KEY'::text
-                      WHEN 'u'::"char" THEN 'UNIQUE'::text
-                      ELSE NULL::text
-                  END::information_schema.character_data AS constraint_type,
-                  CASE
-                      WHEN c.condeferrable THEN 'YES'::text
-                      ELSE 'NO'::text
-                  END::information_schema.yes_or_no AS is_deferrable,
-                  CASE
-                      WHEN c.condeferred THEN 'YES'::text
-                      ELSE 'NO'::text
-                  END::information_schema.yes_or_no AS initially_deferred
-          FROM pg_namespace nc,
-              pg_namespace nr,
-              pg_constraint c,
-              pg_class r
-          WHERE nc.oid = c.connamespace AND nr.oid = r.relnamespace AND c.conrelid = r.oid AND (c.contype <> ALL (ARRAY['t'::"char", 'x'::"char"])) AND r.relkind = 'r'::"char" AND NOT pg_is_other_temp_schema(nr.oid)
-          /*--AND (pg_has_role(r.relowner, 'USAGE'::text) OR has_table_privilege(r.oid, 'INSERT, UPDATE, DELETE, TRUNCATE, REFERENCES, TRIGGER'::text) OR has_any_column_privilege(r.oid, 'INSERT, UPDATE, REFERENCES'::text))*/
-          UNION ALL
-          SELECT current_database()::information_schema.sql_identifier AS constraint_catalog,
-              nr.nspname::information_schema.sql_identifier AS constraint_schema,
-              (((((nr.oid::text || '_'::text) || r.oid::text) || '_'::text) || a.attnum::text) || '_not_null'::text)::information_schema.sql_identifier AS constraint_name,
-              current_database()::information_schema.sql_identifier AS table_catalog,
-              nr.nspname::information_schema.sql_identifier AS table_schema,
-              r.relname::information_schema.sql_identifier AS table_name,
-              'CHECK'::character varying::information_schema.character_data AS constraint_type,
-              'NO'::character varying::information_schema.yes_or_no AS is_deferrable,
-              'NO'::character varying::information_schema.yes_or_no AS initially_deferred
-          FROM pg_namespace nr,
-              pg_class r,
-              pg_attribute a
-          WHERE nr.oid = r.relnamespace AND r.oid = a.attrelid AND a.attnotnull AND a.attnum > 0 AND NOT a.attisdropped AND r.relkind = 'r'::"char" AND NOT pg_is_other_temp_schema(nr.oid)
-          /*--AND (pg_has_role(r.relowner, 'USAGE'::text) OR has_table_privilege(r.oid, 'INSERT, UPDATE, DELETE, TRUNCATE, REFERENCES, TRIGGER'::text) OR has_any_column_privilege(r.oid, 'INSERT, UPDATE, REFERENCES'::text))*/
-      ),
-      /*
-      -- CTE to replace information_schema.key_column_usage to remove owner limit
-      */
-      kc AS (
-          SELECT current_database()::information_schema.sql_identifier AS constraint_catalog,
-              ss.nc_nspname::information_schema.sql_identifier AS constraint_schema,
-              ss.conname::information_schema.sql_identifier AS constraint_name,
-              current_database()::information_schema.sql_identifier AS table_catalog,
-              ss.nr_nspname::information_schema.sql_identifier AS table_schema,
-              ss.relname::information_schema.sql_identifier AS table_name,
-              a.attname::information_schema.sql_identifier AS column_name,
-              (ss.x).n::information_schema.cardinal_number AS ordinal_position,
-                  CASE
-                      WHEN ss.contype = 'f'::"char" THEN information_schema._pg_index_position(ss.conindid, ss.confkey[(ss.x).n])
-                      ELSE NULL::integer
-                  END::information_schema.cardinal_number AS position_in_unique_constraint
-          FROM pg_attribute a,
-              ( SELECT r.oid AS roid,
-                  r.relname,
-                  r.relowner,
-                  nc.nspname AS nc_nspname,
-                  nr.nspname AS nr_nspname,
-                  c.oid AS coid,
-                  c.conname,
-                  c.contype,
-                  c.conindid,
-                  c.confkey,
-                  c.confrelid,
-                  information_schema._pg_expandarray(c.conkey) AS x
-                 FROM pg_namespace nr,
-                  pg_class r,
-                  pg_namespace nc,
-                  pg_constraint c
-                WHERE nr.oid = r.relnamespace AND r.oid = c.conrelid AND nc.oid = c.connamespace AND (c.contype = ANY (ARRAY['p'::"char", 'u'::"char", 'f'::"char"])) AND r.relkind = 'r'::"char" AND NOT pg_is_other_temp_schema(nr.oid)) ss
-          WHERE ss.roid = a.attrelid AND a.attnum = (ss.x).x AND NOT a.attisdropped
-          /*--AND (pg_has_role(ss.relowner, 'USAGE'::text) OR has_column_privilege(ss.roid, a.attnum, 'SELECT, INSERT, UPDATE, REFERENCES'::text))*/
-      )
-      SELECT
-          kc.table_schema,
-          kc.table_name,
-          kc.column_name
-      FROM
-          /*
-          --information_schema.table_constraints tc,
-          --information_schema.key_column_usage kc
-          */
-          tc, kc
-      WHERE
-          tc.constraint_type = 'PRIMARY KEY' AND
-          kc.table_name = tc.table_name AND
-          kc.table_schema = tc.table_schema AND
-          kc.constraint_name = tc.constraint_name AND
-          kc.table_schema NOT IN ('pg_catalog', 'information_schema')
-    |]
-  return $ mapMaybe (pkFromRow tabs) pks
+allPrimaryKeys :: [Table] -> H.Query () [PrimaryKey]
+allPrimaryKeys tabs =
+  H.statement sql HE.unit (decodePks tabs) True
+ where
+  sql = [q|
+    /*
+    -- CTE to replace information_schema.table_constraints to remove owner limit
+    */
+    WITH tc AS (
+        SELECT current_database()::information_schema.sql_identifier AS constraint_catalog,
+            nc.nspname::information_schema.sql_identifier AS constraint_schema,
+            c.conname::information_schema.sql_identifier AS constraint_name,
+            current_database()::information_schema.sql_identifier AS table_catalog,
+            nr.nspname::information_schema.sql_identifier AS table_schema,
+            r.relname::information_schema.sql_identifier AS table_name,
+                CASE c.contype
+                    WHEN 'c'::"char" THEN 'CHECK'::text
+                    WHEN 'f'::"char" THEN 'FOREIGN KEY'::text
+                    WHEN 'p'::"char" THEN 'PRIMARY KEY'::text
+                    WHEN 'u'::"char" THEN 'UNIQUE'::text
+                    ELSE NULL::text
+                END::information_schema.character_data AS constraint_type,
+                CASE
+                    WHEN c.condeferrable THEN 'YES'::text
+                    ELSE 'NO'::text
+                END::information_schema.yes_or_no AS is_deferrable,
+                CASE
+                    WHEN c.condeferred THEN 'YES'::text
+                    ELSE 'NO'::text
+                END::information_schema.yes_or_no AS initially_deferred
+        FROM pg_namespace nc,
+            pg_namespace nr,
+            pg_constraint c,
+            pg_class r
+        WHERE nc.oid = c.connamespace AND nr.oid = r.relnamespace AND c.conrelid = r.oid AND (c.contype <> ALL (ARRAY['t'::"char", 'x'::"char"])) AND r.relkind = 'r'::"char" AND NOT pg_is_other_temp_schema(nr.oid)
+        /*--AND (pg_has_role(r.relowner, 'USAGE'::text) OR has_table_privilege(r.oid, 'INSERT, UPDATE, DELETE, TRUNCATE, REFERENCES, TRIGGER'::text) OR has_any_column_privilege(r.oid, 'INSERT, UPDATE, REFERENCES'::text))*/
+        UNION ALL
+        SELECT current_database()::information_schema.sql_identifier AS constraint_catalog,
+            nr.nspname::information_schema.sql_identifier AS constraint_schema,
+            (((((nr.oid::text || '_'::text) || r.oid::text) || '_'::text) || a.attnum::text) || '_not_null'::text)::information_schema.sql_identifier AS constraint_name,
+            current_database()::information_schema.sql_identifier AS table_catalog,
+            nr.nspname::information_schema.sql_identifier AS table_schema,
+            r.relname::information_schema.sql_identifier AS table_name,
+            'CHECK'::character varying::information_schema.character_data AS constraint_type,
+            'NO'::character varying::information_schema.yes_or_no AS is_deferrable,
+            'NO'::character varying::information_schema.yes_or_no AS initially_deferred
+        FROM pg_namespace nr,
+            pg_class r,
+            pg_attribute a
+        WHERE nr.oid = r.relnamespace AND r.oid = a.attrelid AND a.attnotnull AND a.attnum > 0 AND NOT a.attisdropped AND r.relkind = 'r'::"char" AND NOT pg_is_other_temp_schema(nr.oid)
+        /*--AND (pg_has_role(r.relowner, 'USAGE'::text) OR has_table_privilege(r.oid, 'INSERT, UPDATE, DELETE, TRUNCATE, REFERENCES, TRIGGER'::text) OR has_any_column_privilege(r.oid, 'INSERT, UPDATE, REFERENCES'::text))*/
+    ),
+    /*
+    -- CTE to replace information_schema.key_column_usage to remove owner limit
+    */
+    kc AS (
+        SELECT current_database()::information_schema.sql_identifier AS constraint_catalog,
+            ss.nc_nspname::information_schema.sql_identifier AS constraint_schema,
+            ss.conname::information_schema.sql_identifier AS constraint_name,
+            current_database()::information_schema.sql_identifier AS table_catalog,
+            ss.nr_nspname::information_schema.sql_identifier AS table_schema,
+            ss.relname::information_schema.sql_identifier AS table_name,
+            a.attname::information_schema.sql_identifier AS column_name,
+            (ss.x).n::information_schema.cardinal_number AS ordinal_position,
+                CASE
+                    WHEN ss.contype = 'f'::"char" THEN information_schema._pg_index_position(ss.conindid, ss.confkey[(ss.x).n])
+                    ELSE NULL::integer
+                END::information_schema.cardinal_number AS position_in_unique_constraint
+        FROM pg_attribute a,
+            ( SELECT r.oid AS roid,
+                r.relname,
+                r.relowner,
+                nc.nspname AS nc_nspname,
+                nr.nspname AS nr_nspname,
+                c.oid AS coid,
+                c.conname,
+                c.contype,
+                c.conindid,
+                c.confkey,
+                c.confrelid,
+                information_schema._pg_expandarray(c.conkey) AS x
+               FROM pg_namespace nr,
+                pg_class r,
+                pg_namespace nc,
+                pg_constraint c
+              WHERE nr.oid = r.relnamespace AND r.oid = c.conrelid AND nc.oid = c.connamespace AND (c.contype = ANY (ARRAY['p'::"char", 'u'::"char", 'f'::"char"])) AND r.relkind = 'r'::"char" AND NOT pg_is_other_temp_schema(nr.oid)) ss
+        WHERE ss.roid = a.attrelid AND a.attnum = (ss.x).x AND NOT a.attisdropped
+        /*--AND (pg_has_role(ss.relowner, 'USAGE'::text) OR has_column_privilege(ss.roid, a.attnum, 'SELECT, INSERT, UPDATE, REFERENCES'::text))*/
+    )
+    SELECT
+        kc.table_schema,
+        kc.table_name,
+        kc.column_name
+    FROM
+        /*
+        --information_schema.table_constraints tc,
+        --information_schema.key_column_usage kc
+        */
+        tc, kc
+    WHERE
+        tc.constraint_type = 'PRIMARY KEY' AND
+        kc.table_name = tc.table_name AND
+        kc.table_schema = tc.table_schema AND
+        kc.constraint_name = tc.constraint_name AND
+        kc.table_schema NOT IN ('pg_catalog', 'information_schema') |]
 
 pkFromRow :: [Table] -> (Schema, Text, Text) -> Maybe PrimaryKey
 pkFromRow tabs (s, t, n) = PrimaryKey <$> table <*> pure n
   where table = find (\tbl -> tableSchema tbl == s && tableName tbl == t) tabs
 
-allSynonyms :: [Column] -> H.Tx P.Postgres s [(Column,Column)]
-allSynonyms allCols = do
-  syns <- H.listEx $ [H.stmt|
-    WITH synonyms AS (
-      /*
-      -- CTE to replace the view from information_schema because the information in it depended on the logged in role
-      -- notice the commented line
-      */
-      WITH view_column_usage AS (
-        SELECT DISTINCT
-               CAST(current_database() AS character varying) AS view_catalog,
-               CAST(nv.nspname AS character varying) AS view_schema,
-               CAST(v.relname AS character varying) AS view_name,
-               CAST(current_database() AS character varying) AS table_catalog,
-               CAST(nt.nspname AS character varying) AS table_schema,
-               CAST(t.relname AS character varying) AS table_name,
-               CAST(a.attname AS character varying) AS column_name
-        FROM pg_namespace nv, pg_class v, pg_depend dv,
-             pg_depend dt, pg_class t, pg_namespace nt,
-             pg_attribute a
-        WHERE nv.oid = v.relnamespace
-              AND v.relkind = 'v'
-              AND v.oid = dv.refobjid
-              AND dv.refclassid = 'pg_catalog.pg_class'::regclass
-              AND dv.classid = 'pg_catalog.pg_rewrite'::regclass
-              AND dv.deptype = 'i'
-              AND dv.objid = dt.objid
-              AND dv.refobjid <> dt.refobjid
-              AND dt.classid = 'pg_catalog.pg_rewrite'::regclass
-              AND dt.refclassid = 'pg_catalog.pg_class'::regclass
-              AND dt.refobjid = t.oid
-              AND t.relnamespace = nt.oid
-              AND t.relkind IN ('r', 'v', 'f')
-              AND t.oid = a.attrelid
-              AND dt.refobjsubid = a.attnum
-              /*--AND pg_has_role(t.relowner, 'USAGE')*/
-      )
-      SELECT
-        vcu.table_schema AS src_table_schema,
-        vcu.table_name AS src_table_name,
-        vcu.column_name AS src_column_name,
-        view.schemaname AS syn_table_schema,
-        view.viewname AS syn_table_name,
-        view.definition AS view_definition
-      FROM
-        pg_catalog.pg_views AS view,
-        view_column_usage AS vcu
-      WHERE
-        view.schemaname = vcu.view_schema AND
-        view.viewname = vcu.view_name AND
-        view.schemaname NOT IN ('pg_catalog', 'information_schema')
-        /*--AND (SELECT COUNT(*) FROM information_schema.view_table_usage WHERE view_schema = view.schemaname AND view_name = view.viewname) = 1*/
+allSynonyms :: [Column] -> H.Query () [(Column,Column)]
+allSynonyms cols =
+  H.statement sql HE.unit (decodeSynonyms cols) True
+ where
+  -- query explanation at https://gist.github.com/ruslantalpa/2eab8c930a65e8043d8f
+  sql = [q|
+    WITH view_columns AS (
+    	SELECT
+    		c.oid AS view_oid,
+    		a.attname::information_schema.sql_identifier AS column_name
+    	FROM pg_attribute a
+    	JOIN pg_class c ON a.attrelid = c.oid
+    	JOIN pg_namespace nc ON c.relnamespace = nc.oid
+    	WHERE
+    		NOT pg_is_other_temp_schema(nc.oid)
+    		AND a.attnum > 0
+    		AND NOT a.attisdropped
+    		AND (c.relkind = 'v'::"char")
+    		AND nc.nspname NOT IN ('information_schema', 'pg_catalog')
+    ),
+    view_column_usage AS (
+    	SELECT DISTINCT
+    		v.oid as view_oid,
+    		nv.nspname::information_schema.sql_identifier AS view_schema,
+    		v.relname::information_schema.sql_identifier AS view_name,
+    		nt.nspname::information_schema.sql_identifier AS table_schema,
+    		t.relname::information_schema.sql_identifier AS table_name,
+    		a.attname::information_schema.sql_identifier AS column_name,
+    		pg_get_viewdef(v.oid)::information_schema.character_data AS view_definition
+    	FROM pg_namespace nv
+    	JOIN pg_class v ON nv.oid = v.relnamespace
+    	JOIN pg_depend dv ON v.oid = dv.refobjid
+    	JOIN pg_depend dt ON dv.objid = dt.objid
+    	JOIN pg_class t ON dt.refobjid = t.oid
+    	JOIN pg_namespace nt ON t.relnamespace = nt.oid
+    	JOIN pg_attribute a ON t.oid = a.attrelid AND dt.refobjsubid = a.attnum
+
+    	WHERE
+    		nv.nspname not in ('information_schema', 'pg_catalog')
+    		AND v.relkind = 'v'::"char"
+    		AND dv.refclassid = 'pg_class'::regclass::oid
+    		AND dv.classid = 'pg_rewrite'::regclass::oid
+    		AND dv.deptype = 'i'::"char"
+    		AND dv.refobjid <> dt.refobjid
+    		AND dt.classid = 'pg_rewrite'::regclass::oid
+    		AND dt.refclassid = 'pg_class'::regclass::oid
+    		AND (t.relkind = ANY (ARRAY['r'::"char", 'v'::"char", 'f'::"char"]))
+    ),
+    candidates AS (
+    	SELECT
+    		vcu.*,
+    		(
+    			SELECT CASE WHEN match IS NOT NULL THEN coalesce(match[7], match[4]) END
+    			FROM REGEXP_MATCHES(
+    				CONCAT('SELECT ', SPLIT_PART(vcu.view_definition, 'SELECT', 2)),
+    				CONCAT('SELECT.*?((',vcu.table_name,')|(\w+))\.(', vcu.column_name, ')(\sAS\s(")?([^"]+)\6)?.*?FROM.*?',vcu.table_schema,'\.(\2|',vcu.table_name,'\s+(AS\s)?\3)'),
+    				'ns'
+    			) match
+    		) AS view_column_name
+    	FROM view_column_usage AS vcu
     )
     SELECT
-      src_table_schema, src_table_name, src_column_name,
-      syn_table_schema, syn_table_name,
-      (regexp_matches(view_definition, CONCAT('\.(', src_column_name, ')(?=,|$)'), 'gn'))[1] AS syn_column_name
-    FROM synonyms
-    UNION (
-      SELECT
-        src_table_schema, src_table_name, src_column_name,
-        syn_table_schema, syn_table_name,
-        (regexp_matches(view_definition, CONCAT('\.', src_column_name, '\sAS\s("?)(.+?)\1(,|$)'), 'gn'))[2] AS syn_column_name /* " <- for syntax highlighting */
-      FROM synonyms
-    )
+    	c.table_schema,
+    	c.table_name,
+    	c.column_name AS table_column_name,
+    	c.view_schema,
+    	c.view_name,
+    	c.view_column_name
+    FROM view_columns AS vc, candidates AS c
+    WHERE
+    	vc.view_oid = c.view_oid AND
+    	vc.column_name = c.view_column_name
+    ORDER BY c.view_schema, c.view_name, c.table_name, c.view_column_name
     |]
-  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

src/PostgREST/Error.hs

@@ -2,58 +2,80 @@
 {-# LANGUAGE FlexibleInstances    #-}
 {-# LANGUAGE TypeSynonymInstances #-}
 
-module PostgREST.Error (PgError, pgErrResponse, errResponse) where
+module PostgREST.Error (pgErrResponse, errResponse) where
 
 
 import           Data.Aeson                ((.=))
 import qualified Data.Aeson                as JSON
+import           Data.Maybe                (fromMaybe)
+import           Data.Monoid               ((<>))
 import           Data.String.Conversions   (cs)
-import           Data.String.Utils         (replace)
 import           Data.Text                 (Text)
 import qualified Data.Text                 as T
-import qualified Hasql                     as H
-import qualified Hasql.Postgres            as P
+import qualified Hasql.Pool                as P
+import qualified Hasql.Session             as H
 import           Network.HTTP.Types.Header
 import qualified Network.HTTP.Types.Status as HT
 import           Network.Wai               (Response, responseLBS)
 
-type PgError = H.SessionError P.Postgres
-
 errResponse :: HT.Status -> Text -> Response
 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)
+pgErrResponse :: Bool -> P.UsageError -> Response
+pgErrResponse authed e =
+  let status = httpStatus authed e
+      jsonType = (hContentType, "application/json")
+      wwwAuth = ("WWW-Authenticate", "Bearer")
+      hdrs = if status == HT.status401
+                then [jsonType, wwwAuth]
+                else [jsonType] in
+  responseLBS status hdrs (JSON.encode e)
 
-instance JSON.ToJSON PgError where
-  toJSON (H.TxError (P.ErroneousResult c m d h)) = JSON.object [
+instance JSON.ToJSON P.UsageError where
+  toJSON (P.ConnectionError e) = JSON.object [
+    "code" .= ("" :: T.Text),
+    "message" .= ("Connection error" :: T.Text),
+    "details" .= (cs (fromMaybe "" e) :: T.Text)]
+  toJSON (P.SessionError e) = JSON.toJSON e -- H.Error
+
+instance JSON.ToJSON H.Error where
+  toJSON (H.ResultError (H.ServerError c m d h)) = JSON.object [
     "code" .= (cs c::T.Text),
     "message" .= (cs m::T.Text),
     "details" .= (fmap cs d::Maybe T.Text),
     "hint" .= (fmap cs h::Maybe T.Text)]
-  toJSON (H.TxError (P.NoResult d)) = JSON.object [
-    "message" .= ("No response from server"::T.Text),
+  toJSON (H.ResultError (H.UnexpectedResult m)) = JSON.object [
+    "message" .= (cs m::T.Text)]
+  toJSON (H.ResultError (H.RowError i H.EndOfInput)) = JSON.object [
+    "message" .= ("Row error: end of input"::String),
+    "details" .=
+      ("Attempt to parse more columns than there are in the result"::String),
+    "details" .= ("Row number " <> show i)]
+  toJSON (H.ResultError (H.RowError i H.UnexpectedNull)) = JSON.object [
+    "message" .= ("Row error: unexpected null"::String),
+    "details" .= ("Attempt to parse a NULL as some value."::String),
+    "details" .= ("Row number " <> show i)]
+  toJSON (H.ResultError (H.RowError i (H.ValueError d))) = JSON.object [
+    "message" .= ("Row error: Wrong value parser used"::String),
+    "details" .= d,
+    "details" .= ("Row number " <> show i)]
+  toJSON (H.ResultError (H.UnexpectedAmountOfRows i)) = JSON.object [
+    "message" .= ("Unexpected amount of rows"::String),
+    "details" .= i]
+  toJSON (H.ClientError d) = JSON.object [
+    "message" .= ("Database client error"::String),
     "details" .= (fmap cs d::Maybe T.Text)]
-  toJSON (H.TxError (P.UnexpectedResult m)) = JSON.object ["message" .= m]
-  toJSON (H.TxError P.NotInTransaction) = JSON.object [
-    "message" .= ("Not in transaction"::T.Text)]
-  toJSON (H.CxError (P.CantConnect d)) = JSON.object [
-    "message" .= ("Can't connect to the database"::T.Text),
-    "details" .= (fmap cs d::Maybe T.Text)]
-  toJSON (H.CxError (P.UnsupportedVersion v)) = JSON.object [
-    "message" .= ("Postgres version "++version++" is not supported") ]
-      where version = replace "0" "." (show v)
-  toJSON (H.ResultError m) = JSON.object ["message" .= m]
 
-httpStatus :: PgError -> HT.Status
-httpStatus (H.TxError (P.ErroneousResult codeBS _ _ _)) =
-  let code = cs codeBS in
-  case code of
+httpStatus :: Bool -> P.UsageError -> HT.Status
+httpStatus _ (P.ConnectionError _) = HT.status500
+httpStatus authed (P.SessionError (H.ResultError (H.ServerError c _ _ _))) =
+  case cs c of
     '0':'8':_ -> HT.status503 -- pg connection err
     '0':'9':_ -> HT.status500 -- triggered action exception
     '0':'L':_ -> HT.status403 -- invalid grantor
     '0':'P':_ -> HT.status403 -- invalid role specification
+    "23503"   -> HT.status409 -- foreign_key_violation
+    "23505"   -> HT.status409 -- unique_violation
     '2':'5':_ -> HT.status500 -- invalid tx state
     '2':'8':_ -> HT.status403 -- invalid auth specification
     '2':'D':_ -> HT.status500 -- invalid tx termination
@@ -70,8 +92,8 @@ httpStatus (H.TxError (P.ErroneousResult codeBS _ _ _)) =
     'H':'V':_ -> HT.status500 -- foreign data wrapper error
     'P':'0':_ -> HT.status500 -- PL/pgSQL Error
     'X':'X':_ -> HT.status500 -- internal Error
-    "42P01" -> HT.status404 -- undefined table
-    "42501" -> HT.status404 -- insufficient privilege
-    _ -> HT.status400
-httpStatus (H.TxError (P.NoResult _)) = HT.status503
-httpStatus _ = HT.status500
+    "42P01"   -> HT.status404 -- undefined table
+    "42501"   -> if authed then HT.status403 else HT.status401 -- insufficient privilege
+    _         -> HT.status400
+httpStatus _ (P.SessionError (H.ResultError _)) = HT.status500
+httpStatus _ (P.SessionError (H.ClientError _)) = HT.status503

src/PostgREST/Main.hs

@@ -1,97 +0,0 @@
-{-# LANGUAGE CPP #-}
-
-module Main where
-
-
-import           PostgREST.App
-import           PostgREST.Config                     (AppConfig (..),
-                                                       minimumPgVersion,
-                                                       prettyVersion,
-                                                       readOptions)
-import           PostgREST.DbStructure
-import           PostgREST.Error                      (PgError, pgErrResponse)
-import           PostgREST.Middleware
-
-import           Control.Monad                        (unless, void)
-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           Data.Time.Clock.POSIX                (getPOSIXTime)
-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)
-
-#ifndef mingw32_HOST_OS
-import           System.Posix.Signals
-import           Control.Concurrent                   (myThreadId)
-import           Control.Exception.Base               (throwTo, AsyncException(..))
-#endif
-
-isServerVersionSupported :: H.Session P.Postgres IO Bool
-isServerVersionSupported = do
-  Identity (row :: Text) <- H.tx Nothing $ H.singleEx [H.stmt|SHOW server_version_num|]
-  return $ read (cs row) >= minimumPgVersion
-
-hasqlError :: PgError -> IO a
-hasqlError = error . cs . encode
-
-main :: IO ()
-main = do
-  hSetBuffering stdout LineBuffering
-  hSetBuffering stdin  LineBuffering
-  hSetBuffering stderr NoBuffering
-
-  conf <- readOptions
-  let port = configPort conf
-
-  unless (secret "secret" /= configJwtSecret conf) $
-    putStrLn "WARNING, running in insecure mode, JWT secret is the default value"
-  Prelude.putStrLn $ "Listening on port " ++
-    (show $ configPort conf :: String)
-
-  let pgSettings = P.StringSettings $ cs (configDatabase conf)
-      appSettings = setPort port
-                  . setServerName (cs $ "postgrest/" <> prettyVersion)
-                  $ defaultSettings
-      middle = logStdout . defaultMiddle
-
-  poolSettings <- maybe (fail "Improper session settings") return $
-    H.poolSettings (fromIntegral $ configPool conf) 30
-  pool :: H.Pool P.Postgres <- H.acquirePool pgSettings poolSettings
-
-  supportedOrError <- H.session pool isServerVersionSupported
-  either hasqlError
-    (\supported ->
-      unless supported $
-        error (
-          "Cannot run in this PostgreSQL version, PostgREST needs at least "
-          <> show minimumPgVersion)
-    ) supportedOrError
-
-#ifndef mingw32_HOST_OS
-  tid <- myThreadId
-  void $ installHandler keyboardSignal (Catch $ do
-      H.releasePool pool
-      throwTo tid UserInterrupt
-    ) Nothing
-#endif
-
-  let txSettings = Just (H.ReadCommitted, Just True)
-  dbOrError <- H.session pool $ H.tx txSettings $ getDbStructure (cs $ configSchema conf)
-  dbStructure <- either hasqlError return dbOrError
-
-  runSettings appSettings $ middle $ \ req respond -> do
-    time <- getPOSIXTime
-    body <- strictRequestBody req
-    resOrError <- liftIO $ H.session pool $ H.tx txSettings $
-      runWithClaims conf time (app dbStructure conf body) req
-    either (respond . pgErrResponse) respond resOrError

src/PostgREST/Middleware.hs

@@ -3,56 +3,40 @@
 
 module PostgREST.Middleware where
 
-import           Data.Maybe                    (fromMaybe)
-import           Data.Text
+import           Data.Aeson                    (Value (..))
+import qualified Data.HashMap.Strict           as M
 import           Data.String.Conversions       (cs)
-import           Data.Time.Clock               (NominalDiffTime)
-import qualified Hasql                         as H
-import qualified Hasql.Postgres                as P
+import           Data.Text
+import qualified Hasql.Transaction             as H
 
-import           Network.HTTP.Types.Header     (hAccept, hAuthorization)
-import           Network.HTTP.Types.Status     (status415, status400)
-import           Network.Wai                   (Application, Request (..), Response,
-                                                requestHeaders)
+import           Network.HTTP.Types.Header     (hAccept)
+import           Network.HTTP.Types.Status     (status400, status415)
+import           Network.Wai                   (Application, Request (..),
+                                                Response, requestHeaders)
 import           Network.Wai.Middleware.Cors   (cors)
 import           Network.Wai.Middleware.Gzip   (def, gzip)
 import           Network.Wai.Middleware.Static (only, staticPolicy)
 
-import           PostgREST.ApiRequest       (pickContentType)
-import           PostgREST.Auth                (setRole, jwtClaims, claimsToSQL)
+import           PostgREST.ApiRequest          (ApiRequest(..), pickContentType)
+import           PostgREST.Auth                (claimsToSQL)
 import           PostgREST.Config              (AppConfig (..), corsPolicy)
 import           PostgREST.Error               (errResponse)
 
-import           Prelude hiding(concat)
+import           Prelude                       hiding (concat, null)
 
-import qualified Data.Vector             as V
-import qualified Hasql.Backend           as B
-import qualified Data.Map.Lazy           as M
-
-runWithClaims :: forall s. AppConfig -> NominalDiffTime ->
-                 (Request -> H.Tx P.Postgres s Response) ->
-                 Request -> H.Tx P.Postgres s Response
-runWithClaims conf time app req = do
-    _ <- H.unitEx $ stmt setAnon
-    case split (== ' ') (cs auth) of
-      ("Bearer" : tokenStr : _) ->
-        case jwtClaims jwtSecret tokenStr time of
-          Just claims ->
-            if M.member "role" claims
-            then do
-              mapM_ H.unitEx $ stmt <$> claimsToSQL claims
-              app req
-            else invalidJWT
-          _ -> invalidJWT
-      _ -> app req
+runWithClaims :: AppConfig -> Either Text (M.HashMap Text Value) ->
+                 (ApiRequest -> H.Transaction Response) ->
+                 ApiRequest -> H.Transaction Response
+runWithClaims conf eClaims app req =
+  case eClaims of
+    Left e -> clientErr e
+    Right claims -> do
+          -- role claim defaults to anon if not specified in jwt
+          H.sql . mconcat . claimsToSQL $ M.union claims (M.singleton "role" anon)
+          app req
   where
-    stmt c = B.Stmt c V.empty True
-    hdrs = requestHeaders req
-    jwtSecret = configJwtSecret conf
-    auth = fromMaybe "" $ lookup hAuthorization hdrs
-    anon = cs $ configAnonRole conf
-    setAnon = setRole anon
-    invalidJWT = return $ errResponse status400 "Invalid JWT"
+    anon = String . cs $ configAnonRole conf
+    clientErr = return . errResponse status400
 
 unsupportedAccept :: Application -> Application
 unsupportedAccept app req respond =

src/PostgREST/Parsers.hs

@@ -3,25 +3,30 @@ module PostgREST.Parsers
 -- )
 where
 
-import           Control.Applicative hiding ((<$>))
+import           Control.Applicative           hiding ((<$>))
 import           Data.Monoid
 import           Data.String.Conversions       (cs)
-import           Data.Text                     (Text)
+import           Data.Text                     (Text, intercalate)
 import           Data.Tree
+import           PostgREST.QueryBuilder        (operators)
 import           PostgREST.Types
 import           Text.ParserCombinators.Parsec hiding (many, (<|>))
-import           PostgREST.QueryBuilder (operators)
+import           PostgREST.RangeQuery      (NonnegRange,allRange)
 
 pRequestSelect :: Text -> Parser ReadRequest
 pRequestSelect rootNodeName = do
   fieldTree <- pFieldForest
-  return $ foldr treeEntry (Node (Select [] [rootNodeName] [] Nothing, (rootNodeName, Nothing)) []) fieldTree
+  return $ foldr treeEntry (Node (readQuery, (rootNodeName, Nothing, Nothing)) []) fieldTree
   where
+    readQuery = Select [] [rootNodeName] [] Nothing allRange
     treeEntry :: Tree SelectItem -> ReadRequest -> ReadRequest
-    treeEntry (Node fld@((fn, _),_) fldForest) (Node (q, i) rForest) =
+    treeEntry (Node fld@((fn, _),_,alias) fldForest) (Node (q, i) rForest) =
       case fldForest of
         [] -> Node (q {select=fld:select q}, i) rForest
-        _  -> Node (q, i) (foldr treeEntry (Node (Select [] [fn] [] Nothing, (fn, Nothing)) []) fldForest:rForest)
+        _  -> Node (q, i) newForest
+          where
+            newForest =
+              foldr treeEntry (Node (Select [] [fn] [] Nothing allRange, (fn, Nothing, alias)) []) fldForest:rForest
 
 pRequestFilter :: (String, String) -> Either ParseError (Path, Filter)
 pRequestFilter (k, v) = (,) <$> path <*> (Filter <$> fld <*> op <*> val)
@@ -33,6 +38,19 @@ pRequestFilter (k, v) = (,) <$> path <*> (Filter <$> fld <*> op <*> val)
     op = fst <$> opVal
     val = snd <$> opVal
 
+pRequestOrder :: (String, String) -> Either ParseError (Path, [OrderTerm])
+pRequestOrder (k, v) = (,) <$> path <*> ord
+  where
+    treePath = parse pTreePath ("failed to parser tree path (" ++ k ++ ")") k
+    path = fst <$> treePath
+    ord = parse pOrder ("failed to parse order (" ++ v ++ ")") v
+
+pRequestRange :: (String, NonnegRange) -> Either ParseError (Path, NonnegRange)
+pRequestRange (k, v) = (,) <$> path <*> pure v
+  where
+    treePath = parse pTreePath ("failed to parser tree path (" ++ k ++ ")") k
+    path = fst <$> treePath
+
 ws :: Parser Text
 ws = cs <$> many (oneOf " \t")
 
@@ -51,15 +69,23 @@ pFieldForest :: Parser [Tree SelectItem]
 pFieldForest = pFieldTree `sepBy1` lexeme (char ',')
 
 pFieldTree :: Parser (Tree SelectItem)
-pFieldTree = try (Node <$> pSelect <*> between (char '{') (char '}') pFieldForest)
+pFieldTree = try (Node <$> pSimpleSelect <*> between (char '{') (char '}') pFieldForest)
           <|>     Node <$> pSelect <*> pure []
 
 pStar :: Parser Text
 pStar = cs <$> (string "*" *> pure ("*"::String))
 
+
 pFieldName :: Parser Text
-pFieldName =  cs <$> (many1 (letter <|> digit <|> oneOf "_")
-          <?> "field name (* or [a..z0..9_])")
+pFieldName = do
+  matches <- (many1 (letter <|> digit <|> oneOf "_") `sepBy1` dash) <?> "field name (* or [a..z0..9_])"
+  return $ intercalate "-" $ map cs matches
+  where
+    isDash :: GenParser Char st ()
+    isDash = try ( char '-' >> notFollowedBy (char '>') )
+    dash :: Parser Char
+    dash = isDash *> pure '-'
+
 
 pJsonPathStep :: Parser Text
 pJsonPathStep = cs <$> try (string "->" *> pFieldName)
@@ -70,12 +96,28 @@ pJsonPath = (++) <$> many pJsonPathStep <*> ( (:[]) <$> (string "->>" *> pFieldN
 pField :: Parser Field
 pField = lexeme $ (,) <$> pFieldName <*> optionMaybe pJsonPath
 
+aliasSeparator :: Parser ()
+aliasSeparator = char ':' >> notFollowedBy (char ':')
+
+pSimpleSelect :: Parser SelectItem
+pSimpleSelect = lexeme $ try ( do
+    alias <- optionMaybe ( try(pFieldName <* aliasSeparator) )
+    fld <- pField
+    return (fld, Nothing, alias)
+  )
+
 pSelect :: Parser SelectItem
 pSelect = lexeme $
-  try ((,) <$> pField <*>((cs <$>) <$> optionMaybe (string "::" *> many letter)) )
+  try (
+    do
+      alias <- optionMaybe ( try(pFieldName <* aliasSeparator) )
+      fld <- pField
+      cast <- optionMaybe (string "::" *> many letter)
+      return (fld, cs <$> cast, alias)
+  )
   <|> do
     s <- pStar
-    return ((s, Nothing), Nothing)
+    return ((s, Nothing), Nothing, Nothing)
 
 pOperator :: Parser Operator
 pOperator = cs <$> (pOp <?> "operator (eq, gt, ...)")

src/PostgREST/QueryBuilder.hs

@@ -15,7 +15,6 @@ Any function that outputs a SQL fragment should be in this module.
 module PostgREST.QueryBuilder (
     addRelations
   , addJoinConditions
-  , asJson
   , callProc
   , createReadStatement
   , createWriteStatement
@@ -26,28 +25,33 @@ module PostgREST.QueryBuilder (
   , requestToCountQuery
   , sourceCTEName
   , unquoted
+  , ResultsWithCount
   ) where
 
-import qualified Hasql                   as H
-import qualified Hasql.Backend           as B
-import qualified Hasql.Postgres          as P
+import qualified Hasql.Query             as H
+import qualified Hasql.Encoders          as HE
+import qualified Hasql.Decoders          as HD
 
 import qualified Data.Aeson              as JSON
+import           Data.Int                (Int64)
 
-import           PostgREST.RangeQuery    (NonnegRange, rangeLimit, rangeOffset)
-import           Control.Error           (note, fromMaybe, mapMaybe)
+import           PostgREST.RangeQuery    (NonnegRange, rangeLimit, rangeOffset, allRange)
+import           Control.Error           (note, fromMaybe)
+import           Data.Functor.Contravariant (contramap)
 import qualified Data.HashMap.Strict     as HM
-import           Data.List               (find, (\\))
+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 qualified Data.Text as T          (map, takeWhile, null)
+import qualified Data.Text.Encoding as T
 import           Data.String.Conversions (cs)
-import           Control.Applicative     (empty, (<|>))
-import           Control.Monad           (join)
+import           Control.Applicative     ((<|>))
+import           Control.Monad           (replicateM)
 import           Data.Tree               (Tree(..))
 import qualified Data.Vector as V
 import           PostgREST.Types
 import qualified Data.Map as M
+import           Text.InterpolatedString.Perl6 (qc)
 import           Text.Regex.TDFA         ((=~))
 import qualified Data.ByteString.Char8   as BS
 import           Data.Scientific         ( FPFormat (..)
@@ -57,85 +61,120 @@ import           Data.Scientific         ( FPFormat (..)
 import           Prelude hiding          (unwords)
 import           PostgREST.ApiRequest    (PreferRepresentation (..))
 
-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
+{-| The generic query result format used by API responses. The location header
+    is represented as a list of strings containing variable bindings like
+    @"k1=eq.42"@, or the empty list if there is no location header.
+-}
+type ResultsWithCount = (Maybe Int64, Int64, [BS.ByteString], BS.ByteString)
 
-createReadStatement :: SqlQuery -> SqlQuery -> NonnegRange -> Bool -> Bool -> Bool -> B.Stmt P.Postgres
-createReadStatement selectQuery countQuery range isSingle countTotal asCsv =
-  B.Stmt (
-    "WITH " <> sourceCTEName <> " AS (" <> selectQuery <> ") " <>
-    "SELECT " <> intercalate ", " [
+standardRow :: HD.Row ResultsWithCount
+standardRow = (,,,) <$> HD.nullableValue HD.int8 <*> HD.value HD.int8
+                    <*> HD.value header <*> HD.value HD.bytea
+  where
+    header = HD.array $ HD.arrayDimension replicateM $ HD.arrayValue HD.bytea
+
+noLocationF :: Text
+noLocationF = "array[]::text[]"
+
+{-| Read and Write api requests use a similar response format which includes
+    various record counts and possible location header. This is the decoder
+    for that common type of query.
+-}
+decodeStandard :: HD.Result ResultsWithCount
+decodeStandard =
+  HD.singleRow standardRow
+
+decodeStandardMay :: HD.Result (Maybe ResultsWithCount)
+decodeStandardMay =
+  HD.maybeRow standardRow
+
+{-| JSON and CSV payloads from the client are given to us as
+    UniformObjects (objects who all have the same keys),
+    and we turn this into an old fasioned JSON array
+-}
+encodeUniformObjs :: HE.Params UniformObjects
+encodeUniformObjs =
+  contramap (JSON.Array . V.map JSON.Object . unUniformObjects) (HE.value HE.json)
+
+createReadStatement :: SqlQuery -> SqlQuery -> Bool -> Bool -> Bool ->
+                       H.Query () ResultsWithCount
+createReadStatement selectQuery countQuery isSingle countTotal asCsv =
+  unicodeStatement sql HE.unit decodeStandard True
+ where
+  sql = [qc|
+      WITH {sourceCTEName} AS ({selectQuery}) SELECT {cols}
+      FROM ( SELECT * FROM {sourceCTEName}) t |]
+  countResultF = if countTotal then "("<>countQuery<>")" else "null"
+  cols = intercalate ", " [
       countResultF <> " AS total_result_set",
       "pg_catalog.count(t) AS page_total",
-      "null AS header",
+      noLocationF <> " AS header",
       bodyF <> " AS body"
-    ] <>
-    " FROM ( SELECT * FROM " <> sourceCTEName <> " " <> limitF range <> ") t"
-  ) V.empty True
-  where
-    countResultF = if countTotal then "("<>countQuery<>")" else "null"
-    bodyF
-      | asCsv = asCsvF
-      | isSingle = asJsonSingleF
-      | otherwise = asJsonF
+    ]
+  bodyF
+    | asCsv = asCsvF
+    | isSingle = asJsonSingleF
+    | otherwise = asJsonF
 
-createWriteStatement :: QualifiedIdentifier -> SqlQuery -> SqlQuery -> Bool -> PreferRepresentation ->
-                        [Text] -> Bool -> Payload -> B.Stmt P.Postgres
+createWriteStatement :: QualifiedIdentifier -> SqlQuery -> SqlQuery -> Bool ->
+                        PreferRepresentation -> [Text] -> Bool -> Payload ->
+                        H.Query UniformObjects (Maybe ResultsWithCount)
 createWriteStatement _ _ _ _ _ _ _ (PayloadParseError _) = undefined
 createWriteStatement _ _ mutateQuery _ None
-                     _ _ (PayloadJSON (UniformObjects rows)) =
-  B.Stmt (
-    "WITH " <> sourceCTEName <> " AS (" <> mutateQuery <> ") " <>
-    "SELECT null, 0, null, null"
-  ) (V.singleton . B.encodeValue . JSON.Array . V.map JSON.Object $ rows) True
+                     _ _ (PayloadJSON (UniformObjects _)) =
+  unicodeStatement sql encodeUniformObjs decodeStandardMay True
+ where
+  sql = [qc|
+      WITH {sourceCTEName} AS ({mutateQuery})
+      SELECT '', 0, {noLocationF}, '' |]
+
 createWriteStatement qi _ mutateQuery isSingle HeadersOnly
-                     pKeys _ (PayloadJSON (UniformObjects rows)) =
-  B.Stmt (
-    "WITH " <> sourceCTEName <> " AS (" <> mutateQuery <> " RETURNING " <> fromQi qi <> ".*" <> ") " <>
-    "SELECT " <> intercalate ", " [
-      "null AS total_result_set",
+                     pKeys _ (PayloadJSON (UniformObjects _)) =
+  unicodeStatement sql encodeUniformObjs decodeStandardMay True
+ where
+  sql = [qc|
+      WITH {sourceCTEName} AS ({mutateQuery} RETURNING {fromQi qi}.*)
+      SELECT {cols}
+      FROM (SELECT 1 FROM {sourceCTEName}) t |]
+  cols = intercalate ", " [
+      "'' AS total_result_set",
       "pg_catalog.count(t) AS page_total",
-      if isSingle then locationF pKeys else "null",
-      "null"
-    ] <>
-    " FROM (SELECT 1 FROM " <> sourceCTEName <> ") t"
-  ) (V.singleton . B.encodeValue . JSON.Array . V.map JSON.Object $ rows) True
+      if isSingle then locationF pKeys else noLocationF,
+      "''"
+    ]
+
 createWriteStatement qi selectQuery mutateQuery isSingle Full
-                     pKeys asCsv (PayloadJSON (UniformObjects rows)) =
-  B.Stmt (
-    "WITH " <> sourceCTEName <> " AS (" <> mutateQuery <> " RETURNING " <> fromQi qi <> ".*" <> ") " <>
-    "SELECT " <> intercalate ", " [
-      "null AS total_result_set", -- when updateing it does not make sense
+                     pKeys asCsv (PayloadJSON (UniformObjects _)) =
+  unicodeStatement sql encodeUniformObjs decodeStandardMay True
+ where
+  sql = [qc|
+      WITH {sourceCTEName} AS ({mutateQuery} RETURNING {fromQi qi}.*)
+      SELECT {cols}
+      FROM ({selectQuery}) t |]
+  cols = intercalate ", " [
+      "'' AS total_result_set", -- when updateing it does not make sense
       "pg_catalog.count(t) AS page_total",
-      if isSingle then locationF pKeys else "null" <> " AS header",
+      if isSingle then locationF pKeys else noLocationF <> " AS header",
       bodyF <> " AS body"
-    ] <>
-    " FROM ( "<>selectQuery<>") t"
-  ) (V.singleton . B.encodeValue . JSON.Array . V.map JSON.Object $ rows) True
-  where
-    bodyF
-      | asCsv = asCsvF
-      | isSingle = asJsonSingleF
-      | otherwise = asJsonF
+    ]
+  bodyF
+    | asCsv = asCsvF
+    | isSingle = asJsonSingleF
+    | otherwise = asJsonF
 
 addRelations :: Schema -> [Relation] -> Maybe ReadRequest -> ReadRequest -> Either Text ReadRequest
-addRelations schema allRelations parentNode node@(Node readNode@(query, (name, _)) forest) =
+addRelations schema allRelations parentNode node@(Node readNode@(query, (name, _, alias)) forest) =
   case parentNode of
-    (Just (Node (Select{from=[parentTable]}, (_, _)) _)) -> Node <$> (addRel readNode <$> rel) <*> updatedForest
+    (Just (Node (Select{from=[parentTable]}, (_, _, _)) _)) -> Node <$> (addRel readNode <$> rel) <*> updatedForest
       where
         rel = note ("no relation between " <> parentTable <> " and " <> name)
             $  findRelationByTable schema name parentTable
-           <|> findRelationByTable schema parentTable name
            <|> findRelationByColumn schema parentTable name
-        addRel :: (ReadQuery, (NodeName, Maybe Relation)) -> Relation -> (ReadQuery, (NodeName, Maybe Relation))
-        addRel (q, (n, _)) r = (q {from=fromRelation}, (n, Just r))
-          where fromRelation = map (\t -> if t == n then tableName (relTable r) else t) (from q)
+        addRel :: (ReadQuery, (NodeName, Maybe Relation, Maybe Alias)) -> Relation -> (ReadQuery, (NodeName, Maybe Relation, Maybe Alias))
+        addRel (query', (n, _, a)) r = (query' {from=fromRelation}, (n, Just r, a))
+          where fromRelation = map (\t -> if t == n then tableName (relTable r) else t) (from query')
 
-    _ -> Node (query, (name, Nothing)) <$> updatedForest
+    _ -> Node (query, (name, Nothing, alias)) <$> updatedForest
   where
     updatedForest = mapM (addRelations schema allRelations (Just node)) forest
     -- Searches through all the relations and returns a match given the parameter conditions.
@@ -148,40 +187,45 @@ addRelations schema allRelations parentNode node@(Node readNode@(query, (name, _
       where n `colMatches` rc = (cs ("^" <> rc <> "_?(?:|[iI][dD]|[fF][kK])$") :: BS.ByteString) =~ (cs n :: BS.ByteString)
 
 addJoinConditions :: Schema -> ReadRequest -> Either Text ReadRequest
-addJoinConditions schema (Node (query, (n, r)) forest) =
+addJoinConditions schema (Node nn@(query, (n, r, a)) forest) =
   case r of
-    Nothing -> Node (updatedQuery, (n,r))  <$> updatedForest -- this is the root node
-    Just rel@(Relation{relType=Child}) -> Node (addCond updatedQuery (getJoinConditions rel),(n,r)) <$> updatedForest
-    Just (Relation{relType=Parent}) -> Node (updatedQuery, (n,r)) <$> updatedForest
-    Just rel@(Relation{relType=Many, relLTable=(Just linkTable)}) ->
-      Node (qq, (n, r)) <$> updatedForest
+    Nothing -> Node nn  <$> updatedForest -- this is the root node
+    Just rel@Relation{relType=Child} -> Node (addCond query (getJoinConditions rel),(n,r,a)) <$> updatedForest
+    Just Relation{relType=Parent} -> Node nn <$> updatedForest
+    Just rel@Relation{relType=Many, relLTable=(Just linkTable)} ->
+      Node (qq, (n, r, a)) <$> updatedForest
       where
-         q = addCond updatedQuery (getJoinConditions rel)
-         qq = q{from=tableName linkTable : from q}
+         query' = addCond query (getJoinConditions rel)
+         qq = query'{from=tableName linkTable : from query'}
     _ -> Left "unknown relation"
   where
-    -- add parentTable and parentJoinConditions to the query
-    updatedQuery = foldr (flip addCond) query parentJoinConditions
-      where
-        parentJoinConditions = map (getJoinConditions . snd) parents
-        parents = mapMaybe (getParents . rootLabel) forest
-        getParents (_, (tbl, Just rel@(Relation{relType=Parent}))) = Just (tbl, rel)
-        getParents _ = Nothing
     updatedForest = mapM (addJoinConditions schema) forest
-    addCond q con = q{flt_=con ++ flt_ q}
+    addCond query' con = query'{flt_=con ++ flt_ query'}
 
-asJson :: StatementT
-asJson s = s {
-  B.stmtTemplate =
-    "array_to_json(coalesce(array_agg(row_to_json(t)), '{}'))::character varying from ("
-    <> B.stmtTemplate s <> ") t" }
-
-callProc :: QualifiedIdentifier -> JSON.Object -> PStmt
-callProc qi params = do
-  let args = intercalate "," $ map assignment (HM.toList params)
-  B.Stmt ("select * from " <> fromQi qi <> "(" <> args <> ")") empty True
+type ProcResults = (Maybe Int64, Int64, JSON.Value)
+callProc :: QualifiedIdentifier -> JSON.Object -> NonnegRange -> Bool -> H.Query () (Maybe ProcResults)
+callProc qi params range countTotal =
+  unicodeStatement sql HE.unit decodeProc True
   where
-    assignment (n,v) = pgFmtIdent n <> ":=" <> insertableValue v
+    sql = [qc|
+            WITH t AS (select * {_callSql})
+            SELECT
+              {_countExpr} as countTotal,
+              pg_catalog.count(1) as countResult,
+              array_to_json(
+                coalesce(array_agg(row_to_json(r)), '\{}')
+              )::character varying
+            FROM (select * from t {limitF range}) r;
+          |]
+    _args = intercalate "," $ map _assignment (HM.toList params)
+    _assignment (n,v) = pgFmtIdent n <> ":=" <> insertableValue v
+    _callSql = [qc| from {fromQi qi}({_args}) |] :: Text
+    _countExpr = if countTotal
+                   then "(select pg_catalog.count(1) from t)"
+                   else "null::bigint" :: Text
+    decodeProc = HD.maybeRow procRow
+    procRow = (,,) <$> HD.nullableValue HD.int8 <*> HD.value HD.int8
+                   <*> HD.value HD.json
 
 operators :: [(Text, SqlFragment)]
 operators = [
@@ -210,27 +254,27 @@ pgFmtLit x =
  let trimmed = trimNullChars x
      escaped = "'" <> replace "'" "''" trimmed <> "'"
      slashed = replace "\\" "\\\\" escaped in
- if "\\\\" `isInfixOf` escaped
+ if "\\" `isInfixOf` escaped
    then "E" <> slashed
    else slashed
 
 requestToCountQuery :: Schema -> DbRequest -> SqlQuery
 requestToCountQuery _ (DbMutate _) = undefined
-requestToCountQuery schema (DbRead (Node (Select _ _ conditions _, (mainTbl, _)) _)) =
+requestToCountQuery schema (DbRead (Node (Select _ _ conditions _ _, (mainTbl, _, _)) _)) =
  unwords [
    "SELECT pg_catalog.count(1)",
    "FROM ", fromQi $ QualifiedIdentifier schema mainTbl,
    ("WHERE " <> intercalate " AND " ( map (pgFmtCondition (QualifiedIdentifier schema mainTbl)) localConditions )) `emptyOnNull` localConditions
    ]
  where
-   fn  (Filter{value=VText _}) = True
-   fn  (Filter{value=VForeignKey _ _}) = False
+   fn Filter{value=VText _} = True
+   fn Filter{value=VForeignKey _ _} = False
    localConditions = filter fn conditions
 
 requestToQuery :: Schema -> DbRequest -> SqlQuery
 requestToQuery _ (DbMutate (Insert _ (PayloadParseError _))) = undefined
 requestToQuery _ (DbMutate (Update _ (PayloadParseError _) _)) = undefined
-requestToQuery schema (DbRead (Node (Select colSelects tbls conditions ord, (nodeName, maybeRelation)) forest)) =
+requestToQuery schema (DbRead (Node (Select colSelects tbls conditions ord range, (nodeName, maybeRelation, _)) forest)) =
   query
   where
     -- TODO! the folloing helper functions are just to remove the "schema" part when the table is "source" which is the name
@@ -242,9 +286,10 @@ requestToQuery schema (DbRead (Node (Select colSelects tbls conditions ord, (nod
     query = unwords [
       "SELECT ", intercalate ", " (map (pgFmtSelectItem qi) colSelects ++ selects),
       "FROM ", intercalate ", " (map (fromQi . toQi) tbls),
-      unwords (map joinStr joins),
-      ("WHERE " <> intercalate " AND " ( map (pgFmtCondition qi ) localConditions )) `emptyOnNull` localConditions,
-      orderF (fromMaybe [] ord)
+      unwords joins,
+      ("WHERE " <> intercalate " AND " ( map (pgFmtCondition qi ) conditions )) `emptyOnNull` conditions,
+      orderF (fromMaybe [] ord),
+      limitF range
       ]
     orderF ts =
         if null ts
@@ -258,50 +303,48 @@ requestToQuery schema (DbRead (Node (Select colSelects tbls conditions ord, (nod
                 <> (cs.show) (otDirection t) <> " "
                 <> maybe "" (cs.show) (otNullOrder t) <> " "
     (joins, selects) = foldr getQueryParts ([],[]) forest
-    parentTables = map snd joins
-    parentConditions = join $ map (( `filter` conditions ) . filterParentConditions) parentTables
-    localConditions = conditions \\ parentConditions
-    joinStr :: (SqlFragment, TableName) -> SqlFragment
-    joinStr (sql, t) = "LEFT OUTER JOIN " <> sql <> " ON " <>
-      intercalate " AND " ( map (pgFmtCondition qi ) joinConditions )
-      where
-        joinConditions = filter (filterParentConditions t) conditions
-    filterParentConditions parentTable (Filter _ _ (VForeignKey (QualifiedIdentifier "" t) _)) = parentTable == t
-    filterParentConditions _ _ = False
-    getQueryParts :: Tree ReadNode -> ([(SqlFragment, TableName)], [SqlFragment]) -> ([(SqlFragment,TableName)], [SqlFragment])
-    getQueryParts (Node n@(_, (name, Just (Relation {relType=Child,relTable=Table{tableName=table}}))) forst) (j,s) = (j,sel:s)
+
+    getQueryParts :: Tree ReadNode -> ([SqlFragment], [SqlFragment]) -> ([SqlFragment], [SqlFragment])
+    getQueryParts (Node n@(_, (name, Just Relation{relType=Child,relTable=Table{tableName=table}}, alias)) forst) (j,s) = (j,sel:s)
       where
         sel = "COALESCE(("
-           <> "SELECT array_to_json(array_agg(row_to_json("<>table<>"))) "
-           <> "FROM (" <> subquery <> ") " <> table
-           <> "), '[]') AS " <> pgFmtIdent name
+           <> "SELECT array_to_json(array_agg(row_to_json("<>pgFmtIdent table<>"))) "
+           <> "FROM (" <> subquery <> ") " <> pgFmtIdent table
+           <> "), '[]') AS " <> pgFmtIdent (fromMaybe name alias)
            where subquery = requestToQuery schema (DbRead (Node n forst))
-    getQueryParts (Node n@(_, (name, Just (Relation {relType=Parent,relTable=Table{tableName=table}}))) forst) (j,s) = (joi:j,sel:s)
+    getQueryParts (Node n@(_, (name, Just r@Relation{relType=Parent,relTable=Table{tableName=table}}, alias)) forst) (j,s) = (joi:j,sel:s)
       where
-        sel = "row_to_json(" <> table <> ".*) AS "<>pgFmtIdent name --TODO must be singular
-        joi = ("( " <> subquery <> " ) AS " <> table, table)
+        node_name = fromMaybe name alias
+        local_table_name = table <> "_" <> node_name
+        replaceTableName localTableName (Filter a b (VForeignKey (QualifiedIdentifier "" _) c)) = Filter a b (VForeignKey (QualifiedIdentifier "" localTableName) c)
+        replaceTableName _ x = x
+        sel = "row_to_json(" <> pgFmtIdent local_table_name <> ".*) AS " <> pgFmtIdent node_name
+        joi = " LEFT OUTER JOIN ( " <> subquery <> " ) AS " <> pgFmtIdent local_table_name  <>
+              " ON " <> intercalate " AND " ( map (pgFmtCondition qi . replaceTableName local_table_name) (getJoinConditions r) )
           where subquery = requestToQuery schema (DbRead (Node n forst))
-    getQueryParts (Node n@(_, (name, Just (Relation {relType=Many,relTable=Table{tableName=table}}))) forst) (j,s) = (j,sel:s)
+    getQueryParts (Node n@(_, (name, Just Relation{relType=Many,relTable=Table{tableName=table}}, alias)) forst) (j,s) = (j,sel:s)
       where
         sel = "COALESCE (("
-           <> "SELECT array_to_json(array_agg(row_to_json("<>table<>"))) "
-           <> "FROM (" <> subquery <> ") " <> table
-           <> "), '[]') AS " <> pgFmtIdent name
+           <> "SELECT array_to_json(array_agg(row_to_json("<>pgFmtIdent table<>"))) "
+           <> "FROM (" <> subquery <> ") " <> pgFmtIdent table
+           <> "), '[]') AS " <> pgFmtIdent (fromMaybe name alias)
            where subquery = requestToQuery schema (DbRead (Node n forst))
     --the following is just to remove the warning
     --getQueryParts is not total but requestToQuery is called only after addJoinConditions which ensures the only
     --posible relations are Child Parent Many
-    getQueryParts (Node (_,(_,Nothing)) _) _ = undefined
+    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, ", ?)"
-    ]
+      colsString = intercalate ", " cols
+      insInto = unwords [ "INSERT INTO" , fromQi qi,
+          if T.null colsString then "" else "(" <> colsString <> ")"
+        ]
+      vals = unwords $ if T.null colsString
+                then ["DEFAULT VALUES"]
+                else ["SELECT", colsString, "FROM json_populate_recordset(null::" , fromQi qi, ", $1)"] in
+  insInto <> vals
+
 requestToQuery schema (DbMutate (Update mainTbl (PayloadJSON (UniformObjects rows)) conditions)) =
   case rows V.!? 0 of
     Just obj ->
@@ -315,7 +358,6 @@ requestToQuery schema (DbMutate (Update mainTbl (PayloadJSON (UniformObjects row
     Nothing -> undefined
   where
     qi = QualifiedIdentifier schema mainTbl
-
 requestToQuery schema (DbMutate (Delete mainTbl conditions)) =
   query
   where
@@ -340,7 +382,7 @@ asCsvF :: SqlFragment
 asCsvF = asCsvHeaderF <> " || '\n' || " <> asCsvBodyF
   where
     asCsvHeaderF =
-      "(SELECT string_agg(a.k, ',')" <>
+      "(SELECT coalesce(string_agg(a.k, ','), '')" <>
       "  FROM (" <>
       "    SELECT json_object_keys(r)::TEXT as k" <>
       "    FROM ( " <>
@@ -351,26 +393,27 @@ asCsvF = asCsvHeaderF <> " || '\n' || " <> asCsvBodyF
     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"
+asJsonF = "coalesce(array_to_json(array_agg(row_to_json(t))), '[]')::character varying"
 
 asJsonSingleF :: SqlFragment --TODO! unsafe when the query actually returns multiple rows, used only on inserting and returning single element
-asJsonSingleF = "string_agg(row_to_json(t)::text, ',')::character varying "
+asJsonSingleF = "coalesce(string_agg(row_to_json(t)::text, ','), '')::character varying "
 
 locationF :: [Text] -> SqlFragment
 locationF pKeys =
     "(" <>
     " WITH s AS (SELECT row_to_json(ss) as r from " <> sourceCTEName <> " as ss  limit 1)" <>
-    " SELECT string_agg(json_data.key || '=' || coalesce( 'eq.' || json_data.value, 'is.null'), '&')" <>
+    " SELECT array_agg(json_data.key || '=' || coalesce('eq.' || json_data.value, 'is.null'))" <>
     " FROM s, json_each_text(s.r) AS json_data" <>
     (
       if null pKeys
       then ""
       else " WHERE json_data.key IN ('" <> intercalate "','" pKeys <> "')"
-    ) <>
-    ")"
+    ) <> ")"
 
 limitF :: NonnegRange -> SqlFragment
-limitF r  = "LIMIT " <> limit <> " OFFSET " <> offset
+limitF r  = if r == allRange
+  then ""
+  else "LIMIT " <> limit <> " OFFSET " <> offset
   where
     limit  = maybe "ALL" (cs . show) $ rangeLimit r
     offset = cs . show $ rangeOffset r
@@ -395,6 +438,9 @@ getJoinConditions (Relation t cols ft fcs typ lt lc1 lc2) =
     toFilter :: Text -> Text -> Column -> Column -> Filter
     toFilter tb ftb c fc = Filter (colName c, Nothing) "=" (VForeignKey (QualifiedIdentifier s tb) (ForeignKey fc{colTable=(colTable fc){tableName=ftb}}))
 
+unicodeStatement :: Text -> HE.Params a -> HD.Result b -> Bool -> H.Query a b
+unicodeStatement = H.statement . T.encodeUtf8
+
 emptyOnNull :: Text -> [a] -> Text
 emptyOnNull val x = if null x then "" else val
 
@@ -415,8 +461,8 @@ 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
+pgFmtSelectItem table (f@(_, jp), Nothing, alias) = pgFmtField table f <> pgFmtAs jp alias
+pgFmtSelectItem table (f@(_, jp), Just cast, alias) = "CAST (" <> pgFmtField table f <> " AS " <> cast <> " )" <> pgFmtAs jp alias
 
 pgFmtCondition :: QualifiedIdentifier -> Filter -> SqlFragment
 pgFmtCondition table (Filter (col,jp) ops val) =
@@ -463,9 +509,10 @@ pgFmtJsonPath (Just [x]) = "->>" <> pgFmtLit x
 pgFmtJsonPath (Just (x:xs)) = "->" <> pgFmtLit x <> pgFmtJsonPath ( Just xs )
 pgFmtJsonPath _ = ""
 
-pgFmtAsJsonPath :: Maybe JsonPath -> SqlFragment
-pgFmtAsJsonPath Nothing = ""
-pgFmtAsJsonPath (Just xx) = " AS " <> last xx
+pgFmtAs :: Maybe JsonPath -> Maybe Alias -> SqlFragment
+pgFmtAs Nothing Nothing = ""
+pgFmtAs (Just xx) Nothing = " AS " <> pgFmtIdent (last xx)
+pgFmtAs _ (Just alias) = " AS " <> pgFmtIdent alias
 
 trimNullChars :: Text -> Text
 trimNullChars = T.takeWhile (/= '\x0')

src/PostgREST/RangeQuery.hs

@@ -4,13 +4,14 @@ module PostgREST.RangeQuery (
 , rangeLimit
 , rangeOffset
 , restrictRange
+, rangeGeq
+, allRange
 , NonnegRange
 ) where
 
 
 import           Control.Applicative
 import           Network.HTTP.Types.Header
-import           PostgREST.Types           ()
 
 import qualified Data.ByteString.Char8     as BS
 import           Data.Ranged.Boundaries
@@ -24,7 +25,7 @@ import           Data.Maybe                (fromMaybe, listToMaybe)
 
 import           Prelude
 
-type NonnegRange = Range Int
+type NonnegRange = Range Integer
 
 rangeParse :: BS.ByteString -> NonnegRange
 rangeParse range = do
@@ -34,35 +35,39 @@ rangeParse range = do
     Just parsedRange ->
       let [_, from, to] = readMaybe . cs <$> parsedRange
           lower         = fromMaybe emptyRange   (rangeGeq <$> from)
-          upper         = fromMaybe (rangeGeq 0) (rangeLeq <$> to) in
+          upper         = fromMaybe allRange (rangeLeq <$> to) in
       rangeIntersection lower upper
-    Nothing -> rangeGeq 0
+    Nothing -> allRange
 
 rangeRequested :: RequestHeaders -> NonnegRange
-rangeRequested = rangeParse . fromMaybe "" . lookup hRange
+rangeRequested headers = fromMaybe allRange $
+  rangeParse <$> lookup hRange headers
 
-restrictRange :: Maybe Int -> NonnegRange -> NonnegRange
+restrictRange :: Maybe Integer -> NonnegRange -> NonnegRange
 restrictRange Nothing r = r
 restrictRange (Just limit) r =
-  rangeIntersection r $
-    Range BoundaryBelowAll (BoundaryAbove $ rangeOffset r + limit - 1)
+   rangeIntersection r $
+     Range BoundaryBelowAll (BoundaryAbove $ rangeOffset r + limit - 1)
 
-rangeLimit :: NonnegRange -> Maybe Int
+rangeLimit :: NonnegRange -> Maybe Integer
 rangeLimit range =
   case [rangeLower range, rangeUpper range] of
     [BoundaryBelow from, BoundaryAbove to] -> Just (1 + to - from)
     _ -> Nothing
 
-rangeOffset :: NonnegRange -> Int
+rangeOffset :: NonnegRange -> Integer
 rangeOffset range =
   case rangeLower range of
     BoundaryBelow from -> from
     _ -> error "range without lower bound" -- should never happen
 
-rangeGeq :: Int -> NonnegRange
+rangeGeq :: Integer -> NonnegRange
 rangeGeq n =
   Range (BoundaryBelow n) BoundaryAboveAll
 
-rangeLeq :: Int -> NonnegRange
+allRange :: NonnegRange
+allRange = rangeGeq 0
+
+rangeLeq :: Integer -> NonnegRange
 rangeLeq n =
   Range BoundaryBelowAll (BoundaryAbove n)

src/PostgREST/Types.hs

@@ -1,15 +1,17 @@
 module PostgREST.Types where
-import Data.Text
-import Data.Tree
-import qualified Data.ByteString.Lazy as BL
+import           Data.Aeson
 import qualified Data.ByteString      as BS
+import qualified Data.ByteString.Lazy as BL
+import           Data.Int             (Int32)
+import           Data.Text
+import           Data.Tree
 import qualified Data.Vector          as V
-import Data.Aeson
+import           PostgREST.RangeQuery (NonnegRange)
 
 data DbStructure = DbStructure {
-  dbTables :: [Table]
-, dbColumns :: [Column]
-, dbRelations :: [Relation]
+  dbTables      :: [Table]
+, dbColumns     :: [Column]
+, dbRelations   :: [Relation]
 , dbPrimaryKeys :: [PrimaryKey]
 } deriving (Show, Eq)
 
@@ -31,12 +33,12 @@ data Column =
     Column {
       colTable     :: Table
     , colName      :: Text
-    , colPosition  :: Int
+    , colPosition  :: Int32
     , colNullable  :: Bool
     , colType      :: Text
     , colUpdatable :: Bool
-    , colMaxLen    :: Maybe Int
-    , colPrecision :: Maybe Int
+    , colMaxLen    :: Maybe Int32
+    , colPrecision :: Maybe Int32
     , colDefault   :: Maybe Text
     , colEnum      :: [Text]
     , colFK        :: Maybe ForeignKey
@@ -90,6 +92,9 @@ data Relation = Relation {
 newtype UniformObjects = UniformObjects (V.Vector Object)
   deriving (Show, Eq)
 
+unUniformObjects :: UniformObjects -> V.Vector Object
+unUniformObjects (UniformObjects objs) = objs
+
 -- | When Hasql supports the COPY command then we can
 -- have a special payload just for CSV, but until
 -- then CSV is converted to a JSON array.
@@ -102,16 +107,17 @@ data FValue = VText Text | VForeignKey QualifiedIdentifier ForeignKey deriving (
 type FieldName = Text
 type JsonPath = [Text]
 type Field = (FieldName, Maybe JsonPath)
+type Alias = Text
 type Cast = Text
 type NodeName = Text
-type SelectItem = (Field, Maybe Cast)
+type SelectItem = (Field, Maybe Cast, Maybe Alias)
 type Path = [Text]
-data ReadQuery = Select { select::[SelectItem], from::[TableName], flt_::[Filter], order::Maybe [OrderTerm] } deriving (Show, Eq)
+data ReadQuery = Select { select::[SelectItem], from::[TableName], flt_::[Filter], order::Maybe [OrderTerm], range_::NonnegRange } deriving (Show, Eq)
 data MutateQuery = Insert { in_::TableName, qPayload::Payload }
                  | Delete { in_::TableName, where_::[Filter] }
                  | Update { in_::TableName, qPayload::Payload, where_::[Filter] } deriving (Show, Eq)
 data Filter = Filter {field::Field, operator::Operator, value::FValue} deriving (Show, Eq)
-type ReadNode = (ReadQuery, (NodeName, Maybe Relation))
+type ReadNode = (ReadQuery, (NodeName, Maybe Relation, Maybe Alias))
 type ReadRequest = Tree ReadNode
 type MutateRequest = MutateQuery
 data DbRequest = DbRead ReadRequest | DbMutate MutateRequest

stack.yaml

@@ -1,7 +1,24 @@
-flags: {}
-packages:
-- '.'
+resolver: lts-6.2
 extra-deps:
   - Ranged-sets-0.3.0
-  - packdeps-0.4.1
-resolver: nightly-2015-10-27
+  - bytestring-tree-builder-0.2.7
+  - hasql-0.19.12
+  - hasql-pool-0.4.1
+  - hasql-transaction-0.4.5
+  - jwt-0.7.2
+  - postgresql-binary-0.9.0.1
+  - binary-parser-0.5.2
+  - contravariant-extras-0.3.2
+  - placeholders-0.1
+  - postgresql-error-codes-1
+  - success-0.2.6
+  - tuple-th-0.2.5
+  - wai-cors-0.2.5
+  - cryptohash-sha256-0.11.100.0
+  - hackage-security-0.5.2.1
+
+ghc-options:
+  postgrest: -O2 -Werror -Wall -fwarn-identities
+
+packages:
+- .

test/Feature/AuthSpec.hs

@@ -6,28 +6,61 @@ import Test.Hspec.Wai
 import Test.Hspec.Wai.JSON
 import Network.HTTP.Types
 
-import Hasql as H
-import Hasql.Postgres as P
-
 import SpecHelper
-import PostgREST.Types (DbStructure(..))
+import Network.Wai (Application)
 -- }}}
 
-spec :: DbStructure -> H.Pool P.Postgres -> Spec
-spec struct pool = around (withApp cfgDefault struct pool)
-  $ describe "authorization" $ do
+spec :: SpecWith Application
+spec = describe "authorization" $ do
 
-  it "hides tables that anonymous does not own" $
-    get "/authors_only" `shouldRespondWith` 404
+  it "denies access to tables that anonymous does not own" $
+    get "/authors_only" `shouldRespondWith` ResponseMatcher {
+        matchBody = Just [json| {
+          "hint":null,
+          "details":null,
+          "code":"42501",
+          "message":"permission denied for relation authors_only"} |]
+      , matchStatus = 401
+      , matchHeaders = ["WWW-Authenticate" <:> "Bearer"]
+      }
+
+  it "denies access to tables that postgrest_test_author does not own" $
+    let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJyb2xlIjoicG9zdGdyZXN0X3Rlc3RfYXV0aG9yIiwiaWQiOiJqZG9lIn0.y4vZuu1dDdwAl0-S00MCRWRYMlJ5YAMSir6Es6WtWx0" in
+    request methodGet "/private_table" [auth] ""
+      `shouldRespondWith` ResponseMatcher {
+        matchBody = Just [json| {
+          "hint":null,
+          "details":null,
+          "code":"42501",
+          "message":"permission denied for relation private_table"} |]
+      , matchStatus = 403
+      , matchHeaders = []
+      }
 
   it "returns jwt functions as jwt tokens" $
     post "/rpc/login" [json| { "id": "jdoe", "pass": "1234" } |]
       `shouldRespondWith` ResponseMatcher {
           matchBody = Just [json| {"token":"eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJyb2xlIjoicG9zdGdyZXN0X3Rlc3RfYXV0aG9yIiwiaWQiOiJqZG9lIn0.y4vZuu1dDdwAl0-S00MCRWRYMlJ5YAMSir6Es6WtWx0"} |]
         , matchStatus = 200
-        , matchHeaders = ["Content-Type" <:> "application/json"]
+        , matchHeaders = ["Content-Type" <:> "application/json; charset=utf-8"]
         }
 
+  it "sql functions can encode custom and standard claims" $
+    post "/rpc/jwt_test" "{}"
+      `shouldRespondWith` ResponseMatcher {
+          matchBody = Just [json| {"token":"eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJzdWIiOiJmdW4iLCJqdGkiOiJmb28iLCJuYmYiOjEzMDA4MTkzODAsImV4cCI6MTMwMDgxOTM4MCwiaHR0cDovL3Bvc3RncmVzdC5jb20vZm9vIjp0cnVlLCJpc3MiOiJqb2UiLCJyb2xlIjoicG9zdGdyZXN0X3Rlc3QiLCJpYXQiOjEzMDA4MTkzODAsImF1ZCI6ImV2ZXJ5b25lIn0._tQCF79-ZZGMlLktd3csM_bVaiMg7A8YvIb6K2hcu5w"} |]
+        , matchStatus = 200
+        , matchHeaders = ["Content-Type" <:> "application/json; charset=utf-8"]
+        }
+
+  it "sql functions can read custom and standard claims variables" $ do
+    let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJzdWIiOiJmdW4iLCJqdGkiOiJmb28iLCJuYmYiOjEzMDA4MTkzODAsImV4cCI6OTk5OTk5OTk5OSwiaHR0cDovL3Bvc3RncmVzdC5jb20vZm9vIjp0cnVlLCJpc3MiOiJqb2UiLCJyb2xlIjoicG9zdGdyZXN0X3Rlc3RfYXV0aG9yIiwiaWF0IjoxMzAwODE5MzgwLCJhdWQiOiJldmVyeW9uZSJ9.AQmCA7CMScvfaDRMqRPeUY6eNf--69gpW-kxaWfq9X0"
+    request methodPost "/rpc/reveal_big_jwt" [auth] "{}"
+      `shouldRespondWith` [json| [
+          {"sub":"fun", "jti":"foo", "nbf":1300819380, "exp":9999999999,
+          "http://postgrest.com/foo":true, "iss":"joe", "iat":1300819380,
+          "aud":"everyone"}] |]
+
   it "allows users with permissions to see their tables" $ do
     let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJyb2xlIjoicG9zdGdyZXN0X3Rlc3RfYXV0aG9yIiwiaWQiOiJqZG9lIn0.y4vZuu1dDdwAl0-S00MCRWRYMlJ5YAMSir6Es6WtWx0"
     request methodGet "/authors_only" [auth] ""

test/Feature/ConcurrentSpec.hs

@@ -0,0 +1,51 @@
+{-# LANGUAGE MultiParamTypeClasses, TypeFamilies, UndecidableInstances #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+module Feature.ConcurrentSpec where
+
+import Control.Monad (void)
+import Control.Monad.Base
+
+import Control.Monad.Trans.Control
+import Control.Concurrent.Async (mapConcurrently)
+
+import Test.Hspec hiding (pendingWith)
+import Test.Hspec.Wai.Internal
+import Test.Hspec.Wai
+import Test.Hspec.Wai.JSON
+import Network.Wai.Test (Session)
+
+import Network.Wai (Application)
+
+spec :: SpecWith Application
+spec =
+  describe "Queryiny in parallel" $
+    it "should not raise 'transaction in progress' error" $
+      raceTest 10 $
+        get "/fakefake"
+          `shouldRespondWith` ResponseMatcher {
+            matchBody    = Just [json|
+              { "hint": null,
+                "details":null,
+                "code":"42P01",
+                "message":"relation \"test.fakefake\" does not exist"
+              } |]
+          , matchStatus  = 404
+          , matchHeaders = []
+          }
+
+raceTest :: Int -> WaiExpectation -> WaiExpectation
+raceTest times = liftBaseDiscard go
+ where
+  go test = void $ mapConcurrently (const test) [1..times]
+
+instance MonadBaseControl IO WaiSession where
+  type StM WaiSession a = StM Session a
+  liftBaseWith f = WaiSession $
+    liftBaseWith $ \runInBase ->
+      f $ \k -> runInBase (unWaiSession k)
+  restoreM = WaiSession . restoreM
+  {-# INLINE liftBaseWith #-}
+  {-# INLINE restoreM #-}
+
+instance MonadBase IO WaiSession where
+  liftBase = liftIO

test/Feature/CorsSpec.hs

@@ -6,17 +6,15 @@ import Test.Hspec.Wai
 import Network.Wai.Test (SResponse(simpleHeaders, simpleBody))
 import qualified Data.ByteString.Lazy as BL
 
-import Hasql as H
-import Hasql.Postgres as P
-
 import SpecHelper
-import PostgREST.Types (DbStructure(..))
 
 import Network.HTTP.Types
+import Network.Wai (Application)
 -- }}}
 
-spec :: DbStructure -> H.Pool P.Postgres -> Spec
-spec struct pool = around (withApp cfgDefault struct pool) $ describe "CORS" $ do
+spec :: SpecWith Application
+spec =
+  describe "CORS" $ do
     let preflightHeaders = [
           ("Accept", "*/*"),
           ("Origin", "http://example.com"),

test/Feature/DeleteSpec.hs

@@ -4,17 +4,11 @@ import Test.Hspec
 import Test.Hspec.Wai
 import Text.Heredoc
 
-import Hasql as H
-import Hasql.Postgres as P
-
-import SpecHelper
-import PostgREST.Types (DbStructure(..))
-
 import Network.HTTP.Types
+import Network.Wai (Application)
 
-spec :: DbStructure -> H.Pool P.Postgres -> Spec
-spec struct pool = beforeAll resetDb
-  . around (withApp cfgDefault struct pool) $
+spec :: SpecWith Application
+spec =
   describe "Deleting" $ do
     context "existing record" $ do
       it "succeeds with 204 and deletion count" $
@@ -25,6 +19,28 @@ spec struct pool = beforeAll resetDb
           , matchHeaders = ["Content-Range" <:> "*/1"]
           }
 
+      it "returns the deleted item" $
+        request methodDelete "/items?id=eq.2" [("Prefer", "return=representation")] ""
+          `shouldRespondWith` ResponseMatcher {
+            matchBody    = Just [str|[{"id":2}]|]
+          , matchStatus  = 200
+          , matchHeaders = ["Content-Range" <:> "*/1"]
+          }
+      it "returns the deleted item and shapes the response" $
+        request methodDelete "/complex_items?id=eq.2&select=id,name" [("Prefer", "return=representation")] ""
+          `shouldRespondWith` ResponseMatcher {
+            matchBody    = Just [str|[{"id":2,"name":"Two"}]|]
+          , matchStatus  = 200
+          , matchHeaders = ["Content-Range" <:> "*/1"]
+          }
+      it "can embed (parent) entities" $
+        request methodDelete "/tasks?id=eq.8&select=id,name,project{id}" [("Prefer", "return=representation")] ""
+          `shouldRespondWith` ResponseMatcher {
+            matchBody    = Just [str|[{"id":8,"name":"Code OSX","project":{"id":4}}]|]
+          , matchStatus  = 200
+          , matchHeaders = ["Content-Range" <:> "*/1"]
+          }
+
       it "actually clears items ouf the db" $ do
         _ <- request methodDelete "/items?id=lt.15" [] ""
         get "/items"

test/Feature/InsertSpec.hs

@@ -5,25 +5,23 @@ import Test.Hspec.Wai
 import Test.Hspec.Wai.JSON
 import Network.Wai.Test (SResponse(simpleBody,simpleHeaders,simpleStatus))
 
-import Hasql as H
-import Hasql.Postgres as P
-
 import SpecHelper
-import PostgREST.Types (DbStructure(..))
 
 import qualified Data.Aeson as JSON
 import Data.Maybe (fromJust)
+import Data.Monoid ((<>))
 import Text.Heredoc
 import Network.HTTP.Types.Header
 import Network.HTTP.Types
-import Control.Monad (replicateM_)
+import Control.Monad (replicateM_, void)
 
 import TestTypes(IncPK(..), CompoundPK(..))
+import Network.Wai (Application)
 
-spec :: DbStructure -> H.Pool P.Postgres -> Spec
-spec struct pool = beforeAll_ resetDb $ around (withApp cfgDefault struct pool) $ do
+spec :: SpecWith Application
+spec = do
   describe "Posting new record" $ do
-    after_ (clearTable "menagerie") . context "disparate csv types" $ do
+    context "disparate json types" $ do
       it "accepts disparate json types" $ do
         p <- post "/menagerie"
           [json| {
@@ -34,6 +32,8 @@ spec struct pool = beforeAll_ resetDb $ around (withApp cfgDefault struct pool)
         liftIO $ do
           simpleBody p `shouldBe` ""
           simpleStatus p `shouldBe` created201
+          -- should not have content type set when body is empty
+          lookup hContentType (simpleHeaders p) `shouldBe` Nothing
 
       it "filters columns in result using &select" $
         request methodPost "/menagerie?select=integer,varchar" [("Prefer", "return=representation")]
@@ -44,7 +44,7 @@ spec struct pool = beforeAll_ resetDb $ around (withApp cfgDefault struct pool)
           } |] `shouldRespondWith` ResponseMatcher {
             matchBody    = Just [str|{"integer":14,"varchar":"testing!"}|]
           , matchStatus  = 201
-          , matchHeaders = ["Content-Type" <:> "application/json"]
+          , matchHeaders = ["Content-Type" <:> "application/json; charset=utf-8"]
           }
 
       it "includes related data after insert" $
@@ -52,12 +52,21 @@ spec struct pool = beforeAll_ resetDb $ around (withApp cfgDefault struct pool)
           [str|{"id":6,"name":"New Project","client_id":2}|] `shouldRespondWith` ResponseMatcher {
             matchBody    = Just [str|{"id":6,"name":"New Project","clients":{"id":2,"name":"Apple"}}|]
           , matchStatus  = 201
-          , matchHeaders = ["Content-Type" <:> "application/json", "Location" <:> "/projects?id=eq.6"]
+          , matchHeaders = ["Content-Type" <:> "application/json; charset=utf-8", "Location" <:> "/projects?id=eq.6"]
           }
 
+    context "from an html form" $
+      it "accepts disparate json types" $ do
+        p <- request methodPost "/menagerie"
+               [("Content-Type", "application/x-www-form-urlencoded")]
+               ("integer=7&double=2.71828&varchar=forms+are+fun&" <>
+                "boolean=false&date=1900-01-01&money=$3.99&enum=foo")
+        liftIO $ do
+          simpleBody p `shouldBe` ""
+          simpleStatus p `shouldBe` created201
 
     context "with no pk supplied" $ do
-      context "into a table with auto-incrementing pk" . after_ (clearTable "auto_incrementing_pk") $
+      context "into a table with auto-incrementing pk" $
         it "succeeds with 201 and link" $ do
           p <- post "/auto_incrementing_pk" [json| { "non_nullable_string":"not null"} |]
           liftIO $ do
@@ -76,7 +85,7 @@ spec struct pool = beforeAll_ resetDb $ around (withApp cfgDefault struct pool)
           post "/simple_pk" [json| { "extra":"foo"} |]
             `shouldRespondWith` 400
 
-      context "into a table with no pk" . after_ (clearTable "no_pk") $ do
+      context "into a table with no pk" $ do
         it "succeeds with 201 and a link including all fields" $ do
           p <- post "/no_pk" [json| { "a":"foo", "b":"bar" } |]
           liftIO $ do
@@ -111,58 +120,86 @@ spec struct pool = beforeAll_ resetDb $ around (withApp cfgDefault struct pool)
             simpleHeaders p `shouldSatisfy` matchHeader hLocation "/no_pk\\?a=is.null&b=eq.foo"
             simpleStatus p `shouldBe` created201
 
-    context "with compound pk supplied" . after_ (clearTable "compound_pk") $
-      it "builds response location header appropriately" $
-        post "/compound_pk" [json| { "k1":12, "k2":42 } |]
-          `shouldRespondWith` ResponseMatcher {
-            matchBody    = Nothing,
-            matchStatus  = 201,
-            matchHeaders = ["Location" <:> "/compound_pk?k1=eq.12&k2=eq.42"]
-          }
+    context "with compound pk supplied" $
+      it "builds response location header appropriately" $ do
+        let inserted    = [json| { "k1":12, "k2":"Rock & R+ll" } |]
+            expectedObj = CompoundPK 12 "Rock & R+ll" Nothing
+            expectedLoc = "/compound_pk?k1=eq.12&k2=eq.Rock%20%26%20R%2Bll"
+        p <- request methodPost "/compound_pk"
+                     [("Prefer", "return=representation")]
+                     inserted
+        liftIO $ do
+          JSON.decode (simpleBody p) `shouldBe` Just expectedObj
+          simpleStatus p `shouldBe` created201
+          lookup hLocation (simpleHeaders p) `shouldBe` Just expectedLoc
+
+        r <- get expectedLoc
+        liftIO $ do
+          JSON.decode (simpleBody r) `shouldBe` Just [expectedObj]
+          simpleStatus r `shouldBe` ok200
+
+    context "with bulk insert" $
+      it "returns 201 but no location header" $ do
+        let bulkData = [json| [ {"k1":21, "k2":"hello world"}
+                              , {"k1":22, "k2":"bye for now"}]
+                            |]
+        p <- request methodPost "/compound_pk" [] bulkData
+        liftIO $ do
+          simpleStatus p `shouldBe` created201
+          lookup hLocation (simpleHeaders p) `shouldBe` Nothing
 
     context "with invalid json payload" $
       it "fails with 400 and error" $
         post "/simple_pk" "}{ x = 2" `shouldRespondWith` 400
 
-    context "jsonb" . after_ (clearTable "json") $ do
+    context "with valid json payload" $
+      it "succeeds and returns 201 created" $
+        post "/simple_pk" [json| { "k":"k1", "extra":"e1" } |] `shouldRespondWith` 201
+
+    context "attempting to insert a row with the same primary key" $
+      it "fails returning a 409 Conflict" $
+        post "/simple_pk" [json| { "k":"k1", "extra":"e1" } |] `shouldRespondWith` 409
+
+    context "attempting to insert a row with conflicting unique constraint" $
+      it "fails returning a 409 Conflict" $
+        post "/withUnique"  [json| { "uni":"nodup", "extra":"e2" } |] `shouldRespondWith` 409
+
+    context "jsonb" $ do
       it "serializes nested object" $ do
         let inserted = [json| { "data": { "foo":"bar" } } |]
+            location = "/json?data=eq.%7B%22foo%22%3A%22bar%22%7D"
         request methodPost "/json"
                      [("Prefer", "return=representation")]
                      inserted
           `shouldRespondWith` ResponseMatcher {
             matchBody    = Just inserted
           , matchStatus  = 201
-          , matchHeaders = ["Location" <:> [str|/json?data=eq.{"foo":"bar"}|]]
+          , matchHeaders = ["Location" <:> location]
           }
 
-        -- 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] } |]
+            location = "/json?data=eq.%5B1%2C2%2C3%5D"
         request methodPost "/json"
                      [("Prefer", "return=representation")]
                      inserted
           `shouldRespondWith` ResponseMatcher {
             matchBody    = Just inserted
           , matchStatus  = 201
-          , matchHeaders = ["Location" <:> [str|/json?data=eq.[1,2,3]|]]
+          , matchHeaders = ["Location" <:> location]
+          }
+
+    context "empty object" $
+      it "successfully populates table with all-default columns" $
+        post "/items" "{}" `shouldRespondWith` ResponseMatcher {
+            matchBody    = Just ""
+          , matchStatus  = 201
+          , matchHeaders = []
           }
-        -- 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" $
+    context "disparate csv types" $
       it "succeeds with multipart response" $ do
         pendingWith "Decide on what to do with CSV insert"
         let inserted = [str|integer,double,varchar,boolean,date,money,enum
@@ -174,18 +211,10 @@ spec struct pool = beforeAll_ resetDb $ around (withApp cfgDefault struct pool)
            `shouldRespondWith` ResponseMatcher {
              matchBody    = Just inserted
            , matchStatus  = 201
-           , matchHeaders = ["Content-Type" <:> "text/csv"]
+           , matchHeaders = ["Content-Type" <:> "text/csv; charset=utf-8"]
            }
-        -- 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
+    context "requesting full representation" $ do
       it "returns full details of inserted record" $
         request methodPost "/no_pk"
                      [("Content-Type", "text/csv"), ("Accept", "text/csv"),  ("Prefer", "return=representation")]
@@ -193,21 +222,10 @@ spec struct pool = beforeAll_ resetDb $ around (withApp cfgDefault struct pool)
           `shouldRespondWith` ResponseMatcher {
             matchBody    = Just "a,b\nbar,baz"
           , matchStatus  = 201
-          , matchHeaders = ["Content-Type" <:> "text/csv",
+          , matchHeaders = ["Content-Type" <:> "text/csv; charset=utf-8",
                             "Location" <:> "/no_pk?a=eq.bar&b=eq.baz"]
           }
 
-      -- it "can post nulls (old way)" $ do
-      --   pendingWith "changed the response when in csv mode"
-      --   request methodPost "/no_pk"
-      --                [("Content-Type", "text/csv"), ("Prefer", "return=representation")]
-      --                "a,b\nNULL,foo"
-      --     `shouldRespondWith` ResponseMatcher {
-      --       matchBody    = Just [json| { "a":null, "b":"foo" } |]
-      --     , matchStatus  = 201
-      --     , matchHeaders = ["Content-Type" <:> "application/json",
-      --                       "Location" <:> "/no_pk?a=is.null&b=eq.foo"]
-      --     }
       it "can post nulls" $
         request methodPost "/no_pk"
                      [("Content-Type", "text/csv"), ("Accept", "text/csv"), ("Prefer", "return=representation")]
@@ -215,23 +233,34 @@ spec struct pool = beforeAll_ resetDb $ around (withApp cfgDefault struct pool)
           `shouldRespondWith` ResponseMatcher {
             matchBody    = Just "a,b\n,foo"
           , matchStatus  = 201
-          , matchHeaders = ["Content-Type" <:> "text/csv",
+          , matchHeaders = ["Content-Type" <:> "text/csv; charset=utf-8",
                             "Location" <:> "/no_pk?a=is.null&b=eq.foo"]
           }
 
 
-    after_ (clearTable "no_pk") . context "with wrong number of columns" $
+    context "with wrong number of columns" $
       it "fails for too few" $ do
         p <- request methodPost "/no_pk" [("Content-Type", "text/csv")] "a,b\nfoo,bar\nbaz"
         liftIO $ simpleStatus p `shouldBe` badRequest400
-      -- it does not fail because the extra columns are ignored
-      -- it "fails for too many" $ do
-      --   p <- request methodPost "/no_pk" [("Content-Type", "text/csv")] "a,b\nfoo,bar\nbaz,bat,bad"
-      --   liftIO $ simpleStatus p `shouldBe` badRequest400
+
+    context "with unicode values" $
+      it "succeeds and returns usable location header" $ do
+        let payload = [json| { "a":"圍棋", "b":"￥" } |]
+        p <- request methodPost "/no_pk"
+                     [("Prefer", "return=representation")]
+                     payload
+        liftIO $ do
+          simpleBody p `shouldBe` payload
+          simpleStatus p `shouldBe` created201
+
+        let Just location = lookup hLocation $ simpleHeaders p
+        r <- get location
+        liftIO $ simpleBody r `shouldBe` "["<>payload<>"]"
+
 
   describe "Putting record" $ do
 
-    context "to unkonwn uri" $
+    context "to unknown uri" $
       it "gives a 404" $ do
         pendingWith "Decide on PUT usefullness"
         request methodPut "/fake" []
@@ -255,7 +284,7 @@ spec struct pool = beforeAll_ resetDb $ around (withApp cfgDefault struct pool)
               [json| { "k1":12, "k2":42 } |]
                 `shouldRespondWith` 400
 
-        context "specifying every column in the table" . after_ (clearTable "compound_pk") $ do
+        context "specifying every column in the table" $ do
           it "can create a new record" $ do
             pendingWith "Decide on PUT usefullness"
             p <- request methodPut "/compound_pk?k1=eq.12&k2=eq.42" []
@@ -270,7 +299,7 @@ spec struct pool = beforeAll_ resetDb $ around (withApp cfgDefault struct pool)
               length rows `shouldBe` 1
               let record = head rows
               compoundK1 record `shouldBe` 12
-              compoundK2 record `shouldBe` 42
+              compoundK2 record `shouldBe` "42"
               compoundExtra record `shouldBe` Just 3
 
           it "can update an existing record" $ do
@@ -287,7 +316,7 @@ spec struct pool = beforeAll_ resetDb $ around (withApp cfgDefault struct pool)
               let record = head rows
               compoundExtra record `shouldBe` Just 5
 
-      context "with an auto-incrementing primary key" . after_ (clearTable "auto_incrementing_pk") $
+      context "with an auto-incrementing primary key"$
 
         it "succeeds with 204" $ do
           pendingWith "Decide on PUT usefullness"
@@ -306,7 +335,7 @@ spec struct pool = beforeAll_ resetDb $ around (withApp cfgDefault struct pool)
 
   describe "Patching record" $ do
 
-    context "to unkonwn uri" $
+    context "to unknown uri" $
       it "gives a 404" $
         request methodPatch "/fake" []
           [json| { "real": false } |]
@@ -323,13 +352,15 @@ spec struct pool = beforeAll_ resetDb $ around (withApp cfgDefault struct pool)
         g <- get "/items?id=eq.42"
         liftIO $ simpleHeaders g
           `shouldSatisfy` matchHeader "Content-Range" "\\*/0"
-        request methodPatch "/items?id=eq.2" []
-          [json| { "id":42 } |]
-            `shouldRespondWith` ResponseMatcher {
-              matchBody    = Nothing,
-              matchStatus  = 204,
-              matchHeaders = ["Content-Range" <:> "0-0/1"]
-            }
+        p <- request methodPatch "/items?id=eq.2" [] [json| { "id":42 } |]
+        pure p `shouldRespondWith` ResponseMatcher {
+            matchBody    = Nothing,
+            matchStatus  = 204,
+            matchHeaders = ["Content-Range" <:> "0-0/1"]
+          }
+        liftIO $
+          lookup hContentType (simpleHeaders p) `shouldBe` Nothing
+
         g' <- get "/items?id=eq.42"
         liftIO $ simpleHeaders g'
           `shouldSatisfy` matchHeader "Content-Range" "0-0/1"
@@ -367,6 +398,28 @@ spec struct pool = beforeAll_ resetDb $ around (withApp cfgDefault struct pool)
           [json| { id: 99 } |]
           `shouldRespondWith` [json| [{id:99}] |]
 
+      it "can set a json column to escaped value" $ do
+        _ <- post "/json" [json| { data: {"escaped":"bar"} } |]
+        request methodPatch "/json?data->>escaped=eq.bar"
+                     [("Prefer", "return=representation")]
+                     [json| { "data": { "escaped":" \"bar" } } |]
+          `shouldRespondWith` ResponseMatcher {
+            matchBody    = Just [json| [{ "data": { "escaped":" \"bar" } }] |]
+          , matchStatus  = 200
+          , matchHeaders = []
+          }
+
+    context "with unicode values" $
+      it "succeeds and returns values intact" $ do
+        void $ request methodPost "/no_pk" []
+          [json| { "a":"patchme", "b":"patchme" } |]
+        let payload = [json| { "a":"圍棋", "b":"￥" } |]
+        p <- request methodPatch "/no_pk?a=eq.patchme&b=eq.patchme"
+          [("Prefer", "return=representation")] payload
+        liftIO $ do
+          simpleBody p `shouldBe` "["<>payload<>"]"
+          simpleStatus p `shouldBe` ok200
+
   describe "Row level permission" $
     it "set user_id when inserting rows" $ do
       let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJyb2xlIjoicG9zdGdyZXN0X3Rlc3RfYXV0aG9yIiwiaWQiOiJqZG9lIn0.y4vZuu1dDdwAl0-S00MCRWRYMlJ5YAMSir6Es6WtWx0"

test/Feature/QueryLimitedSpec.hs

@@ -5,30 +5,33 @@ import Test.Hspec.Wai
 import Test.Hspec.Wai.JSON
 import Network.HTTP.Types
 import Network.Wai.Test (SResponse(simpleHeaders, simpleStatus))
-
-import Hasql as H
-import Hasql.Postgres as P
-
+import Text.Heredoc
 import SpecHelper
-import PostgREST.Types (DbStructure(..))
+import Network.Wai (Application)
 
-spec :: DbStructure -> H.Pool P.Postgres -> Spec
-spec struct pool =
-  beforeAll resetDb
-   . around (withApp (cfgLimitRows 3) struct pool) $
+spec :: SpecWith Application
+spec =
   describe "Requesting many items with server limits enabled" $ do
     it "restricts results" $
       get "/items"
         `shouldRespondWith` ResponseMatcher {
-          matchBody    = Just [json| [{"id":1},{"id":2},{"id":3}] |]
+          matchBody    = Just [json| [{"id":1},{"id":2}] |]
         , matchStatus  = 206
-        , matchHeaders = ["Content-Range" <:> "0-2/15"]
+        , matchHeaders = ["Content-Range" <:> "0-1/15"]
         }
 
     it "respects additional client limiting" $ do
       r <- request methodGet  "/items"
-                   (rangeHdrs $ ByteRangeFromTo 0 1) ""
+                   (rangeHdrs $ ByteRangeFromTo 0 0) ""
       liftIO $ do
         simpleHeaders r `shouldSatisfy`
-          matchHeader "Content-Range" "0-1/15"
+          matchHeader "Content-Range" "0-0/15"
         simpleStatus r `shouldBe` partialContent206
+
+    it "limit works on all levels" $
+      get "/users?select=id,tasks{id}&order=id.asc&tasks.order=id.asc"
+        `shouldRespondWith` ResponseMatcher {
+          matchBody    = Just [str|[{"id":1,"tasks":[{"id":1},{"id":2}]},{"id":2,"tasks":[{"id":5},{"id":6}]}]|]
+        , matchStatus  = 206
+        , matchHeaders = ["Content-Range" <:> "0-1/3"]
+        }

test/Feature/QuerySpec.hs

@@ -6,15 +6,12 @@ import Test.Hspec.Wai.JSON
 import Network.HTTP.Types
 import Network.Wai.Test (SResponse(simpleHeaders))
 
-import Hasql as H
-import Hasql.Postgres as P
-
 import SpecHelper
-import PostgREST.Types (DbStructure(..))
 import Text.Heredoc
+import Network.Wai (Application)
 
-spec :: DbStructure -> H.Pool P.Postgres -> Spec
-spec struct pool = around (withApp cfgDefault struct pool) $ do
+spec :: SpecWith Application
+spec = do
 
   describe "Querying a table with a column called count" $
     it "should not confuse count column with pg_catalog.count aggregate" $
@@ -146,16 +143,29 @@ spec struct pool = around (withApp cfgDefault struct pool) $ do
 
     it "selectStar works in absense of parameter" $
       get "/complex_items?id=eq.3" `shouldRespondWith`
-        [str|[{"id":3,"name":"Three","settings":{"foo":{"int":1,"bar":"baz"}},"arr_data":[1,2,3]}]|]
+        [str|[{"id":3,"name":"Three","settings":{"foo":{"int":1,"bar":"baz"}},"arr_data":[1,2,3],"field-with_sep":1}]|]
+
+    it "dash `-` in column names is accepted" $
+      get "/complex_items?id=eq.3&select=id,field-with_sep" `shouldRespondWith`
+        [str|[{"id":3,"field-with_sep":1}]|]
 
     it "one simple column" $
       get "/complex_items?select=id" `shouldRespondWith`
         [json| [{"id":1},{"id":2},{"id":3}] |]
 
+    it "rename simple column" $
+      get "/complex_items?id=eq.1&select=myId:id" `shouldRespondWith`
+        [json| [{"myId":1}] |]
+
+
     it "one simple column with casting (text)" $
       get "/complex_items?select=id::text" `shouldRespondWith`
         [json| [{"id":"1"},{"id":"2"},{"id":"3"}] |]
 
+    it "rename simple column with casting" $
+      get "/complex_items?id=eq.1&select=myId:id::text" `shouldRespondWith`
+        [json| [{"myId":"1"}] |]
+
     it "json column" $
       get "/complex_items?id=eq.1&select=settings" `shouldRespondWith`
         [json| [{"settings":{"foo":{"int":1,"bar":"baz"}}}] |]
@@ -164,6 +174,10 @@ spec struct pool = around (withApp cfgDefault struct pool) $ do
       get "/complex_items?id=eq.1&select=settings->>foo::json" `shouldRespondWith`
         [json| [{"foo":{"int":1,"bar":"baz"}}] |] -- the value of foo here is of type "text"
 
+    it "rename json subfield one level with casting (json)" $
+      get "/complex_items?id=eq.1&select=myFoo:settings->>foo::json" `shouldRespondWith`
+        [json| [{"myFoo":{"int":1,"bar":"baz"}}] |] -- the value of foo here is of type "text"
+
     it "fails on bad casting (data of the wrong format)" $
       get "/complex_items?select=settings->foo->>bar::integer"
         `shouldRespondWith` ResponseMatcher {
@@ -185,15 +199,33 @@ spec struct pool = around (withApp cfgDefault struct pool) $ do
       get "/complex_items?id=eq.1&select=settings->foo->>bar" `shouldRespondWith`
         [json| [{"bar":"baz"}] |]
 
+    it "rename json subfield two levels (string)" $
+      get "/complex_items?id=eq.1&select=myBar:settings->foo->>bar" `shouldRespondWith`
+        [json| [{"myBar":"baz"}] |]
+
 
     it "json subfield two levels with casting (int)" $
       get "/complex_items?id=eq.1&select=settings->foo->>int::integer" `shouldRespondWith`
         [json| [{"int":1}] |] -- the value in the db is an int, but here we expect a string for now
 
+    it "rename json subfield two levels with casting (int)" $
+      get "/complex_items?id=eq.1&select=myInt:settings->foo->>int::integer" `shouldRespondWith`
+        [json| [{"myInt":1}] |] -- the value in the db is an int, but here we expect a string for now
+
     it "requesting parents and children" $
       get "/projects?id=eq.1&select=id, name, clients{*}, tasks{id, name}" `shouldRespondWith`
         [str|[{"id":1,"name":"Windows 7","clients":{"id":1,"name":"Microsoft"},"tasks":[{"id":1,"name":"Design w7"},{"id":2,"name":"Code w7"}]}]|]
 
+    it "embed data with two fk pointing to the same table" $
+      get "/orders?id=eq.1&select=id, name, billing_address_id{id}, shipping_address_id{id}" `shouldRespondWith`
+        [str|[{"id":1,"name":"order 1","billing_address_id":{"id":1},"shipping_address_id":{"id":2}}]|]
+
+
+    it "requesting parents and children while renaming them" $
+      get "/projects?id=eq.1&select=myId:id, name, project_client:client_id{*}, project_tasks:tasks{id, name}" `shouldRespondWith`
+        [str|[{"myId":1,"name":"Windows 7","project_client":{"id":1,"name":"Microsoft"},"project_tasks":[{"id":1,"name":"Design w7"},{"id":2,"name":"Code w7"}]}]|]
+
+
     it "requesting parents and filtering parent columns" $
       get "/projects?id=eq.1&select=id, name, clients{id}" `shouldRespondWith`
         [str|[{"id":1,"name":"Windows 7","clients":{"id":1}}]|]
@@ -214,6 +246,15 @@ spec struct pool = around (withApp cfgDefault struct pool) $ do
       get "/tasks?select=id,users{id}" `shouldRespondWith`
         [str|[{"id":1,"users":[{"id":1},{"id":3}]},{"id":2,"users":[{"id":1}]},{"id":3,"users":[{"id":1}]},{"id":4,"users":[{"id":1}]},{"id":5,"users":[{"id":2},{"id":3}]},{"id":6,"users":[{"id":2}]},{"id":7,"users":[{"id":2}]},{"id":8,"users":[]}]|]
 
+    it "requesting many<->many relation with rename" $
+      get "/tasks?id=eq.1&select=id,theUsers:users{id}" `shouldRespondWith`
+        [str|[{"id":1,"theUsers":[{"id":1},{"id":3}]}]|]
+
+
+    it "requesting many<->many relation reverse" $
+      get "/users?select=id,tasks{id}" `shouldRespondWith`
+        [str|[{"id":1,"tasks":[{"id":1},{"id":2},{"id":3},{"id":4}]},{"id":2,"tasks":[{"id":5},{"id":6},{"id":7}]},{"id":3,"tasks":[{"id":1},{"id":5}]}]|]
+
     it "requesting parents and children on views" $
       get "/projects_view?id=eq.1&select=id, name, clients{*}, tasks{id, name}" `shouldRespondWith`
         [str|[{"id":1,"name":"Windows 7","clients":{"id":1,"name":"Microsoft"},"tasks":[{"id":1,"name":"Design w7"},{"id":2,"name":"Code w7"}]}]|]
@@ -244,6 +285,14 @@ spec struct pool = around (withApp cfgDefault struct pool) $ do
         , matchHeaders = []
         }
 
+    it "can combine multiple prefer values" $
+      request methodGet "/items?id=eq.5" [("Prefer","plurality=singular ; future=new; count=none")] ""
+        `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
@@ -313,6 +362,28 @@ spec struct pool = around (withApp cfgDefault struct pool) $ do
     it "without other constraints" $
       get "/items?order=id.asc" `shouldRespondWith` 200
 
+    it "ordering embeded entities" $
+      get "/projects?id=eq.1&select=id, name, tasks{id, name}&tasks.order=name.asc" `shouldRespondWith`
+        [str|[{"id":1,"name":"Windows 7","tasks":[{"id":2,"name":"Code w7"},{"id":1,"name":"Design w7"}]}]|]
+
+    it "ordering embeded entities with alias" $
+      get "/projects?id=eq.1&select=id, name, the_tasks:tasks{id, name}&tasks.order=name.asc" `shouldRespondWith`
+        [str|[{"id":1,"name":"Windows 7","the_tasks":[{"id":2,"name":"Code w7"},{"id":1,"name":"Design w7"}]}]|]
+
+    it "ordering embeded entities, two levels" $
+      get "/projects?id=eq.1&select=id, name, tasks{id, name, users{id, name}}&tasks.order=name.asc&tasks.users.order=name.desc" `shouldRespondWith`
+        [str|[{"id":1,"name":"Windows 7","tasks":[{"id":2,"name":"Code w7","users":[{"id":1,"name":"Angela Martin"}]},{"id":1,"name":"Design w7","users":[{"id":3,"name":"Dwight Schrute"},{"id":1,"name":"Angela Martin"}]}]}]|]
+
+    it "ordering embeded parents does not break things" $
+      get "/projects?id=eq.1&select=id, name, clients{id, name}&clients.order=name.asc" `shouldRespondWith`
+        [str|[{"id":1,"name":"Windows 7","clients":{"id":1,"name":"Microsoft"}}]|]
+
+    it "ordering embeded parents does not break things when using ducktape names" $
+      get "/projects?id=eq.1&select=id, name, client{id, name}&client.order=name.asc" `shouldRespondWith`
+        [str|[{"id":1,"name":"Windows 7","client":{"id":1,"name":"Microsoft"}}]|]
+
+
+
   describe "Accept headers" $ do
     it "should respond an unknown accept type with 415" $
       request methodGet "/simple_pk"
@@ -335,7 +406,7 @@ spec struct pool = around (withApp cfgDefault struct pool) $ do
         `shouldRespondWith` ResponseMatcher {
           matchBody    = Just "k,extra\nxyyx,u\nxYYx,v"
         , matchStatus  = 200
-        , matchHeaders = ["Content-Type" <:> "text/csv"]
+        , matchHeaders = ["Content-Type" <:> "text/csv; charset=utf-8"]
         }
 
   describe "Canonical location" $ do
@@ -368,7 +439,17 @@ spec struct pool = around (withApp cfgDefault struct pool) $ do
         [json| [{"data": {"id": 1, "foo": {"bar": "baz"}}}] |]
 
   describe "remote procedure call" $ do
-    context "a proc that returns a set" $
+    context "a proc that returns a set" $ do
+      it "returns paginated results" $
+        request methodPost "/rpc/getitemrange"
+                (rangeHdrs (ByteRangeFromTo 0 0))  [json| { "min": 2, "max": 4 } |]
+           `shouldRespondWith` ResponseMatcher {
+              matchBody    = Just [json| [{"id":3}] |]
+            , matchStatus = 206
+            , matchHeaders = ["Content-Range" <:> "0-0/2"]
+            }
+
+
       it "returns proper json" $
         post "/rpc/getitemrange" [json| { "min": 2, "max": 4 } |] `shouldRespondWith`
           [json| [ {"id": 3}, {"id":4} ] |]
@@ -378,7 +459,59 @@ spec struct pool = around (withApp cfgDefault struct pool) $ do
         post "/rpc/test_empty_rowset" [json| {} |] `shouldRespondWith`
           [json| [] |]
 
-    context "a proc that returns plain text" $
+    context "a proc that returns plain text" $ do
       it "returns proper json" $
         post "/rpc/sayhello" [json| { "name": "world" } |] `shouldRespondWith`
           [json| [{"sayhello":"Hello, world"}] |]
+
+      it "can handle unicode" $
+        post "/rpc/sayhello" [json| { "name": "￥" } |] `shouldRespondWith`
+          [json| [{"sayhello":"Hello, ￥"}] |]
+
+    context "improper input" $ do
+      it "rejects unknown content type even if payload is good" $
+        request methodPost "/rpc/sayhello"
+          (acceptHdrs "audio/mpeg3") [json| { "name": "world" } |]
+            `shouldRespondWith` 415
+      it "rejects malformed json payload" $
+        request methodPost "/rpc/sayhello"
+          (acceptHdrs "application/json") "sdfsdf"
+            `shouldRespondWith` 400
+
+    context "unsupported verbs" $ do
+      it "DELETE fails" $
+        request methodDelete "/rpc/sayhello" [] ""
+          `shouldRespondWith` 405
+      it "PATCH fails" $
+        request methodPatch "/rpc/sayhello" [] ""
+          `shouldRespondWith` 405
+      it "OPTIONS fails" $
+        -- TODO: should return info about the function
+        request methodOptions "/rpc/sayhello" [] ""
+          `shouldRespondWith` 405
+      it "GET fails with 405 on unknown procs" $
+        -- TODO: should this be 404?
+        get "/rpc/fake" `shouldRespondWith` 405
+      it "GET with 405 on known procs" $
+        get "/rpc/sayhello" `shouldRespondWith` 405
+
+    it "executes the proc exactly once per request" $ do
+      post "/rpc/callcounter" [json| {} |] `shouldRespondWith`
+        [json| [{"callcounter":1}] |]
+      post "/rpc/callcounter" [json| {} |] `shouldRespondWith`
+        [json| [{"callcounter":2}] |]
+
+  describe "weird requests" $ do
+    it "can query as normal" $ do
+      get "/Escap3e;" `shouldRespondWith`
+        [json| [{"so6meIdColumn":1},{"so6meIdColumn":2},{"so6meIdColumn":3},{"so6meIdColumn":4},{"so6meIdColumn":5}] |]
+      get "/ghostBusters" `shouldRespondWith`
+        [json| [{"escapeId":1},{"escapeId":3},{"escapeId":5}] |]
+
+    it "will embed a collection" $
+      get "/Escap3e;?select=ghostBusters{*}" `shouldRespondWith`
+        [json| [{"ghostBusters":[{"escapeId":1}]},{"ghostBusters":[]},{"ghostBusters":[{"escapeId":3}]},{"ghostBusters":[]},{"ghostBusters":[{"escapeId":5}]}] |]
+
+    it "will embed using a column" $
+      get "/ghostBusters?select=escapeId{*}" `shouldRespondWith`
+        [json| [{"escapeId":{"so6meIdColumn":1}},{"escapeId":{"so6meIdColumn":3}},{"escapeId":{"so6meIdColumn":5}}] |]

test/Feature/RangeSpec.hs

@@ -6,17 +6,110 @@ import Test.Hspec.Wai.JSON
 import Network.HTTP.Types
 import Network.Wai.Test (SResponse(simpleHeaders,simpleStatus))
 
-import Hasql as H
-import Hasql.Postgres as P
+import qualified Data.ByteString.Lazy         as BL
 
 import SpecHelper
-import PostgREST.Types (DbStructure(..))
+import Text.Heredoc
+import Network.Wai (Application)
 
-spec :: DbStructure -> H.Pool P.Postgres -> Spec
-spec struct pool = beforeAll resetDb
-  . around (withApp cfgDefault struct pool) $
+defaultRange :: BL.ByteString
+defaultRange = [json| { "min": 0, "max": 15 } |]
+
+emptyRange :: BL.ByteString
+emptyRange = [json| { "min": 2, "max": 2 } |]
+
+spec :: SpecWith Application
+spec = do
+  describe "POST /rpc/getitemrange" $ do
+    context "without range headers" $ do
+      context "with response under server size limit" $
+        it "returns whole range with status 200" $
+           post "/rpc/getitemrange" defaultRange `shouldRespondWith` 200
+
+      context "when I don't want the count" $ do
+        it "returns range Content-Range with */* for empty range" $
+          request methodPost "/rpc/getitemrange"
+                  [("Prefer", "count=none")] emptyRange
+            `shouldRespondWith` ResponseMatcher {
+              matchBody    = Just [json| [] |]
+            , matchStatus  = 200
+            , matchHeaders = ["Content-Range" <:> "*/*"]
+            }
+
+        it "returns range Content-Range with range/*" $
+          request methodPost "/rpc/getitemrange"
+                  [("Prefer", "count=none")] defaultRange
+            `shouldRespondWith` ResponseMatcher {
+              matchBody    = Just [json| [{"id":1},{"id":2},{"id":3},{"id":4},{"id":5},{"id":6},{"id":7},{"id":8},{"id":9},{"id":10},{"id":11},{"id":12},{"id":13},{"id":14},{"id":15}] |]
+            , matchStatus  = 200
+            , matchHeaders = ["Content-Range" <:> "0-14/*"]
+            }
+
+    context "with range headers" $ do
+
+      context "of acceptable range" $ do
+        it "succeeds with partial content" $ do
+          r <- request methodPost  "/rpc/getitemrange"
+                       (rangeHdrs $ ByteRangeFromTo 0 1) defaultRange
+          liftIO $ do
+            simpleHeaders r `shouldSatisfy`
+              matchHeader "Content-Range" "0-1/15"
+            simpleStatus r `shouldBe` partialContent206
+
+        it "understands open-ended ranges" $
+          request methodPost "/rpc/getitemrange"
+                  (rangeHdrs $ ByteRangeFrom 0) defaultRange
+            `shouldRespondWith` 200
+
+        it "returns an empty body when there are no results" $
+          request methodPost "/rpc/getitemrange"
+                  (rangeHdrs $ ByteRangeFromTo 0 1) emptyRange
+            `shouldRespondWith` ResponseMatcher {
+              matchBody    = Just "[]"
+            , matchStatus  = 200
+            , matchHeaders = ["Content-Range" <:> "*/0"]
+            }
+
+        it "allows one-item requests" $ do
+          r <- request methodPost  "/rpc/getitemrange"
+                       (rangeHdrs $ ByteRangeFromTo 0 0) defaultRange
+          liftIO $ do
+            simpleHeaders r `shouldSatisfy`
+              matchHeader "Content-Range" "0-0/15"
+            simpleStatus r `shouldBe` partialContent206
+
+        it "handles ranges beyond collection length via truncation" $ do
+          r <- request methodPost  "/rpc/getitemrange"
+                       (rangeHdrs $ ByteRangeFromTo 10 100) defaultRange
+          liftIO $ do
+            simpleHeaders r `shouldSatisfy`
+              matchHeader "Content-Range" "10-14/15"
+            simpleStatus r `shouldBe` partialContent206
+
+      context "of invalid range" $ do
+        it "fails with 416 for offside range" $
+          request methodPost  "/rpc/getitemrange"
+                  (rangeHdrs $ ByteRangeFromTo 1 0) emptyRange
+            `shouldRespondWith` 416
+
+        it "refuses a range with nonzero start when there are no items" $
+          request methodPost "/rpc/getitemrange"
+                  (rangeHdrs $ ByteRangeFromTo 1 2) emptyRange
+            `shouldRespondWith` ResponseMatcher {
+              matchBody    = Nothing
+            , matchStatus  = 416
+            , matchHeaders = ["Content-Range" <:> "*/0"]
+            }
+
+        it "refuses a range requesting start past last item" $
+          request methodPost "/rpc/getitemrange"
+                  (rangeHdrs $ ByteRangeFromTo 100 199) defaultRange
+            `shouldRespondWith` ResponseMatcher {
+              matchBody    = Nothing
+            , matchStatus  = 416
+            , matchHeaders = ["Content-Range" <:> "*/15"]
+            }
   describe "GET /items" $ do
-
     context "without range headers" $ do
       context "with response under server size limit" $
         it "returns whole range with status 200" $
@@ -50,6 +143,50 @@ spec struct pool = beforeAll resetDb
             , matchHeaders = ["Content-Range" <:> "0-0/*"]
             }
 
+    context "with limit/offset parameters" $ do
+      it "no parameters return everything" $
+        get "/items?select=id&order=id.asc"
+          `shouldRespondWith` ResponseMatcher {
+            matchBody    = Just [str|[{"id":1},{"id":2},{"id":3},{"id":4},{"id":5},{"id":6},{"id":7},{"id":8},{"id":9},{"id":10},{"id":11},{"id":12},{"id":13},{"id":14},{"id":15}]|]
+          , matchStatus  = 200
+          , matchHeaders = ["Content-Range" <:> "0-14/15"]
+          }
+      it "top level limit with parameter" $
+        get "/items?select=id&order=id.asc&limit=3"
+          `shouldRespondWith` ResponseMatcher {
+            matchBody    = Just [str|[{"id":1},{"id":2},{"id":3}]|]
+          , matchStatus  = 206
+          , matchHeaders = ["Content-Range" <:> "0-2/15"]
+          }
+      it "headers override get parameters" $
+        request methodGet  "/items?select=id&order=id.asc&limit=3"
+                     (rangeHdrs $ ByteRangeFromTo 0 1) ""
+          `shouldRespondWith` ResponseMatcher {
+            matchBody    = Just [str|[{"id":1},{"id":2}]|]
+          , matchStatus  = 206
+          , matchHeaders = ["Content-Range" <:> "0-1/15"]
+          }
+
+      it "limit works on all levels" $
+        get "/clients?select=id,projects{id,tasks{id}}&order=id.asc&limit=1&projects.order=id.asc&projects.limit=1&projects.tasks.order=id.asc&projects.tasks.limit=2"
+          `shouldRespondWith` ResponseMatcher {
+            matchBody    = Just [str|[{"id":1,"projects":[{"id":1,"tasks":[{"id":1},{"id":2}]}]}]|]
+          , matchStatus  = 206
+          , matchHeaders = ["Content-Range" <:> "0-0/2"]
+          }
+
+      it "fails on offset specified below level 1" $
+        get "/clients?select=id,projects{id,tasks{id}}&projects.offset=2&projects.limit=1"
+          `shouldRespondWith` 400
+
+      it "limit and offset works on first level" $
+        get "/items?select=id&order=id.asc&limit=3&offset=2"
+          `shouldRespondWith` ResponseMatcher {
+            matchBody    = Just [str|[{"id":3},{"id":4},{"id":5}]|]
+          , matchStatus  = 206
+          , matchHeaders = ["Content-Range" <:> "2-4/15"]
+          }
+
     context "with range headers" $ do
 
       context "of acceptable range" $ do

test/Feature/StructureSpec.hs

@@ -4,27 +4,31 @@ import Test.Hspec hiding (pendingWith)
 import Test.Hspec.Wai
 import Test.Hspec.Wai.JSON
 
-import Hasql as H
-import Hasql.Postgres as P
-
 import SpecHelper
-import PostgREST.Types (DbStructure(..))
 
 import Network.HTTP.Types
+import Network.Wai (Application)
+import Network.Wai.Test (SResponse(simpleHeaders))
+
+spec :: SpecWith Application
+spec = do
 
-spec :: DbStructure -> H.Pool P.Postgres -> Spec
-spec struct pool = around (withApp cfgDefault struct pool) $ do
   describe "GET /" $ do
     it "lists views in schema" $
       request methodGet "/" [] ""
         `shouldRespondWith` [json| [
-          {"schema":"test","name":"articleStars","insertable":true}
+          {"schema":"test","name":"Escap3e;","insertable":true}
+        , {"schema":"test","name":"addresses","insertable":true}
+        , {"schema":"test","name":"articleStars","insertable":true}
         , {"schema":"test","name":"articles","insertable":true}
         , {"schema":"test","name":"auto_incrementing_pk","insertable":true}
         , {"schema":"test","name":"clients","insertable":true}
         , {"schema":"test","name":"comments","insertable":true}
         , {"schema":"test","name":"complex_items","insertable":true}
         , {"schema":"test","name":"compound_pk","insertable":true}
+        , {"schema":"test","name":"empty_table","insertable":true}
+        , {"schema":"test","name":"filtered_tasks","insertable":true}
+        , {"schema":"test","name":"ghostBusters","insertable":true}
         , {"schema":"test","name":"has_count_column","insertable":false}
         , {"schema":"test","name":"has_fk","insertable":true}
         , {"schema":"test","name":"insertable_view_with_join","insertable":true}
@@ -35,6 +39,7 @@ spec struct pool = around (withApp cfgDefault struct pool) $ do
         , {"schema":"test","name":"menagerie","insertable":true}
         , {"schema":"test","name":"no_pk","insertable":true}
         , {"schema":"test","name":"nullable_integer","insertable":true}
+        , {"schema":"test","name":"orders","insertable":true}
         , {"schema":"test","name":"projects","insertable":true}
         , {"schema":"test","name":"projects_view","insertable":true}
         , {"schema":"test","name":"simple_pk","insertable":true}
@@ -43,6 +48,7 @@ spec struct pool = around (withApp cfgDefault struct pool) $ do
         , {"schema":"test","name":"users","insertable":true}
         , {"schema":"test","name":"users_projects","insertable":true}
         , {"schema":"test","name":"users_tasks","insertable":true}
+        , {"schema":"test","name":"withUnique","insertable":true}
         ] |]
         {matchStatus = 200}
 
@@ -56,6 +62,61 @@ spec struct pool = around (withApp cfgDefault struct pool) $ do
         {matchStatus = 200}
 
   describe "Table info" $ do
+    it "The structure of complex views is correctly detected" $
+      request methodOptions "/filtered_tasks" [] "" `shouldRespondWith`
+      [json|
+      {
+        "pkey": [
+          "myId"
+        ],
+        "columns": [
+          {
+            "references": null,
+            "default": null,
+            "precision": 32,
+            "updatable": true,
+            "schema": "test",
+            "name": "myId",
+            "type": "integer",
+            "maxLen": null,
+            "enum": [],
+            "nullable": true,
+            "position": 1
+          },
+          {
+            "references": null,
+            "default": null,
+            "precision": null,
+            "updatable": true,
+            "schema": "test",
+            "name": "name",
+            "type": "text",
+            "maxLen": null,
+            "enum": [],
+            "nullable": true,
+            "position": 2
+          },
+          {
+            "references": {
+              "schema": "test",
+              "column": "id",
+              "table": "projects"
+            },
+            "default": null,
+            "precision": 32,
+            "updatable": true,
+            "schema": "test",
+            "name": "projectID",
+            "type": "integer",
+            "maxLen": null,
+            "enum": [],
+            "nullable": true,
+            "position": 3
+          }
+        ]
+      }
+      |]
+
     it "is available with OPTIONS verb" $
       request methodOptions "/menagerie" [] "" `shouldRespondWith`
       [json|
@@ -319,3 +380,20 @@ spec struct pool = around (withApp cfgDefault struct pool) $ do
             ]
           }
         |]
+
+    it "errors for non existant tables" $
+      request methodOptions "/dne" [] "" `shouldRespondWith` 404
+
+  describe "Allow header" $ do
+
+    it "includes read/write verbs for writeable table" $ do
+      r <- request methodOptions "/items" [] ""
+      liftIO $
+        simpleHeaders r `shouldSatisfy`
+          matchHeader "Allow" "GET,POST,PATCH,DELETE"
+
+    it "includes read verbs for read-only table" $ do
+      r <- request methodOptions "/has_count_column" [] ""
+      liftIO $
+        simpleHeaders r `shouldSatisfy`
+          matchHeader "Allow" "GET"

test/Feature/UnicodeSpec.hs

@@ -0,0 +1,20 @@
+module Feature.UnicodeSpec where
+
+import Test.Hspec
+import Test.Hspec.Wai
+import Test.Hspec.Wai.JSON
+import Network.Wai (Application)
+import Control.Monad (void)
+
+spec :: SpecWith Application
+spec =
+  describe "Reading and writing to unicode schema and table names" $
+    it "Can read and write values" $ do
+      get "/%D9%85%D9%88%D8%A7%D8%B1%D8%AF"
+        `shouldRespondWith` "[]"
+
+      void $ post "/%D9%85%D9%88%D8%A7%D8%B1%D8%AF"
+        [json| { "هویت": 1 } |]
+
+      get "/%D9%85%D9%88%D8%A7%D8%B1%D8%AF"
+        `shouldRespondWith` [json| [{ "هویت": 1 }] |]

test/Main.hs

@@ -3,9 +3,15 @@ module Main where
 import Test.Hspec
 import SpecHelper
 
---import PostgREST.Types (DbStructure(..))
+import qualified Hasql.Pool as P
+
+import PostgREST.DbStructure (getDbStructure)
+import PostgREST.App (postgrest)
+import Data.IORef
+import Data.String.Conversions (cs)
 
 import qualified Feature.AuthSpec
+import qualified Feature.ConcurrentSpec
 import qualified Feature.CorsSpec
 import qualified Feature.DeleteSpec
 import qualified Feature.InsertSpec
@@ -13,25 +19,39 @@ import qualified Feature.QueryLimitedSpec
 import qualified Feature.QuerySpec
 import qualified Feature.RangeSpec
 import qualified Feature.StructureSpec
+import qualified Feature.UnicodeSpec
 
 main :: IO ()
 main = do
   setupDb
 
-  pool <- specDbPool
-  dbStructure <- specDbStructure pool
+  pool <- P.acquire (3, 10, cs testDbConn)
 
-  -- Not using hspec-discover because we want to precompute
-  -- the db structure and pass it to specs for speed
-  hspec $ specs dbStructure pool
+  result <- P.use pool $ getDbStructure "test"
+  refDbStructure <- newIORef $ either (error.show) id result
+  let withApp = return $ postgrest testCfg refDbStructure pool
+      ltdApp  = return $ postgrest testLtdRowsCfg refDbStructure pool
+      unicodeApp = return $ postgrest testUnicodeCfg refDbStructure pool
+
+  hspec $ do
+    mapM_ (beforeAll_ resetDb . before withApp) specs
+
+    -- this test runs with a different server flag
+    beforeAll_ resetDb . before ltdApp $
+      describe "Feature.QueryLimitedSpec" Feature.QueryLimitedSpec.spec
+
+    -- this test runs with a different schema
+    beforeAll_ resetDb . before unicodeApp $
+      describe "Feature.UnicodeSpec" Feature.UnicodeSpec.spec
 
  where
-  specs dbStructure pool = do
-    describe "Feature.AuthSpec" $ Feature.AuthSpec.spec dbStructure pool
-    describe "Feature.CorsSpec" $ Feature.CorsSpec.spec dbStructure pool
-    describe "Feature.DeleteSpec" $ Feature.DeleteSpec.spec dbStructure pool
-    describe "Feature.InsertSpec" $ Feature.InsertSpec.spec dbStructure pool
-    describe "Feature.QueryLimitedSpec" $ Feature.QueryLimitedSpec.spec dbStructure pool
-    describe "Feature.QuerySpec" $ Feature.QuerySpec.spec dbStructure pool
-    describe "Feature.RangeSpec" $ Feature.RangeSpec.spec dbStructure pool
-    describe "Feature.StructureSpec" $ Feature.StructureSpec.spec dbStructure pool
+  specs = map (uncurry describe) [
+      ("Feature.AuthSpec"         , Feature.AuthSpec.spec)
+    , ("Feature.ConcurrentSpec"   , Feature.ConcurrentSpec.spec)
+    , ("Feature.CorsSpec"         , Feature.CorsSpec.spec)
+    , ("Feature.DeleteSpec"       , Feature.DeleteSpec.spec)
+    , ("Feature.InsertSpec"       , Feature.InsertSpec.spec)
+    , ("Feature.QuerySpec"        , Feature.QuerySpec.spec)
+    , ("Feature.RangeSpec"        , Feature.RangeSpec.spec)
+    , ("Feature.StructureSpec"    , Feature.StructureSpec.spec)
+    ]

test/SpecHelper.hs

@@ -1,75 +1,33 @@
 module SpecHelper where
 
-import Network.Wai
-import Test.Hspec
-import Test.Hspec.Wai
-
-import Hasql as H
-import Hasql.Backend as B
-import Hasql.Postgres as P
-
 import Data.String.Conversions (cs)
-import Data.Monoid
-import Data.Text hiding (map)
-import qualified Data.Vector as V
-import Data.Time.Clock.POSIX (getPOSIXTime)
 import Control.Monad (void)
 
 import Network.HTTP.Types.Header (Header, ByteRange, renderByteRange,
                                   hRange, hAuthorization, hAccept)
 import Codec.Binary.Base64.String (encode)
 import Data.CaseInsensitive (CI(..))
-import Data.Maybe (fromMaybe)
 import Text.Regex.TDFA ((=~))
 import qualified Data.ByteString.Char8 as BS
 import System.Process (readProcess)
 import Web.JWT (secret)
 
-import PostgREST.App (app)
 import PostgREST.Config (AppConfig(..))
-import PostgREST.Middleware
-import PostgREST.Error(pgErrResponse)
-import PostgREST.DbStructure
-import PostgREST.Types
 
-dbString :: String
-dbString = "postgres://postgrest_test_authenticator@localhost:5432/postgrest_test"
+testDbConn :: String
+testDbConn = "postgres://postgrest_test_authenticator@localhost:5432/postgrest_test"
 
-cfg :: String -> Maybe Int -> AppConfig
-cfg conStr = AppConfig conStr 3000 "postgrest_test_anonymous" "test" (secret "safe") 10
+testCfg :: AppConfig
+testCfg =
+  AppConfig testDbConn "postgrest_test_anonymous" "test" 3000 (secret "safe") 10 Nothing True
 
-cfgDefault :: AppConfig
-cfgDefault = cfg dbString Nothing
+testUnicodeCfg :: AppConfig
+testUnicodeCfg =
+  AppConfig testDbConn "postgrest_test_anonymous" "تست" 3000 (secret "safe") 10 Nothing True
 
-cfgLimitRows :: Int -> AppConfig
-cfgLimitRows = cfg dbString . Just
-
-testPoolOpts :: PoolSettings
-testPoolOpts = fromMaybe (error "bad settings") $ H.poolSettings 1 30
-
-pgSettings :: P.Settings
-pgSettings = P.StringSettings $ cs dbString
-
-specDbPool :: IO (H.Pool P.Postgres)
-specDbPool = H.acquirePool pgSettings testPoolOpts
-
-specDbStructure :: H.Pool P.Postgres -> IO DbStructure
-specDbStructure pool = do
-  dbOrError <- H.session pool $ H.tx specTxSettings
-    $ getDbStructure "test"
-  either (fail . show) return dbOrError
-
-withApp :: AppConfig -> DbStructure -> H.Pool P.Postgres
-        -> ActionWith Application -> IO ()
-withApp config dbStructure pool perform = do
-  perform $ middle $ \req resp -> do
-    time <- getPOSIXTime
-    body <- strictRequestBody req
-    result <- liftIO $ H.session pool $ H.tx specTxSettings
-      $ runWithClaims config time (app dbStructure config body) req
-    either (resp . pgErrResponse) resp result
-
-  where middle = defaultMiddle
+testLtdRowsCfg :: AppConfig
+testLtdRowsCfg =
+  AppConfig testDbConn "postgrest_test_anonymous" "test" 3000 (secret "safe") 10 (Just 2) True
 
 setupDb :: IO ()
 setupDb = do
@@ -106,15 +64,3 @@ authHeaderBasic u p =
 authHeaderJWT :: String -> Header
 authHeaderJWT token =
   (hAuthorization, cs $ "Bearer " ++ token)
-
-testPool :: IO(H.Pool P.Postgres)
-testPool = H.acquirePool pgSettings testPoolOpts
-
-clearTable :: Text -> IO ()
-clearTable table = do
-  pool <- testPool
-  void . liftIO $ H.session pool $ H.tx Nothing $
-    H.unitEx $ B.Stmt ("truncate table test." <> table <> " cascade") V.empty True
-
-specTxSettings :: Maybe (TxIsolationLevel, Maybe Bool)
-specTxSettings = Just (H.ReadCommitted, Just True)

test/TestTypes.hs

@@ -37,9 +37,9 @@ instance JSON.FromJSON IncPK where
 
 data CompoundPK = CompoundPK {
   compoundK1 :: Int
-, compoundK2 :: Int
+, compoundK2 :: String
 , compoundExtra :: Maybe Int
-}
+} deriving (Eq, Show)
 
 instance JSON.FromJSON CompoundPK where
   parseJSON (JSON.Object r) = CompoundPK <$>

test/fixtures/data.sql

@@ -65,13 +65,13 @@ SET search_path = test, pg_catalog;
 --
 -- Data for Name: authors_only; Type: TABLE DATA; Schema: test; Owner: -
 --
-
+TRUNCATE TABLE authors_only CASCADE;
 
 
 --
 -- Data for Name: auto_incrementing_pk; Type: TABLE DATA; Schema: test; Owner: -
 --
-
+TRUNCATE TABLE auto_incrementing_pk CASCADE;
 
 
 --
@@ -154,7 +154,7 @@ INSERT INTO complex_items VALUES (3, 'Three', '{"foo":{"int":1,"bar":"baz"}}', '
 --
 -- Data for Name: compound_pk; Type: TABLE DATA; Schema: test; Owner: -
 --
-
+TRUNCATE TABLE compound_pk CASCADE;
 
 
 --
@@ -168,7 +168,7 @@ INSERT INTO simple_pk VALUES ('xYYx', 'v');
 --
 -- Data for Name: has_fk; Type: TABLE DATA; Schema: test; Owner: -
 --
-
+TRUNCATE TABLE has_fk CASCADE;
 
 
 --
@@ -204,7 +204,7 @@ INSERT INTO items VALUES (15);
 -- Name: items_id_seq; Type: SEQUENCE SET; Schema: test; Owner: -
 --
 
-SELECT pg_catalog.setval('items_id_seq', 1, true);
+SELECT pg_catalog.setval('items_id_seq', 15, true);
 
 
 --
@@ -218,7 +218,7 @@ INSERT INTO json VALUES ('{"foo":{"bar":"baz"},"id":1}');
 --
 -- Data for Name: menagerie; Type: TABLE DATA; Schema: test; Owner: -
 --
-
+TRUNCATE TABLE menagerie CASCADE;
 
 
 --
@@ -260,6 +260,26 @@ INSERT INTO users_projects VALUES (2, 4);
 INSERT INTO users_projects VALUES (3, 1);
 INSERT INTO users_projects VALUES (3, 3);
 
+TRUNCATE TABLE "Escap3e;" CASCADE;
+INSERT INTO "Escap3e;" VALUES (1), (2), (3), (4), (5);
+
+TRUNCATE TABLE "ghostBusters" CASCADE;
+INSERT INTO "ghostBusters" VALUES (1), (3), (5);
+
+TRUNCATE TABLE "withUnique" CASCADE;
+INSERT INTO "withUnique" VALUES ('nodup', 'blah');
+
+
+
+TRUNCATE TABLE addresses CASCADE;
+INSERT INTO addresses VALUES (1, 'address 1');
+INSERT INTO addresses VALUES (2, 'address 2');
+INSERT INTO addresses VALUES (3, 'address 3');
+INSERT INTO addresses VALUES (4, 'address 4');
+
+TRUNCATE TABLE orders CASCADE;
+INSERT INTO orders VALUES (1, 'order 1', 1, 2);
+INSERT INTO orders VALUES (2, 'order 2', 3, 4);
 
 --
 -- PostgreSQL database dump complete

test/fixtures/privileges.sql

@@ -2,10 +2,11 @@
 GRANT USAGE ON SCHEMA
       postgrest
     , test
+    , "تست"
 TO postgrest_test_anonymous;
 
 -- Schema test objects
-SET search_path = test, pg_catalog;
+SET search_path = test, "تست", pg_catalog;
 
 GRANT ALL ON TABLE
     items
@@ -16,6 +17,7 @@ GRANT ALL ON TABLE
     , comments
     , complex_items
     , compound_pk
+    , empty_table
     , has_count_column
     , has_fk
     , insertable_view_with_join
@@ -28,10 +30,17 @@ GRANT ALL ON TABLE
     , projects_view
     , simple_pk
     , tasks
+    , filtered_tasks
     , tsearch
     , users
     , users_projects
     , users_tasks
+    , "Escap3e;"
+    , "ghostBusters"
+    , "withUnique"
+    , "موارد"
+    , addresses
+    , orders
 TO postgrest_test_anonymous;
 
 GRANT INSERT ON TABLE insertonly TO postgrest_test_anonymous;
@@ -39,6 +48,7 @@ GRANT INSERT ON TABLE insertonly TO postgrest_test_anonymous;
 GRANT USAGE ON SEQUENCE
       auto_incrementing_pk_id_seq
     , items_id_seq
+    , callcounter_count
 TO postgrest_test_anonymous;
 
 -- Privileges for non anonymous users

test/fixtures/roles.sql

@@ -1,5 +1,5 @@
 DROP ROLE IF EXISTS postgrest_test_authenticator, postgrest_test_anonymous, postgrest_test_default_role, postgrest_test_author;
-CREATE ROLE postgrest_test_authenticator WITH login;
+CREATE ROLE postgrest_test_authenticator WITH login noinherit;
 CREATE ROLE postgrest_test_anonymous;
 CREATE ROLE postgrest_test_default_role;
 CREATE ROLE postgrest_test_author;

test/fixtures/schema.sql

@@ -33,6 +33,13 @@ CREATE SCHEMA private;
 CREATE SCHEMA test;
 
 
+--
+-- Name: تست; Type: SCHEMA; Schema: -; Owner: -
+--
+
+CREATE SCHEMA تست;
+
+
 --
 -- Name: plpgsql; Type: EXTENSION; Schema: -; Owner: -
 --
@@ -50,6 +57,23 @@ CREATE TYPE jwt_claims AS (
 	id text
 );
 
+--
+-- Name: big_jwt_claims; Type: TYPE; Schema: public; Owner: -
+--
+
+CREATE TYPE big_jwt_claims AS (
+  iss text,
+  sub text,
+  aud text,
+  exp integer,
+  nbf integer,
+  iat integer,
+  jti text,
+
+  role text,
+  "http://postgrest.com/foo" boolean
+);
+
 
 SET search_path = test, pg_catalog;
 
@@ -145,6 +169,14 @@ CREATE FUNCTION anti_id(test.items) RETURNS bigint
     AS $_$ SELECT $1.id * -1 $_$;
 
 
+
+SET search_path = تست, pg_catalog;
+
+CREATE TABLE موارد (
+    هویت bigint NOT NULL
+);
+
+
 SET search_path = test, pg_catalog;
 
 --
@@ -183,6 +215,43 @@ SELECT rolname::text, id::text FROM postgrest.auth WHERE id = id AND pass = pass
 $$;
 
 
+--
+-- Name: jwt_test(); Type: FUNCTION; Schema: test; Owner: -
+--
+
+CREATE FUNCTION jwt_test() RETURNS public.big_jwt_claims
+    LANGUAGE sql SECURITY DEFINER
+    AS $$
+SELECT 'joe'::text as iss, 'fun'::text as sub, 'everyone'::text as aud,
+       1300819380 as exp, 1300819380 as nbf, 1300819380 as iat,
+       'foo'::text as jti, 'postgrest_test'::text as role,
+       true as "http://postgrest.com/foo";
+$$;
+
+
+--
+-- Name: reveal_big_jwt(); Type: FUNCTION; Schema: test; Owner: -
+--
+
+CREATE FUNCTION reveal_big_jwt() RETURNS TABLE (
+      iss text, sub text, aud text, exp bigint,
+      nbf bigint, iat bigint, jti text, "http://postgrest.com/foo" boolean
+    )
+    LANGUAGE sql SECURITY DEFINER
+    AS $$
+SELECT current_setting('postgrest.claims.iss') as iss,
+       current_setting('postgrest.claims.sub') as sub,
+       current_setting('postgrest.claims.aud') as aud,
+       current_setting('postgrest.claims.exp')::bigint as exp,
+       current_setting('postgrest.claims.nbf')::bigint as nbf,
+       current_setting('postgrest.claims.iat')::bigint as iat,
+       current_setting('postgrest.claims.jti') as jti,
+       -- role is not included in the claims list
+       current_setting('postgrest.claims.http://postgrest.com/foo')::boolean
+         as "http://postgrest.com/foo";
+$$;
+
+
 --
 -- Name: problem(); Type: FUNCTION; Schema: test; Owner: -
 --
@@ -207,6 +276,18 @@ CREATE FUNCTION sayhello(name text) RETURNS text
 $_$;
 
 
+--
+-- Name: callcounter(); Type: FUNCTION; Schema: test; Owner: -
+--
+
+CREATE SEQUENCE callcounter_count START 1;
+
+CREATE FUNCTION callcounter() RETURNS bigint
+    LANGUAGE sql
+    AS $_$
+    SELECT nextval('test.callcounter_count');
+$_$;
+
 --
 -- Name: test_empty_rowset(); Type: FUNCTION; Schema: test; Owner: -
 --
@@ -351,7 +432,8 @@ CREATE TABLE complex_items (
     id bigint NOT NULL,
     name text,
     settings pg_catalog.json,
-    arr_data integer[]
+    arr_data integer[],
+		"field-with_sep" integer default 1 not null
 );
 
 
@@ -361,7 +443,7 @@ CREATE TABLE complex_items (
 
 CREATE TABLE compound_pk (
     k1 integer NOT NULL,
-    k2 integer NOT NULL,
+    k2 text NOT NULL,
     extra integer
 );
 
@@ -376,6 +458,13 @@ CREATE TABLE empty_table (
 );
 
 
+--
+-- Name: private_table; Type: TABLE; Schema: test; Owner: -
+--
+
+CREATE TABLE private_table ();
+
+
 --
 -- Name: has_count_column; Type: VIEW; Schema: test; Owner: -
 --
@@ -540,6 +629,15 @@ CREATE TABLE simple_pk (
     extra character varying NOT NULL
 );
 
+--
+-- Name: users_projects; Type: TABLE; Schema: test; Owner: -
+--
+
+CREATE TABLE users_projects (
+    user_id integer NOT NULL,
+    project_id integer NOT NULL
+);
+
 
 --
 -- Name: tasks; Type: TABLE; Schema: test; Owner: -
@@ -551,6 +649,16 @@ CREATE TABLE tasks (
     project_id integer
 );
 
+CREATE OR REPLACE VIEW filtered_tasks AS
+SELECT id AS "myId", name, project_id AS "projectID"
+FROM tasks
+WHERE project_id IN (
+	SELECT id FROM projects WHERE id = 1
+) AND
+project_id IN (
+	SELECT project_id FROM users_projects WHERE user_id = 1
+);
+
 
 --
 -- Name: tsearch; Type: TABLE; Schema: test; Owner: -
@@ -571,15 +679,6 @@ CREATE TABLE users (
 );
 
 
---
--- Name: users_projects; Type: TABLE; Schema: test; Owner: -
---
-
-CREATE TABLE users_projects (
-    user_id integer NOT NULL,
-    project_id integer NOT NULL
-);
-
 
 --
 -- Name: users_tasks; Type: TABLE; Schema: test; Owner: -
@@ -591,6 +690,20 @@ CREATE TABLE users_tasks (
 );
 
 
+CREATE TABLE "Escap3e;" (
+		"so6meIdColumn" integer primary key
+);
+
+CREATE TABLE "ghostBusters" (
+		"escapeId" integer not null references "Escap3e;"("so6meIdColumn")
+);
+
+CREATE TABLE "withUnique" (
+    uni text UNIQUE,
+    extra text
+);
+
+
 --
 -- Name: id; Type: DEFAULT; Schema: test; Owner: -
 --
@@ -896,6 +1009,18 @@ ALTER TABLE ONLY users_tasks
     ADD CONSTRAINT users_tasks_user_id_fkey FOREIGN KEY (user_id) REFERENCES users(id);
 
 
+create table addresses (
+	id                   int not null unique,
+	address              text not null
+);
+
+create table orders (
+	id                   int not null unique,
+	name                 text not null,
+	billing_address_id   int references addresses(id),
+	shipping_address_id  int references addresses(id)
+);
+
 --
 -- PostgreSQL database dump complete
 --