v0.3.0.4

Do not block threads on libpq ffi

CHANGELOG.md

@@ -3,6 +3,24 @@
 All notable changes to this project will be documented in this file.
 This project adheres to [Semantic Versioning](http://semver.org/).
 
+## Unreleased
+
+### Fixed
+
+## [0.3.0.4] - 2016-02-12
+
+### Fixed
+- Improved usage screen - @begriffs
+- Reject non-POSTs to rpc endpoints - @begriffs
+- Throw an error for OPTIONS on nonexistent tables - @calebmer
+- Remove deadlock on simultaneous contentious updates - @ruslantalpa, @begriffs
+
+## [0.3.0.3] - 2016-01-08
+
+### Fixed
+- Fix bug in many-many relation detection - @ruslantalpa
+- Inconsistent escaping of table names in read queries - @calebmer
+
 ## [0.3.0.2] - 2015-12-16
 
 ### Fixed
@@ -13,7 +31,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

README.md

@@ -117,7 +117,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 +125,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.0.4"
     },
     "DB_NAME": {
       "description": "Database name",
@@ -47,8 +47,8 @@
       "required": false,
       "value": "secret"
     },
-    "V1SCHEMA": {
+    "SCHEMA": {
-      "description": "DB schema selected whe no version (or version 1) requested",
+      "description": "DB schema to be exported",
       "required": false,
       "value": "1"
     }

circle.yml

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

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

@@ -159,7 +159,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
@@ -285,6 +285,11 @@ GET /projects?id=eq.1&select=id, name, client{*}
 
 Would embed in the `client` key the row referenced with `client_id`.
 
+<div class="admonition note">
+    <p class="admonition-title">Design Consideration</p>
+    <p>In order for this feature to work as expected after a schema change, PostgREST currently requires to be restarted.</p>
+</div>
+
 ### Response Format
 
 Query responses default to JSON but you can get them in CSV as well. Just make your request with the header

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 intefering with others while
+    improving readability.
+    </p>
+</div>
+
 ### Bulk Updates
 
 * ❌ Cannot be cached or prefetched

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
+This example builds off the previous previous [User Management](users/)
-a signup and login system on top of JWT. We'll use this auth system
+one. We had previously created a signup and login system on top of
-for the blog. **Run the SQL in the previous example** first, before
+JWT. We'll use this auth system for the blog. **Run the SQL in the
-continuing with this example.
+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`
+On top of the `authenticator` and `anon` access granted in the
-role which can't do anything itself other than switch into other
+previous example, blogs have an `author` role with extra permissions.
-roles as directed by JWT.
 
 ```sql
-create role anon;
 create role author;
-create role authenticator noinherit;
+grant author to authenticator;
-grant anon, author to authenticator;
 
-grant usage on schema public, basic_auth to anon, author;
+grant usage on schema public, basic_auth to 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;
 
 -- 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;

docs/examples/external_auth.md

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

docs/examples/python-requests-jwt.md

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

docs/examples/start.md

@@ -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

@@ -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
+also need the postgres extension
-[pgcrypto](http://www.postgresql.org/docs/current/static/pgcrypto.html) and
+[pgcrypto](http://www.postgresql.org/docs/current/static/pgcrypto.html).
-[uuid-ossp](http://www.postgresql.org/docs/current/static/uuid-ossp.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',
@@ -475,6 +473,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,6 +46,10 @@ 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
@@ -61,7 +65,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 +73,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>
 
@@ -113,6 +117,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

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.0.4
 synopsis:              REST API for any Postgres database
 license:               MIT
 license-file:          LICENSE
@@ -22,44 +22,40 @@ Flag CI
   Default:     False
 
 executable postgrest
-  if flag(ci)
-    ghc-options:       -Wall -W -Werror
-  else
-    ghc-options:       -Wall -W -O2
-
   main-is:             PostgREST/Main.hs
-  default-extensions:  OverloadedStrings, ScopedTypeVariables, QuasiQuotes
+  default-extensions:  OverloadedStrings, ScopedTypeVariables, QuasiQuotes, LambdaCase
+  ghc-options:         -threaded -rtsopts -with-rtsopts=-N
   default-language:    Haskell2010
-  build-depends:       aeson >= 0.8
+  build-depends:       aeson >= 0.8 && < 0.10
                      , base >= 4.8 && < 5
                      , bytestring
                      , case-insensitive
                      , cassava
                      , containers
+                     , contravariant
                      , errors
-                     , hasql >= 0.7.3 && < 0.8
+                     , hasql >= 0.19.3.3 && < 0.20
-                     , hasql-backend >= 0.4.1 && < 0.5
+                     , http-types
-                     , hasql-postgres >= 0.10.4 && < 0.11
+                     , interpolatedstring-perl6
                      , jwt
                      , optparse-applicative >= 0.11 && < 0.13
                      , parsec
                      , postgrest
                      , regex-tdfa
+                     , resource-pool
                      , safe >= 0.3 && < 0.4
                      , scientific
                      , string-conversions
                      , text
                      , time
-                     , transformers
                      , unordered-containers
                      , vector
                      , wai >= 3.0.1
                      , wai-cors
                      , wai-extra
                      , wai-middleware-static >= 0.6.0
-                     , warp >= 3.0.2
+                     , warp >= 3.1.0
-                     , HTTP, http-types
+                     , HTTP
-                     , MissingH
                      , Ranged-sets
   if !os(windows)
     build-depends:     unix >= 2.7 && < 3
@@ -79,11 +75,6 @@ executable postgrest
                      , PostgREST.Types
 
 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
@@ -92,11 +83,11 @@ library
                      , case-insensitive
                      , cassava
                      , containers
+                     , contravariant
                      , errors
                      , hasql
-                     , hasql-backend
-                     , hasql-postgres
                      , http-types
+                     , interpolatedstring-perl6
                      , jwt
                      , optparse-applicative
                      , parsec
@@ -113,7 +104,6 @@ library
                      , wai-extra
                      , wai-middleware-static
                      , HTTP
-                     , MissingH
                      , Ranged-sets
 
   Other-Modules:       Paths_postgrest
@@ -133,12 +123,8 @@ library
 Test-Suite spec
   Type:                exitcode-stdio-1.0
   Default-Language:    Haskell2010
-  default-extensions:  OverloadedStrings, ScopedTypeVariables, QuasiQuotes
+  default-extensions:  OverloadedStrings, ScopedTypeVariables, QuasiQuotes, LambdaCase
   Hs-Source-Dirs:      test, src
-  if flag(ci)
-    ghc-options:       -Wall -W -Werror
-  else
-    ghc-options:       -Wall -W -O2
   Main-Is:             Main.hs
   Other-Modules:       Feature.AuthSpec
                      , Feature.CorsSpec
@@ -168,19 +154,17 @@ Test-Suite spec
                      , case-insensitive
                      , cassava
                      , containers
+                     , contravariant
                      , errors
                      , hasql
-                     , hasql-backend
-                     , hasql-postgres
                      , heredoc
-                     , hlint
                      , hspec == 2.2.*
                      , hspec-wai
                      , hspec-wai-json
                      , http-types
+                     , interpolatedstring-perl6
                      , jwt
                      , optparse-applicative
-                     , packdeps
                      , parsec
                      , process
                      , regex-tdfa
@@ -196,5 +180,4 @@ Test-Suite spec
                      , wai-extra
                      , wai-middleware-static
                      , HTTP
-                     , MissingH
                      , Ranged-sets

src/PostgREST/ApiRequest.hs

@@ -28,9 +28,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
@@ -77,20 +79,25 @@ data ApiRequest = ApiRequest {
 -- | Examines HTTP request and translates it into user intent.
 userApiRequest :: Schema -> Request -> RequestBody -> ApiRequest
 userApiRequest schema req reqBody =
-  let action = case method of
+  let action =
-                 "GET"     -> ActionRead
+        if isTargetingProc
-                 "POST"    -> if isTargetingProc
+          then
-                                then ActionInvoke
+            if method == "POST"
-                                else ActionCreate
+               then ActionInvoke
-                 "PATCH"   -> ActionUpdate
+               else ActionInappropriate
-                 "DELETE"  -> ActionDelete
+          else
-                 "OPTIONS" -> ActionInfo
+            case method of
-                 other     -> ActionUnknown other
+               "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

src/PostgREST/App.hs

@@ -10,10 +10,8 @@ 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           Data.Maybe                (fromMaybe, fromJust, mapMaybe)
+import           Data.Maybe                (isJust, fromMaybe, fromJust, mapMaybe)
 import           Data.Ord                  (comparing)
 import           Data.Ranged.Ranges        (emptyRange)
 import           Data.String.Conversions   (cs)
@@ -33,9 +31,7 @@ import           Data.Aeson
 import           Data.Aeson.Types (emptyArray)
 import           Data.Monoid
 import qualified Data.Vector               as V
-import qualified Hasql                     as H
+import qualified Hasql.Session             as H
-import qualified Hasql.Backend             as B
-import qualified Hasql.Postgres            as P
 
 import           PostgREST.Config          (AppConfig (..))
 import           PostgREST.Parsers
@@ -49,8 +45,7 @@ import           PostgREST.Types
 import           PostgREST.Auth            (tokenJWT)
 import           PostgREST.Error           (errResponse)
 
-import           PostgREST.QueryBuilder ( asJson
+import           PostgREST.QueryBuilder ( callProc
-                                        , callProc
                                         , addJoinConditions
                                         , sourceCTEName
                                         , requestToQuery
@@ -58,11 +53,12 @@ import           PostgREST.QueryBuilder ( asJson
                                         , addRelations
                                         , createReadStatement
                                         , createWriteStatement
+                                        , ResultsWithCount
                                         )
 
 import           Prelude
 
-app :: DbStructure -> AppConfig -> RequestBody -> Request -> H.Tx P.Postgres s Response
+app :: DbStructure -> AppConfig -> RequestBody -> Request -> H.Session Response
 app dbStructure conf reqBody req =
   let
       -- TODO: blow up for Left values (there is a middleware that checks the headers)
@@ -82,17 +78,17 @@ app dbStructure conf reqBody req =
           if range == emptyRange
           then return $ errResponse status416 "HTTP Range error"
           else do
-            row <- H.maybeEx stm
+            row <- H.query () stm
-            let (tableTotal, queryTotal, _ , body) = extractQueryResult row
+            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
+                  to = frm + toInteger queryTotal - 1
-                  contentRange = contentRangeH frm to tableTotal
+                  contentRange = contentRangeH frm to (toInteger <$> tableTotal)
-                  status = rangeStatus frm to tableTotal
+                  status = rangeStatus frm to (toInteger <$> tableTotal)
                   canonical = urlEncodeVars -- should this be moved to the dbStructure (location)?
                     . sortBy (comparing fst)
                     . map (join (***) cs)
@@ -104,91 +100,93 @@ app dbStructure conf reqBody req =
                     "/" <> 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
+          row <- H.query uniform stm
           let (_, _, location, body) = extractQueryResult row
           return $ responseLBS status201
             [
               contentTypeH,
-              (hLocation, "/" <> cs table <> "?" <> cs (fromMaybe "" location))
+              (hLocation, "/" <> cs table <> "?" <> cs location)
             ]
-            $ if iPreferRepresentation apiRequest == Full then fromMaybe "[]" body else ""
+            $ if iPreferRepresentation apiRequest == Full then cs body else ""
 
-    (ActionUpdate, TargetIdent qi, Just payload@(PayloadJSON _)) ->
+    (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 ""
+            $ if iPreferRepresentation apiRequest == Full then cs body else ""
 
     (ActionDelete, TargetIdent qi, Nothing) ->
       case mutateSqlParts of
         Left e -> return $ responseLBS status400 [jsonH] $ cs e
         Right (sq,mq) -> do
-          let fakeload = PayloadJSON $ UniformObjects V.empty
+          let emptyUniform = UniformObjects V.empty
+          let fakeload = PayloadJSON emptyUniform
           let stm = createWriteStatement qi sq mq False (iPreferRepresentation apiRequest) [] (contentType == TextCSV) fakeload
-          row <- H.maybeEx stm
+          row <- H.query emptyUniform stm
           let (_, queryTotal, _, _) = extractQueryResult row
           return $ if queryTotal == 0
             then notFound
             else responseLBS status204 [("Content-Range", "*/"<> cs (show queryTotal))] ""
 
-    (ActionInfo, TargetIdent (QualifiedIdentifier tSchema tTable), Nothing) -> do
+    (ActionInfo, TargetIdent (QualifiedIdentifier tSchema tTable), Nothing) ->
-      let cols = filter (filterCol tSchema tTable) $ dbColumns dbStructure
+      if isJust $ find (\t -> tableName t == tTable && tableSchema t == tSchema) (dbTables dbStructure)
-          pkeys = map pkName $ filter (filterPk tSchema tTable) allPrKeys
+        then let cols = filter (filterCol tSchema tTable) $ dbColumns dbStructure
-          body = encode (TableOptions cols pkeys)
+                 pkeys = map pkName $ filter (filterPk tSchema tTable) allPrKeys
-          filterCol :: Schema -> TableName -> Column -> Bool
+                 body = encode (TableOptions cols pkeys)
-          filterCol sc tb (Column{colTable=Table{tableSchema=s, tableName=t}}) = s==sc && t==tb
+                 filterCol :: Schema -> TableName -> Column -> Bool
-          filterCol _ _ _ =  False
+                 filterCol sc tb Column{colTable=Table{tableSchema=s, tableName=t}} = s==sc && t==tb
-      return $ responseLBS status200 [jsonH, allOrigins] $ cs body
+                 filterCol _ _ _ =  False in
+          return $ responseLBS status200 [jsonH, allOrigins] $ cs body
+        else
+          return notFound
 
-    (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
+          bodyJson <- H.query () (callProc qi p)
-          returnJWT <- doesProcReturnJWT qi
+          returnJWT <- H.query qi doesProcReturnJWT
           return $ responseLBS status200 [jsonH]
-                 (let body = fromMaybe emptyArray $ runIdentity <$> bodyJson in
+                 (let body = fromMaybe emptyArray bodyJson in
                     if returnJWT
                     then "{\"token\":\"" <> cs (tokenJWT jwtSecret body) <> "\"}"
                     else cs $ encode body)
         else return notFound
 
     (ActionRead, TargetRoot, Nothing) -> do
-      body <- encode <$> accessibleTables (filter ((== cs schema) . tableSchema) (dbTables dbStructure))
+      body <- encode <$> H.query schema accessibleTables
       return $ responseLBS status200 [jsonH] $ cs body
 
-    (ActionUnknown _, _, _) -> return notFound
+    (ActionInappropriate, _, _) -> return $ responseLBS status405 [] ""
-
-    (_, TargetUnknown _, _) -> return notFound
 
     (_, _, Just (PayloadParseError e)) ->
       return $ responseLBS status400 [jsonH] $
         cs (formatGeneralError "Cannot parse request payload" (cs e))
 
+    (_, TargetUnknown _, _) -> return notFound
+
     (_, _, _) -> return notFound
 
  where
@@ -206,14 +204,14 @@ app dbStructure conf reqBody req =
   readSqlParts = (,) <$> selectQuery <*> countQuery
   mutateSqlParts = (,) <$> selectQuery <*> mutateQuery
 
-rangeStatus :: Int -> Int -> Maybe Int -> Status
+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
@@ -298,7 +296,7 @@ buildMutateRequest apiRequest =
     cond = first formatParserError $ map snd <$> mapM pRequestFilter mutateFilters
 
 addFilter :: (Path, Filter) -> ReadRequest -> ReadRequest
-addFilter ([], flt) (Node (q@(Select {flt_=flts}), i) forest) = Node (q {flt_=flt:flts}, i) forest
+addFilter ([], flt) (Node (q@Select {flt_=flts}, i) forest) = Node (q {flt_=flt:flts}, i) forest
 addFilter (path, flt) (Node rn forest) =
   case targetNode of
     Nothing -> Node rn forest -- the filter is silenty dropped in the Request does not contain the required path
@@ -335,6 +333,5 @@ instance ToJSON TableOptions where
     , "pkey"   .= tblOptpkey t ]
 
 
-extractQueryResult :: Maybe (Maybe Int, Int, Maybe BL.ByteString, Maybe BL.ByteString)
+extractQueryResult :: Maybe ResultsWithCount -> ResultsWithCount
-                         -> (Maybe Int, Int, Maybe BL.ByteString, Maybe BL.ByteString)
+extractQueryResult = fromMaybe (Nothing, 0, "", "")
-extractQueryResult = fromMaybe (Just 0, 0, Just "", Just "")

src/PostgREST/Auth.hs

@@ -21,6 +21,7 @@ module PostgREST.Auth (
 import           Control.Monad           (join)
 import           Data.Aeson              (Value (..), Object)
 import           Data.Aeson.Types        (emptyObject, emptyArray)
+import qualified Data.ByteString         as BS
 import           Data.Vector             as V (null, head)
 import           Data.Map                as M (fromList, toList)
 import           Data.Monoid             ((<>))
@@ -38,12 +39,12 @@ import qualified Data.HashMap.Lazy       as H
   this one is mapped to a SET ROLE statement.
   In case there is any problem decoding the JWT it returns Nothing.
 -}
-claimsToSQL :: JWT.ClaimsMap -> [Text]
+claimsToSQL :: JWT.ClaimsMap -> [BS.ByteString]
 claimsToSQL = map setVar . toList
   where
     setVar ("role", String val) = setRole val
-    setVar (k, val) = "set local postgrest.claims." <> pgFmtIdent k <>
+    setVar (k, val) = "set local postgrest.claims." <> cs (pgFmtIdent k) <>
-                      " = " <> valueToVariable val <> ";"
+                      " = " <> cs (valueToVariable val) <> ";"
     valueToVariable = pgFmtLit . unquoted
 
 {-|
@@ -65,9 +66,9 @@ jwtClaims secret input time =
     claim prop = prop . JWT.claims <$> decoded
     customClaims = claim JWT.unregisteredClaims
 
--- | Receives the name of a role and returns a SET ROLE statement
+{-| Receives the name of a role and returns a SET ROLE statement -}
-setRole :: Text -> Text
+setRole :: Text -> BS.ByteString
-setRole role = "set local role " <> cs (pgFmtLit role) <> ";"
+setRole r = "set local role " <> cs (pgFmtLit r) <> ";"
 
 
 {-|

src/PostgREST/Config.hs

@@ -37,21 +37,20 @@ 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
   }
 
 argParser :: Parser AppConfig
 argParser = AppConfig
-  <$> argument str (help "database connection string" <> metavar "STRING")
+  <$> 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")
-  <*> 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")
   <*> 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)

src/PostgREST/DbStructure.hs

@@ -10,28 +10,32 @@ module PostgREST.DbStructure (
 , doesProcReturnJWT
 ) where
 
+import qualified Hasql.Query             as H
+import qualified Hasql.Encoders          as HE
+import qualified Hasql.Decoders          as HD
+
 import           Control.Applicative
-import           Control.Monad          (join)
+import           Control.Monad          (join, replicateM)
-import           Data.Functor.Identity
+import           Data.Functor.Contravariant (contramap)
+import           Text.InterpolatedString.Perl6 (q)
 import           Data.List              (elemIndex, find, subsequences, sort, transpose)
 import           Data.Maybe             (fromMaybe, fromJust, isJust, mapMaybe, listToMaybe)
 import           Data.Monoid
 import           Data.Text              (Text, split)
-import qualified Hasql                  as H
+import qualified Hasql.Session          as H
-import qualified Hasql.Postgres         as P
-import qualified Hasql.Backend          as B
 import           PostgREST.Types
 
 import           GHC.Exts               (groupWith)
+import           Data.Int               (Int32)
 import           Prelude
 
-getDbStructure :: Schema -> H.Tx P.Postgres s DbStructure
+getDbStructure :: Schema -> H.Session DbStructure
 getDbStructure schema = do
-  tabs <- allTables
+  tabs <- H.query () allTables
-  cols <- allColumns tabs
+  cols <- H.query () $ allColumns tabs
-  syns <- allSynonyms cols
+  syns <- H.query () $ allSynonyms cols
-  rels <- allRelations tabs cols
+  rels <- H.query () $ allRelations tabs cols
-  keys <- allPrimaryKeys tabs
+  keys <- H.query () $ allPrimaryKeys tabs
 
   let rels' = (addManyToManyRelations . raiseRelations schema syns . addParentRelations . addSynonymousRelations syns) rels
       cols' = addForeignKeys rels' cols
@@ -44,52 +48,113 @@ getDbStructure schema = do
     , dbPrimaryKeys = keys'
     }
 
-doesProc :: forall c s. B.CxValue c Int =>
+encodeQi :: HE.Params QualifiedIdentifier
-            (Text -> Text -> B.Stmt c) -> QualifiedIdentifier -> H.Tx c s Bool
+encodeQi =
-doesProc stmt qi = do
+  contramap qiSchema (HE.value HE.text) <>
-  row :: Maybe (Identity Int) <- H.maybeEx $ stmt (qiSchema qi) (qiName qi)
+  contramap qiName   (HE.value HE.text)
-  return $ isJust row
 
-doesProcExist :: QualifiedIdentifier -> H.Tx P.Postgres s Bool
+decodeTables :: HD.Result [Table]
-doesProcExist = doesProc [H.stmt|
+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 = ?
+      WHERE  nspname = $1
-      AND    proname = ?
+      AND    proname = $2
-    |]
+    ) |]
 
-doesProcReturnJWT :: QualifiedIdentifier -> H.Tx P.Postgres s Bool
+doesProcReturnJWT :: H.Query QualifiedIdentifier Bool
-doesProcReturnJWT = doesProc [H.stmt|
+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 = ?
+      WHERE  nspname = $1
-      AND    proname = ?
+      AND    proname = $2
       AND    pg_catalog.pg_get_function_result(p.oid) like '%jwt_claims'
-    |]
+    ) |]
 
-accessibleTables :: [Table] -> H.Tx P.Postgres s [Table]
+accessibleTables :: H.Query Schema [Table]
-accessibleTables allTabs = do
+accessibleTables =
-  accessible <- H.listEx $ [H.stmt|
+  H.statement sql (HE.value HE.text) decodeTables True
-      SELECT
+ where
-        n.nspname AS table_schema,
+  sql = [q|
-        c.relname AS table_name
+    select
-      FROM pg_class c
+      n.nspname as table_schema,
-      JOIN pg_namespace n ON n.oid = c.relnamespace
+      relname as table_name,
-      WHERE
+      c.relkind = 'r' or (c.relkind IN ('v', 'f')) and (pg_relation_is_updatable(c.oid::regclass, false) & 8) = 8
-        c.relkind IN ('v','r','m') AND
+      or (exists (
-        n.nspname NOT IN ('pg_catalog', 'information_schema') AND (
+         select 1
-          pg_has_role(c.relowner, 'USAGE'::text) OR
+         from pg_trigger
-          has_table_privilege(c.oid, 'SELECT, INSERT, UPDATE, DELETE, TRUNCATE, REFERENCES, TRIGGER'::text) OR
+         where pg_trigger.tgrelid = c.oid and (pg_trigger.tgtype::integer & 69) = 69)
-          has_any_column_privilege(c.oid, 'SELECT, INSERT, UPDATE, REFERENCES'::text)
+      ) as insertable
-        )
+    from
-      ORDER BY table_schema, table_name
+      pg_class c
-    |]
+      join pg_namespace n on n.oid = c.relnamespace
-  let isAccessible table = isJust $ find (\(s,n) -> tableSchema table == s && tableName table == n) accessible
+    where
-  return $ filter isAccessible allTabs
+      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 +172,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 +192,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 +228,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 :: H.Query () [Table]
-allTables = do
+allTables =
-    rows <- H.listEx $ [H.stmt|
+  H.statement sql HE.unit decodeTables True
-      SELECT
+ where
-        n.nspname AS table_schema,
+  sql = [q|
-        c.relname AS table_name,
+    SELECT
-        c.relkind = 'r' OR (c.relkind IN ('v','f'))
+      n.nspname AS table_schema,
-        AND (pg_relation_is_updatable(c.oid::regclass, FALSE) & 8) = 8
+      c.relname AS table_name,
-        OR (EXISTS
+      c.relkind = 'r' OR (c.relkind IN ('v','f'))
-          ( SELECT 1
+      AND (pg_relation_is_updatable(c.oid::regclass, FALSE) & 8) = 8
-            FROM pg_trigger
+      OR (EXISTS
-            WHERE pg_trigger.tgrelid = c.oid
+        ( SELECT 1
-            AND (pg_trigger.tgtype::integer & 69) = 69) ) AS insertable
+          FROM pg_trigger
-      FROM pg_class c
+          WHERE pg_trigger.tgrelid = c.oid
-      JOIN pg_namespace n ON n.oid = c.relnamespace
+          AND (pg_trigger.tgtype::integer & 69) = 69) ) AS insertable
-      WHERE c.relkind IN ('v','r','m')
+    FROM pg_class c
-        AND n.nspname NOT IN ('pg_catalog', 'information_schema')
+    JOIN pg_namespace n ON n.oid = c.relnamespace
-      GROUP BY table_schema, table_name, insertable
+    WHERE c.relkind IN ('v','r','m')
-      ORDER BY table_schema, table_name
+      AND n.nspname NOT IN ('pg_catalog', 'information_schema')
-    |]
+    GROUP BY table_schema, table_name, insertable
-    return $ map tableFromRow rows
+    ORDER BY table_schema, table_name |]
 
-tableFromRow :: (Text, Text, Bool) -> Table
+allColumns :: [Table] -> H.Query () [Column]
-tableFromRow (s, n, i) = Table s n i
+allColumns tabs =
-
+  H.statement sql HE.unit (decodeColumns tabs) True
-allColumns :: [Table] -> H.Tx P.Postgres s [Column]
+ where
-allColumns tabs = do
+  sql = [q|
-  cols <- H.listEx $ [H.stmt|
+    SELECT DISTINCT
-      SELECT DISTINCT
+        info.table_schema AS schema,
-          info.table_schema AS schema,
+        info.table_name AS table_name,
-          info.table_name AS table_name,
+        info.column_name AS name,
-          info.column_name AS name,
+        info.ordinal_position AS position,
-          info.ordinal_position AS position,
+        info.is_nullable::boolean AS nullable,
-          info.is_nullable::boolean AS nullable,
+        info.data_type AS col_type,
-          info.data_type AS col_type,
+        info.is_updatable::boolean AS updatable,
-          info.is_updatable::boolean AS updatable,
+        info.character_maximum_length AS max_len,
-          info.character_maximum_length AS max_len,
+        info.numeric_precision AS precision,
-          info.numeric_precision AS precision,
+        info.column_default AS default_value,
-          info.column_default AS default_value,
+        array_to_string(enum_info.vals, ',') AS enum
-          array_to_string(enum_info.vals, ',') AS enum
+    FROM (
-      FROM (
+        /*
-          /*
+        -- CTE based on information_schema.columns to remove the owner filter
-          -- CTE based on information_schema.columns to remove the owner filter
+        */
-          */
+        WITH columns AS (
-          WITH columns AS (
+            SELECT current_database()::information_schema.sql_identifier AS table_catalog,
-              SELECT current_database()::information_schema.sql_identifier AS table_catalog,
+                nc.nspname::information_schema.sql_identifier AS table_schema,
-                  nc.nspname::information_schema.sql_identifier AS table_schema,
+                c.relname::information_schema.sql_identifier AS table_name,
-                  c.relname::information_schema.sql_identifier AS table_name,
+                a.attname::information_schema.sql_identifier AS column_name,
-                  a.attname::information_schema.sql_identifier AS column_name,
+                a.attnum::information_schema.cardinal_number AS ordinal_position,
-                  a.attnum::information_schema.cardinal_number AS ordinal_position,
+                pg_get_expr(ad.adbin, ad.adrelid)::information_schema.character_data AS column_default,
-                  pg_get_expr(ad.adbin, ad.adrelid)::information_schema.character_data AS column_default,
+                    CASE
-                      CASE
+                        WHEN a.attnotnull OR t.typtype = 'd'::"char" AND t.typnotnull THEN 'NO'::text
-                          WHEN a.attnotnull OR t.typtype = 'd'::"char" AND t.typnotnull THEN 'NO'::text
+                        ELSE 'YES'::text
-                          ELSE 'YES'::text
+                    END::information_schema.yes_or_no AS is_nullable,
-                      END::information_schema.yes_or_no AS is_nullable,
+                    CASE
-                      CASE
+                        WHEN t.typtype = 'd'::"char" THEN
-                          WHEN t.typtype = 'd'::"char" THEN
+                        CASE
-                          CASE
+                            WHEN bt.typelem <> 0::oid AND bt.typlen = (-1) THEN 'ARRAY'::text
-                              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)
-                              WHEN nbt.nspname = 'pg_catalog'::name THEN format_type(t.typbasetype, NULL::integer)
+                            ELSE 'USER-DEFINED'::text
-                              ELSE 'USER-DEFINED'::text
+                        END
-                          END
+                        ELSE
-                          ELSE
+                        CASE
-                          CASE
+                            WHEN t.typelem <> 0::oid AND t.typlen = (-1) THEN 'ARRAY'::text
-                              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)
-                              WHEN nt.nspname = 'pg_catalog'::name THEN format_type(a.atttypid, NULL::integer)
+                            ELSE 'USER-DEFINED'::text
-                              ELSE 'USER-DEFINED'::text
+                        END
-                          END
+                    END::information_schema.character_data AS data_type,
-                      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_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_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(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_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_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_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,
-                  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::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_catalog,
+                NULL::character varying::information_schema.sql_identifier AS character_set_schema,
-                  NULL::character varying::information_schema.sql_identifier AS character_set_schema,
+                NULL::character varying::information_schema.sql_identifier AS character_set_name,
-                  NULL::character varying::information_schema.sql_identifier AS character_set_name,
+                    CASE
-                      CASE
+                        WHEN nco.nspname IS NOT NULL THEN current_database()
-                          WHEN nco.nspname IS NOT NULL THEN current_database()
+                        ELSE NULL::name
-                          ELSE NULL::name
+                    END::information_schema.sql_identifier AS collation_catalog,
-                      END::information_schema.sql_identifier AS collation_catalog,
+                nco.nspname::information_schema.sql_identifier AS collation_schema,
-                  nco.nspname::information_schema.sql_identifier AS collation_schema,
+                co.collname::information_schema.sql_identifier AS collation_name,
-                  co.collname::information_schema.sql_identifier AS collation_name,
+                    CASE
-                      CASE
+                        WHEN t.typtype = 'd'::"char" THEN current_database()
-                          WHEN t.typtype = 'd'::"char" THEN current_database()
+                        ELSE NULL::name
-                          ELSE NULL::name
+                    END::information_schema.sql_identifier AS domain_catalog,
-                      END::information_schema.sql_identifier AS domain_catalog,
+                    CASE
-                      CASE
+                        WHEN t.typtype = 'd'::"char" THEN nt.nspname
-                          WHEN t.typtype = 'd'::"char" THEN nt.nspname
+                        ELSE NULL::name
-                          ELSE NULL::name
+                    END::information_schema.sql_identifier AS domain_schema,
-                      END::information_schema.sql_identifier AS domain_schema,
+                    CASE
-                      CASE
+                        WHEN t.typtype = 'd'::"char" THEN t.typname
-                          WHEN t.typtype = 'd'::"char" THEN t.typname
+                        ELSE NULL::name
-                          ELSE NULL::name
+                    END::information_schema.sql_identifier AS domain_name,
-                      END::information_schema.sql_identifier AS domain_name,
+                current_database()::information_schema.sql_identifier AS udt_catalog,
-                  current_database()::information_schema.sql_identifier AS udt_catalog,
+                COALESCE(nbt.nspname, nt.nspname)::information_schema.sql_identifier AS udt_schema,
-                  COALESCE(nbt.nspname, nt.nspname)::information_schema.sql_identifier AS udt_schema,
+                COALESCE(bt.typname, t.typname)::information_schema.sql_identifier AS udt_name,
-                  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_catalog,
+                NULL::character varying::information_schema.sql_identifier AS scope_schema,
-                  NULL::character varying::information_schema.sql_identifier AS scope_schema,
+                NULL::character varying::information_schema.sql_identifier AS scope_name,
-                  NULL::character varying::information_schema.sql_identifier AS scope_name,
+                NULL::integer::information_schema.cardinal_number AS maximum_cardinality,
-                  NULL::integer::information_schema.cardinal_number AS maximum_cardinality,
+                a.attnum::information_schema.sql_identifier AS dtd_identifier,
-                  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_self_referencing,
+                'NO'::character varying::information_schema.yes_or_no AS is_identity,
-                  '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_generation,
+                NULL::character varying::information_schema.character_data AS identity_start,
-                  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_increment,
+                NULL::character varying::information_schema.character_data AS identity_maximum,
-                  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.character_data AS identity_minimum,
+                NULL::character varying::information_schema.yes_or_no AS identity_cycle,
-                  NULL::character varying::information_schema.yes_or_no AS identity_cycle,
+                'NEVER'::character varying::information_schema.character_data AS is_generated,
-                  'NEVER'::character varying::information_schema.character_data AS is_generated,
+                NULL::character varying::information_schema.character_data AS generation_expression,
-                  NULL::character varying::information_schema.character_data AS generation_expression,
+                CASE
-                  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
-                      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
-                      ELSE 'NO'::text
+                END::information_schema.yes_or_no AS is_updatable
-                  END::information_schema.yes_or_no AS is_updatable
+            FROM pg_attribute a
-              FROM pg_attribute a
+               LEFT JOIN pg_attrdef ad ON a.attrelid = ad.adrelid AND a.attnum = ad.adnum
-                 LEFT JOIN pg_attrdef ad ON a.attrelid = ad.adrelid AND a.attnum = ad.adnum
+               JOIN (pg_class c
-                 JOIN (pg_class c
+               JOIN pg_namespace nc ON c.relnamespace = nc.oid) ON a.attrelid = c.oid
-                 JOIN pg_namespace nc ON c.relnamespace = nc.oid) ON a.attrelid = c.oid
+               JOIN (pg_type t
-                 JOIN (pg_type t
+               JOIN pg_namespace nt ON t.typnamespace = nt.oid) ON a.atttypid = t.oid
-                 JOIN pg_namespace nt ON t.typnamespace = nt.oid) ON a.atttypid = t.oid
+               LEFT JOIN (pg_type bt
-                 LEFT JOIN (pg_type bt
+               JOIN pg_namespace nbt ON bt.typnamespace = nbt.oid) ON t.typtype = 'd'::"char" AND t.typbasetype = bt.oid
-                 JOIN pg_namespace nbt ON bt.typnamespace = nbt.oid) ON t.typtype = 'd'::"char" AND t.typbasetype = bt.oid
+               LEFT JOIN (pg_collation co
-                 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)
-                 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"]))
-              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))*/
-                /*--AND (pg_has_role(c.relowner, 'USAGE'::text) OR has_column_privilege(c.oid, a.attnum, 'SELECT, INSERT, UPDATE, REFERENCES'::text))*/
+        )
-          )
+        SELECT
-          SELECT
+            table_schema,
-              table_schema,
+            table_name,
-              table_name,
+            column_name,
-              column_name,
+            ordinal_position,
-              ordinal_position,
+            is_nullable,
-              is_nullable,
+            data_type,
-              data_type,
+            is_updatable,
-              is_updatable,
+            character_maximum_length,
-              character_maximum_length,
+            numeric_precision,
-              numeric_precision,
+            column_default,
-              column_default,
+            udt_name
-              udt_name
+        /*-- FROM information_schema.columns*/
-          /*-- FROM information_schema.columns*/
+        FROM columns
-          FROM columns
+        WHERE table_schema NOT IN ('pg_catalog', 'information_schema')
-          WHERE table_schema NOT IN ('pg_catalog', 'information_schema')
+    ) AS info
-      ) AS info
+    LEFT OUTER JOIN (
-      LEFT OUTER JOIN (
+        SELECT
-          SELECT
+            n.nspname AS s,
-              n.nspname AS s,
+            t.typname AS n,
-              t.typname AS n,
+            array_agg(e.enumlabel ORDER BY e.enumsortorder) AS vals
-              array_agg(e.enumlabel ORDER BY e.enumsortorder) AS vals
+        FROM pg_type t
-          FROM pg_type t
+        JOIN pg_enum e ON t.oid = e.enumtypid
-          JOIN pg_enum e ON t.oid = e.enumtypid
+        JOIN pg_catalog.pg_namespace n ON n.oid = t.typnamespace
-          JOIN pg_catalog.pg_namespace n ON n.oid = t.typnamespace
+        GROUP BY s,n
-          GROUP BY s,n
+    ) AS enum_info ON (info.udt_name = enum_info.n)
-      ) AS enum_info ON (info.udt_name = enum_info.n)
+    ORDER BY schema, position |]
-      ORDER BY schema, position
-  |]
-  return $ mapMaybe (columnFromRow tabs) cols
 
 columnFromRow :: [Table] ->
-                 (Text,       Text,      Text,
+                 (Text,       Text,        Text,
-                  Int,        Bool,      Text,
+                  Int32,      Bool,        Text,
-                  Bool,       Maybe Int, Maybe Int,
+                  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 +401,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 :: [Table] -> [Column] -> H.Query () [Relation]
-allRelations tabs cols = do
+allRelations tabs cols =
-  rels <- H.listEx $ [H.stmt|
+  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 +429,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)
+    ORDER BY (conrelid, column_info.nums) |]
-  |]
-  return $ mapMaybe (relationFromRow tabs cols) rels
 
 relationFromRow :: [Table] -> [Column] -> (Text, Text, [Text], Text, Text, [Text]) -> Maybe Relation
 relationFromRow allTabs allCols (rs, rt, rcs, frs, frt, frcs) =
@@ -378,119 +442,121 @@ 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 :: [Table] -> H.Query () [PrimaryKey]
-allPrimaryKeys tabs = do
+allPrimaryKeys tabs =
-  pks <- H.listEx $ [H.stmt|
+  H.statement sql HE.unit (decodePks tabs) True
-      /*
+ where
-      -- CTE to replace information_schema.table_constraints to remove owner limit
+  sql = [q|
-      */
+    /*
-      WITH tc AS (
+    -- CTE to replace information_schema.table_constraints to remove owner limit
-          SELECT current_database()::information_schema.sql_identifier AS constraint_catalog,
+    */
-              nc.nspname::information_schema.sql_identifier AS constraint_schema,
+    WITH tc AS (
-              c.conname::information_schema.sql_identifier AS constraint_name,
+        SELECT current_database()::information_schema.sql_identifier AS constraint_catalog,
-              current_database()::information_schema.sql_identifier AS table_catalog,
+            nc.nspname::information_schema.sql_identifier AS constraint_schema,
-              nr.nspname::information_schema.sql_identifier AS table_schema,
+            c.conname::information_schema.sql_identifier AS constraint_name,
-              r.relname::information_schema.sql_identifier AS table_name,
+            current_database()::information_schema.sql_identifier AS table_catalog,
-                  CASE c.contype
+            nr.nspname::information_schema.sql_identifier AS table_schema,
-                      WHEN 'c'::"char" THEN 'CHECK'::text
+            r.relname::information_schema.sql_identifier AS table_name,
-                      WHEN 'f'::"char" THEN 'FOREIGN KEY'::text
+                CASE c.contype
-                      WHEN 'p'::"char" THEN 'PRIMARY KEY'::text
+                    WHEN 'c'::"char" THEN 'CHECK'::text
-                      WHEN 'u'::"char" THEN 'UNIQUE'::text
+                    WHEN 'f'::"char" THEN 'FOREIGN KEY'::text
-                      ELSE NULL::text
+                    WHEN 'p'::"char" THEN 'PRIMARY KEY'::text
-                  END::information_schema.character_data AS constraint_type,
+                    WHEN 'u'::"char" THEN 'UNIQUE'::text
-                  CASE
+                    ELSE NULL::text
-                      WHEN c.condeferrable THEN 'YES'::text
+                END::information_schema.character_data AS constraint_type,
-                      ELSE 'NO'::text
+                CASE
-                  END::information_schema.yes_or_no AS is_deferrable,
+                    WHEN c.condeferrable THEN 'YES'::text
-                  CASE
+                    ELSE 'NO'::text
-                      WHEN c.condeferred THEN 'YES'::text
+                END::information_schema.yes_or_no AS is_deferrable,
-                      ELSE 'NO'::text
+                CASE
-                  END::information_schema.yes_or_no AS initially_deferred
+                    WHEN c.condeferred THEN 'YES'::text
-          FROM pg_namespace nc,
+                    ELSE 'NO'::text
-              pg_namespace nr,
+                END::information_schema.yes_or_no AS initially_deferred
-              pg_constraint c,
+        FROM pg_namespace nc,
-              pg_class r
+            pg_namespace nr,
-          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)
+            pg_constraint c,
-          /*--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))*/
+            pg_class r
-          UNION ALL
+        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)
-          SELECT current_database()::information_schema.sql_identifier AS constraint_catalog,
+        /*--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))*/
-              nr.nspname::information_schema.sql_identifier AS constraint_schema,
+        UNION ALL
-              (((((nr.oid::text || '_'::text) || r.oid::text) || '_'::text) || a.attnum::text) || '_not_null'::text)::information_schema.sql_identifier AS constraint_name,
+        SELECT current_database()::information_schema.sql_identifier AS constraint_catalog,
-              current_database()::information_schema.sql_identifier AS table_catalog,
+            nr.nspname::information_schema.sql_identifier AS constraint_schema,
-              nr.nspname::information_schema.sql_identifier AS table_schema,
+            (((((nr.oid::text || '_'::text) || r.oid::text) || '_'::text) || a.attnum::text) || '_not_null'::text)::information_schema.sql_identifier AS constraint_name,
-              r.relname::information_schema.sql_identifier AS table_name,
+            current_database()::information_schema.sql_identifier AS table_catalog,
-              'CHECK'::character varying::information_schema.character_data AS constraint_type,
+            nr.nspname::information_schema.sql_identifier AS table_schema,
-              'NO'::character varying::information_schema.yes_or_no AS is_deferrable,
+            r.relname::information_schema.sql_identifier AS table_name,
-              'NO'::character varying::information_schema.yes_or_no AS initially_deferred
+            'CHECK'::character varying::information_schema.character_data AS constraint_type,
-          FROM pg_namespace nr,
+            'NO'::character varying::information_schema.yes_or_no AS is_deferrable,
-              pg_class r,
+            'NO'::character varying::information_schema.yes_or_no AS initially_deferred
-              pg_attribute a
+        FROM pg_namespace nr,
-          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)
+            pg_class r,
-          /*--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))*/
+            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 (
+    -- CTE to replace information_schema.key_column_usage to remove owner limit
-          SELECT current_database()::information_schema.sql_identifier AS constraint_catalog,
+    */
-              ss.nc_nspname::information_schema.sql_identifier AS constraint_schema,
+    kc AS (
-              ss.conname::information_schema.sql_identifier AS constraint_name,
+        SELECT current_database()::information_schema.sql_identifier AS constraint_catalog,
-              current_database()::information_schema.sql_identifier AS table_catalog,
+            ss.nc_nspname::information_schema.sql_identifier AS constraint_schema,
-              ss.nr_nspname::information_schema.sql_identifier AS table_schema,
+            ss.conname::information_schema.sql_identifier AS constraint_name,
-              ss.relname::information_schema.sql_identifier AS table_name,
+            current_database()::information_schema.sql_identifier AS table_catalog,
-              a.attname::information_schema.sql_identifier AS column_name,
+            ss.nr_nspname::information_schema.sql_identifier AS table_schema,
-              (ss.x).n::information_schema.cardinal_number AS ordinal_position,
+            ss.relname::information_schema.sql_identifier AS table_name,
-                  CASE
+            a.attname::information_schema.sql_identifier AS column_name,
-                      WHEN ss.contype = 'f'::"char" THEN information_schema._pg_index_position(ss.conindid, ss.confkey[(ss.x).n])
+            (ss.x).n::information_schema.cardinal_number AS ordinal_position,
-                      ELSE NULL::integer
+                CASE
-                  END::information_schema.cardinal_number AS position_in_unique_constraint
+                    WHEN ss.contype = 'f'::"char" THEN information_schema._pg_index_position(ss.conindid, ss.confkey[(ss.x).n])
-          FROM pg_attribute a,
+                    ELSE NULL::integer
-              ( SELECT r.oid AS roid,
+                END::information_schema.cardinal_number AS position_in_unique_constraint
-                  r.relname,
+        FROM pg_attribute a,
-                  r.relowner,
+            ( SELECT r.oid AS roid,
-                  nc.nspname AS nc_nspname,
+                r.relname,
-                  nr.nspname AS nr_nspname,
+                r.relowner,
-                  c.oid AS coid,
+                nc.nspname AS nc_nspname,
-                  c.conname,
+                nr.nspname AS nr_nspname,
-                  c.contype,
+                c.oid AS coid,
-                  c.conindid,
+                c.conname,
-                  c.confkey,
+                c.contype,
-                  c.confrelid,
+                c.conindid,
-                  information_schema._pg_expandarray(c.conkey) AS x
+                c.confkey,
-                 FROM pg_namespace nr,
+                c.confrelid,
-                  pg_class r,
+                information_schema._pg_expandarray(c.conkey) AS x
-                  pg_namespace nc,
+               FROM pg_namespace nr,
-                  pg_constraint c
+                pg_class r,
-                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
+                pg_namespace nc,
-          WHERE ss.roid = a.attrelid AND a.attnum = (ss.x).x AND NOT a.attisdropped
+                pg_constraint c
-          /*--AND (pg_has_role(ss.relowner, 'USAGE'::text) OR has_column_privilege(ss.roid, a.attnum, 'SELECT, INSERT, UPDATE, REFERENCES'::text))*/
+              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
-      SELECT
+        /*--AND (pg_has_role(ss.relowner, 'USAGE'::text) OR has_column_privilege(ss.roid, a.attnum, 'SELECT, INSERT, UPDATE, REFERENCES'::text))*/
-          kc.table_schema,
+    )
-          kc.table_name,
+    SELECT
-          kc.column_name
+        kc.table_schema,
-      FROM
+        kc.table_name,
-          /*
+        kc.column_name
-          --information_schema.table_constraints tc,
+    FROM
-          --information_schema.key_column_usage kc
+        /*
-          */
+        --information_schema.table_constraints tc,
-          tc, kc
+        --information_schema.key_column_usage kc
-      WHERE
+        */
-          tc.constraint_type = 'PRIMARY KEY' AND
+        tc, kc
-          kc.table_name = tc.table_name AND
+    WHERE
-          kc.table_schema = tc.table_schema AND
+        tc.constraint_type = 'PRIMARY KEY' AND
-          kc.constraint_name = tc.constraint_name AND
+        kc.table_name = tc.table_name AND
-          kc.table_schema NOT IN ('pg_catalog', 'information_schema')
+        kc.table_schema = tc.table_schema AND
-    |]
+        kc.constraint_name = tc.constraint_name AND
-  return $ mapMaybe (pkFromRow tabs) pks
+        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 :: [Column] -> H.Query () [(Column,Column)]
-allSynonyms allCols = do
+allSynonyms cols =
-  syns <- H.listEx $ [H.stmt|
+  H.statement sql HE.unit (decodeSynonyms cols) True
+ where
+  sql = [q|
     WITH synonyms AS (
       /*
       -- CTE to replace the view from information_schema because the information in it depended on the logged in role
@@ -552,9 +618,7 @@ allSynonyms allCols = do
         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
-    )
+    ) |]
-    |]
-  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,64 @@
 {-# 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.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.Session             as H
-import qualified Hasql.Postgres            as P
 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 :: H.Error -> Response
 pgErrResponse e = responseLBS (httpStatus e)
   [(hContentType, "application/json")] (JSON.encode e)
 
-instance JSON.ToJSON PgError where
+instance JSON.ToJSON H.Error where
-  toJSON (H.TxError (P.ErroneousResult c m d h)) = JSON.object [
+  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 [
+  toJSON (H.ResultError (H.UnexpectedResult m)) = JSON.object [
-    "message" .= ("No response from server"::T.Text),
+    "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.Error -> HT.Status
-httpStatus (H.TxError (P.ErroneousResult codeBS _ _ _)) =
+httpStatus (H.ResultError (H.ServerError c _ _ _)) =
-  let code = cs codeBS in
+  case cs c of
-  case code of
     '0':'8':_ -> HT.status503 -- pg connection err
     '0':'9':_ -> HT.status500 -- triggered action exception
     '0':'L':_ -> HT.status403 -- invalid grantor
     '0':'P':_ -> HT.status403 -- invalid role specification
+    "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
@@ -73,5 +79,5 @@ httpStatus (H.TxError (P.ErroneousResult codeBS _ _ _)) =
     "42P01" -> HT.status404 -- undefined table
     "42501" -> HT.status404 -- insufficient privilege
     _ -> HT.status400
-httpStatus (H.TxError (P.NoResult _)) = HT.status503
+httpStatus (H.ResultError _) = HT.status500
-httpStatus _ = HT.status500
+httpStatus (H.ClientError _) = HT.status503

src/PostgREST/Main.hs

@@ -9,21 +9,23 @@ import           PostgREST.Config                     (AppConfig (..),
                                                        prettyVersion,
                                                        readOptions)
 import           PostgREST.DbStructure
-import           PostgREST.Error                      (PgError, pgErrResponse)
+import           PostgREST.Error                      (errResponse, pgErrResponse)
 import           PostgREST.Middleware
+import           PostgREST.QueryBuilder               (inTransaction, Isolation(..))
 
 import           Control.Monad                        (unless, void)
-import           Control.Monad.IO.Class               (liftIO)
-import           Data.Aeson                           (encode)
-import           Data.Functor.Identity
 import           Data.Monoid                          ((<>))
+import           Data.Pool
 import           Data.String.Conversions              (cs)
-import           Data.Text                            (Text)
 import           Data.Time.Clock.POSIX                (getPOSIXTime)
-import qualified Hasql                                as H
+import qualified Hasql.Query                          as H
-import qualified Hasql.Postgres                       as P
+import qualified Hasql.Connection                     as H
+import qualified Hasql.Session                        as H
+import qualified Hasql.Decoders                       as HD
+import qualified Hasql.Encoders                       as HE
+import qualified Network.HTTP.Types.Status            as HT
 import           Network.Wai
-import           Network.Wai.Handler.Warp             hiding (Connection)
+import           Network.Wai.Handler.Warp
 import           Network.Wai.Middleware.RequestLogger (logStdout)
 import           System.IO                            (BufferMode (..),
                                                        hSetBuffering, stderr,
@@ -36,13 +38,14 @@ import           Control.Concurrent                   (myThreadId)
 import           Control.Exception.Base               (throwTo, AsyncException(..))
 #endif
 
-isServerVersionSupported :: H.Session P.Postgres IO Bool
+isServerVersionSupported :: H.Session Bool
 isServerVersionSupported = do
-  Identity (row :: Text) <- H.tx Nothing $ H.singleEx [H.stmt|SHOW server_version_num|]
+  ver <- H.query () pgVersion
-  return $ read (cs row) >= minimumPgVersion
+  return $ read (cs ver) >= minimumPgVersion
-
+ where
-hasqlError :: PgError -> IO a
+  pgVersion =
-hasqlError = error . cs . encode
+    H.statement "SHOW server_version_num"
+      HE.unit (HD.singleRow $ HD.value HD.text) True
 
 main :: IO ()
 main = do
@@ -58,40 +61,44 @@ main = do
   Prelude.putStrLn $ "Listening on port " ++
     (show $ configPort conf :: String)
 
-  let pgSettings = P.StringSettings $ cs (configDatabase conf)
+  let pgSettings = cs (configDatabase conf)
       appSettings = setPort port
                   . setServerName (cs $ "postgrest/" <> prettyVersion)
                   $ defaultSettings
       middle = logStdout . defaultMiddle
 
-  poolSettings <- maybe (fail "Improper session settings") return $
+  pool <- createPool (H.acquire pgSettings)
-    H.poolSettings (fromIntegral $ configPool conf) 30
+            (either (const $ return ()) H.release) 1 1 (configPool conf)
-  pool :: H.Pool P.Postgres <- H.acquirePool pgSettings poolSettings
 
-  supportedOrError <- H.session pool isServerVersionSupported
+  dbStructure <- withResource pool $ \case
-  either hasqlError
+    Left err -> error $ show err
-    (\supported ->
+    Right c -> do
-      unless supported $
+      supported <- H.run isServerVersionSupported c
-        error (
+      case supported of
-          "Cannot run in this PostgreSQL version, PostgREST needs at least "
+        Left e -> error $ show e
-          <> show minimumPgVersion)
+        Right good -> unless good $
-    ) supportedOrError
+          error (
+            "Cannot run in this PostgreSQL version, PostgREST needs at least "
+            <> show minimumPgVersion)
+
+      dbOrError <- H.run (getDbStructure (cs $ configSchema conf)) c
+      either (error . show) return dbOrError
 
 #ifndef mingw32_HOST_OS
   tid <- myThreadId
   void $ installHandler keyboardSignal (Catch $ do
-      H.releasePool pool
+      destroyAllResources 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 $
+    let handleReq = H.run $ inTransaction ReadCommitted
-      runWithClaims conf time (app dbStructure conf body) req
+          (runWithClaims conf time (app dbStructure conf body) req)
-    either (respond . pgErrResponse) respond resOrError
+    withResource pool $ \case
+      Left err -> respond $ errResponse HT.status500 (cs . show $ err)
+      Right c -> do
+        resOrError <- handleReq c
+        either (respond . pgErrResponse) respond resOrError

src/PostgREST/Middleware.hs

@@ -7,8 +7,7 @@ import           Data.Maybe                    (fromMaybe)
 import           Data.Text
 import           Data.String.Conversions       (cs)
 import           Data.Time.Clock               (NominalDiffTime)
-import qualified Hasql                         as H
+import qualified Hasql.Session                 as H
-import qualified Hasql.Postgres                as P
 
 import           Network.HTTP.Types.Header     (hAccept, hAuthorization)
 import           Network.HTTP.Types.Status     (status415, status400)
@@ -25,28 +24,25 @@ import           PostgREST.Error               (errResponse)
 
 import           Prelude hiding(concat)
 
-import qualified Data.Vector             as V
-import qualified Hasql.Backend           as B
 import qualified Data.Map.Lazy           as M
 
-runWithClaims :: forall s. AppConfig -> NominalDiffTime ->
+runWithClaims :: AppConfig -> NominalDiffTime ->
-                 (Request -> H.Tx P.Postgres s Response) ->
+                 (Request -> H.Session Response) ->
-                 Request -> H.Tx P.Postgres s Response
+                 Request -> H.Session Response
 runWithClaims conf time app req = do
-    _ <- H.unitEx $ stmt setAnon
+    H.sql setAnon
     case split (== ' ') (cs auth) of
       ("Bearer" : tokenStr : _) ->
         case jwtClaims jwtSecret tokenStr time of
           Just claims ->
             if M.member "role" claims
             then do
-              mapM_ H.unitEx $ stmt <$> claimsToSQL claims
+              mapM_ H.sql $ claimsToSQL claims
               app req
             else invalidJWT
           _ -> invalidJWT
       _ -> app req
   where
-    stmt c = B.Stmt c V.empty True
     hdrs = requestHeaders req
     jwtSecret = configJwtSecret conf
     auth = fromMaybe "" $ lookup hAuthorization hdrs

src/PostgREST/QueryBuilder.hs

@@ -15,10 +15,10 @@ Any function that outputs a SQL fragment should be in this module.
 module PostgREST.QueryBuilder (
     addRelations
   , addJoinConditions
-  , asJson
   , callProc
   , createReadStatement
   , createWriteStatement
+  , inTransaction
   , operators
   , pgFmtIdent
   , pgFmtLit
@@ -26,28 +26,34 @@ module PostgREST.QueryBuilder (
   , requestToCountQuery
   , sourceCTEName
   , unquoted
+  , ResultsWithCount
+  , Isolation(..)
   ) where
 
-import qualified Hasql                   as H
+import qualified Hasql.Query             as H
-import qualified Hasql.Backend           as B
+import qualified Hasql.Session           as H
-import qualified Hasql.Postgres          as P
+import qualified Hasql.Encoders          as HE
+import qualified Hasql.Decoders          as HD
 
 import qualified Data.Aeson              as JSON
+import           Data.Int                (Int64)
 
 import           PostgREST.RangeQuery    (NonnegRange, rangeLimit, rangeOffset)
 import           Control.Error           (note, fromMaybe, mapMaybe)
+import           Data.Functor.Contravariant (contramap)
 import qualified Data.HashMap.Strict     as HM
 import           Data.List               (find, (\\))
 import           Data.Monoid             ((<>))
 import           Data.Text               (Text, intercalate, unwords, replace, isInfixOf, toLower, split)
 import qualified Data.Text as T          (map, takeWhile)
 import           Data.String.Conversions (cs)
-import           Control.Applicative     (empty, (<|>))
+import           Control.Applicative     ((<|>))
 import           Control.Monad           (join)
 import           Data.Tree               (Tree(..))
 import qualified Data.Vector as V
 import           PostgREST.Types
 import qualified Data.Map as M
+import           Text.InterpolatedString.Perl6 (qc)
 import           Text.Regex.TDFA         ((=~))
 import qualified Data.ByteString.Char8   as BS
 import           Data.Scientific         ( FPFormat (..)
@@ -57,70 +63,101 @@ 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
 
-createReadStatement :: SqlQuery -> SqlQuery -> NonnegRange -> Bool -> Bool -> Bool -> B.Stmt P.Postgres
+{-| The generic query result format used by API responses -}
+type ResultsWithCount = (Maybe Int64, Int64, BS.ByteString, BS.ByteString)
+
+{-| Read and Write api requests use a similar response format which includes
+    various record counts and possible location header. This is the decoder
+    for that common type of query.
+-}
+decodeStandard :: HD.Result ResultsWithCount
+decodeStandard =
+  HD.singleRow standardRow
+ where
+  standardRow = (,,,) <$> HD.nullableValue HD.int8 <*> HD.value HD.int8
+                      <*> HD.value HD.bytea <*> HD.value HD.bytea
+
+decodeStandardMay :: HD.Result (Maybe ResultsWithCount)
+decodeStandardMay =
+  HD.maybeRow standardRow
+ where
+  standardRow = (,,,) <$> HD.nullableValue HD.int8 <*> HD.value HD.int8
+                      <*> HD.value HD.bytea <*> HD.value HD.bytea
+
+{-| JSON and CSV payloads from the client are given to us as
+    UniformObjects (objects who all have the same keys),
+    and we turn this into an old fasioned JSON array
+-}
+encodeUniformObjs :: HE.Params UniformObjects
+encodeUniformObjs =
+  contramap (JSON.Array . V.map JSON.Object . unUniformObjects) (HE.value HE.json)
+
+createReadStatement :: SqlQuery -> SqlQuery -> NonnegRange -> Bool -> Bool -> Bool ->
+                       H.Query () ResultsWithCount
 createReadStatement selectQuery countQuery range isSingle countTotal asCsv =
-  B.Stmt (
+  H.statement sql HE.unit decodeStandard True
-    "WITH " <> sourceCTEName <> " AS (" <> selectQuery <> ") " <>
+ where
-    "SELECT " <> intercalate ", " [
+  sql = [qc|
+      WITH {sourceCTEName} AS ({selectQuery}) SELECT {cols}
+      FROM ( SELECT * FROM {sourceCTEName} {limitF range}) t |]
+  countResultF = if countTotal then "("<>countQuery<>")" else "null"
+  cols = intercalate ", " [
       countResultF <> " AS total_result_set",
       "pg_catalog.count(t) AS page_total",
-      "null AS header",
+      "'' AS header",
       bodyF <> " AS body"
-    ] <>
+    ]
-    " FROM ( SELECT * FROM " <> sourceCTEName <> " " <> limitF range <> ") t"
+  bodyF
-  ) V.empty True
+    | asCsv = asCsvF
-  where
+    | isSingle = asJsonSingleF
-    countResultF = if countTotal then "("<>countQuery<>")" else "null"
+    | otherwise = asJsonF
-    bodyF
-      | asCsv = asCsvF
-      | isSingle = asJsonSingleF
-      | otherwise = asJsonF
 
-createWriteStatement :: QualifiedIdentifier -> SqlQuery -> SqlQuery -> Bool -> PreferRepresentation ->
+createWriteStatement :: QualifiedIdentifier -> SqlQuery -> SqlQuery -> Bool ->
-                        [Text] -> Bool -> Payload -> B.Stmt P.Postgres
+                        PreferRepresentation -> [Text] -> Bool -> Payload ->
+                        H.Query UniformObjects (Maybe ResultsWithCount)
 createWriteStatement _ _ _ _ _ _ _ (PayloadParseError _) = undefined
 createWriteStatement _ _ mutateQuery _ None
-                     _ _ (PayloadJSON (UniformObjects rows)) =
+                     _ _ (PayloadJSON (UniformObjects _)) =
-  B.Stmt (
+  H.statement sql encodeUniformObjs decodeStandardMay True
-    "WITH " <> sourceCTEName <> " AS (" <> mutateQuery <> ") " <>
+ where
-    "SELECT null, 0, null, null"
+  sql = [qc|
-  ) (V.singleton . B.encodeValue . JSON.Array . V.map JSON.Object $ rows) True
+      WITH {sourceCTEName} AS ({mutateQuery})
+      SELECT '', 0, '', '' |]
+
 createWriteStatement qi _ mutateQuery isSingle HeadersOnly
-                     pKeys _ (PayloadJSON (UniformObjects rows)) =
+                     pKeys _ (PayloadJSON (UniformObjects _)) =
-  B.Stmt (
+  H.statement sql encodeUniformObjs decodeStandardMay True
-    "WITH " <> sourceCTEName <> " AS (" <> mutateQuery <> " RETURNING " <> fromQi qi <> ".*" <> ") " <>
+ where
-    "SELECT " <> intercalate ", " [
+  sql = [qc|
-      "null AS total_result_set",
+      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",
+      if isSingle then locationF pKeys else "''",
-      "null"
+      "''"
-    ] <>
+    ]
-    " FROM (SELECT 1 FROM " <> sourceCTEName <> ") t"
+
-  ) (V.singleton . B.encodeValue . JSON.Array . V.map JSON.Object $ rows) True
 createWriteStatement qi selectQuery mutateQuery isSingle Full
-                     pKeys asCsv (PayloadJSON (UniformObjects rows)) =
+                     pKeys asCsv (PayloadJSON (UniformObjects _)) =
-  B.Stmt (
+  H.statement sql encodeUniformObjs decodeStandardMay True
-    "WITH " <> sourceCTEName <> " AS (" <> mutateQuery <> " RETURNING " <> fromQi qi <> ".*" <> ") " <>
+ where
-    "SELECT " <> intercalate ", " [
+  sql = [qc|
-      "null AS total_result_set", -- when updateing it does not make sense
+      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 "''" <> " AS header",
       bodyF <> " AS body"
-    ] <>
+    ]
-    " FROM ( "<>selectQuery<>") t"
+  bodyF
-  ) (V.singleton . B.encodeValue . JSON.Array . V.map JSON.Object $ rows) True
+    | asCsv = asCsvF
-  where
+    | isSingle = asJsonSingleF
-    bodyF
+    | otherwise = asJsonF
-      | 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) =
@@ -129,11 +166,10 @@ addRelations schema allRelations parentNode node@(Node readNode@(query, (name, _
       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))
+        addRel (query', (n, _)) r = (query' {from=fromRelation}, (n, Just r))
-          where fromRelation = map (\t -> if t == n then tableName (relTable r) else t) (from q)
+          where fromRelation = map (\t -> if t == n then tableName (relTable r) else t) (from query')
 
     _ -> Node (query, (name, Nothing)) <$> updatedForest
   where
@@ -151,13 +187,13 @@ addJoinConditions :: Schema -> ReadRequest -> Either Text ReadRequest
 addJoinConditions schema (Node (query, (n, r)) forest) =
   case r of
     Nothing -> Node (updatedQuery, (n,r))  <$> updatedForest -- this is the root node
-    Just rel@(Relation{relType=Child}) -> Node (addCond updatedQuery (getJoinConditions rel),(n,r)) <$> updatedForest
+    Just rel@Relation{relType=Child} -> Node (addCond updatedQuery (getJoinConditions rel),(n,r)) <$> updatedForest
-    Just (Relation{relType=Parent}) -> Node (updatedQuery, (n,r)) <$> updatedForest
+    Just Relation{relType=Parent} -> Node (updatedQuery, (n,r)) <$> updatedForest
-    Just rel@(Relation{relType=Many, relLTable=(Just linkTable)}) ->
+    Just rel@Relation{relType=Many, relLTable=(Just linkTable)} ->
       Node (qq, (n, r)) <$> updatedForest
       where
-         q = addCond updatedQuery (getJoinConditions rel)
+         query' = addCond updatedQuery (getJoinConditions rel)
-         qq = q{from=tableName linkTable : from q}
+         qq = query'{from=tableName linkTable : from query'}
     _ -> Left "unknown relation"
   where
     -- add parentTable and parentJoinConditions to the query
@@ -165,23 +201,23 @@ addJoinConditions schema (Node (query, (n, r)) forest) =
       where
         parentJoinConditions = map (getJoinConditions . snd) parents
         parents = mapMaybe (getParents . rootLabel) forest
-        getParents (_, (tbl, Just rel@(Relation{relType=Parent}))) = Just (tbl, rel)
+        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
+callProc :: QualifiedIdentifier -> JSON.Object -> H.Query () (Maybe JSON.Value)
-asJson s = s {
+callProc qi params =
-  B.stmtTemplate =
+  H.statement sql HE.unit decodeObj True
-    "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
   where
-    assignment (n,v) = pgFmtIdent n <> ":=" <> insertableValue v
+    sql = [qc| SELECT array_to_json(
+                coalesce(array_agg(row_to_json(t)), '\{}')
+              )::character varying
+              from ({_callSql}) t |]
+    _args = intercalate "," $ map _assignment (HM.toList params)
+    _assignment (n,v) = pgFmtIdent n <> ":=" <> insertableValue v
+    _callSql = [qc| select * from {fromQi qi}({_args}) |] :: BS.ByteString
+    decodeObj = HD.maybeRow (HD.value HD.json)
 
 operators :: [(Text, SqlFragment)]
 operators = [
@@ -210,7 +246,7 @@ pgFmtLit x =
  let trimmed = trimNullChars x
      escaped = "'" <> replace "'" "''" trimmed <> "'"
      slashed = replace "\\" "\\\\" escaped in
- if "\\\\" `isInfixOf` escaped
+ if "\\" `isInfixOf` escaped
    then "E" <> slashed
    else slashed
 
@@ -223,8 +259,8 @@ requestToCountQuery schema (DbRead (Node (Select _ _ conditions _, (mainTbl, _))
    ("WHERE " <> intercalate " AND " ( map (pgFmtCondition (QualifiedIdentifier schema mainTbl)) localConditions )) `emptyOnNull` localConditions
    ]
  where
-   fn  (Filter{value=VText _}) = True
+   fn Filter{value=VText _} = True
-   fn  (Filter{value=VForeignKey _ _}) = False
+   fn Filter{value=VForeignKey _ _} = False
    localConditions = filter fn conditions
 
 requestToQuery :: Schema -> DbRequest -> SqlQuery
@@ -269,23 +305,23 @@ requestToQuery schema (DbRead (Node (Select colSelects tbls conditions ord, (nod
     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 (Node n@(_, (name, Just Relation{relType=Child,relTable=Table{tableName=table}})) forst) (j,s) = (j,sel:s)
       where
         sel = "COALESCE(("
-           <> "SELECT array_to_json(array_agg(row_to_json("<>table<>"))) "
+           <> "SELECT array_to_json(array_agg(row_to_json("<>pgFmtIdent table<>"))) "
-           <> "FROM (" <> subquery <> ") " <> table
+           <> "FROM (" <> subquery <> ") " <> pgFmtIdent table
            <> "), '[]') AS " <> pgFmtIdent name
            where subquery = requestToQuery schema (DbRead (Node n forst))
-    getQueryParts (Node n@(_, (name, Just (Relation {relType=Parent,relTable=Table{tableName=table}}))) forst) (j,s) = (joi:j,sel:s)
+    getQueryParts (Node n@(_, (name, Just Relation{relType=Parent,relTable=Table{tableName=table}})) forst) (j,s) = (joi:j,sel:s)
       where
-        sel = "row_to_json(" <> table <> ".*) AS "<>pgFmtIdent name --TODO must be singular
+        sel = "row_to_json(" <> pgFmtIdent table <> ".*) AS "<>pgFmtIdent name --TODO must be singular
-        joi = ("( " <> subquery <> " ) AS " <> table, table)
+        joi = ("( " <> subquery <> " ) AS " <> pgFmtIdent table, table)
           where subquery = requestToQuery schema (DbRead (Node n forst))
-    getQueryParts (Node n@(_, (name, Just (Relation {relType=Many,relTable=Table{tableName=table}}))) forst) (j,s) = (j,sel:s)
+    getQueryParts (Node n@(_, (name, Just Relation{relType=Many,relTable=Table{tableName=table}})) forst) (j,s) = (j,sel:s)
       where
         sel = "COALESCE (("
-           <> "SELECT array_to_json(array_agg(row_to_json("<>table<>"))) "
+           <> "SELECT array_to_json(array_agg(row_to_json("<>pgFmtIdent table<>"))) "
-           <> "FROM (" <> subquery <> ") " <> table
+           <> "FROM (" <> subquery <> ") " <> pgFmtIdent table
            <> "), '[]') AS " <> pgFmtIdent name
            where subquery = requestToQuery schema (DbRead (Node n forst))
     --the following is just to remove the warning
@@ -300,7 +336,7 @@ requestToQuery schema (DbMutate (Insert mainTbl (PayloadJSON (UniformObjects row
     "INSERT INTO ", fromQi qi,
     " (" <> colsString <> ")" <>
     " SELECT " <> colsString <>
-    " FROM json_populate_recordset(null::" , fromQi qi, ", ?)"
+    " FROM json_populate_recordset(null::" , fromQi qi, ", $1)"
     ]
 requestToQuery schema (DbMutate (Update mainTbl (PayloadJSON (UniformObjects rows)) conditions)) =
   case rows V.!? 0 of
@@ -340,7 +376,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,10 +387,10 @@ 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 =
@@ -366,8 +402,7 @@ locationF pKeys =
       if null pKeys
       then ""
       else " WHERE json_data.key IN ('" <> intercalate "','" pKeys <> "')"
-    ) <>
+    ) <> ")"
-    ")"
 
 limitF :: NonnegRange -> SqlFragment
 limitF r  = "LIMIT " <> limit <> " OFFSET " <> offset
@@ -469,3 +504,20 @@ pgFmtAsJsonPath (Just xx) = " AS " <> last xx
 
 trimNullChars :: Text -> Text
 trimNullChars = T.takeWhile (/= '\x0')
+
+data Isolation = ReadCommitted | RepeatableRead | Serializable
+
+{- |
+  Wrap a session in a transaction of desired isolation level
+-}
+inTransaction :: Isolation -> H.Session a -> H.Session a
+inTransaction lvl f = do
+  H.sql $ "begin " <> isolate <> ";"
+  r <- f
+  H.sql "commit;"
+  return r
+ where
+  isolate = case lvl of
+    ReadCommitted  -> "ISOLATION LEVEL READ COMMITTED"
+    RepeatableRead -> "ISOLATION LEVEL REPEATABLE READ"
+    Serializable   -> "ISOLATION LEVEL SERIALIZABLE"

src/PostgREST/RangeQuery.hs

@@ -24,7 +24,7 @@ import           Data.Maybe                (fromMaybe, listToMaybe)
 
 import           Prelude
 
-type NonnegRange = Range Int
+type NonnegRange = Range Integer
 
 rangeParse :: BS.ByteString -> NonnegRange
 rangeParse range = do
@@ -41,28 +41,28 @@ rangeParse range = do
 rangeRequested :: RequestHeaders -> NonnegRange
 rangeRequested = rangeParse . fromMaybe "" . lookup hRange
 
-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)
 
-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
+rangeLeq :: Integer -> NonnegRange
 rangeLeq n =
   Range BoundaryBelowAll (BoundaryAbove n)

src/PostgREST/Types.hs

@@ -5,6 +5,7 @@ import qualified Data.ByteString.Lazy as BL
 import qualified Data.ByteString      as BS
 import qualified Data.Vector          as V
 import Data.Aeson
+import Data.Int (Int32)
 
 data DbStructure = DbStructure {
   dbTables :: [Table]
@@ -31,12 +32,12 @@ data Column =
     Column {
       colTable     :: Table
     , colName      :: Text
-    , colPosition  :: Int
+    , colPosition  :: Int32
     , colNullable  :: Bool
     , colType      :: Text
     , colUpdatable :: Bool
-    , colMaxLen    :: Maybe Int
+    , colMaxLen    :: Maybe Int32
-    , colPrecision :: Maybe Int
+    , colPrecision :: Maybe Int32
     , colDefault   :: Maybe Text
     , colEnum      :: [Text]
     , colFK        :: Maybe ForeignKey
@@ -90,6 +91,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.

stack.yaml

@@ -1,7 +1,10 @@
-flags: {}
+resolver: lts-5.0
+extra-deps:
+  - hasql-0.19.3.3
+  - Ranged-sets-0.3.0
+  - packdeps-0.4.2.1
+ghc-options:
+  postgrest: -O2 -Werror -Wall -fwarn-monomorphism-restriction -fwarn-missing-exported-sigs -fwarn-identities
+
 packages:
 - '.'
-extra-deps:
-  - Ranged-sets-0.3.0
-  - packdeps-0.4.1
-resolver: nightly-2015-10-27

test/Feature/AuthSpec.hs

@@ -5,16 +5,14 @@ import Test.Hspec
 import Test.Hspec.Wai
 import Test.Hspec.Wai.JSON
 import Network.HTTP.Types
-
+import qualified Hasql.Connection  as H
-import Hasql as H
-import Hasql.Postgres as P
 
 import SpecHelper
 import PostgREST.Types (DbStructure(..))
 -- }}}
 
-spec :: DbStructure -> H.Pool P.Postgres -> Spec
+spec :: DbStructure -> H.Connection -> Spec
-spec struct pool = around (withApp cfgDefault struct pool)
+spec struct c = around (withApp cfgDefault struct c)
   $ describe "authorization" $ do
 
   it "hides tables that anonymous does not own" $

test/Feature/CorsSpec.hs

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

test/Feature/DeleteSpec.hs

@@ -4,17 +4,15 @@ 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 qualified Hasql.Connection  as H
 
 import Network.HTTP.Types
 
-spec :: DbStructure -> H.Pool P.Postgres -> Spec
+spec :: DbStructure -> H.Connection -> Spec
-spec struct pool = beforeAll resetDb
+spec struct c = beforeAll resetDb
-  . around (withApp cfgDefault struct pool) $
+  . around (withApp cfgDefault struct c) $
   describe "Deleting" $ do
     context "existing record" $ do
       it "succeeds with 204 and deletion count" $

test/Feature/InsertSpec.hs

@@ -5,9 +5,6 @@ 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(..))
 
@@ -17,13 +14,14 @@ import Text.Heredoc
 import Network.HTTP.Types.Header
 import Network.HTTP.Types
 import Control.Monad (replicateM_)
+import qualified Hasql.Connection  as H
 
 import TestTypes(IncPK(..), CompoundPK(..))
 
-spec :: DbStructure -> H.Pool P.Postgres -> Spec
+spec :: DbStructure -> H.Connection -> Spec
-spec struct pool = beforeAll_ resetDb $ around (withApp cfgDefault struct pool) $ do
+spec struct c = beforeAll_ resetDb $ around (withApp cfgDefault struct c) $ 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| {
@@ -57,7 +55,7 @@ spec struct pool = beforeAll_ resetDb $ around (withApp cfgDefault struct pool)
 
 
     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 +74,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,7 +109,7 @@ 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") $
+    context "with compound pk supplied" $
       it "builds response location header appropriately" $
         post "/compound_pk" [json| { "k1":12, "k2":42 } |]
           `shouldRespondWith` ResponseMatcher {
@@ -124,7 +122,19 @@ spec struct pool = beforeAll_ resetDb $ around (withApp cfgDefault struct pool)
       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" } } |]
         request methodPost "/json"
@@ -162,7 +172,7 @@ spec struct pool = beforeAll_ resetDb $ around (withApp cfgDefault struct pool)
 
   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
@@ -185,7 +195,7 @@ spec struct pool = beforeAll_ resetDb $ around (withApp cfgDefault struct pool)
         --   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")]
@@ -220,7 +230,7 @@ spec struct pool = beforeAll_ resetDb $ around (withApp cfgDefault struct pool)
           }
 
 
-    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
@@ -231,7 +241,7 @@ spec struct pool = beforeAll_ resetDb $ around (withApp cfgDefault struct pool)
 
   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 +265,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" []
@@ -287,7 +297,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 +316,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 } |]
@@ -367,6 +377,17 @@ 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 = []
+          }
+
   describe "Row level permission" $
     it "set user_id when inserting rows" $ do
       let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJyb2xlIjoicG9zdGdyZXN0X3Rlc3RfYXV0aG9yIiwiaWQiOiJqZG9lIn0.y4vZuu1dDdwAl0-S00MCRWRYMlJ5YAMSir6Es6WtWx0"

test/Feature/QueryLimitedSpec.hs

@@ -5,17 +5,15 @@ import Test.Hspec.Wai
 import Test.Hspec.Wai.JSON
 import Network.HTTP.Types
 import Network.Wai.Test (SResponse(simpleHeaders, simpleStatus))
-
+import qualified Hasql.Connection  as H
-import Hasql as H
-import Hasql.Postgres as P
 
 import SpecHelper
 import PostgREST.Types (DbStructure(..))
 
-spec :: DbStructure -> H.Pool P.Postgres -> Spec
+spec :: DbStructure -> H.Connection -> Spec
-spec struct pool =
+spec struct c =
   beforeAll resetDb
-   . around (withApp (cfgLimitRows 3) struct pool) $
+   . around (withApp (cfgLimitRows 3) struct c) $
   describe "Requesting many items with server limits enabled" $ do
     it "restricts results" $
       get "/items"

test/Feature/QuerySpec.hs

@@ -5,16 +5,14 @@ import Test.Hspec.Wai
 import Test.Hspec.Wai.JSON
 import Network.HTTP.Types
 import Network.Wai.Test (SResponse(simpleHeaders))
-
+import qualified Hasql.Connection  as H
-import Hasql as H
-import Hasql.Postgres as P
 
 import SpecHelper
 import PostgREST.Types (DbStructure(..))
 import Text.Heredoc
 
-spec :: DbStructure -> H.Pool P.Postgres -> Spec
+spec :: DbStructure -> H.Connection -> Spec
-spec struct pool = around (withApp cfgDefault struct pool) $ do
+spec struct c = around (withApp cfgDefault struct c) $ do
 
   describe "Querying a table with a column called count" $
     it "should not confuse count column with pg_catalog.count aggregate" $
@@ -214,6 +212,11 @@ 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 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"}]}]|]
@@ -382,3 +385,45 @@ spec struct pool = around (withApp cfgDefault struct pool) $ do
       it "returns proper json" $
         post "/rpc/sayhello" [json| { "name": "world" } |] `shouldRespondWith`
           [json| [{"sayhello":"Hello, world"}] |]
+
+    context "improper input" $ do
+      it "rejects unknown content type even if payload is good" $
+        request methodPost "/rpc/sayhello"
+          (acceptHdrs "audio/mpeg3") [json| { "name": "world" } |]
+            `shouldRespondWith` 415
+      it "rejects malformed json payload" $
+        request methodPost "/rpc/sayhello"
+          (acceptHdrs "application/json") "sdfsdf"
+            `shouldRespondWith` 400
+
+    context "unsupported verbs" $ do
+      it "DELETE fails" $
+        request methodDelete "/rpc/sayhello" [] ""
+          `shouldRespondWith` 405
+      it "PATCH fails" $
+        request methodPatch "/rpc/sayhello" [] ""
+          `shouldRespondWith` 405
+      it "OPTIONS fails" $
+        -- TODO: should return info about the function
+        request methodOptions "/rpc/sayhello" [] ""
+          `shouldRespondWith` 405
+      it "GET fails with 405 on unknown procs" $
+        -- TODO: should this be 404?
+        get "/rpc/fake" `shouldRespondWith` 405
+      it "GET with 405 on known procs" $
+        get "/rpc/sayhello" `shouldRespondWith` 405
+
+  describe "weird requests" $ do
+    it "can query as normal" $ do
+      get "/Escap3e;" `shouldRespondWith`
+        [json| [{"so6meIdColumn":1},{"so6meIdColumn":2},{"so6meIdColumn":3},{"so6meIdColumn":4},{"so6meIdColumn":5}] |]
+      get "/ghostBusters" `shouldRespondWith`
+        [json| [{"escapeId":1},{"escapeId":3},{"escapeId":5}] |]
+
+    it "will embed a collection" $
+      get "/Escap3e;?select=ghostBusters{*}" `shouldRespondWith`
+        [json| [{"ghostBusters":[{"escapeId":1}]},{"ghostBusters":[]},{"ghostBusters":[{"escapeId":3}]},{"ghostBusters":[]},{"ghostBusters":[{"escapeId":5}]}] |]
+
+    it "will embed using a column" $
+      get "/ghostBusters?select=escapeId{*}" `shouldRespondWith`
+        [json| [{"escapeId":{"so6meIdColumn":1}},{"escapeId":{"so6meIdColumn":3}},{"escapeId":{"so6meIdColumn":5}}] |]

test/Feature/RangeSpec.hs

@@ -5,16 +5,14 @@ import Test.Hspec.Wai
 import Test.Hspec.Wai.JSON
 import Network.HTTP.Types
 import Network.Wai.Test (SResponse(simpleHeaders,simpleStatus))
-
+import qualified Hasql.Connection  as H
-import Hasql as H
-import Hasql.Postgres as P
 
 import SpecHelper
 import PostgREST.Types (DbStructure(..))
 
-spec :: DbStructure -> H.Pool P.Postgres -> Spec
+spec :: DbStructure -> H.Connection -> Spec
-spec struct pool = beforeAll resetDb
+spec struct c = beforeAll resetDb
-  . around (withApp cfgDefault struct pool) $
+  . around (withApp cfgDefault struct c) $
   describe "GET /items" $ do
 
     context "without range headers" $ do

test/Feature/StructureSpec.hs

@@ -3,28 +3,28 @@ module Feature.StructureSpec where
 import Test.Hspec hiding (pendingWith)
 import Test.Hspec.Wai
 import Test.Hspec.Wai.JSON
-
+import qualified Hasql.Connection  as H
-import Hasql as H
-import Hasql.Postgres as P
 
 import SpecHelper
 import PostgREST.Types (DbStructure(..))
 
 import Network.HTTP.Types
 
-spec :: DbStructure -> H.Pool P.Postgres -> Spec
+spec :: DbStructure -> H.Connection -> Spec
-spec struct pool = around (withApp cfgDefault struct pool) $ do
+spec struct c = around (withApp cfgDefault struct c) $ 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":"articleStars","insertable":true}
         , {"schema":"test","name":"articles","insertable":true}
         , {"schema":"test","name":"auto_incrementing_pk","insertable":true}
         , {"schema":"test","name":"clients","insertable":true}
         , {"schema":"test","name":"comments","insertable":true}
         , {"schema":"test","name":"complex_items","insertable":true}
         , {"schema":"test","name":"compound_pk","insertable":true}
+        , {"schema":"test","name":"ghostBusters","insertable":true}
         , {"schema":"test","name":"has_count_column","insertable":false}
         , {"schema":"test","name":"has_fk","insertable":true}
         , {"schema":"test","name":"insertable_view_with_join","insertable":true}
@@ -43,6 +43,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}
 
@@ -319,3 +320,6 @@ spec struct pool = around (withApp cfgDefault struct pool) $ do
             ]
           }
         |]
+
+    it "errors for non existant tables" $
+      request methodOptions "/dne" [] "" `shouldRespondWith` 404

test/Main.hs

@@ -3,7 +3,11 @@ module Main where
 import Test.Hspec
 import SpecHelper
 
---import PostgREST.Types (DbStructure(..))
+import qualified Hasql.Session as H
+import qualified Hasql.Connection as H
+
+import PostgREST.DbStructure (getDbStructure)
+import Data.String.Conversions (cs)
 
 import qualified Feature.AuthSpec
 import qualified Feature.CorsSpec
@@ -18,20 +22,22 @@ main :: IO ()
 main = do
   setupDb
 
-  pool <- specDbPool
+  H.acquire (cs dbString) >>= \case
-  dbStructure <- specDbStructure pool
+    Left err -> error $ show err
-
+    Right c -> do
-  -- Not using hspec-discover because we want to precompute
+      dbOrErr <- H.run (getDbStructure "test") c
-  -- the db structure and pass it to specs for speed
+      -- Not using hspec-discover because we want to precompute
-  hspec $ specs dbStructure pool
+      -- the db structure and pass it to specs for speed
+      either (error.show) (hspec . specs c) dbOrErr
+      H.release c
 
  where
-  specs dbStructure pool = do
+  specs conn dbStructure = do
-    describe "Feature.AuthSpec" $ Feature.AuthSpec.spec dbStructure pool
+    describe "Feature.AuthSpec" $ Feature.AuthSpec.spec dbStructure conn
-    describe "Feature.CorsSpec" $ Feature.CorsSpec.spec dbStructure pool
+    describe "Feature.CorsSpec" $ Feature.CorsSpec.spec dbStructure conn
-    describe "Feature.DeleteSpec" $ Feature.DeleteSpec.spec dbStructure pool
+    describe "Feature.DeleteSpec" $ Feature.DeleteSpec.spec dbStructure conn
-    describe "Feature.InsertSpec" $ Feature.InsertSpec.spec dbStructure pool
+    describe "Feature.InsertSpec" $ Feature.InsertSpec.spec dbStructure conn
-    describe "Feature.QueryLimitedSpec" $ Feature.QueryLimitedSpec.spec dbStructure pool
+    describe "Feature.QueryLimitedSpec" $ Feature.QueryLimitedSpec.spec dbStructure conn
-    describe "Feature.QuerySpec" $ Feature.QuerySpec.spec dbStructure pool
+    describe "Feature.QuerySpec" $ Feature.QuerySpec.spec dbStructure conn
-    describe "Feature.RangeSpec" $ Feature.RangeSpec.spec dbStructure pool
+    describe "Feature.RangeSpec" $ Feature.RangeSpec.spec dbStructure conn
-    describe "Feature.StructureSpec" $ Feature.StructureSpec.spec dbStructure pool
+    describe "Feature.StructureSpec" $ Feature.StructureSpec.spec dbStructure conn

test/SpecHelper.hs

@@ -2,16 +2,8 @@ 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)
 
@@ -19,57 +11,47 @@ 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 qualified Hasql.Connection  as H
+import qualified Hasql.Session     as H
+
 import PostgREST.App (app)
 import PostgREST.Config (AppConfig(..))
 import PostgREST.Middleware
 import PostgREST.Error(pgErrResponse)
-import PostgREST.DbStructure
 import PostgREST.Types
+import PostgREST.QueryBuilder (inTransaction, Isolation(..))
 
 dbString :: String
 dbString = "postgres://postgrest_test_authenticator@localhost:5432/postgrest_test"
 
-cfg :: String -> Maybe Int -> AppConfig
+cfg :: String -> Maybe Integer -> AppConfig
-cfg conStr = AppConfig conStr 3000 "postgrest_test_anonymous" "test" (secret "safe") 10
+cfg conStr = AppConfig conStr "postgrest_test_anonymous" "test" 3000 (secret "safe") 10
 
 cfgDefault :: AppConfig
 cfgDefault = cfg dbString Nothing
 
-cfgLimitRows :: Int -> AppConfig
+cfgLimitRows :: Integer -> AppConfig
 cfgLimitRows = cfg dbString . Just
 
-testPoolOpts :: PoolSettings
+withApp :: AppConfig -> DbStructure -> H.Connection
-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
+withApp config dbStructure c perform =
-  perform $ middle $ \req resp -> do
+  perform $ defaultMiddle $ \req resp -> do
     time <- getPOSIXTime
     body <- strictRequestBody req
-    result <- liftIO $ H.session pool $ H.tx specTxSettings
+    let handleReq = H.run $ inTransaction ReadCommitted
-      $ runWithClaims config time (app dbStructure config body) req
+          (runWithClaims config time (app dbStructure config body) req)
-    either (resp . pgErrResponse) resp result
 
-  where middle = defaultMiddle
+    handleReq c >>= \case
+      Left err -> do
+        void $ H.run (H.sql "rollback;") c
+        resp $ pgErrResponse err
+      Right res -> resp res
 
 setupDb :: IO ()
 setupDb = do
@@ -106,15 +88,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/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;
 
 
 --
@@ -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,7 +260,14 @@ INSERT INTO users_projects VALUES (2, 4);
 INSERT INTO users_projects VALUES (3, 1);
 INSERT INTO users_projects VALUES (3, 3);
 
+TRUNCATE TABLE "Escap3e;" CASCADE;
+INSERT INTO "Escap3e;" VALUES (1), (2), (3), (4), (5);
 
+TRUNCATE TABLE "ghostBusters" CASCADE;
+INSERT INTO "ghostBusters" VALUES (1), (3), (5);
+
+TRUNCATE TABLE "withUnique" CASCADE;
+INSERT INTO "withUnique" VALUES ('nodup', 'blah')
 --
 -- PostgreSQL database dump complete
 --

test/fixtures/privileges.sql

@@ -32,6 +32,9 @@ GRANT ALL ON TABLE
     , users
     , users_projects
     , users_tasks
+    , "Escap3e;"
+    , "ghostBusters"
+    , "withUnique"
 TO postgrest_test_anonymous;
 
 GRANT INSERT ON TABLE insertonly TO postgrest_test_anonymous;

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

@@ -591,6 +591,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: -
 --